--- /dev/null
+ PSPP Authors
+
+ * Ben Pfaff wrote most of the program and the manual.
+ * John Williams wrote the T-TEST procedure.
+ * Jim Van Zandt translated the `julcal' date calculation package
+ into C from code written by Michael Covington, which was based on
+ formulae by Jean Meeus.
--- /dev/null
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 675 Mass Ave, Cambridge, MA 02139, USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+\f
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+\f
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+\f
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+\f
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+\f
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) 19yy <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, 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) 19yy name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
--- /dev/null
+Sun Jan 2 21:24:32 2000 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Require Automake 1.4 or later. It's been out for
+ almost a year now, so why haven't you installed it? :-)
+
+ * TODO: Updated.
+
+ * configure.in: Updated version number. Check for libgmp. Check
+ of fenv.h. Check for feholdexpect().
+
+ * pref.h.orig: Don't include debug-print.h by default. Don't
+ disable __attribute ((unused))__ for gcc 2.7.2. Remove LOAD_2,
+ STORE_2. Comment fixes.
+
+ * Updated copyright notices in all files.
+
+Fri Mar 12 12:38:55 1999 Ben Pfaff <blp@gnu.org>
+
+ * Forked 0.3.0.
+
+Tue Mar 9 12:46:31 1999 Ben Pfaff <blp@gnu.org>
+
+ * Released 0.2.3.
+
+ * TODO: Updated.
+
+Tue Jan 5 15:18:07 1999 Ben Pfaff <blp@gnu.org>
+
+ * Released 0.2.2.
+
+ * TODO: Update from Zvi Grauer <z.grauer@sims.csuohio.edu>.
+
+Thu Nov 19 12:34:55 1998 Ben Pfaff <blp@gnu.org>
+
+ * Released 0.2.1.
+
+Sun Aug 9 11:11:32 1998 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+Sat Aug 8 00:19:08 1998 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+ * examples/: New directory.
+
+ * Made patchlevel 95.
+
+Tue Aug 4 23:47:31 1998 Ben Pfaff <blp@gnu.org>
+
+ * Bump version to 0.1.22 (0.2.0 release candidate).
+
+ * configure.in: Remove --enable-Werror, new option
+ --enable-debugging. New gcc option -Wpointer-arith.
+
+ * pref.h.orig: Don't enable debugging by default (now a configure
+ option). Use __inline__ instead of inline with gcc (partial -ansi
+ -pedantic support).
+ (macro local_strdup) Removed.
+
+ * Made patchlevel 94.
+
+Wed Jul 29 22:03:11 1998 Ben Pfaff <blp@gnu.org>
+
+ * Bump version to 0.1.21 (0.2.0 release candidate).
+
+ * debian/: Removed.
+
+ * Makefile.am: Don't copy debian/ into distribution.
+
+ * pref.h.orig: Only enable `unused' attribute if gcc 2.8.0 or
+ later is used.
+
+Sun Jul 5 14:20:04 1998 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Bump version to 0.1.20 (0.2.0 release candidate).
+
+ * Made patchlevel 93.
+
+Sun Jul 5 00:13:58 1998 Ben Pfaff <blp@gnu.org>
+
+ * README: Updated.
+
+ * TODO: Updated.
+
+ * configure.in: Remove -Wno-unused from default gcc flags.
+
+ * pref.h.orig: Add new #define, `unused', which under gcc expands
+ to an explanation to the compiler that a function argument is
+ unused, and expands to the null string under other compilers.
+
+Mon Jun 1 14:33:02 1998 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+ * configure.in: Bump version to 0.1.19.
+
+ * Made patchlevel 92.
+
+Sun May 31 00:55:13 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * configure.in: Generate Makefiles for lib/gmp/{,mpn,mpf}/.
+
+ * Made patchlevel 91.
+
+Fri May 29 21:43:09 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * LANGUAGE: Updated.
+
+ * unconfigure: Remove TeX cruft from doc/.
+
+ * Made patchlevel 90.
+
+Mon May 25 12:41:54 1998 Ben Pfaff <blp@gnu.org>
+
+ * BUGS: Updated.
+
+ * LANGUAGE: Updated.
+
+ * TODO: Updated.
+
+ * configure.in: Bumped version number up to 0.1.18.
+
+ * Made patchlevel 89.
+
+Sun May 24 22:39:55 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 88.
+
+Sat May 23 23:21:43 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * configure.in: Remove gamma from replaceable functions.
+
+ * Made patchlevel 87.
+
+Fri May 22 00:02:33 1998 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Add gamma to list of functions with replacements.
+
+ * Made patchlevel 86.
+
+Wed May 20 00:00:12 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 85.
+
+Sat May 16 19:38:49 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 84.
+
+Tue May 12 16:13:48 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * unconfigure: Don't delete Makefile.in under intl/.
+
+ * Made patchlevel 83.
+
+Thu May 7 23:16:26 1998 Ben Pfaff <blp@gnu.org>
+
+ * unconfigure: Add some more files to reap.
+
+ * Made patchlevel 82.
+
+Tue May 5 13:17:59 1998 Ben Pfaff <blp@gnu.org>
+
+ * acconfig.h: Add HAVE_GOOD_RANDOM definition.
+
+ * acinclude.m4: New macro BLP_RANDOM.
+
+ * configure.in: Use new BLP_RANDOM macro.
+
+ * unconfigure: New file.
+
+ * Made patchlevel 81.
+
+Fri Apr 24 12:42:14 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Remove bad comment.
+
+ * AUTHORS: Removed Brad Appleton.
+
+ * TODO: Updated.
+
+ * configure.in: Remove `satisfy automake' bit. Don't generate
+ avllib Makefile, since we don't use avllib anymore.
+
+ * pref.h.orig: Define PSPP.
+
+ * Made patchlevel 80.
+
+Wed Apr 15 12:59:39 1998 Ben Pfaff <blp@gnu.org>
+
+ * AUTHORS, BUGS, LANGUAGE, README, THANKS: No longer generated
+ from HTML. This caused a lot of deletions from the Makefile.am.
+
+ * TODO: Updated.
+
+ * Made patchlevel 79.
+
+Tue Apr 14 00:48:00 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * configure.in: Check for unistd.h. Fix AC_LN_S (should have been
+ AC_PROG_LN_S).
+
+ * Made patchlevel 78. Must have missed 77 in there somewhere :-)
+
+Mon Mar 9 15:40:40 1998 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 76.
+
+ * configure.in: Bumped version up to 0.1.16.
+
+1998-03-05 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Bumped version up to 0.1.15.
+
+1998-02-23 Ben Pfaff <blp@gnu.org>
+
+ * acinclude.m4: Add BLP_INT_DIGITS and BLP_IS_SPRINTF_GOOD macros.
+
+ * configure.in: Those macros came from here. Better modularity
+ this way. Bump version up to 0.1.14.
+
+ * pref.h.orig: (macros CONFIG_PATH, INCLUDE_PATH, GROFF_FONT_PATH)
+ Removed.
+
+ * Made patchlevel 75.
+
+1998-02-23 Ben Pfaff <blp@gnu.org>
+
+ * acconfig.h: Hard-code PACKAGE and GNU_PACKAGE as "PSPP" and "GNU
+ PSPP" respectively.
+
+ * configure.in: Call the package pspp instead of PSPP. Don't
+ define PACKAGE and GNU_PACKAGE symbols. Add replacement function
+ for strtok_r.
+
+ * TODO: Updated.
+
+ * Made patchlevel 74.
+
+1998-02-16 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Remove a few now-useless targets.
+
+ * TODO: Updated.
+
+ * configure.in: Bump version up to 0.1.13.
+
+ * reconfigure: Don't assume . is in PATH.
+
+ * Made patchlevel 73.
+
+Fri Feb 13 15:35:03 1998 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Bump version up to 0.1.12.
+
+ * TODO: Updated.
+
+ * pref.h.orig: Make __unix equivalent to unix and __unix__; don't
+ require any of these to be defined to 1, just defined. Invert
+ sense of some tests from testing for unix to testing for not being
+ msdog.
+
+ * Made patchlevel 72.
+
+Thu Feb 5 00:22:58 1998 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 71.
+
+ * configure.in: Bump version up to 0.1.11.
+
+Tue Feb 3 16:12:34 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 70.
+
+ * configure.in: Bump version up to 0.1.10.
+
+Fri Jan 23 00:17:18 1998 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 69.
+
+Thu Jan 22 00:35:52 1998 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 68.
+
+Sun Jan 18 00:30:18 1998 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Add ieeefp.h to list of headers to check for.
+
+ * Made patchlevel 67.
+
+Tue Jan 13 23:44:16 1998 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Add sys/wait.h to list of headers to check for.
+
+ * Made patchlevel 66.
+
+Sun Jan 11 21:30:09 1998 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Bump version up to 0.1.9.
+
+ * pref.h.orig (STORE_2): Fix parentheses. From Alexandre
+ Oliva <oliva@dcc.unicamp.br>.
+
+ * Made patchlevel 65.
+
+Sat Jan 10 23:59:06 1998 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 64.
+
+Sat Jan 10 02:10:15 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * pref.h.orig: Comment fixes.
+ (macro second_lowest_flt64) New.
+
+ * Made patchlevel 63.
+
+Thu Jan 8 22:27:03 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 62.
+
+Mon Jan 5 11:18:37 1998 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 61.
+
+Sun Jan 4 18:10:29 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * pref.h.orig: (local_strdup) [HAVE_ALLOCA && PAGED_STACK &&
+ __GNUC__] Rewritten for space and time efficiency and to evaluate
+ its argument only once.
+
+ * Made patchlevel 60.
+
+Sat Jan 3 16:51:20 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 59.
+
+Fri Jan 2 01:38:37 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * config.sub: Got tired of `i686-unknown-linux: Unknown system',
+ so I made 686 equivalent to 586.
+
+ * pref.h.orig: (macros ASCII_*, HTML_*, PS_*) Removed.
+
+ * Made patchlevel 58.
+
+Thu Jan 1 11:50:47 1998 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 57.
+
+Fri Dec 26 15:43:17 1997 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 56.
+
+Wed Dec 24 22:34:55 1997 Ben Pfaff <blp@gnu.org>
+
+ * reconfigure: regularized option syntax.
+
+ * configure.in: Bumped version to 0.1.8. Changed name from pspp
+ to PSPP. Added lib/dcdflib/Makefile to list of output files.
+
+ * Made patchlevel 55.
+
+Sun Dec 21 15:58:52 1997 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * acconfig.h: Reformat.
+
+ * configure.in: Bumped version to 0.1.7.
+
+ * Made patchlevel 54.
+
+Fri Dec 5 23:38:12 1997 Ben Pfaff <blp@gnu.org>
+
+ * Replaced prep.ai.mit.edu with ftp.gnu.org and .gnu.ai.mit.edu
+ with .gnu.org, everywhere.
+
+Fri Dec 5 23:02:40 1997 Ben Pfaff <blp@gnu.org>
+
+ * Replaced remaining instances of Fiasco with PSPP.
+
+ * Made patchlevel 53.
+
+Fri Dec 5 22:51:18 1997 Ben Pfaff <blp@gnu.org>
+
+ * Every instance of the name Fiasco, throughout every file,
+ replaced in-place with PSPP, with the exceptions of a few files
+ that had `fiasco' in their names; these were renamed.
+
+ * Made patchlevel 52.
+
+Fri Dec 5 21:50:52 1997 Ben Pfaff <blp@gnu.org>
+
+ * pref.h.orig: (macros NO_HTML, HTML_DEFAULT_OUTPUT_FILE) New
+ macros.
+
+ * TODO: Updated.
+
+ * Made patchlevel 51.
+
+Tue Dec 2 14:35:12 1997 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * configure.in: Bumped version to 0.1.6.
+
+ * Made patchlevel 50.
+
+Sat Nov 22 01:20:32 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 49.
+
+Fri Nov 21 00:11:41 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 48.
+
+Sun Nov 16 01:31:38 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 47.
+
+Fri Nov 14 00:17:48 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 46.
+
+ * configure.in: Bumped version to 0.1.5.
+
+Tue Oct 28 16:07:17 1997 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Bumped version to 0.1.4.
+
+ * TODO: Updated.
+
+ * Made patchlevel 45.
+
+Wed Oct 8 15:55:50 1997 Ben Pfaff <blp@gnu.org>
+
+ * intl: Upgraded from sources to gettext-0.10.32.
+
+ * configure.in: Bumped version to 0.1.3.
+
+ * Made patchlevel 44.
+
+Tue Oct 7 20:21:53 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (dist-hook) Use $(top_srcdir).
+
+ * pref.h.orig: (MAX_WORKSPACE) Enlarge to 4 MB (from 1 MB).
+
+ * Made patchlevel 43.
+
+Sun Oct 5 15:52:37 1997 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Bumped version to 0.1.2.
+ (strerror) Replace instead of check. From Alexandre Oliva
+ <oliva@dcc.unicamp.br>.
+
+ * pref.h.orig: Include `debug-print' instead of
+ `src/debug-print.h'.
+
+ * Made patchlevel 42.
+
+Sat Oct 4 16:19:44 1997 Ben Pfaff <blp@gnu.org>
+
+ * pref.h.orig: Comment fixes.
+ (local_strdup) [HAVE_ALLOCA && PAGED_STACK &&
+ __GNUC__] Use local_alloc() instead of alloca(), as local_alloc()
+ isn't simply an alias for alloca().
+
+ * configure.in: Bumped version to 0.1.1.
+
+ * Made patchlevel 41.
+
+Sat Oct 4 02:13:00 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 40.
+
+Sun Sep 21 00:07:09 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 39.
+
+Thu Sep 18 21:42:27 1997 Ben Pfaff <blp@gnu.org>
+
+ * pref.h.orig: (CONFIG_PATH) [unix] Add /usr/local/etc/fiasco,
+ /usr/etc/fiasco to search path.
+
+ * Made patchlevel 38.
+
+Wed Aug 20 14:20:06 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (noinst_DATA) Removed ANNOUNCE, HELP-WANTED.
+ (EXTRA_DIST) Removed ANNOUNCE, FAQ, HELP-WANTED, mk-web-dist.
+ (MAINTAINERCLEANFILES) Removed ANNOUNCE, FAQ, HELP-WANTED.
+
+ * Made patchlevel 37.
+
+Wed Aug 20 12:48:25 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (doc/ANNOUNCE.html, ANNOUNCE, FAQ, doc/FAQ.html,
+ HELP-WANTED) Removed.
+ (docfiles) Removed ANNOUNCE, FAQ, HELP-WANTED.
+
+ * mk-web-dist: Removed.
+
+ * Made patchlevel 36.
+
+Mon Aug 18 18:06:12 1997 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * pref.h.orig: (macro DEFAULT_COMPAT) Removed.
+
+ * Made patchlevel 35.
+
+Sun Aug 17 22:48:36 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 34.
+
+Sat Aug 16 10:48:29 1997 Ben Pfaff <blp@gnu.org>
+
+ * In many files, in this directory and others, messages were
+ rephrased to eliminate or reduce usage of certain deprecated terms
+ at suggestion of rms.
+
+ * Makefile.am: (EXTRA_DIST) Removed unix2dos.pl.
+ (MAINTAINERCLEANFILES) Removed doc/ANNOUNCE.html, doc/README.html.
+ (docfiles-recursive) Removed.
+
+ * TODO: Updated.
+
+ * mk-web-dist: Doesn't produce any distributions at all, just a
+ webpage. Doesn't configure the distribution. Changed list of
+ files installed.
+
+ * pref.h.orig: s/VER_PCP40/VER_PC/; s/VER_WIN61/VER_WND/;
+ s/VER_X40/VER_X/; All references changed.
+
+ * Made patchlevel 33.
+
+Thu Aug 14 22:02:08 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Comment fixes. Uses $(VERSION) instead of contents
+ of VERSION file.
+ (EXTRA_DIST) Remove fiasco.ide, mk-bc5-dist.
+ (docfiles-recursive) Works if doc/Makefile doesn't exist.
+ (DIST_BC5_ROOT) Renamed DISTBC5_DISTROOT.
+ (DISTBC5_BC5ROOT) New var.
+ (dist-bc5) Passes $(DISTBC5_BC5ROOT).
+
+ * TODO: Update.
+
+ * acinclude.m4: Remove blp_VERSION_CHEAT kluge.
+
+ * configure.in: Don't use blp_VERSION_CHEAT kluge.
+
+ * mk-web-dist, reconfigure: Extract version number from
+ configure.in.
+
+ * pref.h.orig: (CONFIG_PATH, INCLUDE_PATH, GROFF_FONT_PATH)
+ [__MSDOS__] Fixed bad use of backslashes.
+
+ * reconfigure: Pass $VERSION to Makefile.
+
+ * Made patchlevel 32.
+
+Thu Aug 14 11:49:35 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST, docfiles) Add ONEWS.
+ (docfiles) Depends on docfiles-recursive.
+ (docfiles-recursive) New target, call make for `docfiles' target
+ in doc directory.
+ (dist-bc5) Adds `foo' second arg to mk-bc5-dist.
+ (.PHONY) Add docfiles.
+
+ * mk-bc5-dist: Checks that it is passed a second arg of `foo'.
+
+ * reconfigure: Changed == operators to = as arguments to `test'.
+ No longer uses bash -v switch.
+
+ * mk-distribution: Renamed mk-web-dist, all references changed.
+ Now takes several options, added help. No longer uses -uv
+ options.
+
+ * Made patchlevel 31.
+
+Tue Aug 5 13:56:39 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (MAINTAINERCLEANFILES) Add HELP-WANTED.
+ (EXTRA_DIST) Add ONEWS.
+
+ * Made patchlevel 30.
+
+Sun Aug 3 11:30:17 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (noinst_data, docfiles) Added HELP-WANTED.
+ (EXTRA_DIST) Added configure, mk-bc5-dist, unix2dos.pl,
+ HELP-WANTED.
+ (HELP-WANTED) Generated from doc/HELP-WANTED.html.
+ (dist-bc5) New target.
+
+ * TODO: Updated.
+
+ * mk-distribution: Fixed bugs, added HELP-WANTED.
+
+ * reconfigure: When invoking Makefile.am, pass
+ top_srcdir=. explicitly.
+
+ * unix2dos.pl: New file.
+
+ * Made patchlevel 29.
+
+Thu Jul 17 21:49:13 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 28.
+
+Thu Jul 17 01:43:25 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Remove inactive .html suffix rule.
+ New rules to generate doc/ANNOUNCE.html and doc/README.html from
+ corresponding .in files.
+ (EXTRA_DIST) Add VERSION, fiasco.ide, mk-distribution.
+ (MAINTAINERCLEANFILES) Add doc/ANNOUNCE.html, doc/README.html.
+
+ * acinclude.m4: (blp_VERSION_CHEAT) New macro.
+
+ * configure.in: Forces _GNU_SOURCES not only to be defined, but to
+ a value of 1. Substitutes VERSION from the new file VERSION.
+ Removed DEBIAN reference. Checks for sys/mman.h header.
+
+ * pref.h.orig: (macro gettext) Don't put parentheses in the
+ expansion.
+ (macro N_) Same.
+
+ * reconfigure: Sets -ev in shell. Doesn't try to pass
+ --include-deps to configure (it's an automake flag!). Moved `make
+ docfiles'.
+
+ * sysdeps/borlandc4.0/README, sysdeps/borlandc4.0/_read.c,
+ sysdeps/borlandc4.0/_write.c, sysdeps/borlandc4.0: Removed.
+
+ * VERSION: New file.
+
+ * fiasco.ide: New file.
+
+ * mk-distribution: New file.
+
+ * Made patchlevel 27.
+
+Fri Jul 11 23:00:53 1997 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updates.
+
+ * Made patchlevel 26.
+
+Fri Jul 11 14:08:21 1997 Ben Pfaff <blp@gnu.org>
+
+ * pref.h.orig: __CYGWIN32__ is a form of __unix__.
+
+ * reconfigure: Add -k for make maintainer-clean.
+
+ * Made patchlevel 25.
+
+Thu Jul 10 22:13:07 1997 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Add "-D_GNU_SOURCE" to CPPFLAGS to force GNU
+ glibc extensions to be detected.
+
+ * Made patchlevel 24.
+
+Sun Jul 6 19:13:07 1997 Ben Pfaff <blp@gnu.org>
+
+ * pref.h.orig: Include "src/debug-print.h" instead of
+ "debug-print.h".
+ (macros local_alloc, local_free) More robust under Checker: put
+ their allocations in namespace different from malloc()/free().
+
+ * Made patchlevel 23.
+
+Sat Jul 5 23:42:14 1997 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updates.
+
+ * Made patchlevel 22.
+
+Fri Jul 4 13:20:47 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) Removed orphaned-rules.
+ (docfiles) Removed ChangeLog, COPYING.
+ (html, maintainer-clean-hook, install-data-hook) Removed.
+
+ * reconfigure: Added --help option. Calls configure again even if
+ --no-include-deps.
+
+ * Made patchlevel 21.
+
+Wed Jun 25 22:47:17 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Require Automake 1.2.
+ (dist-hook) Don't copy config dir.
+ (EXTRA_DIST, MAINTAINERCLEANFILES) Add FAQ.
+ (docfiles) Made a variable as well as a target; added ChangeLog,
+ COPYING, FAQ, INSTALL, TODO.
+ (html, maintainer-clean-hook, install-data-hook, debian,
+ debian-clean, debian-clean-full) New targets.
+
+ * orphaned-rules: Removed.
+
+ * configure.in: Bumped up to version 0.1.0.
+
+ * reconfigure: New options --enable-nls, --no-include-deps.
+ Comment fixes.
+
+ * Made patchlevel 20.
+
+Sun Jun 22 22:10:27 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 19.
+
+Sun Jun 15 16:44:14 1997 Ben Pfaff <blp@gnu.org>
+
+ * pref.h.orig: Comment fixes. Includes debug-print.h.
+ (DEMAND_PAGE, ALWAYS_PAGE, NEVER_PAGE) Removed.
+
+ * Made patchlevel 18.
+
+Sun Jun 8 01:25:40 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 17.
+
+Fri Jun 6 22:41:08 1997 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updates.
+
+ * pref.h.orig: Reformatted macros.
+ [!ENABLE_NLS] Defines gettext() as a trivial substitution to allow
+ gcc to give warnings on printf().
+
+ * Made patchlevel 16.
+
+Thu Jun 5 23:01:49 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 15.
+
+Tue Jun 3 23:24:08 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: AUTOMAKE_OPTIONS changed from `foreign 1.1l' to
+ `gnits 1.1p'. SUBDIRS reordered. New target `docfiles'.
+
+ * TODO: Updates.
+
+ * configure.in: Removed AM_MAINTAINER_MODE. Added
+ --enable-Werror, which is implied by --with-checker.
+
+ * reconfigure: Moved `aclocal' from beginning to just before
+ cleaning `autoheader'. Removed --enable-maintainer-mode. Added
+ --disable-nls. Added `make docfiles' to placate autoheader.
+ Added `aclocal' before first real `autoheader'. Uses `make
+ mostlyclean' instead of `make depend'.
+
+ * Made patchlevel 14.
+
+Mon Jun 2 14:21:54 1997 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Removed comment that screwed things up.
+
+ * reconfigure: Added `aclocal' at beginning.
+
+ * Made patchlevel 13.
+
+Sun Jun 1 23:25:39 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Add intl, po to SUBDIRS. Add aclocal.m4,
+ config.h.in to MAINTAINERCLEANFILES.
+
+ * acconfig.h: Add HAVE_LC_MESSAGES, ENABLE_NLS, HAVE_CATGETS,
+ HAVE_GETTEXT, HAVE_STPCPY.
+
+ * configure.in: Reordered to placate autoheader. Added
+ AC_ISC_POSIX, AM_PROG_CC_STDC. Added internationalization:
+ ALL_LINGUAS="", AM_GNU_GETTEXT, AC_LINK_FILES(...). Added
+ po/Makefile.in, intl/Makefile to generated files list. Generates
+ po/Makefile from po/Makefile.in. Comment fix.
+
+ * pref.h.orig: Uncommented i18n support.
+
+ * acinclude.m4: New file.
+
+ * ABOUT-NLS: New file.
+
+ * intl/: New directory, taken from gettext-0.10.27.
+
+ * missing: New file, taken from automake-1.1p.
+
+ * po/: New directory.
+
+ * Made patchlevel 12.
+
+Sun Jun 1 17:28:27 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 11.
+
+Sun Jun 1 11:58:43 1997 Ben Pfaff <blp@gnu.org>
+
+ * pref.h.orig: Removed DEFAULT_VER_PCP40, DEFAULT_VER_WIN61,
+ DEFAULT_VER_X40. Added a macro DEFAULT_COMPAT that takes one of
+ the VER_* enums as a value.
+ (HISTORY_FILE) Changed the definition to "~/.fiasco_history".
+
+ * Made patchlevel 10.
+
+Fri May 30 19:40:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * pref.h.orig: [__MSDOS__] Reordered INCLUDE_PATH.
+
+ * Made patchlevel 9.
+
+Sun May 25 22:32:57 1997 Ben Pfaff <blp@gnu.org>
+
+ * acconfig.h: For support of glibc 2, define _GNU_SOURCE.
+
+ * Made patchlevel 8.
+
+Mon May 5 21:58:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 7.
+
+Fri May 2 22:27:36 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 6.
+
+Thu May 1 15:34:01 1997 Ben Pfaff <blp@gnu.org>
+
+ * All files: Changed copyright from `Ben Pfaff' to `Free Software
+ Foundation, Inc'.
+
+ * Made patchlevel 5.
+
+Thu May 1 15:00:51 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 4.
+
+Sat Apr 26 11:34:05 1997 Ben Pfaff <blp@gnu.org>
+
+ * ChangeLog: Split into one ChangeLog per directory.
+
+ * Made patchlevel 3.
+
+Wed Apr 23 21:33:48 1997 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Update.
+
+ * Made patchlevel 2.
+
+Fri Apr 18 16:48:41 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Removed `include', `util' from SUBDIRS; added
+ `config'. Includes `config' directory in distributions. Added
+ `private-install', `private-uninstall' targets.
+
+ * configure.in: AC_INIT tests for src/q2c.c now. Removed
+ redundant AC_PROG_MAKE_SET call. Removed include/Makefile,
+ util/Makefile from generated files list; added config/Makefile.
+
+ * include/approx.h, include/arena.h, include/common.h,
+ include/dfm.h, include/do-ifP.h, include/error.h, include/expr.h,
+ include/exprP.h, include/file-handle.h, include/filename.h,
+ include/font.h, include/getline.h, include/getopt.h,
+ include/hash.h, include/heap.h, include/log.h, include/misc.h,
+ include/output.h, include/settings.h, include/sfm.h,
+ include/sfmP.h, include/som.h, include/somP.h, include/stat.h,
+ include/stats.h, include/str.h, include/tokens.h, include/var.h,
+ include/version.h, include/vfmP.h: Moved into src/ directory.
+
+ * include/Makefile.am, include/: Removed.
+
+ * util/Makefile.am: Removed.
+
+ * util/q2c.c: Moved to src/.
+
+ * util/reconfigure: Moved to source root.
+
+ * util/: Removed.
+
+ * Made patchlevel 1.
+
+Fri Apr 18 15:42:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Maintainer-cleans generated documentation and
+ Makefile.in.
+
+ * include/Makefile.am, util/Makefile.am: Maintainer-cleans
+ Makefile.in.
+
+ * include/somP.h: (static struct var som) Removed passed_t member.
+
+ * TODO: Updated.
+
+ * configure.in: Fixed source directory for copying pref.h; always
+ updates pref.h or at least touch'es it.
+
+ * pref.h.orig: Made a rather pejorative comment a lot milder so it
+ wouldn't be misinterpreted.
+
+ * Made interim release x3.
+
+Thu Mar 27 01:11:29 1997 Ben Pfaff <blp@gnu.org>
+
+ * All directories now contain new `Makefile.am's, in some cases
+ produced from bits and pieces of the single monolithic old one.
+
+ * PATCHLEVEL: Removed.
+
+ * acconfig.h: Added GNU_PACKAGE, PACKAGE, PROTOTYPES, VERSION;
+ removed inclusion of conf.h.
+
+ * confh.in: Removed.
+ * confh.tmp.in: Removed.
+
+ * configure.in: Deepened. Updated for use with Automake 1.1l.
+ Removed PATCHLEVEL hacks. Fixed lots of functions in
+ AC_CHECK_FUNCS, AC_REPLACE_FUNCS, and similar. Only passes
+ `-Werror' to gcc in maintainer mode. Doesn't output conf.h.
+ Touches pref.h even if it wasn't changed.
+
+ * aclocal.m4: New file.
+
+ * config.h.in: Renamed from configh.in.
+
+ * pref.h.orig: Renamed from prefh.orig.
+
+ * Made interim release x2.
+
+Thu Mar 27 01:07:02 1997 Ben Pfaff <blp@gnu.org>
+
+ Changed the distribution from flat to deep. New configuration:
+
+ ANNOUNCE Makefile.in config.h.in mkinstalldirs
+ AUTHORS NEWS config.sub orphaned-rules
+ BUGS README configure pref.h
+ COPYING THANKS configure.in pref.h.orig
+ ChangeLog TODO debian src
+ ChangeLog~ acconfig.h doc stamp-h.in
+ INSTALL aclocal.m4 include sysdeps
+ LANGUAGE config install-sh tests
+ Makefile.am config.guess lib util
+
+ config:
+ devices environment papersize ps-fontmap ps-prologue
+
+ debian:
+ changelog control postinst rules
+ conffiles copyright postrm
+
+ doc:
+ ANNOUNCE.html Makefile.in fiasco.info-2 stamp-vti
+ AUTHORS.html README.html fiasco.info-3 texinfo.tex
+ BUGS.html THANKS.html fiasco.info-4 version.texi
+ LANGUAGE.html fiasco.info fiasco.texi
+ Makefile.am fiasco.info-1 mdate-sh
+
+ include:
+ approx.h file-handle.h misc.h stats.h
+ arena.h filename.h output.h str.h
+ common.h font.h settings.h tokens.h
+ dfm.h getline.h sfm.h var.h
+ do-ifP.h getopt.h sfmP.h version.h
+ error.h hash.h som.h vfmP.h
+ expr.h heap.h somP.h
+ exprP.h log.h stat.h
+
+ lib:
+ Makefile.am Makefile.in avllib julcal misc
+
+ lib/avllib:
+ AVLLIB.COPYING Makefile.in avl.h
+ Makefile.am avl.c
+
+ lib/julcal:
+ Makefile.am Makefile.in julcal.c julcal.h
+
+ lib/misc:
+ Makefile.am getopt1.c memset.c strstr.c
+ Makefile.in memchr.c qsort.c strtol.c
+ alloca.c memcmp.c stpcpy.c strtoul.c
+ getdelim.c memcpy.c strcasecmp.c
+ getline.c memmem.c strncasecmp.c
+ getopt.c memmove.c strpbrk.c
+
+ src:
+ Makefile.am error.c lexer.c sfm-write.c
+ Makefile.in expr-evl.c list.c show.c
+ arena.c expr-opt.c list.q som-frnt.c
+ ascii.c expr-prs.c log.c som-high.c
+ autorecode.c file-handle.c loop.c som-low.c
+ cases.c file-handle.q main.c sort.c
+ cmdline.c file-type.c mis-val.c split-file.c
+ command.c filename.c misc.c stats.c
+ common.c formats.c modify-vars.c str.c
+ compute.c freq.c numeric.c sysfile-info.c
+ count.c frequencies.c output.c temporary.c
+ crosstabs.c frequencies.g postscript.c title.c
+ crosstabs.q frequencies.q print.c val-labs.c
+ data-in.c get.c recode.c var-labs.c
+ data-list.c getline.c rename-vars.c vars-atr.c
+ data-out.c glob.c repeat.c vars-prs.c
+ descript.c groff-font.c sample.c vector.c
+ descript.q hash.c sel-if.c version.c
+ dfm.c heap.c set.c vfm.c
+ display.c include.c set.q weight.c
+ do-if.c inpt-pgm.c sfm-read.c
+
+ sysdeps:
+ BorlndC4.0 DJGPP2.0 Windows
+
+ sysdeps/BorlndC4.0:
+ Makefile _write.c conf.h
+ _read.c compile.bat config.h
+
+ sysdeps/DJGPP2.0:
+ Makefile compile.bat conf.h config.h
+
+ sysdeps/Windows:
+ con32s.c
+
+ tests:
+ Makefile.am expression.stat reread.data
+ Makefile.in fall92.data reread.stat
+ autorecode.stat fall92.stat sample.stat
+ begin-data.stat file-label.stat show-check-msg
+ bignum.data file-type.stat sort.data
+ bignum.stat filter.stat sort.stat
+ bug.stat gengarbage.c split-file.stat
+ compute.stat input-program.stat sysfile-info.stat
+ count.stat list.data temporary.stat
+ data-formats.stat list.stat time-date.stat
+ data-list.data loop.stat vector.stat
+ data-list.stat modify-vars.stat weighting.data
+ descript.stat print.stat weighting.stat
+ do-if.stat process-if.stat
+ do-repeat.stat recode.stat
+
+ util:
+ Makefile.am Makefile.in q2c.c reconfigure
+
+ Old configuration:
+
+ ANNOUNCE.html count.c hash.h sample.c
+ AUTHORS.html crosstabs.q heap.c sel-if.c
+ AVLLIB.COPYING data-in.c heap.h set.q
+ BUGS.html data-list.c include.c settings.h
+ COPYING data-out.c inpt-pgm.c sfm-read.c
+ ChangeLog debian install-sh sfm-write.c
+ INSTALL descript.q julcal.c sfm.h
+ LANGUAGE.html devices julcal.h sfmP.h
+ Makefile.am dfm.c lexer.c show.c
+ NEWS dfm.h list.q som-frnt.c
+ PATCHLEVEL display.c log.c som-high.c
+ README.html do-if.c log.h som-low.c
+ THANKS.html do-ifP.h loop.c som.h
+ TODO environment main.c somP.h
+ _read.c error.c makeb40.bat sort.c
+ _write.c error.h makedj2.bat split-file.c
+ acconfig.h expr-evl.c makefile.b40 stamp-h.in
+ alloca.c expr-opt.c makefile.dj2 stats.c
+ approx.h expr-prs.c mdate-sh stats.h
+ arena.c expr.h memcmp.c stpcpy.c
+ arena.h exprP.h mis-val.c str.c
+ ascii.c fiasco.texi misc.c str.h
+ autorecode.c file-handle.h misc.h sysfile-info.c
+ avl.c file-handle.q mkinstalldirs temporary.c
+ avl.h file-type.c modify-vars.c test
+ cases.c filename.c numeric.c texinfo.tex
+ cmdline.c filename.h output.c title.c
+ command.c font.h output.h tokens.h
+ common.c formats.c papersize val-labs.c
+ common.h freq.c postscript.c var-labs.c
+ compute.c frequencies.g prefh.orig var.h
+ con32s.c frequencies.q print.c vars-atr.c
+ confh.b40 get.c ps-fontmap vars-prs.c
+ confh.dj2 getline.c ps-prologue vector.c
+ confh.in getline.h q2c.c version.c
+ confh.tmp.in getopt.c qsort.c version.h
+ config.guess getopt.h recode.c vfm.c
+ config.sub getopt1.c reconfigure vfmP.h
+ configh.b40 glob.c reject weight.c
+ configh.dj2 groff-font.c rename-vars.c
+ configure.in hash.c repeat.c
+
+ debian:
+ changelog control postinst rules
+ conffiles copyright postrm
+
+ test:
+ autorecode.stat fall92.data recode.stat
+ begin-data.stat fall92.stat reread.data
+ bignum.data file-label.stat reread.stat
+ bignum.stat file-type.stat sample.stat
+ bug.stat filter.stat sort.stat
+ compute.stat gengarbage.c split-file.stat
+ count.stat gengarbage.pl sysfile-info.stat
+ data-formats.stat input-program.stat temporary.stat
+ data-list.data list.data time-date.stat
+ data-list.stat list.stat vector.stat
+ descript.stat loop.stat weighting.data
+ do-if.stat modify-vars.stat weighting.stat
+ do-repeat.stat print.stat
+ expression.stat process-if.stat
+
+Mon Mar 24 21:47:31 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: @ALLOCA@ is on list of source files instead of
+ alloca.c. Added $(srcdir)/ to version.c reference. Changed to
+ pkgdatadir (/usr/share) for pkgsysconfdir, from pkglibdir
+ (/usr/lib). Removed some of extra distfiles. Added bogus `check'
+ target.
+
+ * Made transition release x1.
+
+Sun Mar 2 20:51:28 1997 Ben Pfaff <blp@gnu.org>
+
+ No longer uses debmake:
+
+ * Makefile.am: Installs documentation according to Debian policy
+ manual. New targets `private-uninstall', `install-data-hook' to
+ help implement this. `debian' target also revised.
+
+ * configure.in: Sets up for Debian installation depending on
+ DEBIAN environment variable. Also, improved & fixed (hopefully)
+ the scheme for detecting patchlevel.
+
+ * Made patchlevel 193.
+
+Wed Feb 19 21:30:31 1997 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 192.
+
+Sun Feb 16 20:57:20 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 191.
+
+Sat Feb 15 21:26:53 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Removed `descript.g' from sources.
+
+ * Made patchlevel 190.
+
+Fri Feb 14 23:32:58 1997 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * configure.in: Fixed test for max number of digits in an `int' to
+ use char[] rather than int[].
+
+ * Made patchlevel 189.
+
+Tue Feb 4 15:15:50 1997 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Fixed some problems with `--with-checker' flag and
+ with detection of available libraries; no longer any lines longer
+ than 79 characters.
+
+ * Made patchlevel 188.
+
+Wed Jan 22 21:54:00 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Add sysfile-info.c to sources.
+
+ * TODO: Moved some notes to different files where they are more
+ appropriate.
+
+ * prefh.orig: (macros STORE_2 and LOAD_2) Always load/store as
+ little-endian.
+
+ * Made patchlevel 187.
+
+Sun Jan 19 14:22:11 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added rename-vars.c to sources. Added to distclean
+ files.
+
+ * TODO: Updates.
+
+ * Made patchlevel 186.
+
+Thu Jan 16 13:08:57 1997 Ben Pfaff <blp@gnu.org>
+
+ * Most files have updated copyright notices for 1997.
+
+ * Makefile.am: Added modify-vars.c to source files. Also changed
+ `lynx' to $(HTML_FORMATTER), etc. Changed messages.
+
+ * TODO: Updates.
+
+ * Made patchlevel 185.
+
+Sat Jan 11 15:44:15 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: By default, now installs config files in pkglibdir,
+ generally /usr/local/lib/fiasco.
+
+ * TODO: Updated.
+
+ * prefh.orig: Added `/etc/fiasco' to config paths. Removed
+ $ARCH/$VER dirs from include paths.
+
+ * Made patchlevel 184.
+
+Fri Jan 10 20:22:08 1997 Ben Pfaff <blp@gnu.org>
+
+ * debian/changelog, debian/control, debian/copyright, debian/dirs,
+ debian/info, debian/menu, debian/rules: Added Debian GNU/Linux
+ control files.
+
+ * Makefile.am: Added sfmP.h to source files. Added several files
+ to the list of distfiles. dist-hook now copies debian control
+ files. New targets `debian', `debian-clean', `debian-clean-full'.
+
+ * confh.in: Defines PATCHLEVEL.
+
+ * configure.in: Adds the current patchlevel to the version
+ number. Versions are now of the form `1.2.3pl456'. Determines
+ the patchlevel based on directory name and contents of file
+ PATCHLEVEL.
+
+ * reconfigure: Passes automake `--strictness=foreign'.
+
+ * Made patchlevel 183.
+
+Thu Jan 2 19:08:23 1997 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 182.
+
+Wed Jan 1 22:08:10 1997 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 181.
+
+Wed Jan 1 17:00:59 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: New target for test/sort.data.
+
+ * Made patchlevel 180.
+
+Sun Dec 29 21:36:48 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 179.
+
+Tue Dec 24 20:42:32 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 178.
+
+Sun Dec 22 23:10:39 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added heap.c, heap.h to source files. Added
+ new html files to distfiles & maintainer-clean files.
+
+ * configure.in: Tests for presence of getpid(), sys/types.h.
+
+ * prefh.orig: #defines mkdir() for MS-DOS compatibility.
+
+ * Made patchlevel 177.
+
+Sat Dec 21 21:51:04 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added README.html, LANGUAGE.html to list of
+ distfiles. Added README, LANGUAGE to list of maintainer-clean
+ files. Added .html to suffixes. Added .html implicit rule that
+ calls `lynx -dump -nolist'.
+
+ * Made patchlevel 176.
+
+Tue Dec 17 18:57:59 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 175.
+
+Sun Dec 15 15:32:16 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added vfmP.c, qsort, sort.c to list of source
+ files.
+
+ * prefh.orig: Subtle changes to MAX_WORKSPACE, ALWAYS_PAGE,
+ NEVER_PAGE, DEMAND_PAGE macro meanings.
+
+ * Made patchlevel 174.
+
+Sat Dec 14 10:35:30 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 173.
+
+Fri Dec 13 21:30:53 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added autorecode.c to source files.
+
+ * prefh.orig: Fixed path GROFF_FONT_PATH.
+
+ * Made patchlevel 172.
+
+Fri Dec 6 23:53:47 1996 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 171.
+
+Wed Dec 4 21:34:17 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 170.
+
+Sun Dec 1 17:19:00 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 169.
+
+Thu Nov 28 23:14:07 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added `set.q' to list of source files.
+
+ * Made patchlevel 168.
+
+Thu Nov 28 19:46:10 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 167.
+
+Wed Nov 27 23:18:35 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added `sfm-write.c' to list of source files.
+
+ * confh.in: New #defines RELEASE_NO, SUB_RELEASE_NO, and
+ SPEC_RELEASE_NO for each part of a version number of form 1.2.3.
+
+ * configure.in: Computes RELEASE_NO, etc., by breaking apart
+ VERSION.
+
+ * prefh.orig: (defn of int32, flt64) Formatting fixes.
+ (FLT64_MAX) New define.
+
+ * Made patchlevel 166.
+
+Sun Nov 24 14:53:53 1996 Ben Pfaff <blp@gnu.org>
+
+ * Wow, it's been almost two weeks since the last update, hard to
+ believe.
+
+ * All source files: Updated e-mail address.
+
+ * prefh.orig: local_alloc() calls xmalloc() under Checker because
+ Checker can keep track of heap blocks much more accurately.
+
+ * Made patchlevel 165.
+
+Mon Nov 11 15:34:09 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 164.
+
+Thu Nov 7 20:52:28 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 163.
+
+Thu Nov 7 17:29:16 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 162.
+
+Thu Nov 7 15:48:52 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 161.
+
+Tue Nov 5 18:34:59 1996 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 160.
+
+Mon Nov 4 22:03:28 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added get.c.
+
+ * TODO: Updated.
+
+ * Made patchlevel 159.
+
+Sun Nov 3 12:24:36 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added sfm.h, sfm-read.c to source files.
+
+ * Made patchlevel 158.
+
+Wed Oct 30 17:13:08 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added dist-zip target to AUTOMAKE_OPTIONS.
+
+ * acconfig.h: Added FPREP_* defines.
+
+ * configure.in: Added checks for the sizes of floating-point
+ types. Added a test for the internal floating-point
+ representation of the host architecture.
+
+ * prefh.orig: Renamed `ATTRIBUTION' macro as `__attribute__'. All
+ references changed. Defines `flt64' 64-bit floating-point for use
+ with system files.
+ [FPREP==FPREP_IEEE754 && __GNUC__ && (ENDIAN==BIG ||
+ ENDIAN==LITTLE] Defines SECOND_LOWEST_VALUE macro.
+
+ * Made patchlevel 157.
+
+Sat Oct 26 23:06:06 1996 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Checks sizes of short, int, long, long long.
+
+ * prefh.orig: Defines new type int32 for use with system
+ files.
+
+ * Made patchlevel 156.
+
+Sat Oct 26 20:46:31 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 155.
+
+Sat Oct 26 10:39:25 1996 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 154.
+
+Thu Oct 24 20:13:42 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added back in these files: recode.c, sample.c,
+ sel-if.c. Also added files somP.h, hash.c that should've been
+ there anyway.
+
+ * TODO: Updated.
+
+ * configure.in: Checks for strncasecmp in place of strcasecmp.
+
+ * Made patchlevel 153.
+
+Thu Oct 24 17:47:14 1996 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * Made patchlevel 152.
+
+Wed Oct 23 21:53:43 1996 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Organized.
+
+ * Made patchlevel 151.
+
+Tue Oct 22 17:27:04 1996 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Culled old notes.
+
+ * Made patchlevel 150.
+
+Mon Oct 21 20:39:59 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 149.
+
+Sun Oct 20 13:45:28 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added back in `numeric.c', `print.c', `title.c'.
+ Defined ETAGS_ARGS.
+
+ * Made patchlevel 148.
+
+Sun Oct 20 09:04:15 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 147.
+
+Fri Oct 18 19:46:49 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 146.
+
+Sun Sep 29 19:37:03 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 145.
+
+Sat Sep 28 21:28:07 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added to DISTCLEANFILES.
+
+ * Made patchlevel 144.
+
+Fri Sep 27 20:08:39 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 143.
+
+Thu Sep 26 22:20:26 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added list.c back into the list of source files.
+
+ * Made patchlevel 142.
+
+Wed Sep 25 19:36:11 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Updated for new files.
+
+ * Made patchlevel 141.
+
+Tue Sep 24 18:39:09 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 140.
+
+Sat Sep 21 23:16:31 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 139.
+
+Fri Sep 20 22:52:28 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 138.
+
+Thu Sep 12 18:40:33 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 137.
+
+Wed Sep 11 22:01:41 1996 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Added timestamp.
+
+ * prefh.orig: Removed `/usr/local/share/fiasco' and
+ `/usr/share/fiasco' from CONFIG_PATH as per the Linux FSSTND,
+ which specifies that programs should never give an explicit
+ `/usr(/local)/share' path.
+
+ * Made patchlevel 136.
+
+Tue Sep 10 21:39:00 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added `display.c' back in.
+
+ * TODO: Addition.
+
+ * Made patchlevel 135.
+
+Mon Sep 9 21:43:13 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added `split-file.c' back into the project.
+
+ * Made patchlevel 134.
+
+Sat Sep 7 22:35:12 1996 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Updated.
+
+ * prefh.orig: (local_strdup) Moved to misc.h.
+
+ * Made patchlevel 133.
+
+Thu Sep 5 22:05:56 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Changed `prologue.ps' references to `ps-prologue'.
+
+ * Made patchlevel 132.
+
+Wed Sep 4 21:45:35 1996 Ben Pfaff <blp@gnu.org>
+
+ * prefh.orig: New i18n defines.
+
+ * This patchlevel doesn't even compile.
+
+ * Made patchlevel 131.
+
+Sat Aug 31 23:52:38 1996 Ben Pfaff <blp@gnu.org>
+
+ * TODO: Addition.
+
+ * Made patchlevel 130.
+
+Thu Aug 29 21:36:41 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 129.
+
+Sat Aug 24 23:26:00 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: New target "private-install" to install config files
+ to $HOME/.fiasco.
+
+ * configure.in: Now that I have made a less-bogus Checker
+ distribution, removed `-b i486-linuxaout -V 2.6.3' from
+ AC_ARG_WITH(checker, ...).
+
+ * Made patchlevel 127 somewhere in there.
+
+ * Made patchlevel 128.
+
+Sun Aug 11 21:31:22 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Changed DISTCLEANFILES.
+
+ * Does not compile.
+
+ * Made patchlevel 126.
+
+Sat Aug 10 23:28:17 1996 Ben Pfaff <blp@gnu.org>
+
+ * reconfigure: Calls `autoheader' twice: once at the beginning,
+ once after make maintainer-clean.
+
+ * Made patchlevel 125.
+
+Thu Aug 8 22:31:11 1996 Ben Pfaff <blp@gnu.org>
+
+ * reconfigure: `autoheader' now first operation performed.
+
+ * Made patchlevel 124.
+
+Sat Aug 3 20:50:35 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added postscript.c to list of source files.
+
+ * configh.in: Removed since autoheader can regenerate it.
+
+ * configure.in: Improved tests for (ncurses or termcap) and
+ (history and/or readline) libraries and associated headers. Added
+ check for strcasecmp(). Changed default gcc CFLAGS.
+
+ * prefh.orig: Removed `.' from GROFF_FONT_PATH.
+ (local_alloc, local_free) New functions.
+
+ * reconfigure: Added call to autoheader.
+
+ * Made patchlevel 123.
+
+Sat Jul 27 22:32:38 1996 Ben Pfaff <blp@gnu.org>
+
+ * There were some problems with the patchfiles so I had to merge
+ what was previously patchlevels 121 and 122; now everything from
+ what was previously 122 is called 121. Oh well, just don't let it
+ happen often.
+
+ * This patchlevel does not compile.
+
+ * configure: No longer included in patches to save lotsa space
+ when configure.in changes.
+
+ * configure.in: Changed the technique for detecting libraries.
+
+ * prefh.orig: Style changes; handles changed configure.in.
+
+ * Made patchlevel 122 (second edition).
+
+Tue Jul 23 21:48:36 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 121.
+
+Wed Jul 17 21:23:36 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 120.
+
+Tue Jul 16 22:10:04 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 119.
+
+Sun Jul 14 15:45:31 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 118.
+
+Fri Jul 12 22:03:36 1996 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added list.c to sources.
+
+ * Made patchlevel 117.
+
+Sat Jul 6 22:22:25 1996 Ben Pfaff <blp@gnu.org>
+
+ * configure.in: Removed reference to `malloc.h'.
+
+ * Made patchlevel 116.
+
+Fri Jul 5 20:16:19 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 115.
+
+Thu Jul 4 20:20:24 1996 Ben Pfaff <blp@gnu.org>
+
+ * prefh.orig: Changes to CONFIG_PATH, INCLUDE_PATH,
+ GROFF_FONT_PATH.
+
+ * Makefile.am: pkgdata_DATA file `output' changed to `devices'.
+
+Thu Jul 4 00:35:59 1996 Ben Pfaff <blp@gnu.org>
+
+ * TODO: doc fix.
+
+ * Made patchlevel 114.
+
+Tue Jul 2 22:13:23 1996 Ben Pfaff <blp@gnu.org>
+
+ * reconfigure: (new file) Runs all the programs necessary to
+ create a Makefile that includes dependencies.
+
+ * Made patchlevel 113.
+
+Mon Jul 1 22:13:39 1996 Ben Pfaff <blp@gnu.org>
+
+ * Made patchlevel 112.
+
+Mon Jul 1 13:00:00 1996 Ben Pfaff <blp@gnu.org>
+
+ * Most files: Changed references from `stat' (the original, rather
+ dull old name for this project) to `Fiasco' (the creative, rather
+ funny new name for this project).
+
+ * Made patchlevel 111.
+
+Sat Jun 29 17:40:47 1996 Ben Pfaff <blp@gnu.org>
+
+ * prefh.orig: changed default file search paths
+
+ * Made patchlevel 110.
+
+Fri Jun 28 11:59:48 1996 Ben Pfaff <blp@gnu.org>
+
+ * Added automake support; removed GNUmakefile and GNUmakefile.in.
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+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 a while. 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.
+
+ 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.
+
+`--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.
+
--- /dev/null
+## Process this file with automake to produce Makefile.in -*- makefile -*-
+
+AUTOMAKE_OPTIONS = gnits 1.4
+
+SUBDIRS = doc intl po lib src config tests
+
+pkgdocdir = $(prefix)/doc/@PACKAGE@
+pkgdoc_DATA = NEWS README TODO
+noinst_DATA = AUTHORS THANKS
+
+DISTCLEANFILES = pref.h
+
+dist-hook:
+ cp -rp $(top_srcdir)/sysdeps $(distdir)
+ cp -rp $(top_srcdir)/examples $(distdir)
+
+# A `private installation' in my terms is just having the appropriate
+# configuration files in ~/.pspp instead of a global configuration
+# location. So I let those files be installed automatically.
+
+private-install:
+ $(MAKE) private-install -C config
+private-uninstall:
+ $(MAKE) private-uninstall -C config
+
+EXTRA_DIST = NEWS ONEWS TODO pref.h.orig reconfigure configure
+
+MAINTAINERCLEANFILES = Makefile.in configure aclocal.m4 config.h.in
+
--- /dev/null
+PSPP NEWS -- history of user-visible changes.
+Time-stamp: <2000-01-07 20:50:17 blp>
+Copyright (C) 1996-9, 2000 Free Software Foundation, Inc.
+See the end for copying conditions.
+
+Please send PSPP bug reports to bug-gnu-pspp@gnu.org.
+\f
+Version 0.3.0 changes since 0.2.3:
+
+ Bugs fixed:
+
+ * Using alphanumeric variables in functions under AGGREGATE
+ segfaulted. Fixed.
+
+ * Under certain circumstances, the final case would be omitted
+ from the results of an AGGREGATE operation. Fixed.
+
+ * Undefined behavior was invoked by referencing a freed pointer
+ under certain circumstances. Fixed.
+
+ * A wrong record size was displayed when paging the active file to
+ disk. Fixed.
+
+ * Not having enough temporary space for sorting caused a core
+ dump. Fixed.
+
+ * Syntax errors in function descriptions on AGGREGATE caused core
+ dumps. Fixed.
+
+ * A null pointer was dereferenced, causing a core dump, when
+ PERCENTILES was specified on FREQUENCIES. This fixes the
+ problem, but PSPP still doesn't calculate percentiles.
+
+ * SORT always sorted in ascending order. Fixed.
+
+ * Some minor memory leaks in the expression parser were removed.
+
+ * Many assertions fixed for strict ANSI C compliance.
+
+ New features:
+
+ * SET ECHO ON now implemented, but turned off by default.
+
+ * PRINT specifier supported on END REPEAT.
+
+ Other:
+
+ * System libgmp2 library is used if installed instead of
+ unconditionally using the included libgmp2 subset.
+
+ * Extensive code cleanup, which continues.
+
+ * Added CORRELATIONS command parser, but not implemented.
+
+Version 0.2.3 changes since 0.2.2:
+
+ Bugs fixed:
+
+ * SPLIT FILE with a string variable caused a core dump. Fixed.
+
+ * Nested INCLUDEs didn't work. Fixed.
+
+ * The MATCH FILES procedure set the values of variables not present
+ to 0. It should have been SYSMIS. This is now fixed.
+
+ * The REMARK command was too aggressive about skipping lines. It
+ didn't like being the last command in a file.
+
+ * Comment parsing wasn't consistent with the rest of the code in its
+ idea of where one command ends and another starts. This meant
+ that sometimes commands would be mysteriously ignored. Thanks to
+ Dr. Dirk Melcher <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * The TABLE subcommand on MATCH FILES worked only erratically at
+ best. This fixes it. Thanks to Dr. Dirk Melcher
+ <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * VARIABLE LABELS rejected a slash before the first variable
+ specification, contradicting the documentation. Thanks to Walter
+ M. Gray <graywm@northernc.on.ca> for reporting this bug.
+
+ * Because of an incorrect optimization in memory allocation,
+ CROSSTABS sometimes segfaulted when asked to output multiple
+ tables. Thanks to Walter M. Gray <graywm@northernc.on.ca> for
+ reporting this bug.
+
+ * CROSSTABS didn't display value labels for column and row
+ variables. Thanks to Walter M. Gray <graywm@northernc.on.ca> for
+ reporting this bug.
+
+ * WRITE didn't write line ends. Fixed. Thanks to Dr. Dirk Melcher
+ <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * The TABLE subcommand on MATCH FILES worked only erratically at
+ best. This fixes it. Thanks to Dr. Dirk Melcher
+ <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * VARIABLE LABELS rejected a slash before the first variable
+ specification, contradicting the documentation. Thanks to Walter
+ M. Gray <graywm@northernc.on.ca> for reporting this bug.
+
+ * Because of an incorrect optimization in memory allocation,
+ CROSSTABS sometimes segfaulted when asked to output multiple
+ tables. Thanks to Walter M. Gray <graywm@northernc.on.ca> for
+ reporting this bug.
+
+ * CROSSTABS didn't display value labels for column and row
+ variables. Thanks to Walter M. Gray <graywm@northernc.on.ca> for
+ reporting this bug.
+
+ * WRITE didn't write line ends. Fixed. Thanks to Dr. Dirk Melcher
+ <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * MATCH FILES corrupted memory and dumped core on some syntax
+ errors. Fixed.
+
+ * MATCH FILES should set numeric values not available to the
+ system-missing value, not to 0. Thanks to Dr. Dirk Melcher
+ <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * KEEP didn't work properly on the SAVE procedure. Fixed. Thanks
+ to Ralf Geschke <ralf@kuerbis.org> for reporting this bug.
+
+ * Memory leak fix.
+
+ * Some systems didn't like the way open_file was coded. Thanks to
+ Hankin <hankin@rogue.consultco.com> for pointing this out.
+
+ * The SAVE procedure didn't save long string variables properly.
+ Fixed by this patch. Thanks to Hankin
+ <hankin@rogue.consultco.com> for this patch.
+
+ * Minor documentation fixes for MATCH FILES.
+
+Version 0.2.2 changes since 0.2.1:
+
+ Bugs fixed:
+
+ * Fix behavior of PRINT SPACE for negative arguments.
+
+ * Fix reading some unusual system files.
+
+ * Fix LIST problems with very long variables. Thanks to Hankin
+ <hankin@dunno.com> for this bug report.
+
+ * Fix problems with some string format specifiers.
+
+ * Fix use of $CASENUM in expressions. Thanks to Dirk Melcher
+ <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * Additional DATA LIST FREE and DATA LIST LIST fixes. Thanks to
+ Hankin <hankin@dunno.com> again on this one.
+
+ * Sometimes you may encounter a PSPP script that has to be
+ interpreted in interactive mode. Now you can use the -i flag to
+ do this.
+
+ * Warnings for egcs 1.1.1 cleaned up. (However you'll get lots of
+ `unused variable' warnings under gcc 2.7.2.3, fixing this will
+ take more effort.)
+
+ * Tests fixed.
+
+ * The files in gmp need the internationalization directory in
+ their include path. Thanks to OKUJI Yoshinori
+ <okuji@kuicr.kyoto-u.ac.jp> for pointing this out.
+
+Version 0.2.1 changes since 0.2.0:
+
+ Bugs fixed:
+
+ * Remember to include examples/ directory in distribution :-)
+
+ * Fixed gmp compile problems for some non-i386 architectures.
+ Thanks to Hans Olav Eggestad <olav@jordforsk.nlh.no> and others
+ for reporting this.
+
+ * DATA LIST FREE and DATA LIST LIST parsing of input files is now
+ matches the documented behavior exactly, and error messages are
+ more helpful. Thanks to Mark H. Wood <mwood@IUPUI.Edu>.
+
+Version 0.2.0 changes since 0.1.0:
+
+ Procedures now implemented:
+ * CROSSTABS. Please see documentation for caveats.
+
+ Transformations and utilities now implemented:
+ * AGGREGATE
+ * APPLY DICTIONARY
+ * CLEAR TRANSFORMATIONS
+ * DISPLAY (all subcommands).
+ * ERASE
+ * FLIP
+ * EXPORT
+ * HOST
+ * IMPORT
+ * MATCH FILES
+ * MATRIX DATA
+ * NEW FILE
+ * REPEATING DATA
+
+ Support for input and output through pipes: "|command" and
+ "command|" filenames; support for special filenames "-", "stdin",
+ "stdout", "stderr".
+
+ New command-line features:
+ * New option --testing-mode: Invoke heuristics to assist testing.
+ * New option --safer, -s: Don't allow certain unsafe operations.
+ * New option --command=CMD, -c CMD: Perform literal command CMD.
+ * rc file ~/.pspp/rc is executed before any other files.
+ * Now multiple syntax files can be specified.
+
+ Operator LAG is now implemented.
+
+ Added missing FILE subcommand to REREAD.
+
+ Table output manager completely rewritten.
+
+ Device configuration file syntax changed. You will need to
+ reinstall your `devices' file.
+
+ New output driver for HTML.
+
+ PostScript driver and prologue simplified.
+
+ Many bugs fixed. General source-code cleanup.
+
+ Added Texinfo documentation for:
+ * PSPP system file format
+ * PSPP portable file format
+ * How to write input for q2c parser generator
+ * HTML driver
+
+ PSPP language is now fully documented. Please report any
+ inaccuracies or omissions in the documentation.
+
+Changes for version 0.1.0:
+
+ First public release. For changes from unreleased development
+ versions, please see ONEWS.
+\f
+----------------------------------------------------------------------
+Copyright information:
+
+Copyright (C) 1996-9, 2000 Free Software Foundation, Inc.
+
+ Permission is granted to anyone to make or distribute verbatim
+ copies of this document as received, in any medium, provided that
+ the copyright notice and this permission notice are preserved, thus
+ giving the recipient permission to redistribute in turn.
+
+ Permission is granted to distribute modified versions of this
+ document, or of portions of it, under the above conditions,
+ provided also that they carry prominent notices stating who last
+ changed them.
+\f
+Local variables:
+version-control: never
+mode: indented-text
+end:
--- /dev/null
+PSPP NEWS -- history of user-visible changes.
+Time-stamp: <1998-08-14 10:45:12 blp>
+Copyright (C) 1996, 1997, 1998 Free Software Foundation, Inc.
+See the end for copying conditions.
+
+Please send PSPP bug reports to bug-gnu-pspp@gnu.org.
+\f
+* Changes for patchlevel 37:
+
+** Bugfixes.
+
+* Changes for patchlevel 36:
+
+** Documentation fixes.
+
+* Changes for patchlevel 35:
+
+** DO REPEAT works.
+
+** Removed PC+ emulation; merged X and Wnd emulations.
+
+** Many smaller bugfixes.
+
+* Changes for patchlevel 34:
+
+** More DO REPEAT work. Does not compile.
+
+* Changes for patchlevel 33:
+
+** Excised politically incorrect words.
+
+* Changes for patchlevel 32:
+
+** Worked on fixing DO REPEAT problems.
+
+* Changes for patchlevel 31:
+
+** Fixed packaging problems.
+
+* Changes for patchlevel 30:
+
+** Looks for include files and data file relative to the syntax file
+directory, not the current working directory.
+
+* Changes for patchlevel 29:
+
+** Add capability for PSPP syntax files to invoked as programs with
+`#!' notation.
+
+* Changes for patchlevels 20, 21, 22, 23, 24, 25, 26, 27, 28:
+
+** Bugfixes.
+
+* Changes for version 0.1.0:
+
+** Debian package support.
+
+* Changes for patchlevel 19:
+
+** Bugfixes.
+
+** Began PSPP FAQ list.
+
+* Changes for patchlevel 18:
+
+** Scratch variables are fully implemented. They are deleted after
+every procedure.
+
+** The virtual file manager has been completely rewritten. Although
+all known bugs have been fixed, the new object-oriented structure to
+vfm is so different that there are likely some that are
+as-yet-undiscovered.
+
+* Changes for patchlevel 14, 15, 16, 17:
+
+** Bugfixes.
+
+* Changes for patchlevels 12, 13:
+
+** Internationalization!
+
+* Changes for patchlevels 7, 8, 9, 10, 11:
+
+** Bugfixes.
+
+* Changes for patchlevel 6:
+
+** Removed the need for a `ps-fontmap' in the PostScript driver.
+This changes the options for the PostScript driver slightly.
+
+* Changes for new patchlevels 1, 2, 3, 4, 5:
+
+** Bugfixes.
+
+* Changes for interim releases x1, x2, x3:
+
+** Package changed from `flat' to `deep' format.
+
+* Changes for patchlevel 193:
+
+** No user-visible changes.
+
+* Changes for patchlevel 192:
+
+** Bugfixes.
+
+* Changes for patchlevel 191:
+
+** Reimplemented FREQUENCIES method of calculation--it should now be
+* acceptable to numerical analysts.
+
+* Changes for patchlevel 190:
+
+** Implemented PROCESS IF to be compatible with PC+.
+
+** Reimplemented DESCRIPTIVES method of calculation--it should now
+be acceptable to numerical analysts.
+
+** DESCRIPTIVES is now correct and complete--please report any bugs
+immediately.
+
+** Implemented SYSFILE INFO, although it is limited in the way it
+displays value labels.
+
+** SAVE now records the number of cases in the system file.
+
+* Changes for patchlevels 189, 188, 187:
+
+** Bugfixes.
+
+* Changes for patchlevel 186:
+
+** Bazillions of bugfixes, and more to come. This version ought to be
+much more usable than any previous.
+
+** Added RENAME VARIABLES command and tested it.
+
+* Changes for patchlevel 185:
+
+** Added MODIFY VARS command; poorly tested.
+
+** Bugfixes.
+
+* Changes for patchlevel 184:
+
+** Debianized and fixed a few packaging problems.
+
+** First ALPHA release.
+
+** Miscellaneous bugfixes.
+
+* Changes for patchlevel 182:
+
+* Added FILE LABEL, DOCUMENT, and DROP DOCUMENTS commands; not tested.
+
+* Changes for patchlevel 181:
+
+* Added FILTER command.
+
+* Changes for patchlevel 180:
+
+* SORT CASES bugfixes.
+
+* Changes for patchlevel 179:
+
+* SORT CASES implemented.
+
+* Changes for patchlevels 178, 177, 176, 175:
+
+* No user-visible changes; might not even compile.
+
+* Changes for patchlevel 174:
+
+** AUTORECODE has been newly implemented.
+
+* Changes for patchlevel 173:
+
+** Bugfixes.
+
+* Changes for patchlevel 172:
+
+** SET has been reintroduced. It is somewhat incomplete.
+
+** Bugfixes.
+
+* Changes for patchlevel 171:
+
+** Several bugfixes.
+
+** Minor language improvements.
+
+* Changes for patchlevel 170:
+
+** Input/output formats DOT, PCT, EDATE, SDATE are now supported but
+not tested.
+
+* Changes for patchlevel 169:
+
+** Several bugfixes.
+
+** Implemented custom currency formats (CCA ... CCE); not tested.
+
+* Changes for patchlevel 168:
+
+** No user-visible changes.
+
+* Changes for patchlevel 167:
+
+** Compression is now available on SAVE and XSAVE.
+
+* Changes for patchlevel 166:
+
+** SAVE and XSAVE are implemented. Compression is not yet available.
+
+* Changes for patchlevel 165:
+
+** GET is now fully implemented for both compressed and uncompressed
+system files.
+
+* Changes for patchlevel 164:
+
+** GET now works on system files (uncompressed only).
+
+* Changes for patchlevels 163, 162, 161, 160, 159, 158:
+
+** No user-visible changes.
+
+** Supports keywords LOWEST and HIGHEST on MISSING VALUES.
+
+* Changes for patchlevel 157:
+
+** Fixed longtime bug with cross-compilation.
+
+* Changes for patchlevel 156:
+
+** Fixed the (known) bugs introduced in patchlevel 155.
+
+** Fixed a longtime bug in RECODE that might have affected other
+transformations as well.
+
+* Changes for patchlevel 155:
+
+** A few bugs fixed, probably several introduced.
+
+* Changes for patchlevel 154:
+
+** FILE HANDLE now supports most of the SPSS/Wnd compatible features.
+
+* Changes for patchlevel 153:
+
+** PRINT now supports OUTFILE.
+
+** WRITE is now distinct from PRINT.
+
+** RECODE, SAMPLE, SELECT IF are re-enabled.
+
+* Changes for patchlevel 152:
+
+** Bugfixes for times & dates.
+
+** Misc. bugfixes.
+
+** System variables supported on expressions.
+
+* Changes for patchlevel 151:
+
+** Newly implemented input/output formats:
+
+Time/date output formats.
+Preliminary testing has been done on times & dates.
+
+* Changes for patchlevel 150:
+
+** Newly implemented input/output formats
+
+Zoned decimal input/output format.
+Time/date input formats, but not output formats.
+All of these are untested.
+
+* Changes for patchlevel 149:
+
+** Bugfixes.
+
+* Changes for patchlevel 148:
+
+** Many bugfixes.
+
+** Re-enabled the following transformations:
+
+LEAVE, NUMERIC, PRINT, PRINT EJECT, PRINT FORMATS, PRINT SPACE,
+STRING, TITLE, WRITE.
+
+* Changes for patchlevel 147:
+
+** Crushed partial tables are much better.
+
+* Changes for patchlevel 146:
+
+** Bugfixes.
+
+** Crushed tables are working better!
+
+** Still pretty broken.
+
+* Changes for patchlevel 145:
+
+** Bugfixes.
+
+** Broken stuff.
+
+* Changes for patchlevels 144, 143:
+
+** Bugfixes.
+
+* Changes for patchlevel 142:
+
+** LIST procedure is back, but not well-implemented.
+
+* Changes for patchlevel 141:
+
+** No user-visible changes.
+
+* Changes for patchlevels 140, 139, 138:
+
+** Worked on manual.
+
+** Minor bugfixes.
+
+* Changes for patchlevel 136:
+
+** Began revisions to manual.
+
+** Changed default path for configuration files.
+
+* Changes for patchlevel 135:
+
+** PostScript driver bugfixes.
+
+** Many memory leaks eliminated.
+
+** Miscellaneous Bugfixes.
+
+* Changes for patchlevel 134:
+
+** SPLIT FILE works again.
+
+** Documentation changes in README.
+
+** New documentation in LANGUAGE, BUGS.
+
+* Changes for patchlevel 133:
+
+** PostScript driver supports encodings.
+
+It also works now, as opposed to the brokenness of the last
+patchlevel.
+
+* Changes for patchlevel 132:
+
+** PostScript driver supports font changes!
+
+Not well tested.
+
+* Changes for patchlevel 131:
+
+** Does not compile.
+
+* Changes for patchlevel 130:
+
+** Generated PostScript code is smaller in size.
+
+This is because, as long as the PostScript option `optimize-line-size'
+is at least 1, individual contiguous short lines are consolidated into
+longer monster lines.
+
+* Changes for patchlevel 129:
+
+** PostScript output much improved.
+
+Mirror no longer necessary.
+
+* Changes for patchlevel 128:
+
+** Try out the PostScript driver, if you've got a mirror handy.
+
+* Changes for patchlevel 126:
+
+** Does not compile.
+
+* Changes for patchlevel 125:
+
+** No user-visible changes.
+
+* Changes for patchlevel 124:
+
+** PostScript driver. Don't use it yet.
+
+** Bugfixes.
+
+* Changes for patchlevel 123:
+
+** No user-visible changes.
+
+* Changes for patchlevel 122:
+
+** FREQUENCIES procedure is more complete.
+
+It can now print out sorted frequency tables as well as all statistics
+except median. No percentiles. Full syntax. No integer mode.
+
+* Changes for patchlevel 121:
+
+** Compiles again!
+
+** FREQUENCIES procedure works but it is incomplete.
+
+* Changes for patchlevels 120, 119:
+
+** Does not compile.
+
+* Changes for patchlevel 118:
+
+** Does not compile.
+
+** Bugfix regarding titles on LIST procedure.
+
+* Changes for patchlevel 117:
+
+** LIST procedure implemented.
+
+** Bugfix regarding unsupported REMARK utility.
+
+* Changes for patchlevel 116:
+
+** Does not compile.
+
+* Changes for patchlevel 115:
+
+** New output driver initialization interface.
+
+*** Changed option syntax.
+
+`-o driver' is the new syntax. The default driver is named `default'.
+
+*** The initialization file `output' has been renamed `devices'.
+
+*** Driver names actually specify categories.
+
+Each driver name specified can actually result in 0, 1, 2, or any
+greater number of actual drivers being used, depending solely on the
+contents of the `devices' output initialization file.
+
+*** The driver initialization file is read in a `termcap'-like manner.
+
+That is, it determines whether to use a driver based on the parameters
+passed to it, rather than mainly on the contents of the `devices' file
+plus some goofy hacks with command-line options.
+
+*** Macros defined in the `devices' file can be overridden.
+
+Do it by specifying a definition on the command line of form
+`KEY=VALUE'. See `devices' for details.
+
+** Short form of option `--verbose' changed to `-V'.
+
+** New option `-v' or `--verbose'.
+
+`-v' causes PSPP to display more info about what it's doing.
+Multiple `-v's display even more.
+
+** Support for small 25-line screens.
+
+The ASCII driver minimum for page length is now 15 lines instead of
+29.
+
+* Changes for patchlevel 114:
+
+** Rich text now supported in the ascii driver.
+
+The style changes are done with overstriking or with defined
+sequences.
+
+** New ascii output driver option `carriage-return-style'.
+
+This can be set to `cr' or to `bs', depending on whether returning to
+the left margin should be done with an ASCII CR or with multiple
+backspaces.
+
+* Changes for patchlevel 113:
+
+** Table titles are more complete.
+
+Now they include a description of the table contents.
+
+* Changes for patchlevel 112:
+
+** Tables now are preceded by a descriptive `title'.
+
+This line shows what procedure emitted it, etc.
+
+** Some tables are now divided into multiple columns.
+
+These columns are displayed across the page in order to save vertical
+space.
+
+* Changes for patchlevel 111:
+
+** Bugfixes.
+
+* Changes for patchlevel 110:
+
+** `stat' has now been renamed `PSPP', for `PSPP Implements Accurate
+Statistical COmputations'! Let's all celebrate the clever acronym!
+
+** Bugfixes.
+
+* Changes for patchlevel 109:
+
+** Bugfixes.
+\f
+----------------------------------------------------------------------
+Copyright information:
+
+Copyright (C) 1996, 1997, 1998 Free Software Foundation, Inc.
+
+ Permission is granted to anyone to make or distribute verbatim
+ copies of this document as received, in any medium, provided that
+ the copyright notice and this permission notice are preserved, thus
+ giving the recipient permission to redistribute in turn.
+
+ Permission is granted to distribute modified versions of this
+ document, or of portions of it, under the above conditions,
+ provided also that they carry prominent notices stating who last
+ changed them.
+\f
+Local variables:
+version-control: never
+mode: text
+mode: outline-minor
+end:
--- /dev/null
+PSPP is a program for statistical analysis of sampled data. It
+interprets commands in the SPSS language and produces tabular output
+in ASCII or PostScript format.
+
+PSPP development is ongoing. It already supports a large subset of
+SPSS's transformation language. Its statistical procedure support is
+currently limited, but growing.
+
+Source code for the latest development release of PSPP is available at
+ftp://alpha.gnu.org/gnu/pspp and ftp://pspp.stat.wisc.edu/pub/PSPP.
+
+For information on differences from previous versions, please see file
+NEWS. Full documentation on PSPP's language and information on known
+bugs can in the doc/ directory.
+
+Questions and comments regarding PSPP can be sent to Ben Pfaff
+<blp@gnu.org>. PSPP bug reports should be sent to
+bug-gnu-pspp@gnu.org.
--- /dev/null
+Thanks to...
+
+ * David MacKenzie for writing Autoconf, the automatic configuration
+ tool.
+ * David MacKenzie and Tom Tromey for writing Automake, the tool for
+ generating `Makefile's.
+ * Ulrich Drepper et al for writing gettext, the GNU
+ internationalization package.
+ * François Pinard for advice on proceeding with development.
+ * Jim Van Zandt for Debian packaging and suggestions.
+ * Torbj"orn Granlund and TMG Datakonsult for GNU gmp2 used in the
+ portable file routines.
--- /dev/null
+Time-stamp: <1999-12-30 22:58:42 blp>
+
+TODO
+----
+
+The way that data-in.c and data-out.c deal with strings is wrong. Instead of
+the way it's done now, we should make it dynamically allocate a buffer and
+return a pointer to it. This is a much safer interface.
+
+Add libplot output driver. Suggested by Robert S. Maier
+<rsm@math.arizona.edu>: "it produces output in idraw-editable PS format, PCL5
+format, xfig-editable format, Illustrator format,..., and can draw vector
+graphics on X11 displays also".
+
+Storage of value labels on disk is inefficient. Invent new data structure.
+
+Add an output flag which would cause a page break if a table segment could fit
+vertically on a page but it just happens to be positioned such that it won't.
+
+Fix spanned joint cells, i.e., EDLEVEL on crosstabs.stat.
+
+Cell footnotes.
+
+PostScript driver should emit thin lines, then thick lines, to optimize time
+and space.
+
+New functions? var_name_or_label(), tab_value_or_label()
+
+Should be able to bottom-justify cells. It'll be expensive, though, by
+requiring an extra metrics call.
+
+Perhaps instead of the current lines we should define the following line types:
+null, thin, thick, double. It might look pretty classy.
+
+Perhaps thick table borders that are cut off by a page break should decay to
+thin borders. (i.e., on a thick bordered table that's longer than one page,
+but narrow, the bottom border would be thin on the first page, and the top and
+bottom borders on middle pages.)
+
+Support multi-line titles on tables. (For the first page only, presumably.)
+
+Rewrite the convert_F() function in data-out.c to be nicer code.
+
+In addition to searching the source directory, we should search the current
+directory (for data files). (Yuck!)
+
+Fix line-too-long problems in PostScript code, instead of covering them up.
+setlinecap is *not* a proper solution.
+
+Need a better way than MAX_WORKSPACE to detect low-memory conditions.
+
+When malloc() returns 0, page to disk and free() unnecessary data.
+
+Remove ccase * argument from procfunc argument to procedure().
+
+See if process_active_file() has wider applicability.
+
+Looks like there's a potential problem with value labels--we use free_val_lab
+from avl_destroy(), but free_val_lab doesn't decrement the reference count, it
+just frees the label. Check into this sometime soon.
+
+Eliminate private data in struct variable through use of pointers.
+
+Fix som_columns().
+
+There needs to be another layer onto the lexer, which should probably be
+entirely rewritten anyway. The lexer needs to read entire *commands* at a
+time, not just a *line* at a time. This would vastly simplify the
+(yet-to-be-implemented) logging mechanism and other stuff as well.
+
+Has glob.c been pared down enough?
+
+Improve interactivity of output by allowing a `commit' function for a page.
+This will also allow for infinite-length pages.
+
+All the tests need to be looked over. Some of the SET calls don't make sense
+any more.
+
+Implement thin single lines, should be pretty easy now.
+
+SELECT IF should be moved before other transformations whenever possible. It
+should only be impossible when one of the variables referred to in SELECT IF is
+created or modified by a previous transformation.
+
+The manual: add text, add index entries, add examples.
+
+The inline file should be improved: There should be *real* detection of whether
+it is used (in dfm.c:cmd_begin_data), not after-the-fact detection.
+
+Figure out a stylesheet for messages displayed by PSPP: i.e., what quotation
+marks around filenames, etc.
+
+Data input and data output are currently arranged in reciprocal pairs: input is
+done directly, with write_record() or whatever; output is done on a callback
+event-driven basis. It would definitely be easier if both could be done on a
+direct basis, with read_record() and write_record() routines, with a coroutine
+implementation (see Knuth). But I'm not sure that coroutines can be
+implemented in ANSI C. This will require some thought. Perhaps 0.4.0 can do
+this.
+
+New SET subcommand: OUTPUT. i.e., SET OUTPUT="filename" to send output to that
+file; SET OUTPUT="filename"(APPEND) to append to that file; SET OUTPUT=DEFAULT
+to reset everything. There might be a better approach, though--think about it.
+
+HDF export capabilities (http://hdf.ncsa.uiuc.edu). Suggested by Marcus
+G. Daniels <mgd@santafe.edu>.
+
+From Zvi Grauer <z.grauer@csuohio.edu> and <zvi@mail.ohio.net>:
+
+ 1. design of experiments software, specifically Factorial, response surface
+ methodology and mixrture design.
+
+ These would be EXTREMELY USEFUL for chemists, engineeris, and anyone
+ involved in the production of chemicals or formulations.
+
+ 2. Multidimensional Scaling analysis (for market analysis) -
+
+ 3. Preference mapping software for market analysis
+
+ 4. Hierarchical clustering (as well as partition clustering)
+
+ 5. Conjoint analysis
+
+ 6. Categorical data analsys ?
+
+IDEAS
+-----
+
+In addition to an "infinite journal", we should keep a number of
+individual-session journals, pspp.jnl-1 through pspp.jnl-X, renaming and
+deleting as needed. All of the journals should have date/time comments.
+
+Qualifiers for variables giving type--categorical, ordinal, ...
+
+Analysis Wizard
+
+Consider consequences of xmalloc(), fail(), hcf() in interactive
+use:
+a. Can we safely just use setjmp()/longjmp()?
+b. Will that leak memory?
+i. I don't think so: all procedure-created memory is either
+garbage-collected or globally-accessible.
+ii. But you never know... esp. w/o Checker.
+c. Is this too early to worry? too late?
+
+Need to implement a shared buffer for funny functions that require relatively
+large permanent transient buffers (1024 bytes or so), that is, buffers that are
+permanent in the sense that they probably shouldn't be deallocated but are only
+used from time to time, buffers that can't be allocated on the stack because
+they are of variable and unpredictable but usually relatively small (usually
+line buffers). There are too many of these lurking around; can save a sizeable
+amount of space at very little overhead and with very little effort by merging
+them.
+
+Clever multiplatform GUI idea (due partly to John Williams): write a GUI in
+Java where each statistical procedure dialog box could be downloaded from the
+server independently. The statistical procedures would run on (the/a) server
+and results would be reported through HTML tables viewed with the user's choice
+of web browsers. Help could be implemented through the browser as well.
+
+Design a plotting API, with scatterplots, line plots, pie charts, barcharts,
+Pareto plots, etc., as subclasses of the plot superclass.
+
+HOWTOs
+------
+
+1. How to add an operator for use in PSPP expressions:
+
+a. Add the operator to the enumerated type at the top of expr.h. If the
+operator has arguments (i.e., it's not a terminal) then add it *before*
+OP_TERMINAL; otherwise, add it *after* OP_TERMINAL. All these begin with OP_.
+
+b. If the operator's a terminal then you'll want to design a structure to hold
+its content. Add the structure to the union any_node. (You can also reuse one
+of the prefab structures, of course.)
+
+c. Now switch to expr-prs.c--the module for expression parsing. Insert the
+operator somewhere in the precedence hierarchy.
+
+(1) If you're adding a operator that is a function (like ACOS, ABS, etc.) then
+add the function to functab in `void init_functab(void)'. Order is not
+important here. The first element is the function name, like "ACOS". The
+second is the operator enumerator you added in expr.h, like OP_ARCOS. The
+third element is the C function to parse the PSPP function. The predefined
+functions will probably suit your needs, but if not, you can write your own.
+The fourth element is an argument to the parsing function; it's only used
+currently by generic_str_func(), which handles a rather general syntax for
+functions that return strings; see the comment at the beginning of its code for
+details.
+
+(2) If you're adding an actual operator you'll have to put a function in
+between two of the operators there already in functions `exprtype
+parse_*(any_node **n)'. Each of these stores the tree for its result into *n,
+and returns the result type, or EX_ERROR on error. Be sure to delete all the
+allocated memory on error before returning.
+
+d. Add the operator to the table `op_desc ops[OP_SENTINEL+1]' in expr-prs.c,
+which has an entry for every operator. These entries *must* be in the same
+order as they are in expr.h. The entries have the form `op(A,B,C,D)'. A is
+the name of the operator as it should be printed in a postfix output format.
+For example, the addition operator is printed as `plus'. B is a bitmapped set
+of flags:
+
+* Set the 001 bit (OP_VAR_ARGS) if the operator takes a variable number of
+arguments. If a function can take, say, two args or three args, but no other
+numbers of args, this is a poor way to do it--instead implement the operator as
+two separate operators, one with two args, the other with three. (The main
+effect of this bit is to cause the number of arguments to be output to the
+postfix form so that the expression evaluator can know how many args the
+operator takes. It also causes the expression optimizer to calculate the
+needed stack height differently, without referencing C.)
+
+* Set the 002 bit (OP_MIN_ARGS) if the operator can take an optional `dotted
+argument' that specified the minimum number of non-SYSMIS arguments in order to
+have a non-SYSMIS result. For instance, MIN.3(e1,e2,e3,e4,e5) returns a
+non-SYSMIS result only if at least 3 out of 5 of the expressions e1 to e5 are
+not missing.
+
+Minargs are passed in the nonterm_node structure in `arg[]''s elements past
+`n'--search expr-prs.c for the words `terrible crock' for an example of this.
+
+Minargs are output to the postfix form. A default value is output if none was
+specified by the user.
+
+You can use minargs for anything you want--they're not limited to actually
+describing a minimum number of valid arguments; that's just what they're most
+*commonly* used for.
+
+* Set the 004 bit (OP_FMT_SPEC) if the operator has an argument that is a
+format specifier. (This causes the format specifier to be output to the
+postfix representation.)
+
+Format specs are passed in the nonterm_node structure in the same way as
+minargs, except that there are three args, in this order: type, width, # of
+decimals--search expr-prs.c for the words `is a crock' for an example of this.
+
+* Set the 010 bit (OP_ABSORB_MISS) if the operator can *ever* have a result of
+other than SYSMIS when given one or more arguments of SYSMIS. Operators
+lacking this bit and known to have a SYSMIS argument are short-circuited to
+SYSMIS by the expression optimizer.
+
+* If your operator doesn't fit easily into the existing categories,
+congratulations, you get to write lots of code to adjust everything to cope
+with this new operator. Are you really sure you want to do that?
+
+C is the effect the operator has on stack height. Set this to `varies' if the
+operator has a variable number of arguments. Otherwise this 1, minus the
+number of arguments the operator has. (Since terminals have no arguments, they
+have a value of +1 for this; other operators have a value of 0 or less.)
+
+D is the number of items output to the postfix form after the operator proper.
+This is 0, plus 1 if the operator has varargs, plus 1 if the operator has
+minargs, plus 3 if the operator has a format spec. Note that minargs/varargs
+can't coexist with a format spec on the same operator as currently coded. Some
+terminals also have a nonzero value for this but don't fit into the above
+categories.
+
+e. Switch to expr-opt.c. Add code to evaluate_tree() to evaluate the
+expression when all arguments are known to be constants. Pseudo-random
+functions can't be evaluated even if their arguments are constants. If the
+function can be optimized even if its arguments aren't all known constants, add
+code to optimize_tree() to do it.
+
+f. Switch to expr-evl.c. Add code to evaluate_expression() to evaluate the
+expression. You must be absolutely certain that the code in evaluate_tree(),
+optimize_tree(), and evaluate_expression() will always return the same results,
+otherwise users will get inconsistent results, a Bad Thing. You must be
+certain that even on boundary conditions users will get identical results, for
+instance for the values 0, 1, -1, SYSMIS, or, for string functions, the null
+string, 1-char strings, and 255-char strings.
+
+g. Test the code. Write some test syntax files. Examine the output carefully.
+
+NOTES ON SEARCH ALGORITHMS
+--------------------------
+
+1. Trees are nicer when you want a sorted table. However, you can always
+sort a hash table after you're done adding values.
+
+2. Brent's variation of Algorithm D is best when the table is fixed: it's
+memory-efficient, having small, fixed overhead. It's easier to use
+when you know in advance how many entries the table will contain.
+
+3. Algorithm L is rather slow for a hash algorithm, however it's easy.
+
+4. Chaining is best in terms of speed; ordered/self-ordering is even
+better.
+
+5. Rehashing is slow.
+
+6. Might want to decide on an algorithm empirically since there are no
+clear mathematical winners in some cases.
+
+7. gprof? Hey, it works!
+
+MORE NOTES/IDEAS/BUGS
+---------------------
+
+The behavior of converting a floating point to an integer when the value of the
+float is out of range of the integer type is UNDEFINED! See ANSI 6.2.1.3.
+
+What should we do for *negative* times in expressions?
+
+Sometimes very wide (or very tall) columns can occur in tables. What is a good
+way to truncate them? It doesn't seem to cause problems for the ascii or
+postscript drivers, but it's not good in the general case. Should they be
+split somehow? (One way that wide columns can occur is through user request,
+for instance through a wide PRINT request--try time-date.stat with a narrow
+ascii page or with the postscript driver on letter size paper.)
+
+NULs in input files break the products we're replacing: although it will input
+them properly and display them properly as AHEX format, it truncates them in A
+format. Also, string-manipulation functions such as CONCAT truncate their
+results after the first NUL. This should simplify the result of PSPP design.
+Perhaps those ugly a_string, b_string, ..., can all be eliminated.
+
+From Moshe Braner <mbraner@nessie.vdh.state.vt.us>: An idea regarding MATCH
+FILES, again getting BEYOND the state of SPSS: it always bothered me that if I
+have a large data file and I want to match it to a small lookup table, via
+MATCH FILES FILE= /TABLE= /BY key, I need to SORT the large file on key, do the
+match, then (usually) re-sort back into the order I really want it. There is
+no reason to do this, when the lookup table is small. Even a dumb sequential
+search through the table, for every case in the big file, is better, in some
+cases, than the sort. So here's my idea: first look at the /TABLE file, if it
+is "small enough", read it into memory, and create an index (or hash table,
+whatever) for it. Then read the /FILE and use the index to match to each case.
+OTOH, if the /TABLE is too large, then do it the old way, complaining if either
+file is not sorted on key.
+
+-------------------------------------------------------------------------------
+Local Variables:
+mode: text
+fill-column: 79
+End:
--- /dev/null
+/* Special definitions, to process by autoheader.
+ Copyright (C) 1997-9, 2000 Free Software Foundation. */
+
+/* Definitions for byte order, according to significance of bytes, from low
+ addresses to high addresses. The value is what you get by putting '4'
+ in the most significant byte, '3' in the second most significant byte,
+ '2' in the second least significant byte, and '1' in the least
+ significant byte. These definitions never need to be modified. */
+#define BIG 4321 /* 68k */
+#define LITTLE 1234 /* i[3456]86 */
+#define UNKNOWN 0000 /* Endianness must be determined at runtime. */
+
+/* Definitions for floating-point representation. */
+#define FPREP_IEEE754 754 /* The usual IEEE-754 format. */
+#define FPREP_UNKNOWN 666 /* Triggers an error at compile time. */
+
+/* We want prototypes for all the GNU extensions. */
+#define _GNU_SOURCE 1
+
+/* Name of the distribution. */
+#define PACKAGE "PSPP"
+
+/* Version of the distribution. */
+#undef VERSION
+
+/* The concatenation of the strings "GNU ", and PACKAGE. */
+#define GNU_PACKAGE "GNU PSPP"
+
+/* Define to 1 if ANSI function prototypes are usable. */
+#undef PROTOTYPES
+
+
+@TOP@
+
+/* Define if sprintf() returns the number of characters written to
+ the destination string, excluding the null terminator. */
+#undef HAVE_GOOD_SPRINTF
+
+/* Define if rand() and company work according to ANSI. */
+#undef HAVE_GOOD_RANDOM
+
+/* Define endianness of computer here as BIG or LITTLE, if known.
+ If not known, define as UNKNOWN. */
+#define ENDIAN BIG
+
+/* Define as floating-point representation of this computer. For
+ i386, m68k, and other common chips, this is FPREP_IEEE754. */
+#define FPREP FPREP_IEEE754
+
+/* Number of digits in longest `long' value, including sign. This is
+ usually 11, for 32-bit `long's, or 19, for 64-bit `long's. */
+#define INT_DIGITS 19
+
+/* Define if you have the history library (-lhistory). */
+#undef HAVE_LIBHISTORY
+
+/* Define if you have the termcap library (-ltermcap). */
+#undef HAVE_LIBTERMCAP
+
+/* Stolen from Ulrich Drepper, <drepper@gnu.org> gettext-0.10,
+ 1995. */
+
+/* Define if your locale.h file contains LC_MESSAGES. */
+#undef HAVE_LC_MESSAGES
+
+/* Define to 1 if NLS is requested. */
+#undef ENABLE_NLS
+
+/* Define as 1 if you have catgets and don't want to use GNU gettext. */
+#undef HAVE_CATGETS
+
+/* Define as 1 if you have gettext and don't want to use GNU gettext. */
+#undef HAVE_GETTEXT
+
+/* Define as 1 if you have the stpcpy function. */
+#undef HAVE_STPCPY
+
+@BOTTOM@
+
+#include <pref.h>
+
+/* Local Variables: */
+/* mode:c */
+/* End: */
--- /dev/null
+dnl --------------------------------------------------------- ##
+dnl The following definitions are from gettext-0.10.27. ##
+dnl --------------------------------------------------------- ##
+
+# Macro to add for using GNU gettext.
+# Ulrich Drepper <drepper@cygnus.com>, 1995.
+
+# serial 2
+
+AC_DEFUN(AM_WITH_NLS,
+ [AC_MSG_CHECKING([whether NLS is requested])
+ dnl Default is enabled NLS
+ AC_ARG_ENABLE(nls,
+ [ --disable-nls do not use Native Language Support],
+ USE_NLS=$enableval, USE_NLS=yes)
+ AC_MSG_RESULT($USE_NLS)
+ AC_SUBST(USE_NLS)
+
+ USE_INCLUDED_LIBINTL=no
+
+ dnl If we use NLS figure out what method
+ if test "$USE_NLS" = "yes"; then
+ AC_DEFINE(ENABLE_NLS)
+ AC_MSG_CHECKING([whether included gettext is requested])
+ AC_ARG_WITH(included-gettext,
+ [ --with-included-gettext use the GNU gettext library included here],
+ nls_cv_force_use_gnu_gettext=$withval,
+ nls_cv_force_use_gnu_gettext=no)
+ AC_MSG_RESULT($nls_cv_force_use_gnu_gettext)
+
+ nls_cv_use_gnu_gettext="$nls_cv_force_use_gnu_gettext"
+ if test "$nls_cv_force_use_gnu_gettext" != "yes"; then
+ dnl User does not insist on using GNU NLS library. Figure out what
+ dnl to use. If gettext or catgets are available (in this order) we
+ dnl use this. Else we have to fall back to GNU NLS library.
+ dnl catgets is only used if permitted by option --with-catgets.
+ nls_cv_header_intl=
+ nls_cv_header_libgt=
+ CATOBJEXT=NONE
+
+ AC_CHECK_HEADER(libintl.h,
+ [AC_CACHE_CHECK([for gettext in libc], gt_cv_func_gettext_libc,
+ [AC_TRY_LINK([#include <libintl.h>], [return (int) gettext ("")],
+ gt_cv_func_gettext_libc=yes, gt_cv_func_gettext_libc=no)])
+
+ if test "$gt_cv_func_gettext_libc" != "yes"; then
+ AC_CHECK_LIB(intl, bindtextdomain,
+ [AC_CACHE_CHECK([for gettext in libintl],
+ gt_cv_func_gettext_libintl,
+ [AC_TRY_LINK([], [return (int) gettext ("")],
+ gt_cv_func_gettext_libintl=yes,
+ gt_cv_func_gettext_libintl=no)])])
+ fi
+
+ if test "$gt_cv_func_gettext_libc" = "yes" \
+ || test "$gt_cv_func_gettext_libintl" = "yes"; then
+ AC_DEFINE(HAVE_GETTEXT)
+ AM_PATH_PROG_WITH_TEST(MSGFMT, msgfmt,
+ [test -z "`$ac_dir/$ac_word -h 2>&1 | grep 'dv '`"], no)dnl
+ if test "$MSGFMT" != "no"; then
+ AC_CHECK_FUNCS(dcgettext)
+ AC_PATH_PROG(GMSGFMT, gmsgfmt, $MSGFMT)
+ AM_PATH_PROG_WITH_TEST(XGETTEXT, xgettext,
+ [test -z "`$ac_dir/$ac_word -h 2>&1 | grep '(HELP)'`"], :)
+ AC_TRY_LINK(, [extern int _nl_msg_cat_cntr;
+ return _nl_msg_cat_cntr],
+ [CATOBJEXT=.gmo
+ DATADIRNAME=share],
+ [CATOBJEXT=.mo
+ DATADIRNAME=lib])
+ INSTOBJEXT=.mo
+ fi
+ fi
+ ])
+
+ if test "$CATOBJEXT" = "NONE"; then
+ AC_MSG_CHECKING([whether catgets can be used])
+ AC_ARG_WITH(catgets,
+ [ --with-catgets use catgets functions if available],
+ nls_cv_use_catgets=$withval, nls_cv_use_catgets=no)
+ AC_MSG_RESULT($nls_cv_use_catgets)
+
+ if test "$nls_cv_use_catgets" = "yes"; then
+ dnl No gettext in C library. Try catgets next.
+ AC_CHECK_LIB(i, main)
+ AC_CHECK_FUNC(catgets,
+ [AC_DEFINE(HAVE_CATGETS)
+ INTLOBJS="\$(CATOBJS)"
+ AC_PATH_PROG(GENCAT, gencat, no)dnl
+ if test "$GENCAT" != "no"; then
+ AC_PATH_PROG(GMSGFMT, gmsgfmt, no)
+ if test "$GMSGFMT" = "no"; then
+ AM_PATH_PROG_WITH_TEST(GMSGFMT, msgfmt,
+ [test -z "`$ac_dir/$ac_word -h 2>&1 | grep 'dv '`"], no)
+ fi
+ AM_PATH_PROG_WITH_TEST(XGETTEXT, xgettext,
+ [test -z "`$ac_dir/$ac_word -h 2>&1 | grep '(HELP)'`"], :)
+ USE_INCLUDED_LIBINTL=yes
+ CATOBJEXT=.cat
+ INSTOBJEXT=.cat
+ DATADIRNAME=lib
+ INTLDEPS="../intl/libintl.a"
+ INTLLIBS=$INTLDEPS
+ LIBS=`echo $LIBS | sed -e 's/-lintl//'`
+ nls_cv_header_intl=intl/libintl.h
+ nls_cv_header_libgt=intl/libgettext.h
+ fi])
+ fi
+ fi
+
+ if test "$CATOBJEXT" = "NONE"; then
+ dnl Neither gettext nor catgets in included in the C library.
+ dnl Fall back on GNU gettext library.
+ nls_cv_use_gnu_gettext=yes
+ fi
+ fi
+
+ if test "$nls_cv_use_gnu_gettext" = "yes"; then
+ dnl Mark actions used to generate GNU NLS library.
+ INTLOBJS="\$(GETTOBJS)"
+ AM_PATH_PROG_WITH_TEST(MSGFMT, msgfmt,
+ [test -z "`$ac_dir/$ac_word -h 2>&1 | grep 'dv '`"], msgfmt)
+ AC_PATH_PROG(GMSGFMT, gmsgfmt, $MSGFMT)
+ AM_PATH_PROG_WITH_TEST(XGETTEXT, xgettext,
+ [test -z "`$ac_dir/$ac_word -h 2>&1 | grep '(HELP)'`"], :)
+ AC_SUBST(MSGFMT)
+ USE_INCLUDED_LIBINTL=yes
+ CATOBJEXT=.gmo
+ INSTOBJEXT=.mo
+ DATADIRNAME=share
+ INTLDEPS="../intl/libintl.a"
+ INTLLIBS=$INTLDEPS
+ LIBS=`echo $LIBS | sed -e 's/-lintl//'`
+ nls_cv_header_intl=intl/libintl.h
+ nls_cv_header_libgt=intl/libgettext.h
+ fi
+
+ dnl Test whether we really found GNU xgettext.
+ if test "$XGETTEXT" != ":"; then
+ dnl If it is no GNU xgettext we define it as : so that the
+ dnl Makefiles still can work.
+ if $XGETTEXT --omit-header /dev/null 2> /dev/null; then
+ : ;
+ else
+ AC_MSG_RESULT(
+ [found xgettext programs is not GNU xgettext; ignore it])
+ XGETTEXT=":"
+ fi
+ fi
+
+ # We need to process the po/ directory.
+ POSUB=po
+ else
+ DATADIRNAME=share
+ nls_cv_header_intl=intl/libintl.h
+ nls_cv_header_libgt=intl/libgettext.h
+ fi
+
+ # If this is used in GNU gettext we have to set USE_NLS to `yes'
+ # because some of the sources are only built for this goal.
+ if test "$PACKAGE" = gettext; then
+ USE_NLS=yes
+ USE_INCLUDED_LIBINTL=yes
+ fi
+
+ dnl These rules are solely for the distribution goal. While doing this
+ dnl we only have to keep exactly one list of the available catalogs
+ dnl in configure.in.
+ for lang in $ALL_LINGUAS; do
+ GMOFILES="$GMOFILES $lang.gmo"
+ POFILES="$POFILES $lang.po"
+ done
+
+ dnl Make all variables we use known to autoconf.
+ AC_SUBST(USE_INCLUDED_LIBINTL)
+ AC_SUBST(CATALOGS)
+ AC_SUBST(CATOBJEXT)
+ AC_SUBST(DATADIRNAME)
+ AC_SUBST(GMOFILES)
+ AC_SUBST(INSTOBJEXT)
+ AC_SUBST(INTLDEPS)
+ AC_SUBST(INTLLIBS)
+ AC_SUBST(INTLOBJS)
+ AC_SUBST(POFILES)
+ AC_SUBST(POSUB)
+ ])
+
+AC_DEFUN(AM_GNU_GETTEXT,
+ [AC_REQUIRE([AC_PROG_MAKE_SET])dnl
+ AC_REQUIRE([AC_PROG_CC])dnl
+ AC_REQUIRE([AC_ISC_POSIX])dnl
+ AC_REQUIRE([AC_HEADER_STDC])dnl
+ AC_REQUIRE([AC_C_CONST])dnl
+ AC_REQUIRE([AC_C_INLINE])dnl
+ AC_REQUIRE([AC_TYPE_OFF_T])dnl
+ AC_REQUIRE([AC_TYPE_SIZE_T])dnl
+ AC_REQUIRE([AC_FUNC_ALLOCA])dnl
+ AC_REQUIRE([AC_FUNC_MMAP])dnl
+
+ AC_CHECK_HEADERS([argz.h limits.h locale.h nl_types.h malloc.h string.h \
+unistd.h values.h])
+ AC_CHECK_FUNCS([getcwd munmap putenv setenv setlocale strchr strcasecmp \
+__argz_count __argz_stringify __argz_next])
+
+ if test "${ac_cv_func_stpcpy+set}" != "set"; then
+ AC_CHECK_FUNCS(stpcpy)
+ fi
+ if test "${ac_cv_func_stpcpy}" = "yes"; then
+ AC_DEFINE(HAVE_STPCPY)
+ fi
+
+ AM_LC_MESSAGES
+ AM_WITH_NLS
+
+ if test "x$CATOBJEXT" != "x"; then
+ if test "x$ALL_LINGUAS" = "x"; then
+ LINGUAS=
+ else
+ AC_MSG_CHECKING(for catalogs to be installed)
+ NEW_LINGUAS=
+ for lang in ${LINGUAS=$ALL_LINGUAS}; do
+ case "$ALL_LINGUAS" in
+ *$lang*) NEW_LINGUAS="$NEW_LINGUAS $lang" ;;
+ esac
+ done
+ LINGUAS=$NEW_LINGUAS
+ AC_MSG_RESULT($LINGUAS)
+ fi
+
+ dnl Construct list of names of catalog files to be constructed.
+ if test -n "$LINGUAS"; then
+ for lang in $LINGUAS; do CATALOGS="$CATALOGS $lang$CATOBJEXT"; done
+ fi
+ fi
+
+ dnl Determine which catalog format we have (if any is needed)
+ dnl For now we know about two different formats:
+ dnl Linux libc-5 and the normal X/Open format
+ test -d intl || mkdir intl
+ if test "$CATOBJEXT" = ".cat"; then
+ AC_CHECK_HEADER(linux/version.h, msgformat=linux, msgformat=xopen)
+
+ dnl Transform the SED scripts while copying because some dumb SEDs
+ dnl cannot handle comments.
+ sed -e '/^#/d' $srcdir/intl/$msgformat-msg.sed > intl/po2msg.sed
+ fi
+ dnl po2tbl.sed is always needed.
+ sed -e '/^#.*[^\\]$/d' -e '/^#$/d' \
+ $srcdir/intl/po2tbl.sed.in > intl/po2tbl.sed
+
+ dnl In the intl/Makefile.in we have a special dependency which makes
+ dnl only sense for gettext. We comment this out for non-gettext
+ dnl packages.
+ if test "$PACKAGE" = "gettext"; then
+ GT_NO="#NO#"
+ GT_YES=
+ else
+ GT_NO=
+ GT_YES="#YES#"
+ fi
+ AC_SUBST(GT_NO)
+ AC_SUBST(GT_YES)
+
+ dnl If the AC_CONFIG_AUX_DIR macro for autoconf is used we possibly
+ dnl find the mkinstalldirs script in another subdir but ($top_srcdir).
+ dnl Try to locate is.
+ MKINSTALLDIRS=
+ if test $ac_aux_dir; then
+ MKINSTALLDIRS="$ac_aux_dir/mkinstalldirs"
+ fi
+ if test -z $MKINSTALLDIRS; then
+ MKINSTALLDIRS="\$(top_srcdir)/mkinstalldirs"
+ fi
+ AC_SUBST(MKINSTALLDIRS)
+
+ dnl Configure the intl/Makefile for shared libs.
+ if test "${enable_shared+set}" = set; then
+ l=l
+ else
+ l=
+ fi
+ AC_SUBST(l)
+
+ dnl Generate list of files to be processed by xgettext which will
+ dnl be included in po/Makefile.
+ test -d po || mkdir po
+ if test "x$srcdir" != "x."; then
+ if test "x`echo $srcdir | sed 's@/.*@@'`" = "x"; then
+ posrcprefix="$srcdir/"
+ else
+ posrcprefix="../$srcdir/"
+ fi
+ else
+ posrcprefix="../"
+ fi
+ sed -e "/^#/d" -e "/^\$/d" -e "s,.*, $posrcprefix& \\\\," -e "\$s/\(.*\) \\\\/\1/" \
+ < $srcdir/po/POTFILES.in > po/POTFILES
+ ])
+
+# Search path for a program which passes the given test.
+# Ulrich Drepper <drepper@cygnus.com>, 1996.
+
+# serial 1
+
+dnl AM_PATH_PROG_WITH_TEST(VARIABLE, PROG-TO-CHECK-FOR,
+dnl TEST-PERFORMED-ON-FOUND_PROGRAM [, VALUE-IF-NOT-FOUND [, PATH]])
+AC_DEFUN(AM_PATH_PROG_WITH_TEST,
+[# Extract the first word of "$2", so it can be a program name with args.
+set dummy $2; ac_word=[$]2
+AC_MSG_CHECKING([for $ac_word])
+AC_CACHE_VAL(ac_cv_path_$1,
+[case "[$]$1" in
+ /*)
+ ac_cv_path_$1="[$]$1" # Let the user override the test with a path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+ for ac_dir in ifelse([$5], , $PATH, [$5]); do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if [$3]; then
+ ac_cv_path_$1="$ac_dir/$ac_word"
+ break
+ fi
+ fi
+ done
+ IFS="$ac_save_ifs"
+dnl If no 4th arg is given, leave the cache variable unset,
+dnl so AC_PATH_PROGS will keep looking.
+ifelse([$4], , , [ test -z "[$]ac_cv_path_$1" && ac_cv_path_$1="$4"
+])dnl
+ ;;
+esac])dnl
+$1="$ac_cv_path_$1"
+if test -n "[$]$1"; then
+ AC_MSG_RESULT([$]$1)
+else
+ AC_MSG_RESULT(no)
+fi
+AC_SUBST($1)dnl
+])
+
+# Check whether LC_MESSAGES is available in <locale.h>.
+# Ulrich Drepper <drepper@cygnus.com>, 1995.
+
+# serial 1
+
+AC_DEFUN(AM_LC_MESSAGES,
+ [if test $ac_cv_header_locale_h = yes; then
+ AC_CACHE_CHECK([for LC_MESSAGES], am_cv_val_LC_MESSAGES,
+ [AC_TRY_LINK([#include <locale.h>], [return LC_MESSAGES],
+ am_cv_val_LC_MESSAGES=yes, am_cv_val_LC_MESSAGES=no)])
+ if test $am_cv_val_LC_MESSAGES = yes; then
+ AC_DEFINE(HAVE_LC_MESSAGES)
+ fi
+ fi])
+
+dnl Check longest integer in digits.
+
+AC_DEFUN([BLP_INT_DIGITS],
+[
+AC_MSG_CHECKING(number of digits in LONG_MIN (incl. sign))
+AC_CACHE_VAL(blp_int_digits,
+ [AC_TRY_RUN([#include <stdio.h>
+ #include <limits.h>
+ int
+ main()
+ {
+ int len;
+ char s[80];
+ sprintf(s, "%ld", LONG_MAX);
+ len = strlen(s);
+ sprintf(s, "%ld", LONG_MIN);
+ if(strlen(s)>len) len=strlen(s);
+ sprintf(s, "%lu", ULONG_MAX);
+ if(strlen(s)>len) len=strlen(s);
+ exit(len);
+ }
+ ],
+ eval "blp_int_digits=19",
+ eval "blp_int_digits=$?"
+ if test "$blp_int_digits" -lt 11; then
+ blp_int_digits=11
+ fi,
+ eval "blp_int_digits=19")
+ ])
+AC_DEFINE_UNQUOTED(INT_DIGITS, $blp_int_digits)
+AC_MSG_RESULT($blp_int_digits)
+])dnl
+
+dnl Check quality of this machine's sprintf implementation.
+
+AC_DEFUN([BLP_IS_SPRINTF_GOOD],
+[
+AC_MSG_CHECKING(if sprintf returns a char count)
+AC_CACHE_VAL(blp_is_sprintf_good,
+ [AC_TRY_RUN([#include <stdio.h>
+ int
+ main()
+ {
+ char s[8];
+ exit((int)sprintf(s, "abcdefg")!=7);
+ }
+ ],
+ eval "blp_is_sprintf_good=yes",
+ eval "blp_is_sprintf_good=no",
+ eval "blp_is_sprintf_good=no")
+ ])
+if test "$blp_is_sprintf_good" = yes; then
+ AC_DEFINE(HAVE_GOOD_SPRINTF)
+ AC_MSG_RESULT(yes)
+else
+ AC_MSG_RESULT(no)
+fi
+])dnl
+
+dnl Check for proper random number generator.
+
+AC_DEFUN([BLP_RANDOM],
+[
+AC_MSG_CHECKING(random number generator)
+AC_CACHE_VAL(blp_random_good,
+ AC_TRY_COMPILE([#include <stdlib.h>], [int x=RAND_MAX;],
+ blp_random_good=yes, blp_random_good=no))
+if test "$blp_random_good" = yes; then
+ AC_DEFINE(HAVE_GOOD_RANDOM)
+ AC_MSG_RESULT(good)
+else
+ AC_MSG_RESULT(bad)
+fi
+])dnl
+
+dnl aclocal.m4 ends here
--- /dev/null
+Sun May 24 22:40:13 1998 Ben Pfaff <blp@gnu.org>
+
+ * ps-prologue: Add %%DocumentMedia: comment.
+
+Wed May 20 00:02:51 1998 Ben Pfaff <blp@gnu.org>
+
+ * ps-prologue: Comment out misleading Bounding-Box comment for
+ now. SF arguments rearranged. BP removed.
+
+Wed Apr 15 13:00:46 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (private-install) Make it work for separate source
+ and build directories.
+
+ * ps-prologue: New TL macro for a thick line. New thick-width arg
+ to BP.
+
+Sun Jan 4 18:11:11 1998 Ben Pfaff <blp@gnu.org>
+
+ * ps-prologue: Minor reorganization. New GB macro to draw a gray
+ box.
+
+Wed Dec 24 22:35:13 1997 Ben Pfaff <blp@gnu.org>
+
+ * devices: Added devicetype options and documentation for them.
+
+Fri Dec 5 21:51:08 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (pkgsysconf_DATA) Add html-prologue.
+ (EXTRA_DIST) Add html-prologue.
+
+ * devices: Add `html' device. Add `listing', `screen', and
+ `printer' flags to devices as appropriate.
+
+ * html-prologue: New file.
+
+ * ps-prologue: Comment fixes.
+
+Thu Sep 18 21:31:02 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (pkgsysconfdir) Changed from $(pkgdatadir) to
+ $(sysconfdir)/$(PACKAGE).
+
+Thu Aug 14 22:05:54 1997 Ben Pfaff <blp@gnu.org>
+
+ * devices: (tty) Define as null instead of not defining.
+
+Sun Aug 3 11:33:28 1997 Ben Pfaff <blp@gnu.org>
+
+ * devices: tty-ascii has no bold or italic by default.
+
+Wed Jun 25 22:50:19 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) New target.
+
+Mon May 5 21:56:54 1997 Ben Pfaff <blp@gnu.org>
+
+ * devices, papersize, ps-prologue: Comment fixes.
+
+Fri May 2 22:05:44 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Removed ps-fontmap.
+
+ * ps-fontmap: Removed.
+
+ * ps-prologue: Added comments. Fixed DSC comments.
+ (BP) Two new arguments; fixed problem with SF argument conflict
+ with SF function.
+
+Thu May 1 14:57:52 1997 Ben Pfaff <blp@gnu.org>
+
+ * ps-prologue: (BP) New argument, SF or scale factor.
+
+Fri Apr 18 16:48:41 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: New file.
+
+ * environment: Comment fix.
+
+Sat Feb 15 21:26:53 1997 Ben Pfaff <blp@gnu.org>
+
+ * devices: Added ml520 and ml520-ul printer devices.
+
+Sat Jan 11 15:44:15 1997 Ben Pfaff <blp@gnu.org>
+
+ * devices: Default listing device is list-ascii, not list-ibmpc.
+
+Sun Dec 29 21:36:48 1996 Ben Pfaff <blp@gnu.org>
+
+ * devices: Changed default devices.
+
+Sat Sep 7 22:35:12 1996 Ben Pfaff <blp@gnu.org>
+
+ * ps-prologue: Added `!encodings' line to cause encodings to be
+ output.
+ (T) Fixed. Yes, really this time.
+
+Thu Sep 5 22:05:56 1996 Ben Pfaff <blp@gnu.org>
+
+ * ps-prologue: (T) Now works correctly.
+ (SF) Parameters changed to: size in psus, target font name,
+ encoding, PostScript font name.
+
+Wed Sep 4 21:45:35 1996 Ben Pfaff <blp@gnu.org>
+
+ * prologue.ps: Renamed ps-prologue, all references changed.
+ (T) New definition.
+
+ * ps-encodings: New PostScript configuration file (not present in
+ distribution).
+
+Sat Aug 31 23:52:38 1996 Ben Pfaff <blp@gnu.org>
+
+ * prologue.ps: One minor comment change.
+
+Thu Aug 29 21:36:41 1996 Ben Pfaff <blp@gnu.org>
+
+ * prologue.ps: Portions other than DSC comments are essentially
+ completely new.
+
+Sat Aug 24 23:26:00 1996 Ben Pfaff <blp@gnu.org>
+
+ * devices: Added PostScript driver.
+
+Sun Aug 11 21:31:22 1996 Ben Pfaff <blp@gnu.org>
+
+ * prologue.ps: Calls `setlinecap' in setup code.
+
+Sat Aug 10 23:28:17 1996 Ben Pfaff <blp@gnu.org>
+
+ * prologue.ps: DSC comment changes. New call to `setlinewidth' in
+ setup code.
+
+Thu Aug 8 22:31:11 1996 Ben Pfaff <blp@gnu.org>
+
+ * prologue.ps: Changes to scaling & translating code.
+
+Sat Aug 3 20:50:35 1996 Ben Pfaff <blp@gnu.org>
+
+ * environment: New file. Yet another new time- and memory-hogging
+ redundant config file; why not?
+
+ * papersize: Comment changes.
+
+ * prologue.ps: Changed vars from $varname$ to ${varname} format.
+ Miscellaneous changes.
+
+ * ps-fontmap: Comment changes. Fixed ZC family.
+
+Sat Jul 27 22:32:38 1996 Ben Pfaff <blp@gnu.org>
+
+ * ps-fontmap: New configuration file. Added to Makefile.am.
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+## Process this file with automake to produce Makefile.in -*- makefile -*-
+
+pkgsysconfdir = $(sysconfdir)/$(PACKAGE)
+pkgsysconf_DATA = devices html-prologue papersize ps-prologue
+EXTRA_DIST = devices html-prologue papersize ps-prologue
+
+# A `private installation' in my terms is just having the appropriate
+# configuration files in ~/.pspp instead of a global configuration
+# location. So I let those files be installed automatically.
+
+private-install:
+ $(mkinstalldirs) $$HOME/.pspp
+ cd $(srcdir); cp $(pkgsysconf_DATA) $$HOME/.pspp
+private-uninstall:
+ -cd $$HOME/.pspp; rm -f $(pkgsysconf_DATA)
+ -rmdir $$HOME/.pspp
+
+MAINTAINERCLEANFILES = Makefile.in
--- /dev/null
+# PSPP's standard output drivers.
+#
+# An introduction to the use of PSPP output drivers and this file
+# follows. However, refer to PSPP's Texinfo documentation for full
+# information.
+#
+# Each output driver specification must be on a single line; however,
+# lines may be spliced with a \ at the end of a line. Line splicing
+# is performed *before* comments (introduced by `#') are removed.
+#
+# Format is `DRIVERNAME:CLASSNAME:DEVICETYPE:OPTIONS'.
+#
+# DRIVERNAME is the name that identifies the driver to the user. It
+# is the name used on the -o command-line option.
+#
+# CLASSNAME is the internal name of the type of driver. Device
+# classes can be listed with `pspp -l'.
+#
+# DEVICETYPE identifies what type or types the devices is. Zero or
+# more of the following keywords may be given here: screen, printer,
+# or listing.
+#
+# OPTIONS is a list of key/value pairs to pass to the driver. Use
+# spaces to separate pairs, and '=' to separate keys and values.
+# Quotes " or ' can be used to delimit values that contain spaces.
+# Example: paper-size="Envelope #10" charset=latin1
+#
+# Driver categories may be defined with lines of the form:
+#
+# category=driver1 driver2 driver3 ... driverN
+#
+# To disable a driver, define a category with nothing on the right
+# side.
+#
+# Macros may be defined with lines of the form:
+#
+# define macro-name definition
+#
+# Macros may not be recursive; they may not take arguments. (However,
+# `definition' is macro-expanded *at time of definition*.) Macros are
+# referenced with $var or ${var} syntax; the latter is preferred.
+# Macro definitions on the PSPP command-line take precedence without
+# warning.
+
+# Preferred devices.
+default=tty list
+tty=#tty-ibmpc
+list=list-ascii
+
+# Output files.
+define tty-output-file "/dev/tty"
+define list-output-file "pspp.list"
+
+define no-attributes bold-on="" italic-on="" bold-italic-on=""
+
+# Generic ASCII devices
+tty-ascii:ascii:screen:char-set=ascii output-file=${tty-output-file} \
+ ${no-attributes}
+list-ascii:ascii:listing:length=66 width=79 char-set=ascii \
+ output-file=${list-output-file} ${no-attributes}
+
+# ASCII devices that support bold & underline via backspacing.
+tty-ascii-bi:ascii:screen:char-set=ascii output-file=${tty-output-file}
+list-ascii-bi:ascii:listing:length=66 width=79 char-set=ascii \
+ output-file=${list-output-file}
+
+# HTML device.
+html:html::
+
+# Devices that support the IBM PC line-drawing characters.
+define ibmpc-graphics \
+ box[0000]='\x20' box[0001]='\xb3' box[0002]='\xba' box[0003]='\xba' \
+ box[0010]='\xc4' box[0011]='\xd9' box[0012]='\xbd' box[0013]='\xbd' \
+ box[0020]='\xcd' box[0021]='\xbe' box[0022]='\xbc' box[0023]='\xbc' \
+ box[0030]='\xf0' box[0031]='\xbe' box[0032]='\xbc' box[0033]='\xbc' \
+ box[0100]='\xb3' box[0101]='\xb3' box[0102]='\xc4' box[0103]='\xf0' \
+ box[0110]='\xbf' box[0111]='\xb4' box[0112]='\xb6' box[0113]='\xb6' \
+ box[0120]='\xb8' box[0121]='\xb5' box[0122]='\xb9' box[0123]='\xb9' \
+ box[0130]='\xb8' box[0131]='\xb5' box[0132]='\xb9' box[0133]='\xb9' \
+ box[0200]='\xba' box[0201]='\xba' box[0202]='\xba' box[0203]='\xba' \
+ box[0210]='\xb7' box[0211]='\xb6' box[0212]='\xb6' box[0213]='\xb6' \
+ box[0220]='\xbb' box[0221]='\xb9' box[0222]='\xb9' box[0223]='\xb9' \
+ box[0300]='\xb3' box[0301]='\xba' box[0302]='\xba' box[0303]='\xba' \
+ box[0310]='\xb7' box[0311]='\xb6' box[0312]='\xb6' box[0313]='\xb6' \
+ box[0320]='\xbb' box[0321]='\xb9' box[0322]='\xb9' box[0323]='\xb9' \
+ box[0330]='\xbb' box[0331]='\xb9' box[0332]='\xb9' box[0333]='\xb9' \
+ box[1000]='\xc4' box[1001]='\xc0' box[1002]='\xd3' box[1003]='\xd3' \
+ box[1010]='\xc4' box[1011]='\xc1' box[1012]='\xd0' box[1013]='\xd0' \
+ box[1020]='\xcd' box[1021]='\xcf' box[1022]='\xca' box[1023]='\xca' \
+ box[1030]='\xf0' box[1031]='\xcf' box[1032]='\xca' box[1033]='\xca' \
+ box[1100]='\xda' box[1101]='\xc3' box[1102]='\xc7' box[1103]='\xc7' \
+ box[1110]='\xc2' box[1111]='\xc5' box[1112]='\xd7' box[1113]='\xd7' \
+ box[1120]='\xd1' box[1121]='\xd8' box[1122]='\xce' box[1123]='\xce' \
+ box[1130]='\xd1' box[1131]='\xd8' box[1132]='\xce' box[1133]='\xce' \
+ box[1200]='\xd6' box[1201]='\xc7' box[1202]='\xc7' box[1203]='\xc7' \
+ box[1210]='\xd2' box[1211]='\xd7' box[1212]='\xd7' box[1213]='\xd7' \
+ box[1220]='\xca' box[1221]='\xce' box[1222]='\xce' box[1223]='\xce' \
+ box[1230]='\xca' box[1231]='\xce' box[1232]='\xce' box[1233]='\xce' \
+ box[1300]='\xd6' box[1301]='\xc7' box[1302]='\xc7' box[1303]='\xc7' \
+ box[1310]='\xd2' box[1311]='\xd7' box[1312]='\xd7' box[1313]='\xd7' \
+ box[1320]='\xca' box[1321]='\xce' box[1322]='\xce' box[1323]='\xce' \
+ box[1330]='\xca' box[1331]='\xce' box[1332]='\xce' box[1333]='\xce' \
+ box[2000]='\xcd' box[2001]='\xd4' box[2002]='\xc8' box[2003]='\xc8' \
+ box[2010]='\xcd' box[2011]='\xcf' box[2012]='\xca' box[2013]='\xca' \
+ box[2020]='\xcd' box[2021]='\xcf' box[2022]='\xca' box[2023]='\xca' \
+ box[2030]='\xf0' box[2031]='\xcf' box[2032]='\xca' box[2033]='\xca' \
+ box[2100]='\xd5' box[2101]='\xc6' box[2102]='\xcc' box[2103]='\xcc' \
+ box[2110]='\xd1' box[2111]='\xd8' box[2112]='\xce' box[2113]='\xce' \
+ box[2120]='\xd1' box[2121]='\xd8' box[2122]='\xce' box[2123]='\xce' \
+ box[2130]='\xd1' box[2131]='\xd8' box[2132]='\xce' box[2133]='\xce' \
+ box[2200]='\xc9' box[2201]='\xcc' box[2202]='\xcc' box[2203]='\xcc' \
+ box[2210]='\xcb' box[2211]='\xce' box[2212]='\xce' box[2213]='\xce' \
+ box[2220]='\xcb' box[2221]='\xce' box[2222]='\xce' box[2223]='\xce' \
+ box[2230]='\xcb' box[2231]='\xce' box[2232]='\xce' box[2233]='\xce' \
+ box[2300]='\xc9' box[2301]='\xcc' box[2302]='\xcc' box[2303]='\xce' \
+ box[2310]='\xcb' box[2311]='\xce' box[2312]='\xce' box[2313]='\xce' \
+ box[2320]='\xcb' box[2321]='\xce' box[2322]='\xce' box[2323]='\xce' \
+ box[2330]='\xcb' box[2331]='\xce' box[2332]='\xce' box[2333]='\xce' \
+ box[3000]='\xcd' box[3001]='\xd4' box[3002]='\xc8' box[3003]='\xc8' \
+ box[3010]='\xcd' box[3011]='\xcf' box[3012]='\xca' box[3013]='\xca' \
+ box[3020]='\xcd' box[3021]='\xcf' box[3022]='\xca' box[3023]='\xca' \
+ box[3030]='\xcd' box[3031]='\xcf' box[3032]='\xca' box[3033]='\xca' \
+ box[3100]='\xd5' box[3101]='\xc6' box[3102]='\xcc' box[3103]='\xcc' \
+ box[3110]='\xd1' box[3111]='\xd8' box[3112]='\xce' box[3113]='\xce' \
+ box[3120]='\xd1' box[3121]='\xd8' box[3122]='\xce' box[3123]='\xce' \
+ box[3130]='\xd1' box[3131]='\xd8' box[3132]='\xce' box[3133]='\xce' \
+ box[3200]='\xc9' box[3201]='\xcc' box[3202]='\xcc' box[3203]='\xcc' \
+ box[3210]='\xcb' box[3211]='\xce' box[3212]='\xce' box[3213]='\xce' \
+ box[3220]='\xcb' box[3221]='\xce' box[3222]='\xce' box[3223]='\xce' \
+ box[3230]='\xcb' box[3231]='\xce' box[3232]='\xce' box[3233]='\xce' \
+ box[3300]='\xc9' box[3301]='\xcc' box[3302]='\xcc' box[3303]='\xce' \
+ box[3310]='\xcb' box[3311]='\xce' box[3312]='\xce' box[3313]='\xce' \
+ box[3320]='\xcb' box[3321]='\xce' box[3322]='\xce' box[3323]='\xce' \
+ box[3330]='\xcb' box[3331]='\xce' box[3332]='\xce' box[3333]='\xce'
+
+tty-ibmpc:ascii:screen:length=$viewlength width=$viewwidth ${ibmpc-graphics} \
+ output-file=${tty-output-file}
+list-ibmpc:ascii:listing:length=66 width=79 output-file=${list-output-file} \
+ ${ibmpc-graphics}
+
+# PostScript device. Tested with HP LaserJet 6MP.
+list-ps:postscript::
+
+# Okidata Microline 520 (these use the Microline emulation mode).
+define ml520-common output-file=${list-output-file} ${ibmpc-graphics} \
+ bold-on='\x1b\x54' bold-off='\x1b\x49' init='\x1b\x7b\x21\x1b\x23\x30'
+define ml520-italic italic-on='\x1b\x21\x2f' italic-off='\x1b\x21\x2a' \
+ bold-italic-on='\x1b\x21\x2f\x1b\x54' bold-italic-off='\x1b\x21\x2a\x1b\x49'
+define ml520-ul italic-on='\x1b\x43' italic-off='\x1b\x44' \
+ bold-italic-on='\x1b\x43\x1b\x54' bold-italic-off='\x1b\x44\x1b\x49'
+ml520=ml520-10cpi
+ml520-10cpi:ascii:printer:length=66 width=79 ${ml520-common} ${ml520-italic}
+ml520-10cpi-ul:ascii:printer:length=66 width=79 ${ml520-common} ${ml520-ul}
+ml520-17cpi:ascii:printer:length=66 width=144 ${ml520-common} ${ml520-italic} \
+ cpi=17 init='\x1b\x7b\x21\x1b\x23\x30\x1d'
+ml520-17cpi-ul:ascii:printer:length=66 width=144 ${ml520-common} ${ml520-ul} \
+ cpi=17 init='\x1b\x7b\x21\x1b\x23\x30\x1d'
+ml520-20cpi:ascii:printer:length=66 width=160 ${ml520-common} ${ml520-italic} \
+ cpi=17 init='\x1b\x7b\x21\x1b\x23\x30\x1b\x23\x33'
+ml520-20cpi-ul:ascii:printer:length=66 width=160 ${ml520-common} ${ml520-ul} \
+ cpi=17 init='\x1b\x7b\x21\x1b\x23\x30\x1b\x23\x33'
+
+# Local Variables:
+# fill-prefix: "# "
+# End:
--- /dev/null
+!!!
+!!! This prologue is hereby placed in the public domain.
+!!!
+!!! PSPP does not place any restrictions on the distribution terms
+!!! of its output. You are encouraged to allow your PSPP outputs to
+!!! be freely distributed.
+!!!
+<!DOCTYPE html PUBLIC "-//IETF//DTD HTML 2.0//EN">
+<!-- Generated ${date} by ${generator}
+ from ${source-file} -->
+<HTML>
+<HEAD>
+<TITLE>${title}</TITLE> !title
+<META NAME="generator" CONTENT="${generator}">
+<META NAME="author" CONTENT="${author}">
+</HEAD>
+<BODY BGCOLOR="#ffffff" TEXT="#000000" LINK="#1f00ff" ALINK="#ff0000"
+ VLINK="#9900dd">
+<H1>${title}</H1> !title
+<H2>${subtitle}</H2> !subtitle
+!!! Local Variables:
+!!! fill-prefix: "!!! "
+!!! End:
--- /dev/null
+# List of standard paper sizes for use with PSPP output drivers.
+#
+# Valid units include "in"=inches, "cm"=centimeters, "mm"=millimeters.
+# Default units are "in" for dimensions less than 50, "mm" otherwise.
+# This automagically determines units for all the standard sizes.
+#
+# Fractional values are allowed: (1) as decimals, or (2) in the form
+# "a-b/c", which has the value of a, plus b divided by c.
+#
+# Also allowed are synonyms: `"B4/JIS"="B4/ISO"'. The left hand size
+# is replaced by the right hand size.
+
+# U.S.
+"Letter" 8-1/2 x 11
+"Legal" 8-1/2 x 14
+"Letter Extra" 9-1/2 x 12
+"Legal Extra" 9-1/2 x 15
+"Executive" 7-1/4 x 10-1/2
+"Ledger" 17 x 11
+"Tabloid" 11 x 17
+"Tabloid Extra" 11.69 x 18
+"US Standard Fanfold"="U.S. Standard Fanfold"
+"U.S. Standard Fanfold" 14-7/8 x 11
+"Standard Fanfold" 8-1/2 x 12
+"Legal Fanfold" 8-1/2 x 12
+
+# Envelopes.
+"DL" 8-2/3 x 4-1/3
+"Monarch" 3-7/8 x 7-1/2
+"6 3/4 Envelope"="6-3/4 Envelope"
+"6-3/4 Envelope" 3-5/8 x 6-1/2
+"#9" 3-7/8 x 8-7/8
+"#10" 4-1/8 x 9-1/2
+"#11" 4-1/2 x 10-3/8
+"#12" 4-3/4 x 11
+"#14" 5 x 11-1/2
+
+# Metric.
+"B4"="B4/ISO"
+"B5"="B5/ISO"
+"A3" 297 x 420
+"A4" 210 x 297
+"B4/ISO" 250 x 353
+"B4/JIS" 257 x 364
+"B5/ISO" 176 x 250
+"B5/JIS" 182 x 257
+"B6" 176 x 125
+"C3" 324 x 458
+"C4" 229 x 324
+"C5" 162 x 229
+"C6" 114 x 162
+"C65" 114 x 229
+"Envelope" 110 x 230
+
+# Demonstration of units.
+#"Bizarre" 55mm x 10in
+
+# Local Variables:
+# fill-prefix: "# "
+# End:
--- /dev/null
+!!!
+!!! This prologue is hereby placed in the public domain.
+!!!
+!!! PSPP does not place any restrictions on the distribution terms
+!!! of its output. You are encouraged to allow your PSPP outputs to
+!!! be freely distributed.
+!!!
+%!PS-Adobe-3.0 EPSF-3.0 !eps
+%!PS-Adobe-3.0 !ps
+%%Pages: (atend)
+%%DocumentNeededResources: (atend)
+%%DocumentSuppliedResources: procset PSPP-Prologue 1.0 0
+!!! %%Bounding-Box: ${bounding-box}
+%%Copyright: This prologue is public domain.
+%%Creator: ${creator}
+%%CreationDate: ${date}
+%%DocumentData: ${data}
+%%DocumentMedia: Plain ${paper-width} ${paper-length} 75 white ()
+%%Orientation: ${orientation}
+%%For: ${user}@${host}
+%%Title: ${title}
+%FscoSourceFile: ${source-file}
+%%EndComments
+%%BeginDefaults
+%%PageResources:
+%%+ ${prop-font}
+%%+ ${fixed-font}
+%%EndDefaults
+%%BeginProlog
+%%BeginResource: procset PSPP-Prologue 1.0 0
+/L{moveto lineto stroke}bind def
+/TL{TW setlinewidth 0 setlinecap
+ moveto lineto stroke
+ LW setlinewidth 2 setlinecap}def
+/D{moveto lineto moveto lineto stroke}bind def
+/S{moveto show}bind def
+/T{currentpoint exch pop moveto show}bind def
+/ED{exch def}bind def
+!!! SF arguments:
+!!! identifier dictionary entry to save font in
+!!! font encoding font encoding vector
+!!! fontsize thousandths of a point
+!!! font name string
+!!! Usage example: 12000/F0 E0 (Times-Roman) SF
+/SF{
+ findfont exch scalefont
+ dup maxlength 1 index/FontName known not{1 add}if dict begin
+ {
+ 1 index/FID ne{def}{pop pop}ifelse
+ }forall
+ /Encoding ED
+ dup/FontName ED
+ currentdict end 1 index exch definefont dup setfont
+ [exch/setfont cvx] cvx bind def
+}bind def
+/F{setfont}bind def
+/EP{
+ pg restore
+ showpage
+}bind def
+/GB{
+ /y2 ED/x2 ED/y1 ED/x1 ED
+ x1 y1 moveto x2 y1 lineto x2 y2 lineto x1 y2 lineto closepath
+ gsave 0.9 setgray fill grestore stroke
+}bind def
+%%EndResource
+%%EndProlog
+%%BeginSetup
+%%IncludeResource: ${prop-font}
+%%IncludeResource: ${fixed-font}
+!encodings
+%%EndSetup
+!!! Local Variables:
+!!! fill-prefix: "!!! "
+!!! End:
--- /dev/null
+dnl Process this file with autoconf to produce a configure script.
+AC_INIT(src/q2c.c)
+AC_PREREQ(2.12)
+AM_CONFIG_HEADER(config.h)
+CPPFLAGS="$CPPFLAGS -D_GNU_SOURCE=1"
+AC_ISC_POSIX
+AC_PROG_CC
+AM_PROG_CC_STDC
+AC_CANONICAL_SYSTEM
+AM_INIT_AUTOMAKE(pspp, [0.3.0])
+
+#AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE")
+AC_DEFINE_UNQUOTED(VERSION, "$VERSION")
+
+#GNU_PACKAGE="GNU $PACKAGE"
+#AC_DEFINE_UNQUOTED(GNU_PACKAGE, "$GNU_PACKAGE")
+
+ALL_LINGUAS=""
+
+AC_ARG_PROGRAM
+AC_PROG_INSTALL
+AC_PROG_RANLIB
+
+dnl internationalization macros
+AM_GNU_GETTEXT
+
+AC_LINK_FILES($nls_cv_header_libgt, $nls_cv_header_intl)
+
+AC_ARG_WITH(checker,
+ [ --with-checker compile with Checker (for debugging)],
+ CC="checkergcc" LOCAL_CC="gcc" CC_OPTIONS="-Werror")
+AC_ARG_ENABLE(debugging,
+ [ --enable-debugging turn on debugging options],
+ CC_OPTIONS="-DDEBUGGING=1")
+
+# LOCAL_CC runs on the build system, targets the build system.
+# CC runs on the build system, targets the host system.
+if test -z "$LOCAL_CC"; then
+ LOCAL_CC="$CC"
+fi
+AC_SUBST(LOCAL_CC)
+
+AC_CHECK_LIB(m, sin)
+AC_CHECK_LIB(gmp, mpf_get_str,
+ LIBS="-lgmp $LIBS" GMP_SUBDIRS= GMP_LIBS=,
+ GMP_SUBDIRS=gmp GMP_LIBS='$(GMP_LIBS)')
+AC_SUBST(GMP_SUBDIRS)
+AC_SUBST(GMP_LIBS)
+
+AC_CHECK_LIB(ncurses, tgetent, LIBS="-lncurses $LIBS" termcap=yes,
+ AC_CHECK_LIB(termcap, tgetent, LIBS="-ltermcap $LIBS" termcap=yes,
+ termcap=no))
+if test "$termcap" = yes; then
+ AC_CHECK_HEADERS(termcap.h)
+ AC_DEFINE(HAVE_LIBTERMCAP)
+fi
+
+AC_CHECK_LIB(readline, readline)
+if test "$ac_cv_lib_readline_readline" = yes; then
+ AC_CHECK_HEADERS(readline/readline.h)
+ AC_CHECK_LIB(readline, add_history, history=yes,
+ AC_CHECK_LIB(history, add_history, LIBS="-lhistory" history=yes,
+ history=no))
+ if test "$history" = yes; then
+ AC_CHECK_HEADERS(readline/history.h)
+ AC_DEFINE(HAVE_LIBHISTORY)
+ fi
+fi
+
+AC_CHECK_HEADERS(limits.h memory.h sys/stat.h sys/time.h sys/types.h \
+ fpu_control.h sys/mman.h sys/wait.h ieeefp.h fenv.h)
+AC_HEADER_STAT
+AC_HEADER_STDC
+AC_HEADER_TIME
+
+dnl This test must precede tests of compiler characteristics like
+dnl that for the inline keyword, since it may change the degree to
+dnl which the compiler supports such features.
+AM_C_PROTOTYPES
+
+AC_C_CONST
+AC_C_INLINE
+AC_TYPE_SIZE_T
+AC_STRUCT_TM
+
+AC_CHECK_SIZEOF(short, 2)
+AC_CHECK_SIZEOF(int, 4)
+AC_CHECK_SIZEOF(long, 4)
+AC_CHECK_SIZEOF(long long, 0)
+AC_CHECK_SIZEOF(float, 0)
+AC_CHECK_SIZEOF(double, 8)
+AC_CHECK_SIZEOF(long double, 0)
+
+dnl There used to be a check for floating-point representation here, but
+dnl for some reason it didn't work on certain m68k GNU/Linux machines, and
+dnl I was unable to determine why. So, since every modern computer uses
+dnl ieee754 format anyway, I've hard-coded it to ieee754. Anyone who uses
+dnl something else can enumerate the exceptions.
+
+AC_DEFINE(FPREP, FPREP_IEEE754)
+
+dnl if test "$cross_compiling" = yes; then
+dnl AC_MSG_WARN([Edit config.h to set proper values for SIZEOF_SHORT, \
+dnl SIZEOF_INT,])
+dnl AC_MSG_WARN([SIZEOF_LONG, and SIZEOF_LONG_LONG (if available), if the \
+dnl values])
+dnl AC_MSG_WARN([are not 2, 4, 4, and 8, respectively.])
+dnl AC_MSG_WARN([Also set the floating point representation (IEEE754, etc.).])
+dnl else
+dnl AC_CACHE_CHECK(
+dnl floating point representation, ac_cv_sys_fprep,
+dnl
+dnl AC_TRY_RUN(
+dnl [changequote(<<, >>)dnl
+dnl <<
+dnl main () {
+dnl /* Test for IEEE754 floating point representation. */
+dnl union { unsigned char c[8]; double d; }
+dnl l = {{0x1c, 0xbc, 0x6e, 0xf2, 0x54, 0x8b, 0x11, 0x43}},
+dnl b = {{0x43, 0x11, 0x8b, 0x54, 0xf2, 0x6e, 0xbc, 0x1c}};
+dnl return l.d!=1234567891234567.0 && b.d!=1234567891234567.0;
+dnl }
+dnl >>
+dnl changequote([, ])dnl
+dnl ], ac_cv_sys_fprep=ieee754, ac_cv_sys_fprep=unknown,
+dnl AC_MSG_WARN([This error cannot occur.])))
+dnl if test "$ac_cv_sys_fprep" = ieee754; then
+dnl AC_DEFINE(FPREP, FPREP_IEEE754)
+dnl else
+dnl AC_MSG_WARN([Unknown floating-point representation. This is a serious \
+dnl error.])
+dnl AC_MSG_WARN([Please contact the author for porting information.])
+dnl AC_MSG_WARN([(It should be a fairly simple port, by the way.)])
+dnl AC_DEFINE(FPREP, FPREP_UNKNOWN)
+dnl fi
+dnl fi
+
+if test "$cross_compiling" = no; then
+ dnl This code was taken from acspecific.m4 and modified.
+ dnl It began life as AC_C_BIGENDIAN.
+ AC_CACHE_CHECK(
+ whether byte ordering is bigendian, ac_cv_c_bigendian,
+ [ac_cv_c_bigendian=unknown
+ # See if sys/param.h defines the BYTE_ORDER macro.
+ AC_TRY_COMPILE(
+ [#include <sys/types.h>
+ #include <sys/param.h>],
+ [#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN
+ bogus endian macros
+ #endif],
+ [# It does; now see whether it defined to BIG_ENDIAN or not.
+ AC_TRY_COMPILE(
+ [#include <sys/types.h>
+ #include <sys/param.h>],
+ [#if BYTE_ORDER != BIG_ENDIAN
+ not big endian
+ #endif],
+ ac_cv_c_bigendian=yes, ac_cv_c_bigendian=no)])
+ if test $ac_cv_c_bigendian = unknown; then
+ AC_TRY_RUN(
+ [main () {
+ /* Are we little or big endian? From Harbison&Steele. */
+ union
+ {
+ long l;
+ char c[sizeof (long)];
+ } u;
+ u.l = 1;
+ exit (u.c[sizeof (long) - 1] == 1);
+ }],
+ ac_cv_c_bigendian=no, ac_cv_c_bigendian=yes,
+ AC_MSG_ERROR([Internal error determining endianness.]))
+ fi])
+
+ if test "$ac_cv_c_bigendian" = yes; then
+ AC_DEFINE(ENDIAN, BIG)
+ elif test "$ac_cv_c_bigendian" = no; then
+ AC_DEFINE(ENDIAN, LITTLE)
+ else
+ AC_MSG_ERROR([Machine's endianness is unknown.])
+ fi
+else
+ AC_DEFINE(ENDIAN, UNKNOWN)
+
+ AC_MSG_WARN([Optionally set value for endianness for best performance.])
+fi
+
+BLP_IS_SPRINTF_GOOD
+BLP_INT_DIGITS
+BLP_RANDOM
+
+AC_FUNC_ALLOCA
+AC_FUNC_MEMCMP
+AC_FUNC_VPRINTF
+AC_REPLACE_FUNCS(memmove memset stpcpy strpbrk strerror strtol strtoul memchr \
+ getline getdelim strcasecmp strncasecmp memmem strtok_r)
+AC_CHECK_FUNCS(gethostname strstr strtod __setfpucw isinf isnan finite getpid \
+ feholdexcept)
+
+AC_PROG_LN_S
+
+dnl This must be after other tests so warnings don't provoke errors above.
+if test "$ac_cv_prog_gcc" = yes; then
+ CFLAGS="-g -Wall -W -Wno-uninitialized -Wwrite-strings \
+-Wstrict-prototypes -Wpointer-arith"
+ if test "$CC_OPTIONS" != ""; then
+ CFLAGS="$CFLAGS $CC_OPTIONS"
+ fi
+fi
+AC_SUBST(CFLAGS)
+
+AC_OUTPUT(Makefile \
+ intl/Makefile \
+ po/Makefile.in \
+ lib/Makefile \
+ lib/gmp/Makefile \
+ lib/gmp/mpn/Makefile \
+ lib/gmp/mpf/Makefile \
+ lib/julcal/Makefile \
+ lib/misc/Makefile \
+ lib/dcdflib/Makefile \
+ doc/Makefile \
+ src/Makefile \
+ config/Makefile \
+ tests/Makefile,
+ [sed -e "/POTFILES =/r po/POTFILES" po/Makefile.in > po/Makefile
+
+ # Copy pref.h from pref.h.orig if prudent
+ if test ! -f pref.h; then
+ echo "creating pref.h"
+ cp $ac_given_srcdir/pref.h.orig pref.h
+ elif test "`ls -t pref.h.orig pref.h 2>/dev/null | sed 1q`" = pref.h.orig; then
+ echo "replacing pref.h with newer pref.h.orig"
+ cp $ac_given_srcdir/pref.h.orig pref.h
+ else
+ echo "pref.h exists"
+ fi
+ if test -f pref.h; then touch pref.h; fi
+ ])
+
+dnl configure.in ends here
--- /dev/null
+Sun Jan 2 21:30:53 2000 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Updated.
+
+Tue Mar 9 12:47:20 1999 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Updated.
+
+Mon Jan 18 19:29:21 1999 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Updated.
+
+Tue Jan 5 12:04:09 1999 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Updated.
+
+Thu Nov 19 12:35:01 1998 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Revised.
+
+Sun Aug 9 11:11:43 1998 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Revised.
+
+Sat Aug 8 00:19:22 1998 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Revised.
+
+Sun Jul 5 00:14:24 1998 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Updated.
+
+Fri May 29 21:43:52 1998 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Revised.
+
+Wed May 20 00:03:50 1998 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Updated.
+
+Fri Apr 24 12:51:28 1998 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Updated.
+
+Wed Apr 15 13:01:28 1998 Ben Pfaff <blp@gnu.org>
+
+ * AUTHORS.html, BUGS.html, LANGUAGE.html, README.html,
+ THANKS.html: Removed.
+
+ * Makefile.am: Don't reference the deleted files.
+
+Mon Mar 9 00:55:59 1998 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: Updated.
+
+1998-03-05 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Updated.
+
+1998-02-23 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Updated.
+
+Fri Feb 13 15:35:44 1998 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: Updated.
+
+Thu Feb 5 00:18:10 1998 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: Updated.
+
+ * pspp.texi: Revised.
+
+Tue Jan 13 23:44:43 1998 Ben Pfaff <blp@gnu.org>
+
+ * BUGS.html: Updated.
+
+ * LANGUAGE.html: Updated.
+
+Thu Jan 8 22:27:29 1998 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Updated.
+
+Sun Jan 4 18:12:11 1998 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: Updated.
+
+Wed Dec 24 22:36:09 1997 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Updated.
+
+Sun Dec 21 16:18:18 1997 Ben Pfaff <blp@gnu.org>
+
+ * pspp.texi: Updated.
+
+Fri Dec 5 22:53:35 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.man: Renamed pspp.man.
+
+ * fiasco.texi: Renamed pspp.texi.
+
+Fri Dec 5 21:52:29 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Updated.
+
+Tue Dec 2 14:35:34 1997 Ben Pfaff <blp@gnu.org>
+
+ * BUGS.html: Updated.
+
+Sat Nov 22 01:20:41 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Revised.
+
+Fri Nov 21 00:02:36 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.man, fiasco.texi: Revised.
+
+Tue Oct 28 16:08:01 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Revised.
+
+Tue Oct 7 20:22:14 1997 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: Updated.
+
+Sat Oct 4 16:19:27 1997 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: Updated.
+
+Thu Sep 18 21:33:44 1997 Ben Pfaff <blp@gnu.org>
+
+ * BUGS.html, LANGUAGE.html: Updated.
+
+Wed Aug 20 14:21:35 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (info_TEXINFOS) Remove FAQ.texi.
+
+Wed Aug 20 12:49:40 1997 Ben Pfaff <blp@gnu.org>
+
+ * ANNOUNCE.html.in, FAQ.texi, HELP-WANTED.html: Removed.
+
+ * BUGS.html, LANGUAGE.html, README.html.in: Updated per
+ suggestions of rms.
+
+ * Makefile.am: (noinst_DATA) Removed ANNOUNCE.html,
+ HELP-WANTED.html.
+ (EXTRA_DIST) Removed ANNOUNCE.html, ANNOUNCE.html.in,
+ HELP-WANTED.html.
+ (MAINTAINERCLEANFILES, HTML_FORMATTER) Removed.
+
+ * fiasco.texi: Revised.
+
+Sat Aug 16 10:51:51 1997 Ben Pfaff <blp@gnu.org>
+
+ * ANNOUNCE.html.in, HELP-WANTED.html, README.html.in: Updated per
+ suggestions of rms.
+
+ * AUTHORS.html, BUGS.html, FAQ.texi, LANGUAGE.html, THANKS.html,
+ fiasco.man, fiasco.texi: Updated.
+
+ * README-i386linux.html, dist.html.in.in, fiasco.lsm.in,
+ changelogs.html.top, changelogs.html.bot: Removed, all references
+ removed.
+
+Thu Aug 14 22:07:02 1997 Ben Pfaff <blp@gnu.org>
+
+ * ANNOUNCE.html.in, README.html.in, dist.html.in.in: Updated.
+
+ * Makefile.am: Use $(VERSION) instead of VERSION file.
+ (EXTRA_DIST) Add README-i386linux.
+
+Thu Aug 14 11:52:20 1997 Ben Pfaff <blp@gnu.org>
+
+ * ANNOUNCE.html.in, AUTHORS.html, BUGS.html, HELP-WANTED.html,
+ LANGUAGE.html, README-i386linux.html, README.html.in, THANKS.html,
+ changelogs.html.bot, changelogs.html.top: Revised.
+
+ * Makefile.am: (noinst_DATA) Remove dist.html, add dist.html.in.
+ (EXTRA_DIST) Add ONEWS, remove dist.html, dist.html.in, add
+ dist.html.in.in.
+ (MAINTAINERCLEANFILES) Add dist.html.in.
+ (dist.html) Removed.
+ (dist.html.in) New target depending on dist.html.in.in.
+ (docfiles) New target.
+
+ * dist.html.in: Renamed dist.html.in.in.
+
+Tue Aug 5 13:57:20 1997 Ben Pfaff <blp@gnu.org>
+
+ * FAQ.texi, fiasco.texi: Updated.
+
+Sun Aug 3 11:34:43 1997 Ben Pfaff <blp@gnu.org>
+
+ * ANNOUNCE.html.in, AUTHORS.html, BUGS.html, FAQ.texi,
+ LANGUAGE.html, README-i386linux.html, README.html.in, THANKS.html,
+ changelogs.html.bot, dist.html.in, fiasco.texi: Updated.
+
+ * Makefile.am: (noinst_DATA, EXTRA_DIST) Add HELP-WANTED.html,
+ remove README-i386gnuwin32.html.
+ (MAINTAINERCLEANFILES) Remove README-i386gnuwin32.html, add
+ README-i386linux.
+ (README-i386linux) New target.
+
+ * README-i386gnuwin32.html.in: Removed.
+
+ * HELP-WANTED.html: New file.
+
+Thu Jul 17 21:40:28 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Generates fiasco.lsm from fiasco.lsm.in.
+
+Thu Jul 17 01:49:06 1997 Ben Pfaff <blp@gnu.org>
+
+ * FAQ.texi: Updated.
+
+ * Makefile.am: Completely rewritten.
+
+ * ANNOUNCE.html.in, README-i386gnuwin32.html.in,
+ README-i386linux.html, README.html.in, dist.html.in,
+ fiasco.lsm.in: New files.
+
+Fri Jul 11 23:01:32 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Updated.
+
+Sun Jul 6 20:46:38 1997 Ben Pfaff <blp@gnu.org>
+
+ * ANNOUNCE.html, FAQ.texi, README.html: Updated.
+
+ * Makefile.am: Add all the recent new files to EXTRA_DIST.
+
+Sat Jul 5 23:43:50 1997 Ben Pfaff <blp@gnu.org>
+
+ * ANNOUNCE.html, FAQ.texi, README.html: Updated.
+
+ * changelogs.html.bot: Fix copyright notice.
+
+ * fiasco.man: New file.
+
+Fri Jul 4 13:23:57 1997 Ben Pfaff <blp@gnu.org>
+
+ * changelogs.html.bot, changelogs.html.top: New files.
+
+ * fiasco.lsm: New file.
+
+ * ANNOUNCE.html, FAQ.texi, README.html: Updated.
+
+ * Makefile.am: (EXTRA_DIST) Removed duplicate assignment.
+
+Wed Jun 25 22:51:39 1997 Ben Pfaff <blp@gnu.org>
+
+ * FAQ.texi: Finished.
+
+ * README.html: Updates.
+
+Sun Jun 22 21:59:07 1997 Ben Pfaff <blp@gnu.org>
+
+ * ANNOUNCE.html, BUGS.html, LANGUAGE.html, README.html,
+ fiasco.texi: Updates.
+
+ * Makefile.am: Add `FAQ.texi' to info_TEXINFOS.
+
+ * FAQ.texi: New file.
+
+Tue Jun 3 23:25:51 1997 Ben Pfaff <blp@gnu.org>
+
+ * AUTHORS.html, BUGS.html, README.html, THANKS.html: Updates.
+
+ * fiasco.texi: Update.
+
+Sun Jun 1 11:58:27 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Development.
+
+Fri May 30 19:39:37 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Development.
+
+Mon May 5 21:57:20 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Development.
+
+Fri May 2 22:07:26 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Development.
+
+Thu May 1 14:58:31 1997 Ben Pfaff <blp@gnu.org>
+
+ * BUGS.html: Update.
+
+ * fiasco.texi: Development.
+
+Wed Apr 23 21:33:48 1997 Ben Pfaff <blp@gnu.org>
+
+ * THANKS.html: Update.
+
+Fri Apr 18 15:42:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Maintainer-clean Makefile.in.
+
+Thu Mar 27 01:11:29 1997 Ben Pfaff <blp@gnu.org>
+
+ * THANKS.html: Added Fran,cois Pinard.
+
+Mon Mar 24 21:47:31 1997 Ben Pfaff <blp@gnu.org>
+
+ * THANKS.html: Spelling fix.
+
+Sat Feb 15 21:26:53 1997 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: Updated.
+
+Fri Feb 14 23:32:58 1997 Ben Pfaff <blp@gnu.org>
+
+ * BUGS.html: Updated.
+
+Wed Jan 22 21:54:00 1997 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: RENAME VARIABLES is implemented.
+
+Thu Jan 16 13:08:57 1997 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: MODIFY VARS now works.
+
+ * README.html: Added `alpha.gnu.ai.mit.edu' to list of sites.
+
+Sat Jan 11 15:44:15 1997 Ben Pfaff <blp@gnu.org>
+
+ * README.html: Commented out sunsite reference and added
+ ALPHA-release warning.
+
+Fri Jan 10 20:22:08 1997 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: Reformatted.
+
+Thu Jan 2 19:08:23 1997 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: Updated.
+
+Wed Jan 1 22:08:10 1997 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: Updated.
+
+Sun Dec 29 21:36:48 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html: Updated.
+
+ * fiasco.texi: Updated.
+
+Tue Dec 24 20:42:32 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html, README.html: Miscellaneous changes.
+
+Sun Dec 22 23:10:39 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE.html, README.html: Miscellaneous changes.
+
+ * AUTHORS.html, BUGS.html, THANKS.html: New files derived from
+ corresponding files without the `.html'.
+
+Sat Dec 21 21:51:04 1996 Ben Pfaff <blp@gnu.org>
+
+ * AUTHORS: Grammar fix.
+
+ * LANGUAGE.html: New file. LANGUAGE is now automatically
+ generated from this html source through lynx.
+
+ * README.html: Similar situation to LANGUAGE.html.
+
+Sun Dec 15 15:32:16 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+Fri Dec 6 23:53:47 1996 Ben Pfaff <blp@gnu.org>
+
+ * AUTHORS, BUGS, LANGUAGE, README: Updated.
+
+ * fiasco.texi: Fixes.
+
+Wed Dec 4 21:34:17 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+Sun Dec 1 17:19:00 1996 Ben Pfaff <blp@gnu.org>
+
+ * BUGS, LANGUAGE, NEWS: Misc. changes.
+
+Sun Nov 24 14:53:53 1996 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Changed many instances of `illegal' to `invalid'.
+
+Wed Oct 30 17:13:08 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+ * README: Updated.
+
+Sat Oct 26 23:06:06 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+Sat Oct 26 10:39:25 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+Thu Oct 24 20:13:42 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+ * README: Updated.
+
+ * fiasco.texi: Updated.
+
+Thu Oct 24 17:47:14 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+Wed Oct 23 21:53:43 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+Tue Oct 22 17:27:04 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+ * fiasco.texi: Very minor changes.
+
+Sun Sep 29 19:37:03 1996 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Continued development.
+
+Tue Sep 24 18:39:09 1996 Ben Pfaff <blp@gnu.org>
+
+ * avl.texi, gpl.texi: Removed.
+
+ * fiasco.texi: Changed copyright notices; deleted references to
+ avl.texi, gpl.texi.
+
+Sat Sep 21 23:16:31 1996 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Continued work--added to configuration chapter.
+
+Fri Sep 20 22:52:28 1996 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Continued work--added to configuration chapter.
+
+Thu Sep 12 18:40:33 1996 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Continued work--added section on bug reports.
+
+Wed Sep 11 22:01:41 1996 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Added timestamp. Started some updating.
+
+Tue Sep 10 21:39:00 1996 Ben Pfaff <blp@gnu.org>
+
+ * LANGUAGE: Updated.
+
+ * README: Minor change.
+
+Mon Sep 9 21:43:13 1996 Ben Pfaff <blp@gnu.org>
+
+ * NEWS: Added automagic timestamp.
+
+ * README: Restructured, extended.
+
+ * BUGS, LANGUAGE: New files.
+
+Sat Jul 6 22:22:25 1996 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.texi: Remarked on broken Borland alloca().
+
+Mon Jul 1 13:00:00 1996 Ben Pfaff <blp@gnu.org>
+
+ * stat.texi: Renamed to `fiasco.texi'.
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+## Process this file with automake to produce Makefile.in -*- makefile -*-
+
+info_TEXINFOS = pspp.texi
+
+# FIXME: remove this when the manual is fixed to eliminate dangling
+# references.
+MAKEINFO = makeinfo --no-validate
+
+EXTRA_DIST = pspp.man
+
+MAINTAINERCLEANFILES = Makefile.in README.html
--- /dev/null
+#!/bin/sh
+# mdate-sh - get modification time of a file and pretty-print it
+# Copyright (C) 1995 Software Foundation, Inc.
+# Written by Ulrich Drepper <drepper@gnu.org>, June 1995
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# Prevent date giving response in another language.
+LANG=C
+export LANG
+LC_ALL=C
+export LC_ALL
+LC_TIME=C
+export LC_TIME
+
+# Get the extended ls output of the file.
+if ls -L /dev/null 1>/dev/null 2>&1; then
+ set - `ls -L -l $1`
+else
+ set - `ls -l $1`
+fi
+# The month is at least the fourth argument.
+# (3 shifts here, the next inside the loop)
+shift
+shift
+shift
+
+# Find the month. Next argument is day, followed by the year or time.
+month=
+until test $month
+do
+ shift
+ case $1 in
+ Jan) month=January; nummonth=1;;
+ Feb) month=February; nummonth=2;;
+ Mar) month=March; nummonth=3;;
+ Apr) month=April; nummonth=4;;
+ May) month=May; nummonth=5;;
+ Jun) month=June; nummonth=6;;
+ Jul) month=July; nummonth=7;;
+ Aug) month=August; nummonth=8;;
+ Sep) month=September; nummonth=9;;
+ Oct) month=October; nummonth=10;;
+ Nov) month=November; nummonth=11;;
+ Dec) month=December; nummonth=12;;
+ esac
+done
+
+day=$2
+
+# Here we have to deal with the problem that the ls output gives either
+# the time of day or the year.
+case $3 in
+ *:*) set `date`; eval year=\$$#
+ case $2 in
+ Jan) nummonthtod=1;;
+ Feb) nummonthtod=2;;
+ Mar) nummonthtod=3;;
+ Apr) nummonthtod=4;;
+ May) nummonthtod=5;;
+ Jun) nummonthtod=6;;
+ Jul) nummonthtod=7;;
+ Aug) nummonthtod=8;;
+ Sep) nummonthtod=9;;
+ Oct) nummonthtod=10;;
+ Nov) nummonthtod=11;;
+ Dec) nummonthtod=12;;
+ esac
+ # For the first six month of the year the time notation can also
+ # be used for files modified in the last year.
+ if (expr $nummonth \> $nummonthtod) > /dev/null;
+ then
+ year=`expr $year - 1`
+ fi;;
+ *) year=$3;;
+esac
+
+# The result.
+echo $day $month $year
--- /dev/null
+.\" PSPP - computes sample statistics.
+.\" Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+.\" Written by Ben Pfaff <blp@gnu.org>.
+.\"
+.\" This program is free software; you can redistribute it and/or
+.\" modify it under the terms of the GNU General Public License as
+.\" published by the Free Software Foundation; either version 2 of the
+.\" License, or (at your option) any later version.
+.\"
+.\" This program is distributed in the hope that it will be useful, but
+.\" WITHOUT ANY WARRANTY; without even the implied warranty of
+.\" MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+.\" General Public License for more details.
+.\"
+.\" You should have received a copy of the GNU General Public License
+.\" along with this program; if not, write to the Free Software
+.\" Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+.\" 02111-1307, USA.
+.\"
+.TH pspp 1 "4 Jul 1997" "manpage v1.0" "PSPP manual"
+.SH NAME
+pspp \- a system for statistical analysis
+.SH SYNOPSIS
+.B pspp
+\&.\|.\|.
+.SH DESCRIPTION
+.B pspp
+starts up the PSPP program. PSPP performs statistical analysis on
+sampled data. Please see Info document `pspp' for more details on
+using PSPP. For other miscellaneous information about PSPP, see
+the PSPP FAQ, which should be installed in /usr/doc/pspp.
+
+These documents and others are available in various formats. On
+Debian GNU/Linux systems, full documentation is available in directory
+`/usr/doc/pspp', in HTML and ASCII formats, and in `/usr/info', in
+Info format. TeX can be used to convert the Texinfo documentation in
+the source distribution to nice-looking output for printing.
+
+Documentation is also at http://www.gnu.org/software/pspp.
+
+.SH BUGS
+
+Probably a lot. Known bugs are listed in the documentation files
+BUGS, LANGUAGE, and TODO, depending on type. Please see those files
+for more details.
--- /dev/null
+\input texinfo @c -*- texinfo -*-
+@c %**start of header
+@setfilename pspp.info
+@settitle PSPP
+@set TIMESTAMP Time-stamp: <2000-01-02 22:32:14 blp>
+@set EDITION 0.2
+@set VERSION 0.2
+@c For double-sided printing, uncomment:
+@c @setchapternewpage odd
+@c %**end of header
+
+@iftex
+@finalout
+@end iftex
+
+@ifinfo
+@format
+START-INFO-DIR-ENTRY
+* PSPP: (pspp). Statistical analysis package.
+END-INFO-DIR-ENTRY
+@end format
+
+PSPP, for statistical analysis of sampled data, by Ben Pfaff.
+
+This file documents PSPP, a statistical package for analysis of
+sampled data that uses a command language compatible with SPSS.
+
+Copyright (C) 1996-9, 2000 Free Software Foundation, Inc.
+
+This version of the PSPP documentation is consistent with version 2 of
+``texinfo.tex''.
+
+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.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission notice
+identical to this one except for the removal of this paragraph (this
+paragraph not being relevant to the printed manual).
+
+@end ignore
+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 condition for modified
+versions, except that this permission notice may be stated in a
+translation approved by the Free Software Foundation.
+@end ifinfo
+
+@titlepage
+@title PSPP
+@subtitle A System for Statistical Analysis
+@subtitle Edition @value{EDITION}, for PSPP version @value{VERSION}
+@author by Ben Pfaff
+
+@page
+@vskip 0pt plus 1filll
+
+PSPP Copyright @copyright{} 1997, 1998 Free Software Foundation, Inc.
+
+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 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 Foundation.
+@end titlepage
+
+@node Top, Introduction, (dir), (dir)
+@ifinfo
+@top PSPP
+
+This file documents the PSPP package for statistical analysis of sampled
+data. This is edition @value{EDITION}, for PSPP version
+@value{VERSION}, last modified at @value{TIMESTAMP}.
+
+@end ifinfo
+
+@menu
+* Introduction:: Description of the package.
+* License:: Your rights and obligations.
+* Credits:: Acknowledgement of authors.
+
+* Installation:: How to compile and install PSPP.
+* Configuration:: Configuring PSPP.
+* Invocation:: Starting and running PSPP.
+
+* Language:: Basics of the PSPP command language.
+* Expressions:: Numeric and string expression syntax.
+
+* Data Input and Output:: Reading data from user files.
+* System and Portable Files:: Dealing with system & portable files.
+* Variable Attributes:: Adjusting and examining variables.
+* Data Manipulation:: Simple operations on data.
+* Data Selection:: Select certain cases for analysis.
+* Conditionals and Looping:: Doing things many times or not at all.
+* Statistics:: Basic statistical procedures.
+* Utilities:: Other commands.
+* Not Implemented:: What's not here yet
+
+* Data File Format:: Format of PSPP system files.
+* Portable File Format:: Format of PSPP portable files.
+* q2c Input Format:: Format of syntax accepted by q2c.
+
+* Bugs:: Known problems; submitting bug reports.
+
+* Function Index:: Index of PSPP functions for expressions.
+* Concept Index:: Index of concepts.
+* Command Index:: Index of PSPP procedures.
+
+@end menu
+
+@node Introduction, License, Top, Top
+@chapter Introduction
+@cindex introduction
+
+@cindex PSPP language
+@cindex language, PSPP
+PSPP is a tool for statistical analysis of sampled data. It reads a
+syntax file and a data file, analyzes the data, and writes the results
+to a listing file or to standard output.
+
+The language accepted by PSPP is similar to those accepted by SPSS
+statistical products. The details of PSPP's language are given
+later in this manual.
+
+@cindex files, PSPP
+@cindex output, PSPP
+@cindex PostScript
+@cindex graphics
+@cindex Ghostscript
+@cindex Free Software Foundation
+PSPP produces output in two forms: tables and charts. Both of these can
+be written in several formats; currently, ASCII, PostScript, and HTML
+are supported. In the future, more drivers, such as PCL and X Window
+System drivers, may be developed. For now, Ghostscript, available from
+the Free Software Foundation, may be used to convert PostScript chart
+output to other formats.
+
+The current version of PSPP, @value{VERSION}, is woefully incomplete in
+terms of its statistical procedure support. PSPP is a work in progress.
+The author hopes to support fully support all features in the products
+that PSPP replaces, eventually. The author welcomes questions,
+comments, donations, and code submissions. @xref{Bugs,,Submitting Bug
+Reports}, for instructions on contacting the author.
+
+@node License, Credits, Introduction, Top
+@chapter Your rights and obligations
+@cindex license
+@cindex your rights and obligations
+@cindex rights, your
+@cindex obligations, your
+
+@cindex Free Software Foundation
+@cindex GNU General Public License
+@cindex General Public License
+@cindex GPL
+@cindex distribution
+@cindex redistribution
+Most of PSPP is distributed under the GNU General Public
+License. The General Public License says, in effect, that you may
+modify and distribute PSPP as you like, as long as you grant the
+same rights to others. It also states that you must provide source code
+when you distribute PSPP, or, if you obtained PSPP
+source code from an anonymous ftp site, give out the name of that site.
+
+The General Public License is given in full in the source distribution
+as file @file{COPYING}. In Debian GNU/Linux, this file is also
+available as file @file{/usr/doc/copyright/GPL}.
+
+To quote the GPL itself:
+
+@quotation
+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.,
+675 Mass Ave, Cambridge, MA 02139, USA.
+@end quotation
+
+@node Credits, Installation, License, Top
+@chapter Credits
+@cindex credits
+@cindex authors
+
+@cindex Minton, Claire
+@cindex @cite{Cat's Cradle}
+@cindex Vonnegut, Kurt, Jr.
+@cindex quotations
+@quotation
+I'm always embarrassed when I see an index an author has made of his own
+work. It's a shameless exhibition---to the @i{trained} eye. Never
+index your own book.
+
+---Claire Minton, @cite{Cat's Cradle}, Kurt Vonnegut, Jr.
+@end quotation
+
+@cindex Pfaff, Ben
+Most of PSPP, as well as this manual (including the indices),
+was written by Ben Pfaff. @xref{Contacting the Author}, for
+instructions on contacting the author.
+
+@cindex Covington, Michael A.
+@cindex Van Zandt, James
+@cindex @file{ftp.cdrom.com}
+@cindex @file{/pub/algorithms/c/julcal10}
+@cindex @file{julcal.c}
+@cindex @file{julcal.h}
+The PSPP source code incorporates @code{julcal10} originally
+written by Michael A. Covington and translated into C by Jim Van Zandt.
+The original package can be found in directory
+@file{ftp://ftp.cdrom.com/pub/algorithms/c/julcal10}. The entire
+contents of that directory constitute the package. The files actually
+used in PSPP are @code{julcal.c} and @code{julcal.h}.
+
+@node Installation, Configuration, Credits, Top
+@chapter Installing PSPP
+@cindex installation
+@cindex PSPP, installing
+
+@cindex GNU C compiler
+@cindex gcc
+@cindex compiler, recommended
+@cindex compiler, gcc
+PSPP conforms to the GNU Coding Standards. PSPP is written in, and
+requires for proper operation, ANSI/ISO C. You might want to
+additionally note the following points:
+
+@itemize @bullet
+@item
+The compiler and linker must allow for significance of several
+characters in external identifiers. The exact number is unknown but at
+least 31 is recommended.
+
+@item
+The @code{int} type must be 32 bits or wider.
+
+@item
+The recommended compiler is gcc 2.7.2.1 or later, but any ANSI compiler
+will do if it fits the above criteria.
+@end itemize
+
+Many UNIX variants should work out-of-the-box, as PSPP uses GNU
+autoconf to detect differences between environments. Please report any
+problems with compilation of PSPP under UNIX and UNIX-like operating
+systems---portability is a major concern of the author.
+
+The pages below give specific instructions for installing PSPP
+on each type of system mentioned above.
+
+@menu
+* UNIX installation:: Installing on UNIX-like environments.
+@end menu
+
+@node UNIX installation, , Installation, Installation
+@section UNIX installation
+@cindex UNIX, installing PSPP under
+@cindex installation, under UNIX
+@noindent
+To install PSPP under a UNIX-like operating system, follow the steps
+below in order. Some of the text below was taken directly from various
+Free Software Foundation sources.
+
+@enumerate
+@item
+@code{cd} to the directory containing the PSPP source.
+
+@cindex configure, GNU
+@cindex GNU configure
+@item
+Type @samp{./configure} to configure for your particular operating
+system and compiler. Running @code{configure} takes a while. While
+running, it displays some messages telling which features it is checking
+for.
+
+You can optionally supply some options to @code{configure} in order to
+give it hints about how to do its job. Type @code{./configure --help}
+to see a list of options. One of the most useful options is
+@samp{--with-checker}, which enables the use of the Checker memory
+debugger under supported operating systems. Checker must already be
+installed to use this option. Do not use @samp{--with-checker} if you
+are not debugging PSPP itself.
+
+@cindex @file{Makefile}
+@cindex @file{config.h}
+@cindex @file{pref.h}
+@cindex makefile
+@item
+(optional) Edit @file{Makefile}, @file{config.h}, and @file{pref.h}.
+These files are produced by @code{configure}. Note that most PSPP
+settings can be changed at runtime.
+
+@file{pref.h} is only generated by @code{configure} if it does not
+already exist. (It's copied from @file{prefh.orig}.)
+
+@cindex compiling
+@item
+Type @samp{make} to compile the package. If there are any errors during
+compilation, try to fix them. If modifications are necessary to compile
+correctly under your configuration, contact the author.
+@xref{Bugs,,Submitting Bug Reports}, for details.
+
+@cindex self-tests, running
+@item
+Type @samp{make check} to run self-tests on the compiled PSPP package.
+
+@cindex installation
+@cindex PSPP, installing
+@cindex @file{/usr/local/share/pspp/}
+@cindex @file{/usr/local/bin/}
+@cindex @file{/usr/local/info/}
+@cindex documentation, installing
+@item
+Become the superuser and type @samp{make install} to install the
+PSPP binaries, by default in @file{/usr/local/bin/}. The
+directory @file{/usr/local/share/pspp/} is created and populated with
+files needed by PSPP at runtime. This step will also cause the
+PSPP documentation to be installed in @file{/usr/local/info/},
+but only if that directory already exists.
+
+@item
+(optional) Type @samp{make clean} to delete the PSPP binaries
+from the source tree.
+@end enumerate
+
+@node Configuration, Invocation, Installation, Top
+@chapter Configuring PSPP
+@cindex configuration
+@cindex PSPP, configuring
+
+PSPP has dozens of configuration possibilities and hundreds of
+settings. This is both a bane and a blessing. On one hand, it's
+possible to easily accommodate diverse ranges of setups. But, on the
+other, the multitude of possibilities can overwhelm the casual user.
+Fortunately, the configuration mechanisms are profusely described in the
+sections below@enddots{}
+
+@menu
+* File locations:: How PSPP finds config files.
+* Configuration techniques:: Many different methods of configuration@enddots{}
+* Configuration files:: How configuration files are read.
+* Environment variables:: All about environment variables.
+* Output devices:: Describing your terminal(s) and printer(s).
+* PostScript driver class:: Configuration of PostScript devices.
+* ASCII driver class:: Configuration of character-code devices.
+* HTML driver class:: Configuration for HTML output.
+* Miscellaneous configuring:: Even more configuration variables.
+* Improving output quality:: Hints for producing ever-more-lovely output.
+@end menu
+
+@node File locations, Configuration techniques, Configuration, Configuration
+@section Locating configuration files
+
+PSPP uses the same method to find most of its configuration files:
+
+@enumerate
+@item
+The @dfn{base name} of the file being sought is determined.
+
+@item
+The path to search is determined.
+
+@item
+Each directory in the search path, from left to right, is searched for a
+file with the name of the base name. The first occurrence is read
+as the configuration file.
+@end enumerate
+
+The first two steps are elaborated below for the sake of our pedantic
+friends.
+
+@enumerate
+@item
+A @dfn{base name} is a file name lacking an absolute directory
+reference. Some examples of base names are: @file{ps-encodings},
+@file{devices}, @file{devps/DESC} (under UNIX), @file{devps\DESC} (under
+M$ environments).
+
+Determining the base name is a two-step process:
+
+@enumerate a
+@item
+If the appropriate environment variable is defined, the value of that
+variable is used (@pxref{Environment variables}). For instance, when
+searching for the output driver initialization file, the variable
+examined is @code{STAT_OUTPUT_INIT_FILE}.
+
+@item
+Otherwise, the compiled-in default is used. For example, when searching
+for the output driver initialization file, the default base name is
+@file{devices}.
+@end enumerate
+
+@strong{Please note:} If a user-specified base name does contain an
+absolute directory reference, as in a file name like
+@file{/home/pfaff/fonts/TR}, no path is searched---the file name is used
+exactly as given---and the algorithm terminates.
+
+@item
+The path is the first of the following that is defined:
+
+@itemize @bullet
+@item
+A variable definition for the path given in the user environment. This
+is a PSPP-specific environment variable name; for instance,
+@code{STAT_OUTPUT_INIT_PATH}.
+
+@item
+In some cases, another, less-specific environment variable is checked.
+For instance, when searching for font files, the PostScript driver first
+checks for a variable with name @code{STAT_GROFF_FONT_PATH}, then for
+one with name @code{GROFF_FONT_PATH}. (However, font searching has its
+own list of esoteric search rules.)
+
+@item
+The configuration file path, which is itself determined by the
+following rules:
+
+@enumerate a
+@item
+If the command line contains an option of the form @samp{-B @var{path}}
+or @samp{--config-dir=@var{path}}, then the value given on the
+rightmost occurrence of such an option is used.
+
+@item
+Otherwise, if the environment variable @code{STAT_CONFIG_PATH} is
+defined, the value of that variable is used.
+
+@item
+Otherwise, the compiled-in fallback default is used. On UNIX machines,
+the default fallback path is
+
+@enumerate 1
+@item
+@file{~/.pspp}
+
+@item
+@file{/usr/local/lib/pspp}
+
+@item
+@file{/usr/lib/pspp}
+@end enumerate
+
+On DOS machines, the default fallback path is:
+
+@enumerate 1
+@item
+All the paths from the DOS search path in the @samp{PATH} environment
+variable, in left-to-right order.
+
+@item
+@file{C:\PSPP}, as a last resort.
+@end enumerate
+
+Note that the installer of PSPP can easily change this default
+fallback path; thus the above should not be taken as gospel.
+@end enumerate
+@end itemize
+@end enumerate
+
+As a final note: Under DOS, directories given in paths are delimited by
+semicolons (@samp{;}); under UNIX, directories are delimited by colons
+(@samp{:}). This corresponds with the standard path delimiter under
+these OSes.
+
+@node Configuration techniques, Configuration files, File locations, Configuration
+@section Configuration techniques
+
+There are many ways that PSPP can be configured. These are
+described in the list below. Values given by earlier items take
+precedence over those given by later items.
+
+@enumerate
+@item
+Syntax commands that modify settings, such as @code{SET}.
+
+@item
+Command-line options. @xref{Invocation}.
+
+@item
+PSPP-specific environment variable contents. @xref{Environment
+variables}.
+
+@item
+General environment variable contents. @xref{Environment variables}.
+
+@item
+Configuration file contents. @xref{Configuration files}.
+
+@item
+Fallback defaults.
+@end enumerate
+
+Some of the above may not apply to a particular setting. For instance,
+the current pager (such as @samp{more}, @samp{most}, or @samp{less})
+cannot be determined by configuration file contents because there is no
+appropriate configuration file.
+
+@node Configuration files, Environment variables, Configuration techniques, Configuration
+@section Configuration files
+
+Most configuration files have a common form:
+
+@itemize @bullet
+@item
+Each line forms a separate command or directive. This means that lines
+cannot be broken up, unless they are spliced together with a trailing
+backslash, as described below.
+
+@item
+Before anything else is done, trailing whitespace is removed.
+
+@item
+When a line ends in a backslash (@samp{\}), the backslash is removed,
+and the next line is read and appended to the current line.
+
+@itemize @minus
+@item
+Whitespace preceding the backslash is retained.
+
+@item
+This rule continues to be applied until the line read does not end in a
+backslash.
+
+@item
+It is an error if the last line in the file ends in a backslash.
+@end itemize
+
+@item
+Comments are introduced by an octothorpe (#), and continue until the
+end of the line.
+
+@itemize @minus
+@item
+An octothorpe inside balanced pairs of double quotation marks (@samp{"})
+or single quotation marks (@samp{'}) does not introduce a comment.
+
+@item
+The backslash character can be used inside balanced quotes of either
+type to escape the following character as a literal character.
+
+(This is distinct from the use of a backslash as a line-splicing
+character.)
+
+@item
+Line splicing takes place before comment removal.
+@end itemize
+
+@item
+Blank lines, and lines that contain only whitespace, are ignored.
+@end itemize
+
+@node Environment variables, Output devices, Configuration files, Configuration
+@section Environment variables
+
+You may think the concept of environment variables is a fairly simple
+one. However, the author of PSPP has found a way to complicate
+even something so simple. Environment variables are further described
+in the sections below:
+
+@menu
+* Variable values:: Values of variables are determined this way.
+* Environment substitutions:: How environment substitutions are made.
+* Predefined variables:: A few variables are automatically defined.
+@end menu
+
+@node Variable values, Environment substitutions, Environment variables, Environment variables
+@subsection Values of environment variables
+
+Values for environment variables are obtained by the following means,
+which are arranged in order of decreasing precedence:
+
+@enumerate
+@item
+Command-line options. @xref{Invocation}.
+
+@item
+The @file{environment} configuration file---more on this below.
+
+@item
+Actual environment variables (defined in the shell or other parent
+process).
+@end enumerate
+
+The @file{environment} configuration file is located through application
+of the usual algorithm for configuration files (@pxref{File locations}),
+except that its contents do not affect the search path used to find
+@file{environment} itself. Use of @file{environment} is discouraged on
+systems that allow an arbitrarily large environment; it is supported for
+use on systems like MS-DOS that limit environment size.
+
+@file{environment} is composed of lines having the form
+@samp{@var{key}=@var{value}}, where @var{key} and the equals sign
+(@samp{=}) are required, and @var{value} is optional. If @var{value} is
+given, variable @var{key} is given that value; if @var{value} is absent,
+variable @var{key} is undefined (deleted). Variables may not be defined
+with a null value.
+
+Environment substitutions are performed on each line in the file
+(@pxref{Environment substitutions}).
+
+See @ref{Configuration files}, for more details on formatting of the
+environment configuration file.
+
+@quotation
+@strong{Please note:} Support for @file{environment} is not yet
+implemented.
+@end quotation
+
+@node Environment substitutions, Predefined variables, Variable values, Environment variables
+@subsection Environment substitutions
+
+Much of the power of environment variables lies in the way that they may
+be substituted into configuration files. Variable substitutions are
+described below.
+
+The line is scanned from left to right. In this scan, all characters
+other than dollar signs (@samp{$}) are retained unmolested. Dollar
+signs, however, introduce an environment variable reference. References
+take three forms:
+
+@table @code
+@item $@var{var}
+Replaced by the value of environment variable @var{var}, determined as
+specified in @ref{Variable values}. @var{var} must be one of the
+following:
+
+@itemize @bullet
+@item
+One or more letters.
+
+@item
+Exactly one nonalphabetic character. This may not be a left brace
+(@samp{@{}).
+@end itemize
+
+@item $@{@var{var}@}
+Same as above, but @var{var} may contain any character (except
+@samp{@}}).
+
+@item $$
+Replaced by a single dollar sign.
+@end table
+
+Undefined variables expand to a empty value.
+
+@node Predefined variables, , Environment substitutions, Environment variables
+@subsection Predefined environment variables
+
+There are two environment variables predefined for use in environment
+substitutions:
+
+@table @samp
+@item VER
+Defined as the version number of PSPP, as a string, in a format
+something like @samp{0.9.4}.
+
+@item ARCH
+Defined as the host architecture of PSPP, as a string, in standard
+cpu-manufacturer-OS format. For instance, Debian GNU/Linux 1.1 on an
+Intel machine defines this as @samp{i586-unknown-linux}. This is
+somewhat dependent on the system used to compile PSPP.
+@end table
+
+Nothing prevents these values from being overridden, although it's a
+good idea not to do so.
+
+@node Output devices, PostScript driver class, Environment variables, Configuration
+@section Output devices
+
+Configuring output devices is the most complicated aspect of configuring
+PSPP. The output device configuration file is named
+@file{devices}. It is searched for using the usual algorithm for
+finding configuration files (@pxref{File locations}). Each line in the
+file is read in the usual manner for configuration files
+(@pxref{Configuration files}).
+
+Lines in @file{devices} are divided into three categories, described
+briefly in the table below:
+
+@table @i
+@item driver category definitions
+Define a driver in terms of other drivers.
+
+@item macro definitions
+Define environment variables local to the the output driver
+configuration file.
+
+@item device definitions
+Describe the configuration of an output device.
+@end table
+
+The following sections further elaborate the contents of the
+@file{devices} file.
+
+@menu
+* Driver categories:: How to organize the driver namespace.
+* Macro definitions:: Environment variables local to @file{devices}.
+* Device definitions:: Output device descriptions.
+* Dimensions:: Lengths, widths, sizes, @enddots{}
+* papersize:: Letter, legal, A4, envelope, @enddots{}
+* Distinguishing line types:: Details on @file{devices} parsing.
+* Tokenizing lines:: Dividing @file{devices} lines into tokens.
+@end menu
+
+@node Driver categories, Macro definitions, Output devices, Output devices
+@subsection Driver categories
+
+Drivers can be divided into categories. Drivers are specified by their
+names, or by the names of the categories that they are contained in.
+Only certain drivers are enabled each time PSPP is run; by
+default, these are the drivers in the category `default'. To enable a
+different set of drivers, use the @samp{-o @var{device}} command-line
+option (@pxref{Invocation}).
+
+Categories are specified with a line of the form
+@samp{@var{category}=@var{driver1} @var{driver2} @var{driver3} @var{@dots{}}
+@var{driver@var{n}}}. This line specifies that the category
+@var{category} is composed of drivers named @var{driver1},
+@var{driver2}, and so on. There may be any number of drivers in the
+category, from zero on up.
+
+Categories may also be specified on the command line
+(@pxref{Invocation}).
+
+This is all you need to know about categories. If you're still curious,
+read on.
+
+First of all, the term `categories' is a bit of a misnomer. In fact,
+the internal representation is nothing like the hierarchy that the term
+seems to imply: a linear list is used to keep track of the enabled
+drivers.
+
+When PSPP first begins reading @file{devices}, this list contains
+the name of any drivers or categories specified on the command line, or
+the single item `default' if none were specified.
+
+Each time a category definition is specified, the list is searched for
+an item with the value of @var{category}. If a matching item is found,
+it is deleted. If there was a match, the list of drivers (@var{driver1}
+through @var{driver@var{n}}) is then appended to the list.
+
+Each time a driver definition line is encountered, the list is searched.
+If the list contains an item with that driver's name, the driver is
+enabled and the item is deleted from the list. Otherwise, the driver
+is not enabled.
+
+It is an error if the list is not empty when the end of @file{devices}
+is reached.
+
+@node Macro definitions, Device definitions, Driver categories, Output devices
+@subsection Macro definitions
+
+Macro definitions take the form @samp{define @var{macroname}
+@var{definition}}. In such a macro definition, the environment variable
+@var{macroname} is defined to expand to the value @var{definition}.
+Before the definition is made, however, any macros used in
+@var{definition} are expanded.
+
+Please note the following nuances of macro usage:
+
+@itemize @bullet
+@item
+For the purposes of this section, @dfn{macro} and @dfn{environment
+variable} are synonyms.
+
+@item
+Macros may not take arguments.
+
+@item
+Macros may not recurse.
+
+@item
+Macros are just environment variable definitions like other environment
+variable definitions, with the exception that they are limited in scope
+to the @file{devices} configuration file.
+
+@item
+Macros override other all environment variables of the same name (within
+the scope of @file{devices}).
+
+@item
+Earlier macro definitions for a particular @var{key} override later
+ones. In particular, macro definitions on the command line override
+those in the device definition file. @xref{Non-option Arguments}.
+
+@item
+There are two predefined macros, whose values are determined at runtime:
+
+@table @samp
+@item viewwidth
+Defined as the width of the console screen, in columns of text.
+
+@item viewlength
+Defined as the length of the console screen, in lines of text.
+@end table
+@end itemize
+
+@node Device definitions, Dimensions, Macro definitions, Output devices
+@subsection Driver definitions
+
+Driver definitions are the ultimate purpose of the @file{devices}
+configuration file. These are where the real action is. Driver
+definitions tell PSPP where it should send its output.
+
+Each driver definition line is divided into four fields. These fields
+are delimited by colons (@samp{:}). Each line is subjected to
+environment variable interpolation before it is processed further
+(@pxref{Environment substitutions}). From left to right, the four
+fields are, in brief:
+
+@table @i
+@item driver name
+A unique identifier, used to determine whether to enable the driver.
+
+@item class name
+One of the predefined driver classes supported by PSPP. The
+currently supported driver classes include `postscript' and `ascii'.
+
+@item device type(s)
+Zero or more of the following keywords, delimited by spaces:
+
+@table @code
+@item screen
+
+Indicates that the device is a screen display. This may reduce the
+amount of buffering done by the driver, to make interactive use more
+convenient.
+
+@item printer
+
+Indicates that the device is a printer.
+
+@item listing
+
+Indicates that the device is a listing file.
+@end table
+
+These options are just hints to PSPP and do not cause the output to be
+directed to the screen, or to the printer, or to a listing file---those
+must be set elsewhere in the options. They are used primarily to decide
+which devices should be enabled at any given time. @xref{SET}, for more
+information.
+
+@item options
+An optional set of options to pass to the driver itself. The exact
+format for the options varies among drivers.
+@end table
+
+The driver is enabled if:
+
+@enumerate
+@item
+Its driver name is specified on the command line, or
+
+@item
+It's in a category specified on the command line, or
+
+@item
+If no categories or driver names are specified on the command line, it
+is in category @code{default}.
+@end enumerate
+
+For more information on driver names, see @ref{Driver categories}.
+
+The class name must be one of those supported by PSPP. The
+classes supported depend on the options with which PSPP was
+compiled. See later sections in this chapter for descriptions of the
+available driver classes.
+
+Options are dependent on the driver. See the driver descriptions for
+details.
+
+@node Dimensions, papersize, Device definitions, Output devices
+@subsection Dimensions
+
+Quite often in configuration it is necessary to specify a length or a
+size. PSPP uses a common syntax for all such, calling them
+collectively by the name @dfn{dimensions}.
+
+@itemize @bullet
+@item
+You can specify dimensions in decimal form (@samp{12.5}) or as
+fractions, either as mixed numbers (@samp{12-1/2}) or raw fractions
+(@samp{25/2}).
+
+@item
+A number of different units are available. These are suffixed to the
+numeric part of the dimension. There must be no spaces between the
+number and the unit. The available units are identical to those offered
+by the popular typesetting system @TeX{}:
+
+@table @code
+@item in
+inch (1 @code{in} = 2.54 @code{cm})
+
+@item "
+inch (1 @code{in} = 2.54 @code{cm})
+
+@item pt
+printer's point (1 @code{in} = 72.27 @code{pt})
+
+@item pc
+pica (12 @code{pt} = 1 @code{pc})
+
+@item bp
+PostScript point (1 @code{in} = 72 @code{bp})
+
+@item cm
+centimeter
+
+@item mm
+millimeter (10 @code{mm} = 1 @code{cm})
+
+@item dd
+didot point (1157 @code{dd} = 1238 @code{pt})
+
+@item cc
+cicero (1 @code{cc} = 12 @code{dd})
+
+@item sp
+scaled point (65536 @code{sp} = 1 @code{pt})
+@end table
+
+@item
+If no explicit unit is given, a DWIM@footnote{Do What I Mean}
+``feature'' attempts to guess the best unit:
+
+@itemize @minus
+@item
+Numbers less than 50 are assumed to be in inches.
+
+@item
+Numbers 50 or greater are assumed to be in millimeters.
+@end itemize
+@end itemize
+
+@node papersize, Distinguishing line types, Dimensions, Output devices
+@subsection Paper sizes
+
+Output drivers usually deal with some sort of hardcopy media. This
+media is called @dfn{paper} by the drivers, though in reality it could
+be a transparency or film or thinly veiled sarcasm. To make it easier
+for you to deal with paper, PSPP allows you to have (of course!) a
+configuration file that gives symbolic names, like ``letter'' or
+``legal'' or ``a4'', to paper sizes, rather than forcing you to use
+cryptic numbers like ``8-1/2 x 11'' or ``210 by 297''. Surprisingly
+enough, this configuration file is named @file{papersize}.
+@xref{Configuration files}.
+
+When PSPP tries to connect a symbolic paper name to a paper size, it
+reads and parses each non-comment line in the file, in order. The first
+field on each line must be a symbolic paper name in double quotes.
+Paper names may not contain double quotes. Paper names are not
+case-sensitive: @samp{legal} and @samp{Legal} are equivalent.
+
+If a match is found for the paper name, the rest of the line is parsed.
+If it is found to be a pair of dimensions (@pxref{Dimensions}) separated
+by either @samp{x} or @samp{by}, then those are taken to be the paper
+size, in order of width followed by length. There @emph{must} be at
+least one space on each side of @samp{x} or @samp{by}.
+
+Otherwise the line must be of the form
+@samp{"@var{paper-1}"="@var{paper-2}"}. In this case the target of the
+search becomes paper name @var{paper-2} and the search through the file
+continues.
+
+@node Distinguishing line types, Tokenizing lines, papersize, Output devices
+@subsection How lines are divided into types
+
+The lines in @file{devices} are distinguished in the following manner:
+
+@enumerate
+@item
+Leading whitespace is removed.
+
+@item
+If the resulting line begins with the exact string @code{define},
+followed by one or more whitespace characters, the line is processed as
+a macro definition.
+
+@item
+Otherwise, the line is scanned for the first instance of a colon
+(@samp{:}) or an equals sign (@samp{=}).
+
+@item
+If a colon is encountered first, the line is processed as a driver
+definition.
+
+@item
+Otherwise, if an equals sign is encountered, the line is processed as a
+macro definition.
+
+@item
+Otherwise, the line is ill-formed.
+@end enumerate
+
+@node Tokenizing lines, , Distinguishing line types, Output devices
+@subsection How lines are divided into tokens
+
+Each driver definition line is run through a simple tokenizer. This
+tokenizer recognizes two basic types of tokens.
+
+The first type is an equals sign (@samp{=}). Equals signs are both
+delimiters between tokens and tokens in themselves.
+
+The second type is an identifier or string token. Identifiers and
+strings are equivalent after tokenization, though they are written
+differently. An identifier is any string of characters other than
+whitespace or equals sign.
+
+A string is introduced by a single- or double-quote character (@samp{'}
+or @samp{"}) and, in general, continues until the next occurrence of
+that same character. The following standard C escapes can also be
+embedded within strings:
+
+@table @code
+@item \'
+A single-quote (@samp{'}).
+
+@item \"
+A double-quote (@samp{"}).
+
+@item \?
+A question mark (@samp{?}). Included for hysterical raisins.
+
+@item \\
+A backslash (@samp{\}).
+
+@item \a
+Audio bell (ASCII 7).
+
+@item \b
+Backspace (ASCII 8).
+
+@item \f
+Formfeed (ASCII 12).
+
+@item \n
+Newline (ASCII 10)
+
+@item \r
+Carriage return (ASCII 13).
+
+@item \t
+Tab (ASCII 9).
+
+@item \v
+Vertical tab (ASCII 11).
+
+@item \@var{o}@var{o}@var{o}
+Each @samp{o} must be an octal digit. The character is the one having
+the octal value specified. Any number of octal digits is read and
+interpreted; only the lower 8 bits are used.
+
+@item \x@var{h}@var{h}
+Each @samp{h} must be a hex digit. The character is the one having the
+hexadecimal value specified. Any number of hex digits is read and
+interpreted; only the lower 8 bits are used.
+@end table
+
+Tokens, outside of quoted strings, are delimited by whitespace or equals
+signs.
+
+@node PostScript driver class, ASCII driver class, Output devices, Configuration
+@section The PostScript driver class
+
+The @code{postscript} driver class is used to produce output that is
+acceptable to PostScript printers and to PC-based PostScript
+interpreters such as Ghostscript. Continuing a long tradition,
+PSPP's PostScript driver is configurable to the point of
+absurdity.
+
+There are actually two PostScript drivers. The first one,
+@samp{postscript}, produces ordinary DSC-compliant PostScript output.
+The second one @samp{epsf}, produces an Encapsulated PostScript file.
+The two drivers are otherwise identical in configuration and in
+operation.
+
+The PostScript driver is described in further detail below.
+
+@menu
+* PS output options:: Output file options.
+* PS page options:: Paper, margins, scaling & rotation, more!
+* PS file options:: Configuration files.
+* PS font options:: Default fonts, font options.
+* PS line options:: Line widths, options.
+* Prologue:: Details on the PostScript prologue.
+* Encodings:: Details on PostScript font encodings.
+@end menu
+
+@node PS output options, PS page options, PostScript driver class, PostScript driver class
+@subsection PostScript output options
+
+These options deal with the form of the output and the output file
+itself:
+
+@table @code
+@item output-file=@var{filename}
+
+File to which output should be sent. This can be an ordinary filename
+(i.e., @code{"pspp.ps"}), a pipe filename (i.e., @code{"|lpr"}), or
+stdout (@code{"-"}). Default: @code{"pspp.ps"}.
+
+@item color=@var{boolean}
+
+Most of the time black-and-white PostScript devices are smart enough to
+map colors to shades themselves. However, you can cause the PSPP
+output driver to do an ugly simulation of this in its own driver by
+turning @code{color} off. Default: @code{on}.
+
+This is a boolean setting, as are many settings in the PostScript
+driver. Valid positive boolean values are @samp{on}, @samp{true},
+@samp{yes}, and nonzero integers. Negative boolean values are
+@samp{off}, @samp{false}, @samp{no}, and zero.
+
+@item data=@var{data-type}
+
+One of @code{clean7bit}, @code{clean8bit}, or @code{binary}. This
+controls what characters will be written to the output file. PostScript
+produced with @code{clean7bit} can be transmitted over 7-bit
+transmission channels that use ASCII control characters for line
+control. @code{clean8bit} is similar but allows characters above 127 to
+be written to the output file. @code{binary} allows any character in
+the output file. Default: @code{clean7bit}.
+
+@item line-ends=@var{line-end-type}
+
+One of @code{cr}, @code{lf}, or @code{crlf}. This controls what is used
+for newline in the output file. Default: @code{cr}.
+
+@item optimize-line-size=@var{level}
+
+Either @code{0} or @code{1}. If @var{level} is @code{1}, then short
+line segments will be collected and merged into longer ones. This
+reduces output file size but requires more time and memory. A
+@var{level} of @code{0} has the advantage of being better for
+interactive environments. @code{1} is the default unless the
+@code{screen} flag is set; in that case, the default is @code{0}.
+
+@item optimize-text-size=@var{level}
+
+One of @code{0}, @code{1}, or @code{2}, each higher level representing
+correspondingly more aggressive space savings for text in the output
+file and requiring correspondingly more time and memory. Unfortunately
+the levels presently are all the same. @code{1} is the default unless
+the @code{screen} flag is set; in that case, the default is @code{0}.
+@end table
+
+@node PS page options, PS file options, PS output options, PostScript driver class
+@subsection PostScript page options
+
+These options affect page setup:
+
+@table @code
+@item headers=@var{boolean}
+
+Controls whether the standard headers showing the time and date and
+title and subtitle are printed at the top of each page. Default:
+@code{on}.
+
+@item paper-size=@var{paper-size}
+
+Paper size, either as a symbolic name (i.e., @code{letter} or @code{a4})
+or specific measurements (i.e., @code{8-1/2x11} or @code{"210 x 297"}.
+@xref{papersize, , Paper sizes}. Default: @code{letter}.
+
+@item orientation=@var{orientation}
+
+Either @code{portrait} or @code{landscape}. Default: @code{portrait}.
+
+@item left-margin=@var{dimension}
+@itemx right-margin=@var{dimension}
+@itemx top-margin=@var{dimension}
+@itemx bottom-margin=@var{dimension}
+
+Sets the margins around the page. The headers, if enabled, are not
+included in the margins; they are in addition to the margins. For a
+description of dimensions, see @ref{Dimensions}. Default: @code{0.5in}.
+
+@end table
+
+@node PS file options, PS font options, PS page options, PostScript driver class
+@subsection PostScript file options
+
+Oh, my. You don't really want to know about the way that the PostScript
+driver deals with files, do you? Well I suppose you're entitled, but I
+warn you right now: it's not pretty. Here goes@enddots{}
+
+First let's look at the options that are available:
+
+@table @code
+
+@item font-dir=@var{font-directory}
+
+Sets the font directory. Default: @code{devps}.
+
+@item prologue-file=@var{prologue-file-name}
+
+Sets the name of the PostScript prologue file. You can write your own
+prologue, though I have no idea why you'd want to: see @ref{Prologue}.
+Default: @code{ps-prologue}.
+
+@item device-file=@var{device-file-name}
+
+Sets the name of the Groff-format device description file. The
+PostScript driver reads this in order to know about the scaling of fonts
+and so on. The format of such files is described in groff_font(5),
+included with Groff. Default: @code{DESC}.
+
+@item encoding-file=@var{encoding-file-name}
+
+Sets the name of the encoding file. This file contains a list of all
+font encodings that will be needed so that the driver can put all of
+them at the top of the prologue. @xref{Encodings}. Default:
+@code{ps-encodings}.
+
+If the specified encoding file cannot be found, this error will be
+silently ignored, since most people do not need any encodings besides
+the ones that can be found using @code{auto-encodings}, described below.
+
+@item auto-encode=@var{boolean}
+
+When enabled, the font encodings needed by the default proportional- and
+fixed-pitch fonts will automatically be dumped to the PostScript
+output. Otherwise, it is assumed that the user has an encoding file
+and knows how to use it (@pxref{Encodings}). There is probably no good
+reason to turn off this convenient feature. Default: @code{on}.
+
+@end table
+
+Next I suppose it's time to describe the search algorithm. When the
+PostScript driver needs a file, whether that file be a font, a
+PostScript prologue, or what you will, it searches in this manner:
+
+@enumerate
+
+@item
+Constructs a path by taking the first of the following that is defined:
+
+@enumerate a
+
+@item
+Environment variable @code{STAT_GROFF_FONT_PATH}. @xref{Environment
+variables}.
+
+@item
+Environment variable @code{GROFF_FONT_PATH}.
+
+@item
+The compiled-in fallback default.
+@end enumerate
+
+@item
+Constructs a base name from concatenating, in order, the font directory,
+a path separator (@samp{/} or @samp{\}), and the file to be found. A
+typical base name would be something like @code{devps/ps-encodings}.
+
+@item
+Searches for the base name in the path constructed above. If the file
+is found, the algorithm terminates.
+
+@item
+Searches for the base name in the standard configuration path. See
+@ref{File locations}, for more details. If the file is found, the
+algorithm terminates.
+
+@item
+At this point we remove the font directory and path separator from the
+base name. Now the base name is simply the file to be found, i.e.,
+@code{ps-encodings}.
+
+@item
+Searches for the base name in the path constructed in the first step.
+If the file is found, the algorithm terminates.
+
+@item
+Searches for the base name in the standard configuration path. If the
+file is found, the algorithm terminates.
+
+@item
+The algorithm terminates unsuccessfully.
+@end enumerate
+
+So, as you see, there are several ways to configure the PostScript
+drivers. Careful selection of techniques can make the configuration
+very flexible indeed.
+
+@node PS font options, PS line options, PS file options, PostScript driver class
+@subsection PostScript font options
+
+The list of available font options is short and sweet:
+
+@table @code
+@item prop-font=@var{font-name}
+
+Sets the default proportional font. The name should be that of a
+PostScript font. Default: @code{"Helvetica"}.
+
+@item fixed-font=@var{font-name}
+
+Sets the default fixed-pitch font. The name should be that of a
+PostScript font. Default: @code{"Courier"}.
+
+@item font-size=@var{font-size}
+
+Sets the size of the default fonts, in thousandths of a point. Default:
+@code{10000}.
+
+@end table
+
+@node PS line options, Prologue, PS font options, PostScript driver class
+@subsection PostScript line options
+
+Most tables contain lines, or rules, between cells. Some features of
+the way that lines are drawn in PostScript tables are user-definable:
+
+@table @code
+
+@item line-style=@var{style}
+
+Sets the style used for lines used to divide tables into sections.
+@var{style} must be either @code{thick}, in which case thick lines are
+used, or @var{double}, in which case double lines are used. Default:
+@code{thick}.
+
+@item line-gutter=@var{dimension}
+
+Sets the line gutter, which is the amount of whitespace on either side
+of lines that border text or graphics objects. @xref{Dimensions}.
+Default: @code{0.5pt}.
+
+@item line-spacing=@var{dimension}
+
+Sets the line spacing, which is the amount of whitespace that separates
+lines that are side by side, as in a double line. Default:
+@code{0.5pt}.
+
+@item line-width=@var{dimension}
+
+Sets the width of a typical line used in tables. Default: @code{0.5pt}.
+
+@item line-width-thick=@var{dimension}
+
+Sets the width of a thick line used in tables. Not used if
+@code{line-style} is set to @code{thick}. Default: @code{1.5pt}.
+
+@end table
+
+@node Prologue, Encodings, PS line options, PostScript driver class
+@subsection The PostScript prologue
+
+Most PostScript files that are generated mechanically by programs
+consist of two parts: a prologue and a body. The prologue is generally
+a collection of boilerplate. Only the body differs greatly between
+two outputs from the same program.
+
+This is also the strategy used in the PSPP PostScript driver. In
+general, the prologue supplied with PSPP will be more than sufficient.
+In this case, you will not need to read the rest of this section.
+However, hackers might want to know more. Read on, if you fall into
+this category.
+
+The prologue is dumped into the output stream essentially unmodified.
+However, two actions are performed on its lines. First, certain lines
+may be omitted as specified in the prologue file itself. Second,
+variables are substituted.
+
+The following lines are omitted:
+
+@enumerate
+@item
+All lines that contain three bangs in a row (@code{!!!}).
+
+@item
+Lines that contain @code{!eps}, if the PostScript driver is producing
+ordinary PostScript output. Otherwise an EPS file is being produced,
+and the line is included in the output, although everything following
+@code{!eps} is deleted.
+
+@item
+Lines that contain @code{!ps}, if the PostScript driver is producing EPS
+output. Otherwise, ordinary PostScript is being produced, and the line
+is included in the output, although everything following @code{!ps} is
+deleted.
+@end enumerate
+
+The following are the variables that are substituted. Only the
+variables listed are substituted; environment variables are not.
+@xref{Environment substitutions}.
+
+@table @code
+@item bounding-box
+
+The page bounding box, in points, as four space-separated numbers. For
+U.S. letter size paper, this is @samp{0 0 612 792}.
+
+@item creator
+
+PSPP version as a string: @samp{GNU PSPP 0.1b}, for example.
+
+@item date
+
+Date the file was created. Example: @samp{Tue May 21 13:46:22 1991}.
+
+@item data
+
+Value of the @code{data} PostScript driver option, as one of the strings
+@samp{Clean7Bit}, @samp{Clean8Bit}, or @samp{Binary}.
+
+@item orientation
+
+Page orientation, as one of the strings @code{Portrait} or
+@code{Landscape}.
+
+@item user
+
+Under multiuser OSes, the user's login name, taken either from the
+environment variable @code{LOGNAME} or, if that fails, the result of the
+C library function @code{getlogin()}. Defaults to @samp{nobody}.
+
+@item host
+
+System hostname as reported by @code{gethostname()}. Defaults to
+@samp{nowhere}.
+
+@item prop-font
+
+Name of the default proportional font, prefixed by the word
+@samp{font} and a space. Example: @samp{font Times-Roman}.
+
+@item fixed-font
+
+Name of the default fixed-pitch font, prefixed by the word @samp{font}
+and a space.
+
+@item scale-factor
+
+The page scaling factor as a floating-point number. Example:
+@code{1.0}. Note that this is also passed as an argument to the BP
+macro.
+
+@item paper-length
+@item paper-width
+
+The paper length and paper width, respectively, in thousandths of a
+point. Note that these are also passed as arguments to the BP macro.
+
+@item left-margin
+@item top-margin
+
+The left margin and top margin, respectively, in thousandths of a
+point. Note that these are also passed as arguments to the BP macro.
+
+@item title
+
+Document title as a string. This is not the title specified in the
+PSPP syntax file. A typical title is the word @samp{PSPP} followed
+by the syntax file name in parentheses. Example: @samp{PSPP
+(<stdin>)}.
+
+@item source-file
+
+PSPP syntax file name. Example: @samp{mary96/first.stat}.
+
+@end table
+
+Any other questions about the PostScript prologue can best be answered
+by examining the default prologue or the PSPP source.
+
+@node Encodings, , Prologue, PostScript driver class
+@subsection PostScript encodings
+
+PostScript fonts often contain many more than 256 characters, in order
+to accommodate foreign language characters and special symbols.
+PostScript uses @dfn{encodings} to map these onto single-byte symbol
+sets. Each font can have many different encodings applied to it.
+
+PSPP's PostScript driver needs to know which encoding to apply to each
+font. It can determine this from the information encapsulated in the
+Groff font description that it reads. However, there is an additional
+problem---for efficiency, the PostScript driver needs to have a complete
+list of all encodings that will be used in the entire session @emph{when
+it opens the output file}. For this reason, it can't use the
+information built into the fonts because it doesn't know which fonts
+will be used.
+
+As a stopgap solution, there are two mechanisms for specifying which
+encodings will be used. The first mechanism is automatic and it is the
+only one that most PSPP users will ever need. The second mechanism is
+manual, but it is more flexible. Either mechanism or both may be used
+at one time.
+
+The first mechanism is activated by the @samp{auto-encode} driver option
+(@pxref{PS file options}). When enabled, @samp{auto-encode} causes the
+PostScript driver to include the encodings used by the default
+proportional and fixed-pitch fonts (@pxref{PS font options}). Many
+PSPP output files will only need these encodings.
+
+The second mechanism is the file specified by the @samp{encoding-file}
+option (@pxref{PS file options}). If it exists, this file must consist
+of lines in PSPP configuration-file format (@pxref{Configuration
+files}). Each line that is not a comment should name a PostScript
+encoding to include in the output.
+
+It is not an error if an encoding is included more than once, by either
+mechanism. It will appear only once in the output. It is also not an
+error if an encoding is included in the output but never used. It
+@emph{is} an error if an encoding is used but not included by one of
+these mechanisms. In this case, the built-in PostScript encoding
+@samp{ISOLatin1Encoding} is substituted.
+
+@node ASCII driver class, HTML driver class, PostScript driver class, Configuration
+@section The ASCII driver class
+
+The ASCII driver class produces output that can be displayed on a
+terminal or output to printers. All of its options are highly
+configurable. The ASCII driver has class name @samp{ascii}.
+
+The ASCII driver is described in further detail below.
+
+@menu
+* ASCII output options:: Output file options.
+* ASCII page options:: Page size, margins, more.
+* ASCII font options:: Box character, bold & italics.
+@end menu
+
+@node ASCII output options, ASCII page options, ASCII driver class, ASCII driver class
+@subsection ASCII output options
+
+@table @code
+@item output-file=@var{filename}
+
+File to which output should be sent. This can be an ordinary filename
+(i.e., @code{"pspp.ps"}), a pipe filename (i.e., @code{"|lpr"}), or
+stdout (@code{"-"}). Default: @code{"pspp.list"}.
+
+@item char-set=@var{char-set-type}
+
+One of @samp{ascii} or @samp{latin1}. This has no effect on output at
+the present time. Default: @code{ascii}.
+
+@item form-feed-string=@var{form-feed-value}
+
+The string written to the output to cause a formfeed. See also
+@code{paginate}, described below, for a related setting. Default:
+@code{"\f"}.
+
+@item newline-string=@var{newline-value}
+
+The string written to the output to cause a newline (carriage return
+plus linefeed). The default, which can be specified explicitly with
+@code{newline-string=default}, is to use the system-dependent newline
+sequence by opening the output file in text mode. This is usually the
+right choice.
+
+However, @code{newline-string} can be set to any string. When this is
+done, the output file is opened in binary mode.
+
+@item paginate=@var{boolean}
+
+If set, a formfeed (as set in @code{form-feed-string}, described above)
+will be written to the device after every page. Default: @code{on}.
+
+@item tab-width=@var{tab-width-value}
+
+The distance between tab stops for this device. If set to 0, tabs will
+not be used in the output. Default: @code{8}.
+
+@item init=@var{initialization-string}.
+
+String written to the device before anything else, at the beginning of
+the output. Default: @code{""} (the empty string).
+
+@item done=@var{finalization-string}.
+
+String written to the device after everything else, at the end of the
+output. Default: @code{""} (the empty string).
+@end table
+
+@node ASCII page options, ASCII font options, ASCII output options, ASCII driver class
+@subsection ASCII page options
+
+These options affect page setup:
+
+@table @code
+@item headers=@var{boolean}
+
+If enabled, two lines of header information giving title and subtitle,
+page number, date and time, and PSPP version are printed at the top of
+every page. These two lines are in addition to any top margin
+requested. Default: @code{on}.
+
+@item length=@var{line-count}
+
+Physical length of a page, in lines. Headers and margins are subtracted
+from this value. Default: @code{66}.
+
+@item width=@var{character-count}
+
+Physical width of a page, in characters. Margins are subtracted from
+this value. Default: @code{130}.
+
+@item lpi=@var{lines-per-inch}
+
+Number of lines per vertical inch. Not currently used. Default: @code{6}.
+
+@item cpi=@var{characters-per-inch}
+
+Number of characters per horizontal inch. Not currently used. Default:
+@code{10}.
+
+@item left-margin=@var{left-margin-width}
+
+Width of the left margin, in characters. PSPP subtracts this value
+from the page width. Default: @code{0}.
+
+@item right-margin=@var{right-margin-width}
+
+Width of the right margin, in characters. PSPP subtracts this value
+from the page width. Default: @code{0}.
+
+@item top-margin=@var{top-margin-lines}
+
+Length of the top margin, in lines. PSPP subtracts this value from
+the page length. Default: @code{2}.
+
+@item bottom-margin=@var{bottom-margin-lines}
+
+Length of the bottom margin, in lines. PSPP subtracts this value from
+the page length. Default: @code{2}.
+
+@end table
+
+@node ASCII font options, , ASCII page options, ASCII driver class
+@subsection ASCII font options
+
+These are the ASCII font options:
+
+@table @code
+@item box[@var{line-type}]=@var{box-chars}
+
+The characters used for lines in tables produced by the ASCII driver can
+be changed using this option. @var{line-type} is used to indicate which
+type of line to change; @var{box-chars} is the character or string of
+characters to use for this type of line.
+
+@var{line-type} must be a 4-digit number in base 4. The digits are in
+the order `right', `bottom', `left', `top'. The four possibilities for
+each digit are:
+
+@table @asis
+@item 0
+No line.
+
+@item 1
+Single line.
+
+@item 2
+Double line.
+
+@item 3
+Special device-defined line, if one is available; otherwise, a double
+line.
+@end table
+
+Examples:
+
+@table @code
+@item box[0101]="|"
+
+Sets @samp{|} as the character to use for a single-width line with
+bottom and top components.
+
+@item box[2222]="#"
+
+Sets @samp{#} as the character to use for the intersection of four
+double-width lines, one each from the top, bottom, left and right.
+
+@item box[1100]="\xda"
+
+Sets @samp{"\xda"}, which under MS-DOG is a box character suitable for
+the top-left corner of a box, as the character for the intersection of
+two single-width lines, one each from the right and bottom.
+
+@end table
+
+Defaults:
+
+@itemize @bullet
+@item
+@code{box[0000]=" "}
+
+@item
+@code{box[1000]="-"}
+@*@code{box[0010]="-"}
+@*@code{box[1010]="-"}
+
+@item
+@code{box[0100]="|"}
+@*@code{box[0001]="|"}
+@*@code{box[0101]="|"}
+
+@item
+@code{box[2000]="="}
+@*@code{box[0020]="="}
+@*@code{box[2020]="="}
+
+@item
+@code{box[0200]="#"}
+@*@code{box[0002]="#"}
+@*@code{box[0202]="#"}
+
+@item
+@code{box[3000]="="}
+@*@code{box[0030]="="}
+@*@code{box[3030]="="}
+
+@item
+@code{box[0300]="#"}
+@*@code{box[0003]="#"}
+@*@code{box[0303]="#"}
+
+@item
+For all others, @samp{+} is used unless there are double lines or
+special lines, in which case @samp{#} is used.
+@end itemize
+
+@item italic-on=@var{italic-on-string}
+
+Character sequence written to turn on italics or underline printing. If
+this is set to @code{overstrike}, then the driver will simulate
+underlining by overstriking with underscore characters (@samp{_}) in the
+manner described by @code{overstrike-style} and
+@code{carriage-return-style}. Default: @code{overstrike}.
+
+@item italic-off=@var{italic-off-string}
+
+Character sequence to turn off italics or underline printing. Default:
+@code{""} (the empty string).
+
+@item bold-on=@var{bold-on-string}
+
+Character sequence written to turn on bold or emphasized printing. If
+set to @code{overstrike}, then the driver will simulated bold printing
+by overstriking characters in the manner described by
+@code{overstrike-style} and @code{carriage-return-style}. Default:
+@code{overstrike}.
+
+@item bold-off=@var{bold-off-string}
+
+Character sequence to turn off bold or emphasized printing. Default:
+@code{""} (the empty string).
+
+@item bold-italic-on=@var{bold-italic-on-string}
+
+Character sequence written to turn on bold-italic printing. If set to
+@code{overstrike}, then the driver will simulate bold-italics by
+overstriking twice, once with the character, a second time with an
+underscore (@samp{_}) character, in the manner described by
+@code{overstrike-style} and @code{carriage-return-style}. Default:
+@code{overstrike}.
+
+@item bold-italic-off=@var{bold-italic-off-string}
+
+Character sequence to turn off bold-italic printing. Default: @code{""}
+(the empty string).
+
+@item overstrike-style=@var{overstrike-option}
+
+Either @code{single} or @code{line}:
+
+@itemize @bullet
+@item
+If @code{single} is selected, then, to overstrike a line of text, the
+output driver will output a character, backspace, overstrike, output a
+character, backspace, overstrike, and so on along a line.
+
+@item
+If @code{line} is selected then the output driver will output an entire
+line, then backspace or emit a carriage return (as indicated by
+@code{carriage-return-style}), then overstrike the entire line at once.
+@end itemize
+
+@code{single} is recommended for use with ttys and programs that
+understand overstriking in text files, such as the pager @code{less}.
+@code{single} will also work with printer devices but results in rapid
+back-and-forth motions of the printhead that can cause the printer to
+physically overheat!
+
+@code{line} is recommended for use with printer devices. Most programs
+that understand overstriking in text files will not properly deal with
+@code{line} mode.
+
+Default: @code{single}.
+
+@item carriage-return-style=@var{carriage-return-type}
+
+Either @code{bs} or @code{cr}. This option applies only when one or
+more of the font commands is set to @code{overstrike} and, at the same
+time, @code{overstrike-style} is set to @code{line}.
+
+@itemize @bullet
+@item
+If @code{bs} is selected then the driver will return to the beginning of
+a line by emitting a sequence of backspace characters (ASCII 8).
+
+@item
+If @code{cr} is selected then the driver will return to the beginning of
+a line by emitting a single carriage-return character (ASCII 13).
+@end itemize
+
+Although @code{cr} is preferred as being more compact, @code{bs} is more
+general since some devices do not interpret carriage returns in the
+desired manner. Default: @code{bs}.
+@end table
+
+@node HTML driver class, Miscellaneous configuring, ASCII driver class, Configuration
+@section The HTML driver class
+
+The @code{html} driver class is used to produce output for viewing in
+tables-capable web browsers such as Emacs' w3-mode. Its configuration
+is very simple. Currently, the output has a very plain format. In the
+future, further work may be done on improving the output appearance.
+
+There are few options for use with the @code{html} driver class:
+
+@table @code
+@item output-file=@var{filename}
+
+File to which output should be sent. This can be an ordinary filename
+(i.e., @code{"pspp.ps"}), a pipe filename (i.e., @code{"|lpr"}), or
+stdout (@code{"-"}). Default: @code{"pspp.html"}.
+
+@item prologue-file=@var{prologue-file-name}
+
+Sets the name of the PostScript prologue file. You can write your own
+prologue if you want to customize colors or other settings: see
+@ref{HTML Prologue}. Default: @code{html-prologue}.
+@end table
+
+@menu
+* HTML Prologue:: Format of the HTML prologue file.
+@end menu
+
+@node HTML Prologue, , HTML driver class, HTML driver class
+@subsection The HTML prologue
+
+HTML files that are generated by PSPP consist of two parts: a prologue
+and a body. The prologue is a collection of boilerplate. Only the body
+differs greatly between two outputs. You can tune the colors and other
+attributes of the output by editing the prologue.
+
+The prologue is dumped into the output stream essentially unmodified.
+However, two actions are performed on its lines. First, certain lines
+may be omitted as specified in the prologue file itself. Second,
+variables are substituted.
+
+The following lines are omitted:
+
+@enumerate
+@item
+All lines that contain three bangs in a row (@code{!!!}).
+
+@item
+Lines that contain @code{!title}, if no title is set for the output. If
+a title is set, then the characters @code{!title} are removed before the
+line is output.
+
+@item
+Lines that contain @code{!subtitle}, if no subtitle is set for the
+output. If a subtitle is set, then the characters @code{!subtitle} are
+removed before the line is output.
+@end enumerate
+
+The following are the variables that are substituted. Only the
+variables listed are substituted; environment variables are not.
+@xref{Environment substitutions}.
+
+@table @code
+@item generator
+
+PSPP version as a string: @samp{GNU PSPP 0.1b}, for example.
+
+@item date
+
+Date the file was created. Example: @samp{Tue May 21 13:46:22 1991}.
+
+@item user
+
+Under multiuser OSes, the user's login name, taken either from the
+environment variable @code{LOGNAME} or, if that fails, the result of the
+C library function @code{getlogin()}. Defaults to @samp{nobody}.
+
+@item host
+
+System hostname as reported by @code{gethostname()}. Defaults to
+@samp{nowhere}.
+
+@item title
+
+Document title as a string. This is the title specified in the PSPP
+syntax file.
+
+@item subtitle
+
+Document subtitle as a string.
+
+@item source-file
+
+PSPP syntax file name. Example: @samp{mary96/first.stat}.
+@end table
+
+@node Miscellaneous configuring, Improving output quality, HTML driver class, Configuration
+@section Miscellaneous configuration
+
+The following environment variables can be used to further configure
+PSPP:
+
+@table @code
+@item HOME
+
+Used to determine the user's home directory. No default value.
+
+@item STAT_INCLUDE_PATH
+
+Path used to find include files in PSPP syntax files. Defaults vary
+across operating systems:
+
+@table @asis
+@item UNIX
+
+@itemize @bullet
+@item
+@file{.}
+
+@item
+@file{~/.pspp/include}
+
+@item
+@file{/usr/local/lib/pspp/include}
+
+@item
+@file{/usr/lib/pspp/include}
+
+@item
+@file{/usr/local/share/pspp/include}
+
+@item
+@file{/usr/share/pspp/include}
+@end itemize
+
+@item MS-DOS
+
+@itemize @bullet
+@item
+@file{.}
+
+@item
+@file{C:\PSPP\INCLUDE}
+
+@item
+@file{$PATH}
+@end itemize
+
+@item Other OSes
+No default path.
+@end table
+
+@item STAT_PAGER
+@itemx PAGER
+
+When PSPP invokes an external pager, it uses the first of these that
+is defined. There is a default pager only if the person who compiled
+PSPP defined one.
+
+@item TERM
+
+The terminal type @code{termcap} or @code{ncurses} will use, if such
+support was compiled into PSPP.
+
+@item STAT_OUTPUT_INIT_FILE
+
+The basename used to search for the driver definition file.
+@xref{Output devices}. @xref{File locations}. Default: @code{devices}.
+
+@item STAT_OUTPUT_PAPERSIZE_FILE
+
+The basename used to search for the papersize file. @xref{papersize}.
+@xref{File locations}. Default: @code{papersize}.
+
+@item STAT_OUTPUT_INIT_PATH
+
+The path used to search for the driver definition file and the papersize
+file. @xref{File locations}. Default: the standard configuration path.
+
+@item TMPDIR
+
+The @code{sort} procedure stores its temporary files in this directory.
+Default: (UNIX) @file{/tmp}, (MS-DOS) @file{\}, (other OSes) empty string.
+
+@item TEMP
+@item TMP
+
+Under MS-DOS only, these variables are consulted after TMPDIR, in this
+order.
+@end table
+
+@node Improving output quality, , Miscellaneous configuring, Configuration
+@section Improving output quality
+
+When its drivers are set up properly, PSPP can produce output that
+looks very good indeed. The PostScript driver, suitably configured, can
+produce presentation-quality output. Here are a few guidelines for
+producing better-looking output, regardless of output driver. Your
+mileage may vary, of course, and everyone has different esthetic
+preferences.
+
+@itemize @bullet
+@item
+Width is important in PSPP output. Greater output width leads to more
+readable output, to a point. Try the following to increase the output
+width:
+
+@itemize @minus
+@item
+If you're using the ASCII driver with a dot-matrix printer, figure out
+what you need to do to put the printer into compressed mode. Put that
+string into the @code{init-string} setting. Try to get 132 columns; 160
+might be better, but you might find that print that tiny is difficult to
+read.
+
+@item
+With the PostScript driver, try these ideas:
+
+@itemize +
+@item
+Landscape mode.
+
+@item
+Legal-size (8.5" x 14") paper in landscape mode.
+
+@item
+Reducing font sizes. If you're using 12-point fonts, try 10 point; if
+you're using 10-point fonts, try 8 point. Some fonts are more readable
+than others at small sizes.
+@end itemize
+@end itemize
+
+Try to strike a balance between character size and page width.
+
+@item
+Use high-quality fonts. Many public domain fonts are poor in quality.
+Recently, URW made some high-quality fonts available under the GPL.
+These are probably suitable.
+
+@item
+Be sure you're using the proper font metrics. The font metrics provided
+with PSPP may not correspond to the fonts actually being printed.
+This can cause bizarre-looking output.
+
+@item
+Make sure that you're using good ink/ribbon/toner. Darker print is
+easier to read.
+
+@item
+Use plain fonts with serifs, such as Times-Roman or Palatino. Avoid
+choosing italic or bold fonts as document base fonts.
+@end itemize
+
+@node Invocation, Language, Configuration, Top
+@chapter Invoking PSPP
+@cindex invocation
+@cindex PSPP, invoking
+
+@cindex command line, options
+@cindex options, command-line
+@example
+pspp [ -B @var{dir} | --config-dir=@var{dir} ] [ -o @var{device} | --device=@var{device} ]
+ [ -d @var{var}[=@var{value}] | --define=@var{var}[=@var{value}] ] [-u @var{var} | --undef=@var{var} ]
+ [ -f @var{file} | --out-file=@var{file} ] [ -p | --pipe ] [ -I- | --no-include ]
+ [ -I @var{dir} | --include=@var{dir} ] [ -i | --interactive ]
+ [ -n | --edit | --dry-run | --just-print | --recon ]
+ [ -r | --no-statrc ] [ -h | --help ] [ -l | --list ]
+ [ -c @var{command} | --command @var{command} ] [ -s | --safer ]
+ [ --testing-mode ] [ -V | --version ] [ -v | --verbose ]
+ [ @var{key}=@var{value} ] @var{file}@enddots{}
+@end example
+
+@menu
+* Non-option Arguments:: Specifying syntax files and output devices.
+* Configuration Options:: Change the configuration for the current run.
+* Input and output options:: Controlling input and output files.
+* Language control options:: Language variants.
+* Informational options:: Helpful information about PSPP.
+@end menu
+
+@node Non-option Arguments, Configuration Options, Invocation, Invocation
+@section Non-option Arguments
+
+Syntax files and output device substitutions can be specified on
+PSPP's command line:
+
+@table @code
+@item @var{file}
+
+A file by itself on the command line will be executed as a syntax file.
+PSPP terminates after the syntax file runs, unless the @code{-i} or
+@code{--interactive} option is given (@pxref{Language control options}).
+
+@item @var{file1} @var{file2}
+
+When two or more filenames are given on the command line, the first
+syntax file is executed, then PSPP's dictionary is cleared, then the second
+syntax file is executed.
+
+@item @var{file1} + @var{file2}
+
+If syntax files' names are delimited by a plus sign (@samp{+}), then the
+dictionary is not cleared between their executions, as if they were
+concatenated together into a single file.
+
+@item @var{key}=@var{value}
+
+Defines an output device macro @var{key} to expand to @var{value},
+overriding any macro having the same @var{key} defined in the device
+configuration file. @xref{Macro definitions}.
+
+@end table
+
+There is one other way to specify a syntax file, if your operating
+system supports it. If you have a syntax file @file{foobar.stat}, put
+the notation
+
+@example
+#! /usr/local/bin/pspp
+@end example
+
+at the top, and mark the file as executable with @code{chmod +x
+foobar.stat}. (If PSPP is not installed in @file{/usr/local/bin},
+then insert its actual installation directory into the syntax file
+instead.) Now you should be able to invoke the syntax file just by
+typing its name. You can include any options on the command line as
+usual. PSPP entirely ignores any lines beginning with @samp{#!}.
+
+@node Configuration Options, Input and output options, Non-option Arguments, Invocation
+@section Configuration Options
+
+Configuration options are used to change PSPP's configuration for the
+current run. The configuration options are:
+
+@table @code
+@item -B @var{dir}
+@itemx --config-dir=@var{dir}
+
+Sets the configuration directory to @var{dir}. @xref{File locations}.
+
+@item -o @var{device}
+@itemx --device=@var{device}
+
+Selects the output device with name @var{device}. If this option is
+given more than once, then all devices mentioned are selected. This
+option disables all devices besides those mentioned on the command line.
+
+@item -d @var{var}[=@var{value}]
+@itemx --define=@var{var}[=@var{value}]
+
+Defines an `environment variable' named @var{var} having the optional
+value @var{value} specified. @xref{Variable values}.
+
+@item -u @var{var}
+@itemx --undef=@var{var}
+
+Undefines the `environment variable' named @var{var}. @xref{Variable
+values}.
+@end table
+
+@node Input and output options, Language control options, Configuration Options, Invocation
+@section Input and output options
+
+Input and output options affect how PSPP reads input and writes
+output. These are the input and output options:
+
+@table @code
+@item -f @var{file}
+@itemx --out-file=@var{file}
+
+This overrides the output file name for devices designated as listing
+devices. If a file named @var{file} already exists, it is overwritten.
+
+@item -p
+@itemx --pipe
+
+Allows PSPP to be used as a filter by causing the syntax file to be
+read from stdin and output to be written to stdout. Conflicts with the
+@code{-f @var{file}} and @code{--file=@var{file}} options.
+
+@item -I-
+@itemx --no-include
+
+Clears all directories from the include path. This includes all
+directories put in the include path by default. @xref{Miscellaneous
+configuring}.
+
+@item -I @var{dir}
+@itemx --include=@var{dir}
+
+Appends directory @var{dir} to the path that is searched for include
+files in PSPP syntax files.
+
+@item -c @var{command}
+@itemx --command=@var{command}
+
+Execute literal command @var{command}. The command is executed before
+startup syntax files, if any.
+
+@item --testing-mode
+
+Invoke heuristics to assist with testing PSPP. For use by @code{make
+check} and similar scripts.
+@end table
+
+@node Language control options, Informational options, Input and output options, Invocation
+@section Language control options
+
+Language control options control how PSPP syntax files are parsed and
+interpreted. The available language control options are:
+
+@table @code
+@item -i
+@itemx --interactive
+
+When a syntax file is specified on the command line, PSPP normally
+terminates after processing it. Giving this option will cause PSPP to
+bring up a command prompt after processing the syntax file.
+
+In addition, this forces syntax files to be interpreted in interactive
+mode, rather than the default batch mode. @xref{Tokenizing lines}, for
+information on the differences between batch mode and interactive mode
+command interpretation.
+
+@item -n
+@itemx --edit
+@itemx --dry-run
+@itemx --just-print
+@itemx --recon
+
+Only the syntax of any syntax file specified or of commands entered at
+the command line is checked. Transformations are not performed and
+procedures are not executed. Not yet implemented.
+
+@item -r
+@itemx --no-statrc
+
+Prevents the execution of the PSPP startup syntax file. Not yet
+implemented, as startup syntax files aren't, either.
+
+@item -s
+@itemx --safer
+
+Disables certain unsafe operations. This includes the @code{ERASE} and
+@code{HOST} commands, as well as use of pipes as input and output files.
+@end table
+
+@node Informational options, , Language control options, Invocation
+@section Informational options
+
+Informational options cause information about PSPP to be written to
+the terminal. Here are the available options:
+
+@table @code
+@item -h
+@item --help
+
+Prints a message describing PSPP command-line syntax and the available
+device driver classes, then terminates.
+
+@item -l
+@item --list
+
+Lists the available device driver classes, then terminates.
+
+@item -V
+@item --version
+
+Prints a brief message listing PSPP's version, warranties you don't
+have, copying conditions and copyright, and e-mail address for bug
+reports, then terminates.
+
+@item -v
+@item --verbose
+
+Increments PSPP's verbosity level. Higher verbosity levels cause
+PSPP to display greater amounts of information about what it is
+doing. Often useful for debugging PSPP's configuration.
+
+This option can be given multiple times to set the verbosity level to
+that value. The default verbosity level is 0, in which no informational
+messages will be displayed.
+
+Higher verbosity levels cause messages to be displayed when the
+corresponding events take place.
+
+@table @asis
+@item 1
+
+Driver and subsystem initializations.
+
+@item 2
+
+Completion of driver initializations. Beginning of driver closings.
+
+@item 3
+
+Completion of driver closings.
+
+@item 4
+
+Files searched for; success of searches.
+
+@item 5
+
+Individual directories included in file searches.
+@end table
+
+Each verbosity level also includes messages from lower verbosity levels.
+
+@end table
+
+@node Language, Expressions, Invocation, Top
+@chapter The PSPP language
+@cindex language, PSPP
+@cindex PSPP, language
+
+@quotation
+@strong{Please note:} PSPP is not even close to completion.
+Only a few actual statistical procedures are implemented. PSPP
+is a work in progress.
+@end quotation
+
+This chapter discusses elements common to many PSPP commands.
+Later chapters will describe individual commands in detail.
+
+@menu
+* Tokens:: Characters combine to form tokens.
+* Commands:: Tokens combine to form commands.
+* Types of Commands:: Commands come in several flavors.
+* Order of Commands:: Commands combine to form syntax files.
+* Missing Observations:: Handling missing observations.
+* Variables:: The unit of data storage.
+* Files:: Files used by PSPP.
+* BNF:: How command syntax is described.
+@end menu
+
+@node Tokens, Commands, Language, Language
+@section Tokens
+@cindex language, lexical analysis
+@cindex language, tokens
+@cindex tokens
+@cindex lexical analysis
+@cindex lexemes
+
+PSPP divides most syntax file lines into series of short chunks
+called @dfn{tokens}, @dfn{lexical elements}, or @dfn{lexemes}. These
+tokens are then grouped to form commands, each of which tells
+PSPP to take some action---read in data, write out data, perform
+a statistical procedure, etc. The process of dividing input into tokens
+is @dfn{tokenization}, or @dfn{lexical analysis}. Each type of token is
+described below.
+
+@cindex delimiters
+@cindex whitespace
+Tokens must be separated from each other by @dfn{delimiters}.
+Delimiters include whitespace (spaces, tabs, carriage returns, line
+feeds, vertical tabs), punctuation (commas, forward slashes, etc.), and
+operators (plus, minus, times, divide, etc.) Note that while whitespace
+only separates tokens, other delimiters are tokens in themselves.
+
+@table @strong
+@cindex identifiers
+@item Identifiers
+Identifiers are names that specify variable names, commands, or command
+details.
+
+@itemize @bullet
+@item
+The first character in an identifier must be a letter, @samp{#}, or
+@samp{@@}. Some system identifiers begin with @samp{$}, but
+user-defined variables' names may not begin with @samp{$}.
+
+@item
+The remaining characters in the identifier must be letters, digits, or
+one of the following special characters:
+
+@example
+. _ $ # @@
+@end example
+
+@item
+@cindex variable names
+@cindex names, variable
+Variable names may be any length, but only the first 8 characters are
+significant.
+
+@item
+@cindex case-sensitivity
+Identifiers are not case-sensitive: @code{foobar}, @code{Foobar},
+@code{FooBar}, @code{FOOBAR}, and @code{FoObaR} are different
+representations of the same identifier.
+
+@item
+@cindex keywords
+Identifiers other than variable names may be abbreviated to their first
+3 characters if this abbreviation is unambiguous. These identifiers are
+often called @dfn{keywords}. (Unique abbreviations of more than 3
+characters are also accepted: @samp{FRE}, @samp{FREQ}, and
+@samp{FREQUENCIES} are equivalent when the last is a keyword.)
+
+@item
+Whether an identifier is a keyword depends on the context.
+
+@item
+@cindex keywords, reserved
+@cindex reserved keywords
+Some keywords are reserved. These keywords may not be used in any
+context besides those explicitly described in this manual. The reserved
+keywords are:
+
+@example
+ALL AND BY EQ GE GT LE LT NE NOT OR TO WITH
+@end example
+
+@item
+Since keywords are identifiers, all the rules for identifiers apply.
+Specifically, they must be delimited as are other identifiers:
+@code{WITH} is a reserved keyword, but @code{WITHOUT} is a valid
+variable name.
+@end itemize
+
+@cindex @samp{.}
+@cindex period
+@cindex variable names, ending with period
+@strong{Caution:} It is legal to end a variable name with a period, but
+@emph{don't do it!} The variable name will be misinterpreted when it is
+the final token on a line: @code{FOO.} will be divided into two separate
+tokens, @samp{FOO} and @samp{.}, the @dfn{terminal dot}.
+@xref{Commands, , Forming commands of tokens}.
+
+@item Numbers
+@cindex numbers
+@cindex integers
+@cindex reals
+Numbers may be specified as integers or reals. Integers are internally
+converted into reals. Scientific notation is not supported. Here are
+some examples of valid numbers:
+
+@example
+1234 3.14159265359 .707106781185 8945.
+@end example
+
+@strong{Caution:} The last example will be interpreted as two tokens,
+@samp{8945} and @samp{.}, if it is the last token on a line.
+
+@item Strings
+@cindex strings
+@cindex @samp{'}
+@cindex @samp{"}
+@cindex case-sensitivity
+Strings are literal sequences of characters enclosed in pairs of single
+quotes (@samp{'}) or double quotes (@samp{"}).
+
+@itemize @bullet
+@item
+Whitespace and case of letters @emph{are} significant inside strings.
+@item
+Whitespace characters inside a string are not delimiters.
+@item
+To include single-quote characters in a string, enclose the string in
+double quotes.
+@item
+To include double-quote characters in a string, enclose the string in
+single quotes.
+@item
+It is not possible to put both single- and double-quote characters
+inside one string.
+@end itemize
+
+@item Hexstrings
+@cindex hexstrings
+Hexstrings are string variants that use hex digits to specify
+characters.
+
+@itemize @bullet
+@item
+A hexstring may be used anywhere that an ordinary string is allowed.
+
+@item
+@cindex @samp{X'}
+@cindex @samp{'}
+A hexstring begins with @samp{X'} or @samp{x'}, and ends with @samp{'}.
+
+@cindex whitespace
+@item
+No whitespace is allowed between the initial @samp{X} and @samp{'}.
+
+@item
+Double quotes @samp{"} may be used in place of single quotes @samp{'} if
+done in both places.
+
+@item
+Each pair of hex digits is internally changed into a single character
+with the given value.
+
+@item
+If there is an odd number of hex digits, the missing last digit is
+assumed to be @samp{0}.
+
+@item
+@cindex portability
+@strong{Please note:} Use of hexstrings is nonportable because the same
+numeric values are associated with different glyphs by different
+operating systems. Therefore, their use should be confined to syntax
+files that will not be widely distributed.
+
+@item
+@cindex characters, reserved
+@cindex 0
+@cindex whitespace
+@strong{Please note also:} The character with value 00 is reserved for
+internal use by PSPP. Its use in strings causes an error and
+replacement with a blank space (in ASCII, hex 20, decimal 32).
+@end itemize
+
+@item Punctuation
+@cindex punctuation
+Punctuation separates tokens; punctuators are delimiters. These are the
+punctuation characters:
+
+@example
+, / = ( )
+@end example
+
+@item Operators
+@cindex operators
+Operators describe mathematical operations. Some operators are delimiters:
+
+@example
+( ) + - * / **
+@end example
+
+Many of the above operators are also punctuators. Punctuators are
+distinguished from operators by context.
+
+The other operators are all reserved keywords. None of these are
+delimiters:
+
+@example
+AND EQ GE GT LE LT NE OR
+@end example
+
+@item Terminal Dot
+@cindex terminal dot
+@cindex dot, terminal
+@cindex period
+@cindex @samp{.}
+A period (@samp{.}) at the end of a line (except for whitespace) is one
+type of a @dfn{terminal dot}, although not every terminal dot is a
+period at the end of a line. @xref{Commands, , Forming commands of
+tokens}. A period is a terminal dot @emph{only}
+when it is at the end of a line; otherwise it is part of a
+floating-point number. (A period outside a number in the middle of a
+line is an error.)
+
+@quotation
+@cindex terminal dot, changing
+@cindex dot, terminal, changing
+@strong{Please note:} The character used for the @dfn{terminal dot} can
+be changed with the SET command. This is strongly discouraged, and
+throughout all the remainder of this manual it will be assumed that the
+default setting is in effect.
+@end quotation
+
+@end table
+
+@node Commands, Types of Commands, Tokens, Language
+@section Forming commands of tokens
+
+@cindex PSPP, command structure
+@cindex language, command structure
+@cindex commands, structure
+
+Most PSPP commands share a common structure, diagrammed below:
+
+@example
+@var{cmd}@dots{} [@var{sbc}[=][@var{spec} [[,]@var{spec}]@dots{}]] [[/[=][@var{spec} [[,]@var{spec}]@dots{}]]@dots{}].
+@end example
+
+@cindex @samp{[ ]}
+In the above, rather daunting, expression, pairs of square brackets
+(@samp{[ ]}) indicate optional elements, and names such as @var{cmd}
+indicate parts of the syntax that vary from command to command.
+Ellipses (@samp{...}) indicate that the preceding part may be repeated
+an arbitrary number of times. Let's pick apart what it says above:
+
+@itemize @bullet
+@cindex commands, names
+@item
+A command begins with a command name of one or more keywords, such as
+@code{FREQUENCIES}, @code{DATA LIST}, or @code{N OF CASES}. @var{cmd}
+may be abbreviated to its first word if that is unambiguous; each word
+in @var{cmd} may be abbreviated to a unique prefix of three or more
+characters as described above.
+
+@cindex subcommands
+@item
+The command name may be followed by one or more @dfn{subcommands}:
+
+@itemize @minus
+@item
+Each subcommand begins with a unique keyword, indicated by @var{sbc}
+above. This is analogous to the command name.
+
+@item
+The subcommand name is optionally followed by an equals sign (@samp{=}).
+
+@item
+Some subcommands accept a series of one or more specifications
+(@var{spec}), optionally separated by commas.
+
+@item
+Each subcommand must be separated from the next (if any) by a forward
+slash (@samp{/}).
+@end itemize
+
+@cindex dot, terminal
+@cindex terminal dot
+@item
+Each command must be terminated with a @dfn{terminal dot}.
+The terminal dot may be given one of three ways:
+
+@itemize @minus
+@item
+(most commonly) A period character at the very end of a line, as
+described above.
+
+@item
+(only if NULLINE is on: @xref{SET, , Setting user preferences}, for more
+details.) A completely blank line.
+
+@item
+(in batch mode only) Any line that is not indented from the left side of
+the page causes a terminal dot to be inserted before that line.
+Therefore, each command begins with a line that is flush left, followed
+by zero or more lines that are indented one or more characters from the
+left margin.
+
+In batch mode, PSPP will ignore a plus sign, minus sign, or period
+(@samp{+}, @samp{@minus{}}, or @samp{.}) as the first character in a
+line. Any of these characters as the first character on a line will
+begin a new command. This allows for visual indentation of a command
+without that command being considered part of the previous command.
+
+PSPP is in batch mode when it is reading input from a file, rather
+than from an interactive user. Note that the other forms of the
+terminal dot may also be used in batch mode.
+
+Sometimes, one encounters syntax files that are intended to be
+interpreted in interactive mode rather than batch mode (for instance,
+this can happen if a session log file is used directly as a syntax
+file). When this occurs, use the @samp{-i} command line option to force
+interpretation in interactive mode (@pxref{Language control options}).
+@end itemize
+@end itemize
+
+PSPP ignores empty commands when they are generated by the above
+rules. Note that, as a consequence of these rules, each command must
+begin on a new line.
+
+@node Types of Commands, Order of Commands, Commands, Language
+@section Types of Commands
+
+Commands in PSPP are divided roughly into six categories:
+
+@table @strong
+@item Utility commands
+Set or display various global options that affect PSPP operations.
+May appear anywhere in a syntax file. @xref{Utilities, , Utility
+commands}.
+
+@item File definition commands
+Give instructions for reading data from text files or from special
+binary ``system files''. Most of these commands discard any previous
+data or variables in order to replace it with the new data and
+variables. At least one must appear before the first command in any of
+the categories below. @xref{Data Input and Output}.
+
+@item Input program commands
+Though rarely used, these provide powerful tools for reading data files
+in arbitrary textual or binary formats. @xref{INPUT PROGRAM}.
+
+@item Transformations
+Perform operations on data and write data to output files. Transformations
+are not carried out until a procedure is executed.
+
+@item Restricted transformations
+Same as transformations for most purposes. @xref{Order of Commands}, for a
+detailed description of the differences.
+
+@item Procedures
+Analyze data, writing results of analyses to the listing file. Cause
+transformations specified earlier in the file to be performed. In a
+more general sense, a @dfn{procedure} is any command that causes the
+active file (the data) to be read.
+@end table
+
+@node Order of Commands, Missing Observations, Types of Commands, Language
+@section Order of Commands
+@cindex commands, ordering
+@cindex order of commands
+
+PSPP does not place many restrictions on ordering of commands.
+The main restriction is that variables must be defined with one of the
+file-definition commands before they are otherwise referred to.
+
+Of course, there are specific rules, for those who are interested.
+PSPP possesses five internal states, called initial, INPUT
+PROGRAM, FILE TYPE, transformation, and procedure states. (Please note
+the distinction between the INPUT PROGRAM and FILE TYPE @emph{commands}
+and the INPUT PROGRAM and FILE TYPE @emph{states}.)
+
+PSPP starts up in the initial state. Each successful completion
+of a command may cause a state transition. Each type of command has its
+own rules for state transitions:
+
+@table @strong
+@item Utility commands
+@itemize @bullet
+@item
+Legal in all states, except Pennsylvania.
+@item
+Do not cause state transitions. Exception: when the N OF CASES command
+is executed in the procedure state, it causes a transition to the
+transformation state.
+@end itemize
+
+@item DATA LIST
+@itemize @bullet
+@item
+Legal in all states.
+@item
+When executed in the initial or procedure state, causes a transition to
+the transformation state.
+@item
+Clears the active file if executed in the procedure or transformation
+state.
+@end itemize
+
+@item INPUT PROGRAM
+@itemize @bullet
+@item
+Invalid in INPUT PROGRAM and FILE TYPE states.
+@item
+Causes a transition to the INPUT PROGRAM state.
+@item
+Clears the active file.
+@end itemize
+
+@item FILE TYPE
+@itemize @bullet
+@item
+Invalid in INPUT PROGRAM and FILE TYPE states.
+@item
+Causes a transition to the FILE TYPE state.
+@item
+Clears the active file.
+@end itemize
+
+@item Other file definition commands
+@itemize @bullet
+@item
+Invalid in INPUT PROGRAM and FILE TYPE states.
+@item
+Cause a transition to the transformation state.
+@item
+Clear the active file, except for ADD FILES, MATCH FILES, and UPDATE.
+@end itemize
+
+@item Transformations
+@itemize @bullet
+@item
+Invalid in initial and FILE TYPE states.
+@item
+Cause a transition to the transformation state.
+@end itemize
+
+@item Restricted transformations
+@itemize @bullet
+@item
+Invalid in initial, INPUT PROGRAM, and FILE TYPE states.
+@item
+Cause a transition to the transformation state.
+@end itemize
+
+@item Procedures
+@itemize @bullet
+@item
+Invalid in initial, INPUT PROGRAM, and FILE TYPE states.
+@item
+Cause a transition to the procedure state.
+@end itemize
+@end table
+
+@node Missing Observations, Variables, Order of Commands, Language
+@section Handling missing observations
+@cindex missing values
+@cindex values, missing
+
+PSPP includes special support for unknown numeric data values.
+Missing observations are assigned a special value, called the
+@dfn{system-missing value}. This ``value'' actually indicates the
+absence of value; it means that the actual value is unknown. Procedures
+automatically exclude from analyses those observations or cases that
+have missing values. Whether single observations or entire cases are
+excluded depends on the procedure.
+
+The system-missing value exists only for numeric variables. String
+variables always have a defined value, even if it is only a string of
+spaces.
+
+Variables, whether numeric or string, can have designated
+@dfn{user-missing values}. Every user-missing value is an actual value
+for that variable. However, most of the time user-missing values are
+treated in the same way as the system-missing value. String variables
+that are wider than a certain width, usually 8 characters (depending on
+computer architecture), cannot have user-missing values.
+
+For more information on missing values, see the following sections:
+@ref{Variables}, @ref{MISSING VALUES}, @ref{Expressions}. See also the
+documentation on individual procedures for information on how they
+handle missing values.
+
+@node Variables, Files, Missing Observations, Language
+@section Variables
+@cindex variables
+
+Variables are the basic unit of data storage in PSPP. All the
+variables in a file taken together, apart from any associated data, are
+said to form a @dfn{dictionary}. Each case contain a value for each
+variable. Some details of variables are described in the sections
+below.
+
+@menu
+* Attributes:: Attributes of variables.
+* System Variables:: Variables automatically defined by PSPP.
+* Sets of Variables:: Lists of variable names.
+* Input/Output Formats:: Input and output formats.
+* Scratch Variables:: Variables deleted by procedures.
+@end menu
+
+@node Attributes, System Variables, Variables, Variables
+@subsection Attributes of Variables
+@cindex variables, attributes of
+@cindex attributes of variables
+Each variable has a number of attributes, including:
+
+@table @strong
+@item Name
+This is an identifier. Each variable must have a different name.
+@xref{Tokens}.
+
+@cindex variables, type
+@cindex type of variables
+@item Type
+Numeric or string.
+
+@cindex variables, width
+@cindex width of variables
+@item Width
+(string variables only) String variables with a width of 8 characters or
+fewer are called @dfn{short string variables}. Short string variables
+can be used in many procedures where @dfn{long string variables} (those
+with widths greater than 8) are not allowed.
+
+@quotation
+@strong{Please note:} Certain systems may consider strings longer than 8
+characters to be short strings. Eight characters represents a minimum
+figure for the maximum length of a short string.
+@end quotation
+
+@item Position
+Variables in the dictionary are arranged in a specific order. The
+DISPLAY command can be used to show this order: see @ref{DISPLAY}.
+
+@item Orientation
+Dexter or sinister. @xref{LEAVE}.
+
+@cindex missing values
+@cindex values, missing
+@item Missing values
+Optionally, up to three values, or a range of values, or a specific
+value plus a range, can be specified as @dfn{user-missing values}.
+There is also a @dfn{system-missing value} that is assigned to an
+observation when there is no other obvious value for that observation.
+Observations with missing values are automatically excluded from
+analyses. User-missing values are actual data values, while the
+system-missing value is not a value at all. @xref{Missing Observations}.
+
+@cindex variable labels
+@cindex labels, variable
+@item Variable label
+A string that describes the variable. @xref{VARIABLE LABELS}.
+
+@cindex value labels
+@cindex labels, value
+@item Value label
+Optionally, these associate each possible value of the variable with a
+string. @xref{VALUE LABELS}.
+
+@cindex print format
+@item Print format
+Display width, format, and (for numeric variables) number of decimal
+places. This attribute does not affect how data are stored, just how
+they are displayed. Example: a width of 8, with 2 decimal places.
+@xref{PRINT FORMATS}.
+
+@cindex write format
+@item Write format
+Similar to print format, but used by certain commands that are
+designed to write to binary files. @xref{WRITE FORMATS}.
+@end table
+
+@node System Variables, Sets of Variables, Attributes, Variables
+@subsection Variables Automatically Defined by PSPP
+@cindex system variables
+@cindex variables, system
+
+There are seven system variables. These are not like ordinary
+variables, as they are not stored in each case. They can only be used
+in expressions. These system variables, whose values and output formats
+cannot be modified, are described below.
+
+@table @code
+@cindex @code{$CASENUM}
+@item $CASENUM
+Case number of the case at the moment. This changes as cases are
+shuffled around.
+
+@cindex @code{$DATE}
+@item $DATE
+Date the PSPP process was started, in format A9, following the
+pattern @code{DD MMM YY}.
+
+@cindex @code{$JDATE}
+@item $JDATE
+Number of days between 15 Oct 1582 and the time the PSPP process
+was started.
+
+@cindex @code{$LENGTH}
+@item $LENGTH
+Page length, in lines, in format F11.
+
+@cindex @code{$SYSMIS}
+@item $SYSMIS
+System missing value, in format F1.
+
+@cindex @code{$TIME}
+@item $TIME
+Number of seconds between midnight 14 Oct 1582 and the time the active file
+was read, in format F20.
+
+@cindex @code{$WIDTH}
+@item $WIDTH
+Page width, in characters, in format F3.
+@end table
+
+@node Sets of Variables, Input/Output Formats, System Variables, Variables
+@subsection Lists of variable names
+@cindex TO convention
+@cindex convention, TO
+
+There are several ways to specify a set of variables:
+
+@enumerate
+@item
+(Most commonly.) List the variable names one after another, optionally
+separating them by commas.
+
+@cindex @code{TO}
+@item
+(This method cannot be used on commands that define the dictionary, such
+as @code{DATA LIST}.) The syntax is the names of two existed variables,
+separated by the reserved keyword @code{TO}. The meaning is to include
+every variable in the dictionary between and including the variables
+specified. For instance, if the dictionary contains six variables with
+the names @code{ID}, @code{X1}, @code{X2}, @code{GOAL}, @code{MET}, and
+@code{NEXTGOAL}, in that order, then @code{X2 TO MET} would include
+variables @code{X2}, @code{GOAL}, and @code{MET}.
+
+@item
+(This method can be used only on commands that define the dictionary,
+such as @code{DATA LIST}.) It is used to define sequences of variables
+that end in consecutive integers. The syntax is two identifiers that
+end in numbers. This method is best illustrated with examples:
+
+@itemize @bullet
+@item
+The syntax @code{X1 TO X5} defines 5 variables:
+
+@itemize @minus
+@item
+X1
+@item
+X2
+@item
+X3
+@item
+X4
+@item
+X5
+@end itemize
+
+@item
+The syntax @code{ITEM0008 TO ITEM0013} defines 6 variables:
+
+@itemize @minus
+@item
+ITEM0008
+@item
+ITEM0009
+@item
+ITEM0010
+@item
+ITEM0011
+@item
+ITEM0012
+@item
+ITEM0013
+@end itemize
+
+@item
+Each of the syntaxes @code{QUES001 TO QUES9} and @code{QUES6 TO QUES3}
+are invalid, although for different reasons, which should be evident.
+@end itemize
+
+Note that after a set of variables has been defined on @code{DATA LIST}
+or another command with this method, the same set can be referenced on
+later commands using the same syntax.
+
+@item
+The above methods can be combined, either one after another or delimited
+by commas. For instance, the combined syntax @code{A Q5 TO Q8 X TO Z}
+is legal as long as each part @code{A}, @code{Q5 TO Q8}, @code{X TO Z}
+is individually legal.
+@end enumerate
+
+@node Input/Output Formats, Scratch Variables, Sets of Variables, Variables
+@subsection Input and Output Formats
+
+Data that PSPP inputs and outputs must have one of a number of formats.
+These formats are described, in general, by a format specification of
+the form @code{NAMEw.d}, where @var{name} is the
+format name and @var{w} is a field width. @var{d} is the optional
+desired number of decimal places, if appropriate. If @var{d} is not
+included then it is assumed to be 0. Some formats do not allow @var{d}
+to be specified.
+
+When an input format is specified on DATA LIST or another command, then
+it is converted to an output format for the purposes of PRINT and other
+data output commands. For most purposes, input and output formats are
+the same; the salient differences are described below.
+
+Below are listed the input and output formats supported by PSPP. If an
+input format is mapped to a different output format by default, then
+that mapping is indicated with @result{}. Each format has the listed
+bounds on input width (iw) and output width (ow).
+
+The standard numeric input and output formats are given in the following
+table:
+
+@table @asis
+@item Fw.d: 1 <= iw,ow <= 40
+Standard decimal format with @var{d} decimal places. If the number is
+too large to fit within the field width, it is expressed in scientific
+notation (@code{1.2+34}) if w >= 6, with always at least two digits in
+the exponent. When used as an input format, scientific notation is
+allowed but an E or an F must be used to introduce the exponent.
+
+The default output format is the same as the input format, except if
+@var{d} > 1. In that case the output @var{w} is always made to be at
+least 2 + @var{d}.
+
+@item Ew.d: 1 <= iw <= 40; 6 <= ow <= 40
+For input this is equivalent to F format except that no E or F is
+require to introduce the exponent. For output, produces scientific
+notation in the form @code{1.2+34}. There are always at least two
+digits given in the exponent.
+
+The default output @var{w} is the largest of the input @var{w}, the
+input @var{d} + 7, and 10. The default output @var{d} is the input
+@var{d}, but at least 3.
+
+@item COMMAw.d: 1 <= iw,ow <= 40
+Equivalent to F format, except that groups of three digits are
+comma-separated on output. If the number is too large to express in the
+field width, then first commas are eliminated, then if there is still
+not enough space the number is expressed in scientific notation given
+that w >= 6. Commas are allowed and ignored when this is used as an
+input format.
+
+@item DOTw.d: 1 <= iw,ow <= 40
+Equivalent to COMMA format except that the roles of comma and decimal
+point are interchanged. However: If SET /DECIMAL=DOT is in effect, then
+COMMA uses @samp{,} for a decimal point and DOT uses @samp{.} for a
+decimal point.
+
+@item DOLLARw.d: 1 <= iw <= 40; 2 <= ow <= 40
+Equivalent to COMMA format, except that the number is prefixed by a
+dollar sign (@samp{$}) if there is room. On input the value is allowed
+to be prefixed by a dollar sign, which is ignored.
+
+The default output @var{w} is the input @var{w}, but at least 2.
+
+@item PCTw.d: 2 <= iw,ow <= 40
+Equivalent to F format, except that the number is suffixed by a percent
+sign (@samp{%}) if there is room. On input the value is allowed to be
+suffixed by a percent sign, which is ignored.
+
+The default output @var{w} is the input @var{w}, but at least 2.
+
+@item Nw.d: 1 <= iw,ow <= 40
+Only digits are allowed within the field width. The decimal point is
+assumed to be @var{d} digits from the right margin.
+
+The default output format is F with the same @var{w} and @var{d}, except
+if @var{d} > 1. In that case the output @var{w} is always made to be at
+least 2 + @var{d}.
+
+@item Zw.d @result{} F: 1 <= iw,ow <= 40
+Zoned decimal input. If you need to use this then you know how.
+
+@item IBw.d @result{} F: 1 <= iw,ow <= 8
+Integer binary format. The field is interpreted as a fixed-point
+positive or negative binary number in two's-complement notation. The
+location of the decimal point is implied. Endianness is the same as the
+host machine.
+
+The default output format is F8.2 if @var{d} is 0. Otherwise it is F,
+with output @var{w} as 9 + input @var{d} and output @var{d} as input
+@var{d}.
+
+@item PIB @result{} F: 1 <= iw,ow <= 8
+Positive integer binary format. The field is interpreted as a
+fixed-point positive binary number. The location of the decimal point
+is implied. Endianness is teh same as the host machine.
+
+The default output format follows the rules for IB format.
+
+@item Pw.d @result{} F: 1 <= iw,ow <= 16
+Binary coded decimal format. Each byte from left to right, except the
+rightmost, represents two digits. The upper nibble of each byte is more
+significant. The upper nibble of the final byte is the least
+significant digit. The lower nibble of the final byte is the sign; a
+value of D represents a negative sign and all other values are
+considered positive. The decimal point is implied.
+
+The default output format follows the rules for IB format.
+
+@item PKw.d @result{} F: 1 <= iw,ow <= 16
+Positive binary code decimal format. Same as P but the last byte is the
+same as the others.
+
+The default output format follows the rules for IB format.
+
+@item RBw @result{} F: 2 <= iw,ow <= 8
+
+Binary C architecture-dependent ``double'' format. For a standard
+IEEE754 implementation @var{w} should be 8.
+
+The default output format follows the rules for IB format.
+
+@item PIBHEXw.d @result{} F: 2 <= iw,ow <= 16
+PIB format encoded as textual hex digit pairs. @var{w} must be even.
+
+The input width is mapped to a default output width as follows:
+2@result{}4, 4@result{}6, 6@result{}9, 8@result{}11, 10@result{}14,
+12@result{}16, 14@result{}18, 16@result{}21. No allowances are made for
+decimal places.
+
+@item RBHEXw @result{} F: 4 <= iw,ow <= 16
+
+RB format encoded as textual hex digits pairs. @var{w} must be even.
+
+The default output format is F8.2.
+
+@item CCAw.d: 1 <= ow <= 40
+@itemx CCBw.d: 1 <= ow <= 40
+@itemx CCCw.d: 1 <= ow <= 40
+@itemx CCDw.d: 1 <= ow <= 40
+@itemx CCEw.d: 1 <= ow <= 40
+
+User-defined custom currency formats. May not be used as an input
+format. @xref{SET}, for more details.
+@end table
+
+The date and time numeric input and output formats accept a number of
+possible formats. Before describing the formats themselves, some
+definitions of the elements that make up their formats will be helpful:
+
+@table @dfn
+@item leader
+All formats accept an optional whitespace leader.
+
+@item day
+An integer between 1 and 31 representing the day of month.
+
+@item day-count
+An integer representing a number of days.
+
+@item date-delimiter
+One or more characters of whitespace or the following characters:
+@code{- / . ,}
+
+@item month
+A month name in one of the following forms:
+@itemize @bullet
+@item
+An integer between 1 and 12.
+@item
+Roman numerals representing an integer between 1 and 12.
+@item
+At least the first three characters of an English month name (January,
+February, @dots{}).
+@end itemize
+
+@item year
+An integer year number between 1582 and 19999, or between 1 and 199.
+Years between 1 and 199 will have 1900 added.
+
+@item julian
+A single number with a year number in the first 2, 3, or 4 digits (as
+above) and the day number within the year in the last 3 digits.
+
+@item quarter
+An integer between 1 and 4 representing a quarter.
+
+@item q-delimiter
+The letter @samp{Q} or @samp{q}.
+
+@item week
+An integer between 1 and 53 representing a week within a year.
+
+@item wk-delimiter
+The letters @samp{wk} in any case.
+
+@item time-delimiter
+At least one characters of whitespace or @samp{:} or @samp{.}.
+
+@item hour
+An integer greater than 0 representing an hour.
+
+@item minute
+An integer between 0 and 59 representing a minute within an hour.
+
+@item opt-second
+Optionally, a time-delimiter followed by a real number representing a
+number of seconds.
+
+@item hour24
+An integer between 0 and 23 representing an hour within a day.
+
+@item weekday
+At least the first two characters of an English day word.
+
+@item spaces
+Any amount or no amount of whitespace.
+
+@item sign
+An optional positive or negative sign.
+
+@item trailer
+All formats accept an optional whitespace trailer.
+@end table
+
+The date input formats are strung together from the above pieces. On
+output, the date formats are always printed in a single canonical
+manner, based on field width. The date input and output formats are
+described below:
+
+@table @asis
+@item DATEw: 9 <= iw,ow <= 40
+Date format. Input format: leader + day + date-delimiter +
+month + date-delimiter + year + trailer. Output format: DD-MMM-YY for
+@var{w} < 11, DD-MMM-YYYY otherwise.
+
+@item EDATEw: 8 <= iw,ow <= 40
+European date format. Input format same as DATE. Output format:
+DD.MM.YY for @var{w} < 10, DD.MM.YYYY otherwise.
+
+@item SDATEw: 8 <= iw,ow <= 40
+Standard date format. Input format: leader + year + date-delimiter +
+month + date-delimiter + day + trailer. Output format: YY/MM/DD for
+@var{w} < 10, YYYY/MM/DD otherwise.
+
+@item ADATEw: 8 <= iw,ow <= 40
+American date format. Input format: leader + month + date-delimiter +
+day + date-delimiter + year + trailer. Output format: MM/DD/YY for
+@var{w} < 10, MM/DD/YYYY otherwise.
+
+@item JDATEw: 5 <= iw,ow <= 40
+Julian date format. Input format: leader + julian + trailer. Output
+format: YYDDD for @var{w} < 7, YYYYDDD otherwise.
+
+@item QYRw: 4 <= iw <= 40, 6 <= ow <= 40
+Quarter/year format. Input format: leader + quarter + q-delimiter +
+year + trailer. Output format: @samp{Q Q YY}, where the first
+@samp{Q} is one of the digits 1, 2, 3, 4, if @var{w} < 8, @code{Q Q
+YYYY} otherwise.
+
+@item MOYRw: 6 <= iw,ow <= 40
+Month/year format. Input format: leader + month + date-delimiter + year
++ trailer. Output format: @samp{MMM YY} for @var{w} < 8, @samp{MMM
+YYYY} otherwise.
+
+@item WKYRw: 6 <= iw <= 40, 8 <= ow <= 40
+Week/year format. Input format: leader + week + wk-delimiter + year +
+trailer. Output format: @samp{WW WK YY} for @var{w} < 10, @samp{WW WK
+YYYY} otherwise.
+
+@item DATETIMEw.d: 17 <= iw,ow <= 40
+Date and time format. Input format: leader + day + date-delimiter +
+month + date-delimiter + yaer + time-delimiter + hour24 + time-delimiter
++ minute + opt-second. Output format: @samp{DD-MMM-YYYY HH:MM}. If
+@var{w} > 19 then seconds @samp{:SS} is added. If @var{w} > 22 and
+@var{d} > 0 then fractional seconds @samp{.SS} are added.
+
+@item TIMEw.d: 5 <= iw,ow <= 40
+Time format. Input format: leader + sign + spaces + hour +
+time-delimiter + minute + opt-second. Output format: @samp{HH:MM}.
+Seconds and fractional seconds are available with @var{w} of at least 8
+and 10, respectively.
+
+@item DTIMEw.d: 1 <= iw <= 40, 8 <= ow <= 40
+Time format with day count. Input format: leader + sign + spaces +
+day-count + time-delimiter + hour + time-delimiter + minute +
+opt-second. Output format: @samp{DD HH:MM}. Seconds and fractional
+seconds are available with @var{w} of at least 8 and 10, respectively.
+
+@item WKDAYw: 2 <= iw,ow <= 40
+A weekday as a number between 1 and 7, where 1 is Sunday. Input format:
+leader + weekday + trailer. Output format: as many characters, in all
+capital letters, of the English name of the weekday as will fit in the
+field width.
+
+@item MONTHw: 3 <= iw,ow <= 40
+A month as a number between 1 and 12, where 1 is January. Input format:
+leader + month + trailer. Output format: as many character, in all
+capital letters, of the English name of the month as will fit in the
+field width.
+@end table
+
+There are only two formats that may be used with string variables:
+
+@table @asis
+@item Aw: 1 <= iw <= 255, 1 <= ow <= 254
+The entire field is treated as a string value.
+
+@item AHEXw @result{} A: 2 <= iw <= 254; 2 <= ow <= 510
+The field is composed of characters in a string encoded as textual hex
+digit pairs.
+
+The default output @var{w} is half the input @var{w}.
+@end table
+
+@node Scratch Variables, , Input/Output Formats, Variables
+@subsection Scratch Variables
+
+Most of the time, variables don't retain their values between cases.
+Instead, either they're being read from a data file or the active file,
+in which case they assume the value read, or, if created with COMPUTE or
+another transformation, they're initialized to the system-missing value
+or to blanks, depending on type.
+
+However, sometimes it's useful to have a variable that keeps its value
+between cases. You can do this with LEAVE (@pxref{LEAVE}), or you can
+use a @dfn{scratch variable}. Scratch variables are variables whose
+names begin with an octothorpe (@samp{#}).
+
+Scratch variables have the same properties as variables left with LEAVE:
+they retain their values between cases, and for the first case they are
+initialized to 0 or blanks. They have the additional property that they
+are deleted before the execution of any procedure. For this reason,
+scratch variables can't be used for analysis. To obtain the same
+effect, use COMPUTE (@pxref{COMPUTE}) to copy the scratch variable's
+value into an ordinary variable, then analysis that variable.
+
+@node Files, BNF, Variables, Language
+@section Files Used by PSPP
+
+PSPP makes use of many files each time it runs. Some of these it
+reads, some it writes, some it creates. Here is a table listing the
+most important of these files:
+
+@table @strong
+@cindex file, command
+@cindex file, syntax file
+@cindex command file
+@cindex syntax file
+@item command file
+@itemx syntax file
+These names (synonyms) refer to the file that contains instructions to
+PSPP that tell it what to do. The syntax file's name is specified on
+the PSPP command line. Syntax files can also be pulled in with the
+@code{INCLUDE} command.
+
+@cindex file, data
+@cindex data file
+@item data file
+Data files contain raw data in ASCII format suitable for being read in
+by the @code{DATA LIST} command. Data can be embedded in the syntax
+file with @code{BEGIN DATA} and @code{END DATA} commands: this makes the
+syntax file a data file too.
+
+@cindex file, output
+@cindex output file
+@item listing file
+One or more output files are created by PSPP each time it is
+run. The output files receive the tables and charts produced by
+statistical procedures. The output files may be in any number of formats,
+depending on how PSPP is configured.
+
+@cindex active file
+@cindex file, active
+@item active file
+The active file is the ``file'' on which all PSPP procedures
+are performed. The active file contains variable definitions and
+cases. The active file is not necessarily a disk file: it is stored
+in memory if there is room.
+@end table
+
+@node BNF, , Files, Language
+@section Backus-Naur Form
+@cindex BNF
+@cindex Backus-Naur Form
+@cindex command syntax, description of
+@cindex description of command syntax
+
+The syntax of some parts of the PSPP language is presented in this
+manual using the formalism known as @dfn{Backus-Naur Form}, or BNF. The
+following table describes BNF:
+
+@itemize @bullet
+@cindex keywords
+@cindex terminals
+@item
+Words in all-uppercase are PSPP keyword tokens. In BNF, these are
+often called @dfn{terminals}. There are some special terminals, which
+are actually written in lowercase for clarity:
+
+@table @asis
+@cindex @code{number}
+@item @code{number}
+A real number.
+
+@cindex @code{integer}
+@item @code{integer}
+An integer number.
+
+@cindex @code{string}
+@item @code{string}
+A string.
+
+@cindex @code{var-name}
+@item @code{var-name}
+A single variable name.
+
+@cindex operators
+@cindex punctuators
+@item @code{=}, @code{/}, @code{+}, @code{-}, etc.
+Operators and punctuators.
+
+@cindex @code{.}
+@cindex terminal dot
+@cindex dot, terminal
+@item @code{.}
+The terminal dot. This is not necessarily an actual dot in the syntax
+file: @xref{Commands}, for more details.
+@end table
+
+@item
+@cindex productions
+@cindex nonterminals
+Other words in all lowercase refer to BNF definitions, called
+@dfn{productions}. These productions are also known as
+@dfn{nonterminals}. Some nonterminals are very common, so they are
+defined here in English for clarity:
+
+@table @code
+@cindex @code{var-list}
+@item var-list
+A list of one or more variable names or the keyword @code{ALL}.
+
+@cindex @code{expression}
+@item expression
+An expression. @xref{Expressions}, for details.
+@end table
+
+@item
+@cindex @code{::=}
+@cindex ``is defined as''
+@cindex productions
+@samp{::=} means ``is defined as''. The left side of @samp{::=} gives
+the name of the nonterminal being defined. The right side of @samp{::=}
+gives the definition of that nonterminal. If the right side is empty,
+then one possible expansion of that nonterminal is nothing. A BNF
+definition is called a @dfn{production}.
+
+@item
+@cindex terminals and nonterminals, differences
+So, the key difference between a terminal and a nonterminal is that a
+terminal cannot be broken into smaller parts---in fact, every terminal
+is a single token (@pxref{Tokens}). On the other hand, nonterminals are
+composed of a (possibly empty) sequence of terminals and nonterminals.
+Thus, terminals indicate the deepest level of syntax description. (In
+parsing theory, terminals are the leaves of the parse tree; nonterminals
+form the branches.)
+
+@item
+@cindex start symbol
+@cindex symbol, start
+The first nonterminal defined in a set of productions is called the
+@dfn{start symbol}. The start symbol defines the entire syntax for
+that command.
+@end itemize
+
+@node Expressions, Data Input and Output, Language, Top
+@chapter Mathematical Expressions
+@cindex expressions, mathematical
+@cindex mathematical expressions
+
+Some PSPP commands use expressions, which share a common syntax
+among all PSPP commands. Expressions are made up of
+@dfn{operands}, which can be numbers, strings, or variable names,
+separated by @dfn{operators}. There are five types of operators:
+grouping, arithmetic, logical, relational, and functions.
+
+Every operator takes one or more @dfn{arguments} as input and produces
+or @dfn{returns} exactly one result as output. Both strings and numeric
+values can be used as arguments and are produced as results, but each
+operator accepts only specific combinations of numeric and string values
+as arguments. With few exceptions, operator arguments may be
+full-fledged expressions in themselves.
+
+@menu
+* Booleans:: Boolean values.
+* Missing Values in Expressions:: Using missing values in expressions.
+* Grouping Operators:: ( )
+* Arithmetic Operators:: + - * / **
+* Logical Operators:: AND NOT OR
+* Relational Operators:: EQ GE GT LE LT NE
+* Functions:: More-sophisticated operators.
+* Order of Operations:: Operator precedence.
+@end menu
+
+@node Booleans, Missing Values in Expressions, Expressions, Expressions
+@section Boolean values
+@cindex Boolean
+@cindex values, Boolean
+
+There is a third type for arguments and results, the @dfn{Boolean} type,
+which is used to represent true/false conditions. Booleans have only
+three possible values: 0 (false), 1 (true), and system-missing.
+System-missing is neither true or false.
+
+@itemize @bullet
+@item
+A numeric expression that has value 0, 1, or system-missing may be used
+in place of a Boolean. Thus, the expression @code{0 AND 1} is valid
+(although it is always true).
+
+@item
+A numeric expression with any other value will cause an error if it is
+used as a Boolean. So, @code{2 OR 3} is invalid.
+
+@item
+A Boolean expression may not be used in place of a numeric expression.
+Thus, @code{(1>2) + (3<4)} is invalid.
+
+@item
+Strings and Booleans are not compatible, and neither may be used in
+place of the other.
+@end itemize
+
+@node Missing Values in Expressions, Grouping Operators, Booleans, Expressions
+@section Missing Values in Expressions
+
+String missing values are not treated specially in expressions. Most
+numeric operators return system-missing when given system-missing
+arguments. Exceptions are listed under particular operator
+descriptions.
+
+User-missing values for numeric variables are always transformed into
+the system-missing value, except inside the arguments to the
+@code{VALUE}, @code{SYSMIS}, and @code{MISSING} functions.
+
+The missing-value functions can be used to precisely control how missing
+values are treated in expressions. @xref{Missing Value Functions}, for
+more details.
+
+@node Grouping Operators, Arithmetic Operators, Missing Values in Expressions, Expressions
+@section Grouping Operators
+@cindex parentheses
+@cindex @samp{( )}
+@cindex grouping operators
+@cindex operators, grouping
+
+Parentheses (@samp{()}) are the grouping operators. Surround an
+expression with parentheses to force early evaluation.
+
+Parentheses also surround the arguments to functions, but in that
+situation they act as punctuators, not as operators.
+
+@node Arithmetic Operators, Logical Operators, Grouping Operators, Expressions
+@section Arithmetic Operators
+@cindex operators, arithmetic
+@cindex arithmetic operators
+
+The arithmetic operators take numeric arguments and produce numeric
+results.
+
+@table @code
+@cindex @samp{+}
+@cindex addition
+@item @var{a} + @var{b}
+Adds @var{a} and @var{b}, returning the sum.
+
+@cindex @samp{-}
+@cindex subtraction
+@item @var{a} - @var{b}
+Subtracts @var{b} from @var{a}, returning the difference.
+
+@cindex @samp{*}
+@cindex multiplication
+@item @var{a} * @var{b}
+Multiplies @var{a} and @var{b}, returning the product.
+
+@cindex @samp{/}
+@cindex division
+@item @var{a} / @var{b}
+Divides @var{a} by @var{b}, returning the quotient. If @var{b} is
+zero, the result is system-missing.
+
+@cindex @samp{**}
+@cindex exponentiation
+@item @var{a} ** @var{b}
+Returns the result of raising @var{a} to the power @var{b}. If
+@var{a} is negative and @var{b} is not an integer, the result is
+system-missing. The result of @code{0**0} is system-missing as well.
+
+@cindex @samp{-}
+@cindex negation
+@item - @var{a}
+Reverses the sign of @var{a}.
+@end table
+
+@node Logical Operators, Relational Operators, Arithmetic Operators, Expressions
+@section Logical Operators
+@cindex logical operators
+@cindex operators, logical
+
+@cindex true
+@cindex false
+@cindex Boolean
+@cindex values, system-missing
+@cindex system-missing
+The logical operators take logical arguments and produce logical
+results, meaning ``true or false''. PSPP logical operators are
+not true Boolean operators because they may also result in a
+system-missing value.
+
+@table @code
+@cindex @code{AND}
+@cindex @samp{&}
+@cindex intersection, logical
+@cindex logical intersection
+@item @var{a} AND @var{b}
+@itemx @var{a} & @var{b}
+True if both @var{a} and @var{b} are true. However, if one argument is
+false and the other is missing, the result is false, not missing. If
+both arguments are missing, the result is missing.
+
+@cindex @code{OR}
+@cindex @samp{|}
+@cindex union, logical
+@cindex logical union
+@item @var{a} OR @var{b}
+@itemx @var{a} | @var{b}
+True if at least one of @var{a} and @var{b} is true. If one argument is
+true and the other is missing, the result is true, not missing. If both
+arguments are missing, the result is missing.
+
+@cindex @code{NOT}
+@cindex @samp{~}
+@cindex inversion, logical
+@cindex logical inversion
+@item NOT @var{a}
+@itemx ~ @var{a}
+True if @var{a} is false.
+@end table
+
+@node Relational Operators, Functions, Logical Operators, Expressions
+@section Relational Operators
+
+The relational operators take numeric or string arguments and produce Boolean
+results.
+
+Note that, with numeric arguments, PSPP does not make exact
+relational tests. Instead, two numbers are considered to be equal even
+if they differ by a small amount. This amount, @dfn{epsilon}, is
+dependent on the PSPP configuration and determined at compile
+time. (The default value is 0.000000001, or
+@ifinfo
+@code{10**(-9)}.)
+@end ifinfo
+@tex
+$10 ^ -9$.)
+@end tex
+Use of epsilon allows for round-off errors. Use of epsilon is also
+idiotic, but the author is not a numeric analyst.
+
+Strings cannot be compared to numbers. When strings of different
+lengths are compared, the shorter string is right-padded with spaces
+to match the length of the longer string.
+
+The results of string comparisons, other than tests for equality or
+inequality, are dependent on the character set in use. String
+comparisons are case-sensitive.
+
+@table @code
+@cindex equality, testing
+@cindex testing for equality
+@cindex @code{EQ}
+@cindex @samp{=}
+@item @var{a} EQ @var{b}
+@itemx @var{a} = @var{b}
+True if @var{a} is equal to @var{b}.
+
+@cindex less than or equal to
+@cindex @code{LE}
+@cindex @code{<=}
+@item @var{a} LE @var{b}
+@itemx @var{a} <= @var{b}
+True if @var{a} is less than or equal to @var{b}.
+
+@cindex less than
+@cindex @code{LT}
+@cindex @code{<}
+@item @var{a} LT @var{b}
+@itemx @var{a} < @var{b}
+True if @var{a} is less than @var{b}.
+
+@cindex greater than or equal to
+@cindex @code{GE}
+@cindex @code{>=}
+@item @var{a} GE @var{b}
+@itemx @var{a} >= @var{b}
+True if @var{a} is greater than or equal to @var{b}.
+
+@cindex greater than
+@cindex @code{GT}
+@cindex @samp{>}
+@item @var{a} GT @var{b}
+@itemx @var{a} > @var{b}
+True if @var{a} is greater than @var{b}.
+
+@cindex inequality, testing
+@cindex testing for inequality
+@cindex @code{NE}
+@cindex @code{~=}
+@cindex @code{<>}
+@item @var{a} NE @var{b}
+@itemx @var{a} ~= @var{b}
+@itemx @var{a} <> @var{b}
+True is @var{a} is not equal to @var{b}.
+@end table
+
+@node Functions, Order of Operations, Relational Operators, Expressions
+@section Functions
+@cindex functions
+
+@cindex mathematics
+@cindex operators
+@cindex parentheses
+@cindex @code{(}
+@cindex @code{)}
+@cindex names, of functions
+PSPP functions provide mathematical abilities above and beyond
+those possible using simple operators. Functions have a common
+syntax: each is composed of a function name followed by a left
+parenthesis, one or more arguments, and a right parenthesis. Function
+names are @strong{not} reserved; their names are specially treated
+only when followed by a left parenthesis: @code{EXP(10)} refers to the
+constant value @code{e} raised to the 10th power, but @code{EXP} by
+itself refers to the value of variable EXP.
+
+The sections below describe each function in detail.
+
+@menu
+* Advanced Mathematics:: EXP LG10 LN SQRT
+* Miscellaneous Mathematics:: ABS MOD MOD10 RND TRUNC
+* Trigonometry:: ACOS ARCOS ARSIN ARTAN ASIN ATAN COS SIN TAN
+* Missing Value Functions:: MISSING NMISS NVALID SYSMIS VALUE
+* Pseudo-Random Numbers:: NORMAL UNIFORM
+* Set Membership:: ANY RANGE
+* Statistical Functions:: CFVAR MAX MEAN MIN SD SUM VARIANCE
+* String Functions:: CONCAT INDEX LENGTH LOWER LPAD LTRIM NUMBER
+ RINDEX RPAD RTRIM STRING SUBSTR UPCASE
+* Time & Date:: CTIME.xxx DATE.xxx TIME.xxx XDATE.xxx
+* Miscellaneous Functions:: LAG YRMODA
+* Functions Not Implemented:: CDF.xxx CDFNORM IDF.xxx NCDF.xxx PROBIT RV.xxx
+@end menu
+
+@node Advanced Mathematics, Miscellaneous Mathematics, Functions, Functions
+@subsection Advanced Mathematical Functions
+@cindex mathematics, advanced
+
+Advanced mathematical functions take numeric arguments and produce
+numeric results.
+
+@deftypefn {Function} {} EXP (@var{exponent})
+Returns @i{e} (approximately 2.71828) raised to power @var{exponent}.
+@end deftypefn
+
+@cindex logarithms
+@deftypefn {Function} {} LG10 (@var{number})
+Takes the base-10 logarithm of @var{number}. If @var{number} is
+not positive, the result is system-missing.
+@end deftypefn
+
+@deftypefn {Function} {} LN (@var{number})
+Takes the base-@samp{e} logarithm of @var{number}. If @var{number} is
+not positive, the result is system-missing.
+@end deftypefn
+
+@cindex square roots
+@deftypefn {Function} {} SQRT (@var{number})
+Takes the square root of @var{number}. If @var{number} is negative,
+the result is system-missing.
+@end deftypefn
+
+@node Miscellaneous Mathematics, Trigonometry, Advanced Mathematics, Functions
+@subsection Miscellaneous Mathematical Functions
+@cindex mathematics, miscellaneous
+
+Miscellaneous mathematical functions take numeric arguments and produce
+numeric results.
+
+@cindex absolute value
+@deftypefn {Function} {} ABS (@var{number})
+Results in the absolute value of @var{number}.
+@end deftypefn
+
+@cindex modulus
+@deftypefn {Function} {} MOD (@var{numerator}, @var{denominator})
+Returns the remainder (modulus) of @var{numerator} divided by
+@var{denominator}. If @var{denominator} is 0, the result is
+system-missing. However, if @var{numerator} is 0 and
+@var{denominator} is system-missing, the result is 0.
+@end deftypefn
+
+@cindex modulus, by 10
+@deftypefn {Function} {} MOD10 (@var{number})
+Returns the remainder when @var{number} is divided by 10. If
+@var{number} is negative, MOD10(@var{number}) is negative or zero.
+@end deftypefn
+
+@cindex rounding
+@deftypefn {Function} {} RND (@var{number})
+Takes the absolute value of @var{number} and rounds it to an integer.
+Then, if @var{number} was negative originally, negates the result.
+@end deftypefn
+
+@cindex truncation
+@deftypefn {Function} {} TRUNC (@var{number})
+Discards the fractional part of @var{number}; that is, rounds
+@var{number} towards zero.
+@end deftypefn
+
+@node Trigonometry, Missing Value Functions, Miscellaneous Mathematics, Functions
+@subsection Trigonometric Functions
+@cindex trigonometry
+
+Trigonometric functions take numeric arguments and produce numeric
+results.
+
+@cindex arccosine
+@cindex inverse cosine
+@deftypefn {Function} {} ACOS (@var{number})
+@deftypefnx {Function} {} ARCOS (@var{number})
+Takes the arccosine, in radians, of @var{number}. Results in
+system-missing if @var{number} is not between -1 and 1. Portability:
+none.
+@end deftypefn
+
+@cindex arcsine
+@cindex inverse sine
+@deftypefn {Function} {} ARSIN (@var{number})
+Takes the arcsine, in radians, of @var{number}. Results in
+system-missing if @var{number} is not between -1 and 1 inclusive.
+@end deftypefn
+
+@cindex arctangent
+@cindex inverse tangent
+@deftypefn {Function} {} ARTAN (@var{number})
+Takes the arctangent, in radians, of @var{number}.
+@end deftypefn
+
+@cindex arcsine
+@cindex inverse sine
+@deftypefn {Function} {} ASIN (@var{number})
+Takes the arcsine, in radians, of @var{number}. Results in
+system-missing if @var{number} is not between -1 and 1 inclusive.
+Portability: none.
+@end deftypefn
+
+@cindex arctangent
+@cindex inverse tangent
+@deftypefn {Function} {} ATAN (@var{number})
+Takes the arctangent, in radians, of @var{number}.
+@end deftypefn
+
+@quotation
+@strong{Please note:} Use of the AR* group of inverse trigonometric
+functions is recommended over the A* group because they are more
+portable.
+@end quotation
+
+@cindex cosine
+@deftypefn {Function} {} COS (@var{radians})
+Takes the cosine of @var{radians}.
+@end deftypefn
+
+@cindex sine
+@deftypefn {Function} {} SIN (@var{angle})
+Takes the sine of @var{radians}.
+@end deftypefn
+
+@cindex tangent
+@deftypefn {Function} {} TAN (@var{angle})
+Takes the tangent of @var{radians}. Results in system-missing at values
+of @var{angle} that are too close to odd multiples of pi/2.
+Portability: none.
+@end deftypefn
+
+@node Missing Value Functions, Pseudo-Random Numbers, Trigonometry, Functions
+@subsection Missing-Value Functions
+@cindex missing values
+@cindex values, missing
+@cindex functions, missing-value
+
+Missing-value functions take various types as arguments, returning
+various types of results.
+
+@deftypefn {Function} {} MISSING (@var{variable or expression})
+@var{num} may be a single variable name or an expression. If it is a
+variable name, results in 1 if the variable has a user-missing or
+system-missing value for the current case, 0 otherwise. If it is an
+expression, results in 1 if the expression has the system-missing value,
+0 otherwise.
+
+@quotation
+@strong{Please note:} If the argument is a string expression other than
+a variable name, MISSING is guaranteed to return 0, because strings do
+not have a system-missing value. Also, when using a numeric expression
+argument, remember that user-missing values are converted to the
+system-missing value in most contexts. Thus, the expressions
+@code{MISSING(VAR1 @var{op} VAR2)} and @code{MISSING(VAR1) OR
+MISSING(VAR2)} are often equivalent, depending on the specific operator
+@var{op} used.
+@end quotation
+@end deftypefn
+
+@deftypefn {Function} {} NMISS (@var{expr} [, @var{expr}]@dots{})
+Each argument must be a numeric expression. Returns the number of
+user- or system-missing values in the list. As a special extension,
+the syntax @code{@var{var1} TO @var{var2}} may be used to refer to a
+range of variables; see @ref{Sets of Variables}, for more details.
+@end deftypefn
+
+@deftypefn {Function} {} NVALID (@var{expr} [, @var{expr}]@dots{})
+Each argument must be a numeric expression. Returns the number of
+values in the list that are not user- or system-missing. As a special extension,
+the syntax @code{@var{var1} TO @var{var2}} may be used to refer to a
+range of variables; see @ref{Sets of Variables}, for more details.
+@end deftypefn
+
+@deftypefn {Function} {} SYSMIS (@var{variable or expression})
+When given the name of a numeric variable, returns 1 if the value of
+that variable is system-missing. Otherwise, if the value is not
+missing or if it is user-missing, returns 0. If given the name of a
+string variable, always returns 1. If given an expression other than
+a single variable name, results in 1 if the value is system- or
+user-missing, 0 otherwise.
+@end deftypefn
+
+@deftypefn {Function} {} VALUE (@var{variable})
+Prevents the user-missing values of @var{variable} from being
+transformed into system-missing values: If @var{variable} is not
+system- or user-missing, results in the value of @var{variable}. If
+@var{variable} is user-missing, results in the value of @var{variable}
+anyway. If @var{variable} is system-missing, results in system-missing.
+@end deftypefn
+
+@node Pseudo-Random Numbers, Set Membership, Missing Value Functions, Functions
+@subsection Pseudo-Random Number Generation Functions
+@cindex random numbers
+@cindex pseudo-random numbers (see random numbers)
+
+Pseudo-random number generation functions take numeric arguments and
+produce numeric results.
+
+@cindex Knuth
+The system's C library random generator is used as a basis for
+generating random numbers, since random number generation is a
+system-dependent task. However, Knuth's Algorithm B is used to
+shuffle the resultant values, which is enough to make even a stream of
+consecutive integers random enough for most applications.
+
+(If you're worried about the quality of the random number generator,
+well, you're using a statistical processing package---analyze it!)
+
+@cindex random numbers, normally-distributed
+@deftypefn {Function} {} NORMAL (@var{number})
+Results in a random number. Results from @code{NORMAL} are normally
+distributed with a mean of 0 and a standard deviation of @var{number}.
+@end deftypefn
+
+@cindex random numbers, uniformly-distributed
+@deftypefn {Function} {} UNIFORM (@var{number})
+Results in a random number between 0 and @var{number}. Results from
+@code{UNIFORM} are evenly distributed across its entire range. There
+may be a maximum on the largest random number ever generated---this is
+often 2**31-1 (2,147,483,647), but it may be orders of magnitude
+higher or lower.
+@end deftypefn
+
+@node Set Membership, Statistical Functions, Pseudo-Random Numbers, Functions
+@subsection Set-Membership Functions
+@cindex set membership
+@cindex membership, of set
+
+Set membership functions determine whether a value is a member of a set.
+They take a set of numeric arguments or a set of string arguments, and
+produce Boolean results.
+
+String comparisons are performed according to the rules given in
+@ref{Relational Operators}.
+
+@deftypefn {Function} {} ANY (@var{value}, @var{set} [, @var{set}]@dots{})
+Results in true if @var{value} is equal to any of the @var{set}
+values. Otherwise, results in false. If @var{value} is
+system-missing, returns system-missing. System-missing values in
+@var{set} do not cause ANY to return system-missing.
+@end deftypefn
+
+@deftypefn {Function} {} RANGE (@var{value}, @var{low}, @var{high} [, @var{low}, @var{high}]@dots{})
+Results in true if @var{value} is in any of the intervals bounded by
+@var{low} and @var{high} inclusive. Otherwise, results in false.
+Each @var{low} must be less than or equal to its corresponding
+@var{high} value. @var{low} and @var{high} must be given in pairs.
+If @var{value} is system-missing, returns system-missing.
+System-missing values in @var{set} do not cause RANGE to return
+system-missing.
+@end deftypefn
+
+@node Statistical Functions, String Functions, Set Membership, Functions
+@subsection Statistical Functions
+@cindex functions, statistical
+@cindex statistics
+
+Statistical functions compute descriptive statistics on a list of
+values. Some statistics can be computed on numeric or string values;
+other can only be computed on numeric values. They result in the same
+type as their arguments.
+
+@cindex arguments, minimum valid
+@cindex minimum valid number of arguments
+With statistical functions it is possible to specify a minimum number of
+non-missing arguments for the function to be evaluated. To do so,
+append a dot and the number to the function name. For instance, to
+specify a minimum of three valid arguments to the MEAN function, use the
+name @code{MEAN.3}.
+
+@cindex coefficient of variation
+@cindex variation, coefficient of
+@deftypefn {Function} {} CFVAR (@var{number}, @var{number}[, @dots{}])
+Results in the coefficient of variation of the values of @var{number}.
+This function requires at least two valid arguments to give a
+non-missing result. (The coefficient of variation is the standard
+deviation divided by the mean.)
+@end deftypefn
+
+@cindex maximum
+@deftypefn {Function} {} MAX (@var{value}, @var{value}[, @dots{}])
+Results in the value of the greatest @var{value}. The @var{value}s may
+be numeric or string. Although at least two arguments must be given,
+only one need be valid for MAX to give a non-missing result.
+@end deftypefn
+
+@cindex mean
+@deftypefn {Function} {} MEAN (@var{number}, @var{number}[, @dots{}])
+Results in the mean of the values of @var{number}. Although at least
+two arguments must be given, only one need be valid for MEAN to give a
+non-missing result.
+@end deftypefn
+
+@cindex minimum
+@deftypefn {Function} {} MIN (@var{number}, @var{number}[, @dots{}])
+Results in the value of the least @var{value}. The @var{value}s may
+be numeric or string. Although at least two arguments must be given,
+only one need be valid for MAX to give a non-missing result.
+@end deftypefn
+
+@cindex standard deviation
+@cindex deviation, standard
+@deftypefn {Function} {} SD (@var{number}, @var{number}[, @dots{}])
+Results in the standard deviation of the values of @var{number}.
+This function requires at least two valid arguments to give a
+non-missing result.
+@end deftypefn
+
+@cindex sum
+@deftypefn {Function} {} SUM (@var{number}, @var{number}[, @dots{}])
+Results in the sum of the values of @var{number}. Although at least two
+arguments must be given, only one need by valid for SUM to give a
+non-missing result.
+@end deftypefn
+
+@cindex variance
+@deftypefn {Function} {} VAR (@var{number}, @var{number}[, @dots{}])
+Results in the variance of the values of @var{number}. This function
+requires at least two valid arguments to give a non-missing result.
+@end deftypefn
+
+@deftypefn {Function} {} VARIANCE (@var{number}, @var{number}[, @dots{}])
+Results in the variance of the values of @var{number}. This function
+requires at least two valid arguments to give a non-missing result.
+(Use VAR in preference to VARIANCE for reasons of portability.)
+@end deftypefn
+
+@node String Functions, Time & Date, Statistical Functions, Functions
+@subsection String Functions
+@cindex functions, string
+@cindex string functions
+
+String functions take various arguments and return various results.
+
+@cindex concatenation
+@cindex strings, concatenation of
+@deftypefn {Function} {} CONCAT (@var{string}, @var{string}[, @dots{}])
+Returns a string consisting of each @var{string} in sequence.
+@code{CONCAT("abc", "def", "ghi")} has a value of @code{"abcdefghi"}.
+The resultant string is truncated to a maximum of 255 characters.
+@end deftypefn
+
+@cindex searching strings
+@deftypefn {Function} {} INDEX (@var{haystack}, @var{needle})
+Returns a positive integer indicating the position of the first
+occurrence @var{needle} in @var{haystack}. Returns 0 if @var{haystack}
+does not contain @var{needle}. Returns system-missing if @var{needle}
+is an empty string.
+@end deftypefn
+
+@deftypefn {Function} {} INDEX (@var{haystack}, @var{needle}, @var{divisor})
+Divides @var{needle} into parts, each with length @var{divisor}.
+Searches @var{haystack} for the first occurrence of each part, and
+returns the smallest value. Returns 0 if @var{haystack} does not
+contain any part in @var{needle}. It is an error if @var{divisor}
+cannot be evenly divided into the length of @var{needle}. Returns
+system-missing if @var{needle} is an empty string.
+@end deftypefn
+
+@cindex strings, finding length of
+@deftypefn {Function} {} LENGTH (@var{string})
+Returns the number of characters in @var{string}.
+@end deftypefn
+
+@cindex strings, case of
+@deftypefn {Function} {} LOWER (@var{string})
+Returns a string identical to @var{string} except that all uppercase
+letters are changed to lowercase letters. The definitions of
+``uppercase'' and ``lowercase'' are system-dependent.
+@end deftypefn
+
+@cindex strings, padding
+@deftypefn {Function} {} LPAD (@var{string}, @var{length})
+If @var{string} is at least @var{length} characters in length, returns
+@var{string} unchanged. Otherwise, returns @var{string} padded with
+spaces on the left side to length @var{length}. Returns an empty string
+if @var{length} is system-missing, negative, or greater than 255.
+@end deftypefn
+
+@deftypefn {Function} {} LPAD (@var{string}, @var{length}, @var{padding})
+If @var{string} is at least @var{length} characters in length, returns
+@var{string} unchanged. Otherwise, returns @var{string} padded with
+@var{padding} on the left side to length @var{length}. Returns an empty
+string if @var{length} is system-missing, negative, or greater than 255, or
+if @var{padding} does not contain exactly one character.
+@end deftypefn
+
+@cindex strings, trimming
+@cindex whitespace, trimming
+@deftypefn {Function} {} LTRIM (@var{string})
+Returns @var{string}, after removing leading spaces. Other whitespace,
+such as tabs, carriage returns, line feeds, and vertical tabs, is not
+removed.
+@end deftypefn
+
+@deftypefn {Function} {} LTRIM (@var{string}, @var{padding})
+Returns @var{string}, after removing leading @var{padding} characters.
+If @var{padding} does not contain exactly one character, returns an
+empty string.
+@end deftypefn
+
+@cindex numbers, converting from strings
+@cindex strings, converting to numbers
+@deftypefn {Function} {} NUMBER (@var{string})
+Returns the number produced when @var{string} is interpreted according
+to format F@var{x}.0, where @var{x} is the number of characters in
+@var{string}. If @var{string} does not form a proper number,
+system-missing is returned without an error message. Portability: none.
+@end deftypefn
+
+@deftypefn {Function} {} NUMBER (@var{string}, @var{format})
+Returns the number produced when @var{string} is interpreted according
+to format specifier @var{format}. Only the number of characters in
+@var{string} specified by @var{format} are examined. For example,
+@code{NUMBER("123", F3.0)} and @code{NUMBER("1234", F3.0)} both have
+value 123. If @var{string} does not form a proper number,
+system-missing is returned without an error message.
+@end deftypefn
+
+@cindex strings, searching backwards
+@deftypefn {Function} {} RINDEX (@var{string}, @var{format})
+Returns a positive integer indicating the position of the last
+occurrence of @var{needle} in @var{haystack}. Returns 0 if
+@var{haystack} does not contain @var{needle}. Returns system-missing if
+@var{needle} is an empty string.
+@end deftypefn
+
+@deftypefn {Function} {} RINDEX (@var{haystack}, @var{needle}, @var{divisor})
+Divides @var{needle} into parts, each with length @var{divisor}.
+Searches @var{haystack} for the last occurrence of each part, and
+returns the largest value. Returns 0 if @var{haystack} does not contain
+any part in @var{needle}. It is an error if @var{divisor} cannot be
+evenly divided into the length of @var{needle}. Returns system-missing
+if @var{needle} is an empty string.
+@end deftypefn
+
+@cindex padding strings
+@cindex strings, padding
+@deftypefn {Function} {} RPAD (@var{string}, @var{length})
+If @var{string} is at least @var{length} characters in length, returns
+@var{string} unchanged. Otherwise, returns @var{string} padded with
+spaces on the right to length @var{length}. Returns an empty string if
+@var{length} is system-missing, negative, or greater than 255.
+@end deftypefn
+
+@deftypefn {Function} {} RPAD (@var{string}, @var{length}, @var{padding})
+If @var{string} is at least @var{length} characters in length, returns
+@var{string} unchanged. Otherwise, returns @var{string} padded with
+@var{padding} on the right to length @var{length}. Returns an empty
+string if @var{length} is system-missing, negative, or greater than 255,
+or if @var{padding} does not contain exactly one character.
+@end deftypefn
+
+@cindex strings, trimming
+@cindex whitespace, trimming
+@deftypefn {Function} {} RTRIM (@var{string})
+Returns @var{string}, after removing trailing spaces. Other types of
+whitespace are not removed.
+@end deftypefn
+
+@deftypefn {Function} {} RTRIM (@var{string}, @var{padding})
+Returns @var{string}, after removing trailing @var{padding} characters.
+If @var{padding} does not contain exactly one character, returns an
+empty string.
+@end deftypefn
+
+@cindex strings, converting from numbers
+@cindex numbers, converting to strings
+@deftypefn {Function} {} STRING (@var{number}, @var{format})
+Returns a string corresponding to @var{number} in the format given by
+format specifier @var{format}. For example, @code{STRING(123.56, F5.1)}
+has the value @code{"123.6"}.
+@end deftypefn
+
+@cindex substrings
+@cindex strings, taking substrings of
+@deftypefn {Function} {} SUBSTR (@var{string}, @var{start})
+Returns a string consisting of the value of @var{string} from position
+@var{start} onward. Returns an empty string if @var{start} is system-missing
+or has a value less than 1 or greater than the number of characters in
+@var{string}.
+@end deftypefn
+
+@deftypefn {Function} {} SUBSTR (@var{string}, @var{start}, @var{count})
+Returns a string consisting of the first @var{count} characters from
+@var{string} beginning at position @var{start}. Returns an empty string
+if @var{start} or @var{count} is system-missing, if @var{start} is less
+than 1 or greater than the number of characters in @var{string}, or if
+@var{count} is less than 1. Returns a string shorter than @var{count}
+characters if @var{start} + @var{count} - 1 is greater than the number
+of characters in @var{string}. Examples: @code{SUBSTR("abcdefg", 3, 2)}
+has value @code{"cd"}; @code{SUBSTR("Ben Pfaff", 5, 10)} has the value
+@code{"Pfaff"}.
+@end deftypefn
+
+@cindex case conversion
+@cindex strings, case of
+@deftypefn {Function} {} UPCASE (@var{string})
+Returns @var{string}, changing lowercase letters to uppercase letters.
+@end deftypefn
+
+@node Time & Date, Miscellaneous Functions, String Functions, Functions
+@subsection Time & Date Functions
+@cindex functions, time & date
+@cindex times
+@cindex dates
+
+@cindex dates, legal range of
+The legal range of dates for use in PSPP is 15 Oct 1582
+through 31 Dec 19999.
+
+@cindex arguments, invalid
+@cindex invalid arguments
+@quotation
+@strong{Please note:} Most time & date extraction functions will accept
+invalid arguments:
+
+@itemize @bullet
+@item
+Negative numbers in PSPP time format.
+@item
+Numbers less than 86,400 in PSPP date format.
+@end itemize
+
+However, sensible results are not guaranteed for these invalid values.
+The given equivalents for these functions are definitely not guaranteed
+for invalid values.
+@end quotation
+
+@quotation
+@strong{Please note also:} The time & date construction
+functions @strong{do} produce reasonable and useful results for
+out-of-range values; these are not considered invalid.
+@end quotation
+
+@menu
+* Time & Date Concepts:: How times & dates are defined and represented
+* Time Construction:: TIME.@{DAYS HMS@}
+* Time Extraction:: CTIME.@{DAYS HOURS MINUTES SECONDS@}
+* Date Construction:: DATE.@{DMY MDY MOYR QYR WKYR YRDAY@}
+* Date Extraction:: XDATE.@{DATE HOUR JDAY MDAY MINUTE MONTH
+ QUARTER SECOND TDAY TIME WEEK
+ WKDAY YEAR@}
+@end menu
+
+@node Time & Date Concepts, Time Construction, Time & Date, Time & Date
+@subsubsection How times & dates are defined and represented
+
+@cindex time, concepts
+@cindex time, intervals
+Times and dates are handled by PSPP as single numbers. A
+@dfn{time} is an interval. PSPP measures times in seconds.
+Thus, the following intervals correspond with the numeric values given:
+
+@example
+ 10 minutes 600
+ 1 hour 3,600
+ 1 day, 3 hours, 10 seconds 97,210
+ 40 days 3,456,000
+ 10010 d, 14 min, 24 s 864,864,864
+@end example
+
+@cindex dates, concepts
+@cindex time, instants of
+A @dfn{date}, on the other hand, is a particular instant in the past or
+the future. PSPP represents a date as a number of seconds after the
+midnight that separated 8 Oct 1582 and 9 Oct 1582. (Please note that 15
+Oct 1582 immediately followed 9 Oct 1582.) Thus, the midnights before
+the dates given below correspond with the numeric PSPP dates given:
+
+@example
+ 15 Oct 1582 86,400
+ 4 Jul 1776 6,113,318,400
+ 1 Jan 1900 10,010,390,400
+ 1 Oct 1978 12,495,427,200
+ 24 Aug 1995 13,028,601,600
+@end example
+
+@cindex time, mathematical properties of
+@cindex mathematics, applied to times & dates
+@cindex dates, mathematical properties of
+@noindent
+Please note:
+
+@itemize @bullet
+@item
+A time may be added to, or subtracted from, a date, resulting in a date.
+
+@item
+The difference of two dates may be taken, resulting in a time.
+
+@item
+Two times may be added to, or subtracted from, each other, resulting in
+a time.
+@end itemize
+
+(Adding two dates does not produce a useful result.)
+
+Since times and dates are merely numbers, the ordinary addition and
+subtraction operators are employed for these purposes.
+
+@quotation
+@strong{Please note:} Many dates and times have extremely large
+values---just look at the values above. Thus, it is not a good idea to
+take powers of these values; also, the accuracy of some procedures may
+be affected. If necessary, convert times or dates in seconds to some
+other unit, like days or years, before performing analysis.
+@end quotation
+
+@node Time Construction, Time Extraction, Time & Date Concepts, Time & Date
+@subsubsection Functions that Produce Times
+@cindex times, constructing
+@cindex constructing times
+
+These functions take numeric arguments and produce numeric results in
+PSPP time format.
+
+@cindex days
+@cindex time, in days
+@deftypefn {Function} {} TIME.DAYS (@var{ndays})
+Results in a time value corresponding to @var{ndays} days.
+(@code{TIME.DAYS(@var{x})} is equivalent to @code{@var{x} * 60 * 60 *
+24}.)
+@end deftypefn
+
+@cindex hours-minutes-seconds
+@cindex time, in hours-minutes-seconds
+@deftypefn {Function} {} TIME.HMS (@var{nhours}, @var{nmins}, @var{nsecs})
+Results in a time value corresponding to @var{nhours} hours, @var{nmins}
+minutes, and @var{nsecs} seconds. (@code{TIME.HMS(@var{h}, @var{m},
+@var{s})} is equivalent to @code{@var{h}*60*60 + @var{m}*60 +
+@var{s}}.)
+@end deftypefn
+
+@node Time Extraction, Date Construction, Time Construction, Time & Date
+@subsubsection Functions that Examine Times
+@cindex extraction, of time
+@cindex time examination
+@cindex examination, of times
+@cindex time, lengths of
+
+These functions take numeric arguments in PSPP time format and
+give numeric results.
+
+@cindex days
+@cindex time, in days
+@deftypefn {Function} {} CTIME.DAYS (@var{time})
+Results in the number of days and fractional days in @var{time}.
+(@code{CTIME.DAYS(@var{x})} is equivalent to @code{@var{x}/60/60/24}.)
+@end deftypefn
+
+@cindex hours
+@cindex time, in hours
+@deftypefn {Function} {} CTIME.HOURS (@var{time})
+Results in the number of hours and fractional hours in @var{time}.
+(@code{CTIME.HOURS(@var{x})} is equivalent to @code{@var{x}/60/60}.)
+@end deftypefn
+
+@cindex minutes
+@cindex time, in minutes
+@deftypefn {Function} {} CTIME.MINUTES (@var{time})
+Results in the number of minutes and fractional minutes in @var{time}.
+(@code{CTIME.MINUTES(@var{x})} is equivalent to @code{@var{x}/60}.)
+@end deftypefn
+
+@cindex seconds
+@cindex time, in seconds
+@deftypefn {Function} {} CTIME.SECONDS (@var{time})
+Results in the number of seconds and fractional seconds in @var{time}.
+(@code{CTIME.SECONDS} does nothing; @code{CTIME.SECONDS(@var{x})} is
+equivalent to @code{@var{x}}.)
+@end deftypefn
+
+@node Date Construction, Date Extraction, Time Extraction, Time & Date
+@subsubsection Functions that Produce Dates
+@cindex dates, constructing
+@cindex constructing dates
+
+@cindex arguments, of date construction functions
+These functions take numeric arguments and give numeric results in the
+PSPP date format. Arguments taken by these functions are:
+
+@table @var
+@item day
+Refers to a day of the month between 1 and 31.
+
+@item month
+Refers to a month of the year between 1 and 12.
+
+@item quarter
+Refers to a quarter of the year between 1 and 4. The quarters of the
+year begin on the first days of months 1, 4, 7, and 10.
+
+@item week
+Refers to a week of the year between 1 and 53.
+
+@item yday
+Refers to a day of the year between 1 and 366.
+
+@item year
+Refers to a year between 1582 and 19999.
+@end table
+
+@cindex arguments, invalid
+If these functions' arguments are out-of-range, they are correctly
+normalized before conversion to date format. Non-integers are rounded
+toward zero.
+
+@cindex day-month-year
+@cindex dates, day-month-year
+@deftypefn {Function} {} DATE.DMY (@var{day}, @var{month}, @var{year})
+@deftypefnx {Function} {} DATE.MDY (@var{month}, @var{day}, @var{year})
+Results in a date value corresponding to the midnight before day
+@var{day} of month @var{month} of year @var{year}.
+@end deftypefn
+
+@cindex month-year
+@cindex dates, month-year
+@deftypefn {Function} {} DATE.MOYR (@var{month}, @var{year})
+Results in a date value corresponding to the midnight before the first
+day of month @var{month} of year @var{year}.
+@end deftypefn
+
+@cindex quarter-year
+@cindex dates, quarter-year
+@deftypefn {Function} {} DATE.QYR (@var{quarter}, @var{year})
+Results in a date value corresponding to the midnight before the first
+day of quarter @var{quarter} of year @var{year}.
+@end deftypefn
+
+@cindex week-year
+@cindex dates, week-year
+@deftypefn {Function} {} DATE.WKYR (@var{week}, @var{year})
+Results in a date value corresponding to the midnight before the first
+day of week @var{week} of year @var{year}.
+@end deftypefn
+
+@cindex year-day
+@cindex dates, year-day
+@deftypefn {Function} {} DATE.YRDAY (@var{year}, @var{yday})
+Results in a date value corresponding to the midnight before day
+@var{yday} of year @var{year}.
+@end deftypefn
+
+@node Date Extraction, , Date Construction, Time & Date
+@subsubsection Functions that Examine Dates
+@cindex extraction, of dates
+@cindex date examination
+
+@cindex arguments, of date extraction functions
+These functions take numeric arguments in PSPP date or time
+format and give numeric results. These names are used for arguments:
+
+@table @var
+@item date
+A numeric value in PSPP date format.
+
+@item time
+A numeric value in PSPP time format.
+
+@item time-or-date
+A numeric value in PSPP time or date format.
+@end table
+
+@cindex days
+@cindex dates, in days
+@cindex time, in days
+@deftypefn {Function} {} XDATE.DATE (@var{time-or-date})
+For a time, results in the time corresponding to the number of whole
+days @var{date-or-time} includes. For a date, results in the date
+corresponding to the latest midnight at or before @var{date-or-time};
+that is, gives the date that @var{date-or-time} is in.
+(XDATE.DATE(@var{x}) is equivalent to TRUNC(@var{x}/86400)*86400.)
+Applying this function to a time is a Portability: none feature.
+@end deftypefn
+
+@cindex hours
+@cindex dates, in hours
+@cindex time, in hours
+@deftypefn {Function} {} XDATE.HOUR (@var{time-or-date})
+For a time, results in the number of whole hours beyond the number of
+whole days represented by @var{date-or-time}. For a date, results in
+the hour (as an integer between 0 and 23) corresponding to
+@var{date-or-time}. (XDATE.HOUR(@var{x}) is equivalent to
+MOD(TRUNC(@var{x}/3600),24)) Applying this function to a time is a
+Portability: none feature.
+@end deftypefn
+
+@cindex day of the year
+@cindex dates, day of the year
+@deftypefn {Function} {} XDATE.JDAY(@var{date})
+Results in the day of the year (as an integer between 1 and 366)
+corresponding to @var{date}.
+@end deftypefn
+
+@cindex day of the month
+@cindex dates, day of the month
+@deftypefn {Function} {} XDATE.MDAY(@var{date})
+Results in the day of the month (as an integer between 1 and 31)
+corresponding to @var{date}.
+@end deftypefn
+
+@cindex minutes
+@cindex dates, in minutes
+@cindex time, in minutes
+@deftypefn {Function} {} XDATE.MINUTE(@var{time-or-date})
+Results in the number of minutes (as an integer between 0 and 59) after
+the last hour in @var{time-or-date}. (XDATE.MINUTE(@var{x}) is
+equivalent to MOD(TRUNC(@var{x}/60),60)) Applying this function to a
+time is a Portability: none feature.
+@end deftypefn
+
+@cindex months
+@cindex dates, in months
+@deftypefn {Function} {} XDATE.MONTH(@var{date})
+Results in the month of the year (as an integer between 1 and 12)
+corresponding to @var{date}.
+@end deftypefn
+
+@cindex quarters
+@cindex dates, in quarters
+@deftypefn {Function} {} XDATE.QUARTER(@var{date})
+Results in the quarter of the year (as an integer between 1 and 4)
+corresponding to @var{date}.
+@end deftypefn
+
+@cindex seconds
+@cindex dates, in seconds
+@cindex time, in seconds
+@deftypefn {Function} {} XDATE.SECOND(@var{time-or-date})
+Results in the number of whole seconds after the last whole minute (as
+an integer between 0 and 59) in @var{time-or-date}.
+(XDATE.SECOND(@var{x}) is equivalent to MOD(@var{x}, 60).) Applying
+this function to a time is a Portability: none feature.
+@end deftypefn
+
+@cindex days
+@cindex times, in days
+@deftypefn {Function} {} XDATE.TDAY(@var{time})
+Results in the number of whole days (as an integer) in @var{time}.
+(XDATE.TDAY(@var{x}) is equivalent to TRUNC(@var{x}/86400).)
+@end deftypefn
+
+@cindex time
+@cindex dates, time of day
+@deftypefn {Function} {} XDATE.TIME(@var{date})
+Results in the time of day at the instant corresponding to @var{date},
+in PSPP time format. This is the number of seconds since
+midnight on the day corresponding to @var{date}. (XDATE.TIME(@var{x}) is
+equivalent to TRUNC(@var{x}/86400)*86400.)
+@end deftypefn
+
+@cindex week
+@cindex dates, in weeks
+@deftypefn {Function} {} XDATE.WEEK(@var{date})
+Results in the week of the year (as an integer between 1 and 53)
+corresponding to @var{date}.
+@end deftypefn
+
+@cindex day of the week
+@cindex weekday
+@cindex dates, day of the week
+@cindex dates, in weekdays
+@deftypefn {Function} {} XDATE.WKDAY(@var{date})
+Results in the day of week (as an integer between 1 and 7) corresponding
+to @var{date}. The days of the week are:
+
+@table @asis
+@item 1
+Sunday
+@item 2
+Monday
+@item 3
+Tuesday
+@item 4
+Wednesday
+@item 5
+Thursday
+@item 6
+Friday
+@item 7
+Saturday
+@end table
+@end deftypefn
+
+@cindex years
+@cindex dates, in years
+@deftypefn {Function} {} XDATE.YEAR (@var{date})
+Returns the year (as an integer between 1582 and 19999) corresponding to
+@var{date}.
+@end deftypefn
+
+@node Miscellaneous Functions, Functions Not Implemented, Time & Date, Functions
+@subsection Miscellaneous Functions
+@cindex functions, miscellaneous
+
+Miscellaneous functions take various arguments and produce various
+results.
+
+@cindex cross-case function
+@cindex function, cross-case
+@deftypefn {Function} {} LAG (@var{variable})
+@var{variable} must be a numeric or string variable name. @code{LAG}
+results in the value of that variable for the case before the current
+one. In case-selection procedures, @code{LAG} results in the value of
+the variable for the last case selected. Results in system-missing (for
+numeric variables) or blanks (for string variables) for the first case
+or before any cases are selected.
+@end deftypefn
+
+@deftypefn {Function} {} LAG (@var{variable}, @var{ncases})
+@var{variable} must be a numeric or string variable name. @var{ncases}
+must be a small positive constant integer, although there is no explicit
+limit. (Use of a large value for @var{ncases} will increase memory
+consumption, since PSPP must keep @var{ncases} cases in memory.)
+@code{LAG (@var{variable}, @var{ncases}} results in the value of
+@var{variable} that is @var{ncases} before the case currently being
+processed. See @code{LAG (@var{variable})} above for more details.
+@end deftypefn
+
+@cindex date, Julian
+@cindex Julian date
+@deftypefn {Function} {} YRMODA (@var{year}, @var{month}, @var{day})
+@var{year} is a year between 0 and 199 or 1582 and 19999. @var{month} is
+a month between 1 and 12. @var{day} is a day between 1 and 31. If
+@var{month} or @var{day} is out-of-range, it changes the next higher
+unit. For instance, a @var{day} of 0 refers to the last day of the
+previous month, and a @var{month} of 13 refers to the first month of the
+next year. @var{year} must be in range. If @var{year} is between 0 and
+199, 1900 is added. @var{year}, @var{month}, and @var{day} must all be
+integers.
+
+@code{YRMODA} results in the number of days between 15 Oct 1582 and
+the date specified, plus one. The date passed to @code{YRMODA} must be
+on or after 15 Oct 1582. 15 Oct 1582 has a value of 1.
+@end deftypefn
+
+@node Functions Not Implemented, , Miscellaneous Functions, Functions
+@subsection Functions Not Implemented
+@cindex functions, not implemented
+@cindex not implemented
+@cindex features, not implemented
+
+These functions are not yet implemented and thus not yet documented,
+since it's a hassle.
+
+@findex CDF.xxx
+@findex CDFNORM
+@findex IDF.xxx
+@findex NCDF.xxx
+@findex PROBIT
+@findex RV.xxx
+
+@itemize @bullet
+@item
+@code{CDF.xxx}
+@item
+@code{CDFNORM}
+@item
+@code{IDF.xxx}
+@item
+@code{NCDF.xxx}
+@item
+@code{PROBIT}
+@item
+@code{RV.xxx}
+@end itemize
+
+@node Order of Operations, , Functions, Expressions
+@section Operator Precedence
+@cindex operator precedence
+@cindex precedence, operator
+@cindex order of operations
+@cindex operations, order of
+
+The following table describes operator precedence. Smaller-numbered
+levels in the table have higher precedence. Within a level, operations
+are performed from left to right, except for level 2 (exponentiation),
+where operations are performed from right to left. If an operator
+appears in the table in two places (@code{-}), the first occurrence is
+unary, the second is binary.
+
+@enumerate
+@item
+@code{( )}
+@item
+@code{**}
+@item
+@code{-}
+@item
+@code{* /}
+@item
+@code{+ -}
+@item
+@code{EQ GE GT LE LT NE}
+@item
+@code{AND NOT OR}
+@end enumerate
+
+@node Data Input and Output, System and Portable Files, Expressions, Top
+@chapter Data Input and Output
+@cindex input
+@cindex output
+@cindex data
+
+Data is the focus of the PSPP language. This chapter examines
+the PSPP commands for defining variables and reading and writing data.
+
+@quotation
+@strong{Please note:} Data is not actually read until a procedure is
+executed. These commands tell PSPP how to read data, but they
+do not @emph{cause} PSPP to read data.
+@end quotation
+
+@menu
+* BEGIN DATA:: Embed data within a syntax file.
+* CLEAR TRANSFORMATIONS:: Clear pending transformations.
+* DATA LIST:: Fundamental data reading command.
+* END CASE:: Output the current case.
+* END FILE:: Terminate the current input program.
+* FILE HANDLE:: Support for fixed-length records.
+* INPUT PROGRAM:: Support for complex input programs.
+* LIST:: List cases in the active file.
+* MATRIX DATA:: Read matrices in text format.
+* NEW FILE:: Clear the active file and dictionary.
+* PRINT:: Display values in print formats.
+* PRINT EJECT:: Eject the current page then print.
+* PRINT SPACE:: Print blank lines.
+* REREAD:: Take another look at the previous input line.
+* REPEATING DATA:: Multiple cases on a single line.
+* WRITE:: Display values in write formats.
+@end menu
+
+@node BEGIN DATA, CLEAR TRANSFORMATIONS, Data Input and Output, Data Input and Output
+@section BEGIN DATA
+@vindex BEGIN DATA
+@vindex END DATA
+@cindex Embedding data in syntax files
+@cindex Data, embedding in syntax files
+
+@display
+BEGIN DATA.
+@dots{}
+END DATA.
+@end display
+
+BEGIN DATA and END DATA can be used to embed raw ASCII data in a PSPP
+syntax file. DATA LIST or another input procedure must be used before
+BEGIN DATA (@pxref{DATA LIST}). BEGIN DATA and END DATA must be used
+together. The END DATA command must appear by itself on a single line,
+with no leading whitespace and exactly one space between the words
+@code{END} and @code{DATA}, followed immediately by the terminal dot,
+like this:
+
+@example
+END DATA.
+@end example
+
+@node CLEAR TRANSFORMATIONS, DATA LIST, BEGIN DATA, Data Input and Output
+@section CLEAR TRANSFORMATIONS
+@vindex CLEAR TRANSFORMATIONS
+
+@display
+CLEAR TRANSFORMATIONS.
+@end display
+
+The CLEAR TRANSFORMATIONS command clears out all pending
+transformations. It does not cancel the current input program. It is
+valid only when PSPP is interactive, not in syntax files.
+
+@node DATA LIST, END CASE, CLEAR TRANSFORMATIONS, Data Input and Output
+@section DATA LIST
+@vindex DATA LIST
+@cindex reading data from a file
+@cindex data, reading from a file
+@cindex data, embedding in syntax files
+@cindex embedding data in syntax files
+
+Used to read text or binary data, DATA LIST is the most
+fundamental data-reading command. Even the more sophisticated input
+methods use DATA LIST commands as a building block.
+Understanding DATA LIST is important to understanding how to use
+PSPP to read your data files.
+
+There are two major variants of DATA LIST, which are fixed
+format and free format. In addition, free format has a minor variant,
+list format, which is discussed in terms of its differences from vanilla
+free format.
+
+Each form of DATA LIST is described in detail below.
+
+@menu
+* DATA LIST FIXED:: Fixed columnar locations for data.
+* DATA LIST FREE:: Any spacing you like.
+* DATA LIST LIST:: Each case must be on a single line.
+@end menu
+
+@node DATA LIST FIXED, DATA LIST FREE, DATA LIST, DATA LIST
+@subsection DATA LIST FIXED
+@vindex DATA LIST FIXED
+@cindex reading fixed-format data
+@cindex fixed-format data, reading
+@cindex data, fixed-format, reading
+@cindex embedding fixed-format data
+
+@display
+DATA LIST [FIXED]
+ @{TABLE,NOTABLE@}
+ FILE='filename'
+ RECORDS=record_count
+ END=end_var
+ /[line_no] var_spec@dots{}
+
+where each var_spec takes one of the forms
+ var_list start-end [type_spec]
+ var_list (fortran_spec)
+@end display
+
+DATA LIST FIXED is used to read data files that have values at fixed
+positions on each line of single-line or multiline records. The
+keyword FIXED is optional.
+
+The FILE subcommand must be used if input is to be taken from an
+external file. It may be used to specify a filename as a string or a
+file handle (@pxref{FILE HANDLE}). If the FILE subcommand is not used,
+then input is assumed to be specified within the command file using
+BEGIN DATA@dots{}END DATA (@pxref{BEGIN DATA}).
+
+The optional RECORDS subcommand, which takes a single integer as an
+argument, is used to specify the number of lines per record. If RECORDS
+is not specified, then the number of lines per record is calculated from
+the list of variable specifications later in the DATA LIST command.
+
+The END subcommand is only useful in conjunction with the INPUT PROGRAM
+input procedure, and for that reason it is not discussed here
+(@pxref{INPUT PROGRAM}).
+
+DATA LIST can optionally output a table describing how the data file
+will be read. The TABLE subcommand enables this output, and NOTABLE
+disables it. The default is to output the table.
+
+The list of variables to be read from the data list must come last in
+the DATA LIST command. Each line in the data record is introduced by a
+slash (@samp{/}). Optionally, a line number may follow the slash.
+Following, any number of variable specifications may be present.
+
+Each variable specification consists of a list of variable names
+followed by a description of their location on the input line. Sets of
+variables may specified using DATA LIST's TO convention (@pxref{Sets of
+Variables}). There are two ways to specify the location of the variable
+on the line: SPSS style and FORTRAN style.
+
+With SPSS style, the starting column and ending column for the field
+are specified after the variable name, separated by a dash (@samp{-}).
+For instance, the third through fifth columns on a line would be
+specified @samp{3-5}. By default, variables are considered to be in
+@samp{F} format (@pxref{Input/Output Formats}). (This default can be
+changed; see @ref{SET} for more information.)
+
+When using SPSS style, to use a variable format other than the default,
+specify the format type in parentheses after the column numbers. For
+instance, for alphanumeric @samp{A} format, use @samp{(A)}.
+
+In addition, implied decimal places can be specified in parentheses
+after the column numbers. As an example, suppose that a data file has a
+field in which the characters @samp{1234} should be interpreted as
+having the value 12.34. Then this field has two implied decimal places,
+and the corresponding specification would be @samp{(2)}. If a field
+that has implied decimal places contains a decimal point, then the
+implied decimal places are not applied.
+
+Changing the variable format and adding implied decimal places can be
+done together; for instance, @samp{(N,5)}.
+
+When using SPSS style, the input and output width of each variable is
+computed from the field width. The field width must be evenly divisible
+into the number of variables specified.
+
+FORTRAN style is an altogether different approach to specifying field
+locations. With this approach, a list of variable input format
+specifications, separated by commas, are placed after the variable names
+inside parentheses. Each format specifier advances as many characters
+into the input line as it uses.
+
+In addition to the standard format specifiers (@pxref{Input/Output
+Formats}), FORTRAN style defines some extensions:
+
+@table @asis
+@item @code{X}
+Advance the current column on this line by one character position.
+
+@item @code{T}@var{x}
+Set the current column on this line to column @var{x}, with column
+numbers considered to begin with 1 at the left margin.
+
+@item @code{NEWREC}@var{x}
+Skip forward @var{x} lines in the current record, resetting the active
+column to the left margin.
+
+@item Repeat count
+Any format specifier may be preceded by a number. This causes the
+action of that format specifier to be repeated the specified number of
+times.
+
+@item (@var{spec1}, @dots{}, @var{specN})
+Group the given specifiers together. This is most useful when preceded
+by a repeat count. Groups may be nested arbitrarily.
+@end table
+
+FORTRAN and SPSS styles may be freely intermixed. SPSS style leaves the
+active column immediately after the ending column specified. Record
+motion using @code{NEWREC} in FORTRAN style also applies to later
+FORTRAN and SPSS specifiers.
+
+@menu
+* DATA LIST FIXED Examples:: Examples of DATA LIST FIXED.
+@end menu
+
+@node DATA LIST FIXED Examples, , DATA LIST FIXED, DATA LIST FIXED
+@unnumberedsubsubsec Examples
+
+@enumerate
+@item
+@example
+DATA LIST TABLE /NAME 1-10 (A) INFO1 TO INFO3 12-17 (1).
+
+BEGIN DATA.
+John Smith 102311
+Bob Arnold 122015
+Bill Yates 918 6
+END DATA.
+@end example
+
+Defines the following variables:
+
+@itemize @bullet
+@item
+@code{NAME}, a 10-character-wide long string variable, in columns 1
+through 10.
+
+@item
+@code{INFO1}, a numeric variable, in columns 12 through 13.
+
+@item
+@code{INFO2}, a numeric variable, in columns 14 through 15.
+
+@item
+@code{INFO3}, a numeric variable, in columns 16 through 17.
+@end itemize
+
+The @code{BEGIN DATA}/@code{END DATA} commands cause three cases to be
+defined:
+
+@example
+Case NAME INFO1 INFO2 INFO3
+ 1 John Smith 10 23 11
+ 2 Bob Arnold 12 20 15
+ 3 Bill Yates 9 18 6
+@end example
+
+The @code{TABLE} keyword causes PSPP to print out a table
+describing the four variables defined.
+
+@item
+@example
+DAT LIS FIL="survey.dat"
+ /ID 1-5 NAME 7-36 (A) SURNAME 38-67 (A) MINITIAL 69 (A)
+ /Q01 TO Q50 7-56
+ /.
+@end example
+
+Defines the following variables:
+
+@itemize @bullet
+@item
+@code{ID}, a numeric variable, in columns 1-5 of the first record.
+
+@item
+@code{NAME}, a 30-character long string variable, in columns 7-36 of the
+first record.
+
+@item
+@code{SURNAME}, a 30-character long string variable, in columns 38-67 of
+the first record.
+
+@item
+@code{MINITIAL}, a 1-character short string variable, in column 69 of
+the first record.
+
+@item
+Fifty variables @code{Q01}, @code{Q02}, @code{Q03}, @dots{}, @code{Q49},
+@code{Q50}, all numeric, @code{Q01} in column 7, @code{Q02} in column 8,
+@dots{}, @code{Q49} in column 55, @code{Q50} in column 56, all in the second
+record.
+@end itemize
+
+Cases are separated by a blank record.
+
+Data is read from file @file{survey.dat} in the current directory.
+
+This example shows keywords abbreviated to their first 3 letters.
+
+@end enumerate
+
+@node DATA LIST FREE, DATA LIST LIST, DATA LIST FIXED, DATA LIST
+@subsection DATA LIST FREE
+@vindex DATA LIST FREE
+
+@display
+DATA LIST FREE
+ [@{NOTABLE,TABLE@}]
+ FILE='filename'
+ END=end_var
+ /var_spec@dots{}
+
+where each var_spec takes one of the forms
+ var_list [(type_spec)]
+ var_list *
+@end display
+
+In free format, the input data is structured as a series of comma- or
+whitespace-delimited fields (end of line is one form of whitespace; it
+is not treated specially). Field contents may be surrounded by matched
+pairs of apostrophes (@samp{'}) or quotes (@samp{"}), or they may be
+unenclosed. For any type of field leading white space (up to the
+apostrophe or quote, if any) is not included in the field.
+
+Multiple consecutive delimiters are equivalent to a single delimiter.
+To specify an empty field, write an empty set of single or double
+quotes; for instance, @samp{""}.
+
+The NOTABLE and TABLE subcommands are as in DATA LIST FIXED above.
+NOTABLE is the default.
+
+The FILE and END subcommands are as in DATA LIST FIXED above.
+
+The variables to be parsed are given as a single list of variable names.
+This list must be introduced by a single slash (@samp{/}). The set of
+variable names may contain format specifications in parentheses
+(@pxref{Input/Output Formats}). Format specifications apply to all
+variables back to the previous parenthesized format specification.
+
+In addition, an asterisk may be used to indicate that all variables
+preceding it are to have input/output format @samp{F8.0}.
+
+Specified field widths are ignored on input, although all normal limits
+on field width apply, but they are honored on output.
+
+@node DATA LIST LIST, , DATA LIST FREE, DATA LIST
+@subsection DATA LIST LIST
+@vindex DATA LIST LIST
+
+@display
+DATA LIST LIST
+ [@{NOTABLE,TABLE@}]
+ FILE='filename'
+ END=end_var
+ /var_spec@dots{}
+
+where each var_spec takes one of the forms
+ var_list [(type_spec)]
+ var_list *
+@end display
+
+Syntactically and semantically, DATA LIST LIST is equivalent to DATA
+LIST FREE, with one exception: each input line is expected to correspond
+to exactly one input record. If more or fewer fields are found on an
+input line than expected, an appropriate diagnostic is issued.
+
+@node END CASE, END FILE, DATA LIST, Data Input and Output
+@section END CASE
+@vindex END CASE
+
+@display
+END CASE.
+@end display
+
+END CASE is used within INPUT PROGRAM to output the current case.
+@xref{INPUT PROGRAM}.
+
+@node END FILE, FILE HANDLE, END CASE, Data Input and Output
+@section END FILE
+@vindex END FILE
+
+@display
+END FILE.
+@end display
+
+END FILE is used within INPUT PROGRAM to terminate the current input
+program. @xref{INPUT PROGRAM}.
+
+@node FILE HANDLE, INPUT PROGRAM, END FILE, Data Input and Output
+@section FILE HANDLE
+@vindex FILE HANDLE
+
+@display
+FILE HANDLE handle_name
+ /NAME='filename'
+ /RECFORM=@{VARIABLE,FIXED,SPANNED@}
+ /LRECL=rec_len
+ /MODE=@{CHARACTER,IMAGE,BINARY,MULTIPUNCH,360@}
+@end display
+
+Use the FILE HANDLE command to define the attributes of a file that does
+not use conventional variable-length records terminated by newline
+characters.
+
+Specify the file handle name as an identifier. Any given identifier may
+only appear once in a PSPP run. File handles may not be reassigned to a
+different file. The file handle name must immediately follow the FILE
+HANDLE command name.
+
+The NAME subcommand specifies the name of the file associated with the
+handle. It is the only required subcommand.
+
+The RECFORM subcommand specifies how the file is laid out. VARIABLE
+specifies variable-length lines terminated with newlines, and it is the
+default. FIXED specifies fixed-length records. SPANNED is not
+supported.
+
+LRECL specifies the length of fixed-length records. It is required if
+@code{/RECFORM FIXED} is specified.
+
+MODE specifies a file mode. CHARACTER, the default, causes the data
+file to be opened in ANSI C text mode. BINARY causes the data file to
+be opened in ANSI C binary mode. The other possibilities are not
+supported.
+
+@node INPUT PROGRAM, LIST, FILE HANDLE, Data Input and Output
+@section INPUT PROGRAM
+@vindex INPUT PROGRAM
+
+@display
+INPUT PROGRAM.
+@dots{} input commands @dots{}
+END INPUT PROGRAM.
+@end display
+
+The INPUT PROGRAM@dots{}END INPUT PROGRAM construct is used to specify a
+complex input program. By placing data input commands within INPUT
+PROGRAM, PSPP programs can take advantage of more complex file
+structures than available by using DATA LIST by itself.
+
+The first sort of extended input program is to simply put multiple DATA
+LIST commands within the INPUT PROGRAM. This will cause all of the data
+files to be read in parallel. Input will stop when end of file is
+reached on any of the data files.
+
+Transformations, such as conditional and looping constructs, can also be
+included within an INPUT PROGRAM. These can be used to combine input
+from several data files in more complex ways. However, input will still
+stop when end of file is reached on any of the data files.
+
+To prevent INPUT PROGRAM from terminating at the first end of file, use
+the END subcommand on DATA LIST. This subcommand takes a variable name,
+which should be a numeric scratch variable (@pxref{Scratch Variables}).
+(It need not be a scratch variable but otherwise the results can be
+surprising.) The value of this variable is set to 0 when reading the
+data file, or 1 when end of file is encountered.
+
+Some additional commands are useful in conjunction with INPUT PROGRAM.
+END CASE is the first one. Normally each loop through the INPUT PROGRAM
+structure produces one case. But with END CASE you can control exactly
+when cases are output. When END CASE is used, looping from the end of
+INPUT PROGRAM to the beginning does not cause a case to be output.
+
+END FILE is the other command. When the END subcommand is used on DATA
+LIST, there is no way for the INPUT PROGRAM construct to stop looping,
+so an infinite loop results. The END FILE command, when executed,
+stops the flow of input data and passes out of the INPUT PROGRAM
+structure.
+
+All this is very confusing. A few examples should help to clarify.
+
+@example
+INPUT PROGRAM.
+ DATA LIST NOTABLE FILE='a.data'/X 1-10.
+ DATA LIST NOTABLE FILE='b.data'/Y 1-10.
+END INPUT PROGRAM.
+LIST.
+@end example
+
+The example above reads variable X from file @file{a.data} and variable
+Y from file @file{b.data}. If one file is shorter than the other then
+the extra data in the longer file is ignored.
+
+@example
+INPUT PROGRAM.
+ NUMERIC #A #B.
+
+ DO IF NOT #A.
+ DATA LIST NOTABLE END=#A FILE='a.data'/X 1-10.
+ END IF.
+ DO IF NOT #B.
+ DATA LIST NOTABLE END=#B FILE='b.data'/Y 1-10.
+ END IF.
+ DO IF #A AND #B.
+ END FILE.
+ END IF.
+ END CASE.
+END INPUT PROGRAM.
+LIST.
+@end example
+
+This example reads variable X from @file{a.data} and variable Y from
+@file{b.data}. If one file is shorter than the other then the missing
+field is set to the system-missing value alongside the present value for
+the remaining length of the longer file.
+
+@example
+INPUT PROGRAM.
+ NUMERIC #A #B.
+
+ DO IF #A.
+ DATA LIST NOTABLE END=#B FILE='b.data'/X 1-10.
+ DO IF #B.
+ END FILE.
+ ELSE.
+ END CASE.
+ END IF.
+ ELSE.
+ DATA LIST NOTABLE END=#A FILE='a.data'/X 1-10.
+ DO IF NOT #A.
+ END CASE.
+ END IF.
+ END IF.
+END INPUT PROGRAM.
+LIST.
+@end example
+
+The above example reads data from file @file{a.data}, then from
+@file{b.data}, and concatenates them into a single active file.
+
+@example
+INPUT PROGRAM.
+ NUMERIC #EOF.
+
+ LOOP IF NOT #EOF.
+ DATA LIST NOTABLE END=#EOF FILE='a.data'/X 1-10.
+ DO IF NOT #EOF.
+ END CASE.
+ END IF.
+ END LOOP.
+
+ COMPUTE #EOF = 0.
+ LOOP IF NOT #EOF.
+ DATA LIST NOTABLE END=#EOF FILE='b.data'/X 1-10.
+ DO IF NOT #EOF.
+ END CASE.
+ END IF.
+ END LOOP.
+
+ END FILE.
+END INPUT PROGRAM.
+LIST.
+@end example
+
+The above example does the same thing as the previous example, in a
+different way.
+
+@example
+INPUT PROGRAM.
+ LOOP #I=1 TO 50.
+ COMPUTE X=UNIFORM(10).
+ END CASE.
+ END LOOP.
+ END FILE.
+END INPUT PROGRAM.
+LIST/FORMAT=NUMBERED.
+@end example
+
+The above example causes an active file to be created consisting of 50
+random variates between 0 and 10.
+
+@node LIST, MATRIX DATA, INPUT PROGRAM, Data Input and Output
+@section LIST
+@vindex LIST
+
+@display
+LIST
+ /VARIABLES=var_list
+ /CASES=FROM start_index TO end_index BY incr_index
+ /FORMAT=@{UNNUMBERED,NUMBERED@} @{WRAP,SINGLE@}
+ @{NOWEIGHT,WEIGHT@}
+@end display
+
+The LIST procedure prints the values of specified variables to the
+listing file.
+
+The VARIABLES subcommand specifies the variables whose values are to be
+printed. Keyword VARIABLES is optional. If VARIABLES subcommand is not
+specified then all variables in the active file are printed.
+
+The CASES subcommand can be used to specify a subset of cases to be
+printed. Specify FROM and the case number of the first case to print,
+TO and the case number of the last case to print, and BY and the number
+of cases to advance between printing cases, or any subset of those
+settings. If CASES is not specified then all cases are printed.
+
+The FORMAT subcommand can be used to change the output format. NUMBERED
+will print case numbers along with each case; UNNUMBERED, the default,
+causes the case numbers to be omitted. The WRAP and SINGLE settings are
+currently not used. WEIGHT will cause case weights to be printed along
+with variable values; NOWEIGHT, the default, causes case weights to be
+omitted from the output.
+
+Case numbers start from 1. They are counted after all transformations
+have been considered.
+
+LIST will attempt to fit all the values on a single line. If necessary,
+variable names will be display vertically in order to fit. If values
+cannot fit on a single line, then a multi-line format will be used.
+
+LIST is a procedure. It causes the data to be read.
+
+@node MATRIX DATA, NEW FILE, LIST, Data Input and Output
+@section MATRIX DATA
+@vindex MATRIX DATA
+
+@display
+MATRIX DATA
+ /VARIABLES=var_list
+ /FILE='filename'
+ /FORMAT=@{LIST,FREE@} @{LOWER,UPPER,FULL@} @{DIAGONAL,NODIAGONAL@}
+ /SPLIT=@{new_var,var_list@}
+ /FACTORS=var_list
+ /CELLS=n_cells
+ /N=n
+ /CONTENTS=@{N_VECTOR,N_SCALAR,N_MATRIX,MEAN,STDDEV,COUNT,MSE,
+ DFE,MAT,COV,CORR,PROX@}
+@end display
+
+The MATRIX DATA command reads square matrices in one of several textual
+formats. MATRIX DATA clears the dictionary and replaces it and reads a
+data file.
+
+Use VARIABLES to specify the variables that form the rows and columns of
+the matrices. You may not specify a variable named VARNAME_. You
+should specify VARIABLES first.
+
+Specify the file to read on FILE, either as a file name string or a file
+handle (@pxref{FILE HANDLE}). If FILE is not specified then matrix data
+must immediately follow MATRIX DATA with a BEGIN DATA@dots{}END DATA
+construct (@pxref{BEGIN DATA}).
+
+The FORMAT subcommand specifies how the matrices are formatted. LIST,
+the default, indicates that there is one line per row of matrix data;
+FREE allows single matrix rows to be broken across multiple lines. This
+is analogous to the difference between DATA LIST FREE and DATA LIST LIST
+(@pxref{DATA LIST}). LOWER, the default, indicates that the lower
+triangle of the matrix is given; UPPER indicates the upper triangle; and
+FULL indicates that the entire matrix is given. DIAGONAL, the default,
+indicates that the diagonal is part of the data; NODIAGONAL indicates
+that it is omitted. DIAGONAL/NODIAGONAL have no effect when FULL is
+specified.
+
+The SPLIT subcommand is used to specify SPLIT FILE variables for the
+input matrices (@pxref{SPLIT FILE}). Specify either a single variable
+not specified on VARIABLES, or one or more variables that are specified
+on VARIABLES. In the former case, the SPLIT values are not present in
+the data and ROWTYPE_ may not be specified on VARIABLES. In the latter
+case, the SPLIT values are present in the data.
+
+Specify a list of factor variables on FACTORS. Factor variables must
+also be listed on VARIABLES. Factor variables are used when there are
+some variables where, for each possible combination of their values,
+statistics on the matrix variables are included in the data.
+
+If FACTORS is specified and ROWTYPE_ is not specified on VARIABLES, the
+CELLS subcommand is required. Specify the number of factor variable
+combinations that are given. For instance, if factor variable A has 2
+values and factor variable B has 3 values, specify 6.
+
+The N subcommand specifies a population number of observations. When N
+is specified, one N record is output for each SPLIT FILE.
+
+Use CONTENTS to specify what sort of information the matrices include.
+Each possible option is described in more detail below. When ROWTYPE_
+is specified on VARIABLES, CONTENTS is optional; otherwise, if CONTENTS
+is not specified then /CONTENTS=CORR is assumed.
+
+@table @asis
+@item N
+@item N_VECTOR
+Number of observations as a vector, one value for each variable.
+@item N_SCALAR
+Number of observations as a single value.
+@item N_MATRIX
+Matrix of counts.
+@item MEAN
+Vector of means.
+@item STDDEV
+Vector of standard deviations.
+@item COUNT
+Vector of counts.
+@item MSE
+Vector of mean squared errors.
+@item DFE
+Vector of degrees of freedom.
+@item MAT
+Generic matrix.
+@item COV
+Covariance matrix.
+@item CORR
+Correlation matrix.
+@item PROX
+Proximities matrix.
+@end table
+
+The exact semantics of the matrices read by MATRIX DATA are complex.
+Right now MATRIX DATA isn't too useful due to a lack of procedures
+accepting or producing related data, so these semantics aren't
+documented. Later, they'll be described here in detail.
+
+@node NEW FILE, PRINT, MATRIX DATA, Data Input and Output
+@section NEW FILE
+@vindex NEW FILE
+
+@display
+NEW FILE.
+@end display
+
+The NEW FILE command clears the current active file.
+
+@node PRINT, PRINT EJECT, NEW FILE, Data Input and Output
+@section PRINT
+@vindex PRINT
+
+@display
+PRINT
+ OUTFILE='filename'
+ RECORDS=n_lines
+ @{NOTABLE,TABLE@}
+ /[line_no] arg@dots{}
+
+arg takes one of the following forms:
+ 'string' [start-end]
+ var_list start-end [type_spec]
+ var_list (fortran_spec)
+ var_list *
+@end display
+
+The PRINT transformation writes variable data to an output file. PRINT
+is executed when a procedure causes the data to be read. In order to
+execute the PRINT transformation without invoking a procedure, use the
+EXECUTE command (@pxref{EXECUTE}).
+
+All PRINT subcommands are optional.
+
+The OUTFILE subcommand specifies the file to receive the output. The
+file may be a file name as a string or a file handle (@pxref{FILE
+HANDLE}). If OUTFILE is not present then output will be sent to PSPP's
+output listing file.
+
+The RECORDS subcommand specifies the number of lines to be output. The
+number of lines may optionally be surrounded by parentheses.
+
+TABLE will cause the PRINT command to output a table to the listing file
+that describes what it will print to the output file. NOTABLE, the
+default, suppresses this output table.
+
+Introduce the strings and variables to be printed with a slash
+(@samp{/}). Optionally, the slash may be followed by a number
+indicating which output line will be specified. In the absence of this
+line number, the next line number will be specified. Multiple lines may
+be specified using multiple slashes with the intended output for a line
+following its respective slash.
+
+Literal strings may be printed. Specify the string itself. Optionally
+the string may be followed by a column number or range of column
+numbers, specifying the location on the line for the string to be
+printed. Otherwise, the string will be printed at the current position
+on the line.
+
+Variables to be printed can be specified in the same ways as available
+for DATA LIST FIXED (@pxref{DATA LIST FIXED}). In addition, a variable
+list may be followed by an asterisk (@samp{*}), which indicates that the
+variables should be printed in their dictionary print formats, separated
+by spaces. A variable list followed by a slash or the end of command
+will be interpreted the same way.
+
+If a FORTRAN type specification is used to move backwards on the current
+line, then text is written at that point on the line, the line will be
+truncated to that length, although additional text being added will
+again extend the line to that length.
+
+@node PRINT EJECT, PRINT SPACE, PRINT, Data Input and Output
+@section PRINT EJECT
+@vindex PRINT EJECT
+
+@display
+PRINT EJECT
+ OUTFILE='filename'
+ RECORDS=n_lines
+ @{NOTABLE,TABLE@}
+ /[line_no] arg@dots{}
+
+arg takes one of the following forms:
+ 'string' [start-end]
+ var_list start-end [type_spec]
+ var_list (fortran_spec)
+ var_list *
+@end display
+
+PRINT EJECT is used to write data to an output file. Before the data is
+written, the current page in the listing file is ejected.
+
+@xref{PRINT}, for more information on syntax and usage.
+
+@node PRINT SPACE, REREAD, PRINT EJECT, Data Input and Output
+@section PRINT SPACE
+@vindex PRINT SPACE
+
+@display
+PRINT SPACE OUTFILE='filename' n_lines.
+@end display
+
+The PRINT SPACE prints one or more blank lines to an output file.
+
+The OUTFILE subcommand is optional. It may be used to direct output to
+a file specified by file name as a string or file handle (@pxref{FILE
+HANDLE}). If OUTFILE is not specified then output will be directed to
+the listing file.
+
+n_lines is also optional. If present, it is an expression
+(@pxref{Expressions}) specifying the number of blank lines to be
+printed. The expression must evaluate to a nonnegative value.
+
+@node REREAD, REPEATING DATA, PRINT SPACE, Data Input and Output
+@section REREAD
+@vindex REREAD
+
+@display
+REREAD FILE=handle COLUMN=column.
+@end display
+
+The REREAD transformation allows the previous input line in a data file
+already processed by DATA LIST or another input command to be re-read
+for further processing.
+
+The FILE subcommand, which is optional, is used to specify the file to
+have its line re-read. The file must be specified in the form of a file
+handle (@pxref{FILE HANDLE}). If FILE is not specified then the last
+file specified on DATA LIST will be assumed (last file specified
+lexically, not in terms of flow-of-control).
+
+By default, the line re-read is re-read in its entirety. With the
+COLUMN subcommand, a prefix of the line can be exempted from
+re-reading. Specify an expression (@pxref{Expressions}) evaluating to
+the first column that should be included in the re-read line. Columns
+are numbered from 1 at the left margin.
+
+Multiple REREAD commands will not back up in the data file. Instead,
+they will re-read the same line multiple times.
+
+@node REPEATING DATA, WRITE, REREAD, Data Input and Output
+@section REPEATING DATA
+@vindex REPEATING DATA
+
+@display
+REPEATING DATA
+ /STARTS=start-end
+ /OCCURS=n_occurs
+ /FILE='filename'
+ /LENGTH=length
+ /CONTINUED[=cont_start-cont_end]
+ /ID=id_start-id_end=id_var
+ /@{TABLE,NOTABLE@}
+ /DATA=var_spec@dots{}
+
+where each var_spec takes one of the forms
+ var_list start-end [type_spec]
+ var_list (fortran_spec)
+@end display
+
+The REPEATING DATA command is used to parse groups of data repeating in
+a uniform format, possibly with several groups on a single line. Each
+group of data corresponds with one case. REPEATING DATA may only be
+used within an INPUT PROGRAM structure. When used with DATA LIST, it
+can be used to parse groups of cases that share a subset of variables
+but differ in their other data.
+
+The STARTS subcommand is required. Specify a range of columns, using
+literal numbers or numeric variable names. This range specifies the
+columns on the first line that are used to contain groups of data. The
+ending column is optional. If it is not specified, then the record
+width of the input file is used. For the inline file (@pxref{BEGIN
+DATA}) this is 80 columns; for a file with fixed record widths it is the
+record width; for other files it is 1024 characters by default.
+
+The OCCURS subcommand is required. It must be a number or the name of a
+numeric variable. Its value is the number of groups present in the
+current record.
+
+The DATA subcommand is required. It must be the last subcommand
+specified. It is used to specify the data present within each repeating
+group. Column numbers are specified relative to the beginning of a
+group at column 1. Data is specified in the same way as with DATA LIST
+FIXED (@pxref{DATA LIST FIXED}).
+
+All other subcommands are optional.
+
+FILE specifies the file to read, either a file name as a string or a
+file handle (@pxref{FILE HANDLE}). If FILE is not present then the
+default is the last file handle used on DATA LIST (lexically, not in
+terms of flow of control).
+
+By default REPEATING DATA will output a table describing how it will
+parse the input data. Specifying NOTABLE will disable this behavior;
+specifying TABLE will explicitly enable it.
+
+The LENGTH subcommand specifies the length in characters of each group.
+If it is not present then length is inferred from the DATA subcommand.
+LENGTH can be a number or a variable name.
+
+Normally all the data groups are expected to be present on a single
+line. Use the CONTINUED command to indicate that data can be continued
+onto additional lines. If data on continuation lines starts at the left
+margin and continues through the entire field width, no column
+specifications are necessary on CONTINUED. Otherwise, specify the
+possible range of columns in the same way as on STARTS.
+
+When data groups are continued from line to line, it's easily possible
+for cases to get out of sync if hand editing is not done carefully. The
+ID subcommand allows a case identifier to be present on each line of
+repeating data groups. REPEATING DATA will check for the same
+identifier on each line and report mismatches. Specify the range of
+columns that the identifier will occupy, followed by an equals sign
+(@samp{=}) and the identifier variable name. The variable must already
+have been declared with NUMERIC or another command.
+
+@node WRITE, , REPEATING DATA, Data Input and Output
+@section WRITE
+@vindex WRITE
+
+@display
+WRITE
+ OUTFILE='filename'
+ RECORDS=n_lines
+ @{NOTABLE,TABLE@}
+ /[line_no] arg@dots{}
+
+arg takes one of the following forms:
+ 'string' [start-end]
+ var_list start-end [type_spec]
+ var_list (fortran_spec)
+ var_list *
+@end display
+
+WRITE is used to write text or binary data to an output file.
+
+@xref{PRINT}, for more information on syntax and usage. The main
+difference between PRINT and WRITE is that whereas by default PRINT uses
+variables' print formats, WRITE uses write formats.
+
+The sole additional difference is that if WRITE is used to send output
+to a binary file, carriage control characters will not be output.
+@xref{FILE HANDLE}, for information on how to declare a file as binary.
+
+@node System and Portable Files, Variable Attributes, Data Input and Output, Top
+@chapter System Files and Portable Files
+
+The commands in this chapter read, write, and examine system files and
+portable files.
+
+@menu
+* APPLY DICTIONARY:: Apply system file dictionary to active file.
+* EXPORT:: Write to a portable file.
+* GET:: Read from a system file.
+* IMPORT:: Read from a portable file.
+* MATCH FILES:: Merge system files.
+* SAVE:: Write to a system file.
+* SYSFILE INFO:: Display system file dictionary.
+* XSAVE:: Write to a system file, as a transform.
+@end menu
+
+@node APPLY DICTIONARY, EXPORT, System and Portable Files, System and Portable Files
+@section APPLY DICTIONARY
+@vindex APPLY DICTIONARY
+
+@display
+APPLY DICTIONARY FROM='filename'.
+@end display
+
+The APPLY DICTIONARY command applies the variable labels, value labels,
+and missing values from variables in a system file to corresponding
+variables in the active file. In some cases it also updates the
+weighting variable.
+
+Specify a system file with a file name string or as a file handle
+(@pxref{FILE HANDLE}). The dictionary in the system file will be read,
+but it will not replace the active file dictionary. The system file's
+data will not be read.
+
+Only variables with names that exist in both the active file and the
+system file are considered. Variables with the same name but different
+types (numeric, string) will cause an error message. Otherwise, the
+system file variables' attributes will replace those in their matching
+active file variables, as described below.
+
+If a system file variable has a variable label, then it will replace the
+active file variable's variable label. If the system file variable does
+not have a variable label, then the active file variable's variable
+label, if any, will be retained.
+
+If the active file variable is numeric or short string, then value
+labels and missing values, if any, will be copied to the active file
+variable. If the system file variable does not have value labels or
+missing values, then those in the active file variable, if any, will not
+be disturbed.
+
+Finally, weighting of the active file is updated (@pxref{WEIGHT}). If
+the active file has a weighting variable, and the system file does not,
+or if the weighting variable in the system file does not exist in the
+active file, then the active file weighting variable, if any, is
+retained. Otherwise, the weighting variable in the system file becomes
+the active file weighting variable.
+
+APPLY DICTIONARY takes effect immediately. It does not read the active
+file. The system file is not modified.
+
+@node EXPORT, GET, APPLY DICTIONARY, System and Portable Files
+@section EXPORT
+@vindex EXPORT
+
+@display
+EXPORT
+ /OUTFILE='filename'
+ /DROP=var_list
+ /KEEP=var_list
+ /RENAME=(src_names=target_names)@dots{}
+@end display
+
+The EXPORT procedure writes the active file dictionary and data to a
+specified portable file.
+
+The OUTFILE subcommand, which is the only required subcommand, specifies
+the portable file to be written as a file name string or a file handle
+(@pxref{FILE HANDLE}).
+
+DROP, KEEP, and RENAME follow the same format as the SAVE procedure
+(@pxref{SAVE}).
+
+EXPORT is a procedure. It causes the active file to be read.
+
+@node GET, IMPORT, EXPORT, System and Portable Files
+@section GET
+@vindex GET
+
+@display
+GET
+ /FILE='filename'
+ /DROP=var_list
+ /KEEP=var_list
+ /RENAME=(src_names=target_names)@dots{}
+@end display
+
+The GET transformation clears the current dictionary and active file and
+replaces them with the dictionary and data from a specified system file.
+
+The FILE subcommand is the only required subcommand. Specify the system
+file to be read as a string file name or a file handle (@pxref{FILE
+HANDLE}).
+
+By default, all the variables in a system file are read. The DROP
+subcommand can be used to specify a list of variables that are not to be
+read. By contrast, the KEEP subcommand can be used to specify variable
+that are to be read, with all other variables not read.
+
+Normally variables in a system file retain the names that they were
+saved under. Use the RENAME subcommand to change these names. Specify,
+within parentheses, a list of variable names followed by an equals sign
+(@samp{=}) and the names that they should be renamed to. Multiple
+parenthesized groups of variable names can be included on a single
+RENAME subcommand. Variables' names may be swapped using a RENAME
+subcommand of the form @samp{/RENAME=(A B=B A)}.
+
+Alternate syntax for the RENAME subcommand allows the parentheses to be
+eliminated. When this is done, only a single variable may be renamed at
+once. For instance, @samp{/RENAME=A=B}. This alternate syntax is
+deprecated.
+
+DROP, KEEP, and RENAME are performed in left-to-right order. They each
+may be present any number of times.
+
+Please note that DROP, KEEP, and RENAME do not cause the system file on
+disk to be modified. Only the active file read from the system file is
+changed.
+
+GET does not cause the data to be read, only the dictionary. The data
+is read later, when a procedure is executed.
+
+@node IMPORT, MATCH FILES, GET, System and Portable Files
+@section IMPORT
+@vindex IMPORT
+
+@display
+IMPORT
+ /FILE='filename'
+ /TYPE=@{COMM,TAPE@}
+ /DROP=var_list
+ /KEEP=var_list
+ /RENAME=(src_names=target_names)@dots{}
+@end display
+
+The IMPORT transformation clears the active file dictionary and data and
+replaces them with a dictionary and data from a portable file on disk.
+
+The FILE subcommand, which is the only required subcommand, specifies
+the portable file to be read as a file name string or a file handle
+(@pxref{FILE HANDLE}).
+
+The TYPE subcommand is currently not used.
+
+DROP, KEEP, and RENAME follow the syntax used by GET (@pxref{GET}).
+
+IMPORT does not cause the data to be read, only the dictionary. The
+data is read later, when a procedure is executed.
+
+@node MATCH FILES, SAVE, IMPORT, System and Portable Files
+@section MATCH FILES
+@vindex MATCH FILES
+
+@display
+MATCH FILES
+ /BY var_list
+ /@{FILE,TABLE@}=@{*,'filename'@}
+ /DROP=var_list
+ /KEEP=var_list
+ /RENAME=(src_names=target_names)@dots{}
+ /IN=var_name
+ /FIRST=var_name
+ /LAST=var_name
+ /MAP
+@end display
+
+The MATCH FILES command merges one or more system files, optionally
+including the active file. Records with the same values for BY
+variables are combined into a single record. Records with different
+values are output in order. Thus, multiple sorted system files are
+combined into a single sorted system file based on the value of the BY
+variables.
+
+The BY subcommand specifies a list of variables that are used to match
+records from each of the system files. Variables specified must exist
+in all the files specified on FILE and TABLE. BY should usually be
+specified. If TABLE is used then BY is required.
+
+Specify FILE with a system file as a file name string or file handle
+(@pxref{FILE HANDLE}). An asterisk (@samp{*}) may also be specified to
+indicate the current active file. The files specified on FILE are
+merged together based on the BY variables, or combined case-by-case if
+BY is not specified. Normally at least two FILE subcommands should be
+specified.
+
+Specify TABLE with a system file in order to use it as a @dfn{table
+lookup file}. Records in table lookup files are not used up after
+they've been used once. This means that data in table lookup files can
+correspond to any number of records in FILE files. Table lookup files
+correspond to lookup tables in traditional relational database systems.
+It is incorrect to have records with duplicate BY values in table lookup
+files.
+
+Any number of FILE and TABLE subcommands may be specified. Each
+instance of FILE or TABLE can be followed by DROP, KEEP, and/or RENAME
+subcommands. These take the same form as the corresponding subcommands
+of GET (@pxref{GET}), and perform the same functions.
+
+Variables belonging to files that are not present for the current case
+are set to the system-missing value for numeric variables or spaces for
+string variables.
+
+IN, FIRST, LAST, and MAP are currently not used.
+
+@node SAVE, SYSFILE INFO, MATCH FILES, System and Portable Files
+@section SAVE
+@vindex SAVE
+
+@display
+SAVE
+ /OUTFILE='filename'
+ /@{COMPRESSED,UNCOMPRESSED@}
+ /DROP=var_list
+ /KEEP=var_list
+ /RENAME=(src_names=target_names)@dots{}
+@end display
+
+The SAVE procedure causes the dictionary and data in the active file to
+be written to a system file.
+
+The FILE subcommand is the only required subcommand. Specify the system
+file to be written as a string file name or a file handle (@pxref{FILE
+HANDLE}).
+
+The COMPRESS and UNCOMPRESS subcommand determine whether the saved
+system file is compressed. By default, system files are compressed.
+This default can be changed with the SET command (@pxref{SET}).
+
+By default, all the variables in the active file dictionary are written
+to the system file. The DROP subcommand can be used to specify a list
+of variables not to be written. In contrast, KEEP specifies variables
+to be written, with all variables not specified not written.
+
+Normally variables are saved to a system file under the same names they
+have in the active file. Use the RENAME command to change these names.
+Specify, within parentheses, a list of variable names followed by an
+equals sign (@samp{=}) and the names that they should be renamed to.
+Multiple parenthesized groups of variable names can be included on a
+single RENAME subcommand. Variables' names may be swapped using a
+RENAME subcommand of the form @samp{/RENAME=(A B=B A)}.
+
+Alternate syntax for the RENAME subcommand allows the parentheses to be
+eliminated. When this is done, only a single variable may be renamed at
+once. For instance, @samp{/RENAME=A=B}. This alternate syntax is
+deprecated.
+
+DROP, KEEP, and RENAME are performed in left-to-right order. They each
+may be present any number of times.
+
+Please note that DROP, KEEP, and RENAME do not cause the active file to
+be modified. Only the system file written to disk is changed.
+
+SAVE causes the data to be read. It is a procedure.
+
+@node SYSFILE INFO, XSAVE, SAVE, System and Portable Files
+@section SYSFILE INFO
+@vindex SYSFILE INFO
+
+@display
+SYSFILE INFO FILE='filename'.
+@end display
+
+The SYSFILE INFO command reads the dictionary in a system file and
+displays the information in its dictionary.
+
+Specify a file name or file handle. SYSFILE INFO will read that file as
+a system file and display information on its dictionary.
+
+The file does not replace the current active file.
+
+@node XSAVE, , SYSFILE INFO, System and Portable Files
+@section XSAVE
+@vindex XSAVE
+
+@display
+XSAVE
+ /FILE='filename'
+ /@{COMPRESSED,UNCOMPRESSED@}
+ /DROP=var_list
+ /KEEP=var_list
+ /RENAME=(src_names=target_names)@dots{}
+@end display
+
+The XSAVE transformation writes the active file dictionary and data to a
+system file stored on disk.
+
+XSAVE is a transformation, not a procedure. It is executed when the
+data is read by a procedure or procedure-like command. In all other
+respects, XSAVE is identical to SAVE. @xref{SAVE}, for more information
+on syntax and usage.
+
+@node Variable Attributes, Data Manipulation, System and Portable Files, Top
+@chapter Manipulating variables
+
+The variables in the active file dictionary are important. There are
+several utility functions for examining and adjusting them.
+
+@menu
+* ADD VALUE LABELS:: Add value labels to variables.
+* DISPLAY:: Display variable names & descriptions.
+* DISPLAY VECTORS:: Display a list of vectors.
+* FORMATS:: Set print and write formats.
+* LEAVE:: Don't clear variables between cases.
+* MISSING VALUES:: Set missing values for variables.
+* MODIFY VARS:: Rename, reorder, and drop variables.
+* NUMERIC:: Create new numeric variables.
+* PRINT FORMATS:: Set variable print formats.
+* RENAME VARIABLES:: Rename variables.
+* VALUE LABELS:: Set value labels for variables.
+* STRING:: Create new string variables.
+* VARIABLE LABELS:: Set variable labels for variables.
+* VECTOR:: Declare an array of variables.
+* WRITE FORMATS:: Set variable write formats.
+@end menu
+
+@node ADD VALUE LABELS, DISPLAY, Variable Attributes, Variable Attributes
+@section ADD VALUE LABELS
+@vindex ADD VALUE LABELS
+
+@display
+ADD VALUE LABELS
+ /var_list value 'label' [value 'label']@dots{}
+@end display
+
+ADD VALUE LABELS has the same syntax and purpose as VALUE LABELS (see
+above), but it does not clear away value labels from the variables
+before adding the ones specified.
+
+@node DISPLAY, DISPLAY VECTORS, ADD VALUE LABELS, Variable Attributes
+@section DISPLAY
+@vindex DISPLAY
+
+@display
+DISPLAY @{NAMES,INDEX,LABELS,VARIABLES,DICTIONARY,SCRATCH@}
+ [SORTED] [var_list]
+@end display
+
+DISPLAY displays requested information on variables. Variables can
+optionally be sorted alphabetically. The entire dictionary or just
+specified variables can be described.
+
+One of the following keywords can be present:
+
+@table @asis
+@item NAMES
+The variables' names are displayed.
+
+@item INDEX
+The variables' names are displayed along with a value describing their
+position within the active file dictionary.
+
+@item LABELS
+Variable names, positions, and variable labels are displayed.
+
+@item VARIABLES
+Variable names, positions, print and write formats, and missing values
+are displayed.
+
+@item DICTIONARY
+Variable names, positions, print and write formats, missing values,
+variable labels, and value labels are displayed.
+
+@item SCRATCH
+Varible names are displayed, for scratch variables only (@pxref{Scratch
+Variables}).
+@end table
+
+If SORTED is specified, then the variables are displayed in ascending
+order based on their names; otherwise, they are displayed in the order
+that they occur in the active file dictionary.
+
+@node DISPLAY VECTORS, FORMATS, DISPLAY, Variable Attributes
+@section DISPLAY VECTORS
+@vindex DISPLAY VECTORS
+
+@display
+DISPLAY VECTORS.
+@end display
+
+The DISPLAY VECTORS command causes a list of the currently declared
+vectors to be displayed.
+
+@node FORMATS, LEAVE, DISPLAY VECTORS, Variable Attributes
+@section FORMATS
+@vindex FORMATS
+
+@display
+FORMATS var_list (fmt_spec).
+@end display
+
+The FORMATS command set the print and write formats for the specified
+variables to the specified format specification. @xref{Input/Output
+Formats}.
+
+Specify a list of variables followed by a format specification in
+parentheses. The print and write formats of the specified variables
+will be changed.
+
+Additional lists of variables and formats may be included if they are
+delimited by a slash (@samp{/}).
+
+The FORMATS command takes effect immediately. It is not affected by
+conditional and looping structures such as DO IF or LOOP.
+
+@node LEAVE, MISSING VALUES, FORMATS, Variable Attributes
+@section LEAVE
+@vindex LEAVE
+
+@display
+LEAVE var_list.
+@end display
+
+The LEAVE command prevents the specified variables from being
+reinitialized whenever a new case is processed.
+
+Normally, when a data file is processed, every variable in the active
+file is initialized to the system-missing value or spaces at the
+beginning of processing for each case. When a variable has been
+specified on LEAVE, this is not the case. Instead, that variable is
+initialized to 0 (not system-missing) or spaces for the first case.
+After that, it retains its value between cases.
+
+This becomes useful for counters. For instance, in the example below
+the variable SUM maintains a running total of the values in the ITEM
+variable.
+
+@example
+DATA LIST /ITEM 1-3.
+COMPUTE SUM=SUM+ITEM.
+PRINT /ITEM SUM.
+LEAVE SUM
+BEGIN DATA.
+123
+404
+555
+999
+END DATA.
+@end example
+
+@noindent Partial output from this example:
+
+@example
+123 123.00
+404 527.00
+555 1082.00
+999 2081.00
+@end example
+
+It is best to use the LEAVE command immediately before invoking a
+procedure command, because it is reset by certain transformations---for
+instance, COMPUTE and IF. LEAVE is also reset by all procedure
+invocations.
+
+@node MISSING VALUES, MODIFY VARS, LEAVE, Variable Attributes
+@section MISSING VALUES
+@vindex MISSING VALUES
+
+@display
+MISSING VALUES var_list (missing_values).
+
+missing_values takes one of the following forms:
+ num1
+ num1, num2
+ num1, num2, num3
+ num1 THRU num2
+ num1 THRU num2, num3
+ string1
+ string1, string2
+ string1, string2, string3
+As part of a range, LO or LOWEST may take the place of num1;
+HI or HIGHEST may take the place of num2.
+@end display
+
+The MISSING VALUES command sets user-missing values for numeric and
+short string variables. Long string variables may not have missing
+values.
+
+Specify a list of variables, followed by a list of their user-missing
+values in parentheses. Up to three discrete values may be given, or,
+for numeric variables only, a range of values optionally accompanied by
+a single discrete value. Ranges may be open-ended on one end, indicated
+through the use of the keyword LO or LOWEST or HI or HIGHEST.
+
+The MISSING VALUES command takes effect immediately. It is not affected
+by conditional and looping constructs such as DO IF or LOOP.
+
+@node MODIFY VARS, NUMERIC, MISSING VALUES, Variable Attributes
+@section MODIFY VARS
+@vindex MODIFY VARS
+
+@display
+MODIFY VARS
+ /REORDER=@{FORWARD,BACKWARD@} @{POSITIONAL,ALPHA@} (var_list)@dots{}
+ /RENAME=(old_names=new_names)@dots{}
+ /@{DROP,KEEP@}=var_list
+ /MAP
+@end display
+
+The MODIFY VARS commands allows variables in the active file to be
+reordered, renamed, or deleted from the active file.
+
+At least one subcommand must be specified, and no subcommand may be
+specified more than once. DROP and KEEP may not both be specified.
+
+The REORDER subcommand changes the order of variables in the active
+file. Specify one or more lists of variable names in parentheses. By
+default, each list of variables is rearranged into the specified order.
+To put the variables into the reverse of the specified order, put
+keyword BACKWARD before the parentheses. To put them into alphabetical
+order in the dictionary, specify keyword ALPHA before the parentheses.
+BACKWARD and ALPHA may also be combined.
+
+To rename variables in the active file, specify RENAME, an equals sign
+(@samp{=}), and lists of the old variable names and new variable names
+separated by another equals sign within parentheses. There must be the
+same number of old and new variable names. Each old variable is renamed to
+the corresponding new variable name. Multiple parenthesized groups of
+variables may be specified.
+
+The DROP subcommand deletes a specified list of variables from the
+active file.
+
+The KEEP subcommand keeps the specified list of variables in the active
+file. Any unlisted variables are delete from the active file.
+
+MAP is currently ignored.
+
+MODIFY VARS takes effect immediately. It does not cause the data to be
+read.
+
+@node NUMERIC, PRINT FORMATS, MODIFY VARS, Variable Attributes
+@section NUMERIC
+@vindex NUMERIC
+
+@display
+NUMERIC /var_list [(fmt_spec)].
+@end display
+
+The NUMERIC command explicitly declares new numeric variables,
+optionally setting their output formats.
+
+Specify a slash (@samp{/}), followed by the names of the new numeric
+variables. If you wish to set their output formats, follow their names
+by an output format specification in parentheses (@pxref{Input/Output
+Formats}). If no output format specification is given then the
+variables will default to F8.2.
+
+Variables created with NUMERIC will be initialized to the system-missing
+value.
+
+@node PRINT FORMATS, RENAME VARIABLES, NUMERIC, Variable Attributes
+@section PRINT FORMATS
+@vindex PRINT FORMATS
+
+@display
+PRINT FORMATS var_list (fmt_spec).
+@end display
+
+The PRINT FORMATS command sets the print formats for the specified
+variables to the specified format specification.
+
+Syntax is identical to that of FORMATS (@pxref{FORMATS}), but the PRINT
+FORMATS command sets only print formats, not write formats.
+
+@node RENAME VARIABLES, VALUE LABELS, PRINT FORMATS, Variable Attributes
+@section RENAME VARIABLES
+@vindex RENAME VARIABLES
+
+@display
+RENAME VARIABLES (old_names=new_names)@dots{} .
+@end display
+
+The RENAME VARIABLES command allows the names of variables in the active
+file to be changed.
+
+To rename variables, specify lists of the old variable names and new
+variable names, separated by an equals sign (@samp{=}), within
+parentheses. There must be the same number of old and new variable
+names. Each old variable is renamed to the corresponding new variable
+name. Multiple parenthesized groups of variables may be specified.
+
+RENAME VARIABLES takes effect immediately. It does not cause the data
+to be read.
+
+@node VALUE LABELS, STRING, RENAME VARIABLES, Variable Attributes
+@section VALUE LABELS
+@vindex VALUE LABELS
+
+@display
+VALUE LABELS
+ /var_list value 'label' [value 'label']@dots{}
+@end display
+
+The VALUE LABELS command allows values of numeric and short string
+variables to be associated with labels. In this way, a short value can
+stand for a long value.
+
+In order to set up value labels for a set of variables, specify the
+variable names after a slash (@samp{/}), followed by a list of values
+and their associated labels, separated by spaces.
+
+Before the VALUE LABELS command is executed, any existing value labels
+are cleared from the variables specified.
+
+@node STRING, VARIABLE LABELS, VALUE LABELS, Variable Attributes
+@section STRING
+@vindex STRING
+
+@display
+STRING /var_list (fmt_spec).
+@end display
+
+The STRING command creates new string variables for use in
+transformations.
+
+Specify a slash (@samp{/}), followed by the names of the string
+variables to create and the desired output format specification in
+parentheses (@pxref{Input/Output Formats}). Variable widths are
+implicitly derived from the specified output formats.
+
+Created variables are initialized to spaces.
+
+@node VARIABLE LABELS, VECTOR, STRING, Variable Attributes
+@section VARIABLE LABELS
+@vindex VARIABLE LABELS
+
+@display
+VARIABLE LABELS
+ /var_list 'var_label'.
+@end display
+
+The VARIABLE LABELS command is used to associate an explanatory name
+with a group of variables. This name (a variable label) is displayed by
+statistical procedures.
+
+To assign a variable label to a group of variables, specify a slash
+(@samp{/}), followed by the list of variable names and the variable
+label as a string.
+
+@node VECTOR, WRITE FORMATS, VARIABLE LABELS, Variable Attributes
+@section VECTOR
+@vindex VECTOR
+
+@display
+Two possible syntaxes:
+ VECTOR vec_name=var_list.
+ VECTOR vec_name_list(count).
+@end display
+
+The VECTOR command allows a group of variables to be accessed as if they
+were consecutive members of an array with a vector(index) notation.
+
+To make a vector out of a set of existing variables, specify a name for
+the vector followed by an equals sign (@samp{=}) and the variables that
+belong in the vector.
+
+To make a vector and create variables at the same time, specify one or
+more vector names followed by a count in parentheses. This will cause
+variables named @code{@var{vec}1} through @code{@var{vec}@var{count}} to
+be created as numeric variables. Variable names including numeric
+suffixes may not exceed 8 characters in length, and none of the
+variables may exist prior to the VECTOR command.
+
+All the variables in a vector must be the same type.
+
+Vectors created with VECTOR disappear after any procedure or
+procedure-like command is executed. The variables contained in the
+vectors remain, unless they are scratch variables (@pxref{Scratch
+Variables}).
+
+Variables within a vector may be references in expressions using
+vector(index) syntax.
+
+@node WRITE FORMATS, , VECTOR, Variable Attributes
+@section WRITE FORMATS
+@vindex WRITE FORMATS
+
+@display
+WRITE FORMATS var_list (fmt_spec).
+@end display
+
+The WRITE FORMATS command sets the write formats for the specified
+variables to the specified format specification.
+
+Syntax is identical to that of FORMATS (@pxref{FORMATS}), but the WRITE
+FORMATS command sets only write formats, not print formats.
+
+@node Data Manipulation, Data Selection, Variable Attributes, Top
+@chapter Data transformations
+
+The PSPP procedures examined in this chapter manipulate data and
+prepare the active file for later analyses. They do not produce output,
+as a rule.
+
+@menu
+* AGGREGATE:: Summarize multiple cases into a single case.
+* AUTORECODE:: Automatic recoding of variables.
+* COMPUTE:: Assigning a variable a calculated value.
+* COUNT:: Counting variables with particular values.
+* FLIP:: Exchange variables with cases.
+* IF:: Conditionally assigning a calculated value.
+* RECODE:: Mapping values from one set to another.
+* SORT CASES:: Sort the active file.
+@end menu
+
+@node AGGREGATE, AUTORECODE, Data Manipulation, Data Manipulation
+@section AGGREGATE
+@vindex AGGREGATE
+
+@display
+AGGREGATE
+ /BREAK=var_list
+ /PRESORTED
+ /OUTFILE=@{*,'filename'@}
+ /DOCUMENT
+ /MISSING=COLUMNWISE
+ /dest_vars=agr_func(src_vars, args@dots{})@dots{}
+@end display
+
+The AGGREGATE command summarizes groups of cases into single cases.
+Cases are divided into groups that have the same values for one or more
+variables called @dfn{break variables}. Several functions are available
+for summarizing case contents.
+
+BREAK is the only required subcommand (in addition, at least one
+aggregation variable must be specified). Specify a list of variable
+names. The values of these variables are used to divide the active file
+into groups to be summarized.
+
+By default, the active file is sorted based on the break variables
+before aggregation takes place. If the active file is already sorted,
+specify PRESORTED to save time.
+
+The OUTFILE subcommand specifies a system file by file name string or
+file handle (@pxref{FILE HANDLE}). The aggregated cases are sent to
+this file. If OUTFILE is not specified, or if @samp{*} is specified,
+then the aggregated cases replace the active file.
+
+Normally the aggregate file does not receive the documents from the
+active file, even if the aggregate file replaces the active file.
+Specify DOCUMENT to have the documents from the active file copied to
+the aggregate file.
+
+At least one aggregation variable must be specified. Specify a list of
+aggregation variables, an equals sign (@samp{=}), an aggregation
+function name (see the list below), and a list of source variables in
+parentheses. In addition, some aggregation functions expect additional
+arguments in the parentheses following the source variable names.
+
+There must be exactly as many source variables as aggregation variables.
+Each aggregation variable receives the results of applying the specified
+aggregation function to the corresponding source variable. Most
+aggregation functions may be applied to numeric and short and long
+string variables. Others are restricted to numeric values; these are
+marked as such in this list below.
+
+Any number of sets of aggregation variables may be specified.
+
+The available aggregation functions are as follows:
+
+@table @asis
+@item SUM(var_name)
+Sum. Limited to numeric values.
+@item MEAN(var_name)
+Arithmetic mean. Limited to numeric values.
+@item SD(var_name)
+Standard deviation of the mean. Limited to numeric values.
+@item MAX(var_name)
+Maximum value.
+@item MIN(var_name)
+Minimum value.
+@item FGT(var_name, value)
+@itemx PGT(var_name, value)
+Fraction between 0 and 1, or percentage between 0 and 100, respectively,
+of values greater than the specified constant.
+@item FLT(var_name, value)
+@itemx PLT(var_name, value)
+Fraction or percentage, respectively, of values less than the specified
+constant.
+@item FIN(var_name, low, high)
+@itemx PIN(var_name, low, high)
+Fraction or percentage, respectively, of values within the specified
+inclusive range of constants.
+@item FOUT(var_name, low, high)
+@itemx POUT(var_name, low, high)
+Fraction or percentage, respectively, of values strictly outside the
+specified range of constants.
+@item N(var_name)
+Number of non-missing values.
+@item N
+Number of cases aggregated to form this group. Don't supply a source
+variable for this aggregation function.
+@item NU(var_name)
+Number of non-missing values. Each case is considered to have a weight
+of 1, regardless of the current weighting variable (@pxref{WEIGHT}).
+@item NU
+Number of cases aggregated to form this group. Each case is considered
+to have a weight of 1, regardless of the current weighting variable.
+@item NMISS(var_name)
+Number of missing values.
+@item NUMISS(var_name)
+Number of missing values. Each case is considered to have a weight of
+1, regardless of the current weighting variable.
+@item FIRST(var_name)
+First value in this group.
+@item LAST(var_name)
+Last value in this group.
+@end table
+
+When string values are compared by aggregation functions, they are done
+in terms of internal character codes. On most modern computers, this is
+a form of ASCII.
+
+In addition, there is a parallel set of aggregation functions having the
+same names as those above, but with a dot after the last character (for
+instance, @samp{SUM.}). These functions are the same as the above,
+except that they cause user-missing values, which are normally excluded
+from calculations, to be included.
+
+Normally, only a single case (2 for SD and SD.) need be non-missing in
+each group in order for the aggregate variable to be non-missing. If
+/MISSING=COLUMNWISE is specified, the behavior reverses: that is, a
+single missing value is enough to make the aggregate variable become a
+missing value.
+
+AGGREGATE ignores the current SPLIT FILE settings and causes them to be
+canceled (@pxref{SPLIT FILE}).
+
+@node AUTORECODE, COMPUTE, AGGREGATE, Data Manipulation
+@section AUTORECODE
+@vindex AUTORECODE
+
+@display
+AUTORECODE VARIABLES=src_vars INTO dest_vars
+ /DESCENDING
+ /PRINT
+@end display
+
+The AUTORECODE procedure considers the @var{n} values that a variable
+takes on and maps them onto values 1@dots{}@var{n} on a new numeric
+variable.
+
+Subcommand VARIABLES is the only required subcommand and must come
+first. Specify VARIABLES, an equals sign (@samp{=}), a list of source
+variables, INTO, and a list of target variables. There must the same
+number of source and target variables. The target variables must not
+already exist.
+
+By default, increasing values of a source variable (for a string, this
+is based on character code comparisons) are recoded to increasing values
+of its target variable. To cause increasing values of a source variable
+to be recoded to decreasing values of its target variable (@var{n} down
+to 1), specify DESCENDING.
+
+PRINT is currently ignored.
+
+AUTORECODE is a procedure. It causes the data to be read.
+
+@node COMPUTE, COUNT, AUTORECODE, Data Manipulation
+@section COMPUTE
+
+@display
+COMPUTE var_name = expression.
+@end display
+
+@code{COMPUTE} creates a variable with the name specified (if
+necessary), then evaluates the given expression for every case and
+assigns the result to the variable. @xref{Expressions}.
+
+Numeric variables created or computed by @code{COMPUTE} are assigned an
+output width of 8 character with two decimal places (@code{F8.2}).
+String variables created or computed by @code{COMPUTE} have the same
+width as the existing variable or constant.
+
+COMPUTE is a transformation. It does not cause the active file to be
+read.
+
+@node COUNT, FLIP, COMPUTE, Data Manipulation
+@section COUNT
+
+@display
+COUNT var_name = var@dots{} (value@dots{}).
+
+Each value takes one of the following forms:
+ number
+ string
+ num1 THRU num2
+ MISSING
+ SYSMIS
+In addition, num1 and num2 can be LO or LOWEST, or HI or HIGHEST,
+respectively.
+@end display
+
+@code{COUNT} creates or replaces a numeric @dfn{target} variable that
+counts the occurrence of a @dfn{criterion} value or set of values over
+one or more @dfn{test} variables for each case.
+
+The target variable values are always nonnegative integers. They are
+never missing. The target variable is assigned an F8.2 output format.
+@xref{Input/Output Formats}. Any variables, including long and short
+string variables, may be test variables.
+
+User-missing values of test variables are treated just like any other
+values. They are @strong{not} treated as system-missing values.
+User-missing values that are criterion values or inside ranges of
+criterion values are counted as any other values. However (for numeric
+variables), keyword @code{MISSING} may be used to refer to all system-
+and user-missing values.
+
+
+@code{COUNT} target variables are assigned values in the order
+specified. In the command @code{COUNT A=A B(1) /B=A B(2).}, the
+following actions occur:
+
+@itemize @minus
+@item
+The number of occurrences of 1 between @code{A} and @code{B} is counted.
+
+@item
+@code{A} is assigned this value.
+
+@item
+The number of occurrences of 1 between @code{B} and the @strong{new}
+value of @code{A} is counted.
+
+@item
+@code{B} is assigned this value.
+@end itemize
+
+Despite this ordering, all @code{COUNT} criterion variables must exist
+before the procedure is executed---they may not be created as target
+variables earlier in the command! Break such a command into two
+separate commands.
+
+The examples below may help to clarify.
+
+@enumerate A
+@item
+Assuming @code{Q0}, @code{Q2}, @dots{}, @code{Q9} are numeric variables,
+the following commands:
+
+@enumerate
+@item
+Count the number of times the value 1 occurs through these variables
+for each case and assigns the count to variable @code{QCOUNT}.
+
+@item
+Print out the total number of times the value 1 occurs throughout
+@emph{all} cases using @code{DESCRIPTIVES}. @xref{DESCRIPTIVES}, for
+details.
+@end enumerate
+
+@example
+COUNT QCOUNT=Q0 TO Q9(1).
+DESCRIPTIVES QCOUNT /STATISTICS=SUM.
+@end example
+
+@item
+Given these same variables, the following commands:
+
+@enumerate
+@item
+Count the number of valid values of these variables for each case and
+assigns the count to variable @code{QVALID}.
+
+@item
+Multiplies each value of @code{QVALID} by 10 to obtain a percentage of
+valid values, using @code{COMPUTE}. @xref{COMPUTE}, for details.
+
+@item
+Print out the percentage of valid values across all cases, using
+@code{DESCRIPTIVES}. @xref{DESCRIPTIVES}, for details.
+@end enumerate
+
+@example
+COUNT QVALID=Q0 TO Q9 (LO THRU HI).
+COMPUTE QVALID=QVALID*10.
+DESCRIPTIVES QVALID /STATISTICS=MEAN.
+@end example
+@end enumerate
+
+@node FLIP, IF, COUNT, Data Manipulation
+@section FLIP
+@vindex FLIP
+
+@display
+FLIP /VARIABLES=var_list /NEWNAMES=var_name.
+@end display
+
+The FLIP command transposes rows and columns in the active file. It
+causes cases to be swapped with variables, and vice versa.
+
+There are no required subcommands. The VARIABLES subcommand specifies
+variables that will be transformed into cases. Variables not specified
+are discarded. By default, all variables are selected for
+transposition.
+
+The variables specified by NEWNAMES, which must be a string variable, is
+used to give names to the variables created by FLIP. If NEWNAMES is not
+specified then the default is a variable named CASE_LBL, if it exists.
+If it does not then the variables created by FLIP are named VAR000
+through VAR999, then VAR1000, VAR1001, and so on.
+
+When a NEWNAMES variable is available, the names must be canonicalized
+before becoming variable names. Invalid characters are replaced by
+letter @samp{V} in the first position, or by @samp{_} in subsequent
+positions. If the name thus generated is not unique, then numeric
+extensions are added, starting with 1, until a unique name is found or
+there are no remaining possibilities. If the latter occurs then the
+FLIP operation aborts.
+
+The resultant dictionary contains a CASE_LBL variable, which stores the
+names of the variables in the dictionary before the transposition. If
+the active file is subsequently transposed using FLIP, this variable can
+be used to recreate the original variable names.
+
+@node IF, RECODE, FLIP, Data Manipulation
+@section IF
+
+@display
+Two possible syntaxes:
+ IF test_expr target_var=target_expr.
+ IF test_expr target_vec(target_index)=target_expr.
+@end display
+
+The IF transformation conditionally assigns the value of a target
+expression to a target variable, based on the truth of a test
+expression.
+
+Specify a boolean-valued expression (@pxref{Expressions}) to be tested
+following the IF keyword. This expression is calculated for each case.
+If the value is true, then the value of target_expr is computed and
+assigned to target_var. If the value is false or missing, nothing is
+done. Numeric and short and long string variables may be used. The
+type of target_expr must match the type of target_var.
+
+For numeric variables only, target_var need not exist before the IF
+transformation is executed. In this case, target_var is assigned the
+system-missing value if the IF condition is not true. String variables
+must be declared before they can be used as targets for IF.
+
+In addition to ordinary variables, the target variable may be an element
+of a vector. In this case, the vector index must be specified in
+parentheses following the vector name.
+
+@node RECODE, SORT CASES, IF, Data Manipulation
+@section RECODE
+
+@display
+RECODE var_list (src_value@dots{}=dest_value)@dots{} [INTO var_list].
+
+src_value may take the following forms:
+ number
+ string
+ num1 THRU num2
+ MISSING
+ SYSMIS
+ ELSE
+Open-ended ranges may be specified using LO or LOWEST for num1
+or HI or HIGHEST for num2.
+
+dest_value may take the following forms:
+ num
+ string
+ SYSMIS
+ COPY
+@end display
+
+The RECODE command is used to translate data from one range of values to
+another, using flexible user-specified mappings. Data may be remapped
+in-place or copied to new variables. Numeric, short string, and long
+string data can be recoded.
+
+Specify the list of source variables, followed by one or more mapping
+specifications each enclosed in parentheses. If the data is to be
+copied to new variables, specify INTO, then the list of target
+variables. String target variables must already have been declared
+using STRING or another transformation, but numeric target variables can
+be created on the fly. There must be exactly as many target variables
+as source variables. Each source variable is remapped into its
+corresponding target variable.
+
+When INTO is not used, the input and output variables must be of the
+same type. Otherwise, string values can be recoded into numeric values,
+and vice versa. When this is done and there is no mapping for a
+particular value, either a value consisting of all spaces or the
+system-missing value is assigned, depending on variable type.
+
+Mappings are considered from left to right. The first src_value that
+matches the value of the source variable causes the target variable to
+receive the value indicated by the dest_value. Literal number, string,
+and range src_value's should be self-explanatory. MISSING as a
+src_value matches any user- or system-missing value. SYSMIS matches the
+system missing value only. ELSE is a catch-all that matches anything.
+It should be the last src_value specified.
+
+Numeric and string dest_value's should also be self-explanatory. COPY
+causes the input values to be copied to the output. This is only value
+if the source and target variables are of the same type. SYSMIS
+indicates the system-missing value.
+
+If the source variables are strings and the target variables are
+numeric, then there is one additional mapping available: (CONVERT),
+which must be the last specified mapping. CONVERT causes a number
+specified as a string to be converted to a numeric value. If the string
+cannot be parsed as a number, then the system-missing value is assigned.
+
+Multiple recodings can be specified on the same RECODE command.
+Introduce additional recodings with a slash (@samp{/}) in order to
+separate them from the previous recodings.
+
+@node SORT CASES, , RECODE, Data Manipulation
+@section SORT CASES
+@vindex SORT CASES
+
+@display
+SORT CASES BY var_list.
+@end display
+
+SORT CASES sorts the active file by the values of one or more
+variables.
+
+Specify BY and a list of variables to sort by. By default, variables
+are sorted in ascending order. To override sort order, specify (D) or
+(DOWN) after a list of variables to get descending order, or (A) or (UP)
+for ascending order. These apply to the entire list of variables
+preceding them.
+
+SORT CASES is a procedure. It causes the data to be read.
+
+SORT CASES will attempt to sort the entire active file in main memory.
+If main memory is exhausted then it will use a merge sort algorithm that
+involves writing and reading numerous temporary files. Environment
+variables determine the temporary files' location. The first of
+SPSSTMPDIR, SPSSXTMPDIR, or TMPDIR that is set determines the location.
+Otherwise, if the compiler environment defined P_tmpdir, that is used.
+Otherwise, under Unix-like OSes /tmp is used; under MS-DOS, the first of
+TEMP, TMP, or root on the current drive is used; under other OSes, the
+current directory.
+
+@node Data Selection, Conditionals and Looping, Data Manipulation, Top
+@chapter Selecting data for analysis
+
+This chapter documents PSPP commands that temporarily or permanently
+select data records from the active file for analysis.
+
+@menu
+* FILTER:: Exclude cases based on a variable.
+* N OF CASES:: Limit the size of the active file.
+* PROCESS IF:: Temporarily excluding cases.
+* SAMPLE:: Select a specified proportion of cases.
+* SELECT IF:: Permanently delete selected cases.
+* SPLIT FILE:: Do multiple analyses with one command.
+* TEMPORARY:: Make transformations' effects temporary.
+* WEIGHT:: Weight cases by a variable.
+@end menu
+
+@node FILTER, N OF CASES, Data Selection, Data Selection
+@section FILTER
+@vindex FILTER
+
+@display
+FILTER BY var_name.
+FILTER OFF.
+@end display
+
+The FILTER command allows a boolean-valued variable to be used to select
+cases from the data stream for processing.
+
+In order to set up filtering, specify BY and a variable name. Keyword
+BY is optional but recommended. Cases which have a zero or system- or
+user-missing value are excluded from analysis, but not deleted from the
+data stream. Cases with other values are analyzed.
+
+Use FILTER OFF to turn off case filtering.
+
+Filtering takes place immediately before cases pass to a procedure for
+analysis. Only one filter variable may be active at once. Normally,
+case filtering continues until it is explicitly turned off with FILTER
+OFF. However, if FILTER is placed after TEMPORARY, then filtering stops
+after execution of the next procedure or procedure-like command.
+
+@node N OF CASES, PROCESS IF, FILTER, Data Selection
+@section N OF CASES
+@vindex N OF CASES
+
+@display
+N [OF CASES] num_of_cases [ESTIMATED].
+@end display
+
+Sometimes you may want to disregard cases of your input. The @code{N}
+command can be used to do this. @code{N 100} tells PSPP to
+disregard all cases after the first 100.
+
+If the value specified for @code{N} is greater than the number of cases
+read in, the value is ignored.
+
+@code{N} does not discard cases or cause them not to be read in. It
+just causes cases beyond the last one specified to be ignored by data
+analysis commands.
+
+A later @code{N} command can increase or decrease the number of cases
+selected. (To select all the cases without knowing how many there are,
+specify a very high number: 100000 or whatever you think is large enough.)
+
+Transformation procedures performed after @code{N} is executed
+@emph{do} cause cases to be discarded.
+
+The @code{SAMPLE}, @code{PROCESS IF}, and @code{SELECT IF} commands have
+precedence over @code{N}---the same results are obtained by both of the
+following fragments, given the same random number seeds:
+
+@example
+@i{@dots{}set up, read in data@dots{}}
+N 100.
+SAMPLE .5.
+@i{@dots{}analyze data@dots{}}
+
+@i{@dots{}set up, read in data@dots{}}
+SAMPLE .5.
+N 100.
+@i{@dots{}analyze data@dots{}}
+@end example
+
+Both fragments above first randomly sample approximately half of the
+cases, then select the first 100 of those sampled.
+
+@code{N} with the @code{ESTIMATED} keyword can be used to give an
+estimated number of cases before DATA LIST or another command to
+read in data. (@code{ESTIMATED} never limits the number of cases
+processed by procedures.)
+
+@node PROCESS IF, SAMPLE, N OF CASES, Data Selection
+@section PROCESS IF
+@vindex PROCESS IF
+
+@example
+PROCESS IF expression.
+@end example
+
+The PROCESS IF command is used to temporarily eliminate cases from the
+data stream. Its effects are active only through the execution of the
+next procedure or procedure-like command.
+
+Specify a boolean expression (@pxref{Expressions}). If the value of the
+expression is true for a particular case, the case will be analyzed. If
+the expression has a false or missing value, then the case will be
+deleted from the data stream for this procedure only.
+
+Regardless of its placement relative to other commands, PROCESS IF
+always takes effect immediately before data passes to the procedure.
+Only one PROCESS IF command may be in effect at any given time.
+
+The effects of PROCESS IF are similar not identical to the effects of
+executing TEMPORARY then SELECT IF (@pxref{SELECT IF}).
+
+Use of PROCESS IF is deprecated. It is included for compatibility with
+old command files. New syntax files should use SELECT IF or FILTER
+instead.
+
+@node SAMPLE, SELECT IF, PROCESS IF, Data Selection
+@section SAMPLE
+@vindex SAMPLE
+
+@display
+SAMPLE num1 [FROM num2].
+@end display
+
+@code{SAMPLE} is used to randomly sample a proportion of the cases in
+the active file. @code{SAMPLE} is temporary, affecting only the next
+procedure, unless that is a data transformation, such as @code{SELECT IF}
+or @code{RECODE}.
+
+The proportion to sample can be expressed as a single number between 0
+and 1. If @code{k} is the number specified, and @code{N} is the number
+of currently-selected cases in the active file, then after
+@code{SAMPLE @var{k}.}, there will be @code{k*N}, plus or minus one, cases
+selected.
+
+The proportion to sample can also be specified in the style @code{SAMPLE
+@var{m} FROM @var{N}}. With this style, cases are selected as follows:
+
+@enumerate
+@item
+If @var{N} is equal to the number of currently-selected cases in the
+active file, exactly @var{m} cases will be selected.
+
+@item
+If @var{N} is greater than the number of currently-selected cases in the
+active file, an equivalent proportion of cases will be selected.
+
+@item
+If @var{N} is less than the number of currently-selected cases in the
+active, exactly @var{m} cases will be selected @emph{from the first
+@var{N} cases in the active file.}
+@end enumerate
+
+@code{SAMPLE}, @code{SELECT IF}, and @code{PROCESS IF} are performed in
+the order specified by the syntax file.
+
+@code{SAMPLE} is ignored before @code{SORT CASES}.
+
+@code{SAMPLE} is always performed before @code{N OF CASES}, regardless
+of ordering in the syntax file. @xref{N OF CASES}.
+
+The same values for @code{SAMPLE} may result in different samples. To
+obtain the same sample, use the @code{SET} command to set the random
+number seed to the same value before each @code{SAMPLE}. By default,
+the random number seed is based on the system time.
+
+@node SELECT IF, SPLIT FILE, SAMPLE, Data Selection
+@section SELECT IF
+@vindex SELECT IF
+
+@display
+SELECT IF expression.
+@end display
+
+The SELECT IF command is used to select particular cases for analysis
+based on the value of a boolean expression. Cases not selected are
+permanently eliminated, unless TEMPORARY is in effect
+(@pxref{TEMPORARY}).
+
+Specify a boolean expression (@pxref{Expressions}). If the value of the
+expression is true for a particular case, the case will be analyzed. If
+the expression has a false or missing value, then the case will be
+deleted from the data stream.
+
+Always place SELECT IF commands as early in the command file as
+possible. Cases that are deleted early can be processed more
+efficiently in time and space.
+
+@node SPLIT FILE, TEMPORARY, SELECT IF, Data Selection
+@section SPLIT FILE
+@vindex SPLIT FILE
+
+@display
+Two possible syntaxes:
+ SPLIT FILE BY var_list.
+ SPLIT FILE OFF.
+@end display
+
+The SPLIT FILE command allows multiple sets of data present in one data
+file to be analyzed separately using single statistical procedure
+commands.
+
+Specify a list of variable names in order to analyze multiple sets of
+data separately. Groups of cases having the same values for these
+variables are analyzed by statistical procedure commands as one group.
+An independent analysis is carried out for each group of cases, and the
+variable values for the group are printed along with the analysis.
+
+Specify OFF in order to disable SPLIT FILE and resume analysis of the
+entire active file as a single group of data.
+
+@node TEMPORARY, WEIGHT, SPLIT FILE, Data Selection
+@section TEMPORARY
+@vindex TEMPORARY
+
+@display
+TEMPORARY.
+@end display
+
+The TEMPORARY command is used to make the effects of transformations
+following its execution temporary. These transformations will
+affect only the execution of the next procedure or procedure-like
+command. Their effects will not be saved to the active file.
+
+The only specification is the command name.
+
+TEMPORARY may not appear within a DO IF or LOOP construct. It may
+appear only once between procedures and procedure-like commands.
+
+An example may help to clarify:
+
+@example
+DATA LIST /X 1-2.
+BEGIN DATA.
+ 2
+ 4
+10
+15
+20
+24
+END DATA.
+COMPUTE X=X/2.
+TEMPORARY.
+COMPUTE X=X+3.
+DESCRIPTIVES X.
+DESCRIPTIVES X.
+@end example
+
+The data read by the first DESCRIPTIVES command are 4, 5, 8,
+10.5, 13, 15. The data read by the first DESCRIPTIVES command are 1, 2,
+5, 7.5, 10, 12.
+
+@node WEIGHT, , TEMPORARY, Data Selection
+@section WEIGHT
+@vindex WEIGHT
+
+@display
+WEIGHT BY var_name.
+WEIGHT OFF.
+@end display
+
+WEIGHT can be used to assign cases varying weights in order to
+change the frequency distribution of the active file. Execution of
+WEIGHT is delayed until data have been read in.
+
+If a variable name is specified, WEIGHT causes the values of that
+variable to be used as weighting factors for subsequent statistical
+procedures. Use of keyword BY is optional but recommended. Weighting
+variables must be numeric. Scratch variables may not be used for
+weighting (@pxref{Scratch Variables}).
+
+When OFF is specified, subsequent statistical procedures will weight all
+cases equally.
+
+Weighting values do not need to be integers. However, negative and
+system- and user-missing values for the weighting variable are
+interpreted as weighting factors of 0.
+
+WEIGHT does not cause cases in the active file to be replicated in
+memory.
+
+@node Conditionals and Looping, Statistics, Data Selection, Top
+@chapter Conditional and Looping Constructs
+@cindex conditionals
+@cindex loops
+@cindex flow of control
+@cindex control flow
+
+This chapter documents PSPP commands used for conditional execution,
+looping, and flow of control.
+
+@menu
+* BREAK:: Exit a loop.
+* DO IF:: Conditionally execute a block of code.
+* DO REPEAT:: Textually repeat a code block.
+* LOOP:: Repeat a block of code.
+@end menu
+
+@node BREAK, DO IF, Conditionals and Looping, Conditionals and Looping
+@section BREAK
+@vindex BREAK
+
+@display
+BREAK.
+@end display
+
+BREAK terminates execution of the innermost currently executing LOOP
+construct.
+
+BREAK is allowed only inside a LOOP construct. @xref{LOOP}, for more
+details.
+
+@node DO IF, DO REPEAT, BREAK, Conditionals and Looping
+@section DO IF
+@vindex DO IF
+
+@display
+DO IF condition.
+ @dots{}
+[ELSE IF condition.
+ @dots{}
+]@dots{}
+[ELSE.
+ @dots{}]
+END IF.
+@end display
+
+The DO IF command allows one of several sets of transformations to be
+executed, depending on user-specified conditions.
+
+Specify a boolean expression. If the condition is true, then the block
+of code following DO IF is executed. If the condition is missing, then
+none of the code blocks is executed. If the condition is false, then
+the boolean expressions on the first ELSE IF, if present, is tested in
+turn, with the same rules applied. If all expressions evaluate to
+false, then the ELSE code block is executed, if it is present.
+
+@node DO REPEAT, LOOP, DO IF, Conditionals and Looping
+@section DO REPEAT
+@vindex DO REPEAT
+
+@display
+DO REPEAT repvar_name=expansion@dots{}.
+ @dots{}
+END REPEAT [PRINT].
+
+expansion takes one of the following forms:
+ var_list
+ num_or_range@dots{}
+ 'string'@dots{}
+
+num_or_range takes one of the following forms:
+ number
+ num1 TO num2
+@end display
+
+The DO REPEAT command causes a block of code to be repeated a number of
+times with different variables, numbers, or strings textually
+substituted into the block with each repetition.
+
+Specify a repeat variable name followed by an equals sign (@samp{=}) and
+the list of replacements. Replacements can be a list of variables
+(which may be existing variables or new variables or a combination
+thereof), of numbers, or of strings. When new variable names are
+specified, DO REPEAT creates them as numeric variables. When numbers
+are specified, runs of integers may be indicated with TO notation, for
+instance @samp{1 TO 5} and @samp{1 2 3 4 5} would be equivalent. There
+is no equivalent notation for string values.
+
+Multiple repeat variables can be specified. When this is done, each
+variable must have the same number of replacements.
+
+The code within DO REPEAT is repeated as many times as there are
+replacements for each variable. The first time, the first value for
+each repeat variable is substituted; the second time, the second value
+for each repeat variable is substituted; and so on.
+
+Repeat variable substitutions work like macros. They take place
+anywhere in a line that the repeat variable name occurs as a token,
+including command and subcommand names. For this reason it is not a
+good idea to select words commonly used in command and subcommand names
+as repeat variable identifiers.
+
+If PRINT is specified on END REPEAT, the commands after substitutions
+are made are printed to the listing file, prefixed by a plus sign
+(@samp{+}).
+
+@node LOOP, , DO REPEAT, Conditionals and Looping
+@section LOOP
+@vindex LOOP
+
+@display
+LOOP [index_var=start TO end [BY incr]] [IF condition].
+ @dots{}
+END LOOP [IF condition].
+@end display
+
+The LOOP command allows a group of commands to be iterated. A number of
+termination options are offered.
+
+Specify index_var in order to make that variable count from one value to
+another by a particular increment. index_var must be a pre-existing
+numeric variable. start, end, and incr are numeric expressions
+(@pxref{Expressions}.)
+
+During the first iteration, index_var is set to the value of start.
+During each successive iteration, index_var is increased by the value of
+incr. If end > start, then the loop terminates when index_var > end;
+otherwise it terminates when index_var < end. If incr is not specified
+then it defaults to +1 or -1 as appropriate.
+
+If end > start and incr < 0, or if end < start and incr > 0, then the
+loop is never executed. index_var is nevertheless set to the value of
+start.
+
+Modifying index_var within the loop is allowed, but it has no effect on
+the value of index_var in the next iteration.
+
+Specify a boolean expression for the condition on the LOOP command to
+cause the loop to be executed only if the condition is true. If the
+condition is false or missing before the loop contents are executed the
+first time, the loop contents are not executed at all.
+
+If index and condition clauses are both present on LOOP, the index
+clause is always evaluated first.
+
+Specify a boolean expression for the condition on the END LOOP to cause
+the loop to terminate if the condition is not true after the enclosed
+code block is executed. The condition is evaluated at the end of the
+loop, not at the beginning.
+
+If the index clause and both condition clauses are not present, then the
+loop is executed MXLOOPS (@pxref{SET}) times or until BREAK
+(@pxref{BREAK}) is executed.
+
+The BREAK command provides another way to terminate execution of a LOOP
+construct.
+
+@node Statistics, Utilities, Conditionals and Looping, Top
+@chapter Statistics
+
+This chapter documents the statistical procedures that PSPP supports so
+far.
+
+@menu
+* DESCRIPTIVES:: Descriptive statistics.
+* FREQUENCIES:: Frequency tables.
+* CROSSTABS:: Crosstabulation tables.
+@end menu
+
+@node DESCRIPTIVES, FREQUENCIES, Statistics, Statistics
+@section DESCRIPTIVES
+
+@display
+DESCRIPTIVES
+ /VARIABLES=var_list
+ /MISSING=@{VARIABLE,LISTWISE@} @{INCLUDE,NOINCLUDE@}
+ /FORMAT=@{LABELS,NOLABELS@} @{NOINDEX,INDEX@} @{LINE,SERIAL@}
+ /SAVE
+ /STATISTICS=@{ALL,MEAN,SEMEAN,STDDEV,VARIANCE,KURTOSIS,
+ SKEWNESS,RANGE,MINIMUM,MAXIMUM,SUM,DEFAULT,
+ SESKEWNESS,SEKURTOSIS@}
+ /SORT=@{NONE,MEAN,SEMEAN,STDDEV,VARIANCE,KURTOSIS,SKEWNESS,
+ RANGE,MINIMUM,MAXIMUM,SUM,SESKEWNESS,SEKURTOSIS,NAME@}
+ @{A,D@}
+@end display
+
+The DESCRIPTIVES procedure reads the active file and outputs descriptive
+statistics requested by the user. In addition, it can optionally
+compute Z-scores.
+
+The VARIABLES subcommand, which is required, specifies the list of
+variables to be analyzed. Keyword VARIABLES is optional.
+
+All other subcommands are optional:
+
+The MISSING subcommand determines the handling of missing variables. If
+INCLUDE is set, then user-missing values are included in the
+calculations. If NOINCLUDE is set, which is the default, user-missing
+values are excluded. If VARIABLE is set, then missing values are
+excluded on a variable by variable basis; if LISTWISE is set, then
+the entire case is excluded whenever any value in that case has a
+system-missing or, if INCLUDE is set, user-missing value.
+
+The FORMAT subcommand affects the output format. Currently the
+LABELS/NOLABELS and NOINDEX/INDEX settings is not used. When SERIAL is
+set, both valid and missing number of cases are listed in the output;
+when NOSERIAL is set, only valid cases are listed.
+
+The SAVE subcommand causes DESCRIPTIVES to calculate Z scores for all
+the specified variables. The Z scores are saved to new variables.
+Variable names are generated by trying first the original variable name
+with Z prepended and truncated to a maximum of 8 characters, then the
+names ZSC000 through ZSC999, STDZ00 through STDZ09, ZZZZ00 through
+ZZZZ09, ZQZQ00 through ZQZQ09, in that sequence. In addition, Z score
+variable names can be specified explicitly on VARIABLES in the variable
+list by enclosing them in parentheses after each variable.
+
+The STATISTICS subcommand specifies the statistics to be displayed:
+
+@table @code
+@item ALL
+All of the statistics below.
+@item MEAN
+Arithmetic mean.
+@item SEMEAN
+Standard error of the mean.
+@item STDDEV
+Standard deviation.
+@item VARIANCE
+Variance.
+@item KURTOSIS
+Kurtosis and standard error of the kurtosis.
+@item SKEWNESS
+Skewness and standard error of the skewness.
+@item RANGE
+Range.
+@item MINIMUM
+Minimum value.
+@item MAXIMUM
+Maximum value.
+@item SUM
+Sum.
+@item DEFAULT
+Mean, standard deviation of the mean, minimum, maximum.
+@item SEKURTOSIS
+Standard error of the kurtosis.
+@item SESKEWNESS
+Standard error of the skewness.
+@end table
+
+The SORT subcommand specifies how the statistics should be sorted. Most
+of the possible values should be self-explanatory. NAME causes the
+statistics to be sorted by name. By default, the statistics are listed
+in the order that they are specified on the VARIABLES subcommand. The A
+and D settings request an ascending or descending sort order,
+respectively.
+
+@node FREQUENCIES, CROSSTABS, DESCRIPTIVES, Statistics
+@section FREQUENCIES
+
+@display
+FREQUENCIES
+ /VARIABLES=var_list
+ /FORMAT=@{TABLE,NOTABLE,LIMIT(limit)@}
+ @{STANDARD,CONDENSE,ONEPAGE[(onepage_limit)]@}
+ @{LABELS,NOLABELS@}
+ @{AVALUE,DVALUE,AFREQ,DFREQ@}
+ @{SINGLE,DOUBLE@}
+ @{OLDPAGE,NEWPAGE@}
+ /MISSING=@{EXCLUDE,INCLUDE@}
+ /STATISTICS=@{DEFAULT,MEAN,SEMEAN,MEDIAN,MODE,STDDEV,VARIANCE,
+ KURTOSIS,SKEWNESS,RANGE,MINIMUM,MAXIMUM,SUM,
+ SESKEWNESS,SEKURTOSIS,ALL,NONE@}
+ /NTILES=ntiles
+ /PERCENTILES=percent@dots{}
+
+(These options are not currently implemented.)
+ /BARCHART=@dots{}
+ /HISTOGRAM=@dots{}
+ /HBAR=@dots{}
+ /GROUPED=@dots{}
+
+(Integer mode.)
+ /VARIABLES=var_list (low,high)@dots{}
+@end display
+
+FREQUENCIES causes the data to be read and frequency tables to be built
+and output for specified variables. FREQUENCIES can also calculate and
+display descriptive statistics (including median and mode) and
+percentiles.
+
+In the future, FREQUENCIES will also support graphical output in the
+form of bar charts and histograms. In addition, it will be able to
+support percentiles for grouped data. (As a historical note, these
+options were supported in a version of PSPP written years ago, but the
+code has not survived.)
+
+The VARIABLES subcommand is the only required subcommand. Specify the
+variables to be analyzed. In most cases, this is all that is required.
+This is known as @dfn{general mode}.
+
+Occasionally, one may want to invoke a special mode called @dfn{integer
+mode}. Normally, in general mode, PSPP will automatically determine
+what values occur in the data. In integer mode, the user specifies the
+range of values that the data assumes. To invoke this mode, specify a
+range of data values in parentheses, separated by a comma. Data values
+inside the range are truncated to the nearest integer, then assigned to
+that value. If values occur outside this range, they are discarded.
+
+The FORMAT subcommand controls the output format. It has several
+possible settings:
+
+@itemize @bullet
+@item
+TABLE, the default, causes a frequency table to be output for every
+variable specified. NOTABLE prevents them from being output. LIMIT
+with a numeric argument causes them to be output except when there are
+more than the specified number of values in the table.
+
+@item
+STANDARD frequency tables contain more complete information, but also to
+take up more space on the printed page. CONDENSE frequency tables are
+less informative but take up less space. ONEPAGE with a numeric
+argument will output standard frequency tables if there are the
+specified number of values or less, condensed tables otherwise. ONEPAGE
+without an argument defaults to a threshold of 50 values.
+
+@item
+LABELS causes value labels to be displayed in STANDARD frequency
+tables. NOLABLES prevents this.
+
+@item
+Normally frequency tables are sorted in ascending order by value. This
+is AVALUE. DVALUE tables are sorted in descending order by value.
+AFREQ and DFREQ tables are sorted in ascending and descending order,
+respectively, by frequency count.
+
+@item
+SINGLE spaced frequency tables are closely spaced. DOUBLE spaced
+frequency tables have wider spacing.
+
+@item
+OLDPAGE and NEWPAGE are not currently used.
+@end itemize
+
+The MISSING subcommand controls the handling of user-missing values.
+When EXCLUDE, the default, is set, user-missing values are not included
+in frequency tables or statistics. When INCLUDE is set, user-missing
+are included. System-missing values are never included in statistics,
+but are listed in frequency tables.
+
+The available STATISTICS are the same as available in DESCRIPTIVES
+(@pxref{DESCRIPTIVES}), with the addition of MEDIAN, the data's median
+value, and MODE, the mode. (If there are multiple modes, the smallest
+value is reported.) By default, the mean, standard deviation of the
+mean, minimum, and maximum are reported for each variable.
+
+NTILES causes the specified quartiles to be reported. For instance,
+@code{/NTILES=4} would cause quartiles to be reported. In addition,
+particular percentiles can be requested with the PERCENTILES subcommand.
+
+@node CROSSTABS, , FREQUENCIES, Statistics
+@section CROSSTABS
+
+@display
+CROSSTABS
+ /TABLES=var_list BY var_list [BY var_list]@dots{}
+ /MISSING=@{TABLE,INCLUDE,REPORT@}
+ /WRITE=@{NONE,CELLS,ALL@}
+ /FORMAT=@{TABLES,NOTABLES@}
+ @{LABELS,NOLABELS,NOVALLABS@}
+ @{PIVOT,NOPIVOT@}
+ @{AVALUE,DVALUE@}
+ @{NOINDEX,INDEX@}
+ @{BOX,NOBOX@}
+ /CELLS=@{COUNT,ROW,COLUMN,TOTAL,EXPECTED,RESIDUAL,SRESIDUAL,
+ ASRESIDUAL,ALL,NONE@}
+ /STATISTICS=@{CHISQ,PHI,CC,LAMBDA,UC,BTAU,CTAU,RISK,GAMMA,D,
+ KAPPA,ETA,CORR,ALL,NONE@}
+
+(Integer mode.)
+ /VARIABLES=var_list (low,high)@dots{}
+@end display
+
+CROSSTABS reads the active file and builds and displays crosstabulation
+tables requested by the user. It can calculate several statistics for
+each cell in the crosstabulation tables. In addition, a number of
+statistics can be calculated for each table itself.
+
+The TABLES subcommand is used to specify the tables to be reported. Any
+number of dimensions is permitted, and any number of variables per
+dimension is allowed. The TABLES subcommand may be repeated as many
+times as needed. This is the only required subcommand in @dfn{general
+mode}.
+
+Occasionally, one may want to invoke a special mode called @dfn{integer
+mode}. Normally, in general mode, PSPP will automatically determine
+what values occur in the data. In integer mode, the user specifies the
+range of values that the data assumes. To invoke this mode, specify the
+VARIABLES subcommand, giving a range of data values in parentheses for
+each variable to be used on the TABLES subcommand. Data values inside
+the range are truncated to the nearest integer, then assigned to that
+value. If values occur outside this range, they are discarded. When it
+is present, the VARIABLES subcommand must precede the TABLES subcommand.
+
+The MISSING subcommand determines the handling of user-missing values.
+When set to TABLE, the default, missing values are dropped on a table by
+table basis. When set to INCLUDE, user-missing values are included in
+tables and statistics. When set to REPORT, which is allowed only in
+integer mode, user-missing values are included in tables but marked with
+an @samp{M} (for ``missing'') and excluded from statistical
+calculations.
+
+Currently the WRITE subcommand is not used.
+
+The FORMAT subcommand controls the characteristics of the
+crosstabulation tables to be displayed. It has a number of possible
+settings:
+
+@itemize @bullet
+@item
+TABLES, the default, causes crosstabulation tables to be output.
+NOTABLES suppresses them.
+
+@item
+LABELS, the default, allows variable labels and value labels to appear
+in the output. NOLABELS suppresses them. NOVALLABS displays variable
+labels but suppresses value labels.
+
+@item
+PIVOT, the default, causes each TABLES subcommand to be displayed in a
+pivot table format. NOPIVOT causes the old-style crosstabulation format
+to be used.
+
+@item
+AVALUE, the default, causes values to be sorted in ascending order.
+DVALUE asserts a descending sort order.
+
+@item
+INDEX/NOINDEX is currently ignored.
+
+@item
+BOX/NOBOX is currently ignored.
+@end itemize
+
+The CELLS subcommand controls the contents of each cell in the displayed
+crosstabulation table. The possible settings are:
+
+@table @asis
+@item COUNT
+Frequency count.
+@item ROW
+Row percent.
+@item COLUMN
+Column percent.
+@item TOTAL
+Table percent.
+@item EXPECTED
+Expected value.
+@item RESIDUAL
+Residual.
+@item SRESIDUAL
+Standardized residual.
+@item ASRESIDUAL
+Adjusted standardized residual.
+@item ALL
+All of the above.
+@item NONE
+Suppress cells entirely.
+@end table
+
+@samp{/CELLS} without any settings specified requests COUNT, ROW,
+COLUMN, and TOTAL. If CELLS is not specified at all then only COUNT
+will be selected.
+
+The STATISTICS subcommand selects statistics for computation:
+
+@table @asis
+@item CHISQ
+Pearson chi-square, likelihood ratio, Fisher's exact test, continuity
+correction, linear-by-linear association.
+@item PHI
+Phi.
+@item CC
+Contingency coefficient.
+@item LAMBDA
+Lambda.
+@item UC
+Uncertainty coefficient.
+@item BTAU
+Tau-b.
+@item CTAU
+Tau-c.
+@item RISK
+Risk estimate.
+@item GAMMA
+Gamma.
+@item D
+Somers' D.
+@item KAPPA
+Cohen's Kappa.
+@item ETA
+Eta.
+@item CORR
+Spearman correlation, Pearson's r.
+@item ALL
+All of the above.
+@item NONE
+No statistics.
+@end table
+
+Selected statistics are only calculated when appropriate for the
+statistic. Certain statistics require tables of a particular size, and
+some statistics are calculated only in integer mode.
+
+@samp{/STATISTICS} without any settings selects CHISQ. If the
+STATISTICS subcommand is not given, no statistics are calculated.
+
+@strong{Please note:} Currently the implementation of CROSSTABS has the
+followings bugs:
+
+@itemize @bullet
+@item
+Pearson's R (but not Spearman!) is off a little.
+@item
+T values for Spearman's R and Pearson's R are wrong.
+@item
+How to calculate significance of symmetric and directional measures?
+@item
+Asymmetric ASEs and T values for lambda are wrong.
+@item
+ASE of Goodman and Kruskal's tau is not calculated.
+@item
+ASE of symmetric somers' d is wrong.
+@item
+Approx. T of uncertainty coefficient is wrong.
+@end itemize
+
+Fix for any of these deficiencies would be welcomed.
+
+@node Utilities, Not Implemented, Statistics, Top
+@chapter Utilities
+
+Commands that don't fit any other category are placed here.
+
+Most of these commands are not affected by commands like IF and LOOP:
+they take effect only once, unconditionally, at the time that they are
+encountered in the input.
+
+@menu
+* COMMENT:: Document your syntax file.
+* DOCUMENT:: Document the active file.
+* DISPLAY DOCUMENTS:: Display active file documents.
+* DISPLAY FILE LABEL:: Display the active file label.
+* DROP DOCUMENTS:: Remove documents from the active file.
+* EXECUTE:: Execute pending transformations.
+* FILE LABEL:: Set the active file's label.
+* INCLUDE:: Include a file within the current one.
+* QUIT:: Terminate the PSPP session.
+* SET:: Adjust PSPP runtime parameters.
+* SUBTITLE:: Provide a document subtitle.
+* SYSFILE INFO:: Display the dictionary in a system file.
+* TITLE:: Provide a document title.
+@end menu
+
+@node COMMENT, DOCUMENT, Utilities, Utilities
+@section COMMENT
+@vindex COMMENT
+@vindex *
+
+@display
+Two possibles syntaxes:
+ COMMENT comment text @dots{} .
+ *comment text @dots{} .
+@end display
+
+The COMMENT command is ignored. It is used to provide information to
+the author and other readers of the PSPP syntax file.
+
+A COMMENT command can extend over any number of lines. Don't forget to
+terminate it with a dot or a blank line!
+
+@node DOCUMENT, DISPLAY DOCUMENTS, COMMENT, Utilities
+@section DOCUMENT
+@vindex DOCUMENT
+
+@display
+DOCUMENT documentary_text.
+@end display
+
+The DOCUMENT command adds one or more lines of descriptive commentary to
+the active file. Documents added in this way are saved to system files.
+They can be viewed using SYSFILE INFO or DISPLAY DOCUMENTS. They can be
+removed from the active file with DROP DOCUMENTS.
+
+Specify the documentary text following the DOCUMENT keyword. You can
+extend the documentary text over as many lines as necessary. Lines are
+truncated at 80 characters width. Don't forget to terminate the
+DOCUMENT command with a dot or a blank line.
+
+@node DISPLAY DOCUMENTS, DISPLAY FILE LABEL, DOCUMENT, Utilities
+@section DISPLAY DOCUMENTS
+@vindex DISPLAY DOCUMENTS
+
+@display
+DISPLAY DOCUMENTS.
+@end display
+
+DISPLAY DOCUMENTS displays the documents in the active file. Each
+document is preceded by a line giving the time and date that it was
+added. @xref{DOCUMENT}.
+
+@node DISPLAY FILE LABEL, DROP DOCUMENTS, DISPLAY DOCUMENTS, Utilities
+@section DISPLAY FILE LABEL
+@vindex DISPLAY FILE LABEL
+
+@display
+DISPLAY FILE LABEL.
+@end display
+
+DISPLAY FILE LABEL displays the file label contained in the active file,
+if any. @xref{FILE LABEL}.
+
+@node DROP DOCUMENTS, EXECUTE, DISPLAY FILE LABEL, Utilities
+@section DROP DOCUMENTS
+@vindex DROP DOCUMENTS
+
+@display
+DROP DOCUMENTS.
+@end display
+
+The DROP DOCUMENTS command removes all documents from the active file.
+New documents can be added with the DOCUMENT utility (@pxref{DOCUMENT}).
+
+DROP DOCUMENTS only changes the active file. It does not modify any
+system files stored on disk.
+
+@node EXECUTE, FILE LABEL, DROP DOCUMENTS, Utilities
+@section EXECUTE
+@vindex EXECUTE
+
+@display
+EXECUTE.
+@end display
+
+The EXECUTE utility causes the active file to be read and all pending
+transformations to be executed.
+
+@node FILE LABEL, INCLUDE, EXECUTE, Utilities
+@section FILE LABEL
+@vindex FILE LABEL
+
+@display
+FILE LABEL file_label.
+@end display
+
+Use the FILE LABEL command to provide a title for the active file. This
+title will be saved into system files and portable files that are
+created during this PSPP run.
+
+It is not necessary to include quotes around file_label. If they are
+included then they become part of the file label.
+
+@node INCLUDE, QUIT, FILE LABEL, Utilities
+@section INCLUDE
+@vindex INCLUDE
+@vindex @@
+
+@display
+Two possible syntaxes:
+ INCLUDE 'filename'.
+ @@filename.
+@end display
+
+The INCLUDE command causes the PSPP command processor to read an
+additional command file as if it were included bodily in the current
+command file.
+
+INCLUDE files may be nested to any depth, up to the limit of available
+memory.
+
+@node QUIT, SET, INCLUDE, Utilities
+@section QUIT
+@vindex QUIT
+
+@display
+Two possible syntaxes:
+ QUIT.
+ EXIT.
+@end display
+
+The QUIT command terminates the current PSPP session and returns control
+to the operating system.
+
+This command is not valid within a command file.
+
+@node SET, SUBTITLE, QUIT, Utilities
+@section SET
+@vindex SET
+
+@display
+SET
+
+(data input)
+ /BLANKS=@{SYSMIS,'.',number@}
+ /DECIMAL=@{DOT,COMMA@}
+ /FORMAT=fmt_spec
+
+(program input)
+ /ENDCMD='.'
+ /NULLINE=@{ON,OFF@}
+
+(interaction)
+ /CPROMPT='cprompt_string'
+ /DPROMPT='dprompt_string'
+ /ERRORBREAK=@{OFF,ON@}
+ /MXERRS=max_errs
+ /MXWARNS=max_warnings
+ /PROMPT='prompt'
+ /VIEWLENGTH=@{MINIMUM,MEDIAN,MAXIMUM,n_lines@}
+ /VIEWWIDTH=n_characters
+
+(program execution)
+ /MEXPAND=@{ON,OFF@}
+ /MITERATE=max_iterations
+ /MNEST=max_nest
+ /MPRINT=@{ON,OFF@}
+ /MXLOOPS=max_loops
+ /SEED=@{RANDOM,seed_value@}
+ /UNDEFINED=@{WARN,NOWARN@}
+
+(data output)
+ /CC@{A,B,C,D,E@}=@{'npre,pre,suf,nsuf','npre.pre.suf.nsuf'@}
+ /DECIMAL=@{DOT,COMMA@}
+ /FORMAT=fmt_spec
+
+(output routing)
+ /ECHO=@{ON,OFF@}
+ /ERRORS=@{ON,OFF,TERMINAL,LISTING,BOTH,NONE@}
+ /INCLUDE=@{ON,OFF@}
+ /MESSAGES=@{ON,OFF,TERMINAL,LISTING,BOTH,NONE@}
+ /PRINTBACK=@{ON,OFF@}
+ /RESULTS=@{ON,OFF,TERMINAL,LISTING,BOTH,NONE@}
+
+(output activation)
+ /LISTING=@{ON,OFF@}
+ /PRINTER=@{ON,OFF@}
+ /SCREEN=@{ON,OFF@}
+
+(output driver options)
+ /HEADERS=@{NO,YES,BLANK@}
+ /LENGTH=@{NONE,length_in_lines@}
+ /LISTING=filename
+ /MORE=@{ON,OFF@}
+ /PAGER=@{OFF,"pager_name"@}
+ /WIDTH=@{NARROW,WIDTH,n_characters@}
+
+(logging)
+ /JOURNAL=@{ON,OFF@} [filename]
+ /LOG=@{ON,OFF@} [filename]
+
+(system files)
+ /COMPRESSION=@{ON,OFF@}
+ /SCOMPRESSION=@{ON,OFF@}
+
+(security)
+ /SAFER=ON
+
+(obsolete settings accepted for compatibility, but ignored)
+ /AUTOMENU=@{ON,OFF@}
+ /BEEP=@{ON,OFF@}
+ /BLOCK='c'
+ /BOXSTRING=@{'xxx','xxxxxxxxxxx'@}
+ /CASE=@{UPPER,UPLOW@}
+ /COLOR=@dots{}
+ /CPI=cpi_value
+ /DISK=@{ON,OFF@}
+ /EJECT=@{ON,OFF@}
+ /HELPWINDOWS=@{ON,OFF@}
+ /HIGHRES=@{ON,OFF@}
+ /HISTOGRAM='c'
+ /LOWRES=@{AUTO,ON,OFF@}
+ /LPI=lpi_value
+ /MENUS=@{STANDARD,EXTENDED@}
+ /MXMEMORY=max_memory
+ /PTRANSLATE=@{ON,OFF@}
+ /RCOLORS=@dots{}
+ /RUNREVIEW=@{AUTO,MANUAL@}
+ /SCRIPTTAB='c'
+ /TB1=@{'xxx','xxxxxxxxxxx'@}
+ /TBFONTS='string'
+ /WORKDEV=drive_letter
+ /WORKSPACE=workspace_size
+ /XSORT=@{YES,NO@}
+@end display
+
+The SET command allows the user to adjust several parameters relating to
+PSPP's execution. Since there are many subcommands to this command, its
+subcommands will be examined in groups.
+
+As a general comment, ON and YES are considered synonymous, and
+so are OFF and NO, when used as subcommand values.
+
+The data input subcommands affect the way that data is read from data
+files. The data input subcommands are
+
+@table @asis
+@item BLANKS
+This is the value assigned to an item data item that is empty or
+contains only whitespace. An argument of SYSMIS or '.' will cause the
+system-missing value to be assigned to null items. This is the
+default. Any real value may be assigned.
+
+@item DECIMAL
+The default DOT setting causes the decimal point character to be
+@samp{.}. A setting of COMMA causes the decimal point character to be
+@samp{,}.
+
+@item FORMAT
+Allows the default numeric input/output format to be specified. The
+default is F8.2. @xref{Input/Output Formats}.
+@end table
+
+Program input subcommands affect the way that programs are parsed when
+they are typed interactively or run from a script. They are
+
+@table @asis
+@item ENDCMD
+This is a single character indicating the end of a command. The default
+is @samp{.}. Don't change this.
+
+@item NULLINE
+Whether a blank line is interpreted as ending the current command. The
+default is ON.
+@end table
+
+Interaction subcommands affect the way that PSPP interacts with an
+online user. The interaction subcommands are
+
+@table @asis
+@item CPROMPT
+The command continuation prompt. The default is @samp{ > }.
+
+@item DPROMPT
+Prompt used when expecting data input within BEGIN DATA (@pxref{BEGIN
+DATA}). The default is @samp{data> }.
+
+@item ERRORBREAK
+Whether an error causes PSPP to stop processing the current command
+file after finishing the current command. The default is OFF.
+
+@item MXERRS
+The maximum number of errors before PSPP halts processing of the current
+command file. The default is 50.
+
+@item MXWARNS
+The maximum number of warnings + errors before PSPP halts processing the
+current command file. The default is 100.
+
+@item PROMPT
+The command prompt. The default is @samp{PSPP> }.
+
+@item VIEWLENGTH
+The length of the screen in lines. MINIMUM means 25 lines, MEDIAN and
+MAXIMUM mean 43 lines. Otherwise specify the number of lines. Normally
+PSPP should auto-detect your screen size so this shouldn't have to be
+used.
+
+@item VIEWWIDTH
+The width of the screen in characters. Normally 80 or 132.
+@end table
+
+Program execution subcommands control the way that PSPP commands
+execute. The program execution subcommands are
+
+@table @asis
+@item MEXPAND
+@itemx MITERATE
+@itemx MNEST
+@itemx MPRINT
+Currently not used.
+
+@item MXLOOPS
+The maximum number of iterations for an uncontrolled loop.
+
+@item SEED
+The initial pseudo-random number seed. Set to a real number or to
+RANDOM, which will obtain an initial seed from the current time of day.
+
+@item UNDEFINED
+Currently not used.
+@end table
+
+Data output subcommands affect the format of output data. These
+subcommands are
+
+@table @asis
+@item CCA
+@itemx CCB
+@itemx CCC
+@itemx CCD
+@itemx CCE
+Set up custom currency formats. The argument is a string which must
+contain exactly three commas or exactly three periods. If commas, then
+the grouping character for the currency format is @samp{,}, and the
+decimal point character is @samp{.}; if periods, then the situation is
+reversed.
+
+The commas or periods divide the string into four fields, which are, in
+order, the negative prefix, prefix, suffix, and negative suffix. When a
+value is formatted using the custom currency format, the prefix precedes
+the value formatted and the suffix follows it. In addition, if the
+value is negative, the negative prefix precedes the prefix and the
+negative suffix follows the suffix.
+
+@item DECIMAL
+The default DOT setting causes the decimal point character to be
+@samp{.}. A setting of COMMA causes the decimal point character to be
+@samp{,}.
+
+@item FORMAT
+Allows the default numeric input/output format to be specified. The
+default is F8.2. @xref{Input/Output Formats}.
+@end table
+
+Output routing subcommands affect where the output of transformations
+and procedures is sent. These subcommands are
+
+@table @asis
+@item ECHO
+
+If turned on, commands are written to the listing file as they are read
+from command files. The default is OFF.
+
+@itemx ERRORS
+@itemx INCLUDE
+@itemx MESSAGES
+@item PRINTBACK
+@item RESULTS
+Currently not used.
+@end table
+
+Output activation subcommands affect whether output devices of
+particular types are enabled. These subcommands are
+
+@table @asis
+@item LISTING
+Enable or disable listing devices.
+
+@item PRINTER
+Enable or disable printer devices.
+
+@item SCREEN
+Enable or disable screen devices.
+@end table
+
+Output driver option subcommands affect output drivers' settings. These
+subcommands are
+
+@table @asis
+@item HEADERS
+@itemx LENGTH
+@itemx LISTING
+@itemx MORE
+@itemx PAGER
+@itemx WIDTH
+Currently not used.
+@end table
+
+Logging subcommands affect logging of commands executed to external
+files. These subcommands are
+
+@table @asis
+@item JOURNAL
+@item LOG
+Not currently used.
+@end table
+
+System file subcommands affect the default format of system files
+produced by PSPP. These subcommands are
+
+@table @asis
+@item COMPRESSION
+Not currently used.
+
+@item SCOMPRESSION
+Whether system files created by SAVE or XSAVE are compressed by default.
+The default is ON.
+@end table
+
+Security subcommands affect the operations that commands are allowed to
+perform. The security subcommands are
+
+@table @asis
+@item SAFER
+When set, this setting cannot ever be reset, for obvious security
+reasons. Setting this option disables the following operations:
+
+@itemize @bullet
+@item
+The ERASE command.
+@item
+The HOST command.
+@item
+Pipe filenames (filenames beginning or ending with @samp{|}).
+@item
+@end itemize
+
+Be aware that this setting does not guarantee safety (commands can still
+overwrite files, for instance) but it is an improvement.
+@end table
+
+@node SUBTITLE, TITLE, SET, Utilities
+@section SUBTITLE
+@vindex SUBTITLE
+
+@display
+Two possible syntaxes:
+ SUBTITLE 'subtitle_string'.
+ SUBTITLE subtitle_string.
+@end display
+
+The SUBTITLE command is used to provide a subtitle to a particular PSPP
+run. This subtitle appears at the top of each output page below the
+title, if titles are enabled on the output device.
+
+Specify a subtitle as a string in quotes. The alternate syntax that did
+not require quotes is now obsolete. If it is used then the subtitle is
+converted to all uppercase.
+
+@node TITLE, , SUBTITLE, Utilities
+@section TITLE
+@vindex TITLE
+
+@display
+Two possible syntaxes:
+ TITLE 'title_string'.
+ TITLE title_string.
+@end display
+
+The TITLE command is used to provide a title to a particular PSPP run.
+This title appears at the top of each output page, if titles are enabled
+on the output device.
+
+Specify a title as a string in quotes. The alternate syntax that did
+not require quotes is now obsolete. If it is used then the title is
+converted to all uppercase.
+
+@node Not Implemented, Data File Format, Utilities, Top
+@chapter Not Implemented
+
+This chapter lists parts of the PSPP language that are not yet
+implemented.
+
+The following transformations and utilities are not yet implemented, but
+they will be supported in a later release.
+
+@itemize @bullet
+@item
+ADD FILES
+@item
+DEFINE
+@item
+FILE TYPE
+@item
+GET SAS
+@item
+GET TRANSLATE
+@item
+MCONVERT
+@item
+PRESERVE
+@item
+PROCEDURE OUTPUT
+@item
+RESTORE
+@item
+SAVE TRANSLATE
+@item
+SHOW
+@item
+UPDATE
+@end itemize
+
+The following transformations and utilities are not implemented. There
+are no plans to support them in future releases. Contributions to
+implement them will still be accepted.
+
+@itemize @bullet
+@item
+EDIT
+@item
+GET DATABASE
+@item
+GET OSIRIS
+@item
+GET SCSS
+@item
+GSET
+@item
+HELP
+@item
+INFO
+@item
+INPUT MATRIX
+@item
+KEYED DATA LIST
+@item
+NUMBERED and UNNUMBERED
+@item
+OPTIONS
+@item
+REVIEW
+@item
+SAVE SCSS
+@item
+SPSS MANAGER
+@item
+STATISTICS
+@end itemize
+
+@node Data File Format, Portable File Format, Not Implemented, Top
+@chapter Data File Format
+
+PSPP necessarily uses the same format for system files as do the
+products with which it is compatible. This chapter is a description of
+that format.
+
+There are three data types used in system files: 32-bit integers, 64-bit
+floating points, and 1-byte characters. In this document these will
+simply be referred to as @code{int32}, @code{flt64}, and @code{char},
+the names that are used in the PSPP source code. Every field of type
+@code{int32} or @code{flt64} is aligned on a 32-bit boundary.
+
+The endianness of data in PSPP system files is not specified. System
+files output on a computer of a particular endianness will have the
+endianness of that computer. However, PSPP can read files of either
+endianness, regardless of its host computer's endianness. PSPP
+translates endianness for both integer and floating point numbers.
+
+Floating point formats are also not specified. PSPP does not
+translate between floating point formats. This is unlikely to be a
+problem as all modern computer architectures use IEEE 754 format for
+floating point representation.
+
+The PSPP system-missing value is represented by the largest possible
+negative number in the floating point format; in C, this is most likely
+@code{-DBL_MAX}. There are two other important values used in missing
+values: @code{HIGHEST} and @code{LOWEST}. These are represented by the
+largest possible positive number (probably @code{DBL_MAX}) and the
+second-largest negative number. The latter must be determined in a
+system-dependent manner; in IEEE 754 format it is represented by value
+@code{0xffeffffffffffffe}.
+
+System files are divided into records. Each record begins with an
+@code{int32} giving a numeric record type. Individual record types are
+described below:
+
+@menu
+* File Header Record::
+* Variable Record::
+* Value Label Record::
+* Value Label Variable Record::
+* Document Record::
+* Machine int32 Info Record::
+* Machine flt64 Info Record::
+* Miscellaneous Informational Records::
+* Dictionary Termination Record::
+* Data Record::
+@end menu
+
+@node File Header Record, Variable Record, Data File Format, Data File Format
+@section File Header Record
+
+The file header is always the first record in the file.
+
+@example
+struct sysfile_header
+ @{
+ char rec_type[4];
+ char prod_name[60];
+ int32 layout_code;
+ int32 case_size;
+ int32 compressed;
+ int32 weight_index;
+ int32 ncases;
+ flt64 bias;
+ char creation_date[9];
+ char creation_time[8];
+ char file_label[64];
+ char padding[3];
+ @};
+@end example
+
+@table @code
+@item char rec_type[4];
+Record type code. Always set to @samp{$FL2}. This is the only record
+for which the record type is not of type @code{int32}.
+
+@item char prod_name[60];
+Product identification string. This always begins with the characters
+@samp{@@(#) SPSS DATA FILE}. PSPP uses the remaining characters to
+give its version and the operating system name; for example, @samp{GNU
+pspp 0.1.4 - sparc-sun-solaris2.5.2}. The string is truncated if it
+would be longer than 60 characters; otherwise it is padded on the right
+with spaces.
+
+@item int32 layout_code;
+Always set to 2. PSPP reads this value in order to determine the
+file's endianness.
+
+@item int32 case_size;
+Number of data elements per case. This is the number of variables,
+except that long string variables add extra data elements (one for every
+8 characters after the first 8).
+
+@item int32 compressed;
+Set to 1 if the data in the file is compressed, 0 otherwise.
+
+@item int32 weight_index;
+If one of the variables in the data set is used as a weighting variable,
+set to the index of that variable. Otherwise, set to 0.
+
+@item int32 ncases;
+Set to the number of cases in the file if it is known, or -1 otherwise.
+
+In the general case it is not possible to determine the number of cases
+that will be output to a system file at the time that the header is
+written. The way that this is dealt with is by writing the entire
+system file, including the header, then seeking back to the beginning of
+the file and writing just the @code{ncases} field. For `files' in which
+this is not valid, the seek operation fails. In this case,
+@code{ncases} remains -1.
+
+@item flt64 bias;
+Compression bias. Always set to 100. The significance of this value is
+that only numbers between @code{(1 - bias)} and @code{(251 - bias)} can
+be compressed.
+
+@item char creation_date[9];
+Set to the date of creation of the system file, in @samp{dd mmm yy}
+format, with the month as standard English abbreviations, using an
+initial capital letter and following with lowercase. If the date is not
+available then this field is arbitrarily set to @samp{01 Jan 70}.
+
+@item char creation_time[8];
+Set to the time of creation of the system file, in @samp{hh:mm:ss}
+format and using 24-hour time. If the time is not available then this
+field is arbitrarily set to @samp{00:00:00}.
+
+@item char file_label[64];
+Set the the file label declared by the user, if any. Padded on the
+right with spaces.
+
+@item char padding[3];
+Ignored padding bytes to make the structure a multiple of 32 bits in
+length. Set to zeros.
+@end table
+
+@node Variable Record, Value Label Record, File Header Record, Data File Format
+@section Variable Record
+
+Immediately following the header must come the variable records. There
+must be one variable record for every variable and every 8 characters in
+a long string beyond the first 8; i.e., there must be exactly as many
+variable records as the value specified for @code{case_size} in the file
+header record.
+
+@example
+struct sysfile_variable
+ @{
+ int32 rec_type;
+ int32 type;
+ int32 has_var_label;
+ int32 n_missing_values;
+ int32 print;
+ int32 write;
+ char name[8];
+
+ /* The following two fields are present
+ only if has_var_label is 1. */
+ int32 label_len;
+ char label[/* variable length */];
+
+ /* The following field is present only
+ if n_missing_values is not 0. */
+ flt64 missing_values[/* variable length*/];
+ @};
+@end example
+
+@table @code
+@item int32 rec_type;
+Record type code. Always set to 2.
+
+@item int32 type;
+Variable type code. Set to 0 for a numeric variable. For a short
+string variable or the first part of a long string variable, this is set
+to the width of the string. For the second and subsequent parts of a
+long string variable, set to -1, and the remaining fields in the
+structure are ignored.
+
+@item int32 has_var_label;
+If this variable has a variable label, set to 1; otherwise, set to 0.
+
+@item int32 n_missing_values;
+If the variable has no missing values, set to 0. If the variable has
+one, two, or three discrete missing values, set to 1, 2, or 3,
+respectively. If the variable has a range for missing variables, set to
+-2; if the variable has a range for missing variables plus a single
+discrete value, set to -3.
+
+@item int32 print;
+Print format for this variable. See below.
+
+@item int32 write;
+Write format for this variable. See below.
+
+@item char name[8];
+Variable name. The variable name must begin with a capital letter or
+the at-sign (@samp{@@}). Subsequent characters may also be octothorpes
+(@samp{#}), dollar signs (@samp{$}), underscores (@samp{_}), or full
+stops (@samp{.}). The variable name is padded on the right with spaces.
+
+@item int32 label_len;
+This field is present only if @code{has_var_label} is set to 1. It is
+set to the length, in characters, of the variable label, which must be a
+number between 0 and 120.
+
+@item char label[/* variable length */];
+This field is present only if @code{has_var_label} is set to 1. It has
+length @code{label_len}, rounded up to the nearest multiple of 32 bits.
+The first @code{label_len} characters are the variable's variable label.
+
+@item flt64 missing_values[/* variable length */];
+This field is present only if @code{n_missing_values} is not 0. It has
+the same number of elements as the absolute value of
+@code{n_missing_values}. For discrete missing values, each element
+represents one missing value. When a range is present, the first
+element denotes the minimum value in the range, and the second element
+denotes the maximum value in the range. When a range plus a value are
+present, the third element denotes the additional discrete missing
+value. HIGHEST and LOWEST are indicated as described in the chapter
+introduction.
+@end table
+
+The @code{print} and @code{write} members of sysfile_variable are output
+formats coded into @code{int32} types. The LSB (least-significant byte)
+of the @code{int32} represents the number of decimal places, and the
+next two bytes in order of increasing significance represent field width
+and format type, respectively. The MSB (most-significant byte) is not
+used and should be set to zero.
+
+Format types are defined as follows:
+@table @asis
+@item 0
+Not used.
+@item 1
+@code{A}
+@item 2
+@code{AHEX}
+@item 3
+@code{COMMA}
+@item 4
+@code{DOLLAR}
+@item 5
+@code{F}
+@item 6
+@code{IB}
+@item 7
+@code{PIBHEX}
+@item 8
+@code{P}
+@item 9
+@code{PIB}
+@item 10
+@code{PK}
+@item 11
+@code{RB}
+@item 12
+@code{RBHEX}
+@item 13
+Not used.
+@item 14
+Not used.
+@item 15
+@code{Z}
+@item 16
+@code{N}
+@item 17
+@code{E}
+@item 18
+Not used.
+@item 19
+Not used.
+@item 20
+@code{DATE}
+@item 21
+@code{TIME}
+@item 22
+@code{DATETIME}
+@item 23
+@code{ADATE}
+@item 24
+@code{JDATE}
+@item 25
+@code{DTIME}
+@item 26
+@code{WKDAY}
+@item 27
+@code{MONTH}
+@item 28
+@code{MOYR}
+@item 29
+@code{QYR}
+@item 30
+@code{WKYR}
+@item 31
+@code{PCT}
+@item 32
+@code{DOT}
+@item 33
+@code{CCA}
+@item 34
+@code{CCB}
+@item 35
+@code{CCC}
+@item 36
+@code{CCD}
+@item 37
+@code{CCE}
+@item 38
+@code{EDATE}
+@item 39
+@code{SDATE}
+@end table
+
+@node Value Label Record, Value Label Variable Record, Variable Record, Data File Format
+@section Value Label Record
+
+Value label records must follow the variable records and must precede
+the header termination record. Other than this, they may appear
+anywhere in the system file. Every value label record must be
+immediately followed by a label variable record, described below.
+
+Value label records begin with @code{rec_type}, an @code{int32} value
+set to the record type of 3. This is followed by @code{count}, an
+@code{int32} value set to the number of value labels present in this
+record.
+
+These two fields are followed by a series of @code{count} tuples. Each
+tuple is divided into two fields, the value and the label. The first of
+these, the value, is composed of a 64-bit value, which is either a
+@code{flt64} value or up to 8 characters (padded on the right to 8
+bytes) denoting a short string value. Whether the value is a
+@code{flt64} or a character string is not defined inside the value label
+record.
+
+The second field in the tuple, the label, has variable length. The
+first @code{char} is a count of the number of characters in the value
+label. The remainder of the field is the label itself. The field is
+padded on the right to a multiple of 64 bits in length.
+
+@node Value Label Variable Record, Document Record, Value Label Record, Data File Format
+@section Value Label Variable Record
+
+Every value label variable record must be immediately preceded by a
+value label record, described above.
+
+@example
+struct sysfile_value_label_variable
+ @{
+ int32 rec_type;
+ int32 count;
+ int32 vars[/* variable length */];
+ @};
+@end example
+
+@table @code
+@item int32 rec_type;
+Record type. Always set to 4.
+
+@item int32 count;
+Number of variables that the associated value labels from the value
+label record are to be applied.
+
+@item int32 vars[/* variable length];
+A list of variables to which to apply the value labels. There are
+@code{count} elements.
+@end table
+
+@node Document Record, Machine int32 Info Record, Value Label Variable Record, Data File Format
+@section Document Record
+
+There must be no more than one document record per system file.
+Document records must follow the variable records and precede the
+dictionary termination record.
+
+@example
+struct sysfile_document
+ @{
+ int32 rec_type;
+ int32 n_lines;
+ char lines[/* variable length */][80];
+ @};
+@end example
+
+@table @code
+@item int32 rec_type;
+Record type. Always set to 6.
+
+@item int32 n_lines;
+Number of lines of documents present.
+
+@item char lines[/* variable length */][80];
+Document lines. The number of elements is defined by @code{n_lines}.
+Lines shorter than 80 characters are padded on the right with spaces.
+@end table
+
+@node Machine int32 Info Record, Machine flt64 Info Record, Document Record, Data File Format
+@section Machine @code{int32} Info Record
+
+There must be no more than one machine @code{int32} info record per
+system file. Machine @code{int32} info records must follow the variable
+records and precede the dictionary termination record.
+
+@example
+struct sysfile_machine_int32_info
+ @{
+ /* Header. */
+ int32 rec_type;
+ int32 subtype;
+ int32 size;
+ int32 count;
+
+ /* Data. */
+ int32 version_major;
+ int32 version_minor;
+ int32 version_revision;
+ int32 machine_code;
+ int32 floating_point_rep;
+ int32 compression_code;
+ int32 endianness;
+ int32 character_code;
+ @};
+@end example
+
+@table @code
+@item int32 rec_type;
+Record type. Always set to 7.
+
+@item int32 subtype;
+Record subtype. Always set to 3.
+
+@item int32 size;
+Size of each piece of data in the data part, in bytes. Always set to 4.
+
+@item int32 count;
+Number of pieces of data in the data part. Always set to 8.
+
+@item int32 version_major;
+PSPP major version number. In version @var{x}.@var{y}.@var{z}, this
+is @var{x}.
+
+@item int32 version_minor;
+PSPP minor version number. In version @var{x}.@var{y}.@var{z}, this
+is @var{y}.
+
+@item int32 version_revision;
+PSPP version revision number. In version @var{x}.@var{y}.@var{z},
+this is @var{z}.
+
+@item int32 machine_code;
+Machine code. PSPP always set this field to value to -1, but other
+values may appear.
+
+@item int32 floating_point_rep;
+Floating point representation code. For IEEE 754 systems this is 1.
+IBM 370 sets this to 2, and DEC VAX E to 3.
+
+@item int32 compression_code;
+Compression code. Always set to 1.
+
+@item int32 endianness;
+Machine endianness. 1 indicates big-endian, 2 indicates little-endian.
+
+@item int32 character_code;
+Character code. 1 indicates EBCDIC, 2 indicates 7-bit ASCII, 3
+indicates 8-bit ASCII, 4 indicates DEC Kanji.
+@end table
+
+@node Machine flt64 Info Record, Miscellaneous Informational Records, Machine int32 Info Record, Data File Format
+@section Machine @code{flt64} Info Record
+
+There must be no more than one machine @code{flt64} info record per
+system file. Machine @code{flt64} info records must follow the variable
+records and precede the dictionary termination record.
+
+@example
+struct sysfile_machine_flt64_info
+ @{
+ /* Header. */
+ int32 rec_type;
+ int32 subtype;
+ int32 size;
+ int32 count;
+
+ /* Data. */
+ flt64 sysmis;
+ flt64 highest;
+ flt64 lowest;
+ @};
+@end example
+
+@table @code
+@item int32 rec_type;
+Record type. Always set to 3.
+
+@item int32 subtype;
+Record subtype. Always set to 4.
+
+@item int32 size;
+Size of each piece of data in the data part, in bytes. Always set to 4.
+
+@item int32 count;
+Number of pieces of data in the data part. Always set to 3.
+
+@item flt64 sysmis;
+The system missing value.
+
+@item flt64 highest;
+The value used for HIGHEST in missing values.
+
+@item flt64 lowest;
+The value used for LOWEST in missing values.
+@end table
+
+@node Miscellaneous Informational Records, Dictionary Termination Record, Machine flt64 Info Record, Data File Format
+@section Miscellaneous Informational Records
+
+Miscellaneous informational records must follow the variable records and
+precede the dictionary termination record.
+
+Miscellaneous informational records are ignored by PSPP when reading
+system files. They are not written by PSPP when writing system files.
+
+@example
+struct sysfile_misc_info
+ @{
+ /* Header. */
+ int32 rec_type;
+ int32 subtype;
+ int32 size;
+ int32 count;
+
+ /* Data. */
+ char data[/* variable length */];
+ @};
+@end example
+
+@table @code
+@item int32 rec_type;
+Record type. Always set to 3.
+
+@item int32 subtype;
+Record subtype. May take any value.
+
+@item int32 size;
+Size of each piece of data in the data part. Should have the value 4 or
+8, for @code{int32} and @code{flt64}, respectively.
+
+@item int32 count;
+Number of pieces of data in the data part.
+
+@item char data[/* variable length */];
+Arbitrary data. There must be @code{size} times @code{count} bytes of
+data.
+@end table
+
+@node Dictionary Termination Record, Data Record, Miscellaneous Informational Records, Data File Format
+@section Dictionary Termination Record
+
+The dictionary termination record must follow all other records, except
+for the actual cases, which it must precede. There must be exactly one
+dictionary termination record in every system file.
+
+@example
+struct sysfile_dict_term
+ @{
+ int32 rec_type;
+ int32 filler;
+ @};
+@end example
+
+@table @code
+@item int32 rec_type;
+Record type. Always set to 999.
+
+@item int32 filler;
+Ignored padding. Should be set to 0.
+@end table
+
+@node Data Record, , Dictionary Termination Record, Data File Format
+@section Data Record
+
+Data records must follow all other records in the data file. There must
+be at least one data record in every system file.
+
+The format of data records varies depending on whether the data is
+compressed. Regardless, the data is arranged in a series of 8-byte
+elements.
+
+When data is not compressed, Every case is composed of @code{case_size}
+of these 8-byte elements, where @code{case_size} comes from the file
+header record (@pxref{File Header Record}). Each element corresponds to
+the variable declared in the respective variable record (@pxref{Variable
+Record}). Numeric values are given in @code{flt64} format; string
+values are literal characters string, padded on the right when
+necessary.
+
+Compressed data is arranged in the following manner: the first 8-byte
+element in the data section is divided into a series of 1-byte command
+codes. These codes have meanings as described below:
+
+@table @asis
+@item 0
+Ignored. If the program writing the system file accumulates compressed
+data in blocks of fixed length, 0 bytes can be used to pad out extra
+bytes remaining at the end of a fixed-size block.
+
+@item 1 through 251
+These values indicate that the corresponding numeric variable has the
+value @code{(@var{code} - @var{bias})} for the case being read, where
+@var{code} is the value of the compression code and @var{bias} is the
+variable @code{compression_bias} from the file header. For example,
+code 105 with bias 100.0 (the normal value) indicates a numeric variable
+of value 5.
+
+@item 252
+End of file. This code may or may not appear at the end of the data
+stream. PSPP always outputs this code but its use is not required.
+
+@item 253
+This value indicates that the numeric or string value is not
+compressible. The value is stored in the 8-byte element following the
+current block of command bytes. If this value appears twice in a block
+of command bytes, then it indicates the second element following the
+command bytes, and so on.
+
+@item 254
+Used to indicate a string value that is all spaces.
+
+@item 255
+Used to indicate the system-missing value.
+@end table
+
+When the end of the first 8-byte element of command bytes is reached,
+any blocks of non-compressible values are skipped, and the next element
+of command bytes is read and interpreted, until the end of the file is
+reached.
+
+@node Portable File Format, q2c Input Format, Data File Format, Top
+@chapter Portable File Format
+
+These days, most computers use the same internal data formats for
+integer and floating-point data, if one ignores little differences like
+big- versus little-endian byte ordering. However, occasionally it is
+necessary to exchange data between systems with incompatible data
+formats. This is what portable files are designed to do.
+
+@strong{Please note:} Although all of the following information is
+correct, as far as the author has been able to ascertain, it is gleaned
+from examination of ASCII-formatted portable files only, so some of it
+may be incorrect in the general case.
+
+@menu
+* Portable File Characters::
+* Portable File Structure::
+* Portable File Header::
+* Version and Date Info Record::
+* Identification Records::
+* Variable Count Record::
+* Variable Records::
+* Value Label Records::
+* Portable File Data::
+@end menu
+
+@node Portable File Characters, Portable File Structure, Portable File Format, Portable File Format
+@section Portable File Characters
+
+Portable files are arranged as a series of lines of exactly 80
+characters each. Each line is terminated by a carriage-return,
+line-feed sequence (henceforth, ``newline''). Newlines are not
+delimiters: they are only used to avoid line-length limitations existing
+on some operating systems.
+
+The file must be terminated with a @samp{Z} character. In addition, if
+the final line in the file does not have exactly 80 characters, then it
+is padded on the right with @samp{Z} characters. (The file contents may
+be in any character set; the file contains a description of its own
+character set, as explained in the next section. Therefore, the
+@samp{Z} character is not necessarily an ASCII @samp{Z}.)
+
+For the rest of the description of the portable file format, newlines
+and the trailing @samp{Z}s will be ignored, as if they did not exist,
+because they are not an important part of understanding the file
+contents.
+
+@node Portable File Structure, Portable File Header, Portable File Characters, Portable File Format
+@section Portable File Structure
+
+Every portable file consists of the following records, in sequence:
+
+@itemize @bullet
+
+@item
+File header.
+
+@item
+Version and date info.
+
+@item
+Product identification.
+
+@item
+Subproduct identification (optional).
+
+@item
+Variable count.
+
+@item
+Variables. Each variable record may optionally be followed by a
+missing value record and a variable label record.
+
+@item
+Value labels (optional).
+
+@item
+Data.
+@end itemize
+
+Most records are identified by a single-character tag code. The file
+header and version info record do not have a tag.
+
+Other than these single-character codes, there are three types of fields
+in a portable file: floating-point, integer, and string. Floating-point
+fields have the following format:
+
+@itemize @bullet
+
+@item
+Zero or more leading spaces.
+
+@item
+Optional asterisk (@samp{*}), which indicates a missing value. The
+asterisk must be followed by a single character, generally a period
+(@samp{.}), but it appears that other characters may also be possible.
+This completes the specification of a missing value.
+
+@item
+Optional minus sign (@samp{-}) to indicate a negative number.
+
+@item
+A whole number, consisting of one or more base-30 digits: @samp{0}
+through @samp{9} plus capital letters @samp{A} through @samp{T}.
+
+@item
+A fraction, consisting of a radix point (@samp{.}) followed by one or
+more base-30 digits (optional).
+
+@item
+An exponent, consisting of a plus or minus sign (@samp{+} or @samp{-})
+followed by one or more base-30 digits (optional).
+
+@item
+A forward slash (@samp{/}).
+@end itemize
+
+Integer fields take form identical to floating-point fields, but they
+may not contain a fraction.
+
+String fields take the form of a integer field having value @var{n},
+followed by exactly @var{n} characters, which are the string content.
+
+@node Portable File Header, Version and Date Info Record, Portable File Structure, Portable File Format
+@section Portable File Header
+
+Every portable file begins with a 464-byte header, consisting of a
+200-byte collection of vanity splash strings, followed by a 256-byte
+character set translation table, followed by an 8-byte tag string.
+
+The 200-byte segment is divided into five 40-byte sections, each of
+which represents the string @code{ASCII SPSS PORT FILE} in a different
+character set encoding. (If the file is encoded in EBCDIC then the
+string is actually @code{EBCDIC SPSS PORT FILE}, and so on.) These
+strings are padded on the right with spaces in their own character set.
+
+It appears that these strings exist only to inform those who might view
+the file on a screen, and that they are not parsed by SPSS products.
+Thus, they can be safely ignored. For those interested, the strings are
+supposed to be in the following character sets, in the specified order:
+EBCDIC, 7-bit ASCII, CDC 6-bit ASCII, 6-bit ASCII, Honeywell 6-bit
+ASCII.
+
+The 256-byte segment describes a mapping from the character set used in
+the portable file to an arbitrary character set having characters at the
+following positions:
+
+@table @asis
+@item 0--60
+
+Control characters. Not important enough to describe in full here.
+
+@item 61--63
+
+Reserved.
+
+@item 64--73
+
+Digits @samp{0} through @samp{9}.
+
+@item 74--99
+
+Capital letters @samp{A} through @samp{Z}.
+
+@item 100--125
+
+Lowercase letters @samp{a} through @samp{z}.
+
+@item 126
+
+Space.
+
+@item 127--130
+
+Symbols @code{.<(+}
+
+@item 131
+
+Solid vertical pipe.
+
+@item 132--142
+
+Symbols @code{&[]!$*);^-/}
+
+@item 143
+
+Broken vertical pipe.
+
+@item 144--150
+
+Symbols @code{,%_>}?@code{`:} @c @code{?} is an inverted question mark
+
+@item 151
+
+British pound symbol.
+
+@item 152--155
+
+Symbols @code{@@'="}.
+
+@item 156
+
+Less than or equal symbol.
+
+@item 157
+
+Empty box.
+
+@item 158
+
+Plus or minus.
+
+@item 159
+
+Filled box.
+
+@item 160
+
+Degree symbol.
+
+@item 161
+
+Dagger.
+
+@item 162
+
+Symbol @samp{~}.
+
+@item 163
+
+En dash.
+
+@item 164
+
+Lower left corner box draw.
+
+@item 165
+
+Upper left corner box draw.
+
+@item 166
+
+Greater than or equal symbol.
+
+@item 167--176
+
+Superscript @samp{0} through @samp{9}.
+
+@item 177
+
+Lower right corner box draw.
+
+@item 178
+
+Upper right corner box draw.
+
+@item 179
+
+Not equal symbol.
+
+@item 180
+
+Em dash.
+
+@item 181
+
+Superscript @samp{(}.
+
+@item 182
+
+Superscript @samp{)}.
+
+@item 183
+
+Horizontal dagger (?).
+
+@item 184--186
+
+Symbols @samp{@{@}\}.
+@item 187
+
+Cents symbol.
+
+@item 188
+
+Centered dot, or bullet.
+
+@item 189--255
+
+Reserved.
+@end table
+
+Symbols that are not defined in a particular character set are set to
+the same value as symbol 64; i.e., to @samp{0}.
+
+The 8-byte tag string consists of the exact characters @code{SPSSPORT}
+in the portable file's character set, which can be used to verify that
+the file is indeed a portable file.
+
+@node Version and Date Info Record, Identification Records, Portable File Header, Portable File Format
+@section Version and Date Info Record
+
+This record does not have a tag code. It has the following structure:
+
+@itemize @bullet
+@item
+A single character identifying the file format version. The letter A
+represents version 0, and so on.
+
+@item
+An 8-character string field giving the file creation date in the format
+YYYYMMDD.
+
+@item
+A 6-character string field giving the file creation time in the format
+HHMMSS.
+@end itemize
+
+@node Identification Records, Variable Count Record, Version and Date Info Record, Portable File Format
+@section Identification Records
+
+The product identification record has tag code @samp{1}. It consists of
+a single string field giving the name of the product that wrote the
+portable file.
+
+The subproduct identification record has tag code @samp{3}. It
+consists of a single string field giving additional information on the
+product that wrote the portable file.
+
+@node Variable Count Record, Variable Records, Identification Records, Portable File Format
+@section Variable Count Record
+
+The variable count record has tag code @samp{4}. It consists of two
+integer fields. The first contains the number of variables in the file
+dictionary. The purpose of the second is unknown; it contains the value
+161 in all portable files examined so far.
+
+@node Variable Records, Value Label Records, Variable Count Record, Portable File Format
+@section Variable Records
+
+Each variable record represents a single variable. Variable records
+have tag code @samp{7}. They have the following structure:
+
+@itemize @bullet
+
+@item
+Width (integer). This is 0 for a numeric variable, and a number between 1
+and 255 for a string variable.
+
+@item
+Name (string). 1--8 characters long. Must be in all capitals.
+
+@item
+Print format. This is a set of three integer fields:
+
+@itemize @minus
+
+@item
+Format type (@pxref{Variable Record}).
+
+@item
+Format width. 1--40.
+
+@item
+Number of decimal places. 1--40.
+@end itemize
+
+@item
+Write format. Same structure as the print format described above.
+@end itemize
+
+Each variable record can optionally be followed by a missing value
+record, which has tag code @samp{8}. A missing value record has one
+field, the missing value itself (a floating-point or string, as
+appropriate). Up to three of these missing value records can be used.
+
+There is also a record for missing value ranges, which has tag code
+@samp{B}. It is followed by two fields representing the range, which
+are floating-point or string as appropriate. If a missing value range
+is present, it may be followed by a single missing value record.
+
+Tag codes @samp{9} and @samp{A} represent @code{LO THRU @var{x}} and
+@code{@var{x} THRU HI} ranges, respectively. Each is followed by a
+single field representing @var{x}. If one of the ranges is present, it
+may be followed by a single missing value record.
+
+In addition, each variable record can optionally be followed by a
+variable label record, which has tag code @samp{C}. A variable label
+record has one field, the variable label itself (string).
+
+@node Value Label Records, Portable File Data, Variable Records, Portable File Format
+@section Value Label Records
+
+Value label records have tag code @samp{D}. They have the following
+format:
+
+@itemize @bullet
+@item
+Variable count (integer).
+
+@item
+List of variables (strings). The variable count specifies the number in
+the list. Variables are specified by their names. All variables must
+be of the same type (numeric or string).
+
+@item
+Label count (integer).
+
+@item
+List of (value, label) tuples. The label count specifies the number of
+tuples. Each tuple consists of a value, which is numeric or string as
+appropriate to the variables, followed by a label (string).
+@end itemize
+
+@node Portable File Data, , Value Label Records, Portable File Format
+@section Portable File Data
+
+The data record has tag code @samp{F}. There is only one tag for all
+the data; thus, all the data must follow the dictionary. The data is
+terminated by the end-of-file marker @samp{Z}, which is not valid as the
+beginning of a data element.
+
+Data elements are output in the same order as the variable records
+describing them. String variables are output as string fields, and
+numeric variables are output as floating-point fields.
+
+@node q2c Input Format, Bugs, Portable File Format, Top
+@chapter @code{q2c} Input Format
+
+PSPP statistical procedures have a bizarre and somewhat irregular
+syntax. Despite this, a parser generator has been written that
+adequately addresses many of the possibilities and tries to provide
+hooks for the exceptional cases. This parser generator is named
+@code{q2c}.
+
+@menu
+* Invoking q2c:: q2c command-line syntax.
+* q2c Input Structure:: High-level layout of the input file.
+* Grammar Rules:: Syntax of the grammar rules.
+@end menu
+
+@node Invoking q2c, q2c Input Structure, q2c Input Format, q2c Input Format
+@section Invoking q2c
+
+@example
+q2c @var{input.q} @var{output.c}
+@end example
+
+@code{q2c} translates a @samp{.q} file into a @samp{.c} file. It takes
+exactly two command-line arguments, which are the input file name and
+output file name, respectively. @code{q2c} does not accept any
+command-line options.
+
+@node q2c Input Structure, Grammar Rules, Invoking q2c, q2c Input Format
+@section @code{q2c} Input Structure
+
+@code{q2c} input files are divided into two sections: the grammar rules
+and the supporting code. The @dfn{grammar rules}, which make up the
+first part of the input, are used to define the syntax of the
+statistical procedure to be parsed. The @dfn{supporting code},
+following the grammar rules, are copied largely unchanged to the output
+file, except for certain escapes.
+
+The most important lines in the grammar rules are used for defining
+procedure syntax. These lines can be prefixed with a dollar sign
+(@samp{$}), which prevents Emacs' CC-mode from munging them. Besides
+this, a bang (@samp{!}) at the beginning of a line causes the line,
+minus the bang, to be written verbatim to the output file (useful for
+comments). As a third special case, any line that begins with the exact
+characters @code{/* *INDENT} is ignored and not written to the output.
+This allows @code{.q} files to be processed through @code{indent}
+without being munged.
+
+The syntax of the grammar rules themselves is given in the following
+sections.
+
+The supporting code is passed into the output file largely unchanged.
+However, the following escapes are supported. Each escape must appear
+on a line by itself.
+
+@table @code
+@item /* (header) */
+
+Expands to a series of C @code{#include} directives which include the
+headers that are required for the parser generated by @code{q2c}.
+
+@item /* (decls @var{scope}) */
+
+Expands to C variable and data type declarations for the variables and
+@code{enum}s input and output by the @code{q2c} parser. @var{scope}
+must be either @code{local} or @code{global}. @code{local} causes the
+declarations to be output as function locals. @code{global} causes them
+to be declared as @code{static} module variables; thus, @code{global} is
+a bit of a misnomer.
+
+@item /* (parser) */
+
+Expands to the entire parser. Must be enclosed within a C function.
+
+@item /* (free) */
+
+Expands to a set of calls to the @code{free} function for variables
+declared by the parser. Only needs to be invoked if subcommands of type
+@code{string} are used in the grammar rules.
+@end table
+
+@node Grammar Rules, , q2c Input Structure, q2c Input Format
+@section Grammar Rules
+
+The grammar rules describe the format of the syntax that the parser
+generated by @code{q2c} will understand. The way that the grammar rules
+are included in @code{q2c} input file are described above.
+
+The grammar rules are divided into tokens of the following types:
+
+@table @asis
+@item Identifier (@code{ID})
+
+An identifier token is a sequence of letters, digits, and underscores
+(@samp{_}). Identifiers are @emph{not} case-sensitive.
+
+@item String (@code{STRING})
+
+String tokens are initiated by a double-quote character (@samp{"}) and
+consist of all the characters between that double quote and the next
+double quote, which must be on the same line as the first. Within a
+string, a backslash can be used as a ``literal escape''. The only
+reasons to use a literal escape are to include a double quote or a
+backslash within a string.
+
+@item Special character
+
+Other characters, other than whitespace, constitute tokens in
+themselves.
+
+@end table
+
+The syntax of the grammar rules is as follows:
+
+@example
+grammar-rules ::= ID : subcommands .
+subcommands ::= subcommand
+ ::= subcommands ; subcommand
+@end example
+
+The syntax begins with an ID or STRING token that gives the name of the
+procedure to be parsed. The rest of the syntax consists of subcommands
+separated by semicolons (@samp{;}) and terminated with a full stop
+(@samp{.}).
+
+@example
+subcommand ::= sbc-options ID sbc-defn
+sbc-options ::=
+ ::= sbc-option
+ ::= sbc-options sbc-options
+sbc-option ::= *
+ ::= +
+sbc-defn ::= opt-prefix = specifiers
+ ::= [ ID ] = array-sbc
+ ::= opt-prefix = sbc-special-form
+opt-prefix ::=
+ ::= ( ID )
+@end example
+
+Each subcommand can be prefixed with one or more option characters. An
+asterisk (@samp{*}) is used to indicate the default subcommand; the
+keyword used for the default subcommand can be omitted in the PSPP
+syntax file. A plus sign (@samp{+}) is used to indicate that a
+subcommand can appear more than once; if it is not present then that
+subcommand can appear no more than once.
+
+The subcommand name appears after the option characters.
+
+There are three forms of subcommands. The first and most common form
+simply gives an equals sign (@samp{=}) and a list of specifiers, which
+can each be set to a single setting. The second form declares an array,
+which is a set of flags that can be individually turned on by the user.
+There are also several special forms that do not take a list of
+specifiers.
+
+Arrays require an additional @code{ID} argument. This is used as a
+prefix, prepended to the variable names constructed from the
+specifiers. The other forms also allow an optional prefix to be
+specified.
+
+@example
+array-sbc ::= alternatives
+ ::= array-sbc , alternatives
+alternatives ::= ID
+ ::= alternatives | ID
+@end example
+
+An array subcommand is a set of Boolean values that can independently be
+turned on by the user, listed separated by commas (@samp{,}). If an value has more
+than one name then these names are separated by pipes (@samp{|}).
+
+@example
+specifiers ::= specifier
+ ::= specifiers , specifier
+specifier ::= opt-id : settings
+opt-id ::=
+ ::= ID
+@end example
+
+Ordinary subcommands (other than arrays and special forms) require a
+list of specifiers. Each specifier has an optional name and a list of
+settings. If the name is given then a correspondingly named variable
+will be used to store the user's choice of setting. If no name is given
+then there is no way to tell which setting the user picked; in this case
+the settings should probably have values attached.
+
+@example
+settings ::= setting
+ ::= settings / setting
+setting ::= setting-options ID setting-value
+setting-options ::=
+ ::= *
+ ::= !
+ ::= * !
+@end example
+
+Individual settings are separated by forward slashes (@samp{/}). Each
+setting can be as little as an @code{ID} token, but options and values
+can optionally be included. The @samp{*} option means that, for this
+setting, the @code{ID} can be omitted. The @samp{!} option means that
+this option is the default for its specifier.
+
+@example
+setting-value ::=
+ ::= ( setting-value-2 )
+ ::= setting-value-2
+setting-value-2 ::= setting-value-options setting-value-type : ID
+ setting-value-restriction
+setting-value-options ::=
+ ::= *
+setting-value-type ::= N
+ ::= D
+setting-value-restriction ::=
+ ::= , STRING
+@end example
+
+Settings may have values. If the value must be enclosed in parentheses,
+then enclose the value declaration in parentheses. Declare the setting
+type as @samp{n} or @samp{d} for integer or floating point type,
+respectively. The given @code{ID} is used to construct a variable name.
+If option @samp{*} is given, then the value is optional; otherwise it
+must be specified whenever the corresponding setting is specified. A
+``restriction'' can also be specified which is a string giving a C
+expression limiting the valid range of the value. The special escape
+@code{%s} should be used within the restriction to refer to the
+setting's value variable.
+
+@example
+sbc-special-form ::= VAR
+ ::= VARLIST varlist-options
+ ::= INTEGER opt-list
+ ::= DOUBLE opt-list
+ ::= PINT
+ ::= STRING @r{(the literal word STRING)} string-options
+ ::= CUSTOM
+varlist-options ::=
+ ::= ( STRING )
+opt-list ::=
+ ::= LIST
+string-options ::=
+ ::= ( STRING STRING )
+@end example
+
+The special forms are of the following types:
+
+@table @code
+@item VAR
+
+A single variable name.
+
+@item VARLIST
+
+A list of variables. If given, the string can be used to provide
+@code{PV_@var{*}} options to the call to @code{parse_variables}.
+
+@item INTEGER
+
+A single integer value.
+
+@item INTEGER LIST
+
+A list of integers separated by spaces or commas.
+
+@item DOUBLE
+
+A single floating-point value.
+
+@item DOUBLE LIST
+
+A list of floating-point values.
+
+@item PINT
+
+A single positive integer value.
+
+@item STRING
+
+A string value. If the options are given then the first string is an
+expression giving a restriction on the value of the string; the second
+string is an error message to display when the restriction is violated.
+
+@item CUSTOM
+
+A custom function is used to parse this subcommand. The function must
+have prototype @code{int custom_@var{name} (void)}. It should return 0
+on failure (when it has already issued an appropriate diagnostic), 1 on
+success, or 2 if it fails and the calling function should issue a syntax
+error on behalf of the custom handler.
+
+@end table
+
+@node Bugs, Function Index, q2c Input Format, Top
+@chapter Bugs
+
+@quotation
+As of fvwm 0.99 there were exactly 39.342 unidentified bugs. Identified
+bugs have mostly been fixed, though. Since then 9.34 bugs have been
+fixed. Assuming that there are at least 10 unidentified bugs for every
+identified one, that leaves us with 39.342 - 9.34 + 10 * 9.34 = 123.422
+unidentified bugs. If we follow this to its logical conclusion we
+will have an infinite number of unidentified bugs before the number of
+bugs can start to diminish, at which point the program will be
+bug-free. Since this is a computer program infinity = 3.4028e+38 if you
+don't insist on double-precision. At the current rate of bug discovery
+we should expect to achieve this point in 3.37e+27 years. I guess I
+better plan on passing this thing on to my children@enddots{}
+
+---Robert Nation, @cite{fvwm manpage}.
+@end quotation
+
+@menu
+* Known bugs:: Pointers to other files.
+* Contacting the Author:: Where to send the bug reports.
+@end menu
+
+@node Known bugs, Contacting the Author, Bugs, Bugs
+@section Known bugs
+
+This is the list of known bugs in PSPP. In addition, @xref{Not
+Implemented}, and @xref{Functions Not Implemented}, for lists of bugs
+due to features not implemented. For known bugs in individual language
+features, see the documentation for that feature.
+
+@itemize @bullet
+@item
+Nothing has yet been tested exhaustively. Be cautious using PSPP to
+make important decisions.
+
+@item
+@code{make check} fails on some systems that don't like the syntax. I'm
+not sure why. If someone could make an attempt to track this down, it
+would be appreciated.
+
+@item
+PostScript driver bugs:
+
+@itemize @minus
+@item
+Does not support driver arguments `max-fonts-simult' or
+`optimize-text-size'.
+
+@item
+Minor problems with font-encodings.
+
+@item
+Fails to align fonts along their baselines.
+
+@item
+Does not support certain bizarre line intersections--should
+never crop up in practice.
+
+@item
+Does not gracefully substitute for existing fonts whose
+encodings are missing.
+
+@item
+Does not perform italic correction or left italic correction
+on font changes.
+
+@item
+Encapsulated PostScript is unimplemented.
+@end itemize
+
+@item
+ASCII driver bugs:
+
+@itemize @minus
+Does not support `infinite length' or `infinite width' paper.
+@end itemize
+@end itemize
+
+See below for information on reporting bugs not listed here.
+
+@node Contacting the Author, , Known bugs, Bugs
+@section Contacting the Author
+
+The author can be contacted at e-mail address
+@ifinfo
+<blp@@gnu.org>.
+@end ifinfo
+@iftex
+@code{<blp@@gnu.org>}.
+@end iftex
+
+PSPP bug reports should be sent to
+@ifinfo
+<bug-gnu-pspp@@gnu.org>.
+@end ifinfo
+@iftex
+@code{<bug-gnu-pspp@@gnu.org>}.
+@end iftex
+
+@node Function Index, Concept Index, Bugs, Top
+@chapter Function Index
+@printindex fn
+
+@node Concept Index, Command Index, Function Index, Top
+@chapter Concept Index
+@printindex cp
+
+@node Command Index, , Concept Index, Top
+@chapter Command Index
+@printindex vr
+
+@contents
+@bye
+
+@c Local Variables:
+@c compile-command: "makeinfo pspp.texi"
+@c End:
--- /dev/null
+%% TeX macros to handle texinfo files
+
+% Copyright (C) 1985, 86, 88, 90, 91, 92, 93, 1994 Free Software Foundation, Inc.
+
+%This texinfo.tex 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, or (at
+%your option) any later version.
+
+%This texinfo.tex file is distributed in the hope that it will be
+%useful, but WITHOUT ANY WARRANTY; without even 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 texinfo.tex file; see the file COPYING. If not, write
+%to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139,
+%USA.
+
+
+%In other words, you are welcome to use, share and improve this program.
+%You are forbidden to forbid anyone else to use, share and improve
+%what you give them. Help stamp out software-hoarding!
+
+
+% Send bug reports to bug-texinfo@prep.ai.mit.edu.
+% Please include a *precise* test case in each bug report.
+
+
+% Make it possible to create a .fmt file just by loading this file:
+% if the underlying format is not loaded, start by loading it now.
+% Added by gildea November 1993.
+\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
+
+% This automatically updates the version number based on RCS.
+\def\deftexinfoversion$#1: #2 ${\def\texinfoversion{#2}}
+\deftexinfoversion$Revision: 1.1 $
+\message{Loading texinfo package [Version \texinfoversion]:}
+
+% If in a .fmt file, print the version number
+% and turn on active characters that we couldn't do earlier because
+% they might have appeared in the input file name.
+\everyjob{\message{[Texinfo version \texinfoversion]}\message{}
+ \catcode`+=\active \catcode`\_=\active}
+
+% Save some parts of plain tex whose names we will redefine.
+
+\let\ptextilde=\~
+\let\ptexlbrace=\{
+\let\ptexrbrace=\}
+\let\ptexdots=\dots
+\let\ptexdot=\.
+\let\ptexstar=\*
+\let\ptexend=\end
+\let\ptexbullet=\bullet
+\let\ptexb=\b
+\let\ptexc=\c
+\let\ptexi=\i
+\let\ptext=\t
+\let\ptexl=\l
+\let\ptexL=\L
+
+% Be sure we're in horizontal mode when doing a tie, since we make space
+% equivalent to this in @example-like environments. Otherwise, a space
+% at the beginning of a line will start with \penalty -- and
+% since \penalty is valid in vertical mode, we'd end up putting the
+% penalty on the vertical list instead of in the new paragraph.
+{\catcode`@ = 11
+ \gdef\tie{\leavevmode\penalty\@M\ }
+}
+\let\~ = \tie % And make it available as @~.
+
+\message{Basics,}
+\chardef\other=12
+
+% If this character appears in an error message or help string, it
+% starts a new line in the output.
+\newlinechar = `^^J
+
+% Set up fixed words for English.
+\ifx\putwordChapter\undefined{\gdef\putwordChapter{Chapter}}\fi%
+\def\putwordInfo{Info}%
+\ifx\putwordSee\undefined{\gdef\putwordSee{See}}\fi%
+\ifx\putwordsee\undefined{\gdef\putwordsee{see}}\fi%
+\ifx\putwordfile\undefined{\gdef\putwordfile{file}}\fi%
+\ifx\putwordpage\undefined{\gdef\putwordpage{page}}\fi%
+\ifx\putwordsection\undefined{\gdef\putwordsection{section}}\fi%
+\ifx\putwordSection\undefined{\gdef\putwordSection{Section}}\fi%
+\ifx\putwordTableofContents\undefined{\gdef\putwordTableofContents{Table of Contents}}\fi%
+\ifx\putwordShortContents\undefined{\gdef\putwordShortContents{Short Contents}}\fi%
+\ifx\putwordAppendix\undefined{\gdef\putwordAppendix{Appendix}}\fi%
+
+% Ignore a token.
+%
+\def\gobble#1{}
+
+\hyphenation{ap-pen-dix}
+\hyphenation{mini-buf-fer mini-buf-fers}
+\hyphenation{eshell}
+
+% Margin to add to right of even pages, to left of odd pages.
+\newdimen \bindingoffset \bindingoffset=0pt
+\newdimen \normaloffset \normaloffset=\hoffset
+\newdimen\pagewidth \newdimen\pageheight
+\pagewidth=\hsize \pageheight=\vsize
+
+% Sometimes it is convenient to have everything in the transcript file
+% and nothing on the terminal. We don't just call \tracingall here,
+% since that produces some useless output on the terminal.
+%
+\def\gloggingall{\begingroup \globaldefs = 1 \loggingall \endgroup}%
+\def\loggingall{\tracingcommands2 \tracingstats2
+ \tracingpages1 \tracingoutput1 \tracinglostchars1
+ \tracingmacros2 \tracingparagraphs1 \tracingrestores1
+ \showboxbreadth\maxdimen\showboxdepth\maxdimen
+}%
+
+%---------------------Begin change-----------------------
+%
+%%%% For @cropmarks command.
+% Dimensions to add cropmarks at corners Added by P. A. MacKay, 12 Nov. 1986
+%
+\newdimen\cornerlong \newdimen\cornerthick
+\newdimen \topandbottommargin
+\newdimen \outerhsize \newdimen \outervsize
+\cornerlong=1pc\cornerthick=.3pt % These set size of cropmarks
+\outerhsize=7in
+%\outervsize=9.5in
+% Alternative @smallbook page size is 9.25in
+\outervsize=9.25in
+\topandbottommargin=.75in
+%
+%---------------------End change-----------------------
+
+% \onepageout takes a vbox as an argument. Note that \pagecontents
+% does insertions itself, but you have to call it yourself.
+\chardef\PAGE=255 \output={\onepageout{\pagecontents\PAGE}}
+\def\onepageout#1{\hoffset=\normaloffset
+\ifodd\pageno \advance\hoffset by \bindingoffset
+\else \advance\hoffset by -\bindingoffset\fi
+{\escapechar=`\\\relax % makes sure backslash is used in output files.
+\shipout\vbox{{\let\hsize=\pagewidth \makeheadline} \pagebody{#1}%
+{\let\hsize=\pagewidth \makefootline}}}%
+\advancepageno \ifnum\outputpenalty>-20000 \else\dosupereject\fi}
+
+%%%% For @cropmarks command %%%%
+
+% Here is a modification of the main output routine for Near East Publications
+% This provides right-angle cropmarks at all four corners.
+% The contents of the page are centerlined into the cropmarks,
+% and any desired binding offset is added as an \hskip on either
+% site of the centerlined box. (P. A. MacKay, 12 November, 1986)
+%
+\def\croppageout#1{\hoffset=0pt % make sure this doesn't mess things up
+{\escapechar=`\\\relax % makes sure backslash is used in output files.
+ \shipout
+ \vbox to \outervsize{\hsize=\outerhsize
+ \vbox{\line{\ewtop\hfill\ewtop}}
+ \nointerlineskip
+ \line{\vbox{\moveleft\cornerthick\nstop}
+ \hfill
+ \vbox{\moveright\cornerthick\nstop}}
+ \vskip \topandbottommargin
+ \centerline{\ifodd\pageno\hskip\bindingoffset\fi
+ \vbox{
+ {\let\hsize=\pagewidth \makeheadline}
+ \pagebody{#1}
+ {\let\hsize=\pagewidth \makefootline}}
+ \ifodd\pageno\else\hskip\bindingoffset\fi}
+ \vskip \topandbottommargin plus1fill minus1fill
+ \boxmaxdepth\cornerthick
+ \line{\vbox{\moveleft\cornerthick\nsbot}
+ \hfill
+ \vbox{\moveright\cornerthick\nsbot}}
+ \nointerlineskip
+ \vbox{\line{\ewbot\hfill\ewbot}}
+ }}
+ \advancepageno
+ \ifnum\outputpenalty>-20000 \else\dosupereject\fi}
+%
+% Do @cropmarks to get crop marks
+\def\cropmarks{\let\onepageout=\croppageout }
+
+\newinsert\margin \dimen\margin=\maxdimen
+
+\def\pagebody#1{\vbox to\pageheight{\boxmaxdepth=\maxdepth #1}}
+{\catcode`\@ =11
+\gdef\pagecontents#1{\ifvoid\topins\else\unvbox\topins\fi
+% marginal hacks, juha@viisa.uucp (Juha Takala)
+\ifvoid\margin\else % marginal info is present
+ \rlap{\kern\hsize\vbox to\z@{\kern1pt\box\margin \vss}}\fi
+\dimen@=\dp#1 \unvbox#1
+\ifvoid\footins\else\vskip\skip\footins\footnoterule \unvbox\footins\fi
+\ifr@ggedbottom \kern-\dimen@ \vfil \fi}
+}
+
+%
+% Here are the rules for the cropmarks. Note that they are
+% offset so that the space between them is truly \outerhsize or \outervsize
+% (P. A. MacKay, 12 November, 1986)
+%
+\def\ewtop{\vrule height\cornerthick depth0pt width\cornerlong}
+\def\nstop{\vbox
+ {\hrule height\cornerthick depth\cornerlong width\cornerthick}}
+\def\ewbot{\vrule height0pt depth\cornerthick width\cornerlong}
+\def\nsbot{\vbox
+ {\hrule height\cornerlong depth\cornerthick width\cornerthick}}
+
+% Parse an argument, then pass it to #1. The argument is the rest of
+% the input line (except we remove a trailing comment). #1 should be a
+% macro which expects an ordinary undelimited TeX argument.
+%
+\def\parsearg#1{%
+ \let\next = #1%
+ \begingroup
+ \obeylines
+ \futurelet\temp\parseargx
+}
+
+% If the next token is an obeyed space (from an @example environment or
+% the like), remove it and recurse. Otherwise, we're done.
+\def\parseargx{%
+ % \obeyedspace is defined far below, after the definition of \sepspaces.
+ \ifx\obeyedspace\temp
+ \expandafter\parseargdiscardspace
+ \else
+ \expandafter\parseargline
+ \fi
+}
+
+% Remove a single space (as the delimiter token to the macro call).
+{\obeyspaces %
+ \gdef\parseargdiscardspace {\futurelet\temp\parseargx}}
+
+{\obeylines %
+ \gdef\parseargline#1^^M{%
+ \endgroup % End of the group started in \parsearg.
+ %
+ % First remove any @c comment, then any @comment.
+ % Result of each macro is put in \toks0.
+ \argremovec #1\c\relax %
+ \expandafter\argremovecomment \the\toks0 \comment\relax %
+ %
+ % Call the caller's macro, saved as \next in \parsearg.
+ \expandafter\next\expandafter{\the\toks0}%
+ }%
+}
+
+% Since all \c{,omment} does is throw away the argument, we can let TeX
+% do that for us. The \relax here is matched by the \relax in the call
+% in \parseargline; it could be more or less anything, its purpose is
+% just to delimit the argument to the \c.
+\def\argremovec#1\c#2\relax{\toks0 = {#1}}
+\def\argremovecomment#1\comment#2\relax{\toks0 = {#1}}
+
+% \argremovec{,omment} might leave us with trailing spaces, though; e.g.,
+% @end itemize @c foo
+% will have two active spaces as part of the argument with the
+% `itemize'. Here we remove all active spaces from #1, and assign the
+% result to \toks0.
+%
+% This loses if there are any *other* active characters besides spaces
+% in the argument -- _ ^ +, for example -- since they get expanded.
+% Fortunately, Texinfo does not define any such commands. (If it ever
+% does, the catcode of the characters in questionwill have to be changed
+% here.) But this means we cannot call \removeactivespaces as part of
+% \argremovec{,omment}, since @c uses \parsearg, and thus the argument
+% that \parsearg gets might well have any character at all in it.
+%
+\def\removeactivespaces#1{%
+ \begingroup
+ \ignoreactivespaces
+ \edef\temp{#1}%
+ \global\toks0 = \expandafter{\temp}%
+ \endgroup
+}
+
+% Change the active space to expand to nothing.
+%
+\begingroup
+ \obeyspaces
+ \gdef\ignoreactivespaces{\obeyspaces\let =\empty}
+\endgroup
+
+
+\def\flushcr{\ifx\par\lisppar \def\next##1{}\else \let\next=\relax \fi \next}
+
+%% These are used to keep @begin/@end levels from running away
+%% Call \inENV within environments (after a \begingroup)
+\newif\ifENV \ENVfalse \def\inENV{\ifENV\relax\else\ENVtrue\fi}
+\def\ENVcheck{%
+\ifENV\errmessage{Still within an environment. Type Return to continue.}
+\endgroup\fi} % This is not perfect, but it should reduce lossage
+
+% @begin foo is the same as @foo, for now.
+\newhelp\EMsimple{Type <Return> to continue.}
+
+\outer\def\begin{\parsearg\beginxxx}
+
+\def\beginxxx #1{%
+\expandafter\ifx\csname #1\endcsname\relax
+{\errhelp=\EMsimple \errmessage{Undefined command @begin #1}}\else
+\csname #1\endcsname\fi}
+
+% @end foo executes the definition of \Efoo.
+%
+\def\end{\parsearg\endxxx}
+\def\endxxx #1{%
+ \removeactivespaces{#1}%
+ \edef\endthing{\the\toks0}%
+ %
+ \expandafter\ifx\csname E\endthing\endcsname\relax
+ \expandafter\ifx\csname \endthing\endcsname\relax
+ % There's no \foo, i.e., no ``environment'' foo.
+ \errhelp = \EMsimple
+ \errmessage{Undefined command `@end \endthing'}%
+ \else
+ \unmatchedenderror\endthing
+ \fi
+ \else
+ % Everything's ok; the right environment has been started.
+ \csname E\endthing\endcsname
+ \fi
+}
+
+% There is an environment #1, but it hasn't been started. Give an error.
+%
+\def\unmatchedenderror#1{%
+ \errhelp = \EMsimple
+ \errmessage{This `@end #1' doesn't have a matching `@#1'}%
+}
+
+% Define the control sequence \E#1 to give an unmatched @end error.
+%
+\def\defineunmatchedend#1{%
+ \expandafter\def\csname E#1\endcsname{\unmatchedenderror{#1}}%
+}
+
+
+% Single-spacing is done by various environments (specifically, in
+% \nonfillstart and \quotations).
+\newskip\singlespaceskip \singlespaceskip = 12.5pt
+\def\singlespace{%
+ % Why was this kern here? It messes up equalizing space above and below
+ % environments. --karl, 6may93
+ %{\advance \baselineskip by -\singlespaceskip
+ %\kern \baselineskip}%
+ \setleading \singlespaceskip
+}
+
+%% Simple single-character @ commands
+
+% @@ prints an @
+% Kludge this until the fonts are right (grr).
+\def\@{{\tt \char '100}}
+
+% This is turned off because it was never documented
+% and you can use @w{...} around a quote to suppress ligatures.
+%% Define @` and @' to be the same as ` and '
+%% but suppressing ligatures.
+%\def\`{{`}}
+%\def\'{{'}}
+
+% Used to generate quoted braces.
+
+\def\mylbrace {{\tt \char '173}}
+\def\myrbrace {{\tt \char '175}}
+\let\{=\mylbrace
+\let\}=\myrbrace
+
+% @: forces normal size whitespace following.
+\def\:{\spacefactor=1000 }
+
+% @* forces a line break.
+\def\*{\hfil\break\hbox{}\ignorespaces}
+
+% @. is an end-of-sentence period.
+\def\.{.\spacefactor=3000 }
+
+% @enddots{} is an end-of-sentence ellipsis.
+\gdef\enddots{$\mathinner{\ldotp\ldotp\ldotp\ldotp}$\spacefactor=3000}
+
+% @! is an end-of-sentence bang.
+\gdef\!{!\spacefactor=3000 }
+
+% @? is an end-of-sentence query.
+\gdef\?{?\spacefactor=3000 }
+
+% @w prevents a word break. Without the \leavevmode, @w at the
+% beginning of a paragraph, when TeX is still in vertical mode, would
+% produce a whole line of output instead of starting the paragraph.
+\def\w#1{\leavevmode\hbox{#1}}
+
+% @group ... @end group forces ... to be all on one page, by enclosing
+% it in a TeX vbox. We use \vtop instead of \vbox to construct the box
+% to keep its height that of a normal line. According to the rules for
+% \topskip (p.114 of the TeXbook), the glue inserted is
+% max (\topskip - \ht (first item), 0). If that height is large,
+% therefore, no glue is inserted, and the space between the headline and
+% the text is small, which looks bad.
+%
+\def\group{\begingroup
+ \ifnum\catcode13=\active \else
+ \errhelp = \groupinvalidhelp
+ \errmessage{@group invalid in context where filling is enabled}%
+ \fi
+ %
+ % The \vtop we start below produces a box with normal height and large
+ % depth; thus, TeX puts \baselineskip glue before it, and (when the
+ % next line of text is done) \lineskip glue after it. (See p.82 of
+ % the TeXbook.) Thus, space below is not quite equal to space
+ % above. But it's pretty close.
+ \def\Egroup{%
+ \egroup % End the \vtop.
+ \endgroup % End the \group.
+ }%
+ %
+ \vtop\bgroup
+ % We have to put a strut on the last line in case the @group is in
+ % the midst of an example, rather than completely enclosing it.
+ % Otherwise, the interline space between the last line of the group
+ % and the first line afterwards is too small. But we can't put the
+ % strut in \Egroup, since there it would be on a line by itself.
+ % Hence this just inserts a strut at the beginning of each line.
+ \everypar = {\strut}%
+ %
+ % Since we have a strut on every line, we don't need any of TeX's
+ % normal interline spacing.
+ \offinterlineskip
+ %
+ % OK, but now we have to do something about blank
+ % lines in the input in @example-like environments, which normally
+ % just turn into \lisppar, which will insert no space now that we've
+ % turned off the interline space. Simplest is to make them be an
+ % empty paragraph.
+ \ifx\par\lisppar
+ \edef\par{\leavevmode \par}%
+ %
+ % Reset ^^M's definition to new definition of \par.
+ \obeylines
+ \fi
+ %
+ % Do @comment since we are called inside an environment such as
+ % @example, where each end-of-line in the input causes an
+ % end-of-line in the output. We don't want the end-of-line after
+ % the `@group' to put extra space in the output. Since @group
+ % should appear on a line by itself (according to the Texinfo
+ % manual), we don't worry about eating any user text.
+ \comment
+}
+%
+% TeX puts in an \escapechar (i.e., `@') at the beginning of the help
+% message, so this ends up printing `@group can only ...'.
+%
+\newhelp\groupinvalidhelp{%
+group can only be used in environments such as @example,^^J%
+where each line of input produces a line of output.}
+
+% @need space-in-mils
+% forces a page break if there is not space-in-mils remaining.
+
+\newdimen\mil \mil=0.001in
+
+\def\need{\parsearg\needx}
+
+% Old definition--didn't work.
+%\def\needx #1{\par %
+%% This method tries to make TeX break the page naturally
+%% if the depth of the box does not fit.
+%{\baselineskip=0pt%
+%\vtop to #1\mil{\vfil}\kern -#1\mil\penalty 10000
+%\prevdepth=-1000pt
+%}}
+
+\def\needx#1{%
+ % Go into vertical mode, so we don't make a big box in the middle of a
+ % paragraph.
+ \par
+ %
+ % Don't add any leading before our big empty box, but allow a page
+ % break, since the best break might be right here.
+ \allowbreak
+ \nointerlineskip
+ \vtop to #1\mil{\vfil}%
+ %
+ % TeX does not even consider page breaks if a penalty added to the
+ % main vertical list is 10000 or more. But in order to see if the
+ % empty box we just added fits on the page, we must make it consider
+ % page breaks. On the other hand, we don't want to actually break the
+ % page after the empty box. So we use a penalty of 9999.
+ %
+ % There is an extremely small chance that TeX will actually break the
+ % page at this \penalty, if there are no other feasible breakpoints in
+ % sight. (If the user is using lots of big @group commands, which
+ % almost-but-not-quite fill up a page, TeX will have a hard time doing
+ % good page breaking, for example.) However, I could not construct an
+ % example where a page broke at this \penalty; if it happens in a real
+ % document, then we can reconsider our strategy.
+ \penalty9999
+ %
+ % Back up by the size of the box, whether we did a page break or not.
+ \kern -#1\mil
+ %
+ % Do not allow a page break right after this kern.
+ \nobreak
+}
+
+% @br forces paragraph break
+
+\let\br = \par
+
+% @dots{} output some dots
+
+\def\dots{$\ldots$}
+
+% @page forces the start of a new page
+
+\def\page{\par\vfill\supereject}
+
+% @exdent text....
+% outputs text on separate line in roman font, starting at standard page margin
+
+% This records the amount of indent in the innermost environment.
+% That's how much \exdent should take out.
+\newskip\exdentamount
+
+% This defn is used inside fill environments such as @defun.
+\def\exdent{\parsearg\exdentyyy}
+\def\exdentyyy #1{{\hfil\break\hbox{\kern -\exdentamount{\rm#1}}\hfil\break}}
+
+% This defn is used inside nofill environments such as @example.
+\def\nofillexdent{\parsearg\nofillexdentyyy}
+\def\nofillexdentyyy #1{{\advance \leftskip by -\exdentamount
+\leftline{\hskip\leftskip{\rm#1}}}}
+
+%\hbox{{\rm#1}}\hfil\break}}
+
+% @include file insert text of that file as input.
+
+\def\include{\parsearg\includezzz}
+%Use \input\thisfile to avoid blank after \input, which may be an active
+%char (in which case the blank would become the \input argument).
+%The grouping keeps the value of \thisfile correct even when @include
+%is nested.
+\def\includezzz #1{\begingroup
+\def\thisfile{#1}\input\thisfile
+\endgroup}
+
+\def\thisfile{}
+
+% @center line outputs that line, centered
+
+\def\center{\parsearg\centerzzz}
+\def\centerzzz #1{{\advance\hsize by -\leftskip
+\advance\hsize by -\rightskip
+\centerline{#1}}}
+
+% @sp n outputs n lines of vertical space
+
+\def\sp{\parsearg\spxxx}
+\def\spxxx #1{\par \vskip #1\baselineskip}
+
+% @comment ...line which is ignored...
+% @c is the same as @comment
+% @ignore ... @end ignore is another way to write a comment
+
+\def\comment{\catcode 64=\other \catcode 123=\other \catcode 125=\other%
+\parsearg \commentxxx}
+
+\def\commentxxx #1{\catcode 64=0 \catcode 123=1 \catcode 125=2 }
+
+\let\c=\comment
+
+% Prevent errors for section commands.
+% Used in @ignore and in failing conditionals.
+\def\ignoresections{%
+\let\chapter=\relax
+\let\unnumbered=\relax
+\let\top=\relax
+\let\unnumberedsec=\relax
+\let\unnumberedsection=\relax
+\let\unnumberedsubsec=\relax
+\let\unnumberedsubsection=\relax
+\let\unnumberedsubsubsec=\relax
+\let\unnumberedsubsubsection=\relax
+\let\section=\relax
+\let\subsec=\relax
+\let\subsubsec=\relax
+\let\subsection=\relax
+\let\subsubsection=\relax
+\let\appendix=\relax
+\let\appendixsec=\relax
+\let\appendixsection=\relax
+\let\appendixsubsec=\relax
+\let\appendixsubsection=\relax
+\let\appendixsubsubsec=\relax
+\let\appendixsubsubsection=\relax
+\let\contents=\relax
+\let\smallbook=\relax
+\let\titlepage=\relax
+}
+
+% Used in nested conditionals, where we have to parse the Texinfo source
+% and so want to turn off most commands, in case they are used
+% incorrectly.
+%
+\def\ignoremorecommands{%
+ \let\defcv = \relax
+ \let\deffn = \relax
+ \let\deffnx = \relax
+ \let\defindex = \relax
+ \let\defivar = \relax
+ \let\defmac = \relax
+ \let\defmethod = \relax
+ \let\defop = \relax
+ \let\defopt = \relax
+ \let\defspec = \relax
+ \let\deftp = \relax
+ \let\deftypefn = \relax
+ \let\deftypefun = \relax
+ \let\deftypevar = \relax
+ \let\deftypevr = \relax
+ \let\defun = \relax
+ \let\defvar = \relax
+ \let\defvr = \relax
+ \let\ref = \relax
+ \let\xref = \relax
+ \let\printindex = \relax
+ \let\pxref = \relax
+ \let\settitle = \relax
+ \let\include = \relax
+ \let\lowersections = \relax
+ \let\down = \relax
+ \let\raisesections = \relax
+ \let\up = \relax
+ \let\set = \relax
+ \let\clear = \relax
+ \let\item = \relax
+ \let\message = \relax
+}
+
+% Ignore @ignore ... @end ignore.
+%
+\def\ignore{\doignore{ignore}}
+
+% Also ignore @ifinfo, @ifhtml, @html, @menu, and @direntry text.
+%
+\def\ifinfo{\doignore{ifinfo}}
+\def\ifhtml{\doignore{ifhtml}}
+\def\html{\doignore{html}}
+\def\menu{\doignore{menu}}
+\def\direntry{\doignore{direntry}}
+
+% Ignore text until a line `@end #1'.
+%
+\def\doignore#1{\begingroup
+ % Don't complain about control sequences we have declared \outer.
+ \ignoresections
+ %
+ % Define a command to swallow text until we reach `@end #1'.
+ \long\def\doignoretext##1\end #1{\enddoignore}%
+ %
+ % Make sure that spaces turn into tokens that match what \doignoretext wants.
+ \catcode32 = 10
+ %
+ % And now expand that command.
+ \doignoretext
+}
+
+% What we do to finish off ignored text.
+%
+\def\enddoignore{\endgroup\ignorespaces}%
+
+\newif\ifwarnedobs\warnedobsfalse
+\def\obstexwarn{%
+ \ifwarnedobs\relax\else
+ % We need to warn folks that they may have trouble with TeX 3.0.
+ % This uses \immediate\write16 rather than \message to get newlines.
+ \immediate\write16{}
+ \immediate\write16{***WARNING*** for users of Unix TeX 3.0!}
+ \immediate\write16{This manual trips a bug in TeX version 3.0 (tex hangs).}
+ \immediate\write16{If you are running another version of TeX, relax.}
+ \immediate\write16{If you are running Unix TeX 3.0, kill this TeX process.}
+ \immediate\write16{ Then upgrade your TeX installation if you can.}
+ \immediate\write16{If you are stuck with version 3.0, run the}
+ \immediate\write16{ script ``tex3patch'' from the Texinfo distribution}
+ \immediate\write16{ to use a workaround.}
+ \immediate\write16{}
+ \warnedobstrue
+ \fi
+}
+
+% **In TeX 3.0, setting text in \nullfont hangs tex. For a
+% workaround (which requires the file ``dummy.tfm'' to be installed),
+% uncomment the following line:
+%%%%%\font\nullfont=dummy\let\obstexwarn=\relax
+
+% Ignore text, except that we keep track of conditional commands for
+% purposes of nesting, up to an `@end #1' command.
+%
+\def\nestedignore#1{%
+ \obstexwarn
+ % We must actually expand the ignored text to look for the @end
+ % command, so that nested ignore constructs work. Thus, we put the
+ % text into a \vbox and then do nothing with the result. To minimize
+ % the change of memory overflow, we follow the approach outlined on
+ % page 401 of the TeXbook: make the current font be a dummy font.
+ %
+ \setbox0 = \vbox\bgroup
+ % Don't complain about control sequences we have declared \outer.
+ \ignoresections
+ %
+ % Define `@end #1' to end the box, which will in turn undefine the
+ % @end command again.
+ \expandafter\def\csname E#1\endcsname{\egroup\ignorespaces}%
+ %
+ % We are going to be parsing Texinfo commands. Most cause no
+ % trouble when they are used incorrectly, but some commands do
+ % complicated argument parsing or otherwise get confused, so we
+ % undefine them.
+ %
+ % We can't do anything about stray @-signs, unfortunately;
+ % they'll produce `undefined control sequence' errors.
+ \ignoremorecommands
+ %
+ % Set the current font to be \nullfont, a TeX primitive, and define
+ % all the font commands to also use \nullfont. We don't use
+ % dummy.tfm, as suggested in the TeXbook, because not all sites
+ % might have that installed. Therefore, math mode will still
+ % produce output, but that should be an extremely small amount of
+ % stuff compared to the main input.
+ %
+ \nullfont
+ \let\tenrm = \nullfont \let\tenit = \nullfont \let\tensl = \nullfont
+ \let\tenbf = \nullfont \let\tentt = \nullfont \let\smallcaps = \nullfont
+ \let\tensf = \nullfont
+ % Similarly for index fonts (mostly for their use in
+ % smallexample)
+ \let\indrm = \nullfont \let\indit = \nullfont \let\indsl = \nullfont
+ \let\indbf = \nullfont \let\indtt = \nullfont \let\indsc = \nullfont
+ \let\indsf = \nullfont
+ %
+ % Don't complain when characters are missing from the fonts.
+ \tracinglostchars = 0
+ %
+ % Don't bother to do space factor calculations.
+ \frenchspacing
+ %
+ % Don't report underfull hboxes.
+ \hbadness = 10000
+ %
+ % Do minimal line-breaking.
+ \pretolerance = 10000
+ %
+ % Do not execute instructions in @tex
+ \def\tex{\doignore{tex}}
+}
+
+% @set VAR sets the variable VAR to an empty value.
+% @set VAR REST-OF-LINE sets VAR to the value REST-OF-LINE.
+%
+% Since we want to separate VAR from REST-OF-LINE (which might be
+% empty), we can't just use \parsearg; we have to insert a space of our
+% own to delimit the rest of the line, and then take it out again if we
+% didn't need it.
+%
+\def\set{\parsearg\setxxx}
+\def\setxxx#1{\setyyy#1 \endsetyyy}
+\def\setyyy#1 #2\endsetyyy{%
+ \def\temp{#2}%
+ \ifx\temp\empty \global\expandafter\let\csname SET#1\endcsname = \empty
+ \else \setzzz{#1}#2\endsetzzz % Remove the trailing space \setxxx inserted.
+ \fi
+}
+% Can't use \xdef to pre-expand #2 and save some time, since \temp or
+% \next or other control sequences that we've defined might get us into
+% an infinite loop. Consider `@set foo @cite{bar}'.
+\def\setzzz#1#2 \endsetzzz{\expandafter\gdef\csname SET#1\endcsname{#2}}
+
+% @clear VAR clears (i.e., unsets) the variable VAR.
+%
+\def\clear{\parsearg\clearxxx}
+\def\clearxxx#1{\global\expandafter\let\csname SET#1\endcsname=\relax}
+
+% @value{foo} gets the text saved in variable foo.
+%
+\def\value#1{\expandafter
+ \ifx\csname SET#1\endcsname\relax
+ {\{No value for ``#1''\}}
+ \else \csname SET#1\endcsname \fi}
+
+% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined
+% with @set.
+%
+\def\ifset{\parsearg\ifsetxxx}
+\def\ifsetxxx #1{%
+ \expandafter\ifx\csname SET#1\endcsname\relax
+ \expandafter\ifsetfail
+ \else
+ \expandafter\ifsetsucceed
+ \fi
+}
+\def\ifsetsucceed{\conditionalsucceed{ifset}}
+\def\ifsetfail{\nestedignore{ifset}}
+\defineunmatchedend{ifset}
+
+% @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been
+% defined with @set, or has been undefined with @clear.
+%
+\def\ifclear{\parsearg\ifclearxxx}
+\def\ifclearxxx #1{%
+ \expandafter\ifx\csname SET#1\endcsname\relax
+ \expandafter\ifclearsucceed
+ \else
+ \expandafter\ifclearfail
+ \fi
+}
+\def\ifclearsucceed{\conditionalsucceed{ifclear}}
+\def\ifclearfail{\nestedignore{ifclear}}
+\defineunmatchedend{ifclear}
+
+% @iftex always succeeds; we read the text following, through @end
+% iftex). But `@end iftex' should be valid only after an @iftex.
+%
+\def\iftex{\conditionalsucceed{iftex}}
+\defineunmatchedend{iftex}
+
+% We can't just want to start a group at @iftex (for example) and end it
+% at @end iftex, since then @set commands inside the conditional have no
+% effect (they'd get reverted at the end of the group). So we must
+% define \Eiftex to redefine itself to be its previous value. (We can't
+% just define it to fail again with an ``unmatched end'' error, since
+% the @ifset might be nested.)
+%
+\def\conditionalsucceed#1{%
+ \edef\temp{%
+ % Remember the current value of \E#1.
+ \let\nece{prevE#1} = \nece{E#1}%
+ %
+ % At the `@end #1', redefine \E#1 to be its previous value.
+ \def\nece{E#1}{\let\nece{E#1} = \nece{prevE#1}}%
+ }%
+ \temp
+}
+
+% We need to expand lots of \csname's, but we don't want to expand the
+% control sequences after we've constructed them.
+%
+\def\nece#1{\expandafter\noexpand\csname#1\endcsname}
+
+% @asis just yields its argument. Used with @table, for example.
+%
+\def\asis#1{#1}
+
+% @math means output in math mode.
+% We don't use $'s directly in the definition of \math because control
+% sequences like \math are expanded when the toc file is written. Then,
+% we read the toc file back, the $'s will be normal characters (as they
+% should be, according to the definition of Texinfo). So we must use a
+% control sequence to switch into and out of math mode.
+%
+% This isn't quite enough for @math to work properly in indices, but it
+% seems unlikely it will ever be needed there.
+%
+\let\implicitmath = $
+\def\math#1{\implicitmath #1\implicitmath}
+
+% @bullet and @minus need the same treatment as @math, just above.
+\def\bullet{\implicitmath\ptexbullet\implicitmath}
+\def\minus{\implicitmath-\implicitmath}
+
+\def\node{\ENVcheck\parsearg\nodezzz}
+\def\nodezzz#1{\nodexxx [#1,]}
+\def\nodexxx[#1,#2]{\gdef\lastnode{#1}}
+\let\nwnode=\node
+\let\lastnode=\relax
+
+\def\donoderef{\ifx\lastnode\relax\else
+\expandafter\expandafter\expandafter\setref{\lastnode}\fi
+\global\let\lastnode=\relax}
+
+\def\unnumbnoderef{\ifx\lastnode\relax\else
+\expandafter\expandafter\expandafter\unnumbsetref{\lastnode}\fi
+\global\let\lastnode=\relax}
+
+\def\appendixnoderef{\ifx\lastnode\relax\else
+\expandafter\expandafter\expandafter\appendixsetref{\lastnode}\fi
+\global\let\lastnode=\relax}
+
+\let\refill=\relax
+
+% @setfilename is done at the beginning of every texinfo file.
+% So open here the files we need to have open while reading the input.
+% This makes it possible to make a .fmt file for texinfo.
+\def\setfilename{%
+ \readauxfile
+ \opencontents
+ \openindices
+ \fixbackslash % Turn off hack to swallow `\input texinfo'.
+ \global\let\setfilename=\comment % Ignore extra @setfilename cmds.
+ \comment % Ignore the actual filename.
+}
+
+\outer\def\bye{\pagealignmacro\tracingstats=1\ptexend}
+
+\def\inforef #1{\inforefzzz #1,,,,**}
+\def\inforefzzz #1,#2,#3,#4**{\putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}},
+ node \samp{\ignorespaces#1{}}}
+
+\message{fonts,}
+
+% Font-change commands.
+
+% Texinfo supports the sans serif font style, which plain TeX does not.
+% So we set up a \sf analogous to plain's \rm, etc.
+\newfam\sffam
+\def\sf{\fam=\sffam \tensf}
+\let\li = \sf % Sometimes we call it \li, not \sf.
+
+%% Try out Computer Modern fonts at \magstephalf
+\let\mainmagstep=\magstephalf
+
+% Set the font macro #1 to the font named #2, adding on the
+% specified font prefix (normally `cm').
+\def\setfont#1#2{\font#1=\fontprefix#2}
+
+% Use cm as the default font prefix.
+% To specify the font prefix, you must define \fontprefix
+% before you read in texinfo.tex.
+\ifx\fontprefix\undefined
+\def\fontprefix{cm}
+\fi
+
+\ifx\bigger\relax
+\let\mainmagstep=\magstep1
+\setfont\textrm{r12}
+\setfont\texttt{tt12}
+\else
+\setfont\textrm{r10 scaled \mainmagstep}
+\setfont\texttt{tt10 scaled \mainmagstep}
+\fi
+% Instead of cmb10, you many want to use cmbx10.
+% cmbx10 is a prettier font on its own, but cmb10
+% looks better when embedded in a line with cmr10.
+\setfont\textbf{b10 scaled \mainmagstep}
+\setfont\textit{ti10 scaled \mainmagstep}
+\setfont\textsl{sl10 scaled \mainmagstep}
+\setfont\textsf{ss10 scaled \mainmagstep}
+\setfont\textsc{csc10 scaled \mainmagstep}
+\font\texti=cmmi10 scaled \mainmagstep
+\font\textsy=cmsy10 scaled \mainmagstep
+
+% A few fonts for @defun, etc.
+\setfont\defbf{bx10 scaled \magstep1} %was 1314
+\setfont\deftt{tt10 scaled \magstep1}
+\def\df{\let\tentt=\deftt \let\tenbf = \defbf \bf}
+
+% Fonts for indices and small examples.
+% We actually use the slanted font rather than the italic,
+% because texinfo normally uses the slanted fonts for that.
+% Do not make many font distinctions in general in the index, since they
+% aren't very useful.
+\setfont\ninett{tt9}
+\setfont\indrm{r9}
+\setfont\indit{sl9}
+\let\indsl=\indit
+\let\indtt=\ninett
+\let\indsf=\indrm
+\let\indbf=\indrm
+\setfont\indsc{csc10 at 9pt}
+\font\indi=cmmi9
+\font\indsy=cmsy9
+
+% Fonts for headings
+\setfont\chaprm{bx12 scaled \magstep2}
+\setfont\chapit{ti12 scaled \magstep2}
+\setfont\chapsl{sl12 scaled \magstep2}
+\setfont\chaptt{tt12 scaled \magstep2}
+\setfont\chapsf{ss12 scaled \magstep2}
+\let\chapbf=\chaprm
+\setfont\chapsc{csc10 scaled\magstep3}
+\font\chapi=cmmi12 scaled \magstep2
+\font\chapsy=cmsy10 scaled \magstep3
+
+\setfont\secrm{bx12 scaled \magstep1}
+\setfont\secit{ti12 scaled \magstep1}
+\setfont\secsl{sl12 scaled \magstep1}
+\setfont\sectt{tt12 scaled \magstep1}
+\setfont\secsf{ss12 scaled \magstep1}
+\setfont\secbf{bx12 scaled \magstep1}
+\setfont\secsc{csc10 scaled\magstep2}
+\font\seci=cmmi12 scaled \magstep1
+\font\secsy=cmsy10 scaled \magstep2
+
+% \setfont\ssecrm{bx10 scaled \magstep1} % This size an font looked bad.
+% \setfont\ssecit{cmti10 scaled \magstep1} % The letters were too crowded.
+% \setfont\ssecsl{sl10 scaled \magstep1}
+% \setfont\ssectt{tt10 scaled \magstep1}
+% \setfont\ssecsf{ss10 scaled \magstep1}
+
+%\setfont\ssecrm{b10 scaled 1315} % Note the use of cmb rather than cmbx.
+%\setfont\ssecit{ti10 scaled 1315} % Also, the size is a little larger than
+%\setfont\ssecsl{sl10 scaled 1315} % being scaled magstep1.
+%\setfont\ssectt{tt10 scaled 1315}
+%\setfont\ssecsf{ss10 scaled 1315}
+
+%\let\ssecbf=\ssecrm
+
+\setfont\ssecrm{bx12 scaled \magstephalf}
+\setfont\ssecit{ti12 scaled \magstephalf}
+\setfont\ssecsl{sl12 scaled \magstephalf}
+\setfont\ssectt{tt12 scaled \magstephalf}
+\setfont\ssecsf{ss12 scaled \magstephalf}
+\setfont\ssecbf{bx12 scaled \magstephalf}
+\setfont\ssecsc{csc10 scaled \magstep1}
+\font\sseci=cmmi12 scaled \magstephalf
+\font\ssecsy=cmsy10 scaled \magstep1
+% The smallcaps and symbol fonts should actually be scaled \magstep1.5,
+% but that is not a standard magnification.
+
+% Fonts for title page:
+\setfont\titlerm{bx12 scaled \magstep3}
+\let\authorrm = \secrm
+
+% In order for the font changes to affect most math symbols and letters,
+% we have to define the \textfont of the standard families. Since
+% texinfo doesn't allow for producing subscripts and superscripts, we
+% don't bother to reset \scriptfont and \scriptscriptfont (which would
+% also require loading a lot more fonts).
+%
+\def\resetmathfonts{%
+ \textfont0 = \tenrm \textfont1 = \teni \textfont2 = \tensy
+ \textfont\itfam = \tenit \textfont\slfam = \tensl \textfont\bffam = \tenbf
+ \textfont\ttfam = \tentt \textfont\sffam = \tensf
+}
+
+
+% The font-changing commands redefine the meanings of \tenSTYLE, instead
+% of just \STYLE. We do this so that font changes will continue to work
+% in math mode, where it is the current \fam that is relevant in most
+% cases, not the current. Plain TeX does, for example,
+% \def\bf{\fam=\bffam \tenbf} By redefining \tenbf, we obviate the need
+% to redefine \bf itself.
+\def\textfonts{%
+ \let\tenrm=\textrm \let\tenit=\textit \let\tensl=\textsl
+ \let\tenbf=\textbf \let\tentt=\texttt \let\smallcaps=\textsc
+ \let\tensf=\textsf \let\teni=\texti \let\tensy=\textsy
+ \resetmathfonts}
+\def\chapfonts{%
+ \let\tenrm=\chaprm \let\tenit=\chapit \let\tensl=\chapsl
+ \let\tenbf=\chapbf \let\tentt=\chaptt \let\smallcaps=\chapsc
+ \let\tensf=\chapsf \let\teni=\chapi \let\tensy=\chapsy
+ \resetmathfonts}
+\def\secfonts{%
+ \let\tenrm=\secrm \let\tenit=\secit \let\tensl=\secsl
+ \let\tenbf=\secbf \let\tentt=\sectt \let\smallcaps=\secsc
+ \let\tensf=\secsf \let\teni=\seci \let\tensy=\secsy
+ \resetmathfonts}
+\def\subsecfonts{%
+ \let\tenrm=\ssecrm \let\tenit=\ssecit \let\tensl=\ssecsl
+ \let\tenbf=\ssecbf \let\tentt=\ssectt \let\smallcaps=\ssecsc
+ \let\tensf=\ssecsf \let\teni=\sseci \let\tensy=\ssecsy
+ \resetmathfonts}
+\def\indexfonts{%
+ \let\tenrm=\indrm \let\tenit=\indit \let\tensl=\indsl
+ \let\tenbf=\indbf \let\tentt=\indtt \let\smallcaps=\indsc
+ \let\tensf=\indsf \let\teni=\indi \let\tensy=\indsy
+ \resetmathfonts}
+
+% Set up the default fonts, so we can use them for creating boxes.
+%
+\textfonts
+
+% Count depth in font-changes, for error checks
+\newcount\fontdepth \fontdepth=0
+
+% Fonts for short table of contents.
+\setfont\shortcontrm{r12}
+\setfont\shortcontbf{bx12}
+\setfont\shortcontsl{sl12}
+
+%% Add scribe-like font environments, plus @l for inline lisp (usually sans
+%% serif) and @ii for TeX italic
+
+% \smartitalic{ARG} outputs arg in italics, followed by an italic correction
+% unless the following character is such as not to need one.
+\def\smartitalicx{\ifx\next,\else\ifx\next-\else\ifx\next.\else\/\fi\fi\fi}
+\def\smartitalic#1{{\sl #1}\futurelet\next\smartitalicx}
+
+\let\i=\smartitalic
+\let\var=\smartitalic
+\let\dfn=\smartitalic
+\let\emph=\smartitalic
+\let\cite=\smartitalic
+
+\def\b#1{{\bf #1}}
+\let\strong=\b
+
+% We can't just use \exhyphenpenalty, because that only has effect at
+% the end of a paragraph. Restore normal hyphenation at the end of the
+% group within which \nohyphenation is presumably called.
+%
+\def\nohyphenation{\hyphenchar\font = -1 \aftergroup\restorehyphenation}
+\def\restorehyphenation{\hyphenchar\font = `- }
+
+\def\t#1{%
+ {\tt \nohyphenation \rawbackslash \frenchspacing #1}%
+ \null
+}
+\let\ttfont = \t
+%\def\samp #1{`{\tt \rawbackslash \frenchspacing #1}'\null}
+\def\samp #1{`\tclose{#1}'\null}
+\def\key #1{{\tt \nohyphenation \uppercase{#1}}\null}
+\def\ctrl #1{{\tt \rawbackslash \hat}#1}
+
+\let\file=\samp
+
+% @code is a modification of @t,
+% which makes spaces the same size as normal in the surrounding text.
+\def\tclose#1{%
+ {%
+ % Change normal interword space to be same as for the current font.
+ \spaceskip = \fontdimen2\font
+ %
+ % Switch to typewriter.
+ \tt
+ %
+ % But `\ ' produces the large typewriter interword space.
+ \def\ {{\spaceskip = 0pt{} }}%
+ %
+ % Turn off hyphenation.
+ \nohyphenation
+ %
+ \rawbackslash
+ \frenchspacing
+ #1%
+ }%
+ \null
+}
+
+% We *must* turn on hyphenation at `-' and `_' in \code.
+% Otherwise, it is too hard to avoid overful hboxes
+% in the Emacs manual, the Library manual, etc.
+
+% Unfortunately, TeX uses one parameter (\hyphenchar) to control
+% both hyphenation at - and hyphenation within words.
+% We must therefore turn them both off (\tclose does that)
+% and arrange explicitly to hyphenate an a dash.
+% -- rms.
+{
+\catcode`\-=\active
+\catcode`\_=\active
+\global\def\code{\begingroup \catcode`\-=\active \let-\codedash \catcode`\_=\active \let_\codeunder \codex}
+% The following is used by \doprintindex to insure that long function names
+% wrap around. It is necessary for - and _ to be active before the index is
+% read from the file, as \entry parses the arguments long before \code is
+% ever called. -- mycroft
+\global\def\indexbreaks{\catcode`\-=\active \let-\realdash \catcode`\_=\active \let_\realunder}
+}
+\def\realdash{-}
+\def\realunder{_}
+\def\codedash{-\discretionary{}{}{}}
+\def\codeunder{\normalunderscore\discretionary{}{}{}}
+\def\codex #1{\tclose{#1}\endgroup}
+
+%\let\exp=\tclose %Was temporary
+
+% @kbd is like @code, except that if the argument is just one @key command,
+% then @kbd has no effect.
+
+\def\xkey{\key}
+\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}%
+\ifx\one\xkey\ifx\threex\three \key{#2}%
+\else\tclose{\look}\fi
+\else\tclose{\look}\fi}
+
+% Typeset a dimension, e.g., `in' or `pt'. The only reason for the
+% argument is to make the input look right: @dmn{pt} instead of
+% @dmn{}pt.
+%
+\def\dmn#1{\thinspace #1}
+
+\def\kbd#1{\def\look{#1}\expandafter\kbdfoo\look??\par}
+
+\def\l#1{{\li #1}\null} %
+
+\def\r#1{{\rm #1}} % roman font
+% Use of \lowercase was suggested.
+\def\sc#1{{\smallcaps#1}} % smallcaps font
+\def\ii#1{{\it #1}} % italic font
+
+\message{page headings,}
+
+\newskip\titlepagetopglue \titlepagetopglue = 1.5in
+\newskip\titlepagebottomglue \titlepagebottomglue = 2pc
+
+% First the title page. Must do @settitle before @titlepage.
+\def\titlefont#1{{\titlerm #1}}
+
+\newif\ifseenauthor
+\newif\iffinishedtitlepage
+
+\def\shorttitlepage{\parsearg\shorttitlepagezzz}
+\def\shorttitlepagezzz #1{\begingroup\hbox{}\vskip 1.5in \chaprm \centerline{#1}%
+ \endgroup\page\hbox{}\page}
+
+\def\titlepage{\begingroup \parindent=0pt \textfonts
+ \let\subtitlerm=\tenrm
+% I deinstalled the following change because \cmr12 is undefined.
+% This change was not in the ChangeLog anyway. --rms.
+% \let\subtitlerm=\cmr12
+ \def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines}%
+ %
+ \def\authorfont{\authorrm \normalbaselineskip = 16pt \normalbaselines}%
+ %
+ % Leave some space at the very top of the page.
+ \vglue\titlepagetopglue
+ %
+ % Now you can print the title using @title.
+ \def\title{\parsearg\titlezzz}%
+ \def\titlezzz##1{\leftline{\titlefont{##1}}
+ % print a rule at the page bottom also.
+ \finishedtitlepagefalse
+ \vskip4pt \hrule height 4pt width \hsize \vskip4pt}%
+ % No rule at page bottom unless we print one at the top with @title.
+ \finishedtitlepagetrue
+ %
+ % Now you can put text using @subtitle.
+ \def\subtitle{\parsearg\subtitlezzz}%
+ \def\subtitlezzz##1{{\subtitlefont \rightline{##1}}}%
+ %
+ % @author should come last, but may come many times.
+ \def\author{\parsearg\authorzzz}%
+ \def\authorzzz##1{\ifseenauthor\else\vskip 0pt plus 1filll\seenauthortrue\fi
+ {\authorfont \leftline{##1}}}%
+ %
+ % Most title ``pages'' are actually two pages long, with space
+ % at the top of the second. We don't want the ragged left on the second.
+ \let\oldpage = \page
+ \def\page{%
+ \iffinishedtitlepage\else
+ \finishtitlepage
+ \fi
+ \oldpage
+ \let\page = \oldpage
+ \hbox{}}%
+% \def\page{\oldpage \hbox{}}
+}
+
+\def\Etitlepage{%
+ \iffinishedtitlepage\else
+ \finishtitlepage
+ \fi
+ % It is important to do the page break before ending the group,
+ % because the headline and footline are only empty inside the group.
+ % If we use the new definition of \page, we always get a blank page
+ % after the title page, which we certainly don't want.
+ \oldpage
+ \endgroup
+ \HEADINGSon
+}
+
+\def\finishtitlepage{%
+ \vskip4pt \hrule height 2pt width \hsize
+ \vskip\titlepagebottomglue
+ \finishedtitlepagetrue
+}
+
+%%% Set up page headings and footings.
+
+\let\thispage=\folio
+
+\newtoks \evenheadline % Token sequence for heading line of even pages
+\newtoks \oddheadline % Token sequence for heading line of odd pages
+\newtoks \evenfootline % Token sequence for footing line of even pages
+\newtoks \oddfootline % Token sequence for footing line of odd pages
+
+% Now make Tex use those variables
+\headline={{\textfonts\rm \ifodd\pageno \the\oddheadline
+ \else \the\evenheadline \fi}}
+\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline
+ \else \the\evenfootline \fi}\HEADINGShook}
+\let\HEADINGShook=\relax
+
+% Commands to set those variables.
+% For example, this is what @headings on does
+% @evenheading @thistitle|@thispage|@thischapter
+% @oddheading @thischapter|@thispage|@thistitle
+% @evenfooting @thisfile||
+% @oddfooting ||@thisfile
+
+\def\evenheading{\parsearg\evenheadingxxx}
+\def\oddheading{\parsearg\oddheadingxxx}
+\def\everyheading{\parsearg\everyheadingxxx}
+
+\def\evenfooting{\parsearg\evenfootingxxx}
+\def\oddfooting{\parsearg\oddfootingxxx}
+\def\everyfooting{\parsearg\everyfootingxxx}
+
+{\catcode`\@=0 %
+
+\gdef\evenheadingxxx #1{\evenheadingyyy #1@|@|@|@|\finish}
+\gdef\evenheadingyyy #1@|#2@|#3@|#4\finish{%
+\global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\gdef\oddheadingxxx #1{\oddheadingyyy #1@|@|@|@|\finish}
+\gdef\oddheadingyyy #1@|#2@|#3@|#4\finish{%
+\global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\gdef\everyheadingxxx #1{\everyheadingyyy #1@|@|@|@|\finish}
+\gdef\everyheadingyyy #1@|#2@|#3@|#4\finish{%
+\global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}
+\global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\gdef\evenfootingxxx #1{\evenfootingyyy #1@|@|@|@|\finish}
+\gdef\evenfootingyyy #1@|#2@|#3@|#4\finish{%
+\global\evenfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\gdef\oddfootingxxx #1{\oddfootingyyy #1@|@|@|@|\finish}
+\gdef\oddfootingyyy #1@|#2@|#3@|#4\finish{%
+\global\oddfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\gdef\everyfootingxxx #1{\everyfootingyyy #1@|@|@|@|\finish}
+\gdef\everyfootingyyy #1@|#2@|#3@|#4\finish{%
+\global\evenfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}
+\global\oddfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+%
+}% unbind the catcode of @.
+
+% @headings double turns headings on for double-sided printing.
+% @headings single turns headings on for single-sided printing.
+% @headings off turns them off.
+% @headings on same as @headings double, retained for compatibility.
+% @headings after turns on double-sided headings after this page.
+% @headings doubleafter turns on double-sided headings after this page.
+% @headings singleafter turns on single-sided headings after this page.
+% By default, they are off.
+
+\def\headings #1 {\csname HEADINGS#1\endcsname}
+
+\def\HEADINGSoff{
+\global\evenheadline={\hfil} \global\evenfootline={\hfil}
+\global\oddheadline={\hfil} \global\oddfootline={\hfil}}
+\HEADINGSoff
+% When we turn headings on, set the page number to 1.
+% For double-sided printing, put current file name in lower left corner,
+% chapter name on inside top of right hand pages, document
+% title on inside top of left hand pages, and page numbers on outside top
+% edge of all pages.
+\def\HEADINGSdouble{
+%\pagealignmacro
+\global\pageno=1
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\folio\hfil\thistitle}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+}
+% For single-sided printing, chapter title goes across top left of page,
+% page number on top right.
+\def\HEADINGSsingle{
+%\pagealignmacro
+\global\pageno=1
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\thischapter\hfil\folio}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+}
+\def\HEADINGSon{\HEADINGSdouble}
+
+\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex}
+\let\HEADINGSdoubleafter=\HEADINGSafter
+\def\HEADINGSdoublex{%
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\folio\hfil\thistitle}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+}
+
+\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex}
+\def\HEADINGSsinglex{%
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\thischapter\hfil\folio}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+}
+
+% Subroutines used in generating headings
+% Produces Day Month Year style of output.
+\def\today{\number\day\space
+\ifcase\month\or
+January\or February\or March\or April\or May\or June\or
+July\or August\or September\or October\or November\or December\fi
+\space\number\year}
+
+% Use this if you want the Month Day, Year style of output.
+%\def\today{\ifcase\month\or
+%January\or February\or March\or April\or May\or June\or
+%July\or August\or September\or October\or November\or December\fi
+%\space\number\day, \number\year}
+
+% @settitle line... specifies the title of the document, for headings
+% It generates no output of its own
+
+\def\thistitle{No Title}
+\def\settitle{\parsearg\settitlezzz}
+\def\settitlezzz #1{\gdef\thistitle{#1}}
+
+\message{tables,}
+
+% @tabs -- simple alignment
+
+% These don't work. For one thing, \+ is defined as outer.
+% So these macros cannot even be defined.
+
+%\def\tabs{\parsearg\tabszzz}
+%\def\tabszzz #1{\settabs\+#1\cr}
+%\def\tabline{\parsearg\tablinezzz}
+%\def\tablinezzz #1{\+#1\cr}
+%\def\&{&}
+
+% Tables -- @table, @ftable, @vtable, @item(x), @kitem(x), @xitem(x).
+
+% default indentation of table text
+\newdimen\tableindent \tableindent=.8in
+% default indentation of @itemize and @enumerate text
+\newdimen\itemindent \itemindent=.3in
+% margin between end of table item and start of table text.
+\newdimen\itemmargin \itemmargin=.1in
+
+% used internally for \itemindent minus \itemmargin
+\newdimen\itemmax
+
+% Note @table, @vtable, and @vtable define @item, @itemx, etc., with
+% these defs.
+% They also define \itemindex
+% to index the item name in whatever manner is desired (perhaps none).
+
+\newif\ifitemxneedsnegativevskip
+
+\def\itemxpar{\par\ifitemxneedsnegativevskip\vskip-\parskip\nobreak\fi}
+
+\def\internalBitem{\smallbreak \parsearg\itemzzz}
+\def\internalBitemx{\itemxpar \parsearg\itemzzz}
+
+\def\internalBxitem "#1"{\def\xitemsubtopix{#1} \smallbreak \parsearg\xitemzzz}
+\def\internalBxitemx "#1"{\def\xitemsubtopix{#1} \itemxpar \parsearg\xitemzzz}
+
+\def\internalBkitem{\smallbreak \parsearg\kitemzzz}
+\def\internalBkitemx{\itemxpar \parsearg\kitemzzz}
+
+\def\kitemzzz #1{\dosubind {kw}{\code{#1}}{for {\bf \lastfunction}}%
+ \itemzzz {#1}}
+
+\def\xitemzzz #1{\dosubind {kw}{\code{#1}}{for {\bf \xitemsubtopic}}%
+ \itemzzz {#1}}
+
+\def\itemzzz #1{\begingroup %
+ \advance\hsize by -\rightskip
+ \advance\hsize by -\tableindent
+ \setbox0=\hbox{\itemfont{#1}}%
+ \itemindex{#1}%
+ \nobreak % This prevents a break before @itemx.
+ %
+ % Be sure we are not still in the middle of a paragraph.
+ %{\parskip = 0in
+ %\par
+ %}%
+ %
+ % If the item text does not fit in the space we have, put it on a line
+ % by itself, and do not allow a page break either before or after that
+ % line. We do not start a paragraph here because then if the next
+ % command is, e.g., @kindex, the whatsit would get put into the
+ % horizontal list on a line by itself, resulting in extra blank space.
+ \ifdim \wd0>\itemmax
+ %
+ % Make this a paragraph so we get the \parskip glue and wrapping,
+ % but leave it ragged-right.
+ \begingroup
+ \advance\leftskip by-\tableindent
+ \advance\hsize by\tableindent
+ \advance\rightskip by0pt plus1fil
+ \leavevmode\unhbox0\par
+ \endgroup
+ %
+ % We're going to be starting a paragraph, but we don't want the
+ % \parskip glue -- logically it's part of the @item we just started.
+ \nobreak \vskip-\parskip
+ %
+ % Stop a page break at the \parskip glue coming up. Unfortunately
+ % we can't prevent a possible page break at the following
+ % \baselineskip glue.
+ \nobreak
+ \endgroup
+ \itemxneedsnegativevskipfalse
+ \else
+ % The item text fits into the space. Start a paragraph, so that the
+ % following text (if any) will end up on the same line. Since that
+ % text will be indented by \tableindent, we make the item text be in
+ % a zero-width box.
+ \noindent
+ \rlap{\hskip -\tableindent\box0}\ignorespaces%
+ \endgroup%
+ \itemxneedsnegativevskiptrue%
+ \fi
+}
+
+\def\item{\errmessage{@item while not in a table}}
+\def\itemx{\errmessage{@itemx while not in a table}}
+\def\kitem{\errmessage{@kitem while not in a table}}
+\def\kitemx{\errmessage{@kitemx while not in a table}}
+\def\xitem{\errmessage{@xitem while not in a table}}
+\def\xitemx{\errmessage{@xitemx while not in a table}}
+
+%% Contains a kludge to get @end[description] to work
+\def\description{\tablez{\dontindex}{1}{}{}{}{}}
+
+\def\table{\begingroup\inENV\obeylines\obeyspaces\tablex}
+{\obeylines\obeyspaces%
+\gdef\tablex #1^^M{%
+\tabley\dontindex#1 \endtabley}}
+
+\def\ftable{\begingroup\inENV\obeylines\obeyspaces\ftablex}
+{\obeylines\obeyspaces%
+\gdef\ftablex #1^^M{%
+\tabley\fnitemindex#1 \endtabley
+\def\Eftable{\endgraf\afterenvbreak\endgroup}%
+\let\Etable=\relax}}
+
+\def\vtable{\begingroup\inENV\obeylines\obeyspaces\vtablex}
+{\obeylines\obeyspaces%
+\gdef\vtablex #1^^M{%
+\tabley\vritemindex#1 \endtabley
+\def\Evtable{\endgraf\afterenvbreak\endgroup}%
+\let\Etable=\relax}}
+
+\def\dontindex #1{}
+\def\fnitemindex #1{\doind {fn}{\code{#1}}}%
+\def\vritemindex #1{\doind {vr}{\code{#1}}}%
+
+{\obeyspaces %
+\gdef\tabley#1#2 #3 #4 #5 #6 #7\endtabley{\endgroup%
+\tablez{#1}{#2}{#3}{#4}{#5}{#6}}}
+
+\def\tablez #1#2#3#4#5#6{%
+\aboveenvbreak %
+\begingroup %
+\def\Edescription{\Etable}% Neccessary kludge.
+\let\itemindex=#1%
+\ifnum 0#3>0 \advance \leftskip by #3\mil \fi %
+\ifnum 0#4>0 \tableindent=#4\mil \fi %
+\ifnum 0#5>0 \advance \rightskip by #5\mil \fi %
+\def\itemfont{#2}%
+\itemmax=\tableindent %
+\advance \itemmax by -\itemmargin %
+\advance \leftskip by \tableindent %
+\exdentamount=\tableindent
+\parindent = 0pt
+\parskip = \smallskipamount
+\ifdim \parskip=0pt \parskip=2pt \fi%
+\def\Etable{\endgraf\afterenvbreak\endgroup}%
+\let\item = \internalBitem %
+\let\itemx = \internalBitemx %
+\let\kitem = \internalBkitem %
+\let\kitemx = \internalBkitemx %
+\let\xitem = \internalBxitem %
+\let\xitemx = \internalBxitemx %
+}
+
+% This is the counter used by @enumerate, which is really @itemize
+
+\newcount \itemno
+
+\def\itemize{\parsearg\itemizezzz}
+
+\def\itemizezzz #1{%
+ \begingroup % ended by the @end itemsize
+ \itemizey {#1}{\Eitemize}
+}
+
+\def\itemizey #1#2{%
+\aboveenvbreak %
+\itemmax=\itemindent %
+\advance \itemmax by -\itemmargin %
+\advance \leftskip by \itemindent %
+\exdentamount=\itemindent
+\parindent = 0pt %
+\parskip = \smallskipamount %
+\ifdim \parskip=0pt \parskip=2pt \fi%
+\def#2{\endgraf\afterenvbreak\endgroup}%
+\def\itemcontents{#1}%
+\let\item=\itemizeitem}
+
+% Set sfcode to normal for the chars that usually have another value.
+% These are `.?!:;,'
+\def\frenchspacing{\sfcode46=1000 \sfcode63=1000 \sfcode33=1000
+ \sfcode58=1000 \sfcode59=1000 \sfcode44=1000 }
+
+% \splitoff TOKENS\endmark defines \first to be the first token in
+% TOKENS, and \rest to be the remainder.
+%
+\def\splitoff#1#2\endmark{\def\first{#1}\def\rest{#2}}%
+
+% Allow an optional argument of an uppercase letter, lowercase letter,
+% or number, to specify the first label in the enumerated list. No
+% argument is the same as `1'.
+%
+\def\enumerate{\parsearg\enumeratezzz}
+\def\enumeratezzz #1{\enumeratey #1 \endenumeratey}
+\def\enumeratey #1 #2\endenumeratey{%
+ \begingroup % ended by the @end enumerate
+ %
+ % If we were given no argument, pretend we were given `1'.
+ \def\thearg{#1}%
+ \ifx\thearg\empty \def\thearg{1}\fi
+ %
+ % Detect if the argument is a single token. If so, it might be a
+ % letter. Otherwise, the only valid thing it can be is a number.
+ % (We will always have one token, because of the test we just made.
+ % This is a good thing, since \splitoff doesn't work given nothing at
+ % all -- the first parameter is undelimited.)
+ \expandafter\splitoff\thearg\endmark
+ \ifx\rest\empty
+ % Only one token in the argument. It could still be anything.
+ % A ``lowercase letter'' is one whose \lccode is nonzero.
+ % An ``uppercase letter'' is one whose \lccode is both nonzero, and
+ % not equal to itself.
+ % Otherwise, we assume it's a number.
+ %
+ % We need the \relax at the end of the \ifnum lines to stop TeX from
+ % continuing to look for a <number>.
+ %
+ \ifnum\lccode\expandafter`\thearg=0\relax
+ \numericenumerate % a number (we hope)
+ \else
+ % It's a letter.
+ \ifnum\lccode\expandafter`\thearg=\expandafter`\thearg\relax
+ \lowercaseenumerate % lowercase letter
+ \else
+ \uppercaseenumerate % uppercase letter
+ \fi
+ \fi
+ \else
+ % Multiple tokens in the argument. We hope it's a number.
+ \numericenumerate
+ \fi
+}
+
+% An @enumerate whose labels are integers. The starting integer is
+% given in \thearg.
+%
+\def\numericenumerate{%
+ \itemno = \thearg
+ \startenumeration{\the\itemno}%
+}
+
+% The starting (lowercase) letter is in \thearg.
+\def\lowercaseenumerate{%
+ \itemno = \expandafter`\thearg
+ \startenumeration{%
+ % Be sure we're not beyond the end of the alphabet.
+ \ifnum\itemno=0
+ \errmessage{No more lowercase letters in @enumerate; get a bigger
+ alphabet}%
+ \fi
+ \char\lccode\itemno
+ }%
+}
+
+% The starting (uppercase) letter is in \thearg.
+\def\uppercaseenumerate{%
+ \itemno = \expandafter`\thearg
+ \startenumeration{%
+ % Be sure we're not beyond the end of the alphabet.
+ \ifnum\itemno=0
+ \errmessage{No more uppercase letters in @enumerate; get a bigger
+ alphabet}
+ \fi
+ \char\uccode\itemno
+ }%
+}
+
+% Call itemizey, adding a period to the first argument and supplying the
+% common last two arguments. Also subtract one from the initial value in
+% \itemno, since @item increments \itemno.
+%
+\def\startenumeration#1{%
+ \advance\itemno by -1
+ \itemizey{#1.}\Eenumerate\flushcr
+}
+
+% @alphaenumerate and @capsenumerate are abbreviations for giving an arg
+% to @enumerate.
+%
+\def\alphaenumerate{\enumerate{a}}
+\def\capsenumerate{\enumerate{A}}
+\def\Ealphaenumerate{\Eenumerate}
+\def\Ecapsenumerate{\Eenumerate}
+
+% Definition of @item while inside @itemize.
+
+\def\itemizeitem{%
+\advance\itemno by 1
+{\let\par=\endgraf \smallbreak}%
+\ifhmode \errmessage{\in hmode at itemizeitem}\fi
+{\parskip=0in \hskip 0pt
+\hbox to 0pt{\hss \itemcontents\hskip \itemmargin}%
+\vadjust{\penalty 1200}}%
+\flushcr}
+
+% @multitable macros
+% Amy Hendrickson, 8/18/94
+%
+% @multitable ... @endmultitable will make as many columns as desired.
+% Contents of each column will wrap at width given in preamble. Width
+% can be specified either with sample text given in a template line,
+% or in percent of \hsize, the current width of text on page.
+
+% Table can continue over pages but will only break between lines.
+
+% To make preamble:
+%
+% Either define widths of columns in terms of percent of \hsize:
+% @multitable @percentofhsize .2 .3 .5
+% @item ...
+%
+% Numbers following @percentofhsize are the percent of the total
+% current hsize to be used for each column. You may use as many
+% columns as desired.
+
+% Or use a template:
+% @multitable {Column 1 template} {Column 2 template} {Column 3 template}
+% @item ...
+% using the widest term desired in each column.
+
+
+% Each new table line starts with @item, each subsequent new column
+% starts with @tab. Empty columns may be produced by supplying @tab's
+% with nothing between them for as many times as empty columns are needed,
+% ie, @tab@tab@tab will produce two empty columns.
+
+% @item, @tab, @multicolumn or @endmulticolumn do not need to be on their
+% own lines, but it will not hurt if they are.
+
+% Sample multitable:
+
+% @multitable {Column 1 template} {Column 2 template} {Column 3 template}
+% @item first col stuff @tab second col stuff @tab third col
+% @item
+% first col stuff
+% @tab
+% second col stuff
+% @tab
+% third col
+% @item first col stuff @tab second col stuff
+% @tab Many paragraphs of text may be used in any column.
+%
+% They will wrap at the width determined by the template.
+% @item@tab@tab This will be in third column.
+% @endmultitable
+
+% Default dimensions may be reset by user.
+% @intableparskip will set vertical space between paragraphs in table.
+% @intableparindent will set paragraph indent in table.
+% @spacebetweencols will set horizontal space to be left between columns.
+% @spacebetweenlines will set vertical space to be left between lines.
+
+%%%%
+% Dimensions
+
+\newdimen\intableparskip
+\newdimen\intableparindent
+\newdimen\spacebetweencols
+\newdimen\spacebetweenlines
+\intableparskip=0pt
+\intableparindent=6pt
+\spacebetweencols=12pt
+\spacebetweenlines=12pt
+
+%%%%
+% Macros used to set up halign preamble:
+\let\endsetuptable\relax
+\def\xendsetuptable{\endsetuptable}
+\let\percentofhsize\relax
+\def\xpercentofhsize{\percentofhsize}
+\newif\ifsetpercent
+
+\newcount\colcount
+\def\setuptable#1{\def\firstarg{#1}%
+\ifx\firstarg\xendsetuptable\let\go\relax%
+\else
+ \ifx\firstarg\xpercentofhsize\global\setpercenttrue%
+ \else
+ \ifsetpercent
+ \if#1.\else%
+ \global\advance\colcount by1 %
+ \expandafter\xdef\csname col\the\colcount\endcsname{.#1\hsize}%
+ \fi
+ \else
+ \global\advance\colcount by1
+ \setbox0=\hbox{#1}%
+ \expandafter\xdef\csname col\the\colcount\endcsname{\the\wd0}%
+ \fi%
+ \fi%
+ \let\go\setuptable%
+\fi\go}
+%%%%
+% multitable syntax
+\def\tab{&}
+
+%%%%
+% @multitable ... @endmultitable definitions:
+
+\def\multitable#1\item{\bgroup
+\let\item\cr
+\tolerance=9500
+\hbadness=9500
+\parskip=\intableparskip
+\parindent=\intableparindent
+\overfullrule=0pt
+\global\colcount=0\relax%
+\def\Emultitable{\global\setpercentfalse\global\everycr{}\cr\egroup\egroup}%
+ % To parse everything between @multitable and @item :
+\def\one{#1}\expandafter\setuptable\one\endsetuptable
+ % Need to reset this to 0 after \setuptable.
+\global\colcount=0\relax%
+ %
+ % This preamble sets up a generic column definition, which will
+ % be used as many times as user calls for columns.
+ % \vtop will set a single line and will also let text wrap and
+ % continue for many paragraphs if desired.
+\halign\bgroup&\global\advance\colcount by 1\relax%
+\vtop{\hsize=\expandafter\csname col\the\colcount\endcsname
+ % In order to keep entries from bumping into each other
+ % we will add a \leftskip of \spacebetweencols to all columns after
+ % the first one.
+ % If a template has been used, we will add \spacebetweencols
+ % to the width of each template entry.
+ % If user has set preamble in terms of percent of \hsize
+ % we will use that dimension as the width of the column, and
+ % the \leftskip will keep entries from bumping into each other.
+ % Table will start at left margin and final column will justify at
+ % right margin.
+\ifnum\colcount=1
+\else
+ \ifsetpercent
+ \else
+ % If user has <not> set preamble in terms of percent of \hsize
+ % we will advance \hsize by \spacebetweencols
+ \advance\hsize by \spacebetweencols
+ \fi
+ % In either case we will make \leftskip=\spacebetweencols:
+\leftskip=\spacebetweencols
+\fi
+\noindent##}\cr%
+ % \everycr will reset column counter, \colcount, at the end of
+ % each line. Every column entry will cause \colcount to advance by one.
+ % The table preamble
+ % looks at the current \colcount to find the correct column width.
+\global\everycr{\noalign{\nointerlineskip\vskip\spacebetweenlines
+\filbreak%% keeps underfull box messages off when table breaks over pages.
+\global\colcount=0\relax}}}
+
+\message{indexing,}
+% Index generation facilities
+
+% Define \newwrite to be identical to plain tex's \newwrite
+% except not \outer, so it can be used within \newindex.
+{\catcode`\@=11
+\gdef\newwrite{\alloc@7\write\chardef\sixt@@n}}
+
+% \newindex {foo} defines an index named foo.
+% It automatically defines \fooindex such that
+% \fooindex ...rest of line... puts an entry in the index foo.
+% It also defines \fooindfile to be the number of the output channel for
+% the file that accumulates this index. The file's extension is foo.
+% The name of an index should be no more than 2 characters long
+% for the sake of vms.
+
+\def\newindex #1{
+\expandafter\newwrite \csname#1indfile\endcsname% Define number for output file
+\openout \csname#1indfile\endcsname \jobname.#1 % Open the file
+\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex
+\noexpand\doindex {#1}}
+}
+
+% @defindex foo == \newindex{foo}
+
+\def\defindex{\parsearg\newindex}
+
+% Define @defcodeindex, like @defindex except put all entries in @code.
+
+\def\newcodeindex #1{
+\expandafter\newwrite \csname#1indfile\endcsname% Define number for output file
+\openout \csname#1indfile\endcsname \jobname.#1 % Open the file
+\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex
+\noexpand\docodeindex {#1}}
+}
+
+\def\defcodeindex{\parsearg\newcodeindex}
+
+% @synindex foo bar makes index foo feed into index bar.
+% Do this instead of @defindex foo if you don't want it as a separate index.
+\def\synindex #1 #2 {%
+\expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname
+\expandafter\let\csname#1indfile\endcsname=\synindexfoo
+\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex
+\noexpand\doindex {#2}}%
+}
+
+% @syncodeindex foo bar similar, but put all entries made for index foo
+% inside @code.
+\def\syncodeindex #1 #2 {%
+\expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname
+\expandafter\let\csname#1indfile\endcsname=\synindexfoo
+\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex
+\noexpand\docodeindex {#2}}%
+}
+
+% Define \doindex, the driver for all \fooindex macros.
+% Argument #1 is generated by the calling \fooindex macro,
+% and it is "foo", the name of the index.
+
+% \doindex just uses \parsearg; it calls \doind for the actual work.
+% This is because \doind is more useful to call from other macros.
+
+% There is also \dosubind {index}{topic}{subtopic}
+% which makes an entry in a two-level index such as the operation index.
+
+\def\doindex#1{\edef\indexname{#1}\parsearg\singleindexer}
+\def\singleindexer #1{\doind{\indexname}{#1}}
+
+% like the previous two, but they put @code around the argument.
+\def\docodeindex#1{\edef\indexname{#1}\parsearg\singlecodeindexer}
+\def\singlecodeindexer #1{\doind{\indexname}{\code{#1}}}
+
+\def\indexdummies{%
+% Take care of the plain tex accent commands.
+\def\"{\realbackslash "}%
+\def\`{\realbackslash `}%
+\def\'{\realbackslash '}%
+\def\^{\realbackslash ^}%
+\def\~{\realbackslash ~}%
+\def\={\realbackslash =}%
+\def\b{\realbackslash b}%
+\def\c{\realbackslash c}%
+\def\d{\realbackslash d}%
+\def\u{\realbackslash u}%
+\def\v{\realbackslash v}%
+\def\H{\realbackslash H}%
+% Take care of the plain tex special European modified letters.
+\def\oe{\realbackslash oe}%
+\def\ae{\realbackslash ae}%
+\def\aa{\realbackslash aa}%
+\def\OE{\realbackslash OE}%
+\def\AE{\realbackslash AE}%
+\def\AA{\realbackslash AA}%
+\def\o{\realbackslash o}%
+\def\O{\realbackslash O}%
+\def\l{\realbackslash l}%
+\def\L{\realbackslash L}%
+\def\ss{\realbackslash ss}%
+% Take care of texinfo commands likely to appear in an index entry.
+\def\_{{\realbackslash _}}%
+\def\w{\realbackslash w }%
+\def\bf{\realbackslash bf }%
+\def\rm{\realbackslash rm }%
+\def\sl{\realbackslash sl }%
+\def\sf{\realbackslash sf}%
+\def\tt{\realbackslash tt}%
+\def\gtr{\realbackslash gtr}%
+\def\less{\realbackslash less}%
+\def\hat{\realbackslash hat}%
+\def\char{\realbackslash char}%
+\def\TeX{\realbackslash TeX}%
+\def\dots{\realbackslash dots }%
+\def\copyright{\realbackslash copyright }%
+\def\tclose##1{\realbackslash tclose {##1}}%
+\def\code##1{\realbackslash code {##1}}%
+\def\samp##1{\realbackslash samp {##1}}%
+\def\t##1{\realbackslash r {##1}}%
+\def\r##1{\realbackslash r {##1}}%
+\def\i##1{\realbackslash i {##1}}%
+\def\b##1{\realbackslash b {##1}}%
+\def\cite##1{\realbackslash cite {##1}}%
+\def\key##1{\realbackslash key {##1}}%
+\def\file##1{\realbackslash file {##1}}%
+\def\var##1{\realbackslash var {##1}}%
+\def\kbd##1{\realbackslash kbd {##1}}%
+\def\dfn##1{\realbackslash dfn {##1}}%
+\def\emph##1{\realbackslash emph {##1}}%
+}
+
+% \indexnofonts no-ops all font-change commands.
+% This is used when outputting the strings to sort the index by.
+\def\indexdummyfont#1{#1}
+\def\indexdummytex{TeX}
+\def\indexdummydots{...}
+
+\def\indexnofonts{%
+% Just ignore accents.
+\let\"=\indexdummyfont
+\let\`=\indexdummyfont
+\let\'=\indexdummyfont
+\let\^=\indexdummyfont
+\let\~=\indexdummyfont
+\let\==\indexdummyfont
+\let\b=\indexdummyfont
+\let\c=\indexdummyfont
+\let\d=\indexdummyfont
+\let\u=\indexdummyfont
+\let\v=\indexdummyfont
+\let\H=\indexdummyfont
+% Take care of the plain tex special European modified letters.
+\def\oe{oe}%
+\def\ae{ae}%
+\def\aa{aa}%
+\def\OE{OE}%
+\def\AE{AE}%
+\def\AA{AA}%
+\def\o{o}%
+\def\O{O}%
+\def\l{l}%
+\def\L{L}%
+\def\ss{ss}%
+\let\w=\indexdummyfont
+\let\t=\indexdummyfont
+\let\r=\indexdummyfont
+\let\i=\indexdummyfont
+\let\b=\indexdummyfont
+\let\emph=\indexdummyfont
+\let\strong=\indexdummyfont
+\let\cite=\indexdummyfont
+\let\sc=\indexdummyfont
+%Don't no-op \tt, since it isn't a user-level command
+% and is used in the definitions of the active chars like <, >, |...
+%\let\tt=\indexdummyfont
+\let\tclose=\indexdummyfont
+\let\code=\indexdummyfont
+\let\file=\indexdummyfont
+\let\samp=\indexdummyfont
+\let\kbd=\indexdummyfont
+\let\key=\indexdummyfont
+\let\var=\indexdummyfont
+\let\TeX=\indexdummytex
+\let\dots=\indexdummydots
+}
+
+% To define \realbackslash, we must make \ not be an escape.
+% We must first make another character (@) an escape
+% so we do not become unable to do a definition.
+
+{\catcode`\@=0 \catcode`\\=\other
+@gdef@realbackslash{\}}
+
+\let\indexbackslash=0 %overridden during \printindex.
+
+\let\SETmarginindex=\relax %initialize!
+% workhorse for all \fooindexes
+% #1 is name of index, #2 is stuff to put there
+\def\doind #1#2{%
+% Put the index entry in the margin if desired.
+\ifx\SETmarginindex\relax\else%
+\insert\margin{\hbox{\vrule height8pt depth3pt width0pt #2}}%
+\fi%
+{\count10=\lastpenalty %
+{\indexdummies % Must do this here, since \bf, etc expand at this stage
+\escapechar=`\\%
+{\let\folio=0% Expand all macros now EXCEPT \folio
+\def\rawbackslashxx{\indexbackslash}% \indexbackslash isn't defined now
+% so it will be output as is; and it will print as backslash in the indx.
+%
+% Now process the index-string once, with all font commands turned off,
+% to get the string to sort the index by.
+{\indexnofonts
+\xdef\temp1{#2}%
+}%
+% Now produce the complete index entry. We process the index-string again,
+% this time with font commands expanded, to get what to print in the index.
+\edef\temp{%
+\write \csname#1indfile\endcsname{%
+\realbackslash entry {\temp1}{\folio}{#2}}}%
+\temp }%
+}\penalty\count10}}
+
+\def\dosubind #1#2#3{%
+{\count10=\lastpenalty %
+{\indexdummies % Must do this here, since \bf, etc expand at this stage
+\escapechar=`\\%
+{\let\folio=0%
+\def\rawbackslashxx{\indexbackslash}%
+%
+% Now process the index-string once, with all font commands turned off,
+% to get the string to sort the index by.
+{\indexnofonts
+\xdef\temp1{#2 #3}%
+}%
+% Now produce the complete index entry. We process the index-string again,
+% this time with font commands expanded, to get what to print in the index.
+\edef\temp{%
+\write \csname#1indfile\endcsname{%
+\realbackslash entry {\temp1}{\folio}{#2}{#3}}}%
+\temp }%
+}\penalty\count10}}
+
+% The index entry written in the file actually looks like
+% \entry {sortstring}{page}{topic}
+% or
+% \entry {sortstring}{page}{topic}{subtopic}
+% The texindex program reads in these files and writes files
+% containing these kinds of lines:
+% \initial {c}
+% before the first topic whose initial is c
+% \entry {topic}{pagelist}
+% for a topic that is used without subtopics
+% \primary {topic}
+% for the beginning of a topic that is used with subtopics
+% \secondary {subtopic}{pagelist}
+% for each subtopic.
+
+% Define the user-accessible indexing commands
+% @findex, @vindex, @kindex, @cindex.
+
+\def\findex {\fnindex}
+\def\kindex {\kyindex}
+\def\cindex {\cpindex}
+\def\vindex {\vrindex}
+\def\tindex {\tpindex}
+\def\pindex {\pgindex}
+
+\def\cindexsub {\begingroup\obeylines\cindexsub}
+{\obeylines %
+\gdef\cindexsub "#1" #2^^M{\endgroup %
+\dosubind{cp}{#2}{#1}}}
+
+% Define the macros used in formatting output of the sorted index material.
+
+% This is what you call to cause a particular index to get printed.
+% Write
+% @unnumbered Function Index
+% @printindex fn
+
+\def\printindex{\parsearg\doprintindex}
+
+\def\doprintindex#1{%
+ \tex
+ \dobreak \chapheadingskip {10000}
+ \catcode`\%=\other\catcode`\&=\other\catcode`\#=\other
+ \catcode`\$=\other
+ \catcode`\~=\other
+ \indexbreaks
+ %
+ % The following don't help, since the chars were translated
+ % when the raw index was written, and their fonts were discarded
+ % due to \indexnofonts.
+ %\catcode`\"=\active
+ %\catcode`\^=\active
+ %\catcode`\_=\active
+ %\catcode`\|=\active
+ %\catcode`\<=\active
+ %\catcode`\>=\active
+ % %
+ \def\indexbackslash{\rawbackslashxx}
+ \indexfonts\rm \tolerance=9500 \advance\baselineskip -1pt
+ \begindoublecolumns
+ %
+ % See if the index file exists and is nonempty.
+ \openin 1 \jobname.#1s
+ \ifeof 1
+ % \enddoublecolumns gets confused if there is no text in the index,
+ % and it loses the chapter title and the aux file entries for the
+ % index. The easiest way to prevent this problem is to make sure
+ % there is some text.
+ (Index is nonexistent)
+ \else
+ %
+ % If the index file exists but is empty, then \openin leaves \ifeof
+ % false. We have to make TeX try to read something from the file, so
+ % it can discover if there is anything in it.
+ \read 1 to \temp
+ \ifeof 1
+ (Index is empty)
+ \else
+ \input \jobname.#1s
+ \fi
+ \fi
+ \closein 1
+ \enddoublecolumns
+ \Etex
+}
+
+% These macros are used by the sorted index file itself.
+% Change them to control the appearance of the index.
+
+% Same as \bigskipamount except no shrink.
+% \balancecolumns gets confused if there is any shrink.
+\newskip\initialskipamount \initialskipamount 12pt plus4pt
+
+\def\initial #1{%
+{\let\tentt=\sectt \let\tt=\sectt \let\sf=\sectt
+\ifdim\lastskip<\initialskipamount
+\removelastskip \penalty-200 \vskip \initialskipamount\fi
+\line{\secbf#1\hfill}\kern 2pt\penalty10000}}
+
+% This typesets a paragraph consisting of #1, dot leaders, and then #2
+% flush to the right margin. It is used for index and table of contents
+% entries. The paragraph is indented by \leftskip.
+%
+\def\entry #1#2{\begingroup
+ %
+ % Start a new paragraph if necessary, so our assignments below can't
+ % affect previous text.
+ \par
+ %
+ % Do not fill out the last line with white space.
+ \parfillskip = 0in
+ %
+ % No extra space above this paragraph.
+ \parskip = 0in
+ %
+ % Do not prefer a separate line ending with a hyphen to fewer lines.
+ \finalhyphendemerits = 0
+ %
+ % \hangindent is only relevant when the entry text and page number
+ % don't both fit on one line. In that case, bob suggests starting the
+ % dots pretty far over on the line. Unfortunately, a large
+ % indentation looks wrong when the entry text itself is broken across
+ % lines. So we use a small indentation and put up with long leaders.
+ %
+ % \hangafter is reset to 1 (which is the value we want) at the start
+ % of each paragraph, so we need not do anything with that.
+ \hangindent=2em
+ %
+ % When the entry text needs to be broken, just fill out the first line
+ % with blank space.
+ \rightskip = 0pt plus1fil
+ %
+ % Start a ``paragraph'' for the index entry so the line breaking
+ % parameters we've set above will have an effect.
+ \noindent
+ %
+ % Insert the text of the index entry. TeX will do line-breaking on it.
+ #1%
+ % The following is kluged to not output a line of dots in the index if
+ % there are no page numbers. The next person who breaks this will be
+ % cursed by a Unix daemon.
+ \def\tempa{{\rm }}%
+ \def\tempb{#2}%
+ \edef\tempc{\tempa}%
+ \edef\tempd{\tempb}%
+ \ifx\tempc\tempd\ \else%
+ %
+ % If we must, put the page number on a line of its own, and fill out
+ % this line with blank space. (The \hfil is overwhelmed with the
+ % fill leaders glue in \indexdotfill if the page number does fit.)
+ \hfil\penalty50
+ \null\nobreak\indexdotfill % Have leaders before the page number.
+ %
+ % The `\ ' here is removed by the implicit \unskip that TeX does as
+ % part of (the primitive) \par. Without it, a spurious underfull
+ % \hbox ensues.
+ \ #2% The page number ends the paragraph.
+ \fi%
+ \par
+\endgroup}
+
+% Like \dotfill except takes at least 1 em.
+\def\indexdotfill{\cleaders
+ \hbox{$\mathsurround=0pt \mkern1.5mu ${\it .}$ \mkern1.5mu$}\hskip 1em plus 1fill}
+
+\def\primary #1{\line{#1\hfil}}
+
+\newskip\secondaryindent \secondaryindent=0.5cm
+
+\def\secondary #1#2{
+{\parfillskip=0in \parskip=0in
+\hangindent =1in \hangafter=1
+\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\par
+}}
+
+%% Define two-column mode, which is used in indexes.
+%% Adapted from the TeXbook, page 416.
+\catcode `\@=11
+
+\newbox\partialpage
+
+\newdimen\doublecolumnhsize
+
+\def\begindoublecolumns{\begingroup
+ % Grab any single-column material above us.
+ \output = {\global\setbox\partialpage
+ =\vbox{\unvbox255\kern -\topskip \kern \baselineskip}}%
+ \eject
+ %
+ % Now switch to the double-column output routine.
+ \output={\doublecolumnout}%
+ %
+ % Change the page size parameters. We could do this once outside this
+ % routine, in each of @smallbook, @afourpaper, and the default 8.5x11
+ % format, but then we repeat the same computation. Repeating a couple
+ % of assignments once per index is clearly meaningless for the
+ % execution time, so we may as well do it once.
+ %
+ % First we halve the line length, less a little for the gutter between
+ % the columns. We compute the gutter based on the line length, so it
+ % changes automatically with the paper format. The magic constant
+ % below is chosen so that the gutter has the same value (well, +- <
+ % 1pt) as it did when we hard-coded it.
+ %
+ % We put the result in a separate register, \doublecolumhsize, so we
+ % can restore it in \pagesofar, after \hsize itself has (potentially)
+ % been clobbered.
+ %
+ \doublecolumnhsize = \hsize
+ \advance\doublecolumnhsize by -.04154\hsize
+ \divide\doublecolumnhsize by 2
+ \hsize = \doublecolumnhsize
+ %
+ % Double the \vsize as well. (We don't need a separate register here,
+ % since nobody clobbers \vsize.)
+ \vsize = 2\vsize
+ \doublecolumnpagegoal
+}
+
+\def\enddoublecolumns{\eject \endgroup \pagegoal=\vsize \unvbox\partialpage}
+
+\def\doublecolumnsplit{\splittopskip=\topskip \splitmaxdepth=\maxdepth
+ \global\dimen@=\pageheight \global\advance\dimen@ by-\ht\partialpage
+ \global\setbox1=\vsplit255 to\dimen@ \global\setbox0=\vbox{\unvbox1}
+ \global\setbox3=\vsplit255 to\dimen@ \global\setbox2=\vbox{\unvbox3}
+ \ifdim\ht0>\dimen@ \setbox255=\vbox{\unvbox0\unvbox2} \global\setbox255=\copy5 \fi
+ \ifdim\ht2>\dimen@ \setbox255=\vbox{\unvbox0\unvbox2} \global\setbox255=\copy5 \fi
+}
+\def\doublecolumnpagegoal{%
+ \dimen@=\vsize \advance\dimen@ by-2\ht\partialpage \global\pagegoal=\dimen@
+}
+\def\pagesofar{\unvbox\partialpage %
+ \hsize=\doublecolumnhsize % have to restore this since output routine
+ \wd0=\hsize \wd2=\hsize \hbox to\pagewidth{\box0\hfil\box2}}
+\def\doublecolumnout{%
+ \setbox5=\copy255
+ {\vbadness=10000 \doublecolumnsplit}
+ \ifvbox255
+ \setbox0=\vtop to\dimen@{\unvbox0}
+ \setbox2=\vtop to\dimen@{\unvbox2}
+ \onepageout\pagesofar \unvbox255 \penalty\outputpenalty
+ \else
+ \setbox0=\vbox{\unvbox5}
+ \ifvbox0
+ \dimen@=\ht0 \advance\dimen@ by\topskip \advance\dimen@ by-\baselineskip
+ \divide\dimen@ by2 \splittopskip=\topskip \splitmaxdepth=\maxdepth
+ {\vbadness=10000
+ \loop \global\setbox5=\copy0
+ \setbox1=\vsplit5 to\dimen@
+ \setbox3=\vsplit5 to\dimen@
+ \ifvbox5 \global\advance\dimen@ by1pt \repeat
+ \setbox0=\vbox to\dimen@{\unvbox1}
+ \setbox2=\vbox to\dimen@{\unvbox3}
+ \global\setbox\partialpage=\vbox{\pagesofar}
+ \doublecolumnpagegoal
+ }
+ \fi
+ \fi
+}
+
+\catcode `\@=\other
+\message{sectioning,}
+% Define chapters, sections, etc.
+
+\newcount \chapno
+\newcount \secno \secno=0
+\newcount \subsecno \subsecno=0
+\newcount \subsubsecno \subsubsecno=0
+
+% This counter is funny since it counts through charcodes of letters A, B, ...
+\newcount \appendixno \appendixno = `\@
+\def\appendixletter{\char\the\appendixno}
+
+\newwrite \contentsfile
+% This is called from \setfilename.
+\def\opencontents{\openout \contentsfile = \jobname.toc}
+
+% Each @chapter defines this as the name of the chapter.
+% page headings and footings can use it. @section does likewise
+
+\def\thischapter{} \def\thissection{}
+\def\seccheck#1{\if \pageno<0 %
+\errmessage{@#1 not allowed after generating table of contents}\fi
+%
+}
+
+\def\chapternofonts{%
+\let\rawbackslash=\relax%
+\let\frenchspacing=\relax%
+\def\result{\realbackslash result}
+\def\equiv{\realbackslash equiv}
+\def\expansion{\realbackslash expansion}
+\def\print{\realbackslash print}
+\def\TeX{\realbackslash TeX}
+\def\dots{\realbackslash dots}
+\def\copyright{\realbackslash copyright}
+\def\tt{\realbackslash tt}
+\def\bf{\realbackslash bf }
+\def\w{\realbackslash w}
+\def\less{\realbackslash less}
+\def\gtr{\realbackslash gtr}
+\def\hat{\realbackslash hat}
+\def\char{\realbackslash char}
+\def\tclose##1{\realbackslash tclose {##1}}
+\def\code##1{\realbackslash code {##1}}
+\def\samp##1{\realbackslash samp {##1}}
+\def\r##1{\realbackslash r {##1}}
+\def\b##1{\realbackslash b {##1}}
+\def\key##1{\realbackslash key {##1}}
+\def\file##1{\realbackslash file {##1}}
+\def\kbd##1{\realbackslash kbd {##1}}
+% These are redefined because @smartitalic wouldn't work inside xdef.
+\def\i##1{\realbackslash i {##1}}
+\def\cite##1{\realbackslash cite {##1}}
+\def\var##1{\realbackslash var {##1}}
+\def\emph##1{\realbackslash emph {##1}}
+\def\dfn##1{\realbackslash dfn {##1}}
+}
+
+\newcount\absseclevel % used to calculate proper heading level
+\newcount\secbase\secbase=0 % @raise/lowersections modify this count
+
+% @raisesections: treat @section as chapter, @subsection as section, etc.
+\def\raisesections{\global\advance\secbase by -1}
+\let\up=\raisesections % original BFox name
+
+% @lowersections: treat @chapter as section, @section as subsection, etc.
+\def\lowersections{\global\advance\secbase by 1}
+\let\down=\lowersections % original BFox name
+
+% Choose a numbered-heading macro
+% #1 is heading level if unmodified by @raisesections or @lowersections
+% #2 is text for heading
+\def\numhead#1#2{\absseclevel=\secbase\advance\absseclevel by #1
+\ifcase\absseclevel
+ \chapterzzz{#2}
+\or
+ \seczzz{#2}
+\or
+ \numberedsubseczzz{#2}
+\or
+ \numberedsubsubseczzz{#2}
+\else
+ \ifnum \absseclevel<0
+ \chapterzzz{#2}
+ \else
+ \numberedsubsubseczzz{#2}
+ \fi
+\fi
+}
+
+% like \numhead, but chooses appendix heading levels
+\def\apphead#1#2{\absseclevel=\secbase\advance\absseclevel by #1
+\ifcase\absseclevel
+ \appendixzzz{#2}
+\or
+ \appendixsectionzzz{#2}
+\or
+ \appendixsubseczzz{#2}
+\or
+ \appendixsubsubseczzz{#2}
+\else
+ \ifnum \absseclevel<0
+ \appendixzzz{#2}
+ \else
+ \appendixsubsubseczzz{#2}
+ \fi
+\fi
+}
+
+% like \numhead, but chooses numberless heading levels
+\def\unnmhead#1#2{\absseclevel=\secbase\advance\absseclevel by #1
+\ifcase\absseclevel
+ \unnumberedzzz{#2}
+\or
+ \unnumberedseczzz{#2}
+\or
+ \unnumberedsubseczzz{#2}
+\or
+ \unnumberedsubsubseczzz{#2}
+\else
+ \ifnum \absseclevel<0
+ \unnumberedzzz{#2}
+ \else
+ \unnumberedsubsubseczzz{#2}
+ \fi
+\fi
+}
+
+
+\def\thischaptername{No Chapter Title}
+\outer\def\chapter{\parsearg\chapteryyy}
+\def\chapteryyy #1{\numhead0{#1}} % normally numhead0 calls chapterzzz
+\def\chapterzzz #1{\seccheck{chapter}%
+\secno=0 \subsecno=0 \subsubsecno=0
+\global\advance \chapno by 1 \message{\putwordChapter \the\chapno}%
+\chapmacro {#1}{\the\chapno}%
+\gdef\thissection{#1}%
+\gdef\thischaptername{#1}%
+% We don't substitute the actual chapter name into \thischapter
+% because we don't want its macros evaluated now.
+\xdef\thischapter{\putwordChapter{} \the\chapno: \noexpand\thischaptername}%
+{\chapternofonts%
+\edef\temp{{\realbackslash chapentry {#1}{\the\chapno}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\donoderef %
+\global\let\section = \numberedsec
+\global\let\subsection = \numberedsubsec
+\global\let\subsubsection = \numberedsubsubsec
+}}
+
+\outer\def\appendix{\parsearg\appendixyyy}
+\def\appendixyyy #1{\apphead0{#1}} % normally apphead0 calls appendixzzz
+\def\appendixzzz #1{\seccheck{appendix}%
+\secno=0 \subsecno=0 \subsubsecno=0
+\global\advance \appendixno by 1 \message{Appendix \appendixletter}%
+\chapmacro {#1}{\putwordAppendix{} \appendixletter}%
+\gdef\thissection{#1}%
+\gdef\thischaptername{#1}%
+\xdef\thischapter{\putwordAppendix{} \appendixletter: \noexpand\thischaptername}%
+{\chapternofonts%
+\edef\temp{{\realbackslash chapentry
+ {#1}{\putwordAppendix{} \appendixletter}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\appendixnoderef %
+\global\let\section = \appendixsec
+\global\let\subsection = \appendixsubsec
+\global\let\subsubsection = \appendixsubsubsec
+}}
+
+\outer\def\top{\parsearg\unnumberedyyy}
+\outer\def\unnumbered{\parsearg\unnumberedyyy}
+\def\unnumberedyyy #1{\unnmhead0{#1}} % normally unnmhead0 calls unnumberedzzz
+\def\unnumberedzzz #1{\seccheck{unnumbered}%
+\secno=0 \subsecno=0 \subsubsecno=0
+%
+% This used to be simply \message{#1}, but TeX fully expands the
+% argument to \message. Therefore, if #1 contained @-commands, TeX
+% expanded them. For example, in `@unnumbered The @cite{Book}', TeX
+% expanded @cite (which turns out to cause errors because \cite is meant
+% to be executed, not expanded).
+%
+% Anyway, we don't want the fully-expanded definition of @cite to appear
+% as a result of the \message, we just want `@cite' itself. We use
+% \the<toks register> to achieve this: TeX expands \the<toks> only once,
+% simply yielding the contents of the <toks register>.
+\toks0 = {#1}\message{(\the\toks0)}%
+%
+\unnumbchapmacro {#1}%
+\gdef\thischapter{#1}\gdef\thissection{#1}%
+{\chapternofonts%
+\edef\temp{{\realbackslash unnumbchapentry {#1}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\unnumbnoderef %
+\global\let\section = \unnumberedsec
+\global\let\subsection = \unnumberedsubsec
+\global\let\subsubsection = \unnumberedsubsubsec
+}}
+
+\outer\def\numberedsec{\parsearg\secyyy}
+\def\secyyy #1{\numhead1{#1}} % normally calls seczzz
+\def\seczzz #1{\seccheck{section}%
+\subsecno=0 \subsubsecno=0 \global\advance \secno by 1 %
+\gdef\thissection{#1}\secheading {#1}{\the\chapno}{\the\secno}%
+{\chapternofonts%
+\edef\temp{{\realbackslash secentry %
+{#1}{\the\chapno}{\the\secno}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\donoderef %
+\penalty 10000 %
+}}
+
+\outer\def\appenixsection{\parsearg\appendixsecyyy}
+\outer\def\appendixsec{\parsearg\appendixsecyyy}
+\def\appendixsecyyy #1{\apphead1{#1}} % normally calls appendixsectionzzz
+\def\appendixsectionzzz #1{\seccheck{appendixsection}%
+\subsecno=0 \subsubsecno=0 \global\advance \secno by 1 %
+\gdef\thissection{#1}\secheading {#1}{\appendixletter}{\the\secno}%
+{\chapternofonts%
+\edef\temp{{\realbackslash secentry %
+{#1}{\appendixletter}{\the\secno}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\appendixnoderef %
+\penalty 10000 %
+}}
+
+\outer\def\unnumberedsec{\parsearg\unnumberedsecyyy}
+\def\unnumberedsecyyy #1{\unnmhead1{#1}} % normally calls unnumberedseczzz
+\def\unnumberedseczzz #1{\seccheck{unnumberedsec}%
+\plainsecheading {#1}\gdef\thissection{#1}%
+{\chapternofonts%
+\edef\temp{{\realbackslash unnumbsecentry{#1}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\unnumbnoderef %
+\penalty 10000 %
+}}
+
+\outer\def\numberedsubsec{\parsearg\numberedsubsecyyy}
+\def\numberedsubsecyyy #1{\numhead2{#1}} % normally calls numberedsubseczzz
+\def\numberedsubseczzz #1{\seccheck{subsection}%
+\gdef\thissection{#1}\subsubsecno=0 \global\advance \subsecno by 1 %
+\subsecheading {#1}{\the\chapno}{\the\secno}{\the\subsecno}%
+{\chapternofonts%
+\edef\temp{{\realbackslash subsecentry %
+{#1}{\the\chapno}{\the\secno}{\the\subsecno}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\donoderef %
+\penalty 10000 %
+}}
+
+\outer\def\appendixsubsec{\parsearg\appendixsubsecyyy}
+\def\appendixsubsecyyy #1{\apphead2{#1}} % normally calls appendixsubseczzz
+\def\appendixsubseczzz #1{\seccheck{appendixsubsec}%
+\gdef\thissection{#1}\subsubsecno=0 \global\advance \subsecno by 1 %
+\subsecheading {#1}{\appendixletter}{\the\secno}{\the\subsecno}%
+{\chapternofonts%
+\edef\temp{{\realbackslash subsecentry %
+{#1}{\appendixletter}{\the\secno}{\the\subsecno}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\appendixnoderef %
+\penalty 10000 %
+}}
+
+\outer\def\unnumberedsubsec{\parsearg\unnumberedsubsecyyy}
+\def\unnumberedsubsecyyy #1{\unnmhead2{#1}} %normally calls unnumberedsubseczzz
+\def\unnumberedsubseczzz #1{\seccheck{unnumberedsubsec}%
+\plainsecheading {#1}\gdef\thissection{#1}%
+{\chapternofonts%
+\edef\temp{{\realbackslash unnumbsubsecentry{#1}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\unnumbnoderef %
+\penalty 10000 %
+}}
+
+\outer\def\numberedsubsubsec{\parsearg\numberedsubsubsecyyy}
+\def\numberedsubsubsecyyy #1{\numhead3{#1}} % normally numberedsubsubseczzz
+\def\numberedsubsubseczzz #1{\seccheck{subsubsection}%
+\gdef\thissection{#1}\global\advance \subsubsecno by 1 %
+\subsubsecheading {#1}
+ {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno}%
+{\chapternofonts%
+\edef\temp{{\realbackslash subsubsecentry %
+ {#1}
+ {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno}
+ {\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\donoderef %
+\penalty 10000 %
+}}
+
+\outer\def\appendixsubsubsec{\parsearg\appendixsubsubsecyyy}
+\def\appendixsubsubsecyyy #1{\apphead3{#1}} % normally appendixsubsubseczzz
+\def\appendixsubsubseczzz #1{\seccheck{appendixsubsubsec}%
+\gdef\thissection{#1}\global\advance \subsubsecno by 1 %
+\subsubsecheading {#1}
+ {\appendixletter}{\the\secno}{\the\subsecno}{\the\subsubsecno}%
+{\chapternofonts%
+\edef\temp{{\realbackslash subsubsecentry{#1}%
+ {\appendixletter}
+ {\the\secno}{\the\subsecno}{\the\subsubsecno}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\appendixnoderef %
+\penalty 10000 %
+}}
+
+\outer\def\unnumberedsubsubsec{\parsearg\unnumberedsubsubsecyyy}
+\def\unnumberedsubsubsecyyy #1{\unnmhead3{#1}} %normally unnumberedsubsubseczzz
+\def\unnumberedsubsubseczzz #1{\seccheck{unnumberedsubsubsec}%
+\plainsecheading {#1}\gdef\thissection{#1}%
+{\chapternofonts%
+\edef\temp{{\realbackslash unnumbsubsubsecentry{#1}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\unnumbnoderef %
+\penalty 10000 %
+}}
+
+% These are variants which are not "outer", so they can appear in @ifinfo.
+% Actually, they should now be obsolete; ordinary section commands should work.
+\def\infotop{\parsearg\unnumberedzzz}
+\def\infounnumbered{\parsearg\unnumberedzzz}
+\def\infounnumberedsec{\parsearg\unnumberedseczzz}
+\def\infounnumberedsubsec{\parsearg\unnumberedsubseczzz}
+\def\infounnumberedsubsubsec{\parsearg\unnumberedsubsubseczzz}
+
+\def\infoappendix{\parsearg\appendixzzz}
+\def\infoappendixsec{\parsearg\appendixseczzz}
+\def\infoappendixsubsec{\parsearg\appendixsubseczzz}
+\def\infoappendixsubsubsec{\parsearg\appendixsubsubseczzz}
+
+\def\infochapter{\parsearg\chapterzzz}
+\def\infosection{\parsearg\sectionzzz}
+\def\infosubsection{\parsearg\subsectionzzz}
+\def\infosubsubsection{\parsearg\subsubsectionzzz}
+
+% These macros control what the section commands do, according
+% to what kind of chapter we are in (ordinary, appendix, or unnumbered).
+% Define them by default for a numbered chapter.
+\global\let\section = \numberedsec
+\global\let\subsection = \numberedsubsec
+\global\let\subsubsection = \numberedsubsubsec
+
+% Define @majorheading, @heading and @subheading
+
+% NOTE on use of \vbox for chapter headings, section headings, and
+% such:
+% 1) We use \vbox rather than the earlier \line to permit
+% overlong headings to fold.
+% 2) \hyphenpenalty is set to 10000 because hyphenation in a
+% heading is obnoxious; this forbids it.
+% 3) Likewise, headings look best if no \parindent is used, and
+% if justification is not attempted. Hence \raggedright.
+
+
+\def\majorheading{\parsearg\majorheadingzzz}
+\def\majorheadingzzz #1{%
+{\advance\chapheadingskip by 10pt \chapbreak }%
+{\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+ \parindent=0pt\raggedright
+ \rm #1\hfill}}\bigskip \par\penalty 200}
+
+\def\chapheading{\parsearg\chapheadingzzz}
+\def\chapheadingzzz #1{\chapbreak %
+{\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+ \parindent=0pt\raggedright
+ \rm #1\hfill}}\bigskip \par\penalty 200}
+
+\def\heading{\parsearg\secheadingi}
+
+\def\subheading{\parsearg\subsecheadingi}
+
+\def\subsubheading{\parsearg\subsubsecheadingi}
+
+% These macros generate a chapter, section, etc. heading only
+% (including whitespace, linebreaking, etc. around it),
+% given all the information in convenient, parsed form.
+
+%%% Args are the skip and penalty (usually negative)
+\def\dobreak#1#2{\par\ifdim\lastskip<#1\removelastskip\penalty#2\vskip#1\fi}
+
+\def\setchapterstyle #1 {\csname CHAPF#1\endcsname}
+
+%%% Define plain chapter starts, and page on/off switching for it
+% Parameter controlling skip before chapter headings (if needed)
+
+\newskip \chapheadingskip \chapheadingskip = 30pt plus 8pt minus 4pt
+
+\def\chapbreak{\dobreak \chapheadingskip {-4000}}
+\def\chappager{\par\vfill\supereject}
+\def\chapoddpage{\chappager \ifodd\pageno \else \hbox to 0pt{} \chappager\fi}
+
+\def\setchapternewpage #1 {\csname CHAPPAG#1\endcsname}
+
+\def\CHAPPAGoff{
+\global\let\pchapsepmacro=\chapbreak
+\global\let\pagealignmacro=\chappager}
+
+\def\CHAPPAGon{
+\global\let\pchapsepmacro=\chappager
+\global\let\pagealignmacro=\chappager
+\global\def\HEADINGSon{\HEADINGSsingle}}
+
+\def\CHAPPAGodd{
+\global\let\pchapsepmacro=\chapoddpage
+\global\let\pagealignmacro=\chapoddpage
+\global\def\HEADINGSon{\HEADINGSdouble}}
+
+\CHAPPAGon
+
+\def\CHAPFplain{
+\global\let\chapmacro=\chfplain
+\global\let\unnumbchapmacro=\unnchfplain}
+
+\def\chfplain #1#2{%
+ \pchapsepmacro
+ {%
+ \chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+ \parindent=0pt\raggedright
+ \rm #2\enspace #1}%
+ }%
+ \bigskip
+ \penalty5000
+}
+
+\def\unnchfplain #1{%
+\pchapsepmacro %
+{\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+ \parindent=0pt\raggedright
+ \rm #1\hfill}}\bigskip \par\penalty 10000 %
+}
+\CHAPFplain % The default
+
+\def\unnchfopen #1{%
+\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+ \parindent=0pt\raggedright
+ \rm #1\hfill}}\bigskip \par\penalty 10000 %
+}
+
+\def\chfopen #1#2{\chapoddpage {\chapfonts
+\vbox to 3in{\vfil \hbox to\hsize{\hfil #2} \hbox to\hsize{\hfil #1} \vfil}}%
+\par\penalty 5000 %
+}
+
+\def\CHAPFopen{
+\global\let\chapmacro=\chfopen
+\global\let\unnumbchapmacro=\unnchfopen}
+
+% Parameter controlling skip before section headings.
+
+% was 17pt plus 8pt minus 4pt
+\newskip \subsecheadingskip \subsecheadingskip = 0pt plus 4pt minus 4pt
+\def\subsecheadingbreak{\dobreak \subsecheadingskip {-500}}
+
+% was 21pt plus 8pt minus 4pt
+\newskip \secheadingskip \secheadingskip = 0pt plus 4pt minus 4pt
+\def\secheadingbreak{\dobreak \secheadingskip {-1000}}
+
+% @paragraphindent is defined for the Info formatting commands only.
+\let\paragraphindent=\comment
+
+% Section fonts are the base font at magstep2, which produces
+% a size a bit more than 14 points in the default situation.
+
+\def\secheading #1#2#3{\secheadingi {#2.#3\enspace #1}}
+\def\plainsecheading #1{\secheadingi {#1}}
+\def\secheadingi #1{{\advance \secheadingskip by \parskip %
+\secheadingbreak}%
+{\secfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+ \parindent=0pt\raggedright
+ \rm #1\hfill}}%
+\ifdim \parskip<10pt \kern 10pt\kern -\parskip\fi \penalty 10000 }
+
+
+% Subsection fonts are the base font at magstep1,
+% which produces a size of 12 points.
+
+\def\subsecheading #1#2#3#4{\subsecheadingi {#2.#3.#4\enspace #1}}
+\def\subsecheadingi #1{{\advance \subsecheadingskip by \parskip %
+\subsecheadingbreak}%
+{\subsecfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+ \parindent=0pt\raggedright
+ \rm #1\hfill}}%
+\ifdim \parskip<10pt \kern 10pt\kern -\parskip\fi \penalty 10000 }
+
+\def\subsubsecfonts{\subsecfonts} % Maybe this should change:
+ % Perhaps make sssec fonts scaled
+ % magstep half
+\def\subsubsecheading #1#2#3#4#5{\subsubsecheadingi {#2.#3.#4.#5\enspace #1}}
+\def\subsubsecheadingi #1{{\advance \subsecheadingskip by \parskip %
+\subsecheadingbreak}%
+{\subsubsecfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+ \parindent=0pt\raggedright
+ \rm #1\hfill}}%
+\ifdim \parskip<10pt \kern 10pt\kern -\parskip\fi \penalty 10000}
+
+
+\message{toc printing,}
+
+% Finish up the main text and prepare to read what we've written
+% to \contentsfile.
+
+\newskip\contentsrightmargin \contentsrightmargin=1in
+\def\startcontents#1{%
+ \pagealignmacro
+ \immediate\closeout \contentsfile
+ \ifnum \pageno>0
+ \pageno = -1 % Request roman numbered pages.
+ \fi
+ % Don't need to put `Contents' or `Short Contents' in the headline.
+ % It is abundantly clear what they are.
+ \unnumbchapmacro{#1}\def\thischapter{}%
+ \begingroup % Set up to handle contents files properly.
+ \catcode`\\=0 \catcode`\{=1 \catcode`\}=2 \catcode`\@=11
+ \catcode`\^=7 % to see ^^e4 as \"a etc. juha@piuha.ydi.vtt.fi
+ \raggedbottom % Worry more about breakpoints than the bottom.
+ \advance\hsize by -\contentsrightmargin % Don't use the full line length.
+}
+
+
+% Normal (long) toc.
+\outer\def\contents{%
+ \startcontents{\putwordTableofContents}%
+ \input \jobname.toc
+ \endgroup
+ \vfill \eject
+}
+
+% And just the chapters.
+\outer\def\summarycontents{%
+ \startcontents{\putwordShortContents}%
+ %
+ \let\chapentry = \shortchapentry
+ \let\unnumbchapentry = \shortunnumberedentry
+ % We want a true roman here for the page numbers.
+ \secfonts
+ \let\rm=\shortcontrm \let\bf=\shortcontbf \let\sl=\shortcontsl
+ \rm
+ \advance\baselineskip by 1pt % Open it up a little.
+ \def\secentry ##1##2##3##4{}
+ \def\unnumbsecentry ##1##2{}
+ \def\subsecentry ##1##2##3##4##5{}
+ \def\unnumbsubsecentry ##1##2{}
+ \def\subsubsecentry ##1##2##3##4##5##6{}
+ \def\unnumbsubsubsecentry ##1##2{}
+ \input \jobname.toc
+ \endgroup
+ \vfill \eject
+}
+\let\shortcontents = \summarycontents
+
+% These macros generate individual entries in the table of contents.
+% The first argument is the chapter or section name.
+% The last argument is the page number.
+% The arguments in between are the chapter number, section number, ...
+
+% Chapter-level things, for both the long and short contents.
+\def\chapentry#1#2#3{\dochapentry{#2\labelspace#1}{#3}}
+
+% See comments in \dochapentry re vbox and related settings
+\def\shortchapentry#1#2#3{%
+ \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno{#3}}%
+}
+
+% Typeset the label for a chapter or appendix for the short contents.
+% The arg is, e.g. `Appendix A' for an appendix, or `3' for a chapter.
+% We could simplify the code here by writing out an \appendixentry
+% command in the toc file for appendices, instead of using \chapentry
+% for both, but it doesn't seem worth it.
+\setbox0 = \hbox{\shortcontrm \putwordAppendix }
+\newdimen\shortappendixwidth \shortappendixwidth = \wd0
+
+\def\shortchaplabel#1{%
+ % We typeset #1 in a box of constant width, regardless of the text of
+ % #1, so the chapter titles will come out aligned.
+ \setbox0 = \hbox{#1}%
+ \dimen0 = \ifdim\wd0 > \shortappendixwidth \shortappendixwidth \else 0pt \fi
+ %
+ % This space should be plenty, since a single number is .5em, and the
+ % widest letter (M) is 1em, at least in the Computer Modern fonts.
+ % (This space doesn't include the extra space that gets added after
+ % the label; that gets put in in \shortchapentry above.)
+ \advance\dimen0 by 1.1em
+ \hbox to \dimen0{#1\hfil}%
+}
+
+\def\unnumbchapentry#1#2{\dochapentry{#1}{#2}}
+\def\shortunnumberedentry#1#2{\tocentry{#1}{\doshortpageno{#2}}}
+
+% Sections.
+\def\secentry#1#2#3#4{\dosecentry{#2.#3\labelspace#1}{#4}}
+\def\unnumbsecentry#1#2{\dosecentry{#1}{#2}}
+
+% Subsections.
+\def\subsecentry#1#2#3#4#5{\dosubsecentry{#2.#3.#4\labelspace#1}{#5}}
+\def\unnumbsubsecentry#1#2{\dosubsecentry{#1}{#2}}
+
+% And subsubsections.
+\def\subsubsecentry#1#2#3#4#5#6{%
+ \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}{#6}}
+\def\unnumbsubsubsecentry#1#2{\dosubsubsecentry{#1}{#2}}
+
+
+% This parameter controls the indentation of the various levels.
+\newdimen\tocindent \tocindent = 3pc
+
+% Now for the actual typesetting. In all these, #1 is the text and #2 is the
+% page number.
+%
+% If the toc has to be broken over pages, we would want to be at chapters
+% if at all possible; hence the \penalty.
+\def\dochapentry#1#2{%
+ \penalty-300 \vskip\baselineskip
+ \begingroup
+ \chapentryfonts
+ \tocentry{#1}{\dopageno{#2}}%
+ \endgroup
+ \nobreak\vskip .25\baselineskip
+}
+
+\def\dosecentry#1#2{\begingroup
+ \secentryfonts \leftskip=\tocindent
+ \tocentry{#1}{\dopageno{#2}}%
+\endgroup}
+
+\def\dosubsecentry#1#2{\begingroup
+ \subsecentryfonts \leftskip=2\tocindent
+ \tocentry{#1}{\dopageno{#2}}%
+\endgroup}
+
+\def\dosubsubsecentry#1#2{\begingroup
+ \subsubsecentryfonts \leftskip=3\tocindent
+ \tocentry{#1}{\dopageno{#2}}%
+\endgroup}
+
+% Final typesetting of a toc entry; we use the same \entry macro as for
+% the index entries, but we want to suppress hyphenation here. (We
+% can't do that in the \entry macro, since index entries might consist
+% of hyphenated-identifiers-that-do-not-fit-on-a-line-and-nothing-else.)
+%
+\def\tocentry#1#2{\begingroup
+ \hyphenpenalty = 10000
+ \entry{#1}{#2}%
+\endgroup}
+
+% Space between chapter (or whatever) number and the title.
+\def\labelspace{\hskip1em \relax}
+
+\def\dopageno#1{{\rm #1}}
+\def\doshortpageno#1{{\rm #1}}
+
+\def\chapentryfonts{\secfonts \rm}
+\def\secentryfonts{\textfonts}
+\let\subsecentryfonts = \textfonts
+\let\subsubsecentryfonts = \textfonts
+
+
+\message{environments,}
+
+% Since these characters are used in examples, it should be an even number of
+% \tt widths. Each \tt character is 1en, so two makes it 1em.
+% Furthermore, these definitions must come after we define our fonts.
+\newbox\dblarrowbox \newbox\longdblarrowbox
+\newbox\pushcharbox \newbox\bullbox
+\newbox\equivbox \newbox\errorbox
+
+\let\ptexequiv = \equiv
+
+%{\tentt
+%\global\setbox\dblarrowbox = \hbox to 1em{\hfil$\Rightarrow$\hfil}
+%\global\setbox\longdblarrowbox = \hbox to 1em{\hfil$\mapsto$\hfil}
+%\global\setbox\pushcharbox = \hbox to 1em{\hfil$\dashv$\hfil}
+%\global\setbox\equivbox = \hbox to 1em{\hfil$\ptexequiv$\hfil}
+% Adapted from the manmac format (p.420 of TeXbook)
+%\global\setbox\bullbox = \hbox to 1em{\kern.15em\vrule height .75ex width .85ex
+% depth .1ex\hfil}
+%}
+
+\def\point{$\star$}
+
+\def\result{\leavevmode\raise.15ex\hbox to 1em{\hfil$\Rightarrow$\hfil}}
+\def\expansion{\leavevmode\raise.1ex\hbox to 1em{\hfil$\mapsto$\hfil}}
+\def\print{\leavevmode\lower.1ex\hbox to 1em{\hfil$\dashv$\hfil}}
+
+\def\equiv{\leavevmode\lower.1ex\hbox to 1em{\hfil$\ptexequiv$\hfil}}
+
+% Adapted from the TeXbook's \boxit.
+{\tentt \global\dimen0 = 3em}% Width of the box.
+\dimen2 = .55pt % Thickness of rules
+% The text. (`r' is open on the right, `e' somewhat less so on the left.)
+\setbox0 = \hbox{\kern-.75pt \tensf error\kern-1.5pt}
+
+\global\setbox\errorbox=\hbox to \dimen0{\hfil
+ \hsize = \dimen0 \advance\hsize by -5.8pt % Space to left+right.
+ \advance\hsize by -2\dimen2 % Rules.
+ \vbox{
+ \hrule height\dimen2
+ \hbox{\vrule width\dimen2 \kern3pt % Space to left of text.
+ \vtop{\kern2.4pt \box0 \kern2.4pt}% Space above/below.
+ \kern3pt\vrule width\dimen2}% Space to right.
+ \hrule height\dimen2}
+ \hfil}
+
+% The @error{} command.
+\def\error{\leavevmode\lower.7ex\copy\errorbox}
+
+% @tex ... @end tex escapes into raw Tex temporarily.
+% One exception: @ is still an escape character, so that @end tex works.
+% But \@ or @@ will get a plain tex @ character.
+
+\def\tex{\begingroup
+\catcode `\\=0 \catcode `\{=1 \catcode `\}=2
+\catcode `\$=3 \catcode `\&=4 \catcode `\#=6
+\catcode `\^=7 \catcode `\_=8 \catcode `\~=13 \let~=\tie
+\catcode `\%=14
+\catcode 43=12
+\catcode`\"=12
+\catcode`\==12
+\catcode`\|=12
+\catcode`\<=12
+\catcode`\>=12
+\escapechar=`\\
+%
+\let\~=\ptextilde
+\let\{=\ptexlbrace
+\let\}=\ptexrbrace
+\let\.=\ptexdot
+\let\*=\ptexstar
+\let\dots=\ptexdots
+\def\@{@}%
+\let\bullet=\ptexbullet
+\let\b=\ptexb \let\c=\ptexc \let\i=\ptexi \let\t=\ptext \let\l=\ptexl
+\let\L=\ptexL
+%
+\let\Etex=\endgroup}
+
+% Define @lisp ... @endlisp.
+% @lisp does a \begingroup so it can rebind things,
+% including the definition of @endlisp (which normally is erroneous).
+
+% Amount to narrow the margins by for @lisp.
+\newskip\lispnarrowing \lispnarrowing=0.4in
+
+% This is the definition that ^^M gets inside @lisp, @example, and other
+% such environments. \null is better than a space, since it doesn't
+% have any width.
+\def\lisppar{\null\endgraf}
+
+% Make each space character in the input produce a normal interword
+% space in the output. Don't allow a line break at this space, as this
+% is used only in environments like @example, where each line of input
+% should produce a line of output anyway.
+%
+{\obeyspaces %
+\gdef\sepspaces{\obeyspaces\let =\tie}}
+
+% Define \obeyedspace to be our active space, whatever it is. This is
+% for use in \parsearg.
+{\sepspaces%
+\global\let\obeyedspace= }
+
+% This space is always present above and below environments.
+\newskip\envskipamount \envskipamount = 0pt
+
+% Make spacing and below environment symmetrical. We use \parskip here
+% to help in doing that, since in @example-like environments \parskip
+% is reset to zero; thus the \afterenvbreak inserts no space -- but the
+% start of the next paragraph will insert \parskip
+%
+\def\aboveenvbreak{{\advance\envskipamount by \parskip
+\endgraf \ifdim\lastskip<\envskipamount
+\removelastskip \penalty-50 \vskip\envskipamount \fi}}
+
+\let\afterenvbreak = \aboveenvbreak
+
+% \nonarrowing is a flag. If "set", @lisp etc don't narrow margins.
+\let\nonarrowing=\relax
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% \cartouche: draw rectangle w/rounded corners around argument
+\font\circle=lcircle10
+\newdimen\circthick
+\newdimen\cartouter\newdimen\cartinner
+\newskip\normbskip\newskip\normpskip\newskip\normlskip
+\circthick=\fontdimen8\circle
+%
+\def\ctl{{\circle\char'013\hskip -6pt}}% 6pt from pl file: 1/2charwidth
+\def\ctr{{\hskip 6pt\circle\char'010}}
+\def\cbl{{\circle\char'012\hskip -6pt}}
+\def\cbr{{\hskip 6pt\circle\char'011}}
+\def\carttop{\hbox to \cartouter{\hskip\lskip
+ \ctl\leaders\hrule height\circthick\hfil\ctr
+ \hskip\rskip}}
+\def\cartbot{\hbox to \cartouter{\hskip\lskip
+ \cbl\leaders\hrule height\circthick\hfil\cbr
+ \hskip\rskip}}
+%
+\newskip\lskip\newskip\rskip
+
+\long\def\cartouche{%
+\begingroup
+ \lskip=\leftskip \rskip=\rightskip
+ \leftskip=0pt\rightskip=0pt %we want these *outside*.
+ \cartinner=\hsize \advance\cartinner by-\lskip
+ \advance\cartinner by-\rskip
+ \cartouter=\hsize
+ \advance\cartouter by 18pt % allow for 3pt kerns on either
+% side, and for 6pt waste from
+% each corner char
+ \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip
+ % Flag to tell @lisp, etc., not to narrow margin.
+ \let\nonarrowing=\comment
+ \vbox\bgroup
+ \baselineskip=0pt\parskip=0pt\lineskip=0pt
+ \carttop
+ \hbox\bgroup
+ \hskip\lskip
+ \vrule\kern3pt
+ \vbox\bgroup
+ \hsize=\cartinner
+ \kern3pt
+ \begingroup
+ \baselineskip=\normbskip
+ \lineskip=\normlskip
+ \parskip=\normpskip
+ \vskip -\parskip
+\def\Ecartouche{%
+ \endgroup
+ \kern3pt
+ \egroup
+ \kern3pt\vrule
+ \hskip\rskip
+ \egroup
+ \cartbot
+ \egroup
+\endgroup
+}}
+
+
+% This macro is called at the beginning of all the @example variants,
+% inside a group.
+\def\nonfillstart{%
+ \aboveenvbreak
+ \inENV % This group ends at the end of the body
+ \hfuzz = 12pt % Don't be fussy
+ \sepspaces % Make spaces be word-separators rather than space tokens.
+ \singlespace
+ \let\par = \lisppar % don't ignore blank lines
+ \obeylines % each line of input is a line of output
+ \parskip = 0pt
+ \parindent = 0pt
+ \emergencystretch = 0pt % don't try to avoid overfull boxes
+ % @cartouche defines \nonarrowing to inhibit narrowing
+ % at next level down.
+ \ifx\nonarrowing\relax
+ \advance \leftskip by \lispnarrowing
+ \exdentamount=\lispnarrowing
+ \let\exdent=\nofillexdent
+ \let\nonarrowing=\relax
+ \fi
+}
+
+% To ending an @example-like environment, we first end the paragraph
+% (via \afterenvbreak's vertical glue), and then the group. That way we
+% keep the zero \parskip that the environments set -- \parskip glue
+% will be inserted at the beginning of the next paragraph in the
+% document, after the environment.
+%
+\def\nonfillfinish{\afterenvbreak\endgroup}%
+
+% This macro is
+\def\lisp{\begingroup
+ \nonfillstart
+ \let\Elisp = \nonfillfinish
+ \tt
+ \rawbackslash % have \ input char produce \ char from current font
+ \gobble
+}
+
+% Define the \E... control sequence only if we are inside the
+% environment, so the error checking in \end will work.
+%
+% We must call \lisp last in the definition, since it reads the
+% return following the @example (or whatever) command.
+%
+\def\example{\begingroup \def\Eexample{\nonfillfinish\endgroup}\lisp}
+\def\smallexample{\begingroup \def\Esmallexample{\nonfillfinish\endgroup}\lisp}
+\def\smalllisp{\begingroup \def\Esmalllisp{\nonfillfinish\endgroup}\lisp}
+
+% @smallexample and @smalllisp. This is not used unless the @smallbook
+% command is given. Originally contributed by Pavel@xerox.
+%
+\def\smalllispx{\begingroup
+ \nonfillstart
+ \let\Esmalllisp = \nonfillfinish
+ \let\Esmallexample = \nonfillfinish
+ %
+ % Smaller interline space and fonts for small examples.
+ \setleading{10pt}%
+ \indexfonts \tt
+ \rawbackslash % make \ output the \ character from the current font (tt)
+ \gobble
+}
+
+% This is @display; same as @lisp except use roman font.
+%
+\def\display{\begingroup
+ \nonfillstart
+ \let\Edisplay = \nonfillfinish
+ \gobble
+}
+
+% This is @format; same as @display except don't narrow margins.
+%
+\def\format{\begingroup
+ \let\nonarrowing = t
+ \nonfillstart
+ \let\Eformat = \nonfillfinish
+ \gobble
+}
+
+% @flushleft (same as @format) and @flushright.
+%
+\def\flushleft{\begingroup
+ \let\nonarrowing = t
+ \nonfillstart
+ \let\Eflushleft = \nonfillfinish
+ \gobble
+}
+\def\flushright{\begingroup
+ \let\nonarrowing = t
+ \nonfillstart
+ \let\Eflushright = \nonfillfinish
+ \advance\leftskip by 0pt plus 1fill
+ \gobble}
+
+% @quotation does normal linebreaking (hence we can't use \nonfillstart)
+% and narrows the margins.
+%
+\def\quotation{%
+ \begingroup\inENV %This group ends at the end of the @quotation body
+ {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip
+ \singlespace
+ \parindent=0pt
+ % We have retained a nonzero parskip for the environment, since we're
+ % doing normal filling. So to avoid extra space below the environment...
+ \def\Equotation{\parskip = 0pt \nonfillfinish}%
+ %
+ % @cartouche defines \nonarrowing to inhibit narrowing at next level down.
+ \ifx\nonarrowing\relax
+ \advance\leftskip by \lispnarrowing
+ \advance\rightskip by \lispnarrowing
+ \exdentamount = \lispnarrowing
+ \let\nonarrowing = \relax
+ \fi
+}
+
+\message{defuns,}
+% Define formatter for defuns
+% First, allow user to change definition object font (\df) internally
+\def\setdeffont #1 {\csname DEF#1\endcsname}
+
+\newskip\defbodyindent \defbodyindent=.4in
+\newskip\defargsindent \defargsindent=50pt
+\newskip\deftypemargin \deftypemargin=12pt
+\newskip\deflastargmargin \deflastargmargin=18pt
+
+\newcount\parencount
+% define \functionparens, which makes ( and ) and & do special things.
+% \functionparens affects the group it is contained in.
+\def\activeparens{%
+\catcode`\(=\active \catcode`\)=\active \catcode`\&=\active
+\catcode`\[=\active \catcode`\]=\active}
+
+% Make control sequences which act like normal parenthesis chars.
+\let\lparen = ( \let\rparen = )
+
+{\activeparens % Now, smart parens don't turn on until &foo (see \amprm)
+
+% Be sure that we always have a definition for `(', etc. For example,
+% if the fn name has parens in it, \boldbrax will not be in effect yet,
+% so TeX would otherwise complain about undefined control sequence.
+\global\let(=\lparen \global\let)=\rparen
+\global\let[=\lbrack \global\let]=\rbrack
+
+\gdef\functionparens{\boldbrax\let&=\amprm\parencount=0 }
+\gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb}
+% This is used to turn on special parens
+% but make & act ordinary (given that it's active).
+\gdef\boldbraxnoamp{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb\let&=\ampnr}
+
+% Definitions of (, ) and & used in args for functions.
+% This is the definition of ( outside of all parentheses.
+\gdef\oprm#1 {{\rm\char`\(}#1 \bf \let(=\opnested %
+\global\advance\parencount by 1 }
+%
+% This is the definition of ( when already inside a level of parens.
+\gdef\opnested{\char`\(\global\advance\parencount by 1 }
+%
+\gdef\clrm{% Print a paren in roman if it is taking us back to depth of 0.
+% also in that case restore the outer-level definition of (.
+\ifnum \parencount=1 {\rm \char `\)}\sl \let(=\oprm \else \char `\) \fi
+\global\advance \parencount by -1 }
+% If we encounter &foo, then turn on ()-hacking afterwards
+\gdef\amprm#1 {{\rm\}\let(=\oprm \let)=\clrm\ }
+%
+\gdef\normalparens{\boldbrax\let&=\ampnr}
+} % End of definition inside \activeparens
+%% These parens (in \boldbrax) actually are a little bolder than the
+%% contained text. This is especially needed for [ and ]
+\def\opnr{{\sf\char`\(}} \def\clnr{{\sf\char`\)}} \def\ampnr{\&}
+\def\lbrb{{\bf\char`\[}} \def\rbrb{{\bf\char`\]}}
+
+% First, defname, which formats the header line itself.
+% #1 should be the function name.
+% #2 should be the type of definition, such as "Function".
+
+\def\defname #1#2{%
+% Get the values of \leftskip and \rightskip as they were
+% outside the @def...
+\dimen2=\leftskip
+\advance\dimen2 by -\defbodyindent
+\dimen3=\rightskip
+\advance\dimen3 by -\defbodyindent
+\noindent %
+\setbox0=\hbox{\hskip \deflastargmargin{\rm #2}\hskip \deftypemargin}%
+\dimen0=\hsize \advance \dimen0 by -\wd0 % compute size for first line
+\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuations
+\parshape 2 0in \dimen0 \defargsindent \dimen1 %
+% Now output arg 2 ("Function" or some such)
+% ending at \deftypemargin from the right margin,
+% but stuck inside a box of width 0 so it does not interfere with linebreaking
+{% Adjust \hsize to exclude the ambient margins,
+% so that \rightline will obey them.
+\advance \hsize by -\dimen2 \advance \hsize by -\dimen3
+\rlap{\rightline{{\rm #2}\hskip \deftypemargin}}}%
+% Make all lines underfull and no complaints:
+\tolerance=10000 \hbadness=10000
+\advance\leftskip by -\defbodyindent
+\exdentamount=\defbodyindent
+{\df #1}\enskip % Generate function name
+}
+
+% Actually process the body of a definition
+% #1 should be the terminating control sequence, such as \Edefun.
+% #2 should be the "another name" control sequence, such as \defunx.
+% #3 should be the control sequence that actually processes the header,
+% such as \defunheader.
+
+\def\defparsebody #1#2#3{\begingroup\inENV% Environment for definitionbody
+\medbreak %
+% Define the end token that this defining construct specifies
+% so that it will exit this group.
+\def#1{\endgraf\endgroup\medbreak}%
+\def#2{\begingroup\obeylines\activeparens\spacesplit#3}%
+\parindent=0in
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent
+\exdentamount=\defbodyindent
+\begingroup %
+\catcode 61=\active % 61 is `='
+\obeylines\activeparens\spacesplit#3}
+
+\def\defmethparsebody #1#2#3#4 {\begingroup\inENV %
+\medbreak %
+% Define the end token that this defining construct specifies
+% so that it will exit this group.
+\def#1{\endgraf\endgroup\medbreak}%
+\def#2##1 {\begingroup\obeylines\activeparens\spacesplit{#3{##1}}}%
+\parindent=0in
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent
+\exdentamount=\defbodyindent
+\begingroup\obeylines\activeparens\spacesplit{#3{#4}}}
+
+\def\defopparsebody #1#2#3#4#5 {\begingroup\inENV %
+\medbreak %
+% Define the end token that this defining construct specifies
+% so that it will exit this group.
+\def#1{\endgraf\endgroup\medbreak}%
+\def#2##1 ##2 {\def#4{##1}%
+\begingroup\obeylines\activeparens\spacesplit{#3{##2}}}%
+\parindent=0in
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent
+\exdentamount=\defbodyindent
+\begingroup\obeylines\activeparens\spacesplit{#3{#5}}}
+
+% These parsing functions are similar to the preceding ones
+% except that they do not make parens into active characters.
+% These are used for "variables" since they have no arguments.
+
+\def\defvarparsebody #1#2#3{\begingroup\inENV% Environment for definitionbody
+\medbreak %
+% Define the end token that this defining construct specifies
+% so that it will exit this group.
+\def#1{\endgraf\endgroup\medbreak}%
+\def#2{\begingroup\obeylines\spacesplit#3}%
+\parindent=0in
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent
+\exdentamount=\defbodyindent
+\begingroup %
+\catcode 61=\active %
+\obeylines\spacesplit#3}
+
+% This is used for \def{tp,vr}parsebody. It could probably be used for
+% some of the others, too, with some judicious conditionals.
+%
+\def\parsebodycommon#1#2#3{%
+ \begingroup\inENV %
+ \medbreak %
+ % Define the end token that this defining construct specifies
+ % so that it will exit this group.
+ \def#1{\endgraf\endgroup\medbreak}%
+ \def#2##1 {\begingroup\obeylines\spacesplit{#3{##1}}}%
+ \parindent=0in
+ \advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent
+ \exdentamount=\defbodyindent
+ \begingroup\obeylines
+}
+
+\def\defvrparsebody#1#2#3#4 {%
+ \parsebodycommon{#1}{#2}{#3}%
+ \spacesplit{#3{#4}}%
+}
+
+% This loses on `@deftp {Data Type} {struct termios}' -- it thinks the
+% type is just `struct', because we lose the braces in `{struct
+% termios}' when \spacesplit reads its undelimited argument. Sigh.
+% \let\deftpparsebody=\defvrparsebody
+%
+% So, to get around this, we put \empty in with the type name. That
+% way, TeX won't find exactly `{...}' as an undelimited argument, and
+% won't strip off the braces.
+%
+\def\deftpparsebody #1#2#3#4 {%
+ \parsebodycommon{#1}{#2}{#3}%
+ \spacesplit{\parsetpheaderline{#3{#4}}}\empty
+}
+
+% Fine, but then we have to eventually remove the \empty *and* the
+% braces (if any). That's what this does, putting the result in \tptemp.
+%
+\def\removeemptybraces\empty#1\relax{\def\tptemp{#1}}%
+
+% After \spacesplit has done its work, this is called -- #1 is the final
+% thing to call, #2 the type name (which starts with \empty), and #3
+% (which might be empty) the arguments.
+%
+\def\parsetpheaderline#1#2#3{%
+ \removeemptybraces#2\relax
+ #1{\tptemp}{#3}%
+}%
+
+\def\defopvarparsebody #1#2#3#4#5 {\begingroup\inENV %
+\medbreak %
+% Define the end token that this defining construct specifies
+% so that it will exit this group.
+\def#1{\endgraf\endgroup\medbreak}%
+\def#2##1 ##2 {\def#4{##1}%
+\begingroup\obeylines\spacesplit{#3{##2}}}%
+\parindent=0in
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent
+\exdentamount=\defbodyindent
+\begingroup\obeylines\spacesplit{#3{#5}}}
+
+% Split up #2 at the first space token.
+% call #1 with two arguments:
+% the first is all of #2 before the space token,
+% the second is all of #2 after that space token.
+% If #2 contains no space token, all of it is passed as the first arg
+% and the second is passed as empty.
+
+{\obeylines
+\gdef\spacesplit#1#2^^M{\endgroup\spacesplitfoo{#1}#2 \relax\spacesplitfoo}%
+\long\gdef\spacesplitfoo#1#2 #3#4\spacesplitfoo{%
+\ifx\relax #3%
+#1{#2}{}\else #1{#2}{#3#4}\fi}}
+
+% So much for the things common to all kinds of definitions.
+
+% Define @defun.
+
+% First, define the processing that is wanted for arguments of \defun
+% Use this to expand the args and terminate the paragraph they make up
+
+\def\defunargs #1{\functionparens \sl
+% Expand, preventing hyphenation at `-' chars.
+% Note that groups don't affect changes in \hyphenchar.
+\hyphenchar\tensl=0
+#1%
+\hyphenchar\tensl=45
+\ifnum\parencount=0 \else \errmessage{unbalanced parens in @def arguments}\fi%
+\interlinepenalty=10000
+\advance\rightskip by 0pt plus 1fil
+\endgraf\penalty 10000\vskip -\parskip\penalty 10000%
+}
+
+\def\deftypefunargs #1{%
+% Expand, preventing hyphenation at `-' chars.
+% Note that groups don't affect changes in \hyphenchar.
+% Use \boldbraxnoamp, not \functionparens, so that & is not special.
+\boldbraxnoamp
+\tclose{#1}% avoid \code because of side effects on active chars
+\interlinepenalty=10000
+\advance\rightskip by 0pt plus 1fil
+\endgraf\penalty 10000\vskip -\parskip\penalty 10000%
+}
+
+% Do complete processing of one @defun or @defunx line already parsed.
+
+% @deffn Command forward-char nchars
+
+\def\deffn{\defmethparsebody\Edeffn\deffnx\deffnheader}
+
+\def\deffnheader #1#2#3{\doind {fn}{\code{#2}}%
+\begingroup\defname {#2}{#1}\defunargs{#3}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% @defun == @deffn Function
+
+\def\defun{\defparsebody\Edefun\defunx\defunheader}
+
+\def\defunheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index
+\begingroup\defname {#1}{Function}%
+\defunargs {#2}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% @deftypefun int foobar (int @var{foo}, float @var{bar})
+
+\def\deftypefun{\defparsebody\Edeftypefun\deftypefunx\deftypefunheader}
+
+% #1 is the data type. #2 is the name and args.
+\def\deftypefunheader #1#2{\deftypefunheaderx{#1}#2 \relax}
+% #1 is the data type, #2 the name, #3 the args.
+\def\deftypefunheaderx #1#2 #3\relax{%
+\doind {fn}{\code{#2}}% Make entry in function index
+\begingroup\defname {\defheaderxcond#1\relax$$$#2}{Function}%
+\deftypefunargs {#3}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% @deftypefn {Library Function} int foobar (int @var{foo}, float @var{bar})
+
+\def\deftypefn{\defmethparsebody\Edeftypefn\deftypefnx\deftypefnheader}
+
+% \defheaderxcond#1\relax$$$
+% puts #1 in @code, followed by a space, but does nothing if #1 is null.
+\def\defheaderxcond#1#2$$${\ifx#1\relax\else\code{#1#2} \fi}
+
+% #1 is the classification. #2 is the data type. #3 is the name and args.
+\def\deftypefnheader #1#2#3{\deftypefnheaderx{#1}{#2}#3 \relax}
+% #1 is the classification, #2 the data type, #3 the name, #4 the args.
+\def\deftypefnheaderx #1#2#3 #4\relax{%
+\doind {fn}{\code{#3}}% Make entry in function index
+\begingroup
+\normalparens % notably, turn off `&' magic, which prevents
+% at least some C++ text from working
+\defname {\defheaderxcond#2\relax$$$#3}{#1}%
+\deftypefunargs {#4}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% @defmac == @deffn Macro
+
+\def\defmac{\defparsebody\Edefmac\defmacx\defmacheader}
+
+\def\defmacheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index
+\begingroup\defname {#1}{Macro}%
+\defunargs {#2}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% @defspec == @deffn Special Form
+
+\def\defspec{\defparsebody\Edefspec\defspecx\defspecheader}
+
+\def\defspecheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index
+\begingroup\defname {#1}{Special Form}%
+\defunargs {#2}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% This definition is run if you use @defunx
+% anywhere other than immediately after a @defun or @defunx.
+
+\def\deffnx #1 {\errmessage{@deffnx in invalid context}}
+\def\defunx #1 {\errmessage{@defunx in invalid context}}
+\def\defmacx #1 {\errmessage{@defmacx in invalid context}}
+\def\defspecx #1 {\errmessage{@defspecx in invalid context}}
+\def\deftypefnx #1 {\errmessage{@deftypefnx in invalid context}}
+\def\deftypeunx #1 {\errmessage{@deftypeunx in invalid context}}
+
+% @defmethod, and so on
+
+% @defop {Funny Method} foo-class frobnicate argument
+
+\def\defop #1 {\def\defoptype{#1}%
+\defopparsebody\Edefop\defopx\defopheader\defoptype}
+
+\def\defopheader #1#2#3{%
+\dosubind {fn}{\code{#2}}{on #1}% Make entry in function index
+\begingroup\defname {#2}{\defoptype{} on #1}%
+\defunargs {#3}\endgroup %
+}
+
+% @defmethod == @defop Method
+
+\def\defmethod{\defmethparsebody\Edefmethod\defmethodx\defmethodheader}
+
+\def\defmethodheader #1#2#3{%
+\dosubind {fn}{\code{#2}}{on #1}% entry in function index
+\begingroup\defname {#2}{Method on #1}%
+\defunargs {#3}\endgroup %
+}
+
+% @defcv {Class Option} foo-class foo-flag
+
+\def\defcv #1 {\def\defcvtype{#1}%
+\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}
+
+\def\defcvarheader #1#2#3{%
+\dosubind {vr}{\code{#2}}{of #1}% Make entry in var index
+\begingroup\defname {#2}{\defcvtype{} of #1}%
+\defvarargs {#3}\endgroup %
+}
+
+% @defivar == @defcv {Instance Variable}
+
+\def\defivar{\defvrparsebody\Edefivar\defivarx\defivarheader}
+
+\def\defivarheader #1#2#3{%
+\dosubind {vr}{\code{#2}}{of #1}% Make entry in var index
+\begingroup\defname {#2}{Instance Variable of #1}%
+\defvarargs {#3}\endgroup %
+}
+
+% These definitions are run if you use @defmethodx, etc.,
+% anywhere other than immediately after a @defmethod, etc.
+
+\def\defopx #1 {\errmessage{@defopx in invalid context}}
+\def\defmethodx #1 {\errmessage{@defmethodx in invalid context}}
+\def\defcvx #1 {\errmessage{@defcvx in invalid context}}
+\def\defivarx #1 {\errmessage{@defivarx in invalid context}}
+
+% Now @defvar
+
+% First, define the processing that is wanted for arguments of @defvar.
+% This is actually simple: just print them in roman.
+% This must expand the args and terminate the paragraph they make up
+\def\defvarargs #1{\normalparens #1%
+\interlinepenalty=10000
+\endgraf\penalty 10000\vskip -\parskip\penalty 10000}
+
+% @defvr Counter foo-count
+
+\def\defvr{\defvrparsebody\Edefvr\defvrx\defvrheader}
+
+\def\defvrheader #1#2#3{\doind {vr}{\code{#2}}%
+\begingroup\defname {#2}{#1}\defvarargs{#3}\endgroup}
+
+% @defvar == @defvr Variable
+
+\def\defvar{\defvarparsebody\Edefvar\defvarx\defvarheader}
+
+\def\defvarheader #1#2{\doind {vr}{\code{#1}}% Make entry in var index
+\begingroup\defname {#1}{Variable}%
+\defvarargs {#2}\endgroup %
+}
+
+% @defopt == @defvr {User Option}
+
+\def\defopt{\defvarparsebody\Edefopt\defoptx\defoptheader}
+
+\def\defoptheader #1#2{\doind {vr}{\code{#1}}% Make entry in var index
+\begingroup\defname {#1}{User Option}%
+\defvarargs {#2}\endgroup %
+}
+
+% @deftypevar int foobar
+
+\def\deftypevar{\defvarparsebody\Edeftypevar\deftypevarx\deftypevarheader}
+
+% #1 is the data type. #2 is the name.
+\def\deftypevarheader #1#2{%
+\doind {vr}{\code{#2}}% Make entry in variables index
+\begingroup\defname {\defheaderxcond#1\relax$$$#2}{Variable}%
+\interlinepenalty=10000
+\endgraf\penalty 10000\vskip -\parskip\penalty 10000
+\endgroup}
+
+% @deftypevr {Global Flag} int enable
+
+\def\deftypevr{\defvrparsebody\Edeftypevr\deftypevrx\deftypevrheader}
+
+\def\deftypevrheader #1#2#3{\doind {vr}{\code{#3}}%
+\begingroup\defname {\defheaderxcond#2\relax$$$#3}{#1}
+\interlinepenalty=10000
+\endgraf\penalty 10000\vskip -\parskip\penalty 10000
+\endgroup}
+
+% This definition is run if you use @defvarx
+% anywhere other than immediately after a @defvar or @defvarx.
+
+\def\defvrx #1 {\errmessage{@defvrx in invalid context}}
+\def\defvarx #1 {\errmessage{@defvarx in invalid context}}
+\def\defoptx #1 {\errmessage{@defoptx in invalid context}}
+\def\deftypevarx #1 {\errmessage{@deftypevarx in invalid context}}
+\def\deftypevrx #1 {\errmessage{@deftypevrx in invalid context}}
+
+% Now define @deftp
+% Args are printed in bold, a slight difference from @defvar.
+
+\def\deftpargs #1{\bf \defvarargs{#1}}
+
+% @deftp Class window height width ...
+
+\def\deftp{\deftpparsebody\Edeftp\deftpx\deftpheader}
+
+\def\deftpheader #1#2#3{\doind {tp}{\code{#2}}%
+\begingroup\defname {#2}{#1}\deftpargs{#3}\endgroup}
+
+% This definition is run if you use @deftpx, etc
+% anywhere other than immediately after a @deftp, etc.
+
+\def\deftpx #1 {\errmessage{@deftpx in invalid context}}
+
+\message{cross reference,}
+% Define cross-reference macros
+\newwrite \auxfile
+
+\newif\ifhavexrefs % True if xref values are known.
+\newif\ifwarnedxrefs % True if we warned once that they aren't known.
+
+% \setref{foo} defines a cross-reference point named foo.
+
+\def\setref#1{%
+\dosetq{#1-title}{Ytitle}%
+\dosetq{#1-pg}{Ypagenumber}%
+\dosetq{#1-snt}{Ysectionnumberandtype}}
+
+\def\unnumbsetref#1{%
+\dosetq{#1-title}{Ytitle}%
+\dosetq{#1-pg}{Ypagenumber}%
+\dosetq{#1-snt}{Ynothing}}
+
+\def\appendixsetref#1{%
+\dosetq{#1-title}{Ytitle}%
+\dosetq{#1-pg}{Ypagenumber}%
+\dosetq{#1-snt}{Yappendixletterandtype}}
+
+% \xref, \pxref, and \ref generate cross-references to specified points.
+% For \xrefX, #1 is the node name, #2 the name of the Info
+% cross-reference, #3 the printed node name, #4 the name of the Info
+% file, #5 the name of the printed manual. All but the node name can be
+% omitted.
+%
+\def\pxref#1{\putwordsee{} \xrefX[#1,,,,,,,]}
+\def\xref#1{\putwordSee{} \xrefX[#1,,,,,,,]}
+\def\ref#1{\xrefX[#1,,,,,,,]}
+\def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup
+ \def\printedmanual{\ignorespaces #5}%
+ \def\printednodename{\ignorespaces #3}%
+ \setbox1=\hbox{\printedmanual}%
+ \setbox0=\hbox{\printednodename}%
+ \ifdim \wd0 = 0pt
+ % No printed node name was explicitly given.
+ \ifx\SETxref-automatic-section-title\relax %
+ % Use the actual chapter/section title appear inside
+ % the square brackets. Use the real section title if we have it.
+ \ifdim \wd1>0pt%
+ % It is in another manual, so we don't have it.
+ \def\printednodename{\ignorespaces #1}%
+ \else
+ \ifhavexrefs
+ % We know the real title if we have the xref values.
+ \def\printednodename{\refx{#1-title}}%
+ \else
+ % Otherwise just copy the Info node name.
+ \def\printednodename{\ignorespaces #1}%
+ \fi%
+ \fi
+ \def\printednodename{#1-title}%
+ \else
+ % Use the node name inside the square brackets.
+ \def\printednodename{\ignorespaces #1}%
+ \fi
+ \fi
+ %
+ % If we use \unhbox0 and \unhbox1 to print the node names, TeX does not
+ % insert empty discretionaries after hyphens, which means that it will
+ % not find a line break at a hyphen in a node names. Since some manuals
+ % are best written with fairly long node names, containing hyphens, this
+ % is a loss. Therefore, we give the text of the node name again, so it
+ % is as if TeX is seeing it for the first time.
+ \ifdim \wd1 > 0pt
+ \putwordsection{} ``\printednodename'' in \cite{\printedmanual}%
+ \else
+ % _ (for example) has to be the character _ for the purposes of the
+ % control sequence corresponding to the node, but it has to expand
+ % into the usual \leavevmode...\vrule stuff for purposes of
+ % printing. So we \turnoffactive for the \refx-snt, back on for the
+ % printing, back off for the \refx-pg.
+ {\turnoffactive \refx{#1-snt}{}}%
+ \space [\printednodename],\space
+ \turnoffactive \putwordpage\tie\refx{#1-pg}{}%
+ \fi
+\endgroup}
+
+% \dosetq is the interface for calls from other macros
+
+% Use \turnoffactive so that punctuation chars such as underscore
+% work in node names.
+\def\dosetq #1#2{{\let\folio=0 \turnoffactive \auxhat%
+\edef\next{\write\auxfile{\internalsetq {#1}{#2}}}%
+\next}}
+
+% \internalsetq {foo}{page} expands into
+% CHARACTERS 'xrdef {foo}{...expansion of \Ypage...}
+% When the aux file is read, ' is the escape character
+
+\def\internalsetq #1#2{'xrdef {#1}{\csname #2\endcsname}}
+
+% Things to be expanded by \internalsetq
+
+\def\Ypagenumber{\folio}
+
+\def\Ytitle{\thissection}
+
+\def\Ynothing{}
+
+\def\Ysectionnumberandtype{%
+\ifnum\secno=0 \putwordChapter\xreftie\the\chapno %
+\else \ifnum \subsecno=0 \putwordSection\xreftie\the\chapno.\the\secno %
+\else \ifnum \subsubsecno=0 %
+\putwordSection\xreftie\the\chapno.\the\secno.\the\subsecno %
+\else %
+\putwordSection\xreftie\the\chapno.\the\secno.\the\subsecno.\the\subsubsecno %
+\fi \fi \fi }
+
+\def\Yappendixletterandtype{%
+\ifnum\secno=0 \putwordAppendix\xreftie'char\the\appendixno{}%
+\else \ifnum \subsecno=0 \putwordSection\xreftie'char\the\appendixno.\the\secno %
+\else \ifnum \subsubsecno=0 %
+\putwordSection\xreftie'char\the\appendixno.\the\secno.\the\subsecno %
+\else %
+\putwordSection\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %
+\fi \fi \fi }
+
+\gdef\xreftie{'tie}
+
+% Use TeX 3.0's \inputlineno to get the line number, for better error
+% messages, but if we're using an old version of TeX, don't do anything.
+%
+\ifx\inputlineno\thisisundefined
+ \let\linenumber = \empty % Non-3.0.
+\else
+ \def\linenumber{\the\inputlineno:\space}
+\fi
+
+% Define \refx{NAME}{SUFFIX} to reference a cross-reference string named NAME.
+% If its value is nonempty, SUFFIX is output afterward.
+
+\def\refx#1#2{%
+ \expandafter\ifx\csname X#1\endcsname\relax
+ % If not defined, say something at least.
+ $\langle$un\-de\-fined$\rangle$%
+ \ifhavexrefs
+ \message{\linenumber Undefined cross reference `#1'.}%
+ \else
+ \ifwarnedxrefs\else
+ \global\warnedxrefstrue
+ \message{Cross reference values unknown; you must run TeX again.}%
+ \fi
+ \fi
+ \else
+ % It's defined, so just use it.
+ \csname X#1\endcsname
+ \fi
+ #2% Output the suffix in any case.
+}
+
+% Read the last existing aux file, if any. No error if none exists.
+
+% This is the macro invoked by entries in the aux file.
+\def\xrdef #1#2{
+{\catcode`\'=\other\expandafter \gdef \csname X#1\endcsname {#2}}}
+
+\def\readauxfile{%
+\begingroup
+\catcode `\^^@=\other
+\catcode `\\ 1=\other
+\catcode `\\ 2=\other
+\catcode `\^^C=\other
+\catcode `\^^D=\other
+\catcode `\^^E=\other
+\catcode `\^^F=\other
+\catcode `\^^G=\other
+\catcode `\^^H=\other
+\catcode `\\v=\other
+\catcode `\^^L=\other
+\catcode `\\ e=\other
+\catcode `\\ f=\other
+\catcode `\\10=\other
+\catcode `\\11=\other
+\catcode `\\12=\other
+\catcode `\\13=\other
+\catcode `\\14=\other
+\catcode `\\15=\other
+\catcode `\\16=\other
+\catcode `\\17=\other
+\catcode `\\18=\other
+\catcode `\\19=\other
+\catcode 26=\other
+\catcode `\^^[=\other
+\catcode `\^^\=\other
+\catcode `\^^]=\other
+\catcode `\^^^=\other
+\catcode `\^^_=\other
+\catcode `\@=\other
+\catcode `\^=\other
+\catcode `\~=\other
+\catcode `\[=\other
+\catcode `\]=\other
+\catcode`\"=\other
+\catcode`\_=\other
+\catcode`\|=\other
+\catcode`\<=\other
+\catcode`\>=\other
+\catcode `\$=\other
+\catcode `\#=\other
+\catcode `\&=\other
+% `\+ does not work, so use 43.
+\catcode 43=\other
+% Make the characters 128-255 be printing characters
+{%
+ \count 1=128
+ \def\loop{%
+ \catcode\count 1=\other
+ \advance\count 1 by 1
+ \ifnum \count 1<256 \loop \fi
+ }%
+}%
+% the aux file uses ' as the escape.
+% Turn off \ as an escape so we do not lose on
+% entries which were dumped with control sequences in their names.
+% For example, 'xrdef {$\leq $-fun}{page ...} made by @defun ^^
+% Reference to such entries still does not work the way one would wish,
+% but at least they do not bomb out when the aux file is read in.
+\catcode `\{=1 \catcode `\}=2
+\catcode `\%=\other
+\catcode `\'=0
+\catcode`\^=7 % to make ^^e4 etc usable in xref tags
+\catcode `\\=\other
+\openin 1 \jobname.aux
+\ifeof 1 \else \closein 1 \input \jobname.aux \global\havexrefstrue
+\global\warnedobstrue
+\fi
+% Open the new aux file. Tex will close it automatically at exit.
+\openout \auxfile=\jobname.aux
+\endgroup}
+
+
+% Footnotes.
+
+\newcount \footnoteno
+
+% The trailing space in the following definition for supereject is
+% vital for proper filling; pages come out unaligned when you do a
+% pagealignmacro call if that space before the closing brace is
+% removed.
+\def\supereject{\par\penalty -20000\footnoteno =0 }
+
+% @footnotestyle is meaningful for info output only..
+\let\footnotestyle=\comment
+
+\let\ptexfootnote=\footnote
+
+{\catcode `\@=11
+%
+% Auto-number footnotes. Otherwise like plain.
+\gdef\footnote{%
+ \global\advance\footnoteno by \@ne
+ \edef\thisfootno{$^{\the\footnoteno}$}%
+ %
+ % In case the footnote comes at the end of a sentence, preserve the
+ % extra spacing after we do the footnote number.
+ \let\@sf\empty
+ \ifhmode\edef\@sf{\spacefactor\the\spacefactor}\/\fi
+ %
+ % Remove inadvertent blank space before typesetting the footnote number.
+ \unskip
+ \thisfootno\@sf
+ \footnotezzz
+}%
+
+% Don't bother with the trickery in plain.tex to not require the
+% footnote text as a parameter. Our footnotes don't need to be so general.
+%
+\long\gdef\footnotezzz#1{\insert\footins{%
+ % We want to typeset this text as a normal paragraph, even if the
+ % footnote reference occurs in (for example) a display environment.
+ % So reset some parameters.
+ \interlinepenalty\interfootnotelinepenalty
+ \splittopskip\ht\strutbox % top baseline for broken footnotes
+ \splitmaxdepth\dp\strutbox
+ \floatingpenalty\@MM
+ \leftskip\z@skip
+ \rightskip\z@skip
+ \spaceskip\z@skip
+ \xspaceskip\z@skip
+ \parindent\defaultparindent
+ %
+ % Hang the footnote text off the number.
+ \hang
+ \textindent{\thisfootno}%
+ %
+ % Don't crash into the line above the footnote text. Since this
+ % expands into a box, it must come within the paragraph, lest it
+ % provide a place where TeX can split the footnote.
+ \footstrut
+ #1\strut}%
+}
+
+}%end \catcode `\@=11
+
+% Set the baselineskip to #1, and the lineskip and strut size
+% correspondingly. There is no deep meaning behind these magic numbers
+% used as factors; they just match (closely enough) what Knuth defined.
+%
+\def\lineskipfactor{.08333}
+\def\strutheightpercent{.70833}
+\def\strutdepthpercent {.29167}
+%
+\def\setleading#1{%
+ \normalbaselineskip = #1\relax
+ \normallineskip = \lineskipfactor\normalbaselineskip
+ \normalbaselines
+ \setbox\strutbox =\hbox{%
+ \vrule width0pt height\strutheightpercent\baselineskip
+ depth \strutdepthpercent \baselineskip
+ }%
+}
+
+% @| inserts a changebar to the left of the current line. It should
+% surround any changed text. This approach does *not* work if the
+% change spans more than two lines of output. To handle that, we would
+% have adopt a much more difficult approach (putting marks into the main
+% vertical list for the beginning and end of each change).
+%
+\def\|{%
+ % \vadjust can only be used in horizontal mode.
+ \leavevmode
+ %
+ % Append this vertical mode material after the current line in the output.
+ \vadjust{%
+ % We want to insert a rule with the height and depth of the current
+ % leading; that is exactly what \strutbox is supposed to record.
+ \vskip-\baselineskip
+ %
+ % \vadjust-items are inserted at the left edge of the type. So
+ % the \llap here moves out into the left-hand margin.
+ \llap{%
+ %
+ % For a thicker or thinner bar, change the `1pt'.
+ \vrule height\baselineskip width1pt
+ %
+ % This is the space between the bar and the text.
+ \hskip 12pt
+ }%
+ }%
+}
+
+% For a final copy, take out the rectangles
+% that mark overfull boxes (in case you have decided
+% that the text looks ok even though it passes the margin).
+%
+\def\finalout{\overfullrule=0pt}
+
+
+% End of control word definitions.
+
+\message{and turning on texinfo input format.}
+
+\def\openindices{%
+ \newindex{cp}%
+ \newcodeindex{fn}%
+ \newcodeindex{vr}%
+ \newcodeindex{tp}%
+ \newcodeindex{ky}%
+ \newcodeindex{pg}%
+}
+
+% Set some numeric style parameters, for 8.5 x 11 format.
+
+%\hsize = 6.5in
+\newdimen\defaultparindent \defaultparindent = 15pt
+\parindent = \defaultparindent
+\parskip 18pt plus 1pt
+\setleading{15pt}
+\advance\topskip by 1.2cm
+
+% Prevent underfull vbox error messages.
+\vbadness=10000
+
+% Following George Bush, just get rid of widows and orphans.
+\widowpenalty=10000
+\clubpenalty=10000
+
+% Use TeX 3.0's \emergencystretch to help line breaking, but if we're
+% using an old version of TeX, don't do anything. We want the amount of
+% stretch added to depend on the line length, hence the dependence on
+% \hsize. This makes it come to about 9pt for the 8.5x11 format.
+%
+\ifx\emergencystretch\thisisundefined
+ % Allow us to assign to \emergencystretch anyway.
+ \def\emergencystretch{\dimen0}%
+\else
+ \emergencystretch = \hsize
+ \divide\emergencystretch by 45
+\fi
+
+% Use @smallbook to reset parameters for 7x9.5 format (or else 7x9.25)
+\def\smallbook{
+
+% These values for secheadingskip and subsecheadingskip are
+% experiments. RJC 7 Aug 1992
+% was 17pt and 14pt plus 6pt minus 3pt
+\global\secheadingskip = 0pt plus 4pt minus 4pt
+\global\subsecheadingskip = 0pt plus 4pt minus 4pt
+
+\global\lispnarrowing = 0.3in
+\setleading{12pt}
+\advance\topskip by -1cm
+\global\parskip 3pt plus 1pt
+\global\hsize = 5in
+\global\vsize=7.5in
+\global\tolerance=700
+\global\hfuzz=1pt
+\global\contentsrightmargin=0pt
+\global\deftypemargin=0pt
+\global\defbodyindent=.5cm
+
+\global\pagewidth=\hsize
+\global\pageheight=\vsize
+
+\global\let\smalllisp=\smalllispx
+\global\let\smallexample=\smalllispx
+\global\def\Esmallexample{\Esmalllisp}
+}
+
+% Use @afourpaper to print on European A4 paper.
+\def\afourpaper{
+\global\tolerance=700
+\global\hfuzz=1pt
+\setleading{12pt}
+\global\parskip 15pt plus 1pt
+
+\global\vsize= 53\baselineskip
+\advance\vsize by \topskip
+%\global\hsize= 5.85in % A4 wide 10pt
+\global\hsize= 6.5in
+\global\outerhsize=\hsize
+\global\advance\outerhsize by 0.5in
+\global\outervsize=\vsize
+\global\advance\outervsize by 0.6in
+
+\global\pagewidth=\hsize
+\global\pageheight=\vsize
+}
+
+% Allow control of the text dimensions. Parameters in order: textheight;
+% textwidth; \voffset; \hoffset (!); binding offset. All require a dimension;
+% header is additional; added length extends the bottom of the page.
+
+\def\changepagesizes#1#2#3#4#5{
+ \global\vsize= #1
+ \advance\vsize by \topskip
+ \global\voffset= #3
+ \global\hsize= #2
+ \global\outerhsize=\hsize
+ \global\advance\outerhsize by 0.5in
+ \global\outervsize=\vsize
+ \global\advance\outervsize by 0.6in
+ \global\pagewidth=\hsize
+ \global\pageheight=\vsize
+ \global\normaloffset= #4
+ \global\bindingoffset= #5}
+
+% This layout is compatible with Latex on A4 paper.
+
+\def\afourlatex{\changepagesizes{22cm}{15cm}{7mm}{4.6mm}{5mm}}
+
+% Use @afourwide to print on European A4 paper in wide format.
+\def\afourwide{\afourpaper
+\changepagesizes{9.5in}{6.5in}{\hoffset}{\normaloffset}{\bindingoffset}}
+
+% Define macros to output various characters with catcode for normal text.
+\catcode`\"=\other
+\catcode`\~=\other
+\catcode`\^=\other
+\catcode`\_=\other
+\catcode`\|=\other
+\catcode`\<=\other
+\catcode`\>=\other
+\catcode`\+=\other
+\def\normaldoublequote{"}
+\def\normaltilde{~}
+\def\normalcaret{^}
+\def\normalunderscore{_}
+\def\normalverticalbar{|}
+\def\normalless{<}
+\def\normalgreater{>}
+\def\normalplus{+}
+
+% This macro is used to make a character print one way in ttfont
+% where it can probably just be output, and another way in other fonts,
+% where something hairier probably needs to be done.
+%
+% #1 is what to print if we are indeed using \tt; #2 is what to print
+% otherwise. Since all the Computer Modern typewriter fonts have zero
+% interword stretch (and shrink), and it is reasonable to expect all
+% typewriter fonts to have this, we can check that font parameter.
+%
+\def\ifusingtt#1#2{\ifdim \fontdimen3\the\font=0pt #1\else #2\fi}
+
+% Turn off all special characters except @
+% (and those which the user can use as if they were ordinary).
+% Most of these we simply print from the \tt font, but for some, we can
+% use math or other variants that look better in normal text.
+
+\catcode`\"=\active
+\def\activedoublequote{{\tt \char '042}}
+\let"=\activedoublequote
+\catcode`\~=\active
+\def~{{\tt \char '176}}
+\chardef\hat=`\^
+\catcode`\^=\active
+\def\auxhat{\def^{'hat}}
+\def^{{\tt \hat}}
+
+\catcode`\_=\active
+\def_{\ifusingtt\normalunderscore\_}
+% Subroutine for the previous macro.
+\def\_{\lvvmode \kern.06em \vbox{\hrule width.3em height.1ex}}
+
+% \lvvmode is equivalent in function to \leavevmode.
+% Using \leavevmode runs into trouble when written out to
+% an index file due to the expansion of \leavevmode into ``\unhbox
+% \voidb@x'' ---which looks to TeX like ``\unhbox \voidb\x'' due to our
+% magic tricks with @.
+\def\lvvmode{\vbox to 0pt{}}
+
+\catcode`\|=\active
+\def|{{\tt \char '174}}
+\chardef \less=`\<
+\catcode`\<=\active
+\def<{{\tt \less}}
+\chardef \gtr=`\>
+\catcode`\>=\active
+\def>{{\tt \gtr}}
+\catcode`\+=\active
+\def+{{\tt \char 43}}
+%\catcode 27=\active
+%\def^^[{$\diamondsuit$}
+
+% Set up an active definition for =, but don't enable it most of the time.
+{\catcode`\==\active
+\global\def={{\tt \char 61}}}
+
+\catcode`+=\active
+\catcode`\_=\active
+
+% If a .fmt file is being used, characters that might appear in a file
+% name cannot be active until we have parsed the command line.
+% So turn them off again, and have \everyjob (or @setfilename) turn them on.
+% \otherifyactive is called near the end of this file.
+\def\otherifyactive{\catcode`+=\other \catcode`\_=\other}
+
+\catcode`\@=0
+
+% \rawbackslashxx output one backslash character in current font
+\global\chardef\rawbackslashxx=`\\
+%{\catcode`\\=\other
+%@gdef@rawbackslashxx{\}}
+
+% \rawbackslash redefines \ as input to do \rawbackslashxx.
+{\catcode`\\=\active
+@gdef@rawbackslash{@let\=@rawbackslashxx }}
+
+% \normalbackslash outputs one backslash in fixed width font.
+\def\normalbackslash{{\tt\rawbackslashxx}}
+
+% Say @foo, not \foo, in error messages.
+\escapechar=`\@
+
+% \catcode 17=0 % Define control-q
+\catcode`\\=\active
+
+% Used sometimes to turn off (effectively) the active characters
+% even after parsing them.
+@def@turnoffactive{@let"=@normaldoublequote
+@let\=@realbackslash
+@let~=@normaltilde
+@let^=@normalcaret
+@let_=@normalunderscore
+@let|=@normalverticalbar
+@let<=@normalless
+@let>=@normalgreater
+@let+=@normalplus}
+
+@def@normalturnoffactive{@let"=@normaldoublequote
+@let\=@normalbackslash
+@let~=@normaltilde
+@let^=@normalcaret
+@let_=@normalunderscore
+@let|=@normalverticalbar
+@let<=@normalless
+@let>=@normalgreater
+@let+=@normalplus}
+
+% Make _ and + \other characters, temporarily.
+% This is canceled by @fixbackslash.
+@otherifyactive
+
+% If a .fmt file is being used, we don't want the `\input texinfo' to show up.
+% That is what \eatinput is for; after that, the `\' should revert to printing
+% a backslash.
+%
+@gdef@eatinput input texinfo{@fixbackslash}
+@global@let\ = @eatinput
+
+% On the other hand, perhaps the file did not have a `\input texinfo'. Then
+% the first `\{ in the file would cause an error. This macro tries to fix
+% that, assuming it is called before the first `\' could plausibly occur.
+% Also back turn on active characters that might appear in the input
+% file name, in case not using a pre-dumped format.
+%
+@gdef@fixbackslash{@ifx\@eatinput @let\ = @normalbackslash @fi
+ @catcode`+=@active @catcode`@_=@active}
+
+%% These look ok in all fonts, so just make them not special. The @rm below
+%% makes sure that the current font starts out as the newly loaded cmr10
+@catcode`@$=@other @catcode`@%=@other @catcode`@&=@other @catcode`@#=@other
+
+@textfonts
+@rm
+
+@c Local variables:
+@c page-delimiter: "^\\\\message"
+@c End:
--- /dev/null
+Sun Aug 9 11:16:13 1998 Ben Pfaff <blp@gnu.org>
+
+ * descriptives.stat: Renamed descript.stat.
+
+Sat Aug 8 00:28:24 1998 Ben Pfaff <blp@gnu.org>
+
+ * New directory.
+
+ * descriptives.stat: New file.
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+title 'Demonstrate DESCRIPTIVES procedure'.
+
+remark EOF
+ Sample syntax file for PSPP.
+ (This comment will appear in the output.)
+EOF
+
+/* run this syntax file with the command:
+/* pspp example.stat
+/*
+/* Output is written to the file "pspp.list".
+/*
+/* (This comment will not appear in the output.)
+
+data list / v0 to v2 1-9.
+begin data.
+ 12 12 89
+ 34 12 80
+ 56 12 77
+ 78 12 73
+ 90 91
+ 37 97 85
+ 52 82
+ 12 79
+ 26 78 76
+ 29 13 71
+end data.
+
+descript all/stat=all/format=serial.
--- /dev/null
+Thu Oct 9 13:41:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.in: (INCLUDES) Add -I$(top_srcdir)/src.
+
+1997-09-06 02:10 Ulrich Drepper <drepper@cygnus.com>
+
+ * intlh.inst.in: Reformat copyright.
+
+1997-08-19 15:22 Ulrich Drepper <drepper@cygnus.com>
+
+ * dcgettext.c (DCGETTEXT): Remove wrong comment.
+
+1997-08-16 00:13 Ulrich Drepper <drepper@cygnus.com>
+
+ * Makefile.in (install-data): Don't change directory to install.
+
+1997-08-01 14:30 Ulrich Drepper <drepper@cygnus.com>
+
+ * cat-compat.c: Fix copyright.
+
+ * localealias.c: Don't define strchr unless !HAVE_STRCHR.
+
+ * loadmsgcat.c: Update copyright. Fix typos.
+
+ * l10nflist.c: Don't define strchr unless !HAVE_STRCHR.
+ (_nl_make_l10nflist): Handle sponsor and revision correctly.
+
+ * gettext.c: Update copyright.
+ * gettext.h: Likewise.
+ * hash-string.h: Likewise.
+
+ * finddomain.c: Remoave dead code. Define strchr only if
+ !HAVE_STRCHR.
+
+ * explodename.c: Include <sys/types.h>.
+
+ * explodename.c: Reformat copyright text.
+ (_nl_explode_name): Fix typo.
+
+ * dcgettext.c: Define and use __set_errno.
+ (guess_category_value): Don't use setlocale if HAVE_LC_MESSAGES is
+ not defined.
+
+ * bindtextdom.c: Pretty printing.
+
+1997-05-01 02:25 Ulrich Drepper <drepper@cygnus.com>
+
+ * dcgettext.c (guess_category_value): Don't depend on
+ HAVE_LC_MESSAGES. We don't need the macro here.
+ Patch by Bruno Haible <haible@ilog.fr>.
+
+ * cat-compat.c (textdomain): DoN't refer to HAVE_SETLOCALE_NULL
+ macro. Instead use HAVE_LOCALE_NULL and define it when using
+ glibc, as in dcgettext.c.
+ Patch by Bruno Haible <haible@ilog.fr>.
+
+ * Makefile.in (CPPFLAGS): New variable. Reported by Franc,ois
+ Pinard.
+
+Mon Mar 10 06:51:17 1997 Ulrich Drepper <drepper@cygnus.com>
+
+ * Makefile.in: Implement handling of libtool.
+
+ * gettextP.h: Change data structures for use of generic lowlevel
+ i18n file handling.
+
+Wed Dec 4 20:21:18 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * textdomain.c: Put parentheses around arguments of memcpy macro
+ definition.
+ * localealias.c: Likewise.
+ * l10nflist.c: Likewise.
+ * finddomain.c: Likewise.
+ * bindtextdom.c: Likewise.
+ Reported by Thomas Esken.
+
+Mon Nov 25 22:57:51 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * textdomain.c: Move definition of `memcpy` macro to right
+ position.
+
+Fri Nov 22 04:01:58 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * finddomain.c [!HAVE_STRING_H && !_LIBC]: Define memcpy using
+ bcopy if not already defined. Reported by Thomas Esken.
+ * bindtextdom.c: Likewise.
+ * l10nflist.c: Likewise.
+ * localealias.c: Likewise.
+ * textdomain.c: Likewise.
+
+Tue Oct 29 11:10:27 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * Makefile.in (libdir): Change to use exec_prefix instead of
+ prefix. Reported by Knut-HåvardAksnes <etokna@eto.ericsson.se>.
+
+Sat Aug 31 03:07:09 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * l10nflist.c (_nl_normalize_codeset): We convert to lower case,
+ so don't prepend uppercase `ISO' for only numeric arg.
+
+Fri Jul 19 00:15:46 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * l10nflist.c: Move inclusion of argz.h, ctype.h, stdlib.h after
+ definition of _GNU_SOURCE. Patch by Roland McGrath.
+
+ * Makefile.in (uninstall): Fix another bug with `for' loop and
+ empty arguments. Patch by Jim Meyering. Correct name os
+ uninstalled files: no intl- prefix anymore.
+
+ * Makefile.in (install-data): Again work around shells which
+ cannot handle mpty for list. Reported by Jim Meyering.
+
+Sat Jul 13 18:11:35 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * Makefile.in (install): Split goal. Now depend on install-exec
+ and install-data.
+ (install-exec, install-data): New goals. Created from former
+ install goal.
+ Reported by Karl Berry.
+
+Sat Jun 22 04:58:14 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * Makefile.in (MKINSTALLDIRS): New variable. Path to
+ mkinstalldirs script.
+ (install): use MKINSTALLDIRS variable or if the script is not present
+ try to find it in the $top_scrdir).
+
+Wed Jun 19 02:56:56 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * l10nflist.c: Linux libc *partly* includes the argz_* functions.
+ Grr. Work around by renaming the static version and use macros
+ for renaming.
+
+Tue Jun 18 20:11:17 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * l10nflist.c: Correct presence test macros of __argz_* functions.
+
+ * l10nflist.c: Include <argz.h> based on test of it instead when
+ __argz_* functions are available.
+ Reported by Andreas Schwab.
+
+Thu Jun 13 15:17:44 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * explodename.c, l10nflist.c: Define NULL for dumb systems.
+
+Tue Jun 11 17:05:13 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * intlh.inst.in, libgettext.h (dcgettext): Rename local variable
+ result to __result to prevent name clash.
+
+ * l10nflist.c, localealias.c, dcgettext.c: Define _GNU_SOURCE to
+ get prototype for stpcpy and strcasecmp.
+
+ * intlh.inst.in, libgettext.h: Move declaration of
+ `_nl_msg_cat_cntr' outside __extension__ block to prevent warning
+ from gcc's -Wnested-extern option.
+
+Fri Jun 7 01:58:00 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * Makefile.in (install): Remove comment.
+
+Thu Jun 6 17:28:17 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * Makefile.in (install): Work around for another Buglix stupidity.
+ Always use an `else' close for `if's. Reported by Nelson Beebe.
+
+ * Makefile.in (intlh.inst): Correct typo in phony rule.
+ Reported by Nelson Beebe.
+
+Thu Jun 6 01:49:52 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * dcgettext.c (read_alias_file): Rename variable alloca_list to
+ block_list as the macro calls assume.
+ Patch by Eric Backus.
+
+ * localealias.c [!HAVE_ALLOCA]: Define alloca as macro using
+ malloc.
+ (read_alias_file): Rename varriabe alloca_list to block_list as the
+ macro calls assume.
+ Patch by Eric Backus.
+
+ * l10nflist.c: Correct conditional for <argz.h> inclusion.
+ Reported by Roland McGrath.
+
+ * Makefile.in (all): Depend on all-@USE_INCLUDED_LIBINTL@, not
+ all-@USE_NLS@.
+
+ * Makefile.in (install): intlh.inst comes from local dir, not
+ $(srcdir).
+
+ * Makefile.in (intlh.inst): Special handling of this goal. If
+ used in gettext, this is really a rul to construct this file. If
+ used in any other package it is defined as a .PHONY rule with
+ empty body.
+
+ * finddomain.c: Extract locale file information handling into
+ l10nfile.c. Rename local stpcpy__ function to stpcpy.
+
+ * dcgettext.c (stpcpy): Add local definition.
+
+ * l10nflist.c: Solve some portability problems. Patches partly by
+ Thomas Esken. Add local definition of stpcpy.
+
+Tue Jun 4 02:47:49 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * intlh.inst.in: Don't depend including <locale.h> on
+ HAVE_LOCALE_H. Instead configure must rewrite this fiile
+ depending on the result of the configure run.
+
+ * Makefile.in (install): libintl.inst is now called intlh.inst.
+ Add rules for updating intlh.inst from intlh.inst.in.
+
+ * libintl.inst: Renamed to intlh.inst.in.
+
+ * localealias.c, dcgettext.c [__GNUC__]: Define HAVE_ALLOCA to 1
+ because gcc has __buitlin_alloca.
+ Reported by Roland McGrath.
+
+Mon Jun 3 00:32:16 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * Makefile.in (installcheck): New goal to fulfill needs of
+ automake's distcheck.
+
+ * Makefile.in (install): Reorder commands so that VERSION is
+ found.
+
+ * Makefile.in (gettextsrcdir): Now use subdirectory intl/ in
+ @datadir@/gettext.
+ (COMSRCS): Add l10nfile.c.
+ (OBJECTS): Add l10nfile.o.
+ (DISTFILES): Rename to DISTFILE.normal. Remove $(DISTFILES.common).
+ (DISTFILE.gettext): Remove $(DISTFILES.common).
+ (all-gettext): Remove goal.
+ (install): If $(PACKAGE) = gettext install, otherwose do nothing. No
+ package but gettext itself should install libintl.h + headers.
+ (dist): Extend goal to work for gettext, too.
+ (dist-gettext): Remove goal.
+
+ * dcgettext.c [!HAVE_ALLOCA]: Define macro alloca by using malloc.
+
+Sun Jun 2 17:33:06 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * loadmsgcat.c (_nl_load_domain): Parameter is now comes from
+ find_l10nfile.
+
+Sat Jun 1 02:23:03 1996 Ulrich Drepper <drepper@cygnus.com>
+
+ * l10nflist.c (__argz_next): Add definition.
+
+ * dcgettext.c [!HAVE_ALLOCA]: Add code for handling missing alloca
+ code. Use new l10nfile handling.
+
+ * localealias.c [!HAVE_ALLOCA]: Add code for handling missing
+ alloca code.
+
+ * l10nflist.c: Initial revision.
+
+Tue Apr 2 18:51:18 1996 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (all-gettext): New goal. Same as all-yes.
+
+Thu Mar 28 23:01:22 1996 Karl Eichwalder <ke@ke.central.de>
+
+ * Makefile.in (gettextsrcdir): Define using @datadir@.
+
+Tue Mar 26 12:39:14 1996 Ulrich Drepper <drepper@myware>
+
+ * finddomain.c: Include <ctype.h>. Reported by Roland McGrath.
+
+Sat Mar 23 02:00:35 1996 Ulrich Drepper <drepper@myware>
+
+ * finddomain.c (stpcpy): Rename to stpcpy__ to prevent clashing
+ with external declaration.
+
+Sat Mar 2 00:47:09 1996 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (all-no): Rename from all_no.
+
+Sat Feb 17 00:25:59 1996 Ulrich Drepper <drepper@myware>
+
+ * gettextP.h [loaded_domain]: Array `successor' must now contain up
+ to 63 elements (because of codeset name normalization).
+
+ * finddomain.c: Implement codeset name normalization.
+
+Thu Feb 15 04:39:09 1996 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (all): Define to `all-@USE_NLS@'.
+ (all-yes, all_no): New goals. `all-no' is noop, `all-yes'
+ is former all.
+
+Mon Jan 15 21:46:01 1996 Howard Gayle <howard@hal.com>
+
+ * localealias.c (alias_compare): Increment string pointers in loop
+ of strcasecmp replacement.
+
+Fri Dec 29 21:16:34 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (install-src): Who commented this goal out ? :-)
+
+Fri Dec 29 15:08:16 1995 Ulrich Drepper <drepper@myware>
+
+ * dcgettext.c (DCGETTEXT): Save `errno'. Failing system calls
+ should not effect it because a missing catalog is no error.
+ Reported by Harald K<o:>nig <koenig@tat.physik.uni-tuebingen.de>.
+
+Tue Dec 19 22:09:13 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (Makefile): Explicitly use $(SHELL) for running
+ shell scripts.
+
+Fri Dec 15 17:34:59 1995 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
+
+ * Makefile.in (install-src): Only install library and header when
+ we use the own implementation. Don't do it when using the
+ system's gettext or catgets functions.
+
+ * dcgettext.c (find_msg): Must not swap domain->hash_size here.
+
+Sat Dec 9 16:24:37 1995 Ulrich Drepper <drepper@myware>
+
+ * localealias.c, libintl.inst, libgettext.h, hash-string.h,
+ gettextP.h, finddomain.c, dcgettext.c, cat-compat.c:
+ Use PARAMS instead of __P. Suggested by Roland McGrath.
+
+Tue Dec 5 11:39:14 1995 Larry Schwimmer <rosebud@cyclone.stanford.edu>
+
+ * libgettext.h: Use `#if !defined (_LIBINTL_H)' instead of `#if
+ !_LIBINTL_H' because Solaris defines _LIBINTL_H as empty.
+
+Mon Dec 4 15:42:07 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (install-src):
+ Install libintl.inst instead of libintl.h.install.
+
+Sat Dec 2 22:51:38 1995 Marcus Daniels <marcus@sysc.pdx.edu>
+
+ * cat-compat.c (textdomain):
+ Reverse order in which files are tried you load. First
+ try local file, when this failed absolute path.
+
+Wed Nov 29 02:03:53 1995 Nelson H. F. Beebe <beebe@math.utah.edu>
+
+ * cat-compat.c (bindtextdomain): Add missing { }.
+
+Sun Nov 26 18:21:41 1995 Ulrich Drepper <drepper@myware>
+
+ * libintl.inst: Add missing __P definition. Reported by Nelson Beebe.
+
+ * Makefile.in:
+ Add dummy `all' and `dvi' goals. Reported by Tom Tromey.
+
+Sat Nov 25 16:12:01 1995 Franc,ois Pinard <pinard@iro.umontreal.ca>
+
+ * hash-string.h: Capitalize arguments of macros.
+
+Sat Nov 25 12:01:36 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (DISTFILES): Prevent files names longer than 13
+ characters. libintl.h.glibc->libintl.glibc,
+ libintl.h.install->libintl.inst. Reported by Joshua R. Poulson.
+
+Sat Nov 25 11:31:12 1995 Eric Backus <ericb@lsid.hp.com>
+
+ * dcgettext.c: Fix bug in preprocessor conditionals.
+
+Sat Nov 25 02:35:27 1995 Nelson H. F. Beebe <beebe@math.utah.edu>
+
+ * libgettext.h: Solaris cc does not understand
+ #if !SYMBOL1 && !SYMBOL2. Sad but true.
+
+Thu Nov 23 16:22:14 1995 Ulrich Drepper <drepper@myware>
+
+ * hash-string.h (hash_string):
+ Fix for machine with >32 bit `unsigned long's.
+
+ * dcgettext.c (DCGETTEXT):
+ Fix horrible bug in loop for alternative translation.
+
+Thu Nov 23 01:45:29 1995 Ulrich Drepper <drepper@myware>
+
+ * po2tbl.sed.in, linux-msg.sed, xopen-msg.sed:
+ Some further simplifications in message number generation.
+
+Mon Nov 20 21:08:43 1995 Ulrich Drepper <drepper@myware>
+
+ * libintl.h.glibc: Use __const instead of const in prototypes.
+
+ * Makefile.in (install-src):
+ Install libintl.h.install instead of libintl.h. This
+ is a stripped-down version. Suggested by Peter Miller.
+
+ * libintl.h.install, libintl.h.glibc: Initial revision.
+
+ * localealias.c (_nl_expand_alias, read_alias_file):
+ Protect prototypes in type casts by __P.
+
+Tue Nov 14 16:43:58 1995 Ulrich Drepper <drepper@myware>
+
+ * hash-string.h: Correct prototype for hash_string.
+
+Sun Nov 12 12:42:30 1995 Ulrich Drepper <drepper@myware>
+
+ * hash-string.h (hash_string): Add prototype.
+
+ * gettextP.h: Fix copyright.
+ (SWAP): Add prototype.
+
+Wed Nov 8 22:56:33 1995 Ulrich Drepper <drepper@myware>
+
+ * localealias.c (read_alias_file): Forgot sizeof.
+ Avoid calling *printf function. This introduces a big overhead.
+ Patch by Roland McGrath.
+
+Tue Nov 7 14:21:08 1995 Ulrich Drepper <drepper@myware>
+
+ * finddomain.c, cat-compat.c: Wrong indentation in #if for stpcpy.
+
+ * finddomain.c (stpcpy):
+ Define substitution function local. The macro was to flaky.
+
+ * cat-compat.c: Fix typo.
+
+ * xopen-msg.sed, linux-msg.sed:
+ While bringing message number to right place only accept digits.
+
+ * linux-msg.sed, xopen-msg.sed: Now that the counter does not have
+ leading 0s we don't need to remove them. Reported by Marcus
+ Daniels.
+
+ * Makefile.in (../po/cat-id-tbl.o): Use $(top_srdir) in
+ dependency. Reported by Marcus Daniels.
+
+ * cat-compat.c: (stpcpy) [!_LIBC && !HAVE_STPCPY]: Define replacement.
+ Generally cleanup using #if instead of #ifndef.
+
+ * Makefile.in: Correct typos in comment. By Franc,ois Pinard.
+
+Mon Nov 6 00:27:02 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (install-src): Don't install libintl.h and libintl.a
+ if we use an available gettext implementation.
+
+Sun Nov 5 22:02:08 1995 Ulrich Drepper <drepper@myware>
+
+ * libgettext.h: Fix typo: HAVE_CATGETTS -> HAVE_CATGETS. Reported
+ by Franc,ois Pinard.
+
+ * libgettext.h: Use #if instead of #ifdef/#ifndef.
+
+ * finddomain.c:
+ Comments describing what has to be done should start with FIXME.
+
+Sun Nov 5 19:38:01 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (DISTFILES): Split. Use DISTFILES with normal meaning.
+ DISTFILES.common names the files common to both dist goals.
+ DISTFILES.gettext are the files only distributed in GNU gettext.
+
+Sun Nov 5 17:32:54 1995 Ulrich Drepper <drepper@myware>
+
+ * dcgettext.c (DCGETTEXT): Correct searching in derived locales.
+ This was necessary since a change in _nl_find_msg several weeks
+ ago. I really don't know this is still not fixed.
+
+Sun Nov 5 12:43:12 1995 Ulrich Drepper <drepper@myware>
+
+ * loadmsgcat.c (_nl_load_domain): Test for FILENAME == NULL. This
+ might mark a special condition.
+
+ * finddomain.c (make_entry_rec): Don't make illegal entry as decided.
+
+ * Makefile.in (dist): Suppress error message when ln failed.
+ Get files from $(srcdir) explicitly.
+
+ * libgettext.h (gettext_const): Rename to gettext_noop.
+
+Fri Nov 3 07:36:50 1995 Ulrich Drepper <drepper@myware>
+
+ * finddomain.c (make_entry_rec):
+ Protect against wrong locale names by testing mask.
+
+ * libgettext.h (gettext_const): Add macro definition.
+ Capitalize macro arguments.
+
+Thu Nov 2 23:15:51 1995 Ulrich Drepper <drepper@myware>
+
+ * finddomain.c (_nl_find_domain):
+ Test for pointer != NULL before accessing value.
+ Reported by Tom Tromey.
+
+ * gettext.c (NULL):
+ Define as (void*)0 instad of 0. Reported by Franc,ois Pinard.
+
+Mon Oct 30 21:28:52 1995 Ulrich Drepper <drepper@myware>
+
+ * po2tbl.sed.in: Serious typo bug fixed by Jim Meyering.
+
+Sat Oct 28 23:20:47 1995 Ulrich Drepper <drepper@myware>
+
+ * libgettext.h: Disable dcgettext optimization for Solaris 2.3.
+
+ * localealias.c (alias_compare):
+ Peter Miller reported that tolower in some systems is
+ even dumber than I thought. Protect call by `isupper'.
+
+Fri Oct 27 22:22:51 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (libdir, includedir): New variables.
+ (install-src): Install libintl.a and libintl.h in correct dirs.
+
+Fri Oct 27 22:07:29 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (SOURCES): Fix typo: intrl.compat.c -> intl-compat.c.
+
+ * po2tbl.sed.in: Patch for buggy SEDs by Christian von Roques.
+
+ * localealias.c:
+ Fix typo and superflous test. Reported by Christian von Roques.
+
+Fri Oct 6 11:52:05 1995 Ulrich Drepper <drepper@myware>
+
+ * finddomain.c (_nl_find_domain):
+ Correct some remainder from the pre-CEN syntax. Now
+ we don't have a constant number of successors anymore.
+
+Wed Sep 27 21:41:13 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (DISTFILES): Add libintl.h.glibc.
+
+ * Makefile.in (dist-libc): Add goal for packing sources for glibc.
+ (COMSRCS, COMHDRS): Splitted to separate sources shared with glibc.
+
+ * loadmsgcat.c: Forget to continue #if line.
+
+ * localealias.c:
+ [_LIBC]: Rename strcasecmp to __strcasecmp to keep ANSI C name
+ space clean.
+
+ * dcgettext.c, finddomain.c: Better comment to last change.
+
+ * loadmsgcat.c:
+ [_LIBC]: Rename fstat, open, close, read, mmap, and munmap to
+ __fstat, __open, __close, __read, __mmap, and __munmap resp
+ to keep ANSI C name space clean.
+
+ * finddomain.c:
+ [_LIBC]: Rename stpcpy to __stpcpy to keep ANSI C name space clean.
+
+ * dcgettext.c:
+ [_LIBC]: Rename getced and stpcpy to __getcwd and __stpcpy resp to
+ keep ANSI C name space clean.
+
+ * libgettext.h:
+ Include sys/types.h for those old SysV systems out there.
+ Reported by Francesco Potorti`.
+
+ * loadmsgcat.c (use_mmap): Define if compiled for glibc.
+
+ * bindtextdom.c: Include all those standard headers
+ unconditionally if _LIBC is defined.
+
+ * finddomain.c: Fix 2 times defiend -> defined.
+
+ * textdomain.c: Include libintl.h instead of libgettext.h when
+ compiling for glibc. Include all those standard headers
+ unconditionally if _LIBC is defined.
+
+ * localealias.c, loadmsgcat.c: Prepare to be compiled in glibc.
+
+ * gettext.c:
+ Include libintl.h instead of libgettext.h when compiling for glibc.
+ Get NULL from stddef.h if we compile for glibc.
+
+ * finddomain.c: Include libintl.h instead of libgettext.h when
+ compiling for glibc. Include all those standard headers
+ unconditionally if _LIBC is defined.
+
+ * dcgettext.c: Include all those standard headers unconditionally
+ if _LIBC is defined.
+
+ * dgettext.c: If compiled in glibc include libintl.h instead of
+ libgettext.h.
+ (locale.h): Don't rely on HAVE_LOCALE_H when compiling for glibc.
+
+ * dcgettext.c: If compiled in glibc include libintl.h instead of
+ libgettext.h.
+ (getcwd): Don't rely on HAVE_GETCWD when compiling for glibc.
+
+ * bindtextdom.c:
+ If compiled in glibc include libintl.h instead of libgettext.h.
+
+Mon Sep 25 22:23:06 1995 Ulrich Drepper <drepper@myware>
+
+ * localealias.c (_nl_expand_alias): Don't call bsearch if NMAP <= 0.
+ Reported by Marcus Daniels.
+
+ * cat-compat.c (bindtextdomain):
+ String used in putenv must not be recycled.
+ Reported by Marcus Daniels.
+
+ * libgettext.h (__USE_GNU_GETTEXT):
+ Additional symbol to signal that we use GNU gettext
+ library.
+
+ * cat-compat.c (bindtextdomain):
+ Fix bug with the strange stpcpy replacement.
+ Reported by Nelson Beebe.
+
+Sat Sep 23 08:23:51 1995 Ulrich Drepper <drepper@myware>
+
+ * cat-compat.c: Include <string.h> for stpcpy prototype.
+
+ * localealias.c (read_alias_file):
+ While expand strdup code temporary variable `cp' hided
+ higher level variable with same name. Rename to `tp'.
+
+ * textdomain.c (textdomain):
+ Avoid warning by using temporary variable in strdup code.
+
+ * finddomain.c (_nl_find_domain): Remove unused variable `application'.
+
+Thu Sep 21 15:51:44 1995 Ulrich Drepper <drepper@myware>
+
+ * localealias.c (alias_compare):
+ Use strcasecmp() only if available. Else use
+ implementation in place.
+
+ * intl-compat.c:
+ Wrapper functions now call *__ functions instead of __*.
+
+ * libgettext.h: Declare prototypes for *__ functions instead for __*.
+
+ * cat-compat.c, loadmsgcat.c:
+ Don't use xmalloc, xstrdup, and stpcpy. These functions are not part
+ of the standard libc and so prevent libintl.a from being used
+ standalone.
+
+ * bindtextdom.c:
+ Don't use xmalloc, xstrdup, and stpcpy. These functions are not part
+ of the standard libc and so prevent libintl.a from being used
+ standalone.
+ Rename to bindtextdomain__ if not used in GNU C Library.
+
+ * dgettext.c:
+ Rename function to dgettext__ if not used in GNU C Library.
+
+ * gettext.c:
+ Don't use xmalloc, xstrdup, and stpcpy. These functions are not part
+ of the standard libc and so prevent libintl.a from being used
+ standalone.
+ Functions now called gettext__ if not used in GNU C Library.
+
+ * dcgettext.c, localealias.c, textdomain.c, finddomain.c:
+ Don't use xmalloc, xstrdup, and stpcpy. These functions are not part
+ of the standard libc and so prevent libintl.a from being used
+ standalone.
+
+Sun Sep 17 23:14:49 1995 Ulrich Drepper <drepper@myware>
+
+ * finddomain.c: Correct some bugs in handling of CEN standard
+ locale definitions.
+
+Thu Sep 7 01:49:28 1995 Ulrich Drepper <drepper@myware>
+
+ * finddomain.c: Implement CEN syntax.
+
+ * gettextP.h (loaded_domain): Extend number of successors to 31.
+
+Sat Aug 19 19:25:29 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (aliaspath): Remove path to X11 locale dir.
+
+ * Makefile.in: Make install-src depend on install. This helps
+ gettext to install the sources and other packages can use the
+ install goal.
+
+Sat Aug 19 15:19:33 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (uninstall): Remove stuff installed by install-src.
+
+Tue Aug 15 13:13:53 1995 Ulrich Drepper <drepper@myware>
+
+ * VERSION.in: Initial revision.
+
+ * Makefile.in (DISTFILES):
+ Add VERSION file. This is not necessary for gettext, but
+ for other packages using this library.
+
+Tue Aug 15 06:16:44 1995 Ulrich Drepper <drepper@myware>
+
+ * gettextP.h (_nl_find_domain):
+ New prototype after changing search strategy.
+
+ * finddomain.c (_nl_find_domain):
+ We now try only to find a specified catalog. Fall back to other
+ catalogs listed in the locale list is now done in __dcgettext.
+
+ * dcgettext.c (__dcgettext):
+ Now we provide message fall back even to different languages.
+ I.e. if a message is not available in one language all the other
+ in the locale list a tried. Formerly fall back was only possible
+ within one language. Implemented by moving one loop from
+ _nl_find_domain to here.
+
+Mon Aug 14 23:45:50 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (gettextsrcdir):
+ Directory where source of GNU gettext library are made
+ available.
+ (INSTALL, INSTALL_DATA): Programs used for installing sources.
+ (gettext-src): New. Rule to install GNU gettext sources for use in
+ gettextize shell script.
+
+Sun Aug 13 14:40:48 1995 Ulrich Drepper <drepper@myware>
+
+ * loadmsgcat.c (_nl_load_domain):
+ Use mmap for loading only when munmap function is
+ also available.
+
+ * Makefile.in (install): Depend on `all' goal.
+
+Wed Aug 9 11:04:33 1995 Ulrich Drepper <drepper@myware>
+
+ * localealias.c (read_alias_file):
+ Do not overwrite '\n' when terminating alias value string.
+
+ * localealias.c (read_alias_file):
+ Handle long lines. Ignore the rest not fitting in
+ the buffer after the initial `fgets' call.
+
+Wed Aug 9 00:54:29 1995 Ulrich Drepper <drepper@myware>
+
+ * gettextP.h (_nl_load_domain):
+ Add prototype, replacing prototype for _nl_load_msg_cat.
+
+ * finddomain.c (_nl_find_domain):
+ Remove unneeded variable filename and filename_len.
+ (expand_alias): Remove prototype because functions does not
+ exist anymore.
+
+ * localealias.c (read_alias_file):
+ Change type of fname_len parameter to int.
+ (xmalloc): Add prototype.
+
+ * loadmsgcat.c: Better prototypes for xmalloc.
+
+Tue Aug 8 22:30:39 1995 Ulrich Drepper <drepper@myware>
+
+ * finddomain.c (_nl_find_domain):
+ Allow alias name to be constructed from the four components.
+
+ * Makefile.in (aliaspath): New variable. Set to preliminary value.
+ (SOURCES): Add localealias.c.
+ (OBJECTS): Add localealias.o.
+
+ * gettextP.h: Add prototype for _nl_expand_alias.
+
+ * finddomain.c: Aliasing handled in intl/localealias.c.
+
+ * localealias.c: Aliasing for locale names.
+
+ * bindtextdom.c: Better prototypes for xmalloc and xstrdup.
+
+Mon Aug 7 23:47:42 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (DISTFILES): gettext.perl is now found in misc/.
+
+ * cat-compat.c (bindtextdomain):
+ Correct implementation. dirname parameter was not used.
+ Reported by Marcus Daniels.
+
+ * gettextP.h (loaded_domain):
+ New fields `successor' and `decided' for oo, lazy
+ message handling implementation.
+
+ * dcgettext.c:
+ Adopt for oo, lazy message handliing.
+ Now we can inherit translations from less specific locales.
+ (find_msg): New function.
+
+ * loadmsgcat.c, finddomain.c:
+ Complete rewrite. Implement oo, lazy message handling :-).
+ We now have an additional environment variable `LANGUAGE' with
+ a higher priority than LC_ALL for the LC_MESSAGE locale.
+ Here we can set a colon separated list of specifications each
+ of the form `language[_territory[.codeset]][@modifier]'.
+
+Sat Aug 5 09:55:42 1995 Ulrich Drepper <drepper@myware>
+
+ * finddomain.c (unistd.h):
+ Include to get _PC_PATH_MAX defined on system having it.
+
+Fri Aug 4 22:42:00 1995 Ulrich Drepper <drepper@myware>
+
+ * finddomain.c (stpcpy): Include prototype.
+
+ * Makefile.in (dist): Remove `copying instead' message.
+
+Wed Aug 2 18:52:03 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (ID, TAGS): Do not use $^.
+
+Tue Aug 1 20:07:11 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (TAGS, ID): Use $^ as command argument.
+ (TAGS): Give etags -o option t write to current directory,
+ not $(srcdir).
+ (ID): Use $(srcdir) instead os $(top_srcdir)/src.
+ (distclean): Remove ID.
+
+Sun Jul 30 11:51:46 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (gnulocaledir):
+ New variable, always using share/ for data directory.
+ (DEFS): Add GNULOCALEDIR, used in finddomain.c.
+
+ * finddomain.c (_nl_default_dirname):
+ Set to GNULOCALEDIR, because it always has to point
+ to the directory where GNU gettext Library writes it to.
+
+ * intl-compat.c (textdomain, bindtextdomain):
+ Undefine macros before function definition.
+
+Sat Jul 22 01:10:02 1995 Ulrich Drepper <drepper@myware>
+
+ * libgettext.h (_LIBINTL_H):
+ Protect definition in case where this file is included as
+ libgettext.h on Solaris machines. Add comment about this.
+
+Wed Jul 19 02:36:42 1995 Ulrich Drepper <drepper@myware>
+
+ * intl-compat.c (textdomain): Correct typo.
+
+Wed Jul 19 01:51:35 1995 Ulrich Drepper <drepper@myware>
+
+ * dcgettext.c (dcgettext): Function now called __dcgettext.
+
+ * dgettext.c (dgettext): Now called __dgettext and calls
+ __dcgettext.
+
+ * gettext.c (gettext):
+ Function now called __gettext and calls __dgettext.
+
+ * textdomain.c (textdomain): Function now called __textdomain.
+
+ * bindtextdom.c (bindtextdomain): Function now called
+ __bindtextdomain.
+
+ * intl-compat.c: Initial revision.
+
+ * Makefile.in (SOURCES): Add intl-compat.c.
+ (OBJECTS): We always compile the GNU gettext library functions.
+ OBJECTS contains all objects but cat-compat.o, ../po/cat-if-tbl.o,
+ and intl-compat.o.
+ (GETTOBJS): Contains now only intl-compat.o.
+
+ * libgettext.h:
+ Re-include protection matches dualistic character of libgettext.h.
+ For all functions in GNU gettext library define __ counter part.
+
+ * finddomain.c (strchr): Define as index if not found in C library.
+ (_nl_find_domain): For relative paths paste / in between.
+
+Tue Jul 18 16:37:45 1995 Ulrich Drepper <drepper@myware>
+
+ * loadmsgcat.c, finddomain.c: Add inclusion of sys/types.h.
+
+ * xopen-msg.sed: Fix bug with `msgstr ""' lines.
+ A little bit better comments.
+
+Tue Jul 18 01:18:27 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in:
+ po-mode.el, makelinks, combine-sh are now found in ../misc.
+
+ * po-mode.el, makelinks, combine-sh, elisp-comp:
+ Moved to ../misc/.
+
+ * libgettext.h, gettextP.h, gettext.h: Uniform test for __STDC__.
+
+Sun Jul 16 22:33:02 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (INSTALL, INSTALL_DATA): New variables.
+ (install-data, uninstall): Install/uninstall .elc file.
+
+ * po-mode.el (Installation comment):
+ Add .pox as possible extension of .po files.
+
+Sun Jul 16 13:23:27 1995 Ulrich Drepper <drepper@myware>
+
+ * elisp-comp: Complete new version by Franc,ois: This does not
+ fail when not compiling in the source directory.
+
+Sun Jul 16 00:12:17 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (../po/cat-id-tbl.o):
+ Use $(MAKE) instead of make for recursive make.
+
+ * Makefile.in (.el.elc): Use $(SHELL) instead of /bin/sh.
+ (install-exec): Add missing dummy goal.
+ (install-data, uninstall): @ in multi-line shell command at
+ beginning, not in front of echo. Reported by Eric Backus.
+
+Sat Jul 15 00:21:28 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (DISTFILES):
+ Rename libgettext.perl to gettext.perl to fit in 14 chars
+ file systems.
+
+ * gettext.perl:
+ Rename to gettext.perl to fit in 14 chars file systems.
+
+Thu Jul 13 23:17:20 1995 Ulrich Drepper <drepper@myware>
+
+ * cat-compat.c: If !STDC_HEADERS try to include malloc.h.
+
+Thu Jul 13 20:55:02 1995 Ulrich Drepper <drepper@myware>
+
+ * po2tbl.sed.in: Pretty printing.
+
+ * linux-msg.sed, xopen-msg.sed:
+ Correct bugs with handling substitute flags in branches.
+
+ * hash-string.h (hash_string):
+ Old K&R compilers don't under stand `unsigned char'.
+
+ * gettext.h (nls_uint32):
+ Some old K&R compilers (eg HP) don't understand `unsigned int'.
+
+ * cat-compat.c (msg_to_cat_id): De-ANSI-fy prototypes.
+
+Thu Jul 13 01:34:33 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (ELCFILES): New variable.
+ (DISTFILES): Add elisp-comp.
+ Add implicit rule for .el -> .elc compilation.
+ (install-data): install $ELCFILES
+ (clean): renamed po-to-tbl and po-to-msg to po2tbl and po2msg resp.
+
+ * elisp-comp: Initial revision
+
+Wed Jul 12 16:14:52 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in:
+ cat-id-tbl.c is now found in po/. This enables us to use an identical
+ intl/ directory in all packages.
+
+ * dcgettext.c (dcgettext): hashing does not work for table size <= 2.
+
+ * textdomain.c: fix typo (#if def -> #if defined)
+
+Tue Jul 11 18:44:43 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in (stamp-cat-id): use top_srcdir to address source files
+ (DISTFILES,distclean): move tupdate.perl to src/
+
+ * po-to-tbl.sed.in:
+ add additional jump to clear change flag to recognize multiline strings
+
+Tue Jul 11 01:32:50 1995 Ulrich Drepper <drepper@myware>
+
+ * textdomain.c: Protect inclusion of stdlib.h and string.h.
+
+ * loadmsgcat.c: Protect inclusion of stdlib.h.
+
+ * libgettext.h: Protect inclusion of locale.h.
+ Allow use in C++ programs.
+ Define NULL is not happened already.
+
+ * Makefile.in (DISTFILES): ship po-to-tbl.sed.in instead of
+ po-to-tbl.sed.
+ (distclean): remove po-to-tbl.sed and tupdate.perl.
+
+ * tupdate.perl.in: Substitute Perl path even in exec line.
+ Don't include entries without translation from old .po file.
+
+Tue Jul 4 00:41:51 1995 Ulrich Drepper <drepper@myware>
+
+ * tupdate.perl.in: use "Updated: " in msgid "".
+
+ * cat-compat.c: Fix typo (LOCALDIR -> LOCALEDIR).
+ Define getenv if !__STDC__.
+
+ * bindtextdom.c: Protect stdlib.h and string.h inclusion.
+ Define free if !__STDC__.
+
+ * finddomain.c: Change DEF_MSG_DOM_DIR to LOCALEDIR.
+ Define free if !__STDC__.
+
+ * cat-compat.c: Change DEF_MSG_DOM_DIR to LOCALEDIR.
+
+Mon Jul 3 23:56:30 1995 Ulrich Drepper <drepper@myware>
+
+ * Makefile.in: Use LOCALEDIR instead of DEF_MSG_DOM_DIR.
+ Remove unneeded $(srcdir) from Makefile.in dependency.
+
+ * makelinks: Add copyright and short description.
+
+ * po-mode.el: Last version for 0.7.
+
+ * tupdate.perl.in: Fix die message.
+
+ * dcgettext.c: Protect include of string.h.
+
+ * gettext.c: Protect include of stdlib.h and further tries to get NULL.
+
+ * finddomain.c: Some corrections in includes.
+
+ * Makefile.in (INCLUDES): Prune list correct path to Makefile.in.
+
+ * po-to-tbl.sed: Adopt for new .po file format.
+
+ * linux-msg.sed, xopen-msg.sed: Adopt for new .po file format.
+
+Sun Jul 2 23:55:03 1995 Ulrich Drepper <drepper@myware>
+
+ * tupdate.perl.in: Complete rewrite for new .po file format.
+
+Sun Jul 2 02:06:50 1995 Ulrich Drepper <drepper@myware>
+
+ * First official release. This directory contains all the code
+ needed to internationalize own packages. It provides functions
+ which allow to use the X/Open catgets function with an interface
+ like the Uniforum gettext function. For system which does not
+ have neither of those a complete implementation is provided.
--- /dev/null
+# Makefile for directory with message catalog handling in GNU NLS Utilities.
+# Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+PACKAGE = @PACKAGE@
+VERSION = @VERSION@
+
+SHELL = /bin/sh
+
+srcdir = @srcdir@
+top_srcdir = @top_srcdir@
+top_builddir = ..
+VPATH = @srcdir@
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+transform = @program_transform_name@
+libdir = $(exec_prefix)/lib
+includedir = $(prefix)/include
+datadir = $(prefix)/@DATADIRNAME@
+localedir = $(datadir)/locale
+gnulocaledir = $(prefix)/share/locale
+gettextsrcdir = @datadir@/gettext/intl
+aliaspath = $(localedir):.
+subdir = intl
+
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+MKINSTALLDIRS = @MKINSTALLDIRS@
+
+l = @l@
+
+AR = ar
+CC = @CC@
+LIBTOOL = @LIBTOOL@
+RANLIB = @RANLIB@
+
+DEFS = -DLOCALEDIR=\"$(localedir)\" -DGNULOCALEDIR=\"$(gnulocaledir)\" \
+-DLOCALE_ALIAS_PATH=\"$(aliaspath)\" @DEFS@
+CPPFLAGS = @CPPFLAGS@
+CFLAGS = @CFLAGS@
+LDFLAGS = @LDFLAGS@
+
+COMPILE = $(CC) -c $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $(XCFLAGS)
+
+HEADERS = $(COMHDRS) libgettext.h loadinfo.h
+COMHDRS = gettext.h gettextP.h hash-string.h
+SOURCES = $(COMSRCS) intl-compat.c cat-compat.c
+COMSRCS = bindtextdom.c dcgettext.c dgettext.c gettext.c \
+finddomain.c loadmsgcat.c localealias.c textdomain.c l10nflist.c \
+explodename.c
+OBJECTS = @INTLOBJS@ bindtextdom.$lo dcgettext.$lo dgettext.$lo gettext.$lo \
+finddomain.$lo loadmsgcat.$lo localealias.$lo textdomain.$lo l10nflist.$lo \
+explodename.$lo
+CATOBJS = cat-compat.$lo ../po/cat-id-tbl.$lo
+GETTOBJS = intl-compat.$lo
+DISTFILES.common = ChangeLog Makefile.in linux-msg.sed po2tbl.sed.in \
+xopen-msg.sed $(HEADERS) $(SOURCES)
+DISTFILES.normal = VERSION
+DISTFILES.gettext = libintl.glibc intlh.inst.in
+
+.SUFFIXES:
+.SUFFIXES: .c .o .lo
+.c.o:
+ $(COMPILE) $<
+.c.lo:
+ $(LIBTOOL) --mode=compile $(COMPILE) $<
+
+INCLUDES = -I.. -I. -I$(top_srcdir)/intl -I$(top_srcdir)/lib -I$(top_srcdir)/src
+
+all: all-@USE_INCLUDED_LIBINTL@
+
+all-yes: libintl.$la intlh.inst
+all-no:
+
+libintl.a: $(OBJECTS)
+ rm -f $@
+ $(AR) cru $@ $(OBJECTS)
+ $(RANLIB) $@
+
+libintl.la: $(OBJECTS)
+ $(LIBTOOL) --mode=link $(CC) $(LDFLAGS) -o $@ $(OBJECTS) \
+ -version-info 1:0 -rpath $(libdir)
+
+../po/cat-id-tbl.$lo: ../po/cat-id-tbl.c $(top_srcdir)/po/$(PACKAGE).pot
+ cd ../po && $(MAKE) cat-id-tbl.$lo
+
+check: all
+
+# This installation goal is only used in GNU gettext. Packages which
+# only use the library should use install instead.
+
+# We must not install the libintl.h/libintl.a files if we are on a
+# system which has the gettext() function in its C library or in a
+# separate library or use the catgets interface. A special case is
+# where configure found a previously installed GNU gettext library.
+# If you want to use the one which comes with this version of the
+# package, you have to use `configure --with-included-gettext'.
+install: install-exec install-data
+install-exec: all
+ if test "$(PACKAGE)" = "gettext" \
+ && test '@INTLOBJS@' = '$(GETTOBJS)'; then \
+ if test -r $(MKINSTALLDIRS); then \
+ $(MKINSTALLDIRS) $(libdir) $(includedir); \
+ else \
+ $(top_srcdir)/mkinstalldirs $(libdir) $(includedir); \
+ fi; \
+ $(INSTALL_DATA) intlh.inst $(includedir)/libintl.h; \
+ $(INSTALL_DATA) libintl.a $(libdir)/libintl.a; \
+ else \
+ : ; \
+ fi
+install-data: all
+ if test "$(PACKAGE)" = "gettext"; then \
+ if test -r $(MKINSTALLDIRS); then \
+ $(MKINSTALLDIRS) $(gettextsrcdir); \
+ else \
+ $(top_srcdir)/mkinstalldirs $(gettextsrcdir); \
+ fi; \
+ $(INSTALL_DATA) VERSION $(gettextsrcdir)/VERSION; \
+ dists="$(DISTFILES.common)"; \
+ for file in $$dists; do \
+ $(INSTALL_DATA) $(srcdir)/$$file $(gettextsrcdir)/$$file; \
+ done; \
+ else \
+ : ; \
+ fi
+
+# Define this as empty until I found a useful application.
+installcheck:
+
+uninstall:
+ dists="$(DISTFILES.common)"; \
+ for file in $$dists; do \
+ rm -f $(gettextsrcdir)/$$file; \
+ done
+
+info dvi:
+
+$(OBJECTS): ../config.h libgettext.h
+bindtextdom.$lo finddomain.$lo loadmsgcat.$lo: gettextP.h gettext.h loadinfo.h
+dcgettext.$lo: gettextP.h gettext.h hash-string.h loadinfo.h
+
+tags: TAGS
+
+TAGS: $(HEADERS) $(SOURCES)
+ here=`pwd`; cd $(srcdir) && etags -o $$here/TAGS $(HEADERS) $(SOURCES)
+
+id: ID
+
+ID: $(HEADERS) $(SOURCES)
+ here=`pwd`; cd $(srcdir) && mkid -f$$here/ID $(HEADERS) $(SOURCES)
+
+
+mostlyclean:
+ rm -f *.a *.o *.lo core core.*
+
+clean: mostlyclean
+
+distclean: clean
+ rm -f Makefile ID TAGS po2msg.sed po2tbl.sed libintl.h
+
+maintainer-clean: distclean
+ @echo "This command is intended for maintainers to use;"
+ @echo "it deletes files that may require special tools to rebuild."
+
+
+# GNU gettext needs not contain the file `VERSION' but contains some
+# other files which should not be distributed in other packages.
+distdir = ../$(PACKAGE)-$(VERSION)/$(subdir)
+dist distdir: Makefile $(DISTFILES)
+ if test "$(PACKAGE)" = gettext; then \
+ additional="$(DISTFILES.gettext)"; \
+ else \
+ additional="$(DISTFILES.normal)"; \
+ fi; \
+ for file in $(DISTFILES.common) $$additional; do \
+ ln $(srcdir)/$$file $(distdir) 2> /dev/null \
+ || cp -p $(srcdir)/$$file $(distdir); \
+ done
+
+dist-libc:
+ tar zcvf intl-glibc.tar.gz $(COMSRCS) $(COMHDRS) libintl.h.glibc
+
+Makefile: Makefile.in ../config.status
+ cd .. \
+ && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+# The dependency for intlh.inst is different in gettext and all other
+# packages. Because we cannot you GNU make features we have to solve
+# the problem while rewriting Makefile.in.
+@GT_YES@intlh.inst: intlh.inst.in ../config.status
+@GT_YES@ cd .. \
+@GT_YES@ && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= \
+@GT_YES@ $(SHELL) ./config.status
+@GT_NO@.PHONY: intlh.inst
+@GT_NO@intlh.inst:
+
+# Tell versions [3.59,3.63) of GNU make not to export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
--- /dev/null
+/* Implementation of the bindtextdomain(3) function
+ Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#if defined STDC_HEADERS || defined _LIBC
+# include <stdlib.h>
+#else
+# ifdef HAVE_MALLOC_H
+# include <malloc.h>
+# else
+void free ();
+# endif
+#endif
+
+#if defined HAVE_STRING_H || defined _LIBC
+# include <string.h>
+#else
+# include <strings.h>
+# ifndef memcpy
+# define memcpy(Dst, Src, Num) bcopy (Src, Dst, Num)
+# endif
+#endif
+
+#ifdef _LIBC
+# include <libintl.h>
+#else
+# include "libgettext.h"
+#endif
+#include "gettext.h"
+#include "gettextP.h"
+
+/* @@ end of prolog @@ */
+
+/* Contains the default location of the message catalogs. */
+extern const char _nl_default_dirname[];
+
+/* List with bindings of specific domains. */
+extern struct binding *_nl_domain_bindings;
+
+
+/* Names for the libintl functions are a problem. They must not clash
+ with existing names and they should follow ANSI C. But this source
+ code is also used in GNU C Library where the names have a __
+ prefix. So we have to make a difference here. */
+#ifdef _LIBC
+# define BINDTEXTDOMAIN __bindtextdomain
+# define strdup(str) __strdup (str)
+#else
+# define BINDTEXTDOMAIN bindtextdomain__
+#endif
+
+/* Specify that the DOMAINNAME message catalog will be found
+ in DIRNAME rather than in the system locale data base. */
+char *
+BINDTEXTDOMAIN (domainname, dirname)
+ const char *domainname;
+ const char *dirname;
+{
+ struct binding *binding;
+
+ /* Some sanity checks. */
+ if (domainname == NULL || domainname[0] == '\0')
+ return NULL;
+
+ for (binding = _nl_domain_bindings; binding != NULL; binding = binding->next)
+ {
+ int compare = strcmp (domainname, binding->domainname);
+ if (compare == 0)
+ /* We found it! */
+ break;
+ if (compare < 0)
+ {
+ /* It is not in the list. */
+ binding = NULL;
+ break;
+ }
+ }
+
+ if (dirname == NULL)
+ /* The current binding has be to returned. */
+ return binding == NULL ? (char *) _nl_default_dirname : binding->dirname;
+
+ if (binding != NULL)
+ {
+ /* The domain is already bound. If the new value and the old
+ one are equal we simply do nothing. Otherwise replace the
+ old binding. */
+ if (strcmp (dirname, binding->dirname) != 0)
+ {
+ char *new_dirname;
+
+ if (strcmp (dirname, _nl_default_dirname) == 0)
+ new_dirname = (char *) _nl_default_dirname;
+ else
+ {
+#if defined _LIBC || defined HAVE_STRDUP
+ new_dirname = strdup (dirname);
+ if (new_dirname == NULL)
+ return NULL;
+#else
+ size_t len = strlen (dirname) + 1;
+ new_dirname = (char *) malloc (len);
+ if (new_dirname == NULL)
+ return NULL;
+
+ memcpy (new_dirname, dirname, len);
+#endif
+ }
+
+ if (binding->dirname != _nl_default_dirname)
+ free (binding->dirname);
+
+ binding->dirname = new_dirname;
+ }
+ }
+ else
+ {
+ /* We have to create a new binding. */
+ size_t len;
+ struct binding *new_binding =
+ (struct binding *) malloc (sizeof (*new_binding));
+
+ if (new_binding == NULL)
+ return NULL;
+
+#if defined _LIBC || defined HAVE_STRDUP
+ new_binding->domainname = strdup (domainname);
+ if (new_binding->domainname == NULL)
+ return NULL;
+#else
+ len = strlen (domainname) + 1;
+ new_binding->domainname = (char *) malloc (len);
+ if (new_binding->domainname == NULL)
+ return NULL;
+ memcpy (new_binding->domainname, domainname, len);
+#endif
+
+ if (strcmp (dirname, _nl_default_dirname) == 0)
+ new_binding->dirname = (char *) _nl_default_dirname;
+ else
+ {
+#if defined _LIBC || defined HAVE_STRDUP
+ new_binding->dirname = strdup (dirname);
+ if (new_binding->dirname == NULL)
+ return NULL;
+#else
+ len = strlen (dirname) + 1;
+ new_binding->dirname = (char *) malloc (len);
+ if (new_binding->dirname == NULL)
+ return NULL;
+ memcpy (new_binding->dirname, dirname, len);
+#endif
+ }
+
+ /* Now enqueue it. */
+ if (_nl_domain_bindings == NULL
+ || strcmp (domainname, _nl_domain_bindings->domainname) < 0)
+ {
+ new_binding->next = _nl_domain_bindings;
+ _nl_domain_bindings = new_binding;
+ }
+ else
+ {
+ binding = _nl_domain_bindings;
+ while (binding->next != NULL
+ && strcmp (domainname, binding->next->domainname) > 0)
+ binding = binding->next;
+
+ new_binding->next = binding->next;
+ binding->next = new_binding;
+ }
+
+ binding = new_binding;
+ }
+
+ return binding->dirname;
+}
+
+#ifdef _LIBC
+/* Alias for function name in GNU C Library. */
+weak_alias (__bindtextdomain, bindtextdomain);
+#endif
--- /dev/null
+/* Compatibility code for gettext-using-catgets interface.
+ Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <stdio.h>
+
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <string.h>
+#else
+char *getenv ();
+# ifdef HAVE_MALLOC_H
+# include <malloc.h>
+# endif
+#endif
+
+#ifdef HAVE_NL_TYPES_H
+# include <nl_types.h>
+#endif
+
+#include "libgettext.h"
+
+/* @@ end of prolog @@ */
+
+/* XPG3 defines the result of `setlocale (category, NULL)' as:
+ ``Directs `setlocale()' to query `category' and return the current
+ setting of `local'.''
+ However it does not specify the exact format. And even worse: POSIX
+ defines this not at all. So we can use this feature only on selected
+ system (e.g. those using GNU C Library). */
+#ifdef _LIBC
+# define HAVE_LOCALE_NULL
+#endif
+
+/* The catalog descriptor. */
+static nl_catd catalog = (nl_catd) -1;
+
+/* Name of the default catalog. */
+static const char default_catalog_name[] = "messages";
+
+/* Name of currently used catalog. */
+static const char *catalog_name = default_catalog_name;
+
+/* Get ID for given string. If not found return -1. */
+static int msg_to_cat_id PARAMS ((const char *msg));
+
+/* Substitution for systems lacking this function in their C library. */
+#if !_LIBC && !HAVE_STPCPY
+static char *stpcpy PARAMS ((char *dest, const char *src));
+#endif
+
+
+/* Set currently used domain/catalog. */
+char *
+textdomain (domainname)
+ const char *domainname;
+{
+ nl_catd new_catalog;
+ char *new_name;
+ size_t new_name_len;
+ char *lang;
+
+#if defined HAVE_SETLOCALE && defined HAVE_LC_MESSAGES \
+ && defined HAVE_LOCALE_NULL
+ lang = setlocale (LC_MESSAGES, NULL);
+#else
+ lang = getenv ("LC_ALL");
+ if (lang == NULL || lang[0] == '\0')
+ {
+ lang = getenv ("LC_MESSAGES");
+ if (lang == NULL || lang[0] == '\0')
+ lang = getenv ("LANG");
+ }
+#endif
+ if (lang == NULL || lang[0] == '\0')
+ lang = "C";
+
+ /* See whether name of currently used domain is asked. */
+ if (domainname == NULL)
+ return (char *) catalog_name;
+
+ if (domainname[0] == '\0')
+ domainname = default_catalog_name;
+
+ /* Compute length of added path element. */
+ new_name_len = sizeof (LOCALEDIR) - 1 + 1 + strlen (lang)
+ + sizeof ("/LC_MESSAGES/") - 1 + sizeof (PACKAGE) - 1
+ + sizeof (".cat");
+
+ new_name = (char *) malloc (new_name_len);
+ if (new_name == NULL)
+ return NULL;
+
+ strcpy (new_name, PACKAGE);
+ new_catalog = catopen (new_name, 0);
+
+ if (new_catalog == (nl_catd) -1)
+ {
+ /* NLSPATH search didn't work, try absolute path */
+ sprintf (new_name, "%s/%s/LC_MESSAGES/%s.cat", LOCALEDIR, lang,
+ PACKAGE);
+ new_catalog = catopen (new_name, 0);
+
+ if (new_catalog == (nl_catd) -1)
+ {
+ free (new_name);
+ return (char *) catalog_name;
+ }
+ }
+
+ /* Close old catalog. */
+ if (catalog != (nl_catd) -1)
+ catclose (catalog);
+ if (catalog_name != default_catalog_name)
+ free ((char *) catalog_name);
+
+ catalog = new_catalog;
+ catalog_name = new_name;
+
+ return (char *) catalog_name;
+}
+
+char *
+bindtextdomain (domainname, dirname)
+ const char *domainname;
+ const char *dirname;
+{
+#if HAVE_SETENV || HAVE_PUTENV
+ char *old_val, *new_val, *cp;
+ size_t new_val_len;
+
+ /* This does not make much sense here but to be compatible do it. */
+ if (domainname == NULL)
+ return NULL;
+
+ /* Compute length of added path element. If we use setenv we don't need
+ the first byts for NLSPATH=, but why complicate the code for this
+ peanuts. */
+ new_val_len = sizeof ("NLSPATH=") - 1 + strlen (dirname)
+ + sizeof ("/%L/LC_MESSAGES/%N.cat");
+
+ old_val = getenv ("NLSPATH");
+ if (old_val == NULL || old_val[0] == '\0')
+ {
+ old_val = NULL;
+ new_val_len += 1 + sizeof (LOCALEDIR) - 1
+ + sizeof ("/%L/LC_MESSAGES/%N.cat");
+ }
+ else
+ new_val_len += strlen (old_val);
+
+ new_val = (char *) malloc (new_val_len);
+ if (new_val == NULL)
+ return NULL;
+
+# if HAVE_SETENV
+ cp = new_val;
+# else
+ cp = stpcpy (new_val, "NLSPATH=");
+# endif
+
+ cp = stpcpy (cp, dirname);
+ cp = stpcpy (cp, "/%L/LC_MESSAGES/%N.cat:");
+
+ if (old_val == NULL)
+ {
+# if __STDC__
+ stpcpy (cp, LOCALEDIR "/%L/LC_MESSAGES/%N.cat");
+# else
+
+ cp = stpcpy (cp, LOCALEDIR);
+ stpcpy (cp, "/%L/LC_MESSAGES/%N.cat");
+# endif
+ }
+ else
+ stpcpy (cp, old_val);
+
+# if HAVE_SETENV
+ setenv ("NLSPATH", new_val, 1);
+ free (new_val);
+# else
+ putenv (new_val);
+ /* Do *not* free the environment entry we just entered. It is used
+ from now on. */
+# endif
+
+#endif
+
+ return (char *) domainname;
+}
+
+#undef gettext
+char *
+gettext (msg)
+ const char *msg;
+{
+ int msgid;
+
+ if (msg == NULL || catalog == (nl_catd) -1)
+ return (char *) msg;
+
+ /* Get the message from the catalog. We always use set number 1.
+ The message ID is computed by the function `msg_to_cat_id'
+ which works on the table generated by `po-to-tbl'. */
+ msgid = msg_to_cat_id (msg);
+ if (msgid == -1)
+ return (char *) msg;
+
+ return catgets (catalog, 1, msgid, (char *) msg);
+}
+
+/* Look through the table `_msg_tbl' which has `_msg_tbl_length' entries
+ for the one equal to msg. If it is found return the ID. In case when
+ the string is not found return -1. */
+static int
+msg_to_cat_id (msg)
+ const char *msg;
+{
+ int cnt;
+
+ for (cnt = 0; cnt < _msg_tbl_length; ++cnt)
+ if (strcmp (msg, _msg_tbl[cnt]._msg) == 0)
+ return _msg_tbl[cnt]._msg_number;
+
+ return -1;
+}
+
+
+/* @@ begin of epilog @@ */
+
+/* We don't want libintl.a to depend on any other library. So we
+ avoid the non-standard function stpcpy. In GNU C Library this
+ function is available, though. Also allow the symbol HAVE_STPCPY
+ to be defined. */
+#if !_LIBC && !HAVE_STPCPY
+static char *
+stpcpy (dest, src)
+ char *dest;
+ const char *src;
+{
+ while ((*dest++ = *src++) != '\0')
+ /* Do nothing. */ ;
+ return dest - 1;
+}
+#endif
--- /dev/null
+/* Implementation of the dcgettext(3) function
+ Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <sys/types.h>
+
+#ifdef __GNUC__
+# define alloca __builtin_alloca
+# define HAVE_ALLOCA 1
+#else
+# if defined HAVE_ALLOCA_H || defined _LIBC
+# include <alloca.h>
+# else
+# ifdef _AIX
+ #pragma alloca
+# else
+# ifndef alloca
+char *alloca ();
+# endif
+# endif
+# endif
+#endif
+
+#include <errno.h>
+#ifndef errno
+extern int errno;
+#endif
+#ifndef __set_errno
+# define __set_errno(val) errno = (val)
+#endif
+
+#if defined STDC_HEADERS || defined _LIBC
+# include <stdlib.h>
+#else
+char *getenv ();
+# ifdef HAVE_MALLOC_H
+# include <malloc.h>
+# else
+void free ();
+# endif
+#endif
+
+#if defined HAVE_STRING_H || defined _LIBC
+# ifndef _GNU_SOURCE
+# define _GNU_SOURCE 1
+# endif
+# include <string.h>
+#else
+# include <strings.h>
+#endif
+#if !HAVE_STRCHR && !defined _LIBC
+# ifndef strchr
+# define strchr index
+# endif
+#endif
+
+#if defined HAVE_UNISTD_H || defined _LIBC
+# include <unistd.h>
+#endif
+
+#include "gettext.h"
+#include "gettextP.h"
+#ifdef _LIBC
+# include <libintl.h>
+#else
+# include "libgettext.h"
+#endif
+#include "hash-string.h"
+
+/* @@ end of prolog @@ */
+
+#ifdef _LIBC
+/* Rename the non ANSI C functions. This is required by the standard
+ because some ANSI C functions will require linking with this object
+ file and the name space must not be polluted. */
+# define getcwd __getcwd
+# define stpcpy __stpcpy
+#else
+# if !defined HAVE_GETCWD
+char *getwd ();
+# define getcwd(buf, max) getwd (buf)
+# else
+char *getcwd ();
+# endif
+# ifndef HAVE_STPCPY
+static char *stpcpy PARAMS ((char *dest, const char *src));
+# endif
+#endif
+
+/* Amount to increase buffer size by in each try. */
+#define PATH_INCR 32
+
+/* The following is from pathmax.h. */
+/* Non-POSIX BSD systems might have gcc's limits.h, which doesn't define
+ PATH_MAX but might cause redefinition warnings when sys/param.h is
+ later included (as on MORE/BSD 4.3). */
+#if defined(_POSIX_VERSION) || (defined(HAVE_LIMITS_H) && !defined(__GNUC__))
+# include <limits.h>
+#endif
+
+#ifndef _POSIX_PATH_MAX
+# define _POSIX_PATH_MAX 255
+#endif
+
+#if !defined(PATH_MAX) && defined(_PC_PATH_MAX)
+# define PATH_MAX (pathconf ("/", _PC_PATH_MAX) < 1 ? 1024 : pathconf ("/", _PC_PATH_MAX))
+#endif
+
+/* Don't include sys/param.h if it already has been. */
+#if defined(HAVE_SYS_PARAM_H) && !defined(PATH_MAX) && !defined(MAXPATHLEN)
+# include <sys/param.h>
+#endif
+
+#if !defined(PATH_MAX) && defined(MAXPATHLEN)
+# define PATH_MAX MAXPATHLEN
+#endif
+
+#ifndef PATH_MAX
+# define PATH_MAX _POSIX_PATH_MAX
+#endif
+
+/* XPG3 defines the result of `setlocale (category, NULL)' as:
+ ``Directs `setlocale()' to query `category' and return the current
+ setting of `local'.''
+ However it does not specify the exact format. And even worse: POSIX
+ defines this not at all. So we can use this feature only on selected
+ system (e.g. those using GNU C Library). */
+#ifdef _LIBC
+# define HAVE_LOCALE_NULL
+#endif
+
+/* Name of the default domain used for gettext(3) prior any call to
+ textdomain(3). The default value for this is "messages". */
+const char _nl_default_default_domain[] = "messages";
+
+/* Value used as the default domain for gettext(3). */
+const char *_nl_current_default_domain = _nl_default_default_domain;
+
+/* Contains the default location of the message catalogs. */
+const char _nl_default_dirname[] = GNULOCALEDIR;
+
+/* List with bindings of specific domains created by bindtextdomain()
+ calls. */
+struct binding *_nl_domain_bindings;
+
+/* Prototypes for local functions. */
+static char *find_msg PARAMS ((struct loaded_l10nfile *domain_file,
+ const char *msgid));
+static const char *category_to_name PARAMS ((int category));
+static const char *guess_category_value PARAMS ((int category,
+ const char *categoryname));
+
+
+/* For those loosing systems which don't have `alloca' we have to add
+ some additional code emulating it. */
+#ifdef HAVE_ALLOCA
+/* Nothing has to be done. */
+# define ADD_BLOCK(list, address) /* nothing */
+# define FREE_BLOCKS(list) /* nothing */
+#else
+struct block_list
+{
+ void *address;
+ struct block_list *next;
+};
+# define ADD_BLOCK(list, addr) \
+ do { \
+ struct block_list *newp = (struct block_list *) malloc (sizeof (*newp)); \
+ /* If we cannot get a free block we cannot add the new element to \
+ the list. */ \
+ if (newp != NULL) { \
+ newp->address = (addr); \
+ newp->next = (list); \
+ (list) = newp; \
+ } \
+ } while (0)
+# define FREE_BLOCKS(list) \
+ do { \
+ while (list != NULL) { \
+ struct block_list *old = list; \
+ list = list->next; \
+ free (old); \
+ } \
+ } while (0)
+# undef alloca
+# define alloca(size) (malloc (size))
+#endif /* have alloca */
+
+
+/* Names for the libintl functions are a problem. They must not clash
+ with existing names and they should follow ANSI C. But this source
+ code is also used in GNU C Library where the names have a __
+ prefix. So we have to make a difference here. */
+#ifdef _LIBC
+# define DCGETTEXT __dcgettext
+#else
+# define DCGETTEXT dcgettext__
+#endif
+
+/* Look up MSGID in the DOMAINNAME message catalog for the current CATEGORY
+ locale. */
+char *
+DCGETTEXT (domainname, msgid, category)
+ const char *domainname;
+ const char *msgid;
+ int category;
+{
+#ifndef HAVE_ALLOCA
+ struct block_list *block_list = NULL;
+#endif
+ struct loaded_l10nfile *domain;
+ struct binding *binding;
+ const char *categoryname;
+ const char *categoryvalue;
+ char *dirname, *xdomainname;
+ char *single_locale;
+ char *retval;
+ int saved_errno = errno;
+
+ /* If no real MSGID is given return NULL. */
+ if (msgid == NULL)
+ return NULL;
+
+ /* If DOMAINNAME is NULL, we are interested in the default domain. If
+ CATEGORY is not LC_MESSAGES this might not make much sense but the
+ defintion left this undefined. */
+ if (domainname == NULL)
+ domainname = _nl_current_default_domain;
+
+ /* First find matching binding. */
+ for (binding = _nl_domain_bindings; binding != NULL; binding = binding->next)
+ {
+ int compare = strcmp (domainname, binding->domainname);
+ if (compare == 0)
+ /* We found it! */
+ break;
+ if (compare < 0)
+ {
+ /* It is not in the list. */
+ binding = NULL;
+ break;
+ }
+ }
+
+ if (binding == NULL)
+ dirname = (char *) _nl_default_dirname;
+ else if (binding->dirname[0] == '/')
+ dirname = binding->dirname;
+ else
+ {
+ /* We have a relative path. Make it absolute now. */
+ size_t dirname_len = strlen (binding->dirname) + 1;
+ size_t path_max;
+ char *ret;
+
+ path_max = (unsigned) PATH_MAX;
+ path_max += 2; /* The getcwd docs say to do this. */
+
+ dirname = (char *) alloca (path_max + dirname_len);
+ ADD_BLOCK (block_list, dirname);
+
+ __set_errno (0);
+ while ((ret = getcwd (dirname, path_max)) == NULL && errno == ERANGE)
+ {
+ path_max += PATH_INCR;
+ dirname = (char *) alloca (path_max + dirname_len);
+ ADD_BLOCK (block_list, dirname);
+ __set_errno (0);
+ }
+
+ if (ret == NULL)
+ {
+ /* We cannot get the current working directory. Don't signal an
+ error but simply return the default string. */
+ FREE_BLOCKS (block_list);
+ __set_errno (saved_errno);
+ return (char *) msgid;
+ }
+
+ stpcpy (stpcpy (strchr (dirname, '\0'), "/"), binding->dirname);
+ }
+
+ /* Now determine the symbolic name of CATEGORY and its value. */
+ categoryname = category_to_name (category);
+ categoryvalue = guess_category_value (category, categoryname);
+
+ xdomainname = (char *) alloca (strlen (categoryname)
+ + strlen (domainname) + 5);
+ ADD_BLOCK (block_list, xdomainname);
+
+ stpcpy (stpcpy (stpcpy (stpcpy (xdomainname, categoryname), "/"),
+ domainname),
+ ".mo");
+
+ /* Creating working area. */
+ single_locale = (char *) alloca (strlen (categoryvalue) + 1);
+ ADD_BLOCK (block_list, single_locale);
+
+
+ /* Search for the given string. This is a loop because we perhaps
+ got an ordered list of languages to consider for th translation. */
+ while (1)
+ {
+ /* Make CATEGORYVALUE point to the next element of the list. */
+ while (categoryvalue[0] != '\0' && categoryvalue[0] == ':')
+ ++categoryvalue;
+ if (categoryvalue[0] == '\0')
+ {
+ /* The whole contents of CATEGORYVALUE has been searched but
+ no valid entry has been found. We solve this situation
+ by implicitly appending a "C" entry, i.e. no translation
+ will take place. */
+ single_locale[0] = 'C';
+ single_locale[1] = '\0';
+ }
+ else
+ {
+ char *cp = single_locale;
+ while (categoryvalue[0] != '\0' && categoryvalue[0] != ':')
+ *cp++ = *categoryvalue++;
+ *cp = '\0';
+ }
+
+ /* If the current locale value is C (or POSIX) we don't load a
+ domain. Return the MSGID. */
+ if (strcmp (single_locale, "C") == 0
+ || strcmp (single_locale, "POSIX") == 0)
+ {
+ FREE_BLOCKS (block_list);
+ __set_errno (saved_errno);
+ return (char *) msgid;
+ }
+
+
+ /* Find structure describing the message catalog matching the
+ DOMAINNAME and CATEGORY. */
+ domain = _nl_find_domain (dirname, single_locale, xdomainname);
+
+ if (domain != NULL)
+ {
+ retval = find_msg (domain, msgid);
+
+ if (retval == NULL)
+ {
+ int cnt;
+
+ for (cnt = 0; domain->successor[cnt] != NULL; ++cnt)
+ {
+ retval = find_msg (domain->successor[cnt], msgid);
+
+ if (retval != NULL)
+ break;
+ }
+ }
+
+ if (retval != NULL)
+ {
+ FREE_BLOCKS (block_list);
+ __set_errno (saved_errno);
+ return retval;
+ }
+ }
+ }
+ /* NOTREACHED */
+}
+
+#ifdef _LIBC
+/* Alias for function name in GNU C Library. */
+weak_alias (__dcgettext, dcgettext);
+#endif
+
+
+static char *
+find_msg (domain_file, msgid)
+ struct loaded_l10nfile *domain_file;
+ const char *msgid;
+{
+ size_t top, act, bottom;
+ struct loaded_domain *domain;
+
+ if (domain_file->decided == 0)
+ _nl_load_domain (domain_file);
+
+ if (domain_file->data == NULL)
+ return NULL;
+
+ domain = (struct loaded_domain *) domain_file->data;
+
+ /* Locate the MSGID and its translation. */
+ if (domain->hash_size > 2 && domain->hash_tab != NULL)
+ {
+ /* Use the hashing table. */
+ nls_uint32 len = strlen (msgid);
+ nls_uint32 hash_val = hash_string (msgid);
+ nls_uint32 idx = hash_val % domain->hash_size;
+ nls_uint32 incr = 1 + (hash_val % (domain->hash_size - 2));
+ nls_uint32 nstr = W (domain->must_swap, domain->hash_tab[idx]);
+
+ if (nstr == 0)
+ /* Hash table entry is empty. */
+ return NULL;
+
+ if (W (domain->must_swap, domain->orig_tab[nstr - 1].length) == len
+ && strcmp (msgid,
+ domain->data + W (domain->must_swap,
+ domain->orig_tab[nstr - 1].offset)) == 0)
+ return (char *) domain->data + W (domain->must_swap,
+ domain->trans_tab[nstr - 1].offset);
+
+ while (1)
+ {
+ if (idx >= domain->hash_size - incr)
+ idx -= domain->hash_size - incr;
+ else
+ idx += incr;
+
+ nstr = W (domain->must_swap, domain->hash_tab[idx]);
+ if (nstr == 0)
+ /* Hash table entry is empty. */
+ return NULL;
+
+ if (W (domain->must_swap, domain->orig_tab[nstr - 1].length) == len
+ && strcmp (msgid,
+ domain->data + W (domain->must_swap,
+ domain->orig_tab[nstr - 1].offset))
+ == 0)
+ return (char *) domain->data
+ + W (domain->must_swap, domain->trans_tab[nstr - 1].offset);
+ }
+ /* NOTREACHED */
+ }
+
+ /* Now we try the default method: binary search in the sorted
+ array of messages. */
+ bottom = 0;
+ top = domain->nstrings;
+ while (bottom < top)
+ {
+ int cmp_val;
+
+ act = (bottom + top) / 2;
+ cmp_val = strcmp (msgid, domain->data
+ + W (domain->must_swap,
+ domain->orig_tab[act].offset));
+ if (cmp_val < 0)
+ top = act;
+ else if (cmp_val > 0)
+ bottom = act + 1;
+ else
+ break;
+ }
+
+ /* If an translation is found return this. */
+ return bottom >= top ? NULL : (char *) domain->data
+ + W (domain->must_swap,
+ domain->trans_tab[act].offset);
+}
+
+
+/* Return string representation of locale CATEGORY. */
+static const char *
+category_to_name (category)
+ int category;
+{
+ const char *retval;
+
+ switch (category)
+ {
+#ifdef LC_COLLATE
+ case LC_COLLATE:
+ retval = "LC_COLLATE";
+ break;
+#endif
+#ifdef LC_CTYPE
+ case LC_CTYPE:
+ retval = "LC_CTYPE";
+ break;
+#endif
+#ifdef LC_MONETARY
+ case LC_MONETARY:
+ retval = "LC_MONETARY";
+ break;
+#endif
+#ifdef LC_NUMERIC
+ case LC_NUMERIC:
+ retval = "LC_NUMERIC";
+ break;
+#endif
+#ifdef LC_TIME
+ case LC_TIME:
+ retval = "LC_TIME";
+ break;
+#endif
+#ifdef LC_MESSAGES
+ case LC_MESSAGES:
+ retval = "LC_MESSAGES";
+ break;
+#endif
+#ifdef LC_RESPONSE
+ case LC_RESPONSE:
+ retval = "LC_RESPONSE";
+ break;
+#endif
+#ifdef LC_ALL
+ case LC_ALL:
+ /* This might not make sense but is perhaps better than any other
+ value. */
+ retval = "LC_ALL";
+ break;
+#endif
+ default:
+ /* If you have a better idea for a default value let me know. */
+ retval = "LC_XXX";
+ }
+
+ return retval;
+}
+
+/* Guess value of current locale from value of the environment variables. */
+static const char *
+guess_category_value (category, categoryname)
+ int category;
+ const char *categoryname;
+{
+ const char *retval;
+
+ /* The highest priority value is the `LANGUAGE' environment
+ variable. This is a GNU extension. */
+ retval = getenv ("LANGUAGE");
+ if (retval != NULL && retval[0] != '\0')
+ return retval;
+
+ /* `LANGUAGE' is not set. So we have to proceed with the POSIX
+ methods of looking to `LC_ALL', `LC_xxx', and `LANG'. On some
+ systems this can be done by the `setlocale' function itself. */
+#if defined HAVE_SETLOCALE && defined HAVE_LC_MESSAGES && defined HAVE_LOCALE_NULL
+ return setlocale (category, NULL);
+#else
+ /* Setting of LC_ALL overwrites all other. */
+ retval = getenv ("LC_ALL");
+ if (retval != NULL && retval[0] != '\0')
+ return retval;
+
+ /* Next comes the name of the desired category. */
+ retval = getenv (categoryname);
+ if (retval != NULL && retval[0] != '\0')
+ return retval;
+
+ /* Last possibility is the LANG environment variable. */
+ retval = getenv ("LANG");
+ if (retval != NULL && retval[0] != '\0')
+ return retval;
+
+ /* We use C as the default domain. POSIX says this is implementation
+ defined. */
+ return "C";
+#endif
+}
+
+/* @@ begin of epilog @@ */
+
+/* We don't want libintl.a to depend on any other library. So we
+ avoid the non-standard function stpcpy. In GNU C Library this
+ function is available, though. Also allow the symbol HAVE_STPCPY
+ to be defined. */
+#if !_LIBC && !HAVE_STPCPY
+static char *
+stpcpy (dest, src)
+ char *dest;
+ const char *src;
+{
+ while ((*dest++ = *src++) != '\0')
+ /* Do nothing. */ ;
+ return dest - 1;
+}
+#endif
--- /dev/null
+/* dgettext.c -- implementation of the dgettext(3) function
+ Copyright (C) 1995 Software Foundation, Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#if defined HAVE_LOCALE_H || defined _LIBC
+# include <locale.h>
+#endif
+
+#ifdef _LIBC
+# include <libintl.h>
+#else
+# include "libgettext.h"
+#endif
+
+/* @@ end of prolog @@ */
+
+/* Names for the libintl functions are a problem. They must not clash
+ with existing names and they should follow ANSI C. But this source
+ code is also used in GNU C Library where the names have a __
+ prefix. So we have to make a difference here. */
+#ifdef _LIBC
+# define DGETTEXT __dgettext
+# define DCGETTEXT __dcgettext
+#else
+# define DGETTEXT dgettext__
+# define DCGETTEXT dcgettext__
+#endif
+
+/* Look up MSGID in the DOMAINNAME message catalog of the current
+ LC_MESSAGES locale. */
+char *
+DGETTEXT (domainname, msgid)
+ const char *domainname;
+ const char *msgid;
+{
+ return DCGETTEXT (domainname, msgid, LC_MESSAGES);
+}
+
+#ifdef _LIBC
+/* Alias for function name in GNU C Library. */
+weak_alias (__dgettext, dgettext);
+#endif
--- /dev/null
+/* Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+ Contributed by Ulrich Drepper <drepper@gnu.org>, 1995.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <stdlib.h>
+#include <string.h>
+#include <sys/types.h>
+
+#include "loadinfo.h"
+
+/* On some strange systems still no definition of NULL is found. Sigh! */
+#ifndef NULL
+# if defined __STDC__ && __STDC__
+# define NULL ((void *) 0)
+# else
+# define NULL 0
+# endif
+#endif
+
+/* @@ end of prolog @@ */
+
+int
+_nl_explode_name (name, language, modifier, territory, codeset,
+ normalized_codeset, special, sponsor, revision)
+ char *name;
+ const char **language;
+ const char **modifier;
+ const char **territory;
+ const char **codeset;
+ const char **normalized_codeset;
+ const char **special;
+ const char **sponsor;
+ const char **revision;
+{
+ enum { undecided, xpg, cen } syntax;
+ char *cp;
+ int mask;
+
+ *modifier = NULL;
+ *territory = NULL;
+ *codeset = NULL;
+ *normalized_codeset = NULL;
+ *special = NULL;
+ *sponsor = NULL;
+ *revision = NULL;
+
+ /* Now we determine the single parts of the locale name. First
+ look for the language. Termination symbols are `_' and `@' if
+ we use XPG4 style, and `_', `+', and `,' if we use CEN syntax. */
+ mask = 0;
+ syntax = undecided;
+ *language = cp = name;
+ while (cp[0] != '\0' && cp[0] != '_' && cp[0] != '@'
+ && cp[0] != '+' && cp[0] != ',')
+ ++cp;
+
+ if (*language == cp)
+ /* This does not make sense: language has to be specified. Use
+ this entry as it is without exploding. Perhaps it is an alias. */
+ cp = strchr (*language, '\0');
+ else if (cp[0] == '_')
+ {
+ /* Next is the territory. */
+ cp[0] = '\0';
+ *territory = ++cp;
+
+ while (cp[0] != '\0' && cp[0] != '.' && cp[0] != '@'
+ && cp[0] != '+' && cp[0] != ',' && cp[0] != '_')
+ ++cp;
+
+ mask |= TERRITORY;
+
+ if (cp[0] == '.')
+ {
+ /* Next is the codeset. */
+ syntax = xpg;
+ cp[0] = '\0';
+ *codeset = ++cp;
+
+ while (cp[0] != '\0' && cp[0] != '@')
+ ++cp;
+
+ mask |= XPG_CODESET;
+
+ if (*codeset != cp && (*codeset)[0] != '\0')
+ {
+ *normalized_codeset = _nl_normalize_codeset (*codeset,
+ cp - *codeset);
+ if (strcmp (*codeset, *normalized_codeset) == 0)
+ free ((char *) *normalized_codeset);
+ else
+ mask |= XPG_NORM_CODESET;
+ }
+ }
+ }
+
+ if (cp[0] == '@' || (syntax != xpg && cp[0] == '+'))
+ {
+ /* Next is the modifier. */
+ syntax = cp[0] == '@' ? xpg : cen;
+ cp[0] = '\0';
+ *modifier = ++cp;
+
+ while (syntax == cen && cp[0] != '\0' && cp[0] != '+'
+ && cp[0] != ',' && cp[0] != '_')
+ ++cp;
+
+ mask |= XPG_MODIFIER | CEN_AUDIENCE;
+ }
+
+ if (syntax != xpg && (cp[0] == '+' || cp[0] == ',' || cp[0] == '_'))
+ {
+ syntax = cen;
+
+ if (cp[0] == '+')
+ {
+ /* Next is special application (CEN syntax). */
+ cp[0] = '\0';
+ *special = ++cp;
+
+ while (cp[0] != '\0' && cp[0] != ',' && cp[0] != '_')
+ ++cp;
+
+ mask |= CEN_SPECIAL;
+ }
+
+ if (cp[0] == ',')
+ {
+ /* Next is sponsor (CEN syntax). */
+ cp[0] = '\0';
+ *sponsor = ++cp;
+
+ while (cp[0] != '\0' && cp[0] != '_')
+ ++cp;
+
+ mask |= CEN_SPONSOR;
+ }
+
+ if (cp[0] == '_')
+ {
+ /* Next is revision (CEN syntax). */
+ cp[0] = '\0';
+ *revision = ++cp;
+
+ mask |= CEN_REVISION;
+ }
+ }
+
+ /* For CEN syntax values it might be important to have the
+ separator character in the file name, not for XPG syntax. */
+ if (syntax == xpg)
+ {
+ if (*territory != NULL && (*territory)[0] == '\0')
+ mask &= ~TERRITORY;
+
+ if (*codeset != NULL && (*codeset)[0] == '\0')
+ mask &= ~XPG_CODESET;
+
+ if (*modifier != NULL && (*modifier)[0] == '\0')
+ mask &= ~XPG_MODIFIER;
+ }
+
+ return mask;
+}
--- /dev/null
+/* Handle list of needed message catalogs
+ Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+ Written by Ulrich Drepper <drepper@gnu.org>, 1995.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <ctype.h>
+#include <errno.h>
+#include <stdio.h>
+#include <sys/types.h>
+
+#if defined STDC_HEADERS || defined _LIBC
+# include <stdlib.h>
+#else
+# ifdef HAVE_MALLOC_H
+# include <malloc.h>
+# else
+void free ();
+# endif
+#endif
+
+#if defined HAVE_STRING_H || defined _LIBC
+# include <string.h>
+#else
+# include <strings.h>
+# ifndef memcpy
+# define memcpy(Dst, Src, Num) bcopy (Src, Dst, Num)
+# endif
+#endif
+#if !HAVE_STRCHR && !defined _LIBC
+# ifndef strchr
+# define strchr index
+# endif
+#endif
+
+#if defined HAVE_UNISTD_H || defined _LIBC
+# include <unistd.h>
+#endif
+
+#include "gettext.h"
+#include "gettextP.h"
+#ifdef _LIBC
+# include <libintl.h>
+#else
+# include "libgettext.h"
+#endif
+
+/* @@ end of prolog @@ */
+/* List of already loaded domains. */
+static struct loaded_l10nfile *_nl_loaded_domains;
+
+
+/* Return a data structure describing the message catalog described by
+ the DOMAINNAME and CATEGORY parameters with respect to the currently
+ established bindings. */
+struct loaded_l10nfile *
+_nl_find_domain (dirname, locale, domainname)
+ const char *dirname;
+ char *locale;
+ const char *domainname;
+{
+ struct loaded_l10nfile *retval;
+ const char *language;
+ const char *modifier;
+ const char *territory;
+ const char *codeset;
+ const char *normalized_codeset;
+ const char *special;
+ const char *sponsor;
+ const char *revision;
+ const char *alias_value;
+ int mask;
+
+ /* LOCALE can consist of up to four recognized parts for the XPG syntax:
+
+ language[_territory[.codeset]][@modifier]
+
+ and six parts for the CEN syntax:
+
+ language[_territory][+audience][+special][,[sponsor][_revision]]
+
+ Beside the first all of them are allowed to be missing. If the
+ full specified locale is not found, the less specific one are
+ looked for. The various part will be stripped of according to
+ the following order:
+ (1) revision
+ (2) sponsor
+ (3) special
+ (4) codeset
+ (5) normalized codeset
+ (6) territory
+ (7) audience/modifier
+ */
+
+ /* If we have already tested for this locale entry there has to
+ be one data set in the list of loaded domains. */
+ retval = _nl_make_l10nflist (&_nl_loaded_domains, dirname,
+ strlen (dirname) + 1, 0, locale, NULL, NULL,
+ NULL, NULL, NULL, NULL, NULL, domainname, 0);
+ if (retval != NULL)
+ {
+ /* We know something about this locale. */
+ int cnt;
+
+ if (retval->decided == 0)
+ _nl_load_domain (retval);
+
+ if (retval->data != NULL)
+ return retval;
+
+ for (cnt = 0; retval->successor[cnt] != NULL; ++cnt)
+ {
+ if (retval->successor[cnt]->decided == 0)
+ _nl_load_domain (retval->successor[cnt]);
+
+ if (retval->successor[cnt]->data != NULL)
+ break;
+ }
+ return cnt >= 0 ? retval : NULL;
+ /* NOTREACHED */
+ }
+
+ /* See whether the locale value is an alias. If yes its value
+ *overwrites* the alias name. No test for the original value is
+ done. */
+ alias_value = _nl_expand_alias (locale);
+ if (alias_value != NULL)
+ {
+ size_t len = strlen (alias_value) + 1;
+ locale = (char *) malloc (len);
+ if (locale == NULL)
+ return NULL;
+
+ memcpy (locale, alias_value, len);
+ }
+
+ /* Now we determine the single parts of the locale name. First
+ look for the language. Termination symbols are `_' and `@' if
+ we use XPG4 style, and `_', `+', and `,' if we use CEN syntax. */
+ mask = _nl_explode_name (locale, &language, &modifier, &territory,
+ &codeset, &normalized_codeset, &special,
+ &sponsor, &revision);
+
+ /* Create all possible locale entries which might be interested in
+ generalization. */
+ retval = _nl_make_l10nflist (&_nl_loaded_domains, dirname,
+ strlen (dirname) + 1, mask, language, territory,
+ codeset, normalized_codeset, modifier, special,
+ sponsor, revision, domainname, 1);
+ if (retval == NULL)
+ /* This means we are out of core. */
+ return NULL;
+
+ if (retval->decided == 0)
+ _nl_load_domain (retval);
+ if (retval->data == NULL)
+ {
+ int cnt;
+ for (cnt = 0; retval->successor[cnt] != NULL; ++cnt)
+ {
+ if (retval->successor[cnt]->decided == 0)
+ _nl_load_domain (retval->successor[cnt]);
+ if (retval->successor[cnt]->data != NULL)
+ break;
+ }
+ }
+
+ /* The room for an alias was dynamically allocated. Free it now. */
+ if (alias_value != NULL)
+ free (locale);
+
+ return retval;
+}
--- /dev/null
+/* Implementation of gettext(3) function
+ Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#ifdef _LIBC
+# define __need_NULL
+# include <stddef.h>
+#else
+# ifdef STDC_HEADERS
+# include <stdlib.h> /* Just for NULL. */
+# else
+# ifdef HAVE_STRING_H
+# include <string.h>
+# else
+# define NULL ((void *) 0)
+# endif
+# endif
+#endif
+
+#ifdef _LIBC
+# include <libintl.h>
+#else
+# include "libgettext.h"
+#endif
+
+/* @@ end of prolog @@ */
+
+/* Names for the libintl functions are a problem. They must not clash
+ with existing names and they should follow ANSI C. But this source
+ code is also used in GNU C Library where the names have a __
+ prefix. So we have to make a difference here. */
+#ifdef _LIBC
+# define GETTEXT __gettext
+# define DGETTEXT __dgettext
+#else
+# define GETTEXT gettext__
+# define DGETTEXT dgettext__
+#endif
+
+/* Look up MSGID in the current default message catalog for the current
+ LC_MESSAGES locale. If not found, returns MSGID itself (the default
+ text). */
+char *
+GETTEXT (msgid)
+ const char *msgid;
+{
+ return DGETTEXT (NULL, msgid);
+}
+
+#ifdef _LIBC
+/* Alias for function name in GNU C Library. */
+weak_alias (__gettext, gettext);
+#endif
--- /dev/null
+/* Internal header for GNU gettext internationalization functions
+ Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with the GNU C Library; see the file COPYING.LIB. If not,
+ write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+#ifndef _GETTEXT_H
+#define _GETTEXT_H 1
+
+#include <stdio.h>
+
+#if HAVE_LIMITS_H || _LIBC
+# include <limits.h>
+#endif
+
+/* @@ end of prolog @@ */
+
+/* The magic number of the GNU message catalog format. */
+#define _MAGIC 0x950412de
+#define _MAGIC_SWAPPED 0xde120495
+
+/* Revision number of the currently used .mo (binary) file format. */
+#define MO_REVISION_NUMBER 0
+
+/* The following contortions are an attempt to use the C preprocessor
+ to determine an unsigned integral type that is 32 bits wide. An
+ alternative approach is to use autoconf's AC_CHECK_SIZEOF macro, but
+ doing that would require that the configure script compile and *run*
+ the resulting executable. Locally running cross-compiled executables
+ is usually not possible. */
+
+#if __STDC__
+# define UINT_MAX_32_BITS 4294967295U
+#else
+# define UINT_MAX_32_BITS 0xFFFFFFFF
+#endif
+
+/* If UINT_MAX isn't defined, assume it's a 32-bit type.
+ This should be valid for all systems GNU cares about because
+ that doesn't include 16-bit systems, and only modern systems
+ (that certainly have <limits.h>) have 64+-bit integral types. */
+
+#ifndef UINT_MAX
+# define UINT_MAX UINT_MAX_32_BITS
+#endif
+
+#if UINT_MAX == UINT_MAX_32_BITS
+typedef unsigned nls_uint32;
+#else
+# if USHRT_MAX == UINT_MAX_32_BITS
+typedef unsigned short nls_uint32;
+# else
+# if ULONG_MAX == UINT_MAX_32_BITS
+typedef unsigned long nls_uint32;
+# else
+ /* The following line is intended to throw an error. Using #error is
+ not portable enough. */
+ "Cannot determine unsigned 32-bit data type."
+# endif
+# endif
+#endif
+
+
+/* Header for binary .mo file format. */
+struct mo_file_header
+{
+ /* The magic number. */
+ nls_uint32 magic;
+ /* The revision number of the file format. */
+ nls_uint32 revision;
+ /* The number of strings pairs. */
+ nls_uint32 nstrings;
+ /* Offset of table with start offsets of original strings. */
+ nls_uint32 orig_tab_offset;
+ /* Offset of table with start offsets of translation strings. */
+ nls_uint32 trans_tab_offset;
+ /* Size of hashing table. */
+ nls_uint32 hash_tab_size;
+ /* Offset of first hashing entry. */
+ nls_uint32 hash_tab_offset;
+};
+
+struct string_desc
+{
+ /* Length of addressed string. */
+ nls_uint32 length;
+ /* Offset of string in file. */
+ nls_uint32 offset;
+};
+
+/* @@ begin of epilog @@ */
+
+#endif /* gettext.h */
--- /dev/null
+/* Header describing internals of gettext library
+ Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifndef _GETTEXTP_H
+#define _GETTEXTP_H
+
+#include "loadinfo.h"
+
+/* @@ end of prolog @@ */
+
+#ifndef PARAMS
+# if __STDC__
+# define PARAMS(args) args
+# else
+# define PARAMS(args) ()
+# endif
+#endif
+
+#ifndef W
+# define W(flag, data) ((flag) ? SWAP (data) : (data))
+#endif
+
+
+static nls_uint32 SWAP PARAMS ((nls_uint32 i));
+
+static inline nls_uint32
+SWAP (i)
+ nls_uint32 i;
+{
+ return (i << 24) | ((i & 0xff00) << 8) | ((i >> 8) & 0xff00) | (i >> 24);
+}
+
+
+struct loaded_domain
+{
+ const char *data;
+ int must_swap;
+ nls_uint32 nstrings;
+ struct string_desc *orig_tab;
+ struct string_desc *trans_tab;
+ nls_uint32 hash_size;
+ nls_uint32 *hash_tab;
+};
+
+struct binding
+{
+ struct binding *next;
+ char *domainname;
+ char *dirname;
+};
+
+struct loaded_l10nfile *_nl_find_domain PARAMS ((const char *__dirname,
+ char *__locale,
+ const char *__domainname));
+void _nl_load_domain PARAMS ((struct loaded_l10nfile *__domain));
+
+/* @@ begin of epilog @@ */
+
+#endif /* gettextP.h */
--- /dev/null
+/* Implements a string hashing function.
+ Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with the GNU C Library; see the file COPYING.LIB. If not,
+ write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_VALUES_H
+# include <values.h>
+#endif
+
+/* @@ end of prolog @@ */
+
+#ifndef PARAMS
+# if __STDC__
+# define PARAMS(Args) Args
+# else
+# define PARAMS(Args) ()
+# endif
+#endif
+
+/* We assume to have `unsigned long int' value with at least 32 bits. */
+#define HASHWORDBITS 32
+
+
+/* Defines the so called `hashpjw' function by P.J. Weinberger
+ [see Aho/Sethi/Ullman, COMPILERS: Principles, Techniques and Tools,
+ 1986, 1987 Bell Telephone Laboratories, Inc.] */
+static unsigned long hash_string PARAMS ((const char *__str_param));
+
+static inline unsigned long
+hash_string (str_param)
+ const char *str_param;
+{
+ unsigned long int hval, g;
+ const char *str = str_param;
+
+ /* Compute the hash value for the given string. */
+ hval = 0;
+ while (*str != '\0')
+ {
+ hval <<= 4;
+ hval += (unsigned long) *str++;
+ g = hval & ((unsigned long) 0xf << (HASHWORDBITS - 4));
+ if (g != 0)
+ {
+ hval ^= g >> (HASHWORDBITS - 8);
+ hval ^= g;
+ }
+ }
+ return hval;
+}
--- /dev/null
+/* intl-compat.c - Stub functions to call gettext functions from GNU gettext
+ Library.
+ Copyright (C) 1995 Software Foundation, Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include "libgettext.h"
+
+/* @@ end of prolog @@ */
+
+
+#undef gettext
+#undef dgettext
+#undef dcgettext
+#undef textdomain
+#undef bindtextdomain
+
+
+char *
+bindtextdomain (domainname, dirname)
+ const char *domainname;
+ const char *dirname;
+{
+ return bindtextdomain__ (domainname, dirname);
+}
+
+
+char *
+dcgettext (domainname, msgid, category)
+ const char *domainname;
+ const char *msgid;
+ int category;
+{
+ return dcgettext__ (domainname, msgid, category);
+}
+
+
+char *
+dgettext (domainname, msgid)
+ const char *domainname;
+ const char *msgid;
+{
+ return dgettext__ (domainname, msgid);
+}
+
+
+char *
+gettext (msgid)
+ const char *msgid;
+{
+ return gettext__ (msgid);
+}
+
+
+char *
+textdomain (domainname)
+ const char *domainname;
+{
+ return textdomain__ (domainname);
+}
--- /dev/null
+/* Handle list of needed message catalogs
+ Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+ Written by Ulrich Drepper <drepper@gnu.org>, 1995.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+
+#if defined HAVE_STRING_H || defined _LIBC
+# ifndef _GNU_SOURCE
+# define _GNU_SOURCE 1
+# endif
+# include <string.h>
+#else
+# include <strings.h>
+# ifndef memcpy
+# define memcpy(Dst, Src, Num) bcopy (Src, Dst, Num)
+# endif
+#endif
+#if !HAVE_STRCHR && !defined _LIBC
+# ifndef strchr
+# define strchr index
+# endif
+#endif
+
+#if defined _LIBC || defined HAVE_ARGZ_H
+# include <argz.h>
+#endif
+#include <ctype.h>
+#include <sys/types.h>
+
+#if defined STDC_HEADERS || defined _LIBC
+# include <stdlib.h>
+#endif
+
+#include "loadinfo.h"
+
+/* On some strange systems still no definition of NULL is found. Sigh! */
+#ifndef NULL
+# if defined __STDC__ && __STDC__
+# define NULL ((void *) 0)
+# else
+# define NULL 0
+# endif
+#endif
+
+/* @@ end of prolog @@ */
+
+#ifdef _LIBC
+/* Rename the non ANSI C functions. This is required by the standard
+ because some ANSI C functions will require linking with this object
+ file and the name space must not be polluted. */
+# define stpcpy(dest, src) __stpcpy(dest, src)
+#else
+# ifndef HAVE_STPCPY
+static char *stpcpy PARAMS ((char *dest, const char *src));
+# endif
+#endif
+
+/* Define function which are usually not available. */
+
+#if !defined _LIBC && !defined HAVE___ARGZ_COUNT
+/* Returns the number of strings in ARGZ. */
+static size_t argz_count__ PARAMS ((const char *argz, size_t len));
+
+static size_t
+argz_count__ (argz, len)
+ const char *argz;
+ size_t len;
+{
+ size_t count = 0;
+ while (len > 0)
+ {
+ size_t part_len = strlen (argz);
+ argz += part_len + 1;
+ len -= part_len + 1;
+ count++;
+ }
+ return count;
+}
+# undef __argz_count
+# define __argz_count(argz, len) argz_count__ (argz, len)
+#endif /* !_LIBC && !HAVE___ARGZ_COUNT */
+
+#if !defined _LIBC && !defined HAVE___ARGZ_STRINGIFY
+/* Make '\0' separated arg vector ARGZ printable by converting all the '\0's
+ except the last into the character SEP. */
+static void argz_stringify__ PARAMS ((char *argz, size_t len, int sep));
+
+static void
+argz_stringify__ (argz, len, sep)
+ char *argz;
+ size_t len;
+ int sep;
+{
+ while (len > 0)
+ {
+ size_t part_len = strlen (argz);
+ argz += part_len;
+ len -= part_len + 1;
+ if (len > 0)
+ *argz++ = sep;
+ }
+}
+# undef __argz_stringify
+# define __argz_stringify(argz, len, sep) argz_stringify__ (argz, len, sep)
+#endif /* !_LIBC && !HAVE___ARGZ_STRINGIFY */
+
+#if !defined _LIBC && !defined HAVE___ARGZ_NEXT
+static char *argz_next__ PARAMS ((char *argz, size_t argz_len,
+ const char *entry));
+
+static char *
+argz_next__ (argz, argz_len, entry)
+ char *argz;
+ size_t argz_len;
+ const char *entry;
+{
+ if (entry)
+ {
+ if (entry < argz + argz_len)
+ entry = strchr (entry, '\0') + 1;
+
+ return entry >= argz + argz_len ? NULL : (char *) entry;
+ }
+ else
+ if (argz_len > 0)
+ return argz;
+ else
+ return 0;
+}
+# undef __argz_next
+# define __argz_next(argz, len, entry) argz_next__ (argz, len, entry)
+#endif /* !_LIBC && !HAVE___ARGZ_NEXT */
+
+
+/* Return number of bits set in X. */
+static int pop PARAMS ((int x));
+
+static inline int
+pop (x)
+ int x;
+{
+ /* We assume that no more than 16 bits are used. */
+ x = ((x & ~0x5555) >> 1) + (x & 0x5555);
+ x = ((x & ~0x3333) >> 2) + (x & 0x3333);
+ x = ((x >> 4) + x) & 0x0f0f;
+ x = ((x >> 8) + x) & 0xff;
+
+ return x;
+}
+
+\f
+struct loaded_l10nfile *
+_nl_make_l10nflist (l10nfile_list, dirlist, dirlist_len, mask, language,
+ territory, codeset, normalized_codeset, modifier, special,
+ sponsor, revision, filename, do_allocate)
+ struct loaded_l10nfile **l10nfile_list;
+ const char *dirlist;
+ size_t dirlist_len;
+ int mask;
+ const char *language;
+ const char *territory;
+ const char *codeset;
+ const char *normalized_codeset;
+ const char *modifier;
+ const char *special;
+ const char *sponsor;
+ const char *revision;
+ const char *filename;
+ int do_allocate;
+{
+ char *abs_filename;
+ struct loaded_l10nfile *last = NULL;
+ struct loaded_l10nfile *retval;
+ char *cp;
+ size_t entries;
+ int cnt;
+
+ /* Allocate room for the full file name. */
+ abs_filename = (char *) malloc (dirlist_len
+ + strlen (language)
+ + ((mask & TERRITORY) != 0
+ ? strlen (territory) + 1 : 0)
+ + ((mask & XPG_CODESET) != 0
+ ? strlen (codeset) + 1 : 0)
+ + ((mask & XPG_NORM_CODESET) != 0
+ ? strlen (normalized_codeset) + 1 : 0)
+ + (((mask & XPG_MODIFIER) != 0
+ || (mask & CEN_AUDIENCE) != 0)
+ ? strlen (modifier) + 1 : 0)
+ + ((mask & CEN_SPECIAL) != 0
+ ? strlen (special) + 1 : 0)
+ + (((mask & CEN_SPONSOR) != 0
+ || (mask & CEN_REVISION) != 0)
+ ? (1 + ((mask & CEN_SPONSOR) != 0
+ ? strlen (sponsor) + 1 : 0)
+ + ((mask & CEN_REVISION) != 0
+ ? strlen (revision) + 1 : 0)) : 0)
+ + 1 + strlen (filename) + 1);
+
+ if (abs_filename == NULL)
+ return NULL;
+
+ retval = NULL;
+ last = NULL;
+
+ /* Construct file name. */
+ memcpy (abs_filename, dirlist, dirlist_len);
+ __argz_stringify (abs_filename, dirlist_len, ':');
+ cp = abs_filename + (dirlist_len - 1);
+ *cp++ = '/';
+ cp = stpcpy (cp, language);
+
+ if ((mask & TERRITORY) != 0)
+ {
+ *cp++ = '_';
+ cp = stpcpy (cp, territory);
+ }
+ if ((mask & XPG_CODESET) != 0)
+ {
+ *cp++ = '.';
+ cp = stpcpy (cp, codeset);
+ }
+ if ((mask & XPG_NORM_CODESET) != 0)
+ {
+ *cp++ = '.';
+ cp = stpcpy (cp, normalized_codeset);
+ }
+ if ((mask & (XPG_MODIFIER | CEN_AUDIENCE)) != 0)
+ {
+ /* This component can be part of both syntaces but has different
+ leading characters. For CEN we use `+', else `@'. */
+ *cp++ = (mask & CEN_AUDIENCE) != 0 ? '+' : '@';
+ cp = stpcpy (cp, modifier);
+ }
+ if ((mask & CEN_SPECIAL) != 0)
+ {
+ *cp++ = '+';
+ cp = stpcpy (cp, special);
+ }
+ if ((mask & (CEN_SPONSOR | CEN_REVISION)) != 0)
+ {
+ *cp++ = ',';
+ if ((mask & CEN_SPONSOR) != 0)
+ cp = stpcpy (cp, sponsor);
+ if ((mask & CEN_REVISION) != 0)
+ {
+ *cp++ = '_';
+ cp = stpcpy (cp, revision);
+ }
+ }
+
+ *cp++ = '/';
+ stpcpy (cp, filename);
+
+ /* Look in list of already loaded domains whether it is already
+ available. */
+ last = NULL;
+ for (retval = *l10nfile_list; retval != NULL; retval = retval->next)
+ if (retval->filename != NULL)
+ {
+ int compare = strcmp (retval->filename, abs_filename);
+ if (compare == 0)
+ /* We found it! */
+ break;
+ if (compare < 0)
+ {
+ /* It's not in the list. */
+ retval = NULL;
+ break;
+ }
+
+ last = retval;
+ }
+
+ if (retval != NULL || do_allocate == 0)
+ {
+ free (abs_filename);
+ return retval;
+ }
+
+ retval = (struct loaded_l10nfile *)
+ malloc (sizeof (*retval) + (__argz_count (dirlist, dirlist_len)
+ * (1 << pop (mask))
+ * sizeof (struct loaded_l10nfile *)));
+ if (retval == NULL)
+ return NULL;
+
+ retval->filename = abs_filename;
+ retval->decided = (__argz_count (dirlist, dirlist_len) != 1
+ || ((mask & XPG_CODESET) != 0
+ && (mask & XPG_NORM_CODESET) != 0));
+ retval->data = NULL;
+
+ if (last == NULL)
+ {
+ retval->next = *l10nfile_list;
+ *l10nfile_list = retval;
+ }
+ else
+ {
+ retval->next = last->next;
+ last->next = retval;
+ }
+
+ entries = 0;
+ /* If the DIRLIST is a real list the RETVAL entry corresponds not to
+ a real file. So we have to use the DIRLIST separation mechanism
+ of the inner loop. */
+ cnt = __argz_count (dirlist, dirlist_len) == 1 ? mask - 1 : mask;
+ for (; cnt >= 0; --cnt)
+ if ((cnt & ~mask) == 0
+ && ((cnt & CEN_SPECIFIC) == 0 || (cnt & XPG_SPECIFIC) == 0)
+ && ((cnt & XPG_CODESET) == 0 || (cnt & XPG_NORM_CODESET) == 0))
+ {
+ /* Iterate over all elements of the DIRLIST. */
+ char *dir = NULL;
+
+ while ((dir = __argz_next ((char *) dirlist, dirlist_len, dir))
+ != NULL)
+ retval->successor[entries++]
+ = _nl_make_l10nflist (l10nfile_list, dir, strlen (dir) + 1, cnt,
+ language, territory, codeset,
+ normalized_codeset, modifier, special,
+ sponsor, revision, filename, 1);
+ }
+ retval->successor[entries] = NULL;
+
+ return retval;
+}
+\f
+/* Normalize codeset name. There is no standard for the codeset
+ names. Normalization allows the user to use any of the common
+ names. */
+const char *
+_nl_normalize_codeset (codeset, name_len)
+ const char *codeset;
+ size_t name_len;
+{
+ int len = 0;
+ int only_digit = 1;
+ char *retval;
+ char *wp;
+ size_t cnt;
+
+ for (cnt = 0; cnt < name_len; ++cnt)
+ if (isalnum (codeset[cnt]))
+ {
+ ++len;
+
+ if (isalpha (codeset[cnt]))
+ only_digit = 0;
+ }
+
+ retval = (char *) malloc ((only_digit ? 3 : 0) + len + 1);
+
+ if (retval != NULL)
+ {
+ if (only_digit)
+ wp = stpcpy (retval, "iso");
+ else
+ wp = retval;
+
+ for (cnt = 0; cnt < name_len; ++cnt)
+ if (isalpha (codeset[cnt]))
+ *wp++ = tolower (codeset[cnt]);
+ else if (isdigit (codeset[cnt]))
+ *wp++ = codeset[cnt];
+
+ *wp = '\0';
+ }
+
+ return (const char *) retval;
+}
+
+
+/* @@ begin of epilog @@ */
+
+/* We don't want libintl.a to depend on any other library. So we
+ avoid the non-standard function stpcpy. In GNU C Library this
+ function is available, though. Also allow the symbol HAVE_STPCPY
+ to be defined. */
+#if !_LIBC && !HAVE_STPCPY
+static char *
+stpcpy (dest, src)
+ char *dest;
+ const char *src;
+{
+ while ((*dest++ = *src++) != '\0')
+ /* Do nothing. */ ;
+ return dest - 1;
+}
+#endif
--- /dev/null
+/* Message catalogs for internationalization.
+ Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+/* Because on some systems (e.g. Solaris) we sometimes have to include
+ the systems libintl.h as well as this file we have more complex
+ include protection above. But the systems header might perhaps also
+ define _LIBINTL_H and therefore we have to protect the definition here. */
+
+#if !defined (_LIBINTL_H) || !defined (_LIBGETTEXT_H)
+#if !defined (_LIBINTL_H)
+# define _LIBINTL_H 1
+#endif
+#define _LIBGETTEXT_H 1
+
+/* We define an additional symbol to signal that we use the GNU
+ implementation of gettext. */
+#define __USE_GNU_GETTEXT 1
+
+#include <sys/types.h>
+
+#if HAVE_LOCALE_H
+# include <locale.h>
+#endif
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* @@ end of prolog @@ */
+
+#ifndef PARAMS
+# if __STDC__
+# define PARAMS(args) args
+# else
+# define PARAMS(args) ()
+# endif
+#endif
+
+#ifndef NULL
+# if !defined __cplusplus || defined __GNUC__
+# define NULL ((void *) 0)
+# else
+# define NULL (0)
+# endif
+#endif
+
+#if !HAVE_LC_MESSAGES
+/* This value determines the behaviour of the gettext() and dgettext()
+ function. But some system does not have this defined. Define it
+ to a default value. */
+# define LC_MESSAGES (-1)
+#endif
+
+
+/* Declarations for gettext-using-catgets interface. Derived from
+ Jim Meyering's libintl.h. */
+struct _msg_ent
+{
+ const char *_msg;
+ int _msg_number;
+};
+
+
+#if HAVE_CATGETS
+/* These two variables are defined in the automatically by po-to-tbl.sed
+ generated file `cat-id-tbl.c'. */
+extern const struct _msg_ent _msg_tbl[];
+extern int _msg_tbl_length;
+#endif
+
+
+/* For automatical extraction of messages sometimes no real
+ translation is needed. Instead the string itself is the result. */
+#define gettext_noop(Str) (Str)
+
+/* Look up MSGID in the current default message catalog for the current
+ LC_MESSAGES locale. If not found, returns MSGID itself (the default
+ text). */
+extern char *gettext PARAMS ((const char *__msgid));
+extern char *gettext__ PARAMS ((const char *__msgid));
+
+/* Look up MSGID in the DOMAINNAME message catalog for the current
+ LC_MESSAGES locale. */
+extern char *dgettext PARAMS ((const char *__domainname, const char *__msgid));
+extern char *dgettext__ PARAMS ((const char *__domainname,
+ const char *__msgid));
+
+/* Look up MSGID in the DOMAINNAME message catalog for the current CATEGORY
+ locale. */
+extern char *dcgettext PARAMS ((const char *__domainname, const char *__msgid,
+ int __category));
+extern char *dcgettext__ PARAMS ((const char *__domainname,
+ const char *__msgid, int __category));
+
+
+/* Set the current default message catalog to DOMAINNAME.
+ If DOMAINNAME is null, return the current default.
+ If DOMAINNAME is "", reset to the default of "messages". */
+extern char *textdomain PARAMS ((const char *__domainname));
+extern char *textdomain__ PARAMS ((const char *__domainname));
+
+/* Specify that the DOMAINNAME message catalog will be found
+ in DIRNAME rather than in the system locale data base. */
+extern char *bindtextdomain PARAMS ((const char *__domainname,
+ const char *__dirname));
+extern char *bindtextdomain__ PARAMS ((const char *__domainname,
+ const char *__dirname));
+
+#if ENABLE_NLS
+
+/* Solaris 2.3 has the gettext function but dcgettext is missing.
+ So we omit this optimization for Solaris 2.3. BTW, Solaris 2.4
+ has dcgettext. */
+# if !HAVE_CATGETS && (!HAVE_GETTEXT || HAVE_DCGETTEXT)
+
+# define gettext(Msgid) \
+ dgettext (NULL, Msgid)
+
+# define dgettext(Domainname, Msgid) \
+ dcgettext (Domainname, Msgid, LC_MESSAGES)
+
+# if defined __GNUC__ && __GNUC__ == 2 && __GNUC_MINOR__ >= 7
+/* This global variable is defined in loadmsgcat.c. We need a sign,
+ whether a new catalog was loaded, which can be associated with all
+ translations. */
+extern int _nl_msg_cat_cntr;
+
+# define dcgettext(Domainname, Msgid, Category) \
+ (__extension__ \
+ ({ \
+ char *__result; \
+ if (__builtin_constant_p (Msgid)) \
+ { \
+ static char *__translation__; \
+ static int __catalog_counter__; \
+ if (! __translation__ || __catalog_counter__ != _nl_msg_cat_cntr) \
+ { \
+ __translation__ = \
+ dcgettext__ (Domainname, Msgid, Category); \
+ __catalog_counter__ = _nl_msg_cat_cntr; \
+ } \
+ __result = __translation__; \
+ } \
+ else \
+ __result = dcgettext__ (Domainname, Msgid, Category); \
+ __result; \
+ }))
+# endif
+# endif
+
+#else
+
+# define gettext(Msgid) (Msgid)
+# define dgettext(Domainname, Msgid) (Msgid)
+# define dcgettext(Domainname, Msgid, Category) (Msgid)
+# define textdomain(Domainname) while (0) /* nothing */
+# define bindtextdomain(Domainname, Dirname) while (0) /* nothing */
+
+#endif
+
+/* @@ begin of epilog @@ */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
--- /dev/null
+# po2msg.sed - Convert Uniforum style .po file to Linux style .msg file
+# Copyright (C) 1995 Free Software Foundation, Inc.
+# Ulrich Drepper <drepper@gnu.org>, 1995.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+#
+# The first directive in the .msg should be the definition of the
+# message set number. We use always set number 1.
+#
+1 {
+ i\
+$set 1 # Automatically created by po2msg.sed
+ h
+ s/.*/0/
+ x
+}
+#
+# Mitch's old catalog format does not allow comments.
+#
+# We copy the original message as a comment into the .msg file.
+#
+/^msgid/ {
+ s/msgid[ ]*"//
+#
+# This does not work now with the new format.
+# /"$/! {
+# s/\\$//
+# s/$/ ... (more lines following)"/
+# }
+ x
+# The following nice solution is by
+# Bruno <Haible@ma2s2.mathematik.uni-karlsruhe.de>
+ td
+# Increment a decimal number in pattern space.
+# First hide trailing `9' digits.
+ :d
+ s/9\(_*\)$/_\1/
+ td
+# Assure at least one digit is available.
+ s/^\(_*\)$/0\1/
+# Increment the last digit.
+ s/8\(_*\)$/9\1/
+ s/7\(_*\)$/8\1/
+ s/6\(_*\)$/7\1/
+ s/5\(_*\)$/6\1/
+ s/4\(_*\)$/5\1/
+ s/3\(_*\)$/4\1/
+ s/2\(_*\)$/3\1/
+ s/1\(_*\)$/2\1/
+ s/0\(_*\)$/1\1/
+# Convert the hidden `9' digits to `0's.
+ s/_/0/g
+ x
+ G
+ s/\(.*\)"\n\([0-9]*\)/$ #\2 Original Message:(\1)/p
+}
+#
+# The .msg file contains, other then the .po file, only the translations
+# but each given a unique ID. Starting from 1 and incrementing by 1 for
+# each message we assign them to the messages.
+# It is important that the .po file used to generate the cat-id-tbl.c file
+# (with po-to-tbl) is the same as the one used here. (At least the order
+# of declarations must not be changed.)
+#
+/^msgstr/ {
+ s/msgstr[ ]*"\(.*\)"/# \1/
+# Clear substitution flag.
+ tb
+# Append the next line.
+ :b
+ N
+# Look whether second part is continuation line.
+ s/\(.*\n\)"\(.*\)"/\1\2/
+# Yes, then branch.
+ ta
+ P
+ D
+# Note that D includes a jump to the start!!
+# We found a continuation line. But before printing insert '\'.
+ :a
+ s/\(.*\)\(\n.*\)/\1\\\2/
+ P
+# We cannot use D here.
+ s/.*\n\(.*\)/\1/
+ tb
+}
+d
--- /dev/null
+#ifndef PARAMS
+# if __STDC__
+# define PARAMS(args) args
+# else
+# define PARAMS(args) ()
+# endif
+#endif
+
+/* Encoding of locale name parts. */
+#define CEN_REVISION 1
+#define CEN_SPONSOR 2
+#define CEN_SPECIAL 4
+#define XPG_NORM_CODESET 8
+#define XPG_CODESET 16
+#define TERRITORY 32
+#define CEN_AUDIENCE 64
+#define XPG_MODIFIER 128
+
+#define CEN_SPECIFIC (CEN_REVISION|CEN_SPONSOR|CEN_SPECIAL|CEN_AUDIENCE)
+#define XPG_SPECIFIC (XPG_CODESET|XPG_NORM_CODESET|XPG_MODIFIER)
+
+
+struct loaded_l10nfile
+{
+ const char *filename;
+ int decided;
+
+ const void *data;
+
+ struct loaded_l10nfile *next;
+ struct loaded_l10nfile *successor[1];
+};
+
+
+extern const char *_nl_normalize_codeset PARAMS ((const char *codeset,
+ size_t name_len));
+
+extern struct loaded_l10nfile *
+_nl_make_l10nflist PARAMS ((struct loaded_l10nfile **l10nfile_list,
+ const char *dirlist, size_t dirlist_len, int mask,
+ const char *language, const char *territory,
+ const char *codeset,
+ const char *normalized_codeset,
+ const char *modifier, const char *special,
+ const char *sponsor, const char *revision,
+ const char *filename, int do_allocate));
+
+
+extern const char *_nl_expand_alias PARAMS ((const char *name));
+
+extern int _nl_explode_name PARAMS ((char *name, const char **language,
+ const char **modifier,
+ const char **territory,
+ const char **codeset,
+ const char **normalized_codeset,
+ const char **special,
+ const char **sponsor,
+ const char **revision));
--- /dev/null
+/* Load needed message catalogs
+ Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <fcntl.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+
+#if defined STDC_HEADERS || defined _LIBC
+# include <stdlib.h>
+#endif
+
+#if defined HAVE_UNISTD_H || defined _LIBC
+# include <unistd.h>
+#endif
+
+#if (defined HAVE_MMAP && defined HAVE_MUNMAP) || defined _LIBC
+# include <sys/mman.h>
+#endif
+
+#include "gettext.h"
+#include "gettextP.h"
+
+/* @@ end of prolog @@ */
+
+#ifdef _LIBC
+/* Rename the non ISO C functions. This is required by the standard
+ because some ISO C functions will require linking with this object
+ file and the name space must not be polluted. */
+# define fstat __fstat
+# define open __open
+# define close __close
+# define read __read
+# define mmap __mmap
+# define munmap __munmap
+#endif
+
+/* We need a sign, whether a new catalog was loaded, which can be associated
+ with all translations. This is important if the translations are
+ cached by one of GCC's features. */
+int _nl_msg_cat_cntr = 0;
+
+
+/* Load the message catalogs specified by FILENAME. If it is no valid
+ message catalog do nothing. */
+void
+_nl_load_domain (domain_file)
+ struct loaded_l10nfile *domain_file;
+{
+ int fd;
+ struct stat st;
+ struct mo_file_header *data = (struct mo_file_header *) -1;
+#if (defined HAVE_MMAP && defined HAVE_MUNMAP && !defined DISALLOW_MMAP) \
+ || defined _LIBC
+ int use_mmap = 0;
+#endif
+ struct loaded_domain *domain;
+
+ domain_file->decided = 1;
+ domain_file->data = NULL;
+
+ /* If the record does not represent a valid locale the FILENAME
+ might be NULL. This can happen when according to the given
+ specification the locale file name is different for XPG and CEN
+ syntax. */
+ if (domain_file->filename == NULL)
+ return;
+
+ /* Try to open the addressed file. */
+ fd = open (domain_file->filename, O_RDONLY);
+ if (fd == -1)
+ return;
+
+ /* We must know about the size of the file. */
+ if (fstat (fd, &st) != 0
+ && st.st_size < (off_t) sizeof (struct mo_file_header))
+ {
+ /* Something went wrong. */
+ close (fd);
+ return;
+ }
+
+#if (defined HAVE_MMAP && defined HAVE_MUNMAP && !defined DISALLOW_MMAP) \
+ || defined _LIBC
+ /* Now we are ready to load the file. If mmap() is available we try
+ this first. If not available or it failed we try to load it. */
+ data = (struct mo_file_header *) mmap (NULL, st.st_size, PROT_READ,
+ MAP_PRIVATE, fd, 0);
+
+ if (data != (struct mo_file_header *) -1)
+ {
+ /* mmap() call was successful. */
+ close (fd);
+ use_mmap = 1;
+ }
+#endif
+
+ /* If the data is not yet available (i.e. mmap'ed) we try to load
+ it manually. */
+ if (data == (struct mo_file_header *) -1)
+ {
+ off_t to_read;
+ char *read_ptr;
+
+ data = (struct mo_file_header *) malloc (st.st_size);
+ if (data == NULL)
+ return;
+
+ to_read = st.st_size;
+ read_ptr = (char *) data;
+ do
+ {
+ long int nb = (long int) read (fd, read_ptr, to_read);
+ if (nb == -1)
+ {
+ close (fd);
+ return;
+ }
+
+ read_ptr += nb;
+ to_read -= nb;
+ }
+ while (to_read > 0);
+
+ close (fd);
+ }
+
+ /* Using the magic number we can test whether it really is a message
+ catalog file. */
+ if (data->magic != _MAGIC && data->magic != _MAGIC_SWAPPED)
+ {
+ /* The magic number is wrong: not a message catalog file. */
+#if (defined HAVE_MMAP && defined HAVE_MUNMAP && !defined DISALLOW_MMAP) \
+ || defined _LIBC
+ if (use_mmap)
+ munmap ((caddr_t) data, st.st_size);
+ else
+#endif
+ free (data);
+ return;
+ }
+
+ domain_file->data
+ = (struct loaded_domain *) malloc (sizeof (struct loaded_domain));
+ if (domain_file->data == NULL)
+ return;
+
+ domain = (struct loaded_domain *) domain_file->data;
+ domain->data = (char *) data;
+ domain->must_swap = data->magic != _MAGIC;
+
+ /* Fill in the information about the available tables. */
+ switch (W (domain->must_swap, data->revision))
+ {
+ case 0:
+ domain->nstrings = W (domain->must_swap, data->nstrings);
+ domain->orig_tab = (struct string_desc *)
+ ((char *) data + W (domain->must_swap, data->orig_tab_offset));
+ domain->trans_tab = (struct string_desc *)
+ ((char *) data + W (domain->must_swap, data->trans_tab_offset));
+ domain->hash_size = W (domain->must_swap, data->hash_tab_size);
+ domain->hash_tab = (nls_uint32 *)
+ ((char *) data + W (domain->must_swap, data->hash_tab_offset));
+ break;
+ default:
+ /* This is an illegal revision. */
+#if (defined HAVE_MMAP && defined HAVE_MUNMAP && !defined DISALLOW_MMAP) \
+ || defined _LIBC
+ if (use_mmap)
+ munmap ((caddr_t) data, st.st_size);
+ else
+#endif
+ free (data);
+ free (domain);
+ domain_file->data = NULL;
+ return;
+ }
+
+ /* Show that one domain is changed. This might make some cached
+ translations invalid. */
+ ++_nl_msg_cat_cntr;
+}
--- /dev/null
+/* Handle aliases for locale names
+ Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+ Written by Ulrich Drepper <drepper@gnu.org>, 1995.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <ctype.h>
+#include <stdio.h>
+#include <sys/types.h>
+
+#ifdef __GNUC__
+# define alloca __builtin_alloca
+# define HAVE_ALLOCA 1
+#else
+# if defined HAVE_ALLOCA_H || defined _LIBC
+# include <alloca.h>
+# else
+# ifdef _AIX
+ #pragma alloca
+# else
+# ifndef alloca
+char *alloca ();
+# endif
+# endif
+# endif
+#endif
+
+#if defined STDC_HEADERS || defined _LIBC
+# include <stdlib.h>
+#else
+char *getenv ();
+# ifdef HAVE_MALLOC_H
+# include <malloc.h>
+# else
+void free ();
+# endif
+#endif
+
+#if defined HAVE_STRING_H || defined _LIBC
+# ifndef _GNU_SOURCE
+# define _GNU_SOURCE 1
+# endif
+# include <string.h>
+#else
+# include <strings.h>
+# ifndef memcpy
+# define memcpy(Dst, Src, Num) bcopy (Src, Dst, Num)
+# endif
+#endif
+#if !HAVE_STRCHR && !defined _LIBC
+# ifndef strchr
+# define strchr index
+# endif
+#endif
+
+#include "gettext.h"
+#include "gettextP.h"
+
+/* @@ end of prolog @@ */
+
+#ifdef _LIBC
+/* Rename the non ANSI C functions. This is required by the standard
+ because some ANSI C functions will require linking with this object
+ file and the name space must not be polluted. */
+# define strcasecmp __strcasecmp
+#endif
+
+
+/* For those loosing systems which don't have `alloca' we have to add
+ some additional code emulating it. */
+#ifdef HAVE_ALLOCA
+/* Nothing has to be done. */
+# define ADD_BLOCK(list, address) /* nothing */
+# define FREE_BLOCKS(list) /* nothing */
+#else
+struct block_list
+{
+ void *address;
+ struct block_list *next;
+};
+# define ADD_BLOCK(list, addr) \
+ do { \
+ struct block_list *newp = (struct block_list *) malloc (sizeof (*newp)); \
+ /* If we cannot get a free block we cannot add the new element to \
+ the list. */ \
+ if (newp != NULL) { \
+ newp->address = (addr); \
+ newp->next = (list); \
+ (list) = newp; \
+ } \
+ } while (0)
+# define FREE_BLOCKS(list) \
+ do { \
+ while (list != NULL) { \
+ struct block_list *old = list; \
+ list = list->next; \
+ free (old); \
+ } \
+ } while (0)
+# undef alloca
+# define alloca(size) (malloc (size))
+#endif /* have alloca */
+
+
+struct alias_map
+{
+ const char *alias;
+ const char *value;
+};
+
+
+static struct alias_map *map;
+static size_t nmap = 0;
+static size_t maxmap = 0;
+
+
+/* Prototypes for local functions. */
+static size_t read_alias_file PARAMS ((const char *fname, int fname_len));
+static void extend_alias_table PARAMS ((void));
+static int alias_compare PARAMS ((const struct alias_map *map1,
+ const struct alias_map *map2));
+
+
+const char *
+_nl_expand_alias (name)
+ const char *name;
+{
+ static const char *locale_alias_path = LOCALE_ALIAS_PATH;
+ struct alias_map *retval;
+ size_t added;
+
+ do
+ {
+ struct alias_map item;
+
+ item.alias = name;
+
+ if (nmap > 0)
+ retval = (struct alias_map *) bsearch (&item, map, nmap,
+ sizeof (struct alias_map),
+ (int (*) PARAMS ((const void *,
+ const void *))
+ ) alias_compare);
+ else
+ retval = NULL;
+
+ /* We really found an alias. Return the value. */
+ if (retval != NULL)
+ return retval->value;
+
+ /* Perhaps we can find another alias file. */
+ added = 0;
+ while (added == 0 && locale_alias_path[0] != '\0')
+ {
+ const char *start;
+
+ while (locale_alias_path[0] == ':')
+ ++locale_alias_path;
+ start = locale_alias_path;
+
+ while (locale_alias_path[0] != '\0' && locale_alias_path[0] != ':')
+ ++locale_alias_path;
+
+ if (start < locale_alias_path)
+ added = read_alias_file (start, locale_alias_path - start);
+ }
+ }
+ while (added != 0);
+
+ return NULL;
+}
+
+
+static size_t
+read_alias_file (fname, fname_len)
+ const char *fname;
+ int fname_len;
+{
+#ifndef HAVE_ALLOCA
+ struct block_list *block_list = NULL;
+#endif
+ FILE *fp;
+ char *full_fname;
+ size_t added;
+ static const char aliasfile[] = "/locale.alias";
+
+ full_fname = (char *) alloca (fname_len + sizeof aliasfile);
+ ADD_BLOCK (block_list, full_fname);
+ memcpy (full_fname, fname, fname_len);
+ memcpy (&full_fname[fname_len], aliasfile, sizeof aliasfile);
+
+ fp = fopen (full_fname, "r");
+ if (fp == NULL)
+ {
+ FREE_BLOCKS (block_list);
+ return 0;
+ }
+
+ added = 0;
+ while (!feof (fp))
+ {
+ /* It is a reasonable approach to use a fix buffer here because
+ a) we are only interested in the first two fields
+ b) these fields must be usable as file names and so must not
+ be that long
+ */
+ char buf[BUFSIZ];
+ char *alias;
+ char *value;
+ char *cp;
+
+ if (fgets (buf, BUFSIZ, fp) == NULL)
+ /* EOF reached. */
+ break;
+
+ cp = buf;
+ /* Ignore leading white space. */
+ while (isspace (cp[0]))
+ ++cp;
+
+ /* A leading '#' signals a comment line. */
+ if (cp[0] != '\0' && cp[0] != '#')
+ {
+ alias = cp++;
+ while (cp[0] != '\0' && !isspace (cp[0]))
+ ++cp;
+ /* Terminate alias name. */
+ if (cp[0] != '\0')
+ *cp++ = '\0';
+
+ /* Now look for the beginning of the value. */
+ while (isspace (cp[0]))
+ ++cp;
+
+ if (cp[0] != '\0')
+ {
+ char *tp;
+ size_t len;
+
+ value = cp++;
+ while (cp[0] != '\0' && !isspace (cp[0]))
+ ++cp;
+ /* Terminate value. */
+ if (cp[0] == '\n')
+ {
+ /* This has to be done to make the following test
+ for the end of line possible. We are looking for
+ the terminating '\n' which do not overwrite here. */
+ *cp++ = '\0';
+ *cp = '\n';
+ }
+ else if (cp[0] != '\0')
+ *cp++ = '\0';
+
+ if (nmap >= maxmap)
+ extend_alias_table ();
+
+ /* We cannot depend on strdup available in the libc. Sigh! */
+ len = strlen (alias) + 1;
+ tp = (char *) malloc (len);
+ if (tp == NULL)
+ {
+ FREE_BLOCKS (block_list);
+ return added;
+ }
+ memcpy (tp, alias, len);
+ map[nmap].alias = tp;
+
+ len = strlen (value) + 1;
+ tp = (char *) malloc (len);
+ if (tp == NULL)
+ {
+ FREE_BLOCKS (block_list);
+ return added;
+ }
+ memcpy (tp, value, len);
+ map[nmap].value = tp;
+
+ ++nmap;
+ ++added;
+ }
+ }
+
+ /* Possibly not the whole line fits into the buffer. Ignore
+ the rest of the line. */
+ while (strchr (cp, '\n') == NULL)
+ {
+ cp = buf;
+ if (fgets (buf, BUFSIZ, fp) == NULL)
+ /* Make sure the inner loop will be left. The outer loop
+ will exit at the `feof' test. */
+ *cp = '\n';
+ }
+ }
+
+ /* Should we test for ferror()? I think we have to silently ignore
+ errors. --drepper */
+ fclose (fp);
+
+ if (added > 0)
+ qsort (map, nmap, sizeof (struct alias_map),
+ (int (*) PARAMS ((const void *, const void *))) alias_compare);
+
+ FREE_BLOCKS (block_list);
+ return added;
+}
+
+
+static void
+extend_alias_table ()
+{
+ size_t new_size;
+ struct alias_map *new_map;
+
+ new_size = maxmap == 0 ? 100 : 2 * maxmap;
+ new_map = (struct alias_map *) malloc (new_size
+ * sizeof (struct alias_map));
+ if (new_map == NULL)
+ /* Simply don't extend: we don't have any more core. */
+ return;
+
+ memcpy (new_map, map, nmap * sizeof (struct alias_map));
+
+ if (maxmap != 0)
+ free (map);
+
+ map = new_map;
+ maxmap = new_size;
+}
+
+
+static int
+alias_compare (map1, map2)
+ const struct alias_map *map1;
+ const struct alias_map *map2;
+{
+#if defined _LIBC || defined HAVE_STRCASECMP
+ return strcasecmp (map1->alias, map2->alias);
+#else
+ const unsigned char *p1 = (const unsigned char *) map1->alias;
+ const unsigned char *p2 = (const unsigned char *) map2->alias;
+ unsigned char c1, c2;
+
+ if (p1 == p2)
+ return 0;
+
+ do
+ {
+ /* I know this seems to be odd but the tolower() function in
+ some systems libc cannot handle nonalpha characters. */
+ c1 = isupper (*p1) ? tolower (*p1) : *p1;
+ c2 = isupper (*p2) ? tolower (*p2) : *p2;
+ if (c1 == '\0')
+ break;
+ ++p1;
+ ++p2;
+ }
+ while (c1 == c2);
+
+ return c1 - c2;
+#endif
+}
--- /dev/null
+# po2tbl.sed - Convert Uniforum style .po file to lookup table for catgets
+# Copyright (C) 1995 Free Software Foundation, Inc.
+# Ulrich Drepper <drepper@gnu.org>, 1995.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+1 {
+ i\
+/* Automatically generated by po2tbl.sed from @PACKAGE NAME@.pot. */\
+\
+#if HAVE_CONFIG_H\
+# include <config.h>\
+#endif\
+\
+#include "libgettext.h"\
+\
+const struct _msg_ent _msg_tbl[] = {
+ h
+ s/.*/0/
+ x
+}
+#
+# Write msgid entries in C array form.
+#
+/^msgid/ {
+ s/msgid[ ]*\(".*"\)/ {\1/
+ tb
+# Append the next line
+ :b
+ N
+# Look whether second part is continuation line.
+ s/\(.*\)"\(\n\)"\(.*"\)/\1\2\3/
+# Yes, then branch.
+ ta
+# Because we assume that the input file correctly formed the line
+# just read cannot be again be a msgid line. So it's safe to ignore
+# it.
+ s/\(.*\)\n.*/\1/
+ bc
+# We found a continuation line. But before printing insert '\'.
+ :a
+ s/\(.*\)\(\n.*\)/\1\\\2/
+ P
+# We cannot use D here.
+ s/.*\n\(.*\)/\1/
+# Some buggy seds do not clear the `successful substitution since last ``t'''
+# flag on `N', so we do a `t' here to clear it.
+ tb
+# Not reached
+ :c
+ x
+# The following nice solution is by
+# Bruno <Haible@ma2s2.mathematik.uni-karlsruhe.de>
+ td
+# Increment a decimal number in pattern space.
+# First hide trailing `9' digits.
+ :d
+ s/9\(_*\)$/_\1/
+ td
+# Assure at least one digit is available.
+ s/^\(_*\)$/0\1/
+# Increment the last digit.
+ s/8\(_*\)$/9\1/
+ s/7\(_*\)$/8\1/
+ s/6\(_*\)$/7\1/
+ s/5\(_*\)$/6\1/
+ s/4\(_*\)$/5\1/
+ s/3\(_*\)$/4\1/
+ s/2\(_*\)$/3\1/
+ s/1\(_*\)$/2\1/
+ s/0\(_*\)$/1\1/
+# Convert the hidden `9' digits to `0's.
+ s/_/0/g
+ x
+ G
+ s/\(.*\)\n\([0-9]*\)/\1, \2},/
+ s/\(.*\)"$/\1/
+ p
+}
+#
+# Last line.
+#
+$ {
+ i\
+};\
+
+ g
+ s/0*\(.*\)/int _msg_tbl_length = \1;/p
+}
+d
--- /dev/null
+/* Implementation of the textdomain(3) function
+ Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+ Written by Ulrich Drepper <drepper@gnu.org>, 1995.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#if defined STDC_HEADERS || defined _LIBC
+# include <stdlib.h>
+#endif
+
+#if defined STDC_HEADERS || defined HAVE_STRING_H || defined _LIBC
+# include <string.h>
+#else
+# include <strings.h>
+# ifndef memcpy
+# define memcpy(Dst, Src, Num) bcopy (Src, Dst, Num)
+# endif
+#endif
+
+#ifdef _LIBC
+# include <libintl.h>
+#else
+# include "libgettext.h"
+#endif
+
+/* @@ end of prolog @@ */
+
+/* Name of the default text domain. */
+extern const char _nl_default_default_domain[];
+
+/* Default text domain in which entries for gettext(3) are to be found. */
+extern const char *_nl_current_default_domain;
+
+
+/* Names for the libintl functions are a problem. They must not clash
+ with existing names and they should follow ANSI C. But this source
+ code is also used in GNU C Library where the names have a __
+ prefix. So we have to make a difference here. */
+#ifdef _LIBC
+# define TEXTDOMAIN __textdomain
+# define strdup(str) __strdup (str)
+#else
+# define TEXTDOMAIN textdomain__
+#endif
+
+/* Set the current default message catalog to DOMAINNAME.
+ If DOMAINNAME is null, return the current default.
+ If DOMAINNAME is "", reset to the default of "messages". */
+char *
+TEXTDOMAIN (domainname)
+ const char *domainname;
+{
+ char *old;
+
+ /* A NULL pointer requests the current setting. */
+ if (domainname == NULL)
+ return (char *) _nl_current_default_domain;
+
+ old = (char *) _nl_current_default_domain;
+
+ /* If domain name is the null string set to default domain "messages". */
+ if (domainname[0] == '\0'
+ || strcmp (domainname, _nl_default_default_domain) == 0)
+ _nl_current_default_domain = _nl_default_default_domain;
+ else
+ {
+ /* If the following malloc fails `_nl_current_default_domain'
+ will be NULL. This value will be returned and so signals we
+ are out of core. */
+#if defined _LIBC || defined HAVE_STRDUP
+ _nl_current_default_domain = strdup (domainname);
+#else
+ size_t len = strlen (domainname) + 1;
+ char *cp = (char *) malloc (len);
+ if (cp != NULL)
+ memcpy (cp, domainname, len);
+ _nl_current_default_domain = cp;
+#endif
+ }
+
+ if (old != _nl_default_default_domain)
+ free (old);
+
+ return (char *) _nl_current_default_domain;
+}
+
+#ifdef _LIBC
+/* Alias for function name in GNU C Library. */
+weak_alias (__textdomain, textdomain);
+#endif
--- /dev/null
+# po2msg.sed - Convert Uniforum style .po file to X/Open style .msg file
+# Copyright (C) 1995 Free Software Foundation, Inc.
+# Ulrich Drepper <drepper@gnu.org>, 1995.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+#
+# The first directive in the .msg should be the definition of the
+# message set number. We use always set number 1.
+#
+1 {
+ i\
+$set 1 # Automatically created by po2msg.sed
+ h
+ s/.*/0/
+ x
+}
+#
+# We copy all comments into the .msg file. Perhaps they can help.
+#
+/^#/ s/^#[ ]*/$ /p
+#
+# We copy the original message as a comment into the .msg file.
+#
+/^msgid/ {
+# Does not work now
+# /"$/! {
+# s/\\$//
+# s/$/ ... (more lines following)"/
+# }
+ s/^msgid[ ]*"\(.*\)"$/$ Original Message: \1/
+ p
+}
+#
+# The .msg file contains, other then the .po file, only the translations
+# but each given a unique ID. Starting from 1 and incrementing by 1 for
+# each message we assign them to the messages.
+# It is important that the .po file used to generate the cat-id-tbl.c file
+# (with po-to-tbl) is the same as the one used here. (At least the order
+# of declarations must not be changed.)
+#
+/^msgstr/ {
+ s/msgstr[ ]*"\(.*\)"/\1/
+ x
+# The following nice solution is by
+# Bruno <Haible@ma2s2.mathematik.uni-karlsruhe.de>
+ td
+# Increment a decimal number in pattern space.
+# First hide trailing `9' digits.
+ :d
+ s/9\(_*\)$/_\1/
+ td
+# Assure at least one digit is available.
+ s/^\(_*\)$/0\1/
+# Increment the last digit.
+ s/8\(_*\)$/9\1/
+ s/7\(_*\)$/8\1/
+ s/6\(_*\)$/7\1/
+ s/5\(_*\)$/6\1/
+ s/4\(_*\)$/5\1/
+ s/3\(_*\)$/4\1/
+ s/2\(_*\)$/3\1/
+ s/1\(_*\)$/2\1/
+ s/0\(_*\)$/1\1/
+# Convert the hidden `9' digits to `0's.
+ s/_/0/g
+ x
+# Bring the line in the format `<number> <message>'
+ G
+ s/^[^\n]*$/& /
+ s/\(.*\)\n\([0-9]*\)/\2 \1/
+# Clear flag from last substitution.
+ tb
+# Append the next line.
+ :b
+ N
+# Look whether second part is a continuation line.
+ s/\(.*\n\)"\(.*\)"/\1\2/
+# Yes, then branch.
+ ta
+ P
+ D
+# Note that `D' includes a jump to the start!!
+# We found a continuation line. But before printing insert '\'.
+ :a
+ s/\(.*\)\(\n.*\)/\1\\\2/
+ P
+# We cannot use the sed command `D' here
+ s/.*\n\(.*\)/\1/
+ tb
+}
+d
--- /dev/null
+Sun Jan 2 21:31:48 2000 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (SUBDIRS) Only include gmp if libgmp not installed
+ on this system already.
+
+Sun May 31 00:55:51 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (SUBDIRS) Add gmp.
+
+ * gmp/: New subdirectory, containing a subset of GNU libgmp2 just
+ big enough to support mpf_init_set_d(), mpf_get_str(), and
+ mpf_clear().
+
+Fri Apr 24 12:52:07 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (SUBDIRS) Remove avllib.
+
+ * avllib/: Removed.
+
+Wed Dec 24 22:36:50 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (SUBDIRS) Add dcdflib.
+
+ * dcdflib: New subdirectory.
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+## Process this file with automake to produce Makefile.in -*- makefile -*-
+
+SUBDIRS = julcal @GMP_SUBDIRS@ misc dcdflib
+DIST_SUBDIRS = julcal gmp misc dcdflib
+
+MAINTAINERCLEANFILES = Makefile.in
--- /dev/null
+The following license applies *only* to the files cdflib.h, dcdflib.c,
+and ipmpar.c. -blp
+
+ LEGALITIES
+
+Code that appeared in an ACM publication is subject to their
+algorithms policy:
+
+ Submittal of an algorithm for publication in one of the ACM
+ Transactions implies that unrestricted use of the algorithm within a
+ computer is permissible. General permission to copy and distribute
+ the algorithm without fee is granted provided that the copies are not
+ made or distributed for direct commercial advantage. The ACM
+ copyright notice and the title of the publication and its date appear,
+ and notice is given that copying is by permission of the Association
+ for Computing Machinery. To copy otherwise, or to republish, requires
+ a fee and/or specific permission.
+
+ Krogh, F. Algorithms Policy. ACM Tran. Math. Softw. 13(1987),
+ 183-186.
+
+We place the DCDFLIB code that we have written in the public domain.
+
+ NO WARRANTY
+
+ WE PROVIDE ABSOLUTELY NO 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
+ THIS PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY
+ SERVICING, REPAIR OR CORRECTION.
+
+ IN NO EVENT SHALL THE UNIVERSITY OF TEXAS OR ANY OF ITS COMPONENT
+ INSTITUTIONS INCLUDING M. D. ANDERSON HOSPITAL BE LIABLE TO YOU FOR
+ DAMAGES, INCLUDING ANY LOST PROFITS, LOST MONIES, OR OTHER SPECIAL,
+ INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR
+ INABILITY TO USE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA OR
+ ITS ANALYSIS BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD
+ PARTIES) THE PROGRAM.
+
+ (Above NO WARRANTY modified from the GNU NO WARRANTY statement.)
--- /dev/null
+Sun Aug 9 11:16:26 1998 Ben Pfaff <blp@gnu.org>
+
+ * dcdflib.COPYING: Renamed COPYING.
+
+Sun Jul 5 00:14:51 1998 Ben Pfaff <blp@gnu.org>
+
+ * cdflib.h: Move E0000, E0001 prototypes into dcdflib.c.
+
+Thu May 7 22:56:48 1998 Ben Pfaff <blp@gnu.org>
+
+ * dcdflib.c: (E0000) Explicitly constant string to char * in call
+ to ftnstop() in order to alleviate warning from gcc.
+
+Sat Jan 3 17:08:58 1998 Ben Pfaff <blp@gnu.org>
+
+ * README: New file.
+
+Wed Dec 24 22:37:21 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: New file.
+
+ * cdflib.h: New file from dcdflib.c-1.1.
+
+ * dcdflib.COPYING: New file extracted from dcdflib.c-1.1 README.
+
+ * dcdflib.c: New file from dcdflib.c-1.1. Minor changes
+ (parenthesization) to placate gcc warnings.
+
+ * ipmpar.c: New file from dcdflib.c-1.1. Largely rewritten for
+ autoconf.
+
+
--- /dev/null
+## Process this file with automake to produce Makefile.in -*- makefile -*-
+
+noinst_LIBRARIES = libdcdflib.a
+
+INCLUDES = -I$(srcdir) -I$(top_srcdir)/src -I$(top_srcdir) \
+-I$(top_srcdir)/intl
+
+libdcdflib_a_SOURCES = dcdflib.c ipmpar.c
+noinst_HEADERS = cdflib.h
+
+MAINTAINERCLEANFILES = Makefile.in
+
+EXTRA_DIST = COPYING
--- /dev/null
+Please note that dcdflib is not part of PSPP. Instead, it is a
+separate library that is included in the PSPP distribution for
+convenience in compiling.
+
+ -blp
--- /dev/null
+double algdiv(double*,double*);
+double alngam(double*);
+double alnrel(double*);
+double apser(double*,double*,double*,double*);
+double basym(double*,double*,double*,double*);
+double bcorr(double*,double*);
+double betaln(double*,double*);
+double bfrac(double*,double*,double*,double*,double*,double*);
+void bgrat(double*,double*,double*,double*,double*,double*,int*i);
+double bpser(double*,double*,double*,double*);
+void bratio(double*,double*,double*,double*,double*,double*,int*);
+double brcmp1(int*,double*,double*,double*,double*);
+double brcomp(double*,double*,double*,double*);
+double bup(double*,double*,double*,double*,int*,double*);
+void cdfbet(int*,double*,double*,double*,double*,double*,double*,
+ int*,double*);
+void cdfbin(int*,double*,double*,double*,double*,double*,double*,
+ int*,double*);
+void cdfchi(int*,double*,double*,double*,double*,int*,double*);
+void cdfchn(int*,double*,double*,double*,double*,double*,int*,double*);
+void cdff(int*,double*,double*,double*,double*,double*,int*,double*);
+void cdffnc(int*,double*,double*,double*,double*,double*,double*,
+ int*s,double*);
+void cdfgam(int*,double*,double*,double*,double*,double*,int*,double*);
+void cdfnbn(int*,double*,double*,double*,double*,double*,double*,
+ int*,double*);
+void cdfnor(int*,double*,double*,double*,double*,double*,int*,double*);
+void cdfpoi(int*,double*,double*,double*,double*,int*,double*);
+void cdft(int*,double*,double*,double*,double*,int*,double*);
+void cdftnc(int*,double*,double*,double*,double*,double*,int*,double*);
+void cumbet(double*,double*,double*,double*,double*,double*);
+void cumbin(double*,double*,double*,double*,double*,double*);
+void cumchi(double*,double*,double*,double*);
+void cumchn(double*,double*,double*,double*,double*);
+void cumf(double*,double*,double*,double*,double*);
+void cumfnc(double*,double*,double*,double*,double*,double*);
+void cumgam(double*,double*,double*,double*);
+void cumnbn(double*,double*,double*,double*,double*,double*);
+void cumnor(double*,double*,double*);
+void cumpoi(double*,double*,double*,double*);
+void cumt(double*,double*,double*,double*);
+void cumtnc(double*,double*,double*,double*,double*);
+double devlpl(double [],int*,double*);
+double dinvnr(double *p,double *q);
+void dinvr(int*,double*,double*,unsigned long*,unsigned long*);
+void dstinv(double*,double*,double*,double*,double*,double*,
+ double*);
+double dt1(double*,double*,double*);
+void dzror(int*,double*,double*,double*,double *,
+ unsigned long*,unsigned long*);
+void dstzr(double *zxlo,double *zxhi,double *zabstl,double *zreltl);
+double erf1(double*);
+double erfc1(int*,double*);
+double esum(int*,double*);
+double exparg(int*);
+double fpser(double*,double*,double*,double*);
+double gam1(double*);
+void gaminv(double*,double*,double*,double*,double*,int*);
+double gamln(double*);
+double gamln1(double*);
+double Xgamm(double*);
+void grat1(double*,double*,double*,double*,double*,double*);
+void gratio(double*,double*,double*,double*,int*);
+double gsumln(double*,double*);
+double psi(double*);
+double rcomp(double*,double*);
+double rexp(double*);
+double rlog(double*);
+double rlog1(double*);
+double spmpar(int*);
+double stvaln(double*);
+double fifdint(double);
+double fifdmax1(double,double);
+double fifdmin1(double,double);
+double fifdsign(double,double);
+long fifidint(double);
+long fifmod(long,long);
+void ftnstop(char*);
+extern int ipmpar(int*);
+
--- /dev/null
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "cdflib.h"
+
+static void E0000(int,int*,double*,double*,unsigned long*,
+ unsigned long*,double*,double*,double*,
+ double*,double*,double*,double*);
+static void E0001(int,int*,double*,double*,double*,double*,
+ unsigned long*,unsigned long*,double*,double*,
+ double*,double*);
+
+/*
+ * A comment about ints and longs - whether ints or longs are used should
+ * make no difference, but where double r-values are assigned to ints the
+ * r-value is cast converted to a long, which is then assigned to the int
+ * to be compatible with the operation of fifidint.
+ */
+/*
+-----------------------------------------------------------------------
+
+ COMPUTATION OF LN(GAMMA(B)/GAMMA(A+B)) WHEN B .GE. 8
+
+ --------
+
+ IN THIS ALGORITHM, DEL(X) IS THE FUNCTION DEFINED BY
+ LN(GAMMA(X)) = (X - 0.5)*LN(X) - X + 0.5*LN(2*PI) + DEL(X).
+
+-----------------------------------------------------------------------
+*/
+double algdiv(double *a,double *b)
+{
+static double c0 = .833333333333333e-01;
+static double c1 = -.277777777760991e-02;
+static double c2 = .793650666825390e-03;
+static double c3 = -.595202931351870e-03;
+static double c4 = .837308034031215e-03;
+static double c5 = -.165322962780713e-02;
+static double algdiv,c,d,h,s11,s3,s5,s7,s9,t,u,v,w,x,x2,T1;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(*a <= *b) goto S10;
+ h = *b/ *a;
+ c = 1.0e0/(1.0e0+h);
+ x = h/(1.0e0+h);
+ d = *a+(*b-0.5e0);
+ goto S20;
+S10:
+ h = *a/ *b;
+ c = h/(1.0e0+h);
+ x = 1.0e0/(1.0e0+h);
+ d = *b+(*a-0.5e0);
+S20:
+/*
+ SET SN = (1 - X**N)/(1 - X)
+*/
+ x2 = x*x;
+ s3 = 1.0e0+(x+x2);
+ s5 = 1.0e0+(x+x2*s3);
+ s7 = 1.0e0+(x+x2*s5);
+ s9 = 1.0e0+(x+x2*s7);
+ s11 = 1.0e0+(x+x2*s9);
+/*
+ SET W = DEL(B) - DEL(A + B)
+*/
+ t = pow(1.0e0/ *b,2.0);
+ w = ((((c5*s11*t+c4*s9)*t+c3*s7)*t+c2*s5)*t+c1*s3)*t+c0;
+ w *= (c/ *b);
+/*
+ COMBINE THE RESULTS
+*/
+ T1 = *a/ *b;
+ u = d*alnrel(&T1);
+ v = *a*(log(*b)-1.0e0);
+ if(u <= v) goto S30;
+ algdiv = w-v-u;
+ return algdiv;
+S30:
+ algdiv = w-u-v;
+ return algdiv;
+}
+double alngam(double *x)
+/*
+**********************************************************************
+
+ double alngam(double *x)
+ double precision LN of the GAMma function
+
+
+ Function
+
+
+ Returns the natural logarithm of GAMMA(X).
+
+
+ Arguments
+
+
+ X --> value at which scaled log gamma is to be returned
+ X is DOUBLE PRECISION
+
+
+ Method
+
+
+ If X .le. 6.0, then use recursion to get X below 3
+ then apply rational approximation number 5236 of
+ Hart et al, Computer Approximations, John Wiley and
+ Sons, NY, 1968.
+
+ If X .gt. 6.0, then use recursion to get X to at least 12 and
+ then use formula 5423 of the same source.
+
+**********************************************************************
+*/
+{
+#define hln2pi 0.91893853320467274178e0
+static double coef[5] = {
+ 0.83333333333333023564e-1,-0.27777777768818808e-2,0.79365006754279e-3,
+ -0.594997310889e-3,0.8065880899e-3
+};
+static double scoefd[4] = {
+ 0.62003838007126989331e2,0.9822521104713994894e1,-0.8906016659497461257e1,
+ 0.1000000000000000000e1
+};
+static double scoefn[9] = {
+ 0.62003838007127258804e2,0.36036772530024836321e2,0.20782472531792126786e2,
+ 0.6338067999387272343e1,0.215994312846059073e1,0.3980671310203570498e0,
+ 0.1093115956710439502e0,0.92381945590275995e-2,0.29737866448101651e-2
+};
+static int K1 = 9;
+static int K3 = 4;
+static int K5 = 5;
+static double alngam,offset,prod,xx;
+static int i,n;
+static double T2,T4,T6;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(!(*x <= 6.0e0)) goto S70;
+ prod = 1.0e0;
+ xx = *x;
+ if(!(*x > 3.0e0)) goto S30;
+S10:
+ if(!(xx > 3.0e0)) goto S20;
+ xx -= 1.0e0;
+ prod *= xx;
+ goto S10;
+S30:
+S20:
+ if(!(*x < 2.0e0)) goto S60;
+S40:
+ if(!(xx < 2.0e0)) goto S50;
+ prod /= xx;
+ xx += 1.0e0;
+ goto S40;
+S60:
+S50:
+ T2 = xx-2.0e0;
+ T4 = xx-2.0e0;
+ alngam = devlpl(scoefn,&K1,&T2)/devlpl(scoefd,&K3,&T4);
+/*
+ COMPUTE RATIONAL APPROXIMATION TO GAMMA(X)
+*/
+ alngam *= prod;
+ alngam = log(alngam);
+ goto S110;
+S70:
+ offset = hln2pi;
+/*
+ IF NECESSARY MAKE X AT LEAST 12 AND CARRY CORRECTION IN OFFSET
+*/
+ n = fifidint(12.0e0-*x);
+ if(!(n > 0)) goto S90;
+ prod = 1.0e0;
+ for(i=1; i<=n; i++) prod *= (*x+(double)(i-1));
+ offset -= log(prod);
+ xx = *x+(double)n;
+ goto S100;
+S90:
+ xx = *x;
+S100:
+/*
+ COMPUTE POWER SERIES
+*/
+ T6 = 1.0e0/pow(xx,2.0);
+ alngam = devlpl(coef,&K5,&T6)/xx;
+ alngam += (offset+(xx-0.5e0)*log(xx)-xx);
+S110:
+ return alngam;
+#undef hln2pi
+}
+double alnrel(double *a)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF THE FUNCTION LN(1 + A)
+-----------------------------------------------------------------------
+*/
+{
+static double p1 = -.129418923021993e+01;
+static double p2 = .405303492862024e+00;
+static double p3 = -.178874546012214e-01;
+static double q1 = -.162752256355323e+01;
+static double q2 = .747811014037616e+00;
+static double q3 = -.845104217945565e-01;
+static double alnrel,t,t2,w,x;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(fabs(*a) > 0.375e0) goto S10;
+ t = *a/(*a+2.0e0);
+ t2 = t*t;
+ w = (((p3*t2+p2)*t2+p1)*t2+1.0e0)/(((q3*t2+q2)*t2+q1)*t2+1.0e0);
+ alnrel = 2.0e0*t*w;
+ return alnrel;
+S10:
+ x = 1.e0+*a;
+ alnrel = log(x);
+ return alnrel;
+}
+double apser(double *a,double *b,double *x,double *eps)
+/*
+-----------------------------------------------------------------------
+ APSER YIELDS THE INCOMPLETE BETA RATIO I(SUB(1-X))(B,A) FOR
+ A .LE. MIN(EPS,EPS*B), B*X .LE. 1, AND X .LE. 0.5. USED WHEN
+ A IS VERY SMALL. USE ONLY IF ABOVE INEQUALITIES ARE SATISFIED.
+-----------------------------------------------------------------------
+*/
+{
+static double g = .577215664901533e0;
+static double apser,aj,bx,c,j,s,t,tol;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ bx = *b**x;
+ t = *x-bx;
+ if(*b**eps > 2.e-2) goto S10;
+ c = log(*x)+psi(b)+g+t;
+ goto S20;
+S10:
+ c = log(bx)+g+t;
+S20:
+ tol = 5.0e0**eps*fabs(c);
+ j = 1.0e0;
+ s = 0.0e0;
+S30:
+ j += 1.0e0;
+ t *= (*x-bx/j);
+ aj = t/j;
+ s += aj;
+ if(fabs(aj) > tol) goto S30;
+ apser = -(*a*(c+s));
+ return apser;
+}
+double basym(double *a,double *b,double *lambda,double *eps)
+/*
+-----------------------------------------------------------------------
+ ASYMPTOTIC EXPANSION FOR IX(A,B) FOR LARGE A AND B.
+ LAMBDA = (A + B)*Y - B AND EPS IS THE TOLERANCE USED.
+ IT IS ASSUMED THAT LAMBDA IS NONNEGATIVE AND THAT
+ A AND B ARE GREATER THAN OR EQUAL TO 15.
+-----------------------------------------------------------------------
+*/
+{
+static double e0 = 1.12837916709551e0;
+static double e1 = .353553390593274e0;
+static int num = 20;
+/*
+------------------------
+ ****** NUM IS THE MAXIMUM VALUE THAT N CAN TAKE IN THE DO LOOP
+ ENDING AT STATEMENT 50. IT IS REQUIRED THAT NUM BE EVEN.
+ THE ARRAYS A0, B0, C, D HAVE DIMENSION NUM + 1.
+------------------------
+ E0 = 2/SQRT(PI)
+ E1 = 2**(-3/2)
+------------------------
+*/
+static int K3 = 1;
+static double basym,bsum,dsum,f,h,h2,hn,j0,j1,r,r0,r1,s,sum,t,t0,t1,u,w,w0,z,z0,
+ z2,zn,znm1;
+static int i,im1,imj,j,m,mm1,mmj,n,np1;
+static double a0[21],b0[21],c[21],d[21],T1,T2;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ basym = 0.0e0;
+ if(*a >= *b) goto S10;
+ h = *a/ *b;
+ r0 = 1.0e0/(1.0e0+h);
+ r1 = (*b-*a)/ *b;
+ w0 = 1.0e0/sqrt(*a*(1.0e0+h));
+ goto S20;
+S10:
+ h = *b/ *a;
+ r0 = 1.0e0/(1.0e0+h);
+ r1 = (*b-*a)/ *a;
+ w0 = 1.0e0/sqrt(*b*(1.0e0+h));
+S20:
+ T1 = -(*lambda/ *a);
+ T2 = *lambda/ *b;
+ f = *a*rlog1(&T1)+*b*rlog1(&T2);
+ t = exp(-f);
+ if(t == 0.0e0) return basym;
+ z0 = sqrt(f);
+ z = 0.5e0*(z0/e1);
+ z2 = f+f;
+ a0[0] = 2.0e0/3.0e0*r1;
+ c[0] = -(0.5e0*a0[0]);
+ d[0] = -c[0];
+ j0 = 0.5e0/e0*erfc1(&K3,&z0);
+ j1 = e1;
+ sum = j0+d[0]*w0*j1;
+ s = 1.0e0;
+ h2 = h*h;
+ hn = 1.0e0;
+ w = w0;
+ znm1 = z;
+ zn = z2;
+ for(n=2; n<=num; n+=2) {
+ hn = h2*hn;
+ a0[n-1] = 2.0e0*r0*(1.0e0+h*hn)/((double)n+2.0e0);
+ np1 = n+1;
+ s += hn;
+ a0[np1-1] = 2.0e0*r1*s/((double)n+3.0e0);
+ for(i=n; i<=np1; i++) {
+ r = -(0.5e0*((double)i+1.0e0));
+ b0[0] = r*a0[0];
+ for(m=2; m<=i; m++) {
+ bsum = 0.0e0;
+ mm1 = m-1;
+ for(j=1; j<=mm1; j++) {
+ mmj = m-j;
+ bsum += (((double)j*r-(double)mmj)*a0[j-1]*b0[mmj-1]);
+ }
+ b0[m-1] = r*a0[m-1]+bsum/(double)m;
+ }
+ c[i-1] = b0[i-1]/((double)i+1.0e0);
+ dsum = 0.0e0;
+ im1 = i-1;
+ for(j=1; j<=im1; j++) {
+ imj = i-j;
+ dsum += (d[imj-1]*c[j-1]);
+ }
+ d[i-1] = -(dsum+c[i-1]);
+ }
+ j0 = e1*znm1+((double)n-1.0e0)*j0;
+ j1 = e1*zn+(double)n*j1;
+ znm1 = z2*znm1;
+ zn = z2*zn;
+ w = w0*w;
+ t0 = d[n-1]*w*j0;
+ w = w0*w;
+ t1 = d[np1-1]*w*j1;
+ sum += (t0+t1);
+ if(fabs(t0)+fabs(t1) <= *eps*sum) goto S80;
+ }
+S80:
+ u = exp(-bcorr(a,b));
+ basym = e0*t*u*sum;
+ return basym;
+}
+double bcorr(double *a0,double *b0)
+/*
+-----------------------------------------------------------------------
+
+ EVALUATION OF DEL(A0) + DEL(B0) - DEL(A0 + B0) WHERE
+ LN(GAMMA(A)) = (A - 0.5)*LN(A) - A + 0.5*LN(2*PI) + DEL(A).
+ IT IS ASSUMED THAT A0 .GE. 8 AND B0 .GE. 8.
+
+-----------------------------------------------------------------------
+*/
+{
+static double c0 = .833333333333333e-01;
+static double c1 = -.277777777760991e-02;
+static double c2 = .793650666825390e-03;
+static double c3 = -.595202931351870e-03;
+static double c4 = .837308034031215e-03;
+static double c5 = -.165322962780713e-02;
+static double bcorr,a,b,c,h,s11,s3,s5,s7,s9,t,w,x,x2;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ a = fifdmin1(*a0,*b0);
+ b = fifdmax1(*a0,*b0);
+ h = a/b;
+ c = h/(1.0e0+h);
+ x = 1.0e0/(1.0e0+h);
+ x2 = x*x;
+/*
+ SET SN = (1 - X**N)/(1 - X)
+*/
+ s3 = 1.0e0+(x+x2);
+ s5 = 1.0e0+(x+x2*s3);
+ s7 = 1.0e0+(x+x2*s5);
+ s9 = 1.0e0+(x+x2*s7);
+ s11 = 1.0e0+(x+x2*s9);
+/*
+ SET W = DEL(B) - DEL(A + B)
+*/
+ t = pow(1.0e0/b,2.0);
+ w = ((((c5*s11*t+c4*s9)*t+c3*s7)*t+c2*s5)*t+c1*s3)*t+c0;
+ w *= (c/b);
+/*
+ COMPUTE DEL(A) + W
+*/
+ t = pow(1.0e0/a,2.0);
+ bcorr = (((((c5*t+c4)*t+c3)*t+c2)*t+c1)*t+c0)/a+w;
+ return bcorr;
+}
+double betaln(double *a0,double *b0)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF THE LOGARITHM OF THE BETA FUNCTION
+-----------------------------------------------------------------------
+ E = 0.5*LN(2*PI)
+--------------------------
+*/
+{
+static double e = .918938533204673e0;
+static double betaln,a,b,c,h,u,v,w,z;
+static int i,n;
+static double T1;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ a = fifdmin1(*a0,*b0);
+ b = fifdmax1(*a0,*b0);
+ if(a >= 8.0e0) goto S100;
+ if(a >= 1.0e0) goto S20;
+/*
+-----------------------------------------------------------------------
+ PROCEDURE WHEN A .LT. 1
+-----------------------------------------------------------------------
+*/
+ if(b >= 8.0e0) goto S10;
+ T1 = a+b;
+ betaln = gamln(&a)+(gamln(&b)-gamln(&T1));
+ return betaln;
+S10:
+ betaln = gamln(&a)+algdiv(&a,&b);
+ return betaln;
+S20:
+/*
+-----------------------------------------------------------------------
+ PROCEDURE WHEN 1 .LE. A .LT. 8
+-----------------------------------------------------------------------
+*/
+ if(a > 2.0e0) goto S40;
+ if(b > 2.0e0) goto S30;
+ betaln = gamln(&a)+gamln(&b)-gsumln(&a,&b);
+ return betaln;
+S30:
+ w = 0.0e0;
+ if(b < 8.0e0) goto S60;
+ betaln = gamln(&a)+algdiv(&a,&b);
+ return betaln;
+S40:
+/*
+ REDUCTION OF A WHEN B .LE. 1000
+*/
+ if(b > 1000.0e0) goto S80;
+ n = (long)(a - 1.0e0);
+ w = 1.0e0;
+ for(i=1; i<=n; i++) {
+ a -= 1.0e0;
+ h = a/b;
+ w *= (h/(1.0e0+h));
+ }
+ w = log(w);
+ if(b < 8.0e0) goto S60;
+ betaln = w+gamln(&a)+algdiv(&a,&b);
+ return betaln;
+S60:
+/*
+ REDUCTION OF B WHEN B .LT. 8
+*/
+ n = (long)(b - 1.0e0);
+ z = 1.0e0;
+ for(i=1; i<=n; i++) {
+ b -= 1.0e0;
+ z *= (b/(a+b));
+ }
+ betaln = w+log(z)+(gamln(&a)+(gamln(&b)-gsumln(&a,&b)));
+ return betaln;
+S80:
+/*
+ REDUCTION OF A WHEN B .GT. 1000
+*/
+ n = (long)(a - 1.0e0);
+ w = 1.0e0;
+ for(i=1; i<=n; i++) {
+ a -= 1.0e0;
+ w *= (a/(1.0e0+a/b));
+ }
+ betaln = log(w)-(double)n*log(b)+(gamln(&a)+algdiv(&a,&b));
+ return betaln;
+S100:
+/*
+-----------------------------------------------------------------------
+ PROCEDURE WHEN A .GE. 8
+-----------------------------------------------------------------------
+*/
+ w = bcorr(&a,&b);
+ h = a/b;
+ c = h/(1.0e0+h);
+ u = -((a-0.5e0)*log(c));
+ v = b*alnrel(&h);
+ if(u <= v) goto S110;
+ betaln = -(0.5e0*log(b))+e+w-v-u;
+ return betaln;
+S110:
+ betaln = -(0.5e0*log(b))+e+w-u-v;
+ return betaln;
+}
+double bfrac(double *a,double *b,double *x,double *y,double *lambda,
+ double *eps)
+/*
+-----------------------------------------------------------------------
+ CONTINUED FRACTION EXPANSION FOR IX(A,B) WHEN A,B .GT. 1.
+ IT IS ASSUMED THAT LAMBDA = (A + B)*Y - B.
+-----------------------------------------------------------------------
+*/
+{
+static double bfrac,alpha,an,anp1,beta,bn,bnp1,c,c0,c1,e,n,p,r,r0,s,t,w,yp1;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ bfrac = brcomp(a,b,x,y);
+ if(bfrac == 0.0e0) return bfrac;
+ c = 1.0e0+*lambda;
+ c0 = *b/ *a;
+ c1 = 1.0e0+1.0e0/ *a;
+ yp1 = *y+1.0e0;
+ n = 0.0e0;
+ p = 1.0e0;
+ s = *a+1.0e0;
+ an = 0.0e0;
+ bn = anp1 = 1.0e0;
+ bnp1 = c/c1;
+ r = c1/c;
+S10:
+/*
+ CONTINUED FRACTION CALCULATION
+*/
+ n += 1.0e0;
+ t = n/ *a;
+ w = n*(*b-n)**x;
+ e = *a/s;
+ alpha = p*(p+c0)*e*e*(w**x);
+ e = (1.0e0+t)/(c1+t+t);
+ beta = n+w/s+e*(c+n*yp1);
+ p = 1.0e0+t;
+ s += 2.0e0;
+/*
+ UPDATE AN, BN, ANP1, AND BNP1
+*/
+ t = alpha*an+beta*anp1;
+ an = anp1;
+ anp1 = t;
+ t = alpha*bn+beta*bnp1;
+ bn = bnp1;
+ bnp1 = t;
+ r0 = r;
+ r = anp1/bnp1;
+ if(fabs(r-r0) <= *eps*r) goto S20;
+/*
+ RESCALE AN, BN, ANP1, AND BNP1
+*/
+ an /= bnp1;
+ bn /= bnp1;
+ anp1 = r;
+ bnp1 = 1.0e0;
+ goto S10;
+S20:
+/*
+ TERMINATION
+*/
+ bfrac *= r;
+ return bfrac;
+}
+void bgrat(double *a,double *b,double *x,double *y,double *w,
+ double *eps,int *ierr)
+/*
+-----------------------------------------------------------------------
+ ASYMPTOTIC EXPANSION FOR IX(A,B) WHEN A IS LARGER THAN B.
+ THE RESULT OF THE EXPANSION IS ADDED TO W. IT IS ASSUMED
+ THAT A .GE. 15 AND B .LE. 1. EPS IS THE TOLERANCE USED.
+ IERR IS A VARIABLE THAT REPORTS THE STATUS OF THE RESULTS.
+-----------------------------------------------------------------------
+*/
+{
+static double bm1,bp2n,cn,coef,dj,j,l,lnx,n2,nu,p,q,r,s,sum,t,t2,u,v,z;
+static int i,n,nm1;
+static double c[30],d[30],T1;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ bm1 = *b-0.5e0-0.5e0;
+ nu = *a+0.5e0*bm1;
+ if(*y > 0.375e0) goto S10;
+ T1 = -*y;
+ lnx = alnrel(&T1);
+ goto S20;
+S10:
+ lnx = log(*x);
+S20:
+ z = -(nu*lnx);
+ if(*b*z == 0.0e0) goto S70;
+/*
+ COMPUTATION OF THE EXPANSION
+ SET R = EXP(-Z)*Z**B/GAMMA(B)
+*/
+ r = *b*(1.0e0+gam1(b))*exp(*b*log(z));
+ r *= (exp(*a*lnx)*exp(0.5e0*bm1*lnx));
+ u = algdiv(b,a)+*b*log(nu);
+ u = r*exp(-u);
+ if(u == 0.0e0) goto S70;
+ grat1(b,&z,&r,&p,&q,eps);
+ v = 0.25e0*pow(1.0e0/nu,2.0);
+ t2 = 0.25e0*lnx*lnx;
+ l = *w/u;
+ j = q/r;
+ sum = j;
+ t = cn = 1.0e0;
+ n2 = 0.0e0;
+ for(n=1; n<=30; n++) {
+ bp2n = *b+n2;
+ j = (bp2n*(bp2n+1.0e0)*j+(z+bp2n+1.0e0)*t)*v;
+ n2 += 2.0e0;
+ t *= t2;
+ cn /= (n2*(n2+1.0e0));
+ c[n-1] = cn;
+ s = 0.0e0;
+ if(n == 1) goto S40;
+ nm1 = n-1;
+ coef = *b-(double)n;
+ for(i=1; i<=nm1; i++) {
+ s += (coef*c[i-1]*d[n-i-1]);
+ coef += *b;
+ }
+S40:
+ d[n-1] = bm1*cn+s/(double)n;
+ dj = d[n-1]*j;
+ sum += dj;
+ if(sum <= 0.0e0) goto S70;
+ if(fabs(dj) <= *eps*(sum+l)) goto S60;
+ }
+S60:
+/*
+ ADD THE RESULTS TO W
+*/
+ *ierr = 0;
+ *w += (u*sum);
+ return;
+S70:
+/*
+ THE EXPANSION CANNOT BE COMPUTED
+*/
+ *ierr = 1;
+ return;
+}
+double bpser(double *a,double *b,double *x,double *eps)
+/*
+-----------------------------------------------------------------------
+ POWER SERIES EXPANSION FOR EVALUATING IX(A,B) WHEN B .LE. 1
+ OR B*X .LE. 0.7. EPS IS THE TOLERANCE USED.
+-----------------------------------------------------------------------
+*/
+{
+static double bpser,a0,apb,b0,c,n,sum,t,tol,u,w,z;
+static int i,m;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ bpser = 0.0e0;
+ if(*x == 0.0e0) return bpser;
+/*
+-----------------------------------------------------------------------
+ COMPUTE THE FACTOR X**A/(A*BETA(A,B))
+-----------------------------------------------------------------------
+*/
+ a0 = fifdmin1(*a,*b);
+ if(a0 < 1.0e0) goto S10;
+ z = *a*log(*x)-betaln(a,b);
+ bpser = exp(z)/ *a;
+ goto S100;
+S10:
+ b0 = fifdmax1(*a,*b);
+ if(b0 >= 8.0e0) goto S90;
+ if(b0 > 1.0e0) goto S40;
+/*
+ PROCEDURE FOR A0 .LT. 1 AND B0 .LE. 1
+*/
+ bpser = pow(*x,*a);
+ if(bpser == 0.0e0) return bpser;
+ apb = *a+*b;
+ if(apb > 1.0e0) goto S20;
+ z = 1.0e0+gam1(&apb);
+ goto S30;
+S20:
+ u = *a+*b-1.e0;
+ z = (1.0e0+gam1(&u))/apb;
+S30:
+ c = (1.0e0+gam1(a))*(1.0e0+gam1(b))/z;
+ bpser *= (c*(*b/apb));
+ goto S100;
+S40:
+/*
+ PROCEDURE FOR A0 .LT. 1 AND 1 .LT. B0 .LT. 8
+*/
+ u = gamln1(&a0);
+ m = (long)(b0 - 1.0e0);
+ if(m < 1) goto S60;
+ c = 1.0e0;
+ for(i=1; i<=m; i++) {
+ b0 -= 1.0e0;
+ c *= (b0/(a0+b0));
+ }
+ u = log(c)+u;
+S60:
+ z = *a*log(*x)-u;
+ b0 -= 1.0e0;
+ apb = a0+b0;
+ if(apb > 1.0e0) goto S70;
+ t = 1.0e0+gam1(&apb);
+ goto S80;
+S70:
+ u = a0+b0-1.e0;
+ t = (1.0e0+gam1(&u))/apb;
+S80:
+ bpser = exp(z)*(a0/ *a)*(1.0e0+gam1(&b0))/t;
+ goto S100;
+S90:
+/*
+ PROCEDURE FOR A0 .LT. 1 AND B0 .GE. 8
+*/
+ u = gamln1(&a0)+algdiv(&a0,&b0);
+ z = *a*log(*x)-u;
+ bpser = a0/ *a*exp(z);
+S100:
+ if(bpser == 0.0e0 || *a <= 0.1e0**eps) return bpser;
+/*
+-----------------------------------------------------------------------
+ COMPUTE THE SERIES
+-----------------------------------------------------------------------
+*/
+ sum = n = 0.0e0;
+ c = 1.0e0;
+ tol = *eps/ *a;
+S110:
+ n += 1.0e0;
+ c *= ((0.5e0+(0.5e0-*b/n))**x);
+ w = c/(*a+n);
+ sum += w;
+ if(fabs(w) > tol) goto S110;
+ bpser *= (1.0e0+*a*sum);
+ return bpser;
+}
+void bratio(double *a,double *b,double *x,double *y,double *w,
+ double *w1,int *ierr)
+/*
+-----------------------------------------------------------------------
+
+ EVALUATION OF THE INCOMPLETE BETA FUNCTION IX(A,B)
+
+ --------------------
+
+ IT IS ASSUMED THAT A AND B ARE NONNEGATIVE, AND THAT X .LE. 1
+ AND Y = 1 - X. BRATIO ASSIGNS W AND W1 THE VALUES
+
+ W = IX(A,B)
+ W1 = 1 - IX(A,B)
+
+ IERR IS A VARIABLE THAT REPORTS THE STATUS OF THE RESULTS.
+ IF NO INPUT ERRORS ARE DETECTED THEN IERR IS SET TO 0 AND
+ W AND W1 ARE COMPUTED. OTHERWISE, IF AN ERROR IS DETECTED,
+ THEN W AND W1 ARE ASSIGNED THE VALUE 0 AND IERR IS SET TO
+ ONE OF THE FOLLOWING VALUES ...
+
+ IERR = 1 IF A OR B IS NEGATIVE
+ IERR = 2 IF A = B = 0
+ IERR = 3 IF X .LT. 0 OR X .GT. 1
+ IERR = 4 IF Y .LT. 0 OR Y .GT. 1
+ IERR = 5 IF X + Y .NE. 1
+ IERR = 6 IF X = A = 0
+ IERR = 7 IF Y = B = 0
+
+--------------------
+ WRITTEN BY ALFRED H. MORRIS, JR.
+ NAVAL SURFACE WARFARE CENTER
+ DAHLGREN, VIRGINIA
+ REVISED ... NOV 1991
+-----------------------------------------------------------------------
+*/
+{
+static int K1 = 1;
+static double a0,b0,eps,lambda,t,x0,y0,z;
+static int ierr1,ind,n;
+static double T2,T3,T4,T5;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ ****** EPS IS A MACHINE DEPENDENT CONSTANT. EPS IS THE SMALLEST
+ FLOATING POINT NUMBER FOR WHICH 1.0 + EPS .GT. 1.0
+*/
+ eps = spmpar(&K1);
+ *w = *w1 = 0.0e0;
+ if(*a < 0.0e0 || *b < 0.0e0) goto S270;
+ if(*a == 0.0e0 && *b == 0.0e0) goto S280;
+ if(*x < 0.0e0 || *x > 1.0e0) goto S290;
+ if(*y < 0.0e0 || *y > 1.0e0) goto S300;
+ z = *x+*y-0.5e0-0.5e0;
+ if(fabs(z) > 3.0e0*eps) goto S310;
+ *ierr = 0;
+ if(*x == 0.0e0) goto S210;
+ if(*y == 0.0e0) goto S230;
+ if(*a == 0.0e0) goto S240;
+ if(*b == 0.0e0) goto S220;
+ eps = fifdmax1(eps,1.e-15);
+ if(fifdmax1(*a,*b) < 1.e-3*eps) goto S260;
+ ind = 0;
+ a0 = *a;
+ b0 = *b;
+ x0 = *x;
+ y0 = *y;
+ if(fifdmin1(a0,b0) > 1.0e0) goto S40;
+/*
+ PROCEDURE FOR A0 .LE. 1 OR B0 .LE. 1
+*/
+ if(*x <= 0.5e0) goto S10;
+ ind = 1;
+ a0 = *b;
+ b0 = *a;
+ x0 = *y;
+ y0 = *x;
+S10:
+ if(b0 < fifdmin1(eps,eps*a0)) goto S90;
+ if(a0 < fifdmin1(eps,eps*b0) && b0*x0 <= 1.0e0) goto S100;
+ if(fifdmax1(a0,b0) > 1.0e0) goto S20;
+ if(a0 >= fifdmin1(0.2e0,b0)) goto S110;
+ if(pow(x0,a0) <= 0.9e0) goto S110;
+ if(x0 >= 0.3e0) goto S120;
+ n = 20;
+ goto S140;
+S20:
+ if(b0 <= 1.0e0) goto S110;
+ if(x0 >= 0.3e0) goto S120;
+ if(x0 >= 0.1e0) goto S30;
+ if(pow(x0*b0,a0) <= 0.7e0) goto S110;
+S30:
+ if(b0 > 15.0e0) goto S150;
+ n = 20;
+ goto S140;
+S40:
+/*
+ PROCEDURE FOR A0 .GT. 1 AND B0 .GT. 1
+*/
+ if(*a > *b) goto S50;
+ lambda = *a-(*a+*b)**x;
+ goto S60;
+S50:
+ lambda = (*a+*b)**y-*b;
+S60:
+ if(lambda >= 0.0e0) goto S70;
+ ind = 1;
+ a0 = *b;
+ b0 = *a;
+ x0 = *y;
+ y0 = *x;
+ lambda = fabs(lambda);
+S70:
+ if(b0 < 40.0e0 && b0*x0 <= 0.7e0) goto S110;
+ if(b0 < 40.0e0) goto S160;
+ if(a0 > b0) goto S80;
+ if(a0 <= 100.0e0) goto S130;
+ if(lambda > 0.03e0*a0) goto S130;
+ goto S200;
+S80:
+ if(b0 <= 100.0e0) goto S130;
+ if(lambda > 0.03e0*b0) goto S130;
+ goto S200;
+S90:
+/*
+ EVALUATION OF THE APPROPRIATE ALGORITHM
+*/
+ *w = fpser(&a0,&b0,&x0,&eps);
+ *w1 = 0.5e0+(0.5e0-*w);
+ goto S250;
+S100:
+ *w1 = apser(&a0,&b0,&x0,&eps);
+ *w = 0.5e0+(0.5e0-*w1);
+ goto S250;
+S110:
+ *w = bpser(&a0,&b0,&x0,&eps);
+ *w1 = 0.5e0+(0.5e0-*w);
+ goto S250;
+S120:
+ *w1 = bpser(&b0,&a0,&y0,&eps);
+ *w = 0.5e0+(0.5e0-*w1);
+ goto S250;
+S130:
+ T2 = 15.0e0*eps;
+ *w = bfrac(&a0,&b0,&x0,&y0,&lambda,&T2);
+ *w1 = 0.5e0+(0.5e0-*w);
+ goto S250;
+S140:
+ *w1 = bup(&b0,&a0,&y0,&x0,&n,&eps);
+ b0 += (double)n;
+S150:
+ T3 = 15.0e0*eps;
+ bgrat(&b0,&a0,&y0,&x0,w1,&T3,&ierr1);
+ *w = 0.5e0+(0.5e0-*w1);
+ goto S250;
+S160:
+ n = (long)(b0);
+ b0 -= (double)n;
+ if(b0 != 0.0e0) goto S170;
+ n -= 1;
+ b0 = 1.0e0;
+S170:
+ *w = bup(&b0,&a0,&y0,&x0,&n,&eps);
+ if(x0 > 0.7e0) goto S180;
+ *w += bpser(&a0,&b0,&x0,&eps);
+ *w1 = 0.5e0+(0.5e0-*w);
+ goto S250;
+S180:
+ if(a0 > 15.0e0) goto S190;
+ n = 20;
+ *w += bup(&a0,&b0,&x0,&y0,&n,&eps);
+ a0 += (double)n;
+S190:
+ T4 = 15.0e0*eps;
+ bgrat(&a0,&b0,&x0,&y0,w,&T4,&ierr1);
+ *w1 = 0.5e0+(0.5e0-*w);
+ goto S250;
+S200:
+ T5 = 100.0e0*eps;
+ *w = basym(&a0,&b0,&lambda,&T5);
+ *w1 = 0.5e0+(0.5e0-*w);
+ goto S250;
+S210:
+/*
+ TERMINATION OF THE PROCEDURE
+*/
+ if(*a == 0.0e0) goto S320;
+S220:
+ *w = 0.0e0;
+ *w1 = 1.0e0;
+ return;
+S230:
+ if(*b == 0.0e0) goto S330;
+S240:
+ *w = 1.0e0;
+ *w1 = 0.0e0;
+ return;
+S250:
+ if(ind == 0) return;
+ t = *w;
+ *w = *w1;
+ *w1 = t;
+ return;
+S260:
+/*
+ PROCEDURE FOR A AND B .LT. 1.E-3*EPS
+*/
+ *w = *b/(*a+*b);
+ *w1 = *a/(*a+*b);
+ return;
+S270:
+/*
+ ERROR RETURN
+*/
+ *ierr = 1;
+ return;
+S280:
+ *ierr = 2;
+ return;
+S290:
+ *ierr = 3;
+ return;
+S300:
+ *ierr = 4;
+ return;
+S310:
+ *ierr = 5;
+ return;
+S320:
+ *ierr = 6;
+ return;
+S330:
+ *ierr = 7;
+ return;
+}
+double brcmp1(int *mu,double *a,double *b,double *x,double *y)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF EXP(MU) * (X**A*Y**B/BETA(A,B))
+-----------------------------------------------------------------------
+*/
+{
+static double Const = .398942280401433e0;
+static double brcmp1,a0,apb,b0,c,e,h,lambda,lnx,lny,t,u,v,x0,y0,z;
+static int i,n;
+/*
+-----------------
+ CONST = 1/SQRT(2*PI)
+-----------------
+*/
+static double T1,T2,T3,T4;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ a0 = fifdmin1(*a,*b);
+ if(a0 >= 8.0e0) goto S130;
+ if(*x > 0.375e0) goto S10;
+ lnx = log(*x);
+ T1 = -*x;
+ lny = alnrel(&T1);
+ goto S30;
+S10:
+ if(*y > 0.375e0) goto S20;
+ T2 = -*y;
+ lnx = alnrel(&T2);
+ lny = log(*y);
+ goto S30;
+S20:
+ lnx = log(*x);
+ lny = log(*y);
+S30:
+ z = *a*lnx+*b*lny;
+ if(a0 < 1.0e0) goto S40;
+ z -= betaln(a,b);
+ brcmp1 = esum(mu,&z);
+ return brcmp1;
+S40:
+/*
+-----------------------------------------------------------------------
+ PROCEDURE FOR A .LT. 1 OR B .LT. 1
+-----------------------------------------------------------------------
+*/
+ b0 = fifdmax1(*a,*b);
+ if(b0 >= 8.0e0) goto S120;
+ if(b0 > 1.0e0) goto S70;
+/*
+ ALGORITHM FOR B0 .LE. 1
+*/
+ brcmp1 = esum(mu,&z);
+ if(brcmp1 == 0.0e0) return brcmp1;
+ apb = *a+*b;
+ if(apb > 1.0e0) goto S50;
+ z = 1.0e0+gam1(&apb);
+ goto S60;
+S50:
+ u = *a+*b-1.e0;
+ z = (1.0e0+gam1(&u))/apb;
+S60:
+ c = (1.0e0+gam1(a))*(1.0e0+gam1(b))/z;
+ brcmp1 = brcmp1*(a0*c)/(1.0e0+a0/b0);
+ return brcmp1;
+S70:
+/*
+ ALGORITHM FOR 1 .LT. B0 .LT. 8
+*/
+ u = gamln1(&a0);
+ n = (long)(b0 - 1.0e0);
+ if(n < 1) goto S90;
+ c = 1.0e0;
+ for(i=1; i<=n; i++) {
+ b0 -= 1.0e0;
+ c *= (b0/(a0+b0));
+ }
+ u = log(c)+u;
+S90:
+ z -= u;
+ b0 -= 1.0e0;
+ apb = a0+b0;
+ if(apb > 1.0e0) goto S100;
+ t = 1.0e0+gam1(&apb);
+ goto S110;
+S100:
+ u = a0+b0-1.e0;
+ t = (1.0e0+gam1(&u))/apb;
+S110:
+ brcmp1 = a0*esum(mu,&z)*(1.0e0+gam1(&b0))/t;
+ return brcmp1;
+S120:
+/*
+ ALGORITHM FOR B0 .GE. 8
+*/
+ u = gamln1(&a0)+algdiv(&a0,&b0);
+ T3 = z-u;
+ brcmp1 = a0*esum(mu,&T3);
+ return brcmp1;
+S130:
+/*
+-----------------------------------------------------------------------
+ PROCEDURE FOR A .GE. 8 AND B .GE. 8
+-----------------------------------------------------------------------
+*/
+ if(*a > *b) goto S140;
+ h = *a/ *b;
+ x0 = h/(1.0e0+h);
+ y0 = 1.0e0/(1.0e0+h);
+ lambda = *a-(*a+*b)**x;
+ goto S150;
+S140:
+ h = *b/ *a;
+ x0 = 1.0e0/(1.0e0+h);
+ y0 = h/(1.0e0+h);
+ lambda = (*a+*b)**y-*b;
+S150:
+ e = -(lambda/ *a);
+ if(fabs(e) > 0.6e0) goto S160;
+ u = rlog1(&e);
+ goto S170;
+S160:
+ u = e-log(*x/x0);
+S170:
+ e = lambda/ *b;
+ if(fabs(e) > 0.6e0) goto S180;
+ v = rlog1(&e);
+ goto S190;
+S180:
+ v = e-log(*y/y0);
+S190:
+ T4 = -(*a*u+*b*v);
+ z = esum(mu,&T4);
+ brcmp1 = Const*sqrt(*b*x0)*z*exp(-bcorr(a,b));
+ return brcmp1;
+}
+double brcomp(double *a,double *b,double *x,double *y)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF X**A*Y**B/BETA(A,B)
+-----------------------------------------------------------------------
+*/
+{
+static double Const = .398942280401433e0;
+static double brcomp,a0,apb,b0,c,e,h,lambda,lnx,lny,t,u,v,x0,y0,z;
+static int i,n;
+/*
+-----------------
+ CONST = 1/SQRT(2*PI)
+-----------------
+*/
+static double T1,T2;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ brcomp = 0.0e0;
+ if(*x == 0.0e0 || *y == 0.0e0) return brcomp;
+ a0 = fifdmin1(*a,*b);
+ if(a0 >= 8.0e0) goto S130;
+ if(*x > 0.375e0) goto S10;
+ lnx = log(*x);
+ T1 = -*x;
+ lny = alnrel(&T1);
+ goto S30;
+S10:
+ if(*y > 0.375e0) goto S20;
+ T2 = -*y;
+ lnx = alnrel(&T2);
+ lny = log(*y);
+ goto S30;
+S20:
+ lnx = log(*x);
+ lny = log(*y);
+S30:
+ z = *a*lnx+*b*lny;
+ if(a0 < 1.0e0) goto S40;
+ z -= betaln(a,b);
+ brcomp = exp(z);
+ return brcomp;
+S40:
+/*
+-----------------------------------------------------------------------
+ PROCEDURE FOR A .LT. 1 OR B .LT. 1
+-----------------------------------------------------------------------
+*/
+ b0 = fifdmax1(*a,*b);
+ if(b0 >= 8.0e0) goto S120;
+ if(b0 > 1.0e0) goto S70;
+/*
+ ALGORITHM FOR B0 .LE. 1
+*/
+ brcomp = exp(z);
+ if(brcomp == 0.0e0) return brcomp;
+ apb = *a+*b;
+ if(apb > 1.0e0) goto S50;
+ z = 1.0e0+gam1(&apb);
+ goto S60;
+S50:
+ u = *a+*b-1.e0;
+ z = (1.0e0+gam1(&u))/apb;
+S60:
+ c = (1.0e0+gam1(a))*(1.0e0+gam1(b))/z;
+ brcomp = brcomp*(a0*c)/(1.0e0+a0/b0);
+ return brcomp;
+S70:
+/*
+ ALGORITHM FOR 1 .LT. B0 .LT. 8
+*/
+ u = gamln1(&a0);
+ n = (long)(b0 - 1.0e0);
+ if(n < 1) goto S90;
+ c = 1.0e0;
+ for(i=1; i<=n; i++) {
+ b0 -= 1.0e0;
+ c *= (b0/(a0+b0));
+ }
+ u = log(c)+u;
+S90:
+ z -= u;
+ b0 -= 1.0e0;
+ apb = a0+b0;
+ if(apb > 1.0e0) goto S100;
+ t = 1.0e0+gam1(&apb);
+ goto S110;
+S100:
+ u = a0+b0-1.e0;
+ t = (1.0e0+gam1(&u))/apb;
+S110:
+ brcomp = a0*exp(z)*(1.0e0+gam1(&b0))/t;
+ return brcomp;
+S120:
+/*
+ ALGORITHM FOR B0 .GE. 8
+*/
+ u = gamln1(&a0)+algdiv(&a0,&b0);
+ brcomp = a0*exp(z-u);
+ return brcomp;
+S130:
+/*
+-----------------------------------------------------------------------
+ PROCEDURE FOR A .GE. 8 AND B .GE. 8
+-----------------------------------------------------------------------
+*/
+ if(*a > *b) goto S140;
+ h = *a/ *b;
+ x0 = h/(1.0e0+h);
+ y0 = 1.0e0/(1.0e0+h);
+ lambda = *a-(*a+*b)**x;
+ goto S150;
+S140:
+ h = *b/ *a;
+ x0 = 1.0e0/(1.0e0+h);
+ y0 = h/(1.0e0+h);
+ lambda = (*a+*b)**y-*b;
+S150:
+ e = -(lambda/ *a);
+ if(fabs(e) > 0.6e0) goto S160;
+ u = rlog1(&e);
+ goto S170;
+S160:
+ u = e-log(*x/x0);
+S170:
+ e = lambda/ *b;
+ if(fabs(e) > 0.6e0) goto S180;
+ v = rlog1(&e);
+ goto S190;
+S180:
+ v = e-log(*y/y0);
+S190:
+ z = exp(-(*a*u+*b*v));
+ brcomp = Const*sqrt(*b*x0)*z*exp(-bcorr(a,b));
+ return brcomp;
+}
+double bup(double *a,double *b,double *x,double *y,int *n,double *eps)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF IX(A,B) - IX(A+N,B) WHERE N IS A POSITIVE INTEGER.
+ EPS IS THE TOLERANCE USED.
+-----------------------------------------------------------------------
+*/
+{
+static int K1 = 1;
+static int K2 = 0;
+static double bup,ap1,apb,d,l,r,t,w;
+static int i,k,kp1,mu,nm1;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ OBTAIN THE SCALING FACTOR EXP(-MU) AND
+ EXP(MU)*(X**A*Y**B/BETA(A,B))/A
+*/
+ apb = *a+*b;
+ ap1 = *a+1.0e0;
+ mu = 0;
+ d = 1.0e0;
+ if(*n == 1 || *a < 1.0e0) goto S10;
+ if(apb < 1.1e0*ap1) goto S10;
+ mu = (long)(fabs(exparg(&K1)));
+ k = (long)(exparg(&K2));
+ if(k < mu) mu = k;
+ t = mu;
+ d = exp(-t);
+S10:
+ bup = brcmp1(&mu,a,b,x,y)/ *a;
+ if(*n == 1 || bup == 0.0e0) return bup;
+ nm1 = *n-1;
+ w = d;
+/*
+ LET K BE THE INDEX OF THE MAXIMUM TERM
+*/
+ k = 0;
+ if(*b <= 1.0e0) goto S50;
+ if(*y > 1.e-4) goto S20;
+ k = nm1;
+ goto S30;
+S20:
+ r = (*b-1.0e0)**x/ *y-*a;
+ if(r < 1.0e0) goto S50;
+ t = nm1;
+ k = (long)(t);
+ if(r < t) k = (long)(r);
+S30:
+/*
+ ADD THE INCREASING TERMS OF THE SERIES
+*/
+ for(i=1; i<=k; i++) {
+ l = i-1;
+ d = (apb+l)/(ap1+l)**x*d;
+ w += d;
+ }
+ if(k == nm1) goto S70;
+S50:
+/*
+ ADD THE REMAINING TERMS OF THE SERIES
+*/
+ kp1 = k+1;
+ for(i=kp1; i<=nm1; i++) {
+ l = i-1;
+ d = (apb+l)/(ap1+l)**x*d;
+ w += d;
+ if(d <= *eps*w) goto S70;
+ }
+S70:
+/*
+ TERMINATE THE PROCEDURE
+*/
+ bup *= w;
+ return bup;
+}
+void cdfbet(int *which,double *p,double *q,double *x,double *y,
+ double *a,double *b,int *status,double *bound)
+/**********************************************************************
+
+ void cdfbet(int *which,double *p,double *q,double *x,double *y,
+ double *a,double *b,int *status,double *bound)
+
+ Cumulative Distribution Function
+ BETa Distribution
+
+
+ Function
+
+
+ Calculates any one parameter of the beta distribution given
+ values for the others.
+
+
+ Arguments
+
+
+ WHICH --> Integer indicating which of the next four argument
+ values is to be calculated from the others.
+ Legal range: 1..4
+ iwhich = 1 : Calculate P and Q from X,Y,A and B
+ iwhich = 2 : Calculate X and Y from P,Q,A and B
+ iwhich = 3 : Calculate A from P,Q,X,Y and B
+ iwhich = 4 : Calculate B from P,Q,X,Y and A
+
+ P <--> The integral from 0 to X of the chi-square
+ distribution.
+ Input range: [0, 1].
+
+ Q <--> 1-P.
+ Input range: [0, 1].
+ P + Q = 1.0.
+
+ X <--> Upper limit of integration of beta density.
+ Input range: [0,1].
+ Search range: [0,1]
+
+ Y <--> 1-X.
+ Input range: [0,1].
+ Search range: [0,1]
+ X + Y = 1.0.
+
+ A <--> The first parameter of the beta density.
+ Input range: (0, +infinity).
+ Search range: [1D-100,1D100]
+
+ B <--> The second parameter of the beta density.
+ Input range: (0, +infinity).
+ Search range: [1D-100,1D100]
+
+ STATUS <-- 0 if calculation completed correctly
+ -I if input parameter number I is out of range
+ 1 if answer appears to be lower than lowest
+ search bound
+ 2 if answer appears to be higher than greatest
+ search bound
+ 3 if P + Q .ne. 1
+ 4 if X + Y .ne. 1
+
+ BOUND <-- Undefined if STATUS is 0
+
+ Bound exceeded by parameter number I if STATUS
+ is negative.
+
+ Lower search bound if STATUS is 1.
+
+ Upper search bound if STATUS is 2.
+
+
+ Method
+
+
+ Cumulative distribution function (P) is calculated directly by
+ code associated with the following reference.
+
+ DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant
+ Digit Computation of the Incomplete Beta Function Ratios. ACM
+ Trans. Math. Softw. 18 (1993), 360-373.
+
+ Computation of other parameters involve a seach for a value that
+ produces the desired value of P. The search relies on the
+ monotinicity of P with the other parameter.
+
+
+ Note
+
+
+ The beta density is proportional to
+ t^(A-1) * (1-t)^(B-1)
+
+**********************************************************************/
+{
+#define tol 1.0e-8
+#define atol 1.0e-50
+#define zero 1.0e-100
+#define inf 1.0e100
+#define one 1.0e0
+static int K1 = 1;
+static double K2 = 0.0e0;
+static double K3 = 1.0e0;
+static double K8 = 0.5e0;
+static double K9 = 5.0e0;
+static double fx,xhi,xlo,cum,ccum,xy,pq;
+static unsigned long qhi,qleft,qporq;
+static double T4,T5,T6,T7,T10,T11,T12,T13,T14,T15;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ Check arguments
+*/
+ if(!(*which < 1 || *which > 4)) goto S30;
+ if(!(*which < 1)) goto S10;
+ *bound = 1.0e0;
+ goto S20;
+S10:
+ *bound = 4.0e0;
+S20:
+ *status = -1;
+ return;
+S30:
+ if(*which == 1) goto S70;
+/*
+ P
+*/
+ if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
+ if(!(*p < 0.0e0)) goto S40;
+ *bound = 0.0e0;
+ goto S50;
+S40:
+ *bound = 1.0e0;
+S50:
+ *status = -2;
+ return;
+S70:
+S60:
+ if(*which == 1) goto S110;
+/*
+ Q
+*/
+ if(!(*q < 0.0e0 || *q > 1.0e0)) goto S100;
+ if(!(*q < 0.0e0)) goto S80;
+ *bound = 0.0e0;
+ goto S90;
+S80:
+ *bound = 1.0e0;
+S90:
+ *status = -3;
+ return;
+S110:
+S100:
+ if(*which == 2) goto S150;
+/*
+ X
+*/
+ if(!(*x < 0.0e0 || *x > 1.0e0)) goto S140;
+ if(!(*x < 0.0e0)) goto S120;
+ *bound = 0.0e0;
+ goto S130;
+S120:
+ *bound = 1.0e0;
+S130:
+ *status = -4;
+ return;
+S150:
+S140:
+ if(*which == 2) goto S190;
+/*
+ Y
+*/
+ if(!(*y < 0.0e0 || *y > 1.0e0)) goto S180;
+ if(!(*y < 0.0e0)) goto S160;
+ *bound = 0.0e0;
+ goto S170;
+S160:
+ *bound = 1.0e0;
+S170:
+ *status = -5;
+ return;
+S190:
+S180:
+ if(*which == 3) goto S210;
+/*
+ A
+*/
+ if(!(*a <= 0.0e0)) goto S200;
+ *bound = 0.0e0;
+ *status = -6;
+ return;
+S210:
+S200:
+ if(*which == 4) goto S230;
+/*
+ B
+*/
+ if(!(*b <= 0.0e0)) goto S220;
+ *bound = 0.0e0;
+ *status = -7;
+ return;
+S230:
+S220:
+ if(*which == 1) goto S270;
+/*
+ P + Q
+*/
+ pq = *p+*q;
+ if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S260;
+ if(!(pq < 0.0e0)) goto S240;
+ *bound = 0.0e0;
+ goto S250;
+S240:
+ *bound = 1.0e0;
+S250:
+ *status = 3;
+ return;
+S270:
+S260:
+ if(*which == 2) goto S310;
+/*
+ X + Y
+*/
+ xy = *x+*y;
+ if(!(fabs(xy-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S300;
+ if(!(xy < 0.0e0)) goto S280;
+ *bound = 0.0e0;
+ goto S290;
+S280:
+ *bound = 1.0e0;
+S290:
+ *status = 4;
+ return;
+S310:
+S300:
+ if(!(*which == 1)) qporq = *p <= *q;
+/*
+ Select the minimum of P or Q
+ Calculate ANSWERS
+*/
+ if(1 == *which) {
+/*
+ Calculating P and Q
+*/
+ cumbet(x,y,a,b,p,q);
+ *status = 0;
+ }
+ else if(2 == *which) {
+/*
+ Calculating X and Y
+*/
+ T4 = atol;
+ T5 = tol;
+ dstzr(&K2,&K3,&T4,&T5);
+ if(!qporq) goto S340;
+ *status = 0;
+ dzror(status,x,&fx,&xlo,&xhi,&qleft,&qhi);
+ *y = one-*x;
+S320:
+ if(!(*status == 1)) goto S330;
+ cumbet(x,y,a,b,&cum,&ccum);
+ fx = cum-*p;
+ dzror(status,x,&fx,&xlo,&xhi,&qleft,&qhi);
+ *y = one-*x;
+ goto S320;
+S330:
+ goto S370;
+S340:
+ *status = 0;
+ dzror(status,y,&fx,&xlo,&xhi,&qleft,&qhi);
+ *x = one-*y;
+S350:
+ if(!(*status == 1)) goto S360;
+ cumbet(x,y,a,b,&cum,&ccum);
+ fx = ccum-*q;
+ dzror(status,y,&fx,&xlo,&xhi,&qleft,&qhi);
+ *x = one-*y;
+ goto S350;
+S370:
+S360:
+ if(!(*status == -1)) goto S400;
+ if(!qleft) goto S380;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S390;
+S380:
+ *status = 2;
+ *bound = 1.0e0;
+S400:
+S390:
+ ;
+ }
+ else if(3 == *which) {
+/*
+ Computing A
+*/
+ *a = 5.0e0;
+ T6 = zero;
+ T7 = inf;
+ T10 = atol;
+ T11 = tol;
+ dstinv(&T6,&T7,&K8,&K8,&K9,&T10,&T11);
+ *status = 0;
+ dinvr(status,a,&fx,&qleft,&qhi);
+S410:
+ if(!(*status == 1)) goto S440;
+ cumbet(x,y,a,b,&cum,&ccum);
+ if(!qporq) goto S420;
+ fx = cum-*p;
+ goto S430;
+S420:
+ fx = ccum-*q;
+S430:
+ dinvr(status,a,&fx,&qleft,&qhi);
+ goto S410;
+S440:
+ if(!(*status == -1)) goto S470;
+ if(!qleft) goto S450;
+ *status = 1;
+ *bound = zero;
+ goto S460;
+S450:
+ *status = 2;
+ *bound = inf;
+S470:
+S460:
+ ;
+ }
+ else if(4 == *which) {
+/*
+ Computing B
+*/
+ *b = 5.0e0;
+ T12 = zero;
+ T13 = inf;
+ T14 = atol;
+ T15 = tol;
+ dstinv(&T12,&T13,&K8,&K8,&K9,&T14,&T15);
+ *status = 0;
+ dinvr(status,b,&fx,&qleft,&qhi);
+S480:
+ if(!(*status == 1)) goto S510;
+ cumbet(x,y,a,b,&cum,&ccum);
+ if(!qporq) goto S490;
+ fx = cum-*p;
+ goto S500;
+S490:
+ fx = ccum-*q;
+S500:
+ dinvr(status,b,&fx,&qleft,&qhi);
+ goto S480;
+S510:
+ if(!(*status == -1)) goto S540;
+ if(!qleft) goto S520;
+ *status = 1;
+ *bound = zero;
+ goto S530;
+S520:
+ *status = 2;
+ *bound = inf;
+S530:
+ ;
+ }
+S540:
+ return;
+#undef tol
+#undef atol
+#undef zero
+#undef inf
+#undef one
+}
+void cdfbin(int *which,double *p,double *q,double *s,double *xn,
+ double *pr,double *ompr,int *status,double *bound)
+/**********************************************************************
+
+ void cdfbin(int *which,double *p,double *q,double *s,double *xn,
+ double *pr,double *ompr,int *status,double *bound)
+
+ Cumulative Distribution Function
+ BINomial distribution
+
+
+ Function
+
+
+ Calculates any one parameter of the binomial
+ distribution given values for the others.
+
+
+ Arguments
+
+
+ WHICH --> Integer indicating which of the next four argument
+ values is to be calculated from the others.
+ Legal range: 1..4
+ iwhich = 1 : Calculate P and Q from S,XN,PR and OMPR
+ iwhich = 2 : Calculate S from P,Q,XN,PR and OMPR
+ iwhich = 3 : Calculate XN from P,Q,S,PR and OMPR
+ iwhich = 4 : Calculate PR and OMPR from P,Q,S and XN
+
+ P <--> The cumulation from 0 to S of the binomial distribution.
+ (Probablility of S or fewer successes in XN trials each
+ with probability of success PR.)
+ Input range: [0,1].
+
+ Q <--> 1-P.
+ Input range: [0, 1].
+ P + Q = 1.0.
+
+ S <--> The number of successes observed.
+ Input range: [0, XN]
+ Search range: [0, XN]
+
+ XN <--> The number of binomial trials.
+ Input range: (0, +infinity).
+ Search range: [1E-100, 1E100]
+
+ PR <--> The probability of success in each binomial trial.
+ Input range: [0,1].
+ Search range: [0,1]
+
+ OMPR <--> 1-PR
+ Input range: [0,1].
+ Search range: [0,1]
+ PR + OMPR = 1.0
+
+ STATUS <-- 0 if calculation completed correctly
+ -I if input parameter number I is out of range
+ 1 if answer appears to be lower than lowest
+ search bound
+ 2 if answer appears to be higher than greatest
+ search bound
+ 3 if P + Q .ne. 1
+ 4 if PR + OMPR .ne. 1
+
+ BOUND <-- Undefined if STATUS is 0
+
+ Bound exceeded by parameter number I if STATUS
+ is negative.
+
+ Lower search bound if STATUS is 1.
+
+ Upper search bound if STATUS is 2.
+
+
+ Method
+
+
+ Formula 26.5.24 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions (1966) is used to reduce the binomial
+ distribution to the cumulative incomplete beta distribution.
+
+ Computation of other parameters involve a seach for a value that
+ produces the desired value of P. The search relies on the
+ monotinicity of P with the other parameter.
+
+
+**********************************************************************/
+{
+#define atol 1.0e-50
+#define tol 1.0e-8
+#define zero 1.0e-100
+#define inf 1.0e100
+#define one 1.0e0
+static int K1 = 1;
+static double K2 = 0.0e0;
+static double K3 = 0.5e0;
+static double K4 = 5.0e0;
+static double K11 = 1.0e0;
+static double fx,xhi,xlo,cum,ccum,pq,prompr;
+static unsigned long qhi,qleft,qporq;
+static double T5,T6,T7,T8,T9,T10,T12,T13;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ Check arguments
+*/
+ if(!(*which < 1 && *which > 4)) goto S30;
+ if(!(*which < 1)) goto S10;
+ *bound = 1.0e0;
+ goto S20;
+S10:
+ *bound = 4.0e0;
+S20:
+ *status = -1;
+ return;
+S30:
+ if(*which == 1) goto S70;
+/*
+ P
+*/
+ if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
+ if(!(*p < 0.0e0)) goto S40;
+ *bound = 0.0e0;
+ goto S50;
+S40:
+ *bound = 1.0e0;
+S50:
+ *status = -2;
+ return;
+S70:
+S60:
+ if(*which == 1) goto S110;
+/*
+ Q
+*/
+ if(!(*q < 0.0e0 || *q > 1.0e0)) goto S100;
+ if(!(*q < 0.0e0)) goto S80;
+ *bound = 0.0e0;
+ goto S90;
+S80:
+ *bound = 1.0e0;
+S90:
+ *status = -3;
+ return;
+S110:
+S100:
+ if(*which == 3) goto S130;
+/*
+ XN
+*/
+ if(!(*xn <= 0.0e0)) goto S120;
+ *bound = 0.0e0;
+ *status = -5;
+ return;
+S130:
+S120:
+ if(*which == 2) goto S170;
+/*
+ S
+*/
+ if(!(*s < 0.0e0 || (*which != 3 && *s > *xn))) goto S160;
+ if(!(*s < 0.0e0)) goto S140;
+ *bound = 0.0e0;
+ goto S150;
+S140:
+ *bound = *xn;
+S150:
+ *status = -4;
+ return;
+S170:
+S160:
+ if(*which == 4) goto S210;
+/*
+ PR
+*/
+ if(!(*pr < 0.0e0 || *pr > 1.0e0)) goto S200;
+ if(!(*pr < 0.0e0)) goto S180;
+ *bound = 0.0e0;
+ goto S190;
+S180:
+ *bound = 1.0e0;
+S190:
+ *status = -6;
+ return;
+S210:
+S200:
+ if(*which == 4) goto S250;
+/*
+ OMPR
+*/
+ if(!(*ompr < 0.0e0 || *ompr > 1.0e0)) goto S240;
+ if(!(*ompr < 0.0e0)) goto S220;
+ *bound = 0.0e0;
+ goto S230;
+S220:
+ *bound = 1.0e0;
+S230:
+ *status = -7;
+ return;
+S250:
+S240:
+ if(*which == 1) goto S290;
+/*
+ P + Q
+*/
+ pq = *p+*q;
+ if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S280;
+ if(!(pq < 0.0e0)) goto S260;
+ *bound = 0.0e0;
+ goto S270;
+S260:
+ *bound = 1.0e0;
+S270:
+ *status = 3;
+ return;
+S290:
+S280:
+ if(*which == 4) goto S330;
+/*
+ PR + OMPR
+*/
+ prompr = *pr+*ompr;
+ if(!(fabs(prompr-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S320;
+ if(!(prompr < 0.0e0)) goto S300;
+ *bound = 0.0e0;
+ goto S310;
+S300:
+ *bound = 1.0e0;
+S310:
+ *status = 4;
+ return;
+S330:
+S320:
+ if(!(*which == 1)) qporq = *p <= *q;
+/*
+ Select the minimum of P or Q
+ Calculate ANSWERS
+*/
+ if(1 == *which) {
+/*
+ Calculating P
+*/
+ cumbin(s,xn,pr,ompr,p,q);
+ *status = 0;
+ }
+ else if(2 == *which) {
+/*
+ Calculating S
+*/
+ *s = 5.0e0;
+ T5 = atol;
+ T6 = tol;
+ dstinv(&K2,xn,&K3,&K3,&K4,&T5,&T6);
+ *status = 0;
+ dinvr(status,s,&fx,&qleft,&qhi);
+S340:
+ if(!(*status == 1)) goto S370;
+ cumbin(s,xn,pr,ompr,&cum,&ccum);
+ if(!qporq) goto S350;
+ fx = cum-*p;
+ goto S360;
+S350:
+ fx = ccum-*q;
+S360:
+ dinvr(status,s,&fx,&qleft,&qhi);
+ goto S340;
+S370:
+ if(!(*status == -1)) goto S400;
+ if(!qleft) goto S380;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S390;
+S380:
+ *status = 2;
+ *bound = *xn;
+S400:
+S390:
+ ;
+ }
+ else if(3 == *which) {
+/*
+ Calculating XN
+*/
+ *xn = 5.0e0;
+ T7 = zero;
+ T8 = inf;
+ T9 = atol;
+ T10 = tol;
+ dstinv(&T7,&T8,&K3,&K3,&K4,&T9,&T10);
+ *status = 0;
+ dinvr(status,xn,&fx,&qleft,&qhi);
+S410:
+ if(!(*status == 1)) goto S440;
+ cumbin(s,xn,pr,ompr,&cum,&ccum);
+ if(!qporq) goto S420;
+ fx = cum-*p;
+ goto S430;
+S420:
+ fx = ccum-*q;
+S430:
+ dinvr(status,xn,&fx,&qleft,&qhi);
+ goto S410;
+S440:
+ if(!(*status == -1)) goto S470;
+ if(!qleft) goto S450;
+ *status = 1;
+ *bound = zero;
+ goto S460;
+S450:
+ *status = 2;
+ *bound = inf;
+S470:
+S460:
+ ;
+ }
+ else if(4 == *which) {
+/*
+ Calculating PR and OMPR
+*/
+ T12 = atol;
+ T13 = tol;
+ dstzr(&K2,&K11,&T12,&T13);
+ if(!qporq) goto S500;
+ *status = 0;
+ dzror(status,pr,&fx,&xlo,&xhi,&qleft,&qhi);
+ *ompr = one-*pr;
+S480:
+ if(!(*status == 1)) goto S490;
+ cumbin(s,xn,pr,ompr,&cum,&ccum);
+ fx = cum-*p;
+ dzror(status,pr,&fx,&xlo,&xhi,&qleft,&qhi);
+ *ompr = one-*pr;
+ goto S480;
+S490:
+ goto S530;
+S500:
+ *status = 0;
+ dzror(status,ompr,&fx,&xlo,&xhi,&qleft,&qhi);
+ *pr = one-*ompr;
+S510:
+ if(!(*status == 1)) goto S520;
+ cumbin(s,xn,pr,ompr,&cum,&ccum);
+ fx = ccum-*q;
+ dzror(status,ompr,&fx,&xlo,&xhi,&qleft,&qhi);
+ *pr = one-*ompr;
+ goto S510;
+S530:
+S520:
+ if(!(*status == -1)) goto S560;
+ if(!qleft) goto S540;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S550;
+S540:
+ *status = 2;
+ *bound = 1.0e0;
+S550:
+ ;
+ }
+S560:
+ return;
+#undef atol
+#undef tol
+#undef zero
+#undef inf
+#undef one
+}
+void cdfchi(int *which,double *p,double *q,double *x,double *df,
+ int *status,double *bound)
+/**********************************************************************
+
+ void cdfchi(int *which,double *p,double *q,double *x,double *df,
+ int *status,double *bound)
+
+ Cumulative Distribution Function
+ CHI-Square distribution
+
+
+ Function
+
+
+ Calculates any one parameter of the chi-square
+ distribution given values for the others.
+
+
+ Arguments
+
+
+ WHICH --> Integer indicating which of the next three argument
+ values is to be calculated from the others.
+ Legal range: 1..3
+ iwhich = 1 : Calculate P and Q from X and DF
+ iwhich = 2 : Calculate X from P,Q and DF
+ iwhich = 3 : Calculate DF from P,Q and X
+
+ P <--> The integral from 0 to X of the chi-square
+ distribution.
+ Input range: [0, 1].
+
+ Q <--> 1-P.
+ Input range: (0, 1].
+ P + Q = 1.0.
+
+ X <--> Upper limit of integration of the non-central
+ chi-square distribution.
+ Input range: [0, +infinity).
+ Search range: [0,1E100]
+
+ DF <--> Degrees of freedom of the
+ chi-square distribution.
+ Input range: (0, +infinity).
+ Search range: [ 1E-100, 1E100]
+
+ STATUS <-- 0 if calculation completed correctly
+ -I if input parameter number I is out of range
+ 1 if answer appears to be lower than lowest
+ search bound
+ 2 if answer appears to be higher than greatest
+ search bound
+ 3 if P + Q .ne. 1
+ 10 indicates error returned from cumgam. See
+ references in cdfgam
+
+ BOUND <-- Undefined if STATUS is 0
+
+ Bound exceeded by parameter number I if STATUS
+ is negative.
+
+ Lower search bound if STATUS is 1.
+
+ Upper search bound if STATUS is 2.
+
+
+ Method
+
+
+ Formula 26.4.19 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions (1966) is used to reduce the chisqure
+ distribution to the incomplete distribution.
+
+ Computation of other parameters involve a seach for a value that
+ produces the desired value of P. The search relies on the
+ monotinicity of P with the other parameter.
+
+**********************************************************************/
+{
+#define tol 1.0e-8
+#define atol 1.0e-50
+#define zero 1.0e-100
+#define inf 1.0e100
+static int K1 = 1;
+static double K2 = 0.0e0;
+static double K4 = 0.5e0;
+static double K5 = 5.0e0;
+static double fx,cum,ccum,pq,porq;
+static unsigned long qhi,qleft,qporq;
+static double T3,T6,T7,T8,T9,T10,T11;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ Check arguments
+*/
+ if(!(*which < 1 || *which > 3)) goto S30;
+ if(!(*which < 1)) goto S10;
+ *bound = 1.0e0;
+ goto S20;
+S10:
+ *bound = 3.0e0;
+S20:
+ *status = -1;
+ return;
+S30:
+ if(*which == 1) goto S70;
+/*
+ P
+*/
+ if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
+ if(!(*p < 0.0e0)) goto S40;
+ *bound = 0.0e0;
+ goto S50;
+S40:
+ *bound = 1.0e0;
+S50:
+ *status = -2;
+ return;
+S70:
+S60:
+ if(*which == 1) goto S110;
+/*
+ Q
+*/
+ if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
+ if(!(*q <= 0.0e0)) goto S80;
+ *bound = 0.0e0;
+ goto S90;
+S80:
+ *bound = 1.0e0;
+S90:
+ *status = -3;
+ return;
+S110:
+S100:
+ if(*which == 2) goto S130;
+/*
+ X
+*/
+ if(!(*x < 0.0e0)) goto S120;
+ *bound = 0.0e0;
+ *status = -4;
+ return;
+S130:
+S120:
+ if(*which == 3) goto S150;
+/*
+ DF
+*/
+ if(!(*df <= 0.0e0)) goto S140;
+ *bound = 0.0e0;
+ *status = -5;
+ return;
+S150:
+S140:
+ if(*which == 1) goto S190;
+/*
+ P + Q
+*/
+ pq = *p+*q;
+ if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S180;
+ if(!(pq < 0.0e0)) goto S160;
+ *bound = 0.0e0;
+ goto S170;
+S160:
+ *bound = 1.0e0;
+S170:
+ *status = 3;
+ return;
+S190:
+S180:
+ if(*which == 1) goto S220;
+/*
+ Select the minimum of P or Q
+*/
+ qporq = *p <= *q;
+ if(!qporq) goto S200;
+ porq = *p;
+ goto S210;
+S200:
+ porq = *q;
+S220:
+S210:
+/*
+ Calculate ANSWERS
+*/
+ if(1 == *which) {
+/*
+ Calculating P and Q
+*/
+ *status = 0;
+ cumchi(x,df,p,q);
+ if(porq > 1.5e0) {
+ *status = 10;
+ return;
+ }
+ }
+ else if(2 == *which) {
+/*
+ Calculating X
+*/
+ *x = 5.0e0;
+ T3 = inf;
+ T6 = atol;
+ T7 = tol;
+ dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7);
+ *status = 0;
+ dinvr(status,x,&fx,&qleft,&qhi);
+S230:
+ if(!(*status == 1)) goto S270;
+ cumchi(x,df,&cum,&ccum);
+ if(!qporq) goto S240;
+ fx = cum-*p;
+ goto S250;
+S240:
+ fx = ccum-*q;
+S250:
+ if(!(fx+porq > 1.5e0)) goto S260;
+ *status = 10;
+ return;
+S260:
+ dinvr(status,x,&fx,&qleft,&qhi);
+ goto S230;
+S270:
+ if(!(*status == -1)) goto S300;
+ if(!qleft) goto S280;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S290;
+S280:
+ *status = 2;
+ *bound = inf;
+S300:
+S290:
+ ;
+ }
+ else if(3 == *which) {
+/*
+ Calculating DF
+*/
+ *df = 5.0e0;
+ T8 = zero;
+ T9 = inf;
+ T10 = atol;
+ T11 = tol;
+ dstinv(&T8,&T9,&K4,&K4,&K5,&T10,&T11);
+ *status = 0;
+ dinvr(status,df,&fx,&qleft,&qhi);
+S310:
+ if(!(*status == 1)) goto S350;
+ cumchi(x,df,&cum,&ccum);
+ if(!qporq) goto S320;
+ fx = cum-*p;
+ goto S330;
+S320:
+ fx = ccum-*q;
+S330:
+ if(!(fx+porq > 1.5e0)) goto S340;
+ *status = 10;
+ return;
+S340:
+ dinvr(status,df,&fx,&qleft,&qhi);
+ goto S310;
+S350:
+ if(!(*status == -1)) goto S380;
+ if(!qleft) goto S360;
+ *status = 1;
+ *bound = zero;
+ goto S370;
+S360:
+ *status = 2;
+ *bound = inf;
+S370:
+ ;
+ }
+S380:
+ return;
+#undef tol
+#undef atol
+#undef zero
+#undef inf
+}
+void cdfchn(int *which,double *p,double *q,double *x,double *df,
+ double *pnonc,int *status,double *bound)
+/**********************************************************************
+
+ void cdfchn(int *which,double *p,double *q,double *x,double *df,
+ double *pnonc,int *status,double *bound)
+
+ Cumulative Distribution Function
+ Non-central Chi-Square
+
+
+ Function
+
+
+ Calculates any one parameter of the non-central chi-square
+ distribution given values for the others.
+
+
+ Arguments
+
+
+ WHICH --> Integer indicating which of the next three argument
+ values is to be calculated from the others.
+ Input range: 1..4
+ iwhich = 1 : Calculate P and Q from X and DF
+ iwhich = 2 : Calculate X from P,DF and PNONC
+ iwhich = 3 : Calculate DF from P,X and PNONC
+ iwhich = 3 : Calculate PNONC from P,X and DF
+
+ P <--> The integral from 0 to X of the non-central chi-square
+ distribution.
+ Input range: [0, 1-1E-16).
+
+ Q <--> 1-P.
+ Q is not used by this subroutine and is only included
+ for similarity with other cdf* routines.
+
+ X <--> Upper limit of integration of the non-central
+ chi-square distribution.
+ Input range: [0, +infinity).
+ Search range: [0,1E100]
+
+ DF <--> Degrees of freedom of the non-central
+ chi-square distribution.
+ Input range: (0, +infinity).
+ Search range: [ 1E-100, 1E100]
+
+ PNONC <--> Non-centrality parameter of the non-central
+ chi-square distribution.
+ Input range: [0, +infinity).
+ Search range: [0,1E4]
+
+ STATUS <-- 0 if calculation completed correctly
+ -I if input parameter number I is out of range
+ 1 if answer appears to be lower than lowest
+ search bound
+ 2 if answer appears to be higher than greatest
+ search bound
+
+ BOUND <-- Undefined if STATUS is 0
+
+ Bound exceeded by parameter number I if STATUS
+ is negative.
+
+ Lower search bound if STATUS is 1.
+
+ Upper search bound if STATUS is 2.
+
+
+ Method
+
+
+ Formula 26.4.25 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions (1966) is used to compute the cumulative
+ distribution function.
+
+ Computation of other parameters involve a seach for a value that
+ produces the desired value of P. The search relies on the
+ monotinicity of P with the other parameter.
+
+
+ WARNING
+
+ The computation time required for this routine is proportional
+ to the noncentrality parameter (PNONC). Very large values of
+ this parameter can consume immense computer resources. This is
+ why the search range is bounded by 10,000.
+
+**********************************************************************/
+{
+#define tent4 1.0e4
+#define tol 1.0e-8
+#define atol 1.0e-50
+#define zero 1.0e-100
+#define one ( 1.0e0 - 1.0e-16 )
+#define inf 1.0e100
+static double K1 = 0.0e0;
+static double K3 = 0.5e0;
+static double K4 = 5.0e0;
+static double fx,cum,ccum;
+static unsigned long qhi,qleft;
+static double T2,T5,T6,T7,T8,T9,T10,T11,T12,T13;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ Check arguments
+*/
+ if(!(*which < 1 || *which > 4)) goto S30;
+ if(!(*which < 1)) goto S10;
+ *bound = 1.0e0;
+ goto S20;
+S10:
+ *bound = 4.0e0;
+S20:
+ *status = -1;
+ return;
+S30:
+ if(*which == 1) goto S70;
+/*
+ P
+*/
+ if(!(*p < 0.0e0 || *p > one)) goto S60;
+ if(!(*p < 0.0e0)) goto S40;
+ *bound = 0.0e0;
+ goto S50;
+S40:
+ *bound = one;
+S50:
+ *status = -2;
+ return;
+S70:
+S60:
+ if(*which == 2) goto S90;
+/*
+ X
+*/
+ if(!(*x < 0.0e0)) goto S80;
+ *bound = 0.0e0;
+ *status = -4;
+ return;
+S90:
+S80:
+ if(*which == 3) goto S110;
+/*
+ DF
+*/
+ if(!(*df <= 0.0e0)) goto S100;
+ *bound = 0.0e0;
+ *status = -5;
+ return;
+S110:
+S100:
+ if(*which == 4) goto S130;
+/*
+ PNONC
+*/
+ if(!(*pnonc < 0.0e0)) goto S120;
+ *bound = 0.0e0;
+ *status = -6;
+ return;
+S130:
+S120:
+/*
+ Calculate ANSWERS
+*/
+ if(1 == *which) {
+/*
+ Calculating P and Q
+*/
+ cumchn(x,df,pnonc,p,q);
+ *status = 0;
+ }
+ else if(2 == *which) {
+/*
+ Calculating X
+*/
+ *x = 5.0e0;
+ T2 = inf;
+ T5 = atol;
+ T6 = tol;
+ dstinv(&K1,&T2,&K3,&K3,&K4,&T5,&T6);
+ *status = 0;
+ dinvr(status,x,&fx,&qleft,&qhi);
+S140:
+ if(!(*status == 1)) goto S150;
+ cumchn(x,df,pnonc,&cum,&ccum);
+ fx = cum-*p;
+ dinvr(status,x,&fx,&qleft,&qhi);
+ goto S140;
+S150:
+ if(!(*status == -1)) goto S180;
+ if(!qleft) goto S160;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S170;
+S160:
+ *status = 2;
+ *bound = inf;
+S180:
+S170:
+ ;
+ }
+ else if(3 == *which) {
+/*
+ Calculating DF
+*/
+ *df = 5.0e0;
+ T7 = zero;
+ T8 = inf;
+ T9 = atol;
+ T10 = tol;
+ dstinv(&T7,&T8,&K3,&K3,&K4,&T9,&T10);
+ *status = 0;
+ dinvr(status,df,&fx,&qleft,&qhi);
+S190:
+ if(!(*status == 1)) goto S200;
+ cumchn(x,df,pnonc,&cum,&ccum);
+ fx = cum-*p;
+ dinvr(status,df,&fx,&qleft,&qhi);
+ goto S190;
+S200:
+ if(!(*status == -1)) goto S230;
+ if(!qleft) goto S210;
+ *status = 1;
+ *bound = zero;
+ goto S220;
+S210:
+ *status = 2;
+ *bound = inf;
+S230:
+S220:
+ ;
+ }
+ else if(4 == *which) {
+/*
+ Calculating PNONC
+*/
+ *pnonc = 5.0e0;
+ T11 = tent4;
+ T12 = atol;
+ T13 = tol;
+ dstinv(&K1,&T11,&K3,&K3,&K4,&T12,&T13);
+ *status = 0;
+ dinvr(status,pnonc,&fx,&qleft,&qhi);
+S240:
+ if(!(*status == 1)) goto S250;
+ cumchn(x,df,pnonc,&cum,&ccum);
+ fx = cum-*p;
+ dinvr(status,pnonc,&fx,&qleft,&qhi);
+ goto S240;
+S250:
+ if(!(*status == -1)) goto S280;
+ if(!qleft) goto S260;
+ *status = 1;
+ *bound = zero;
+ goto S270;
+S260:
+ *status = 2;
+ *bound = tent4;
+S270:
+ ;
+ }
+S280:
+ return;
+#undef tent4
+#undef tol
+#undef atol
+#undef zero
+#undef one
+#undef inf
+}
+void cdff(int *which,double *p,double *q,double *f,double *dfn,
+ double *dfd,int *status,double *bound)
+/**********************************************************************
+
+ void cdff(int *which,double *p,double *q,double *f,double *dfn,
+ double *dfd,int *status,double *bound)
+
+ Cumulative Distribution Function
+ F distribution
+
+
+ Function
+
+
+ Calculates any one parameter of the F distribution
+ given values for the others.
+
+
+ Arguments
+
+
+ WHICH --> Integer indicating which of the next four argument
+ values is to be calculated from the others.
+ Legal range: 1..4
+ iwhich = 1 : Calculate P and Q from F,DFN and DFD
+ iwhich = 2 : Calculate F from P,Q,DFN and DFD
+ iwhich = 3 : Calculate DFN from P,Q,F and DFD
+ iwhich = 4 : Calculate DFD from P,Q,F and DFN
+
+ P <--> The integral from 0 to F of the f-density.
+ Input range: [0,1].
+
+ Q <--> 1-P.
+ Input range: (0, 1].
+ P + Q = 1.0.
+
+ F <--> Upper limit of integration of the f-density.
+ Input range: [0, +infinity).
+ Search range: [0,1E100]
+
+ DFN < --> Degrees of freedom of the numerator sum of squares.
+ Input range: (0, +infinity).
+ Search range: [ 1E-100, 1E100]
+
+ DFD < --> Degrees of freedom of the denominator sum of squares.
+ Input range: (0, +infinity).
+ Search range: [ 1E-100, 1E100]
+
+ STATUS <-- 0 if calculation completed correctly
+ -I if input parameter number I is out of range
+ 1 if answer appears to be lower than lowest
+ search bound
+ 2 if answer appears to be higher than greatest
+ search bound
+ 3 if P + Q .ne. 1
+
+ BOUND <-- Undefined if STATUS is 0
+
+ Bound exceeded by parameter number I if STATUS
+ is negative.
+
+ Lower search bound if STATUS is 1.
+
+ Upper search bound if STATUS is 2.
+
+
+ Method
+
+
+ Formula 26.6.2 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions (1966) is used to reduce the computation
+ of the cumulative distribution function for the F variate to
+ that of an incomplete beta.
+
+ Computation of other parameters involve a seach for a value that
+ produces the desired value of P. The search relies on the
+ monotinicity of P with the other parameter.
+
+ WARNING
+
+ The value of the cumulative F distribution is not necessarily
+ monotone in either degrees of freedom. There thus may be two
+ values that provide a given CDF value. This routine assumes
+ monotonicity and will find an arbitrary one of the two values.
+
+**********************************************************************/
+{
+#define tol 1.0e-8
+#define atol 1.0e-50
+#define zero 1.0e-100
+#define inf 1.0e100
+static int K1 = 1;
+static double K2 = 0.0e0;
+static double K4 = 0.5e0;
+static double K5 = 5.0e0;
+static double pq,fx,cum,ccum;
+static unsigned long qhi,qleft,qporq;
+static double T3,T6,T7,T8,T9,T10,T11,T12,T13,T14,T15;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ Check arguments
+*/
+ if(!(*which < 1 || *which > 4)) goto S30;
+ if(!(*which < 1)) goto S10;
+ *bound = 1.0e0;
+ goto S20;
+S10:
+ *bound = 4.0e0;
+S20:
+ *status = -1;
+ return;
+S30:
+ if(*which == 1) goto S70;
+/*
+ P
+*/
+ if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
+ if(!(*p < 0.0e0)) goto S40;
+ *bound = 0.0e0;
+ goto S50;
+S40:
+ *bound = 1.0e0;
+S50:
+ *status = -2;
+ return;
+S70:
+S60:
+ if(*which == 1) goto S110;
+/*
+ Q
+*/
+ if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
+ if(!(*q <= 0.0e0)) goto S80;
+ *bound = 0.0e0;
+ goto S90;
+S80:
+ *bound = 1.0e0;
+S90:
+ *status = -3;
+ return;
+S110:
+S100:
+ if(*which == 2) goto S130;
+/*
+ F
+*/
+ if(!(*f < 0.0e0)) goto S120;
+ *bound = 0.0e0;
+ *status = -4;
+ return;
+S130:
+S120:
+ if(*which == 3) goto S150;
+/*
+ DFN
+*/
+ if(!(*dfn <= 0.0e0)) goto S140;
+ *bound = 0.0e0;
+ *status = -5;
+ return;
+S150:
+S140:
+ if(*which == 4) goto S170;
+/*
+ DFD
+*/
+ if(!(*dfd <= 0.0e0)) goto S160;
+ *bound = 0.0e0;
+ *status = -6;
+ return;
+S170:
+S160:
+ if(*which == 1) goto S210;
+/*
+ P + Q
+*/
+ pq = *p+*q;
+ if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S200;
+ if(!(pq < 0.0e0)) goto S180;
+ *bound = 0.0e0;
+ goto S190;
+S180:
+ *bound = 1.0e0;
+S190:
+ *status = 3;
+ return;
+S210:
+S200:
+ if(!(*which == 1)) qporq = *p <= *q;
+/*
+ Select the minimum of P or Q
+ Calculate ANSWERS
+*/
+ if(1 == *which) {
+/*
+ Calculating P
+*/
+ cumf(f,dfn,dfd,p,q);
+ *status = 0;
+ }
+ else if(2 == *which) {
+/*
+ Calculating F
+*/
+ *f = 5.0e0;
+ T3 = inf;
+ T6 = atol;
+ T7 = tol;
+ dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7);
+ *status = 0;
+ dinvr(status,f,&fx,&qleft,&qhi);
+S220:
+ if(!(*status == 1)) goto S250;
+ cumf(f,dfn,dfd,&cum,&ccum);
+ if(!qporq) goto S230;
+ fx = cum-*p;
+ goto S240;
+S230:
+ fx = ccum-*q;
+S240:
+ dinvr(status,f,&fx,&qleft,&qhi);
+ goto S220;
+S250:
+ if(!(*status == -1)) goto S280;
+ if(!qleft) goto S260;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S270;
+S260:
+ *status = 2;
+ *bound = inf;
+S280:
+S270:
+ ;
+ }
+ else if(3 == *which) {
+/*
+ Calculating DFN
+*/
+ *dfn = 5.0e0;
+ T8 = zero;
+ T9 = inf;
+ T10 = atol;
+ T11 = tol;
+ dstinv(&T8,&T9,&K4,&K4,&K5,&T10,&T11);
+ *status = 0;
+ dinvr(status,dfn,&fx,&qleft,&qhi);
+S290:
+ if(!(*status == 1)) goto S320;
+ cumf(f,dfn,dfd,&cum,&ccum);
+ if(!qporq) goto S300;
+ fx = cum-*p;
+ goto S310;
+S300:
+ fx = ccum-*q;
+S310:
+ dinvr(status,dfn,&fx,&qleft,&qhi);
+ goto S290;
+S320:
+ if(!(*status == -1)) goto S350;
+ if(!qleft) goto S330;
+ *status = 1;
+ *bound = zero;
+ goto S340;
+S330:
+ *status = 2;
+ *bound = inf;
+S350:
+S340:
+ ;
+ }
+ else if(4 == *which) {
+/*
+ Calculating DFD
+*/
+ *dfd = 5.0e0;
+ T12 = zero;
+ T13 = inf;
+ T14 = atol;
+ T15 = tol;
+ dstinv(&T12,&T13,&K4,&K4,&K5,&T14,&T15);
+ *status = 0;
+ dinvr(status,dfd,&fx,&qleft,&qhi);
+S360:
+ if(!(*status == 1)) goto S390;
+ cumf(f,dfn,dfd,&cum,&ccum);
+ if(!qporq) goto S370;
+ fx = cum-*p;
+ goto S380;
+S370:
+ fx = ccum-*q;
+S380:
+ dinvr(status,dfd,&fx,&qleft,&qhi);
+ goto S360;
+S390:
+ if(!(*status == -1)) goto S420;
+ if(!qleft) goto S400;
+ *status = 1;
+ *bound = zero;
+ goto S410;
+S400:
+ *status = 2;
+ *bound = inf;
+S410:
+ ;
+ }
+S420:
+ return;
+#undef tol
+#undef atol
+#undef zero
+#undef inf
+}
+void cdffnc(int *which,double *p,double *q,double *f,double *dfn,
+ double *dfd,double *phonc,int *status,double *bound)
+/**********************************************************************
+
+ void cdffnc(int *which,double *p,double *q,double *f,double *dfn,
+ double *dfd,double *phonc,int *status,double *bound)
+
+ Cumulative Distribution Function
+ Non-central F distribution
+
+
+ Function
+
+
+ Calculates any one parameter of the Non-central F
+ distribution given values for the others.
+
+
+ Arguments
+
+
+ WHICH --> Integer indicating which of the next five argument
+ values is to be calculated from the others.
+ Legal range: 1..5
+ iwhich = 1 : Calculate P and Q from F,DFN,DFD and PNONC
+ iwhich = 2 : Calculate F from P,Q,DFN,DFD and PNONC
+ iwhich = 3 : Calculate DFN from P,Q,F,DFD and PNONC
+ iwhich = 4 : Calculate DFD from P,Q,F,DFN and PNONC
+ iwhich = 5 : Calculate PNONC from P,Q,F,DFN and DFD
+
+ P <--> The integral from 0 to F of the non-central f-density.
+ Input range: [0,1-1E-16).
+
+ Q <--> 1-P.
+ Q is not used by this subroutine and is only included
+ for similarity with other cdf* routines.
+
+ F <--> Upper limit of integration of the non-central f-density.
+ Input range: [0, +infinity).
+ Search range: [0,1E100]
+
+ DFN < --> Degrees of freedom of the numerator sum of squares.
+ Input range: (0, +infinity).
+ Search range: [ 1E-100, 1E100]
+
+ DFD < --> Degrees of freedom of the denominator sum of squares.
+ Must be in range: (0, +infinity).
+ Input range: (0, +infinity).
+ Search range: [ 1E-100, 1E100]
+
+ PNONC <-> The non-centrality parameter
+ Input range: [0,infinity)
+ Search range: [0,1E4]
+
+ STATUS <-- 0 if calculation completed correctly
+ -I if input parameter number I is out of range
+ 1 if answer appears to be lower than lowest
+ search bound
+ 2 if answer appears to be higher than greatest
+ search bound
+ 3 if P + Q .ne. 1
+
+ BOUND <-- Undefined if STATUS is 0
+
+ Bound exceeded by parameter number I if STATUS
+ is negative.
+
+ Lower search bound if STATUS is 1.
+
+ Upper search bound if STATUS is 2.
+
+
+ Method
+
+
+ Formula 26.6.20 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions (1966) is used to compute the cumulative
+ distribution function.
+
+ Computation of other parameters involve a seach for a value that
+ produces the desired value of P. The search relies on the
+ monotinicity of P with the other parameter.
+
+ WARNING
+
+ The computation time required for this routine is proportional
+ to the noncentrality parameter (PNONC). Very large values of
+ this parameter can consume immense computer resources. This is
+ why the search range is bounded by 10,000.
+
+ WARNING
+
+ The value of the cumulative noncentral F distribution is not
+ necessarily monotone in either degrees of freedom. There thus
+ may be two values that provide a given CDF value. This routine
+ assumes monotonicity and will find an arbitrary one of the two
+ values.
+
+**********************************************************************/
+{
+#define tent4 1.0e4
+#define tol 1.0e-8
+#define atol 1.0e-50
+#define zero 1.0e-100
+#define one ( 1.0e0 - 1.0e-16 )
+#define inf 1.0e100
+static double K1 = 0.0e0;
+static double K3 = 0.5e0;
+static double K4 = 5.0e0;
+static double fx,cum,ccum;
+static unsigned long qhi,qleft;
+static double T2,T5,T6,T7,T8,T9,T10,T11,T12,T13,T14,T15,T16,T17;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ Check arguments
+*/
+ if(!(*which < 1 || *which > 5)) goto S30;
+ if(!(*which < 1)) goto S10;
+ *bound = 1.0e0;
+ goto S20;
+S10:
+ *bound = 5.0e0;
+S20:
+ *status = -1;
+ return;
+S30:
+ if(*which == 1) goto S70;
+/*
+ P
+*/
+ if(!(*p < 0.0e0 || *p > one)) goto S60;
+ if(!(*p < 0.0e0)) goto S40;
+ *bound = 0.0e0;
+ goto S50;
+S40:
+ *bound = one;
+S50:
+ *status = -2;
+ return;
+S70:
+S60:
+ if(*which == 2) goto S90;
+/*
+ F
+*/
+ if(!(*f < 0.0e0)) goto S80;
+ *bound = 0.0e0;
+ *status = -4;
+ return;
+S90:
+S80:
+ if(*which == 3) goto S110;
+/*
+ DFN
+*/
+ if(!(*dfn <= 0.0e0)) goto S100;
+ *bound = 0.0e0;
+ *status = -5;
+ return;
+S110:
+S100:
+ if(*which == 4) goto S130;
+/*
+ DFD
+*/
+ if(!(*dfd <= 0.0e0)) goto S120;
+ *bound = 0.0e0;
+ *status = -6;
+ return;
+S130:
+S120:
+ if(*which == 5) goto S150;
+/*
+ PHONC
+*/
+ if(!(*phonc < 0.0e0)) goto S140;
+ *bound = 0.0e0;
+ *status = -7;
+ return;
+S150:
+S140:
+/*
+ Calculate ANSWERS
+*/
+ if(1 == *which) {
+/*
+ Calculating P
+*/
+ cumfnc(f,dfn,dfd,phonc,p,q);
+ *status = 0;
+ }
+ else if(2 == *which) {
+/*
+ Calculating F
+*/
+ *f = 5.0e0;
+ T2 = inf;
+ T5 = atol;
+ T6 = tol;
+ dstinv(&K1,&T2,&K3,&K3,&K4,&T5,&T6);
+ *status = 0;
+ dinvr(status,f,&fx,&qleft,&qhi);
+S160:
+ if(!(*status == 1)) goto S170;
+ cumfnc(f,dfn,dfd,phonc,&cum,&ccum);
+ fx = cum-*p;
+ dinvr(status,f,&fx,&qleft,&qhi);
+ goto S160;
+S170:
+ if(!(*status == -1)) goto S200;
+ if(!qleft) goto S180;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S190;
+S180:
+ *status = 2;
+ *bound = inf;
+S200:
+S190:
+ ;
+ }
+ else if(3 == *which) {
+/*
+ Calculating DFN
+*/
+ *dfn = 5.0e0;
+ T7 = zero;
+ T8 = inf;
+ T9 = atol;
+ T10 = tol;
+ dstinv(&T7,&T8,&K3,&K3,&K4,&T9,&T10);
+ *status = 0;
+ dinvr(status,dfn,&fx,&qleft,&qhi);
+S210:
+ if(!(*status == 1)) goto S220;
+ cumfnc(f,dfn,dfd,phonc,&cum,&ccum);
+ fx = cum-*p;
+ dinvr(status,dfn,&fx,&qleft,&qhi);
+ goto S210;
+S220:
+ if(!(*status == -1)) goto S250;
+ if(!qleft) goto S230;
+ *status = 1;
+ *bound = zero;
+ goto S240;
+S230:
+ *status = 2;
+ *bound = inf;
+S250:
+S240:
+ ;
+ }
+ else if(4 == *which) {
+/*
+ Calculating DFD
+*/
+ *dfd = 5.0e0;
+ T11 = zero;
+ T12 = inf;
+ T13 = atol;
+ T14 = tol;
+ dstinv(&T11,&T12,&K3,&K3,&K4,&T13,&T14);
+ *status = 0;
+ dinvr(status,dfd,&fx,&qleft,&qhi);
+S260:
+ if(!(*status == 1)) goto S270;
+ cumfnc(f,dfn,dfd,phonc,&cum,&ccum);
+ fx = cum-*p;
+ dinvr(status,dfd,&fx,&qleft,&qhi);
+ goto S260;
+S270:
+ if(!(*status == -1)) goto S300;
+ if(!qleft) goto S280;
+ *status = 1;
+ *bound = zero;
+ goto S290;
+S280:
+ *status = 2;
+ *bound = inf;
+S300:
+S290:
+ ;
+ }
+ else if(5 == *which) {
+/*
+ Calculating PHONC
+*/
+ *phonc = 5.0e0;
+ T15 = tent4;
+ T16 = atol;
+ T17 = tol;
+ dstinv(&K1,&T15,&K3,&K3,&K4,&T16,&T17);
+ *status = 0;
+ dinvr(status,phonc,&fx,&qleft,&qhi);
+S310:
+ if(!(*status == 1)) goto S320;
+ cumfnc(f,dfn,dfd,phonc,&cum,&ccum);
+ fx = cum-*p;
+ dinvr(status,phonc,&fx,&qleft,&qhi);
+ goto S310;
+S320:
+ if(!(*status == -1)) goto S350;
+ if(!qleft) goto S330;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S340;
+S330:
+ *status = 2;
+ *bound = tent4;
+S340:
+ ;
+ }
+S350:
+ return;
+#undef tent4
+#undef tol
+#undef atol
+#undef zero
+#undef one
+#undef inf
+}
+void cdfgam(int *which,double *p,double *q,double *x,double *shape,
+ double *scale,int *status,double *bound)
+/**********************************************************************
+
+ void cdfgam(int *which,double *p,double *q,double *x,double *shape,
+ double *scale,int *status,double *bound)
+
+ Cumulative Distribution Function
+ GAMma Distribution
+
+
+ Function
+
+
+ Calculates any one parameter of the gamma
+ distribution given values for the others.
+
+
+ Arguments
+
+
+ WHICH --> Integer indicating which of the next four argument
+ values is to be calculated from the others.
+ Legal range: 1..4
+ iwhich = 1 : Calculate P and Q from X,SHAPE and SCALE
+ iwhich = 2 : Calculate X from P,Q,SHAPE and SCALE
+ iwhich = 3 : Calculate SHAPE from P,Q,X and SCALE
+ iwhich = 4 : Calculate SCALE from P,Q,X and SHAPE
+
+ P <--> The integral from 0 to X of the gamma density.
+ Input range: [0,1].
+
+ Q <--> 1-P.
+ Input range: (0, 1].
+ P + Q = 1.0.
+
+ X <--> The upper limit of integration of the gamma density.
+ Input range: [0, +infinity).
+ Search range: [0,1E100]
+
+ SHAPE <--> The shape parameter of the gamma density.
+ Input range: (0, +infinity).
+ Search range: [1E-100,1E100]
+
+ SCALE <--> The scale parameter of the gamma density.
+ Input range: (0, +infinity).
+ Search range: (1E-100,1E100]
+
+ STATUS <-- 0 if calculation completed correctly
+ -I if input parameter number I is out of range
+ 1 if answer appears to be lower than lowest
+ search bound
+ 2 if answer appears to be higher than greatest
+ search bound
+ 3 if P + Q .ne. 1
+ 10 if the gamma or inverse gamma routine cannot
+ compute the answer. Usually happens only for
+ X and SHAPE very large (gt 1E10 or more)
+
+ BOUND <-- Undefined if STATUS is 0
+
+ Bound exceeded by parameter number I if STATUS
+ is negative.
+
+ Lower search bound if STATUS is 1.
+
+ Upper search bound if STATUS is 2.
+
+
+ Method
+
+
+ Cumulative distribution function (P) is calculated directly by
+ the code associated with:
+
+ DiDinato, A. R. and Morris, A. H. Computation of the incomplete
+ gamma function ratios and their inverse. ACM Trans. Math.
+ Softw. 12 (1986), 377-393.
+
+ Computation of other parameters involve a seach for a value that
+ produces the desired value of P. The search relies on the
+ monotinicity of P with the other parameter.
+
+
+ Note
+
+
+
+ The gamma density is proportional to
+ T**(SHAPE - 1) * EXP(- SCALE * T)
+
+**********************************************************************/
+{
+#define tol 1.0e-8
+#define atol 1.0e-50
+#define zero 1.0e-100
+#define inf 1.0e100
+static int K1 = 1;
+static double K5 = 0.5e0;
+static double K6 = 5.0e0;
+static double xx,fx,xscale,cum,ccum,pq,porq;
+static int ierr;
+static unsigned long qhi,qleft,qporq;
+static double T2,T3,T4,T7,T8,T9;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ Check arguments
+*/
+ if(!(*which < 1 || *which > 4)) goto S30;
+ if(!(*which < 1)) goto S10;
+ *bound = 1.0e0;
+ goto S20;
+S10:
+ *bound = 4.0e0;
+S20:
+ *status = -1;
+ return;
+S30:
+ if(*which == 1) goto S70;
+/*
+ P
+*/
+ if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
+ if(!(*p < 0.0e0)) goto S40;
+ *bound = 0.0e0;
+ goto S50;
+S40:
+ *bound = 1.0e0;
+S50:
+ *status = -2;
+ return;
+S70:
+S60:
+ if(*which == 1) goto S110;
+/*
+ Q
+*/
+ if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
+ if(!(*q <= 0.0e0)) goto S80;
+ *bound = 0.0e0;
+ goto S90;
+S80:
+ *bound = 1.0e0;
+S90:
+ *status = -3;
+ return;
+S110:
+S100:
+ if(*which == 2) goto S130;
+/*
+ X
+*/
+ if(!(*x < 0.0e0)) goto S120;
+ *bound = 0.0e0;
+ *status = -4;
+ return;
+S130:
+S120:
+ if(*which == 3) goto S150;
+/*
+ SHAPE
+*/
+ if(!(*shape <= 0.0e0)) goto S140;
+ *bound = 0.0e0;
+ *status = -5;
+ return;
+S150:
+S140:
+ if(*which == 4) goto S170;
+/*
+ SCALE
+*/
+ if(!(*scale <= 0.0e0)) goto S160;
+ *bound = 0.0e0;
+ *status = -6;
+ return;
+S170:
+S160:
+ if(*which == 1) goto S210;
+/*
+ P + Q
+*/
+ pq = *p+*q;
+ if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S200;
+ if(!(pq < 0.0e0)) goto S180;
+ *bound = 0.0e0;
+ goto S190;
+S180:
+ *bound = 1.0e0;
+S190:
+ *status = 3;
+ return;
+S210:
+S200:
+ if(*which == 1) goto S240;
+/*
+ Select the minimum of P or Q
+*/
+ qporq = *p <= *q;
+ if(!qporq) goto S220;
+ porq = *p;
+ goto S230;
+S220:
+ porq = *q;
+S240:
+S230:
+/*
+ Calculate ANSWERS
+*/
+ if(1 == *which) {
+/*
+ Calculating P
+*/
+ *status = 0;
+ xscale = *x**scale;
+ cumgam(&xscale,shape,p,q);
+ if(porq > 1.5e0) *status = 10;
+ }
+ else if(2 == *which) {
+/*
+ Computing X
+*/
+ T2 = -1.0e0;
+ gaminv(shape,&xx,&T2,p,q,&ierr);
+ if(ierr < 0.0e0) {
+ *status = 10;
+ return;
+ }
+ else {
+ *x = xx/ *scale;
+ *status = 0;
+ }
+ }
+ else if(3 == *which) {
+/*
+ Computing SHAPE
+*/
+ *shape = 5.0e0;
+ xscale = *x**scale;
+ T3 = zero;
+ T4 = inf;
+ T7 = atol;
+ T8 = tol;
+ dstinv(&T3,&T4,&K5,&K5,&K6,&T7,&T8);
+ *status = 0;
+ dinvr(status,shape,&fx,&qleft,&qhi);
+S250:
+ if(!(*status == 1)) goto S290;
+ cumgam(&xscale,shape,&cum,&ccum);
+ if(!qporq) goto S260;
+ fx = cum-*p;
+ goto S270;
+S260:
+ fx = ccum-*q;
+S270:
+ if(!((qporq && cum > 1.5e0) || (!qporq && ccum > 1.5e0))) goto S280;
+ *status = 10;
+ return;
+S280:
+ dinvr(status,shape,&fx,&qleft,&qhi);
+ goto S250;
+S290:
+ if(!(*status == -1)) goto S320;
+ if(!qleft) goto S300;
+ *status = 1;
+ *bound = zero;
+ goto S310;
+S300:
+ *status = 2;
+ *bound = inf;
+S320:
+S310:
+ ;
+ }
+ else if(4 == *which) {
+/*
+ Computing SCALE
+*/
+ T9 = -1.0e0;
+ gaminv(shape,&xx,&T9,p,q,&ierr);
+ if(ierr < 0.0e0) {
+ *status = 10;
+ return;
+ }
+ else {
+ *scale = xx/ *x;
+ *status = 0;
+ }
+ }
+ return;
+#undef tol
+#undef atol
+#undef zero
+#undef inf
+}
+void cdfnbn(int *which,double *p,double *q,double *s,double *xn,
+ double *pr,double *ompr,int *status,double *bound)
+/**********************************************************************
+
+ void cdfnbn(int *which,double *p,double *q,double *s,double *xn,
+ double *pr,double *ompr,int *status,double *bound)
+
+ Cumulative Distribution Function
+ Negative BiNomial distribution
+
+
+ Function
+
+
+ Calculates any one parameter of the negative binomial
+ distribution given values for the others.
+
+ The cumulative negative binomial distribution returns the
+ probability that there will be F or fewer failures before the
+ XNth success in binomial trials each of which has probability of
+ success PR.
+
+ The individual term of the negative binomial is the probability of
+ S failures before XN successes and is
+ Choose( S, XN+S-1 ) * PR^(XN) * (1-PR)^S
+
+
+ Arguments
+
+
+ WHICH --> Integer indicating which of the next four argument
+ values is to be calculated from the others.
+ Legal range: 1..4
+ iwhich = 1 : Calculate P and Q from S,XN,PR and OMPR
+ iwhich = 2 : Calculate S from P,Q,XN,PR and OMPR
+ iwhich = 3 : Calculate XN from P,Q,S,PR and OMPR
+ iwhich = 4 : Calculate PR and OMPR from P,Q,S and XN
+
+ P <--> The cumulation from 0 to S of the negative
+ binomial distribution.
+ Input range: [0,1].
+
+ Q <--> 1-P.
+ Input range: (0, 1].
+ P + Q = 1.0.
+
+ S <--> The upper limit of cumulation of the binomial distribution.
+ There are F or fewer failures before the XNth success.
+ Input range: [0, +infinity).
+ Search range: [0, 1E100]
+
+ XN <--> The number of successes.
+ Input range: [0, +infinity).
+ Search range: [0, 1E100]
+
+ PR <--> The probability of success in each binomial trial.
+ Input range: [0,1].
+ Search range: [0,1].
+
+ OMPR <--> 1-PR
+ Input range: [0,1].
+ Search range: [0,1]
+ PR + OMPR = 1.0
+
+ STATUS <-- 0 if calculation completed correctly
+ -I if input parameter number I is out of range
+ 1 if answer appears to be lower than lowest
+ search bound
+ 2 if answer appears to be higher than greatest
+ search bound
+ 3 if P + Q .ne. 1
+ 4 if PR + OMPR .ne. 1
+
+ BOUND <-- Undefined if STATUS is 0
+
+ Bound exceeded by parameter number I if STATUS
+ is negative.
+
+ Lower search bound if STATUS is 1.
+
+ Upper search bound if STATUS is 2.
+
+
+ Method
+
+
+ Formula 26.5.26 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions (1966) is used to reduce calculation of
+ the cumulative distribution function to that of an incomplete
+ beta.
+
+ Computation of other parameters involve a seach for a value that
+ produces the desired value of P. The search relies on the
+ monotinicity of P with the other parameter.
+
+**********************************************************************/
+{
+#define tol 1.0e-8
+#define atol 1.0e-50
+#define inf 1.0e100
+#define one 1.0e0
+static int K1 = 1;
+static double K2 = 0.0e0;
+static double K4 = 0.5e0;
+static double K5 = 5.0e0;
+static double K11 = 1.0e0;
+static double fx,xhi,xlo,pq,prompr,cum,ccum;
+static unsigned long qhi,qleft,qporq;
+static double T3,T6,T7,T8,T9,T10,T12,T13;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ Check arguments
+*/
+ if(!(*which < 1 || *which > 4)) goto S30;
+ if(!(*which < 1)) goto S10;
+ *bound = 1.0e0;
+ goto S20;
+S10:
+ *bound = 4.0e0;
+S20:
+ *status = -1;
+ return;
+S30:
+ if(*which == 1) goto S70;
+/*
+ P
+*/
+ if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
+ if(!(*p < 0.0e0)) goto S40;
+ *bound = 0.0e0;
+ goto S50;
+S40:
+ *bound = 1.0e0;
+S50:
+ *status = -2;
+ return;
+S70:
+S60:
+ if(*which == 1) goto S110;
+/*
+ Q
+*/
+ if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
+ if(!(*q <= 0.0e0)) goto S80;
+ *bound = 0.0e0;
+ goto S90;
+S80:
+ *bound = 1.0e0;
+S90:
+ *status = -3;
+ return;
+S110:
+S100:
+ if(*which == 2) goto S130;
+/*
+ S
+*/
+ if(!(*s < 0.0e0)) goto S120;
+ *bound = 0.0e0;
+ *status = -4;
+ return;
+S130:
+S120:
+ if(*which == 3) goto S150;
+/*
+ XN
+*/
+ if(!(*xn < 0.0e0)) goto S140;
+ *bound = 0.0e0;
+ *status = -5;
+ return;
+S150:
+S140:
+ if(*which == 4) goto S190;
+/*
+ PR
+*/
+ if(!(*pr < 0.0e0 || *pr > 1.0e0)) goto S180;
+ if(!(*pr < 0.0e0)) goto S160;
+ *bound = 0.0e0;
+ goto S170;
+S160:
+ *bound = 1.0e0;
+S170:
+ *status = -6;
+ return;
+S190:
+S180:
+ if(*which == 4) goto S230;
+/*
+ OMPR
+*/
+ if(!(*ompr < 0.0e0 || *ompr > 1.0e0)) goto S220;
+ if(!(*ompr < 0.0e0)) goto S200;
+ *bound = 0.0e0;
+ goto S210;
+S200:
+ *bound = 1.0e0;
+S210:
+ *status = -7;
+ return;
+S230:
+S220:
+ if(*which == 1) goto S270;
+/*
+ P + Q
+*/
+ pq = *p+*q;
+ if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S260;
+ if(!(pq < 0.0e0)) goto S240;
+ *bound = 0.0e0;
+ goto S250;
+S240:
+ *bound = 1.0e0;
+S250:
+ *status = 3;
+ return;
+S270:
+S260:
+ if(*which == 4) goto S310;
+/*
+ PR + OMPR
+*/
+ prompr = *pr+*ompr;
+ if(!(fabs(prompr-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S300;
+ if(!(prompr < 0.0e0)) goto S280;
+ *bound = 0.0e0;
+ goto S290;
+S280:
+ *bound = 1.0e0;
+S290:
+ *status = 4;
+ return;
+S310:
+S300:
+ if(!(*which == 1)) qporq = *p <= *q;
+/*
+ Select the minimum of P or Q
+ Calculate ANSWERS
+*/
+ if(1 == *which) {
+/*
+ Calculating P
+*/
+ cumnbn(s,xn,pr,ompr,p,q);
+ *status = 0;
+ }
+ else if(2 == *which) {
+/*
+ Calculating S
+*/
+ *s = 5.0e0;
+ T3 = inf;
+ T6 = atol;
+ T7 = tol;
+ dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7);
+ *status = 0;
+ dinvr(status,s,&fx,&qleft,&qhi);
+S320:
+ if(!(*status == 1)) goto S350;
+ cumnbn(s,xn,pr,ompr,&cum,&ccum);
+ if(!qporq) goto S330;
+ fx = cum-*p;
+ goto S340;
+S330:
+ fx = ccum-*q;
+S340:
+ dinvr(status,s,&fx,&qleft,&qhi);
+ goto S320;
+S350:
+ if(!(*status == -1)) goto S380;
+ if(!qleft) goto S360;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S370;
+S360:
+ *status = 2;
+ *bound = inf;
+S380:
+S370:
+ ;
+ }
+ else if(3 == *which) {
+/*
+ Calculating XN
+*/
+ *xn = 5.0e0;
+ T8 = inf;
+ T9 = atol;
+ T10 = tol;
+ dstinv(&K2,&T8,&K4,&K4,&K5,&T9,&T10);
+ *status = 0;
+ dinvr(status,xn,&fx,&qleft,&qhi);
+S390:
+ if(!(*status == 1)) goto S420;
+ cumnbn(s,xn,pr,ompr,&cum,&ccum);
+ if(!qporq) goto S400;
+ fx = cum-*p;
+ goto S410;
+S400:
+ fx = ccum-*q;
+S410:
+ dinvr(status,xn,&fx,&qleft,&qhi);
+ goto S390;
+S420:
+ if(!(*status == -1)) goto S450;
+ if(!qleft) goto S430;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S440;
+S430:
+ *status = 2;
+ *bound = inf;
+S450:
+S440:
+ ;
+ }
+ else if(4 == *which) {
+/*
+ Calculating PR and OMPR
+*/
+ T12 = atol;
+ T13 = tol;
+ dstzr(&K2,&K11,&T12,&T13);
+ if(!qporq) goto S480;
+ *status = 0;
+ dzror(status,pr,&fx,&xlo,&xhi,&qleft,&qhi);
+ *ompr = one-*pr;
+S460:
+ if(!(*status == 1)) goto S470;
+ cumnbn(s,xn,pr,ompr,&cum,&ccum);
+ fx = cum-*p;
+ dzror(status,pr,&fx,&xlo,&xhi,&qleft,&qhi);
+ *ompr = one-*pr;
+ goto S460;
+S470:
+ goto S510;
+S480:
+ *status = 0;
+ dzror(status,ompr,&fx,&xlo,&xhi,&qleft,&qhi);
+ *pr = one-*ompr;
+S490:
+ if(!(*status == 1)) goto S500;
+ cumnbn(s,xn,pr,ompr,&cum,&ccum);
+ fx = ccum-*q;
+ dzror(status,ompr,&fx,&xlo,&xhi,&qleft,&qhi);
+ *pr = one-*ompr;
+ goto S490;
+S510:
+S500:
+ if(!(*status == -1)) goto S540;
+ if(!qleft) goto S520;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S530;
+S520:
+ *status = 2;
+ *bound = 1.0e0;
+S530:
+ ;
+ }
+S540:
+ return;
+#undef tol
+#undef atol
+#undef inf
+#undef one
+}
+void cdfnor(int *which,double *p,double *q,double *x,double *mean,
+ double *sd,int *status,double *bound)
+/**********************************************************************
+
+ void cdfnor(int *which,double *p,double *q,double *x,double *mean,
+ double *sd,int *status,double *bound)
+
+ Cumulative Distribution Function
+ NORmal distribution
+
+
+ Function
+
+
+ Calculates any one parameter of the normal
+ distribution given values for the others.
+
+
+ Arguments
+
+
+ WHICH --> Integer indicating which of the next parameter
+ values is to be calculated using values of the others.
+ Legal range: 1..4
+ iwhich = 1 : Calculate P and Q from X,MEAN and SD
+ iwhich = 2 : Calculate X from P,Q,MEAN and SD
+ iwhich = 3 : Calculate MEAN from P,Q,X and SD
+ iwhich = 4 : Calculate SD from P,Q,X and MEAN
+
+ P <--> The integral from -infinity to X of the normal density.
+ Input range: (0,1].
+
+ Q <--> 1-P.
+ Input range: (0, 1].
+ P + Q = 1.0.
+
+ X < --> Upper limit of integration of the normal-density.
+ Input range: ( -infinity, +infinity)
+
+ MEAN <--> The mean of the normal density.
+ Input range: (-infinity, +infinity)
+
+ SD <--> Standard Deviation of the normal density.
+ Input range: (0, +infinity).
+
+ STATUS <-- 0 if calculation completed correctly
+ -I if input parameter number I is out of range
+ 1 if answer appears to be lower than lowest
+ search bound
+ 2 if answer appears to be higher than greatest
+ search bound
+ 3 if P + Q .ne. 1
+
+ BOUND <-- Undefined if STATUS is 0
+
+ Bound exceeded by parameter number I if STATUS
+ is negative.
+
+ Lower search bound if STATUS is 1.
+
+ Upper search bound if STATUS is 2.
+
+
+ Method
+
+
+
+
+ A slightly modified version of ANORM from
+
+ Cody, W.D. (1993). "ALGORITHM 715: SPECFUN - A Portabel FORTRAN
+ Package of Special Function Routines and Test Drivers"
+ acm Transactions on Mathematical Software. 19, 22-32.
+
+ is used to calulate the cumulative standard normal distribution.
+
+ The rational functions from pages 90-95 of Kennedy and Gentle,
+ Statistical Computing, Marcel Dekker, NY, 1980 are used as
+ starting values to Newton's Iterations which compute the inverse
+ standard normal. Therefore no searches are necessary for any
+ parameter.
+
+ For X < -15, the asymptotic expansion for the normal is used as
+ the starting value in finding the inverse standard normal.
+ This is formula 26.2.12 of Abramowitz and Stegun.
+
+
+ Note
+
+
+ The normal density is proportional to
+ exp( - 0.5 * (( X - MEAN)/SD)**2)
+
+**********************************************************************/
+{
+static int K1 = 1;
+static double z,pq;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ Check arguments
+*/
+ *status = 0;
+ if(!(*which < 1 || *which > 4)) goto S30;
+ if(!(*which < 1)) goto S10;
+ *bound = 1.0e0;
+ goto S20;
+S10:
+ *bound = 4.0e0;
+S20:
+ *status = -1;
+ return;
+S30:
+ if(*which == 1) goto S70;
+/*
+ P
+*/
+ if(!(*p <= 0.0e0 || *p > 1.0e0)) goto S60;
+ if(!(*p <= 0.0e0)) goto S40;
+ *bound = 0.0e0;
+ goto S50;
+S40:
+ *bound = 1.0e0;
+S50:
+ *status = -2;
+ return;
+S70:
+S60:
+ if(*which == 1) goto S110;
+/*
+ Q
+*/
+ if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
+ if(!(*q <= 0.0e0)) goto S80;
+ *bound = 0.0e0;
+ goto S90;
+S80:
+ *bound = 1.0e0;
+S90:
+ *status = -3;
+ return;
+S110:
+S100:
+ if(*which == 1) goto S150;
+/*
+ P + Q
+*/
+ pq = *p+*q;
+ if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S140;
+ if(!(pq < 0.0e0)) goto S120;
+ *bound = 0.0e0;
+ goto S130;
+S120:
+ *bound = 1.0e0;
+S130:
+ *status = 3;
+ return;
+S150:
+S140:
+ if(*which == 4) goto S170;
+/*
+ SD
+*/
+ if(!(*sd <= 0.0e0)) goto S160;
+ *bound = 0.0e0;
+ *status = -6;
+ return;
+S170:
+S160:
+/*
+ Calculate ANSWERS
+*/
+ if(1 == *which) {
+/*
+ Computing P
+*/
+ z = (*x-*mean)/ *sd;
+ cumnor(&z,p,q);
+ }
+ else if(2 == *which) {
+/*
+ Computing X
+*/
+ z = dinvnr(p,q);
+ *x = *sd*z+*mean;
+ }
+ else if(3 == *which) {
+/*
+ Computing the MEAN
+*/
+ z = dinvnr(p,q);
+ *mean = *x-*sd*z;
+ }
+ else if(4 == *which) {
+/*
+ Computing SD
+*/
+ z = dinvnr(p,q);
+ *sd = (*x-*mean)/z;
+ }
+ return;
+}
+void cdfpoi(int *which,double *p,double *q,double *s,double *xlam,
+ int *status,double *bound)
+/**********************************************************************
+
+ void cdfpoi(int *which,double *p,double *q,double *s,double *xlam,
+ int *status,double *bound)
+
+ Cumulative Distribution Function
+ POIsson distribution
+
+
+ Function
+
+
+ Calculates any one parameter of the Poisson
+ distribution given values for the others.
+
+
+ Arguments
+
+
+ WHICH --> Integer indicating which argument
+ value is to be calculated from the others.
+ Legal range: 1..3
+ iwhich = 1 : Calculate P and Q from S and XLAM
+ iwhich = 2 : Calculate A from P,Q and XLAM
+ iwhich = 3 : Calculate XLAM from P,Q and S
+
+ P <--> The cumulation from 0 to S of the poisson density.
+ Input range: [0,1].
+
+ Q <--> 1-P.
+ Input range: (0, 1].
+ P + Q = 1.0.
+
+ S <--> Upper limit of cumulation of the Poisson.
+ Input range: [0, +infinity).
+ Search range: [0,1E100]
+
+ XLAM <--> Mean of the Poisson distribution.
+ Input range: [0, +infinity).
+ Search range: [0,1E100]
+
+ STATUS <-- 0 if calculation completed correctly
+ -I if input parameter number I is out of range
+ 1 if answer appears to be lower than lowest
+ search bound
+ 2 if answer appears to be higher than greatest
+ search bound
+ 3 if P + Q .ne. 1
+
+ BOUND <-- Undefined if STATUS is 0
+
+ Bound exceeded by parameter number I if STATUS
+ is negative.
+
+ Lower search bound if STATUS is 1.
+
+ Upper search bound if STATUS is 2.
+
+
+ Method
+
+
+ Formula 26.4.21 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions (1966) is used to reduce the computation
+ of the cumulative distribution function to that of computing a
+ chi-square, hence an incomplete gamma function.
+
+ Cumulative distribution function (P) is calculated directly.
+ Computation of other parameters involve a seach for a value that
+ produces the desired value of P. The search relies on the
+ monotinicity of P with the other parameter.
+
+**********************************************************************/
+{
+#define tol 1.0e-8
+#define atol 1.0e-50
+#define inf 1.0e100
+static int K1 = 1;
+static double K2 = 0.0e0;
+static double K4 = 0.5e0;
+static double K5 = 5.0e0;
+static double fx,cum,ccum,pq;
+static unsigned long qhi,qleft,qporq;
+static double T3,T6,T7,T8,T9,T10;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ Check arguments
+*/
+ if(!(*which < 1 || *which > 3)) goto S30;
+ if(!(*which < 1)) goto S10;
+ *bound = 1.0e0;
+ goto S20;
+S10:
+ *bound = 3.0e0;
+S20:
+ *status = -1;
+ return;
+S30:
+ if(*which == 1) goto S70;
+/*
+ P
+*/
+ if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
+ if(!(*p < 0.0e0)) goto S40;
+ *bound = 0.0e0;
+ goto S50;
+S40:
+ *bound = 1.0e0;
+S50:
+ *status = -2;
+ return;
+S70:
+S60:
+ if(*which == 1) goto S110;
+/*
+ Q
+*/
+ if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
+ if(!(*q <= 0.0e0)) goto S80;
+ *bound = 0.0e0;
+ goto S90;
+S80:
+ *bound = 1.0e0;
+S90:
+ *status = -3;
+ return;
+S110:
+S100:
+ if(*which == 2) goto S130;
+/*
+ S
+*/
+ if(!(*s < 0.0e0)) goto S120;
+ *bound = 0.0e0;
+ *status = -4;
+ return;
+S130:
+S120:
+ if(*which == 3) goto S150;
+/*
+ XLAM
+*/
+ if(!(*xlam < 0.0e0)) goto S140;
+ *bound = 0.0e0;
+ *status = -5;
+ return;
+S150:
+S140:
+ if(*which == 1) goto S190;
+/*
+ P + Q
+*/
+ pq = *p+*q;
+ if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S180;
+ if(!(pq < 0.0e0)) goto S160;
+ *bound = 0.0e0;
+ goto S170;
+S160:
+ *bound = 1.0e0;
+S170:
+ *status = 3;
+ return;
+S190:
+S180:
+ if(!(*which == 1)) qporq = *p <= *q;
+/*
+ Select the minimum of P or Q
+ Calculate ANSWERS
+*/
+ if(1 == *which) {
+/*
+ Calculating P
+*/
+ cumpoi(s,xlam,p,q);
+ *status = 0;
+ }
+ else if(2 == *which) {
+/*
+ Calculating S
+*/
+ *s = 5.0e0;
+ T3 = inf;
+ T6 = atol;
+ T7 = tol;
+ dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7);
+ *status = 0;
+ dinvr(status,s,&fx,&qleft,&qhi);
+S200:
+ if(!(*status == 1)) goto S230;
+ cumpoi(s,xlam,&cum,&ccum);
+ if(!qporq) goto S210;
+ fx = cum-*p;
+ goto S220;
+S210:
+ fx = ccum-*q;
+S220:
+ dinvr(status,s,&fx,&qleft,&qhi);
+ goto S200;
+S230:
+ if(!(*status == -1)) goto S260;
+ if(!qleft) goto S240;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S250;
+S240:
+ *status = 2;
+ *bound = inf;
+S260:
+S250:
+ ;
+ }
+ else if(3 == *which) {
+/*
+ Calculating XLAM
+*/
+ *xlam = 5.0e0;
+ T8 = inf;
+ T9 = atol;
+ T10 = tol;
+ dstinv(&K2,&T8,&K4,&K4,&K5,&T9,&T10);
+ *status = 0;
+ dinvr(status,xlam,&fx,&qleft,&qhi);
+S270:
+ if(!(*status == 1)) goto S300;
+ cumpoi(s,xlam,&cum,&ccum);
+ if(!qporq) goto S280;
+ fx = cum-*p;
+ goto S290;
+S280:
+ fx = ccum-*q;
+S290:
+ dinvr(status,xlam,&fx,&qleft,&qhi);
+ goto S270;
+S300:
+ if(!(*status == -1)) goto S330;
+ if(!qleft) goto S310;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S320;
+S310:
+ *status = 2;
+ *bound = inf;
+S320:
+ ;
+ }
+S330:
+ return;
+#undef tol
+#undef atol
+#undef inf
+}
+void cdft(int *which,double *p,double *q,double *t,double *df,
+ int *status,double *bound)
+/**********************************************************************
+
+ void cdft(int *which,double *p,double *q,double *t,double *df,
+ int *status,double *bound)
+
+ Cumulative Distribution Function
+ T distribution
+
+
+ Function
+
+
+ Calculates any one parameter of the t distribution given
+ values for the others.
+
+
+ Arguments
+
+
+ WHICH --> Integer indicating which argument
+ values is to be calculated from the others.
+ Legal range: 1..3
+ iwhich = 1 : Calculate P and Q from T and DF
+ iwhich = 2 : Calculate T from P,Q and DF
+ iwhich = 3 : Calculate DF from P,Q and T
+
+ P <--> The integral from -infinity to t of the t-density.
+ Input range: (0,1].
+
+ Q <--> 1-P.
+ Input range: (0, 1].
+ P + Q = 1.0.
+
+ T <--> Upper limit of integration of the t-density.
+ Input range: ( -infinity, +infinity).
+ Search range: [ -1E100, 1E100 ]
+
+ DF <--> Degrees of freedom of the t-distribution.
+ Input range: (0 , +infinity).
+ Search range: [1e-100, 1E10]
+
+ STATUS <-- 0 if calculation completed correctly
+ -I if input parameter number I is out of range
+ 1 if answer appears to be lower than lowest
+ search bound
+ 2 if answer appears to be higher than greatest
+ search bound
+ 3 if P + Q .ne. 1
+
+ BOUND <-- Undefined if STATUS is 0
+
+ Bound exceeded by parameter number I if STATUS
+ is negative.
+
+ Lower search bound if STATUS is 1.
+
+ Upper search bound if STATUS is 2.
+
+
+ Method
+
+
+ Formula 26.5.27 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions (1966) is used to reduce the computation
+ of the cumulative distribution function to that of an incomplete
+ beta.
+
+ Computation of other parameters involve a seach for a value that
+ produces the desired value of P. The search relies on the
+ monotinicity of P with the other parameter.
+
+**********************************************************************/
+{
+#define tol 1.0e-8
+#define atol 1.0e-50
+#define zero 1.0e-100
+#define inf 1.0e100
+#define rtinf 1.0e100
+#define maxdf 1.0e10
+static int K1 = 1;
+static double K4 = 0.5e0;
+static double K5 = 5.0e0;
+static double fx,cum,ccum,pq;
+static unsigned long qhi,qleft,qporq;
+static double T2,T3,T6,T7,T8,T9,T10,T11;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ Check arguments
+*/
+ if(!(*which < 1 || *which > 3)) goto S30;
+ if(!(*which < 1)) goto S10;
+ *bound = 1.0e0;
+ goto S20;
+S10:
+ *bound = 3.0e0;
+S20:
+ *status = -1;
+ return;
+S30:
+ if(*which == 1) goto S70;
+/*
+ P
+*/
+ if(!(*p <= 0.0e0 || *p > 1.0e0)) goto S60;
+ if(!(*p <= 0.0e0)) goto S40;
+ *bound = 0.0e0;
+ goto S50;
+S40:
+ *bound = 1.0e0;
+S50:
+ *status = -2;
+ return;
+S70:
+S60:
+ if(*which == 1) goto S110;
+/*
+ Q
+*/
+ if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
+ if(!(*q <= 0.0e0)) goto S80;
+ *bound = 0.0e0;
+ goto S90;
+S80:
+ *bound = 1.0e0;
+S90:
+ *status = -3;
+ return;
+S110:
+S100:
+ if(*which == 3) goto S130;
+/*
+ DF
+*/
+ if(!(*df <= 0.0e0)) goto S120;
+ *bound = 0.0e0;
+ *status = -5;
+ return;
+S130:
+S120:
+ if(*which == 1) goto S170;
+/*
+ P + Q
+*/
+ pq = *p+*q;
+ if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S160;
+ if(!(pq < 0.0e0)) goto S140;
+ *bound = 0.0e0;
+ goto S150;
+S140:
+ *bound = 1.0e0;
+S150:
+ *status = 3;
+ return;
+S170:
+S160:
+ if(!(*which == 1)) qporq = *p <= *q;
+/*
+ Select the minimum of P or Q
+ Calculate ANSWERS
+*/
+ if(1 == *which) {
+/*
+ Computing P and Q
+*/
+ cumt(t,df,p,q);
+ *status = 0;
+ }
+ else if(2 == *which) {
+/*
+ Computing T
+ .. Get initial approximation for T
+*/
+ *t = dt1(p,q,df);
+ T2 = -rtinf;
+ T3 = rtinf;
+ T6 = atol;
+ T7 = tol;
+ dstinv(&T2,&T3,&K4,&K4,&K5,&T6,&T7);
+ *status = 0;
+ dinvr(status,t,&fx,&qleft,&qhi);
+S180:
+ if(!(*status == 1)) goto S210;
+ cumt(t,df,&cum,&ccum);
+ if(!qporq) goto S190;
+ fx = cum-*p;
+ goto S200;
+S190:
+ fx = ccum-*q;
+S200:
+ dinvr(status,t,&fx,&qleft,&qhi);
+ goto S180;
+S210:
+ if(!(*status == -1)) goto S240;
+ if(!qleft) goto S220;
+ *status = 1;
+ *bound = -rtinf;
+ goto S230;
+S220:
+ *status = 2;
+ *bound = rtinf;
+S240:
+S230:
+ ;
+ }
+ else if(3 == *which) {
+/*
+ Computing DF
+*/
+ *df = 5.0e0;
+ T8 = zero;
+ T9 = maxdf;
+ T10 = atol;
+ T11 = tol;
+ dstinv(&T8,&T9,&K4,&K4,&K5,&T10,&T11);
+ *status = 0;
+ dinvr(status,df,&fx,&qleft,&qhi);
+S250:
+ if(!(*status == 1)) goto S280;
+ cumt(t,df,&cum,&ccum);
+ if(!qporq) goto S260;
+ fx = cum-*p;
+ goto S270;
+S260:
+ fx = ccum-*q;
+S270:
+ dinvr(status,df,&fx,&qleft,&qhi);
+ goto S250;
+S280:
+ if(!(*status == -1)) goto S310;
+ if(!qleft) goto S290;
+ *status = 1;
+ *bound = zero;
+ goto S300;
+S290:
+ *status = 2;
+ *bound = maxdf;
+S300:
+ ;
+ }
+S310:
+ return;
+#undef tol
+#undef atol
+#undef zero
+#undef inf
+#undef rtinf
+#undef maxdf
+}
+void cdftnc(int *which,double *p,double *q,double *t,double *df,
+ double *pnonc,int *status,double *bound)
+/**********************************************************************
+
+ void cdftnc(int *which,double *p,double *q,double *t,double *df,
+ double *pnonc,int *status,double *bound)
+
+ Cumulative Distribution Function
+ Non-Central T distribution
+
+ Function
+
+ Calculates any one parameter of the noncentral t distribution give
+ values for the others.
+
+ Arguments
+
+ WHICH --> Integer indicating which argument
+ values is to be calculated from the others.
+ Legal range: 1..3
+ iwhich = 1 : Calculate P and Q from T,DF,PNONC
+ iwhich = 2 : Calculate T from P,Q,DF,PNONC
+ iwhich = 3 : Calculate DF from P,Q,T
+ iwhich = 4 : Calculate PNONC from P,Q,DF,T
+
+ P <--> The integral from -infinity to t of the noncentral t-den
+ Input range: (0,1].
+
+ Q <--> 1-P.
+ Input range: (0, 1].
+ P + Q = 1.0.
+
+ T <--> Upper limit of integration of the noncentral t-density.
+ Input range: ( -infinity, +infinity).
+ Search range: [ -1E100, 1E100 ]
+
+ DF <--> Degrees of freedom of the noncentral t-distribution.
+ Input range: (0 , +infinity).
+ Search range: [1e-100, 1E10]
+
+ PNONC <--> Noncentrality parameter of the noncentral t-distributio
+ Input range: [-infinity , +infinity).
+ Search range: [-1e4, 1E4]
+
+ STATUS <-- 0 if calculation completed correctly
+ -I if input parameter number I is out of range
+ 1 if answer appears to be lower than lowest
+ search bound
+ 2 if answer appears to be higher than greatest
+ search bound
+ 3 if P + Q .ne. 1
+
+ BOUND <-- Undefined if STATUS is 0
+
+ Bound exceeded by parameter number I if STATUS
+ is negative.
+
+ Lower search bound if STATUS is 1.
+
+ Upper search bound if STATUS is 2.
+
+ Method
+
+ Upper tail of the cumulative noncentral t is calculated usin
+ formulae from page 532 of Johnson, Kotz, Balakrishnan, Coninuou
+ Univariate Distributions, Vol 2, 2nd Edition. Wiley (1995)
+
+ Computation of other parameters involve a seach for a value that
+ produces the desired value of P. The search relies on the
+ monotinicity of P with the other parameter.
+
+**********************************************************************/
+{
+#define tent4 1.0e4
+#define tol 1.0e-8
+#define atol 1.0e-50
+#define zero 1.0e-100
+#define one ( 1.0e0 - 1.0e-16 )
+#define inf 1.0e100
+static double K3 = 0.5e0;
+static double K4 = 5.0e0;
+static double ccum,cum,fx;
+static unsigned long qhi,qleft;
+static double T1,T2,T5,T6,T7,T8,T9,T10,T11,T12,T13,T14;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(!(*which < 1 || *which > 4)) goto S30;
+ if(!(*which < 1)) goto S10;
+ *bound = 1.0e0;
+ goto S20;
+S10:
+ *bound = 5.0e0;
+S20:
+ *status = -1;
+ return;
+S30:
+ if(*which == 1) goto S70;
+ if(!(*p < 0.0e0 || *p > one)) goto S60;
+ if(!(*p < 0.0e0)) goto S40;
+ *bound = 0.0e0;
+ goto S50;
+S40:
+ *bound = one;
+S50:
+ *status = -2;
+ return;
+S70:
+S60:
+ if(*which == 3) goto S90;
+ if(!(*df <= 0.0e0)) goto S80;
+ *bound = 0.0e0;
+ *status = -5;
+ return;
+S90:
+S80:
+ if(*which == 4) goto S100;
+S100:
+ if(1 == *which) {
+ cumtnc(t,df,pnonc,p,q);
+ *status = 0;
+ }
+ else if(2 == *which) {
+ *t = 5.0e0;
+ T1 = -inf;
+ T2 = inf;
+ T5 = atol;
+ T6 = tol;
+ dstinv(&T1,&T2,&K3,&K3,&K4,&T5,&T6);
+ *status = 0;
+ dinvr(status,t,&fx,&qleft,&qhi);
+S110:
+ if(!(*status == 1)) goto S120;
+ cumtnc(t,df,pnonc,&cum,&ccum);
+ fx = cum - *p;
+ dinvr(status,t,&fx,&qleft,&qhi);
+ goto S110;
+S120:
+ if(!(*status == -1)) goto S150;
+ if(!qleft) goto S130;
+ *status = 1;
+ *bound = -inf;
+ goto S140;
+S130:
+ *status = 2;
+ *bound = inf;
+S150:
+S140:
+ ;
+ }
+ else if(3 == *which) {
+ *df = 5.0e0;
+ T7 = zero;
+ T8 = tent4;
+ T9 = atol;
+ T10 = tol;
+ dstinv(&T7,&T8,&K3,&K3,&K4,&T9,&T10);
+ *status = 0;
+ dinvr(status,df,&fx,&qleft,&qhi);
+S160:
+ if(!(*status == 1)) goto S170;
+ cumtnc(t,df,pnonc,&cum,&ccum);
+ fx = cum - *p;
+ dinvr(status,df,&fx,&qleft,&qhi);
+ goto S160;
+S170:
+ if(!(*status == -1)) goto S200;
+ if(!qleft) goto S180;
+ *status = 1;
+ *bound = zero;
+ goto S190;
+S180:
+ *status = 2;
+ *bound = inf;
+S200:
+S190:
+ ;
+ }
+ else if(4 == *which) {
+ *pnonc = 5.0e0;
+ T11 = -tent4;
+ T12 = tent4;
+ T13 = atol;
+ T14 = tol;
+ dstinv(&T11,&T12,&K3,&K3,&K4,&T13,&T14);
+ *status = 0;
+ dinvr(status,pnonc,&fx,&qleft,&qhi);
+S210:
+ if(!(*status == 1)) goto S220;
+ cumtnc(t,df,pnonc,&cum,&ccum);
+ fx = cum - *p;
+ dinvr(status,pnonc,&fx,&qleft,&qhi);
+ goto S210;
+S220:
+ if(!(*status == -1)) goto S250;
+ if(!qleft) goto S230;
+ *status = 1;
+ *bound = 0.0e0;
+ goto S240;
+S230:
+ *status = 2;
+ *bound = tent4;
+S240:
+ ;
+ }
+S250:
+ return;
+#undef tent4
+#undef tol
+#undef atol
+#undef zero
+#undef one
+#undef inf
+}
+void cumbet(double *x,double *y,double *a,double *b,double *cum,
+ double *ccum)
+/*
+**********************************************************************
+
+ void cumbet(double *x,double *y,double *a,double *b,double *cum,
+ double *ccum)
+
+ Double precision cUMulative incomplete BETa distribution
+
+
+ Function
+
+
+ Calculates the cdf to X of the incomplete beta distribution
+ with parameters a and b. This is the integral from 0 to x
+ of (1/B(a,b))*f(t)) where f(t) = t**(a-1) * (1-t)**(b-1)
+
+
+ Arguments
+
+
+ X --> Upper limit of integration.
+ X is DOUBLE PRECISION
+
+ Y --> 1 - X.
+ Y is DOUBLE PRECISION
+
+ A --> First parameter of the beta distribution.
+ A is DOUBLE PRECISION
+
+ B --> Second parameter of the beta distribution.
+ B is DOUBLE PRECISION
+
+ CUM <-- Cumulative incomplete beta distribution.
+ CUM is DOUBLE PRECISION
+
+ CCUM <-- Compliment of Cumulative incomplete beta distribution.
+ CCUM is DOUBLE PRECISION
+
+
+ Method
+
+
+ Calls the routine BRATIO.
+
+ References
+
+ Didonato, Armido R. and Morris, Alfred H. Jr. (1992) Algorithim
+ 708 Significant Digit Computation of the Incomplete Beta Function
+ Ratios. ACM ToMS, Vol.18, No. 3, Sept. 1992, 360-373.
+
+**********************************************************************
+*/
+{
+static int ierr;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(!(*x <= 0.0e0)) goto S10;
+ *cum = 0.0e0;
+ *ccum = 1.0e0;
+ return;
+S10:
+ if(!(*y <= 0.0e0)) goto S20;
+ *cum = 1.0e0;
+ *ccum = 0.0e0;
+ return;
+S20:
+ bratio(a,b,x,y,cum,ccum,&ierr);
+/*
+ Call bratio routine
+*/
+ return;
+}
+void cumbin(double *s,double *xn,double *pr,double *ompr,
+ double *cum,double *ccum)
+/*
+**********************************************************************
+
+ void cumbin(double *s,double *xn,double *pr,double *ompr,
+ double *cum,double *ccum)
+
+ CUmulative BINomial distribution
+
+
+ Function
+
+
+ Returns the probability of 0 to S successes in XN binomial
+ trials, each of which has a probability of success, PBIN.
+
+
+ Arguments
+
+
+ S --> The upper limit of cumulation of the binomial distribution.
+ S is DOUBLE PRECISION
+
+ XN --> The number of binomial trials.
+ XN is DOUBLE PRECISIO
+
+ PBIN --> The probability of success in each binomial trial.
+ PBIN is DOUBLE PRECIS
+
+ OMPR --> 1 - PBIN
+ OMPR is DOUBLE PRECIS
+
+ CUM <-- Cumulative binomial distribution.
+ CUM is DOUBLE PRECISI
+
+ CCUM <-- Compliment of Cumulative binomial distribution.
+ CCUM is DOUBLE PRECIS
+
+
+ Method
+
+
+ Formula 26.5.24 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions (1966) is used to reduce the binomial
+ distribution to the cumulative beta distribution.
+
+**********************************************************************
+*/
+{
+static double T1,T2;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(!(*s < *xn)) goto S10;
+ T1 = *s+1.0e0;
+ T2 = *xn-*s;
+ cumbet(pr,ompr,&T1,&T2,ccum,cum);
+ goto S20;
+S10:
+ *cum = 1.0e0;
+ *ccum = 0.0e0;
+S20:
+ return;
+}
+void cumchi(double *x,double *df,double *cum,double *ccum)
+/*
+**********************************************************************
+
+ void cumchi(double *x,double *df,double *cum,double *ccum)
+ CUMulative of the CHi-square distribution
+
+
+ Function
+
+
+ Calculates the cumulative chi-square distribution.
+
+
+ Arguments
+
+
+ X --> Upper limit of integration of the
+ chi-square distribution.
+ X is DOUBLE PRECISION
+
+ DF --> Degrees of freedom of the
+ chi-square distribution.
+ DF is DOUBLE PRECISION
+
+ CUM <-- Cumulative chi-square distribution.
+ CUM is DOUBLE PRECISIO
+
+ CCUM <-- Compliment of Cumulative chi-square distribution.
+ CCUM is DOUBLE PRECISI
+
+
+ Method
+
+
+ Calls incomplete gamma function (CUMGAM)
+
+**********************************************************************
+*/
+{
+static double a,xx;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ a = *df*0.5e0;
+ xx = *x*0.5e0;
+ cumgam(&xx,&a,cum,ccum);
+ return;
+}
+void cumchn(double *x,double *df,double *pnonc,double *cum,
+ double *ccum)
+/**********************************************************************
+
+ void cumchn(double *x,double *df,double *pnonc,double *cum,
+ double *ccum)
+
+ CUMulative of the Non-central CHi-square distribution
+
+ Function
+
+ Calculates the cumulative non-central chi-square
+ distribution, i.e., the probability that a random variable
+ which follows the non-central chi-square distribution, with
+ non-centrality parameter PNONC and continuous degrees of
+ freedom DF, is less than or equal to X.
+
+ Arguments
+
+ X --> Upper limit of integration of the non-central
+ chi-square distribution.
+
+ DF --> Degrees of freedom of the non-central
+ chi-square distribution.
+
+ PNONC --> Non-centrality parameter of the non-central
+ chi-square distribution.
+
+ CUM <-- Cumulative non-central chi-square distribution.
+
+ CCUM <-- Compliment of Cumulative non-central chi-square distribut
+
+
+ Method
+
+ Uses formula 26.4.25 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions, US NBS (1966) to calculate the
+ non-central chi-square.
+
+ Variables
+
+ EPS --- Convergence criterion. The sum stops when a
+ term is less than EPS*SUM.
+
+ CCUM <-- Compliment of Cumulative non-central
+ chi-square distribution.
+
+**********************************************************************/
+{
+#define dg(i) (*df + 2.0e0 * (double)(i))
+#define qsmall(xx) (int)(sum < 1.0e-20 || (xx) < eps * sum)
+static double eps = 1.0e-5;
+static double adj,centaj,centwt,chid2,dfd2,lcntaj,lcntwt,lfact,pcent,pterm,sum,
+ sumadj,term,wt,xnonc;
+static int i,icent;
+static double T1,T2,T3;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(!(*x <= 0.0e0)) goto S10;
+ *cum = 0.0e0;
+ *ccum = 1.0e0;
+ return;
+S10:
+ if(!(*pnonc <= 1.0e-10 )) goto S20;
+/*
+ When non-centrality parameter is (essentially) zero,
+ use cumulative chi-square distribution
+*/
+ cumchi(x,df,cum,ccum);
+ return;
+S20:
+ xnonc = *pnonc / 2.0e0;
+/*
+***********************************************************************
+ The following code calcualtes the weight, chi-square, and
+ adjustment term for the central term in the infinite series.
+ The central term is the one in which the poisson weight is
+ greatest. The adjustment term is the amount that must
+ be subtracted from the chi-square to move up two degrees
+ of freedom.
+***********************************************************************
+*/
+ icent = fifidint(xnonc);
+ if(icent == 0) icent = 1;
+ chid2 = *x / 2.0e0;
+/*
+ Calculate central weight term
+*/
+ T1 = (double)(icent + 1);
+ lfact = alngam(&T1);
+ lcntwt = -xnonc + (double)icent * log(xnonc) - lfact;
+ centwt = exp(lcntwt);
+/*
+ Calculate central chi-square
+*/
+ T2 = dg(icent);
+ cumchi(x,&T2,&pcent,ccum);
+/*
+ Calculate central adjustment term
+*/
+ dfd2 = dg(icent) / 2.0e0;
+ T3 = 1.0e0 + dfd2;
+ lfact = alngam(&T3);
+ lcntaj = dfd2 * log(chid2) - chid2 - lfact;
+ centaj = exp(lcntaj);
+ sum = centwt * pcent;
+/*
+***********************************************************************
+ Sum backwards from the central term towards zero.
+ Quit whenever either
+ (1) the zero term is reached, or
+ (2) the term gets small relative to the sum
+***********************************************************************
+*/
+ sumadj = 0.0e0;
+ adj = centaj;
+ wt = centwt;
+ i = icent;
+ goto S40;
+S30:
+ if(qsmall(term) || i == 0) goto S50;
+S40:
+ dfd2 = dg(i) / 2.0e0;
+/*
+ Adjust chi-square for two fewer degrees of freedom.
+ The adjusted value ends up in PTERM.
+*/
+ adj = adj * dfd2 / chid2;
+ sumadj += adj;
+ pterm = pcent + sumadj;
+/*
+ Adjust poisson weight for J decreased by one
+*/
+ wt *= ((double)i / xnonc);
+ term = wt * pterm;
+ sum += term;
+ i -= 1;
+ goto S30;
+S50:
+/*
+***********************************************************************
+ Now sum forward from the central term towards infinity.
+ Quit when either
+ (1) the term gets small relative to the sum, or
+***********************************************************************
+*/
+ sumadj = adj = centaj;
+ wt = centwt;
+ i = icent;
+ goto S70;
+S60:
+ if(qsmall(term)) goto S80;
+S70:
+/*
+ Update weights for next higher J
+*/
+ wt *= (xnonc / (double)(i + 1));
+/*
+ Calculate PTERM and add term to sum
+*/
+ pterm = pcent - sumadj;
+ term = wt * pterm;
+ sum += term;
+/*
+ Update adjustment term for DF for next iteration
+*/
+ i += 1;
+ dfd2 = dg(i) / 2.0e0;
+ adj = adj * chid2 / dfd2;
+ sumadj += adj;
+ goto S60;
+S80:
+ *cum = sum;
+ *ccum = 0.5e0 + (0.5e0 - *cum);
+ return;
+#undef dg
+#undef qsmall
+}
+void cumf(double *f,double *dfn,double *dfd,double *cum,double *ccum)
+/*
+**********************************************************************
+
+ void cumf(double *f,double *dfn,double *dfd,double *cum,double *ccum)
+ CUMulative F distribution
+
+
+ Function
+
+
+ Computes the integral from 0 to F of the f-density with DFN
+ and DFD degrees of freedom.
+
+
+ Arguments
+
+
+ F --> Upper limit of integration of the f-density.
+ F is DOUBLE PRECISION
+
+ DFN --> Degrees of freedom of the numerator sum of squares.
+ DFN is DOUBLE PRECISI
+
+ DFD --> Degrees of freedom of the denominator sum of squares.
+ DFD is DOUBLE PRECISI
+
+ CUM <-- Cumulative f distribution.
+ CUM is DOUBLE PRECISI
+
+ CCUM <-- Compliment of Cumulative f distribution.
+ CCUM is DOUBLE PRECIS
+
+
+ Method
+
+
+ Formula 26.5.28 of Abramowitz and Stegun is used to reduce
+ the cumulative F to a cumulative beta distribution.
+
+
+ Note
+
+
+ If F is less than or equal to 0, 0 is returned.
+
+**********************************************************************
+*/
+{
+#define half 0.5e0
+#define done 1.0e0
+static double dsum,prod,xx,yy;
+static int ierr;
+static double T1,T2;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(!(*f <= 0.0e0)) goto S10;
+ *cum = 0.0e0;
+ *ccum = 1.0e0;
+ return;
+S10:
+ prod = *dfn**f;
+/*
+ XX is such that the incomplete beta with parameters
+ DFD/2 and DFN/2 evaluated at XX is 1 - CUM or CCUM
+ YY is 1 - XX
+ Calculate the smaller of XX and YY accurately
+*/
+ dsum = *dfd+prod;
+ xx = *dfd/dsum;
+ if(xx > half) {
+ yy = prod/dsum;
+ xx = done-yy;
+ }
+ else yy = done-xx;
+ T1 = *dfd*half;
+ T2 = *dfn*half;
+ bratio(&T1,&T2,&xx,&yy,ccum,cum,&ierr);
+ return;
+#undef half
+#undef done
+}
+void cumfnc(double *f,double *dfn,double *dfd,double *pnonc,
+ double *cum,double *ccum)
+/*
+**********************************************************************
+
+ F -NON- -C-ENTRAL F DISTRIBUTION
+
+
+
+ Function
+
+
+ COMPUTES NONCENTRAL F DISTRIBUTION WITH DFN AND DFD
+ DEGREES OF FREEDOM AND NONCENTRALITY PARAMETER PNONC
+
+
+ Arguments
+
+
+ X --> UPPER LIMIT OF INTEGRATION OF NONCENTRAL F IN EQUATION
+
+ DFN --> DEGREES OF FREEDOM OF NUMERATOR
+
+ DFD --> DEGREES OF FREEDOM OF DENOMINATOR
+
+ PNONC --> NONCENTRALITY PARAMETER.
+
+ CUM <-- CUMULATIVE NONCENTRAL F DISTRIBUTION
+
+ CCUM <-- COMPLIMENT OF CUMMULATIVE
+
+
+ Method
+
+
+ USES FORMULA 26.6.20 OF REFERENCE FOR INFINITE SERIES.
+ SERIES IS CALCULATED BACKWARD AND FORWARD FROM J = LAMBDA/2
+ (THIS IS THE TERM WITH THE LARGEST POISSON WEIGHT) UNTIL
+ THE CONVERGENCE CRITERION IS MET.
+
+ FOR SPEED, THE INCOMPLETE BETA FUNCTIONS ARE EVALUATED
+ BY FORMULA 26.5.16.
+
+
+ REFERENCE
+
+
+ HANDBOOD OF MATHEMATICAL FUNCTIONS
+ EDITED BY MILTON ABRAMOWITZ AND IRENE A. STEGUN
+ NATIONAL BUREAU OF STANDARDS APPLIED MATEMATICS SERIES - 55
+ MARCH 1965
+ P 947, EQUATIONS 26.6.17, 26.6.18
+
+
+ Note
+
+
+ THE SUM CONTINUES UNTIL A SUCCEEDING TERM IS LESS THAN EPS
+ TIMES THE SUM (OR THE SUM IS LESS THAN 1.0E-20). EPS IS
+ SET TO 1.0E-4 IN A DATA STATEMENT WHICH CAN BE CHANGED.
+
+**********************************************************************
+*/
+{
+#define qsmall(x) (int)(sum < 1.0e-20 || (x) < eps*sum)
+#define half 0.5e0
+#define done 1.0e0
+static double eps = 1.0e-4;
+static double dsum,dummy,prod,xx,yy,adn,aup,b,betdn,betup,centwt,dnterm,sum,
+ upterm,xmult,xnonc;
+static int i,icent,ierr;
+static double T1,T2,T3,T4,T5,T6;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(!(*f <= 0.0e0)) goto S10;
+ *cum = 0.0e0;
+ *ccum = 1.0e0;
+ return;
+S10:
+ if(!(*pnonc < 1.0e-10)) goto S20;
+/*
+ Handle case in which the non-centrality parameter is
+ (essentially) zero.
+*/
+ cumf(f,dfn,dfd,cum,ccum);
+ return;
+S20:
+ xnonc = *pnonc/2.0e0;
+/*
+ Calculate the central term of the poisson weighting factor.
+*/
+ icent = (long)(xnonc);
+ if(icent == 0) icent = 1;
+/*
+ Compute central weight term
+*/
+ T1 = (double)(icent+1);
+ centwt = exp(-xnonc+(double)icent*log(xnonc)-alngam(&T1));
+/*
+ Compute central incomplete beta term
+ Assure that minimum of arg to beta and 1 - arg is computed
+ accurately.
+*/
+ prod = *dfn**f;
+ dsum = *dfd+prod;
+ yy = *dfd/dsum;
+ if(yy > half) {
+ xx = prod/dsum;
+ yy = done-xx;
+ }
+ else xx = done-yy;
+ T2 = *dfn*half+(double)icent;
+ T3 = *dfd*half;
+ bratio(&T2,&T3,&xx,&yy,&betdn,&dummy,&ierr);
+ adn = *dfn/2.0e0+(double)icent;
+ aup = adn;
+ b = *dfd/2.0e0;
+ betup = betdn;
+ sum = centwt*betdn;
+/*
+ Now sum terms backward from icent until convergence or all done
+*/
+ xmult = centwt;
+ i = icent;
+ T4 = adn+b;
+ T5 = adn+1.0e0;
+ dnterm = exp(alngam(&T4)-alngam(&T5)-alngam(&b)+adn*log(xx)+b*log(yy));
+S30:
+ if(qsmall(xmult*betdn) || i <= 0) goto S40;
+ xmult *= ((double)i/xnonc);
+ i -= 1;
+ adn -= 1.0;
+ dnterm = (adn+1.0)/((adn+b)*xx)*dnterm;
+ betdn += dnterm;
+ sum += (xmult*betdn);
+ goto S30;
+S40:
+ i = icent+1;
+/*
+ Now sum forwards until convergence
+*/
+ xmult = centwt;
+ if(aup-1.0+b == 0) upterm = exp(-alngam(&aup)-alngam(&b)+(aup-1.0)*log(xx)+
+ b*log(yy));
+ else {
+ T6 = aup-1.0+b;
+ upterm = exp(alngam(&T6)-alngam(&aup)-alngam(&b)+(aup-1.0)*log(xx)+b*
+ log(yy));
+ }
+ goto S60;
+S50:
+ if(qsmall(xmult*betup)) goto S70;
+S60:
+ xmult *= (xnonc/(double)i);
+ i += 1;
+ aup += 1.0;
+ upterm = (aup+b-2.0e0)*xx/(aup-1.0)*upterm;
+ betup -= upterm;
+ sum += (xmult*betup);
+ goto S50;
+S70:
+ *cum = sum;
+ *ccum = 0.5e0+(0.5e0-*cum);
+ return;
+#undef qsmall
+#undef half
+#undef done
+}
+void cumgam(double *x,double *a,double *cum,double *ccum)
+/*
+**********************************************************************
+
+ void cumgam(double *x,double *a,double *cum,double *ccum)
+ Double precision cUMulative incomplete GAMma distribution
+
+
+ Function
+
+
+ Computes the cumulative of the incomplete gamma
+ distribution, i.e., the integral from 0 to X of
+ (1/GAM(A))*EXP(-T)*T**(A-1) DT
+ where GAM(A) is the complete gamma function of A, i.e.,
+ GAM(A) = integral from 0 to infinity of
+ EXP(-T)*T**(A-1) DT
+
+
+ Arguments
+
+
+ X --> The upper limit of integration of the incomplete gamma.
+ X is DOUBLE PRECISION
+
+ A --> The shape parameter of the incomplete gamma.
+ A is DOUBLE PRECISION
+
+ CUM <-- Cumulative incomplete gamma distribution.
+ CUM is DOUBLE PRECISION
+
+ CCUM <-- Compliment of Cumulative incomplete gamma distribution.
+ CCUM is DOUBLE PRECISIO
+
+
+ Method
+
+
+ Calls the routine GRATIO.
+
+**********************************************************************
+*/
+{
+static int K1 = 0;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(!(*x <= 0.0e0)) goto S10;
+ *cum = 0.0e0;
+ *ccum = 1.0e0;
+ return;
+S10:
+ gratio(a,x,cum,ccum,&K1);
+/*
+ Call gratio routine
+*/
+ return;
+}
+void cumnbn(double *s,double *xn,double *pr,double *ompr,
+ double *cum,double *ccum)
+/*
+**********************************************************************
+
+ void cumnbn(double *s,double *xn,double *pr,double *ompr,
+ double *cum,double *ccum)
+
+ CUmulative Negative BINomial distribution
+
+
+ Function
+
+
+ Returns the probability that it there will be S or fewer failures
+ before there are XN successes, with each binomial trial having
+ a probability of success PR.
+
+ Prob(# failures = S | XN successes, PR) =
+ ( XN + S - 1 )
+ ( ) * PR^XN * (1-PR)^S
+ ( S )
+
+
+ Arguments
+
+
+ S --> The number of failures
+ S is DOUBLE PRECISION
+
+ XN --> The number of successes
+ XN is DOUBLE PRECISIO
+
+ PR --> The probability of success in each binomial trial.
+ PR is DOUBLE PRECISIO
+
+ OMPR --> 1 - PR
+ OMPR is DOUBLE PRECIS
+
+ CUM <-- Cumulative negative binomial distribution.
+ CUM is DOUBLE PRECISI
+
+ CCUM <-- Compliment of Cumulative negative binomial distribution.
+ CCUM is DOUBLE PRECIS
+
+
+ Method
+
+
+ Formula 26.5.26 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions (1966) is used to reduce the negative
+ binomial distribution to the cumulative beta distribution.
+
+**********************************************************************
+*/
+{
+static double T1;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ T1 = *s+1.e0;
+ cumbet(pr,ompr,xn,&T1,cum,ccum);
+ return;
+}
+void cumnor(double *arg,double *result,double *ccum)
+/*
+**********************************************************************
+
+ void cumnor(double *arg,double *result,double *ccum)
+
+
+ Function
+
+
+ Computes the cumulative of the normal distribution, i.e.,
+ the integral from -infinity to x of
+ (1/sqrt(2*pi)) exp(-u*u/2) du
+
+ X --> Upper limit of integration.
+ X is DOUBLE PRECISION
+
+ RESULT <-- Cumulative normal distribution.
+ RESULT is DOUBLE PRECISION
+
+ CCUM <-- Compliment of Cumulative normal distribution.
+ CCUM is DOUBLE PRECISION
+
+ Renaming of function ANORM from:
+
+ Cody, W.D. (1993). "ALGORITHM 715: SPECFUN - A Portabel FORTRAN
+ Package of Special Function Routines and Test Drivers"
+ acm Transactions on Mathematical Software. 19, 22-32.
+
+ with slight modifications to return ccum and to deal with
+ machine constants.
+
+**********************************************************************
+ Original Comments:
+------------------------------------------------------------------
+
+ This function evaluates the normal distribution function:
+
+ / x
+ 1 | -t*t/2
+ P(x) = ----------- | e dt
+ sqrt(2 pi) |
+ /-oo
+
+ The main computation evaluates near-minimax approximations
+ derived from those in "Rational Chebyshev approximations for
+ the error function" by W. J. Cody, Math. Comp., 1969, 631-637.
+ This transportable program uses rational functions that
+ theoretically approximate the normal distribution function to
+ at least 18 significant decimal digits. The accuracy achieved
+ depends on the arithmetic system, the compiler, the intrinsic
+ functions, and proper selection of the machine-dependent
+ constants.
+
+*******************************************************************
+*******************************************************************
+
+ Explanation of machine-dependent constants.
+
+ MIN = smallest machine representable number.
+
+ EPS = argument below which anorm(x) may be represented by
+ 0.5 and above which x*x will not underflow.
+ A conservative value is the largest machine number X
+ such that 1.0 + X = 1.0 to machine precision.
+*******************************************************************
+*******************************************************************
+
+ Error returns
+
+ The program returns ANORM = 0 for ARG .LE. XLOW.
+
+
+ Intrinsic functions required are:
+
+ ABS, AINT, EXP
+
+
+ Author: W. J. Cody
+ Mathematics and Computer Science Division
+ Argonne National Laboratory
+ Argonne, IL 60439
+
+ Latest modification: March 15, 1992
+
+------------------------------------------------------------------
+*/
+{
+static double a[5] = {
+ 2.2352520354606839287e00,1.6102823106855587881e02,1.0676894854603709582e03,
+ 1.8154981253343561249e04,6.5682337918207449113e-2
+};
+static double b[4] = {
+ 4.7202581904688241870e01,9.7609855173777669322e02,1.0260932208618978205e04,
+ 4.5507789335026729956e04
+};
+static double c[9] = {
+ 3.9894151208813466764e-1,8.8831497943883759412e00,9.3506656132177855979e01,
+ 5.9727027639480026226e02,2.4945375852903726711e03,6.8481904505362823326e03,
+ 1.1602651437647350124e04,9.8427148383839780218e03,1.0765576773720192317e-8
+};
+static double d[8] = {
+ 2.2266688044328115691e01,2.3538790178262499861e02,1.5193775994075548050e03,
+ 6.4855582982667607550e03,1.8615571640885098091e04,3.4900952721145977266e04,
+ 3.8912003286093271411e04,1.9685429676859990727e04
+};
+static double half = 0.5e0;
+static double p[6] = {
+ 2.1589853405795699e-1,1.274011611602473639e-1,2.2235277870649807e-2,
+ 1.421619193227893466e-3,2.9112874951168792e-5,2.307344176494017303e-2
+};
+static double one = 1.0e0;
+static double q[5] = {
+ 1.28426009614491121e00,4.68238212480865118e-1,6.59881378689285515e-2,
+ 3.78239633202758244e-3,7.29751555083966205e-5
+};
+static double sixten = 1.60e0;
+static double sqrpi = 3.9894228040143267794e-1;
+static double thrsh = 0.66291e0;
+static double root32 = 5.656854248e0;
+static double zero = 0.0e0;
+static int K1 = 1;
+static int K2 = 2;
+static int i;
+static double del,eps,temp,x,xden,xnum,y,xsq,min;
+/*
+------------------------------------------------------------------
+ Machine dependent constants
+------------------------------------------------------------------
+*/
+ eps = spmpar(&K1)*0.5e0;
+ min = spmpar(&K2);
+ x = *arg;
+ y = fabs(x);
+ if(y <= thrsh) {
+/*
+------------------------------------------------------------------
+ Evaluate anorm for |X| <= 0.66291
+------------------------------------------------------------------
+*/
+ xsq = zero;
+ if(y > eps) xsq = x*x;
+ xnum = a[4]*xsq;
+ xden = xsq;
+ for(i=0; i<3; i++) {
+ xnum = (xnum+a[i])*xsq;
+ xden = (xden+b[i])*xsq;
+ }
+ *result = x*(xnum+a[3])/(xden+b[3]);
+ temp = *result;
+ *result = half+temp;
+ *ccum = half-temp;
+ }
+/*
+------------------------------------------------------------------
+ Evaluate anorm for 0.66291 <= |X| <= sqrt(32)
+------------------------------------------------------------------
+*/
+ else if(y <= root32) {
+ xnum = c[8]*y;
+ xden = y;
+ for(i=0; i<7; i++) {
+ xnum = (xnum+c[i])*y;
+ xden = (xden+d[i])*y;
+ }
+ *result = (xnum+c[7])/(xden+d[7]);
+ xsq = fifdint(y*sixten)/sixten;
+ del = (y-xsq)*(y+xsq);
+ *result = exp(-(xsq*xsq*half))*exp(-(del*half))**result;
+ *ccum = one-*result;
+ if(x > zero) {
+ temp = *result;
+ *result = *ccum;
+ *ccum = temp;
+ }
+ }
+/*
+------------------------------------------------------------------
+ Evaluate anorm for |X| > sqrt(32)
+------------------------------------------------------------------
+*/
+ else {
+ *result = zero;
+ xsq = one/(x*x);
+ xnum = p[5]*xsq;
+ xden = xsq;
+ for(i=0; i<4; i++) {
+ xnum = (xnum+p[i])*xsq;
+ xden = (xden+q[i])*xsq;
+ }
+ *result = xsq*(xnum+p[4])/(xden+q[4]);
+ *result = (sqrpi-*result)/y;
+ xsq = fifdint(x*sixten)/sixten;
+ del = (x-xsq)*(x+xsq);
+ *result = exp(-(xsq*xsq*half))*exp(-(del*half))**result;
+ *ccum = one-*result;
+ if(x > zero) {
+ temp = *result;
+ *result = *ccum;
+ *ccum = temp;
+ }
+ }
+ if(*result < min) *result = 0.0e0;
+/*
+------------------------------------------------------------------
+ Fix up for negative argument, erf, etc.
+------------------------------------------------------------------
+----------Last card of ANORM ----------
+*/
+ if(*ccum < min) *ccum = 0.0e0;
+}
+void cumpoi(double *s,double *xlam,double *cum,double *ccum)
+/*
+**********************************************************************
+
+ void cumpoi(double *s,double *xlam,double *cum,double *ccum)
+ CUMulative POIsson distribution
+
+
+ Function
+
+
+ Returns the probability of S or fewer events in a Poisson
+ distribution with mean XLAM.
+
+
+ Arguments
+
+
+ S --> Upper limit of cumulation of the Poisson.
+ S is DOUBLE PRECISION
+
+ XLAM --> Mean of the Poisson distribution.
+ XLAM is DOUBLE PRECIS
+
+ CUM <-- Cumulative poisson distribution.
+ CUM is DOUBLE PRECISION
+
+ CCUM <-- Compliment of Cumulative poisson distribution.
+ CCUM is DOUBLE PRECIS
+
+
+ Method
+
+
+ Uses formula 26.4.21 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions to reduce the cumulative Poisson to
+ the cumulative chi-square distribution.
+
+**********************************************************************
+*/
+{
+static double chi,df;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ df = 2.0e0*(*s+1.0e0);
+ chi = 2.0e0**xlam;
+ cumchi(&chi,&df,ccum,cum);
+ return;
+}
+void cumt(double *t,double *df,double *cum,double *ccum)
+/*
+**********************************************************************
+
+ void cumt(double *t,double *df,double *cum,double *ccum)
+ CUMulative T-distribution
+
+
+ Function
+
+
+ Computes the integral from -infinity to T of the t-density.
+
+
+ Arguments
+
+
+ T --> Upper limit of integration of the t-density.
+ T is DOUBLE PRECISION
+
+ DF --> Degrees of freedom of the t-distribution.
+ DF is DOUBLE PRECISIO
+
+ CUM <-- Cumulative t-distribution.
+ CCUM is DOUBLE PRECIS
+
+ CCUM <-- Compliment of Cumulative t-distribution.
+ CCUM is DOUBLE PRECIS
+
+
+ Method
+
+
+ Formula 26.5.27 of Abramowitz and Stegun, Handbook of
+ Mathematical Functions is used to reduce the t-distribution
+ to an incomplete beta.
+
+**********************************************************************
+*/
+{
+static double K2 = 0.5e0;
+static double xx,a,oma,tt,yy,dfptt,T1;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ tt = *t**t;
+ dfptt = *df+tt;
+ xx = *df/dfptt;
+ yy = tt/dfptt;
+ T1 = 0.5e0**df;
+ cumbet(&xx,&yy,&T1,&K2,&a,&oma);
+ if(!(*t <= 0.0e0)) goto S10;
+ *cum = 0.5e0*a;
+ *ccum = oma+*cum;
+ goto S20;
+S10:
+ *ccum = 0.5e0*a;
+ *cum = oma+*ccum;
+S20:
+ return;
+}
+void cumtnc(double *t,double *df,double *pnonc,double *cum,
+ double *ccum)
+/**********************************************************************
+
+ void cumtnc(double *t,double *df,double *pnonc,double *cum,
+ double *ccum)
+
+ CUMulative Non-Central T-distribution
+
+
+ Function
+
+
+ Computes the integral from -infinity to T of the non-central
+ t-density.
+
+
+ Arguments
+
+
+ T --> Upper limit of integration of the non-central t-density.
+
+ DF --> Degrees of freedom of the non-central t-distribution.
+
+ PNONC --> Non-centrality parameter of the non-central t distibutio
+
+ CUM <-- Cumulative t-distribution.
+
+ CCUM <-- Compliment of Cumulative t-distribution.
+
+
+ Method
+
+ Upper tail of the cumulative noncentral t using
+ formulae from page 532 of Johnson, Kotz, Balakrishnan, Coninuous
+ Univariate Distributions, Vol 2, 2nd Edition. Wiley (1995)
+
+ This implementation starts the calculation at i = lambda,
+ which is near the largest Di. It then sums forward and backward.
+**********************************************************************/
+{
+#define one 1.0e0
+#define zero 0.0e0
+#define half 0.5e0
+#define two 2.0e0
+#define onep5 1.5e0
+#define conv 1.0e-7
+#define tiny 1.0e-10
+static double alghdf,b,bb,bbcent,bcent,cent,d,dcent,dpnonc,dum1,dum2,e,ecent,
+ halfdf,lambda,lnomx,lnx,omx,pnonc2,s,scent,ss,sscent,t2,term,tt,twoi,x,xi,
+ xlnd,xlne;
+static int ierr;
+static unsigned long qrevs;
+static double T1,T2,T3,T4,T5,T6,T7,T8,T9,T10;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ Case pnonc essentially zero
+*/
+ if(fabs(*pnonc) <= tiny) {
+ cumt(t,df,cum,ccum);
+ return;
+ }
+ qrevs = *t < zero;
+ if(qrevs) {
+ tt = -*t;
+ dpnonc = -*pnonc;
+ }
+ else {
+ tt = *t;
+ dpnonc = *pnonc;
+ }
+ pnonc2 = dpnonc * dpnonc;
+ t2 = tt * tt;
+ if(fabs(tt) <= tiny) {
+ T1 = -*pnonc;
+ cumnor(&T1,cum,ccum);
+ return;
+ }
+ lambda = half * pnonc2;
+ x = *df / (*df + t2);
+ omx = one - x;
+ lnx = log(x);
+ lnomx = log(omx);
+ halfdf = half * *df;
+ alghdf = gamln(&halfdf);
+/*
+ ******************** Case i = lambda
+*/
+ cent = fifidint(lambda);
+ if(cent < one) cent = one;
+/*
+ Compute d=T(2i) in log space and offset by exp(-lambda)
+*/
+ T2 = cent + one;
+ xlnd = cent * log(lambda) - gamln(&T2) - lambda;
+ dcent = exp(xlnd);
+/*
+ Compute e=t(2i+1) in log space offset by exp(-lambda)
+*/
+ T3 = cent + onep5;
+ xlne = (cent + half) * log(lambda) - gamln(&T3) - lambda;
+ ecent = exp(xlne);
+ if(dpnonc < zero) ecent = -ecent;
+/*
+ Compute bcent=B(2*cent)
+*/
+ T4 = cent + half;
+ bratio(&halfdf,&T4,&x,&omx,&bcent,&dum1,&ierr);
+/*
+ compute bbcent=B(2*cent+1)
+*/
+ T5 = cent + one;
+ bratio(&halfdf,&T5,&x,&omx,&bbcent,&dum2,&ierr);
+/*
+ Case bcent and bbcent are essentially zero
+ Thus t is effectively infinite
+*/
+ if(bcent + bbcent < tiny) {
+ if(qrevs) {
+ *cum = zero;
+ *ccum = one;
+ }
+ else {
+ *cum = one;
+ *ccum = zero;
+ }
+ return;
+ }
+/*
+ Case bcent and bbcent are essentially one
+ Thus t is effectively zero
+*/
+ if(dum1 + dum2 < tiny) {
+ T6 = -*pnonc;
+ cumnor(&T6,cum,ccum);
+ return;
+ }
+/*
+ First term in ccum is D*B + E*BB
+*/
+ *ccum = dcent * bcent + ecent * bbcent;
+/*
+ compute s(cent) = B(2*(cent+1)) - B(2*cent))
+*/
+ T7 = halfdf + cent + half;
+ T8 = cent + onep5;
+ scent = gamln(&T7) - gamln(&T8) - alghdf + halfdf * lnx + (cent + half) *
+ lnomx;
+ scent = exp(scent);
+/*
+ compute ss(cent) = B(2*cent+3) - B(2*cent+1)
+*/
+ T9 = halfdf + cent + one;
+ T10 = cent + two;
+ sscent = gamln(&T9) - gamln(&T10) - alghdf + halfdf * lnx + (cent + one) *
+ lnomx;
+ sscent = exp(sscent);
+/*
+ ******************** Sum Forward
+*/
+ xi = cent + one;
+ twoi = two * xi;
+ d = dcent;
+ e = ecent;
+ b = bcent;
+ bb = bbcent;
+ s = scent;
+ ss = sscent;
+S10:
+ b += s;
+ bb += ss;
+ d = lambda / xi * d;
+ e = lambda / (xi + half) * e;
+ term = d * b + e * bb;
+ *ccum += term;
+ s = s * omx * (*df + twoi - one) / (twoi + one);
+ ss = ss * omx * (*df + twoi) / (twoi + two);
+ xi += one;
+ twoi = two * xi;
+ if(fabs(term) > conv * *ccum) goto S10;
+/*
+ ******************** Sum Backward
+*/
+ xi = cent;
+ twoi = two * xi;
+ d = dcent;
+ e = ecent;
+ b = bcent;
+ bb = bbcent;
+ s = scent * (one + twoi) / ((*df + twoi - one) * omx);
+ ss = sscent * (two + twoi) / ((*df + twoi) * omx);
+S20:
+ b -= s;
+ bb -= ss;
+ d *= (xi / lambda);
+ e *= ((xi + half) / lambda);
+ term = d * b + e * bb;
+ *ccum += term;
+ xi -= one;
+ if(xi < half) goto S30;
+ twoi = two * xi;
+ s = s * (one + twoi) / ((*df + twoi - one) * omx);
+ ss = ss * (two + twoi) / ((*df + twoi) * omx);
+ if(fabs(term) > conv * *ccum) goto S20;
+S30:
+ if(qrevs) {
+ *cum = half * *ccum;
+ *ccum = one - *cum;
+ }
+ else {
+ *ccum = half * *ccum;
+ *cum = one - *ccum;
+ }
+/*
+ Due to roundoff error the answer may not lie between zero and one
+ Force it to do so
+*/
+ *cum = fifdmax1(fifdmin1(*cum,one),zero);
+ *ccum = fifdmax1(fifdmin1(*ccum,one),zero);
+ return;
+#undef one
+#undef zero
+#undef half
+#undef two
+#undef onep5
+#undef conv
+#undef tiny
+}
+double devlpl(double a[],int *n,double *x)
+/*
+**********************************************************************
+
+ double devlpl(double a[],int *n,double *x)
+ Double precision EVALuate a PoLynomial at X
+
+
+ Function
+
+
+ returns
+ A(1) + A(2)*X + ... + A(N)*X**(N-1)
+
+
+ Arguments
+
+
+ A --> Array of coefficients of the polynomial.
+ A is DOUBLE PRECISION(N)
+
+ N --> Length of A, also degree of polynomial - 1.
+ N is INTEGER
+
+ X --> Point at which the polynomial is to be evaluated.
+ X is DOUBLE PRECISION
+
+**********************************************************************
+*/
+{
+static double devlpl,term;
+static int i;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ term = a[*n-1];
+ for(i= *n-1-1; i>=0; i--) term = a[i]+term**x;
+ devlpl = term;
+ return devlpl;
+}
+double dinvnr(double *p,double *q)
+/*
+**********************************************************************
+
+ double dinvnr(double *p,double *q)
+ Double precision NoRmal distribution INVerse
+
+
+ Function
+
+
+ Returns X such that CUMNOR(X) = P, i.e., the integral from -
+ infinity to X of (1/SQRT(2*PI)) EXP(-U*U/2) dU is P
+
+
+ Arguments
+
+
+ P --> The probability whose normal deviate is sought.
+ P is DOUBLE PRECISION
+
+ Q --> 1-P
+ P is DOUBLE PRECISION
+
+
+ Method
+
+
+ The rational function on page 95 of Kennedy and Gentle,
+ Statistical Computing, Marcel Dekker, NY , 1980 is used as a start
+ value for the Newton method of finding roots.
+
+
+ Note
+
+
+ If P or Q .lt. machine EPS returns +/- DINVNR(EPS)
+
+**********************************************************************
+*/
+{
+#define maxit 100
+#define eps 1.0e-13
+#define r2pi 0.3989422804014326e0
+#define nhalf -0.5e0
+#define dennor(x) (r2pi*exp(nhalf*(x)*(x)))
+static double dinvnr,strtx,xcur,cum,ccum,pp,dx;
+static int i;
+static unsigned long qporq;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ FIND MINIMUM OF P AND Q
+*/
+ qporq = *p <= *q;
+ if(!qporq) goto S10;
+ pp = *p;
+ goto S20;
+S10:
+ pp = *q;
+S20:
+/*
+ INITIALIZATION STEP
+*/
+ strtx = stvaln(&pp);
+ xcur = strtx;
+/*
+ NEWTON INTERATIONS
+*/
+ for(i=1; i<=maxit; i++) {
+ cumnor(&xcur,&cum,&ccum);
+ dx = (cum-pp)/dennor(xcur);
+ xcur -= dx;
+ if(fabs(dx/xcur) < eps) goto S40;
+ }
+ dinvnr = strtx;
+/*
+ IF WE GET HERE, NEWTON HAS FAILED
+*/
+ if(!qporq) dinvnr = -dinvnr;
+ return dinvnr;
+S40:
+/*
+ IF WE GET HERE, NEWTON HAS SUCCEDED
+*/
+ dinvnr = xcur;
+ if(!qporq) dinvnr = -dinvnr;
+ return dinvnr;
+#undef maxit
+#undef eps
+#undef r2pi
+#undef nhalf
+#undef dennor
+}
+/* DEFINE DINVR */
+static void E0000(int IENTRY,int *status,double *x,double *fx,
+ unsigned long *qleft,unsigned long *qhi,double *zabsst,
+ double *zabsto,double *zbig,double *zrelst,
+ double *zrelto,double *zsmall,double *zstpmu)
+{
+#define qxmon(zx,zy,zz) (int)((zx) <= (zy) && (zy) <= (zz))
+static double absstp,abstol,big,fbig,fsmall,relstp,reltol,small,step,stpmul,xhi,
+ xlb,xlo,xsave,xub,yy;
+static int i99999;
+static unsigned long qbdd,qcond,qdum1,qdum2,qincr,qlim,qok,qup;
+ switch(IENTRY){case 0: goto DINVR; case 1: goto DSTINV;}
+DINVR:
+ if(*status > 0) goto S310;
+ qcond = !qxmon(small,*x,big);
+ if(qcond) ftnstop((char *) " SMALL, X, BIG not monotone in INVR");
+ xsave = *x;
+/*
+ See that SMALL and BIG bound the zero and set QINCR
+*/
+ *x = small;
+/*
+ GET-FUNCTION-VALUE
+*/
+ i99999 = 1;
+ goto S300;
+S10:
+ fsmall = *fx;
+ *x = big;
+/*
+ GET-FUNCTION-VALUE
+*/
+ i99999 = 2;
+ goto S300;
+S20:
+ fbig = *fx;
+ qincr = fbig > fsmall;
+ if(!qincr) goto S50;
+ if(fsmall <= 0.0e0) goto S30;
+ *status = -1;
+ *qleft = *qhi = 1;
+ return;
+S30:
+ if(fbig >= 0.0e0) goto S40;
+ *status = -1;
+ *qleft = *qhi = 0;
+ return;
+S40:
+ goto S80;
+S50:
+ if(fsmall >= 0.0e0) goto S60;
+ *status = -1;
+ *qleft = 1;
+ *qhi = 0;
+ return;
+S60:
+ if(fbig <= 0.0e0) goto S70;
+ *status = -1;
+ *qleft = 0;
+ *qhi = 1;
+ return;
+S80:
+S70:
+ *x = xsave;
+ step = fifdmax1(absstp,relstp*fabs(*x));
+/*
+ YY = F(X) - Y
+ GET-FUNCTION-VALUE
+*/
+ i99999 = 3;
+ goto S300;
+S90:
+ yy = *fx;
+ if(!(yy == 0.0e0)) goto S100;
+ *status = 0;
+ qok = 1;
+ return;
+S100:
+ qup = (qincr && yy < 0.0e0) || (!qincr && yy > 0.0e0);
+/*
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ HANDLE CASE IN WHICH WE MUST STEP HIGHER
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+*/
+ if(!qup) goto S170;
+ xlb = xsave;
+ xub = fifdmin1(xlb+step,big);
+ goto S120;
+S110:
+ if(qcond) goto S150;
+S120:
+/*
+ YY = F(XUB) - Y
+*/
+ *x = xub;
+/*
+ GET-FUNCTION-VALUE
+*/
+ i99999 = 4;
+ goto S300;
+S130:
+ yy = *fx;
+ qbdd = (qincr && yy >= 0.0e0) || (!qincr && yy <= 0.0e0);
+ qlim = xub >= big;
+ qcond = qbdd || qlim;
+ if(qcond) goto S140;
+ step = stpmul*step;
+ xlb = xub;
+ xub = fifdmin1(xlb+step,big);
+S140:
+ goto S110;
+S150:
+ if(!(qlim && !qbdd)) goto S160;
+ *status = -1;
+ *qleft = 0;
+ *qhi = !qincr;
+ *x = big;
+ return;
+S160:
+ goto S240;
+S170:
+/*
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ HANDLE CASE IN WHICH WE MUST STEP LOWER
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+*/
+ xub = xsave;
+ xlb = fifdmax1(xub-step,small);
+ goto S190;
+S180:
+ if(qcond) goto S220;
+S190:
+/*
+ YY = F(XLB) - Y
+*/
+ *x = xlb;
+/*
+ GET-FUNCTION-VALUE
+*/
+ i99999 = 5;
+ goto S300;
+S200:
+ yy = *fx;
+ qbdd = (qincr && yy <= 0.0e0) || (!qincr && yy >= 0.0e0);
+ qlim = xlb <= small;
+ qcond = qbdd || qlim;
+ if(qcond) goto S210;
+ step = stpmul*step;
+ xub = xlb;
+ xlb = fifdmax1(xub-step,small);
+S210:
+ goto S180;
+S220:
+ if(!(qlim && !qbdd)) goto S230;
+ *status = -1;
+ *qleft = 1;
+ *qhi = qincr;
+ *x = small;
+ return;
+S240:
+S230:
+ dstzr(&xlb,&xub,&abstol,&reltol);
+/*
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ IF WE REACH HERE, XLB AND XUB BOUND THE ZERO OF F.
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+*/
+ *status = 0;
+ goto S260;
+S250:
+ if(!(*status == 1)) goto S290;
+S260:
+ dzror(status,x,fx,&xlo,&xhi,&qdum1,&qdum2);
+ if(!(*status == 1)) goto S280;
+/*
+ GET-FUNCTION-VALUE
+*/
+ i99999 = 6;
+ goto S300;
+S280:
+S270:
+ goto S250;
+S290:
+ *x = xlo;
+ *status = 0;
+ return;
+DSTINV:
+ small = *zsmall;
+ big = *zbig;
+ absstp = *zabsst;
+ relstp = *zrelst;
+ stpmul = *zstpmu;
+ abstol = *zabsto;
+ reltol = *zrelto;
+ return;
+S300:
+/*
+ TO GET-FUNCTION-VALUE
+*/
+ *status = 1;
+ return;
+S310:
+ switch((int)i99999){case 1: goto S10;case 2: goto S20;case 3: goto S90;case
+ 4: goto S130;case 5: goto S200;case 6: goto S270;default: break;}
+#undef qxmon
+}
+void dinvr(int *status,double *x,double *fx,
+ unsigned long *qleft,unsigned long *qhi)
+/*
+**********************************************************************
+
+ void dinvr(int *status,double *x,double *fx,
+ unsigned long *qleft,unsigned long *qhi)
+
+ Double precision
+ bounds the zero of the function and invokes zror
+ Reverse Communication
+
+
+ Function
+
+
+ Bounds the function and invokes ZROR to perform the zero
+ finding. STINVR must have been called before this routine
+ in order to set its parameters.
+
+
+ Arguments
+
+
+ STATUS <--> At the beginning of a zero finding problem, STATUS
+ should be set to 0 and INVR invoked. (The value
+ of parameters other than X will be ignored on this cal
+
+ When INVR needs the function evaluated, it will set
+ STATUS to 1 and return. The value of the function
+ should be set in FX and INVR again called without
+ changing any of its other parameters.
+
+ When INVR has finished without error, it will return
+ with STATUS 0. In that case X is approximately a root
+ of F(X).
+
+ If INVR cannot bound the function, it returns status
+ -1 and sets QLEFT and QHI.
+ INTEGER STATUS
+
+ X <-- The value of X at which F(X) is to be evaluated.
+ DOUBLE PRECISION X
+
+ FX --> The value of F(X) calculated when INVR returns with
+ STATUS = 1.
+ DOUBLE PRECISION FX
+
+ QLEFT <-- Defined only if QMFINV returns .FALSE. In that
+ case it is .TRUE. If the stepping search terminated
+ unsucessfully at SMALL. If it is .FALSE. the search
+ terminated unsucessfully at BIG.
+ QLEFT is LOGICAL
+
+ QHI <-- Defined only if QMFINV returns .FALSE. In that
+ case it is .TRUE. if F(X) .GT. Y at the termination
+ of the search and .FALSE. if F(X) .LT. Y at the
+ termination of the search.
+ QHI is LOGICAL
+
+**********************************************************************
+*/
+{
+ E0000(0,status,x,fx,qleft,qhi,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
+}
+void dstinv(double *zsmall,double *zbig,double *zabsst,
+ double *zrelst,double *zstpmu,double *zabsto,
+ double *zrelto)
+/*
+**********************************************************************
+ void dstinv(double *zsmall,double *zbig,double *zabsst,
+ double *zrelst,double *zstpmu,double *zabsto,
+ double *zrelto)
+
+ Double Precision - SeT INverse finder - Reverse Communication
+ Function
+ Concise Description - Given a monotone function F finds X
+ such that F(X) = Y. Uses Reverse communication -- see invr.
+ This routine sets quantities needed by INVR.
+ More Precise Description of INVR -
+ F must be a monotone function, the results of QMFINV are
+ otherwise undefined. QINCR must be .TRUE. if F is non-
+ decreasing and .FALSE. if F is non-increasing.
+ QMFINV will return .TRUE. if and only if F(SMALL) and
+ F(BIG) bracket Y, i. e.,
+ QINCR is .TRUE. and F(SMALL).LE.Y.LE.F(BIG) or
+ QINCR is .FALSE. and F(BIG).LE.Y.LE.F(SMALL)
+ if QMFINV returns .TRUE., then the X returned satisfies
+ the following condition. let
+ TOL(X) = MAX(ABSTOL,RELTOL*ABS(X))
+ then if QINCR is .TRUE.,
+ F(X-TOL(X)) .LE. Y .LE. F(X+TOL(X))
+ and if QINCR is .FALSE.
+ F(X-TOL(X)) .GE. Y .GE. F(X+TOL(X))
+ Arguments
+ SMALL --> The left endpoint of the interval to be
+ searched for a solution.
+ SMALL is DOUBLE PRECISION
+ BIG --> The right endpoint of the interval to be
+ searched for a solution.
+ BIG is DOUBLE PRECISION
+ ABSSTP, RELSTP --> The initial step size in the search
+ is MAX(ABSSTP,RELSTP*ABS(X)). See algorithm.
+ ABSSTP is DOUBLE PRECISION
+ RELSTP is DOUBLE PRECISION
+ STPMUL --> When a step doesn't bound the zero, the step
+ size is multiplied by STPMUL and another step
+ taken. A popular value is 2.0
+ DOUBLE PRECISION STPMUL
+ ABSTOL, RELTOL --> Two numbers that determine the accuracy
+ of the solution. See function for a precise definition.
+ ABSTOL is DOUBLE PRECISION
+ RELTOL is DOUBLE PRECISION
+ Method
+ Compares F(X) with Y for the input value of X then uses QINCR
+ to determine whether to step left or right to bound the
+ desired x. the initial step size is
+ MAX(ABSSTP,RELSTP*ABS(S)) for the input value of X.
+ Iteratively steps right or left until it bounds X.
+ At each step which doesn't bound X, the step size is doubled.
+ The routine is careful never to step beyond SMALL or BIG. If
+ it hasn't bounded X at SMALL or BIG, QMFINV returns .FALSE.
+ after setting QLEFT and QHI.
+ If X is successfully bounded then Algorithm R of the paper
+ 'Two Efficient Algorithms with Guaranteed Convergence for
+ Finding a Zero of a Function' by J. C. P. Bus and
+ T. J. Dekker in ACM Transactions on Mathematical
+ Software, Volume 1, No. 4 page 330 (DEC. '75) is employed
+ to find the zero of the function F(X)-Y. This is routine
+ QRZERO.
+**********************************************************************
+*/
+{
+ E0000(1,NULL,NULL,NULL,NULL,NULL,zabsst,zabsto,zbig,zrelst,zrelto,zsmall,
+ zstpmu);
+}
+double dt1(double *p,double *q,double *df)
+/*
+**********************************************************************
+
+ double dt1(double *p,double *q,double *df)
+ Double precision Initalize Approximation to
+ INVerse of the cumulative T distribution
+
+
+ Function
+
+
+ Returns the inverse of the T distribution function, i.e.,
+ the integral from 0 to INVT of the T density is P. This is an
+ initial approximation
+
+
+ Arguments
+
+
+ P --> The p-value whose inverse from the T distribution is
+ desired.
+ P is DOUBLE PRECISION
+
+ Q --> 1-P.
+ Q is DOUBLE PRECISION
+
+ DF --> Degrees of freedom of the T distribution.
+ DF is DOUBLE PRECISION
+
+**********************************************************************
+*/
+{
+static double coef[4][5] = {
+ {1.0e0,1.0e0,0.0e0,0.0e0,0.0e0},
+ {3.0e0,16.0e0,5.0e0,0.0e0,0.0e0},
+ {-15.0e0,17.0e0,19.0e0,3.0e0,0.0e0},
+ {-945.0e0,-1920.0e0,1482.0e0,776.0e0,79.0e0}
+};
+static double denom[4] = {
+ 4.0e0,96.0e0,384.0e0,92160.0e0
+};
+static int ideg[4] = {
+ 2,3,4,5
+};
+static double dt1,denpow,sum,term,x,xp,xx;
+static int i;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ x = fabs(dinvnr(p,q));
+ xx = x*x;
+ sum = x;
+ denpow = 1.0e0;
+ for(i=0; i<4; i++) {
+ term = devlpl(&coef[i][0],&ideg[i],&xx)*x;
+ denpow *= *df;
+ sum += (term/(denpow*denom[i]));
+ }
+ if(!(*p >= 0.5e0)) goto S20;
+ xp = sum;
+ goto S30;
+S20:
+ xp = -sum;
+S30:
+ dt1 = xp;
+ return dt1;
+}
+/* DEFINE DZROR */
+static void E0001(int IENTRY,int *status,double *x,double *fx,
+ double *xlo,double *xhi,unsigned long *qleft,
+ unsigned long *qhi,double *zabstl,double *zreltl,
+ double *zxhi,double *zxlo)
+{
+#define ftol(zx) (0.5e0*fifdmax1(abstol,reltol*fabs((zx))))
+static double a,abstol,b,c,d,fa,fb,fc,fd,fda,fdb,m,mb,p,q,reltol,tol,w,xxhi,xxlo;
+static int ext,i99999;
+static unsigned long first,qrzero;
+ switch(IENTRY){case 0: goto DZROR; case 1: goto DSTZR;}
+DZROR:
+ if(*status > 0) goto S280;
+ *xlo = xxlo;
+ *xhi = xxhi;
+ b = *x = *xlo;
+/*
+ GET-FUNCTION-VALUE
+*/
+ i99999 = 1;
+ goto S270;
+S10:
+ fb = *fx;
+ *xlo = *xhi;
+ a = *x = *xlo;
+/*
+ GET-FUNCTION-VALUE
+*/
+ i99999 = 2;
+ goto S270;
+S20:
+/*
+ Check that F(ZXLO) < 0 < F(ZXHI) or
+ F(ZXLO) > 0 > F(ZXHI)
+*/
+ if(!(fb < 0.0e0)) goto S40;
+ if(!(*fx < 0.0e0)) goto S30;
+ *status = -1;
+ *qleft = *fx < fb;
+ *qhi = 0;
+ return;
+S40:
+S30:
+ if(!(fb > 0.0e0)) goto S60;
+ if(!(*fx > 0.0e0)) goto S50;
+ *status = -1;
+ *qleft = *fx > fb;
+ *qhi = 1;
+ return;
+S60:
+S50:
+ fa = *fx;
+ first = 1;
+S70:
+ c = a;
+ fc = fa;
+ ext = 0;
+S80:
+ if(!(fabs(fc) < fabs(fb))) goto S100;
+ if(!(c != a)) goto S90;
+ d = a;
+ fd = fa;
+S90:
+ a = b;
+ fa = fb;
+ *xlo = c;
+ b = *xlo;
+ fb = fc;
+ c = a;
+ fc = fa;
+S100:
+ tol = ftol(*xlo);
+ m = (c+b)*.5e0;
+ mb = m-b;
+ if(!(fabs(mb) > tol)) goto S240;
+ if(!(ext > 3)) goto S110;
+ w = mb;
+ goto S190;
+S110:
+ tol = fifdsign(tol,mb);
+ p = (b-a)*fb;
+ if(!first) goto S120;
+ q = fa-fb;
+ first = 0;
+ goto S130;
+S120:
+ fdb = (fd-fb)/(d-b);
+ fda = (fd-fa)/(d-a);
+ p = fda*p;
+ q = fdb*fa-fda*fb;
+S130:
+ if(!(p < 0.0e0)) goto S140;
+ p = -p;
+ q = -q;
+S140:
+ if(ext == 3) p *= 2.0e0;
+ if(!(p*1.0e0 == 0.0e0 || p <= q*tol)) goto S150;
+ w = tol;
+ goto S180;
+S150:
+ if(!(p < mb*q)) goto S160;
+ w = p/q;
+ goto S170;
+S160:
+ w = mb;
+S190:
+S180:
+S170:
+ d = a;
+ fd = fa;
+ a = b;
+ fa = fb;
+ b += w;
+ *xlo = b;
+ *x = *xlo;
+/*
+ GET-FUNCTION-VALUE
+*/
+ i99999 = 3;
+ goto S270;
+S200:
+ fb = *fx;
+ if(!(fc*fb >= 0.0e0)) goto S210;
+ goto S70;
+S210:
+ if(!(w == mb)) goto S220;
+ ext = 0;
+ goto S230;
+S220:
+ ext += 1;
+S230:
+ goto S80;
+S240:
+ *xhi = c;
+ qrzero = (fc >= 0.0e0 && fb <= 0.0e0) || (fc < 0.0e0 && fb >= 0.0e0);
+ if(!qrzero) goto S250;
+ *status = 0;
+ goto S260;
+S250:
+ *status = -1;
+S260:
+ return;
+DSTZR:
+ xxlo = *zxlo;
+ xxhi = *zxhi;
+ abstol = *zabstl;
+ reltol = *zreltl;
+ return;
+S270:
+/*
+ TO GET-FUNCTION-VALUE
+*/
+ *status = 1;
+ return;
+S280:
+ switch((int)i99999){case 1: goto S10;case 2: goto S20;case 3: goto S200;
+ default: break;}
+#undef ftol
+}
+void dzror(int *status,double *x,double *fx,double *xlo,
+ double *xhi,unsigned long *qleft,unsigned long *qhi)
+/*
+**********************************************************************
+
+ void dzror(int *status,double *x,double *fx,double *xlo,
+ double *xhi,unsigned long *qleft,unsigned long *qhi)
+
+ Double precision ZeRo of a function -- Reverse Communication
+
+
+ Function
+
+
+ Performs the zero finding. STZROR must have been called before
+ this routine in order to set its parameters.
+
+
+ Arguments
+
+
+ STATUS <--> At the beginning of a zero finding problem, STATUS
+ should be set to 0 and ZROR invoked. (The value
+ of other parameters will be ignored on this call.)
+
+ When ZROR needs the function evaluated, it will set
+ STATUS to 1 and return. The value of the function
+ should be set in FX and ZROR again called without
+ changing any of its other parameters.
+
+ When ZROR has finished without error, it will return
+ with STATUS 0. In that case (XLO,XHI) bound the answe
+
+ If ZROR finds an error (which implies that F(XLO)-Y an
+ F(XHI)-Y have the same sign, it returns STATUS -1. In
+ this case, XLO and XHI are undefined.
+ INTEGER STATUS
+
+ X <-- The value of X at which F(X) is to be evaluated.
+ DOUBLE PRECISION X
+
+ FX --> The value of F(X) calculated when ZROR returns with
+ STATUS = 1.
+ DOUBLE PRECISION FX
+
+ XLO <-- When ZROR returns with STATUS = 0, XLO bounds the
+ inverval in X containing the solution below.
+ DOUBLE PRECISION XLO
+
+ XHI <-- When ZROR returns with STATUS = 0, XHI bounds the
+ inverval in X containing the solution above.
+ DOUBLE PRECISION XHI
+
+ QLEFT <-- .TRUE. if the stepping search terminated unsucessfully
+ at XLO. If it is .FALSE. the search terminated
+ unsucessfully at XHI.
+ QLEFT is LOGICAL
+
+ QHI <-- .TRUE. if F(X) .GT. Y at the termination of the
+ search and .FALSE. if F(X) .LT. Y at the
+ termination of the search.
+ QHI is LOGICAL
+
+**********************************************************************
+*/
+{
+ E0001(0,status,x,fx,xlo,xhi,qleft,qhi,NULL,NULL,NULL,NULL);
+}
+void dstzr(double *zxlo,double *zxhi,double *zabstl,double *zreltl)
+/*
+**********************************************************************
+ void dstzr(double *zxlo,double *zxhi,double *zabstl,double *zreltl)
+ Double precision SeT ZeRo finder - Reverse communication version
+ Function
+ Sets quantities needed by ZROR. The function of ZROR
+ and the quantities set is given here.
+ Concise Description - Given a function F
+ find XLO such that F(XLO) = 0.
+ More Precise Description -
+ Input condition. F is a double precision function of a single
+ double precision argument and XLO and XHI are such that
+ F(XLO)*F(XHI) .LE. 0.0
+ If the input condition is met, QRZERO returns .TRUE.
+ and output values of XLO and XHI satisfy the following
+ F(XLO)*F(XHI) .LE. 0.
+ ABS(F(XLO) .LE. ABS(F(XHI)
+ ABS(XLO-XHI) .LE. TOL(X)
+ where
+ TOL(X) = MAX(ABSTOL,RELTOL*ABS(X))
+ If this algorithm does not find XLO and XHI satisfying
+ these conditions then QRZERO returns .FALSE. This
+ implies that the input condition was not met.
+ Arguments
+ XLO --> The left endpoint of the interval to be
+ searched for a solution.
+ XLO is DOUBLE PRECISION
+ XHI --> The right endpoint of the interval to be
+ for a solution.
+ XHI is DOUBLE PRECISION
+ ABSTOL, RELTOL --> Two numbers that determine the accuracy
+ of the solution. See function for a
+ precise definition.
+ ABSTOL is DOUBLE PRECISION
+ RELTOL is DOUBLE PRECISION
+ Method
+ Algorithm R of the paper 'Two Efficient Algorithms with
+ Guaranteed Convergence for Finding a Zero of a Function'
+ by J. C. P. Bus and T. J. Dekker in ACM Transactions on
+ Mathematical Software, Volume 1, no. 4 page 330
+ (Dec. '75) is employed to find the zero of F(X)-Y.
+**********************************************************************
+*/
+{
+ E0001(1,NULL,NULL,NULL,NULL,NULL,NULL,NULL,zabstl,zreltl,zxhi,zxlo);
+}
+double erf1(double *x)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF THE REAL ERROR FUNCTION
+-----------------------------------------------------------------------
+*/
+{
+static double c = .564189583547756e0;
+static double a[5] = {
+ .771058495001320e-04,-.133733772997339e-02,.323076579225834e-01,
+ .479137145607681e-01,.128379167095513e+00
+};
+static double b[3] = {
+ .301048631703895e-02,.538971687740286e-01,.375795757275549e+00
+};
+static double p[8] = {
+ -1.36864857382717e-07,5.64195517478974e-01,7.21175825088309e+00,
+ 4.31622272220567e+01,1.52989285046940e+02,3.39320816734344e+02,
+ 4.51918953711873e+02,3.00459261020162e+02
+};
+static double q[8] = {
+ 1.00000000000000e+00,1.27827273196294e+01,7.70001529352295e+01,
+ 2.77585444743988e+02,6.38980264465631e+02,9.31354094850610e+02,
+ 7.90950925327898e+02,3.00459260956983e+02
+};
+static double r[5] = {
+ 2.10144126479064e+00,2.62370141675169e+01,2.13688200555087e+01,
+ 4.65807828718470e+00,2.82094791773523e-01
+};
+static double s[4] = {
+ 9.41537750555460e+01,1.87114811799590e+02,9.90191814623914e+01,
+ 1.80124575948747e+01
+};
+static double erf1,ax,bot,t,top,x2;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ ax = fabs(*x);
+ if(ax > 0.5e0) goto S10;
+ t = *x**x;
+ top = (((a[0]*t+a[1])*t+a[2])*t+a[3])*t+a[4]+1.0e0;
+ bot = ((b[0]*t+b[1])*t+b[2])*t+1.0e0;
+ erf1 = *x*(top/bot);
+ return erf1;
+S10:
+ if(ax > 4.0e0) goto S20;
+ top = ((((((p[0]*ax+p[1])*ax+p[2])*ax+p[3])*ax+p[4])*ax+p[5])*ax+p[6])*ax+p[
+ 7];
+ bot = ((((((q[0]*ax+q[1])*ax+q[2])*ax+q[3])*ax+q[4])*ax+q[5])*ax+q[6])*ax+q[
+ 7];
+ erf1 = 0.5e0+(0.5e0-exp(-(*x**x))*top/bot);
+ if(*x < 0.0e0) erf1 = -erf1;
+ return erf1;
+S20:
+ if(ax >= 5.8e0) goto S30;
+ x2 = *x**x;
+ t = 1.0e0/x2;
+ top = (((r[0]*t+r[1])*t+r[2])*t+r[3])*t+r[4];
+ bot = (((s[0]*t+s[1])*t+s[2])*t+s[3])*t+1.0e0;
+ erf1 = (c-top/(x2*bot))/ax;
+ erf1 = 0.5e0+(0.5e0-exp(-x2)*erf1);
+ if(*x < 0.0e0) erf1 = -erf1;
+ return erf1;
+S30:
+ erf1 = fifdsign(1.0e0,*x);
+ return erf1;
+}
+double erfc1(int *ind,double *x)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF THE COMPLEMENTARY ERROR FUNCTION
+
+ ERFC1(IND,X) = ERFC(X) IF IND = 0
+ ERFC1(IND,X) = EXP(X*X)*ERFC(X) OTHERWISE
+-----------------------------------------------------------------------
+*/
+{
+static double c = .564189583547756e0;
+static double a[5] = {
+ .771058495001320e-04,-.133733772997339e-02,.323076579225834e-01,
+ .479137145607681e-01,.128379167095513e+00
+};
+static double b[3] = {
+ .301048631703895e-02,.538971687740286e-01,.375795757275549e+00
+};
+static double p[8] = {
+ -1.36864857382717e-07,5.64195517478974e-01,7.21175825088309e+00,
+ 4.31622272220567e+01,1.52989285046940e+02,3.39320816734344e+02,
+ 4.51918953711873e+02,3.00459261020162e+02
+};
+static double q[8] = {
+ 1.00000000000000e+00,1.27827273196294e+01,7.70001529352295e+01,
+ 2.77585444743988e+02,6.38980264465631e+02,9.31354094850610e+02,
+ 7.90950925327898e+02,3.00459260956983e+02
+};
+static double r[5] = {
+ 2.10144126479064e+00,2.62370141675169e+01,2.13688200555087e+01,
+ 4.65807828718470e+00,2.82094791773523e-01
+};
+static double s[4] = {
+ 9.41537750555460e+01,1.87114811799590e+02,9.90191814623914e+01,
+ 1.80124575948747e+01
+};
+static int K1 = 1;
+static double erfc1,ax,bot,e,t,top,w;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ ABS(X) .LE. 0.5
+*/
+ ax = fabs(*x);
+ if(ax > 0.5e0) goto S10;
+ t = *x**x;
+ top = (((a[0]*t+a[1])*t+a[2])*t+a[3])*t+a[4]+1.0e0;
+ bot = ((b[0]*t+b[1])*t+b[2])*t+1.0e0;
+ erfc1 = 0.5e0+(0.5e0-*x*(top/bot));
+ if(*ind != 0) erfc1 = exp(t)*erfc1;
+ return erfc1;
+S10:
+/*
+ 0.5 .LT. ABS(X) .LE. 4
+*/
+ if(ax > 4.0e0) goto S20;
+ top = ((((((p[0]*ax+p[1])*ax+p[2])*ax+p[3])*ax+p[4])*ax+p[5])*ax+p[6])*ax+p[
+ 7];
+ bot = ((((((q[0]*ax+q[1])*ax+q[2])*ax+q[3])*ax+q[4])*ax+q[5])*ax+q[6])*ax+q[
+ 7];
+ erfc1 = top/bot;
+ goto S40;
+S20:
+/*
+ ABS(X) .GT. 4
+*/
+ if(*x <= -5.6e0) goto S60;
+ if(*ind != 0) goto S30;
+ if(*x > 100.0e0) goto S70;
+ if(*x**x > -exparg(&K1)) goto S70;
+S30:
+ t = pow(1.0e0/ *x,2.0);
+ top = (((r[0]*t+r[1])*t+r[2])*t+r[3])*t+r[4];
+ bot = (((s[0]*t+s[1])*t+s[2])*t+s[3])*t+1.0e0;
+ erfc1 = (c-t*top/bot)/ax;
+S40:
+/*
+ FINAL ASSEMBLY
+*/
+ if(*ind == 0) goto S50;
+ if(*x < 0.0e0) erfc1 = 2.0e0*exp(*x**x)-erfc1;
+ return erfc1;
+S50:
+ w = *x**x;
+ t = w;
+ e = w-t;
+ erfc1 = (0.5e0+(0.5e0-e))*exp(-t)*erfc1;
+ if(*x < 0.0e0) erfc1 = 2.0e0-erfc1;
+ return erfc1;
+S60:
+/*
+ LIMIT VALUE FOR LARGE NEGATIVE X
+*/
+ erfc1 = 2.0e0;
+ if(*ind != 0) erfc1 = 2.0e0*exp(*x**x);
+ return erfc1;
+S70:
+/*
+ LIMIT VALUE FOR LARGE POSITIVE X
+ WHEN IND = 0
+*/
+ erfc1 = 0.0e0;
+ return erfc1;
+}
+double esum(int *mu,double *x)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF EXP(MU + X)
+-----------------------------------------------------------------------
+*/
+{
+static double esum,w;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(*x > 0.0e0) goto S10;
+ if(*mu < 0) goto S20;
+ w = (double)*mu+*x;
+ if(w > 0.0e0) goto S20;
+ esum = exp(w);
+ return esum;
+S10:
+ if(*mu > 0) goto S20;
+ w = (double)*mu+*x;
+ if(w < 0.0e0) goto S20;
+ esum = exp(w);
+ return esum;
+S20:
+ w = *mu;
+ esum = exp(w)*exp(*x);
+ return esum;
+}
+double exparg(int *l)
+/*
+--------------------------------------------------------------------
+ IF L = 0 THEN EXPARG(L) = THE LARGEST POSITIVE W FOR WHICH
+ EXP(W) CAN BE COMPUTED.
+
+ IF L IS NONZERO THEN EXPARG(L) = THE LARGEST NEGATIVE W FOR
+ WHICH THE COMPUTED VALUE OF EXP(W) IS NONZERO.
+
+ NOTE... ONLY AN APPROXIMATE VALUE FOR EXPARG(L) IS NEEDED.
+--------------------------------------------------------------------
+*/
+{
+static int K1 = 4;
+static int K2 = 9;
+static int K3 = 10;
+static double exparg,lnb;
+static int b,m;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ b = ipmpar(&K1);
+ if(b != 2) goto S10;
+ lnb = .69314718055995e0;
+ goto S40;
+S10:
+ if(b != 8) goto S20;
+ lnb = 2.0794415416798e0;
+ goto S40;
+S20:
+ if(b != 16) goto S30;
+ lnb = 2.7725887222398e0;
+ goto S40;
+S30:
+ lnb = log((double)b);
+S40:
+ if(*l == 0) goto S50;
+ m = ipmpar(&K2)-1;
+ exparg = 0.99999e0*((double)m*lnb);
+ return exparg;
+S50:
+ m = ipmpar(&K3);
+ exparg = 0.99999e0*((double)m*lnb);
+ return exparg;
+}
+double fpser(double *a,double *b,double *x,double *eps)
+/*
+-----------------------------------------------------------------------
+
+ EVALUATION OF I (A,B)
+ X
+
+ FOR B .LT. MIN(EPS,EPS*A) AND X .LE. 0.5.
+
+-----------------------------------------------------------------------
+
+ SET FPSER = X**A
+*/
+{
+static int K1 = 1;
+static double fpser,an,c,s,t,tol;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ fpser = 1.0e0;
+ if(*a <= 1.e-3**eps) goto S10;
+ fpser = 0.0e0;
+ t = *a*log(*x);
+ if(t < exparg(&K1)) return fpser;
+ fpser = exp(t);
+S10:
+/*
+ NOTE THAT 1/B(A,B) = B
+*/
+ fpser = *b/ *a*fpser;
+ tol = *eps/ *a;
+ an = *a+1.0e0;
+ t = *x;
+ s = t/an;
+S20:
+ an += 1.0e0;
+ t = *x*t;
+ c = t/an;
+ s += c;
+ if(fabs(c) > tol) goto S20;
+ fpser *= (1.0e0+*a*s);
+ return fpser;
+}
+double gam1(double *a)
+/*
+ ------------------------------------------------------------------
+ COMPUTATION OF 1/GAMMA(A+1) - 1 FOR -0.5 .LE. A .LE. 1.5
+ ------------------------------------------------------------------
+*/
+{
+static double s1 = .273076135303957e+00;
+static double s2 = .559398236957378e-01;
+static double p[7] = {
+ .577215664901533e+00,-.409078193005776e+00,-.230975380857675e+00,
+ .597275330452234e-01,.766968181649490e-02,-.514889771323592e-02,
+ .589597428611429e-03
+};
+static double q[5] = {
+ .100000000000000e+01,.427569613095214e+00,.158451672430138e+00,
+ .261132021441447e-01,.423244297896961e-02
+};
+static double r[9] = {
+ -.422784335098468e+00,-.771330383816272e+00,-.244757765222226e+00,
+ .118378989872749e+00,.930357293360349e-03,-.118290993445146e-01,
+ .223047661158249e-02,.266505979058923e-03,-.132674909766242e-03
+};
+static double gam1,bot,d,t,top,w,T1;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ t = *a;
+ d = *a-0.5e0;
+ if(d > 0.0e0) t = d-0.5e0;
+ T1 = t;
+ if(T1 < 0) goto S40;
+ else if(T1 == 0) goto S10;
+ else goto S20;
+S10:
+ gam1 = 0.0e0;
+ return gam1;
+S20:
+ top = (((((p[6]*t+p[5])*t+p[4])*t+p[3])*t+p[2])*t+p[1])*t+p[0];
+ bot = (((q[4]*t+q[3])*t+q[2])*t+q[1])*t+1.0e0;
+ w = top/bot;
+ if(d > 0.0e0) goto S30;
+ gam1 = *a*w;
+ return gam1;
+S30:
+ gam1 = t/ *a*(w-0.5e0-0.5e0);
+ return gam1;
+S40:
+ top = (((((((r[8]*t+r[7])*t+r[6])*t+r[5])*t+r[4])*t+r[3])*t+r[2])*t+r[1])*t+
+ r[0];
+ bot = (s2*t+s1)*t+1.0e0;
+ w = top/bot;
+ if(d > 0.0e0) goto S50;
+ gam1 = *a*(w+0.5e0+0.5e0);
+ return gam1;
+S50:
+ gam1 = t*w/ *a;
+ return gam1;
+}
+void gaminv(double *a,double *x,double *x0,double *p,double *q,
+ int *ierr)
+/*
+ ----------------------------------------------------------------------
+ INVERSE INCOMPLETE GAMMA RATIO FUNCTION
+
+ GIVEN POSITIVE A, AND NONEGATIVE P AND Q WHERE P + Q = 1.
+ THEN X IS COMPUTED WHERE P(A,X) = P AND Q(A,X) = Q. SCHRODER
+ ITERATION IS EMPLOYED. THE ROUTINE ATTEMPTS TO COMPUTE X
+ TO 10 SIGNIFICANT DIGITS IF THIS IS POSSIBLE FOR THE
+ PARTICULAR COMPUTER ARITHMETIC BEING USED.
+
+ ------------
+
+ X IS A VARIABLE. IF P = 0 THEN X IS ASSIGNED THE VALUE 0,
+ AND IF Q = 0 THEN X IS SET TO THE LARGEST FLOATING POINT
+ NUMBER AVAILABLE. OTHERWISE, GAMINV ATTEMPTS TO OBTAIN
+ A SOLUTION FOR P(A,X) = P AND Q(A,X) = Q. IF THE ROUTINE
+ IS SUCCESSFUL THEN THE SOLUTION IS STORED IN X.
+
+ X0 IS AN OPTIONAL INITIAL APPROXIMATION FOR X. IF THE USER
+ DOES NOT WISH TO SUPPLY AN INITIAL APPROXIMATION, THEN SET
+ X0 .LE. 0.
+
+ IERR IS A VARIABLE THAT REPORTS THE STATUS OF THE RESULTS.
+ WHEN THE ROUTINE TERMINATES, IERR HAS ONE OF THE FOLLOWING
+ VALUES ...
+
+ IERR = 0 THE SOLUTION WAS OBTAINED. ITERATION WAS
+ NOT USED.
+ IERR.GT.0 THE SOLUTION WAS OBTAINED. IERR ITERATIONS
+ WERE PERFORMED.
+ IERR = -2 (INPUT ERROR) A .LE. 0
+ IERR = -3 NO SOLUTION WAS OBTAINED. THE RATIO Q/A
+ IS TOO LARGE.
+ IERR = -4 (INPUT ERROR) P + Q .NE. 1
+ IERR = -6 20 ITERATIONS WERE PERFORMED. THE MOST
+ RECENT VALUE OBTAINED FOR X IS GIVEN.
+ THIS CANNOT OCCUR IF X0 .LE. 0.
+ IERR = -7 ITERATION FAILED. NO VALUE IS GIVEN FOR X.
+ THIS MAY OCCUR WHEN X IS APPROXIMATELY 0.
+ IERR = -8 A VALUE FOR X HAS BEEN OBTAINED, BUT THE
+ ROUTINE IS NOT CERTAIN OF ITS ACCURACY.
+ ITERATION CANNOT BE PERFORMED IN THIS
+ CASE. IF X0 .LE. 0, THIS CAN OCCUR ONLY
+ WHEN P OR Q IS APPROXIMATELY 0. IF X0 IS
+ POSITIVE THEN THIS CAN OCCUR WHEN A IS
+ EXCEEDINGLY CLOSE TO X AND A IS EXTREMELY
+ LARGE (SAY A .GE. 1.E20).
+ ----------------------------------------------------------------------
+ WRITTEN BY ALFRED H. MORRIS, JR.
+ NAVAL SURFACE WEAPONS CENTER
+ DAHLGREN, VIRGINIA
+ -------------------
+*/
+{
+static double a0 = 3.31125922108741e0;
+static double a1 = 11.6616720288968e0;
+static double a2 = 4.28342155967104e0;
+static double a3 = .213623493715853e0;
+static double b1 = 6.61053765625462e0;
+static double b2 = 6.40691597760039e0;
+static double b3 = 1.27364489782223e0;
+static double b4 = .036117081018842e0;
+static double c = .577215664901533e0;
+static double ln10 = 2.302585e0;
+static double tol = 1.e-5;
+static double amin[2] = {
+ 500.0e0,100.0e0
+};
+static double bmin[2] = {
+ 1.e-28,1.e-13
+};
+static double dmin[2] = {
+ 1.e-06,1.e-04
+};
+static double emin[2] = {
+ 2.e-03,6.e-03
+};
+static double eps0[2] = {
+ 1.e-10,1.e-08
+};
+static int K1 = 1;
+static int K2 = 2;
+static int K3 = 3;
+static int K8 = 0;
+static double am1,amax,ap1,ap2,ap3,apn,b,c1,c2,c3,c4,c5,d,e,e2,eps,g,h,pn,qg,qn,
+ r,rta,s,s2,sum,t,u,w,xmax,xmin,xn,y,z;
+static int iop;
+static double T4,T5,T6,T7,T9;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ ****** E, XMIN, AND XMAX ARE MACHINE DEPENDENT CONSTANTS.
+ E IS THE SMALLEST NUMBER FOR WHICH 1.0 + E .GT. 1.0.
+ XMIN IS THE SMALLEST POSITIVE NUMBER AND XMAX IS THE
+ LARGEST POSITIVE NUMBER.
+*/
+ e = spmpar(&K1);
+ xmin = spmpar(&K2);
+ xmax = spmpar(&K3);
+ *x = 0.0e0;
+ if(*a <= 0.0e0) goto S300;
+ t = *p+*q-1.e0;
+ if(fabs(t) > e) goto S320;
+ *ierr = 0;
+ if(*p == 0.0e0) return;
+ if(*q == 0.0e0) goto S270;
+ if(*a == 1.0e0) goto S280;
+ e2 = 2.0e0*e;
+ amax = 0.4e-10/(e*e);
+ iop = 1;
+ if(e > 1.e-10) iop = 2;
+ eps = eps0[iop-1];
+ xn = *x0;
+ if(*x0 > 0.0e0) goto S160;
+/*
+ SELECTION OF THE INITIAL APPROXIMATION XN OF X
+ WHEN A .LT. 1
+*/
+ if(*a > 1.0e0) goto S80;
+ T4 = *a+1.0e0;
+ g = Xgamm(&T4);
+ qg = *q*g;
+ if(qg == 0.0e0) goto S360;
+ b = qg/ *a;
+ if(qg > 0.6e0**a) goto S40;
+ if(*a >= 0.30e0 || b < 0.35e0) goto S10;
+ t = exp(-(b+c));
+ u = t*exp(t);
+ xn = t*exp(u);
+ goto S160;
+S10:
+ if(b >= 0.45e0) goto S40;
+ if(b == 0.0e0) goto S360;
+ y = -log(b);
+ s = 0.5e0+(0.5e0-*a);
+ z = log(y);
+ t = y-s*z;
+ if(b < 0.15e0) goto S20;
+ xn = y-s*log(t)-log(1.0e0+s/(t+1.0e0));
+ goto S220;
+S20:
+ if(b <= 0.01e0) goto S30;
+ u = ((t+2.0e0*(3.0e0-*a))*t+(2.0e0-*a)*(3.0e0-*a))/((t+(5.0e0-*a))*t+2.0e0);
+ xn = y-s*log(t)-log(u);
+ goto S220;
+S30:
+ c1 = -(s*z);
+ c2 = -(s*(1.0e0+c1));
+ c3 = s*((0.5e0*c1+(2.0e0-*a))*c1+(2.5e0-1.5e0**a));
+ c4 = -(s*(((c1/3.0e0+(2.5e0-1.5e0**a))*c1+((*a-6.0e0)**a+7.0e0))*c1+(
+ (11.0e0**a-46.0)**a+47.0e0)/6.0e0));
+ c5 = -(s*((((-(c1/4.0e0)+(11.0e0**a-17.0e0)/6.0e0)*c1+((-(3.0e0**a)+13.0e0)*
+ *a-13.0e0))*c1+0.5e0*(((2.0e0**a-25.0e0)**a+72.0e0)**a-61.0e0))*c1+((
+ (25.0e0**a-195.0e0)**a+477.0e0)**a-379.0e0)/12.0e0));
+ xn = (((c5/y+c4)/y+c3)/y+c2)/y+c1+y;
+ if(*a > 1.0e0) goto S220;
+ if(b > bmin[iop-1]) goto S220;
+ *x = xn;
+ return;
+S40:
+ if(b**q > 1.e-8) goto S50;
+ xn = exp(-(*q/ *a+c));
+ goto S70;
+S50:
+ if(*p <= 0.9e0) goto S60;
+ T5 = -*q;
+ xn = exp((alnrel(&T5)+gamln1(a))/ *a);
+ goto S70;
+S60:
+ xn = exp(log(*p*g)/ *a);
+S70:
+ if(xn == 0.0e0) goto S310;
+ t = 0.5e0+(0.5e0-xn/(*a+1.0e0));
+ xn /= t;
+ goto S160;
+S80:
+/*
+ SELECTION OF THE INITIAL APPROXIMATION XN OF X
+ WHEN A .GT. 1
+*/
+ if(*q <= 0.5e0) goto S90;
+ w = log(*p);
+ goto S100;
+S90:
+ w = log(*q);
+S100:
+ t = sqrt(-(2.0e0*w));
+ s = t-(((a3*t+a2)*t+a1)*t+a0)/((((b4*t+b3)*t+b2)*t+b1)*t+1.0e0);
+ if(*q > 0.5e0) s = -s;
+ rta = sqrt(*a);
+ s2 = s*s;
+ xn = *a+s*rta+(s2-1.0e0)/3.0e0+s*(s2-7.0e0)/(36.0e0*rta)-((3.0e0*s2+7.0e0)*
+ s2-16.0e0)/(810.0e0**a)+s*((9.0e0*s2+256.0e0)*s2-433.0e0)/(38880.0e0**a*
+ rta);
+ xn = fifdmax1(xn,0.0e0);
+ if(*a < amin[iop-1]) goto S110;
+ *x = xn;
+ d = 0.5e0+(0.5e0-*x/ *a);
+ if(fabs(d) <= dmin[iop-1]) return;
+S110:
+ if(*p <= 0.5e0) goto S130;
+ if(xn < 3.0e0**a) goto S220;
+ y = -(w+gamln(a));
+ d = fifdmax1(2.0e0,*a*(*a-1.0e0));
+ if(y < ln10*d) goto S120;
+ s = 1.0e0-*a;
+ z = log(y);
+ goto S30;
+S120:
+ t = *a-1.0e0;
+ T6 = -(t/(xn+1.0e0));
+ xn = y+t*log(xn)-alnrel(&T6);
+ T7 = -(t/(xn+1.0e0));
+ xn = y+t*log(xn)-alnrel(&T7);
+ goto S220;
+S130:
+ ap1 = *a+1.0e0;
+ if(xn > 0.70e0*ap1) goto S170;
+ w += gamln(&ap1);
+ if(xn > 0.15e0*ap1) goto S140;
+ ap2 = *a+2.0e0;
+ ap3 = *a+3.0e0;
+ *x = exp((w+*x)/ *a);
+ *x = exp((w+*x-log(1.0e0+*x/ap1*(1.0e0+*x/ap2)))/ *a);
+ *x = exp((w+*x-log(1.0e0+*x/ap1*(1.0e0+*x/ap2)))/ *a);
+ *x = exp((w+*x-log(1.0e0+*x/ap1*(1.0e0+*x/ap2*(1.0e0+*x/ap3))))/ *a);
+ xn = *x;
+ if(xn > 1.e-2*ap1) goto S140;
+ if(xn <= emin[iop-1]*ap1) return;
+ goto S170;
+S140:
+ apn = ap1;
+ t = xn/apn;
+ sum = 1.0e0+t;
+S150:
+ apn += 1.0e0;
+ t *= (xn/apn);
+ sum += t;
+ if(t > 1.e-4) goto S150;
+ t = w-log(sum);
+ xn = exp((xn+t)/ *a);
+ xn *= (1.0e0-(*a*log(xn)-xn-t)/(*a-xn));
+ goto S170;
+S160:
+/*
+ SCHRODER ITERATION USING P
+*/
+ if(*p > 0.5e0) goto S220;
+S170:
+ if(*p <= 1.e10*xmin) goto S350;
+ am1 = *a-0.5e0-0.5e0;
+S180:
+ if(*a <= amax) goto S190;
+ d = 0.5e0+(0.5e0-xn/ *a);
+ if(fabs(d) <= e2) goto S350;
+S190:
+ if(*ierr >= 20) goto S330;
+ *ierr += 1;
+ gratio(a,&xn,&pn,&qn,&K8);
+ if(pn == 0.0e0 || qn == 0.0e0) goto S350;
+ r = rcomp(a,&xn);
+ if(r == 0.0e0) goto S350;
+ t = (pn-*p)/r;
+ w = 0.5e0*(am1-xn);
+ if(fabs(t) <= 0.1e0 && fabs(w*t) <= 0.1e0) goto S200;
+ *x = xn*(1.0e0-t);
+ if(*x <= 0.0e0) goto S340;
+ d = fabs(t);
+ goto S210;
+S200:
+ h = t*(1.0e0+w*t);
+ *x = xn*(1.0e0-h);
+ if(*x <= 0.0e0) goto S340;
+ if(fabs(w) >= 1.0e0 && fabs(w)*t*t <= eps) return;
+ d = fabs(h);
+S210:
+ xn = *x;
+ if(d > tol) goto S180;
+ if(d <= eps) return;
+ if(fabs(*p-pn) <= tol**p) return;
+ goto S180;
+S220:
+/*
+ SCHRODER ITERATION USING Q
+*/
+ if(*q <= 1.e10*xmin) goto S350;
+ am1 = *a-0.5e0-0.5e0;
+S230:
+ if(*a <= amax) goto S240;
+ d = 0.5e0+(0.5e0-xn/ *a);
+ if(fabs(d) <= e2) goto S350;
+S240:
+ if(*ierr >= 20) goto S330;
+ *ierr += 1;
+ gratio(a,&xn,&pn,&qn,&K8);
+ if(pn == 0.0e0 || qn == 0.0e0) goto S350;
+ r = rcomp(a,&xn);
+ if(r == 0.0e0) goto S350;
+ t = (*q-qn)/r;
+ w = 0.5e0*(am1-xn);
+ if(fabs(t) <= 0.1e0 && fabs(w*t) <= 0.1e0) goto S250;
+ *x = xn*(1.0e0-t);
+ if(*x <= 0.0e0) goto S340;
+ d = fabs(t);
+ goto S260;
+S250:
+ h = t*(1.0e0+w*t);
+ *x = xn*(1.0e0-h);
+ if(*x <= 0.0e0) goto S340;
+ if(fabs(w) >= 1.0e0 && fabs(w)*t*t <= eps) return;
+ d = fabs(h);
+S260:
+ xn = *x;
+ if(d > tol) goto S230;
+ if(d <= eps) return;
+ if(fabs(*q-qn) <= tol**q) return;
+ goto S230;
+S270:
+/*
+ SPECIAL CASES
+*/
+ *x = xmax;
+ return;
+S280:
+ if(*q < 0.9e0) goto S290;
+ T9 = -*p;
+ *x = -alnrel(&T9);
+ return;
+S290:
+ *x = -log(*q);
+ return;
+S300:
+/*
+ ERROR RETURN
+*/
+ *ierr = -2;
+ return;
+S310:
+ *ierr = -3;
+ return;
+S320:
+ *ierr = -4;
+ return;
+S330:
+ *ierr = -6;
+ return;
+S340:
+ *ierr = -7;
+ return;
+S350:
+ *x = xn;
+ *ierr = -8;
+ return;
+S360:
+ *x = xmax;
+ *ierr = -8;
+ return;
+}
+double gamln(double *a)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF LN(GAMMA(A)) FOR POSITIVE A
+-----------------------------------------------------------------------
+ WRITTEN BY ALFRED H. MORRIS
+ NAVAL SURFACE WARFARE CENTER
+ DAHLGREN, VIRGINIA
+--------------------------
+ D = 0.5*(LN(2*PI) - 1)
+--------------------------
+*/
+{
+static double c0 = .833333333333333e-01;
+static double c1 = -.277777777760991e-02;
+static double c2 = .793650666825390e-03;
+static double c3 = -.595202931351870e-03;
+static double c4 = .837308034031215e-03;
+static double c5 = -.165322962780713e-02;
+static double d = .418938533204673e0;
+static double gamln,t,w;
+static int i,n;
+static double T1;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(*a > 0.8e0) goto S10;
+ gamln = gamln1(a)-log(*a);
+ return gamln;
+S10:
+ if(*a > 2.25e0) goto S20;
+ t = *a-0.5e0-0.5e0;
+ gamln = gamln1(&t);
+ return gamln;
+S20:
+ if(*a >= 10.0e0) goto S40;
+ n = (long)(*a - 1.25e0);
+ t = *a;
+ w = 1.0e0;
+ for(i=1; i<=n; i++) {
+ t -= 1.0e0;
+ w = t*w;
+ }
+ T1 = t-1.0e0;
+ gamln = gamln1(&T1)+log(w);
+ return gamln;
+S40:
+ t = pow(1.0e0/ *a,2.0);
+ w = (((((c5*t+c4)*t+c3)*t+c2)*t+c1)*t+c0)/ *a;
+ gamln = d+w+(*a-0.5e0)*(log(*a)-1.0e0);
+ return gamln;
+}
+double gamln1(double *a)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF LN(GAMMA(1 + A)) FOR -0.2 .LE. A .LE. 1.25
+-----------------------------------------------------------------------
+*/
+{
+static double p0 = .577215664901533e+00;
+static double p1 = .844203922187225e+00;
+static double p2 = -.168860593646662e+00;
+static double p3 = -.780427615533591e+00;
+static double p4 = -.402055799310489e+00;
+static double p5 = -.673562214325671e-01;
+static double p6 = -.271935708322958e-02;
+static double q1 = .288743195473681e+01;
+static double q2 = .312755088914843e+01;
+static double q3 = .156875193295039e+01;
+static double q4 = .361951990101499e+00;
+static double q5 = .325038868253937e-01;
+static double q6 = .667465618796164e-03;
+static double r0 = .422784335098467e+00;
+static double r1 = .848044614534529e+00;
+static double r2 = .565221050691933e+00;
+static double r3 = .156513060486551e+00;
+static double r4 = .170502484022650e-01;
+static double r5 = .497958207639485e-03;
+static double s1 = .124313399877507e+01;
+static double s2 = .548042109832463e+00;
+static double s3 = .101552187439830e+00;
+static double s4 = .713309612391000e-02;
+static double s5 = .116165475989616e-03;
+static double gamln1,w,x;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(*a >= 0.6e0) goto S10;
+ w = ((((((p6**a+p5)**a+p4)**a+p3)**a+p2)**a+p1)**a+p0)/((((((q6**a+q5)**a+
+ q4)**a+q3)**a+q2)**a+q1)**a+1.0e0);
+ gamln1 = -(*a*w);
+ return gamln1;
+S10:
+ x = *a-0.5e0-0.5e0;
+ w = (((((r5*x+r4)*x+r3)*x+r2)*x+r1)*x+r0)/(((((s5*x+s4)*x+s3)*x+s2)*x+s1)*x
+ +1.0e0);
+ gamln1 = x*w;
+ return gamln1;
+}
+double Xgamm(double *a)
+/*
+-----------------------------------------------------------------------
+
+ EVALUATION OF THE GAMMA FUNCTION FOR REAL ARGUMENTS
+
+ -----------
+
+ GAMMA(A) IS ASSIGNED THE VALUE 0 WHEN THE GAMMA FUNCTION CANNOT
+ BE COMPUTED.
+
+-----------------------------------------------------------------------
+ WRITTEN BY ALFRED H. MORRIS, JR.
+ NAVAL SURFACE WEAPONS CENTER
+ DAHLGREN, VIRGINIA
+-----------------------------------------------------------------------
+*/
+{
+static double d = .41893853320467274178e0;
+static double pi = 3.1415926535898e0;
+static double r1 = .820756370353826e-03;
+static double r2 = -.595156336428591e-03;
+static double r3 = .793650663183693e-03;
+static double r4 = -.277777777770481e-02;
+static double r5 = .833333333333333e-01;
+static double p[7] = {
+ .539637273585445e-03,.261939260042690e-02,.204493667594920e-01,
+ .730981088720487e-01,.279648642639792e+00,.553413866010467e+00,1.0e0
+};
+static double q[7] = {
+ -.832979206704073e-03,.470059485860584e-02,.225211131035340e-01,
+ -.170458969313360e+00,-.567902761974940e-01,.113062953091122e+01,1.0e0
+};
+static int K2 = 3;
+static int K3 = 0;
+static double Xgamm,bot,g,lnx,s,t,top,w,x,z;
+static int i,j,m,n,T1;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ Xgamm = 0.0e0;
+ x = *a;
+ if(fabs(*a) >= 15.0e0) goto S110;
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF GAMMA(A) FOR ABS(A) .LT. 15
+-----------------------------------------------------------------------
+*/
+ t = 1.0e0;
+ m = fifidint(*a)-1;
+/*
+ LET T BE THE PRODUCT OF A-J WHEN A .GE. 2
+*/
+ T1 = m;
+ if(T1 < 0) goto S40;
+ else if(T1 == 0) goto S30;
+ else goto S10;
+S10:
+ for(j=1; j<=m; j++) {
+ x -= 1.0e0;
+ t = x*t;
+ }
+S30:
+ x -= 1.0e0;
+ goto S80;
+S40:
+/*
+ LET T BE THE PRODUCT OF A+J WHEN A .LT. 1
+*/
+ t = *a;
+ if(*a > 0.0e0) goto S70;
+ m = -m-1;
+ if(m == 0) goto S60;
+ for(j=1; j<=m; j++) {
+ x += 1.0e0;
+ t = x*t;
+ }
+S60:
+ x += (0.5e0+0.5e0);
+ t = x*t;
+ if(t == 0.0e0) return Xgamm;
+S70:
+/*
+ THE FOLLOWING CODE CHECKS IF 1/T CAN OVERFLOW. THIS
+ CODE MAY BE OMITTED IF DESIRED.
+*/
+ if(fabs(t) >= 1.e-30) goto S80;
+ if(fabs(t)*spmpar(&K2) <= 1.0001e0) return Xgamm;
+ Xgamm = 1.0e0/t;
+ return Xgamm;
+S80:
+/*
+ COMPUTE GAMMA(1 + X) FOR 0 .LE. X .LT. 1
+*/
+ top = p[0];
+ bot = q[0];
+ for(i=1; i<7; i++) {
+ top = p[i]+x*top;
+ bot = q[i]+x*bot;
+ }
+ Xgamm = top/bot;
+/*
+ TERMINATION
+*/
+ if(*a < 1.0e0) goto S100;
+ Xgamm *= t;
+ return Xgamm;
+S100:
+ Xgamm /= t;
+ return Xgamm;
+S110:
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF GAMMA(A) FOR ABS(A) .GE. 15
+-----------------------------------------------------------------------
+*/
+ if(fabs(*a) >= 1.e3) return Xgamm;
+ if(*a > 0.0e0) goto S120;
+ x = -*a;
+ n = (long)(x);
+ t = x-(double)n;
+ if(t > 0.9e0) t = 1.0e0-t;
+ s = sin(pi*t)/pi;
+ if(fifmod(n,2) == 0) s = -s;
+ if(s == 0.0e0) return Xgamm;
+S120:
+/*
+ COMPUTE THE MODIFIED ASYMPTOTIC SUM
+*/
+ t = 1.0e0/(x*x);
+ g = ((((r1*t+r2)*t+r3)*t+r4)*t+r5)/x;
+/*
+ ONE MAY REPLACE THE NEXT STATEMENT WITH LNX = ALOG(X)
+ BUT LESS ACCURACY WILL NORMALLY BE OBTAINED.
+*/
+ lnx = log(x);
+/*
+ FINAL ASSEMBLY
+*/
+ z = x;
+ g = d+g+(z-0.5e0)*(lnx-1.e0);
+ w = g;
+ t = g-w;
+ if(w > 0.99999e0*exparg(&K3)) return Xgamm;
+ Xgamm = exp(w)*(1.0e0+t);
+ if(*a < 0.0e0) Xgamm = 1.0e0/(Xgamm*s)/x;
+ return Xgamm;
+}
+void grat1(double *a,double *x,double *r,double *p,double *q,
+ double *eps)
+{
+static int K2 = 0;
+static double a2n,a2nm1,am0,an,an0,b2n,b2nm1,c,cma,g,h,j,l,sum,t,tol,w,z,T1,T3;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF THE INCOMPLETE GAMMA RATIO FUNCTIONS
+ P(A,X) AND Q(A,X)
+ IT IS ASSUMED THAT A .LE. 1. EPS IS THE TOLERANCE TO BE USED.
+ THE INPUT ARGUMENT R HAS THE VALUE E**(-X)*X**A/GAMMA(A).
+-----------------------------------------------------------------------
+*/
+ if(*a**x == 0.0e0) goto S120;
+ if(*a == 0.5e0) goto S100;
+ if(*x < 1.1e0) goto S10;
+ goto S60;
+S10:
+/*
+ TAYLOR SERIES FOR P(A,X)/X**A
+*/
+ an = 3.0e0;
+ c = *x;
+ sum = *x/(*a+3.0e0);
+ tol = 0.1e0**eps/(*a+1.0e0);
+S20:
+ an += 1.0e0;
+ c = -(c*(*x/an));
+ t = c/(*a+an);
+ sum += t;
+ if(fabs(t) > tol) goto S20;
+ j = *a**x*((sum/6.0e0-0.5e0/(*a+2.0e0))**x+1.0e0/(*a+1.0e0));
+ z = *a*log(*x);
+ h = gam1(a);
+ g = 1.0e0+h;
+ if(*x < 0.25e0) goto S30;
+ if(*a < *x/2.59e0) goto S50;
+ goto S40;
+S30:
+ if(z > -.13394e0) goto S50;
+S40:
+ w = exp(z);
+ *p = w*g*(0.5e0+(0.5e0-j));
+ *q = 0.5e0+(0.5e0-*p);
+ return;
+S50:
+ l = rexp(&z);
+ w = 0.5e0+(0.5e0+l);
+ *q = (w*j-l)*g-h;
+ if(*q < 0.0e0) goto S90;
+ *p = 0.5e0+(0.5e0-*q);
+ return;
+S60:
+/*
+ CONTINUED FRACTION EXPANSION
+*/
+ a2nm1 = a2n = 1.0e0;
+ b2nm1 = *x;
+ b2n = *x+(1.0e0-*a);
+ c = 1.0e0;
+S70:
+ a2nm1 = *x*a2n+c*a2nm1;
+ b2nm1 = *x*b2n+c*b2nm1;
+ am0 = a2nm1/b2nm1;
+ c += 1.0e0;
+ cma = c-*a;
+ a2n = a2nm1+cma*a2n;
+ b2n = b2nm1+cma*b2n;
+ an0 = a2n/b2n;
+ if(fabs(an0-am0) >= *eps*an0) goto S70;
+ *q = *r*an0;
+ *p = 0.5e0+(0.5e0-*q);
+ return;
+S80:
+/*
+ SPECIAL CASES
+*/
+ *p = 0.0e0;
+ *q = 1.0e0;
+ return;
+S90:
+ *p = 1.0e0;
+ *q = 0.0e0;
+ return;
+S100:
+ if(*x >= 0.25e0) goto S110;
+ T1 = sqrt(*x);
+ *p = erf1(&T1);
+ *q = 0.5e0+(0.5e0-*p);
+ return;
+S110:
+ T3 = sqrt(*x);
+ *q = erfc1(&K2,&T3);
+ *p = 0.5e0+(0.5e0-*q);
+ return;
+S120:
+ if(*x <= *a) goto S80;
+ goto S90;
+}
+void gratio(double *a,double *x,double *ans,double *qans,int *ind)
+/*
+ ----------------------------------------------------------------------
+ EVALUATION OF THE INCOMPLETE GAMMA RATIO FUNCTIONS
+ P(A,X) AND Q(A,X)
+
+ ----------
+
+ IT IS ASSUMED THAT A AND X ARE NONNEGATIVE, WHERE A AND X
+ ARE NOT BOTH 0.
+
+ ANS AND QANS ARE VARIABLES. GRATIO ASSIGNS ANS THE VALUE
+ P(A,X) AND QANS THE VALUE Q(A,X). IND MAY BE ANY INTEGER.
+ IF IND = 0 THEN THE USER IS REQUESTING AS MUCH ACCURACY AS
+ POSSIBLE (UP TO 14 SIGNIFICANT DIGITS). OTHERWISE, IF
+ IND = 1 THEN ACCURACY IS REQUESTED TO WITHIN 1 UNIT OF THE
+ 6-TH SIGNIFICANT DIGIT, AND IF IND .NE. 0,1 THEN ACCURACY
+ IS REQUESTED TO WITHIN 1 UNIT OF THE 3RD SIGNIFICANT DIGIT.
+
+ ERROR RETURN ...
+ ANS IS ASSIGNED THE VALUE 2 WHEN A OR X IS NEGATIVE,
+ WHEN A*X = 0, OR WHEN P(A,X) AND Q(A,X) ARE INDETERMINANT.
+ P(A,X) AND Q(A,X) ARE COMPUTATIONALLY INDETERMINANT WHEN
+ X IS EXCEEDINGLY CLOSE TO A AND A IS EXTREMELY LARGE.
+ ----------------------------------------------------------------------
+ WRITTEN BY ALFRED H. MORRIS, JR.
+ NAVAL SURFACE WEAPONS CENTER
+ DAHLGREN, VIRGINIA
+ --------------------
+*/
+{
+static double alog10 = 2.30258509299405e0;
+static double d10 = -.185185185185185e-02;
+static double d20 = .413359788359788e-02;
+static double d30 = .649434156378601e-03;
+static double d40 = -.861888290916712e-03;
+static double d50 = -.336798553366358e-03;
+static double d60 = .531307936463992e-03;
+static double d70 = .344367606892378e-03;
+static double rt2pin = .398942280401433e0;
+static double rtpi = 1.77245385090552e0;
+static double third = .333333333333333e0;
+static double acc0[3] = {
+ 5.e-15,5.e-7,5.e-4
+};
+static double big[3] = {
+ 20.0e0,14.0e0,10.0e0
+};
+static double d0[13] = {
+ .833333333333333e-01,-.148148148148148e-01,.115740740740741e-02,
+ .352733686067019e-03,-.178755144032922e-03,.391926317852244e-04,
+ -.218544851067999e-05,-.185406221071516e-05,.829671134095309e-06,
+ -.176659527368261e-06,.670785354340150e-08,.102618097842403e-07,
+ -.438203601845335e-08
+};
+static double d1[12] = {
+ -.347222222222222e-02,.264550264550265e-02,-.990226337448560e-03,
+ .205761316872428e-03,-.401877572016461e-06,-.180985503344900e-04,
+ .764916091608111e-05,-.161209008945634e-05,.464712780280743e-08,
+ .137863344691572e-06,-.575254560351770e-07,.119516285997781e-07
+};
+static double d2[10] = {
+ -.268132716049383e-02,.771604938271605e-03,.200938786008230e-05,
+ -.107366532263652e-03,.529234488291201e-04,-.127606351886187e-04,
+ .342357873409614e-07,.137219573090629e-05,-.629899213838006e-06,
+ .142806142060642e-06
+};
+static double d3[8] = {
+ .229472093621399e-03,-.469189494395256e-03,.267720632062839e-03,
+ -.756180167188398e-04,-.239650511386730e-06,.110826541153473e-04,
+ -.567495282699160e-05,.142309007324359e-05
+};
+static double d4[6] = {
+ .784039221720067e-03,-.299072480303190e-03,-.146384525788434e-05,
+ .664149821546512e-04,-.396836504717943e-04,.113757269706784e-04
+};
+static double d5[4] = {
+ -.697281375836586e-04,.277275324495939e-03,-.199325705161888e-03,
+ .679778047793721e-04
+};
+static double d6[2] = {
+ -.592166437353694e-03,.270878209671804e-03
+};
+static double e00[3] = {
+ .25e-3,.25e-1,.14e0
+};
+static double x00[3] = {
+ 31.0e0,17.0e0,9.7e0
+};
+static int K1 = 1;
+static int K2 = 0;
+static double a2n,a2nm1,acc,am0,amn,an,an0,apn,b2n,b2nm1,c,c0,c1,c2,c3,c4,c5,c6,
+ cma,e,e0,g,h,j,l,r,rta,rtx,s,sum,t,t1,tol,twoa,u,w,x0,y,z;
+static int i,iop,m,max,n;
+static double wk[20],T3;
+static int T4,T5;
+static double T6,T7;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+ --------------------
+ ****** E IS A MACHINE DEPENDENT CONSTANT. E IS THE SMALLEST
+ FLOATING POINT NUMBER FOR WHICH 1.0 + E .GT. 1.0 .
+*/
+ e = spmpar(&K1);
+ if(*a < 0.0e0 || *x < 0.0e0) goto S430;
+ if(*a == 0.0e0 && *x == 0.0e0) goto S430;
+ if(*a**x == 0.0e0) goto S420;
+ iop = *ind+1;
+ if(iop != 1 && iop != 2) iop = 3;
+ acc = fifdmax1(acc0[iop-1],e);
+ e0 = e00[iop-1];
+ x0 = x00[iop-1];
+/*
+ SELECT THE APPROPRIATE ALGORITHM
+*/
+ if(*a >= 1.0e0) goto S10;
+ if(*a == 0.5e0) goto S390;
+ if(*x < 1.1e0) goto S160;
+ t1 = *a*log(*x)-*x;
+ u = *a*exp(t1);
+ if(u == 0.0e0) goto S380;
+ r = u*(1.0e0+gam1(a));
+ goto S250;
+S10:
+ if(*a >= big[iop-1]) goto S30;
+ if(*a > *x || *x >= x0) goto S20;
+ twoa = *a+*a;
+ m = fifidint(twoa);
+ if(twoa != (double)m) goto S20;
+ i = m/2;
+ if(*a == (double)i) goto S210;
+ goto S220;
+S20:
+ t1 = *a*log(*x)-*x;
+ r = exp(t1)/Xgamm(a);
+ goto S40;
+S30:
+ l = *x/ *a;
+ if(l == 0.0e0) goto S370;
+ s = 0.5e0+(0.5e0-l);
+ z = rlog(&l);
+ if(z >= 700.0e0/ *a) goto S410;
+ y = *a*z;
+ rta = sqrt(*a);
+ if(fabs(s) <= e0/rta) goto S330;
+ if(fabs(s) <= 0.4e0) goto S270;
+ t = pow(1.0e0/ *a,2.0);
+ t1 = (((0.75e0*t-1.0e0)*t+3.5e0)*t-105.0e0)/(*a*1260.0e0);
+ t1 -= y;
+ r = rt2pin*rta*exp(t1);
+S40:
+ if(r == 0.0e0) goto S420;
+ if(*x <= fifdmax1(*a,alog10)) goto S50;
+ if(*x < x0) goto S250;
+ goto S100;
+S50:
+/*
+ TAYLOR SERIES FOR P/R
+*/
+ apn = *a+1.0e0;
+ t = *x/apn;
+ wk[0] = t;
+ for(n=2; n<=20; n++) {
+ apn += 1.0e0;
+ t *= (*x/apn);
+ if(t <= 1.e-3) goto S70;
+ wk[n-1] = t;
+ }
+ n = 20;
+S70:
+ sum = t;
+ tol = 0.5e0*acc;
+S80:
+ apn += 1.0e0;
+ t *= (*x/apn);
+ sum += t;
+ if(t > tol) goto S80;
+ max = n-1;
+ for(m=1; m<=max; m++) {
+ n -= 1;
+ sum += wk[n-1];
+ }
+ *ans = r/ *a*(1.0e0+sum);
+ *qans = 0.5e0+(0.5e0-*ans);
+ return;
+S100:
+/*
+ ASYMPTOTIC EXPANSION
+*/
+ amn = *a-1.0e0;
+ t = amn/ *x;
+ wk[0] = t;
+ for(n=2; n<=20; n++) {
+ amn -= 1.0e0;
+ t *= (amn/ *x);
+ if(fabs(t) <= 1.e-3) goto S120;
+ wk[n-1] = t;
+ }
+ n = 20;
+S120:
+ sum = t;
+S130:
+ if(fabs(t) <= acc) goto S140;
+ amn -= 1.0e0;
+ t *= (amn/ *x);
+ sum += t;
+ goto S130;
+S140:
+ max = n-1;
+ for(m=1; m<=max; m++) {
+ n -= 1;
+ sum += wk[n-1];
+ }
+ *qans = r/ *x*(1.0e0+sum);
+ *ans = 0.5e0+(0.5e0-*qans);
+ return;
+S160:
+/*
+ TAYLOR SERIES FOR P(A,X)/X**A
+*/
+ an = 3.0e0;
+ c = *x;
+ sum = *x/(*a+3.0e0);
+ tol = 3.0e0*acc/(*a+1.0e0);
+S170:
+ an += 1.0e0;
+ c = -(c*(*x/an));
+ t = c/(*a+an);
+ sum += t;
+ if(fabs(t) > tol) goto S170;
+ j = *a**x*((sum/6.0e0-0.5e0/(*a+2.0e0))**x+1.0e0/(*a+1.0e0));
+ z = *a*log(*x);
+ h = gam1(a);
+ g = 1.0e0+h;
+ if(*x < 0.25e0) goto S180;
+ if(*a < *x/2.59e0) goto S200;
+ goto S190;
+S180:
+ if(z > -.13394e0) goto S200;
+S190:
+ w = exp(z);
+ *ans = w*g*(0.5e0+(0.5e0-j));
+ *qans = 0.5e0+(0.5e0-*ans);
+ return;
+S200:
+ l = rexp(&z);
+ w = 0.5e0+(0.5e0+l);
+ *qans = (w*j-l)*g-h;
+ if(*qans < 0.0e0) goto S380;
+ *ans = 0.5e0+(0.5e0-*qans);
+ return;
+S210:
+/*
+ FINITE SUMS FOR Q WHEN A .GE. 1
+ AND 2*A IS AN INTEGER
+*/
+ sum = exp(-*x);
+ t = sum;
+ n = 1;
+ c = 0.0e0;
+ goto S230;
+S220:
+ rtx = sqrt(*x);
+ sum = erfc1(&K2,&rtx);
+ t = exp(-*x)/(rtpi*rtx);
+ n = 0;
+ c = -0.5e0;
+S230:
+ if(n == i) goto S240;
+ n += 1;
+ c += 1.0e0;
+ t = *x*t/c;
+ sum += t;
+ goto S230;
+S240:
+ *qans = sum;
+ *ans = 0.5e0+(0.5e0-*qans);
+ return;
+S250:
+/*
+ CONTINUED FRACTION EXPANSION
+*/
+ tol = fifdmax1(5.0e0*e,acc);
+ a2nm1 = a2n = 1.0e0;
+ b2nm1 = *x;
+ b2n = *x+(1.0e0-*a);
+ c = 1.0e0;
+S260:
+ a2nm1 = *x*a2n+c*a2nm1;
+ b2nm1 = *x*b2n+c*b2nm1;
+ am0 = a2nm1/b2nm1;
+ c += 1.0e0;
+ cma = c-*a;
+ a2n = a2nm1+cma*a2n;
+ b2n = b2nm1+cma*b2n;
+ an0 = a2n/b2n;
+ if(fabs(an0-am0) >= tol*an0) goto S260;
+ *qans = r*an0;
+ *ans = 0.5e0+(0.5e0-*qans);
+ return;
+S270:
+/*
+ GENERAL TEMME EXPANSION
+*/
+ if(fabs(s) <= 2.0e0*e && *a*e*e > 3.28e-3) goto S430;
+ c = exp(-y);
+ T3 = sqrt(y);
+ w = 0.5e0*erfc1(&K1,&T3);
+ u = 1.0e0/ *a;
+ z = sqrt(z+z);
+ if(l < 1.0e0) z = -z;
+ T4 = iop-2;
+ if(T4 < 0) goto S280;
+ else if(T4 == 0) goto S290;
+ else goto S300;
+S280:
+ if(fabs(s) <= 1.e-3) goto S340;
+ c0 = ((((((((((((d0[12]*z+d0[11])*z+d0[10])*z+d0[9])*z+d0[8])*z+d0[7])*z+d0[
+ 6])*z+d0[5])*z+d0[4])*z+d0[3])*z+d0[2])*z+d0[1])*z+d0[0])*z-third;
+ c1 = (((((((((((d1[11]*z+d1[10])*z+d1[9])*z+d1[8])*z+d1[7])*z+d1[6])*z+d1[5]
+ )*z+d1[4])*z+d1[3])*z+d1[2])*z+d1[1])*z+d1[0])*z+d10;
+ c2 = (((((((((d2[9]*z+d2[8])*z+d2[7])*z+d2[6])*z+d2[5])*z+d2[4])*z+d2[3])*z+
+ d2[2])*z+d2[1])*z+d2[0])*z+d20;
+ c3 = (((((((d3[7]*z+d3[6])*z+d3[5])*z+d3[4])*z+d3[3])*z+d3[2])*z+d3[1])*z+
+ d3[0])*z+d30;
+ c4 = (((((d4[5]*z+d4[4])*z+d4[3])*z+d4[2])*z+d4[1])*z+d4[0])*z+d40;
+ c5 = (((d5[3]*z+d5[2])*z+d5[1])*z+d5[0])*z+d50;
+ c6 = (d6[1]*z+d6[0])*z+d60;
+ t = ((((((d70*u+c6)*u+c5)*u+c4)*u+c3)*u+c2)*u+c1)*u+c0;
+ goto S310;
+S290:
+ c0 = (((((d0[5]*z+d0[4])*z+d0[3])*z+d0[2])*z+d0[1])*z+d0[0])*z-third;
+ c1 = (((d1[3]*z+d1[2])*z+d1[1])*z+d1[0])*z+d10;
+ c2 = d2[0]*z+d20;
+ t = (c2*u+c1)*u+c0;
+ goto S310;
+S300:
+ t = ((d0[2]*z+d0[1])*z+d0[0])*z-third;
+S310:
+ if(l < 1.0e0) goto S320;
+ *qans = c*(w+rt2pin*t/rta);
+ *ans = 0.5e0+(0.5e0-*qans);
+ return;
+S320:
+ *ans = c*(w-rt2pin*t/rta);
+ *qans = 0.5e0+(0.5e0-*ans);
+ return;
+S330:
+/*
+ TEMME EXPANSION FOR L = 1
+*/
+ if(*a*e*e > 3.28e-3) goto S430;
+ c = 0.5e0+(0.5e0-y);
+ w = (0.5e0-sqrt(y)*(0.5e0+(0.5e0-y/3.0e0))/rtpi)/c;
+ u = 1.0e0/ *a;
+ z = sqrt(z+z);
+ if(l < 1.0e0) z = -z;
+ T5 = iop-2;
+ if(T5 < 0) goto S340;
+ else if(T5 == 0) goto S350;
+ else goto S360;
+S340:
+ c0 = ((((((d0[6]*z+d0[5])*z+d0[4])*z+d0[3])*z+d0[2])*z+d0[1])*z+d0[0])*z-
+ third;
+ c1 = (((((d1[5]*z+d1[4])*z+d1[3])*z+d1[2])*z+d1[1])*z+d1[0])*z+d10;
+ c2 = ((((d2[4]*z+d2[3])*z+d2[2])*z+d2[1])*z+d2[0])*z+d20;
+ c3 = (((d3[3]*z+d3[2])*z+d3[1])*z+d3[0])*z+d30;
+ c4 = (d4[1]*z+d4[0])*z+d40;
+ c5 = (d5[1]*z+d5[0])*z+d50;
+ c6 = d6[0]*z+d60;
+ t = ((((((d70*u+c6)*u+c5)*u+c4)*u+c3)*u+c2)*u+c1)*u+c0;
+ goto S310;
+S350:
+ c0 = (d0[1]*z+d0[0])*z-third;
+ c1 = d1[0]*z+d10;
+ t = (d20*u+c1)*u+c0;
+ goto S310;
+S360:
+ t = d0[0]*z-third;
+ goto S310;
+S370:
+/*
+ SPECIAL CASES
+*/
+ *ans = 0.0e0;
+ *qans = 1.0e0;
+ return;
+S380:
+ *ans = 1.0e0;
+ *qans = 0.0e0;
+ return;
+S390:
+ if(*x >= 0.25e0) goto S400;
+ T6 = sqrt(*x);
+ *ans = erf1(&T6);
+ *qans = 0.5e0+(0.5e0-*ans);
+ return;
+S400:
+ T7 = sqrt(*x);
+ *qans = erfc1(&K2,&T7);
+ *ans = 0.5e0+(0.5e0-*qans);
+ return;
+S410:
+ if(fabs(s) <= 2.0e0*e) goto S430;
+S420:
+ if(*x <= *a) goto S370;
+ goto S380;
+S430:
+/*
+ ERROR RETURN
+*/
+ *ans = 2.0e0;
+ return;
+}
+double gsumln(double *a,double *b)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF THE FUNCTION LN(GAMMA(A + B))
+ FOR 1 .LE. A .LE. 2 AND 1 .LE. B .LE. 2
+-----------------------------------------------------------------------
+*/
+{
+static double gsumln,x,T1,T2;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ x = *a+*b-2.e0;
+ if(x > 0.25e0) goto S10;
+ T1 = 1.0e0+x;
+ gsumln = gamln1(&T1);
+ return gsumln;
+S10:
+ if(x > 1.25e0) goto S20;
+ gsumln = gamln1(&x)+alnrel(&x);
+ return gsumln;
+S20:
+ T2 = x-1.0e0;
+ gsumln = gamln1(&T2)+log(x*(1.0e0+x));
+ return gsumln;
+}
+double psi(double *xx)
+/*
+---------------------------------------------------------------------
+
+ EVALUATION OF THE DIGAMMA FUNCTION
+
+ -----------
+
+ PSI(XX) IS ASSIGNED THE VALUE 0 WHEN THE DIGAMMA FUNCTION CANNOT
+ BE COMPUTED.
+
+ THE MAIN COMPUTATION INVOLVES EVALUATION OF RATIONAL CHEBYSHEV
+ APPROXIMATIONS PUBLISHED IN MATH. COMP. 27, 123-127(1973) BY
+ CODY, STRECOK AND THACHER.
+
+---------------------------------------------------------------------
+ PSI WAS WRITTEN AT ARGONNE NATIONAL LABORATORY FOR THE FUNPACK
+ PACKAGE OF SPECIAL FUNCTION SUBROUTINES. PSI WAS MODIFIED BY
+ A.H. MORRIS (NSWC).
+---------------------------------------------------------------------
+*/
+{
+static double dx0 = 1.461632144968362341262659542325721325e0;
+static double piov4 = .785398163397448e0;
+static double p1[7] = {
+ .895385022981970e-02,.477762828042627e+01,.142441585084029e+03,
+ .118645200713425e+04,.363351846806499e+04,.413810161269013e+04,
+ .130560269827897e+04
+};
+static double p2[4] = {
+ -.212940445131011e+01,-.701677227766759e+01,-.448616543918019e+01,
+ -.648157123766197e+00
+};
+static double q1[6] = {
+ .448452573429826e+02,.520752771467162e+03,.221000799247830e+04,
+ .364127349079381e+04,.190831076596300e+04,.691091682714533e-05
+};
+static double q2[4] = {
+ .322703493791143e+02,.892920700481861e+02,.546117738103215e+02,
+ .777788548522962e+01
+};
+static int K1 = 3;
+static int K2 = 1;
+static double psi,aug,den,sgn,upper,w,x,xmax1,xmx0,xsmall,z;
+static int i,m,n,nq;
+/*
+ ..
+ .. Executable Statements ..
+*/
+/*
+---------------------------------------------------------------------
+ MACHINE DEPENDENT CONSTANTS ...
+ XMAX1 = THE SMALLEST POSITIVE FLOATING POINT CONSTANT
+ WITH ENTIRELY INTEGER REPRESENTATION. ALSO USED
+ AS NEGATIVE OF LOWER BOUND ON ACCEPTABLE NEGATIVE
+ ARGUMENTS AND AS THE POSITIVE ARGUMENT BEYOND WHICH
+ PSI MAY BE REPRESENTED AS ALOG(X).
+ XSMALL = ABSOLUTE ARGUMENT BELOW WHICH PI*COTAN(PI*X)
+ MAY BE REPRESENTED BY 1/X.
+---------------------------------------------------------------------
+*/
+ xmax1 = ipmpar(&K1);
+ xmax1 = fifdmin1(xmax1,1.0e0/spmpar(&K2));
+ xsmall = 1.e-9;
+ x = *xx;
+ aug = 0.0e0;
+ if(x >= 0.5e0) goto S50;
+/*
+---------------------------------------------------------------------
+ X .LT. 0.5, USE REFLECTION FORMULA
+ PSI(1-X) = PSI(X) + PI * COTAN(PI*X)
+---------------------------------------------------------------------
+*/
+ if(fabs(x) > xsmall) goto S10;
+ if(x == 0.0e0) goto S100;
+/*
+---------------------------------------------------------------------
+ 0 .LT. ABS(X) .LE. XSMALL. USE 1/X AS A SUBSTITUTE
+ FOR PI*COTAN(PI*X)
+---------------------------------------------------------------------
+*/
+ aug = -(1.0e0/x);
+ goto S40;
+S10:
+/*
+---------------------------------------------------------------------
+ REDUCTION OF ARGUMENT FOR COTAN
+---------------------------------------------------------------------
+*/
+ w = -x;
+ sgn = piov4;
+ if(w > 0.0e0) goto S20;
+ w = -w;
+ sgn = -sgn;
+S20:
+/*
+---------------------------------------------------------------------
+ MAKE AN ERROR EXIT IF X .LE. -XMAX1
+---------------------------------------------------------------------
+*/
+ if(w >= xmax1) goto S100;
+ nq = fifidint(w);
+ w -= (double)nq;
+ nq = fifidint(w*4.0e0);
+ w = 4.0e0*(w-(double)nq*.25e0);
+/*
+---------------------------------------------------------------------
+ W IS NOW RELATED TO THE FRACTIONAL PART OF 4.0 * X.
+ ADJUST ARGUMENT TO CORRESPOND TO VALUES IN FIRST
+ QUADRANT AND DETERMINE SIGN
+---------------------------------------------------------------------
+*/
+ n = nq/2;
+ if(n+n != nq) w = 1.0e0-w;
+ z = piov4*w;
+ m = n/2;
+ if(m+m != n) sgn = -sgn;
+/*
+---------------------------------------------------------------------
+ DETERMINE FINAL VALUE FOR -PI*COTAN(PI*X)
+---------------------------------------------------------------------
+*/
+ n = (nq+1)/2;
+ m = n/2;
+ m += m;
+ if(m != n) goto S30;
+/*
+---------------------------------------------------------------------
+ CHECK FOR SINGULARITY
+---------------------------------------------------------------------
+*/
+ if(z == 0.0e0) goto S100;
+/*
+---------------------------------------------------------------------
+ USE COS/SIN AS A SUBSTITUTE FOR COTAN, AND
+ SIN/COS AS A SUBSTITUTE FOR TAN
+---------------------------------------------------------------------
+*/
+ aug = sgn*(cos(z)/sin(z)*4.0e0);
+ goto S40;
+S30:
+ aug = sgn*(sin(z)/cos(z)*4.0e0);
+S40:
+ x = 1.0e0-x;
+S50:
+ if(x > 3.0e0) goto S70;
+/*
+---------------------------------------------------------------------
+ 0.5 .LE. X .LE. 3.0
+---------------------------------------------------------------------
+*/
+ den = x;
+ upper = p1[0]*x;
+ for(i=1; i<=5; i++) {
+ den = (den+q1[i-1])*x;
+ upper = (upper+p1[i+1-1])*x;
+ }
+ den = (upper+p1[6])/(den+q1[5]);
+ xmx0 = x-dx0;
+ psi = den*xmx0+aug;
+ return psi;
+S70:
+/*
+---------------------------------------------------------------------
+ IF X .GE. XMAX1, PSI = LN(X)
+---------------------------------------------------------------------
+*/
+ if(x >= xmax1) goto S90;
+/*
+---------------------------------------------------------------------
+ 3.0 .LT. X .LT. XMAX1
+---------------------------------------------------------------------
+*/
+ w = 1.0e0/(x*x);
+ den = w;
+ upper = p2[0]*w;
+ for(i=1; i<=3; i++) {
+ den = (den+q2[i-1])*w;
+ upper = (upper+p2[i+1-1])*w;
+ }
+ aug = upper/(den+q2[3])-0.5e0/x+aug;
+S90:
+ psi = aug+log(x);
+ return psi;
+S100:
+/*
+---------------------------------------------------------------------
+ ERROR RETURN
+---------------------------------------------------------------------
+*/
+ psi = 0.0e0;
+ return psi;
+}
+double rcomp(double *a,double *x)
+/*
+ -------------------
+ EVALUATION OF EXP(-X)*X**A/GAMMA(A)
+ -------------------
+ RT2PIN = 1/SQRT(2*PI)
+ -------------------
+*/
+{
+static double rt2pin = .398942280401433e0;
+static double rcomp,t,t1,u;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ rcomp = 0.0e0;
+ if(*a >= 20.0e0) goto S20;
+ t = *a*log(*x)-*x;
+ if(*a >= 1.0e0) goto S10;
+ rcomp = *a*exp(t)*(1.0e0+gam1(a));
+ return rcomp;
+S10:
+ rcomp = exp(t)/Xgamm(a);
+ return rcomp;
+S20:
+ u = *x/ *a;
+ if(u == 0.0e0) return rcomp;
+ t = pow(1.0e0/ *a,2.0);
+ t1 = (((0.75e0*t-1.0e0)*t+3.5e0)*t-105.0e0)/(*a*1260.0e0);
+ t1 -= (*a*rlog(&u));
+ rcomp = rt2pin*sqrt(*a)*exp(t1);
+ return rcomp;
+}
+double rexp(double *x)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF THE FUNCTION EXP(X) - 1
+-----------------------------------------------------------------------
+*/
+{
+static double p1 = .914041914819518e-09;
+static double p2 = .238082361044469e-01;
+static double q1 = -.499999999085958e+00;
+static double q2 = .107141568980644e+00;
+static double q3 = -.119041179760821e-01;
+static double q4 = .595130811860248e-03;
+static double rexp,w;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(fabs(*x) > 0.15e0) goto S10;
+ rexp = *x*(((p2**x+p1)**x+1.0e0)/((((q4**x+q3)**x+q2)**x+q1)**x+1.0e0));
+ return rexp;
+S10:
+ w = exp(*x);
+ if(*x > 0.0e0) goto S20;
+ rexp = w-0.5e0-0.5e0;
+ return rexp;
+S20:
+ rexp = w*(0.5e0+(0.5e0-1.0e0/w));
+ return rexp;
+}
+double rlog(double *x)
+/*
+ -------------------
+ COMPUTATION OF X - 1 - LN(X)
+ -------------------
+*/
+{
+static double a = .566749439387324e-01;
+static double b = .456512608815524e-01;
+static double p0 = .333333333333333e+00;
+static double p1 = -.224696413112536e+00;
+static double p2 = .620886815375787e-02;
+static double q1 = -.127408923933623e+01;
+static double q2 = .354508718369557e+00;
+static double rlog,r,t,u,w,w1;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(*x < 0.61e0 || *x > 1.57e0) goto S40;
+ if(*x < 0.82e0) goto S10;
+ if(*x > 1.18e0) goto S20;
+/*
+ ARGUMENT REDUCTION
+*/
+ u = *x-0.5e0-0.5e0;
+ w1 = 0.0e0;
+ goto S30;
+S10:
+ u = *x-0.7e0;
+ u /= 0.7e0;
+ w1 = a-u*0.3e0;
+ goto S30;
+S20:
+ u = 0.75e0**x-1.e0;
+ w1 = b+u/3.0e0;
+S30:
+/*
+ SERIES EXPANSION
+*/
+ r = u/(u+2.0e0);
+ t = r*r;
+ w = ((p2*t+p1)*t+p0)/((q2*t+q1)*t+1.0e0);
+ rlog = 2.0e0*t*(1.0e0/(1.0e0-r)-r*w)+w1;
+ return rlog;
+S40:
+ r = *x-0.5e0-0.5e0;
+ rlog = r-log(*x);
+ return rlog;
+}
+double rlog1(double *x)
+/*
+-----------------------------------------------------------------------
+ EVALUATION OF THE FUNCTION X - LN(1 + X)
+-----------------------------------------------------------------------
+*/
+{
+static double a = .566749439387324e-01;
+static double b = .456512608815524e-01;
+static double p0 = .333333333333333e+00;
+static double p1 = -.224696413112536e+00;
+static double p2 = .620886815375787e-02;
+static double q1 = -.127408923933623e+01;
+static double q2 = .354508718369557e+00;
+static double rlog1,h,r,t,w,w1;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(*x < -0.39e0 || *x > 0.57e0) goto S40;
+ if(*x < -0.18e0) goto S10;
+ if(*x > 0.18e0) goto S20;
+/*
+ ARGUMENT REDUCTION
+*/
+ h = *x;
+ w1 = 0.0e0;
+ goto S30;
+S10:
+ h = *x+0.3e0;
+ h /= 0.7e0;
+ w1 = a-h*0.3e0;
+ goto S30;
+S20:
+ h = 0.75e0**x-0.25e0;
+ w1 = b+h/3.0e0;
+S30:
+/*
+ SERIES EXPANSION
+*/
+ r = h/(h+2.0e0);
+ t = r*r;
+ w = ((p2*t+p1)*t+p0)/((q2*t+q1)*t+1.0e0);
+ rlog1 = 2.0e0*t*(1.0e0/(1.0e0-r)-r*w)+w1;
+ return rlog1;
+S40:
+ w = *x+0.5e0+0.5e0;
+ rlog1 = *x-log(w);
+ return rlog1;
+}
+double spmpar(int *i)
+/*
+-----------------------------------------------------------------------
+
+ SPMPAR PROVIDES THE SINGLE PRECISION MACHINE CONSTANTS FOR
+ THE COMPUTER BEING USED. IT IS ASSUMED THAT THE ARGUMENT
+ I IS AN INTEGER HAVING ONE OF THE VALUES 1, 2, OR 3. IF THE
+ SINGLE PRECISION ARITHMETIC BEING USED HAS M BASE B DIGITS AND
+ ITS SMALLEST AND LARGEST EXPONENTS ARE EMIN AND EMAX, THEN
+
+ SPMPAR(1) = B**(1 - M), THE MACHINE PRECISION,
+
+ SPMPAR(2) = B**(EMIN - 1), THE SMALLEST MAGNITUDE,
+
+ SPMPAR(3) = B**EMAX*(1 - B**(-M)), THE LARGEST MAGNITUDE.
+
+-----------------------------------------------------------------------
+ WRITTEN BY
+ ALFRED H. MORRIS, JR.
+ NAVAL SURFACE WARFARE CENTER
+ DAHLGREN VIRGINIA
+-----------------------------------------------------------------------
+-----------------------------------------------------------------------
+ MODIFIED BY BARRY W. BROWN TO RETURN DOUBLE PRECISION MACHINE
+ CONSTANTS FOR THE COMPUTER BEING USED. THIS MODIFICATION WAS
+ MADE AS PART OF CONVERTING BRATIO TO DOUBLE PRECISION
+-----------------------------------------------------------------------
+*/
+{
+static int K1 = 4;
+static int K2 = 8;
+static int K3 = 9;
+static int K4 = 10;
+static double spmpar,b,binv,bm1,one,w,z;
+static int emax,emin,ibeta,m;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(*i > 1) goto S10;
+ b = ipmpar(&K1);
+ m = ipmpar(&K2);
+ spmpar = pow(b,(double)(1-m));
+ return spmpar;
+S10:
+ if(*i > 2) goto S20;
+ b = ipmpar(&K1);
+ emin = ipmpar(&K3);
+ one = 1.0;
+ binv = one/b;
+ w = pow(b,(double)(emin+2));
+ spmpar = w*binv*binv*binv;
+ return spmpar;
+S20:
+ ibeta = ipmpar(&K1);
+ m = ipmpar(&K2);
+ emax = ipmpar(&K4);
+ b = ibeta;
+ bm1 = ibeta-1;
+ one = 1.0;
+ z = pow(b,(double)(m-1));
+ w = ((z-one)*b+bm1)/(b*z);
+ z = pow(b,(double)(emax-2));
+ spmpar = w*z*b*b;
+ return spmpar;
+}
+double stvaln(double *p)
+/*
+**********************************************************************
+
+ double stvaln(double *p)
+ STarting VALue for Neton-Raphon
+ calculation of Normal distribution Inverse
+
+
+ Function
+
+
+ Returns X such that CUMNOR(X) = P, i.e., the integral from -
+ infinity to X of (1/SQRT(2*PI)) EXP(-U*U/2) dU is P
+
+
+ Arguments
+
+
+ P --> The probability whose normal deviate is sought.
+ P is DOUBLE PRECISION
+
+
+ Method
+
+
+ The rational function on page 95 of Kennedy and Gentle,
+ Statistical Computing, Marcel Dekker, NY , 1980.
+
+**********************************************************************
+*/
+{
+static double xden[5] = {
+ 0.993484626060e-1,0.588581570495e0,0.531103462366e0,0.103537752850e0,
+ 0.38560700634e-2
+};
+static double xnum[5] = {
+ -0.322232431088e0,-1.000000000000e0,-0.342242088547e0,-0.204231210245e-1,
+ -0.453642210148e-4
+};
+static int K1 = 5;
+static double stvaln,sign,y,z;
+/*
+ ..
+ .. Executable Statements ..
+*/
+ if(!(*p <= 0.5e0)) goto S10;
+ sign = -1.0e0;
+ z = *p;
+ goto S20;
+S10:
+ sign = 1.0e0;
+ z = 1.0e0-*p;
+S20:
+ y = sqrt(-(2.0e0*log(z)));
+ stvaln = y+devlpl(xnum,&K1,&y)/devlpl(xden,&K1,&y);
+ stvaln = sign*stvaln;
+ return stvaln;
+}
+/************************************************************************
+FIFDINT:
+Truncates a double precision number to an integer and returns the
+value in a double.
+************************************************************************/
+double fifdint(double a)
+/* a - number to be truncated */
+{
+ long temp;
+ temp = (long)(a);
+ return (double)(temp);
+}
+/************************************************************************
+FIFDMAX1:
+returns the maximum of two numbers a and b
+************************************************************************/
+double fifdmax1(double a,double b)
+/* a - first number */
+/* b - second number */
+{
+ if (a < b) return b;
+ else return a;
+}
+/************************************************************************
+FIFDMIN1:
+returns the minimum of two numbers a and b
+************************************************************************/
+double fifdmin1(double a,double b)
+/* a - first number */
+/* b - second number */
+{
+ if (a < b) return a;
+ else return b;
+}
+/************************************************************************
+FIFDSIGN:
+transfers the sign of the variable "sign" to the variable "mag"
+************************************************************************/
+double fifdsign(double mag,double sign)
+/* mag - magnitude */
+/* sign - sign to be transfered */
+{
+ if (mag < 0) mag = -mag;
+ if (sign < 0) mag = -mag;
+ return mag;
+
+}
+/************************************************************************
+FIFIDINT:
+Truncates a double precision number to a long integer
+************************************************************************/
+long fifidint(double a)
+/* a - number to be truncated */
+{
+ return (long)(a);
+}
+/************************************************************************
+FIFMOD:
+returns the modulo of a and b
+************************************************************************/
+long fifmod(long a,long b)
+/* a - numerator */
+/* b - denominator */
+{
+ return a % b;
+}
+/************************************************************************
+FTNSTOP:
+Prints msg to standard error and then exits
+************************************************************************/
+void ftnstop(char* msg)
+/* msg - error message */
+{
+ if (msg != NULL) fprintf(stderr,"%s\n",msg);
+ exit(EXIT_FAILURE); /* EXIT_FAILURE from stdlib.h, or use an int */
+}
--- /dev/null
+#include <config.h>
+
+#include "limits.h"
+
+/* Edited 12/22/97 by Ben Pfaff for PSPP. */
+
+int ipmpar(int*);
+/*
+-----------------------------------------------------------------------
+
+ IPMPAR PROVIDES THE INTEGER MACHINE CONSTANTS FOR THE COMPUTER
+ THAT IS USED. IT IS ASSUMED THAT THE ARGUMENT I IS AN INTEGER
+ HAVING ONE OF THE VALUES 1-10. IPMPAR(I) HAS THE VALUE ...
+
+ INTEGERS.
+
+ ASSUME INTEGERS ARE REPRESENTED IN THE N-DIGIT, BASE-A FORM
+
+ SIGN ( X(N-1)*A**(N-1) + ... + X(1)*A + X(0) )
+
+ WHERE 0 .LE. X(I) .LT. A FOR I=0,...,N-1.
+
+ IPMPAR(1) = A, THE BASE.
+
+ IPMPAR(2) = N, THE NUMBER OF BASE-A DIGITS.
+
+ IPMPAR(3) = A**N - 1, THE LARGEST MAGNITUDE.
+
+ FLOATING-POINT NUMBERS.
+
+ IT IS ASSUMED THAT THE SINGLE AND DOUBLE PRECISION FLOATING
+ POINT ARITHMETICS HAVE THE SAME BASE, SAY B, AND THAT THE
+ NONZERO NUMBERS ARE REPRESENTED IN THE FORM
+
+ SIGN (B**E) * (X(1)/B + ... + X(M)/B**M)
+
+ WHERE X(I) = 0,1,...,B-1 FOR I=1,...,M,
+ X(1) .GE. 1, AND EMIN .LE. E .LE. EMAX.
+
+ IPMPAR(4) = B, THE BASE.
+
+ SINGLE-PRECISION
+
+ IPMPAR(5) = M, THE NUMBER OF BASE-B DIGITS.
+
+ IPMPAR(6) = EMIN, THE SMALLEST EXPONENT E.
+
+ IPMPAR(7) = EMAX, THE LARGEST EXPONENT E.
+
+ DOUBLE-PRECISION
+
+ IPMPAR(8) = M, THE NUMBER OF BASE-B DIGITS.
+
+ IPMPAR(9) = EMIN, THE SMALLEST EXPONENT E.
+
+ IPMPAR(10) = EMAX, THE LARGEST EXPONENT E.
+
+-----------------------------------------------------------------------
+
+ TO DEFINE THIS FUNCTION FOR THE COMPUTER BEING USED REMOVE
+ THE COMMENT DELIMITORS FROM THE DEFINITIONS DIRECTLY BELOW THE NAME
+ OF THE MACHINE
+
+-----------------------------------------------------------------------
+
+ IPMPAR IS AN ADAPTATION OF THE FUNCTION I1MACH, WRITTEN BY
+ P.A. FOX, A.D. HALL, AND N.L. SCHRYER (BELL LABORATORIES).
+ IPMPAR WAS FORMED BY A.H. MORRIS (NSWC). THE CONSTANTS ARE
+ FROM BELL LABORATORIES, NSWC, AND OTHER SOURCES.
+
+-----------------------------------------------------------------------
+ .. Scalar Arguments ..
+*/
+int ipmpar(int *i)
+{
+ static int imach[11];
+ static int ipmpar;
+
+ imach[1] = 2;
+ imach[2] = sizeof (long) * 8 - 1;
+ imach[3] = INT_MAX;
+
+#if FPREP==FPREP_IEEE754
+ imach[4] = 2;
+ imach[5] = 24;
+ imach[6] = -125;
+ imach[7] = 128;
+ imach[8] = 53;
+ imach[9] = -1021;
+ imach[10] = 1024;
+#else
+#error Please define machine-specific constants for your machine.
+#endif
+
+ ipmpar = imach[*i];
+ return ipmpar;
+}
--- /dev/null
+ GNU LIBRARY GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the library GPL. It is
+ numbered 2 because it goes with version 2 of the ordinary GPL.]
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+ This license, the Library General Public License, applies to some
+specially designated Free Software Foundation software, and to any
+other libraries whose authors decide to use it. You can use it for
+your libraries, 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 library, or if you modify it.
+
+ For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you. You must make sure that they, too, receive or can get the source
+code. If you link a program with the library, you must provide
+complete object files to the recipients so that they can relink them
+with the library, after making changes to the library and recompiling
+it. And you must show them these terms so they know their rights.
+
+ Our method of protecting your rights has two steps: (1) copyright
+the library, and (2) offer you this license which gives you legal
+permission to copy, distribute and/or modify the library.
+
+ Also, for each distributor's protection, we want to make certain
+that everyone understands that there is no warranty for this free
+library. If the library is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original
+version, so that any problems introduced by others will not reflect on
+the original authors' reputations.
+\f
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that companies distributing free
+software will individually obtain patent licenses, thus in effect
+transforming the program into proprietary software. To prevent this,
+we have made it clear that any patent must be licensed for everyone's
+free use or not licensed at all.
+
+ Most GNU software, including some libraries, is covered by the ordinary
+GNU General Public License, which was designed for utility programs. This
+license, the GNU Library General Public License, applies to certain
+designated libraries. This license is quite different from the ordinary
+one; be sure to read it in full, and don't assume that anything in it is
+the same as in the ordinary license.
+
+ The reason we have a separate public license for some libraries is that
+they blur the distinction we usually make between modifying or adding to a
+program and simply using it. Linking a program with a library, without
+changing the library, is in some sense simply using the library, and is
+analogous to running a utility program or application program. However, in
+a textual and legal sense, the linked executable is a combined work, a
+derivative of the original library, and the ordinary General Public License
+treats it as such.
+
+ Because of this blurred distinction, using the ordinary General
+Public License for libraries did not effectively promote software
+sharing, because most developers did not use the libraries. We
+concluded that weaker conditions might promote sharing better.
+
+ However, unrestricted linking of non-free programs would deprive the
+users of those programs of all benefit from the free status of the
+libraries themselves. This Library General Public License is intended to
+permit developers of non-free programs to use free libraries, while
+preserving your freedom as a user of such programs to change the free
+libraries that are incorporated in them. (We have not seen how to achieve
+this as regards changes in header files, but we have achieved it as regards
+changes in the actual functions of the Library.) The hope is that this
+will lead to faster development of free libraries.
+
+ The precise terms and conditions for copying, distribution and
+modification follow. Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library". The
+former contains code derived from the library, while the latter only
+works together with the library.
+
+ Note that it is possible for a library to be covered by the ordinary
+General Public License rather than by this special one.
+\f
+ GNU LIBRARY GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License Agreement applies to any software library which
+contains a notice placed by the copyright holder or other authorized
+party saying it may be distributed under the terms of this Library
+General Public License (also called "this License"). Each licensee is
+addressed as "you".
+
+ A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+ The "Library", below, refers to any such software library or work
+which has been distributed under these terms. A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language. (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+ "Source code" for a work means the preferred form of the work for
+making modifications to it. For a library, 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 library.
+
+ Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it). Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+
+ 1. You may copy and distribute verbatim copies of the Library's
+complete 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 distribute a copy of this License along with the
+Library.
+
+ 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.
+\f
+ 2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, 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) The modified work must itself be a software library.
+
+ b) You must cause the files modified to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ c) You must cause the whole of the work to be licensed at no
+ charge to all third parties under the terms of this License.
+
+ d) If a facility in the modified Library refers to a function or a
+ table of data to be supplied by an application program that uses
+ the facility, other than as an argument passed when the facility
+ is invoked, then you must make a good faith effort to ensure that,
+ in the event an application does not supply such function or
+ table, the facility still operates, and performs whatever part of
+ its purpose remains meaningful.
+
+ (For example, a function in a library to compute square roots has
+ a purpose that is entirely well-defined independent of the
+ application. Therefore, Subsection 2d requires that any
+ application-supplied function or table used by this function must
+ be optional: if the application does not supply it, the square
+ root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Library,
+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 Library, 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 Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library. To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License. (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.) Do not make any other change in
+these notices.
+\f
+ Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+ This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+ 4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you 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.
+
+ If distribution of 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 satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library". Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+ However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library". The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+ When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library. The
+threshold for this to be true is not precisely defined by law.
+
+ If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work. (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+ Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+\f
+ 6. As an exception to the Sections above, you may also compile or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+ You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License. You must supply a copy of this License. If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License. Also, you must do one
+of these things:
+
+ a) Accompany the work with the complete corresponding
+ machine-readable source code for the Library including whatever
+ changes were used in the work (which must be distributed under
+ Sections 1 and 2 above); and, if the work is an executable linked
+ with the Library, with the complete machine-readable "work that
+ uses the Library", as object code and/or source code, so that the
+ user can modify the Library and then relink to produce a modified
+ executable containing the modified Library. (It is understood
+ that the user who changes the contents of definitions files in the
+ Library will not necessarily be able to recompile the application
+ to use the modified definitions.)
+
+ b) Accompany the work with a written offer, valid for at
+ least three years, to give the same user the materials
+ specified in Subsection 6a, above, for a charge no more
+ than the cost of performing this distribution.
+
+ c) If distribution of the work is made by offering access to copy
+ from a designated place, offer equivalent access to copy the above
+ specified materials from the same place.
+
+ d) Verify that the user has already received a copy of these
+ materials or that you have already sent this user a copy.
+
+ For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it. 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.
+
+ It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system. Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+\f
+ 7. 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 not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+ a) Accompany the combined library with a copy of the same work
+ based on the Library, uncombined with any other library
+ facilities. This must be distributed under the terms of the
+ Sections above.
+
+ b) Give prominent notice with the combined library of the fact
+ that part of it is a work based on the Library, and explaining
+ where to find the accompanying uncombined form of the same work.
+
+ 8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License. Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library 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.
+
+ 9. 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 Library or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+ 10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+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.
+\f
+ 11. 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 Library at all. For example, if a patent
+license would not permit royalty-free redistribution of the Library 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 Library.
+
+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.
+
+ 12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library 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.
+
+ 13. The Free Software Foundation may publish revised and/or new
+versions of the Library 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
+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 Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+\f
+ 14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+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
+
+ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "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
+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. 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 LIBRARY 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
+LIBRARY (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 LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+\f
+ How to Apply These Terms to Your New Libraries
+
+ If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change. You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+ To apply these terms, attach the following notices to the library. It is
+safest to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the library's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the
+ library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+ <signature of Ty Coon>, 1 April 1990
+ Ty Coon, President of Vice
+
+That's all there is to it!
--- /dev/null
+Mon Dec 14 11:52:05 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am, mpn/Makefile.am, mpf/Makefile.am: (INCLUDES) Add
+ -I$(top_srcdir)/intl. Thanks to OKUJI Yoshinori
+ <okuji@kuicr.kyoto-u.ac.jp>.
+
+Thu Nov 19 12:35:13 1998 Ben Pfaff <blp@gnu.org>
+
+ * Thanks to Hans Olav Eggestad <olav@jordforsk.nlh.no> and others
+ for reporting bug fixed below.
+
+ * Makefile.am: (libgmp_a_SOURCES) Add mp_clz_tab.c.
+
+ * longlong.h: Define LONGLONG_STANDALONE unconditionally since we
+ don't include architecture-specific directories.
+
+ * mp_clz_tab.c: New file.
+
+Sun Aug 9 11:17:02 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Fixed for renamed file.
+
+ * extract-double.c: Renamed extract-dbl.c.
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+(Other sections omitted because they're not useful in use along with
+PSPP. -blp)
+
+Known Build Problems
+--------------------
+
+Note that GCC 2.7.2 (as well as 2.6.3) for the RS/6000 and PowerPC can not
+be used to compile GMP, due to a bug in GCC. If you want to use GCC, you
+need to apply the patch at the end of this file, or use a later version of
+the compiler.
+
+If you are on a Sequent Symmetry, use GAS instead of the system's assembler
+due to the latter's serious bugs.
+
+The system compiler on NeXT is a massacred and old gcc, even if the
+compiler calls itself cc. This compiler cannot be used to build GMP. You
+need to get a real gcc, and install that before you compile GMP. (NeXT
+might have fixed this in newer releases of their system.)
+
+Please report other problems to bug-gmp@prep.ai.mit.edu.
+
+
+Patch to apply to GCC 2.6.3 and 2.7.2:
+
+*** config/rs6000/rs6000.md Sun Feb 11 08:22:11 1996
+--- config/rs6000/rs6000.md.new Sun Feb 18 03:33:37 1996
+***************
+*** 920,926 ****
+ (set (match_operand:SI 0 "gpc_reg_operand" "=r")
+ (not:SI (match_dup 1)))]
+ ""
+! "nor. %0,%2,%1"
+ [(set_attr "type" "compare")])
+
+ (define_insn ""
+--- 920,926 ----
+ (set (match_operand:SI 0 "gpc_reg_operand" "=r")
+ (not:SI (match_dup 1)))]
+ ""
+! "nor. %0,%1,%1"
+ [(set_attr "type" "compare")])
+
+ (define_insn ""
--- /dev/null
+## Process this file with automake to produce Makefile.in -*- makefile -*-
+
+INCLUDES = -I$(srcdir) -I$(top_srcdir) -I$(top_srcdir)/src -I$(top_srcdir)/intl
+
+SUBDIRS = mpn mpf
+
+noinst_LIBRARIES = libgmp.a
+libgmp_a_SOURCES = extract-dbl.c gmp-mparam.h longlong.h gmp-impl.h \
+gmp.h memory.c mp_clz_tab.c
+
+MAINTAINERCLEANFILES = Makefile.in
--- /dev/null
+/* __gmp_extract_double -- convert from double to array of mp_limb_t.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#ifdef XDEBUG
+#undef _GMP_IEEE_FLOATS
+#endif
+
+#ifndef _GMP_IEEE_FLOATS
+#define _GMP_IEEE_FLOATS 0
+#endif
+
+#define MP_BASE_AS_DOUBLE (2.0 * ((mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1)))
+
+/* Extract a non-negative double in d. */
+
+int
+#if __STDC__
+__gmp_extract_double (mp_ptr rp, double d)
+#else
+__gmp_extract_double (rp, d)
+ mp_ptr rp;
+ double d;
+#endif
+{
+ long exp;
+ unsigned sc;
+ mp_limb_t manh, manl;
+
+ /* BUGS
+
+ 1. Should handle Inf and NaN in IEEE specific code.
+ 2. Handle Inf and NaN also in default code, to avoid hangs.
+ 3. Generalize to handle all BITS_PER_MP_LIMB >= 32.
+ 4. This lits is incomplete and misspelled.
+ */
+
+ if (d == 0.0)
+ {
+ rp[0] = 0;
+ rp[1] = 0;
+#if BITS_PER_MP_LIMB == 32
+ rp[2] = 0;
+#endif
+ return 0;
+ }
+
+#if _GMP_IEEE_FLOATS
+ {
+ union ieee_double_extract x;
+ x.d = d;
+
+ exp = x.s.exp;
+ sc = (unsigned) (exp + 2) % BITS_PER_MP_LIMB;
+#if BITS_PER_MP_LIMB == 64
+ manl = (((mp_limb_t) 1 << 63)
+ | ((mp_limb_t) x.s.manh << 43) | ((mp_limb_t) x.s.manl << 11));
+#else
+ manh = ((mp_limb_t) 1 << 31) | (x.s.manh << 11) | (x.s.manl >> 21);
+ manl = x.s.manl << 11;
+#endif
+ }
+#else
+ {
+ /* Unknown (or known to be non-IEEE) double format. */
+ exp = 0;
+ if (d >= 1.0)
+ {
+ if (d * 0.5 == d)
+ abort ();
+
+ while (d >= 32768.0)
+ {
+ d *= (1.0 / 65536.0);
+ exp += 16;
+ }
+ while (d >= 1.0)
+ {
+ d *= 0.5;
+ exp += 1;
+ }
+ }
+ else if (d < 0.5)
+ {
+ while (d < (1.0 / 65536.0))
+ {
+ d *= 65536.0;
+ exp -= 16;
+ }
+ while (d < 0.5)
+ {
+ d *= 2.0;
+ exp -= 1;
+ }
+ }
+
+ sc = (unsigned) exp % BITS_PER_MP_LIMB;
+
+ d *= MP_BASE_AS_DOUBLE;
+#if BITS_PER_MP_LIMB == 64
+ manl = d;
+#else
+ manh = d;
+ manl = (d - manh) * MP_BASE_AS_DOUBLE;
+#endif
+
+ exp += 1022;
+ }
+#endif
+
+ exp = (unsigned) (exp + 1) / BITS_PER_MP_LIMB - 1024 / BITS_PER_MP_LIMB + 1;
+
+#if BITS_PER_MP_LIMB == 64
+ if (sc != 0)
+ {
+ rp[1] = manl >> (BITS_PER_MP_LIMB - sc);
+ rp[0] = manl << sc;
+ }
+ else
+ {
+ rp[1] = manl;
+ rp[0] = 0;
+ }
+#else
+ if (sc != 0)
+ {
+ rp[2] = manh >> (BITS_PER_MP_LIMB - sc);
+ rp[1] = (manl >> (BITS_PER_MP_LIMB - sc)) | (manh << sc);
+ rp[0] = manl << sc;
+ }
+ else
+ {
+ rp[2] = manh;
+ rp[1] = manl;
+ rp[0] = 0;
+ }
+#endif
+
+ return exp;
+}
--- /dev/null
+/* Include file for internal GNU MP types and definitions.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#if 0 /* PSPP has its own alloca */
+/* When using gcc, make sure to use its builtin alloca. */
+#if ! defined (alloca) && defined (__GNUC__)
+#define alloca __builtin_alloca
+#define HAVE_ALLOCA
+#endif
+
+/* When using cc, do whatever necessary to allow use of alloca. For many
+ machines, this means including alloca.h. IBM's compilers need a #pragma
+ in "each module that needs to use alloca". */
+#if ! defined (alloca)
+/* We need lots of variants for MIPS, to cover all versions and perversions
+ of OSes for MIPS. */
+#if defined (__mips) || defined (MIPSEL) || defined (MIPSEB) \
+ || defined (_MIPSEL) || defined (_MIPSEB) || defined (__sgi) \
+ || defined (__alpha) || defined (__sparc) || defined (sparc) \
+ || defined (__ksr__)
+#include <alloca.h>
+#define HAVE_ALLOCA
+#endif
+#if defined (_IBMR2)
+#pragma alloca
+#define HAVE_ALLOCA
+#endif
+#if defined (__DECC)
+#define alloca(x) __ALLOCA(x)
+#define HAVE_ALLOCA
+#endif
+#endif
+#endif /* 0 */
+
+#if ! defined (HAVE_ALLOCA) || USE_STACK_ALLOC
+#include "stack-alloc.h"
+#else
+#define TMP_DECL(m)
+#define TMP_ALLOC(x) alloca(x)
+#define TMP_MARK(m)
+#define TMP_FREE(m)
+#endif
+
+#ifndef NULL
+#define NULL ((void *) 0)
+#endif
+
+#if ! defined (__GNUC__)
+#define inline /* Empty */
+#endif
+
+#define ABS(x) (x >= 0 ? x : -x)
+#define MIN(l,o) ((l) < (o) ? (l) : (o))
+#define MAX(h,i) ((h) > (i) ? (h) : (i))
+
+/* Field access macros. */
+#define SIZ(x) ((x)->_mp_size)
+#define ABSIZ(x) ABS (SIZ (x))
+#define PTR(x) ((x)->_mp_d)
+#define EXP(x) ((x)->_mp_exp)
+#define PREC(x) ((x)->_mp_prec)
+#define ALLOC(x) ((x)->_mp_alloc)
+
+#include "gmp-mparam.h"
+/* #include "longlong.h" */
+
+#if defined (__STDC__) || defined (__cplusplus)
+void *malloc (size_t);
+void *realloc (void *, size_t);
+void free (void *);
+
+extern void * (*_mp_allocate_func) (size_t);
+extern void * (*_mp_reallocate_func) (void *, size_t, size_t);
+extern void (*_mp_free_func) (void *, size_t);
+
+void *_mp_default_allocate (size_t);
+void *_mp_default_reallocate (void *, size_t, size_t);
+void _mp_default_free (void *, size_t);
+
+#else
+
+#define const /* Empty */
+#define signed /* Empty */
+
+void *malloc ();
+void *realloc ();
+void free ();
+
+extern void * (*_mp_allocate_func) ();
+extern void * (*_mp_reallocate_func) ();
+extern void (*_mp_free_func) ();
+
+void *_mp_default_allocate ();
+void *_mp_default_reallocate ();
+void _mp_default_free ();
+#endif
+
+/* Copy NLIMBS *limbs* from SRC to DST. */
+#define MPN_COPY_INCR(DST, SRC, NLIMBS) \
+ do { \
+ mp_size_t __i; \
+ for (__i = 0; __i < (NLIMBS); __i++) \
+ (DST)[__i] = (SRC)[__i]; \
+ } while (0)
+#define MPN_COPY_DECR(DST, SRC, NLIMBS) \
+ do { \
+ mp_size_t __i; \
+ for (__i = (NLIMBS) - 1; __i >= 0; __i--) \
+ (DST)[__i] = (SRC)[__i]; \
+ } while (0)
+#define MPN_COPY MPN_COPY_INCR
+
+/* Zero NLIMBS *limbs* AT DST. */
+#define MPN_ZERO(DST, NLIMBS) \
+ do { \
+ mp_size_t __i; \
+ for (__i = 0; __i < (NLIMBS); __i++) \
+ (DST)[__i] = 0; \
+ } while (0)
+
+#define MPN_NORMALIZE(DST, NLIMBS) \
+ do { \
+ while (NLIMBS > 0) \
+ { \
+ if ((DST)[(NLIMBS) - 1] != 0) \
+ break; \
+ NLIMBS--; \
+ } \
+ } while (0)
+#define MPN_NORMALIZE_NOT_ZERO(DST, NLIMBS) \
+ do { \
+ while (1) \
+ { \
+ if ((DST)[(NLIMBS) - 1] != 0) \
+ break; \
+ NLIMBS--; \
+ } \
+ } while (0)
+
+/* Initialize the MP_INT X with space for NLIMBS limbs.
+ X should be a temporary variable, and it will be automatically
+ cleared out when the running function returns.
+ We use __x here to make it possible to accept both mpz_ptr and mpz_t
+ arguments. */
+#define MPZ_TMP_INIT(X, NLIMBS) \
+ do { \
+ mpz_ptr __x = (X); \
+ __x->_mp_alloc = (NLIMBS); \
+ __x->_mp_d = (mp_ptr) TMP_ALLOC ((NLIMBS) * BYTES_PER_MP_LIMB); \
+ } while (0)
+
+#define MPN_MUL_N_RECURSE(prodp, up, vp, size, tspace) \
+ do { \
+ if ((size) < KARATSUBA_THRESHOLD) \
+ impn_mul_n_basecase (prodp, up, vp, size); \
+ else \
+ impn_mul_n (prodp, up, vp, size, tspace); \
+ } while (0);
+#define MPN_SQR_N_RECURSE(prodp, up, size, tspace) \
+ do { \
+ if ((size) < KARATSUBA_THRESHOLD) \
+ impn_sqr_n_basecase (prodp, up, size); \
+ else \
+ impn_sqr_n (prodp, up, size, tspace); \
+ } while (0);
+
+/* Structure for conversion between internal binary format and
+ strings in base 2..36. */
+struct bases
+{
+ /* Number of digits in the conversion base that always fits in an mp_limb_t.
+ For example, for base 10 on a machine where a mp_limb_t has 32 bits this
+ is 9, since 10**9 is the largest number that fits into a mp_limb_t. */
+ int chars_per_limb;
+
+ /* log(2)/log(conversion_base) */
+ float chars_per_bit_exactly;
+
+ /* base**chars_per_limb, i.e. the biggest number that fits a word, built by
+ factors of base. Exception: For 2, 4, 8, etc, big_base is log2(base),
+ i.e. the number of bits used to represent each digit in the base. */
+ mp_limb_t big_base;
+
+ /* A BITS_PER_MP_LIMB bit approximation to 1/big_base, represented as a
+ fixed-point number. Instead of dividing by big_base an application can
+ choose to multiply by big_base_inverted. */
+ mp_limb_t big_base_inverted;
+};
+
+extern const struct bases __mp_bases[];
+extern mp_size_t __gmp_default_fp_limb_precision;
+
+/* Divide the two-limb number in (NH,,NL) by D, with DI being the largest
+ limb not larger than (2**(2*BITS_PER_MP_LIMB))/D - (2**BITS_PER_MP_LIMB).
+ If this would yield overflow, DI should be the largest possible number
+ (i.e., only ones). For correct operation, the most significant bit of D
+ has to be set. Put the quotient in Q and the remainder in R. */
+#define udiv_qrnnd_preinv(q, r, nh, nl, d, di) \
+ do { \
+ mp_limb_t _q, _ql, _r; \
+ mp_limb_t _xh, _xl; \
+ umul_ppmm (_q, _ql, (nh), (di)); \
+ _q += (nh); /* DI is 2**BITS_PER_MP_LIMB too small */\
+ umul_ppmm (_xh, _xl, _q, (d)); \
+ sub_ddmmss (_xh, _r, (nh), (nl), _xh, _xl); \
+ if (_xh != 0) \
+ { \
+ sub_ddmmss (_xh, _r, _xh, _r, 0, (d)); \
+ _q += 1; \
+ if (_xh != 0) \
+ { \
+ sub_ddmmss (_xh, _r, _xh, _r, 0, (d)); \
+ _q += 1; \
+ } \
+ } \
+ if (_r >= (d)) \
+ { \
+ _r -= (d); \
+ _q += 1; \
+ } \
+ (r) = _r; \
+ (q) = _q; \
+ } while (0)
+/* Like udiv_qrnnd_preinv, but for for any value D. DNORM is D shifted left
+ so that its most significant bit is set. LGUP is ceil(log2(D)). */
+#define udiv_qrnnd_preinv2gen(q, r, nh, nl, d, di, dnorm, lgup) \
+ do { \
+ mp_limb_t n2, n10, n1, nadj, q1; \
+ mp_limb_t _xh, _xl; \
+ n2 = ((nh) << (BITS_PER_MP_LIMB - (lgup))) + ((nl) >> 1 >> (l - 1));\
+ n10 = (nl) << (BITS_PER_MP_LIMB - (lgup)); \
+ n1 = ((mp_limb_signed_t) n10 >> (BITS_PER_MP_LIMB - 1)); \
+ nadj = n10 + (n1 & (dnorm)); \
+ umul_ppmm (_xh, _xl, di, n2 - n1); \
+ add_ssaaaa (_xh, _xl, _xh, _xl, 0, nadj); \
+ q1 = ~(n2 + _xh); \
+ umul_ppmm (_xh, _xl, q1, d); \
+ add_ssaaaa (_xh, _xl, _xh, _xl, nh, nl); \
+ _xh -= (d); \
+ (r) = _xl + ((d) & _xh); \
+ (q) = _xh - q1; \
+ } while (0)
+/* Exactly like udiv_qrnnd_preinv, but branch-free. It is not clear which
+ version to use. */
+#define udiv_qrnnd_preinv2norm(q, r, nh, nl, d, di) \
+ do { \
+ mp_limb_t n2, n10, n1, nadj, q1; \
+ mp_limb_t _xh, _xl; \
+ n2 = (nh); \
+ n10 = (nl); \
+ n1 = ((mp_limb_signed_t) n10 >> (BITS_PER_MP_LIMB - 1)); \
+ nadj = n10 + (n1 & (d)); \
+ umul_ppmm (_xh, _xl, di, n2 - n1); \
+ add_ssaaaa (_xh, _xl, _xh, _xl, 0, nadj); \
+ q1 = ~(n2 + _xh); \
+ umul_ppmm (_xh, _xl, q1, d); \
+ add_ssaaaa (_xh, _xl, _xh, _xl, nh, nl); \
+ _xh -= (d); \
+ (r) = _xl + ((d) & _xh); \
+ (q) = _xh - q1; \
+ } while (0)
+
+#if defined (__GNUC__)
+/* Define stuff for longlong.h. */
+typedef unsigned int UQItype __attribute__ ((mode (QI)));
+typedef int SItype __attribute__ ((mode (SI)));
+typedef unsigned int USItype __attribute__ ((mode (SI)));
+typedef int DItype __attribute__ ((mode (DI)));
+typedef unsigned int UDItype __attribute__ ((mode (DI)));
+#else
+typedef unsigned char UQItype;
+typedef long SItype;
+typedef unsigned long USItype;
+#endif
+
+typedef mp_limb_t UWtype;
+typedef unsigned int UHWtype;
+#define W_TYPE_SIZE BITS_PER_MP_LIMB
+
+/* Internal mpn calls */
+#define impn_mul_n_basecase __MPN(impn_mul_n_basecase)
+#define impn_mul_n __MPN(impn_mul_n)
+#define impn_sqr_n_basecase __MPN(impn_sqr_n_basecase)
+#define impn_sqr_n __MPN(impn_sqr_n)
+
+void impn_mul_n_basecase (mp_ptr prodp, mp_srcptr up, mp_srcptr vp,
+ mp_size_t size);
+void impn_mul_n (mp_ptr prodp, mp_srcptr up, mp_srcptr vp, mp_size_t size,
+ mp_ptr tspace);
+
+/* Define ieee_double_extract and _GMP_IEEE_FLOATS. */
+
+#if defined (_LITTLE_ENDIAN) || defined (__LITTLE_ENDIAN__) \
+ || defined (__alpha) \
+ || (defined (__arm__) && defined (__ARMWEL__)) \
+ || defined (__clipper__) \
+ || defined (__cris) \
+ || defined (__i386__) \
+ || defined (__i860__) \
+ || defined (__i960__) \
+ || defined (MIPSEL) || defined (_MIPSEL) \
+ || defined (__ns32000__) \
+ || defined (__WINNT) || defined (_WIN32)
+#define _GMP_IEEE_FLOATS 1
+union ieee_double_extract
+{
+ struct
+ {
+ unsigned int manl:32;
+ unsigned int manh:20;
+ unsigned int exp:11;
+ unsigned int sig:1;
+ } s;
+ double d;
+};
+#else /* Need this as an #else since the tests aren't made exclusive. */
+#if defined (_BIG_ENDIAN) \
+ || defined (__a29k__) || defined (_AM29K) \
+ || defined (__arm__) \
+ || (defined (__convex__) && defined (_IEEE_FLOAT_)) \
+ || defined (__i370__) || defined (__mvs__) \
+ || defined (__mc68000__) || defined (__mc68020__) || defined (__NeXT__)\
+ || defined(mc68020) \
+ || defined (__m88000__) \
+ || defined (MIPSEB) || defined (_MIPSEB) \
+ || defined (__hppa) \
+ || defined (__pyr__) \
+ || defined (__ibm032__) \
+ || defined (_IBMR2) || defined (_ARCH_PPC) \
+ || defined (__sh__) \
+ || defined (__sparc) || defined (sparc) \
+ || defined (__we32k__)
+#define _GMP_IEEE_FLOATS 1
+union ieee_double_extract
+{
+ struct
+ {
+ unsigned int sig:1;
+ unsigned int exp:11;
+ unsigned int manh:20;
+ unsigned int manl:32;
+ } s;
+ double d;
+};
+#endif
+#endif
+
+#define MP_BASE_AS_DOUBLE (2.0 * ((mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1)))
+#if BITS_PER_MP_LIMB == 64
+#define LIMBS_PER_DOUBLE 2
+#else
+#define LIMBS_PER_DOUBLE 3
+#endif
+
+double __gmp_scale2 _PROTO ((double, int));
+int __gmp_extract_double _PROTO((mp_ptr, double));
--- /dev/null
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB (8 * SIZEOF_LONG)
+#define BYTES_PER_MP_LIMB SIZEOF_LONG
+#define BITS_PER_LONGINT (8 * SIZEOF_LONG)
+#define BITS_PER_INT (8 * SIZEOF_INT)
+#define BITS_PER_SHORTINT (8 * SIZEOF_SHORT)
+#define BITS_PER_CHAR 8
--- /dev/null
+/* gmp.h -- Definitions for GNU multiple precision functions.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#ifndef __GMP_H__
+
+#ifndef __GNU_MP__
+#define __GNU_MP__ 2
+#define __need_size_t
+#include <stddef.h>
+#undef __need_size_t
+
+#if defined (__STDC__) || defined (__cplusplus)
+#define __gmp_const const
+#else
+#define __gmp_const
+#endif
+
+#if defined (__GNUC__)
+#define __gmp_inline __inline__
+#else
+#define __gmp_inline
+#endif
+
+#ifndef _EXTERN_INLINE
+#ifdef __GNUC__
+#define _EXTERN_INLINE extern __inline__
+#else
+#define _EXTERN_INLINE static
+#endif
+#endif
+
+#ifdef _SHORT_LIMB
+typedef unsigned int mp_limb_t;
+typedef int mp_limb_signed_t;
+#else
+#ifdef _LONG_LONG_LIMB
+typedef unsigned long long int mp_limb_t;
+typedef long long int mp_limb_signed_t;
+#else
+typedef unsigned long int mp_limb_t;
+typedef long int mp_limb_signed_t;
+#endif
+#endif
+
+typedef mp_limb_t * mp_ptr;
+typedef __gmp_const mp_limb_t * mp_srcptr;
+typedef long int mp_size_t;
+typedef long int mp_exp_t;
+
+#ifndef __MP_SMALL__
+typedef struct
+{
+ int _mp_alloc; /* Number of *limbs* allocated and pointed
+ to by the D field. */
+ int _mp_size; /* abs(SIZE) is the number of limbs
+ the last field points to. If SIZE
+ is negative this is a negative
+ number. */
+ mp_limb_t *_mp_d; /* Pointer to the limbs. */
+} __mpz_struct;
+#else
+typedef struct
+{
+ short int _mp_alloc; /* Number of *limbs* allocated and pointed
+ to by the D field. */
+ short int _mp_size; /* abs(SIZE) is the number of limbs
+ the last field points to. If SIZE
+ is negative this is a negative
+ number. */
+ mp_limb_t *_mp_d; /* Pointer to the limbs. */
+} __mpz_struct;
+#endif
+#endif /* __GNU_MP__ */
+
+/* User-visible types. */
+typedef __mpz_struct MP_INT;
+typedef __mpz_struct mpz_t[1];
+
+/* Structure for rational numbers. Zero is represented as 0/any, i.e.
+ the denominator is ignored. Negative numbers have the sign in
+ the numerator. */
+typedef struct
+{
+ __mpz_struct _mp_num;
+ __mpz_struct _mp_den;
+#if 0
+ int _mp_num_alloc; /* Number of limbs allocated
+ for the numerator. */
+ int _mp_num_size; /* The absolute value of this field is the
+ length of the numerator; the sign is the
+ sign of the entire rational number. */
+ mp_ptr _mp_num; /* Pointer to the numerator limbs. */
+ int _mp_den_alloc; /* Number of limbs allocated
+ for the denominator. */
+ int _mp_den_size; /* Length of the denominator. (This field
+ should always be positive.) */
+ mp_ptr _mp_den; /* Pointer to the denominator limbs. */
+#endif
+} __mpq_struct;
+
+typedef __mpq_struct MP_RAT;
+typedef __mpq_struct mpq_t[1];
+
+typedef struct
+{
+ int _mp_prec; /* Max precision, in number of `mp_limb_t's.
+ Set by mpf_init and modified by
+ mpf_set_prec. The area pointed to
+ by the `d' field contains `prec' + 1
+ limbs. */
+ int _mp_size; /* abs(SIZE) is the number of limbs
+ the last field points to. If SIZE
+ is negative this is a negative
+ number. */
+ mp_exp_t _mp_exp; /* Exponent, in the base of `mp_limb_t'. */
+ mp_limb_t *_mp_d; /* Pointer to the limbs. */
+} __mpf_struct;
+
+/* typedef __mpf_struct MP_FLOAT; */
+typedef __mpf_struct mpf_t[1];
+
+/* Types for function declarations in gmp files. */
+/* ??? Should not pollute user name space with these ??? */
+typedef __gmp_const __mpz_struct *mpz_srcptr;
+typedef __mpz_struct *mpz_ptr;
+typedef __gmp_const __mpf_struct *mpf_srcptr;
+typedef __mpf_struct *mpf_ptr;
+typedef __gmp_const __mpq_struct *mpq_srcptr;
+typedef __mpq_struct *mpq_ptr;
+
+#ifndef _PROTO
+#if defined (__STDC__) || defined (__cplusplus)
+#define _PROTO(x) x
+#else
+#define _PROTO(x) ()
+#endif
+#endif
+
+#ifndef __MPN
+#if defined (__STDC__) || defined (__cplusplus)
+#define __MPN(x) __mpn_##x
+#else
+#define __MPN(x) __mpn_/**/x
+#endif
+#endif
+
+#if defined (FILE) || defined (H_STDIO) || defined (_H_STDIO) \
+ || defined (_STDIO_H) || defined (_STDIO_H_) || defined (__STDIO_H__) \
+ || defined (_STDIO_INCLUDED)
+#define _GMP_H_HAVE_FILE 1
+#endif
+
+void mp_set_memory_functions _PROTO ((void *(*) (size_t),
+ void *(*) (void *, size_t, size_t),
+ void (*) (void *, size_t)));
+extern __gmp_const int mp_bits_per_limb;
+
+/**************** Integer (i.e. Z) routines. ****************/
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+void *_mpz_realloc _PROTO ((mpz_ptr, mp_size_t));
+
+void mpz_abs _PROTO ((mpz_ptr, mpz_srcptr));
+void mpz_add _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_add_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_and _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_array_init _PROTO ((mpz_ptr, mp_size_t, mp_size_t));
+void mpz_cdiv_q _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+unsigned long int mpz_cdiv_q_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_cdiv_qr _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
+unsigned long int mpz_cdiv_qr_ui _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_cdiv_r _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+unsigned long int mpz_cdiv_r_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+unsigned long int mpz_cdiv_ui _PROTO ((mpz_srcptr, unsigned long int));
+void mpz_clear _PROTO ((mpz_ptr));
+void mpz_clrbit _PROTO ((mpz_ptr, unsigned long int));
+int mpz_cmp _PROTO ((mpz_srcptr, mpz_srcptr));
+int mpz_cmp_si _PROTO ((mpz_srcptr, signed long int));
+int mpz_cmp_ui _PROTO ((mpz_srcptr, unsigned long int));
+void mpz_com _PROTO ((mpz_ptr, mpz_srcptr));
+void mpz_divexact _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_fac_ui _PROTO ((mpz_ptr, unsigned long int));
+void mpz_fdiv_q _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_fdiv_q_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+unsigned long int mpz_fdiv_q_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_fdiv_qr _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
+unsigned long int mpz_fdiv_qr_ui _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_fdiv_r _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_fdiv_r_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+unsigned long int mpz_fdiv_r_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+unsigned long int mpz_fdiv_ui _PROTO ((mpz_srcptr, unsigned long int));
+void mpz_gcd _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+unsigned long int mpz_gcd_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_gcdext _PROTO ((mpz_ptr, mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
+double mpz_get_d _PROTO ((mpz_srcptr));
+/* signed */ long int mpz_get_si _PROTO ((mpz_srcptr));
+char *mpz_get_str _PROTO ((char *, int, mpz_srcptr));
+unsigned long int mpz_get_ui _PROTO ((mpz_srcptr));
+mp_limb_t mpz_getlimbn _PROTO ((mpz_srcptr, mp_size_t));
+unsigned long int mpz_hamdist _PROTO ((mpz_srcptr, mpz_srcptr));
+void mpz_init _PROTO ((mpz_ptr));
+#ifdef _GMP_H_HAVE_FILE
+size_t mpz_inp_binary _PROTO ((mpz_ptr, FILE *));
+size_t mpz_inp_raw _PROTO ((mpz_ptr, FILE *));
+size_t mpz_inp_str _PROTO ((mpz_ptr, FILE *, int));
+#endif
+void mpz_init_set _PROTO ((mpz_ptr, mpz_srcptr));
+void mpz_init_set_d _PROTO ((mpz_ptr, double));
+void mpz_init_set_si _PROTO ((mpz_ptr, signed long int));
+int mpz_init_set_str _PROTO ((mpz_ptr, const char *, int));
+void mpz_init_set_ui _PROTO ((mpz_ptr, unsigned long int));
+int mpz_invert _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_ior _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+int mpz_jacobi _PROTO ((mpz_srcptr, mpz_srcptr));
+int mpz_legendre _PROTO ((mpz_srcptr, mpz_srcptr));
+void mpz_mod _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_mul _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_mul_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_mul_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_neg _PROTO ((mpz_ptr, mpz_srcptr));
+#ifdef _GMP_H_HAVE_FILE
+size_t mpz_out_binary _PROTO ((FILE *, mpz_srcptr));
+size_t mpz_out_raw _PROTO ((FILE *, mpz_srcptr));
+size_t mpz_out_str _PROTO ((FILE *, int, mpz_srcptr));
+#endif
+int mpz_perfect_square_p _PROTO ((mpz_srcptr));
+unsigned long int mpz_popcount _PROTO ((mpz_srcptr));
+void mpz_pow_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_powm _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr, mpz_srcptr));
+void mpz_powm_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int, mpz_srcptr));
+int mpz_probab_prime_p _PROTO ((mpz_srcptr, int));
+void mpz_random _PROTO ((mpz_ptr, mp_size_t));
+void mpz_random2 _PROTO ((mpz_ptr, mp_size_t));
+unsigned long int mpz_scan0 _PROTO ((mpz_srcptr, unsigned long int));
+unsigned long int mpz_scan1 _PROTO ((mpz_srcptr, unsigned long int));
+void mpz_set _PROTO ((mpz_ptr, mpz_srcptr));
+void mpz_set_d _PROTO ((mpz_ptr, double));
+void mpz_set_f _PROTO ((mpz_ptr, mpf_srcptr));
+void mpz_set_q _PROTO ((mpz_ptr, mpq_srcptr));
+void mpz_set_si _PROTO ((mpz_ptr, signed long int));
+int mpz_set_str _PROTO ((mpz_ptr, const char *, int));
+void mpz_set_ui _PROTO ((mpz_ptr, unsigned long int));
+void mpz_setbit _PROTO ((mpz_ptr, unsigned long int));
+size_t mpz_size _PROTO ((mpz_srcptr));
+size_t mpz_sizeinbase _PROTO ((mpz_srcptr, int));
+void mpz_sqrt _PROTO ((mpz_ptr, mpz_srcptr));
+void mpz_sqrtrem _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr));
+void mpz_sub _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_sub_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_tdiv_q _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_tdiv_q_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_tdiv_q_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_tdiv_qr _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_tdiv_qr_ui _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_tdiv_r _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_tdiv_r_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_tdiv_r_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_ui_pow_ui _PROTO ((mpz_ptr, unsigned long int, unsigned long int));
+
+/**************** Rational (i.e. Q) routines. ****************/
+
+void mpq_init _PROTO ((mpq_ptr));
+void mpq_clear _PROTO ((mpq_ptr));
+void mpq_set _PROTO ((mpq_ptr, mpq_srcptr));
+void mpq_set_ui _PROTO ((mpq_ptr, unsigned long int, unsigned long int));
+void mpq_set_si _PROTO ((mpq_ptr, signed long int, unsigned long int));
+void mpq_set_z _PROTO ((mpq_ptr, mpz_srcptr));
+void mpq_add _PROTO ((mpq_ptr, mpq_srcptr, mpq_srcptr));
+void mpq_sub _PROTO ((mpq_ptr, mpq_srcptr, mpq_srcptr));
+void mpq_mul _PROTO ((mpq_ptr, mpq_srcptr, mpq_srcptr));
+void mpq_div _PROTO ((mpq_ptr, mpq_srcptr, mpq_srcptr));
+void mpq_neg _PROTO ((mpq_ptr, mpq_srcptr));
+int mpq_cmp _PROTO ((mpq_srcptr, mpq_srcptr));
+int mpq_cmp_ui _PROTO ((mpq_srcptr, unsigned long int, unsigned long int));
+int mpq_equal _PROTO ((mpq_srcptr, mpq_srcptr));
+void mpq_inv _PROTO ((mpq_ptr, mpq_srcptr));
+void mpq_set_num _PROTO ((mpq_ptr, mpz_srcptr));
+void mpq_set_den _PROTO ((mpq_ptr, mpz_srcptr));
+void mpq_get_num _PROTO ((mpz_ptr, mpq_srcptr));
+void mpq_get_den _PROTO ((mpz_ptr, mpq_srcptr));
+double mpq_get_d _PROTO ((mpq_srcptr));
+void mpq_canonicalize _PROTO ((mpq_ptr));
+
+/**************** Float (i.e. F) routines. ****************/
+
+void mpf_abs _PROTO ((mpf_ptr, mpf_srcptr));
+void mpf_add _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
+void mpf_add_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_clear _PROTO ((mpf_ptr));
+int mpf_cmp _PROTO ((mpf_srcptr, mpf_srcptr));
+int mpf_cmp_si _PROTO ((mpf_srcptr, signed long int));
+int mpf_cmp_ui _PROTO ((mpf_srcptr, unsigned long int));
+void mpf_div _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
+void mpf_div_2exp _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_div_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_dump _PROTO ((mpf_srcptr));
+int mpf_eq _PROTO ((mpf_srcptr, mpf_srcptr, unsigned long int));
+double mpf_get_d _PROTO ((mpf_srcptr));
+unsigned long int mpf_get_prec _PROTO ((mpf_srcptr));
+char *mpf_get_str _PROTO ((char *, mp_exp_t *, int, size_t, mpf_srcptr));
+void mpf_init _PROTO ((mpf_ptr));
+void mpf_init2 _PROTO ((mpf_ptr, unsigned long int));
+#ifdef _GMP_H_HAVE_FILE
+size_t mpf_inp_str _PROTO ((mpf_ptr, FILE *, int));
+#endif
+void mpf_init_set _PROTO ((mpf_ptr, mpf_srcptr));
+void mpf_init_set_d _PROTO ((mpf_ptr, double));
+void mpf_init_set_si _PROTO ((mpf_ptr, signed long int));
+int mpf_init_set_str _PROTO ((mpf_ptr, const char *, int));
+void mpf_init_set_ui _PROTO ((mpf_ptr, unsigned long int));
+void mpf_mul _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
+void mpf_mul_2exp _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_mul_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_neg _PROTO ((mpf_ptr, mpf_srcptr));
+#ifdef _GMP_H_HAVE_FILE
+size_t mpf_out_str _PROTO ((FILE *, int, size_t, mpf_srcptr));
+#endif
+void mpf_random2 _PROTO ((mpf_ptr, mp_size_t, mp_exp_t));
+void mpf_reldiff _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
+void mpf_set _PROTO ((mpf_ptr, mpf_srcptr));
+void mpf_set_d _PROTO ((mpf_ptr, double));
+void mpf_set_default_prec _PROTO ((unsigned long int));
+void mpf_set_prec _PROTO ((mpf_ptr, unsigned long int));
+void mpf_set_prec_raw _PROTO ((mpf_ptr, unsigned long int));
+void mpf_set_q _PROTO ((mpf_ptr, mpq_srcptr));
+void mpf_set_si _PROTO ((mpf_ptr, signed long int));
+int mpf_set_str _PROTO ((mpf_ptr, const char *, int));
+void mpf_set_ui _PROTO ((mpf_ptr, unsigned long int));
+void mpf_set_z _PROTO ((mpf_ptr, mpz_srcptr));
+size_t mpf_size _PROTO ((mpf_srcptr));
+void mpf_sqrt _PROTO ((mpf_ptr, mpf_srcptr));
+void mpf_sqrt_ui _PROTO ((mpf_ptr, unsigned long int));
+void mpf_sub _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
+void mpf_sub_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_ui_div _PROTO ((mpf_ptr, unsigned long int, mpf_srcptr));
+void mpf_ui_sub _PROTO ((mpf_ptr, unsigned long int, mpf_srcptr));
+#if defined (__cplusplus)
+}
+#endif
+/************ Low level positive-integer (i.e. N) routines. ************/
+
+/* This is ugly, but we need to make usr calls reach the prefixed function. */
+#define mpn_add __MPN(add)
+#define mpn_add_1 __MPN(add_1)
+#define mpn_add_n __MPN(add_n)
+#define mpn_addmul_1 __MPN(addmul_1)
+#define mpn_bdivmod __MPN(bdivmod)
+#define mpn_cmp __MPN(cmp)
+#define mpn_divmod_1 __MPN(divmod_1)
+#define mpn_divrem __MPN(divrem)
+#define mpn_divrem_1 __MPN(divrem_1)
+#define mpn_dump __MPN(dump)
+#define mpn_gcd __MPN(gcd)
+#define mpn_gcd_1 __MPN(gcd_1)
+#define mpn_gcdext __MPN(gcdext)
+#define mpn_get_str __MPN(get_str)
+#define mpn_hamdist __MPN(hamdist)
+#define mpn_lshift __MPN(lshift)
+#define mpn_mod_1 __MPN(mod_1)
+#define mpn_mul __MPN(mul)
+#define mpn_mul_1 __MPN(mul_1)
+#define mpn_mul_n __MPN(mul_n)
+#define mpn_perfect_square_p __MPN(perfect_square_p)
+#define mpn_popcount __MPN(popcount)
+#define mpn_preinv_mod_1 __MPN(preinv_mod_1)
+#define mpn_random2 __MPN(random2)
+#define mpn_rshift __MPN(rshift)
+#define mpn_scan0 __MPN(scan0)
+#define mpn_scan1 __MPN(scan1)
+#define mpn_set_str __MPN(set_str)
+#define mpn_sqrtrem __MPN(sqrtrem)
+#define mpn_sub __MPN(sub)
+#define mpn_sub_1 __MPN(sub_1)
+#define mpn_sub_n __MPN(sub_n)
+#define mpn_submul_1 __MPN(submul_1)
+#define mpn_udiv_w_sdiv __MPN(udiv_w_sdiv)
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+mp_limb_t mpn_add _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_srcptr,mp_size_t));
+mp_limb_t mpn_add_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
+mp_limb_t mpn_add_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+mp_limb_t mpn_addmul_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
+mp_limb_t mpn_bdivmod _PROTO ((mp_ptr, mp_ptr, mp_size_t, mp_srcptr, mp_size_t, unsigned long int));
+int mpn_cmp _PROTO ((mp_srcptr, mp_srcptr, mp_size_t));
+mp_limb_t mpn_divmod_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
+mp_limb_t mpn_divrem _PROTO ((mp_ptr, mp_size_t, mp_ptr, mp_size_t, mp_srcptr, mp_size_t));
+mp_limb_t mpn_divrem_1 _PROTO ((mp_ptr, mp_size_t, mp_srcptr, mp_size_t, mp_limb_t));
+void mpn_dump _PROTO ((mp_srcptr, mp_size_t));
+mp_size_t mpn_gcd _PROTO ((mp_ptr, mp_ptr, mp_size_t, mp_ptr, mp_size_t));
+mp_limb_t mpn_gcd_1 _PROTO ((mp_srcptr, mp_size_t, mp_limb_t));
+mp_size_t mpn_gcdext _PROTO ((mp_ptr, mp_ptr, mp_ptr, mp_size_t, mp_ptr, mp_size_t));
+size_t mpn_get_str _PROTO ((unsigned char *, int, mp_ptr, mp_size_t));
+unsigned long int mpn_hamdist _PROTO ((mp_srcptr, mp_srcptr, mp_size_t));
+mp_limb_t mpn_lshift _PROTO ((mp_ptr, mp_srcptr, mp_size_t, unsigned int));
+mp_limb_t mpn_mod_1 _PROTO ((mp_srcptr, mp_size_t, mp_limb_t));
+mp_limb_t mpn_mul _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t));
+mp_limb_t mpn_mul_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
+void mpn_mul_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+int mpn_perfect_square_p _PROTO ((mp_srcptr, mp_size_t));
+unsigned long int mpn_popcount _PROTO ((mp_srcptr, mp_size_t));
+mp_limb_t mpn_preinv_mod_1 _PROTO ((mp_srcptr, mp_size_t, mp_limb_t, mp_limb_t));
+void mpn_random2 _PROTO ((mp_ptr, mp_size_t));
+mp_limb_t mpn_rshift _PROTO ((mp_ptr, mp_srcptr, mp_size_t, unsigned int));
+unsigned long int mpn_scan0 _PROTO ((mp_srcptr, unsigned long int));
+unsigned long int mpn_scan1 _PROTO ((mp_srcptr, unsigned long int));
+mp_size_t mpn_set_str _PROTO ((mp_ptr, const unsigned char *, size_t, int));
+mp_size_t mpn_sqrtrem _PROTO ((mp_ptr, mp_ptr, mp_srcptr, mp_size_t));
+mp_limb_t mpn_sub _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_srcptr,mp_size_t));
+mp_limb_t mpn_sub_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
+mp_limb_t mpn_sub_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+mp_limb_t mpn_submul_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
+#if defined (__cplusplus)
+}
+#endif
+
+#if defined (__GNUC__) || defined (_FORCE_INLINES)
+_EXTERN_INLINE mp_limb_t
+#if defined (__STDC__) || defined (__cplusplus)
+mpn_add_1 (register mp_ptr res_ptr,
+ register mp_srcptr s1_ptr,
+ register mp_size_t s1_size,
+ register mp_limb_t s2_limb)
+#else
+mpn_add_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+ register mp_ptr res_ptr;
+ register mp_srcptr s1_ptr;
+ register mp_size_t s1_size;
+ register mp_limb_t s2_limb;
+#endif
+{
+ register mp_limb_t x;
+
+ x = *s1_ptr++;
+ s2_limb = x + s2_limb;
+ *res_ptr++ = s2_limb;
+ if (s2_limb < x)
+ {
+ while (--s1_size != 0)
+ {
+ x = *s1_ptr++ + 1;
+ *res_ptr++ = x;
+ if (x != 0)
+ goto fin;
+ }
+
+ return 1;
+ }
+
+ fin:
+ if (res_ptr != s1_ptr)
+ {
+ mp_size_t i;
+ for (i = 0; i < s1_size - 1; i++)
+ res_ptr[i] = s1_ptr[i];
+ }
+ return 0;
+}
+
+_EXTERN_INLINE mp_limb_t
+#if defined (__STDC__) || defined (__cplusplus)
+mpn_add (register mp_ptr res_ptr,
+ register mp_srcptr s1_ptr,
+ register mp_size_t s1_size,
+ register mp_srcptr s2_ptr,
+ register mp_size_t s2_size)
+#else
+mpn_add (res_ptr, s1_ptr, s1_size, s2_ptr, s2_size)
+ register mp_ptr res_ptr;
+ register mp_srcptr s1_ptr;
+ register mp_size_t s1_size;
+ register mp_srcptr s2_ptr;
+ register mp_size_t s2_size;
+#endif
+{
+ mp_limb_t cy_limb = 0;
+
+ if (s2_size != 0)
+ cy_limb = mpn_add_n (res_ptr, s1_ptr, s2_ptr, s2_size);
+
+ if (s1_size - s2_size != 0)
+ cy_limb = mpn_add_1 (res_ptr + s2_size,
+ s1_ptr + s2_size,
+ s1_size - s2_size,
+ cy_limb);
+ return cy_limb;
+}
+
+_EXTERN_INLINE mp_limb_t
+#if defined (__STDC__) || defined (__cplusplus)
+mpn_sub_1 (register mp_ptr res_ptr,
+ register mp_srcptr s1_ptr,
+ register mp_size_t s1_size,
+ register mp_limb_t s2_limb)
+#else
+mpn_sub_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+ register mp_ptr res_ptr;
+ register mp_srcptr s1_ptr;
+ register mp_size_t s1_size;
+ register mp_limb_t s2_limb;
+#endif
+{
+ register mp_limb_t x;
+
+ x = *s1_ptr++;
+ s2_limb = x - s2_limb;
+ *res_ptr++ = s2_limb;
+ if (s2_limb > x)
+ {
+ while (--s1_size != 0)
+ {
+ x = *s1_ptr++;
+ *res_ptr++ = x - 1;
+ if (x != 0)
+ goto fin;
+ }
+
+ return 1;
+ }
+
+ fin:
+ if (res_ptr != s1_ptr)
+ {
+ mp_size_t i;
+ for (i = 0; i < s1_size - 1; i++)
+ res_ptr[i] = s1_ptr[i];
+ }
+ return 0;
+}
+
+_EXTERN_INLINE mp_limb_t
+#if defined (__STDC__) || defined (__cplusplus)
+mpn_sub (register mp_ptr res_ptr,
+ register mp_srcptr s1_ptr,
+ register mp_size_t s1_size,
+ register mp_srcptr s2_ptr,
+ register mp_size_t s2_size)
+#else
+mpn_sub (res_ptr, s1_ptr, s1_size, s2_ptr, s2_size)
+ register mp_ptr res_ptr;
+ register mp_srcptr s1_ptr;
+ register mp_size_t s1_size;
+ register mp_srcptr s2_ptr;
+ register mp_size_t s2_size;
+#endif
+{
+ mp_limb_t cy_limb = 0;
+
+ if (s2_size != 0)
+ cy_limb = mpn_sub_n (res_ptr, s1_ptr, s2_ptr, s2_size);
+
+ if (s1_size - s2_size != 0)
+ cy_limb = mpn_sub_1 (res_ptr + s2_size,
+ s1_ptr + s2_size,
+ s1_size - s2_size,
+ cy_limb);
+ return cy_limb;
+}
+#endif /* __GNUC__ */
+
+/* Allow faster testing for negative, zero, and positive. */
+#define mpz_sgn(Z) ((Z)->_mp_size < 0 ? -1 : (Z)->_mp_size > 0)
+#define mpf_sgn(F) ((F)->_mp_size < 0 ? -1 : (F)->_mp_size > 0)
+#define mpq_sgn(Q) ((Q)->_mp_num._mp_size < 0 ? -1 : (Q)->_mp_num._mp_size > 0)
+
+/* Allow direct user access to numerator and denominator of a mpq_t object. */
+#define mpq_numref(Q) (&((Q)->_mp_num))
+#define mpq_denref(Q) (&((Q)->_mp_den))
+
+/* When using GCC, optimize certain common comparisons. */
+#if defined (__GNUC__)
+#define mpz_cmp_ui(Z,UI) \
+ (__builtin_constant_p (UI) && (UI) == 0 \
+ ? mpz_sgn (Z) : mpz_cmp_ui (Z,UI))
+#define mpz_cmp_si(Z,UI) \
+ (__builtin_constant_p (UI) && (UI) == 0 ? mpz_sgn (Z) \
+ : __builtin_constant_p (UI) && (UI) > 0 ? mpz_cmp_ui (Z,UI) \
+ : mpz_cmp_si (Z,UI))
+#define mpq_cmp_ui(Q,NUI,DUI) \
+ (__builtin_constant_p (NUI) && (NUI) == 0 \
+ ? mpq_sgn (Q) : mpq_cmp_ui (Q,NUI,DUI))
+#endif
+
+#define mpn_divmod(qp,np,nsize,dp,dsize) mpn_divrem (qp,0,np,nsize,dp,dsize)
+#if 0
+#define mpn_divmod_1(qp,np,nsize,dlimb) mpn_divrem_1 (qp,0,np,nsize,dlimb)
+#endif
+
+/* Compatibility with GMP 1. */
+#define mpz_mdiv mpz_fdiv_q
+#define mpz_mdivmod mpz_fdiv_qr
+#define mpz_mmod mpz_fdiv_r
+#define mpz_mdiv_ui mpz_fdiv_q_ui
+#define mpz_mdivmod_ui(q,r,n,d) \
+ ((r == 0) ? mpz_fdiv_q_ui (q,n,d) : mpz_fdiv_qr_ui (q,r,n,d))
+#define mpz_mmod_ui(r,n,d) \
+ ((r == 0) ? mpz_fdiv_ui (n,d) : mpz_fdiv_r_ui (r,n,d))
+
+/* Useful synonyms, but not quite compatible with GMP 1. */
+#define mpz_div mpz_fdiv_q
+#define mpz_divmod mpz_fdiv_qr
+#define mpz_div_ui mpz_fdiv_q_ui
+#define mpz_divmod_ui mpz_fdiv_qr_ui
+#define mpz_mod_ui mpz_fdiv_r_ui
+#define mpz_div_2exp mpz_fdiv_q_2exp
+#define mpz_mod_2exp mpz_fdiv_r_2exp
+
+#define __GNU_MP_VERSION 2
+#define __GNU_MP_VERSION_MINOR 0
+#define __GMP_H__
+#endif /* __GMP_H__ */
--- /dev/null
+/* longlong.h -- definitions for mixed size 32/64 bit arithmetic.
+
+Copyright (C) 1991, 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+This file is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with this file; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define LONGLONG_STANDALONE 1 /* blp 1998/10/29 */
+
+/* You have to define the following before including this file:
+
+ UWtype -- An unsigned type, default type for operations (typically a "word")
+ UHWtype -- An unsigned type, at least half the size of UWtype.
+ UDWtype -- An unsigned type, at least twice as large a UWtype
+ W_TYPE_SIZE -- size in bits of UWtype
+
+ SItype, USItype -- Signed and unsigned 32 bit types.
+ DItype, UDItype -- Signed and unsigned 64 bit types.
+
+ On a 32 bit machine UWtype should typically be USItype;
+ on a 64 bit machine, UWtype should typically be UDItype.
+*/
+
+#define __BITS4 (W_TYPE_SIZE / 4)
+#define __ll_B ((UWtype) 1 << (W_TYPE_SIZE / 2))
+#define __ll_lowpart(t) ((UWtype) (t) & (__ll_B - 1))
+#define __ll_highpart(t) ((UWtype) (t) >> (W_TYPE_SIZE / 2))
+
+/* This is used to make sure no undesirable sharing between different libraries
+ that use this file takes place. */
+#ifndef __MPN
+#define __MPN(x) __##x
+#endif
+
+/* Define auxiliary asm macros.
+
+ 1) umul_ppmm(high_prod, low_prod, multipler, multiplicand) multiplies two
+ UWtype integers MULTIPLER and MULTIPLICAND, and generates a two UWtype
+ word product in HIGH_PROD and LOW_PROD.
+
+ 2) __umulsidi3(a,b) multiplies two UWtype integers A and B, and returns a
+ UDWtype product. This is just a variant of umul_ppmm.
+
+ 3) udiv_qrnnd(quotient, remainder, high_numerator, low_numerator,
+ denominator) divides a UDWtype, composed by the UWtype integers
+ HIGH_NUMERATOR and LOW_NUMERATOR, by DENOMINATOR and places the quotient
+ in QUOTIENT and the remainder in REMAINDER. HIGH_NUMERATOR must be less
+ than DENOMINATOR for correct operation. If, in addition, the most
+ significant bit of DENOMINATOR must be 1, then the pre-processor symbol
+ UDIV_NEEDS_NORMALIZATION is defined to 1.
+
+ 4) sdiv_qrnnd(quotient, remainder, high_numerator, low_numerator,
+ denominator). Like udiv_qrnnd but the numbers are signed. The quotient
+ is rounded towards 0.
+
+ 5) count_leading_zeros(count, x) counts the number of zero-bits from the
+ msb to the first non-zero bit in the UWtype X. This is the number of
+ steps X needs to be shifted left to set the msb. Undefined for X == 0,
+ unless the symbol COUNT_LEADING_ZEROS_0 is defined to some value.
+
+ 6) count_trailing_zeros(count, x) like count_leading_zeros, but counts
+ from the least significant end.
+
+ 7) add_ssaaaa(high_sum, low_sum, high_addend_1, low_addend_1,
+ high_addend_2, low_addend_2) adds two UWtype integers, composed by
+ HIGH_ADDEND_1 and LOW_ADDEND_1, and HIGH_ADDEND_2 and LOW_ADDEND_2
+ respectively. The result is placed in HIGH_SUM and LOW_SUM. Overflow
+ (i.e. carry out) is not stored anywhere, and is lost.
+
+ 8) sub_ddmmss(high_difference, low_difference, high_minuend, low_minuend,
+ high_subtrahend, low_subtrahend) subtracts two two-word UWtype integers,
+ composed by HIGH_MINUEND_1 and LOW_MINUEND_1, and HIGH_SUBTRAHEND_2 and
+ LOW_SUBTRAHEND_2 respectively. The result is placed in HIGH_DIFFERENCE
+ and LOW_DIFFERENCE. Overflow (i.e. carry out) is not stored anywhere,
+ and is lost.
+
+ If any of these macros are left undefined for a particular CPU,
+ C macros are used. */
+
+/* The CPUs come in alphabetical order below.
+
+ Please add support for more CPUs here, or improve the current support
+ for the CPUs below! */
+
+#if defined (__CHECKER__)
+#define NO_ASM
+#endif
+
+#if defined (__GNUC__) && !defined (NO_ASM)
+
+/* We sometimes need to clobber "cc" with gcc2, but that would not be
+ understood by gcc1. Use cpp to avoid major code duplication. */
+#if __GNUC__ < 2
+#define __CLOBBER_CC
+#define __AND_CLOBBER_CC
+#else /* __GNUC__ >= 2 */
+#define __CLOBBER_CC : "cc"
+#define __AND_CLOBBER_CC , "cc"
+#endif /* __GNUC__ < 2 */
+
+#if (defined (__a29k__) || defined (_AM29K)) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("add %1,%4,%5
+ addc %0,%2,%3" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "%r" ((USItype)(ah)), \
+ "rI" ((USItype)(bh)), \
+ "%r" ((USItype)(al)), \
+ "rI" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("sub %1,%4,%5
+ subc %0,%2,%3" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "r" ((USItype)(ah)), \
+ "rI" ((USItype)(bh)), \
+ "r" ((USItype)(al)), \
+ "rI" ((USItype)(bl)))
+#define umul_ppmm(xh, xl, m0, m1) \
+ do { \
+ USItype __m0 = (m0), __m1 = (m1); \
+ __asm__ ("multiplu %0,%1,%2" \
+ : "=r" ((USItype)(xl)) \
+ : "r" (__m0), \
+ "r" (__m1)); \
+ __asm__ ("multmu %0,%1,%2" \
+ : "=r" ((USItype)(xh)) \
+ : "r" (__m0), \
+ "r" (__m1)); \
+ } while (0)
+#define udiv_qrnnd(q, r, n1, n0, d) \
+ __asm__ ("dividu %0,%3,%4" \
+ : "=r" ((USItype)(q)), \
+ "=q" ((USItype)(r)) \
+ : "1" ((USItype)(n1)), \
+ "r" ((USItype)(n0)), \
+ "r" ((USItype)(d)))
+#define count_leading_zeros(count, x) \
+ __asm__ ("clz %0,%1" \
+ : "=r" ((USItype)(count)) \
+ : "r" ((USItype)(x)))
+#define COUNT_LEADING_ZEROS_0 32
+#endif /* __a29k__ */
+
+#if defined (__alpha) && W_TYPE_SIZE == 64
+#define umul_ppmm(ph, pl, m0, m1) \
+ do { \
+ UDItype __m0 = (m0), __m1 = (m1); \
+ __asm__ ("umulh %r1,%2,%0" \
+ : "=r" ((UDItype) ph) \
+ : "%rJ" (__m0), \
+ "rI" (__m1)); \
+ (pl) = __m0 * __m1; \
+ } while (0)
+#define UMUL_TIME 46
+#ifndef LONGLONG_STANDALONE
+#define udiv_qrnnd(q, r, n1, n0, d) \
+ do { UDItype __r; \
+ (q) = __udiv_qrnnd (&__r, (n1), (n0), (d)); \
+ (r) = __r; \
+ } while (0)
+extern UDItype __udiv_qrnnd ();
+#define UDIV_TIME 220
+#endif /* LONGLONG_STANDALONE */
+#endif /* __alpha */
+
+#if defined (__arm__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("adds %1, %4, %5
+ adc %0, %2, %3" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "%r" ((USItype)(ah)), \
+ "rI" ((USItype)(bh)), \
+ "%r" ((USItype)(al)), \
+ "rI" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("subs %1, %4, %5
+ sbc %0, %2, %3" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "r" ((USItype)(ah)), \
+ "rI" ((USItype)(bh)), \
+ "r" ((USItype)(al)), \
+ "rI" ((USItype)(bl)))
+#define umul_ppmm(xh, xl, a, b) \
+ __asm__ ("%@ Inlined umul_ppmm
+ mov %|r0, %2, lsr #16
+ mov %|r2, %3, lsr #16
+ bic %|r1, %2, %|r0, lsl #16
+ bic %|r2, %3, %|r2, lsl #16
+ mul %1, %|r1, %|r2
+ mul %|r2, %|r0, %|r2
+ mul %|r1, %0, %|r1
+ mul %0, %|r0, %0
+ adds %|r1, %|r2, %|r1
+ addcs %0, %0, #65536
+ adds %1, %1, %|r1, lsl #16
+ adc %0, %0, %|r1, lsr #16" \
+ : "=&r" ((USItype)(xh)), \
+ "=r" ((USItype)(xl)) \
+ : "r" ((USItype)(a)), \
+ "r" ((USItype)(b)) \
+ : "r0", "r1", "r2")
+#define UMUL_TIME 20
+#define UDIV_TIME 100
+#endif /* __arm__ */
+
+#if defined (__clipper__) && W_TYPE_SIZE == 32
+#define umul_ppmm(w1, w0, u, v) \
+ ({union {UDItype __ll; \
+ struct {USItype __l, __h;} __i; \
+ } __xx; \
+ __asm__ ("mulwux %2,%0" \
+ : "=r" (__xx.__ll) \
+ : "%0" ((USItype)(u)), \
+ "r" ((USItype)(v))); \
+ (w1) = __xx.__i.__h; (w0) = __xx.__i.__l;})
+#define smul_ppmm(w1, w0, u, v) \
+ ({union {DItype __ll; \
+ struct {SItype __l, __h;} __i; \
+ } __xx; \
+ __asm__ ("mulwx %2,%0" \
+ : "=r" (__xx.__ll) \
+ : "%0" ((SItype)(u)), \
+ "r" ((SItype)(v))); \
+ (w1) = __xx.__i.__h; (w0) = __xx.__i.__l;})
+#define __umulsidi3(u, v) \
+ ({UDItype __w; \
+ __asm__ ("mulwux %2,%0" \
+ : "=r" (__w) \
+ : "%0" ((USItype)(u)), \
+ "r" ((USItype)(v))); \
+ __w; })
+#endif /* __clipper__ */
+
+#if defined (__gmicro__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("add.w %5,%1
+ addx %3,%0" \
+ : "=g" ((USItype)(sh)), \
+ "=&g" ((USItype)(sl)) \
+ : "%0" ((USItype)(ah)), \
+ "g" ((USItype)(bh)), \
+ "%1" ((USItype)(al)), \
+ "g" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("sub.w %5,%1
+ subx %3,%0" \
+ : "=g" ((USItype)(sh)), \
+ "=&g" ((USItype)(sl)) \
+ : "0" ((USItype)(ah)), \
+ "g" ((USItype)(bh)), \
+ "1" ((USItype)(al)), \
+ "g" ((USItype)(bl)))
+#define umul_ppmm(ph, pl, m0, m1) \
+ __asm__ ("mulx %3,%0,%1" \
+ : "=g" ((USItype)(ph)), \
+ "=r" ((USItype)(pl)) \
+ : "%0" ((USItype)(m0)), \
+ "g" ((USItype)(m1)))
+#define udiv_qrnnd(q, r, nh, nl, d) \
+ __asm__ ("divx %4,%0,%1" \
+ : "=g" ((USItype)(q)), \
+ "=r" ((USItype)(r)) \
+ : "1" ((USItype)(nh)), \
+ "0" ((USItype)(nl)), \
+ "g" ((USItype)(d)))
+#define count_leading_zeros(count, x) \
+ __asm__ ("bsch/1 %1,%0" \
+ : "=g" (count) \
+ : "g" ((USItype)(x)), \
+ "0" ((USItype)0))
+#endif
+
+#if defined (__hppa) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("add %4,%5,%1
+ addc %2,%3,%0" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "%rM" ((USItype)(ah)), \
+ "rM" ((USItype)(bh)), \
+ "%rM" ((USItype)(al)), \
+ "rM" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("sub %4,%5,%1
+ subb %2,%3,%0" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "rM" ((USItype)(ah)), \
+ "rM" ((USItype)(bh)), \
+ "rM" ((USItype)(al)), \
+ "rM" ((USItype)(bl)))
+#if defined (_PA_RISC1_1)
+#define umul_ppmm(wh, wl, u, v) \
+ do { \
+ union {UDItype __ll; \
+ struct {USItype __h, __l;} __i; \
+ } __xx; \
+ __asm__ ("xmpyu %1,%2,%0" \
+ : "=*f" (__xx.__ll) \
+ : "*f" ((USItype)(u)), \
+ "*f" ((USItype)(v))); \
+ (wh) = __xx.__i.__h; \
+ (wl) = __xx.__i.__l; \
+ } while (0)
+#define UMUL_TIME 8
+#define UDIV_TIME 60
+#else
+#define UMUL_TIME 40
+#define UDIV_TIME 80
+#endif
+#ifndef LONGLONG_STANDALONE
+#define udiv_qrnnd(q, r, n1, n0, d) \
+ do { USItype __r; \
+ (q) = __udiv_qrnnd (&__r, (n1), (n0), (d)); \
+ (r) = __r; \
+ } while (0)
+extern USItype __udiv_qrnnd ();
+#endif /* LONGLONG_STANDALONE */
+#define count_leading_zeros(count, x) \
+ do { \
+ USItype __tmp; \
+ __asm__ ( \
+ "ldi 1,%0
+ extru,= %1,15,16,%%r0 ; Bits 31..16 zero?
+ extru,tr %1,15,16,%1 ; No. Shift down, skip add.
+ ldo 16(%0),%0 ; Yes. Perform add.
+ extru,= %1,23,8,%%r0 ; Bits 15..8 zero?
+ extru,tr %1,23,8,%1 ; No. Shift down, skip add.
+ ldo 8(%0),%0 ; Yes. Perform add.
+ extru,= %1,27,4,%%r0 ; Bits 7..4 zero?
+ extru,tr %1,27,4,%1 ; No. Shift down, skip add.
+ ldo 4(%0),%0 ; Yes. Perform add.
+ extru,= %1,29,2,%%r0 ; Bits 3..2 zero?
+ extru,tr %1,29,2,%1 ; No. Shift down, skip add.
+ ldo 2(%0),%0 ; Yes. Perform add.
+ extru %1,30,1,%1 ; Extract bit 1.
+ sub %0,%1,%0 ; Subtract it.
+ " : "=r" (count), "=r" (__tmp) : "1" (x)); \
+ } while (0)
+#endif /* hppa */
+
+#if (defined (__i370__) || defined (__mvs__)) && W_TYPE_SIZE == 32
+#define umul_ppmm(xh, xl, m0, m1) \
+ do { \
+ union {UDItype __ll; \
+ struct {USItype __h, __l;} __i; \
+ } __xx; \
+ USItype __m0 = (m0), __m1 = (m1); \
+ __asm__ ("mr %0,%3" \
+ : "=r" (__xx.__i.__h), \
+ "=r" (__xx.__i.__l) \
+ : "%1" (__m0), \
+ "r" (__m1)); \
+ (xh) = __xx.__i.__h; (xl) = __xx.__i.__l; \
+ (xh) += ((((SItype) __m0 >> 31) & __m1) \
+ + (((SItype) __m1 >> 31) & __m0)); \
+ } while (0)
+#define smul_ppmm(xh, xl, m0, m1) \
+ do { \
+ union {DItype __ll; \
+ struct {USItype __h, __l;} __i; \
+ } __xx; \
+ __asm__ ("mr %0,%3" \
+ : "=r" (__xx.__i.__h), \
+ "=r" (__xx.__i.__l) \
+ : "%1" (m0), \
+ "r" (m1)); \
+ (xh) = __xx.__i.__h; (xl) = __xx.__i.__l; \
+ } while (0)
+#define sdiv_qrnnd(q, r, n1, n0, d) \
+ do { \
+ union {DItype __ll; \
+ struct {USItype __h, __l;} __i; \
+ } __xx; \
+ __xx.__i.__h = n1; __xx.__i.__l = n0; \
+ __asm__ ("dr %0,%2" \
+ : "=r" (__xx.__ll) \
+ : "0" (__xx.__ll), "r" (d)); \
+ (q) = __xx.__i.__l; (r) = __xx.__i.__h; \
+ } while (0)
+#endif
+
+#if (defined (__i386__) || defined (__i486__)) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("addl %5,%1
+ adcl %3,%0" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "%0" ((USItype)(ah)), \
+ "g" ((USItype)(bh)), \
+ "%1" ((USItype)(al)), \
+ "g" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("subl %5,%1
+ sbbl %3,%0" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "0" ((USItype)(ah)), \
+ "g" ((USItype)(bh)), \
+ "1" ((USItype)(al)), \
+ "g" ((USItype)(bl)))
+#define umul_ppmm(w1, w0, u, v) \
+ __asm__ ("mull %3" \
+ : "=a" ((USItype)(w0)), \
+ "=d" ((USItype)(w1)) \
+ : "%0" ((USItype)(u)), \
+ "rm" ((USItype)(v)))
+#define udiv_qrnnd(q, r, n1, n0, d) \
+ __asm__ ("divl %4" \
+ : "=a" ((USItype)(q)), \
+ "=d" ((USItype)(r)) \
+ : "0" ((USItype)(n0)), \
+ "1" ((USItype)(n1)), \
+ "rm" ((USItype)(d)))
+#define count_leading_zeros(count, x) \
+ do { \
+ USItype __cbtmp; \
+ __asm__ ("bsrl %1,%0" \
+ : "=r" (__cbtmp) : "rm" ((USItype)(x))); \
+ (count) = __cbtmp ^ 31; \
+ } while (0)
+#define count_trailing_zeros(count, x) \
+ __asm__ ("bsfl %1,%0" : "=r" (count) : "rm" ((USItype)(x)))
+#ifndef UMUL_TIME
+#define UMUL_TIME 40
+#endif
+#ifndef UDIV_TIME
+#define UDIV_TIME 40
+#endif
+#endif /* 80x86 */
+
+#if defined (__i860__) && W_TYPE_SIZE == 32
+#define rshift_rhlc(r,h,l,c) \
+ __asm__ ("shr %3,r0,r0\;shrd %1,%2,%0" \
+ "=r" (r) : "r" (h), "r" (l), "rn" (c))
+#endif /* i860 */
+
+#if defined (__i960__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("cmpo 1,0\;addc %5,%4,%1\;addc %3,%2,%0" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "%dI" ((USItype)(ah)), \
+ "dI" ((USItype)(bh)), \
+ "%dI" ((USItype)(al)), \
+ "dI" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("cmpo 0,0\;subc %5,%4,%1\;subc %3,%2,%0" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "dI" ((USItype)(ah)), \
+ "dI" ((USItype)(bh)), \
+ "dI" ((USItype)(al)), \
+ "dI" ((USItype)(bl)))
+#define umul_ppmm(w1, w0, u, v) \
+ ({union {UDItype __ll; \
+ struct {USItype __l, __h;} __i; \
+ } __xx; \
+ __asm__ ("emul %2,%1,%0" \
+ : "=d" (__xx.__ll) \
+ : "%dI" ((USItype)(u)), \
+ "dI" ((USItype)(v))); \
+ (w1) = __xx.__i.__h; (w0) = __xx.__i.__l;})
+#define __umulsidi3(u, v) \
+ ({UDItype __w; \
+ __asm__ ("emul %2,%1,%0" \
+ : "=d" (__w) \
+ : "%dI" ((USItype)(u)), \
+ "dI" ((USItype)(v))); \
+ __w; })
+#define udiv_qrnnd(q, r, nh, nl, d) \
+ do { \
+ union {UDItype __ll; \
+ struct {USItype __l, __h;} __i; \
+ } __nn; \
+ __nn.__i.__h = (nh); __nn.__i.__l = (nl); \
+ __asm__ ("ediv %d,%n,%0" \
+ : "=d" (__rq.__ll) \
+ : "dI" (__nn.__ll), \
+ "dI" ((USItype)(d))); \
+ (r) = __rq.__i.__l; (q) = __rq.__i.__h; \
+ } while (0)
+#define count_leading_zeros(count, x) \
+ do { \
+ USItype __cbtmp; \
+ __asm__ ("scanbit %1,%0" \
+ : "=r" (__cbtmp) \
+ : "r" ((USItype)(x))); \
+ (count) = __cbtmp ^ 31; \
+ } while (0)
+#define COUNT_LEADING_ZEROS_0 (-32) /* sic */
+#if defined (__i960mx) /* what is the proper symbol to test??? */
+#define rshift_rhlc(r,h,l,c) \
+ do { \
+ union {UDItype __ll; \
+ struct {USItype __l, __h;} __i; \
+ } __nn; \
+ __nn.__i.__h = (h); __nn.__i.__l = (l); \
+ __asm__ ("shre %2,%1,%0" \
+ : "=d" (r) : "dI" (__nn.__ll), "dI" (c)); \
+ }
+#endif /* i960mx */
+#endif /* i960 */
+
+#if (defined (__mc68000__) || defined (__mc68020__) || defined (__NeXT__) || defined(mc68020)) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("add%.l %5,%1
+ addx%.l %3,%0" \
+ : "=d" ((USItype)(sh)), \
+ "=&d" ((USItype)(sl)) \
+ : "%0" ((USItype)(ah)), \
+ "d" ((USItype)(bh)), \
+ "%1" ((USItype)(al)), \
+ "g" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("sub%.l %5,%1
+ subx%.l %3,%0" \
+ : "=d" ((USItype)(sh)), \
+ "=&d" ((USItype)(sl)) \
+ : "0" ((USItype)(ah)), \
+ "d" ((USItype)(bh)), \
+ "1" ((USItype)(al)), \
+ "g" ((USItype)(bl)))
+#if (defined (__mc68020__) || defined (__NeXT__) || defined(mc68020))
+#define umul_ppmm(w1, w0, u, v) \
+ __asm__ ("mulu%.l %3,%1:%0" \
+ : "=d" ((USItype)(w0)), \
+ "=d" ((USItype)(w1)) \
+ : "%0" ((USItype)(u)), \
+ "dmi" ((USItype)(v)))
+#define UMUL_TIME 45
+#define udiv_qrnnd(q, r, n1, n0, d) \
+ __asm__ ("divu%.l %4,%1:%0" \
+ : "=d" ((USItype)(q)), \
+ "=d" ((USItype)(r)) \
+ : "0" ((USItype)(n0)), \
+ "1" ((USItype)(n1)), \
+ "dmi" ((USItype)(d)))
+#define UDIV_TIME 90
+#define sdiv_qrnnd(q, r, n1, n0, d) \
+ __asm__ ("divs%.l %4,%1:%0" \
+ : "=d" ((USItype)(q)), \
+ "=d" ((USItype)(r)) \
+ : "0" ((USItype)(n0)), \
+ "1" ((USItype)(n1)), \
+ "dmi" ((USItype)(d)))
+#define count_leading_zeros(count, x) \
+ __asm__ ("bfffo %1{%b2:%b2},%0" \
+ : "=d" ((USItype)(count)) \
+ : "od" ((USItype)(x)), "n" (0))
+#define COUNT_LEADING_ZEROS_0 32
+#else /* not mc68020 */
+#define umul_ppmm(xh, xl, a, b) \
+ do { USItype __umul_tmp1, __umul_tmp2; \
+ __asm__ ("| Inlined umul_ppmm
+ move%.l %5,%3
+ move%.l %2,%0
+ move%.w %3,%1
+ swap %3
+ swap %0
+ mulu %2,%1
+ mulu %3,%0
+ mulu %2,%3
+ swap %2
+ mulu %5,%2
+ add%.l %3,%2
+ jcc 1f
+ add%.l %#0x10000,%0
+1: move%.l %2,%3
+ clr%.w %2
+ swap %2
+ swap %3
+ clr%.w %3
+ add%.l %3,%1
+ addx%.l %2,%0
+ | End inlined umul_ppmm" \
+ : "=&d" ((USItype)(xh)), "=&d" ((USItype)(xl)), \
+ "=d" (__umul_tmp1), "=&d" (__umul_tmp2) \
+ : "%2" ((USItype)(a)), "d" ((USItype)(b))); \
+ } while (0)
+#define UMUL_TIME 100
+#define UDIV_TIME 400
+#endif /* not mc68020 */
+#endif /* mc68000 */
+
+#if defined (__m88000__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("addu.co %1,%r4,%r5
+ addu.ci %0,%r2,%r3" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "%rJ" ((USItype)(ah)), \
+ "rJ" ((USItype)(bh)), \
+ "%rJ" ((USItype)(al)), \
+ "rJ" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("subu.co %1,%r4,%r5
+ subu.ci %0,%r2,%r3" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "rJ" ((USItype)(ah)), \
+ "rJ" ((USItype)(bh)), \
+ "rJ" ((USItype)(al)), \
+ "rJ" ((USItype)(bl)))
+#define count_leading_zeros(count, x) \
+ do { \
+ USItype __cbtmp; \
+ __asm__ ("ff1 %0,%1" \
+ : "=r" (__cbtmp) \
+ : "r" ((USItype)(x))); \
+ (count) = __cbtmp ^ 31; \
+ } while (0)
+#define COUNT_LEADING_ZEROS_0 63 /* sic */
+#if defined (__m88110__)
+#define umul_ppmm(wh, wl, u, v) \
+ do { \
+ union {UDItype __ll; \
+ struct {USItype __h, __l;} __i; \
+ } __xx; \
+ __asm__ ("mulu.d %0,%1,%2" \
+ : "=r" (__xx.__ll) \
+ : "r" ((USItype)(u)), \
+ "r" ((USItype)(v))); \
+ (wh) = __xx.__i.__h; \
+ (wl) = __xx.__i.__l; \
+ } while (0)
+#define udiv_qrnnd(q, r, n1, n0, d) \
+ ({union {UDItype __ll; \
+ struct {USItype __h, __l;} __i; \
+ } __xx; \
+ USItype __q; \
+ __xx.__i.__h = (n1); __xx.__i.__l = (n0); \
+ __asm__ ("divu.d %0,%1,%2" \
+ : "=r" (__q) \
+ : "r" (__xx.__ll), \
+ "r" ((USItype)(d))); \
+ (r) = (n0) - __q * (d); (q) = __q; })
+#define UMUL_TIME 5
+#define UDIV_TIME 25
+#else
+#define UMUL_TIME 17
+#define UDIV_TIME 150
+#endif /* __m88110__ */
+#endif /* __m88000__ */
+
+#if defined (__mips__) && W_TYPE_SIZE == 32
+#if __GNUC__ > 2 || __GNUC_MINOR__ >= 7
+#define umul_ppmm(w1, w0, u, v) \
+ __asm__ ("multu %2,%3" \
+ : "=l" ((USItype)(w0)), \
+ "=h" ((USItype)(w1)) \
+ : "d" ((USItype)(u)), \
+ "d" ((USItype)(v)))
+#else
+#define umul_ppmm(w1, w0, u, v) \
+ __asm__ ("multu %2,%3
+ mflo %0
+ mfhi %1" \
+ : "=d" ((USItype)(w0)), \
+ "=d" ((USItype)(w1)) \
+ : "d" ((USItype)(u)), \
+ "d" ((USItype)(v)))
+#endif
+#define UMUL_TIME 10
+#define UDIV_TIME 100
+#endif /* __mips__ */
+
+#if (defined (__mips) && __mips >= 3) && W_TYPE_SIZE == 64
+#if __GNUC__ > 2 || __GNUC_MINOR__ >= 7
+#define umul_ppmm(w1, w0, u, v) \
+ __asm__ ("dmultu %2,%3" \
+ : "=l" ((UDItype)(w0)), \
+ "=h" ((UDItype)(w1)) \
+ : "d" ((UDItype)(u)), \
+ "d" ((UDItype)(v)))
+#else
+#define umul_ppmm(w1, w0, u, v) \
+ __asm__ ("dmultu %2,%3
+ mflo %0
+ mfhi %1" \
+ : "=d" ((UDItype)(w0)), \
+ "=d" ((UDItype)(w1)) \
+ : "d" ((UDItype)(u)), \
+ "d" ((UDItype)(v)))
+#endif
+#define UMUL_TIME 20
+#define UDIV_TIME 140
+#endif /* __mips__ */
+
+#if defined (__ns32000__) && W_TYPE_SIZE == 32
+#define umul_ppmm(w1, w0, u, v) \
+ ({union {UDItype __ll; \
+ struct {USItype __l, __h;} __i; \
+ } __xx; \
+ __asm__ ("meid %2,%0" \
+ : "=g" (__xx.__ll) \
+ : "%0" ((USItype)(u)), \
+ "g" ((USItype)(v))); \
+ (w1) = __xx.__i.__h; (w0) = __xx.__i.__l;})
+#define __umulsidi3(u, v) \
+ ({UDItype __w; \
+ __asm__ ("meid %2,%0" \
+ : "=g" (__w) \
+ : "%0" ((USItype)(u)), \
+ "g" ((USItype)(v))); \
+ __w; })
+#define udiv_qrnnd(q, r, n1, n0, d) \
+ ({union {UDItype __ll; \
+ struct {USItype __l, __h;} __i; \
+ } __xx; \
+ __xx.__i.__h = (n1); __xx.__i.__l = (n0); \
+ __asm__ ("deid %2,%0" \
+ : "=g" (__xx.__ll) \
+ : "0" (__xx.__ll), \
+ "g" ((USItype)(d))); \
+ (r) = __xx.__i.__l; (q) = __xx.__i.__h; })
+#define count_trailing_zeros(count,x) \
+ do {
+ __asm__ ("ffsd %2,%0" \
+ : "=r" ((USItype) (count)) \
+ : "0" ((USItype) 0), \
+ "r" ((USItype) (x))); \
+ } while (0)
+#endif /* __ns32000__ */
+
+#if (defined (_ARCH_PPC) || defined (_IBMR2)) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ do { \
+ if (__builtin_constant_p (bh) && (bh) == 0) \
+ __asm__ ("{a%I4|add%I4c} %1,%3,%4\n\t{aze|addze} %0,%2" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "%r" ((USItype)(ah)), \
+ "%r" ((USItype)(al)), \
+ "rI" ((USItype)(bl))); \
+ else if (__builtin_constant_p (bh) && (bh) ==~(USItype) 0) \
+ __asm__ ("{a%I4|add%I4c} %1,%3,%4\n\t{ame|addme} %0,%2" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "%r" ((USItype)(ah)), \
+ "%r" ((USItype)(al)), \
+ "rI" ((USItype)(bl))); \
+ else \
+ __asm__ ("{a%I5|add%I5c} %1,%4,%5\n\t{ae|adde} %0,%2,%3" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "%r" ((USItype)(ah)), \
+ "r" ((USItype)(bh)), \
+ "%r" ((USItype)(al)), \
+ "rI" ((USItype)(bl))); \
+ } while (0)
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ do { \
+ if (__builtin_constant_p (ah) && (ah) == 0) \
+ __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{sfze|subfze} %0,%2" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "r" ((USItype)(bh)), \
+ "rI" ((USItype)(al)), \
+ "r" ((USItype)(bl))); \
+ else if (__builtin_constant_p (ah) && (ah) ==~(USItype) 0) \
+ __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{sfme|subfme} %0,%2" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "r" ((USItype)(bh)), \
+ "rI" ((USItype)(al)), \
+ "r" ((USItype)(bl))); \
+ else if (__builtin_constant_p (bh) && (bh) == 0) \
+ __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{ame|addme} %0,%2" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "r" ((USItype)(ah)), \
+ "rI" ((USItype)(al)), \
+ "r" ((USItype)(bl))); \
+ else if (__builtin_constant_p (bh) && (bh) ==~(USItype) 0) \
+ __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{aze|addze} %0,%2" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "r" ((USItype)(ah)), \
+ "rI" ((USItype)(al)), \
+ "r" ((USItype)(bl))); \
+ else \
+ __asm__ ("{sf%I4|subf%I4c} %1,%5,%4\n\t{sfe|subfe} %0,%3,%2" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "r" ((USItype)(ah)), \
+ "r" ((USItype)(bh)), \
+ "rI" ((USItype)(al)), \
+ "r" ((USItype)(bl))); \
+ } while (0)
+#define count_leading_zeros(count, x) \
+ __asm__ ("{cntlz|cntlzw} %0,%1" \
+ : "=r" ((USItype)(count)) \
+ : "r" ((USItype)(x)))
+#define COUNT_LEADING_ZEROS_0 32
+#if defined (_ARCH_PPC)
+#define umul_ppmm(ph, pl, m0, m1) \
+ do { \
+ USItype __m0 = (m0), __m1 = (m1); \
+ __asm__ ("mulhwu %0,%1,%2" \
+ : "=r" ((USItype) ph) \
+ : "%r" (__m0), \
+ "r" (__m1)); \
+ (pl) = __m0 * __m1; \
+ } while (0)
+#define UMUL_TIME 15
+#define smul_ppmm(ph, pl, m0, m1) \
+ do { \
+ SItype __m0 = (m0), __m1 = (m1); \
+ __asm__ ("mulhw %0,%1,%2" \
+ : "=r" ((SItype) ph) \
+ : "%r" (__m0), \
+ "r" (__m1)); \
+ (pl) = __m0 * __m1; \
+ } while (0)
+#define SMUL_TIME 14
+#define UDIV_TIME 120
+#else
+#define umul_ppmm(xh, xl, m0, m1) \
+ do { \
+ USItype __m0 = (m0), __m1 = (m1); \
+ __asm__ ("mul %0,%2,%3" \
+ : "=r" ((USItype)(xh)), \
+ "=q" ((USItype)(xl)) \
+ : "r" (__m0), \
+ "r" (__m1)); \
+ (xh) += ((((SItype) __m0 >> 31) & __m1) \
+ + (((SItype) __m1 >> 31) & __m0)); \
+ } while (0)
+#define UMUL_TIME 8
+#define smul_ppmm(xh, xl, m0, m1) \
+ __asm__ ("mul %0,%2,%3" \
+ : "=r" ((SItype)(xh)), \
+ "=q" ((SItype)(xl)) \
+ : "r" (m0), \
+ "r" (m1))
+#define SMUL_TIME 4
+#define sdiv_qrnnd(q, r, nh, nl, d) \
+ __asm__ ("div %0,%2,%4" \
+ : "=r" ((SItype)(q)), "=q" ((SItype)(r)) \
+ : "r" ((SItype)(nh)), "1" ((SItype)(nl)), "r" ((SItype)(d)))
+#define UDIV_TIME 100
+#endif
+#endif /* Power architecture variants. */
+
+#if defined (__pyr__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("addw %5,%1
+ addwc %3,%0" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "%0" ((USItype)(ah)), \
+ "g" ((USItype)(bh)), \
+ "%1" ((USItype)(al)), \
+ "g" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("subw %5,%1
+ subwb %3,%0" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "0" ((USItype)(ah)), \
+ "g" ((USItype)(bh)), \
+ "1" ((USItype)(al)), \
+ "g" ((USItype)(bl)))
+/* This insn works on Pyramids with AP, XP, or MI CPUs, but not with SP. */
+#define umul_ppmm(w1, w0, u, v) \
+ ({union {UDItype __ll; \
+ struct {USItype __h, __l;} __i; \
+ } __xx; \
+ __asm__ ("movw %1,%R0
+ uemul %2,%0" \
+ : "=&r" (__xx.__ll) \
+ : "g" ((USItype) (u)), \
+ "g" ((USItype)(v))); \
+ (w1) = __xx.__i.__h; (w0) = __xx.__i.__l;})
+#endif /* __pyr__ */
+
+#if defined (__ibm032__) /* RT/ROMP */ && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("a %1,%5
+ ae %0,%3" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "%0" ((USItype)(ah)), \
+ "r" ((USItype)(bh)), \
+ "%1" ((USItype)(al)), \
+ "r" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("s %1,%5
+ se %0,%3" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "0" ((USItype)(ah)), \
+ "r" ((USItype)(bh)), \
+ "1" ((USItype)(al)), \
+ "r" ((USItype)(bl)))
+#define umul_ppmm(ph, pl, m0, m1) \
+ do { \
+ USItype __m0 = (m0), __m1 = (m1); \
+ __asm__ ( \
+ "s r2,r2
+ mts r10,%2
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ m r2,%3
+ cas %0,r2,r0
+ mfs r10,%1" \
+ : "=r" ((USItype)(ph)), \
+ "=r" ((USItype)(pl)) \
+ : "%r" (__m0), \
+ "r" (__m1) \
+ : "r2"); \
+ (ph) += ((((SItype) __m0 >> 31) & __m1) \
+ + (((SItype) __m1 >> 31) & __m0)); \
+ } while (0)
+#define UMUL_TIME 20
+#define UDIV_TIME 200
+#define count_leading_zeros(count, x) \
+ do { \
+ if ((x) >= 0x10000) \
+ __asm__ ("clz %0,%1" \
+ : "=r" ((USItype)(count)) \
+ : "r" ((USItype)(x) >> 16)); \
+ else \
+ { \
+ __asm__ ("clz %0,%1" \
+ : "=r" ((USItype)(count)) \
+ : "r" ((USItype)(x))); \
+ (count) += 16; \
+ } \
+ } while (0)
+#endif /* RT/ROMP */
+
+#if defined (__sh2__) && W_TYPE_SIZE == 32
+#define umul_ppmm(w1, w0, u, v) \
+ __asm__ ( \
+ "dmulu.l %2,%3
+ sts macl,%1
+ sts mach,%0" \
+ : "=r" ((USItype)(w1)), \
+ "=r" ((USItype)(w0)) \
+ : "r" ((USItype)(u)), \
+ "r" ((USItype)(v)) \
+ : "macl", "mach")
+#define UMUL_TIME 5
+#endif
+
+#if defined (__sparc__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("addcc %r4,%5,%1
+ addx %r2,%3,%0" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "%rJ" ((USItype)(ah)), \
+ "rI" ((USItype)(bh)), \
+ "%rJ" ((USItype)(al)), \
+ "rI" ((USItype)(bl)) \
+ __CLOBBER_CC)
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("subcc %r4,%5,%1
+ subx %r2,%3,%0" \
+ : "=r" ((USItype)(sh)), \
+ "=&r" ((USItype)(sl)) \
+ : "rJ" ((USItype)(ah)), \
+ "rI" ((USItype)(bh)), \
+ "rJ" ((USItype)(al)), \
+ "rI" ((USItype)(bl)) \
+ __CLOBBER_CC)
+#if defined (__sparc_v8__)
+/* Don't match immediate range because, 1) it is not often useful,
+ 2) the 'I' flag thinks of the range as a 13 bit signed interval,
+ while we want to match a 13 bit interval, sign extended to 32 bits,
+ but INTERPRETED AS UNSIGNED. */
+#define umul_ppmm(w1, w0, u, v) \
+ __asm__ ("umul %2,%3,%1;rd %%y,%0" \
+ : "=r" ((USItype)(w1)), \
+ "=r" ((USItype)(w0)) \
+ : "r" ((USItype)(u)), \
+ "r" ((USItype)(v)))
+#define UMUL_TIME 5
+#ifndef SUPERSPARC /* SuperSPARC's udiv only handles 53 bit dividends */
+#define udiv_qrnnd(q, r, n1, n0, d) \
+ do { \
+ USItype __q; \
+ __asm__ ("mov %1,%%y;nop;nop;nop;udiv %2,%3,%0" \
+ : "=r" ((USItype)(__q)) \
+ : "r" ((USItype)(n1)), \
+ "r" ((USItype)(n0)), \
+ "r" ((USItype)(d))); \
+ (r) = (n0) - __q * (d); \
+ (q) = __q; \
+ } while (0)
+#define UDIV_TIME 25
+#endif /* SUPERSPARC */
+#else /* ! __sparc_v8__ */
+#if defined (__sparclite__)
+/* This has hardware multiply but not divide. It also has two additional
+ instructions scan (ffs from high bit) and divscc. */
+#define umul_ppmm(w1, w0, u, v) \
+ __asm__ ("umul %2,%3,%1;rd %%y,%0" \
+ : "=r" ((USItype)(w1)), \
+ "=r" ((USItype)(w0)) \
+ : "r" ((USItype)(u)), \
+ "r" ((USItype)(v)))
+#define UMUL_TIME 5
+#define udiv_qrnnd(q, r, n1, n0, d) \
+ __asm__ ("! Inlined udiv_qrnnd
+ wr %%g0,%2,%%y ! Not a delayed write for sparclite
+ tst %%g0
+ divscc %3,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%%g1
+ divscc %%g1,%4,%0
+ rd %%y,%1
+ bl,a 1f
+ add %1,%4,%1
+1: ! End of inline udiv_qrnnd" \
+ : "=r" ((USItype)(q)), \
+ "=r" ((USItype)(r)) \
+ : "r" ((USItype)(n1)), \
+ "r" ((USItype)(n0)), \
+ "rI" ((USItype)(d)) \
+ : "%g1" __AND_CLOBBER_CC)
+#define UDIV_TIME 37
+#define count_leading_zeros(count, x) \
+ __asm__ ("scan %1,0,%0" \
+ : "=r" ((USItype)(x)) \
+ : "r" ((USItype)(count)))
+/* Early sparclites return 63 for an argument of 0, but they warn that future
+ implementations might change this. Therefore, leave COUNT_LEADING_ZEROS_0
+ undefined. */
+#endif /* __sparclite__ */
+#endif /* __sparc_v8__ */
+/* Default to sparc v7 versions of umul_ppmm and udiv_qrnnd. */
+#ifndef umul_ppmm
+#define umul_ppmm(w1, w0, u, v) \
+ __asm__ ("! Inlined umul_ppmm
+ wr %%g0,%2,%%y ! SPARC has 0-3 delay insn after a wr
+ sra %3,31,%%g2 ! Don't move this insn
+ and %2,%%g2,%%g2 ! Don't move this insn
+ andcc %%g0,0,%%g1 ! Don't move this insn
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,%3,%%g1
+ mulscc %%g1,0,%%g1
+ add %%g1,%%g2,%0
+ rd %%y,%1" \
+ : "=r" ((USItype)(w1)), \
+ "=r" ((USItype)(w0)) \
+ : "%rI" ((USItype)(u)), \
+ "r" ((USItype)(v)) \
+ : "%g1", "%g2" __AND_CLOBBER_CC)
+#define UMUL_TIME 39 /* 39 instructions */
+#endif
+#ifndef udiv_qrnnd
+#ifndef LONGLONG_STANDALONE
+#define udiv_qrnnd(q, r, n1, n0, d) \
+ do { USItype __r; \
+ (q) = __udiv_qrnnd (&__r, (n1), (n0), (d)); \
+ (r) = __r; \
+ } while (0)
+extern USItype __udiv_qrnnd ();
+#define UDIV_TIME 140
+#endif /* LONGLONG_STANDALONE */
+#endif /* udiv_qrnnd */
+#endif /* __sparc__ */
+
+#if defined (__vax__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("addl2 %5,%1
+ adwc %3,%0" \
+ : "=g" ((USItype)(sh)), \
+ "=&g" ((USItype)(sl)) \
+ : "%0" ((USItype)(ah)), \
+ "g" ((USItype)(bh)), \
+ "%1" ((USItype)(al)), \
+ "g" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("subl2 %5,%1
+ sbwc %3,%0" \
+ : "=g" ((USItype)(sh)), \
+ "=&g" ((USItype)(sl)) \
+ : "0" ((USItype)(ah)), \
+ "g" ((USItype)(bh)), \
+ "1" ((USItype)(al)), \
+ "g" ((USItype)(bl)))
+#define umul_ppmm(xh, xl, m0, m1) \
+ do { \
+ union {UDItype __ll; \
+ struct {USItype __l, __h;} __i; \
+ } __xx; \
+ USItype __m0 = (m0), __m1 = (m1); \
+ __asm__ ("emul %1,%2,$0,%0" \
+ : "=g" (__xx.__ll) \
+ : "g" (__m0), \
+ "g" (__m1)); \
+ (xh) = __xx.__i.__h; (xl) = __xx.__i.__l; \
+ (xh) += ((((SItype) __m0 >> 31) & __m1) \
+ + (((SItype) __m1 >> 31) & __m0)); \
+ } while (0)
+#define sdiv_qrnnd(q, r, n1, n0, d) \
+ do { \
+ union {DItype __ll; \
+ struct {SItype __l, __h;} __i; \
+ } __xx; \
+ __xx.__i.__h = n1; __xx.__i.__l = n0; \
+ __asm__ ("ediv %3,%2,%0,%1" \
+ : "=g" (q), "=g" (r) \
+ : "g" (__xx.ll), "g" (d)); \
+ } while (0)
+#endif /* __vax__ */
+
+#if defined (__z8000__) && W_TYPE_SIZE == 16
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ __asm__ ("add %H1,%H5\n\tadc %H0,%H3" \
+ : "=r" ((unsigned int)(sh)), \
+ "=&r" ((unsigned int)(sl)) \
+ : "%0" ((unsigned int)(ah)), \
+ "r" ((unsigned int)(bh)), \
+ "%1" ((unsigned int)(al)), \
+ "rQR" ((unsigned int)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ __asm__ ("sub %H1,%H5\n\tsbc %H0,%H3" \
+ : "=r" ((unsigned int)(sh)), \
+ "=&r" ((unsigned int)(sl)) \
+ : "0" ((unsigned int)(ah)), \
+ "r" ((unsigned int)(bh)), \
+ "1" ((unsigned int)(al)), \
+ "rQR" ((unsigned int)(bl)))
+#define umul_ppmm(xh, xl, m0, m1) \
+ do { \
+ union {long int __ll; \
+ struct {unsigned int __h, __l;} __i; \
+ } __xx; \
+ unsigned int __m0 = (m0), __m1 = (m1); \
+ __asm__ ("mult %S0,%H3" \
+ : "=r" (__xx.__i.__h), \
+ "=r" (__xx.__i.__l) \
+ : "%1" (__m0), \
+ "rQR" (__m1)); \
+ (xh) = __xx.__i.__h; (xl) = __xx.__i.__l; \
+ (xh) += ((((signed int) __m0 >> 15) & __m1) \
+ + (((signed int) __m1 >> 15) & __m0)); \
+ } while (0)
+#endif /* __z8000__ */
+
+#endif /* __GNUC__ */
+
+
+#if !defined (umul_ppmm) && defined (__umulsidi3)
+#define umul_ppmm(ph, pl, m0, m1) \
+ { \
+ UDWtype __ll = __umulsidi3 (m0, m1); \
+ ph = (UWtype) (__ll >> W_TYPE_SIZE); \
+ pl = (UWtype) __ll; \
+ }
+#endif
+
+#if !defined (__umulsidi3)
+#define __umulsidi3(u, v) \
+ ({UWtype __hi, __lo; \
+ umul_ppmm (__hi, __lo, u, v); \
+ ((UDWtype) __hi << W_TYPE_SIZE) | __lo; })
+#endif
+
+/* If this machine has no inline assembler, use C macros. */
+
+#if !defined (add_ssaaaa)
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+ do { \
+ UWtype __x; \
+ __x = (al) + (bl); \
+ (sh) = (ah) + (bh) + (__x < (al)); \
+ (sl) = __x; \
+ } while (0)
+#endif
+
+#if !defined (sub_ddmmss)
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+ do { \
+ UWtype __x; \
+ __x = (al) - (bl); \
+ (sh) = (ah) - (bh) - (__x > (al)); \
+ (sl) = __x; \
+ } while (0)
+#endif
+
+#if !defined (umul_ppmm)
+#define umul_ppmm(w1, w0, u, v) \
+ do { \
+ UWtype __x0, __x1, __x2, __x3; \
+ UHWtype __ul, __vl, __uh, __vh; \
+ UWtype __u = (u), __v = (v); \
+ \
+ __ul = __ll_lowpart (__u); \
+ __uh = __ll_highpart (__u); \
+ __vl = __ll_lowpart (__v); \
+ __vh = __ll_highpart (__v); \
+ \
+ __x0 = (UWtype) __ul * __vl; \
+ __x1 = (UWtype) __ul * __vh; \
+ __x2 = (UWtype) __uh * __vl; \
+ __x3 = (UWtype) __uh * __vh; \
+ \
+ __x1 += __ll_highpart (__x0);/* this can't give carry */ \
+ __x1 += __x2; /* but this indeed can */ \
+ if (__x1 < __x2) /* did we get it? */ \
+ __x3 += __ll_B; /* yes, add it in the proper pos. */ \
+ \
+ (w1) = __x3 + __ll_highpart (__x1); \
+ (w0) = (__ll_lowpart (__x1) << W_TYPE_SIZE/2) + __ll_lowpart (__x0);\
+ } while (0)
+#endif
+
+#if !defined (umul_ppmm)
+#define smul_ppmm(w1, w0, u, v) \
+ do { \
+ UWtype __w1; \
+ UWtype __m0 = (u), __m1 = (v); \
+ umul_ppmm (__w1, w0, __m0, __m1); \
+ (w1) = __w1 - (-(__m0 >> (W_TYPE_SIZE - 1)) & __m1) \
+ - (-(__m1 >> (W_TYPE_SIZE - 1)) & __m0); \
+ } while (0)
+#endif
+
+/* Define this unconditionally, so it can be used for debugging. */
+#define __udiv_qrnnd_c(q, r, n1, n0, d) \
+ do { \
+ UWtype __d1, __d0, __q1, __q0, __r1, __r0, __m; \
+ __d1 = __ll_highpart (d); \
+ __d0 = __ll_lowpart (d); \
+ \
+ __r1 = (n1) % __d1; \
+ __q1 = (n1) / __d1; \
+ __m = (UWtype) __q1 * __d0; \
+ __r1 = __r1 * __ll_B | __ll_highpart (n0); \
+ if (__r1 < __m) \
+ { \
+ __q1--, __r1 += (d); \
+ if (__r1 >= (d)) /* i.e. we didn't get carry when adding to __r1 */\
+ if (__r1 < __m) \
+ __q1--, __r1 += (d); \
+ } \
+ __r1 -= __m; \
+ \
+ __r0 = __r1 % __d1; \
+ __q0 = __r1 / __d1; \
+ __m = (UWtype) __q0 * __d0; \
+ __r0 = __r0 * __ll_B | __ll_lowpart (n0); \
+ if (__r0 < __m) \
+ { \
+ __q0--, __r0 += (d); \
+ if (__r0 >= (d)) \
+ if (__r0 < __m) \
+ __q0--, __r0 += (d); \
+ } \
+ __r0 -= __m; \
+ \
+ (q) = (UWtype) __q1 * __ll_B | __q0; \
+ (r) = __r0; \
+ } while (0)
+
+/* If the processor has no udiv_qrnnd but sdiv_qrnnd, go through
+ __udiv_w_sdiv (defined in libgcc or elsewhere). */
+#if !defined (udiv_qrnnd) && defined (sdiv_qrnnd)
+#define udiv_qrnnd(q, r, nh, nl, d) \
+ do { \
+ UWtype __r; \
+ (q) = __MPN(udiv_w_sdiv) (&__r, nh, nl, d); \
+ (r) = __r; \
+ } while (0)
+#endif
+
+/* If udiv_qrnnd was not defined for this processor, use __udiv_qrnnd_c. */
+#if !defined (udiv_qrnnd)
+#define UDIV_NEEDS_NORMALIZATION 1
+#define udiv_qrnnd __udiv_qrnnd_c
+#endif
+
+#if !defined (count_leading_zeros)
+extern
+#ifdef __STDC__
+const
+#endif
+unsigned char __clz_tab[];
+#define count_leading_zeros(count, x) \
+ do { \
+ UWtype __xr = (x); \
+ UWtype __a; \
+ \
+ if (W_TYPE_SIZE <= 32) \
+ { \
+ __a = __xr < ((UWtype) 1 << 2*__BITS4) \
+ ? (__xr < ((UWtype) 1 << __BITS4) ? 0 : __BITS4) \
+ : (__xr < ((UWtype) 1 << 3*__BITS4) ? 2*__BITS4 : 3*__BITS4);\
+ } \
+ else \
+ { \
+ for (__a = W_TYPE_SIZE - 8; __a > 0; __a -= 8) \
+ if (((__xr >> __a) & 0xff) != 0) \
+ break; \
+ } \
+ \
+ (count) = W_TYPE_SIZE - (__clz_tab[__xr >> __a] + __a); \
+ } while (0)
+/* This version gives a well-defined value for zero. */
+#define COUNT_LEADING_ZEROS_0 W_TYPE_SIZE
+#endif
+
+#if !defined (count_trailing_zeros)
+/* Define count_trailing_zeros using count_leading_zeros. The latter might be
+ defined in asm, but if it is not, the C version above is good enough. */
+#define count_trailing_zeros(count, x) \
+ do { \
+ UWtype __ctz_x = (x); \
+ UWtype __ctz_c; \
+ count_leading_zeros (__ctz_c, __ctz_x & -__ctz_x); \
+ (count) = W_TYPE_SIZE - 1 - __ctz_c; \
+ } while (0)
+#endif
+
+#ifndef UDIV_NEEDS_NORMALIZATION
+#define UDIV_NEEDS_NORMALIZATION 0
+#endif
--- /dev/null
+/* Memory allocation routines.
+
+Copyright (C) 1991, 1993, 1994 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include <stdio.h>
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#ifdef __NeXT__
+#define static
+#endif
+
+#if __STDC__
+void * (*_mp_allocate_func) (size_t) = _mp_default_allocate;
+void * (*_mp_reallocate_func) (void *, size_t, size_t)
+ = _mp_default_reallocate;
+void (*_mp_free_func) (void *, size_t) = _mp_default_free;
+#else
+void * (*_mp_allocate_func) () = _mp_default_allocate;
+void * (*_mp_reallocate_func) () = _mp_default_reallocate;
+void (*_mp_free_func) () = _mp_default_free;
+#endif
+
+/* Default allocation functions. In case of failure to allocate/reallocate
+ an error message is written to stderr and the program aborts. */
+
+void *
+#if __STDC__
+_mp_default_allocate (size_t size)
+#else
+_mp_default_allocate (size)
+ size_t size;
+#endif
+{
+ void *ret;
+
+ ret = malloc (size);
+ if (ret == 0)
+ {
+ perror ("cannot allocate in gmp");
+ abort ();
+ }
+
+ return ret;
+}
+
+void *
+#if __STDC__
+_mp_default_reallocate (void *oldptr, unused size_t old_size, size_t new_size)
+#else
+_mp_default_reallocate (oldptr, old_size, new_size)
+ void *oldptr;
+ size_t old_size;
+ size_t new_size;
+#endif
+{
+ void *ret;
+
+ ret = realloc (oldptr, new_size);
+ if (ret == 0)
+ {
+ perror ("cannot allocate in gmp");
+ abort ();
+ }
+
+ return ret;
+}
+
+void
+#if __STDC__
+_mp_default_free (void *blk_ptr, unused size_t blk_size)
+#else
+_mp_default_free (blk_ptr, blk_size)
+ void *blk_ptr;
+ size_t blk_size;
+#endif
+{
+ free (blk_ptr);
+}
--- /dev/null
+/* __clz_tab -- support for longlong.h
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#if 0
+#include "gmp.h"
+#include "gmp-impl.h"
+#endif
+
+#if 0
+const
+#endif
+unsigned char __clz_tab[] =
+{
+ 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
+ 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
+ 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
+ 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
+ 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+ 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+ 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+ 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+};
--- /dev/null
+## Process this file with automake to produce Makefile.in -*- makefile -*-
+
+INCLUDES = -I$(srcdir) -I$(srcdir)/.. -I$(top_srcdir) -I$(top_srcdir)/src \
+ -I$(top_srcdir)/intl
+
+noinst_LIBRARIES = libmpf.a
+libmpf_a_SOURCES = clear.c get_str.c iset_d.c set_d.c set_dfl_prec.c
+
+MAINTAINERCLEANFILES = Makefile.in
--- /dev/null
+/* mpf_clear -- de-allocate the space occupied by the dynamic digit space of
+ an integer.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_clear (mpf_ptr m)
+#else
+mpf_clear (m)
+ mpf_ptr m;
+#endif
+{
+ (*_mp_free_func) (m->_mp_d, (m->_mp_prec + 1) * BYTES_PER_MP_LIMB);
+}
--- /dev/null
+/* mpf_get_str (digit_ptr, exp, base, n_digits, a) -- Convert the floating
+ point number A to a base BASE number and store N_DIGITS raw digits at
+ DIGIT_PTR, and the base BASE exponent in the word pointed to by EXP. For
+ example, the number 3.1416 would be returned as "31416" in DIGIT_PTR and
+ 1 in EXP.
+
+Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/*
+ New algorithm for converting fractions (951019):
+ 0. Call the fraction to convert F.
+ 1. Compute [exp * log(2^BITS_PER_MP_LIMB)/log(B)], i.e.,
+ [exp * BITS_PER_MP_LIMB * __mp_bases[B].chars_per_bit_exactly]. Exp is
+ the number of limbs between the limb point and the most significant
+ non-zero limb. Call this result n.
+ 2. Compute B^n.
+ 3. F*B^n will now be just below 1, which can be converted easily. (Just
+ multiply by B repeatedly, and see the digits fall out as integers.)
+ We should interrupt the conversion process of F*B^n as soon as the number
+ of digits requested have been generated.
+
+ New algorithm for converting integers (951019):
+ 0. Call the integer to convert I.
+ 1. Compute [exp * log(2^BITS_PER_MP_LIMB)/log(B)], i.e.,
+ [exp BITS_PER_MP_LIMB * __mp_bases[B].chars_per_bit_exactly]. Exp is
+ the number of limbs between the limb point and the least significant
+ non-zero limb. Call this result n.
+ 2. Compute B^n.
+ 3. I/B^n can be converted easily. (Just divide by B repeatedly. In GMP,
+ this is best done by calling mpn_get_str.)
+ Note that converting I/B^n could yield more digits than requested. For
+ efficiency, the variable n above should be set larger in such cases, to
+ kill all undesired digits in the division in step 3.
+*/
+
+char *
+#if __STDC__
+mpf_get_str (char *digit_ptr, mp_exp_t *exp, int base, size_t n_digits, mpf_srcptr u)
+#else
+mpf_get_str (digit_ptr, exp, base, n_digits, u)
+ char *digit_ptr;
+ mp_exp_t *exp;
+ int base;
+ size_t n_digits;
+ mpf_srcptr u;
+#endif
+{
+ mp_size_t usize;
+ mp_exp_t uexp;
+ unsigned char *str;
+ size_t str_size;
+ char *num_to_text;
+ long i; /* should be size_t */
+ mp_ptr rp;
+ mp_limb_t big_base;
+ size_t digits_computed_so_far;
+ int dig_per_u;
+ mp_srcptr up;
+ unsigned char *tstr;
+ mp_exp_t exp_in_base;
+ TMP_DECL (marker);
+
+ TMP_MARK (marker);
+ usize = u->_mp_size;
+ uexp = u->_mp_exp;
+
+ if (base >= 0)
+ {
+ if (base == 0)
+ base = 10;
+ num_to_text = (char *) "0123456789abcdefghijklmnopqrstuvwxyz";
+ }
+ else
+ {
+ base = -base;
+ num_to_text = (char *) "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+ }
+
+ /* Don't compute more digits than U can accurately represent.
+ Also, if 0 digits were requested, give *exactly* as many digits
+ as can be accurately represented. */
+ {
+ size_t max_digits = (((u->_mp_prec - 1) * BITS_PER_MP_LIMB)
+ * __mp_bases[base].chars_per_bit_exactly);
+ if (n_digits == 0 || n_digits > max_digits)
+ n_digits = max_digits;
+ }
+
+ if (digit_ptr == 0)
+ {
+ /* We didn't get a string from the user. Allocate one (and return
+ a pointer to it) with space for `-' and terminating null. */
+ digit_ptr = (char *) (*_mp_allocate_func) (n_digits + 2);
+ }
+
+ if (usize == 0)
+ {
+ *exp = 0;
+ *digit_ptr = 0;
+ return digit_ptr;
+ }
+
+ str = (unsigned char *) digit_ptr;
+
+ /* Allocate temporary digit space. We can't put digits directly in the user
+ area, since we almost always generate more digits than requested. */
+ tstr = (unsigned char *) TMP_ALLOC (n_digits + 3 * BITS_PER_MP_LIMB);
+
+ if (usize < 0)
+ {
+ *digit_ptr = '-';
+ str++;
+ usize = -usize;
+ }
+
+ digits_computed_so_far = 0;
+
+ if (uexp > usize)
+ {
+ /* The number has just an integral part. */
+ mp_size_t rsize;
+ mp_size_t exp_in_limbs;
+ mp_size_t msize;
+ mp_ptr tp, xp, mp;
+ int cnt;
+ mp_limb_t cy;
+ mp_size_t start_str;
+ mp_size_t n_limbs;
+
+ n_limbs = 2 + ((mp_size_t) (n_digits / __mp_bases[base].chars_per_bit_exactly)
+ / BITS_PER_MP_LIMB);
+
+ /* Compute n such that [u/B^n] contains (somewhat) more than n_digits
+ digits. (We compute less than that only if that is an exact number,
+ i.e., exp is small enough.) */
+
+ exp_in_limbs = uexp;
+
+ if (n_limbs >= exp_in_limbs)
+ {
+ /* The number is so small that we convert the entire number. */
+ exp_in_base = 0;
+ rp = (mp_ptr) TMP_ALLOC (exp_in_limbs * BYTES_PER_MP_LIMB);
+ MPN_ZERO (rp, exp_in_limbs - usize);
+ MPN_COPY (rp + (exp_in_limbs - usize), u->_mp_d, usize);
+ rsize = exp_in_limbs;
+ }
+ else
+ {
+ exp_in_limbs -= n_limbs;
+ exp_in_base = (((exp_in_limbs * BITS_PER_MP_LIMB - 1))
+ * __mp_bases[base].chars_per_bit_exactly);
+
+ rsize = exp_in_limbs + 1;
+ rp = (mp_ptr) TMP_ALLOC (rsize * BYTES_PER_MP_LIMB);
+ tp = (mp_ptr) TMP_ALLOC (rsize * BYTES_PER_MP_LIMB);
+
+ rp[0] = base;
+ rsize = 1;
+
+ count_leading_zeros (cnt, exp_in_base);
+ for (i = BITS_PER_MP_LIMB - cnt - 2; i >= 0; i--)
+ {
+ mpn_mul_n (tp, rp, rp, rsize);
+ rsize = 2 * rsize;
+ rsize -= tp[rsize - 1] == 0;
+ xp = tp; tp = rp; rp = xp;
+
+ if (((exp_in_base >> i) & 1) != 0)
+ {
+ cy = mpn_mul_1 (rp, rp, rsize, (mp_limb_t) base);
+ rp[rsize] = cy;
+ rsize += cy != 0;
+ }
+ }
+
+ mp = u->_mp_d;
+ msize = usize;
+
+ {
+ mp_ptr qp;
+ mp_limb_t qflag;
+ mp_size_t xtra;
+ if (msize < rsize)
+ {
+ mp_ptr tmp = (mp_ptr) TMP_ALLOC ((rsize+1)* BYTES_PER_MP_LIMB);
+ MPN_ZERO (tmp, rsize - msize);
+ MPN_COPY (tmp + rsize - msize, mp, msize);
+ mp = tmp;
+ msize = rsize;
+ }
+ else
+ {
+ mp_ptr tmp = (mp_ptr) TMP_ALLOC ((msize+1)* BYTES_PER_MP_LIMB);
+ MPN_COPY (tmp, mp, msize);
+ mp = tmp;
+ }
+ count_leading_zeros (cnt, rp[rsize - 1]);
+ cy = 0;
+ if (cnt != 0)
+ {
+ mpn_lshift (rp, rp, rsize, cnt);
+ cy = mpn_lshift (mp, mp, msize, cnt);
+ if (cy)
+ mp[msize++] = cy;
+ }
+
+ {
+ mp_size_t qsize = n_limbs + (cy != 0);
+ qp = (mp_ptr) TMP_ALLOC ((qsize + 1) * BYTES_PER_MP_LIMB);
+ xtra = qsize - (msize - rsize);
+ qflag = mpn_divrem (qp, xtra, mp, msize, rp, rsize);
+ qp[qsize] = qflag;
+ rsize = qsize + qflag;
+ rp = qp;
+ }
+ }
+ }
+
+ str_size = mpn_get_str (tstr, base, rp, rsize);
+
+ if (str_size > n_digits + 3 * BITS_PER_MP_LIMB)
+ abort ();
+
+ start_str = 0;
+ while (tstr[start_str] == 0)
+ start_str++;
+
+ for (i = start_str; i < (int) str_size; i++)
+ {
+ tstr[digits_computed_so_far++] = tstr[i];
+ if (digits_computed_so_far > n_digits)
+ break;
+ }
+ exp_in_base = exp_in_base + str_size - start_str;
+ goto finish_up;
+ }
+
+ exp_in_base = 0;
+
+ if (uexp > 0)
+ {
+ /* The number has an integral part, convert that first.
+ If there is a fractional part too, it will be handled later. */
+ mp_size_t start_str;
+
+ rp = (mp_ptr) TMP_ALLOC (uexp * BYTES_PER_MP_LIMB);
+ up = u->_mp_d + usize - uexp;
+ MPN_COPY (rp, up, uexp);
+
+ str_size = mpn_get_str (tstr, base, rp, uexp);
+
+ start_str = 0;
+ while (tstr[start_str] == 0)
+ start_str++;
+
+ for (i = start_str; i < (int) str_size; i++)
+ {
+ tstr[digits_computed_so_far++] = tstr[i];
+ if (digits_computed_so_far > n_digits)
+ {
+ exp_in_base = str_size - start_str;
+ goto finish_up;
+ }
+ }
+
+ exp_in_base = str_size - start_str;
+ /* Modify somewhat and fall out to convert fraction... */
+ usize -= uexp;
+ uexp = 0;
+ }
+
+ if (usize <= 0)
+ goto finish_up;
+
+ /* Convert the fraction. */
+ {
+ mp_size_t rsize, msize;
+ mp_ptr rp, tp, xp, mp;
+ int cnt;
+ mp_limb_t cy;
+ mp_exp_t nexp;
+
+ big_base = __mp_bases[base].big_base;
+ dig_per_u = __mp_bases[base].chars_per_limb;
+
+ /* Hack for correctly (although not efficiently) converting to bases that
+ are powers of 2. If we deem it important, we could handle powers of 2
+ by shifting and masking (just like mpn_get_str). */
+ if (big_base < 10) /* logarithm of base when power of two */
+ {
+ int logbase = big_base;
+ if (dig_per_u * logbase == BITS_PER_MP_LIMB)
+ dig_per_u--;
+ big_base = (mp_limb_t) 1 << (dig_per_u * logbase);
+ /* fall out to general code... */
+ }
+
+#if 0
+ if (0 && uexp == 0)
+ {
+ rp = (mp_ptr) TMP_ALLOC (usize * BYTES_PER_MP_LIMB);
+ up = u->_mp_d;
+ MPN_COPY (rp, up, usize);
+ rsize = usize;
+ nexp = 0;
+ }
+ else
+ {}
+#endif
+ uexp = -uexp;
+ if (u->_mp_d[usize - 1] == 0)
+ cnt = 0;
+ else
+ count_leading_zeros (cnt, u->_mp_d[usize - 1]);
+
+ nexp = ((uexp * BITS_PER_MP_LIMB) + cnt)
+ * __mp_bases[base].chars_per_bit_exactly;
+
+ if (nexp == 0)
+ {
+ rp = (mp_ptr) TMP_ALLOC (usize * BYTES_PER_MP_LIMB);
+ up = u->_mp_d;
+ MPN_COPY (rp, up, usize);
+ rsize = usize;
+ }
+ else
+ {
+ rsize = uexp + 2;
+ rp = (mp_ptr) TMP_ALLOC (rsize * BYTES_PER_MP_LIMB);
+ tp = (mp_ptr) TMP_ALLOC (rsize * BYTES_PER_MP_LIMB);
+
+ rp[0] = base;
+ rsize = 1;
+
+ count_leading_zeros (cnt, nexp);
+ for (i = BITS_PER_MP_LIMB - cnt - 2; i >= 0; i--)
+ {
+ mpn_mul_n (tp, rp, rp, rsize);
+ rsize = 2 * rsize;
+ rsize -= tp[rsize - 1] == 0;
+ xp = tp; tp = rp; rp = xp;
+
+ if (((nexp >> i) & 1) != 0)
+ {
+ cy = mpn_mul_1 (rp, rp, rsize, (mp_limb_t) base);
+ rp[rsize] = cy;
+ rsize += cy != 0;
+ }
+ }
+
+ /* Did our multiplier (base^nexp) cancel with uexp? */
+#if 0
+ if (uexp != rsize)
+ {
+ do
+ {
+ cy = mpn_mul_1 (rp, rp, rsize, big_base);
+ nexp += dig_per_u;
+ }
+ while (cy == 0);
+ rp[rsize++] = cy;
+ }
+#endif
+ mp = u->_mp_d;
+ msize = usize;
+
+ tp = (mp_ptr) TMP_ALLOC ((rsize + msize) * BYTES_PER_MP_LIMB);
+ if (rsize > msize)
+ cy = mpn_mul (tp, rp, rsize, mp, msize);
+ else
+ cy = mpn_mul (tp, mp, msize, rp, rsize);
+ rsize += msize;
+ rsize -= cy == 0;
+ rp = tp;
+
+ /* If we already output digits (for an integral part) pad
+ leading zeros. */
+ if (digits_computed_so_far != 0)
+ for (i = 0; i < nexp; i++)
+ tstr[digits_computed_so_far++] = 0;
+ }
+
+ while (digits_computed_so_far <= n_digits)
+ {
+ /* For speed: skip trailing zeroes. */
+ if (rp[0] == 0)
+ {
+ rp++;
+ rsize--;
+ if (rsize == 0)
+ {
+ n_digits = digits_computed_so_far;
+ break;
+ }
+ }
+
+ cy = mpn_mul_1 (rp, rp, rsize, big_base);
+ if (digits_computed_so_far == 0 && cy == 0)
+ {
+ abort ();
+ nexp += dig_per_u;
+ continue;
+ }
+ /* Convert N1 from BIG_BASE to a string of digits in BASE
+ using single precision operations. */
+ {
+ unsigned char *s = tstr + digits_computed_so_far + dig_per_u;
+ for (i = dig_per_u - 1; i >= 0; i--)
+ {
+ *--s = cy % base;
+ cy /= base;
+ }
+ }
+ digits_computed_so_far += dig_per_u;
+ }
+ if (exp_in_base == 0)
+ exp_in_base = -nexp;
+ }
+
+ finish_up:
+
+ /* We can have at most one leading 0. Remove it. */
+ if (tstr[0] == 0)
+ {
+ tstr++;
+ digits_computed_so_far--;
+ exp_in_base--;
+ }
+
+ /* We should normally have computed too many digits. Round the result
+ at the point indicated by n_digits. */
+ if (digits_computed_so_far > n_digits)
+ {
+ /* Round the result. */
+ if (tstr[n_digits] * 2 >= base)
+ {
+ digits_computed_so_far = n_digits;
+ for (i = n_digits - 1; i >= 0; i--)
+ {
+ unsigned int x;
+ x = ++(tstr[i]);
+ if ((int) x < base)
+ goto rounded_ok;
+ digits_computed_so_far--;
+ }
+ tstr[0] = 1;
+ digits_computed_so_far = 1;
+ exp_in_base++;
+ rounded_ok:;
+ }
+ }
+
+ /* We might have fewer digits than requested as a result of rounding above,
+ (i.e. 0.999999 => 1.0) or because we have a number that simply doesn't
+ need many digits in this base (i.e., 0.125 in base 10). */
+ if (n_digits > digits_computed_so_far)
+ n_digits = digits_computed_so_far;
+
+ /* Remove trailing 0. There can be many zeros. */
+ while (n_digits != 0 && tstr[n_digits - 1] == 0)
+ n_digits--;
+
+ /* Translate to ascii and null-terminate. */
+ for (i = 0; i < (int) n_digits; i++)
+ *str++ = num_to_text[tstr[i]];
+ *str = 0;
+ *exp = exp_in_base;
+ TMP_FREE (marker);
+ return digit_ptr;
+}
+
+#if COPY_THIS_TO_OTHER_PLACES
+ /* Use this expression in lots of places in the library instead of the
+ count_leading_zeros+expression that is used currently. This expression
+ is much more accurate and will save odles of memory. */
+ rsize = ((mp_size_t) (exp_in_base / __mp_bases[base].chars_per_bit_exactly)
+ + BITS_PER_MP_LIMB) / BITS_PER_MP_LIMB;
+#endif
--- /dev/null
+/* mpf_init_set_d -- Initialize a float and assign it from a double.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_init_set_d (mpf_ptr r, double val)
+#else
+mpf_init_set_d (r, val)
+ mpf_ptr r;
+ double val;
+#endif
+{
+ mp_size_t prec = __gmp_default_fp_limb_precision;
+ r->_mp_d = (mp_ptr) (*_mp_allocate_func) ((prec + 1) * BYTES_PER_MP_LIMB);
+ r->_mp_prec = prec;
+
+ mpf_set_d (r, val);
+}
--- /dev/null
+/* mpf_set_d -- Assign a float from a IEEE double.
+
+Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_set_d (mpf_ptr r, double d)
+#else
+mpf_set_d (r, d)
+ mpf_ptr r;
+ double d;
+#endif
+{
+ int negative;
+
+ if (d == 0)
+ {
+ SIZ(r) = 0;
+ EXP(r) = 0;
+ return;
+ }
+ negative = d < 0;
+ d = ABS (d);
+
+ EXP(r) = __gmp_extract_double (PTR(r), d);
+ SIZ(r) = negative ? -LIMBS_PER_DOUBLE : LIMBS_PER_DOUBLE;
+}
--- /dev/null
+/* mpf_set_default_prec --
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_size_t __gmp_default_fp_limb_precision
+ = (53 + 2 * BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
+
+void
+#if __STDC__
+mpf_set_default_prec (unsigned long int prec_in_bits)
+#else
+mpf_set_default_prec (prec_in_bits)
+ unsigned long int prec_in_bits;
+#endif
+{
+ mp_size_t prec;
+
+ prec = (MAX (53, prec_in_bits) + 2 * BITS_PER_MP_LIMB - 1)/BITS_PER_MP_LIMB;
+ __gmp_default_fp_limb_precision = prec;
+}
--- /dev/null
+## Process this file with automake to produce Makefile.in -*- makefile -*-
+
+INCLUDES = -I$(srcdir) -I$(srcdir)/.. -I$(top_srcdir) -I$(top_srcdir)/src \
+ -I$(top_srcdir)/intl
+
+noinst_LIBRARIES = libmpn.a
+libmpn_a_SOURCES = add_n.c addmul_1.c cmp.c divrem.c get_str.c \
+inlines.c lshift.c mp_bases.c mul.c mul_1.c mul_n.c sub_n.c submul_1.c
+
+MAINTAINERCLEANFILES = Makefile.in
--- /dev/null
+/* mpn_add_n -- Add two limb vectors of equal, non-zero length.
+
+Copyright (C) 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_limb_t
+#if __STDC__
+mpn_add_n (mp_ptr res_ptr, mp_srcptr s1_ptr, mp_srcptr s2_ptr, mp_size_t size)
+#else
+mpn_add_n (res_ptr, s1_ptr, s2_ptr, size)
+ register mp_ptr res_ptr;
+ register mp_srcptr s1_ptr;
+ register mp_srcptr s2_ptr;
+ mp_size_t size;
+#endif
+{
+ register mp_limb_t x, y, cy;
+ register mp_size_t j;
+
+ /* The loop counter and index J goes from -SIZE to -1. This way
+ the loop becomes faster. */
+ j = -size;
+
+ /* Offset the base pointers to compensate for the negative indices. */
+ s1_ptr -= j;
+ s2_ptr -= j;
+ res_ptr -= j;
+
+ cy = 0;
+ do
+ {
+ y = s2_ptr[j];
+ x = s1_ptr[j];
+ y += cy; /* add previous carry to one addend */
+ cy = (y < cy); /* get out carry from that addition */
+ y = x + y; /* add other addend */
+ cy = (y < x) + cy; /* get out carry from that add, combine */
+ res_ptr[j] = y;
+ }
+ while (++j != 0);
+
+ return cy;
+}
--- /dev/null
+/* mpn_addmul_1 -- multiply the S1_SIZE long limb vector pointed to by S1_PTR
+ by S2_LIMB, add the S1_SIZE least significant limbs of the product to the
+ limb vector pointed to by RES_PTR. Return the most significant limb of
+ the product, adjusted for carry-out from the addition.
+
+Copyright (C) 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+mp_limb_t
+mpn_addmul_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+ register mp_ptr res_ptr;
+ register mp_srcptr s1_ptr;
+ mp_size_t s1_size;
+ register mp_limb_t s2_limb;
+{
+ register mp_limb_t cy_limb;
+ register mp_size_t j;
+ register mp_limb_t prod_high, prod_low;
+ register mp_limb_t x;
+
+ /* The loop counter and index J goes from -SIZE to -1. This way
+ the loop becomes faster. */
+ j = -s1_size;
+
+ /* Offset the base pointers to compensate for the negative indices. */
+ res_ptr -= j;
+ s1_ptr -= j;
+
+ cy_limb = 0;
+ do
+ {
+ umul_ppmm (prod_high, prod_low, s1_ptr[j], s2_limb);
+
+ prod_low += cy_limb;
+ cy_limb = (prod_low < cy_limb) + prod_high;
+
+ x = res_ptr[j];
+ prod_low = x + prod_low;
+ cy_limb += (prod_low < x);
+ res_ptr[j] = prod_low;
+ }
+ while (++j != 0);
+
+ return cy_limb;
+}
--- /dev/null
+/* mpn_cmp -- Compare two low-level natural-number integers.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/* Compare OP1_PTR/OP1_SIZE with OP2_PTR/OP2_SIZE.
+ There are no restrictions on the relative sizes of
+ the two arguments.
+ Return 1 if OP1 > OP2, 0 if they are equal, and -1 if OP1 < OP2. */
+
+int
+#if __STDC__
+mpn_cmp (mp_srcptr op1_ptr, mp_srcptr op2_ptr, mp_size_t size)
+#else
+mpn_cmp (op1_ptr, op2_ptr, size)
+ mp_srcptr op1_ptr;
+ mp_srcptr op2_ptr;
+ mp_size_t size;
+#endif
+{
+ mp_size_t i;
+ mp_limb_t op1_word, op2_word;
+
+ for (i = size - 1; i >= 0; i--)
+ {
+ op1_word = op1_ptr[i];
+ op2_word = op2_ptr[i];
+ if (op1_word != op2_word)
+ goto diff;
+ }
+ return 0;
+ diff:
+ /* This can *not* be simplified to
+ op2_word - op2_word
+ since that expression might give signed overflow. */
+ return (op1_word > op2_word) ? 1 : -1;
+}
--- /dev/null
+/* mpn_divrem -- Divide natural numbers, producing both remainder and
+ quotient.
+
+Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/* Divide num (NP/NSIZE) by den (DP/DSIZE) and write
+ the NSIZE-DSIZE least significant quotient limbs at QP
+ and the DSIZE long remainder at NP. If QEXTRA_LIMBS is
+ non-zero, generate that many fraction bits and append them after the
+ other quotient limbs.
+ Return the most significant limb of the quotient, this is always 0 or 1.
+
+ Preconditions:
+ 0. NSIZE >= DSIZE.
+ 1. The most significant bit of the divisor must be set.
+ 2. QP must either not overlap with the input operands at all, or
+ QP + DSIZE >= NP must hold true. (This means that it's
+ possible to put the quotient in the high part of NUM, right after the
+ remainder in NUM.
+ 3. NSIZE >= DSIZE, even if QEXTRA_LIMBS is non-zero. */
+
+mp_limb_t
+#if __STDC__
+mpn_divrem (mp_ptr qp, mp_size_t qextra_limbs,
+ mp_ptr np, mp_size_t nsize,
+ mp_srcptr dp, mp_size_t dsize)
+#else
+mpn_divrem (qp, qextra_limbs, np, nsize, dp, dsize)
+ mp_ptr qp;
+ mp_size_t qextra_limbs;
+ mp_ptr np;
+ mp_size_t nsize;
+ mp_srcptr dp;
+ mp_size_t dsize;
+#endif
+{
+ mp_limb_t most_significant_q_limb = 0;
+
+ switch (dsize)
+ {
+ case 0:
+ /* We are asked to divide by zero, so go ahead and do it! (To make
+ the compiler not remove this statement, return the value.) */
+ return 1 / dsize;
+
+ case 1:
+ {
+ mp_size_t i;
+ mp_limb_t n1;
+ mp_limb_t d;
+
+ d = dp[0];
+ n1 = np[nsize - 1];
+
+ if (n1 >= d)
+ {
+ n1 -= d;
+ most_significant_q_limb = 1;
+ }
+
+ qp += qextra_limbs;
+ for (i = nsize - 2; i >= 0; i--)
+ udiv_qrnnd (qp[i], n1, n1, np[i], d);
+ qp -= qextra_limbs;
+
+ for (i = qextra_limbs - 1; i >= 0; i--)
+ udiv_qrnnd (qp[i], n1, n1, 0, d);
+
+ np[0] = n1;
+ }
+ break;
+
+ case 2:
+ {
+ mp_size_t i;
+ mp_limb_t n1, n0, n2;
+ mp_limb_t d1, d0;
+
+ np += nsize - 2;
+ d1 = dp[1];
+ d0 = dp[0];
+ n1 = np[1];
+ n0 = np[0];
+
+ if (n1 >= d1 && (n1 > d1 || n0 >= d0))
+ {
+ sub_ddmmss (n1, n0, n1, n0, d1, d0);
+ most_significant_q_limb = 1;
+ }
+
+ for (i = qextra_limbs + nsize - 2 - 1; i >= 0; i--)
+ {
+ mp_limb_t q;
+ mp_limb_t r;
+
+ if (i >= qextra_limbs)
+ np--;
+ else
+ np[0] = 0;
+
+ if (n1 == d1)
+ {
+ /* Q should be either 111..111 or 111..110. Need special
+ treatment of this rare case as normal division would
+ give overflow. */
+ q = ~(mp_limb_t) 0;
+
+ r = n0 + d1;
+ if (r < d1) /* Carry in the addition? */
+ {
+ add_ssaaaa (n1, n0, r - d0, np[0], 0, d0);
+ qp[i] = q;
+ continue;
+ }
+ n1 = d0 - (d0 != 0);
+ n0 = -d0;
+ }
+ else
+ {
+ udiv_qrnnd (q, r, n1, n0, d1);
+ umul_ppmm (n1, n0, d0, q);
+ }
+
+ n2 = np[0];
+ q_test:
+ if (n1 > r || (n1 == r && n0 > n2))
+ {
+ /* The estimated Q was too large. */
+ q--;
+
+ sub_ddmmss (n1, n0, n1, n0, 0, d0);
+ r += d1;
+ if (r >= d1) /* If not carry, test Q again. */
+ goto q_test;
+ }
+
+ qp[i] = q;
+ sub_ddmmss (n1, n0, r, n2, n1, n0);
+ }
+ np[1] = n1;
+ np[0] = n0;
+ }
+ break;
+
+ default:
+ {
+ mp_size_t i;
+ mp_limb_t dX, d1, n0;
+
+ np += nsize - dsize;
+ dX = dp[dsize - 1];
+ d1 = dp[dsize - 2];
+ n0 = np[dsize - 1];
+
+ if (n0 >= dX)
+ {
+ if (n0 > dX || mpn_cmp (np, dp, dsize - 1) >= 0)
+ {
+ mpn_sub_n (np, np, dp, dsize);
+ n0 = np[dsize - 1];
+ most_significant_q_limb = 1;
+ }
+ }
+
+ for (i = qextra_limbs + nsize - dsize - 1; i >= 0; i--)
+ {
+ mp_limb_t q;
+ mp_limb_t n1, n2;
+ mp_limb_t cy_limb;
+
+ if (i >= qextra_limbs)
+ {
+ np--;
+ n2 = np[dsize];
+ }
+ else
+ {
+ n2 = np[dsize - 1];
+ MPN_COPY_DECR (np + 1, np, dsize);
+ np[0] = 0;
+ }
+
+ if (n0 == dX)
+ /* This might over-estimate q, but it's probably not worth
+ the extra code here to find out. */
+ q = ~(mp_limb_t) 0;
+ else
+ {
+ mp_limb_t r;
+
+ udiv_qrnnd (q, r, n0, np[dsize - 1], dX);
+ umul_ppmm (n1, n0, d1, q);
+
+ while (n1 > r || (n1 == r && n0 > np[dsize - 2]))
+ {
+ q--;
+ r += dX;
+ if (r < dX) /* I.e. "carry in previous addition?" */
+ break;
+ n1 -= n0 < d1;
+ n0 -= d1;
+ }
+ }
+
+ /* Possible optimization: We already have (q * n0) and (1 * n1)
+ after the calculation of q. Taking advantage of that, we
+ could make this loop make two iterations less. */
+
+ cy_limb = mpn_submul_1 (np, dp, dsize, q);
+
+ if (n2 != cy_limb)
+ {
+ mpn_add_n (np, np, dp, dsize);
+ q--;
+ }
+
+ qp[i] = q;
+ n0 = np[dsize - 1];
+ }
+ }
+ }
+
+ return most_significant_q_limb;
+}
--- /dev/null
+/* mpn_get_str -- Convert a MSIZE long limb vector pointed to by MPTR
+ to a printable string in STR in base BASE.
+
+Copyright (C) 1991, 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/* Convert the limb vector pointed to by MPTR and MSIZE long to a
+ char array, using base BASE for the result array. Store the
+ result in the character array STR. STR must point to an array with
+ space for the largest possible number represented by a MSIZE long
+ limb vector + 1 extra character.
+
+ The result is NOT in Ascii, to convert it to printable format, add
+ '0' or 'A' depending on the base and range.
+
+ Return the number of digits in the result string.
+ This may include some leading zeros.
+
+ The limb vector pointed to by MPTR is clobbered. */
+
+size_t
+mpn_get_str (str, base, mptr, msize)
+ unsigned char *str;
+ int base;
+ mp_ptr mptr;
+ mp_size_t msize;
+{
+ mp_limb_t big_base;
+#if UDIV_NEEDS_NORMALIZATION || UDIV_TIME > 2 * UMUL_TIME
+ int normalization_steps;
+#endif
+#if UDIV_TIME > 2 * UMUL_TIME
+ mp_limb_t big_base_inverted;
+#endif
+ unsigned int dig_per_u;
+ mp_size_t out_len;
+ register unsigned char *s;
+
+ big_base = __mp_bases[base].big_base;
+
+ s = str;
+
+ /* Special case zero, as the code below doesn't handle it. */
+ if (msize == 0)
+ {
+ s[0] = 0;
+ return 1;
+ }
+
+ if ((base & (base - 1)) == 0)
+ {
+ /* The base is a power of 2. Make conversion from most
+ significant side. */
+ mp_limb_t n1, n0;
+ register int bits_per_digit = big_base;
+ register int x;
+ register int bit_pos;
+ register int i;
+
+ n1 = mptr[msize - 1];
+ count_leading_zeros (x, n1);
+
+ /* BIT_POS should be R when input ends in least sign. nibble,
+ R + bits_per_digit * n when input ends in n:th least significant
+ nibble. */
+
+ {
+ int bits;
+
+ bits = BITS_PER_MP_LIMB * msize - x;
+ x = bits % bits_per_digit;
+ if (x != 0)
+ bits += bits_per_digit - x;
+ bit_pos = bits - (msize - 1) * BITS_PER_MP_LIMB;
+ }
+
+ /* Fast loop for bit output. */
+ i = msize - 1;
+ for (;;)
+ {
+ bit_pos -= bits_per_digit;
+ while (bit_pos >= 0)
+ {
+ *s++ = (n1 >> bit_pos) & ((1 << bits_per_digit) - 1);
+ bit_pos -= bits_per_digit;
+ }
+ i--;
+ if (i < 0)
+ break;
+ n0 = (n1 << -bit_pos) & ((1 << bits_per_digit) - 1);
+ n1 = mptr[i];
+ bit_pos += BITS_PER_MP_LIMB;
+ *s++ = n0 | (n1 >> bit_pos);
+ }
+
+ *s = 0;
+
+ return s - str;
+ }
+ else
+ {
+ /* General case. The base is not a power of 2. Make conversion
+ from least significant end. */
+
+ /* If udiv_qrnnd only handles divisors with the most significant bit
+ set, prepare BIG_BASE for being a divisor by shifting it to the
+ left exactly enough to set the most significant bit. */
+#if UDIV_NEEDS_NORMALIZATION || UDIV_TIME > 2 * UMUL_TIME
+ count_leading_zeros (normalization_steps, big_base);
+ big_base <<= normalization_steps;
+#if UDIV_TIME > 2 * UMUL_TIME
+ /* Get the fixed-point approximation to 1/(BIG_BASE << NORMALIZATION_STEPS). */
+ big_base_inverted = __mp_bases[base].big_base_inverted;
+#endif
+#endif
+
+ dig_per_u = __mp_bases[base].chars_per_limb;
+ out_len = ((size_t) msize * BITS_PER_MP_LIMB
+ * __mp_bases[base].chars_per_bit_exactly) + 1;
+ s += out_len;
+
+ while (msize != 0)
+ {
+ int i;
+ mp_limb_t n0, n1;
+
+#if UDIV_NEEDS_NORMALIZATION || UDIV_TIME > 2 * UMUL_TIME
+ /* If we shifted BIG_BASE above, shift the dividend too, to get
+ the right quotient. We need to do this every loop,
+ since the intermediate quotients are OK, but the quotient from
+ one turn in the loop is going to be the dividend in the
+ next turn, and the dividend needs to be up-shifted. */
+ if (normalization_steps != 0)
+ {
+ n0 = mpn_lshift (mptr, mptr, msize, normalization_steps);
+
+ /* If the shifting gave a carry out limb, store it and
+ increase the length. */
+ if (n0 != 0)
+ {
+ mptr[msize] = n0;
+ msize++;
+ }
+ }
+#endif
+
+ /* Divide the number at TP with BIG_BASE to get a quotient and a
+ remainder. The remainder is our new digit in base BIG_BASE. */
+ i = msize - 1;
+ n1 = mptr[i];
+
+ if (n1 >= big_base)
+ n1 = 0;
+ else
+ {
+ msize--;
+ i--;
+ }
+
+ for (; i >= 0; i--)
+ {
+ n0 = mptr[i];
+#if UDIV_TIME > 2 * UMUL_TIME
+ udiv_qrnnd_preinv (mptr[i], n1, n1, n0, big_base, big_base_inverted);
+#else
+ udiv_qrnnd (mptr[i], n1, n1, n0, big_base);
+#endif
+ }
+
+#if UDIV_NEEDS_NORMALIZATION || UDIV_TIME > 2 * UMUL_TIME
+ /* If we shifted above (at previous UDIV_NEEDS_NORMALIZATION tests)
+ the remainder will be up-shifted here. Compensate. */
+ n1 >>= normalization_steps;
+#endif
+
+ /* Convert N1 from BIG_BASE to a string of digits in BASE
+ using single precision operations. */
+ for (i = dig_per_u - 1; i >= 0; i--)
+ {
+ *--s = n1 % base;
+ n1 /= base;
+ if (n1 == 0 && msize == 0)
+ break;
+ }
+ }
+
+ while (s != str)
+ *--s = 0;
+ return out_len;
+ }
+}
--- /dev/null
+#include <config.h>
+#define _FORCE_INLINES
+#define _EXTERN_INLINE /* empty */
+#include "gmp.h"
--- /dev/null
+/* mpn_lshift -- Shift left low level.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/* Shift U (pointed to by UP and USIZE digits long) CNT bits to the left
+ and store the USIZE least significant digits of the result at WP.
+ Return the bits shifted out from the most significant digit.
+
+ Argument constraints:
+ 1. 0 < CNT < BITS_PER_MP_LIMB
+ 2. If the result is to be written over the input, WP must be >= UP.
+*/
+
+mp_limb_t
+#if __STDC__
+mpn_lshift (register mp_ptr wp,
+ register mp_srcptr up, mp_size_t usize,
+ register unsigned int cnt)
+#else
+mpn_lshift (wp, up, usize, cnt)
+ register mp_ptr wp;
+ register mp_srcptr up;
+ mp_size_t usize;
+ register unsigned int cnt;
+#endif
+{
+ register mp_limb_t high_limb, low_limb;
+ register unsigned sh_1, sh_2;
+ register mp_size_t i;
+ mp_limb_t retval;
+
+#ifdef DEBUG
+ if (usize == 0 || cnt == 0)
+ abort ();
+#endif
+
+ sh_1 = cnt;
+#if 0
+ if (sh_1 == 0)
+ {
+ if (wp != up)
+ {
+ /* Copy from high end to low end, to allow specified input/output
+ overlapping. */
+ for (i = usize - 1; i >= 0; i--)
+ wp[i] = up[i];
+ }
+ return 0;
+ }
+#endif
+
+ wp += 1;
+ sh_2 = BITS_PER_MP_LIMB - sh_1;
+ i = usize - 1;
+ low_limb = up[i];
+ retval = low_limb >> sh_2;
+ high_limb = low_limb;
+ while (--i >= 0)
+ {
+ low_limb = up[i];
+ wp[i] = (high_limb << sh_1) | (low_limb >> sh_2);
+ high_limb = low_limb;
+ }
+ wp[i] = high_limb << sh_1;
+
+ return retval;
+}
--- /dev/null
+/* __mp_bases -- Structure for conversion between internal binary
+ format and strings in base 2..255. The fields are explained in
+ gmp-impl.h.
+
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if BITS_PER_MP_LIMB == 32
+const struct bases __mp_bases[256] =
+{
+ /* 0 */ {0, 0.0, 0, 0},
+ /* 1 */ {0, 1e38, 0, 0},
+ /* 2 */ {32, 1.00000000, 0x1, 0x0},
+ /* 3 */ {20, 0.63092975, 0xcfd41b91, 0x3b563c24},
+ /* 4 */ {16, 0.50000000, 0x2, 0x0},
+ /* 5 */ {13, 0.43067656, 0x48c27395, 0xc25c2684},
+ /* 6 */ {12, 0.38685281, 0x81bf1000, 0xf91bd1b6},
+ /* 7 */ {11, 0.35620719, 0x75db9c97, 0x1607a2cb},
+ /* 8 */ {10, 0.33333333, 0x3, 0x0},
+ /* 9 */ {10, 0.31546488, 0xcfd41b91, 0x3b563c24},
+ /* 10 */ {9, 0.30103000, 0x3b9aca00, 0x12e0be82},
+ /* 11 */ {9, 0.28906483, 0x8c8b6d2b, 0xd24cde04},
+ /* 12 */ {8, 0.27894295, 0x19a10000, 0x3fa39ab5},
+ /* 13 */ {8, 0.27023815, 0x309f1021, 0x50f8ac5f},
+ /* 14 */ {8, 0.26264954, 0x57f6c100, 0x74843b1e},
+ /* 15 */ {8, 0.25595802, 0x98c29b81, 0xad0326c2},
+ /* 16 */ {8, 0.25000000, 0x4, 0x0},
+ /* 17 */ {7, 0.24465054, 0x18754571, 0x4ef0b6bd},
+ /* 18 */ {7, 0.23981247, 0x247dbc80, 0xc0fc48a1},
+ /* 19 */ {7, 0.23540891, 0x3547667b, 0x33838942},
+ /* 20 */ {7, 0.23137821, 0x4c4b4000, 0xad7f29ab},
+ /* 21 */ {7, 0.22767025, 0x6b5a6e1d, 0x313c3d15},
+ /* 22 */ {7, 0.22424382, 0x94ace180, 0xb8cca9e0},
+ /* 23 */ {7, 0.22106473, 0xcaf18367, 0x42ed6de9},
+ /* 24 */ {6, 0.21810429, 0xb640000, 0x67980e0b},
+ /* 25 */ {6, 0.21533828, 0xe8d4a51, 0x19799812},
+ /* 26 */ {6, 0.21274605, 0x1269ae40, 0xbce85396},
+ /* 27 */ {6, 0.21030992, 0x17179149, 0x62c103a9},
+ /* 28 */ {6, 0.20801460, 0x1cb91000, 0x1d353d43},
+ /* 29 */ {6, 0.20584683, 0x23744899, 0xce1decea},
+ /* 30 */ {6, 0.20379505, 0x2b73a840, 0x790fc511},
+ /* 31 */ {6, 0.20184909, 0x34e63b41, 0x35b865a0},
+ /* 32 */ {6, 0.20000000, 0x5, 0x0},
+ /* 33 */ {6, 0.19823986, 0x4cfa3cc1, 0xa9aed1b3},
+ /* 34 */ {6, 0.19656163, 0x5c13d840, 0x63dfc229},
+ /* 35 */ {6, 0.19495902, 0x6d91b519, 0x2b0fee30},
+ /* 36 */ {6, 0.19342640, 0x81bf1000, 0xf91bd1b6},
+ /* 37 */ {6, 0.19195872, 0x98ede0c9, 0xac89c3a9},
+ /* 38 */ {6, 0.19055141, 0xb3773e40, 0x6d2c32fe},
+ /* 39 */ {6, 0.18920036, 0xd1bbc4d1, 0x387907c9},
+ /* 40 */ {6, 0.18790182, 0xf4240000, 0xc6f7a0b},
+ /* 41 */ {5, 0.18665241, 0x6e7d349, 0x28928154},
+ /* 42 */ {5, 0.18544902, 0x7ca30a0, 0x6e8629d},
+ /* 43 */ {5, 0.18428883, 0x8c32bbb, 0xd373dca0},
+ /* 44 */ {5, 0.18316925, 0x9d46c00, 0xa0b17895},
+ /* 45 */ {5, 0.18208790, 0xaffacfd, 0x746811a5},
+ /* 46 */ {5, 0.18104260, 0xc46bee0, 0x4da6500f},
+ /* 47 */ {5, 0.18003133, 0xdab86ef, 0x2ba23582},
+ /* 48 */ {5, 0.17905223, 0xf300000, 0xdb20a88},
+ /* 49 */ {5, 0.17810359, 0x10d63af1, 0xe68d5ce4},
+ /* 50 */ {5, 0.17718382, 0x12a05f20, 0xb7cdfd9d},
+ /* 51 */ {5, 0.17629143, 0x1490aae3, 0x8e583933},
+ /* 52 */ {5, 0.17542506, 0x16a97400, 0x697cc3ea},
+ /* 53 */ {5, 0.17458343, 0x18ed2825, 0x48a5ca6c},
+ /* 54 */ {5, 0.17376534, 0x1b5e4d60, 0x2b52db16},
+ /* 55 */ {5, 0.17296969, 0x1dff8297, 0x111586a6},
+ /* 56 */ {5, 0.17219543, 0x20d38000, 0xf31d2b36},
+ /* 57 */ {5, 0.17144160, 0x23dd1799, 0xc8d76d19},
+ /* 58 */ {5, 0.17070728, 0x271f35a0, 0xa2cb1eb4},
+ /* 59 */ {5, 0.16999162, 0x2a9ce10b, 0x807c3ec3},
+ /* 60 */ {5, 0.16929381, 0x2e593c00, 0x617ec8bf},
+ /* 61 */ {5, 0.16861310, 0x3257844d, 0x45746cbe},
+ /* 62 */ {5, 0.16794878, 0x369b13e0, 0x2c0aa273},
+ /* 63 */ {5, 0.16730018, 0x3b27613f, 0x14f90805},
+ /* 64 */ {5, 0.16666667, 0x6, 0x0},
+ /* 65 */ {5, 0.16604765, 0x4528a141, 0xd9cf0829},
+ /* 66 */ {5, 0.16544255, 0x4aa51420, 0xb6fc4841},
+ /* 67 */ {5, 0.16485086, 0x50794633, 0x973054cb},
+ /* 68 */ {5, 0.16427205, 0x56a94400, 0x7a1dbe4b},
+ /* 69 */ {5, 0.16370566, 0x5d393975, 0x5f7fcd7f},
+ /* 70 */ {5, 0.16315122, 0x642d7260, 0x47196c84},
+ /* 71 */ {5, 0.16260831, 0x6b8a5ae7, 0x30b43635},
+ /* 72 */ {5, 0.16207652, 0x73548000, 0x1c1fa5f6},
+ /* 73 */ {5, 0.16155547, 0x7b908fe9, 0x930634a},
+ /* 74 */ {5, 0.16104477, 0x84435aa0, 0xef7f4a3c},
+ /* 75 */ {5, 0.16054409, 0x8d71d25b, 0xcf5552d2},
+ /* 76 */ {5, 0.16005307, 0x97210c00, 0xb1a47c8e},
+ /* 77 */ {5, 0.15957142, 0xa1563f9d, 0x9634b43e},
+ /* 78 */ {5, 0.15909881, 0xac16c8e0, 0x7cd3817d},
+ /* 79 */ {5, 0.15863496, 0xb768278f, 0x65536761},
+ /* 80 */ {5, 0.15817959, 0xc3500000, 0x4f8b588e},
+ /* 81 */ {5, 0.15773244, 0xcfd41b91, 0x3b563c24},
+ /* 82 */ {5, 0.15729325, 0xdcfa6920, 0x28928154},
+ /* 83 */ {5, 0.15686177, 0xeac8fd83, 0x1721bfb0},
+ /* 84 */ {5, 0.15643779, 0xf9461400, 0x6e8629d},
+ /* 85 */ {4, 0.15602107, 0x31c84b1, 0x491cc17c},
+ /* 86 */ {4, 0.15561139, 0x342ab10, 0x3a11d83b},
+ /* 87 */ {4, 0.15520856, 0x36a2c21, 0x2be074cd},
+ /* 88 */ {4, 0.15481238, 0x3931000, 0x1e7a02e7},
+ /* 89 */ {4, 0.15442266, 0x3bd5ee1, 0x11d10edd},
+ /* 90 */ {4, 0.15403922, 0x3e92110, 0x5d92c68},
+ /* 91 */ {4, 0.15366189, 0x4165ef1, 0xf50dbfb2},
+ /* 92 */ {4, 0.15329049, 0x4452100, 0xdf9f1316},
+ /* 93 */ {4, 0.15292487, 0x4756fd1, 0xcb52a684},
+ /* 94 */ {4, 0.15256487, 0x4a75410, 0xb8163e97},
+ /* 95 */ {4, 0.15221035, 0x4dad681, 0xa5d8f269},
+ /* 96 */ {4, 0.15186115, 0x5100000, 0x948b0fcd},
+ /* 97 */ {4, 0.15151715, 0x546d981, 0x841e0215},
+ /* 98 */ {4, 0.15117821, 0x57f6c10, 0x74843b1e},
+ /* 99 */ {4, 0.15084420, 0x5b9c0d1, 0x65b11e6e},
+ /* 100 */ {4, 0.15051500, 0x5f5e100, 0x5798ee23},
+ /* 101 */ {4, 0.15019048, 0x633d5f1, 0x4a30b99b},
+ /* 102 */ {4, 0.14987054, 0x673a910, 0x3d6e4d94},
+ /* 103 */ {4, 0.14955506, 0x6b563e1, 0x314825b0},
+ /* 104 */ {4, 0.14924394, 0x6f91000, 0x25b55f2e},
+ /* 105 */ {4, 0.14893706, 0x73eb721, 0x1aadaccb},
+ /* 106 */ {4, 0.14863434, 0x7866310, 0x10294ba2},
+ /* 107 */ {4, 0.14833567, 0x7d01db1, 0x620f8f6},
+ /* 108 */ {4, 0.14804096, 0x81bf100, 0xf91bd1b6},
+ /* 109 */ {4, 0.14775011, 0x869e711, 0xe6d37b2a},
+ /* 110 */ {4, 0.14746305, 0x8ba0a10, 0xd55cff6e},
+ /* 111 */ {4, 0.14717969, 0x90c6441, 0xc4ad2db2},
+ /* 112 */ {4, 0.14689994, 0x9610000, 0xb4b985cf},
+ /* 113 */ {4, 0.14662372, 0x9b7e7c1, 0xa5782bef},
+ /* 114 */ {4, 0.14635096, 0xa112610, 0x96dfdd2a},
+ /* 115 */ {4, 0.14608158, 0xa6cc591, 0x88e7e509},
+ /* 116 */ {4, 0.14581551, 0xacad100, 0x7b8813d3},
+ /* 117 */ {4, 0.14555268, 0xb2b5331, 0x6eb8b595},
+ /* 118 */ {4, 0.14529302, 0xb8e5710, 0x627289db},
+ /* 119 */ {4, 0.14503647, 0xbf3e7a1, 0x56aebc07},
+ /* 120 */ {4, 0.14478295, 0xc5c1000, 0x4b66dc33},
+ /* 121 */ {4, 0.14453241, 0xcc6db61, 0x4094d8a3},
+ /* 122 */ {4, 0.14428479, 0xd345510, 0x3632f7a5},
+ /* 123 */ {4, 0.14404003, 0xda48871, 0x2c3bd1f0},
+ /* 124 */ {4, 0.14379807, 0xe178100, 0x22aa4d5f},
+ /* 125 */ {4, 0.14355885, 0xe8d4a51, 0x19799812},
+ /* 126 */ {4, 0.14332233, 0xf05f010, 0x10a523e5},
+ /* 127 */ {4, 0.14308844, 0xf817e01, 0x828a237},
+ /* 128 */ {4, 0.14285714, 0x7, 0x0},
+ /* 129 */ {4, 0.14262838, 0x10818201, 0xf04ec452},
+ /* 130 */ {4, 0.14240211, 0x11061010, 0xe136444a},
+ /* 131 */ {4, 0.14217828, 0x118db651, 0xd2af9589},
+ /* 132 */ {4, 0.14195685, 0x12188100, 0xc4b42a83},
+ /* 133 */ {4, 0.14173777, 0x12a67c71, 0xb73dccf5},
+ /* 134 */ {4, 0.14152100, 0x1337b510, 0xaa4698c5},
+ /* 135 */ {4, 0.14130649, 0x13cc3761, 0x9dc8f729},
+ /* 136 */ {4, 0.14109421, 0x14641000, 0x91bf9a30},
+ /* 137 */ {4, 0.14088412, 0x14ff4ba1, 0x86257887},
+ /* 138 */ {4, 0.14067617, 0x159df710, 0x7af5c98c},
+ /* 139 */ {4, 0.14047033, 0x16401f31, 0x702c01a0},
+ /* 140 */ {4, 0.14026656, 0x16e5d100, 0x65c3ceb1},
+ /* 141 */ {4, 0.14006482, 0x178f1991, 0x5bb91502},
+ /* 142 */ {4, 0.13986509, 0x183c0610, 0x5207ec23},
+ /* 143 */ {4, 0.13966731, 0x18eca3c1, 0x48ac9c19},
+ /* 144 */ {4, 0.13947147, 0x19a10000, 0x3fa39ab5},
+ /* 145 */ {4, 0.13927753, 0x1a592841, 0x36e98912},
+ /* 146 */ {4, 0.13908545, 0x1b152a10, 0x2e7b3140},
+ /* 147 */ {4, 0.13889521, 0x1bd51311, 0x2655840b},
+ /* 148 */ {4, 0.13870677, 0x1c98f100, 0x1e7596ea},
+ /* 149 */ {4, 0.13852011, 0x1d60d1b1, 0x16d8a20d},
+ /* 150 */ {4, 0.13833519, 0x1e2cc310, 0xf7bfe87},
+ /* 151 */ {4, 0.13815199, 0x1efcd321, 0x85d2492},
+ /* 152 */ {4, 0.13797047, 0x1fd11000, 0x179a9f4},
+ /* 153 */ {4, 0.13779062, 0x20a987e1, 0xf59e80eb},
+ /* 154 */ {4, 0.13761241, 0x21864910, 0xe8b768db},
+ /* 155 */ {4, 0.13743580, 0x226761f1, 0xdc39d6d5},
+ /* 156 */ {4, 0.13726078, 0x234ce100, 0xd021c5d1},
+ /* 157 */ {4, 0.13708732, 0x2436d4d1, 0xc46b5e37},
+ /* 158 */ {4, 0.13691539, 0x25254c10, 0xb912f39c},
+ /* 159 */ {4, 0.13674498, 0x26185581, 0xae150294},
+ /* 160 */ {4, 0.13657605, 0x27100000, 0xa36e2eb1},
+ /* 161 */ {4, 0.13640859, 0x280c5a81, 0x991b4094},
+ /* 162 */ {4, 0.13624257, 0x290d7410, 0x8f19241e},
+ /* 163 */ {4, 0.13607797, 0x2a135bd1, 0x8564e6b7},
+ /* 164 */ {4, 0.13591477, 0x2b1e2100, 0x7bfbb5b4},
+ /* 165 */ {4, 0.13575295, 0x2c2dd2f1, 0x72dadcc8},
+ /* 166 */ {4, 0.13559250, 0x2d428110, 0x69ffc498},
+ /* 167 */ {4, 0.13543338, 0x2e5c3ae1, 0x6167f154},
+ /* 168 */ {4, 0.13527558, 0x2f7b1000, 0x5911016e},
+ /* 169 */ {4, 0.13511908, 0x309f1021, 0x50f8ac5f},
+ /* 170 */ {4, 0.13496386, 0x31c84b10, 0x491cc17c},
+ /* 171 */ {4, 0.13480991, 0x32f6d0b1, 0x417b26d8},
+ /* 172 */ {4, 0.13465720, 0x342ab100, 0x3a11d83b},
+ /* 173 */ {4, 0.13450572, 0x3563fc11, 0x32dee622},
+ /* 174 */ {4, 0.13435545, 0x36a2c210, 0x2be074cd},
+ /* 175 */ {4, 0.13420637, 0x37e71341, 0x2514bb58},
+ /* 176 */ {4, 0.13405847, 0x39310000, 0x1e7a02e7},
+ /* 177 */ {4, 0.13391173, 0x3a8098c1, 0x180ea5d0},
+ /* 178 */ {4, 0.13376614, 0x3bd5ee10, 0x11d10edd},
+ /* 179 */ {4, 0.13362168, 0x3d311091, 0xbbfb88e},
+ /* 180 */ {4, 0.13347832, 0x3e921100, 0x5d92c68},
+ /* 181 */ {4, 0.13333607, 0x3ff90031, 0x1c024c},
+ /* 182 */ {4, 0.13319491, 0x4165ef10, 0xf50dbfb2},
+ /* 183 */ {4, 0.13305481, 0x42d8eea1, 0xea30efa3},
+ /* 184 */ {4, 0.13291577, 0x44521000, 0xdf9f1316},
+ /* 185 */ {4, 0.13277777, 0x45d16461, 0xd555c0c9},
+ /* 186 */ {4, 0.13264079, 0x4756fd10, 0xcb52a684},
+ /* 187 */ {4, 0.13250483, 0x48e2eb71, 0xc193881f},
+ /* 188 */ {4, 0.13236988, 0x4a754100, 0xb8163e97},
+ /* 189 */ {4, 0.13223591, 0x4c0e0f51, 0xaed8b724},
+ /* 190 */ {4, 0.13210292, 0x4dad6810, 0xa5d8f269},
+ /* 191 */ {4, 0.13197089, 0x4f535d01, 0x9d15039d},
+ /* 192 */ {4, 0.13183981, 0x51000000, 0x948b0fcd},
+ /* 193 */ {4, 0.13170967, 0x52b36301, 0x8c394d1d},
+ /* 194 */ {4, 0.13158046, 0x546d9810, 0x841e0215},
+ /* 195 */ {4, 0.13145216, 0x562eb151, 0x7c3784f8},
+ /* 196 */ {4, 0.13132477, 0x57f6c100, 0x74843b1e},
+ /* 197 */ {4, 0.13119827, 0x59c5d971, 0x6d02985d},
+ /* 198 */ {4, 0.13107265, 0x5b9c0d10, 0x65b11e6e},
+ /* 199 */ {4, 0.13094791, 0x5d796e61, 0x5e8e5c64},
+ /* 200 */ {4, 0.13082402, 0x5f5e1000, 0x5798ee23},
+ /* 201 */ {4, 0.13070099, 0x614a04a1, 0x50cf7bde},
+ /* 202 */ {4, 0.13057879, 0x633d5f10, 0x4a30b99b},
+ /* 203 */ {4, 0.13045743, 0x65383231, 0x43bb66bd},
+ /* 204 */ {4, 0.13033688, 0x673a9100, 0x3d6e4d94},
+ /* 205 */ {4, 0.13021715, 0x69448e91, 0x374842ee},
+ /* 206 */ {4, 0.13009822, 0x6b563e10, 0x314825b0},
+ /* 207 */ {4, 0.12998007, 0x6d6fb2c1, 0x2b6cde75},
+ /* 208 */ {4, 0.12986271, 0x6f910000, 0x25b55f2e},
+ /* 209 */ {4, 0.12974613, 0x71ba3941, 0x2020a2c5},
+ /* 210 */ {4, 0.12963031, 0x73eb7210, 0x1aadaccb},
+ /* 211 */ {4, 0.12951524, 0x7624be11, 0x155b891f},
+ /* 212 */ {4, 0.12940092, 0x78663100, 0x10294ba2},
+ /* 213 */ {4, 0.12928734, 0x7aafdeb1, 0xb160fe9},
+ /* 214 */ {4, 0.12917448, 0x7d01db10, 0x620f8f6},
+ /* 215 */ {4, 0.12906235, 0x7f5c3a21, 0x14930ef},
+ /* 216 */ {4, 0.12895094, 0x81bf1000, 0xf91bd1b6},
+ /* 217 */ {4, 0.12884022, 0x842a70e1, 0xefdcb0c7},
+ /* 218 */ {4, 0.12873021, 0x869e7110, 0xe6d37b2a},
+ /* 219 */ {4, 0.12862089, 0x891b24f1, 0xddfeb94a},
+ /* 220 */ {4, 0.12851224, 0x8ba0a100, 0xd55cff6e},
+ /* 221 */ {4, 0.12840428, 0x8e2ef9d1, 0xcceced50},
+ /* 222 */ {4, 0.12829698, 0x90c64410, 0xc4ad2db2},
+ /* 223 */ {4, 0.12819034, 0x93669481, 0xbc9c75f9},
+ /* 224 */ {4, 0.12808435, 0x96100000, 0xb4b985cf},
+ /* 225 */ {4, 0.12797901, 0x98c29b81, 0xad0326c2},
+ /* 226 */ {4, 0.12787431, 0x9b7e7c10, 0xa5782bef},
+ /* 227 */ {4, 0.12777024, 0x9e43b6d1, 0x9e1771a9},
+ /* 228 */ {4, 0.12766680, 0xa1126100, 0x96dfdd2a},
+ /* 229 */ {4, 0.12756398, 0xa3ea8ff1, 0x8fd05c41},
+ /* 230 */ {4, 0.12746176, 0xa6cc5910, 0x88e7e509},
+ /* 231 */ {4, 0.12736016, 0xa9b7d1e1, 0x8225759d},
+ /* 232 */ {4, 0.12725915, 0xacad1000, 0x7b8813d3},
+ /* 233 */ {4, 0.12715874, 0xafac2921, 0x750eccf9},
+ /* 234 */ {4, 0.12705891, 0xb2b53310, 0x6eb8b595},
+ /* 235 */ {4, 0.12695967, 0xb5c843b1, 0x6884e923},
+ /* 236 */ {4, 0.12686100, 0xb8e57100, 0x627289db},
+ /* 237 */ {4, 0.12676290, 0xbc0cd111, 0x5c80c07b},
+ /* 238 */ {4, 0.12666537, 0xbf3e7a10, 0x56aebc07},
+ /* 239 */ {4, 0.12656839, 0xc27a8241, 0x50fbb19b},
+ /* 240 */ {4, 0.12647197, 0xc5c10000, 0x4b66dc33},
+ /* 241 */ {4, 0.12637609, 0xc91209c1, 0x45ef7c7c},
+ /* 242 */ {4, 0.12628075, 0xcc6db610, 0x4094d8a3},
+ /* 243 */ {4, 0.12618595, 0xcfd41b91, 0x3b563c24},
+ /* 244 */ {4, 0.12609168, 0xd3455100, 0x3632f7a5},
+ /* 245 */ {4, 0.12599794, 0xd6c16d31, 0x312a60c3},
+ /* 246 */ {4, 0.12590471, 0xda488710, 0x2c3bd1f0},
+ /* 247 */ {4, 0.12581200, 0xdddab5a1, 0x2766aa45},
+ /* 248 */ {4, 0.12571980, 0xe1781000, 0x22aa4d5f},
+ /* 249 */ {4, 0.12562811, 0xe520ad61, 0x1e06233c},
+ /* 250 */ {4, 0.12553692, 0xe8d4a510, 0x19799812},
+ /* 251 */ {4, 0.12544622, 0xec940e71, 0x15041c33},
+ /* 252 */ {4, 0.12535601, 0xf05f0100, 0x10a523e5},
+ /* 253 */ {4, 0.12526629, 0xf4359451, 0xc5c2749},
+ /* 254 */ {4, 0.12517705, 0xf817e010, 0x828a237},
+ /* 255 */ {4, 0.12508829, 0xfc05fc01, 0x40a1423},
+};
+#endif
+#if BITS_PER_MP_LIMB == 64
+const struct bases __mp_bases[256] =
+{
+ /* 0 */ {0, 0.0, 0, 0},
+ /* 1 */ {0, 1e38, 0, 0},
+ /* 2 */ {64, 1.00000000, 0x1, 0x0},
+ /* 3 */ {40, 0.63092975, 0xa8b8b452291fe821L, 0x846d550e37b5063dL},
+ /* 4 */ {32, 0.50000000, 0x2L, 0x0L},
+ /* 5 */ {27, 0.43067656, 0x6765c793fa10079dL, 0x3ce9a36f23c0fc90L},
+ /* 6 */ {24, 0.38685281, 0x41c21cb8e1000000L, 0xf24f62335024a295L},
+ /* 7 */ {22, 0.35620719, 0x3642798750226111L, 0x2df495ccaa57147bL},
+ /* 8 */ {21, 0.33333333, 0x3L, 0x0L},
+ /* 9 */ {20, 0.31546488, 0xa8b8b452291fe821L, 0x846d550e37b5063dL},
+ /* 10 */ {19, 0.30103000, 0x8ac7230489e80000L, 0xd83c94fb6d2ac34aL},
+ /* 11 */ {18, 0.28906483, 0x4d28cb56c33fa539L, 0xa8adf7ae45e7577bL},
+ /* 12 */ {17, 0.27894295, 0x1eca170c00000000L, 0xa10c2bec5da8f8fL},
+ /* 13 */ {17, 0.27023815, 0x780c7372621bd74dL, 0x10f4becafe412ec3L},
+ /* 14 */ {16, 0.26264954, 0x1e39a5057d810000L, 0xf08480f672b4e86L},
+ /* 15 */ {16, 0.25595802, 0x5b27ac993df97701L, 0x6779c7f90dc42f48L},
+ /* 16 */ {16, 0.25000000, 0x4L, 0x0L},
+ /* 17 */ {15, 0.24465054, 0x27b95e997e21d9f1L, 0x9c71e11bab279323L},
+ /* 18 */ {15, 0.23981247, 0x5da0e1e53c5c8000L, 0x5dfaa697ec6f6a1cL},
+ /* 19 */ {15, 0.23540891, 0xd2ae3299c1c4aedbL, 0x3711783f6be7e9ecL},
+ /* 20 */ {14, 0.23137821, 0x16bcc41e90000000L, 0x6849b86a12b9b01eL},
+ /* 21 */ {14, 0.22767025, 0x2d04b7fdd9c0ef49L, 0x6bf097ba5ca5e239L},
+ /* 22 */ {14, 0.22424382, 0x5658597bcaa24000L, 0x7b8015c8d7af8f08L},
+ /* 23 */ {14, 0.22106473, 0xa0e2073737609371L, 0x975a24b3a3151b38L},
+ /* 24 */ {13, 0.21810429, 0xc29e98000000000L, 0x50bd367972689db1L},
+ /* 25 */ {13, 0.21533828, 0x14adf4b7320334b9L, 0x8c240c4aecb13bb5L},
+ /* 26 */ {13, 0.21274605, 0x226ed36478bfa000L, 0xdbd2e56854e118c9L},
+ /* 27 */ {13, 0.21030992, 0x383d9170b85ff80bL, 0x2351ffcaa9c7c4aeL},
+ /* 28 */ {13, 0.20801460, 0x5a3c23e39c000000L, 0x6b24188ca33b0636L},
+ /* 29 */ {13, 0.20584683, 0x8e65137388122bcdL, 0xcc3dceaf2b8ba99dL},
+ /* 30 */ {13, 0.20379505, 0xdd41bb36d259e000L, 0x2832e835c6c7d6b6L},
+ /* 31 */ {12, 0.20184909, 0xaee5720ee830681L, 0x76b6aa272e1873c5L},
+ /* 32 */ {12, 0.20000000, 0x5L, 0x0L},
+ /* 33 */ {12, 0.19823986, 0x172588ad4f5f0981L, 0x61eaf5d402c7bf4fL},
+ /* 34 */ {12, 0.19656163, 0x211e44f7d02c1000L, 0xeeb658123ffb27ecL},
+ /* 35 */ {12, 0.19495902, 0x2ee56725f06e5c71L, 0x5d5e3762e6fdf509L},
+ /* 36 */ {12, 0.19342640, 0x41c21cb8e1000000L, 0xf24f62335024a295L},
+ /* 37 */ {12, 0.19195872, 0x5b5b57f8a98a5dd1L, 0x66ae7831762efb6fL},
+ /* 38 */ {12, 0.19055141, 0x7dcff8986ea31000L, 0x47388865a00f544L},
+ /* 39 */ {12, 0.18920036, 0xabd4211662a6b2a1L, 0x7d673c33a123b54cL},
+ /* 40 */ {12, 0.18790182, 0xe8d4a51000000000L, 0x19799812dea11197L},
+ /* 41 */ {11, 0.18665241, 0x7a32956ad081b79L, 0xc27e62e0686feaeL},
+ /* 42 */ {11, 0.18544902, 0x9f49aaff0e86800L, 0x9b6e7507064ce7c7L},
+ /* 43 */ {11, 0.18428883, 0xce583bb812d37b3L, 0x3d9ac2bf66cfed94L},
+ /* 44 */ {11, 0.18316925, 0x109b79a654c00000L, 0xed46bc50ce59712aL},
+ /* 45 */ {11, 0.18208790, 0x1543beff214c8b95L, 0x813d97e2c89b8d46L},
+ /* 46 */ {11, 0.18104260, 0x1b149a79459a3800L, 0x2e81751956af8083L},
+ /* 47 */ {11, 0.18003133, 0x224edfb5434a830fL, 0xdd8e0a95e30c0988L},
+ /* 48 */ {11, 0.17905223, 0x2b3fb00000000000L, 0x7ad4dd48a0b5b167L},
+ /* 49 */ {11, 0.17810359, 0x3642798750226111L, 0x2df495ccaa57147bL},
+ /* 50 */ {11, 0.17718382, 0x43c33c1937564800L, 0xe392010175ee5962L},
+ /* 51 */ {11, 0.17629143, 0x54411b2441c3cd8bL, 0x84eaf11b2fe7738eL},
+ /* 52 */ {11, 0.17542506, 0x6851455acd400000L, 0x3a1e3971e008995dL},
+ /* 53 */ {11, 0.17458343, 0x80a23b117c8feb6dL, 0xfd7a462344ffce25L},
+ /* 54 */ {11, 0.17376534, 0x9dff7d32d5dc1800L, 0x9eca40b40ebcef8aL},
+ /* 55 */ {11, 0.17296969, 0xc155af6faeffe6a7L, 0x52fa161a4a48e43dL},
+ /* 56 */ {11, 0.17219543, 0xebb7392e00000000L, 0x1607a2cbacf930c1L},
+ /* 57 */ {10, 0.17144160, 0x50633659656d971L, 0x97a014f8e3be55f1L},
+ /* 58 */ {10, 0.17070728, 0x5fa8624c7fba400L, 0x568df8b76cbf212cL},
+ /* 59 */ {10, 0.16999162, 0x717d9faa73c5679L, 0x20ba7c4b4e6ef492L},
+ /* 60 */ {10, 0.16929381, 0x86430aac6100000L, 0xe81ee46b9ef492f5L},
+ /* 61 */ {10, 0.16861310, 0x9e64d9944b57f29L, 0x9dc0d10d51940416L},
+ /* 62 */ {10, 0.16794878, 0xba5ca5392cb0400L, 0x5fa8ed2f450272a5L},
+ /* 63 */ {10, 0.16730018, 0xdab2ce1d022cd81L, 0x2ba9eb8c5e04e641L},
+ /* 64 */ {10, 0.16666667, 0x6L, 0x0L},
+ /* 65 */ {10, 0.16604765, 0x12aeed5fd3e2d281L, 0xb67759cc00287bf1L},
+ /* 66 */ {10, 0.16544255, 0x15c3da1572d50400L, 0x78621feeb7f4ed33L},
+ /* 67 */ {10, 0.16485086, 0x194c05534f75ee29L, 0x43d55b5f72943bc0L},
+ /* 68 */ {10, 0.16427205, 0x1d56299ada100000L, 0x173decb64d1d4409L},
+ /* 69 */ {10, 0.16370566, 0x21f2a089a4ff4f79L, 0xe29fb54fd6b6074fL},
+ /* 70 */ {10, 0.16315122, 0x2733896c68d9a400L, 0xa1f1f5c210d54e62L},
+ /* 71 */ {10, 0.16260831, 0x2d2cf2c33b533c71L, 0x6aac7f9bfafd57b2L},
+ /* 72 */ {10, 0.16207652, 0x33f506e440000000L, 0x3b563c2478b72ee2L},
+ /* 73 */ {10, 0.16155547, 0x3ba43bec1d062211L, 0x12b536b574e92d1bL},
+ /* 74 */ {10, 0.16104477, 0x4455872d8fd4e400L, 0xdf86c03020404fa5L},
+ /* 75 */ {10, 0.16054409, 0x4e2694539f2f6c59L, 0xa34adf02234eea8eL},
+ /* 76 */ {10, 0.16005307, 0x5938006c18900000L, 0x6f46eb8574eb59ddL},
+ /* 77 */ {10, 0.15957142, 0x65ad9912474aa649L, 0x42459b481df47cecL},
+ /* 78 */ {10, 0.15909881, 0x73ae9ff4241ec400L, 0x1b424b95d80ca505L},
+ /* 79 */ {10, 0.15863496, 0x836612ee9c4ce1e1L, 0xf2c1b982203a0dacL},
+ /* 80 */ {10, 0.15817959, 0x9502f90000000000L, 0xb7cdfd9d7bdbab7dL},
+ /* 81 */ {10, 0.15773244, 0xa8b8b452291fe821L, 0x846d550e37b5063dL},
+ /* 82 */ {10, 0.15729325, 0xbebf59a07dab4400L, 0x57931eeaf85cf64fL},
+ /* 83 */ {10, 0.15686177, 0xd7540d4093bc3109L, 0x305a944507c82f47L},
+ /* 84 */ {10, 0.15643779, 0xf2b96616f1900000L, 0xe007ccc9c22781aL},
+ /* 85 */ {9, 0.15602107, 0x336de62af2bca35L, 0x3e92c42e000eeed4L},
+ /* 86 */ {9, 0.15561139, 0x39235ec33d49600L, 0x1ebe59130db2795eL},
+ /* 87 */ {9, 0.15520856, 0x3f674e539585a17L, 0x268859e90f51b89L},
+ /* 88 */ {9, 0.15481238, 0x4645b6958000000L, 0xd24cde0463108cfaL},
+ /* 89 */ {9, 0.15442266, 0x4dcb74afbc49c19L, 0xa536009f37adc383L},
+ /* 90 */ {9, 0.15403922, 0x56064e1d18d9a00L, 0x7cea06ce1c9ace10L},
+ /* 91 */ {9, 0.15366189, 0x5f04fe2cd8a39fbL, 0x58db032e72e8ba43L},
+ /* 92 */ {9, 0.15329049, 0x68d74421f5c0000L, 0x388cc17cae105447L},
+ /* 93 */ {9, 0.15292487, 0x738df1f6ab4827dL, 0x1b92672857620ce0L},
+ /* 94 */ {9, 0.15256487, 0x7f3afbc9cfb5e00L, 0x18c6a9575c2ade4L},
+ /* 95 */ {9, 0.15221035, 0x8bf187fba88f35fL, 0xd44da7da8e44b24fL},
+ /* 96 */ {9, 0.15186115, 0x99c600000000000L, 0xaa2f78f1b4cc6794L},
+ /* 97 */ {9, 0.15151715, 0xa8ce21eb6531361L, 0x843c067d091ee4ccL},
+ /* 98 */ {9, 0.15117821, 0xb92112c1a0b6200L, 0x62005e1e913356e3L},
+ /* 99 */ {9, 0.15084420, 0xcad7718b8747c43L, 0x4316eed01dedd518L},
+ /* 100 */ {9, 0.15051500, 0xde0b6b3a7640000L, 0x2725dd1d243aba0eL},
+ /* 101 */ {9, 0.15019048, 0xf2d8cf5fe6d74c5L, 0xddd9057c24cb54fL},
+ /* 102 */ {9, 0.14987054, 0x1095d25bfa712600L, 0xedeee175a736d2a1L},
+ /* 103 */ {9, 0.14955506, 0x121b7c4c3698faa7L, 0xc4699f3df8b6b328L},
+ /* 104 */ {9, 0.14924394, 0x13c09e8d68000000L, 0x9ebbe7d859cb5a7cL},
+ /* 105 */ {9, 0.14893706, 0x15876ccb0b709ca9L, 0x7c828b9887eb2179L},
+ /* 106 */ {9, 0.14863434, 0x17723c2976da2a00L, 0x5d652ab99001adcfL},
+ /* 107 */ {9, 0.14833567, 0x198384e9c259048bL, 0x4114f1754e5d7b32L},
+ /* 108 */ {9, 0.14804096, 0x1bbde41dfeec0000L, 0x274b7c902f7e0188L},
+ /* 109 */ {9, 0.14775011, 0x1e241d6e3337910dL, 0xfc9e0fbb32e210cL},
+ /* 110 */ {9, 0.14746305, 0x20b91cee9901ee00L, 0xf4afa3e594f8ea1fL},
+ /* 111 */ {9, 0.14717969, 0x237ff9079863dfefL, 0xcd85c32e9e4437b0L},
+ /* 112 */ {9, 0.14689994, 0x267bf47000000000L, 0xa9bbb147e0dd92a8L},
+ /* 113 */ {9, 0.14662372, 0x29b08039fbeda7f1L, 0x8900447b70e8eb82L},
+ /* 114 */ {9, 0.14635096, 0x2d213df34f65f200L, 0x6b0a92adaad5848aL},
+ /* 115 */ {9, 0.14608158, 0x30d201d957a7c2d3L, 0x4f990ad8740f0ee5L},
+ /* 116 */ {9, 0.14581551, 0x34c6d52160f40000L, 0x3670a9663a8d3610L},
+ /* 117 */ {9, 0.14555268, 0x3903f855d8f4c755L, 0x1f5c44188057be3cL},
+ /* 118 */ {9, 0.14529302, 0x3d8de5c8ec59b600L, 0xa2bea956c4e4977L},
+ /* 119 */ {9, 0.14503647, 0x4269541d1ff01337L, 0xed68b23033c3637eL},
+ /* 120 */ {9, 0.14478295, 0x479b38e478000000L, 0xc99cf624e50549c5L},
+ /* 121 */ {9, 0.14453241, 0x4d28cb56c33fa539L, 0xa8adf7ae45e7577bL},
+ /* 122 */ {9, 0.14428479, 0x5317871fa13aba00L, 0x8a5bc740b1c113e5L},
+ /* 123 */ {9, 0.14404003, 0x596d2f44de9fa71bL, 0x6e6c7efb81cfbb9bL},
+ /* 124 */ {9, 0.14379807, 0x602fd125c47c0000L, 0x54aba5c5cada5f10L},
+ /* 125 */ {9, 0.14355885, 0x6765c793fa10079dL, 0x3ce9a36f23c0fc90L},
+ /* 126 */ {9, 0.14332233, 0x6f15be069b847e00L, 0x26fb43de2c8cd2a8L},
+ /* 127 */ {9, 0.14308844, 0x7746b3e82a77047fL, 0x12b94793db8486a1L},
+ /* 128 */ {9, 0.14285714, 0x7L, 0x0L},
+ /* 129 */ {9, 0.14262838, 0x894953f7ea890481L, 0xdd5deca404c0156dL},
+ /* 130 */ {9, 0.14240211, 0x932abffea4848200L, 0xbd51373330291de0L},
+ /* 131 */ {9, 0.14217828, 0x9dacb687d3d6a163L, 0x9fa4025d66f23085L},
+ /* 132 */ {9, 0.14195685, 0xa8d8102a44840000L, 0x842530ee2db4949dL},
+ /* 133 */ {9, 0.14173777, 0xb4b60f9d140541e5L, 0x6aa7f2766b03dc25L},
+ /* 134 */ {9, 0.14152100, 0xc15065d4856e4600L, 0x53035ba7ebf32e8dL},
+ /* 135 */ {9, 0.14130649, 0xceb1363f396d23c7L, 0x3d12091fc9fb4914L},
+ /* 136 */ {9, 0.14109421, 0xdce31b2488000000L, 0x28b1cb81b1ef1849L},
+ /* 137 */ {9, 0.14088412, 0xebf12a24bca135c9L, 0x15c35be67ae3e2c9L},
+ /* 138 */ {9, 0.14067617, 0xfbe6f8dbf88f4a00L, 0x42a17bd09be1ff0L},
+ /* 139 */ {8, 0.14047033, 0x1ef156c084ce761L, 0x8bf461f03cf0bbfL},
+ /* 140 */ {8, 0.14026656, 0x20c4e3b94a10000L, 0xf3fbb43f68a32d05L},
+ /* 141 */ {8, 0.14006482, 0x22b0695a08ba421L, 0xd84f44c48564dc19L},
+ /* 142 */ {8, 0.13986509, 0x24b4f35d7a4c100L, 0xbe58ebcce7956abeL},
+ /* 143 */ {8, 0.13966731, 0x26d397284975781L, 0xa5fac463c7c134b7L},
+ /* 144 */ {8, 0.13947147, 0x290d74100000000L, 0x8f19241e28c7d757L},
+ /* 145 */ {8, 0.13927753, 0x2b63b3a37866081L, 0x799a6d046c0ae1aeL},
+ /* 146 */ {8, 0.13908545, 0x2dd789f4d894100L, 0x6566e37d746a9e40L},
+ /* 147 */ {8, 0.13889521, 0x306a35e51b58721L, 0x526887dbfb5f788fL},
+ /* 148 */ {8, 0.13870677, 0x331d01712e10000L, 0x408af3382b8efd3dL},
+ /* 149 */ {8, 0.13852011, 0x35f14200a827c61L, 0x2fbb374806ec05f1L},
+ /* 150 */ {8, 0.13833519, 0x38e858b62216100L, 0x1fe7c0f0afce87feL},
+ /* 151 */ {8, 0.13815199, 0x3c03b2c13176a41L, 0x11003d517540d32eL},
+ /* 152 */ {8, 0.13797047, 0x3f44c9b21000000L, 0x2f5810f98eff0dcL},
+ /* 153 */ {8, 0.13779062, 0x42ad23cef3113c1L, 0xeb72e35e7840d910L},
+ /* 154 */ {8, 0.13761241, 0x463e546b19a2100L, 0xd27de19593dc3614L},
+ /* 155 */ {8, 0.13743580, 0x49f9fc3f96684e1L, 0xbaf391fd3e5e6fc2L},
+ /* 156 */ {8, 0.13726078, 0x4de1c9c5dc10000L, 0xa4bd38c55228c81dL},
+ /* 157 */ {8, 0.13708732, 0x51f77994116d2a1L, 0x8fc5a8de8e1de782L},
+ /* 158 */ {8, 0.13691539, 0x563cd6bb3398100L, 0x7bf9265bea9d3a3bL},
+ /* 159 */ {8, 0.13674498, 0x5ab3bb270beeb01L, 0x69454b325983dccdL},
+ /* 160 */ {8, 0.13657605, 0x5f5e10000000000L, 0x5798ee2308c39df9L},
+ /* 161 */ {8, 0.13640859, 0x643dce0ec16f501L, 0x46e40ba0fa66a753L},
+ /* 162 */ {8, 0.13624257, 0x6954fe21e3e8100L, 0x3717b0870b0db3a7L},
+ /* 163 */ {8, 0.13607797, 0x6ea5b9755f440a1L, 0x2825e6775d11cdebL},
+ /* 164 */ {8, 0.13591477, 0x74322a1c0410000L, 0x1a01a1c09d1b4dacL},
+ /* 165 */ {8, 0.13575295, 0x79fc8b6ae8a46e1L, 0xc9eb0a8bebc8f3eL},
+ /* 166 */ {8, 0.13559250, 0x80072a66d512100L, 0xffe357ff59e6a004L},
+ /* 167 */ {8, 0.13543338, 0x86546633b42b9c1L, 0xe7dfd1be05fa61a8L},
+ /* 168 */ {8, 0.13527558, 0x8ce6b0861000000L, 0xd11ed6fc78f760e5L},
+ /* 169 */ {8, 0.13511908, 0x93c08e16a022441L, 0xbb8db609dd29ebfeL},
+ /* 170 */ {8, 0.13496386, 0x9ae49717f026100L, 0xa71aec8d1813d532L},
+ /* 171 */ {8, 0.13480991, 0xa25577ae24c1a61L, 0x93b612a9f20fbc02L},
+ /* 172 */ {8, 0.13465720, 0xaa15f068e610000L, 0x814fc7b19a67d317L},
+ /* 173 */ {8, 0.13450572, 0xb228d6bf7577921L, 0x6fd9a03f2e0a4b7cL},
+ /* 174 */ {8, 0.13435545, 0xba91158ef5c4100L, 0x5f4615a38d0d316eL},
+ /* 175 */ {8, 0.13420637, 0xc351ad9aec0b681L, 0x4f8876863479a286L},
+ /* 176 */ {8, 0.13405847, 0xcc6db6100000000L, 0x4094d8a3041b60ebL},
+ /* 177 */ {8, 0.13391173, 0xd5e85d09025c181L, 0x32600b8ed883a09bL},
+ /* 178 */ {8, 0.13376614, 0xdfc4e816401c100L, 0x24df8c6eb4b6d1f1L},
+ /* 179 */ {8, 0.13362168, 0xea06b4c72947221L, 0x18097a8ee151acefL},
+ /* 180 */ {8, 0.13347832, 0xf4b139365210000L, 0xbd48cc8ec1cd8e3L},
+ /* 181 */ {8, 0.13333607, 0xffc80497d520961L, 0x3807a8d67485fbL},
+ /* 182 */ {8, 0.13319491, 0x10b4ebfca1dee100L, 0xea5768860b62e8d8L},
+ /* 183 */ {8, 0.13305481, 0x117492de921fc141L, 0xd54faf5b635c5005L},
+ /* 184 */ {8, 0.13291577, 0x123bb2ce41000000L, 0xc14a56233a377926L},
+ /* 185 */ {8, 0.13277777, 0x130a8b6157bdecc1L, 0xae39a88db7cd329fL},
+ /* 186 */ {8, 0.13264079, 0x13e15dede0e8a100L, 0x9c10bde69efa7ab6L},
+ /* 187 */ {8, 0.13250483, 0x14c06d941c0ca7e1L, 0x8ac36c42a2836497L},
+ /* 188 */ {8, 0.13236988, 0x15a7ff487a810000L, 0x7a463c8b84f5ef67L},
+ /* 189 */ {8, 0.13223591, 0x169859ddc5c697a1L, 0x6a8e5f5ad090fd4bL},
+ /* 190 */ {8, 0.13210292, 0x1791c60f6fed0100L, 0x5b91a2943596fc56L},
+ /* 191 */ {8, 0.13197089, 0x18948e8c0e6fba01L, 0x4d4667b1c468e8f0L},
+ /* 192 */ {8, 0.13183981, 0x19a1000000000000L, 0x3fa39ab547994dafL},
+ /* 193 */ {8, 0.13170967, 0x1ab769203dafc601L, 0x32a0a9b2faee1e2aL},
+ /* 194 */ {8, 0.13158046, 0x1bd81ab557f30100L, 0x26357ceac0e96962L},
+ /* 195 */ {8, 0.13145216, 0x1d0367a69fed1ba1L, 0x1a5a6f65caa5859eL},
+ /* 196 */ {8, 0.13132477, 0x1e39a5057d810000L, 0xf08480f672b4e86L},
+ /* 197 */ {8, 0.13119827, 0x1f7b2a18f29ac3e1L, 0x4383340615612caL},
+ /* 198 */ {8, 0.13107265, 0x20c850694c2aa100L, 0xf3c77969ee4be5a2L},
+ /* 199 */ {8, 0.13094791, 0x222173cc014980c1L, 0xe00993cc187c5ec9L},
+ /* 200 */ {8, 0.13082402, 0x2386f26fc1000000L, 0xcd2b297d889bc2b6L},
+ /* 201 */ {8, 0.13070099, 0x24f92ce8af296d41L, 0xbb214d5064862b22L},
+ /* 202 */ {8, 0.13057879, 0x2678863cd0ece100L, 0xa9e1a7ca7ea10e20L},
+ /* 203 */ {8, 0.13045743, 0x280563f0a9472d61L, 0x99626e72b39ea0cfL},
+ /* 204 */ {8, 0.13033688, 0x29a02e1406210000L, 0x899a5ba9c13fafd9L},
+ /* 205 */ {8, 0.13021715, 0x2b494f4efe6d2e21L, 0x7a80a705391e96ffL},
+ /* 206 */ {8, 0.13009822, 0x2d0134ef21cbc100L, 0x6c0cfe23de23042aL},
+ /* 207 */ {8, 0.12998007, 0x2ec84ef4da2ef581L, 0x5e377df359c944ddL},
+ /* 208 */ {8, 0.12986271, 0x309f102100000000L, 0x50f8ac5fc8f53985L},
+ /* 209 */ {8, 0.12974613, 0x3285ee02a1420281L, 0x44497266278e35b7L},
+ /* 210 */ {8, 0.12963031, 0x347d6104fc324100L, 0x382316831f7ee175L},
+ /* 211 */ {8, 0.12951524, 0x3685e47dade53d21L, 0x2c7f377833b8946eL},
+ /* 212 */ {8, 0.12940092, 0x389ff6bb15610000L, 0x2157c761ab4163efL},
+ /* 213 */ {8, 0.12928734, 0x3acc1912ebb57661L, 0x16a7071803cc49a9L},
+ /* 214 */ {8, 0.12917448, 0x3d0acff111946100L, 0xc6781d80f8224fcL},
+ /* 215 */ {8, 0.12906235, 0x3f5ca2e692eaf841L, 0x294092d370a900bL},
+ /* 216 */ {8, 0.12895094, 0x41c21cb8e1000000L, 0xf24f62335024a295L},
+ /* 217 */ {8, 0.12884022, 0x443bcb714399a5c1L, 0xe03b98f103fad6d2L},
+ /* 218 */ {8, 0.12873021, 0x46ca406c81af2100L, 0xcee3d32cad2a9049L},
+ /* 219 */ {8, 0.12862089, 0x496e106ac22aaae1L, 0xbe3f9df9277fdadaL},
+ /* 220 */ {8, 0.12851224, 0x4c27d39fa5410000L, 0xae46f0d94c05e933L},
+ /* 221 */ {8, 0.12840428, 0x4ef825c296e43ca1L, 0x9ef2280fb437a33dL},
+ /* 222 */ {8, 0.12829698, 0x51dfa61f5ad88100L, 0x9039ff426d3f284bL},
+ /* 223 */ {8, 0.12819034, 0x54def7a6d2f16901L, 0x82178c6d6b51f8f4L},
+ /* 224 */ {8, 0.12808435, 0x57f6c10000000000L, 0x74843b1ee4c1e053L},
+ /* 225 */ {8, 0.12797901, 0x5b27ac993df97701L, 0x6779c7f90dc42f48L},
+ /* 226 */ {8, 0.12787431, 0x5e7268b9bbdf8100L, 0x5af23c74f9ad9fe9L},
+ /* 227 */ {8, 0.12777024, 0x61d7a7932ff3d6a1L, 0x4ee7eae2acdc617eL},
+ /* 228 */ {8, 0.12766680, 0x65581f53c8c10000L, 0x43556aa2ac262a0bL},
+ /* 229 */ {8, 0.12756398, 0x68f48a385b8320e1L, 0x3835949593b8ddd1L},
+ /* 230 */ {8, 0.12746176, 0x6cada69ed07c2100L, 0x2d837fbe78458762L},
+ /* 231 */ {8, 0.12736016, 0x70843718cdbf27c1L, 0x233a7e150a54a555L},
+ /* 232 */ {8, 0.12725915, 0x7479027ea1000000L, 0x19561984a50ff8feL},
+ /* 233 */ {8, 0.12715874, 0x788cd40268f39641L, 0xfd211159fe3490fL},
+ /* 234 */ {8, 0.12705891, 0x7cc07b437ecf6100L, 0x6aa563e655033e3L},
+ /* 235 */ {8, 0.12695967, 0x8114cc6220762061L, 0xfbb614b3f2d3b14cL},
+ /* 236 */ {8, 0.12686100, 0x858aa0135be10000L, 0xeac0f8837fb05773L},
+ /* 237 */ {8, 0.12676290, 0x8a22d3b53c54c321L, 0xda6e4c10e8615ca5L},
+ /* 238 */ {8, 0.12666537, 0x8ede496339f34100L, 0xcab755a8d01fa67fL},
+ /* 239 */ {8, 0.12656839, 0x93bde80aec3a1481L, 0xbb95a9ae71aa3e0cL},
+ /* 240 */ {8, 0.12647197, 0x98c29b8100000000L, 0xad0326c296b4f529L},
+ /* 241 */ {8, 0.12637609, 0x9ded549671832381L, 0x9ef9f21eed31b7c1L},
+ /* 242 */ {8, 0.12628075, 0xa33f092e0b1ac100L, 0x91747422be14b0b2L},
+ /* 243 */ {8, 0.12618595, 0xa8b8b452291fe821L, 0x846d550e37b5063dL},
+ /* 244 */ {8, 0.12609168, 0xae5b564ac3a10000L, 0x77df79e9a96c06f6L},
+ /* 245 */ {8, 0.12599794, 0xb427f4b3be74c361L, 0x6bc6019636c7d0c2L},
+ /* 246 */ {8, 0.12590471, 0xba1f9a938041e100L, 0x601c4205aebd9e47L},
+ /* 247 */ {8, 0.12581200, 0xc0435871d1110f41L, 0x54ddc59756f05016L},
+ /* 248 */ {8, 0.12571980, 0xc694446f01000000L, 0x4a0648979c838c18L},
+ /* 249 */ {8, 0.12562811, 0xcd137a5b57ac3ec1L, 0x3f91b6e0bb3a053dL},
+ /* 250 */ {8, 0.12553692, 0xd3c21bcecceda100L, 0x357c299a88ea76a5L},
+ /* 251 */ {8, 0.12544622, 0xdaa150410b788de1L, 0x2bc1e517aecc56e3L},
+ /* 252 */ {8, 0.12535601, 0xe1b24521be010000L, 0x225f56ceb3da9f5dL},
+ /* 253 */ {8, 0.12526629, 0xe8f62df12777c1a1L, 0x1951136d53ad63acL},
+ /* 254 */ {8, 0.12517705, 0xf06e445906fc0100L, 0x1093d504b3cd7d93L},
+ /* 255 */ {8, 0.12508829, 0xf81bc845c81bf801L, 0x824794d1ec1814fL},
+};
+#endif
--- /dev/null
+/* mpn_mul -- Multiply two natural numbers.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/* Multiply the natural numbers u (pointed to by UP, with USIZE limbs)
+ and v (pointed to by VP, with VSIZE limbs), and store the result at
+ PRODP. USIZE + VSIZE limbs are always stored, but if the input
+ operands are normalized. Return the most significant limb of the
+ result.
+
+ NOTE: The space pointed to by PRODP is overwritten before finished
+ with U and V, so overlap is an error.
+
+ Argument constraints:
+ 1. USIZE >= VSIZE.
+ 2. PRODP != UP and PRODP != VP, i.e. the destination
+ must be distinct from the multiplier and the multiplicand. */
+
+/* If KARATSUBA_THRESHOLD is not already defined, define it to a
+ value which is good on most machines. */
+#ifndef KARATSUBA_THRESHOLD
+#define KARATSUBA_THRESHOLD 32
+#endif
+
+mp_limb_t
+#if __STDC__
+mpn_mul (mp_ptr prodp,
+ mp_srcptr up, mp_size_t usize,
+ mp_srcptr vp, mp_size_t vsize)
+#else
+mpn_mul (prodp, up, usize, vp, vsize)
+ mp_ptr prodp;
+ mp_srcptr up;
+ mp_size_t usize;
+ mp_srcptr vp;
+ mp_size_t vsize;
+#endif
+{
+ mp_ptr prod_endp = prodp + usize + vsize - 1;
+ mp_limb_t cy;
+ mp_ptr tspace;
+ TMP_DECL (marker);
+
+ if (vsize < KARATSUBA_THRESHOLD)
+ {
+ /* Handle simple cases with traditional multiplication.
+
+ This is the most critical code of the entire function. All
+ multiplies rely on this, both small and huge. Small ones arrive
+ here immediately. Huge ones arrive here as this is the base case
+ for Karatsuba's recursive algorithm below. */
+ mp_size_t i;
+ mp_limb_t cy_limb;
+ mp_limb_t v_limb;
+
+ if (vsize == 0)
+ return 0;
+
+ /* Multiply by the first limb in V separately, as the result can be
+ stored (not added) to PROD. We also avoid a loop for zeroing. */
+ v_limb = vp[0];
+ if (v_limb <= 1)
+ {
+ if (v_limb == 1)
+ MPN_COPY (prodp, up, usize);
+ else
+ MPN_ZERO (prodp, usize);
+ cy_limb = 0;
+ }
+ else
+ cy_limb = mpn_mul_1 (prodp, up, usize, v_limb);
+
+ prodp[usize] = cy_limb;
+ prodp++;
+
+ /* For each iteration in the outer loop, multiply one limb from
+ U with one limb from V, and add it to PROD. */
+ for (i = 1; i < vsize; i++)
+ {
+ v_limb = vp[i];
+ if (v_limb <= 1)
+ {
+ cy_limb = 0;
+ if (v_limb == 1)
+ cy_limb = mpn_add_n (prodp, prodp, up, usize);
+ }
+ else
+ cy_limb = mpn_addmul_1 (prodp, up, usize, v_limb);
+
+ prodp[usize] = cy_limb;
+ prodp++;
+ }
+ return cy_limb;
+ }
+
+ TMP_MARK (marker);
+
+ tspace = (mp_ptr) TMP_ALLOC (2 * vsize * BYTES_PER_MP_LIMB);
+ MPN_MUL_N_RECURSE (prodp, up, vp, vsize, tspace);
+
+ prodp += vsize;
+ up += vsize;
+ usize -= vsize;
+ if (usize >= vsize)
+ {
+ mp_ptr tp = (mp_ptr) TMP_ALLOC (2 * vsize * BYTES_PER_MP_LIMB);
+ do
+ {
+ MPN_MUL_N_RECURSE (tp, up, vp, vsize, tspace);
+ cy = mpn_add_n (prodp, prodp, tp, vsize);
+ mpn_add_1 (prodp + vsize, tp + vsize, vsize, cy);
+ prodp += vsize;
+ up += vsize;
+ usize -= vsize;
+ }
+ while (usize >= vsize);
+ }
+
+ /* True: usize < vsize. */
+
+ /* Make life simple: Recurse. */
+
+ if (usize != 0)
+ {
+ mpn_mul (tspace, vp, vsize, up, usize);
+ cy = mpn_add_n (prodp, prodp, tspace, vsize);
+ mpn_add_1 (prodp + vsize, tspace + vsize, usize, cy);
+ }
+
+ TMP_FREE (marker);
+ return *prod_endp;
+}
--- /dev/null
+/* mpn_mul_1 -- Multiply a limb vector with a single limb and
+ store the product in a second limb vector.
+
+Copyright (C) 1991, 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+mp_limb_t
+mpn_mul_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+ register mp_ptr res_ptr;
+ register mp_srcptr s1_ptr;
+ mp_size_t s1_size;
+ register mp_limb_t s2_limb;
+{
+ register mp_limb_t cy_limb;
+ register mp_size_t j;
+ register mp_limb_t prod_high, prod_low;
+
+ /* The loop counter and index J goes from -S1_SIZE to -1. This way
+ the loop becomes faster. */
+ j = -s1_size;
+
+ /* Offset the base pointers to compensate for the negative indices. */
+ s1_ptr -= j;
+ res_ptr -= j;
+
+ cy_limb = 0;
+ do
+ {
+ umul_ppmm (prod_high, prod_low, s1_ptr[j], s2_limb);
+
+ prod_low += cy_limb;
+ cy_limb = (prod_low < cy_limb) + prod_high;
+
+ res_ptr[j] = prod_low;
+ }
+ while (++j != 0);
+
+ return cy_limb;
+}
--- /dev/null
+/* mpn_mul_n -- Multiply two natural numbers of length n.
+
+Copyright (C) 1991, 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/* Multiply the natural numbers u (pointed to by UP) and v (pointed to by VP),
+ both with SIZE limbs, and store the result at PRODP. 2 * SIZE limbs are
+ always stored. Return the most significant limb.
+
+ Argument constraints:
+ 1. PRODP != UP and PRODP != VP, i.e. the destination
+ must be distinct from the multiplier and the multiplicand. */
+
+/* If KARATSUBA_THRESHOLD is not already defined, define it to a
+ value which is good on most machines. */
+#ifndef KARATSUBA_THRESHOLD
+#define KARATSUBA_THRESHOLD 32
+#endif
+
+/* The code can't handle KARATSUBA_THRESHOLD smaller than 2. */
+#if KARATSUBA_THRESHOLD < 2
+#undef KARATSUBA_THRESHOLD
+#define KARATSUBA_THRESHOLD 2
+#endif
+
+/* Handle simple cases with traditional multiplication.
+
+ This is the most critical code of multiplication. All multiplies rely
+ on this, both small and huge. Small ones arrive here immediately. Huge
+ ones arrive here as this is the base case for Karatsuba's recursive
+ algorithm below. */
+
+void
+#if __STDC__
+impn_mul_n_basecase (mp_ptr prodp, mp_srcptr up, mp_srcptr vp, mp_size_t size)
+#else
+impn_mul_n_basecase (prodp, up, vp, size)
+ mp_ptr prodp;
+ mp_srcptr up;
+ mp_srcptr vp;
+ mp_size_t size;
+#endif
+{
+ mp_size_t i;
+ mp_limb_t cy_limb;
+ mp_limb_t v_limb;
+
+ /* Multiply by the first limb in V separately, as the result can be
+ stored (not added) to PROD. We also avoid a loop for zeroing. */
+ v_limb = vp[0];
+ if (v_limb <= 1)
+ {
+ if (v_limb == 1)
+ MPN_COPY (prodp, up, size);
+ else
+ MPN_ZERO (prodp, size);
+ cy_limb = 0;
+ }
+ else
+ cy_limb = mpn_mul_1 (prodp, up, size, v_limb);
+
+ prodp[size] = cy_limb;
+ prodp++;
+
+ /* For each iteration in the outer loop, multiply one limb from
+ U with one limb from V, and add it to PROD. */
+ for (i = 1; i < size; i++)
+ {
+ v_limb = vp[i];
+ if (v_limb <= 1)
+ {
+ cy_limb = 0;
+ if (v_limb == 1)
+ cy_limb = mpn_add_n (prodp, prodp, up, size);
+ }
+ else
+ cy_limb = mpn_addmul_1 (prodp, up, size, v_limb);
+
+ prodp[size] = cy_limb;
+ prodp++;
+ }
+}
+
+void
+#if __STDC__
+impn_mul_n (mp_ptr prodp,
+ mp_srcptr up, mp_srcptr vp, mp_size_t size, mp_ptr tspace)
+#else
+impn_mul_n (prodp, up, vp, size, tspace)
+ mp_ptr prodp;
+ mp_srcptr up;
+ mp_srcptr vp;
+ mp_size_t size;
+ mp_ptr tspace;
+#endif
+{
+ if ((size & 1) != 0)
+ {
+ /* The size is odd, the code code below doesn't handle that.
+ Multiply the least significant (size - 1) limbs with a recursive
+ call, and handle the most significant limb of S1 and S2
+ separately. */
+ /* A slightly faster way to do this would be to make the Karatsuba
+ code below behave as if the size were even, and let it check for
+ odd size in the end. I.e., in essence move this code to the end.
+ Doing so would save us a recursive call, and potentially make the
+ stack grow a lot less. */
+
+ mp_size_t esize = size - 1; /* even size */
+ mp_limb_t cy_limb;
+
+ MPN_MUL_N_RECURSE (prodp, up, vp, esize, tspace);
+ cy_limb = mpn_addmul_1 (prodp + esize, up, esize, vp[esize]);
+ prodp[esize + esize] = cy_limb;
+ cy_limb = mpn_addmul_1 (prodp + esize, vp, size, up[esize]);
+
+ prodp[esize + size] = cy_limb;
+ }
+ else
+ {
+ /* Anatolij Alekseevich Karatsuba's divide-and-conquer algorithm.
+
+ Split U in two pieces, U1 and U0, such that
+ U = U0 + U1*(B**n),
+ and V in V1 and V0, such that
+ V = V0 + V1*(B**n).
+
+ UV is then computed recursively using the identity
+
+ 2n n n n
+ UV = (B + B )U V + B (U -U )(V -V ) + (B + 1)U V
+ 1 1 1 0 0 1 0 0
+
+ Where B = 2**BITS_PER_MP_LIMB. */
+
+ mp_size_t hsize = size >> 1;
+ mp_limb_t cy;
+ int negflg;
+
+ /*** Product H. ________________ ________________
+ |_____U1 x V1____||____U0 x V0_____| */
+ /* Put result in upper part of PROD and pass low part of TSPACE
+ as new TSPACE. */
+ MPN_MUL_N_RECURSE (prodp + size, up + hsize, vp + hsize, hsize, tspace);
+
+ /*** Product M. ________________
+ |_(U1-U0)(V0-V1)_| */
+ if (mpn_cmp (up + hsize, up, hsize) >= 0)
+ {
+ mpn_sub_n (prodp, up + hsize, up, hsize);
+ negflg = 0;
+ }
+ else
+ {
+ mpn_sub_n (prodp, up, up + hsize, hsize);
+ negflg = 1;
+ }
+ if (mpn_cmp (vp + hsize, vp, hsize) >= 0)
+ {
+ mpn_sub_n (prodp + hsize, vp + hsize, vp, hsize);
+ negflg ^= 1;
+ }
+ else
+ {
+ mpn_sub_n (prodp + hsize, vp, vp + hsize, hsize);
+ /* No change of NEGFLG. */
+ }
+ /* Read temporary operands from low part of PROD.
+ Put result in low part of TSPACE using upper part of TSPACE
+ as new TSPACE. */
+ MPN_MUL_N_RECURSE (tspace, prodp, prodp + hsize, hsize, tspace + size);
+
+ /*** Add/copy product H. */
+ MPN_COPY (prodp + hsize, prodp + size, hsize);
+ cy = mpn_add_n (prodp + size, prodp + size, prodp + size + hsize, hsize);
+
+ /*** Add product M (if NEGFLG M is a negative number). */
+ if (negflg)
+ cy -= mpn_sub_n (prodp + hsize, prodp + hsize, tspace, size);
+ else
+ cy += mpn_add_n (prodp + hsize, prodp + hsize, tspace, size);
+
+ /*** Product L. ________________ ________________
+ |________________||____U0 x V0_____| */
+ /* Read temporary operands from low part of PROD.
+ Put result in low part of TSPACE using upper part of TSPACE
+ as new TSPACE. */
+ MPN_MUL_N_RECURSE (tspace, up, vp, hsize, tspace + size);
+
+ /*** Add/copy Product L (twice). */
+
+ cy += mpn_add_n (prodp + hsize, prodp + hsize, tspace, size);
+ if (cy)
+ mpn_add_1 (prodp + hsize + size, prodp + hsize + size, hsize, cy);
+
+ MPN_COPY (prodp, tspace, hsize);
+ cy = mpn_add_n (prodp + hsize, prodp + hsize, tspace + hsize, hsize);
+ if (cy)
+ mpn_add_1 (prodp + size, prodp + size, size, 1);
+ }
+}
+
+void
+#if __STDC__
+impn_sqr_n_basecase (mp_ptr prodp, mp_srcptr up, mp_size_t size)
+#else
+impn_sqr_n_basecase (prodp, up, size)
+ mp_ptr prodp;
+ mp_srcptr up;
+ mp_size_t size;
+#endif
+{
+ mp_size_t i;
+ mp_limb_t cy_limb;
+ mp_limb_t v_limb;
+
+ /* Multiply by the first limb in V separately, as the result can be
+ stored (not added) to PROD. We also avoid a loop for zeroing. */
+ v_limb = up[0];
+ if (v_limb <= 1)
+ {
+ if (v_limb == 1)
+ MPN_COPY (prodp, up, size);
+ else
+ MPN_ZERO (prodp, size);
+ cy_limb = 0;
+ }
+ else
+ cy_limb = mpn_mul_1 (prodp, up, size, v_limb);
+
+ prodp[size] = cy_limb;
+ prodp++;
+
+ /* For each iteration in the outer loop, multiply one limb from
+ U with one limb from V, and add it to PROD. */
+ for (i = 1; i < size; i++)
+ {
+ v_limb = up[i];
+ if (v_limb <= 1)
+ {
+ cy_limb = 0;
+ if (v_limb == 1)
+ cy_limb = mpn_add_n (prodp, prodp, up, size);
+ }
+ else
+ cy_limb = mpn_addmul_1 (prodp, up, size, v_limb);
+
+ prodp[size] = cy_limb;
+ prodp++;
+ }
+}
+
+void
+#if __STDC__
+impn_sqr_n (mp_ptr prodp,
+ mp_srcptr up, mp_size_t size, mp_ptr tspace)
+#else
+impn_sqr_n (prodp, up, size, tspace)
+ mp_ptr prodp;
+ mp_srcptr up;
+ mp_size_t size;
+ mp_ptr tspace;
+#endif
+{
+ if ((size & 1) != 0)
+ {
+ /* The size is odd, the code code below doesn't handle that.
+ Multiply the least significant (size - 1) limbs with a recursive
+ call, and handle the most significant limb of S1 and S2
+ separately. */
+ /* A slightly faster way to do this would be to make the Karatsuba
+ code below behave as if the size were even, and let it check for
+ odd size in the end. I.e., in essence move this code to the end.
+ Doing so would save us a recursive call, and potentially make the
+ stack grow a lot less. */
+
+ mp_size_t esize = size - 1; /* even size */
+ mp_limb_t cy_limb;
+
+ MPN_SQR_N_RECURSE (prodp, up, esize, tspace);
+ cy_limb = mpn_addmul_1 (prodp + esize, up, esize, up[esize]);
+ prodp[esize + esize] = cy_limb;
+ cy_limb = mpn_addmul_1 (prodp + esize, up, size, up[esize]);
+
+ prodp[esize + size] = cy_limb;
+ }
+ else
+ {
+ mp_size_t hsize = size >> 1;
+ mp_limb_t cy;
+
+ /*** Product H. ________________ ________________
+ |_____U1 x U1____||____U0 x U0_____| */
+ /* Put result in upper part of PROD and pass low part of TSPACE
+ as new TSPACE. */
+ MPN_SQR_N_RECURSE (prodp + size, up + hsize, hsize, tspace);
+
+ /*** Product M. ________________
+ |_(U1-U0)(U0-U1)_| */
+ if (mpn_cmp (up + hsize, up, hsize) >= 0)
+ {
+ mpn_sub_n (prodp, up + hsize, up, hsize);
+ }
+ else
+ {
+ mpn_sub_n (prodp, up, up + hsize, hsize);
+ }
+
+ /* Read temporary operands from low part of PROD.
+ Put result in low part of TSPACE using upper part of TSPACE
+ as new TSPACE. */
+ MPN_SQR_N_RECURSE (tspace, prodp, hsize, tspace + size);
+
+ /*** Add/copy product H. */
+ MPN_COPY (prodp + hsize, prodp + size, hsize);
+ cy = mpn_add_n (prodp + size, prodp + size, prodp + size + hsize, hsize);
+
+ /*** Add product M (if NEGFLG M is a negative number). */
+ cy -= mpn_sub_n (prodp + hsize, prodp + hsize, tspace, size);
+
+ /*** Product L. ________________ ________________
+ |________________||____U0 x U0_____| */
+ /* Read temporary operands from low part of PROD.
+ Put result in low part of TSPACE using upper part of TSPACE
+ as new TSPACE. */
+ MPN_SQR_N_RECURSE (tspace, up, hsize, tspace + size);
+
+ /*** Add/copy Product L (twice). */
+
+ cy += mpn_add_n (prodp + hsize, prodp + hsize, tspace, size);
+ if (cy)
+ mpn_add_1 (prodp + hsize + size, prodp + hsize + size, hsize, cy);
+
+ MPN_COPY (prodp, tspace, hsize);
+ cy = mpn_add_n (prodp + hsize, prodp + hsize, tspace + hsize, hsize);
+ if (cy)
+ mpn_add_1 (prodp + size, prodp + size, size, 1);
+ }
+}
+
+/* This should be made into an inline function in gmp.h. */
+inline void
+#if __STDC__
+mpn_mul_n (mp_ptr prodp, mp_srcptr up, mp_srcptr vp, mp_size_t size)
+#else
+mpn_mul_n (prodp, up, vp, size)
+ mp_ptr prodp;
+ mp_srcptr up;
+ mp_srcptr vp;
+ mp_size_t size;
+#endif
+{
+ TMP_DECL (marker);
+ TMP_MARK (marker);
+ if (up == vp)
+ {
+ if (size < KARATSUBA_THRESHOLD)
+ {
+ impn_sqr_n_basecase (prodp, up, size);
+ }
+ else
+ {
+ mp_ptr tspace;
+ tspace = (mp_ptr) TMP_ALLOC (2 * size * BYTES_PER_MP_LIMB);
+ impn_sqr_n (prodp, up, size, tspace);
+ }
+ }
+ else
+ {
+ if (size < KARATSUBA_THRESHOLD)
+ {
+ impn_mul_n_basecase (prodp, up, vp, size);
+ }
+ else
+ {
+ mp_ptr tspace;
+ tspace = (mp_ptr) TMP_ALLOC (2 * size * BYTES_PER_MP_LIMB);
+ impn_mul_n (prodp, up, vp, size, tspace);
+ }
+ }
+ TMP_FREE (marker);
+}
--- /dev/null
+/* mpn_sub_n -- Subtract two limb vectors of equal, non-zero length.
+
+Copyright (C) 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_limb_t
+#if __STDC__
+mpn_sub_n (mp_ptr res_ptr, mp_srcptr s1_ptr, mp_srcptr s2_ptr, mp_size_t size)
+#else
+mpn_sub_n (res_ptr, s1_ptr, s2_ptr, size)
+ register mp_ptr res_ptr;
+ register mp_srcptr s1_ptr;
+ register mp_srcptr s2_ptr;
+ mp_size_t size;
+#endif
+{
+ register mp_limb_t x, y, cy;
+ register mp_size_t j;
+
+ /* The loop counter and index J goes from -SIZE to -1. This way
+ the loop becomes faster. */
+ j = -size;
+
+ /* Offset the base pointers to compensate for the negative indices. */
+ s1_ptr -= j;
+ s2_ptr -= j;
+ res_ptr -= j;
+
+ cy = 0;
+ do
+ {
+ y = s2_ptr[j];
+ x = s1_ptr[j];
+ y += cy; /* add previous carry to subtrahend */
+ cy = (y < cy); /* get out carry from that addition */
+ y = x - y; /* main subtract */
+ cy = (y > x) + cy; /* get out carry from the subtract, combine */
+ res_ptr[j] = y;
+ }
+ while (++j != 0);
+
+ return cy;
+}
--- /dev/null
+/* mpn_submul_1 -- multiply the S1_SIZE long limb vector pointed to by S1_PTR
+ by S2_LIMB, subtract the S1_SIZE least significant limbs of the product
+ from the limb vector pointed to by RES_PTR. Return the most significant
+ limb of the product, adjusted for carry-out from the subtraction.
+
+Copyright (C) 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <config.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+mp_limb_t
+mpn_submul_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+ register mp_ptr res_ptr;
+ register mp_srcptr s1_ptr;
+ mp_size_t s1_size;
+ register mp_limb_t s2_limb;
+{
+ register mp_limb_t cy_limb;
+ register mp_size_t j;
+ register mp_limb_t prod_high, prod_low;
+ register mp_limb_t x;
+
+ /* The loop counter and index J goes from -SIZE to -1. This way
+ the loop becomes faster. */
+ j = -s1_size;
+
+ /* Offset the base pointers to compensate for the negative indices. */
+ res_ptr -= j;
+ s1_ptr -= j;
+
+ cy_limb = 0;
+ do
+ {
+ umul_ppmm (prod_high, prod_low, s1_ptr[j], s2_limb);
+
+ prod_low += cy_limb;
+ cy_limb = (prod_low < cy_limb) + prod_high;
+
+ x = res_ptr[j];
+ prod_low = x - prod_low;
+ cy_limb += (prod_low > x);
+ res_ptr[j] = prod_low;
+ }
+ while (++j != 0);
+
+ return cy_limb;
+}
--- /dev/null
+Sun Jan 2 21:32:13 2000 Ben Pfaff <blp@gnu.org>
+
+ * julcal.c: Comment fixes. Most of the code was rewritten.
+ (_juldnj) Renamed calendar_to_julian. Interface changed.
+ (juldnj) Removed.
+ (juldnd) Renamed julian_to_calendar. Interface changed.
+ (julcd) Removed.
+ (julcdd) Removed.
+ (julian_to_mday) New function.
+ (julian_to_wday) New function.
+ [STANDALONE] (main) New test routines.
+
+ * julcal.h: Replaced.
+
+Sat Jan 3 17:09:07 1998 Ben Pfaff <blp@gnu.org>
+
+ * README: New file.
+
+Fri Dec 26 15:43:57 1997 Ben Pfaff <blp@gnu.org>
+
+ * julcal.c: (julian_offset) Move glob var definition here.
+
+Sun Jul 6 19:12:18 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Fixed INCLUDES to include intl; fixed directories.
+
+Sun Jun 1 17:27:17 1997 Ben Pfaff <blp@gnu.org>
+
+ * julcal.h: Made the declaration of macros with arguments a lot
+ nicer looking.
+
+Fri Apr 18 16:48:41 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Refers to src/ as include directory instead of
+ include/.
+
+Fri Apr 18 15:42:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Maintainer-clean Makefile.in.
+
+Thu Oct 24 17:47:14 1996 Ben Pfaff <blp@gnu.org>
+
+ * julcal.h: Comment fix.
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+## Process this file with automake to produce Makefile.in -*- makefile -*-
+
+noinst_LIBRARIES = libjulcal.a
+
+INCLUDES = -I$(srcdir) -I$(top_srcdir)/src -I$(top_srcdir) \
+-I$(top_srcdir)/intl
+
+libjulcal_a_SOURCES = julcal.c
+noinst_HEADERS = julcal.h
+
+MAINTAINERCLEANFILES = Makefile.in
--- /dev/null
+Please note that julcal is not part of PSPP. Instead, it is a
+separate library that is included in the PSPP distribution for
+convenience in compiling.
+
+ -blp
--- /dev/null
+/*
+ Modified BLP 8/28/95, 12/15/99 for PSPP.
+
+ Original sources for julcal.c and julcal.h can be found at
+ ftp.cdrom.com in /pub/algorithms/c/julcal10/{julcal.c,julcal.h}.
+ */
+
+/*
+ Translated from Pascal to C by Jim Van Zandt, July 1992.
+
+ Error-free translation based on error-free PL/I source
+
+ Based on Pascal code copyright 1985 by Michael A. Covington,
+ published in P.C. Tech Journal, December 1985, based on formulae
+ appearing in Astronomical Formulae for Calculators by Jean Meeus
+ */
+
+/*#include <config.h>*/
+#include <time.h>
+#include <assert.h>
+#include "julcal.h"
+
+#define JUL_OFFSET 2299160L
+
+/* Takes Y, M, and D, and returns the corresponding Julian date as an
+ offset in days from the midnight separating 8 Oct 1582 and 9 Oct
+ 1582. (Y,M,D) = (1999,10,1) corresponds to 1 Oct 1999. */
+long
+calendar_to_julian (int y, int m, int d)
+{
+ m--;
+ y += m / 12;
+ m -= m / 12 * 12;
+
+ assert (m > -12 && m < 12);
+ if (m < 0)
+ {
+ m += 12;
+ y--;
+ }
+
+ assert (m >= 0 && m < 12);
+ if (m < 2)
+ {
+ m += 13;
+ y--;
+ }
+ else
+ m++;
+
+ return ((1461 * (y + 4716L) / 4)
+ + (153 * (m + 1) / 5)
+ + (d - 1)
+ - 1524
+ + 3
+ - y / 100
+ + y / 400
+ - y / 4000
+ - JUL_OFFSET);
+}
+
+/* Takes a Julian date JD and sets *Y0, *M0, and *D0 to the
+ corresponding year, month, and day, respectively, where
+ (*Y0,*M0,*D0) = (1999,10,1) would be 1 Oct 1999. */
+void
+julian_to_calendar (long jd, int *y0, int *m0, int *d0)
+{
+ int a, ay, em;
+
+ jd += JUL_OFFSET;
+
+ {
+ long aa, ab;
+
+ aa = jd - 1721120L;
+ ab = 31 * (aa / 1460969L);
+ aa %= 1460969L;
+ ab += 3 * (aa / 146097L);
+ aa = aa % 146097L;
+ if (aa == 146096L)
+ ab += 3;
+ else
+ ab += aa / 36524L;
+ a = jd + (ab - 2);
+ }
+
+ {
+ long ee, b, d;
+
+ b = a + 1524;
+ ay = (20 * b - 2442) / 7305;
+ d = 1461L * ay / 4;
+ ee = b - d;
+ em = 10000 * ee / 306001;
+ if (d0 != NULL)
+ *d0 = ee - 306001L * em / 10000L;
+ }
+
+ if (y0 != NULL || m0 != NULL)
+ {
+ int m = em - 1;
+ if (m > 12)
+ m -= 12;
+ if (m0 != NULL)
+ *m0 = m;
+
+ if (y0 != NULL)
+ {
+ if (m > 2)
+ *y0 = ay - 4716;
+ else
+ *y0 = ay - 4715;
+ }
+
+ }
+}
+
+/* Takes a julian date JD and returns the corresponding year-relative
+ Julian date, with 1=Jan 1. */
+int
+julian_to_jday (long jd)
+{
+ int year;
+
+ julian_to_calendar (jd, &year, NULL, NULL);
+ return jd - calendar_to_julian (year, 1, 1) + 1;
+}
+
+
+/* Takes a julian date JD and returns the corresponding weekday 1...7,
+ with 1=Sunday. */
+int
+julian_to_wday (long jd)
+{
+ return (jd - 3) % 7 + 1;
+}
+
+#if STANDALONE
+#include <stdio.h>
+
+int
+main (void)
+{
+ {
+ long julian[] =
+ {
+ 1, 50000, 102, 1157, 14288, 87365, 109623, 153211, 152371, 144623,
+ };
+ size_t j;
+
+ for (j = 0; j < sizeof julian / sizeof *julian; j++)
+ {
+ int y, m, d;
+ long jd;
+ julian_to_calendar (julian[j], &y, &m, &d);
+ jd = calendar_to_julian (y, m, d);
+ printf ("%ld => %d/%d/%d => %ld\n", julian[j], y, m, d, jd);
+ }
+ }
+
+ {
+ int date[][3] =
+ {
+ {1582,10,15}, {1719,9,6}, {1583,1,24}, {1585,12,14},
+ {1621,11,26}, {1821,12,25}, {1882,12,3}, {2002,4,6},
+ {1999,12,19}, {1978,10,1},
+ };
+ size_t j;
+
+ for (j = 0; j < sizeof date / sizeof *date; j++)
+ {
+ int y = date[j][0], m = date[j][1], d = date[j][2];
+ long jd = calendar_to_julian (y, m, d);
+ int y2, m2, d2;
+ julian_to_calendar (jd, &y2, &m2, &d2);
+ printf ("%d/%d/%d => %ld => %d/%d/%d\n",
+ y, m, d, jd, y2, m2, d2);
+ }
+ }
+
+ return 0;
+}
+#endif
--- /dev/null
+/*
+ Declarations for Julian date routines.
+
+ Modified BLP 8/28/95, 9/26/95, 12/15/99 for PSPP.
+ */
+
+#if !julcal_h
+#define julcal_h 1
+
+long calendar_to_julian (int y, int m, int d);
+void julian_to_calendar (long jd, int *y, int *m, int *d);
+int julian_to_wday (long jd);
+int julian_to_jday (long jd);
+
+#endif /* !julcal_h */
--- /dev/null
+Sun Jan 2 21:35:47 2000 Ben Pfaff <blp@gnu.org>
+
+ * qsort.c: Change headers. Fix __attribute__ for gcc 2.7.2.
+
+ * strcasecmp.c: Remove duplicate inclusion of ctype.h.
+
+ * strncasecmp.c: (strncasecmp) Must cast argument of tolower() to
+ unsigned char.
+
+Sat Jan 23 12:50:16 1999 Ben Pfaff <blp@gnu.org>
+
+ * strcasecmp.c: (strcasecmp) Fix behavior for zero-length strings.
+
+Sun Jul 5 00:15:44 1998 Ben Pfaff <blp@gnu.org>
+
+ * qsort.c: (blp_quicksort) Add unused qualifier to temp_buf when
+ alloca is in use.
+
+1998-02-23 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) Add strtok_r.c.
+
+ * strtok_r.c: New file.
+
+1998-02-16 Ben Pfaff <blp@gnu.org>
+
+ * memmem.c: Cast void * to char * before dereferencing, in a
+ different place.
+
+Fri Feb 13 15:35:55 1998 Ben Pfaff <blp@gnu.org>
+
+ * memmem.c: Cast void * to char * before dereferencing. Reported
+ by palme@uni-wuppertal.de (Hubert Palme).
+
+Sun Jan 18 00:30:38 1998 Ben Pfaff <blp@gnu.org>
+
+ * memmem.c: Fix argument types.
+
+Sun Oct 5 15:54:37 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) Add strerror.c. From Alexandre Oliva
+ <oliva@dcc.unicamp.br>.
+
+ * strerror.c: New file. From Alexandre Oliva
+ <oliva@dcc.unicamp.br>.
+
+Thu Sep 18 21:34:07 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (libmisc_a_SOURCES) Added getopt.c, getopt1.c.
+ (EXTRA_DIST) Removed getopt.c, getopt1.c.
+
+Thu Jul 17 01:50:43 1997 Ben Pfaff <blp@gnu.org>
+
+ * strncasecmp.c: (strncasecmp) Rewritten to fix undefined
+ behavior.
+
+Fri Jul 11 14:06:04 1997 Ben Pfaff <blp@gnu.org>
+
+ * getdelim.c: Added in some necessary #include's.
+
+ * getline.c: #include's <config.h>. Added getdelim() prototype.
+
+ * memmem.c: #include's <stddef.h>.
+ (memmem) `i' now a size_t. Avoid subtraction of unsigned's.
+
+Sun Jul 6 19:12:35 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Fixed INCLUDES to include intl; fixed directories.
+
+Mon Jun 2 14:22:24 1997 Ben Pfaff <blp@gnu.org>
+
+ * getopt.c: Marked strings for gettext.
+
+Fri Apr 18 16:48:41 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Refers to src/ as include directory instead of
+ include/.
+
+Fri Apr 18 15:42:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Maintainer-clean Makefile.in.
+
+Thu Mar 27 01:11:29 1997 Ben Pfaff <blp@gnu.org>
+
+ * alloca.c: Only compiled if necessary.
+
+ * getdelim.c: New file.
+ * getline.c: New file.
+ * memchr.c: New file.
+ * memcpy.c: New file.
+ * memmem.c: New file.
+ * memmove.c: New file.
+ * memset.c: New file.
+ * strcasecmp.c: New file.
+ * strncasecmp.c: New file.
+ * strpbrk.c: New file.
+ * strstr.c: New file.
+ * strtol.c: New file.
+ * strtoul.c: New file.
+
+Sun Dec 15 15:32:16 1996 Ben Pfaff <blp@gnu.org>
+
+ * qsort.c: New file, essentially unchanged from the glibc-1.09
+ distribution.
+
+Mon Nov 11 15:34:09 1996 Ben Pfaff <blp@gnu.org>
+
+ * avl.c: (destroy) Format fix.
+ (avl_destroy) Only calls destroy() if the tree has a non-NULL
+ root.
+
+Thu Nov 7 20:52:28 1996 Ben Pfaff <blp@gnu.org>
+
+ * avl.h: (force_avl_insert, force_avl_delete) New macros/functions
+ that assure that a node was successfully added/deleted, active
+ only when GLOBAL_DEBUGGING. Most occurrences of
+ avl_insert/avl_delete changed to use these instead.
+
+ * avl.c: [GLOBAL_DEBUGGING] (force_avl_delete) New function.
+
+Tue Sep 24 18:39:09 1996 Ben Pfaff <blp@gnu.org>
+
+ * stpcpy.c: Comment fix.
+
+Fri Sep 20 22:52:28 1996 Ben Pfaff <blp@gnu.org>
+
+ * alloca.c: Changed conditions for inclusion.
+
+Tue Jul 23 21:48:36 1996 Ben Pfaff <blp@gnu.org>
+
+ * avl.c: Formatting fixes.
+ (balance) Fixed bug introduced in last patchlevel that reversed
+ the truth value returned by final statement.
+ (find) Always returns NULL if end of function reached.
+ (avl_walk) Split into two functions, walk_inorder and
+ walk_preorder. All callers and callees changed.
+ (avl_sort) New function.
+
+Fri Jul 19 19:11:13 1996 Ben Pfaff <blp@gnu.org>
+
+ * avl.h, avl.c: Completely reworked, might as well be considered
+ new files. All callers, all references to AVL trees changed.
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+## Process this file with automake to produce Makefile.in -*- makefile -*-
+
+noinst_LIBRARIES = libmisc.a
+
+INCLUDES = -I$(srcdir) -I$(top_srcdir)/src -I$(top_srcdir) \
+-I$(top_srcdir)/intl
+
+libmisc_a_SOURCES = qsort.c getopt.c getopt1.c
+libmisc_a_LIBADD = @ALLOCA@ @LIBOBJS@
+libmisc_a_DEPENDENCIES = @ALLOCA@ @LIBOBJS@
+
+EXTRA_DIST = alloca.c getdelim.c getline.c memchr.c memcmp.c memcpy.c \
+memmem.c memmove.c memset.c stpcpy.c strcasecmp.c strerror.c \
+strncasecmp.c strpbrk.c strstr.c strtok_r.c strtol.c strtoul.c
+
+MAINTAINERCLEANFILES = Makefile.in
--- /dev/null
+/*
+ alloca -- (mostly) portable public-domain implementation -- D A Gwyn
+
+ edited 8/22/95, 2/28/96, 3/28/96 by BLP for PSPP
+
+ edited 86/05/30 rms
+ include config.h, since on VMS it renames some symbols.
+ Use xmalloc instead of malloc.
+
+ This implementation of the PWB library alloca() function,
+ which is used to allocate space off the run-time stack so
+ that it is automatically reclaimed upon procedure exit,
+ was inspired by discussions with J. Q. Johnson of Cornell.
+
+ It should work under any C implementation that uses an
+ actual procedure stack (as opposed to a linked list of
+ frames). There are some preprocessor constants that can
+ be defined when compiling for your specific system, for
+ improved efficiency; however, the defaults should be okay.
+
+ The general concept of this implementation is to keep
+ track of all alloca()-allocated blocks, and reclaim any
+ that are found to be deeper in the stack than the current
+ invocation. This heuristic does not reclaim storage as
+ soon as it becomes invalid, but it will do so eventually.
+
+ As a special case, alloca(0) reclaims storage without
+ allocating any. It is a good idea to use alloca(0) in
+ your main control loop, etc. to force garbage collection.
+ */
+
+#if C_ALLOCA
+
+#include <config.h>
+#include <stdlib.h>
+#include "common.h"
+
+typedef void *pointer; /* generic pointer type */
+#define NULL 0 /* null pointer constant */
+
+extern void free ();
+extern pointer xmalloc ();
+
+/*
+ Define STACK_DIRECTION if you know the direction of stack
+ growth for your system; otherwise it will be automatically
+ deduced at run-time.
+
+ STACK_DIRECTION > 0 => grows toward higher addresses
+ STACK_DIRECTION < 0 => grows toward lower addresses
+ STACK_DIRECTION = 0 => direction of growth unknown
+ */
+
+#ifndef STACK_DIRECTION
+#define STACK_DIRECTION 0 /* direction unknown */
+#endif
+
+#if STACK_DIRECTION != 0
+
+#define STACK_DIR STACK_DIRECTION /* known at compile-time */
+
+#else /* STACK_DIRECTION == 0; need run-time code */
+
+static int stack_dir; /* 1 or -1 once known */
+#define STACK_DIR stack_dir
+
+static void
+find_stack_direction (void)
+{
+ static char *addr = NULL; /* address of first
+ `dummy', once known */
+ auto char dummy; /* to get stack address */
+
+ if (addr == NULL)
+ { /* initial entry */
+ addr = &dummy;
+
+ find_stack_direction (); /* recurse once */
+ }
+ else
+ /* second entry */ if (&dummy > addr)
+ stack_dir = 1; /* stack grew upward */
+ else
+ stack_dir = -1; /* stack grew downward */
+}
+
+#endif /* STACK_DIRECTION == 0 */
+
+/*
+ An "alloca header" is used to:
+ (a) chain together all alloca()ed blocks;
+ (b) keep track of stack depth.
+
+ PORTME: It is very important that sizeof(header) agree with
+ malloc() alignment chunk size. The following default should
+ work okay. */
+
+#ifndef ALIGN_SIZE
+#define ALIGN_SIZE sizeof(double)
+#endif
+
+typedef union hdr
+{
+ char align[ALIGN_SIZE]; /* to force sizeof(header) */
+ struct
+ {
+ union hdr *next; /* for chaining headers */
+ char *deep; /* for stack depth measure */
+ }
+ h;
+}
+header;
+
+/*
+ alloca( size ) returns a pointer to at least `size' bytes of
+ storage which will be automatically reclaimed upon exit from
+ the procedure that called alloca(). Originally, this space
+ was supposed to be taken from the current stack frame of the
+ caller, but that method cannot be made to work for some
+ implementations of C, for example under Gould's UTX/32.
+ */
+
+static header *last_alloca_header = NULL; /* -> last alloca header */
+
+pointer
+alloca (unsigned size) /* returns pointer to storage */
+{
+ auto char probe; /* probes stack depth: */
+ register char *depth = &probe;
+
+#if STACK_DIRECTION == 0
+ if (STACK_DIR == 0) /* unknown growth direction */
+ find_stack_direction ();
+#endif
+
+ /* Reclaim garbage, defined as all alloca()ed storage that
+ was allocated from deeper in the stack than currently. */
+
+ {
+ register header *hp; /* traverses linked list */
+
+ for (hp = last_alloca_header; hp != NULL;)
+ if (STACK_DIR > 0 && hp->h.deep > depth
+ || STACK_DIR < 0 && hp->h.deep < depth)
+ {
+ register header *np = hp->h.next;
+
+ free ((pointer) hp); /* collect garbage */
+
+ hp = np; /* -> next header */
+ }
+ else
+ break; /* rest are not deeper */
+
+ last_alloca_header = hp; /* -> last valid storage */
+ }
+
+ if (size == 0)
+ return NULL; /* no allocation required */
+
+ /* Allocate combined header + user data storage. */
+
+ {
+ register pointer new = xmalloc (sizeof (header) + size);
+ /* address of header */
+
+ ((header *) new)->h.next = last_alloca_header;
+ ((header *) new)->h.deep = depth;
+
+ last_alloca_header = (header *) new;
+
+ /* User storage begins just after header. */
+
+ return (pointer) ((char *) new + sizeof (header));
+ }
+}
+
+#endif /* !__GNUC__ && !__BORLANDC__ */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stddef.h>
+#include <stdio.h>
+#include "common.h"
+
+/* Reads a DELIMITER-separated field of any length from file STREAM.
+ *LINEPTR is a malloc'd string of size N; if *LINEPTR is NULL, it is
+ allocated. *LINEPTR is allocated/enlarged as necessary. Returns
+ -1 if at eof when entered; otherwise eof causes return of string
+ without a terminating DELIMITER. Normally DELIMITER is the last
+ character in *LINEPTR on return (besides the null character which
+ is always present). Returns number of characters read, including
+ terminating field delimiter if present. */
+long
+getdelim (char **lineptr, size_t *n, int delimiter, FILE *stream)
+{
+ /* Number of characters stored in *lineptr so far. */
+ size_t len;
+
+ /* Last character read. */
+ int c;
+
+ if (*lineptr == NULL || *n < 2)
+ {
+ *lineptr = xrealloc (*lineptr, 128);
+ *n = 128;
+ }
+ assert (*n > 0);
+
+ len = 0;
+ c = getc (stream);
+ if (c == EOF)
+ return -1;
+ while (1)
+ {
+ if (len + 1 >= *n)
+ {
+ *n *= 2;
+ *lineptr = xrealloc (*lineptr, *n);
+ }
+ (*lineptr)[len++] = c;
+
+ if (c == delimiter)
+ break;
+
+ c = getc (stream);
+ if (c == EOF)
+ break;
+ }
+ (*lineptr)[len] = '\0';
+ return len;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <stddef.h>
+#include <stdio.h>
+
+#if !HAVE_GETDELIM
+long getdelim (char **lineptr, size_t *n, int delimiter, FILE *stream);
+#endif
+
+long
+getline (char **lineptr, size_t *n, FILE *stream)
+{
+ return getdelim (lineptr, n, '\n', stream);
+}
--- /dev/null
+/* Getopt for GNU.
+ NOTE: getopt is now part of the C library, so if you don't know what
+ "Keep this file name-space clean" means, talk to roland@gnu.org
+ before changing it!
+
+ Copyright (C) 1987, 88, 89, 90, 91, 92, 93, 94
+ Free Software Foundation, Inc.
+
+ This file is part of the GNU C Library. Its master source is NOT part of
+ the C library, however. The master source lives in /gd/gnu/lib.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with the GNU C Library; see the file COPYING.LIB. If
+ not, write to the Free Software Foundation, Inc., 675 Mass Ave,
+ Cambridge, MA 02139, USA. */
+\f
+/* This file has been modified from the GNU libc distribution. */
+
+/* This tells Alpha OSF/1 not to define a getopt prototype in <stdio.h>.
+ Ditto for AIX 3.2 and <stdlib.h>. */
+#ifndef _NO_PROTO
+#define _NO_PROTO
+#endif
+
+#include <config.h>
+
+#if !defined (__STDC__) || !__STDC__
+/* This is a separate conditional since some stdc systems
+ reject `defined (const)'. */
+#ifndef const
+#define const
+#endif
+#endif
+
+#include <stdio.h>
+
+/* Comment out all this code if we are using the GNU C Library, and are not
+ actually compiling the library itself. This code is part of the GNU C
+ Library, but also included in many other GNU distributions. Compiling
+ and linking in this code is a waste when using the GNU C library
+ (especially if it is a shared library). Rather than having every GNU
+ program understand `configure --with-gnu-libc' and omit the object files,
+ it is simpler to just do this in the source for each such file. */
+
+#if defined (_LIBC) || !defined (__GNU_LIBRARY__)
+
+
+/* This needs to come after some library #include
+ to get __GNU_LIBRARY__ defined. */
+#ifdef __GNU_LIBRARY__
+/* Don't include stdlib.h for non-GNU C libraries because some of them
+ contain conflicting prototypes for getopt. */
+#include <stdlib.h>
+#endif /* GNU C library. */
+
+/* This version of `getopt' appears to the caller like standard Unix `getopt'
+ but it behaves differently for the user, since it allows the user
+ to intersperse the options with the other arguments.
+
+ As `getopt' works, it permutes the elements of ARGV so that,
+ when it is done, all the options precede everything else. Thus
+ all application programs are extended to handle flexible argument order.
+
+ Setting the environment variable POSIXLY_CORRECT disables permutation.
+ Then the behavior is completely standard.
+
+ GNU application programs can use a third alternative mode in which
+ they can distinguish the relative order of options and other arguments. */
+
+#include "getopt.h"
+
+/* For communication from `getopt' to the caller.
+ When `getopt' finds an option that takes an argument,
+ the argument value is returned here.
+ Also, when `ordering' is RETURN_IN_ORDER,
+ each non-option ARGV-element is returned here. */
+
+char *optarg = NULL;
+
+/* Index in ARGV of the next element to be scanned.
+ This is used for communication to and from the caller
+ and for communication between successive calls to `getopt'.
+
+ On entry to `getopt', zero means this is the first call; initialize.
+
+ When `getopt' returns EOF, this is the index of the first of the
+ non-option elements that the caller should itself scan.
+
+ Otherwise, `optind' communicates from one call to the next
+ how much of ARGV has been scanned so far. */
+
+/* XXX 1003.2 says this must be 1 before any call. */
+int optind = 0;
+
+/* The next char to be scanned in the option-element
+ in which the last option character we returned was found.
+ This allows us to pick up the scan where we left off.
+
+ If this is zero, or a null string, it means resume the scan
+ by advancing to the next ARGV-element. */
+
+static char *nextchar;
+
+/* Callers store zero here to inhibit the error message
+ for unrecognized options. */
+
+int opterr = 1;
+
+/* Set to an option character which was unrecognized.
+ This must be initialized on some systems to avoid linking in the
+ system's own getopt implementation. */
+
+int optopt = '?';
+
+/* Describe how to deal with options that follow non-option ARGV-elements.
+
+ If the caller did not specify anything,
+ the default is REQUIRE_ORDER if the environment variable
+ POSIXLY_CORRECT is defined, PERMUTE otherwise.
+
+ REQUIRE_ORDER means don't recognize them as options;
+ stop option processing when the first non-option is seen.
+ This is what Unix does.
+ This mode of operation is selected by either setting the environment
+ variable POSIXLY_CORRECT, or using `+' as the first character
+ of the list of option characters.
+
+ PERMUTE is the default. We permute the contents of ARGV as we scan,
+ so that eventually all the non-options are at the end. This allows options
+ to be given in any order, even with programs that were not written to
+ expect this.
+
+ RETURN_IN_ORDER is an option available to programs that were written
+ to expect options and other ARGV-elements in any order and that care about
+ the ordering of the two. We describe each non-option ARGV-element
+ as if it were the argument of an option with character code 1.
+ Using `-' as the first character of the list of option characters
+ selects this mode of operation.
+
+ The special argument `--' forces an end of option-scanning regardless
+ of the value of `ordering'. In the case of RETURN_IN_ORDER, only
+ `--' can cause `getopt' to return EOF with `optind' != ARGC. */
+
+static enum
+ {
+ REQUIRE_ORDER, PERMUTE, RETURN_IN_ORDER
+ }
+ordering;
+
+/* Value of POSIXLY_CORRECT environment variable. */
+static char *posixly_correct;
+\f
+#ifdef __GNU_LIBRARY__
+/* We want to avoid inclusion of string.h with non-GNU libraries
+ because there are many ways it can cause trouble.
+ On some systems, it contains special magic macros that don't work
+ in GCC. */
+#include <string.h>
+#define my_index strchr
+#else
+
+/* Avoid depending on library functions or files
+ whose names are inconsistent. */
+
+char *getenv ();
+
+static char *
+my_index (str, chr)
+ const char *str;
+ int chr;
+{
+ while (*str)
+ {
+ if (*str == chr)
+ return (char *) str;
+ str++;
+ }
+ return 0;
+}
+
+/* If using GCC, we can safely declare strlen this way.
+ If not using GCC, it is ok not to declare it. */
+#ifdef __GNUC__
+/* Note that Motorola Delta 68k R3V7 comes with GCC but not stddef.h.
+ That was relevant to code that was here before. */
+#if !defined (__STDC__) || !__STDC__
+/* gcc with -traditional declares the built-in strlen to return int,
+ and has done so at least since version 2.4.5. -- rms. */
+extern int strlen (const char *);
+#endif /* not __STDC__ */
+#endif /* __GNUC__ */
+
+#endif /* not __GNU_LIBRARY__ */
+\f
+/* Handle permutation of arguments. */
+
+/* Describe the part of ARGV that contains non-options that have
+ been skipped. `first_nonopt' is the index in ARGV of the first of them;
+ `last_nonopt' is the index after the last of them. */
+
+static int first_nonopt;
+static int last_nonopt;
+
+/* Exchange two adjacent subsequences of ARGV.
+ One subsequence is elements [first_nonopt,last_nonopt)
+ which contains all the non-options that have been skipped so far.
+ The other is elements [last_nonopt,optind), which contains all
+ the options processed since those non-options were skipped.
+
+ `first_nonopt' and `last_nonopt' are relocated so that they describe
+ the new indices of the non-options in ARGV after they are moved. */
+
+static void
+exchange (argv)
+ char **argv;
+{
+ int bottom = first_nonopt;
+ int middle = last_nonopt;
+ int top = optind;
+ char *tem;
+
+ /* Exchange the shorter segment with the far end of the longer segment.
+ That puts the shorter segment into the right place.
+ It leaves the longer segment in the right place overall,
+ but it consists of two parts that need to be swapped next. */
+
+ while (top > middle && middle > bottom)
+ {
+ if (top - middle > middle - bottom)
+ {
+ /* Bottom segment is the short one. */
+ int len = middle - bottom;
+ register int i;
+
+ /* Swap it with the top part of the top segment. */
+ for (i = 0; i < len; i++)
+ {
+ tem = argv[bottom + i];
+ argv[bottom + i] = argv[top - (middle - bottom) + i];
+ argv[top - (middle - bottom) + i] = tem;
+ }
+ /* Exclude the moved bottom segment from further swapping. */
+ top -= len;
+ }
+ else
+ {
+ /* Top segment is the short one. */
+ int len = top - middle;
+ register int i;
+
+ /* Swap it with the bottom part of the bottom segment. */
+ for (i = 0; i < len; i++)
+ {
+ tem = argv[bottom + i];
+ argv[bottom + i] = argv[middle + i];
+ argv[middle + i] = tem;
+ }
+ /* Exclude the moved top segment from further swapping. */
+ bottom += len;
+ }
+ }
+
+ /* Update records for the slots the non-options now occupy. */
+
+ first_nonopt += (optind - last_nonopt);
+ last_nonopt = optind;
+}
+
+/* Initialize the internal data when the first call is made. */
+
+static const char *
+_getopt_initialize (optstring)
+ const char *optstring;
+{
+ /* Start processing options with ARGV-element 1 (since ARGV-element 0
+ is the program name); the sequence of previously skipped
+ non-option ARGV-elements is empty. */
+
+ first_nonopt = last_nonopt = optind = 1;
+
+ nextchar = NULL;
+
+ posixly_correct = getenv ("POSIXLY_CORRECT");
+
+ /* Determine how to handle the ordering of options and nonoptions. */
+
+ if (optstring[0] == '-')
+ {
+ ordering = RETURN_IN_ORDER;
+ ++optstring;
+ }
+ else if (optstring[0] == '+')
+ {
+ ordering = REQUIRE_ORDER;
+ ++optstring;
+ }
+ else if (posixly_correct != NULL)
+ ordering = REQUIRE_ORDER;
+ else
+ ordering = PERMUTE;
+
+ return optstring;
+}
+\f
+/* Scan elements of ARGV (whose length is ARGC) for option characters
+ given in OPTSTRING.
+
+ If an element of ARGV starts with '-', and is not exactly "-" or "--",
+ then it is an option element. The characters of this element
+ (aside from the initial '-') are option characters. If `getopt'
+ is called repeatedly, it returns successively each of the option characters
+ from each of the option elements.
+
+ If `getopt' finds another option character, it returns that character,
+ updating `optind' and `nextchar' so that the next call to `getopt' can
+ resume the scan with the following option character or ARGV-element.
+
+ If there are no more option characters, `getopt' returns `EOF'.
+ Then `optind' is the index in ARGV of the first ARGV-element
+ that is not an option. (The ARGV-elements have been permuted
+ so that those that are not options now come last.)
+
+ OPTSTRING is a string containing the legitimate option characters.
+ If an option character is seen that is not listed in OPTSTRING,
+ return '?' after printing an error message. If you set `opterr' to
+ zero, the error message is suppressed but we still return '?'.
+
+ If a char in OPTSTRING is followed by a colon, that means it wants an arg,
+ so the following text in the same ARGV-element, or the text of the following
+ ARGV-element, is returned in `optarg'. Two colons mean an option that
+ wants an optional arg; if there is text in the current ARGV-element,
+ it is returned in `optarg', otherwise `optarg' is set to zero.
+
+ If OPTSTRING starts with `-' or `+', it requests different methods of
+ handling the non-option ARGV-elements.
+ See the comments about RETURN_IN_ORDER and REQUIRE_ORDER, above.
+
+ Long-named options begin with `--' instead of `-'.
+ Their names may be abbreviated as long as the abbreviation is unique
+ or is an exact match for some defined option. If they have an
+ argument, it follows the option name in the same ARGV-element, separated
+ from the option name by a `=', or else the in next ARGV-element.
+ When `getopt' finds a long-named option, it returns 0 if that option's
+ `flag' field is nonzero, the value of the option's `val' field
+ if the `flag' field is zero.
+
+ The elements of ARGV aren't really const, because we permute them.
+ But we pretend they're const in the prototype to be compatible
+ with other systems.
+
+ LONGOPTS is a vector of `struct option' terminated by an
+ element containing a name which is zero.
+
+ LONGIND returns the index in LONGOPT of the long-named option found.
+ It is only valid when a long-named option has been found by the most
+ recent call.
+
+ If LONG_ONLY is nonzero, '-' as well as '--' can introduce
+ long-named options. */
+
+int
+_getopt_internal (argc, argv, optstring, longopts, longind, long_only)
+ int argc;
+ char *const *argv;
+ const char *optstring;
+ const struct option *longopts;
+ int *longind;
+ int long_only;
+{
+ optarg = NULL;
+
+ if (optind == 0)
+ optstring = _getopt_initialize (optstring);
+
+ if (nextchar == NULL || *nextchar == '\0')
+ {
+ /* Advance to the next ARGV-element. */
+
+ if (ordering == PERMUTE)
+ {
+ /* If we have just processed some options following some non-options,
+ exchange them so that the options come first. */
+
+ if (first_nonopt != last_nonopt && last_nonopt != optind)
+ exchange ((char **) argv);
+ else if (last_nonopt != optind)
+ first_nonopt = optind;
+
+ /* Skip any additional non-options
+ and extend the range of non-options previously skipped. */
+
+ while (optind < argc
+ && (argv[optind][0] != '-' || argv[optind][1] == '\0'))
+ optind++;
+ last_nonopt = optind;
+ }
+
+ /* The special ARGV-element `--' means premature end of options.
+ Skip it like a null option,
+ then exchange with previous non-options as if it were an option,
+ then skip everything else like a non-option. */
+
+ if (optind != argc && !strcmp (argv[optind], "--"))
+ {
+ optind++;
+
+ if (first_nonopt != last_nonopt && last_nonopt != optind)
+ exchange ((char **) argv);
+ else if (first_nonopt == last_nonopt)
+ first_nonopt = optind;
+ last_nonopt = argc;
+
+ optind = argc;
+ }
+
+ /* If we have done all the ARGV-elements, stop the scan
+ and back over any non-options that we skipped and permuted. */
+
+ if (optind == argc)
+ {
+ /* Set the next-arg-index to point at the non-options
+ that we previously skipped, so the caller will digest them. */
+ if (first_nonopt != last_nonopt)
+ optind = first_nonopt;
+ return EOF;
+ }
+
+ /* If we have come to a non-option and did not permute it,
+ either stop the scan or describe it to the caller and pass it by. */
+
+ if ((argv[optind][0] != '-' || argv[optind][1] == '\0'))
+ {
+ if (ordering == REQUIRE_ORDER)
+ return EOF;
+ optarg = argv[optind++];
+ return 1;
+ }
+
+ /* We have found another option-ARGV-element.
+ Skip the initial punctuation. */
+
+ nextchar = (argv[optind] + 1
+ + (longopts != NULL && argv[optind][1] == '-'));
+ }
+
+ /* Decode the current option-ARGV-element. */
+
+ /* Check whether the ARGV-element is a long option.
+
+ If long_only and the ARGV-element has the form "-f", where f is
+ a valid short option, don't consider it an abbreviated form of
+ a long option that starts with f. Otherwise there would be no
+ way to give the -f short option.
+
+ On the other hand, if there's a long option "fubar" and
+ the ARGV-element is "-fu", do consider that an abbreviation of
+ the long option, just like "--fu", and not "-f" with arg "u".
+
+ This distinction seems to be the most useful approach. */
+
+ if (longopts != NULL
+ && (argv[optind][1] == '-'
+ || (long_only && (argv[optind][2]
+ || !my_index (optstring, argv[optind][1])))))
+ {
+ char *nameend;
+ const struct option *p;
+ const struct option *pfound = NULL;
+ int exact = 0;
+ int ambig = 0;
+ int indfound;
+ int option_index;
+
+ for (nameend = nextchar; *nameend && *nameend != '='; nameend++)
+ /* Do nothing. */ ;
+
+ /* Test all long options for either exact match
+ or abbreviated matches. */
+ for (p = longopts, option_index = 0; p->name; p++, option_index++)
+ if (!strncmp (p->name, nextchar, nameend - nextchar))
+ {
+ if (nameend - nextchar == strlen (p->name))
+ {
+ /* Exact match found. */
+ pfound = p;
+ indfound = option_index;
+ exact = 1;
+ break;
+ }
+ else if (pfound == NULL)
+ {
+ /* First nonexact match found. */
+ pfound = p;
+ indfound = option_index;
+ }
+ else
+ /* Second or later nonexact match found. */
+ ambig = 1;
+ }
+
+ if (ambig && !exact)
+ {
+ if (opterr)
+ fprintf (stderr, _("%s: option `%s' is ambiguous\n"),
+ argv[0], argv[optind]);
+ nextchar += strlen (nextchar);
+ optind++;
+ return '?';
+ }
+
+ if (pfound != NULL)
+ {
+ option_index = indfound;
+ optind++;
+ if (*nameend)
+ {
+ /* Don't test has_arg with >, because some C compilers don't
+ allow it to be used on enums. */
+ if (pfound->has_arg)
+ optarg = nameend + 1;
+ else
+ {
+ if (opterr)
+ {
+ if (argv[optind - 1][1] == '-')
+ /* --option */
+ fprintf (stderr,
+ _("%s: option `--%s' doesn't allow an argument\n"),
+ argv[0], pfound->name);
+ else
+ /* +option or -option */
+ fprintf (stderr,
+ _("%s: option `%c%s' doesn't allow an argument\n"),
+ argv[0], argv[optind - 1][0], pfound->name);
+ }
+ nextchar += strlen (nextchar);
+ return '?';
+ }
+ }
+ else if (pfound->has_arg == 1)
+ {
+ if (optind < argc)
+ optarg = argv[optind++];
+ else
+ {
+ if (opterr)
+ fprintf (stderr, _("%s: option `%s' requires an argument\n"),
+ argv[0], argv[optind - 1]);
+ nextchar += strlen (nextchar);
+ return optstring[0] == ':' ? ':' : '?';
+ }
+ }
+ nextchar += strlen (nextchar);
+ if (longind != NULL)
+ *longind = option_index;
+ if (pfound->flag)
+ {
+ *(pfound->flag) = pfound->val;
+ return 0;
+ }
+ return pfound->val;
+ }
+
+ /* Can't find it as a long option. If this is not getopt_long_only,
+ or the option starts with '--' or is not a valid short
+ option, then it's an error.
+ Otherwise interpret it as a short option. */
+ if (!long_only || argv[optind][1] == '-'
+ || my_index (optstring, *nextchar) == NULL)
+ {
+ if (opterr)
+ {
+ if (argv[optind][1] == '-')
+ /* --option */
+ fprintf (stderr, _("%s: unrecognized option `--%s'\n"),
+ argv[0], nextchar);
+ else
+ /* +option or -option */
+ fprintf (stderr, _("%s: unrecognized option `%c%s'\n"),
+ argv[0], argv[optind][0], nextchar);
+ }
+ nextchar = (char *) "";
+ optind++;
+ return '?';
+ }
+ }
+
+ /* Look at and handle the next short option-character. */
+
+ {
+ char c = *nextchar++;
+ char *temp = my_index (optstring, c);
+
+ /* Increment `optind' when we start to process its last character. */
+ if (*nextchar == '\0')
+ ++optind;
+
+ if (temp == NULL || c == ':')
+ {
+ if (opterr)
+ {
+ if (posixly_correct)
+ /* 1003.2 specifies the format of this message. */
+ fprintf (stderr, _("%s: illegal option -- %c\n"), argv[0], c);
+ else
+ fprintf (stderr, _("%s: invalid option -- %c\n"), argv[0], c);
+ }
+ optopt = c;
+ return '?';
+ }
+ if (temp[1] == ':')
+ {
+ if (temp[2] == ':')
+ {
+ /* This is an option that accepts an argument optionally. */
+ if (*nextchar != '\0')
+ {
+ optarg = nextchar;
+ optind++;
+ }
+ else
+ optarg = NULL;
+ nextchar = NULL;
+ }
+ else
+ {
+ /* This is an option that requires an argument. */
+ if (*nextchar != '\0')
+ {
+ optarg = nextchar;
+ /* If we end this ARGV-element by taking the rest as an arg,
+ we must advance to the next element now. */
+ optind++;
+ }
+ else if (optind == argc)
+ {
+ if (opterr)
+ {
+ /* 1003.2 specifies the format of this message. */
+ fprintf (stderr, _("%s: option requires an argument -- %c\n"),
+ argv[0], c);
+ }
+ optopt = c;
+ if (optstring[0] == ':')
+ c = ':';
+ else
+ c = '?';
+ }
+ else
+ /* We already incremented `optind' once;
+ increment it again when taking next ARGV-elt as argument. */
+ optarg = argv[optind++];
+ nextchar = NULL;
+ }
+ }
+ return c;
+ }
+}
+
+int
+getopt (argc, argv, optstring)
+ int argc;
+ char *const *argv;
+ const char *optstring;
+{
+ return _getopt_internal (argc, argv, optstring,
+ (const struct option *) 0,
+ (int *) 0,
+ 0);
+}
+
+#endif /* _LIBC or not __GNU_LIBRARY__. */
+\f
+#ifdef TEST
+
+/* Compile with -DTEST to make an executable for use in testing
+ the above definition of `getopt'. */
+
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ int c;
+ int digit_optind = 0;
+
+ while (1)
+ {
+ int this_option_optind = optind ? optind : 1;
+
+ c = getopt (argc, argv, "abc:d:0123456789");
+ if (c == EOF)
+ break;
+
+ switch (c)
+ {
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ if (digit_optind != 0 && digit_optind != this_option_optind)
+ printf ("digits occur in two different argv-elements.\n");
+ digit_optind = this_option_optind;
+ printf ("option %c\n", c);
+ break;
+
+ case 'a':
+ printf ("option a\n");
+ break;
+
+ case 'b':
+ printf ("option b\n");
+ break;
+
+ case 'c':
+ printf ("option c with value `%s'\n", optarg);
+ break;
+
+ case '?':
+ break;
+
+ default:
+ printf ("?? getopt returned character code 0%o ??\n", c);
+ }
+ }
+
+ if (optind < argc)
+ {
+ printf ("non-option ARGV-elements: ");
+ while (optind < argc)
+ printf ("%s ", argv[optind++]);
+ printf ("\n");
+ }
+
+ exit (0);
+}
+
+#endif /* TEST */
--- /dev/null
+/* getopt_long and getopt_long_only entry points for GNU getopt.
+ Copyright (C) 1987, 88, 89, 90, 91, 92, 1993, 1994
+ Free Software Foundation, Inc.
+
+ This file is part of the GNU C Library. Its master source is NOT part of
+ the C library, however. The master source lives in /gd/gnu/lib.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with the GNU C Library; see the file COPYING.LIB. If
+ not, write to the Free Software Foundation, Inc., 675 Mass Ave,
+ Cambridge, MA 02139, USA. */
+\f
+/* This file has been modified from the GNU libc distribution. */
+#include <config.h>
+
+#include "getopt.h"
+
+#if !defined (__STDC__) || !__STDC__
+/* This is a separate conditional since some stdc systems
+ reject `defined (const)'. */
+#ifndef const
+#define const
+#endif
+#endif
+
+#include <stdio.h>
+
+/* Comment out all this code if we are using the GNU C Library, and are not
+ actually compiling the library itself. This code is part of the GNU C
+ Library, but also included in many other GNU distributions. Compiling
+ and linking in this code is a waste when using the GNU C library
+ (especially if it is a shared library). Rather than having every GNU
+ program understand `configure --with-gnu-libc' and omit the object files,
+ it is simpler to just do this in the source for each such file. */
+
+#if defined (_LIBC) || !defined (__GNU_LIBRARY__)
+
+
+/* This needs to come after some library #include
+ to get __GNU_LIBRARY__ defined. */
+#ifdef __GNU_LIBRARY__
+#include <stdlib.h>
+#else
+char *getenv ();
+#endif
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+int
+getopt_long (argc, argv, options, long_options, opt_index)
+ int argc;
+ char *const *argv;
+ const char *options;
+ const struct option *long_options;
+ int *opt_index;
+{
+ return _getopt_internal (argc, argv, options, long_options, opt_index, 0);
+}
+
+/* Like getopt_long, but '-' as well as '--' can indicate a long option.
+ If an option that starts with '-' (not '--') doesn't match a long option,
+ but does match a short option, it is parsed as a short option
+ instead. */
+
+int
+getopt_long_only (argc, argv, options, long_options, opt_index)
+ int argc;
+ char *const *argv;
+ const char *options;
+ const struct option *long_options;
+ int *opt_index;
+{
+ return _getopt_internal (argc, argv, options, long_options, opt_index, 1);
+}
+
+
+#endif /* _LIBC or not __GNU_LIBRARY__. */
+\f
+#ifdef TEST
+
+#include <stdio.h>
+
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ int c;
+ int digit_optind = 0;
+
+ while (1)
+ {
+ int this_option_optind = optind ? optind : 1;
+ int option_index = 0;
+ static struct option long_options[] =
+ {
+ {"add", 1, 0, 0},
+ {"append", 0, 0, 0},
+ {"delete", 1, 0, 0},
+ {"verbose", 0, 0, 0},
+ {"create", 0, 0, 0},
+ {"file", 1, 0, 0},
+ {0, 0, 0, 0}
+ };
+
+ c = getopt_long (argc, argv, "abc:d:0123456789",
+ long_options, &option_index);
+ if (c == EOF)
+ break;
+
+ switch (c)
+ {
+ case 0:
+ printf ("option %s", long_options[option_index].name);
+ if (optarg)
+ printf (" with arg %s", optarg);
+ printf ("\n");
+ break;
+
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ if (digit_optind != 0 && digit_optind != this_option_optind)
+ printf ("digits occur in two different argv-elements.\n");
+ digit_optind = this_option_optind;
+ printf ("option %c\n", c);
+ break;
+
+ case 'a':
+ printf ("option a\n");
+ break;
+
+ case 'b':
+ printf ("option b\n");
+ break;
+
+ case 'c':
+ printf ("option c with value `%s'\n", optarg);
+ break;
+
+ case 'd':
+ printf ("option d with value `%s'\n", optarg);
+ break;
+
+ case '?':
+ break;
+
+ default:
+ printf ("?? getopt returned character code 0%o ??\n", c);
+ }
+ }
+
+ if (optind < argc)
+ {
+ printf ("non-option ARGV-elements: ");
+ while (optind < argc)
+ printf ("%s ", argv[optind++]);
+ printf ("\n");
+ }
+
+ exit (0);
+}
+
+#endif /* TEST */
--- /dev/null
+/* Copyright (C) 1991, 1993 Free Software Foundation, Inc.
+ Based on strlen implemention by Torbjorn Granlund (tege@sics.se),
+ with help from Dan Sahlin (dan@sics.se) and
+ commentary by Jim Blandy (jimb@ai.mit.edu);
+ adaptation to memchr suggested by Dick Karpinski (dick@cca.ucsf.edu),
+ and implemented by Roland McGrath (roland@ai.mit.edu).
+
+NOTE: The canonical source of this file is maintained with the GNU C Library.
+Bugs can be reported to bug-glibc@prep.ai.mit.edu.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA. */
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#undef __ptr_t
+#if defined (__cplusplus) || (defined (__STDC__) && __STDC__)
+# define __ptr_t void *
+#else /* Not C++ or ANSI C. */
+# define __ptr_t char *
+#endif /* C++ or ANSI C. */
+
+#if defined (_LIBC)
+# include <string.h>
+#endif
+
+#if defined (HAVE_LIMITS_H) || defined (_LIBC)
+# include <limits.h>
+#endif
+
+#define LONG_MAX_32_BITS 2147483647
+
+#ifndef LONG_MAX
+#define LONG_MAX LONG_MAX_32_BITS
+#endif
+
+#include <sys/types.h>
+
+
+/* Search no more than N bytes of S for C. */
+
+__ptr_t
+memchr (s, c, n)
+ const __ptr_t s;
+ int c;
+ size_t n;
+{
+ const unsigned char *char_ptr;
+ const unsigned long int *longword_ptr;
+ unsigned long int longword, magic_bits, charmask;
+
+ c = (unsigned char) c;
+
+ /* Handle the first few characters by reading one character at a time.
+ Do this until CHAR_PTR is aligned on a longword boundary. */
+ for (char_ptr = (const unsigned char *) s;
+ n > 0 && ((unsigned long int) char_ptr
+ & (sizeof (longword) - 1)) != 0;
+ --n, ++char_ptr)
+ if (*char_ptr == c)
+ return (__ptr_t) char_ptr;
+
+ /* All these elucidatory comments refer to 4-byte longwords,
+ but the theory applies equally well to 8-byte longwords. */
+
+ longword_ptr = (unsigned long int *) char_ptr;
+
+ /* Bits 31, 24, 16, and 8 of this number are zero. Call these bits
+ the "holes." Note that there is a hole just to the left of
+ each byte, with an extra at the end:
+
+ bits: 01111110 11111110 11111110 11111111
+ bytes: AAAAAAAA BBBBBBBB CCCCCCCC DDDDDDDD
+
+ The 1-bits make sure that carries propagate to the next 0-bit.
+ The 0-bits provide holes for carries to fall into. */
+
+ if (sizeof (longword) != 4 && sizeof (longword) != 8)
+ abort ();
+
+#if LONG_MAX <= LONG_MAX_32_BITS
+ magic_bits = 0x7efefeff;
+#else
+ magic_bits = ((unsigned long int) 0x7efefefe << 32) | 0xfefefeff;
+#endif
+
+ /* Set up a longword, each of whose bytes is C. */
+ charmask = c | (c << 8);
+ charmask |= charmask << 16;
+#if LONG_MAX > LONG_MAX_32_BITS
+ charmask |= charmask << 32;
+#endif
+
+ /* Instead of the traditional loop which tests each character,
+ we will test a longword at a time. The tricky part is testing
+ if *any of the four* bytes in the longword in question are zero. */
+ while (n >= sizeof (longword))
+ {
+ /* We tentatively exit the loop if adding MAGIC_BITS to
+ LONGWORD fails to change any of the hole bits of LONGWORD.
+
+ 1) Is this safe? Will it catch all the zero bytes?
+ Suppose there is a byte with all zeros. Any carry bits
+ propagating from its left will fall into the hole at its
+ least significant bit and stop. Since there will be no
+ carry from its most significant bit, the LSB of the
+ byte to the left will be unchanged, and the zero will be
+ detected.
+
+ 2) Is this worthwhile? Will it ignore everything except
+ zero bytes? Suppose every byte of LONGWORD has a bit set
+ somewhere. There will be a carry into bit 8. If bit 8
+ is set, this will carry into bit 16. If bit 8 is clear,
+ one of bits 9-15 must be set, so there will be a carry
+ into bit 16. Similarly, there will be a carry into bit
+ 24. If one of bits 24-30 is set, there will be a carry
+ into bit 31, so all of the hole bits will be changed.
+
+ The one misfire occurs when bits 24-30 are clear and bit
+ 31 is set; in this case, the hole at bit 31 is not
+ changed. If we had access to the processor carry flag,
+ we could close this loophole by putting the fourth hole
+ at bit 32!
+
+ So it ignores everything except 128's, when they're aligned
+ properly.
+
+ 3) But wait! Aren't we looking for C, not zero?
+ Good point. So what we do is XOR LONGWORD with a longword,
+ each of whose bytes is C. This turns each byte that is C
+ into a zero. */
+
+ longword = *longword_ptr++ ^ charmask;
+
+ /* Add MAGIC_BITS to LONGWORD. */
+ if ((((longword + magic_bits)
+
+ /* Set those bits that were unchanged by the addition. */
+ ^ ~longword)
+
+ /* Look at only the hole bits. If any of the hole bits
+ are unchanged, most likely one of the bytes was a
+ zero. */
+ & ~magic_bits) != 0)
+ {
+ /* Which of the bytes was C? If none of them were, it was
+ a misfire; continue the search. */
+
+ const unsigned char *cp = (const unsigned char *) (longword_ptr - 1);
+
+ if (cp[0] == c)
+ return (__ptr_t) cp;
+ if (cp[1] == c)
+ return (__ptr_t) &cp[1];
+ if (cp[2] == c)
+ return (__ptr_t) &cp[2];
+ if (cp[3] == c)
+ return (__ptr_t) &cp[3];
+#if LONG_MAX > 2147483647
+ if (cp[4] == c)
+ return (__ptr_t) &cp[4];
+ if (cp[5] == c)
+ return (__ptr_t) &cp[5];
+ if (cp[6] == c)
+ return (__ptr_t) &cp[6];
+ if (cp[7] == c)
+ return (__ptr_t) &cp[7];
+#endif
+ }
+
+ n -= sizeof (longword);
+ }
+
+ char_ptr = (const unsigned char *) longword_ptr;
+
+ while (n-- > 0)
+ {
+ if (*char_ptr == c)
+ return (__ptr_t) char_ptr;
+ else
+ ++char_ptr;
+ }
+
+ return 0;
+}
--- /dev/null
+/* Copyright (C) 1991, 1993 Free Software Foundation, Inc.
+ Contributed by Torbjorn Granlund (tege@sics.se).
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with the GNU C Library; see the file COPYING.LIB. If
+ not, write to the Free Software Foundation, Inc., 675 Mass Ave,
+ Cambridge, MA 02139, USA. */
+
+#if HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+#undef __ptr_t
+#if defined (__cplusplus) || (defined (__STDC__) && __STDC__)
+#define __ptr_t void *
+#else /* Not C++ or ANSI C. */
+#undef const
+#define const
+#define __ptr_t char *
+#endif /* C++ or ANSI C. */
+
+#if defined (HAVE_STRING_H) || defined (_LIBC)
+#include <string.h>
+#endif
+
+#ifdef _LIBC
+
+#include <memcopy.h>
+
+#else /* Not in the GNU C library. */
+
+#include <sys/types.h>
+
+/* Type to use for aligned memory operations.
+ This should normally be the biggest type supported by a single load
+ and store. Must be an unsigned type. */
+#define op_t unsigned long int
+#define OPSIZ (sizeof(op_t))
+
+/* Threshold value for when to enter the unrolled loops. */
+#define OP_T_THRES 16
+
+/* Type to use for unaligned operations. */
+typedef unsigned char byte;
+
+#ifndef WORDS_BIGENDIAN
+#define MERGE(w0, sh_1, w1, sh_2) (((w0) >> (sh_1)) | ((w1) << (sh_2)))
+#else
+#define MERGE(w0, sh_1, w1, sh_2) (((w0) << (sh_1)) | ((w1) >> (sh_2)))
+#endif
+
+#endif /* In the GNU C library. */
+
+#ifdef WORDS_BIGENDIAN
+#define CMP_LT_OR_GT(a, b) ((a) > (b) ? 1 : -1)
+#else
+#define CMP_LT_OR_GT(a, b) memcmp_bytes ((a), (b))
+#endif
+
+/* BE VERY CAREFUL IF YOU CHANGE THIS CODE! */
+
+/* The strategy of this memcmp is:
+
+ 1. Compare bytes until one of the block pointers is aligned.
+
+ 2. Compare using memcmp_common_alignment or
+ memcmp_not_common_alignment, regarding the alignment of the other
+ block after the initial byte operations. The maximum number of
+ full words (of type op_t) are compared in this way.
+
+ 3. Compare the few remaining bytes. */
+
+#ifndef WORDS_BIGENDIAN
+/* memcmp_bytes -- Compare A and B bytewise in the byte order of the machine.
+ A and B are known to be different.
+ This is needed only on little-endian machines. */
+#ifdef __GNUC__
+__inline
+#endif
+static int
+memcmp_bytes (a, b)
+ op_t a, b;
+{
+ long int srcp1 = (long int) &a;
+ long int srcp2 = (long int) &b;
+ op_t a0, b0;
+
+ do
+ {
+ a0 = ((byte *) srcp1)[0];
+ b0 = ((byte *) srcp2)[0];
+ srcp1 += 1;
+ srcp2 += 1;
+ }
+ while (a0 == b0);
+ return a0 - b0;
+}
+#endif
+
+/* memcmp_common_alignment -- Compare blocks at SRCP1 and SRCP2 with LEN `op_t'
+ objects (not LEN bytes!). Both SRCP1 and SRCP2 should be aligned for
+ memory operations on `op_t's. */
+#ifdef __GNUC__
+__inline
+#endif
+static int
+memcmp_common_alignment (srcp1, srcp2, len)
+ long int srcp1;
+ long int srcp2;
+ size_t len;
+{
+ op_t a0, a1;
+ op_t b0, b1;
+
+ switch (len % 4)
+ {
+ case 2:
+ a0 = ((op_t *) srcp1)[0];
+ b0 = ((op_t *) srcp2)[0];
+ srcp1 -= 2 * OPSIZ;
+ srcp2 -= 2 * OPSIZ;
+ len += 2;
+ goto do1;
+ case 3:
+ a1 = ((op_t *) srcp1)[0];
+ b1 = ((op_t *) srcp2)[0];
+ srcp1 -= OPSIZ;
+ srcp2 -= OPSIZ;
+ len += 1;
+ goto do2;
+ case 0:
+ if (OP_T_THRES <= 3 * OPSIZ && len == 0)
+ return 0;
+ a0 = ((op_t *) srcp1)[0];
+ b0 = ((op_t *) srcp2)[0];
+ goto do3;
+ case 1:
+ a1 = ((op_t *) srcp1)[0];
+ b1 = ((op_t *) srcp2)[0];
+ srcp1 += OPSIZ;
+ srcp2 += OPSIZ;
+ len -= 1;
+ if (OP_T_THRES <= 3 * OPSIZ && len == 0)
+ goto do0;
+ /* Fall through. */
+ }
+
+ do
+ {
+ a0 = ((op_t *) srcp1)[0];
+ b0 = ((op_t *) srcp2)[0];
+ if (a1 != b1)
+ return CMP_LT_OR_GT (a1, b1);
+
+ do3:
+ a1 = ((op_t *) srcp1)[1];
+ b1 = ((op_t *) srcp2)[1];
+ if (a0 != b0)
+ return CMP_LT_OR_GT (a0, b0);
+
+ do2:
+ a0 = ((op_t *) srcp1)[2];
+ b0 = ((op_t *) srcp2)[2];
+ if (a1 != b1)
+ return CMP_LT_OR_GT (a1, b1);
+
+ do1:
+ a1 = ((op_t *) srcp1)[3];
+ b1 = ((op_t *) srcp2)[3];
+ if (a0 != b0)
+ return CMP_LT_OR_GT (a0, b0);
+
+ srcp1 += 4 * OPSIZ;
+ srcp2 += 4 * OPSIZ;
+ len -= 4;
+ }
+ while (len != 0);
+
+ /* This is the right position for do0. Please don't move
+ it into the loop. */
+do0:
+ if (a1 != b1)
+ return CMP_LT_OR_GT (a1, b1);
+ return 0;
+}
+
+/* memcmp_not_common_alignment -- Compare blocks at SRCP1 and SRCP2 with LEN
+ `op_t' objects (not LEN bytes!). SRCP2 should be aligned for memory
+ operations on `op_t', but SRCP1 *should be unaligned*. */
+#ifdef __GNUC__
+__inline
+#endif
+static int
+memcmp_not_common_alignment (srcp1, srcp2, len)
+ long int srcp1;
+ long int srcp2;
+ size_t len;
+{
+ op_t a0, a1, a2, a3;
+ op_t b0, b1, b2, b3;
+ op_t x;
+ int shl, shr;
+
+ /* Calculate how to shift a word read at the memory operation
+ aligned srcp1 to make it aligned for comparison. */
+
+ shl = 8 * (srcp1 % OPSIZ);
+ shr = 8 * OPSIZ - shl;
+
+ /* Make SRCP1 aligned by rounding it down to the beginning of the `op_t'
+ it points in the middle of. */
+ srcp1 &= -OPSIZ;
+
+ switch (len % 4)
+ {
+ case 2:
+ a1 = ((op_t *) srcp1)[0];
+ a2 = ((op_t *) srcp1)[1];
+ b2 = ((op_t *) srcp2)[0];
+ srcp1 -= 1 * OPSIZ;
+ srcp2 -= 2 * OPSIZ;
+ len += 2;
+ goto do1;
+ case 3:
+ a0 = ((op_t *) srcp1)[0];
+ a1 = ((op_t *) srcp1)[1];
+ b1 = ((op_t *) srcp2)[0];
+ srcp2 -= 1 * OPSIZ;
+ len += 1;
+ goto do2;
+ case 0:
+ if (OP_T_THRES <= 3 * OPSIZ && len == 0)
+ return 0;
+ a3 = ((op_t *) srcp1)[0];
+ a0 = ((op_t *) srcp1)[1];
+ b0 = ((op_t *) srcp2)[0];
+ srcp1 += 1 * OPSIZ;
+ goto do3;
+ case 1:
+ a2 = ((op_t *) srcp1)[0];
+ a3 = ((op_t *) srcp1)[1];
+ b3 = ((op_t *) srcp2)[0];
+ srcp1 += 2 * OPSIZ;
+ srcp2 += 1 * OPSIZ;
+ len -= 1;
+ if (OP_T_THRES <= 3 * OPSIZ && len == 0)
+ goto do0;
+ /* Fall through. */
+ }
+
+ do
+ {
+ a0 = ((op_t *) srcp1)[0];
+ b0 = ((op_t *) srcp2)[0];
+ x = MERGE (a2, shl, a3, shr);
+ if (x != b3)
+ return CMP_LT_OR_GT (x, b3);
+
+ do3:
+ a1 = ((op_t *) srcp1)[1];
+ b1 = ((op_t *) srcp2)[1];
+ x = MERGE (a3, shl, a0, shr);
+ if (x != b0)
+ return CMP_LT_OR_GT (x, b0);
+
+ do2:
+ a2 = ((op_t *) srcp1)[2];
+ b2 = ((op_t *) srcp2)[2];
+ x = MERGE (a0, shl, a1, shr);
+ if (x != b1)
+ return CMP_LT_OR_GT (x, b1);
+
+ do1:
+ a3 = ((op_t *) srcp1)[3];
+ b3 = ((op_t *) srcp2)[3];
+ x = MERGE (a1, shl, a2, shr);
+ if (x != b2)
+ return CMP_LT_OR_GT (x, b2);
+
+ srcp1 += 4 * OPSIZ;
+ srcp2 += 4 * OPSIZ;
+ len -= 4;
+ }
+ while (len != 0);
+
+ /* This is the right position for do0. Please don't move
+ it into the loop. */
+do0:
+ x = MERGE (a2, shl, a3, shr);
+ if (x != b3)
+ return CMP_LT_OR_GT (x, b3);
+ return 0;
+}
+
+int
+memcmp (s1, s2, len)
+ const __ptr_t s1;
+ const __ptr_t s2;
+ size_t len;
+{
+ op_t a0;
+ op_t b0;
+ long int srcp1 = (long int) s1;
+ long int srcp2 = (long int) s2;
+ op_t res;
+
+ if (len >= OP_T_THRES)
+ {
+ /* There are at least some bytes to compare. No need to test
+ for LEN == 0 in this alignment loop. */
+ while (srcp2 % OPSIZ != 0)
+ {
+ a0 = ((byte *) srcp1)[0];
+ b0 = ((byte *) srcp2)[0];
+ srcp1 += 1;
+ srcp2 += 1;
+ res = a0 - b0;
+ if (res != 0)
+ return res;
+ len -= 1;
+ }
+
+ /* SRCP2 is now aligned for memory operations on `op_t'.
+ SRCP1 alignment determines if we can do a simple,
+ aligned compare or need to shuffle bits. */
+
+ if (srcp1 % OPSIZ == 0)
+ res = memcmp_common_alignment (srcp1, srcp2, len / OPSIZ);
+ else
+ res = memcmp_not_common_alignment (srcp1, srcp2, len / OPSIZ);
+ if (res != 0)
+ return res;
+
+ /* Number of bytes remaining in the interval [0..OPSIZ-1]. */
+ srcp1 += len & -OPSIZ;
+ srcp2 += len & -OPSIZ;
+ len %= OPSIZ;
+ }
+
+ /* There are just a few bytes to compare. Use byte memory operations. */
+ while (len != 0)
+ {
+ a0 = ((byte *) srcp1)[0];
+ b0 = ((byte *) srcp2)[0];
+ srcp1 += 1;
+ srcp2 += 1;
+ res = a0 - b0;
+ if (res != 0)
+ return res;
+ len -= 1;
+ }
+
+ return 0;
+}
--- /dev/null
+/* Copy LEN bytes starting at SRCADDR to DESTADDR. Result undefined
+ if the source overlaps with the destination.
+ Return DESTADDR. */
+
+#if HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+char *
+memcpy (destaddr, srcaddr, len)
+ char *destaddr;
+ const char *srcaddr;
+ int len;
+{
+ char *dest = destaddr;
+
+ while (len-- > 0)
+ *destaddr++ = *srcaddr++;
+ return dest;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <stddef.h>
+
+int memcmp ();
+
+/* Finds the first NEEDLE of length NEEDLE_LEN in a HAYSTACK of length
+ HAYSTACK_LEN. Returns a pointer to the match or NULL on
+ failure. */
+void *
+memmem (const void *haystack, size_t haystack_len,
+ const void *needle, size_t needle_len)
+{
+ size_t i;
+
+ if (needle_len > haystack_len)
+ return NULL;
+
+ for (i = 0; i <= haystack_len - needle_len; i++)
+ if (!memcmp (needle, &((const char *) haystack)[i], needle_len))
+ return (void *) (&((const char *) haystack)[i]);
+
+ return NULL;
+}
+
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* Written by Tristan Gingold <gingold@email.enst.fr>. */
+
+void
+memmove (const char *src, char *dest, int len)
+{
+ if (dest < src)
+ while (len--)
+ *dest++ = *src++;
+ else
+ {
+ char *lasts = (char *)src + (len-1);
+ char *lastd = dest + (len-1);
+ while (len--)
+ *(char *)lastd-- = *(char *)lasts--;
+ }
+}
+
--- /dev/null
+/* memset.c -- set an area of memory to a given value
+ Copyright (C) 1991 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+char *
+memset (str, c, len)
+ char *str;
+ int c;
+ unsigned len;
+{
+ register char *st = str;
+
+ while (len-- > 0)
+ *st++ = c;
+ return str;
+}
--- /dev/null
+/* Copyright (C) 1991, 1992 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+ Written by Douglas C. Schmidt (schmidt@ics.uci.edu).
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with the GNU C Library; see the file COPYING.LIB. If
+ not, write to the Free Software Foundation, Inc., 675 Mass Ave,
+ Cambridge, MA 02139, USA. */
+
+/* Modified 12/15/96 by Ben Pfaff for PSPP. */
+
+#include <config.h>
+#include <stdlib.h>
+#include <string.h>
+#include "alloc.h"
+
+/* Byte-wise swap two items of size SIZE. */
+#define SWAP(a, b, size) \
+ do \
+ { \
+ register size_t __size = (size); \
+ register char *__a = (a), *__b = (b); \
+ do \
+ { \
+ char __tmp = *__a; \
+ *__a++ = *__b; \
+ *__b++ = __tmp; \
+ } while (--__size > 0); \
+ } while (0)
+
+/* Discontinue quicksort algorithm when partition gets below this size.
+ This particular magic number was chosen to work best on a Sun 4/260. */
+#define MAX_THRESH 4
+
+/* Stack node declarations used to store unfulfilled partition obligations. */
+typedef struct
+ {
+ char *lo;
+ char *hi;
+ }
+stack_node;
+
+/* The next 4 #defines implement a very fast in-line stack abstraction. */
+#define STACK_SIZE (8 * sizeof(unsigned long int))
+#define PUSH(low, high) ((void) ((top->lo = (low)), (top->hi = (high)), ++top))
+#define POP(low, high) ((void) (--top, (low = top->lo), (high = top->hi)))
+#define STACK_NOT_EMPTY (stack < top)
+
+
+/* Order size using quicksort. This implementation incorporates
+ four optimizations discussed in Sedgewick:
+
+ 1. Non-recursive, using an explicit stack of pointer that store the
+ next array partition to sort. To save time, this maximum amount
+ of space required to store an array of MAX_INT is allocated on the
+ stack. Assuming a 32-bit integer, this needs only 32 *
+ sizeof(stack_node) == 136 bits. Pretty cheap, actually.
+
+ 2. Chose the pivot element using a median-of-three decision tree.
+ This reduces the probability of selecting a bad pivot value and
+ eliminates certain extraneous comparisons.
+
+ 3. Only quicksorts TOTAL_ELEMS / MAX_THRESH partitions, leaving
+ insertion sort to order the MAX_THRESH items within each partition.
+ This is a big win, since insertion sort is faster for small, mostly
+ sorted array segements.
+
+ 4. The larger of the two sub-partitions is always pushed onto the
+ stack first, with the algorithm then concentrating on the
+ smaller partition. This *guarantees* no more than log (n)
+ stack size is needed (actually O(1) in this case)! */
+
+void
+blp_quicksort (void *pbase, size_t total_elems, size_t size,
+ int (*cmp) (const void *, const void *),
+ void *temp_buf
+#if HAVE_ALLOCA
+ unused
+#endif
+ )
+{
+ register char *base_ptr = (char *) pbase;
+
+ /* Allocating SIZE bytes for a pivot buffer facilitates a better
+ algorithm below since we can do comparisons directly on the pivot. */
+#if HAVE_ALLOCA
+ char *pivot_buffer = (char *) local_alloc (size);
+#else
+ char *pivot_buffer = temp_buf;
+#endif
+ const size_t max_thresh = MAX_THRESH * size;
+
+ if (total_elems == 0)
+ {
+ /* Avoid lossage with unsigned arithmetic below. */
+ local_free (pivot_buffer);
+ return;
+ }
+
+ if (total_elems > MAX_THRESH)
+ {
+ char *lo = base_ptr;
+ char *hi = &lo[size * (total_elems - 1)];
+ /* Largest size needed for 32-bit int!!! */
+ stack_node stack[STACK_SIZE];
+ stack_node *top = stack + 1;
+
+ while (STACK_NOT_EMPTY)
+ {
+ char *left_ptr;
+ char *right_ptr;
+
+ char *pivot = pivot_buffer;
+
+ /* Select median value from among LO, MID, and HI. Rearrange
+ LO and HI so the three values are sorted. This lowers the
+ probability of picking a pathological pivot value and
+ skips a comparison for both the LEFT_PTR and RIGHT_PTR. */
+
+ char *mid = lo + size * ((hi - lo) / size >> 1);
+
+ if ((*cmp) ((void *) mid, (void *) lo) < 0)
+ SWAP (mid, lo, size);
+ if ((*cmp) ((void *) hi, (void *) mid) < 0)
+ SWAP (mid, hi, size);
+ else
+ goto jump_over;
+ if ((*cmp) ((void *) mid, (void *) lo) < 0)
+ SWAP (mid, lo, size);
+ jump_over:;
+ memcpy (pivot, mid, size);
+ pivot = pivot_buffer;
+
+ left_ptr = lo + size;
+ right_ptr = hi - size;
+
+ /* Here's the famous ``collapse the walls'' section of quicksort.
+ Gotta like those tight inner loops! They are the main reason
+ that this algorithm runs much faster than others. */
+ do
+ {
+ while ((*cmp) ((void *) left_ptr, (void *) pivot) < 0)
+ left_ptr += size;
+
+ while ((*cmp) ((void *) pivot, (void *) right_ptr) < 0)
+ right_ptr -= size;
+
+ if (left_ptr < right_ptr)
+ {
+ SWAP (left_ptr, right_ptr, size);
+ left_ptr += size;
+ right_ptr -= size;
+ }
+ else if (left_ptr == right_ptr)
+ {
+ left_ptr += size;
+ right_ptr -= size;
+ break;
+ }
+ }
+ while (left_ptr <= right_ptr);
+
+ /* Set up pointers for next iteration. First determine whether
+ left and right partitions are below the threshold size. If so,
+ ignore one or both. Otherwise, push the larger partition's
+ bounds on the stack and continue sorting the smaller one. */
+
+ if ((size_t) (right_ptr - lo) <= max_thresh)
+ {
+ if ((size_t) (hi - left_ptr) <= max_thresh)
+ /* Ignore both small partitions. */
+ POP (lo, hi);
+ else
+ /* Ignore small left partition. */
+ lo = left_ptr;
+ }
+ else if ((size_t) (hi - left_ptr) <= max_thresh)
+ /* Ignore small right partition. */
+ hi = right_ptr;
+ else if ((right_ptr - lo) > (hi - left_ptr))
+ {
+ /* Push larger left partition indices. */
+ PUSH (lo, right_ptr);
+ lo = left_ptr;
+ }
+ else
+ {
+ /* Push larger right partition indices. */
+ PUSH (left_ptr, hi);
+ hi = right_ptr;
+ }
+ }
+ }
+
+ /* Once the BASE_PTR array is partially sorted by quicksort the rest
+ is completely sorted using insertion sort, since this is efficient
+ for partitions below MAX_THRESH size. BASE_PTR points to the beginning
+ of the array to sort, and END_PTR points at the very last element in
+ the array (*not* one beyond it!). */
+
+#define min(x, y) ((x) < (y) ? (x) : (y))
+
+ {
+ char *const end_ptr = &base_ptr[size * (total_elems - 1)];
+ char *tmp_ptr = base_ptr;
+ char *thresh = min (end_ptr, base_ptr + max_thresh);
+ register char *run_ptr;
+
+ /* Find smallest element in first threshold and place it at the
+ array's beginning. This is the smallest array element,
+ and the operation speeds up insertion sort's inner loop. */
+
+ for (run_ptr = tmp_ptr + size; run_ptr <= thresh; run_ptr += size)
+ if ((*cmp) ((void *) run_ptr, (void *) tmp_ptr) < 0)
+ tmp_ptr = run_ptr;
+
+ if (tmp_ptr != base_ptr)
+ SWAP (tmp_ptr, base_ptr, size);
+
+ /* Insertion sort, running from left-hand-side up to right-hand-side. */
+
+ run_ptr = base_ptr + size;
+ while ((run_ptr += size) <= end_ptr)
+ {
+ tmp_ptr = run_ptr - size;
+ while ((*cmp) ((void *) run_ptr, (void *) tmp_ptr) < 0)
+ tmp_ptr -= size;
+
+ tmp_ptr += size;
+ if (tmp_ptr != run_ptr)
+ {
+ char *trav;
+
+ trav = run_ptr + size;
+ while (--trav >= run_ptr)
+ {
+ char c = *trav;
+ char *hi, *lo;
+
+ for (hi = lo = trav; (lo -= size) >= tmp_ptr; hi = lo)
+ *hi = *lo;
+ *hi = c;
+ }
+ }
+ }
+ }
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <stddef.h>
+
+/* Some old versions of Linux libc prototype stpcpy() in string.h but
+ fail to include it in their C library. By not including string.h
+ on these systems we can avoid conflicting prototypes. Of course,
+ in theory this might be dangerous, if the prototype specifies some
+ weird calling convention, but for GNU/Linux at least it shouldn't
+ cause problems.
+
+ This might be needed for systems other than GNU/Linux; let me
+ know. */
+
+#ifdef __linux__
+void *memcpy (void *, const void *, size_t);
+size_t strlen (const char *);
+#else
+#include "str.h"
+#endif
+
+/* Copies SRC to DEST, returning the address of the terminating '\0'
+ in DEST. */
+char *
+stpcpy (char *dest, const char *src)
+{
+ int len = strlen (src);
+ memcpy (dest, src, len + 1);
+ return &dest[len];
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <ctype.h>
+
+int
+strcasecmp (const char *s1, const char *s2)
+{
+ for (;;)
+ {
+ if (!*s1 || !*s2
+ || tolower ((unsigned char) *s1) != tolower ((unsigned char) *s2))
+ return (unsigned char) *s1 - (unsigned char) *s2;
+ s1++;
+ s2++;
+ }
+}
--- /dev/null
+/* A replacement version of strerror
+
+ Copyright (C) 1996 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2, or (at
+ your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#include <stdio.h>
+#ifdef HAVE_ERRNO_H
+#include <errno.h>
+#endif
+
+#if defined (HAVE_SYS_ERRLIST) && !defined (HAVE_SYS_ERRLIST_DECL)
+extern int sys_nerr;
+extern char *sys_errlist[];
+#endif
+
+/* Return a string describing the system error code ERR. The returned value
+ may be in a static buffer (and in any case shouldn't be written to). */
+const char *
+strerror (int err)
+{
+#ifdef HAVE_SYS_ERRLIST
+ if (err >= 0 && err < sys_nerr && sys_errlist[err])
+ return sys_errlist[err];
+ else
+#endif
+ {
+ static char buf[100];
+ sprintf (buf, "Error %d", err);
+ return buf;
+ }
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <ctype.h>
+
+int
+strncasecmp (const char *s1, const char *s2, size_t n)
+{
+ size_t index;
+
+ for (index = 0; index < n; index++)
+ {
+ if (tolower ((unsigned char) s1[index])
+ != tolower ((unsigned char) s2[index]))
+ return (((unsigned const char *)s1)[index]
+ - ((unsigned const char *)s2)[index]);
+ if (s1[index] == 0)
+ return 0;
+ }
+ return 0;
+}
--- /dev/null
+/* Copyright (C) 1991, 1994, 1996 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with the GNU C Library; see the file COPYING.LIB. If not,
+ write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+#include <string.h>
+
+
+/* Find the first occurrence in S of any character in ACCEPT. */
+char *
+strpbrk (s, accept)
+ const char *s;
+ const char *accept;
+{
+ while (*s != '\0')
+ {
+ const char *a = accept;
+ while (*a != '\0')
+ if (*a++ == *s)
+ return (char *) s;
+ ++s;
+ }
+
+ return NULL;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+char *
+strstr (const char *haystack, const char *needle)
+{
+ return memmem (haystack, strlen (haystack), needle, strlen (needle));
+}
--- /dev/null
+/* Reentrant string tokenizer. Generic version.
+Copyright (C) 1991, 1996 Free Software Foundation, Inc.
+This file is part of the GNU C Library.
+
+The GNU C Library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public License as
+published by the Free Software Foundation; either version 2 of the
+License, or (at your option) any later version.
+
+The GNU C Library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with the GNU C Library; see the file COPYING.LIB. If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+#include <string.h>
+
+
+/* Parse S into tokens separated by characters in DELIM.
+ If S is NULL, the saved pointer in SAVE_PTR is used as
+ the next starting point. For example:
+ char s[] = "-abc-=-def";
+ char *sp;
+ x = strtok_r(s, "-", &sp); // x = "abc", sp = "=-def"
+ x = strtok_r(NULL, "-=", &sp); // x = "def", sp = NULL
+ x = strtok_r(NULL, "=", &sp); // x = NULL
+ // s = "abc\0-def\0"
+*/
+char *
+strtok_r (s, delim, save_ptr)
+ char *s;
+ const char *delim;
+ char **save_ptr;
+{
+ char *token;
+
+ if (s == NULL)
+ s = *save_ptr;
+
+ /* Scan leading delimiters. */
+ s += strspn (s, delim);
+ if (*s == '\0')
+ return NULL;
+
+ /* Find the end of the token. */
+ token = s;
+ s = strpbrk (token, delim);
+ if (s == NULL)
+ /* This token finishes the string. */
+ *save_ptr = strchr (token, '\0');
+ else
+ {
+ /* Terminate the token and make *SAVE_PTR point past it. */
+ *s = '\0';
+ *save_ptr = s + 1;
+ }
+ return token;
+}
--- /dev/null
+/* strtol - Convert string representation of a number into an integer value.
+ Copyright (C) 1991, 92, 94, 95, 96 Free Software Foundation, Inc.
+ NOTE: The canonical source of this file is maintained with the GNU C
+ Library. Bugs can be reported to bug-glibc@prep.ai.mit.edu.
+
+ This program is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by the
+ Free Software Foundation; either version 2, or (at your option) any
+ later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#if HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#ifdef _LIBC
+# define USE_NUMBER_GROUPING
+# define STDC_HEADERS
+# define HAVE_LIMITS_H
+#endif
+
+#include <ctype.h>
+#include <errno.h>
+#ifndef errno
+extern int errno;
+#endif
+#ifndef __set_errno
+# define __set_errno(Val) errno = (Val)
+#endif
+
+#ifdef HAVE_LIMITS_H
+# include <limits.h>
+#endif
+
+#ifdef STDC_HEADERS
+# include <stddef.h>
+# include <stdlib.h>
+# include <string.h>
+#else
+# ifndef NULL
+# define NULL 0
+# endif
+#endif
+
+#ifdef USE_NUMBER_GROUPING
+# include "../locale/localeinfo.h"
+#endif
+
+/* Nonzero if we are defining `strtoul' or `strtouq', operating on
+ unsigned integers. */
+#ifndef UNSIGNED
+# define UNSIGNED 0
+# define INT LONG int
+#else
+# define INT unsigned LONG int
+#endif
+
+/* Determine the name. */
+#if UNSIGNED
+# ifdef USE_WIDE_CHAR
+# ifdef QUAD
+# define strtol wcstouq
+# else
+# define strtol wcstoul
+# endif
+# else
+# ifdef QUAD
+# define strtol strtouq
+# else
+# define strtol strtoul
+# endif
+# endif
+#else
+# ifdef USE_WIDE_CHAR
+# ifdef QUAD
+# define strtol wcstoq
+# else
+# define strtol wcstol
+# endif
+# else
+# ifdef QUAD
+# define strtol strtoq
+# endif
+# endif
+#endif
+
+/* If QUAD is defined, we are defining `strtoq' or `strtouq',
+ operating on `long long int's. */
+#ifdef QUAD
+# define LONG long long
+# undef LONG_MIN
+# define LONG_MIN LONG_LONG_MIN
+# undef LONG_MAX
+# define LONG_MAX LONG_LONG_MAX
+# undef ULONG_MAX
+# define ULONG_MAX ULONG_LONG_MAX
+# if __GNUC__ == 2 && __GNUC_MINOR__ < 7
+ /* Work around gcc bug with using this constant. */
+ static const unsigned long long int maxquad = ULONG_LONG_MAX;
+# undef ULONG_MAX
+# define ULONG_MAX maxquad
+# endif
+#else
+# define LONG long
+
+#ifndef ULONG_MAX
+# define ULONG_MAX ((unsigned long) ~(unsigned long) 0)
+#endif
+#ifndef LONG_MAX
+# define LONG_MAX ((long int) (ULONG_MAX >> 1))
+#endif
+#endif
+
+#ifdef USE_WIDE_CHAR
+# include <wchar.h>
+# include <wctype.h>
+# define L_(Ch) L##Ch
+# define UCHAR_TYPE wint_t
+# define STRING_TYPE wchar_t
+# define ISSPACE(Ch) iswspace (Ch)
+# define ISALPHA(Ch) iswalpha (Ch)
+# define TOUPPER(Ch) towupper (Ch)
+#else
+# define L_(Ch) Ch
+# define UCHAR_TYPE unsigned char
+# define STRING_TYPE char
+# define ISSPACE(Ch) isspace (Ch)
+# define ISALPHA(Ch) isalpha (Ch)
+# define TOUPPER(Ch) toupper (Ch)
+#endif
+
+#ifdef __STDC__
+# define INTERNAL(X) INTERNAL1(X)
+# define INTERNAL1(X) __##X##_internal
+# define WEAKNAME(X) WEAKNAME1(X)
+#else
+# define INTERNAL(X) __/**/X/**/_internal
+#endif
+
+#ifdef USE_NUMBER_GROUPING
+/* This file defines a function to check for correct grouping. */
+# include "grouping.h"
+#endif
+
+
+/* Convert NPTR to an `unsigned long int' or `long int' in base BASE.
+ If BASE is 0 the base is determined by the presence of a leading
+ zero, indicating octal or a leading "0x" or "0X", indicating hexadecimal.
+ If BASE is < 2 or > 36, it is reset to 10.
+ If ENDPTR is not NULL, a pointer to the character after the last
+ one converted is stored in *ENDPTR. */
+
+INT
+INTERNAL (strtol) (nptr, endptr, base, group)
+ const STRING_TYPE *nptr;
+ STRING_TYPE **endptr;
+ int base;
+ int group;
+{
+ int negative;
+ register unsigned LONG int cutoff;
+ register unsigned int cutlim;
+ register unsigned LONG int i;
+ register const STRING_TYPE *s;
+ register UCHAR_TYPE c;
+ const STRING_TYPE *save, *end;
+ int overflow;
+
+#ifdef USE_NUMBER_GROUPING
+ /* The thousands character of the current locale. */
+ wchar_t thousands;
+ /* The numeric grouping specification of the current locale,
+ in the format described in <locale.h>. */
+ const char *grouping;
+
+ if (group)
+ {
+ grouping = _NL_CURRENT (LC_NUMERIC, GROUPING);
+ if (*grouping <= 0 || *grouping == CHAR_MAX)
+ grouping = NULL;
+ else
+ {
+ /* Figure out the thousands separator character. */
+ if (mbtowc (&thousands, _NL_CURRENT (LC_NUMERIC, THOUSANDS_SEP),
+ strlen (_NL_CURRENT (LC_NUMERIC, THOUSANDS_SEP))) <= 0)
+ thousands = (wchar_t) *_NL_CURRENT (LC_NUMERIC, THOUSANDS_SEP);
+ if (thousands == L'\0')
+ grouping = NULL;
+ }
+ }
+ else
+ grouping = NULL;
+#endif
+
+ if (base < 0 || base == 1 || base > 36)
+ base = 10;
+
+ save = s = nptr;
+
+ /* Skip white space. */
+ while (ISSPACE (*s))
+ ++s;
+ if (*s == L_('\0'))
+ goto noconv;
+
+ /* Check for a sign. */
+ if (*s == L_('-'))
+ {
+ negative = 1;
+ ++s;
+ }
+ else if (*s == L_('+'))
+ {
+ negative = 0;
+ ++s;
+ }
+ else
+ negative = 0;
+
+ if (base == 16 && s[0] == L_('0') && TOUPPER (s[1]) == L_('X'))
+ s += 2;
+
+ /* If BASE is zero, figure it out ourselves. */
+ if (base == 0)
+ if (*s == L_('0'))
+ {
+ if (TOUPPER (s[1]) == L_('X'))
+ {
+ s += 2;
+ base = 16;
+ }
+ else
+ base = 8;
+ }
+ else
+ base = 10;
+
+ /* Save the pointer so we can check later if anything happened. */
+ save = s;
+
+#ifdef USE_NUMBER_GROUPING
+ if (group)
+ {
+ /* Find the end of the digit string and check its grouping. */
+ end = s;
+ for (c = *end; c != L_('\0'); c = *++end)
+ if ((wchar_t) c != thousands
+ && ((wchar_t) c < L_('0') || (wchar_t) c > L_('9'))
+ && (!ISALPHA (c) || (int) (TOUPPER (c) - L_('A') + 10) >= base))
+ break;
+ if (*s == thousands)
+ end = s;
+ else
+ end = correctly_grouped_prefix (s, end, thousands, grouping);
+ }
+ else
+#endif
+ end = NULL;
+
+ cutoff = ULONG_MAX / (unsigned LONG int) base;
+ cutlim = ULONG_MAX % (unsigned LONG int) base;
+
+ overflow = 0;
+ i = 0;
+ for (c = *s; c != L_('\0'); c = *++s)
+ {
+ if (s == end)
+ break;
+ if (c >= L_('0') && c <= L_('9'))
+ c -= L_('0');
+ else if (ISALPHA (c))
+ c = TOUPPER (c) - L_('A') + 10;
+ else
+ break;
+ if ((int) c >= base)
+ break;
+ /* Check for overflow. */
+ if (i > cutoff || (i == cutoff && c > cutlim))
+ overflow = 1;
+ else
+ {
+ i *= (unsigned LONG int) base;
+ i += c;
+ }
+ }
+
+ /* Check if anything actually happened. */
+ if (s == save)
+ goto noconv;
+
+ /* Store in ENDPTR the address of one character
+ past the last character we converted. */
+ if (endptr != NULL)
+ *endptr = (STRING_TYPE *) s;
+
+#if !UNSIGNED
+ /* Check for a value that is within the range of
+ `unsigned LONG int', but outside the range of `LONG int'. */
+ if (overflow == 0
+ && i > (negative
+ ? -((unsigned LONG int) (LONG_MIN + 1)) + 1
+ : (unsigned LONG int) LONG_MAX))
+ overflow = 1;
+#endif
+
+ if (overflow)
+ {
+ __set_errno (ERANGE);
+#if UNSIGNED
+ return ULONG_MAX;
+#else
+ return negative ? LONG_MIN : LONG_MAX;
+#endif
+ }
+
+ /* Return the result of the appropriate sign. */
+ return (negative ? -i : i);
+
+noconv:
+ /* We must handle a special case here: the base is 0 or 16 and the
+ first two characters are '0' and 'x', but the rest are no
+ hexadecimal digits. This is no error case. We return 0 and
+ ENDPTR points to the `x`. */
+ if (endptr != NULL)
+ if (save - nptr >= 2 && TOUPPER (save[-1]) == L_('X')
+ && save[-2] == L_('0'))
+ *endptr = (STRING_TYPE *) &save[-1];
+ else
+ /* There was no number to convert. */
+ *endptr = (STRING_TYPE *) nptr;
+
+ return 0L;
+}
+\f
+/* External user entry point. */
+
+#if _LIBC - 0 == 0
+# undef PARAMS
+# if defined (__STDC__) && __STDC__
+# define PARAMS(Args) Args
+# else
+# define PARAMS(Args) ()
+# endif
+
+/* Prototype. */
+INT strtol PARAMS ((const STRING_TYPE *nptr, STRING_TYPE **endptr, int base));
+#endif
+
+
+INT
+#ifdef weak_function
+weak_function
+#endif
+strtol (nptr, endptr, base)
+ const STRING_TYPE *nptr;
+ STRING_TYPE **endptr;
+ int base;
+{
+ return INTERNAL (strtol) (nptr, endptr, base, 0);
+}
--- /dev/null
+/* Copyright (C) 1991 Free Software Foundation, Inc.
+
+NOTE: The canonical source of this file is maintained with the GNU C Library.
+Bugs can be reported to bug-glibc@prep.ai.mit.edu.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#define UNSIGNED 1
+
+#include <strtol.c>
--- /dev/null
+Sat Jan 1 23:27:03 2000 Ben Pfaff <blp@gnu.org>
+
+ * POTFILES.in: Update.
+
+Thu Jan 8 22:27:38 1998 Ben Pfaff <blp@gnu.org>
+
+ * POTFILES.in: Recreate.
+
+ * Makefile.in.in: Upcase `pspp' within maintainer-clean target.
+
+Tue Dec 2 14:35:47 1997 Ben Pfaff <blp@gnu.org>
+
+ * POTFILES.in: Add src/aggregate.c; alphabetize.
+
+Wed Oct 8 15:53:13 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.in.in: Updated to gettext-0.10.32 while retaining local
+ fixes.
+
+Tue Oct 7 20:22:25 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.in.in: Maintainer-cleans Makefile.
+
+Thu Jul 17 01:51:23 1997 Ben Pfaff <blp@gnu.org>
+
+ * POTFILES.in: Remove src/display.c.
+
+Sat Jul 5 23:44:30 1997 Ben Pfaff <blp@gnu.org>
+
+ * POTFILES.in: Fix file list.
+
+Tue Jun 3 23:29:57 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.in.in: Maintainer-cleans fiasco.pot.
+
+Mon Jun 2 14:22:59 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.in.in: Maintainer-cleans cat-id-tbl.c, stamp-cat-id.
+
+ * POTFILES.in: Added all the files that have internationalized
+ strings; basically this is `grep -l `find . -name \*.[qc]`'.
+
+Sun Jun 1 23:36:32 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.in.in: New file, taken from gettext-0.10.27.
+
+ * POTFILES.in: New file (empty).
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+# Makefile for program source directory in GNU NLS utilities package.
+# Copyright (C) 1995, 1996, 1997 by Ulrich Drepper <drepper@gnu.org>
+#
+# This file file be copied and used freely without restrictions. It can
+# be used in projects which are not available under the GNU Public License
+# but which still want to provide support for the GNU gettext functionality.
+# Please note that the actual code is *not* freely available.
+
+PACKAGE = @PACKAGE@
+VERSION = @VERSION@
+
+SHELL = /bin/sh
+@SET_MAKE@
+
+srcdir = @srcdir@
+top_srcdir = @top_srcdir@
+VPATH = @srcdir@
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+datadir = $(prefix)/@DATADIRNAME@
+localedir = $(datadir)/locale
+gnulocaledir = $(prefix)/share/locale
+gettextsrcdir = $(prefix)/share/gettext/po
+subdir = po
+
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+MKINSTALLDIRS = $(top_srcdir)/@MKINSTALLDIRS@
+
+CC = @CC@
+GENCAT = @GENCAT@
+GMSGFMT = PATH=../src:$$PATH @GMSGFMT@
+MSGFMT = @MSGFMT@
+XGETTEXT = PATH=../src:$$PATH @XGETTEXT@
+MSGMERGE = PATH=../src:$$PATH msgmerge
+
+DEFS = @DEFS@
+CFLAGS = @CFLAGS@
+CPPFLAGS = @CPPFLAGS@
+
+INCLUDES = -I.. -I$(top_srcdir)/intl
+
+COMPILE = $(CC) -c $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $(XCFLAGS)
+
+SOURCES = cat-id-tbl.c
+POFILES = @POFILES@
+GMOFILES = @GMOFILES@
+DISTFILES = ChangeLog Makefile.in.in POTFILES.in $(PACKAGE).pot \
+stamp-cat-id $(POFILES) $(GMOFILES) $(SOURCES)
+
+POTFILES = \
+
+CATALOGS = @CATALOGS@
+CATOBJEXT = @CATOBJEXT@
+INSTOBJEXT = @INSTOBJEXT@
+
+.SUFFIXES:
+.SUFFIXES: .c .o .po .pox .gmo .mo .msg .cat
+
+.c.o:
+ $(COMPILE) $<
+
+.po.pox:
+ $(MAKE) $(PACKAGE).pot
+ $(MSGMERGE) $< $(srcdir)/$(PACKAGE).pot -o $*.pox
+
+.po.mo:
+ $(MSGFMT) -o $@ $<
+
+.po.gmo:
+ file=$(srcdir)/`echo $* | sed 's,.*/,,'`.gmo \
+ && rm -f $$file && $(GMSGFMT) -o $$file $<
+
+.po.cat:
+ sed -f ../intl/po2msg.sed < $< > $*.msg \
+ && rm -f $@ && $(GENCAT) $@ $*.msg
+
+
+all: all-@USE_NLS@
+
+all-yes: cat-id-tbl.c $(CATALOGS)
+all-no:
+
+$(srcdir)/$(PACKAGE).pot: $(POTFILES)
+ $(XGETTEXT) --default-domain=$(PACKAGE) --directory=$(top_srcdir) \
+ --add-comments --keyword=_ --keyword=N_ \
+ --files-from=$(srcdir)/POTFILES.in
+ rm -f $(srcdir)/$(PACKAGE).pot
+ mv $(PACKAGE).po $(srcdir)/$(PACKAGE).pot
+
+$(srcdir)/cat-id-tbl.c: stamp-cat-id; @:
+$(srcdir)/stamp-cat-id: $(PACKAGE).pot
+ rm -f cat-id-tbl.tmp
+ sed -f ../intl/po2tbl.sed $(srcdir)/$(PACKAGE).pot \
+ | sed -e "s/@PACKAGE NAME@/$(PACKAGE)/" > cat-id-tbl.tmp
+ if cmp -s cat-id-tbl.tmp $(srcdir)/cat-id-tbl.c; then \
+ rm cat-id-tbl.tmp; \
+ else \
+ echo cat-id-tbl.c changed; \
+ rm -f $(srcdir)/cat-id-tbl.c; \
+ mv cat-id-tbl.tmp $(srcdir)/cat-id-tbl.c; \
+ fi
+ cd $(srcdir) && rm -f stamp-cat-id && echo timestamp > stamp-cat-id
+
+
+install: install-exec install-data
+install-exec:
+install-data: install-data-@USE_NLS@
+install-data-no: all
+install-data-yes: all
+ if test -r $(MKINSTALLDIRS); then \
+ $(MKINSTALLDIRS) $(datadir); \
+ else \
+ $(top_srcdir)/mkinstalldirs $(datadir); \
+ fi
+ @catalogs='$(CATALOGS)'; \
+ for cat in $$catalogs; do \
+ cat=`basename $$cat`; \
+ case "$$cat" in \
+ *.gmo) destdir=$(gnulocaledir);; \
+ *) destdir=$(localedir);; \
+ esac; \
+ lang=`echo $$cat | sed 's/\$(CATOBJEXT)$$//'`; \
+ dir=$$destdir/$$lang/LC_MESSAGES; \
+ if test -r $(MKINSTALLDIRS); then \
+ $(MKINSTALLDIRS) $$dir; \
+ else \
+ $(top_srcdir)/mkinstalldirs $$dir; \
+ fi; \
+ if test -r $$cat; then \
+ $(INSTALL_DATA) $$cat $$dir/$(PACKAGE)$(INSTOBJEXT); \
+ echo "installing $$cat as $$dir/$(PACKAGE)$(INSTOBJEXT)"; \
+ else \
+ $(INSTALL_DATA) $(srcdir)/$$cat $$dir/$(PACKAGE)$(INSTOBJEXT); \
+ echo "installing $(srcdir)/$$cat as" \
+ "$$dir/$(PACKAGE)$(INSTOBJEXT)"; \
+ fi; \
+ if test -r $$cat.m; then \
+ $(INSTALL_DATA) $$cat.m $$dir/$(PACKAGE)$(INSTOBJEXT).m; \
+ echo "installing $$cat.m as $$dir/$(PACKAGE)$(INSTOBJEXT).m"; \
+ else \
+ if test -r $(srcdir)/$$cat.m ; then \
+ $(INSTALL_DATA) $(srcdir)/$$cat.m \
+ $$dir/$(PACKAGE)$(INSTOBJEXT).m; \
+ echo "installing $(srcdir)/$$cat as" \
+ "$$dir/$(PACKAGE)$(INSTOBJEXT).m"; \
+ else \
+ true; \
+ fi; \
+ fi; \
+ done
+ if test "$(PACKAGE)" = "gettext"; then \
+ if test -r $(MKINSTALLDIRS); then \
+ $(MKINSTALLDIRS) $(gettextsrcdir); \
+ else \
+ $(top_srcdir)/mkinstalldirs $(gettextsrcdir); \
+ fi; \
+ $(INSTALL_DATA) $(srcdir)/Makefile.in.in \
+ $(gettextsrcdir)/Makefile.in.in; \
+ else \
+ : ; \
+ fi
+
+# Define this as empty until I found a useful application.
+installcheck:
+
+uninstall:
+ catalogs='$(CATALOGS)'; \
+ for cat in $$catalogs; do \
+ cat=`basename $$cat`; \
+ lang=`echo $$cat | sed 's/\$(CATOBJEXT)$$//'`; \
+ rm -f $(localedir)/$$lang/LC_MESSAGES/$(PACKAGE)$(INSTOBJEXT); \
+ rm -f $(localedir)/$$lang/LC_MESSAGES/$(PACKAGE)$(INSTOBJEXT).m; \
+ rm -f $(gnulocaledir)/$$lang/LC_MESSAGES/$(PACKAGE)$(INSTOBJEXT); \
+ rm -f $(gnulocaledir)/$$lang/LC_MESSAGES/$(PACKAGE)$(INSTOBJEXT).m; \
+ done
+ rm -f $(gettextsrcdir)/po-Makefile.in.in
+
+check: all
+
+cat-id-tbl.o: ../intl/libgettext.h
+
+dvi info tags TAGS ID:
+
+mostlyclean:
+ rm -f core core.* *.pox $(PACKAGE).po *.old.po cat-id-tbl.tmp
+ rm -fr *.o
+
+clean: mostlyclean
+
+distclean: clean
+ rm -f Makefile Makefile.in POTFILES *.mo *.msg *.cat *.cat.m
+
+maintainer-clean: distclean
+ @echo "This command is intended for maintainers to use;"
+ @echo "it deletes files that may require special tools to rebuild."
+ rm -f $(GMOFILES) Makefile PSPP.pot cat-id-tbl.c stamp-cat-id
+
+distdir = ../$(PACKAGE)-$(VERSION)/$(subdir)
+dist distdir: update-po $(DISTFILES)
+ dists="$(DISTFILES)"; \
+ for file in $$dists; do \
+ ln $(srcdir)/$$file $(distdir) 2> /dev/null \
+ || cp -p $(srcdir)/$$file $(distdir); \
+ done
+
+update-po: Makefile
+ $(MAKE) $(PACKAGE).pot
+ PATH=`pwd`/../src:$$PATH; \
+ cd $(srcdir); \
+ catalogs='$(CATALOGS)'; \
+ for cat in $$catalogs; do \
+ cat=`basename $$cat`; \
+ lang=`echo $$cat | sed 's/\$(CATOBJEXT)$$//'`; \
+ mv $$lang.po $$lang.old.po; \
+ echo "$$lang:"; \
+ if $(MSGMERGE) $$lang.old.po $(PACKAGE).pot -o $$lang.po; then \
+ rm -f $$lang.old.po; \
+ else \
+ echo "msgmerge for $$cat failed!"; \
+ rm -f $$lang.po; \
+ mv $$lang.old.po $$lang.po; \
+ fi; \
+ done
+
+POTFILES: POTFILES.in
+ ( if test 'x$(srcdir)' != 'x.'; then \
+ posrcprefix='$(top_srcdir)/'; \
+ else \
+ posrcprefix="../"; \
+ fi; \
+ rm -f $@-t $@ \
+ && (sed -e '/^#/d' -e '/^[ ]*$$/d' \
+ -e "s@.*@ $$posrcprefix& \\\\@" < $(srcdir)/$@.in \
+ | sed -e '$$s/\\$$//') > $@-t \
+ && chmod a-w $@-t \
+ && mv $@-t $@ )
+
+Makefile: Makefile.in.in ../config.status POTFILES
+ cd .. \
+ && CONFIG_FILES=$(subdir)/$@.in CONFIG_HEADERS= \
+ $(SHELL) ./config.status
+
+# Tell versions [3.59,3.63) of GNU make not to export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
--- /dev/null
+# List of source files containing translatable strings.
+# Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+
+# Common library files
+lib/misc/strtol.c
+lib/misc/getopt.c
+
+# Package source files
+src/aggregate.c
+src/alloc.c
+src/expr-evl.c
+src/expr-prs.c
+src/expr-opt.c
+src/debug-print.h
+src/alloc.h
+src/approx.h
+src/avl.c
+src/avl.h
+src/hash.c
+src/bitvector.h
+src/filename.c
+src/apply-dict.c
+src/filename.h
+src/hash.h
+src/heap.c
+src/heap.h
+src/pool.c
+src/pool.h
+src/stat.h
+src/str.c
+src/str.h
+src/data-in.c
+src/data-in.h
+src/data-list.c
+src/dfm.c
+src/dfm.h
+src/file-handle.h
+src/file-handle.q
+src/file-type.c
+src/format.c
+src/format.h
+src/formats.c
+src/get.c
+src/inpt-pgm.c
+src/inpt-pgm.h
+src/matrix-data.c
+src/pfm-read.c
+src/pfm-write.c
+src/pfm.h
+src/sfm-read.c
+src/sfm-write.c
+src/sfm.h
+src/sfmP.h
+src/sysfile-info.c
+src/exprP.h
+src/expr.h
+src/command.c
+src/command.h
+src/getline.c
+src/getline.h
+src/lexer.c
+src/lexer.h
+src/cmdline.c
+src/error.c
+src/error.h
+src/glob.c
+src/main.c
+src/main.h
+src/misc.c
+src/misc.h
+src/version.h
+src/ascii.c
+src/magic.c
+src/magic.h
+src/matrix.c
+src/matrix.h
+src/random.c
+src/random.h
+src/stats.c
+src/stats.h
+src/cases.c
+src/data-out.c
+src/font.h
+src/groff-font.c
+src/html.c
+src/htmlP.h
+src/log.h
+src/output.c
+src/output.h
+src/postscript.c
+src/som.c
+src/som.h
+src/tab.c
+src/tab.h
+src/do-if.c
+src/correlations.q
+src/crosstabs.q
+src/descript.q
+src/frequencies.q
+src/list.q
+src/means.q
+src/t-test.q
+src/cases.h
+src/count.c
+src/var.h
+src/vars-atr.c
+src/vars-prs.c
+src/vfm.c
+src/vfm.h
+src/vfmP.h
+src/autorecode.c
+src/compute.c
+src/flip.c
+src/print.c
+src/recode.c
+src/sel-if.c
+src/sort.c
+src/sort.h
+src/do-ifP.h
+src/include.c
+src/loop.c
+src/repeat.c
+src/mis-val.c
+src/modify-vars.c
+src/numeric.c
+src/rename-vars.c
+src/sample.c
+src/set.q
+src/settings.h
+src/split-file.c
+src/temporary.c
+src/title.c
+src/val-labs.c
+src/var-labs.c
+src/vector.c
+src/vector.h
+src/weight.c
+
--- /dev/null
+# SOME DESCRIPTIVE TITLE.
+# Copyright (C) YEAR Free Software Foundation, Inc.
+# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
+#
+#, fuzzy
+msgid ""
+msgstr ""
+"Project-Id-Version: PACKAGE VERSION\n"
+"POT-Creation-Date: 2000-01-07 20:39-0500\n"
+"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
+"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
+"Language-Team: LANGUAGE <LL@li.org>\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=CHARSET\n"
+"Content-Transfer-Encoding: ENCODING\n"
+
+#: lib/misc/getopt.c:514
+#, c-format
+msgid "%s: option `%s' is ambiguous\n"
+msgstr ""
+
+#: lib/misc/getopt.c:538
+#, c-format
+msgid "%s: option `--%s' doesn't allow an argument\n"
+msgstr ""
+
+#: lib/misc/getopt.c:543
+#, c-format
+msgid "%s: option `%c%s' doesn't allow an argument\n"
+msgstr ""
+
+#: lib/misc/getopt.c:557
+#, c-format
+msgid "%s: option `%s' requires an argument\n"
+msgstr ""
+
+#. --option
+#: lib/misc/getopt.c:585
+#, c-format
+msgid "%s: unrecognized option `--%s'\n"
+msgstr ""
+
+#. +option or -option
+#: lib/misc/getopt.c:589
+#, c-format
+msgid "%s: unrecognized option `%c%s'\n"
+msgstr ""
+
+#. 1003.2 specifies the format of this message.
+#: lib/misc/getopt.c:614
+#, c-format
+msgid "%s: illegal option -- %c\n"
+msgstr ""
+
+#: lib/misc/getopt.c:616
+#, c-format
+msgid "%s: invalid option -- %c\n"
+msgstr ""
+
+#. 1003.2 specifies the format of this message.
+#: lib/misc/getopt.c:650
+#, c-format
+msgid "%s: option requires an argument -- %c\n"
+msgstr ""
+
+#: src/aggregate.c:191
+msgid "OUTFILE specified multiple times."
+msgstr ""
+
+#: src/aggregate.c:217
+msgid "while expecting COLUMNWISE"
+msgstr ""
+
+#: src/aggregate.c:232
+msgid "BREAK specified multiple times."
+msgstr ""
+
+#: src/aggregate.c:261
+msgid "BREAK subcommand not specified."
+msgstr ""
+
+#: src/aggregate.c:504
+msgid "expecting aggregation function"
+msgstr ""
+
+#: src/aggregate.c:520
+#, c-format
+msgid "Unknown aggregation function %s."
+msgstr ""
+
+#: src/aggregate.c:535
+msgid "expecting `('"
+msgstr ""
+
+#: src/aggregate.c:570
+#, c-format
+msgid "Missing argument %d to %s."
+msgstr ""
+
+#: src/aggregate.c:578
+#, c-format
+msgid "Arguments to %s must be of same type as source variables."
+msgstr ""
+
+#: src/aggregate.c:588 src/expr-prs.c:664
+msgid "expecting `)'"
+msgstr ""
+
+#: src/aggregate.c:600 src/autorecode.c:114
+#, c-format
+msgid ""
+"Number of source variables (%d) does not match number of target variables "
+"(%d)."
+msgstr ""
+
+#: src/aggregate.c:671
+#, c-format
+msgid ""
+"Variable name %s is not unique within the aggregate file dictionary, which "
+"contains the aggregate variables and the break variables."
+msgstr ""
+
+#: src/expr-evl.c:1180
+msgid ""
+"A number being treated as a Boolean in an expression was found to have a "
+"value other than 0 (false), 1 (true), or the system-missing value. The "
+"result was forced to 0."
+msgstr ""
+
+#: src/expr-evl.c:1224
+#, c-format
+msgid ""
+"SYSMIS is not a valid index value for vector %s. The result will be set to "
+"SYSMIS."
+msgstr ""
+
+#: src/expr-evl.c:1228
+#, c-format
+msgid ""
+"%g is not a valid index value for vector %s. The result will be set to "
+"SYSMIS."
+msgstr ""
+
+#: src/expr-evl.c:1246
+#, c-format
+msgid ""
+"SYSMIS is not a valid index value for vector %s. The result will be set to "
+"the empty string."
+msgstr ""
+
+#: src/expr-evl.c:1251
+#, c-format
+msgid ""
+"%g is not a valid index value for vector %s. The result will be set to the "
+"empty string."
+msgstr ""
+
+#: src/expr-evl.c:1362
+#, c-format
+msgid "evaluate_expression(): not implemented: %s\n"
+msgstr ""
+
+#: src/expr-evl.c:1365
+#, c-format
+msgid "evaluate_expression(): not implemented: %d\n"
+msgstr ""
+
+#: src/expr-prs.c:140
+msgid ""
+"A string expression was supplied in a place where a Boolean expression was "
+"expected."
+msgstr ""
+
+#: src/expr-prs.c:151
+msgid ""
+"A numeric expression was expected in a place where one was not supplied."
+msgstr ""
+
+#: src/expr-prs.c:159
+msgid "A string expression was expected in a place where one was not supplied."
+msgstr ""
+
+#: src/expr-prs.c:173
+msgid "The OR operator cannot take string operands."
+msgstr ""
+
+#: src/expr-prs.c:221
+msgid "The AND operator cannot take string operands."
+msgstr ""
+
+#: src/expr-prs.c:270
+msgid "The NOT operator cannot take a string operand."
+msgstr ""
+
+#: src/expr-prs.c:297
+msgid ""
+"Strings cannot be compared with numeric or Boolean values with the "
+"relational operators = >= > <= < <>."
+msgstr ""
+
+#: src/expr-prs.c:354
+msgid "The `+' and `-' operators may only be used with numeric operands."
+msgstr ""
+
+#: src/expr-prs.c:406
+msgid "The `*' and `/' operators may only be used with numeric operands."
+msgstr ""
+
+#: src/expr-prs.c:457
+msgid "The unary minus (-) operator can only take a numeric operand."
+msgstr ""
+
+#: src/expr-prs.c:487
+msgid "Both operands to the ** operator must be numeric."
+msgstr ""
+
+#: src/expr-prs.c:581
+msgid "Use of $LENGTH is obsolete, returning default of 66."
+msgstr ""
+
+#: src/expr-prs.c:586
+msgid "Use of $WIDTH is obsolete, returning default of 131."
+msgstr ""
+
+#: src/expr-prs.c:591
+#, c-format
+msgid "Unknown system variable %s."
+msgstr ""
+
+#: src/expr-prs.c:630
+msgid "expecting variable name"
+msgstr ""
+
+#: src/expr-prs.c:672
+msgid "in expression"
+msgstr ""
+
+#: src/expr-prs.c:849
+msgid "Argument 2 to LAG must be a small positive integer constant."
+msgstr ""
+
+#: src/expr-prs.c:922 src/expr-prs.c:961
+#, c-format
+msgid ""
+"Type mismatch in argument %d of %s, which was expected to be of %s type. It "
+"was actually of %s type. "
+msgstr ""
+
+#: src/expr-prs.c:948
+#, c-format
+msgid "%s cannot take Boolean operands."
+msgstr ""
+
+#: src/expr-prs.c:980
+msgid "in function call"
+msgstr ""
+
+#: src/expr-prs.c:994
+msgid "RANGE requires an odd number of arguments, but at least three."
+msgstr ""
+
+#: src/expr-prs.c:1004
+#, c-format
+msgid "%s requires at least two arguments."
+msgstr ""
+
+#: src/expr-prs.c:1019
+#, c-format
+msgid "%s.%d requires at least %d arguments."
+msgstr ""
+
+#: src/expr-prs.c:1061
+#, c-format
+msgid ""
+"Argument %d to CONCAT is type %s. All arguments to CONCAT must be strings."
+msgstr ""
+
+#: src/expr-prs.c:1120
+#, c-format
+msgid ""
+"Argument %d to %s was expected to be of %s type. It was actually of type %s."
+msgstr ""
+
+#: src/apply-dict.c:72 src/apply-dict.c:73 src/expr-prs.c:1123
+#: src/expr-prs.c:1464 src/expr-prs.c:1483 src/formats.c:105
+#: src/pfm-read.c:654 src/print.c:719 src/sfm-read.c:1009 src/sfm-read.c:1137
+#: src/sfm-read.c:1138
+msgid "numeric"
+msgstr ""
+
+#: src/apply-dict.c:72 src/apply-dict.c:73 src/expr-prs.c:1123
+#: src/expr-prs.c:1467 src/expr-prs.c:1485 src/formats.c:105
+#: src/pfm-read.c:654 src/print.c:719 src/sfm-read.c:1009 src/sfm-read.c:1137
+#: src/sfm-read.c:1138
+msgid "string"
+msgstr ""
+
+#: src/expr-prs.c:1139
+#, c-format
+msgid "%s is not a numeric format."
+msgstr ""
+
+#: src/expr-prs.c:1165
+#, c-format
+msgid "Too few arguments to function %s."
+msgstr ""
+
+#: src/expr-prs.c:1197
+#, c-format
+msgid ""
+"Type mismatch in argument %d of %s, which was expected to be numeric. It "
+"was actually type %s."
+msgstr ""
+
+#: src/expr-prs.c:1206
+#, c-format
+msgid "Missing comma following argument %d of %s."
+msgstr ""
+
+#: src/expr-prs.c:1244
+msgid "The index value after a vector name must be numeric."
+msgstr ""
+
+#: src/expr-prs.c:1251
+msgid "`)' expected after a vector index value."
+msgstr ""
+
+#: src/expr-prs.c:1283
+#, c-format
+msgid "There is no function named %s."
+msgstr ""
+
+#: src/expr-prs.c:1288
+#, c-format
+msgid "Function %s may not be given a minimum number of arguments."
+msgstr ""
+
+#: src/expr-prs.c:1297
+#, c-format
+msgid "expecting `)' after %s function"
+msgstr ""
+
+#. FE
+#: src/error.c:281 src/error.c:288 src/error.c:291 src/expr-prs.c:1458
+msgid "error"
+msgstr ""
+
+#: src/expr-prs.c:1461
+msgid "Boolean"
+msgstr ""
+
+#: src/expr-prs.c:1689
+msgid "!!TERMINAL!!"
+msgstr ""
+
+#: src/expr-prs.c:1715
+msgid "!!SENTINEL!!"
+msgstr ""
+
+#: src/expr-prs.c:1718
+#, c-format
+msgid "!!ERROR%d!!"
+msgstr ""
+
+#: src/expr-prs.c:1736
+msgid "postfix:"
+msgstr ""
+
+#: src/expr-opt.c:662
+msgid ""
+"While optimizing a constant expression, there was a bad value for the third "
+"argument to INDEX."
+msgstr ""
+
+#: src/expr-opt.c:687
+msgid ""
+"While optimizing a constant expression, there was a bad value for the third "
+"argument to RINDEX."
+msgstr ""
+
+#: src/expr-opt.c:746
+#, c-format
+msgid "Third argument to %cPAD() must be at least one character in length."
+msgstr ""
+
+#: src/expr-opt.c:779
+#, c-format
+msgid "Second argument to %cTRIM() must be at least one character in length."
+msgstr ""
+
+#: src/expr-opt.c:880
+msgid ""
+"When optimizing a constant expression, an integer that was being used as an "
+"Boolean value was found to have a constant value other than 0, 1, or SYSMIS."
+msgstr ""
+
+#: src/hash.c:315
+msgid "hash table:"
+msgstr ""
+
+#: src/filename.c:240
+#, c-format
+msgid "Searching for `%s'..."
+msgstr ""
+
+#: src/filename.c:248 src/filename.c:280
+msgid "Search unsuccessful!"
+msgstr ""
+
+#: src/filename.c:273
+#, c-format
+msgid "Found `%s'."
+msgstr ""
+
+#: src/filename.c:694
+#, c-format
+msgid "Not opening pipe file `%s' because SAFER option set."
+msgstr ""
+
+#: src/apply-dict.c:69
+#, c-format
+msgid "Variable %s is %s in target file, but %s in source file."
+msgstr ""
+
+#: src/apply-dict.c:85
+#, c-format
+msgid "Cannot add value labels from source file to long string variable %s."
+msgstr ""
+
+#: src/apply-dict.c:121
+#, c-format
+msgid ""
+"Cannot apply missing values from source file to long string variable %s."
+msgstr ""
+
+#: src/apply-dict.c:153
+msgid "No matching variables found between the source and target files."
+msgstr ""
+
+#: src/heap.c:167
+#, c-format
+msgid "bad ordering of keys %d and %d\n"
+msgstr ""
+
+#: src/heap.c:177
+msgid "Heap contents:\n"
+msgstr ""
+
+#: src/data-in.c:71
+msgid "data-file error: "
+msgstr ""
+
+#: src/data-in.c:73
+#, c-format
+msgid "(column %d"
+msgstr ""
+
+#: src/data-in.c:75
+#, c-format
+msgid "(columns %d-%d"
+msgstr ""
+
+#: src/data-in.c:76
+#, c-format
+msgid ", field type %s) "
+msgstr ""
+
+#: src/data-in.c:225
+msgid "Field contents followed by garbage."
+msgstr ""
+
+#. Return an overflow error.
+#: src/data-in.c:258
+msgid "Overflow in floating-point constant."
+msgstr ""
+
+#. Return an underflow error.
+#: src/data-in.c:264
+msgid "Underflow in floating-point constant."
+msgstr ""
+
+#. There was no number.
+#: src/data-in.c:270
+msgid "Field does not form a valid floating-point constant."
+msgstr ""
+
+#: src/data-in.c:295
+msgid "All characters in field must be digits."
+msgstr ""
+
+#: src/data-in.c:320
+msgid "Unrecognized character in field."
+msgstr ""
+
+#: src/data-in.c:338 src/data-in.c:592
+msgid "Field must have even length."
+msgstr ""
+
+#: src/data-in.c:348 src/data-in.c:602
+msgid "Field must contain only hex digits."
+msgstr ""
+
+#: src/data-in.c:385
+msgid ""
+"Quality of zoned decimal (Z) input format code is suspect. Check your "
+"results three times, report bugs to author."
+msgstr ""
+
+#: src/data-in.c:397
+msgid "Zoned decimal field contains fewer than 2 characters."
+msgstr ""
+
+#: src/data-in.c:405
+msgid "Bad sign byte in zoned decimal number."
+msgstr ""
+
+#: src/data-in.c:422
+msgid "Format error in zoned decimal number."
+msgstr ""
+
+#: src/data-in.c:436
+msgid "Error in syntax of zoned decimal number."
+msgstr ""
+
+#: src/data-in.c:647
+msgid "Unexpected end of field."
+msgstr ""
+
+#: src/data-in.c:673
+msgid "Digit expected in field."
+msgstr ""
+
+#: src/data-in.c:698
+#, c-format
+msgid "Day (%ld) must be between 1 and 31."
+msgstr ""
+
+#: src/data-in.c:723
+msgid "Delimiter expected between fields in date."
+msgstr ""
+
+#: src/data-in.c:820
+#, c-format
+msgid "Month (%ld) must be between 1 and 12."
+msgstr ""
+
+#: src/data-in.c:861
+#, c-format
+msgid "Month (%s) must be between I and XII."
+msgstr ""
+
+#: src/data-in.c:888
+#, c-format
+msgid "Month name (%s...) is too long."
+msgstr ""
+
+#: src/data-in.c:899
+#, c-format
+msgid "Bad month name (%s)."
+msgstr ""
+
+#: src/data-in.c:915
+#, c-format
+msgid "Year (%ld) must be between 1582 and 19999."
+msgstr ""
+
+#: src/data-in.c:926
+#, c-format
+msgid "Trailing garbage \"%s\" following date."
+msgstr ""
+
+#: src/data-in.c:941
+#, c-format
+msgid "Julian day (%d) must be between 1 and 366."
+msgstr ""
+
+#: src/data-in.c:953
+#, c-format
+msgid "Year (%d) must be between 1582 and 19999."
+msgstr ""
+
+#: src/data-in.c:969
+#, c-format
+msgid "Quarter (%ld) must be between 1 and 4."
+msgstr ""
+
+#: src/data-in.c:979
+msgid "`Q' expected between quarter and year."
+msgstr ""
+
+#: src/data-in.c:995
+#, c-format
+msgid "Week (%ld) must be between 1 and 53."
+msgstr ""
+
+#: src/data-in.c:1006
+msgid "`WK' expected between week and year."
+msgstr ""
+
+#: src/data-in.c:1029
+msgid "Delimiter expected between fields in time."
+msgstr ""
+
+#: src/data-in.c:1041
+#, c-format
+msgid "Hour (%ld) must be positive."
+msgstr ""
+
+#: src/data-in.c:1053
+#, c-format
+msgid "Minute (%ld) must be between 0 and 59."
+msgstr ""
+
+#: src/data-in.c:1100
+#, c-format
+msgid "Hour (%ld) must be between 0 and 23."
+msgstr ""
+
+#: src/data-in.c:1114 src/data-in.c:1149
+msgid "Day of the week expected in date value."
+msgstr ""
+
+#: src/data-in.c:1200
+msgid "Date is not in valid range between 15 Oct 1582 and 31 Dec 19999."
+msgstr ""
+
+#: src/data-in.c:1528
+#, c-format
+msgid "Field too long (%d characters). Truncated after character %d."
+msgstr ""
+
+#: src/data-list.c:154
+msgid ""
+"DATA LIST may not use a different file from that specified on its "
+"surrounding FILE TYPE."
+msgstr ""
+
+#: src/data-list.c:173
+msgid "The END subcommand may only be specified once."
+msgstr ""
+
+#: src/data-list.c:209
+msgid "Only one of FIXED, FREE, or LIST may be specified."
+msgstr ""
+
+#: src/data-list.c:339 src/print.c:320
+#, c-format
+msgid ""
+"The record number specified, %ld, is before the previous record, %d. Data "
+"fields must be listed in order of increasing record number."
+msgstr ""
+
+#: src/data-list.c:371 src/data-list.c:1635
+msgid ""
+"SPSS-like or FORTRAN-like format specification expected after variable names."
+msgstr ""
+
+#: src/data-list.c:382 src/print.c:352
+msgid ""
+"Variables are specified on records that should not exist according to "
+"RECORDS subcommand."
+msgstr ""
+
+#: src/autorecode.c:125 src/command.c:714 src/compute.c:361
+#: src/data-list.c:390 src/data-list.c:840 src/data-list.c:1646
+#: src/do-if.c:267 src/file-handle.q:90 src/get.c:436 src/lexer.c:384
+#: src/loop.c:250 src/matrix-data.c:527 src/print.c:359 src/print.c:1100
+#: src/recode.c:411 src/sel-if.c:56 src/sel-if.c:136 src/vector.c:208
+msgid "expecting end of command"
+msgstr ""
+
+#: src/data-list.c:414 src/data-list.c:427 src/print.c:529 src/print.c:542
+msgid "Column positions for fields must be positive."
+msgstr ""
+
+#: src/data-list.c:432
+msgid "The ending column for a field must be greater than the starting column."
+msgstr ""
+
+#: src/data-list.c:456 src/print.c:570
+msgid "A format specifier on this line has extra characters on the end."
+msgstr ""
+
+#: src/data-list.c:471 src/print.c:586
+msgid "The value for number of decimal places must be at least 1."
+msgstr ""
+
+#: src/data-list.c:485 src/print.c:599
+#, c-format
+msgid "Input format %s doesn't accept decimal places."
+msgstr ""
+
+#: src/data-list.c:506 src/print.c:619
+#, c-format
+msgid "The %d columns %d-%d can't be evenly divided into %d fields."
+msgstr ""
+
+#: src/data-list.c:539 src/data-list.c:626 src/data-list.c:823
+#, c-format
+msgid "%s is a duplicate variable name."
+msgstr ""
+
+#: src/data-list.c:544
+#, c-format
+msgid "There is already a variable %s of a different type."
+msgstr ""
+
+#: src/data-list.c:551
+#, c-format
+msgid "There is already a string variable %s of a different width."
+msgstr ""
+
+#: src/data-list.c:615 src/print.c:708
+msgid ""
+"The number of format specifications exceeds the number of variable names "
+"given."
+msgstr ""
+
+#: src/data-list.c:699 src/print.c:792
+msgid ""
+"There aren't enough format specifications to match the number of variable "
+"names given."
+msgstr ""
+
+#: src/data-list.c:733 src/data-list.c:867 src/descript.q:799 src/print.c:824
+#: src/sysfile-info.c:130 src/sysfile-info.c:369 src/vfm.c:1133
+msgid "Variable"
+msgstr ""
+
+#: src/data-list.c:734 src/print.c:825
+msgid "Record"
+msgstr ""
+
+#: src/data-list.c:735 src/print.c:826
+msgid "Columns"
+msgstr ""
+
+#: src/data-list.c:736 src/data-list.c:868 src/print.c:827
+msgid "Format"
+msgstr ""
+
+#: src/data-list.c:758
+#, c-format
+msgid "Reading %d record%s from file %s."
+msgstr ""
+
+#: src/data-list.c:759
+#, c-format
+msgid "Reading %d record%s from the command file."
+msgstr ""
+
+#: src/data-list.c:764 src/data-list.c:765
+msgid "Occurrence data specifications."
+msgstr ""
+
+#: src/data-list.c:891
+#, c-format
+msgid "Reading free-form data from file %s."
+msgstr ""
+
+#: src/data-list.c:892
+msgid "Reading free-form data from the command file."
+msgstr ""
+
+#: src/data-list.c:943 src/matrix-data.c:957
+msgid "Scope of string exceeds line."
+msgstr ""
+
+#: src/data-list.c:1004
+msgid "Attempt to read past end of file."
+msgstr ""
+
+#: src/data-list.c:1033
+msgid "abort in write_case()\n"
+msgstr ""
+
+#. Note that this can't occur on the first record.
+#: src/data-list.c:1064
+#, c-format
+msgid "Partial case of %d of %d records discarded."
+msgstr ""
+
+#: src/data-list.c:1113
+#, c-format
+msgid "Partial case discarded. The first variable missing was %s."
+msgstr ""
+
+#: src/data-list.c:1154
+#, c-format
+msgid ""
+"Missing value(s) for all variables from %s onward. These will be filled "
+"with the system-missing value or blanks, as appropriate."
+msgstr ""
+
+#: src/data-list.c:1312
+msgid ""
+"REPEATING DATA must use the same file as its corresponding DATA LIST or FILE "
+"TYPE."
+msgstr ""
+
+#: src/data-list.c:1322
+msgid "STARTS subcommand given multiple times."
+msgstr ""
+
+#: src/data-list.c:1346
+#, c-format
+msgid "STARTS beginning column (%d) exceeds STARTS ending column (%d)."
+msgstr ""
+
+#: src/data-list.c:1357
+msgid "OCCURS subcommand given multiple times."
+msgstr ""
+
+#: src/data-list.c:1370
+msgid "LENGTH subcommand given multiple times."
+msgstr ""
+
+#: src/data-list.c:1383
+msgid "CONTINUED subcommand given multiple times."
+msgstr ""
+
+#: src/data-list.c:1402
+#, c-format
+msgid "CONTINUED beginning column (%d) exceeds CONTINUED ending column (%d)."
+msgstr ""
+
+#: src/data-list.c:1416
+msgid "ID subcommand given multiple times."
+msgstr ""
+
+#: src/data-list.c:1425
+#, c-format
+msgid "ID beginning column (%ld) must be positive."
+msgstr ""
+
+#: src/data-list.c:1440
+#, c-format
+msgid "ID ending column (%ld) must be positive."
+msgstr ""
+
+#: src/data-list.c:1446
+#, c-format
+msgid "ID ending column (%ld) cannot be less than ID beginning column (%d)."
+msgstr ""
+
+#: src/data-list.c:1485
+msgid "Missing required specification STARTS."
+msgstr ""
+
+#: src/data-list.c:1487
+msgid "Missing required specification OCCURS."
+msgstr ""
+
+#: src/data-list.c:1494
+msgid "ID specified without CONTINUED."
+msgstr ""
+
+#: src/data-list.c:1582
+msgid "String variable not allowed here."
+msgstr ""
+
+#: src/data-list.c:1592
+#, c-format
+msgid "%s (%d) must be at least 1."
+msgstr ""
+
+#: src/data-list.c:1598
+#, c-format
+msgid "Variable or integer expected for %s."
+msgstr ""
+
+#: src/data-list.c:1737
+#, c-format
+msgid "Mismatched case ID (%s). Expected value was %s."
+msgstr ""
+
+#: src/data-list.c:1769
+#, c-format
+msgid ""
+"Variable %s startging in column %d extends beyond physical record length of "
+"%d."
+msgstr ""
+
+#: src/data-list.c:1837
+#, c-format
+msgid "Invalid value %d for OCCURS."
+msgstr ""
+
+#: src/data-list.c:1843
+#, c-format
+msgid "Beginning column for STARTS (%d) must be at least 1."
+msgstr ""
+
+#: src/data-list.c:1851
+#, c-format
+msgid "Ending column for STARTS (%d) is less than beginning column (%d)."
+msgstr ""
+
+#: src/data-list.c:1859
+#, c-format
+msgid "Invalid value %d for LENGTH."
+msgstr ""
+
+#: src/data-list.c:1866
+#, c-format
+msgid "Beginning column for CONTINUED (%d) must be at least 1."
+msgstr ""
+
+#: src/data-list.c:1874
+#, c-format
+msgid "Ending column for CONTINUED (%d) is less than beginning column (%d)."
+msgstr ""
+
+#: src/data-list.c:1897
+#, c-format
+msgid ""
+"Number of repetitions specified on OCCURS (%d) exceed number of repetitions "
+"available in space on STARTS (%d), and CONTINUED not specified."
+msgstr ""
+
+#: src/data-list.c:1914
+#, c-format
+msgid "Unexpected end of file with %d repetitions remaining out of %d."
+msgstr ""
+
+#: src/dfm.c:92
+#, c-format
+msgid "%s: Closing data-file handle %s."
+msgstr ""
+
+#: src/dfm.c:117
+msgid "<<Bug in dfm.c>>"
+msgstr ""
+
+#: src/dfm.c:139
+#, c-format
+msgid "%s: Opening data-file handle %s for reading."
+msgstr ""
+
+#: src/dfm.c:156 src/dfm.c:173
+msgid "BEGIN DATA expected."
+msgstr ""
+
+#: src/dfm.c:193
+#, c-format
+msgid "An error occurred while opening \"%s\" for reading as a data file: %s."
+msgstr ""
+
+#: src/dfm.c:222
+#, c-format
+msgid "%s: Opening data-file handle %s for writing."
+msgstr ""
+
+#: src/dfm.c:228
+msgid "Cannot open the inline file for writing."
+msgstr ""
+
+#: src/dfm.c:243
+#, c-format
+msgid "An error occurred while opening \"%s\" for writing as a data file: %s."
+msgstr ""
+
+#: src/dfm.c:388
+msgid ""
+"Unexpected end-of-file while reading data in BEGIN DATA. This probably "
+"indicates a missing or misformatted END DATA command. END DATA must appear "
+"by itself on a single line with exactly one space between words."
+msgstr ""
+
+#: src/dfm.c:421 src/dfm.c:442
+#, c-format
+msgid "Error reading file %s: %s."
+msgstr ""
+
+#: src/dfm.c:445
+#, c-format
+msgid "%s: Partial record at end of file."
+msgstr ""
+
+#: src/dfm.c:501
+#, c-format
+msgid "Cannot read from file %s already opened for %s."
+msgstr ""
+
+#: src/dfm.c:515
+#, c-format
+msgid "Attempt to read beyond end-of-file on file %s."
+msgstr ""
+
+#: src/dfm.c:609
+#, c-format
+msgid "Cannot write to file %s already opened for %s."
+msgstr ""
+
+#: src/dfm.c:633
+#, c-format
+msgid "Error writing file %s: %s."
+msgstr ""
+
+#: src/dfm.c:676
+msgid ""
+"This command is not valid here since the current input program does not "
+"access the inline file."
+msgstr ""
+
+#. Initialize inline_file.
+#: src/dfm.c:683
+msgid "inline file: Opening for reading."
+msgstr ""
+
+#: src/dfm.c:697
+msgid "Skipping remaining inline data."
+msgstr ""
+
+#: src/dfm.c:709
+msgid "reading as a data file"
+msgstr ""
+
+#: src/dfm.c:716
+msgid "writing as a data file"
+msgstr ""
+
+#: src/file-handle.q:74
+#, c-format
+msgid ""
+"File handle %s had already been defined to refer to file %s. It is not "
+"possible to redefine a file handle within a session."
+msgstr ""
+
+#: src/file-handle.q:96
+msgid "The FILE HANDLE required subcommand NAME is not present."
+msgstr ""
+
+#: src/file-handle.q:109
+msgid ""
+"Fixed length records were specified on /RECFORM, but record length was not "
+"specified on /LRECL. 80-character records will be assumed."
+msgstr ""
+
+#: src/file-handle.q:116
+#, c-format
+msgid ""
+"Record length (%ld) must be at least one byte. 80-character records will be "
+"assumed."
+msgstr ""
+
+#: src/file-handle.q:127
+msgid ""
+"/RECFORM SPANNED is not implemented, as the author doesn't know what it is "
+"supposed to do. Send the author a note."
+msgstr ""
+
+#: src/file-handle.q:140
+msgid ""
+"/MODE IMAGE is not implemented, as the author doesn't know what it is "
+"supposed to do. Send the author a note."
+msgstr ""
+
+#: src/file-handle.q:147
+msgid "/MODE MULTIPUNCH is not implemented. If you care, complain."
+msgstr ""
+
+#: src/file-handle.q:151
+msgid "/MODE 360 is not implemented. If you care, complain."
+msgstr ""
+
+#: src/file-handle.q:233
+#, c-format
+msgid "File handle `%s' has not been previously declared on FILE HANDLE."
+msgstr ""
+
+#: src/file-handle.q:309
+msgid "<Inline File>"
+msgstr ""
+
+#: src/file-handle.q:328
+msgid "expecting a file name or handle"
+msgstr ""
+
+#: src/file-type.c:126
+msgid "MIXED, GROUPED, or NESTED expected."
+msgstr ""
+
+#: src/file-type.c:149
+msgid "The CASE subcommand is not valid on FILE TYPE MIXED."
+msgstr ""
+
+#: src/file-type.c:167
+msgid "WARN or NOWARN expected after WILD."
+msgstr ""
+
+#: src/file-type.c:175
+msgid "The DUPLICATE subcommand is not valid on FILE TYPE MIXED."
+msgstr ""
+
+#: src/file-type.c:189
+msgid "DUPLICATE=CASE is only valid on FILE TYPE NESTED."
+msgstr ""
+
+#: src/file-type.c:198
+#, c-format
+msgid "WARN%s expected after DUPLICATE."
+msgstr ""
+
+#: src/file-type.c:199
+msgid ", NOWARN, or CASE"
+msgstr ""
+
+#: src/file-type.c:200
+msgid " or NOWARN"
+msgstr ""
+
+#: src/file-type.c:208
+msgid "The MISSING subcommand is not valid on FILE TYPE MIXED."
+msgstr ""
+
+#: src/file-type.c:220
+msgid "WARN or NOWARN after MISSING."
+msgstr ""
+
+#: src/file-type.c:228
+msgid "ORDERED is only valid on FILE TYPE GROUPED."
+msgstr ""
+
+#: src/file-type.c:239
+msgid "YES or NO expected after ORDERED."
+msgstr ""
+
+#: src/file-type.c:245 src/file-type.c:555 src/get.c:420
+msgid "while expecting a valid subcommand"
+msgstr ""
+
+#: src/file-type.c:252
+msgid "The required RECORD subcommand was not present."
+msgstr ""
+
+#: src/file-type.c:260
+msgid "The required CASE subcommand was not present."
+msgstr ""
+
+#: src/file-type.c:266
+msgid "CASE and RECORD must specify different variable names."
+msgstr ""
+
+#: src/file-type.c:317
+msgid "Column value must be positive."
+msgstr ""
+
+#: src/file-type.c:332
+msgid "Ending column precedes beginning column."
+msgstr ""
+
+#: src/file-type.c:351
+msgid "Bad format specifier name."
+msgstr ""
+
+#: src/file-type.c:417 src/file-type.c:576
+msgid ""
+"This command may only appear within a FILE TYPE/END FILE TYPE structure."
+msgstr ""
+
+#: src/file-type.c:424
+msgid "OTHER may appear only on the last RECORD TYPE command."
+msgstr ""
+
+#: src/file-type.c:434
+msgid "No input commands (DATA LIST, REPEATING DATA) for above RECORD TYPE."
+msgstr ""
+
+#: src/file-type.c:488
+msgid ""
+"The CASE subcommand is not allowed on the RECORD TYPE command for FILE TYPE "
+"MIXED."
+msgstr ""
+
+#: src/file-type.c:498
+msgid ""
+"No variable name may be specified for the CASE subcommand on RECORD TYPE."
+msgstr ""
+
+#: src/file-type.c:506
+msgid ""
+"The CASE column specification on RECORD TYPE must give a format specifier "
+"that is the same type as that of the CASE column specification given on FILE "
+"TYPE."
+msgstr ""
+
+#: src/file-type.c:522
+msgid "WARN or NOWARN expected on DUPLICATE subcommand."
+msgstr ""
+
+#: src/file-type.c:536
+msgid "WARN or NOWARN expected on MISSING subcommand."
+msgstr ""
+
+#: src/file-type.c:549
+msgid "YES or NO expected on SPREAD subcommand."
+msgstr ""
+
+#: src/file-type.c:589
+msgid "No input commands (DATA LIST, REPEATING DATA) on above RECORD TYPE."
+msgstr ""
+
+#: src/file-type.c:596
+msgid "No commands between FILE TYPE and END FILE TYPE."
+msgstr ""
+
+#: src/file-type.c:661
+#, c-format
+msgid "Unknown record type \"%.*s\"."
+msgstr ""
+
+#: src/file-type.c:685
+#, c-format
+msgid "Unknown record type %g."
+msgstr ""
+
+#: src/format.c:75
+msgid "X and T format specifiers not allowed here."
+msgstr ""
+
+#: src/format.c:81
+#, c-format
+msgid "%s is not a valid data format."
+msgstr ""
+
+#: src/format.c:112
+#, c-format
+msgid "Format %s may not be used as an input format."
+msgstr ""
+
+#: src/format.c:117
+#, c-format
+msgid ""
+"Input format %s specifies a bad width %d. Format %s requires a width "
+"between %d and %d."
+msgstr ""
+
+#: src/format.c:124
+#, c-format
+msgid ""
+"Input format %s specifies an odd width %d, but format %s requires an even "
+"width between %d and %d."
+msgstr ""
+
+#: src/format.c:131
+#, c-format
+msgid ""
+"Input format %s specifies a bad number of implied decimal places %d. Input "
+"format %s allows up to 16 implied decimal places."
+msgstr ""
+
+#: src/format.c:151
+#, c-format
+msgid ""
+"Output format %s specifies a bad width %d. Format %s requires a width "
+"between %d and %d."
+msgstr ""
+
+#: src/format.c:161
+#, c-format
+msgid ""
+"Output format %s requires minimum width %d to allow %d decimal places. Try "
+"%s%d.%d instead of %s."
+msgstr ""
+
+#: src/format.c:169
+#, c-format
+msgid ""
+"Output format %s specifies an odd width %d, but output format %s requires an "
+"even width between %d and %d."
+msgstr ""
+
+#: src/format.c:176
+#, c-format
+msgid ""
+"Output format %s specifies a bad number of implied decimal places %d. "
+"Output format %s allows a number of implied decimal places between 1 and 16."
+msgstr ""
+
+#: src/format.c:193
+#, c-format
+msgid "Can't display a string variable of width %d with format specifier %s."
+msgstr ""
+
+#: src/format.c:303
+msgid "Format specifier expected."
+msgstr ""
+
+#: src/format.c:314
+#, c-format
+msgid "Data format %s does not specify a width."
+msgstr ""
+
+#: src/format.c:331
+#, c-format
+msgid "Data format %s is not valid."
+msgstr ""
+
+#: src/formats.c:95
+msgid "`(' expected after variable list"
+msgstr ""
+
+#: src/formats.c:104
+#, c-format
+msgid "Format %s may not be assigned to a %s variable."
+msgstr ""
+
+#: src/formats.c:125 src/numeric.c:68 src/numeric.c:142
+msgid "`)' expected after output format."
+msgstr ""
+
+#: src/formats.c:155
+msgid "Formats:\n"
+msgstr ""
+
+#: src/formats.c:156
+msgid " Name Print Write\n"
+msgstr ""
+
+#: src/get.c:125
+msgid "GET translation table from file to memory:\n"
+msgstr ""
+
+#: src/get.c:130 src/get.c:1487
+#, c-format
+msgid " %8s from %3d,%3d to %3d,%3d\n"
+msgstr ""
+
+#: src/get.c:426
+msgid "All variables deleted from system file dictionary."
+msgstr ""
+
+#: src/get.c:472
+#, c-format
+msgid ""
+"Cannot rename %s as %s because there already exists a variable named %s. To "
+"rename variables with overlapping names, use a single RENAME subcommand such "
+"as \"/RENAME (A=B)(B=C)(C=A)\", or equivalently, \"/RENAME (A B C=B C A)\"."
+msgstr ""
+
+#: src/get.c:497
+msgid "`=' expected after variable list."
+msgstr ""
+
+#: src/get.c:504
+#, c-format
+msgid ""
+"Number of variables on left side of `=' (%d) do not match number of "
+"variables on right side (%d), in parenthesized group %d of RENAME subcommand."
+msgstr ""
+
+#: src/get.c:522
+#, c-format
+msgid "Duplicate variables name %s."
+msgstr ""
+
+#: src/get.c:545
+msgid ""
+"\n"
+"Variables in dictionary:\n"
+msgstr ""
+
+#: src/get.c:659
+msgid "The BY subcommand may be given once at most."
+msgstr ""
+
+#: src/get.c:726
+msgid "The active file may not be specified more than once."
+msgstr ""
+
+#: src/get.c:735
+msgid "Cannot specify the active file since no active file has been defined."
+msgstr ""
+
+#: src/get.c:767
+msgid ""
+"IN, FIRST, and LAST subcommands may not occur before the first FILE or TABLE."
+msgstr ""
+
+#: src/get.c:799
+#, c-format
+msgid "Multiple %s subcommands for a single FILE or TABLE."
+msgstr ""
+
+#: src/get.c:809
+#, c-format
+msgid "Duplicate variable name %s while creating %s variable."
+msgstr ""
+
+#: src/get.c:823
+msgid ""
+"RENAME, KEEP, and DROP subcommands may not occur before the first FILE or "
+"TABLE."
+msgstr ""
+
+#: src/get.c:847
+msgid "The BY subcommand is required when a TABLE subcommand is given."
+msgstr ""
+
+#: src/get.c:868
+#, c-format
+msgid "File %s lacks BY variable %s."
+msgstr ""
+
+#: src/get.c:1386
+#, c-format
+msgid ""
+"Variable %s in file %s (%s) has different type or width from the same "
+"variable in earlier file (%s)."
+msgstr ""
+
+#: src/get.c:1438
+msgid "expecting COMM or TAPE"
+msgstr ""
+
+#: src/get.c:1482
+msgid "IMPORT translation table from file to memory:\n"
+msgstr ""
+
+#: src/inpt-pgm.c:81
+msgid "No matching INPUT PROGRAM command."
+msgstr ""
+
+#: src/inpt-pgm.c:86
+msgid ""
+"No data-input or transformation commands specified between INPUT PROGRAM and "
+"END INPUT PROGRAM."
+msgstr ""
+
+#: src/inpt-pgm.c:302 src/inpt-pgm.c:445
+msgid ""
+"This command may only be executed between INPUT PROGRAM and END INPUT "
+"PROGRAM."
+msgstr ""
+
+#: src/inpt-pgm.c:361
+msgid "COLUMN subcommand multiply specified."
+msgstr ""
+
+#: src/inpt-pgm.c:375
+msgid "expecting file handle name"
+msgstr ""
+
+#: src/inpt-pgm.c:418
+msgid ""
+"REREAD: Column numbers must be positive finite numbers. Column set to 1."
+msgstr ""
+
+#: src/matrix-data.c:204
+msgid "VARIABLES subcommand multiply specified."
+msgstr ""
+
+#: src/matrix-data.c:219
+msgid "VARNAME_ cannot be explicitly specified on VARIABLES."
+msgstr ""
+
+#: src/matrix-data.c:285
+msgid "in FORMAT subcommand"
+msgstr ""
+
+#: src/matrix-data.c:296
+msgid "SPLIT subcommand multiply specified."
+msgstr ""
+
+#: src/matrix-data.c:303
+msgid "in SPLIT subcommand"
+msgstr ""
+
+#: src/matrix-data.c:312
+msgid "Split variable may not be named ROWTYPE_ or VARNAME_."
+msgstr ""
+
+#: src/matrix-data.c:348
+#, c-format
+msgid "Split variable %s is already another type."
+msgstr ""
+
+#: src/matrix-data.c:363
+msgid "FACTORS subcommand multiply specified."
+msgstr ""
+
+#: src/matrix-data.c:378
+#, c-format
+msgid "Factor variable %s is already another type."
+msgstr ""
+
+#: src/matrix-data.c:393
+msgid "CELLS subcommand multiply specified."
+msgstr ""
+
+#: src/matrix-data.c:399 src/matrix-data.c:418
+msgid "expecting positive integer"
+msgstr ""
+
+#: src/matrix-data.c:412
+msgid "N subcommand multiply specified."
+msgstr ""
+
+#: src/matrix-data.c:433
+msgid "CONTENTS subcommand multiply specified."
+msgstr ""
+
+#: src/matrix-data.c:453
+msgid "Nested parentheses not allowed."
+msgstr ""
+
+#: src/matrix-data.c:463
+msgid "Mismatched right parenthesis (`(')."
+msgstr ""
+
+#: src/matrix-data.c:468
+msgid "Empty parentheses not allowed."
+msgstr ""
+
+#: src/matrix-data.c:481 src/matrix-data.c:489
+msgid "in CONTENTS subcommand"
+msgstr ""
+
+#: src/matrix-data.c:496
+#, c-format
+msgid "Content multiply specified for %s."
+msgstr ""
+
+#: src/matrix-data.c:513
+msgid "Missing right parenthesis."
+msgstr ""
+
+#: src/matrix-data.c:533
+msgid "Missing VARIABLES subcommand."
+msgstr ""
+
+#: src/matrix-data.c:539
+msgid ""
+"CONTENTS subcommand not specified: assuming file contains only CORR matrix."
+msgstr ""
+
+#: src/matrix-data.c:549
+msgid ""
+"Missing CELLS subcommand. CELLS is required when ROWTYPE_ is not given in "
+"the data and factors are present."
+msgstr ""
+
+#: src/matrix-data.c:557
+msgid "Split file values must be present in the data when ROWTYPE_ is present."
+msgstr ""
+
+#: src/matrix-data.c:613
+msgid "No continuous variables specified."
+msgstr ""
+
+#: src/matrix-data.c:1024
+#, c-format
+msgid "End of line expected %s while reading %s."
+msgstr ""
+
+#: src/matrix-data.c:1210
+#, c-format
+msgid "expecting value for %s %s"
+msgstr ""
+
+#: src/matrix-data.c:1360
+#, c-format
+msgid "Syntax error expecting SPLIT FILE value %s."
+msgstr ""
+
+#: src/matrix-data.c:1369
+#, c-format
+msgid "Expecting value %g for %s."
+msgstr ""
+
+#: src/matrix-data.c:1408 src/matrix-data.c:1821
+#, c-format
+msgid "Syntax error expecting factor value %s."
+msgstr ""
+
+#: src/matrix-data.c:1417
+#, c-format
+msgid "Syntax error expecting value %g for %s %s."
+msgstr ""
+
+#: src/matrix-data.c:1624
+#, c-format
+msgid "Syntax error %s expecting SPLIT FILE value."
+msgstr ""
+
+#: src/matrix-data.c:1735
+#, c-format
+msgid ""
+"Expected %d lines of data for %s content; actually saw %d lines. No data "
+"will be output for this content."
+msgstr ""
+
+#: src/matrix-data.c:1766
+#, c-format
+msgid "Multiply specified ROWTYPE_ %s."
+msgstr ""
+
+#: src/matrix-data.c:1771
+#, c-format
+msgid "Syntax error %s expecting ROWTYPE_ string."
+msgstr ""
+
+#: src/matrix-data.c:1790
+#, c-format
+msgid "Syntax error %s."
+msgstr ""
+
+#: src/matrix-data.c:1936
+#, c-format
+msgid "Duplicate specification for %s."
+msgstr ""
+
+#: src/matrix-data.c:1948
+#, c-format
+msgid "Too many rows of matrix data for %s."
+msgstr ""
+
+#: src/matrix-data.c:1993
+#, c-format
+msgid "Syntax error expecting value for %s %s."
+msgstr ""
+
+#: src/pfm-read.c:107
+#, c-format
+msgid "portable file %s corrupt at offset %ld: "
+msgstr ""
+
+#: src/pfm-read.c:126 src/pfm-write.c:499
+#, c-format
+msgid "%s: Closing portable file: %s."
+msgstr ""
+
+#: src/lexer.c:948 src/pfm-read.c:150 src/repeat.c:227
+msgid "Unexpected end of file."
+msgstr ""
+
+#: src/pfm-read.c:158
+msgid "Bad line end."
+msgstr ""
+
+#: src/pfm-read.c:239
+#, c-format
+msgid "Cannot read file %s as portable file: already opened for %s."
+msgstr ""
+
+#: src/pfm-read.c:245
+#, c-format
+msgid "%s: Opening portable-file handle %s for reading."
+msgstr ""
+
+#: src/pfm-read.c:253
+#, c-format
+msgid ""
+"An error occurred while opening \"%s\" for reading as a portable file: %s."
+msgstr ""
+
+#. F
+#: src/pfm-read.c:287
+msgid "Data record expected."
+msgstr ""
+
+#: src/pfm-read.c:289
+msgid "Read portable-file dictionary successfully."
+msgstr ""
+
+#. Come here on unsuccessful completion.
+#: src/pfm-read.c:298
+msgid "Error reading portable-file dictionary."
+msgstr ""
+
+#. /
+#: src/pfm-read.c:396
+msgid "Missing numeric terminator."
+msgstr ""
+
+#: src/pfm-read.c:433
+msgid "Bad integer format."
+msgstr ""
+
+#: src/pfm-read.c:463
+#, c-format
+msgid "Bad string length %d."
+msgstr ""
+
+#: src/pfm-read.c:562
+#, c-format
+msgid "Bad date string length %d."
+msgstr ""
+
+#. 0
+#. 9
+#: src/pfm-read.c:566
+msgid "Bad character in date."
+msgstr ""
+
+#: src/pfm-read.c:586
+#, c-format
+msgid "Bad time string length %d."
+msgstr ""
+
+#. 0
+#. 9
+#: src/pfm-read.c:590
+msgid "Bad character in time."
+msgstr ""
+
+#: src/pfm-read.c:640
+#, c-format
+msgid "%s: Bad format specifier byte %d."
+msgstr ""
+
+#: src/pfm-read.c:649 src/sfm-read.c:993 src/sfm-read.c:1003
+#, c-format
+msgid "%s: Bad format specifier byte (%d)."
+msgstr ""
+
+#: src/pfm-read.c:651
+#, c-format
+msgid "%s variable %s has %s format specifier %s."
+msgstr ""
+
+#: src/pfm-read.c:652 src/print.c:631 src/sfm-read.c:1007
+msgid "String"
+msgstr ""
+
+#: src/pfm-read.c:652 src/print.c:631 src/sfm-read.c:1007
+msgid "Numeric"
+msgstr ""
+
+#. 4
+#: src/pfm-read.c:690
+msgid "Expected variable count record."
+msgstr ""
+
+#: src/pfm-read.c:694
+#, c-format
+msgid "Invalid number of variables %d."
+msgstr ""
+
+#: src/pfm-read.c:704
+#, c-format
+msgid "Unexpected flag value %d."
+msgstr ""
+
+#. 7
+#: src/pfm-read.c:728
+msgid "Expected variable record."
+msgstr ""
+
+#: src/pfm-read.c:734
+#, c-format
+msgid "Invalid variable width %d."
+msgstr ""
+
+#: src/pfm-read.c:752
+#, c-format
+msgid "position %d: Variable name has %u characters."
+msgstr ""
+
+#. A
+#. Z
+#. @
+#: src/pfm-read.c:756
+#, c-format
+msgid "position %d: Variable name begins with invalid character."
+msgstr ""
+
+#: src/pfm-read.c:760
+#, c-format
+msgid "position %d: Variable name begins with lowercase letter %c."
+msgstr ""
+
+#: src/pfm-read.c:773
+#, c-format
+msgid "position %d: Variable name character %d is lowercase letter %c."
+msgstr ""
+
+#: src/pfm-read.c:783
+#, c-format
+msgid "position %d: character `\\%03o' is not valid in a variable name."
+msgstr ""
+
+#: src/pfm-read.c:794
+#, c-format
+msgid "Duplicate variable name %s."
+msgstr ""
+
+#: src/pfm-read.c:838
+#, c-format
+msgid "Bad missing values for %s."
+msgstr ""
+
+#: src/pfm-read.c:860
+#, c-format
+msgid "Weighting variable %s not present in dictionary."
+msgstr ""
+
+#: src/pfm-read.c:928
+#, c-format
+msgid "Unknown variable %s while parsing value labels."
+msgstr ""
+
+#: src/pfm-read.c:931
+#, c-format
+msgid ""
+"Cannot assign value labels to %s and %s, which have different variable types "
+"or widths."
+msgstr ""
+
+#: src/pfm-read.c:978
+#, c-format
+msgid "Duplicate label for value %g for variable %s."
+msgstr ""
+
+#: src/pfm-read.c:981
+#, c-format
+msgid "Duplicate label for value `%.*s' for variable %s."
+msgstr ""
+
+#: src/pfm-read.c:1053
+msgid "End of file midway through case."
+msgstr ""
+
+#: src/pfm-read.c:1063
+msgid "reading as a portable file"
+msgstr ""
+
+#: src/pfm-write.c:72
+#, c-format
+msgid "Cannot write file %s as portable file: already opened for %s."
+msgstr ""
+
+#: src/pfm-write.c:78
+#, c-format
+msgid "%s: Opening portable-file handle %s for writing."
+msgstr ""
+
+#: src/pfm-write.c:88
+#, c-format
+msgid ""
+"An error occurred while opening \"%s\" for writing as a portable file: %s."
+msgstr ""
+
+#: src/pfm-write.c:124
+msgid "Wrote portable-file header successfully."
+msgstr ""
+
+#: src/pfm-write.c:129
+msgid "Error writing portable-file header."
+msgstr ""
+
+#: src/pfm-write.c:169
+#, c-format
+msgid "%s: Writing portable file: %s."
+msgstr ""
+
+#: src/pfm-write.c:508
+msgid "writing as a portable file"
+msgstr ""
+
+#: src/sfm-read.c:188
+msgid "corrupt system file: "
+msgstr ""
+
+#: src/sfm-read.c:204 src/sfm-write.c:744
+#, c-format
+msgid "%s: Closing system file: %s."
+msgstr ""
+
+#: src/sfm-read.c:277
+#, c-format
+msgid "Cannot read file %s as system file: already opened for %s."
+msgstr ""
+
+#: src/sfm-read.c:282
+#, c-format
+msgid "%s: Opening system-file handle %s for reading."
+msgstr ""
+
+#: src/sfm-read.c:290
+#, c-format
+msgid ""
+"An error occurred while opening \"%s\" for reading as a system file: %s."
+msgstr ""
+
+#: src/sfm-read.c:324
+#, c-format
+msgid ""
+"%s: Weighting variable may not be a continuation of a long string variable."
+msgstr ""
+
+#: src/sfm-read.c:327
+#, c-format
+msgid "%s: Weighting variable may not be a string variable."
+msgstr ""
+
+#: src/sfm-read.c:352
+#, c-format
+msgid ""
+"%s: Orphaned variable index record (type 4). Type 4 records must always "
+"immediately follow type 3 records."
+msgstr ""
+
+#: src/sfm-read.c:407
+#, c-format
+msgid "%s: Unrecognized record type 7, subtype %d encountered in system file."
+msgstr ""
+
+#: src/sfm-read.c:431
+#, c-format
+msgid "%s: Unrecognized record type %d."
+msgstr ""
+
+#. Come here on successful completion.
+#: src/sfm-read.c:437
+msgid "Read system-file dictionary successfully."
+msgstr ""
+
+#. Come here on unsuccessful completion.
+#: src/sfm-read.c:447
+msgid "Error reading system-file header."
+msgstr ""
+
+#: src/sfm-read.c:471
+#, c-format
+msgid ""
+"%s: Bad size (%d) or count (%d) field on record type 7, subtype 3.\tExpected "
+"size %d, count 8."
+msgstr ""
+
+#: src/sfm-read.c:485
+#, c-format
+msgid ""
+"%s: Floating-point representation in system file is not IEEE-754. PSPP "
+"cannot convert between floating-point formats."
+msgstr ""
+
+#: src/sfm-read.c:506
+#, c-format
+msgid ""
+"%s: File-indicated endianness (%s) does not match endianness intuited from "
+"file header (%s)."
+msgstr ""
+
+#: src/sfm-read.c:508 src/sfm-read.c:509
+msgid "big-endian"
+msgstr ""
+
+#: src/sfm-read.c:508 src/sfm-read.c:509
+msgid "little-endian"
+msgstr ""
+
+#: src/sfm-read.c:510
+msgid "unknown"
+msgstr ""
+
+#: src/sfm-read.c:514
+#, c-format
+msgid "%s: File-indicated character representation code (%s) is not ASCII."
+msgstr ""
+
+#: src/sfm-read.c:516
+msgid "DEC Kanji"
+msgstr ""
+
+#: src/data-out.c:145 src/sfm-read.c:516 src/sysfile-info.c:114
+msgid "Unknown"
+msgstr ""
+
+#: src/sfm-read.c:535
+#, c-format
+msgid ""
+"%s: Bad size (%d) or count (%d) field on record type 7, subtype 4.\tExpected "
+"size %d, count 8."
+msgstr ""
+
+#: src/sfm-read.c:550
+#, c-format
+msgid ""
+"%s: File-indicated value is different from internal value for at least one "
+"of the three system values. SYSMIS: indicated %g, expected %g; HIGHEST: %g, "
+"%g; LOWEST: %g, %g."
+msgstr ""
+
+#: src/sfm-read.c:594
+#, c-format
+msgid ""
+"%s: Bad magic. Proper system files begin with the four characters `$FL2'. "
+"This file will not be read."
+msgstr ""
+
+#: src/sfm-read.c:637
+#, c-format
+msgid ""
+"%s: File layout code has unexpected value %d. Value should be 2, in "
+"big-endian or little-endian format."
+msgstr ""
+
+#: src/sfm-read.c:653
+#, c-format
+msgid "%s: Number of elements per case (%d) is not between 1 and %d."
+msgstr ""
+
+#: src/sfm-read.c:660
+#, c-format
+msgid ""
+"%s: Index of weighting variable (%d) is not between 0 and number of elements "
+"per case (%d)."
+msgstr ""
+
+#: src/sfm-read.c:666
+#, c-format
+msgid "%s: Number of cases in file (%ld) is not between -1 and %d."
+msgstr ""
+
+#: src/sfm-read.c:671
+#, c-format
+msgid "%s: Compression bias (%g) is not the usual value of 100."
+msgstr ""
+
+#: src/sfm-read.c:767
+#, c-format
+msgid "%s: position %d: Bad record type (%d); the expected value was 2."
+msgstr ""
+
+#: src/sfm-read.c:776
+#, c-format
+msgid ""
+"%s: position %d: String variable does not have proper number of continuation "
+"records."
+msgstr ""
+
+#: src/sfm-read.c:784
+#, c-format
+msgid "%s: position %d: Superfluous long string continuation record."
+msgstr ""
+
+#: src/sfm-read.c:789
+#, c-format
+msgid "%s: position %d: Bad variable type code %d."
+msgstr ""
+
+#: src/sfm-read.c:792
+#, c-format
+msgid "%s: position %d: Variable label indicator field is not 0 or 1."
+msgstr ""
+
+#: src/sfm-read.c:796
+#, c-format
+msgid ""
+"%s: position %d: Missing value indicator field is not -3, -2, 0, 1, 2, or 3."
+msgstr ""
+
+#: src/sfm-read.c:809
+#, c-format
+msgid "%s: position %d: Variable name begins with invalid character."
+msgstr ""
+
+#: src/sfm-read.c:812
+#, c-format
+msgid "%s: position %d: Variable name begins with lowercase letter %c."
+msgstr ""
+
+#: src/sfm-read.c:815
+#, c-format
+msgid ""
+"%s: position %d: Variable name begins with octothorpe (`#'). Scratch "
+"variables should not appear in system files."
+msgstr ""
+
+#: src/sfm-read.c:829
+#, c-format
+msgid "%s: position %d: Variable name character %d is lowercase letter %c."
+msgstr ""
+
+#: src/sfm-read.c:837
+#, c-format
+msgid ""
+"%s: position %d: character `\\%03o' (%c) is not valid in a variable name."
+msgstr ""
+
+#: src/sfm-read.c:877
+#, c-format
+msgid "%s: Variable %s indicates variable label of invalid length %d."
+msgstr ""
+
+#: src/sfm-read.c:893
+#, c-format
+msgid "%s: Long string variable %s may not have missing values."
+msgstr ""
+
+#: src/sfm-read.c:917
+#, c-format
+msgid ""
+"%s: String variable %s may not have missing values specified as a range."
+msgstr ""
+
+#: src/sfm-read.c:954
+#, c-format
+msgid "%s: Long string continuation records omitted at end of dictionary."
+msgstr ""
+
+#: src/sfm-read.c:957
+#, c-format
+msgid ""
+"%s: System file header indicates %d variable positions but %d were read from "
+"file."
+msgstr ""
+
+#: src/sfm-read.c:966
+#, c-format
+msgid "%s: Duplicate variable name `%s' within system file."
+msgstr ""
+
+#: src/sfm-read.c:1006
+#, c-format
+msgid "%s: %s variable %s has %s format specifier %s."
+msgstr ""
+
+#: src/sfm-read.c:1085
+#, c-format
+msgid ""
+"%s: Variable index record (type 4) does not immediately follow value label "
+"record (type 3) as it ought."
+msgstr ""
+
+#: src/sfm-read.c:1095
+#, c-format
+msgid ""
+"%s: Number of variables associated with a value label (%d) is not between 1 "
+"and the number of variables (%d)."
+msgstr ""
+
+#: src/sfm-read.c:1113
+#, c-format
+msgid ""
+"%s: Variable index associated with value label (%d) is not between 1 and the "
+"number of values (%d)."
+msgstr ""
+
+#: src/sfm-read.c:1120
+#, c-format
+msgid ""
+"%s: Variable index associated with value label (%d) refers to a continuation "
+"of a string variable, not to an actual variable."
+msgstr ""
+
+#: src/sfm-read.c:1124
+#, c-format
+msgid "%s: Value labels are not allowed on long string variables (%s)."
+msgstr ""
+
+#: src/sfm-read.c:1134
+#, c-format
+msgid ""
+"%s: Variables associated with value label are not all of identical type. "
+"Variable %s has %s type, but variable %s has %s type."
+msgstr ""
+
+#: src/sfm-read.c:1177
+#, c-format
+msgid "%s: File contains duplicate label for value %g for variable %s."
+msgstr ""
+
+#: src/sfm-read.c:1180
+#, c-format
+msgid "%s: File contains duplicate label for value `%.*s' for variable %s."
+msgstr ""
+
+#: src/sfm-read.c:1220 src/sfm-read.c:1498
+#, c-format
+msgid "%s: Reading system file: %s."
+msgstr ""
+
+#: src/sfm-read.c:1222 src/sfm-read.c:1403 src/sfm-read.c:1444
+#, c-format
+msgid "%s: Unexpected end of file."
+msgstr ""
+
+#: src/sfm-read.c:1239
+#, c-format
+msgid "%s: System file contains multiple type 6 (document) records."
+msgstr ""
+
+#: src/sfm-read.c:1245
+#, c-format
+msgid "%s: Number of document lines (%ld) must be greater than 0."
+msgstr ""
+
+#: src/sfm-read.c:1266
+msgid "dictionary:\n"
+msgstr ""
+
+#. debug_printf (("(indices:%d,%d)", v->index, v->foo));
+#: src/sfm-read.c:1275
+msgid "num"
+msgstr ""
+
+#: src/sfm-read.c:1276
+msgid "str"
+msgstr ""
+
+#. debug_printf (("(get.fv:%d,%d)", v->get.fv, v->get.nv));
+#: src/sfm-read.c:1280
+msgid "left"
+msgstr ""
+
+#: src/sfm-read.c:1280
+msgid "right"
+msgstr ""
+
+#: src/sfm-read.c:1286
+msgid "none"
+msgstr ""
+
+#: src/sfm-read.c:1290
+msgid "one"
+msgstr ""
+
+#: src/sfm-read.c:1294
+msgid "two"
+msgstr ""
+
+#: src/sfm-read.c:1298
+msgid "three"
+msgstr ""
+
+#: src/descript.q:166 src/sfm-read.c:1302
+msgid "range"
+msgstr ""
+
+#: src/sfm-read.c:1306
+msgid "low"
+msgstr ""
+
+#: src/sfm-read.c:1310
+msgid "high"
+msgstr ""
+
+#: src/sfm-read.c:1314
+msgid "range+1"
+msgstr ""
+
+#: src/sfm-read.c:1318
+msgid "low+1"
+msgstr ""
+
+#: src/sfm-read.c:1322
+msgid "high+1"
+msgstr ""
+
+#: src/sfm-read.c:1356
+#, c-format
+msgid "%s: Error reading file: %s."
+msgstr ""
+
+#: src/sfm-read.c:1394
+#, c-format
+msgid "%s: Compressed data is corrupted. Data ends partway through a case."
+msgstr ""
+
+#: src/sfm-read.c:1500
+#, c-format
+msgid "%s: Partial record at end of system file."
+msgstr ""
+
+#: src/sfm-read.c:1538
+msgid "reading as a system file"
+msgstr ""
+
+#: src/sfm-write.c:114
+#, c-format
+msgid "Cannot write file %s as system file: already opened for %s."
+msgstr ""
+
+#: src/sfm-write.c:119
+#, c-format
+msgid "%s: Opening system-file handle %s for writing."
+msgstr ""
+
+#: src/sfm-write.c:129
+#, c-format
+msgid ""
+"An error occurred while opening \"%s\" for writing as a system file: %s."
+msgstr ""
+
+#: src/sfm-write.c:182
+msgid "Wrote system-file header successfully."
+msgstr ""
+
+#: src/sfm-write.c:187
+msgid "Error writing system-file header."
+msgstr ""
+
+#: src/sfm-write.c:608
+#, c-format
+msgid "%s: Writing system file: %s."
+msgstr ""
+
+#: src/sfm-write.c:754
+msgid "writing as a system file"
+msgstr ""
+
+#: src/sysfile-info.c:96
+msgid "File:"
+msgstr ""
+
+#: src/sysfile-info.c:98
+msgid "Label:"
+msgstr ""
+
+#: src/sysfile-info.c:100
+msgid "No label."
+msgstr ""
+
+#: src/sysfile-info.c:101
+msgid "Created:"
+msgstr ""
+
+#: src/sysfile-info.c:104
+msgid "Endian:"
+msgstr ""
+
+#: src/sysfile-info.c:106
+msgid "Big."
+msgstr ""
+
+#: src/sysfile-info.c:107
+msgid "Little."
+msgstr ""
+
+#: src/sysfile-info.c:108
+msgid "<internal error>"
+msgstr ""
+
+#: src/sysfile-info.c:109
+msgid "Variables:"
+msgstr ""
+
+#: src/sysfile-info.c:112
+msgid "Cases:"
+msgstr ""
+
+#: src/sysfile-info.c:115
+msgid "Type:"
+msgstr ""
+
+#: src/sysfile-info.c:116
+msgid "System File."
+msgstr ""
+
+#: src/sysfile-info.c:117
+msgid "Weight:"
+msgstr ""
+
+#: src/sysfile-info.c:119
+msgid "Not weighted."
+msgstr ""
+
+#: src/sysfile-info.c:120
+msgid "Mode:"
+msgstr ""
+
+#: src/sysfile-info.c:122
+#, c-format
+msgid "Compression %s."
+msgstr ""
+
+#: src/sysfile-info.c:122
+msgid "on"
+msgstr ""
+
+#: src/sysfile-info.c:122
+msgid "off"
+msgstr ""
+
+#: src/sysfile-info.c:131 src/sysfile-info.c:376
+msgid "Description"
+msgstr ""
+
+#: src/sysfile-info.c:132 src/sysfile-info.c:373
+msgid "Position"
+msgstr ""
+
+#: src/sysfile-info.c:192
+msgid "The active file does not have a file label."
+msgstr ""
+
+#: src/sysfile-info.c:195
+msgid "File label:"
+msgstr ""
+
+#: src/sysfile-info.c:257
+msgid "No variables to display."
+msgstr ""
+
+#: src/sysfile-info.c:282
+msgid "Macros not supported."
+msgstr ""
+
+#: src/sysfile-info.c:290
+msgid "The active file dictionary does not contain any documents."
+msgstr ""
+
+#: src/sysfile-info.c:298
+msgid "Documents in the active file:"
+msgstr ""
+
+#: src/sysfile-info.c:378 src/sysfile-info.c:538 src/vfm.c:1135
+msgid "Label"
+msgstr ""
+
+#: src/sysfile-info.c:450
+#, c-format
+msgid "Format: %s"
+msgstr ""
+
+#: src/sysfile-info.c:457
+#, c-format
+msgid "Print Format: %s"
+msgstr ""
+
+#: src/sysfile-info.c:460
+#, c-format
+msgid "Write Format: %s"
+msgstr ""
+
+#: src/sysfile-info.c:468
+msgid "Missing Values: "
+msgstr ""
+
+#: src/crosstabs.q:1233 src/crosstabs.q:1260 src/crosstabs.q:1280
+#: src/crosstabs.q:1302 src/frequencies.q:895 src/frequencies.q:1012
+#: src/sysfile-info.c:537 src/vfm.c:1134
+msgid "Value"
+msgstr ""
+
+#: src/sysfile-info.c:598
+msgid "No vectors defined."
+msgstr ""
+
+#: src/sysfile-info.c:613
+msgid "Vector"
+msgstr ""
+
+#: src/command.c:161
+#, c-format
+msgid "%s not allowed inside FILE TYPE/END FILE TYPE."
+msgstr ""
+
+#: src/command.c:165
+#, c-format
+msgid "%s not allowed inside FILE TYPE GROUPED/END FILE TYPE."
+msgstr ""
+
+#: src/command.c:168
+msgid "RECORD TYPE must be the first command inside a FILE TYPE structure."
+msgstr ""
+
+#: src/command.c:213
+msgid "This line does not begin with a valid command name."
+msgstr ""
+
+#: src/command.c:223
+#, c-format
+msgid "%s is not yet implemented."
+msgstr ""
+
+#: src/command.c:241
+#, c-format
+msgid ""
+"%s is not allowed (1) before a command to specify the input program, such as "
+"DATA LIST, (2) between FILE TYPE and END FILE TYPE, (3) between INPUT "
+"PROGRAM and END INPUT PROGRAM."
+msgstr ""
+
+#: src/command.c:245
+#, c-format
+msgid "%s is not allowed within an input program."
+msgstr ""
+
+#: src/command.c:246 src/command.c:247
+#, c-format
+msgid "%s is only allowed within an input program."
+msgstr ""
+
+#: src/command.c:256
+#, c-format
+msgid "%s command beginning\n"
+msgstr ""
+
+#: src/command.c:292
+#, c-format
+msgid ""
+"%s command completed\n"
+"\n"
+msgstr ""
+
+#: src/command.c:307
+msgid "The identifier(s) specified do not form a valid command name:"
+msgstr ""
+
+#: src/command.c:310
+msgid "The identifier(s) specified do not form a complete command name:"
+msgstr ""
+
+#: src/command.c:434
+msgid ""
+"This command is not accepted in a syntax file. Instead, use FINISH to "
+"terminate a syntax file."
+msgstr ""
+
+#: src/command.c:452
+msgid ""
+"This command is not executed in interactive mode. Instead, PSPP drops down "
+"to the command prompt. Use EXIT if you really want to quit."
+msgstr ""
+
+#: src/command.c:543
+msgid "The sentinel may not be the empty string."
+msgstr ""
+
+#: src/command.c:601 src/command.c:732
+msgid "This command not allowed when the SAFER option is set."
+msgstr ""
+
+#: src/command.c:614
+#, c-format
+msgid "Error removing `%s': %s."
+msgstr ""
+
+#: src/command.c:664
+#, c-format
+msgid "Couldn't fork: %s."
+msgstr ""
+
+#: src/command.c:705
+#, c-format
+msgid "Error executing command: %s."
+msgstr ""
+
+#: src/command.c:755
+msgid "No operating system support for this command."
+msgstr ""
+
+#: src/command.c:784
+msgid "This command is not valid in a syntax file."
+msgstr ""
+
+#: src/getline.c:160
+#, c-format
+msgid "Can't find `%s' in include file search path."
+msgstr ""
+
+#: src/getline.c:315
+#, c-format
+msgid "%s: Opening as syntax file."
+msgstr ""
+
+#: src/getline.c:320
+#, c-format
+msgid "Opening `%s': %s."
+msgstr ""
+
+#: src/getline.c:329 src/html.c:334 src/postscript.c:1480
+#, c-format
+msgid "Reading `%s': %s."
+msgstr ""
+
+#: src/getline.c:387
+#, c-format
+msgid "Closing `%s': %s."
+msgstr ""
+
+#: src/lexer.c:216
+#, c-format
+msgid "%s does not form a valid number."
+msgstr ""
+
+#: src/lexer.c:334
+#, c-format
+msgid "Bad character in input: `%c'."
+msgstr ""
+
+#: src/lexer.c:336
+#, c-format
+msgid "Bad character in input: `\\%o'."
+msgstr ""
+
+#: src/lexer.c:357
+msgid "Syntax error at end of file."
+msgstr ""
+
+#: src/lexer.c:367
+#, c-format
+msgid "Syntax error %s at `%s'."
+msgstr ""
+
+#: src/lexer.c:370
+#, c-format
+msgid "Syntax error at `%s'."
+msgstr ""
+
+#: src/lexer.c:473
+#, c-format
+msgid "expecting `%s'"
+msgstr ""
+
+#: src/lexer.c:490
+#, c-format
+msgid "expecting %s"
+msgstr ""
+
+#: src/lexer.c:504
+msgid "expecting string"
+msgstr ""
+
+#: src/lexer.c:518
+msgid "expecting integer"
+msgstr ""
+
+#: src/lexer.c:532
+msgid "expecting number"
+msgstr ""
+
+#: src/lexer.c:546
+msgid "expecting identifier"
+msgstr ""
+
+#: src/lexer.c:682
+msgid "The rest of this command has been discarded."
+msgstr ""
+
+#: src/lexer.c:822 src/print.c:1193
+msgid "<ERROR>"
+msgstr ""
+
+#: src/lexer.c:974
+msgid "binary"
+msgstr ""
+
+#: src/lexer.c:974
+msgid "octal"
+msgstr ""
+
+#: src/lexer.c:974
+msgid "hex"
+msgstr ""
+
+#: src/lexer.c:988
+#, c-format
+msgid "String of %s digits has %d characters, which is not a multiple of %d."
+msgstr ""
+
+#: src/lexer.c:1017
+#, c-format
+msgid "`%c' is not a valid %s digit."
+msgstr ""
+
+#: src/lexer.c:1048
+msgid "Unterminated string constant."
+msgstr ""
+
+#: src/lexer.c:1120
+#, c-format
+msgid "String exceeds 255 characters in length (%d characters)."
+msgstr ""
+
+#: src/lexer.c:1135
+msgid ""
+"Sorry, literal strings may not contain null characters. Replacing with "
+"spaces."
+msgstr ""
+
+#: src/cmdline.c:111
+msgid "-f not yet implemented\n"
+msgstr ""
+
+#: src/cmdline.c:129
+msgid "-n not yet implemented\n"
+msgstr ""
+
+#: src/cmdline.c:140
+msgid "-p not yet implemented\n"
+msgstr ""
+
+#: src/cmdline.c:153
+msgid ""
+"\n"
+"Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.\n"
+"This is free software; see the source for copying conditions. There is NO\n"
+"WARRANTY; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n"
+"\n"
+"Written by Ben Pfaff <blp@gnu.org>."
+msgstr ""
+
+#: src/cmdline.c:213
+#, c-format
+msgid ""
+"PSPP, a program for statistical analysis of sample data.\n"
+"\n"
+"Usage: %s [OPTION]... FILE...\n"
+"\n"
+"If a long option shows an argument as mandatory, then it is mandatory\n"
+"for the equivalent short option also. Similarly for optional arguments.\n"
+"\n"
+"Configuration:\n"
+" -B, --config-dir=DIR set configuration directory to DIR\n"
+" -o, --device=DEVICE select output driver DEVICE and disable "
+"defaults\n"
+" -d, --define=VAR[=VALUE] set environment variable VAR to VALUE, or empty\n"
+" -u, --undef=VAR undefine environment variable VAR\n"
+"\n"
+"Input and output:\n"
+" -f, --out-file=FILE send output to FILE (overwritten)\n"
+" -p, --pipe read script from stdin, send output to stdout\n"
+" -I-, --no-include clear include path\n"
+" -I, --include=DIR append DIR to include path\n"
+" -c, --command=COMMAND execute COMMAND before .pspp/rc at startup\n"
+"\n"
+"Language modifiers:\n"
+" -i, --interactive interpret scripts in interactive mode\n"
+" -n, --edit just check syntax; don't actually run the code\n"
+" -r, --no-statrc disable execution of .pspp/rc at startup\n"
+" -s, --safer don't allow some unsafe operations\n"
+"\n"
+"Informative output:\n"
+" -h, --help print this help, then exit\n"
+" -l, --list print a list of known driver classes, then exit\n"
+" -V, --version show PSPP version, then exit\n"
+" -v, --verbose increments verbosity level\n"
+"\n"
+"Non-option arguments:\n"
+" FILE1 FILE2 run FILE1, clear the dictionary, run FILE2\n"
+" FILE1 + FILE2 run FILE1 then FILE2 without clearing "
+"dictionary\n"
+" KEY=VALUE overrides macros in output initialization file\n"
+"\n"
+msgstr ""
+
+#: src/cmdline.c:246
+msgid ""
+"\n"
+"Report bugs to <bug-gnu-pspp@gnu.org>.\n"
+msgstr ""
+
+#: src/error.c:130
+msgid "Terminating NOW due to a fatal error!"
+msgstr ""
+
+#: src/error.c:207
+msgid "Terminating execution of syntax file due to error."
+msgstr ""
+
+#: src/error.c:209
+#, c-format
+msgid "Errors (%d) exceeds limit (%d)."
+msgstr ""
+
+#: src/error.c:212
+#, c-format
+msgid "Warnings (%d) exceed limit (%d)."
+msgstr ""
+
+#: src/error.c:279
+msgid "fatal"
+msgstr ""
+
+#. SE
+#: src/error.c:282 src/error.c:289 src/error.c:292
+msgid "warning"
+msgstr ""
+
+#. SW
+#: src/error.c:283 src/error.c:293
+msgid "note"
+msgstr ""
+
+#. SM
+#: src/error.c:285 src/error.c:286
+msgid "installation error"
+msgstr ""
+
+#: src/error.c:509
+msgid ""
+"\n"
+"\t*********************\n"
+"\t* INDUCING SEGFAULT *\n"
+"\t*********************\n"
+msgstr ""
+
+#: src/glob.c:183
+msgid ""
+"Your machine does not appear to be either big- or little-endian. At the "
+"moment, PSPP only supports machines of these standard endiannesses. If you "
+"want to hack in others, contact the author."
+msgstr ""
+
+#: src/glob.c:267
+msgid "data> "
+msgstr ""
+
+#: src/glob.c:328
+msgid "Specify a terminal type with `setenv TERM <yourtype>'."
+msgstr ""
+
+#: src/glob.c:339
+msgid "Could not access the termcap data base."
+msgstr ""
+
+#: src/glob.c:341
+#, c-format
+msgid "Terminal type `%s' is not defined."
+msgstr ""
+
+#: src/glob.c:342
+msgid "Assuming screen of size 79x25."
+msgstr ""
+
+#: src/glob.c:377
+msgid "Jan"
+msgstr ""
+
+#: src/glob.c:377
+msgid "Feb"
+msgstr ""
+
+#: src/glob.c:377
+msgid "Mar"
+msgstr ""
+
+#: src/glob.c:377
+msgid "Apr"
+msgstr ""
+
+#: src/glob.c:377
+msgid "May"
+msgstr ""
+
+#: src/glob.c:377
+msgid "Jun"
+msgstr ""
+
+#: src/glob.c:378
+msgid "Jul"
+msgstr ""
+
+#: src/glob.c:378
+msgid "Aug"
+msgstr ""
+
+#: src/glob.c:378
+msgid "Sep"
+msgstr ""
+
+#: src/glob.c:378
+msgid "Oct"
+msgstr ""
+
+#: src/glob.c:378
+msgid "Nov"
+msgstr ""
+
+#: src/glob.c:378
+msgid "Dec"
+msgstr ""
+
+#: src/main.c:65
+msgid "Error initializing output drivers."
+msgstr ""
+
+#: src/main.c:123
+msgid "This command not executed."
+msgstr ""
+
+#: src/main.c:127
+msgid ""
+"Skipping the rest of this command. Part of this command may have been "
+"executed."
+msgstr ""
+
+#: src/main.c:132
+msgid ""
+"Skipping the rest of this command. This command was fully executed up to "
+"this point."
+msgstr ""
+
+#: src/main.c:137
+msgid ""
+"Trailing garbage was encountered following this command. The command was "
+"fully executed to this point."
+msgstr ""
+
+#: src/ascii.c:216
+#, c-format
+msgid "ASCII driver initializing as `%s'..."
+msgstr ""
+
+#: src/ascii.c:273
+#, c-format
+msgid ""
+"ascii driver: Area of page excluding margins and headers must be at least 59 "
+"characters wide by 15 lines long. Page as configured is only %d characters "
+"by %d lines."
+msgstr ""
+
+#: src/ascii.c:378 src/html.c:102 src/postscript.c:474
+#, c-format
+msgid "%s: Initialization complete."
+msgstr ""
+
+#: src/ascii.c:389 src/html.c:114 src/postscript.c:487
+#, c-format
+msgid "%s: Beginning closing..."
+msgstr ""
+
+#: src/ascii.c:399 src/html.c:119 src/postscript.c:506
+#, c-format
+msgid "%s: Finished closing."
+msgstr ""
+
+#: src/ascii.c:460
+#, c-format
+msgid ""
+"Bad index value for `box' key: syntax is box[INDEX], 0 <= INDEX < %d "
+"decimal, with INDEX expressed in base 4."
+msgstr ""
+
+#: src/ascii.c:466
+#, c-format
+msgid "Duplicate value for key `%s'."
+msgstr ""
+
+#: src/ascii.c:476
+#, c-format
+msgid "Unknown configuration parameter `%s' for ascii device driver."
+msgstr ""
+
+#: src/ascii.c:489
+#, c-format
+msgid ""
+"Unknown character set `%s'. Valid character sets are `ascii' and `latin1'."
+msgstr ""
+
+#: src/ascii.c:498
+#, c-format
+msgid ""
+"Unknown overstrike style `%s'. Valid overstrike styles are `single' and "
+"`line'."
+msgstr ""
+
+#: src/ascii.c:507
+#, c-format
+msgid ""
+"Unknown carriage return style `%s'. Valid carriage return styles are `cr' "
+"and `bs'."
+msgstr ""
+
+#: src/ascii.c:519 src/postscript.c:695
+#, c-format
+msgid "Positive integer required as value for `%s'."
+msgstr ""
+
+#: src/ascii.c:550
+#, c-format
+msgid "Zero or positive integer required as value for `%s'."
+msgstr ""
+
+#: src/ascii.c:620 src/postscript.c:654
+#, c-format
+msgid "Boolean value expected for %s."
+msgstr ""
+
+#: src/ascii.c:649 src/ascii.c:664 src/ascii.c:681
+#, c-format
+msgid "ASCII output driver: %s: %s"
+msgstr ""
+
+#: src/ascii.c:750
+#, c-format
+msgid "ascii_line_horz: bad hline (%d,%d),%d out of (%d,%d)\n"
+msgstr ""
+
+#: src/ascii.c:784
+#, c-format
+msgid "ascii_line_vert: bad vline %d,(%d,%d) out of (%d,%d)\n"
+msgstr ""
+
+#: src/ascii.c:814
+#, c-format
+msgid "ascii_line_intersection: bad intsct (%d,%d) out of (%d,%d)\n"
+msgstr ""
+
+#: src/ascii.c:976
+#, c-format
+msgid "%s: horiz=%d, vert=%d\n"
+msgstr ""
+
+#: src/ascii.c:1148
+#, c-format
+msgid "Writing `%s': %s"
+msgstr ""
+
+#: src/ascii.c:1542 src/postscript.c:2116
+#, c-format
+msgid "%s - Page %d"
+msgstr ""
+
+#: src/data-out.c:253
+msgid ""
+"The N output format cannot be used to output a negative number or the "
+"system-missing value."
+msgstr ""
+
+#: src/data-out.c:363
+msgid ""
+"Quality of zoned decimal (Z) output format code is suspect. Check your "
+"results, report bugs to author."
+msgstr ""
+
+#: src/data-out.c:370
+msgid "The system-missing value cannot be output as a zoned decimal number."
+msgstr ""
+
+#: src/data-out.c:383
+#, c-format
+msgid "Number %g too big to fit in field with format Z%d.%d."
+msgstr ""
+
+#: src/data-out.c:777
+#, c-format
+msgid "Time value %g too large in magnitude to convert to alphanumeric time."
+msgstr ""
+
+#: src/data-out.c:830
+#, c-format
+msgid "Weekday index %d does not lie between 1 and 7."
+msgstr ""
+
+#: src/data-out.c:851
+#, c-format
+msgid "Month index %d does not lie between 1 and 12."
+msgstr ""
+
+#: src/data-out.c:963
+#, c-format
+msgid ""
+"Year %d cannot be represented in four digits for output formatting purposes."
+msgstr ""
+
+#: src/groff-font.c:107
+#, c-format
+msgid "%s: Opening Groff font file..."
+msgstr ""
+
+#: src/groff-font.c:162
+msgid "Missing font name."
+msgstr ""
+
+#: src/groff-font.c:172
+msgid "Missing encoding filename."
+msgstr ""
+
+#: src/groff-font.c:185
+msgid "Bad spacewidth value."
+msgstr ""
+
+#: src/groff-font.c:197
+msgid "Bad slant value."
+msgstr ""
+
+#: src/groff-font.c:222
+#, c-format
+msgid "Unknown ligature `%s'."
+msgstr ""
+
+#: src/groff-font.c:257
+msgid "Unexpected end of line reading character set."
+msgstr ""
+
+#: src/groff-font.c:265
+msgid "Can't use ditto mark for first character."
+msgstr ""
+
+#: src/groff-font.c:270
+msgid "Can't ditto into an unnamed character."
+msgstr ""
+
+#: src/groff-font.c:287
+#, c-format
+msgid "Missing metrics for character `%s'."
+msgstr ""
+
+#: src/groff-font.c:296
+#, c-format
+msgid "Missing type for character `%s'."
+msgstr ""
+
+#: src/groff-font.c:305
+#, c-format
+msgid "Missing code for character `%s'."
+msgstr ""
+
+#: src/groff-font.c:324
+msgid "Malformed kernpair."
+msgstr ""
+
+#: src/groff-font.c:331
+msgid "Unexpected end of line reading kernpairs."
+msgstr ""
+
+#: src/groff-font.c:337
+msgid "Bad kern value."
+msgstr ""
+
+#: src/groff-font.c:369
+#, c-format
+msgid "Font read successfully with internal name %s."
+msgstr ""
+
+#: src/groff-font.c:389
+msgid "Error reading font."
+msgstr ""
+
+#: src/groff-font.c:400
+msgid "installation error: Groff font error: "
+msgstr ""
+
+#: src/groff-font.c:425
+#, c-format
+msgid "Bad character \\%3o."
+msgstr ""
+
+#: src/groff-font.c:665
+#, c-format
+msgid "Groff font error: Cannot find \"%s\"."
+msgstr ""
+
+#: src/groff-font.c:730
+#, c-format
+msgid "%s: Opening Groff description file..."
+msgstr ""
+
+#: src/groff-font.c:746
+msgid "Multiple `sizes' declarations."
+msgstr ""
+
+#: src/groff-font.c:763
+msgid "Unexpected end of file. Missing 0 terminator to `sizes' command?"
+msgstr ""
+
+#: src/groff-font.c:775 src/groff-font.c:782 src/groff-font.c:795
+msgid "Bad argument to `sizes'."
+msgstr ""
+
+#: src/groff-font.c:787
+msgid "Bad range in argument to `sizes'."
+msgstr ""
+
+#: src/groff-font.c:816
+msgid "Family name expected."
+msgstr ""
+
+#: src/groff-font.c:821
+msgid "This command already specified."
+msgstr ""
+
+#: src/groff-font.c:841
+#, c-format
+msgid "%s: Device characteristic already defined."
+msgstr ""
+
+#: src/groff-font.c:847
+#, c-format
+msgid "%s: Invalid numeric format."
+msgstr ""
+
+#: src/groff-font.c:877
+msgid "Missing `res', `unitwidth', and/or `sizes' line(s)."
+msgstr ""
+
+#: src/groff-font.c:903
+msgid "Description file read successfully."
+msgstr ""
+
+#: src/groff-font.c:935
+msgid "Error reading description file."
+msgstr ""
+
+#: src/groff-font.c:991
+msgid "<<fallback>>"
+msgstr ""
+
+#: src/html.c:66
+#, c-format
+msgid "HTML driver initializing as `%s'..."
+msgstr ""
+
+#: src/html.c:154
+#, c-format
+msgid "Unknown configuration parameter `%s' for HTML device driver."
+msgstr ""
+
+#: src/html.c:240
+msgid ""
+"Cannot find HTML prologue. The use of `-vv' on the command line is "
+"suggested as a debugging aid."
+msgstr ""
+
+#: src/html.c:245
+#, c-format
+msgid "%s: %s: Opening HTML prologue..."
+msgstr ""
+
+#: src/html.c:272 src/html.c:283 src/postscript.c:1372 src/postscript.c:1383
+msgid "nobody"
+msgstr ""
+
+#: src/html.c:279 src/html.c:284 src/postscript.c:1379 src/postscript.c:1384
+msgid "nowhere"
+msgstr ""
+
+#: src/html.c:343
+#, c-format
+msgid "%s: HTML prologue read successfully."
+msgstr ""
+
+#: src/html.c:347
+#, c-format
+msgid "%s: Error reading HTML prologue."
+msgstr ""
+
+#: src/html.c:375
+#, c-format
+msgid "HTML output driver: %s: %s"
+msgstr ""
+
+#: src/html.c:406 src/list.q:277
+#, c-format
+msgid "Cannot open first page on HTML device %s."
+msgstr ""
+
+#: src/output.c:162
+#, c-format
+msgid "Unknown output driver `%s'."
+msgstr ""
+
+#: src/output.c:164
+#, c-format
+msgid "Output driver `%s' referenced but never defined."
+msgstr ""
+
+#: src/output.c:292
+msgid "Cannot find output initialization file. Use `-vv' to view search path."
+msgstr ""
+
+#: src/output.c:297
+#, c-format
+msgid "%s: Opening device description file..."
+msgstr ""
+
+#: src/output.c:301 src/output.c:1161 src/postscript.c:1114
+#, c-format
+msgid "Opening %s: %s."
+msgstr ""
+
+#: src/output.c:313 src/output.c:1173 src/postscript.c:1131
+#, c-format
+msgid "Reading %s: %s."
+msgstr ""
+
+#: src/output.c:335 src/output.c:487
+msgid "Syntax error."
+msgstr ""
+
+#: src/output.c:345 src/postscript.c:1142
+#, c-format
+msgid "Closing %s: %s."
+msgstr ""
+
+#: src/output.c:350
+msgid "No output drivers are active."
+msgstr ""
+
+#: src/output.c:353
+msgid "Device definition file read successfully."
+msgstr ""
+
+#: src/output.c:355
+msgid "Error reading device definition file."
+msgstr ""
+
+#: src/output.c:459
+msgid ""
+"Driver classes:\n"
+"\t"
+msgstr ""
+
+#: src/output.c:588
+msgid "Syntax error in string constant."
+msgstr ""
+
+#: src/output.c:619
+msgid "Syntax error in options."
+msgstr ""
+
+#: src/output.c:629
+msgid "Syntax error in options (`=' expected)."
+msgstr ""
+
+#: src/output.c:636
+msgid "Syntax error in options (value expected after `=')."
+msgstr ""
+
+#: src/output.c:708
+msgid "Driver name expected."
+msgstr ""
+
+#: src/output.c:729
+msgid "Class name expected."
+msgstr ""
+
+#: src/output.c:738
+#, c-format
+msgid "Unknown output driver class `%s'."
+msgstr ""
+
+#: src/output.c:745
+#, c-format
+msgid "Can't initialize output driver class `%s'."
+msgstr ""
+
+#: src/output.c:752
+#, c-format
+msgid "Can't initialize output driver `%s' of class `%s'."
+msgstr ""
+
+#: src/output.c:774
+#, c-format
+msgid "Unknown device type `%s'."
+msgstr ""
+
+#: src/output.c:786
+#, c-format
+msgid "Can't complete initialization of output driver `%s' of class `%s'."
+msgstr ""
+
+#: src/output.c:833
+#, c-format
+msgid "Can't deinitialize output driver class `%s'."
+msgstr ""
+
+#: src/output.c:906
+#, c-format
+msgid "Trying to find keyword `%s'...\n"
+msgstr ""
+
+#: src/output.c:1023
+#, c-format
+msgid "Unit \"%s\" is unknown in dimension \"%s\"."
+msgstr ""
+
+#: src/output.c:1038
+#, c-format
+msgid "Bad dimension \"%s\"."
+msgstr ""
+
+#: src/output.c:1064
+#, c-format
+msgid "`x' expected in paper size `%s'."
+msgstr ""
+
+#: src/output.c:1074
+#, c-format
+msgid "Trailing garbage `%s' on paper size `%s'."
+msgstr ""
+
+#: src/output.c:1123
+msgid "Paper size name must not be empty."
+msgstr ""
+
+#: src/output.c:1153
+msgid "Cannot find `papersize' configuration file."
+msgstr ""
+
+#: src/output.c:1157
+#, c-format
+msgid "%s: Opening paper size definition file..."
+msgstr ""
+
+#: src/output.c:1200
+msgid "Syntax error in paper size definition."
+msgstr ""
+
+#: src/output.c:1229
+msgid "Paper size definition file read successfully."
+msgstr ""
+
+#: src/output.c:1231
+msgid "Error reading paper size definition file."
+msgstr ""
+
+#: src/output.c:1300
+#, c-format
+msgid "Error closing page on %s device of %s class."
+msgstr ""
+
+#: src/output.c:1304
+#, c-format
+msgid "Error opening page on %s device of %s class."
+msgstr ""
+
+#: src/postscript.c:339
+#, c-format
+msgid "PostScript driver initializing as `%s'..."
+msgstr ""
+
+#: src/postscript.c:463
+#, c-format
+msgid ""
+"PostScript driver: The defined page is not long enough to hold margins and "
+"headers, plus least 15 lines of the default fonts. In fact, there's only "
+"room for %d lines of each font at the default size of %d.%03d points."
+msgstr ""
+
+#: src/postscript.c:592
+#, c-format
+msgid "Unknown configuration parameter `%s' for PostScript device driver."
+msgstr ""
+
+#: src/postscript.c:608
+#, c-format
+msgid ""
+"Unknown orientation `%s'. Valid orientations are `portrait' and `landscape'."
+msgstr ""
+
+#: src/postscript.c:620
+msgid ""
+"Unknown value for `data'. Valid values are `clean7bit', `clean8bit', and "
+"`binary'."
+msgstr ""
+
+#: src/postscript.c:629
+msgid "Unknown value for `line-ends'. Valid values are `lf' and `crlf'."
+msgstr ""
+
+#: src/postscript.c:638
+msgid "Unknown value for `line-style'. Valid values are `thick' and `double'."
+msgstr ""
+
+#: src/postscript.c:700
+#, c-format
+msgid ""
+"Default font size must be at least 1 point (value of 1000 for key `%s')."
+msgstr ""
+
+#: src/postscript.c:732
+#, c-format
+msgid "Value for `%s' must be a dimension of positive length (i.e., `1in')."
+msgstr ""
+
+#: src/postscript.c:795
+#, c-format
+msgid "Nonnegative integer required as value for `%s'."
+msgstr ""
+
+#: src/postscript.c:925
+#, c-format
+msgid "%s: %s: Opening PostScript font encoding..."
+msgstr ""
+
+#: src/postscript.c:931
+#, c-format
+msgid ""
+"PostScript driver: Cannot open encoding file `%s': %s. Substituting "
+"ISOLatin1Encoding for missing encoding."
+msgstr ""
+
+#: src/postscript.c:970
+msgid "PostScript driver: Invalid numeric format."
+msgstr ""
+
+#: src/postscript.c:975
+#, c-format
+msgid ""
+"PostScript driver: Codes must be between 0 and 255. (%d is not allowed.)"
+msgstr ""
+
+#: src/postscript.c:1011
+#, c-format
+msgid "PostScript driver: Error closing encoding file `%s'."
+msgstr ""
+
+#: src/postscript.c:1014
+#, c-format
+msgid "%s: PostScript font encoding read successfully."
+msgstr ""
+
+#: src/postscript.c:1109
+#, c-format
+msgid "%s: %s: Opening PostScript encoding list file."
+msgstr ""
+
+#: src/postscript.c:1144
+#, c-format
+msgid "%s: PostScript encoding list file read successfully."
+msgstr ""
+
+#: src/postscript.c:1158
+msgid "<<default encoding>>"
+msgstr ""
+
+#: src/postscript.c:1316
+msgid ""
+"Cannot find PostScript prologue. The use of `-vv' on the command line is "
+"suggested as a debugging aid."
+msgstr ""
+
+#: src/postscript.c:1321
+#, c-format
+msgid "%s: %s: Opening PostScript prologue..."
+msgstr ""
+
+#: src/postscript.c:1493
+#, c-format
+msgid "%s: PostScript prologue read successfully."
+msgstr ""
+
+#: src/postscript.c:1497
+#, c-format
+msgid "%s: Error reading PostScript prologue."
+msgstr ""
+
+#: src/postscript.c:1667
+#, c-format
+msgid "PostScript output driver: %s: %s"
+msgstr ""
+
+#: src/postscript.c:2355
+#, c-format
+msgid "PostScript driver: Cannot find encoding `%s' for PostScript font `%s'."
+msgstr ""
+
+#: src/tab.c:276
+#, c-format
+msgid "bad vline: x=%d+%d=%d y=(%d+%d=%d,%d+%d=%d) in table size (%d,%d)\n"
+msgstr ""
+
+#: src/tab.c:312
+#, c-format
+msgid "bad hline: x=(%d+%d=%d,%d+%d=%d) y=%d+%d=%d in table size (%d,%d)\n"
+msgstr ""
+
+#: src/tab.c:352
+#, c-format
+msgid ""
+"bad box: (%d+%d=%d,%d+%d=%d)-(%d+%d=%d,%d+%d=%d) in table size (%d,%d)\n"
+msgstr ""
+
+#: src/do-if.c:121
+msgid "There is no DO IF to match with this ELSE IF."
+msgstr ""
+
+#: src/do-if.c:126
+msgid "The ELSE command must follow all ELSE IF commands in a DO IF structure."
+msgstr ""
+
+#: src/do-if.c:149
+msgid "End of command expected."
+msgstr ""
+
+#: src/do-if.c:167
+msgid "There is no DO IF to match with this ELSE."
+msgstr ""
+
+#: src/do-if.c:173
+msgid ""
+"There may be at most one ELSE clause in each DO IF structure. It must be "
+"the last clause."
+msgstr ""
+
+#: src/do-if.c:210
+msgid "There is no DO IF to match with this END IF."
+msgstr ""
+
+#: src/do-if.c:296
+#, c-format
+msgid "DO IF %d: true\n"
+msgstr ""
+
+#: src/do-if.c:301
+#, c-format
+msgid "DO IF %d: false\n"
+msgstr ""
+
+#: src/do-if.c:306
+#, c-format
+msgid "DO IF %d: missing\n"
+msgstr ""
+
+#: src/crosstabs.q:273
+msgid ""
+"Missing mode REPORT not allowed in general mode. Assuming MISSING=TABLE."
+msgstr ""
+
+#: src/crosstabs.q:283
+msgid "Write mode ALL not allowed in general mode. Assuming WRITE=CELLS."
+msgstr ""
+
+#: src/crosstabs.q:367
+msgid "expecting BY"
+msgstr ""
+
+#: src/crosstabs.q:440
+msgid "VARIABLES must be specified before TABLES."
+msgstr ""
+
+#: src/crosstabs.q:477
+#, c-format
+msgid "Maximum value (%ld) less than minimum value (%ld)."
+msgstr ""
+
+#: src/crosstabs.q:937
+msgid "Summary."
+msgstr ""
+
+#: src/crosstabs.q:939
+msgid "Cases"
+msgstr ""
+
+#: src/crosstabs.q:940 src/frequencies.q:893
+msgid "Valid"
+msgstr ""
+
+#: src/crosstabs.q:941 src/frequencies.q:960
+msgid "Missing"
+msgstr ""
+
+#: src/crosstabs.q:942 src/crosstabs.q:1143 src/crosstabs.q:1886
+#: src/frequencies.q:969
+msgid "Total"
+msgstr ""
+
+#: src/crosstabs.q:952
+msgid "N"
+msgstr ""
+
+#: src/crosstabs.q:953 src/frequencies.q:897 src/frequencies.q:898
+#: src/frequencies.q:899
+msgid "Percent"
+msgstr ""
+
+#: src/crosstabs.q:1192
+msgid "count"
+msgstr ""
+
+#: src/crosstabs.q:1193
+#, c-format
+msgid "row %"
+msgstr ""
+
+#: src/crosstabs.q:1194
+#, c-format
+msgid "column %"
+msgstr ""
+
+#: src/crosstabs.q:1195
+#, c-format
+msgid "total %"
+msgstr ""
+
+#: src/crosstabs.q:1196
+msgid "expected"
+msgstr ""
+
+#: src/crosstabs.q:1197
+msgid "residual"
+msgstr ""
+
+#: src/crosstabs.q:1198
+msgid "std. resid."
+msgstr ""
+
+#: src/crosstabs.q:1199
+msgid "adj. resid."
+msgstr ""
+
+#: src/crosstabs.q:1232 src/crosstabs.q:1259 src/crosstabs.q:1279
+#: src/crosstabs.q:1300
+msgid "Statistic"
+msgstr ""
+
+#: src/crosstabs.q:1234
+msgid "df"
+msgstr ""
+
+#: src/crosstabs.q:1236
+msgid "Asymp. Sig. (2-sided)"
+msgstr ""
+
+#: src/crosstabs.q:1238
+msgid "Exact. Sig. (2-sided)"
+msgstr ""
+
+#: src/crosstabs.q:1240
+msgid "Exact. Sig. (1-sided)"
+msgstr ""
+
+#: src/crosstabs.q:1258 src/crosstabs.q:1299
+msgid "Category"
+msgstr ""
+
+#: src/crosstabs.q:1261 src/crosstabs.q:1303
+msgid "Asymp. Std. Error"
+msgstr ""
+
+#: src/crosstabs.q:1262 src/crosstabs.q:1304
+msgid "Approx. T"
+msgstr ""
+
+#: src/crosstabs.q:1263 src/crosstabs.q:1305
+msgid "Approx. Sig."
+msgstr ""
+
+#: src/crosstabs.q:1278
+msgid " 95%% Confidence Interval"
+msgstr ""
+
+#: src/crosstabs.q:1281
+msgid "Lower"
+msgstr ""
+
+#: src/crosstabs.q:1282
+msgid "Upper"
+msgstr ""
+
+#: src/crosstabs.q:1301
+msgid "Type"
+msgstr ""
+
+#: src/crosstabs.q:2063
+msgid "Pearson Chi-Square"
+msgstr ""
+
+#: src/crosstabs.q:2064
+msgid "Likelihood Ratio"
+msgstr ""
+
+#: src/crosstabs.q:2065
+msgid "Fisher's Exact Test"
+msgstr ""
+
+#: src/crosstabs.q:2066
+msgid "Continuity Correction"
+msgstr ""
+
+#: src/crosstabs.q:2067
+msgid "Linear-by-Linear Association"
+msgstr ""
+
+#: src/crosstabs.q:2104 src/crosstabs.q:2174 src/crosstabs.q:2233
+msgid "N of Valid Cases"
+msgstr ""
+
+#: src/crosstabs.q:2120 src/crosstabs.q:2249
+msgid "Nominal by Nominal"
+msgstr ""
+
+#: src/crosstabs.q:2121 src/crosstabs.q:2250
+msgid "Ordinal by Ordinal"
+msgstr ""
+
+#: src/crosstabs.q:2122
+msgid "Interval by Interval"
+msgstr ""
+
+#: src/crosstabs.q:2123
+msgid "Measure of Agreement"
+msgstr ""
+
+#: src/crosstabs.q:2128
+msgid "Phi"
+msgstr ""
+
+#: src/crosstabs.q:2129
+msgid "Cramer's V"
+msgstr ""
+
+#: src/crosstabs.q:2130
+msgid "Contingency Coefficient"
+msgstr ""
+
+#: src/crosstabs.q:2131
+msgid "Kendall's tau-b"
+msgstr ""
+
+#: src/crosstabs.q:2132
+msgid "Kendall's tau-c"
+msgstr ""
+
+#: src/crosstabs.q:2133
+msgid "Gamma"
+msgstr ""
+
+#: src/crosstabs.q:2134
+msgid "Spearman Correlation"
+msgstr ""
+
+#: src/crosstabs.q:2135
+msgid "Pearson's R"
+msgstr ""
+
+#: src/crosstabs.q:2136
+msgid "Kappa"
+msgstr ""
+
+#: src/crosstabs.q:2206
+#, c-format
+msgid "Odds Ratio for %s (%g / %g)"
+msgstr ""
+
+#: src/crosstabs.q:2209
+#, c-format
+msgid "Odds Ratio for %s (%.*s / %.*s)"
+msgstr ""
+
+#: src/crosstabs.q:2217
+#, c-format
+msgid "For cohort %s = %g"
+msgstr ""
+
+#: src/crosstabs.q:2220
+#, c-format
+msgid "For cohort %s = %.*s"
+msgstr ""
+
+#: src/crosstabs.q:2251
+msgid "Nominal by Interval"
+msgstr ""
+
+#: src/crosstabs.q:2256
+msgid "Lambda"
+msgstr ""
+
+#: src/crosstabs.q:2257
+msgid "Goodman and Kruskal tau"
+msgstr ""
+
+#: src/crosstabs.q:2258
+msgid "Uncertainty Coefficient"
+msgstr ""
+
+#: src/crosstabs.q:2259
+msgid "Somers' d"
+msgstr ""
+
+#: src/crosstabs.q:2260
+msgid "Eta"
+msgstr ""
+
+#: src/crosstabs.q:2265
+msgid "Symmetric"
+msgstr ""
+
+#: src/crosstabs.q:2266 src/crosstabs.q:2267
+#, c-format
+msgid "%s Dependent"
+msgstr ""
+
+#: src/descript.q:151 src/frequencies.q:95
+msgid "Mean"
+msgstr ""
+
+#: src/descript.q:151
+msgid "mean"
+msgstr ""
+
+#: src/descript.q:152 src/frequencies.q:96
+msgid "S.E. Mean"
+msgstr ""
+
+#: src/descript.q:152
+msgid "S E Mean"
+msgstr ""
+
+#: src/descript.q:152
+msgid "SE"
+msgstr ""
+
+#: src/descript.q:153
+msgid "standard error of mean"
+msgstr ""
+
+#: src/descript.q:154 src/frequencies.q:99
+msgid "Std Dev"
+msgstr ""
+
+#: src/descript.q:154
+msgid "SD"
+msgstr ""
+
+#: src/descript.q:155
+msgid "standard deviation"
+msgstr ""
+
+#: src/descript.q:156 src/frequencies.q:100
+msgid "Variance"
+msgstr ""
+
+#: src/descript.q:157
+msgid "Var"
+msgstr ""
+
+#: src/descript.q:157
+msgid "variance"
+msgstr ""
+
+#: src/descript.q:158 src/frequencies.q:101
+msgid "Kurtosis"
+msgstr ""
+
+#: src/descript.q:159
+msgid "Kurt"
+msgstr ""
+
+#: src/descript.q:159
+msgid "kurtosis"
+msgstr ""
+
+#: src/descript.q:160 src/frequencies.q:102
+msgid "S.E. Kurt"
+msgstr ""
+
+#: src/descript.q:160
+msgid "S E Kurt"
+msgstr ""
+
+#: src/descript.q:160
+msgid "SEKurt"
+msgstr ""
+
+#: src/descript.q:161
+msgid "standard error of kurtosis"
+msgstr ""
+
+#: src/descript.q:162 src/frequencies.q:103
+msgid "Skewness"
+msgstr ""
+
+#: src/descript.q:162
+msgid "Skew"
+msgstr ""
+
+#: src/descript.q:163
+msgid "skewness"
+msgstr ""
+
+#: src/descript.q:164 src/frequencies.q:104
+msgid "S.E. Skew"
+msgstr ""
+
+#: src/descript.q:164
+msgid "S E Skew"
+msgstr ""
+
+#: src/descript.q:164
+msgid "SESkew"
+msgstr ""
+
+#: src/descript.q:165
+msgid "standard error of skewness"
+msgstr ""
+
+#: src/descript.q:166 src/frequencies.q:105
+msgid "Range"
+msgstr ""
+
+#: src/descript.q:166
+msgid "Rng"
+msgstr ""
+
+#: src/descript.q:167 src/frequencies.q:106
+msgid "Minimum"
+msgstr ""
+
+#: src/descript.q:167
+msgid "Min"
+msgstr ""
+
+#: src/descript.q:168
+msgid "minimum"
+msgstr ""
+
+#: src/descript.q:169 src/frequencies.q:107
+msgid "Maximum"
+msgstr ""
+
+#: src/descript.q:169
+msgid "Max"
+msgstr ""
+
+#: src/descript.q:170
+msgid "maximum"
+msgstr ""
+
+#: src/descript.q:171 src/frequencies.q:108
+msgid "Sum"
+msgstr ""
+
+#: src/descript.q:171
+msgid "sum"
+msgstr ""
+
+#: src/descript.q:212 src/list.q:161
+msgid "No variables specified."
+msgstr ""
+
+#: src/descript.q:218
+msgid "OPTIONS may not be used with SAVE, FORMAT, or MISSING."
+msgstr ""
+
+#: src/descript.q:280
+#, c-format
+msgid "It's not possible to sort on `%s' without displaying `%s'."
+msgstr ""
+
+#: src/descript.q:295
+msgid ""
+"At least one case in the data file had a weight value that was "
+"system-missing, zero, or negative. These case(s) were ignored."
+msgstr ""
+
+#: src/descript.q:336
+msgid ""
+"Names for z-score variables must be given for individual variables, not for "
+"groups of variables."
+msgstr ""
+
+#: src/descript.q:344
+msgid "Name for z-score variable expected."
+msgstr ""
+
+#: src/descript.q:349
+#, c-format
+msgid ""
+"Z-score variable name `%s' is a duplicate variable name with a current "
+"variable."
+msgstr ""
+
+#: src/descript.q:358
+#, c-format
+msgid "Z-score variable name `%s' is used multiple times."
+msgstr ""
+
+#: src/descript.q:366
+msgid "`)' expected after z-score variable name."
+msgstr ""
+
+#: src/descript.q:426
+msgid ""
+"Ran out of generic names for Z-score variables. There are only 126 generic "
+"names: ZSC001-ZSC0999, STDZ01-STDZ09, ZZZZ01-ZZZZ09, ZQZQ01-ZQZQ09."
+msgstr ""
+
+#: src/descript.q:455
+msgid "Mapping of variables to corresponding Z-scores."
+msgstr ""
+
+#: src/descript.q:460
+msgid "Source"
+msgstr ""
+
+#: src/descript.q:461
+msgid "Target"
+msgstr ""
+
+#: src/descript.q:548 src/descript.q:554
+msgid "Z-score of "
+msgstr ""
+
+#: src/descript.q:803
+msgid "Valid N"
+msgstr ""
+
+#: src/descript.q:804
+msgid "Missing N"
+msgstr ""
+
+#: src/descript.q:831
+#, c-format
+msgid "Valid cases = %g; cases with missing value(s) = %g."
+msgstr ""
+
+#: src/frequencies.q:97
+msgid "Median"
+msgstr ""
+
+#: src/frequencies.q:98
+msgid "Mode"
+msgstr ""
+
+#: src/frequencies.q:271
+msgid ""
+"At most one of BARCHART, HISTOGRAM, or HBAR should be given. HBAR will be "
+"assumed. Argument values will be given precedence increasing along the "
+"order given."
+msgstr ""
+
+#: src/frequencies.q:352
+#, c-format
+msgid ""
+"MAX must be greater than or equal to MIN, if both are specified. However, "
+"MIN was specified as %g and MAX as %g. MIN and MAX will be ignored."
+msgstr ""
+
+#: src/frequencies.q:602
+msgid ""
+"Upper limit of integer mode value range must be greater than lower limit."
+msgstr ""
+
+#: src/frequencies.q:614
+#, c-format
+msgid "Variable %s specified multiple times on VARIABLES subcommand."
+msgstr ""
+
+#: src/frequencies.q:627
+#, c-format
+msgid "Integer mode specified, but %s is not a numeric variable."
+msgstr ""
+
+#: src/frequencies.q:687
+msgid "`)' expected after GROUPED interval list."
+msgstr ""
+
+#: src/frequencies.q:697
+#, c-format
+msgid "Variables %s specified on GROUPED but not on VARIABLES."
+msgstr ""
+
+#: src/frequencies.q:700
+#, c-format
+msgid "Variables %s specified multiple times on GROUPED subcommand."
+msgstr ""
+
+#: src/frequencies.q:751
+msgid "Percentile list expected after PERCENTILES."
+msgstr ""
+
+#: src/frequencies.q:759
+msgid "Percentiles must be greater than 0 and less than 100."
+msgstr ""
+
+#: src/frequencies.q:894 src/frequencies.q:984 src/frequencies.q:985
+#: src/frequencies.q:1015
+msgid "Cum"
+msgstr ""
+
+#: src/frequencies.q:896 src/frequencies.q:1420
+msgid "Frequency"
+msgstr ""
+
+#: src/frequencies.q:915
+msgid "Value Label"
+msgstr ""
+
+#: src/frequencies.q:1013
+msgid "Freq"
+msgstr ""
+
+#: src/frequencies.q:1014 src/frequencies.q:1016
+msgid "Pct"
+msgstr ""
+
+#: src/frequencies.q:1132
+#, c-format
+msgid "No valid data for variable %s; statistics not displayed."
+msgstr ""
+
+#: src/frequencies.q:1226
+#, c-format
+msgid "only %g case%s for variable %s, statistics not computed"
+msgstr ""
+
+#: src/frequencies.q:1261
+#, c-format
+msgid ""
+"The variable %s has %d modes. The lowest of these is the one given in the "
+"table."
+msgstr ""
+
+#. Draw axis labels.
+#. 18-point text
+#: src/frequencies.q:1420
+msgid "Percentage"
+msgstr ""
+
+#: src/frequencies.q:1443
+msgid "low-res graphs not implemented"
+msgstr ""
+
+#: src/frequencies.q:1577
+#, c-format
+msgid ""
+"Could not make histogram for %s for specified minimum %g and maximum %g; "
+"please discard graph."
+msgstr ""
+
+#: src/frequencies.q:1716
+msgid "Percentile Value Percentile Value Percentile Value"
+msgstr ""
+
+#: src/frequencies.q:1733
+msgid "this form of percentiles not supported"
+msgstr ""
+
+#: src/frequencies.q:1797
+#, c-format
+msgid "Difference between %g and %g is too small for grouping interval %g."
+msgstr ""
+
+#: src/list.q:169
+#, c-format
+msgid ""
+"The first case (%ld) specified precedes the last case (%ld) specified. The "
+"values will be swapped."
+msgstr ""
+
+#: src/list.q:177
+#, c-format
+msgid ""
+"The first case (%ld) to list is less than 1. The value is being reset to 1."
+msgstr ""
+
+#: src/list.q:183
+#, c-format
+msgid ""
+"The last case (%ld) to list is less than 1. The value is being reset to 1."
+msgstr ""
+
+#: src/list.q:189
+#, c-format
+msgid "The step value %ld is less than 1. The value is being reset to 1."
+msgstr ""
+
+#: src/list.q:217
+msgid "`/FORMAT WEIGHT' specified, but weighting is not on."
+msgstr ""
+
+#: src/list.q:455
+msgid "Line"
+msgstr ""
+
+#: src/means.q:108
+msgid "Missing required subcommand TABLES."
+msgstr ""
+
+#: src/means.q:155
+msgid "TABLES or CROSSBREAK subcommand may not appear more than once."
+msgstr ""
+
+#: src/means.q:202
+#, c-format
+msgid ""
+"Variable %s specified on TABLES or CROSSBREAK, but not specified on "
+"VARIABLES."
+msgstr ""
+
+#: src/means.q:216
+#, c-format
+msgid "LOWEST and HIGHEST may not be used for independent variables (%s)."
+msgstr ""
+
+#: src/means.q:224
+#, c-format
+msgid ""
+"Independent variables (%s) may not have noninteger endpoints in their ranges."
+msgstr ""
+
+#: src/means.q:245
+#, c-format
+msgid "Variable %s is multiply specified on TABLES or CROSSBREAK."
+msgstr ""
+
+#: src/means.q:271
+msgid "VARIABLES must precede TABLES."
+msgstr ""
+
+#: src/means.q:328
+#, c-format
+msgid "Upper value (%g) is less than lower value (%g) on VARIABLES subcommand."
+msgstr ""
+
+#: src/t-test.q:470
+msgid "expecting variable name in GROUPS subcommand"
+msgstr ""
+
+#: src/t-test.q:475
+#, c-format
+msgid "Long string variable %s is not valid here."
+msgstr ""
+
+#: src/t-test.q:491
+msgid ""
+"When applying GROUPS to a string variable, at least one value must be "
+"specified."
+msgstr ""
+
+#: src/t-test.q:581
+#, c-format
+msgid ""
+"PAIRED was specified but the number of variables preceding WITH (%d) did not "
+"match the number following (%d)."
+msgstr ""
+
+#: src/t-test.q:597
+msgid "At least two variables must be specified on PAIRS."
+msgstr ""
+
+#: src/count.c:189
+msgid "Destination cannot be a string variable."
+msgstr ""
+
+#: src/count.c:299
+#, c-format
+msgid ""
+"%g THRU %g is not a valid range. The number following THRU must be at least "
+"as big as the number preceding THRU."
+msgstr ""
+
+#: src/vars-atr.c:61
+msgid "Vartree:\n"
+msgstr ""
+
+#: src/vars-atr.c:313
+#, c-format
+msgid "clearing variable %d:%s %s\n"
+msgstr ""
+
+#: src/vars-atr.c:314
+msgid "in default dictionary"
+msgstr ""
+
+#: src/vars-atr.c:315
+msgid "in auxiliary dictionary"
+msgstr ""
+
+#: src/vars-prs.c:113
+#, c-format
+msgid "%s is not declared as a variable."
+msgstr ""
+
+#: src/vars-prs.c:131
+#, c-format
+msgid "%s is not a variable name."
+msgstr ""
+
+#: src/vars-prs.c:230
+#, c-format
+msgid "%s TO %s is not valid syntax since %s precedes %s in the dictionary."
+msgstr ""
+
+#: src/vars-prs.c:239
+#, c-format
+msgid ""
+"When using the TO keyword to specify several variables, both variables must "
+"be from the same variable dictionaries, of either ordinary, scratch, or "
+"system variables. %s and %s are from different dictionaries."
+msgstr ""
+
+#: src/vars-prs.c:256
+#, c-format
+msgid "Scratch variables (such as %s) are not allowed here."
+msgstr ""
+
+#: src/vars-prs.c:279
+#, c-format
+msgid ""
+"%s is not a numeric variable. It will not be included in the variable list."
+msgstr ""
+
+#: src/vars-prs.c:285
+#, c-format
+msgid ""
+"%s is not a string variable. It will not be included in the variable list."
+msgstr ""
+
+#: src/vars-prs.c:291
+#, c-format
+msgid ""
+"%s and %s are not the same type. All variables in this variable list must "
+"be of the same type. %s will be omitted from list."
+msgstr ""
+
+#: src/vars-prs.c:299
+#, c-format
+msgid "Variable %s appears twice in variable list."
+msgstr ""
+
+#: src/vars-prs.c:370
+msgid "incorrect use of TO convention"
+msgstr ""
+
+#: src/vars-prs.c:410
+msgid "Scratch variables not allowed here."
+msgstr ""
+
+#: src/vars-prs.c:432
+msgid "Prefixes don't match in use of TO convention."
+msgstr ""
+
+#: src/vars-prs.c:437
+msgid "Bad bounds in use of TO convention."
+msgstr ""
+
+#: src/vfm.c:311
+#, c-format
+msgid ""
+"Workspace overflow predicted. Max workspace is currently set to %d KB (%d "
+"cases at %d bytes each). Paging active file to disk."
+msgstr ""
+
+#: src/vfm.c:374
+msgid "!ERROR!"
+msgstr ""
+
+#: src/vfm.c:395
+msgid "<NOVAR>"
+msgstr ""
+
+#: src/vfm.c:655
+#, c-format
+msgid ""
+"An error occurred attempting to create a temporary file for use as the "
+"active file: %s."
+msgstr ""
+
+#: src/vfm.c:673
+#, c-format
+msgid ""
+"An error occurred while attempting to read from a temporary file created for "
+"the active file: %s."
+msgstr ""
+
+#: src/vfm.c:701
+#, c-format
+msgid ""
+"An error occurred while attempting to write to a temporary file used as the "
+"active file: %s."
+msgstr ""
+
+#: src/vfm.c:715
+#, c-format
+msgid ""
+"An error occurred while attempting to rewind a temporary file used as the "
+"active file: %s."
+msgstr ""
+
+#: src/vfm.c:830
+msgid "Virtual memory exhausted. Paging active file to disk."
+msgstr ""
+
+#: src/vfm.c:833
+#, c-format
+msgid ""
+"Workspace limit of %d KB (%d cases at %d bytes each) overflowed. Paging "
+"active file to disk."
+msgstr ""
+
+#: src/vfm.c:857 src/vfm.c:894
+#, c-format
+msgid ""
+"An error occurred while attempting to write to a temporary file created as "
+"the active file, while paging to disk: %s."
+msgstr ""
+
+#: src/vfm.c:1008
+msgid "transform: "
+msgstr ""
+
+#: src/autorecode.c:135
+#, c-format
+msgid "Target variable %s duplicates existing variable %s."
+msgstr ""
+
+#: src/autorecode.c:142
+#, c-format
+msgid "Duplicate variable name %s among target variables."
+msgstr ""
+
+#: src/compute.c:140 src/compute.c:186 src/compute.c:292 src/compute.c:329
+#, c-format
+msgid ""
+"When executing COMPUTE: SYSMIS is not a valid value as an index into vector "
+"%s."
+msgstr ""
+
+#: src/compute.c:143 src/compute.c:189 src/compute.c:295 src/compute.c:332
+#, c-format
+msgid ""
+"When executing COMPUTE: %g is not a valid value as an index into vector %s."
+msgstr ""
+
+#: src/compute.c:422
+#, c-format
+msgid "There is no vector named %s."
+msgstr ""
+
+#: src/compute.c:471
+msgid "Extra characters after expression."
+msgstr ""
+
+#: src/flip.c:160
+#, c-format
+msgid "Could not create acceptable variant for variable %s."
+msgstr ""
+
+#: src/flip.c:176
+msgid "Cannot create more than 99999 variable names."
+msgstr ""
+
+#: src/flip.c:290
+#, c-format
+msgid "Error reading FLIP source file: %s."
+msgstr ""
+
+#: src/flip.c:366
+msgid "Could not create temporary file for FLIP."
+msgstr ""
+
+#: src/flip.c:376 src/flip.c:395
+#, c-format
+msgid "Error writing FLIP file: %s."
+msgstr ""
+
+#: src/flip.c:431
+msgid "Error creating FLIP source file."
+msgstr ""
+
+#: src/flip.c:434
+#, c-format
+msgid "Error rewinding FLIP file: %s."
+msgstr ""
+
+#: src/flip.c:443
+#, c-format
+msgid "Error reading FLIP file: %s."
+msgstr ""
+
+#: src/flip.c:455
+#, c-format
+msgid "Error seeking FLIP source file: %s."
+msgstr ""
+
+#: src/flip.c:460
+#, c-format
+msgid "Error writing FLIP source file: %s."
+msgstr ""
+
+#: src/flip.c:468
+#, c-format
+msgid "Error rewind FLIP source file: %s."
+msgstr ""
+
+#: src/print.c:209
+msgid "expecting a valid subcommand"
+msgstr ""
+
+#: src/print.c:389 src/print.c:406
+#, c-format
+msgid "%g is not a valid column location."
+msgstr ""
+
+#: src/print.c:400
+#, c-format
+msgid "Column location expected following `%d-'."
+msgstr ""
+
+#: src/print.c:411
+#, c-format
+msgid ""
+"%d-%ld is not a valid column range. The second column must be greater than "
+"or equal to the first."
+msgstr ""
+
+#: src/print.c:517
+#, c-format
+msgid ""
+"%s is not of the same type as %s. To specify variables of different types "
+"in the same variable list, use a FORTRAN-like format specifier."
+msgstr ""
+
+#: src/print.c:547
+msgid ""
+"The ending column for a field must not be less than the starting column."
+msgstr ""
+
+#: src/print.c:630
+#, c-format
+msgid "%s variables cannot be displayed with format %s."
+msgstr ""
+
+#: src/print.c:717
+#, c-format
+msgid "Display format %s may not be used with a %s variable."
+msgstr ""
+
+#: src/print.c:867
+#, c-format
+msgid "Writing %3d records to file %s."
+msgstr ""
+
+#: src/print.c:868
+#, c-format
+msgid "Writing %3d records to the listing file."
+msgstr ""
+
+#: src/print.c:1082
+msgid "A file name or handle was expected in the OUTFILE subcommand."
+msgstr ""
+
+#: src/print.c:1134
+#, c-format
+msgid ""
+"The expression on PRINT SPACE evaluated to %d. It's not possible to PRINT "
+"SPACE a negative number of lines."
+msgstr ""
+
+#: src/recode.c:290
+#, c-format
+msgid ""
+"%d variable(s) cannot be recoded into %d variable(s). Specify the same "
+"number of variables as input and output variables."
+msgstr ""
+
+#: src/recode.c:304
+#, c-format
+msgid ""
+"There is no string variable named %s. (All string variables specified on "
+"INTO must already exist. Use the STRING command to create a string "
+"variable.)"
+msgstr ""
+
+#: src/recode.c:313
+#, c-format
+msgid ""
+"Type mismatch between input and output variables. Output variable %s is not "
+"a string variable, but all the input variables are string variables."
+msgstr ""
+
+#: src/recode.c:332
+#, c-format
+msgid "Type mismatch after INTO: %s is not a numeric variable."
+msgstr ""
+
+#: src/recode.c:362
+msgid ""
+"INTO must be used when the input values are numeric and output values are "
+"string."
+msgstr ""
+
+#: src/recode.c:370
+msgid ""
+"INTO must be used when the input values are string and output values are "
+"numeric."
+msgstr ""
+
+#: src/recode.c:507
+msgid ""
+"Inconsistent output types. The output values must be all numeric or all "
+"string."
+msgstr ""
+
+#: src/recode.c:558
+msgid "following LO THRU"
+msgstr ""
+
+#: src/recode.c:574 src/recode.c:603
+msgid "in source value"
+msgstr ""
+
+#: src/recode.c:616
+msgid ""
+"Keyword CONVERT may only be used with string input values and numeric output "
+"values."
+msgstr ""
+
+#: src/recode.c:872
+msgid "!!END!!"
+msgstr ""
+
+#: src/recode.c:893 src/recode.c:909
+msgid "!!ERROR!!"
+msgstr ""
+
+#: src/sel-if.c:102
+msgid "The filter variable must be numeric."
+msgstr ""
+
+#: src/sel-if.c:108
+msgid "The filter variable may not be scratch."
+msgstr ""
+
+#: src/sel-if.c:142
+msgid "Only last instance of this command is in effect."
+msgstr ""
+
+#: src/sort.c:131
+msgid "`A' or `D' expected inside parentheses."
+msgstr ""
+
+#: src/sort.c:137
+msgid "`)' expected."
+msgstr ""
+
+#: src/sort.c:462
+#, c-format
+msgid "%s: Cannot create temporary directory: %s."
+msgstr ""
+
+#: src/sort.c:486
+#, c-format
+msgid "%s: Error removing directory for temporary files: %s."
+msgstr ""
+
+#: src/sort.c:530
+#, c-format
+msgid ""
+"Out of memory. Could not allocate room for minimum of %d cases of %d bytes "
+"each. (PSPP workspace is currently restricted to a maximum of %d KB.)"
+msgstr ""
+
+#: src/sort.c:542
+#, c-format
+msgid "allocated %d cases == %d bytes\n"
+msgstr ""
+
+#: src/sort.c:580
+#, c-format
+msgid "%s: Error writing temporary file: %s."
+msgstr ""
+
+#: src/sort.c:592
+#, c-format
+msgid "SORT: Closing handle %d."
+msgstr ""
+
+#: src/sort.c:598 src/sort.c:822
+#, c-format
+msgid "%s: Error closing temporary file: %s."
+msgstr ""
+
+#: src/sort.c:620 src/sort.c:636
+#, c-format
+msgid "SORT: %s: Opening for writing as run %d."
+msgstr ""
+
+#: src/sort.c:642
+#, c-format
+msgid "%s: Error opening temporary file for reading: %s."
+msgstr ""
+
+#: src/sort.c:668 src/sort.c:684
+#, c-format
+msgid "%s: Error creating temporary file: %s."
+msgstr ""
+
+#: src/sort.c:826 src/sort.c:987 src/sort.c:1037 src/sort.c:1207
+#: src/sort.c:1214
+#, c-format
+msgid "%s: Error removing temporary file: %s."
+msgstr ""
+
+#. Find the shortest runs; put them in runs[] in reverse order
+#. of length, to force dummy runs of length 0 to the end of the
+#. list.
+#: src/sort.c:969
+msgid "merging runs"
+msgstr ""
+
+#: src/sort.c:977
+#, c-format
+msgid " into run %d(%d)\n"
+msgstr ""
+
+#: src/sort.c:996
+msgid "Out of memory expanding Huffman priority queue."
+msgstr ""
+
+#: src/sort.c:1048
+#, c-format
+msgid "%s: Error creating temporary file for merge: %s."
+msgstr ""
+
+#: src/sort.c:1076 src/sort.c:1134
+#, c-format
+msgid "%s: Error reading temporary file in merge: %s."
+msgstr ""
+
+#: src/sort.c:1079 src/sort.c:1138
+#, c-format
+msgid "%s: Unexpected end of temporary file in merge."
+msgstr ""
+
+#: src/sort.c:1104
+#, c-format
+msgid "%s: Error writing temporary file in merge: %s."
+msgstr ""
+
+#: src/sort.c:1154 src/sort.c:1187
+#, c-format
+msgid "%s: Error closing temporary file in merge: %s."
+msgstr ""
+
+#: src/sort.c:1159
+#, c-format
+msgid "%s: Error removing temporary file in merge: %s."
+msgstr ""
+
+#: src/sort.c:1258
+#, c-format
+msgid "%s: Cannot open sort result file: %s."
+msgstr ""
+
+#: src/sort.c:1269
+#, c-format
+msgid "%s: Error reading sort result file: %s."
+msgstr ""
+
+#: src/sort.c:1272
+#, c-format
+msgid "%s: Unexpected end of sort result file: %s."
+msgstr ""
+
+#: src/sort.c:1283
+#, c-format
+msgid "%s: Error closing sort result file: %s."
+msgstr ""
+
+#: src/sort.c:1287
+#, c-format
+msgid "%s: Error removing sort result file: %s."
+msgstr ""
+
+#: src/include.c:51
+msgid "Unrecognized filename format."
+msgstr ""
+
+#: src/loop.c:203
+msgid "The index variable may not be a string variable."
+msgstr ""
+
+#: src/loop.c:323
+msgid "There is no LOOP command that corresponds to this END LOOP."
+msgstr ""
+
+#: src/loop.c:524
+msgid ""
+"This command may only appear enclosed in a LOOP/END LOOP control structure."
+msgstr ""
+
+#: src/loop.c:530
+msgid "BREAK not enclosed in DO IF structure."
+msgstr ""
+
+#: src/loop.c:607
+#, c-format
+msgid "%s without %s."
+msgstr ""
+
+#: src/repeat.c:160
+#, c-format
+msgid "Identifier %s is given twice."
+msgstr ""
+
+#: src/repeat.c:203
+#, c-format
+msgid ""
+"There must be the same number of substitutions for each dummy variable "
+"specified. Since there were %d substitutions for %s, there must be %d for "
+"%s as well, but %d were specified."
+msgstr ""
+
+#: src/repeat.c:312
+msgid "No commands in scope."
+msgstr ""
+
+#: src/mis-val.c:332 src/repeat.c:485
+msgid "String expected."
+msgstr ""
+
+#: src/repeat.c:512
+msgid "No matching DO REPEAT."
+msgstr ""
+
+#: src/mis-val.c:83
+msgid "`)' expected after value specification."
+msgstr ""
+
+#: src/mis-val.c:117
+#, c-format
+msgid "`(' expected after variable name%s."
+msgstr ""
+
+#: src/mis-val.c:129
+msgid "Long string value specified."
+msgstr ""
+
+#: src/mis-val.c:134
+msgid "Short strings must be of equal width."
+msgstr ""
+
+#: src/mis-val.c:191
+#, c-format
+msgid "Range %g THRU %g is not valid because %g is greater than %g."
+msgstr ""
+
+#: src/mis-val.c:222
+msgid "Number or range expected."
+msgstr ""
+
+#: src/mis-val.c:255
+msgid "At most one range can exist in the missing values for any one variable."
+msgstr ""
+
+#: src/mis-val.c:261
+msgid "At most one individual value can be missing along with one range."
+msgstr ""
+
+#: src/mis-val.c:323
+msgid "String is not of proper length."
+msgstr ""
+
+#: src/mis-val.c:372
+msgid "Missing value:"
+msgstr ""
+
+#: src/mis-val.c:377
+msgid "(long string variable)"
+msgstr ""
+
+#: src/mis-val.c:382
+msgid "(no missing values)\n"
+msgstr ""
+
+#: src/mis-val.c:405
+#, c-format
+msgid "(!!!INTERNAL ERROR--%d!!!)\n"
+msgstr ""
+
+#: src/modify-vars.c:109
+msgid "REORDER subcommand may be given at most once."
+msgstr ""
+
+#: src/modify-vars.c:131
+msgid "Cannot specify ALL after specifying a set of variables."
+msgstr ""
+
+#: src/modify-vars.c:141
+msgid "`(' expected on REORDER subcommand."
+msgstr ""
+
+#: src/modify-vars.c:153
+msgid "`)' expected following variable names on REORDER subcommand."
+msgstr ""
+
+#: src/modify-vars.c:185
+msgid "RENAME subcommand may be given at most once."
+msgstr ""
+
+#: src/modify-vars.c:198
+msgid "`(' expected on RENAME subcommand."
+msgstr ""
+
+#: src/modify-vars.c:206
+msgid ""
+"`=' expected between lists of new and old variable names on RENAME "
+"subcommand."
+msgstr ""
+
+#: src/modify-vars.c:216 src/rename-vars.c:74
+#, c-format
+msgid ""
+"Differing number of variables in old name list (%d) and in new name list "
+"(%d)."
+msgstr ""
+
+#: src/modify-vars.c:227
+msgid "`)' expected after variable lists on RENAME subcommand."
+msgstr ""
+
+#: src/modify-vars.c:243
+msgid ""
+"KEEP subcommand may be given at most once. It may notbe given in "
+"conjunction with the DROP subcommand."
+msgstr ""
+
+#: src/modify-vars.c:281
+msgid ""
+"DROP subcommand may be given at most once. It may notbe given in "
+"conjunction with the KEEP subcommand."
+msgstr ""
+
+#: src/modify-vars.c:307
+#, c-format
+msgid "Unrecognized subcommand name `%s'."
+msgstr ""
+
+#: src/modify-vars.c:309
+msgid "Subcommand name expected."
+msgstr ""
+
+#: src/modify-vars.c:317
+msgid "`/' or `.' expected."
+msgstr ""
+
+#: src/modify-vars.c:471 src/rename-vars.c:124
+#, c-format
+msgid "Duplicate variable name `%s' after renaming."
+msgstr ""
+
+#: src/numeric.c:61
+#, c-format
+msgid "Format type %s may not be used with a numeric variable."
+msgstr ""
+
+#: src/numeric.c:81 src/numeric.c:164 src/vector.c:167
+#, c-format
+msgid "There is already a variable named %s."
+msgstr ""
+
+#: src/numeric.c:135
+#, c-format
+msgid "Format type %s may not be used with a string variable."
+msgstr ""
+
+#: src/rename-vars.c:59
+msgid "`(' expected."
+msgstr ""
+
+#: src/rename-vars.c:67
+msgid "`=' expected between lists of new and old variable names."
+msgstr ""
+
+#: src/rename-vars.c:85
+msgid "`)' expected after variable names."
+msgstr ""
+
+#: src/sample.c:72
+msgid "The sampling factor must be between 0 and 1 exclusive."
+msgstr ""
+
+#: src/sample.c:92
+#, c-format
+msgid "Cannot sample %d observations from a population of %d."
+msgstr ""
+
+#: src/set.q:216
+msgid "BLOCK is obsolete."
+msgstr ""
+
+#: src/set.q:219
+msgid "BOXSTRING is obsolete."
+msgstr ""
+
+#: src/set.q:223
+msgid "Active file compression is not yet implemented (and probably won't be)."
+msgstr ""
+
+#: src/set.q:232
+msgid "CPI must be greater than 0."
+msgstr ""
+
+#: src/set.q:237
+msgid "HISTOGRAM is obsolete."
+msgstr ""
+
+#: src/set.q:241
+msgid "LPI must be greater than 0."
+msgstr ""
+
+#: src/set.q:248
+msgid ""
+"CASE is not implemented and probably won't be. If you care, complain about "
+"it."
+msgstr ""
+
+#: src/set.q:278
+#, c-format
+msgid "Value for MITERATE (%ld) must be greater than 0."
+msgstr ""
+
+#: src/set.q:286
+#, c-format
+msgid "Value for MNEST (%ld) must be greater than 0."
+msgstr ""
+
+#: src/set.q:294
+msgid "MXERRS must be at least 1."
+msgstr ""
+
+#: src/set.q:301
+msgid "MXLOOPS must be at least 1."
+msgstr ""
+
+#: src/set.q:306
+msgid "MXMEMORY is obsolete."
+msgstr ""
+
+#: src/set.q:312
+msgid "SCRIPTTAB is obsolete."
+msgstr ""
+
+#: src/set.q:314
+msgid "TBFONTS not implemented."
+msgstr ""
+
+#: src/set.q:316
+msgid "TB1 not implemented."
+msgstr ""
+
+#: src/set.q:320
+msgid "WORKSPACE is obsolete."
+msgstr ""
+
+#: src/set.q:327
+msgid "AUTOMENU is obsolete."
+msgstr ""
+
+#: src/set.q:329
+msgid "BEEP is obsolete."
+msgstr ""
+
+#: src/set.q:348
+msgid "EJECT is obsolete."
+msgstr ""
+
+#: src/set.q:352
+msgid "HELPWINDOWS is obsolete."
+msgstr ""
+
+#: src/set.q:356
+msgid "MENUS is obsolete."
+msgstr ""
+
+#: src/set.q:370
+msgid "PTRANSLATE is obsolete."
+msgstr ""
+
+#: src/set.q:376
+msgid "XSORT is obsolete."
+msgstr ""
+
+#: src/set.q:390
+#, c-format
+msgid ""
+"CC%c: Length of custom currency string `%s' (%d) exceeds maximum length of "
+"16."
+msgstr ""
+
+#: src/set.q:412
+#, c-format
+msgid ""
+"CC%c: Custom currency string `%s' does not contain exactly three periods or "
+"commas (not both)."
+msgstr ""
+
+#: src/set.q:555
+msgid "LENGTH must be at least 1."
+msgstr ""
+
+#: src/set.q:592
+msgid "Missing identifier in RESULTS subcommand."
+msgstr ""
+
+#: src/set.q:603
+msgid "Unrecognized identifier in RESULTS subcommand."
+msgstr ""
+
+#: src/set.q:639
+msgid "WIDTH must be at least 1."
+msgstr ""
+
+#: src/set.q:662
+#, c-format
+msgid ""
+"FORMAT requires numeric output format as an argument. Specified format %s "
+"is of type string."
+msgstr ""
+
+#: src/set.q:706
+msgid "Text color must be in range 0-15."
+msgstr ""
+
+#: src/set.q:719
+msgid "Background color must be in range 0-7."
+msgstr ""
+
+#: src/set.q:730
+msgid "Border color must be in range 0-7."
+msgstr ""
+
+#: src/set.q:774
+msgid "RCOLOR is obsolete."
+msgstr ""
+
+#: src/set.q:786
+msgid "Lower window color must be between 0 and 6."
+msgstr ""
+
+#: src/set.q:800
+msgid "Upper window color must be between 0 and 6."
+msgstr ""
+
+#: src/set.q:812
+msgid "Frame color must be between 0 and 6."
+msgstr ""
+
+#: src/set.q:845
+msgid "VIEWLENGTH not implemented."
+msgstr ""
+
+#: src/set.q:855
+msgid "WORKDEV is obsolete."
+msgstr ""
+
+#: src/set.q:864
+msgid "Drive letter expected in WORKDEV subcommand."
+msgstr ""
+
+#: src/temporary.c:65
+msgid "This command is not valid inside DO IF or LOOP."
+msgstr ""
+
+#: src/temporary.c:72
+msgid ""
+"This command may only appear once between procedures and procedure-like "
+"commands."
+msgstr ""
+
+#: src/title.c:57
+#, c-format
+msgid "%s before: %s\n"
+msgstr ""
+
+#: src/title.c:57
+msgid "<none>"
+msgstr ""
+
+#: src/title.c:69
+#, c-format
+msgid "%s: `.' expected after string."
+msgstr ""
+
+#: src/title.c:84
+#, c-format
+msgid "%s after: %s\n"
+msgstr ""
+
+#: src/title.c:134
+#, c-format
+msgid "Document entered %s %02d:%02d:%02d by %s (%s):"
+msgstr ""
+
+#: src/val-labs.c:139
+#, c-format
+msgid ""
+"It is not possible to assign value labels to long string variables such as "
+"%s."
+msgstr ""
+
+#: src/val-labs.c:186
+msgid "String expected for value."
+msgstr ""
+
+#: src/val-labs.c:195
+msgid "Number expected for value."
+msgstr ""
+
+#: src/val-labs.c:199
+#, c-format
+msgid "Value label `%g' is not integer."
+msgstr ""
+
+#: src/val-labs.c:209
+msgid "Truncating value label to 60 characters."
+msgstr ""
+
+#: src/val-labs.c:242
+msgid "Value labels:"
+msgstr ""
+
+#: src/val-labs.c:259
+msgid " (no value labels)\n"
+msgstr ""
+
+#: src/var-labs.c:55
+msgid "String expected for variable label."
+msgstr ""
+
+#: src/var-labs.c:61
+msgid "Truncating variable label to 120 characters."
+msgstr ""
+
+#: src/var-labs.c:89
+msgid "Variable labels:\n"
+msgstr ""
+
+#: src/var-labs.c:96
+msgid "(no variable label)"
+msgstr ""
+
+#: src/vector.c:80
+#, c-format
+msgid "Vector name %s is given twice."
+msgstr ""
+
+#: src/vector.c:86
+#, c-format
+msgid "There is already a vector with name %s."
+msgstr ""
+
+#. There's more than one vector name.
+#: src/vector.c:105
+msgid ""
+"A slash must be used to separate each vector specification when using the "
+"long form. Commands such as VECTOR A,B=Q1 TO Q20 are not supported."
+msgstr ""
+
+#: src/vector.c:139
+msgid "Vectors must have at least one element."
+msgstr ""
+
+#: src/vector.c:153
+#, c-format
+msgid "%s%d is too long for a variable name."
+msgstr ""
+
+#: src/vector.c:195
+msgid ""
+"The syntax for this command does not match the expected syntax for either "
+"the long form or the short form of VECTOR."
+msgstr ""
+
+#: src/weight.c:61
+msgid "The weighting variable must be numeric."
+msgstr ""
+
+#: src/weight.c:66
+msgid "The weighting variable may not be scratch."
+msgstr ""
+
+#: src/weight.c:106
+msgid "bad weighting variable, canceling\n"
+msgstr ""
--- /dev/null
+/* Let's tell EMACS what language this is: -*- C -*- */
+
+/* Used by separable libraries to enable PSPP-specific features. */
+#define PSPP 1
+
+/*
+ *
+ * Debugging
+ *
+ */
+
+/* Define to get lots of info printed by procedures. */
+/*#define DEBUGGING 1*/
+
+#if DEBUGGING
+#define GLOBAL_DEBUGGING 1
+#endif
+
+/* Define these if DEBUGGING is off and you want to make certain
+ additional optimizations. */
+#if !DEBUGGING
+/* #define PRODUCTION 1 */ /* disable extra function calls */
+/* #define NDEBUG 1 */ /* disable assert() sanity checks */
+#endif
+\f
+/* Compilers. */
+
+/* Fix Windows lossage. */
+#ifdef __WIN32__
+#undef __WIN32__
+#define __WIN32__ 1
+#undef __MSDOS__
+#define __MSDOS__ 1
+#endif
+
+/* Fix DJGPP lossage. */
+#if __DJGPP__
+#undef unix
+#undef __unix__
+#endif
+
+/* Fix Cygnus Windows lossage. */
+#if defined (__CYGWIN32__)
+#define unix 1
+#endif
+
+/* Ensure that unix and __unix__ are equivalent. */
+#if defined (unix) || defined (__unix__) || defined (__unix)
+#undef unix
+#define unix 1
+
+#undef __unix__
+#define __unix__ 1
+
+#undef __unix
+#define __unix 1
+#endif
+
+/* Make sure to use the proper keywords. */
+#if __GNUC__ > 1 && !defined (inline)
+#define inline __inline__
+#endif
+
+/* GNU C allows the programmer to declare that certain functions take
+ printf-like arguments, never return, etc. Conditionalize these
+ declarations on whether gcc is in use. */
+#if __GNUC__ > 1
+#define __attribute__(X) __attribute__ (X)
+#else
+#define __attribute__(X)
+#endif
+
+/* GNU C allows unused variables and parameters to be declared as
+ such. */
+#if __GNUC__ >= 2
+#define unused __attribute__ ((__unused__))
+#else
+#define unused
+#endif
+\f
+/* CPUs. */
+
+/* Check that the floating-point representation is one that we
+ understand. */
+#if FPREP==FPREP_IEEE754
+
+#if SIZEOF_DOUBLE == 8
+#define second_lowest_flt64 second_lowest_value
+#else
+#error Must define second_lowest_flt64 for your architecture.
+#endif
+
+/* This trick borrowed from gcc-lib/.../include/float.h. */
+#if __GNUC__ && (ENDIAN==BIG || ENDIAN==LITTLE)
+#ifndef __DBL_UNION__
+#define __DBL_UNION__
+union blp_convert_double {
+ unsigned char convert_double_i[8];
+ double convert_double_d;
+};
+#endif /* !defined __DBL_UNION__ */
+#if ENDIAN==LITTLE
+#define SECOND_LOWEST_VALUE \
+ (__extension__ ((union blp_convert_double) \
+ {{0xfe,0xff,0xff,0xff, 0xff,0xff,0xef,0xff}}) \
+ .convert_double_d)
+#elif ENDIAN==BIG
+#define SECOND_LOWEST_VALUE \
+ (__extension__ ((union blp_convert_double) \
+ {{0xff,0xef,0xff,0xff, 0xff,0xff,0xff,0xfe}}) \
+ .convert_double_d)
+#endif /* endianness */
+#endif /* __GNUC__ and known endianness */
+
+#else /* FPREP != FPREP_IEEE754 */
+#error Floating point representation must be known at compile time.
+#endif /* fprep */
+
+/* Figure out which integer type on this system is a signed 32-bit
+ integer. */
+#if SIZEOF_SHORT==4
+ #define int32 short
+#elif SIZEOF_INT==4
+ #define int32 int
+#elif SIZEOF_LONG==4
+ #define int32 long
+#else
+ #error Which one of your basic types is 32-bit signed integer?
+#endif
+
+#if SIZEOF_FLOAT==8
+ #define flt64 float
+ #define FLT64_MAX FLT_MAX
+#elif SIZEOF_DOUBLE==8
+ #define flt64 double
+ #define FLT64_MAX DBL_MAX
+#elif SIZEOF_LONG_DOUBLE==8
+ #define flt64 long double
+ #define FLT64_MAX LDBL_MAX
+#else
+ #error Which one of your basic types is 64-bit floating point?
+ #define flt64 double
+ #define FLT64_MAX DBL_MAX
+#endif
+\f
+/* Environments. */
+
+/* Internationalization. */
+#include <libintl.h>
+
+#if !ENABLE_NLS
+/* If we don't do this then gettext() still monkeys with the string,
+ which causes gcc not to do its checking on printf() format
+ types. */
+#undef gettext
+#define gettext(STRING) \
+ STRING
+#endif
+
+#define _(STRING) \
+ gettext(STRING)
+
+#define N_(STRING) \
+ STRING
+
+/* Even C emulation of alloca counts as an alloca implementation. */
+#if C_ALLOCA
+#define HAVE_ALLOCA 1
+#endif
+
+/* Define PAGED_STACK if alloca() is supported and the stack can
+ expand arbitrarily. (Under some broken OSes like DOS and
+ Windows the stack is small and fixed in size.) This will prevent
+ big alloca() requests (like 1MB). */
+#if HAVE_ALLOCA && unix
+#define PAGED_STACK 1
+#endif
+
+/* Saves on #if's. */
+#if HAVE_ALLOCA && !__CHECKER__
+#define local_alloc(X) \
+ alloca(X)
+
+#define local_free(P) \
+ do \
+ { \
+ } \
+ while (0)
+#elif !__CHECKER__
+#define local_alloc(X) \
+ xmalloc (X)
+
+#define local_free(P) \
+ free (P)
+#else /* __CHECKER__ */
+/* Why define these this way? Because if you do it this way then if
+ you try to free a block returned by local_alloc() with the free()
+ function, you get an error message. */
+#define local_alloc(X) \
+ ((void *) (((char *) (xmalloc (X+16))) + 16))
+
+#define local_free(P) \
+ free (((char *) P) - 16)
+#endif /* __CHECKER__ */
+\f
+/* Filesystems. */
+
+/* Directory separator character for this OS, if applicable. */
+#if !__MSDOS__
+#define DIR_SEPARATOR '/'
+#elif
+#define DIR_SEPARATOR '\\'
+#endif
+
+/* Path delimiter character. */
+#if !__MSDOS__
+#define PATH_DELIMITER ':'
+#else
+#define PATH_DELIMITER ';'
+#endif
+
+/* MSDOS mkdir() takes only one argument. */
+#if __MSDOS__ && !__DJGPP__
+#define mkdir(path, mode) \
+ mkdir (path)
+#endif
+\f
+/* Options. */
+
+/* Approximate amount of memory, in bytes, to allocate before paging
+ to disk. */
+#define MAX_WORKSPACE (4*1024*1024) /* 4 MBytes */
+
+/* (libhistory) The location for the history file that records
+ commands entered interactively. Tilde expansion is performed. */
+#define HISTORY_FILE "~/.pspp_history"
+
+/* (libhistory) Maximum number of commands to record in history
+ file. */
+#define MAX_HISTORY 500
+\f
+/* Output drivers. */
+
+/* Define to exclude the HTML output driver. */
+/* #define NO_HTML 1 */
+
+/* Define to exclude the PostScript and Encapsulated PostScript
+ driver. */
+/* #define NO_POSTSCRIPT 1 */
+\f
+/* Procedure-specific options. */
+
+/* CROSSTABS: Maximum number of tables to process in one pass. */
+#define MAX_CROSSTAB_TABLES 32
+
+/* FREQUENCIES: Define to allow bars greater than 1/2" wide. */
+/* #define ALLOW_HUGE_BARS 1 */
+
+/* FREQUENCIES: Minimum, maximum number of bars in a histogram. The
+ number is based on the number of unique values of the variable,
+ unless overridden. */
+#define MIN_HIST_BARS 3
+#define MAX_HIST_BARS 20
+
+/* FREQUENCIES: Density of polyline used to approximate the normal
+ curve. The value is the number of samples taken per chart. Higher
+ values give smoother curves. */
+#define POLYLINE_DENSITY (MAX_HIST_BARS*4)
--- /dev/null
+#! /bin/sh -e
+
+nls=--disable-nls
+clean=no
+include_deps=yes
+
+while true; do
+ if [ "$1" = "--enable-nls" ]; then
+ nls=
+ elif [ "$1" = "--disable-nls" ]; then
+ nls=--disable-nls
+ elif [ "$1" = "--clean" ]; then
+ clean=yes
+ elif [ "$1" = "--not-clean" ]; then
+ clean=no
+ elif [ "$1" = "--no-include-deps" ]; then
+ include_deps=no
+ elif [ "$1" = "--include-deps" ]; then
+ include_deps=yes
+ elif [ "$1" = "--help" ]; then
+ echo "Usage: $0 [--enable-nls] [--clean] [--include-deps] ..."
+ exit 0
+ else
+ break
+ fi
+
+ shift
+done
+
+# Extract PSPP version number.
+VERSION=`sed -ne 's/^.*\[//;s/].*$//;/^[0-9]*\.[0-9]*\.[0-9]*$/p' < configure.in`
+
+if [ "$clean" = "no" ]; then
+ echo "Generating a Makefile for cleaning..."
+ if [ ! -f Makefile ]; then
+ aclocal
+ autoheader
+ make -f Makefile.am docfiles VERSION=$VERSION
+ automake --foreign
+ autoconf
+ ./configure $nls $*
+ fi
+ echo "Cleaning the distribution..."
+ make -k maintainer-clean || true
+fi
+
+echo "Configuring..."
+aclocal
+autoheader
+make -f Makefile.am docfiles VERSION=$VERSION
+automake
+autoconf
+./configure $nls $*
+make mostlyclean || true # This causes dependencies to be generated
+
+if [ "$include_deps" = "yes" ]; then
+ echo "Configuring with included dependencies..."
+ automake --include-deps
+ autoconf
+ ./configure $nls $*
+fi
--- /dev/null
+Sun Jan 2 21:40:13 2000 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Reorganized. Put locale dir in version.c instead
+ of passing it to each compile command. Only put local gmp libs in
+ LD_ADD if not installed on system. Remove `boast' target.
+
+ * All source files: struct and union typedefs eliminated.
+ `sizeof type' replaced by `sizeof object' where practical. Moved
+ `unused' qualifiers from start to end of declarations for gcc
+ 2.7.2 compatibility. Change `while (1)' to `for (;;)'. Made
+ assertions on pointers strictly compliant. Removed _ prefixes on
+ some function parameter names.
+
+ * alloc.c: New source file, containing these external linkage
+ functions removed from common.c: xmalloc, xcalloc, xrealloc,
+ xstrdup.
+
+ * arena.c: Removed.
+
+ * arena.h: Removed.
+
+ * ascii.c: Migrated from arenas to pools.
+ (struct ascii_driver_ext) ops[], box[], fonts[] changed from
+ c_string to len_string. All references changed.
+ (ascii_option) Signature changed to comply to new output.c
+ interface.
+ (count_fancy_chars) Removed.
+ (delineate) Removed support for rich text.
+ (ascii_text_metrics) Ditto.
+ (text_draw) Ditto.
+ (output_shorts) Change `box', `off', `on' from c_string to
+ len_string. Change `remaining' from int to size_t.
+ (ascii_close_page) Make page numbering less haphazard.
+
+ * autorecode.c: Migrate from arenas to pools.
+
+ * avl.c: Migrate from arenas to pools. Synch from libavl 1.4.0.
+
+ * bitvector.h: New file containing these macros from misc.h:
+ SET_BIT, CLEAR_BIT, SET_BIT_TO, TEST_BIT, BIT_INDEX.
+
+ * command.c: (struct command) cmd1, cmd2, cmd3 members changed to
+ word[3]. ncmd removed.
+ (var empty_string) Removed.
+ (var cmd_table) Declaration updated.
+ (var cmdtab) Removed.
+ (cmp_command) Removed.
+ (split_words) Rewritten to use strtok_r().
+ (init_cmd_parser) Renamed cmd_init(). Rewritten.
+ (find_command) Removed.
+ (FILE_TYPE_okay) Rewritten.
+ (cmd_parse) Rewritten. Semantics of the return value of command
+ handlers has changed: they must now return one of the new CMD_*
+ enumerals, rather than a magic value. This meant that all
+ commands had to be modified, and they were.
+ (figure_out_command) New function.
+
+ * command.def: Add CORRELATIONS, PEARSON CORRELATIONS. Add
+ #defines for INIT, INPU, etc.
+
+ * command.h: New CMD_* enum series.
+ (cur_proc) Make const char *, not char *.
+ (cmd_init) Prototype.
+ (cmd_parse) Ditto.
+
+ * common.c: Removed.
+
+ * common.h: Removed.
+
+ * correlations.q: New file.
+
+ * crosstabs.q: Migrate from arenas to pools. Migrate to new-style
+ q2c.
+ (custom_tables) Renamed crs_custom_tables().
+ (custom_variables) Renamed crs_custom_variables().
+ (calc_integer) Add in some `const' qualifiers.
+ (table_value_missing) Change from a_string to len_string.
+ (float_M_suffix) Change from a_string to len_string.
+
+ * data-in.c: Rewritten. All references to
+ parse_string_as_format() changed to data_in().
+
+ * data-in.h: New file.
+
+ * data-list.c: Change DLS_* from #define's to enums. Move from
+ rpd_msg() to tmsg().
+ (RPD_ERR) New #define.
+ (do_reading) Change dfm_push_cust() to dfm_push(), pop_cust() to
+ dfm_pop().
+ (read_from_data_list_fixed) Change from old
+ parse_string_as_format() to new data_in().
+ (read_from_data_list_free) Ditto.
+ (read_from_data_list_list) Ditto.
+ (cmd_repeating_data) Modify approach to checking for end of
+ command.
+ (rpd_msg) Removed.
+ (rpd_parse_record) Change from old parse_string_as_format() to new
+ data_in(). Change from old convert_format_to_string() to new
+ data_out().
+ (read_one_set_of_repetitions) Change dfm_push_cust() to
+ dfm_push(), pop_cust() to dfm_pop().
+
+ * data-out.c: Rewritten. All references to
+ convert_format_to_string() changed to data_out().
+
+ * descript.q: Migrate to new q2c.
+ (cmd_descriptives) Removed.
+ (internal_cmd_descriptives) Renamed cmd_descriptives ().
+ (custom_variables) Renamed dsc_custom_variables().
+
+ * dfm.c: (struct dfm_fhuser_ext) `ln' removed. All references
+ removed.
+ (open_file_r) Initialize h->where.line_number. Migrate to new
+ struct string.
+ (open_file_w) Initialize h->where.line_number.
+ (read_record) Change from ext->ln to h->where.line_number.
+ Migrate to struct string.
+ (dfm_put_record) Rephrased.
+ (dfm_push_cust) Renamed dfm_push(), rewritten.
+ (dfm_pop) New function.
+
+ * error.c: All references updated.
+ (glob var error_count) Renamed err_err_count.
+ (glob var warning_count) Renamed err_warning_count.
+ (glob var error_already_flagged) Renamed err_already_flagged.
+ (glob var verbosity) Renamed err_verbosity.
+ (glob var cust_fn) Removed.
+ (glob var cust_ln) Removed.
+ (static var file_loc) New.
+ (static var nfile_loc) New.
+ (static var mfile_loc) New.
+ (tmsg) New function.
+ (push_cust) Removed.
+ (pop_cust) Removed.
+ (msg) Rewritten.
+ (static var terminating) Removed.
+ (failure) Renamed err_failure().
+ (hcf) Renamed err_hcf().
+ (err_push_file_locator) New function.
+ (err_pop_file_locator) New function.
+ (err_location) New function.
+ (check_error_count) Renamed err_check_count().
+ (vmsg) Renamed err_vmsg(). Interface changed.
+ (verbose_msg) Removed.
+ (err_cond_fail) New function.
+ (error_break) Renamed err_break().
+
+ * error.h: All references updated.
+ (enum MSG_CLASS_COUNT) Renamed ERR_CLASS_COUNT.
+ (enum ERR_CLASS_MASK, ERR_VERBOSITY_SHIFT, ERR_VERBOSITY_MASK)
+ New.
+ (struct file_locator) New.
+ (struct error) New.
+ (macro verbose_msg) Removed.
+ (macro cond_fail) Removed.
+
+ * expr-opt.c: (evaluate_tree) sizeof(char) == 1.
+
+ * expr-prs.c: Reorganized. All references updated.
+ (exprtypename) Renamed expr_type_name().
+ (typename) Renamed type_name().
+ (free_expression) Renamed expr_free().
+ (parse_expression) Renamed expr_parse(). Uses new type_check()
+ function.
+ (init_functab) Renamed init_func_tab().
+ (type_check) New function.
+ (parse_or) Rewritten to use new allocate_nonterminal() and
+ append_nonterminal_arg() functions.
+ (parse_and) Ditto.
+ (parse_not) Ditto.
+ (parse_rel) Ditto. Also simplified logic.
+ (parse_add) Ditto.
+ (parse_mul) Ditto.
+ (parse_neg) Ditto.
+ (parse_exp) Ditto.
+ (SYSMIS_func) Ditto.
+ (VALUE_func) Rephrased.
+ (CONCAT_func) Fix memory leak by replacing free by free_node on
+ lossage.
+ (generic_str_func) Ditto.
+ (parse_function) Ditto. Also rephrasings. Uses bsearch() to find
+ function.
+ (allocate_nonterminal) New function.
+ (append_nonterminal_arg) New function.
+ (static func_tab[]) Now at file level.
+ (cmp_func) Moved.
+ (init_func_tab) Moved. Now just uses qsort() to sort func_tab[].
+
+ * expr.h: (enum series OP_*) Moved to exprP.h.
+ (OP_* defines) Ditto.
+ (struct op_desc) Ditto.
+ (global ops[]) Ditto.
+ (struct num_con_node) Ditto.
+ (struct str_con_node) Ditto.
+ (struct var_node) Ditto.
+ (struct lag_node) Ditto.
+ (struct casenum_node) Ditto.
+ (struct nonterm_node) Ditto.
+ (union any_node) Members renamed.
+ (struct sys_node) Removed.
+ (struct val_node) Removed.
+ (operator typedef) Removed.
+ (typedef exprtype) Removed.
+ (enum series EX_*) Moved to exprP.h.
+ (struct expression) Ditto. Also renamed a lot of the members.
+ (PXP_* defines) Changed to enums.
+ (free_node prototype) Moved to exprP.h.
+
+ * file-handle.h: (struct file_handle) New member `where'.
+
+ * file-handle.q: Migrated to new q2c format.
+ (prepend_current_directory) Removed (dead code).
+ (cmd_file_handle) Incorporated all of internal_cmd_file_handle().
+ (fh_get_handle_by_filename) Removed dead code.
+ Set new `where' member.
+
+ * file-type.c: (file_type_source_read) References to
+ parse_string_as_format() changed to data_in().
+ dfm_push_cust()/pop_cust() changed to dfm_push()/dfm_pop().
+
+ * filename.c: All references updated.
+ (init_filename) Renamed fn_init().
+ (expand_line) Removed.
+ (macro EXPAND_LINE) Removed.
+ (interp_vars) Renamed fn_interp_vars(). Now uses st_*() instead
+ of custom functions.
+ (gnu_getcwd) Renamed fn_get_cwd(), rewritten.
+ (tilde_expand) Renamed fn_tilde_expand(), uses ds_*().
+ (normalize_filename) Renamed fn_normalize().
+ (search_path) Renamed fn_search_path(), rewritten.
+ (prepend_dir) Renamed fn_prepend_dir().
+ (blp_getenv) Renamed fn_getenv().
+ (blp_dirname) Renamed fn_dirname().
+ (fn_basename) New function, not used.
+ (absolute_filename_p) Renamed fn_absolute_p().
+ (is_special_filename) Renamed fn_special_p().
+ (file_exists) Renamed fn_exists_p().
+ (readlink_malloc) Renamed fn_readlink().
+ (getenv_default) Renamed fn_getenv_default().
+ (open_file) Renamed fn_open().
+ (close_file) Renamed fn_close().
+ (open_file_ext) Renamed fn_open_ext().
+ (close_file_ext) Renamed fn_close_ext().
+
+ * font.h: Migrate from arenas to pools.
+
+ * format.c: (parse_format_specifier_name) Deal with ds_* strings.
+
+ * frequencies.g: Migrate from arenas to pools.
+
+ * frequencies.q: Migrate to new q2c version. Migrate from arenas
+ to pools.
+
+ * getline.c: All references updated.
+ (global getl_buf) Changed from char * to struct string.
+ (static getl_include_path) Ditto.
+ (global getl_buf_len) Removed.
+ (global getl_buf_size) Removed.
+ (getl_include_path) Deal with new getl_buf, getl_include_path.
+ (getl_uninitialize) New function.
+ (getl_get_current_directory) Rewritten.
+ (getl_clear_include_path) Rewritten.
+ (getl_add_include_dir) Rewritten.
+ (getl_add_file) Assertion fixed.
+ (getl_add_virtual_file) Change initial value of `remaining_loops'
+ from 2 to 1.
+ (welcome) Rewritten.
+ (handle_line_buffer) Make static. Change logic to make
+ getl_add_virtual_file() change sensible. Use ds_*() strings.
+ (getl_read_line) Use ds_*() strings. Implement SET ECHO.
+ (getl_close_file) Moved.
+ (getl_location) New function.
+
+ * getline.h: All references updated.
+ (macro curln) Removed.
+ (macro curfn) Removed.
+ (macro am_interactive) Renamed getl_am_interactive.
+ (macro am_reading_script) Renamed getl_reading_script.
+
+ * glob.c: (global fmt_parse_ignore_error) Removed.
+ (init_glob) Use locale_dir not LOCALEDIR. Use feholdexcept() on
+ systems that support it (C99). Turn off SET ECHO by default. No
+ necessary julcal initialization anymore.
+
+ * groff-font.c: Migrate from arenas to pools.
+ (groff_read_font) Use err_push_file_locator().
+ (groff_read_DESC) Ditto.
+ (font_msg) Use tmsg().
+
+ * hash.c: (hsh_sort) Fix debug code.
+ [GLOBAL_DEBUGGING] Include stdio.h.
+
+ * hash.h: (macro force_hsh_insert) Rephrase.
+
+ * heap.c: Rewritten.
+
+ * heap.h: Rewritten.
+
+ * html.c: (html_option) Change from outp_value to struct string.
+ (postopen) Change from curfn to getl_location().
+ (escape_string) Remove rich-text code. Signature changed.
+ (output_tab_table) Switch from a_string to struct len_string.
+ Remove rich text support.
+
+ * lexer.c: All references updated. Largely rewritten. Major
+ changes listed below. Removed tagged quote support. Adapted to
+ struct string tokstr.
+ (global tokstr) Changed to struct string.
+ (global tokstr_size) Removed.
+ (global tokstr_len) Removed.
+ (global tokid) New.
+ (global tokint) Removed.
+ (global toklongstr) Removed.
+ (C* defines) Removed.
+ (static tbl[]) Removed.
+ (static id[]) Removed.
+ (static une[]) Removed.
+ (discard_line) Renamed lex_discard_line().
+ (get_entire_line) Renamed lex_entire_line().
+ (get_rest_of_line) Renamed lex_rest_of_line().
+ (get_dotted_rest_of_line) Merged into lex_rest_of_line().
+ (make_hexit) Removed.
+ (syntax_error) Renamed lex_error(). Return value removed.
+ (get_token_representation) Renamed lex_token_representation().
+ (putback) Renamed lex_put_back().
+ (putfwd) Renamed lex_put_forward().
+ (convert_negative_to_dash) Renamed lex_negative_to_dash().
+ (set_prog) Renamed lex_set_prog().
+ (init_lex) Renamed lex_init().
+ (reset_eof) Renamed lex_reset_eof().
+ (lookahead) Renamed lex_look_ahead().
+ (check_id) Rewritten.
+ (yylex) Renamed lex_get(), rewritten.
+ (lex_end_of_command) New function. Many commands were rephrased
+ using this.
+ (lex_integer_p) New function. Replaces compare of tokint against
+ NOT_LONG.
+ (lex_integer) New function. Replaces tokint.
+ (match_tok) Renamed lex_match().
+ (match_id) Renamed lex_match_id().
+ (match_int) Renamed lex_match_int().
+ (force_match_id) Renamed lex_force_match_id(), added return value.
+ (force_match) Renamed lex_force_match(), added return value.
+ (force_string) Renamed lex_force_string(), added return value.
+ (force_int) Renamed lex_force_int(), added return value.
+ (lex_id_match_len) New function.
+ (id_match) Renamed lex_id_match(), rewritten.
+ (get_line) Renamed lex_get_line().
+ (preprocess_line) Renamed lex_preprocess_line().
+ (tokname) Renamed lex_token_name().
+ (bin_value_func) Removed.
+ (oct_value_func) Removed.
+ (hex_value_func) Removed.
+ (unexpected_eof) New function.
+ (convert_numeric_string_to_char_string) New function.
+ (parse_string) Rewritten, signature changed.
+ (add_tokstr_char) Removed.
+ (add_tokstr_unsigned) Removed.
+ (add_tokstr_string) Removed.
+ (parse_tagged_quote) Removed.
+ (skip_comment) Renamed lex_skip_comment().
+
+ * lexer.h: All references updated.
+ (macro is_id1) Renamed CHAR_IS_ID1.
+ (macro is_idn) Renamed CHAR_IS_IDN.
+ (token names ID, NUM, STRING, STOP, ... WITH, EXP) Renamed with
+ prefix T_: T_ID, T_NUM, T_STRING, T_STOP, ... T_WITH, T_EXP.
+ (macro get_token) Removed.
+ (macro id_match) Removed.
+ (macro force_match_id) Removed.
+ (macro force_match) Removed.
+ (macro force_string) Removed.
+ (macro force_int) Removed.
+ (macro force_num) Removed.
+ (macro force_id) Removed.
+
+ * lexerP.h: Removed.
+
+ * list.q: Migrated to new q2c format.
+ (write_line) Deal with struct len_string.
+ (write_varname) Ditto.
+ (write_fallback_headers) Ditto.
+
+ * magic.c: New file, incorporating the following global variables
+ previously in other files: endian, second_lowest_value. And both
+ of those are conditional on #define's.
+
+ * magic.h: New file, incorporating the following global variable
+ declarations: endian, second_lowest_value, and the following macro
+ declarations: NOT_DOUBLE, NOT_LONG, NOT_INT.
+
+ * main.c: Added declarations of pgmname, finished, curdate,
+ start_interactive.
+ (main) Call new parse_script() function.
+ (parse_script) New function.
+ (execute_command) New function.
+ (dump_token) Removed.
+ (handle_error) New function.
+
+ * matrix.c: New file.
+
+ * matrix.h: New file.
+
+ * matrix-data.c: Migrated from arenas to pools.
+ (mget_token) Change from parse_string_as_format() to data_in().
+
+ * means.q: Migrate to new q2c.
+ (custom_tables) Renamed mns_custom_tables().
+ (custom_crossbreak) Renamed mns_custom_crossbreak().
+ (custom_variables) Renamed mns_custom_variables().
+
+ * mis-val.c: (static var width) Changed from `int' to `size_t'.
+ (parse_varnames) Prototype.
+ (parse_numeric) Rephrasings.
+ (parse_alpha) Adapt to new struct string tokstr.
+
+ * misc.c: (intlog10) Rewritten.
+ (spacing) Removed.
+ (ansi_rand) Renamed real_rand(), moved into random.c.
+ (ansi_srand) Renamed real_srand(), moved into random.c.
+ (setup_randomize) Moved to random.c.
+ (rand_uniform) Ditto.
+ (rand_normal) Ditto.
+ (rand_simple) Ditto.
+ (get_config_line) Removed.
+ (reverse) Removed (dead code).
+
+ * misc.h: (macro SET_BIT) Moved to bitvector.h.
+ (macro CLEAR_BIT) Ditto.
+ (macro TEST_BIT) Ditto.
+ (macro SET_BIT_TO) Ditto.
+ (macro BIT_INDEX) Ditto.
+
+ * output.c: (outp_read_devices) Move to err_push_file_locator()
+ from push_cust(). Use struct string.
+ (expand_op_tokstr) Removed.
+ (static var op_tokstr) Changed to struct string.
+ (static var op_tokstr_size) Removed.
+ (tokener) Rephrasings. Use struct string.
+ (parse_options) Use struct string.
+ (destroy_driver) Fix assertion.
+ (outp_get_paper_size) Move to err_push_file_locator().
+ [0] Removed dead code.
+ (outp_string_width) Move to len_string.
+
+ * output.h: Comment fixes.
+ (TAG_* enum series) Removed.
+ (struct outp_value) Removed.
+ (enum OUTP_T_FANCY) Removed.
+ (struct outp_text) `s' changed from a_string to len_string.
+ (struct outp_class) `option' change arg 3 from outp_value to
+ struct string.
+
+ * pfm-read.c: (corrupt_msg) Rewritten.
+
+ * pfm-write.c: (bufwrite) Fix assertion.
+
+ * pool.c: New file, reference version.
+
+ * pool.h: New file, reference version.
+
+ * postscript.c: (ps_font_sizes) Fix assertion.
+ (ps_option) Change arg 3 from outp_value to struct string.
+ Adapt to struct string.
+ (macro output_line) Removed.
+ (macro add_string) Removed.
+ (output_encodings) Adapted to struct string. Moved to
+ err_push_file_locator().
+ (find_encoding_file) Fix assertion.
+ (read_ps_encodings) Move to err_push_file_locator().
+ (postopen) Use getl_location() instead of curfn.
+ (out_text_plain) Move to len_string.
+ (text) Ditto. Remove rich text support.
+
+ * print.c: (cmd_print) Remove now-unneeded resource cleanup code.
+ (cmd_print_eject) Ditto.
+ (cmd_write) Ditto.
+ (internal_cmd_print) Now cleans up after itself. Uses
+ fh_parse_file_handle() now.
+ (cmd_print_space) Use PXP_NUMERIC to type-check.
+
+ * q2c.c: Overhauled. Removed _("") i18n support. All references
+ updated. All output functions updated to handle structures rather
+ than local or static variables. Adapt to new PSPP lex_*()
+ functions.
+ (macro _) Removed.
+ (macro N_) Removed.
+ (macro MAX_N_SBC) Removed.
+ (global bare) Removed.
+ (enum STRING) Renamed T_STRING.
+ (enum ID) Renamed T_ID.
+ (get_buffer) Buffer size increased.
+ (strlower) Renamed st_lower(), rephrased.
+ (strupper) Renamed st_upper(), rephrased.
+ (skip_ws) New function.
+ (get_line) Don't special-case any types of lines (like those
+ beginning with ! or $, for instance).
+ (get_token) Renamed lex_get(). Rephrased.
+ (static var `prefix') New.
+ (parse) New function.
+ (parse_setting) Minor rephrasing.
+ (dump_specifier_vars) Ditto.
+ (make_identifier) Put null terminator on identifier, duh.
+ (dump_vars) Renamed dump_declarations(). Never indent. Never
+ static. Output changed entirely.
+ (dump_specifier_init) Rephrase.
+ (dump_vars_init) No index variable needed. Other modifications.
+ (dump_parser) Don't parse command name. Do dump functions instead
+ of just code fragments.
+ (dump_free) Dump function instead of code fragment.
+ (recognize_directive) New function.
+ (main) Use recognize_directive(). Don't rely on magic $ line
+ beginning: instead, parse comments. Update list of headers.
+
+ * random.c: New file, containing the following functions:
+ real_rand(), real_srand(), setup_randomize, shuffle, rand_uniform,
+ rand_normal, rand_simple.
+
+ * random.h: New file.
+
+ * recode.c: (cmd_recode) Merge internal_cmd_recode() into this
+ function. `max_src_width', `max_dst_width' changed to size_t.
+ (internal_cmd_recode) Removed.
+ (parse_dest_spec) Merge similar cases.
+ (parse_src_spec) Add assertion.
+
+ * repeat.c: (recognize_keyword) New function.
+ (internal_cmd_do_repeat) Parse and handle PRINT keyword on END
+ REPEAT. Improve recognition of END REPEAT (use
+ recognize_keyword()). Move from curfn to getl_location(). Use
+ struct string.
+
+ (perform_DO_REPEAT_substitutions) Adapt to struct string.
+
+ * set.q: Adapt to new q2c.
+ (cmd_set) Range-check some values better.
+ (custom_blanks) Renamed stc_custom_blanks().
+ (custom_length) Renamed stc_custom_length().
+ (custom_results) Renamed stc_custom_results().
+ (custom_seed) Renamed stc_custom_seed().
+ (custom_width) Renamed stc_custom_width().
+ (custom_format) Renamed stc_custom_format().
+ (custom_journal) Renamed stc_custom_journal().
+ (custom_color) Renamed stc_custom_color().
+ (custom_listing) Renamed stc_custom_listing().
+ (custom_disk) Renamed stc_custom_disk().
+ (custom_log) Renamed stc_custom_log().
+ (custom_rcolor) Renamed stc_custom_rcolor().
+ (custom_viewlength) Renamed stc_custom_viewlength().
+ (custom_workdev) Renamed stc_custom_workdev().
+
+ * settings.h: Not necessary to include format.h any longer.
+
+ * sfm-read.h: (macro bswap_int32) Moved here from sfmP.h.
+ (corrupt_msg) Rewritten.
+
+ * sort.c: Adapt to rewritten heap ADT.
+
+ * str.c: (aa_strcpy) Removed.
+ (ab_strcpy) Removed.
+ (ac_strcpy) Removed.
+ (ba_strcpy) Removed.
+ (bb_strcpy) Removed.
+ (ca_strcpy) Removed.
+ (aa_strdup) Removed.
+ (aa_strdupcpy) Removed.
+ (ba_strdup) Removed.
+ (sa_strdup) Removed.
+ (memrev) Renamed mm_reverse().
+ (memrmem) Renamed mm_find_reverse().
+ (cmp_str) Renamed st_compare_pad().
+ (strmaxcpy) Removed.
+ (strbarepadcpy) Renamed st_bare_pad_copy(), signature changed.
+ (strbarepadlencpy) Renamed st_bare_pad_len_copy(), signature
+ changed.
+ (strpadcpy) Renamed st_pad_copy(), signature changed.
+ (blpstrset) Removed.
+ (ds_create) New function.
+ (ds_init) New function.
+ (ds_replace) New function.
+ (ds_destroy) New function.
+ (ds_clear) New function.
+ (ds_extend) New function.
+ (ds_shrink) New function.
+ (ds_truncate) New function.
+ (ds_length) New function.
+ (ds_size) New function.
+ (ds_value) New function.
+ (ds_end) New function.
+ (ds_concat) New function.
+ (ds_concat_buffer) New function.
+ (ds_printf) New function.
+ (ds_putchar) New function.
+ (ds_getline) New function.
+ (ds_get_config_line) New function derived from the old
+ misc.c:get_config_line().
+ (ls_create) New function.
+ (ls_create_buffer) New function.
+ (ls_init) New function.
+ (ls_shallow_copy) New function.
+ (ls_destroy) New function.
+ (ls_null) New function.
+ (ls_null_p) New function.
+ (ls_empty_p) New function.
+ (ls_length) New function.
+ (ls_value) New function.
+ (ls_end) New function.
+
+ * str.h: Reformatted.
+ (struct a_string) Removed.
+ (struct b_string) Removed.
+ (struct c_string) Removed.
+ (struct len_string) New.
+ (struct string) New.
+ (macro as_streq) Removed.
+ (macro bs_streq) Removed.
+ (macro cs_streq) Removed.
+ (macro sa_streq) Removed.
+ (macro sb_streq) Removed.
+ [__GNUC__] (inline function ds_putchar) New function.
+ [__GNUC__] (inline function ds_length) New function.
+ [__GNUC__] (inline function ds_value) New function.
+ [__GNUC__] (inline function ds_end) New function.
+
+ * sysfile-info.c: (cmd_sysfile_info) Rephrased.
+ (display_vectors) Fix missing i18n.
+
+ * t-test.q: Migrate to new q2c.
+
+ * tab.c: Migrate from arenas to pools.
+ (tab_create) Use struct len_string.
+ (tab_realloc) Ditto.
+ (text_format) Ditto.
+ (tab_joint_text) Ditto.
+ (tab_natural_width) Remove rich text support.
+ (tab_natural_height) Ditto.
+ (tab_output_text) Handle TAT_FIX.
+ (tab_raw) Change arg from a_string to len_string.
+ (tabi_driver) Fix assertion. Use struct len_string.
+ (render_strip) Use struct len_string. Remove rich text support.
+ Add `const' qualifiers.
+
+ * tab.h: (enum TAB_RICH) Remove.
+ (enums TAB_COL_NONE, TAB_COL_DONE) New. Where appropriate,
+ SOM_COL_* updated to read TAB_COL_*.
+ (struct tab_table) Change arena to pool. Change a_string to
+ len_string.
+
+ * temporary.c: (restore_dictionary) Rewrite Checker code.
+
+ * var.h: (macros MAX_SHORT_STRING, MIN_LONG_STRING, SYSMIS,
+ LOWEST, HIGHEST) Moved here from common.h.
+ (typedef any_trns) Removed. All references changed to `struct
+ trns_header'.
+
+ * vars-atr.c: (force_create_variable) Fix assertion.
+ (force_dup_variable) Fix assertion.
+
+Thu Jun 3 18:40:42 1999 Ben Pfaff <blp@gnu.org>
+
+ Using alphanumeric variables in functions under AGGREGATE
+ segfaulted. Fixed. Thanks to Dr. Dirk Melcher
+ <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * aggregate.c: (parse_aggregate_functions) When setting the
+ FSTRING bit, also allocate memory for the `string' member of
+ agr_next.
+ (free_aggregate_functions) Free iter->string. Don't use the
+ non-function bits when indexing the array of functions.
+ [DEBUGGING] (debug_print) Don't use the non-function bits when
+ indexing the array of functions.
+
+Sun May 30 00:00:54 1999 Ben Pfaff <blp@gnu.org>
+
+ Under certain circumstances, the final case would be omitted from
+ the results of an AGGREGATE operation. Fixed. Thanks to Dr. Dirk
+ Melcher <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * aggregate.c (agr_00x_end_func): Increment number of cases in
+ sink before writing case. For streams that keep track of how many
+ cases there are based on this value, this means that the last case
+ will be read in on the next stream read.
+
+Sat May 29 22:03:31 1999 Ben Pfaff <blp@gnu.org>
+
+ Undefined behavior was invoked by referencing a freed pointer.
+
+ * vfm.c (memory_stream_write): Free pointer *after* checking for
+ non-null status.
+
+Sat May 29 22:02:22 1999 Ben Pfaff <blp@gnu.org>
+
+ A wrong record size was displayed when paging the active file to
+ disk.
+
+ * vfm.c: (memory_stream_write) Fix off-by-one error.
+
+Sat May 29 21:50:26 1999 Ben Pfaff <blp@gnu.org>
+
+ Not having enough temporary space for sorting caused a core dump.
+ Fixed.
+
+ * sort.c: (allocate_cases) Initialize i.
+
+Sat May 29 21:40:54 1999 Ben Pfaff <blp@gnu.org>
+
+ Syntax errors in function descriptions on AGGREGATE caused core
+ dumps. Fixed.
+
+ * aggregate.c (cmd_aggregate): Don't free agr_dict after calling
+ free_aggregate_functions(), since that function already frees
+ agr_dict.
+
+Sat May 29 21:06:10 1999 Ben Pfaff <blp@gnu.org>
+
+ A null pointer was dereferenced, causing a core dump, when
+ PERCENTILES was specified on FREQUENCIES. This fixes the problem,
+ but PSPP still doesn't calculate percentiles. Thanks to Regnor
+ Jernsletten <rjernsle@eunet.no> for reporting this problem.
+
+ * arena.c: (arena_malloc) If the arena hasn't been initialized
+ already, initialize it.
+
+Sat May 29 20:47:29 1999 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.cygwin: New file supplied by Hankin <hankin@dunno.com>
+ for compilation with Cygnus Windows B20. Not used by other
+ systems.
+
+Sat May 29 20:36:04 1999 Ben Pfaff <blp@gnu.org>
+
+ SORT always sorted in ascending order. Fixed. Thanks to Dr. Dirk
+ Melcher <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * sort.c: (compare_case_lists) Reverse sense of comparison if
+ sorting in descending order.
+ (compare_record) Ditto.
+
+Tue Mar 9 13:18:54 1999 Ben Pfaff <blp@gnu.org>
+
+ SPLIT FILE with a string variable caused a core dump. Fixed.
+
+ * vfm.c: If the variable is a string then make a temporary value
+ struct pointing to it. The underlying problem is a lot bigger
+ than this (see TODO) but this is a stopgap for the simple case at
+ least.
+
+Tue Mar 9 13:15:53 1999 Ben Pfaff <blp@gnu.org>
+
+ Nested INCLUDEs didn't work. Fixed.
+
+ * getline.c: (getl_include) Set first_line to NULL in allocated
+ structure.
+
+Tue Mar 9 13:13:46 1999 Ben Pfaff <blp@gnu.org>
+
+ The MATCH FILES procedure set the values of variables not present
+ to 0. It should have been SYSMIS. This is now fixed.
+
+ * get.c: (mtf_delete_file_in_place) Replace 0.0 by SYSMIS.
+
+Tue Mar 9 12:52:23 1999 Ben Pfaff <blp@gnu.org>
+
+ The REMARK command was too aggressive about skipping lines. It
+ didn't like being the last command in a file.
+
+ * command.c: (cmd_remark) Call get_entire_line() instead of
+ get_line().
+
+Tue Mar 9 12:48:05 1999 Ben Pfaff <blp@gnu.org>
+
+ Comment parsing wasn't consistent with the rest of the code in its
+ idea of where one command ends and another starts. This meant
+ that sometimes commands would be mysteriously ignored. Thanks to
+ Dr. Dirk Melcher <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * command.c: (parse_cmd) Hand off comment parsing to new function
+ skip_comment() in lexer.c.
+ * lexer.c: (skip_comment) New function.
+
+Wed Jan 20 20:22:07 1999 Ben Pfaff <blp@gnu.org>
+
+ The TABLE subcommand on MATCH FILES worked only erratically at
+ best. This fixes it. Thanks to Dr. Dirk Melcher
+ <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * get.c: (mtf_compare_BY_values) When comparing string values, a
+ difference of 1 is still a difference :-)
+ (mtf_processing) Inverted TABLE reading logic fixed. Also don't
+ advance TABLE files automatically when matched. Comment fixes.
+
+Tue Jan 19 22:32:31 1999 Ben Pfaff <blp@gnu.org>
+
+ VARIABLE LABELS rejected a slash before the first variable
+ specification, contradicting the documentation. Thanks to Walter
+ M. Gray <graywm@northernc.on.ca> for reporting this bug.
+
+ * var-labs.c: (cmd_variable_labels) Ignore a leading slash in
+ command specification.
+
+Tue Jan 19 22:29:54 1999 Ben Pfaff <blp@gnu.org>
+
+ Because of an incorrect optimization in memory allocation,
+ CROSSTABS sometimes segfaulted when asked to output multiple
+ tables. Thanks to Walter M. Gray <graywm@northernc.on.ca> for
+ reporting this bug.
+
+ * crosstabs.q: (postcalc) New variables maxcols, maxcells, which
+ are passed to output_pivot_table() for its use.
+ (output_pivot_table) Instead of assuming the number of columns is
+ constant, keep track with maxcols. In general mode, use maxcells
+ to determine whether more matrix cells need to be allocated.
+
+Tue Jan 19 22:27:46 1999 Ben Pfaff <blp@gnu.org>
+
+ CROSSTABS didn't display value labels for column and row
+ variables. Thanks to Walter M. Gray <graywm@northernc.on.ca> for
+ reporting this bug.
+
+ * crosstabs.q: (table_value_missing) If the specified value has a
+ value label for this variable, then show it instead of the raw
+ value.
+ (display_dimensions) Delegate display of value_labels to
+ table_value_missing.
+
+Mon Jan 18 20:04:06 1999 Ben Pfaff <blp@gnu.org>
+
+ WRITE didn't write line ends. Fixed. Thanks to Dr. Dirk Melcher
+ <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * print.c: (print_trns_proc) Write (CR/)LF if PRINT is used _or_
+ if the file isn't declared as binary.
+
+Mon Jan 18 19:56:45 1999 Ben Pfaff <blp@gnu.org>
+
+ MATCH FILES corrupted memory and dumped core on some syntax
+ errors. Fixed.
+
+ * get.c: (cmd_match_files) Set file->handle to NULL before
+ jumping to lossage.
+ (mtf_free_file) Don't free a null dictionary.
+
+Mon Jan 18 19:27:57 1999 Ben Pfaff <blp@gnu.org>
+
+ MATCH FILES should set numeric values not available to the
+ system-missing value, not to 0. Thanks to Dr. Dirk Melcher
+ <BZN-mdksh@t-online.de> for reporting this bug.
+
+ * get.c: (mtf_processing) Set unused records to system-missing,
+ not 0.
+
+Mon Jan 18 15:06:46 1999 Ben Pfaff <blp@gnu.org>
+
+ KEEP didn't work properly on the SAVE procedure. Fixed. Thanks
+ to Ralf Geschke <ralf@kuerbis.org> for reporting this bug.
+
+ * temporary.c: (save_dictionary) Initialize var_by_name AVL tree
+ in newly created dictionary, and add each copied variable to the
+ tree.
+
+Mon Jan 18 15:04:48 1999 Ben Pfaff <blp@gnu.org>
+
+ Memory leak fix.
+
+ * get.c: (trim_dictionary) Free variable list for KEEP after
+ finishing with it.
+
+Mon Jan 18 12:57:36 1999 Ben Pfaff <blp@gnu.org>
+
+ Some systems didn't like the way open_file was coded. Thanks to
+ Hankin <hankin@rogue.consultco.com> for pointing this out.
+
+ * filename.c: (open_file) Don't try to store stdin, stdout,
+ stderr as part of an array, because that doesn't always work.
+
+Mon Jan 18 12:53:27 1999 Ben Pfaff <blp@gnu.org>
+
+ The SAVE procedure didn't save long string variables properly.
+ Fixed by this patch. Thanks to Hankin
+ <hankin@rogue.consultco.com> for this patch.
+
+ * sfm-write.c: (write_variable) Fix off-by-one error in writing
+ out variable pad records.
+
+Tue Jan 5 14:29:27 1999 Ben Pfaff <blp@gnu.org>
+
+ Previously, if PRINT SPACE were given a negative argument, it
+ would report an error, then spin in an (almost) infinite loop.
+ This fixes that behavior.
+
+ * print.c: (print_space_trns_proc) After reporting a negative
+ argument, set number of lines to print to 1.
+
+Tue Jan 5 13:59:55 1999 Ben Pfaff <blp@gnu.org>
+
+ SPSS 8.0 outputs some new record types in its system files, and it
+ allows longer value labels. Accept these system files.
+
+ * sfm-read.c: (sfm_read_dictionary) Ignore record type 7 subtype
+ 11 emitted by SPSS 8.0.
+
+Tue Jan 5 13:55:50 1999 Ben Pfaff <blp@gnu.org>
+
+ The LIST procedure was too conservative in allocating space for
+ buffers, which caused a bug that only showed up with very long
+ output variables. Thanks to Hankin <hankin@dunno.com> for this
+ bug report.
+
+ * list.q: (determine_layout) Allocate 1022 bytes instead of 256.
+
+Tue Jan 5 13:34:34 1999 Ben Pfaff <blp@gnu.org>
+
+ Typo meant string format specifiers weren't checked properly. I
+ think that Hankin <hankin@dunno.com> sent me this report, but I'm
+ willing to be corrected on this point.
+
+ * format.c: (check_string_specifier) Fix obvious typo.
+
+Tue Jan 5 12:50:42 1999 Ben Pfaff <blp@gnu.org>
+
+ Using $CASENUM in an expression didn't work. Here's a fix.
+ Thanks to Dirk Melcher <BZN-mdksh@t-online.de> for reporting this
+ bug.
+
+ * expr-evl.c: (evaluate_expression) Add OP_CASENUM case.
+
+ * expr-opt.c: (dump_node) OP_CASENUM is acceptable.
+
+Tue Jan 5 12:47:48 1999 Ben Pfaff <blp@gnu.org>
+
+ The changes in 0.2.1 to fix DATA LIST FREE parsing broke some
+ other behavior, *sigh*. This patch hopefully fixes that. This
+ time I've actually tested it.
+
+ Thanks to Hankin <hankin@dunno.com> for reporting this bug.
+
+ * data-list.c: (read_from_data_list_free,
+ read_from_data_list_list) Call parse_string_as_format() directly
+ without mucking around with the field width.
+
+Tue Jan 5 12:31:19 1999 Ben Pfaff <blp@gnu.org>
+
+ Occasionally, you may encounter a script that wants to be
+ interpreted in interactive mode. Make -i emulate this behavior to
+ allow such scripts to be executed with PSPP.
+
+ Thanks to Hankin <hankin@dunno.com> for reporting this behavior.
+
+ * cmdline.c: (pre_syntax_message[]) Update -i description.
+
+ * lexer.c: (preprocess_line) When getl_interactive is 2 (i.e.,
+ when -i is given on the command line) don't treat unindented lines
+ as starting a new command.
+
+Tue Jan 5 12:30:10 1999 Ben Pfaff <blp@gnu.org>
+
+ In conjunction with egcs 1.1.1, Checker emits some bogus warnings,
+ mostly caused by local initialized aggregates. After egcs is
+ fixed upstream these can be removed, but for now they're not a big
+ deal.
+
+ * ascii.c: (ascii_postopen_driver) Checker chokes on local
+ initialized arrays. Avoid this.
+
+ * sfm-write.c: (sfm_write_dictionary) Don't use a local
+ initialized struct.
+
+Tue Jan 5 12:07:24 1999 Ben Pfaff <blp@gnu.org>
+
+ egcs 1.1.1 has some new warnings relative to gcc 2.8.1, which the
+ following changes avoid. Currently I compile sources with egcs
+ 1.1.1 and gcc 2.7.2.3 before sending them out.
+
+ * apply-dict.c: (apply_dict) Use new avl_traverser_init() macro.
+
+ * ascii.c: (option_tab[]) Initialize all struct members.
+
+ * avl.h: (avl_traverser_init) New macro.
+
+ * command.c: (DEFCMD, UNIMPL macros, cmd_table[]) Initialize all
+ struct members.
+
+ * crosstabs.q: (enum_var_values) Use new hsh_iterator_init()
+ macro.
+
+ * hash.c: Comment fix.
+
+ * hash.h: (hsh_iterator_init) New macro.
+
+ * html.c: (option_tab[]) Initialize all struct members.
+
+ * pfm-write.c: (write_value_labels) Use new avl_traverser_init()
+ macro.
+
+ * postscript.c: (option_tab[]) Initialize all struct members.
+ (output_encodings, preclose, dump_lines) Use new
+ hsh_iterator_init() macro.
+
+ * sfm-write.c: (write_value_labels) Use new avl_traverser_init()
+ macro.
+
+ * sysfile-info.c: (describe_variable) Use new avl_traverser_init()
+ macro.
+
+Thu Nov 19 12:32:45 1998 Ben Pfaff <blp@gnu.org>
+
+ * data-in.c: Examined each of the parsing functions to make sure
+ that they wouldn't dump core if they were passed a string of the
+ wrong length, since now the DATA LIST FREE/LIST routines don't
+ check for field width before passing it to the data parser.
+ (parse_RBHEX, parse_AHEX) Reject odd length input.
+ (parse_string_as_format) Reject input that's too short or too
+ long.
+
+ * data-list.c: Before, the DATA LIST FREE/LIST routines would pad
+ a field to its entire declared output width then pass it to the
+ data-in parsing routines. This contradicted the documented
+ behavior. This is fixed in these changes. Thanks to Mark H. Wood
+ <mwood@IUPUI.Edu>. In addition, this fixes a few more details of
+ free-format parsing that differed from SPSS.
+ (cut_field) Commas and spaces are treated identically. Returns
+ the proper column instead of a fixed 1 value.
+ (parse_field) Removed.
+ (read_from_data_list_free, read_from_data_list_list) Call
+ parse_string_as_format directly instead of parse_field.
+
+ * heap.c: (heap_delete) Stylistic fixes.
+
+Sun Aug 9 11:12:13 1998 Ben Pfaff <blp@gnu.org>
+
+ * loop.c: (loop_2_trns_proc) Formatting fix.
+
+ * sel-if.c: (cmd_filter) Set FILTER_before_TEMPORARY.
+
+ * var.h: (glob var FILTER_before_TEMPORARY) New global var.
+
+ * vfm.c: (macro FILTERED) New.
+ (static var filter_var) New.
+ (process_active_file_write_case) Use FILTERED.
+ (setup_filter) Set filter_var.
+ (close_active_file) Delete the filter if not
+ FILTER_before_TEMPORARY.
+ (procedure_write_case) Use FILTERED.
+
+Sat Aug 8 00:20:14 1998 Ben Pfaff <blp@gnu.org>
+
+ * crosstabs.q: Changed /PIVOT={ON,OFF} to /FORMAT={PIVOT,NOPIVOT}.
+
+ * data-in.c: (parse_day_count) Message fix.
+ (parse_month) Style fix.
+
+ * data-list.c: (struct data_list_pgm) New member eof.
+ (cmd_data_list) Init eof to 0.
+ (do_reading) Implement the /END subcommand and read-past-eof
+ checking.
+
+ * do-if.c: Include stdio.h when debugging.
+ (cmd_else_if) Make sure the command is .-terminated.
+
+ * glob.c: (init_glob) Capitalize the command prompt.
+
+ * inpt-pgm.c: (end_case_trns_proc) Debugging message.
+ (end_file_trns_proc) Debugging message.
+
+ * loop.c: (internal_cmd_loop) Make it work when there's no loop
+ index!
+ (loop_2_trns_proc) Enable MXLOOPS (why was this disabled?)
+
+ * main.c: (dump_token) Make kwtab[] const.
+
+ * set.q: Spelling, comment fixes.
+
+ * sysfile-info.c: (cmd_display) DISPLAY VECTORS not DISPLAY
+ VECTOR.
+
+ * vars-prs.c: (fill_all_vars) Style fix.
+
+ * vfm.c: (index_to_varname) Return const.
+
+Tue Aug 4 23:49:23 1998 Ben Pfaff <blp@gnu.org>
+
+ * Changes in many source files for partial -ansi -pedantic and
+ no-debugging compliance: Remove trailing common in enum
+ declarations; add `unused' attributes; insert some appropriate
+ casts.
+
+ * cmdline.c: (parse_command_line) Add new --testing-mode flag.
+
+ * command.c: (shell) Make static.
+ (run_command) Make static.
+
+ * data-list.c: (dump_fixed_table) Remove use of local_strdup().
+
+ * dfm.c: (cmd_begin_data) I18n fix.
+
+ * error.c: (verbose_msg) Define if __STRICT_ANSI__.
+
+ * error.h: (macro verbose_msg) Define if __STRICT_ANSI__.
+
+ * expr-opt.c: (evaluate_tree) Don't initialize local arrays if
+ __STRICT_ANSI__.
+
+ * file-handle.q: Don't prepend the source file directory name to
+ the data file name. (Ongoing issue.)
+ (prepend_current_directory) Comment out.
+ (internal_cmd_file_handle) Don't call prepend_current_directory().
+ (fh_get_handle_by_filename) Ditto.
+
+ * filename.c: Append zero byte to readlink() return value.
+
+ * getline.c: (getl_read_line) I18n fix.
+
+ * lexer.h: Don't use gcc features if __STRICT_ANSI__.
+
+ * misc.h: Don't use gcc features if __STRICT_ANSI__.
+
+ * pfm-write.c: (bufwrite) Don't try to increment a void * pointer
+ directly.
+
+ * postscript.c: (output_encodings) Don't use local_strdup().
+ (postopen) Ditto.
+
+ * print.c: Don't use gcc features if __STRICT_ANSI__.
+
+ * q2c.c: (dump_vars) Don't put a , at the end of the last enum.
+
+ * recode.c: (parse_src_spec) Fully brace nested if's.
+
+ * set.q: (global var set_testing_mode) New var.
+
+Wed Jul 29 22:01:44 1998 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: Add some more `unused' attributes that only come into
+ play when NDEBUG is defined.
+ (ascii_close_page) Set s_len when reallocating s.
+
+ * crosstabs.q: (delete_missing) New function.
+ (output_pivot_table) Call delete_missing() if /MISSING=REPORT.
+ (make_summary_table) Create summary table reallocable.
+
+ * postscript.c: Add more `unused' attributes as above.
+
+ * tab.c: (tab_create) [GLOBAL_DEBUGGING] Set reallocable member.
+ (tab_realloc) [GLOBAL_DEBUGGING] Assert that table is reallocable.
+
+ * tab.h: (struct tab_table) [GLOBAL_DEBUGGING] New `reallocable'
+ member.
+
+ * var.h: (macro force_dup_variable) [!GLOBAL_DEBUGGING] Remove
+ gratuitous space between parameter definition.
+
+ * vars-atr.c: Changed some assert(0)'s to abort()'s to prevent
+ complaints about running off the end of functions with NDEBUG
+ enabled.
+
+Sun Jul 5 00:17:25 1998 Ben Pfaff <blp@gnu.org>
+
+ * Several source files: Removed some PORTME notes when reflection
+ revealed that ANSI forbids that sort of breakage. Also, added
+ lots of `unused' qualifiers here and there.
+
+ * aggregate.c: (accumulate_aggregate_info) Remove local var
+ weighting that turned out not to be used.
+
+ * avl.c: Update to version 1.1.0. Add unused specifier.
+ (avl_destroy) Initialize ab to 0. Comment fixes. Cast return
+ value to void *.
+ (avl_probe) Replace some instances of 1 with +1 where appropriate.
+ (avl_find) Cast return value to void *.
+ (avl_delete) q doesn't need to be initialized at the beginning of
+ the function. Replace some instances of 1 with +1.
+ (force_avl_delete) Renamed avl_force_delete, all references changed.
+ (compare_ints) `param' marked unused.
+ (print_int) `param' marked unused.
+ (recurse_tree) Replace some instances of 1 with +1.
+
+ * avl.h: Update to version 1.1.0. Only declares avl function
+ types if not already declared.
+ (AVL_MAX_HEIGHT) Only define if not already defined.
+ (struct avl_node) New unused member char pad[2].
+ [GLOBAL_DEBUGGING] Change conditionalization to NDEBUG instead.
+ (force_avl_insert) Renamed avl_force_insert.
+ (force_avl_delete) Renamed avl_force_delete.
+
+ * crosstabs.q: (struct table_entry) Put `freq' into a union with
+ new member `data'.
+ (struct crosstab) Add new member `ofs'.
+ (glob var int_tab) Removed.
+ (custom_tables) In integer mode, assign v[i] properly through the
+ indirect var_dict.
+ (custom_variables) Now p.crs.max == max + 1.
+ [DEBUGGING] (debug_print) p.crs.min and p.crs.max are now ints.
+ (precalc) Implement integer mode.
+ (calc_integer) Implement integer mode.
+ (compare_table_entry) Remove unused local variable `comparing'.
+ (make_summary_table) Implement integer mode.
+ (macro ns_rows) Implemented as static variable now.
+ (several variables) Made static, from global.
+ (output_pivot_table) Use table_value_missing() for column heads.
+ Remove several unused local variables. Implement integer mode
+ table summing. Count up ns_rows.
+ (crosstabs_dim) Make columns wider when /MISSING=REPORT requested.
+ (find_pivot_extent) Moved into find_pivot_extent_general; now just
+ calls that function or find_pivot_extent_integer.
+ (find_pivot_extent_integer) New function.
+ (enum_var_values) Implemented for integer mode.
+ (table_value_missing) New function.
+ (display_dimensions) Call table_value_missing() for heads.
+ (float_M_suffix) New function.
+ (display_crosstabulation) Call table_value_missing() for row
+ heads. Handle missing values in /MISSING=REPORT mode.
+ (calc_fisher) Remove unused var N.
+ (calc_r) Remove unused var fact.
+
+ * data-list.c: (dump_fixed_table) Fix table dimensioning.
+ (read_one_set_of_repetitions) Remove unused vars var_spec, column.
+
+ * data-out.c: (insert_commas) Remove unused var cp.
+ (convert_CCx) Remove unused vars save_set_decimal,
+ save_set_grouping.
+
+ * descript.q: (dump_z_table) Fix table dimensioning.
+ (pre_calc) Remove unused var j.
+ (display) Remove unused vars title, s. Fix table dimensioning.
+
+ * expr-evl.c: Comment fixes.
+
+ * frequencies.q: (full_dim) New function.
+ (dump_full) Fix table dimensioning.
+ (condensed_dim) New function.
+ (dump_condensed) Fix table dimensioning.
+
+ * get.c: (cmd_match_files) Remove unused var n_val. Remove unused
+ label winnage.
+
+ * html.c: (html_close_drive) Remove unused var i.
+ (postopen) Remove unused vars title, curfn_len, cp.
+ (preclose) Remove unused vars this, x.
+
+ * lexer.c: Comment fixes.
+
+ * matrix-data.c: (cmd_matrix_data) Remove unused var index.
+
+ * means.q: (custom_tables) Remove unused var m_dim.
+
+ * mis-val.c: Format fix.
+
+ * modify-vars.c: (cmd_modify_vars) Remove unused var new_dict.
+
+ * output.c: (outp_get_paper_size) Remove unused var cp.
+
+ * pfm-read.c: (read_float) Remove unused var save, unused label
+ underflow.
+ (read_variables) Remove unused vars cp, j.
+ (read_value_label) Remove unused var j.
+
+ * pfm-write.c: (bufwrite) Remove unused var i.
+
+ * postscript.c: (ps_postopen_drive) Remove unused vars dev_info,
+ fn.
+ (output_encodings) Remove unused vars char_cp, n_output.
+ (read_ps_encodings) Remove unused var ep.
+ (postopen) Remove unused var title.
+ (preclose) Remove unused var fp.
+ (ps_open_page) Remove unused vars true, false, orientation,
+ mirror_horz, mirror_vert, width, length.
+ (ps_text_metrics) Remove unused var x.
+
+ * q2c.c: (find_symbol) Remove unused var y.
+ (parse_setting) Remove unused parameter sbc, all references
+ changed.
+ (dump_parser) Remove unused var cp.
+ (dump_free) Remove unused var i.
+
+ * set.q: (static vars args, n) Removed.
+ (internal_cmd_gset) Removed.
+
+ * sfm-read.c: (sfm_read_dictionary) Removed unused var i.
+ (read_machine_flt64_info) Removed unused var file_endian.
+ (read_documents) Removed unused var i.
+ (read_compressed_data) Removed unused parameter dict, all
+ references changed.
+
+ * sfm-write.c: (bufwrite) Removed unused var i.
+ (sfm_write_case) Removed unused var i.
+
+ * sort.c: (merge_once) Remove unused var t.
+ (write_separate) #if 0 out as dead code.
+
+ * split-file.c: (cmd_split_file) Remove unused var i.
+
+ * sysfile-info.c: (sysfile_info_dim) New function.
+ (cmd_sysfile_info) Fix table dimensioning.
+ (variables_dim) New function.
+ (display_variables) Fix table dimensioning.
+ (describe_variable) Remove unused var prev_r.
+
+ * t-test.q: (z_postcalc) Removed.
+ (pairs_calc) Remove unused var bad_weight.
+ (postcalc) Remove unused vars dfn, dfd.
+
+ * tab.c: (tab_create) Set t->dim to NULL.
+ (tab_dim) Make sure t->dim is NULL first.
+ (tab_natural_width) Remove parameter `clamp'.
+ (tab_value) Remove duplicate assertion for table.
+ (tab_raw) New function.
+ (nowrap_dim) New function.
+ (wrap_dim) New function.
+ (tab_output_text) Fix table dimensioning.
+
+ * tab.h: (tab_raw) New macro.
+
+ * val-labs.c: (get_label) Remove unused var type.
+ (copy_value_labels) Remove unused var trav.
+
+ * var.h: (struct crosstab_proc) Completely changed.
+
+ * vars-prs.c: (parse_dict_variable) Remove unused var v.
+
+ * vfm.c: (open_active_file) Remove unused vars i, lp.
+
+ * weight.c: (weight_trns_proc) #if 0 out as dead code.
+
+Tue Jun 2 23:37:21 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Add apply-dict.c, flip.c.
+
+ * apply-dict.c: New file.
+
+ * command.c: (struct command) Make cmd[] larger for CLEAR
+ TRANSFORMATIONS command name.
+ (parse_cmd) Make sure we're in a valid state before using it as an
+ index. Discard variables and reset state on invalid transitions.
+ (cmd_clear_transformations) New function.
+
+ * command.def: Add APPLY DICTIONARY, CLEAR TRANSFORMATIONS, FLIP.
+ Add unimplemented PRESERVE, RESTORE.
+
+ * file-handle.h: Include stddef.h.
+
+ * flip.c: New file.
+
+ * pfm-read.c: (parse_value) Pad value label values with spaces,
+ not nulls.
+
+ * sfm-read.c: (struct sfm_fhuser_ext) Add reference count.
+ (sfm_close) Decrement reference count, make sure it's zero.
+ (sfm_maybe_close) New function.
+ (sfm_read_dictionary) Handle reference counts.
+
+ * vars-atr.c: (clear_default_dict) New function.
+ (discard_variables) Use clear_default_dict().
+
+Sun May 31 00:58:05 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Add pfm-write.c.
+ (LDADD) Add the libgmp2 libraries.
+
+ * command.def: Define EXPORT.
+
+ * get.c: (cmd_export) New function.
+ (export_write_case_func) New function.
+
+ * pfm-read.c: (static spss2ascii[]) Make it const.
+
+ * pfm-write.c: New file.
+
+ * sfm-write.c: Formatting, comment fixes.
+
+ * var.h: Comment fix.
+
+Fri May 29 21:44:12 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Add pfm.h, pfm-read.c.
+
+ * command.def: IMPORT is now implemented.
+
+ * format.c: (glob var translate_fmt[]) New var.
+
+ * get.c: (enum GTSV_NONE) Renamed GTSV_OPT_NONE.
+ (cmd_import) New function.
+ (import_source_read) New function.
+ (glob var import_source) New var.
+
+ * pfm-read.c: New file.
+
+ * pfm.h: New file.
+
+ * sfm-read.c: (parse_format_spec) Local variable translate_fmt[]
+ moved in format.c.
+ (dump_dictionary) Disabled printing a couple of items.
+
+Mon May 25 12:42:37 1998 Ben Pfaff <blp@gnu.org>
+
+ * crosstabs.q: (postcalc) Call make_summary_table().
+ (make_summary_table) New function.
+ (insert_summary) New function.
+ (display_dimensions) Remove some unnecessary arguments, all
+ references changed.
+ (output_pivot_table) Fix lots of problems with the risk table
+ setup.
+ (submit) Don't display an empty table.
+ (display_risk) Fix order of arguments to calc_risk().
+
+ * glob.c: Always include assert.h and stdlib.h.
+
+ * output.h: (enum OUTP_T_JUST_FULL) Removed, all references
+ removed.
+
+ * tab.c: (tab_create) Cosmetic changes.
+
+ * tab.h: (enum TAB_JUSTIFY) Removed, all references removed.
+
+Sun May 24 22:39:23 1998 Ben Pfaff <blp@gnu.org>
+
+ * tab.def: Removed.
+
+ * crosstabs.q: (output_pivot_table) Headers drawing and submission
+ code simplified, moved into new function submit().
+ (submit) New function.
+ (crosstabs_dim) New function.
+ (display_directional) Substitute variable names for %s where
+ appropriate.
+ (somers_d_v[], somers_d_ase[], somers_d_t[]) New static vars.
+ (calc_symmetric) Initialize parameters only if non-NULL.
+ Calculate Somers' d.
+ (calc_directional) Calculate Somers' d (or copy it, really).
+ Calculate eta.
+
+ * output.c: (outp_string_width) New function.
+
+ * postscript.c: (postopen) Calculate font widths based on the
+ width of the zero '0' character, not the width of the space
+ character. Set paper-width and paper-length based on points, not
+ device units.
+ (ps_open_page) Fix page setup string for landscape mode.
+
+ * som.h: (struct som_dimension) Removed.
+ (struct som_table_class) height, width members take int * not
+ som_dimesion * now.
+
+ * tab.c: Many functions now have added parameter validation.
+ (tab_height, tab_width) These functions were removed and merged
+ into a single function tab_resize(), and all references changed.
+ (tab_dim) Rewritten since the interface changed; reduced from
+ hundreds of lines to two. All callers were changed. Currently
+ most of them just use tab_natural_dimensions as their callback and
+ await detailed translation of functionality.
+ (tab_natural_width) New function.
+ (tab_natural_height) New function.
+ (tab_natural_dimensions) New function. This is a callback
+ function, not something that you'd want to call directly.
+ (tab_nat_dim) Removed.
+ (tabi_table) Allocates t->w and t->h.
+ (tabi_driver) Inlined sum_columns()'s functionality. Calls the
+ dimensions callback.
+ (evaluate_dimensions) Removed.
+ (sum_columns) Removed.
+
+ * tab.h: (enum TAL_1THIN) Removed.
+ (enum series t_*) Removed.
+ (struct tab_table) Members trh, trv changed to unsigned char *
+ from int *. Member dim changed to a function pointer from a
+ unsigned char *. Member max_stack_height removed. New members
+ hr_tot, vr_tot.
+ (macros tab_l, tab_r, tab_t, tab_b) New.
+
+Sat May 23 23:22:13 1998 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: (delineate) Assign last_space_nchars before skipping
+ spaces, to fix right justification.
+
+ * crosstabs.q: (static vars risk, direct) New vars.
+ (static var pearson_r) Removed.
+ (glob var chisq_fisher) Made static.
+ (static vars row_tot[], col_tot[]) Don't include grand total
+ anymore.
+ (static var grand_total) Renamed W, all references changed.
+ (output_pivot_table) Only make `table' if num_cells != 0. Make
+ risk and directional tables. Deal with grand total no longer part
+ of col_tot[]. Free rows and cols after we're done with them.
+ (display_risk) New function.
+ (display_directional) New function.
+ (clac_r) Rewritten so that it stores all its results into its
+ arguments, so it can be used for Spearman's correlation too.
+ (calc_symmetric) Added a t[] argument, all references changed.
+ Calculates ASEs for tau-b, tau-c, gamma. Calculates Spearman's r,
+ Pearson's r, Cohen's kappa.
+ (calc_risk) New function.
+ (calc_directional) New function.
+
+ * som.c: (som_submit) Improved debugging code.
+
+ * stats.c: (hypercube) New function.
+ (cube) New function.
+ (sqr) New function.
+ (normal_sig) Went back to old implementation, which actually
+ worked.
+
+ * stats.h: (macros square, cube, hypercube) Removed. The
+ equivalent functions in stats.c are inlined here; all references
+ to square changed to sqr.
+
+Fri May 22 00:03:41 1998 Ben Pfaff <blp@gnu.org>
+
+ * crosstabs.q: (N_SYMMETRIC) New define.
+ (postcalc) Disable debug printing.
+ (static vars chisq_fisher, pearson_r) New.
+ (output_pivot_table) Add support for symmetric measures. Add
+ chi-square output of exact sigs.
+ (display_chisq) Rewritten.
+ (display_symmetric) New function.
+ (gamma_int) New function.
+ (Pr) New function.
+ (swap) New function.
+ (calc_fisher) New function.
+ (calc_chisq) Check boundary conditions better. Calculate Yates,
+ Fisher, Mantel-Haenszel tests.
+ (calc_r) New function.
+ (calc_symmetric) New function.
+
+ * stats.c: (normal_sig) Rewritten with new algorithm. Renamed
+ from calc_normal.
+ (chisq_sig) Better boundary conditions. Renamed from
+ calc_significance.
+
+ * tab.h: (struct tab_table) New member cf.
+
+ * tab.c: (tab_create) Set cf.
+ (tab_width) New function.
+ (tab_realloc) Handle cf.
+ (tab_vline) Handle cf.
+ (tab_hline) Handle cf.
+ (tab_box) Handle cf.
+ (tab_value) Handle cf.
+ (tab_float) Handle cf.
+ (tab_text) Handle cf.
+ (tab_joint_text) Handle cf.
+ (tab_offset) Handle cf.
+ (tab_next_row) Handle cf.
+ (evaluate_dimensions) Handle cf.
+ (render_strip) Handle cf.
+
+Wed May 20 00:03:59 1998 Ben Pfaff <blp@gnu.org>
+
+ * crosstabs.q: (postcalc) New vars row_tot, col_tot, pass them to
+ output_pivot_table().
+ (output_pivot_table) Moved lots of local variables outside and
+ made them static. Add beginnings of chi-square statistic
+ support. Now column and row totals aren't in the main matrix.
+ Always zero out any leftover rows & columns after we're done with
+ the table entries. Move all output stuff into
+ display_dimensions(), display_crosstabs(), display_chisq().
+ (display_dimensions) New function.
+ (display_crosstabulation) New function.
+ (display_chisq) New function.
+ (calc_chisq) Implemented Pearson and likelihood-ratio chisquares.
+
+ * frequencies.q: (dump_full, dump_condensed) Remove tab_null()
+ references, simplify logic.
+
+ * postscript.c: Remove scale, translate-x, translate-y,
+ mirror-horz, mirror-vert, rotate-180 options.
+ (struct ps_driver_ext) Remove scale, translate_x, translate_y.
+ All references deleted.
+ (macro YT) New macro.
+ (array option_tab[]) Removed options.
+ (ps_option) Removed options.
+ (ps_open_page) Write page setup explicitly to output file, without
+ using now-deleted BP function.
+ (macro dump_line) Use YT().
+ (macro dump_thick_line) Use YT().
+ (draw_headers) Use YT().
+ (switch_font) Reorder arguments to SF function.
+ (write_text) Use YT().
+
+ * sfm-read.c: (sfm_read_case) Don't attempt to read variables that
+ have get.fv == -1.
+
+ * sysfile-info.c: (describe_variables) Don't use tab_nulls().
+
+ * tab.c: (tab_create) Initialize t->ct to zeros. Remove
+ null-debugging code.
+ (tab_realloc) Remove null-debugging code. Initialize new regions
+ of t->ct to zeros.
+ (tab_vline) Support offsets.
+ (tab_hline) Support offsets.
+ (tab_box) Support offsets.
+ (tab_null) Removed.
+ (tab_nulls) Removed.
+ (tab_row) Removed.
+ (tab_col) Removed.
+ (evaluate_dimensions) Remove null-debugging code. Understand
+ TAB_EMPTY attribute. Assert that text.s.s is always non-NULL if
+ TAB_EMPTY not present.
+
+ * tab.h: New cell attribute TAB_EMPTY.
+ (macros tab_nr, tab_nc, tab_row, tab_col) New.
+
+ * vars-atr.c: (init_variable) Set get.fv to -1 so that GET doesn't
+ try to read them from system files.
+
+ * vfm.c: (dump_splits) Don't call tab_null().
+
+Sat May 16 19:36:55 1998 Ben Pfaff <blp@gnu.org>
+
+ * crosstabs.q: (struct crosstab) Added `missing' member.
+ (custom_tables) Init missing.
+ (calc_general) Handle missing values.
+ (calc_chisq) New function.
+ (output_pivot_table) Start work on chi-square output. Update for
+ new tab offset support functions. Shorten statistic names.
+
+ * Several files: add in more `const's to placate gcc's warnings.
+
+ * tab.h: (struct tab_table) Add col_ofs, row_ofs members. Comment
+ fixes.
+
+ * tab.c: (tab_height, tab_realloc, tab_vline, tab_hline, tab_box,
+ tab_null, tab_nulls, tab_value, tab_float, tab_text,
+ tab_joint_text) Add col_ofs and row_ofs support.
+ (tab_offset) New function.
+ (tab_next_row) New function.
+ (tab_row) New function.
+ (tab_col) New function.
+ (tabi_table) Add col_ofs and row_ofs support.
+
+ * vars-atr.c: (is_system_missing) New function.
+
+Tue May 12 16:14:30 1998 Ben Pfaff <blp@gnu.org>
+
+ * crosstabs.q: Expanded subcommand names RESID --> RESIDUAL, etc.
+ (static var no_cells) Removed.
+ (static var num_cells) New.
+ (static var expected) New.
+ (static var cells[]) New.
+ (internal_cmd_crosstabs) Deal with new variables.
+ (postcalc) Removed most of the meat and put it in new function
+ output_pivot_table().
+ (output_pivot_table) Calculates and outputs an entire pivot table.
+
+ * postscript.c: (postopen) Fix problems with free()ing addresses
+ not obtained from malloc().
+
+ * som.c: (som_submit) Add assertion.
+
+ * sysfile-info.c: (describe_variable) Use new tab_nulls()
+ function.
+
+ * tab.c: (static var tab_names[]) New.
+ (tab_realloc) -1 for nc or nr indicates no change.
+ (tab_nulls) New function.
+ (tab_dim) Use tab_names[].
+ (tabi_cumulate) Don't include bottom or right headers. Furrfu.
+ (evaluate_dimensions) Don't terminate on uninited cells, just put
+ an X in them and emit a notice. Use tab_names[].
+
+ * tab.h: Move bits into tab.def.
+
+ * tab.def: New. Don't try to declare tab_table_class because then
+ som.h has to be included.
+
+Thu May 7 22:55:04 1998 Ben Pfaff <blp@gnu.org>
+
+ * command.def: New file, contains all the command definitions
+ previously included bodily in command.c.
+
+ * format.def: New file, contains all of the format definitions
+ previously split across format.h, format.c, and sfm-write.c.
+
+ * lexer.h: Renamed from tokens.h in order to match corresponding
+ .c file name.
+
+ * lexerP.h: Moved some rarely used functions exported by lexer.c
+ into here.
+
+ * Makefile.am: Commemorate renamed files.
+ (EXTRA_DIST) Add command.def, format.def.
+
+ * command.c: [0] (walk_cmdtable_func) Removed.
+
+ * crosstabs.q: (postcalc) Made it work and print out matrices
+ proving it.
+ (enum_column_values) Renamed enum_var_values, generalized for any
+ variable.
+
+ * format.h: (struct fmt_desc) New member `spss'.
+
+ * q2c.c: (main) Generated code includes lexer.h instead of
+ tokens.h.
+
+ * sfm-write.c: (write_format_spec) Use new spss member of fmt_spec
+ instead of an independent translation table.
+
+Tue May 5 13:19:03 1998 Ben Pfaff <blp@gnu.org>
+
+ * Lots of source files: Added const to declarations.
+
+ * aggregate.c: (parse_aggregate_function) Rename inner i to j.
+
+ * arena.c: (arena_clear) Set prev pointer to null when done.
+
+ * ascii.c: (ascii_option) Rename index as indx.
+
+ * avl.c: This is now a separate library called libavl.
+ (xmalloc) Make static.
+ (avl_probe) Step A7 can use the cache instead of an explicit
+ compare.
+ (avl_delete) Don't maintain a q pointer because it's always
+ available in the pointer stack. Comment fix.
+
+ * avl.h: This is now a separate library called libavl.
+
+ * command.c: (cmd_table[]) Remove spurious trailing "".
+
+ * common.h: Only include random() fix if this system needs it.
+
+ * crosstabs.q: Include alloca headers.
+ (n_sorted_tab) New global var.
+ (postcalc) Mostly rewritten.
+ (find_pivot_extent) Rewritten.
+ (enum_column_values) Rewritten.
+
+ * data-out.c: (convert_F) Rename inner n as n_spaces.
+
+ * error.c: (dump_message) Don't have an outer var i.
+
+ * file-handle.q: (static var f) Removed. All references removed.
+ (internal_cmd_file_handle) Uses a local variable instead of f.
+
+ * get.c: (trim_dictionary) Change scope of i, i1, i2.
+ (cmd_match_files) Don't strcpy tokstr into sbc (why was this ever
+ done?)
+
+ * getline.h: Declare getl_history as extern. Reported by
+ palme@uni-wuppertal.de (Hubert Palme).
+
+ * postscript.c: (postopen) Some large mods for constness.
+
+ * recode.c: Remove spurious copyrights since PSPP is owned by FSF
+ anyway.
+
+Fri Apr 24 12:52:47 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Rename BUILT_SOURCES to q_sources, all references
+ changed. Add avl.c, avl.h to pspp_SOURCES. Remove avllib from
+ LDADD.
+
+ * avl.c, avl.h: New files. These form a clean-room
+ reimplementation of avllib. Iterative algorithms are used in
+ place of recursive ones, so there is no resemblance in the code.
+
+ * Lots of headers: Don't include other headers by default.
+
+ * Lots of source files: Explicitly include all needed headers.
+
+ * arena.c: (arena_clear) New function.
+
+ * crosstabs.q: (ROW_VAR, COL_VAR) New enums.
+ (static var ar) Removed.
+ (staitc vars ar_tc, ar_col) New.
+ (cmd_crosstabs) Destroy the arenas.
+ (internal_cmd_crosstabs) Create the arenas.
+ (precalc) Don't need a free function for the hash.
+ (calc_general) Make sure to zero out the trailer on the key data
+ before inserting.
+ (print_table_entries) Updated.
+ (postcalc) Worked on actually implementing.
+ (find_pivot_extent) New function.
+ (compare_value) New function.
+ (enum_column_values) New function.
+
+ * data-in.c: (parse_month) Make local array `static const'.
+
+ * data-out.c: (convert_date) Make local array `static const'.
+ (convert_WKDAY) Same.
+ (convert_MONTH) Same.
+
+ * frequencies.q: (postprocess_freq_tab) avl_walk_inorder() has
+ been renamed to avl_walk().
+
+ * hash.c: Rewritten more efficiently.
+
+ * hash.h: Add attribute const to hsh_next_prime declaration.
+
+ * lexer.c: (id_match) Make arguments const.
+
+ * postscript.c: (ps_postopen_driver) Make default fonts the
+ Helvetica family.
+
+ * q2c.c: (main) Generated code needs stdlib.h.
+
+ * sfm-write.c: (write_value_labels) An avl_traverser needs to be
+ initialized to 0 now, not to NULL. All other references to
+ avl_traverser were updated in the same way.
+
+ * tokens.h: Macro version of id_match updated to use const
+ properly.
+
+ * val-labs.c: (inc_ref_count) New function.
+ (copy_value_labels) Simply through use of new avl_copy() function.
+
+Wed Apr 15 13:01:58 1998 Ben Pfaff <blp@gnu.org>
+
+ * crosstabs.q: Probably doesn't compile. New PIVOT subcommand.
+ (postcalc) Worked on this.
+
+ * postscript.c: (OPO_DOUBLE_LINE) New enum.
+ (struct ps_driver_ext) New line_width_thick member.
+ (ps_preopen_drive) Init line_width_thick.
+ (option_tab[]) Add line-* options.
+ (ps_option) Parse line-* options.
+ (postopen) Add line_width_thick support. Strip leading spaces on
+ prologue output lines.
+ (ps_open_page) Include line_width_thick in output.
+ (macro dump_thick_line) New.
+ (dump_fancy_line) Support thick lines as well as double lines.
+
+Tue Apr 14 00:50:08 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Add crosstabs.c to BUILT_SOURCES. Add crosstabs.q
+ to pspp_SOURCES. Add crosstabs.q to EXTRA_DIST.
+
+ * Many source files: Rename `options' to `pv_opts' as appropriate.
+
+ * command.c: (static var cmd_table[]) Add CROSSTABS command.
+
+ * common.c: (xcalloc) New function.
+
+ * crosstabs.q: New file. Not finished yet, though.
+
+ * data-list.c: Comment fix.
+
+ * error.c: Remove some old Checker cruft.
+
+ * frequencies.q: (dump_full) Cumulate valid percent instead of
+ regular percent.
+
+ * getline.c: Comment fix.
+
+ * hash.c: Comment fixes.
+
+ * hash.h: (struct hsh_table) Make hash functions return unsigned
+ instead of int to avoid problems with taking the modulo of
+ negative return values. All references changed.
+
+ * misc.c: (intlog10) Make its table static const instead of auto.
+
+ * sfm-read.c: (read_header) Make `prefix' static const instead of
+ auto.
+
+ * var.h: (union value) Add member `hash'.
+ (struct variable) Rename prv_index as `foo'--all references
+ changed. Reorder.
+ (typedef pv_opts) Removed. All references changed.
+
+ * vars-prs.c: (parse_variables) Message fixes.
+
+Mon Mar 9 15:35:08 1998 Ben Pfaff <blp@gnu.org>
+
+ * get.c: (cmd_match_files) Don't reverse the order of FILEs as
+ they are being inserted. Don't check for BY variables of
+ different types. Discard variables if the active file isn't
+ included in the merge.
+ (mtf_processing) Essentially rewritten.
+ (mtf_merge_dictionary) Check for master/slave variables of
+ different types/widths.
+
+ * vfm.c: (static var not_canceled) New var.
+ (process_active_file) Don't call vfm_source->read() if
+ there's no vfm-source. Initialize not_canceled.
+ (process_active_file_write_case) Honor and update not_canceled.
+ (prepare_for_writing) Rollback changes from yesterday, they were
+ wrong.
+ (close_active_file) Don't destroy vfm_source unless it exists.
+
+Mon Mar 9 00:56:16 1998 Ben Pfaff <blp@gnu.org>
+
+ * Lots of source files: Added { } around nested if/else constructs
+ to avoid new gcc 2.8 warnings.
+
+ * data-in.c: (parse_Z) Declare `int' type explicitly.
+ (convert_Z) Ditto.
+
+ * get.c: (struct mtf_file) Add prev, next_min, by, input members.
+ (cmd_match_files) Initialize mtf_by_values. Manage by, input,
+ prev members. Put TABLEs at the end of the chain and FILEs at the
+ beginning. Don't allow the active file in STATE_INIT. Use proper
+ `seen' value for the active file. Fill out the by members and
+ make sure they're of consistent type. Do the actual merge
+ operation.
+ (mtf_processing_finish) New function.
+ (var_type_description) New function.
+ (mtf_free_file) New function.
+ (mtf_free) Rewritten.
+ (mtf_delete_file_in_place) New function.
+ (mtf_read_nonactive_records) New function.
+ (mtf_compare_BY_values) New function.
+ (static var mtf_seq_no) New var.
+ (mtf_processing) New function.
+ (mtf_merge_dictionary) Assign nval members for the system file
+ dictionary. Assign fv values for its variables. Point each slave
+ variable to the corresponding master variable.
+
+ * hash.c: Include str.h.
+
+ * mis-val.c: (copy_missing_values) src arg is const.
+
+ * misc.c: (spacing) Make `max' var explicitly int.
+
+ * sfm-read.c: (dump_dictionary) Message reformatting.
+ (sfm_read_case) Add assertion.
+
+ * sort.c: Esthetic fixes.
+
+ * var.h: (struct match_files_proc) New struct.
+ (struct variable) Add private data match_files_proc.
+
+ * vars-atr.c: (delete_variable) Implement. Add argument for the
+ dictionary that owning the variable.
+ (dup_variable) Add assertion.
+
+ * vfm.c: Comment fixes, hopefully the comments are correct now.
+ (process_active_file) New function.
+ (process_active_file_write_case) New function.
+ (process_active_file_output_case) New function.
+ (prepare_for_writing) Use temp_dict->nval for vfm_info, not
+ default_dict.nval.
+ (write_case) Renamed procedure_write_case(). Now write_case is a
+ pointer to a function. Style fixes.
+
+1998-03-05 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (q2c) Link with libmisc.
+ (version.c) Define default_config_path, include_path,
+ groff_font_path.
+
+ * ascii.c: (ascii_postopen_driver) When the default newline string
+ is requested, open file in text mode. Suggested by
+ palme@uni-wuppertal.de (Hubert Palme).
+ (static vars line_buf, line_p) Change from char * to unsigned char
+ *.
+ (ascii_close_page) char * to unsigned char *.
+
+ * cmdline.c: (parse_command_line) Implement -r option by
+ prepending ~/.pspp/rc to the list of files to process.
+
+ * command.c: (cmd_remark) Reset getl_prompt to the standard prompt
+ before pulling in a final line.
+ (null_func, null_int_func) Removed (dead code).
+
+ * descript.q: (display) Calculate width of variable name column
+ properly. Calculate number of valid cases properly. Reported by
+ palme@uni-wuppertal.de (Hubert Palme).
+
+ * filename.c: (init_filename) Use default_config_path instead of
+ now obsolete CONFIG_PATH.
+
+ * getline.c: (getl_initialize) Use include_path instead of now
+ obsolete INCLUDE_PATH.
+ (getl_add_file) New argument `where'. All references changed.
+
+ * groff.c: (find_font_file) Use groff_font_path instead of now
+ obsolete GROFF_FONT_PATH.
+
+ * postscript.c: (find_ps_file) Use groff_font_path instead of now
+ obsolete GROFF_FONT_PATH. Copy through temporary variable to
+ avoid problems with constness.
+
+ * str.h: (macro cs_streq) New macro.
+
+ * version.h: (glob var default_config_path, include_path,
+ groff_font_path) New vars.
+
+1998-02-23 Ben Pfaff <blp@gnu.org>
+
+ * Many source files: Change verbose_msg() priority levels and
+ messages.
+
+ * aggregate.c: Include debug-print.h.
+
+ * cmdline.c: (parse_command_line) Add --safer/-s and --command/-c
+ options.
+ (static var pre_syntax_message) Document --safer/-s and
+ --command/-c.
+
+ * command.c: (cmd_erase, cmd_host) Disable if set_safer is set.
+
+ * dfm.c: (open_inline_file) [__CHECKER__] Zero out ext->file,
+ because it's not used but it's still copied.
+ (open_file_r) Remove gratuitous debug message.
+
+ * filename.c: (safety_violation) New function.
+ (open_file) Remove gratuitous debug messages. Don't allow pipe
+ files if set_safer is set.
+
+ * get.c: Turn off debugging.
+
+ * getline.c: (getl_add_virtual_file) New function.
+ (getl_read_line) Add verbose_msg() call for opening new syntax
+ file.
+ (getl_perform_delayed_reset) Add a return value describing whether
+ any action was taken. Call reset_eof().
+
+ * getline.h: Comment fix.
+
+ * groff-font.c: (groff_read_font) Use `goto next_iteration' in
+ place of incorrect `continue'. Use strtok_r() instead of
+ strtok(). Always check strtok_r() return value.
+ (groff_read_DESC) Use strtok_r() instead of strtok().
+
+ * lexer.c: (reset_eof) New function.
+
+ * main.c: (parse) Get a token after performing a delayed reset
+ action; allow empty syntax files.
+
+ * postscript.c: (output_encodings) Use strtok_r() instead of
+ strtok().
+
+ * q2c.c: (dump_parser) Use strtok_r() instead of strtok().
+
+ * set.q: Comment fixes.
+ (glob var set_safer) New var.
+ (internal_cmd_set) Support SAFER.
+
+ * str.h: [!HAVE_STRTOK_R] Declare strtok_r() prototype.
+
+ * temporary.c: (free_dictionary) Set d->splits to NULL after
+ freeing.
+
+ * vars-atr.c: (clear_variable) Decrement dict->n_splits if
+ variable deleted, not if it *isn't* deleted.
+
+1998-02-16 Ben Pfaff <blp@gnu.org>
+
+ * command.c: (array cmd_table[]) Add MATCH FILES.
+
+ * common.c: Comment fixes.
+
+ * data-list.c, dfm.c, error.c, filename.c, list.q, matrix-data.c,
+ modify-vars.c, postscript.c, sfm-read.c, sfm-write.c, tab.c:
+ Include alloca.h. Problem reported by palme@uni-wuppertal.de
+ (Hubert Palme).
+
+ * expr-opt.c: Include str.h. Problem reported by
+ palme@uni-wuppertal.de (Hubert Palme).
+
+ * get.c: (cmd_get) [DEBUGGING] Update v->p.get to v->get.
+ (static var mtf_by) Change from char ** to variable **.
+ (static var mtf_master) New var.
+ (mtf_merge_dictionary) New function.
+ (cmd_match_files) Init mtf_master. Parse mtf_by according to new
+ var type. Reorder tests properly. Initialize file->dict. Detect
+ TABLE= without BY=. Read file dictionaries and merge them. Give
+ subcommand name with IN, LAST, FIRST error messages. Create IN,
+ LAST, FIRST variables. Comment fixes.
+ (mtf_free) Don't free default_dict. Free mtf_master.
+
+ * getline.c: Define getl_mode. Change getl_buf_size to size_t
+ from int.
+ (handle_line_buffer) Cast int to size_t in comparison to avoid
+ warning.
+
+ * getline.h: Declare getl_mode extern.
+
+ * groff-font.c: (groff_read_font) Type-fix calls to getline.
+ (groff_read_DESC) Make line_size a size_t.
+ (match_tok) Parenthesize name to avoid macro expansion.
+
+ * mis-val.c: (copy_missing_values) New function.
+
+ * postscript.c: (postopen) Make buf_size a size_t.
+
+ * sfm-read.c: (dump_dictionary) Make global from static. Print
+ variable info in parts for easier debugging with Checker.
+
+ * temporary.c: (copy_variable) Use copy_value_labels().
+ (new_dictionary) New arg: whether to copy file label, documents.
+
+ * val-labs.c: (copy_value_labels) New function.
+
+ * var.h: (enums MISSING_*) Add MISSING_COUNT.
+
+ * vars-atr.c: [GLOBAL_DEBUGGING] (force_dup_variable) New
+ function.
+ (dup_variable) Set prv_index, get.fv, get.nv.
+
+Fri Feb 13 15:38:36 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (pspp_SOURCE) Add htmlP.h.
+
+ * Many source files: For ANSI-compliance, add empty statement
+ after label. Reported by palme@uni-wuppertal.de (Hubert Palme)
+ and Micah Altman <maltman@www-vdc.fas.harvard.edu>.
+
+ * data-in.c: (parse_numeric) Some header files break on
+ -DBL_MIN_10_EXP because they get a --; add () for safety.
+ Reported by palme@uni-wuppertal.de (Hubert Palme).
+
+ * dfm.c: Idea by Dr Eberhard W Lisse <el@linux.lisse.na>.
+ (struct dfm_fhuser_ext) Change `file' from FILE * to file_ext.
+ (dfm_close) Use close_file_ext.
+ (open_inline_file) Set file.file to NULL, not file.
+ (open_file_r, open_file_w) Initialize file.file; fill in file_ext
+ struct and use open_file_ext().
+ (read_record) Use file.file.
+
+ * file-handle.q: (prepend_current_directory) Pass through special
+ filenames.
+
+ * filename.c: Only include unistd.h if HAVE_UNISTD_H.
+ (normalize_filename) Pass through special filenames.
+ (open_file, close_file) Accept pipe| and |pipe syntaxes as
+ equivalent.
+ (dirname) Rename blp_dirname() because of name conflict on some
+ OS. All references changed. Reported by palme@uni-wuppertal.de
+ (Hubert Palme).
+ (is_special_filename) New function.
+
+ * get.c: (GTSV_OPT*) Add GTSV_OPT_MATCH_FILES.
+ (trim_dictionary) Conditionalize some of the options on whether
+ GTSV_OPT_MATCH_FILES is in *options.
+ (rename_variables) Don't allow variables to be renamed as scratch
+ variables.
+ (MTF_*) New enum series.
+ (struct mtf_file) New struct.
+ (static vars mtf_head, mtf_tail, mtf_by, mtf_n_by, mtf_free) New
+ vars.
+ (cmd_match_files, mtf_free) New functions.
+
+ * lexer.c: (match_int) Needed parentheses around name to escape
+ macro expansion. Reported by Micah Altman
+ <maltman@www-vdc.fas.harvard.edu>.
+
+ * print.c: Needed to include alloca.h. Reported by Micah Altman
+ <maltman@www-vdc.fas.harvard.edu>.
+
+ * recode.c: (convert_to_double) Parenthesize -DBL_MIN_10_EXP to
+ -(DBL_MIN_10_EXP). Reported by palme@uni-wuppertal.de (Hubert
+ Palme).
+
+ * str.h: Include stdarg.h. Reported by palme@uni-wuppertal.de
+ (Hubert Palme) and Micah Altman <maltman@www-vdc.fas.harvard.edu>.
+
+Thu Feb 5 00:18:21 1998 Ben Pfaff <blp@gnu.org>
+
+ * html.c: (struct html_driver_ext) Move into htmlP.h.
+ (html_preopen_driver) Initialize cp_x, cp_y.
+ (html_submit) Implement as call to output_tab_table().
+ (change_attributes) New function.
+ (escape_string) New function.
+ (output_tab_table) New function.
+
+ * list.q: (write_all_headers) Add code for writing headers for the
+ html driver.
+ (clean_up) Write out the html close-table tag.
+ (determine_layout) Ignore html driver.
+ (list_cases) Write html data.
+
+ * som.c: (som_submit) Move more of the code into output_table().
+
+ * tab.c: (static var hit) Make a global var and rename tab_hit.
+ (static var tab_table_class) Make a global var.
+
+ * htmlP.h: New file.
+
+Tue Feb 3 16:12:18 1998 Ben Pfaff <blp@gnu.org>
+
+ * dump-sysfile.c: Removed.
+
+ * html.c: (preclose) Change comment in emitted code.
+
+ * matrix-data.c: Debugging off by default. Comment fixes.
+ (static var container) New var.
+ (cmd_matrix_data) Create and destroy container. Initialize
+ is_per_factor[] to 0s. Move code into new function
+ string_to_content_type(). Require split values to be present in
+ the data when ROWTYPE_ is explicit. Call specific function, not
+ general read_matrices().
+ (string_to_content_type) New function.
+ (context) Exclude all whitespace, not just spaces.
+ (mget_token) A dot is a number. Add assertion.
+ (static var data) Renamed nr_data.
+ (static var factor_values) Renamed nr_factor_values.
+ (read_matrices) Renamed read_matrices_without_rowtype(). Handle
+ only specific case. Close data_file before exit.
+ (fill_matrix) New function.
+ (read_data_lines) Renamed nr_read_data_lines(). Remove debug
+ printing. Style fixes. Message fixes. Move code into
+ fill_matrix().
+ (read_matrices_without_rowtype) Rename
+ matrix_data_read_without_rowtype(). Fix off-by-one error on
+ loops. Allocate nr_data[] memory from arena.
+ (read_matrices_with_rowtype) Removed.
+ (read_splits) Renamed nr_read_splits(). Style fixes.
+ (read_factors) Renamed nr_read_factors().
+ (dump_cell_content) Comment fixes. Arguments changed. Change
+ debug printing. All references changed.
+ (output_data) Renamed nr_output_data().
+ (static var wr_content) New var.
+ (struct factor_data) New struct.
+ (static var wr_data) New var.
+ (static var wr_current) New var.
+ (matrix_data_source_destroy_source) Removed.
+ (read_matrices_with_rowtype) New function.
+ (matrix_data_read_with_rowtype) New function.
+ (wr_read_splits) New function.
+ (compare_factors) New function.
+ (wr_output_data) New function.
+ (wr_read_rowtype) New function.
+ (wr_read_factors) New function.
+ (wr_read_indeps) New function.
+ (glob var matrix_data_source) Make destroy_source member NULL as
+ well.
+
+Fri Jan 23 00:09:08 1998 Ben Pfaff <blp@gnu.org>
+
+ * lexer.c: (syntax_error) Give better error message when at end of
+ file.
+
+ * matrix-data.c: (var content_names[]) Fix PROX spelling. Change
+ N_SCALAR to output as plain N.
+ (mdump_token) Change output format.
+ (context) Fix message output interaction with spaces in input.
+ (another_token) New function.
+ (force_eol) Improved error message.
+ (static var max_cell_index) New var.
+ (read_matrices) Init `cells'. factor_values is now per-cell.
+ Init max_cell_index.
+ (read_data_lines) Replace `compare' local with new `compare' arg.
+ Debugging messages changed. Only read factors if per_factor.
+ Propagate error return from read_factors(), force_eol().
+ Copy N_SCALAR values across the N vector.
+ (read_matrices_without_rowtype) Don't init `cells'. Don't need to
+ check parentheses manually since we now have is_per_factor[].
+ Call read_data_lines() with new args. Check for end of data after
+ looping, using another_token().
+ (read_factors) Arguments changed. Use max_cell_index to determine
+ whether to read or compare factors. Message fixes.
+ (dump_cell_content) New function.
+ (output_data) Completely rewritten because content types were
+ supported to be nested inside factor values, not vice versa.
+
+Thu Jan 22 00:26:38 1998 Ben Pfaff <blp@gnu.org>
+
+ * lexer.c: (syntax_error) Support formatted varargs messages.
+
+ * matrix-data.c: Turn debugging on by default.
+ (static content_type[]) New array.
+ (static content_names[]) New array.
+ (static rowtype_, varname_) New vars.
+ (static is_per_factor[]) New array.
+ (static split_values) Moved declaration.
+ (static n_continuous, first_continuous) New var.
+ (cmd_matrix_data) Don't init split_values. Assign ROWTYPE_ to
+ rowtype_. Simplify SPLIT code. Init is_per_factor[]. Assign
+ VARNAME_ to varname_. Initialize first_continuous, n_continuous.
+ Check for continuous variables.
+ [DEBUGGING] (debug_print) Remove content_names[].
+ (mdump_token) New macro.
+ (mget_token_dump) New function.
+ (mdump_token) New function.
+ (context) New function.
+ (mget_token) Fix messages.
+ (static var data, split_values, factor_values) New vars.
+ (read_matrices) Manage split_values, factor_values.
+ (read_data_lines) New function.
+ (read_matrices_without_rowtype) Implemented.
+ (read_splits) Message fixes. Uses `just_read'.
+ (read_factors) New function.
+ (output_data) New function.
+ (matrix_data_source_destroy_source) Close the file handle.
+ (glob var matrix_source) Change name from "DATA LIST" to "MATRIX
+ DATA".
+
+ * str.c: (strpadcmp) Removed.
+
+ * vfm.c: (dump_splits) Initialize i; fix test for end of splits.
+
+Sun Jan 18 00:30:59 1998 Ben Pfaff <blp@gnu.org>
+
+ * Lots of source files: Add cast to unsigned character to calls to
+ tolower() and toupper().
+
+ * aggregate.c: Set default_dict.splits to NULL.
+
+ * command.c: (static variable tab[]) Add MATRIX DATA.
+
+ * data-in.c: Add debugging defines. Formatting fixes.
+
+ * expr-opt.c: Formatting fixes.
+
+ * lexer.c: (syntax_error) Message fixes.
+
+ * matrix-data.c: New enum series.
+ (static vars fmt, section, diag, explicit_rowtype, signle_split,
+ split_values, n_factors, factors, cells, pop_n, contents,
+ n_contents) New vars.
+ (cmd_matrix_data) Finished implementation.
+ (compare_variables_by_mxd_vartype) New function.
+ [DEBUGGING] (debug_print) New function.
+ (static vars mtoken, mtokstr, mtoklen, mtokval) New vars.
+ (read_matrices) New function.
+ (read_matrices_without_rowtype) New function.
+ (read_matrices_with_rowtype) New function.
+ (read_splits) New function.
+ (mget_token) New function.
+ (force_eol) New function.
+ [0] (test_tokenizer) New function.
+ (matrix_data_source_destroy_source) New function.
+ (glob var matrix_data_source) New var.
+
+ * misc.h: Include ieeefp.h if present.
+
+ * split-file.h: (cmd_split_file) Changes corresponding to struct
+ dictionary changes.
+
+ * str.h: Fix memmem prototype.
+
+ * temporary.c: (save_dictionary, restore_dictionary,
+ free_dictionary) Changes corresponding to struct dictionary
+ changes.
+
+ * var.h: (MXD_* enums) New enum series.
+ (struct matrix_data_proc) New struct.
+ (struct split) Removed.
+ (struct dictionary) Changed `splits' member from `split *' to
+ `variable **'.
+ (macro force_create_variable) New macro. Replaced lots of
+ create_variable()/assert() calls with calls to this macro.
+
+ * vars-atr.c: (discard_variables) Changed assertion.
+ [GLOBAL_DEBUGGING] (force_create_variable) New function
+ called by the macro of the same name.
+ (clear_variable) Changes to delete splits from the dictionary
+ corresponding to struct dictionary changes.
+
+ * vars-prs.c: (parse_variables) [GLOBAL_DEBUGGING] Check for
+ corrupted variable `index' values in the dictionary passed in
+ every time this function is called.
+
+ * vfm.c: (dump_splits, SPLIT_FILE_procfunc) Changes corresponding
+ to struct dictionary changes.
+
+Tue Jan 13 23:45:02 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (pspp_SOURCES) Add matrix-data.c.
+
+ * command.c: New includes.
+ (static array cmd_table[]) Add ERASE, HOST, NEW FILE.
+ (cmd_erase) New function.
+ [unix] (shell) New function.
+ (run_command) New function.
+ (cmd_host) New function.
+ (cmd_new_file) New function.
+
+ * expr-prs.c: (parse_primary) Message fix.
+
+ * inpt-pgm.c: Formatting fix.
+ (cmd_reread) Implement the FILE subcommand.
+
+ * matrix-data.c: New file.
+
+ * q2c.c: (dump_header) Change output commenting style.
+
+ * weight.c: Comment fix.
+
+Tue Jan 13 00:53:39 1998 Ben Pfaff <blp@gnu.org>
+
+ * aggregate.c: (buf64_10x) Renamed buf64_1xx, all references
+ changed.
+ (buf_10x) Renamed buf_1xx, all references changed.
+ (cmd_aggregate) Implemented cases 010, 011, 110, and 111 (all
+ cases now implemented).
+ (create_sysfile) New function.
+ (agr_11x_func) New function.
+
+ * data-in.c: (parse_numeric) Work properly if there's an
+ explicitly coded decimal point in the data and decimal places are
+ specified on DATA LIST. Bug reported by Dr Eberhard W Lisse
+ <el@linux.lisse.na>.
+
+ * get.c: (cmd_get, cmd_save_internal) Allow extraneous slash
+ before file specification on GET, SAVE, XSAVE. Bug reported by Dr
+ Eberhard W Lisse <el@linux.lisse.na>.
+
+ * q2c.c: [!HAVE_STRERROR] Include misc/strerror.c, not
+ strerror.c. Bug reported by Alexandre Oliva
+ <oliva@dcc.unicamp.br>.
+
+ * sort.c: Include sort.h. Comment fixes. A few esthetic fixes.
+ (static var separate_case_tab) New var.
+ (cmd_sort_cases) Cancel temporary transformations here. Free
+ v_sort before return.
+ (sort_cases) Run an EXECUTE procedure if SEPARATE is nonzero and
+ we're reading from a sort stream. Don't cancel temporary
+ transformations. Offload internal sorting to do_internal_sort().
+ (do_internal_sort) New function. Handles internal sorting even
+ when SEPARATE is nonzero. Doesn't free v_sort.
+ (do_external_sort) Take new arg SEPARATE. Only destroy `x' if
+ it's non-NULL.
+ (write_initial_runs) Take new arg SEPARATE. Only destroy the old
+ sink if SEPARATE is zero.
+ (read_output_cases) Renamed read_sort_output(), all references
+ changed. Now uses separate_case_tab when it exists.
+ (write_separate) New function.
+
+ * vfm.c: (page_to_disk) Destroy memory_source_cases, not
+ memory_sink_cases. Don't redundantly call
+ vfm_source->destroy_source().
+ (memory_stream_mode) After switching over, set memory_sink_cases
+ to NULL.
+
+Sat Jan 10 23:35:51 1998 Ben Pfaff <blp@gnu.org>
+
+ * aggregate.c: (struct agr_var) Expand dbl[] array from 2 to 3
+ elements.
+ (static var prev_case) New, moved out of aggregate_single_case()
+ local scope.
+ (static var buf64_10x, buf_10x) New.
+ (cmd_aggregate) Initialize prev_case. Comment fixes. Implement
+ the 000, 001, 100, and 101 cases. Free prev_case.
+ (parse_aggregate_functions) Disallow scratch variables.
+ (free_aggregate_functions) Only free agr_dict if non-null. Use
+ iter->function to determine numeric/string type, not
+ iter->src->type.
+ (aggregate_single_case) Don't manage prev_case. Initialize
+ aggregate info after dumping it.
+ (accumulate_aggregate_info) Fix sum, weighted sum, mean, weighted
+ mean, stddev, weighted stddev definitions.
+ (dump_aggregate_info) Implemented.
+ (initialize_aggregate_info) Renamed from
+ initialize_aggregate_functions(). Initializes dbl[2].
+ (agr_00x_trns_proc, agr_00x_end_func, write_case_to_sfm,
+ agr_10x_trns_proc, agr_10x_trns_free, agr_10x_end_func) New.
+
+ * cases.c: (alloc_val) Removed.
+
+ * get.c: (cmd_save_internal) Initialize new `dict' member.
+
+ * sfm-write.c: (sfm_write_dictionary, write_header,
+ write_variable, write_value_labels, write_documents) Reorganize,
+ simplify for new parameter structure.
+ (write_variable) Only one variable * argument now.
+
+ * sfm.h: (struct sfm_write_info) Removed `pri', `sec', and
+ replaced by new `dict' member.
+
+ * temporary.c: (new_dictionary) Initialize n_documents.
+
+ * vars-atr.c: (dup_variable) Allocate `value's from dict into
+ v->fv manually.
+ (init_variable, replace_variable) Eliminate usage of alloc_val().
+
+ * vars-prs.c: (parse_DATA_LIST_vars) Accept PV_NO_SCRATCH option.
+
+ * vfm.c: (arrange_compaction) Allow `temporary' value of 2 to
+ signal that AGGREGATE is to be used for forming final cases.
+ (close_active_file) Call end_func before stopping lagging. Cancel
+ temporary after finishing compaction.
+ (write_case) Comment fixes. Cleaned up.
+ (compact_case) Let AGGREGATE handle compaction when `temporary' is
+ 2.
+
+Sat Jan 10 02:10:47 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (BUILT_SOURCES) Add means.c.
+ (pspp_SOURCES) Add means.c.
+ (EXTRA_DIST) Add means.q.
+
+ * command.c: (array cmd_table[]) Add MEANS.
+
+ * common.h: Esthetic fixes. Comment fixes. Test for
+ MAX_SHORT_STRING greater than 8.
+ (macros LOWEST, HIGHEST) New.
+
+ * data-in.c, data-list.c, recode.c: Comment fixes.
+
+ * means.q: New file, base version.
+
+ * mis-val.c: (parse_num_or_range, parse_numeric) Replace -DBL_MAX
+ with LOWEST, DBL_MAX with HIGHEST.
+
+ * q2c.c: (dump_vars) Add an enum to array types giving the number
+ of values for the enum.
+
+ * sfm-read.c: (sfm_read_dictionary, read_machine_flt64_info)
+ Replace second_lowest_value with second_lowest_flt64.
+
+ * sfm-write.c: (write_variable, write_rec_7_34) Replace
+ second_lowest_value with second_lowest_flt64.
+
+ * t-test.q: Comment fix.
+
+ * temporary.c: (restore_dictionary) Esthetic fix.
+
+ * tokens.h: (force_match_id, force_match, force_string, force_int,
+ force_num, force_id) Replace msg() with syntax_error().
+
+ * var.h: (struct means_proc) New.
+ (struct variable) Add mns member to `p' union.
+
+ * vars-prs.c: (parse_variable, parse_dict_variable,
+ parse_variables, parse_DATA_LIST_vars) Replace msg() with
+ syntax_error().
+
+Thu Jan 8 22:28:41 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (pspp_SOURCES) Add tab.h.
+
+ * Most source files: Added a cast to unsigned char in usages of
+ the ctype is*() functions. Replaced `end of command expected'
+ calls to msg() with calls to syntax_error().
+
+ * frequencies.q: (dump_condensed) Fix tab_dim() column reference.
+
+ * lexer.c: (hex_val) Removed (was dead code).
+ (idmatch) Parenthesize function name to avoid macro expansion.
+
+ * postscript.c: Comment fixes.
+ (ps_preopen_driver) Change default font size to 10pt.
+
+ * sfm-read.c: (read_variables) Byteswap sv.print, sv.write as
+ int32s.
+ (parse_format_spec) Change system-file format spec argument type
+ to int32. Parse the format spec with bitwise operators.
+
+ * sfmP.h: (struct sysfile_format) Removed.
+ (struct sysfile_variable) Changed print, write members from
+ sysfile_format to int32.
+
+ * tokens.h: Esthetic fixes.
+ [__GNUC__] (macro id_match) New macro to hopefully speed up
+ identifier matching.
+ (macros match_id, match_tok, match_int) Implemented in
+ compiler-independent manner; no longer GNU C only.
+
+ * vfm.h: Include time.h.
+
+Mon Jan 5 11:06:15 1998 Ben Pfaff <blp@gnu.org>
+
+ * data-list.c: (dump_fixed_table) Change tab_dim().
+
+ * dump-sysfile.c: (open_sysfile) Fix mmap() call.
+
+ * error.c: Include command.h.
+
+ * frequencies.g: Formatting fixes.
+
+ * frequencies.q: Add tab_dim() calls. Make the total cell a
+ joined cell.
+
+ * glob.c: Include command.h.
+
+ * sfm-read.c: (struct sfm_fhuser_ext) New members sysmis, highest,
+ lowest.
+ (sfm_read_dictionary) Initialize sysmis, highest, lowest.
+ (sfm_read_machine_flt64_info) Update sysmis, highest, lowest.
+ (read_variables) Byteswap sv.type; byteswap sv.print, sv.write as
+ the other elements (is this right?).
+ (read_variables) Use lowest, highest members.
+ (parse_format_spec) New arg `vv' for more stringent checking.
+ (dump_dictionary) Byteswaps nonexplicit data.
+ (sfm_read_case) Byteswap numeric data.
+
+ * som.c: Initialize table_num to 1.
+ (render_segments) Remember to increment y_index after each table
+ segment.
+
+ * sysfile-info.c: (cmd_sysfile_info) Change tab_dim(). Don't call
+ avl_count() on a NULL tree. No title for the second table.
+ (cmd_display) Handle DISPLAY VECTORS by calling display_vectors().
+ Handle AS_SCRATCH as AS_NAMES. Warn if no variables. Re-enable;
+ fix call to display_variables().
+ (display_variables) Default to 4 columns, not 3. Set up headers.
+ Column title is Variable, not Name. Fix index column.
+ Add joint text. Add tab_dim(). Handle value labels properly.
+ Handle DISPLAY LABELS properly. Draw boxes correctly.
+ (describe_variable) Value labels don't need titles. Don't clear
+ nonexistent index column.
+ (compare_vectors_by_name) New function.
+ (display_vectors) New function.
+
+ * tab.c: (tab_height) Add assertion.
+ (tab_null) Add debug code.
+ (evaluate_dimensions) Add debug code.
+
+ * var.h: (struct variable) get_proc data is sometimes used
+ simultaneously with other per-procedure info, therefore it was
+ removed from the union. All references changed.
+
+Sun Jan 4 18:13:33 1998 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: (ascii_close_page) Put title on second line of headers
+ if there is no subtitle.
+
+ * command.c: (glob var cur_proc) Move definition here, from
+ common.c.
+ (cmd_remark) Emit blank line before remarks.
+
+ * command.h: (glob var cur_proc) Move declaration here, from
+ common.h.
+
+ * data-list.c: (dump_fixed_table) Fix messages.
+ (dump_free_table) Call tab_nat_dim().
+
+ * descript.q: (dump_z_table) Modify tab_dim() call.
+
+ * frequencies.q: (dump_condensed, dump_statistics) Add tab_dim()
+ call.
+ (dump_statistics) Don't output header.
+
+ * groff-font.c: Minor format fix.
+
+ * html.c: Comment fix.
+
+ * list.q: (write_varname) Indent after advancing page.
+
+ * output.h: Minor reordering.
+
+ * postscript.c: Comment fixes. Many places, '\n' was replaced by
+ a reference to eol[].
+ (struct ps_driver_ext) New member eol[].
+ (ps_preopen_driver) Initialize eol[].
+ (ps_postopen_driver) Fix sense of text for text_opt, line_opt
+ defaults. Handle headers. Fix test for minimum page length.
+ (static var option_tab[]) Add `line-ends'.
+ (ps_option) Handle line-ends to change eol[].
+ (postopen) Scale prop_em_width and fixed_width properly. Set the
+ prologue title to outp_title if applicable. Replace the prologue
+ line ends with eol[]. Call draw_headers() if headers are enabled.
+ (text_width) New function.
+ (out_text_plain) New function.
+ (draw_headers) New function.
+
+ * print.c: (dump_table) Call tab_nat_dim().
+
+ * som.c: (som_blank_line) Only advance a line if not at the top of
+ a page.
+ (som_submit) Move several informational table calls here.
+ Increment subtable_num if SOMF_NO_TITLE not set.
+ (output_table) Advance a line if SOMF_NO_SPACING not set.
+ (render_columns, render_segments, render_simple) Handle spacing
+ between tables. Handle table titles. Remove debug output.
+
+ * som.h: (SOMF_*) New enum series.
+ (struct som_table_class) New member `flags'.
+
+ * sysfile-info.c: (cmd_sysfile_info) Calls tab_nat_dim(). No
+ headers or spacing.
+ (display_variables) Calls tab_nat_dim().
+ (describe_variable) Remove restriction on number of value labels.
+ Make value labels separated by thin lines.
+
+ * tab.c: (tab_create) Default `flags' to none.
+ (tab_float) New arg `w'. All references changed.
+ (tab_nat_dim) New function.
+ (tab_output_text) No title or spacing.
+ (tab_flags) New function.
+ (tabi_flags) New function.
+ (tabi_title) New function.
+ (strip_height) Removed.
+ (tabi_render) Skip title when necessary.
+ (static var tab_tab_class) Add tabi_flags, tabi_title.
+ (evaluate_dimensions) Disable display of column, row size.
+ (sum_columns) Add title height to top header.
+ (render_strip) Moved within file.
+
+ * tab.h: (struct tab_table) New member `flags'.
+
+ * vfm.c: (dump_splits) Calls tab_nat_dim(). No title.
+
+Sat Jan 3 16:55:44 1998 Ben Pfaff <blp@gnu.org>
+
+ * Most source files: Add `const' attribute in all appropriate
+ places.
+
+ * sysfile-info.c: (cmd_sysfile_info) Add tab_dim() call, add a
+ column to the variables table for use by describe_variable().
+ (cmd_display) Disable for the present.
+ (display_documents) Don't wrap documents.
+ (display_variables) Table has four columns now.
+ (describe_variable) Table has four columns now. Don't use a
+ subtable, use joined cells instead.
+
+ * tab.c: (tab_create) Don't set `join'.
+ (tab_realloc) ct array is not made up of a_string's.
+ Reallocate trh, hrh, h arrays, initialize trh array. Initialize
+ cell contents on GLOBAL_DEBUGGING, not DEBUGGING.
+ (text_format) New function.
+ (tab_title) Rewritten, uses text_format().
+ (tab_text) Rewritten, uses text_format().
+ (tab_joint_text) New function.
+ (tab_join) Removed.
+ (static var hit) New variable.
+ (render_strip) New args r1, r2. Implement joined cells that fit
+ on a single page.
+ (tabi_render) Increment hit. Pass new args to render_strip().
+ (evaluate_dimensions) [GLOBAL_DEBUGGING] Check for uninitialized
+ cells. For t_naw and t_nah, ignore joined cells and null cells in
+ calculations.
+
+ * tab.h: (struct tab_join_rect) Removed.
+ (struct tab_table) Removed `join'.
+ (TAB_JOIN_MAIN) Removed.
+ (struct tab_joined_cell) New struct.
+ (TAT_NOWRAP) New enum.
+
+Fri Jan 2 01:39:58 1998 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: (ascii_postopen) Replace ASCII_* macros with their
+ expansions.
+ (ascii_postopen_driver) Fix initialization of *_spacing so that
+ the TAL_0 bit doesn't count.
+
+ * data-list.c: (dump_fixed_table) Use natural width for Format
+ column.
+
+ * glob.c: (rerange) Removed.
+ (get_date) Formatting fixes. Internationalization fix.
+
+ * html.c: (html_postopen_driver) Replace HTML_DEFAULT_OUTPUT_FILE
+ with "pspp.html".
+
+ * postscript.c: (ps_postopen_driver) Replace
+ PS_DEFAULT_OUTPUT_FILE with "pspp.ps".
+
+ * som.c: (som_submit) Don't eject page before every table.
+ (output_table) Fix order of arguments on call to area().
+ (render_columns) Fix calculation of max_len.
+
+ * tab.c: (tabi_cumulate) Minor change to increase elegance.
+ (render_strip) New function.
+ (strip_height) New function.
+ (tabi_render) Rewrite as calls to render_strip().
+
+ * tab.h: (TAT_* enums) Removed TAT_RICH, all references removed.
+ Renumbered TAT_PRINTF, TAT_TITLE, TAT_FIX to correspond better
+ with the TAB_* and OUTP_T_* constants.
+
+Thu Jan 1 11:53:52 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Formatting fixes.
+
+ * ascii.c: (ascii_postopen_driver) Initialize *_line_spacing[],
+ *_line_width[].
+
+ * data-list.c: (dump_fixed_table) Add tab_dim() call.
+
+ * descript.q: (dump_z_table, display) Add tab_dim() calls.
+
+ * dump-sysfile.c: (glob var length) Make type off_t.
+ (usage) Fix arguments.
+ (main) Return 0.
+
+ * output.h: (OUTP_T_*) Change constants' value to match tab.h.
+ Now right-justification is the default so many references had to
+ change.
+ (struct outp_class) Removed line_width, all references changed.
+ (OUTP_DEV_*) Add OUTP_DEV_DISABLED.
+ (struct outp_driver) Add elements horiz_line_width,
+ vert_line_width, horiz_line_spacing, vert_line_spacing. Remove
+ som element.
+
+ * postscript.c: (outp_encodings) Formatting fixes. Fix garbage
+ collection.
+ (postopen) Initialize all the informational members of
+ outp_driver.
+
+ * som.c: (som_blank_line) New function, renamed from blank_line(),
+ all references changed.
+ (som_submit) Disables drivers whose pages can't be opened.
+ (render_columns, render_simple, render_segments) Add debug output.
+ (render_columns) Fix loop range.
+ (render_simple) Don't try to render the headers, they're taken
+ care of automatically. Advance cp_y past the table when done.
+ (render_segments) Fix loop ranges.
+
+ * tab.c: Initialize new members of tab_table.
+ (tab_vline) Handle trv[]; don't set style for spacing-only lines.
+ (tab_hline) Handle trh[]; don't set style for spacing-only lines.
+ (tab_box) Handle trh[], trv[]; don't set style for spacing-only
+ lines.
+ (set_expr) Removed.
+ (tab_dim) New function.
+ (tab_col_width) Removed.
+ (tab_row_height) Removed.
+ (tab_output_text) Call tab_dim().
+ (tabi_driver) Call evaluate_dimensions(), sum_columns().
+ (tabi_area) Implemented.
+ (tabi_cumulate) Implemented.
+ (tabi_render) Partially implemented, but broken.
+ (var tab_table_class) Made static.
+ (evaluate_dimensions) New function.
+ (sum_columns) New function.
+
+ * tab.h: (enum t_*) Now start at t_end. New: t_ptw, t_nr, t_nc,
+ t_nah, t_naw, t_neg, t_xch, t_dup, t_lbl, t_jnz, t_sac, t_sar,
+ t_scr, t_srr, t_sentinel. Removed: t_nat.
+ (struct tab_table) New: wl, wr, ht, hb, trh, hrh, trv, wrv, dim,
+ max_stack_height, w, h. Removed: ce, re.
+ (macro blank_line) Removed.
+ (glob var zero_length) Removed.
+
+Fri Dec 26 15:44:31 1997 Ben Pfaff <blp@gnu.org>
+
+ * Most source files: include some of the new include files broken
+ out of var.h.
+
+ * Makefile.am: (pspp_SOURCES) Add all the new source files to the
+ list.
+
+ * aggregate.c: (glob var outfile) Make static.
+
+ * command.c: (glob var pgm_state) Move here.
+
+ * common.c: (glob vars endian, second_lowest_value, pgmname,
+ finished, curdate, cur_proc, start_interactive, history_file) Move
+ here.
+
+ * descript.q: (structs dsc_z_score, descriptives_trns) Move here.
+
+ * file-handle.q: (glob vars files, inline_file) Move here.
+
+ * glob.c: Lost lots of glob vars, detailed in individual file
+ entries.
+ (init_glob) set_printer, set_screen were obsolete, deleted.
+ set_cprompt has fewer spaces because pspp has fewer letters than
+ fiasco.
+
+ * inpt-pgm.c: (glob vars inp_init, inp_init_size) Move here.
+ (inp_nval) Made static.
+
+ * lexer.c: (glob vars token, tokval, tokstr, tokstr_size,
+ tokstr_len, toklongstr, tokint) Move here.
+
+ * misc.c: Lost several vars and functions.
+
+ * set.q: (all the set_* variables) Move here.
+
+ * str.c: (strmaxcpy, strbarepadcpy, strbarepadlencpy, strpadcpy,
+ blpstrset, strpadcmp, memrev, memrmem, cmp_str) Move here from
+ misc.c.
+
+ * tab.c: (set_expr, tab_col_width, tab_row_height) New functions.
+
+ * tab.h: (enum series t_*) New enums.
+ (struct tab_table) Use arena struct tag. New members ce, re.
+
+ * tokens.h: Comment fixes.
+
+ * var.h: Move lots of enums and variables and functions and
+ structures to other files. Use and declare a lot more union and
+ struct tags. Comment fixes.
+
+ * vector.c: (glob vars vec, nvec) Move here.
+
+ * vfm.c: (glob vars reinit_sysmis, reinit_blanks, init_zero,
+ init_blanks, last_vfm_invocation) Move here.
+
+ * cases.h: New file.
+ (struct long_vec) Move here.
+ (vec_init, vec_clear, vec_insert, vec_delete, devector, envector)
+ Move here.
+
+ * command.h: New file.
+ (STATE_* enums) Move here.
+ (glob var pgm_state) Move here.
+
+ * format.c: New file.
+ (glob var formats) Move here.
+ (parse_format_specifier_name, fmt_to_string,
+ check_input_specifier, check_output_specifier,
+ check_string_specifier, convert_fmt_ItoO, parse_format_specifier)
+ Move here.
+
+ * format.h: New file. Move functions now in format.c here.
+ (FMT_* enums) Move here.
+ (struct fmt_desc) Move here.
+ (FCAT_* enums) Move here.
+ (struct fmt_spec) Move here.
+ (glob vars formats, fmt_parse_ignore_error) Move here.
+
+ * inpt-pgm.h: New file.
+ (INP_* enums) Move here, make #defines into enums.
+ (glob vars inp_init, inp_init_size) Move here.
+
+ * sort.h: New file.
+ (glob vars v_sort, nv_sort) Move here.
+ (sort_cases, read_sort_output) Move here.
+
+ * vector.h: New file.
+ (struct vector) Move here, add struct tag.
+ (glob vars vec, nvec) Move here.
+ (find_vector) Move here.
+
+ * New file.
+ (glob vars last_vfm_invocation, temp_case, reinit_sysmis,
+ reinit_blanks, init_zero, init_blanks) Move here.
+ (struct case_stream) Move here.
+ (glob vars vfm_source, vfm_sink, vfm_memory_stream,
+ vfm_disk_stream, sort_stream, data_list_source,
+ input_program_source, file_type_source, get_source, n_lag) Move
+ here.
+ (procedure, write_case, lagged_case, compact_case, page_to_disk)
+ Move here.
+
+Wed Dec 24 22:40:42 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (pspp_SOURCES) Added html.c, som.c, som.h.
+ (LDADD) Add libdcdflib.
+
+ * ascii.c: Comment and formatting fixes. Almost every external
+ function had an assert added, checking driver_open and page_open.
+ (ascii_init_driver) Broken into ascii_preopen_driver,
+ ascii_postopen_driver, ascii_close_driver. Manages driver_open.
+ (ascii_open_page) Sets page_open.
+ (ascii_close_page) Clears page_open.
+
+ * html.c: Comment and formatting fixes. Almost every external
+ function had an assert added, checking driver_open and page_open.
+ (html_init_driver) Broken into html_preopen_driver,
+ html_postopen_driver, html_close_driver. Manages driver_open.
+ (html_open_page) Sets page_open.
+ (html_close_page) Clears page_open.
+ (html_submit) Disabled.
+
+ * lexer.c: (parse_string) Remove debugging printf.
+
+ * list.q: (determine_layout) Open a page if one is not yet open.
+
+ * output.c: Comment fixes.
+ (add_class) Set the class member of the new list element.
+ (parse_options) Don't handle device type.
+ (colon_tokenize) New function.
+ (configure_driver) New four-field format with a field for device
+ type. Now initialize driver_open, page_open, next, and prev
+ fields. Use new colon_tokenize() function. Don't do a memory
+ copy to replace a driver, it doesn't work; instead delete the old
+ driver and insert a new one.
+ (destroy_driver) Don't call som_destroy_driver(). Close the page
+ if it's open. Find the class in the list of classes and decrement
+ that reference count. Remove the driver from the global driver
+ list.
+ (outp_iterate_enabled_drivers) Renamed outp_drivers(). All
+ references changed. Rewritten. Don't return a driver that's not
+ enabled.
+ (outp_eject_page) All references to som_internal_eject_page()
+ changed to use this. Sets cp_x to 0 as well as cp_y.
+
+ * output.h: (OUTP_I_* enums) Removed.
+ (struct som_submission_form) Removed.
+ (struct outp_class) init_driver broken into preopen_driver,
+ postopen_driver, and close_driver. submit changed to take a
+ som_table argument.
+
+ * postscript.c: Comment and formatting fixes. Almost every
+ external function had an assert added, checking driver_open and
+ page_open.
+ (ps_init_driver) Broken into ps_preopen_driver,
+ ps_postopen_driver, ps_close_driver. Manages driver_open.
+ (ps_open_page) Sets page_open.
+ (ps_close_page) Clears page_open.
+
+ * som.c: New file, base implementation.
+
+ * som.h: (struct som_table) Add struct tag.
+ (enum SOM_COL_ACROSS) Removed.
+ (SOM_ROWS, SOM_COLUMNS) New enums.
+ (struct som_table_class) Add member `cumulate'. Remove `segment';
+ change `render' arguments.
+ (struct som_point, struct som_rect) Removed.
+ (som_submit_table) Fixed typo, should have been som_submit.
+
+ * sysfile-info: (describe_variable) Don't try to insert a
+ subtable; just destroy it for now.
+
+ * t-test.q: Include dcdflib/cdflib.h instead of cdflib.h. Fix
+ references to value labels.
+
+ * tab.c: (tab_destroy) New function.
+ (tab_columns) Change argument.
+ [0] (tab_submit) Remove dead code.
+ (tab_title) Allocate string from the table's arena.
+ (tab_output_text) Only free the buffer if we allocated it.
+ (tab_submit) New function.
+ (static vars t, d) New static vars.
+ (tabi_table, tabi_driver, tabi_count, tabi_area, tabi_columns,
+ tabi_headers, tabi_cumulate, tabi_render) New functions.
+ (glob var tab_table_class) New global var.
+
+ * tab.h: (struct tab_join_rect) Don't use a som_rect; directly
+ encapsulate the rectangle. All references changed.
+
+Sun Dec 21 16:18:58 1997 Ben Pfaff <blp@gnu.org>
+
+ * All header files updated to use struct tags in addition to
+ typedefs for all structures. Don't use word `struct' in struct
+ tags.
+
+ * Makefile.am: (pspp_SOURCES) Remove html.c.
+ (INCLUDES) Replace the lib/* includes with a single lib/ include;
+ all references updated.
+
+ * command.c: (parse_cmd) Remove call to som_check_workspace.
+ (output_line) Update to new som.
+
+ * data-in.c: (parse_numeric) A single dot is not an error; it is
+ the system-missing value.
+
+ * data-list.c: (dump_fixed_table, dump_free_table) Update to new
+ som.
+
+ * data-out.c: Added `const' as appropriate to many prototypes.
+ (convert_E, convert_F, convert_CCx) Take double argument instead
+ of value * argument.
+ (convert_format_to_string) Call changed functions appropriately.
+ Instead of modifying the caller's value for FCAT_SHIFT_DECIMAL,
+ make a local copy of the value.
+
+ * descript.q: Remove custom_variables() prototype now provided by
+ q2c.
+ (custom_variables) Don't increment sbc_variables, the caller does
+ this.
+ (dump_z_table, display) Update to new som.
+
+ * error.c: (vmsg) Add const to prototype. Remove code to handle
+ `too many errors' condition.
+ (check_error_count) New function.
+ (msg) Add const to prototype.
+
+ * filename.c: (open_file) Rewrite for elegance.
+
+ * frequencies.q: Remove custom_*() prototypes now provided by q2c.
+ (dump_full, dump_condensed, dump_statistics) Update for new som.
+
+ * list.q: Don't include somP.h. Change all references to
+ som_driver_ext to refer to the new members of som_driver. Change
+ som_internal_eject_page() references to outp_eject_page().
+
+ * main.c: (parse) Rewrite for elegance. Add call to
+ check_error_count().
+
+ * output.c: (add_class, outp_list_classes, outp_configure_driver)
+ Rewrite or revise for new outp_driver_class_list structure.
+ (outp_iterate_enabled_drivers) Fix comparison between disabled
+ devices and current device type.
+ (outp_eject_page) New function.
+
+ * output.h: Comment fixes.
+ (struct outp_driver) New members driver_open, page_open, cp_x,
+ cp_y, font_height, prop_em_width, fixed_width. Deleted members
+ ref_count, next.
+ (struct outp_driver_class_list) New struct.
+ (outp_class_list) Changed to type outp_driver_class_list; all
+ references updated.
+
+ * print.c: (dump_table, print_trns_proc) Updated for new som.
+
+ * q2c.c: (dump_vars) Simplify array subcommand code. Declare
+ prototypes for custom subcommands.
+ (dump_subcommand) Always include the `else'.
+ (dump_parser) Fix comments in output code.
+
+ * set.q: Reordered functions.
+
+ * som-frnt.c, som-high.c, som-low.c, somP.h: Removed.
+
+ * som.h: Rewritten from scratch.
+
+ * str.h: Remove dead code.
+
+ * tab.c, tab.h: New files, base implementation.
+
+ * sysfile-info.c: (cmd_sysfile_info, describe_variable) Update to
+ new som.
+
+ * t-test.q: New code from John Williams
+ <johnr.williams@stonebow.otago.ac.nz>. Include math.h, cdflib.h.
+ Many many new static vars and defines.
+ (precalc, postcalc, g_postcalc, z_postcalc, t_pairs, t_groups,
+ groups_calc, pairs_calc, z_dev_calc, z_calc) New functions.
+ (struct value_list) New struct.
+ (variance, covariance, pooled_variance, oneway, pearson_r, f_sig,
+ t_crt, t_sig, print_t_groups) New functions.
+ (cmd_t_test) Implemented.
+
+ * temporary.c: (cancel_temporary) Only free the temp_dict if it's
+ non-NULL.
+
+ * vfm.c: (dump_splits) Update to new som.
+
+Thu Dec 4 23:02:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (fiasco_SOURCES) Add html.c.
+
+ * aggregate.c: Base source.
+
+ * ascii.c: (postopen, preclose) Reformat.
+
+ * data-out.c, expr-evl.c: Comment fixes.
+
+ * filename.c: (open_file) When opening a file for writing, use
+ line buffering instead of full buffering for better interactive
+ performance. Suggested by Valerio Aimale
+ <valerio@svpop.com.dist.unige.it>. Also, recognize special file
+ names `stdin', `stdout', `stderr'.
+
+ * groff-font.c: Comment fixes.
+
+ * html.c: New file; base version.
+
+ * list.q: (write_all_headers, clean_up, determine_layout,
+ list_cases) Ignore `special' devices for now. Needs to be fixed
+ later.
+
+ * output.c: (outp_init) Add html driver to list; reverse list
+ order.
+
+ * output.h: (struct outp_class_struct) New members `special',
+ `submit'; comment fixes. All references changed.
+
+ * postscript.c: (ps_init_driver) Make defaults for text_opt,
+ line_opt depend on whether the OUTP_DEV_SCREEN bit is set on the
+ device.
+ (postopen) Comment fix.
+ (preclose) Comment fixes, formatting fixes. Change x->file.file
+ references to more proper f->file.
+
+ * som-high.c: (som_submit_table) Special classes use their own
+ renderers.
+
+ * som.h: Comment fixes.
+
+ * temporary.c: (new_dictionary) Don't try to xstrdup() a NULL
+ string.
+
+Tue Dec 2 14:36:07 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (fiasco_SOURCES) Add aggregate.c back in.
+
+ * aggregate.c: Still working on this.
+
+ * command.c: (cmd_table[]) Add AGGREGATE back in.
+ (split_words) Make '-' a legal word separator as well as ' '.
+
+ * main.c: Comment fixes.
+
+ * q2c.c: (dump_parser) Don't require the procedure's full name to
+ be present, in the generated source.
+
+ * t-test.q: Change name to `t-test' from `t test'. Let PAIRS be
+ multiply specified and let it be default; let MISSING, CRITERIA,
+ FORMAT be multiply specified.
+ (cmd_t_test) Parse command name. [DEBUGGING] Call debug_print().
+ (custom_groups) Fix defaults.
+ (custom_pairs) Check whether this is a PAIRS subcommand before
+ attempting to parse. Better garbage collection. Proper storage
+ allocation.
+ [DEBUGGING] (debug_print) New function.
+
+ * temporary.c: Comment fixes.
+ (copy_variable) Don't copy variable name and index.
+ (save_dictionary) Copy variable name and index by hand.
+
+ * vars-atr.c: Comment fixes.
+ (create_variable) New dictionary argument. All references
+ changed.
+ (common_init_stuff) New dictionary argument. All references
+ changed.
+ (init_variable) New dictionary argument. All references changed.
+ (dup_variable) New function.
+
+ * vars-prs.c: (parse_variables) If there are any errors, we always
+ return 0. Previously, it was possible for some types of errors to
+ be ignored.
+
+Sat Nov 22 01:20:59 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (fiasco_SOURCES) For 0.1.5 release, remove
+ aggregate.c.
+
+ * command.c: (cmd_table[]) Comment out AGGREGATE; add T TEST.
+
+ * list.q, t-test.q: Remove ALL option from VARLIST declaration in
+ grammar rules.
+
+ * q2c.c: Comment fixes.
+ (SBC_* enums) Remove SBC_VARLIST_ALL; all references removed.
+
+ * t-test.q: (cmd_list) Rename cmd_t_test.
+
+ * temporary.c: (new_dictionary) Don't declare as static.
+
+Fri Nov 21 00:03:06 1997 Ben Pfaff <blp@gnu.org>
+
+ * aggregate.c: Changes, still not finished.
+
+ * file-handle.q, frequencies.q, list.q, set.q: Comment fixes.
+
+ * q2c.c: Comment fixes. Now its output is internationalized.
+ (get_token) Fix parsing of escapes within literal strings.
+ (main) Fix bad #line directives in output.
+
+ * t-test.q: Base implementation.
+
+ * temporary.c: (new_dictionary) New function.
+ (restore_dictionary) [__CHECKER__] Change fill character to *
+ (from @).
+
+Sun Nov 16 01:29:57 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (BUILT_SOURCES, fiasco_SOURCES) Add t-test.c
+
+ * aggregate.c: Changes, still not finished.
+
+ * descript.q, list.q: Comment fixes.
+
+ * q2c.c: Almost completely rewritten.
+
+ * t-test.q: New file, not complete.
+
+Fri Nov 14 00:14:48 1997 Ben Pfaff <blp@gnu.org>
+
+ * aggregate.c: Changes, still not finished.
+
+ * sort.c: (sort_cases) Call cancel_temporary() instead of doing it
+ by hand.
+
+ * temporary.c: (cancel_temporary) New function.
+
+ * vars-atr.c: (discard_variables) Call cancel_temporary() instead
+ of doing it by hand.
+
+ * vfm.c: (close_active_file) After restoring a TEMPORARY
+ dictionary, set temp_dict to NULL. Cancel TEMPORARY through
+ cancel_temporary().
+ (SPLIT_FILE_procfunc) Comment fix.
+
+Tue Oct 28 16:08:45 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (fiasco_SOURCES) Add aggregate.c.
+
+ * aggregate.c: New file, not finished yet.
+
+ * command.c: (cmd_table) Add AGGREGATE.
+
+ * common.h: (pgm_state) Move declaration to var.h.
+
+ * lexer.c: (bin_value_func, oct_value_func, hex_value_func) i18n
+ fixes.
+ (parse_string) Message fix.
+
+ * recode.c: Comment fix.
+
+ * sfm-read.c: (read_variables) Code esthetic fixes.
+ (write_header) Default date is `Jan', not `JAN'.
+
+ * sfmP.h: (bswap_int32) [!__linux__] Fix off-by-one errors.
+
+ * sort.c: (cmd_sort_cases) Farm the work out to new function
+ parse_sort_variables().
+ (parse_sort_variables) New function.
+ (sort_cases) New function. Cancels temporary transformations,
+ which sorting didn't do previously.
+ (cmd_sort_cases) Better garbage collection on error. Uses
+ do_external_sort().
+ (write_initial_runs, merge_once) Improved code esthetics.
+ (sort_stream_read) Reduced to one call to read_output_cases().
+ (read_output_cases) New function.
+
+ * var-labs.c: (cmd_variable_labels) Re-enabled truncation of
+ variable labels to 120 characters.
+
+ * var.h: Comment fixes.
+ (glob var pgm_state) From common.h.
+
+ * vars-atr.c: (discard_variables) Set pgm_state to STATE_INIT.
+
+ * vars-prs.c: (parse_DATA_LIST_vars) Support PV_SINGLE in
+ options. Set *names to NULL on error.
+
+ * vfm.c: (memory_stream_init) Assert compaction_nval != 0.
+
+Thu Oct 9 09:59:49 1997 Ben Pfaff <blp@gnu.org>
+
+ * sfm-write.c, vfm.c: [HAVE_UNISTD] #include <unistd.h>, needed by
+ SunOS4. From Alexandre Oliva <oliva@dcc.unicamp.br>.
+
+Wed Oct 8 18:55:24 1997 Ben Pfaff <blp@gnu.org>
+
+ * vfm.c: (page_to_disk) Added missing local variables.
+
+Tue Oct 7 20:23:17 1997 Ben Pfaff <blp@gnu.org>
+
+ * get.c: Comment fix.
+
+ * sort.c: (cmd_sort_cases) Attempt to perform internal sort if the
+ source is anything other than a disk stream, not just if it's in a
+ memory stream. Call page_to_disk() before external sort.
+ (allocate_cases) Message fix.
+
+ * vfm.c: (prepare_for_writing) Warn user when paging workspace to
+ disk.
+ (page_to_disk) New function.
+
+Sun Oct 5 15:56:14 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (INCLUDES) Include .. instead of $(top_srcdir).
+
+ * common.h: (macro strerror) Remove. From Alexandre Oliva
+ <oliva@dcc.unicamp.br>.
+
+ * get.c: (dict_delete_run) The number of variables to delete is
+ not necessarily the number of variables that need to be shifted
+ up.
+ (trim_dictionary) Don't set *options to 0. Fix bug that caused
+ too many variables to be deleted.
+
+ * postscript.c: Comment fix.
+
+ * q2c.c: Include strerror.c. From Alexandre Oliva
+ <oliva@dcc.unicamp.br>.
+
+ * set.q: #undef ON and OFF. From Alexandre Oliva
+ <oliva@dcc.unicamp.br>.
+
+ * sfm-read.c: (sfm_read_dictionary) Don't set the file class too
+ early, otherwise errors cause a bad free().
+
+ * str.h: (macro nvsprintf) s/FORMATS/FORMAT/ typo. From Alexandre
+ Oliva <oliva@dcc.unicamp.br>.
+
+ * temporary.c: (save_dictionary) Don't allocate memory if
+ n_documents is 0.
+
+ * vfm.c: (memory_stream_write) Message fix.
+
+Sat Oct 4 16:20:43 1997 Ben Pfaff <blp@gnu.org>
+
+ * command.c: (static var cmd_table[]) Define REPEATING DATA
+ command.
+
+ * common.h: Added support for broken systems that are missing
+ EXIT_SUCCESS, EXIT_FAILURE, RAND_MAX, and/or strerror().
+
+ * Many source files: Replace syntax error messages via msg() with
+ call to syntax_error().
+
+ * data-list.c: (dump_fixed_table) Add support for dumping table
+ for REPEATING DATA as well as DATA LIST FIXED.
+ (cmd_repeating_data) Allows and requires `/' between subcommands.
+ Does proper thing with allowing rpd.starts_end to stay 0. Allows
+ CONTINUED specifications to be omitted. Forces CONTINUED to be
+ specified if ID is. Calculates starts_end, cont_end from logical
+ record length as reported by fhp. Calls dump_fixed_table() if
+ requested. Fixed length of record copied by memcpy.
+ (parse_num_or_var) Sets `num' to 0, not NOT_INT, for variables.
+ Message fix.
+ (realize_value) Returns sensible value for out-of-range variable
+ values.
+ (rpd_parse_record) New argument `ofs'. Fixed confusion between
+ length of occurrences and length of line. Added warning for
+ fields that exceed the line length. Fixed infinite loop.
+ (read_one_set_of_repetitions) Numerous minor changes for more
+ complete SPSS compliance. Message fixes.
+
+ * dfm.c: (dfm_close) If the file being closed is the inline file,
+ read all the remaining data before closing it.
+ (dfm_get_record) Don't close the file on lossage, as either it
+ has been closed already or it doesn't belong to us.
+
+ * error.c: (puts_stdout) New function.
+ (vmsg) Use puts_stdout instead of puts.
+
+ * file-handle.q: (fh_record_width) New function.
+
+ * inpt-pgm.c: (init_case) Fixed buffer overrun when inp_nval % 4
+ == 0.
+ (clear_case) Ditto.
+ (input_program_source_read) Made an old kluge an approved method.
+
+ * lexer.c: (syntax_error) New function.
+
+ * misc.c: [BROKEN_RAND] (ansi_rand, ansi_srand; static var next)
+ New.
+
+ * output.c: (oupt_get_paper_size) Message fix.
+
+ * q2c.c: Numerous fixes to formatting of generated code made to
+ conform to GNU coding standards. Uses syntax_error() in generated
+ code. Other miscellaneous generated message fixes. Added support
+ for broken systems that are missing EXIT_SUCCESS, EXIT_FAILURE,
+ RAND_MAX, and/or strerror().
+
+Sat Oct 4 02:09:56 1997 Ben Pfaff <blp@gnu.org>
+
+ * data-in.c: Comment fixes.
+
+ * data-list.c: (struct repeating_data_trns) New member `id_spec'.
+ (find_variable_input_spec) New function.
+ (cmd_repeating_data) Initializes id_spec.
+ (rpd_parse_record) Implemented.
+ (read_one_set_of_repetitions) Returns -3 by default in order to
+ kluge out some potential bugs.
+
+ * data-out.c: Comment fixes.
+
+ * file-type.c: (internal_cmd_record_type) Message fix.
+
+ * inpt-pgm.c: (input_program_source_read) Special temporary kluge
+ for handling -3 return value.
+
+Sat Sep 20 23:58:15 1997 Ben Pfaff <blp@gnu.org>
+
+ * data-list.c: Comment fixes.
+ (struct dls_var_spec) Reordered members.
+ (read_from_data_list_fixed) Restructured.
+ (struct repeating_data_trns) Reordered members. Renamed `starts'
+ as `starts_beg', `ends' as `starts_end'.
+ (cmd_repeating_data) Calculates length of repeated data if
+ necessary and possible.
+ (parse_num_or_var) Don't allow string variables.
+ (realize_value) New function.
+ (rpd_msg) New function.
+ (rpd_parse_record) New function. Currently stubbed out.
+ (read_one_set_of_repetitions) Implemented.
+
+ * inpt-pgm.c: (input_program_source_read) Comment fix.
+
+Thu Sep 18 21:34:57 1997 Ben Pfaff <blp@gnu.org>
+
+ * command.c: (cmd_end_repeat_p) Removed.
+ (init_cmd_parser) Doesn't set cmd_end_repeat_p.
+ (parse_cmd_name) Removed.
+
+ * data-list.c: Comment fixes.
+ (data_list_pgm) Removed `eof' member.
+ (static var first) New var.
+ (cmd_data_list) Sets `first'. Ensures that DATA LIST uses the
+ FILE TYPE file inside FILE TYPE structures.
+ (append_var_spec) Appends to *first, not dls.spec.
+ (parse_fixed) Message fixes.
+ (struct rpd_num_or_var) New.
+ (struct repeating_data_trns) New.
+ (static var rpd) New.
+ (cmd_repeating_data) New function.
+ (parse_num_or_var) New function.
+ (parse_repeating_data) New function.
+ (read_one_set_of_repetitions) New function.
+
+ * file-type.c: (cmd_file_type) Message fixes. Always
+ default_handle to FILE TYPE file handle.
+ (internal_cmd_record_type) Message fixes.
+
+Wed Aug 20 14:22:03 1997 Ben Pfaff <blp@gnu.org>
+
+ * repeat.c: Comment fix. Disable debugging.
+
+ * temporary.c: (restore_dictionary) Sets splits to NULL and
+ n_splits to 0 before destroying the variables because now doing
+ this tries to remove split variables.
+
+ * vars-atr.c: (discard_variables) Asserts that n_splits is 0 after
+ destroying the dictionary.
+ (clear_variable) Removes a variable from splits after destroying
+ it.
+
+Mon Aug 18 18:06:55 1997 Ben Pfaff <blp@gnu.org>
+
+ * cmdline.c: (set_compat) Removed.
+ (pick_compat) Removed.
+ (parse_command_line) Removed -c option.
+ (pre_syntax_message) Removed -c option.
+ (usage) Remove compatibility code.
+
+ * common.h: (macros VER_PC, VER_WND, VER_X) Removed.
+ (glob var compat) Removed.
+
+ * compute.c: (type_check) Fixed messages about type mismatches.
+
+ * data-list.c: (cmd_data_list) Removed compatibility code.
+ (fixed_parse_compatible) Calls convert_negative_to_dash().
+ Fixed bug where it only set the variable in fx.spec if it created
+ the variable itself.
+ (dump_fmt_list) Spelling fix.
+ (cut_field) Removed compatibility code.
+
+ * dfm.c: (cmd_begin_data) Don't require a command terminator on
+ BEGIN DATA command.
+
+ * expr-evl.c: (evaluate_expression) Implement LAG.
+
+ * expr-prs.c: (parse_add) Calls convert_negative_to_dash().
+ (parse_neg) Calls convert_negative_to_dash().
+ (LAG_func) Increases n_lag to the lag requested. Fixed assignment
+ bug.
+
+ * expr.h: (struct expression_struct) Removed member max_lag.
+
+ * file-type.c: (parse_col_spec) Calls convert_negative_to_dash().
+ (internal_cmd_record_type) Removed special handling to produce
+ negative numbers from dash tokens.
+
+ * getline.c: (static var DO_REPEAT_level) New var.
+ (getl_add_DO_REPEAT_file) Increments DO_REPEAT_level.
+ (handle_line_buffer) Copies the line into getl_buf; doesn't call
+ copy_with_DO_REPEAT_substitutions().
+ (getl_read_line) Maintains value of getl_mode. Calls
+ perform_DO_REPEAT_substitutions() whenever DO_REPEAT_level is
+ positive.
+ (getl_close_file) Decrements DO_REPEAT_level when appropriate.
+
+ * getline.h: (getl_mode) New glob var.
+
+ * glob.c: Comment fixes.
+ (init_glob) Restructured. Sets set_seed.
+ (init_compat_dependent) Removed. All references removed.
+ (get_date) Format changed from MM/DD/YY to DD MMM YYYY.
+ (__htonl, __htons) Removed. (What were these for?)
+
+ * lexer.c: (static var tbl) Dash set to class CNUM.
+ (make_hexit) New function from data-out.c.
+ (get_token_representation) Rewritten.
+ (convert_negative_to_dash) New function.
+ (lex_init_compat_dependent) Removed.
+ (yylex) A dash is parsed as part of a number if it is followed by
+ a digit. The ASCII representation of a number is copied to
+ tokstr. String parsing farmed out to parse_string(). Comment
+ fixes.
+ (bin_value_func, oct_value_func, hex_value_func, parse_string) New
+ functions.
+ (preprocess_line) Line processing depends on interactive/batch
+ mode, not on compatibility mode. Removed PC+ compatibility code.
+
+ * loop.c: (loop_3_trns_proc) Comment fix.
+
+ * main.c: Remove dead code.
+ (main) Remove call to init_compat_dependent().
+
+ * misc.c: (convert_fmt_ItoO) Make E format conversion more
+ conformant.
+
+ * print.c: (parse_string_argument) Calls
+ convert_negative_to_dash().
+ (fixed_parse_compatible) Calls convert_negative_to_dash().
+
+ * repeat.c: (RPT_* defines) Removed.
+ (struct rpt_numeric) Removed.
+ (struct repeat_entry) New member type, changed `replacement' from
+ char * to char **.
+ (clean_up) Deallocation adapted to new repeat_entry.
+ (internal_cmd_do_repeat) `type' defaults to 0. Remove lookahead()
+ usage. Creates vars for `type' of 1.
+ (parse_ids) Sets type of 1. Adapted to new repeat_entry.
+ (store_numeric) Rewritten, new interface.
+ (parse_numbers) Rewritten.
+ (parse_strings) Rewritten.
+ (find_DO_REPEAT_substitution) New function.
+ (perform_DO_REPEAT_substitutions) New function.
+ (copy_with_DO_REPEAT_substitutions) Removed.
+ (debug_print) Rewritten.
+
+ * set.q: Comment fix.
+ (custom_results) Removed compatibility code.
+ (internal_cmd_set) Removed SET EMULATION subcommand. Removed
+ compatibility code.
+
+ * sysfile-info.c: (cmd_display) Removed compatibility code.
+
+ * tokens.h: Comment fixes.
+ (token types enum) Removed `toktype' typedef name for this int
+ type. Removed SUBST. Restructured.
+
+ * vars-atr.c: (discard_variables) Sets n_lag to 0.
+
+ * vars-prs.c: Comment fix.
+
+ * vfm.c: Comment fixes.
+ (glob var n_lag) New var.
+ (static vars lag_count, lag_head, lag_queue) New vars.
+ (procedure) Removed argument nlag.
+ (setup_lag) New function.
+ (close_active_file) Discards lagging state.
+ (lag_case) New function.
+ (lagged_case) New function.
+ (write_case) Lags a case if lagging.
+
+ * weight.c: (cmd_weight) Removed compatibility code.
+
+Sun Aug 17 22:34:40 1997 Ben Pfaff <blp@gnu.org>
+
+ * getline.h: (struct getl_script) New members loop_index, macros.
+
+ * getline.c: (getl_add_file) Sets first_line field to NULL.
+ (getl_add_DO_REPEAT_file) New function.
+ (handle_line_buffer) When the current line's length is negative,
+ set the filename and line number. Increment line number after
+ reading line. Pass the line to
+ copy_with_DO_REPEAT_substitutions() for processing.
+ (getl_close_file) Free DO REPEAT lines before freeing the
+ filename, and just set the filename to NULL when doing this,
+ because otherwise the filename gets freed twice.
+
+ * glob.c: (glob var queuing) Removed. All references removed.
+
+ * lexer.c: Comment fixes.
+ (get_token_representation) New function.
+
+ * repeat.c: Comment fixes.
+ (struct repeat_entry) Replaced type and v union members with a
+ simple string.
+ (append_record) New function.
+ (internal_cmd_do_repeat) Started reforming it for the new
+ repeat_entry struct. Properly records filename changes in the
+ getl_line_buf. Fixed improper use of = for ==. Fixed sense of
+ strncasecmp() result usage. Uses append_record() to simplify.
+ Properly discards END REPEAT line. Calls getl_add_DO_REPEAT_file
+ to add in the file.
+
+ (copy_with_DO_REPEAT_substitutions) Started coding.
+
+ [DEBUGGING] (debug_print_lines) New function.
+
+ * set.q: (custom_results, internal_cmd_set) s/VER_PCP40/VER_PC/;
+
+ * tokens.h: (macro is_id1, is_idn) New macros.
+
+Sat Aug 16 10:57:41 1997 Ben Pfaff <blp@gnu.org>
+
+ * cmdline.c: (static var pre_syntax_message) Changed `win'
+ compatibility mode to `wnd'.
+
+ * data-list.c: (fixed_parse_spss) Renamed
+ fixed_parse_compatible().
+
+ * glob.c: (init_glob) Excise unused code for
+ program_invocation_short_name.
+
+ * lexer.c: (preprocess_line) Leading indentors are ignored in Wnd
+ as well as in X.
+
+ * print.c: (fixed_parse_spss) Renamed fixed_parse_compatible().
+
+ * set.q: `win' compatibility renamed `wnd'.
+
+Thu Aug 14 22:11:12 1997 Ben Pfaff <blp@gnu.org>
+
+ * filename.c: [__WIN32__] Change the included Windows header files
+ (again).
+ (absolute_filename_p) [__MSDOS__] A filename with a colon as the
+ second character is absolute.
+ (dirname) Fix logic error. Don't printf() the results.
+ (prepend_dir) Don't printf() the results.
+
+ * getline.c: (handle_line_buffer) New function.
+ (getl_read_line) Reads line with handle_line_buffer() when
+ appropriate.
+ (getl_close_file) Discard line buffer data.
+
+ * getline.h: Comment fixes.
+ (struct getl_line_list) New struct.
+ (getl_script_struct) Added line buffer members. These are hooks
+ for use by DO REPEAT to allow it to insert virtual source code
+ into the program.
+
+ * glob.c: (init_glob) [__DJGPP__ || (__WIN32__ && __BORLANDC__)]
+ Override Borland C++ stupidity that claims Windows has a console
+ window size of 0x3.
+
+ * repeat.c: This is in the process of being restructured from
+ using a token-buffering approach to the DO REPEAT facility to
+ using the more flexible approach of a line-buffering approach in
+ conjunction with the getline module. Comment fixes.
+ (struct tok_struct) Removed.
+ (static vars queue_index, queue_head, queue) Removed.
+ (static vars line_buf_head, line_buf_tail) New vars.
+ (internal_cmd_do_repeat) Instead of queuing tokens, queue lines.
+ Not complete.
+ (pull_queue, destroy_queue) Removed.
+ [DEBUGGING] (debug_print_tokens) Removed.
+
+Tue Aug 5 13:57:58 1997 Ben Pfaff <blp@gnu.org>
+
+ * file-handle.q: (prepend_current_directory) New function.
+ (internal_cmd_file_handle, fh_get_handle_by_filename) Prepends
+ current directory before normalizing filename.
+
+ * filename.c: (gnu_getcwd) New function.
+ (absolute_filename_p) New function.
+ (search_path) New argument, PREPEND. All references changed to
+ pass NULL except those explicitly mentioned. Uses
+ absolute_filename_p(). Prepends PREPEND before trying the
+ filename.
+ (dirname, prepend_dir) New functions.
+
+ * getline.c: (getl_get_current_directory) New function.
+ (getl_include) Passes getl_get_current_directory() as PREPEND arg
+ to search_path().
+
+Sun Aug 3 11:42:36 1997 Ben Pfaff <blp@gnu.org>
+
+ * In several source files, the term `script' was replaced with
+ `syntax file' inside error messages. Usage of the term `script'
+ in the sense of a syntax file is now deprecated.
+
+ * cmdline.c: (static vars pre_syntax_message, post_syntax_message)
+ Updated messages.
+
+ * dump-sysfile.c: (usage) Update message.
+
+ * getline.c: (getl_read_line) Ignore lines beginning with `#!'.
+
+ * getline.h: (glob var getl_include_path) Declare extern.
+
+ * list.q: Define EXTERN as extern before #including somP.h.
+
+ * var.h: Remove declaration of `disptype' variable.
+
+ * vfm.c: (close_active_file) After switching the data sink to a
+ data source, set vfm_sink to NULL, because it doesn't exist any
+ more.
+
+Thu Jul 17 21:41:44 1997 Ben Pfaff <blp@gnu.org>
+
+ * glob.c: [__BORLANDC__] Include math.h. Define _matherr() and
+ _matherrl() to ignore all math errors.
+
+ * sfm-read.c: (read_value_labels) When reading the labels from
+ disk, read the little parts separately instead of as a struct;
+ this avoids alignment problems.
+
+ * sfm-write.c: (struct sfm_fhuser_ext) New member `elem_type'.
+ (sfm_write_dictionary) Sets elem_type and frees it on lossage.
+ (write_header) Allocates and initializes elem_type.
+ (sfm_write_case) Uses elem_type to determine how to handle each
+ flt64 element.
+ (sfm_close) Frees elem_type.
+
+ * sfmP.h: Comment fix.
+ [__BORLANDC__] Uses #pragma -a to adjust structure member
+ alignment.
+
+Thu Jul 17 01:55:12 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (fiasco_SOURCES) Remove display.c.
+
+ * common.c: Fix typo.
+
+ * dfm.c: (read_record) Remove strncasecmp() emulation and fix the
+ sense of the condition.
+
+ * expr-evl.c: (macro ALLOC_STRING_SPACE) [!PAGED_STACK] Add
+ line-continuation backslash.
+
+ * filename.c: [__WIN32__] Include <windef.h> before <winbase.h>.
+
+ * frequencies.q: (custom_grouped, add_percentile) Don't use a
+ non-constant expression as an argument to sizeof.
+
+ * glob.c: [__WIN32__ && __BORLANDC__] When including <conio.h>,
+ undefine gettext macro because that's a conio function.
+
+ * hash.h: (hsh_prime_tab declaration) Remove.
+
+ * list.q: (write_fallback_headers) Move `leader' allocation out of
+ main loop. Change to local_alloc() allocation.
+
+ * output.h: Formatting fixes. Put __attribute__ in right place on
+ function prototypes.
+
+ * sfm-read.c: (read_machine_flt64_info, read_variables) Change
+ incorrect `SECOND_LOWEST_VALUE' references to proper
+ `second_lowest_value'.
+
+ * som-frnt.c: (EXTERN macro) Define as `extern' instead of null
+ value. This way 2 out of 3 of the som files define the vars
+ extern, the correct way, that actually works under BC++.
+ (som_set_float) Don't use nonconstant initializers for a struct.
+
+ * som-high.c: Add the standard alloca() header.
+ (replicate_table) Add prototype.
+
+ Merged DISPLAY routine.
+ * sysfile-info.c: (AS_*) New enum series.
+ (cmd_sysfile_info) Gutted. Calls describe_variable() to do the
+ dirty work.
+ (cmd_display, display_macros, display_documents,
+ display_variables) Stolen from defunct display.c.
+ (describe_variable) New function.
+
+ * temporary.c: [0] (display_tree) New debug function.
+ (copy_variable) Performs shallow copy of value labels instead of
+ deep copy; i.e., just copys the AVL tree and increments the
+ reference counts.
+
+ * val-labs.c: Comment fixes.
+ (do_value_labels) Optionally skip leading forward slash.
+ (get_label) Creates only a single value label instead of many
+ copies of one, and sets the reference count.
+
+ * display.c: Removed.
+
+ * dump-sysfile.c: New file, not yet complete.
+
+Fri Jul 11 23:02:18 1997 Ben Pfaff <blp@gnu.org>
+
+ For lots of source files I added more verbose_msg's. These aren't
+ listed below as they have tested as being benign. In some cases
+ these replaced debug_printf() calls.
+
+ * output.c: (outp_read_devices) Message fix.
+
+ * postscript.c: (output_encodings) Message fix. Reports errors on
+ fclose().
+ (postopen) Message fix.
+
+Fri Jul 11 14:09:40 1997 Ben Pfaff <blp@gnu.org>
+
+ * dfm.c: (dfm_close) Don't call fclose() for a NULL FILE.
+
+ * filename.c: (close_file_ext) Set f->file to NULL *after* closing
+ it.
+
+ * main.c: Remove <malloc.h> #include.
+
+ * mis-val.c: (parse_numeric) Set .f member for each missing[]
+ instead of trying to just set the missing[] itself, which is a
+ gcc-specific idiom.
+
+ * sfm-read.c: (read_variables) Same.
+
+ * str.h: Add memmem() prototype.
+
+ * val-labs.c, var-labs.c: Replace <malloc.h> with <stdlib.h>.
+
+Thu Jul 10 22:13:53 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (q2c) Don't include any libraries in the link.
+
+ * dfm.c: (force_line_buffer_extension) New macro.
+ (count_tabs) New function.
+ (tabs_To_spaces) New function.
+ (read_record) Calls tabs_to_spaces() on the line being processed.
+
+ * q2c.c: Disabled i18n for this proglet so that libintl.a doesn't
+ have to be compiled twice (once for CC, once for LOCAL_CC).
+
+Sun Jul 6 19:14:33 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (INCLUDES) Add intl directory; fix directories.
+ (LDADD) Add @INTLLIBS@.
+ (q2c) Add LIBS, @INTLLIBS@ to link step.
+
+ * inpt-pgm.c: Turn off debugging.
+
+ * postscript.c: (postopen) Format fix. local_free() blocks
+ returned by local_alloc(); don't free() them.
+
+Sat Jul 5 23:44:51 1997 Ben Pfaff <blp@gnu.org>
+
+ * data-in.c: (parse_string_as_format) Comment fix. Fix check for
+ string length.
+
+ * data-list.c: (read_from_data_list_fixed) Pass proper value for
+ LEN arg, not simply the full string length.
+
+ * sort.c: (allocate_file_handles) Check SPSS compatible temp file
+ directories before generic temp file directories.
+
+ * vfm.c: Disable debugging.
+
+Fri Jul 4 13:26:41 1997 Ben Pfaff <blp@gnu.org>
+
+ * get.c: Comment fix.
+ (cmd_save_internal) Always passes GTSV_OPT_SAVE option.
+
+Wed Jun 25 22:52:28 1997 Ben Pfaff <blp@gnu.org>
+
+ * expr-prs.c: (debug_print_postfix) Conditionally included on
+ GLOBAL_DEBUGGING. Removed out_header() reference.
+
+ * exprP.h: Removed #undef GLOBAL_DEBUGGING.
+
+Sun Jun 22 22:00:28 1997 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: Removed obsolete ascii_close_page() prototype.
+
+ * command.c: (output_line) Comment fix.
+
+ * data-in.c: Formatting fix.
+ (parse_string_as_format) Now the `fc' argument is used only for
+ the purpose of error messages; it is not an index into the string
+ passed. All references changed.
+
+ * data-list.c: Comment fix.
+ (cut_field) Comment fix. Now returns the column number of the
+ position of the field cut out on success.
+ (parse_field) Added `column' argument. Puts the column numbers in
+ the error message.
+ (read_from_data_list_free, read_from_data_list_list) Record the
+ column number returned by cut_field(), pass it to parse_field().
+
+ * dfm.c: Comment fix.
+
+ * do-ifP.h: Comment fix.
+
+ * expr-prs.c: (SYSMIS_func) Implemented string-type arguments for
+ the SYSMIS function.
+
+ * expr.h, exprP.h: Comment fix.
+
+ * glob.c: (init_glob) Only calls setlocale() and family if
+ ENABLE_NLS set.
+
+ * hash.h: Comment fix.
+
+ * include.c: Comment fix.
+
+ * output.c: Comment fix.
+
+ * postscript.c: (ps_line_intersection) Simplified assertion.
+
+ * repeat.c: Comment fix.
+
+ * vars-atr.c: Comment fix.
+
+ * vars-prs.c: Comment fix.
+
+ * vfm.c: (vector_initialization) [DEBUGGING] Fixed undefined
+ behavior with usage of postincrement.
+ (memory_stream_read) Discards cases as it goes.
+
+Sun Jun 15 16:45:17 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Cleans q2c, not just distcleans it. Distcleans
+ foo.
+
+ * Most source files: Includes debug-print.h, related comment
+ fixes.
+
+ * cases.c: (alloc_val) Removed complex allocation code. Merely
+ increments default_dict.nval and returns the former value.
+ (envector, devector) Removed references to lv member of struct
+ variable.
+
+ * common.h: (macro VME) Replaced complex definition with simple
+ one.
+
+ * data-list.c: (cmd_data_list) Sets vfm_source instead of
+ read_active_file and cancel_input_pgm.
+ (read_from_data_list, cancel_data_list) Removed.
+ (data_list_source_read, data_list_source_destroy_source) New
+ functions.
+ (glob var data_list_source) New var.
+
+ * dfm.c: (open_file_r, open_file_w) Simplified debug output.
+ (cmd_begin_data) Improved criteria for an input program accessing
+ the inline file. Still not perfect.
+
+ * do-if.c: (do_if_trns_proc) Simplified debug output.
+
+ * expr-prs.c: Comment fixes.
+ [DEBUGGING] (debug_print_postfix) Simplified debug output.
+
+ * file-handle.q: (fh_close_handle) Simplified debug output.
+
+ * file-type.c: Comment fixes.
+ (cmd_file_type) Sets vfm_source instead of read_active_file and
+ cancel_input_pgm.
+ (cmd_end_file_type) On failure, discards variables in place of
+ just canceling the input program.
+ (read_from_file_type) Renamed file_type_source_read.
+ (cancel_file_type) Renamed file_type_source_destroy_source.
+ (glob var file_type_source) New var.
+
+ * get.c: (GTSV_* enum series) New enums GTSV_OPT_SAVE, GTSV_NONE.
+ (cmd_get) Initializes options to GTSV_NONE before passing to
+ trim_dictionary(). Removed `lv' reference. Sets vfm_source
+ instead of read_active_file and cancel_input_pgm.
+ (cmd_save_internal) Initializes options before passing to
+ trim_dictionary(). Local var `nval' removed.
+ (dict_delete_run) Comment fixes.
+ (trim_dictionary) Comment fixes. Disallows scratch variables if
+ GTSV_OPT_SAVE set in options.
+ (read_from_get) Renamed get_source_read.
+ (cancel_get) Renamed get_source_destroy_source.
+ (glob var get_source) New var.
+
+ * inpt-pgm.c: (cmd_input_program) Sets vfm_source instead of
+ read_active_file and cancel_input_pgm.
+ (read_from_input_program) Renamed input_program_source_read.
+ Simplified debug output.
+ (cancel_input_program) Renamed
+ input_program_source_destroy_source.
+ (glob var input_program_source) New var.
+
+ * loop.c: (loop_1_trns_proc) Simplified debug output.
+
+ * main.c: (dump_token) Made eof output more explicit.
+
+ * sfm-read.c: (read_variables, dump_dictionary) Removed `lv'
+ references.
+
+ * sort.c: (cmd_sort_cases) Disallows scratch variables. Removed
+ code for always-memory or always-disk cases. malloc's case-list
+ based on vfm_source_info.ncases. Explicit support for
+ memory_stream via memory_source_cases.
+ (do_external_sort) Sets vfm_source instead of read_active_file and
+ cancel_input_pgm.
+ (allocate_file_handles) The temporary directory permissions are
+ set to 0700 instead of 0777.
+ (allocate_cases) Formatting fixes. Simplified debug output.
+ (output_record) Compacts the case if necessary before writing it
+ out.
+ (close_handle, open_handle_w) Simplified debug output.
+ (write_initial_runs) Destroys vfm_sink, then sets it to
+ sort_stream. Writes records to memory based on
+ vfm_sink_info.case_size.
+ (write_to_sort_cases) Renamed sort_stream_write().
+ (merge) Simplified error handling. Simplified debug output.
+ Formatting fixes.
+ (read_from_external_sort) Renamed sort_stream_read().
+ Reads records based on vfm_source_info.case_size.
+ (sort_stream_write) Writes records to memory based on
+ vfm_sink_info.case_size.
+ (sort_stream_mode) New function.
+ (glob var sort_stream) New variable.
+
+ * temporary.c: (cmd_temporary) Simplified debug output.
+ (copy_variable) Removed references to `lv'.
+
+ * title.c: (get_title) Simplified debug output.
+
+ * var.h: Comment fixes.
+ (struct get_proc) Removed member `lv'.
+ (struct variable) Removed member `lv'. Comment fixes.
+ (glob vars read_active_file, write_active_file, cancel_input_pgm)
+ Removed.
+ (struct case_stream) New.
+
+ * vars-atr.c: (discard_variables) Changed cancel_input_pgm,
+ read_active_file references to use vfm_source.
+ (init_variable, replace_variable) Removed references to `lv'.
+
+ * vfm.c: Comment fixes.
+ (glob var vfm_source, vfm_sink, vfm_source_info, vfm_sink_info)
+ New variables.
+ (static var queue, qh, qt, n_lag) Removed. All references
+ removed.
+ (glob var compaction_necessary, compaction_nval, compaction_case,
+ paging) New variables.
+ (record_case) Removed.
+ (procedure) Comment fixes. Calls vfm_source->read() instead of
+ read_active_file().
+ (lag) Removed.
+ (prepare_for_writing, arrange_compaction, make_temp_case,
+ vector_initialization, setup_filter) New function.
+ (open_active_file) Most of the code moved into the abovementioned
+ new functions. Now sets temp_dict to &default_dict if there is no
+ temporary dictionary, for convenience. New debug output.
+ (close_active_file) Deals with changing the sink to the source.
+ Calls finish_compaction(). Frees compaction_case. Mostly
+ rewritten.
+ (glob vars disk_source_file, disk_sink_file) New vars.
+ (destroy_active_file, read_from_memory) Removed.
+ (disk_stream_init, disk_stream_read, disk_stream_write,
+ disk_stream_mode, disk_stream_destroy_source,
+ disk_stream_destroy_sink) New functions.
+ (glob var vfm_disk_stream) New var.
+ (glob vars memory_source_cases, memory_sink_cases,
+ memory_sink_iter, memory_sink_max_cases) New vars.
+ (memory_stream_init, memory_stream_read, memory_stream_write,
+ memory_stream_mode, memory_stream_destroy_source,
+ memory_stream_destroy_sink) New functions.
+ (glob var vfm_memory_stream) New var.
+ (write_case) Local var `i' renamed `cur_trns'; local var `retval'
+ named `more_cases'. Simplified debug output. Otherwise mostly
+ rewritten.
+ (record_case) Moved into the stream drivers. Removed.
+ (transform) Removed (was dead code).
+ (SPLIT_FILE_procfunc) s/vfm_replacement/vfm_sink_info/. In the
+ common case that the splits don't change, we don't need to copy
+ the case into prev_case again--pointless.
+ (compact_case) New function.
+ (finish_compaction) New function.
+
+ * vfmP.h: Comment fixes.
+ (DEV_* enum series) Removed.
+ (struct storage) Renamed `stream_info'. Removed variant record.
+ Removed `device' member.
+
+ * debug-print.h: New file.
+
+Sun Jun 8 01:12:38 1997 Ben Pfaff <blp@gnu.org>
+
+ * autorecode.c: Turned off debugging.
+
+ * data-list.c: (destroy_dls) Closes the associated file handle.
+
+ * descript.q: (custom_variables) Added PV_NO_SCRATCH to
+ parse_variables() options.
+
+ * dfm.c: (open_file_r) Removed gratuituous argument to msg() call.
+
+ * display.c: (display_variables) Really fixed null cell bug.
+
+ * file-handle.q: (fh_close_handle) Changed debugging message.
+
+ * frequencies.q: (custom_variables) Added PV_NO_SCRATCH to
+ parse_variables() options.
+
+ * list.q: Added PV_NO_SCRATCH in q2c varlist options.
+ (cmd_list) Fails if no variables specified.
+ (determine_layout) Writes blank lines manually.
+
+ * loop.c: (loop_1_trns_proc) Made debugging code only print
+ messages if debugging.
+
+ * q2c.c: (dump_subcommand) Appends sbc->message to SBC_VARLIST
+ parse_variables() arguments.
+ (main) Parses optional parenthesized options to varlist
+ subcommands into sbc->message.
+
+ * sfm-read.c: Format fix.
+
+ * var.h: (FV_*) New enum series.
+ (PV_*) New enum PV_NO_SCRATCH.
+
+ * vars-prs.c: (find_var) Removed.
+ (fill_all_vars) Takes FV_* enum instead of boolean third
+ argument. Rewritten to deal with scratch as well as system
+ variables.
+ (parse_variables) Error message on scratch variable if
+ PV_NO_SCRATCH set.
+
+ * vfm.c: (static var virt_begin_func) New var.
+ (procedure) Sets up virt_begin_func.
+ (SPLIT_FILE_procfunc) For the first case, calls virt_begin_func()
+ after dump_splits(). For succeeding groups changes, calls
+ virt_begin_func() instead of begin_func().
+
+Fri Jun 6 22:42:23 1997 Ben Pfaff <blp@gnu.org>
+
+ * count.c, data-out.c, file-handle.q, list.q, loop.c: Turned off
+ debugging.
+
+ * dfm.c: Added some debugging messages, disabled by default.
+ (open_file_r) Fixed error message.
+ (read_record) On eof on inline_file, instead of calling
+ fh_close_handle(), simply jump to eof label like a normal file.
+ Message fixes.
+
+ * display.c: Thin lines between rows for certain kinds of
+ listing. Fixed `null cell' bug.
+
+ * error.c: (failure) Flush stdout, stderr before failing.
+
+ * file-handle.q: (fh_close_handle) Added debugging message.
+
+ * frequencies.q: (dump_full) Bottom line extends across entire
+ table width. Changed title formatting.
+ (dump_condensed) Changed title formatting.
+ (dump_statistics) Fixed title formatting.
+
+ * glob.c: (init_glob) Moved initialization of cur_proc out of #if.
+ Sets default value of set_format.
+
+ * list.q: (cmd_list) Calls blank_line() before determine_layout().
+ Passes write_all_headers() to procedure() as pre-group func.
+ (write_all_headers) New function.
+ (determine_layout) Removed calls to write_header().
+ Calls blank_line() before and after write_fallback_headers().
+
+ * recode.c: (recode_trns_free) Only attempts to free head->map if
+ non-NULL.
+
+ * sfm-read.c: (read_variables) Allows `#' at beginning of system
+ file variable names but gives a warning. Sets `left' based on
+ first character being/not being `#'. On lossage frees dict->var.
+
+ * som-high.c: (som_draw_title) Simplified title formatting.
+
+ * vfm.c: (dump_splits) Fixed and changed splits formatting.
+
+Thu Jun 5 22:51:15 1997 Ben Pfaff <blp@gnu.org>
+
+ * autorecode.c: (cmd_autorecode) Sets h_trans to NULL at
+ beginning. Frees v_src, v_dest on successful exit. Frees
+ h_trans[*], h_trans on lossage.
+ (recode) Frees h_trans[*], h_trans.
+
+ * dfm.c: (dfm_close) Formatting change.
+ (open_inline_file) Now passed a dfm_fhuser_ext to initialize; no
+ longer allocates its own in inline_file.
+ (open_file_r) Passes the local dfm_fhuser_ext to
+ open_inline_file().
+ (open_file_w) Message fix.
+ (read_record) Buffer reallocation strategy changed. Frees
+ ext->line even in inline_file to prevent leaks.
+ (dfm_put_record) Fixed bug where `ext' was cached before the file
+ was opened and thus it would be NULL when the file really was
+ open.
+ (cmd_begin_data) Sets up inline_file basics itself, then calls
+ open_inline_file() for the dfm_fhuser_ext. Formatting fix.
+
+ * list.q: (write_line) Formatting fix.
+ (clean_up) Minor strategy change. Sets proportional font after
+ finishing cleanup.
+ (determine_layout) Sets fixed font before writing regular headers,
+ or after writing fallback headers.
+
+ * modify-vars.c: (cmd_modify_vars) Frees variable lists for DROP
+ and KEEP vars after using them.
+
+ * postscript.c: (ps_init_driver) Frees x->family.
+ (postopen) When loading fonts, free the temporary font name buffer
+ after using it.
+ (ps_text_set_font_by_position) Free temporary font name buffer
+ after using it.
+ (text) Fixed code that calculated `lig' so that `lig' always gets
+ initialized. Formatting fix.
+
+ * som-low.c: (get_cell_size, som_get_table_size) `prop_height' ->
+ `font_height'.
+ [GLOBAL_DEBUGGIGN] (check_table) Use arena_alloc() to allocate
+ cells, not xmalloc(), so that the cells will get destroyed
+ automatically.
+
+ * sysfile-info.c: (cmd_sysfile_info) Frees the dictionary after
+ using it.
+
+Tue Jun 3 23:33:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: (ascii_text_draw) Always sets metrics for strings that
+ are drawn.
+
+ * dfm.c: Comment fix.
+
+ * list.q: Comment fixes. Include somP.h. Removed static vars
+ table, n_columns, n_rows, part. New struct list_ext. New static
+ var line_buf.
+ (n_lines_remaining, n_chars_width, write_line) New functions.
+ (cmd_list, list_cases) Rewritten.
+ (begin_row, end_row, flush_table) Removed.
+ (write_header, clean_up, write_varname, write_fallback_headers,
+ determine_layout) New functions.
+
+ * output.c: (outp_iterate_enabled_drivers) Minor reformat.
+
+ * output.h: Comment fix.
+
+ * postscript.c: Comment fix.
+ (struct ps_driver_ext) Removed prop_size, fixed_size members;
+ added font_size. All references changed.
+ (ps_init_driver) Initializes font_size. Simplified space checking
+ code.
+ (static var option_tab[]) Removed prop-size, fixed-size; added
+ font-size.
+ (ps_option) Handles font_size.
+
+ * som-high.c: Moved prototypes into somP.h.
+ (som_init_driver) New function.
+ (som_submit_table) Moved some code into new function
+ som_init_driver().
+ (build_target) Moved some code into new function
+ som_internal_eject_page().
+ (som_eject_page) Uses som_internal_eject_page().
+ (som_internal_eject_page) New function.
+
+ * som-low.c: Moved prototypes into somP.h.
+
+ * som.h: Formatting fixes.
+
+ * somP.h: (struct som_driver_ext) Removed em_width;
+ added prop_em_width, fixed_width.
+
+Mon Jun 2 14:25:25 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added `localedir' definition. Added
+ -DLOCALEDIR="..." to DEFS. Added -I. to INCLUDES.
+
+ * ascii.c: (macro draw_line) Fixed capitalization.
+
+ * ascii.c, autorecode.c, cases.c, cmdline.c, command.c, common.c,
+ compute.c, count.c, data-in.c, data-list.c, data-out.c,
+ descript.q, dfm.c, display.c, do-if.c, error.c, expr-evl.c,
+ expr-opt.c, expr-prs.c, file-handle.q, file-type.c, filename.c,
+ formats.c, frequencies.q, get.c, getline.c, glob.c, groff-font.c,
+ hash.c, heap.c, include.c, inpt-pgm.c, lexer.c, list.q, loop.c,
+ main.c, mis-val.c, misc.c, modify-vars.c, numeric.c, output.c,
+ postscript.c, print.c, q2c.c, recode.c, rename-vars.c, repeat.c,
+ sample.c, sel-if.c, sfm-read.c, sfm-write.c, sfmP.h, som-frnt.c,
+ som-high.c, som-low.c, sort.c, split-file.c, sysfile-info.c,
+ temporary.c, title.c, tokens.h, val-labs.c, var-labs.c,
+ vars-atr.c, vars-prs.c, vector.c, vfm.c, weight.c: Marked strings
+ for internationlization.
+
+ * glob.c: [HAVE_LOCALE_H] Includes locale.h.
+
+Sun Jun 1 23:31:18 1997 Ben Pfaff <blp@gnu.org>
+
+ * do-if.c, sort.c, val-labs.c: Comment fixes.
+
+ * glob.c: (init_glob) Uncommented, updated i18n support.
+
+ * arena.c, ascii.c, data-in.c, descript.q, error.c, expr-evl.c,
+ expr-opt.c, expr-prs.c, filename.c, frequencies.q, groff-font.c,
+ output.c, postscript.c, sfm-read.c, som-high.c, vars-prs.c: Made
+ the declarations of macros taking arguments a lot nicer.
+
+Sun Jun 1 17:22:04 1997 Ben Pfaff <blp@gnu.org>
+
+ * error.h: Removed CE, CW aliases for SE, SW.
+
+ * q2c.c: Removed explicit streq() definition since it's duplicated
+ in str.h.
+
+ * approx.h, error.h, font.h, hash.h, misc.h, output.h, somP.h,
+ stats.h, str.h, tokens.h: Made the declarations of macros taking
+ arguments a lot nicer-looking of <pinard@iro.umontreal.ca>.
+ Comment fixes.
+
+Sun Jun 1 12:02:06 1997 Ben Pfaff <blp@gnu.org>
+
+ * cmdline.c: Comment fixes.
+ (pick_compat) Changed return type to int. Now, instead of setting
+ glob var `compat' to the emulation, returns the emulation. All
+ references changed.
+ (parse_command_line) Added terminating null to end of
+ `long_options' array definition.
+ (pre_syntax_message) Fixes.
+ (usage) Shows the default emulation in the syntax message by
+ calling pick_compat().
+
+ * getline.c: (getl_add_include_dir) Separates paths with
+ PATH_DELIMITER, not DIR_SEPARATOR.
+
+ * glob.c: (init_glob) Fixed references to DEFAULT_VER_PCP40,
+ DEFAULT_VER_WIN61, DEFAULT_VER_X40.
+
+ * output.c: (outp_configure_macro) Make earlier definitions for a
+ particular key override later ones for the same key.
+
+Fri May 30 19:40:49 1997 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: Comment fixes.
+
+ * output.c: (outp_get_paper_size)
+ s/STAT_OUTPUT_INIT_FILE/STAT_OUTPUT_PAPERSIZE_FILE/.
+
+Sun May 25 22:34:07 1997 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c, postscript.c, sfm-read.c, sfm-write.c, sort.c: Include
+ <errno.h>. GNU libc 2 enforces this!
+
+ * command.c: (parse_cmd) Fixed problem with `else' clause being
+ paired with wrong `if'. Comment fix.
+
+Fri May 9 16:53:52 1997 Ben Pfaff <blp@gnu.org>
+
+ * getline.c: [!HAVE_LIBREADLINE] (read_console) Changed
+ blp_getline() to getline().
+
+ * output.c: (outp_eval_dimension) Changed the fix from last time;
+ there was no variable `a'.
+
+ * q2c.c: (get_line) Fixed boundary condition overrun bug.
+
+Mon May 5 21:58:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * output.c: (outp_evaluate_dimension) Fixed handling of negative
+ numbers having fractional parts. Added case of a fraction without
+ a whole-number part.
+
+Fri May 2 22:08:05 1997 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: (ascii_text_get_font_position) Removed.
+
+ * expr.h, exprP.h: Disabled debugging.
+
+ * groff-font.c, postscript.c: Changed `groff' to `Groff' in
+ several places.
+
+ * output.h: (struct outp_class_struct) Removed
+ text_get_font_position method. All references deleted.
+
+ * postscript.c: Big change here. Fontmaps were completely
+ eliminated because of a change in philosophy. Comment fixes.
+ (struct ps_fontmap, ps2dit_map, font_family, dit2family_map)
+ Removed.
+ (struct ps_driver_ext) `position', `fontmap', `prop_name',
+ `fixed_name' members removed. New members `prop_family',
+ `fixed_family'. `family' member changed to type char *.
+ (static var ps_fontmaps) Removed.
+ () Removed.
+ (ps_init_driver) Removed obsolete references, updated.
+ Initializes `translate_x', `translate_y', `scale'. Doesn't read
+ fontmap, of course. Refers to font names through internal_name
+ rather than subversive means. Frees proper items.
+ (static var option_tab[]) Removed `fontmap-file' option; renamed
+ `fixed-font', `prop-font'.
+ (ps_option) Corresponds to option_tab[].
+ (read_fontmap, release_fontmap, ps_to_dit, compare_ps2dit,
+ hash_ps2dit, compare_dit2family, hash_dit2family, compare_family,
+ hash_family) Removed.
+ (postopen) Generates font names from family names. Gets
+ PostScript font name properly. New prologue file comment `!!!'
+ style.
+ (ps_open_page) Adds translate_x, translate_y to BP prologue
+ function; gives SF argument floating-point format.
+ (ps_text_set_font_by_name) Doesn't try to map PostScript->Groff
+ font name. Doesn't change font family.
+ (ps_text_set_font_by_position) Generates Groff font name from font
+ family name instead of through table lookup.
+ (ps_text_set_font_by_family) Renamed `ps_text_set_font_family',
+ all references changed. Reduced to simple string assignment.
+ (ps_get_font_name) Removed.
+ (ps_get_font_family) Reduced to string return.
+ (text) Doesn't save `position' since it no longer exists. Ugly
+ kluge to save font family--fix soon?
+ (load_font) Removed PostScript name argument.
+
+Thu May 1 14:58:59 1997 Ben Pfaff <blp@gnu.org>
+
+ * postscript.c: Comment fix.
+ (ps_open_page) Puts scale factor in PostScript output.
+
+Sat Apr 26 11:49:32 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Distcleans q2c.
+
+Wed Apr 23 21:33:48 1997 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: (delineate) Sets text size even if width is zero.
+
+ * command.c: Comment fix.
+ (static var cmd_table[]) Re-enabled EVALUATE command.
+ (parse_cmd) Lotsa comment fixes. Fixed infinite loop in parsing
+ of comments in script files. Now more liberal on criteria for
+ performing a state transition--if *anything* happened correctly,
+ not just if *everything* happened correctly.
+
+ * data-out.c: (convert_F) Comment fix. Why in the fsck does
+ Checker segfault on formatting large numbers and why in the fsck
+ hadn't I noticed this before?
+
+ * expr.h, exprP.h: No longer turn off GLOBAL_DEBUGGING.
+
+ * list.q: (cmd_list) Commented out the actual output routine
+ because of various problems. Probably will abandon the idea of
+ using the general `crushed tables' for the LIST procedure.
+
+ * temporary.c: (restore_dictionary) Sets var_by_name to NULL after
+ clearing it. Allocates a new var_by_name dictionary before trying
+ to add members to it.
+
+ * vars-atr.c: [DEBUGGING] (dump_one_var_node) Removed argument
+ `sib'. Changed type of `node' argument.
+ [DEBUGGING] (dump_var_tree) Replaced avlwalk() with
+ avl_walk_inorder().
+ (clear_variable) Only dumps the var tree if var_by_name non-NULL.
+ [DEBUGGING] Only deletes the variable from var_by_name if that var
+ non-NULL.
+
+Fri Apr 18 16:48:41 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added include files to SOURCES. Added
+ frequencies.q to EXTRA_DIST. Removed include/ from INCLUDES. Now
+ includes rules for q2c. Added `boast' target.
+
+Fri Apr 18 15:42:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Maintainer-clean Makefile.in.
+
+ * Makefile.am: Fixed redundant EXTRA_DIST line.
+
+ * ascii.c: Comment fixes.
+ (ascii_line_vert) Fixed overly aggressive range check.
+
+ * display.c: Removed dead code.
+
+ * list.q: Turn debugging on.
+ (flush_table) New debug code.
+
+ * sfm-read.c: (read_value_labels) malloc's the structure before
+ trying to assign to its members.
+
+ * sfm-write.c: Comment fix.
+
+ * som-high.c: (som_submit_table) Sets som.t and som.d on each call
+ to output_table().
+ (output_table) No arguments anymore--gets them through `som'
+ global. New debug code. In crushed tables, now sets `htv' as
+ well as `hv' to avoid bad confusion later.
+ (dump_crush_page) New debug code.
+
+ * som-low.c: (som_dump_crush_page) New debug code.
+
+Thu Mar 27 01:11:29 1997 Ben Pfaff <blp@gnu.org>
+
+ All source files: Broke long lines into multiple lines.
+
+ * ascii.c: (ascii_close_page) Uses host_system var in place of
+ HOST_SYSTEM constant.
+
+ * cmdline.c: (var syntax_message[]) Broke into
+ pre_syntax_message[] and post_syntax_message[].
+ (usage) Outputs both parts, separated by driver list.
+
+ * error.h: Fixed broken formatting.
+
+ * expr-opt.c: (str_search, str_rsearch) New functions.
+
+ * misc.c: (blp_getdelim) Removed. All references changed to
+ `getdelim'.
+ (str_search, str_rsearch) Removed.
+ (memrmem) New function.
+
+ * misc.h: (blp_getline) Removed. All reference changed to
+ `getline'.
+
+ * stat.h: New file.
+
+ * filename.c: Includes "stat.h", not <sys/stat.h>.
+ (blp_getenv) Uses host_system var instead of HOST_SYSTEM constant.
+
+ * output.c: (outp_list_classes) Changed output formatting.
+
+ * sfm-write.c: (write_header) Uses host_system var instead of
+ HOST_SYSTEM constant.
+ (write_rec_7_34) Extracts version numbers from the version string.
+ Untested.
+
+ * sort.c: Includes "stat.h", not <sys/stat.h>.
+
+ * str.c: (strcasecmp) Removed.
+
+ * title.c: (cmd_document) Uses host_system var instead of
+ HOST_SYSTEM constant.
+
+ * version.c: Generated on-the-fly by the Makefile instead of being
+ static.
+
+ * str.h: Comment fixes. Doesn't substitute for missing memmove or
+ memcpy.
+ [!HAVE_STRNCASECMP] Declares strncasecmp().
+
+ * version.h: Removed stray character. Comment fixes.
+ (vars host_system, build_system) New vars.
+
+Mon Mar 24 21:47:31 1997 Ben Pfaff <blp@gnu.org>
+
+ * Most source files: Changed formatting of copyright notice; fixed
+ FSF address; reformatted to better conform to GNU standards;
+ comment fixes. Added markups to prevent GNU indent from messing
+ up my beautiful formatting :-).
+
+ * q2c.c: (get_line) Ignores lines that begin with `/* *INDENT' so
+ that GNU indent markups can be passed through without problems.
+
+Wed Feb 19 21:30:31 1997 Ben Pfaff <blp@gnu.org>
+
+ * get.c: Turned off debugging.
+
+ * glob.c: (init_glob) Turned on save-file compression by default.
+
+ * sfm-write.c: (sfm_write_case) Fixed bug which resulted in less
+ compression than was possible in save files.
+
+Sun Feb 16 20:57:20 1997 Ben Pfaff <blp@gnu.org>
+
+ * data-out.c: (convert_F) Comment fixes. Debug message fixes.
+
+ * frequencies.q: Removed Fiasco extensions. Updated calculation
+ algorithms. Polished output format.
+ (struct frq_info_struct) Removed members `max_degree', `min_n',
+ all references removed.
+ (macro frq_extensions) Removed.
+ (static vars min_n, max_degree) Removed, all references removed.
+ (internal_cmd_frequencies) Doesn't handle extensions. Doesn't
+ calculate `min_n', `max_degree'.
+ (postcalc) Passes new arg to dump_statistics().
+ (dump_full) Honor NOLABEL option. Buggy? Adds variable name
+ title.
+ (dump_condensed) Adds variable name title.
+ (sum_freqs) Removed.
+ (calc_stats) Updated calculation algorithm.
+ (dump_statistics) Removed warning for too-few observations.
+ Changed table formatting. Adds variable name title if passed new
+ arg is nonzero.
+
+ * output.h: Comment fix.
+
+ * recode.c, sample.c, sort.c: Disabled debug code.
+
+ * som-frnt.c: (som_set_value, som_set_float, som_set_text)
+ Improved debug code.
+
+ * var.h: (enum series frq_*) Removed Fiasco extensions.
+
+Sat Feb 15 21:26:53 1997 Ben Pfaff <blp@gnu.org>
+
+ * command.c: Added PROCESS IF to command table.
+
+ * Lots & lots of places, removed checks for NULLs preceding calls
+ to free_expression(), which itself checks.
+
+ * descript.q: Removed Fiasco extensions. Removed optimizations
+ for non-weighted active files. Implemented some options.
+ Finished polishing output format. Comment fixes. Merged
+ `descript.g'.
+ (static vars n_glob_miss_list, n_glob_valid, n_glob_missing,
+ max_degree, min_n) Removed.
+ (macro dsc_extensions) Removed.
+ (struct dsc_info_struct) Removed `min_n' member, all references
+ fixed.
+ (internal_cmd_descriptives) Removed calculation of min_n,
+ max_degree. Only deals with one `calc' routine instead of two
+ flavors.
+ (precalc) Eliminated redundancy. Updated for changes to
+ descriptives_proc structure.
+ (calc) Moved here from `descript.g'. Rewritten to calculate
+ statistics via `moments about the mean' rather than by summing,
+ summing squares, summing cubes, and so on.
+ (postcalc) Rewritten for new-style statistical calculation.
+ (display) Removed support for displaying variables across rows.
+ No longer crushes the descriptives table. Removed ancient code.
+ Added display of N, by variable and listwise.
+
+ * descript.g: Removed; merged into `descript.q'.
+
+ * expr-evl.c: (evaluate_expression) Now returns a double. For
+ numeric results, it returns the result as well as storing it in
+ the passed `value' structure if non-NULL. For string results it
+ just returns 0.0 and it must be passed non-NULL. Many references
+ to this function were optimized by use of this change, especially
+ but not exclusively in `compute.c'.
+
+ * frequencies.g: Comment fix.
+
+ * glob.c: (glob var process_if_expr) New global var.
+
+ * postscript.c: (static var option_tab[]) Corrected entry for
+ `fixed_size'.
+ (postopen) Sets x->size to x->prop_size.
+ (ps_text_set_font_by_name) Sets font size as well as typeface for
+ PROP and FIXED fonts.
+
+ * sel-if.c: (cmd_process_if) New function.
+
+ * sfm-write.c: (struct sfm_fhuser_ext) New member `n_cases'.
+ (sfm_write_dictionary) Sets `n_cases' to 0.
+ (sfm_write_case) Increments `n_cases'.
+ (sfm_close) Attempts to seek the system file back to the header
+ and write the number of cases in its proper slot.
+
+ * som-frnt.c: (som_insert_table) Masks off expansion options since
+ only SOPT_X_NORM seems to work sensibly.
+
+ * som-low.c: (get_cell_size) Fixed bug when a table cell was sized
+ with a `fixed' value of 2.
+
+ * sort.c: (cmd_sort_cases) Cancels PROCESS IF.
+
+ * sysfile-info.c: (cmd_sysfile_info) Doesn't display more than 10
+ value labels; uses SOPT_NONE instead of SOPT_X_BOTH.
+
+ * var.h: (enum series dsc_*) Removed Fiasco extensions.
+ (struct descriptives_proc) Removed `miss_noweight'; new members
+ `X_bar', `M2', `M3', `M4', `min', `max'.
+
+ * vars-atr.c: (discard_variables) Cancels PROCESS IF.
+
+ * vfm.c: (close_active_file) Cancels PROCESS IF.
+ (write_case) Doesn't process cases unselected by PROCESS IF.
+
+Fri Feb 14 23:32:58 1997 Ben Pfaff <blp@gnu.org>
+
+ * glob.c: (glob var err) Removed.
+
+ * sysfile-info.c: (cmd_sysfile_info) When adjusting table size,
+ doesn't have to take into account number of value labels since
+ they're in a subtable anyway. Also, doesn't display more than 10
+ value labels since we can't yet break pages in subtables.
+
+Tue Feb 4 15:15:50 1997 Ben Pfaff <blp@gnu.org>
+
+ * som-frnt.c: (som_change_table_size) Simple change for elegance
+ that shouldn't change behavior.
+ (som_set_value) Comment fix.
+
+ * som-high.c: (som_submit_table) Message fix.
+
+Wed Jan 22 21:54:00 1997 Ben Pfaff <blp@gnu.org>
+
+ * command.c: Added SYSFILE INFO to command table.
+
+ * file-handle.q: (fh_handle_filename) New function.
+
+ * get.c: (save_trns_proc) Fixed a bug in padding of output data
+ with spaces.
+
+ * main.c: (parse) New return value for command functions, -3.
+
+ * misc.h: Comment fix.
+
+ * output.h: Comment fixes.
+ (macro COMPONENTS) Removed.
+
+ * postscript.c: (write_text) Modified literal_chars[] so that `('
+ and ')' are not written to the output in strings as literals.
+
+ * sfm-read.c: (sfm_read_dictionary) New argument.
+ (read_header) New argument. Sets the information structure's
+ values from the header information.
+ (read_variables) [__CHECKER__] Redefines isalnum()--some sort of
+ bizarre Checker problem, I guess.
+ (read_variables) Proper cleanup on lossage.
+
+ * sfm.h: (struct sfm_read_info) New struct for use by
+ sfm_read_dictionary().
+
+ * som-frnt.c: (som_create_table) New argument CREATE_FLAGS,
+ currently used just for tables that can be dynamically resized and
+ thus have to be allocated with arena_malloc() instead of
+ arena_alloc(). All references changed.
+ (som_change_table_size) New function.
+ (som_insert_table) Bugfix: now inserts `cell', not `c'!
+
+ * som-high.c: [GLOBAL_DEBUGGING] (check_table) Moved to som-low.c.
+ (som_submit_table) [GLOBAL_DEBUGGING] Doesn't call check_table()
+ any more.
+
+ * som-low.c: (draw_cell) Calls draw_table_cell() for SCON_TABLE
+ cells.
+ (draw_intersection) Now takes an argument specifying the table in
+ question. All references changed.
+ (draw_table_cell) New function.
+ (som_get_table_size) [GLOBAL_DEBUGGING] Calls check_table().
+ (som_get_table_size) Many nice new explanatory comments.
+ [GLOBAL_DEBUGGING] (check_table) Moved here from som-high.c.
+
+ * som.h: New enum series SOM_CREATE_* for use as create flags with
+ som_create_table().
+
+ * str.h: Moved a comment here from TODO.
+
+ * sysfile-info.c: New file. Reference implementation.
+
+Sun Jan 19 14:22:11 1997 Ben Pfaff <blp@gnu.org>
+
+ * command.c: Added RENAME VARIABLES to table of commands.
+
+ * data-in.c: (dls_error) Sets `cust_field'.
+ (parse_N) Message fix.
+ (parse_day_count) New function.
+ (to_roman) Never outputs VX as a `short form' of V.
+ (parse_month) Fixed parsing of Roman numerals.
+ (parse_trailer) Message fix.
+ (parse_DATE, parse_ADATE, parse_EDATE, parse_SDATE, parse_JDATE,
+ parse_QYR, parse_MOYR, parse_WKYR, parse_DTIME) Issue a message if
+ the date is invalid.
+ (parse_SDATE) Fixed swapped day, year.
+ (parse_JDATE) Fixed bug for dates in 1582.
+ (parse_DTIME) Allows days not between 1 and 31.
+ (parse_numeric) Makes local copy of f.type for easier usage.
+ FMT_DOLLAR fixed.
+
+ * data-out.c: (convert_F) When outputting as scientific, properly
+ sets f.type as fp->type.
+ (insert_commas) Fixed operator precedence problem with setting of
+ nitems. Changed strcpy to memcpy (no null terminator).
+ (convert_date) Fixed FMT_JDATE: added 1900 to year.
+ (convert_CCx) Essentially rewritten, but now it works.
+
+ * display.c: (cmd_display) Added DISPLAY FILE LABEL (undocumented
+ feature of Fiasco).
+ (display_documents) Implemented.
+
+ * error.c: (glob var cust_field) New var.
+ (vmsg) Displays cust_field as part of message classes DE and DW.
+
+ * formats.c: (debug_print) Fixed to compile under updated
+ dictionary format.
+
+ * get.c: (cmd_get, cmd_save_internal) Close file handle on
+ failure.
+
+ * misc.c: (parse_format_specifier) Formatting fix.
+
+ * modify-vars.c: (struct var_modification) Renamed `n_reorder' as
+ `n_rename' for clarity.
+ (cmd_modify_vars) Initializes `forward' and `positional' at
+ appropriate times. Frees lists of vars to rename on failure.
+ Comment fix. Frees memory on success.
+ (rearrange_dict) Simplified `for' loop condition.
+
+ * rename-vars.c: New file (reference implementation).
+
+ * set.q: (internal_cmd_set) Fixed `emu' test condition.
+
+ * sfm-read.c: (read_header) File label is created only if file
+ label in file is not blank.
+ (read_variables) Initializes `dict' local variable.
+ (read_documents) Proper behavior on lossage.
+
+ * sfm-write.c: (write_header) Doesn't blank out the file label
+ (why was this here to begin with?!)
+
+ * temporary.c: (save_dictionary) File label is copied only if
+ non-NULL. Doesn't try to xstrdup() dictionary documents.
+ Adapted so as to not irritate Checker.
+ (free_dictionary) Only destroys var_by_name if non-NULL.
+
+ * title.c: (cmd_file_label) Doesn't skip FILE, LABEL tokens.
+ (cmd_document) Doesn't skip DOCUMENT token. Adds some header
+ lines to the document, indents the document. Also, it works now.
+ (add_document_line) New function.
+
+ * var.h: (struct dictionary) Reordering.
+
+ * vars-prs.c: (parse_variables) On lossage, only local_free()'s
+ bits if it was allocated to begin with.
+
+Thu Jan 16 13:08:57 1997 Ben Pfaff <blp@gnu.org>
+
+ * command.c: Added MODIFY VARS to list of commands.
+
+ * configure.in: Updated custom macros for autoconf 2.12. Removed
+ mmap reference; fixed termcap library reference.
+
+ * display.c: (display_variables) Fixed a few bugs although it's
+ still not well written.
+
+ * error.c: [!__CHECKER__] (chkr_disp_call_chain) New function.
+ (induce_segfault) Calls chkr_disp_call_chain() instead of
+ inducing an actual SIGSEGV.
+
+ * expr-opt.c: (evaluate_tree) Swapped order of arguments to
+ str_search() and str_rsearch(). Fixed tests for matches on
+ OP_INDEX and OP_RINDEX.
+
+ * filename.c: (good_getcwd) Removed as the new libc for Checker
+ doesn't contain this bug, apparently.
+
+ * misc.c: (str_search, str_rsearch) Changed order of arguments for
+ consistency with GNU memmem.
+ (blp_getdelim) Changed `len' from `int' to `size_t'.
+
+ * modify-vars.c: Reference implementation.
+
+ * som-frnt.c: (zero_length) New global var.
+ (som_create_table) Message fix.
+
+ * som.h: Added gcc attributions to som_set_text(),
+ som_output_text() prototypes. blank_line() refers to
+ zero_length[] instead of a literal null string to suppress gcc
+ warnings.
+
+ * sort.c: (do_external_sort) Fixed fencepost error on lossage.
+ (allocate_cases) Decrements x_max so the last element of x[] can
+ be used by the algorithm.
+
+ * var.h: Changed minor details of `variable' declaration.
+ (struct modify_vars_proc) New struct.
+ (struct variable) Added field p.mfv.
+
+ * vars-atr.c: Comment fix.
+
+ * vars-prs.c: (fill_all_vars) More optimal implementation.
+
+ * vfm.c: (dump_splits) Sets the last byte of temp_buf to a null
+ character, which it shouldn't have to do but printf() seems to
+ read the null byte even though I supply a maximum length...
+
+Fri Jan 10 20:22:08 1997 Ben Pfaff <blp@gnu.org>
+
+ * command.c: Removed command alias X for QUIT.
+ (parse_cmd) Fixed comment parsing.
+
+ * dfm.c: (struct dfm_fhuser_ext) Fields `len', `size' are now of
+ type size_t.
+ (read_record) Fixed references to len, size.
+ (dfm_get_record) Restructured.
+
+ * file-handle.h: (struct file_handle) Field `lrecl' now of type
+ size_t.
+
+ * file-handle.q: (internal_cmd_file_handle) Checks for nonpositive
+ record length.
+
+ * modify-vars.c: New file. Not complete.
+
+ * set.q: (set_ccx) Fixed operator precedence problem regarding ^
+ and ==.
+
+ * sfm-read.c: (bswap_flt64, read_header, write_variable) Fixed
+ problems caused by int/size_t differences.
+
+ * sort.c: (output_record, merge_once) Cast `size_t's to `int's in
+ appropriate spots.
+
+ * str.c: (strcasecmp) Fixed bug that cropped up when the strings
+ being compared were of equal length.
+
+Thu Jan 2 19:08:23 1997 Ben Pfaff <blp@gnu.org>
+
+ * command.c: Added DOCUMENT, DROP DOCUMENTS, FILE LABEL.
+
+ * lexer.c: (get_dotted_rest_of_line) New function.
+
+ * sel-if.c: (cmd_filter) Cannot choose string or scratch variables
+ as filters.
+
+ * sfm-read.c: (sfm_read_dictionary) Calls read_documents() to read
+ type 6 records. Frees the dictionary properly.
+ (read_header) Initializes the dictionary instead of letting
+ read_variables() do it. Sets the dictionary file label from the
+ system file.
+ (read_documents) New function.
+
+ * sfm-write.c: (sfm_write_dictionary) Calls write_documents() to
+ write type 6 record if appropriate.
+ (write_header) Writes file label from dictionary.
+ (write_documents) New function.
+
+ * temporary.c: (save_dictionary, restore_dictionary,
+ free_dictionary) Properly handle new fields in dictionary struct.
+
+ * title.c: (get_title) Returns after failure().
+ (cmd_file_label, cmd_document, cmd_drop_documents) New functions
+ for new commands FILE LABEL, DOCUMENT, DROP DOCUMENTS. Untested.
+
+ * var.h: (struct dictionary) New fields `label', `n_documents',
+ `documents'.
+
+Wed Jan 1 22:08:10 1997 Ben Pfaff <blp@gnu.org>
+
+ * command.c: Added FILTER to list of commands.
+
+ * frequencies.g: [WEIGHTING] Removed test for weighting!=-1 since
+ it's always true.
+
+ * get.c: (cmd_save_internal) Removed weighting code since it's now
+ handled by sfm-write.c. Properly commented out debug code.
+
+ * glob.c: (glob var weighting) Removed.
+
+ * sel-if.c: Comment fixes.
+ (cmd_filter) New function.
+
+ * sfm-read.c: (struct sfm_fhuser_ext) New field `weight_index'.
+ (sfm_read_dictionary) Sets weighting variable direct in the
+ created dictionary now. (Apparently we previously didn't support
+ weighting on GET?)
+ (read_header) Sets weight_index field in sfm_fhuser_ext from
+ header read from disk.
+
+ * sfm-write.c: (sfm_write_dictionary) Comment fix.
+ (write_header) Now sets the weighting in the header from the
+ passed primary dictionary instead of from the sfm_write_info.
+
+ * sfm.h: (struct sfm_write_info) Removed field `weight'.
+
+ * som-high.c: (dump_crush_table) Fixed a couple of assertions that
+ broke on boundary conditions.
+
+ * var.h: (struct dictionary) New fields `weight_var',
+ `weight_index', and `filter_var'.
+ (glob var weighting) Removed. This is now part of struct
+ dictionary. All references changed; the less mechanical changes
+ are described above.
+
+ * vars-atr.c: (find_dict_variable) New function.
+
+ * vfm.c: (static var filter_index) New variable.
+ (open_active_file) Initializes filter_index from default_dict.
+ (write_case) Calls proc_func() only if the filter variable is
+ nonzero; this implements FILTER behavior.
+
+ * weight.c: (static var weight_varname) Removed.
+ (cmd_weight) Modified default_dict instead of glob vars.
+ (update_weighting) Changed the signature to modify a dictionary
+ instead of glob vars. Now returns the weighting variable.
+ (get_weighting_variable) Removed; its function is absorbed by
+ update_weighting().
+ (stop_weighting) Operates on a dictionary now.
+
+Wed Jan 1 17:00:59 1997 Ben Pfaff <blp@gnu.org>
+
+ * sort.c: Removed debugging info from messages.
+ (do_external_sort) Cleans up after itself by deleting the
+ temporary directory on failure. (On success it is deleted by the
+ input program.)
+ (allocate_cases) Removed debug code. Added clean up code.
+ (output_record) Removed debug code.
+ (merge) Added code to close all the input files that are currently
+ open. This is a likely location for bugs, because I'm not sure
+ about boundary conditions. Removed an unnecesary heap_delete().
+ (merge_once) Removed input file "optimization" that in fact
+ screwed up the rest of the code. Message and comment fixes.
+
+Sun Dec 29 21:36:48 1996 Ben Pfaff <blp@gnu.org>
+
+ * error.c: [__CHECKER__] (induce_segfault) Flushes output streams.
+
+ * heap.c: (heap_delete) New argument.
+
+ * sort.c: Finished implementation of external sort.
+
+ * vfm.c: (read_from_disk) Returns after a disk error.
+
+Sun Dec 22 23:10:39 1996 Ben Pfaff <blp@gnu.org>
+
+ * sort.c: (static var state) Removed.
+ (static vars max_handles, tmp_basename, tmp_extname,
+ huffman_queue) New variables.
+ (do_external_sort) Moved most code to new functions.
+ Creates huffman_queue.
+ (allocate_file_handles, allocate_cases) New functions.
+ (static vars run_no, run_length, file_index, case_count) New
+ variables.
+ (output_record) Returns success. Now really writes to the output
+ file.
+ (begin_run, end_run) New functions.
+ (write_initial_runs) Returns success. Initializes run_no to -1.
+ Calls begin_run(), end_run() at appropriate times. Outputs debug
+ messages.
+ (write_to_sort_cases) Calls begin_run(), end_run() at appropriate
+ times.
+ (merge) New function.
+
+ * heap.c, heap.h: New files. Hopefully in near-final form.
+
+Sat Dec 21 21:51:04 1996 Ben Pfaff <blp@gnu.org>
+
+ * glob.c: Added write_active_file to global vars.
+
+ * sort.c: Several new miscellaneous static variables.
+ (cmd_sort_cases) Big comment fix.
+ (perform_case_2) Renamed `do_external_sort' and completely
+ rewritten.
+ (case_2_proc_func) Removed.
+ (output_record, write_initial_runs, write_to_sort_cases,
+ compare_record) New functions.
+
+ * vfm.c: [DEBUGGING] (index_to_varname) Excised bit rot.
+
+Tue Dec 17 18:57:59 1996 Ben Pfaff <blp@gnu.org>
+
+ * sort.c: (perform_case_2) Changed the method for allocation of
+ lots of memory--now allocates one case at a time in hopes that
+ more cases can be allocated with heavily fragmented memory.
+
+ * var.h: (write_active_file) New global var.
+
+ * vfm.c: (procedure, close_active_file, write_case,
+ SPLIT_FILE_procfunc) Now allow beginfunc, procfunc, and endfunc
+ arguments to procedure() to be NULL. All references to
+ procedure() that made use of dummy functions were changed to NULL
+ functions.
+ (open_active_file) If write_active_file is non-NULL, the output
+ device becomes DEV_PGM (a new enum).
+ (close_active_file) Sets write_active_file to NULL.
+ (read_from_memory) Comment fix.
+ (record_case) Calls write_active_file() when the output device is
+ DEV_PGM.
+
+Sun Dec 15 15:32:16 1996 Ben Pfaff <blp@gnu.org>
+
+ * sort.c: New file.
+
+ * autorecode.c: (cmd_autorecode) Fixed parsing of options.
+ Fixed checking for duplicate varnames.
+ (recode) xmalloc()'s the transformation instead of arena_alloc()'ing
+ it.
+ (autorecode_trns_free) Destroys hash tables for each recoding
+ specification.
+ (autorecode_proc_func) Compares NULL to *vpp instead of vpp.
+
+ * command.c: Added SORT CASES to cmd_table.
+ (null_func, null_int_func) Prototyped.
+
+ * descript.g: (calc_weight, calc_noweight) Computes own case
+ number now.
+
+ * frequencies.q: (dump_statistics) Fixed problem with
+ too-few-cases warning message.
+
+ * get.c: (cmd_save_internal) Handles weighting properly.
+
+ * hash.c: (hsh_dump) Output format changed.
+ (force_hsh_insert) Actually works now, prototype changed.
+
+ * list.q: (static var case_num) New variable.
+ (cmd_list) Initializes case_num.
+ (list_cases) Increments case_num.
+
+ * var.h: Added definitions for SORT CASES. Comment fixes.
+
+ * vfm.c: Some definitions moved to new file vfmP.h. Comment
+ fixes. `active' renamed vfm_active, `rep' renamed
+ vfm_replacement, all references changed.
+ (procedure) The procfunc no longer receives a case number. All
+ references changed.
+ (write_case) Subtle reordering.
+ (SPLIT_FILE_procfunc) Counts cases differently. Slightly less
+ redundant.
+
+ * weight.c: (get_weighting_variable) New function.
+
+ * vfmP.h: New file with definitions from vfm.c.
+
+Sat Dec 14 10:35:30 1996 Ben Pfaff <blp@gnu.org>
+
+ * command.c: (FILE_TYPE_okay) Commented out some tests because
+ they're clumsy and not yet needed.
+
+ * var.h: Most *_trns structures moved to their respective source
+ files. Some were moved into a new file, do-ifP.h. Comment fixes.
+ (union any_trns) Changed to a typedef for trns_header.
+ (struct input_program_pgm) Removed.
+
+ * vars-prs.c: (parse_variables) Only local_free()'s bits if it
+ was allocated in the first place.
+
+Fri Dec 13 21:30:53 1996 Ben Pfaff <blp@gnu.org>
+
+ * autorecode.c: New file.
+
+ * command.c: Added AUTORECODE to command table; re-enabled SET.
+
+ * data-out.c: (convert_F) Handles infinities and NaNs properly.
+
+ * error.c: (vmsg) Comment fixes.
+
+ * hash.c: Comment fix.
+ (hashpjw_d) New function.
+ (hashpjw) Reimplemented as call to more general function
+ hashpjw_d().
+ (internal_comparison_fn) Initializes pointers properly.
+ (hsh_sort) [GLOBAL_DEBUGGING] New debugging code.
+ (force_hsh_insert, force_hsh_find) New debugging wrapper
+ functions.
+
+ * main.c: (main) Message fix.
+
+ * output.c: (outp_read_devices) Message fix.
+
+ * set.q: Comment fixes.
+ (custom_results) Implemented Wnd/X form of subcommand.
+ (set_routing) New function.
+ (internal_cmd_set) Implemented ERRORS, MESSAGES.
+
+ * settings.h: (SET_ROUTE_*) New enum series.
+ (set_results) Renamed set_results_file, all references changed.
+ (set_messages) Removed.
+ (glob vars set_errors, set_messages, set_results) New vars.
+
+ * title.c: (get_title) Remembers to xstrdup() the result of
+ get_rest_of_line().
+
+ * var.h: (arc_item, arc_spec, autorecode_trns) New structures for
+ use by AUTORECODE.
+ (union any_trns) New element `arc'.
+
+Fri Dec 6 23:53:47 1996 Ben Pfaff <blp@gnu.org>
+
+ * command.c: (output_line) Removed references to set_screen.
+
+ * error.c: (static var terminating) New var.
+ (hcf) Sets terminating to 1.
+ (vmsg) If terminating is nonzero, does not attempt to call hcf().
+ This prevents an infinite loop if an error occurs within hcf().
+
+ * expr-evl.c: (evaluate_expression) [__CHECKER__] Replaced case
+ statement circumlocution with `case 42000' trick.
+ (evaluate_expression) New support for OP_STR_MIS.
+
+ * expr-opt.c: (evaluate_expression) [__CHECKER__] Replaced case
+ statement circumlocution with `case 42000' trick.
+ (dump_node) Handles OP_STR_MIS.
+
+ * expr-prs.c: (MISSING_func, SYSMIS_func) Rewrote to handle string
+ variables exceptions.
+ (parse_function) Message fix.
+ (ops[]) Added OP_STR_MIS.
+
+ * expr.h: Added OP_STR_MIS to OP_* enum. Comment fixes.
+
+ * exprP.h: [__CHECKER__] Removed case statement circumlocution.
+
+ * glob.c: Removed set_scrnfile glob var.
+ (init_glob) set_errorbreak set to 0 by default.
+
+ * groff-font.c: Changed included files.
+ (groff_read_font) Initializes font_arena local var correctly.
+ (default_font) New function.
+
+ * output.c: Comment fixes.
+ (glob var disabled_devices) New variable.
+ [GLOBAL_DEBUGGING] (static var iterating_driver_list) New
+ variable.
+ [GLOBAL_DEBUGGING] (reentrancy) New function.
+ [GLOBAL_DEBUGGING] (outp_read_devices, outp_done, find_driver,
+ outp_iterate_enabled_drivers) Calls to reentrancy().
+ (destroy_list) New function.
+ (outp_done) Moved code to destroy_list().
+ (parse_options) Parses `listing', `screen', `printer' options
+ internally.
+ (configure_driver) Sets new `device' member of driver.
+ (outp_iterate_enabled_drivers, outp_enable_device) New functions.
+
+ * output.h: Comment fixes. New enum series OUTP_DEV_*.
+ (struct outp_driver_struct) New member `device'.
+
+ * postscript.c: (find_encoding_file) Doesn't display its own error
+ messages.
+ (default_encoding) New function.
+ (switch_font) Calls default_encoding() if no encoding can be
+ found.
+ (text) Makes up a character metric if none exists for the desired
+ character.
+ (load_font) Properly copies a fallback filename. Calls
+ default_font() for a font if none at all are known.
+
+ * set.q: Comment fixes. Removed OUTPUT subcommand.
+ (custom_listing) Calls outp_enable_device() to enable/disable
+ listing device.
+ (turn_screen_on) Removed.
+ (internal_cmd_set) Calls outp_enable_device() to enable/disable
+ screen, printer devices.
+
+ * settings.h: Comment fixes.
+ (glob vars set_output, set_printer, set_screen, set_scrnfile)
+ Removed.
+
+ * som-high.c: (som_submit_table, som_eject_page) Use
+ outp_iterate_enabled_drivers() instead of iterating
+ outp_driver_list directly.
+
+Wed Dec 4 21:34:17 1996 Ben Pfaff <blp@gnu.org>
+
+ * data-in.c: (parse_EDATE, parse_SDATE) New functions.
+ (parse_string_as_format) Handles new formats.
+ (parse_numeric) Now handles DOT and PCT formats.
+
+ * data-out.c: (convert_E, convert_F, insert_commas) Handle DOT
+ format now.
+ (convert_date) Handle EDATE and SDATE formats.
+ (convert_CCx) Now if there's not room for the currency characters,
+ converts it as F format if it's positive instead of giving up
+ quickly. Also fixed save-and-restore bug with decimal point
+ characters.
+ (convert_format_to_string) Handles new formats.
+
+ * misc.c: (formats[]) Added new formats.
+ (convert_fmt_ItoO) Supports new formats.
+
+ * sfm-read.c: (parse_format_spec) Supports new formats. Better
+ data checking. New argument, all references changed.
+
+ * sfm-write.c: (write_format_spec) Supports new formats.
+
+ * var.h: New formats FMT_DOT, FMT_PCT, FMT_EDATE, FMT_SDATE.
+ Comment fixes.
+
+Sun Dec 1 17:19:00 1996 Ben Pfaff <blp@gnu.org>
+
+ * cmdline.c: Comment fixes.
+ (parse_command_line) Changed return type to void.
+
+ * data-in.c: (parse_string_as_format) Added FMT_CCA...FMT_CCE to
+ switch.
+ (parse_numeric) Handles international numbers (comma as decimal
+ point). Some reformatting.
+
+ * data-list.c: (parse_free) Default output format is now
+ set_format instead of hard-coded F8.2.
+ (read_from_data_list_list) Emits error message on undefined data
+ only if set_undefined is nonzero.
+
+ * data-out.c: (convert_E) Changes decimal point from period to
+ comma if appropriate. Restructured. Better comments.
+ (convert_F) Changes decimal point from period to comma if
+ appropriate.
+ (insert_commas) Major bug with handling of negative values fixed.
+ Also, inserts periods instead of commas if appropriate.
+ (convert_CCx) New function.
+ (convert_format_to_string) Added FMT_CCA...FMT_CCE to switch.
+ (num_to_string) Changed `.' to set_decimal.
+
+ * dfm.c: Comment fixes.
+ (dfm_close) Frees ext->line even in inline_file.
+ (open_inline_file) New function.
+ (open_file_r) When opening the inline file: now properly
+ recognizes `BEGIN DATA.' line, and calls open_inline_file() to
+ finish up.
+ (read_record) Calls fh_close_handle() instead of dfm_close() to
+ close the inline file. Makes a copy of the line getl_buf to avoid
+ interlock problems.
+ (dfm_get_record) Restructured. Now checks the return value of
+ open_file_r().
+ (cmd_begin_data) Moved open code into open_inline_file(). Relaxed
+ checking for use of inline file. No longer tries to close inline
+ file.
+
+ * error.c: (glob var error_already_flagged) New var.
+ (vmsg) Message change. Now checks max number of errors/warnings,
+ acts on it.
+
+ * file-handle.q: (fh_handle_name) Now allows closing of
+ inline_file.
+ (fh_init_files) Reformatted.
+
+ * get.c: (trim_dictionary) Checks SCOMP option instead of COMP.
+
+ * getline.c: (getl_include) Fixed bug that popped up when called
+ when file queue was empty.
+ (read_console) Resets error_count, warning_count,
+ error_already_flagged to zero.
+
+ * glob.c: Many changes to update list of variables.
+ (init_compat_dependent) Now this function is called whenever
+ `compat' changes. It now sets set_seed only if it hasn't
+ previously been referenced. It now calls
+ lex_init_compat_dependent().
+
+ * include.c: (cmd_include_at) Frees temporary buffer instead of
+ line buffer.
+ (cmd_include) Doesn't make copy of include file name.
+
+ * lexer.c: Comment fixes.
+ (init_lex) Moved some code into new function
+ lex_init_compat_dependent().
+ (lex_init_compat_dependent) New function.
+ (hex_val) Simplified.
+ (preprocess_line) Uses set_endcmd instead of hardcoding `.'.
+
+ * main.c: Comment fixes.
+ (main) Reformatted.
+
+ * misc.c: (formats[]) Added FMT_CCA...FMT_CCE.
+ (check_input_specifier) Disallows FMT_CCA...FMT_CCE.
+ (convert_fmt_ItoO) Detects FMT_CCA...FMT_CCE.
+ (setup_randomize) Sets set_seed_used.
+
+ * set.q: Comment fixes.
+ (custom_results) Conditionalizes on `compat'.
+ (custom_log) Calls custom_journal().
+ (set_ccx) New function.
+ (cmd_set) Calls init_compat_dependent() when `compat' changes.
+ Calls set_ccx() to handle CCA...CCE. Sets set_grouping
+ when set_decimal changes. Range-checks values for MITERATE,
+ MNEST. Message fixes.
+
+ * settings.h: Comment fixes.
+ (struct set_cust_currency) New struct.
+ (set_cc[], set_grouping, set_seed_used) New global vars.
+
+ * var.h: (FMT_CCA...FMT_CCE) New output formats.
+ (FCAT_OUTPUT_ONLY) New FCAT_* constant.
+
+Thu Nov 28 23:14:07 1996 Ben Pfaff <blp@gnu.org>
+
+ * glob.c: Revised variables to correspond to settings.h.
+ (init_glob) Initializes variables from settings.h properly.
+
+ * set.q: Began long-overdue major revision to correspond to new
+ philosophy. Most code changed.
+
+ * settings.h: Mostly changed; reorganized, reordered, large new
+ comment.
+
+Thu Nov 28 19:46:10 1996 Ben Pfaff <blp@gnu.org>
+
+ * get.c: (cmd_save_internal) No longer forces compression off.
+
+ * sfm-read.c: (read_compressed_data) If eof is reached when
+ reading a new instruction octet, only signal error if we're in the
+ middle of a case.
+
+ * sfm-write.c: (COMPRESSION_BIAS) New #define.
+ (struct sfm_fhuser_ext) New member `end'.
+ (write_header) Refers to COMPRESSION_BIAS instead of magic 100.0.
+ (ensure_buf_space) New function.
+ (sfm_write_case) Reimplemented in order to support compression.
+ (sfm_close) Writes out the remaining contents of the compression
+ buffer if any.
+
+Wed Nov 27 23:18:35 1996 Ben Pfaff <blp@gnu.org>
+
+ * command.c: Defined SAVE and XSAVE commands in command table.
+
+ * common.h: second_lowest_value is of type flt64, not double.
+
+ * file-handle.h: Comment fix.
+
+ * get.c: Comment fixes.
+ (static var `trns') New.
+ (save_write_case_func, save_trns_proc, save_trns_free, null_func,
+ cmd_save_internal, cmd_save, cmd_xsave) New functions.
+ (dict_delete_run) Clears the variables and frees them now.
+ (trim_dictionary) Sets default for compression.
+ On KEEP subcommand, frees deleted variables as well as clearing
+ them. Finally got the sense of the test for deleting all
+ variables correct.
+ [DEBUGGING] (dump_dict_variables) Message fix.
+
+ * glob.c: (init_glob) set_compression set to 1 by default.
+
+ * list.q: Properly #includes config.h.
+
+ * misc.h: New macro REM_RND_UP.
+
+ * settings.h: Comment fix.
+
+ * sfm-read.c: (structs sysfile_header, sysfile_format,
+ sysfile_variable; inline function bswap_int32) Moved to new file
+ sfmP.h.
+ (corrupt_msg) [__CHECKER__] No longer induces segfault.
+ (sfm_read_dictionary) Fixed bug caused by failing to initialize
+ var_by_index.
+ (read_machine_flt64_info) Fixed some problems caused by confusion
+ between flt64 and double types.
+ (read_header) Message fix.
+ (read_variables) Fixed set of cases in which we byte-swap sv.print
+ and sv.write. Fixed confusion of flt64 and double.
+
+ * sfm.h: (struct sfm_write_info) New.
+
+ * som-high.c: (som_draw_title) Properly frees `s'.
+
+ * temporary.c: (save_dictionary) Comment fix.
+
+ * var.h: Comment fixes. New FMT_* enum, FMT_NUMBER_OF_FORMATS.
+ (struct trns_header) Formatting fix.
+ (struct save_trns) New.
+
+ * vars-atr.c: (discard_variables) Comment fix.
+
+ * sfm-write.c: New file, baseline release.
+
+ * sfmP.h: New file, baseline release.
+
+Sun Nov 24 14:53:53 1996 Ben Pfaff <blp@gnu.org>
+
+ * cmdline.c: (parse_command_line) `--version' output updated.
+ (glob var syntax_message[]) Added my e-mail address.
+
+ * file-handle.q, lexer.c, vfm.c: Changed many instances of
+ `illegal' to `invalid'.
+
+ * sfm-read.c: (struct sfm_fhuser_ext) New fields used as
+ uncompression buffer.
+ (sfm_close) Frees decompression buffer.
+ (sfm_read_dictionary) Initializes decompression buffer.
+ (buffer_input, read_compressed_data) New functions.
+ (sfm_read_case) Restructured; now calls read_compressed_data() to
+ handle compressed system file data.
+
+ * var.h: Comment fix.
+
+Mon Nov 11 15:34:09 1996 Ben Pfaff <blp@gnu.org>
+
+ * dfm.c: (dfm_close) Does not set h->{ext,class} because the
+ caller handles it.
+
+ * get.c: New comments. New static var `get_file'.
+ (cmd_get) Now fully implemented. Calls discard_variables();
+ initializes fv and lv for all variables; new debug code; sets
+ up the dictionary; sets up the input program.
+ (read_from_get, cancel_get) New functions.
+
+ * sfm-read.c: Comment fixes.
+ (sfm_close) New static function.
+ (sfm_read_dictionary) Properly sets up the class of the
+ file_handle. No longer cares what size the data is in records of
+ type 7. Also, on failure, properly cleans up the file_handle and
+ free()s some stuff.
+ (read_variables) No longer thinks it knows `nval' of the
+ dictionary. Now sets p.get.fv, etc., instead of speculatively
+ setting fv itself.
+ (read_value_labels) Fixed off-by-one error in indexing of
+ var_by_index[].
+ (sfm_read_case) New function.
+ (sfm_r_class) New static var.
+
+ * var.h: (get_proc) New struct.
+ (struct variable) New member p.get.
+
+Thu Nov 7 20:52:28 1996 Ben Pfaff <blp@gnu.org>
+
+ * get.c: Removed GTSV_OPT_MAP because of a misinterpretation of
+ the manual's meaning.
+ (rename_variables) New function.
+ (trim_variables) Doesn't try to parse MAP any more. Removed debug
+ code. Now properly reorders the dictionary on the KEEP keyword.
+
+ * sfm-read.c: (read_value_labels) Fixed some bugs regarding
+ garbage collection.
+
+ * vars-atr.c: (clear_variable) New argument `dictionary *'.
+ (rename_variable) New function.
+ (free_val_lab) Reformatted.
+
+Thu Nov 7 17:29:16 1996 Ben Pfaff <blp@gnu.org>
+
+ * var.h: Reindented entire file. Comment fixes.
+ (glob vars var, var_by_name, nvar, N, nval, n_splits, splits)
+ Removed.
+ (glob var default_dict) New.
+ (struct indirect_dictionary) Removed.
+
+ * Many other source files were changed to add `default_dict.'
+ before all references to the dictionary of the active file.
+
+ * vars-atr.c: (make_indirect_dictionary) Removed.
+
+ * glob.c: Reindented all variable declarations. Updated for
+ changed var.h. Comment fixes.
+
+ * temporary.c: (restore_dictionary, save_dictionary) Simplified
+ because now we can mainly copy dictionary structs.
+
+ * vars-prs.c: (is_dict_varname, parse_dict_variable,
+ parse_variables) Takes dictionary instead of indirect_dictionary
+ first argument.
+ (parse_variables) Instead of calling make_indirect_dictionary,
+ just sets DICT to &default_dict if DICT is NULL. Of course, lots
+ of `*dict.' references had to be changed to `dict->'. Removed
+ debug code.
+
+Thu Nov 7 15:48:52 1996 Ben Pfaff <blp@gnu.org>
+
+ * get.c: Added GTSV_OPT_* series of enums.
+ (trim_dictionary, dict_delete_run) New functions.
+ [DEBUGGING] (dump_dict_variables) New function.
+ (cmd_get) Calls trim_dictionary() to get dictionary fully set-up.
+ [DEBUGGING] Calls dump_dict_variables() to display results.
+
+ * glob.c: (cmp_variable) Now a public function declared in var.h.
+
+ * sfm-read.c: Turned off debug code. Comment fixes.
+ (read_machine_int32_info, read_machine_flt64_info) New functions
+ to parse type 7 records.
+ (sfm_read_dictionary) Properly byteswaps several fields now.
+ Calls read_machine_*_info() to parse type 7 subtypes 3 and 4
+ records. [DEBUGGING] Dumps dictionary.
+ (read_variables) Sets `index' field of variables created properly.
+ Constructs avl tree of variables in dictionary. [DEBUGGING] No
+ longer dumps dictionary.
+ (read_value_labels) Properly byteswaps fields. [DEBUGGING] New
+ debug code.
+ [DEBUGGING] (dump_dictionary) No longer stubbed out.
+
+ * temporary.c: (restore_dictionary) Destroys `var_by_name' glob
+ var before destroying any variables just to save a little time.
+
+ * var.h: (struct variable) Reordered in order to make name[] the
+ first member; this makes pointers to `variable' pointers to the
+ variable name, simplifying avl trees, etc.
+ (struct indirect_dictionary) New struct.
+
+ * vars-atr.c: (find_variable) Rewritten for efficiency.
+ (make_indirect_dictionary, is_dict_varname, parse_dict_variable)
+ New functions.
+ (is_varname) Rewritten for efficiency.
+ (parse_variables) New argument, which is a `dictionary *'. All
+ references changed. This function now reads variable names from
+ the dictionary passed, or from the default dictionary if NULL.
+
+Tue Nov 5 18:34:59 1996 Ben Pfaff <blp@gnu.org>
+
+ * misc.h: Added new macro DIV_RND_UP to perform integer division,
+ rounding up. Changed many references to ROUND_UP to use this
+ instead.
+
+ * sfm-read.c: Includes avl.h.
+ (corrupt_msg) Induces a segfault under Checker.
+ (macro assertive_bufread) New. Many references to bufread() now
+ use this instead.
+ (sfm_read_dictionary) Split up into several functions. Added code
+ to read dictionary records following the the type 2 records. Not
+ quite complete. New variable `var_by_index'.
+ (read_header, read_variables) New functions extracted from
+ sfm_read_dictionary().
+ (read_value_labels) New function.
+ (bufread) Checks ferror() if fread() doesn't return the expected
+ value; if ferror() is zero it's just EOF.
+ (dump_dictionary) Stubbed out.
+
+ * BTW: The source code now exceeds 50000 lines!
+
+Mon Nov 4 22:03:28 1996 Ben Pfaff <blp@gnu.org>
+
+ * command.c: Added GET to cmd_table[].
+
+ * list.q: Removed reference to alloca headers.
+ (cmd_list) Gave prototype.
+
+ * sfm-read.c: Added DEBUGGING comments.
+ (sfm_read_dictionary) Checks bias correctly. Sets
+ dict->var_by_name to NULL. Calculates long_string_count
+ correctly. realloc's dict->var[] array to minimum size.
+ [DEBUGGING] Calls dump_dictionary.
+ [DEBUGGING] (dump_dictionary) New function.
+
+ * temporary.c: (save_dictionary) Sets var_by_name to NULL.
+ (restore_dictionary) If the dictionary contains a non-NULL
+ var_by_name, uses that instead of generating one.
+ (free_dictionary) Destroys var_by_name.
+
+ * var.h: (struct dictionary) Added field `var_by_name'.
+
+ * get.c: New file, not complete.
+
+Sun Nov 3 12:24:36 1996 Ben Pfaff <blp@gnu.org>
+
+ * mis-val.c: New enums MV_NOR_*. New struct num_or_range.
+ (parse_num_or_range) New function.
+ (parse_numeric) Reimplemented in order to support LOW THRU <n> and
+ <n> THRU HIGH missing values.
+
+ * output.h: [__GNUC__>1 && __OPTIMIZE__] (width, height) Made
+ __attribute__((const)).
+
+ * q2c.c: (get_token) Merged isdigit || isalpha into isalnum.
+
+ * sfm-read.c: Finished reference implementation.
+
+ * sfm.h: Includes var.h.
+
+ * var.h: Comment fixes.
+ (struct `variable') Reordered some fields.
+
+ * vars-atr.c: (is_num_user_missing) Added support for MISSING_*
+ constants added previously.
+
+Wed Oct 30 17:13:08 1996 Ben Pfaff <blp@gnu.org>
+
+ * common.h: Comment fixes. Added declaration of
+ `second_lowest_value' as variable or macro. Made `compat_type',
+ `pgm_state_type' into anonymous enums.
+
+ * display.c: Comment fix.
+
+ * glob.c: [ENDIAN==UNKNOWN] Added definition for `endian' global
+ var.
+ [!defined SECOND_LOWEST_VALUE] Added definition for
+ `second_lowest_value' global var.
+ (compat, pgm_state global vars) Changed types to `int'.
+ (init_glob) Initializes `second_lowest_value'.
+
+ * sfm-read.c: Continued work, not complete.
+
+ * var.h: Added new MISSING_* constants to handle LOWEST and
+ HIGHEST.
+
+Sat Oct 26 23:06:06 1996 Ben Pfaff <blp@gnu.org>
+
+ * sfm-read.c: New file, not complete.
+
+ * cases.c: (vec_insert) Changed vector expansion algorithm.
+ (vec_delete) Fixed bug that screwed up deletion sometimes, it was
+ mucking up the RECODE transformation in particular.
+ (envector) Harmless change in notation.
+
+ dfm is now fairly well tested again.
+ * dfm.c: (dfm_get_record) Only returns ext->ptr if ext is
+ non-NULL--duh.
+ (cmd_begin_data) if(ext->line) replaced by if(ext && ext->line).
+
+ * recode.c: Comment fix.
+
+ * sfm.h: Interface should be fairly final now, or at least for a
+ day or so...
+
+ * vfm.c: [DEBUGGING] (index_to_varname) New function.
+ (open_active_file) [DEBUGGING] Translates ccase indices into
+ variable names now to make it easier to understand what's really
+ going on.
+
+Sat Oct 26 20:46:31 1996 Ben Pfaff <blp@gnu.org>
+
+ * data-in.c: Comment fix.
+
+ * data-list.c: Includes dfm.h.
+ (do_reading) Uses new function dfm_push_cust().
+
+ * data-out.c: (convert_time, convert_WKDAY, convert_MONTH) Added
+ `return 1;' at end.
+
+ * file-handle.h: Completely changed. Some parts split off into
+ new file dfm.h. Implemented in file-handle.q.
+ (enum FH_*) Removed.
+ (struct fh_ext_class) New struct.
+ (struct file_handle) Retained only these fields: name, norm_fn,
+ fn, recform, lrecl, mode. New fields class, ext.
+ (get_handle_by_name, get_handle_by_filename, parse_file_handle,
+ close_handle, handle_name) Added `fh_' prefix to name, all
+ references changed.
+
+ * dfm.h: New file, implemented in dfm.c.
+ (get_record, put_record, fwd_record, bkwd_record, set_record,
+ get_cur_col) Functions moved from file-handle.h, now prefixed with
+ `dfm_'.
+ (dfm_push_cust) New function.
+
+ * sfm.h: New file. Incomplete.
+
+ * dfm.c: All functions adjusted/rewritten for new dfm/fhp
+ interface. Functions reordered, comments changed. Not well
+ tested, probably full of bugs.
+ (struct dfm_fhuser_ext) New struct.
+ (dfm_close) New function.
+ (open_file_r) Pickier about finding `BEGIN DATA.' line.
+ (open_file_w) User messages changed.
+ (get_record) Comment fixed.
+ (read_record) Increments ext->ln even for inline_file. Calls
+ dfm_close() for inline_file when `END DATA.' encountered.
+ (dfm_get_record) Experimental restructuring.
+ (dfm_push_cust) New function.
+ (cmd_begin_data) Detects whether the inline file was fully read by
+ checking whether it is still open; detects whether it was read at
+ all by checking whether the line number is greater than zero.
+
+ * file-handle.q: All functions adjust/rewritten for new dfm/fhp
+ interface. Functions reordered, comments changed. Not well
+ tested, probably full of bugs.
+ (init_file_handle) Removed initializers for obsolete fields, added
+ new fields.
+ (fh_close_handle) Much simpler, now mainly calls the class
+ function.
+ (fh_init_files) Renamed inline file internal filename.
+
+ * file-type.c: Includes dfm.h.
+ (read_from_file_type) Doesn't use dfm internal state anymore.
+
+ * inpt-pgm.c, print.c: Include dfm.h.
+
+ * recode.c: (internal_cmd_recode) Casts strlen() return value to
+ int in comparison with other int.
+
+ * som-high.c: (build_target) Fixed operator precedence problem in
+ if statement (& versus ==).
+
+Sat Oct 26 10:39:25 1996 Ben Pfaff <blp@gnu.org>
+
+ * dfm.c: (read_record) Can now read fixed-length records; not
+ tested.
+ (put_record) Can now write fixed-length records; not tested.
+
+ * file-handle.h: FH_* defines changed to enums. New enum series
+ FH_RF_*, FH_MD_*.
+ (struct file_handle) New members recform, lrecl, mode.
+
+ * file-handle.q: Parser changed.
+ (internal_cmd_file_handle) Added support for new /RECFORM, /MODE,
+ /LRECL subcommands. These are compatible with Windows.
+ (init_file_handle) Initializes recform, mode fields.
+
+ * q2c.c: (get_line) When outputting `!' comment lines, now
+ increments the output file line number so that `#line' directives
+ are correct.
+ (make_identifier) New function that converts an arbitrary string
+ into a valid C identifier.
+ (dump_vars) Calls make_identifier() in two places in order to
+ suppress some errors for bad identifiers.
+ (make_match) Allows TRUE as synonym for YES and FALSE as synonym
+ for NO. Allows numbers to be prefixed by underscores to make them
+ acceptable C identifiers but still to be parsed as numbers by the
+ Fiasco lexer.
+
+Thu Oct 24 20:13:42 1996 Ben Pfaff <blp@gnu.org>
+
+ * command.c: Re-enabled RECODE, SAMPLE, SELECT IF.
+
+ * dfm.c: Comment fixes. (get_record) Gives error if file handle
+ was opened for writing.
+ (open_file_w) New function.
+ (read_record) Uses strncasecmp if available. Improved error
+ messages, comments.
+ (put_record) New function.
+
+ * file-handle.h: Moved function comments into dfm.c and
+ file-handle.q. Comment fixes. Removed declarations of
+ tilde_expand() and normalize_filename().
+ (struct file_handle) Changed `open' from boolean to enumerated
+ field to allow for three states--closed, open for reading, open
+ for writing--all references changed.
+
+ * file-handle.q: Includes filename.h.
+
+ * print.c: (CMD_* enums) Renamed PRT_* and moved into var.h; all
+ references changed.
+ (alloc_line) Makes allowance for line terminator characters in
+ calculations.
+ (print_trns_proc) Now handles OUTFILE, WRITE differences.
+ (print_space_trns_proc) Handles OUTFILE differences.
+
+ * recode.c, sample.c: Comment fixes.
+
+ * var.h: (struct print_trns) Changed boolean field `eject' to
+ bitmapped field `options'; all references changed. New enums
+ PRT_* for use with this field.
+
+ * exception.h, test-exception.c: Removed.
+
+Thu Oct 24 17:47:14 1996 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: (delineate) Turned off debug output.
+
+ * common.c: [Checker and Linux] (__assert_fail, __eprintf) Moved
+ to error.c.
+
+ * data-in.c: (parse_string_as_format) Sets the entire string value
+ to spaces, not just the short string part of it. Is this correct
+ now?
+
+ * data-out.c: (convert_date) Fixed DATETIME format problems with
+ decimal places, removed debug code.
+
+ * dfm.c: (open_file_r) Fixed bug where an error would occur in the
+ middle of parsing BEGIN DATA that would cause the lexer to read
+ from a wild pointer `prog'; now calls new function
+ preprocess_line() in lexer.c.
+
+ * error.c: [__CHECKER__] (hcf) Calls induce_segfault() on improper
+ termination.
+ [Checker and Linux] (__assert_fail, _eprintf) Moved from common.c.
+ Now call induce_segfault() to induce the segfault.
+ (induce_segfault) New function.
+
+ * expr-opt.c: Comment fix.
+ (parse_sysvar) New function.
+ (parse_primary) Added system variable support--calls
+ parse_sysvar().
+ (global var ops) Added OP_CASENUM operator.
+
+ * expr.h: Comment fixes.
+ (OP_* enum) added OP_CASENUM operator.
+ (struct casenum_node) New struct.
+ (union any_union_union) New member `cas' of type `casenum_node'.
+
+ * glob.c: (global var last_vfm_invocation) New var.
+ (init_glob) Initializes last_vfm_invocation.
+
+ * lexer.c: (lookahead) Fixed reversed condition on if statement.
+
+ * getline.c: (get_line) Split into get_line() and preprocess_line().
+ (preprocess_line) New function.
+
+ * var.h: Declares last_vfm_invocation.
+
+ * vfm.c: (procedure) Sets last_vfm_invocation.
+
+Wed Oct 23 21:53:43 1996 Ben Pfaff <blp@gnu.org>
+
+ * command.c: (parse_cmd) Fixed bad assertion related to
+ lookahead().
+
+ * data-in.c: (parse_month) Implemented to parse months according
+ to full interpretation of standard.
+ (to_roman) New function.
+ (parse_wk_delimiter) Bug fix (forgot to skip `WK' in string).
+ (parse_weekday) Bug fix (forgot to skip all the day name).
+
+ * data-list.c: (read_from_data_list_fixed) Fixed bug that screwed
+ up parsing of multirecord data items. Also fixed user message.
+
+ * data-out.c: Comment fix.
+ (year2, year4, convert_date, convert_time, convert_WKDAY,
+ convert_MONTH) New functions to support time & date output.
+ (convert_format_to_string) Calls new time & date output routines.
+
+ * expr-prs.c: (nary_num_func) Found a bug, but didn't fix it yet.
+
+ * lexer.c: (lookahead) Noted a previously unnoticed caveat in
+ comment.
+
+ * main.c: [DEBUGGING] (dump_token) Updated to handle getline.h.
+
+ * misc.c: (global var formats) Fixed declarations of DATETIME,
+ TIME, DTIME.
+
+ * postscript.c: (text) Fixed a pair of bugs in the reallocation of
+ the output_char buffer.
+
+ * vars-prs.c: (parse_DATA_LIST_vars) Fixed a failure to free
+ memory bug. Fixed user messages.
+
+Tue Oct 22 17:27:04 1996 Ben Pfaff <blp@gnu.org>
+
+ * Removed #pragma argsused from lots of places.
+
+ * data-in.c: Implemented zoned decimal and time-date formats.
+ Untested. This is a huge chunk of code--maybe 1000 lines and 50
+ new functions.
+
+ * data-out.c: Implemented zoned decimal format.
+
+ * expr.h: Moved yrmoda() declaration here from exprP.h.
+
+ * misc.c: (global var formats) Minor fixes--added
+ FCAT_SHIFT_DECIMAL to formats N and Z.
+ (convert_fmt_ItoO) Added support for format Z.
+
+ * som-frnt.c: (som_set_value) Fixed bug regarding string values.
+
+Mon Oct 21 20:39:59 1996 Ben Pfaff <blp@gnu.org>
+
+ * command.c: (parse_cmd) [GLOBAL_DEBUGGING] Inserted call to
+ som_check_workspace() that is activated between commands.
+
+ * data-list.c: (dump_fixed_table, dump_free_table) Finished these
+ for good, I hope.
+
+ * list.q: (begin_row) Changed title expansion style from
+ SOPT_X_VERT to SOPT_X_SHSP.
+
+ * som-frnt.c: Now includes `somP.h'.
+ (som_push_workspace, som_pop_workspace) New functions that, taken
+ together, form a solution to the recursive table building problem
+ mentioned yesterday. Surrounded every table output routine
+ throughout the program with calls to these functions.
+ [GLOBAL_DEBUGGING] (som_check_workspace) New function.
+ (som_create_table) Checks that there's an active workspace.
+ (som_destroy_all_tables, som_crush) Removed.
+
+ * som-high.c: (global var som_preserve_tables) Removed, all
+ references deleted.
+ (som_submit_table) Checks that there's an active workspace.
+ (dump_columnated_table) Doesn't columnate tables that would have
+ just one row per column.
+ (dump_crush_page, som_dump_crush_page) Removed debugging code.
+ (som_dump_crush_page) Moved row number labels from left side of
+ tables to right side.
+ (som_get_table_size) Added support for SOPT_X_SHSP.
+
+ * som.h: New cell expansion type SOPT_X_SHSP.
+
+ * somP.h: (global vars arena_stack, n_arena_stack, m_arena_stack)
+ New vars.
+ (global var curtab_arena) Moved from som-frnt.c.
+
+Sun Oct 20 13:45:28 1996 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: [GLOBAL_DEBUGGING] (SUPPRESS_WARNINGS) New debug option
+ that causes bad location warnings to be suppressed.
+ (delineate) Saves current font when calling draw_text(); fixed
+ handling of NULLs when backing up. Also fixed line-wrapping bug.
+
+ * command.c: Re-enabled `LEAVE', `NUMERIC', `PRINT', `PRINT EJECT',
+ `PRINT FORMATS', `PRINT SPACE', `STRING', `TITLE', `WRITE'.
+
+ * common.c: Added code to cause assertion failure to dump core
+ when run under Checker.
+
+ * data-list.c: (dump_fixed_table) Fixed some inconsistencies, but
+ there are still bugs.
+
+ * glob.c: (__eprintf) Removed.
+
+ * list.q: Inserted som_preserve_tables kluge that prevents tables
+ from being thrown away due to recursive table building through
+ som_output_line being called from a transformation during the LIST
+ procedure invocation. This is a general problem that must be
+ solved in a better way since it applies to all procedures in
+ general.
+ (begin_row) Changed title options to SOM_X_VERT from SOM_X_BOTH.
+ (flush_table) Removed SOM_TOPT_PRESERVE from submission options.
+
+ * numeric.c: Fixed several errors in the form of msg() calls.
+
+ * print.c: Updated for use of som.
+ (dump_table) Reimplemented.
+ (print_trns_proc) Calls som_eject_page() instead of eject_page().
+ Calls som_output_text() instead of outs_line().
+
+ * som-frnt.c: (som_destroy_all_tables) Sets som_preserve_tables to
+ 0.
+ (som_output_text) Function moved from som-low.c. Interface
+ changed.
+
+ * som-high.c: (som_preserve_tables) New global public variable
+ declared in som.h.
+ (som_submit_table) Destroys the tables only if som_preserve_tables
+ is 0.
+ (paginate_horizontally) Bugfix: sets som.mpw even if there's only
+ one subrow per row. Now labels subrows if there's more than one
+ subrow per row.
+ (dump_crush_table) Added wishlist comment.
+ (som_eject_page) New public function declared in som.h.
+
+ * som-low.c: (som_dump_crush_page) Draws row labels if there's
+ more than one subrow per row.
+ (som_output_text) Moved to som-frnt.c.
+
+ * som.h: (SOM_TOPT_PRESERVE) Removed.
+
+ * title.c: (get_title) Changed interface.
+ (cmd_title) Changed `title' to `outp_title'.
+ (cmd_subtitle) Changed `subtitle' to `outp_subtitle'.
+
+Sun Oct 20 09:04:15 1996 Ben Pfaff <blp@gnu.org>
+
+ * list.q: (flush_table) Conforms to new partial options in
+ som_submission_form.
+
+ * som-high.c: (paginate_horizontally) Changed form of subrow
+ number labels.
+ (build_target) Omits spacing before table if
+ SOM_TOPT_PARTIAL_OMIT_TOP is selected.
+ (dump_crush_page) Changed interface. Only trims bottom rule if
+ SOM_TOPT_PARTIAL_OMIT_BTM is not selected.
+ (dump_crush_table) Handles partial tables.
+ (output_row_label) New function.
+ (som_dump_crush_page) Emits subrow number labels. Draws vertical
+ rule on the right edge of narrow subrows.
+
+ * som.h: Changed SOM_SUB_PARTIAL_* series of submission type
+ constants to a series of SOM_TOPT_PARTIAL_* submission options.
+ All references updated.
+
+Fri Oct 18 19:46:49 1996 Ben Pfaff <blp@gnu.org>
+
+ * misc.c: Comment fix.
+
+ * som-high.c: (examine_table) Treats crushed tables separates for
+ purpose of determining header size.
+ (paginate_horizontally) Allots space for line numbers in crushed
+ tables with lots of subrows per row. Calculates the `maximum page
+ width', the width of the widest horizontal page.
+ (build_target) Removed trim argument; all references changed.
+ Stricter assertions. (dump_crush_page) New function.
+ (dump_crush_table) Reimplemented.
+
+ * som-low.c: (som_dump_page) Uses new RULE_ROW &c. constants.
+ (som_dump_crush_page) Reimplemented, interface changed.
+
+ * somP.h: Many many new helper macros for use with crushed tables.
+ (global var som) Removed `tv', `cum_y' members; all references
+ removed. New members `mpw', `digit_space'.
+
+Sun Sep 29 19:37:03 1996 Ben Pfaff <blp@gnu.org>
+
+ * arena.c: (arena_alloc) [!DISCRETE_BLOCKS] Removed `size'
+ variable, changed to constant 1024.
+ (arena_ca_strdup) Changed `sizeof(a_string)' to
+ `sizeof(c_string)'.
+ (arena_ca_strdup) [!DISCRETE_BLOCKS] Changed bad cast from
+ `(c_string *)' to `(char *)'; this fixed some offset problems.
+
+ * filename.c: (readlink_malloc) Changed initial allocation from
+ 100 bytes to 128.
+ (good_getcwd) Changed from xmalloc() to local_alloc(); removed
+ comment.
+
+ * postscript.c: (read_fontmap) Fixed leak by changing &owner to
+ &fm->owner in several places.
+
+ * som-high.c: (output_table) Changed interface to rest of world.
+ (examine_crush_table) Removed. Crushed tables are re-broken now,
+ in preparation for rewrite.
+
+ * som.h: Comment fix.
+
+Sat Sep 28 21:28:07 1996 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: (ascii_init_driver) Disposes of x->file.filename and x
+ itself in the cleanup stage.
+
+ * descript.q: (display) At least temporarily, changed the table
+ format to a crushed table.
+
+ * list.q: (begin_row) At least temporarily, added horizontal lines
+ between cases.
+
+ * som-high.c: (examine_crush_table) Sets som.hh to the width of
+ the horizontal "headers," that is, to the width of the far left
+ and far right rules.
+ (justify_pagination) Sets som.th to the width of the widest row
+ in the crushed table. Fixed inner loop off-by-one error.
+
+ * som-low.c: (som_dump_crush_page) Added code to draw horizontal
+ rules.
+
+ * somP.h: Comment fix.
+
+Fri Sep 27 20:08:39 1996 Ben Pfaff <blp@gnu.org>
+
+ * filename.c: (open_file_ext) Now, doesn't set f->file to NULL
+ before closing it; also, opens the constructed filename `s'
+ instead of f->filename.
+
+ * postscript.c: Moved initialization of x->loaded, x->prop,
+ x->fixed, x->current, also the add_encoding() calls, into
+ postopen().
+ (preclose) Destroys x->combos; sets x->loaded, x->combos to NULL;
+ sets x->last_font to NULL; sets x->next_combo to zero.
+
+ * som-high.c: (crushed_row_height) Moved definition farther up.
+ (som_submit_table) Doesn't calculate line width, font size until
+ after calling open_page(), to accomodate changes to PostScript
+ driver.
+ (vert_headers) Removed; equivalent functionality moved to
+ examine_table(), examine_crush_table().
+ (justify_pagination) Replaced with different algorithm.
+ (dump_crush_table) Bugfix that caused tables to fail to be clipped
+ at the bottom of the page.
+
+Thu Sep 26 22:20:26 1996 Ben Pfaff <blp@gnu.org>
+
+ * command.c: Added cmd_list back into cmd_table.
+
+ * freq.c, frequencies.q, repeat.c, list.q, vars-atr.c, vfm.c:
+ Comment fix: `#define DEBUGGING' --> `#define DEBUGGING 1'.
+
+ * list.q: (flush_table) Updated to new som_submission_form format.
+
+ * som-frnt.c: Comment fix.
+
+ * som-high.c: Changed `#endif' to `#undef EXTERN'.
+ (output_table) Calls som_get_table_size() directly; handles
+ crushed tables.
+ (examine_crush_table) New function; calls vert_headers().
+ (examine_table) Moved some code into new function, vert_headers().
+ (justify_pagination) New function.
+ (dump_plain_table) Removed `static' from `cy'.
+ (dump_crush_table) New function.
+
+ * som-low.c: (som_dump_crush_page) New function.
+
+ * som.h: Comment fixes.
+ (enum SOM_TOPT_CRUSH) New.
+ (SOM_SUB_PARTIAL_BEG, SOM_SUB_PARTIAL_MID, SOM_SUB_PARTIAL_END)
+ Temporarily set to zero to make do with LIST procedure.
+
+ * somP.h: Re-ordering.
+
+Wed Sep 25 19:36:11 1996 Ben Pfaff <blp@gnu.org>
+
+ * som.c: Split into som-frnt.c, som-high.c, som-low.c.
+
+ * somP.h: New file for use by som-high.c, som-low.c.
+
+ * q2c.c: Added definition for VME.
+ (get_line) Now dumps `!' comment lines to the output file
+ verbatim.
+
+ * crosstabs.q, descript.q, file-handle.q, frequencies.q, list.q,
+ set.q: Changed format of `!' comment lines.
+
+Tue Sep 24 18:39:09 1996 Ben Pfaff <blp@gnu.org>
+
+ * All source files: Added copyright notice.
+
+ * common.c: (xmalloc, xrealloc, xstrdup) Cast size_t's to unsigned
+ longs in msg() calls.
+
+ * con32s.c: (xmalloc, xrealloc) Updated from common.c.
+
+ * q2c.c: (xmalloc, xrealloc, xstrdup) Updated from common.c.
+
+Sat Sep 21 23:16:31 1996 Ben Pfaff <blp@gnu.org>
+
+ * output.c: (outp_read_devices) Changed criteria for
+ distinguishing different types of lines.
+
+Fri Sep 20 22:52:28 1996 Ben Pfaff <blp@gnu.org>
+
+ * cmdline.c: Changed syntax message.
+
+ * filename.c: (good_getcwd) Bug fix (?).
+ (normalize_filename) [__BORLANDC__] Uses _fullpath() library
+ function.
+ (search_path) Appends DIR_SEPARATOR to directory name only if it
+ does not already end with one.
+
+ * glob.c: Checks STAT_PAGER envvar before PAGER.
+
+ * output.c: Checks environment variables instead of just local
+ macros.
+
+Tue Sep 10 21:39:00 1996 Ben Pfaff <blp@gnu.org>
+
+ * arena.c: (arena_destroy) Swatted a subtle bug that cropped up
+ when the pointer passed to the function was within the arena
+ itself, so that it couldn't properly be set to NULL _after the
+ arena was freed_.
+
+ * command.c: Re-enabled DISPLAY.
+
+ * display.c: Rewritten to handle tables. Untested.
+
+ * filename.c: (search_path) Fixed memory leak.
+
+ * frequencies.q: (cmd_frequencies) Frees v_variables.
+ (postcalc) Calls cleanup_freq_tab() after displaying statistics.
+ (cleanup_freq_tab) New function to garbage collect.
+ (dump_full) Elegantized.
+
+ * main.c: New comment.
+
+ * output.h: New tag for tagged quotes: TAG_NEWLINE.
+
+ * postscript.c: Comment fix.
+ (release_fontmap, free_font_entry) New functions.
+ (ps_init_driver) Sets free_font_entry() as the freefunc for
+ hashtable `loaded'. Calls release_fontmap() when destroying a
+ driver; also frees the output filename; also frees the
+ ps_driver_ext block.
+ (free_ps_encoding) Frees the filename as well as the encoding
+ block.
+ (output_encodings) Frees the line buffer and pops the msg-filename
+ stack.
+ (read_fontmap) Frees the fontmap filename and the line buffer.
+ (postopen, preclose) Misc. garbage collection fixes.
+ (ps_open_page) Destroys the `combos' hash table; sets `last_font'
+ to NULL; this fixes some output problems.
+ (text) Handles TAG_NEWLINE. Untested.
+
+ * som.c: (cell_byte_size) Merged SCON_VALUE and SCON_TEXT cases.
+ (som_set_string) Removed. All references changed to
+ `som_set_text'.
+ (som_set_text) Rewritten. New interface. More general.
+
+ * som.h: Minor format changes.
+ (struct som_value_cell) Removed; all references changed to
+ `som_text_cell'.
+ (enums SOT_*) Changed.
+
+Mon Sep 9 21:43:13 1996 Ben Pfaff <blp@gnu.org>
+
+ * command.c: Re-enabled SPLIT FILE.
+
+ * postscript.c: Comment fix.
+
+ * som.h: Added `SOT_NONE'.
+
+ * split-file.h: (cmd_split_file) Removed superfluous parenthesis.
+
+ * vfm.c: (dump_splits) Reimplemented.
+
+Sat Sep 7 22:35:12 1996 Ben Pfaff <blp@gnu.org>
+
+ * Compiled the project under gcc 2.7.2, which gave some new
+ warnings. This led to many additions of casts from unsigned to
+ int sprinkled throughout the code.
+
+ * arena.c: Many uses of `unsigned' changed to `size_t'.
+
+ * command.c: Added END FILE, END REPEAT to command table.
+ (var cmd_end_repeat) Renamed cmd_end_repeat_p.
+ (find_command, FILE_TYPE_okay) Not commented out anymore.
+ (parse_cmd) Calls FILE_TYPE_okay again.
+ (output_line) Added calls to som_output_text() to put the line
+ in the output files.
+
+ * common.c: (macro VME) Format changes.
+ (xstrdup) Asserts that its argument is not NULL.
+
+ * data-list.c: Implemented dump_fixed_table().
+
+ * inpt-pgm.c: Formatting changes. Comment changes.
+ (end_case_proc) Renamed end_case_trns_proc.
+ (cmd_end_file, end_file_trns_proc) New functions.
+
+ * misc.c: Many uses of `int' and `unsigned' changed to `size_t'.
+
+ * misc.h: (local_strdup) New macro corresponding to strdup() but
+ allocating its data through local_alloc() if possible--that is, if
+ GNU C is in use.
+
+ * postscript.c: Comment changes.
+ (quote_ps_name, quote_ps_string, output_encodings) New functions.
+ (output_line, add_string) New macros supporting
+ output_encodings().
+ (postopen) Fixed contents of ${fixed-font} and ${prop-font}
+ substitution vars. Calls output_encodings() when a line
+ consisting of `!encodings' is encountered.
+ (preclose) Some code moved into quote_ps_string().
+ (dump_line) Changed into macro supporting dump_fancy_line().
+ (switch_font) Now outputs DSC "%%IncludeResource: font (...)"
+ command when appropriate.
+ (write_text) Fixed `literal_char' array (I think it's fixed, at
+ least.)
+ (text) Fixed bug when width was zero. Now exits immediately on
+ zero height_left. Now, when executing `goto restart;', checks
+ that cp<end, so that we don't read beyond end-of-string. Also,
+ outputs the correct code to the output file by outputting the code
+ from the metric instead of the internal metric index.
+
+ * repeat.c: (cmd_end_repeat) New function.
+
+ * som.c: (var som) `headers' renamed `options' and semantics
+ changed. All references changed.
+ (draw_title) `if(px!=-1 || px!=-1)' --> `if(px!=-1 || py!=-1)'.
+ (build_target) Only inserts spacing if SOM_TOPT_SPACING not
+ selected.
+ (som_text_table) Removed.
+ (som_output_text) New function.
+
+ * som.h: (struct som_submission_form) Removed `header', `reuse',
+ replaced with bitmapped field `options'.
+ (SOM_TOPT_*) New enum set for som_submission_form.options.
+ (SOT_*) New enum set for som_output_text().
+
+ * temporary.c: (copy_variable) When copying the var label, only
+ calls xstrdup() if it's non-NULL.
+
+ * var.h: (enum type `vartype') Removed; all references changed to
+ `int'.
+
+ * vars-atr.c: (init_variable) Changed local var `nbytes' from
+ `int' to `size_t'.
+
+Thu Sep 5 22:05:56 1996 Ben Pfaff <blp@gnu.org>
+
+ * font.h: Comment changes.
+
+ * groff-font.c: (groff_read_font) Initializes `name' field to
+ NULL. Handles `encoding' field.
+
+ * hash.c: (hsh_dump) [GLOBAL_DEBUGGING] Output formatting changes.
+
+ * postscript.c: (struct font_entry) Removed `position' field.
+ (struct ps_font_combo) New struct.
+ (struct ps_driver_ext) Removed field `next_position'. New fields
+ `combos', `next_combo'. `last_font' field changed from
+ `font_entry *' to `ps_font_combo *'.
+ (ps_init_driver) Reformatted; handles new fields. When
+ OPO_AUTO_ENCODE is set, adds the two default fonts' encodings to
+ the encoding list.
+ (get_encoding, find_encoding_file) New functions.
+ (add_encoding) Some code moved out into find_encoding_file().
+ (postopen) Changed value for ${title}.
+ (preclose) Sets `loaded' field to NULL after destroying the hash
+ table.
+ (ps_open_page) Added comment. Inits the `combos' and `next_combo'
+ fields.
+ (ps_text_set_font_by_position) Figures out the current family if
+ not known.
+ (compare_ps_combo, hash_ps_combo, free_ps_combo) New functions.
+ (switch_font) Implemented.
+ (write_text) Calls switch_font() more often. Format changes.
+ #undefs its macros after they're no longer useful.
+ (text) Changed `continue' at one point to a jump to the top of the
+ loop because we don't want `separate' reset to 0 at that point.
+ (load_font) No longer sets `position' in the font_entry created.
+
+Wed Sep 4 21:45:35 1996 Ben Pfaff <blp@gnu.org>
+
+ * font.h: (struct font_desc) New member `encoding', which is not
+ properly handled yet.
+
+ * glob.c: (init_glob) Some new i18n code, which is probably
+ screwed up.
+
+ * output.c: (outp_read_devices, outp_get_paper_size) Changed
+ `size' local from `int' to `size_t'.
+
+ * postscript.c: New driver configuration parameter `auto-encode'.
+ New enums OPO_AUTO_ENCODE, ODA_COUNT.
+ (struct font_entry) New member `position'.
+ (struct ps_driver_ext) Reordered. New hash table member
+ `encodings'; new members `next_position', `next_encoding',
+ `last_font'. Members `current', `prop', `fixed' changed from type
+ `font_desc *' to `font_entry *'; all references changed.
+ (struct ps_encoding) New struct.
+ (read_ps_encodings, compare_ps_encoding, hash_ps_encoding,
+ free_ps_encoding, add_encoding) New functions.
+ (ps_init_driver) Added OPO_AUTO_ENCODE to default
+ x->output_options. Initializes new members of ps_driver_ext.
+ Changed default value for prologue_fn, encoding_fn. Calls
+ read_ps_encodings after loading default fonts.
+ (option_tab[], ps_option) Handle new configuration parameter.
+ (switch_font) New function.
+ (struct output_char) `font' member changed from `font_desc *' to
+ `font_entry *'. New member `separate'.
+ (read_fontmap) Changed `size' from `int' to `size_t'.
+ (output_line, put_number) New macros for write_text().
+ (write_text) Optimizes text output by consolidating multiple
+ calls to PostScript `show' operator.
+ (text) Keeps track of when text arguments can't be consolidated by
+ write_text(), and marks those spots in the output stream.
+ (load_font) Sets `position' of the allocated font_entry to -1, cuz
+ the font hasn't been switched to by switch_font(), which is where
+ the position is important--the PostScript is what cares about the
+ position.
+
+Sat Aug 31 23:52:38 1996 Ben Pfaff <blp@gnu.org>
+
+ * hash.c: (hsh_destroy) Ignores NULL argument. Doesn't try to
+ call a NULL free_func.
+ (hsh_rehash) Elegantized.
+ (hsh_probe) Fix bug that manifested when the table was expanded
+ and thus had to change location in memory. Good thing
+ too--otherwise could have been much more subtle.
+ (hsh_find) [GLOBAL_DEBUGGING] Not stubbed out anymore.
+ (hsh_foreach) New function for hash table iteration.
+
+ * hash.h: (struct hsh_iterator) New.
+
+ * lexer.c: (parse_tagged_quote) Font and family name strings in
+ tags are now null-terminated.
+
+ * output.c: (outp_evaluate_dimension) Fixed over-aggressive unit
+ parsing.
+ (internal_get_paper_size, outp_get_paper_size) Fixed; now work as
+ documented. (Never before tested?)
+
+ * output.h: Comment changes.
+
+ * postscript.c: New driver options `optimize-text-size',
+ `optimize-line-size', `max-fonts-simult'. New enum set for
+ specing cached line types. Comment fixes.
+ (struct line_form) New struct.
+ (struct ps_driver_struct) New members `text_opt', `line_opt',
+ `max_fonts', `lines'.
+ (ps_init_driver) Initializes new members of ps_driver_struct.
+ (user option type enum set) New member `nonneg_int_arg'.
+ (static var option_tab[]) Supports new options.
+ (ps_option) Handles new options.
+ (find_ps_file) Made static. No longer calls hsh_dump().
+ (ps_get_var) Made static.
+ (preclose) Dumps out proper DSC trailer.
+ (ps_open_page) Elegantized.
+ (ps_close_page) Calls dump_lines() if appropriate.
+ (ps_line_horz, ps_line_vert, ps_line_intersection) Reduced to
+ wrappers around line().
+ (int_2_compare, compare_line, dump_line, dump_fancy_line,
+ dump_lines, hash_line, free_line, line) New functions for support
+ of line caching.
+ (write_text, text) Made static.
+ (text) Added to font support, not finished.
+
+Thu Aug 29 21:36:41 1996 Ben Pfaff <blp@gnu.org>
+
+ * font.h: (struct font_desc) New members ascent, descent.
+
+ * groff-font.c: (groff_read_font) Calculates font ascent and
+ descent from the ascent and descent of the `d' and `p' characters,
+ respectively, as per a suggestion on comp.fonts.
+
+ * postscript.c: (ps_open_page, ps_close_page, ps_line_horz,
+ ps_line_vert, ps_line_intersection) Rewritten to deal with changed
+ prologue.
+ (write_text) Handles text right-justification and centering (not
+ full justification). Still very inefficient. (One output line
+ per character?!)
+ (struct output_char) Added fields for font and font size.
+ (text) Many bugfixes.
+
+Sat Aug 24 23:26:00 1996 Ben Pfaff <blp@gnu.org>
+
+ * cmdline.c: (usage) Calls outp_list_classes().
+
+ * font.h: Comment fix.
+
+ * groff-font.c: New exported global var `space_index'.
+ (groff_init) New function to initialize `space_index'.
+ (hash_kern) Casts result to unsigned.
+ (font_name_to_index) Renamed font_char_name_to_index. All
+ references changed. Also, now returns the value of `space_index'
+ when passed an ASCII space character as an argument. Fixed
+ handling of nulls.
+ (font_get_kern_adjust) Changed i from `int' to `unsigned'.
+ Handles passed NULL pointers properly.
+
+ * lexer.c: (parse_tagged_quote) Comment fix. Better range
+ checking.
+
+ * output.c: (outp_list_drivers) Removed. Removed all references.
+
+ * output.h: Comment fixes.
+
+ * postscript.c: (ps_open_global) Calls groff_init().
+ (output_char) New structure.
+ (write_text) New function.
+ (text) No longer stubbed out! Now the output is correct--with a
+ few exceptions, one of them being that the page has to be held
+ upside down into a mirror.
+
+Sun Aug 11 21:31:22 1996 Ben Pfaff <blp@gnu.org>
+
+ * font.h: Comment fix.
+
+ * font.c: (name_to_index) Renamed font_name_to_index, made extern.
+ All callers changed.
+ (number_to_index) Renamed font_number_to_index, made extern. All
+ callers changed.
+ (font_get_kern_adjust, font_get_char_metrics) New functions.
+
+ * output.h: New constant OUTP_T_INTERNAL_DRAW.
+
+ * postscript.c: Changed default line width back to 1/2 point.
+ (ps_line_horz, ps_line_vert, ps_line_intersection) Now lines are
+ in the center of the space allotted for them, not just a fixed
+ offset from the edge of the space; this fixes some bugs.
+ (ps_line_intersection) Now supports all command line styles.
+ (ps_text_get_size) Bug fix in computation of em width.
+ (text) New function, the meat behind ps_text_metrics and
+ ps_text_draw. Not complete.
+ (ps_text_metrics, ps_text_draw) Removed the stub taken from
+ ascii.c; call text().
+
+Sat Aug 10 23:28:17 1996 Ben Pfaff <blp@gnu.org>
+
+ * arena.c: (arena_free) Assert that the argument is non-NULL.
+
+ * groff-font.c: (add_kern) Calls arena_free() for old_kern if and
+ only if old_kern is non-NULL.
+
+ * postscript.c: (ps_init_driver) Changed default line width to 1
+ point.
+ (postopen) New prologue variables.
+ (ps_line_horz, ps_line_vert, ps_line_intersection) Implements some
+ more of the common line styles properly, but not all.
+ (ps_text_metrics) Fixed problem with this stubbed out version that
+ kept it from taking font sizes into account.
+
+Thu Aug 8 22:31:11 1996 Ben Pfaff <blp@gnu.org>
+
+ * arena.c: (arena_malloc) Bug fix.
+ (arena_dump) [GLOBAL_DEBUGGING] New function.
+
+ * ascii.c: Comment fix.
+ (count_fancy_chars, delineate) Now static functions.
+
+ * filename.c: (interp_vars) Bug fixes.
+
+ * font.h: Comment fixes.
+
+ * glob.c: (init_glob) Sets set_viewwidth, set_viewlength at
+ beginning in case we have an error message to display before
+ initializing the display.
+
+ * groff-font.c: Comment fix. Changed rehash threshold from 2/3
+ full to 1/2 full.
+ (groff_read_font) Bug fixes.
+ (name_to_index) Increments hash.used. Sets `name' field of hash
+ entry properly.
+ (add_kern) Sets kern_max_used after rehashing. Other bug fixes.
+
+ * hash.c: Return type changed.
+
+ * postscript.c: Continued development. Now marks lines on the
+ paper, but very buggy.
+
+Sat Aug 3 20:50:35 1996 Ben Pfaff <blp@gnu.org>
+
+ * Changed comments in many source files from `/* xxx /* yyy */' to
+ `/* xxx */ /* yyy */' for cleanliness.
+
+ * arena.c: (arena_sd_strdup) New function.
+
+ * ascii.c: (struct ascii_driver_ext) New member `file'.
+ (ascii_init_driver) Fills out member `file' for initing; uses
+ close_file_ext for closing drivers.
+ (ascii_option) Changed %.*s back to %s because the a_string's are
+ always null-terminated.
+ (postopen, preclose) New functions.
+ (ascii_open_page) Uses new style of open_file_ext.
+ (ascii_option, commit_line_buf, output_lines) Use ext->file.file
+ instead of this->output.
+ (__assert_fail) Removed.
+
+ * cmdline.c: Changed syntax_message[].
+
+ * error.c: #include's <readline/history.h> only if the history
+ library is available, not if just the readline library is
+ available.
+
+ * filename.c: (expand_line) Removed alloca() support.
+ (interp_vars) No longer tilde-expands argument. Limit on output
+ length removed.
+ (tilde_expand) Now treats argument as path rather than filename.
+ [!unix] Now is a no-op function.
+ (search_path) Better verbose message formatting.
+ (open_file, close_file) Comment fixes.
+ (close_file) [!unix] Doesn't bother with pipes.
+ (open_file_ext) Completely rewritten, interface revamped.
+ (close_file_ext) New function.
+
+ * font.h: Comment changes.
+
+ * frequencies.q: Removed AIX alloca support since it doesn't use
+ alloca.
+
+ * hash.c: Comment changes & additions.
+ (hsh_create) Initializes entire table instead of first M entries.
+ (hsh_probe) Stupid bug fixed. Now it works.
+ (hsh_dump) [GLOBAL_DEBUGGING] New function.
+
+ * main.c: (parse) Detects EOF properly in token-eating loop.
+ Should the STOP token have its value changed to 0?
+
+ * misc.c: (blp_getdelim) [HAVE_GETDELIM] Now it's a macro.
+ (blp_getline) Now it's a macro.
+
+ * output.h: (struct outp_driver) Removed members output, filename.
+
+ * output.c: (outp_init) [!NO_POSTSCRIPT] Installs PostScript
+ drivers in driver table.
+ (outp_read_devices) Frees buf. Warns if there are no active
+ output drivers.
+ (outp_configure_clear) Sets outp_configure_vec to NULL after
+ deleting its elements.
+ (configure_driver, destroy_driver) Removed references to output,
+ filename members of outp_driver.
+ (outp_evaluate_dimension, internal_get_paper_size,
+ outp_get_paper_size) New functions.
+
+ * postscript.c: Continued development. Now links but doesn't make
+ any marks on the page. Lotsa bugs I suppose.
+
+ * str.c: (strcasecmp) [!HAVE_STRCASECMP] New function.
+
+ * str.h: Comment changes.
+
+Sat Jul 27 22:32:38 1996 Ben Pfaff <blp@gnu.org>
+
+ * Removed dependencies on non-nested comments in several files.
+ Also removed references to (unix || __unix__) in #if's since
+ prefh.orig makes those two equivalent.
+
+ * ascii.c: (ascii_open_global) Creates ascii_arena.
+ (ascii_close_global) Destroys ascii_arena.
+ (ascii_init_driver) Doesn't create ascii_arena.
+ (ascii_copy_driver) Removed.
+ (ascii_option) Possible bugfix regarding %s vs. %.*s with a_string's.
+ (outp_class ascii_class) Removed ascii_copy_driver reference.
+
+ * frequencies.q: Now can display all statistics except median.
+ Still not finished.
+
+ * output.c: Handles outp_class.ref_count so output class
+ destructors are called properly.
+ (add_class) Sets ref_count to 0.
+ (configure_driver) Initializes class if ref_count++ is 0.
+ (destroy_driver) Destructs class if --ref_count is 0. Frees the
+ class output file name.
+
+ * output.h: (struct outp_class) Removed copy_driver, inited.
+ Added ref_count.
+
+ * postscript.c: Completely replaced but not finished.
+
+Tue Jul 23 21:48:36 1996 Ben Pfaff <blp@gnu.org>
+
+ * approx.h: #includes <float.h>.
+
+ * arena.h, arena.c: Many functions changed to take an arena **
+ instead of an arena *, for consistency. All callers changed.
+ (arena_alloc) Now creates a new arena if passed *A that is NULL.
+ (arena_destroy) Sets *A to NULL.
+
+ * ascii.c: (delineate) Implements OUTP_T_VERT correctly. Removed
+ assertion that `width' be positive.
+
+ * command.c: Removed #if's from cmd_table.
+ (walk_cmdtable_func) [0] New function (debug code).
+ (init_cmd_parser) [0] Dumps out cmd_table (debug code).
+ (parse_cmd) Doesn't return failure for unimplemented commands.
+
+ * common.h: (SYSMIS) Changed from DBL_MAX to -DBL_MAX.
+ (SYSCODE) New constant macro.
+
+ * descript.q: Checks for positive n_variables before performing
+ analysis.
+
+ * file-handle.q: (get_handle_by_filename) Bug fix: passes &f to
+ avl_find instead of &fp as arg 2.
+
+ * frequencies.g, frequencies.q: Continued updating; now compiles &
+ works again, but not complete.
+
+ * main.c: Changes to user messages.
+
+ * misc.c: (reverse) [0] New function.
+
+ * settings.h: Comment removed. #includes "common.h".
+
+ * som.c: (som_set_null) New function.
+ (som_set_value, som_set_string, som_set_text) More detailing
+ assertions.
+ (som_set_float) Implemented function.
+ (dump_columnated_table) Bug fix regarding page breaks.
+ (draw_cell) Bug fix regarding text that spilled out of a cell.
+ (draw_intersection, draw_horz_rule, draw_vert_rule) No longer draw
+ null lines.
+ (get_cell_size) Support SCON_EMPTY cells.
+ (get_table_size) When calculating rules' widths and heights, mask
+ out SLIN_SPACING bit. Added SOPT_X_HLTL support.
+
+ * som.h: (som_any_cell) New option SOPT_X_HTLT. Removed
+ SOPT_X_SHADE.
+ (struct som_submission_form) New member `header'; all users
+ changed.
+
+ * val-labs.c: (get_label) User messages changed.
+
+ * var.h: Changed FREQUENCIES structures.
+
+ * vars-atr.c: (is_num_user_missing, is_str_user_missing) Made
+ inline.
+
+Fri Jul 19 19:11:13 1996 Ben Pfaff <blp@gnu.org>
+
+ * approx.h: Definition of EPSILON now depends on system's
+ DBL_EPSILON. Removed GNU C specific code.
+ (cmpapx) Renamed approx_compare.
+
+ * frequencies.g, frequencies.q: Continued updating; still doesn't
+ compile.
+
+ * groff-font.c: (name_to_index) Fix bug that kept it from
+ compiling.
+
+ * hash.c, hash.h: Completed work.
+
+ * var.h: Changes to freq_tab, frequencies_proc.
+
+Wed Jul 17 21:23:36 1996 Ben Pfaff <blp@gnu.org>
+
+ New hashing code.
+ * hash.c, hash.h: New files. Not completed.
+ * Makefile.am: Added hash.c to source file list.
+ * font.h: (struct font_desc) New member kern_size_p.
+ * groff-font.c: Uses hash.h.
+ (hashpjw) Moved to hash.c.
+ (next_prime_power) Rewrote, renamed hsh_next_prime, moved to
+ hash.c.
+ (static var hash) New member size_p.
+ * var.h: Includes hash.h.
+ (struct freq_tab) Changed AVL_TREE to hash_tab.
+
+ * vars-prs.c: Comment, formatting fixes.
+
+ * frequencies.g, frequencies.q: Continued updating. Not yet
+ working.
+
+ * formats.c: Bug fix.
+
+Tue Jul 16 22:10:04 1996 Ben Pfaff <blp@gnu.org>
+
+ Increasing parallelism between DESCRIPTIVES and FREQUENCIES.
+ * descript.g: Comment fixes.
+ * descript.q: Comment fixes. Moved some declarations into var.h.
+ Made dsc_info a static table. Updated FIXMEs.
+ (internal_cmd_descriptives) Beautified.
+
+ * frequencies.q: Started updating into working order.
+ * frequencies.g: New file analogous to descript.g.
+ * var.h: Comment fixes. Added structures for FREQUENCIES.
+
+ * som.c: Removed vestiges of crushing and partial table support.
+
+Sun Jul 14 15:45:31 1996 Ben Pfaff <blp@gnu.org>
+
+ * Many more changes to som.c especially, but these will not be
+ documented as I have resolved to remove them. This patchlevel is
+ being released solely so that I can fall back to it if I decide
+ that removing the changes is not a good idea.
+
+Sat Jul 13 09:58:44 1996 Ben Pfaff <blp@gnu.org>
+
+ * som.c: (global var som) New member `cum_y'.
+ (build_target) Properly handles titles for partial tables.
+ (dump_partial_beg, dump_partial_mid, dump_partial_end)
+ Merged into single new function dump_partial(). Fixed problem
+ with titles on partial tables.
+ (dump_table) Calls dump_partial() for all parts of partial tables.
+ (dump_page) Criteria for drawing title changed.
+
+Fri Jul 12 22:03:36 1996 Ben Pfaff <blp@gnu.org>
+
+ * command.c: (cmd_table) Added LIST, WEIGHT.
+
+ * command.c: (cmd_remark) No longer frees `s' since it's not
+ dynamically allocated.
+
+ * data-out.c: (convert_f) Now correctly handles the case where
+ abs(v->f)<1 but v->f rounds to a value of 1.00 given the specified
+ number of decimals.
+ (som_destroy_all_tables) Removed argument. All callers changed.
+ (som_vline, som_hline) Argument validity checking corrected.
+ (som_set_value) Implemented half-heartedly.
+ (replicate_table) Copies tables piece-by-piece when using Checker.
+
+ * som.h: New line style SLIN_1THIN, currently equivalent to
+ SLIN_0. New enum set SOM_SUB_*.
+ (struct som_submission_form) Removed `seq_no'. Added `type'.
+
+ * list.q: Newly working file; uses partial tables.
+
+ * som.c: (som_reduce_table) Renamed som_set_table_height().
+ (som_crush) Removed argument `group'.
+ (global var som) Removed `nt', `seq_no'. Added `type'.
+ (som_submit_table) Arguments changed.
+ (output_table) Removed partial table code.
+ (build_target) New arg; partial table support added. All callers
+ changed.
+ (dump_plain_table) Removed partial table code.
+ (dump_partial_beg, dump_partial_mid, dump_partial_end) New functions.
+ (dump_table) Supports partial tables.
+ (dump_page) New argument to allow not drawing top and/or bottom
+ headers. All callers changed. Supports partial tables.
+
+Sat Jul 6 22:22:25 1996 Ben Pfaff <blp@gnu.org>
+
+ * data-out.c: Changed `#include <approx.h>' to `#include
+ "approx.h".
+ (convert_F) Comment fix. Now won't print `-.000', etc.
+
+ * descript.q: Now Z-scores work, although there appears to
+ be a bug (which might actually be in data-out.c:convert_F()).
+ (descriptives_trns_proc, descriptives_trns_free) New functions.
+ (run_z_pass) Implemented.
+
+ * var.h: Comment fixes.
+ (dsc_z_score, descriptives_trns) New structs.
+ (descriptives_trns) Added to any_trns as `dsc'.
+
+ * error.c, error.h: New error class, IS (Installation Script
+ error), used in those instances where the error is in the
+ installation, but there is a script file or installation file that
+ can be usefully referred to.
+
+ * output.c: Change many IE classes to IS classes.
+
+ * cases.c, command.c, common.c, crosstabs.q, expr-evl.c,
+ frequencies.q, list.q, vars-prs.c, vfm.c: Removed reference to
+ HAVE_MALLOC_H because Borland C++ alloca() is broken, so why
+ include the corresponding header?
+
+ * glob.c: (init_glob) Don't malloc term_buffer under Checker.
+ Don't bail out if termcap can't be read.
+
+ * som.c: (som_destroy_table) Removed.
+ (som_reduce_table, som_destroy_all_tables) New functions.
+ (som_crush) New function, not implemented.
+
+ * som.h: New table option STAB_CRUSH. Comment fix. New struct
+ som_submission_form. Function prototypes revised.
+
+ Outputting huge tables (1000s of rows) a few rows at a time
+ is supported, though untested. May even break everything.
+ Actually, the code doesn't even compile right now.
+ * som.c: (struct som) New fields htv, nt, seq_no.
+ (som_submit_table) Multiple arguments changed to a single
+ pointer to struct submission_form. Only increments subtable_num
+ if seq_no is zero. Only destroys table if it's not going to
+ be reused.
+ (replicate_table) New function.
+ (output_table) Comment fix.
+ (examine_table) Changed inline code to code calling
+ replicate_table(). Calculates htv. Supports partial tables.
+ (draw_title) Removed comment.
+ (build_target) Only allows for title on first part of partial
+ tables.
+ (dump_plain_table) Only resets table chunk number on first part
+ of partial tables; FIXME: doesn't work quite right. Supports
+ partial tables.
+ (dump_page) Titles only on first part of partial tables.
+
+Fri Jul 5 20:16:19 1996 Ben Pfaff <blp@gnu.org>
+
+ * Thanks to an unreliable IDE hard drive, I have spent the last
+ day reconstructing my Debian GNU/Linux installation and redoing
+ the previous day's changes--somehow I managed to save every file
+ except for output.c and output.h. So the following changes could
+ really be considered independent of the output.c, output.h changes
+ from Jul 4.
+
+ * output.h, output.c: Moved the outp_configure_vec global var,
+ outp_names struct, and enum set OUTP_S_* from output.h to output.c.
+ outp_configure_vec is now static.
+
+Thu Jul 4 20:20:24 1996 Ben Pfaff <blp@gnu.org>
+
+ * The entire philosophy behind configuration of the output drivers
+ changed. Now there is a termcap-type configuration where drivers
+ to be read are determined beforehand, rather than parsing the
+ entire output init file and storing it in memory & deciding what
+ to actually use later. Faster & more memory-efficient at the same
+ time, cool.
+
+ * output.c: Comment fix. Removed outp_init_drivers global var.
+ Removed all references to synonyms. New structure outp_defn. New
+ global vars outp_macros, outp_configure_vec.
+ (search_name, delete_name, add_name, check_configure_vec,
+ expand_name, find_defn_value) New static functions.
+ (outp_configure_clear, outp_configure_add, outp_configure_macro,
+ outp_read_devices) New extern functions.
+ (outp_init) Much functionality moved into outp_read_devices.
+ (outp_read_devices) Format of output init file changed; name of
+ file is `devices' rather than `output' to avoid Makefile
+ conflicts.
+ (outp_clear) Renamed outp_done.
+ (outp_list_classes) Bug fix, cleaned up.
+ (outp_list_drivers) Not implemented anymore.
+ (outp_configure_driver) Now a static function; simplified; now
+ interpolates macros; supports new structure.
+ (outp_enable_driver, match_synonym) Removed; all references
+ removed.
+ (find_driver) First argument removed.
+
+ * output.h: Global var outp_init_drivers removed; new structure
+ outp_names; new enum set OUTP_S_*; new global var
+ outp_configure_vec; function prototypes for output.c exports
+ updated.
+
+ * main.c: (main) Calls outp_read_devices() after parsing the
+ command line.
+
+ * cmdline.c: (parse_command_line) New option -v --verbose;
+ --version changed to -V. --device option changed syntax to just
+ take a single device name. Accepts key=value declaration of
+ output init file macros. Syntax message updated.
+
+ * filename.c: (expand_line) New function.
+ (interp_environ_vars) Renamed interp_vars; no longer uses
+ fixed-size buffer.
+ (blp_getenv) Allows $ARCH and $VER pseudo-environment-vars to be
+ overridden by real environment vars.
+ (search_path) Uses verbose_msg() instead of #ifdef'd printf().
+ * filename.h: interp_environ_vars() renamed interp_vars().
+
+ * error.c, error.h: Added extern variable `verbosity', message
+ class MM.
+
+ * error.c: (vmsg) Support message class MM.
+ (verbose_msg) New function.
+
+ * descript.q: (generate_z_varname) Bug fix in generation of
+ Z-score varnames.
+ (dump_z_table) Bug fix in column headers.
+
+ * ascii.c: (ascii_init_driver) Changed minimum number of lines per
+ page from 29 to 15. Don't set a default for ops[OPS_INIT,
+ OPS_DONE]. Writes the uninit string when the driver is closed.
+ (ascii_open_page) Write the init string before the first page.
+ (output_shorts) Form of main loop changed from `while' to `for'.
+ Bug fix with overstrikes: the character is printed *after* the
+ backspace. Eliminated a lot of `& 0xff' modifiers.
+ (advance_to_left_margin) New function.
+ (return_carriage, output_lines) Handle left margin.
+
+Thu Jul 4 00:35:59 1996 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: New option `carriage-return-style'.
+
+ * ascii.c: (count_fancy_chars) New function.
+ (delineate, text_metrics) Use new function; bug fixes regarding
+ rich text strings.
+ (text_draw) Bug fix with rich text.
+ (output_string, output_shorts) Reordered.
+ (output_shorts) Now handles boxchars and some overstrike font
+ changes.
+ (output_char, return_carriage) New functions.
+ (output_lines) Now handles overstriking and font changes properly;
+ some code moved to output_shorts.
+
+Tue Jul 2 22:13:23 1996 Ben Pfaff <blp@gnu.org>
+
+ [GLOBAL_DEBUGGING]
+ * ascii.c: New member `debug' in ascii_driver_ext.
+ (ascii_init_driver, delineate) Uses new member.
+
+ Now you can set a vertical height on writing text.
+ * ascii.c: (delineate) Keeps track of vertical position.
+ (text_draw) No longer considers fully justified text an internal
+ error.
+
+ * output.h: New flag OUTP_T_VERT; other OUTP_T_ values changed.
+
+ Tables' titles are drawn; they can have variable height.
+ * som.c: `som' struct has new member, title_height.
+ (draw_title) New argument. Moved within file. All caller
+ changed.
+ (build_target) New argument, amount of space needed for first row.
+ Calculates height of title, takes that into account. All callers
+ changed.
+ (dump_plain_table, dump_columnated_table) Took calculation of y1,
+ y2 out of loop.
+ (dump_columnated_table) [GLOBAL_DEBUGGING] Debugging code
+ improved.
+ (dump_columnated_table) Organized for readability.
+ (dump_page) Makes use of som.title_height.
+
+ * som.c: Many comment bug fixes.
+
+ * descript.q: (try_name, generate_z_name) Bug fix regarding
+ generation of Z-score variable names.
+ * var.h: Removed num from descriptives_proc; all referents removed.
+
+Mon Jul 1 22:13:39 1996 Ben Pfaff <blp@gnu.org>
+
+ * ascii.c: (ascii_line_horz, ascii_line_vert,
+ ascii_line_intersection) Added debugging code.
+
+ Added a descriptive line above each table to describe it.
+ * command.c: (parse_cmd) Calls som_new_series.
+
+ * som.c: New static vars table_num, subtable_num. New `som'
+ member `title'.
+ (dump_page) New arguments.
+ (som_submit_table) Handle new variables.
+
+ * som.c, som.h: (som_submit_table) New arguments. All callers
+ changed.
+ (som_new_series) New function.
+ (build_target) Makes room for extra line.
+ (draw_title) New function.
+ (dump_page) Calls draw_title. Bug fix: doesn't always set
+ som.ext->cp to 0.
+
+ Columnation of tables support.
+ * som.h: Deleted fr, lr, ri from som_table. Reorganized.
+
+ * som.c: Deleted references to fr, lr, ri.
+ (som_columnate) Bux fix: sets group member of table.
+ (som_add_options) Function removed.
+ (dump_table) Split into three functions; extensively reworked.
+
+ * descript.q: (dump_z_table) Better output table formatting; added
+ title support to correspond to som.h changes.
+ (display) Title support.
+
+ * output.h: Added OUTP_T_NONE.
+
+Mon Jul 1 13:00:00 1996 Ben Pfaff <blp@gnu.org>
+
+ * descript.q: Improved handling of Z scores; still not perfect.
+
+ * output.h, ascii.c: Added hook for getting em width of current
+ font.
+
+ * som.c: Uses new em-width hook. Added debugging code to
+ several functions.
+ (som_columnate) New argument.
+ (som_add_options) Removed.
+
+Jun 29 17:40:47 1996 Ben Pfaff <blp@gnu.org>
+
+ * som.h, som.c, output.c, output.h, ascii.c: Updated to work with
+ rules as a property of the table instead of as a property of the
+ cells.
+
+ * ascii.c: Added `header' to table of options.
+
+ * descript.q: Added even shorter statistic names; modified to work
+ with new som interface.
+
+ * misc.c (blp_getdelim): Bug fix.
+
+ * version.c: includes 'conf.h'.
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+## Process this file with automake to produce Makefile.in -*- makefile -*-
+
+# PSPP
+
+bin_PROGRAMS = pspp
+
+INCLUDES = -I$(top_srcdir) -I$(top_srcdir)/src -I$(top_srcdir)/lib \
+-I$(top_srcdir)/intl
+
+DISTCLEANFILES = foo $(q_sources_c)
+MAINTAINERCLEANFILES = Makefile.in
+EXTRA_DIST = $(q_sources_q) q2c.c
+ETAGS_ARGS = -l c $(q_sources_c)
+SUFFIXES = .q
+
+$(q_sources_c): q2c
+.q.c:
+ ./q2c $< $@
+
+q_sources_c = correlations.c crosstabs.c descript.c file-handle.c \
+frequencies.c list.c means.c set.c t-test.c
+
+q_sources_q = correlations.q crosstabs.q descript.q file-handle.q \
+frequencies.q list.q means.q set.q t-test.q
+
+pspp_SOURCES = aggregate.c alloc.c alloc.h apply-dict.c approx.h \
+ascii.c autorecode.c avl.c avl.h bitvector.h cases.c cases.h cmdline.c \
+command.c command.def command.h compute.c correlations.c count.c \
+crosstabs.c data-in.c data-in.h data-list.c data-out.c debug-print.h \
+descript.c dfm.c dfm.h do-if.c do-ifP.h error.c error.h expr-evl.c \
+expr-opt.c expr-prs.c expr.h exprP.h file-handle.c file-handle.h \
+file-type.c filename.c filename.h flip.c font.h format.c format.def \
+format.h formats.c frequencies.c frequencies.g get.c getline.c \
+getline.h glob.c groff-font.c hash.c hash.h heap.c heap.h html.c \
+htmlP.h include.c inpt-pgm.c inpt-pgm.h lexer.c lexer.h list.c log.h \
+loop.c magic.c magic.h main.c main.h matrix-data.c matrix.c matrix.h \
+means.c mis-val.c misc.c misc.h modify-vars.c numeric.c output.c \
+output.h pfm-read.c pfm-write.c pfm.h pool.c pool.h postscript.c \
+print.c random.c random.h recode.c rename-vars.c repeat.c sample.c \
+sel-if.c set.c settings.h sfm-read.c sfm-write.c sfm.h sfmP.h som.c \
+som.h sort.c sort.h split-file.c stat.h stats.c stats.h str.c str.h \
+sysfile-info.c tab.c tab.h temporary.c title.c t-test.c val-labs.c \
+var-labs.c var.h vars-atr.c vars-prs.c vector.c vector.h version.c \
+version.h vfm.c vfm.h vfmP.h weight.c
+
+GMP_LIBS = ../lib/gmp/mpf/libmpf.a \
+ ../lib/gmp/mpn/libmpn.a \
+ ../lib/gmp/libgmp.a
+
+LDADD = ../lib/julcal/libjulcal.a \
+ ../lib/misc/libmisc.a \
+ ../lib/dcdflib/libdcdflib.a \
+ @GMP_LIBS@ @INTLLIBS@
+
+version.c:
+ echo "#include <config.h>" > version.c
+ echo "const char bare_version[] = \"@VERSION@\";" >> version.c
+ echo "const char version[] = GNU_PACKAGE \" @VERSION@\";" >> version.c
+ echo "const char stat_version[] = GNU_PACKAGE \" @VERSION@ \
+(`date`).\";" >> version.c
+ echo "const char host_system[] = \"$(host_triplet)\";" >> version.c
+ echo "const char build_system[] = \"$(build_triplet)\";" >> version.c
+ echo "const char default_config_path[] =\
+\"~/.pspp:$(pkgsysconfdir)\";" >> version.c
+ echo "const char include_path[] =\
+\"./:~/.pspp/include:$(pkgdatadir)\";" >> version.c
+ echo "const char groff_font_path[] = \"~/.pspp/font:\" \\" >> version.c
+ echo " \"$(pkgdatadir)/font:\" \\" >> version.c
+ echo " \"/usr/local/lib/groff/font:\" \\" >> version.c
+ echo " \"/usr/lib/groff/font:\" \\" >> version.c
+ echo " \"/usr/local/share/groff/font:\" \\" >> version.c
+ echo " \"/usr/share/groff/font\";" >> version.c
+ echo "const char locale_dir[] = \"$(datadir)/locale\";" >> version.c
+\f
+# q2c
+
+LOCAL_CC = @LOCAL_CC@
+LOCAL_COMPILE = $(LOCAL_CC) -c $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)
+LOCAL_LINK = $(LOCAL_CC) $(LDFLAGS) -o $@
+
+q2c.o: q2c.c
+ $(LOCAL_COMPILE) $< -o q2c.o
+q2c: q2c.o
+ $(LOCAL_LINK) q2c.o ../lib/misc/libmisc.a -o q2c
+
+CLEANFILES = q2c
+MAINTAINERCLEANFILES = Makefile.in
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "approx.h"
+#include "command.h"
+#include "error.h"
+#include "file-handle.h"
+#include "lexer.h"
+#include "misc.h"
+#include "settings.h"
+#include "sfm.h"
+#include "sort.h"
+#include "stats.h"
+#include "str.h"
+#include "var.h"
+#include "vfm.h"
+#include "vfmP.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* Specifies how to make an aggregate variable. */
+struct agr_var
+ {
+ struct agr_var *next; /* Next in list. */
+
+ /* Collected during parsing. */
+ struct variable *src; /* Source variable. */
+ struct variable *dest; /* Target variable. */
+ int function; /* Function. */
+ int include_missing; /* 1=Include user-missing values. */
+ union value arg[2]; /* Arguments. */
+
+ /* Accumulated during AGGREGATE execution. */
+ double dbl[3];
+ int int1, int2;
+ char *string;
+ int missing;
+ };
+
+/* Aggregation functions. */
+enum
+ {
+ NONE, SUM, MEAN, SD, MAX, MIN, PGT, PLT, PIN, POUT, FGT, FLT, FIN,
+ FOUT, N, NU, NMISS, NUMISS, FIRST, LAST,
+ N_AGR_FUNCS, N_NO_VARS, NU_NO_VARS,
+ FUNC = 0x1f, /* Function mask. */
+ FSTRING = 1<<5, /* String function bit. */
+ FWEIGHT = 1<<6, /* Weighted function bit. */
+ FOPTIONS = FSTRING | FWEIGHT /* Function options mask. */
+ };
+
+/* Attributes of an aggregation function. */
+struct agr_func
+ {
+ const char *name; /* Aggregation function name. */
+ int n_args; /* Number of arguments. */
+ int alpha_type; /* When given ALPHA arguments, output type. */
+ struct fmt_spec format; /* Format spec if alpha_type != ALPHA. */
+ };
+
+/* Attributes of aggregation functions. */
+static struct agr_func agr_func_tab[] =
+ {
+ {"<NONE>", 0, -1, {0, 0, 0}},
+ {"SUM", 0, -1, {FMT_F, 8, 2}},
+ {"MEAN", 0, -1, {FMT_F, 8, 2}},
+ {"SD", 0, -1, {FMT_F, 8, 2}},
+ {"MAX", 0, ALPHA, {-1, -1, -1}},
+ {"MIN", 0, ALPHA, {-1, -1, -1}},
+ {"PGT", 1, NUMERIC, {FMT_F, 5, 1}},
+ {"PLT", 1, NUMERIC, {FMT_F, 5, 1}},
+ {"PIN", 2, NUMERIC, {FMT_F, 5, 1}},
+ {"POUT", 2, NUMERIC, {FMT_F, 5, 1}},
+ {"FGT", 1, NUMERIC, {FMT_F, 5, 3}},
+ {"FLT", 1, NUMERIC, {FMT_F, 5, 3}},
+ {"FIN", 2, NUMERIC, {FMT_F, 5, 3}},
+ {"FOUT", 2, NUMERIC, {FMT_F, 5, 3}},
+ {"N", 0, NUMERIC, {FMT_F, 7, 0}},
+ {"NU", 0, NUMERIC, {FMT_F, 7, 0}},
+ {"NMISS", 0, NUMERIC, {FMT_F, 7, 0}},
+ {"NUMISS", 0, NUMERIC, {FMT_F, 7, 0}},
+ {"FIRST", 0, ALPHA, {-1, -1, -1}},
+ {"LAST", 0, ALPHA, {-1, -1, -1}},
+ {NULL, 0, -1, {-1, -1, -1}},
+ {"N", 0, NUMERIC, {FMT_F, 7, 0}},
+ {"NU", 0, NUMERIC, {FMT_F, 7, 0}},
+ };
+
+/* Output file, or NULL for the active file. */
+static struct file_handle *outfile;
+
+/* Missing value types. */
+enum
+ {
+ ITEMWISE, /* Missing values item by item. */
+ COLUMNWISE /* Missing values column by column. */
+ };
+
+/* ITEMWISE or COLUMNWISE. */
+static int missing;
+
+/* Aggregate variables. */
+static struct agr_var *agr_first, *agr_next;
+
+/* Aggregate dictionary. */
+static struct dictionary *agr_dict;
+
+/* Number of cases passed through aggregation. */
+static int case_count;
+
+/* Last values of the break variables. */
+static union value *prev_case;
+
+/* Buffers for use by the 10x transformation. */
+static flt64 *buf64_1xx;
+static struct ccase *buf_1xx;
+
+static void initialize_aggregate_info (void);
+
+/* Prototypes. */
+static int parse_aggregate_functions (void);
+static void free_aggregate_functions (void);
+static int aggregate_single_case (struct ccase *input, struct ccase *output);
+static int create_sysfile (void);
+
+static int agr_00x_trns_proc (struct trns_header *, struct ccase *);
+static void agr_00x_end_func (void);
+static int agr_10x_trns_proc (struct trns_header *, struct ccase *);
+static void agr_10x_trns_free (struct trns_header *);
+static void agr_10x_end_func (void);
+static int agr_11x_func (void);
+
+#if DEBUGGING
+static void debug_print (int flags);
+#endif
+\f
+/* Parsing. */
+
+/* Parses and executes the AGGREGATE procedure. */
+int
+cmd_aggregate (void)
+{
+ /* From sort.c. */
+ int parse_sort_variables (void);
+
+ /* Have we seen these subcommands? */
+ unsigned seen = 0;
+
+ outfile = NULL;
+ missing = ITEMWISE;
+ v_sort = NULL;
+ prev_case = NULL;
+
+ agr_dict = new_dictionary (1);
+
+ lex_match_id ("AGGREGATE");
+
+ /* Read most of the subcommands. */
+ for (;;)
+ {
+ lex_match('/');
+
+ if (lex_match_id ("OUTFILE"))
+ {
+ if (seen & 1)
+ {
+ free (v_sort);
+ free_dictionary (agr_dict);
+ msg (SE, _("OUTFILE specified multiple times."));
+ return CMD_FAILURE;
+ }
+ seen |= 1;
+
+ lex_match ('=');
+ if (lex_match ('*'))
+ outfile = NULL;
+ else
+ {
+ outfile = fh_parse_file_handle ();
+ if (outfile == NULL)
+ {
+ free (v_sort);
+ free_dictionary (agr_dict);
+ return CMD_FAILURE;
+ }
+ }
+ }
+ else if (lex_match_id ("MISSING"))
+ {
+ lex_match ('=');
+ if (!lex_match_id ("COLUMNWISE"))
+ {
+ free (v_sort);
+ free_dictionary (agr_dict);
+ lex_error (_("while expecting COLUMNWISE"));
+ return CMD_FAILURE;
+ }
+ missing = COLUMNWISE;
+ }
+ else if (lex_match_id ("DOCUMENT"))
+ seen |= 2;
+ else if (lex_match_id ("PRESORTED"))
+ seen |= 4;
+ else if (lex_match_id ("BREAK"))
+ {
+ if (seen & 8)
+ {
+ free (v_sort);
+ free_dictionary (agr_dict);
+ msg (SE, _("BREAK specified multiple times."));
+ return CMD_FAILURE;
+ }
+ seen |= 8;
+
+ lex_match ('=');
+ if (!parse_sort_variables ())
+ {
+ free_dictionary (agr_dict);
+ return CMD_FAILURE;
+ }
+
+ {
+ int i;
+
+ for (i = 0; i < nv_sort; i++)
+ {
+ struct variable *v;
+
+ v = dup_variable (agr_dict, v_sort[i], v_sort[i]->name);
+ assert (v != NULL);
+ }
+ }
+ }
+ else break;
+ }
+
+ /* Check for proper syntax. */
+ if (!(seen & 8))
+ msg (SW, _("BREAK subcommand not specified."));
+
+ /* Read in the aggregate functions. */
+ if (!parse_aggregate_functions ())
+ {
+ free_aggregate_functions ();
+ free (v_sort);
+ return CMD_FAILURE;
+ }
+
+ /* Delete documents. */
+ if (!(seen & 2))
+ {
+ free (agr_dict->documents);
+ agr_dict->documents = NULL;
+ agr_dict->n_documents = 0;
+ }
+
+ /* Cancel SPLIT FILE. */
+ default_dict.n_splits = 0;
+ free (default_dict.splits);
+ default_dict.splits = NULL;
+
+#if DEBUGGING
+ debug_print (seen);
+#endif
+
+ /* Initialize. */
+ case_count = 0;
+ initialize_aggregate_info ();
+
+ /* How to implement all this... There are three important variables:
+ whether output is going to the active file (0) or a separate file
+ (1); whether the input data is presorted (0) or needs sorting
+ (1); whether there is a temporary transformation (1) or not (0).
+ The eight cases are as follows:
+
+ 000 (0): Pass it through an aggregate transformation that
+ modifies the data.
+
+ 001 (1): Cancel the temporary transformation and handle as 000.
+
+ 010 (2): Set up a SORT CASES and aggregate the output, writing
+ the results to the active file.
+
+ 011 (3): Cancel the temporary transformation and handle as 010.
+
+ 100 (4): Pass it through an aggregate transformation that doesn't
+ modify the data but merely writes it to the output file.
+
+ 101 (5): Handled as 100.
+
+ 110 (6): Set up a SORT CASES and capture the output, aggregate
+ it, write it to the output file without modifying the active
+ file.
+
+ 111 (7): Handled as 110. */
+
+ {
+ unsigned type = 0;
+
+ if (outfile != NULL)
+ type |= 4;
+ if (nv_sort != 0 && (seen & 4) == 0)
+ type |= 2;
+ if (temporary)
+ type |= 1;
+
+ switch (type)
+ {
+ case 3:
+ cancel_temporary ();
+ /* fall through */
+ case 2:
+ sort_cases (0);
+ goto case0;
+
+ case 1:
+ cancel_temporary ();
+ /* fall through */
+ case 0:
+ case0:
+ {
+ struct trns_header *t = xmalloc (sizeof *t);
+ t->proc = agr_00x_trns_proc;
+ t->free = NULL;
+ add_transformation (t);
+
+ temporary = 2;
+ temp_dict = agr_dict;
+ temp_trns = n_trns;
+
+ agr_dict = NULL;
+
+ procedure (NULL, NULL, agr_00x_end_func);
+ break;
+ }
+
+ case 4:
+ case 5:
+ {
+ if (!create_sysfile ())
+ goto lossage;
+
+ {
+ struct trns_header *t = xmalloc (sizeof *t);
+ t->proc = agr_10x_trns_proc;
+ t->free = agr_10x_trns_free;
+ add_transformation (t);
+
+ procedure (NULL, NULL, agr_10x_end_func);
+ }
+
+ break;
+ }
+
+ case 6:
+ case 7:
+ sort_cases (1);
+
+ if (!create_sysfile ())
+ goto lossage;
+ read_sort_output (agr_11x_func);
+
+ {
+ struct ccase *save_temp_case = temp_case;
+ temp_case = NULL;
+ agr_11x_func ();
+ temp_case = save_temp_case;
+ }
+
+ break;
+
+ default:
+ assert (0);
+ }
+ }
+
+ free (buf64_1xx);
+ free (buf_1xx);
+
+ /* Clean up. */
+ free (v_sort);
+ free_aggregate_functions ();
+ free (prev_case);
+
+ return CMD_SUCCESS;
+
+lossage:
+ /* Clean up. */
+ free (v_sort);
+ free_aggregate_functions ();
+ free (prev_case);
+
+ return CMD_FAILURE;
+}
+
+/* Create a system file for use in aggregation to an external file,
+ and allocate temporary buffers for writing out cases. */
+static int
+create_sysfile (void)
+{
+ struct sfm_write_info w;
+ w.h = outfile;
+ w.dict = agr_dict;
+ w.compress = set_scompression;
+ if (!sfm_write_dictionary (&w))
+ {
+ free_aggregate_functions ();
+ free (v_sort);
+ free_dictionary (agr_dict);
+ return 0;
+ }
+
+ buf64_1xx = xmalloc (sizeof *buf64_1xx * w.case_size);
+ buf_1xx = xmalloc (sizeof (struct ccase) + sizeof (union value) * (agr_dict->nval - 1));
+
+ return 1;
+}
+
+/* Parse all the aggregate functions. */
+static int
+parse_aggregate_functions (void)
+{
+ agr_first = agr_next = NULL;
+
+ /* Anticipate weighting for optimization later. */
+ update_weighting (&default_dict);
+
+ /* Parse everything. */
+ for (;;)
+ {
+ char **dest;
+ char **dest_label;
+ int n_dest;
+
+ int include_missing;
+ struct agr_func *function;
+ int func_index;
+
+ union value arg[2];
+
+ struct variable **src;
+ int n_src;
+
+ int i;
+
+ dest = NULL;
+ dest_label = NULL;
+ n_dest = 0;
+ src = NULL;
+ n_src = 0;
+ arg[0].c = NULL;
+ arg[1].c = NULL;
+
+ /* Parse the list of target variables. */
+ while (!lex_match ('='))
+ {
+ int n_dest_prev = n_dest;
+
+ if (!parse_DATA_LIST_vars (&dest, &n_dest, PV_APPEND | PV_SINGLE | PV_NO_SCRATCH))
+ goto lossage;
+
+ /* Assign empty labels. */
+ {
+ int j;
+
+ dest_label = xrealloc (dest_label, sizeof *dest_label * n_dest);
+ for (j = n_dest_prev; j < n_dest; j++)
+ dest_label[j] = NULL;
+ }
+
+ if (token == T_STRING)
+ {
+ ds_truncate (&tokstr, 120);
+ dest_label[n_dest - 1] = xstrdup (ds_value (&tokstr));
+ lex_get ();
+ }
+ }
+
+ /* Get the name of the aggregation function. */
+ if (token != T_ID)
+ {
+ lex_error (_("expecting aggregation function"));
+ goto lossage;
+ }
+
+ include_missing = 0;
+ if (tokid[strlen (tokid) - 1] == '.')
+ {
+ include_missing = 1;
+ tokid[strlen (tokid) - 1] = 0;
+ }
+
+ for (function = agr_func_tab; function->name; function++)
+ if (!strcmp (function->name, tokid))
+ break;
+ if (NULL == function->name)
+ {
+ msg (SE, _("Unknown aggregation function %s."), tokid);
+ goto lossage;
+ }
+ func_index = function - agr_func_tab;
+ lex_get ();
+
+ /* Check for leading lparen. */
+ if (!lex_match ('('))
+ {
+ if (func_index == N)
+ func_index = N_NO_VARS;
+ else if (func_index == NU)
+ func_index = NU_NO_VARS;
+ else
+ {
+ lex_error (_("expecting `('"));
+ goto lossage;
+ }
+ } else {
+ /* Parse list of source variables. */
+ {
+ int pv_opts = PV_NO_SCRATCH;
+
+ if (func_index == SUM || func_index == MEAN || func_index == SD)
+ pv_opts |= PV_NUMERIC;
+ else if (function->n_args)
+ pv_opts |= PV_SAME_TYPE;
+
+ if (!parse_variables (&default_dict, &src, &n_src, pv_opts))
+ goto lossage;
+ }
+
+ /* Parse function arguments, for those functions that
+ require arguments. */
+ if (function->n_args != 0)
+ for (i = 0; i < function->n_args; i++)
+ {
+ int type;
+
+ lex_match (',');
+ if (token == T_STRING)
+ {
+ arg[i].c = xstrdup (ds_value (&tokstr));
+ type = ALPHA;
+ }
+ else if (token == T_NUM)
+ {
+ arg[i].f = tokval;
+ type = NUMERIC;
+ } else {
+ msg (SE, _("Missing argument %d to %s."), i + 1, function->name);
+ goto lossage;
+ }
+
+ lex_get ();
+
+ if (type != src[0]->type)
+ {
+ msg (SE, _("Arguments to %s must be of same type as "
+ "source variables."),
+ function->name);
+ goto lossage;
+ }
+ }
+
+ /* Trailing rparen. */
+ if (!lex_match(')'))
+ {
+ lex_error (_("expecting `)'"));
+ goto lossage;
+ }
+
+ /* Now check that the number of source variables match the
+ number of target variables. Do this here because if we
+ do it earlier then the user can get very misleading error
+ messages; i.e., `AGGREGATE x=SUM(y t).' will get this
+ error message when a proper message would be more like
+ `unknown variable t'. */
+ if (n_src != n_dest)
+ {
+ msg (SE, _("Number of source variables (%d) does not match "
+ "number of target variables (%d)."),
+ n_src, n_dest);
+ goto lossage;
+ }
+ }
+
+ /* Finally add these to the linked list of aggregation
+ variables. */
+ for (i = 0; i < n_dest; i++)
+ {
+ struct agr_var *v = xmalloc (sizeof *v);
+
+ /* Add variable to chain. */
+ if (agr_first)
+ agr_next = agr_next->next = v;
+ else
+ agr_first = agr_next = v;
+ agr_next->next = NULL;
+
+ /* Create the target variable in the aggregate
+ dictionary. */
+ {
+ struct variable *destvar;
+
+ agr_next->function = func_index;
+
+ if (src)
+ {
+ int output_type;
+
+ agr_next->src = src[i];
+
+ if (src[i]->type == ALPHA)
+ {
+ agr_next->function |= FSTRING;
+ agr_next->string = xmalloc (src[i]->width);
+ }
+
+ if (default_dict.weight_index != -1)
+ agr_next->function |= FWEIGHT;
+
+ if (agr_next->src->type == NUMERIC)
+ output_type = NUMERIC;
+ else
+ output_type = function->alpha_type;
+
+ if (function->alpha_type == ALPHA)
+ destvar = dup_variable (agr_dict, agr_next->src, dest[i]);
+ else
+ {
+ destvar = create_variable (agr_dict, dest[i], output_type,
+ agr_next->src->width);
+ if (output_type == NUMERIC)
+ destvar->print = destvar->write = function->format;
+ if (output_type == NUMERIC && default_dict.weight_index != -1
+ && (func_index == N || func_index == N_NO_VARS
+ || func_index == NU || func_index == NU_NO_VARS))
+ {
+ struct fmt_spec f = {FMT_F, 8, 2};
+
+ destvar->print = destvar->write = f;
+ }
+ }
+ } else {
+ agr_next->src = NULL;
+ destvar = create_variable (agr_dict, dest[i], NUMERIC, 0);
+ }
+
+ if (!destvar)
+ {
+ msg (SE, _("Variable name %s is not unique within the "
+ "aggregate file dictionary, which contains "
+ "the aggregate variables and the break "
+ "variables."),
+ dest[i]);
+ free (dest[i]);
+ goto lossage;
+ }
+
+ free (dest[i]);
+ if (dest_label[i])
+ {
+ destvar->label = dest_label[i];
+ dest_label[i] = NULL;
+ }
+ else if (function->alpha_type == ALPHA)
+ destvar->print = destvar->write = function->format;
+
+ agr_next->dest = destvar;
+ }
+
+ agr_next->include_missing = include_missing;
+
+ if (agr_next->src != NULL)
+ {
+ int j;
+
+ if (agr_next->src->type == NUMERIC)
+ for (j = 0; j < function->n_args; j++)
+ agr_next->arg[j].f = arg[j].f;
+ else
+ for (j = 0; j < function->n_args; j++)
+ agr_next->arg[j].c = xstrdup (arg[j].c);
+ }
+ }
+
+ if (src != NULL && src[0]->type == ALPHA)
+ for (i = 0; i < function->n_args; i++)
+ {
+ free (arg[i].c);
+ arg[i].c = NULL;
+ }
+
+ free (src);
+ free (dest);
+ free (dest_label);
+
+ if (!lex_match ('/'))
+ {
+ if (token == '.')
+ return 1;
+
+ lex_error ("expecting end of command");
+ return 0;
+ }
+ continue;
+
+ lossage:
+ for (i = 0; i < n_dest; i++)
+ {
+ free (dest[i]);
+ free (dest_label[i]);
+ }
+ free (dest);
+ free (dest_label);
+ free (arg[0].c);
+ free (arg[1].c);
+ if (src && n_src && src[0]->type == ALPHA)
+ for (i = 0; i < function->n_args; i++)
+ {
+ free(arg[i].c);
+ arg[i].c = NULL;
+ }
+ free (src);
+
+ return 0;
+ }
+}
+
+/* Frees all the state for the AGGREGATE procedure. */
+static void
+free_aggregate_functions (void)
+{
+ struct agr_var *iter, *next;
+
+ if (agr_dict)
+ free_dictionary (agr_dict);
+ for (iter = agr_first; iter; iter = next)
+ {
+ next = iter->next;
+
+ if (iter->function & FSTRING)
+ {
+ int n_args;
+ int i;
+
+ n_args = agr_func_tab[iter->function & FUNC].n_args;
+ for (i = 0; i < n_args; i++)
+ free (iter->arg[i].c);
+ free (iter->string);
+ }
+ free (iter);
+ }
+}
+\f
+/* Execution. */
+
+static void accumulate_aggregate_info (struct ccase *input);
+static void dump_aggregate_info (struct ccase *output);
+
+/* Processes a single case INPUT for aggregation. If output is
+ warranted, it is written to case OUTPUT, which may be (but need not
+ be) an alias to INPUT. Returns -1 when output is performed, -2
+ otherwise. */
+/* The code in this function has an eerie similarity to
+ vfm.c:SPLIT_FILE_procfunc()... */
+static int
+aggregate_single_case (struct ccase *input, struct ccase *output)
+{
+ /* The first case always begins a new break group. We also need to
+ preserve the values of the case for later comparison. */
+ if (case_count++ == 0)
+ {
+ int n_elem = 0;
+
+ {
+ int i;
+
+ for (i = 0; i < nv_sort; i++)
+ n_elem += v_sort[i]->nv;
+ }
+
+ prev_case = xmalloc (sizeof *prev_case * n_elem);
+
+ /* Copy INPUT into prev_case. */
+ {
+ union value *iter = prev_case;
+ int i;
+
+ for (i = 0; i < nv_sort; i++)
+ {
+ struct variable *v = v_sort[i];
+
+ if (v->type == NUMERIC)
+ (iter++)->f = input->data[v->fv].f;
+ else
+ {
+ memcpy (iter->s, input->data[v->fv].s, v->width);
+ iter += v->nv;
+ }
+ }
+ }
+
+ accumulate_aggregate_info (input);
+
+ return -2;
+ }
+
+ /* Compare the value of each break variable to the values on the
+ previous case. */
+ {
+ union value *iter = prev_case;
+ int i;
+
+ for (i = 0; i < nv_sort; i++)
+ {
+ struct variable *v = v_sort[i];
+
+ switch (v->type)
+ {
+ case NUMERIC:
+ if (approx_ne (input->data[v->fv].f, iter->f))
+ goto not_equal;
+ iter++;
+ break;
+ case ALPHA:
+ if (memcmp (input->data[v->fv].s, iter->s, v->width))
+ goto not_equal;
+ iter += v->nv;
+ break;
+ default:
+ assert (0);
+ }
+ }
+ }
+
+ accumulate_aggregate_info (input);
+
+ return -2;
+
+not_equal:
+ /* The values of the break variable are different from the values on
+ the previous case. That means that it's time to dump aggregate
+ info. */
+ dump_aggregate_info (output);
+ initialize_aggregate_info ();
+ accumulate_aggregate_info (input);
+
+ /* Copy INPUT into prev_case. */
+ {
+ union value *iter = prev_case;
+ int i;
+
+ for (i = 0; i < nv_sort; i++)
+ {
+ struct variable *v = v_sort[i];
+
+ if (v->type == NUMERIC)
+ (iter++)->f = input->data[v->fv].f;
+ else
+ {
+ memcpy (iter->s, input->data[v->fv].s, v->width);
+ iter += v->nv;
+ }
+ }
+ }
+
+ return -1;
+}
+
+/* Accumulates aggregation data from the case INPUT. */
+static void
+accumulate_aggregate_info (struct ccase *input)
+{
+ struct agr_var *iter;
+
+#define WEIGHT (input->data[default_dict.weight_index].f)
+
+ for (iter = agr_first; iter; iter = iter->next)
+ if (iter->src)
+ {
+ union value *v = &input->data[iter->src->fv];
+
+ if ((!iter->include_missing && is_missing (v, iter->src))
+ || (iter->include_missing && iter->src->type == NUMERIC
+ && v->f == SYSMIS))
+ {
+ switch (iter->function)
+ {
+ case NMISS | FWEIGHT:
+ iter->dbl[0] += WEIGHT;
+ break;
+ case NMISS:
+ case NUMISS:
+ case NUMISS | FWEIGHT:
+ iter->int1++;
+ break;
+ }
+ iter->missing = 1;
+ continue;
+ }
+
+ /* This is horrible. There are too many possibilities. */
+ switch (iter->function)
+ {
+ case SUM:
+ case SUM | FWEIGHT:
+ iter->dbl[0] += v->f;
+ break;
+ case MEAN:
+ iter->dbl[0] += v->f;
+ iter->int1++;
+ break;
+ case MEAN | FWEIGHT:
+ {
+ double w = WEIGHT;
+ iter->dbl[0] += v->f * w;
+ iter->dbl[1] += w;
+ break;
+ }
+ case SD:
+ iter->dbl[0] += v->f;
+ iter->dbl[1] += v->f * v->f;
+ iter->int1++;
+ break;
+ case SD | FWEIGHT:
+ {
+ double w = WEIGHT;
+ double product = v->f * w;
+ iter->dbl[0] += product;
+ iter->dbl[1] += product * v->f;
+ iter->dbl[2] += w;
+ break;
+ }
+ case MAX:
+ case MAX | FWEIGHT:
+ iter->dbl[0] = max (iter->dbl[0], v->f);
+ iter->int1 = 1;
+ break;
+ case MAX | FSTRING:
+ case MAX | FSTRING | FWEIGHT:
+ if (memcmp (iter->string, v->s, iter->src->width) < 0)
+ memcpy (iter->string, v->s, iter->src->width);
+ iter->int1 = 1;
+ break;
+ case MIN:
+ case MIN | FWEIGHT:
+ iter->dbl[0] = min (iter->dbl[0], v->f);
+ iter->int1 = 1;
+ break;
+ case MIN | FSTRING:
+ case MIN | FSTRING | FWEIGHT:
+ if (memcmp (iter->string, v->s, iter->src->width) > 0)
+ memcpy (iter->string, v->s, iter->src->width);
+ iter->int1 = 1;
+ break;
+ case FGT:
+ case PGT:
+ if (approx_gt (v->f, iter->arg[0].f))
+ iter->int1++;
+ iter->int2++;
+ break;
+ case FGT | FWEIGHT:
+ case PGT | FWEIGHT:
+ {
+ double w = WEIGHT;
+ if (approx_gt (v->f, iter->arg[0].f))
+ iter->dbl[0] += w;
+ iter->dbl[1] += w;
+ break;
+ }
+ case FGT | FSTRING:
+ case PGT | FSTRING:
+ if (memcmp (iter->arg[0].c, v->s, iter->src->width) < 0)
+ iter->int1++;
+ iter->int2++;
+ break;
+ case FGT | FSTRING | FWEIGHT:
+ case PGT | FSTRING | FWEIGHT:
+ {
+ double w = WEIGHT;
+ if (memcmp (iter->arg[0].c, v->s, iter->src->width) < 0)
+ iter->dbl[0] += w;
+ iter->dbl[1] += w;
+ break;
+ }
+ case FLT:
+ case PLT:
+ if (approx_lt (v->f, iter->arg[0].f))
+ iter->int1++;
+ iter->int2++;
+ break;
+ case FLT | FWEIGHT:
+ case PLT | FWEIGHT:
+ {
+ double w = WEIGHT;
+ if (approx_lt (v->f, iter->arg[0].f))
+ iter->dbl[0] += w;
+ iter->dbl[1] += w;
+ break;
+ }
+ case FLT | FSTRING:
+ case PLT | FSTRING:
+ if (memcmp (iter->arg[0].c, v->s, iter->src->width) > 0)
+ iter->int1++;
+ iter->int2++;
+ break;
+ case FLT | FSTRING | FWEIGHT:
+ case PLT | FSTRING | FWEIGHT:
+ {
+ double w = WEIGHT;
+ if (memcmp (iter->arg[0].c, v->s, iter->src->width) > 0)
+ iter->dbl[0] += w;
+ iter->dbl[1] += w;
+ break;
+ }
+ case FIN:
+ case PIN:
+ if (approx_in_range (v->f, iter->arg[0].f, iter->arg[1].f))
+ iter->int1++;
+ iter->int2++;
+ break;
+ case FIN | FWEIGHT:
+ case PIN | FWEIGHT:
+ {
+ double w = WEIGHT;
+ if (approx_in_range (v->f, iter->arg[0].f, iter->arg[1].f))
+ iter->dbl[0] += w;
+ iter->dbl[1] += w;
+ break;
+ }
+ case FIN | FSTRING:
+ case PIN | FSTRING:
+ if (memcmp (iter->arg[0].c, v->s, iter->src->width) <= 0
+ && memcmp (iter->arg[1].c, v->s, iter->src->width) >= 0)
+ iter->int1++;
+ iter->int2++;
+ break;
+ case FIN | FSTRING | FWEIGHT:
+ case PIN | FSTRING | FWEIGHT:
+ {
+ double w = WEIGHT;
+ if (memcmp (iter->arg[0].c, v->s, iter->src->width) <= 0
+ && memcmp (iter->arg[1].c, v->s, iter->src->width) >= 0)
+ iter->dbl[0] += w;
+ iter->dbl[1] += w;
+ break;
+ }
+ case FOUT:
+ case POUT:
+ if (!approx_in_range (v->f, iter->arg[0].f, iter->arg[1].f))
+ iter->int1++;
+ iter->int2++;
+ break;
+ case FOUT | FWEIGHT:
+ case POUT | FWEIGHT:
+ {
+ double w = WEIGHT;
+ if (!approx_in_range (v->f, iter->arg[0].f, iter->arg[1].f))
+ iter->dbl[0] += w;
+ iter->dbl[1] += w;
+ break;
+ }
+ case FOUT | FSTRING:
+ case POUT | FSTRING:
+ if (memcmp (iter->arg[0].c, v->s, iter->src->width) > 0
+ && memcmp (iter->arg[1].c, v->s, iter->src->width) < 0)
+ iter->int1++;
+ iter->int2++;
+ break;
+ case FOUT | FSTRING | FWEIGHT:
+ case POUT | FSTRING | FWEIGHT:
+ {
+ double w = WEIGHT;
+ if (memcmp (iter->arg[0].c, v->s, iter->src->width) > 0
+ && memcmp (iter->arg[1].c, v->s, iter->src->width) < 0)
+ iter->dbl[0] += w;
+ iter->dbl[1] += w;
+ break;
+ }
+ case N | FWEIGHT:
+ iter->dbl[0] += WEIGHT;
+ break;
+ case N:
+ case NU:
+ case NU | FWEIGHT:
+ iter->int1++;
+ break;
+ case FIRST:
+ case FIRST | FWEIGHT:
+ if (iter->int1 == 0)
+ {
+ iter->dbl[0] = v->f;
+ iter->int1 = 1;
+ }
+ break;
+ case FIRST | FSTRING:
+ case FIRST | FSTRING | FWEIGHT:
+ if (iter->int1 == 0)
+ {
+ memcpy (iter->string, v->s, iter->src->width);
+ iter->int1 = 1;
+ }
+ break;
+ case LAST:
+ case LAST | FWEIGHT:
+ iter->dbl[0] = v->f;
+ iter->int1 = 1;
+ break;
+ case LAST | FSTRING:
+ case LAST | FSTRING | FWEIGHT:
+ memcpy (iter->string, v->s, iter->src->width);
+ iter->int1 = 1;
+ break;
+ default:
+ assert (0);
+ }
+ } else {
+ switch (iter->function)
+ {
+ case N_NO_VARS | FWEIGHT:
+ iter->dbl[0] += WEIGHT;
+ break;
+ case N_NO_VARS:
+ case NU_NO_VARS:
+ case NU_NO_VARS | FWEIGHT:
+ iter->int1++;
+ break;
+ default:
+ assert (0);
+ }
+ }
+}
+
+/* We've come to a record that differs from the previous in one or
+ more of the break variables. Make an output record from the
+ accumulated statistics in the OUTPUT case. */
+static void
+dump_aggregate_info (struct ccase *output)
+{
+ debug_printf (("(dumping "));
+
+ {
+ int n_elem = 0;
+
+ {
+ int i;
+
+ for (i = 0; i < nv_sort; i++)
+ n_elem += v_sort[i]->nv;
+ }
+ debug_printf (("n_elem=%d:", n_elem));
+ memcpy (output->data, prev_case, sizeof (union value) * n_elem);
+ }
+
+ {
+ struct agr_var *i;
+
+ for (i = agr_first; i; i = i->next)
+ {
+ union value *v = &output->data[i->dest->fv];
+
+ debug_printf ((" %d,%d", i->dest->fv, i->dest->nv));
+
+ if (missing == COLUMNWISE && i->missing != 0
+ && (i->function & FUNC) != N && (i->function & FUNC) != NU
+ && (i->function & FUNC) != NMISS && (i->function & FUNC) != NUMISS)
+ {
+ if (i->function & FSTRING)
+ memset (v->s, ' ', i->dest->width);
+ else
+ v->f = SYSMIS;
+ continue;
+ }
+
+ switch (i->function)
+ {
+ case SUM:
+ case SUM | FWEIGHT:
+ v->f = i->dbl[0];
+ break;
+ case MEAN:
+ v->f = i->int1 ? i->dbl[0] / i->int1 : SYSMIS;
+ break;
+ case MEAN | FWEIGHT:
+ v->f = i->dbl[1] != 0.0 ? i->dbl[0] / i->dbl[1] : SYSMIS;
+ break;
+ case SD:
+ v->f = ((i->int1 > 1)
+ ? calc_stddev (calc_variance (i->dbl, i->int1))
+ : SYSMIS);
+ break;
+ case SD | FWEIGHT:
+ v->f = ((i->dbl[2] > 1.0)
+ ? calc_stddev (calc_variance (i->dbl, i->dbl[2]))
+ : SYSMIS);
+ break;
+ case MAX:
+ case MAX | FWEIGHT:
+ case MIN:
+ case MIN | FWEIGHT:
+ v->f = i->int1 ? i->dbl[0] : SYSMIS;
+ break;
+ case MAX | FSTRING:
+ case MAX | FSTRING | FWEIGHT:
+ case MIN | FSTRING:
+ case MIN | FSTRING | FWEIGHT:
+ if (i->int1)
+ memcpy (v->s, i->string, i->dest->width);
+ else
+ memset (v->s, ' ', i->dest->width);
+ break;
+ case FGT:
+ case FGT | FSTRING:
+ case FLT:
+ case FLT | FSTRING:
+ case FIN:
+ case FIN | FSTRING:
+ case FOUT:
+ case FOUT | FSTRING:
+ v->f = i->int2 ? (double) i->int1 / (double) i->int2 : SYSMIS;
+ break;
+ case FGT | FWEIGHT:
+ case FGT | FSTRING | FWEIGHT:
+ case FLT | FWEIGHT:
+ case FLT | FSTRING | FWEIGHT:
+ case FIN | FWEIGHT:
+ case FIN | FSTRING | FWEIGHT:
+ case FOUT | FWEIGHT:
+ case FOUT | FSTRING | FWEIGHT:
+ v->f = i->dbl[1] ? i->dbl[0] / i->dbl[1] : SYSMIS;
+ break;
+ case PGT:
+ case PGT | FSTRING:
+ case PLT:
+ case PLT | FSTRING:
+ case PIN:
+ case PIN | FSTRING:
+ case POUT:
+ case POUT | FSTRING:
+ v->f = (i->int2
+ ? (double) i->int1 / (double) i->int2 * 100.0
+ : SYSMIS);
+ break;
+ case PGT | FWEIGHT:
+ case PGT | FSTRING | FWEIGHT:
+ case PLT | FWEIGHT:
+ case PLT | FSTRING | FWEIGHT:
+ case PIN | FWEIGHT:
+ case PIN | FSTRING | FWEIGHT:
+ case POUT | FWEIGHT:
+ case POUT | FSTRING | FWEIGHT:
+ v->f = i->dbl[1] ? i->dbl[0] / i->dbl[1] * 100.0 : SYSMIS;
+ break;
+ case N | FWEIGHT:
+ v->f = i->dbl[0];
+ case N:
+ case NU:
+ case NU | FWEIGHT:
+ v->f = i->int1;
+ break;
+ case FIRST:
+ case FIRST | FWEIGHT:
+ case LAST:
+ case LAST | FWEIGHT:
+ v->f = i->int1 ? i->dbl[0] : SYSMIS;
+ break;
+ case FIRST | FSTRING:
+ case FIRST | FSTRING | FWEIGHT:
+ case LAST | FSTRING:
+ case LAST | FSTRING | FWEIGHT:
+ if (i->int1)
+ memcpy (v->s, i->string, i->dest->width);
+ else
+ memset (v->s, ' ', i->dest->width);
+ break;
+ case N_NO_VARS | FWEIGHT:
+ v->f = i->dbl[0];
+ break;
+ case N_NO_VARS:
+ case NU_NO_VARS:
+ case NU_NO_VARS | FWEIGHT:
+ v->f = i->int1;
+ break;
+ case NMISS | FWEIGHT:
+ v->f = i->dbl[0];
+ break;
+ case NMISS:
+ case NUMISS:
+ case NUMISS | FWEIGHT:
+ v->f = i->int1;
+ break;
+ default:
+ assert (0);
+ }
+ }
+ }
+ debug_printf ((") "));
+}
+
+/* Resets the state for all the aggregate functions. */
+static void
+initialize_aggregate_info (void)
+{
+ struct agr_var *iter;
+
+ for (iter = agr_first; iter; iter = iter->next)
+ {
+ int plain_function = iter->function & ~FWEIGHT;
+
+ iter->missing = 0;
+ switch (plain_function)
+ {
+ case MIN:
+ iter->dbl[0] = DBL_MAX;
+ break;
+ case MIN | FSTRING:
+ memset (iter->string, 255, iter->src->width);
+ break;
+ case MAX:
+ iter->dbl[0] = -DBL_MAX;
+ break;
+ case MAX | FSTRING:
+ memset (iter->string, 0, iter->src->width);
+ break;
+ default:
+ iter->dbl[0] = iter->dbl[1] = iter->dbl[2] = 0.0;
+ iter->int1 = iter->int2 = 0;
+ break;
+ }
+ }
+}
+\f
+/* Aggregate each case as it comes through. Cases which aren't needed
+ are dropped. */
+static int
+agr_00x_trns_proc (struct trns_header *h unused, struct ccase *c)
+{
+ int code = aggregate_single_case (c, compaction_case);
+ debug_printf (("%d ", code));
+ return code;
+}
+
+/* Output the last aggregate case. It's okay to call the vfm_sink's
+ write() method here because end_func is called so soon after all
+ the cases have been output; very little has been cleaned up at this
+ point. */
+static void
+agr_00x_end_func (void)
+{
+ /* Ensure that info for the last break group gets written to the
+ active file. */
+ dump_aggregate_info (compaction_case);
+ vfm_sink_info.ncases++;
+ vfm_sink->write ();
+}
+
+/* Transform the aggregate case buf_1xx, in internal format, to system
+ file format, in buf64_1xx, and write the resultant case to the
+ system file. */
+static void
+write_case_to_sfm (void)
+{
+ flt64 *p = buf64_1xx;
+ int i;
+
+ for (i = 0; i < agr_dict->nvar; i++)
+ {
+ struct variable *v = agr_dict->var[i];
+
+ if (v->type == NUMERIC)
+ {
+ double src = buf_1xx->data[v->fv].f;
+ if (src == SYSMIS)
+ *p++ = -FLT64_MAX;
+ else
+ *p++ = src;
+ }
+ else
+ {
+ memcpy (p, buf_1xx->data[v->fv].s, v->width);
+ memset (&((char *) p)[v->width], ' ',
+ REM_RND_UP (v->width, sizeof (flt64)));
+ p += DIV_RND_UP (v->width, sizeof (flt64));
+ }
+ }
+
+ sfm_write_case (outfile, buf64_1xx, p - buf64_1xx);
+}
+
+/* Aggregate the current case and output it if we passed a
+ breakpoint. */
+static int
+agr_10x_trns_proc (struct trns_header *h unused, struct ccase *c)
+{
+ int code = aggregate_single_case (c, buf_1xx);
+
+ assert (code == -2 || code == -1);
+ if (code == -1)
+ write_case_to_sfm ();
+ return -1;
+}
+
+/* Close the system file now that we're done with it. */
+static void
+agr_10x_trns_free (struct trns_header *h unused)
+{
+ fh_close_handle (outfile);
+}
+
+/* Ensure that info for the last break group gets written to the
+ system file. */
+static void
+agr_10x_end_func (void)
+{
+ dump_aggregate_info (buf_1xx);
+ write_case_to_sfm ();
+}
+
+/* When called with temp_case non-NULL (the normal case), runs the
+ case through the aggregater and outputs it to the system file if
+ appropriate. If temp_case is NULL, finishes up writing the last
+ case if necessary. */
+static int
+agr_11x_func (void)
+{
+ if (temp_case != NULL)
+ {
+ int code = aggregate_single_case (temp_case, buf_1xx);
+
+ assert (code == -2 || code == -1);
+ if (code == -1)
+ write_case_to_sfm ();
+ }
+ else
+ {
+ if (case_count)
+ {
+ dump_aggregate_info (buf_1xx);
+ write_case_to_sfm ();
+ }
+ fh_close_handle (outfile);
+ }
+ return 1;
+}
+\f
+/* Debugging. */
+#if DEBUGGING
+/* Print out useful debugging information. */
+static void
+debug_print (int flags)
+{
+ printf ("AGGREGATE\n /OUTFILE=%s\n",
+ outfile ? fh_handle_filename (outfile) : "*");
+
+ if (missing == COLUMNWISE)
+ puts (" /MISSING=COLUMNWISE");
+
+ if (flags & 2)
+ puts (" /DOCUMENT");
+ if (flags & 4)
+ puts (" /PRESORTED");
+
+ {
+ int i;
+
+ printf (" /BREAK=");
+ for (i = 0; i < nv_sort; i++)
+ printf ("%s(%c) ", v_sort[i]->name,
+ v_sort[i]->p.srt.order == SRT_ASCEND ? 'A' : 'D');
+ putc ('\n', stdout);
+ }
+
+ {
+ struct agr_var *iter;
+
+ for (iter = agr_first; iter; iter = iter->next)
+ {
+ struct agr_func *f = &agr_func_tab[iter->function & FUNC];
+
+ printf (" /%s", iter->dest->name);
+ if (iter->dest->label)
+ printf ("'%s'", iter->dest->label);
+ printf ("=%s(%s", f->name, iter->src->name);
+ if (f->n_args)
+ {
+ int i;
+
+ for (i = 0; i < f->n_args; i++)
+ {
+ putc (',', stdout);
+ if (iter->src->type == NUMERIC)
+ printf ("%g", iter->arg[i].f);
+ else
+ printf ("%.*s", iter->src->width, iter->arg[i].c);
+ }
+ }
+ printf (")\n");
+ }
+ }
+}
+
+#endif /* DEBUGGING */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "str.h"
+
+static void out_of_memory (void);
+\f
+/* Public functions. */
+
+/* Allocates a block of SIZE bytes and returns it.
+ If SIZE is 0, returns a null pointer.
+ Aborts if unsuccessful. */
+void *
+xmalloc (size_t size)
+{
+ void *vp;
+ if (size == 0)
+ return NULL;
+
+ vp = malloc (size);
+ if (!vp)
+ out_of_memory ();
+
+ return vp;
+}
+
+/* Allocates a block of SIZE bytes, fill it with all-bits-0, and
+ returns it.
+ If SIZE is 0, returns a null pointer.
+ Aborts if unsuccessful. */
+void *
+xcalloc (size_t size)
+{
+ void *vp = xmalloc (size);
+ memset (vp, 0, size);
+ return vp;
+}
+
+/* If SIZE is 0, then block PTR is freed and a null pointer is
+ returned.
+ Otherwise, if PTR is a null pointer, then a new block is allocated
+ and returned.
+ Otherwise, block PTR is reallocated to be SIZE bytes in size and
+ the new location of the block is returned.
+ Aborts if unsuccessful. */
+void *
+xrealloc (void *ptr, size_t size)
+{
+ void *vp;
+ if (!size)
+ {
+ if (ptr)
+ free (ptr);
+
+ return NULL;
+ }
+
+ if (ptr)
+ vp = realloc (ptr, size);
+ else
+ vp = malloc (size);
+
+ if (!vp)
+ out_of_memory ();
+
+ return vp;
+}
+
+/* Makes a copy of string S in malloc()'d memory and returns the copy.
+ S must not be a null pointer. */
+char *
+xstrdup (const char *s)
+{
+ size_t size;
+ char *t;
+
+ assert (s != NULL);
+
+ size = strlen (s) + 1;
+
+ t = malloc (size);
+ if (!t)
+ out_of_memory ();
+
+ memcpy (t, s, size);
+ return t;
+}
+\f
+/* Private functions. */
+
+/* Report an out-of-memory condition and abort execution. */
+static void
+out_of_memory (void)
+{
+#if __CHECKER__
+ fprintf (stderr, "Out of memory: inducing segfault\n");
+ *((int *) 0) = 0;
+#else
+ fprintf (stderr, "virtual memory exhausted\n");
+ exit (EXIT_FAILURE);
+#endif
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !alloc_h
+#define alloc_h 1
+
+#include <stddef.h>
+
+/* Functions. */
+void *xmalloc (size_t size);
+void *xcalloc (size_t size);
+void *xrealloc (void *ptr, size_t size);
+char *xstrdup (const char *s);
+
+#endif /* alloc.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <stdlib.h>
+#include "avl.h"
+#include "command.h"
+#include "error.h"
+#include "file-handle.h"
+#include "lexer.h"
+#include "sfm.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* Parses and executes APPLY DICTIONARY. */
+int
+cmd_apply_dictionary (void)
+{
+ struct file_handle *handle;
+ struct dictionary *dict;
+
+ int n_matched = 0;
+
+ int i;
+
+ lex_match_id ("APPLY");
+ lex_match_id ("DICTIONARY");
+
+ lex_match_id ("FROM");
+ lex_match ('=');
+ handle = fh_parse_file_handle ();
+ if (!handle)
+ return CMD_FAILURE;
+
+ dict = sfm_read_dictionary (handle, NULL);
+ if (dict == NULL)
+ return CMD_FAILURE;
+
+ for (i = 0; i < dict->nvar; i++)
+ {
+ struct variable *s = dict->var[i];
+ struct variable *t = find_variable (s->name);
+ if (t == NULL)
+ continue;
+
+ n_matched++;
+ if (s->type != t->type)
+ {
+ msg (SW, _("Variable %s is %s in target file, but %s in "
+ "source file."),
+ s->name,
+ t->type == ALPHA ? _("string") : _("numeric"),
+ s->type == ALPHA ? _("string") : _("numeric"));
+ continue;
+ }
+
+ if (s->label && strcspn (s->label, " ") != strlen (s->label))
+ {
+ free (t->label);
+ t->label = s->label;
+ s->label = NULL;
+ }
+
+ if (s->val_lab && t->width > MAX_SHORT_STRING)
+ msg (SW, _("Cannot add value labels from source file to "
+ "long string variable %s."),
+ s->name);
+ else if (s->val_lab)
+ {
+ if (t->width < s->width)
+ {
+ avl_traverser iter;
+ struct value_label *lab;
+
+ avl_traverser_init (iter);
+ while ((lab = avl_traverse (s->val_lab, &iter)) != NULL)
+ {
+ int j;
+
+ /* If the truncated characters aren't all blanks
+ anyway, then don't apply the value labels. */
+ for (j = t->width; j < s->width; j++)
+ if (lab->v.s[j] != ' ')
+ goto skip_value_labels;
+ }
+ }
+ else
+ {
+ /* Fortunately, we follow the convention that all value
+ label values are right-padded with spaces, so it is
+ unnecessary to bother padding values here. */
+ }
+
+ avl_destroy (t->val_lab, free_val_lab);
+ t->val_lab = s->val_lab;
+ s->val_lab = NULL;
+ }
+ skip_value_labels: ;
+
+ if (s->miss_type != MISSING_NONE && t->width > MAX_SHORT_STRING)
+ msg (SW, _("Cannot apply missing values from source file to "
+ "long string variable %s."),
+ s->name);
+ else if (s->miss_type != MISSING_NONE)
+ {
+ if (t->width < s->width)
+ {
+ static const int miss_count[MISSING_COUNT] =
+ {
+ 0, 1, 2, 3, 2, 1, 1, 3, 2, 2,
+ };
+
+ int j, k;
+
+ for (j = 0; j < miss_count[s->miss_type]; j++)
+ for (k = t->width; k < s->width; k++)
+ if (s->missing[j].s[k] != ' ')
+ goto skip_missing_values;
+ }
+
+ t->miss_type = s->miss_type;
+ memcpy (t->missing, s->missing, sizeof s->missing);
+ }
+
+ if (s->type == NUMERIC)
+ {
+ t->print = s->print;
+ t->write = s->write;
+ }
+ }
+
+ if (!n_matched)
+ msg (SW, _("No matching variables found between the source "
+ "and target files."));
+
+ /* Weighting. */
+ {
+ const int tfw = find_variable (default_dict.weight_var) != 0;
+ const int sfw = dict->weight_var[0] != 0;
+ struct variable *w;
+
+ switch (10 * tfw + sfw)
+ {
+ case 10:
+ /* The working file retains its weighting variable. */
+ break;
+
+ case 00:
+ case 01:
+ /* Fall through to case 11. */
+
+ case 11:
+ w = find_variable (dict->weight_var);
+ if (w)
+ strcpy (default_dict.weight_var, dict->weight_var);
+ break;
+ }
+ }
+ skip_missing_values: ;
+
+ sfm_maybe_close (handle);
+
+ return lex_end_of_command ();
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !approx_h
+#define approx_h 1
+
+#include <float.h>
+#include <math.h>
+
+/* Minimum difference to consider values to be distinct. */
+#define EPSILON (DBL_EPSILON*10)
+
+/* The boundary at EPSILON is considered to be equal. */
+/* Possible modification: insert frexp() into all these expressions. */
+
+#define approx_eq(A, B) \
+ (fabs((A)-(B))<=EPSILON)
+
+#define approx_ne(A, B) \
+ (fabs((A)-(B))>EPSILON)
+
+#define approx_ge(A, B) \
+ ((A) >= (B)-EPSILON)
+
+#define approx_gt(A, B) \
+ ((A) > (B)+EPSILON)
+
+#define approx_le(A, B) \
+ ((A) <= (B)+EPSILON)
+
+#define approx_lt(A, B) \
+ ((A) < (B)-EPSILON)
+
+#define approx_floor(x) \
+ (floor((x)+EPSILON))
+
+#define approx_in_range(V, L, H) \
+ (((V) >= (L)-EPSILON) && ((V) <= (H)+EPSILON))
+
+#define approx_compare(A, B) \
+ (approx_gt(A,B) ? 1 : (approx_lt(A,B) ? -1 : 0))
+
+#endif /* !approx_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <ctype.h>
+#include <errno.h>
+#include <limits.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "error.h"
+#include "filename.h"
+#include "main.h"
+#include "misc.h"
+#include "output.h"
+#include "pool.h"
+#include "version.h"
+
+/* ASCII driver options: (defaults listed first)
+
+ output-file="pspp.list"
+ char-set=ascii|latin1
+ form-feed-string="\f" Written as a formfeed.
+ newline-string=default|"\r\n"|"\n"
+ Written as a newline.
+ paginate=on|off Formfeeds are desired?
+ tab-width=8 Width of a tab; 0 to not use tabs.
+ init="" Written at beginning of output.
+ done="" Written at end of output.
+
+ headers=on|off Put headers at top of page?
+ length=66
+ width=130
+ lpi=6 Only used to determine font size.
+ cpi=10
+
+ left-margin=0
+ right-margin=0
+ top-margin=2
+ bottom-margin=2
+
+ box[x]="strng" Sets box character X (X in base 4: 0-3333).
+ italic-on=overstrike|"strng" Turns on italic (underline).
+ italic-off=""|"strng" Turns off italic; ignored for overstrike.
+ bold-on=overstrike|"strng" Turns on bold.
+ bold-off=""|"strng" Turns off bold; ignored for overstrike.
+ bold-italic-on=overstrike|"strng" Turns on bold-italic.
+ bold-italic-off=""|"strng" Turns off bold-italic; ignored for overstrike.
+ overstrike-style=single|line Can we print a whole line then BS over it, or
+ must we go char by char, as on a terminal?
+ carriage-return-style=bs|cr Must we return the carriage with a sequence of
+ BSes, or will a single CR do it?
+ */
+
+/* Disable messages by failed range checks. */
+/*#define SUPPRESS_WARNINGS 1 */
+
+/* Character set. */
+enum
+ {
+ CHS_ASCII, /* 7-bit ASCII */
+ CHS_LATIN1 /* Latin 1; not really supported at the moment */
+ };
+
+/* Overstrike style. */
+enum
+ {
+ OVS_SINGLE, /* Overstrike each character: "a\b_b\b_c\b_" */
+ OVS_LINE /* Overstrike lines: "abc\b\b\b___" (or if
+ newline is "\r\n", then "abc\r___"). Easier
+ on the printer, doesn't work on a tty. */
+ };
+
+/* Basic output strings. */
+enum
+ {
+ OPS_INIT, /* Document initialization string. */
+ OPS_DONE, /* Document uninit string. */
+ OPS_FORMFEED, /* Formfeed string. */
+ OPS_NEWLINE, /* Newline string. */
+
+ OPS_COUNT /* Number of output strings. */
+ };
+
+/* Line styles bit shifts. */
+enum
+ {
+ LNS_TOP = 0,
+ LNS_LEFT = 2,
+ LNS_BOTTOM = 4,
+ LNS_RIGHT = 6,
+
+ LNS_COUNT = 256
+ };
+
+/* Carriage return style. */
+enum
+ {
+ CRS_BS, /* Multiple backspaces. */
+ CRS_CR /* Single carriage return. */
+ };
+
+/* Assembles a byte from four taystes. */
+#define TAYSTE2BYTE(T, L, B, R) \
+ (((T) << LNS_TOP) \
+ | ((L) << LNS_LEFT) \
+ | ((B) << LNS_BOTTOM) \
+ | ((R) << LNS_RIGHT))
+
+/* Extract tayste with shift value S from byte B. */
+#define BYTE2TAYSTE(B, S) \
+ (((B) >> (S)) & 3)
+
+/* Font style; take one of the first group |'d with one of the second group. */
+enum
+ {
+ FSTY_ON = 000, /* Turn font on. */
+ FSTY_OFF = 001, /* Turn font off. */
+
+ FSTY_ITALIC = 0, /* Italic font. */
+ FSTY_BOLD = 2, /* Bold font. */
+ FSTY_BOLD_ITALIC = 4, /* Bold-italic font. */
+
+ FSTY_COUNT = 6 /* Number of font styles. */
+ };
+
+/* ASCII output driver extension record. */
+struct ascii_driver_ext
+ {
+ /* User parameters. */
+ int char_set; /* CHS_ASCII/CHS_LATIN1; no-op right now. */
+ int headers; /* 1=print headers at top of page. */
+ int page_length; /* Page length in lines. */
+ int page_width; /* Page width in characters. */
+ int lpi; /* Lines per inch. */
+ int cpi; /* Characters per inch. */
+ int left_margin; /* Left margin in characters. */
+ int right_margin; /* Right margin in characters. */
+ int top_margin; /* Top margin in lines. */
+ int bottom_margin; /* Bottom margin in lines. */
+ int paginate; /* 1=insert formfeeds. */
+ int tab_width; /* Width of a tab; 0 not to use tabs. */
+ struct len_string ops[OPS_COUNT]; /* Basic output strings. */
+ struct len_string box[LNS_COUNT]; /* Line & box drawing characters. */
+ struct len_string fonts[FSTY_COUNT]; /* Font styles; NULL=overstrike. */
+ int overstrike_style; /* OVS_SINGLE or OVS_LINE. */
+ int carriage_return_style; /* Carriage return style. */
+
+ /* Internal state. */
+ struct file_ext file; /* Output file. */
+ int page_number; /* Current page number. */
+ unsigned short *page; /* Page content. */
+ int page_size; /* Number of bytes allocated for page, attr. */
+ int *line_len; /* Length of each line in page, attr. */
+ int line_len_size; /* Number of ints allocated for line_len. */
+ int w, l; /* Actual width & length w/o margins, etc. */
+ int n_output; /* Number of lines output so far. */
+ int cur_font; /* Current font by OUTP_F_*. */
+#if GLOBAL_DEBUGGING
+ int debug; /* Set by som_text_draw(). */
+#endif
+ };
+
+static struct pool *ascii_pool;
+
+static int postopen (struct file_ext *);
+static int preclose (struct file_ext *);
+
+int
+ascii_open_global (struct outp_class *this unused)
+{
+ ascii_pool = pool_create ();
+ return 1;
+}
+
+int
+ascii_close_global (struct outp_class *this unused)
+{
+ pool_destroy (ascii_pool);
+ return 1;
+}
+
+int *
+ascii_font_sizes (struct outp_class *this unused, int *n_valid_sizes)
+{
+ static int valid_sizes[] = {12, 12, 0, 0};
+
+ assert (n_valid_sizes);
+ *n_valid_sizes = 1;
+ return valid_sizes;
+}
+
+int
+ascii_preopen_driver (struct outp_driver *this)
+{
+ struct ascii_driver_ext *x;
+ int i;
+
+ assert (this->driver_open == 0);
+ msg (VM (1), _("ASCII driver initializing as `%s'..."), this->name);
+ this->ext = x = xmalloc (sizeof (struct ascii_driver_ext));
+ x->char_set = CHS_ASCII;
+ x->headers = 1;
+ x->page_length = 66;
+ x->page_width = 79;
+ x->lpi = 6;
+ x->cpi = 10;
+ x->left_margin = 0;
+ x->right_margin = 0;
+ x->top_margin = 2;
+ x->bottom_margin = 2;
+ x->paginate = 1;
+ x->tab_width = 8;
+ for (i = 0; i < OPS_COUNT; i++)
+ ls_null (&x->ops[i]);
+ for (i = 0; i < LNS_COUNT; i++)
+ ls_null (&x->box[i]);
+ for (i = 0; i < FSTY_COUNT; i++)
+ ls_null (&x->fonts[i]);
+ x->overstrike_style = OVS_SINGLE;
+ x->carriage_return_style = CRS_BS;
+ x->file.filename = NULL;
+ x->file.mode = "wb";
+ x->file.file = NULL;
+ x->file.sequence_no = &x->page_number;
+ x->file.param = x;
+ x->file.postopen = postopen;
+ x->file.preclose = preclose;
+ x->page_number = 0;
+ x->page = NULL;
+ x->page_size = 0;
+ x->line_len = NULL;
+ x->line_len_size = 0;
+ x->n_output = 0;
+ x->cur_font = OUTP_F_R;
+#if GLOBAL_DEBUGGING
+ x->debug = 0;
+#endif
+ return 1;
+}
+
+int
+ascii_postopen_driver (struct outp_driver *this)
+{
+ struct ascii_driver_ext *x = this->ext;
+
+ assert (this->driver_open == 0);
+
+ if (NULL == x->file.filename)
+ x->file.filename = xstrdup ("pspp.list");
+
+ x->w = x->page_width - x->left_margin - x->right_margin;
+ x->l = (x->page_length - (x->headers ? 3 : 0) - x->top_margin
+ - x->bottom_margin - 1);
+ if (x->w < 59 || x->l < 15)
+ {
+ msg (SE, _("ascii driver: Area of page excluding margins and headers "
+ "must be at least 59 characters wide by 15 lines long. Page as "
+ "configured is only %d characters by %d lines."), x->w, x->l);
+ return 0;
+ }
+
+ this->res = x->lpi * x->cpi;
+ this->horiz = x->lpi;
+ this->vert = x->cpi;
+ this->width = x->w * this->horiz;
+ this->length = x->l * this->vert;
+
+ if (ls_null_p (&x->ops[OPS_FORMFEED]))
+ ls_create (ascii_pool, &x->ops[OPS_FORMFEED], "\f");
+ if (ls_null_p (&x->ops[OPS_NEWLINE])
+ || !strcmp (ls_value (&x->ops[OPS_NEWLINE]), "default"))
+ {
+ ls_create (ascii_pool, &x->ops[OPS_NEWLINE], "\n");
+ x->file.mode = "wt";
+ }
+
+ {
+ int i;
+
+ for (i = 0; i < LNS_COUNT; i++)
+ {
+ char c[2];
+ c[1] = 0;
+ if (!ls_null_p (&x->box[i]))
+ continue;
+ switch (i)
+ {
+ case TAYSTE2BYTE (0, 0, 0, 0):
+ c[0] = ' ';
+ break;
+
+ case TAYSTE2BYTE (0, 1, 0, 0):
+ case TAYSTE2BYTE (0, 1, 0, 1):
+ case TAYSTE2BYTE (0, 0, 0, 1):
+ c[0] = '-';
+ break;
+
+ case TAYSTE2BYTE (1, 0, 0, 0):
+ case TAYSTE2BYTE (1, 0, 1, 0):
+ case TAYSTE2BYTE (0, 0, 1, 0):
+ c[0] = '|';
+ break;
+
+ case TAYSTE2BYTE (0, 3, 0, 0):
+ case TAYSTE2BYTE (0, 3, 0, 3):
+ case TAYSTE2BYTE (0, 0, 0, 3):
+ case TAYSTE2BYTE (0, 2, 0, 0):
+ case TAYSTE2BYTE (0, 2, 0, 2):
+ case TAYSTE2BYTE (0, 0, 0, 2):
+ c[0] = '=';
+ break;
+
+ case TAYSTE2BYTE (3, 0, 0, 0):
+ case TAYSTE2BYTE (3, 0, 3, 0):
+ case TAYSTE2BYTE (0, 0, 3, 0):
+ case TAYSTE2BYTE (2, 0, 0, 0):
+ case TAYSTE2BYTE (2, 0, 2, 0):
+ case TAYSTE2BYTE (0, 0, 2, 0):
+ c[0] = '#';
+ break;
+
+ default:
+ if (BYTE2TAYSTE (i, LNS_LEFT) > 1
+ || BYTE2TAYSTE (i, LNS_TOP) > 1
+ || BYTE2TAYSTE (i, LNS_RIGHT) > 1
+ || BYTE2TAYSTE (i, LNS_BOTTOM) > 1)
+ c[0] = '#';
+ else
+ c[0] = '+';
+ break;
+ }
+ ls_create (ascii_pool, &x->box[i], c);
+ }
+ }
+
+ {
+ int i;
+
+ this->cp_x = this->cp_y = 0;
+ this->font_height = this->vert;
+ this->prop_em_width = this->horiz;
+ this->fixed_width = this->horiz;
+
+ this->horiz_line_width[0] = 0;
+ this->vert_line_width[0] = 0;
+
+ for (i = 1; i < OUTP_L_COUNT; i++)
+ {
+ this->horiz_line_width[i] = this->vert;
+ this->vert_line_width[i] = this->horiz;
+ }
+
+ for (i = 0; i < (1 << OUTP_L_COUNT); i++)
+ {
+ this->horiz_line_spacing[i] = (i & ~1) ? this->vert : 0;
+ this->vert_line_spacing[i] = (i & ~1) ? this->horiz : 0;
+ }
+ }
+
+ this->driver_open = 1;
+ msg (VM (2), _("%s: Initialization complete."), this->name);
+
+ return 1;
+}
+
+int
+ascii_close_driver (struct outp_driver *this)
+{
+ struct ascii_driver_ext *x = this->ext;
+
+ assert (this->driver_open == 1);
+ msg (VM (2), _("%s: Beginning closing..."), this->name);
+
+ x = this->ext;
+ free (x->page);
+ free (x->line_len);
+ fn_close_ext (&x->file);
+ free (x->file.filename);
+ free (x);
+
+ this->driver_open = 0;
+ msg (VM (3), _("%s: Finished closing."), this->name);
+
+ return 1;
+}
+
+/* Generic option types. */
+enum
+ {
+ pos_int_arg = -10,
+ nonneg_int_arg,
+ string_arg,
+ font_string_arg,
+ boolean_arg
+ };
+
+static struct outp_option option_tab[] =
+ {
+ {"headers", boolean_arg, 0},
+ {"output-file", 1, 0},
+ {"char-set", 2, 0},
+ {"length", pos_int_arg, 0},
+ {"width", pos_int_arg, 1},
+ {"lpi", pos_int_arg, 2},
+ {"cpi", pos_int_arg, 3},
+ {"init", string_arg, 0},
+ {"done", string_arg, 1},
+ {"left-margin", nonneg_int_arg, 0},
+ {"right-margin", nonneg_int_arg, 1},
+ {"top-margin", nonneg_int_arg, 2},
+ {"bottom-margin", nonneg_int_arg, 3},
+ {"paginate", boolean_arg, 1},
+ {"form-feed-string", string_arg, 2},
+ {"newline-string", string_arg, 3},
+ {"italic-on", font_string_arg, 0},
+ {"italic-off", font_string_arg, 1},
+ {"bold-on", font_string_arg, 2},
+ {"bold-off", font_string_arg, 3},
+ {"bold-italic-on", font_string_arg, 4},
+ {"bold-italic-off", font_string_arg, 5},
+ {"overstrike-style", 3, 0},
+ {"tab-width", nonneg_int_arg, 4},
+ {"carriage-return-style", 4, 0},
+ {"", 0, 0},
+ };
+static struct outp_option_info option_info;
+
+void
+ascii_option (struct outp_driver *this, const char *key,
+ const struct string *val)
+{
+ struct ascii_driver_ext *x = this->ext;
+ int cat, subcat;
+ const char *value;
+
+ value = ds_value (val);
+ if (!strncmp (key, "box[", 4))
+ {
+ char *tail;
+ int indx = strtol (&key[4], &tail, 4);
+ if (*tail != ']' || indx < 0 || indx > LNS_COUNT)
+ {
+ msg (SE, _("Bad index value for `box' key: syntax is box[INDEX], "
+ "0 <= INDEX < %d decimal, with INDEX expressed in base 4."),
+ LNS_COUNT);
+ return;
+ }
+ if (!ls_null_p (&x->box[indx]))
+ msg (SW, _("Duplicate value for key `%s'."), key);
+ ls_create (ascii_pool, &x->box[indx], value);
+ return;
+ }
+
+ cat = outp_match_keyword (key, option_tab, &option_info, &subcat);
+
+ switch (cat)
+ {
+ case 0:
+ msg (SE, _("Unknown configuration parameter `%s' for ascii device driver."),
+ key);
+ break;
+ case 1:
+ free (x->file.filename);
+ x->file.filename = xstrdup (value);
+ break;
+ case 2:
+ if (!strcmp (value, "ascii"))
+ x->char_set = CHS_ASCII;
+ else if (!strcmp (value, "latin1"))
+ x->char_set = CHS_LATIN1;
+ else
+ msg (SE, _("Unknown character set `%s'. Valid character sets are "
+ "`ascii' and `latin1'."), value);
+ break;
+ case 3:
+ if (!strcmp (value, "single"))
+ x->overstrike_style = OVS_SINGLE;
+ else if (!strcmp (value, "line"))
+ x->overstrike_style = OVS_LINE;
+ else
+ msg (SE, _("Unknown overstrike style `%s'. Valid overstrike styles "
+ "are `single' and `line'."), value);
+ break;
+ case 4:
+ if (!strcmp (value, "bs"))
+ x->carriage_return_style = CRS_BS;
+ else if (!strcmp (value, "cr"))
+ x->carriage_return_style = CRS_CR;
+ else
+ msg (SE, _("Unknown carriage return style `%s'. Valid carriage "
+ "return styles are `cr' and `bs'."), value);
+ break;
+ case pos_int_arg:
+ {
+ char *tail;
+ int arg;
+
+ errno = 0;
+ arg = strtol (value, &tail, 0);
+ if (arg < 1 || errno == ERANGE || *tail)
+ {
+ msg (SE, _("Positive integer required as value for `%s'."), key);
+ break;
+ }
+ switch (subcat)
+ {
+ case 0:
+ x->page_length = arg;
+ break;
+ case 1:
+ x->page_width = arg;
+ break;
+ case 2:
+ x->lpi = arg;
+ break;
+ case 3:
+ x->cpi = arg;
+ break;
+ default:
+ assert (0);
+ }
+ }
+ break;
+ case nonneg_int_arg:
+ {
+ char *tail;
+ int arg;
+
+ errno = 0;
+ arg = strtol (value, &tail, 0);
+ if (arg < 0 || errno == ERANGE || *tail)
+ {
+ msg (SE, _("Zero or positive integer required as value for `%s'."),
+ key);
+ break;
+ }
+ switch (subcat)
+ {
+ case 0:
+ x->left_margin = arg;
+ break;
+ case 1:
+ x->right_margin = arg;
+ break;
+ case 2:
+ x->top_margin = arg;
+ break;
+ case 3:
+ x->bottom_margin = arg;
+ break;
+ case 4:
+ x->tab_width = arg;
+ break;
+ default:
+ assert (0);
+ }
+ }
+ break;
+ case string_arg:
+ {
+ struct len_string *s;
+ switch (subcat)
+ {
+ case 0:
+ s = &x->ops[OPS_INIT];
+ break;
+ case 1:
+ s = &x->ops[OPS_DONE];
+ break;
+ case 2:
+ s = &x->ops[OPS_FORMFEED];
+ break;
+ case 3:
+ s = &x->ops[OPS_NEWLINE];
+ break;
+ default:
+ assert (0);
+ }
+ ls_create (ascii_pool, s, value);
+ }
+ break;
+ case font_string_arg:
+ {
+ if (!strcmp (value, "overstrike"))
+ {
+ ls_destroy (ascii_pool, &x->fonts[subcat]);
+ return;
+ }
+ ls_create (ascii_pool, &x->fonts[subcat], value);
+ }
+ break;
+ case boolean_arg:
+ {
+ int setting;
+ if (!strcmp (value, "on") || !strcmp (value, "true")
+ || !strcmp (value, "yes") || atoi (value))
+ setting = 1;
+ else if (!strcmp (value, "off") || !strcmp (value, "false")
+ || !strcmp (value, "no") || !strcmp (value, "0"))
+ setting = 0;
+ else
+ {
+ msg (SE, _("Boolean value expected for %s."), key);
+ return;
+ }
+ switch (subcat)
+ {
+ case 0:
+ x->headers = 0;
+ break;
+ case 1:
+ x->paginate = setting;
+ break;
+ default:
+ assert (0);
+ }
+ }
+ break;
+ default:
+ assert (0);
+ }
+}
+
+int
+postopen (struct file_ext *f)
+{
+ struct ascii_driver_ext *x = f->param;
+ struct len_string *s = &x->ops[OPS_INIT];
+
+ if (!ls_empty_p (s) && fwrite (ls_value (s), ls_length (s), 1, f->file) < 1)
+ {
+ msg (ME, _("ASCII output driver: %s: %s"),
+ f->filename, strerror (errno));
+ return 0;
+ }
+ return 1;
+}
+
+int
+preclose (struct file_ext *f)
+{
+ struct ascii_driver_ext *x = f->param;
+ struct len_string *d = &x->ops[OPS_DONE];
+
+ if (!ls_empty_p (d) && fwrite (ls_value (d), ls_length (d), 1, f->file) < 1)
+ {
+ msg (ME, _("ASCII output driver: %s: %s"),
+ f->filename, strerror (errno));
+ return 0;
+ }
+ return 1;
+}
+
+int
+ascii_open_page (struct outp_driver *this)
+{
+ struct ascii_driver_ext *x = this->ext;
+ int req_page_size;
+
+ assert (this->driver_open && !this->page_open);
+ x->page_number++;
+ if (!fn_open_ext (&x->file))
+ {
+ msg (ME, _("ASCII output driver: %s: %s"), x->file.filename,
+ strerror (errno));
+ return 0;
+ }
+
+ req_page_size = x->w * x->l;
+ if (req_page_size > x->page_size || req_page_size / 2 < x->page_size)
+ {
+ x->page_size = req_page_size;
+ x->page = xrealloc (x->page, sizeof *x->page * req_page_size);
+ }
+
+ if (x->l > x->line_len_size)
+ {
+ x->line_len_size = x->l;
+ x->line_len = xrealloc (x->line_len,
+ sizeof *x->line_len * x->line_len_size);
+ }
+
+ memset (x->line_len, 0, sizeof *x->line_len * x->l);
+
+ this->page_open = 1;
+ return 1;
+}
+
+/* Ensures that at least the first L characters of line I in the
+ driver identified by struct ascii_driver_ext *X have been cleared out. */
+static inline void
+expand_line (struct ascii_driver_ext *x, int i, int l)
+{
+ int limit = i * x->w + l;
+ int j;
+
+ for (j = i * x->w + x->line_len[i]; j < limit; j++)
+ x->page[j] = ' ';
+ x->line_len[i] = l;
+}
+
+/* Puts line L at (H,K) in the current output page. Assumes
+ struct ascii_driver_ext named `ext'. */
+#define draw_line(H, K, L) \
+ ext->page[ext->w * (K) + (H)] = (L) | 0x800
+
+/* Line styles for each position. */
+#define T(STYLE) (STYLE<<LNS_TOP)
+#define L(STYLE) (STYLE<<LNS_LEFT)
+#define B(STYLE) (STYLE<<LNS_BOTTOM)
+#define R(STYLE) (STYLE<<LNS_RIGHT)
+
+void
+ascii_line_horz (struct outp_driver *this, const struct rect *r,
+ const struct color *c unused, int style)
+{
+ struct ascii_driver_ext *ext = this->ext;
+ int x1 = r->x1 / this->horiz;
+ int x2 = r->x2 / this->horiz;
+ int y1 = r->y1 / this->vert;
+ int x;
+
+ assert (this->driver_open && this->page_open);
+ if (x1 == x2)
+ return;
+#if GLOBAL_DEBUGGING
+ if (x1 > x2
+ || x1 < 0 || x1 >= ext->w
+ || x2 <= 0 || x2 > ext->w
+ || y1 < 0 || y1 >= ext->l)
+ {
+#if !SUPPRESS_WARNINGS
+ printf (_("ascii_line_horz: bad hline (%d,%d),%d out of (%d,%d)\n"),
+ x1, x2, y1, ext->w, ext->l);
+#endif
+ return;
+ }
+#endif
+
+ if (ext->line_len[y1] < x2)
+ expand_line (ext, y1, x2);
+
+ for (x = x1; x < x2; x++)
+ draw_line (x, y1, (style << LNS_LEFT) | (style << LNS_RIGHT));
+}
+
+void
+ascii_line_vert (struct outp_driver *this, const struct rect *r,
+ const struct color *c unused, int style)
+{
+ struct ascii_driver_ext *ext = this->ext;
+ int x1 = r->x1 / this->horiz;
+ int y1 = r->y1 / this->vert;
+ int y2 = r->y2 / this->vert;
+ int y;
+
+ assert (this->driver_open && this->page_open);
+ if (y1 == y2)
+ return;
+#if GLOBAL_DEBUGGING
+ if (y1 > y2
+ || x1 < 0 || x1 >= ext->w
+ || y1 < 0 || y1 >= ext->l
+ || y2 < 0 || y2 > ext->l)
+ {
+#if !SUPPRESS_WARNINGS
+ printf (_("ascii_line_vert: bad vline %d,(%d,%d) out of (%d,%d)\n"),
+ x1, y1, y2, ext->w, ext->l);
+#endif
+ return;
+ }
+#endif
+
+ for (y = y1; y < y2; y++)
+ if (ext->line_len[y] <= x1)
+ expand_line (ext, y, x1 + 1);
+
+ for (y = y1; y < y2; y++)
+ draw_line (x1, y, (style << LNS_TOP) | (style << LNS_BOTTOM));
+}
+
+void
+ascii_line_intersection (struct outp_driver *this, const struct rect *r,
+ const struct color *c unused,
+ const struct outp_styles *style)
+{
+ struct ascii_driver_ext *ext = this->ext;
+ int x = r->x1 / this->horiz;
+ int y = r->y1 / this->vert;
+ int l;
+
+ assert (this->driver_open && this->page_open);
+#if GLOBAL_DEBUGGING
+ if (x < 0 || x >= ext->w || y < 0 || y >= ext->l)
+ {
+#if !SUPPRESS_WARNINGS
+ printf (_("ascii_line_intersection: bad intsct (%d,%d) out of (%d,%d)\n"),
+ x, y, ext->w, ext->l);
+#endif
+ return;
+ }
+#endif
+
+ l = ((style->l << LNS_LEFT) | (style->r << LNS_RIGHT)
+ | (style->t << LNS_TOP) | (style->b << LNS_BOTTOM));
+
+ if (ext->line_len[y] <= x)
+ expand_line (ext, y, x + 1);
+ draw_line (x, y, l);
+}
+
+void
+ascii_line_width (struct outp_driver *this, int *width, int *height)
+{
+ int i;
+
+ assert (this->driver_open && this->page_open);
+ width[0] = height[0] = 0;
+ for (i = 1; i < OUTP_L_COUNT; i++)
+ {
+ width[i] = this->horiz;
+ height[i] = this->vert;
+ }
+}
+
+/* FIXME: Later we could set this up so that for certain devices it
+ performs shading? */
+void
+ascii_box (struct outp_driver *this unused, const struct rect *r unused,
+ const struct color *bord unused, const struct color *fill unused)
+{
+ assert (this->driver_open && this->page_open);
+}
+
+/* Polylines not supported. */
+void
+ascii_polyline_begin (struct outp_driver *this unused, const struct color *c unused)
+{
+ assert (this->driver_open && this->page_open);
+}
+void
+ascii_polyline_point (struct outp_driver *this unused, int x unused, int y unused)
+{
+ assert (this->driver_open && this->page_open);
+}
+void
+ascii_polyline_end (struct outp_driver *this unused)
+{
+ assert (this->driver_open && this->page_open);
+}
+
+void
+ascii_text_set_font_by_name (struct outp_driver * this, const char *s)
+{
+ struct ascii_driver_ext *x = this->ext;
+ int len = strlen (s);
+
+ assert (this->driver_open && this->page_open);
+ x->cur_font = OUTP_F_R;
+ if (len == 0)
+ return;
+ if (s[len - 1] == 'I')
+ {
+ if (len > 1 && s[len - 2] == 'B')
+ x->cur_font = OUTP_F_BI;
+ else
+ x->cur_font = OUTP_F_I;
+ }
+ else if (s[len - 1] == 'B')
+ x->cur_font = OUTP_F_B;
+}
+
+void
+ascii_text_set_font_by_position (struct outp_driver *this, int pos)
+{
+ struct ascii_driver_ext *x = this->ext;
+ assert (this->driver_open && this->page_open);
+ x->cur_font = pos >= 0 && pos < 4 ? pos : 0;
+}
+
+void
+ascii_text_set_font_by_family (struct outp_driver *this unused, const char *s unused)
+{
+ assert (this->driver_open && this->page_open);
+}
+
+const char *
+ascii_text_get_font_name (struct outp_driver *this)
+{
+ struct ascii_driver_ext *x = this->ext;
+
+ assert (this->driver_open && this->page_open);
+ switch (x->cur_font)
+ {
+ case OUTP_F_R:
+ return "R";
+ case OUTP_F_I:
+ return "I";
+ case OUTP_F_B:
+ return "B";
+ case OUTP_F_BI:
+ return "BI";
+ default:
+ assert (0);
+ }
+ abort ();
+}
+
+const char *
+ascii_text_get_font_family (struct outp_driver *this unused)
+{
+ assert (this->driver_open && this->page_open);
+ return "";
+}
+
+int
+ascii_text_set_size (struct outp_driver *this, int size)
+{
+ assert (this->driver_open && this->page_open);
+ return size == this->vert;
+}
+
+int
+ascii_text_get_size (struct outp_driver *this, int *em_width)
+{
+ assert (this->driver_open && this->page_open);
+ if (em_width)
+ *em_width = this->horiz;
+ return this->vert;
+}
+
+static void text_draw (struct outp_driver *this, struct outp_text *t);
+
+/* Divides the text T->S into lines of width T->H. Sets T->V to the
+ number of lines necessary. Actually draws the text if DRAW is
+ nonzero.
+
+ You probably don't want to look at this code. */
+static void
+delineate (struct outp_driver *this, struct outp_text *t, int draw)
+{
+ /* Width we're fitting everything into. */
+ int width = t->h / this->horiz;
+
+ /* Maximum `y' position we can write to. */
+ int max_y;
+
+ /* Current position in string, character following end of string. */
+ const char *s = ls_value (&t->s);
+ const char *end = ls_end (&t->s);
+
+ /* Temporary struct outp_text to pass to low-level function. */
+ struct outp_text temp;
+
+#if GLOBAL_DEBUGGING && 0
+ if (!ext->debug)
+ {
+ ext->debug = 1;
+ printf (_("%s: horiz=%d, vert=%d\n"), this->name, this->horiz, this->vert);
+ }
+#endif
+
+ if (!width)
+ {
+ t->h = t->v = 0;
+ return;
+ }
+
+ if (draw)
+ {
+ temp.options = t->options;
+ ls_shallow_copy (&temp.s, &t->s);
+ temp.h = t->h / this->horiz;
+ temp.x = t->x / this->horiz;
+ }
+ else
+ t->y = 0;
+ temp.y = t->y / this->vert;
+
+ if (t->options & OUTP_T_VERT)
+ max_y = (t->v / this->vert) + temp.y - 1;
+ else
+ max_y = INT_MAX;
+
+ while (end - s > width)
+ {
+ const char *beg = s;
+ const char *space;
+
+ /* Find first space before &s[width]. */
+ space = &s[width];
+ for (;;)
+ {
+ if (space > s)
+ {
+ if (!isspace ((unsigned char) space[-1]))
+ {
+ space--;
+ continue;
+ }
+ else
+ s = space;
+ }
+ else
+ s = space = &s[width];
+ break;
+ }
+
+ /* Draw text. */
+ if (draw)
+ {
+ ls_init (&temp.s, beg, space - beg);
+ temp.w = space - beg;
+ text_draw (this, &temp);
+ }
+ if (++temp.y > max_y)
+ return;
+
+ /* Find first nonspace after space. */
+ while (s < end && isspace ((unsigned char) *s))
+ s++;
+ }
+ if (s < end)
+ {
+ if (draw)
+ {
+ ls_init (&temp.s, s, end - s);
+ temp.w = end - s;
+ text_draw (this, &temp);
+ }
+ temp.y++;
+ }
+
+ t->v = (temp.y * this->vert) - t->y;
+}
+
+void
+ascii_text_metrics (struct outp_driver *this, struct outp_text *t)
+{
+ assert (this->driver_open && this->page_open);
+ if (!(t->options & OUTP_T_HORZ))
+ {
+ t->v = this->vert;
+ t->h = ls_length (&t->s) * this->horiz;
+ }
+ else
+ delineate (this, t, 0);
+}
+
+void
+ascii_text_draw (struct outp_driver *this, struct outp_text *t)
+{
+ /* FIXME: orientations not supported. */
+ assert (this->driver_open && this->page_open);
+ if (!(t->options & OUTP_T_HORZ))
+ {
+ struct outp_text temp;
+
+ temp.options = t->options;
+ temp.s = t->s;
+ temp.h = temp.v = 0;
+ temp.x = t->x / this->horiz;
+ temp.y = t->y / this->vert;
+ text_draw (this, &temp);
+ ascii_text_metrics (this, t);
+
+ return;
+ }
+ delineate (this, t, 1);
+}
+
+static void
+text_draw (struct outp_driver *this, struct outp_text *t)
+{
+ struct ascii_driver_ext *ext = this->ext;
+ unsigned attr = ext->cur_font << 8;
+
+ int x = t->x;
+ int y = t->y * ext->w;
+
+ char *s = ls_value (&t->s);
+
+ /* Expand the line with the assumption that S takes up LEN character
+ spaces (sometimes it takes up less). */
+ int min_len;
+
+ assert (this->driver_open && this->page_open);
+ switch (t->options & OUTP_T_JUST_MASK)
+ {
+ case OUTP_T_JUST_LEFT:
+ break;
+ case OUTP_T_JUST_CENTER:
+ x -= (t->h - t->w) / 2; /* fall through */
+ case OUTP_T_JUST_RIGHT:
+ x += (t->h - t->w);
+ break;
+ default:
+ assert (0);
+ }
+
+ if (!(t->y < ext->l && x < ext->w))
+ return;
+ min_len = min (x + ls_length (&t->s), ext->w);
+ if (ext->line_len[t->y] < min_len)
+ expand_line (ext, t->y, min_len);
+
+ {
+ int len = ls_length (&t->s);
+
+ if (len + x > ext->w)
+ len = ext->w - x;
+ while (len--)
+ ext->page[y + x++] = *s++ | attr;
+ }
+}
+\f
+/* ascii_close_page () and support routines. */
+
+#define LINE_BUF_SIZE 1024
+static unsigned char *line_buf;
+static unsigned char *line_p;
+
+static inline int
+commit_line_buf (struct outp_driver *this)
+{
+ struct ascii_driver_ext *x = this->ext;
+
+ if ((int) fwrite (line_buf, 1, line_p - line_buf, x->file.file)
+ < line_p - line_buf)
+ {
+ msg (ME, _("Writing `%s': %s"), x->file.filename, strerror (errno));
+ return 0;
+ }
+
+ line_p = line_buf;
+ return 1;
+}
+
+/* Writes everything from BP to EP exclusive into line_buf, or to
+ THIS->output if line_buf overflows. */
+static inline void
+output_string (struct outp_driver *this, const char *bp, const char *ep)
+{
+ if (LINE_BUF_SIZE - (line_p - line_buf) >= ep - bp)
+ {
+ memcpy (line_p, bp, ep - bp);
+ line_p += ep - bp;
+ }
+ else
+ while (bp < ep)
+ {
+ if (LINE_BUF_SIZE - (line_p - line_buf) <= 1 && !commit_line_buf (this))
+ return;
+ *line_p++ = *bp++;
+ }
+}
+
+/* Writes everything from BP to EP exclusive into line_buf, or to
+ THIS->output if line_buf overflows. Returns 1 if additional passes
+ over the line are required. FIXME: probably could do a lot of
+ optimization here. */
+static inline int
+output_shorts (struct outp_driver *this,
+ const unsigned short *bp, const unsigned short *ep)
+{
+ struct ascii_driver_ext *ext = this->ext;
+ size_t remaining = LINE_BUF_SIZE - (line_p - line_buf);
+ int result = 0;
+
+ for (; bp < ep; bp++)
+ {
+ if (*bp & 0x800)
+ {
+ struct len_string *box = &ext->box[*bp & 0xff];
+ size_t len = ls_length (box);
+
+ if (remaining >= len)
+ {
+ memcpy (line_p, ls_value (box), len);
+ line_p += len;
+ remaining -= len;
+ }
+ else
+ {
+ if (!commit_line_buf (this))
+ return 0;
+ output_string (this, ls_value (box), ls_end (box));
+ remaining = LINE_BUF_SIZE - (line_p - line_buf);
+ }
+ }
+ else if (*bp & 0x0300)
+ {
+ struct len_string *on;
+ char buf[5];
+ int len;
+
+ switch (*bp & 0x0300)
+ {
+ case OUTP_F_I << 8:
+ on = &ext->fonts[FSTY_ON | FSTY_ITALIC];
+ break;
+ case OUTP_F_B << 8:
+ on = &ext->fonts[FSTY_ON | FSTY_BOLD];
+ break;
+ case OUTP_F_BI << 8:
+ on = &ext->fonts[FSTY_ON | FSTY_BOLD_ITALIC];
+ break;
+ default:
+ assert (0);
+ }
+ if (!on)
+ {
+ if (ext->overstrike_style == OVS_SINGLE)
+ switch (*bp & 0x0300)
+ {
+ case OUTP_F_I << 8:
+ buf[0] = '_';
+ buf[1] = '\b';
+ buf[2] = *bp;
+ len = 3;
+ break;
+ case OUTP_F_B << 8:
+ buf[0] = *bp;
+ buf[1] = '\b';
+ buf[2] = *bp;
+ len = 3;
+ break;
+ case OUTP_F_BI << 8:
+ buf[0] = '_';
+ buf[1] = '\b';
+ buf[2] = *bp;
+ buf[3] = '\b';
+ buf[4] = *bp;
+ len = 5;
+ break;
+ default:
+ assert (0);
+ }
+ else
+ {
+ buf[0] = *bp;
+ result = len = 1;
+ }
+ }
+ else
+ {
+ buf[0] = *bp;
+ len = 1;
+ }
+ output_string (this, buf, &buf[len]);
+ }
+ else if (remaining)
+ {
+ *line_p++ = *bp;
+ remaining--;
+ }
+ else
+ {
+ if (!commit_line_buf (this))
+ return 0;
+ remaining = LINE_BUF_SIZE - (line_p - line_buf);
+ *line_p++ = *bp;
+ }
+ }
+
+ return result;
+}
+
+/* Writes CH into line_buf N times, or to THIS->output if line_buf
+ overflows. */
+static inline void
+output_char (struct outp_driver *this, int n, int ch)
+{
+ if (LINE_BUF_SIZE - (line_p - line_buf) >= n)
+ {
+ memset (line_p, ch, n);
+ line_p += n;
+ }
+ else
+ while (n--)
+ {
+ if (LINE_BUF_SIZE - (line_p - line_buf) <= 1 && !commit_line_buf (this))
+ return;
+ *line_p++ = ch;
+ }
+}
+
+/* Advance the carriage from column 0 to the left margin. */
+static void
+advance_to_left_margin (struct outp_driver *this)
+{
+ struct ascii_driver_ext *ext = this->ext;
+ int margin;
+
+ margin = ext->left_margin;
+ if (margin == 0)
+ return;
+ if (ext->tab_width && margin >= ext->tab_width)
+ {
+ output_char (this, margin / ext->tab_width, '\t');
+ margin %= ext->tab_width;
+ }
+ if (margin)
+ output_char (this, margin, ' ');
+}
+
+/* Move the output file carriage N_CHARS left, to the left margin. */
+static void
+return_carriage (struct outp_driver *this, int n_chars)
+{
+ struct ascii_driver_ext *ext = this->ext;
+
+ switch (ext->carriage_return_style)
+ {
+ case CRS_BS:
+ output_char (this, n_chars, '\b');
+ break;
+ case CRS_CR:
+ output_char (this, 1, '\r');
+ advance_to_left_margin (this);
+ break;
+ default:
+ assert (0);
+ }
+}
+
+/* Writes COUNT lines from the line buffer in THIS, starting at line
+ number FIRST. */
+static void
+output_lines (struct outp_driver *this, int first, int count)
+{
+ struct ascii_driver_ext *ext = this->ext;
+
+ unsigned short *p = &ext->page[ext->w * first];
+ int *len = &ext->line_len[first];
+ struct len_string *newline = &ext->ops[OPS_NEWLINE];
+
+ int n_chars;
+ int n_passes;
+
+ if (NULL == ext->file.file)
+ return;
+
+ while (count--) /* Iterate over all the lines to be output. */
+ {
+ unsigned short *end_p;
+ unsigned short *bp, *ep;
+ unsigned short attr = 0;
+
+ end_p = p + *len++;
+ assert (end_p >= p);
+
+ /* Output every character in the line in the appropriate
+ manner. */
+ n_passes = 1;
+ bp = ep = p;
+ n_chars = 0;
+ advance_to_left_margin (this);
+ for (;;)
+ {
+ while (ep < end_p && attr == (*ep & 0x0300))
+ ep++;
+ if (output_shorts (this, bp, ep))
+ n_passes = 2;
+ n_chars += ep - bp;
+ bp = ep;
+
+ if (bp >= end_p)
+ break;
+
+ /* Turn off old font. */
+ if (attr != (OUTP_F_R << 8))
+ {
+ struct len_string *off;
+
+ switch (attr)
+ {
+ case OUTP_F_I << 8:
+ off = &ext->fonts[FSTY_OFF | FSTY_ITALIC];
+ break;
+ case OUTP_F_B << 8:
+ off = &ext->fonts[FSTY_OFF | FSTY_BOLD];
+ break;
+ case OUTP_F_BI << 8:
+ off = &ext->fonts[FSTY_OFF | FSTY_BOLD_ITALIC];
+ break;
+ default:
+ assert (0);
+ }
+ if (off)
+ output_string (this, ls_value (off), ls_end (off));
+ }
+
+ /* Turn on new font. */
+ attr = (*bp & 0x0300);
+ if (attr != (OUTP_F_R << 8))
+ {
+ struct len_string *on;
+
+ switch (attr)
+ {
+ case OUTP_F_I << 8:
+ on = &ext->fonts[FSTY_ON | FSTY_ITALIC];
+ break;
+ case OUTP_F_B << 8:
+ on = &ext->fonts[FSTY_ON | FSTY_BOLD];
+ break;
+ case OUTP_F_BI << 8:
+ on = &ext->fonts[FSTY_ON | FSTY_BOLD_ITALIC];
+ break;
+ default:
+ assert (0);
+ }
+ if (on)
+ output_string (this, ls_value (on), ls_end (on));
+ }
+
+ ep = bp + 1;
+ }
+ if (n_passes > 1)
+ {
+ unsigned char ch;
+
+ return_carriage (this, n_chars);
+ n_chars = 0;
+ bp = ep = p;
+ for (;;)
+ {
+ while (ep < end_p && (*ep & 0x0300) == (OUTP_F_R << 8))
+ ep++;
+ if (ep >= end_p)
+ break;
+ output_char (this, ep - bp, ' ');
+
+ switch (*ep & 0x0300)
+ {
+ case OUTP_F_I << 8:
+ ch = '_';
+ break;
+ case OUTP_F_B << 8:
+ ch = *ep;
+ break;
+ case OUTP_F_BI << 8:
+ ch = *ep;
+ n_passes = 3;
+ break;
+ }
+ output_char (this, 1, ch);
+ n_chars += ep - bp + 1;
+ bp = ep + 1;
+ ep = bp;
+ }
+ }
+ if (n_passes > 2)
+ {
+ return_carriage (this, n_chars);
+ bp = ep = p;
+ for (;;)
+ {
+ while (ep < end_p && (*ep & 0x0300) != (OUTP_F_BI << 8))
+ ep++;
+ if (ep >= end_p)
+ break;
+ output_char (this, ep - bp, ' ');
+ output_char (this, 1, '_');
+ bp = ep + 1;
+ ep = bp;
+ }
+ }
+ p += ext->w;
+
+ output_string (this, ls_value (newline), ls_end (newline));
+ }
+}
+
+int
+ascii_close_page (struct outp_driver *this)
+{
+ static unsigned char *s;
+ static int s_len;
+
+ struct ascii_driver_ext *x = this->ext;
+ int nl_len, ff_len, total_len;
+ unsigned char *cp;
+ int i;
+
+ assert (this->driver_open && this->page_open);
+
+ if (!line_buf)
+ line_buf = xmalloc (LINE_BUF_SIZE);
+ line_p = line_buf;
+
+ nl_len = ls_length (&x->ops[OPS_NEWLINE]);
+ if (x->top_margin)
+ {
+ total_len = x->top_margin * nl_len;
+ if (s_len < total_len)
+ {
+ s_len = total_len;
+ s = xrealloc (s, s_len);
+ }
+ for (cp = s, i = 0; i < x->top_margin; i++)
+ {
+ memcpy (cp, ls_value (&x->ops[OPS_NEWLINE]), nl_len);
+ cp += nl_len;
+ }
+ output_string (this, s, &s[total_len]);
+ }
+ if (x->headers)
+ {
+ int len;
+
+ total_len = nl_len + x->w;
+ if (s_len < total_len + 1)
+ {
+ s_len = total_len + 1;
+ s = xrealloc (s, s_len);
+ }
+
+ memset (s, ' ', x->w);
+
+ {
+ char temp[40];
+
+ snprintf (temp, 80, _("%s - Page %d"), curdate, x->page_number);
+ memcpy (&s[x->w - strlen (temp)], temp, strlen (temp));
+ }
+
+ if (outp_title && outp_subtitle)
+ {
+ len = min ((int) strlen (outp_title), x->w);
+ memcpy (s, outp_title, len);
+ }
+ memcpy (&s[x->w], ls_value (&x->ops[OPS_NEWLINE]), nl_len);
+ output_string (this, s, &s[total_len]);
+
+ memset (s, ' ', x->w);
+ len = strlen (version) + 3 + strlen (host_system);
+ if (len < x->w)
+ sprintf (&s[x->w - len], "%s - %s" , version, host_system);
+ if (outp_subtitle || outp_title)
+ {
+ char *string = outp_subtitle ? outp_subtitle : outp_title;
+ len = min ((int) strlen (string), x->w);
+ memcpy (s, string, len);
+ }
+ memcpy (&s[x->w], ls_value (&x->ops[OPS_NEWLINE]), nl_len);
+ output_string (this, s, &s[total_len]);
+ output_string (this, &s[x->w], &s[total_len]);
+ }
+ if (line_p != line_buf && !commit_line_buf (this))
+ return 0;
+
+ output_lines (this, x->n_output, x->l - x->n_output);
+
+ ff_len = ls_length (&x->ops[OPS_FORMFEED]);
+ total_len = x->bottom_margin * nl_len + ff_len;
+ if (s_len < total_len)
+ s = xrealloc (s, total_len);
+ for (cp = s, i = 0; i < x->bottom_margin; i++)
+ {
+ memcpy (cp, ls_value (&x->ops[OPS_NEWLINE]), nl_len);
+ cp += nl_len;
+ }
+ memcpy (cp, ls_value (&x->ops[OPS_FORMFEED]), ff_len);
+ output_string (this, s, &s[total_len]);
+ if (line_p != line_buf && !commit_line_buf (this))
+ return 0;
+
+ x->n_output = 0;
+
+ this->page_open = 0;
+ return 1;
+}
+
+struct outp_class ascii_class =
+{
+ "ascii",
+ 0,
+ 0,
+
+ ascii_open_global,
+ ascii_close_global,
+ ascii_font_sizes,
+
+ ascii_preopen_driver,
+ ascii_option,
+ ascii_postopen_driver,
+ ascii_close_driver,
+
+ ascii_open_page,
+ ascii_close_page,
+
+ NULL,
+
+ ascii_line_horz,
+ ascii_line_vert,
+ ascii_line_intersection,
+
+ ascii_box,
+ ascii_polyline_begin,
+ ascii_polyline_point,
+ ascii_polyline_end,
+
+ ascii_text_set_font_by_name,
+ ascii_text_set_font_by_position,
+ ascii_text_set_font_by_family,
+ ascii_text_get_font_name,
+ ascii_text_get_font_family,
+ ascii_text_set_size,
+ ascii_text_get_size,
+ ascii_text_metrics,
+ ascii_text_draw,
+};
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "hash.h"
+#include "lexer.h"
+#include "pool.h"
+#include "str.h"
+#include "var.h"
+#include "vfm.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+
+/* FIXME: This module is less than ideally efficient, both in space
+ and time. If anyone cares, it would be a good project. */
+
+/* FIXME: Implement PRINT subcommand. */
+
+/* Explains how to recode one value. `from' must be first element. */
+struct arc_item
+ {
+ union value from; /* Original value. */
+ double to; /* Recoded value. */
+ };
+
+/* Explains how to recode an AUTORECODE variable. */
+struct arc_spec
+ {
+ struct variable *src; /* Source variable. */
+ struct variable *dest; /* Target variable. */
+ struct hsh_table *items; /* Hash table of `freq's. */
+ };
+
+/* AUTORECODE transformation. */
+struct autorecode_trns
+ {
+ struct trns_header h;
+ struct pool *owner; /* Contains AUTORECODE specs. */
+ struct arc_spec *arc; /* AUTORECODE specifications. */
+ int n_arc; /* Number of specifications. */
+ };
+
+/* Source and target variables, hash table translator. */
+static struct variable **v_src;
+static struct variable **v_dest;
+static struct hsh_table **h_trans;
+static int nv_src;
+
+/* Pool for allocation of hash table entries. */
+static struct pool *hash_pool;
+
+/* Options. */
+static int descend;
+static int print;
+
+static int autorecode_trns_proc (struct trns_header *, struct ccase *);
+static void autorecode_trns_free (struct trns_header *);
+static int autorecode_proc_func (struct ccase *);
+static int compare_alpha_value (const void *, const void *, void *);
+static unsigned hash_alpha_value (const void *, void *);
+static int compare_numeric_value (const void *, const void *, void *);
+static unsigned hash_numeric_value (const void *, void *);
+static void recode (void);
+
+/* Performs the AUTORECODE procedure. */
+int
+cmd_autorecode (void)
+{
+ /* Dest var names. */
+ char **n_dest = NULL;
+ int nv_dest = 0;
+
+ int i;
+
+ v_src = NULL;
+ descend = print = 0;
+ h_trans = NULL;
+
+ lex_match_id ("AUTORECODE");
+ lex_match_id ("VARIABLES");
+ lex_match ('=');
+ if (!parse_variables (&default_dict, &v_src, &nv_src, PV_NO_DUPLICATE))
+ return CMD_FAILURE;
+ if (!lex_force_match_id ("INTO"))
+ return CMD_FAILURE;
+ lex_match ('=');
+ if (!parse_DATA_LIST_vars (&n_dest, &nv_dest, PV_NONE))
+ goto lossage;
+ if (nv_dest != nv_src)
+ {
+ msg (SE, _("Number of source variables (%d) does not match number "
+ "of target variables (%d)."), nv_src, nv_dest);
+ goto lossage;
+ }
+ while (lex_match ('/'))
+ if (lex_match_id ("DESCENDING"))
+ descend = 1;
+ else if (lex_match_id ("PRINT"))
+ print = 1;
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ goto lossage;
+ }
+
+ for (i = 0; i < nv_dest; i++)
+ {
+ int j;
+
+ if (is_varname (n_dest[i]))
+ {
+ msg (SE, _("Target variable %s duplicates existing variable %s."),
+ n_dest[i], n_dest[i]);
+ goto lossage;
+ }
+ for (j = 0; j < i; j++)
+ if (!strcmp (n_dest[i], n_dest[j]))
+ {
+ msg (SE, _("Duplicate variable name %s among target variables."),
+ n_dest[i]);
+ goto lossage;
+ }
+ }
+
+ hash_pool = pool_create ();
+
+ v_dest = xmalloc (sizeof *v_dest * nv_dest);
+ h_trans = xmalloc (sizeof *h_trans * nv_dest);
+ for (i = 0; i < nv_dest; i++)
+ if (v_src[i]->type == ALPHA)
+ h_trans[i] = hsh_create (10, compare_alpha_value,
+ hash_alpha_value, NULL,
+ (void *) v_src[i]->width);
+ else
+ h_trans[i] = hsh_create (10, compare_numeric_value,
+ hash_numeric_value, NULL, NULL);
+
+ procedure (NULL, autorecode_proc_func, NULL);
+
+ for (i = 0; i < nv_dest; i++)
+ {
+ v_dest[i] = force_create_variable (&default_dict, n_dest[i], NUMERIC, 0);
+ free (n_dest[i]);
+ }
+ free (n_dest);
+
+ recode ();
+
+ free (v_src);
+ free (v_dest);
+
+ return CMD_SUCCESS;
+
+lossage:
+ if (h_trans != NULL)
+ for (i = 0; i < nv_src; i++)
+ hsh_destroy (h_trans[i]);
+ for (i = 0; i < nv_dest; i++)
+ free (n_dest[i]);
+ free (n_dest);
+ free (v_src);
+ return CMD_FAILURE;
+}
+\f
+/* AUTORECODE transformation. */
+
+static void
+recode (void)
+{
+ struct autorecode_trns *t;
+ struct pool *arc_pool;
+ int i;
+
+ arc_pool = pool_create ();
+ t = xmalloc (sizeof *t);
+ t->h.proc = autorecode_trns_proc;
+ t->h.free = autorecode_trns_free;
+ t->owner = arc_pool;
+ t->arc = pool_alloc (arc_pool, sizeof *t->arc * nv_src);
+ t->n_arc = nv_src;
+ for (i = 0; i < nv_src; i++)
+ {
+ struct arc_spec *spec = &t->arc[i];
+ void **p = hsh_sort (h_trans[i], NULL);
+ int count = hsh_count (h_trans[i]);
+ int j;
+
+ spec->src = v_src[i];
+ spec->dest = v_dest[i];
+
+ if (v_src[i]->type == ALPHA)
+ spec->items = hsh_create (2 * count, compare_alpha_value,
+ hash_alpha_value, NULL,
+ (void *) v_src[i]->width);
+ else
+ spec->items = hsh_create (2 * count, compare_numeric_value,
+ hash_numeric_value, NULL, NULL);
+
+ for (j = 0; *p; p++, j++)
+ {
+ struct arc_item *item = pool_alloc (arc_pool, sizeof *item);
+
+ memcpy (&item->from, *p, sizeof (union value));
+ if (v_src[i]->type == ALPHA)
+ item->from.c = pool_strdup (arc_pool, item->from.c);
+ item->to = !descend ? j + 1 : count - j;
+ force_hsh_insert (spec->items, item);
+ }
+
+ hsh_destroy (h_trans[i]);
+ }
+ free (h_trans);
+ pool_destroy (hash_pool);
+ add_transformation ((struct trns_header *) t);
+}
+
+static int
+autorecode_trns_proc (struct trns_header * trns, struct ccase * c)
+{
+ struct autorecode_trns *t = (struct autorecode_trns *) trns;
+ int i;
+
+ for (i = 0; i < t->n_arc; i++)
+ {
+ struct arc_spec *spec = &t->arc[i];
+ struct arc_item *item;
+
+ if (spec->src->type == NUMERIC)
+ item = force_hsh_find (spec->items, &c->data[spec->src->fv].f);
+ else
+ {
+ union value v;
+ v.c = c->data[spec->src->fv].s;
+ item = force_hsh_find (spec->items, &v);
+ }
+
+ c->data[spec->dest->fv].f = item->to;
+ }
+ return -1;
+}
+
+static void
+autorecode_trns_free (struct trns_header * trns)
+{
+ struct autorecode_trns *t = (struct autorecode_trns *) trns;
+ int i;
+
+ for (i = 0; i < t->n_arc; i++)
+ hsh_destroy (t->arc[i].items);
+ pool_destroy (t->owner);
+}
+\f
+/* AUTORECODE procedure. */
+
+static int
+compare_alpha_value (const void *a, const void *b, void *len)
+{
+ return memcmp (((union value *) a)->c, ((union value *) b)->c, (int) len);
+}
+
+static unsigned
+hash_alpha_value (const void *a, void *len)
+{
+ return hashpjw_d (((union value *) a)->c, &((union value *) a)->c[(int) len]);
+}
+
+static int
+compare_numeric_value (const void *pa, const void *pb, void *foobar unused)
+{
+ double a = ((union value *) pa)->f, b = ((union value *) pb)->f;
+ return a > b ? 1 : (a < b ? -1 : 0);
+}
+
+static unsigned
+hash_numeric_value (const void *a, void *len unused)
+{
+ return hashpjw_d ((char *) &((union value *) a)->f,
+ (char *) &(&((union value *) a)->f)[1]);
+}
+
+static int
+autorecode_proc_func (struct ccase * c)
+{
+ int i;
+
+ for (i = 0; i < nv_src; i++)
+ {
+ union value v;
+ union value *vp;
+ union value **vpp;
+
+ if (v_src[i]->type == NUMERIC)
+ {
+ v.f = c->data[v_src[i]->fv].f;
+ vpp = (union value **) hsh_probe (h_trans[i], &v);
+ if (NULL == *vpp)
+ {
+ vp = pool_alloc (hash_pool, sizeof (union value));
+ vp->f = v.f;
+ *vpp = vp;
+ }
+ }
+ else
+ {
+ v.c = c->data[v_src[i]->fv].s;
+ vpp = (union value **) hsh_probe (h_trans[i], &v);
+ if (NULL == *vpp)
+ {
+ vp = pool_alloc (hash_pool, sizeof (union value));
+#if __CHECKER__
+ memset (vp, 0, sizeof (union value));
+#endif
+ vp->c = pool_strdup (hash_pool, v.c);
+ *vpp = vp;
+ }
+ }
+ }
+ return 1;
+}
--- /dev/null
+/* libavl - manipulates AVL trees.
+ Copyright (C) 1998-9, 2000 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA.
+
+ The author may be contacted at <pfaffben@pilot.msu.edu> on the
+ Internet, or as Ben Pfaff, 12167 Airport Rd, DeWitt MI 48820, USA
+ through more mundane means. */
+
+/* This is file avl.c in libavl. */
+
+#if HAVE_CONFIG_H
+#include <config.h>
+#endif
+#if PSPP
+#include "pool.h"
+#define HAVE_XMALLOC 1
+#endif
+#if SELF_TEST
+#include <limits.h>
+#include <time.h>
+#endif
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+#include "avl.h"
+
+#if !PSPP && !__GCC__
+#define inline
+#endif
+
+#if !PSPP
+#if __GNUC__ >= 2
+#define unused __attribute__ ((unused))
+#else
+#define unused
+#endif
+#endif
+
+#ifdef HAVE_XMALLOC
+void *xmalloc (size_t);
+#else /* !HAVE_XMALLOC */
+/* Allocates SIZE bytes of space using malloc(). Aborts if out of
+ memory. */
+static void *
+xmalloc (size_t size)
+{
+ void *vp;
+
+ if (size == 0)
+ return NULL;
+ vp = malloc (size);
+
+ assert (vp != NULL);
+ if (vp == NULL)
+ {
+ fprintf (stderr, "virtual memory exhausted\n");
+ exit (EXIT_FAILURE);
+ }
+ return vp;
+}
+#endif /* !HAVE_XMALLOC */
+
+/* Creates an AVL tree in POOL (which can be NULL). POOL is owned by
+ the caller, not by the AVL tree. CMP is a order function for the
+ data to be stored in the tree. PARAM is arbitrary data that
+ becomes an argument to the comparison function. */
+avl_tree *
+avl_create (MAYBE_POOL avl_comparison_func cmp, void *param)
+{
+ avl_tree *tree;
+
+ assert (cmp != NULL);
+#if PSPP
+ if (pool)
+ tree = pool_alloc (pool, sizeof *tree);
+ else
+#endif
+ tree = xmalloc (sizeof *tree);
+
+#if PSPP
+ tree->pool = pool;
+#endif
+ tree->root.link[0] = NULL;
+ tree->root.link[1] = NULL;
+ tree->cmp = cmp;
+ tree->count = 0;
+ tree->param = param;
+
+ return tree;
+}
+
+/* Destroy tree TREE. Function FREE_FUNC is called for every node in
+ the tree as it is destroyed.
+
+ No effect if the tree has an pool owner and free_func is NULL.
+ The caller owns the pool and must destroy it itself.
+
+ Do not attempt to reuse the tree after it has been freed. Create a
+ new one. */
+void
+avl_destroy (avl_tree *tree, avl_node_func free_func)
+{
+ assert (tree != NULL);
+
+#if PSPP
+ if (free_func || tree->pool == NULL)
+#endif
+ {
+ /* Uses Knuth's Algorithm 2.3.1T as modified in exercise 13
+ (postorder traversal). */
+
+ /* T1. */
+ avl_node *an[AVL_MAX_HEIGHT]; /* Stack A: nodes. */
+ char ab[AVL_MAX_HEIGHT]; /* Stack A: bits. */
+ int ap = 0; /* Stack A: height. */
+ avl_node *p = tree->root.link[0];
+
+ for (;;)
+ {
+ /* T2. */
+ while (p != NULL)
+ {
+ /* T3. */
+ ab[ap] = 0;
+ an[ap++] = p;
+ p = p->link[0];
+ }
+
+ /* T4. */
+ for (;;)
+ {
+ if (ap == 0)
+ goto done;
+
+ p = an[--ap];
+ if (ab[ap] == 0)
+ {
+ ab[ap++] = 1;
+ p = p->link[1];
+ break;
+ }
+
+ if (free_func)
+ free_func (p->data, tree->param);
+#if PSPP
+ if (tree->pool == NULL)
+#endif
+ free (p);
+ }
+ }
+ }
+
+ done:
+#if PSPP
+ if (tree->pool == NULL)
+#endif
+ free (tree);
+}
+
+/* avl_destroy() with FREE_FUNC hardcoded as free(). */
+void
+avl_free (avl_tree *tree)
+{
+ avl_destroy (tree, (avl_node_func) free);
+}
+
+/* Return the number of nodes in TREE. */
+int
+avl_count (const avl_tree *tree)
+{
+ assert (tree != NULL);
+ return tree->count;
+}
+
+/* Allocates room for a new avl_node in POOL, or using xmalloc() if
+ POOL is NULL. */
+#if PSPP
+static inline avl_node *
+new_node (struct pool *pool)
+{
+ if (pool != NULL)
+ return pool_alloc (pool, sizeof (avl_node));
+ else
+ return xmalloc (sizeof (avl_node));
+}
+#else
+static inline avl_node *
+new_node (void)
+{
+ return xmalloc (sizeof (avl_node));
+}
+
+#define new_node(POOL) \
+ new_node ()
+#endif
+
+/* Copy the contents of TREE to a new tree in POOL. If COPY is
+ non-NULL, then each data item is passed to function COPY, and the
+ return values are inserted into the new tree; otherwise, the items
+ are copied verbatim from the old tree to the new tree. Returns the
+ new tree. */
+avl_tree *
+avl_copy (MAYBE_POOL const avl_tree *tree, avl_copy_func copy)
+{
+ /* This is a combination of Knuth's Algorithm 2.3.1C (copying a
+ binary tree) and Algorithm 2.3.1T as modified by exercise 12
+ (preorder traversal). */
+
+ avl_tree *new_tree;
+
+ /* PT1. */
+ const avl_node *pa[AVL_MAX_HEIGHT]; /* Stack PA: nodes. */
+ const avl_node **pp = pa; /* Stack PA: stack pointer. */
+ const avl_node *p = &tree->root;
+
+ /* QT1. */
+ avl_node *qa[AVL_MAX_HEIGHT]; /* Stack QA: nodes. */
+ avl_node **qp = qa; /* Stack QA: stack pointer. */
+ avl_node *q;
+
+ assert (tree != NULL);
+#if PSPP
+ new_tree = avl_create (pool, tree->cmp, tree->param);
+#else
+ new_tree = avl_create (tree->cmp, tree->param);
+#endif
+ new_tree->count = tree->count;
+ q = &new_tree->root;
+
+ for (;;)
+ {
+ /* C4. */
+ if (p->link[0] != NULL)
+ {
+ avl_node *r = new_node (pool);
+ r->link[0] = r->link[1] = NULL;
+ q->link[0] = r;
+ }
+
+ /* C5: Find preorder successors of P and Q. */
+ goto start;
+ for (;;)
+ {
+ /* PT2. */
+ while (p != NULL)
+ {
+ goto escape;
+ start:
+ /* PT3. */
+ *pp++ = p;
+ *qp++ = q;
+ p = p->link[0];
+ q = q->link[0];
+ }
+
+ /* PT4. */
+ if (pp == pa)
+ {
+ assert (qp == qa);
+ return new_tree;
+ }
+
+ p = *--pp;
+ q = *--qp;
+
+ /* PT5. */
+ p = p->link[1];
+ q = q->link[1];
+ }
+ escape:
+
+ /* C2. */
+ if (p->link[1])
+ {
+ avl_node *r = new_node (pool);
+ r->link[0] = r->link[1] = NULL;
+ q->link[1] = r;
+ }
+
+ /* C3. */
+ q->bal = p->bal;
+ if (copy == NULL)
+ q->data = p->data;
+ else
+ q->data = copy (p->data, tree->param);
+ }
+}
+
+/* Walk tree TREE in inorder, calling WALK_FUNC at each node. Passes
+ PARAM to WALK_FUNC. */
+void
+avl_walk (const avl_tree *tree, avl_node_func walk_func, void *param)
+{
+ /* Uses Knuth's algorithm 2.3.1T (inorder traversal). */
+ assert (tree && walk_func);
+
+ {
+ /* T1. */
+ const avl_node *an[AVL_MAX_HEIGHT]; /* Stack A: nodes. */
+ const avl_node **ap = an; /* Stack A: stack pointer. */
+ const avl_node *p = tree->root.link[0];
+
+ for (;;)
+ {
+ /* T2. */
+ while (p != NULL)
+ {
+ /* T3. */
+ *ap++ = p;
+ p = p->link[0];
+ }
+
+ /* T4. */
+ if (ap == an)
+ return;
+ p = *--ap;
+
+ /* T5. */
+ walk_func (p->data, param);
+ p = p->link[1];
+ }
+ }
+}
+
+/* Each call to this function for a given TREE and TRAV return the
+ next item in the tree in inorder. Initialize the first element of
+ TRAV (init) to 0 before calling the first time. Returns NULL when
+ out of elements. */
+void *
+avl_traverse (const avl_tree *tree, avl_traverser *trav)
+{
+ assert (tree && trav);
+
+ /* Uses Knuth's algorithm 2.3.1T (inorder traversal). */
+ if (trav->init == 0)
+ {
+ /* T1. */
+ trav->init = 1;
+ trav->nstack = 0;
+ trav->p = tree->root.link[0];
+ }
+ else
+ /* T5. */
+ trav->p = trav->p->link[1];
+
+ for (;;)
+ {
+ /* T2. */
+ while (trav->p != NULL)
+ {
+ /* T3. */
+ trav->stack[trav->nstack++] = trav->p;
+ trav->p = trav->p->link[0];
+ }
+
+ /* T4. */
+ if (trav->nstack == 0)
+ {
+ trav->init = 0;
+ return NULL;
+ }
+ trav->p = trav->stack[--trav->nstack];
+
+ /* T5. */
+ return trav->p->data;
+ }
+}
+
+/* Search TREE for an item matching ITEM. If found, returns a pointer
+ to the address of the item. If none is found, ITEM is inserted
+ into the tree, and a pointer to the address of ITEM is returned.
+ In either case, the pointer returned can be changed by the caller,
+ or the returned data item can be directly edited, but the key data
+ in the item must not be changed. */
+void **
+avl_probe (avl_tree *tree, void *item)
+{
+ /* Uses Knuth's Algorithm 6.2.3A (balanced tree search and
+ insertion), but caches results of comparisons. In empirical
+ tests this eliminates about 25% of the comparisons seen under
+ random insertions. */
+
+ /* A1. */
+ avl_node *t;
+ avl_node *s, *p, *q, *r;
+
+ assert (tree != NULL);
+ t = &tree->root;
+ s = p = t->link[0];
+
+ if (s == NULL)
+ {
+ tree->count++;
+ assert (tree->count == 1);
+ q = t->link[0] = new_node (tree->pool);
+ q->data = item;
+ q->link[0] = q->link[1] = NULL;
+ q->bal = 0;
+ return &q->data;
+ }
+
+ for (;;)
+ {
+ /* A2. */
+ int diff = tree->cmp (item, p->data, tree->param);
+
+ /* A3. */
+ if (diff < 0)
+ {
+ p->cache = 0;
+ q = p->link[0];
+ if (q == NULL)
+ {
+ p->link[0] = q = new_node (tree->pool);
+ break;
+ }
+ }
+ /* A4. */
+ else if (diff > 0)
+ {
+ p->cache = 1;
+ q = p->link[1];
+ if (q == NULL)
+ {
+ p->link[1] = q = new_node (tree->pool);
+ break;
+ }
+ }
+ else
+ /* A2. */
+ return &p->data;
+
+ /* A3, A4. */
+ if (q->bal != 0)
+ t = p, s = q;
+ p = q;
+ }
+
+ /* A5. */
+ tree->count++;
+ q->data = item;
+ q->link[0] = q->link[1] = NULL;
+ q->bal = 0;
+
+ /* A6. */
+ r = p = s->link[(int) s->cache];
+ while (p != q)
+ {
+ p->bal = p->cache * 2 - 1;
+ p = p->link[(int) p->cache];
+ }
+
+ /* A7. */
+ if (s->cache == 0)
+ {
+ /* a = -1. */
+ if (s->bal == 0)
+ {
+ s->bal = -1;
+ return &q->data;
+ }
+ else if (s->bal == +1)
+ {
+ s->bal = 0;
+ return &q->data;
+ }
+
+ assert (s->bal == -1);
+ if (r->bal == -1)
+ {
+ /* A8. */
+ p = r;
+ s->link[0] = r->link[1];
+ r->link[1] = s;
+ s->bal = r->bal = 0;
+ }
+ else
+ {
+ /* A9. */
+ assert (r->bal == +1);
+ p = r->link[1];
+ r->link[1] = p->link[0];
+ p->link[0] = r;
+ s->link[0] = p->link[1];
+ p->link[1] = s;
+ if (p->bal == -1)
+ s->bal = 1, r->bal = 0;
+ else if (p->bal == 0)
+ s->bal = r->bal = 0;
+ else
+ {
+ assert (p->bal == +1);
+ s->bal = 0, r->bal = -1;
+ }
+ p->bal = 0;
+ }
+ }
+ else
+ {
+ /* a == +1. */
+ if (s->bal == 0)
+ {
+ s->bal = 1;
+ return &q->data;
+ }
+ else if (s->bal == -1)
+ {
+ s->bal = 0;
+ return &q->data;
+ }
+
+ assert (s->bal == +1);
+ if (r->bal == +1)
+ {
+ /* A8. */
+ p = r;
+ s->link[1] = r->link[0];
+ r->link[0] = s;
+ s->bal = r->bal = 0;
+ }
+ else
+ {
+ /* A9. */
+ assert (r->bal == -1);
+ p = r->link[0];
+ r->link[0] = p->link[1];
+ p->link[1] = r;
+ s->link[1] = p->link[0];
+ p->link[0] = s;
+ if (p->bal == +1)
+ s->bal = -1, r->bal = 0;
+ else if (p->bal == 0)
+ s->bal = r->bal = 0;
+ else
+ {
+ assert (p->bal == -1);
+ s->bal = 0, r->bal = 1;
+ }
+ p->bal = 0;
+ }
+ }
+
+ /* A10. */
+ if (t != &tree->root && s == t->link[1])
+ t->link[1] = p;
+ else
+ t->link[0] = p;
+
+ return &q->data;
+}
+
+/* Search TREE for an item matching ITEM, and return it if found. */
+void *
+avl_find (const avl_tree *tree, const void *item)
+{
+ const avl_node *p;
+
+ assert (tree != NULL);
+ for (p = tree->root.link[0]; p; )
+ {
+ int diff = tree->cmp (item, p->data, tree->param);
+
+ if (diff < 0)
+ p = p->link[0];
+ else if (diff > 0)
+ p = p->link[1];
+ else
+ return p->data;
+ }
+
+ return NULL;
+}
+
+/* Searches AVL tree TREE for an item matching ITEM. If found, the
+ item is removed from the tree and the actual item found is returned
+ to the caller. If no item matching ITEM exists in the tree,
+ returns NULL. */
+void *
+avl_delete (avl_tree *tree, const void *item)
+{
+ /* Uses my Algorithm D, which can be found at
+ http://www.msu.edu/user/pfaffben/avl. Algorithm D is based on
+ Knuth's Algorithm 6.2.2D (Tree deletion) and 6.2.3A (Balanced
+ tree search and insertion), as well as the notes on pages 465-466
+ of Vol. 3. */
+
+ /* D1. */
+ avl_node *pa[AVL_MAX_HEIGHT]; /* Stack P: Nodes. */
+ char a[AVL_MAX_HEIGHT]; /* Stack P: Bits. */
+ int k = 1; /* Stack P: Pointer. */
+
+ avl_node **q;
+ avl_node *p;
+
+ assert (tree != NULL);
+
+ a[0] = 0;
+ pa[0] = &tree->root;
+ p = tree->root.link[0];
+ for (;;)
+ {
+ /* D2. */
+ int diff;
+
+ if (p == NULL)
+ return NULL;
+
+ diff = tree->cmp (item, p->data, tree->param);
+ if (diff == 0)
+ break;
+
+ /* D3, D4. */
+ pa[k] = p;
+ if (diff < 0)
+ {
+ p = p->link[0];
+ a[k] = 0;
+ }
+ else if (diff > 0)
+ {
+ p = p->link[1];
+ a[k] = 1;
+ }
+ k++;
+ }
+ tree->count--;
+
+ item = p->data;
+
+ /* D5. */
+ q = &pa[k - 1]->link[(int) a[k - 1]];
+ if (p->link[1] == NULL)
+ {
+ *q = p->link[0];
+ if (*q)
+ (*q)->bal = 0;
+ }
+ else
+ {
+ /* D6. */
+ avl_node *r = p->link[1];
+ if (r->link[0] == NULL)
+ {
+ r->link[0] = p->link[0];
+ *q = r;
+ r->bal = p->bal;
+ a[k] = 1;
+ pa[k++] = r;
+ }
+ else
+ {
+ /* D7. */
+ avl_node *s = r->link[0];
+ int l = k++;
+
+ a[k] = 0;
+ pa[k++] = r;
+
+ /* D8. */
+ while (s->link[0] != NULL)
+ {
+ r = s;
+ s = r->link[0];
+ a[k] = 0;
+ pa[k++] = r;
+ }
+
+ /* D9. */
+ a[l] = 1;
+ pa[l] = s;
+ s->link[0] = p->link[0];
+ r->link[0] = s->link[1];
+ s->link[1] = p->link[1];
+ s->bal = p->bal;
+ *q = s;
+ }
+ }
+
+#if PSPP
+ if (tree->pool == NULL)
+#endif
+ free (p);
+
+ assert (k > 0);
+ /* D10. */
+ while (--k)
+ {
+ avl_node *s = pa[k], *r;
+
+ if (a[k] == 0)
+ {
+ /* D10. */
+ if (s->bal == -1)
+ {
+ s->bal = 0;
+ continue;
+ }
+ else if (s->bal == 0)
+ {
+ s->bal = 1;
+ break;
+ }
+
+ assert (s->bal == +1);
+ r = s->link[1];
+
+ assert (r != NULL);
+ if (r->bal == 0)
+ {
+ /* D11. */
+ s->link[1] = r->link[0];
+ r->link[0] = s;
+ r->bal = -1;
+ pa[k - 1]->link[(int) a[k - 1]] = r;
+ break;
+ }
+ else if (r->bal == +1)
+ {
+ /* D12. */
+ s->link[1] = r->link[0];
+ r->link[0] = s;
+ s->bal = r->bal = 0;
+ pa[k - 1]->link[(int) a[k - 1]] = r;
+ }
+ else
+ {
+ /* D13. */
+ assert (r->bal == -1);
+ p = r->link[0];
+ r->link[0] = p->link[1];
+ p->link[1] = r;
+ s->link[1] = p->link[0];
+ p->link[0] = s;
+ if (p->bal == +1)
+ s->bal = -1, r->bal = 0;
+ else if (p->bal == 0)
+ s->bal = r->bal = 0;
+ else
+ {
+ assert (p->bal == -1);
+ s->bal = 0, r->bal = +1;
+ }
+ p->bal = 0;
+ pa[k - 1]->link[(int) a[k - 1]] = p;
+ }
+ }
+ else
+ {
+ assert (a[k] == 1);
+
+ /* D10. */
+ if (s->bal == +1)
+ {
+ s->bal = 0;
+ continue;
+ }
+ else if (s->bal == 0)
+ {
+ s->bal = -1;
+ break;
+ }
+
+ assert (s->bal == -1);
+ r = s->link[0];
+
+ if (r == NULL || r->bal == 0)
+ {
+ /* D11. */
+ s->link[0] = r->link[1];
+ r->link[1] = s;
+ r->bal = 1;
+ pa[k - 1]->link[(int) a[k - 1]] = r;
+ break;
+ }
+ else if (r->bal == -1)
+ {
+ /* D12. */
+ s->link[0] = r->link[1];
+ r->link[1] = s;
+ s->bal = r->bal = 0;
+ pa[k - 1]->link[(int) a[k - 1]] = r;
+ }
+ else if (r->bal == +1)
+ {
+ /* D13. */
+ p = r->link[1];
+ r->link[1] = p->link[0];
+ p->link[0] = r;
+ s->link[0] = p->link[1];
+ p->link[1] = s;
+ if (p->bal == -1)
+ s->bal = 1, r->bal = 0;
+ else if (p->bal == 0)
+ s->bal = r->bal = 0;
+ else
+ {
+ assert (p->bal == 1);
+ s->bal = 0, r->bal = -1;
+ }
+ p->bal = 0;
+ pa[k - 1]->link[(int) a[k - 1]] = p;
+ }
+ }
+ }
+
+ return (void *) item;
+}
+
+/* Inserts ITEM into TREE. Returns NULL if the item was inserted,
+ otherwise a pointer to the duplicate item. */
+void *
+avl_insert (avl_tree *tree, void *item)
+{
+ void **p;
+
+ assert (tree != NULL);
+
+ p = avl_probe (tree, item);
+ return (*p == item) ? NULL : *p;
+}
+
+/* If ITEM does not exist in TREE, inserts it and returns NULL. If a
+ matching item does exist, it is replaced by ITEM and the item
+ replaced is returned. The caller is responsible for freeing the
+ item returned. */
+void *
+avl_replace (avl_tree *tree, void *item)
+{
+ void **p;
+
+ assert (tree != NULL);
+
+ p = avl_probe (tree, item);
+ if (*p == item)
+ return NULL;
+ else
+ {
+ void *r = *p;
+ *p = item;
+ return r;
+ }
+}
+
+/* Delete ITEM from TREE when you know that ITEM must be in TREE. For
+ debugging purposes. */
+void *
+(avl_force_delete) (avl_tree *tree, void *item)
+{
+ void *found = avl_delete (tree, item);
+ assert (found != NULL);
+ return found;
+}
+\f
+#if SELF_TEST
+
+/* Used to flag delayed aborting. */
+int done = 0;
+
+/* Print the structure of node NODE of an avl tree, which is LEVEL
+ levels from the top of the tree. Uses different delimiters to
+ visually distinguish levels. */
+void
+print_structure (avl_node *node, int level)
+{
+ char lc[] = "([{`/";
+ char rc[] = ")]}'\\";
+
+ assert (level <= 10);
+
+ if (node == NULL)
+ {
+ printf (" nil");
+ return;
+ }
+ printf (" %c%d", lc[level % 5], (int) node->data);
+ if (node->link[0] || node->link[1])
+ print_structure (node->link[0], level + 1);
+ if (node->link[1])
+ print_structure (node->link[1], level + 1);
+ printf ("%c", rc[level % 5]);
+}
+
+/* Compare two integers A and B and return a strcmp()-type result. */
+int
+compare_ints (const void *a, const void *b, void *param unused)
+{
+ return ((int) a) - ((int) b);
+}
+
+/* Print the value of integer A. */
+void
+print_int (void *a, void *param unused)
+{
+ printf (" %d", (int) a);
+}
+
+/* Linearly print contents of TREE. */
+void
+print_contents (avl_tree *tree)
+{
+ avl_walk (tree, print_int, NULL);
+ printf ("\n");
+}
+
+/* Examine NODE in a avl tree. *COUNT is increased by the number of
+ nodes in the tree, including the current one. If the node is the
+ root of the tree, PARENT should be INT_MIN, otherwise it should be
+ the parent node value. DIR is the direction that the current node
+ is linked from the parent: -1 for left child, +1 for right child;
+ it is not used if PARENT is INT_MIN. Returns the height of the
+ tree rooted at NODE. */
+int
+recurse_tree (avl_node *node, int *count, int parent, int dir)
+{
+ if (node)
+ {
+ int d = (int) node->data;
+ int nl = node->link[0] ? recurse_tree (node->link[0], count, d, -1) : 0;
+ int nr = node->link[1] ? recurse_tree (node->link[1], count, d, 1) : 0;
+ (*count)++;
+
+ if (nr - nl != node->bal)
+ {
+ printf (" Node %d is unbalanced: right height=%d, left height=%d, "
+ "difference=%d, but balance factor=%d.\n",
+ d, nr, nl, nr - nl, node->bal);
+ done = 1;
+ }
+
+ if (parent != INT_MIN)
+ {
+ assert (dir == -1 || dir == +1);
+ if (dir == -1 && d > parent)
+ {
+ printf (" Node %d is smaller than its left child %d.\n",
+ parent, d);
+ done = 1;
+ }
+ else if (dir == +1 && d < parent)
+ {
+ printf (" Node %d is larger than its right child %d.\n",
+ parent, d);
+ done = 1;
+ }
+ }
+ assert (node->bal >= -1 && node->bal <= 1);
+ return 1 + (nl > nr ? nl : nr);
+ }
+ else return 0;
+}
+
+/* Check that everything about TREE is kosher. */
+void
+verify_tree (avl_tree *tree)
+{
+ int count = 0;
+ recurse_tree (tree->root.link[0], &count, INT_MIN, 0);
+ if (count != tree->count)
+ {
+ printf (" Tree has %d nodes, but tree count is %d.\n",
+ count, tree->count);
+ done = 1;
+ }
+ if (done)
+ abort ();
+}
+
+/* Arrange the N elements of ARRAY in random order. */
+void
+shuffle (int *array, int n)
+{
+ int i;
+
+ for (i = 0; i < n; i++)
+ {
+ int j = i + rand () % (n - i);
+ int t = array[j];
+ array[j] = array[i];
+ array[i] = t;
+ }
+}
+
+/* Compares avl trees rooted at A and B, making sure that they are
+ identical. */
+void
+compare_trees (avl_node *a, avl_node *b)
+{
+ if (a == NULL || b == NULL)
+ {
+ assert (a == NULL && b == NULL);
+ return;
+ }
+ if (a->data != b->data || a->bal != b->bal
+ || ((a->link[0] != NULL) ^ (b->link[0] != NULL))
+ || ((a->link[1] != NULL) ^ (b->link[1] != NULL)))
+ {
+ printf (" Copied nodes differ: %d b=%d a->bal=%d b->bal=%d a:",
+ (int) a->data, (int) b->data, a->bal, b->bal);
+ if (a->link[0])
+ printf ("l");
+ if (a->link[1])
+ printf ("r");
+ printf (" b:");
+ if (b->link[0])
+ printf ("l");
+ if (b->link[1])
+ printf ("r");
+ printf ("\n");
+ abort ();
+ }
+ if (a->link[0] != NULL)
+ compare_trees (a->link[0], b->link[0]);
+ if (a->link[1] != NULL)
+ compare_trees (a->link[1], b->link[1]);
+}
+
+/* Simple stress test procedure for the AVL tree routines. Does the
+ following:
+
+ * Generate a random number seed. By default this is generated from
+ the current time. You can also pass a seed value on the command
+ line if you want to test the same case. The seed value is
+ displayed.
+
+ * Create a tree and insert the integers from 0 up to TREE_SIZE - 1
+ into it, in random order. Verify the tree structure after each
+ insertion.
+
+ * Remove each integer from the tree, in a different random order.
+ After each deletion, verify the tree structure; also, make a copy
+ of the tree into a new tree, verify the copy and compare it to the
+ original, then destroy the copy.
+
+ * Destroy the tree, increment the random seed value, and start over.
+
+ If you make any modifications to the avl tree routines, then you
+ might want to insert some calls to print_structure() at strategic
+ places in order to be able to see what's really going on. Also,
+ memory debuggers like Checker or Purify are very handy. */
+#define TREE_SIZE 1024
+#define N_ITERATIONS 16
+int
+main (int argc, char **argv)
+{
+ int array[TREE_SIZE];
+ int seed;
+ int iteration;
+
+ if (argc == 2)
+ seed = atoi (argv[1]);
+ else
+ seed = time (0) * 257 % 32768;
+
+ fputs ("Testing avl...\n", stdout);
+
+ for (iteration = 1; iteration <= N_ITERATIONS; iteration++)
+ {
+ avl_tree *tree;
+ int i;
+
+ printf ("Iteration %4d/%4d: seed=%5d", iteration, N_ITERATIONS, seed);
+ fflush (stdout);
+
+ srand (seed++);
+
+ for (i = 0; i < TREE_SIZE; i++)
+ array[i] = i;
+ shuffle (array, TREE_SIZE);
+
+ tree = avl_create (compare_ints, NULL);
+ for (i = 0; i < TREE_SIZE; i++)
+ avl_force_insert (tree, (void *) (array[i]));
+ verify_tree (tree);
+
+ shuffle (array, TREE_SIZE);
+ for (i = 0; i < TREE_SIZE; i++)
+ {
+ avl_tree *copy;
+
+ avl_delete (tree, (void *) (array[i]));
+ verify_tree (tree);
+
+ copy = avl_copy (tree, NULL);
+ verify_tree (copy);
+ compare_trees (tree->root.link[0], copy->root.link[0]);
+ avl_destroy (copy, NULL);
+
+ if (i % 128 == 0)
+ {
+ putchar ('.');
+ fflush (stdout);
+ }
+ }
+ fputs (" good.\n", stdout);
+
+ avl_destroy (tree, NULL);
+ }
+
+ return 0;
+}
+#endif /* SELF_TEST */
+
+/*
+ Local variables:
+ compile-command: "gcc -DSELF_TEST=1 -W -Wall -I. -o ./avl-test avl.c"
+ End:
+*/
+
--- /dev/null
+/* libavl - manipulates AVL trees.
+ Copyright (C) 1998-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* This is file avl.h in libavl, version 1.1.0. */
+
+#if !avl_h
+#define avl_h 1
+
+/* This stack size allows for AVL trees for between 5,704,880 and
+ 4,294,967,295 nodes, depending on order of insertion. If you
+ increase this it will require recoding some functions that assume
+ one long is big enough for a bitmap. */
+#ifndef AVL_MAX_HEIGHT
+#define AVL_MAX_HEIGHT 32
+#endif
+
+/* Structure for a node in an AVL tree. */
+typedef struct avl_node
+ {
+ void *data; /* Pointer to data. */
+ struct avl_node *link[2]; /* Subtrees. */
+ signed char bal; /* Balance factor. */
+ char cache; /* Used during insertion. */
+ signed char pad[2]; /* Unused. Reserved for threaded trees. */
+ }
+avl_node;
+
+/* Used for traversing an AVL tree. */
+typedef struct avl_traverser
+ {
+ int init; /* Initialized? */
+ int nstack; /* Top of stack. */
+ const avl_node *p; /* Used for traversal. */
+ const avl_node *stack[AVL_MAX_HEIGHT];/* Descended trees. */
+ }
+avl_traverser;
+
+#define avl_traverser_init(TRAVERSER) (TRAVERSER).init = 0
+
+/* Function types. */
+#if !AVL_FUNC_TYPES
+#define AVL_FUNC_TYPES 1
+typedef int (*avl_comparison_func) (const void *a, const void *b, void *param);
+typedef void (*avl_node_func) (void *data, void *param);
+typedef void *(*avl_copy_func) (void *data, void *param);
+#endif
+
+/* Structure which holds information about an AVL tree. */
+typedef struct avl_tree
+ {
+#if PSPP
+ struct pool *pool; /* Pool to store nodes. */
+#endif
+ avl_node root; /* Tree root node. */
+ avl_comparison_func cmp; /* Used to compare keys. */
+ int count; /* Number of nodes in the tree. */
+ void *param; /* Arbitary user data. */
+ }
+avl_tree;
+
+#if PSPP
+#define MAYBE_POOL struct pool *pool,
+#else
+#define MAYBE_POOL /* nothing */
+#endif
+
+/* General functions. */
+avl_tree *avl_create (MAYBE_POOL avl_comparison_func, void *param);
+void avl_destroy (avl_tree *, avl_node_func);
+void avl_free (avl_tree *);
+int avl_count (const avl_tree *);
+avl_tree *avl_copy (MAYBE_POOL const avl_tree *, avl_copy_func);
+
+/* Walk the tree. */
+void avl_walk (const avl_tree *, avl_node_func, void *param);
+void *avl_traverse (const avl_tree *, avl_traverser *);
+
+/* Search for a given item. */
+void **avl_probe (avl_tree *, void *);
+void *avl_delete (avl_tree *, const void *);
+void *avl_find (const avl_tree *, const void *);
+
+#if __GCC__ >= 2
+extern inline void *
+avl_insert (avl_tree *tree, void *item)
+{
+ void **p = avl_probe (tree, item);
+ return (*p == item) ? NULL : *p;
+}
+
+extern inline void *
+avl_replace (avl_tree *tree, void *item)
+{
+ void **p = avl_probe (tree, item);
+ if (*p == item)
+ return NULL;
+ else
+ {
+ void *r = *p;
+ *p = item;
+ return r;
+ }
+}
+#else /* not gcc */
+void *avl_insert (avl_tree *tree, void *item);
+void *avl_replace (avl_tree *tree, void *item);
+#endif /* not gcc */
+
+/* Easy assertions on insertion & deletion. */
+#ifndef NDEBUG
+#define avl_force_insert(A, B) \
+ do \
+ { \
+ void *r = avl_insert (A, B); \
+ assert (r == NULL); \
+ } \
+ while (0)
+void *avl_force_delete (avl_tree *, void *);
+#else
+#define avl_force_insert(A, B) \
+ avl_insert (A, B)
+#define avl_force_delete(A, B) \
+ avl_delete (A, B)
+#endif
+
+#endif /* avl_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !bitvector_h
+#define bitvector_h 1
+
+#include <limits.h>
+
+/* Sets bit Y starting at address X. */
+#define SET_BIT(X, Y) \
+ (((unsigned char *) X)[(Y) / CHAR_BIT] |= 1 << ((Y) % CHAR_BIT))
+
+/* Clears bit Y starting at address X. */
+#define CLEAR_BIT(X, Y) \
+ (((unsigned char *) X)[(Y) / CHAR_BIT] &= ~(1 << ((Y) % CHAR_BIT)))
+
+/* Sets bit Y starting at address X to Z, which is zero/nonzero */
+#define SET_BIT_TO(X, Y, Z) \
+ ((Z) ? SET_BIT(X, Y) : CLEAR_BIT(X, Y))
+
+/* Nonzero if bit Y starting at address X is set. */
+#define TEST_BIT(X, Y) \
+ (((unsigned char *) X)[(Y) / CHAR_BIT] & (1 << ((Y) % CHAR_BIT)))
+
+/* Returns 2**X, 0 <= X < 32. */
+#define BIT_INDEX(X) \
+ (1ul << (X))
+
+#endif /* bitvector.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "cases.h"
+#include "var.h"
+#include "vfm.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* Initializes V. */
+void
+vec_init (struct long_vec * v)
+{
+ v->vec = NULL;
+ v->n = v->m = 0;
+}
+
+/* Deletes the contents of V. */
+void
+vec_clear (struct long_vec * v)
+{
+ free (v->vec);
+ v->vec = NULL;
+ v->n = v->m = 0;
+}
+
+/* Inserts ELEM into V. */
+void
+vec_insert (struct long_vec * v, long elem)
+{
+ if (v->n >= v->m)
+ {
+ v->m = (v->m == 0 ? 16 : 2 * v->m);
+ v->vec = xrealloc (v->vec, v->m * sizeof *v->vec);
+ }
+ v->vec[v->n++] = elem;
+}
+
+/* Deletes all occurrences of values A through B exclusive from V. */
+void
+vec_delete (struct long_vec * v, long a, long b)
+{
+ int i;
+
+ for (i = v->n - 1; i >= 0; i--)
+ if (v->vec[i] >= a && v->vec[i] < b)
+ v->vec[i] = v->vec[--v->n];
+}
+
+/* Sticks V->FV in the proper vector. */
+void
+envector (const struct variable *v)
+{
+ if (v->type == NUMERIC)
+ {
+ if (v->left)
+ vec_insert (&init_zero, v->fv);
+ else
+ vec_insert (&reinit_sysmis, v->fv);
+ }
+ else
+ {
+ int i;
+
+ if (v->left)
+ for (i = v->fv; i < v->fv + v->nv; i++)
+ vec_insert (&init_blanks, i);
+ else
+ for (i = v->fv; i < v->fv + v->nv; i++)
+ vec_insert (&reinit_blanks, i);
+ }
+}
+
+/* Removes V->FV from the proper vector. */
+void
+devector (const struct variable *v)
+{
+ if (v->type == NUMERIC)
+ {
+ if (v->left)
+ vec_delete (&init_zero, v->fv, v->fv + 1);
+ else
+ vec_delete (&reinit_sysmis, v->fv, v->fv + 1);
+ }
+ else if (v->left)
+ vec_delete (&init_blanks, v->fv, v->fv + v->nv);
+ else
+ vec_delete (&reinit_blanks, v->fv, v->fv + v->nv);
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !cases_h
+#define cases_h 1
+
+/* Vectors. */
+
+/* A vector of longs. */
+struct long_vec
+ {
+ long *vec; /* Contents. */
+ int n; /* Number of elements. */
+ int m; /* Number of elements room is allocated for. */
+ };
+
+struct variable;
+
+void vec_init (struct long_vec *);
+void vec_clear (struct long_vec *);
+void vec_insert (struct long_vec *, long);
+void vec_delete (struct long_vec *, long a, long b);
+void devector (const struct variable *);
+void envector (const struct variable *);
+
+#endif /* !cases_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <ctype.h>
+#include <stdio.h>
+#include <errno.h>
+#include <getopt.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "error.h"
+#include "filename.h"
+#include "getline.h"
+#include "main.h"
+#include "output.h"
+#include "settings.h"
+#include "str.h"
+#include "var.h"
+#include "version.h"
+
+void welcome (void);
+static void usage (void);
+
+char *subst_vars (char *);
+
+/* Parses the command line specified by ARGC and ARGV as received by
+ main(). */
+void
+parse_command_line (int argc, char **argv)
+{
+ static struct option long_options[] =
+ {
+ {"command", required_argument, NULL, 'c'},
+ {"config-directory", required_argument, NULL, 'B'},
+ {"device", required_argument, NULL, 'o'},
+ {"dry-run", no_argument, NULL, 'n'},
+ {"edit", no_argument, NULL, 'n'},
+ {"help", no_argument, NULL, 'h'},
+ {"include-directory", required_argument, NULL, 'I'},
+ {"interactive", no_argument, NULL, 'i'},
+ {"just-print", no_argument, NULL, 'n'},
+ {"list", no_argument, NULL, 'l'},
+ {"no-include", no_argument, NULL, 'I'},
+ {"no-statrc", no_argument, NULL, 'r'},
+ {"out-file", required_argument, NULL, 'f'},
+ {"pipe", no_argument, NULL, 'p'},
+ {"recon", no_argument, NULL, 'n'},
+ {"safer", no_argument, NULL, 's'},
+ {"testing-mode", no_argument, &set_testing_mode, 1},
+ {"verbose", no_argument, NULL, 'v'},
+ {"version", no_argument, NULL, 'V'},
+ {0, 0, 0, 0},
+ };
+
+ int c, i;
+
+ int cleared_device_defaults = 0;
+
+ int no_statrc = 0;
+
+ for (;;)
+ {
+ c = getopt_long (argc, argv, "B:c:f:hiI:lno:prsvV", long_options, NULL);
+ if (c == -1)
+ break;
+
+ switch (c)
+ {
+ case 'c':
+ {
+ static int n_cmds;
+
+ struct getl_script *script = xmalloc (sizeof *script);
+
+ {
+ struct getl_line_list *line;
+
+ script->first_line = line = xmalloc (sizeof *line);
+ line->line = xstrdup ("commandline");
+ line->len = --n_cmds;
+ line = line->next = xmalloc (sizeof *line);
+ line->line = xstrdup (optarg);
+ line->len = strlen (optarg);
+ line->next = NULL;
+ }
+
+ getl_add_virtual_file (script);
+ }
+ break;
+ case 'B':
+ config_path = optarg;
+ break;
+ case 'f':
+ printf (_("-f not yet implemented\n"));
+ break;
+ case 'h':
+ usage ();
+ assert (0);
+ case 'i':
+ getl_interactive = 2;
+ break;
+ case 'I':
+ if (optarg == NULL || !strcmp (optarg, "-"))
+ getl_clear_include_path ();
+ else
+ getl_add_include_dir (optarg);
+ break;
+ case 'l':
+ outp_list_classes ();
+ err_hcf (1);
+ case 'n':
+ printf (_("-n not yet implemented\n"));
+ break;
+ case 'o':
+ if (!cleared_device_defaults)
+ {
+ outp_configure_clear ();
+ cleared_device_defaults = 1;
+ }
+ outp_configure_add (optarg);
+ break;
+ case 'p':
+ printf (_("-p not yet implemented\n"));
+ break;
+ case 'r':
+ no_statrc = 1;
+ break;
+ case 's':
+ set_safer = 1;
+ break;
+ case 'v':
+ err_verbosity++;
+ break;
+ case 'V':
+ puts (version);
+ puts (_("\nCopyright (C) 1997-9, 2000 Free Software Foundation, "
+ "Inc.\n"
+ "This is free software; see the source for copying "
+ "conditions. There is NO\n"
+ "WARRANTY; not even for MERCHANTABILITY or FITNESS "
+ "FOR A PARTICULAR PURPOSE.\n\n"
+ "Written by Ben Pfaff <blp@gnu.org>."));
+ err_hcf (1);
+ case '?':
+ usage ();
+ assert (0);
+ case 0:
+ break;
+ default:
+ assert (0);
+ }
+ }
+
+ if (set_testing_mode)
+ {
+ /* FIXME: Later this option should do some other things, too. */
+ set_viewwidth = 79;
+ }
+
+ for (i = optind; i < argc; i++)
+ {
+ int separate = 1;
+
+ if (!strcmp (argv[i], "+"))
+ {
+ separate = 0;
+ if (++i >= argc)
+ usage ();
+ }
+ else if (strchr (argv[i], '='))
+ {
+ outp_configure_macro (argv[i]);
+ continue;
+ }
+ getl_add_file (argv[i], separate, 0);
+ }
+ if (getl_head)
+ getl_head->separate = 0;
+
+ if (getl_am_interactive)
+ getl_interactive = 1;
+
+ if (!no_statrc)
+ {
+ char *pspprc_fn = fn_search_path ("rc", config_path, NULL);
+
+ if (pspprc_fn)
+ getl_add_file (pspprc_fn, 0, 1);
+
+ free (pspprc_fn);
+ }
+}
+
+/* Message that describes PSPP command-line syntax. */
+static const char pre_syntax_message[] =
+N_("PSPP, a program for statistical analysis of sample data.\n"
+"\nUsage: %s [OPTION]... FILE...\n"
+"\nIf a long option shows an argument as mandatory, then it is mandatory\n"
+"for the equivalent short option also. Similarly for optional arguments.\n"
+"\nConfiguration:\n"
+" -B, --config-dir=DIR set configuration directory to DIR\n"
+" -o, --device=DEVICE select output driver DEVICE and disable defaults\n"
+" -d, --define=VAR[=VALUE] set environment variable VAR to VALUE, or empty\n"
+" -u, --undef=VAR undefine environment variable VAR\n"
+"\nInput and output:\n"
+" -f, --out-file=FILE send output to FILE (overwritten)\n"
+" -p, --pipe read script from stdin, send output to stdout\n"
+" -I-, --no-include clear include path\n"
+" -I, --include=DIR append DIR to include path\n"
+" -c, --command=COMMAND execute COMMAND before .pspp/rc at startup\n"
+"\nLanguage modifiers:\n"
+" -i, --interactive interpret scripts in interactive mode\n"
+" -n, --edit just check syntax; don't actually run the code\n"
+" -r, --no-statrc disable execution of .pspp/rc at startup\n"
+" -s, --safer don't allow some unsafe operations\n"
+"\nInformative output:\n"
+" -h, --help print this help, then exit\n"
+" -l, --list print a list of known driver classes, then exit\n"
+" -V, --version show PSPP version, then exit\n"
+" -v, --verbose increments verbosity level\n"
+"\nNon-option arguments:\n"
+" FILE1 FILE2 run FILE1, clear the dictionary, run FILE2\n"
+" FILE1 + FILE2 run FILE1 then FILE2 without clearing dictionary\n"
+" KEY=VALUE overrides macros in output initialization file\n"
+"\n");
+
+/* Message that describes PSPP command-line syntax, continued. */
+static const char post_syntax_message[] =
+N_("\nReport bugs to <bug-gnu-pspp@gnu.org>.\n");
+
+/* Writes a syntax description to stdout and terminates. */
+static void
+usage (void)
+{
+ printf (gettext (pre_syntax_message), pgmname);
+ outp_list_classes ();
+ printf (gettext (post_syntax_message));
+
+ err_hcf (1);
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <errno.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "getline.h"
+#include "lexer.h"
+#include "main.h"
+#include "settings.h"
+#include "som.h"
+#include "str.h"
+#include "tab.h"
+#include "var.h"
+#include "vfm.h"
+
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#if HAVE_SYS_WAIT_H
+#include <sys/wait.h>
+#endif
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+\f
+/* Global variables. */
+
+/* A STATE_* constant giving the current program state. */
+int pgm_state;
+
+/* The name of the procedure currently executing, if any. */
+const char *cur_proc;
+\f
+/* Static variables. */
+
+/* A single command. */
+struct command
+ {
+ /* Initialized statically. */
+ char cmd[22]; /* Command name. */
+ int transition[4]; /* Transitions to make from each state. */
+ int (*func) (void); /* Function to call. */
+
+ /* Calculated at startup time. */
+ char *word[3]; /* cmd[], divided into individual words. */
+ struct command *next; /* Next command with same word[0]. */
+ };
+
+/* Prototype all the command functions. */
+#define DEFCMD(NAME, T1, T2, T3, T4, FUNC) \
+ int FUNC (void);
+#define UNIMPL(NAME, T1, T2, T3, T4)
+#include "command.def"
+#undef DEFCMD
+#undef UNIMPL
+
+/* Define the command array. */
+#define DEFCMD(NAME, T1, T2, T3, T4, FUNC) \
+ {NAME, {T1, T2, T3, T4}, FUNC, {NULL, NULL, NULL}, NULL},
+#define UNIMPL(NAME, T1, T2, T3, T4) \
+ {NAME, {T1, T2, T3, T4}, NULL, {NULL, NULL, NULL}, NULL},
+static struct command cmd_table[] =
+ {
+#include "command.def"
+ {"", {ERRO, ERRO, ERRO, ERRO}, NULL, {NULL, NULL, NULL}, NULL},
+ };
+#undef DEFCMD
+#undef UNIMPL
+\f
+/* Command parser. */
+
+static struct command *figure_out_command (void);
+
+/* Breaks the `cmd' member of C into individual words and sets C's
+ word[] member appropriately. */
+static void
+split_words (struct command *c)
+{
+ char *cmd, *save;
+ int i;
+
+ cmd = xstrdup (c->cmd);
+ for (i = 0; i < 3; i++)
+ cmd = c->word[i] = strtok_r (i == 0 ? cmd : NULL, " -", &save);
+}
+
+/* Initializes the command parser. */
+void
+cmd_init (void)
+{
+ struct command *c;
+
+ /* Break up command names into words. */
+ for (c = cmd_table; c->cmd[0]; c++)
+ split_words (c);
+
+ /* Make chains of commands having the same first word. */
+ for (c = cmd_table; c->cmd[0]; c++)
+ {
+ struct command *first;
+ for (first = c; c[1].word[0] && !strcmp (c[0].word[0], c[1].word[0]); c++)
+ c->next = c + 1;
+
+ c->next = NULL;
+ }
+}
+
+/* Determines whether command C is appropriate to call in this
+ part of a FILE TYPE structure. */
+static int
+FILE_TYPE_okay (struct command *c)
+{
+ int okay = 0;
+
+ if (c->func != cmd_record_type
+ && c->func != cmd_data_list
+ && c->func != cmd_repeating_data
+ && c->func != cmd_end_file_type)
+ msg (SE, _("%s not allowed inside FILE TYPE/END FILE TYPE."), c->cmd);
+#if 0
+ /* FIXME */
+ else if (c->func == cmd_repeating_data && fty.type == FTY_GROUPED)
+ msg (SE, _("%s not allowed inside FILE TYPE GROUPED/END FILE TYPE."),
+ c->cmd);
+ else if (!fty.had_rec_type && c->func != cmd_record_type)
+ msg (SE, _("RECORD TYPE must be the first command inside a "
+ "FILE TYPE structure."));
+#endif
+ else
+ okay = 1;
+
+#if 0
+ if (c->func == cmd_record_type)
+ fty.had_rec_type = 1;
+#endif
+
+ return okay;
+}
+
+/* Parses an entire PSPP command. This includes everything from the
+ command name to the terminating dot. Does most of its work by
+ passing it off to the respective command dispatchers. Only called
+ by parse() in main.c. */
+int
+cmd_parse (void)
+{
+ struct command *cp; /* Iterator used to find the proper command. */
+
+#if C_ALLOCA
+ /* The generic alloca package performs garbage collection when it is
+ called with an argument of zero. */
+ alloca (0);
+#endif /* C_ALLOCA */
+
+ /* Null commands can result from extra empty lines. */
+ if (token == '.')
+ return CMD_SUCCESS;
+
+ /* Parse comments. */
+ if ((token == T_ID && !strcmp (tokid, "COMMENT"))
+ || token == T_EXP || token == '*' || token == '[')
+ {
+ lex_skip_comment ();
+ return CMD_SUCCESS;
+ }
+
+ /* Otherwise the line must begin with a command name, which is
+ always an ID token. */
+ if (token != T_ID)
+ {
+ msg (SE, _("This line does not begin with a valid command name."));
+ return CMD_FAILURE;
+ }
+
+ /* Parse the command name. */
+ cp = figure_out_command ();
+ if (cp == NULL)
+ return CMD_FAILURE;
+ if (cp->func == NULL)
+ {
+ msg (SE, _("%s is not yet implemented."), cp->cmd);
+ while (token && token != '.')
+ lex_get ();
+ return CMD_SUCCESS;
+ }
+
+ /* If we're in a FILE TYPE structure, only certain commands can be
+ allowed. */
+ if (pgm_state == STATE_INPUT && vfm_source == &file_type_source
+ && !FILE_TYPE_okay (cp))
+ return CMD_FAILURE;
+
+ /* Certain state transitions are not allowed. Check for these. */
+ assert (pgm_state >= 0 && pgm_state < STATE_ERROR);
+ if (cp->transition[pgm_state] == STATE_ERROR)
+ {
+ static const char *state_name[4] =
+ {
+ N_("%s is not allowed (1) before a command to specify the "
+ "input program, such as DATA LIST, (2) between FILE TYPE "
+ "and END FILE TYPE, (3) between INPUT PROGRAM and END "
+ "INPUT PROGRAM."),
+ N_("%s is not allowed within an input program."),
+ N_("%s is only allowed within an input program."),
+ N_("%s is only allowed within an input program."),
+ };
+
+ msg (SE, gettext (state_name[pgm_state]), cp->cmd);
+ return CMD_FAILURE;
+ }
+
+#if DEBUGGING
+ if (cp->func != cmd_remark)
+ printf (_("%s command beginning\n"), cp->cmd);
+#endif
+
+ /* The structured output manager numbers all its tables. Increment
+ the major table number for each separate procedure. */
+ som_new_series ();
+
+ {
+ int result;
+
+ /* Call the command dispatcher. Save and restore the name of
+ the current command around this call. */
+ {
+ const char *prev_proc;
+
+ prev_proc = cur_proc;
+ cur_proc = cp->cmd;
+ result = cp->func ();
+ cur_proc = prev_proc;
+ }
+
+ /* Perform the state transition if the command completed
+ successfully (at least in part). */
+ if (result != 0)
+ {
+ pgm_state = cp->transition[pgm_state];
+
+ if (pgm_state == STATE_ERROR)
+ {
+ discard_variables ();
+ pgm_state = STATE_INIT;
+ }
+ }
+
+#if DEBUGGING
+ if (cp->func != cmd_remark)
+ printf (_("%s command completed\n\n"), cp->cmd);
+#endif
+
+ /* Pass the command's success value up to the caller. */
+ return result;
+ }
+}
+
+/* Parse the command name and return a pointer to the corresponding
+ struct command if successful.
+ If not successful, return a null pointer. */
+static struct command *
+figure_out_command (void)
+{
+ static const char *unk =
+ N_("The identifier(s) specified do not form a valid command name:");
+
+ static const char *inc =
+ N_("The identifier(s) specified do not form a complete command name:");
+
+ struct command *cp;
+
+ /* Parse the INCLUDE short form.
+ Note that `@' is a valid character in identifiers. */
+ if (tokid[0] == '@')
+ return &cmd_table[0];
+
+ /* Find a command whose first word matches this identifier.
+ If it is the only command that begins with this word, return
+ it. */
+ for (cp = cmd_table; cp->cmd[0]; cp++)
+ if (lex_id_match (cp->word[0], tokid))
+ break;
+
+ if (cp->cmd[0] == '\0')
+ {
+ msg (SE, "%s %s.", gettext (unk), ds_value (&tokstr));
+ return NULL;
+ }
+
+ if (cp->next == NULL)
+ return cp;
+
+ /* We know that there is more than one command starting with this
+ word. Read the next word in the command name. */
+ {
+ struct command *ocp = cp;
+
+ /* Verify that the next token is an identifier, because we
+ must disambiguate this command name. */
+ lex_get ();
+ if (token != T_ID)
+ {
+ /* If there's a command whose name is the first word only,
+ return it. This happens with, i.e., PRINT vs. PRINT
+ SPACE. */
+ if (ocp->word[1] == NULL)
+ return ocp;
+
+ msg (SE, "%s %s.", gettext (inc), ds_value (&tokstr));
+ return NULL;
+ }
+
+ for (; cp; cp = cp->next)
+ if (cp->word[1] && lex_id_match (cp->word[1], tokid))
+ break;
+
+ if (cp == NULL)
+ {
+ /* No match. If there's a command whose name is the first
+ word only, return it. This happens with, i.e., PRINT
+ vs. PRINT SPACE. */
+ if (ocp->word[1] == NULL)
+ return ocp;
+
+ msg (SE, "%s %s %s.", gettext (unk), ocp->word[0], tokid);
+ return NULL;
+ }
+
+ /* Check whether the next token is an identifier.
+ If not, bail. */
+ if (!isalpha ((unsigned char) (lex_look_ahead ())))
+ {
+ /* Check whether there is an unambiguous interpretation.
+ If not, give an error. */
+ if (cp->word[2]
+ && cp->next
+ && !strcmp (cp->word[1], cp->next->word[1]))
+ {
+ msg (SE, "%s %s %s.", gettext (inc), ocp->word[0], ocp->word[1]);
+ return NULL;
+ }
+ else
+ return cp;
+ }
+ }
+
+ /* If this command can have a third word, disambiguate based on it. */
+ if (cp->word[2]
+ || (cp->next
+ && cp->next->word[2]
+ && !strcmp (cp->word[1], cp->next->word[1])))
+ {
+ struct command *ocp = cp;
+
+ lex_get ();
+ assert (token == T_ID);
+
+ /* Try to find a command with this third word.
+ If found, bail. */
+ for (; cp; cp = cp->next)
+ if (cp->word[2]
+ && !strcmp (cp->word[1], ocp->word[1])
+ && lex_id_match (cp->word[2], tokid))
+ break;
+
+ if (cp != NULL)
+ return cp;
+
+ /* If no command with this third word found, make sure that
+ there's a command with those first two words but without a
+ third word. */
+ cp = ocp;
+ if (cp->word[2])
+ {
+ msg (SE, "%s %s %s %s.",
+ gettext (unk), ocp->word[0], ocp->word[1], ds_value (&tokstr));
+ return 0;
+ }
+ }
+
+ return cp;
+}
+\f
+/* Simple commands. */
+
+/* Parse and execute EXIT command. */
+int
+cmd_exit (void)
+{
+ if (getl_reading_script)
+ {
+ msg (SE, _("This command is not accepted in a syntax file. "
+ "Instead, use FINISH to terminate a syntax file."));
+ lex_get ();
+ }
+ else
+ finished = 1;
+
+ return CMD_SUCCESS;
+}
+
+/* Parse and execute FINISH command. */
+int
+cmd_finish (void)
+{
+ /* Do not check for `.'
+ Do not fetch any extra tokens. */
+ if (getl_interactive)
+ {
+ msg (SM, _("This command is not executed "
+ "in interactive mode. Instead, PSPP drops "
+ "down to the command prompt. Use EXIT if you really want "
+ "to quit."));
+ getl_close_all ();
+ }
+ else
+ finished = 1;
+
+ return CMD_SUCCESS;
+}
+
+/* Extracts a null-terminated 8-or-fewer-character PREFIX from STRING.
+ PREFIX is converted to lowercase. Removes trailing spaces from
+ STRING as a side effect. */
+static void
+extract_prefix (char *string, char *prefix)
+{
+ /* Length of STRING. */
+ int len;
+
+ /* Points to the null terminator in STRING (`end pointer'). */
+ char *ep;
+
+ /* Strip spaces from end of STRING. */
+ len = strlen (string);
+ while (len && isspace ((unsigned char) string[len - 1]))
+ string[--len] = 0;
+
+ /* Find null terminator. */
+ ep = memchr (string, '\0', 8);
+ if (!ep)
+ ep = &string[8];
+
+ /* Copy prefix, converting to lowercase. */
+ while (string < ep)
+ *prefix++ = tolower ((unsigned char) (*string++));
+ *prefix = 0;
+}
+
+/* Prints STRING on the console and to the listing file, replacing \n
+ by newline. */
+static void
+output_line (char *string)
+{
+ /* Location of \n in line read in. */
+ char *cp;
+
+ cp = strstr (string, "\\n");
+ while (cp)
+ {
+ *cp = 0;
+ tab_output_text (TAB_LEFT | TAT_NOWRAP, string);
+ string = &cp[2];
+ cp = strstr (string, "\\n");
+ }
+ tab_output_text (TAB_LEFT | TAT_NOWRAP, string);
+}
+
+/* Parse and execute REMARK command. */
+int
+cmd_remark ()
+{
+ /* Points to the line read in. */
+ char *s;
+
+ /* Index into s. */
+ char *cp;
+
+ /* 8-character sentinel used to terminate remark. */
+ char sentinel[9];
+
+ /* Beginning of line used to compare with SENTINEL. */
+ char prefix[9];
+
+ som_blank_line ();
+
+ s = lex_rest_of_line (NULL);
+ if (*s == '-')
+ {
+ output_line (&s[1]);
+ return CMD_SUCCESS;
+ }
+
+ /* Read in SENTINEL from end of current line. */
+ cp = s;
+ while (isspace ((unsigned char) *cp))
+ cp++;
+ extract_prefix (cp, sentinel);
+ if (sentinel[0] == 0)
+ {
+ msg (SE, _("The sentinel may not be the empty string."));
+ return CMD_FAILURE;
+ }
+
+ /* Read in other lines until we encounter the sentinel. */
+ while (getl_read_line ())
+ {
+ extract_prefix (ds_value (&getl_buf), prefix);
+ if (!strcmp (sentinel, prefix))
+ break;
+
+ /* Output the line. */
+ output_line (ds_value (&getl_buf));
+ }
+
+ /* Calling lex_entire_line() forces the sentinel line to be
+ discarded. */
+ getl_prompt = GETL_PRPT_STANDARD;
+ lex_entire_line ();
+
+ return CMD_SUCCESS;
+}
+
+/* Parses the N command. */
+int
+cmd_n_of_cases (void)
+{
+ /* Value for N. */
+ int x;
+
+ lex_match_id ("N");
+ lex_match_id ("OF");
+ lex_match_id ("CASES");
+ if (!lex_force_int ())
+ return CMD_FAILURE;
+ x = lex_integer ();
+ lex_get ();
+ if (!lex_match_id ("ESTIMATED"))
+ default_dict.N = x;
+
+ return lex_end_of_command ();
+}
+
+/* Parses, performs the EXECUTE procedure. */
+int
+cmd_execute (void)
+{
+ lex_match_id ("EXECUTE");
+ procedure (NULL, NULL, NULL);
+ return lex_end_of_command ();
+}
+
+/* Parses, performs the ERASE command. */
+int
+cmd_erase (void)
+{
+ if (set_safer)
+ {
+ msg (SE, _("This command not allowed when the SAFER option is set."));
+ return CMD_FAILURE;
+ }
+
+ lex_match_id ("ERASE");
+ if (!lex_force_match_id ("FILE"))
+ return CMD_FAILURE;
+ lex_match ('=');
+ if (!lex_force_string ())
+ return CMD_FAILURE;
+
+ if (remove (ds_value (&tokstr)) == -1)
+ {
+ msg (SW, _("Error removing `%s': %s."),
+ ds_value (&tokstr), strerror (errno));
+ return CMD_FAILURE;
+ }
+
+ return lex_end_of_command ();
+}
+
+#if unix
+/* Spawn a shell process. */
+static int
+shell (void)
+{
+ int pid;
+
+ pid = fork ();
+ switch (pid)
+ {
+ case 0:
+ {
+ const char *shell_fn;
+ char *shell_process;
+
+ {
+ int i;
+
+ for (i = 3; i < 20; i++)
+ close (i);
+ }
+
+ shell_fn = getenv ("SHELL");
+ if (shell_fn == NULL)
+ shell_fn = "/bin/sh";
+
+ {
+ const char *cp = strrchr (shell_fn, '/');
+ cp = cp ? &cp[1] : shell_fn;
+ shell_process = local_alloc (strlen (cp) + 8);
+ strcpy (shell_process, "-");
+ strcat (shell_process, cp);
+ if (strcmp (cp, "sh"))
+ shell_process[0] = '+';
+ }
+
+ execl (shell_fn, shell_process, NULL);
+
+ err_hcf (1);
+ }
+
+ case -1:
+ msg (SE, _("Couldn't fork: %s."), strerror (errno));
+ return 0;
+
+ default:
+ assert (pid > 0);
+ while (wait (NULL) != pid)
+ ;
+ return 1;
+ }
+}
+#endif /* unix */
+
+/* Parses the HOST command argument and executes the specified
+ command. Returns a suitable command return code. */
+static int
+run_command (void)
+{
+ char *cmd;
+ int string;
+
+ /* Handle either a string argument or a full-line argument. */
+ {
+ int c = lex_look_ahead ();
+
+ if (c == '\'' || c == '"')
+ {
+ lex_get ();
+ if (!lex_force_string ())
+ return CMD_FAILURE;
+ cmd = ds_value (&tokstr);
+ string = 1;
+ }
+ else
+ {
+ cmd = lex_rest_of_line (NULL);
+ string = 0;
+ }
+ }
+
+ /* Execute the command. */
+ if (system (cmd) == -1)
+ msg (SE, _("Error executing command: %s."), strerror (errno));
+
+ /* Finish parsing. */
+ if (string)
+ {
+ lex_get ();
+
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ return CMD_TRAILING_GARBAGE;
+ }
+ }
+ else
+ token = '.';
+
+ return CMD_SUCCESS;
+}
+
+/* Parses, performs the HOST command. */
+int
+cmd_host (void)
+{
+ int code;
+
+ if (set_safer)
+ {
+ msg (SE, _("This command not allowed when the SAFER option is set."));
+ return CMD_FAILURE;
+ }
+
+ lex_match_id ("HOST");
+
+#if unix
+ /* Figure out whether to invoke an interactive shell or to execute a
+ single shell command. */
+ if (lex_look_ahead () == '.')
+ {
+ lex_get ();
+ code = shell () ? CMD_PART_SUCCESS_MAYBE : CMD_SUCCESS;
+ }
+ else
+ code = run_command ();
+#else /* !unix */
+ /* Make sure that the system has a command interpreter, then run a
+ command. */
+ if (system (NULL) != 0)
+ success = run_command ();
+ else
+ {
+ msg (SE, _("No operating system support for this command."));
+ success = CMD_FAILURE;
+ }
+#endif /* !unix */
+
+ return code ? CMD_FAILURE : CMD_SUCCESS;
+}
+
+/* Parses, performs the NEW FILE command. */
+int
+cmd_new_file (void)
+{
+ lex_match_id ("NEW");
+ lex_match_id ("FILE");
+
+ discard_variables ();
+
+ return lex_end_of_command ();
+}
+
+/* Parses, performs the CLEAR TRANSFORMATIONS command. */
+int
+cmd_clear_transformations (void)
+{
+ lex_match_id ("CLEAR");
+ lex_match_id ("TRANSFORMATIONS");
+
+ if (getl_reading_script)
+ {
+ msg (SW, _("This command is not valid in a syntax file."));
+ return CMD_FAILURE;
+ }
+
+ cancel_transformations ();
+
+ return CMD_SUCCESS;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* State abbreviations. */
+#define INIT STATE_INIT
+#define INPU STATE_INPUT
+#define TRAN STATE_TRANS
+#define PROC STATE_PROC
+#define ERRO STATE_ERROR
+
+DEFCMD ("@", INIT, INPU, TRAN, PROC, cmd_include_at)
+UNIMPL ("ADD FILES", TRAN, ERRO, TRAN, TRAN)
+DEFCMD ("ADD VALUE LABELS", ERRO, INPU, TRAN, TRAN, cmd_add_value_labels)
+DEFCMD ("AGGREGATE", ERRO, ERRO, PROC, TRAN, cmd_aggregate)
+DEFCMD ("APPLY DICTIONARY", ERRO, ERRO, TRAN, TRAN, cmd_apply_dictionary)
+DEFCMD ("AUTORECODE", ERRO, ERRO, PROC, PROC, cmd_autorecode)
+DEFCMD ("BEGIN DATA", ERRO, ERRO, PROC, PROC, cmd_begin_data)
+DEFCMD ("BREAK", ERRO, INPU, TRAN, TRAN, cmd_break)
+DEFCMD ("CLEAR TRANSFORMATIONS", ERRO, INPU, TRAN, TRAN, cmd_clear_transformations)
+DEFCMD ("COMPUTE", ERRO, INPU, TRAN, TRAN, cmd_compute)
+DEFCMD ("CORRELATIONS", ERRO, ERRO, PROC, PROC, cmd_correlations)
+DEFCMD ("CONDESCRIPTIVES", ERRO, ERRO, PROC, PROC, cmd_descriptives)
+DEFCMD ("COUNT", ERRO, INPU, TRAN, TRAN, cmd_count)
+DEFCMD ("CROSSTABS", ERRO, ERRO, PROC, PROC, cmd_crosstabs)
+DEFCMD ("DATA LIST", TRAN, INPU, TRAN, TRAN, cmd_data_list)
+DEFCMD ("DESCRIPTIVES", ERRO, ERRO, PROC, PROC, cmd_descriptives)
+DEFCMD ("DISPLAY", ERRO, INPU, TRAN, PROC, cmd_display)
+DEFCMD ("DO IF", ERRO, INPU, TRAN, TRAN, cmd_do_if)
+DEFCMD ("DO REPEAT", ERRO, INPU, TRAN, TRAN, cmd_do_repeat)
+DEFCMD ("DOCUMENT", ERRO, INPU, TRAN, TRAN, cmd_document)
+DEFCMD ("DROP DOCUMENTS", INIT, INPU, TRAN, PROC, cmd_drop_documents)
+UNIMPL ("EDIT", INIT, INPU, TRAN, PROC)
+DEFCMD ("ELSE", ERRO, INPU, TRAN, TRAN, cmd_else)
+DEFCMD ("ELSE IF", ERRO, INPU, TRAN, TRAN, cmd_else_if)
+DEFCMD ("END CASE", ERRO, INPU, ERRO, ERRO, cmd_end_case)
+DEFCMD ("END FILE", ERRO, INPU, ERRO, ERRO, cmd_end_file)
+DEFCMD ("END FILE TYPE", ERRO, TRAN, ERRO, ERRO, cmd_end_file_type)
+DEFCMD ("END IF", ERRO, INPU, TRAN, TRAN, cmd_end_if)
+DEFCMD ("END INPUT PROGRAM", ERRO, TRAN, ERRO, ERRO, cmd_end_input_program)
+DEFCMD ("END LOOP", ERRO, INPU, TRAN, TRAN, cmd_end_loop)
+DEFCMD ("END REPEAT", ERRO, INPU, TRAN, TRAN, cmd_end_repeat)
+DEFCMD ("ERASE", INIT, INPU, TRAN, PROC, cmd_erase)
+#if GLOBAL_DEBUGGING
+DEFCMD ("EVALUATE", INIT, INPU, TRAN, PROC, cmd_evaluate)
+#endif
+DEFCMD ("EXECUTE", ERRO, ERRO, PROC, PROC, cmd_execute)
+DEFCMD ("EXIT", INIT, INPU, TRAN, PROC, cmd_exit)
+DEFCMD ("EXPORT", ERRO, ERRO, PROC, PROC, cmd_export)
+DEFCMD ("FILE HANDLE", INIT, INPU, TRAN, PROC, cmd_file_handle)
+DEFCMD ("FILE LABEL", INIT, INPU, TRAN, PROC, cmd_file_label)
+DEFCMD ("FILE TYPE", INPU, ERRO, INPU, INPU, cmd_file_type)
+DEFCMD ("FILTER", ERRO, ERRO, TRAN, TRAN, cmd_filter)
+DEFCMD ("FINISH", INIT, INPU, TRAN, PROC, cmd_finish)
+DEFCMD ("FLIP", ERRO, ERRO, PROC, PROC, cmd_flip)
+DEFCMD ("FORMATS", INIT, INPU, TRAN, PROC, cmd_formats)
+DEFCMD ("FREQUENCIES", ERRO, ERRO, PROC, PROC, cmd_frequencies)
+DEFCMD ("GET", TRAN, ERRO, TRAN, TRAN, cmd_get)
+DEFCMD ("HOST", INIT, INPU, TRAN, PROC, cmd_host)
+DEFCMD ("IF", ERRO, INPU, TRAN, TRAN, cmd_if)
+DEFCMD ("INCLUDE", INIT, INPU, TRAN, PROC, cmd_include)
+UNIMPL ("INFO", INIT, INPU, TRAN, PROC)
+DEFCMD ("IMPORT", TRAN, ERRO, TRAN, TRAN, cmd_import)
+UNIMPL ("INPUT MATRIX", INIT, INPU, TRAN, PROC)
+DEFCMD ("INPUT PROGRAM", INPU, ERRO, INPU, INPU, cmd_input_program)
+UNIMPL ("KEYED DATA LIST", INPU, ERRO, INPU, INPU)
+DEFCMD ("LEAVE", ERRO, INPU, TRAN, TRAN, cmd_leave)
+DEFCMD ("LIST", ERRO, ERRO, PROC, PROC, cmd_list)
+DEFCMD ("LOOP", ERRO, INPU, TRAN, TRAN, cmd_loop)
+DEFCMD ("MATCH FILES", TRAN, ERRO, TRAN, PROC, cmd_match_files)
+DEFCMD ("MATRIX DATA", TRAN, ERRO, TRAN, TRAN, cmd_matrix_data)
+DEFCMD ("MEANS", ERRO, ERRO, PROC, PROC, cmd_means)
+DEFCMD ("MISSING VALUES", ERRO, INPU, TRAN, TRAN, cmd_missing_values)
+DEFCMD ("MODIFY VARS", ERRO, INPU, TRAN, PROC, cmd_modify_vars)
+DEFCMD ("NEW FILE", INIT, ERRO, INIT, INIT, cmd_new_file)
+DEFCMD ("N OF CASES", INIT, INPU, TRAN, TRAN, cmd_n_of_cases)
+UNIMPL ("NUMBERED", INIT, INPU, TRAN, PROC)
+DEFCMD ("NUMERIC", ERRO, INPU, TRAN, TRAN, cmd_numeric)
+UNIMPL ("UNNUMBERED", INIT, INPU, TRAN, PROC)
+DEFCMD ("PEARSON CORRELATIONS", ERRO, ERRO, PROC, PROC, cmd_correlations)
+UNIMPL ("POINT", ERRO, INPU, ERRO, ERRO)
+UNIMPL ("PRESERVE", INIT, INPU, TRAN, PROC)
+DEFCMD ("PRINT", ERRO, INPU, TRAN, TRAN, cmd_print)
+DEFCMD ("PRINT EJECT", ERRO, INPU, TRAN, TRAN, cmd_print_eject)
+DEFCMD ("PRINT FORMATS", ERRO, INPU, TRAN, TRAN, cmd_print_formats)
+DEFCMD ("PRINT SPACE", ERRO, INPU, TRAN, TRAN, cmd_print_space)
+UNIMPL ("PROCEDURE OUTPUT", INIT, INPU, TRAN, PROC)
+DEFCMD ("PROCESS IF", ERRO, ERRO, TRAN, TRAN, cmd_process_if)
+DEFCMD ("Q", INIT, INPU, TRAN, PROC, cmd_exit)
+DEFCMD ("QUIT", INIT, INPU, TRAN, PROC, cmd_exit)
+DEFCMD ("RECODE", ERRO, INPU, TRAN, TRAN, cmd_recode)
+DEFCMD ("RECORD TYPE", ERRO, INPU, ERRO, ERRO, cmd_record_type)
+UNIMPL ("REFORMAT", ERRO, ERRO, TRAN, TRAN)
+DEFCMD ("REMARK", INIT, INPU, TRAN, PROC, cmd_remark)
+DEFCMD ("RENAME VARIABLES", ERRO, INPU, TRAN, PROC, cmd_rename_variables)
+DEFCMD ("REPEATING DATA", ERRO, INPU, ERRO, ERRO, cmd_repeating_data)
+DEFCMD ("REREAD", ERRO, INPU, ERRO, ERRO, cmd_reread)
+UNIMPL ("RESTORE", INIT, INPU, TRAN, PROC)
+DEFCMD ("SAMPLE", ERRO, ERRO, TRAN, TRAN, cmd_sample)
+DEFCMD ("SAVE", ERRO, ERRO, PROC, PROC, cmd_save)
+DEFCMD ("SELECT IF", ERRO, ERRO, TRAN, TRAN, cmd_select_if)
+DEFCMD ("SET", INIT, INPU, TRAN, PROC, cmd_set)
+UNIMPL ("SHOW", INIT, INPU, TRAN, PROC)
+DEFCMD ("SORT CASES", ERRO, ERRO, PROC, PROC, cmd_sort_cases)
+DEFCMD ("SPLIT FILE", ERRO, INPU, TRAN, TRAN, cmd_split_file)
+DEFCMD ("STRING", ERRO, INPU, TRAN, TRAN, cmd_string)
+DEFCMD ("SUBTITLE", INIT, INPU, TRAN, PROC, cmd_subtitle)
+DEFCMD ("SYSFILE INFO", INIT, INPU, TRAN, PROC, cmd_sysfile_info)
+DEFCMD ("TEMPORARY", ERRO, ERRO, TRAN, TRAN, cmd_temporary)
+DEFCMD ("TITLE", INIT, INPU, TRAN, PROC, cmd_title)
+DEFCMD ("T-TEST", ERRO, ERRO, PROC, PROC, cmd_t_test)
+UNIMPL ("UPDATE", TRAN, ERRO, TRAN, TRAN)
+DEFCMD ("VALUE LABELS", ERRO, INPU, TRAN, TRAN, cmd_value_labels)
+DEFCMD ("VARIABLE LABELS", ERRO, INPU, TRAN, TRAN, cmd_variable_labels)
+DEFCMD ("VECTOR", ERRO, INPU, TRAN, TRAN, cmd_vector)
+DEFCMD ("WEIGHT", ERRO, INPU, TRAN, TRAN, cmd_weight)
+DEFCMD ("WRITE", ERRO, INPU, TRAN, TRAN, cmd_write)
+DEFCMD ("WRITE FORMATS", ERRO, INPU, TRAN, TRAN, cmd_write_formats)
+DEFCMD ("XSAVE", ERRO, INPU, TRAN, TRAN, cmd_xsave)
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !command_h
+#define command_h 1
+
+/* Current program state. */
+enum
+ {
+ STATE_INIT, /* Initialization state. */
+ STATE_INPUT, /* Input state. */
+ STATE_TRANS, /* Transformation state. */
+ STATE_PROC, /* Procedure state. */
+ STATE_ERROR /* Invalid state transition. */
+ };
+
+/* Command return values. */
+enum
+ {
+ CMD_FAILURE = 0x1000, /* Command not executed. */
+ CMD_SUCCESS, /* Command successfully parsed and executed. */
+ CMD_PART_SUCCESS_MAYBE, /* Command may have been partially executed. */
+ CMD_PART_SUCCESS, /* Command fully executed up to error. */
+ CMD_TRAILING_GARBAGE, /* Command followed by garbage. */
+ };
+
+extern int pgm_state;
+extern const char *cur_proc;
+
+void cmd_init (void);
+int cmd_parse (void);
+
+#endif /* !command_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "approx.h"
+#include "cases.h"
+#include "command.h"
+#include "error.h"
+#include "expr.h"
+#include "lexer.h"
+#include "str.h"
+#include "var.h"
+#include "vector.h"
+
+/* I can't think of any really good reason to disable debugging for
+ this module. */
+/*#undef DEBUGGING */
+#define DEBUGGING 1
+#include "debug-print.h"
+
+/* COMPUTE and IF transformation. */
+struct compute_trns
+ {
+ struct trns_header h;
+
+ /* Destination. (Used only during parsing.) */
+ struct variable *v; /* Destvar, if dest isn't a vector elem. */
+ int created; /* Whether we created the destvar (used only during
+ parsing). */
+
+ /* Destination. (Used during execution.) */
+ struct vector *vec; /* Destination vector, if dest is a vector elem. */
+ int fv; /* `value' index of destination variable. */
+ int width; /* Target variable width (string vars only). */
+
+ /* Expressions. */
+ struct expression *vec_elem; /* Destination vector element expr. */
+ struct expression *target; /* Target expression. */
+ struct expression *test; /* Test expression (IF only). */
+ };
+
+static int parse_target_expression (struct compute_trns *,
+ int (*func_tab[4]) (struct trns_header *, struct ccase *));
+static struct compute_trns *new_trns (void);
+static void delete_trns (struct compute_trns *);
+static void free_trns (struct trns_header *);
+static int parse_var_or_vec (struct compute_trns *);
+\f
+/* COMPUTE. */
+
+static int compute_num (struct trns_header *, struct ccase *);
+static int compute_str (struct trns_header *, struct ccase *);
+static int compute_num_vec (struct trns_header *, struct ccase *);
+static int compute_str_vec (struct trns_header *, struct ccase *);
+
+int
+cmd_compute (void)
+{
+ /* Table of functions to process data. */
+ static int (*func_tab[4]) (struct trns_header *, struct ccase *) =
+ {
+ compute_num,
+ compute_str,
+ compute_num_vec,
+ compute_str_vec,
+ };
+
+ /* Transformation being constructed. */
+ struct compute_trns *c;
+
+ lex_match_id ("COMPUTE");
+
+ c = new_trns ();
+ if (!parse_var_or_vec (c))
+ goto fail;
+
+ if (!lex_force_match ('=')
+ || !parse_target_expression (c, func_tab))
+ goto fail;
+
+ /* Goofy behavior, but compatible: Turn off LEAVE on the destvar. */
+ if (c->v && c->v->left && c->v->name[0] != '#')
+ {
+ devector (c->v);
+ c->v->left = 0;
+ envector (c->v);
+ }
+
+ add_transformation ((struct trns_header *) c);
+
+ return CMD_SUCCESS;
+
+fail:
+ delete_trns (c);
+ return CMD_FAILURE;
+}
+
+static int
+compute_num (struct trns_header * pt, struct ccase * c)
+{
+ struct compute_trns *t = (struct compute_trns *) pt;
+ expr_evaluate (t->target, c, &c->data[t->fv]);
+ return -1;
+}
+
+static int
+compute_num_vec (struct trns_header * pt, struct ccase * c)
+{
+ struct compute_trns *t = (struct compute_trns *) pt;
+
+ /* Index into the vector. */
+ union value index;
+
+ /* Rounded index value. */
+ int rindx;
+
+ expr_evaluate (t->vec_elem, c, &index);
+ rindx = floor (index.f + EPSILON);
+ if (index.f == SYSMIS || rindx < 1 || rindx > t->vec->nv)
+ {
+ if (index.f == SYSMIS)
+ msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
+ "an index into vector %s."), t->vec->name);
+ else
+ msg (SW, _("When executing COMPUTE: %g is not a valid value as "
+ "an index into vector %s."), index.f, t->vec->name);
+ return -1;
+ }
+ expr_evaluate (t->target, c, &c->data[t->vec->v[rindx - 1]->fv]);
+ return -1;
+}
+
+static int
+compute_str (struct trns_header * pt, struct ccase * c)
+{
+ struct compute_trns *t = (struct compute_trns *) pt;
+
+ /* Temporary storage for string expression return value. */
+ union value v;
+
+ expr_evaluate (t->target, c, &v);
+ st_bare_pad_len_copy (c->data[t->fv].s, &v.c[1], t->width, v.c[0]);
+ return -1;
+}
+
+static int
+compute_str_vec (struct trns_header * pt, struct ccase * c)
+{
+ struct compute_trns *t = (struct compute_trns *) pt;
+
+ /* Temporary storage for string expression return value. */
+ union value v;
+
+ /* Index into the vector. */
+ union value index;
+
+ /* Rounded index value. */
+ int rindx;
+
+ /* Variable reference by indexed vector. */
+ struct variable *vr;
+
+ expr_evaluate (t->vec_elem, c, &index);
+ rindx = floor (index.f + EPSILON);
+ if (index.f == SYSMIS || rindx < 1 || rindx > t->vec->nv)
+ {
+ if (index.f == SYSMIS)
+ msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
+ "an index into vector %s."), t->vec->name);
+ else
+ msg (SW, _("When executing COMPUTE: %g is not a valid value as "
+ "an index into vector %s."), index.f, t->vec->name);
+ return -1;
+ }
+
+ expr_evaluate (t->target, c, &v);
+ vr = t->vec->v[rindx - 1];
+ st_bare_pad_len_copy (c->data[vr->fv].s, &v.c[1], vr->width, v.c[0]);
+ return -1;
+}
+\f
+/* IF. */
+
+static int if_num (struct trns_header *, struct ccase *);
+static int if_str (struct trns_header *, struct ccase *);
+static int if_num_vec (struct trns_header *, struct ccase *);
+static int if_str_vec (struct trns_header *, struct ccase *);
+
+int
+cmd_if (void)
+{
+ /* Table of functions to process data. */
+ static int (*func_tab[4]) (struct trns_header *, struct ccase *) =
+ {
+ if_num,
+ if_str,
+ if_num_vec,
+ if_str_vec,
+ };
+
+ /* Transformation being constructed. */
+ struct compute_trns *c;
+
+ lex_match_id ("IF");
+ c = new_trns ();
+
+ /* Test expression. */
+ c->test = expr_parse (PXP_BOOLEAN);
+ if (!c->test)
+ goto fail;
+
+ /* Target variable. */
+ if (!parse_var_or_vec (c))
+ goto fail;
+
+ /* Target expression. */
+
+ if (!lex_force_match ('=')
+ || !parse_target_expression (c, func_tab))
+ goto fail;
+
+ add_transformation ((struct trns_header *) c);
+
+ return CMD_SUCCESS;
+
+fail:
+ delete_trns (c);
+ return CMD_FAILURE;
+}
+
+static int
+if_num (struct trns_header * pt, struct ccase * c)
+{
+ struct compute_trns *t = (struct compute_trns *) pt;
+
+ if (expr_evaluate (t->test, c, NULL) == 1.0)
+ expr_evaluate (t->target, c, &c->data[t->fv]);
+ return -1;
+}
+
+static int
+if_str (struct trns_header * pt, struct ccase * c)
+{
+ struct compute_trns *t = (struct compute_trns *) pt;
+
+ if (expr_evaluate (t->test, c, NULL) == 1.0)
+ {
+ union value v;
+
+ expr_evaluate (t->target, c, &v);
+ st_bare_pad_len_copy (c->data[t->fv].s, &v.c[1], t->width, v.c[0]);
+ }
+ return -1;
+}
+
+static int
+if_num_vec (struct trns_header * pt, struct ccase * c)
+{
+ struct compute_trns *t = (struct compute_trns *) pt;
+
+ if (expr_evaluate (t->test, c, NULL) == 1.0)
+ {
+ /* Index into the vector. */
+ union value index;
+
+ /* Rounded index value. */
+ int rindx;
+
+ expr_evaluate (t->vec_elem, c, &index);
+ rindx = floor (index.f + EPSILON);
+ if (index.f == SYSMIS || rindx < 1 || rindx > t->vec->nv)
+ {
+ if (index.f == SYSMIS)
+ msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
+ "an index into vector %s."), t->vec->name);
+ else
+ msg (SW, _("When executing COMPUTE: %g is not a valid value as "
+ "an index into vector %s."), index.f, t->vec->name);
+ return -1;
+ }
+ expr_evaluate (t->target, c,
+ &c->data[t->vec->v[rindx]->fv]);
+ }
+ return -1;
+}
+
+static int
+if_str_vec (struct trns_header * pt, struct ccase * c)
+{
+ struct compute_trns *t = (struct compute_trns *) pt;
+
+ if (expr_evaluate (t->test, c, NULL) == 1.0)
+ {
+ /* Index into the vector. */
+ union value index;
+
+ /* Rounded index value. */
+ int rindx;
+
+ /* Temporary storage for result of target expression. */
+ union value v2;
+
+ /* Variable reference by indexed vector. */
+ struct variable *vr;
+
+ expr_evaluate (t->vec_elem, c, &index);
+ rindx = floor (index.f + EPSILON);
+ if (index.f == SYSMIS || rindx < 1 || rindx > t->vec->nv)
+ {
+ if (index.f == SYSMIS)
+ msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
+ "an index into vector %s."), t->vec->name);
+ else
+ msg (SW, _("When executing COMPUTE: %g is not a valid value as "
+ "an index into vector %s."), index.f, t->vec->name);
+ return -1;
+ }
+ expr_evaluate (t->target, c, &v2);
+ vr = t->vec->v[rindx - 1];
+ st_bare_pad_len_copy (c->data[vr->fv].s, &v2.c[1], vr->width, v2.c[0]);
+ }
+ return -1;
+}
+\f
+/* Code common to COMPUTE and IF. */
+
+/* Checks for type mismatches on transformation C. Also checks for
+ command terminator, sets the case-handling proc from the array
+ passed. */
+static int
+parse_target_expression (struct compute_trns *c,
+ int (*proc_list[4]) (struct trns_header *, struct ccase *))
+{
+ int dest_type = c->v ? c->v->type : c->vec->v[0]->type;
+ c->target = expr_parse (dest_type == ALPHA ? PXP_STRING : PXP_NUMERIC);
+ if (!c->target)
+ return 0;
+
+ c->h.proc = proc_list[(dest_type == ALPHA) + 2 * (c->vec != NULL)];
+
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Returns a new struct compute_trns after initializing its fields. */
+static struct compute_trns *
+new_trns (void)
+{
+ struct compute_trns *c = xmalloc (sizeof *c);
+ c->h.proc = NULL;
+ c->h.free = free_trns;
+ c->v = NULL;
+ c->created = 0;
+ c->vec = NULL;
+ c->fv = 0;
+ c->width = 0;
+ c->vec_elem = NULL;
+ c->target = NULL;
+ c->test = NULL;
+ return c;
+}
+
+/* Deletes all the fields in C, the variable C->v if we created it,
+ and C itself. */
+static void
+delete_trns (struct compute_trns * c)
+{
+ free_trns ((struct trns_header *) c);
+ if (c->created)
+ delete_variable (&default_dict, c->v);
+ free (c);
+}
+
+/* Deletes all the fields in C. */
+static void
+free_trns (struct trns_header * pt)
+{
+ struct compute_trns *t = (struct compute_trns *) pt;
+
+ expr_free (t->vec_elem);
+ expr_free (t->target);
+ expr_free (t->test);
+}
+
+/* Parses a variable name or a vector element into C. If the
+ variable does not exist, it is created. Returns success. */
+static int
+parse_var_or_vec (struct compute_trns * c)
+{
+ if (!lex_force_id ())
+ return 0;
+
+ if (lex_look_ahead () == '(')
+ {
+ /* Vector element. */
+ c->vec = find_vector (tokid);
+ if (!c->vec)
+ {
+ msg (SE, _("There is no vector named %s."), tokid);
+ return 0;
+ }
+
+ lex_get ();
+ if (!lex_force_match ('('))
+ return 0;
+ c->vec_elem = expr_parse (PXP_NUMERIC);
+ if (!c->vec_elem)
+ return 0;
+ if (!lex_force_match (')'))
+ {
+ expr_free (c->vec_elem);
+ return 0;
+ }
+ }
+ else
+ {
+ /* Variable name. */
+ c->v = find_variable (tokid);
+ if (!c->v)
+ {
+ c->v = force_create_variable (&default_dict, tokid, NUMERIC, 0);
+ envector (c->v);
+ c->created = 1;
+ }
+ c->fv = c->v->fv;
+ c->width = c->v->width;
+ lex_get ();
+ }
+ return 1;
+}
+\f
+/* EVALUATE. */
+
+#if GLOBAL_DEBUGGING
+int
+cmd_evaluate (void)
+{
+ struct expression *expr;
+
+ lex_match_id ("EVALUATE");
+ expr = expr_parse (PXP_DUMP);
+ if (!expr)
+ return CMD_FAILURE;
+
+ expr_free (expr);
+ if (token != '.')
+ {
+ msg (SE, _("Extra characters after expression."));
+ return CMD_FAILURE;
+ }
+
+ return CMD_SUCCESS;
+}
+#endif
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "file-handle.h"
+#include "command.h"
+#include "lexer.h"
+#include "var.h"
+/* (headers) */
+
+#undef DEBUGGING
+#define DEBUGGING 1
+#include "debug-print.h"
+
+struct cor_set
+ {
+ struct cor_set *next;
+ struct variable **v1, **v2;
+ int nv1, nv2;
+ };
+
+struct cor_set *cor_list, *cor_last;
+
+struct file_handle *matrix_file;
+
+static void free_correlations_state (void);
+static int internal_cmd_correlations (void);
+
+int
+cmd_correlations (void)
+{
+ int result = internal_cmd_correlations ();
+ free_correlations_state ();
+ return result;
+}
+
+/* (specification)
+ "CORRELATIONS" (cor_):
+ *variables=custom;
+ +missing=miss:!pairwise/listwise,
+ inc:include/exclude;
+ +print=tail:!twotail/onetail,
+ sig:!sig/nosig;
+ +format=fmt:!matrix/serial;
+ +matrix=custom;
+ +statistics[st_]=descriptives,xprod,all.
+*/
+/* (declarations) */
+/* (functions) */
+
+int
+internal_cmd_correlations (void)
+{
+ struct cmd_correlations cmd;
+
+ cor_list = cor_last = NULL;
+ matrix_file = NULL;
+
+ lex_match_id ("PEARSON");
+ lex_match_id ("CORRELATIONS");
+
+ if (!parse_correlations (&cmd))
+ return CMD_FAILURE;
+ free_correlations (&cmd);
+
+ return CMD_SUCCESS;
+}
+
+static int
+cor_custom_variables (struct cmd_correlations *cmd unused)
+{
+ struct variable **v1, **v2;
+ int nv1, nv2;
+ struct cor_set *cor;
+
+ /* Ensure that this is a VARIABLES subcommand. */
+ if (!lex_match_id ("VARIABLES") && (token != T_ID || !is_varname (tokid))
+ && token != T_ALL)
+ return 2;
+ lex_match ('=');
+
+ if (!parse_variables (&default_dict, &v1, &nv1,
+ PV_NO_DUPLICATE | PV_NUMERIC))
+ return 0;
+
+ if (lex_match (T_WITH))
+ {
+ if (!parse_variables (&default_dict, &v2, &nv2,
+ PV_NO_DUPLICATE | PV_NUMERIC))
+ {
+ free (v1);
+ return 0;
+ }
+ }
+ else
+ {
+ nv2 = nv1;
+ v2 = v1;
+ }
+
+ cor = xmalloc (sizeof *cor);
+ cor->next = NULL;
+ cor->v1 = v1;
+ cor->v2 = v2;
+ cor->nv1 = nv1;
+ cor->nv2 = nv2;
+ if (cor_list)
+ cor_last = cor_last->next = cor;
+ else
+ cor_list = cor_last = cor;
+
+ return 1;
+}
+
+static int
+cor_custom_matrix (struct cmd_correlations *cmd unused)
+{
+ if (!lex_force_match ('('))
+ return 0;
+
+ if (lex_match ('*'))
+ matrix_file = inline_file;
+ else
+ matrix_file = fh_parse_file_handle ();
+
+ if (!matrix_file)
+ return 0;
+
+ if (!lex_force_match (')'))
+ return 0;
+
+ return 1;
+}
+
+static void
+free_correlations_state (void)
+{
+ struct cor_set *cor, *next;
+
+ for (cor = cor_list; cor != NULL; cor = next)
+ {
+ next = cor->next;
+ if (cor->v1 != cor->v2)
+ free (cor->v2);
+ free (cor->v1);
+ free (cor);
+ }
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "approx.h"
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "str.h"
+#include "var.h"
+
+/* Implementation details:
+
+ The S?SS manuals do not specify the order that COUNT subcommands are
+ performed in. Experiments, however, have shown that they are performed
+ in the order that they are specified in, rather than simultaneously.
+ So, with the two variables A and B, and the two cases,
+
+ A B
+ 1 2
+ 2 1
+
+ the command COUNT A=A B (1) / B=A B (2) will produce the following
+ results,
+
+ A B
+ 1 1
+ 1 0
+
+ rather than the results that would be produced if subcommands were
+ simultaneous:
+
+ A B
+ 1 1
+ 1 1
+
+ Perhaps simultaneity could be implemented as an option. On the
+ other hand, what good are the above commands? */
+
+#undef DEBUGGING
+#define DEBUGGING 1
+#include "debug-print.h"
+\f
+/* Definitions. */
+
+enum
+ {
+ CNT_ERROR, /* Invalid value. */
+ CNT_SINGLE, /* Single value. */
+ CNT_HIGH, /* x >= a. */
+ CNT_LOW, /* x <= a. */
+ CNT_RANGE, /* a <= x <= b. */
+ CNT_ANY, /* Count any. */
+ CNT_SENTINEL /* List terminator. */
+ };
+
+struct cnt_num
+ {
+ int type;
+ double a, b;
+ };
+
+struct cnt_str
+ {
+ int type;
+ char *s;
+ };
+
+struct counting
+ {
+ struct counting *next;
+
+ /* variables to count */
+ struct variable **v;
+ int n;
+
+ /* values to count */
+ int missing; /* (numeric only)
+ 0=don't count missing,
+ 1=count SYSMIS,
+ 2=count system- and user-missing */
+ union /* Criterion values. */
+ {
+ struct cnt_num *n;
+ struct cnt_str *s;
+ }
+ crit;
+ };
+
+struct cnt_var_info
+ {
+ struct cnt_var_info *next;
+
+ struct variable *d; /* Destination variable. */
+ char n[9]; /* Name of dest var. */
+
+ struct counting *c; /* The counting specifications. */
+ };
+
+struct count_trns
+ {
+ struct trns_header h;
+ struct cnt_var_info *specs;
+ };
+
+#if DEBUGGING
+static void debug_print (void);
+#endif
+
+/* First counting in chain. */
+static struct cnt_var_info *head;
+\f
+/* Parser. */
+
+static int count_trns_proc (struct trns_header *, struct ccase *);
+static void count_trns_free (struct trns_header *);
+
+static int parse_numeric_criteria (struct counting *);
+static int parse_string_criteria (struct counting *);
+
+int cmd_count (void);
+
+int
+internal_cmd_count (void)
+{
+ int code = cmd_count ();
+ if (!code)
+ {
+ struct count_trns c;
+ c.specs = head;
+ count_trns_free ((struct trns_header *) & c);
+ }
+ return code;
+}
+
+int
+cmd_count (void)
+{
+ /* Specification currently being parsed. */
+ struct cnt_var_info *cnt;
+
+ /* Counting currently being parsed. */
+ struct counting *c;
+
+ /* Return value from parsing function. */
+ int ret;
+
+ /* Transformation. */
+ struct count_trns *trns;
+
+ lex_match_id ("COUNT");
+
+ /* Parses each slash-delimited specification. */
+ head = cnt = xmalloc (sizeof *cnt);
+ for (;;)
+ {
+ /* Initialize this struct cnt_var_info to ensure proper cleanup. */
+ cnt->next = NULL;
+ cnt->d = NULL;
+ cnt->c = NULL;
+
+ /* Get destination struct variable, or at least its name. */
+ if (!lex_force_id ())
+ goto fail;
+ cnt->d = find_variable (tokid);
+ if (cnt->d)
+ {
+ if (cnt->d->type == ALPHA)
+ {
+ msg (SE, _("Destination cannot be a string variable."));
+ goto fail;
+ }
+ }
+ else
+ strcpy (cnt->n, tokid);
+
+ lex_get ();
+ if (!lex_force_match ('='))
+ goto fail;
+
+ c = cnt->c = xmalloc (sizeof *c);
+ for (;;)
+ {
+ c->next = NULL;
+ c->v = NULL;
+ if (!parse_variables (NULL, &c->v, &c->n, PV_DUPLICATE | PV_SAME_TYPE))
+ goto fail;
+
+ if (!lex_force_match ('('))
+ goto fail;
+
+ ret = (c->v[0]->type == NUMERIC
+ ? parse_numeric_criteria
+ : parse_string_criteria) (c);
+ if (!ret)
+ goto fail;
+
+ if (token == '/' || token == '.')
+ break;
+
+ c = c->next = xmalloc (sizeof *c);
+ }
+
+ if (token == '.')
+ break;
+
+ if (!lex_force_match ('/'))
+ goto fail;
+ cnt = cnt->next = xmalloc (sizeof *cnt);
+ }
+
+ /* Create all the nonexistent destination variables. */
+ for (cnt = head; cnt; cnt = cnt->next)
+ if (!cnt->d)
+ {
+ /* It's legal, though motivationally questionable, to count to
+ the same dest var more than once. */
+ cnt->d = find_variable (cnt->n);
+
+ if (!cnt->d)
+ cnt->d = force_create_variable (&default_dict, cnt->n, NUMERIC, 0);
+ }
+
+#if DEBUGGING
+ debug_print ();
+#endif
+
+ trns = xmalloc (sizeof *trns);
+ trns->h.proc = count_trns_proc;
+ trns->h.free = count_trns_free;
+ trns->specs = head;
+ add_transformation ((struct trns_header *) trns);
+
+ return CMD_SUCCESS;
+
+fail:
+ {
+ struct count_trns t;
+ t.specs = head;
+ count_trns_free ((struct trns_header *) & t);
+ return CMD_FAILURE;
+ }
+}
+
+/* Parses a set of numeric criterion values. */
+static int
+parse_numeric_criteria (struct counting * c)
+{
+ int n = 0;
+ int m = 0;
+
+ c->crit.n = 0;
+ c->missing = 0;
+ for (;;)
+ {
+ struct cnt_num *cur;
+ if (n >= m - 1)
+ {
+ m += 16;
+ c->crit.n = xrealloc (c->crit.n, m * sizeof (struct cnt_num));
+ }
+
+ cur = &c->crit.n[n++];
+ if (token == T_NUM)
+ {
+ cur->a = tokval;
+ lex_get ();
+ if (lex_match_id ("THRU"))
+ {
+ if (token == T_NUM)
+ {
+ if (!lex_force_num ())
+ return 0;
+ cur->b = tokval;
+ cur->type = CNT_RANGE;
+ lex_get ();
+
+ if (cur->a > cur->b)
+ {
+ msg (SE, _("%g THRU %g is not a valid range. The "
+ "number following THRU must be at least "
+ "as big as the number preceding THRU."),
+ cur->a, cur->b);
+ return 0;
+ }
+ }
+ else if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
+ cur->type = CNT_HIGH;
+ else
+ {
+ lex_error (NULL);
+ return 0;
+ }
+ }
+ else
+ cur->type = CNT_SINGLE;
+ }
+ else if (lex_match_id ("LO") || lex_match_id ("LOWEST"))
+ {
+ if (!lex_force_match_id ("THRU"))
+ return 0;
+ if (token == T_NUM)
+ {
+ cur->type = CNT_LOW;
+ cur->a = tokval;
+ lex_get ();
+ }
+ else if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
+ cur->type = CNT_ANY;
+ else
+ {
+ lex_error (NULL);
+ return 0;
+ }
+ }
+ else if (lex_match_id ("SYSMIS"))
+ {
+ if (c->missing < 1)
+ c->missing = 1;
+ }
+ else if (lex_match_id ("MISSING"))
+ c->missing = 2;
+ else
+ {
+ lex_error (NULL);
+ return 0;
+ }
+
+ lex_match (',');
+ if (lex_match (')'))
+ break;
+ }
+
+ c->crit.n[n].type = CNT_SENTINEL;
+ return 1;
+}
+
+/* Parses a set of string criteria values. The skeleton is the same
+ as parse_numeric_criteria(). */
+static int
+parse_string_criteria (struct counting * c)
+{
+ int len = 0;
+
+ int n = 0;
+ int m = 0;
+
+ int i;
+
+ for (i = 0; i < c->n; i++)
+ if (c->v[i]->width > len)
+ len = c->v[i]->width;
+
+ c->crit.n = 0;
+ for (;;)
+ {
+ struct cnt_str *cur;
+ if (n >= m - 1)
+ {
+ m += 16;
+ c->crit.n = xrealloc (c->crit.n, m * sizeof (struct cnt_str));
+ }
+
+ if (!lex_force_string ())
+ return 0;
+ cur = &c->crit.s[n++];
+ cur->type = CNT_SINGLE;
+ cur->s = malloc (len + 1);
+ st_pad_copy (cur->s, ds_value (&tokstr), len + 1);
+ lex_get ();
+
+ lex_match (',');
+ if (lex_match (')'))
+ break;
+ }
+
+ c->crit.s[n].type = CNT_SENTINEL;
+ return 1;
+}
+\f
+/* Transformation. */
+
+/* Counts the number of values in case C matching counting CNT. */
+static inline int
+count_numeric (struct counting * cnt, struct ccase * c)
+{
+ int counter = 0;
+
+ struct cnt_num *num;
+
+ double cmp;
+ int i;
+
+ for (i = 0; i < cnt->n; i++)
+ {
+ /* Extract the variable value and eliminate missing values. */
+ cmp = c->data[cnt->v[i]->fv].f;
+ if (cmp == SYSMIS)
+ {
+ if (cnt->missing >= 1)
+ counter++;
+ continue;
+ }
+ if (cnt->missing >= 2 && is_num_user_missing (cmp, cnt->v[i]))
+ {
+ counter++;
+ continue;
+ }
+
+ /* Try to find the value in the list. */
+ for (num = cnt->crit.n;; num++)
+ switch (num->type)
+ {
+ case CNT_ERROR:
+ assert (0);
+ break;
+ case CNT_SINGLE:
+ if (approx_ne (cmp, num->a))
+ break;
+ counter++;
+ goto done;
+ case CNT_HIGH:
+ if (approx_lt (cmp, num->a))
+ break;
+ counter++;
+ goto done;
+ case CNT_LOW:
+ if (approx_gt (cmp, num->a))
+ break;
+ counter++;
+ goto done;
+ case CNT_RANGE:
+ if (approx_lt (cmp, num->a) || approx_gt (cmp, num->b))
+ break;
+ counter++;
+ goto done;
+ case CNT_ANY:
+ counter++;
+ goto done;
+ case CNT_SENTINEL:
+ goto done;
+ default:
+ assert (0);
+ }
+ done: ;
+ }
+ return counter;
+}
+
+/* Counts the number of values in case C matching counting CNT. */
+static inline int
+count_string (struct counting * cnt, struct ccase * c)
+{
+ int counter = 0;
+
+ struct cnt_str *str;
+
+ char *cmp;
+ int len;
+
+ int i;
+
+ for (i = 0; i < cnt->n; i++)
+ {
+ /* Extract the variable value, variable width. */
+ cmp = c->data[cnt->v[i]->fv].s;
+ len = cnt->v[i]->width;
+
+ for (str = cnt->crit.s;; str++)
+ switch (str->type)
+ {
+ case CNT_ERROR:
+ assert (0);
+ case CNT_SINGLE:
+ if (memcmp (cmp, str->s, len))
+ break;
+ counter++;
+ goto done;
+ case CNT_SENTINEL:
+ goto done;
+ default:
+ assert (0);
+ }
+ done: ;
+ }
+ return counter;
+}
+
+/* Performs the COUNT transformation T on case C. */
+static int
+count_trns_proc (struct trns_header * trns, struct ccase * c)
+{
+ struct cnt_var_info *info;
+ struct counting *cnt;
+ int counter;
+
+ for (info = ((struct count_trns *) trns)->specs; info; info = info->next)
+ {
+ counter = 0;
+ for (cnt = info->c; cnt; cnt = cnt->next)
+ if (cnt->v[0]->type == NUMERIC)
+ counter += count_numeric (cnt, c);
+ else
+ counter += count_string (cnt, c);
+ c->data[info->d->fv].f = counter;
+ }
+ return -1;
+}
+
+/* Destroys all dynamic data structures associated with T. */
+static void
+count_trns_free (struct trns_header * t)
+{
+ struct cnt_var_info *iter, *next;
+
+ for (iter = ((struct count_trns *) t)->specs; iter; iter = next)
+ {
+ struct counting *i, *n;
+
+ for (i = iter->c; i; i = n)
+ {
+ if (i->n && i->v)
+ {
+ if (i->v[0]->type == NUMERIC)
+ free (i->crit.n);
+ else
+ {
+ struct cnt_str *s;
+
+ for (s = i->crit.s; s->type != CNT_SENTINEL; s++)
+ free (s->s);
+ free (i->crit.s);
+ }
+ }
+ free (i->v);
+
+ n = i->next;
+ free (i);
+ }
+
+ next = iter->next;
+ free (iter);
+ }
+}
+\f
+/* Debugging. */
+
+#if DEBUGGING
+static void
+debug_print (void)
+{
+ struct cnt_var_info *iter;
+ struct counting *i;
+ int j;
+
+ printf ("COUNT\n");
+ for (iter = head; iter; iter = iter->next)
+ {
+ printf (" %s=", iter->d->name);
+ for (i = iter->c; i; i = i->next)
+ {
+ for (j = 0; j < i->n; j++)
+ printf ("%s%s", j ? " " : "", i->v[j]->name);
+ printf (" (");
+ if (i->v[0]->type == NUMERIC)
+ {
+ struct cnt_num *n;
+
+ if (i->missing == 2)
+ printf ("MISSING");
+ else if (i->missing == 1)
+ printf ("SYSMIS");
+ else
+ assert (i->missing == 0);
+
+ for (n = i->crit.n; n->type != CNT_SENTINEL; n++)
+ {
+ if (i->missing && n != i->crit.n)
+ printf (",");
+ switch (n->type)
+ {
+ case CNT_SINGLE:
+ printf ("%g", n->a);
+ break;
+ case CNT_HIGH:
+ printf ("%g THRU HIGH", n->a);
+ break;
+ case CNT_LOW:
+ printf ("LOW THRU %g", n->a);
+ break;
+ case CNT_RANGE:
+ printf ("%g THRU %g", n->a, n->b);
+ break;
+ case CNT_ANY:
+ printf ("LOW THRU HIGH");
+ break;
+ default:
+ printf ("<ERROR %d>", n->type);
+ break;
+ }
+ }
+ }
+ else
+ {
+ struct cnt_str *s;
+
+ for (s = i->crit.s; s->type != CNT_SENTINEL; s++)
+ {
+ if (s != i->crit.s)
+ printf (",");
+ if (s->type == CNT_SINGLE)
+ printf ("'%s'", s->s);
+ else
+ printf ("<ERROR %d>", s->type);
+ }
+ }
+ printf (") ");
+ }
+ printf ("\n");
+ }
+}
+#endif /* DEBUGGING */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* FIXME:
+
+ - Pearson's R (but not Spearman!) is off a little.
+ - T values for Spearman's R and Pearson's R are wrong.
+ - How to calculate significance of symmetric and directional measures?
+ - Asymmetric ASEs and T values for lambda are wrong.
+ - ASE of Goodman and Kruskal's tau is not calculated.
+ - ASE of symmetric somers' d is wrong.
+ - Approx. T of uncertainty coefficient is wrong.
+
+*/
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <ctype.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include "alloc.h"
+#include "avl.h"
+#include "hash.h"
+#include "pool.h"
+#include "dcdflib/cdflib.h"
+#include "command.h"
+#include "lexer.h"
+#include "error.h"
+#include "magic.h"
+#include "misc.h"
+#include "stats.h"
+#include "output.h"
+#include "tab.h"
+#include "var.h"
+#include "vfm.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* (specification)
+ crosstabs (crs_):
+ *tables=custom;
+ +variables=custom;
+ +missing=miss:!table/include/report;
+ +write[wr_]=none,cells,all;
+ +format=fmt:!labels/nolabels/novallabs,
+ val:!avalue/dvalue,
+ indx:!noindex/index,
+ tabl:!tables/notables,
+ box:!box/nobox,
+ pivot:!pivot/nopivot;
+ +cells[cl_]=count,none,row,column,total,expected,residual,sresidual,
+ asresidual,all;
+ +statistics[st_]=chisq,phi,cc,lambda,uc,none,btau,ctau,risk,gamma,d,
+ kappa,eta,corr,all.
+*/
+/* (declarations) */
+/* (functions) */
+
+/* Number of chi-square statistics. */
+#define N_CHISQ 5
+
+/* Number of symmetric statistics. */
+#define N_SYMMETRIC 9
+
+/* Number of directional statistics. */
+#define N_DIRECTIONAL 13
+
+/* A single table entry for general mode. */
+struct table_entry
+ {
+ int table; /* Flattened table number. */
+ union
+ {
+ double freq; /* Frequency count. */
+ double *data; /* Crosstabulation table for integer mode. */
+ }
+ u;
+ union value v[1]; /* Values. */
+ };
+
+/* A crosstabulation. */
+struct crosstab
+ {
+ int nvar; /* Number of variables. */
+ double missing; /* Missing cases count. */
+ int ofs; /* Integer mode: Offset into sorted_tab[]. */
+ struct variable *v[2]; /* At least two variables; sorted by
+ larger indices first. */
+ };
+
+/* Indexes into crosstab.v. */
+enum
+ {
+ ROW_VAR = 0,
+ COL_VAR = 1
+ };
+
+/* General mode crosstabulation table. */
+static struct hsh_table *gen_tab; /* Hash table. */
+static int n_sorted_tab; /* Number of entries in sorted_tab. */
+static struct table_entry **sorted_tab; /* Sorted table. */
+
+/* VARIABLES dictionary. */
+static struct dictionary *var_dict;
+
+/* TABLES. */
+static struct crosstab **xtab;
+static int nxtab;
+
+/* Integer or general mode? */
+enum
+ {
+ INTEGER,
+ GENERAL
+ };
+static int mode;
+
+/* CELLS. */
+static int num_cells; /* Number of cells requested. */
+static int cells[8]; /* Cells requested. */
+static int expected; /* Nonzero if expected value is needed. */
+
+/* WRITE. */
+static int write; /* One of WR_* that specifies the WRITE style. */
+
+/* Command parsing info. */
+static struct cmd_crosstabs cmd;
+
+/* Pools. */
+static struct pool *pl_tc; /* For table cells. */
+static struct pool *pl_col; /* For column data. */
+
+static int internal_cmd_crosstabs (void);
+static void free_var_dict (void);
+static void precalc (void);
+static int calc_general (struct ccase *);
+static int calc_integer (struct ccase *);
+static void postcalc (void);
+static void submit (struct tab_table *);
+
+#if DEBUGGING
+static void debug_print (void);
+static void print_table_entries (struct table_entry **tab);
+#endif
+
+/* Parse and execute CROSSTABS, then clean up. */
+int
+cmd_crosstabs (void)
+{
+ int result = internal_cmd_crosstabs ();
+
+ free_var_dict ();
+ pool_destroy (pl_tc);
+ pool_destroy (pl_col);
+
+ return result;
+}
+
+/* Parses and executes the CROSSTABS procedure. */
+static int
+internal_cmd_crosstabs (void)
+{
+ var_dict = NULL;
+ xtab = NULL;
+ nxtab = 0;
+ pl_tc = pool_create ();
+ pl_col = pool_create ();
+
+ lex_match_id ("CROSSTABS");
+ if (!parse_crosstabs (&cmd))
+ return CMD_FAILURE;
+
+#if DEBUGGING
+ /* Needs var_dict. */
+ debug_print ();
+#endif
+
+ mode = var_dict ? INTEGER : GENERAL;
+ free_var_dict();
+
+ /* CELLS. */
+ expected = 0;
+ if (!cmd.sbc_cells)
+ {
+ cmd.a_cells[CRS_CL_COUNT] = 1;
+ num_cells = 1;
+ }
+ else
+ {
+ int i;
+ int count = 0;
+
+ for (i = 0; i < CRS_CL_count; i++)
+ if (cmd.a_cells[i])
+ count++;
+ if (count == 0)
+ {
+ cmd.a_cells[CRS_CL_COUNT] = 1;
+ cmd.a_cells[CRS_CL_ROW] = 1;
+ cmd.a_cells[CRS_CL_COLUMN] = 1;
+ cmd.a_cells[CRS_CL_TOTAL] = 1;
+ }
+ if (cmd.a_cells[CRS_CL_ALL])
+ {
+ for (i = 0; i < CRS_CL_count; i++)
+ cmd.a_cells[i] = 1;
+ cmd.a_cells[CRS_CL_ALL] = 0;
+ }
+ cmd.a_cells[CRS_CL_NONE] = 0;
+ for (num_cells = i = 0; i < CRS_CL_count; i++)
+ if (cmd.a_cells[i])
+ {
+ if (i >= CRS_CL_EXPECTED)
+ expected = 1;
+ cmd.a_cells[num_cells++] = i;
+ }
+ }
+
+ /* STATISTICS. */
+ if (cmd.sbc_statistics)
+ {
+ int i;
+ int count = 0;
+
+ for (i = 0; i < CRS_ST_count; i++)
+ if (cmd.a_statistics[i])
+ count++;
+ if (count == 0)
+ cmd.a_statistics[CRS_ST_CHISQ] = 1;
+ if (cmd.a_statistics[CRS_ST_ALL])
+ for (i = 0; i < CRS_ST_count; i++)
+ cmd.a_statistics[i] = 1;
+ }
+
+ /* MISSING. */
+ if (cmd.miss == CRS_REPORT && mode == GENERAL)
+ {
+ msg (SE, _("Missing mode REPORT not allowed in general mode. "
+ "Assuming MISSING=TABLE."));
+ cmd.miss = CRS_TABLE;
+ }
+
+ /* WRITE. */
+ if (cmd.a_write[CRS_WR_ALL] && cmd.a_write[CRS_WR_CELLS])
+ cmd.a_write[CRS_WR_ALL] = 0;
+ if (cmd.a_write[CRS_WR_ALL] && mode == GENERAL)
+ {
+ msg (SE, _("Write mode ALL not allowed in general mode. "
+ "Assuming WRITE=CELLS."));
+ cmd.a_write[CRS_WR_CELLS] = 1;
+ }
+ if (cmd.sbc_write
+ && (cmd.a_write[CRS_WR_NONE]
+ + cmd.a_write[CRS_WR_ALL]
+ + cmd.a_write[CRS_WR_CELLS] == 0))
+ cmd.a_write[CRS_WR_CELLS] = 1;
+ if (cmd.a_write[CRS_WR_CELLS])
+ write = CRS_WR_CELLS;
+ else if (cmd.a_write[CRS_WR_ALL])
+ write = CRS_WR_ALL;
+ else
+ write = CRS_WR_NONE;
+
+ update_weighting (&default_dict);
+ procedure (precalc, mode == GENERAL ? calc_general : calc_integer, postcalc);
+
+ return CMD_SUCCESS;
+}
+
+/* Frees var_dict once it's no longer needed. */
+static void
+free_var_dict (void)
+{
+ if (!var_dict)
+ return;
+
+ {
+ int i;
+
+ if (var_dict->var_by_name)
+ {
+ avl_destroy (var_dict->var_by_name, NULL);
+ var_dict->var_by_name = NULL;
+ }
+
+ for (i = 0; i < var_dict->nvar; i++)
+ free (var_dict->var[i]);
+ free (var_dict->var);
+ var_dict->var = NULL;
+ var_dict->nvar = 0;
+
+ free_dictionary (var_dict);
+
+ var_dict = NULL;
+ }
+}
+
+/* Parses the TABLES subcommand. */
+static int
+crs_custom_tables (struct cmd_crosstabs *cmd unused)
+{
+ struct dictionary *dict;
+ int n_by;
+ struct variable ***by = NULL;
+ int *by_nvar = NULL;
+ int nx = 1;
+ int success = 0;
+
+ /* Ensure that this is a TABLES subcommand. */
+ if (!lex_match_id ("TABLES")
+ && (token != T_ID || !is_varname (tokid))
+ && token != T_ALL)
+ return 2;
+ lex_match ('=');
+
+ dict = var_dict ? var_dict : &default_dict;
+
+ for (n_by = 0; ;)
+ {
+ by = xrealloc (by, sizeof *by * (n_by + 1));
+ by_nvar = xrealloc (by_nvar, sizeof *by_nvar * (n_by + 1));
+ if (!parse_variables (dict, &by[n_by], &by_nvar[n_by],
+ PV_NO_DUPLICATE | PV_NO_SCRATCH))
+ goto lossage;
+ nx *= by_nvar[n_by];
+ n_by++;
+
+ if (!lex_match (T_BY))
+ {
+ if (n_by < 1)
+ {
+ lex_error (_("expecting BY"));
+ goto lossage;
+ }
+ else
+ break;
+ }
+ }
+
+ {
+ int *by_iter = xcalloc (sizeof *by_iter * n_by);
+ int i;
+
+ xtab = xrealloc (xtab, sizeof *xtab * (nxtab + nx));
+ for (i = 0; i < nx; i++)
+ {
+ struct crosstab *x;
+
+ x = xmalloc (sizeof *x + sizeof (struct variable *) * (n_by - 2));
+ x->nvar = n_by;
+ x->missing = 0.;
+
+ {
+ int i;
+
+ if (var_dict == NULL)
+ for (i = 0; i < n_by; i++)
+ x->v[i] = by[i][by_iter[i]];
+ else
+ for (i = 0; i < n_by; i++)
+ x->v[i] = default_dict.var[by[i][by_iter[i]]->foo];
+ }
+
+ {
+ int i;
+
+ for (i = n_by - 1; i >= 0; i--)
+ {
+ if (++by_iter[i] < by_nvar[i])
+ break;
+ by_iter[i] = 0;
+ }
+ }
+
+ xtab[nxtab++] = x;
+ }
+ free (by_iter);
+ }
+
+ success = 1;
+ /* Despite the name, we come here whether we're successful or
+ not. */
+ lossage:
+ {
+ int i;
+
+ for (i = 0; i < n_by; i++)
+ free (by[i]);
+ free (by);
+ free (by_nvar);
+ }
+
+ return success;
+}
+
+/* Parses the VARIABLES subcommand. */
+static int
+crs_custom_variables (struct cmd_crosstabs *cmd unused)
+{
+ struct variable **v = NULL;
+ int nv = 0;
+
+ if (nxtab)
+ {
+ msg (SE, _("VARIABLES must be specified before TABLES."));
+ return 0;
+ }
+
+ lex_match ('=');
+
+ for (;;)
+ {
+ int orig_nv = nv;
+ int i;
+
+ long min, max;
+
+ if (!parse_variables (&default_dict, &v, &nv,
+ (PV_APPEND | PV_NUMERIC
+ | PV_NO_DUPLICATE | PV_NO_SCRATCH)))
+ return 0;
+
+ if (token != '(')
+ {
+ lex_error ("expecting `('");
+ goto lossage;
+ }
+ lex_get ();
+
+ if (!lex_force_int ())
+ goto lossage;
+ min = lex_integer ();
+ lex_get ();
+
+ lex_match (',');
+
+ if (!lex_force_int ())
+ goto lossage;
+ max = lex_integer ();
+ if (max < min)
+ {
+ msg (SE, _("Maximum value (%ld) less than minimum value (%ld)."),
+ max, min);
+ goto lossage;
+ }
+ lex_get ();
+
+ if (token != ')')
+ {
+ lex_error ("expecting `)'");
+ goto lossage;
+ }
+ lex_get ();
+
+ for (i = orig_nv; i < nv; i++)
+ {
+ v[i]->p.crs.min = min;
+ v[i]->p.crs.max = max + 1.;
+ v[i]->p.crs.count = max - min + 1;
+ }
+
+ if (token == '/')
+ break;
+ }
+
+ {
+ int i;
+
+ var_dict = new_dictionary (0);
+ var_dict->var = xmalloc (sizeof *var_dict->var * nv);
+ var_dict->nvar = nv;
+ for (i = 0; i < nv; i++)
+ {
+ struct variable *var = xmalloc (offsetof (struct variable, width));
+ strcpy (var->name, v[i]->name);
+ var->index = i;
+ var->type = v[i]->type;
+ var->foo = v[i]->index;
+ var_dict->var[i] = var;
+ avl_force_insert (var_dict->var_by_name, var);
+ }
+
+ free (v);
+ return 1;
+ }
+
+ lossage:
+ free (v);
+ return 0;
+}
+
+#if DEBUGGING
+static void
+debug_print (void)
+{
+ printf ("CROSSTABS\n");
+
+ if (var_dict)
+ {
+ int i;
+
+ printf ("\t/VARIABLES=");
+ for (i = 0; i < var_dict->nvar; i++)
+ {
+ struct variable *v = var_dict->var[i];
+ struct variable *iv = default_dict.var[v->foo];
+
+ printf ("%s ", v->name);
+ if (i < var_dict->nvar - 1)
+ {
+ struct variable *nv = var_dict->var[i + 1];
+ struct variable *niv = default_dict.var[nv->foo];
+
+ if (iv->p.crs.min == niv->p.crs.min
+ && iv->p.crs.max == niv->p.crs.max)
+ continue;
+ }
+ printf ("(%d,%d) ", iv->p.crs.min, iv->p.crs.max - 1);
+ }
+ printf ("\n");
+ }
+
+ {
+ int i;
+
+ printf ("\t/TABLES=");
+ for (i = 0; i < nxtab; i++)
+ {
+ struct crosstab *x = xtab[i];
+ int j;
+
+ if (i)
+ printf("\t\t");
+ for (j = 0; j < x->nvar; j++)
+ {
+ if (j)
+ printf (" BY ");
+ printf ("%s", x->v[j]->name);
+ }
+ printf ("\n");
+ }
+ }
+}
+#endif /* DEBUGGING */
+\f
+/* Data file processing. */
+
+static int compare_table_entry (const void *, const void *, void *);
+static unsigned hash_table_entry (const void *, void *);
+
+/* Set up the crosstabulation tables for processing. */
+static void
+precalc (void)
+{
+ if (mode == GENERAL)
+ {
+ gen_tab = hsh_create (512, compare_table_entry, hash_table_entry,
+ NULL, NULL);
+ }
+ else
+ {
+ int i;
+
+ sorted_tab = NULL;
+ n_sorted_tab = 0;
+
+ for (i = 0; i < nxtab; i++)
+ {
+ struct crosstab *x = xtab[i];
+ int count = 1;
+ int *v;
+ int j;
+
+ x->ofs = n_sorted_tab;
+
+ for (j = 2; j < x->nvar; j++)
+ count *= x->v[j - 2]->p.crs.count;
+
+ sorted_tab = xrealloc (sorted_tab,
+ sizeof *sorted_tab * (n_sorted_tab + count));
+ v = local_alloc (sizeof *v * x->nvar);
+ for (j = 2; j < x->nvar; j++)
+ v[j] = x->v[j]->p.crs.min;
+ for (j = 0; j < count; j++)
+ {
+ struct table_entry *te;
+ int k;
+
+ te = sorted_tab[n_sorted_tab++]
+ = xmalloc (sizeof *te + sizeof (union value) * (x->nvar - 1));
+ te->table = i;
+
+ {
+ const int mat_size = (x->v[0]->p.crs.count
+ * x->v[1]->p.crs.count);
+ int m;
+
+ te->u.data = xmalloc (sizeof *te->u.data * mat_size);
+ for (m = 0; m < mat_size; m++)
+ te->u.data[m] = 0.;
+ }
+
+ for (k = 2; k < x->nvar; k++)
+ te->v[k].f = v[k];
+ for (k = 2; k < x->nvar; k++)
+ if (++v[k] >= x->v[k]->p.crs.max)
+ v[k] = x->v[k]->p.crs.min;
+ else
+ break;
+ }
+ local_free (v);
+ }
+
+ sorted_tab = xrealloc (sorted_tab,
+ sizeof *sorted_tab * (n_sorted_tab + 1));
+ sorted_tab[n_sorted_tab] = NULL;
+ }
+}
+
+/* Form crosstabulations for general mode. */
+static int
+calc_general (struct ccase *c)
+{
+ /* Case weight. */
+ double w = (default_dict.weight_index != -1
+ ? c->data[default_dict.var[default_dict.weight_index]->fv].f
+ : 1.0);
+
+ /* Flattened current table index. */
+ int t;
+
+ for (t = 0; t < nxtab; t++)
+ {
+ struct crosstab *x = xtab[t];
+ const size_t entry_size = (sizeof (struct table_entry)
+ + sizeof (union value) * (x->nvar - 1));
+ struct table_entry *te = local_alloc (entry_size);
+
+ /* Construct table entry for the current record and table. */
+ te->table = t;
+ {
+ int j;
+
+ assert (x != NULL);
+ for (j = 0; j < x->nvar; j++)
+ {
+ if ((cmd.miss == CRS_TABLE
+ && is_missing (&c->data[x->v[j]->fv], x->v[j]))
+ || (cmd.miss == CRS_INCLUDE
+ && is_system_missing (&c->data[x->v[j]->fv], x->v[j])))
+ {
+ x->missing += w;
+ goto next_crosstab;
+ }
+
+ if (x->v[j]->type == NUMERIC)
+ te->v[j].f = c->data[x->v[j]->fv].f;
+ else
+ {
+ memcpy (te->v[j].s, c->data[x->v[j]->fv].s, x->v[j]->width);
+
+ /* Necessary in order to simplify comparisons. */
+ memset (&te->v[j].s[x->v[j]->width], 0,
+ sizeof (union value) - x->v[j]->width);
+ }
+ }
+ }
+
+ /* Add record to hash table. */
+ {
+ struct table_entry **tepp = (struct table_entry **) hsh_probe (gen_tab, te);
+ if (NULL == *tepp)
+ {
+ struct table_entry *tep = pool_alloc (pl_tc, entry_size);
+
+ te->u.freq = w;
+ memcpy (tep, te, entry_size);
+
+ *tepp = tep;
+ }
+ else
+ (*tepp)->u.freq += w;
+ }
+
+ next_crosstab:
+ local_free (te);
+ }
+
+ return 1;
+}
+
+static int
+calc_integer (struct ccase *c)
+{
+ /* Case weight. */
+ double w = (default_dict.weight_index != -1
+ ? c->data[default_dict.var[default_dict.weight_index]->fv].f
+ : 1.0);
+
+ /* Flattened current table index. */
+ int t;
+
+ for (t = 0; t < nxtab; t++)
+ {
+ struct crosstab *x = xtab[t];
+ int i, fact, ofs;
+
+ fact = i = 1;
+ ofs = x->ofs;
+ for (i = 0; i < x->nvar; i++)
+ {
+ struct variable *const v = x->v[i];
+ double value = c->data[v->fv].f;
+
+ /* Note that the first test also rules out SYSMIS. */
+ if ((value < v->p.crs.min || value >= v->p.crs.max)
+ || (cmd.miss == CRS_TABLE && is_num_user_missing (value, v)))
+ {
+ x->missing += w;
+ goto next_crosstab;
+ }
+
+ if (i > 1)
+ {
+ ofs += fact * ((int) value - v->p.crs.min);
+ fact *= v->p.crs.count;
+ }
+ }
+
+ {
+ const int row = c->data[x->v[ROW_VAR]->fv].f - x->v[ROW_VAR]->p.crs.min;
+ const int col = c->data[x->v[COL_VAR]->fv].f - x->v[COL_VAR]->p.crs.min;
+ const int col_dim = x->v[COL_VAR]->p.crs.count;
+
+ sorted_tab[ofs]->u.data[col + row * col_dim] += w;
+ }
+
+ next_crosstab: ;
+ }
+
+ return 1;
+}
+
+#if DEBUGGING
+/* Print out all table entries in NULL-terminated TAB for use by a
+ debugger (a person, not a program). */
+static void
+print_table_entries (struct table_entry **tab)
+{
+ printf ("raw crosstabulation data:\n");
+ for (; *tab; tab++)
+ {
+ const struct crosstab *x = xtab[(*tab)->table];
+ int i;
+
+ printf ("(%g) table:%d ", (*tab)->u.freq, (*tab)->table);
+ for (i = 0; i < x->nvar; i++)
+ {
+ if (i)
+ printf (", ");
+ printf ("%s:", x->v[i]->name);
+
+ if (x->v[i]->type == NUMERIC)
+ printf ("%g", (*tab)->v[i].f);
+ else
+ printf ("%.*s", x->v[i]->width, (*tab)->v[i].s);
+ }
+ printf ("\n");
+ }
+ fflush (stdout);
+}
+#endif
+
+/* Compare the table_entry's at PA and PB and return a strcmp()-type
+ result. */
+static int
+compare_table_entry (const void *pa, const void *pb, void *foo unused)
+{
+ const struct table_entry *a = pa;
+ const struct table_entry *b = pb;
+
+ {
+ const int difftable = a->table - b->table;
+ if (difftable)
+ return difftable;
+ }
+
+ {
+ const struct crosstab *x = xtab[a->table];
+ int i;
+
+ for (i = x->nvar - 1; i >= 0; i--)
+ if (x->v[i]->type == NUMERIC)
+ {
+ const double diffnum = a->v[i].f - b->v[i].f;
+ if (diffnum < 0)
+ return -1;
+ else if (diffnum > 0)
+ return 1;
+ }
+ else
+ {
+ assert (x->v[i]->type == ALPHA);
+ {
+ const int diffstr = strncmp (a->v[i].s, b->v[i].s, x->v[i]->width);
+ if (diffstr)
+ return diffstr;
+ }
+ }
+ }
+
+ return 0;
+}
+
+/* Calculate a hash value from table_entry PA. */
+static unsigned
+hash_table_entry (const void *pa, void *foo unused)
+{
+ const struct table_entry *a = pa;
+ unsigned long hash = a->table;
+ int i;
+
+ /* Hash formula from _SPSS Statistical Algorithms_. */
+ for (i = 0; i < xtab[a->table]->nvar; i++)
+ {
+ hash = (hash << 3) | (hash >> (CHAR_BIT * SIZEOF_LONG - 3));
+ hash ^= a->v[i].hash[0];
+#if SIZEOF_DOUBLE / SIZEOF_LONG > 1
+ hash ^= a->v[i].hash[1];
+#endif
+ }
+
+ return hash;
+}
+\f
+/* Post-data reading calculations. */
+
+static struct table_entry **find_pivot_extent (struct table_entry **, int *cnt, int pivot);
+static void enum_var_values (struct table_entry **beg, int cnt,
+ union value **values, int *nvalues,
+ int var_index);
+static void output_pivot_table (struct table_entry **, struct table_entry **,
+ double **, double **, double **,
+ int *, int *, int *);
+static void make_summary_table (void);
+
+static void
+postcalc (void)
+{
+ if (mode == GENERAL)
+ {
+ n_sorted_tab = hsh_count (gen_tab);
+ sorted_tab = (struct table_entry **) hsh_sort (gen_tab, compare_table_entry);
+#if DEBUGGING
+ print_table_entries (sorted_tab);
+#endif
+ }
+
+ make_summary_table ();
+
+ /* Identify all the individual crosstabulation tables, and deal with
+ them. */
+ {
+ struct table_entry **pb = sorted_tab, **pe; /* Pivot begin, pivot end. */
+ int pc = n_sorted_tab; /* Pivot count. */
+
+ double *mat = NULL, *row_tot = NULL, *col_tot = NULL;
+ int maxrows = 0, maxcols = 0, maxcells = 0;
+
+ for (;;)
+ {
+ pe = find_pivot_extent (pb, &pc, cmd.pivot == CRS_PIVOT);
+ if (pe == NULL)
+ break;
+
+ output_pivot_table (pb, pe, &mat, &row_tot, &col_tot,
+ &maxrows, &maxcols, &maxcells);
+
+ pb = pe;
+ }
+ free (mat);
+ free (row_tot);
+ free (col_tot);
+ }
+
+ hsh_destroy (gen_tab);
+}
+
+static void insert_summary (struct tab_table *, int tab_index, double valid);
+
+/* Output a table summarizing the cases processed. */
+static void
+make_summary_table (void)
+{
+ struct tab_table *summary;
+
+ struct table_entry **pb = sorted_tab, **pe;
+ int pc = n_sorted_tab;
+ int cur_tab = 0;
+
+ summary = tab_create (7, 3 + nxtab, 1);
+ tab_title (summary, 0, _("Summary."));
+ tab_headers (summary, 1, 0, 3, 0);
+ tab_joint_text (summary, 1, 0, 6, 0, TAB_CENTER, _("Cases"));
+ tab_joint_text (summary, 1, 1, 2, 1, TAB_CENTER, _("Valid"));
+ tab_joint_text (summary, 3, 1, 4, 1, TAB_CENTER, _("Missing"));
+ tab_joint_text (summary, 5, 1, 6, 1, TAB_CENTER, _("Total"));
+ tab_hline (summary, TAL_1, 1, 6, 1);
+ tab_hline (summary, TAL_1, 1, 6, 2);
+ tab_vline (summary, TAL_1, 3, 1, 1);
+ tab_vline (summary, TAL_1, 5, 1, 1);
+ {
+ int i;
+
+ for (i = 0; i < 3; i++)
+ {
+ tab_text (summary, 1 + i * 2, 2, TAB_RIGHT, _("N"));
+ tab_text (summary, 2 + i * 2, 2, TAB_RIGHT, _("Percent"));
+ }
+ }
+ tab_offset (summary, 0, 3);
+
+ for (;;)
+ {
+ double valid;
+
+ pe = find_pivot_extent (pb, &pc, cmd.pivot == CRS_PIVOT);
+ if (pe == NULL)
+ break;
+
+ while (cur_tab < (*pb)->table)
+ insert_summary (summary, cur_tab++, 0.);
+
+ if (mode == GENERAL)
+ for (valid = 0.; pb < pe; pb++)
+ valid += (*pb)->u.freq;
+ else
+ {
+ const struct crosstab *const x = xtab[(*pb)->table];
+ const int n_cols = x->v[COL_VAR]->p.crs.count;
+ const int n_rows = x->v[ROW_VAR]->p.crs.count;
+ const int count = n_cols * n_rows;
+
+ for (valid = 0.; pb < pe; pb++)
+ {
+ const double *data = (*pb)->u.data;
+ int i;
+
+ for (i = 0; i < count; i++)
+ valid += *data++;
+ }
+ }
+ insert_summary (summary, cur_tab++, valid);
+
+ pb = pe;
+ }
+
+ while (cur_tab < nxtab)
+ insert_summary (summary, cur_tab++, 0.);
+
+ submit (summary);
+}
+
+/* Inserts a line into T describing the crosstabulation at index
+ TAB_INDEX, which has VALID valid observations. */
+static void
+insert_summary (struct tab_table *t, int tab_index, double valid)
+{
+ struct crosstab *x = xtab[tab_index];
+
+ tab_hline (t, TAL_1, 0, 6, 0);
+
+ /* Crosstabulation name. */
+ {
+ char *buf = local_alloc (128 * x->nvar);
+ char *cp = buf;
+ int i;
+
+ for (i = 0; i < x->nvar; i++)
+ {
+ if (i > 0)
+ cp = stpcpy (cp, " * ");
+
+ cp = stpcpy (cp, x->v[i]->label ? x->v[i]->label : x->v[i]->name);
+ }
+ tab_text (t, 0, 0, TAB_LEFT, buf);
+
+ local_free (buf);
+ }
+
+ /* Counts and percentages. */
+ {
+ double n[3];
+ int i;
+
+ n[0] = valid;
+ n[1] = x->missing;
+ n[2] = n[0] + n[1];
+
+
+ for (i = 0; i < 3; i++)
+ {
+ tab_float (t, i * 2 + 1, 0, TAB_RIGHT, n[i], 8, 0);
+ tab_text (t, i * 2 + 2, 0, TAB_RIGHT | TAT_PRINTF, "%.1f%%",
+ n[i] / n[2] * 100.);
+ }
+ }
+
+ tab_next_row (t);
+}
+\f
+/* Output. */
+
+/* Tables. */
+static struct tab_table *table; /* Crosstabulation table. */
+static struct tab_table *chisq; /* Chi-square table. */
+static struct tab_table *sym; /* Symmetric measures table. */
+static struct tab_table *risk; /* Risk estimate table. */
+static struct tab_table *direct; /* Directional measures table. */
+
+/* Statistics. */
+static int chisq_fisher; /* Did any rows include Fisher's exact test? */
+
+/* Column values, number of columns. */
+static union value *cols;
+static int n_cols;
+
+/* Row values, number of rows. */
+static union value *rows;
+static int n_rows;
+
+/* Number of statistically interesting columns/rows (columns/rows with
+ data in them). */
+static int ns_cols, ns_rows;
+
+/* Crosstabulation. */
+static struct crosstab *x;
+
+/* Number of variables from the crosstabulation to consider. This is
+ either x->nvar, if pivoting is on, or 2, if pivoting is off. */
+static int nvar;
+
+/* Matrix contents. */
+static double *mat; /* Matrix proper. */
+static double *row_tot; /* Row totals. */
+static double *col_tot; /* Column totals. */
+static double W; /* Grand total. */
+
+static void display_dimensions (struct tab_table *, int first_difference,
+ struct table_entry *);
+static void display_crosstabulation (void);
+static void display_chisq (void);
+static void display_symmetric (void);
+static void display_risk (void);
+static void display_directional (void);
+static void crosstabs_dim (struct tab_table *, struct outp_driver *);
+static void table_value_missing (struct tab_table *table, int c, int r,
+ unsigned char opt, const union value *v,
+ const struct variable *var);
+static void delete_missing (void);
+
+/* Output pivot table beginning at PB and continuing until PE,
+ exclusive. For efficiency, *MATP is a pointer to a matrix that can
+ hold *MAXROWS entries. */
+static void
+output_pivot_table (struct table_entry **pb, struct table_entry **pe,
+ double **matp, double **row_totp, double **col_totp,
+ int *maxrows, int *maxcols, int *maxcells)
+{
+ /* Subtable. */
+ struct table_entry **tb = pb, **te; /* Table begin, table end. */
+ int tc = pe - pb; /* Table count. */
+
+ /* Table entry for header comparison. */
+ struct table_entry *cmp;
+
+ x = xtab[(*pb)->table];
+ enum_var_values (pb, pe - pb, &cols, &n_cols, COL_VAR);
+
+ nvar = cmd.pivot == CRS_PIVOT ? x->nvar : 2;
+
+ /* Crosstabulation table initialization. */
+ if (num_cells)
+ {
+ table = tab_create (nvar + n_cols,
+ (pe - pb) / n_cols * 3 / 2 * num_cells + 10, 1);
+ tab_headers (table, nvar - 1, 0, 2, 0);
+
+ /* First header line. */
+ tab_joint_text (table, nvar - 1, 0, (nvar - 1) + (n_cols - 1), 0,
+ TAB_CENTER | TAT_TITLE, x->v[COL_VAR]->name);
+
+ tab_hline (table, TAL_1, nvar - 1, nvar + n_cols - 2, 1);
+
+ /* Second header line. */
+ {
+ int i;
+
+ for (i = 2; i < nvar; i++)
+ tab_joint_text (table, nvar - i - 1, 0, nvar - i - 1, 1,
+ TAB_RIGHT | TAT_TITLE,
+ x->v[i]->label ? x->v[i]->label : x->v[i]->name);
+ tab_text (table, nvar - 2, 1, TAB_RIGHT | TAT_TITLE,
+ x->v[ROW_VAR]->name);
+ for (i = 0; i < n_cols; i++)
+ table_value_missing (table, nvar + i - 1, 1, TAB_RIGHT, &cols[i],
+ x->v[COL_VAR]);
+ tab_text (table, nvar + n_cols - 1, 1, TAB_CENTER, _("Total"));
+ }
+
+ tab_hline (table, TAL_1, 0, nvar + n_cols - 1, 2);
+ tab_vline (table, TAL_1, nvar + n_cols - 1, 0, 1);
+
+ /* Title. */
+ {
+ char *title = local_alloc (x->nvar * 64 + 128);
+ char *cp = title;
+ int i;
+
+ if (cmd.pivot == CRS_PIVOT)
+ for (i = 0; i < nvar; i++)
+ {
+ if (i)
+ cp = stpcpy (cp, " by ");
+ cp = stpcpy (cp, x->v[i]->name);
+ }
+ else
+ {
+ cp = spprintf (cp, "%s by %s for", x->v[0]->name, x->v[1]->name);
+ for (i = 2; i < nvar; i++)
+ {
+ char buf[64], *bufp;
+
+ if (i > 2)
+ *cp++ = ',';
+ *cp++ = ' ';
+ cp = stpcpy (cp, x->v[i]->name);
+ *cp++ = '=';
+ data_out (buf, &x->v[i]->print, &(*pb)->v[i]);
+ for (bufp = buf; isspace ((unsigned char) *bufp); bufp++)
+ ;
+ cp = stpcpy (cp, bufp);
+ }
+ }
+
+ cp = stpcpy (cp, " [");
+ for (i = 0; i < num_cells; i++)
+ {
+ struct tuple
+ {
+ int value;
+ const char *name;
+ };
+
+ static const struct tuple cell_names[] =
+ {
+ {CRS_CL_COUNT, N_("count")},
+ {CRS_CL_ROW, N_("row %")},
+ {CRS_CL_COLUMN, N_("column %")},
+ {CRS_CL_TOTAL, N_("total %")},
+ {CRS_CL_EXPECTED, N_("expected")},
+ {CRS_CL_RESIDUAL, N_("residual")},
+ {CRS_CL_SRESIDUAL, N_("std. resid.")},
+ {CRS_CL_ASRESIDUAL, N_("adj. resid.")},
+ {-1, NULL},
+ };
+
+ const struct tuple *t;
+
+ for (t = cell_names; t->value != cells[i]; t++)
+ assert (t->value != -1);
+ if (i)
+ cp = stpcpy (cp, ", ");
+ cp = stpcpy (cp, gettext (t->name));
+ }
+ strcpy (cp, "].");
+
+ tab_title (table, 0, title);
+ local_free (title);
+ }
+
+ tab_offset (table, 0, 2);
+ }
+ else
+ table = NULL;
+
+ /* Chi-square table initialization. */
+ if (cmd.a_statistics[CRS_ST_CHISQ])
+ {
+ chisq = tab_create (6 + (nvar - 2),
+ (pe - pb) / n_cols * 3 / 2 * N_CHISQ + 10, 1);
+ tab_headers (chisq, 1 + (nvar - 2), 0, 1, 0);
+
+ tab_title (chisq, 0, "Chi-square tests.");
+
+ tab_offset (chisq, nvar - 2, 0);
+ tab_text (chisq, 0, 0, TAB_LEFT | TAT_TITLE, _("Statistic"));
+ tab_text (chisq, 1, 0, TAB_RIGHT | TAT_TITLE, _("Value"));
+ tab_text (chisq, 2, 0, TAB_RIGHT | TAT_TITLE, _("df"));
+ tab_text (chisq, 3, 0, TAB_RIGHT | TAT_TITLE,
+ _("Asymp. Sig. (2-sided)"));
+ tab_text (chisq, 4, 0, TAB_RIGHT | TAT_TITLE,
+ _("Exact. Sig. (2-sided)"));
+ tab_text (chisq, 5, 0, TAB_RIGHT | TAT_TITLE,
+ _("Exact. Sig. (1-sided)"));
+ chisq_fisher = 0;
+ tab_offset (chisq, 0, 1);
+ }
+ else
+ chisq = NULL;
+
+ /* Symmetric measures. */
+ if (cmd.a_statistics[CRS_ST_PHI] || cmd.a_statistics[CRS_ST_CC]
+ || cmd.a_statistics[CRS_ST_BTAU] || cmd.a_statistics[CRS_ST_CTAU]
+ || cmd.a_statistics[CRS_ST_GAMMA] || cmd.a_statistics[CRS_ST_CORR]
+ || cmd.a_statistics[CRS_ST_KAPPA])
+ {
+ sym = tab_create (6 + (nvar - 2), (pe - pb) / n_cols * 7 + 10, 1);
+ tab_headers (sym, 2 + (nvar - 2), 0, 1, 0);
+ tab_title (sym, 0, "Symmetric measures.");
+
+ tab_offset (sym, nvar - 2, 0);
+ tab_text (sym, 0, 0, TAB_LEFT | TAT_TITLE, _("Category"));
+ tab_text (sym, 1, 0, TAB_LEFT | TAT_TITLE, _("Statistic"));
+ tab_text (sym, 2, 0, TAB_RIGHT | TAT_TITLE, _("Value"));
+ tab_text (sym, 3, 0, TAB_RIGHT | TAT_TITLE, _("Asymp. Std. Error"));
+ tab_text (sym, 4, 0, TAB_RIGHT | TAT_TITLE, _("Approx. T"));
+ tab_text (sym, 5, 0, TAB_RIGHT | TAT_TITLE, _("Approx. Sig."));
+ tab_offset (sym, 0, 1);
+ }
+ else
+ sym = NULL;
+
+ /* Risk estimate. */
+ if (cmd.a_statistics[CRS_ST_RISK])
+ {
+ risk = tab_create (4 + (nvar - 2), (pe - pb) / n_cols * 4 + 10, 1);
+ tab_headers (risk, 1 + nvar - 2, 0, 2, 0);
+ tab_title (risk, 0, "Risk estimate.");
+
+ tab_offset (risk, nvar - 2, 0);
+ tab_joint_text (risk, 2, 0, 3, 0, TAB_CENTER | TAT_TITLE | TAT_PRINTF,
+ _(" 95%% Confidence Interval"));
+ tab_text (risk, 0, 1, TAB_LEFT | TAT_TITLE, _("Statistic"));
+ tab_text (risk, 1, 1, TAB_RIGHT | TAT_TITLE, _("Value"));
+ tab_text (risk, 2, 1, TAB_RIGHT | TAT_TITLE, _("Lower"));
+ tab_text (risk, 3, 1, TAB_RIGHT | TAT_TITLE, _("Upper"));
+ tab_hline (risk, TAL_1, 2, 3, 1);
+ tab_vline (risk, TAL_1, 2, 0, 1);
+ tab_offset (risk, 0, 2);
+ }
+ else
+ risk = NULL;
+
+ /* Directional measures. */
+ if (cmd.a_statistics[CRS_ST_LAMBDA] || cmd.a_statistics[CRS_ST_UC]
+ || cmd.a_statistics[CRS_ST_D] || cmd.a_statistics[CRS_ST_ETA])
+ {
+ direct = tab_create (7 + (nvar - 2), (pe - pb) / n_cols * 7 + 10, 1);
+ tab_headers (direct, 3 + (nvar - 2), 0, 1, 0);
+ tab_title (direct, 0, "Directional measures.");
+
+ tab_offset (direct, nvar - 2, 0);
+ tab_text (direct, 0, 0, TAB_LEFT | TAT_TITLE, _("Category"));
+ tab_text (direct, 1, 0, TAB_LEFT | TAT_TITLE, _("Statistic"));
+ tab_text (direct, 2, 0, TAB_LEFT | TAT_TITLE, _("Type"));
+ tab_text (direct, 3, 0, TAB_RIGHT | TAT_TITLE, _("Value"));
+ tab_text (direct, 4, 0, TAB_RIGHT | TAT_TITLE, _("Asymp. Std. Error"));
+ tab_text (direct, 5, 0, TAB_RIGHT | TAT_TITLE, _("Approx. T"));
+ tab_text (direct, 6, 0, TAB_RIGHT | TAT_TITLE, _("Approx. Sig."));
+ tab_offset (direct, 0, 1);
+ }
+ else
+ direct = NULL;
+
+ for (;;)
+ {
+ /* Find pivot subtable if applicable. */
+ te = find_pivot_extent (tb, &tc, 0);
+ if (te == NULL)
+ break;
+
+ /* Find all the row variable values. */
+ enum_var_values (tb, te - tb, &rows, &n_rows, ROW_VAR);
+
+ /* Allocate memory space for the column and row totals. */
+ if (n_rows > *maxrows)
+ {
+ *row_totp = xrealloc (*row_totp, sizeof **row_totp * n_rows);
+ row_tot = *row_totp;
+ *maxrows = n_rows;
+ }
+ if (n_cols > *maxcols)
+ {
+ *col_totp = xrealloc (*col_totp, sizeof **col_totp * n_cols);
+ col_tot = *col_totp;
+ *maxcols = n_cols;
+ }
+
+ /* Allocate table space for the matrix. */
+ if (table && tab_row (table) + (n_rows + 1) * num_cells > tab_nr (table))
+ tab_realloc (table, -1,
+ max (tab_nr (table) + (n_rows + 1) * num_cells,
+ tab_nr (table) * (pe - pb) / (te - tb)));
+
+ if (mode == GENERAL)
+ {
+ /* Allocate memory space for the matrix. */
+ if (n_cols * n_rows > *maxcells)
+ {
+ *matp = xrealloc (*matp, sizeof **matp * n_cols * n_rows);
+ *maxcells = n_cols * n_rows;
+ }
+
+ mat = *matp;
+
+ /* Build the matrix and calculate column totals. */
+ {
+ union value *cur_col = cols;
+ union value *cur_row = rows;
+ double *mp = mat;
+ double *cp = col_tot;
+ struct table_entry **p;
+
+ *cp = 0.;
+ for (p = &tb[0]; p < te; p++)
+ {
+ for (; memcmp (cur_col, &(*p)->v[COL_VAR], sizeof *cur_col);
+ cur_row = rows)
+ {
+ *++cp = 0.;
+ for (; cur_row < &rows[n_rows]; cur_row++)
+ {
+ *mp = 0.;
+ mp += n_cols;
+ }
+ cur_col++;
+ mp = &mat[cur_col - cols];
+ }
+
+ for (; memcmp (cur_row, &(*p)->v[ROW_VAR], sizeof *cur_row);
+ cur_row++)
+ {
+ *mp = 0.;
+ mp += n_cols;
+ }
+
+ *cp += *mp = (*p)->u.freq;
+ mp += n_cols;
+ cur_row++;
+ }
+
+ /* Zero out the rest of the matrix. */
+ for (; cur_row < &rows[n_rows]; cur_row++)
+ {
+ *mp = 0.;
+ mp += n_cols;
+ }
+ cur_col++;
+ if (cur_col < &cols[n_cols])
+ {
+ const int rem_cols = n_cols - (cur_col - cols);
+ int c, r;
+
+ for (c = 0; c < rem_cols; c++)
+ *++cp = 0.;
+ mp = &mat[cur_col - cols];
+ for (r = 0; r < n_rows; r++)
+ {
+ for (c = 0; c < rem_cols; c++)
+ *mp++ = 0.;
+ mp += n_cols - rem_cols;
+ }
+ }
+ }
+ }
+ else
+ {
+ int r, c;
+ double *tp = col_tot;
+
+ assert (mode == INTEGER);
+ mat = (*tb)->u.data;
+ ns_cols = n_cols;
+
+ /* Calculate column totals. */
+ for (c = 0; c < n_cols; c++)
+ {
+ double cum = 0.;
+ double *cp = &mat[c];
+
+ for (r = 0; r < n_rows; r++)
+ cum += cp[r * n_cols];
+ *tp++ = cum;
+ }
+ }
+
+ {
+ double *cp;
+
+ for (ns_cols = 0, cp = col_tot; cp < &col_tot[n_cols]; cp++)
+ ns_cols += *cp != 0.;
+ }
+
+ /* Calculate row totals. */
+ {
+ double *mp = mat;
+ double *rp = row_tot;
+ int r, c;
+
+ for (ns_rows = 0, r = n_rows; r--; )
+ {
+ double cum = 0.;
+ for (c = n_cols; c--; )
+ cum += *mp++;
+ *rp++ = cum;
+ if (cum != 0.)
+ ns_rows++;
+ }
+ }
+
+ /* Calculate grand total. */
+ {
+ double *tp;
+ double cum = 0.;
+ int n;
+
+ if (n_rows < n_cols)
+ tp = row_tot, n = n_rows;
+ else
+ tp = col_tot, n = n_cols;
+ while (n--)
+ cum += *tp++;
+ W = cum;
+ }
+
+#if DEBUGGING
+ /* Print the matrix. */
+ {
+ int i, r, c;
+
+ printf ("%s by %s for", x->v[0]->name, x->v[1]->name);
+ for (i = 2; i < nvar; i++)
+ printf (" %s=%g", x->v[i]->name, tb[0]->v[i].f);
+ printf ("\n");
+ printf (" ");
+ for (c = 0; c < n_cols; c++)
+ printf ("%4g", cols[c].f);
+ printf ("\n");
+ for (r = 0; r < n_rows; r++)
+ {
+ printf ("%4g:", rows[r].f);
+ for (c = 0; c < n_cols; c++)
+ printf ("%4g", mat[c + r * n_cols]);
+ printf ("%4g", row_tot[r]);
+ printf ("\n");
+ }
+ printf (" ");
+ for (c = 0; c < n_cols; c++)
+ printf ("%4g", col_tot[c]);
+ printf ("%4g", W);
+ printf ("\n\n");
+ }
+#endif
+
+ /* Find the first variable that differs from the last subtable,
+ then display the values of the dimensioning variables for
+ each table that needs it. */
+ {
+ int first_difference = nvar - 1;
+
+ if (tb != pb)
+ for (; ; first_difference--)
+ {
+ assert (first_difference >= 2);
+ if (memcmp (&cmp->v[first_difference],
+ &(*tb)->v[first_difference], sizeof *cmp->v))
+ break;
+ }
+ cmp = *tb;
+
+ if (table)
+ display_dimensions (table, first_difference, *tb);
+ if (chisq)
+ display_dimensions (chisq, first_difference, *tb);
+ if (sym)
+ display_dimensions (sym, first_difference, *tb);
+ if (risk)
+ display_dimensions (risk, first_difference, *tb);
+ if (direct)
+ display_dimensions (direct, first_difference, *tb);
+ }
+
+ if (table)
+ display_crosstabulation ();
+ if (cmd.miss == CRS_REPORT)
+ delete_missing ();
+ if (chisq)
+ display_chisq ();
+ if (sym)
+ display_symmetric ();
+ if (risk)
+ display_risk ();
+ if (direct)
+ display_directional ();
+
+ tb = te;
+ free (rows);
+ }
+
+ submit (table);
+
+ if (chisq)
+ {
+ if (!chisq_fisher)
+ tab_resize (chisq, 4 + (nvar - 2), -1);
+ submit (chisq);
+ }
+
+ submit (sym);
+ submit (risk);
+ submit (direct);
+
+ free (cols);
+}
+
+/* Delete missing rows and columns for statistical analysis when
+ /MISSING=REPORT. */
+static void
+delete_missing (void)
+{
+ {
+ int r;
+
+ for (r = 0; r < n_rows; r++)
+ if (is_num_user_missing (rows[r].f, x->v[ROW_VAR]))
+ {
+ int c;
+
+ for (c = 0; c < n_cols; c++)
+ mat[c + r * n_cols] = 0.;
+ ns_rows--;
+ }
+ }
+
+ {
+ int c;
+
+ for (c = 0; c < n_cols; c++)
+ if (is_num_user_missing (cols[c].f, x->v[COL_VAR]))
+ {
+ int r;
+
+ for (r = 0; r < n_rows; r++)
+ mat[c + r * n_cols] = 0.;
+ ns_cols--;
+ }
+ }
+}
+
+/* Prepare table T for submission, and submit it. */
+static void
+submit (struct tab_table *t)
+{
+ int i;
+
+ if (t == NULL)
+ return;
+
+ tab_resize (t, -1, 0);
+ if (tab_nr (t) == tab_t (t))
+ {
+ tab_destroy (t);
+ return;
+ }
+ tab_offset (t, 0, 0);
+ if (t != table)
+ for (i = 2; i < nvar; i++)
+ tab_text (t, nvar - i - 1, 0, TAB_RIGHT | TAT_TITLE,
+ x->v[i]->label ? x->v[i]->label : x->v[i]->name);
+ tab_box (t, TAL_2, TAL_2, -1, -1, 0, 0, tab_nc (t) - 1, tab_nr (t) - 1);
+ tab_box (t, -1, -1, -1, TAL_1, tab_l (t), tab_t (t) - 1, tab_nc (t) - 1,
+ tab_nr (t) - 1);
+ tab_box (t, -1, -1, -1, TAL_1 | TAL_SPACING, 0, tab_t (t), tab_l (t) - 1,
+ tab_nr (t) - 1);
+ tab_vline (t, TAL_2, tab_l (t), 0, tab_nr (t) - 1);
+ tab_dim (t, crosstabs_dim);
+ tab_submit (t);
+}
+
+/* Sets the widths of all the columns and heights of all the rows in
+ table T for driver D. */
+static void
+crosstabs_dim (struct tab_table *t, struct outp_driver *d)
+{
+ int i;
+
+ /* Width of a numerical column. */
+ int c = outp_string_width (d, "0.000000");
+ if (cmd.miss == CRS_REPORT)
+ c += outp_string_width (d, "M");
+
+ /* Set width for header columns. */
+ if (t->l != 0)
+ {
+ int w = (d->width - t->vr_tot - c * (t->nc - t->l)) / t->l;
+
+ if (w < d->prop_em_width * 8)
+ w = d->prop_em_width * 8;
+
+ if (w > d->prop_em_width * 15)
+ w = d->prop_em_width * 15;
+
+ for (i = 0; i < t->l; i++)
+ t->w[i] = w;
+ }
+
+ for (i = t->l; i < t->nc; i++)
+ t->w[i] = c;
+
+ for (i = 0; i < t->nr; i++)
+ t->h[i] = tab_natural_height (t, d, i);
+}
+
+static struct table_entry **find_pivot_extent_general (struct table_entry **tp,
+ int *cnt, int pivot);
+static struct table_entry **find_pivot_extent_integer (struct table_entry **tp,
+ int *cnt, int pivot);
+
+/* Calls find_pivot_extent_general or find_pivot_extent_integer, as
+ appropriate. */
+static struct table_entry **
+find_pivot_extent (struct table_entry **tp, int *cnt, int pivot)
+{
+ return (mode == GENERAL
+ ? find_pivot_extent_general (tp, cnt, pivot)
+ : find_pivot_extent_integer (tp, cnt, pivot));
+}
+
+/* Find the extent of a region in TP that contains one table. If
+ PIVOT != 0 that means a set of table entries with identical table
+ number; otherwise they also have to have the same values for every
+ dimension after the row and column dimensions. The table that is
+ searched starts at TP and has length CNT. Returns the first entry
+ after the last one in the table; sets *CNT to the number of
+ remaining values. If there are no entries in TP at all, returns
+ NULL. A yucky interface, admittedly, but it works. */
+static struct table_entry **
+find_pivot_extent_general (struct table_entry **tp, int *cnt, int pivot)
+{
+ struct table_entry *fp = *tp;
+ struct crosstab *x;
+
+ if (*cnt == 0)
+ return NULL;
+ x = xtab[(*tp)->table];
+ for (;;)
+ {
+ tp++;
+ if (--*cnt == 0)
+ break;
+ assert (*cnt > 0);
+
+ if ((*tp)->table != fp->table)
+ break;
+ if (pivot)
+ continue;
+
+ if (memcmp (&(*tp)->v[2], &fp->v[2], sizeof (union value) * (x->nvar - 2)))
+ break;
+ }
+
+ return tp;
+}
+
+/* Integer mode correspondent to find_pivot_extent_general(). This
+ could be optimized somewhat, but I just don't give a crap about
+ CROSSTABS performance in integer mode, which is just a wart on
+ CROSSTABS' ass as far as I'm concerned.
+
+ That said, feel free to send optimization patches to me. */
+static struct table_entry **
+find_pivot_extent_integer (struct table_entry **tp, int *cnt, int pivot)
+{
+ struct table_entry *fp = *tp;
+ struct crosstab *x;
+
+ if (*cnt == 0)
+ return NULL;
+ x = xtab[(*tp)->table];
+ for (;;)
+ {
+ tp++;
+ if (--*cnt == 0)
+ break;
+ assert (*cnt > 0);
+
+ if ((*tp)->table != fp->table)
+ break;
+ if (pivot)
+ continue;
+
+ if (memcmp (&(*tp)->v[2], &fp->v[2], sizeof (union value) * (x->nvar - 2)))
+ break;
+ }
+
+ return tp;
+}
+
+/* Compare value * A and B, where WIDTH is the string width or 0 for
+ numerics, and return a strcmp()-type result. */
+static int
+compare_value (const void *pa, const void *pb, void *pwidth)
+{
+ const union value *a = pa;
+ const union value *b = pb;
+ const int width = (int) pwidth;
+
+ if (width)
+ return strncmp (a->s, b->s, width);
+ else
+ return a->f < b->f ? -1 : (a->f > b->f ? 1 : 0);
+}
+
+/* Given a list of CNT table_entry's starting at BEG, creates a list
+ of *NVALUES values *VALUES of variable with index VAR_INDEX. */
+static void
+enum_var_values (struct table_entry **beg, int cnt, union value **values, int *nvalues,
+ int var_index)
+{
+ if (mode == GENERAL)
+ {
+ avl_tree *tree;
+
+ tree = avl_create (pl_col, compare_value,
+ (void *) (xtab[(*beg)->table]->v[var_index]->width));
+
+ {
+ int i;
+
+ for (i = 0; i < cnt; i++)
+ avl_insert (tree, &beg[i]->v[var_index]);
+ *values = xmalloc (sizeof **values * avl_count (tree));
+ }
+
+ {
+ avl_traverser trav;
+ union value *v;
+ int i;
+
+ i = 0;
+ hsh_iterator_init (trav);
+ while (NULL != (v = avl_traverse (tree, &trav)))
+ (*values)[i++] = *v;
+ *nvalues = i;
+ }
+
+ /* Destroy tree. */
+ pool_destroy (pl_col);
+ pl_col = pool_create ();
+ }
+ else
+ {
+ struct crosstab_proc *crs = &xtab[(*beg)->table]->v[var_index]->p.crs;
+ int i;
+
+ assert (mode == INTEGER);
+ *values = xmalloc (sizeof **values * crs->count);
+ for (i = 0; i < crs->count; i++)
+ (*values)[i].f = i + crs->min;
+ *nvalues = crs->count;
+ }
+}
+
+/* Sets cell (C,R) in TABLE, with options OPT, to have a value taken
+ from V, displayed with print format spec from variable VAR. When
+ in REPORT missing-value mode, missing values have an M appended. */
+static void
+table_value_missing (struct tab_table *table, int c, int r, unsigned char opt,
+ const union value *v, const struct variable *var)
+{
+ struct len_string s;
+
+ char *label = get_val_lab (var, *v, 0);
+ if (label)
+ {
+ tab_text (table, c, r, TAB_LEFT, label);
+ return;
+ }
+
+ s.length = var->print.w;
+ s.string = tab_alloc (table, s.length + 1);
+ data_out (s.string, &var->print, v);
+ if (cmd.miss == CRS_REPORT && is_num_user_missing (v->f, var))
+ s.string[s.length++] = 'M';
+ while (s.length && *s.string == ' ')
+ {
+ s.length--;
+ s.string++;
+ }
+ tab_raw (table, c, r, opt, &s);
+}
+
+/* Draws a line across TABLE at the current row to indicate the most
+ major dimension variable with index FIRST_DIFFERENCE out of NVAR
+ that changed, and puts the values that changed into the table. TB
+ and X must be the corresponding table_entry and crosstab,
+ respectively. */
+static void
+display_dimensions (struct tab_table *table, int first_difference, struct table_entry *tb)
+{
+ tab_hline (table, TAL_1, nvar - first_difference - 1, tab_nc (table) - 1, 0);
+
+ for (; first_difference >= 2; first_difference--)
+ table_value_missing (table, nvar - first_difference - 1, 0,
+ TAB_RIGHT, &tb->v[first_difference],
+ x->v[first_difference]);
+}
+
+/* Put value V into cell (C,R) of TABLE, suffixed with letter M. */
+static void
+float_M_suffix (struct tab_table *table, int c, int r, double v)
+{
+ static const struct fmt_spec f = {FMT_F, 8, 0};
+ struct len_string s;
+
+ s.length = 9;
+ s.string = tab_alloc (table, 9);
+ s.string[8] = 'M';
+ data_out (s.string, &f, (union value *) &v);
+ while (*s.string == ' ')
+ {
+ s.length--;
+ s.string++;
+ }
+ tab_raw (table, c, r, TAB_RIGHT, &s);
+}
+
+/* Displays the crosstabulation table. */
+static void
+display_crosstabulation (void)
+{
+ {
+ int r;
+
+ for (r = 0; r < n_rows; r++)
+ table_value_missing (table, nvar - 2, r * num_cells,
+ TAB_RIGHT, &rows[r], x->v[ROW_VAR]);
+ }
+ tab_text (table, nvar - 2, n_rows * num_cells,
+ TAB_LEFT, _("Total"));
+
+ /* Put in the actual cells. */
+ {
+ double *mp = mat;
+ int r, c, i;
+
+ tab_offset (table, nvar - 1, -1);
+ for (r = 0; r < n_rows; r++)
+ {
+ if (num_cells > 1)
+ tab_hline (table, TAL_1, -1, n_cols, 0);
+ for (c = 0; c < n_cols; c++)
+ {
+ double expected_value;
+
+ if (expected)
+ expected_value = row_tot[r] * col_tot[c] / W;
+ for (i = 0; i < num_cells; i++)
+ {
+ double v;
+
+ switch (cells[i])
+ {
+ case CRS_CL_COUNT:
+ v = *mp;
+ break;
+ case CRS_CL_ROW:
+ v = *mp / row_tot[r] * 100.;
+ break;
+ case CRS_CL_COLUMN:
+ v = *mp / col_tot[c] * 100.;
+ break;
+ case CRS_CL_TOTAL:
+ v = *mp / W * 100.;
+ break;
+ case CRS_CL_EXPECTED:
+ v = expected_value;
+ break;
+ case CRS_CL_RESIDUAL:
+ v = *mp - expected_value;
+ break;
+ case CRS_CL_SRESIDUAL:
+ v = (*mp - expected_value) / sqrt (expected_value);
+ break;
+ case CRS_CL_ASRESIDUAL:
+ v = ((*mp - expected_value)
+ / sqrt (expected_value
+ * (1. - row_tot[r] / W)
+ * (1. - col_tot[c] / W)));
+ break;
+ default:
+ assert (0);
+ }
+
+ if (cmd.miss == CRS_REPORT
+ && (is_num_user_missing (cols[c].f, x->v[COL_VAR])
+ || is_num_user_missing (rows[r].f, x->v[ROW_VAR])))
+ float_M_suffix (table, c, i, v);
+ else if (v != 0.)
+ tab_float (table, c, i, TAB_RIGHT, v, 8, 0);
+ }
+
+ mp++;
+ }
+
+ tab_offset (table, -1, tab_row (table) + num_cells);
+ }
+ }
+
+ /* Row totals. */
+ {
+ int r, i;
+
+ tab_offset (table, -1, tab_row (table) - num_cells * n_rows);
+ for (r = 0; r < n_rows; r++)
+ for (i = 0; i < num_cells; i++)
+ {
+ double v;
+
+ switch (cells[i])
+ {
+ case CRS_CL_COUNT:
+ v = row_tot[r];
+ break;
+ case CRS_CL_ROW:
+ v = 100.;
+ break;
+ case CRS_CL_COLUMN:
+ v = row_tot[r] / W * 100.;
+ break;
+ case CRS_CL_TOTAL:
+ v = row_tot[r] / W * 100.;
+ break;
+ case CRS_CL_EXPECTED:
+ case CRS_CL_RESIDUAL:
+ case CRS_CL_SRESIDUAL:
+ case CRS_CL_ASRESIDUAL:
+ v = 0.;
+ break;
+ default:
+ assert (0);
+ }
+
+ if (cmd.miss == CRS_REPORT
+ && is_num_user_missing (rows[r].f, x->v[ROW_VAR]))
+ float_M_suffix (table, n_cols, 0, v);
+ else if (v != 0.)
+ tab_float (table, n_cols, 0, TAB_RIGHT, v, 8, 0);
+
+ tab_next_row (table);
+ }
+ }
+
+ /* Column totals, grand total. */
+ {
+ int c, j;
+
+ if (num_cells > 1)
+ tab_hline (table, TAL_1, -1, n_cols, 0);
+ for (c = 0; c <= n_cols; c++)
+ {
+ double ct = c < n_cols ? col_tot[c] : W;
+ int i;
+
+ for (i = j = 0; i < num_cells; i++)
+ {
+ double v;
+
+ switch (cells[i])
+ {
+ case CRS_CL_COUNT:
+ v = ct;
+ break;
+ case CRS_CL_ROW:
+ v = ct / W * 100.;
+ break;
+ case CRS_CL_COLUMN:
+ v = 100.;
+ break;
+ case CRS_CL_TOTAL:
+ v = ct / W * 100.;
+ break;
+ case CRS_CL_EXPECTED:
+ case CRS_CL_RESIDUAL:
+ case CRS_CL_SRESIDUAL:
+ case CRS_CL_ASRESIDUAL:
+ continue;
+ default:
+ assert (0);
+ }
+
+ if (cmd.miss == CRS_REPORT && c < n_cols
+ && is_num_user_missing (cols[c].f, x->v[COL_VAR]))
+ float_M_suffix (table, c, j, v);
+ else if (v != 0.)
+ tab_float (table, c, j, TAB_RIGHT, v, 8, 0);
+
+ j++;
+ }
+ }
+
+ tab_offset (table, -1, tab_row (table) + j);
+ }
+
+ tab_offset (table, 0, -1);
+}
+
+static void calc_r (double *X, double *Y, double *, double *, double *);
+static void calc_chisq (double[N_CHISQ], int[N_CHISQ], double *, double *);
+
+/* Display chi-square statistics. */
+static void
+display_chisq (void)
+{
+ static const char *chisq_stats[N_CHISQ] =
+ {
+ N_("Pearson Chi-Square"),
+ N_("Likelihood Ratio"),
+ N_("Fisher's Exact Test"),
+ N_("Continuity Correction"),
+ N_("Linear-by-Linear Association"),
+ };
+ double chisq_v[N_CHISQ];
+ double fisher1, fisher2;
+ int df[N_CHISQ];
+ int s = 0;
+
+ int i;
+
+ calc_chisq (chisq_v, df, &fisher1, &fisher2);
+
+ tab_offset (chisq, nvar - 2, -1);
+
+ for (i = 0; i < N_CHISQ; i++)
+ {
+ if ((i != 2 && chisq_v[i] == SYSMIS)
+ || (i == 2 && fisher1 == SYSMIS))
+ continue;
+ s = 1;
+
+ tab_text (chisq, 0, 0, TAB_LEFT, gettext (chisq_stats[i]));
+ if (i != 2)
+ {
+ tab_float (chisq, 1, 0, TAB_RIGHT, chisq_v[i], 8, 3);
+ tab_float (chisq, 2, 0, TAB_RIGHT, df[i], 8, 0);
+ tab_float (chisq, 3, 0, TAB_RIGHT,
+ chisq_sig (chisq_v[i], df[i]), 8, 3);
+ }
+ else
+ {
+ chisq_fisher = 1;
+ tab_float (chisq, 4, 0, TAB_RIGHT, fisher2, 8, 3);
+ tab_float (chisq, 5, 0, TAB_RIGHT, fisher1, 8, 3);
+ }
+ tab_next_row (chisq);
+ }
+
+ tab_text (chisq, 0, 0, TAB_LEFT, _("N of Valid Cases"));
+ tab_float (chisq, 1, 0, TAB_RIGHT, W, 8, 0);
+ tab_next_row (chisq);
+
+ tab_offset (chisq, 0, -1);
+}
+
+static int calc_symmetric (double[N_SYMMETRIC], double[N_SYMMETRIC],
+ double[N_SYMMETRIC]);
+
+/* Display symmetric measures. */
+static void
+display_symmetric (void)
+{
+ static const char *categories[] =
+ {
+ N_("Nominal by Nominal"),
+ N_("Ordinal by Ordinal"),
+ N_("Interval by Interval"),
+ N_("Measure of Agreement"),
+ };
+
+ static const char *stats[N_SYMMETRIC] =
+ {
+ N_("Phi"),
+ N_("Cramer's V"),
+ N_("Contingency Coefficient"),
+ N_("Kendall's tau-b"),
+ N_("Kendall's tau-c"),
+ N_("Gamma"),
+ N_("Spearman Correlation"),
+ N_("Pearson's R"),
+ N_("Kappa"),
+ };
+
+ static const int stats_categories[N_SYMMETRIC] =
+ {
+ 0, 0, 0, 1, 1, 1, 1, 2, 3,
+ };
+
+ int last_cat = -1;
+ double sym_v[N_SYMMETRIC], sym_ase[N_SYMMETRIC], sym_t[N_SYMMETRIC];
+ int i;
+
+ if (!calc_symmetric (sym_v, sym_ase, sym_t))
+ return;
+
+ tab_offset (sym, nvar - 2, -1);
+
+ for (i = 0; i < N_SYMMETRIC; i++)
+ {
+ if (sym_v[i] == SYSMIS)
+ continue;
+
+ if (stats_categories[i] != last_cat)
+ {
+ last_cat = stats_categories[i];
+ tab_text (sym, 0, 0, TAB_LEFT, gettext (categories[last_cat]));
+ }
+
+ tab_text (sym, 1, 0, TAB_LEFT, gettext (stats[i]));
+ tab_float (sym, 2, 0, TAB_RIGHT, sym_v[i], 8, 3);
+ if (sym_ase[i] != SYSMIS)
+ tab_float (sym, 3, 0, TAB_RIGHT, sym_ase[i], 8, 3);
+ if (sym_t[i] != SYSMIS)
+ tab_float (sym, 4, 0, TAB_RIGHT, sym_t[i], 8, 3);
+ /*tab_float (sym, 5, 0, TAB_RIGHT, normal_sig (sym_v[i]), 8, 3);*/
+ tab_next_row (sym);
+ }
+
+ tab_text (sym, 0, 0, TAB_LEFT, _("N of Valid Cases"));
+ tab_float (sym, 2, 0, TAB_RIGHT, W, 8, 0);
+ tab_next_row (sym);
+
+ tab_offset (sym, 0, -1);
+}
+
+static int calc_risk (double[], double[], double[], union value *);
+
+/* Display risk estimate. */
+static void
+display_risk (void)
+{
+ char buf[256];
+ double risk_v[3], lower[3], upper[3];
+ union value c[2];
+ int i;
+
+ if (!calc_risk (risk_v, upper, lower, c))
+ return;
+
+ tab_offset (risk, nvar - 2, -1);
+
+ for (i = 0; i < 3; i++)
+ {
+ if (risk_v[i] == SYSMIS)
+ continue;
+
+ switch (i)
+ {
+ case 0:
+ if (x->v[COL_VAR]->type == NUMERIC)
+ sprintf (buf, _("Odds Ratio for %s (%g / %g)"),
+ x->v[COL_VAR]->name, c[0].f, c[1].f);
+ else
+ sprintf (buf, _("Odds Ratio for %s (%.*s / %.*s)"),
+ x->v[COL_VAR]->name,
+ x->v[COL_VAR]->width, c[0].s,
+ x->v[COL_VAR]->width, c[1].s);
+ break;
+ case 1:
+ case 2:
+ if (x->v[ROW_VAR]->type == NUMERIC)
+ sprintf (buf, _("For cohort %s = %g"),
+ x->v[ROW_VAR]->name, rows[i - 1].f);
+ else
+ sprintf (buf, _("For cohort %s = %.*s"),
+ x->v[ROW_VAR]->name,
+ x->v[ROW_VAR]->width, rows[i - 1].s);
+ break;
+ }
+
+ tab_text (risk, 0, 0, TAB_LEFT, buf);
+ tab_float (risk, 1, 0, TAB_RIGHT, risk_v[i], 8, 3);
+ tab_float (risk, 2, 0, TAB_RIGHT, lower[i], 8, 3);
+ tab_float (risk, 3, 0, TAB_RIGHT, upper[i], 8, 3);
+ tab_next_row (risk);
+ }
+
+ tab_text (risk, 0, 0, TAB_LEFT, _("N of Valid Cases"));
+ tab_float (risk, 1, 0, TAB_RIGHT, W, 8, 0);
+ tab_next_row (risk);
+
+ tab_offset (risk, 0, -1);
+}
+
+static int calc_directional (double[N_DIRECTIONAL], double[N_DIRECTIONAL],
+ double[N_DIRECTIONAL]);
+
+/* Display directional measures. */
+static void
+display_directional (void)
+{
+ static const char *categories[] =
+ {
+ N_("Nominal by Nominal"),
+ N_("Ordinal by Ordinal"),
+ N_("Nominal by Interval"),
+ };
+
+ static const char *stats[] =
+ {
+ N_("Lambda"),
+ N_("Goodman and Kruskal tau"),
+ N_("Uncertainty Coefficient"),
+ N_("Somers' d"),
+ N_("Eta"),
+ };
+
+ static const char *types[] =
+ {
+ N_("Symmetric"),
+ N_("%s Dependent"),
+ N_("%s Dependent"),
+ };
+
+ static const int stats_categories[N_DIRECTIONAL] =
+ {
+ 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 2, 2,
+ };
+
+ static const int stats_stats[N_DIRECTIONAL] =
+ {
+ 0, 0, 0, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4,
+ };
+
+ static const int stats_types[N_DIRECTIONAL] =
+ {
+ 0, 1, 2, 1, 2, 0, 1, 2, 0, 1, 2, 1, 2,
+ };
+
+ static const int *stats_lookup[] =
+ {
+ stats_categories,
+ stats_stats,
+ stats_types,
+ };
+
+ static const char **stats_names[] =
+ {
+ categories,
+ stats,
+ types,
+ };
+
+ int last[3] =
+ {
+ -1, -1, -1,
+ };
+
+ double direct_v[N_DIRECTIONAL];
+ double direct_ase[N_DIRECTIONAL];
+ double direct_t[N_DIRECTIONAL];
+
+ int i;
+
+ if (!calc_directional (direct_v, direct_ase, direct_t))
+ return;
+
+ tab_offset (direct, nvar - 2, -1);
+
+ for (i = 0; i < N_DIRECTIONAL; i++)
+ {
+ if (direct_v[i] == SYSMIS)
+ continue;
+
+ {
+ int j;
+
+ for (j = 0; j < 3; j++)
+ if (last[j] != stats_lookup[j][i])
+ {
+ if (j < 2)
+ tab_hline (direct, TAL_1, j, 6, 0);
+
+ for (; j < 3; j++)
+ {
+ char *string;
+ int k = last[j] = stats_lookup[j][i];
+
+ if (k == 0)
+ string = NULL;
+ else if (k == 1)
+ string = x->v[0]->name;
+ else
+ string = x->v[1]->name;
+
+ tab_text (direct, j, 0, TAB_LEFT | TAT_PRINTF,
+ gettext (stats_names[j][k]), string);
+ }
+ }
+ }
+
+ tab_float (direct, 3, 0, TAB_RIGHT, direct_v[i], 8, 3);
+ if (direct_ase[i] != SYSMIS)
+ tab_float (direct, 4, 0, TAB_RIGHT, direct_ase[i], 8, 3);
+ if (direct_t[i] != SYSMIS)
+ tab_float (direct, 5, 0, TAB_RIGHT, direct_t[i], 8, 3);
+ /*tab_float (direct, 6, 0, TAB_RIGHT, normal_sig (direct_v[i]), 8, 3);*/
+ tab_next_row (direct);
+ }
+
+ tab_offset (direct, 0, -1);
+}
+\f
+/* Statistical calculations. */
+
+/* Returns the value of the gamma (factorial) function for an integer
+ argument X. */
+double
+gamma_int (double x)
+{
+ double r = 1;
+ int i;
+
+ for (i = 2; i < x; i++)
+ r *= i;
+ return r;
+}
+
+/* Calculate P_r as specified in _SPSS Statistical Algorithms_,
+ Appendix 5. */
+static inline double
+Pr (int a, int b, int c, int d)
+{
+ return (gamma_int (a + b + 1.) / gamma_int (a + 1.)
+ * gamma_int (c + d + 1.) / gamma_int (b + 1.)
+ * gamma_int (a + c + 1.) / gamma_int (c + 1.)
+ * gamma_int (b + d + 1.) / gamma_int (d + 1.)
+ / gamma_int (a + b + c + d + 1.));
+}
+
+/* Swap the contents of A and B. */
+static inline void
+swap (int *a, int *b)
+{
+ int t = *a;
+ *a = *b;
+ *b = t;
+}
+
+/* Calculate significance for Fisher's exact test as specified in
+ _SPSS Statistical Algorithms_, Appendix 5. */
+static void
+calc_fisher (int a, int b, int c, int d, double *fisher1, double *fisher2)
+{
+ int x;
+
+ if (min (c, d) < min (a, b))
+ swap (&a, &c), swap (&b, &d);
+ if (min (b, d) < min (a, c))
+ swap (&a, &b), swap (&c, &d);
+ if (b * c < a * d)
+ {
+ if (b < c)
+ swap (&a, &b), swap (&c, &d);
+ else
+ swap (&a, &c), swap (&b, &d);
+ }
+
+ *fisher1 = 0.;
+ for (x = 0; x <= a; x++)
+ *fisher1 += Pr (a - x, b + x, c + x, d - x);
+
+ *fisher2 = *fisher1;
+ for (x = 1; x <= b; x++)
+ *fisher2 += Pr (a + x, b - x, c - x, d + x);
+}
+
+/* Calculates chi-squares into CHISQ. MAT is a matrix with N_COLS
+ columns with values COLS and N_ROWS rows with values ROWS. Values
+ in the matrix sum to W. */
+static void
+calc_chisq (double chisq[N_CHISQ], int df[N_CHISQ],
+ double *fisher1, double *fisher2)
+{
+ int r, c;
+
+ chisq[0] = chisq[1] = 0.;
+ chisq[2] = chisq[3] = chisq[4] = SYSMIS;
+ *fisher1 = *fisher2 = SYSMIS;
+
+ df[0] = df[1] = (ns_cols - 1) * (ns_rows - 1);
+
+ if (ns_rows <= 1 || ns_cols <= 1)
+ {
+ chisq[0] = chisq[1] = SYSMIS;
+ return;
+ }
+
+ for (r = 0; r < n_rows; r++)
+ for (c = 0; c < n_cols; c++)
+ {
+ const double expected = row_tot[r] * col_tot[c] / W;
+ const double freq = mat[n_cols * r + c];
+ const double residual = freq - expected;
+
+ if (expected)
+ chisq[0] += residual * residual / expected;
+ if (freq)
+ chisq[1] += freq * log (expected / freq);
+ }
+
+ if (chisq[0] == 0.)
+ chisq[0] = SYSMIS;
+
+ if (chisq[1] != 0.)
+ chisq[1] *= -2.;
+ else
+ chisq[1] = SYSMIS;
+
+ /* Calculate Yates and Fisher exact test. */
+ if (ns_cols == 2 && ns_rows == 2)
+ {
+ double f11, f12, f21, f22;
+
+ {
+ int nz_cols[2];
+ int i, j;
+
+ for (i = j = 0; i < n_cols; i++)
+ if (col_tot[i] != 0.)
+ {
+ nz_cols[j++] = i;
+ if (j == 2)
+ break;
+ }
+
+ assert (j == 2);
+
+ f11 = mat[nz_cols[0]];
+ f12 = mat[nz_cols[1]];
+ f21 = mat[nz_cols[0] + n_cols];
+ f22 = mat[nz_cols[1] + n_cols];
+ }
+
+ /* Yates. */
+ {
+ const double x = fabs (f11 * f22 - f12 * f21) - 0.5 * W;
+
+ if (x > 0.)
+ chisq[3] = (W * x * x
+ / (f11 + f12) / (f21 + f22)
+ / (f11 + f21) / (f12 + f22));
+ else
+ chisq[3] = 0.;
+
+ df[3] = 1.;
+ }
+
+ /* Fisher. */
+ if (f11 < 5. || f12 < 5. || f21 < 5. || f22 < 5.)
+ calc_fisher (f11 + .5, f12 + .5, f21 + .5, f22 + .5, fisher1, fisher2);
+ }
+
+ /* Calculate Mantel-Haenszel. */
+ if (x->v[ROW_VAR]->type == NUMERIC && x->v[COL_VAR]->type == NUMERIC)
+ {
+ double r, ase_0, ase_1;
+ calc_r ((double *) rows, (double *) cols, &r, &ase_0, &ase_1);
+
+ chisq[4] = (W - 1.) * r * r;
+ df[4] = 1;
+ }
+}
+
+/* Calculate the value of Pearson's r. r is stored into R, ase_1 into
+ ASE_1, and ase_0 into ASE_0. The row and column values must be
+ passed in X and Y. */
+static void
+calc_r (double *X, double *Y, double *r, double *ase_0, double *ase_1)
+{
+ double SX, SY, S, T;
+ double Xbar, Ybar;
+ double sum_XYf, sum_X2Y2f;
+ double sum_Xr, sum_X2r;
+ double sum_Yc, sum_Y2c;
+ int i, j;
+
+ for (sum_X2Y2f = sum_XYf = 0., i = 0; i < n_rows; i++)
+ for (j = 0; j < n_cols; j++)
+ {
+ double fij = mat[j + i * n_cols];
+ double product = X[i] * Y[j];
+ double temp = fij * product;
+ sum_XYf += temp;
+ sum_X2Y2f += temp * product;
+ }
+
+ for (sum_Xr = sum_X2r = 0., i = 0; i < n_rows; i++)
+ {
+ sum_Xr += X[i] * row_tot[i];
+ sum_X2r += X[i] * X[i] * row_tot[i];
+ }
+ Xbar = sum_Xr / W;
+
+ for (sum_Yc = sum_Y2c = 0., i = 0; i < n_cols; i++)
+ {
+ sum_Yc += Y[i] * col_tot[i];
+ sum_Y2c += Y[i] * Y[i] * col_tot[i];
+ }
+ Ybar = sum_Yc / W;
+
+ S = sum_XYf - sum_Xr * sum_Yc / W;
+ SX = sum_X2r - sum_Xr * sum_Xr / W;
+ SY = sum_Y2c - sum_Yc * sum_Yc / W;
+ T = sqrt (SX * SY);
+ *r = S / T;
+ *ase_0 = sqrt ((sum_X2Y2f - (sum_XYf * sum_XYf) / W) / (sum_X2r * sum_Y2c));
+
+ {
+ double s, c, y, t;
+
+ for (s = c = 0., i = 0; i < n_rows; i++)
+ for (j = 0; j < n_cols; j++)
+ {
+ double Xresid, Yresid;
+ double temp;
+
+ Xresid = X[i] - Xbar;
+ Yresid = Y[j] - Ybar;
+ temp = (T * Xresid * Yresid
+ - ((S / (2. * T))
+ * (Xresid * Xresid * SY + Yresid * Yresid * SX)));
+ y = mat[j + i * n_cols] * temp * temp - c;
+ t = s + y;
+ c = (t - s) - y;
+ s = t;
+ }
+ *ase_1 = sqrt (s) / (T * T);
+ }
+}
+
+static double somers_d_v[3];
+static double somers_d_ase[3];
+static double somers_d_t[3];
+
+/* Calculate symmetric statistics and their asymptotic standard
+ errors. Returns 0 if none could be calculated. */
+static int
+calc_symmetric (double v[N_SYMMETRIC], double ase[N_SYMMETRIC],
+ double t[N_SYMMETRIC])
+{
+ int q = min (ns_rows, ns_cols);
+
+ if (q <= 1)
+ return 0;
+
+ {
+ int i;
+
+ if (v)
+ for (i = 0; i < N_SYMMETRIC; i++)
+ v[i] = ase[i] = t[i] = SYSMIS;
+ }
+
+ /* Phi, Cramer's V, contingency coefficient. */
+ if (cmd.a_statistics[CRS_ST_PHI] || cmd.a_statistics[CRS_ST_CC])
+ {
+ double Xp = 0.; /* Pearson chi-square. */
+
+ {
+ int r, c;
+
+ for (r = 0; r < n_rows; r++)
+ for (c = 0; c < n_cols; c++)
+ {
+ const double expected = row_tot[r] * col_tot[c] / W;
+ const double freq = mat[n_cols * r + c];
+ const double residual = freq - expected;
+
+ if (expected)
+ Xp += residual * residual / expected;
+ }
+ }
+
+ if (cmd.a_statistics[CRS_ST_PHI])
+ {
+ v[0] = sqrt (Xp / W);
+ v[1] = sqrt (Xp / (W * (q - 1)));
+ }
+ if (cmd.a_statistics[CRS_ST_CC])
+ v[2] = sqrt (Xp / (Xp + W));
+ }
+
+ if (cmd.a_statistics[CRS_ST_BTAU] || cmd.a_statistics[CRS_ST_CTAU]
+ || cmd.a_statistics[CRS_ST_GAMMA] || cmd.a_statistics[CRS_ST_D])
+ {
+ double *cum;
+ double Dr, Dc;
+ double P, Q;
+ double btau_cum, ctau_cum, gamma_cum, d_yx_cum, d_xy_cum;
+ double btau_var;
+
+ {
+ int r, c;
+
+ Dr = Dc = W * W;
+ for (r = 0; r < n_rows; r++)
+ Dr -= row_tot[r] * row_tot[r];
+ for (c = 0; c < n_cols; c++)
+ Dc -= col_tot[c] * col_tot[c];
+ }
+
+ {
+ int r, c;
+
+ cum = xmalloc (sizeof *cum * n_cols * n_rows);
+ for (c = 0; c < n_cols; c++)
+ {
+ double ct = 0.;
+
+ for (r = 0; r < n_rows; r++)
+ cum[c + r * n_cols] = ct += mat[c + r * n_cols];
+ }
+ }
+
+ /* P and Q. */
+ {
+ int i, j;
+ double Cij, Dij;
+
+ P = Q = 0.;
+ for (i = 0; i < n_rows; i++)
+ {
+ Cij = Dij = 0.;
+
+ for (j = 1; j < n_cols; j++)
+ Cij += col_tot[j] - cum[j + i * n_cols];
+
+ if (i > 0)
+ for (j = 1; j < n_cols; j++)
+ Dij += cum[j + (i - 1) * n_cols];
+
+ for (j = 0;;)
+ {
+ double fij = mat[j + i * n_cols];
+ P += fij * Cij;
+ Q += fij * Dij;
+
+ if (++j == n_cols)
+ break;
+ assert (j < n_cols);
+
+ Cij -= col_tot[j] - cum[j + i * n_cols];
+ Dij += col_tot[j - 1] - cum[j - 1 + i * n_cols];
+
+ if (i > 0)
+ {
+ Cij += cum[j - 1 + (i - 1) * n_cols];
+ Dij -= cum[j + (i - 1) * n_cols];
+ }
+ }
+ }
+ }
+
+ if (cmd.a_statistics[CRS_ST_BTAU])
+ v[3] = (P - Q) / sqrt (Dr * Dc);
+ if (cmd.a_statistics[CRS_ST_CTAU])
+ v[4] = (q * (P - Q)) / ((W * W) * (q - 1));
+ if (cmd.a_statistics[CRS_ST_GAMMA])
+ v[5] = (P - Q) / (P + Q);
+
+ /* ASE for tau-b, tau-c, gamma. Calculations could be
+ eliminated here, at expense of memory. */
+ {
+ int i, j;
+ double Cij, Dij;
+
+ btau_cum = ctau_cum = gamma_cum = d_yx_cum = d_xy_cum = 0.;
+ for (i = 0; i < n_rows; i++)
+ {
+ Cij = Dij = 0.;
+
+ for (j = 1; j < n_cols; j++)
+ Cij += col_tot[j] - cum[j + i * n_cols];
+
+ if (i > 0)
+ for (j = 1; j < n_cols; j++)
+ Dij += cum[j + (i - 1) * n_cols];
+
+ for (j = 0;;)
+ {
+ double fij = mat[j + i * n_cols];
+
+ if (cmd.a_statistics[CRS_ST_BTAU])
+ {
+ const double temp = (2. * sqrt (Dr * Dc) * (Cij - Dij)
+ + v[3] * (row_tot[i] * Dc
+ + col_tot[j] * Dr));
+ btau_cum += fij * temp * temp;
+ }
+
+ {
+ const double temp = Cij - Dij;
+ ctau_cum += fij * temp * temp;
+ }
+
+ if (cmd.a_statistics[CRS_ST_GAMMA])
+ {
+ const double temp = Q * Cij - P * Dij;
+ gamma_cum += fij * temp * temp;
+ }
+
+ if (cmd.a_statistics[CRS_ST_D])
+ {
+ d_yx_cum += fij * sqr (Dr * (Cij - Dij)
+ - (P - Q) * (W - row_tot[i]));
+ d_xy_cum += fij * sqr (Dc * (Dij - Cij)
+ - (Q - P) * (W - col_tot[j]));
+ }
+
+ if (++j == n_cols)
+ break;
+ assert (j < n_cols);
+
+ Cij -= col_tot[j] - cum[j + i * n_cols];
+ Dij += col_tot[j - 1] - cum[j - 1 + i * n_cols];
+
+ if (i > 0)
+ {
+ Cij += cum[j - 1 + (i - 1) * n_cols];
+ Dij -= cum[j + (i - 1) * n_cols];
+ }
+ }
+ }
+ }
+
+ btau_var = ((btau_cum
+ - (W * sqr (W * (P - Q) / sqrt (Dr * Dc) * (Dr + Dc))))
+ / sqr (Dr * Dc));
+ if (cmd.a_statistics[CRS_ST_BTAU])
+ {
+ ase[3] = sqrt (btau_var);
+ t[3] = v[3] / (2 * sqrt ((ctau_cum - (P - Q) * (P - Q) / W)
+ / (Dr * Dc)));
+ }
+ if (cmd.a_statistics[CRS_ST_CTAU])
+ {
+ ase[4] = ((2 * q / ((q - 1) * W * W))
+ * sqrt (ctau_cum - (P - Q) * (P - Q) / W));
+ t[4] = v[4] / ase[4];
+ }
+ if (cmd.a_statistics[CRS_ST_GAMMA])
+ {
+ ase[5] = ((4. / ((P + Q) * (P + Q))) * sqrt (gamma_cum));
+ t[5] = v[5] / (2. / (P + Q)
+ * sqrt (ctau_cum - (P - Q) * (P - Q) / W));
+ }
+ if (cmd.a_statistics[CRS_ST_D])
+ {
+ somers_d_v[0] = (P - Q) / (.5 * (Dc + Dr));
+ somers_d_ase[0] = 2. * btau_var / (Dr + Dc) * sqrt (Dr * Dc);
+ somers_d_t[0] = (somers_d_v[0]
+ / (4 / (Dc + Dr)
+ * sqrt (ctau_cum - sqr (P - Q) / W)));
+ somers_d_v[1] = (P - Q) / Dc;
+ somers_d_ase[1] = 2. / sqr (Dc) * sqrt (d_xy_cum);
+ somers_d_t[1] = (somers_d_v[1]
+ / (2. / Dc
+ * sqrt (ctau_cum - sqr (P - Q) / W)));
+ somers_d_v[2] = (P - Q) / Dr;
+ somers_d_ase[2] = 2. / sqr (Dr) * sqrt (d_yx_cum);
+ somers_d_t[2] = (somers_d_v[2]
+ / (2. / Dr
+ * sqrt (ctau_cum - sqr (P - Q) / W)));
+ }
+
+ free (cum);
+ }
+
+ /* Spearman correlation, Pearson's r. */
+ if (cmd.a_statistics[CRS_ST_CORR])
+ {
+ double *R = local_alloc (sizeof *R * n_rows);
+ double *C = local_alloc (sizeof *C * n_cols);
+
+ {
+ double y, t, c = 0., s = 0.;
+ int i = 0;
+
+ for (;;)
+ {
+ R[i] = s + (row_tot[i] + 1.) / 2.;
+ y = row_tot[i] - c;
+ t = s + y;
+ c = (t - s) - y;
+ s = t;
+ if (++i == n_rows)
+ break;
+ assert (i < n_rows);
+ }
+ }
+
+ {
+ double y, t, c = 0., s = 0.;
+ int j = 0;
+
+ for (;;)
+ {
+ C[j] = s + (col_tot[j] + 1.) / 2;
+ y = col_tot[j] - c;
+ t = s + y;
+ c = (t - s) - y;
+ s = t;
+ if (++j == n_cols)
+ break;
+ assert (j < n_cols);
+ }
+ }
+
+ calc_r (R, C, &v[6], &t[6], &ase[6]);
+ t[6] = v[6] / t[6];
+
+ local_free (R);
+ local_free (C);
+
+ calc_r ((double *) rows, (double *) cols, &v[7], &t[7], &ase[7]);
+ t[7] = v[7] / t[7];
+ }
+
+ /* Cohen's kappa. */
+ if (cmd.a_statistics[CRS_ST_KAPPA] && ns_rows == ns_cols)
+ {
+ double sum_fii, sum_rici, sum_fiiri_ci, sum_fijri_ci2, sum_riciri_ci;
+ int i, j;
+
+ for (sum_fii = sum_rici = sum_fiiri_ci = sum_riciri_ci = 0., i = j = 0;
+ i < ns_rows; i++, j++)
+ {
+ double prod, sum;
+
+ while (col_tot[j] == 0.)
+ j++;
+
+ prod = row_tot[i] * col_tot[j];
+ sum = row_tot[i] + col_tot[j];
+
+ sum_fii += mat[j + i * n_cols];
+ sum_rici += prod;
+ sum_fiiri_ci += mat[j + i * n_cols] * sum;
+ sum_riciri_ci += prod * sum;
+ }
+ for (sum_fijri_ci2 = 0., i = 0; i < ns_rows; i++)
+ for (j = 0; j < ns_cols; j++)
+ {
+ double sum = row_tot[i] + col_tot[j];
+ sum_fijri_ci2 += mat[j + i * n_cols] * sum * sum;
+ }
+
+ v[8] = (W * sum_fii - sum_rici) / (W * W - sum_rici);
+
+ ase[8] = sqrt ((W * W * sum_rici
+ + sum_rici * sum_rici
+ - W * sum_riciri_ci)
+ / (W * (W * W - sum_rici) * (W * W - sum_rici)));
+#if 0
+ t[8] = v[8] / sqrt (W * (((sum_fii * (W - sum_fii))
+ / sqr (W * W - sum_rici))
+ + ((2. * (W - sum_fii)
+ * (2. * sum_fii * sum_rici
+ - W * sum_fiiri_ci))
+ / cube (W * W - sum_rici))
+ + (sqr (W - sum_fii)
+ * (W * sum_fijri_ci2 - 4.
+ * sum_rici * sum_rici)
+ / hypercube (W * W - sum_rici))));
+#else
+ t[8] = v[8] / ase[8];
+#endif
+ }
+
+ return 1;
+}
+
+/* Calculate risk estimate. */
+static int
+calc_risk (double *value, double *upper, double *lower, union value *c)
+{
+ double f11, f12, f21, f22;
+ double v;
+
+ {
+ int i;
+
+ for (i = 0; i < 3; i++)
+ value[i] = upper[i] = lower[i] = SYSMIS;
+ }
+
+ if (ns_rows != 2 || ns_cols != 2)
+ return 0;
+
+ {
+ int nz_cols[2];
+ int i, j;
+
+ for (i = j = 0; i < n_cols; i++)
+ if (col_tot[i] != 0.)
+ {
+ nz_cols[j++] = i;
+ if (j == 2)
+ break;
+ }
+
+ assert (j == 2);
+
+ f11 = mat[nz_cols[0]];
+ f12 = mat[nz_cols[1]];
+ f21 = mat[nz_cols[0] + n_cols];
+ f22 = mat[nz_cols[1] + n_cols];
+
+ c[0] = cols[nz_cols[0]];
+ c[1] = cols[nz_cols[1]];
+ }
+
+ value[0] = (f11 * f22) / (f12 * f21);
+ v = sqrt (1. / f11 + 1. / f12 + 1. / f21 + 1. / f22);
+ lower[0] = value[0] * exp (-1.960 * v);
+ upper[0] = value[0] * exp (1.960 * v);
+
+ value[1] = (f11 * (f21 + f22)) / (f21 * (f11 + f12));
+ v = sqrt ((f12 / (f11 * (f11 + f12)))
+ + (f22 / (f21 * (f21 + f22))));
+ lower[1] = value[1] * exp (-1.960 * v);
+ upper[1] = value[1] * exp (1.960 * v);
+
+ value[2] = (f12 * (f21 + f22)) / (f22 * (f11 + f12));
+ v = sqrt ((f11 / (f12 * (f11 + f12)))
+ + (f21 / (f22 * (f21 + f22))));
+ lower[2] = value[2] * exp (-1.960 * v);
+ upper[2] = value[2] * exp (1.960 * v);
+
+ return 1;
+}
+
+/* Calculate directional measures. */
+static int
+calc_directional (double v[N_DIRECTIONAL], double ase[N_DIRECTIONAL],
+ double t[N_DIRECTIONAL])
+{
+ {
+ int i;
+
+ for (i = 0; i < N_DIRECTIONAL; i++)
+ v[i] = ase[i] = t[i] = SYSMIS;
+ }
+
+ /* Lambda. */
+ if (cmd.a_statistics[CRS_ST_LAMBDA])
+ {
+ double *fim = xmalloc (sizeof *fim * n_rows);
+ int *fim_index = xmalloc (sizeof *fim_index * n_rows);
+ double *fmj = xmalloc (sizeof *fmj * n_cols);
+ int *fmj_index = xmalloc (sizeof *fmj_index * n_cols);
+ double sum_fim, sum_fmj;
+ double rm, cm;
+ int rm_index, cm_index;
+ int i, j;
+
+ /* Find maximum for each row and their sum. */
+ for (sum_fim = 0., i = 0; i < n_rows; i++)
+ {
+ double max = mat[i * n_cols];
+ int index = 0;
+
+ for (j = 1; j < n_cols; j++)
+ if (mat[j + i * n_cols] > max)
+ {
+ max = mat[j + i * n_cols];
+ index = j;
+ }
+
+ sum_fim += fim[i] = max;
+ fim_index[i] = index;
+ }
+
+ /* Find maximum for each column. */
+ for (sum_fmj = 0., j = 0; j < n_cols; j++)
+ {
+ double max = mat[j];
+ int index = 0;
+
+ for (i = 1; i < n_rows; i++)
+ if (mat[j + i * n_cols] > max)
+ {
+ max = mat[j + i * n_cols];
+ index = i;
+ }
+
+ sum_fmj += fmj[j] = max;
+ fmj_index[j] = index;
+ }
+
+ /* Find maximum row total. */
+ rm = row_tot[0];
+ rm_index = 0;
+ for (i = 1; i < n_rows; i++)
+ if (row_tot[i] > rm)
+ {
+ rm = row_tot[i];
+ rm_index = i;
+ }
+
+ /* Find maximum column total. */
+ cm = col_tot[0];
+ cm_index = 0;
+ for (j = 1; j < n_cols; j++)
+ if (col_tot[j] > cm)
+ {
+ cm = col_tot[j];
+ cm_index = j;
+ }
+
+ v[0] = (sum_fim + sum_fmj - cm - rm) / (2. * W - rm - cm);
+ v[1] = (sum_fmj - rm) / (W - rm);
+ v[2] = (sum_fim - cm) / (W - cm);
+
+ /* ASE1 for Y given X. */
+ {
+ double accum;
+
+ for (accum = 0., i = 0; i < n_rows; i++)
+ for (j = 0; j < n_cols; j++)
+ {
+ const int deltaj = j == cm_index;
+ accum += (mat[j + i * n_cols]
+ * sqr ((j == fim_index[i])
+ - deltaj
+ + v[0] * deltaj));
+ }
+
+ ase[2] = sqrt (accum - W * v[0]) / (W - cm);
+ }
+
+ /* ASE0 for Y given X. */
+ {
+ double accum;
+
+ for (accum = 0., i = 0; i < n_rows; i++)
+ if (cm_index != fim_index[i])
+ accum += (mat[i * n_cols + fim_index[i]]
+ + mat[i * n_cols + cm_index]);
+ t[2] = v[2] / (sqrt (accum - sqr (sum_fim - cm) / W) / (W - cm));
+ }
+
+ /* ASE1 for X given Y. */
+ {
+ double accum;
+
+ for (accum = 0., i = 0; i < n_rows; i++)
+ for (j = 0; j < n_cols; j++)
+ {
+ const int deltaj = i == rm_index;
+ accum += (mat[j + i * n_cols]
+ * sqr ((i == fmj_index[j])
+ - deltaj
+ + v[0] * deltaj));
+ }
+
+ ase[1] = sqrt (accum - W * v[0]) / (W - rm);
+ }
+
+ /* ASE0 for X given Y. */
+ {
+ double accum;
+
+ for (accum = 0., j = 0; j < n_cols; j++)
+ if (rm_index != fmj_index[j])
+ accum += (mat[j + n_cols * fmj_index[j]]
+ + mat[j + n_cols * rm_index]);
+ t[1] = v[1] / (sqrt (accum - sqr (sum_fmj - rm) / W) / (W - rm));
+ }
+
+ /* Symmetric ASE0 and ASE1. */
+ {
+ double accum0;
+ double accum1;
+
+ for (accum0 = accum1 = 0., i = 0; i < n_rows; i++)
+ for (j = 0; j < n_cols; j++)
+ {
+ int temp0 = (fmj_index[j] == i) + (fim_index[i] == j);
+ int temp1 = (i == rm_index) + (j == cm_index);
+ accum0 += mat[j + i * n_cols] * sqr (temp0 - temp1);
+ accum1 += (mat[j + i * n_cols]
+ * sqr (temp0 + (v[0] - 1.) * temp1));
+ }
+ ase[0] = sqrt (accum1 - 4. * W * v[0] * v[0]) / (2. * W - rm - cm);
+ t[0] = v[0] / (sqrt (accum0 - sqr ((sum_fim + sum_fmj - cm - rm) / W))
+ / (2. * W - rm - cm));
+ }
+
+ free (fim);
+ free (fim_index);
+ free (fmj);
+ free (fmj_index);
+
+ {
+ double sum_fij2_ri, sum_fij2_ci;
+ double sum_ri2, sum_cj2;
+
+ for (sum_fij2_ri = sum_fij2_ci = 0., i = 0; i < n_rows; i++)
+ for (j = 0; j < n_cols; j++)
+ {
+ double temp = sqr (mat[j + i * n_cols]);
+ sum_fij2_ri += temp / row_tot[i];
+ sum_fij2_ci += temp / col_tot[j];
+ }
+
+ for (sum_ri2 = 0., i = 0; i < n_rows; i++)
+ sum_ri2 += row_tot[i] * row_tot[i];
+
+ for (sum_cj2 = 0., j = 0; j < n_cols; j++)
+ sum_cj2 += col_tot[j] * col_tot[j];
+
+ v[3] = (W * sum_fij2_ci - sum_ri2) / (W * W - sum_ri2);
+ v[4] = (W * sum_fij2_ri - sum_cj2) / (W * W - sum_cj2);
+ }
+ }
+
+ if (cmd.a_statistics[CRS_ST_UC])
+ {
+ double UX, UY, UXY, P;
+ double ase1_yx, ase1_xy, ase1_sym;
+ int i, j;
+
+ for (UX = 0., i = 0; i < n_rows; i++)
+ if (row_tot[i] > 0.)
+ UX -= row_tot[i] / W * log (row_tot[i] / W);
+
+ for (UY = 0., j = 0; j < n_cols; j++)
+ if (col_tot[j] > 0.)
+ UY -= col_tot[j] / W * log (col_tot[j] / W);
+
+ for (UXY = P = 0., i = 0; i < n_rows; i++)
+ for (j = 0; j < n_cols; j++)
+ {
+ double entry = mat[j + i * n_cols];
+
+ if (entry <= 0.)
+ continue;
+
+ P += entry * sqr (log (col_tot[j] * row_tot[i] / (W * entry)));
+ UXY -= entry / W * log (entry / W);
+ }
+
+ for (ase1_yx = ase1_xy = ase1_sym = 0., i = 0; i < n_rows; i++)
+ for (j = 0; j < n_cols; j++)
+ {
+ double entry = mat[j + i * n_cols];
+
+ if (entry <= 0.)
+ continue;
+
+ ase1_yx += entry * sqr (UY * log (entry / row_tot[i])
+ + (UX - UXY) * log (col_tot[j] / W));
+ ase1_xy += entry * sqr (UX * log (entry / col_tot[j])
+ + (UY - UXY) * log (row_tot[i] / W));
+ ase1_sym += entry * sqr ((UXY
+ * log (row_tot[i] * col_tot[j] / (W * W)))
+ - (UX + UY) * log (entry / W));
+ }
+
+ v[5] = 2. * ((UX + UY - UXY) / (UX + UY));
+ ase[5] = (2. / (W * sqr (UX + UY))) * sqrt (ase1_sym);
+ t[5] = v[5] / ((2. / (W * (UX + UY)))
+ * sqrt (P - sqr (UX + UY - UXY) / W));
+
+ v[6] = (UX + UY - UXY) / UX;
+ ase[6] = sqrt (ase1_xy) / (W * UX * UX);
+ t[6] = v[6] / (sqrt (P - W * sqr (UX + UY - UXY)) / (W * UX));
+
+ v[7] = (UX + UY - UXY) / UY;
+ ase[7] = sqrt (ase1_yx) / (W * UY * UY);
+ t[7] = v[7] / (sqrt (P - W * sqr (UX + UY - UXY)) / (W * UY));
+ }
+
+ /* Somers' D. */
+ if (cmd.a_statistics[CRS_ST_D])
+ {
+ int i;
+
+ if (!sym)
+ calc_symmetric (NULL, NULL, NULL);
+ for (i = 0; i < 3; i++)
+ {
+ v[8 + i] = somers_d_v[i];
+ ase[8 + i] = somers_d_ase[i];
+ t[8 + i] = somers_d_t[i];
+ }
+ }
+
+ /* Eta. */
+ if (cmd.a_statistics[CRS_ST_ETA])
+ {
+ {
+ double sum_Xr, sum_X2r;
+ double SX, SXW;
+ int i, j;
+
+ for (sum_Xr = sum_X2r = 0., i = 0; i < n_rows; i++)
+ {
+ sum_Xr += rows[i].f * row_tot[i];
+ sum_X2r += rows[i].f * rows[i].f * row_tot[i];
+ }
+ SX = sum_X2r - sum_Xr * sum_Xr / W;
+
+ for (SXW = 0., j = 0; j < n_cols; j++)
+ {
+ double cum;
+
+ for (cum = 0., i = 0; i < n_rows; i++)
+ {
+ SXW += rows[i].f * rows[i].f * mat[j + i * n_cols];
+ cum += rows[i].f * mat[j + i * n_cols];
+ }
+
+ SXW -= cum * cum / col_tot[j];
+ }
+ v[11] = sqrt (1. - SXW / SX);
+ }
+
+ {
+ double sum_Yc, sum_Y2c;
+ double SY, SYW;
+ int i, j;
+
+ for (sum_Yc = sum_Y2c = 0., i = 0; i < n_cols; i++)
+ {
+ sum_Yc += cols[i].f * col_tot[i];
+ sum_Y2c += cols[i].f * cols[i].f * col_tot[i];
+ }
+ SY = sum_Y2c - sum_Yc * sum_Yc / W;
+
+ for (SYW = 0., i = 0; i < n_rows; i++)
+ {
+ double cum;
+
+ for (cum = 0., j = 0; j < n_cols; j++)
+ {
+ SYW += cols[j].f * cols[j].f * mat[j + i * n_cols];
+ cum += cols[j].f * mat[j + i * n_cols];
+ }
+
+ SYW -= cum * cum / row_tot[i];
+ }
+ v[12] = sqrt (1. - SYW / SY);
+ }
+ }
+
+ return 1;
+}
+
+/*
+ Local Variables:
+ mode: c
+ End:
+*/
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <math.h>
+#include <ctype.h>
+#include <stdarg.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "data-in.h"
+#include "error.h"
+#include "getline.h"
+#include "julcal/julcal.h"
+#include "lexer.h"
+#include "magic.h"
+#include "misc.h"
+#include "settings.h"
+#include "str.h"
+#include "var.h"
+\f
+#undef DEBUGGING
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+
+\f
+/* Specialized error routine. */
+
+static void dls_error (const struct data_in *, const char *format, ...)
+ __attribute__ ((format (printf, 2, 3)));
+
+static void
+dls_error (const struct data_in *i, const char *format, ...)
+{
+ char buf[1024];
+
+ if (i->flags & DI_IGNORE_ERROR)
+ return;
+
+ {
+ va_list args;
+
+ va_start (args, format);
+ snprintf (buf, 1024, format, args);
+ va_end (args);
+ }
+
+ {
+ struct error e;
+ struct string title;
+
+ ds_init (NULL, &title, 64);
+ if (!getl_reading_script)
+ ds_concat (&title, _("data-file error: "));
+ if (i->f1 == i->f2)
+ ds_printf (&title, _("(column %d"), i->f1);
+ else
+ ds_printf (&title, _("(columns %d-%d"), i->f1, i->f2);
+ ds_printf (&title, _(", field type %s) "), fmt_to_string (&i->format));
+
+ e.class = DE;
+ err_location (&e.where);
+ e.title = ds_value (&title);
+ e.text = buf;
+
+ err_vmsg (&e);
+
+ ds_destroy (&title);
+ }
+}
+
+/* Excludes leading and trailing whitespace from I by adjusting
+ pointers. */
+static void
+trim_whitespace (struct data_in *i)
+{
+ while (i->s < i->e && isspace (i->s[0]))
+ i->s++;
+
+ while (i->s < i->e && isspace (i->e[-1]))
+ i->e--;
+}
+
+/* Returns nonzero if we're not at the end of the string being
+ parsed. */
+static inline int
+have_char (struct data_in *i)
+{
+ return i->s < i->e;
+}
+\f
+/* Format parsers. */
+
+static int parse_int (struct data_in *i, long *result);
+
+/* This function is based on strtod() from the GNU C library. */
+static int
+parse_numeric (struct data_in *i)
+{
+ short int sign; /* +1 or -1. */
+ double num; /* The number so far. */
+
+ int got_dot; /* Found a decimal point. */
+ int got_digit; /* Count of digits. */
+
+ int decimal; /* Decimal point character. */
+ int grouping; /* Grouping character. */
+
+ long int exponent; /* Number's exponent. */
+ int type; /* Usually same as i->format.type. */
+
+ trim_whitespace (i);
+
+ type = i->format.type;
+ if (type == FMT_DOLLAR && have_char (i) && *i->s == '$')
+ {
+ i->s++;
+ type = FMT_COMMA;
+ }
+
+ /* Get the sign. */
+ if (have_char (i))
+ {
+ sign = *i->s == '-' ? -1 : 1;
+ if (*i->s == '-' || *i->s == '+')
+ i->s++;
+ }
+
+ if (type != FMT_DOT)
+ {
+ decimal = set_decimal;
+ grouping = set_grouping;
+ }
+ else
+ {
+ decimal = set_grouping;
+ grouping = set_decimal;
+ }
+
+ i->v->f = SYSMIS;
+ num = 0.0;
+ got_dot = 0;
+ got_digit = 0;
+ exponent = 0;
+ for (; have_char (i); i->s++)
+ {
+ if (isdigit (*i->s))
+ {
+ got_digit++;
+
+ /* Make sure that multiplication by 10 will not overflow. */
+ if (num > DBL_MAX * 0.1)
+ /* The value of the digit doesn't matter, since we have already
+ gotten as many digits as can be represented in a `double'.
+ This doesn't necessarily mean the result will overflow.
+ The exponent may reduce it to within range.
+
+ We just need to record that there was another
+ digit so that we can multiply by 10 later. */
+ ++exponent;
+ else
+ num = (num * 10.0) + (*i->s - '0');
+
+ /* Keep track of the number of digits after the decimal point.
+ If we just divided by 10 here, we would lose precision. */
+ if (got_dot)
+ --exponent;
+ }
+ else if (!got_dot && *i->s == decimal)
+ /* Record that we have found the decimal point. */
+ got_dot = 1;
+ else if ((type != FMT_COMMA && type != FMT_DOT) || *i->s != grouping)
+ /* Any other character terminates the number. */
+ break;
+ }
+
+ if (!got_digit)
+ {
+ if (got_dot)
+ {
+ i->v->f = SYSMIS;
+ return 1;
+ }
+ goto noconv;
+ }
+
+ if (have_char (i)
+ && (tolower (*i->s) == 'e' || tolower (*i->s) == 'd'
+ || (type == FMT_E && (*i->s == '+' || *i->s == '-'))))
+ {
+ /* Get the exponent specified after the `e' or `E'. */
+ long exp;
+
+ if (isalpha (*i->s))
+ i->s++;
+ if (!parse_int (i, &exp))
+ goto noconv;
+
+ exponent += exp;
+ }
+ else if (!got_dot)
+ exponent -= i->format.d;
+
+ if (type == FMT_PCT && have_char (i) && *i->s == '%')
+ i->s++;
+ if (i->s < i->e)
+ {
+ dls_error (i, _("Field contents followed by garbage."));
+ i->v->f = SYSMIS;
+ return 0;
+ }
+
+ if (num == 0.0)
+ {
+ i->v->f = 0.0;
+ return 1;
+ }
+
+ /* Multiply NUM by 10 to the EXPONENT power, checking for overflow
+ and underflow. */
+
+ if (exponent < 0)
+ {
+ if (-exponent + got_digit > -(DBL_MIN_10_EXP) + 5
+ || num < DBL_MIN * pow (10.0, (double) -exponent))
+ goto underflow;
+ num *= pow (10.0, (double) exponent);
+ }
+ else if (exponent > 0)
+ {
+ if (num > DBL_MAX * pow (10.0, (double) -exponent))
+ goto overflow;
+ num *= pow (10.0, (double) exponent);
+ }
+
+ i->v->f = sign * num;
+ return 1;
+
+overflow:
+ /* Return an overflow error. */
+ dls_error (i, _("Overflow in floating-point constant."));
+ i->v->f = SYSMIS;
+ return 0;
+
+underflow:
+ /* Return an underflow error. */
+ dls_error (i, _("Underflow in floating-point constant."));
+ i->v->f = 0.0;
+ return 0;
+
+noconv:
+ /* There was no number. */
+ dls_error (i, _("Field does not form a valid floating-point constant."));
+ i->v->f = SYSMIS;
+ return 0;
+}
+
+/* Returns the integer value of hex digit C. */
+static inline int
+hexit_value (int c)
+{
+ const char s[] = "0123456789abcdef";
+ const char *cp = strchr (s, tolower ((unsigned char) c));
+
+ assert (cp != NULL);
+ return cp - s;
+}
+
+static inline int
+parse_N (struct data_in *i)
+{
+ const unsigned char *cp;
+
+ for (cp = i->s; cp < i->e; cp++)
+ {
+ if (!isdigit (*cp))
+ {
+ dls_error (i, _("All characters in field must be digits."));
+ return 0;
+ }
+
+ i->v->f = i->v->f * 10.0 + *cp - '0';
+ }
+
+ if (i->format.d)
+ i->v->f /= pow (10.0, i->format.d);
+ return 1;
+}
+
+static inline int
+parse_PIBHEX (struct data_in *i)
+{
+ double n;
+ const unsigned char *cp;
+
+ trim_whitespace (i);
+
+ n = 0.0;
+ for (cp = i->s; cp < i->e; cp++)
+ {
+ if (!isxdigit (*cp))
+ {
+ dls_error (i, _("Unrecognized character in field."));
+ return 0;
+ }
+
+ n = n * 16.0 + hexit_value (*cp);
+ }
+
+ i->v->f = n;
+ return 1;
+}
+
+static inline int
+parse_RBHEX (struct data_in *i)
+{
+ /* Validate input. */
+ trim_whitespace (i);
+ if ((i->e - i->s) % 2)
+ {
+ dls_error (i, _("Field must have even length."));
+ return 0;
+ }
+
+ {
+ const unsigned char *cp;
+
+ for (cp = i->s; cp < i->e; cp++)
+ if (!isxdigit (*cp))
+ {
+ dls_error (i, _("Field must contain only hex digits."));
+ return 0;
+ }
+ }
+
+ /* Parse input. */
+ {
+ union
+ {
+ double d;
+ unsigned char c[sizeof (double)];
+ }
+ u;
+
+ int j;
+
+ memset (u.c, 0, sizeof u.c);
+ for (j = 0; j < min ((i->e - i->s) / 2, sizeof u.d); j++)
+ u.c[j] = 16 * hexit_value (i->s[j * 2]) + hexit_value (i->s[j * 2 + 1]);
+
+ i->v->f = u.d;
+ }
+
+ return 1;
+}
+
+static inline int
+parse_Z (struct data_in *i)
+{
+ char buf[64];
+
+ /* Warn user that we suck. */
+ {
+ static int warned;
+
+ if (!warned)
+ {
+ msg (MW, _("Quality of zoned decimal (Z) input format code is "
+ "suspect. Check your results three times, report bugs "
+ "to author."));
+ warned = 1;
+ }
+ }
+
+ /* Validate input. */
+ trim_whitespace (i);
+
+ if (i->e - i->s < 2)
+ {
+ dls_error (i, _("Zoned decimal field contains fewer than 2 "
+ "characters."));
+ return 0;
+ }
+
+ /* Copy sign into buf[0]. */
+ if ((i->e[-1] & 0xc0) != 0xc0)
+ {
+ dls_error (i, _("Bad sign byte in zoned decimal number."));
+ return 0;
+ }
+ buf[0] = (i->e[-1] ^ (i->e[-1] >> 1)) & 0x10 ? '-' : '+';
+
+ /* Copy digits into buf[1 ... len - 1] and terminate string. */
+ {
+ const unsigned char *sp;
+ char *dp;
+
+ for (sp = i->s, dp = buf + 1; sp < i->e - 1; sp++, dp++)
+ if (*sp == '.')
+ *dp = '.';
+ else if ((*sp & 0xf0) == 0xf0 && (*sp & 0xf) < 10)
+ *dp = (*sp & 0xf) + '0';
+ else
+ {
+ dls_error (i, _("Format error in zoned decimal number."));
+ return 0;
+ }
+
+ *dp = '\0';
+ }
+
+ /* Parse as number. */
+ {
+ char *tail;
+
+ i->v->f = strtod ((char *) buf, (char **) &tail);
+ if ((unsigned char *) tail != i->e)
+ {
+ dls_error (i, _("Error in syntax of zoned decimal number."));
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+static inline int
+parse_IB (struct data_in *i)
+{
+ char buf[64];
+ const char *p;
+
+ unsigned char xor;
+
+ /* We want the data to be in big-endian format. If this is a
+ little-endian machine, reverse the byte order. */
+ if (endian == LITTLE)
+ {
+ memcpy (buf, i->s, i->e - i->s);
+ mm_reverse (buf, i->e - i->s);
+ p = buf;
+ }
+ else
+ p = i->s;
+
+ /* If the value is negative, we need to logical-NOT each value
+ before adding it. */
+ if (p[0] & 0x80)
+ xor = 0xff;
+ else
+ xor = 0x00;
+
+ {
+ int j;
+
+ i->v->f = 0.0;
+ for (j = 0; j < i->e - i->s; j++)
+ i->v->f = i->v->f * 256.0 + (p[j] ^ xor);
+ }
+
+ /* If the value is negative, add 1 and set the sign, to complete a
+ two's-complement negation. */
+ if (p[0] & 0x80)
+ i->v->f = -(i->v->f + 1.0);
+
+ if (i->format.d)
+ i->v->f /= pow (10.0, i->format.d);
+
+ return 1;
+}
+
+static inline int
+parse_PIB (struct data_in *i)
+{
+ int j;
+
+ i->v->f = 0.0;
+ if (endian == BIG)
+ for (j = 0; j < i->e - i->s; j++)
+ i->v->f = i->v->f * 256.0 + i->s[j];
+ else
+ for (j = i->e - i->s - 1; j >= 0; j--)
+ i->v->f = i->v->f * 256.0 + i->s[j];
+
+ if (i->format.d)
+ i->v->f /= pow (10.0, i->format.d);
+
+ return 1;
+}
+
+static inline int
+parse_P (struct data_in *i)
+{
+ const unsigned char *cp;
+
+ i->v->f = 0.0;
+ for (cp = i->s; cp < i->e - 1; cp++)
+ {
+ i->v->f = i->v->f * 10 + (*cp >> 4);
+ i->v->f = i->v->f * 10 + (*cp & 15);
+ }
+ i->v->f = i->v->f * 10 + (*cp >> 4);
+ if ((*cp ^ (*cp >> 1)) & 0x10)
+ i->v->f = -i->v->f;
+
+ if (i->format.d)
+ i->v->f /= pow (10.0, i->format.d);
+
+ return 1;
+}
+
+static inline int
+parse_PK (struct data_in *i)
+{
+ const unsigned char *cp;
+
+ i->v->f = 0.0;
+ for (cp = i->s; cp < i->e; cp++)
+ {
+ i->v->f = i->v->f * 10 + (*cp >> 4);
+ i->v->f = i->v->f * 10 + (*cp & 15);
+ }
+
+ if (i->format.d)
+ i->v->f /= pow (10.0, i->format.d);
+
+ return 1;
+}
+
+static inline int
+parse_RB (struct data_in *i)
+{
+ union
+ {
+ double d;
+ unsigned char c[sizeof (double)];
+ }
+ u;
+
+ memset (u.c, 0, sizeof u.c);
+ memcpy (u.c, i->s, min ((int) sizeof (u.c), i->e - i->s));
+ i->v->f = u.d;
+
+ return 1;
+}
+
+static inline int
+parse_A (struct data_in *i)
+{
+ ptrdiff_t len = i->e - i->s;
+
+ if (len >= i->format.w)
+ memcpy (i->v->s, i->s, i->format.w);
+ else
+ {
+ memcpy (i->v->s, i->s, len);
+ memset (i->v->s + len, ' ', i->format.w - len);
+ }
+
+#if __CHECKER__
+ memset (i->v->s + i->format.w, '%',
+ REM_RND_UP (i->format.w, MAX_SHORT_STRING));
+#endif
+
+ return 1;
+}
+
+static inline int
+parse_AHEX (struct data_in *i)
+{
+ /* Validate input. */
+ trim_whitespace (i);
+ if ((i->e - i->s) % 2)
+ {
+ dls_error (i, _("Field must have even length."));
+ return 0;
+ }
+
+ {
+ const unsigned char *cp;
+
+ for (cp = i->s; cp < i->e; cp++)
+ if (!isxdigit (*cp))
+ {
+ dls_error (i, _("Field must contain only hex digits."));
+ return 0;
+ }
+ }
+
+ {
+ int j;
+
+ /* Parse input. */
+ for (j = 0; j < min (i->e - i->s, i->format.w); j += 2)
+ i->v->s[j / 2] = hexit_value (i->s[j]) * 16 + hexit_value (i->s[j + 1]);
+ memset (i->v->s + (i->e - i->s) / 2, ' ', (i->format.w - (i->e - i->s)) / 2);
+ }
+
+#if __CHECKER__
+ memset (i->v->s + i->format.w / 2, '%',
+ REM_RND_UP (i->format.w / 2, MAX_SHORT_STRING));
+#endif
+
+ return 1;
+}
+\f
+/* Date & time format components. */
+
+/* Advances *CP past any whitespace characters. */
+static inline void
+skip_whitespace (struct data_in *i)
+{
+ while (isspace ((unsigned char) *i->s))
+ i->s++;
+}
+
+static inline int
+parse_leader (struct data_in *i)
+{
+ skip_whitespace (i);
+ return 1;
+}
+
+static inline int
+force_have_char (struct data_in *i)
+{
+ if (have_char (i))
+ return 1;
+
+ dls_error (i, _("Unexpected end of field."));
+ return 0;
+}
+
+static int
+parse_int (struct data_in *i, long *result)
+{
+ int negative = 0;
+
+ if (!force_have_char (i))
+ return 0;
+
+ if (*i->s == '+')
+ {
+ i->s++;
+ force_have_char (i);
+ }
+ else if (*i->s == '-')
+ {
+ negative = 1;
+ i->s++;
+ force_have_char (i);
+ }
+
+ if (!isdigit (*i->s))
+ {
+ dls_error (i, _("Digit expected in field."));
+ return 0;
+ }
+
+ *result = 0;
+ for (;;)
+ {
+ *result = *result * 10 + *i->s++ - '0';
+ if (!have_char (i) || !isdigit (*i->s))
+ break;
+ }
+
+ if (negative)
+ *result = -*result;
+ return 1;
+}
+
+static int
+parse_day (struct data_in *i, long *day)
+{
+ if (!parse_int (i, day))
+ return 0;
+ if (*day >= 1 && *day <= 31)
+ return 1;
+
+ dls_error (i, _("Day (%ld) must be between 1 and 31."), *day);
+ return 0;
+}
+
+static int
+parse_day_count (struct data_in *i, long *day_count)
+{
+ return parse_int (i, day_count);
+}
+
+static int
+parse_date_delimiter (struct data_in *i)
+{
+ int delim = 0;
+
+ while (have_char (i)
+ && (*i->s == '-' || *i->s == '/' || isspace (*i->s)
+ || *i->s == '.' || *i->s == ','))
+ {
+ delim = 1;
+ i->s++;
+ }
+ if (delim)
+ return 1;
+
+ dls_error (i, _("Delimiter expected between fields in date."));
+ return 0;
+}
+
+/* Formats NUMBER as Roman numerals in ROMAN, or as Arabic numerals if
+ the Roman expansion would be too long. */
+static void
+to_roman (int number, char roman[32])
+{
+ int save_number = number;
+
+ struct roman_digit
+ {
+ int value; /* Value corresponding to this digit. */
+ char name; /* Digit name. */
+ };
+
+ static const struct roman_digit roman_tab[7] =
+ {
+ {1000, 'M'},
+ {500, 'D'},
+ {100, 'C'},
+ {50, 'L'},
+ {10, 'X'},
+ {5, 'V'},
+ {1, 'I'},
+ };
+
+ char *cp = roman;
+
+ int i, j;
+
+ assert (32 >= INT_DIGITS + 1);
+ if (number == 0)
+ goto arabic;
+
+ if (number < 0)
+ {
+ *cp++ = '-';
+ number = -number;
+ }
+
+ for (i = 0; i < 7; i++)
+ {
+ int digit = roman_tab[i].value;
+ while (number >= digit)
+ {
+ number -= digit;
+ if (cp > &roman[30])
+ goto arabic;
+ *cp++ = roman_tab[i].name;
+ }
+
+ for (j = i + 1; j < 7; j++)
+ {
+ if (i == 4 && j == 5) /* VX is not a shortened form of V. */
+ break;
+
+ digit = roman_tab[i].value - roman_tab[j].value;
+ while (number >= digit)
+ {
+ number -= digit;
+ if (cp > &roman[29])
+ goto arabic;
+ *cp++ = roman_tab[j].name;
+ *cp++ = roman_tab[i].name;
+ }
+ }
+ }
+ *cp = 0;
+ return;
+
+arabic:
+ sprintf (roman, "%d", save_number);
+}
+
+/* Returns true if C is a (lowercase) roman numeral. */
+#define CHAR_IS_ROMAN(C) \
+ ((C) == 'x' || (C) == 'v' || (C) == 'i')
+
+/* Returns the value of a single (lowercase) roman numeral. */
+#define ROMAN_VALUE(C) \
+ ((C) == 'x' ? 10 : ((C) == 'v' ? 5 : 1))
+
+static int
+parse_month (struct data_in *i, long *month)
+{
+ if (!force_have_char (i))
+ return 0;
+
+ if (isdigit (*i->s))
+ {
+ if (!parse_int (i, month))
+ return 0;
+ if (*month >= 1 && *month <= 12)
+ return 1;
+
+ dls_error (i, _("Month (%ld) must be between 1 and 12."), *month);
+ return 0;
+ }
+
+ if (CHAR_IS_ROMAN (tolower (*i->s)))
+ {
+ int last = ROMAN_VALUE (tolower (*i->s));
+
+ *month = 0;
+ for (;;)
+ {
+ int value;
+
+ i->s++;
+ if (!have_char || !CHAR_IS_ROMAN (tolower (*i->s)))
+ {
+ if (last != INT_MAX)
+ *month += last;
+ break;
+ }
+
+ value = ROMAN_VALUE (tolower (*i->s));
+ if (last == INT_MAX)
+ *month += value;
+ else if (value > last)
+ {
+ *month += value - last;
+ last = INT_MAX;
+ }
+ else
+ {
+ *month += last;
+ last = value;
+ }
+ }
+
+ if (*month < 1 || *month > 12)
+ {
+ char buf[32];
+
+ to_roman (*month, buf);
+ dls_error (i, _("Month (%s) must be between I and XII."), buf);
+ return 0;
+ }
+
+ return 1;
+ }
+
+ {
+ static const char *months[12] =
+ {
+ "january", "february", "march", "april", "may", "june",
+ "july", "august", "september", "october", "november", "december",
+ };
+
+ char month_buf[32];
+ char *mp;
+
+ int j;
+
+ for (mp = month_buf;
+ have_char (i) && isalpha (*i->s) && mp < &month_buf[31];
+ i->s++)
+ *mp++ = tolower (*i->s);
+ *mp = '\0';
+
+ if (have_char (i) && isalpha (*i->s))
+ {
+ dls_error (i, _("Month name (%s...) is too long."), month_buf);
+ return 0;
+ }
+
+ for (j = 0; j < 12; j++)
+ if (lex_id_match (months[j], month_buf))
+ {
+ *month = j + 1;
+ return 1;
+ }
+
+ dls_error (i, _("Bad month name (%s)."), month_buf);
+ return 0;
+ }
+}
+
+static int
+parse_year (struct data_in *i, long *year)
+{
+ if (!parse_int (i, year))
+ return 0;
+
+ if (*year >= 0 && *year <= 199)
+ *year += 1900;
+ if (*year >= 1582 || *year <= 19999)
+ return 1;
+
+ dls_error (i, _("Year (%ld) must be between 1582 and 19999."), *year);
+ return 0;
+}
+
+static int
+parse_trailer (struct data_in *i)
+{
+ skip_whitespace (i);
+ if (!have_char (i))
+ return 1;
+
+ dls_error (i, _("Trailing garbage \"%s\" following date."), i->s);
+ return 0;
+}
+
+static int
+parse_julian (struct data_in *i, long *julian)
+{
+ if (!parse_int (i, julian))
+ return 0;
+
+ {
+ int day = *julian % 1000;
+
+ if (day < 1 || day > 366)
+ {
+ dls_error (i, _("Julian day (%d) must be between 1 and 366."), day);
+ return 0;
+ }
+ }
+
+ {
+ int year = *julian / 1000;
+
+ if (year >= 0 && year <= 199)
+ *julian += 1900000L;
+ else if (year < 1582 || year > 19999)
+ {
+ dls_error (i, _("Year (%d) must be between 1582 and 19999."), year);
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+static int
+parse_quarter (struct data_in *i, long *quarter)
+{
+ if (!parse_int (i, quarter))
+ return 0;
+ if (*quarter >= 1 && *quarter <= 4)
+ return 1;
+
+ dls_error (i, _("Quarter (%ld) must be between 1 and 4."), *quarter);
+ return 0;
+}
+
+static int
+parse_q_delimiter (struct data_in *i)
+{
+ skip_whitespace (i);
+ if (!have_char (i) || tolower (*i->s) != 'q')
+ {
+ dls_error (i, _("`Q' expected between quarter and year."));
+ return 0;
+ }
+ i->s++;
+ skip_whitespace (i);
+ return 1;
+}
+
+static int
+parse_week (struct data_in *i, long *week)
+{
+ if (!parse_int (i, week))
+ return 0;
+ if (*week >= 1 && *week <= 53)
+ return 1;
+
+ dls_error (i, _("Week (%ld) must be between 1 and 53."), *week);
+ return 0;
+}
+
+static int
+parse_wk_delimiter (struct data_in *i)
+{
+ skip_whitespace (i);
+ if (i->s + 1 >= i->e
+ || tolower (i->s[0]) != 'w' || tolower (i->s[1]) != 'k')
+ {
+ dls_error (i, _("`WK' expected between week and year."));
+ return 0;
+ }
+ i->s += 2;
+ skip_whitespace (i);
+ return 1;
+}
+
+static int
+parse_time_delimiter (struct data_in *i)
+{
+ int delim = 0;
+
+ while (have_char (i)
+ && (*i->s == ':' || *i->s == '.' || isspace (*i->s)))
+ {
+ delim = 1;
+ i->s++;
+ }
+
+ if (delim)
+ return 1;
+
+ dls_error (i, _("Delimiter expected between fields in time."));
+ return 0;
+}
+
+static int
+parse_hour (struct data_in *i, long *hour)
+{
+ if (!parse_int (i, hour))
+ return 0;
+ if (*hour >= 0)
+ return 1;
+
+ dls_error (i, _("Hour (%ld) must be positive."), *hour);
+ return 0;
+}
+
+static int
+parse_minute (struct data_in *i, long *minute)
+{
+ if (!parse_int (i, minute))
+ return 0;
+ if (*minute >= 0 && *minute <= 59)
+ return 1;
+
+ dls_error (i, _("Minute (%ld) must be between 0 and 59."), *minute);
+ return 0;
+}
+
+static int
+parse_opt_second (struct data_in *i, double *second)
+{
+ int delim = 0;
+
+ char buf[64];
+ char *cp;
+
+ while (have_char (i)
+ && (*i->s == ':' || *i->s == '.' || isspace (*i->s)))
+ {
+ delim = 1;
+ i->s++;
+ }
+
+ if (!delim || !isdigit (*i->s))
+ {
+ *second = 0.0;
+ return 1;
+ }
+
+ cp = buf;
+ while (have_char (i) && isdigit (*i->s))
+ *cp++ = *i->s++;
+ if (have_char (i) && *i->s == '.')
+ *cp++ = *i->s++;
+ while (have_char (i) && isdigit (*i->s))
+ *cp++ = *i->s++;
+ *cp = '\0';
+
+ *second = strtod (buf, NULL);
+
+ return 1;
+}
+
+static int
+parse_hour24 (struct data_in *i, long *hour24)
+{
+ if (!parse_int (i, hour24))
+ return 0;
+ if (*hour24 >= 0 && *hour24 <= 23)
+ return 1;
+
+ dls_error (i, _("Hour (%ld) must be between 0 and 23."), *hour24);
+ return 0;
+}
+
+
+static int
+parse_weekday (struct data_in *i, int *weekday)
+{
+ /* PORTME */
+ #define TUPLE(A,B) \
+ (((A) << 8) + (B))
+
+ if (i->s + 1 >= i->e)
+ {
+ dls_error (i, _("Day of the week expected in date value."));
+ return 0;
+ }
+
+ switch (TUPLE (tolower (i->s[0]), tolower (i->s[1])))
+ {
+ case TUPLE ('s', 'u'):
+ *weekday = 1;
+ break;
+
+ case TUPLE ('m', 'o'):
+ *weekday = 2;
+ break;
+
+ case TUPLE ('t', 'u'):
+ *weekday = 3;
+ break;
+
+ case TUPLE ('w', 'e'):
+ *weekday = 4;
+ break;
+
+ case TUPLE ('t', 'h'):
+ *weekday = 5;
+ break;
+
+ case TUPLE ('f', 'r'):
+ *weekday = 6;
+ break;
+
+ case TUPLE ('s', 'a'):
+ *weekday = 7;
+ break;
+
+ default:
+ dls_error (i, _("Day of the week expected in date value."));
+ return 0;
+ }
+
+ while (have_char (i) && isalpha (*i->s))
+ i->s++;
+
+ return 1;
+
+ #undef TUPLE
+}
+
+static int
+parse_spaces (struct data_in *i)
+{
+ skip_whitespace (i);
+ return 1;
+}
+
+static int
+parse_sign (struct data_in *i, int *sign)
+{
+ if (!force_have_char (i))
+ return 0;
+
+ switch (*i->s)
+ {
+ case '-':
+ i->s++;
+ *sign = 1;
+ break;
+
+ case '+':
+ i->s++;
+ /* fall through */
+
+ default:
+ *sign = 0;
+ break;
+ }
+
+ return 1;
+}
+\f
+/* Date & time formats. */
+
+static int
+valid_date (struct data_in *i)
+{
+ if (i->v->f == SYSMIS)
+ {
+ dls_error (i, _("Date is not in valid range between "
+ "15 Oct 1582 and 31 Dec 19999."));
+ return 0;
+ }
+ else
+ return 1;
+}
+
+static int
+parse_DATE (struct data_in *i)
+{
+ long day, month, year;
+
+ if (!parse_leader (i)
+ || !parse_day (i, &day)
+ || !parse_date_delimiter (i)
+ || !parse_month (i, &month)
+ || !parse_date_delimiter (i)
+ || !parse_year (i, &year)
+ || !parse_trailer (i))
+ return 0;
+
+ i->v->f = calendar_to_julian (year, month, day);
+ if (!valid_date (i))
+ return 0;
+ i->v->f *= 60. * 60. * 24.;
+
+ return 1;
+}
+
+static int
+parse_ADATE (struct data_in *i)
+{
+ long month, day, year;
+
+ if (!parse_leader (i)
+ || !parse_month (i, &month)
+ || !parse_date_delimiter (i)
+ || !parse_day (i, &day)
+ || !parse_date_delimiter (i)
+ || !parse_year (i, &year)
+ || !parse_trailer (i))
+ return 0;
+
+ i->v->f = calendar_to_julian (year, month, day);
+ if (!valid_date (i))
+ return 0;
+ i->v->f *= 60. * 60. * 24.;
+
+ return 1;
+}
+
+static int
+parse_EDATE (struct data_in *i)
+{
+ long month, day, year;
+
+ if (!parse_leader (i)
+ || !parse_day (i, &day)
+ || !parse_date_delimiter (i)
+ || !parse_month (i, &month)
+ || !parse_date_delimiter (i)
+ || !parse_year (i, &year)
+ || !parse_trailer (i))
+ return 0;
+
+ i->v->f = calendar_to_julian (year, month, day);
+ if (!valid_date (i))
+ return 0;
+ i->v->f *= 60. * 60. * 24.;
+
+ return 1;
+}
+
+static int
+parse_SDATE (struct data_in *i)
+{
+ long month, day, year;
+
+ if (!parse_leader (i)
+ || !parse_year (i, &year)
+ || !parse_date_delimiter (i)
+ || !parse_month (i, &month)
+ || !parse_date_delimiter (i)
+ || !parse_day (i, &day)
+ || !parse_trailer (i))
+ return 0;
+
+ i->v->f = calendar_to_julian (year, month, day);
+ if (!valid_date (i))
+ return 0;
+ i->v->f *= 60. * 60. * 24.;
+
+ return 1;
+}
+
+static int
+parse_JDATE (struct data_in *i)
+{
+ long julian;
+
+ if (!parse_leader (i)
+ || !parse_julian (i, &julian)
+ || !parse_trailer (i))
+ return 0;
+
+ if (julian / 1000 == 1582)
+ i->v->f = calendar_to_julian (1583, 1, 1) - 365;
+ else
+ i->v->f = calendar_to_julian (julian / 1000, 1, 1);
+
+ if (valid_date (i))
+ {
+ i->v->f = (i->v->f + julian % 1000 - 1) * 60. * 60. * 24.;
+ if (i->v->f < 0.)
+ i->v->f = SYSMIS;
+ }
+
+ return valid_date (i);
+}
+
+static int
+parse_QYR (struct data_in *i)
+{
+ long quarter, year;
+
+ if (!parse_leader (i)
+ || !parse_quarter (i, &quarter)
+ || !parse_q_delimiter (i)
+ || !parse_year (i, &year)
+ || !parse_trailer (i))
+ return 0;
+
+ i->v->f = calendar_to_julian (year, (quarter - 1) * 3 + 1, 1);
+ if (!valid_date (i))
+ return 0;
+ i->v->f *= 60. * 60. * 24.;
+
+ return 1;
+}
+
+static int
+parse_MOYR (struct data_in *i)
+{
+ long month, year;
+
+ if (!parse_leader (i)
+ || !parse_month (i, &month)
+ || !parse_date_delimiter (i)
+ || !parse_year (i, &year)
+ || !parse_trailer (i))
+ return 0;
+
+ i->v->f = calendar_to_julian (year, month, 1);
+ if (!valid_date (i))
+ return 0;
+ i->v->f *= 60. * 60. * 24.;
+
+ return 1;
+}
+
+static int
+parse_WKYR (struct data_in *i)
+{
+ long week, year;
+
+ if (!parse_leader (i)
+ || !parse_week (i, &week)
+ || !parse_wk_delimiter (i)
+ || !parse_year (i, &year)
+ || !parse_trailer (i))
+ return 0;
+
+ i->v->f = calendar_to_julian (year, 1, 1);
+ if (!valid_date (i))
+ return 0;
+ i->v->f = (i->v->f + (week - 1) * 7) * 60. * 60. * 24.;
+
+ return 1;
+}
+
+static int
+parse_TIME (struct data_in *i)
+{
+ int sign;
+ double second;
+ long hour, minute;
+
+ if (!parse_leader (i)
+ || !parse_sign (i, &sign)
+ || !parse_spaces (i)
+ || !parse_hour (i, &hour)
+ || !parse_time_delimiter (i)
+ || !parse_minute (i, &minute)
+ || !parse_opt_second (i, &second))
+ return 0;
+
+ i->v->f = hour * 60. * 60. + minute * 60. + second;
+ if (sign)
+ i->v->f = -i->v->f;
+ return 1;
+}
+
+static int
+parse_DTIME (struct data_in *i)
+{
+ int sign;
+ long day_count, hour;
+ double second;
+ long minute;
+
+ if (!parse_leader (i)
+ || !parse_sign (i, &sign)
+ || !parse_spaces (i)
+ || !parse_day_count (i, &day_count)
+ || !parse_time_delimiter (i)
+ || !parse_hour (i, &hour)
+ || !parse_time_delimiter (i)
+ || !parse_minute (i, &minute)
+ || !parse_opt_second (i, &second))
+ return 0;
+
+ i->v->f = (day_count * 60. * 60. * 24.
+ + hour * 60. * 60.
+ + minute * 60.
+ + second);
+ if (sign)
+ i->v->f = -i->v->f;
+ return 1;
+}
+
+static int
+parse_DATETIME (struct data_in *i)
+{
+ long day, month, year;
+ long hour24;
+ double second;
+ long minute;
+
+ if (!parse_leader (i)
+ || !parse_day (i, &day)
+ || !parse_date_delimiter (i)
+ || !parse_month (i, &month)
+ || !parse_date_delimiter (i)
+ || !parse_year (i, &year)
+ || !parse_time_delimiter (i)
+ || !parse_hour24 (i, &hour24)
+ || !parse_time_delimiter (i)
+ || !parse_minute (i, &minute)
+ || !parse_opt_second (i, &second))
+ return 0;
+
+ i->v->f = calendar_to_julian (year, month, day);
+ if (!valid_date (i))
+ return 0;
+ i->v->f = (i->v->f * 60. * 60. * 24.
+ + hour24 * 60. * 60.
+ + minute * 60.
+ + second);
+
+ return 1;
+}
+
+static int
+parse_WKDAY (struct data_in *i)
+{
+ int weekday;
+
+ if (!parse_leader (i)
+ || !parse_weekday (i, &weekday)
+ || !parse_trailer (i))
+ return 0;
+
+ i->v->f = weekday;
+ return 1;
+}
+
+static int
+parse_MONTH (struct data_in *i)
+{
+ long month;
+
+ if (!parse_leader (i)
+ || !parse_month (i, &month)
+ || !parse_trailer (i))
+ return 0;
+
+ i->v->f = month;
+ return 1;
+}
+\f
+/* Main dispatcher. */
+
+static void
+default_result (struct data_in *i)
+{
+ const struct fmt_desc *const fmt = &formats[i->format.type];
+
+ /* Default to SYSMIS or blanks. */
+ if (fmt->cat & FCAT_STRING)
+ {
+#if __CHECKER__
+ memset (i->v->s, ' ', ROUND_UP (i->format.w, MAX_SHORT_STRING));
+#else
+ memset (i->v->s, ' ', i->format.w);
+#endif
+ }
+ else
+ i->v->f = set_blanks;
+}
+
+int
+data_in (struct data_in *i)
+{
+ const struct fmt_desc *const fmt = &formats[i->format.type];
+
+ /* Check that we've got a string to work with. */
+ if (i->e == i->s || i->format.w <= 0)
+ {
+ default_result (i);
+ return 1;
+ }
+
+ i->f2 = i->f1 + (i->e - i->s) - 1;
+
+ /* Make sure that the string isn't too long. */
+ if (i->format.w > fmt->Imax_w)
+ {
+ dls_error (i, _("Field too long (%d characters). Truncated after "
+ "character %d."),
+ i->format.w, fmt->Imax_w);
+ i->format.w = fmt->Imax_w;
+ }
+
+ if (fmt->cat & FCAT_BLANKS_SYSMIS)
+ {
+ const unsigned char *cp;
+
+ cp = i->s;
+ for (;;)
+ {
+ if (!isspace (*cp))
+ break;
+
+ if (++cp == i->e)
+ {
+ i->v->f = set_blanks;
+ return 1;
+ }
+ }
+ }
+
+ {
+ static int (*const handlers[FMT_NUMBER_OF_FORMATS])(struct data_in *) =
+ {
+ parse_numeric, parse_N, parse_numeric, parse_numeric,
+ parse_numeric, parse_numeric, parse_numeric,
+ parse_Z, parse_A, parse_AHEX, parse_IB, parse_P, parse_PIB,
+ parse_PIBHEX, parse_PK, parse_RB, parse_RBHEX,
+ NULL, NULL, NULL, NULL, NULL,
+ parse_DATE, parse_EDATE, parse_SDATE, parse_ADATE, parse_JDATE,
+ parse_QYR, parse_MOYR, parse_WKYR,
+ parse_DATETIME, parse_TIME, parse_DTIME,
+ parse_WKDAY, parse_MONTH,
+ };
+
+ int (*handler)(struct data_in *);
+ int success;
+
+ handler = handlers[i->format.type];
+ assert (handler != NULL);
+
+ success = handler (i);
+ if (!success)
+ default_result (i);
+
+ return success;
+ }
+}
+\f
+/* Utility function. */
+
+/* Sets DI->{s,e} appropriately given that LINE has length LEN and the
+ field starts at one-based column FC and ends at one-based column
+ LC, inclusive. */
+void
+data_in_finite_line (struct data_in *di, const char *line, size_t len,
+ int fc, int lc)
+{
+ di->s = line + ((size_t) fc <= len ? fc - 1 : len);
+ di->e = line + ((size_t) lc <= len ? lc : len);
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !data_in_h
+#define data_in_h 1
+
+#include "format.h"
+
+/* Flags. */
+enum
+ {
+ DI_IGNORE_ERROR = 01, /* Don't report errors to the user. */
+ };
+
+/* Information about parsing one data field. */
+struct data_in
+ {
+ const unsigned char *s; /* Source start. */
+ const unsigned char *e; /* Source end. */
+
+ union value *v; /* Destination. */
+
+ int flags; /* Zero or more of DI_*. */
+ int f1, f2; /* Columns the field was taken from. */
+ struct fmt_spec format; /* Format specification to use. */
+ };
+
+int data_in (struct data_in *);
+
+void data_in_finite_line (struct data_in *di, const char *line, size_t len,
+ int fc, int lc);
+
+#if __GNUC__ >= 2
+extern inline void
+data_in_finite_line (struct data_in *di, const char *line, size_t len,
+ int fc, int lc)
+{
+ di->s = line + ((size_t) fc <= len ? fc - 1 : len);
+ di->e = line + ((size_t) lc <= len ? lc : len);
+}
+#endif /* GNU C */
+
+#endif /* data-in.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <ctype.h>
+#include <float.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "data-in.h"
+#include "debug-print.h"
+#include "dfm.h"
+#include "error.h"
+#include "file-handle.h"
+#include "format.h"
+#include "lexer.h"
+#include "misc.h"
+#include "settings.h"
+#include "str.h"
+#include "tab.h"
+#include "var.h"
+#include "vfm.h"
+\f
+/* Utility function. */
+
+/* FIXME: Either REPEATING DATA must be the last transformation, or we
+ must multiplex the transformations that follow (i.e., perform them
+ for every case that we produce from a repetition instance).
+ Currently we do neither. We should do one or the other. */
+
+/* Describes how to parse one variable. */
+struct dls_var_spec
+ {
+ struct dls_var_spec *next;
+ struct variable *v; /* Associated variable. Used only in
+ parsing. Not safe later. */
+ char name[9]; /* Free-format: Name of variable. */
+ int rec; /* Fixed-format: Record number (1-based). */
+ int fc, lc; /* Fixed-format: Column numbers in record. */
+ struct fmt_spec input; /* Input format of this field. */
+ int fv; /* First value in case. */
+ int type; /* 0=numeric, >0=width of alpha field. */
+ };
+
+/* Constants for DATA LIST type. */
+/* Must match table in cmd_data_list(). */
+enum
+ {
+ DLS_FIXED,
+ DLS_FREE,
+ DLS_LIST
+ };
+
+/* DATA LIST private data structure. */
+struct data_list_pgm
+ {
+ struct trns_header h;
+ struct dls_var_spec *spec; /* Variable parsing specifications. */
+ struct file_handle *handle; /* Input file, never NULL. */
+ /* Do not reorder preceding fields. */
+
+ int type; /* A DLS_* constant. */
+ struct variable *end; /* Variable specified on END subcommand. */
+ int eof; /* End of file encountered. */
+ int nrec; /* Number of records. */
+ };
+
+/* Holds information on parsing the data file. */
+static struct data_list_pgm dls;
+
+/* Pointer to a pointer to where the first dls_var_spec should go. */
+static struct dls_var_spec **first;
+
+/* Last dls_var_spec in the chain. Used for building the linked-list. */
+static struct dls_var_spec *next;
+
+static int parse_fixed (void);
+static int parse_free (void);
+static void dump_fixed_table (void);
+static void dump_free_table (void);
+static void destroy_dls (struct trns_header *);
+static int read_one_case (struct trns_header *, struct ccase *);
+
+/* Message title for REPEATING DATA. */
+#define RPD_ERR "REPEATING DATA: "
+
+int
+cmd_data_list (void)
+{
+ /* 0=print no table, 1=print table. (TABLE subcommand.) */
+ int table = -1;
+
+ lex_match_id ("DATA");
+ lex_match_id ("LIST");
+
+ if (vfm_source != &input_program_source
+ && vfm_source != &file_type_source)
+ discard_variables ();
+
+ dls.handle = default_handle;
+ dls.type = -1;
+ dls.end = NULL;
+ dls.eof = 0;
+ dls.nrec = 0;
+ dls.spec = NULL;
+ next = NULL;
+ first = &dls.spec;
+
+ while (token != '/')
+ {
+ if (lex_match_id ("FILE"))
+ {
+ lex_match ('=');
+ dls.handle = fh_parse_file_handle ();
+ if (!dls.handle)
+ return CMD_FAILURE;
+ if (vfm_source == &file_type_source && dls.handle != default_handle)
+ {
+ msg (SE, _("DATA LIST may not use a different file from "
+ "that specified on its surrounding FILE TYPE."));
+ return CMD_FAILURE;
+ }
+ }
+ else if (lex_match_id ("RECORDS"))
+ {
+ lex_match ('=');
+ lex_match ('(');
+ if (!lex_force_int ())
+ return CMD_FAILURE;
+ dls.nrec = lex_integer ();
+ lex_get ();
+ lex_match (')');
+ }
+ else if (lex_match_id ("END"))
+ {
+ if (dls.end)
+ {
+ msg (SE, _("The END subcommand may only be specified once."));
+ return CMD_FAILURE;
+ }
+
+ lex_match ('=');
+ if (!lex_force_id ())
+ return CMD_FAILURE;
+ dls.end = find_variable (tokid);
+ if (!dls.end)
+ dls.end = force_create_variable (&default_dict, tokid, NUMERIC, 0);
+ lex_get ();
+ }
+ else if (token == T_ID)
+ {
+ /* Must match DLS_* constants. */
+ static const char *id[] = {"FIXED", "FREE", "LIST", "NOTABLE",
+ "TABLE", NULL};
+ const char **p;
+ int index;
+
+ for (p = id; *p; p++)
+ if (lex_id_match (*p, tokid))
+ break;
+ if (*p == NULL)
+ {
+ lex_error (NULL);
+ return CMD_FAILURE;
+ }
+
+ lex_get ();
+
+ index = p - id;
+ if (index < 3)
+ {
+ if (dls.type != -1)
+ {
+ msg (SE, _("Only one of FIXED, FREE, or LIST may "
+ "be specified."));
+ return CMD_FAILURE;
+ }
+
+ dls.type = index;
+ }
+ else
+ table = index - 3;
+ }
+ else
+ {
+ lex_error (NULL);
+ return CMD_FAILURE;
+ }
+ }
+
+ default_handle = dls.handle;
+
+ if (dls.type == -1)
+ dls.type = DLS_FIXED;
+
+ if (table == -1)
+ {
+ if (dls.type == DLS_FREE)
+ table = 0;
+ else
+ table = 1;
+ }
+
+ if (dls.type == DLS_FIXED)
+ {
+ if (!parse_fixed ())
+ return CMD_FAILURE;
+ if (table)
+ dump_fixed_table ();
+ }
+ else
+ {
+ if (!parse_free ())
+ return CMD_FAILURE;
+ if (table)
+ dump_free_table ();
+ }
+
+ if (vfm_source != NULL)
+ {
+ struct data_list_pgm *new_pgm;
+
+ dls.h.proc = read_one_case;
+ dls.h.free = destroy_dls;
+
+ new_pgm = xmalloc (sizeof *new_pgm);
+ memcpy (new_pgm, &dls, sizeof *new_pgm);
+ add_transformation ((struct trns_header *) new_pgm);
+ }
+ else
+ vfm_source = &data_list_source;
+
+ return CMD_SUCCESS;
+}
+
+static void
+append_var_spec (struct dls_var_spec *spec)
+{
+ if (next == 0)
+ *first = next = xmalloc (sizeof *spec);
+ else
+ next = next->next = xmalloc (sizeof *spec);
+
+#if __CHECKER__
+ spec->type = ROUND_UP (spec->type, 8);
+#endif
+
+ memcpy (next, spec, sizeof *spec);
+ next->next = NULL;
+}
+\f
+/* Fixed-format parsing. */
+
+/* Used for chaining together fortran-like format specifiers. */
+struct fmt_list
+ {
+ struct fmt_list *next;
+ int count;
+ struct fmt_spec f;
+ struct fmt_list *down;
+ };
+
+/* Used as "local" variables among the fixed-format parsing funcs. If
+ it were guaranteed that PSPP were going to be compiled by gcc,
+ I'd make all these functions a single set of nested functions. */
+static struct
+ {
+ char **name; /* Variable names. */
+ int nname; /* Number of names. */
+ int cname; /* dump_fmt_list: index of next name to use. */
+
+ int recno; /* Index of current record. */
+ int sc; /* 1-based column number of starting column for
+ next field to output. */
+
+ struct dls_var_spec spec; /* Next specification to output. */
+ int fc, lc; /* First, last column in set of fields specified
+ together. */
+
+ int level; /* Nesting level in fixed_parse_fortran(). */
+ }
+fx;
+
+static int fixed_parse_compatible (void);
+static struct fmt_list *fixed_parse_fortran (void);
+
+static int
+parse_fixed (void)
+{
+ int i;
+
+ fx.recno = 0;
+ fx.sc = 1;
+
+ while (token != '.')
+ {
+ while (lex_match ('/'))
+ {
+ fx.recno++;
+ if (lex_integer_p ())
+ {
+ if (lex_integer () < fx.recno)
+ {
+ msg (SE, _("The record number specified, %ld, is "
+ "before the previous record, %d. Data "
+ "fields must be listed in order of "
+ "increasing record number."),
+ lex_integer (), fx.recno - 1);
+ return 0;
+ }
+
+ fx.recno = lex_integer ();
+ lex_get ();
+ }
+ fx.sc = 1;
+ }
+ fx.spec.rec = fx.recno;
+
+ if (!parse_DATA_LIST_vars (&fx.name, &fx.nname, PV_NONE))
+ return 0;
+
+ if (token == T_NUM)
+ {
+ if (!fixed_parse_compatible ())
+ goto fail;
+ }
+ else if (token == '(')
+ {
+ fx.level = 0;
+ fx.cname = 0;
+ if (!fixed_parse_fortran ())
+ goto fail;
+ }
+ else
+ {
+ msg (SE, _("SPSS-like or FORTRAN-like format "
+ "specification expected after variable names."));
+ goto fail;
+ }
+
+ for (i = 0; i < fx.nname; i++)
+ free (fx.name[i]);
+ free (fx.name);
+ }
+ if (dls.nrec && next->rec > dls.nrec)
+ {
+ msg (SE, _("Variables are specified on records that "
+ "should not exist according to RECORDS subcommand."));
+ return 0;
+ }
+ else if (!dls.nrec)
+ dls.nrec = next->rec;
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ return 0;
+ }
+ return 1;
+
+fail:
+ for (i = 0; i < fx.nname; i++)
+ free (fx.name[i]);
+ free (fx.name);
+ return 0;
+}
+
+static int
+fixed_parse_compatible (void)
+{
+ int dividend;
+ int i;
+
+ if (!lex_force_int ())
+ return 0;
+
+ fx.fc = lex_integer ();
+ if (fx.fc < 1)
+ {
+ msg (SE, _("Column positions for fields must be positive."));
+ return 0;
+ }
+ lex_get ();
+
+ lex_negative_to_dash ();
+ if (lex_match ('-'))
+ {
+ if (!lex_force_int ())
+ return 0;
+ fx.lc = lex_integer ();
+ if (fx.lc < 1)
+ {
+ msg (SE, _("Column positions for fields must be positive."));
+ return 0;
+ }
+ else if (fx.lc < fx.fc)
+ {
+ msg (SE, _("The ending column for a field must be "
+ "greater than the starting column."));
+ return 0;
+ }
+
+ lex_get ();
+ }
+ else
+ fx.lc = fx.fc;
+
+ fx.spec.input.w = fx.lc - fx.fc + 1;
+ if (lex_match ('('))
+ {
+ struct fmt_desc *fdp;
+
+ if (token == T_ID)
+ {
+ const char *cp;
+
+ fx.spec.input.type = parse_format_specifier_name (&cp, 0);
+ if (fx.spec.input.type == -1)
+ return 0;
+ if (*cp)
+ {
+ msg (SE, _("A format specifier on this line "
+ "has extra characters on the end."));
+ return 0;
+ }
+
+ lex_get ();
+ lex_match (',');
+ }
+ else
+ fx.spec.input.type = FMT_F;
+
+ if (lex_integer_p ())
+ {
+ if (lex_integer () < 1)
+ {
+ msg (SE, _("The value for number of decimal places "
+ "must be at least 1."));
+ return 0;
+ }
+
+ fx.spec.input.d = lex_integer ();
+ lex_get ();
+ }
+ else
+ fx.spec.input.d = 0;
+
+ fdp = &formats[fx.spec.input.type];
+ if (fdp->n_args < 2 && fx.spec.input.d)
+ {
+ msg (SE, _("Input format %s doesn't accept decimal places."),
+ fdp->name);
+ return 0;
+ }
+
+ if (fx.spec.input.d > 16)
+ fx.spec.input.d = 16;
+
+ if (!lex_force_match (')'))
+ return 0;
+ }
+ else
+ {
+ fx.spec.input.type = FMT_F;
+ fx.spec.input.d = 0;
+ }
+
+ fx.sc = fx.lc + 1;
+
+ if ((fx.lc - fx.fc + 1) % fx.nname)
+ {
+ msg (SE, _("The %d columns %d-%d "
+ "can't be evenly divided into %d fields."),
+ fx.lc - fx.fc + 1, fx.fc, fx.lc, fx.nname);
+ return 0;
+ }
+
+ dividend = (fx.lc - fx.fc + 1) / fx.nname;
+ fx.spec.input.w = dividend;
+ if (!check_input_specifier (&fx.spec.input))
+ return 0;
+
+ for (i = 0; i < fx.nname; i++)
+ {
+ int type;
+ struct variable *v;
+
+ if (fx.spec.input.type == FMT_A || fx.spec.input.type == FMT_AHEX)
+ type = ALPHA;
+ else
+ type = NUMERIC;
+
+ v = create_variable (&default_dict, fx.name[i], type, dividend);
+ if (v)
+ {
+ convert_fmt_ItoO (&fx.spec.input, &v->print);
+ v->write = v->print;
+ }
+ else
+ {
+ v = find_variable (fx.name[i]);
+ assert (v);
+ if (!vfm_source)
+ {
+ msg (SE, _("%s is a duplicate variable name."), fx.name[i]);
+ return 0;
+ }
+ if (type != v->type)
+ {
+ msg (SE, _("There is already a variable %s of a "
+ "different type."),
+ fx.name[i]);
+ return 0;
+ }
+ if (type == ALPHA && dividend != v->width)
+ {
+ msg (SE, _("There is already a string variable %s of a "
+ "different width."), fx.name[i]);
+ return 0;
+ }
+ }
+
+ fx.spec.v = v;
+ fx.spec.fc = fx.fc + dividend * i;
+ fx.spec.lc = fx.spec.fc + dividend - 1;
+ fx.spec.fv = v->fv;
+ fx.spec.type = v->type == NUMERIC ? 0 : v->width;
+ append_var_spec (&fx.spec);
+ }
+ return 1;
+}
+
+/* Destroy a format list and, optionally, all its sublists. */
+static void
+destroy_fmt_list (struct fmt_list *f, int recurse)
+{
+ struct fmt_list *next;
+
+ for (; f; f = next)
+ {
+ next = f->next;
+ if (recurse && f->f.type == FMT_DESCEND)
+ destroy_fmt_list (f->down, 1);
+ free (f);
+ }
+}
+
+/* Takes a hierarchically structured fmt_list F as constructed by
+ fixed_parse_fortran(), and flattens it into a linear list of
+ dls_var_spec's. */
+static int
+dump_fmt_list (struct fmt_list *f)
+{
+ int i;
+
+ for (; f; f = f->next)
+ if (f->f.type == FMT_X)
+ fx.sc += f->count;
+ else if (f->f.type == FMT_T)
+ fx.sc = f->f.w;
+ else if (f->f.type == FMT_NEWREC)
+ {
+ fx.recno += f->count;
+ fx.sc = 1;
+ }
+ else
+ for (i = 0; i < f->count; i++)
+ if (f->f.type == FMT_DESCEND)
+ {
+ if (!dump_fmt_list (f->down))
+ return 0;
+ }
+ else
+ {
+ int type;
+ struct variable *v;
+
+ type = (formats[f->f.type].cat & FCAT_STRING) ? ALPHA : NUMERIC;
+ if (fx.cname >= fx.nname)
+ {
+ msg (SE, _("The number of format "
+ "specifications exceeds the number of "
+ "variable names given."));
+ return 0;
+ }
+
+ fx.spec.v = v = create_variable (&default_dict,
+ fx.name[fx.cname++],
+ type, f->f.w);
+ if (!v)
+ {
+ msg (SE, _("%s is a duplicate variable name."), fx.name[i]);
+ return 0;
+ }
+
+ fx.spec.input = f->f;
+ convert_fmt_ItoO (&fx.spec.input, &v->print);
+ v->write = v->print;
+
+ fx.spec.rec = fx.recno;
+ fx.spec.fc = fx.sc;
+ fx.spec.lc = fx.sc + f->f.w - 1;
+ fx.spec.fv = v->fv;
+ fx.spec.type = v->type == NUMERIC ? 0 : v->width;
+ append_var_spec (&fx.spec);
+
+ fx.sc += f->f.w;
+ }
+ return 1;
+}
+
+/* Calls itself recursively to parse nested levels of parentheses.
+ Returns to its original caller: NULL, to indicate error; non-NULL,
+ but nothing useful, to indicate success (it returns a free()'d
+ block). */
+static struct fmt_list *
+fixed_parse_fortran (void)
+{
+ struct fmt_list *head;
+ struct fmt_list *fl = NULL;
+
+ lex_get (); /* Skip opening parenthesis. */
+ while (token != ')')
+ {
+ if (fl)
+ fl = fl->next = xmalloc (sizeof *fl);
+ else
+ head = fl = xmalloc (sizeof *fl);
+
+ if (lex_integer_p ())
+ {
+ fl->count = lex_integer ();
+ lex_get ();
+ }
+ else
+ fl->count = 1;
+
+ if (token == '(')
+ {
+ fl->f.type = FMT_DESCEND;
+ fx.level++;
+ fl->down = fixed_parse_fortran ();
+ fx.level--;
+ if (!fl->down)
+ goto fail;
+ }
+ else if (lex_match ('/'))
+ fl->f.type = FMT_NEWREC;
+ else if (!parse_format_specifier (&fl->f, 1)
+ || !check_input_specifier (&fl->f))
+ goto fail;
+
+ lex_match (',');
+ }
+ fl->next = NULL;
+ lex_get ();
+
+ if (fx.level)
+ return head;
+
+ fl->next = NULL;
+ dump_fmt_list (head);
+ if (fx.cname < fx.nname)
+ {
+ msg (SE, _("There aren't enough format specifications "
+ "to match the number of variable names given."));
+ goto fail;
+ }
+ destroy_fmt_list (head, 1);
+ return head;
+
+fail:
+ fl->next = NULL;
+ destroy_fmt_list (head, 0);
+
+ return NULL;
+}
+
+/* Displays a table giving information on fixed-format variable
+ parsing on DATA LIST. */
+/* FIXME: The `Columns' column should be divided into three columns,
+ one for the starting column, one for the dash, one for the ending
+ column; then right-justify the starting column and left-justify the
+ ending column. */
+static void
+dump_fixed_table (void)
+{
+ struct dls_var_spec *spec;
+ struct tab_table *t;
+ char *buf;
+ const char *filename;
+ int i;
+
+ for (i = 0, spec = *first; spec; spec = spec->next)
+ i++;
+ t = tab_create (4, i + 1, 0);
+ tab_columns (t, TAB_COL_DOWN, 1);
+ tab_headers (t, 0, 0, 1, 0);
+ tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
+ tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
+ tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
+ tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
+ tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, i);
+ tab_hline (t, TAL_2, 0, 3, 1);
+ tab_dim (t, tab_natural_dimensions);
+
+ for (i = 1, spec = *first; spec; spec = spec->next, i++)
+ {
+ tab_text (t, 0, i, TAB_LEFT, spec->v->name);
+ tab_text (t, 1, i, TAT_PRINTF, "%d", spec->rec);
+ tab_text (t, 2, i, TAT_PRINTF, "%3d-%3d",
+ spec->fc, spec->lc);
+ tab_text (t, 3, i, TAB_LEFT | TAT_FIX,
+ fmt_to_string (&spec->input));
+ }
+
+ if (*first == dls.spec)
+ {
+ filename = fh_handle_name (dls.handle);
+ if (filename == NULL)
+ filename = "";
+ buf = local_alloc (strlen (filename) + INT_DIGITS + 80);
+ sprintf (buf, (dls.handle != inline_file
+ ? _("Reading %d record%s from file %s.")
+ : _("Reading %d record%s from the command file.")),
+ dls.nrec, dls.nrec != 1 ? "s" : "", filename);
+ }
+ else
+ {
+ buf = local_alloc (strlen (_("Occurrence data specifications.")) + 1);
+ strcpy (buf, _("Occurrence data specifications."));
+ }
+
+ tab_title (t, 0, buf);
+ tab_submit (t);
+ fh_handle_name (NULL);
+ local_free (buf);
+}
+\f
+/* Free-format parsing. */
+
+static int
+parse_free (void)
+{
+ struct dls_var_spec spec;
+ struct fmt_spec in, out;
+ char **name;
+ int nname;
+ int i;
+ int type;
+
+#if __CHECKER__
+ memset (&spec, 0, sizeof spec);
+#endif
+ lex_get ();
+ while (token != '.')
+ {
+ if (!parse_DATA_LIST_vars (&name, &nname, PV_NONE))
+ return 0;
+ if (lex_match ('('))
+ {
+ if (!parse_format_specifier (&in, 0) || !check_input_specifier (&in))
+ goto fail;
+ if (!lex_force_match (')'))
+ goto fail;
+ convert_fmt_ItoO (&in, &out);
+ }
+ else
+ {
+ lex_match ('*');
+ in.type = FMT_F;
+ in.w = 8;
+ in.d = 0;
+ out = set_format;
+ }
+
+ spec.input = in;
+ if (in.type == FMT_A || in.type == FMT_AHEX)
+ type = ALPHA;
+ else
+ type = NUMERIC;
+ for (i = 0; i < nname; i++)
+ {
+ struct variable *v;
+
+ spec.v = v = create_variable (&default_dict, name[i], type, in.w);
+ if (!v)
+ {
+ msg (SE, _("%s is a duplicate variable name."), name[i]);
+ return 0;
+ }
+
+ v->print = v->write = out;
+
+ strcpy (spec.name, name[i]);
+ spec.fv = v->fv;
+ spec.type = type == NUMERIC ? 0 : v->width;
+ append_var_spec (&spec);
+ }
+ for (i = 0; i < nname; i++)
+ free (name[i]);
+ free (name);
+ }
+
+ if (token != '.')
+ lex_error (_("expecting end of command"));
+ return 1;
+
+fail:
+ for (i = 0; i < nname; i++)
+ free (name[i]);
+ free (name);
+ return 0;
+}
+
+/* Displays a table giving information on free-format variable parsing
+ on DATA LIST. */
+static void
+dump_free_table (void)
+{
+ struct tab_table *t;
+ int i;
+
+ {
+ struct dls_var_spec *spec;
+ for (i = 0, spec = dls.spec; spec; spec = spec->next)
+ i++;
+ }
+
+ t = tab_create (2, i + 1, 0);
+ tab_columns (t, TAB_COL_DOWN, 1);
+ tab_headers (t, 0, 0, 1, 0);
+ tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
+ tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
+ tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, i);
+ tab_hline (t, TAL_2, 0, 1, 1);
+ tab_dim (t, tab_natural_dimensions);
+
+ {
+ struct dls_var_spec *spec;
+
+ for (i = 1, spec = dls.spec; spec; spec = spec->next, i++)
+ {
+ tab_text (t, 0, i, TAB_LEFT, spec->v->name);
+ tab_text (t, 1, i, TAB_LEFT | TAT_FIX, fmt_to_string (&spec->input));
+ }
+ }
+
+ {
+ const char *filename;
+
+ filename = fh_handle_name (dls.handle);
+ if (filename == NULL)
+ filename = "";
+ tab_title (t, 1,
+ (dls.handle != inline_file
+ ? _("Reading free-form data from file %s.")
+ : _("Reading free-form data from the command file.")),
+ filename);
+ }
+
+ tab_submit (t);
+ fh_handle_name (NULL);
+}
+\f
+/* Input procedure. */
+
+/* Pointer to relevant parsing data. Static just to avoid passing it
+ around so much. */
+static struct data_list_pgm *dlsp;
+
+/* Extracts a field from the current position in the current record.
+ Fields can be unquoted or quoted with single- or double-quote
+ characters. *RET_LEN is set to the field length, *RET_CP is set to
+ the field itself. After parsing the field, sets the current
+ position in the record to just past the field. Returns 0 on
+ failure or a 1-based column number indicating the beginning of the
+ field on success. */
+static int
+cut_field (char **ret_cp, int *ret_len)
+{
+ char *cp, *ep;
+ int len;
+
+ cp = dfm_get_record (dlsp->handle, &len);
+ if (!cp)
+ return 0;
+
+ ep = cp + len;
+
+ /* Skip leading whitespace and commas. */
+ while ((isspace ((unsigned char) *cp) || *cp == ',') && cp < ep)
+ cp++;
+ if (cp >= ep)
+ return 0;
+
+ /* Three types of fields: quoted with ', quoted with ", unquoted. */
+ if (*cp == '\'' || *cp == '"')
+ {
+ int quote = *cp;
+
+ *ret_cp = ++cp;
+ while (cp < ep && *cp != quote)
+ cp++;
+ *ret_len = cp - *ret_cp;
+ if (cp < ep)
+ cp++;
+ else
+ msg (SW, _("Scope of string exceeds line."));
+ }
+ else
+ {
+ *ret_cp = cp;
+ while (cp < ep && !isspace ((unsigned char) *cp) && *cp != ',')
+ cp++;
+ *ret_len = cp - *ret_cp;
+ }
+
+ {
+ int beginning_column;
+
+ dfm_set_record (dlsp->handle, *ret_cp);
+ beginning_column = dfm_get_cur_col (dlsp->handle) + 1;
+
+ dfm_set_record (dlsp->handle, cp);
+
+ return beginning_column;
+ }
+}
+
+static int read_from_data_list_fixed (void);
+static int read_from_data_list_free (void);
+static int read_from_data_list_list (void);
+static int do_reading (int flag);
+
+/* FLAG==0: reads any number of cases into temp_case and calls
+ write_case() for each one, returns garbage. FLAG!=0: reads one
+ case into temp_case and returns -2 on eof, -1 otherwise.
+ Uses dlsp as the relevant parsing description. */
+static int
+do_reading (int flag)
+{
+ int (*func) (void);
+
+ int code;
+
+ dfm_push (dlsp->handle);
+
+ switch (dlsp->type)
+ {
+ case DLS_FIXED:
+ func = read_from_data_list_fixed;
+ break;
+ case DLS_FREE:
+ func = read_from_data_list_free;
+ break;
+ case DLS_LIST:
+ func = read_from_data_list_list;
+ break;
+ default:
+ assert (0);
+ }
+ if (flag)
+ {
+ code = func ();
+ if (code == -2)
+ {
+ if (dlsp->eof == 1)
+ {
+ msg (SE, _("Attempt to read past end of file."));
+ err_failure ();
+ return -2;
+ }
+ dlsp->eof = 1;
+ }
+ else
+ dlsp->eof = 0;
+
+ if (dlsp->end != NULL)
+ {
+ if (code == -2)
+ {
+ printf ("end of file, setting %s to 1\n", dlsp->end->name);
+ temp_case->data[dlsp->end->fv].f = 1.0;
+ code = -1;
+ }
+ else
+ {
+ printf ("not end of file, setting %s to 0\n", dlsp->end->name);
+ temp_case->data[dlsp->end->fv].f = 0.0;
+ }
+ }
+ }
+ else
+ {
+ while (func () != -2)
+ if (!write_case ())
+ {
+ debug_printf ((_("abort in write_case()\n")));
+ break;
+ }
+ fh_close_handle (dlsp->handle);
+#if __CHECKER__
+ code = 0; /* prevent error at `return code;' */
+#endif
+ }
+ dfm_pop (dlsp->handle);
+
+ return code;
+}
+
+/* Reads a case from the data file and parses it according to
+ fixed-format syntax rules. */
+static int
+read_from_data_list_fixed (void)
+{
+ struct dls_var_spec *var_spec = dlsp->spec;
+ int i;
+
+ if (!dfm_get_record (dlsp->handle, NULL))
+ return -2;
+ for (i = 1; i <= dlsp->nrec; i++)
+ {
+ int len;
+ char *line = dfm_get_record (dlsp->handle, &len);
+
+ if (!line)
+ {
+ /* Note that this can't occur on the first record. */
+ msg (SW, _("Partial case of %d of %d records discarded."),
+ i - 1, dlsp->nrec);
+ return -2;
+ }
+
+ for (; var_spec && i == var_spec->rec; var_spec = var_spec->next)
+ {
+ struct data_in di;
+
+ data_in_finite_line (&di, line, len, var_spec->fc, var_spec->lc);
+ di.v = &temp_case->data[var_spec->fv];
+ di.flags = 0;
+ di.f1 = var_spec->fc;
+ di.format = var_spec->input;
+
+ data_in (&di);
+ }
+
+ dfm_fwd_record (dlsp->handle);
+ }
+
+ return -1;
+}
+
+/* Reads a case from the data file and parses it according to
+ free-format syntax rules. */
+static int
+read_from_data_list_free (void)
+{
+ struct dls_var_spec *var_spec;
+ char *field;
+ int len;
+
+ for (var_spec = dlsp->spec; var_spec; var_spec = var_spec->next)
+ {
+ int column;
+
+ /* Cut out a field and read in a new record if necessary. */
+ for (;;)
+ {
+ column = cut_field (&field, &len);
+ if (column != 0)
+ break;
+
+ if (dfm_get_record (dlsp->handle, NULL))
+ dfm_fwd_record (dlsp->handle);
+ if (!dfm_get_record (dlsp->handle, NULL))
+ {
+ if (var_spec != dlsp->spec)
+ msg (SW, _("Partial case discarded. The first variable "
+ "missing was %s."), var_spec->name);
+ return -2;
+ }
+ }
+
+ {
+ struct data_in di;
+
+ di.s = field;
+ di.e = field + len;
+ di.v = &temp_case->data[var_spec->fv];
+ di.flags = 0;
+ di.f1 = column;
+ di.format = var_spec->input;
+ data_in (&di);
+ }
+ }
+ return -1;
+}
+
+/* Reads a case from the data file and parses it according to
+ list-format syntax rules. */
+static int
+read_from_data_list_list (void)
+{
+ struct dls_var_spec *var_spec;
+ char *field;
+ int len;
+
+ if (!dfm_get_record (dlsp->handle, NULL))
+ return -2;
+
+ for (var_spec = dlsp->spec; var_spec; var_spec = var_spec->next)
+ {
+ /* Cut out a field and check for end-of-line. */
+ int column = cut_field (&field, &len);
+
+ if (column == 0)
+ {
+ if (set_undefined)
+ msg (SW, _("Missing value(s) for all variables from %s onward. "
+ "These will be filled with the system-missing value "
+ "or blanks, as appropriate."),
+ var_spec->name);
+ for (; var_spec; var_spec = var_spec->next)
+ if (!var_spec->type)
+ temp_case->data[var_spec->fv].f = SYSMIS;
+ else
+ memset (temp_case->data[var_spec->fv].s, ' ', var_spec->type);
+ break;
+ }
+
+ {
+ struct data_in di;
+
+ di.s = field;
+ di.e = field + len;
+ di.v = &temp_case->data[var_spec->fv];
+ di.flags = 0;
+ di.f1 = column;
+ di.format = var_spec->input;
+ data_in (&di);
+ }
+ }
+
+ dfm_fwd_record (dlsp->handle);
+ return -1;
+}
+
+/* Destroys DATA LIST transformation or input program PGM. */
+static void
+destroy_dls (struct trns_header *pgm)
+{
+ struct data_list_pgm *dls = (struct data_list_pgm *) pgm;
+ struct dls_var_spec *iter, *next;
+
+ iter = dls->spec;
+ while (iter)
+ {
+ next = iter->next;
+ free (iter);
+ iter = next;
+ }
+ fh_close_handle (dls->handle);
+}
+
+/* Note that since this is exclusively an input program, C is
+ guaranteed to be temp_case. */
+static int
+read_one_case (struct trns_header *t, struct ccase *c unused)
+{
+ dlsp = (struct data_list_pgm *) t;
+ return do_reading (1);
+}
+\f
+/* Reads all the records from the data file and passes them to
+ write_case(). */
+static void
+data_list_source_read (void)
+{
+ dlsp = &dls;
+ do_reading (0);
+}
+
+/* Destroys the source's internal data. */
+static void
+data_list_source_destroy_source (void)
+{
+ destroy_dls ((struct trns_header *) & dls);
+}
+
+struct case_stream data_list_source =
+ {
+ NULL,
+ data_list_source_read,
+ NULL,
+ NULL,
+ data_list_source_destroy_source,
+ NULL,
+ "DATA LIST",
+ };
+\f
+/* REPEATING DATA. */
+
+/* Represents a number or a variable. */
+struct rpd_num_or_var
+ {
+ int num; /* Value, or 0. */
+ struct variable *var; /* Variable, if number==0. */
+ };
+
+/* REPEATING DATA private data structure. */
+struct repeating_data_trns
+ {
+ struct trns_header h;
+ struct dls_var_spec *spec; /* Variable parsing specifications. */
+ struct file_handle *handle; /* Input file, never NULL. */
+ /* Do not reorder preceding fields. */
+
+ struct rpd_num_or_var starts_beg; /* STARTS=, before the dash. */
+ struct rpd_num_or_var starts_end; /* STARTS=, after the dash. */
+ struct rpd_num_or_var occurs; /* OCCURS= subcommand. */
+ struct rpd_num_or_var length; /* LENGTH= subcommand. */
+ struct rpd_num_or_var cont_beg; /* CONTINUED=, before the dash. */
+ struct rpd_num_or_var cont_end; /* CONTINUED=, after the dash. */
+ int id_beg, id_end; /* ID subcommand, beginning & end columns. */
+ struct variable *id_var; /* ID subcommand, DATA LIST variable. */
+ struct fmt_spec id_spec; /* ID subcommand, input format spec. */
+ };
+
+/* Information about the transformation being parsed. */
+static struct repeating_data_trns rpd;
+
+static int read_one_set_of_repetitions (struct trns_header *, struct ccase *);
+static int parse_num_or_var (struct rpd_num_or_var *, const char *);
+static int parse_repeating_data (void);
+static void find_variable_input_spec (struct variable *v,
+ struct fmt_spec *spec);
+
+/* Parses the REPEATING DATA command. */
+int
+cmd_repeating_data (void)
+{
+ /* 0=print no table, 1=print table. (TABLE subcommand.) */
+ int table = 1;
+
+ /* Bits are set when a particular subcommand has been seen. */
+ unsigned seen = 0;
+
+ lex_match_id ("REPEATING");
+ lex_match_id ("DATA");
+
+ assert (vfm_source == &input_program_source
+ || vfm_source == &file_type_source);
+
+ rpd.handle = default_handle;
+ rpd.starts_beg.num = 0;
+ rpd.starts_beg.var = NULL;
+ rpd.starts_end = rpd.occurs = rpd.length = rpd.cont_beg
+ = rpd.cont_end = rpd.starts_beg;
+ rpd.id_beg = rpd.id_end = 0;
+ rpd.id_var = NULL;
+ rpd.spec = NULL;
+ first = &rpd.spec;
+ next = NULL;
+
+ lex_match ('/');
+
+ for (;;)
+ {
+ if (lex_match_id ("FILE"))
+ {
+ lex_match ('=');
+ rpd.handle = fh_parse_file_handle ();
+ if (!rpd.handle)
+ return CMD_FAILURE;
+ if (rpd.handle != default_handle)
+ {
+ msg (SE, _("REPEATING DATA must use the same file as its "
+ "corresponding DATA LIST or FILE TYPE."));
+ return CMD_FAILURE;
+ }
+ }
+ else if (lex_match_id ("STARTS"))
+ {
+ lex_match ('=');
+ if (seen & 1)
+ {
+ msg (SE, _("STARTS subcommand given multiple times."));
+ return CMD_FAILURE;
+ }
+ seen |= 1;
+
+ if (!parse_num_or_var (&rpd.starts_beg, "STARTS beginning column"))
+ return CMD_FAILURE;
+
+ lex_negative_to_dash ();
+ if (lex_match ('-'))
+ {
+ if (!parse_num_or_var (&rpd.starts_end, "STARTS ending column"))
+ return CMD_FAILURE;
+ } else {
+ /* Otherwise, rpd.starts_end is left uninitialized.
+ This is okay. We will initialize it later from the
+ record length of the file. We can't do this now
+ because we can't be sure that the user has specified
+ the file handle yet. */
+ }
+
+ if (rpd.starts_beg.num != 0 && rpd.starts_end.num != 0
+ && rpd.starts_beg.num > rpd.starts_end.num)
+ {
+ msg (SE, _("STARTS beginning column (%d) exceeds "
+ "STARTS ending column (%d)."),
+ rpd.starts_beg.num, rpd.starts_end.num);
+ return CMD_FAILURE;
+ }
+ }
+ else if (lex_match_id ("OCCURS"))
+ {
+ lex_match ('=');
+ if (seen & 2)
+ {
+ msg (SE, _("OCCURS subcommand given multiple times."));
+ return CMD_FAILURE;
+ }
+ seen |= 2;
+
+ if (!parse_num_or_var (&rpd.occurs, "OCCURS"))
+ return CMD_FAILURE;
+ }
+ else if (lex_match_id ("LENGTH"))
+ {
+ lex_match ('=');
+ if (seen & 4)
+ {
+ msg (SE, _("LENGTH subcommand given multiple times."));
+ return CMD_FAILURE;
+ }
+ seen |= 4;
+
+ if (!parse_num_or_var (&rpd.length, "LENGTH"))
+ return CMD_FAILURE;
+ }
+ else if (lex_match_id ("CONTINUED"))
+ {
+ lex_match ('=');
+ if (seen & 8)
+ {
+ msg (SE, _("CONTINUED subcommand given multiple times."));
+ return CMD_FAILURE;
+ }
+ seen |= 8;
+
+ if (!lex_match ('/'))
+ {
+ if (!parse_num_or_var (&rpd.cont_beg, "CONTINUED beginning column"))
+ return CMD_FAILURE;
+
+ lex_negative_to_dash ();
+ if (lex_match ('-')
+ && !parse_num_or_var (&rpd.cont_end,
+ "CONTINUED ending column"))
+ return CMD_FAILURE;
+
+ if (rpd.cont_beg.num != 0 && rpd.cont_end.num != 0
+ && rpd.cont_beg.num > rpd.cont_end.num)
+ {
+ msg (SE, _("CONTINUED beginning column (%d) exceeds "
+ "CONTINUED ending column (%d)."),
+ rpd.cont_beg.num, rpd.cont_end.num);
+ return CMD_FAILURE;
+ }
+ }
+ else
+ rpd.cont_beg.num = 1;
+ }
+ else if (lex_match_id ("ID"))
+ {
+ lex_match ('=');
+ if (seen & 16)
+ {
+ msg (SE, _("ID subcommand given multiple times."));
+ return CMD_FAILURE;
+ }
+ seen |= 16;
+
+ if (!lex_force_int ())
+ return CMD_FAILURE;
+ if (lex_integer () < 1)
+ {
+ msg (SE, _("ID beginning column (%ld) must be positive."),
+ lex_integer ());
+ return CMD_FAILURE;
+ }
+ rpd.id_beg = lex_integer ();
+
+ lex_get ();
+ lex_negative_to_dash ();
+
+ if (lex_match ('-'))
+ {
+ if (!lex_force_int ())
+ return CMD_FAILURE;
+ if (lex_integer () < 1)
+ {
+ msg (SE, _("ID ending column (%ld) must be positive."),
+ lex_integer ());
+ return CMD_FAILURE;
+ }
+ if (lex_integer () < rpd.id_end)
+ {
+ msg (SE, _("ID ending column (%ld) cannot be less than "
+ "ID beginning column (%d)."),
+ lex_integer (), rpd.id_beg);
+ return CMD_FAILURE;
+ }
+
+ rpd.id_end = lex_integer ();
+ lex_get ();
+ }
+ else rpd.id_end = rpd.id_beg;
+
+ if (!lex_force_match ('='))
+ return CMD_FAILURE;
+ rpd.id_var = parse_variable ();
+ if (rpd.id_var == NULL)
+ return CMD_FAILURE;
+
+ find_variable_input_spec (rpd.id_var, &rpd.id_spec);
+ }
+ else if (lex_match_id ("TABLE"))
+ table = 1;
+ else if (lex_match_id ("NOTABLE"))
+ table = 0;
+ else if (lex_match_id ("DATA"))
+ break;
+ else
+ {
+ lex_error (NULL);
+ return CMD_FAILURE;
+ }
+
+ if (!lex_force_match ('/'))
+ return CMD_FAILURE;
+ }
+
+ /* Comes here when DATA specification encountered. */
+ if ((seen & (1 | 2)) != (1 | 2))
+ {
+ if ((seen & 1) == 0)
+ msg (SE, _("Missing required specification STARTS."));
+ if ((seen & 2) == 0)
+ msg (SE, _("Missing required specification OCCURS."));
+ return CMD_FAILURE;
+ }
+
+ /* Enforce ID restriction. */
+ if ((seen & 16) && !(seen & 8))
+ {
+ msg (SE, _("ID specified without CONTINUED."));
+ return CMD_FAILURE;
+ }
+
+ /* Calculate starts_end, cont_end if necessary. */
+ if (rpd.starts_end.num == 0 && rpd.starts_end.var == NULL)
+ rpd.starts_end.num = fh_record_width (rpd.handle);
+ if (rpd.cont_end.num == 0 && rpd.starts_end.var == NULL)
+ rpd.cont_end.num = fh_record_width (rpd.handle);
+
+ /* Calculate length if possible. */
+ if ((seen & 4) == 0)
+ {
+ struct dls_var_spec *iter;
+
+ for (iter = rpd.spec; iter; iter = iter->next)
+ {
+ if (iter->lc > rpd.length.num)
+ rpd.length.num = iter->lc;
+ }
+ assert (rpd.length.num != 0);
+ }
+
+ lex_match ('=');
+ if (!parse_repeating_data ())
+ return CMD_FAILURE;
+
+ if (table)
+ dump_fixed_table ();
+
+ {
+ struct repeating_data_trns *new_trns;
+
+ rpd.h.proc = read_one_set_of_repetitions;
+ rpd.h.free = destroy_dls;
+
+ new_trns = xmalloc (sizeof *new_trns);
+ memcpy (new_trns, &rpd, sizeof *new_trns);
+ add_transformation ((struct trns_header *) new_trns);
+ }
+
+ return lex_end_of_command ();
+}
+
+/* Because of the way that DATA LIST is structured, it's not trivial
+ to determine what input format is associated with a given variable.
+ This function finds the input format specification for variable V
+ and puts it in SPEC. */
+static void
+find_variable_input_spec (struct variable *v, struct fmt_spec *spec)
+{
+ int i;
+
+ for (i = 0; i < n_trns; i++)
+ {
+ struct data_list_pgm *pgm = (struct data_list_pgm *) t_trns[i];
+
+ if (pgm->h.proc == read_one_case)
+ {
+ struct dls_var_spec *iter;
+
+ for (iter = pgm->spec; iter; iter = iter->next)
+ if (iter->v == v)
+ {
+ *spec = iter->input;
+ return;
+ }
+ }
+ }
+
+ assert (0);
+}
+
+/* Parses a number or a variable name from the syntax file and puts
+ the results in VALUE. Ensures that the number is at least 1; else
+ emits an error based on MESSAGE. Returns nonzero only if
+ successful. */
+static int
+parse_num_or_var (struct rpd_num_or_var *value, const char *message)
+{
+ if (token == T_ID)
+ {
+ value->num = 0;
+ value->var = parse_variable ();
+ if (value->var == NULL)
+ return 0;
+ if (value->var->type == ALPHA)
+ {
+ msg (SE, _("String variable not allowed here."));
+ return 0;
+ }
+ }
+ else if (lex_integer_p ())
+ {
+ value->num = lex_integer ();
+
+ if (value->num < 1)
+ {
+ msg (SE, _("%s (%d) must be at least 1."), message, value->num);
+ return 0;
+ }
+
+ lex_get ();
+ } else {
+ msg (SE, _("Variable or integer expected for %s."), message);
+ return 0;
+ }
+ return 1;
+}
+
+/* Parses data specifications for repeating data groups. Taken from
+ parse_fixed(). Returns nonzero only if successful. */
+static int
+parse_repeating_data (void)
+{
+ int i;
+
+ fx.recno = 0;
+ fx.sc = 1;
+
+ while (token != '.')
+ {
+ fx.spec.rec = fx.recno;
+
+ if (!parse_DATA_LIST_vars (&fx.name, &fx.nname, PV_NONE))
+ return 0;
+
+ if (token == T_NUM)
+ {
+ if (!fixed_parse_compatible ())
+ goto fail;
+ }
+ else if (token == '(')
+ {
+ fx.level = 0;
+ fx.cname = 0;
+ if (!fixed_parse_fortran ())
+ goto fail;
+ }
+ else
+ {
+ msg (SE, _("SPSS-like or FORTRAN-like format "
+ "specification expected after variable names."));
+ goto fail;
+ }
+
+ for (i = 0; i < fx.nname; i++)
+ free (fx.name[i]);
+ free (fx.name);
+ }
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ return 0;
+ }
+
+ return 1;
+
+fail:
+ for (i = 0; i < fx.nname; i++)
+ free (fx.name[i]);
+ free (fx.name);
+ return 0;
+}
+
+/* Obtains the real value for rpd_num_or_var N in case C and returns
+ it. The valid range is nonnegative numbers, but numbers outside
+ this range can be returned and should be handled by the caller as
+ invalid. */
+static int
+realize_value (struct rpd_num_or_var *n, struct ccase *c)
+{
+ if (n->num > 0)
+ return n->num;
+
+ assert (n->num == 0);
+ if (n->var != NULL)
+ {
+ double v = c->data[n->var->fv].f;
+
+ if (v == SYSMIS || v <= INT_MIN || v >= INT_MAX)
+ return -1;
+ else
+ return v;
+ }
+ else
+ return 0;
+}
+
+/* Parses one record of repeated data and outputs corresponding cases.
+ Repeating data is present in line LINE having length LEN.
+ Repeating data begins in column BEG and continues through column
+ END inclusive (1-based columns); occurrences are offset OFS columns
+ from each other. C is the case that will be filled in; T is the
+ REPEATING DATA transformation. The record ID will be verified if
+ COMPARE_ID is nonzero; if it is zero, then the record ID is
+ initialized to the ID present in the case (assuming that ID
+ location was specified by the user). Returns number of occurrences
+ parsed up to the specified maximum of MAX_OCCURS. */
+static int
+rpd_parse_record (int beg, int end, int ofs, struct ccase *c,
+ struct repeating_data_trns *t,
+ char *line, int len, int compare_id, int max_occurs)
+{
+ int occurrences;
+ int cur = beg;
+
+ /* Handle record ID values. */
+ if (t->id_beg != 0)
+ {
+ static union value comparator;
+ union value v;
+
+ {
+ struct data_in di;
+
+ data_in_finite_line (&di, line, len, t->id_beg, t->id_end);
+ di.v = &v;
+ di.flags = 0;
+ di.f1 = t->id_beg;
+ di.format = t->id_spec;
+
+ if (!data_in (&di))
+ return 0;
+ }
+
+ if (compare_id == 0)
+ comparator = v;
+ else if ((t->id_var->type == NUMERIC && comparator.f != v.f)
+ || (t->id_var->type == ALPHA
+ && strncmp (comparator.s, v.s, t->id_var->width)))
+ {
+ char comp_str [64];
+ char v_str [64];
+
+ if (!data_out (comp_str, &t->id_var->print, &comparator))
+ comp_str[0] = 0;
+ if (!data_out (v_str, &t->id_var->print, &v))
+ v_str[0] = 0;
+
+ comp_str[t->id_var->print.w] = v_str[t->id_var->print.w] = 0;
+
+ tmsg (SE, RPD_ERR,
+ _("Mismatched case ID (%s). Expected value was %s."),
+ v_str, comp_str);
+
+ return 0;
+ }
+ }
+
+ /* Iterate over the set of expected occurrences and record each of
+ them as a separate case. FIXME: We need to execute any
+ transformations that follow the current one. */
+ {
+ int warned = 0;
+
+ for (occurrences = 0; occurrences < max_occurs; )
+ {
+ if (cur + ofs > end + 1)
+ break;
+ occurrences++;
+
+ {
+ struct dls_var_spec *var_spec = t->spec;
+
+ for (; var_spec; var_spec = var_spec->next)
+ {
+ int fc = var_spec->fc - 1 + cur;
+ int lc = var_spec->lc - 1 + cur;
+
+ if (fc > len && !warned && var_spec->input.type != FMT_A)
+ {
+ warned = 1;
+
+ tmsg (SW, RPD_ERR,
+ _("Variable %s startging in column %d extends "
+ "beyond physical record length of %d."),
+ var_spec->v->name, fc, len);
+ }
+
+ {
+ struct data_in di;
+
+ data_in_finite_line (&di, line, len, fc, lc);
+ di.v = &c->data[var_spec->fv];
+ di.flags = 0;
+ di.f1 = fc + 1;
+ di.format = var_spec->input;
+
+ if (!data_in (&di))
+ return 0;
+ }
+ }
+ }
+
+ cur += ofs;
+
+ if (!write_case ())
+ return 0;
+ }
+ }
+
+ return occurrences;
+}
+
+/* Analogous to read_one_case; reads one set of repetitions of the
+ elements in the REPEATING DATA structure. Returns -1 on success,
+ -2 on end of file or on failure. */
+static int
+read_one_set_of_repetitions (struct trns_header *trns, struct ccase *c)
+{
+ dfm_push (dlsp->handle);
+
+ {
+ struct repeating_data_trns *t = (struct repeating_data_trns *) trns;
+
+ char *line; /* Current record. */
+ int len; /* Length of current record. */
+
+ int starts_beg; /* Starting column. */
+ int starts_end; /* Ending column. */
+ int occurs; /* Number of repetitions. */
+ int length; /* Length of each occurrence. */
+ int cont_beg; /* Starting column for continuation lines. */
+ int cont_end; /* Ending column for continuation lines. */
+
+ int occurs_left; /* Number of occurrences remaining. */
+
+ int code; /* Return value from rpd_parse_record(). */
+
+ int skip_first_record = 0;
+
+ /* Read the current record. */
+ dfm_bkwd_record (dlsp->handle, 1);
+ line = dfm_get_record (dlsp->handle, &len);
+ if (line == NULL)
+ return -2;
+ dfm_fwd_record (dlsp->handle);
+
+ /* Calculate occurs, length. */
+ occurs_left = occurs = realize_value (&t->occurs, c);
+ if (occurs <= 0)
+ {
+ tmsg (SE, RPD_ERR, _("Invalid value %d for OCCURS."), occurs);
+ return -3;
+ }
+ starts_beg = realize_value (&t->starts_beg, c);
+ if (starts_beg <= 0)
+ {
+ tmsg (SE, RPD_ERR, _("Beginning column for STARTS (%d) must be "
+ "at least 1."),
+ starts_beg);
+ return -3;
+ }
+ starts_end = realize_value (&t->starts_end, c);
+ if (starts_end < starts_beg)
+ {
+ tmsg (SE, RPD_ERR, _("Ending column for STARTS (%d) is less than "
+ "beginning column (%d)."),
+ starts_end, starts_beg);
+ skip_first_record = 1;
+ }
+ length = realize_value (&t->length, c);
+ if (length < 0)
+ {
+ tmsg (SE, RPD_ERR, _("Invalid value %d for LENGTH."), length);
+ length = 1;
+ occurs = occurs_left = 1;
+ }
+ cont_beg = realize_value (&t->cont_beg, c);
+ if (cont_beg < 0)
+ {
+ tmsg (SE, RPD_ERR, _("Beginning column for CONTINUED (%d) must be "
+ "at least 1."),
+ cont_beg);
+ return -2;
+ }
+ cont_end = realize_value (&t->cont_end, c);
+ if (cont_end < cont_beg)
+ {
+ tmsg (SE, RPD_ERR, _("Ending column for CONTINUED (%d) is less than "
+ "beginning column (%d)."),
+ cont_end, cont_beg);
+ return -2;
+ }
+
+ /* Parse the first record. */
+ if (!skip_first_record)
+ {
+ code = rpd_parse_record (starts_beg, starts_end, length, c, t, line,
+ len, 0, occurs_left);
+ if (!code)
+ return -2;
+ }
+ else if (cont_beg == 0)
+ return -3;
+
+ /* Make sure, if some occurrences are left, that we have
+ continuation records. */
+ occurs_left -= code;
+ if (occurs_left != 0 && cont_beg == 0)
+ {
+ tmsg (SE, RPD_ERR,
+ _("Number of repetitions specified on OCCURS (%d) "
+ "exceed number of repetitions available in "
+ "space on STARTS (%d), and CONTINUED not specified."),
+ occurs, code);
+ return -2;
+ }
+
+ /* Go on to additional records. */
+ while (occurs_left != 0)
+ {
+ assert (occurs_left >= 0);
+
+ /* Read in another record. */
+ line = dfm_get_record (dlsp->handle, &len);
+ if (line == NULL)
+ {
+ tmsg (SE, RPD_ERR,
+ _("Unexpected end of file with %d repetitions "
+ "remaining out of %d."),
+ occurs_left, occurs);
+ return -2;
+ }
+ dfm_fwd_record (dlsp->handle);
+
+ /* Parse this record. */
+ code = rpd_parse_record (cont_beg, cont_end, length, c, t, line,
+ len, 1, occurs_left);
+ if (!code)
+ return -2;
+ occurs_left -= code;
+ }
+ }
+
+ dfm_pop (dlsp->handle);
+
+ /* FIXME: This is a kluge until we've implemented multiplexing of
+ transformations. */
+ return -3;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <ctype.h>
+#include <math.h>
+#include <float.h>
+#include <stdlib.h>
+#include <time.h>
+#include "approx.h"
+#include "error.h"
+#include "format.h"
+#include "julcal/julcal.h"
+#include "magic.h"
+#include "misc.h"
+#include "misc.h"
+#include "settings.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* In older versions, numbers got their trailing zeros stripped.
+ Newer versions leave them on when there's room. Comment this next
+ line out for retro styling. */
+#define NEW_STYLE 1
+\f
+/* Public functions. */
+
+typedef int convert_func (char *, const struct fmt_spec *,
+ const union value *);
+
+static convert_func convert_F, convert_N, convert_E, convert_F_plus;
+static convert_func convert_Z, convert_A, convert_AHEX, convert_IB;
+static convert_func convert_P, convert_PIB, convert_PIBHEX, convert_PK;
+static convert_func convert_RB, convert_RBHEX, convert_CCx, convert_date;
+static convert_func convert_time, convert_WKDAY, convert_MONTH;
+static convert_func try_F;
+
+/* Converts binary value V into printable form in string S according
+ to format specification FP. The string as written has exactly
+ FP->W characters. It is not null-terminated. Returns 1 on
+ success, 0 on failure. */
+int
+data_out (char *s, const struct fmt_spec *fp, const union value *v)
+{
+ union value tmp_val;
+
+ {
+ int cat = formats[fp->type].cat;
+ if ((cat & FCAT_BLANKS_SYSMIS) && v->f == SYSMIS)
+ {
+ memset (s, ' ', fp->w);
+ s[fp->w - fp->d - 1] = '.';
+ return 1;
+ }
+ if ((cat & FCAT_SHIFT_DECIMAL) && v->f != SYSMIS && fp->d)
+ {
+ tmp_val.f = v->f * pow (10.0, fp->d);
+ v = &tmp_val;
+ }
+ }
+
+ {
+ static convert_func *const handlers[FMT_NUMBER_OF_FORMATS] =
+ {
+ convert_F, convert_N, convert_E, convert_F_plus,
+ convert_F_plus, convert_F_plus, convert_F_plus,
+ convert_Z, convert_A, convert_AHEX, convert_IB, convert_P, convert_PIB,
+ convert_PIBHEX, convert_PK, convert_RB, convert_RBHEX,
+ convert_CCx, convert_CCx, convert_CCx, convert_CCx, convert_CCx,
+ convert_date, convert_date, convert_date, convert_date, convert_date,
+ convert_date, convert_date, convert_date, convert_date,
+ convert_time, convert_time,
+ convert_WKDAY, convert_MONTH,
+ };
+
+ return handlers[fp->type] (s, fp, v);
+ }
+}
+
+/* Converts V into S in F format with width W and D decimal places,
+ then deletes trailing zeros. S is not null-terminated. */
+void
+num_to_string (double v, char *s, int w, int d)
+{
+ /* Dummies to pass to convert_F. */
+ union value val;
+ struct fmt_spec f;
+
+#if !NEW_STYLE
+ /* Pointer to `.' in S. */
+ char *decp;
+
+ /* Pointer to `E' in S. */
+ char *expp;
+
+ /* Number of characters to delete. */
+ int n = 0;
+#endif
+
+ f.w = w;
+ f.d = d;
+ val.f = v;
+
+ /* Cut out the jokers. */
+ if (!finite (v))
+ {
+ char temp[9];
+ int len;
+
+ if (isnan (v))
+ {
+ memcpy (temp, "NaN", 3);
+ len = 3;
+ }
+ else if (isinf (v))
+ {
+ memcpy (temp, "+Infinity", 9);
+ if (v < 0)
+ temp[0] = '-';
+ len = 9;
+ }
+ else
+ {
+ memcpy (temp, _("Unknown"), 7);
+ len = 7;
+ }
+ if (w > len)
+ {
+ int pad = w - len;
+ memset (s, ' ', pad);
+ s += pad;
+ w -= pad;
+ }
+ memcpy (s, temp, w);
+ return;
+ }
+
+ try_F (s, &f, &val);
+
+#if !NEW_STYLE
+ decp = memchr (s, set_decimal, w);
+ if (!decp)
+ return;
+
+ /* If there's an `E' we can only delete 0s before the E. */
+ expp = memchr (s, 'E', w);
+ if (expp)
+ {
+ while (expp[-n - 1] == '0')
+ n++;
+ if (expp[-n - 1] == set_decimal)
+ n++;
+ memmove (&s[n], s, expp - s - n);
+ memset (s, ' ', n);
+ return;
+ }
+
+ /* Otherwise delete all trailing 0s. */
+ n++;
+ while (s[w - n] == '0')
+ n++;
+ if (s[w - n] != set_decimal)
+ {
+ /* Avoid stripping `.0' to `'. */
+ if (w == n || !isdigit ((unsigned char) s[w - n - 1]))
+ n -= 2;
+ }
+ else
+ n--;
+ memmove (&s[n], s, w - n);
+ memset (s, ' ', n);
+#endif
+}
+\f
+/* Main conversion functions. */
+
+static void insert_commas (char *dst, const char *src,
+ const struct fmt_spec *fp);
+static int year4 (int year);
+static int try_CCx (char *s, const struct fmt_spec *fp, double v);
+
+#if FLT_RADIX!=2
+#error Write your own floating-point output routines.
+#endif
+
+/* PORTME:
+
+ Some of the routines in this file are likely very specific to
+ base-2 representation of floating-point numbers, most notably the
+ routines that use frexp() or ldexp(). These attempt to extract
+ individual digits by setting the base-2 exponent and
+ multiplying/dividing by powers of 2. In base-2 numeration systems,
+ this just nudges the exponent up or down, but in base-10 floating
+ point, such multiplications/division can cause catastrophic loss of
+ precision.
+
+ The author has never personally used a machine that didn't use
+ binary floating point formats, so he is unwilling, and perhaps
+ unable, to code around this "problem". */
+
+/* Converts a number between 0 and 15 inclusive to a `hexit'
+ [0-9A-F]. */
+#define MAKE_HEXIT(X) ("0123456789ABCDEF"[X])
+
+/* Table of powers of 10. */
+static const double power10[] =
+ {
+ 0, /* Not used. */
+ 1e01, 1e02, 1e03, 1e04, 1e05, 1e06, 1e07, 1e08, 1e09, 1e10,
+ 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, 1e20,
+ 1e21, 1e22, 1e23, 1e24, 1e25, 1e26, 1e27, 1e28, 1e29, 1e30,
+ 1e31, 1e32, 1e33, 1e34, 1e35, 1e36, 1e37, 1e38, 1e39, 1e40,
+ };
+
+/* Handles F format. */
+static int
+convert_F (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ if (!try_F (dst, fp, v))
+ convert_E (dst, fp, v);
+ return 1;
+}
+
+/* Handles N format. */
+static int
+convert_N (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ double d = floor (v->f);
+
+ if (d < 0 || d == SYSMIS)
+ {
+ msg (ME, _("The N output format cannot be used to output a "
+ "negative number or the system-missing value."));
+ return 0;
+ }
+
+ if (d < power10[fp->w])
+ {
+ char buf[128];
+ sprintf (buf, "%0*.0f", fp->w, v->f);
+ memcpy (dst, buf, fp->w);
+ }
+ else
+ memset (dst, '*', fp->w);
+
+ return 1;
+}
+
+/* Handles E format. Also operates as fallback for some other
+ formats. */
+static int
+convert_E (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ /* Temporary buffer. */
+ char buf[128];
+
+ /* Ranged number of decimal places. */
+ int d;
+
+ /* Check that the format is width enough.
+ Although PSPP generally checks this, convert_E() can be called as
+ a fallback from other formats which do not check. */
+ if (fp->w < 6)
+ {
+ memset (dst, '*', fp->w);
+ return 1;
+ }
+
+ /* Put decimal places in usable range. */
+ d = min (fp->d, fp->w - 6);
+ if (v->f < 0)
+ d--;
+ if (d < 0)
+ d = 0;
+ sprintf (buf, "%*.*E", fp->w, d, v->f);
+
+ /* What we do here is force the exponent part to have four
+ characters whenever possible. That is, 1.00E+99 is okay (`E+99')
+ but 1.00E+100 (`E+100') must be coerced to 1.00+100 (`+100'). On
+ the other hand, 1.00E1000 (`E+100') cannot be canonicalized.
+ Note that ANSI C guarantees at least two digits in the
+ exponent. */
+ if (fabs (v->f) > 1e99)
+ {
+ /* Pointer to the `E' in buf. */
+ char *cp;
+
+ cp = strchr (buf, 'E');
+ if (cp)
+ {
+ /* Exponent better not be bigger than an int. */
+ int exp = atoi (cp + 1);
+
+ if (abs (exp) > 99 && abs (exp) < 1000)
+ {
+ /* Shift everything left one place: 1.00e+100 -> 1.00+100. */
+ cp[0] = cp[1];
+ cp[1] = cp[2];
+ cp[2] = cp[3];
+ cp[3] = cp[4];
+ }
+ else if (abs (exp) >= 1000)
+ memset (buf, '*', fp->w);
+ }
+ }
+
+ /* The C locale always uses a period `.' as a decimal point.
+ Translate to comma if necessary. */
+ if ((set_decimal == ',' && fp->type != FMT_DOT)
+ || (set_decimal == '.' && fp->type == FMT_DOT))
+ {
+ char *cp = strchr (buf, '.');
+ if (cp)
+ *cp = ',';
+ }
+
+ memcpy (dst, buf, fp->w);
+ return 1;
+}
+
+/* Handles COMMA, DOT, DOLLAR, and PCT formats. */
+static int
+convert_F_plus (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ char buf[40];
+
+ if (try_F (buf, fp, v))
+ insert_commas (dst, buf, fp);
+ else
+ convert_E (dst, fp, v);
+
+ return 1;
+}
+
+static int
+convert_Z (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ static int warned = 0;
+
+ if (!warned)
+ {
+ msg (MW, _("Quality of zoned decimal (Z) output format code is "
+ "suspect. Check your results, report bugs to author."));
+ warned = 1;
+ }
+
+ if (v->f == SYSMIS)
+ {
+ msg (ME, _("The system-missing value cannot be output as a zoned "
+ "decimal number."));
+ return 0;
+ }
+
+ {
+ char buf[41];
+ double d;
+ int i;
+
+ d = fabs (floor (v->f));
+ if (d >= power10[fp->w])
+ {
+ msg (ME, _("Number %g too big to fit in field with format Z%d.%d."),
+ v->f, fp->w, fp->d);
+ return 0;
+ }
+
+ sprintf (buf, "%*.0f", fp->w, v->f);
+ for (i = 0; i < fp->w; i++)
+ dst[i] = (buf[i] - '0') | 0xf0;
+ if (v->f < 0)
+ dst[fp->w - 1] &= 0xdf;
+ }
+
+ return 1;
+}
+
+static int
+convert_A (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ memcpy (dst, v->c, fp->w);
+ return 1;
+}
+
+static int
+convert_AHEX (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ int i;
+
+ for (i = 0; i < fp->w / 2; i++)
+ {
+ ((unsigned char *) dst)[i * 2] = MAKE_HEXIT ((v->c[i]) >> 4);
+ ((unsigned char *) dst)[i * 2 + 1] = MAKE_HEXIT ((v->c[i]) & 0xf);
+ }
+
+ return 1;
+}
+
+static int
+convert_IB (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ /* Strategy: Basically the same as convert_PIBHEX() but with base
+ 256. Then it's necessary to negate the two's-complement result if
+ v->f is negative. */
+
+ /* Used for constructing the two's-complement result. */
+ unsigned temp[8];
+
+ /* Fraction (mantissa). */
+ double frac;
+
+ /* Exponent. */
+ int exp;
+
+ /* Difference between exponent and (-8*fp->w-1). */
+ int diff;
+
+ /* Counter. */
+ int i;
+
+ /* Make the exponent (-8*fp->w-1). */
+ frac = frexp (fabs (v->f), &exp);
+ diff = exp - (-8 * fp->w - 1);
+ exp -= diff;
+ frac *= ldexp (1.0, diff);
+
+ /* Extract each base-256 digit. */
+ for (i = 0; i < fp->w; i++)
+ {
+ modf (frac, &frac);
+ frac *= 256.0;
+ temp[i] = floor (frac);
+ }
+
+ /* Perform two's-complement negation if v->f is negative. */
+ if (v->f < 0)
+ {
+ /* Perform NOT operation. */
+ for (i = 0; i < fp->w; i++)
+ temp[i] = ~temp[i];
+ /* Add 1 to the whole number. */
+ for (i = fp->w - 1; i >= 0; i--)
+ {
+ temp[i]++;
+ if (temp[i])
+ break;
+ }
+ }
+ memcpy (dst, temp, fp->w);
+ if (endian == LITTLE)
+ mm_reverse (dst, fp->w);
+
+ return 1;
+}
+
+static int
+convert_P (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ /* Buffer for v->f*2-1 characters + a decimal point if library is
+ not quite compliant + a null. */
+ char buf[17];
+
+ /* Counter. */
+ int i;
+
+ /* Main extraction. */
+ sprintf (buf, "%0*.0f", fp->w * 2 - 1, floor (fabs (v->f)));
+
+ for (i = 0; i < fp->w; i++)
+ ((unsigned char *) dst)[i]
+ = ((buf[i * 2] - '0') << 4) + buf[i * 2 + 1] - '0';
+
+ /* Set sign. */
+ dst[fp->w - 1] &= 0xf0;
+ if (v->f >= 0.0)
+ dst[fp->w - 1] |= 0xf;
+ else
+ dst[fp->w - 1] |= 0xd;
+
+ return 1;
+}
+
+static int
+convert_PIB (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ /* Strategy: Basically the same as convert_IB(). */
+
+ /* Fraction (mantissa). */
+ double frac;
+
+ /* Exponent. */
+ int exp;
+
+ /* Difference between exponent and (-8*fp->w). */
+ int diff;
+
+ /* Counter. */
+ int i;
+
+ /* Make the exponent (-8*fp->w). */
+ frac = frexp (fabs (v->f), &exp);
+ diff = exp - (-8 * fp->w);
+ exp -= diff;
+ frac *= ldexp (1.0, diff);
+
+ /* Extract each base-256 digit. */
+ for (i = 0; i < fp->w; i++)
+ {
+ modf (frac, &frac);
+ frac *= 256.0;
+ ((unsigned char *) dst)[i] = floor (frac);
+ }
+ if (endian == LITTLE)
+ mm_reverse (dst, fp->w);
+
+ return 1;
+}
+
+static int
+convert_PIBHEX (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ /* Strategy: Use frexp() to create a normalized result (but mostly
+ to find the base-2 exponent), then change the base-2 exponent to
+ (-4*fp->w) using multiplication and division by powers of two.
+ Extract each hexit by multiplying by 16. */
+
+ /* Fraction (mantissa). */
+ double frac;
+
+ /* Exponent. */
+ int exp;
+
+ /* Difference between exponent and (-4*fp->w). */
+ int diff;
+
+ /* Counter. */
+ int i;
+
+ /* Make the exponent (-4*fp->w). */
+ frac = frexp (fabs (v->f), &exp);
+ diff = exp - (-4 * fp->w);
+ exp -= diff;
+ frac *= ldexp (1.0, diff);
+
+ /* Extract each hexit. */
+ for (i = 0; i < fp->w; i++)
+ {
+ modf (frac, &frac);
+ frac *= 16.0;
+ *dst++ = MAKE_HEXIT ((int) floor (frac));
+ }
+
+ return 1;
+}
+
+static int
+convert_PK (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ /* Buffer for v->f*2 characters + a decimal point if library is not
+ quite compliant + a null. */
+ char buf[18];
+
+ /* Counter. */
+ int i;
+
+ /* Main extraction. */
+ sprintf (buf, "%0*.0f", fp->w * 2, floor (fabs (v->f)));
+
+ for (i = 0; i < fp->w; i++)
+ ((unsigned char *) dst)[i]
+ = ((buf[i * 2] - '0') << 4) + buf[i * 2 + 1] - '0';
+
+ return 1;
+}
+
+static int
+convert_RB (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ union
+ {
+ double d;
+ char c[8];
+ }
+ u;
+
+ u.d = v->f;
+ memcpy (dst, u.c, fp->w);
+
+ return 1;
+}
+
+static int
+convert_RBHEX (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ union
+ {
+ double d;
+ char c[8];
+ }
+ u;
+
+ int i;
+
+ u.d = v->f;
+ for (i = 0; i < fp->w / 2; i++)
+ {
+ *dst++ = MAKE_HEXIT (u.c[i] >> 4);
+ *dst++ = MAKE_HEXIT (u.c[i] & 15);
+ }
+
+ return 1;
+}
+
+static int
+convert_CCx (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ if (try_CCx (dst, fp, v->f))
+ return 1;
+ else
+ {
+ struct fmt_spec f;
+
+ f.type = FMT_COMMA;
+ f.w = fp->w;
+ f.d = fp->d;
+
+ return convert_F (dst, &f, v);
+ }
+}
+
+static int
+convert_date (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ static const char *months[12] =
+ {
+ "JAN", "FEB", "MAR", "APR", "MAY", "JUN",
+ "JUL", "AUG", "SEP", "OCT", "NOV", "DEC",
+ };
+
+ char buf[64] = {0};
+ int month, day, year;
+
+ julian_to_calendar (v->f / 86400., &year, &month, &day);
+ switch (fp->type)
+ {
+ case FMT_DATE:
+ if (fp->w >= 11)
+ sprintf (buf, "%02d-%s-%04d", day, months[month - 1], year);
+ else
+ sprintf (buf, "%02d-%s-%02d", day, months[month - 1], year % 100);
+ break;
+ case FMT_EDATE:
+ if (fp->w >= 10)
+ sprintf (buf, "%02d.%02d.%04d", day, month, year);
+ else
+ sprintf (buf, "%02d.%02d.%02d", day, month, year % 100);
+ break;
+ case FMT_SDATE:
+ if (fp->w >= 10)
+ sprintf (buf, "%04d/%02d/%02d", year, month, day);
+ else
+ sprintf (buf, "%02d/%02d/%02d", year % 100, month, day);
+ break;
+ case FMT_ADATE:
+ if (fp->w >= 10)
+ sprintf (buf, "%02d/%02d/%04d", month, day, year);
+ else
+ sprintf (buf, "%02d/%02d/%02d", month, day, year % 100);
+ break;
+ case FMT_JDATE:
+ {
+ int yday = (v->f / 86400.) - calendar_to_julian (year, 1, 1) + 1;
+
+ if (fp->w >= 7)
+ {
+ if (year4 (year))
+ sprintf (buf, "%04d%03d", year, yday);
+ }
+ else
+ sprintf (buf, "%02d%03d", year % 100, yday);
+ break;
+ }
+ case FMT_QYR:
+ if (fp->w >= 8)
+ sprintf (buf, "%d Q% 04d", (month - 1) / 3 + 1, year);
+ else
+ sprintf (buf, "%d Q% 02d", (month - 1) / 3 + 1, year % 100);
+ break;
+ case FMT_MOYR:
+ if (fp->w >= 8)
+ sprintf (buf, "%s% 04d", months[month - 1], year);
+ else
+ sprintf (buf, "%s% 02d", months[month - 1], year % 100);
+ break;
+ case FMT_WKYR:
+ {
+ int yday = (v->f / 86400.) - calendar_to_julian (year, 1, 1) + 1;
+
+ if (fp->w >= 10)
+ sprintf (buf, "%02d WK% 04d", (yday - 1) / 7 + 1, year);
+ else
+ sprintf (buf, "%02d WK% 02d", (yday - 1) / 7 + 1, year % 100);
+ }
+ break;
+ case FMT_DATETIME:
+ {
+ char *cp;
+
+ cp = spprintf (buf, "%02d-%s-%04d %02d:%02d",
+ day, months[month - 1], year,
+ (int) fmod (floor (v->f / 60. / 60.), 24.),
+ (int) fmod (floor (v->f / 60.), 60.));
+ if (fp->w >= 20)
+ {
+ int w, d;
+
+ if (fp->w >= 22 && fp->d > 0)
+ {
+ d = min (fp->d, fp->w - 21);
+ w = 3 + d;
+ }
+ else
+ {
+ w = 2;
+ d = 0;
+ }
+
+ cp = spprintf (cp, ":%0*.*f", w, d, fmod (v->f, 60.));
+ }
+ }
+ break;
+#if __CHECKER__
+ case 42000:
+ assert (0);
+#endif
+ default:
+ assert (0);
+ }
+
+ if (buf[0] == 0)
+ return 0;
+ st_bare_pad_copy (dst, buf, fp->w);
+ return 1;
+}
+
+static int
+convert_time (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ char temp_buf[40];
+ char *cp;
+
+ double time;
+ int width;
+
+ if (fabs (v->f) > 1e20)
+ {
+ msg (ME, _("Time value %g too large in magnitude to convert to "
+ "alphanumeric time."), v->f);
+ return 0;
+ }
+
+ time = v->f;
+ width = fp->w;
+ cp = temp_buf;
+ if (time < 0)
+ *cp++ = '-', time = -time;
+ if (fp->type == FMT_DTIME)
+ {
+ double days = floor (time / 60. / 60. / 24.);
+ cp = spprintf (temp_buf, "%02.0f ", days);
+ time = time - days * 60. * 60. * 24.;
+ width -= 3;
+ }
+ else
+ cp = temp_buf;
+
+ cp = spprintf (cp, "%02.0f:%02.0f",
+ fmod (floor (time / 60. / 60.), 24.),
+ fmod (floor (time / 60.), 60.));
+
+ if (width >= 8)
+ {
+ int w, d;
+
+ if (width >= 10 && fp->d >= 0 && fp->d != 0)
+ d = min (fp->d, width - 9), w = 3 + d;
+ else
+ w = 2, d = 0;
+
+ cp = spprintf (cp, ":%0*.*f", w, d, fmod (time, 60.));
+ }
+ st_bare_pad_copy (dst, temp_buf, fp->w);
+
+ return 1;
+}
+
+static int
+convert_WKDAY (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ static const char *weekdays[7] =
+ {
+ "SUNDAY", "MONDAY", "TUESDAY", "WEDNESDAY",
+ "THURSDAY", "FRIDAY", "SATURDAY",
+ };
+
+ int x = v->f;
+
+ if (x < 1 || x > 7)
+ {
+ msg (ME, _("Weekday index %d does not lie between 1 and 7."), x);
+ return 0;
+ }
+ st_bare_pad_copy (dst, weekdays[x - 1], fp->w);
+
+ return 1;
+}
+
+static int
+convert_MONTH (char *dst, const struct fmt_spec *fp, const union value *v)
+{
+ static const char *months[12] =
+ {
+ "JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE",
+ "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER",
+ };
+
+ int x = v->f;
+
+ if (x < 1 || x > 12)
+ {
+ msg (ME, _("Month index %d does not lie between 1 and 12."), x);
+ return 0;
+ }
+
+ st_bare_pad_copy (dst, months[x - 1], fp->w);
+
+ return 1;
+}
+\f
+/* Helper functions. */
+
+/* Copies SRC to DST, inserting commas and dollar signs as appropriate
+ for format spec *FP. */
+static void
+insert_commas (char *dst, const char *src, const struct fmt_spec *fp)
+{
+ /* Number of leading spaces in the number. This is the amount of
+ room we have for inserting commas and dollar signs. */
+ int n_spaces;
+
+ /* Number of digits before the decimal point. This is used to
+ determine the Number of commas to insert. */
+ int n_digits;
+
+ /* Number of commas to insert. */
+ int n_commas;
+
+ /* Number of items ,%$ to insert. */
+ int n_items;
+
+ /* Number of n_items items not to use for commas. */
+ int n_reserved;
+
+ /* Digit iterator. */
+ int i;
+
+ /* Source pointer. */
+ const char *sp;
+
+ /* Count spaces and digits. */
+ sp = src;
+ while (sp < src + fp->w && *sp == ' ')
+ sp++;
+ n_spaces = sp - src;
+ sp = src + n_spaces;
+ if (*sp == '-')
+ sp++;
+ n_digits = 0;
+ while (sp + n_digits < src + fp->w && isdigit ((unsigned char) sp[n_digits]))
+ n_digits++;
+ n_commas = (n_digits - 1) / 3;
+ n_items = n_commas + (fp->type == FMT_DOLLAR || fp->type == FMT_PCT);
+
+ /* Check whether we have enough space to do insertions. */
+ if (!n_spaces || !n_items)
+ {
+ memcpy (dst, src, fp->w);
+ return;
+ }
+ if (n_items > n_spaces)
+ {
+ n_items -= n_commas;
+ if (!n_items)
+ {
+ memcpy (dst, src, fp->w);
+ return;
+ }
+ }
+
+ /* Put spaces at the beginning if there's extra room. */
+ if (n_spaces > n_items)
+ {
+ memset (dst, ' ', n_spaces - n_items);
+ dst += n_spaces - n_items;
+ }
+
+ /* Insert $ and reserve space for %. */
+ n_reserved = 0;
+ if (fp->type == FMT_DOLLAR)
+ {
+ *dst++ = '$';
+ n_items--;
+ }
+ else if (fp->type == FMT_PCT)
+ n_reserved = 1;
+
+ /* Copy negative sign and digits, inserting commas. */
+ if (sp - src > n_spaces)
+ *dst++ = '-';
+ for (i = n_digits; i; i--)
+ {
+ if (i % 3 == 0 && n_digits > i && n_items > n_reserved)
+ {
+ n_items--;
+ *dst++ = fp->type == FMT_COMMA ? set_grouping : set_decimal;
+ }
+ *dst++ = *sp++;
+ }
+
+ /* Copy decimal places and insert % if necessary. */
+ memcpy (dst, sp, fp->w - (sp - src));
+ if (fp->type == FMT_PCT && n_items > 0)
+ dst[fp->w - (sp - src)] = '%';
+}
+
+/* Returns 1 if YEAR (i.e., 1987) can be represented in four digits, 0
+ otherwise. */
+static int
+year4 (int year)
+{
+ if (year >= 1 && year <= 9999)
+ return 1;
+ msg (ME, _("Year %d cannot be represented in four digits for "
+ "output formatting purposes."), year);
+ return 0;
+}
+
+static int
+try_CCx (char *dst, const struct fmt_spec *fp, double v)
+{
+ struct set_cust_currency *cc = &set_cc[fp->type - FMT_CCA];
+
+ struct fmt_spec f;
+
+ char buf[64];
+ char buf2[64];
+ char *cp;
+
+ /* Determine length available, decimal character for number
+ proper. */
+ f.type = cc->decimal == set_decimal ? FMT_COMMA : FMT_DOT;
+ f.w = fp->w - strlen (cc->prefix) - strlen (cc->suffix);
+ if (v < 0)
+ f.w -= strlen (cc->neg_prefix) + strlen (cc->neg_suffix) - 1;
+ else
+ /* Convert -0 to +0. */
+ v = fabs (v);
+ f.d = fp->d;
+
+ if (f.w <= 0)
+ return 0;
+
+ /* There's room for all that currency crap. Let's do the F
+ conversion first. */
+ if (!convert_F (buf, &f, (union value *) &v) || *buf == '*')
+ return 0;
+ insert_commas (buf2, buf, &f);
+
+ /* Postprocess back into buf. */
+ cp = buf;
+ if (v < 0)
+ cp = stpcpy (cp, cc->neg_prefix);
+ cp = stpcpy (cp, cc->prefix);
+ {
+ char *bp = buf2;
+ while (*bp == ' ')
+ bp++;
+
+ assert ((v >= 0) ^ (*bp == '-'));
+ if (v < 0)
+ bp++;
+
+ memcpy (cp, bp, f.w - (bp - buf2));
+ cp += f.w - (bp - buf2);
+ }
+ cp = stpcpy (cp, cc->suffix);
+ if (v < 0)
+ cp = stpcpy (cp, cc->neg_suffix);
+
+ /* Copy into dst. */
+ assert (cp - buf <= fp->w);
+ if (cp - buf < fp->w)
+ {
+ memcpy (&dst[fp->w - (cp - buf)], buf, cp - buf);
+ memset (dst, ' ', fp->w - (cp - buf));
+ }
+ else
+ memcpy (dst, buf, fp->w);
+
+ return 1;
+}
+
+/* This routine relies on the underlying implementation of sprintf:
+
+ If the number has a magnitude 1e40 or greater, then we needn't
+ bother with it, since it's guaranteed to need processing in
+ scientific notation.
+
+ Otherwise, do a binary search for the base-10 magnitude of the
+ thing. log10() is not accurate enough, and the alternatives are
+ frightful. Besides, we never need as many as 6 (pairs of)
+ comparisons. The algorithm used for searching is Knuth's Algorithm
+ 6.2.1C (Uniform binary search).
+
+ DON'T CHANGE ANYTHING HERE UNLESS YOU'VE THOUGHT ABOUT IT FOR A
+ LONG TIME! The rest of the program is heavily dependent on
+ specific properties of this routine's output. LOG ALL CHANGES! */
+static int
+try_F (char *dst, const struct fmt_spec *fp, const union value *value)
+{
+ /* This is the DELTA array from Knuth.
+ DELTA[j] = floor((40+2**(j-1))/(2**j)). */
+ static const int delta[8] =
+ {
+ 0, (40 + 1) / 2, (40 + 2) / 4, (40 + 4) / 8, (40 + 8) / 16,
+ (40 + 16) / 32, (40 + 32) / 64, (40 + 64) / 128,
+ };
+
+ /* The number of digits in floor(v), including sign. This is `i'
+ from Knuth. */
+ int n_int = (40 + 1) / 2;
+
+ /* Used to step through delta[]. This is `j' from Knuth. */
+ int j = 2;
+
+ /* Value. */
+ double v = value->f;
+
+ /* Magnitude of v. This is `K' from Knuth. */
+ double mag;
+
+ /* Number of characters for the fractional part, including the
+ decimal point. */
+ int n_dec;
+
+ /* Pointer into buf used for formatting. */
+ char *cp;
+
+ /* Used to count characters formatted by nsprintf(). */
+ int n;
+
+ /* Temporary buffer. */
+ char buf[128];
+
+ /* First check for infinities and NaNs. 12/13/96. */
+ if (!finite (v))
+ {
+ n = nsprintf (buf, "%f", v);
+ if (n > fp->w)
+ memset (buf, '*', fp->w);
+ else if (n < fp->w)
+ {
+ memmove (&buf[fp->w - n], buf, n);
+ memset (buf, ' ', fp->w - n);
+ }
+ memcpy (dst, buf, fp->w);
+ return 1;
+ }
+
+ /* Then check for radically out-of-range values. */
+ mag = fabs (v);
+ if (mag >= power10[fp->w])
+ return 0;
+
+ if (mag < 1.0)
+ {
+ n_int = 0;
+
+ /* Avoid printing `-.000'. 7/6/96. */
+ if (approx_eq (v, 0.0))
+ v = 0.0;
+ }
+ else
+ /* Now perform a `uniform binary search' based on the tables
+ power10[] and delta[]. After this step, nint is the number of
+ digits in floor(v), including any sign. */
+ for (;;)
+ {
+ if (mag >= power10[n_int]) /* Should this be approx_ge()? */
+ {
+ assert (delta[j]);
+ n_int += delta[j++];
+ }
+ else if (mag < power10[n_int - 1])
+ {
+ assert (delta[j]);
+ n_int -= delta[j++];
+ }
+ else
+ break;
+ }
+
+ /* If we have any decimal places, then there is a decimal point,
+ too. */
+ n_dec = fp->d;
+ if (n_dec)
+ n_dec++;
+
+ /* 1/10/96: If there aren't any digits at all, add one. This occurs
+ only when fabs(v) < 1.0. */
+ if (n_int + n_dec == 0)
+ n_int++;
+
+ /* Give space for a minus sign. Moved 1/10/96. */
+ if (v < 0)
+ n_int++;
+
+ /* Normally we only go through the loop once; occasionally twice.
+ Three times or more indicates a very serious bug somewhere. */
+ for (;;)
+ {
+ /* Check out the total length of the string. */
+ cp = buf;
+ if (n_int + n_dec > fp->w)
+ {
+ /* The string is too long. Let's see what can be done. */
+ if (n_int <= fp->w)
+ /* If we can, just reduce the number of decimal places. */
+ n_dec = fp->w - n_int;
+ else
+ return 0;
+ }
+ else if (n_int + n_dec < fp->w)
+ {
+ /* The string is too short. Left-pad with spaces. */
+ int n_spaces = fp->w - n_int - n_dec;
+ memset (cp, ' ', n_spaces);
+ cp += n_spaces;
+ }
+
+ /* Finally, format the number. */
+ if (n_dec)
+ n = nsprintf (cp, "%.*f", n_dec - 1, v);
+ else
+ n = nsprintf (cp, "%.0f", v);
+
+ /* If v is positive and its magnitude is less than 1... */
+ if (n_int == 0)
+ {
+ if (*cp == '0')
+ {
+ /* The value rounds to `.###'. */
+ memmove (cp, &cp[1], n - 1);
+ n--;
+ }
+ else
+ {
+ /* The value rounds to `1.###'. */
+ n_int = 1;
+ continue;
+ }
+ }
+ /* Else if v is negative and its magnitude is less than 1... */
+ else if (v < 0 && n_int == 1)
+ {
+ if (cp[1] == '0')
+ {
+ /* The value rounds to `-.###'. */
+ memmove (&cp[1], &cp[2], n - 2);
+ n--;
+ }
+ else
+ {
+ /* The value rounds to `-1.###'. */
+ n_int = 2;
+ continue;
+ }
+ }
+
+ /* Check for a correct number of digits & decimal places & stuff.
+ This is just a desperation check. Hopefully it won't fail too
+ often, because then we have to run through the whole loop again:
+ sprintf() is not a fast operation with floating-points! */
+ if (n == n_int + n_dec)
+ {
+ /* Convert periods `.' to commas `,' for our foreign friends. */
+ if ((set_decimal == ',' && fp->type != FMT_DOT)
+ || (set_decimal == '.' && fp->type == FMT_DOT))
+ {
+ cp = strchr (cp, '.');
+ if (cp)
+ *cp = ',';
+ }
+
+ memcpy (dst, buf, fp->w);
+ return 1;
+ }
+
+ n_int = n - n_dec; /* FIXME? Need an idiot check on resulting n_int? */
+ }
+}
--- /dev/null
+/* This file can be included multiple times. It redeclares its macros
+ appropriately each time, like assert.h. */
+
+#undef debug_printf
+#undef debug_puts
+#undef debug_putc
+
+#if DEBUGGING
+
+#define debug_printf(args) \
+ do \
+ { \
+ printf args; \
+ fflush (stdout); \
+ } \
+ while (0)
+
+#define debug_puts(string) \
+ do \
+ { \
+ puts (string); \
+ fflush (stdout); \
+ } \
+ while (0)
+
+#define debug_putc(char, stream) \
+ do \
+ { \
+ putc (char, stream); \
+ fflush (stdout); \
+ } \
+ while (0)
+
+#else /* !DEBUGGING */
+
+#define debug_printf(args) \
+ do \
+ { \
+ } \
+ while (0)
+
+#define debug_puts(string) \
+ do \
+ { \
+ } \
+ while (0)
+
+#define debug_putc(char, stream) \
+ do \
+ { \
+ } \
+ while (0)
+
+#endif /* !DEBUGGING */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* FIXME: Many possible optimizations. */
+
+#include <config.h>
+#include <assert.h>
+#include <limits.h>
+#include <math.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "bitvector.h"
+#include "command.h"
+#include "lexer.h"
+#include "error.h"
+#include "approx.h"
+#include "magic.h"
+#include "stats.h"
+#include "som.h"
+#include "tab.h"
+#include "var.h"
+#include "vfm.h"
+
+/* (specification)
+ DESCRIPTIVES (dsc_):
+ *variables=custom;
+ +missing=miss:!variable/listwise,incl:!noinclude/include;
+ +format=labeled:!labels/nolabels,indexed:!noindex/index,lined:!line/serial;
+ +save=;
+ +options[op_]=1,2,3,4,5,6,7,8;
+ +statistics[st_]=all,1|mean,2|semean,5|stddev,6|variance,7|kurtosis,
+ 8|skewness,9|range,10|minimum,11|maximum,12|sum,
+ 13|default,14|seskewness,15|sekurtosis;
+ +sort=sortby:mean/semean/stddev/variance/kurtosis/skewness/range/
+ range/minimum/maximum/sum/name/seskewness/sekurtosis/!none,
+ order:!a/d.
+*/
+/* (declarations) */
+/* (functions) */
+
+/* DESCRIPTIVES private data. */
+
+/* Describes properties of a distribution for the purpose of
+ calculating a Z-score. */
+struct dsc_z_score
+ {
+ struct variable *s, *d; /* Source, destination variable. */
+ double mean; /* Distribution mean. */
+ double std_dev; /* Distribution standard deviation. */
+ };
+
+/* DESCRIPTIVES transformation (for calculating Z-scores). */
+struct descriptives_trns
+ {
+ struct trns_header h;
+ int n; /* Number of Z-scores. */
+ struct dsc_z_score *z; /* Array of Z-scores. */
+ };
+
+/* These next three vars, see comment at top of display(). */
+/* Number of cases missing listwise, even if option 5 not selected. */
+static double d_glob_miss_list;
+
+/* Number of total *cases* valid or missing, as a double. Unless
+ option 5 is selected, d_glob_missing is 0. */
+static double d_glob_valid, d_glob_missing;
+
+/* Set when a weighting variable is missing or <=0. */
+static int bad_weight;
+
+/* Number of generic zvarnames we've generated in this execution. */
+static int z_count;
+
+/* Variables specified on command. */
+static struct variable **v_variables;
+static int n_variables;
+
+/* Command specifications. */
+static struct cmd_descriptives cmd;
+
+/* Whether z-scores are computed. */
+static int z_scores;
+
+/* Statistic to sort by. */
+static int sortby_stat;
+
+/* Statistics to display. */
+static unsigned long stats;
+
+/* Easier access to long-named arrays. */
+#define stat cmd.a_statistics
+#define opt cmd.a_options
+
+/* Groups of statistics. */
+#define BI BIT_INDEX
+
+#define dsc_default \
+ (BI (dsc_mean) | BI (dsc_stddev) | BI (dsc_min) | BI (dsc_max))
+
+#define dsc_all \
+ (BI (dsc_sum) | BI (dsc_min) | BI (dsc_max) \
+ | BI (dsc_mean) | BI (dsc_semean) | BI (dsc_stddev) \
+ | BI (dsc_variance) | BI (dsc_kurt) | BI (dsc_sekurt) \
+ | BI (dsc_skew) | BI (dsc_seskew) | BI (dsc_range) \
+ | BI (dsc_range))
+
+/* Table of options. */
+#define op_incl_miss DSC_OP_1 /* Honored. */
+#define op_no_varlabs DSC_OP_2 /* Ignored. */
+#define op_zscores DSC_OP_3 /* Honored. */
+#define op_index DSC_OP_4 /* FIXME. */
+#define op_excl_miss DSC_OP_5 /* Honored. */
+#define op_serial DSC_OP_6 /* Honored. */
+#define op_narrow DSC_OP_7 /* Ignored. */
+#define op_no_varnames DSC_OP_8 /* Honored. */
+
+/* Describes one statistic that can be calculated. */
+/* FIXME: Currently sm,col_width are not used. */
+struct dsc_info
+ {
+ int st_indx; /* Index into st_a_statistics[]. */
+ int sb_indx; /* Sort-by index. */
+ const char *s10; /* Name, stuffed into 10 columns. */
+ const char *s8; /* Name, stuffed into 8 columns. */
+ const char *sm; /* Name, stuffed minimally. */
+ const char *s; /* Full name. */
+ int max_degree; /* Highest degree necessary to calculate this
+ statistic. */
+ int col_width; /* Column width (not incl. spacing between columns) */
+ };
+
+/* Table of statistics, indexed by dsc_*. */
+static struct dsc_info dsc_info[dsc_n_stats] =
+{
+ {DSC_ST_MEAN, DSC_MEAN, N_("Mean"), N_("Mean"), N_("Mean"), N_("mean"), 1, 10},
+ {DSC_ST_SEMEAN, DSC_SEMEAN, N_("S.E. Mean"), N_("S E Mean"), N_("SE"),
+ N_("standard error of mean"), 2, 10},
+ {DSC_ST_STDDEV, DSC_STDDEV, N_("Std Dev"), N_("Std Dev"), N_("SD"),
+ N_("standard deviation"), 2, 11},
+ {DSC_ST_VARIANCE, DSC_VARIANCE, N_("Variance"), N_("Variance"),
+ N_("Var"), N_("variance"), 2, 12},
+ {DSC_ST_KURTOSIS, DSC_KURTOSIS, N_("Kurtosis"), N_("Kurtosis"),
+ N_("Kurt"), N_("kurtosis"), 4, 9},
+ {DSC_ST_SEKURTOSIS, DSC_SEKURTOSIS, N_("S.E. Kurt"), N_("S E Kurt"), N_("SEKurt"),
+ N_("standard error of kurtosis"), 0, 9},
+ {DSC_ST_SKEWNESS, DSC_SKEWNESS, N_("Skewness"), N_("Skewness"), N_("Skew"),
+ N_("skewness"), 3, 9},
+ {DSC_ST_SESKEWNESS, DSC_SESKEWNESS, N_("S.E. Skew"), N_("S E Skew"), N_("SESkew"),
+ N_("standard error of skewness"), 0, 9},
+ {DSC_ST_RANGE, DSC_RANGE, N_("Range"), N_("Range"), N_("Rng"), N_("range"), 0, 10},
+ {DSC_ST_MINIMUM, DSC_MINIMUM, N_("Minimum"), N_("Minimum"), N_("Min"),
+ N_("minimum"), 0, 10},
+ {DSC_ST_MAXIMUM, DSC_MAXIMUM, N_("Maximum"), N_("Maximum"), N_("Max"),
+ N_("maximum"), 0, 10},
+ {DSC_ST_SUM, DSC_SUM, N_("Sum"), N_("Sum"), N_("Sum"), N_("sum"), 1, 13},
+};
+
+/* Z-score functions. */
+static int generate_z_varname (struct variable * v);
+static void dump_z_table (void);
+static void run_z_pass (void);
+
+/* Procedure execution functions. */
+static int calc (struct ccase *);
+static void precalc (void);
+static void postcalc (void);
+static void display (void);
+\f
+/* Parser and outline. */
+
+int
+cmd_descriptives (void)
+{
+ struct variable *v;
+ int i;
+
+ v_variables = NULL;
+ n_variables = 0;
+
+ lex_match_id ("DESCRIPTIVES");
+ lex_match_id ("CONDESCRIPTIVES");
+ if (!parse_descriptives (&cmd))
+ goto lossage;
+
+ if (n_variables == 0)
+ goto lossage;
+ for (i = 0; i < n_variables; i++)
+ {
+ v = v_variables[i];
+ v->p.dsc.dup = 0;
+ v->p.dsc.zname[0] = 0;
+ }
+
+ if (n_variables < 0)
+ {
+ msg (SE, _("No variables specified."));
+ goto lossage;
+ }
+
+ if (cmd.sbc_options && (cmd.sbc_save || cmd.sbc_format || cmd.sbc_missing))
+ {
+ msg (SE, _("OPTIONS may not be used with SAVE, FORMAT, or MISSING."));
+ goto lossage;
+ }
+
+ if (!cmd.sbc_options)
+ {
+ if (cmd.incl == DSC_INCLUDE)
+ opt[op_incl_miss] = 1;
+ if (cmd.labeled == DSC_NOLABELS)
+ opt[op_no_varlabs] = 1;
+ if (cmd.sbc_save)
+ opt[op_zscores] = 1;
+ if (cmd.miss == DSC_LISTWISE)
+ opt[op_excl_miss] = 1;
+ if (cmd.lined == DSC_SERIAL)
+ opt[op_serial] = 1;
+ }
+
+ /* Construct z-score varnames, show translation table. */
+ if (opt[op_zscores])
+ {
+ z_count = 0;
+ for (i = 0; i < n_variables; i++)
+ {
+ v = v_variables[i];
+ if (v->p.dsc.dup++)
+ continue;
+
+ if (v->p.dsc.zname[0] == 0)
+ if (!generate_z_varname (v))
+ goto lossage;
+ }
+ dump_z_table ();
+ z_scores = 1;
+ }
+
+ /* Figure out statistics to calculate. */
+ stats = 0;
+ if (stat[DSC_ST_DEFAULT] || !cmd.sbc_statistics)
+ stats |= dsc_default;
+ if (stat[DSC_ST_ALL])
+ stats |= dsc_all;
+ for (i = 0; i < dsc_n_stats; i++)
+ if (stat[dsc_info[i].st_indx])
+ stats |= BIT_INDEX (i);
+ if (stats & dsc_kurt)
+ stats |= dsc_sekurt;
+ if (stats & dsc_skew)
+ stats |= dsc_seskew;
+
+ /* Check the sort order. */
+ sortby_stat = -1;
+ if (cmd.sortby == DSC_NONE)
+ sortby_stat = -2;
+ else if (cmd.sortby != DSC_NAME)
+ {
+ for (i = 0; i < n_variables; i++)
+ if (dsc_info[i].sb_indx == cmd.sortby)
+ {
+ sortby_stat = i;
+ if (!(stats & BIT_INDEX (i)))
+ {
+ msg (SE, _("It's not possible to sort on `%s' without "
+ "displaying `%s'."),
+ gettext (dsc_info[i].s), gettext (dsc_info[i].s));
+ goto lossage;
+ }
+ }
+ assert (sortby_stat != -1);
+ }
+
+ /* Data pass! */
+ update_weighting (&default_dict);
+ bad_weight = 0;
+ procedure (precalc, calc, postcalc);
+
+ if (bad_weight)
+ msg (SW, _("At least one case in the data file had a weight value "
+ "that was system-missing, zero, or negative. These case(s) "
+ "were ignored."));
+
+ /* Z-scoring! */
+ if (z_scores)
+ run_z_pass ();
+
+ if (v_variables)
+ free (v_variables);
+ return CMD_SUCCESS;
+
+ lossage:
+ if (v_variables)
+ free (v_variables);
+ return CMD_FAILURE;
+}
+
+/* Parses the VARIABLES subcommand. */
+static int
+dsc_custom_variables (struct cmd_descriptives *cmd unused)
+{
+ if (!lex_match_id ("VARIABLES")
+ && (token != T_ID || !is_varname (tokid))
+ && token != T_ALL)
+ return 2;
+ lex_match ('=');
+
+ while (token == T_ID || token == T_ALL)
+ {
+ int i, n;
+
+ n = n_variables;
+ if (!parse_variables (NULL, &v_variables, &n_variables,
+ PV_DUPLICATE | PV_SINGLE | PV_APPEND | PV_NUMERIC
+ | PV_NO_SCRATCH))
+ return 0;
+ if (lex_match ('('))
+ {
+ if (n_variables - n > 1)
+ {
+ msg (SE, _("Names for z-score variables must be given for "
+ "individual variables, not for groups of "
+ "variables."));
+ return 0;
+ }
+ assert (n_variables - n <= 0);
+ if (token != T_ID)
+ {
+ msg (SE, _("Name for z-score variable expected."));
+ return 0;
+ }
+ if (is_varname (tokid))
+ {
+ msg (SE, _("Z-score variable name `%s' is a "
+ "duplicate variable name with a current variable."),
+ tokid);
+ return 0;
+ }
+ for (i = 0; i < n_variables; i++)
+ if (v_variables[i]->p.dsc.zname[0]
+ && !strcmp (v_variables[i]->p.dsc.zname, tokid))
+ {
+ msg (SE, _("Z-score variable name `%s' is "
+ "used multiple times."), tokid);
+ return 0;
+ }
+ strcpy (v_variables[n_variables - 1]->p.dsc.zname, tokid);
+ lex_get ();
+ if (token != ')')
+ {
+ msg (SE, _("`)' expected after z-score variable name."));
+ return 0;
+ }
+
+ z_scores = 1;
+ }
+ lex_match (',');
+ }
+ return 1;
+}
+\f
+/* Z scores. */
+
+/* Returns 0 if NAME is a duplicate of any existing variable name or
+ of any previously-declared z-var name; otherwise returns 1. */
+static int
+try_name (char *name)
+{
+ int i;
+
+ if (is_varname (name))
+ return 0;
+ for (i = 0; i < n_variables; i++)
+ {
+ struct variable *v = v_variables[i];
+ if (!strcmp (v->p.dsc.zname, name))
+ return 0;
+ }
+ return 1;
+}
+
+static int
+generate_z_varname (struct variable * v)
+{
+ char zname[10];
+
+ strcpy (&zname[1], v->name);
+ zname[0] = 'Z';
+ zname[8] = '\0';
+ if (try_name (zname))
+ {
+ strcpy (v->p.dsc.zname, zname);
+ return 1;
+ }
+
+ for (;;)
+ {
+ /* Generate variable name. */
+ z_count++;
+
+ if (z_count <= 99)
+ sprintf (zname, "ZSC%03d", z_count);
+ else if (z_count <= 108)
+ sprintf (zname, "STDZ%02d", z_count - 99);
+ else if (z_count <= 117)
+ sprintf (zname, "ZZZZ%02d", z_count - 108);
+ else if (z_count <= 126)
+ sprintf (zname, "ZQZQ%02d", z_count - 117);
+ else
+ {
+ msg (SE, _("Ran out of generic names for Z-score variables. "
+ "There are only 126 generic names: ZSC001-ZSC0999, "
+ "STDZ01-STDZ09, ZZZZ01-ZZZZ09, ZQZQ01-ZQZQ09."));
+ return 0;
+ }
+
+ if (try_name (zname))
+ {
+ strcpy (v->p.dsc.zname, zname);
+ return 1;
+ }
+ }
+}
+
+static void
+dump_z_table (void)
+{
+ int count;
+ struct tab_table *t;
+
+ {
+ int i;
+
+ for (count = i = 0; i < n_variables; i++)
+ if (v_variables[i]->p.dsc.zname)
+ count++;
+ }
+
+ t = tab_create (2, count + 1, 0);
+ tab_title (t, 0, _("Mapping of variables to corresponding Z-scores."));
+ tab_columns (t, SOM_COL_DOWN, 1);
+ tab_headers (t, 0, 0, 1, 0);
+ tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, count);
+ tab_hline (t, TAL_2, 0, 1, 1);
+ tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Source"));
+ tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Target"));
+ tab_dim (t, tab_natural_dimensions);
+
+ {
+ int i, y;
+
+ for (i = 0, y = 1; i < n_variables; i++)
+ if (v_variables[i]->p.dsc.zname)
+ {
+ tab_text (t, 0, y, TAB_LEFT, v_variables[i]->name);
+ tab_text (t, 1, y++, TAB_LEFT, v_variables[i]->p.dsc.zname);
+ }
+ }
+
+ tab_submit (t);
+}
+
+/* Transformation function to calculate Z-scores. */
+static int
+descriptives_trns_proc (struct trns_header * trns, struct ccase * c)
+{
+ struct descriptives_trns *t = (struct descriptives_trns *) trns;
+ struct dsc_z_score *z;
+ int i;
+
+ for (i = t->n, z = t->z; i--; z++)
+ {
+ double score = c->data[z->s->fv].f;
+
+ if (z->mean == SYSMIS || score == SYSMIS)
+ c->data[z->d->fv].f = SYSMIS;
+ else
+ c->data[z->d->fv].f = (score - z->mean) / z->std_dev;
+ }
+ return -1;
+}
+
+/* Frees a descriptives_trns struct. */
+static void
+descriptives_trns_free (struct trns_header * trns)
+{
+ struct descriptives_trns *t = (struct descriptives_trns *) trns;
+
+ free (t->z);
+}
+
+/* The name is a misnomer: actually this function sets up a
+ transformation by which scores can be converted into Z-scores. */
+static void
+run_z_pass (void)
+{
+ struct descriptives_trns *t;
+ int count, i;
+
+ for (i = 0; i < n_variables; i++)
+ v_variables[i]->p.dsc.dup = 0;
+ for (count = i = 0; i < n_variables; i++)
+ {
+ if (v_variables[i]->p.dsc.dup++)
+ continue;
+ if (v_variables[i]->p.dsc.zname)
+ count++;
+ }
+
+ t = xmalloc (sizeof *t);
+ t->h.proc = descriptives_trns_proc;
+ t->h.free = descriptives_trns_free;
+ t->n = count;
+ t->z = xmalloc (count * sizeof *t->z);
+
+ for (i = 0; i < n_variables; i++)
+ v_variables[i]->p.dsc.dup = 0;
+ for (count = i = 0; i < n_variables; i++)
+ {
+ struct variable *v = v_variables[i];
+ if (v->p.dsc.dup++ == 0 && v->p.dsc.zname[0])
+ {
+ char *cp;
+ struct variable *d;
+
+ t->z[count].s = v;
+ t->z[count].d = d = force_create_variable (&default_dict,
+ v->p.dsc.zname,
+ NUMERIC, 0);
+ if (v->label)
+ {
+ d->label = xmalloc (strlen (v->label) + 12);
+ cp = stpcpy (d->label, _("Z-score of "));
+ strcpy (cp, v->label);
+ }
+ else
+ {
+ d->label = xmalloc (strlen (v->name) + 12);
+ cp = stpcpy (d->label, _("Z-score of "));
+ strcpy (cp, v->name);
+ }
+ t->z[count].mean = v->p.dsc.stats[dsc_mean];
+ t->z[count].std_dev = v->p.dsc.stats[dsc_stddev];
+ if (t->z[count].std_dev == SYSMIS
+ || approx_eq (t->z[count].std_dev, 0.0))
+ t->z[count].mean = SYSMIS;
+ count++;
+ }
+ }
+
+ add_transformation ((struct trns_header *) t);
+}
+\f
+/* Statistical calculation. */
+
+static void
+precalc (void)
+{
+ int i;
+
+ for (i = 0; i < n_variables; i++)
+ v_variables[i]->p.dsc.dup = -2;
+ for (i = 0; i < n_variables; i++)
+ {
+ struct descriptives_proc *dsc = &v_variables[i]->p.dsc;
+
+ /* Don't need to initialize more than once. */
+ if (dsc->dup == -1)
+ continue;
+ dsc->dup = -1;
+
+ dsc->valid = dsc->miss = 0.0;
+ dsc->X_bar = dsc->M2 = dsc->M3 = dsc->M4 = 0.0;
+ dsc->min = DBL_MAX;
+ dsc->max = -DBL_MAX;
+ }
+ d_glob_valid = d_glob_missing = 0.0;
+}
+
+static int
+calc (struct ccase * c)
+{
+ int i;
+
+ /* Unique case identifier. */
+ static int case_id;
+
+ /* Get the weight for this case. */
+ double w;
+
+ if (default_dict.weight_index == -1)
+ w = 1.0;
+ else
+ {
+ w = c->data[default_dict.weight_index].f;
+ if (w <= 0.0 || w == SYSMIS)
+ {
+ w = 0.0;
+ bad_weight = 1;
+ }
+ }
+
+ case_id++;
+
+ /* Handle missing values. */
+ for (i = 0; i < n_variables; i++)
+ {
+ struct variable *v = v_variables[i];
+ double X = c->data[v->fv].f;
+
+ if (X == SYSMIS || (!opt[op_incl_miss] && is_num_user_missing (X, v)))
+ {
+ if (opt[op_excl_miss])
+ {
+ d_glob_missing += w;
+ return 1;
+ }
+ else
+ {
+ d_glob_miss_list += w;
+ goto iterate;
+ }
+ }
+ }
+ d_glob_valid += w;
+
+iterate:
+ for (i = 0; i < n_variables; i++)
+ {
+ struct descriptives_proc *inf = &v_variables[i]->p.dsc;
+
+ double X, v;
+ double W_old, W_new;
+ double v2, v3, v4;
+ double w2, w3, w4;
+
+ if (inf->dup == case_id)
+ continue;
+ inf->dup = case_id;
+
+ X = c->data[v_variables[i]->fv].f;
+ if (X == SYSMIS
+ || (!opt[op_incl_miss] && is_num_user_missing (X, v_variables[i])))
+ {
+ inf->miss += w;
+ continue;
+ }
+
+ /* These formulas taken from _SPSS Statistical Algorithms_. The
+ names W_old, and W_new are used for W_j-1 and W_j,
+ respectively, and other variables simply have the subscripts
+ trimmed off, except for X_bar.
+
+ I am happy that mathematical formulas may not be
+ copyrighted. */
+ W_old = inf->valid;
+ W_new = inf->valid += w;
+ v = (w / W_new) * (X - inf->X_bar);
+ v2 = v * v;
+ v3 = v2 * v;
+ v4 = v3 * v;
+ w2 = w * w;
+ w3 = w2 * w;
+ w4 = w3 * w;
+ inf->M4 += (-4.0 * v * inf->M3 + 6.0 * v2 * inf->M2
+ + (W_new * W_new - 3 * w * W_old / w3) * v4 * W_old * W_new);
+ inf->M3 += (-3.0 * v * inf->M2 + W_new * W_old / w2
+ * (W_new - 2 * w) * v3);
+ inf->M2 += W_new * W_old / w * v2;
+ inf->X_bar += v;
+ if (X < inf->min)
+ inf->min = X;
+ if (X > inf->max)
+ inf->max = X;
+ }
+ return 1;
+}
+
+static void
+postcalc (void)
+{
+ int i;
+
+ if (opt[op_excl_miss])
+ d_glob_miss_list = d_glob_missing;
+
+ for (i = 0; i < n_variables; i++)
+ {
+ struct descriptives_proc *dsc = &v_variables[i]->p.dsc;
+ double W;
+
+ /* Don't duplicate our efforts. */
+ if (dsc->dup == -2)
+ continue;
+ dsc->dup = -2;
+
+ W = dsc->valid;
+
+ dsc->stats[dsc_mean] = dsc->X_bar;
+ dsc->stats[dsc_variance] = dsc->M2 / (W - 1);
+ dsc->stats[dsc_stddev] = sqrt (dsc->stats[dsc_variance]);
+ dsc->stats[dsc_semean] = dsc->stats[dsc_stddev] / sqrt (W);
+ dsc->stats[dsc_min] = dsc->min == DBL_MAX ? SYSMIS : dsc->min;
+ dsc->stats[dsc_max] = dsc->max == -DBL_MAX ? SYSMIS : dsc->max;
+ dsc->stats[dsc_range] = ((dsc->min == DBL_MAX || dsc->max == -DBL_MAX)
+ ? SYSMIS : dsc->max - dsc->min);
+ dsc->stats[dsc_sum] = W * dsc->X_bar;
+ if (W > 2.0 && dsc->stats[dsc_variance] >= 1e-20)
+ {
+ double S = dsc->stats[dsc_stddev];
+ dsc->stats[dsc_skew] = (W * dsc->M3 / ((W - 1.0) * (W - 2.0) * S * S * S));
+ dsc->stats[dsc_seskew] =
+ sqrt (6.0 * W * (W - 1.0) / ((W - 2.0) * (W + 1.0) * (W + 3.0)));
+ }
+ else
+ {
+ dsc->stats[dsc_skew] = dsc->stats[dsc_seskew] = SYSMIS;
+ }
+ if (W > 3.0 && dsc->stats[dsc_variance] >= 1e-20)
+ {
+ double S2 = dsc->stats[dsc_variance];
+ double SE_g1 = dsc->stats[dsc_seskew];
+
+ dsc->stats[dsc_kurt] =
+ (W * (W + 1.0) * dsc->M4 - 3.0 * dsc->M2 * dsc->M2 * (W - 1.0))
+ / ((W - 1.0) * (W - 2.0) * (W - 3.0) * S2 * S2);
+
+ /* Note that in _SPSS Statistical Algorithms_, the square
+ root symbol is missing from this formula. */
+ dsc->stats[dsc_sekurt] =
+ sqrt ((4.0 * (W * W - 1.0) * SE_g1 * SE_g1) / ((W - 3.0) * (W + 5.0)));
+ }
+ else
+ {
+ dsc->stats[dsc_kurt] = dsc->stats[dsc_sekurt] = SYSMIS;
+ }
+ }
+
+ display ();
+}
+\f
+/* Statistical display. */
+
+static int compare_func (struct variable ** a, struct variable ** b);
+
+static void
+display (void)
+{
+ int i, j;
+
+ int nc, n_stats;
+ struct tab_table *t;
+
+ /* If op_excl_miss is on, d_glob_valid and (potentially)
+ d_glob_missing are nonzero, and d_glob_missing equals
+ d_glob_miss_list.
+
+ If op_excl_miss is off, d_glob_valid is nonzero. d_glob_missing
+ is zero. d_glob_miss_list is (potentially) nonzero. */
+
+ if (sortby_stat != -2)
+ qsort (v_variables, n_variables, sizeof (struct variable *),
+ (int (*)(const void *, const void *)) compare_func);
+
+ for (nc = i = 0; i < dsc_n_stats; i++)
+ if (stats & BIT_INDEX (i))
+ nc++;
+ n_stats = nc;
+ if (!opt[op_no_varnames])
+ nc++;
+ nc += opt[op_serial] ? 2 : 1;
+
+ t = tab_create (nc, n_variables + 1, 0);
+ tab_headers (t, 1, 0, 1, 0);
+ tab_box (t, TAL_1, TAL_1, -1, -1, 0, 0, nc - 1, n_variables);
+ tab_box (t, -1, -1, -1, TAL_1, 1, 0, nc - 1, n_variables);
+ tab_hline (t, TAL_2, 0, nc - 1, 1);
+ tab_vline (t, TAL_2, 1, 0, n_variables);
+ tab_dim (t, tab_natural_dimensions);
+
+ nc = 0;
+ if (!opt[op_no_varnames])
+ {
+ tab_text (t, nc++, 0, TAB_LEFT | TAT_TITLE, _("Variable"));
+ }
+ if (opt[op_serial])
+ {
+ tab_text (t, nc++, 0, TAB_CENTER | TAT_TITLE, _("Valid N"));
+ tab_text (t, nc++, 0, TAB_CENTER | TAT_TITLE, _("Missing N"));
+ } else {
+ tab_text (t, nc++, 0, TAB_CENTER | TAT_TITLE, "N");
+ }
+
+ for (i = 0; i < dsc_n_stats; i++)
+ if (stats & BIT_INDEX (i))
+ {
+ const char *title = gettext (dsc_info[i].s8);
+ tab_text (t, nc++, 0, TAB_CENTER | TAT_TITLE, title);
+ }
+
+ for (i = 0; i < n_variables; i++)
+ {
+ struct variable *v = v_variables[i];
+
+ nc = 0;
+ if (!opt[op_no_varnames])
+ tab_text (t, nc++, i + 1, TAB_LEFT, v->name);
+ tab_text (t, nc++, i + 1, TAT_PRINTF, "%g", v->p.dsc.valid);
+ if (opt[op_serial])
+ tab_text (t, nc++, i + 1, TAT_PRINTF, "%g", v->p.dsc.miss);
+ for (j = 0; j < dsc_n_stats; j++)
+ if (stats & BIT_INDEX (j))
+ tab_float (t, nc++, i + 1, TAB_NONE, v->p.dsc.stats[j], 10, 3);
+ }
+
+ tab_title (t, 1, _("Valid cases = %g; cases with missing value(s) = %g."),
+ d_glob_valid, d_glob_miss_list);
+
+ tab_submit (t);
+}
+
+static int
+compare_func (struct variable ** a, struct variable ** b)
+{
+ double temp;
+
+ if (cmd.order == DSC_D)
+ {
+ struct variable **t;
+ t = a;
+ a = b;
+ b = t;
+ }
+
+ if (cmd.sortby == DSC_NAME)
+ return strcmp ((*a)->name, (*b)->name);
+ temp = ((*a)->p.dsc.stats[sortby_stat]
+ - (*b)->p.dsc.stats[sortby_stat]);
+ if (temp > 0)
+ return 1;
+ else if (temp < 0)
+ return -1;
+ else
+ return 0;
+}
+
+/*
+ Local variables:
+ mode: c
+ End:
+*/
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <ctype.h>
+#include <errno.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "file-handle.h"
+#include "filename.h"
+#include "getline.h"
+#include "lexer.h"
+#include "misc.h"
+#include "str.h"
+#include "vfm.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* file_handle extension structure. */
+struct dfm_fhuser_ext
+ {
+ struct file_ext file; /* Associated file. */
+
+ char *line; /* Current line, not null-terminated. */
+ size_t len; /* Length of line. */
+
+ char *ptr; /* Pointer into line that is returned by
+ dfm_get_record(). */
+ size_t size; /* Number of bytes allocated for line. */
+ int advance; /* Nonzero=dfm_get_record() reads a new
+ record; otherwise returns current record. */
+ };
+
+/* These are defined at the end of this file. */
+static struct fh_ext_class dfm_r_class;
+static struct fh_ext_class dfm_w_class;
+
+static void read_record (struct file_handle *h);
+\f
+/* Internal (low level). */
+
+/* Closes the file handle H which was opened by open_file_r() or
+ open_file_w(). */
+static void
+dfm_close (struct file_handle *h)
+{
+ struct dfm_fhuser_ext *ext = h->ext;
+
+ /* Skip any remaining data on the inline file. */
+ if (h == inline_file)
+ while (ext->line != NULL)
+ read_record (h);
+
+ msg (VM (2), _("%s: Closing data-file handle %s."),
+ fh_handle_filename (h), fh_handle_name (h));
+ assert (h->class == &dfm_r_class || h->class == &dfm_w_class);
+ if (ext->file.file)
+ {
+ fn_close_ext (&ext->file);
+ free (ext->file.filename);
+ ext->file.filename = NULL;
+ }
+ free (ext->line);
+ free (ext);
+}
+
+/* Initializes EXT properly as an inline data file. */
+static void
+open_inline_file (struct dfm_fhuser_ext *ext)
+{
+ /* We want to indicate that the file is open, that we are not at
+ eof, and that another line needs to be read in. */
+#if __CHECKER__
+ memset (&ext->file, 0, sizeof ext->file);
+#endif
+ ext->file.file = NULL;
+ ext->line = xmalloc (128);
+#if !PRODUCTION
+ strcpy (ext->line, _("<<Bug in dfm.c>>"));
+#endif
+ ext->len = strlen (ext->line);
+ ext->ptr = ext->line;
+ ext->size = 128;
+ ext->advance = 1;
+}
+
+/* Opens a file handle for reading as a data file. */
+static int
+open_file_r (struct file_handle *h)
+{
+ struct dfm_fhuser_ext ext;
+
+ h->where.line_number = 0;
+ ext.file.file = NULL;
+ ext.line = NULL;
+ ext.len = 0;
+ ext.ptr = NULL;
+ ext.size = 0;
+ ext.advance = 0;
+
+ msg (VM (1), _("%s: Opening data-file handle %s for reading."),
+ fh_handle_filename (h), fh_handle_name (h));
+
+ assert (h != NULL);
+ if (h == inline_file)
+ {
+ char *s;
+
+ /* WTF can't this just be done with tokens?
+ Is this really a special case?
+ FIXME! */
+ do
+ {
+ char *cp;
+
+ if (!getl_read_line ())
+ {
+ msg (SE, _("BEGIN DATA expected."));
+ err_failure ();
+ }
+
+ /* Skip leading whitespace, separate out first word, so that
+ S points to a single word reduced to lowercase. */
+ s = ds_value (&getl_buf);
+ while (isspace ((unsigned char) *s))
+ s++;
+ for (cp = s; isalpha ((unsigned char) *cp); cp++)
+ *cp = tolower ((unsigned char) (*cp));
+ ds_truncate (&getl_buf, cp - s);
+ }
+ while (*s == '\0');
+
+ if (!lex_id_match_len ("begin", 5, s, strcspn (s, " \t\r\v\n")))
+ {
+ msg (SE, _("BEGIN DATA expected."));
+ err_cond_fail ();
+ lex_preprocess_line ();
+ return 0;
+ }
+ getl_prompt = GETL_PRPT_DATA;
+
+ open_inline_file (&ext);
+ }
+ else
+ {
+ ext.file.filename = xstrdup (h->norm_fn);
+ ext.file.mode = "rb";
+ ext.file.file = NULL;
+ ext.file.sequence_no = NULL;
+ ext.file.param = NULL;
+ ext.file.postopen = NULL;
+ ext.file.preclose = NULL;
+ if (!fn_open_ext (&ext.file))
+ {
+ msg (ME, _("An error occurred while opening \"%s\" for reading "
+ "as a data file: %s."), h->fn, strerror (errno));
+ err_cond_fail ();
+ return 0;
+ }
+ }
+
+ h->class = &dfm_r_class;
+ h->ext = xmalloc (sizeof (struct dfm_fhuser_ext));
+ memcpy (h->ext, &ext, sizeof (struct dfm_fhuser_ext));
+
+ return 1;
+}
+
+/* Opens a file handle for writing as a data file. */
+static int
+open_file_w (struct file_handle *h)
+{
+ struct dfm_fhuser_ext ext;
+
+ ext.file.file = NULL;
+ ext.line = NULL;
+ ext.len = 0;
+ ext.ptr = NULL;
+ ext.size = 0;
+ ext.advance = 0;
+
+ h->where.line_number = 0;
+
+ msg (VM (1), _("%s: Opening data-file handle %s for writing."),
+ fh_handle_filename (h), fh_handle_name (h));
+
+ assert (h != NULL);
+ if (h == inline_file)
+ {
+ msg (ME, _("Cannot open the inline file for writing."));
+ err_cond_fail ();
+ return 0;
+ }
+
+ ext.file.filename = xstrdup (h->norm_fn);
+ ext.file.mode = "wb";
+ ext.file.file = NULL;
+ ext.file.sequence_no = NULL;
+ ext.file.param = NULL;
+ ext.file.postopen = NULL;
+ ext.file.preclose = NULL;
+
+ if (!fn_open_ext (&ext.file))
+ {
+ msg (ME, _("An error occurred while opening \"%s\" for writing "
+ "as a data file: %s."), h->fn, strerror (errno));
+ err_cond_fail ();
+ return 0;
+ }
+
+ h->class = &dfm_w_class;
+ h->ext = xmalloc (sizeof (struct dfm_fhuser_ext));
+ memcpy (h->ext, &ext, sizeof (struct dfm_fhuser_ext));
+
+ return 1;
+}
+
+/* Ensures that the line buffer in file handle with extension EXT is
+ big enough to hold a line of length EXT->LEN characters not
+ including null terminator. */
+#define force_line_buffer_expansion() \
+ do \
+ { \
+ if (ext->len + 1 > ext->size) \
+ { \
+ ext->size = ext->len * 2; \
+ ext->line = xrealloc (ext->line, ext->size); \
+ } \
+ } \
+ while (0)
+
+/* Counts the number of tabs in string STRING of length LEN. */
+static inline int
+count_tabs (char *s, size_t len)
+{
+ int n_tabs = 0;
+
+ for (;;)
+ {
+ char *cp = memchr (s, '\t', len);
+ if (cp == NULL)
+ return n_tabs;
+ n_tabs++;
+ len -= cp - s + 1;
+ s = cp + 1;
+ }
+}
+
+/* Converts all the tabs in H->EXT->LINE to an equivalent number of
+ spaces, if necessary. */
+static void
+tabs_to_spaces (struct file_handle *h)
+{
+ struct dfm_fhuser_ext *ext = h->ext;
+
+ char *first_tab; /* Location of first tab (if any). */
+ char *second_tab; /* Location of second tab (if any). */
+ size_t orig_len; /* Line length at function entry. */
+
+ /* If there aren't any tabs then there's nothing to do. */
+ first_tab = memchr (ext->line, '\t', ext->len);
+ if (first_tab == NULL)
+ return;
+ orig_len = ext->len;
+
+ /* If there's just one tab then expand it inline. Otherwise do a
+ full string copy to another buffer. */
+ second_tab = memchr (first_tab + 1, '\t',
+ ext->len - (first_tab - ext->line + 1));
+ if (second_tab == NULL)
+ {
+ int n_spaces = 8 - (first_tab - ext->line) % 8;
+
+ ext->len += n_spaces - 1;
+
+ /* Expand the line if necessary, keeping the first_tab pointer
+ valid. */
+ {
+ size_t ofs = first_tab - ext->line;
+ force_line_buffer_expansion ();
+ first_tab = ext->line + ofs;
+ }
+
+ memmove (first_tab + n_spaces, first_tab + 1,
+ orig_len - (first_tab - ext->line + 1));
+ memset (first_tab, ' ', n_spaces);
+ } else {
+ /* Make a local copy of original text. */
+ char *orig_line = local_alloc (ext->len + 1);
+ memcpy (orig_line, ext->line, ext->len);
+
+ /* Allocate memory assuming we need to add 8 spaces for every tab. */
+ ext->len += 2 + count_tabs (second_tab + 1,
+ ext->len - (second_tab - ext->line + 1));
+
+ /* Expand the line if necessary, keeping the first_tab pointer
+ valid. */
+ {
+ size_t ofs = first_tab - ext->line;
+ force_line_buffer_expansion ();
+ first_tab = ext->line + ofs;
+ }
+
+ /* Walk through orig_line, expanding tabs into ext->line. */
+ {
+ char *src_p = orig_line + (first_tab - ext->line);
+ char *dest_p = first_tab;
+
+ for (; src_p < orig_line + orig_len; src_p++)
+ {
+ /* Most characters simply pass through untouched. */
+ if (*src_p != '\t')
+ {
+ *dest_p++ = *src_p;
+ continue;
+ }
+
+ /* Tabs are expanded into an equivalent number of
+ spaces. */
+ {
+ int n_spaces = 8 - (dest_p - ext->line) % 8;
+
+ memset (dest_p, ' ', n_spaces);
+ dest_p += n_spaces;
+ }
+ }
+
+ /* Supply null terminator and actual string length. */
+ *dest_p = 0;
+ ext->len = dest_p - ext->line;
+ }
+
+ local_free (orig_line);
+ }
+}
+
+/* Reads a record from H->EXT->FILE into H->EXT->LINE, setting
+ H->EXT->PTR to H->EXT->LINE, and setting H->EXT-LEN to the length
+ of the line. The line is not null-terminated. If an error occurs
+ or end-of-file is encountered, H->EXT->LINE is set to NULL. */
+static void
+read_record (struct file_handle *h)
+{
+ struct dfm_fhuser_ext *ext = h->ext;
+
+ if (h == inline_file)
+ {
+ if (!getl_read_line ())
+ {
+ msg (SE, _("Unexpected end-of-file while reading data in BEGIN "
+ "DATA. This probably indicates "
+ "a missing or misformatted END DATA command. "
+ "END DATA must appear by itself on a single line "
+ "with exactly one space between words."));
+ err_failure ();
+ }
+
+ h->where.line_number++;
+
+ if (ds_length (&getl_buf) >= 8
+ && !strncasecmp (ds_value (&getl_buf), "end data", 8))
+ {
+ lex_set_prog (ds_value (&getl_buf) + ds_length (&getl_buf));
+ goto eof;
+ }
+
+ ext->len = ds_length (&getl_buf);
+ force_line_buffer_expansion ();
+ strcpy (ext->line, ds_value (&getl_buf));
+ }
+ else
+ {
+ if (h->recform == FH_RF_VARIABLE)
+ {
+ /* PORTME: here you should adapt the routine to your
+ system's concept of a "line" of text. */
+ int read_len = getline (&ext->line, &ext->size, ext->file.file);
+
+ if (read_len == -1)
+ {
+ if (ferror (ext->file.file))
+ {
+ msg (ME, _("Error reading file %s: %s."),
+ fh_handle_name (h), strerror (errno));
+ err_cond_fail ();
+ }
+ goto eof;
+ }
+ ext->len = (size_t) read_len;
+ }
+ else if (h->recform == FH_RF_FIXED)
+ {
+ size_t amt;
+
+ if (ext->size < h->lrecl)
+ {
+ ext->size = h->lrecl;
+ ext->line = xmalloc (ext->size);
+ }
+ amt = fread (ext->line, 1, h->lrecl, ext->file.file);
+ if (h->lrecl != amt)
+ {
+ if (ferror (ext->file.file))
+ msg (ME, _("Error reading file %s: %s."),
+ fh_handle_name (h), strerror (errno));
+ else if (amt != 0)
+ msg (ME, _("%s: Partial record at end of file."),
+ fh_handle_name (h));
+ else
+ goto eof;
+
+ err_cond_fail ();
+ goto eof;
+ }
+ }
+ else
+ assert (0);
+
+ h->where.line_number++;
+ }
+
+ /* Strip trailing whitespace, I forget why. But there's a good
+ reason, I'm sure. I'm too scared to eliminate this code. */
+ if (h->recform == FH_RF_VARIABLE)
+ {
+ while (ext->len && isspace ((unsigned char) ext->line[ext->len - 1]))
+ ext->len--;
+
+ /* Convert tabs to spaces. */
+ tabs_to_spaces (h);
+
+ ext->ptr = ext->line;
+ }
+ return;
+
+eof:
+ /*hit eof or an error, clean up everything. */
+ if (ext->line)
+ free (ext->line);
+ ext->size = 0;
+ ext->line = ext->ptr = NULL;
+ return;
+}
+\f
+/* Public (high level). */
+
+/* Returns the current record in the file corresponding to HANDLE.
+ Opens files and reads records, etc., as necessary. Sets *LEN to
+ the length of the line. The line returned is not null-terminated.
+ Returns NULL at end of file. Calls fail() on attempt to read past
+ end of file. */
+char *
+dfm_get_record (struct file_handle *h, int *len)
+{
+ if (h->class == NULL)
+ {
+ if (!open_file_r (h))
+ return NULL;
+ read_record (h);
+ }
+ else if (h->class != &dfm_r_class)
+ {
+ msg (ME, _("Cannot read from file %s already opened for %s."),
+ fh_handle_name (h), gettext (h->class->name));
+ goto lossage;
+ }
+ else
+ {
+ struct dfm_fhuser_ext *ext = h->ext;
+
+ if (ext->advance)
+ {
+ if (ext->line)
+ read_record (h);
+ else
+ {
+ msg (SE, _("Attempt to read beyond end-of-file on file %s."),
+ fh_handle_name (h));
+ goto lossage;
+ }
+ }
+ }
+
+ {
+ struct dfm_fhuser_ext *ext = h->ext;
+
+ if (ext)
+ {
+ ext->advance = 0;
+ if (len)
+ *len = ext->len - (ext->ptr - ext->line);
+ return ext->ptr;
+ }
+ }
+
+ return NULL;
+
+lossage:
+ /* Come here on reading beyond eof or reading from a file already
+ open for something else. */
+ err_cond_fail ();
+
+ return NULL;
+}
+
+/* Causes dfm_get_record() to read in the next record the next time it
+ is executed on file HANDLE. */
+void
+dfm_fwd_record (struct file_handle *h)
+{
+ struct dfm_fhuser_ext *ext = h->ext;
+
+ assert (h->class == &dfm_r_class);
+ ext->advance = 1;
+}
+
+/* Cancels the effect of any previous dfm_fwd_record() executed on
+ file HANDLE. Sets the current line to begin in the 1-based column
+ COLUMN, as with dfm_set_record but based on a column number instead
+ of a character pointer. */
+void
+dfm_bkwd_record (struct file_handle *h, int column)
+{
+ struct dfm_fhuser_ext *ext = h->ext;
+
+ assert (h->class == &dfm_r_class);
+ ext->advance = 0;
+ ext->ptr = ext->line + min ((int) ext->len + 1, column) - 1;
+}
+
+/* Sets the current line in HANDLE to NEW_LINE, which must point
+ somewhere in the line last returned by dfm_get_record(). Used by
+ DATA LIST FREE to strip the leading portion off the current line. */
+void
+dfm_set_record (struct file_handle *h, char *new_line)
+{
+ struct dfm_fhuser_ext *ext = h->ext;
+
+ assert (h->class == &dfm_r_class);
+ ext->ptr = new_line;
+}
+
+/* Returns the 0-based current column to which the line pointer in
+ HANDLE is set. Unless dfm_set_record() or dfm_bkwd_record() have
+ been called, this is 0. */
+int
+dfm_get_cur_col (struct file_handle *h)
+{
+ struct dfm_fhuser_ext *ext = h->ext;
+
+ assert (h->class == &dfm_r_class);
+ return ext->ptr - ext->line;
+}
+
+/* Writes record REC having length LEN to the file corresponding to
+ HANDLE. REC is not null-terminated. Returns nonzero on success,
+ zero on failure. */
+int
+dfm_put_record (struct file_handle *h, const char *rec, size_t len)
+{
+ char *ptr;
+ size_t amt;
+
+ if (h->class == NULL)
+ {
+ if (!open_file_w (h))
+ return 0;
+ }
+ else if (h->class != &dfm_w_class)
+ {
+ msg (ME, _("Cannot write to file %s already opened for %s."),
+ fh_handle_name (h), gettext (h->class->name));
+ err_cond_fail ();
+ return 0;
+ }
+
+ if (h->recform == FH_RF_FIXED && len < h->lrecl)
+ {
+ int ch;
+
+ amt = h->lrecl;
+ ptr = local_alloc (amt);
+ memcpy (ptr, rec, len);
+ ch = h->mode == FH_MD_CHARACTER ? ' ' : 0;
+ memset (&ptr[len], ch, amt - len);
+ }
+ else
+ {
+ ptr = (char *) rec;
+ amt = len;
+ }
+
+ if (1 != fwrite (ptr, amt, 1, ((struct dfm_fhuser_ext *) h->ext)->file.file))
+ {
+ msg (ME, _("Error writing file %s: %s."), fh_handle_name (h),
+ strerror (errno));
+ err_cond_fail ();
+ return 0;
+ }
+
+ if (ptr != rec)
+ local_free (ptr);
+
+ return 1;
+}
+
+/* Pushes the filename and line number on the fn/ln stack. */
+void
+dfm_push (struct file_handle *h)
+{
+ if (h != inline_file)
+ err_push_file_locator (&h->where);
+}
+
+/* Pops the filename and line number from the fn/ln stack. */
+void
+dfm_pop (struct file_handle *h)
+{
+ if (h != inline_file)
+ err_pop_file_locator (&h->where);
+}
+\f
+/* BEGIN DATA...END DATA procedure. */
+
+/* Perform BEGIN DATA...END DATA as a procedure in itself. */
+int
+cmd_begin_data (void)
+{
+ struct dfm_fhuser_ext *ext;
+
+ /* FIXME: figure out the *exact* conditions, not these really
+ lenient conditions. */
+ if (vfm_source == NULL
+ || vfm_source == &vfm_memory_stream
+ || vfm_source == &vfm_disk_stream
+ || vfm_source == &sort_stream)
+ {
+ msg (SE, _("This command is not valid here since the current "
+ "input program does not access the inline file."));
+ err_cond_fail ();
+ return CMD_FAILURE;
+ }
+
+ /* Initialize inline_file. */
+ msg (VM (1), _("inline file: Opening for reading."));
+ inline_file->class = &dfm_r_class;
+ inline_file->ext = xmalloc (sizeof (struct dfm_fhuser_ext));
+ open_inline_file (inline_file->ext);
+
+ /* We don't actually read from the inline file. The input procedure
+ is what reads from it. */
+ getl_prompt = GETL_PRPT_DATA;
+ procedure (NULL, NULL, NULL);
+
+ ext = inline_file->ext;
+
+ if (ext && ext->line)
+ {
+ msg (MW, _("Skipping remaining inline data."));
+ for (read_record (inline_file); ext->line; read_record (inline_file))
+ ;
+ }
+ assert (inline_file->ext == NULL);
+
+ return CMD_SUCCESS;
+}
+
+static struct fh_ext_class dfm_r_class =
+{
+ 1,
+ N_("reading as a data file"),
+ dfm_close,
+};
+
+static struct fh_ext_class dfm_w_class =
+{
+ 2,
+ N_("writing as a data file"),
+ dfm_close,
+};
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !dfm_h
+#define dfm_h 1
+
+/* Data file manager (dfm).
+
+ This module is in charge of reading and writing data files (other
+ than system files). dfm is an fhuser, so see file-handle.h for the
+ fhuser interface. */
+
+/* I/O utilities. */
+struct file_handle;
+char *dfm_get_record (struct file_handle *handle, int *len);
+int dfm_put_record (struct file_handle *handle, const char *rec, size_t len);
+
+/* Motion control. */
+void dfm_fwd_record (struct file_handle *handle);
+void dfm_bkwd_record (struct file_handle *handle, int column);
+
+/* Weirdness. */
+void dfm_set_record (struct file_handle *handle, char *new_line);
+int dfm_get_cur_col (struct file_handle *handle);
+void dfm_push (struct file_handle *handle);
+void dfm_pop (struct file_handle *handle);
+
+#endif /* dfm_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "expr.h"
+#include "lexer.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+#if DEBUGGING
+#include <stdio.h>
+#endif
+
+/* *INDENT-OFF* */
+/* Description of DO IF transformations:
+
+ DO IF has two transformations. One is a conditional jump around
+ a false condition. The second is an unconditional jump around
+ the rest of the code after a true condition. Both of these types
+ have their destinations backpatched in by the next clause (ELSE IF,
+ END IF).
+
+ The characters `^V<>' are meant to represent arrows.
+
+ 1. DO IF
+ V<<<<if false
+ V
+ V *. Transformations executed when the condition on DO IF is true.
+ V
+ V 2. GOTO>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>V
+ V V
+ >>1. ELSE IF V
+ V<<<<if false V
+ V V
+ V *. Transformations executed when condition on 1st ELSE IF is true. V
+ V V
+ V 2. GOTO>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>V
+ V V
+ >>1. ELSE IF V
+ V<<<<if false V
+ V V
+ V *. Transformations executed when condition on 2nd ELSE IF is true. V
+ V V
+ V 2. GOTO>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>V
+ V V
+ >>*. Transformations executed when no condition is true. (ELSE) V
+ V
+ *. Transformations after DO IF structure.<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+*/
+/* *INDENT-ON* */
+
+#include "do-ifP.h"
+
+static struct do_if_trns *parse_do_if (void);
+static void add_ELSE_IF (struct do_if_trns *);
+static int goto_trns_proc (struct trns_header *, struct ccase *);
+static int do_if_trns_proc (struct trns_header *, struct ccase *);
+static void do_if_trns_free (struct trns_header *);
+
+/* Parse DO IF. */
+int
+cmd_do_if (void)
+{
+ struct do_if_trns *t;
+
+ /* Parse the transformation. */
+ t = parse_do_if ();
+ if (!t)
+ return CMD_FAILURE;
+
+ /* Finish up the transformation, add to control stack, add to
+ transformation list. */
+ t->brk = NULL;
+ t->ctl.type = CST_DO_IF;
+ t->ctl.down = ctl_stack;
+ t->ctl.trns = (struct trns_header *) t;
+ t->ctl.brk = NULL;
+ t->has_else = 0;
+ ctl_stack = &t->ctl;
+ add_transformation ((struct trns_header *) t);
+
+ return CMD_SUCCESS;
+}
+
+/* Parse ELSE IF. */
+int
+cmd_else_if (void)
+{
+ /* Transformation created. */
+ struct do_if_trns *t;
+
+ /* Check that we're in a pleasing situation. */
+ if (!ctl_stack || ctl_stack->type != CST_DO_IF)
+ {
+ msg (SE, _("There is no DO IF to match with this ELSE IF."));
+ return CMD_FAILURE;
+ }
+ if (((struct do_if_trns *) ctl_stack->trns)->has_else)
+ {
+ msg (SE, _("The ELSE command must follow all ELSE IF commands "
+ "in a DO IF structure."));
+ return CMD_FAILURE;
+ }
+
+ /* Parse the transformation. */
+ t = parse_do_if ();
+ if (!t)
+ return CMD_FAILURE;
+
+ /* Stick in the breakout transformation. */
+ t->brk = xmalloc (sizeof *t->brk);
+ t->brk->h.proc = goto_trns_proc;
+ t->brk->h.free = NULL;
+
+ /* Add to list of transformations, add to string of ELSE IFs. */
+ add_transformation ((struct trns_header *) t->brk);
+ add_transformation ((struct trns_header *) t);
+
+ add_ELSE_IF (t);
+
+ if (token != '.')
+ {
+ msg (SE, _("End of command expected."));
+ return CMD_TRAILING_GARBAGE;
+ }
+
+ return CMD_SUCCESS;
+}
+
+/* Parse ELSE. */
+int
+cmd_else (void)
+{
+ struct do_if_trns *t;
+
+ lex_match_id ("ELSE");
+
+ /* Check that we're in a pleasing situation. */
+ if (!ctl_stack || ctl_stack->type != CST_DO_IF)
+ {
+ msg (SE, _("There is no DO IF to match with this ELSE."));
+ return CMD_FAILURE;
+ }
+
+ if (((struct do_if_trns *) ctl_stack->trns)->has_else)
+ {
+ msg (SE, _("There may be at most one ELSE clause in each DO IF "
+ "structure. It must be the last clause."));
+ return CMD_FAILURE;
+ }
+
+ /* Note that the ELSE transformation is *not* added to the list of
+ transformations. That's because it doesn't need to do anything.
+ Its goto transformation *is* added, because that's necessary.
+ The main DO IF do_if_trns is the destructor for this ELSE
+ do_if_trns. */
+ t = xmalloc (sizeof *t);
+ t->next = NULL;
+ t->brk = xmalloc (sizeof *t->brk);
+ t->brk->h.proc = goto_trns_proc;
+ t->brk->h.free = NULL;
+ t->cond = NULL;
+ add_transformation ((struct trns_header *) t->brk);
+ t->h.index = t->brk->h.index + 1;
+
+ /* Add to string of ELSE IFs. */
+ add_ELSE_IF (t);
+
+ return lex_end_of_command ();
+}
+
+/* Parse END IF. */
+int
+cmd_end_if (void)
+{
+ /* List iterator. */
+ struct do_if_trns *iter;
+
+ lex_match_id ("IF");
+
+ /* Check that we're in a pleasing situation. */
+ if (!ctl_stack || ctl_stack->type != CST_DO_IF)
+ {
+ msg (SE, _("There is no DO IF to match with this END IF."));
+ return CMD_FAILURE;
+ }
+
+ /* Chain down the list, backpatching destinations for gotos. */
+ iter = (struct do_if_trns *) ctl_stack->trns;
+ for (;;)
+ {
+ if (iter->brk)
+ iter->brk->dest = n_trns;
+ iter->missing_jump = n_trns;
+ if (iter->next)
+ iter = iter->next;
+ else
+ break;
+ }
+ iter->false_jump = n_trns;
+
+ /* Pop control stack. */
+ ctl_stack = ctl_stack->down;
+
+ return lex_end_of_command ();
+}
+
+/* Adds an ELSE IF or ELSE to the chain of them that hangs off the
+ main DO IF. */
+static void
+add_ELSE_IF (struct do_if_trns * t)
+{
+ /* List iterator. */
+ struct do_if_trns *iter;
+
+ iter = (struct do_if_trns *) ctl_stack->trns;
+ while (iter->next)
+ iter = iter->next;
+ assert (iter != NULL);
+
+ iter->next = t;
+ iter->false_jump = t->h.index;
+}
+
+/* Parses a DO IF or ELSE IF command and returns a pointer to a mostly
+ filled in transformation. */
+static struct do_if_trns *
+parse_do_if (void)
+{
+ struct do_if_trns *t;
+ struct expression *e;
+
+ lex_match_id ("IF");
+
+ e = expr_parse (PXP_BOOLEAN);
+ if (!e)
+ return NULL;
+ if (token != '.')
+ {
+ expr_free (e);
+ lex_error (_("expecting end of command"));
+ return NULL;
+ }
+
+ t = xmalloc (sizeof *t);
+ t->h.proc = do_if_trns_proc;
+ t->h.free = do_if_trns_free;
+ t->next = NULL;
+ t->cond = e;
+
+ return t;
+}
+
+/* Executes a goto transformation. */
+static int
+goto_trns_proc (struct trns_header * t, struct ccase * c unused)
+{
+ return ((struct goto_trns *) t)->dest;
+}
+
+static int
+do_if_trns_proc (struct trns_header * trns, struct ccase * c)
+{
+ struct do_if_trns *t = (struct do_if_trns *) trns;
+ union value bool;
+
+ expr_evaluate (t->cond, c, &bool);
+ if (bool.f == 1.0)
+ {
+ debug_printf ((_("DO IF %d: true\n"), t->h.index));
+ return -1;
+ }
+ else if (bool.f == 0.0)
+ {
+ debug_printf ((_("DO IF %d: false\n"), t->h.index));
+ return t->false_jump;
+ }
+ else
+ {
+ debug_printf ((_("DO IF %d: missing\n"), t->h.index));
+ return t->missing_jump;
+ }
+}
+
+static void
+do_if_trns_free (struct trns_header * trns)
+{
+ struct do_if_trns *t = (struct do_if_trns *) trns;
+ expr_free (t->cond);
+
+ /* If brk is NULL then this is the main DO IF; therefore we
+ need to chain down to the ELSE and delete it. */
+ if (t->brk == NULL)
+ {
+ struct do_if_trns *iter = t->next;
+ while (iter)
+ {
+ if (!iter->cond)
+ {
+ /* This is the ELSE. */
+ free (iter);
+ break;
+ }
+ iter = iter->next;
+ }
+ }
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !do_ifP_h
+#define do_ifP_h 1
+
+#include "var.h"
+
+/* BREAK transformation. */
+struct break_trns
+ {
+ struct trns_header h;
+
+ struct break_trns *next; /* Next in chain of BREAKs associated
+ with a single LOOP. */
+ int loop_term; /* t_trns[] index to jump to; backpatched
+ in by END LOOP. */
+ };
+
+/* Types of control structures. */
+enum
+ {
+ CST_LOOP,
+ CST_DO_IF
+ };
+
+/* Control structure info. */
+struct ctl_stmt
+ {
+ int type; /* One of CST_*. */
+ struct ctl_stmt *down; /* Points toward the bottom of ctl_stack. */
+ struct trns_header *trns; /* Associated transformation. */
+ struct break_trns *brk; /* (LOOP only): Chain of associated BREAKs. */
+ }; /* ctl_stmt */
+
+/* Goto transformation. */
+struct goto_trns
+ {
+ struct trns_header h;
+
+ int dest; /* t_trns[] index of destination of jump. */
+ };
+
+/* DO IF/ELSE IF/ELSE transformation. */
+struct do_if_trns
+ {
+ struct trns_header h;
+
+ struct ctl_stmt ctl; /* DO IF: Control information for nesting. */
+
+ /* Keeping track of clauses. */
+ struct do_if_trns *next; /* Points toward next ELSE IF. */
+ struct goto_trns *brk; /* ELSE IF: jumps out of DO IF structure. */
+ int has_else; /* DO IF: 1=there's been an ELSE. */
+
+ /* Runtime info. */
+ struct expression *cond; /* Condition. */
+ int false_jump; /* t_trns[] index of destination when false. */
+ int missing_jump; /* t_trns[] index to break out of DO IF. */
+ };
+
+/* Top of the control structure stack. */
+extern struct ctl_stmt *ctl_stack;
+
+void discard_ctl_stack (void);
+
+#endif /* !do_ifP_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <ctype.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "getline.h"
+#include "main.h"
+#include "output.h"
+#include "settings.h"
+#include "str.h"
+#include "var.h"
+
+int err_error_count;
+int err_warning_count;
+
+int err_already_flagged;
+
+int err_verbosity;
+
+/* File locator stack. */
+static const struct file_locator **file_loc;
+static int nfile_loc, mfile_loc;
+\f
+/* Fairly common public functions. */
+
+/* Writes error message in CLASS, with title TITLE and text FORMAT,
+ formatted with printf, to the standard places. */
+void
+tmsg (int class, const char *title, const char *format, ...)
+{
+ char buf[1024];
+
+ /* Format the message into BUF. */
+ {
+ va_list args;
+
+ va_start (args, format);
+ vsnprintf (buf, 1024, format, args);
+ va_end (args);
+ }
+
+ /* Output the message. */
+ {
+ struct error e;
+
+ e.class = class;
+ err_location (&e.where);
+ e.title = title;
+ e.text = buf;
+ err_vmsg (&e);
+ }
+}
+
+/* Writes error message in CLASS, with text FORMAT, formatted with
+ printf, to the standard places. */
+void
+msg (int class, const char *format, ...)
+{
+ char buf[1024];
+
+ /* Format the message into BUF. */
+ {
+ va_list args;
+
+ va_start (args, format);
+ vsnprintf (buf, 1024, format, args);
+ va_end (args);
+ }
+
+ /* Output the message. */
+ {
+ struct error e;
+
+ e.class = class;
+ err_location (&e.where);
+ e.title = NULL;
+ e.text = buf;
+ err_vmsg (&e);
+ }
+}
+
+/* Terminate due to fatal error in input. */
+void
+err_failure (void)
+{
+ fflush (stdout);
+ fflush (stderr);
+
+ fprintf (stderr, "%s: %s\n", pgmname,
+ _("Terminating NOW due to a fatal error!"));
+
+ err_hcf (0);
+}
+
+/* Terminate unless we're interactive or will go interactive when the
+ file is over with. */
+void
+err_cond_fail (void)
+{
+ if (getl_reading_script)
+ {
+ if (getl_interactive)
+ getl_close_all ();
+ else
+ err_failure ();
+ }
+}
+\f
+/* File locator stack functions. */
+
+/* Pushes F onto the stack of file locations. */
+void
+err_push_file_locator (const struct file_locator *f)
+{
+ if (nfile_loc >= mfile_loc)
+ {
+ if (mfile_loc == 0)
+ mfile_loc = 8;
+ else
+ mfile_loc *= 2;
+
+ file_loc = xrealloc (file_loc, mfile_loc * sizeof *file_loc);
+ }
+
+ file_loc[nfile_loc++] = f;
+}
+
+/* Pops F off the stack of file locations.
+ Argument F is only used for verification that that is actually the
+ item on top of the stack. */
+void
+err_pop_file_locator (const struct file_locator *f)
+{
+ assert (nfile_loc >= 0 && file_loc[nfile_loc - 1] == f);
+ nfile_loc--;
+}
+
+/* Puts the current file and line number in F, or NULL and -1 if
+ none. */
+void
+err_location (struct file_locator *f)
+{
+ if (nfile_loc)
+ *f = *file_loc[nfile_loc - 1];
+ else
+ getl_location (&f->filename, &f->line_number);
+}
+\f
+/* Obscure public functions. */
+
+/* Writes a blank line to the error device(s).
+ FIXME: currently a no-op. */
+void
+err_break (void)
+{
+}
+
+/* Checks whether we've had so many errors that it's time to quit
+ processing this syntax file. If so, then take appropriate
+ action. */
+void
+err_check_count (void)
+{
+ int error_class = getl_interactive ? MM : FE;
+
+ if (set_errorbreak && err_error_count)
+ msg (error_class, _("Terminating execution of syntax file due to error."));
+ else if (err_error_count > set_mxerrs)
+ msg (error_class, _("Errors (%d) exceeds limit (%d)."),
+ err_error_count, set_mxerrs);
+ else if (err_error_count + err_warning_count > set_mxwarns)
+ msg (error_class, _("Warnings (%d) exceed limit (%d)."),
+ err_error_count + err_warning_count, set_mxwarns);
+ else
+ return;
+
+ getl_close_all ();
+}
+
+#if __CHECKER__
+static void induce_segfault (void);
+#endif
+
+/* Some machines are broken. Compensate. */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+
+#ifndef EXIT_FAILURE
+#define EXIT_FAILURE 1
+#endif
+
+static int terminating;
+
+/* Halt-catch-fire. SUCCESS should be nonzero if exiting successfully
+ or zero if not. Despite the name, this is the usual way to finish,
+ successfully or not. */
+void
+err_hcf (int success)
+{
+ terminating = 1;
+
+ getl_uninitialize ();
+
+ outp_done ();
+
+#if __CHECKER__
+ if (!success)
+ induce_segfault ();
+#endif
+
+ exit (success ? EXIT_SUCCESS : EXIT_FAILURE);
+}
+
+static void puts_stdout (const char *s);
+static void dump_message (char *errbuf, unsigned indent,
+ void (*func) (const char *), unsigned width);
+
+void
+err_vmsg (const struct error *e)
+{
+ /* Class flags. */
+ enum
+ {
+ ERR_IN_PROCEDURE = 01, /* 1=Display name of current procedure. */
+ ERR_WITH_FILE = 02, /* 1=Display filename and line number. */
+ };
+
+ /* Describes one class of error. */
+ struct error_class
+ {
+ int flags; /* Zero or more of MSG_*. */
+ int *count; /* Counting category. */
+ const char *banner; /* Banner. */
+ };
+
+ static const struct error_class error_classes[ERR_CLASS_COUNT] =
+ {
+ {0, NULL, N_("fatal")}, /* FE */
+
+ {3, &err_error_count, N_("error")}, /* SE */
+ {3, &err_warning_count, N_("warning")}, /* SW */
+ {3, NULL, N_("note")}, /* SM */
+
+ {0, NULL, N_("installation error")}, /* IE */
+ {2, NULL, N_("installation error")}, /* IS */
+
+ {2, NULL, N_("error")}, /* DE */
+ {2, NULL, N_("warning")}, /* DW */
+
+ {0, NULL, N_("error")}, /* ME */
+ {0, NULL, N_("warning")}, /* MW */
+ {0, NULL, N_("note")}, /* MM */
+ };
+
+ struct string msg;
+ int class;
+
+ /* Check verbosity level. */
+ class = e->class;
+ if (((class >> ERR_VERBOSITY_SHIFT) & ERR_VERBOSITY_MASK) > err_verbosity)
+ return;
+ class &= ERR_CLASS_MASK;
+
+ assert (class >= 0 && class < ERR_CLASS_COUNT);
+ assert (e->text != NULL);
+
+ ds_init (NULL, &msg, 64);
+ if (e->where.filename && (error_classes[class].flags & ERR_WITH_FILE))
+ {
+ ds_printf (&msg, "%s:", e->where.filename);
+ if (e->where.line_number != -1)
+ ds_printf (&msg, "%d:", e->where.line_number);
+ ds_putchar (&msg, ' ');
+ }
+
+ ds_printf (&msg, "%s: ", gettext (error_classes[class].banner));
+
+ {
+ int *count = error_classes[class].count;
+ if (count)
+ (*count)++;
+ }
+
+ if (cur_proc && (error_classes[class].flags & ERR_IN_PROCEDURE))
+ ds_printf (&msg, "%s: ", cur_proc);
+
+ if (e->title)
+ ds_concat (&msg, e->title);
+
+ ds_concat (&msg, e->text);
+
+ /* FIXME: Check set_messages and set_errors to determine where to
+ send errors and messages.
+
+ Please note that this is not trivial. We have to avoid an
+ infinite loop in reporting errors that originate in the output
+ section. */
+ dump_message (ds_value (&msg), 8, puts_stdout, set_viewwidth);
+
+ ds_destroy (&msg);
+
+ if (e->class == FE && !terminating)
+ err_hcf (0);
+}
+\f
+/* Private functions. */
+
+#if 0
+/* Write S followed by a newline to stderr. */
+static void
+puts_stderr (const char *s)
+{
+ fputs (s, stderr);
+ fputc ('\n', stderr);
+}
+#endif
+
+/* Write S followed by a newline to stdout. */
+static void
+puts_stdout (const char *s)
+{
+ puts (s);
+}
+
+/* Returns 1 if C is a `break character', that is, if it is a good
+ place to break a message into lines. */
+static inline int
+char_is_break (int quote, int c)
+{
+ return ((quote && c == DIR_SEPARATOR)
+ || (!quote && (isspace (c) || c == '-' || c == '/')));
+}
+
+/* Returns 1 if C is a break character where the break should be made
+ BEFORE the character. */
+static inline int
+break_before (int quote, int c)
+{
+ return !quote && isspace (c);
+}
+
+/* If C is a break character, returns 1 if the break should be made
+ AFTER the character. Does not return a meaningful result if C is
+ not a break character. */
+static inline int
+break_after (int quote, int c)
+{
+ return !break_before (quote, c);
+}
+
+/* If you want very long words that occur at a bad break point to be
+ broken into two lines even if they're shorter than a whole line by
+ themselves, define as 2/3, or 4/5, or whatever fraction of a whole
+ line you think is necessary in order to consider a word long enough
+ to break into pieces. Otherwise, define as 0. See code to grok
+ the details. Do NOT parenthesize the expression! */
+#define BREAK_LONG_WORD 0
+/* #define BREAK_LONG_WORD 2/3 */
+/* #define BREAK_LONG_WORD 4/5 */
+
+/* Divides MSG into lines of WIDTH width for the first line and WIDTH
+ - INDENT width for each succeeding line. Each line is dumped
+ through FUNC, which may do with the string what it will. */
+static void
+dump_message (char *msg, unsigned indent, void (*func) (const char *),
+ unsigned width)
+{
+ char *cp;
+
+ /* 1 when at a position inside double quotes ("). */
+ int quote = 0;
+
+ /* Buffer for a single line. */
+ char *buf;
+
+ /* If the message is short, just print the full thing. */
+ if (strlen (msg) < width)
+ {
+ func (msg);
+ return;
+ }
+
+ /* Make sure the indent isn't too big relative to the page width. */
+ if (indent > width / 3)
+ indent = width / 3;
+
+ buf = local_alloc (width + 1);
+
+ /* Advance WIDTH characters into MSG.
+ If that's a valid breakpoint, keep it; otherwise, back up.
+ Output the line. */
+ for (cp = msg; (unsigned) (cp - msg) < width - 1; cp++)
+ if (*cp == '"')
+ quote ^= 1;
+
+ if (break_after (quote, (unsigned char) *cp))
+ {
+ for (cp--; !char_is_break (quote, (unsigned char) *cp) && cp > msg; cp--)
+ if (*cp == '"')
+ quote ^= 1;
+
+ if (break_after (quote, (unsigned char) *cp))
+ cp++;
+ }
+
+ if (cp <= msg + width * BREAK_LONG_WORD)
+ for (; cp < msg + width - 1; cp++)
+ if (*cp == '"')
+ quote ^= 1;
+
+ {
+ int c = *cp;
+ *cp = '\0';
+ func (msg);
+ *cp = c;
+ }
+
+ /* Repeat above procedure for remaining lines. */
+ for (;;)
+ {
+ char *cp2;
+
+ /* Advance past whitespace. */
+ while (isspace ((unsigned char) *cp))
+ cp++;
+ if (*cp == 0)
+ break;
+
+ /* Advance WIDTH - INDENT characters. */
+ for (cp2 = cp; (unsigned) (cp2 - cp) < width - indent && *cp2; cp2++)
+ if (*cp2 == '"')
+ quote ^= 1;
+
+ /* Back up if this isn't a breakpoint. */
+ {
+ unsigned w = cp2 - cp;
+ if (*cp2)
+ for (cp2--; !char_is_break (quote, (unsigned char) *cp2) && cp2 > cp;
+ cp2--)
+ if (*cp2 == '"')
+ quote ^= 1;
+
+ if (w == width - indent
+ && (unsigned) (cp2 - cp) <= (width - indent) * BREAK_LONG_WORD)
+ for (; (unsigned) (cp2 - cp) < width - indent && *cp2; cp2++)
+ if (*cp2 == '"')
+ quote ^= 1;
+ }
+
+ /* Write out the line. */
+ memset (buf, ' ', indent);
+ memcpy (&buf[indent], cp, cp2 - cp);
+ buf[indent + cp2 - cp] = '\0';
+ func (buf);
+
+ cp = cp2;
+ }
+
+ local_free (buf);
+}
+
+#if __CHECKER__
+/* Causes a segfault in order to force Checker to print a stack
+ backtrace. */
+static void
+induce_segfault (void)
+{
+ fputs (_("\n"
+ "\t*********************\n"
+ "\t* INDUCING SEGFAULT *\n"
+ "\t*********************\n"), stdout);
+ fflush (stdout);
+ fflush (stderr);
+ abort ();
+}
+#endif
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !error_h
+#define error_h 1
+
+#include <stdarg.h>
+
+/* Message classes. */
+enum
+ {
+ FE, /* Fatal errors. */
+ SE, SW, SM, /* Script error/warning/message. */
+ IE, IS, /* Installation error/script error. */
+ DE, DW, /* Data-file error/warning. */
+ ME, MW, MM, /* General error/warning/message. */
+ ERR_CLASS_COUNT, /* Number of message classes. */
+ ERR_CLASS_MASK = 0xf, /* Bitmask for class. */
+ ERR_VERBOSITY_SHIFT = 4, /* Shift count for verbosity. */
+ ERR_VERBOSITY_MASK = 0xf, /* Bitmask for verbosity. */
+ };
+
+/* If passed to msg() as CLASS, the return value will cause the message
+ to be displayed only if `verbosity' is at least LEVEL. */
+#define VM(LEVEL) (MM | ((LEVEL) << ERR_VERBOSITY_SHIFT))
+
+/* A file location. */
+struct file_locator
+ {
+ const char *filename; /* Filename. */
+ int line_number; /* Line number. */
+ };
+
+/* An error message. */
+struct error
+ {
+ int class; /* One of the classes above. */
+ struct file_locator where; /* File location, or (NULL, -1). */
+ const char *title; /* Special text inserted if not null. */
+ const char *text; /* Error text. */
+ };
+
+/* Number of errors, warnings reported. */
+extern int err_error_count;
+extern int err_warning_count;
+
+/* If number of allowable errors/warnings is exceeded, then a message
+ is displayed and this flag is set to suppress subsequent
+ messages. */
+extern int err_already_flagged;
+
+/* Nonnegative verbosity level. Higher value == more verbose. */
+extern int err_verbosity;
+
+/* Functions. */
+void msg (int class, const char *format, ...)
+ __attribute__ ((format (printf, 2, 3)));
+void tmsg (int class, const char *title, const char *format, ...)
+ __attribute__ ((format (printf, 3, 4)));
+void err_failure (void);
+void err_cond_fail (void);
+
+/* File-locator stack. */
+void err_push_file_locator (const struct file_locator *);
+void err_pop_file_locator (const struct file_locator *);
+void err_location (struct file_locator *);
+
+/* Obscure functions. */
+void err_break (void);
+void err_check_count (void);
+void err_hcf (int exit_code) __attribute__ ((noreturn));
+void err_vmsg (const struct error *);
+
+#endif /* error.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#if TIME_WITH_SYS_TIME
+#include <sys/time.h>
+#include <time.h>
+#else
+#if HAVE_SYS_TIME_H
+#include <sys/time.h>
+#else
+#include <time.h>
+#endif
+#endif
+
+#include <ctype.h>
+#include <assert.h>
+#include <math.h>
+#include <errno.h>
+#include <stdio.h>
+#include "approx.h"
+#include "data-in.h"
+#include "error.h"
+#include "expr.h"
+#include "exprP.h"
+#include "julcal/julcal.h"
+#include "magic.h"
+#include "random.h"
+#include "stats.h"
+#include "str.h"
+#include "var.h"
+#include "vector.h"
+#include "vfm.h"
+#include "vfmP.h"
+
+/* FIXME: This could be even more efficient if we caught SYSMIS when
+ it first reared its ugly head, then threw it into an entirely new
+ switch that handled SYSMIS aggressively like all the code does now.
+ But I've spent a couple of weeks on the expression code, and that's
+ enough to make anyone sick. For that matter, it could be more
+ efficient if I hand-coded it in assembly for a dozen processors,
+ but I'm not going to do that either. */
+
+/* These macros are defined differently depending on the way that
+ the stack is managed. (i.e., I have to adapt the code to inferior
+ environments.)
+
+ void CHECK_STRING_SPACE(int x): Assure that at least X+1 bytes of
+ space are available in the string evaluation stack.
+
+ unsigned char *ALLOC_STRING_SPACE(int x): Return a pointer to X+1
+ bytes of space. CHECK_STRING_SPACE must have previously been
+ called with an argument of at least X. */
+
+#if PAGED_STACK
+#define CHECK_STRING_SPACE(X) /* nothing to do! */
+#define ALLOC_STRING_SPACE(X) \
+ alloca((X) + 1)
+#else /* !PAGED_STACK */
+#define CHECK_STRING_SPACE(X) \
+ do \
+ { \
+ if (str_stk + X >= str_end) \
+ { \
+ e->str_size += 1024; \
+ e->str_stk = xrealloc (e->str_stk, e->str_size); \
+ str_end = e->str_stk + e->str_size - 1; \
+ } \
+ } \
+ while (0)
+
+#define ALLOC_STRING_SPACE(X) \
+ (str_stk += X + 1, str_stk - X - 1)
+#endif /* !PAGED_STACK */
+
+double
+expr_evaluate (struct expression *e, struct ccase *c, union value *v)
+{
+ unsigned char *op = e->op;
+ double *dbl = e->num;
+ unsigned char *str = e->str;
+#if !PAGED_STACK
+ unsigned char *str_stk = e->str_stk;
+ unsigned char *str_end = e->str_stk + e->str_size - 1;
+#endif
+ struct variable **vars = e->var;
+ int i, j;
+
+ /* Stack pointer. */
+ union value *sp = e->stack;
+
+ for (;;)
+ {
+ switch (*op++)
+ {
+ case OP_PLUS:
+ sp -= *op - 1;
+ if (sp->f != SYSMIS)
+ for (i = 1; i < *op; i++)
+ {
+ if (sp[i].f == SYSMIS)
+ {
+ sp->f = SYSMIS;
+ break;
+ }
+ else
+ sp->f += sp[i].f;
+ }
+ op++;
+ break;
+ case OP_MUL:
+ sp -= *op - 1;
+ if (sp->f != SYSMIS)
+ for (i = 1; i < *op; i++)
+ {
+ if (sp[i].f == SYSMIS)
+ {
+ sp->f = SYSMIS;
+ break;
+ }
+ else
+ sp->f *= sp[i].f;
+ }
+ op++;
+ break;
+ case OP_POW:
+ sp--;
+ if (sp[0].f == SYSMIS)
+ {
+ if (approx_eq (sp[1].f, 0.0))
+ sp->f = 1.0;
+ }
+ else if (sp[1].f == SYSMIS)
+ {
+ if (sp[0].f == 0.0)
+ /* SYSMIS**0 */
+ sp->f = 0.0;
+ else
+ sp->f = SYSMIS;
+ }
+ else if (approx_eq (sp[0].f, 0.0) && approx_eq (sp[1].f, 0.0))
+ sp->f = SYSMIS;
+ else
+ sp->f = pow (sp[0].f, sp[1].f);
+ break;
+
+ case OP_AND:
+ /* Note that the equality operator (==) may be used here
+ (instead of approx_eq) because booleans are always
+ *exactly* 0, 1, or SYSMIS.
+
+ Truth table (in order of detection):
+
+ 1:
+ 0 and 0 = 0
+ 0 and 1 = 0
+ 0 and SYSMIS = 0
+
+ 2:
+ 1 and 0 = 0
+ SYSMIS and 0 = 0
+
+ 3:
+ 1 and SYSMIS = SYSMIS
+ SYSMIS and SYSMIS = SYSMIS
+
+ 4:
+ 1 and 1 = 1
+ SYSMIS and 1 = SYSMIS
+
+ */
+ sp--;
+ if (sp[0].f == 0.0); /* 1 */
+ else if (sp[1].f == 0.0)
+ sp->f = 0.0; /* 2 */
+ else if (sp[1].f == SYSMIS)
+ sp->f = SYSMIS; /* 3 */
+ break;
+ case OP_OR:
+ /* Truth table (in order of detection):
+
+ 1:
+ 1 or 1 = 1
+ 1 or 0 = 1
+ 1 or SYSMIS = 1
+
+ 2:
+ 0 or 1 = 1
+ SYSMIS or 1 = 1
+
+ 3:
+ 0 or SYSMIS = SYSMIS
+ SYSMIS or SYSMIS = SYSMIS
+
+ 4:
+ 0 or 0 = 0
+ SYSMIS or 0 = SYSMIS
+
+ */
+ sp--;
+ if (sp[0].f == 1.0); /* 1 */
+ else if (sp[1].f == 1.0)
+ sp->f = 1.0; /* 2 */
+ else if (sp[1].f == SYSMIS)
+ sp->f = SYSMIS; /* 3 */
+ break;
+ case OP_NOT:
+ if (sp[0].f == 0.0)
+ sp->f = 1.0;
+ else if (sp[0].f == 1.0)
+ sp->f = 0.0;
+ break;
+
+ case OP_EQ:
+ sp--;
+ if (sp[0].f != SYSMIS)
+ {
+ if (sp[1].f == SYSMIS)
+ sp->f = SYSMIS;
+ else
+ sp->f = approx_eq (sp[0].f, sp[1].f);
+ }
+ break;
+ case OP_GE:
+ sp--;
+ if (sp[0].f != SYSMIS)
+ {
+ if (sp[1].f == SYSMIS)
+ sp->f = SYSMIS;
+ else
+ sp->f = approx_ge (sp[0].f, sp[1].f);
+ }
+ break;
+ case OP_GT:
+ sp--;
+ if (sp[0].f != SYSMIS)
+ {
+ if (sp[1].f == SYSMIS)
+ sp->f = SYSMIS;
+ else
+ sp->f = approx_gt (sp[0].f, sp[1].f);
+ }
+ break;
+ case OP_LE:
+ sp--;
+ if (sp[0].f != SYSMIS)
+ {
+ if (sp[1].f == SYSMIS)
+ sp->f = SYSMIS;
+ else
+ sp->f = approx_le (sp[0].f, sp[1].f);
+ }
+ break;
+ case OP_LT:
+ sp--;
+ if (sp[0].f != SYSMIS)
+ {
+ if (sp[1].f == SYSMIS)
+ sp->f = SYSMIS;
+ else
+ sp->f = approx_lt (sp[0].f, sp[1].f);
+ }
+ break;
+ case OP_NE:
+ sp--;
+ if (sp[0].f != SYSMIS)
+ {
+ if (sp[1].f == SYSMIS)
+ sp->f = SYSMIS;
+ else
+ sp->f = approx_ne (sp[0].f, sp[1].f);
+ }
+ break;
+
+ /* String operators. */
+ case OP_STRING_EQ:
+ sp--;
+ sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
+ &sp[1].c[1], sp[1].c[0]) == 0;
+ break;
+ case OP_STRING_GE:
+ sp--;
+ sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
+ &sp[1].c[1], sp[1].c[0]) >= 0;
+ break;
+ case OP_STRING_GT:
+ sp--;
+ sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
+ &sp[1].c[1], sp[1].c[0]) > 0;
+ break;
+ case OP_STRING_LE:
+ sp--;
+ sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
+ &sp[1].c[1], sp[1].c[0]) <= 0;
+ break;
+ case OP_STRING_LT:
+ sp--;
+ sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
+ &sp[1].c[1], sp[1].c[0]) < 0;
+ break;
+ case OP_STRING_NE:
+ sp--;
+ sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
+ &sp[1].c[1], sp[1].c[0]) != 0;
+ break;
+
+ /* Unary functions. */
+ case OP_NEG:
+ if (sp->f != SYSMIS)
+ sp->f = -sp->f;
+ break;
+ case OP_ABS:
+ if (sp->f != SYSMIS)
+ sp->f = fabs (sp->f);
+ break;
+ case OP_ARCOS:
+ if (sp->f != SYSMIS)
+ {
+ errno = 0;
+ sp->f = acos (sp->f);
+ if (errno)
+ sp->f = SYSMIS;
+ }
+ break;
+ case OP_ARSIN:
+ if (sp->f != SYSMIS)
+ {
+ errno = 0;
+ sp->f = asin (sp->f);
+ if (errno)
+ sp->f = SYSMIS;
+ }
+ break;
+ case OP_ARTAN:
+ if (sp->f != SYSMIS)
+ sp->f = atan (sp->f);
+ break;
+ case OP_COS:
+ if (sp->f != SYSMIS)
+ sp->f = cos (sp->f);
+ break;
+ case OP_EXP:
+ if (sp->f != SYSMIS)
+ {
+ errno = 0;
+ sp->f = exp (sp->f);
+ if (errno)
+ sp->f = SYSMIS;
+ }
+ break;
+ case OP_LG10:
+ if (sp->f != SYSMIS)
+ {
+ errno = 0;
+ sp->f = log10 (sp->f);
+ if (errno)
+ sp->f = SYSMIS;
+ }
+ break;
+ case OP_LN:
+ if (sp->f != SYSMIS)
+ {
+ errno = 0;
+ sp->f = log10 (sp->f);
+ if (errno)
+ sp->f = SYSMIS;
+ }
+ break;
+ case OP_MOD10:
+ if (sp->f != SYSMIS)
+ sp->f = fmod (sp->f, 10);
+ break;
+ case OP_RND:
+ if (sp->f != SYSMIS)
+ {
+ if (sp->f >= 0.0)
+ sp->f = floor (sp->f + 0.5);
+ else
+ sp->f = -floor (-sp->f + 0.5);
+ }
+ break;
+ case OP_SIN:
+ if (sp->f != SYSMIS)
+ sp->f = sin (sp->f);
+ break;
+ case OP_SQRT:
+ if (sp->f != SYSMIS)
+ {
+ errno = 0;
+ sp->f = sqrt (sp->f);
+ if (errno)
+ sp->f = SYSMIS;
+ }
+ break;
+ case OP_TAN:
+ if (sp->f != SYSMIS)
+ {
+ errno = 0;
+ sp->f = tan (sp->f);
+ if (errno)
+ sp->f = SYSMIS;
+ }
+ break;
+ case OP_TRUNC:
+ if (sp->f != SYSMIS)
+ {
+ if (sp->f >= 0.0)
+ sp->f = floor (sp->f);
+ else
+ sp->f = -floor (-sp->f);
+ }
+ break;
+
+ /* N-ary numeric functions. */
+ case OP_ANY:
+ {
+ int n_args = *op++;
+ int sysmis = 1;
+
+ sp -= n_args - 1;
+ if (sp->f == SYSMIS)
+ break;
+ for (i = 1; i <= n_args; i++)
+ if (approx_eq (sp[0].f, sp[i].f))
+ {
+ sp->f = 1.0;
+ goto main_loop;
+ }
+ else if (sp[i].f != SYSMIS)
+ sysmis = 0;
+ sp->f = sysmis ? SYSMIS : 0.0;
+ }
+ break;
+ case OP_ANY_STRING:
+ {
+ int n_args = *op++;
+
+ sp -= n_args - 1;
+ for (i = 1; i <= n_args; i++)
+ if (!st_compare_pad (&sp[0].c[1], sp[0].c[0],
+ &sp[i].c[1], sp[i].c[0]))
+ {
+ sp->f = 1.0;
+ goto main_loop;
+ }
+ sp->f = 0.0;
+ }
+ break;
+ case OP_CFVAR:
+ {
+ int n_args = *op++;
+ int nv = 0;
+ double sum[2] =
+ {0.0, 0.0};
+
+ sp -= n_args - 1;
+ for (i = 0; i < n_args; i++)
+ if (sp[i].f != SYSMIS)
+ {
+ nv++;
+ sum[0] += sp[i].f;
+ sum[1] += sp[i].f * sp[i].f;
+ }
+ if (nv < *op++)
+ sp->f = SYSMIS;
+ else
+ sp->f = calc_cfvar (sum, nv);
+ }
+ break;
+ case OP_MAX:
+ {
+ int n_args = *op++;
+ int nv = 0;
+ double max = -DBL_MAX;
+
+ sp -= n_args - 1;
+ for (i = 0; i < n_args; i++)
+ if (sp[i].f != SYSMIS)
+ {
+ nv++;
+ if (sp[i].f > max)
+ max = sp[i].f;
+ }
+ if (nv < *op++)
+ sp->f = SYSMIS;
+ else
+ sp->f = max;
+ }
+ break;
+ case OP_MEAN:
+ {
+ int n_args = *op++;
+ int nv = 0;
+ double sum[1] =
+ {0.0};
+
+ sp -= n_args - 1;
+ for (i = 0; i < n_args; i++)
+ if (sp[i].f != SYSMIS)
+ {
+ nv++;
+ sum[0] += sp[i].f;
+ }
+ if (nv < *op++)
+ sp->f = SYSMIS;
+ else
+ sp->f = calc_mean (sum, nv);
+ }
+ break;
+ case OP_MIN:
+ {
+ int n_args = *op++;
+ int nv = 0;
+ double min = DBL_MAX;
+
+ sp -= n_args - 1;
+ for (i = 0; i < n_args; i++)
+ if (sp[i].f != SYSMIS)
+ {
+ nv++;
+ if (sp[i].f < min)
+ min = sp[i].f;
+ }
+ if (nv < *op++)
+ sp->f = SYSMIS;
+ else
+ sp->f = min;
+ }
+ break;
+ case OP_NMISS:
+ {
+ int n_args = *op++;
+ int n_missing = 0;
+
+ sp -= n_args - 1;
+ for (i = 0; i < n_args; i++)
+ if (sp[i].f == SYSMIS)
+ n_missing++;
+ sp->f = n_missing;
+ }
+ break;
+ case OP_NVALID:
+ {
+ int n_args = *op++;
+ int n_valid = 0;
+
+ sp -= n_args - 1;
+ for (i = 0; i < n_args; i++)
+ if (sp[i].f != SYSMIS)
+ n_valid++;
+ sp->f = n_valid;
+ }
+ break;
+ case OP_RANGE:
+ {
+ int n_args = *op++;
+ int sysmis = 1;
+
+ sp -= n_args - 1;
+ if (sp->f == SYSMIS)
+ break;
+ for (i = 1; i <= n_args; i += 2)
+ if (sp[i].f == SYSMIS || sp[i + 1].f == SYSMIS)
+ continue;
+ else if (approx_ge (sp[0].f, sp[i].f)
+ && approx_le (sp[0].f, sp[i + 1].f))
+ {
+ sp->f = 1.0;
+ goto main_loop;
+ }
+ else
+ sysmis = 0;
+ sp->f = sysmis ? SYSMIS : 0.0;
+ }
+ break;
+ case OP_RANGE_STRING:
+ {
+ int n_args = *op++;
+
+ sp -= n_args - 1;
+ for (i = 1; i <= n_args; i += 2)
+ if (st_compare_pad (&sp[0].c[1], sp[0].c[0],
+ &sp[i].c[1], sp[i].c[0]) >= 0
+ && st_compare_pad (&sp[0].c[1], sp[0].c[0],
+ &sp[i + 1].c[1], sp[i + 1].c[0]) <= 0)
+ {
+ sp->f = 1.0;
+ goto main_loop;
+ }
+ sp->f = 0.0;
+ }
+ break;
+ case OP_SD:
+ {
+ int n_args = *op++;
+ int nv = 0;
+ double sum[2];
+
+ sum[0] = sum[1] = 0.0;
+
+ sp -= n_args - 1;
+ for (i = 0; i < n_args; i++)
+ if (sp[i].f != SYSMIS)
+ {
+ nv++;
+ sum[0] += sp[i].f;
+ sum[1] += sp[i].f * sp[i].f;
+ }
+ if (nv < *op++)
+ sp->f = SYSMIS;
+ else
+ sp->f = calc_stddev (calc_variance (sum, nv));
+ }
+ break;
+ case OP_SUM:
+ {
+ int n_args = *op++;
+ int nv = 0;
+ double sum = 0.0;
+
+ sp -= n_args - 1;
+ for (i = 0; i < n_args; i++)
+ if (sp[i].f != SYSMIS)
+ {
+ nv++;
+ sum += sp[i].f;
+ }
+ if (nv < *op++)
+ sp->f = SYSMIS;
+ else
+ sp->f = sum;
+ }
+ break;
+ case OP_VARIANCE:
+ {
+ int n_args = *op++;
+ int nv = 0;
+ double sum[2];
+
+ sum[0] = sum[1] = 0.0;
+
+ sp -= n_args - 1;
+ for (i = 0; i < n_args; i++)
+ if (sp[i].f != SYSMIS)
+ {
+ nv++;
+ sum[0] += sp[i].f;
+ sum[1] += sp[i].f * sp[i].f;
+ }
+ if (nv < *op++)
+ sp->f = SYSMIS;
+ else
+ sp->f = calc_variance (sum, nv);
+ }
+ break;
+
+ /* Time construction function. */
+ case OP_TIME_HMS:
+ sp -= 2;
+ if (sp[0].f == SYSMIS || sp[1].f == SYSMIS || sp[2].f == SYSMIS)
+ sp->f = SYSMIS;
+ else
+ sp->f = 60. * (60. * sp[0].f + sp[1].f) + sp[2].f;
+ break;
+
+ /* Date construction functions. */
+ case OP_DATE_DMY:
+ sp -= 2;
+ sp->f = yrmoda (sp[2].f, sp[1].f, sp[0].f);
+ if (sp->f != SYSMIS)
+ sp->f *= 60. * 60. * 24.;
+ break;
+ case OP_DATE_MDY:
+ sp -= 2;
+ sp->f = yrmoda (sp[2].f, sp[0].f, sp[1].f);
+ if (sp->f != SYSMIS)
+ sp->f *= 60. * 60. * 24.;
+ break;
+ case OP_DATE_MOYR:
+ (--sp)->f = yrmoda (sp[1].f, sp[0].f, 1);
+ if (sp->f != SYSMIS)
+ sp->f *= 60. * 60. * 24.;
+ break;
+ case OP_DATE_QYR:
+ sp--;
+ if (sp[0].f == SYSMIS)
+ sp->f = SYSMIS;
+ else
+ {
+ sp->f = yrmoda (sp[1].f, sp[0].f * 3 - 2, 1);
+ if (sp->f != SYSMIS)
+ sp->f *= 60. * 60. * 24.;
+ }
+ break;
+ case OP_DATE_WKYR:
+ sp--;
+ if (sp[0].f == SYSMIS)
+ sp->f = SYSMIS;
+ else
+ {
+ sp[1].f = yrmoda (sp[1].f, 1, 1);
+ if (sp->f != SYSMIS)
+ sp[1].f = 60. * 60. * 24. * (sp[1].f + 7. * (floor (sp[0].f) - 1.));
+ sp->f = sp[1].f;
+ }
+ break;
+ case OP_DATE_YRDAY:
+ sp--;
+ if (sp[1].f == SYSMIS)
+ sp->f = SYSMIS;
+ else
+ {
+ sp->f = yrmoda (sp[0].f, 1, 1);
+ if (sp->f != SYSMIS)
+ sp->f = 60. * 60. * 24. * (sp->f + floor (sp[1].f) - 1);
+ }
+ break;
+ case OP_YRMODA:
+ sp -= 2;
+ sp->f = yrmoda (sp[0].f, sp[1].f, sp[2].f);
+ break;
+
+ /* Date extraction functions. */
+ case OP_XDATE_DATE:
+ if (sp->f != SYSMIS)
+ sp->f = floor (sp->f / 60. / 60. / 24.) * 60. * 60. * 24.;
+ break;
+ case OP_XDATE_HOUR:
+ if (sp->f != SYSMIS)
+ sp->f = fmod (floor (sp->f / 60. / 60.), 24.);
+ break;
+ case OP_XDATE_JDAY:
+ if (sp->f != SYSMIS)
+ sp->f = 86400. * julian_to_jday (sp->f / 86400.);
+ break;
+ case OP_XDATE_MDAY:
+ if (sp->f != SYSMIS)
+ {
+ int day;
+ julian_to_calendar (sp->f / 86400., NULL, NULL, &day);
+ sp->f = day;
+ }
+ break;
+ case OP_XDATE_MINUTE:
+ if (sp->f != SYSMIS)
+ sp->f = fmod (floor (sp->f / 60.), 60.);
+ break;
+ case OP_XDATE_MONTH:
+ if (sp->f != SYSMIS)
+ {
+ int month;
+ julian_to_calendar (sp->f / 86400., NULL, &month, NULL);
+ sp->f = month;
+ }
+ break;
+ case OP_XDATE_QUARTER:
+ if (sp->f != SYSMIS)
+ {
+ int month;
+ julian_to_calendar (sp->f / 86400., NULL, &month, NULL);
+ sp->f = (month - 1) / 3 + 1;
+ }
+ break;
+ case OP_XDATE_SECOND:
+ if (sp->f != SYSMIS)
+ sp->f = fmod (sp->f, 60.);
+ break;
+ case OP_XDATE_TDAY:
+ if (sp->f != SYSMIS)
+ sp->f = floor (sp->f / 60. / 60. / 24.);
+ break;
+ case OP_XDATE_TIME:
+ if (sp->f != SYSMIS)
+ sp->f -= floor (sp->f / 60. / 60. / 24.) * 60. * 60. * 24.;
+ break;
+ case OP_XDATE_WEEK:
+ if (sp->f != SYSMIS)
+ sp->f = (julian_to_jday (sp->f / 86400.) - 1) / 7 + 1;
+ break;
+ case OP_XDATE_WKDAY:
+ if (sp->f != SYSMIS)
+ sp->f = julian_to_wday (sp->f / 86400.);
+ break;
+ case OP_XDATE_YEAR:
+ if (sp->f != SYSMIS)
+ {
+ int year;
+ julian_to_calendar (sp->f / 86400., &year, NULL, NULL);
+ sp->f = year;
+ }
+ break;
+
+ /* String functions. */
+ case OP_CONCAT:
+ {
+ int n_args = *op++;
+ unsigned char *dest;
+
+ CHECK_STRING_SPACE (255);
+ dest = ALLOC_STRING_SPACE (255);
+ dest[0] = 0;
+
+ sp -= n_args - 1;
+ for (i = 0; i < n_args; i++)
+ if (sp[i].c[0] != 0)
+ {
+ if (sp[i].c[0] + dest[0] < 255)
+ {
+ memcpy (&dest[dest[0] + 1], &sp[i].c[1], sp[i].c[0]);
+ dest[0] += sp[i].c[0];
+ }
+ else
+ {
+ memcpy (&dest[dest[0] + 1], &sp[i].c[1], 255 - dest[0]);
+ dest[0] = 255;
+ break;
+ }
+ }
+ sp[0].c = dest;
+ }
+ break;
+ case OP_INDEX:
+ sp--;
+ if (sp[1].c[0] == 0)
+ sp->f = SYSMIS;
+ else
+ {
+ int last = sp[0].c[0] - sp[1].c[0];
+ for (i = 0; i <= last; i++)
+ if (!memcmp (&sp[0].c[i + 1], &sp[0].c[1], sp[0].c[0]))
+ {
+ sp->f = i + 1;
+ goto main_loop;
+ }
+ sp->f = 0.0;
+ }
+ break;
+ case OP_INDEX_OPT:
+ {
+ /* Length of each search string. */
+ int part_len = sp[2].f;
+
+ sp -= 2;
+ if (sp[1].c[0] == 0 || part_len <= 0 || sp[2].f == SYSMIS
+ || sp[1].c[0] % part_len != 0)
+ sp->f = SYSMIS;
+ else
+ {
+ /* Last possible index. */
+ int last = sp[0].c[0] - part_len;
+
+ for (i = 0; i <= last; i++)
+ for (j = 0; j < sp[1].c[0]; j += part_len)
+ if (!memcmp (&sp[0].c[i], &sp[1].c[j], part_len))
+ {
+ sp->f = i + 1;
+ goto main_loop;
+ }
+ sp->f = 0.0;
+ }
+ }
+ break;
+ case OP_RINDEX:
+ sp--;
+ if (sp[1].c[0] == 0)
+ sp->f = SYSMIS;
+ else
+ {
+ for (i = sp[0].c[0] - sp[1].c[0]; i >= 0; i--)
+ if (!memcmp (&sp[0].c[i + 1], &sp[0].c[1], sp[0].c[0]))
+ {
+ sp->f = i + 1;
+ goto main_loop;
+ }
+ sp->f = 0.0;
+ }
+ break;
+ case OP_RINDEX_OPT:
+ {
+ /* Length of each search string. */
+ int part_len = sp[2].f;
+
+ sp -= 2;
+ if (sp[1].c[0] == 0 || part_len <= 0 || sp[2].f == SYSMIS
+ || sp[1].c[0] % part_len != 0)
+ sp->f = SYSMIS;
+ else
+ {
+ for (i = sp[0].c[0] - part_len; i >= 0; i--)
+ for (j = 0; j < sp[1].c[0]; j += part_len)
+ if (!memcmp (&sp[0].c[i], &sp[1].c[j], part_len))
+ {
+ sp->f = i + 1;
+ goto main_loop;
+ }
+ sp->f = 0.0;
+ }
+ }
+ break;
+ case OP_LENGTH:
+ sp->f = sp[0].c[0];
+ break;
+ case OP_LOWER:
+ for (i = sp[0].c[0]; i >= 1; i--)
+ sp[0].c[i] = tolower ((unsigned char) (sp[0].c[i]));
+ break;
+ case OP_UPPER:
+ for (i = sp[0].c[0]; i >= 1; i--)
+ sp[0].c[i] = toupper ((unsigned char) (sp[0].c[i]));
+ break;
+ case OP_LPAD:
+ {
+ int len;
+ sp--;
+ len = sp[1].f;
+ if (sp[1].f == SYSMIS || len < 0 || len > 255)
+ sp->c[0] = 0;
+ else if (len > sp[0].c[0])
+ {
+ unsigned char *dest;
+
+ CHECK_STRING_SPACE (len);
+ dest = ALLOC_STRING_SPACE (len);
+ dest[0] = len;
+ memset (&dest[1], ' ', len - sp->c[0]);
+ memcpy (&dest[len - sp->c[0] + 1], &sp->c[1], sp->c[0]);
+ sp->c = dest;
+ }
+ }
+ break;
+ case OP_LPAD_OPT:
+ {
+ int len;
+ sp -= 2;
+ len = sp[1].f;
+ if (sp[1].f == SYSMIS || len < 0 || len > 255 || sp[2].c[0] != 1)
+ sp->c[0] = 0;
+ else if (len > sp[0].c[0])
+ {
+ unsigned char *dest;
+
+ CHECK_STRING_SPACE (len);
+ dest = ALLOC_STRING_SPACE (len);
+ dest[0] = len;
+ memset (&dest[1], sp[2].c[1], len - sp->c[0]);
+ memcpy (&dest[len - sp->c[0] + 1], &sp->c[1], sp->c[0]);
+ sp->c = dest;
+ }
+ }
+ break;
+ case OP_RPAD:
+ {
+ int len;
+ sp--;
+ len = sp[1].f;
+ if (sp[1].f == SYSMIS || len < 0 || len > 255)
+ sp->c[0] = 0;
+ else if (len > sp[0].c[0])
+ {
+ unsigned char *dest;
+
+ CHECK_STRING_SPACE (len);
+ dest = ALLOC_STRING_SPACE (len);
+ dest[0] = len;
+ memcpy (&dest[1], &sp->c[1], sp->c[0]);
+ memset (&dest[sp->c[0] + 1], ' ', len - sp->c[0]);
+ sp->c = dest;
+ }
+ }
+ break;
+ case OP_RPAD_OPT:
+ {
+ int len;
+ sp -= 2;
+ len = sp[1].f;
+ if (len < 0 || len > 255 || sp[2].c[0] != 1)
+ sp->c[0] = 0;
+ else if (len > sp[0].c[0])
+ {
+ unsigned char *dest;
+
+ CHECK_STRING_SPACE (len);
+ dest = ALLOC_STRING_SPACE (len);
+ dest[0] = len;
+ memcpy (&dest[1], &sp->c[1], sp->c[0]);
+ memset (&dest[sp->c[0] + 1], sp[2].c[1], len - sp->c[0]);
+ sp->c = dest;
+ }
+ }
+ break;
+ case OP_LTRIM:
+ {
+ int len = sp[0].c[0];
+
+ i = 1;
+ while (i <= len && sp[0].c[i] == ' ')
+ i++;
+ if (--i)
+ {
+ sp[0].c[i] = sp[0].c[0] - i;
+ sp->c = &sp[0].c[i];
+ }
+ }
+ break;
+ case OP_LTRIM_OPT:
+ {
+ sp--;
+ if (sp[1].c[0] != 1)
+ sp[0].c[0] = 0;
+ else
+ {
+ int len = sp[0].c[0];
+ int cmp = sp[1].c[1];
+
+ i = 1;
+ while (i <= len && sp[0].c[i] == cmp)
+ i++;
+ if (--i)
+ {
+ sp[0].c[i] = sp[0].c[0] - i;
+ sp->c = &sp[0].c[i];
+ }
+ }
+ }
+ break;
+ case OP_RTRIM:
+ assert (' ' != 0);
+ while (sp[0].c[sp[0].c[0]] == ' ')
+ sp[0].c[0]--;
+ break;
+ case OP_RTRIM_OPT:
+ sp--;
+ if (sp[1].c[0] != 1)
+ sp[0].c[0] = 0;
+ else
+ {
+ /* Note that NULs are not allowed in strings. This code
+ needs to change if this decision is changed. */
+ int cmp = sp[1].c[1];
+ while (sp[0].c[sp[0].c[0]] == cmp)
+ sp[0].c[0]--;
+ }
+ break;
+ case OP_NUMBER:
+ {
+ struct data_in di;
+
+ di.s = &sp->c[1];
+ di.e = &sp->c[1] + sp->c[0];
+ di.v = sp;
+ di.flags = DI_IGNORE_ERROR;
+ di.f1 = 1;
+ di.format.type = FMT_F;
+ di.format.w = sp->c[0];
+ di.format.d = 0;
+ data_in (&di);
+ }
+ break;
+ case OP_NUMBER_OPT:
+ {
+ struct data_in di;
+ di.s = &sp->c[1];
+ di.e = &sp->c[1] + sp->c[0];
+ di.v = sp;
+ di.flags = DI_IGNORE_ERROR;
+ di.f1 = 1;
+ di.format.type = *op++;
+ di.format.w = *op++;
+ di.format.d = *op++;
+ data_in (&di);
+ }
+ break;
+ case OP_STRING:
+ {
+ struct fmt_spec f;
+ unsigned char *dest;
+
+ f.type = *op++;
+ f.w = *op++;
+ f.d = *op++;
+
+ CHECK_STRING_SPACE (f.w);
+ dest = ALLOC_STRING_SPACE (f.w);
+ dest[0] = f.w;
+
+ data_out (&dest[1], &f, sp);
+ sp->c = dest;
+ }
+ break;
+ case OP_SUBSTR:
+ {
+ int index;
+
+ sp--;
+ index = sp[1].f;
+ if (index < 1 || index > sp[0].c[0])
+ sp->c[0] = 0;
+ else if (index > 1)
+ {
+ index--;
+ sp->c[index] = sp->c[0] - index;
+ sp->c += index;
+ }
+ }
+ break;
+ case OP_SUBSTR_OPT:
+ {
+ int index;
+ int n;
+
+ sp -= 2;
+ index = sp[1].f;
+ n = sp[2].f;
+ if (sp[1].f == SYSMIS || sp[2].f == SYSMIS || index < 1
+ || index > sp[0].c[0] || n < 1)
+ sp->c[0] = 0;
+ else
+ {
+ if (index > 1)
+ {
+ index--;
+ sp->c[index] = sp->c[0] - index;
+ sp->c += index;
+ }
+ if (sp->c[0] > n)
+ sp->c[0] = n;
+ }
+ }
+ break;
+
+ /* Artificial. */
+ case OP_INV:
+ if (sp->f != SYSMIS)
+ sp->f = 1. / sp->f;
+ break;
+ case OP_SQUARE:
+ if (sp->f != SYSMIS)
+ sp->f *= sp->f;
+ break;
+ case OP_NUM_TO_BOOL:
+ if (approx_eq (sp->f, 0.0))
+ sp->f = 0.0;
+ else if (approx_eq (sp->f, 1.0))
+ sp->f = 1.0;
+ else if (sp->f != SYSMIS)
+ {
+ msg (SE, _("A number being treated as a Boolean in an "
+ "expression was found to have a value other than "
+ "0 (false), 1 (true), or the system-missing value. "
+ "The result was forced to 0."));
+ sp->f = 0.0;
+ }
+ break;
+
+ /* Weirdness. */
+ case OP_MOD:
+ sp--;
+ if (sp[0].f != SYSMIS)
+ {
+ if (sp[1].f == SYSMIS)
+ {
+ if (approx_ne (sp[0].f, 0.0))
+ sp->f = SYSMIS;
+ }
+ else
+ sp->f = fmod (sp[0].f, sp[1].f);
+ }
+ break;
+ case OP_NORMAL:
+ if (sp->f != SYSMIS)
+ sp->f = rand_normal (sp->f);
+ break;
+ case OP_UNIFORM:
+ if (sp->f != SYSMIS)
+ sp->f = rand_uniform (sp->f);
+ break;
+ case OP_SYSMIS:
+ if (sp[0].f == SYSMIS || !finite (sp[0].f))
+ sp->f = 1.0;
+ else
+ sp->f = 0.0;
+ break;
+ case OP_VEC_ELEM_NUM:
+ {
+ int rindx = sp[0].f + EPSILON;
+ struct vector *v = &vec[*op++];
+
+ if (sp[0].f == SYSMIS || rindx < 1 || rindx > v->nv)
+ {
+ if (sp[0].f == SYSMIS)
+ msg (SE, _("SYSMIS is not a valid index value for vector "
+ "%s. The result will be set to SYSMIS."),
+ v->name);
+ else
+ msg (SE, _("%g is not a valid index value for vector %s. "
+ "The result will be set to SYSMIS."),
+ sp[0].f, v->name);
+ sp->f = SYSMIS;
+ break;
+ }
+ sp->f = c->data[v->v[rindx - 1]->fv].f;
+ }
+ break;
+ case OP_VEC_ELEM_STR:
+ {
+ int rindx = sp[0].f + EPSILON;
+ struct vector *vect = &vec[*op++];
+ struct variable *v;
+
+ if (sp[0].f == SYSMIS || rindx < 1 || rindx > vect->nv)
+ {
+ if (sp[0].f == SYSMIS)
+ msg (SE, _("SYSMIS is not a valid index value for vector "
+ "%s. The result will be set to the empty "
+ "string."),
+ vect->name);
+ else
+ msg (SE, _("%g is not a valid index value for vector %s. "
+ "The result will be set to the empty string."),
+ sp[0].f, vect->name);
+ CHECK_STRING_SPACE (0);
+ sp->c = ALLOC_STRING_SPACE (0);
+ sp->c[0] = 0;
+ break;
+ }
+
+ v = vect->v[rindx - 1];
+ CHECK_STRING_SPACE (v->width);
+ sp->c = ALLOC_STRING_SPACE (v->width);
+ sp->c[0] = v->width;
+ memcpy (&sp->c[1], c->data[v->fv].s, v->width);
+ }
+ break;
+
+ /* Terminals. */
+ case OP_NUM_CON:
+ sp++;
+ sp->f = *dbl++;
+ break;
+ case OP_STR_CON:
+ sp++;
+ CHECK_STRING_SPACE (*str);
+ sp->c = ALLOC_STRING_SPACE (*str);
+ memcpy (sp->c, str, *str + 1);
+ str += *str + 1;
+ break;
+ case OP_NUM_VAR:
+ sp++;
+ sp->f = c->data[(*vars)->fv].f;
+ if (is_num_user_missing (sp->f, *vars))
+ sp->f = SYSMIS;
+ vars++;
+ break;
+ case OP_STR_VAR:
+ {
+ int width = (*vars)->width;
+
+ sp++;
+ CHECK_STRING_SPACE (width);
+ sp->c = ALLOC_STRING_SPACE (width);
+ sp->c[0] = width;
+ memcpy (&sp->c[1], &c->data[(*vars)->fv], width);
+ vars++;
+ }
+ break;
+ case OP_NUM_LAG:
+ {
+ struct ccase *c = lagged_case (*op++);
+
+ sp++;
+ if (c == NULL)
+ sp->f = SYSMIS;
+ else
+ {
+ sp->f = c->data[(*vars)->fv].f;
+ if (is_num_user_missing (sp->f, *vars))
+ sp->f = SYSMIS;
+ }
+ vars++;
+ break;
+ }
+ case OP_STR_LAG:
+ {
+ struct ccase *c = lagged_case (*op++);
+ int width = (*vars)->width;
+
+ sp++;
+ CHECK_STRING_SPACE (width);
+ sp->c = ALLOC_STRING_SPACE (width);
+ sp->c[0] = width;
+
+ if (c == NULL)
+ memset (sp->c, ' ', width);
+ else
+ memcpy (&sp->c[1], &c->data[(*vars)->fv], width);
+
+ vars++;
+ }
+ break;
+ case OP_NUM_SYS:
+ sp++;
+ sp->f = c->data[*op++].f == SYSMIS;
+ break;
+ case OP_STR_MIS:
+ sp++;
+ sp->f = is_str_user_missing (c->data[(*vars)->fv].s, *vars);
+ vars++;
+ break;
+ case OP_NUM_VAL:
+ sp++;
+ sp->f = c->data[*op++].f;
+ break;
+ case OP_CASENUM:
+ sp++;
+ sp->f = vfm_sink_info.ncases + 1;
+ break;
+
+ case OP_SENTINEL:
+ goto finished;
+
+#if __CHECKER__
+ /* This case prevents Checker from choking. */
+ case 42000:
+ assert (0);
+#endif
+
+ default:
+#if GLOBAL_DEBUGGING
+ printf (_("evaluate_expression(): not implemented: %s\n"),
+ ops[op[-1]].name);
+#else
+ printf (_("evaluate_expression(): not implemented: %d\n"), op[-1]);
+#endif
+ assert (0);
+ }
+
+ main_loop: ;
+ }
+finished:
+ if (e->type != EX_STRING)
+ {
+ double value = sp->f;
+ if (!finite (value))
+ value = SYSMIS;
+ if (v)
+ v->f = value;
+ return value;
+ }
+ else
+ {
+ assert (v);
+
+#if PAGED_STACK
+ memcpy (e->str_stack, sp->c, sp->c[0] + 1);
+ v->c = e->str_stack;
+#else
+ v->c = sp->c;
+#endif
+
+ return 0.0;
+ }
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <math.h>
+#include <ctype.h>
+#include <errno.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "approx.h"
+#include "data-in.h"
+#include "error.h"
+#include "expr.h"
+#include "exprP.h"
+#include "julcal/julcal.h"
+#include "misc.h"
+#include "stats.h"
+#include "str.h"
+#include "var.h"
+
+/*
+ Expression "optimizer"
+
+ Operates on the tree representation of expressions.
+ optimize_expression() performs the optimizations listed below:
+
+ 1. Constant folding
+ Any operation with constant operands is replaced by its value.
+ (Exception: random-number-generator functions.)
+
+ 2. Strength reduction (x is any expression; a is a numeric constant)
+ x/0 => SYSMIS
+ x*0 => 0
+ x**0 => 1
+ x**1, x+0, x-0, x*1 => x
+ x**2 => sqr(x)
+ x/a => x*(1/a) (where 1/a is evaluated at optimization time)
+
+ I thought about adding additional optimizations but decided that what
+ is here could already be considered overkill.
+ */
+
+static struct nonterm_node *evaluate_tree (struct nonterm_node * n);
+static struct nonterm_node *optimize_tree (struct nonterm_node * n);
+
+struct nonterm_node *
+optimize_expression (struct nonterm_node * n)
+{
+ int i;
+
+ /* Set to 1 if a child is nonconstant. */
+ int nonconst = 0;
+
+ /* Number of system-missing children. */
+ int sysmis = 0;
+
+ /* We can't optimize a terminal node. */
+ if (n->type > OP_TERMINAL)
+ return n;
+
+ /* Start by optimizing all the children. */
+ for (i = 0; i < n->n; i++)
+ {
+ n->arg[i] = ((union any_node *)
+ optimize_expression ((struct nonterm_node *) n->arg[i]));
+ if (n->arg[i]->type == OP_NUM_CON)
+ {
+ if (n->arg[i]->num_con.value == SYSMIS)
+ sysmis++;
+ }
+ else if (n->arg[i]->type != OP_STR_CON)
+ nonconst = 1;
+ }
+
+ if (sysmis && !(ops[n->type].flags & OP_ABSORB_MISS))
+ /* Just about any operation produces SYSMIS when given any SYSMIS
+ arguments. */
+ {
+ struct num_con_node *num = xmalloc (sizeof *num);
+ free_node ((union any_node *) n);
+ num->type = OP_NUM_CON;
+ num->value = SYSMIS;
+ n = (struct nonterm_node *) num;
+ }
+ else if (!nonconst)
+ /* If all the children of this node are constants, then there are
+ obvious optimizations. */
+ n = evaluate_tree (n);
+ else
+ /* Otherwise, we may be able to make certain optimizations
+ anyway. */
+ n = optimize_tree (n);
+ return n;
+}
+
+static struct nonterm_node *repl_num_con (struct nonterm_node *, double);
+static struct nonterm_node *force_repl_num_con (struct nonterm_node *, double);
+static struct nonterm_node *repl_str_con (struct nonterm_node *, char *, int);
+
+#define n0 n->arg[0]->num_con.value
+#define n1 n->arg[1]->num_con.value
+#define n2 n->arg[2]->num_con.value
+
+#define s0 n->arg[0]->str_con.s
+#define s0l n->arg[0]->str_con.len
+#define s1 n->arg[1]->str_con.s
+#define s1l n->arg[1]->str_con.len
+#define s2 n->arg[2]->str_con.s
+#define s2l n->arg[2]->str_con.len
+#define s(X) n->arg[X]->str_con.s
+#define sl(X) n->arg[X]->str_con.len
+
+static struct nonterm_node *
+optimize_tree (struct nonterm_node * n)
+{
+ int i;
+
+ errno = 0;
+ if (n->type == OP_PLUS || n->type == OP_MUL)
+ {
+ /* Default constant value. */
+ double def = n->type == OP_MUL ? 1.0 : 0.0;
+
+ /* Total value of all the constants. */
+ double cval = def;
+
+ /* Number of nonconst arguments. */
+ int nvar = 0;
+
+ /* New node. */
+ struct nonterm_node *m;
+
+ /* Argument copying counter. */
+ int c;
+
+ /* 1=SYSMIS encountered */
+ int sysmis = 0;
+
+ for (i = 0; i < n->n; i++)
+ if (n->arg[i]->type == OP_NUM_CON)
+ {
+ if (n->arg[i]->num_con.value != SYSMIS)
+ {
+ if (n->type == OP_MUL)
+ cval *= n->arg[i]->num_con.value;
+ else
+ cval += n->arg[i]->num_con.value;
+ }
+ else
+ sysmis++;
+ }
+ else
+ nvar++;
+
+ /* 0*SYSMIS=0, 0/SYSMIS=0; otherwise, SYSMIS and infinities
+ produce SYSMIS. */
+ if (approx_eq (cval, 0.0) && n->type == OP_MUL)
+ nvar = 0;
+ else if (sysmis || !finite (cval))
+ {
+ nvar = 0;
+ cval = SYSMIS;
+ }
+
+ /* If no nonconstant terms, replace with a constant node. */
+ if (nvar == 0)
+ return force_repl_num_con (n, cval);
+
+ if (nvar == 1 && cval == def)
+ {
+ /* If there is exactly one nonconstant term and no constant
+ terms, replace with the nonconstant term. */
+ for (i = 0; i < n->n; i++)
+ if (n->arg[i]->type != OP_NUM_CON)
+ m = (struct nonterm_node *) n->arg[i];
+ else
+ free_node (n->arg[i]);
+ }
+ else
+ {
+ /* Otherwise consolidate all the nonconstant terms. */
+ m = xmalloc (sizeof (struct nonterm_node)
+ + ((nvar + approx_ne (cval, def) - 1)
+ * sizeof (union any_node *)));
+ for (i = c = 0; i < n->n; i++)
+ if (n->arg[i]->type != OP_NUM_CON)
+ m->arg[c++] = n->arg[i];
+ else
+ free_node (n->arg[i]);
+
+ if (approx_ne (cval, def))
+ {
+ m->arg[c] = xmalloc (sizeof (struct num_con_node));
+ m->arg[c]->num_con.type = OP_NUM_CON;
+ m->arg[c]->num_con.value = cval;
+ c++;
+ }
+
+ m->type = n->type;
+ m->n = c;
+ }
+ free (n);
+ n = m;
+ }
+ else if (n->type == OP_POW)
+ {
+ if (n->arg[1]->type == OP_NUM_CON)
+ {
+ if (approx_eq (n1, 1.0))
+ {
+ struct nonterm_node *m = (struct nonterm_node *) n->arg[0];
+
+ free_node (n->arg[1]);
+ free (n);
+ return m;
+ }
+ else if (approx_eq (n1, 2.0))
+ {
+ n = xrealloc (n, sizeof (struct nonterm_node));
+ n->type = OP_SQUARE;
+ n->n = 1;
+ }
+ }
+ }
+ return n;
+}
+
+#define rnc(D) \
+ (n = repl_num_con (n, D))
+
+#define frnc(D) \
+ (n = force_repl_num_con (n, D))
+
+/* Finds the first NEEDLE of length NEEDLE_LEN in a HAYSTACK of length
+ HAYSTACK_LEN. Returns a 1-based index, 0 on failure. */
+static inline int
+str_search (char *haystack, int haystack_len, char *needle, int needle_len)
+{
+ char *p = memmem (haystack, haystack_len, needle, needle_len);
+ return p ? p - haystack + 1 : 0;
+}
+
+/* Finds the last NEEDLE of length NEEDLE_LEN in a HAYSTACK of length
+ HAYSTACK_LEN. Returns a 1-based index, 0 on failure. */
+static inline int
+str_rsearch (char *haystack, int haystack_len, char *needle, int needle_len)
+{
+ char *p = mm_find_reverse (haystack, haystack_len, needle, needle_len);
+ return p ? p - haystack + 1 : 0;
+}
+
+static struct nonterm_node *
+evaluate_tree (struct nonterm_node * n)
+{
+ static char *strbuf;
+ int add;
+ int len;
+ int i;
+
+ if (!strbuf)
+ strbuf = xmalloc (256);
+ errno = 0;
+
+ switch (n->type)
+ {
+ case OP_PLUS:
+ case OP_MUL:
+ return optimize_tree (n);
+
+ case OP_POW:
+ if (approx_eq (n0, 0.0) && approx_eq (n1, 0.0))
+ frnc (SYSMIS);
+ else if (n0 == SYSMIS && n1 == 0.0)
+ frnc (1.0);
+ else if (n0 == 0.0 && n1 == SYSMIS)
+ frnc (0.0);
+ else
+ rnc (pow (n0, n1));
+ break;
+
+ case OP_AND:
+ if (n0 == 0.0 || n1 == 0.0)
+ frnc (0.0);
+ else if (n0 == SYSMIS || n1 == SYSMIS)
+ frnc (SYSMIS);
+ else
+ frnc (1.0);
+ break;
+ case OP_OR:
+ if (n0 == 1.0 || n1 == 1.0)
+ frnc (1.0);
+ else if (n0 == SYSMIS || n1 == SYSMIS)
+ frnc (SYSMIS);
+ else
+ frnc (0.0);
+ break;
+ case OP_NOT:
+ rnc (n0 == 0.0 ? 1.0 : 0.0);
+ break;
+
+ case OP_EQ:
+ rnc (approx_eq (n0, n1));
+ break;
+ case OP_GE:
+ rnc (approx_ge (n0, n1));
+ break;
+ case OP_GT:
+ rnc (approx_gt (n0, n1));
+ break;
+ case OP_LE:
+ rnc (approx_le (n0, n1));
+ break;
+ case OP_LT:
+ rnc (approx_lt (n0, n1));
+ break;
+ case OP_NE:
+ rnc (approx_ne (n0, n1));
+ break;
+
+ /* String operators. */
+ case OP_STRING_EQ:
+ rnc (st_compare_pad (s0, s0l, s1, s1l) == 0);
+ break;
+ case OP_STRING_GE:
+ rnc (st_compare_pad (s0, s0l, s1, s1l) >= 0);
+ break;
+ case OP_STRING_GT:
+ rnc (st_compare_pad (s0, s0l, s1, s1l) > 0);
+ break;
+ case OP_STRING_LE:
+ rnc (st_compare_pad (s0, s0l, s1, s1l) <= 0);
+ break;
+ case OP_STRING_LT:
+ rnc (st_compare_pad (s0, s0l, s1, s1l) < 0);
+ break;
+ case OP_STRING_NE:
+ rnc (st_compare_pad (s0, s0l, s1, s1l) != 0);
+ break;
+
+ /* Unary functions. */
+ case OP_NEG:
+ rnc (-n0);
+ break;
+ case OP_ABS:
+ rnc (fabs (n0));
+ break;
+ case OP_ARCOS:
+ rnc (acos (n0));
+ break;
+ case OP_ARSIN:
+ rnc (asin (n0));
+ break;
+ case OP_ARTAN:
+ rnc (atan (n0));
+ break;
+ case OP_COS:
+ rnc (cos (n0));
+ break;
+ case OP_EXP:
+ rnc (exp (n0));
+ break;
+ case OP_LG10:
+ rnc (log10 (n0));
+ break;
+ case OP_LN:
+ rnc (log (n0));
+ break;
+ case OP_MOD10:
+ rnc (fmod (n0, 10));
+ break;
+ case OP_RND:
+ rnc (n0 >= 0.0 ? floor (n0 + 0.5) : -floor (-n0 + 0.5));
+ break;
+ case OP_SIN:
+ rnc (sin (n0));
+ break;
+ case OP_SQRT:
+ rnc (sqrt (n0));
+ break;
+ case OP_TAN:
+ rnc (tan (n0));
+ break;
+ case OP_TRUNC:
+ rnc (n0 >= 0.0 ? floor (n0) : -floor (-n0));
+ break;
+
+ /* N-ary numeric functions. */
+ case OP_ANY:
+ if (n0 == SYSMIS)
+ frnc (SYSMIS);
+ else
+ {
+ int sysmis = 1;
+ double ni;
+
+ for (i = 1; i < n->n; i++)
+ {
+ ni = n->arg[i]->num_con.value;
+ if (approx_eq (n0, ni))
+ {
+ frnc (1.0);
+ goto any_done;
+ }
+ if (ni != SYSMIS)
+ sysmis = 0;
+ }
+ frnc (sysmis ? SYSMIS : 0.0);
+ }
+ any_done:
+ break;
+ case OP_ANY_STRING:
+ for (i = 1; i < n->n; i++)
+ if (!st_compare_pad (n->arg[0]->str_con.s, n->arg[0]->str_con.len,
+ n->arg[i]->str_con.s, n->arg[i]->str_con.len))
+ {
+ frnc (1.0);
+ goto any_string_done;
+ }
+ frnc (0.0);
+ any_string_done:
+ break;
+
+ case OP_CFVAR:
+ case OP_MAX:
+ case OP_MEAN:
+ case OP_MIN:
+ case OP_NMISS:
+ case OP_NVALID:
+ case OP_SD:
+ case OP_SUM:
+ case OP_VARIANCE:
+ {
+ double d[2] =
+ {0.0, 0.0}; /* sum, sum of squares */
+ double min = DBL_MAX; /* minimum value */
+ double max = -DBL_MAX; /* maximum value */
+ double ni; /* value of i'th argument */
+ int nv = 0; /* number of valid arguments */
+
+ for (i = 0; i < n->n; i++)
+ {
+ ni = n->arg[i]->num_con.value;
+ if (ni != SYSMIS)
+ {
+ nv++;
+ d[0] += ni;
+ d[1] += ni * ni;
+ if (ni < min)
+ min = ni;
+ if (ni > max)
+ max = ni;
+ }
+ }
+ if (n->type == OP_NMISS)
+ frnc (i - nv);
+ else if (n->type == OP_NVALID)
+ frnc (nv);
+ else if (nv >= (int) n->arg[i])
+ {
+ switch (n->type)
+ {
+ case OP_CFVAR:
+ frnc (calc_cfvar (d, nv));
+ break;
+ case OP_MAX:
+ frnc (max);
+ break;
+ case OP_MEAN:
+ frnc (calc_mean (d, nv));
+ break;
+ case OP_MIN:
+ frnc (min);
+ break;
+ case OP_SD:
+ frnc (calc_stddev (calc_variance (d, nv)));
+ break;
+ case OP_SUM:
+ frnc (d[0]);
+ break;
+ case OP_VARIANCE:
+ frnc (calc_variance (d, nv));
+ break;
+ }
+ }
+ else
+ frnc (SYSMIS);
+ }
+ break;
+ case OP_RANGE:
+ if (n0 == SYSMIS)
+ frnc (SYSMIS);
+ else
+ {
+ double min, max;
+ int sysmis = 1;
+
+ for (i = 1; i < n->n; i += 2)
+ {
+ min = n->arg[i]->num_con.value;
+ max = n->arg[i + 1]->num_con.value;
+ if (min == SYSMIS || max == SYSMIS)
+ continue;
+ sysmis = 0;
+ if (approx_ge (n0, min) && approx_le (n0, max))
+ {
+ frnc (1.0);
+ goto range_done;
+ }
+ }
+ frnc (sysmis ? SYSMIS : 0.0);
+ }
+ range_done:
+ break;
+ case OP_RANGE_STRING:
+ for (i = 1; i < n->n; i += 2)
+ if (st_compare_pad (n->arg[0]->str_con.s, n->arg[0]->str_con.len,
+ n->arg[i]->str_con.s, n->arg[i]->str_con.len) >= 0
+ && st_compare_pad (n->arg[0]->str_con.s, n->arg[0]->str_con.len,
+ n->arg[i + 1]->str_con.s,
+ n->arg[i + 1]->str_con.len) <= 0)
+ {
+ frnc (1.0);
+ goto range_str_done;
+ }
+ frnc (0.0);
+ range_str_done:
+ break;
+
+ /* Time function. */
+ case OP_TIME_HMS:
+ rnc (60. * (60. * n0 + n1) + n2);
+ break;
+
+ /* Date construction functions. */
+ case OP_DATE_DMY:
+ rnc (60. * 60. * 24. * yrmoda (n2, n1, n0));
+ break;
+ case OP_DATE_MDY:
+ rnc (60. * 60. * 24. * yrmoda (n2, n0, n1));
+ break;
+ case OP_DATE_MOYR:
+ rnc (60. * 60. * 24. * yrmoda (n1, n0, 1));
+ break;
+ case OP_DATE_QYR:
+ rnc (60. * 60. * 24. * yrmoda (n1, 3 * (int) n0 - 2, 1));
+ break;
+ case OP_DATE_WKYR:
+ {
+ double t = yrmoda (n1, 1, 1);
+ if (t != SYSMIS)
+ t = 60. * 60. * 24. * (t + 7. * (n0 - 1));
+ rnc (t);
+ }
+ break;
+ case OP_DATE_YRDAY:
+ {
+ double t = yrmoda (n0, 1, 1);
+ if (t != SYSMIS)
+ t = 60. * 60. * 24. * (t + n0 - 1);
+ rnc (t);
+ }
+ break;
+ case OP_YRMODA:
+ rnc (yrmoda (n0, n1, n2));
+ break;
+ /* Date extraction functions. */
+ case OP_XDATE_DATE:
+ rnc (floor (n0 / 60. / 60. / 24.) * 60. * 60. * 24.);
+ break;
+ case OP_XDATE_HOUR:
+ rnc (fmod (floor (n0 / 60. / 60.), 24.));
+ break;
+ case OP_XDATE_JDAY:
+ rnc (julian_to_jday (n0 / 86400.));
+ break;
+ case OP_XDATE_MDAY:
+ {
+ int day;
+ julian_to_calendar (n0 / 86400., NULL, NULL, &day);
+ rnc (day);
+ }
+ break;
+ case OP_XDATE_MINUTE:
+ rnc (fmod (floor (n0 / 60.), 60.));
+ break;
+ case OP_XDATE_MONTH:
+ {
+ int month;
+ julian_to_calendar (n0 / 86400., NULL, &month, NULL);
+ rnc (month);
+ }
+ break;
+ case OP_XDATE_QUARTER:
+ {
+ int month;
+ julian_to_calendar (n0 / 86400., NULL, &month, NULL);
+ rnc ((month - 1) / 3 + 1);
+ }
+ break;
+ case OP_XDATE_SECOND:
+ rnc (fmod (n0, 60.));
+ break;
+ case OP_XDATE_TDAY:
+ rnc (floor (n0 / 60. / 60. / 24.));
+ break;
+ case OP_XDATE_TIME:
+ rnc (n0 - floor (n0 / 60. / 60. / 24.) * 60. * 60. * 24.);
+ break;
+ case OP_XDATE_WEEK:
+ rnc ((julian_to_jday (n0) - 1) / 7 + 1);
+ break;
+ case OP_XDATE_WKDAY:
+ rnc (julian_to_wday (n0));
+ break;
+ case OP_XDATE_YEAR:
+ {
+ int year;
+ julian_to_calendar (n0 / 86400., &year, NULL, NULL);
+ rnc (year);
+ }
+ break;
+
+ /* String functions. */
+ case OP_CONCAT:
+ {
+ len = s0l;
+ memcpy (strbuf, s0, len);
+ for (i = 1; i < n->n; i++)
+ {
+ add = sl (i);
+ if (add + len > 255)
+ add = 255 - len;
+ memcpy (&strbuf[len], s (i), add);
+ len += add;
+ }
+ n = repl_str_con (n, strbuf, len);
+ }
+ break;
+ case OP_INDEX:
+ rnc (s1l ? str_search (s0, s0l, s1, s1l) : SYSMIS);
+ break;
+ case OP_INDEX_OPT:
+ if (n2 == SYSMIS || (int) n2 <= 0 || s1l % (int) n2)
+ {
+ msg (SW, _("While optimizing a constant expression, there was "
+ "a bad value for the third argument to INDEX."));
+ frnc (SYSMIS);
+ }
+ else
+ {
+ int pos = 0;
+ int c = s1l / (int) n2;
+ int r;
+
+ for (i = 0; i < c; i++)
+ {
+ r = str_search (s0, s0l, s (i), sl (i));
+ if (r < pos || pos == 0)
+ pos = r;
+ }
+ frnc (pos);
+ }
+ break;
+ case OP_RINDEX:
+ rnc (str_rsearch (s0, s0l, s1, s1l));
+ break;
+ case OP_RINDEX_OPT:
+ if (n2 == SYSMIS || (int) n2 <= 0 || s1l % (int) n2)
+ {
+ msg (SE, _("While optimizing a constant expression, there was "
+ "a bad value for the third argument to RINDEX."));
+ frnc (SYSMIS);
+ }
+ else
+ {
+ int pos = 0;
+ int c = s1l / n2;
+ int r;
+
+ for (i = 0; i < c; i++)
+ {
+ r = str_rsearch (s0, s0l, s (i), sl (i));
+ if (r > pos)
+ pos = r;
+ }
+ frnc (pos);
+ }
+ break;
+ case OP_LENGTH:
+ frnc (s0l);
+ break;
+ case OP_LOWER:
+ {
+ char *cp;
+ for (cp = &s0[s0l]; cp >= s0; cp--)
+ *cp = tolower ((unsigned char) (*cp));
+ n = repl_str_con (n, s0, s0l);
+ }
+ break;
+ case OP_UPPER:
+ {
+ char *cp;
+ for (cp = &s0[s0[0] + 1]; cp > s0; cp--)
+ *cp = toupper ((unsigned char) (*cp));
+ n = repl_str_con (n, s0, s0l);
+ }
+ break;
+ case OP_LPAD:
+ case OP_LPAD_OPT:
+ case OP_RPAD:
+ case OP_RPAD_OPT:
+ {
+ int c;
+
+ if (n1 == SYSMIS)
+ {
+ n = repl_str_con (n, NULL, 0);
+ break;
+ }
+ len = n1;
+ len = range (len, 1, 255);
+ add = max (n1 - s0l, 0);
+
+ if (n->type == OP_LPAD_OPT || n->type == OP_RPAD_OPT)
+ {
+ if (s2l < 1)
+ {
+ c = n->type == OP_LPAD_OPT ? 'L' : 'R';
+ msg (SE, _("Third argument to %cPAD() must be at least one "
+ "character in length."), c);
+ c = ' ';
+ }
+ else
+ c = s2[0];
+ }
+ else
+ c = ' ';
+
+ if (n->type == OP_LPAD || n->type == OP_LPAD_OPT)
+ memmove (&s0[add], s0, len);
+ if (n->type == OP_LPAD || n->type == OP_LPAD_OPT)
+ memset (s0, c, add);
+ else
+ memset (&s0[s0l], c, add);
+
+ n = repl_str_con (n, s0, len);
+ }
+ break;
+ case OP_LTRIM:
+ case OP_LTRIM_OPT:
+ case OP_RTRIM:
+ case OP_RTRIM_OPT:
+ {
+ int c;
+ char *cp = s0;
+
+ if (n->type == OP_LTRIM_OPT || n->type == OP_RTRIM_OPT)
+ {
+ if (s1l < 1)
+ {
+ c = n->type == OP_LTRIM_OPT ? 'L' : 'R';
+ msg (SE, _("Second argument to %cTRIM() must be at least one "
+ "character in length."), c);
+ c = ' ';
+ }
+ else
+ c = s1[0];
+ }
+ len = s0l;
+ if (n->type == OP_LTRIM || n->type == OP_LTRIM_OPT)
+ {
+ while (*cp == c && cp < &s0[len])
+ cp++;
+ len -= cp - s0;
+ }
+ else
+ while (len > 0 && s0[len - 1] == c)
+ len--;
+ n = repl_str_con (n, cp, len);
+ }
+ break;
+ case OP_NUMBER:
+ case OP_NUMBER_OPT:
+ {
+ union value v;
+ struct data_in di;
+
+ di.s = s0;
+ di.e = s0 + s0l;
+ di.v = &v;
+ di.flags = DI_IGNORE_ERROR;
+ di.f1 = 1;
+
+ if (n->type == OP_NUMBER_OPT)
+ {
+ di.format.type = (int) n->arg[1];
+ di.format.w = (int) n->arg[2];
+ di.format.d = (int) n->arg[3];
+ }
+ else
+ {
+ di.format.type = FMT_F;
+ di.format.w = s0l;
+ di.format.d = 0;
+ }
+
+ data_in (&di);
+ frnc (v.f);
+ }
+ break;
+ case OP_STRING:
+ {
+ union value v;
+ struct fmt_spec f;
+ f.type = (int) n->arg[1];
+ f.w = (int) n->arg[2];
+ f.d = (int) n->arg[3];
+ v.f = n0;
+
+ data_out (strbuf, &f, &v);
+ n = repl_str_con (n, strbuf, f.w);
+ }
+ break;
+ case OP_SUBSTR:
+ case OP_SUBSTR_OPT:
+ {
+ int pos = (int) n1;
+ if (pos > s0l || pos <= 0 || n1 == SYSMIS
+ || (n->type == OP_SUBSTR_OPT && n2 == SYSMIS))
+ n = repl_str_con (n, NULL, 0);
+ else
+ {
+ if (n->type == OP_SUBSTR_OPT)
+ {
+ len = (int) n2;
+ if (len + pos - 1 > s0l)
+ len = s0l - pos + 1;
+ }
+ else
+ len = s0l - pos + 1;
+ n = repl_str_con (n, &s0[pos - 1], len);
+ }
+ }
+ break;
+
+ /* Weirdness. */
+ case OP_INV:
+ rnc (1.0 / n0);
+ break;
+ case OP_MOD:
+ if (approx_eq (n0, 0.0) && n1 == SYSMIS)
+ frnc (0.0);
+ else
+ rnc (fmod (n0, n1));
+ break;
+ case OP_NUM_TO_BOOL:
+ if (approx_eq (n0, 0.0))
+ n0 = 0.0;
+ else if (approx_eq (n0, 1.0))
+ n0 = 1.0;
+ else if (n0 != SYSMIS)
+ {
+ msg (SE, _("When optimizing a constant expression, an integer "
+ "that was being used as an Boolean value was found "
+ "to have a constant value other than 0, 1, or SYSMIS."));
+ n0 = 0.0;
+ }
+ rnc (n0);
+ break;
+
+#if __CHECKER__
+ /* This case prevents Checker from choking. */
+ case 42000:
+ assert (0);
+#endif
+ }
+ return n;
+}
+
+#undef n0
+#undef n1
+#undef n2
+
+#undef s0
+#undef s0l
+#undef s1
+#undef s1l
+#undef s2
+#undef s2l
+#undef s
+#undef sl
+
+#undef rnc
+#undef frnc
+
+static struct nonterm_node *
+repl_num_con (struct nonterm_node * n, double d)
+{
+ int i;
+ if (!finite (d) || errno)
+ d = SYSMIS;
+ else
+ for (i = 0; i < n->n; i++)
+ if (n->arg[i]->type == OP_NUM_CON && n->arg[i]->num_con.value == SYSMIS)
+ {
+ d = SYSMIS;
+ break;
+ }
+ return force_repl_num_con (n, d);
+}
+
+static struct nonterm_node *
+force_repl_num_con (struct nonterm_node * n, double d)
+{
+ struct num_con_node *num;
+
+ if (!finite (d) || errno)
+ d = SYSMIS;
+ free_node ((union any_node *) n);
+ num = xmalloc (sizeof *num);
+ num->type = OP_NUM_CON;
+ num->value = d;
+ return (struct nonterm_node *) num;
+}
+
+static struct nonterm_node *
+repl_str_con (struct nonterm_node * n, char *s, int len)
+{
+ struct str_con_node *str;
+
+ /* The ordering here is important since the source string may be
+ part of a subnode of n. */
+ str = xmalloc (sizeof *str + len - 1);
+ str->type = OP_STR_CON;
+ str->len = len;
+ memcpy (str->s, s, len);
+ free_node ((union any_node *) n);
+ return (struct nonterm_node *) str;
+}
+
+/* Returns the number of days since 10 Oct 1582 for the date
+ YEAR/MONTH/DAY, where YEAR is in range 0..199 or 1582..19999, MONTH
+ is in 1..12, and DAY is in 1..31. */
+double
+yrmoda (double year, double month, double day)
+{
+ if (year == SYSMIS || month == SYSMIS || day == SYSMIS)
+ return SYSMIS;
+
+ /* The addition of EPSILON avoids converting, for example,
+ 1991.9999997=>1991. */
+ year = floor (year + EPSILON);
+ month = floor (month + EPSILON);
+ day = floor (day + EPSILON);
+
+ if (year >= 0. && year <= 199.)
+ year += 1900.;
+ if ((year < 1582. || year > 19999.)
+ || (year == 1582. && (month < 10. || (month == 10. && day < 15.)))
+ || (month < -1 || month > 13)
+ || (day < -1 || day > 32))
+ return SYSMIS;
+ return calendar_to_julian (year, month, day);
+}
+\f
+/* Expression dumper. */
+
+static struct expression *e;
+static int nop, mop;
+static int ndbl, mdbl;
+static int nstr, mstr;
+static int nvars, mvars;
+
+static void dump_node (union any_node * n);
+static void emit (int);
+static void emit_num_con (double);
+static void emit_str_con (char *, int);
+static void emit_var (struct variable *);
+
+void
+dump_expression (union any_node * n, struct expression * expr)
+{
+ unsigned char *o;
+
+ int height = 0;
+
+ int max_height = 0;
+
+ e = expr;
+ e->op = NULL;
+ e->num = NULL;
+ e->str = NULL;
+ e->var = NULL;
+ nop = mop = 0;
+ ndbl = mdbl = 0;
+ nstr = mstr = 0;
+ nvars = mvars = 0;
+ dump_node (n);
+ emit (OP_SENTINEL);
+
+ /* Now compute the stack height needed to evaluate the expression. */
+ for (o = e->op; *o != OP_SENTINEL; o++)
+ {
+ if (ops[*o].flags & OP_VAR_ARGS)
+ height += 1 - o[1];
+ else
+ height += ops[*o].height;
+ o += ops[*o].skip;
+ if (height > max_height)
+ max_height = height;
+ }
+
+ /* ANSI says we have to waste space for one `value' since pointers
+ are not guaranteed to be able to point to a spot *before* a
+ block. If only all the world were a VAX... */
+ max_height++;
+
+ e->stack = xmalloc (max_height * sizeof *e->stack);
+
+#if PAGED_STACK
+ e->str_stack = e->type == EX_STRING ? xmalloc (256) : NULL;
+#else
+ e->str_stack = xmalloc (256);
+ e->str_size = 256;
+#endif
+}
+
+static void
+dump_node (union any_node * n)
+{
+ if (n->type == OP_AND || n->type == OP_OR)
+ {
+ int i;
+
+ dump_node (n->nonterm.arg[0]);
+ for (i = 1; i < n->nonterm.n; i++)
+ {
+ dump_node (n->nonterm.arg[i]);
+ emit (n->type);
+ }
+ return;
+ }
+ else if (n->type < OP_TERMINAL)
+ {
+ int i;
+ for (i = 0; i < n->nonterm.n; i++)
+ dump_node (n->nonterm.arg[i]);
+ emit (n->type);
+ if (ops[n->type].flags & OP_VAR_ARGS)
+ emit (n->nonterm.n);
+ if (ops[n->type].flags & OP_MIN_ARGS)
+ emit ((int) n->nonterm.arg[n->nonterm.n]);
+ if (ops[n->type].flags & OP_FMT_SPEC)
+ {
+ emit ((int) n->nonterm.arg[n->nonterm.n]);
+ emit ((int) n->nonterm.arg[n->nonterm.n + 1]);
+ emit ((int) n->nonterm.arg[n->nonterm.n + 2]);
+ }
+ return;
+ }
+
+ emit (n->type);
+ if (n->type == OP_NUM_CON)
+ emit_num_con (n->num_con.value);
+ else if (n->type == OP_STR_CON)
+ emit_str_con (n->str_con.s, n->str_con.len);
+ else if (n->type == OP_NUM_VAR || n->type == OP_STR_VAR
+ || n->type == OP_STR_MIS)
+ emit_var (n->var.v);
+ else if (n->type == OP_NUM_LAG || n->type == OP_STR_LAG)
+ {
+ emit_var (n->lag.v);
+ emit (n->lag.lag);
+ }
+ else if (n->type == OP_NUM_SYS || n->type == OP_NUM_VAL)
+ emit (n->var.v->fv);
+ else
+ assert (n->type == OP_CASENUM);
+}
+
+static void
+emit (int op)
+{
+ if (nop >= mop)
+ {
+ mop += 16;
+ e->op = xrealloc (e->op, mop * sizeof *e->op);
+ }
+ e->op[nop++] = op;
+}
+
+static void
+emit_num_con (double dbl)
+{
+ if (ndbl >= mdbl)
+ {
+ mdbl += 16;
+ e->num = xrealloc (e->num, mdbl * sizeof *e->num);
+ }
+ e->num[ndbl++] = dbl;
+}
+
+static void
+emit_str_con (char *str, int len)
+{
+ if (nstr + len + 1 > mstr)
+ {
+ mstr += 256;
+ e->str = xrealloc (e->str, mstr);
+ }
+ e->str[nstr++] = len;
+ memcpy (&e->str[nstr], str, len);
+ nstr += len;
+}
+
+static void
+emit_var (struct variable * v)
+{
+ if (nvars >= mvars)
+ {
+ mvars += 16;
+ e->var = xrealloc (e->var, mvars * sizeof *e->var);
+ }
+ e->var[nvars++] = v;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <ctype.h>
+#include <float.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "error.h"
+#include "expr.h"
+#include "exprP.h"
+#include "lexer.h"
+#include "misc.h"
+#include "str.h"
+#include "var.h"
+#include "vector.h"
+#include "vfm.h"
+\f
+/* Declarations. */
+
+/* Lowest precedence. */
+static int parse_or (union any_node **n);
+static int parse_and (union any_node **n);
+static int parse_not (union any_node **n);
+static int parse_rel (union any_node **n);
+static int parse_add (union any_node **n);
+static int parse_mul (union any_node **n);
+static int parse_neg (union any_node **n);
+static int parse_exp (union any_node **n);
+static int parse_primary (union any_node **n);
+static int parse_function (union any_node **n);
+/* Highest precedence. */
+
+/* Utility functions. */
+static const char *expr_type_name (int type);
+static const char *type_name (int type);
+static void make_bool (union any_node **n);
+static union any_node *allocate_nonterminal (int op, union any_node *n);
+static union any_node *append_nonterminal_arg (union any_node *,
+ union any_node *);
+static int type_check (union any_node **n, int type, int flags);
+
+static void init_func_tab (void);
+static int cmp_func (const void *a, const void *b);
+
+#if DEBUGGING
+static void debug_print_tree (union any_node *, int);
+#endif
+
+#if GLOBAL_DEBUGGING
+static void debug_print_postfix (struct expression *);
+#endif
+\f
+/* Public functions. */
+
+void
+expr_free (struct expression *e)
+{
+ if (e == NULL)
+ return;
+
+ free (e->op);
+ free (e->var);
+ free (e->num);
+ free (e->str);
+ free (e->stack);
+ free (e->str_stack);
+ free (e);
+}
+
+struct expression *
+expr_parse (int flags)
+{
+ struct expression *e;
+ union any_node *n;
+ int type;
+
+ /* Make sure the table of functions is initialized. */
+ init_func_tab ();
+
+ /* Parse the expression. */
+ type = parse_or (&n);
+ if (type == EX_ERROR)
+ return NULL;
+
+ /* Enforce type rules. */
+ if (!type_check (&n, type, flags))
+ {
+ free_node (n);
+ return NULL;
+ }
+
+ /* Optimize the expression as best we can. */
+ n = (union any_node *) optimize_expression ((struct nonterm_node *) n);
+
+ /* Dump the tree-based expression to a postfix representation for
+ best evaluation speed, and destroy the tree. */
+ e = xmalloc (sizeof *e);
+ e->type = type;
+ dump_expression (n, e);
+ free_node (n);
+
+ /* If we're debugging or the user requested it, print the postfix
+ representation. */
+#if GLOBAL_DEBUGGING
+#if !DEBUGGING
+ if (flags & PXP_DUMP)
+#endif
+ debug_print_postfix (e);
+#endif
+
+ return e;
+}
+
+static int
+type_check (union any_node **n, int type, int flags)
+{
+ /* Enforce PXP_BOOLEAN flag. */
+ if (flags & PXP_BOOLEAN)
+ {
+ if (type == EX_STRING)
+ {
+ msg (SE, _("A string expression was supplied in a place "
+ "where a Boolean expression was expected."));
+ return 0;
+ }
+ else if (type == EX_NUMERIC)
+ *n = allocate_nonterminal (OP_NUM_TO_BOOL, *n);
+ }
+
+ /* Enforce PXP_NUMERIC flag. */
+ if ((flags & PXP_NUMERIC) && (type != EX_NUMERIC))
+ {
+ msg (SE, _("A numeric expression was expected in a place "
+ "where one was not supplied."));
+ return 0;
+ }
+
+ /* Enforce PXP_STRING flag. */
+ if ((flags & PXP_STRING) && (type != EX_STRING))
+ {
+ msg (SE, _("A string expression was expected in a place "
+ "where one was not supplied."));
+ return 0;
+ }
+
+ return 1;
+}
+\f
+/* Recursive-descent expression parser. */
+
+/* Parses the OR level. */
+static int
+parse_or (union any_node **n)
+{
+ char typ[] = N_("The OR operator cannot take string operands.");
+ union any_node *c;
+ int type;
+
+ type = parse_and (n);
+ if (type == EX_ERROR || token != T_OR)
+ return type;
+ if (type == EX_STRING)
+ {
+ free_node (*n);
+ msg (SE, gettext (typ));
+ return 0;
+ }
+ else if (type == EX_NUMERIC)
+ make_bool (n);
+
+ c = allocate_nonterminal (OP_OR, *n);
+ for (;;)
+ {
+ lex_get ();
+ type = parse_and (n);
+ if (type == EX_ERROR)
+ goto fail;
+ else if (type == EX_STRING)
+ {
+ msg (SE, gettext (typ));
+ goto fail;
+ }
+ else if (type == EX_NUMERIC)
+ make_bool (n);
+ c = append_nonterminal_arg (c, *n);
+
+ if (token != T_OR)
+ break;
+ }
+ *n = c;
+ return EX_BOOLEAN;
+
+fail:
+ free_node (c);
+ return EX_ERROR;
+}
+
+/* Parses the AND level. */
+static int
+parse_and (union any_node ** n)
+{
+ static const char typ[]
+ = N_("The AND operator cannot take string operands.");
+ union any_node *c;
+ int type = parse_not (n);
+
+ if (type == EX_ERROR)
+ return EX_ERROR;
+ if (token != T_AND)
+ return type;
+ if (type == EX_STRING)
+ {
+ free_node (*n);
+ msg (SE, gettext (typ));
+ return 0;
+ }
+ else if (type == EX_NUMERIC)
+ make_bool (n);
+
+ c = allocate_nonterminal (OP_AND, *n);
+ for (;;)
+ {
+ lex_get ();
+ type = parse_not (n);
+ if (type == EX_ERROR)
+ goto fail;
+ else if (type == EX_STRING)
+ {
+ msg (SE, gettext (typ));
+ goto fail;
+ }
+ else if (type == EX_NUMERIC)
+ make_bool (n);
+ c = append_nonterminal_arg (c, *n);
+
+ if (token != T_AND)
+ break;
+ }
+ *n = c;
+ return EX_BOOLEAN;
+
+fail:
+ free_node (c);
+ return EX_ERROR;
+}
+
+/* Parses the NOT level. */
+static int
+parse_not (union any_node ** n)
+{
+ static const char typ[]
+ = N_("The NOT operator cannot take a string operand.");
+ int not = 0;
+ int type;
+
+ while (lex_match (T_NOT))
+ not ^= 1;
+ type = parse_rel (n);
+ if (!not || type == EX_ERROR)
+ return type;
+
+ if (type == EX_STRING)
+ {
+ free_node (*n);
+ msg (SE, gettext (typ));
+ return 0;
+ }
+ else if (type == EX_NUMERIC)
+ make_bool (n);
+
+ *n = allocate_nonterminal (OP_NOT, *n);
+ return EX_BOOLEAN;
+}
+
+static int
+parse_rel (union any_node ** n)
+{
+ static const char typ[]
+ = N_("Strings cannot be compared with numeric or Boolean "
+ "values with the relational operators "
+ "= >= > <= < <>.");
+ union any_node *c;
+ int type = parse_add (n);
+
+ if (type == EX_ERROR)
+ return EX_ERROR;
+ if (token == '=')
+ token = T_EQ;
+ if (token < T_EQ || token > T_NE)
+ return type;
+
+ for (;;)
+ {
+ int t;
+
+ c = allocate_nonterminal (token - T_EQ
+ + (type == EX_NUMERIC ? OP_EQ : OP_STRING_EQ),
+ *n);
+ lex_get ();
+
+ t = parse_add (n);
+ if (t == EX_ERROR)
+ goto fail;
+ if (t == EX_BOOLEAN && type == EX_NUMERIC)
+ make_bool (&c->nonterm.arg[0]);
+ else if (t == EX_NUMERIC && type == EX_BOOLEAN)
+ make_bool (n);
+ else if (t != type)
+ {
+ msg (SE, gettext (typ));
+ goto fail;
+ }
+
+ c = append_nonterminal_arg (c, *n);
+ *n = c;
+
+ if (token == '=')
+ token = T_EQ;
+ if (token < T_EQ || token > T_NE)
+ break;
+
+ type = EX_BOOLEAN;
+ }
+ return EX_BOOLEAN;
+
+fail:
+ free_node (c);
+ return EX_ERROR;
+}
+
+/* Parses the addition and subtraction level. */
+static int
+parse_add (union any_node **n)
+{
+ static const char typ[]
+ = N_("The `+' and `-' operators may only be used with "
+ "numeric operands.");
+ union any_node *c;
+ int type;
+ int op;
+
+ type = parse_mul (n);
+ lex_negative_to_dash ();
+ if (type == EX_ERROR || (token != '+' && token != '-'))
+ return type;
+ if (type != EX_NUMERIC)
+ {
+ free_node (*n);
+ msg (SE, gettext (typ));
+ return 0;
+ }
+
+ c = allocate_nonterminal (OP_PLUS, *n);
+ for (;;)
+ {
+ op = token;
+ lex_get ();
+
+ type = parse_mul (n);
+ if (type == EX_ERROR)
+ goto fail;
+ else if (type != EX_NUMERIC)
+ {
+ msg (SE, gettext (typ));
+ goto fail;
+ }
+ if (op == '-')
+ *n = allocate_nonterminal (OP_NEG, *n);
+ c = append_nonterminal_arg (c, *n);
+
+ lex_negative_to_dash ();
+ if (token != '+' && token != '-')
+ break;
+ }
+ *n = c;
+ return EX_NUMERIC;
+
+fail:
+ free_node (c);
+ return EX_ERROR;
+}
+
+/* Parses the multiplication and division level. */
+static int
+parse_mul (union any_node ** n)
+{
+ static const char typ[]
+ = N_("The `*' and `/' operators may only be used with "
+ "numeric operands.");
+
+ union any_node *c;
+ int type;
+ int op;
+
+ type = parse_neg (n);
+ if (type == EX_ERROR || (token != '*' && token != '/'))
+ return type;
+ if (type != EX_NUMERIC)
+ {
+ free_node (*n);
+ msg (SE, gettext (typ));
+ return 0;
+ }
+
+ c = allocate_nonterminal (OP_MUL, *n);
+ for (;;)
+ {
+ op = token;
+ lex_get ();
+
+ type = parse_neg (n);
+ if (type == EX_ERROR)
+ goto fail;
+ else if (type != EX_NUMERIC)
+ {
+ msg (SE, gettext (typ));
+ goto fail;
+ }
+ if (op == '/')
+ *n = allocate_nonterminal (OP_INV, *n);
+ c = append_nonterminal_arg (c, *n);
+
+ if (token != '*' && token != '/')
+ break;
+ }
+ *n = c;
+ return EX_NUMERIC;
+
+fail:
+ free_node (c);
+ return EX_ERROR;
+}
+
+/* Parses the unary minus level. */
+static int
+parse_neg (union any_node **n)
+{
+ static const char typ[]
+ = N_("The unary minus (-) operator can only take a numeric operand.");
+
+ int neg = 0;
+ int type;
+
+ for (;;)
+ {
+ lex_negative_to_dash ();
+ if (!lex_match ('-'))
+ break;
+ neg ^= 1;
+ }
+ type = parse_exp (n);
+ if (!neg || type == EX_ERROR)
+ return type;
+ if (type != EX_NUMERIC)
+ {
+ free_node (*n);
+ msg (SE, gettext (typ));
+ return 0;
+ }
+
+ *n = allocate_nonterminal (OP_NEG, *n);
+ return EX_NUMERIC;
+}
+
+static int
+parse_exp (union any_node **n)
+{
+ static const char typ[]
+ = N_("Both operands to the ** operator must be numeric.");
+
+ union any_node *c;
+ int type;
+
+ type = parse_primary (n);
+ if (type == EX_ERROR || token != T_EXP)
+ return type;
+ if (type != EX_NUMERIC)
+ {
+ free_node (*n);
+ msg (SE, gettext (typ));
+ return 0;
+ }
+
+ for (;;)
+ {
+ c = allocate_nonterminal (OP_POW, *n);
+ lex_get ();
+
+ type = parse_primary (n);
+ if (type == EX_ERROR)
+ goto fail;
+ else if (type != EX_NUMERIC)
+ {
+ msg (SE, gettext (typ));
+ goto fail;
+ }
+ *n = append_nonterminal_arg (c, *n);
+
+ if (token != T_EXP)
+ break;
+ }
+ return EX_NUMERIC;
+
+fail:
+ free_node (c);
+ return EX_ERROR;
+}
+
+/* Parses system variables. */
+static int
+parse_sysvar (union any_node **n)
+{
+ if (!strcmp (tokid, "$CASENUM"))
+ {
+ *n = xmalloc (sizeof (struct casenum_node));
+ (*n)->casenum.type = OP_CASENUM;
+ return EX_NUMERIC;
+ }
+ else
+ {
+ double d;
+
+ if (!strcmp (tokid, "$SYSMIS"))
+ d = SYSMIS;
+ else if (!strcmp (tokid, "$JDATE"))
+ {
+ struct tm *time = localtime (&last_vfm_invocation);
+ d = yrmoda (time->tm_year + 1900, time->tm_mon + 1, time->tm_mday);
+ }
+ else if (!strcmp (tokid, "$DATE"))
+ {
+ static const char *months[12] =
+ {
+ "JAN", "FEB", "MAR", "APR", "MAY", "JUN",
+ "JUL", "AUG", "SEP", "OCT", "NOV", "DEC",
+ };
+
+ struct tm *time;
+ char temp_buf[10];
+
+ time = localtime (&last_vfm_invocation);
+ sprintf (temp_buf, "%02d %s %02d", abs (time->tm_mday) % 100,
+ months[abs (time->tm_mon) % 12], abs (time->tm_year) % 100);
+
+ *n = xmalloc (sizeof (struct str_con_node) + 8);
+ (*n)->str_con.type = OP_STR_CON;
+ (*n)->str_con.len = 9;
+ memcpy ((*n)->str_con.s, temp_buf, 9);
+ return EX_STRING;
+ }
+ else if (!strcmp (tokid, "$TIME"))
+ {
+ struct tm *time;
+ time = localtime (&last_vfm_invocation);
+ d = (yrmoda (time->tm_year + 1900, time->tm_mon + 1,
+ time->tm_mday) * 60. * 60. * 24.
+ + time->tm_hour * 60 * 60.
+ + time->tm_min * 60.
+ + time->tm_sec);
+ }
+ else if (!strcmp (tokid, "$LENGTH"))
+ {
+ msg (SW, _("Use of $LENGTH is obsolete, returning default of 66."));
+ d = 66.0;
+ }
+ else if (!strcmp (tokid, "$WIDTH"))
+ {
+ msg (SW, _("Use of $WIDTH is obsolete, returning default of 131."));
+ d = 131.0;
+ }
+ else
+ {
+ msg (SE, _("Unknown system variable %s."), tokid);
+ return EX_ERROR;
+ }
+
+ *n = xmalloc (sizeof (struct num_con_node));
+ (*n)->num_con.type = OP_NUM_CON;
+ (*n)->num_con.value = d;
+ return EX_NUMERIC;
+ }
+}
+
+/* Parses numbers, varnames, etc. */
+static int
+parse_primary (union any_node **n)
+{
+ switch (token)
+ {
+ case T_ID:
+ {
+ struct variable *v;
+
+ /* An identifier followed by a left parenthesis is a function
+ call. */
+ if (lex_look_ahead () == '(')
+ return parse_function (n);
+
+ /* $ at the beginning indicates a system variable. */
+ if (tokid[0] == '$')
+ {
+ int type = parse_sysvar (n);
+ lex_get ();
+ return type;
+ }
+
+ /* Otherwise, it must be a user variable. */
+ v = find_variable (tokid);
+ lex_get ();
+ if (v == NULL)
+ {
+ lex_error (_("expecting variable name"));
+ return EX_ERROR;
+ }
+
+ *n = xmalloc (sizeof (struct var_node));
+ (*n)->var.type = v->type == NUMERIC ? OP_NUM_VAR : OP_STR_VAR;
+ (*n)->var.v = v;
+ return v->type == NUMERIC ? EX_NUMERIC : EX_STRING;
+ }
+
+ case T_NUM:
+ *n = xmalloc (sizeof (struct num_con_node));
+ (*n)->num_con.type = OP_NUM_CON;
+ (*n)->num_con.value = tokval;
+ lex_get ();
+ return EX_NUMERIC;
+
+ case T_STRING:
+ {
+ *n = xmalloc (sizeof (struct str_con_node) + ds_length (&tokstr) - 1);
+ (*n)->str_con.type = OP_STR_CON;
+ (*n)->str_con.len = ds_length (&tokstr);
+ memcpy ((*n)->str_con.s, ds_value (&tokstr), ds_length (&tokstr));
+ lex_get ();
+ return EX_STRING;
+ }
+
+ case '(':
+ {
+ int t;
+ lex_get ();
+ t = parse_or (n);
+ if (!lex_match (')'))
+ {
+ lex_error (_("expecting `)'"));
+ free_node (*n);
+ return EX_ERROR;
+ }
+ return t;
+ }
+
+ default:
+ lex_error (_("in expression"));
+ return EX_ERROR;
+ }
+}
+\f
+/* Individual function parsing. */
+
+struct function
+ {
+ const char *s;
+ int t;
+ int (*func) (struct function *, int, union any_node **);
+ const char *desc;
+ };
+
+static struct function func_tab[];
+static int func_count;
+
+static int get_num_args (struct function *, int, union any_node **);
+
+static int
+unary_func (struct function * f, int x unused, union any_node ** n)
+{
+ double divisor;
+ struct nonterm_node *c;
+
+ if (!get_num_args (f, 1, n))
+ return EX_ERROR;
+
+ switch (f->t)
+ {
+ case OP_CTIME_DAYS:
+ divisor = 1 / 60. / 60. / 24.;
+ goto multiply;
+ case OP_CTIME_HOURS:
+ divisor = 1 / 60. / 60.;
+ goto multiply;
+ case OP_CTIME_MINUTES:
+ divisor = 1 / 60.;
+ goto multiply;
+ case OP_TIME_DAYS:
+ divisor = 60. * 60. * 24.;
+ goto multiply;
+
+ case OP_CTIME_SECONDS:
+ c = &(*n)->nonterm;
+ *n = (*n)->nonterm.arg[0];
+ free (c);
+ return EX_NUMERIC;
+ }
+ return EX_NUMERIC;
+
+multiply:
+ /* Arrive here when we encounter an operation that is just a
+ glorified version of a multiplication or division. Converts the
+ operation directly into that multiplication. */
+ c = xmalloc (sizeof (struct nonterm_node) + sizeof (union any_node *));
+ c->type = OP_MUL;
+ c->n = 2;
+ c->arg[0] = (*n)->nonterm.arg[0];
+ c->arg[1] = xmalloc (sizeof (struct num_con_node));
+ c->arg[1]->num_con.type = OP_NUM_CON;
+ c->arg[1]->num_con.value = divisor;
+ free (*n);
+ *n = (union any_node *) c;
+ return EX_NUMERIC;
+}
+
+static int
+binary_func (struct function * f, int x unused, union any_node ** n)
+{
+ if (!get_num_args (f, 2, n))
+ return EX_ERROR;
+ return EX_NUMERIC;
+}
+
+static int
+ternary_func (struct function * f, int x unused, union any_node ** n)
+{
+ if (!get_num_args (f, 3, n))
+ return EX_ERROR;
+ return EX_NUMERIC;
+}
+
+static int
+MISSING_func (struct function * f, int x unused, union any_node ** n)
+{
+ if (token == T_ID && is_varname (tokid) && lex_look_ahead () == ')')
+ {
+ struct var_node *c = xmalloc (sizeof *c);
+ c->v = parse_variable ();
+ c->type = c->v->type == ALPHA ? OP_STR_MIS : OP_NUM_SYS;
+ *n = (union any_node *) c;
+ return EX_BOOLEAN;
+ }
+ if (!get_num_args (f, 1, n))
+ return EX_ERROR;
+ return EX_BOOLEAN;
+}
+
+static int
+SYSMIS_func (struct function * f unused, int x unused, union any_node ** n)
+{
+ int t;
+
+ if (token == T_ID && is_varname (tokid) && lex_look_ahead () == ')')
+ {
+ struct variable *v;
+ v = parse_variable ();
+ if (v->type == ALPHA)
+ {
+ struct num_con_node *c = xmalloc (sizeof *c);
+ c->type = OP_NUM_CON;
+ c->value = 0;
+ return EX_BOOLEAN;
+ }
+ else
+ {
+ struct var_node *c = xmalloc (sizeof *c);
+ c->type = OP_NUM_SYS;
+ c->v = v;
+ return EX_BOOLEAN;
+ }
+ }
+
+ t = parse_or (n);
+ if (t == EX_ERROR)
+ return t;
+ else if (t == EX_NUMERIC)
+ {
+ *n = allocate_nonterminal (OP_SYSMIS, *n);
+ return EX_BOOLEAN;
+ }
+ else /* EX_STRING or EX_BOOLEAN */
+ {
+ /* Return constant `true' value. */
+ free_node (*n);
+ *n = xmalloc (sizeof (struct num_con_node));
+ (*n)->num_con.type = OP_NUM_CON;
+ (*n)->num_con.value = 1.0;
+ return EX_BOOLEAN;
+ }
+}
+
+static int
+VALUE_func (struct function *f unused, int x unused, union any_node **n)
+{
+ struct variable *v = parse_variable ();
+
+ if (!v)
+ return EX_ERROR;
+ *n = xmalloc (sizeof (struct var_node));
+ (*n)->var.v = v;
+ if (v->type == NUMERIC)
+ {
+ (*n)->var.type = OP_NUM_VAL;
+ return EX_NUMERIC;
+ }
+ else
+ {
+ (*n)->var.type = OP_STR_VAR;
+ return EX_STRING;
+ }
+}
+
+static int
+LAG_func (struct function *f unused, int x unused, union any_node **n)
+{
+ struct variable *v = parse_variable ();
+ int nlag = 1;
+
+ if (!v)
+ return EX_ERROR;
+ if (lex_match (','))
+ {
+ if (!lex_integer_p () || lex_integer () <= 0 || lex_integer () > 1000)
+ {
+ msg (SE, _("Argument 2 to LAG must be a small positive "
+ "integer constant."));
+ return 0;
+ }
+
+ nlag = lex_integer ();
+ lex_get ();
+ }
+ n_lag = max (nlag, n_lag);
+ *n = xmalloc (sizeof (struct lag_node));
+ (*n)->lag.type = (v->type == NUMERIC ? OP_NUM_LAG : OP_STR_LAG);
+ (*n)->lag.v = v;
+ (*n)->lag.lag = nlag;
+ return (v->type == NUMERIC ? EX_NUMERIC : EX_STRING);
+}
+
+/* This screwball function parses n-ary operators:
+ 1. NMISS, NVALID, SUM, MEAN, MIN, MAX: any number of (numeric) arguments.
+ 2. SD, VARIANCE, CFVAR: at least two (numeric) arguments.
+ 3. RANGE: An odd number of arguments, but at least three.
+ All arguments must be the same type.
+ 4. ANY: At least two arguments. All arguments must be the same type.
+ */
+static int
+nary_num_func (struct function *f, int min_args, union any_node **n)
+{
+ /* Argument number of current argument (used for error messages). */
+ int argn = 1;
+
+ /* Number of arguments. */
+ int nargs;
+
+ /* Number of arguments allocated. */
+ int m = 16;
+
+ /* Type of arguments. */
+ int type = (f->t == OP_ANY || f->t == OP_RANGE) ? -1 : NUMERIC;
+
+ *n = xmalloc (sizeof (struct nonterm_node) + sizeof (union any_node *[15]));
+ (*n)->nonterm.type = f->t;
+ (*n)->nonterm.n = 0;
+ for (;;)
+ {
+ /* Special case: vara TO varb. */
+
+ /* FIXME: Is this condition failsafe? Can we _ever_ have two
+ juxtaposed identifiers otherwise? */
+ if (token == T_ID && is_varname (tokid)
+ && toupper (lex_look_ahead ()) == 'T')
+ {
+ struct variable **v;
+ int nv;
+ int j;
+ int opts = PV_SINGLE;
+
+ if (type == NUMERIC)
+ opts |= PV_NUMERIC;
+ else if (type == ALPHA)
+ opts |= PV_STRING;
+ if (!parse_variables (NULL, &v, &nv, opts))
+ goto fail;
+ if (nv + (*n)->nonterm.n >= m)
+ {
+ m += nv + 16;
+ *n = xrealloc (*n, (sizeof (struct nonterm_node)
+ + (m - 1) * sizeof (union any_node *)));
+ }
+ if (type == -1)
+ {
+ type = v[0]->type;
+ for (j = 1; j < nv; j++)
+ if (type != v[j]->type)
+ {
+ msg (SE, _("Type mismatch in argument %d of %s, which was "
+ "expected to be of %s type. It was actually "
+ "of %s type. "),
+ argn, f->s, type_name (type), type_name (v[j]->type));
+ free (v);
+ goto fail;
+ }
+ }
+ for (j = 0; j < nv; j++)
+ {
+ union any_node **c = &(*n)->nonterm.arg[(*n)->nonterm.n++];
+ *c = xmalloc (sizeof (struct var_node));
+ (*c)->var.type = (type == NUMERIC ? OP_NUM_VAR : OP_STR_VAR);
+ (*c)->var.v = v[j];
+ }
+ }
+ else
+ {
+ union any_node *c;
+ int t = parse_or (&c);
+
+ if (t == EX_ERROR)
+ goto fail;
+ if (t == EX_BOOLEAN)
+ {
+ free_node (c);
+ msg (SE, _("%s cannot take Boolean operands."), f->s);
+ goto fail;
+ }
+ if (type == -1)
+ {
+ if (t == EX_NUMERIC)
+ type = NUMERIC;
+ else if (t == EX_STRING)
+ type = ALPHA;
+ }
+ else if ((t == EX_NUMERIC) ^ (type == NUMERIC))
+ {
+ free_node (c);
+ msg (SE, _("Type mismatch in argument %d of %s, which was "
+ "expected to be of %s type. It was actually "
+ "of %s type. "),
+ argn, f->s, type_name (type), expr_type_name (t));
+ goto fail;
+ }
+ if ((*n)->nonterm.n + 1 >= m)
+ {
+ m += 16;
+ *n = xrealloc (*n, (sizeof (struct nonterm_node)
+ + (m - 1) * sizeof (union any_node *)));
+ }
+ (*n)->nonterm.arg[(*n)->nonterm.n++] = c;
+ }
+
+ if (token == ')')
+ break;
+ if (!lex_match (','))
+ {
+ lex_error (_("in function call"));
+ goto fail;
+ }
+
+ argn++;
+ }
+ *n = xrealloc (*n, (sizeof (struct nonterm_node)
+ + ((*n)->nonterm.n) * sizeof (union any_node *)));
+
+ nargs = (*n)->nonterm.n;
+ if (f->t == OP_RANGE)
+ {
+ if (nargs < 3 || (nargs & 1) == 0)
+ {
+ msg (SE, _("RANGE requires an odd number of arguments, but "
+ "at least three."));
+ return 0;
+ }
+ }
+ else if (f->t == OP_SD || f->t == OP_VARIANCE
+ || f->t == OP_CFVAR || f->t == OP_ANY)
+ {
+ if (nargs < 2)
+ {
+ msg (SE, _("%s requires at least two arguments."), f->s);
+ return 0;
+ }
+ }
+
+ if (f->t == OP_CFVAR || f->t == OP_SD || f->t == OP_VARIANCE)
+ min_args = max (min_args, 2);
+ else
+ min_args = max (min_args, 1);
+
+ /* Yes, this is admittedly a terrible crock, but it works. */
+ (*n)->nonterm.arg[(*n)->nonterm.n] = (union any_node *) min_args;
+
+ if (min_args > nargs)
+ {
+ msg (SE, _("%s.%d requires at least %d arguments."),
+ f->s, min_args, min_args);
+ return 0;
+ }
+
+ if (f->t == OP_ANY || f->t == OP_RANGE)
+ {
+ if (type == T_STRING)
+ f->t++;
+ return EX_BOOLEAN;
+ }
+ else
+ return EX_NUMERIC;
+
+fail:
+ free_node (*n);
+ return EX_ERROR;
+}
+
+static int
+CONCAT_func (struct function * f unused, int x unused, union any_node ** n)
+{
+ int m = 0;
+
+ int type;
+
+ *n = xmalloc (sizeof (struct nonterm_node) + sizeof (union any_node *[15]));
+ (*n)->nonterm.type = OP_CONCAT;
+ (*n)->nonterm.n = 0;
+ for (;;)
+ {
+ if ((*n)->nonterm.n >= m)
+ {
+ m += 16;
+ *n = xrealloc (*n, (sizeof (struct nonterm_node)
+ + (m - 1) * sizeof (union any_node *)));
+ }
+ type = parse_or (&(*n)->nonterm.arg[(*n)->nonterm.n]);
+ if (type == EX_ERROR)
+ goto fail;
+ if (type != EX_STRING)
+ {
+ msg (SE, _("Argument %d to CONCAT is type %s. All arguments "
+ "to CONCAT must be strings."),
+ (*n)->nonterm.n + 1, expr_type_name (type));
+ goto fail;
+ }
+ (*n)->nonterm.n++;
+
+ if (!lex_match (','))
+ break;
+ }
+ *n = xrealloc (*n, (sizeof (struct nonterm_node)
+ + ((*n)->nonterm.n - 1) * sizeof (union any_node *)));
+ return EX_STRING;
+
+fail:
+ free_node (*n);
+ return EX_ERROR;
+}
+
+/* Parses a string function according to f->desc. f->desc[0] is the
+ return type of the function. Succeeding characters represent
+ successive args. Optional args are separated from the required
+ args by a slash (`/'). Codes are `n', numeric arg; `s', string
+ arg; and `f', format spec (this must be the last arg). If the
+ optional args are included, the type becomes f->t+1. */
+static int
+generic_str_func (struct function *f, int x unused, union any_node ** n)
+{
+ int max_args = 0;
+ int type;
+ const char *cp;
+
+ /* Count max number of arguments. */
+ cp = &f->desc[1];
+ while (*cp)
+ {
+ if (*cp == 'n' || *cp == 's')
+ max_args++;
+ else if (*cp == 'f')
+ max_args += 3;
+ cp++;
+ }
+ cp = &f->desc[1];
+
+ *n = xmalloc (sizeof (struct nonterm_node)
+ + (max_args - 1) * sizeof (union any_node *));
+ (*n)->nonterm.type = f->t;
+ (*n)->nonterm.n = 0;
+ for (;;)
+ {
+ if (*cp == 'n' || *cp == 's')
+ {
+ int t = *cp == 'n' ? EX_NUMERIC : EX_STRING;
+ type = parse_or (&(*n)->nonterm.arg[(*n)->nonterm.n]);
+
+ if (type == EX_ERROR)
+ goto fail;
+ if (type != t)
+ {
+ msg (SE, _("Argument %d to %s was expected to be of %s type. "
+ "It was actually of type %s."),
+ (*n)->nonterm.n + 1, f->s,
+ *cp == 'n' ? _("numeric") : _("string"),
+ expr_type_name (type));
+ goto fail;
+ }
+ (*n)->nonterm.n++;
+ }
+ else if (*cp == 'f')
+ {
+ /* This is always the very last argument. Also, this code
+ is a crock. However, it works. */
+ struct fmt_spec fmt;
+
+ if (!parse_format_specifier (&fmt, 0))
+ goto fail;
+ if (formats[fmt.type].cat & FCAT_STRING)
+ {
+ msg (SE, _("%s is not a numeric format."), fmt_to_string (&fmt));
+ goto fail;
+ }
+ (*n)->nonterm.arg[(*n)->nonterm.n + 0] = (union any_node *) fmt.type;
+ (*n)->nonterm.arg[(*n)->nonterm.n + 1] = (union any_node *) fmt.w;
+ (*n)->nonterm.arg[(*n)->nonterm.n + 2] = (union any_node *) fmt.d;
+ break;
+ }
+ else
+ assert (0);
+
+ if (*++cp == 0)
+ break;
+ if (*cp == '/')
+ {
+ cp++;
+ if (lex_match (','))
+ {
+ (*n)->nonterm.type++;
+ continue;
+ }
+ else
+ break;
+ }
+ else if (!lex_match (','))
+ {
+ msg (SE, _("Too few arguments to function %s."), f->s);
+ goto fail;
+ }
+ }
+
+ return f->desc[0] == 'n' ? EX_NUMERIC : EX_STRING;
+
+fail:
+ free_node (*n);
+ return EX_ERROR;
+}
+\f
+/* General function parsing. */
+
+static int
+get_num_args (struct function *f, int num_args, union any_node **n)
+{
+ int t;
+ int i;
+
+ *n = xmalloc (sizeof (struct nonterm_node)
+ + (num_args - 1) * sizeof (union any_node *));
+ (*n)->nonterm.type = f->t;
+ (*n)->nonterm.n = 0;
+ for (i = 0;;)
+ {
+ t = parse_or (&(*n)->nonterm.arg[i]);
+ if (t == EX_ERROR)
+ goto fail;
+ (*n)->nonterm.n++;
+ if (t != EX_NUMERIC)
+ {
+ msg (SE, _("Type mismatch in argument %d of %s, which was expected "
+ "to be numeric. It was actually type %s."),
+ i + 1, f->s, expr_type_name (t));
+ goto fail;
+ }
+ if (++i >= num_args)
+ return 1;
+ if (!lex_match (','))
+ {
+ msg (SE, _("Missing comma following argument %d of %s."), i + 1, f->s);
+ goto fail;
+ }
+ }
+
+fail:
+ free_node (*n);
+ return 0;
+}
+
+static int
+parse_function (union any_node ** n)
+{
+ struct function *fp;
+ char fname[32], *cp;
+ int t;
+ int min_args;
+ struct vector *v;
+
+ /* Check for a vector with this name. */
+ v = find_vector (tokid);
+ if (v)
+ {
+ lex_get ();
+ assert (token == '(');
+ lex_get ();
+
+ *n = xmalloc (sizeof (struct nonterm_node)
+ + sizeof (union any_node *[2]));
+ (*n)->nonterm.type = (v->v[0]->type == NUMERIC
+ ? OP_VEC_ELEM_NUM : OP_VEC_ELEM_STR);
+ (*n)->nonterm.n = 0;
+
+ t = parse_or (&(*n)->nonterm.arg[0]);
+ if (t == EX_ERROR)
+ goto fail;
+ if (t != EX_NUMERIC)
+ {
+ msg (SE, _("The index value after a vector name must be numeric."));
+ goto fail;
+ }
+ (*n)->nonterm.n++;
+
+ if (!lex_match (')'))
+ {
+ msg (SE, _("`)' expected after a vector index value."));
+ goto fail;
+ }
+ ((*n)->nonterm.arg[1]) = (union any_node *) v->index;
+
+ return v->v[0]->type == NUMERIC ? EX_NUMERIC : EX_STRING;
+ }
+
+ ds_truncate (&tokstr, 31);
+ strcpy (fname, ds_value (&tokstr));
+ cp = strrchr (fname, '.');
+ if (cp && isdigit ((unsigned char) cp[1]))
+ {
+ min_args = atoi (&cp[1]);
+ *cp = 0;
+ }
+ else
+ min_args = 0;
+
+ lex_get ();
+ if (!lex_force_match ('('))
+ return 0;
+
+ {
+ struct function f;
+ f.s = fname;
+
+ fp = bsearch (&f, func_tab, func_count, sizeof *func_tab, cmp_func);
+ }
+
+ if (!fp)
+ {
+ msg (SE, _("There is no function named %s."), fname);
+ return 0;
+ }
+ if (min_args && fp->func != nary_num_func)
+ {
+ msg (SE, _("Function %s may not be given a minimum number of "
+ "arguments."), fname);
+ return 0;
+ }
+ t = fp->func (fp, min_args, n);
+ if (t == EX_ERROR)
+ return EX_ERROR;
+ if (!lex_match (')'))
+ {
+ lex_error (_("expecting `)' after %s function"), fname);
+ goto fail;
+ }
+
+ return t;
+
+fail:
+ free_node (*n);
+ return EX_ERROR;
+}
+
+#if GLOBAL_DEBUGGING
+#define op(a,b,c,d) {a,b,c,d}
+#else
+#define op(a,b,c,d) {b,c,d}
+#endif
+
+#define varies 0
+
+struct op_desc ops[OP_SENTINEL + 1] =
+{
+ op ("!?ERROR?!", 000, 0, 0),
+
+ op ("plus", 001, varies, 1),
+ op ("mul", 011, varies, 1),
+ op ("pow", 010, -1, 0),
+ op ("and", 010, -1, 0),
+ op ("or", 010, -1, 0),
+ op ("not", 000, 0, 0),
+ op ("eq", 000, -1, 0),
+ op ("ge", 000, -1, 0),
+ op ("gt", 000, -1, 0),
+ op ("le", 000, -1, 0),
+ op ("lt", 000, -1, 0),
+ op ("ne", 000, -1, 0),
+
+ op ("string-eq", 000, -1, 0),
+ op ("string-ge", 000, -1, 0),
+ op ("string-gt", 000, -1, 0),
+ op ("string-le", 000, -1, 0),
+ op ("string-lt", 000, -1, 0),
+ op ("string-ne", 000, -1, 0),
+
+ op ("neg", 000, 0, 0),
+ op ("abs", 000, 0, 0),
+ op ("arcos", 000, 0, 0),
+ op ("arsin", 000, 0, 0),
+ op ("artan", 000, 0, 0),
+ op ("cos", 000, 0, 0),
+ op ("exp", 000, 0, 0),
+ op ("lg10", 000, 0, 0),
+ op ("ln", 000, 0, 0),
+ op ("mod10", 000, 0, 0),
+ op ("rnd", 000, 0, 0),
+ op ("sin", 000, 0, 0),
+ op ("sqrt", 000, 0, 0),
+ op ("tan", 000, 0, 0),
+ op ("trunc", 000, 0, 0),
+
+ op ("any", 011, varies, 1),
+ op ("any-string", 001, varies, 1),
+ op ("cfvar", 013, varies, 2),
+ op ("max", 013, varies, 2),
+ op ("mean", 013, varies, 2),
+ op ("min", 013, varies, 2),
+ op ("nmiss", 011, varies, 1),
+ op ("nvalid", 011, varies, 1),
+ op ("range", 011, varies, 1),
+ op ("range-string", 001, varies, 1),
+ op ("sd", 013, varies, 2),
+ op ("sum", 013, varies, 2),
+ op ("variance", 013, varies, 2),
+
+ op ("time_hms", 000, -2, 0),
+ op ("ctime_days?!", 000, 0, 0),
+ op ("ctime_hours?!", 000, 0, 0),
+ op ("ctime_minutes?!", 000, 0, 0),
+ op ("ctime_seconds?!", 000, 0, 0),
+ op ("time_days?!", 000, 0, 0),
+
+ op ("date_dmy", 000, -2, 0),
+ op ("date_mdy", 000, -2, 0),
+ op ("date_moyr", 000, -1, 0),
+ op ("date_qyr", 000, -1, 0),
+ op ("date_wkyr", 000, -1, 0),
+ op ("date_yrday", 000, -1, 0),
+ op ("yrmoda", 000, -2, 0),
+
+ op ("xdate_date", 000, 0, 0),
+ op ("xdate_hour", 000, 0, 0),
+ op ("xdate_jday", 000, 0, 0),
+ op ("xdate_mday", 000, 0, 0),
+ op ("xdate_minute", 000, 0, 0),
+ op ("xdate_month", 000, 0, 0),
+ op ("xdate_quarter", 000, 0, 0),
+ op ("xdate_second", 000, 0, 0),
+ op ("xdate_tday", 000, 0, 0),
+ op ("xdate_time", 000, 0, 0),
+ op ("xdate_week", 000, 0, 0),
+ op ("xdate_wkday", 000, 0, 0),
+ op ("xdate_year", 000, 0, 0),
+
+ op ("concat", 001, varies, 1),
+ op ("index-2", 000, -1, 0),
+ op ("index-3", 000, -2, 0),
+ op ("rindex-2", 000, -1, 0),
+ op ("rindex-3", 000, -2, 0),
+ op ("length", 000, 0, 0),
+ op ("lower", 000, 0, 0),
+ op ("upcas", 000, 0, 0),
+ op ("lpad-2", 010, -1, 0),
+ op ("lpad-3", 010, -2, 0),
+ op ("rpad-2", 010, -1, 0),
+ op ("rpad-3", 010, -2, 0),
+ op ("ltrim-1", 000, 0, 0),
+ op ("ltrim-2", 000, -1, 0),
+ op ("rtrim-1", 000, 0, 0),
+ op ("rtrim-2", 000, -1, 0),
+ op ("number-1", 010, 0, 0),
+ op ("number-2", 014, 0, 3),
+ op ("string", 004, 0, 3),
+ op ("substr-2", 010, -1, 0),
+ op ("substr-3", 010, -2, 0),
+
+ op ("inv", 000, 0, 0),
+ op ("square", 000, 0, 0),
+ op ("num-to-Bool", 000, 0, 0),
+
+ op ("mod", 010, -1, 0),
+ op ("normal", 000, 0, 0),
+ op ("uniform", 000, 0, 0),
+ op ("sysmis", 010, 0, 0),
+ op ("vec-elem-num", 002, 0, 1),
+ op ("vec-elem-str", 002, 0, 1),
+
+ op ("!?TERMINAL?!", 000, 0, 0),
+ op ("num-con", 000, +1, 0),
+ op ("str-con", 000, +1, 0),
+ op ("num-var", 000, +1, 0),
+ op ("str-var", 000, +1, 0),
+ op ("num-lag", 000, +1, 1),
+ op ("str-lag", 000, +1, 1),
+ op ("num-sys", 000, +1, 1),
+ op ("num-val", 000, +1, 1),
+ op ("str-mis", 000, +1, 1),
+ op ("$casenum", 000, +1, 0),
+ op ("!?SENTINEL?!", 000, 0, 0),
+};
+
+#undef op
+#undef varies
+\f
+\f
+/* Utility functions. */
+
+static const char *
+expr_type_name (int type)
+{
+ switch (type)
+ {
+ case EX_ERROR:
+ return _("error");
+
+ case EX_BOOLEAN:
+ return _("Boolean");
+
+ case EX_NUMERIC:
+ return _("numeric");
+
+ case EX_STRING:
+ return _("string");
+
+ default:
+ assert (0);
+ }
+#if __GNUC__ || __BORLANDC__
+ return 0;
+#endif
+}
+
+static const char *
+type_name (int type)
+{
+ switch (type)
+ {
+ case NUMERIC:
+ return _("numeric");
+ case ALPHA:
+ return _("string");
+ default:
+ assert (0);
+ }
+#if __GNUC__ || __BORLANDC__
+ return 0;
+#endif
+}
+
+static void
+make_bool (union any_node **n)
+{
+ union any_node *c;
+
+ c = xmalloc (sizeof (struct nonterm_node));
+ c->nonterm.type = OP_NUM_TO_BOOL;
+ c->nonterm.n = 1;
+ c->nonterm.arg[0] = *n;
+ *n = c;
+}
+
+void
+free_node (union any_node *n)
+{
+ if (n->type < OP_TERMINAL)
+ {
+ int i;
+
+ for (i = 0; i < n->nonterm.n; i++)
+ free_node (n->nonterm.arg[i]);
+ }
+ free (n);
+}
+
+union any_node *
+allocate_nonterminal (int op, union any_node *n)
+{
+ union any_node *c;
+
+ c = xmalloc (sizeof c->nonterm);
+ c->nonterm.type = op;
+ c->nonterm.n = 1;
+ c->nonterm.arg[0] = n;
+
+ return c;
+}
+
+union any_node *
+append_nonterminal_arg (union any_node *a, union any_node *b)
+{
+ a = xrealloc (a, sizeof *a + sizeof *a->nonterm.arg * a->nonterm.n);
+ a->nonterm.arg[a->nonterm.n++] = b;
+ return a;
+}
+\f
+static struct function func_tab[] =
+{
+ {"ABS", OP_ABS, unary_func, NULL},
+ {"ACOS", OP_ARCOS, unary_func, NULL},
+ {"ARCOS", OP_ARCOS, unary_func, NULL},
+ {"ARSIN", OP_ARSIN, unary_func, NULL},
+ {"ARTAN", OP_ARTAN, unary_func, NULL},
+ {"ASIN", OP_ARSIN, unary_func, NULL},
+ {"ATAN", OP_ARTAN, unary_func, NULL},
+ {"COS", OP_COS, unary_func, NULL},
+ {"EXP", OP_EXP, unary_func, NULL},
+ {"LG10", OP_LG10, unary_func, NULL},
+ {"LN", OP_LN, unary_func, NULL},
+ {"MOD10", OP_MOD10, unary_func, NULL},
+ {"NORMAL", OP_NORMAL, unary_func, NULL},
+ {"RND", OP_RND, unary_func, NULL},
+ {"SIN", OP_SIN, unary_func, NULL},
+ {"SQRT", OP_SQRT, unary_func, NULL},
+ {"TAN", OP_TAN, unary_func, NULL},
+ {"TRUNC", OP_TRUNC, unary_func, NULL},
+ {"UNIFORM", OP_UNIFORM, unary_func, NULL},
+
+ {"TIME.DAYS", OP_TIME_DAYS, unary_func, NULL},
+ {"TIME.HMS", OP_TIME_HMS, ternary_func, NULL},
+
+ {"CTIME.DAYS", OP_CTIME_DAYS, unary_func, NULL},
+ {"CTIME.HOURS", OP_CTIME_HOURS, unary_func, NULL},
+ {"CTIME.MINUTES", OP_CTIME_MINUTES, unary_func, NULL},
+ {"CTIME.SECONDS", OP_CTIME_SECONDS, unary_func, NULL},
+
+ {"DATE.DMY", OP_DATE_DMY, ternary_func, NULL},
+ {"DATE.MDY", OP_DATE_MDY, ternary_func, NULL},
+ {"DATE.MOYR", OP_DATE_MOYR, binary_func, NULL},
+ {"DATE.QYR", OP_DATE_QYR, binary_func, NULL},
+ {"DATE.WKYR", OP_DATE_WKYR, binary_func, NULL},
+ {"DATE.YRDAY", OP_DATE_YRDAY, binary_func, NULL},
+
+ {"XDATE.DATE", OP_XDATE_DATE, unary_func, NULL},
+ {"XDATE.HOUR", OP_XDATE_HOUR, unary_func, NULL},
+ {"XDATE.JDAY", OP_XDATE_JDAY, unary_func, NULL},
+ {"XDATE.MDAY", OP_XDATE_MDAY, unary_func, NULL},
+ {"XDATE.MINUTE", OP_XDATE_MINUTE, unary_func, NULL},
+ {"XDATE.MONTH", OP_XDATE_MONTH, unary_func, NULL},
+ {"XDATE.QUARTER", OP_XDATE_QUARTER, unary_func, NULL},
+ {"XDATE.SECOND", OP_XDATE_SECOND, unary_func, NULL},
+ {"XDATE.TDAY", OP_XDATE_TDAY, unary_func, NULL},
+ {"XDATE.TIME", OP_XDATE_TIME, unary_func, NULL},
+ {"XDATE.WEEK", OP_XDATE_WEEK, unary_func, NULL},
+ {"XDATE.WKDAY", OP_XDATE_WKDAY, unary_func, NULL},
+ {"XDATE.YEAR", OP_XDATE_YEAR, unary_func, NULL},
+
+ {"MISSING", OP_SYSMIS, MISSING_func, NULL},
+ {"MOD", OP_MOD, binary_func, NULL},
+ {"SYSMIS", OP_SYSMIS, SYSMIS_func, NULL},
+ {"VALUE", OP_NUM_VAL, VALUE_func, NULL},
+ {"LAG", OP_NUM_LAG, LAG_func, NULL},
+ {"YRMODA", OP_YRMODA, ternary_func, NULL},
+
+ {"ANY", OP_ANY, nary_num_func, NULL},
+ {"CFVAR", OP_CFVAR, nary_num_func, NULL},
+ {"MAX", OP_MAX, nary_num_func, NULL},
+ {"MEAN", OP_MEAN, nary_num_func, NULL},
+ {"MIN", OP_MIN, nary_num_func, NULL},
+ {"NMISS", OP_NMISS, nary_num_func, NULL},
+ {"NVALID", OP_NVALID, nary_num_func, NULL},
+ {"RANGE", OP_RANGE, nary_num_func, NULL},
+ {"SD", OP_SD, nary_num_func, NULL},
+ {"SUM", OP_SUM, nary_num_func, NULL},
+ {"VARIANCE", OP_VARIANCE, nary_num_func, NULL},
+
+ {"CONCAT", OP_CONCAT, CONCAT_func, NULL},
+ {"INDEX", OP_INDEX, generic_str_func, "nss/n"},
+ {"RINDEX", OP_RINDEX, generic_str_func, "nss/n"},
+ {"LENGTH", OP_LENGTH, generic_str_func, "ns"},
+ {"LOWER", OP_LOWER, generic_str_func, "ss"},
+ {"UPCAS", OP_UPPER, generic_str_func, "ss"},
+ {"LPAD", OP_LPAD, generic_str_func, "ssn/s"},
+ {"RPAD", OP_RPAD, generic_str_func, "ssn/s"},
+ {"LTRIM", OP_LTRIM, generic_str_func, "ss/s"},
+ {"RTRIM", OP_RTRIM, generic_str_func, "ss/s"},
+ {"NUMBER", OP_NUMBER, generic_str_func, "ns/f"},
+ {"STRING", OP_STRING, generic_str_func, "snf"},
+ {"SUBSTR", OP_SUBSTR, generic_str_func, "ssn/n"},
+};
+
+static int
+cmp_func (const void *a, const void *b)
+{
+ return strcmp (*(char **) a, *(char **) b);
+}
+
+static void
+init_func_tab (void)
+{
+ {
+ static int inited;
+
+ if (inited)
+ return;
+ inited = 1;
+ }
+
+ func_count = sizeof func_tab / sizeof *func_tab;
+ qsort (func_tab, func_count, sizeof *func_tab, cmp_func);
+}
+\f
+/* Debug output. */
+
+#if DEBUGGING
+static void
+print_type (union any_node * n)
+{
+ const char *s;
+ size_t len;
+
+ s = ops[n->type].name;
+ len = strlen (s);
+ if (ops[n->type].flags & OP_MIN_ARGS)
+ printf ("%s.%d\n", s, (int) n->nonterm.arg[n->nonterm.n]);
+ else if (ops[n->type].flags & OP_FMT_SPEC)
+ {
+ struct fmt_spec f;
+
+ f.type = (int) n->nonterm.arg[n->nonterm.n + 0];
+ f.w = (int) n->nonterm.arg[n->nonterm.n + 1];
+ f.d = (int) n->nonterm.arg[n->nonterm.n + 2];
+ printf ("%s(%s)\n", s, fmt_to_string (&f));
+ }
+ else
+ printf ("%s\n", s);
+}
+
+static void
+debug_print_tree (union any_node * n, int level)
+{
+ int i;
+ for (i = 0; i < level; i++)
+ printf (" ");
+ if (n->type < OP_TERMINAL)
+ {
+ print_type (n);
+ for (i = 0; i < n->nonterm.n; i++)
+ debug_print_tree (n->nonterm.arg[i], level + 1);
+ }
+ else
+ {
+ switch (n->type)
+ {
+ case OP_TERMINAL:
+ printf (_("!!TERMINAL!!"));
+ break;
+ case OP_NUM_CON:
+ if (n->num_con.value == SYSMIS)
+ printf ("SYSMIS");
+ else
+ printf ("%f", n->num_con.value);
+ break;
+ case OP_STR_CON:
+ printf ("\"%.*s\"", n->str_con.len, n->str_con.s);
+ break;
+ case OP_NUM_VAR:
+ case OP_STR_VAR:
+ printf ("%s", n->var.v->name);
+ break;
+ case OP_NUM_LAG:
+ case OP_STR_LAG:
+ printf ("LAG(%s,%d)", n->lag.v->name, n->lag.lag);
+ break;
+ case OP_NUM_SYS:
+ printf ("SYSMIS(%s)", n->var.v->name);
+ break;
+ case OP_NUM_VAL:
+ printf ("VALUE(%s)", n->var.v->name);
+ break;
+ case OP_SENTINEL:
+ printf (_("!!SENTINEL!!"));
+ break;
+ default:
+ printf (_("!!ERROR%d!!"), n->type);
+ assert (0);
+ }
+ printf ("\n");
+ }
+}
+#endif /* DEBUGGING */
+
+#if GLOBAL_DEBUGGING
+static void
+debug_print_postfix (struct expression * e)
+{
+ unsigned char *o;
+ double *num = e->num;
+ unsigned char *str = e->str;
+ struct variable **v = e->var;
+ int t;
+
+ debug_printf ((_("postfix:")));
+ for (o = e->op; *o != OP_SENTINEL;)
+ {
+ t = *o++;
+ if (t < OP_TERMINAL)
+ {
+ debug_printf ((" %s", ops[t].name));
+
+ if (ops[t].flags & OP_VAR_ARGS)
+ {
+ debug_printf (("(%d)", *o));
+ o++;
+ }
+ if (ops[t].flags & OP_MIN_ARGS)
+ {
+ debug_printf ((".%d", *o));
+ o++;
+ }
+ if (ops[t].flags & OP_FMT_SPEC)
+ {
+ struct fmt_spec f;
+ f.type = (int) *o++;
+ f.w = (int) *o++;
+ f.d = (int) *o++;
+ debug_printf (("(%s)", fmt_to_string (&f)));
+ }
+ }
+ else if (t == OP_NUM_CON)
+ {
+ if (*num == SYSMIS)
+ debug_printf ((" SYSMIS"));
+ else
+ debug_printf ((" %f", *num));
+ num++;
+ }
+ else if (t == OP_STR_CON)
+ {
+ debug_printf ((" \"%.*s\"", *str, &str[1]));
+ str += str[0] + 1;
+ }
+ else if (t == OP_NUM_VAR || t == OP_STR_VAR)
+ {
+ debug_printf ((" %s", (*v)->name));
+ v++;
+ }
+ else if (t == OP_NUM_SYS)
+ {
+ debug_printf ((" SYSMIS(#%d)", *o));
+ o++;
+ }
+ else if (t == OP_NUM_VAL)
+ {
+ debug_printf ((" VALUE(#%d)", *o));
+ o++;
+ }
+ else if (t == OP_NUM_LAG || t == OP_STR_LAG)
+ {
+ debug_printf ((" LAG(%s,%d)", (*v)->name, *o));
+ o++;
+ v++;
+ }
+ else
+ {
+ printf ("debug_print_postfix(): %d\n", t);
+ assert (0);
+ }
+ }
+ debug_putc ('\n', stdout);
+}
+#endif /* GLOBAL_DEBUGGING */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !expr_h
+#define expr_h 1
+
+/* Expression parsing flags. */
+enum
+ {
+ PXP_NONE = 000, /* No flags. */
+ PXP_DUMP = 001, /* Dump postfix representation to screen;
+ only for use by EVALUATE. */
+
+ /* Specify expression type. */
+ PXP_BOOLEAN = 002, /* Coerce return value to Boolean. */
+ PXP_NUMERIC = 004, /* Must be numeric result type. */
+ PXP_STRING = 010 /* Must be string result type. */
+ };
+
+struct expression;
+struct ccase;
+union value;
+
+struct expression *expr_parse (int flags);
+double expr_evaluate (struct expression *, struct ccase *, union value *);
+void expr_free (struct expression *);
+
+#endif /* expr.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !exprP_h
+#define exprP_h 1
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+#if GLOBAL_DEBUGGING
+void debug_print_expr (struct expression *);
+void debug_print_op (short int *);
+#endif
+
+/* Expression types. */
+enum
+ {
+ EX_ERROR, /* Error value for propagation. */
+ EX_BOOLEAN, /* Numeric value that's 0, 1, or SYSMIS. */
+ EX_NUMERIC, /* Numeric value. */
+ EX_STRING /* String value. */
+ };
+
+/* Expression operators.
+ The ordering below is important. Do not change it. */
+enum
+ {
+ OP_ERROR,
+
+ /* Basic operators. */
+ OP_PLUS,
+ OP_MUL,
+ OP_POW,
+ OP_AND,
+ OP_OR,
+ OP_NOT,
+
+ /* Numeric relational operators. */
+ OP_EQ,
+ OP_GE,
+ OP_GT,
+ OP_LE,
+ OP_LT,
+ OP_NE,
+
+ /* String relational operators. */
+ OP_STRING_EQ,
+ OP_STRING_GE,
+ OP_STRING_GT,
+ OP_STRING_LE,
+ OP_STRING_LT,
+ OP_STRING_NE,
+
+ /* Unary functions. */
+ OP_NEG,
+ OP_ABS,
+ OP_ARCOS,
+ OP_ARSIN,
+ OP_ARTAN,
+ OP_COS,
+ OP_EXP,
+ OP_LG10,
+ OP_LN,
+ OP_MOD10,
+ OP_RND,
+ OP_SIN,
+ OP_SQRT,
+ OP_TAN,
+ OP_TRUNC,
+
+ /* N-ary numeric functions. */
+ OP_ANY,
+ OP_ANY_STRING,
+ OP_CFVAR,
+ OP_MAX,
+ OP_MEAN,
+ OP_MIN,
+ OP_NMISS,
+ OP_NVALID,
+ OP_RANGE,
+ OP_RANGE_STRING,
+ OP_SD,
+ OP_SUM,
+ OP_VARIANCE,
+
+ /* Time construction & extraction functions. */
+ OP_TIME_HMS,
+
+ /* These never appear in a tree or an expression.
+ They disappear in parse.c:unary_func(). */
+ OP_CTIME_DAYS,
+ OP_CTIME_HOURS,
+ OP_CTIME_MINUTES,
+ OP_CTIME_SECONDS,
+ OP_TIME_DAYS,
+
+ /* Date construction functions. */
+ OP_DATE_DMY,
+ OP_DATE_MDY,
+ OP_DATE_MOYR,
+ OP_DATE_QYR,
+ OP_DATE_WKYR,
+ OP_DATE_YRDAY,
+ OP_YRMODA,
+
+ /* Date extraction functions. */
+ OP_XDATE_DATE,
+ OP_XDATE_HOUR,
+ OP_XDATE_JDAY,
+ OP_XDATE_MDAY,
+ OP_XDATE_MINUTE,
+ OP_XDATE_MONTH,
+ OP_XDATE_QUARTER,
+ OP_XDATE_SECOND,
+ OP_XDATE_TDAY,
+ OP_XDATE_TIME,
+ OP_XDATE_WEEK,
+ OP_XDATE_WKDAY,
+ OP_XDATE_YEAR,
+
+ /* String functions. */
+ OP_CONCAT,
+ OP_INDEX,
+ OP_INDEX_OPT,
+ OP_RINDEX,
+ OP_RINDEX_OPT,
+ OP_LENGTH,
+ OP_LOWER,
+ OP_UPPER,
+ OP_LPAD,
+ OP_LPAD_OPT,
+ OP_RPAD,
+ OP_RPAD_OPT,
+ OP_LTRIM,
+ OP_LTRIM_OPT,
+ OP_RTRIM,
+ OP_RTRIM_OPT,
+ OP_NUMBER,
+ OP_NUMBER_OPT,
+ OP_STRING,
+ OP_SUBSTR,
+ OP_SUBSTR_OPT,
+
+ /* Artificial. */
+ OP_INV, /* Reciprocal. */
+ OP_SQUARE, /* Squares the argument. */
+ OP_NUM_TO_BOOL, /* Converts ~0=>0, ~1=>1, SYSMIS=>SYSMIS,
+ others=>0 with a warning. */
+
+ /* Weirdness. */
+ OP_MOD, /* Modulo function. */
+ OP_NORMAL, /* Normally distributed PRNG. */
+ OP_UNIFORM, /* Uniformly distributed PRNG. */
+ OP_SYSMIS, /* Tests whether for SYSMIS argument. */
+ OP_VEC_ELEM_NUM, /* Element of a numeric vector. */
+ OP_VEC_ELEM_STR, /* Element of a string vector. */
+
+ /* Terminals. */
+ OP_TERMINAL, /* Not a valid type. Boundary
+ between terminals and nonterminals. */
+
+ OP_NUM_CON, /* Numeric constant. */
+ OP_STR_CON, /* String literal. */
+ OP_NUM_VAR, /* Numeric variable reference. */
+ OP_STR_VAR, /* String variable reference. */
+ OP_NUM_LAG, /* Numeric variable from an earlier case. */
+ OP_STR_LAG, /* String variable from an earlier case. */
+ OP_NUM_SYS, /* SYSMIS(numvar). */
+ OP_NUM_VAL, /* VALUE(numvar). */
+ OP_STR_MIS, /* MISSING(strvar). */
+ OP_CASENUM, /* $CASENUM. */
+ OP_SENTINEL /* Sentinel. */
+ };
+
+/* Flags that describe operators. */
+enum
+ {
+ OP_VAR_ARGS = 001, /* 1=Variable number of args. */
+ OP_MIN_ARGS = 002, /* 1=Can specific min args with .X. */
+ OP_FMT_SPEC = 004, /* 1=Includes a format specifier. */
+ OP_ABSORB_MISS = 010, /* 1=May return other than SYSMIS if
+ given a SYSMIS argument. */
+ };
+
+/* Describes an operator. */
+struct op_desc
+ {
+#if GLOBAL_DEBUGGING
+ const char *name; /* Operator name. */
+#endif
+ unsigned char flags; /* Flags. */
+ signed char height; /* Effect on stack height. */
+ unsigned char skip; /* Number of operator item arguments. */
+ };
+
+extern struct op_desc ops[];
+
+/* Tree structured expressions. */
+
+/* Numeric constant. */
+struct num_con_node
+ {
+ int type; /* Always OP_NUM_CON. */
+ double value; /* Numeric value. */
+ };
+
+/* String literal. */
+struct str_con_node
+ {
+ int type; /* Always OP_STR_CON. */
+ int len; /* Length of string. */
+ char s[1]; /* String value. */
+ };
+
+/* Variable or test for missing values or cancellation of
+ user-missing. */
+struct var_node
+ {
+ int type; /* OP_NUM_VAR, OP_NUM_SYS, OP_NUM_VAL,
+ OP_STR_MIS, or OP_STR_VAR. */
+ struct variable *v; /* Variable. */
+ };
+
+/* Variable from an earlier case. */
+struct lag_node
+ {
+ int type; /* Always OP_NUM_LAG. */
+ struct variable *v; /* Relevant variable. */
+ int lag; /* Number of cases to lag. */
+ };
+
+/* $CASENUM. */
+struct casenum_node
+ {
+ int type; /* Always OP_CASENUM. */
+ };
+
+/* Any nonterminal node. */
+struct nonterm_node
+ {
+ int type; /* Always greater than OP_TERMINAL. */
+ int n; /* Number of arguments. */
+ union any_node *arg[1]; /* Arguments. */
+ };
+
+/* Any node. */
+union any_node
+ {
+ int type;
+ struct nonterm_node nonterm;
+ struct num_con_node num_con;
+ struct str_con_node str_con;
+ struct var_node var;
+ struct lag_node lag;
+ struct casenum_node casenum;
+ };
+
+/* An expression. */
+struct expression
+ {
+ int type; /* Type of expression result. */
+ unsigned char *op; /* Operators. */
+ struct variable **var; /* Variables. */
+ double *num; /* Numeric operands. */
+ unsigned char *str; /* String operands. */
+ union value *stack; /* Evaluation stack. */
+ unsigned char *str_stack; /* String evaluation stack. */
+#if !PAGED_STACK
+ size_t str_size; /* Size of string eval stack. */
+#endif
+ };
+
+struct nonterm_node *optimize_expression (struct nonterm_node *);
+void dump_expression (union any_node *, struct expression *);
+void free_node (union any_node *);
+
+double yrmoda (double year, double month, double day);
+
+#endif /* exprP.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !file_handle_h
+#define file_handle_h 1
+
+/* File handle provider (fhp).
+
+ This module provides file handles in the form of file_handle
+ structures to the dfm and sfm modules, which are known as file
+ handle users (fhusers). fhp does not know anything about file
+ contents. */
+
+#include <stddef.h>
+#include "error.h"
+
+/* Record formats. */
+enum
+ {
+ FH_RF_FIXED, /* Fixed length records. */
+ FH_RF_VARIABLE, /* Variable length records. */
+ FH_RF_SPANNED /* ? */
+ };
+
+/* File modes. */
+enum
+ {
+ FH_MD_CHARACTER, /* Character data. */
+ FH_MD_IMAGE, /* ? */
+ FH_MD_BINARY, /* Character and/or binary data. */
+ FH_MD_MULTIPUNCH, /* Column binary data (not supported). */
+ FH_MD_360 /* ? */
+ };
+
+struct file_handle;
+
+/* Services that fhusers provide to fhp. */
+struct fh_ext_class
+ {
+ int magic; /* Magic identifier for fhuser. */
+ const char *name; /* String identifier for fhuser. */
+
+ void (*close) (struct file_handle *);
+ /* Closes any associated file, etc. */
+ };
+
+/* Opaque structure. The `ext' member is an exception for use by
+ subclasses. `where.ln' is also acceptable. */
+struct file_handle
+ {
+ /* name must be the first member. */
+ const char *name; /* File handle identifier. */
+ char *norm_fn; /* Normalized filename. */
+ char *fn; /* Filename as provided by user. */
+ struct file_locator where; /* Used for reporting error messages. */
+
+ int recform; /* One of FH_RF_*. */
+ size_t lrecl; /* Length of records for FH_RF_FIXED. */
+ int mode; /* One of FH_MD_*. */
+
+ struct fh_ext_class *class; /* Polymorphism support. */
+ void *ext; /* Extension struct for fhuser use. */
+ };
+
+/* All the file handles in the system. */
+extern struct avl_tree *files;
+
+/* Pointer to the file handle that corresponds to data in the command
+ file entered via BEGIN DATA/END DATA. */
+extern struct file_handle *inline_file;
+
+/* Opening and closing handles. */
+struct file_handle *fh_get_handle_by_name (const char name[9]);
+struct file_handle *fh_get_handle_by_filename (const char *filename);
+struct file_handle *fh_parse_file_handle (void);
+void fh_close_handle (struct file_handle *handle);
+
+/* Handle info. */
+const char *fh_handle_name (struct file_handle *handle);
+char *fh_handle_filename (struct file_handle *handle);
+size_t fh_record_width (struct file_handle *handle);
+
+#endif /* !file_handle.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <errno.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "avl.h"
+#include "filename.h"
+#include "file-handle.h"
+#include "command.h"
+#include "lexer.h"
+#include "getline.h"
+#include "error.h"
+#include "magic.h"
+#include "var.h"
+/* (headers) */
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+avl_tree *files;
+struct file_handle *inline_file;
+
+static void init_file_handle (struct file_handle * handle);
+
+/* (specification)
+ "FILE HANDLE" (fh_):
+ name=string;
+ recform=recform:fixed/!variable/spanned;
+ lrecl=integer;
+ mode=mode:!character/image/binary/multipunch/_360.
+*/
+/* (declarations) */
+/* (functions) */
+
+int
+cmd_file_handle (void)
+{
+ char handle_name[9];
+ char *handle_name_p = handle_name;
+
+ struct cmd_file_handle cmd;
+ struct file_handle *fp;
+
+ lex_get ();
+ if (!lex_force_id ())
+ return CMD_FAILURE;
+ strcpy (handle_name, tokid);
+
+ fp = NULL;
+ if (files)
+ fp = avl_find (files, &handle_name_p);
+ if (fp)
+ {
+ msg (SE, _("File handle %s had already been defined to refer to "
+ "file %s. It is not possible to redefine a file "
+ "handle within a session."),
+ tokid, fp->fn);
+ return CMD_FAILURE;
+ }
+
+ lex_get ();
+ if (!lex_force_match ('/'))
+ return CMD_FAILURE;
+
+ if (!parse_file_handle (&cmd))
+ return CMD_FAILURE;
+
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ goto lossage;
+ }
+
+ if (cmd.s_name == NULL)
+ {
+ msg (SE, _("The FILE HANDLE required subcommand NAME "
+ "is not present."));
+ goto lossage;
+ }
+
+ fp = xmalloc (sizeof *fp);
+ init_file_handle (fp);
+
+ switch (cmd.recform)
+ {
+ case FH_FIXED:
+ if (cmd.n_lrecl == NOT_LONG)
+ {
+ msg (SE, _("Fixed length records were specified on /RECFORM, but "
+ "record length was not specified on /LRECL. 80-character "
+ "records will be assumed."));
+ cmd.n_lrecl = 80;
+ }
+ else if (cmd.n_lrecl < 1)
+ {
+ msg (SE, _("Record length (%ld) must be at least one byte. "
+ "80-character records will be assumed."), cmd.n_lrecl);
+ cmd.n_lrecl = 80;
+ }
+ fp->recform = FH_RF_FIXED;
+ fp->lrecl = cmd.n_lrecl;
+ break;
+ case FH_VARIABLE:
+ fp->recform = FH_RF_VARIABLE;
+ break;
+ case FH_SPANNED:
+ msg (SE, _("/RECFORM SPANNED is not implemented, as the author doesn't "
+ "know what it is supposed to do. Send the author a note."));
+ break;
+ default:
+ assert (0);
+ }
+
+ switch (cmd.mode)
+ {
+ case FH_CHARACTER:
+ fp->mode = FH_MD_CHARACTER;
+ break;
+ case FH_IMAGE:
+ msg (SE, _("/MODE IMAGE is not implemented, as the author doesn't know "
+ "what it is supposed to do. Send the author a note."));
+ break;
+ case FH_BINARY:
+ fp->mode = FH_MD_BINARY;
+ break;
+ case FH_MULTIPUNCH:
+ msg (SE, _("/MODE MULTIPUNCH is not implemented. If you care, "
+ "complain."));
+ break;
+ case FH__360:
+ msg (SE, _("/MODE 360 is not implemented. If you care, complain."));
+ break;
+ default:
+ assert (0);
+ }
+
+ fp->name = xstrdup (handle_name);
+ fp->norm_fn = fn_normalize (cmd.s_name);
+ fp->where.filename = fp->fn = cmd.s_name;
+ avl_force_insert (files, fp);
+
+ return CMD_SUCCESS;
+
+ lossage:
+ free_file_handle (&cmd);
+ return CMD_FAILURE;
+}
+\f
+/* File handle functions. */
+
+/* Sets up some fields in H; caller should fill in
+ H->{NAME,NORM_FN,FN}. */
+static void
+init_file_handle (struct file_handle *h)
+{
+ h->recform = FH_RF_VARIABLE;
+ h->mode = FH_MD_CHARACTER;
+ h->ext = NULL;
+ h->class = NULL;
+}
+
+/* Returns the handle corresponding to FILENAME. Creates the handle
+ if no handle exists for that file. All filenames are normalized
+ first, so different filenames referring to the same file will
+ return the same file handle. */
+struct file_handle *
+fh_get_handle_by_filename (const char *filename)
+{
+ struct file_handle f, *fp;
+ char *fn;
+ char *name;
+ int len;
+
+ /* Get filename. */
+ fn = fn_normalize (filename);
+ len = strlen (fn);
+
+ /* Create handle name with invalid identifier character to prevent
+ conflicts with handles created with FILE HANDLE. */
+ name = xmalloc (len + 2);
+ name[0] = '*';
+ strcpy (&name[1], fn);
+
+ f.name = name;
+ fp = avl_find (files, &f);
+ if (!fp)
+ {
+ fp = xmalloc (sizeof *fp);
+ init_file_handle (fp);
+ fp->name = name;
+ fp->norm_fn = fn;
+ fp->where.filename = fp->fn = xstrdup (filename);
+ avl_force_insert (files, fp);
+ }
+ else
+ {
+ free (fn);
+ free (name);
+ }
+ return fp;
+}
+
+/* Returns the handle with identifier NAME, if it exists; otherwise
+ reports error to user and returns NULL. */
+struct file_handle *
+fh_get_handle_by_name (const char name[9])
+{
+ struct file_handle f, *fp;
+ f.name = (char *) name;
+ fp = avl_find (files, &f);
+
+ if (!fp)
+ msg (SE, _("File handle `%s' has not been previously declared on "
+ "FILE HANDLE."), name);
+ return fp;
+}
+
+/* Returns the identifier of file HANDLE. If HANDLE was created by
+ referring to a filename (i.e., DATA LIST FILE='yyy' instead of FILE
+ HANDLE XXX='yyy'), returns the filename, enclosed in double quotes.
+ Return value is in a static buffer.
+
+ Useful for printing error messages about use of file handles. */
+const char *
+fh_handle_name (struct file_handle *h)
+{
+ static char *buf = NULL;
+
+ if (buf)
+ {
+ free (buf);
+ buf = NULL;
+ }
+ if (!h)
+ return NULL;
+
+ if (h->name[0] == '*')
+ {
+ int len = strlen (h->fn);
+
+ buf = xmalloc (len + 3);
+ strcpy (&buf[1], h->fn);
+ buf[0] = buf[len + 1] = '"';
+ buf[len + 2] = 0;
+ return buf;
+ }
+ return h->name;
+}
+
+/* Closes the stdio FILE associated with handle H. Frees internal
+ buffers associated with that file. Does *not* destroy the file
+ handle H. (File handles are permanent during a session.) */
+void
+fh_close_handle (struct file_handle *h)
+{
+ if (h == NULL)
+ return;
+
+ debug_printf (("Closing %s%s.\n", fh_handle_name (h),
+ h->class == NULL ? " (already closed)" : ""));
+
+ if (h->class)
+ h->class->close (h);
+ h->class = NULL;
+ h->ext = NULL;
+}
+
+/* Compares names of file handles A and B. */
+static int
+cmp_file_handle (const void *a, const void *b, void *foo unused)
+{
+ return strcmp (((struct file_handle *) a)->name,
+ ((struct file_handle *) b)->name);
+}
+
+/* Initialize the AVL tree of file handles; inserts the "inline file"
+ inline_file. */
+void
+fh_init_files (void)
+{
+ /* Create AVL tree. */
+ files = avl_create (NULL, cmp_file_handle, NULL);
+
+ /* Insert inline file. */
+ inline_file = xmalloc (sizeof *inline_file);
+ init_file_handle (inline_file);
+ inline_file->name = "INLINE";
+ inline_file->where.filename
+ = inline_file->fn = inline_file->norm_fn = (char *) _("<Inline File>");
+ inline_file->where.line_number = 0;
+ avl_force_insert (files, inline_file);
+}
+
+/* Parses a file handle name, which may be a filename as a string or
+ a file handle name as an identifier. Returns the file handle or
+ NULL on failure. */
+struct file_handle *
+fh_parse_file_handle (void)
+{
+ struct file_handle *handle;
+
+ if (token == T_ID)
+ handle = fh_get_handle_by_name (tokid);
+ else if (token == T_STRING)
+ handle = fh_get_handle_by_filename (ds_value (&tokstr));
+ else
+ {
+ lex_error (_("expecting a file name or handle"));
+ return NULL;
+ }
+
+ if (!handle)
+ return NULL;
+ lex_get ();
+
+ return handle;
+}
+
+/* Returns the (normalized) filename associated with file handle H. */
+char *
+fh_handle_filename (struct file_handle * h)
+{
+ return h->norm_fn;
+}
+
+/* Returns the width of a logical record on file handle H. */
+size_t
+fh_record_width (struct file_handle *h)
+{
+ if (h == inline_file)
+ return 80;
+ else if (h->recform == FH_RF_FIXED)
+ return h->lrecl;
+ else
+ return 1024;
+}
+
+/*
+ Local variables:
+ mode: c
+ End:
+*/
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "approx.h"
+#include "command.h"
+#include "data-in.h"
+#include "dfm.h"
+#include "file-handle.h"
+#include "format.h"
+#include "lexer.h"
+#include "str.h"
+#include "var.h"
+#include "vfm.h"
+
+/* Defines the three types of complex files read by FILE TYPE. */
+enum
+ {
+ FTY_MIXED,
+ FTY_GROUPED,
+ FTY_NESTED
+ };
+
+/* Limited variable column specifications. */
+struct col_spec
+ {
+ char name[9]; /* Variable name. */
+ int fc, nc; /* First column (1-based), # of columns. */
+ int fmt; /* Format type. */
+ struct variable *v; /* Variable. */
+ };
+
+/* RCT_* record type constants. */
+enum
+ {
+ RCT_OTHER = 001, /* 1=OTHER. */
+ RCT_SKIP = 002, /* 1=SKIP. */
+ RCT_DUPLICATE = 004, /* DUPLICATE: 0=NOWARN, 1=WARN. */
+ RCT_MISSING = 010, /* MISSING: 0=NOWARN, 1=WARN. */
+ RCT_SPREAD = 020 /* SPREAD: 0=NO, 1=YES. */
+ };
+
+/* Represents a RECORD TYPE command. */
+struct record_type
+ {
+ struct record_type *next;
+ unsigned flags; /* RCT_* constants. */
+ union value *v; /* Vector of values for this record type. */
+ int nv; /* Length of vector V. */
+ struct col_spec case_sbc; /* CASE subcommand. */
+ int ft, lt; /* First, last transformation index. */
+ }; /* record_type */
+
+/* Represents a FILE TYPE input program. Does not contain a
+ trns_header because it's never submitted as a transformation. */
+struct file_type_pgm
+ {
+ int type; /* One of the FTY_* constants. */
+ struct file_handle *handle; /* File handle of input file. */
+ struct col_spec record; /* RECORD subcommand. */
+ struct col_spec case_sbc; /* CASE subcommand. */
+ int wild; /* 0=NOWARN, 1=WARN. */
+ int duplicate; /* 0=NOWARN, 1=WARN. */
+ int missing; /* 0=NOWARN, 1=WARN, 2=CASE. */
+ int ordered; /* 0=NO, 1=YES. */
+ int had_rec_type; /* 1=Had a RECORD TYPE command.
+ RECORD TYPE must precede the first
+ DATA LIST. */
+ struct record_type *recs_head; /* List of record types. */
+ struct record_type *recs_tail; /* Last in list of record types. */
+ };
+
+/* Current FILE TYPE input program. */
+static struct file_type_pgm fty;
+
+static int parse_col_spec (struct col_spec *, const char *);
+static void create_col_var (struct col_spec *c);
+
+/* Parses FILE TYPE command. */
+int
+cmd_file_type (void)
+{
+ /* Initialize. */
+ discard_variables ();
+ fty.handle = inline_file;
+ fty.record.name[0] = 0;
+ fty.case_sbc.name[0] = 0;
+ fty.wild = fty.duplicate = fty.missing = fty.ordered = 0;
+ fty.had_rec_type = 0;
+ fty.recs_head = fty.recs_tail = NULL;
+
+ lex_match_id ("TYPE");
+ if (lex_match_id ("MIXED"))
+ fty.type = FTY_MIXED;
+ else if (lex_match_id ("GROUPED"))
+ {
+ fty.type = FTY_GROUPED;
+ fty.wild = 1;
+ fty.duplicate = 1;
+ fty.missing = 1;
+ fty.ordered = 1;
+ }
+ else if (lex_match_id ("NESTED"))
+ fty.type = FTY_NESTED;
+ else
+ {
+ msg (SE, _("MIXED, GROUPED, or NESTED expected."));
+ return CMD_FAILURE;
+ }
+
+ while (token != '.')
+ {
+ if (lex_match_id ("FILE"))
+ {
+ lex_match ('=');
+ fty.handle = fh_parse_file_handle ();
+ if (!fty.handle)
+ return CMD_FAILURE;
+ }
+ else if (lex_match_id ("RECORD"))
+ {
+ lex_match ('=');
+ if (!parse_col_spec (&fty.record, "####RECD"))
+ return CMD_FAILURE;
+ }
+ else if (lex_match_id ("CASE"))
+ {
+ if (fty.type == FTY_MIXED)
+ {
+ msg (SE, _("The CASE subcommand is not valid on FILE TYPE "
+ "MIXED."));
+ return CMD_FAILURE;
+ }
+
+ lex_match ('=');
+ if (!parse_col_spec (&fty.case_sbc, "####CASE"))
+ return CMD_FAILURE;
+ }
+ else if (lex_match_id ("WILD"))
+ {
+ lex_match ('=');
+ if (lex_match_id ("WARN"))
+ fty.wild = 1;
+ else if (lex_match_id ("NOWARN"))
+ fty.wild = 0;
+ else
+ {
+ msg (SE, _("WARN or NOWARN expected after WILD."));
+ return CMD_FAILURE;
+ }
+ }
+ else if (lex_match_id ("DUPLICATE"))
+ {
+ if (fty.type == FTY_MIXED)
+ {
+ msg (SE, _("The DUPLICATE subcommand is not valid on "
+ "FILE TYPE MIXED."));
+ return CMD_FAILURE;
+ }
+
+ lex_match ('=');
+ if (lex_match_id ("WARN"))
+ fty.duplicate = 1;
+ else if (lex_match_id ("NOWARN"))
+ fty.duplicate = 0;
+ else if (lex_match_id ("CASE"))
+ {
+ if (fty.type != FTY_NESTED)
+ {
+ msg (SE, _("DUPLICATE=CASE is only valid on "
+ "FILE TYPE NESTED."));
+ return CMD_FAILURE;
+ }
+
+ fty.duplicate = 2;
+ }
+ else
+ {
+ msg (SE, _("WARN%s expected after DUPLICATE."),
+ (fty.type == FTY_NESTED ? _(", NOWARN, or CASE")
+ : _(" or NOWARN")));
+ return CMD_FAILURE;
+ }
+ }
+ else if (lex_match_id ("MISSING"))
+ {
+ if (fty.type == FTY_MIXED)
+ {
+ msg (SE, _("The MISSING subcommand is not valid on "
+ "FILE TYPE MIXED."));
+ return CMD_FAILURE;
+ }
+
+ lex_match ('=');
+ if (lex_match_id ("NOWARN"))
+ fty.missing = 0;
+ else if (lex_match_id ("WARN"))
+ fty.missing = 1;
+ else
+ {
+ msg (SE, _("WARN or NOWARN after MISSING."));
+ return CMD_FAILURE;
+ }
+ }
+ else if (lex_match_id ("ORDERED"))
+ {
+ if (fty.type != FTY_GROUPED)
+ {
+ msg (SE, _("ORDERED is only valid on FILE TYPE GROUPED."));
+ return CMD_FAILURE;
+ }
+
+ lex_match ('=');
+ if (lex_match_id ("YES"))
+ fty.ordered = 1;
+ else if (lex_match_id ("NO"))
+ fty.ordered = 0;
+ else
+ {
+ msg (SE, _("YES or NO expected after ORDERED."));
+ return CMD_FAILURE;
+ }
+ }
+ else
+ {
+ lex_error (_("while expecting a valid subcommand"));
+ return CMD_FAILURE;
+ }
+ }
+
+ if (fty.record.name[0] == 0)
+ {
+ msg (SE, _("The required RECORD subcommand was not present."));
+ return CMD_FAILURE;
+ }
+
+ if (fty.type == FTY_GROUPED)
+ {
+ if (fty.case_sbc.name[0] == 0)
+ {
+ msg (SE, _("The required CASE subcommand was not present."));
+ return CMD_FAILURE;
+ }
+
+ if (!strcmp (fty.case_sbc.name, fty.record.name))
+ {
+ msg (SE, _("CASE and RECORD must specify different variable "
+ "names."));
+ return CMD_FAILURE;
+ }
+ }
+
+ default_handle = fty.handle;
+
+ vfm_source = &file_type_source;
+ create_col_var (&fty.record);
+ if (fty.case_sbc.name[0])
+ create_col_var (&fty.case_sbc);
+
+ return CMD_SUCCESS;
+}
+
+/* Creates a variable with attributes specified by struct col_spec C, and
+ stores it into C->V. */
+static void
+create_col_var (struct col_spec *c)
+{
+ int type;
+ int width;
+
+ type = (formats[c->fmt].cat & FCAT_STRING) ? ALPHA : NUMERIC;
+ if (type == ALPHA)
+ width = c->nc;
+ else
+ width = 0;
+ c->v = force_create_variable (&default_dict, c->name, type, width);
+}
+
+/* Parses variable, column, type specifications for a variable. */
+static int
+parse_col_spec (struct col_spec *c, const char *def_name)
+{
+ struct fmt_spec spec;
+
+ if (token == T_ID)
+ {
+ strcpy (c->name, tokid);
+ lex_get ();
+ }
+ else
+ strcpy (c->name, def_name);
+
+ if (!lex_force_int ())
+ return 0;
+ c->fc = lex_integer ();
+ if (c->fc < 1)
+ {
+ msg (SE, _("Column value must be positive."));
+ return 0;
+ }
+ lex_get ();
+
+ lex_negative_to_dash ();
+ if (lex_match ('-'))
+ {
+ if (!lex_force_int ())
+ return 0;
+ c->nc = lex_integer ();
+ lex_get ();
+
+ if (c->nc < c->fc)
+ {
+ msg (SE, _("Ending column precedes beginning column."));
+ return 0;
+ }
+
+ c->nc -= c->fc - 1;
+ }
+ else
+ c->nc = 1;
+
+ if (lex_match ('('))
+ {
+ const char *cp;
+ if (!lex_force_id ())
+ return 0;
+ c->fmt = parse_format_specifier_name (&cp, 0);
+ if (c->fmt == -1)
+ return 0;
+ if (*cp)
+ {
+ msg (SE, _("Bad format specifier name."));
+ return 0;
+ }
+ lex_get ();
+ if (!lex_force_match (')'))
+ return 0;
+ }
+ else
+ c->fmt = FMT_F;
+
+ spec.type = c->fmt;
+ spec.w = c->nc;
+ spec.d = 0;
+ return check_input_specifier (&spec);
+}
+\f
+/* RECORD TYPE. */
+
+/* Structure being filled in by internal_cmd_record_type. */
+static struct record_type rct;
+
+static int internal_cmd_record_type (void);
+
+/* Parse the RECORD TYPE command. */
+int
+cmd_record_type (void)
+{
+ int result = internal_cmd_record_type ();
+
+ if (result == CMD_FAILURE)
+ {
+ int i;
+
+ if (formats[fty.record.fmt].cat & FCAT_STRING)
+ for (i = 0; i < rct.nv; i++)
+ free (rct.v[i].c);
+ free (rct.v);
+ }
+
+ return result;
+}
+
+static int
+internal_cmd_record_type (void)
+{
+ /* Initialize the record_type structure. */
+ rct.next = NULL;
+ rct.flags = 0;
+ if (fty.duplicate)
+ rct.flags |= RCT_DUPLICATE;
+ if (fty.missing)
+ rct.flags |= RCT_MISSING;
+ rct.v = NULL;
+ rct.nv = 0;
+ rct.ft = n_trns;
+ if (fty.case_sbc.name[0])
+ rct.case_sbc = fty.case_sbc;
+#if __CHECKER__
+ else
+ memset (&rct.case_sbc, 0, sizeof rct.case_sbc);
+ rct.lt = -1;
+#endif
+
+ /* Make sure we're inside a FILE TYPE structure. */
+ if (pgm_state != STATE_INPUT || vfm_source != &file_type_source)
+ {
+ msg (SE, _("This command may only appear within a "
+ "FILE TYPE/END FILE TYPE structure."));
+ return CMD_FAILURE;
+ }
+
+ if (fty.recs_tail && (fty.recs_tail->flags & RCT_OTHER))
+ {
+ msg (SE, _("OTHER may appear only on the last RECORD TYPE command."));
+ return CMD_FAILURE;
+ }
+
+ if (fty.recs_tail)
+ {
+ fty.recs_tail->lt = n_trns - 1;
+ if (!(fty.recs_tail->flags & RCT_SKIP)
+ && fty.recs_tail->ft == fty.recs_tail->lt)
+ {
+ msg (SE, _("No input commands (DATA LIST, REPEATING DATA) "
+ "for above RECORD TYPE."));
+ return CMD_FAILURE;
+ }
+ }
+
+ lex_match_id ("RECORD");
+ lex_match_id ("TYPE");
+
+ /* Parse record type values. */
+ if (lex_match_id ("OTHER"))
+ rct.flags |= RCT_OTHER;
+ else
+ {
+ int mv = 0;
+
+ while (token == T_NUM || token == T_STRING)
+ {
+ if (rct.nv >= mv)
+ {
+ mv += 16;
+ rct.v = xrealloc (rct.v, mv * sizeof *rct.v);
+ }
+
+ if (formats[fty.record.fmt].cat & FCAT_STRING)
+ {
+ if (!lex_force_string ())
+ return CMD_FAILURE;
+ rct.v[rct.nv].c = xmalloc (fty.record.nc + 1);
+ st_bare_pad_copy (rct.v[rct.nv].c, ds_value (&tokstr),
+ fty.record.nc + 1);
+ }
+ else
+ {
+ if (!lex_force_num ())
+ return CMD_FAILURE;
+ rct.v[rct.nv].f = tokval;
+ }
+ rct.nv++;
+ lex_get ();
+
+ lex_match (',');
+ }
+ }
+
+ /* Parse the rest of the subcommands. */
+ while (token != '.')
+ {
+ if (lex_match_id ("SKIP"))
+ rct.flags |= RCT_SKIP;
+ else if (lex_match_id ("CASE"))
+ {
+ if (fty.type == FTY_MIXED)
+ {
+ msg (SE, _("The CASE subcommand is not allowed on "
+ "the RECORD TYPE command for FILE TYPE MIXED."));
+ return CMD_FAILURE;
+ }
+
+ lex_match ('=');
+ if (!parse_col_spec (&rct.case_sbc, ""))
+ return CMD_FAILURE;
+ if (rct.case_sbc.name[0])
+ {
+ msg (SE, _("No variable name may be specified for the "
+ "CASE subcommand on RECORD TYPE."));
+ return CMD_FAILURE;
+ }
+
+ if ((formats[rct.case_sbc.fmt].cat ^ formats[fty.case_sbc.fmt].cat)
+ & FCAT_STRING)
+ {
+ msg (SE, _("The CASE column specification on RECORD TYPE "
+ "must give a format specifier that is the "
+ "same type as that of the CASE column "
+ "specification given on FILE TYPE."));
+ return CMD_FAILURE;
+ }
+ }
+ else if (lex_match_id ("DUPLICATE"))
+ {
+ lex_match ('=');
+ if (lex_match_id ("WARN"))
+ rct.flags |= RCT_DUPLICATE;
+ else if (lex_match_id ("NOWARN"))
+ rct.flags &= ~RCT_DUPLICATE;
+ else
+ {
+ msg (SE, _("WARN or NOWARN expected on DUPLICATE "
+ "subcommand."));
+ return CMD_FAILURE;
+ }
+ }
+ else if (lex_match_id ("MISSING"))
+ {
+ lex_match ('=');
+ if (lex_match_id ("WARN"))
+ rct.flags |= RCT_MISSING;
+ else if (lex_match_id ("NOWARN"))
+ rct.flags &= ~RCT_MISSING;
+ else
+ {
+ msg (SE, _("WARN or NOWARN expected on MISSING subcommand."));
+ return CMD_FAILURE;
+ }
+ }
+ else if (lex_match_id ("SPREAD"))
+ {
+ lex_match ('=');
+ if (lex_match_id ("YES"))
+ rct.flags |= RCT_SPREAD;
+ else if (lex_match_id ("NO"))
+ rct.flags &= ~RCT_SPREAD;
+ else
+ {
+ msg (SE, _("YES or NO expected on SPREAD subcommand."));
+ return CMD_FAILURE;
+ }
+ }
+ else
+ {
+ lex_error (_("while expecting a valid subcommand"));
+ return CMD_FAILURE;
+ }
+ }
+
+ if (fty.recs_head)
+ fty.recs_tail = fty.recs_tail->next = xmalloc (sizeof *fty.recs_tail);
+ else
+ fty.recs_head = fty.recs_tail = xmalloc (sizeof *fty.recs_tail);
+ memcpy (fty.recs_tail, &rct, sizeof *fty.recs_tail);
+
+ return CMD_SUCCESS;
+}
+\f
+/* END FILE TYPE. */
+
+int
+cmd_end_file_type (void)
+{
+ if (pgm_state != STATE_INPUT || vfm_source != &file_type_source)
+ {
+ msg (SE, _("This command may only appear within a "
+ "FILE TYPE/END FILE TYPE structure."));
+ return CMD_FAILURE;
+ }
+
+ lex_match_id ("TYPE");
+
+ if (fty.recs_tail)
+ {
+ fty.recs_tail->lt = n_trns - 1;
+ if (!(fty.recs_tail->flags & RCT_SKIP)
+ && fty.recs_tail->ft == fty.recs_tail->lt)
+ {
+ msg (SE, _("No input commands (DATA LIST, REPEATING DATA) "
+ "on above RECORD TYPE."));
+ goto fail;
+ }
+ }
+ else
+ {
+ msg (SE, _("No commands between FILE TYPE and END FILE TYPE."));
+ goto fail;
+ }
+
+ f_trns = n_trns;
+
+ return lex_end_of_command ();
+
+ fail:
+ /* Come here on discovering catastrophic error. */
+ err_cond_fail ();
+ discard_variables ();
+ return CMD_FAILURE;
+}
+\f
+/* FILE TYPE runtime. */
+
+/*static void read_from_file_type_mixed(void);
+ static void read_from_file_type_grouped(void);
+ static void read_from_file_type_nested(void); */
+
+/* Reads any number of cases into temp_case and calls write_case() for
+ each one. Compare data-list.c:read_from_data_list. */
+static void
+file_type_source_read (void)
+{
+ char *line;
+ int len;
+
+ struct fmt_spec format;
+
+ dfm_push (fty.handle);
+
+ format.type = fty.record.fmt;
+ format.w = fty.record.nc;
+ format.d = 0;
+ while (NULL != (line = dfm_get_record (fty.handle, &len)))
+ {
+ struct record_type *iter;
+ union value v;
+ int i;
+
+ if (formats[fty.record.fmt].cat & FCAT_STRING)
+ {
+ struct data_in di;
+
+ v.c = temp_case->data[fty.record.v->fv].s;
+
+ data_in_finite_line (&di, line, len,
+ fty.record.fc, fty.record.fc + fty.record.nc);
+ di.v = (union value *) v.c;
+ di.flags = 0;
+ di.f1 = fty.record.fc;
+ di.format = format;
+ data_in (&di);
+
+ for (iter = fty.recs_head; iter; iter = iter->next)
+ {
+ if (iter->flags & RCT_OTHER)
+ goto found;
+ for (i = 0; i < iter->nv; i++)
+ if (!memcmp (iter->v[i].c, v.c, fty.record.nc))
+ goto found;
+ }
+ if (fty.wild)
+ msg (SW, _("Unknown record type \"%.*s\"."), fty.record.nc, v.c);
+ }
+ else
+ {
+ struct data_in di;
+
+ data_in_finite_line (&di, line, len,
+ fty.record.fc, fty.record.fc + fty.record.nc);
+ di.v = &v;
+ di.flags = 0;
+ di.f1 = fty.record.fc;
+ di.format = format;
+ data_in (&di);
+
+ memcpy (&temp_case->data[fty.record.v->fv].f, &v.f, sizeof v.f);
+ for (iter = fty.recs_head; iter; iter = iter->next)
+ {
+ if (iter->flags & RCT_OTHER)
+ goto found;
+ for (i = 0; i < iter->nv; i++)
+ if (approx_eq (iter->v[i].f, v.f))
+ goto found;
+ }
+ if (fty.wild)
+ msg (SW, _("Unknown record type %g."), v.f);
+ }
+ dfm_fwd_record (fty.handle);
+ continue;
+
+ found:
+ /* Arrive here if there is a matching record_type, which is in
+ iter. */
+ dfm_fwd_record (fty.handle);
+ }
+
+/* switch(fty.type)
+ {
+ case FTY_MIXED: read_from_file_type_mixed(); break;
+ case FTY_GROUPED: read_from_file_type_grouped(); break;
+ case FTY_NESTED: read_from_file_type_nested(); break;
+ default: assert(0);
+ } */
+
+ dfm_pop (fty.handle);
+}
+
+static void
+file_type_source_destroy_source (void)
+{
+ struct record_type *iter, *next;
+
+ cancel_transformations ();
+ for (iter = fty.recs_head; iter; iter = next)
+ {
+ next = iter->next;
+ free (iter);
+ }
+}
+
+struct case_stream file_type_source =
+ {
+ NULL,
+ file_type_source_read,
+ NULL,
+ NULL,
+ file_type_source_destroy_source,
+ NULL,
+ "FILE TYPE",
+ };
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <errno.h>
+#include "alloc.h"
+#include "error.h"
+#include "filename.h"
+#include "settings.h"
+#include "str.h"
+#include "version.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+
+/* PORTME: Everything in this file is system dependent. */
+
+#if unix
+#include <pwd.h>
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#include "stat.h"
+#endif
+
+#if __WIN32__
+#define NOGDI
+#define NOUSER
+#define NONLS
+#include <win32/windows.h>
+#endif
+
+#if __DJGPP__
+#include <sys/stat.h>
+#endif
+\f
+/* Initialization. */
+
+const char *config_path;
+
+void
+fn_init (void)
+{
+ config_path = fn_getenv_default ("STAT_CONFIG_PATH", default_config_path);
+}
+\f
+/* Functions for performing operations on filenames. */
+
+/* Substitutes $variables as defined by GETENV into INPUT and returns
+ a copy of the resultant string. Supports $var and ${var} syntaxes;
+ $$ substitutes as $. */
+char *
+fn_interp_vars (const char *input, const char *(*getenv) (const char *))
+{
+ struct string output;
+
+ if (NULL == strchr (input, '$'))
+ return xstrdup (input);
+
+ ds_init (NULL, &output, strlen (input));
+
+ for (;;)
+ switch (*input)
+ {
+ case '\0':
+ return ds_value (&output);
+
+ case '$':
+ input++;
+
+ if (*input == '$')
+ {
+ ds_putchar (&output, '$');
+ input++;
+ }
+ else
+ {
+ int stop;
+ int start;
+ const char *value;
+
+ start = ds_length (&output);
+
+ if (*input == '(')
+ {
+ stop = ')';
+ input++;
+ }
+ else if (*input == '{')
+ {
+ stop = '}';
+ input++;
+ }
+ else
+ stop = 0;
+
+ while (*input && *input != stop
+ && (stop || isalpha ((unsigned char) *input)))
+ ds_putchar (&output, *input++);
+
+ value = getenv (ds_value (&output) + start);
+ ds_truncate (&output, start);
+ ds_concat (&output, value);
+
+ if (stop && *input == stop)
+ input++;
+ }
+
+ default:
+ ds_putchar (&output, *input++);
+ }
+}
+
+#if unix
+/* Expands csh tilde notation from the path INPUT into a malloc()'d
+ returned string. */
+char *
+fn_tilde_expand (const char *input)
+{
+ const char *ip;
+ struct string output;
+
+ if (NULL == strchr (input, '~'))
+ return xstrdup (input);
+ ds_init (NULL, &output, strlen (input));
+
+ ip = input;
+
+ for (ip = input; *ip; )
+ if (*ip != '~' || (ip != input && ip[-1] != PATH_DELIMITER))
+ ds_putchar (&output, *ip++);
+ else
+ {
+ static const char stop_set[3] = {DIR_SEPARATOR, PATH_DELIMITER, 0};
+ const char *cp;
+
+ ip++;
+
+ cp = ip + strcspn (ip, stop_set);
+
+ if (cp > ip)
+ {
+ struct passwd *pwd;
+ char username[9];
+
+ strncpy (username, ip, cp - ip + 1);
+ username[8] = 0;
+ pwd = getpwnam (username);
+
+ if (!pwd || !pwd->pw_dir)
+ ds_putchar (&output, *ip++);
+ else
+ ds_concat (&output, pwd->pw_dir);
+ }
+ else
+ {
+ const char *home = fn_getenv ("HOME");
+ if (!home)
+ ds_putchar (&output, *ip++);
+ else
+ ds_concat (&output, home);
+ }
+
+ ip = cp;
+ }
+
+ return ds_value (&output);
+}
+#else /* !unix */
+char *
+fn_tilde_expand (char *input)
+{
+ return xstrdup (input);
+}
+#endif /* !unix */
+
+/* Searches for a configuration file with name NAME in the path given
+ by PATH, which is tilde- and environment-interpolated. Directories
+ in PATH are delimited by PATH_DELIMITER, defined in <pref.h>.
+ Returns the malloc'd full name of the first file found, or NULL if
+ none is found.
+
+ If PREPEND is non-NULL, then it is prepended to each filename;
+ i.e., it looks like PREPEND/PATH_COMPONENT/NAME. This is not done
+ with absolute directories in the path. */
+#if unix || __MSDOS__ || __WIN32__
+char *
+fn_search_path (const char *basename, const char *path, const char *prepend)
+{
+ char *subst_path;
+ struct string filename;
+ const char *bp;
+
+ if (fn_absolute_p (basename))
+ return fn_tilde_expand (basename);
+
+ {
+ char *temp = fn_interp_vars (path, fn_getenv);
+ bp = subst_path = fn_tilde_expand (temp);
+ free (temp);
+ }
+
+ msg (VM (4), _("Searching for `%s'..."), basename);
+ ds_init (NULL, &filename, 64);
+
+ for (;;)
+ {
+ const char *ep;
+ if (0 == *bp)
+ {
+ msg (VM (4), _("Search unsuccessful!"));
+ ds_destroy (&filename);
+ free (subst_path);
+ return NULL;
+ }
+
+ for (ep = bp; *ep && *ep != PATH_DELIMITER; ep++)
+ ;
+
+ /* Paste together PREPEND/PATH/BASENAME. */
+ ds_clear (&filename);
+ if (prepend && !fn_absolute_p (bp))
+ {
+ ds_concat (&filename, prepend);
+ ds_putchar (&filename, DIR_SEPARATOR);
+ }
+ ds_concat_buffer (&filename, bp, ep - bp);
+ if (ep - bp
+ && ds_value (&filename)[ds_length (&filename) - 1] != DIR_SEPARATOR)
+ ds_putchar (&filename, DIR_SEPARATOR);
+ ds_concat (&filename, basename);
+
+ msg (VM (5), " - %s", ds_value (&filename));
+ if (fn_exists_p (ds_value (&filename)))
+ {
+ msg (VM (4), _("Found `%s'."), ds_value (&filename));
+ free (subst_path);
+ return ds_value (&filename);
+ }
+
+ if (0 == *ep)
+ {
+ msg (VM (4), _("Search unsuccessful!"));
+ free (subst_path);
+ ds_destroy (&filename);
+ return NULL;
+ }
+ bp = ep + 1;
+ }
+}
+#else /* not unix, msdog, lose32 */
+char *
+fn_search_path (const char *basename, const char *path, const char *prepend)
+{
+ size_t size = strlen (path) + 1 + strlen (basename) + 1;
+ char *string;
+ char *cp;
+
+ if (prepend)
+ size += strlen (prepend) + 1;
+ string = xmalloc (size);
+
+ cp = string;
+ if (prepend)
+ {
+ cp = stpcpy (cp, prepend);
+ *cp++ = DIR_SEPARATOR;
+ }
+ cp = stpcpy (cp, path);
+ *cp++ = DIR_SEPARATOR;
+ strcpy (cp, basename);
+
+ return string;
+}
+#endif /* not unix, msdog, lose32 */
+
+/* Prepends directory DIR to filename FILE and returns a malloc()'d
+ copy of it. */
+char *
+fn_prepend_dir (const char *file, const char *dir)
+{
+ char *temp;
+ char *cp;
+
+ if (fn_absolute_p (file))
+ return xstrdup (file);
+
+ temp = xmalloc (strlen (file) + 1 + strlen (dir) + 1);
+ cp = stpcpy (temp, dir);
+ if (cp != temp && cp[-1] != DIR_SEPARATOR)
+ *cp++ = DIR_SEPARATOR;
+ cp = stpcpy (cp, file);
+
+ return temp;
+}
+
+/* fn_normalize(): This very OS-dependent routine canonicalizes
+ filename FN1. The filename should not need to be the name of an
+ existing file. Returns a malloc()'d copy of the canonical name.
+ This function must always succeed; if it needs to bail out then it
+ should return xstrdup(FN1). */
+#if unix
+char *
+fn_normalize (const char *filename)
+{
+ const char *src;
+ char *fn1, *fn2, *dest;
+ int maxlen;
+
+ if (fn_special_p (filename))
+ return xstrdup (filename);
+
+ fn1 = fn_tilde_expand (filename);
+
+ /* Follow symbolic links. */
+ for (;;)
+ {
+ fn2 = fn1;
+ fn1 = fn_readlink (fn1);
+ if (!fn1)
+ {
+ fn1 = fn2;
+ break;
+ }
+ free (fn2);
+ }
+
+ maxlen = strlen (fn1) * 2;
+ if (maxlen < 31)
+ maxlen = 31;
+ dest = fn2 = xmalloc (maxlen + 1);
+ src = fn1;
+
+ if (*src == DIR_SEPARATOR)
+ *dest++ = *src++;
+ else
+ {
+ errno = 0;
+#if __CHECKER__
+ memset (dest, 0, maxlen);
+#endif
+ while (getcwd (dest, maxlen - (dest - fn2)) == NULL && errno == ERANGE)
+ {
+ maxlen *= 2;
+ dest = fn2 = xrealloc (fn2, maxlen + 1);
+#if __CHECKER__
+ memset (dest, 0, maxlen);
+#endif
+ errno = 0;
+ }
+ if (errno)
+ {
+ free (fn1);
+ free (fn2);
+ return NULL;
+ }
+ dest = strchr (fn2, '\0');
+ if (dest - fn2 >= maxlen)
+ {
+ int ofs = dest - fn2;
+ maxlen *= 2;
+ fn2 = xrealloc (fn2, maxlen + 1);
+ dest = fn2 + ofs;
+ }
+ if (dest[-1] != DIR_SEPARATOR)
+ *dest++ = DIR_SEPARATOR;
+ }
+
+ for (;;)
+ {
+ int c, f;
+
+ c = *src++;
+
+ f = 0;
+ if (c == DIR_SEPARATOR || c == 0)
+ {
+ /* remove `./', `../' from directory */
+ if (dest[-1] == '.' && dest[-2] == DIR_SEPARATOR)
+ dest--;
+ else if (dest[-1] == '.' && dest[-2] == '.' && dest[-3] == DIR_SEPARATOR)
+ {
+ dest -= 3;
+ if (dest == fn2)
+ dest++;
+ while (dest[-1] != DIR_SEPARATOR)
+ dest--;
+ }
+ else if (dest[-1] != DIR_SEPARATOR) /* remove extra slashes */
+ f = 1;
+
+ if (c == 0)
+ {
+ if (dest[-1] == DIR_SEPARATOR && dest > fn2 + 1)
+ dest--;
+ *dest = 0;
+ free (fn1);
+
+ return xrealloc (fn2, strlen (fn2) + 1);
+ }
+ }
+ else
+ f = 1;
+
+ if (f)
+ {
+ if (dest - fn2 >= maxlen)
+ {
+ int ofs = dest - fn2;
+ maxlen *= 2;
+ fn2 = xrealloc (fn2, maxlen + 1);
+ dest = fn2 + ofs;
+ }
+ *dest++ = c;
+ }
+ }
+}
+#elif __WIN32__
+char *
+fn_normalize (const char *fn1)
+{
+ DWORD len;
+ DWORD success;
+ char *fn2;
+
+ /* Don't change special filenames. */
+ if (is_special_filename (filename))
+ return xstrdup (filename);
+
+ /* First find the required buffer length. */
+ len = GetFullPathName (fn1, 0, NULL, NULL);
+ if (!len)
+ {
+ fn2 = xstrdup (fn1);
+ return fn2;
+ }
+
+ /* Then make a buffer that big. */
+ fn2 = xmalloc (len);
+ success = GetFullPathName (fn1, len, fn2, NULL);
+ if (success >= len || success == 0)
+ {
+ free (fn2);
+ fn2 = xstrdup (fn1);
+ return fn2;
+ }
+ return fn2;
+}
+#elif __BORLANDC__
+char *
+fn_normalize (const char *fn1)
+{
+ char *fn2 = _fullpath (NULL, fn1, 0);
+ if (fn2)
+ {
+ char *cp;
+ for (cp = fn2; *cp; cp++)
+ *cp = toupper ((unsigned char) (*cp));
+ return fn2;
+ }
+ return xstrdup (fn1);
+}
+#elif __DJGPP__
+char *
+fn_normalize (const char *fn1)
+{
+ char *fn2 = xmalloc (1024);
+ _fixpath (fn1, fn2);
+ fn2 = xrealloc (fn2, strlen (fn2) + 1);
+ return fn2;
+}
+#else /* not Lose32, Unix, or DJGPP */
+char *
+fn_normalize (const char *fn)
+{
+ return xstrdup (fn);
+}
+#endif /* not Lose32, Unix, or DJGPP */
+
+/* Returns the directory part of FILENAME, as a malloc()'d
+ string. */
+char *
+fn_dirname (const char *filename)
+{
+ const char *p;
+ char *s;
+ size_t len;
+
+ len = strlen (filename);
+ if (len == 1 && filename[0] == '/')
+ p = filename + 1;
+ else if (len && filename[len - 1] == DIR_SEPARATOR)
+ p = mm_find_reverse (filename, len - 1, filename + len - 1, 1);
+ else
+ p = strrchr (filename, DIR_SEPARATOR);
+ if (p == NULL)
+ p = filename;
+
+ s = xmalloc (p - filename + 1);
+ memcpy (s, filename, p - filename);
+ s[p - filename] = 0;
+
+ return s;
+}
+
+/* Returns the basename part of FILENAME as a malloc()'d string. */
+#if 0
+char *
+fn_basename (const char *filename)
+{
+ /* Not used, not implemented. */
+ abort ();
+}
+#endif
+\f
+/* Returns the current working directory, as a malloc()'d string.
+ From libc.info. */
+char *
+fn_get_cwd (void)
+{
+ int size = 100;
+ char *buffer = xmalloc (size);
+
+ for (;;)
+ {
+ char *value = getcwd (buffer, size);
+ if (value != 0)
+ return buffer;
+
+ size *= 2;
+ free (buffer);
+ buffer = xmalloc (size);
+ }
+}
+\f
+/* Find out information about files. */
+
+/* Returns nonzero iff NAME specifies an absolute filename. */
+int
+fn_absolute_p (const char *name)
+{
+#if unix
+ if (name[0] == '/'
+ || !strncmp (name, "./", 2)
+ || !strncmp (name, "../", 3)
+ || name[0] == '~')
+ return 1;
+#elif __MSDOS__
+ if (name[0] == '\\'
+ || !strncmp (name, ".\\", 2)
+ || !strncmp (name, "..\\", 3)
+ || (name[0] && name[1] == ':'))
+ return 1;
+#endif
+
+ return 0;
+}
+
+/* Returns 1 if the filename specified is a virtual file that doesn't
+ really exist on disk, 0 if it's a real filename. */
+int
+fn_special_p (const char *filename)
+{
+ if (!strcmp (filename, "-") || !strcmp (filename, "stdin")
+ || !strcmp (filename, "stdout") || !strcmp (filename, "stderr")
+#if unix
+ || filename[0] == '|'
+ || (*filename && filename[strlen (filename) - 1] == '|')
+#endif
+ )
+ return 1;
+
+ return 0;
+}
+
+/* Returns nonzero if file with name NAME exists. */
+int
+fn_exists_p (const char *name)
+{
+#if unix
+ struct stat temp;
+
+ return stat (name, &temp) == 0;
+#else
+ FILE *f = fopen (name, "r");
+ if (!f)
+ return 0;
+ fclose (f);
+ return 1;
+#endif
+}
+
+#if unix
+/* Stolen from libc.info but heavily modified, this is a wrapper
+ around readlink() that allows for arbitrary filename length. */
+char *
+fn_readlink (const char *filename)
+{
+ int size = 128;
+
+ for (;;)
+ {
+ char *buffer = xmalloc (size);
+ int nchars = readlink (filename, buffer, size);
+ if (nchars == -1)
+ {
+ free (buffer);
+ return NULL;
+ }
+
+ if (nchars < size - 1)
+ {
+ buffer[nchars] = 0;
+ return buffer;
+ }
+ free (buffer);
+ size *= 2;
+ }
+}
+#else /* Not UNIX. */
+char *
+fn_readlink (const char *filename)
+{
+ return NULL;
+}
+#endif /* Not UNIX. */
+\f
+/* Environment variables. */
+
+/* Simulates $VER and $ARCH environment variables. */
+const char *
+fn_getenv (const char *s)
+{
+ if (!strcmp (s, "VER"))
+ return fn_getenv_default ("STAT_VER", bare_version);
+ else if (!strcmp (s, "ARCH"))
+ return fn_getenv_default ("STAT_ARCH", host_system);
+ else
+ return getenv (s);
+}
+
+/* Returns getenv(KEY) if that's non-NULL; else returns DEF. */
+const char *
+fn_getenv_default (const char *key, const char *def)
+{
+ const char *value = getenv (key);
+ return value ? value : def;
+}
+\f
+/* Basic file handling. */
+
+/* Used for giving an error message on a set_safer security
+ violation. */
+static FILE *
+safety_violation (const char *fn)
+{
+ msg (SE, _("Not opening pipe file `%s' because SAFER option set."), fn);
+ errno = EPERM;
+ return NULL;
+}
+
+/* As a general comment on the following routines, a `sensible value'
+ for errno includes 0 if there is no associated system error. The
+ routines will only set errno to 0 if there is an error in a
+ callback that sets errno to 0; they themselves won't. */
+
+/* File open routine that understands `-' as stdin/stdout and `|cmd'
+ as a pipe to command `cmd'. Returns resultant FILE on success,
+ NULL on failure. If NULL is returned then errno is set to a
+ sensible value. */
+FILE *
+fn_open (const char *fn, const char *mode)
+{
+ assert (mode[0] == 'r' || mode[0] == 'w');
+
+ if (mode[0] == 'r' && (!strcmp (fn, "stdin") || !strcmp (fn, "-")))
+ return stdin;
+ else if (mode[0] == 'w' && (!strcmp (fn, "stdout") || !strcmp (fn, "-")))
+ return stdout;
+ else if (mode[0] == 'w' && !strcmp (fn, "stderr"))
+ return stderr;
+
+#if unix
+ if (fn[0] == '|')
+ {
+ if (set_safer)
+ return safety_violation (fn);
+
+ return popen (&fn[1], mode);
+ }
+ else if (*fn && fn[strlen (fn) - 1] == '|')
+ {
+ char *s;
+ FILE *f;
+
+ if (set_safer)
+ return safety_violation (fn);
+
+ s = local_alloc (strlen (fn));
+ memcpy (s, fn, strlen (fn) - 1);
+ s[strlen (fn) - 1] = 0;
+
+ f = popen (s, mode);
+
+ local_free (s);
+
+ return f;
+ }
+ else
+#endif
+ {
+ FILE *f = fopen (fn, mode);
+
+ if (f && mode[0] == 'w')
+ setvbuf (f, NULL, _IOLBF, 0);
+
+ return f;
+ }
+}
+
+/* Counterpart to fn_open that closes file F with name FN; returns 0
+ on success, EOF on failure. If EOF is returned, errno is set to a
+ sensible value. */
+int
+fn_close (const char *fn, FILE *f)
+{
+ if (!strcmp (fn, "-"))
+ return 0;
+#if unix
+ else if (fn[0] == '|' || (*fn && fn[strlen (fn) - 1] == '|'))
+ {
+ pclose (f);
+ return 0;
+ }
+#endif
+ else
+ return fclose (f);
+}
+\f
+/* More extensive file handling. */
+
+/* File open routine that extends fn_open(). Opens or reopens a
+ file according to the contents of file_ext F. Returns nonzero on
+ success. If 0 is returned, errno is set to a sensible value. */
+int
+fn_open_ext (struct file_ext *f)
+{
+ char *p;
+
+ p = strstr (f->filename, "%d");
+ if (p)
+ {
+ char *s = local_alloc (strlen (f->filename) + INT_DIGITS - 1);
+ char *cp;
+
+ memcpy (s, f->filename, p - f->filename);
+ cp = spprintf (&s[p - f->filename], "%d", *f->sequence_no);
+ strcpy (cp, &p[2]);
+
+ if (f->file)
+ {
+ int error = 0;
+
+ if (f->preclose)
+ if (f->preclose (f) == 0)
+ error = errno;
+
+ if (EOF == fn_close (f->filename, f->file) || error)
+ {
+ f->file = NULL;
+ local_free (s);
+
+ if (error)
+ errno = error;
+
+ return 0;
+ }
+
+ f->file = NULL;
+ }
+
+ f->file = fn_open (s, f->mode);
+ local_free (s);
+
+ if (f->file && f->postopen)
+ if (f->postopen (f) == 0)
+ {
+ int error = errno;
+ fn_close (f->filename, f->file);
+ errno = error;
+
+ return 0;
+ }
+
+ return (f->file != NULL);
+ }
+ else if (f->file)
+ return 1;
+ else
+ {
+ f->file = fn_open (f->filename, f->mode);
+
+ if (f->file && f->postopen)
+ if (f->postopen (f) == 0)
+ {
+ int error = errno;
+ fn_close (f->filename, f->file);
+ errno = error;
+
+ return 0;
+ }
+
+ return (f->file != NULL);
+ }
+}
+
+/* Properly closes the file associated with file_ext F, if any.
+ Return nonzero on success. If zero is returned, errno is set to a
+ sensible value. */
+int
+fn_close_ext (struct file_ext *f)
+{
+ if (f->file)
+ {
+ int error = 0;
+
+ if (f->preclose)
+ if (f->preclose (f) == 0)
+ error = errno;
+
+ if (EOF == fn_close (f->filename, f->file) || error)
+ {
+ f->file = NULL;
+
+ if (error)
+ errno = error;
+
+ return 0;
+ }
+
+ f->file = NULL;
+ }
+ return 1;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !filename_h
+#define filename_h 1
+
+#include <stdio.h>
+
+/* Search path for configuration files. */
+extern const char *config_path;
+
+void fn_init (void);
+
+char *fn_interp_vars (const char *input, const char *(*getenv) (const char *));
+char *fn_tilde_expand (const char *fn);
+char *fn_search_path (const char *basename, const char *path,
+ const char *prepend);
+char *fn_prepend_dir (const char *filename, const char *directory);
+char *fn_normalize (const char *fn);
+char *fn_dirname (const char *fn);
+char *fn_basename (const char *fn);
+
+char *fn_get_cwd (void);
+
+int fn_absolute_p (const char *fn);
+int fn_special_p (const char *fn);
+int fn_exists_p (const char *fn);
+char *fn_readlink (const char *fn);
+
+const char *fn_getenv (const char *variable);
+const char *fn_getenv_default (const char *variable, const char *def);
+
+FILE *fn_open (const char *fn, const char *mode);
+int fn_close (const char *fn, FILE *file);
+\f
+/* Extended file routines. */
+struct file_ext;
+
+typedef int (*file_callback) (struct file_ext *);
+
+/* File callbacks may not return zero to indicate failure unless they
+ set errno to a sensible value. */
+struct file_ext
+ {
+ char *filename; /* Filename. */
+ const char *mode; /* Open mode, i.e, "wb". */
+ FILE *file; /* File. */
+ int *sequence_no; /* Page number, etc. */
+ void *param; /* User data. */
+ file_callback postopen; /* Called after FILE opened. */
+ file_callback preclose; /* Called before FILE closed. */
+ };
+
+int fn_open_ext (struct file_ext *file);
+int fn_close_ext (struct file_ext *file);
+
+#endif /* filename_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <ctype.h>
+#include <errno.h>
+#include <float.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "misc.h"
+#include "str.h"
+#include "var.h"
+#include "vfm.h"
+
+/* Variables to transpose. */
+static struct variable **var;
+static int nvar;
+
+/* Variable containing new variable names. */
+static struct variable *newnames;
+
+/* List of variable names. */
+struct varname
+ {
+ struct varname *next;
+ char name[1];
+ };
+
+/* New variable names. */
+static struct varname *new_names_head, *new_names_tail;
+static int case_count;
+
+static int build_dictionary (void);
+
+/* Parses and executes FLIP. */
+int
+cmd_flip (void)
+{
+ lex_match_id ("FLIP");
+ lex_match ('/');
+ if (lex_match_id ("VARIABLES"))
+ {
+ lex_match ('=');
+ if (!parse_variables (&default_dict, &var, &nvar, PV_NO_DUPLICATE))
+ return CMD_FAILURE;
+ lex_match ('/');
+ }
+ else
+ fill_all_vars (&var, &nvar, FV_NO_SYSTEM);
+
+ lex_match ('/');
+ if (lex_match_id ("NEWNAMES"))
+ {
+ lex_match ('=');
+ newnames = parse_variable ();
+ if (!newnames)
+ {
+ free (var);
+ return CMD_FAILURE;
+ }
+ }
+ else
+ newnames = find_variable ("CASE_LBL");
+
+ if (newnames)
+ {
+ int i;
+
+ for (i = 0; i < nvar; i++)
+ if (var[i] == newnames)
+ {
+ memcpy (&var[i], &var[i + 1], sizeof *var * (nvar - i - 1));
+ nvar--;
+ break;
+ }
+ }
+
+ case_count = 0;
+ temp_trns = temporary = 0;
+ vfm_sink = &flip_stream;
+ new_names_tail = NULL;
+ procedure (NULL, NULL, NULL);
+
+ clear_default_dict ();
+ if (!build_dictionary ())
+ {
+ discard_variables ();
+ free (var);
+ return CMD_FAILURE;
+ }
+
+ free (var);
+ return lex_end_of_command ();
+}
+
+/* Make a new variable with base name NAME, which is bowdlerized and
+ mangled until acceptable, and returns success. */
+static int
+make_new_var (char name[])
+{
+ /* Fix invalid characters. */
+ {
+ char *cp;
+
+ for (cp = name; *cp && !isspace (*cp); cp++)
+ {
+ *cp = toupper ((unsigned char) *cp);
+ if (!isalpha (*cp) && *cp != '@' && *cp != '#'
+ && (cp == name || (*cp != '.' && *cp != '$' && *cp != '_')))
+ {
+ if (cp == name)
+ *cp = 'V'; /* _ not valid in first position. */
+ else
+ *cp = '_';
+ }
+ }
+ *cp = 0;
+ }
+
+ if (create_variable (&default_dict, name, NUMERIC, 0))
+ return 1;
+
+ /* Add numeric extensions until acceptable. */
+ {
+ int len = (int) strlen (name);
+ char n[9];
+ int i;
+
+ for (i = 1; i < 10000000; i++)
+ {
+ int ofs = min (7 - intlog10 (i), len);
+ memcpy (n, name, ofs);
+ sprintf (&n[ofs], "%d", i);
+
+ if (create_variable (&default_dict, n, NUMERIC, 0))
+ return 1;
+ }
+ }
+
+ msg (SE, _("Could not create acceptable variant for variable %s."), name);
+ return 0;
+}
+
+/* Make a new dictionary for all the new variable names. */
+static int
+build_dictionary (void)
+{
+ force_create_variable (&default_dict, "CASE_LBL", ALPHA, 8);
+
+ if (!new_names_tail)
+ {
+ int i;
+
+ if (case_count > 99999)
+ {
+ msg (SE, _("Cannot create more than 99999 variable names."));
+ return 0;
+ }
+
+ for (i = 0; i < case_count; i++)
+ {
+ char s[9];
+
+ sprintf (s, "VAR%03d", i);
+ force_create_variable (&default_dict, s, NUMERIC, 0);
+ }
+ }
+ else
+ {
+ struct varname *v, *n;
+
+ new_names_tail->next = NULL;
+ for (v = new_names_head; v; v = n)
+ {
+ n = v->next;
+ if (!make_new_var (v->name))
+ {
+ for (; v; v = n)
+ {
+ n = v->next;
+ free (v);
+ }
+ return 0;
+ }
+ free (v);
+ }
+ }
+
+ return 1;
+}
+
+
+/* Each case to be transposed. */
+struct flip_case
+ {
+ struct flip_case *next;
+ double v[1];
+ };
+
+/* Sink: Cases during transposition. */
+static int internal; /* Internal vs. external flipping. */
+static char *sink_old_names; /* Old variable names. */
+static unsigned long sink_cases; /* Number of cases. */
+static struct flip_case *head, *tail; /* internal == 1: Cases. */
+static FILE *sink_file; /* internal == 0: Temporary file. */
+
+/* Source: Cases after transposition. */
+static struct flip_case *src; /* Internal transposition records. */
+static char *src_old_names; /* Old variable names. */
+static unsigned long src_cases; /* Number of cases. */
+static FILE *src_file; /* src == NULL: Temporary file. */
+
+/* Initialize the FLIP stream. */
+static void
+flip_stream_init (void)
+{
+ internal = 1;
+ sink_cases = 0;
+ tail = NULL;
+
+ {
+ size_t n = nvar;
+ char *p;
+ int i;
+
+ for (i = 0; i < nvar; i++)
+ n += strlen (var[i]->name);
+ p = sink_old_names = xmalloc (n);
+ for (i = 0; i < nvar; i++)
+ p = stpcpy (p, var[i]->name) + 1;
+ }
+}
+
+/* Reads the FLIP stream and passes it to write_case(). */
+static void
+flip_stream_read (void)
+{
+ if (src || (src == NULL && src_file == NULL))
+ {
+ /* Internal transposition, or empty file. */
+ int i, j;
+ char *p = src_old_names;
+
+ for (i = 0; i < nvar; i++)
+ {
+ struct flip_case *iter;
+
+ st_bare_pad_copy (temp_case->data[0].s, p, 8);
+ p = strchr (p, 0) + 1;
+
+ for (iter = src, j = 1; iter; iter = iter->next, j++)
+ temp_case->data[j].f = iter->v[i];
+
+ if (!write_case ())
+ return;
+ }
+ }
+ else
+ {
+ int i;
+ char *p = src_old_names;
+
+ for (i = 0; i < nvar; i++)
+ {
+ st_bare_pad_copy (temp_case->data[0].s, p, 8);
+ p = strchr (p, 0) + 1;
+
+ if (fread (&temp_case->data[1], sizeof (double), src_cases,
+ src_file) != src_cases)
+ msg (FE, _("Error reading FLIP source file: %s."),
+ strerror (errno));
+
+ if (!write_case ())
+ return;
+ }
+ }
+}
+
+/* Writes temp_case to the FLIP stream. */
+static void
+flip_stream_write (void)
+{
+ sink_cases++;
+
+ if (newnames)
+ {
+ struct varname *v;
+ char name[INT_DIGITS + 2];
+
+ if (newnames->type == NUMERIC)
+ sprintf (name, "V%d", (int) temp_case->data[newnames->fv].f);
+ else
+ {
+ int width = min (newnames->width, 8);
+ memcpy (name, temp_case->data[newnames->fv].s, width);
+ name[width] = 0;
+ }
+
+ v = xmalloc (sizeof (struct varname) + strlen (name) - 1);
+ strcpy (v->name, name);
+
+ if (new_names_tail == NULL)
+ new_names_head = v;
+ else
+ new_names_tail->next = v;
+ new_names_tail = v;
+ }
+ else
+ case_count++;
+
+ if (internal)
+ {
+#if 0
+ flip_case *c = malloc (sizeof (flip_case)
+ + sizeof (double) * (nvar - 1));
+
+ if (c != NULL)
+ {
+ /* Write to internal file. */
+ int i;
+
+ for (i = 0; i < nvar; i++)
+ if (var[i]->type == NUMERIC)
+ c->v[i] = temp_case->data[var[i]->fv].f;
+ else
+ c->v[i] = SYSMIS;
+
+ if (tail == NULL)
+ head = c;
+ else
+ tail->next = c;
+ tail = c;
+
+ return;
+ }
+ else
+#endif
+ {
+ /* Initialize external file. */
+ struct flip_case *iter, *next;
+
+ internal = 0;
+
+ sink_file = tmpfile ();
+ if (!sink_file)
+ msg (FE, _("Could not create temporary file for FLIP."));
+
+ if (tail)
+ tail->next = NULL;
+ for (iter = head; iter; iter = next)
+ {
+ next = iter->next;
+
+ if (fwrite (iter->v, sizeof (double), nvar, sink_file)
+ != (size_t) nvar)
+ msg (FE, _("Error writing FLIP file: %s."),
+ strerror (errno));
+ free (iter);
+ }
+ }
+ }
+
+ /* Write to external file. */
+ {
+ double *d = local_alloc (sizeof *d * nvar);
+ int i;
+
+ for (i = 0; i < nvar; i++)
+ if (var[i]->type == NUMERIC)
+ d[i] = temp_case->data[var[i]->fv].f;
+ else
+ d[i] = SYSMIS;
+
+ if (fwrite (d, sizeof *d, nvar, sink_file) != (size_t) nvar)
+ msg (FE, _("Error writing FLIP file: %s."),
+ strerror (errno));
+
+ local_free (d);
+ }
+}
+
+/* Transpose the external file. */
+static void
+transpose_external_file (void)
+{
+ unsigned long n_cases;
+ unsigned long cur_case;
+ double *case_buf, *temp_buf;
+
+ n_cases = 4 * 1024 * 1024 / ((nvar + 1) * sizeof *case_buf);
+ if (n_cases < 2)
+ n_cases = 2;
+ for (;;)
+ {
+ assert (n_cases >= 2 /* 1 */);
+ case_buf = ((n_cases <= 2 ? xmalloc : (void *(*)(size_t)) malloc)
+ ((nvar + 1) * sizeof *case_buf * n_cases));
+ if (case_buf)
+ break;
+
+ n_cases /= 2;
+ if (n_cases < 2)
+ n_cases = 2;
+ }
+
+ /* A temporary buffer that holds n_cases elements. */
+ temp_buf = &case_buf[nvar * n_cases];
+
+ src_file = tmpfile ();
+ if (!src_file)
+ msg (FE, _("Error creating FLIP source file."));
+
+ if (fseek (sink_file, 0, SEEK_SET) != 0)
+ msg (FE, _("Error rewinding FLIP file: %s."), strerror (errno));
+
+ for (cur_case = 0; cur_case < sink_cases; )
+ {
+ unsigned long read_cases = min (sink_cases - cur_case, n_cases);
+ int i;
+
+ if (read_cases != fread (case_buf, sizeof *case_buf * nvar,
+ read_cases, sink_file))
+ msg (FE, _("Error reading FLIP file: %s."), strerror (errno));
+
+ for (i = 0; i < nvar; i++)
+ {
+ unsigned long j;
+
+ for (j = 0; j < read_cases; j++)
+ temp_buf[j] = case_buf[i + j * nvar];
+
+ if (fseek (src_file,
+ sizeof *case_buf * (cur_case + i * sink_cases),
+ SEEK_SET) != 0)
+ msg (FE, _("Error seeking FLIP source file: %s."),
+ strerror (errno));
+
+ if (fwrite (temp_buf, sizeof *case_buf, read_cases, src_file)
+ != read_cases)
+ msg (FE, _("Error writing FLIP source file: %s."),
+ strerror (errno));
+ }
+
+ cur_case += read_cases;
+ }
+
+ if (fseek (src_file, 0, SEEK_SET) != 0)
+ msg (FE, _("Error rewind FLIP source file: %s."), strerror (errno));
+
+ fclose (sink_file);
+
+ free (case_buf);
+}
+
+/* Change the FLIP stream from sink to source mode. */
+static void
+flip_stream_mode (void)
+{
+ src_cases = sink_cases;
+ src_old_names = sink_old_names;
+ sink_old_names = NULL;
+
+ if (internal)
+ {
+ if (tail)
+ {
+ tail->next = NULL;
+ src = head;
+ }
+ else
+ {
+ src = NULL;
+ src_file = NULL;
+ }
+ }
+ else
+ {
+ src = NULL;
+ transpose_external_file ();
+ }
+}
+
+/* Destroy source's internal data. */
+static void
+flip_stream_destroy_source (void)
+{
+ free (src_old_names);
+ if (internal)
+ {
+ struct flip_case *iter, *next;
+
+ for (iter = src; iter; iter = next)
+ {
+ next = iter->next;
+ free (iter);
+ }
+ }
+ else
+ fclose (src_file);
+}
+
+/* Destroy sink's internal data. */
+static void
+flip_stream_destroy_sink (void)
+{
+ struct flip_case *iter, *next;
+
+ free (sink_old_names);
+ if (tail == NULL)
+ return;
+
+ tail->next = NULL;
+ for (iter = head; iter; iter = next)
+ {
+ next = iter->next;
+ free (iter);
+ }
+}
+
+struct case_stream flip_stream =
+ {
+ flip_stream_init,
+ flip_stream_read,
+ flip_stream_write,
+ flip_stream_mode,
+ flip_stream_destroy_source,
+ flip_stream_destroy_sink,
+ "FLIP",
+ };
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !font_h
+#define font_h 1
+
+/* Possible ligatures. */
+#define LIG_ff 001
+#define LIG_ffi 002
+#define LIG_ffl 004
+#define LIG_fi 010
+#define LIG_fl 020
+
+/* Character type constants. */
+#define CTYP_NONE 000 /* Neither ascenders nor descenders. */
+#define CTYP_ASCENDER 001 /* Character has an ascender. */
+#define CTYP_DESCENDER 002 /* Character has a descender. */
+
+/* Font metrics for a single character. */
+struct char_metrics
+ {
+ int code; /* Character code. */
+ int type; /* CTYP_* constants. */
+ int width; /* Width. */
+ int height; /* Height above baseline, never negative. */
+ int depth; /* Depth below baseline, never negative. */
+
+ /* These fields are not yet used, so to save memory, they are left
+ out. */
+#if 0
+ int italic_correction; /* Italic correction. */
+ int left_italic_correction; /* Left italic correction. */
+ int subscript_correction; /* Subscript correction. */
+#endif
+ };
+
+/* Kerning for a pair of characters. */
+struct kern_pair
+ {
+ int ch1; /* First character. */
+ int ch2; /* Second character. */
+ int adjust; /* Kern amount. */
+ };
+
+/* Font description. */
+struct font_desc
+ {
+ /* Housekeeping data. */
+ struct pool *owner; /* Containing pool. */
+ char *name; /* Font name. FIXME: this field's
+ role is uncertain. */
+ char *filename; /* Normalized filename. */
+
+ /* PostScript-specific courtesy data. */
+ char *internal_name; /* Font internal name. */
+ char *encoding; /* Name of encoding file. */
+
+ /* Basic font characteristics. */
+ int space_width; /* Width of a space character. */
+ double slant; /* Slant angle, in degrees of forward slant. */
+ unsigned ligatures; /* Characters that have ligatures. */
+ int special; /* 1=This is a special font that will be
+ searched when a character is not present in
+ another font. */
+ int ascent, descent; /* Height above, below the baseline. */
+
+ /* First dereferencing level is font_char_name_to_index(NAME). */
+ /* Second dereferencing level. */
+ short *deref; /* Each entry is an index into metric.
+ metric[deref[lookup(NAME)]] is the metric
+ for character with name NAME. */
+ int deref_size; /* Number of spaces for entries in deref. */
+
+ /* Third dereferencing level. */
+ struct char_metrics **metric; /* Metrics for font characters. */
+ int metric_size; /* Number of spaces for entries in metric. */
+ int metric_used; /* Number of spaces used in metric. */
+
+ /* Kern pairs. */
+ struct kern_pair *kern; /* Hash table for kerns. */
+ int kern_size; /* Number of spaces for kerns in kern. */
+ int *kern_size_p; /* Next larger hash table size. */
+ int kern_used; /* Number of used spaces in kern. */
+ int kern_max_used; /* Max number used before rehashing. */
+ };
+
+/* Index into deref[] of character with name "space". */
+extern int space_index;
+
+/* A set of fonts. */
+struct font_set
+ {
+ struct font_set *next, *prev; /* Next, previous in chain. */
+ struct font_desc *font; /* Current font. */
+ };
+
+/* Functions to work with any font. */
+#define destroy_font(FONT) \
+ pool_destroy (FONT->owner)
+
+int font_char_name_to_index (const char *);
+struct char_metrics *font_get_char_metrics (const struct font_desc *font,
+ int ch);
+int font_get_kern_adjust (const struct font_desc *font, int ch1, int ch2);
+
+/* groff fonts. */
+struct groff_device_info
+ {
+ /* See groff_font(5). */
+ int res, horiz, vert;
+ int size_scale, unit_width;
+ int (*sizes)[2], n_sizes;
+ char *font_name[4]; /* Names of 4 default fonts. */
+ char *family; /* Name of default font family. */
+ };
+
+struct outp_driver;
+struct font_desc *groff_read_font (const char *fn);
+struct font_desc *groff_find_font (const char *dev, const char *name);
+int groff_read_DESC (const char *dev_name, struct groff_device_info * dev);
+void groff_init (void);
+
+struct font_desc *default_font (void);
+
+#endif /* font_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+
+#include <ctype.h>
+#include <assert.h>
+#include <stdlib.h>
+#include "error.h"
+#include "format.h"
+#include "lexer.h"
+#include "misc.h"
+#include "str.h"
+
+#define DEFFMT(LABEL, NAME, N_ARGS, IMIN_W, IMAX_W, OMIN_W, OMAX_W, CAT, \
+ OUTPUT, SPSS_FMT) \
+ {NAME, N_ARGS, IMIN_W, IMAX_W, OMIN_W, OMAX_W, CAT, OUTPUT, SPSS_FMT},
+struct fmt_desc formats[FMT_NUMBER_OF_FORMATS + 1] =
+{
+#include "format.def"
+ {"", -1, -1, -1, -1, -1, 0000, -1, -1},
+};
+
+const int translate_fmt[40] =
+ {
+ -1, FMT_A, FMT_AHEX, FMT_COMMA, FMT_DOLLAR, FMT_F, FMT_IB,
+ FMT_PIBHEX, FMT_P, FMT_PIB, FMT_PK, FMT_RB, FMT_RBHEX, -1,
+ -1, FMT_Z, FMT_N, FMT_E, -1, -1, FMT_DATE, FMT_TIME,
+ FMT_DATETIME, FMT_ADATE, FMT_JDATE, FMT_DTIME, FMT_WKDAY,
+ FMT_MONTH, FMT_MOYR, FMT_QYR, FMT_WKYR, FMT_PCT, FMT_DOT,
+ FMT_CCA, FMT_CCB, FMT_CCC, FMT_CCD, FMT_CCE, FMT_EDATE,
+ FMT_SDATE,
+ };
+
+int
+parse_format_specifier_name (const char **cp, int allow_xt)
+{
+ struct fmt_desc *f;
+ char *ep;
+ int x;
+
+ ep = ds_value (&tokstr);
+ while (isalpha ((unsigned char) *ep))
+ ep++;
+ x = *ep;
+ *ep = 0;
+
+ for (f = formats; f->name[0]; f++)
+ if (!strcmp (f->name, ds_value (&tokstr)))
+ {
+ int indx = f - formats;
+
+ *ep = x;
+ if (cp)
+ *cp = ep;
+
+ if (!allow_xt && (indx == FMT_T || indx == FMT_X))
+ {
+ msg (SE, _("X and T format specifiers not allowed here."));
+ return -1;
+ }
+ return indx;
+ }
+
+ msg (SE, _("%s is not a valid data format."), ds_value (&tokstr));
+ *ep = x;
+ return -1;
+}
+
+/* Converts F to its string representation (for instance, "F8.2") and
+ returns a pointer to a static buffer containing that string. */
+char *
+fmt_to_string (const struct fmt_spec *f)
+{
+ static char buf[32];
+
+ if (formats[f->type].n_args >= 2)
+ sprintf (buf, "%s%d.%d", formats[f->type].name, f->w, f->d);
+ else
+ sprintf (buf, "%s%d", formats[f->type].name, f->w);
+ return buf;
+}
+
+int
+check_input_specifier (const struct fmt_spec *spec)
+{
+ struct fmt_desc *f;
+ char *str;
+
+ f = &formats[spec->type];
+ str = fmt_to_string (spec);
+ if (spec->type == FMT_X)
+ return 1;
+ if (f->cat & FCAT_OUTPUT_ONLY)
+ {
+ msg (SE, _("Format %s may not be used as an input format."), f->name);
+ return 0;
+ }
+ if (spec->w < f->Imin_w || spec->w > f->Imax_w)
+ {
+ msg (SE, _("Input format %s specifies a bad width %d. "
+ "Format %s requires a width between %d and %d."),
+ str, spec->w, f->name, f->Imin_w, f->Imax_w);
+ return 0;
+ }
+ if ((f->cat & FCAT_EVEN_WIDTH) && spec->w % 2)
+ {
+ msg (SE, _("Input format %s specifies an odd width %d, but "
+ "format %s requires an even width between %d and "
+ "%d."), str, spec->w, f->name, f->Imin_w, f->Imax_w);
+ return 0;
+ }
+ if (f->n_args > 1 && (spec->d < 0 || spec->d > 16))
+ {
+ msg (SE, _("Input format %s specifies a bad number of "
+ "implied decimal places %d. Input format %s allows "
+ "up to 16 implied decimal places."), str, spec->d, f->name);
+ return 0;
+ }
+ return 1;
+}
+
+int
+check_output_specifier (const struct fmt_spec *spec)
+{
+ struct fmt_desc *f;
+ char *str;
+
+ f = &formats[spec->type];
+ str = fmt_to_string (spec);
+ if (spec->type == FMT_X)
+ return 1;
+ if (spec->w < f->Omin_w || spec->w > f->Omax_w)
+ {
+ msg (SE, _("Output format %s specifies a bad width %d. "
+ "Format %s requires a width between %d and %d."),
+ str, spec->w, f->name, f->Omin_w, f->Omax_w);
+ return 0;
+ }
+ if (spec->d > 1
+ && (spec->type == FMT_F || spec->type == FMT_COMMA
+ || spec->type == FMT_DOLLAR)
+ && spec->w < f->Omin_w + 1 + spec->d)
+ {
+ msg (SE, _("Output format %s requires minimum width %d to allow "
+ "%d decimal places. Try %s%d.%d instead of %s."),
+ f->name, f->Omin_w + 1 + spec->d, spec->d, f->name,
+ f->Omin_w + 1 + spec->d, spec->d, str);
+ return 0;
+ }
+ if ((f->cat & FCAT_EVEN_WIDTH) && spec->w % 2)
+ {
+ msg (SE, _("Output format %s specifies an odd width %d, but "
+ "output format %s requires an even width between %d and "
+ "%d."), str, spec->w, f->name, f->Omin_w, f->Omax_w);
+ return 0;
+ }
+ if (f->n_args > 1 && (spec->d < 0 || spec->d > 16))
+ {
+ msg (SE, _("Output format %s specifies a bad number of "
+ "implied decimal places %d. Output format %s allows "
+ "a number of implied decimal places between 1 "
+ "and 16."), str, spec->d, f->name);
+ return 0;
+ }
+ return 1;
+}
+
+/* If a string variable has width W, you can't display it with a
+ format specifier with a required width MIN_LEN>W. */
+int
+check_string_specifier (const struct fmt_spec *f, int min_len)
+{
+ if ((f->type == FMT_A && min_len > f->w)
+ || (f->type == FMT_AHEX && min_len * 2 > f->w))
+ {
+ msg (SE, _("Can't display a string variable of width %d with "
+ "format specifier %s."), min_len, fmt_to_string (f));
+ return 0;
+ }
+ return 1;
+}
+
+void
+convert_fmt_ItoO (const struct fmt_spec *input, struct fmt_spec *output)
+{
+ output->type = formats[input->type].output;
+ output->w = input->w;
+ if (output->w > formats[output->type].Omax_w)
+ output->w = formats[output->type].Omax_w;
+ output->d = input->d;
+
+ switch (input->type)
+ {
+ case FMT_F:
+ case FMT_N:
+ if (output->d > 1 && output->w < 2 + output->d)
+ output->w = 2 + output->d;
+ break;
+ case FMT_E:
+ output->w = max (max (input->w, input->d+7), 10);
+ output->d = max (input->d, 3);
+ break;
+ case FMT_COMMA:
+ case FMT_DOT:
+ /* nothing is necessary */
+ break;
+ case FMT_DOLLAR:
+ case FMT_PCT:
+ if (output->w < 2)
+ output->w = 2;
+ break;
+ case FMT_PIBHEX:
+ {
+ static const int map[] = {4, 6, 9, 11, 14, 16, 18, 21};
+ assert (input->w % 2 == 0 && input->w >= 2 && input->w <= 16);
+ output->w = map[input->w / 2 - 1];
+ break;
+ }
+ case FMT_RBHEX:
+ output->w = 8, output->d = 2; /* FIXME */
+ break;
+ case FMT_IB:
+ case FMT_PIB:
+ case FMT_P:
+ case FMT_PK:
+ case FMT_RB:
+ if (input->d < 1)
+ output->w = 8, output->d = 2;
+ else
+ output->w = 9 + input->d;
+ break;
+ case FMT_CCA:
+ case FMT_CCB:
+ case FMT_CCC:
+ case FMT_CCD:
+ case FMT_CCE:
+ assert (0);
+ case FMT_Z:
+ case FMT_A:
+ /* nothing is necessary */
+ break;
+ case FMT_AHEX:
+ output->w = input->w / 2;
+ break;
+ case FMT_DATE:
+ case FMT_EDATE:
+ case FMT_SDATE:
+ case FMT_ADATE:
+ case FMT_JDATE:
+ /* nothing is necessary */
+ break;
+ case FMT_QYR:
+ if (output->w < 6)
+ output->w = 6;
+ break;
+ case FMT_MOYR:
+ /* nothing is necessary */
+ break;
+ case FMT_WKYR:
+ if (output->w < 8)
+ output->w = 8;
+ break;
+ case FMT_TIME:
+ case FMT_DTIME:
+ case FMT_DATETIME:
+ case FMT_WKDAY:
+ case FMT_MONTH:
+ /* nothing is necessary */
+ break;
+ default:
+ assert (0);
+ }
+}
+
+int
+parse_format_specifier (struct fmt_spec *input, int allow_xt)
+{
+ struct fmt_spec spec;
+ struct fmt_desc *f;
+ const char *cp;
+ char *cp2;
+ int type, w, d;
+
+ if (token != T_ID)
+ {
+ msg (SE, _("Format specifier expected."));
+ return 0;
+ }
+ type = parse_format_specifier_name (&cp, allow_xt);
+ if (type == -1)
+ return 0;
+ f = &formats[type];
+
+ w = strtol (cp, &cp2, 10);
+ if (cp2 == cp && type != FMT_X)
+ {
+ msg (SE, _("Data format %s does not specify a width."),
+ ds_value (&tokstr));
+ return 0;
+ }
+
+ cp = cp2;
+ if (f->n_args > 1 && *cp == '.')
+ {
+ cp++;
+ d = strtol (cp, &cp2, 10);
+ cp = cp2;
+ }
+ else
+ d = 0;
+
+ if (*cp)
+ {
+ msg (SE, _("Data format %s is not valid."), ds_value (&tokstr));
+ return 0;
+ }
+ lex_get ();
+
+ spec.type = type;
+ spec.w = w;
+ spec.d = d;
+ *input = spec;
+
+ return 1;
+}
+
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* Numeric and string formats. */
+DEFFMT (FMT_F, "F", 2, 1, 40, 1, 40, 0001, FMT_F, 5)
+DEFFMT (FMT_N, "N", 2, 1, 40, 1, 40, 0011, FMT_F, 16)
+DEFFMT (FMT_E, "E", 2, 1, 40, 6, 40, 0001, FMT_E, 17)
+DEFFMT (FMT_COMMA, "COMMA", 2, 1, 40, 1, 40, 0001, FMT_COMMA, 3)
+DEFFMT (FMT_DOT, "DOT", 2, 1, 40, 1, 40, 0001, FMT_DOT, 32)
+DEFFMT (FMT_DOLLAR, "DOLLAR", 2, 1, 40, 2, 40, 0001, FMT_DOLLAR, 4)
+DEFFMT (FMT_PCT, "PCT", 2, 1, 40, 2, 40, 0001, FMT_PCT, 31)
+DEFFMT (FMT_Z, "Z", 2, 1, 40, 1, 40, 0011, FMT_F, 15)
+DEFFMT (FMT_A, "A", 1, 1, 255, 1, 254, 0004, FMT_A, 1)
+DEFFMT (FMT_AHEX, "AHEX", 1, 2, 254, 2, 510, 0006, FMT_A, 2)
+DEFFMT (FMT_IB, "IB", 2, 1, 8, 1, 8, 0010, FMT_F, 6)
+DEFFMT (FMT_P, "P", 2, 1, 16, 1, 16, 0011, FMT_F, 8)
+DEFFMT (FMT_PIB, "PIB", 2, 1, 8, 1, 8, 0010, FMT_F, 9)
+DEFFMT (FMT_PIBHEX, "PIBHEX", 2, 2, 16, 2, 16, 0002, FMT_F, 7)
+DEFFMT (FMT_PK, "PK", 2, 1, 16, 1, 16, 0010, FMT_F, 10)
+DEFFMT (FMT_RB, "RB", 1, 2, 8, 2, 8, 0002, FMT_F, 11)
+DEFFMT (FMT_RBHEX, "RBHEX", 1, 4, 16, 4, 16, 0002, FMT_F, 12)
+
+/* Custom currency. */
+DEFFMT (FMT_CCA, "CCA", 2, -1, -1, 1, 40, 0020, FMT_CCA, 33)
+DEFFMT (FMT_CCB, "CCB", 2, -1, -1, 1, 40, 0020, FMT_CCB, 34)
+DEFFMT (FMT_CCC, "CCC", 2, -1, -1, 1, 40, 0020, FMT_CCC, 35)
+DEFFMT (FMT_CCD, "CCD", 2, -1, -1, 1, 40, 0020, FMT_CCD, 36)
+DEFFMT (FMT_CCE, "CCE", 2, -1, -1, 1, 40, 0020, FMT_CCE, 37)
+
+/* Date/time formats. */
+DEFFMT (FMT_DATE, "DATE", 1, 9, 40, 9, 40, 0001, FMT_DATE, 20)
+DEFFMT (FMT_EDATE, "EDATE", 1, 8, 40, 8, 40, 0001, FMT_EDATE, 23)
+DEFFMT (FMT_SDATE, "SDATE", 1, 8, 40, 8, 40, 0001, FMT_SDATE, 24)
+DEFFMT (FMT_ADATE, "ADATE", 1, 8, 40, 8, 40, 0001, FMT_ADATE, 29)
+DEFFMT (FMT_JDATE, "JDATE", 1, 5, 40, 5, 40, 0001, FMT_JDATE, 28)
+DEFFMT (FMT_QYR, "QYR", 1, 4, 40, 6, 40, 0001, FMT_QYR, 30)
+DEFFMT (FMT_MOYR, "MOYR", 1, 6, 40, 6, 40, 0001, FMT_MOYR, 22)
+DEFFMT (FMT_WKYR, "WKYR", 1, 6, 40, 8, 40, 0001, FMT_WKYR, 21)
+DEFFMT (FMT_DATETIME, "DATETIME", 2, 17, 40, 17, 40, 0001, FMT_DATETIME, 38)
+DEFFMT (FMT_TIME, "TIME", 2, 5, 40, 5, 40, 0001, FMT_TIME, 39)
+DEFFMT (FMT_DTIME, "DTIME", 2, 11, 40, 8, 40, 0001, FMT_DTIME, 25)
+DEFFMT (FMT_WKDAY, "WKDAY", 1, 2, 40, 2, 40, 0001, FMT_WKDAY, 26)
+DEFFMT (FMT_MONTH, "MONTH", 1, 3, 40, 3, 40, 0001, FMT_MONTH, 27)
+
+/* These aren't real formats. They're used by DATA LIST. */
+DEFFMT (FMT_T, "T", 1, 1,99999, 1,99999, 0000, FMT_T, -1)
+DEFFMT (FMT_X, "X", 1, 1,99999, 1,99999, 0000, FMT_X, -1)
+DEFFMT (FMT_DESCEND, "***", 1, 1,99999, 1,99999, 0000, -1, -1)
+DEFFMT (FMT_NEWREC, "***", 1, 1,99999, 1,99999, 0000, -1, -1)
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !format_h
+#define format_h 1
+
+/* Display format types. */
+/* See the definitions of these functions and variables when modifying
+ this list:
+ misc.c:convert_fmt_ItoO()
+ sfm-read.c:parse_format_spec()
+ data-in.c:parse_string_as_format()
+ data-out.c:convert_format_to_string(). */
+#define DEFFMT(LABEL, NAME, N_ARGS, IMIN_W, IMAX_W, OMIN_W, OMAX_W, \
+ CAT, OUTPUT, SPSS_FMT) \
+ LABEL,
+enum
+ {
+#include "format.def"
+ FMT_NUMBER_OF_FORMATS
+ };
+#undef DEFFMT
+
+/* Describes one of the display formats above. */
+struct fmt_desc
+ {
+ char name[9]; /* `DATETIME' is the longest name. */
+ int n_args; /* 1=width; 2=width.decimals. */
+ int Imin_w, Imax_w; /* Bounds on input width. */
+ int Omin_w, Omax_w; /* Bounds on output width. */
+ int cat; /* Categories. */
+ int output; /* Output format. */
+ int spss; /* Equivalent SPSS output format. */
+ };
+
+/* Display format categories. */
+enum
+ {
+ FCAT_BLANKS_SYSMIS = 001, /* 1=All-whitespace means SYSMIS. */
+ FCAT_EVEN_WIDTH = 002, /* 1=Width must be even. */
+ FCAT_STRING = 004, /* 1=String input/output format. */
+ FCAT_SHIFT_DECIMAL = 010, /* 1=Automatically shift decimal point
+ on output--used for fixed-point
+ formats. */
+ FCAT_OUTPUT_ONLY = 020 /* 1=This is not an input format. */
+ };
+
+/* Display format. */
+struct fmt_spec
+ {
+ int type; /* One of the above constants. */
+ int w; /* Width. */
+ int d; /* Number of implied decimal places. */
+ };
+
+/* Descriptions of all the display formats above. */
+extern struct fmt_desc formats[];
+
+/* Translates SPSS formats to PSPP formats. */
+extern const int translate_fmt[40];
+
+union value;
+
+int parse_format_specifier (struct fmt_spec *input, int allow_xt);
+int parse_format_specifier_name (const char **cp, int allow_xt);
+int check_input_specifier (const struct fmt_spec *spec);
+int check_output_specifier (const struct fmt_spec *spec);
+int check_string_specifier (const struct fmt_spec *spec, int min_len);
+void convert_fmt_ItoO (const struct fmt_spec *input, struct fmt_spec *output);
+int parse_string_as_format (const char *s, int len, const struct fmt_spec *fp,
+ int fc, union value *v);
+int data_out (char *s, const struct fmt_spec *fp, const union value *v);
+char *fmt_to_string (const struct fmt_spec *);
+void num_to_string (double v, char *s, int w, int d);
+
+#endif /* !format_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <limits.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "misc.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+#if DEBUGGING
+static void debug_print (void);
+#endif
+
+enum
+ {
+ FORMATS_PRINT = 001,
+ FORMATS_WRITE = 002
+ };
+
+static int internal_cmd_formats (int);
+
+int
+cmd_print_formats (void)
+{
+ lex_match_id ("FORMATS");
+ return internal_cmd_formats (FORMATS_PRINT);
+}
+
+int
+cmd_write_formats (void)
+{
+ lex_match_id ("FORMATS");
+ return internal_cmd_formats (FORMATS_WRITE);
+}
+
+int
+cmd_formats (void)
+{
+ lex_match_id ("FORMATS");
+ return internal_cmd_formats (FORMATS_PRINT | FORMATS_WRITE);
+}
+
+int
+internal_cmd_formats (int which)
+{
+ /* Variables. */
+ struct variable **v;
+ int cv;
+
+ /* Format to set the variables to. */
+ struct fmt_spec f;
+
+ /* Numeric or string. */
+ int type;
+
+ /* Counter. */
+ int i;
+
+ for (;;)
+ {
+ if (token == '.')
+ break;
+
+ if (!parse_variables (NULL, &v, &cv, PV_SAME_TYPE))
+ return CMD_PART_SUCCESS_MAYBE;
+ type = v[0]->type;
+
+ if (!lex_match ('('))
+ {
+ msg (SE, _("`(' expected after variable list"));
+ goto fail;
+ }
+ if (!parse_format_specifier (&f, 0) || !check_output_specifier (&f))
+ goto fail;
+
+ /* Catch type mismatch errors. */
+ if ((type == ALPHA) ^ (0 != (formats[f.type].cat & FCAT_STRING)))
+ {
+ msg (SE, _("Format %s may not be assigned to a %s variable."),
+ fmt_to_string (&f), type == NUMERIC ? _("numeric") : _("string"));
+ goto fail;
+ }
+
+ /* This is an additional check for string variables. We can't
+ let the user specify an A8 format for a string variable with
+ width 4. */
+ if (type == ALPHA)
+ {
+ /* Shortest string so far. */
+ int min_len = INT_MAX;
+
+ for (i = 0; i < cv; i++)
+ min_len = min (min_len, v[i]->width);
+ if (!check_string_specifier (&f, min_len))
+ goto fail;
+ }
+
+ if (!lex_match (')'))
+ {
+ msg (SE, _("`)' expected after output format."));
+ goto fail;
+ }
+
+ for (i = 0; i < cv; i++)
+ {
+ if (which & FORMATS_PRINT)
+ v[i]->print = f;
+ if (which & FORMATS_WRITE)
+ v[i]->write = f;
+ }
+ free (v);
+ v = NULL;
+ }
+#if DEBUGGING
+ debug_print ();
+#endif
+ return CMD_SUCCESS;
+
+fail:
+ free (v);
+ return CMD_PART_SUCCESS_MAYBE;
+}
+
+#if DEBUGGING
+static void
+debug_print (void)
+{
+ int i;
+
+ printf (_("Formats:\n"));
+ printf (_(" Name Print Write\n"));
+ printf (" -------- ------------ ------------\n");
+ for (i = 0; i < default_dict.nvar; i++)
+ {
+ struct variable *v = default_dict.var[i];
+ printf (" %-8s %-12s", v->name, fmt_to_string (&v->print));
+ printf (" %-12s\n", fmt_to_string (&v->write));
+ }
+}
+#endif /* DEBUGGING */
--- /dev/null
+/* PSPP - computes sample statistics. -*- C -*-
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* Included by frequencies.q. */
+
+#if WEIGHTING
+ #define WEIGHT w
+ #define FUNCNAME calc_weighting
+#else /* !WEIGHTING */
+ #define WEIGHT 1.0
+ #define FUNCNAME calc_no_weight
+#endif /* !WEIGHTING */
+
+static int
+FUNCNAME (struct ccase *c)
+{
+ int i;
+#if WEIGHTING
+ double w;
+
+ w = c->data[default_dict.var[default_dict.weight_index]->fv].f;
+#endif
+
+ for (i = 0; i < n_variables; i++)
+ {
+ struct variable *v = v_variables[i];
+ union value *val = &c->data[v->fv];
+ struct freq_tab *ft = &v->p.frq.tab;
+
+ switch (v->p.frq.tab.mode)
+ {
+ case FRQM_GENERAL:
+ {
+ /* General mode. This declaration and initialization are
+ strictly conforming: see C89 section 6.5.2.1. */
+ struct freq *fp = avl_find (ft->tree, (struct freq *) val);
+
+ if (fp)
+ fp->c += WEIGHT;
+ else
+ {
+ fp = pool_alloc (gen_pool, sizeof *fp);
+ fp->v = *val;
+ fp->c = WEIGHT;
+ avl_insert (ft->tree, fp);
+ if (is_missing (val, v))
+ v->p.frq.tab.n_missing++;
+ }
+ }
+ break;
+ case FRQM_INTEGER:
+ /* Integer mode. */
+ if (val->f == SYSMIS)
+ v->p.frq.tab.sysmis += WEIGHT;
+ else if (val->f > INT_MIN+1 && val->f < INT_MAX-1)
+ {
+ int i = val->f;
+ if (i >= v->p.frq.tab.min && i <= v->p.frq.tab.max)
+ v->p.frq.tab.vector[i - v->p.frq.tab.min] += WEIGHT;
+ }
+ else
+ v->p.frq.tab.out_of_range += WEIGHT;
+ break;
+ default:
+ assert (0);
+ }
+ }
+ return 1;
+}
+
+#undef WEIGHT
+#undef WEIGHTING
+#undef FUNCNAME
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/*
+ TODO:
+
+ * Remember that histograms, bar charts need mean, stddev.
+*/
+
+#include <config.h>
+#include <assert.h>
+#include <math.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "avl.h"
+#include "bitvector.h"
+#include "hash.h"
+#include "pool.h"
+#include "command.h"
+#include "lexer.h"
+#include "error.h"
+#include "approx.h"
+#include "magic.h"
+#include "misc.h"
+#include "stats.h"
+#include "output.h"
+#include "som.h"
+#include "tab.h"
+#include "var.h"
+#include "vfm.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+
+/* (specification)
+ FREQUENCIES (frq_):
+ *variables=custom;
+ format=cond:condense/onepage(*n:onepage_limit,"%s>=0")/!standard,
+ table:limit(n:limit,"%s>0")/notable/!table,
+ labels:!labels/nolabels,
+ sort:!avalue/dvalue/afreq/dfreq,
+ spaces:!single/double,
+ paging:newpage/!oldpage;
+ missing=miss:include/!exclude;
+ barchart(ba_)=:minimum(d:min),
+ :maximum(d:max),
+ scale:freq(*n:freq,"%s>0")/percent(*n:pcnt,"%s>0");
+ histogram(hi_)=:minimum(d:min),
+ :maximum(d:max),
+ scale:freq(*n:freq,"%s>0")/percent(*n:pcnt,"%s>0"),
+ norm:!nonormal/normal,
+ incr:increment(d:inc,"%s>0");
+ hbar(hb_)=:minimum(d:min),
+ :maximum(d:max),
+ scale:freq(*n:freq,"%s>0")/percent(*n:pcnt,"%s>0"),
+ norm:!nonormal/normal,
+ incr:increment(d:inc,"%s>0");
+ grouped=custom;
+ ntiles=custom;
+ percentiles=custom;
+ statistics[st_]=1|mean,2|semean,3|median,4|mode,5|stddev,6|variance,
+ 7|kurtosis,8|skewness,9|range,10|minimum,11|maximum,12|sum,
+ 13|default,14|seskewness,15|sekurtosis,all,none.
+*/
+/* (declarations) */
+/* (functions) */
+
+/* Description of a statistic. */
+struct frq_info
+ {
+ int st_indx; /* Index into a_statistics[]. */
+ const char *s10; /* Identifying string. */
+ };
+
+/* Table of statistics, indexed by dsc_*. */
+static struct frq_info st_name[frq_n_stats + 1] =
+{
+ {FRQ_ST_MEAN, N_("Mean")},
+ {FRQ_ST_SEMEAN, N_("S.E. Mean")},
+ {FRQ_ST_MEDIAN, N_("Median")},
+ {FRQ_ST_MODE, N_("Mode")},
+ {FRQ_ST_STDDEV, N_("Std Dev")},
+ {FRQ_ST_VARIANCE, N_("Variance")},
+ {FRQ_ST_KURTOSIS, N_("Kurtosis")},
+ {FRQ_ST_SEKURTOSIS, N_("S.E. Kurt")},
+ {FRQ_ST_SKEWNESS, N_("Skewness")},
+ {FRQ_ST_SESKEWNESS, N_("S.E. Skew")},
+ {FRQ_ST_RANGE, N_("Range")},
+ {FRQ_ST_MINIMUM, N_("Minimum")},
+ {FRQ_ST_MAXIMUM, N_("Maximum")},
+ {FRQ_ST_SUM, N_("Sum")},
+ {-1, 0},
+};
+
+/* Percentiles to calculate. */
+static double *percentiles;
+static int n_percentiles;
+
+/* Groups of statistics. */
+#define BI BIT_INDEX
+#define frq_default \
+ (BI (frq_mean) | BI (frq_stddev) | BI (frq_min) | BI (frq_max))
+#define frq_all \
+ (BI (frq_sum) | BI(frq_min) | BI(frq_max) \
+ | BI(frq_mean) | BI(frq_semean) | BI(frq_stddev) \
+ | BI(frq_variance) | BI(frq_kurt) | BI(frq_sekurt) \
+ | BI(frq_skew) | BI(frq_seskew) | BI(frq_range) \
+ | BI(frq_range) | BI(frq_mode) | BI(frq_median))
+
+/* Statistics; number of statistics. */
+static unsigned long stats;
+static int n_stats;
+
+/* Types of graphs. */
+enum
+ {
+ GFT_NONE, /* Don't draw graphs. */
+ GFT_BAR, /* Draw bar charts. */
+ GFT_HIST, /* Draw histograms. */
+ GFT_HBAR /* Draw bar charts or histograms at our discretion. */
+ };
+
+/* Parsed command. */
+static struct cmd_frequencies cmd;
+
+/* Summary of the barchart, histogram, and hbar subcommands. */
+static int chart; /* NONE/BAR/HIST/HBAR. */
+static double min, max; /* Minimum, maximum on y axis. */
+static int format; /* FREQ/PERCENT: Scaling of y axis. */
+static double scale, incr; /* FIXME */
+static int normal; /* FIXME */
+
+/* Variables for which to calculate statistics. */
+static int n_variables;
+static struct variable **v_variables;
+
+/* Arenas used to store semi-permanent storage. */
+static struct pool *int_pool; /* Integer mode. */
+static struct pool *gen_pool; /* General mode. */
+
+/* Easier access to a_statistics. */
+#define stat cmd.a_statistics
+
+static void determine_charts (void);
+
+static void precalc (void);
+static int calc_weighting (struct ccase *);
+static int calc_no_weight (struct ccase *);
+static void postcalc (void);
+
+static void postprocess_freq_tab (struct variable *);
+static void dump_full (struct variable *);
+static void dump_condensed (struct variable *);
+static void dump_statistics (struct variable *, int show_varname);
+static void cleanup_freq_tab (struct variable *);
+
+static int compare_value_numeric_a (const void *, const void *, void *);
+static int compare_value_alpha_a (const void *, const void *, void *);
+static int compare_value_numeric_d (const void *, const void *, void *);
+static int compare_value_alpha_d (const void *, const void *, void *);
+static int compare_freq_numeric_a (const void *, const void *, void *);
+static int compare_freq_alpha_a (const void *, const void *, void *);
+static int compare_freq_numeric_d (const void *, const void *, void *);
+static int compare_freq_alpha_d (const void *, const void *, void *);
+\f
+/* Parser and outline. */
+
+static int internal_cmd_frequencies (void);
+
+int
+cmd_frequencies (void)
+{
+ int result;
+
+ int_pool = pool_create ();
+ result = internal_cmd_frequencies ();
+ pool_destroy (int_pool);
+ pool_destroy (gen_pool);
+ free (v_variables);
+ return result;
+}
+
+static int
+internal_cmd_frequencies (void)
+{
+ int (*calc) (struct ccase *);
+ int i;
+
+ n_percentiles = 0;
+ percentiles = NULL;
+
+ n_variables = 0;
+ v_variables = NULL;
+
+ for (i = 0; i < default_dict.nvar; i++)
+ default_dict.var[i]->foo = 0;
+
+ lex_match_id ("FREQUENCIES");
+ if (!parse_frequencies (&cmd))
+ return CMD_FAILURE;
+
+ if (cmd.onepage_limit == NOT_LONG)
+ cmd.onepage_limit = 50;
+
+ /* Figure out statistics to calculate. */
+ stats = 0;
+ if (stat[FRQ_ST_DEFAULT] || !cmd.sbc_statistics)
+ stats |= frq_default;
+ if (stat[FRQ_ST_ALL])
+ stats |= frq_all;
+ if (cmd.sort != FRQ_AVALUE && cmd.sort != FRQ_DVALUE)
+ stats &= ~frq_median;
+ for (i = 0; i < frq_n_stats; i++)
+ if (stat[st_name[i].st_indx])
+ stats |= BIT_INDEX (i);
+ if (stats & frq_kurt)
+ stats |= frq_sekurt;
+ if (stats & frq_skew)
+ stats |= frq_seskew;
+
+ /* Calculate n_stats. */
+ n_stats = 0;
+ for (i = 0; i < frq_n_stats; i++)
+ if ((stats & BIT_INDEX (i)))
+ n_stats++;
+
+ /* Charting. */
+ determine_charts ();
+ if (chart != GFT_NONE || cmd.sbc_ntiles)
+ cmd.sort = FRQ_AVALUE;
+
+ /* Do it! */
+ update_weighting (&default_dict);
+ calc = default_dict.weight_index == -1 ? calc_no_weight : calc_weighting;
+ procedure (precalc, calc, postcalc);
+
+ return CMD_SUCCESS;
+}
+
+/* Figure out which charts the user requested. */
+static void
+determine_charts (void)
+{
+ int count = (!!cmd.sbc_histogram) + (!!cmd.sbc_barchart) + (!!cmd.sbc_hbar);
+
+ if (!count)
+ {
+ chart = GFT_NONE;
+ return;
+ }
+ else if (count > 1)
+ {
+ chart = GFT_HBAR;
+ msg (SW, _("At most one of BARCHART, HISTOGRAM, or HBAR should be "
+ "given. HBAR will be assumed. Argument values will be "
+ "given precedence increasing along the order given."));
+ }
+ else if (cmd.sbc_histogram)
+ chart = GFT_HIST;
+ else if (cmd.sbc_barchart)
+ chart = GFT_BAR;
+ else
+ chart = GFT_HBAR;
+
+ min = max = SYSMIS;
+ format = FRQ_FREQ;
+ scale = SYSMIS;
+ incr = SYSMIS;
+ normal = 0;
+
+ if (cmd.sbc_barchart)
+ {
+ if (cmd.ba_min != SYSMIS)
+ min = cmd.ba_min;
+ if (cmd.ba_max != SYSMIS)
+ max = cmd.ba_max;
+ if (cmd.ba_scale == FRQ_FREQ)
+ {
+ format = FRQ_FREQ;
+ scale = cmd.ba_freq;
+ }
+ else if (cmd.ba_scale == FRQ_PERCENT)
+ {
+ format = FRQ_PERCENT;
+ scale = cmd.ba_pcnt;
+ }
+ }
+
+ if (cmd.sbc_histogram)
+ {
+ if (cmd.hi_min != SYSMIS)
+ min = cmd.hi_min;
+ if (cmd.hi_max != SYSMIS)
+ max = cmd.hi_max;
+ if (cmd.hi_scale == FRQ_FREQ)
+ {
+ format = FRQ_FREQ;
+ scale = cmd.hi_freq;
+ }
+ else if (cmd.hi_scale == FRQ_PERCENT)
+ {
+ format = FRQ_PERCENT;
+ scale = cmd.ba_pcnt;
+ }
+ if (cmd.hi_norm)
+ normal = 1;
+ if (cmd.hi_incr == FRQ_INCREMENT)
+ incr = cmd.hi_inc;
+ }
+
+ if (cmd.sbc_hbar)
+ {
+ if (cmd.hb_min != SYSMIS)
+ min = cmd.hb_min;
+ if (cmd.hb_max != SYSMIS)
+ max = cmd.hb_max;
+ if (cmd.hb_scale == FRQ_FREQ)
+ {
+ format = FRQ_FREQ;
+ scale = cmd.hb_freq;
+ }
+ else if (cmd.hb_scale == FRQ_PERCENT)
+ {
+ format = FRQ_PERCENT;
+ scale = cmd.ba_pcnt;
+ }
+ if (cmd.hb_norm)
+ normal = 1;
+ if (cmd.hb_incr == FRQ_INCREMENT)
+ incr = cmd.hb_inc;
+ }
+
+ if (min != SYSMIS && max != SYSMIS && min >= max)
+ {
+ msg (SE, _("MAX must be greater than or equal to MIN, if both are "
+ "specified. However, MIN was specified as %g and MAX as %g. "
+ "MIN and MAX will be ignored."), min, max);
+ min = max = SYSMIS;
+ }
+}
+
+/* Generate each calc_*(). */
+#define WEIGHTING 0
+#include "frequencies.g"
+
+#define WEIGHTING 1
+#include "frequencies.g"
+
+/* Prepares each variable that is the target of FREQUENCIES by setting
+ up its hash table. */
+static void
+precalc (void)
+{
+ int i;
+
+ pool_destroy (gen_pool);
+ gen_pool = pool_create ();
+
+ for (i = 0; i < n_variables; i++)
+ {
+ struct variable *v = v_variables[i];
+
+ if (v->p.frq.tab.mode == FRQM_GENERAL)
+ {
+ avl_comparison_func compare;
+ if (v->type == NUMERIC)
+ compare = compare_value_numeric_a;
+ else
+ compare = compare_value_alpha_a;
+ v->p.frq.tab.tree = avl_create (gen_pool, compare,
+ (void *) v->width);
+ v->p.frq.tab.n_missing = 0;
+ }
+ else
+ {
+ int j;
+
+ for (j = (v->p.frq.tab.max - v->p.frq.tab.min); j >= 0; j--)
+ v->p.frq.tab.vector[j] = 0.0;
+ v->p.frq.tab.out_of_range = 0.0;
+ v->p.frq.tab.sysmis = 0.0;
+ }
+ }
+}
+
+/* Finishes up with the variables after frequencies have been
+ calculated. Displays statistics, percentiles, ... */
+static void
+postcalc (void)
+{
+ int i;
+
+ for (i = 0; i < n_variables; i++)
+ {
+ struct variable *v = v_variables[i];
+ int n_categories;
+ int dumped_freq_tab = 1;
+
+ postprocess_freq_tab (v);
+
+ /* Frequencies tables. */
+ n_categories = v->p.frq.tab.n_valid + v->p.frq.tab.n_missing;
+ if (cmd.table == FRQ_TABLE
+ || (cmd.table == FRQ_LIMIT && n_categories <= cmd.limit))
+ switch (cmd.cond)
+ {
+ case FRQ_CONDENSE:
+ dump_condensed (v);
+ break;
+ case FRQ_STANDARD:
+ dump_full (v);
+ break;
+ case FRQ_ONEPAGE:
+ if (n_categories > cmd.onepage_limit)
+ dump_condensed (v);
+ else
+ dump_full (v);
+ break;
+ default:
+ assert (0);
+ }
+ else
+ dumped_freq_tab = 0;
+
+ /* Statistics. */
+ if (n_stats)
+ dump_statistics (v, !dumped_freq_tab);
+
+ cleanup_freq_tab (v);
+ }
+}
+
+/* Comparison function called by comparison_helper(). */
+static avl_comparison_func comparison_func;
+
+/* Passed to comparison function by comparison_helper(). */
+static void *comparison_param;
+
+/* Used by postprocess_freq_tab to re-sort frequency tables. */
+static int
+comparison_helper (const void *a, const void *b)
+{
+ return comparison_func (&((struct freq *) a)->v,
+ &((struct freq *) b)->v, comparison_param);
+}
+
+/* Used by postprocess_freq_tab to construct the array members valid,
+ missing of freq_tab. */
+static void
+add_freq (void *data, void *param)
+{
+ struct freq *f = data;
+ struct variable *v = param;
+
+ v->p.frq.tab.total_cases += f->c;
+
+ if ((v->type == NUMERIC && f->v.f == SYSMIS)
+ || (cmd.miss == FRQ_EXCLUDE && is_user_missing (&f->v, v)))
+ {
+ *v->p.frq.tab.missing++ = *f;
+ v->p.frq.tab.valid_cases -= f->c;
+ }
+ else
+ *v->p.frq.tab.valid++ = *f;
+}
+
+static void
+postprocess_freq_tab (struct variable * v)
+{
+ avl_comparison_func compare;
+
+ switch (cmd.sort | (v->type << 16))
+ {
+ /* Note that q2c generates tags beginning with 1000. */
+ case FRQ_AVALUE | (NUMERIC << 16):
+ compare = NULL;
+ break;
+ case FRQ_AVALUE | (ALPHA << 16):
+ compare = NULL;
+ break;
+ case FRQ_DVALUE | (NUMERIC << 16):
+ comparison_func = compare_value_numeric_d;
+ break;
+ case FRQ_DVALUE | (ALPHA << 16):
+ compare = compare_value_alpha_d;
+ break;
+ case FRQ_AFREQ | (NUMERIC << 16):
+ compare = compare_freq_numeric_a;
+ break;
+ case FRQ_AFREQ | (ALPHA << 16):
+ compare = compare_freq_alpha_a;
+ break;
+ case FRQ_DFREQ | (NUMERIC << 16):
+ compare = compare_freq_numeric_d;
+ break;
+ case FRQ_DFREQ | (ALPHA << 16):
+ compare = compare_freq_alpha_d;
+ break;
+ default:
+ assert (0);
+ }
+ comparison_func = compare;
+
+ if (v->p.frq.tab.mode == FRQM_GENERAL)
+ {
+ int total;
+ struct freq_tab *ft = &v->p.frq.tab;
+
+ total = avl_count (ft->tree);
+ ft->n_valid = total - ft->n_missing;
+ ft->valid = xmalloc (sizeof (struct freq) * total);
+ ft->missing = &ft->valid[ft->n_valid];
+ ft->valid_cases = ft->total_cases = 0.0;
+
+ avl_walk (ft->tree, add_freq, (void *) v);
+
+ ft->valid -= ft->n_valid;
+ ft->missing -= ft->n_missing;
+ ft->valid_cases += ft->total_cases;
+
+ if (compare)
+ {
+ qsort (ft->valid, ft->n_valid, sizeof (struct freq), comparison_helper);
+ qsort (ft->missing, ft->n_missing, sizeof (struct freq), comparison_helper);
+ }
+ }
+ else
+ assert (0);
+}
+
+static void
+cleanup_freq_tab (struct variable * v)
+{
+ if (v->p.frq.tab.mode == FRQM_GENERAL)
+ {
+ struct freq_tab *ft = &v->p.frq.tab;
+
+ free (ft->valid);
+ }
+ else
+ assert (0);
+}
+
+/* Parses the VARIABLES subcommand, adding to
+ {n_variables,v_variables}. */
+static int
+frq_custom_variables (struct cmd_frequencies *cmd unused)
+{
+ int mode;
+ int min, max;
+
+ int old_n_variables = n_variables;
+ int i;
+
+ lex_match ('=');
+ if (token != T_ALL && (token != T_ID || !is_varname (tokid)))
+ return 2;
+
+ if (!parse_variables (NULL, &v_variables, &n_variables,
+ PV_APPEND | PV_NO_SCRATCH))
+ return 0;
+
+ for (i = old_n_variables; i < n_variables; i++)
+ v_variables[i]->p.frq.tab.mode = FRQM_GENERAL;
+
+ if (!lex_match ('('))
+ mode = FRQM_GENERAL;
+ else
+ {
+ mode = FRQM_INTEGER;
+ if (!lex_force_int ())
+ return 0;
+ min = lex_integer ();
+ lex_get ();
+ if (!lex_force_match (','))
+ return 0;
+ if (!lex_force_int ())
+ return 0;
+ max = lex_integer ();
+ lex_get ();
+ if (!lex_force_match (')'))
+ return 0;
+ if (max < min)
+ {
+ msg (SE, _("Upper limit of integer mode value range must be "
+ "greater than lower limit."));
+ return 0;
+ }
+ }
+
+ for (i = old_n_variables; i < n_variables; i++)
+ {
+ struct variable *v = v_variables[i];
+
+ if (v->foo != 0)
+ {
+ msg (SE, _("Variable %s specified multiple times on VARIABLES "
+ "subcommand."), v->name);
+ return 0;
+ }
+
+ v->foo = 1; /* Used simply as a marker. */
+
+ v->p.frq.tab.valid = v->p.frq.tab.missing = NULL;
+
+ if (mode == FRQM_INTEGER)
+ {
+ if (v->type != NUMERIC)
+ {
+ msg (SE, _("Integer mode specified, but %s is not a numeric "
+ "variable."), v->name);
+ return 0;
+ }
+
+ v->p.frq.tab.min = min;
+ v->p.frq.tab.max = max;
+ v->p.frq.tab.vector = pool_alloc (int_pool,
+ sizeof (struct freq) * (max - min + 1));
+ }
+ else
+ v->p.frq.tab.vector = NULL;
+
+ v->p.frq.n_groups = 0;
+ v->p.frq.groups = NULL;
+ }
+ return 1;
+}
+
+/* Parses the GROUPED subcommand, setting the frq.{n_grouped,grouped}
+ fields of specified variables. */
+static int
+frq_custom_grouped (struct cmd_frequencies *cmd unused)
+{
+ lex_match ('=');
+ if ((token == T_ID && is_varname (tokid)) || token == T_ID)
+ for (;;)
+ {
+ int i;
+
+ /* Max, current size of list; list itself. */
+ int nl, ml;
+ double *dl;
+
+ /* Variable list. */
+ int n;
+ struct variable **v;
+
+ if (!parse_variables (NULL, &v, &n, PV_NO_DUPLICATE | PV_NUMERIC))
+ return 0;
+ if (lex_match ('('))
+ {
+ nl = ml = 0;
+ dl = NULL;
+ while (token == T_NUM)
+ {
+ if (nl >= ml)
+ {
+ ml += 16;
+ dl = pool_realloc (int_pool, dl, ml * sizeof (double));
+ }
+ dl[nl++] = tokval;
+ lex_get ();
+ lex_match (',');
+ }
+ /* Note that nl might still be 0 and dl might still be
+ NULL. That's okay. */
+ if (!lex_match (')'))
+ {
+ free (v);
+ msg (SE, _("`)' expected after GROUPED interval list."));
+ return 0;
+ }
+ }
+ else
+ nl = 0;
+
+ for (i = 0; i < n; i++)
+ {
+ if (v[i]->foo == 0)
+ msg (SE, _("Variables %s specified on GROUPED but not on "
+ "VARIABLES."), v[i]->name);
+ if (v[i]->p.frq.groups != NULL)
+ msg (SE, _("Variables %s specified multiple times on GROUPED "
+ "subcommand."), v[i]->name);
+ else
+ {
+ v[i]->p.frq.n_groups = nl;
+ v[i]->p.frq.groups = dl;
+ }
+ }
+ free (v);
+ if (!lex_match ('/'))
+ break;
+ if ((token != T_ID || !is_varname (tokid)) && token != T_ALL)
+ {
+ lex_put_back ('/');
+ break;
+ }
+ }
+
+ return 1;
+}
+
+/* Adds X to the list of percentiles, keeping the list in proper
+ order. */
+static void
+add_percentile (double x)
+{
+ int i;
+
+ for (i = 0; i < n_percentiles; i++)
+ if (x <= percentiles[i])
+ break;
+ if (i >= n_percentiles || tokval != percentiles[i])
+ {
+ percentiles = pool_realloc (int_pool, percentiles,
+ (n_percentiles + 1) * sizeof (double));
+ if (i < n_percentiles)
+ memmove (&percentiles[i + 1], &percentiles[i],
+ (n_percentiles - i) * sizeof (double));
+ percentiles[i] = x;
+ n_percentiles++;
+ }
+}
+
+/* Parses the PERCENTILES subcommand, adding user-specified
+ percentiles to the list. */
+static int
+frq_custom_percentiles (struct cmd_frequencies *cmd unused)
+{
+ lex_match ('=');
+ if (token != T_NUM)
+ {
+ msg (SE, _("Percentile list expected after PERCENTILES."));
+ return 0;
+ }
+
+ do
+ {
+ if (tokval <= 0 || tokval >= 100)
+ {
+ msg (SE, _("Percentiles must be greater than "
+ "0 and less than 100."));
+ return 0;
+ }
+
+ add_percentile (tokval / 100.0);
+ lex_get ();
+ lex_match (',');
+ }
+ while (token == T_NUM);
+ return 1;
+}
+
+/* Parses the NTILES subcommand, adding the percentiles that
+ correspond to the specified evenly-distributed ntiles. */
+static int
+frq_custom_ntiles (struct cmd_frequencies *cmd unused)
+{
+ int i;
+
+ lex_match ('=');
+ if (!lex_force_int ())
+ return 0;
+ for (i = 1; i < lex_integer (); i++)
+ add_percentile (1.0 / lex_integer () * i);
+ lex_get ();
+ return 1;
+}
+\f
+/* Comparison functions. */
+
+/* Ascending numeric compare of values. */
+static int
+compare_value_numeric_a (const void *a, const void *b, void *foo unused)
+{
+ return approx_compare (((struct freq *) a)->v.f, ((struct freq *) b)->v.f);
+}
+
+/* Ascending string compare of values. */
+static int
+compare_value_alpha_a (const void *a, const void *b, void *len)
+{
+ return memcmp (((struct freq *) a)->v.s, ((struct freq *) b)->v.s, (int) len);
+}
+
+/* Descending numeric compare of values. */
+static int
+compare_value_numeric_d (const void *a, const void *b, void *foo unused)
+{
+ return approx_compare (((struct freq *) b)->v.f, ((struct freq *) a)->v.f);
+}
+
+/* Descending string compare of values. */
+static int
+compare_value_alpha_d (const void *a, const void *b, void *len)
+{
+ return memcmp (((struct freq *) b)->v.s, ((struct freq *) a)->v.s, (int) len);
+}
+
+/* Ascending numeric compare of frequency;
+ secondary key on ascending numeric value. */
+static int
+compare_freq_numeric_a (const void *a, const void *b, void *foo unused)
+{
+ int x = approx_compare (((struct freq *) a)->c, ((struct freq *) b)->c);
+ return x ? x : approx_compare (((struct freq *) a)->v.f, ((struct freq *) b)->v.f);
+}
+
+/* Ascending numeric compare of frequency;
+ secondary key on ascending string value. */
+static int
+compare_freq_alpha_a (const void *a, const void *b, void *len)
+{
+ int x = approx_compare (((struct freq *) a)->c, ((struct freq *) b)->c);
+ return x ? x : memcmp (((struct freq *) a)->v.s, ((struct freq *) b)->v.s, (int) len);
+}
+
+/* Descending numeric compare of frequency;
+ secondary key on ascending numeric value. */
+static int
+compare_freq_numeric_d (const void *a, const void *b, void *foo unused)
+{
+ int x = approx_compare (((struct freq *) b)->c, ((struct freq *) a)->c);
+ return x ? x : approx_compare (((struct freq *) a)->v.f, ((struct freq *) b)->v.f);
+}
+
+/* Descending numeric compare of frequency;
+ secondary key on ascending string value. */
+static int
+compare_freq_alpha_d (const void *a, const void *b, void *len)
+{
+ int x = approx_compare (((struct freq *) b)->c, ((struct freq *) a)->c);
+ return x ? x : memcmp (((struct freq *) a)->v.s, ((struct freq *) b)->v.s, (int) len);
+}
+\f
+/* Frequency table display. */
+
+/* Sets the widths of all the columns and heights of all the rows in
+ table T for driver D. */
+static void
+full_dim (struct tab_table *t, struct outp_driver *d)
+{
+ int lab = cmd.labels == FRQ_LABELS;
+ int i;
+
+ if (lab)
+ t->w[0] = min (tab_natural_width (t, d, 0), d->prop_em_width * 15);
+ for (i = lab; i < lab + 5; i++)
+ t->w[i] = max (tab_natural_width (t, d, i), d->prop_em_width * 8);
+ for (i = 0; i < t->nr; i++)
+ t->h[i] = d->font_height;
+}
+
+/* Displays a full frequency table for variable V. */
+static void
+dump_full (struct variable * v)
+{
+ int n_categories;
+ struct freq *f;
+ struct tab_table *t;
+ int r;
+ double cum_percent = 0.0;
+ double cum_freq = 0.0;
+
+ struct init
+ {
+ int c, r;
+ const char *s;
+ };
+
+ struct init *p;
+
+ static struct init vec[] =
+ {
+ {4, 0, N_("Valid")},
+ {5, 0, N_("Cum")},
+ {1, 1, N_("Value")},
+ {2, 1, N_("Frequency")},
+ {3, 1, N_("Percent")},
+ {4, 1, N_("Percent")},
+ {5, 1, N_("Percent")},
+ {0, 0, NULL},
+ {1, 0, NULL},
+ {2, 0, NULL},
+ {3, 0, NULL},
+ {-1, -1, NULL},
+ };
+
+ int lab = cmd.labels == FRQ_LABELS;
+
+ n_categories = v->p.frq.tab.n_valid + v->p.frq.tab.n_missing;
+ t = tab_create (5 + lab, n_categories + 3, 0);
+ tab_headers (t, 0, 0, 2, 0);
+ tab_dim (t, full_dim);
+
+ if (lab)
+ tab_text (t, 0, 1, TAB_CENTER | TAT_TITLE, _("Value Label"));
+ for (p = vec; p->s; p++)
+ tab_text (t, p->c - (p->r ? !lab : 0), p->r,
+ TAB_CENTER | TAT_TITLE, gettext (p->s));
+
+ r = 2;
+ for (f = v->p.frq.tab.valid; f < v->p.frq.tab.missing; f++)
+ {
+ double percent, valid_percent;
+
+ cum_freq += f->c;
+
+ percent = f->c / v->p.frq.tab.total_cases * 100.0;
+ valid_percent = f->c / v->p.frq.tab.valid_cases * 100.0;
+ cum_percent += valid_percent;
+
+ if (lab)
+ {
+ char *label = get_val_lab (v, f->v, 0);
+ if (label != NULL)
+ tab_text (t, 0, r, TAB_LEFT, label);
+ }
+
+ tab_value (t, 0 + lab, r, TAB_NONE, &f->v, &v->print);
+ tab_float (t, 1 + lab, r, TAB_NONE, f->c, 8, 0);
+ tab_float (t, 2 + lab, r, TAB_NONE, percent, 5, 1);
+ tab_float (t, 3 + lab, r, TAB_NONE, valid_percent, 5, 1);
+ tab_float (t, 4 + lab, r, TAB_NONE, cum_percent, 5, 1);
+ r++;
+ }
+ for (; f < &v->p.frq.tab.valid[n_categories]; f++)
+ {
+ cum_freq += f->c;
+
+ if (lab)
+ {
+ char *label = get_val_lab (v, f->v, 0);
+ if (label != NULL)
+ tab_text (t, 0, r, TAB_LEFT, label);
+ }
+
+ tab_value (t, 0 + lab, r, TAB_NONE, &f->v, &v->print);
+ tab_float (t, 1 + lab, r, TAB_NONE, f->c, 8, 0);
+ tab_float (t, 2 + lab, r, TAB_NONE,
+ f->c / v->p.frq.tab.total_cases * 100.0, 5, 1);
+ tab_text (t, 3 + lab, r, TAB_NONE, _("Missing"));
+ r++;
+ }
+
+ tab_box (t, TAL_1, TAL_1,
+ cmd.spaces == FRQ_SINGLE ? -1 : (TAL_1 | TAL_SPACING), TAL_1,
+ 0, 0, 4 + lab, r);
+ tab_hline (t, TAL_2, 0, 4 + lab, 2);
+ tab_hline (t, TAL_2, 0, 4 + lab, r);
+ tab_joint_text (t, 0, r, 0 + lab, r, TAB_RIGHT | TAT_TITLE, _("Total"));
+ tab_vline (t, TAL_0, 1, r, r);
+ tab_float (t, 1 + lab, r, TAB_NONE, cum_freq, 8, 0);
+ tab_float (t, 2 + lab, r, TAB_NONE, 100.0, 5, 1);
+ tab_float (t, 3 + lab, r, TAB_NONE, 100.0, 5, 1);
+
+ tab_title (t, 1, "%s: %s", v->name, v->label ? v->label : "");
+ tab_submit (t);
+}
+
+/* Sets the widths of all the columns and heights of all the rows in
+ table T for driver D. */
+static void
+condensed_dim (struct tab_table *t, struct outp_driver *d)
+{
+ int cum_w = max (outp_string_width (d, _("Cum")),
+ max (outp_string_width (d, _("Cum")),
+ outp_string_width (d, "000")));
+
+ int i;
+
+ for (i = 0; i < 2; i++)
+ t->w[i] = max (tab_natural_width (t, d, i), d->prop_em_width * 8);
+ for (i = 2; i < 4; i++)
+ t->w[i] = cum_w;
+ for (i = 0; i < t->nr; i++)
+ t->h[i] = d->font_height;
+}
+
+/* Display condensed frequency table for variable V. */
+static void
+dump_condensed (struct variable * v)
+{
+ int n_categories;
+ struct freq *f;
+ struct tab_table *t;
+ int r;
+ double cum_percent = 0.0;
+
+ n_categories = v->p.frq.tab.n_valid + v->p.frq.tab.n_missing;
+ t = tab_create (4, n_categories + 2, 0);
+
+ tab_headers (t, 0, 0, 2, 0);
+ tab_text (t, 0, 1, TAB_CENTER | TAT_TITLE, _("Value"));
+ tab_text (t, 1, 1, TAB_CENTER | TAT_TITLE, _("Freq"));
+ tab_text (t, 2, 1, TAB_CENTER | TAT_TITLE, _("Pct"));
+ tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Cum"));
+ tab_text (t, 3, 1, TAB_CENTER | TAT_TITLE, _("Pct"));
+ tab_dim (t, condensed_dim);
+
+ r = 2;
+ for (f = v->p.frq.tab.valid; f < v->p.frq.tab.missing; f++)
+ {
+ double percent;
+
+ percent = f->c / v->p.frq.tab.total_cases * 100.0;
+ cum_percent += f->c / v->p.frq.tab.valid_cases * 100.0;
+
+ tab_value (t, 0, r, TAB_NONE, &f->v, &v->print);
+ tab_float (t, 1, r, TAB_NONE, f->c, 8, 0);
+ tab_float (t, 2, r, TAB_NONE, percent, 3, 0);
+ tab_float (t, 3, r, TAB_NONE, cum_percent, 3, 0);
+ r++;
+ }
+ for (; f < &v->p.frq.tab.valid[n_categories]; f++)
+ {
+ tab_value (t, 0, r, TAB_NONE, &f->v, &v->print);
+ tab_float (t, 1, r, TAB_NONE, f->c, 8, 0);
+ tab_float (t, 2, r, TAB_NONE,
+ f->c / v->p.frq.tab.total_cases * 100.0, 3, 0);
+ r++;
+ }
+
+ tab_box (t, TAL_1, TAL_1,
+ cmd.spaces == FRQ_SINGLE ? -1 : (TAL_1 | TAL_SPACING), TAL_1,
+ 0, 0, 3, r - 1);
+ tab_hline (t, TAL_2, 0, 3, 2);
+ tab_title (t, 1, "%s: %s", v->name, v->label ? v->label : "");
+ tab_columns (t, SOM_COL_DOWN, 1);
+ tab_submit (t);
+}
+\f
+/* Statistical display. */
+
+/* Calculates all the pertinent statistics for variable V, putting
+ them in array D[]. FIXME: This could be made much more optimal. */
+static void
+calc_stats (struct variable * v, double d[frq_n_stats])
+{
+ double W = v->p.frq.tab.valid_cases;
+ double X_bar, M2, M3, M4;
+ struct freq *f;
+
+ /* Calculate the mean. */
+ X_bar = 0.0;
+ for (f = v->p.frq.tab.valid; f < v->p.frq.tab.missing; f++)
+ X_bar += f->v.f * f->c;
+ X_bar /= W;
+
+ /* Calculate moments about the mean. */
+ M2 = M3 = M4 = 0.0;
+ for (f = v->p.frq.tab.valid; f < v->p.frq.tab.missing; f++)
+ {
+ double dev = f->v.f - X_bar;
+ double tmp;
+ tmp = dev * dev;
+ M2 += f->c * tmp;
+ tmp *= dev;
+ M3 += f->c * tmp;
+ tmp *= dev;
+ M4 += f->c * tmp;
+ }
+
+ /* Formulas below are taken from _SPSS Statistical Algorithms_. */
+ d[frq_min] = v->p.frq.tab.valid[0].v.f;
+ d[frq_max] = v->p.frq.tab.missing[-1].v.f;
+ d[frq_mode] = 0.0;
+ d[frq_range] = d[frq_max] - d[frq_min];
+ d[frq_median] = 0.0;
+ d[frq_mean] = X_bar;
+ d[frq_sum] = X_bar * W;
+ d[frq_variance] = M2 / (W - 1);
+ d[frq_stddev] = sqrt (d[frq_variance]);
+ d[frq_semean] = d[frq_stddev] / sqrt (W);
+ if (W >= 3.0 && d[frq_variance] > 0)
+ {
+ double S = d[frq_stddev];
+ d[frq_skew] = (W * M3 / ((W - 1.0) * (W - 2.0) * S * S * S));
+ d[frq_seskew] = sqrt (6.0 * W * (W - 1.0)
+ / ((W - 2.0) * (W + 1.0) * (W + 3.0)));
+ }
+ else
+ {
+ d[frq_skew] = d[frq_seskew] = SYSMIS;
+ }
+ if (W >= 4.0 && d[frq_variance] > 0)
+ {
+ double S2 = d[frq_variance];
+ double SE_g1 = d[frq_seskew];
+
+ d[frq_kurt] = ((W * (W + 1.0) * M4 - 3.0 * M2 * M2 * (W - 1.0))
+ / ((W - 1.0) * (W - 2.0) * (W - 3.0) * S2 * S2));
+ d[frq_sekurt] = sqrt ((4.0 * (W * W - 1.0) * SE_g1 * SE_g1)
+ / ((W - 3.0) * (W + 5.0)));
+ }
+ else
+ {
+ d[frq_kurt] = d[frq_sekurt] = SYSMIS;
+ }
+}
+
+/* Displays a table of all the statistics requested for variable V. */
+static void
+dump_statistics (struct variable * v, int show_varname)
+{
+ double stat_value[frq_n_stats];
+ struct tab_table *t;
+ int i, r;
+
+ if (v->type == ALPHA)
+ return;
+ if (v->p.frq.tab.n_valid == 0)
+ {
+ msg (SW, _("No valid data for variable %s; statistics not displayed."),
+ v->name);
+ return;
+ }
+ calc_stats (v, stat_value);
+
+ t = tab_create (2, n_stats, 0);
+ tab_dim (t, tab_natural_dimensions);
+ tab_vline (t, TAL_1 | TAL_SPACING, 1, 0, n_stats - 1);
+ for (i = r = 0; i < frq_n_stats; i++)
+ if (stats & BIT_INDEX (i))
+ {
+ tab_text (t, 0, r, TAB_LEFT | TAT_TITLE,
+ gettext (st_name[i].s10));
+ tab_float (t, 1, r, TAB_NONE, stat_value[i], 11, 3);
+ r++;
+ }
+
+ tab_columns (t, SOM_COL_DOWN, 1);
+ if (show_varname)
+ {
+ if (v->label)
+ tab_title (t, 1, "%s: %s", v->name, v->label);
+ else
+ tab_title (t, 0, v->name);
+ }
+ else
+ tab_flags (t, SOMF_NO_TITLE);
+
+ tab_submit (t);
+}
+\f
+#if 0
+/* Statistical calculation. */
+
+static int degree[6];
+static int maxdegree, minmax;
+
+static void stat_func (struct freq *, VISIT, int);
+static void calc_stats (int);
+static void display_stats (int);
+
+/* mapping of data[]:
+ * 0=>8
+ * 1=>9
+ * 2=>10
+ * index 3: number of modes found (detects multiple modes)
+ * index 4: number of nodes processed, for calculation of median
+ * 5=>11
+ *
+ * mapping of dbl[]:
+ * index 0-3: sum of X**i
+ * index 4: minimum
+ * index 5: maximum
+ * index 6: mode
+ * index 7: median
+ * index 8: number of cases, valid and missing
+ * index 9: number of valid cases
+ * index 10: maximum frequency found, for calculation of mode
+ * index 11: maximum frequency
+ */
+static void
+out_stats (int i)
+{
+ int j;
+
+ if (cur_var->type == ALPHA)
+ return;
+ for (j = 0; j < 8; j++)
+ cur_var->dbl[j] = 0.;
+ cur_var->dbl[10] = 0;
+ cur_var->dbl[4] = DBL_MAX;
+ cur_var->dbl[5] = -DBL_MAX;
+ for (j = 2; j < 5; j++)
+ cur_var->data[j] = 0;
+ cur_var->p.frq.median_ncases = cur_var->p.frq.t.valid_cases / 2;
+ avlwalk (cur_var->p.frq.t.f, stat_func, LEFT_TO_RIGHT);
+ calc_stats (i);
+ display_stats (i);
+}
+
+static void
+calc_stats (int i)
+{
+ struct variable *v;
+ double n;
+ double *d;
+
+ v = v_variables[i];
+ n = v->p.frq.t.valid_cases;
+ d = v->dbl;
+
+ if (n < 2 || (n < 3 && stat[FRQ_ST_7]))
+ {
+ warn (_("only %g case%s for variable %s, statistics not "
+ "computed"), n, n == 1 ? "" : "s", v->name);
+ return;
+ }
+ if (stat[FRQ_ST_9])
+ v->res[FRQ_ST_9] = d[5] - d[4];
+ if (stat[FRQ_ST_10])
+ v->res[FRQ_ST_10] = d[4];
+ if (stat[FRQ_ST_11])
+ v->res[FRQ_ST_11] = d[5];
+ if (stat[FRQ_ST_12])
+ v->res[FRQ_ST_12] = d[0];
+ if (stat[FRQ_ST_1] || stat[FRQ_ST_2] || stat[FRQ_ST_5] || stat[FRQ_ST_6] || stat[FRQ_ST_7])
+ {
+ v->res[FRQ_ST_1] = calc_mean (d, n);
+ v->res[FRQ_ST_6] = calc_variance (d, n);
+ }
+ if (stat[FRQ_ST_2] || stat[FRQ_ST_5] || stat[FRQ_ST_7])
+ v->res[FRQ_ST_5] = calc_stddev (v->res[FRQ_ST_6]);
+ if (stat[FRQ_ST_2])
+ v->res[FRQ_ST_2] = calc_semean (v->res[FRQ_ST_5], n);
+ if (stat[FRQ_ST_7])
+ {
+ v->res[FRQ_ST_7] = calc_kurt (d, n, v->res[FRQ_ST_6]);
+ v->res[FRQ_ST_14] = calc_sekurt (n);
+ }
+ if (stat[FRQ_ST_8])
+ {
+ v->res[FRQ_ST_8] = calc_skew (d, n, v->res[FRQ_ST_5]);
+ v->res[FRQ_ST_15] = calc_seskew (n);
+ }
+ if (stat[FRQ_ST_MODE])
+ {
+ v->res[FRQ_ST_MODE] = v->dbl[6];
+ if (v->data[3] > 1)
+ warn (_("The variable %s has %d modes. The lowest of these "
+ "is the one given in the table."), v->name, v->data[3]);
+ }
+ if (stat[FRQ_ST_MEDIAN])
+ v->res[FRQ_ST_MEDIAN] = v->dbl[7];
+}
+
+static void
+stat_func (struct freq * x, VISIT order, int param)
+{
+ double d, f;
+
+ if (order != INORDER)
+ return;
+ f = d = x->v.f;
+ cur_var->dbl[0] += (d * x->c);
+ switch (maxdegree)
+ {
+ case 1:
+ f *= d;
+ cur_var->dbl[1] += (f * x->c);
+ break;
+ case 2:
+ f *= d;
+ cur_var->dbl[1] += (f * x->c);
+ f *= d;
+ cur_var->dbl[2] += (f * x->c);
+ break;
+ case 3:
+ f *= d;
+ cur_var->dbl[1] += (f * x->c);
+ f *= d;
+ cur_var->dbl[2] += (f * x->c);
+ f *= d;
+ cur_var->dbl[3] += (f * x->c);
+ break;
+ }
+ if (minmax)
+ {
+ if (d < cur_var->dbl[4])
+ cur_var->dbl[4] = d;
+ if (d > cur_var->dbl[5])
+ cur_var->dbl[5] = d;
+ }
+ if (x->c > cur_var->dbl[10])
+ {
+ cur_var->data[3] = 1;
+ cur_var->dbl[10] = x->c;
+ cur_var->dbl[6] = x->v.f;
+ }
+ else if (x->c == cur_var->dbl[10])
+ cur_var->data[3]++;
+ if (cur_var->data[4] < cur_var->p.frq.median_ncases
+ && cur_var->data[4] + x->c >= cur_var->p.frq.median_ncases)
+ cur_var->dbl[7] = x->v.f;
+ cur_var->data[4] += x->c;
+}
+\f
+/* Statistical display. */
+static int column, ncolumns;
+
+static void outstat (char *, double);
+
+static void
+display_stats (int i)
+{
+ statname *sp;
+ struct variable *v;
+ int nlines;
+
+ v = v_variables[i];
+ ncolumns = (margin_width + 3) / 26;
+ if (ncolumns < 1)
+ ncolumns = 1;
+ nlines = sc / ncolumns + (sc % ncolumns > 0);
+ if (nlines == 2 && sc == 4)
+ ncolumns = 2;
+ if (nlines == 3 && sc == 9)
+ ncolumns = 3;
+ if (nlines == 4 && sc == 12)
+ ncolumns = 3;
+ column = 0;
+ for (sp = st_name; sp->s != -1; sp++)
+ if (stat[sp->s] == 1)
+ outstat (gettext (sp->s10), v->res[sp->s]);
+ if (column)
+ out_eol ();
+ blank_line ();
+}
+
+static void
+outstat (char *label, double value)
+{
+ char buf[128], *cp;
+ int dw, n;
+
+ cp = &buf[0];
+ if (!column)
+ out_header ();
+ else
+ {
+ memset (buf, ' ', 3);
+ cp = &buf[3];
+ }
+ dw = 4;
+ n = nsprintf (cp, "%-10s %12.4f", label, value);
+ while (n > 23 && dw > 0)
+ n = nsprintf (cp, "%-10s %12.*f", label, --dw, value);
+ outs (buf);
+ column++;
+ if (column == ncolumns)
+ {
+ column = 0;
+ out_eol ();
+ }
+}
+\f
+/* Graphs. */
+
+static rect pb, gb; /* Page border, graph border. */
+static int px, py; /* Page width, height. */
+static int ix, iy; /* Inch width, height. */
+
+static void draw_bar_chart (int);
+static void draw_histogram (int);
+static int scale_dep_axis (int);
+
+static void
+out_graphs (int i)
+{
+ struct variable *v;
+
+ v = v_variables[i];
+ if (avlcount (cur_var->p.frq.t.f) < 2
+ || (chart == HIST && v_variables[i]->type == ALPHA))
+ return;
+ if (driver_id && set_highres == 1)
+ {
+ char *text;
+
+ graf_page_size (&px, &py, &ix, &iy);
+ graf_feed_page ();
+
+ /* Calculate borders. */
+ pb.x1 = ix;
+ pb.y1 = iy;
+ pb.x2 = px - ix;
+ pb.y2 = py - iy;
+ gb.x1 = pb.x1 + ix;
+ gb.y1 = pb.y1 + iy;
+ gb.x2 = pb.x2 - ix / 2;
+ gb.y2 = pb.y2 - iy;
+
+ /* Draw borders. */
+ graf_frame_rect (COMPONENTS (pb));
+ graf_frame_rect (COMPONENTS (gb));
+
+ /* Draw axis labels. */
+ graf_font_size (iy / 4); /* 18-point text */
+ text = format == PERCENT ? _("Percentage") : _("Frequency");
+ graf_text (pb.x1 + max (ix, iy) / 4 + max (ix, iy) / 16, gb.y2, text,
+ SIDEWAYS);
+ text = v->label ? v->label : v->name;
+ graf_text (gb.x1, pb.y2 - iy / 4, text, UPRIGHT);
+
+ /* Draw axes, chart proper. */
+ if (chart == BAR ||
+ (chart == HBAR
+ && (avlcount (cur_var->p.frq.t.f) || v_variables[i]->type == ALPHA)))
+ draw_bar_chart (i);
+ else
+ draw_histogram (i);
+
+ graf_eject_page ();
+ }
+ if (set_lowres == 1 || (set_lowres == 2 && (!driver_id || !set_highres)))
+ {
+ static warned;
+
+ /* Do character-based graphs. */
+ if (!warned)
+ {
+ warn (_("low-res graphs not implemented"));
+ warned = 1;
+ }
+ }
+}
+
+#if __GNUC__ && !__CHECKER__
+#define BIG_TYPE long long
+#else /* !__GNUC__ */
+#define BIG_TYPE double
+#endif /* !__GNUC__ */
+
+static void
+draw_bar_chart (int i)
+{
+ int bar_width, bar_spacing;
+ int w, max, row;
+ double val;
+ struct freq *f;
+ rect r;
+ AVLtraverser *t = NULL;
+
+ w = (px - ix * 7 / 2) / avlcount (cur_var->p.frq.t.f);
+ bar_width = w * 2 / 3;
+ bar_spacing = w - bar_width;
+
+#if !ALLOW_HUGE_BARS
+ if (bar_width > ix / 2)
+ bar_width = ix / 2;
+#endif /* !ALLOW_HUGE_BARS */
+
+ max = scale_dep_axis (cur_var->p.frq.t.max_freq);
+
+ row = 0;
+ r.x1 = gb.x1 + bar_spacing / 2;
+ r.x2 = r.x1 + bar_width;
+ r.y2 = gb.y2;
+ graf_fill_color (255, 0, 0);
+ for (f = avltrav (cur_var->p.frq.t.f, &t); f;
+ f = avltrav (cur_var->p.frq.t.f, &t))
+ {
+ char buf2[64];
+ char *buf;
+
+ val = f->c;
+ if (format == PERCENT)
+ val = val * 100 / cur_var->p.frq.t.valid_cases;
+ r.y1 = r.y2 - val * (height (gb) - 1) / max;
+ graf_fill_rect (COMPONENTS (r));
+ graf_frame_rect (COMPONENTS (r));
+ buf = get_val_lab (cur_var, f->v, 0);
+ if (!buf)
+ if (cur_var->type == ALPHA)
+ buf = f->v.s;
+ else
+ {
+ sprintf (buf2, "%g", f->v.f);
+ buf = buf2;
+ }
+ graf_text (r.x1 + bar_width / 2,
+ gb.y2 + iy / 32 + row * iy / 9, buf, TCJUST);
+ row ^= 1;
+ r.x1 += bar_width + bar_spacing;
+ r.x2 += bar_width + bar_spacing;
+ }
+ graf_fill_color (0, 0, 0);
+}
+
+#define round_down(X, V) \
+ (floor ((X) / (V)) * (V))
+#define round_up(X, V) \
+ (ceil ((X) / (V)) * (V))
+
+static void
+draw_histogram (int i)
+{
+ double lower, upper, interval;
+ int bars[MAX_HIST_BARS + 1], top, j;
+ int err, addend, rem, nbars, row, max_freq;
+ char buf[25];
+ rect r;
+ struct freq *f;
+ AVLtraverser *t = NULL;
+
+ lower = min == SYSMIS ? cur_var->dbl[4] : min;
+ upper = max == SYSMIS ? cur_var->dbl[5] : max;
+ if (upper - lower >= 10)
+ {
+ double l, u;
+
+ u = round_up (upper, 5);
+ l = round_down (lower, 5);
+ nbars = (u - l) / 5;
+ if (nbars * 2 + 1 <= MAX_HIST_BARS)
+ {
+ nbars *= 2;
+ u = round_up (upper, 2.5);
+ l = round_down (lower, 2.5);
+ if (l + 1.25 <= lower && u - 1.25 >= upper)
+ nbars--, lower = l + 1.25, upper = u - 1.25;
+ else if (l + 1.25 <= lower)
+ lower = l + 1.25, upper = u + 1.25;
+ else if (u - 1.25 >= upper)
+ lower = l - 1.25, upper = u - 1.25;
+ else
+ nbars++, lower = l - 1.25, upper = u + 1.25;
+ }
+ else if (nbars < MAX_HIST_BARS)
+ {
+ if (l + 2.5 <= lower && u - 2.5 >= upper)
+ nbars--, lower = l + 2.5, upper = u - 2.5;
+ else if (l + 2.5 <= lower)
+ lower = l + 2.5, upper = u + 2.5;
+ else if (u - 2.5 >= upper)
+ lower = l - 2.5, upper = u - 2.5;
+ else
+ nbars++, lower = l - 2.5, upper = u + 2.5;
+ }
+ else
+ nbars = MAX_HIST_BARS;
+ }
+ else
+ {
+ nbars = avlcount (cur_var->p.frq.t.f);
+ if (nbars > MAX_HIST_BARS)
+ nbars = MAX_HIST_BARS;
+ }
+ if (nbars < MIN_HIST_BARS)
+ nbars = MIN_HIST_BARS;
+ interval = (upper - lower) / nbars;
+
+ memset (bars, 0, sizeof (int[nbars + 1]));
+ if (lower >= upper)
+ {
+ msg (SE, _("Could not make histogram for %s for specified "
+ "minimum %g and maximum %g; please discard graph."), cur_var->name,
+ lower, upper);
+ return;
+ }
+ for (f = avltrav (cur_var->p.frq.t.f, &t); f;
+ f = avltrav (cur_var->p.frq.t.f, &t))
+ if (f->v.f == upper)
+ bars[nbars - 1] += f->c;
+ else if (f->v.f >= lower && f->v.f < upper)
+ bars[(int) ((f->v.f - lower) / interval)] += f->c;
+ bars[nbars - 1] += bars[nbars];
+ for (j = top = 0; j < nbars; j++)
+ if (bars[j] > top)
+ top = bars[j];
+ max_freq = top;
+ top = scale_dep_axis (top);
+
+ err = row = 0;
+ addend = width (gb) / nbars;
+ rem = width (gb) % nbars;
+ r.x1 = gb.x1;
+ r.x2 = r.x1 + addend;
+ r.y2 = gb.y2;
+ err += rem;
+ graf_fill_color (255, 0, 0);
+ for (j = 0; j < nbars; j++)
+ {
+ int w;
+
+ r.y1 = r.y2 - (BIG_TYPE) bars[j] * (height (gb) - 1) / top;
+ graf_fill_rect (COMPONENTS (r));
+ graf_frame_rect (COMPONENTS (r));
+ sprintf (buf, "%g", lower + interval / 2 + interval * j);
+ graf_text (r.x1 + addend / 2,
+ gb.y2 + iy / 32 + row * iy / 9, buf, TCJUST);
+ row ^= 1;
+ w = addend;
+ err += rem;
+ while (err >= addend)
+ {
+ w++;
+ err -= addend;
+ }
+ r.x1 = r.x2;
+ r.x2 = r.x1 + w;
+ }
+ if (normal)
+ {
+ double x, y, variance, mean, step, factor;
+
+ variance = cur_var->res[FRQ_ST_VARIANCE];
+ mean = cur_var->res[FRQ_ST_MEAN];
+ factor = (1. / (sqrt (2. * PI * variance))
+ * cur_var->p.frq.t.valid_cases * interval);
+ graf_polyline_begin ();
+ for (x = lower, step = (upper - lower) / (POLYLINE_DENSITY);
+ x <= upper; x += step)
+ {
+ y = factor * exp (-square (x - mean) / (2. * variance));
+ debug_printf (("(%20.10f, %20.10f)\n", x, y));
+ graf_polyline_point (gb.x1 + (x - lower) / (upper - lower) * width (gb),
+ gb.y2 - y * (height (gb) - 1) / top);
+ }
+ graf_polyline_end ();
+ }
+ graf_fill_color (0, 0, 0);
+}
+
+static int
+scale_dep_axis (int max)
+{
+ int j, s, x, y, ty, by;
+ char buf[10];
+
+ x = 10, s = 2;
+ if (scale != SYSMIS && max < scale)
+ x = scale, s = scale / 5;
+ else if (format == PERCENT)
+ {
+ max = ((BIG_TYPE) 100 * cur_var->p.frq.t.max_freq
+ / cur_var->p.frq.t.valid_cases + 1);
+ if (max < 5)
+ x = 5, s = 1;
+ else if (max < 10)
+ x = 10, s = 2;
+ else if (max < 25)
+ x = 25, s = 5;
+ else if (max < 50)
+ x = 50, s = 10;
+ else
+ max = 100, s = 20;
+ }
+ else /* format==FREQ */
+ /* Uses a progression of 10, 20, 50, 100, 200, 500, ... */
+ for (;;)
+ {
+ if (x > max)
+ break;
+ x *= 2;
+ s *= 2;
+ if (x > max)
+ break;
+ x = x / 2 * 5;
+ s = s / 2 * 5;
+ if (x > max)
+ break;
+ x *= 2;
+ s *= 2;
+ }
+ graf_font_size (iy / 9); /* 8-pt text */
+ for (j = 0; j <= x; j += s)
+ {
+ y = gb.y2 - (BIG_TYPE) j *(height (gb) - 1) / x;
+ ty = y - iy / 64;
+ by = y + iy / 64;
+ if (ty < gb.y1)
+ ty += iy / 64, by += iy / 64;
+ else if (by > gb.y2)
+ ty -= iy / 64, by -= iy / 64;
+ graf_fill_rect (gb.x1 - ix / 16, ty, gb.x1, by);
+ sprintf (buf, "%d", j);
+ graf_text (gb.x1 - ix / 8, (ty + by) / 2, buf, CRJUST);
+ }
+ return x;
+}
+\f
+/* Percentiles. */
+
+static void ungrouped_pcnt (int i);
+static int grouped_interval_pcnt (int i);
+static void out_pcnt (double, double);
+
+static void
+out_percentiles (int i)
+{
+ if (cur_var->type == ALPHA || !n_percentiles)
+ return;
+
+ outs_line (_("Percentile Value "
+ "Percentile Value "
+ "Percentile Value"));
+ blank_line ();
+
+ column = 0;
+ if (!g_var[i])
+ ungrouped_pcnt (i);
+ else if (g_var[i] == 1)
+ grouped_interval_pcnt (i);
+#if 0
+ else if (g_var[i] == -1)
+ grouped_pcnt (i);
+ else
+ grouped_boundaries_pcnt (i);
+#else /* !0 */
+ else
+ warn (_("this form of percentiles not supported"));
+#endif
+ if (column)
+ out_eol ();
+}
+
+static void
+out_pcnt (double pcnt, double value)
+{
+ if (!column)
+ out_header ();
+ else
+ outs (" ");
+ out ("%7.2f%13.3f", pcnt * 100., value);
+ column++;
+ if (column == 3)
+ {
+ out_eol ();
+ column = 0;
+ }
+}
+
+static void
+ungrouped_pcnt (int i)
+{
+ AVLtraverser *t = NULL;
+ struct freq *f;
+ double *p, *e;
+ int sum;
+
+ p = percentiles;
+ e = &percentiles[n_percentiles];
+ sum = 0;
+ for (f = avltrav (cur_var->p.frq.t.f, &t);
+ f && p < e; f = avltrav (cur_var->p.frq.t.f, &t))
+ {
+ sum += f->c;
+ while (sum >= p[0] * cur_var->p.frq.t.valid_cases && p < e)
+ out_pcnt (*p++, f->v.f);
+ }
+}
+
+
+static int
+grouped_interval_pcnt (int i)
+{
+ AVLtraverser * t = NULL;
+ struct freq * f, *fp;
+ double *p, *e, w;
+ int sum, psum;
+
+ p = percentiles;
+ e = &percentiles[n_percentiles];
+ w = gl_var[i][0];
+ sum = psum = 0;
+ for (fp = 0, f = avltrav (cur_var->p.frq.t.f, &t);
+ f && p < e;
+ fp = f, f = avltrav (cur_var->p.frq.t.f, &t))
+ {
+ if (fp)
+ if (fabs (f->v.f - fp->v.f) < w)
+ {
+ out_eol ();
+ column = 0;
+ return msg (SE, _("Difference between %g and %g is "
+ "too small for grouping interval %g."), f->v.f,
+ fp->v.f, w);
+ }
+ psum = sum;
+ sum += f->c;
+ while (sum >= p[0] * cur_var->p.frq.t.valid_cases && p < e)
+ {
+ out_pcnt (p[0], (((p[0] * cur_var->p.frq.t.valid_cases) - psum) * w / f->c
+ + (f->v.f - w / 2)));
+ p++;
+ }
+ }
+ return 1;
+}
+#endif
+
+/*
+ Local Variables:
+ mode: c
+ End:
+*/
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "avl.h"
+#include "command.h"
+#include "error.h"
+#include "file-handle.h"
+#include "lexer.h"
+#include "misc.h"
+#include "pfm.h"
+#include "settings.h"
+#include "sfm.h"
+#include "str.h"
+#include "var.h"
+#include "vfm.h"
+#include "vfmP.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* XSAVE transformation (and related SAVE, EXPORT procedures). */
+struct save_trns
+ {
+ struct trns_header h;
+ struct file_handle *f; /* Associated system file. */
+ int nvar; /* Number of variables. */
+ int *var; /* Indices of variables. */
+ flt64 *case_buf; /* Case transfer buffer. */
+ };
+
+/* Options bits set by trim_dictionary(). */
+#define GTSV_OPT_COMPRESSED 001 /* Compression; (X)SAVE only. */
+#define GTSV_OPT_SAVE 002 /* The SAVE/XSAVE/EXPORT procedures. */
+#define GTSV_OPT_MATCH_FILES 004 /* The MATCH FILES procedure. */
+#define GTSV_OPT_NONE 0
+
+/* The file being read by the input program. */
+static struct file_handle *get_file;
+
+/* The transformation being used by the SAVE procedure. */
+static struct save_trns *trns;
+
+static int trim_dictionary (struct dictionary * dict, int *options);
+static int save_write_case_func (struct ccase *);
+static int save_trns_proc (struct trns_header *, struct ccase *);
+static void save_trns_free (struct trns_header *);
+
+#if DEBUGGING
+void dump_dict_variables (struct dictionary *);
+#endif
+
+/* Parses the GET command. */
+int
+cmd_get (void)
+{
+ struct file_handle *handle;
+ struct dictionary *dict;
+ int options = GTSV_OPT_NONE;
+
+ int i;
+ int nval;
+
+ lex_match_id ("GET");
+ discard_variables ();
+
+ lex_match ('/');
+ if (lex_match_id ("FILE"))
+ lex_match ('=');
+
+ handle = fh_parse_file_handle ();
+ if (handle == NULL)
+ return CMD_FAILURE;
+
+ dict = sfm_read_dictionary (handle, NULL);
+ if (dict == NULL)
+ return CMD_FAILURE;
+
+#if DEBUGGING
+ dump_dict_variables (dict);
+#endif
+ if (0 == trim_dictionary (dict, &options))
+ {
+ fh_close_handle (handle);
+ return CMD_FAILURE;
+ }
+#if DEBUGGING
+ dump_dict_variables (dict);
+#endif
+
+ /* Set the fv and lv elements of all variables remaining in the
+ dictionary. */
+ nval = 0;
+ for (i = 0; i < dict->nvar; i++)
+ {
+ struct variable *v = dict->var[i];
+
+ v->fv = nval;
+ nval += v->nv;
+ }
+ dict->nval = nval;
+ assert (nval);
+
+#if DEBUGGING
+ printf (_("GET translation table from file to memory:\n"));
+ for (i = 0; i < dict->nvar; i++)
+ {
+ struct variable *v = dict->var[i];
+
+ printf (_(" %8s from %3d,%3d to %3d,%3d\n"), v->name,
+ v->get.fv, v->get.nv, v->fv, v->nv);
+ }
+#endif
+
+ restore_dictionary (dict);
+
+ vfm_source = &get_source;
+ get_file = handle;
+
+ return CMD_SUCCESS;
+}
+
+/* Parses the SAVE (for X==0) and XSAVE (for X==1) commands. */
+/* FIXME: save_dictionary() is too expensive. It would make more
+ sense to copy just the first few fields of each variables (up to
+ `foo'): that's a SMOP. */
+int
+cmd_save_internal (int x)
+{
+ struct file_handle *handle;
+ struct dictionary *dict;
+ int options = GTSV_OPT_SAVE;
+
+ struct save_trns *t;
+ struct sfm_write_info inf;
+
+ int i;
+
+ lex_match_id ("SAVE");
+
+ lex_match ('/');
+ if (lex_match_id ("OUTFILE"))
+ lex_match ('=');
+
+ handle = fh_parse_file_handle ();
+ if (handle == NULL)
+ return CMD_FAILURE;
+
+ dict = save_dictionary ();
+#if DEBUGGING
+ dump_dict_variables (dict);
+#endif
+ for (i = 0; i < dict->nvar; i++)
+ dict->var[i]->foo = i;
+ if (0 == trim_dictionary (dict, &options))
+ {
+ fh_close_handle (handle);
+ return CMD_FAILURE;
+ }
+
+#if DEBUGGING
+ dump_dict_variables (dict);
+#endif
+
+ /* Write dictionary. */
+ inf.h = handle;
+ inf.dict = dict;
+ inf.compress = !!(options & GTSV_OPT_COMPRESSED);
+ if (!sfm_write_dictionary (&inf))
+ {
+ free_dictionary (dict);
+ fh_close_handle (handle);
+ return CMD_FAILURE;
+ }
+
+ /* Fill in transformation structure. */
+ t = trns = xmalloc (sizeof *t);
+ t->h.proc = save_trns_proc;
+ t->h.free = save_trns_free;
+ t->f = handle;
+ t->nvar = dict->nvar;
+ t->var = xmalloc (sizeof *t->var * dict->nvar);
+ for (i = 0; i < dict->nvar; i++)
+ t->var[i] = dict->var[i]->foo;
+ t->case_buf = xmalloc (sizeof *t->case_buf * inf.case_size);
+ free_dictionary (dict);
+
+ if (x == 0)
+ /* SAVE. */
+ {
+ procedure (NULL, save_write_case_func, NULL);
+ save_trns_free ((struct trns_header *) t);
+ }
+ else
+ /* XSAVE. */
+ add_transformation ((struct trns_header *) t);
+
+ return CMD_SUCCESS;
+}
+
+/* Parses and performs the SAVE procedure. */
+int
+cmd_save (void)
+{
+ return cmd_save_internal (0);
+}
+
+/* Parses the XSAVE transformation command. */
+int
+cmd_xsave (void)
+{
+ return cmd_save_internal (1);
+}
+
+static int
+save_write_case_func (struct ccase * c)
+{
+ save_trns_proc ((struct trns_header *) trns, c);
+ return 1;
+}
+
+static int
+save_trns_proc (struct trns_header * t unused, struct ccase * c)
+{
+ flt64 *p = trns->case_buf;
+ int i;
+
+ for (i = 0; i < trns->nvar; i++)
+ {
+ struct variable *v = default_dict.var[trns->var[i]];
+ if (v->type == NUMERIC)
+ {
+ double src = c->data[v->fv].f;
+ if (src == SYSMIS)
+ *p++ = -FLT64_MAX;
+ else
+ *p++ = src;
+ }
+ else
+ {
+ memcpy (p, c->data[v->fv].s, v->width);
+ memset (&((char *) p)[v->width], ' ',
+ REM_RND_UP (v->width, sizeof *p));
+ p += DIV_RND_UP (v->width, sizeof *p);
+ }
+ }
+
+ sfm_write_case (trns->f, trns->case_buf, p - trns->case_buf);
+ return -1;
+}
+
+static void
+save_trns_free (struct trns_header *pt)
+{
+ struct save_trns *t = (struct save_trns *) pt;
+
+ fh_close_handle (t->f);
+ free (t->var);
+ free (t->case_buf);
+ free (t);
+}
+
+/* Deletes NV variables from DICT, starting at index FIRST. The
+ variables must have consecutive indices. The variables are cleared
+ and freed. */
+static void
+dict_delete_run (struct dictionary *dict, int first, int nv)
+{
+ int i;
+
+ for (i = first; i < first + nv; i++)
+ {
+ clear_variable (dict, dict->var[i]);
+ free (dict->var[i]);
+ }
+ for (i = first; i < dict->nvar - nv; i++)
+ {
+ dict->var[i] = dict->var[i + nv];
+ dict->var[i]->index -= nv;
+ }
+ dict->nvar -= nv;
+}
+
+static int rename_variables (struct dictionary * dict);
+
+/* The GET and SAVE commands have a common structure after the
+ FILE/OUTFILE subcommand. This function parses this structure and
+ returns nonzero on success, zero on failure. It both reads
+ *OPTIONS, for the GTSV_OPT_SAVE bit, and writes it, for the
+ GTSV_OPT_COMPRESSED bit. */
+/* FIXME: IN, FIRST, LAST, MAP. */
+static int
+trim_dictionary (struct dictionary *dict, int *options)
+{
+ if (set_scompression)
+ *options |= GTSV_OPT_COMPRESSED;
+
+ if (*options & GTSV_OPT_SAVE)
+ {
+ int i;
+
+ /* Delete all the scratch variables. */
+ for (i = 0; i < dict->nvar; i++)
+ {
+ int j;
+
+ if (dict->var[i]->name[0] != '#')
+ continue;
+
+ /* Find a run of variables to be deleted. */
+ for (j = i + 1; j < dict->nvar; j++)
+ if (dict->var[j]->name[0] != '#')
+ break;
+
+ /* Actually delete 'em. */
+ dict_delete_run (dict, i, j - i);
+ }
+ }
+
+ while ((*options & GTSV_OPT_MATCH_FILES) || lex_match ('/'))
+ {
+ if (!(*options & GTSV_OPT_MATCH_FILES) && lex_match_id ("COMPRESSED"))
+ *options |= GTSV_OPT_COMPRESSED;
+ else if (!(*options & GTSV_OPT_MATCH_FILES) && lex_match_id ("UNCOMPRESSED"))
+ *options &= ~GTSV_OPT_COMPRESSED;
+ else if (lex_match_id ("DROP"))
+ {
+ struct variable **v;
+ int nv;
+ int i;
+
+ lex_match ('=');
+ if (!parse_variables (dict, &v, &nv, PV_NONE))
+ return 0;
+
+ /* Loop through the variables to delete. */
+ for (i = 0; i < nv;)
+ {
+ int j;
+
+ /* Find a run of variables to be deleted. */
+ for (j = i + 1; j < nv; j++)
+ if (v[j]->index != v[j - 1]->index + 1)
+ break;
+
+ /* Actually delete 'em. */
+ dict_delete_run (dict, v[i]->index, j - i);
+ i = j;
+ }
+ }
+ else if (lex_match_id ("KEEP"))
+ {
+ struct variable **v;
+ int nv;
+
+ lex_match ('=');
+ if (!parse_variables (dict, &v, &nv, PV_NONE))
+ return 0;
+
+ /* Reorder the dictionary so that the kept variables are at
+ the beginning. */
+ {
+ int i1;
+
+ for (i1 = 0; i1 < nv; i1++)
+ {
+ int i2 = v[i1]->index;
+
+ /* Swap variables with indices i1 and i2. */
+ struct variable *t = dict->var[i1];
+ dict->var[i1] = dict->var[i2];
+ dict->var[i2] = t;
+ dict->var[i1]->index = i1;
+ dict->var[i2]->index = i2;
+ }
+
+ free (v);
+ }
+
+ /* Delete all but the first NV variables from the
+ dictionary. */
+ {
+ int i;
+ for (i = nv; i < dict->nvar; i++)
+ {
+ clear_variable (dict, dict->var[i]);
+ free (dict->var[i]);
+ }
+ }
+ dict->var = xrealloc (dict->var, sizeof *dict->var * nv);
+ dict->nvar = nv;
+ }
+ else if (lex_match_id ("RENAME"))
+ {
+ if (!rename_variables (dict))
+ return 0;
+ }
+ else
+ {
+ lex_error (_("while expecting a valid subcommand"));
+ return 0;
+ }
+
+ if (dict->nvar == 0)
+ {
+ msg (SE, _("All variables deleted from system file dictionary."));
+ return 0;
+ }
+
+ if (*options & GTSV_OPT_MATCH_FILES)
+ return 1;
+ }
+
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Parses and performs the RENAME subcommand of GET and SAVE. */
+static int
+rename_variables (struct dictionary * dict)
+{
+ int i;
+
+ int success = 0;
+
+ struct variable **v;
+ char **new_names;
+ int nv, nn;
+
+ int group;
+
+ lex_match ('=');
+ if (token != '(')
+ {
+ struct variable *v;
+
+ v = parse_dict_variable (dict);
+ if (v == NULL)
+ return 0;
+ if (!lex_force_match ('=')
+ || !lex_force_id ())
+ return 0;
+ if (!strncmp (tokid, v->name, 8))
+ return 1;
+ if (is_dict_varname (dict, tokid))
+ {
+ msg (SE, _("Cannot rename %s as %s because there already exists "
+ "a variable named %s. To rename variables with "
+ "overlapping names, use a single RENAME subcommand "
+ "such as \"/RENAME (A=B)(B=C)(C=A)\", or equivalently, "
+ "\"/RENAME (A B C=B C A)\"."), v->name, tokid, tokid);
+ return 0;
+ }
+
+ rename_variable (dict, v, tokid);
+ lex_get ();
+ return 1;
+ }
+
+ nv = nn = 0;
+ v = NULL;
+ new_names = 0;
+ group = 1;
+ while (lex_match ('('))
+ {
+ int old_nv = nv;
+
+ if (!parse_variables (dict, &v, &nv, PV_NO_DUPLICATE | PV_APPEND))
+ goto lossage;
+ if (!lex_match ('='))
+ {
+ msg (SE, _("`=' expected after variable list."));
+ goto lossage;
+ }
+ if (!parse_DATA_LIST_vars (&new_names, &nn, PV_APPEND | PV_NO_SCRATCH))
+ goto lossage;
+ if (nn != nv)
+ {
+ msg (SE, _("Number of variables on left side of `=' (%d) do not "
+ "match number of variables on right side (%d), in "
+ "parenthesized group %d of RENAME subcommand."),
+ nv - old_nv, nn - old_nv, group);
+ goto lossage;
+ }
+ if (!lex_force_match (')'))
+ goto lossage;
+ group++;
+ }
+
+ for (i = 0; i < nv; i++)
+ avl_force_delete (dict->var_by_name, v[i]);
+ for (i = 0; i < nv; i++)
+ {
+ strcpy (v[i]->name, new_names[i]);
+ if (NULL != avl_insert (dict->var_by_name, v[i]))
+ {
+ msg (SE, _("Duplicate variables name %s."), v[i]->name);
+ goto lossage;
+ }
+ }
+ success = 1;
+
+lossage:
+ /* The label is a bit of a misnomer, we actually come here on any
+ sort of return. */
+ for (i = 0; i < nn; i++)
+ free (new_names[i]);
+ free (new_names);
+ free (v);
+
+ return success;
+}
+
+#if DEBUGGING
+void
+dump_dict_variables (struct dictionary * dict)
+{
+ int i;
+
+ printf (_("\nVariables in dictionary:\n"));
+ for (i = 0; i < dict->nvar; i++)
+ printf ("%s, ", dict->var[i]->name);
+ printf ("\n");
+}
+#endif
+\f
+/* Clears internal state related to GET input procedure. */
+static void
+get_source_destroy_source (void)
+{
+ /* It is not necessary to destroy the dictionary because if we get
+ to this point then the dictionary is default_dict. */
+ fh_close_handle (get_file);
+}
+
+/* Reads all the cases from the data file and passes them to
+ write_case(). */
+static void
+get_source_read (void)
+{
+ while (sfm_read_case (get_file, temp_case->data, &default_dict)
+ && write_case ())
+ ;
+ get_source_destroy_source ();
+}
+
+struct case_stream get_source =
+ {
+ NULL,
+ get_source_read,
+ NULL,
+ NULL,
+ get_source_destroy_source,
+ NULL,
+ "GET",
+ };
+
+\f
+/* MATCH FILES. */
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* File types. */
+enum
+ {
+ MTF_FILE, /* Specified on FILE= subcommand. */
+ MTF_TABLE /* Specified on TABLE= subcommand. */
+ };
+
+/* One of the files on MATCH FILES. */
+struct mtf_file
+ {
+ struct mtf_file *next, *prev;
+ /* Next, previous in the list of files. */
+ struct mtf_file *next_min; /* Next in the chain of minimums. */
+
+ int type; /* One of MTF_*. */
+ struct variable **by; /* List of BY variables for this file. */
+ struct file_handle *handle; /* File handle for the file. */
+ struct dictionary *dict; /* Dictionary from system file. */
+ char in[9]; /* Name of the variable from IN=. */
+ char first[9], last[9]; /* Name of the variables from FIRST=, LAST=. */
+ union value *input; /* Input record. */
+ };
+
+/* All the files mentioned on FILE= or TABLE=. */
+static struct mtf_file *mtf_head, *mtf_tail;
+
+/* Variables on the BY subcommand. */
+static struct variable **mtf_by;
+static int mtf_n_by;
+
+/* Master dictionary. */
+static struct dictionary *mtf_master;
+
+static void mtf_free (void);
+static void mtf_free_file (struct mtf_file *file);
+static int mtf_merge_dictionary (struct mtf_file *f);
+static void mtf_delete_file_in_place (struct mtf_file **file);
+
+static void mtf_read_nonactive_records (void);
+static void mtf_processing_finish (void);
+static int mtf_processing (struct ccase *);
+
+static char *var_type_description (struct variable *);
+
+/* Parse and execute the MATCH FILES command. */
+int
+cmd_match_files (void)
+{
+ struct mtf_file *first_table = NULL;
+
+ int seen = 0;
+
+ lex_match_id ("MATCH");
+ lex_match_id ("FILES");
+
+ mtf_head = mtf_tail = NULL;
+ mtf_by = NULL;
+ mtf_n_by = 0;
+ mtf_master = new_dictionary (0);
+ mtf_master->N = default_dict.N;
+
+ do
+ {
+ lex_match ('/');
+
+ if (lex_match (T_BY))
+ {
+ if (seen & 1)
+ {
+ msg (SE, _("The BY subcommand may be given once at most."));
+ goto lossage;
+ }
+ seen |= 1;
+
+ lex_match ('=');
+ if (!parse_variables (mtf_master, &mtf_by, &mtf_n_by,
+ PV_NO_DUPLICATE | PV_NO_SCRATCH))
+ goto lossage;
+ }
+ else if (token != T_ID)
+ {
+ lex_error (NULL);
+ goto lossage;
+ }
+ else if (lex_id_match ("FILE", tokid) || lex_id_match ("TABLE", tokid))
+ {
+ struct mtf_file *file = xmalloc (sizeof *file);
+
+ file->in[0] = file->first[0] = file->last[0] = '\0';
+ file->dict = NULL;
+ file->by = NULL;
+ file->input = NULL;
+
+ if (lex_match_id ("FILE"))
+ file->type = MTF_FILE;
+ else if (lex_match_id ("TABLE"))
+ {
+ file->type = MTF_TABLE;
+ seen |= 4;
+ }
+ else
+ assert (0);
+
+ /* FILEs go first, then TABLEs. */
+ if (file->type == MTF_TABLE || first_table == NULL)
+ {
+ file->next = NULL;
+ file->prev = mtf_tail;
+ if (mtf_tail)
+ mtf_tail->next = file;
+ mtf_tail = file;
+ if (mtf_head == NULL)
+ mtf_head = file;
+ if (file->type == MTF_TABLE && first_table == NULL)
+ first_table = file;
+ }
+ else
+ {
+ assert (file->type == MTF_FILE);
+ file->next = first_table;
+ file->prev = first_table->prev;
+ if (first_table->prev)
+ first_table->prev->next = file;
+ else
+ mtf_head = file;
+ first_table->prev = file;
+ }
+
+ lex_match ('=');
+
+ if (lex_match ('*'))
+ {
+ file->handle = NULL;
+
+ if (seen & 2)
+ {
+ msg (SE, _("The active file may not be specified more "
+ "than once."));
+ goto lossage;
+ }
+ seen |= 2;
+
+ assert (pgm_state != STATE_INPUT);
+ if (pgm_state == STATE_INIT)
+ {
+ msg (SE, _("Cannot specify the active file since no active "
+ "file has been defined."));
+ goto lossage;
+ }
+ }
+ else
+ {
+ file->handle = fh_parse_file_handle ();
+ if (!file->handle)
+ goto lossage;
+ }
+
+ if (file->handle)
+ {
+ file->dict = sfm_read_dictionary (file->handle, NULL);
+ if (!file->dict)
+ goto lossage;
+ }
+ else
+ file->dict = &default_dict;
+ if (!mtf_merge_dictionary (file))
+ goto lossage;
+ }
+ else if (lex_id_match ("IN", tokid)
+ || lex_id_match ("FIRST", tokid)
+ || lex_id_match ("LAST", tokid))
+ {
+ const char *sbc;
+ char *name;
+
+ if (mtf_tail == NULL)
+ {
+ msg (SE, _("IN, FIRST, and LAST subcommands may not occur "
+ "before the first FILE or TABLE."));
+ goto lossage;
+ }
+
+ if (lex_match_id ("IN"))
+ {
+ name = mtf_tail->in;
+ sbc = "IN";
+ }
+ else if (lex_match_id ("FIRST"))
+ {
+ name = mtf_tail->first;
+ sbc = "FIRST";
+ }
+ else if (lex_match_id ("LAST"))
+ {
+ name = mtf_tail->last;
+ sbc = "LAST";
+ }
+ else
+ assert (0);
+
+ lex_match ('=');
+ if (token != T_ID)
+ {
+ lex_error (NULL);
+ goto lossage;
+ }
+
+ if (*name)
+ {
+ msg (SE, _("Multiple %s subcommands for a single FILE or "
+ "TABLE."),
+ sbc);
+ goto lossage;
+ }
+ strcpy (name, tokid);
+ lex_get ();
+
+ if (!create_variable (mtf_master, name, NUMERIC, 0))
+ {
+ msg (SE, _("Duplicate variable name %s while creating %s "
+ "variable."),
+ name, sbc);
+ goto lossage;
+ }
+ }
+ else if (lex_id_match ("RENAME", tokid)
+ || lex_id_match ("KEEP", tokid)
+ || lex_id_match ("DROP", tokid))
+ {
+ int options = GTSV_OPT_MATCH_FILES;
+
+ if (mtf_tail == NULL)
+ {
+ msg (SE, _("RENAME, KEEP, and DROP subcommands may not occur "
+ "before the first FILE or TABLE."));
+ goto lossage;
+ }
+
+ if (!trim_dictionary (mtf_tail->dict, &options))
+ goto lossage;
+ }
+ else if (lex_match_id ("MAP"))
+ {
+ /* FIXME. */
+ }
+ else
+ {
+ lex_error (NULL);
+ goto lossage;
+ }
+ }
+ while (token != '.');
+
+ if (seen & 4)
+ {
+ if (!(seen & 1))
+ {
+ msg (SE, _("The BY subcommand is required when a TABLE subcommand "
+ "is given."));
+ goto lossage;
+ }
+ }
+
+ if (seen & 1)
+ {
+ struct mtf_file *iter;
+
+ for (iter = mtf_head; iter; iter = iter->next)
+ {
+ int i;
+
+ iter->by = xmalloc (sizeof *iter->by * mtf_n_by);
+
+ for (i = 0; i < mtf_n_by; i++)
+ {
+ iter->by[i] = find_dict_variable (iter->dict, mtf_by[i]->name);
+ if (iter->by[i] == NULL)
+ {
+ msg (SE, _("File %s lacks BY variable %s."),
+ iter->handle ? fh_handle_name (iter->handle) : "*",
+ mtf_by[i]->name);
+ goto lossage;
+ }
+ }
+ }
+ }
+
+#if DEBUGGING
+ {
+ /* From sfm-read.c. */
+ extern void dump_dictionary (struct dictionary *);
+
+ dump_dictionary (mtf_master);
+ }
+#endif
+
+ /* MATCH FILES performs an n-way merge on all its input files.
+ Abstract algorithm:
+
+ 1. Read one input record from every input FILE.
+
+ 2. If no FILEs are left, stop. Otherwise, proceed to step 3.
+
+ 3. Find the FILE input record with minimum BY values. Store all
+ the values from this input record into the output record.
+
+ 4. Find all the FILE input records with BY values identical to
+ the minimums. Store all the values from these input records into
+ the output record.
+
+ 5. For every TABLE, read another record as long as the BY values
+ on the TABLE's input record are less than the FILEs' BY values.
+ If an exact match is found, store all the values from the TABLE
+ input record into the output record.
+
+ 6. Write the output record.
+
+ 7. Read another record from each input file FILE and TABLE that
+ we stored values from above. If we come to the end of one of the
+ input files, remove it from the list of input files.
+
+ 8. Repeat from step 2.
+
+ Unfortunately, this algorithm can't be directly implemented
+ because there's no function to read a record from the active
+ file; instead, it has to be done using callbacks.
+
+ FIXME: A better algorithm would use a heap for finding minimum
+ values, or replacement selection, as described by Knuth in _Art
+ of Computer Programming, Vol. 3_. The SORT CASES procedure does
+ this, and perhaps some of its code could be adapted. */
+
+ if (!(seen & 2))
+ discard_variables ();
+
+ temporary = 2;
+ temp_dict = mtf_master;
+ temp_trns = n_trns;
+
+ process_active_file (mtf_read_nonactive_records, mtf_processing,
+ mtf_processing_finish);
+ mtf_master = NULL;
+
+ mtf_free ();
+ return CMD_SUCCESS;
+
+lossage:
+ mtf_free ();
+ return CMD_FAILURE;
+}
+
+/* Repeats 2...8 an arbitrary number of times. */
+static void
+mtf_processing_finish (void)
+{
+ /* Find the active file and delete it. */
+ {
+ struct mtf_file *iter;
+
+ for (iter = mtf_head; iter; iter = iter->next)
+ if (iter->handle == NULL)
+ {
+ mtf_delete_file_in_place (&iter);
+ break;
+ }
+ }
+
+ while (mtf_head && mtf_head->type == MTF_FILE)
+ if (!mtf_processing (temp_case))
+ break;
+}
+
+/* Return a string in a static buffer describing V's variable type and
+ width. */
+static char *
+var_type_description (struct variable *v)
+{
+ static char buf[2][32];
+ static int x = 0;
+ char *s;
+
+ x ^= 1;
+ s = buf[x];
+
+ if (v->type == NUMERIC)
+ strcpy (s, "numeric");
+ else
+ {
+ assert (v->type == ALPHA);
+ sprintf (s, "string with width %d", v->width);
+ }
+ return s;
+}
+
+/* Free FILE and associated data. */
+static void
+mtf_free_file (struct mtf_file *file)
+{
+ fh_close_handle (file->handle);
+ if (file->dict && file->dict != &default_dict)
+ free_dictionary (file->dict);
+ free (file->by);
+ if (file->handle)
+ free (file->input);
+ free (file);
+}
+
+/* Free all the data for the MATCH FILES procedure. */
+static void
+mtf_free (void)
+{
+ struct mtf_file *iter, *next;
+
+ for (iter = mtf_head; iter; iter = next)
+ {
+ next = iter->next;
+
+ mtf_free_file (iter);
+ }
+
+ free (mtf_by);
+ if (mtf_master)
+ free_dictionary (mtf_master);
+}
+
+/* Remove *FILE from the mtf_file chain. Make *FILE point to the next
+ file in the chain, or to NULL if was the last in the chain. */
+static void
+mtf_delete_file_in_place (struct mtf_file **file)
+{
+ struct mtf_file *f = *file;
+
+ if (f->prev)
+ f->prev->next = f->next;
+ if (f->next)
+ f->next->prev = f->prev;
+ if (f == mtf_head)
+ mtf_head = f->next;
+ if (f == mtf_tail)
+ mtf_tail = f->prev;
+ *file = f->next;
+
+ {
+ int i;
+
+ for (i = 0; i < f->dict->nvar; i++)
+ {
+ struct variable *v = f->dict->var[i];
+
+ if (v->type == NUMERIC)
+ compaction_case->data[v->p.mtf.master->fv].f = SYSMIS;
+ else
+ memset (compaction_case->data[v->p.mtf.master->fv].s, ' ',
+ v->width);
+ }
+ }
+
+ mtf_free_file (f);
+}
+
+/* Read a record from every input file except the active file. */
+static void
+mtf_read_nonactive_records (void)
+{
+ struct mtf_file *iter;
+
+ for (iter = mtf_head; iter; )
+ {
+ if (iter->handle)
+ {
+ assert (iter->input == NULL);
+ iter->input = xmalloc (sizeof *iter->input * iter->dict->nval);
+
+ if (!sfm_read_case (iter->handle, iter->input, iter->dict))
+ mtf_delete_file_in_place (&iter);
+ else
+ iter = iter->next;
+ }
+ else
+ {
+ iter->input = temp_case->data;
+ iter = iter->next;
+ }
+ }
+}
+
+/* Compare the BY variables for files A and B; return -1 if A < B, 0
+ if A == B, 1 if A > B. */
+static inline int
+mtf_compare_BY_values (struct mtf_file *a, struct mtf_file *b)
+{
+ int i;
+
+ for (i = 0; i < mtf_n_by; i++)
+ {
+ assert (a->by[i]->type == b->by[i]->type);
+ assert (a->by[i]->width == b->by[i]->width);
+
+ if (a->by[i]->type == NUMERIC)
+ {
+ double af = a->input[a->by[i]->fv].f;
+ double bf = b->input[b->by[i]->fv].f;
+
+ if (af < bf)
+ return -1;
+ else if (af > bf)
+ return 1;
+ }
+ else
+ {
+ int result;
+
+ assert (a->by[i]->type == ALPHA);
+ result = memcmp (a->input[a->by[i]->fv].s,
+ b->input[b->by[i]->fv].s,
+ a->by[i]->width);
+ if (result < 0)
+ return -1;
+ else if (result > 0)
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/* Used to determine whether we've already initialized this
+ variable. */
+static int mtf_seq_no = 0;
+
+/* Perform one iteration of steps 3...7 above. */
+static int
+mtf_processing (struct ccase *c unused)
+{
+ /* List of files with minimum BY values. */
+ struct mtf_file *min_head, *min_tail;
+
+ /* List of files with non-minimum BY values. */
+ struct mtf_file *max_head, *max_tail;
+
+ /* Iterator. */
+ struct mtf_file *iter;
+
+ for (;;)
+ {
+ /* If the active file doesn't have the minimum BY values, don't
+ return because that would cause a record to be skipped. */
+ int advance = 1;
+
+ if (mtf_head->type == MTF_TABLE)
+ return 0;
+
+ /* 3. Find the FILE input record with minimum BY values. Store
+ all the values from this input record into the output record.
+
+ 4. Find all the FILE input records with BY values identical
+ to the minimums. Store all the values from these input
+ records into the output record. */
+ min_head = min_tail = mtf_head;
+ max_head = max_tail = NULL;
+ for (iter = mtf_head->next; iter && iter->type == MTF_FILE;
+ iter = iter->next)
+ switch (mtf_compare_BY_values (min_head, iter))
+ {
+ case -1:
+ if (max_head)
+ max_tail = max_tail->next_min = iter;
+ else
+ max_head = max_tail = iter;
+ break;
+
+ case 0:
+ min_tail = min_tail->next_min = iter;
+ break;
+
+ case 1:
+ if (max_head)
+ {
+ max_tail->next_min = min_head;
+ max_tail = min_tail;
+ }
+ else
+ {
+ max_head = min_head;
+ max_tail = min_tail;
+ }
+ min_head = min_tail = iter;
+ break;
+
+ default:
+ assert (0);
+ }
+
+ /* 5. For every TABLE, read another record as long as the BY
+ values on the TABLE's input record are less than the FILEs'
+ BY values. If an exact match is found, store all the values
+ from the TABLE input record into the output record. */
+ while (iter)
+ {
+ struct mtf_file *next = iter->next;
+
+ assert (iter->type == MTF_TABLE);
+
+ if (iter->handle == NULL)
+ advance = 0;
+
+ again:
+ switch (mtf_compare_BY_values (min_head, iter))
+ {
+ case -1:
+ if (max_head)
+ max_tail = max_tail->next_min = iter;
+ else
+ max_head = max_tail = iter;
+ break;
+
+ case 0:
+ min_tail = min_tail->next_min = iter;
+ break;
+
+ case 1:
+ if (iter->handle == NULL)
+ return 1;
+ if (sfm_read_case (iter->handle, iter->input, iter->dict))
+ goto again;
+ mtf_delete_file_in_place (&iter);
+ break;
+
+ default:
+ assert (0);
+ }
+
+ iter = next;
+ }
+
+ /* Next sequence number. */
+ mtf_seq_no++;
+
+ /* Store data to all the records we are using. */
+ if (min_tail)
+ min_tail->next_min = NULL;
+ for (iter = min_head; iter; iter = iter->next_min)
+ {
+ int i;
+
+ for (i = 0; i < iter->dict->nvar; i++)
+ {
+ struct variable *v = iter->dict->var[i];
+
+ if (v->p.mtf.master->foo == mtf_seq_no)
+ continue;
+ v->p.mtf.master->foo = mtf_seq_no;
+
+#if 0
+ printf ("%s/%s: dest-fv=%d, src-fv=%d\n",
+ fh_handle_name (iter->handle),
+ v->name,
+ v->p.mtf.master->fv, v->fv);
+#endif
+ if (v->type == NUMERIC)
+ compaction_case->data[v->p.mtf.master->fv].f
+ = iter->input[v->fv].f;
+ else
+ {
+ assert (v->type == ALPHA);
+ memcpy (compaction_case->data[v->p.mtf.master->fv].s,
+ iter->input[v->fv].s, v->width);
+#if __CHECKER__
+ memset (&compaction_case
+ ->data[v->p.mtf.master->fv].s[v->width],
+ 0, REM_RND_UP (v->width, MAX_SHORT_STRING));
+#endif
+ }
+ }
+ }
+
+ /* Store missing values to all the records we're not using. */
+ if (max_tail)
+ max_tail->next_min = NULL;
+ for (iter = max_head; iter; iter = iter->next_min)
+ {
+ int i;
+
+ for (i = 0; i < iter->dict->nvar; i++)
+ {
+ struct variable *v = iter->dict->var[i];
+
+ if (v->p.mtf.master->foo == mtf_seq_no)
+ continue;
+ v->p.mtf.master->foo = mtf_seq_no;
+
+#if 0
+ printf ("%s/%s: dest-fv=%d\n",
+ fh_handle_name (iter->handle),
+ v->name,
+ v->p.mtf.master->fv);
+#endif
+ if (v->type == NUMERIC)
+ compaction_case->data[v->p.mtf.master->fv].f = SYSMIS;
+ else
+ {
+ memset (compaction_case->data[v->p.mtf.master->fv].s, ' ',
+ v->width);
+#if __CHECKER__
+ memset (&compaction_case
+ ->data[v->p.mtf.master->fv].s[v->width],
+ 0, REM_RND_UP (v->width, MAX_SHORT_STRING));
+#endif
+ }
+ }
+
+ if (iter->handle == NULL)
+ advance = 0;
+ }
+
+ /* 6. Write the output record. */
+ process_active_file_output_case ();
+
+ /* 7. Read another record from each input file FILE and TABLE
+ that we stored values from above. If we come to the end of
+ one of the input files, remove it from the list of input
+ files. */
+ for (iter = min_head; iter && iter->type == MTF_FILE; )
+ {
+ struct mtf_file *next = iter->next_min;
+
+ if (iter->handle)
+ {
+ assert (iter->input != NULL);
+
+ if (!sfm_read_case (iter->handle, iter->input, iter->dict))
+ mtf_delete_file_in_place (&iter);
+ }
+
+ iter = next;
+ }
+
+ if (advance)
+ break;
+ }
+
+ return (mtf_head && mtf_head->type != MTF_TABLE);
+}
+
+/* Merge the dictionary for file F into the master dictionary
+ mtf_master. */
+static int
+mtf_merge_dictionary (struct mtf_file *f)
+{
+ struct dictionary *const m = mtf_master;
+ struct dictionary *d = f->dict;
+
+ if (d->label && m->label == NULL)
+ m->label = xstrdup (d->label);
+
+ if (d->documents)
+ {
+ m->documents = xrealloc (m->documents,
+ 80 * (m->n_documents + d->n_documents));
+ memcpy (&m->documents[80 * m->n_documents],
+ d->documents, 80 * d->n_documents);
+ m->n_documents += d->n_documents;
+ }
+
+ {
+ int i;
+
+ d->nval = 0;
+ for (i = 0; i < d->nvar; i++)
+ {
+ struct variable *dv = d->var[i];
+ struct variable *mv = find_dict_variable (m, dv->name);
+
+ dv->fv = d->nval;
+ d->nval += dv->nv;
+
+ assert (dv->type == ALPHA || dv->width == 0);
+ assert (!mv || mv->type == ALPHA || mv->width == 0);
+ if (mv && dv->width == mv->width)
+ {
+ if (dv->val_lab && !mv->val_lab)
+ mv->val_lab = copy_value_labels (dv->val_lab);
+ if (dv->miss_type != MISSING_NONE && mv->miss_type == MISSING_NONE)
+ copy_missing_values (mv, dv);
+ }
+ if (mv && dv->label && !mv->label)
+ mv->label = xstrdup (dv->label);
+ if (!mv)
+ {
+ mv = force_dup_variable (m, dv, dv->name);
+
+ /* Used to make sure we initialize each variable in the
+ master dictionary exactly once per case. */
+ mv->foo = mtf_seq_no;
+ }
+ else if (mv->width != dv->width)
+ {
+ msg (SE, _("Variable %s in file %s (%s) has different "
+ "type or width from the same variable in "
+ "earlier file (%s)."),
+ dv->name, fh_handle_name (f->handle),
+ var_type_description (dv), var_type_description (mv));
+ return 0;
+ }
+ dv->p.mtf.master = mv;
+ }
+ }
+
+ return 1;
+}
+\f
+/* IMPORT command. */
+
+/* Parses the IMPORT command. */
+int
+cmd_import (void)
+{
+ struct file_handle *handle = NULL;
+ struct dictionary *dict;
+ int options = GTSV_OPT_NONE;
+ int type;
+
+ int i;
+ int nval;
+
+ lex_match_id ("IMPORT");
+
+ for (;;)
+ {
+ lex_match ('/');
+
+ if (lex_match_id ("FILE") || token == T_STRING)
+ {
+ lex_match ('=');
+
+ handle = fh_parse_file_handle ();
+ if (handle == NULL)
+ return CMD_FAILURE;
+ }
+ else if (lex_match_id ("TYPE"))
+ {
+ lex_match ('=');
+
+ if (lex_match_id ("COMM"))
+ type = PFM_COMM;
+ else if (lex_match_id ("TAPE"))
+ type = PFM_TAPE;
+ else
+ {
+ lex_error (_("expecting COMM or TAPE"));
+ return CMD_FAILURE;
+ }
+ }
+ else break;
+ }
+ if (!lex_match ('/') && token != '.')
+ {
+ lex_error (NULL);
+ return CMD_FAILURE;
+ }
+
+ discard_variables ();
+
+ dict = pfm_read_dictionary (handle, NULL);
+ if (dict == NULL)
+ return CMD_FAILURE;
+
+#if DEBUGGING
+ dump_dict_variables (dict);
+#endif
+ if (0 == trim_dictionary (dict, &options))
+ {
+ fh_close_handle (handle);
+ return CMD_FAILURE;
+ }
+#if DEBUGGING
+ dump_dict_variables (dict);
+#endif
+
+ /* Set the fv and lv elements of all variables remaining in the
+ dictionary. */
+ nval = 0;
+ for (i = 0; i < dict->nvar; i++)
+ {
+ struct variable *v = dict->var[i];
+
+ v->fv = nval;
+ nval += v->nv;
+ }
+ dict->nval = nval;
+ assert (nval);
+
+#if DEBUGGING
+ printf (_("IMPORT translation table from file to memory:\n"));
+ for (i = 0; i < dict->nvar; i++)
+ {
+ struct variable *v = dict->var[i];
+
+ printf (_(" %8s from %3d,%3d to %3d,%3d\n"), v->name,
+ v->get.fv, v->get.nv, v->fv, v->nv);
+ }
+#endif
+
+ restore_dictionary (dict);
+
+ vfm_source = &import_source;
+ get_file = handle;
+
+ return CMD_SUCCESS;
+}
+
+/* Reads all the cases from the data file and passes them to
+ write_case(). */
+static void
+import_source_read (void)
+{
+ while (pfm_read_case (get_file, temp_case->data, &default_dict)
+ && write_case ())
+ ;
+ get_source_destroy_source ();
+}
+
+struct case_stream import_source =
+ {
+ NULL,
+ import_source_read,
+ NULL,
+ NULL,
+ get_source_destroy_source,
+ NULL,
+ "IMPORT",
+ };
+\f
+static int export_write_case_func (struct ccase *c);
+
+/* Parses the EXPORT command. */
+/* FIXME: same as cmd_save_internal(). */
+int
+cmd_export (void)
+{
+ struct file_handle *handle;
+ struct dictionary *dict;
+ int options = GTSV_OPT_SAVE;
+
+ struct save_trns *t;
+
+ int i;
+
+ lex_match_id ("EXPORT");
+
+ lex_match ('/');
+ if (lex_match_id ("OUTFILE"))
+ lex_match ('=');
+
+ handle = fh_parse_file_handle ();
+ if (handle == NULL)
+ return CMD_FAILURE;
+
+ dict = save_dictionary ();
+#if DEBUGGING
+ dump_dict_variables (dict);
+#endif
+ for (i = 0; i < dict->nvar; i++)
+ dict->var[i]->foo = i;
+ if (0 == trim_dictionary (dict, &options))
+ {
+ fh_close_handle (handle);
+ return CMD_FAILURE;
+ }
+
+#if DEBUGGING
+ dump_dict_variables (dict);
+#endif
+
+ /* Write dictionary. */
+ if (!pfm_write_dictionary (handle, dict))
+ {
+ free_dictionary (dict);
+ fh_close_handle (handle);
+ return CMD_FAILURE;
+ }
+
+ /* Fill in transformation structure. */
+ t = trns = xmalloc (sizeof *t);
+ t->h.proc = save_trns_proc;
+ t->h.free = save_trns_free;
+ t->f = handle;
+ t->nvar = dict->nvar;
+ t->var = xmalloc (sizeof *t->var * dict->nvar);
+ for (i = 0; i < dict->nvar; i++)
+ t->var[i] = dict->var[i]->foo;
+ t->case_buf = xmalloc (sizeof *t->case_buf * dict->nvar);
+ free_dictionary (dict);
+
+ procedure (NULL, export_write_case_func, NULL);
+ save_trns_free ((struct trns_header *) t);
+
+ return CMD_SUCCESS;
+}
+
+static int
+export_write_case_func (struct ccase *c)
+{
+ union value *p = (union value *) trns->case_buf;
+ int i;
+
+ for (i = 0; i < trns->nvar; i++)
+ {
+ struct variable *v = default_dict.var[trns->var[i]];
+
+ if (v->type == NUMERIC)
+ *p++ = c->data[v->fv];
+ else
+ (*p++).c = c->data[v->fv].s;
+ }
+
+ printf (".");
+ fflush (stdout);
+
+ pfm_write_case (trns->f, (union value *) trns->case_buf);
+ return 1;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdio.h>
+#include <errno.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "error.h"
+#include "filename.h"
+#include "getline.h"
+#include "lexer.h"
+#include "settings.h"
+#include "str.h"
+#include "tab.h"
+#include "var.h"
+#include "version.h"
+
+/* Global variables. */
+struct string getl_buf;
+struct getl_script *getl_head;
+struct getl_script *getl_tail;
+int getl_interactive;
+int getl_welcomed;
+int getl_mode;
+int getl_prompt;
+
+#if HAVE_LIBHISTORY
+static char *history_file;
+
+#if HAVE_READLINE_HISTORY_H
+#include <readline/history.h>
+#else /* no readline/history.h */
+extern void add_history (char *);
+extern void using_history (void);
+extern int read_history (char *);
+extern void stifle_history (int);
+extern int write_history (char *);
+#endif /* no readline/history.h */
+#endif /* -lhistory */
+
+static struct string getl_include_path;
+
+/* Number of levels of DO REPEAT structures we're nested inside. If
+ this is greater than zero then DO REPEAT macro substitutions are
+ performed. */
+static int DO_REPEAT_level;
+
+static int read_console (void);
+
+/* Initialize getline. */
+void
+getl_initialize (void)
+{
+ ds_create (NULL, &getl_include_path,
+ fn_getenv_default ("STAT_INCLUDE_PATH", include_path));
+ ds_init (NULL, &getl_buf, 256);
+}
+
+/* Close getline. */
+void
+getl_uninitialize (void)
+{
+#if HAVE_LIBHISTORY && unix
+ if (history_file)
+ write_history (history_file);
+#endif
+}
+
+/* Returns a string that represents the directory that the syntax file
+ currently being read resides in. If there is no syntax file then
+ returns the OS current working directory. Return value must be
+ free()'d. */
+char *
+getl_get_current_directory (void)
+{
+ return getl_head ? fn_dirname (getl_head->fn) : fn_get_cwd ();
+}
+
+/* Delete everything from the include path. */
+void
+getl_clear_include_path (void)
+{
+ ds_clear (&getl_include_path);
+}
+
+/* Add to the include path. */
+void
+getl_add_include_dir (const char *path)
+{
+ if (ds_length (&getl_include_path))
+ ds_putchar (&getl_include_path, PATH_DELIMITER);
+
+ ds_concat (&getl_include_path, path);
+}
+
+/* Adds FN to the tail end of the list of script files to execute.
+ OPTIONS is the value to stick in the options field of the
+ getl_script struct. If WHERE is zero then the file is added after
+ all other files; otherwise it is added before all other files (this
+ can be done only if parsing has not yet begun). */
+void
+getl_add_file (const char *fn, int separate, int where)
+{
+ struct getl_script *n = xmalloc (sizeof *n);
+
+ assert (fn != NULL);
+ n->next = NULL;
+ if (getl_tail == NULL)
+ getl_head = getl_tail = n;
+ else if (!where)
+ getl_tail = getl_tail->next = n;
+ else
+ {
+ assert (getl_head->f == NULL);
+ n->next = getl_head;
+ getl_head = n;
+ }
+ n->included_from = n->includes = NULL;
+ n->fn = xstrdup (fn);
+ n->ln = 0;
+ n->f = NULL;
+ n->separate = separate;
+ n->first_line = NULL;
+}
+
+/* Inserts the given file with filename FN into the current file after
+ the current line. */
+void
+getl_include (const char *fn)
+{
+ struct getl_script *n;
+ char *real_fn;
+
+ {
+ char *cur_dir = getl_get_current_directory ();
+ real_fn = fn_search_path (fn, ds_value (&getl_include_path), cur_dir);
+ free (cur_dir);
+ }
+
+ if (!real_fn)
+ {
+ msg (SE, _("Can't find `%s' in include file search path."), fn);
+ return;
+ }
+
+ if (!getl_head)
+ {
+ getl_add_file (real_fn, 0, 0);
+ free (real_fn);
+ }
+ else
+ {
+ n = xmalloc (sizeof *n);
+ n->included_from = getl_head;
+ getl_head = getl_head->includes = n;
+ n->includes = NULL;
+ n->next = NULL;
+ n->fn = real_fn;
+ n->ln = 0;
+ n->f = NULL;
+ n->separate = 0;
+ n->first_line = NULL;
+ }
+}
+
+/* Add the virtual file FILE to the list of files to be processed.
+ The first_line field in FILE must already have been initialized. */
+void
+getl_add_virtual_file (struct getl_script *file)
+{
+ if (getl_tail == NULL)
+ getl_head = getl_tail = file;
+ else
+ getl_tail = getl_tail->next = file;
+ file->included_from = file->includes = NULL;
+ file->next = NULL;
+ file->fn = file->first_line->line;
+ file->ln = -file->first_line->len - 1;
+ file->separate = 0;
+ file->f = NULL;
+ file->cur_line = NULL;
+ file->remaining_loops = 1;
+ file->loop_index = -1;
+ file->macros = NULL;
+}
+
+/* Causes the DO REPEAT virtual file passed in FILE to be included in
+ the current file. The first_line, cur_line, remaining_loops,
+ loop_index, and macros fields in FILE must already have been
+ initialized. */
+void
+getl_add_DO_REPEAT_file (struct getl_script *file)
+{
+ /* getl_head == NULL can't happen. */
+ assert (getl_head);
+
+ DO_REPEAT_level++;
+ file->included_from = getl_head;
+ getl_head = getl_head->includes = file;
+ file->includes = NULL;
+ file->next = NULL;
+ assert (file->first_line->len < 0);
+ file->fn = file->first_line->line;
+ file->ln = -file->first_line->len - 1;
+ file->separate = 0;
+ file->f = NULL;
+}
+
+/* Display a welcoming message. */
+void
+welcome (void)
+{
+ getl_welcomed = 1;
+ fputs ("PSPP is free software and you are welcome to distribute copies of"
+ "it\nunder certain conditions; type \"show copying.\" to see the "
+ "conditions.\nThere is ABSOLUTELY NO WARRANTY for PSPP; type \"show "
+ "warranty.\" for details.\n", stdout);
+ puts (stat_version);
+}
+
+/* Reads a single line from the user's terminal. */
+
+/* From repeat.c. */
+extern void perform_DO_REPEAT_substitutions (void);
+
+/* Reads a single line from the line buffer associated with getl_head.
+ Returns 1 if a line was successfully read or 0 if no more lines are
+ available. */
+static int
+handle_line_buffer (void)
+{
+ struct getl_script *s = getl_head;
+
+ /* Check that we're not all done. */
+ do
+ {
+ if (s->cur_line == NULL)
+ {
+ s->loop_index++;
+ if (s->remaining_loops-- == 0)
+ return 0;
+ s->cur_line = s->first_line;
+ }
+
+ if (s->cur_line->len < 0)
+ {
+ s->ln = -s->cur_line->len - 1;
+ s->fn = s->cur_line->line;
+ s->cur_line = s->cur_line->next;
+ continue;
+ }
+ }
+ while (s->cur_line == NULL);
+
+ ds_concat_buffer (&getl_buf, s->cur_line->line, s->cur_line->len);
+
+ /* Advance pointers. */
+ s->cur_line = s->cur_line->next;
+ s->ln++;
+
+ return 1;
+}
+
+/* Reads a single line into getl_buf from the list of files. Will not
+ read from the eof of one file to the beginning of another unless
+ the options field on the new file's getl_script is nonzero. Return
+ zero on eof. */
+int
+getl_read_line (void)
+{
+ getl_mode = GETL_MODE_BATCH;
+
+ while (getl_head)
+ {
+ struct getl_script *s = getl_head;
+
+ ds_clear (&getl_buf);
+ if (s->separate)
+ return 0;
+
+ if (s->first_line)
+ {
+ if (!handle_line_buffer ())
+ {
+ getl_close_file ();
+ continue;
+ }
+ perform_DO_REPEAT_substitutions ();
+ if (getl_head->print)
+ tab_output_text (TAB_LEFT | TAT_FIX | TAT_PRINTF, "+%s",
+ ds_value (&getl_buf));
+ return 1;
+ }
+
+ if (s->f == NULL)
+ {
+ msg (VM (1), _("%s: Opening as syntax file."), s->fn);
+ s->f = fn_open (s->fn, "r");
+
+ if (s->f == NULL)
+ {
+ msg (ME, _("Opening `%s': %s."), s->fn, strerror (errno));
+ getl_close_file ();
+ continue;
+ }
+ }
+
+ if (!ds_getline (&getl_buf, s->f))
+ {
+ if (ferror (s->f))
+ msg (ME, _("Reading `%s': %s."), s->fn, strerror (errno));
+ getl_close_file ();
+ continue;
+ }
+ if (ds_length (&getl_buf) > 0 && ds_end (&getl_buf)[-1] == '\n')
+ ds_truncate (&getl_buf, ds_length (&getl_buf) - 1);
+
+ if (set_echo)
+ tab_output_text (TAB_LEFT | TAT_FIX, ds_value (&getl_buf));
+
+ getl_head->ln++;
+
+ /* Allows shebang invocation: `#! /usr/local/bin/pspp'. */
+ if (ds_value (&getl_buf)[0] == '#'
+ && ds_value (&getl_buf)[1] == '!')
+ continue;
+
+ return 1;
+ }
+
+ if (getl_interactive == 0)
+ return 0;
+
+ getl_mode = GETL_MODE_INTERACTIVE;
+
+ if (getl_welcomed == 0)
+ welcome ();
+
+ return read_console ();
+}
+
+/* Closes the current file, whether it be a main file or included
+ file, then moves getl_head to the next file in the chain. */
+void
+getl_close_file (void)
+{
+ struct getl_script *s = getl_head;
+
+ if (!s)
+ return;
+ assert (getl_tail != NULL);
+
+ if (s->first_line)
+ {
+ struct getl_line_list *cur, *next;
+
+ s->fn = NULL; /* It will be freed below. */
+ for (cur = s->first_line; cur; cur = next)
+ {
+ next = cur->next;
+ free (cur->line);
+ free (cur);
+ }
+
+ DO_REPEAT_level--;
+ }
+
+ if (s->f && EOF == fn_close (s->fn, s->f))
+ msg (MW, _("Closing `%s': %s."), s->fn, strerror (errno));
+ free (s->fn);
+
+ if (s->included_from)
+ {
+ getl_head = s->included_from;
+ getl_head->includes = NULL;
+ }
+ else
+ {
+ getl_head = s->next;
+ if (NULL == getl_head)
+ getl_tail = NULL;
+ }
+
+ free (s);
+}
+
+/* PORTME: Adapt to your local system's idea of the terminal. */
+#if HAVE_LIBREADLINE
+
+#if HAVE_READLINE_READLINE_H
+#include <readline/readline.h>
+#else /* no readline/readline.h */
+extern char *readline (char *);
+#endif /* no readline/readline.h */
+
+static int
+read_console (void)
+{
+ char *line;
+ char *prompt;
+
+ err_error_count = err_warning_count = 0;
+ err_already_flagged = 0;
+
+#if HAVE_LIBHISTORY
+ if (!history_file)
+ {
+#if unix
+ history_file = tilde_expand (HISTORY_FILE);
+#endif
+ using_history ();
+ read_history (history_file);
+ stifle_history (MAX_HISTORY);
+ }
+#endif /* -lhistory */
+
+ switch (getl_prompt)
+ {
+ case GETL_PRPT_STANDARD:
+ prompt = set_prompt;
+ break;
+
+ case GETL_PRPT_CONTINUATION:
+ prompt = set_cprompt;
+ break;
+
+ case GETL_PRPT_DATA:
+ prompt = set_dprompt;
+ break;
+
+ default:
+ assert (0);
+ }
+
+ line = readline (prompt);
+ if (!line)
+ return 0;
+
+#if HAVE_LIBHISTORY
+ if (*line)
+ add_history (line);
+#endif
+
+ ds_clear (&getl_buf);
+ ds_concat (&getl_buf, line);
+
+ return 1;
+}
+#else /* no -lreadline */
+static int
+read_console (void)
+{
+ err_error_count = err_warning_count = 0;
+ err_already_flagged = 0;
+
+ fputs (getl_prompt ? set_cprompt : set_prompt, stdout);
+ ds_clear (&getl_buf);
+ if (ds_getline (&getl_buf, stdin))
+ return 1;
+
+ if (ferror (stdin))
+ msg (FE, "stdin: fgets(): %s.", strerror (errno));
+
+ return 0;
+}
+#endif /* no -lreadline */
+
+/* Closes all files. */
+void
+getl_close_all (void)
+{
+ while (getl_head)
+ getl_close_file ();
+}
+
+/* Sets the options flag of the current script to 0, thus allowing it
+ to be read in. Returns nonzero if this action was taken, zero
+ otherwise. */
+int
+getl_perform_delayed_reset (void)
+{
+ if (getl_head && getl_head->separate)
+ {
+ getl_head->separate = 0;
+ discard_variables ();
+ lex_reset_eof ();
+ return 1;
+ }
+ return 0;
+}
+
+/* Puts the current file and line number in *FN and *LN, respectively,
+ or NULL and -1 if none. */
+void
+getl_location (const char **fn, int *ln)
+{
+ if (fn != NULL)
+ *fn = getl_head ? getl_head->fn : NULL;
+ if (ln != NULL)
+ *ln = getl_head ? getl_head->ln : -1;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !getline_h
+#define getline_h 1
+
+#include <stdio.h>
+
+/* Defines a list of lines used by DO REPEAT. */
+/* Special case: if LEN is negative then it is a line number; in this
+ case LINE is a file name. This is used to allow errors to be
+ reported for the correct file and line number when DO REPEAT spans
+ files. */
+struct getl_line_list
+ {
+ char *line; /* Line contents. */
+ int len; /* Line length. */
+ struct getl_line_list *next; /* Next line. */
+ };
+
+/* Source file. */
+struct getl_script
+ {
+ struct getl_script *included_from; /* File that this is nested inside. */
+ struct getl_script *includes; /* File nested inside this file. */
+ struct getl_script *next; /* Next file in list. */
+ char *fn; /* Filename. */
+ int ln; /* Line number. */
+ int separate; /* !=0 means this is a separate job. */
+ FILE *f; /* File handle. */
+
+ /* Used only if F is NULL. Used for DO REPEAT. */
+ struct getl_line_list *first_line; /* First line in line buffer. */
+ struct getl_line_list *cur_line; /* Current line in line buffer. */
+ int remaining_loops; /* Number of remaining loops through LINES. */
+ int loop_index; /* Number of loops through LINES so far. */
+ void *macros; /* Pointer to macro table. */
+ int print; /* 1=Print lines as executed. */
+ };
+
+/* List of script files. */
+extern struct getl_script *getl_head; /* Current file. */
+extern struct getl_script *getl_tail; /* End of list. */
+
+/* If getl_head==0 and getl_interactive!=0, lines will be read from
+ the console rather than terminating. */
+extern int getl_interactive;
+
+/* 1=the welcome message has been printed. */
+extern int getl_welcomed;
+
+/* Prompt styles. */
+enum
+ {
+ GETL_PRPT_STANDARD, /* Just asks for a command. */
+ GETL_PRPT_CONTINUATION, /* Continuation lines for a single command. */
+ GETL_PRPT_DATA /* Between BEGIN DATA and END DATA. */
+ };
+
+/* Current mode. */
+enum
+ {
+ GETL_MODE_BATCH, /* Batch mode. */
+ GETL_MODE_INTERACTIVE /* Interactive mode. */
+ };
+
+/* One of GETL_MODE_*, representing the current mode. */
+extern int getl_mode;
+
+/* Current prompting style: one of GETL_PRPT_*. */
+extern int getl_prompt;
+
+/* Are we reading a script? Are we interactive? */
+#define getl_am_interactive (getl_head == NULL)
+#define getl_reading_script (getl_head != NULL)
+
+/* Current line. This line may be modified by modules other than
+ getline.c, and by lexer.c in particular. */
+extern struct string getl_buf;
+
+/* Name of the command history file. */
+#if HAVE_LIBREADLINE && HAVE_LIBHISTORY
+extern char *getl_history;
+#endif
+
+void getl_initialize (void);
+void getl_uninitialize (void);
+void getl_clear_include_path (void);
+char *getl_get_current_directory (void);
+void getl_add_include_dir (const char *);
+void getl_add_file (const char *fn, int separate, int where);
+void getl_include (const char *fn);
+int getl_read_line (void);
+void getl_close_file (void);
+void getl_close_all (void);
+int getl_perform_delayed_reset (void);
+void getl_add_DO_REPEAT_file (struct getl_script *);
+void getl_add_virtual_file (struct getl_script *);
+void getl_location (const char **, int *);
+
+#endif /* getline_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+
+#include <assert.h>
+#include <stdlib.h>
+
+#if TIME_WITH_SYS_TIME
+#include <sys/time.h>
+#include <time.h>
+#else
+#if HAVE_SYS_TIME_H
+#include <sys/time.h>
+#else
+#include <time.h>
+#endif
+#endif
+
+#if HAVE_LIBTERMCAP
+#if HAVE_TERMCAP_H
+#include <termcap.h>
+#else /* !HAVE_TERMCAP_H */
+int tgetent (char *, char *);
+int tgetnum (char *);
+#endif /* !HAVE_TERMCAP_H */
+#endif /* !HAVE_LIBTERMCAP */
+
+#if HAVE_LIBHISTORY
+#if HAVE_READLINE_HISTORY_H
+#include <readline/history.h>
+#else /* no readline/history.h */
+extern void using_history ();
+extern int read_history ();
+extern void stifle_history ();
+#endif /* no readline/history.h */
+#endif /* -lhistory */
+
+#if HAVE_FPU_CONTROL_H
+#include <fpu_control.h>
+#elif __BORLANDC__
+#include <float.h>
+#include <math.h>
+#endif
+
+#if __DJGPP__
+#include <conio.h>
+#elif __WIN32__ && __BORLANDC__
+#undef gettext
+#include <conio.h>
+#define gettext(STRING) \
+ STRING
+#endif
+
+#if HAVE_LOCALE_H
+#include <locale.h>
+#endif
+
+#if HAVE_FENV_H
+#include <fenv.h>
+#endif
+
+#include "alloc.h"
+#include "avl.h"
+#include "command.h"
+#include "do-ifP.h"
+#include "error.h"
+#include "expr.h"
+#include "filename.h"
+#include "getline.h"
+#include "julcal/julcal.h"
+#include "lexer.h"
+#include "main.h"
+#include "settings.h"
+#include "str.h"
+#include "var.h"
+#include "version.h"
+#include "vfm.h"
+
+/* var.h */
+struct dictionary default_dict;
+struct expression *process_if_expr;
+
+struct ccase *temp_case;
+
+struct trns_header **t_trns;
+int n_trns;
+int m_trns;
+int f_trns;
+
+int FILTER_before_TEMPORARY;
+
+struct file_handle *default_handle;
+
+void (*read_active_file) (void);
+void (*cancel_input_pgm) (void);
+
+struct ctl_stmt *ctl_stack;
+
+/* log.h */
+char *logfn;
+FILE *logfile;
+int logging;
+\f
+/* Functions. */
+
+static void get_date (void);
+
+#if HAVE_LIBTERMCAP && !__CHECKER__
+static char *term_buffer;
+#endif
+
+void
+init_glob (int argc unused, char **argv)
+{
+ /* FIXME: Allow i18n of other locale items (besides LC_MESSAGES). */
+#if ENABLE_NLS
+#if LC_MESSAGE
+ setlocale (LC_MESSAGES, "");
+#endif
+ setlocale (LC_MONETARY, "");
+ bindtextdomain (PACKAGE, locale_dir);
+ textdomain (PACKAGE);
+#endif /* ENABLE_NLS */
+
+ /* Workable defaults before we determine the real terminal size. */
+ set_viewwidth = 79;
+ set_viewlength = 24;
+
+ fn_init ();
+ getl_initialize ();
+
+ /* PORTME: If your system/OS has the nasty tendency to halt with a
+ SIGFPE whenever there's a floating-point overflow (or other
+ exception), be sure to mask off those bits in the FPU here.
+ PSPP wants a guarantee that, no matter what boneheaded
+ floating-point operation it performs, the process will not halt. */
+#if HAVE_FEHOLDEXCEPT
+ {
+ fenv_t foo;
+
+ feholdexcept (&foo);
+ }
+#elif HAVE___SETFPUCW && defined(_FPU_IEEE)
+ __setfpucw (_FPU_IEEE);
+#elif __BORLANDC__
+ _control87 (0xffff, 0x137f);
+#endif
+
+#if ENDIAN==UNKNOWN
+ {
+ /* Test for endianness borrowed from acspecific.m4, which was in
+ turn borrowed from Harbison&Steele. */
+ union
+ {
+ long l;
+ char c[sizeof (long)];
+ }
+ u;
+
+ u.l = 1;
+ if (u.c[sizeof u.l - 1] == 1)
+ endian = BIG;
+ else if (u.c[0] == 1)
+ endian = LITTLE;
+ else
+ msg (FE, _("Your machine does not appear to be either big- or little-"
+ "endian. At the moment, PSPP only supports machines of "
+ "these standard endiannesses. If you want to hack in "
+ "others, contact the author."));
+ }
+#endif
+
+ /* PORTME: Set the value for second_lowest_value, which is the
+ "second lowest" possible value for a double. This is the value
+ for LOWEST on MISSING VALUES, etc. */
+#ifndef SECOND_LOWEST_VALUE
+#if FPREP == FPREP_IEEE754
+ {
+ union
+ {
+ unsigned char c[8];
+ double d;
+ }
+ second_lowest_little = {{0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xef, 0xff}},
+ second_lowest_big = {{0xff, 0xef, 0xff, 0xff, 0xff, 0xff, 0xff, 0xfe}};
+
+ if (endian == LITTLE)
+ second_lowest_value = second_lowest_little.d;
+ else if (endian == BIG)
+ second_lowest_value = second_lowest_big.d;
+ }
+#else /* FPREP != FPREP_IEEE754 */
+#error Unknown floating-point representation.
+#endif /* FPREP != FPREP_IEEE754 */
+#endif /* !SECOND_LOWEST_VALUE */
+
+ /* var.h */
+ default_dict.var_by_name = avl_create (NULL, cmp_variable, NULL);
+
+ vec_init (&reinit_sysmis);
+ vec_init (&reinit_blanks);
+ vec_init (&init_zero);
+ vec_init (&init_blanks);
+
+ last_vfm_invocation = time (NULL);
+
+ /* lexer.h */
+ ds_init (NULL, &tokstr, 64);
+
+ /* common.h */
+ {
+ char *cp;
+
+ pgmname = argv[0];
+ for (;;)
+ {
+ cp = strchr (pgmname, DIR_SEPARATOR);
+ if (!cp)
+ break;
+ pgmname = &cp[1];
+ }
+ cur_proc = NULL;
+ }
+
+ /* settings.h */
+#if !USE_INTERNAL_PAGER
+ {
+ char *pager;
+
+ pager = getenv ("STAT_PAGER");
+ if (!pager)
+ pager = getenv ("PAGER");
+ if (pager)
+ set_pager = xstrdup (pager);
+#if DEFAULT_PAGER
+ else
+ set_pager = xstrdup (DEFAULT_PAGER);
+#endif /* DEFAULT_PAGER */
+ }
+#endif /* !USE_INTERNAL_PAGER */
+
+ set_blanks = SYSMIS;
+ set_scompression = 1;
+ set_format.type = FMT_F;
+ set_format.w = 8;
+ set_format.d = 2;
+ set_cpi = 6;
+ set_lpi = 10;
+ set_results_file = xstrdup ("pspp.prc");
+ set_dprompt = xstrdup (_("data> "));
+
+ {
+ int i;
+
+ for (i = 0; i < 5; i++)
+ {
+ struct set_cust_currency *cc = &set_cc[i];
+ strcpy (cc->buf, "-");
+ cc->neg_prefix = cc->buf;
+ cc->prefix = &cc->buf[1];
+ cc->suffix = &cc->buf[1];
+ cc->neg_suffix = &cc->buf[1];
+ cc->decimal = '.';
+ cc->grouping = ',';
+ }
+ }
+
+ set_decimal = '.';
+ set_grouping = ',';
+ set_headers = 1;
+ set_journaling = 1;
+ set_journal = xstrdup ("pspp.jnl");
+ set_messages = 1;
+ set_mexpand = 1;
+ set_mprint = 1;
+ set_mxerrs = 50;
+ set_mxwarns = 100;
+ set_printback = 1;
+ set_undefined = 1;
+
+ set_cprompt = xstrdup (" > ");
+ set_echo = 0;
+ set_endcmd = '.';
+ set_errorbreak = 0;
+ set_include = 1;
+ set_nullline = 1;
+ set_more = 1;
+ set_prompt = xstrdup ("PSPP> ");
+ set_seed = 2000000;
+
+#if __DJGPP__ || __BORLANDC__
+ {
+ struct text_info ti;
+
+ gettextinfo (&ti);
+ set_viewlength = max (ti.screenheight, 25);
+ set_viewwidth = max (ti.screenwidth, 79);
+ }
+#elif HAVE_LIBTERMCAP
+ {
+ char *termtype;
+ int success;
+
+ /* This code stolen from termcap.info, though modified. */
+#if !__CHECKER__
+ term_buffer = xmalloc (2048);
+#endif
+
+ termtype = getenv ("TERM");
+ if (!termtype)
+ msg (FE, _("Specify a terminal type with `setenv TERM <yourtype>'."));
+
+#if __CHECKER__
+ success = tgetent (NULL, termtype);
+#else
+ success = tgetent (term_buffer, termtype);
+#endif
+
+ if (success <= 0)
+ {
+ if (success < 0)
+ msg (IE, _("Could not access the termcap data base."));
+ else
+ msg (IE, _("Terminal type `%s' is not defined."), termtype);
+ msg (MM, _("Assuming screen of size 79x25."));
+ set_viewlength = 25;
+ set_viewwidth = 79;
+ }
+ else
+ {
+ set_viewlength = tgetnum ("li");
+ set_viewwidth = tgetnum ("co") - 1;
+ }
+ }
+#else /* !HAVE_LIBTERMCAP */
+ set_viewlength = 25;
+ set_viewwidth = 79;
+#endif /* !HAVE_LIBTERMCAP */
+
+ /* log.h */
+ logging = 1;
+ logfn = xstrdup ("pspp.log");
+ logfile = NULL;
+
+ /* file-handle.h */
+ {
+ extern void fh_init_files (void);
+
+ fh_init_files ();
+ }
+
+ get_date ();
+}
+
+static void
+get_date ()
+{
+ static const char *months[12] =
+ {
+ N_("Jan"), N_("Feb"), N_("Mar"), N_("Apr"), N_("May"), N_("Jun"),
+ N_("Jul"), N_("Aug"), N_("Sep"), N_("Oct"), N_("Nov"), N_("Dec"),
+ };
+
+ time_t t;
+ int mn, dy, yr;
+ struct tm *tmp;
+
+ if ((time_t) -1 == time (&t))
+ {
+ strcpy (curdate, "1 Jan 1970");
+ return;
+ }
+ tmp = localtime (&t);
+
+ mn = tmp->tm_mon;
+ if (mn < 0)
+ mn = 0;
+ if (mn > 11)
+ mn = 11;
+
+ dy = tmp->tm_mday;
+ if (dy < 0)
+ dy = 0;
+ if (dy > 99)
+ dy = 99;
+
+ yr = tmp->tm_year + 1900;
+ if (yr < 0)
+ yr = 0;
+ if (yr > 9999)
+ yr = 9999;
+
+ sprintf (curdate, "%2d %s %04d", dy, gettext (months[mn]), yr);
+}
+
+int
+cmp_variable (const void *a, const void *b, void *foo unused)
+{
+ return strcmp (((struct variable *) a)->name, ((struct variable *) b)->name);
+}
+
+#if __BORLANDC__
+int
+_RTLENTRY _EXPFUNC _matherr (struct exception _FAR *__e)
+{
+ return 1;
+}
+
+int
+_RTLENTRY _EXPFUNC _matherrl (struct _exceptionl _FAR *__e)
+{
+ return 1;
+}
+#endif
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdio.h>
+#include <errno.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <stdarg.h>
+#include "alloc.h"
+#include "error.h"
+#include "filename.h"
+#include "font.h"
+#include "hash.h"
+#include "pool.h"
+#include "str.h"
+#include "version.h"
+
+int font_number_to_index (int);
+
+int space_index;
+
+static int font_msg (int, const char *,...)
+ __attribute__ ((format (printf, 2, 3)));
+static void scan_badchars (char *, int);
+static void dup_char_metric (struct font_desc * font, int dest, int src);
+static void add_char_metric (struct font_desc * font, struct char_metrics *metrics,
+ int code);
+static void add_kern (struct font_desc * font, int ch1, int ch2, int adjust);
+
+/* Typical whitespace characters for tokenizing. */
+static const char whitespace[] = " \t\n\r\v";
+
+void
+groff_init (void)
+{
+ space_index = font_char_name_to_index ("space");
+}
+
+/* Some notes on the groff_font(8) manpage:
+
+ DESC file format: A typical PostScript `res' would be 72000, with
+ `hor' and `vert' set to 1 to indicate that all those positions are
+ valid. `sizescale' of 1000 would indicate that a scaled point is
+ 1/1000 of a point (which is 1/72000 of an inch, the same as the
+ number of machine units per inch indicated on `res'). `unitwidth'
+ of 1000 would indicate that font files are set up for fonts with
+ point size of 1000 scaled points, which would equal 1/72 inch or 1
+ point (this would tell Groff's postprocessor that it needs to scale
+ the font 12 times larger to get a 12-point font). */
+
+/* Reads a Groff font description file and converts it to a usable
+ binary format in memory. Installs the binary format in the global
+ font table. See groff_font(8) for a description of the font
+ description format supported. Returns nonzero on success. */
+struct font_desc *
+groff_read_font (const char *fn)
+{
+ struct char_metrics *metrics;
+
+ /* Pool created for font, font being created, font file. */
+ struct pool *font_pool = NULL;
+ struct font_desc *font = NULL;
+ FILE *f = NULL;
+
+ /* Current line, size of line buffer, length of line. */
+ char *line = NULL;
+ size_t size;
+ int len;
+
+ /* Tokenization saved pointer. */
+ char *sp;
+
+ /* First token on line. */
+ char *key;
+
+ /* 0=kernpairs section, 1=charset section. */
+ int charset;
+
+ /* Index for previous line. */
+ int prev_index = -1;
+
+ /* Current location in file, used for error reporting. */
+ struct file_locator where;
+
+#if unix
+ fn = fn_tilde_expand (fn);
+#endif
+
+ msg (VM (1), _("%s: Opening Groff font file..."), fn);
+
+ where.filename = fn;
+ where.line_number = 1;
+ err_push_file_locator (&where);
+
+ f = fopen (fn, "r");
+ if (!f)
+ goto file_lossage;
+
+ font_pool = pool_create ();
+ font = pool_alloc (font_pool, sizeof *font);
+ font->owner = font_pool;
+ font->name = NULL;
+ font->internal_name = NULL;
+ font->encoding = NULL;
+ font->space_width = 0;
+ font->slant = 0.0;
+ font->ligatures = 0;
+ font->special = 0;
+ font->deref = NULL;
+ font->deref_size = 0;
+ font->metric = NULL;
+ font->metric_size = 0;
+ font->metric_used = 0;
+ font->kern = NULL;
+ font->kern_size = 0;
+ font->kern_size_p = hsh_next_prime (64);
+ font->kern_used = 0;
+ font->kern_max_used = 0;
+
+ /* Parses first section of font file. */
+ for (;;)
+ {
+ /* Location of '#' in line. */
+ char *p;
+
+ len = getline (&line, &size, f);
+ if (len == -1)
+ break;
+
+ scan_badchars (line, len);
+ p = strchr (line, '#');
+ if (p)
+ *p = '\0'; /* Reject comments. */
+
+ key = strtok_r (line, whitespace, &sp);
+ if (!key)
+ goto next_iteration;
+
+ if (!strcmp (key, "internalname"))
+ {
+ font->internal_name = strtok_r (NULL, whitespace, &sp);
+ if (font->internal_name == NULL)
+ {
+ font_msg (SE, _("Missing font name."));
+ goto lose;
+ }
+ font->internal_name = pool_strdup (font_pool, font->internal_name);
+ }
+ else if (!strcmp (key, "encoding"))
+ {
+ font->encoding = strtok_r (NULL, whitespace, &sp);
+ if (font->encoding == NULL)
+ {
+ font_msg (SE, _("Missing encoding filename."));
+ goto lose;
+ }
+ font->encoding = pool_strdup (font_pool, font->encoding);
+ }
+ else if (!strcmp (key, "spacewidth"))
+ {
+ char *n = strtok_r (NULL, whitespace, &sp);
+ char *tail;
+ if (n)
+ font->space_width = strtol (n, &tail, 10);
+ if (n == NULL || tail == n)
+ {
+ font_msg (SE, _("Bad spacewidth value."));
+ goto lose;
+ }
+ }
+ else if (!strcmp (key, "slant"))
+ {
+ char *n = strtok_r (NULL, whitespace, &sp);
+ char *tail;
+ if (n)
+ font->slant = strtod (n, &tail);
+ if (n == NULL || tail == n)
+ {
+ font_msg (SE, _("Bad slant value."));
+ goto lose;
+ }
+ }
+ else if (!strcmp (key, "ligatures"))
+ {
+ char *lig;
+
+ for (;;)
+ {
+ lig = strtok_r (NULL, whitespace, &sp);
+ if (!lig || !strcmp (lig, "0"))
+ break;
+ else if (!strcmp (lig, "ff"))
+ font->ligatures |= LIG_ff;
+ else if (!strcmp (lig, "ffi"))
+ font->ligatures |= LIG_ffi;
+ else if (!strcmp (lig, "ffl"))
+ font->ligatures |= LIG_ffl;
+ else if (!strcmp (lig, "fi"))
+ font->ligatures |= LIG_fi;
+ else if (!strcmp (lig, "fl"))
+ font->ligatures |= LIG_fl;
+ else
+ {
+ font_msg (SE, _("Unknown ligature `%s'."), lig);
+ goto lose;
+ }
+ }
+ }
+ else if (!strcmp (key, "special"))
+ font->special = 1;
+ else if (!strcmp (key, "charset") || !strcmp (key, "kernpairs"))
+ break;
+
+ where.line_number++;
+ }
+ if (ferror (f))
+ goto file_lossage;
+
+ /* Parses second section of font file (metrics & kerning data). */
+ do
+ {
+ key = strtok_r (line, whitespace, &sp);
+ if (!key)
+ goto next_iteration;
+
+ if (!strcmp (key, "charset"))
+ charset = 1;
+ else if (!strcmp (key, "kernpairs"))
+ charset = 0;
+ else if (charset)
+ {
+ struct char_metrics *metrics = pool_alloc (font_pool,
+ sizeof *metrics);
+ char *m, *type, *code, *tail;
+
+ m = strtok_r (NULL, whitespace, &sp);
+ if (!m)
+ {
+ font_msg (SE, _("Unexpected end of line reading character "
+ "set."));
+ goto lose;
+ }
+ if (!strcmp (m, "\""))
+ {
+ if (!prev_index)
+ {
+ font_msg (SE, _("Can't use ditto mark for first character."));
+ goto lose;
+ }
+ if (!strcmp (key, "---"))
+ {
+ font_msg (SE, _("Can't ditto into an unnamed character."));
+ goto lose;
+ }
+ dup_char_metric (font, font_char_name_to_index (key), prev_index);
+ where.line_number++;
+ goto next_iteration;
+ }
+
+ if (m)
+ {
+ metrics->code = metrics->width
+ = metrics->height = metrics->depth = 0;
+ }
+
+ if (m == NULL || 1 > sscanf (m, "%d,%d,%d", &metrics->width,
+ &metrics->height, &metrics->depth))
+ {
+ font_msg (SE, _("Missing metrics for character `%s'."), key);
+ goto lose;
+ }
+
+ type = strtok_r (NULL, whitespace, &sp);
+ if (type)
+ metrics->type = strtol (type, &tail, 10);
+ if (!type || tail == type)
+ {
+ font_msg (SE, _("Missing type for character `%s'."), key);
+ goto lose;
+ }
+
+ code = strtok_r (NULL, whitespace, &sp);
+ if (code)
+ metrics->code = strtol (code, &tail, 0);
+ if (tail == code)
+ {
+ font_msg (SE, _("Missing code for character `%s'."), key);
+ goto lose;
+ }
+
+ if (strcmp (key, "---"))
+ prev_index = font_char_name_to_index (key);
+ else
+ prev_index = font_number_to_index (metrics->code);
+ add_char_metric (font, metrics, prev_index);
+ }
+ else
+ {
+ char *c1 = key;
+ char *c2 = strtok_r (NULL, whitespace, &sp);
+ char *n, *tail;
+ int adjust;
+
+ if (c2 == NULL)
+ {
+ font_msg (SE, _("Malformed kernpair."));
+ goto lose;
+ }
+
+ n = strtok_r (NULL, whitespace, &sp);
+ if (!n)
+ {
+ font_msg (SE, _("Unexpected end of line reading kernpairs."));
+ goto lose;
+ }
+ adjust = strtol (n, &tail, 10);
+ if (tail == n || *tail)
+ {
+ font_msg (SE, _("Bad kern value."));
+ goto lose;
+ }
+ add_kern (font, font_char_name_to_index (c1),
+ font_char_name_to_index (c2), adjust);
+ }
+
+ next_iteration:
+ where.line_number++;
+
+ len = getline (&line, &size, f);
+ }
+ while (len != -1);
+
+ if (ferror (f))
+ goto file_lossage;
+ if (fclose (f) == EOF)
+ {
+ f = NULL;
+ goto file_lossage;
+ }
+ free (line);
+#if unix
+ free ((char *) fn);
+#endif
+
+ /* Get font ascent and descent. */
+ metrics = font_get_char_metrics (font, font_char_name_to_index ("d"));
+ font->ascent = metrics ? metrics->height : 0;
+ metrics = font_get_char_metrics (font, font_char_name_to_index ("p"));
+ font->descent = metrics ? metrics->depth : 0;
+
+ msg (VM (2), _("Font read successfully with internal name %s."),
+ font->internal_name == NULL ? "<none>" : font->internal_name);
+
+ err_pop_file_locator (&where);
+
+ return font;
+
+ /* Come here on a file error. */
+file_lossage:
+ msg (ME, "%s: %s", fn, strerror (errno));
+
+ /* Come here on any error. */
+lose:
+ fclose (f);
+ pool_destroy (font_pool);
+#if unix
+ free ((char *) fn);
+#endif
+ err_pop_file_locator (&where);
+
+ msg (VM (1), _("Error reading font."));
+ return NULL;
+}
+
+/* Prints a font error on stderr. */
+static int
+font_msg (int class, const char *format,...)
+{
+ va_list args;
+
+ va_start (args, format);
+ tmsg (class, format, args, _("installation error: Groff font error: "));
+ va_end (args);
+
+ return 0;
+}
+
+/* Scans string LINE of length LEN (not incl. null terminator) for bad
+ characters, converts to spaces; reports warnings on file FN. */
+static void
+scan_badchars (char *line, int len)
+{
+ unsigned char *cp = line;
+
+ /* Same bad characters as Groff. */
+ static unsigned char badchars[32] =
+ {
+ 0x01, 0xe8, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0xff, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ };
+
+ for (; len--; cp++)
+ if (badchars[*cp >> 3] & (1 << (*cp & 7)))
+ {
+ font_msg (SE, _("Bad character \\%3o."), *cp);
+ *cp = ' ';
+ }
+}
+\f
+/* Character name hashing. */
+
+/* Associates a character index with a character name. */
+struct index_hash
+ {
+ char *name;
+ int index;
+ };
+
+/* Character index hash table. */
+static struct
+ {
+ int size; /* Size of table. */
+ int *size_p; /* Next larger table size. */
+ int used; /* Number of full entries. */
+ int max_used; /* # used entries where we enlarge & rehash. */
+ int next_index; /* Next index to allocate. */
+ struct index_hash *tab; /* Hash table proper. */
+ struct pool *ar; /* Pool for names. */
+ }
+hash;
+
+/* Searches for NAME in the global character code table, returns the
+ index if found; otherwise inserts NAME and returns the new
+ index. */
+int
+font_char_name_to_index (const char *name)
+{
+ int i;
+
+ if (name[0] == ' ')
+ return space_index;
+ if (name[0] == '\0' || name[1] == '\0')
+ return name[0];
+ if (0 == strncmp (name, "char", 4))
+ {
+ char *tail;
+ int x = strtol (name + 4, &tail, 10);
+ if (tail != name + 4 && *tail == 0 && x >= 0 && x <= 255)
+ return x;
+ }
+
+ if (!hash.tab)
+ {
+ hash.size_p = hsh_next_prime (128);
+ hash.size = *hash.size_p++;
+ hash.used = 0;
+ hash.max_used = hash.size / 2;
+ hash.next_index = 256;
+ hash.tab = xmalloc (sizeof *hash.tab * hash.size);
+ hash.ar = pool_create ();
+ for (i = 0; i < hash.size; i++)
+ hash.tab[i].name = NULL;
+ }
+
+ for (i = hashpjw (name) % hash.size; hash.tab[i].name;)
+ {
+ if (!strcmp (hash.tab[i].name, name))
+ return hash.tab[i].index;
+ if (++i >= hash.size)
+ i = 0;
+ }
+
+ hash.used++;
+ if (hash.used >= hash.max_used)
+ {
+ struct index_hash *old_tab = hash.tab;
+ int old_size = hash.size;
+ int i, j;
+
+ hash.size = *hash.size_p++;
+ hash.max_used = hash.size / 2;
+ hash.tab = xmalloc (sizeof *hash.tab * hash.size);
+ for (i = 0; i < hash.size; i++)
+ hash.tab[i].name = NULL;
+ for (i = 0; i < old_size; i++)
+ if (old_tab[i].name)
+ {
+ for (j = hashpjw (old_tab[i].name) % hash.size; hash.tab[j].name;)
+ if (++j >= hash.size)
+ j = 0;
+ hash.tab[j] = old_tab[i];
+ }
+ free (old_tab);
+ }
+
+ hash.tab[i].name = pool_strdup (hash.ar, name);
+ hash.tab[i].index = hash.next_index;
+ return hash.next_index++;
+}
+
+/* Returns an index for a character that has only a code, not a
+ name. */
+int
+font_number_to_index (int x)
+{
+ char name[INT_DIGITS + 2];
+
+ /* Note that space is the only character that can't appear in a
+ character name. That makes it an excellent choice for a name
+ that won't conflict. */
+ sprintf (name, " %d", x);
+ return font_char_name_to_index (name);
+}
+\f
+/* Font character metric entries. */
+
+/* Ensures room for at least MIN_SIZE metric indexes in deref of
+ FONT. */
+static void
+check_deref_space (struct font_desc *font, int min_size)
+{
+ if (min_size >= font->deref_size)
+ {
+ int i = font->deref_size;
+
+ font->deref_size = min_size + 16;
+ if (font->deref_size < 256)
+ font->deref_size = 256;
+ font->deref = pool_realloc (font->owner, font->deref,
+ sizeof *font->deref * font->deref_size);
+ for (; i < font->deref_size; i++)
+ font->deref[i] = -1;
+ }
+}
+
+/* Inserts METRICS for character with code CODE into FONT. */
+static void
+add_char_metric (struct font_desc *font, struct char_metrics *metrics, int code)
+{
+ check_deref_space (font, code);
+ if (font->metric_used >= font->metric_size)
+ {
+ font->metric_size += 64;
+ font->metric = pool_realloc (font->owner, font->metric,
+ sizeof *font->metric * font->metric_size);
+ }
+ font->metric[font->metric_used] = metrics;
+ font->deref[code] = font->metric_used++;
+}
+
+/* Copies metric in FONT from character with code SRC to character
+ with code DEST. */
+static void
+dup_char_metric (struct font_desc *font, int dest, int src)
+{
+ check_deref_space (font, dest);
+ assert (font->deref[src] != -1);
+ font->deref[dest] = font->deref[src];
+}
+\f
+/* Kerning. */
+
+/* Returns a hash value for characters with codes CH1 and CH2. */
+#define hash_kern(CH1, CH2) \
+ ((unsigned) (((CH1) << 16) ^ (CH2)))
+
+/* Adds an ADJUST-size kern to FONT between characters with codes CH1
+ and CH2. */
+static void
+add_kern (struct font_desc *font, int ch1, int ch2, int adjust)
+{
+ int i;
+
+ if (font->kern_used >= font->kern_max_used)
+ {
+ struct kern_pair *old_kern = font->kern;
+ int old_kern_size = font->kern_size;
+ int j;
+
+ font->kern_size = *font->kern_size_p++;
+ font->kern_max_used = font->kern_size / 2;
+ font->kern = pool_malloc (font->owner,
+ sizeof *font->kern * font->kern_size);
+ for (i = 0; i < font->kern_size; i++)
+ font->kern[i].ch1 = -1;
+
+ for (i = 0; i < old_kern_size; i++)
+ {
+ if (old_kern[i].ch1 == -1)
+ continue;
+
+ j = hash_kern (old_kern[i].ch1, old_kern[i].ch2) % font->kern_size;
+ while (font->kern[j].ch1 != -1)
+ if (0 == j--)
+ j = font->kern_size - 1;
+ font->kern[j] = old_kern[i];
+ }
+ if (old_kern)
+ pool_free (font->owner, old_kern);
+ }
+
+ for (i = hash_kern (ch1, ch2) % font->kern_size; font->kern[i].ch1 != -1;)
+ if (0 == i--)
+ i = font->kern_size - 1;
+ font->kern[i].ch1 = ch1;
+ font->kern[i].ch2 = ch2;
+ font->kern[i].adjust = adjust;
+ font->kern_used++;
+}
+
+/* Finds a font file corresponding to font NAME for device DEV. */
+static char *
+find_font_file (const char *dev, const char *name)
+{
+ char *basename = xmalloc (3 + strlen (dev) + 1 + strlen (name) + 1);
+ char *cp;
+ char *filename;
+ char *path;
+
+ cp = stpcpy (basename, "dev");
+ cp = stpcpy (cp, dev);
+ *cp++ = DIR_SEPARATOR;
+ strcpy (cp, name);
+
+ /* Search order:
+ 1. $STAT_GROFF_FONT_PATH
+ 2. $GROFF_FONT_PATH
+ 3. GROFF_FONT_PATH from pref.h
+ 4. config_path
+ */
+ if ((path = getenv ("STAT_GROFF_FONT_PATH")) != NULL
+ && (filename = fn_search_path (basename, path, NULL)) != NULL)
+ goto win;
+
+ if ((path = getenv ("GROFF_FONT_PATH")) != NULL
+ && (filename = fn_search_path (basename, path, NULL)) != NULL)
+ goto win;
+
+ if ((filename = fn_search_path (basename, groff_font_path, NULL)) != NULL)
+ goto win;
+
+ if ((filename = fn_search_path (basename, config_path, NULL)) != NULL)
+ goto win;
+
+ msg (IE, _("Groff font error: Cannot find \"%s\"."), basename);
+
+win:
+ free (basename);
+ return filename;
+}
+
+/* Finds a font for device DEV with name NAME, reads it with
+ groff_read_font(), and returns the resultant font. */
+struct font_desc *
+groff_find_font (const char *dev, const char *name)
+{
+ char *filename = find_font_file (dev, name);
+ struct font_desc *fd;
+
+ if (!filename)
+ return NULL;
+ fd = groff_read_font (filename);
+ free (filename);
+ return fd;
+}
+
+/* Reads a DESC file for device DEV and sets the appropriate fields in
+ output driver *DRIVER, which must be previously allocated. Returns
+ nonzero on success. */
+int
+groff_read_DESC (const char *dev_name, struct groff_device_info * dev)
+{
+ char *filename; /* Full name of DESC file. */
+ FILE *f; /* DESC file. */
+
+ char *line = NULL; /* Current line. */
+ int line_len; /* Number of chars in current line. */
+ size_t line_size = 0; /* Number of chars allocated for line. */
+
+ char *token; /* strtok()'d token inside line. */
+
+ unsigned found = 0; /* Bitmask showing what settings
+ have been encountered. */
+
+ int m_sizes = 0; /* Number of int[2] items that
+ can fit in driver->sizes. */
+
+ char *sp; /* Tokenization string pointer. */
+ struct file_locator where;
+
+ int i;
+
+ dev->horiz = 1;
+ dev->vert = 1;
+ dev->size_scale = 1;
+ dev->n_sizes = 0;
+ dev->sizes = NULL;
+ dev->family = NULL;
+ for (i = 0; i < 4; i++)
+ dev->font_name[i] = NULL;
+
+ filename = find_font_file (dev_name, "DESC");
+ if (!filename)
+ return 0;
+
+ where.filename = filename;
+ where.line_number = 0;
+ err_push_file_locator (&where);
+
+ msg (VM (1), _("%s: Opening Groff description file..."), filename);
+ f = fopen (filename, "r");
+ if (!f)
+ goto file_lossage;
+
+ while ((line_len = getline (&line, &line_size, f)) != -1)
+ {
+ where.line_number++;
+
+ token = strtok_r (line, whitespace, &sp);
+ if (!token)
+ continue;
+
+ if (!strcmp (token, "sizes"))
+ {
+ if (found & 0x10000)
+ font_msg (SW, _("Multiple `sizes' declarations."));
+ for (;;)
+ {
+ char *tail;
+ int lower, upper;
+
+ for (;;)
+ {
+ token = strtok_r (NULL, whitespace, &sp);
+ if (token)
+ break;
+
+ where.line_number++;
+ if ((line_len = getline (&line, &line_size, f)) != -1)
+ {
+ if (ferror (f))
+ goto file_lossage;
+ font_msg (SE, _("Unexpected end of file. "
+ "Missing 0 terminator to `sizes' command?"));
+ goto lossage;
+ }
+ }
+
+ if (!strcmp (token, "0"))
+ break;
+
+ errno = 0;
+ if (0 == (lower = strtol (token, &tail, 0)) || errno == ERANGE)
+ {
+ font_msg (SE, _("Bad argument to `sizes'."));
+ goto lossage;
+ }
+ if (*tail == '-')
+ {
+ if (0 == (upper = strtol (&tail[1], &tail, 0)) || errno == ERANGE)
+ {
+ font_msg (SE, _("Bad argument to `sizes'."));
+ goto lossage;
+ }
+ if (lower < upper)
+ {
+ font_msg (SE, _("Bad range in argument to `sizes'."));
+ goto lossage;
+ }
+ }
+ else
+ upper = lower;
+ if (*tail)
+ {
+ font_msg (SE, _("Bad argument to `sizes'."));
+ goto lossage;
+ }
+
+ if (dev->n_sizes + 2 >= m_sizes)
+ {
+ m_sizes += 1;
+ dev->sizes = xrealloc (dev->sizes,
+ m_sizes * sizeof *dev->sizes);
+ }
+ dev->sizes[dev->n_sizes++][0] = lower;
+ dev->sizes[dev->n_sizes][1] = upper;
+
+ found |= 0x10000;
+ }
+ }
+ else if (!strcmp (token, "family"))
+ {
+ token = strtok_r (NULL, whitespace, &sp);
+ if (!token)
+ {
+ font_msg (SE, _("Family name expected."));
+ goto lossage;
+ }
+ if (found & 0x20000)
+ {
+ font_msg (SE, _("This command already specified."));
+ goto lossage;
+ }
+ dev->family = xstrdup (token);
+ }
+ else if (!strcmp (token, "charset"))
+ break;
+ else
+ {
+ static const char *id[]
+ = {"res", "hor", "vert", "sizescale", "unitwidth", NULL};
+ const char **cp;
+ int value;
+
+ for (cp = id; *cp; cp++)
+ if (!strcmp (token, *cp))
+ break;
+ if (*cp == NULL)
+ continue; /* completely ignore unrecognized lines */
+ if (found & (1 << (cp - id)))
+ font_msg (SW, _("%s: Device characteristic already defined."), *cp);
+
+ token = strtok_r (NULL, whitespace, &sp);
+ errno = 0;
+ if (!token || (value = strtol (token, NULL, 0)) <= 0 || errno == ERANGE)
+ {
+ font_msg (SE, _("%s: Invalid numeric format."), *cp);
+ goto lossage;
+ }
+ found |= (1 << (cp - id));
+ switch (cp - id)
+ {
+ case 0:
+ dev->res = value;
+ break;
+ case 1:
+ dev->horiz = value;
+ break;
+ case 2:
+ dev->vert = value;
+ break;
+ case 3:
+ dev->size_scale = value;
+ break;
+ case 4:
+ dev->unit_width = value;
+ break;
+ default:
+ assert (0);
+ }
+ }
+ }
+ if (ferror (f))
+ goto file_lossage;
+ if ((found & 0x10011) != 0x10011)
+ {
+ font_msg (SE, _("Missing `res', `unitwidth', and/or `sizes' line(s)."));
+ goto lossage;
+ }
+
+ /* Font name = family name + suffix. */
+ {
+ static const char *suffix[4] =
+ {"R", "I", "B", "BI"}; /* match OUTP_F_* */
+ int len; /* length of family name */
+ int i;
+
+ if (!dev->family)
+ dev->family = xstrdup ("");
+ len = strlen (dev->family);
+ for (i = 0; i < 4; i++)
+ {
+ char *cp;
+ dev->font_name[i] = xmalloc (len + strlen (suffix[i]) + 1);
+ cp = stpcpy (dev->font_name[i], dev->family);
+ strcpy (cp, suffix[i]);
+ }
+ }
+
+ dev->sizes[dev->n_sizes][0] = 0;
+ dev->sizes[dev->n_sizes][1] = 0;
+
+ msg (VM (2), _("Description file read successfully."));
+
+ err_pop_file_locator (&where);
+ free (filename);
+ free (line);
+ return 1;
+
+ /* Come here on a file error. */
+file_lossage:
+ msg (ME, "%s: %s", filename, strerror (errno));
+
+ /* Come here on any error. */
+lossage:
+ fclose (f);
+ free (line);
+ free (dev->family);
+ dev->family = NULL;
+ free (filename);
+ free (dev->sizes);
+ dev->sizes = NULL;
+ dev->n_sizes = 0;
+#if 0 /* at the moment, no errors can come here when dev->font_name[*] are
+ nonzero. */
+ for (i = 0; i < 4; i++)
+ {
+ free (dev->font_name[i]);
+ dev->font_name[i] = NULL;
+ }
+#endif
+
+ err_pop_file_locator (&where);
+
+ msg (VM (1), _("Error reading description file."));
+
+ return 0;
+}
+
+/* Finds character with index CH (as returned by name_to_index() or
+ number_to_index()) in font FONT and returns the associated metrics.
+ Nonexistent characters have width 0. */
+struct char_metrics *
+font_get_char_metrics (const struct font_desc *font, int ch)
+{
+ short index;
+
+ if (ch < 0 || ch >= font->deref_size)
+ return 0;
+
+ index = font->deref[ch];
+ if (index == -1)
+ return 0;
+
+ return font->metric[index];
+}
+
+/* Finds kernpair consisting of CH1 and CH2, in that order, in font
+ FONT and returns the associated kerning adjustment. */
+int
+font_get_kern_adjust (const struct font_desc *font, int ch1, int ch2)
+{
+ unsigned i;
+
+ if (!font->kern)
+ return 0;
+ for (i = hash_kern (ch1, ch2) % font->kern_size; font->kern[i].ch1 != -1;)
+ {
+ if (font->kern[i].ch1 == ch1 && font->kern[i].ch2 == ch2)
+ return font->kern[i].adjust;
+ if (0 == i--)
+ i = font->kern_size - 1;
+ }
+ return 0;
+}
+
+/* Returns a twelve-point fixed-pitch font that can be used as a
+ last-resort fallback. */
+struct font_desc *
+default_font (void)
+{
+ struct pool *font_pool;
+ static struct font_desc *font;
+
+ if (font)
+ return font;
+ font_pool = pool_create ();
+ font = pool_alloc (font_pool, sizeof *font);
+ font->owner = font_pool;
+ font->name = NULL;
+ font->internal_name = pool_strdup (font_pool, _("<<fallback>>"));
+ font->encoding = pool_strdup (font_pool, "text.enc");
+ font->space_width = 12000;
+ font->slant = 0.0;
+ font->ligatures = 0;
+ font->special = 0;
+ font->ascent = 8000;
+ font->descent = 4000;
+ font->deref = NULL;
+ font->deref_size = 0;
+ font->metric = NULL;
+ font->metric_size = 0;
+ font->metric_used = 0;
+ font->kern = NULL;
+ font->kern_size = 0;
+ font->kern_size_p = hsh_next_prime (64);
+ font->kern_used = 0;
+ font->kern_max_used = 0;
+ return font;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <limits.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "hash.h"
+
+/* Note for constructing hash functions:
+
+ You can store the hash values in the records, then compare hash
+ values (in the compare function) before bothering to compare keys.
+ Hash values can simply be returned from the records instead of
+ recalculating when rehashing. */
+
+/* Debugging note:
+
+ Since hash_probe and hash_find take void * pointers, it's easy to
+ pass a void ** to your data by accidentally inserting an `&'
+ reference operator where one shouldn't go. It took me an hour to
+ hunt down a bug like that once. */
+\f
+/* Prime numbers and hash functions. */
+
+static int hsh_prime_tab[] =
+{
+ 13, 31, 47, 67, 131, 257, 521, 1031, 2053, 4099, 8209, 16411,
+ 32771, 65537, 131101, 262147, 524309, 1048583, 2097169, 4194319,
+ 8388617, 16777259, 33554467, 67108879, 134217757, 268435459,
+ 536870923, 1073741827, INT_MAX,
+};
+
+/* Returns pointer into hsh_prime_tab[], pointing to the first prime
+ in the table greater than X. */
+int *
+hsh_next_prime (int x)
+{
+ int *p;
+
+ assert (x >= 0);
+
+ for (p = hsh_prime_tab; *p < x; p++)
+ ;
+
+ assert (*p != INT_MAX);
+
+ return p;
+}
+
+/* P.J. Weinberger's hash function, recommended by the Red Dragon
+ Book. Hashes the d-string between S1 and S2. Returns unbounded
+ nonnegative result. */
+int
+hashpjw_d (const char *s1, const char *s2)
+{
+ const char *p;
+ unsigned g, h;
+
+ for (h = 0, p = s1; p < s2; p++)
+ {
+ h = (h << 4) + *(unsigned char *) p;
+ g = h & 0xf0000000;
+ h ^= (g >> 24) | g;
+ }
+ return abs ((int) h);
+}
+
+/* Alternate entry point for hashpjw_d() that takes an s-string. */
+int
+hashpjw (const char *s)
+{
+ return hashpjw_d (s, &s[strlen (s)]);
+}
+\f
+/*hash tables. */
+
+/* Creates a hash table with at least M entries. COMPARE is a
+ function that compares two entries and returns 0 if they are
+ identical, nonzero otherwise; HASH returns a nonnegative hash value
+ for an entry; FREE destroys an entry. */
+struct hsh_table *
+hsh_create (int m,
+ int (*compare) (const void *, const void *, void *param),
+ unsigned (*hash) (const void *, void *param),
+ void (*free) (void *, void *param),
+ void *param)
+{
+ struct hsh_table *h = xmalloc (sizeof *h);
+ int i;
+
+ h->n = 0;
+ h->mp = hsh_next_prime (m);
+ h->m = *h->mp++;
+ h->table = xmalloc (sizeof *h->table * h->m);
+ for (i = 0; i < h->m; i++)
+ h->table[i] = NULL;
+ h->param = param;
+ h->compare = compare;
+ h->hash = hash;
+ h->free = free;
+ return h;
+}
+
+/* Destroys the contents of table H. */
+void
+hsh_clear (struct hsh_table *h)
+{
+ int i;
+
+ if (h->free)
+ for (i = 0; i < h->m; i++)
+ h->free (h->table[i], h->param);
+
+ if (h->m >= 128)
+ {
+ free (h->table);
+ h->mp = hsh_next_prime (31);
+ h->m = *h->mp++;
+ h->table = xmalloc (sizeof *h->table * h->m);
+ }
+
+ for (i = 0; i < h->m; i++)
+ h->table[i] = NULL;
+}
+
+/* Destroys table H and all its contents. */
+void
+hsh_destroy (struct hsh_table *h)
+{
+ int i;
+
+ if (h == NULL)
+ return;
+ if (h->free)
+ for (i = 0; i < h->m; i++)
+ {
+ void *p = h->table[i];
+ if (p)
+ h->free (p, h->param);
+ }
+ free (h->table);
+ free (h);
+}
+
+/* Increases the capacity of H. */
+void
+hsh_rehash (struct hsh_table *h)
+{
+ void **begin = h->table;
+ void **end = &h->table[h->m];
+ void **table_p;
+ int i;
+
+ h->m = *h->mp++;
+ h->table = xmalloc (sizeof *h->table * h->m);
+ for (i = 0; i < h->m; i++)
+ h->table[i] = NULL;
+ for (table_p = begin; table_p < end; table_p++)
+ {
+ void **entry;
+
+ if (*table_p == NULL)
+ continue;
+ entry = &h->table[h->hash (*table_p, h->param) % h->m];
+ while (*entry)
+ if (--entry < h->table)
+ entry = &h->table[h->m - 1];
+ *entry = *table_p;
+ }
+ free (begin);
+}
+
+/* Static variables for hsh_sort(). */
+static void *hsh_param;
+static int (*hsh_compare) (const void *, const void *, void *param);
+
+/* hsh_sort() helper function that ensures NULLs are sorted after the
+ rest of the table. */
+static int
+internal_comparison_fn (const void *pa, const void *pb)
+{
+ void *a = *(void **) pa;
+ void *b = *(void **) pb;
+ return a == NULL ? 1 : (b == NULL ? -1 : hsh_compare (a, b, hsh_param));
+}
+
+/* Sorts hash table H based on function COMPARE. NULLs are sent to
+ the end of the table. The resultant table is returned (it is
+ guaranteed to be NULL-terminated). H should not be used again as a
+ hash table until and unless hsh_clear() called. */
+void **
+hsh_sort (struct hsh_table *h,
+ int (*compare) (const void *, const void *, void *param))
+{
+#if GLOBAL_DEBUGGING
+ static int reentrant;
+ if (reentrant)
+ abort ();
+ reentrant++;
+#endif
+ hsh_param = h->param;
+ hsh_compare = compare ? compare : h->compare;
+ qsort (h->table, h->m, sizeof *h->table, internal_comparison_fn);
+#if GLOBAL_DEBUGGING
+ reentrant--;
+#endif
+ return h->table;
+}
+\f
+/* Hash entries. */
+
+/* Searches hash table H for TARGET. If found, returns a pointer to a
+ pointer to that entry; otherwise returns a pointer to a NULL entry
+ which _must_ be used to insert a new entry having the same key
+ data. */
+inline void **
+hsh_probe (struct hsh_table *h, const void *target)
+{
+ void **entry;
+
+ /* Order of these statements is important! */
+ if (h->n > h->m / 2)
+ hsh_rehash (h);
+ entry = &h->table[h->hash (target, h->param) % h->m];
+
+ while (*entry)
+ {
+ if (!h->compare (*entry, target, h->param))
+ return entry;
+
+ if (--entry < h->table)
+ entry = &h->table[h->m - 1];
+ }
+ h->n++;
+ return entry;
+}
+
+/* Returns the entry in hash table H that matches TARGET, NULL if
+ there is none. */
+void *
+hsh_find (struct hsh_table *h, const void *target)
+{
+ void **entry = &h->table[h->hash (target, h->param) % h->m];
+
+ while (*entry)
+ {
+ if (!h->compare (*entry, target, h->param))
+ return *entry;
+ if (--entry < h->table)
+ entry = &h->table[h->m - 1];
+ }
+ return NULL;
+}
+
+/* Iterates throught hash table TABLE with iterator ITER. Returns the
+ next non-NULL entry in TABLE, or NULL after the last non-NULL
+ entry. After NULL is returned, ITER is returned to a condition in
+ which hsh_foreach() will return the first non-NULL entry if any on
+ the next call. Do not add entries to TABLE between call to
+ hsh_foreach() between NULL returns.
+
+ Before calling hsh_foreach with a particular iterator for the first
+ time, you must initialize the iterator with a call to
+ hsh_iterator_init. */
+void *
+hsh_foreach (struct hsh_table *table, struct hsh_iterator *iter)
+{
+ int i;
+
+ if (!table)
+ return NULL;
+ if (!iter->init)
+ {
+ iter->init = 1;
+ iter->next = 0;
+ }
+ for (i = iter->next; i < table->m; i++)
+ if (table->table[i])
+ {
+ iter->next = i + 1;
+ return table->table[i];
+ }
+ iter->init = 0;
+ return NULL;
+}
+
+#if GLOBAL_DEBUGGING
+#include <stdio.h>
+
+/* Displays contents of hash table H on stdout. */
+void
+hsh_dump (struct hsh_table *h)
+{
+ void **entry = h->table;
+ int i;
+
+ printf (_("hash table:"));
+ for (i = 0; i < h->m; i++)
+ printf (" %p", *entry++);
+ printf ("\n");
+}
+
+/* This wrapper around hsh_probe() assures that it returns a pointer
+ to a NULL pointer. This function is used when it is known that the
+ entry to be inserted does not already exist in the table. */
+void
+force_hsh_insert (struct hsh_table *h, void *p)
+{
+ void **pp = hsh_probe (h, p);
+ if (*pp != NULL)
+ assert (0);
+ *pp = p;
+}
+
+/* This wrapper around hsh_find() assures that it returns non-NULL.
+ This function is for use when it is known that the entry being
+ searched for must exist in the table. */
+void *
+force_hsh_find (struct hsh_table *h, const void *p)
+{
+ p = hsh_find (h, p);
+ if (p == NULL)
+ assert (0);
+ return (void *) p;
+}
+#endif
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !hash_h
+#define hash_h 1
+
+/* Hash table (opaque). */
+struct hsh_table
+ {
+ int n; /* Number of filled entries. */
+ int m; /* Number of entries. */
+ int *mp; /* Pointer into hsh_prime_tab[]. */
+ void **table; /* Hash table proper. */
+
+ void *param;
+ int (*compare) (const void *, const void *, void *param);
+ unsigned (*hash) (const void *, void *param);
+ void (*free) (void *, void *param);
+ };
+
+/* Hash table iterator (opaque). */
+struct hsh_iterator
+ {
+ int init; /* Initialized? */
+ int next; /* Index of next entry. */
+ };
+
+#define hsh_iterator_init(ITERATOR) (ITERATOR).init = 0
+
+/* Prime numbers and hash functions. */
+int *hsh_next_prime (int) __attribute__ ((const));
+int hashpjw_d (const char *s1, const char *s2);
+
+#if __GNUC__>=2 && __OPTIMIZE__
+extern inline int
+hashpjw (const char *s)
+{
+ return hashpjw_d (s, &s[strlen (s)]);
+}
+#else
+int hashpjw (const char *s);
+#endif
+
+/* Hash tables. */
+struct hsh_table *hsh_create (int m,
+ int (*compare) (const void *, const void *,
+ void *param),
+ unsigned (*hash) (const void *, void *param),
+ void (*free) (void *, void *param),
+ void *param);
+void hsh_clear (struct hsh_table *);
+void hsh_destroy (struct hsh_table *);
+void hsh_rehash (struct hsh_table *);
+void **hsh_sort (struct hsh_table *,
+ int (*compare) (const void *, const void *, void *param));
+#if GLOBAL_DEBUGGING
+void hsh_dump (struct hsh_table *);
+#endif
+
+/* Hash entries. */
+void **hsh_probe (struct hsh_table *, const void *);
+void *hsh_find (struct hsh_table *, const void *);
+void *hsh_foreach (struct hsh_table *, struct hsh_iterator *);
+
+#if GLOBAL_DEBUGGING
+void force_hsh_insert (struct hsh_table *, void *);
+void *force_hsh_find (struct hsh_table *, const void *);
+#else
+#define force_hsh_insert(A, B) \
+ do *hsh_probe (A, B) = B; while (0)
+#define force_hsh_find(A, B) \
+ hsh_find (A, B)
+#endif
+
+/* Returns number of used elements in hash table H. */
+#define hsh_count(H) \
+ ((H)->n)
+
+#endif /* hash_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+#include "heap.h"
+
+#if STANDALONE
+#define GLOBAL_DEBUGGING 1
+#define _(x) (x)
+#endif
+
+/* Creates and returns a heap with an initial capacity of M_ELEM
+ elements. Returns nonzero only if successful. */
+struct heap *
+heap_create (size_t m_elem)
+{
+ struct heap *h = malloc (sizeof *h);
+ if (h != NULL)
+ {
+ h->n_elem = 0;
+ h->m_elem = m_elem;
+ h->elem = malloc (h->m_elem * sizeof *h->elem);
+ if (h->elem == NULL)
+ {
+ free (h);
+ h = NULL;
+ }
+ }
+ return h;
+}
+
+/* Destroys the heap at *H. */
+void
+heap_destroy (struct heap *h)
+{
+ assert (h != NULL);
+ free (h->elem);
+ free (h);
+}
+
+/* Inserts into heap *H an element having index INDEX and key KEY.
+ Returns nonzero only if successful. */
+int
+heap_insert (struct heap *h, int index, int key)
+{
+ int i, j;
+
+ assert (h != NULL);
+ if (h->n_elem >= h->m_elem)
+ {
+ h->elem = realloc (h->elem, 2 * h->m_elem * sizeof *h->elem);
+ if (h->elem == NULL)
+ return 0;
+ h->m_elem *= 2;
+ }
+
+ /* Knuth's Algorithm 5.2.3-16. Step 1. */
+ j = h->n_elem + 1;
+
+ for (;;)
+ {
+ /* Step 2. */
+ i = j / 2;
+
+ /* Step 3. */
+ if (i == 0 || h->elem[i - 1].key <= key)
+ {
+ h->elem[j - 1].index = index;
+ h->elem[j - 1].key = key;
+ h->n_elem++;
+ return 1;
+ }
+
+ /* Step 4. */
+ h->elem[j - 1] = h->elem[i - 1];
+ j = i;
+ }
+}
+
+/* Deletes the first element in the heap (the one with the greatest
+ index) and returns its index, or -1 if the heap is empty. If KEY
+ is non-NULL then *KEY is set to the deleted element's key, if it
+ returns non-NULL. */
+int
+heap_delete (struct heap *h, int *key)
+{
+ /* Knuth's Algorithm 5.2.3H-19. */
+ int first, K, R, l, r, i, j;
+
+ if (h->n_elem == 0)
+ return -1;
+ first = h->elem[0].index;
+ if (key)
+ *key = h->elem[0].key;
+ K = h->elem[h->n_elem - 1].key;
+ R = h->elem[h->n_elem - 1].index;
+ l = 1;
+ r = h->n_elem - 1;
+
+ /* H3. */
+ j = 1;
+
+H4:
+ i = j;
+ j *= 2;
+ if (j == r)
+ goto H6;
+ else if (j > r)
+ goto H8;
+
+ /* H5. */
+ if (h->elem[j - 1].key > h->elem[j].key)
+ j++;
+
+H6:
+ if (K <= h->elem[j - 1].key)
+ goto H8;
+
+ /* H7. */
+ h->elem[i - 1] = h->elem[j - 1];
+ goto H4;
+
+H8:
+ h->elem[i - 1].key = K;
+ h->elem[i - 1].index = R;
+
+ h->n_elem--;
+ return first;
+}
+
+/* Returns the number of elements in heap H. */
+int
+heap_size (struct heap *h)
+{
+ return h->n_elem;
+}
+
+#if GLOBAL_DEBUGGING
+/* Checks that a heap is really a heap. */
+void
+heap_verify (const struct heap *h)
+{
+ size_t j;
+
+ for (j = 1; j <= h->n_elem; j++)
+ {
+ if (j / 2 >= 1 && h->elem[j / 2 - 1].key > h->elem[j - 1].key)
+ printf (_("bad ordering of keys %d and %d\n"), j / 2 - 1, j - 1);
+ }
+}
+
+/* Dumps out the heap on stdout. */
+void
+heap_dump (const struct heap *h)
+{
+ size_t j;
+
+ printf (_("Heap contents:\n"));
+ for (j = 1; j <= h->n_elem; j++)
+ {
+ int partner;
+ if (j / 2 >= 1)
+ partner = h->elem[j / 2 - 1].key;
+ else
+ partner = -1;
+ printf ("%6d-%5d", h->elem[j - 1].key, partner);
+ }
+}
+#endif /* GLOBAL_DEBUGGING */
+
+#if STANDALONE
+#include <time.h>
+
+/* To perform a fairly thorough test of the heap routines, define
+ STANDALONE to nonzero then compile this file by itself. */
+
+/* Compares the second elements of the integer arrays at _A and _B and
+ returns a strcmp()-type result. */
+int
+compare_int2 (const void *pa, const void *pb)
+{
+ int *a = (int *) pa;
+ int *b = (int *) pb;
+
+ return a[1] - b[1];
+}
+
+#define N_ELEM 16
+
+/* Arrange the N elements of ARRAY in random order. */
+void
+shuffle (int (*array)[2], int n)
+{
+ int i;
+
+ for (i = 0; i < n; i++)
+ {
+ int j = i + rand () % (n - i);
+ int t = array[j][0], s = array[j][1];
+ array[j][0] = array[i][0], array[j][1] = array[i][1];
+ array[i][0] = t, array[i][1] = s;
+ }
+}
+
+/* Test routine. */
+int
+main (void)
+{
+ struct heap *h;
+ int i;
+ int array[N_ELEM][2];
+
+ srand (time (0));
+
+ h = heap_create (16);
+ for (i = 0; i < N_ELEM; i++)
+ {
+ array[i][0] = i;
+ array[i][1] = N_ELEM - i - 1;
+ }
+ shuffle (array, N_ELEM);
+
+ printf ("Insertion order:\n");
+ for (i = 0; i < N_ELEM; i++)
+ {
+ printf ("(%d,%d) ", array[i][0], array[i][1]);
+ heap_insert (h, array[i][0], array[i][1]);
+ heap_verify (h);
+ }
+ putchar ('\n');
+
+ /*heap_dump(&h); */
+
+ printf ("\nDeletion order:\n");
+ for (i = 0; i < N_ELEM; i++)
+ {
+ int index, key;
+ index = heap_delete (h, &key);
+ assert (index != -1);
+ printf ("(%d,%d) ", index, key);
+ fflush (stdout);
+ assert (index == N_ELEM - i - 1 && key == i);
+ heap_verify (h);
+ }
+ putchar ('\n');
+ heap_destroy (h);
+
+ return 0;
+}
+#endif
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !heap_h
+#define heap_h 1
+
+/* This module implements a priority queue as a heap as described in
+ Knuth 5.2.3. This is a first-in-smallest-out priority queue. */
+
+/* One element of a heap. */
+struct heap_elem
+ {
+ int index; /* Data. */
+ int key; /* Key value. */
+ };
+
+/* An entire heap. */
+struct heap
+ {
+ size_t n_elem; /* Number of elements in heap. */
+ size_t m_elem; /* Number of elements allocated for heap. */
+ struct heap_elem *elem; /* Heap elements. */
+ };
+
+struct heap *heap_create (size_t m_elem);
+void heap_destroy (struct heap *);
+int heap_insert (struct heap *, int index, int key);
+int heap_delete (struct heap *, int *key);
+int heap_size (struct heap *);
+
+#if GLOBAL_DEBUGGING
+void heap_verify (const struct heap *);
+void heap_dump (const struct heap *);
+#endif
+
+#endif /* heap_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* This #if encloses the rest of the file. */
+#if !NO_HTML
+
+#include <config.h>
+#include <assert.h>
+#include <errno.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <time.h>
+
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#include "alloc.h"
+#include "error.h"
+#include "filename.h"
+#include "getline.h"
+#include "htmlP.h"
+#include "output.h"
+#include "som.h"
+#include "tab.h"
+#include "version.h"
+
+/* Prototypes. */
+static int postopen (struct file_ext *);
+static int preclose (struct file_ext *);
+
+int
+html_open_global (struct outp_class *this unused)
+{
+ return 1;
+}
+
+int
+html_close_global (struct outp_class *this unused)
+{
+ return 1;
+}
+
+int
+html_preopen_driver (struct outp_driver *this)
+{
+ struct html_driver_ext *x;
+
+ assert (this->driver_open == 0);
+ msg (VM (1), _("HTML driver initializing as `%s'..."), this->name);
+
+ this->ext = x = xmalloc (sizeof *x);
+ this->res = 0;
+ this->horiz = this->vert = 0;
+ this->width = this->length = 0;
+
+ this->cp_x = this->cp_y = 0;
+
+ x->prologue_fn = NULL;
+
+ x->file.filename = NULL;
+ x->file.mode = "w";
+ x->file.file = NULL;
+ x->file.sequence_no = &x->sequence_no;
+ x->file.param = this;
+ x->file.postopen = postopen;
+ x->file.preclose = preclose;
+
+ x->sequence_no = 0;
+
+ return 1;
+}
+
+int
+html_postopen_driver (struct outp_driver *this)
+{
+ struct html_driver_ext *x = this->ext;
+
+ assert (this->driver_open == 0);
+ if (NULL == x->file.filename)
+ x->file.filename = xstrdup ("pspp.html");
+
+ if (x->prologue_fn == NULL)
+ x->prologue_fn = xstrdup ("html-prologue");
+
+ msg (VM (2), _("%s: Initialization complete."), this->name);
+ this->driver_open = 1;
+
+ return 1;
+}
+
+int
+html_close_driver (struct outp_driver *this)
+{
+ struct html_driver_ext *x = this->ext;
+
+ assert (this->driver_open);
+ msg (VM (2), _("%s: Beginning closing..."), this->name);
+ fn_close_ext (&x->file);
+ free (x->prologue_fn);
+ free (x->file.filename);
+ free (x);
+ msg (VM (3), _("%s: Finished closing."), this->name);
+ this->driver_open = 0;
+
+ return 1;
+}
+
+/* Generic option types. */
+enum
+{
+ boolean_arg = -10,
+ string_arg,
+ nonneg_int_arg
+};
+
+/* All the options that the HTML driver supports. */
+static struct outp_option option_tab[] =
+{
+ /* *INDENT-OFF* */
+ {"output-file", 1, 0},
+ {"prologue-file", string_arg, 0},
+ {"", 0, 0},
+ /* *INDENT-ON* */
+};
+static struct outp_option_info option_info;
+
+void
+html_option (struct outp_driver *this, const char *key, const struct string *val)
+{
+ struct html_driver_ext *x = this->ext;
+ int cat, subcat;
+
+ cat = outp_match_keyword (key, option_tab, &option_info, &subcat);
+ switch (cat)
+ {
+ case 0:
+ msg (SE, _("Unknown configuration parameter `%s' for HTML device "
+ "driver."), key);
+ break;
+ case 1:
+ free (x->file.filename);
+ x->file.filename = xstrdup (ds_value (val));
+ break;
+ case string_arg:
+ {
+ char **dest;
+ switch (subcat)
+ {
+ case 0:
+ dest = &x->prologue_fn;
+ break;
+ default:
+ assert (0);
+ }
+ if (*dest)
+ free (*dest);
+ *dest = xstrdup (ds_value (val));
+ }
+ break;
+#if __CHECKER__
+ case 42000:
+ assert (0);
+#endif
+ default:
+ assert (0);
+ }
+}
+
+/* Variables for the prologue. */
+struct html_variable
+ {
+ const char *key;
+ const char *value;
+ };
+
+static struct html_variable *html_var_tab;
+
+/* Searches html_var_tab for a html_variable with key KEY, and returns
+ the associated value. */
+static const char *
+html_get_var (const char *key)
+{
+ struct html_variable *v;
+
+ for (v = html_var_tab; v->key; v++)
+ if (!strcmp (key, v->key))
+ return v->value;
+ return NULL;
+}
+
+/* Writes the HTML prologue to file F. */
+static int
+postopen (struct file_ext *f)
+{
+ static struct html_variable dict[] =
+ {
+ {"generator", 0},
+ {"date", 0},
+ {"user", 0},
+ {"host", 0},
+ {"title", 0},
+ {"subtitle", 0},
+ {"source-file", 0},
+ {0, 0},
+ };
+#if HAVE_UNISTD_H
+ char host[128];
+#endif
+ time_t curtime;
+ struct tm *loctime;
+
+ struct outp_driver *this = f->param;
+ struct html_driver_ext *x = this->ext;
+
+ char *prologue_fn = fn_search_path (x->prologue_fn, config_path, NULL);
+ FILE *prologue_file;
+
+ char *buf = NULL;
+ int buf_size = 0;
+
+ if (prologue_fn == NULL)
+ {
+ msg (IE, _("Cannot find HTML prologue. The use of `-vv' "
+ "on the command line is suggested as a debugging aid."));
+ return 0;
+ }
+
+ msg (VM (1), _("%s: %s: Opening HTML prologue..."), this->name, prologue_fn);
+ prologue_file = fopen (prologue_fn, "rb");
+ if (prologue_file == NULL)
+ {
+ fclose (prologue_file);
+ free (prologue_fn);
+ msg (IE, "%s: %s", prologue_fn, strerror (errno));
+ goto error;
+ }
+
+ dict[0].value = version;
+
+ curtime = time (NULL);
+ loctime = localtime (&curtime);
+ dict[1].value = asctime (loctime);
+ {
+ char *cp = strchr (dict[1].value, '\n');
+ if (cp)
+ *cp = 0;
+ }
+
+ /* PORTME: Determine username, net address. */
+#if HAVE_UNISTD_H
+ dict[2].value = getenv ("LOGNAME");
+ if (!dict[2].value)
+ dict[2].value = getlogin ();
+ if (!dict[2].value)
+ dict[2].value = _("nobody");
+
+ if (gethostname (host, 128) == -1)
+ {
+ if (errno == ENAMETOOLONG)
+ host[127] = 0;
+ else
+ strcpy (host, _("nowhere"));
+ }
+ dict[3].value = host;
+#else /* !HAVE_UNISTD_H */
+ dict[2].value = _("nobody");
+ dict[3].value = _("nowhere");
+#endif /* !HAVE_UNISTD_H */
+
+ dict[4].value = outp_title ? outp_title : "";
+ dict[5].value = outp_subtitle ? outp_subtitle : "";
+
+ getl_location (&dict[6].value, NULL);
+ if (dict[6].value == NULL)
+ dict[6].value = "<stdin>";
+
+ html_var_tab = dict;
+ while (-1 != getline (&buf, &buf_size, prologue_file))
+ {
+ char *buf2;
+ int len;
+
+ if (strstr (buf, "!!!"))
+ continue;
+
+ {
+ char *cp = strstr (buf, "!title");
+ if (cp)
+ {
+ if (outp_title == NULL)
+ continue;
+ else
+ *cp = '\0';
+ }
+ }
+
+ {
+ char *cp = strstr (buf, "!subtitle");
+ if (cp)
+ {
+ if (outp_subtitle == NULL)
+ continue;
+ else
+ *cp = '\0';
+ }
+ }
+
+ /* PORTME: Line terminator. */
+ buf2 = fn_interp_vars (buf, html_get_var);
+ len = strlen (buf2);
+ fwrite (buf2, len, 1, f->file);
+ if (buf2[len - 1] != '\n')
+ putc ('\n', f->file);
+ free (buf2);
+ }
+ if (ferror (f->file))
+ msg (IE, _("Reading `%s': %s."), prologue_fn, strerror (errno));
+ fclose (prologue_file);
+
+ free (prologue_fn);
+ free (buf);
+
+ if (ferror (f->file))
+ goto error;
+
+ msg (VM (2), _("%s: HTML prologue read successfully."), this->name);
+ return 1;
+
+error:
+ msg (VM (1), _("%s: Error reading HTML prologue."), this->name);
+ return 0;
+}
+
+/* Writes the HTML epilogue to file F. */
+static int
+preclose (struct file_ext *f)
+{
+ fprintf (f->file,
+ "</BODY>\n"
+ "</HTML>\n"
+ "<!-- end of file -->\n");
+
+ if (ferror (f->file))
+ return 0;
+ return 1;
+}
+
+int
+html_open_page (struct outp_driver *this)
+{
+ struct html_driver_ext *x = this->ext;
+
+ assert (this->driver_open && this->page_open == 0);
+ x->sequence_no++;
+ if (!fn_open_ext (&x->file))
+ {
+ if (errno)
+ msg (ME, _("HTML output driver: %s: %s"), x->file.filename,
+ strerror (errno));
+ return 0;
+ }
+
+ if (!ferror (x->file.file))
+ this->page_open = 1;
+ return !ferror (x->file.file);
+}
+
+int
+html_close_page (struct outp_driver *this)
+{
+ struct html_driver_ext *x = this->ext;
+
+ assert (this->driver_open && this->page_open);
+ this->page_open = 0;
+ return !ferror (x->file.file);
+}
+
+static void output_tab_table (struct outp_driver *, struct tab_table *);
+
+void
+html_submit (struct outp_driver *this, struct som_table *s)
+{
+ extern struct som_table_class tab_table_class;
+ struct html_driver_ext *x = this->ext;
+
+ assert (this->driver_open && this->page_open);
+ if (x->sequence_no == 0 && !html_open_page (this))
+ {
+ msg (ME, _("Cannot open first page on HTML device %s."), this->name);
+ return;
+ }
+
+ if (s->class == &tab_table_class)
+ output_tab_table (this, (struct tab_table *) s->ext);
+ else
+ assert (0);
+}
+
+/* Emit HTML to FILE to change from *OLD_ATTR attributes to NEW_ATTR.
+ Sets *OLD_ATTR to NEW_ATTR when done. */
+static void
+change_attributes (FILE *f, int *old_attr, int new_attr)
+{
+ if (*old_attr == new_attr)
+ return;
+
+ if (*old_attr & OUTP_F_B)
+ fputs ("</B>", f);
+ if (*old_attr & OUTP_F_I)
+ fputs ("</I>", f);
+ if (new_attr & OUTP_F_I)
+ fputs ("<I>", f);
+ if (new_attr & OUTP_F_B)
+ fputs ("<B>", f);
+
+ *old_attr = new_attr;
+}
+
+/* Write string S of length LEN to file F, escaping characters as
+ necessary for HTML. */
+static void
+escape_string (FILE *f, char *s, int len)
+{
+ char *ep = &s[len];
+ char *bp, *cp;
+ int attr = 0;
+
+ for (bp = cp = s; bp < ep; bp = cp)
+ {
+ while (cp < ep && *cp != '&' && *cp != '<' && *cp != '>' && *cp)
+ cp++;
+ if (cp > bp)
+ fwrite (bp, 1, cp - bp, f);
+ if (cp < ep)
+ switch (*cp++)
+ {
+ case '&':
+ fputs ("&", f);
+ break;
+ case '<':
+ fputs ("<", f);
+ break;
+ case '>':
+ fputs (">", f);
+ break;
+ case 0:
+ break;
+ default:
+ assert (0);
+ }
+ }
+
+ if (attr)
+ change_attributes (f, &attr, 0);
+}
+
+/* Write table T to THIS output driver. */
+static void
+output_tab_table (struct outp_driver *this, struct tab_table *t)
+{
+ struct html_driver_ext *x = this->ext;
+
+ tab_hit++;
+
+ if (t->nr == 1 && t->nc == 1)
+ {
+ fputs ("<P>", x->file.file);
+ if (!ls_empty_p (t->cc))
+ escape_string (x->file.file, ls_value (t->cc), ls_length (t->cc));
+ fputs ("</P>\n", x->file.file);
+
+ return;
+ }
+
+ fputs ("<TABLE BORDER=1>\n", x->file.file);
+
+ if (!ls_empty_p (&t->title))
+ {
+ fprintf (x->file.file, " <TR>\n <TH COLSPAN=%d>", t->nc);
+ escape_string (x->file.file, ls_value (&t->title),
+ ls_length (&t->title));
+ fputs ("</TH>\n </TR>\n", x->file.file);
+ }
+
+ {
+ int r;
+ struct len_string *cc = t->cc;
+ unsigned char *ct = t->ct;
+
+ for (r = 0; r < t->nr; r++)
+ {
+ int c;
+
+ fputs (" <TR>\n", x->file.file);
+ for (c = 0; c < t->nc; c++, cc++, ct++)
+ {
+ int tag;
+ char header[128];
+ char *cp;
+
+ if ((*ct & TAB_JOIN)
+ && ((struct tab_joined_cell *) ls_value (cc))->hit == tab_hit)
+ continue;
+
+ if (r < t->t || r >= t->nr - t->b
+ || c < t->l || c >= t->nc - t->r)
+ tag = 'H';
+ else
+ tag = 'D';
+ cp = stpcpy (header, " <T");
+ *cp++ = tag;
+
+ switch (*ct & TAB_ALIGN_MASK)
+ {
+ case TAB_RIGHT:
+ cp = stpcpy (cp, " ALIGN=RIGHT");
+ break;
+ case TAB_LEFT:
+ break;
+ case TAB_CENTER:
+ cp = stpcpy (cp, " ALIGN=CENTER");
+ break;
+ default:
+ assert (0);
+ }
+
+ if (*ct & TAB_JOIN)
+ {
+ struct tab_joined_cell *j =
+ (struct tab_joined_cell *) ls_value (cc);
+ j->hit = tab_hit;
+
+ if (j->x2 - j->x1 > 1)
+ cp = spprintf (cp, " COLSPAN=%d", j->x2 - j->x1);
+ if (j->y2 - j->y1 > 1)
+ cp = spprintf (cp, " ROWSPAN=%d", j->y2 - j->y1);
+ }
+
+ strcpy (cp, ">");
+ fputs (header, x->file.file);
+
+ {
+ char *s = ls_value (cc);
+ size_t l = ls_length (cc);
+
+ while (l && isspace ((unsigned char) *s))
+ {
+ l--;
+ s++;
+ }
+
+ escape_string (x->file.file, s, l);
+ }
+
+ fprintf (x->file.file, "</T%c>\n", tag);
+ }
+ fputs (" </TR>\n", x->file.file);
+ }
+ }
+
+ fputs ("</TABLE>\n\n", x->file.file);
+}
+
+/* HTML driver class. */
+struct outp_class html_class =
+{
+ "html",
+ 0xfaeb,
+ 1,
+
+ html_open_global,
+ html_close_global,
+ NULL,
+
+ html_preopen_driver,
+ html_option,
+ html_postopen_driver,
+ html_close_driver,
+
+ html_open_page,
+ html_close_page,
+
+ html_submit,
+
+ NULL,
+ NULL,
+ NULL,
+
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+};
+
+#endif /* !NO_HTML */
+
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !htmlP_h
+#define htmlP_h 1
+
+#include "filename.h"
+
+/* HTML output driver extension record. */
+struct html_driver_ext
+ {
+ /* User parameters. */
+ char *prologue_fn; /* Prologue's filename relative to font dir. */
+
+ /* Internal state. */
+ struct file_ext file; /* Output file. */
+ int sequence_no; /* Sequence number. */
+ };
+
+extern struct outp_class html_class;
+
+#endif /* !htmlP_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <ctype.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "getline.h"
+#include "lexer.h"
+#include "str.h"
+
+int
+cmd_include_at (void)
+{
+ char *incfn, *s, *bp, *ep;
+
+ s = bp = lex_entire_line ();
+ while (isspace ((unsigned char) *bp))
+ bp++;
+ bp++; /* skip `@' */
+ while (isspace ((unsigned char) *bp))
+ bp++;
+ if (*bp == '\'')
+ bp++;
+
+ ep = bp + strlen (bp);
+ while (isspace ((unsigned char) *--ep));
+ if (*ep != '\'')
+ ep++;
+
+ if (ep <= bp)
+ {
+ msg (SE, _("Unrecognized filename format."));
+ return CMD_FAILURE;
+ }
+
+ /* Now the filename is trapped between bp and ep. */
+ incfn = xmalloc (ep - bp + 1);
+ strncpy (incfn, bp, ep - bp);
+ incfn[ep - bp] = 0;
+ getl_include (incfn);
+ free (incfn);
+
+ return CMD_SUCCESS;
+}
+
+int
+cmd_include (void)
+{
+ lex_get ();
+
+ if (!lex_force_string ())
+ return CMD_SUCCESS;
+ getl_include (ds_value (&tokstr));
+
+ lex_get ();
+ return lex_end_of_command ();
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <float.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "dfm.h"
+#include "error.h"
+#include "expr.h"
+#include "file-handle.h"
+#include "inpt-pgm.h"
+#include "lexer.h"
+#include "misc.h"
+#include "str.h"
+#include "var.h"
+#include "vfm.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* A bit-vector of two-bit entries. The array tells INPUT PROGRAM how
+ to initialize each `value'. Modified by envector(), devector(),
+ which are called by create_variable(), also by LEAVE, COMPUTE(!). */
+unsigned char *inp_init;
+
+/* Number of bytes allocated for inp_init. */
+size_t inp_init_size;
+
+/* Number of `values' created inside INPUT PROGRAM. */
+static int inp_nval;
+
+static int end_case_trns_proc (struct trns_header *, struct ccase *);
+static int end_file_trns_proc (struct trns_header * t, struct ccase * c);
+static int reread_trns_proc (struct trns_header *, struct ccase *);
+static void reread_trns_free (struct trns_header *);
+
+int
+cmd_input_program (void)
+{
+ lex_match_id ("INPUT");
+ lex_match_id ("PROGRAM");
+ discard_variables ();
+
+ vfm_source = &input_program_source;
+
+ inp_init = NULL;
+ inp_init_size = 0;
+
+ return lex_end_of_command ();
+}
+
+int
+cmd_end_input_program (void)
+{
+ lex_match_id ("END");
+ lex_match_id ("INPUT");
+ lex_match_id ("PROGRAM");
+
+ if (vfm_source != &input_program_source)
+ {
+ msg (SE, _("No matching INPUT PROGRAM command."));
+ return CMD_FAILURE;
+ }
+
+ if (default_dict.nval == 0)
+ msg (SW, _("No data-input or transformation commands specified "
+ "between INPUT PROGRAM and END INPUT PROGRAM."));
+
+ /* Mark the boundary between INPUT PROGRAM and more-mundane
+ transformations. */
+ f_trns = n_trns;
+
+ /* Mark the boundary between input program `values' and
+ later-created `values'. */
+ inp_nval = default_dict.nval;
+
+ return lex_end_of_command ();
+}
+
+/* Initializes temp_case. Called before the first case is read. */
+static void
+init_case (void)
+{
+ union value *val = temp_case->data;
+ unsigned char *cp = inp_init;
+ unsigned char c;
+ int i, j;
+
+ /* This code is 2-3X the complexity it might be, but I felt like
+ it. It initializes temp_case union values to 0, or SYSMIS, or
+ blanks, as appropriate. */
+ for (i = 0; i < inp_nval / 4; i++)
+ {
+ c = *cp++;
+ for (j = 0; j < 4; j++)
+ {
+ switch (c & INP_MASK)
+ {
+ case INP_NUMERIC | INP_RIGHT:
+ val++->f = SYSMIS;
+ break;
+ case INP_NUMERIC | INP_LEFT:
+ val++->f = 0.0;
+ break;
+ case INP_STRING | INP_RIGHT:
+ case INP_STRING | INP_LEFT:
+ memset (val++->s, ' ', MAX_SHORT_STRING);
+ break;
+ }
+ c >>= 2;
+ }
+ }
+ if (inp_nval % 4)
+ {
+ c = *cp;
+ for (j = 0; j < inp_nval % 4; j++)
+ {
+ switch (c & INP_MASK)
+ {
+ case INP_NUMERIC | INP_RIGHT:
+ val++->f = SYSMIS;
+ break;
+ case INP_NUMERIC | INP_LEFT:
+ val++->f = 0.0;
+ break;
+ case INP_STRING | INP_RIGHT:
+ case INP_STRING | INP_LEFT:
+ memset (val++->s, ' ', MAX_SHORT_STRING);
+ break;
+ }
+ c >>= 2;
+ }
+ }
+}
+
+/* Clears temp_case. Called between reading successive records. */
+static void
+clear_case (void)
+{
+ union value *val = temp_case->data;
+ unsigned char *cp = inp_init;
+ unsigned char c;
+ int i, j;
+
+ /* This code is 2-3X the complexity it might be, but I felt like
+ it. It initializes temp_case values to SYSMIS, or
+ blanks, or does nothing, as appropriate. */
+ for (i = 0; i < inp_nval / 4; i++)
+ {
+ c = *cp++;
+ for (j = 0; j < 4; j++)
+ {
+ if (!(c & INP_LEFT))
+ {
+ if (c & INP_STRING)
+ memset (val->s, ' ', MAX_SHORT_STRING);
+ else
+ val->f = SYSMIS;
+ }
+ val++;
+ c >>= 2;
+ }
+ }
+
+ if (inp_nval % 4)
+ {
+ c = *cp;
+ for (j = 0; j < inp_nval % 4; j++)
+ {
+ if (!(c & INP_LEFT))
+ {
+ if (c & INP_STRING)
+ memset (val->s, ' ', MAX_SHORT_STRING);
+ else
+ val->f = SYSMIS;
+ }
+ val++;
+ c >>= 2;
+ }
+ }
+}
+
+/* Executes each transformation in turn on a `blank' case. When a
+ transformation fails, returning -2, then that's the end of the
+ file. -1 means go on to the next transformation. Otherwise the
+ return value is the index of the transformation to go to next. */
+void
+input_program_source_read (void)
+{
+ int i;
+
+ /* Nonzero if there were any END CASE commands in the set of
+ transformations. */
+ int end_case = 0;
+
+ /* We don't automatically write out cases if the user took over
+ that prerogative. */
+ for (i = 0; i < f_trns; i++)
+ if (t_trns[i]->proc == end_case_trns_proc)
+ end_case = 1;
+
+ init_case ();
+ for (;;)
+ {
+ /* Index of current transformation. */
+ int i;
+
+ /* Return value of last-called transformation. */
+ int code;
+
+ debug_printf (("input-program: "));
+
+ /* Perform transformations on `blank' case. */
+ for (i = 0; i < f_trns;)
+ {
+#if DEBUGGING
+ printf ("/%d", i);
+ if (t_trns[i]->proc == end_case_trns_proc)
+ printf ("\n");
+#endif
+ code = t_trns[i]->proc (t_trns[i], temp_case);
+ switch (code)
+ {
+ case -1:
+ i++;
+ break;
+ case -2:
+ return;
+ case -3:
+ goto next_case;
+ default:
+ i = code;
+ break;
+ }
+ }
+
+#if DEBUGGING
+ if (!end_case)
+ printf ("\n");
+#endif
+
+ /* Write the case if appropriate. */
+ if (!end_case)
+ if (!write_case ())
+ return;
+
+ /* Blank out the case for the next iteration. */
+ next_case:
+ clear_case ();
+ }
+}
+
+static void
+input_program_source_destroy_source (void)
+{
+ cancel_transformations ();
+ free (inp_init);
+ inp_init = NULL;
+}
+
+struct case_stream input_program_source =
+ {
+ NULL,
+ input_program_source_read,
+ NULL,
+ NULL,
+ input_program_source_destroy_source,
+ NULL,
+ "INPUT PROGRAM",
+ };
+\f
+int
+cmd_end_case (void)
+{
+ struct trns_header *t;
+
+ lex_match_id ("END");
+ lex_match_id ("CASE");
+
+ if (vfm_source != &input_program_source)
+ {
+ msg (SE, _("This command may only be executed between INPUT PROGRAM "
+ "and END INPUT PROGRAM."));
+ return CMD_FAILURE;
+ }
+
+ t = xmalloc (sizeof *t);
+ t->proc = end_case_trns_proc;
+ t->free = NULL;
+ add_transformation ((struct trns_header *) t);
+
+ return lex_end_of_command ();
+}
+
+int
+end_case_trns_proc (struct trns_header *t unused, struct ccase * c unused)
+{
+#if DEBUGGING
+ printf ("END CASE\n");
+#endif
+ if (!write_case ())
+ return -2;
+ clear_case ();
+ return -1;
+}
+
+/* REREAD transformation. */
+struct reread_trns
+ {
+ struct trns_header h;
+
+ struct file_handle *handle; /* File to move file pointer back on. */
+ struct expression *column; /* Column to reset file pointer to. */
+ };
+
+/* Parses REREAD command. */
+int
+cmd_reread (void)
+{
+ /* File to be re-read. */
+ struct file_handle *h;
+
+ /* Expression for column to set file pointer to. */
+ struct expression *e;
+
+ /* Created transformation. */
+ struct reread_trns *t;
+
+ lex_match_id ("REREAD");
+
+ h = default_handle;
+ e = NULL;
+ while (token != '.')
+ {
+ if (lex_match_id ("COLUMN"))
+ {
+ lex_match ('=');
+
+ if (e)
+ {
+ msg (SE, _("COLUMN subcommand multiply specified."));
+ expr_free (e);
+ return CMD_FAILURE;
+ }
+
+ e = expr_parse (PXP_NUMERIC);
+ if (!e)
+ return CMD_FAILURE;
+ }
+ else if (lex_match_id ("FILE"))
+ {
+ lex_match ('=');
+ if (token != T_ID)
+ {
+ lex_error (_("expecting file handle name"));
+ expr_free (e);
+ return CMD_FAILURE;
+ }
+ h = fh_get_handle_by_name (tokid);
+ if (!h)
+ {
+ expr_free (e);
+ return CMD_FAILURE;
+ }
+ lex_get ();
+ }
+ else
+ {
+ lex_error (NULL);
+ expr_free (e);
+ }
+ }
+
+ t = xmalloc (sizeof *t);
+ t->h.proc = reread_trns_proc;
+ t->h.free = reread_trns_free;
+ t->handle = h;
+ t->column = e;
+ add_transformation ((struct trns_header *) t);
+
+ return CMD_SUCCESS;
+}
+
+static int
+reread_trns_proc (struct trns_header * pt, struct ccase * c)
+{
+ struct reread_trns *t = (struct reread_trns *) pt;
+
+ if (t->column == NULL)
+ dfm_bkwd_record (t->handle, 1);
+ else
+ {
+ union value column;
+
+ expr_evaluate (t->column, c, &column);
+ if (!finite (column.f) || column.f < 1)
+ {
+ msg (SE, _("REREAD: Column numbers must be positive finite "
+ "numbers. Column set to 1."));
+ dfm_bkwd_record (t->handle, 1);
+ }
+ else
+ dfm_bkwd_record (t->handle, column.f);
+ }
+ return -1;
+}
+
+static void
+reread_trns_free (struct trns_header * t)
+{
+ expr_free (((struct reread_trns *) t)->column);
+}
+
+/* Parses END FILE command. */
+int
+cmd_end_file (void)
+{
+ struct trns_header *t;
+
+ lex_match_id ("END");
+ lex_match_id ("FILE");
+
+ if (vfm_source != &input_program_source)
+ {
+ msg (SE, _("This command may only be executed between INPUT PROGRAM "
+ "and END INPUT PROGRAM."));
+ return CMD_FAILURE;
+ }
+
+ t = xmalloc (sizeof *t);
+ t->proc = end_file_trns_proc;
+ t->free = NULL;
+ add_transformation ((struct trns_header *) t);
+
+ return lex_end_of_command ();
+}
+
+static int
+end_file_trns_proc (struct trns_header * t unused, struct ccase * c unused)
+{
+#if DEBUGGING
+ printf ("END FILE\n");
+#endif
+ return -2;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !inpt_pgm_h
+#define inpt_pgm_h 1
+
+/* Bitmasks to indicate variable type. */
+enum
+ {
+ INP_MASK = 03, /* 2#11. */
+
+ INP_NUMERIC = 0, /* Numeric. */
+ INP_STRING = 01, /* String. */
+
+ INP_RIGHT = 0, /* Ordinary. */
+ INP_LEFT = 02 /* Scratch or LEAVE. */
+ };
+
+extern unsigned char *inp_init;
+extern size_t inp_init_size;
+
+#endif /* !inpt_pgm_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <ctype.h>
+#include <errno.h>
+#include <limits.h>
+#include <math.h>
+#include <stdarg.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "getline.h"
+#include "lexer.h"
+#include "magic.h"
+#include "settings.h"
+#include "str.h"
+
+/*#define DUMP_TOKENS 1*/
+
+\f
+/* Global variables. */
+
+/* Current token. */
+int token;
+
+/* T_NUM: the token's value. */
+double tokval;
+
+/* T_ID: the identifier. */
+char tokid[9];
+
+/* T_ID, T_STRING: token string value.
+ For T_ID, this is not truncated to 8 characters as is tokid. */
+struct string tokstr;
+\f
+/* Static variables. */
+
+/* Table of keywords. */
+static const char *keywords[T_N_KEYWORDS + 1] =
+ {
+ "AND", "OR", "NOT",
+ "EQ", "GE", "GT", "LE", "LT", "NE",
+ "ALL", "BY", "TO", "WITH",
+ NULL,
+ };
+
+/* Pointer to next token in getl_buf. */
+static char *prog;
+
+/* Nonzero only if this line ends with a terminal dot. */
+static int dot;
+
+/* Nonzero only if the last token returned was T_EOF. */
+static int eof;
+
+/* If nonzero, next token returned by lex_get().
+ Used only in exceptional circumstances. */
+static int put;
+
+static void unexpected_eof (void);
+static inline int check_id (const char *id, size_t len);
+static void convert_numeric_string_to_char_string (int type);
+static int parse_string (int type);
+
+#if DUMP_TOKENS
+static void dump_token (void);
+#endif
+\f
+/* Initialization. */
+
+/* Initializes the lexer. */
+void
+lex_init (void)
+{
+ if (!lex_get_line ())
+ unexpected_eof ();
+}
+\f
+/* Common functions. */
+
+/* Parses a single token, setting appropriate global variables to
+ indicate the token's attributes. */
+void
+lex_get (void)
+{
+ /* If a token was pushed ahead, return it. */
+ if (put)
+ {
+ token = put;
+ put = 0;
+#if DUMP_TOKENS
+ dump_token ();
+#endif
+ return;
+ }
+
+ /* Find a token. */
+ for (;;)
+ {
+ char *cp;
+
+ /* Skip whitespace. */
+ if (eof)
+ unexpected_eof ();
+
+ for (;;)
+ {
+ while (isspace ((unsigned char) *prog))
+ prog++;
+ if (*prog)
+ break;
+
+ if (dot)
+ {
+ dot = 0;
+ token = '.';
+#if DUMP_TOKENS
+ dump_token ();
+#endif
+ return;
+ }
+ else if (!lex_get_line ())
+ {
+ eof = 1;
+ token = T_STOP;
+#if DUMP_TOKENS
+ dump_token ();
+#endif
+ return;
+ }
+
+ if (put)
+ {
+ token = put;
+ put = 0;
+#if DUMP_TOKENS
+ dump_token ();
+#endif
+ return;
+ }
+ }
+
+ /* Actually parse the token. */
+ cp = prog;
+ ds_clear (&tokstr);
+
+ switch (*prog)
+ {
+ case '-': case '.':
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ {
+ char *tail;
+
+ /* `-' can introduce a negative number, or it can be a
+ token by itself. If it is not followed by a digit or a
+ decimal point, it is definitely not a number.
+ Otherwise, it might be either, but most of the time we
+ want it as a number. When the syntax calls for a `-'
+ token, lex_negative_to_dash() must be used to break
+ negative numbers into two tokens. */
+ if (*cp == '-')
+ {
+ ds_putchar (&tokstr, *prog++);
+ while (isspace ((unsigned char) *prog))
+ prog++;
+
+ if (!isdigit ((unsigned char) *prog) && *prog != '.')
+ {
+ token = '-';
+ break;
+ }
+ }
+
+ /* Parse the number, copying it into tokstr. */
+ while (isdigit ((unsigned char) *prog))
+ ds_putchar (&tokstr, *prog++);
+ if (*prog == '.')
+ {
+ ds_putchar (&tokstr, *prog++);
+ while (isdigit ((unsigned char) *prog))
+ ds_putchar (&tokstr, *prog++);
+ }
+ if (*prog == 'e' || *prog == 'E')
+ {
+ ds_putchar (&tokstr, *prog++);
+ if (*prog == '+' || *prog == '-')
+ ds_putchar (&tokstr, *prog++);
+ while (isdigit ((unsigned char) *prog))
+ ds_putchar (&tokstr, *prog++);
+ }
+
+ /* Parse as floating point. */
+ tokval = strtod (ds_value (&tokstr), &tail);
+ if (*tail)
+ {
+ msg (SE, _("%s does not form a valid number."),
+ ds_value (&tokstr));
+ tokval = 0.0;
+
+ ds_clear (&tokstr);
+ ds_putchar (&tokstr, '0');
+ }
+
+ token = T_NUM;
+ break;
+ }
+
+ case '\'': case '"':
+ token = parse_string (0);
+ break;
+
+ case '(': case ')': case ',': case '=': case '+': case '/':
+ token = *prog++;
+ break;
+
+ case '*':
+ if (*++prog == '*')
+ {
+ prog++;
+ token = T_EXP;
+ }
+ else
+ token = '*';
+ break;
+
+ case '<':
+ if (*++prog == '=')
+ {
+ prog++;
+ token = T_LE;
+ }
+ else if (*prog == '>')
+ {
+ prog++;
+ token = T_NE;
+ }
+ else
+ token = T_LT;
+ break;
+
+ case '>':
+ if (*++prog == '=')
+ {
+ prog++;
+ token = T_GE;
+ }
+ else
+ token = T_GT;
+ break;
+
+ case '~':
+ if (*++prog == '=')
+ {
+ prog++;
+ token = T_NE;
+ }
+ else
+ token = T_NOT;
+ break;
+
+ case '&':
+ prog++;
+ token = T_AND;
+ break;
+
+ case '|':
+ prog++;
+ token = T_OR;
+ break;
+
+ case 'a': case 'b': case 'c': case 'd': case 'e':
+ case 'f': case 'g': case 'h': case 'i': case 'j':
+ case 'k': case 'l': case 'm': case 'n': case 'o':
+ case 'p': case 'q': case 'r': case 's': case 't':
+ case 'u': case 'v': case 'w': case 'x': case 'y':
+ case 'z':
+ case 'A': case 'B': case 'C': case 'D': case 'E':
+ case 'F': case 'G': case 'H': case 'I': case 'J':
+ case 'K': case 'L': case 'M': case 'N': case 'O':
+ case 'P': case 'Q': case 'R': case 'S': case 'T':
+ case 'U': case 'V': case 'W': case 'X': case 'Y':
+ case 'Z':
+ case '#': case '$': case '@':
+ /* Strings can be specified in binary, octal, or hex using
+ this special syntax. */
+ if (prog[1] == '\'' || prog[1] == '"')
+ {
+ static const char special[3] = "box";
+ const char *p;
+
+ p = strchr (special, tolower ((unsigned char) *prog));
+ if (p)
+ {
+ prog++;
+ token = parse_string (p - special + 1);
+ break;
+ }
+ }
+
+ /* Copy id to tokstr. */
+ ds_putchar (&tokstr, toupper ((unsigned char) *prog++));
+ while (CHAR_IS_IDN (*prog))
+ ds_putchar (&tokstr, toupper ((unsigned char) *prog++));
+
+ /* Copy tokstr to tokid, truncating it to 8 characters. */
+ strncpy (tokid, ds_value (&tokstr), 8);
+ tokid[8] = 0;
+
+ token = check_id (ds_value (&tokstr), ds_length (&tokstr));
+ break;
+
+ default:
+ if (isgraph ((unsigned char) *prog))
+ msg (SE, _("Bad character in input: `%c'."), *prog++);
+ else
+ msg (SE, _("Bad character in input: `\\%o'."), *prog++);
+ continue;
+ }
+
+ break;
+ }
+
+#if DUMP_TOKENS
+ dump_token ();
+#endif
+}
+
+/* Prints a syntax error message containing the current token and
+ given message MESSAGE (if non-null). */
+void
+lex_error (const char *message, ...)
+{
+ char *token_rep;
+
+ token_rep = lex_token_representation ();
+ if (token_rep[0] == 0)
+ msg (SE, _("Syntax error at end of file."));
+ else if (message)
+ {
+ char buf[1024];
+ va_list args;
+
+ va_start (args, message);
+ vsnprintf (buf, 1024, message, args);
+ va_end (args);
+
+ msg (SE, _("Syntax error %s at `%s'."), buf, token_rep);
+ }
+ else
+ msg (SE, _("Syntax error at `%s'."), token_rep);
+
+ free (token_rep);
+}
+
+/* Checks that we're at end of command.
+ If so, returns a successful command completion code.
+ If not, flags a syntax error and returns an error command
+ completion code. */
+int
+lex_end_of_command (void)
+{
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ return CMD_TRAILING_GARBAGE;
+ }
+ else
+ return CMD_SUCCESS;
+}
+\f
+/* Token testing functions. */
+
+/* Returns nonzero if the current token is an integer. */
+int
+lex_integer_p (void)
+{
+ return (token == T_NUM
+ && tokval != NOT_LONG
+ && tokval >= LONG_MIN
+ && tokval <= LONG_MAX
+ && floor (tokval) == tokval);
+}
+
+/* Returns the value of the current token, which must be an
+ integer. */
+long
+lex_integer (void)
+{
+ assert (lex_integer_p ());
+ return tokval;
+}
+\f
+/* Token matching functions. */
+
+/* If TOK is the current token, skips it and returns nonzero.
+ Otherwise, returns zero. */
+int
+lex_match (int t)
+{
+ if (token == t)
+ {
+ lex_get ();
+ return 1;
+ }
+ else
+ return 0;
+}
+
+/* If the current token is the identifier S, skips it and returns
+ nonzero.
+ Otherwise, returns zero. */
+int
+lex_match_id (const char *s)
+{
+ if (token == T_ID && lex_id_match (s, tokid))
+ {
+ lex_get ();
+ return 1;
+ }
+ else
+ return 0;
+}
+
+/* If the current token is integer N, skips it and returns nonzero.
+ Otherwise, returns zero. */
+int
+lex_match_int (int x)
+{
+ if (lex_integer_p () && lex_integer () == x)
+ {
+ lex_get ();
+ return 1;
+ }
+ else
+ return 0;
+}
+\f
+/* Forced matches. */
+
+/* If this token is identifier S, fetches the next token and returns
+ nonzero.
+ Otherwise, reports an error and returns zero. */
+int
+lex_force_match_id (const char *s)
+{
+ if (token == T_ID && lex_id_match (s, tokid))
+ {
+ lex_get ();
+ return 1;
+ }
+ else
+ {
+ lex_error (_("expecting `%s'"), s);
+ return 0;
+ }
+}
+
+/* If the current token is T, skips the token. Otherwise, reports an
+ error and returns from the current function with return value 0. */
+int
+lex_force_match (int t)
+{
+ if (token == t)
+ {
+ lex_get ();
+ return 1;
+ }
+ else
+ {
+ lex_error (_("expecting %s"), lex_token_name (t));
+ return 0;
+ }
+}
+
+/* If this token is a string, does nothing and returns nonzero.
+ Otherwise, reports an error and returns zero. */
+int
+lex_force_string (void)
+{
+ if (token == T_STRING)
+ return 1;
+ else
+ {
+ lex_error (_("expecting string"));
+ return 0;
+ }
+}
+
+/* If this token is an integer, does nothing and returns nonzero.
+ Otherwise, reports an error and returns zero. */
+int
+lex_force_int (void)
+{
+ if (lex_integer_p ())
+ return 1;
+ else
+ {
+ lex_error (_("expecting integer"));
+ return 0;
+ }
+}
+
+/* If this token is a number, does nothing and returns nonzero.
+ Otherwise, reports an error and returns zero. */
+int
+lex_force_num (void)
+{
+ if (token == T_NUM)
+ return 1;
+ else
+ {
+ lex_error (_("expecting number"));
+ return 0;
+ }
+}
+
+/* If this token is an identifier, does nothing and returns nonzero.
+ Otherwise, reports an error and returns zero. */
+int
+lex_force_id (void)
+{
+ if (token == T_ID)
+ return 1;
+ else
+ {
+ lex_error (_("expecting identifier"));
+ return 0;
+ }
+}
+\f
+/* Comparing identifiers. */
+
+/* Keywords match if one of the following is true: KW and TOK are
+ identical (barring differences in case), or TOK is at least 3
+ characters long and those characters are identical to KW. KW_LEN
+ is the length of KW, TOK_LEN is the length of TOK. */
+int
+lex_id_match_len (const char *kw, size_t kw_len,
+ const char *tok, size_t tok_len)
+{
+ size_t i = 0;
+
+ assert (kw && tok);
+ for (;;)
+ {
+ if (i == kw_len && i == tok_len)
+ return 1;
+ else if (i == tok_len)
+ return i >= 3;
+ else if (i == kw_len)
+ return 0;
+ else if (toupper ((unsigned char) kw[i])
+ != toupper ((unsigned char) tok[i]))
+ return 0;
+
+ i++;
+ }
+}
+
+/* Same as lex_id_match_len() minus the need to pass in the lengths. */
+int
+lex_id_match (const char *kw, const char *tok)
+{
+ return lex_id_match_len (kw, strlen (kw), tok, strlen (tok));
+}
+\f
+/* Weird token functions. */
+
+/* Returns the first character of the next token, except that if the
+ next token is not an identifier, the character returned will not be
+ a character that can begin an identifier. Specifically, the
+ hexstring lead-in X' causes lookahead() to return '. Note that an
+ alphanumeric return value doesn't guarantee an ID token, it could
+ also be a reserved-word token. */
+int
+lex_look_ahead (void)
+{
+ if (put)
+ return put;
+
+ for (;;)
+ {
+ if (eof)
+ unexpected_eof ();
+
+ for (;;)
+ {
+ while (isspace ((unsigned char) *prog))
+ prog++;
+ if (*prog)
+ break;
+
+ if (dot)
+ return '.';
+ else if (!lex_get_line ())
+ unexpected_eof ();
+
+ if (put)
+ return put;
+ }
+
+ if ((toupper ((unsigned char) *prog) == 'X'
+ || toupper ((unsigned char) *prog) == 'B')
+ && (prog[1] == '\'' || prog[1] == '"'))
+ return '\'';
+
+ return *prog;
+ }
+}
+
+/* Makes the current token become the next token to be read; the
+ current token is set to T. */
+void
+lex_put_back (int t)
+{
+ put = token;
+ token = t;
+}
+
+/* Makes T the next token read. */
+void
+lex_put_forward (int t)
+{
+ put = t;
+}
+\f
+/* Weird line processing functions. */
+
+/* Discards the rest of the current input line for tokenization
+ purposes, but returns the entire contents of the line for use by
+ the caller. */
+char *
+lex_entire_line (void)
+{
+ prog = ds_end (&getl_buf);
+ dot = 0;
+ return ds_value (&getl_buf);
+}
+
+/* As lex_entire_line(), but only returns the part of the current line
+ that hasn't already been tokenized.
+ If HAD_DOT is non-null, stores nonzero into *HAD_DOT if the line
+ ends with a terminal dot, or zero if it doesn't. */
+char *
+lex_rest_of_line (int *had_dot)
+{
+ char *s = prog;
+ prog = ds_end (&getl_buf);
+
+ if (had_dot)
+ *had_dot = dot;
+ dot = 0;
+
+ return s;
+}
+
+/* Causes the rest of the current input line to be ignored for
+ tokenization purposes. */
+void
+lex_discard_line (void)
+{
+ msg (SW, _("The rest of this command has been discarded."));
+
+ ds_clear (&getl_buf);
+ prog = ds_value (&getl_buf);
+ dot = put = 0;
+}
+
+/* Sets the current position in the current line to P, which must be
+ in getl_buf. */
+void
+lex_set_prog (char *p)
+{
+ prog = p;
+}
+\f
+/* Weird line reading functions. */
+
+/* Read a line for use by the tokenizer. */
+int
+lex_get_line (void)
+{
+ if (!getl_read_line ())
+ return 0;
+
+ lex_preprocess_line ();
+ return 1;
+}
+
+/* Preprocesses getl_buf by removing comments, stripping trailing
+ whitespace and the terminal dot, and removing leading indentors. */
+void
+lex_preprocess_line (void)
+{
+ /* Strips comments. */
+ {
+ /* getl_buf iterator. */
+ char *cp;
+
+ /* Nonzero inside a comment. */
+ int comment;
+
+ /* Nonzero inside a quoted string. */
+ int quote;
+
+ /* Remove C-style comments begun by slash-star and terminated by
+ star-slash or newline. */
+ quote = comment = 0;
+ for (cp = ds_value (&getl_buf); *cp; )
+ {
+ /* If we're not commented out, toggle quoting. */
+ if (!comment)
+ {
+ if (*cp == quote)
+ quote = 0;
+ else if (*cp == '\'' || *cp == '"')
+ quote = *cp;
+ }
+
+ /* If we're not quoting, toggle commenting. */
+ if (!quote)
+ {
+ if (cp[0] == '/' && cp[1] == '*')
+ {
+ comment = 1;
+ *cp++ = ' ';
+ *cp++ = ' ';
+ continue;
+ }
+ else if (cp[0] == '*' && cp[1] == '/' && comment)
+ {
+ comment = 0;
+ *cp++ = ' ';
+ *cp++ = ' ';
+ continue;
+ }
+ }
+
+ /* Check commenting. */
+ if (!comment)
+ cp++;
+ else
+ *cp++ = ' ';
+ }
+ }
+
+ /* Strip trailing whitespace and terminal dot. */
+ {
+ size_t len = ds_length (&getl_buf);
+ char *s = ds_value (&getl_buf);
+
+ /* Strip trailing whitespace. */
+ while (len > 0 && isspace ((unsigned char) s[len - 1]))
+ len--;
+
+ /* Check for and remove terminal dot. */
+ if (len > 0 && s[len - 1] == set_endcmd)
+ {
+ dot = 1;
+ len--;
+ }
+ else if (len == 0 && set_nullline)
+ dot = 1;
+ else
+ dot = 0;
+
+ /* Set length. */
+ ds_truncate (&getl_buf, len);
+ }
+
+ /* In batch mode, strip leading indentors and insert a terminal dot
+ as necessary. */
+ if (getl_interactive != 2 && getl_mode == GETL_MODE_BATCH)
+ {
+ char *s = ds_value (&getl_buf);
+
+ if (s[0] == '+' || s[0] == '-' || s[0] == '.')
+ s[0] = ' ';
+ else if (s[0] && !isspace ((unsigned char) s[0]))
+ lex_put_forward ('.');
+ }
+
+ prog = ds_value (&getl_buf);
+}
+\f
+/* Token names. */
+
+/* Returns the name of a token in a static buffer. */
+const char *
+lex_token_name (int token)
+{
+ if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
+ return keywords[token - T_FIRST_KEYWORD];
+
+ if (token < 256)
+ {
+ static char t[2];
+ t[0] = token;
+ return t;
+ }
+
+ return _("<ERROR>");
+}
+
+/* Returns an ASCII representation of the current token as a
+ malloc()'d string. */
+char *
+lex_token_representation (void)
+{
+ char *token_rep;
+
+ switch (token)
+ {
+ case T_ID:
+ case T_NUM:
+ return xstrdup (ds_value (&tokstr));
+ break;
+
+ case T_STRING:
+ {
+ int hexstring = 0;
+ char *sp, *dp;
+
+ for (sp = ds_value (&tokstr); sp < ds_end (&tokstr); sp++)
+ if (!isprint ((unsigned char) *sp))
+ {
+ hexstring = 1;
+ break;
+ }
+
+ token_rep = xmalloc (2 + ds_length (&tokstr) * 2 + 1 + 1);
+
+ dp = token_rep;
+ if (hexstring)
+ *dp++ = 'X';
+ *dp++ = '\'';
+
+ if (!hexstring)
+ for (sp = ds_value (&tokstr); *sp; )
+ {
+ if (*sp == '\'')
+ *dp++ = '\'';
+ *dp++ = (unsigned char) *sp++;
+ }
+ else
+ for (sp = ds_value (&tokstr); sp < ds_end (&tokstr); sp++)
+ {
+ *dp++ = (((unsigned char) *sp) >> 4)["0123456789ABCDEF"];
+ *dp++ = (((unsigned char) *sp) & 15)["0123456789ABCDEF"];
+ }
+ *dp++ = '\'';
+ *dp = '\0';
+
+ return token_rep;
+ }
+ break;
+
+ case T_STOP:
+ token_rep = xmalloc (1);
+ *token_rep = '\0';
+ return token_rep;
+
+ case T_EXP:
+ return xstrdup ("**");
+
+ default:
+ if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
+ return xstrdup (keywords [token - T_FIRST_KEYWORD]);
+ else
+ {
+ token_rep = xmalloc (2);
+ token_rep[0] = token;
+ token_rep[1] = '\0';
+ return token_rep;
+ }
+ }
+
+ assert (0);
+}
+\f
+/* Really weird functions. */
+
+/* Most of the time, a `-' is a lead-in to a negative number. But
+ sometimes it's actually part of the syntax. If a dash can be part
+ of syntax then this function is called to rip it off of a
+ number. */
+void
+lex_negative_to_dash (void)
+{
+ if (token == T_NUM && tokval < 0.0)
+ {
+ token = '-';
+ tokval = -tokval;
+ ds_replace (&tokstr, ds_value (&tokstr) + 1);
+ lex_put_forward (T_NUM);
+ }
+}
+
+/* We're not at eof any more. */
+void
+lex_reset_eof (void)
+{
+ eof = 0;
+}
+
+/* Skip a COMMENT command. */
+void
+lex_skip_comment (void)
+{
+ for (;;)
+ {
+ lex_get_line ();
+ if (put == '.')
+ break;
+
+ prog = ds_end (&getl_buf);
+ if (dot)
+ break;
+ }
+}
+\f
+/* Private functions. */
+
+/* Unexpected end of file. */
+static void
+unexpected_eof (void)
+{
+ msg (FE, _("Unexpected end of file."));
+}
+
+/* Returns the proper token type, either T_ID or a reserved keyword
+ enum, for ID[], which must contain LEN characters. */
+static inline int
+check_id (const char *id, size_t len)
+{
+ const char **kwp;
+
+ if (len < 2 || len > 4)
+ return T_ID;
+
+ for (kwp = keywords; *kwp; kwp++)
+ if (!strcmp (*kwp, id))
+ return T_FIRST_KEYWORD + (kwp - keywords);
+
+ return T_ID;
+}
+
+/* When invoked, tokstr contains a string of binary, octal, or hex
+ digits, for values of TYPE of 0, 1, or 2, respectively. The string
+ is converted to characters having the specified values. */
+static void
+convert_numeric_string_to_char_string (int type)
+{
+ static const char *base_names[] = {N_("binary"), N_("octal"), N_("hex")};
+ static const int bases[] = {2, 8, 16};
+ static const int chars_per_byte[] = {8, 3, 2};
+
+ const char *const base_name = base_names[type];
+ const int base = bases[type];
+ const int cpb = chars_per_byte[type];
+ const int nb = ds_length (&tokstr) / cpb;
+ int i;
+ char *p;
+
+ assert (type >= 0 && type <= 2);
+
+ if (ds_length (&tokstr) % cpb)
+ msg (SE, _("String of %s digits has %d characters, which is not a "
+ "multiple of %d."),
+ gettext (base_name), ds_length (&tokstr), cpb);
+
+ p = ds_value (&tokstr);
+ for (i = 0; i < nb; i++)
+ {
+ int value;
+ int j;
+
+ value = 0;
+ for (j = 0; j < cpb; j++, p++)
+ {
+ int v;
+
+ if (*p >= '0' && *p <= '9')
+ v = *p - '0';
+ else
+ {
+ static const char alpha[] = "abcdef";
+ const char *q = strchr (alpha, tolower ((unsigned char) *p));
+
+ if (q)
+ v = q - alpha + 10;
+ else
+ v = base;
+ }
+
+ if (v >= base)
+ msg (SE, _("`%c' is not a valid %s digit."), *p, base_name);
+
+ value = value * base + v;
+ }
+
+ ds_value (&tokstr)[i] = (unsigned char) value;
+ }
+
+ ds_truncate (&tokstr, nb);
+}
+
+/* Parses a string from the input buffer into tokstr. The input
+ buffer pointer prog must point to the initial single or double
+ quote. TYPE is 0 if it is an ordinary string, or 1, 2, or 3 for a
+ binary, octal, or hexstring, respectively. Returns token type. */
+static int
+parse_string (int type)
+{
+ /* Accumulate the entire string, joining sections indicated by +
+ signs. */
+ for (;;)
+ {
+ /* Single or double quote. */
+ int c = *prog++;
+
+ /* Accumulate section. */
+ for (;;)
+ {
+ /* Check end of line. */
+ if (*prog == 0)
+ {
+ msg (SE, _("Unterminated string constant."));
+ goto finish;
+ }
+
+ /* Double quote characters to embed them in strings. */
+ if (*prog == c)
+ {
+ if (prog[1] == c)
+ prog++;
+ else
+ break;
+ }
+
+ ds_putchar (&tokstr, *prog++);
+ }
+ prog++;
+
+ /* Skip whitespace after final quote mark. */
+ if (eof)
+ break;
+ for (;;)
+ {
+ while (isspace ((unsigned char) *prog))
+ prog++;
+ if (*prog)
+ break;
+
+ if (dot)
+ goto finish;
+
+ if (!lex_get_line ())
+ unexpected_eof ();
+ }
+
+ /* Skip plus sign. */
+ if (*prog != '+')
+ break;
+ prog++;
+
+ /* Skip whitespace after plus sign. */
+ if (eof)
+ break;
+ for (;;)
+ {
+ while (isspace ((unsigned char) *prog))
+ prog++;
+ if (*prog)
+ break;
+
+ if (dot)
+ goto finish;
+
+ if (!lex_get_line ())
+ unexpected_eof ();
+ }
+
+ /* Ensure that a valid string follows. */
+ if (*prog != '\'' && *prog != '"')
+ {
+ msg (SE, "String expected following `+'.");
+ goto finish;
+ }
+ }
+
+ /* We come here when we've finished concatenating all the string sections
+ into one large string. */
+finish:
+ if (type != 0)
+ convert_numeric_string_to_char_string (type - 1);
+
+ if (ds_length (&tokstr) > 255)
+ {
+ msg (SE, _("String exceeds 255 characters in length (%d characters)."),
+ ds_length (&tokstr));
+ ds_truncate (&tokstr, 255);
+ }
+
+ {
+ /* FIXME. */
+ size_t i;
+ int warned = 0;
+
+ for (i = 0; i < ds_length (&tokstr); i++)
+ if (ds_value (&tokstr)[i] == 0)
+ {
+ if (!warned)
+ {
+ msg (SE, _("Sorry, literal strings may not contain null "
+ "characters. Replacing with spaces."));
+ warned = 1;
+ }
+ ds_value (&tokstr)[i] = ' ';
+ }
+ }
+
+ return T_STRING;
+}
+\f
+#if DUMP_TOKENS
+/* Reads one token from the lexer and writes a textual representation
+ on stdout for debugging purposes. */
+static void
+dump_token (void)
+{
+ {
+ const char *curfn;
+ int curln;
+
+ getl_location (&curfn, &curln);
+ if (curfn)
+ printf ("%s:%d\t", curfn, curln);
+ }
+
+ switch (token)
+ {
+ case T_ID:
+ printf ("ID\t%s\n", tokid);
+ break;
+
+ case T_NUM:
+ printf ("NUM\t%f\n", tokval);
+ break;
+
+ case T_STRING:
+ printf ("STRING\t\"%s\"\n", ds_value (&tokstr));
+ break;
+
+ case T_STOP:
+ printf ("STOP\n");
+ break;
+
+ case T_EXP:
+ puts ("MISC\tEXP");
+ break;
+
+ case 0:
+ puts ("MISC\tEOF");
+ break;
+
+ default:
+ if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
+ printf ("KEYWORD\t%s\n", lex_token_name (token));
+ else
+ printf ("PUNCT\t%c\n", token);
+ break;
+ }
+}
+#endif /* DEBUGGING */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !lexer_h
+#define lexer_h 1
+
+/* Returns nonzero if character CH may be the first character in an
+ identifier. */
+#define CHAR_IS_ID1(CH) \
+ (isalpha ((unsigned char) (CH)) \
+ || (CH) == '@' \
+ || (CH) == '#' \
+ || (CH) == '$')
+
+/* Returns nonzero if character CH may be a character in an
+ identifier other than the first. */
+#define CHAR_IS_IDN(CH) \
+ (CHAR_IS_ID1 (CH) \
+ || isdigit ((unsigned char) (CH)) \
+ || (CH) == '.' \
+ || (CH) == '_')
+
+/* Token types. */
+/* The order of the enumerals below is important. Do not change it. */
+enum
+ {
+ T_ID = 256, /* Identifier. */
+ T_NUM, /* Number. */
+ T_STRING, /* Quoted string. */
+ T_STOP, /* End of input. */
+
+ T_AND, /* AND */
+ T_OR, /* OR */
+ T_NOT, /* NOT */
+
+ T_EQ, /* EQ */
+ T_GE, /* GE or >= */
+ T_GT, /* GT or > */
+ T_LE, /* LE or <= */
+ T_LT, /* LT or < */
+ T_NE, /* NE or ~= */
+
+ T_ALL, /* ALL */
+ T_BY, /* BY */
+ T_TO, /* TO */
+ T_WITH, /* WITH */
+
+ T_EXP, /* ** */
+
+ T_FIRST_KEYWORD = T_AND,
+ T_LAST_KEYWORD = T_WITH,
+ T_N_KEYWORDS = T_LAST_KEYWORD - T_FIRST_KEYWORD + 1,
+ };
+
+
+extern int token;
+extern double tokval;
+extern char tokid[9];
+extern struct string tokstr;
+
+#include <stddef.h>
+
+/* Initialization. */
+void lex_init (void);
+
+/* Common functions. */
+void lex_get (void);
+void lex_error (const char *, ...);
+int lex_end_of_command (void);
+
+/* Token testing functions. */
+int lex_integer_p (void);
+long lex_integer (void);
+
+/* Token matching functions. */
+int lex_match (int);
+int lex_match_id (const char *);
+int lex_match_int (int);
+
+/* Forcible matching functions. */
+int lex_force_match (int);
+int lex_force_match_id (const char *);
+int lex_force_int (void);
+int lex_force_num (void);
+int lex_force_id (void);
+int lex_force_string (void);
+
+/* Comparing identifiers. */
+int lex_id_match_len (const char *keyword_string, size_t keyword_len,
+ const char *token_string, size_t token_len);
+int lex_id_match (const char *keyword_string, const char *token_string);
+
+/* Weird token functions. */
+int lex_look_ahead (void);
+void lex_put_back (int);
+void lex_put_forward (int);
+
+/* Weird line processing functions. */
+char *lex_entire_line (void);
+char *lex_rest_of_line (int *had_dot);
+void lex_discard_line (void);
+void lex_set_prog (char *p);
+
+/* Weird line reading functions. */
+int lex_get_line (void);
+void lex_preprocess_line (void);
+
+/* Token names. */
+const char *lex_token_name (int);
+char *lex_token_representation (void);
+
+/* Really weird functions. */
+void lex_negative_to_dash (void);
+void lex_reset_eof (void);
+void lex_skip_comment (void);
+
+#endif /* !lexer_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "lexer.h"
+#include "error.h"
+#include "magic.h"
+#include "misc.h"
+#include "htmlP.h"
+#include "output.h"
+#include "som.h"
+#include "var.h"
+#include "vfm.h"
+#include "format.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+#if DEBUGGING
+static void debug_print (void);
+#endif
+
+/* (specification)
+ list (lst_):
+ *variables=varlist("PV_NO_SCRATCH");
+ cases=:from n:first,"%s>0"/by n:step,"%s>0"/ *to n:last,"%s>0";
+ format=numbering:numbered/!unnumbered,
+ wrap:!wrap/single,
+ weight:weight/!noweight.
+*/
+/* (declarations) */
+/* (functions) */
+
+/* Layout for one output driver. */
+struct list_ext
+ {
+ int type; /* 0=Values and labels fit across the page. */
+ int n_vertical; /* Number of labels to list vertically. */
+ int header_rows; /* Number of header rows. */
+ char **header; /* The header itself. */
+ };
+
+/* Parsed command. */
+static struct cmd_list cmd;
+
+/* Current case number. */
+static int case_num;
+
+/* Line buffer. */
+static char *line_buf;
+
+/* TTY-style output functions. */
+static int n_lines_remaining (struct outp_driver *d);
+static int n_chars_width (struct outp_driver *d);
+static void write_line (struct outp_driver *d, char *s);
+
+/* Other functions. */
+static int list_cases (struct ccase *);
+static void determine_layout (void);
+static void clean_up (void);
+static void write_header (struct outp_driver *);
+static void write_all_headers (void);
+
+/* Returns the number of text lines that can fit on the remainder of
+ the page. */
+static inline int
+n_lines_remaining (struct outp_driver *d)
+{
+ int diff;
+
+ diff = d->length - d->cp_y;
+ return (diff > 0) ? (diff / d->font_height) : 0;
+}
+
+/* Returns the number of fixed-width character that can fit across the
+ page. */
+static inline int
+n_chars_width (struct outp_driver *d)
+{
+ return d->width / d->fixed_width;
+}
+
+/* Writes the line S at the current position and advances to the next
+ line. */
+static void
+write_line (struct outp_driver *d, char *s)
+{
+ struct outp_text text;
+
+ assert (d->cp_y + d->font_height <= d->length);
+ text.options = OUTP_T_JUST_LEFT;
+ ls_init (&text.s, s, strlen (s));
+ text.x = d->cp_x;
+ text.y = d->cp_y;
+ d->class->text_draw (d, &text);
+ d->cp_x = 0;
+ d->cp_y += d->font_height;
+}
+
+/* Parses and executes the LIST procedure. */
+int
+cmd_list (void)
+{
+ struct variable casenum_var;
+
+ lex_match_id ("LIST");
+ if (!parse_list (&cmd))
+ return CMD_FAILURE;
+
+ /* Fill in defaults. */
+ if (cmd.step == NOT_LONG)
+ cmd.step = 1;
+ if (cmd.first == NOT_LONG)
+ cmd.first = 1;
+ if (cmd.last == NOT_LONG)
+ cmd.last = LONG_MAX;
+ if (!cmd.sbc_variables)
+ fill_all_vars (&cmd.v_variables, &cmd.n_variables,
+ FV_NO_SYSTEM | FV_NO_SCRATCH);
+ if (cmd.n_variables == 0)
+ {
+ msg (SE, _("No variables specified."));
+ return CMD_FAILURE;
+ }
+
+ /* Verify arguments. */
+ if (cmd.first > cmd.last)
+ {
+ int t;
+ msg (SW, _("The first case (%ld) specified precedes the last case (%ld) "
+ "specified. The values will be swapped."), cmd.first, cmd.last);
+ t = cmd.first;
+ cmd.first = cmd.last;
+ cmd.last = t;
+ }
+ if (cmd.first < 1)
+ {
+ msg (SW, _("The first case (%ld) to list is less than 1. The value is "
+ "being reset to 1."), cmd.first);
+ cmd.first = 1;
+ }
+ if (cmd.last < 1)
+ {
+ msg (SW, _("The last case (%ld) to list is less than 1. The value is "
+ "being reset to 1."), cmd.last);
+ cmd.last = 1;
+ }
+ if (cmd.step < 1)
+ {
+ msg (SW, _("The step value %ld is less than 1. The value is being "
+ "reset to 1."), cmd.step);
+ cmd.step = 1;
+ }
+
+ /* Weighting variable. */
+ if (cmd.weight == LST_WEIGHT)
+ {
+ update_weighting (&default_dict);
+ if (default_dict.weight_index != -1)
+ {
+ int i;
+
+ for (i = 0; i < cmd.n_variables; i++)
+ if (cmd.v_variables[i]->index == default_dict.weight_index)
+ break;
+ if (i >= cmd.n_variables)
+ {
+ /* Add the weight variable to the end of the variable list. */
+ cmd.n_variables++;
+ cmd.v_variables = xrealloc (cmd.v_variables,
+ (cmd.n_variables
+ * sizeof *cmd.v_variables));
+ cmd.v_variables[cmd.n_variables - 1]
+ = default_dict.var[default_dict.weight_index];
+ }
+ }
+ else
+ msg (SW, _("`/FORMAT WEIGHT' specified, but weighting is not on."));
+ }
+
+ /* Case number. */
+ if (cmd.numbering == LST_NUMBERED)
+ {
+ /* Initialize the case-number variable. */
+ strcpy (casenum_var.name, "Case#");
+ casenum_var.type = NUMERIC;
+ casenum_var.fv = -1;
+ casenum_var.print.type = FMT_F;
+ casenum_var.print.w = (cmd.last == LONG_MAX ? 5 : intlog10 (cmd.last));
+ casenum_var.print.d = 0;
+
+ /* Add the weight variable at the beginning of the variable list. */
+ cmd.n_variables++;
+ cmd.v_variables = xrealloc (cmd.v_variables,
+ cmd.n_variables * sizeof *cmd.v_variables);
+ memmove (&cmd.v_variables[1], &cmd.v_variables[0],
+ (cmd.n_variables - 1) * sizeof *cmd.v_variables);
+ cmd.v_variables[0] = &casenum_var;
+ }
+
+#if DEBUGGING
+ /* Print out command. */
+ debug_print ();
+#endif
+
+ determine_layout ();
+
+ case_num = 0;
+ procedure (write_all_headers, list_cases, NULL);
+ free (line_buf);
+
+ clean_up ();
+
+ return CMD_SUCCESS;
+}
+
+/* Writes headers to all devices. This is done at the beginning of
+ each SPLIT FILE group. */
+static void
+write_all_headers (void)
+{
+ struct outp_driver *d;
+
+ for (d = outp_drivers (NULL); d; d = outp_drivers (d))
+ {
+ if (!d->class->special)
+ {
+ d->cp_y += d->font_height; /* Blank line. */
+ write_header (d);
+ }
+ else if (d->class == &html_class)
+ {
+ struct html_driver_ext *x = d->ext;
+
+ assert (d->driver_open && d->page_open);
+ if (x->sequence_no == 0 && !d->class->open_page (d))
+ {
+ msg (ME, _("Cannot open first page on HTML device %s."),
+ d->name);
+ return;
+ }
+
+ fputs ("<TABLE BORDER=1>\n <TR>\n", x->file.file);
+
+ {
+ int i;
+
+ for (i = 0; i < cmd.n_variables; i++)
+ fprintf (x->file.file, " <TH><I><B>%s</B></I></TH>\n",
+ cmd.v_variables[i]->name);
+ }
+
+ fputs (" <TR>\n", x->file.file);
+ }
+ else
+ assert (0);
+ }
+}
+
+/* Writes the headers. Some of them might be vertical; most are
+ probably horizontal. */
+static void
+write_header (struct outp_driver *d)
+{
+ struct list_ext *prc = d->prc;
+
+ if (!prc->header_rows)
+ return;
+
+ if (n_lines_remaining (d) < prc->header_rows + 1)
+ {
+ outp_eject_page (d);
+ assert (n_lines_remaining (d) >= prc->header_rows + 1);
+ }
+
+ /* Design the header. */
+ if (!prc->header)
+ {
+ int i, x;
+
+ /* Allocate, initialize header. */
+ prc->header = xmalloc (sizeof (char *) * prc->header_rows);
+ {
+ int w = n_chars_width (d);
+ for (i = 0; i < prc->header_rows; i++)
+ {
+ prc->header[i] = xmalloc (w + 1);
+ memset (prc->header[i], ' ', w);
+ }
+ }
+
+ /* Put in vertical names. */
+ for (i = x = 0; i < prc->n_vertical; i++)
+ {
+ struct variable *v = cmd.v_variables[i];
+ int j;
+
+ memset (&prc->header[prc->header_rows - 1][x], '-', v->print.w);
+ x += v->print.w - 1;
+ for (j = 0; j < (int) strlen (v->name); j++)
+ prc->header[strlen (v->name) - j - 1][x] = v->name[j];
+ x += 2;
+ }
+
+ /* Put in horizontal names. */
+ for (; i < cmd.n_variables; i++)
+ {
+ struct variable *v = cmd.v_variables[i];
+
+ memset (&prc->header[prc->header_rows - 1][x], '-',
+ max (v->print.w, (int) strlen (v->name)));
+ if ((int) strlen (v->name) < v->print.w)
+ x += v->print.w - strlen (v->name);
+ memcpy (&prc->header[0][x], v->name, strlen (v->name));
+ x += strlen (v->name) + 1;
+ }
+
+ /* Add null bytes. */
+ for (i = 0; i < prc->header_rows; i++)
+ {
+ for (x = n_chars_width (d); x >= 1; x--)
+ if (prc->header[i][x - 1] != ' ')
+ {
+ prc->header[i][x] = 0;
+ break;
+ }
+ assert (x);
+ }
+ }
+
+ /* Write out the header, in back-to-front order except for the last line. */
+ {
+ int i;
+
+ for (i = prc->header_rows - 2; i >= 0; i--)
+ write_line (d, prc->header[i]);
+ write_line (d, prc->header[prc->header_rows - 1]);
+ }
+}
+
+
+/* Frees up all the memory we've allocated. */
+static void
+clean_up (void)
+{
+ struct outp_driver *d;
+
+ for (d = outp_drivers (NULL); d; d = outp_drivers (d))
+ if (d->class->special == 0)
+ {
+ struct list_ext *prc = d->prc;
+ int i;
+
+ if (prc->header)
+ {
+ for (i = 0; i < prc->header_rows; i++)
+ free (prc->header[i]);
+ free (prc->header);
+ }
+ free (prc);
+
+ d->class->text_set_font_by_name (d, "PROP");
+ }
+ else if (d->class == &html_class)
+ {
+ if (d->driver_open && d->page_open)
+ {
+ struct html_driver_ext *x = d->ext;
+
+ fputs ("</TABLE>\n", x->file.file);
+ }
+ }
+ else
+ assert (0);
+
+ free (cmd.v_variables);
+}
+
+/* Writes string STRING at the current position. If the text would
+ fall off the side of the page, then advance to the next line,
+ indenting by amount INDENT. */
+static void
+write_varname (struct outp_driver *d, char *string, int indent)
+{
+ struct outp_text text;
+
+ text.options = OUTP_T_JUST_LEFT;
+ ls_init (&text.s, string, strlen (string));
+ d->class->text_metrics (d, &text);
+
+ if (d->cp_x + text.h > d->width)
+ {
+ d->cp_y += d->font_height;
+ if (d->cp_y + d->font_height > d->length)
+ outp_eject_page (d);
+ d->cp_x = indent;
+ }
+
+ text.x = d->cp_x;
+ text.y = d->cp_y;
+ d->class->text_draw (d, &text);
+ d->cp_x += text.h;
+}
+
+/* When we can't fit all the values across the page, we write out all
+ the variable names just once. This is where we do it. */
+static void
+write_fallback_headers (struct outp_driver *d)
+{
+ const int max_width = n_chars_width(d) - 10;
+
+ int index = 0;
+ int width = 0;
+ int line_number = 0;
+
+ const char *Line = _("Line");
+ char *leader = local_alloc (strlen (Line) + INT_DIGITS + 1 + 1);
+
+ while (index < cmd.n_variables)
+ {
+ struct outp_text text;
+
+ /* Ensure that there is enough room for a line of text. */
+ if (d->cp_y + d->font_height > d->length)
+ outp_eject_page (d);
+
+ /* The leader is a string like `Line 1: '. Write the leader. */
+ sprintf(leader, "%s %d:", Line, ++line_number);
+ text.options = OUTP_T_JUST_LEFT;
+ ls_init (&text.s, leader, strlen (leader));
+ text.x = 0;
+ text.y = d->cp_y;
+ d->class->text_draw (d, &text);
+ d->cp_x = text.h;
+
+ goto entry;
+ do
+ {
+ width++;
+
+ entry:
+ {
+ int var_width = cmd.v_variables[index]->print.w;
+ if (width + var_width > max_width && width != 0)
+ {
+ width = 0;
+ d->cp_x = 0;
+ d->cp_y += d->font_height;
+ break;
+ }
+ width += var_width;
+ }
+
+ {
+ char varname[10];
+ sprintf (varname, " %s", cmd.v_variables[index]->name);
+ write_varname (d, varname, text.h);
+ }
+ }
+ while (++index < cmd.n_variables);
+
+ }
+ d->cp_x = 0;
+ d->cp_y += d->font_height;
+
+ local_free (leader);
+}
+
+/* There are three possible layouts for the LIST procedure:
+
+ 1. If the values and their variables' name fit across the page,
+ then they are listed across the page in that way.
+
+ 2. If the values can fit across the page, but not the variable
+ names, then as many variable names as necessary are printed
+ vertically to compensate.
+
+ 3. If not even the values can fit across the page, the variable
+ names are listed just once, at the beginning, in a compact format,
+ and the values are listed with a variable name label at the
+ beginning of each line for easier reference.
+
+ This is complicated by the fact that we have to do all this for
+ every output driver, not just once. */
+static void
+determine_layout (void)
+{
+ struct outp_driver *d;
+
+ /* This is the largest page width of any driver, so we can tell what
+ size buffer to allocate. */
+ int largest_page_width = 0;
+
+ for (d = outp_drivers (NULL); d; d = outp_drivers (d))
+ {
+ int column; /* Current column. */
+ int width; /* Accumulated width. */
+ int max_width; /* Page width. */
+
+ struct list_ext *prc;
+
+ if (d->class == &html_class)
+ continue;
+
+ assert (d->class->special == 0);
+
+ if (!d->page_open)
+ d->class->open_page (d);
+
+ max_width = n_chars_width (d);
+ largest_page_width = max (largest_page_width, max_width);
+
+ prc = d->prc = xmalloc (sizeof *prc);
+ prc->type = 0;
+ prc->n_vertical = 0;
+ prc->header = NULL;
+
+ /* Try layout #1. */
+ for (width = cmd.n_variables - 1, column = 0; column < cmd.n_variables; column++)
+ {
+ struct variable *v = cmd.v_variables[column];
+ width += max (v->print.w, (int) strlen (v->name));
+ }
+ if (width <= max_width)
+ {
+ prc->header_rows = 2;
+ d->class->text_set_font_by_name (d, "FIXED");
+ continue;
+ }
+
+ /* Try layout #2. */
+ for (width = cmd.n_variables - 1, column = 0;
+ column < cmd.n_variables && width <= max_width;
+ column++)
+ width += cmd.v_variables[column]->print.w;
+
+ /* If it fit then we need to determine how many labels can be
+ written horizontally. */
+ if (width <= max_width)
+ {
+#ifndef NDEBUG
+ prc->n_vertical = -1;
+#endif
+ for (column = cmd.n_variables - 1; column >= 0; column--)
+ {
+ struct variable *v = cmd.v_variables[column];
+ int trial_width = (width - v->print.w
+ + max (v->print.w, (int) strlen (v->name)));
+
+ if (trial_width > max_width)
+ {
+ prc->n_vertical = column + 1;
+ break;
+ }
+ width = trial_width;
+ }
+ assert(prc->n_vertical != -1);
+
+ prc->n_vertical = cmd.n_variables;
+ /* Finally determine the length of the headers. */
+ for (prc->header_rows = 0, column = 0;
+ column < prc->n_vertical;
+ column++)
+ prc->header_rows = max (prc->header_rows,
+ (int) strlen (cmd.v_variables[column]->name));
+ prc->header_rows++;
+
+ d->class->text_set_font_by_name (d, "FIXED");
+ continue;
+ }
+
+ /* Otherwise use the ugly fallback listing format. */
+ prc->type = 1;
+ prc->header_rows = 0;
+
+ d->cp_y += d->font_height;
+ write_fallback_headers (d);
+ d->cp_y += d->font_height;
+ d->class->text_set_font_by_name (d, "FIXED");
+ }
+
+ line_buf = xmalloc (max (1022, largest_page_width) + 2);
+}
+
+static int
+list_cases (struct ccase *c)
+{
+ struct outp_driver *d;
+
+ case_num++;
+ if (case_num < cmd.first || case_num > cmd.last
+ || (cmd.step != 1 && (case_num - cmd.first) % cmd.step))
+ return 1;
+
+ for (d = outp_drivers (NULL); d; d = outp_drivers (d))
+ if (d->class->special == 0)
+ {
+ const struct list_ext *prc = d->prc;
+ const int max_width = n_chars_width (d);
+ int column;
+ int x = 0;
+
+ if (!prc->header_rows)
+ x = nsprintf (line_buf, "%8s: ", cmd.v_variables[0]->name);
+
+ for (column = 0; column < cmd.n_variables; column++)
+ {
+ struct variable *v = cmd.v_variables[column];
+ int width;
+
+ if (prc->type == 0 && column >= prc->n_vertical)
+ width = max ((int) strlen (v->name), v->print.w);
+ else
+ width = v->print.w;
+
+ if (width + x > max_width && x != 0)
+ {
+ if (!n_lines_remaining (d))
+ {
+ outp_eject_page (d);
+ write_header (d);
+ }
+
+ line_buf[x] = 0;
+ write_line (d, line_buf);
+
+ x = 0;
+ if (!prc->header_rows)
+ x = nsprintf (line_buf, "%8s: ", v->name);
+ }
+
+ if (width > v->print.w)
+ {
+ memset(&line_buf[x], ' ', width - v->print.w);
+ x += width - v->print.w;
+ }
+
+ {
+ union value value;
+
+ if (formats[v->print.type].cat & FCAT_STRING)
+ value.c = c->data[v->fv].s;
+ else if (v->fv == -1)
+ value.f = case_num;
+ else
+ value.f = c->data[v->fv].f;
+
+ data_out (&line_buf[x], &v->print, &value);
+ }
+ x += v->print.w;
+
+ line_buf[x++] = ' ';
+ }
+
+ if (!n_lines_remaining (d))
+ {
+ outp_eject_page (d);
+ write_header (d);
+ }
+
+ line_buf[x] = 0;
+ write_line (d, line_buf);
+ }
+ else if (d->class == &html_class)
+ {
+ struct html_driver_ext *x = d->ext;
+ int column;
+
+ fputs (" <TR>\n", x->file.file);
+
+ for (column = 0; column < cmd.n_variables; column++)
+ {
+ struct variable *v = cmd.v_variables[column];
+ union value value;
+ char buf[41];
+
+ if (formats[v->print.type].cat & FCAT_STRING)
+ value.c = c->data[v->fv].s;
+ else if (v->fv == -1)
+ value.f = case_num;
+ else
+ value.f = c->data[v->fv].f;
+
+ data_out (buf, &v->print, &value);
+ buf[v->print.w] = 0;
+
+ fprintf (x->file.file, " <TD ALIGN=RIGHT>%s</TD>\n",
+ &buf[strspn (buf, " ")]);
+ }
+
+ fputs (" </TR>\n", x->file.file);
+ }
+ else
+ assert (0);
+
+ return 1;
+}
+\f
+/* Debugging output. */
+
+#if DEBUGGING
+/* Prints out the command as parsed by cmd_list(). */
+static void
+debug_print (void)
+{
+ int i;
+
+ puts ("LIST");
+ printf (" VARIABLES=");
+ for (i = 0; i < cmd.n_variables; i++)
+ {
+ if (i)
+ putc (' ', stdout);
+ fputs (cmd.v_variables[i]->name, stdout);
+ }
+
+ printf ("\n /CASES=FROM %ld TO %ld BY %ld\n", first, last, step);
+
+ fputs (" /FORMAT=", stdout);
+ if (numbering == NUMBERED)
+ fputs ("NUMBERED", stdout);
+ else
+ fputs ("UNNUMBERED", stdout);
+ putc (' ', stdout);
+ if (wrap == WRAP)
+ fputs ("WRAP", stdout);
+ else
+ fputs ("SINGLE", stdout);
+ putc (' ', stdout);
+ if (weight == WEIGHT)
+ fputs ("WEIGHT", stdout);
+ else
+ fputs ("NOWEIGHT", stdout);
+ puts (".");
+}
+#endif /* DEBUGGING */
+
+/*
+ Local Variables:
+ mode: c
+ End:
+*/
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !log_h
+#define log_h 1
+
+#include <stdio.h>
+
+/* Whether logging is on. */
+extern int logging;
+
+/* The name of the log file. */
+extern char *logfn;
+
+/* The log file stream. */
+extern FILE *logfile;
+
+/* Log file management. */
+void open_logfile (void);
+void close_logfile (void);
+
+#endif /* !log_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include "alloc.h"
+#include "approx.h"
+#include "command.h"
+#include "do-ifP.h"
+#include "error.h"
+#include "expr.h"
+#include "lexer.h"
+#include "settings.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* *INDENT-OFF* */
+/* LOOP strategy:
+
+ Each loop causes 3 different transformations to be output. The
+ first two are output when the LOOP command is encountered; the last
+ is output when the END LOOP command is encountered.
+
+ The first to be output resets the pass number in the second
+ transformation to -1. This ensures that the pass number is set to
+ -1 every time the loop is encountered, before the first iteration.
+
+ The second transformation increments the pass number. If there is
+ no indexing or test clause on either LOOP or END LOOP, then the
+ pass number is checked against MXLOOPS and control may pass out of
+ the loop; otherwise the indexing or test clause(s) on LOOP are
+ checked, and again control may pass out of the loop.
+
+ After the second transformation the body of the loop is executed.
+
+ The last transformation checks the test clause if present and
+ either jumps back up to the second transformation or terminates the
+ loop.
+
+ Flow of control: (The characters ^V<> represents arrows.)
+
+ 1. LOOP (sets pass # to -1)
+ V
+ V
+ >>2. LOOP (increment pass number)
+ ^ (test optional indexing clause)
+ ^ (test optional IF clause)
+ ^ if we need another trip if we're done with the loop>>V
+ ^ V V
+ ^ V V
+ ^ *. execute loop body V
+ ^ . V
+ ^ . (any number of transformations) V
+ ^ . V
+ ^ V
+ ^ 3. END LOOP (test optional IF clause) V
+ ^<<<<if we need another trip if we're done with the loop>>V
+ V
+ V
+ *. transformations after loop body<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+ */
+/* *INDENT-ON* */
+
+/* Types of limits on loop execution. */
+enum
+ {
+ LPC_INDEX = 001, /* Limited by indexing clause. */
+ LPC_COND = 002, /* Limited by IF clause. */
+ LPC_RINDEX = 004 /* Indexing clause counts downward, at least
+ for this pass thru the loop. */
+ };
+
+/* LOOP transformation 1. */
+struct loop_1_trns
+ {
+ struct trns_header h;
+
+ struct loop_2_trns *two; /* Allows modification of associated
+ second transformation. */
+
+ struct expression *init; /* Starting index. */
+ struct expression *incr; /* Index increment. */
+ struct expression *term; /* Terminal index. */
+ };
+
+/* LOOP transformation 2. */
+struct loop_2_trns
+ {
+ struct trns_header h;
+
+ struct ctl_stmt ctl; /* Nesting control info. */
+
+ int flags; /* Types of limits on loop execution. */
+ int pass; /* Number of passes thru the loop so far. */
+
+ struct variable *index; /* Index variable. */
+ double curr; /* Current index. */
+ double incr; /* Increment. */
+ double term; /* Terminal index. */
+
+ struct expression *cond; /* Optional IF condition when non-NULL. */
+
+ int loop_term; /* 1+(t_trns[] index of transformation 3);
+ backpatched in by END LOOP. */
+ };
+
+/* LOOP transformation 3. (Actually output by END LOOP.) */
+struct loop_3_trns
+ {
+ struct trns_header h;
+
+ struct expression *cond; /* Optional IF condition when non-NULL. */
+
+ int loop_start; /* t_trns[] index of transformation 2. */
+ };
+
+/* LOOP transformations being created. */
+static struct loop_1_trns *one;
+static struct loop_2_trns *two;
+static struct loop_3_trns *thr;
+
+static int internal_cmd_loop (void);
+static int internal_cmd_end_loop (void);
+static int break_trns_proc (struct trns_header *, struct ccase *);
+static int loop_1_trns_proc (struct trns_header *, struct ccase *);
+static void loop_1_trns_free (struct trns_header *);
+static int loop_2_trns_proc (struct trns_header *, struct ccase *);
+static void loop_2_trns_free (struct trns_header *);
+static int loop_3_trns_proc (struct trns_header *, struct ccase *);
+static void loop_3_trns_free (struct trns_header *);
+static void pop_ctl_stack (void);
+\f
+/* LOOP. */
+
+/* Parses a LOOP command. Passes the real work off to
+ internal_cmd_loop(). */
+int
+cmd_loop (void)
+{
+ if (!internal_cmd_loop ())
+ {
+ loop_1_trns_free ((struct trns_header *) one);
+ loop_2_trns_free ((struct trns_header *) two);
+ return CMD_FAILURE;
+ }
+
+ return CMD_SUCCESS;
+}
+
+/* Parses a LOOP command, returns success. */
+static int
+internal_cmd_loop (void)
+{
+ /* Name of indexing variable if applicable. */
+ char name[9];
+
+ lex_match_id ("LOOP");
+
+ /* Create and initialize transformations to facilitate
+ error-handling. */
+ two = xmalloc (sizeof *two);
+ two->h.proc = loop_2_trns_proc;
+ two->h.free = loop_2_trns_free;
+ two->cond = NULL;
+ two->flags = 0;
+
+ one = xmalloc (sizeof *one);
+ one->h.proc = loop_1_trns_proc;
+ one->h.free = loop_1_trns_free;
+ one->init = one->incr = one->term = NULL;
+ one->two = two;
+
+ /* Parse indexing clause. */
+ if (token == T_ID && lex_look_ahead () == '=')
+ {
+ struct variable *v = find_variable (tokid);
+
+ two->flags |= LPC_INDEX;
+
+ if (v && v->type == ALPHA)
+ {
+ msg (SE, _("The index variable may not be a string variable."));
+ return 0;
+ }
+ strcpy (name, tokid);
+
+ lex_get ();
+ assert (token == '=');
+ lex_get ();
+
+ one->init = expr_parse (PXP_NUMERIC);
+ if (!one->init)
+ return 0;
+
+ if (!lex_force_match (T_TO))
+ {
+ expr_free (one->init);
+ return 0;
+ }
+ one->term = expr_parse (PXP_NUMERIC);
+ if (!one->term)
+ {
+ expr_free (one->init);
+ return 0;
+ }
+
+ if (lex_match (T_BY))
+ {
+ one->incr = expr_parse (PXP_NUMERIC);
+ if (!one->incr)
+ return 0;
+ }
+ }
+ else
+ name[0] = 0;
+
+ /* Parse IF clause. */
+ if (lex_match_id ("IF"))
+ {
+ two->flags |= LPC_COND;
+
+ two->cond = expr_parse (PXP_BOOLEAN);
+ if (!two->cond)
+ return 0;
+ }
+
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ return 0;
+ }
+
+ /* Find variable; create if necessary. */
+ if (name[0])
+ {
+ two->index = find_variable (name);
+ if (!two->index)
+ {
+ two->index = force_create_variable (&default_dict, name, NUMERIC, 0);
+#if DEBUGGING
+ envector (two->index);
+#endif
+ }
+ }
+
+ /* Push on control stack. */
+ two->ctl.down = ctl_stack;
+ two->ctl.type = CST_LOOP;
+ two->ctl.trns = (struct trns_header *) two;
+ two->ctl.brk = NULL;
+ ctl_stack = &two->ctl;
+
+ /* Dump out the transformations. */
+ add_transformation ((struct trns_header *) one);
+ add_transformation ((struct trns_header *) two);
+
+#if DEBUGGING
+ printf ("LOOP");
+ if (two->flags & LPC_INDEX)
+ printf ("(INDEX)");
+ if (two->flags & LPC_COND)
+ printf ("(IF)");
+ printf ("\n");
+#endif
+
+ return 1;
+}
+
+/* Parses the END LOOP command by passing the buck off to
+ cmd_internal_end_loop(). */
+int
+cmd_end_loop (void)
+{
+ if (!internal_cmd_end_loop ())
+ {
+ loop_3_trns_free ((struct trns_header *) thr);
+ if (ctl_stack && ctl_stack->type == CST_LOOP)
+ pop_ctl_stack ();
+ return CMD_FAILURE;
+ }
+
+ return CMD_SUCCESS;
+}
+
+/* Parses the END LOOP command. */
+int
+internal_cmd_end_loop (void)
+{
+ /* Backpatch pointer for BREAK commands. */
+ struct break_trns *brk;
+
+ /* Allocate, initialize transformation to facilitate
+ error-handling. */
+ thr = xmalloc (sizeof *thr);
+ thr->h.proc = loop_3_trns_proc;
+ thr->h.free = loop_3_trns_free;
+ thr->cond = NULL;
+
+ /* There must be a matching LOOP command. */
+ if (!ctl_stack || ctl_stack->type != CST_LOOP)
+ {
+ msg (SE, _("There is no LOOP command that corresponds to this "
+ "END LOOP."));
+ return 0;
+ }
+ thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
+
+ /* Parse the expression if any. */
+ if (lex_match_id ("IF"))
+ {
+ thr->cond = expr_parse (PXP_BOOLEAN);
+ if (!thr->cond)
+ return 0;
+ }
+
+ add_transformation ((struct trns_header *) thr);
+
+ /* Backpatch. */
+ ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
+ for (brk = ctl_stack->brk; brk; brk = brk->next)
+ brk->loop_term = n_trns;
+
+ /* Pop off the top of stack. */
+ ctl_stack = ctl_stack->down;
+
+#if DEBUGGING
+ printf ("END LOOP");
+ if (thr->cond)
+ printf ("(IF)");
+ printf ("\n");
+#endif
+
+ return 1;
+}
+
+/* Performs transformation 1. */
+static int
+loop_1_trns_proc (struct trns_header * trns, struct ccase * c)
+{
+ struct loop_1_trns *one = (struct loop_1_trns *) trns;
+ struct loop_2_trns *two = one->two;
+
+ two->pass = -1;
+ if (two->flags & LPC_INDEX)
+ {
+ union value t1, t2, t3;
+
+ expr_evaluate (one->init, c, &t1);
+ if (one->incr)
+ expr_evaluate (one->incr, c, &t2);
+ else
+ t2.f = 1.0;
+ expr_evaluate (one->term, c, &t3);
+
+ /* Even if the loop is never entered, force the index variable
+ to assume the initial value. */
+ c->data[two->index->fv].f = t1.f;
+
+ /* Throw out various pathological cases. */
+ if (!finite (t1.f) || !finite (t2.f) || !finite (t3.f)
+ || approx_eq (t2.f, 0.0))
+ return two->loop_term;
+ debug_printf (("LOOP %s=%g TO %g BY %g.\n", two->index->name,
+ t1.f, t3.f, t2.f));
+ if (t2.f > 0.0)
+ {
+ /* Loop counts upward: I=1 TO 5 BY 1. */
+ two->flags &= ~LPC_RINDEX;
+
+ /* incr>0 but init>term */
+ if (approx_gt (t1.f, t3.f))
+ return two->loop_term;
+ }
+ else
+ {
+ /* Loop counts downward: I=5 TO 1 BY -1. */
+ two->flags |= LPC_RINDEX;
+
+ /* incr<0 but init<term */
+ if (approx_lt (t1.f, t3.f))
+ return two->loop_term;
+ }
+
+ two->curr = t1.f;
+ two->incr = t2.f;
+ two->term = t3.f;
+ }
+
+ return -1;
+}
+
+/* Frees transformation 1. */
+static void
+loop_1_trns_free (struct trns_header * trns)
+{
+ struct loop_1_trns *one = (struct loop_1_trns *) trns;
+
+ expr_free (one->init);
+ expr_free (one->incr);
+ expr_free (one->term);
+}
+
+/* Performs transformation 2. */
+static int
+loop_2_trns_proc (struct trns_header * trns, struct ccase * c)
+{
+ struct loop_2_trns *two = (struct loop_2_trns *) trns;
+
+ /* MXLOOPS limiter. */
+ if (two->flags == 0)
+ {
+ two->pass++;
+ if (two->pass > set_mxloops)
+ return two->loop_term;
+ }
+
+ /* Indexing clause limiter: counting downward. */
+ if (two->flags & LPC_RINDEX)
+ {
+ /* Test if we're at the end of the looping. */
+ if (approx_lt (two->curr, two->term))
+ return two->loop_term;
+
+ /* Set the current value into the case. */
+ c->data[two->index->fv].f = two->curr;
+
+ /* Decrement the current value. */
+ two->curr += two->incr;
+ }
+ /* Indexing clause limiter: counting upward. */
+ else if (two->flags & LPC_INDEX)
+ {
+ /* Test if we're at the end of the looping. */
+ if (approx_gt (two->curr, two->term))
+ return two->loop_term;
+
+ /* Set the current value into the case. */
+ c->data[two->index->fv].f = two->curr;
+
+ /* Increment the current value. */
+ two->curr += two->incr;
+ }
+
+ /* Conditional clause limiter. */
+ if ((two->flags & LPC_COND)
+ && expr_evaluate (two->cond, c, NULL) != 1.0)
+ return two->loop_term;
+
+ return -1;
+}
+
+/* Frees transformation 2. */
+static void
+loop_2_trns_free (struct trns_header * trns)
+{
+ struct loop_2_trns *two = (struct loop_2_trns *) trns;
+
+ expr_free (two->cond);
+}
+
+/* Performs transformation 3. */
+static int
+loop_3_trns_proc (struct trns_header * trns, struct ccase * c)
+{
+ struct loop_3_trns *thr = (struct loop_3_trns *) trns;
+
+ /* Note that it breaks out of the loop if the expression is true *or
+ missing*. This is conformant. */
+ if (thr->cond && expr_evaluate (two->cond, c, NULL) != 0.0)
+ return -1;
+
+ return thr->loop_start;
+}
+
+/* Frees transformation 3. */
+static void
+loop_3_trns_free (struct trns_header * trns)
+{
+ struct loop_3_trns *thr = (struct loop_3_trns *) trns;
+
+ expr_free (thr->cond);
+}
+\f
+/* BREAK. */
+
+/* Parses the BREAK command. */
+int
+cmd_break (void)
+{
+ /* Climbs down the stack to find a LOOP. */
+ struct ctl_stmt *loop;
+
+ /* New transformation. */
+ struct break_trns *t;
+
+ lex_match_id ("BREAK");
+
+ for (loop = ctl_stack; loop; loop = loop->down)
+ if (loop->type == CST_LOOP)
+ break;
+ if (!loop)
+ {
+ msg (SE, _("This command may only appear enclosed in a LOOP/"
+ "END LOOP control structure."));
+ return CMD_FAILURE;
+ }
+
+ if (ctl_stack->type != CST_DO_IF)
+ msg (SW, _("BREAK not enclosed in DO IF structure."));
+
+ t = xmalloc (sizeof *t);
+ t->h.proc = break_trns_proc;
+ t->h.free = NULL;
+ t->next = loop->brk;
+ loop->brk = t;
+ add_transformation ((struct trns_header *) t);
+
+ return lex_end_of_command ();
+}
+
+static int
+break_trns_proc (struct trns_header * trns, struct ccase * c unused)
+{
+ return ((struct break_trns *) trns)->loop_term;
+}
+\f
+/* Control stack operations. */
+
+/* Pops the top of stack element off of ctl_stack. Does not
+ check that ctl_stack is indeed non-NULL. */
+static void
+pop_ctl_stack (void)
+{
+ switch (ctl_stack->type)
+ {
+ case CST_LOOP:
+ {
+ /* Pointer for chasing down and backpatching BREAKs. */
+ struct break_trns *brk;
+
+ /* Terminate the loop. */
+ thr = xmalloc (sizeof *thr);
+ thr->h.proc = loop_3_trns_proc;
+ thr->h.free = loop_3_trns_free;
+ thr->cond = NULL;
+ thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
+ add_transformation ((struct trns_header *) thr);
+
+ /* Backpatch. */
+ ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
+ for (brk = ctl_stack->brk; brk; brk = brk->next)
+ brk->loop_term = n_trns;
+ }
+ break;
+ case CST_DO_IF:
+ {
+ /* List iterator. */
+ struct do_if_trns *iter;
+
+ iter = ((struct do_if_trns *) ctl_stack->trns);
+ for (;;)
+ {
+ if (iter->brk)
+ iter->brk->dest = n_trns;
+ iter->missing_jump = n_trns;
+ if (iter->next)
+ iter = iter->next;
+ else
+ break;
+ }
+ iter->false_jump = n_trns;
+ }
+ break;
+ default:
+ assert (0);
+ }
+ ctl_stack = ctl_stack->down;
+}
+
+/* Checks for unclosed LOOPs and DO IFs and closes them out. */
+void
+discard_ctl_stack (void)
+{
+ if (!ctl_stack)
+ return;
+ msg (SE, _("%s without %s."), ctl_stack->type == CST_LOOP ? "LOOP" : "DO IF",
+ ctl_stack->type == CST_LOOP ? "END LOOP" : "END IF");
+ while (ctl_stack)
+ pop_ctl_stack ();
+ ctl_stack = NULL;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include "magic.h"
+
+#if ENDIAN==UNKNOWN
+/* BIG or LITTLE, depending on this machine's endianness, as detected
+ at program startup. */
+int endian;
+#endif
+
+#ifndef SECOND_LOWEST_VALUE
+/* "Second lowest" value for a flt64; that is, (-FLT64_MAX) + epsilon. */
+double second_lowest_value;
+#endif
+
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !magic_h
+#define magic_h 1
+
+/* Magic numbers. */
+
+#include <float.h>
+#include <limits.h>
+
+#if ENDIAN != UNKNOWN
+#define endian ENDIAN
+#else
+extern int endian;
+#endif
+
+#ifdef SECOND_LOWEST_VALUE
+#define second_lowest_value SECOND_LOWEST_VALUE
+#else
+extern double second_lowest_value;
+#endif
+
+/* Used when we want a "missing value". */
+#define NOT_DOUBLE (-DBL_MAX)
+#define NOT_LONG LONG_MIN
+#define NOT_INT INT_MIN
+
+#endif /* magic.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdio.h>
+#include "command.h"
+#include "error.h"
+#include "getline.h"
+#include "lexer.h"
+#include "output.h"
+
+#include <stdlib.h>
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+static void parse_script (void) __attribute__ ((noreturn));
+static void handle_error (int code);
+static int execute_command (void);
+
+/* argv[0] with stripped leading directories. */
+char *pgmname;
+
+/* Whether FINISH. has been executed. */
+int finished;
+
+/* The current date in the form DD MMM YYYY. */
+char curdate[12];
+
+/* Whether we're dropping down to interactive mode immediately because
+ we hit end-of-file unexpectedly (or whatever). */
+int start_interactive;
+
+/* Program entry point. */
+int
+main (int argc, char **argv)
+{
+ void init_glob (int, char **); /* Exported by glob.c. */
+ void parse_command_line (int, char **); /* Exported by cmdline.c */
+
+ /* Initialization. */
+ if (!outp_init ())
+ err_hcf (0);
+ init_glob (argc, argv);
+ parse_command_line (argc, argv);
+ if (!outp_read_devices ())
+ msg (FE, _("Error initializing output drivers."));
+
+ lex_init ();
+ cmd_init ();
+
+ /* Execution. */
+ parse_script ();
+}
+
+/* Parses the entire script. */
+static void
+parse_script (void)
+{
+ while (!finished)
+ {
+ err_check_count ();
+ handle_error (execute_command ());
+ }
+
+ err_hcf (1);
+}
+
+/* Parse and execute a command, returning its return code. */
+static int
+execute_command (void)
+{
+ /* Read the command's first token.
+ We may hit end of file.
+ If so, give the line reader a chance to proceed to the next file.
+ End of file is not handled transparently since the user may want
+ the dictionary cleared between files. */
+ getl_prompt = GETL_PRPT_STANDARD;
+ for (;;)
+ {
+ lex_get ();
+ if (token != T_STOP)
+ break;
+
+ if (!getl_perform_delayed_reset ())
+ err_hcf (1);
+ }
+
+ /* Parse the command. */
+ getl_prompt = GETL_PRPT_CONTINUATION;
+ return cmd_parse ();
+}
+
+/* Print an error message corresponding to the command return code
+ CODE. */
+static void
+handle_error (int code)
+{
+ switch (code)
+ {
+ case CMD_SUCCESS:
+ return;
+
+ case CMD_FAILURE:
+ msg (SW, _("This command not executed."));
+ break;
+
+ case CMD_PART_SUCCESS_MAYBE:
+ msg (SW, _("Skipping the rest of this command. Part of "
+ "this command may have been executed."));
+ break;
+
+ case CMD_PART_SUCCESS:
+ msg (SW, _("Skipping the rest of this command. This "
+ "command was fully executed up to this point."));
+ break;
+
+ case CMD_TRAILING_GARBAGE:
+ msg (SW, _("Trailing garbage was encountered following "
+ "this command. The command was fully executed "
+ "to this point."));
+ break;
+
+ default:
+ assert (0);
+ }
+
+ if (getl_reading_script)
+ {
+ err_break ();
+ while (token != T_STOP && token != '.')
+ lex_get ();
+ }
+ else
+ lex_discard_line ();
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !main_h
+#define main_h 1
+
+extern char *pgmname;
+extern char curdate[];
+extern int start_interactive;
+extern int finished;
+
+#endif /* main.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <float.h>
+#include "alloc.h"
+#include "command.h"
+#include "data-in.h"
+#include "dfm.h"
+#include "error.h"
+#include "file-handle.h"
+#include "lexer.h"
+#include "misc.h"
+#include "pool.h"
+#include "str.h"
+#include "var.h"
+#include "vfm.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* FIXME: /N subcommand not implemented. It should be pretty simple,
+ too. */
+
+/* Format type enums. */
+enum
+ {
+ LIST,
+ FREE
+ };
+
+/* Matrix section enums. */
+enum
+ {
+ LOWER,
+ UPPER,
+ FULL
+ };
+
+/* Diagonal inclusion enums. */
+enum
+ {
+ DIAGONAL,
+ NODIAGONAL
+ };
+
+/* CONTENTS types. */
+enum
+ {
+ N_VECTOR,
+ N_SCALAR,
+ N_MATRIX,
+ MEAN,
+ STDDEV,
+ COUNT,
+ MSE,
+ DFE,
+ MAT,
+ COV,
+ CORR,
+ PROX,
+
+ LPAREN,
+ RPAREN,
+ EOC
+ };
+
+/* 0=vector, 1=matrix, 2=scalar. */
+static int content_type[PROX + 1] =
+ {
+ 0, 2, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1,
+ };
+
+/* Name of each content type. */
+static const char *content_names[PROX + 1] =
+ {
+ "N", "N", "N_MATRIX", "MEAN", "STDDEV", "COUNT", "MSE",
+ "DFE", "MAT", "COV", "CORR", "PROX",
+ };
+
+/* The data file to be read. */
+static struct file_handle *data_file;
+
+/* Format type. */
+static int fmt; /* LIST or FREE. */
+static int section; /* LOWER or UPPER or FULL. */
+static int diag; /* DIAGONAL or NODIAGONAL. */
+
+/* Arena used for all the MATRIX DATA allocations. */
+static struct pool *container;
+
+/* ROWTYPE_ specified explicitly in data? */
+static int explicit_rowtype;
+
+/* ROWTYPE_, VARNAME_ variables. */
+static struct variable *rowtype_, *varname_;
+
+/* Is is per-factor data? */
+int is_per_factor[PROX + 1];
+
+/* Single SPLIT FILE variable. */
+static struct variable *single_split;
+
+/* Factor variables. */
+static int n_factors;
+static struct variable **factors;
+
+/* Number of cells, or -1 if none. */
+static int cells;
+
+/* Population N specified by user. */
+static int pop_n;
+
+/* CONTENTS subcommand. */
+static int contents[EOC * 3 + 1];
+static int n_contents;
+
+/* Number of continuous variables. */
+static int n_continuous;
+
+/* Index into default_dict.var of first continuous variables. */
+static int first_continuous;
+
+static int compare_variables_by_mxd_vartype (const void *pa,
+ const void *pb);
+static void read_matrices_without_rowtype (void);
+static void read_matrices_with_rowtype (void);
+static int string_to_content_type (char *, int *);
+
+#if DEBUGGING
+static void debug_print (void);
+#endif
+
+int
+cmd_matrix_data (void)
+{
+ unsigned seen = 0;
+
+ lex_match_id ("MATRIX");
+ lex_match_id ("DATA");
+
+ container = pool_create ();
+
+ discard_variables ();
+
+ data_file = inline_file;
+ fmt = LIST;
+ section = LOWER;
+ diag = DIAGONAL;
+ single_split = NULL;
+ n_factors = 0;
+ factors = NULL;
+ cells = -1;
+ pop_n = -1;
+ n_contents = 0;
+ while (token != '.')
+ {
+ lex_match ('/');
+
+ if (lex_match_id ("VARIABLES"))
+ {
+ char **v;
+ int nv;
+
+ if (seen & 1)
+ {
+ msg (SE, _("VARIABLES subcommand multiply specified."));
+ goto lossage;
+ }
+ seen |= 1;
+
+ lex_match ('=');
+ if (!parse_DATA_LIST_vars (&v, &nv, PV_NO_DUPLICATE))
+ goto lossage;
+
+ {
+ int i;
+
+ for (i = 0; i < nv; i++)
+ if (!strcmp (v[i], "VARNAME_"))
+ {
+ msg (SE, _("VARNAME_ cannot be explicitly specified on "
+ "VARIABLES."));
+ for (i = 0; i < nv; i++)
+ free (v[i]);
+ free (v);
+ goto lossage;
+ }
+ }
+
+ {
+ int i;
+
+ for (i = 0; i < nv; i++)
+ {
+ struct variable *new_var;
+
+ if (strcmp (v[i], "ROWTYPE_"))
+ {
+ new_var = force_create_variable (&default_dict, v[i],
+ NUMERIC, 0);
+ new_var->p.mxd.vartype = MXD_CONTINUOUS;
+ new_var->p.mxd.subtype = i;
+ }
+ else
+ explicit_rowtype = 1;
+ free (v[i]);
+ }
+ free (v);
+ }
+
+ {
+ rowtype_ = force_create_variable (&default_dict, "ROWTYPE_",
+ ALPHA, 8);
+ rowtype_->p.mxd.vartype = MXD_ROWTYPE;
+ rowtype_->p.mxd.subtype = 0;
+ }
+ }
+ else if (lex_match_id ("FILE"))
+ {
+ lex_match ('=');
+ data_file = fh_parse_file_handle ();
+ if (!data_file)
+ goto lossage;
+ }
+ else if (lex_match_id ("FORMAT"))
+ {
+ lex_match ('=');
+
+ while (token == T_ID)
+ {
+ if (lex_match_id ("LIST"))
+ fmt = LIST;
+ else if (lex_match_id ("FREE"))
+ fmt = FREE;
+ else if (lex_match_id ("LOWER"))
+ section = LOWER;
+ else if (lex_match_id ("UPPER"))
+ section = UPPER;
+ else if (lex_match_id ("FULL"))
+ section = FULL;
+ else if (lex_match_id ("DIAGONAL"))
+ diag = DIAGONAL;
+ else if (lex_match_id ("NODIAGONAL"))
+ diag = NODIAGONAL;
+ else
+ {
+ lex_error (_("in FORMAT subcommand"));
+ goto lossage;
+ }
+ }
+ }
+ else if (lex_match_id ("SPLIT"))
+ {
+ lex_match ('=');
+
+ if (seen & 2)
+ {
+ msg (SE, _("SPLIT subcommand multiply specified."));
+ goto lossage;
+ }
+ seen |= 2;
+
+ if (token != T_ID)
+ {
+ lex_error (_("in SPLIT subcommand"));
+ goto lossage;
+ }
+
+ if (!is_varname (tokid)
+ && (lex_look_ahead () == '.' || lex_look_ahead () == '/'))
+ {
+ if (!strcmp (tokid, "ROWTYPE_") || !strcmp (tokid, "VARNAME_"))
+ {
+ msg (SE, _("Split variable may not be named ROWTYPE_ "
+ "or VARNAME_."));
+ goto lossage;
+ }
+
+ single_split = force_create_variable (&default_dict, tokid,
+ NUMERIC, 0);
+ lex_get ();
+
+ single_split->p.mxd.vartype = MXD_CONTINUOUS;
+
+ default_dict.n_splits = 1;
+ default_dict.splits = xmalloc (2 * sizeof *default_dict.splits);
+ default_dict.splits[0] = single_split;
+ default_dict.splits[1] = NULL;
+ }
+ else
+ {
+ struct variable **v;
+ int n;
+
+ if (!parse_variables (NULL, &v, &n, PV_NO_DUPLICATE))
+ goto lossage;
+
+ default_dict.n_splits = n;
+ default_dict.splits = v = xrealloc (v, sizeof *v * (n + 1));
+ v[n] = NULL;
+ }
+
+ {
+ int i;
+
+ for (i = 0; i < default_dict.n_splits; i++)
+ {
+ if (default_dict.splits[i]->p.mxd.vartype != MXD_CONTINUOUS)
+ {
+ msg (SE, _("Split variable %s is already another type."),
+ tokid);
+ goto lossage;
+ }
+ default_dict.splits[i]->p.mxd.vartype = MXD_SPLIT;
+ default_dict.splits[i]->p.mxd.subtype = i;
+ }
+ }
+ }
+ else if (lex_match_id ("FACTORS"))
+ {
+ lex_match ('=');
+
+ if (seen & 4)
+ {
+ msg (SE, _("FACTORS subcommand multiply specified."));
+ goto lossage;
+ }
+ seen |= 4;
+
+ if (!parse_variables (NULL, &factors, &n_factors, PV_NONE))
+ goto lossage;
+
+ {
+ int i;
+
+ for (i = 0; i < n_factors; i++)
+ {
+ if (factors[i]->p.mxd.vartype != MXD_CONTINUOUS)
+ {
+ msg (SE, _("Factor variable %s is already another type."),
+ tokid);
+ goto lossage;
+ }
+ factors[i]->p.mxd.vartype = MXD_FACTOR;
+ factors[i]->p.mxd.subtype = i;
+ }
+ }
+ }
+ else if (lex_match_id ("CELLS"))
+ {
+ lex_match ('=');
+
+ if (cells != -1)
+ {
+ msg (SE, _("CELLS subcommand multiply specified."));
+ goto lossage;
+ }
+
+ if (!lex_integer_p () || lex_integer () < 1)
+ {
+ lex_error (_("expecting positive integer"));
+ goto lossage;
+ }
+
+ cells = lex_integer ();
+ lex_get ();
+ }
+ else if (lex_match_id ("N"))
+ {
+ lex_match ('=');
+
+ if (pop_n != -1)
+ {
+ msg (SE, _("N subcommand multiply specified."));
+ goto lossage;
+ }
+
+ if (!lex_integer_p () || lex_integer () < 1)
+ {
+ lex_error (_("expecting positive integer"));
+ goto lossage;
+ }
+
+ pop_n = lex_integer ();
+ lex_get ();
+ }
+ else if (lex_match_id ("CONTENTS"))
+ {
+ int inside_parens = 0;
+ unsigned collide = 0;
+ int item;
+
+ if (seen & 8)
+ {
+ msg (SE, _("CONTENTS subcommand multiply specified."));
+ goto lossage;
+ }
+ seen |= 8;
+
+ lex_match ('=');
+
+ {
+ int i;
+
+ for (i = 0; i <= PROX; i++)
+ is_per_factor[i] = 0;
+ }
+
+ for (;;)
+ {
+ if (lex_match ('('))
+ {
+ if (inside_parens)
+ {
+ msg (SE, _("Nested parentheses not allowed."));
+ goto lossage;
+ }
+ inside_parens = 1;
+ item = LPAREN;
+ }
+ else if (lex_match (')'))
+ {
+ if (!inside_parens)
+ {
+ msg (SE, _("Mismatched right parenthesis (`(')."));
+ goto lossage;
+ }
+ if (contents[n_contents - 1] == LPAREN)
+ {
+ msg (SE, _("Empty parentheses not allowed."));
+ goto lossage;
+ }
+ inside_parens = 0;
+ item = RPAREN;
+ }
+ else
+ {
+ int content_type;
+ int collide_index;
+
+ if (token != T_ID)
+ {
+ lex_error (_("in CONTENTS subcommand"));
+ goto lossage;
+ }
+
+ content_type = string_to_content_type (tokid,
+ &collide_index);
+ if (content_type == -1)
+ {
+ lex_error (_("in CONTENTS subcommand"));
+ goto lossage;
+ }
+ lex_get ();
+
+ if (collide & (1 << collide_index))
+ {
+ msg (SE, _("Content multiply specified for %s."),
+ content_names[content_type]);
+ goto lossage;
+ }
+ collide |= (1 << collide_index);
+
+ item = content_type;
+ is_per_factor[item] = inside_parens;
+ }
+ contents[n_contents++] = item;
+
+ if (token == '/' || token == '.')
+ break;
+ }
+
+ if (inside_parens)
+ {
+ msg (SE, _("Missing right parenthesis."));
+ goto lossage;
+ }
+ contents[n_contents] = EOC;
+ }
+ else
+ {
+ lex_error (NULL);
+ goto lossage;
+ }
+ }
+
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ goto lossage;
+ }
+
+ if (!(seen & 1))
+ {
+ msg (SE, _("Missing VARIABLES subcommand."));
+ goto lossage;
+ }
+
+ if (!n_contents && !explicit_rowtype)
+ {
+ msg (SW, _("CONTENTS subcommand not specified: assuming file "
+ "contains only CORR matrix."));
+
+ contents[0] = CORR;
+ contents[1] = EOC;
+ n_contents = 0;
+ }
+
+ if (n_factors && !explicit_rowtype && cells == -1)
+ {
+ msg (SE, _("Missing CELLS subcommand. CELLS is required "
+ "when ROWTYPE_ is not given in the data and "
+ "factors are present."));
+ goto lossage;
+ }
+
+ if (explicit_rowtype && single_split)
+ {
+ msg (SE, _("Split file values must be present in the data when "
+ "ROWTYPE_ is present."));
+ goto lossage;
+ }
+
+ /* Create VARNAME_. */
+ {
+ varname_ = force_create_variable (&default_dict, "VARNAME_",
+ ALPHA, 8);
+ varname_->p.mxd.vartype = MXD_VARNAME;
+ varname_->p.mxd.subtype = 0;
+ }
+
+ /* Sort the dictionary variables into the desired order for the
+ system file output. */
+ {
+ int i;
+
+ qsort (default_dict.var, default_dict.nvar, sizeof *default_dict.var,
+ compare_variables_by_mxd_vartype);
+
+ for (i = 0; i < default_dict.nvar; i++)
+ default_dict.var[i]->index = i;
+ }
+
+ /* Set formats. */
+ {
+ static const struct fmt_spec fmt_tab[MXD_COUNT] =
+ {
+ {FMT_F, 4, 0},
+ {FMT_A, 8, 0},
+ {FMT_F, 4, 0},
+ {FMT_A, 8, 0},
+ {FMT_F, 10, 4},
+ };
+
+ int i;
+
+ first_continuous = -1;
+ for (i = 0; i < default_dict.nvar; i++)
+ {
+ struct variable *v = default_dict.var[i];
+ int type = v->p.mxd.vartype;
+
+ assert (type >= 0 && type < MXD_COUNT);
+ v->print = v->write = fmt_tab[type];
+
+ if (type == MXD_CONTINUOUS)
+ n_continuous++;
+ if (first_continuous == -1 && type == MXD_CONTINUOUS)
+ first_continuous = i;
+ }
+ }
+
+ if (n_continuous == 0)
+ {
+ msg (SE, _("No continuous variables specified."));
+ goto lossage;
+ }
+
+#if DEBUGGING
+ debug_print ();
+#endif
+
+ if (explicit_rowtype)
+ read_matrices_with_rowtype ();
+ else
+ read_matrices_without_rowtype ();
+
+ pool_destroy (container);
+
+ return CMD_SUCCESS;
+
+lossage:
+ discard_variables ();
+ free (factors);
+ pool_destroy (container);
+ return CMD_FAILURE;
+}
+
+/* Look up string S as a content-type name and return the
+ corresponding enumerated value, or -1 if there is no match. If
+ COLLIDE is non-NULL then *COLLIDE returns a value (suitable for use
+ as a bit-index) which can be used for determining whether a related
+ statistic has already been used. */
+static int
+string_to_content_type (char *s, int *collide)
+{
+ static const struct
+ {
+ int value;
+ int collide;
+ const char *string;
+ }
+ *tp,
+ tab[] =
+ {
+ {N_VECTOR, 0, "N_VECTOR"},
+ {N_VECTOR, 0, "N"},
+ {N_SCALAR, 0, "N_SCALAR"},
+ {N_MATRIX, 1, "N_MATRIX"},
+ {MEAN, 2, "MEAN"},
+ {STDDEV, 3, "STDDEV"},
+ {STDDEV, 3, "SD"},
+ {COUNT, 4, "COUNT"},
+ {MSE, 5, "MSE"},
+ {DFE, 6, "DFE"},
+ {MAT, 7, "MAT"},
+ {COV, 8, "COV"},
+ {CORR, 9, "CORR"},
+ {PROX, 10, "PROX"},
+ {-1, -1, NULL},
+ };
+
+ for (tp = tab; tp->value != -1; tp++)
+ if (!strcmp (s, tp->string))
+ {
+ if (collide)
+ *collide = tp->collide;
+
+ return tp->value;
+ }
+ return -1;
+}
+
+/* Compare two variables using p.mxd.vartype and p.mxd.subtype
+ fields. */
+static int
+compare_variables_by_mxd_vartype (const void *pa, const void *pb)
+{
+ struct matrix_data_proc *a = &(*((struct variable **) pa))->p.mxd;
+ struct matrix_data_proc *b = &(*((struct variable **) pb))->p.mxd;
+
+ return (a->vartype != b->vartype
+ ? a->vartype - b->vartype
+ : a->subtype - b->subtype);
+}
+
+#if DEBUGGING
+/* Print out the command as input. */
+static void
+debug_print (void)
+{
+ printf ("MATRIX DATA\n\t/VARIABLES=");
+
+ {
+ int i;
+
+ for (i = 0; i < default_dict.nvar; i++)
+ printf ("%s ", default_dict.var[i]->name);
+ }
+ printf ("\n");
+
+ printf ("\t/FORMAT=");
+ if (fmt == LIST)
+ printf ("LIST");
+ else if (fmt == FREE)
+ printf ("FREE");
+ else
+ assert (0);
+ if (section == LOWER)
+ printf (" LOWER");
+ else if (section == UPPER)
+ printf (" UPPER");
+ else if (section == FULL)
+ printf (" FULL");
+ else
+ assert (0);
+ if (diag == DIAGONAL)
+ printf (" DIAGONAL\n");
+ else if (diag == NODIAGONAL)
+ printf (" NODIAGONAL\n");
+ else
+ assert (0);
+
+ if (default_dict.n_splits)
+ {
+ int i;
+
+ printf ("\t/SPLIT=");
+ for (i = 0; i < default_dict.n_splits; i++)
+ printf ("%s ", default_dict.splits[i]->name);
+ if (single_split)
+ printf ("\t/* single split");
+ printf ("\n");
+ }
+
+ if (n_factors)
+ {
+ int i;
+
+ printf ("\t/FACTORS=");
+ for (i = 0; i < n_factors; i++)
+ printf ("%s ", factors[i]->name);
+ printf ("\n");
+ }
+
+ if (cells != -1)
+ printf ("\t/CELLS=%d\n", cells);
+
+ if (pop_n != -1)
+ printf ("\t/N=%d\n", pop_n);
+
+ if (n_contents)
+ {
+ int i;
+ int space = 0;
+
+ printf ("\t/CONTENTS=");
+ for (i = 0; i < n_contents; i++)
+ {
+ if (contents[i] == LPAREN)
+ {
+ if (space)
+ printf (" ");
+ printf ("(");
+ space = 0;
+ }
+ else if (contents[i] == RPAREN)
+ {
+ printf (")");
+ space = 1;
+ }
+ else
+ {
+
+ assert (contents[i] >= 0 && contents[i] <= PROX);
+ if (space)
+ printf (" ");
+ printf ("%s", content_names[contents[i]]);
+ space = 1;
+ }
+ }
+ printf ("\n");
+ }
+}
+#endif /* DEBUGGING */
+\f
+/* Matrix tokenizer. */
+
+/* Matrix token types. */
+enum
+ {
+ MNULL, /* No token. */
+ MNUM, /* Number. */
+ MSTR, /* String. */
+ MSTOP /* End of file. */
+ };
+
+/* Current matrix token. */
+static int mtoken;
+
+/* Token string if applicable; not null-terminated. */
+static char *mtokstr;
+
+/* Length of mtokstr in characters. */
+static int mtoklen;
+
+/* Token value if applicable. */
+static double mtokval;
+
+static int mget_token (void);
+
+#if DEBUGGING
+#define mget_token() mget_token_dump()
+
+static int
+mget_token_dump (void)
+{
+ int result = (mget_token) ();
+ mdump_token ();
+ return result;
+}
+
+static void
+mdump_token (void)
+{
+ switch (mtoken)
+ {
+ case MNULL:
+ printf (" <NULLTOK>");
+ break;
+ case MNUM:
+ printf (" #%g", mtokval);
+ break;
+ case MSTR:
+ printf (" #'%.*s'", mtoklen, mtokstr);
+ break;
+ case MSTOP:
+ printf (" <STOP>");
+ break;
+ default:
+ assert (0);
+ }
+ fflush (stdout);
+}
+#endif
+
+/* Return the current position in the data file. */
+static const char *
+context (void)
+{
+ static char buf[32];
+ int len;
+ char *p = dfm_get_record (data_file, &len);
+
+ if (!p || !len)
+ strcpy (buf, "at end of line");
+ else
+ {
+ char *cp = buf;
+ int n_copy = min (10, len);
+ cp = stpcpy (buf, "before `");
+ while (n_copy && isspace ((unsigned char) *p))
+ p++, n_copy++;
+ while (n_copy && !isspace ((unsigned char) *p))
+ *cp++ = *p++, n_copy--;
+ *cp++ = '\'';
+ *cp = 0;
+ }
+
+ return buf;
+}
+
+/* Is there at least one token left in the data file? */
+static int
+another_token (void)
+{
+ char *cp, *ep;
+ int len;
+
+ if (mtoken == MSTOP)
+ return 0;
+
+ for (;;)
+ {
+ cp = dfm_get_record (data_file, &len);
+ if (!cp)
+ return 0;
+
+ ep = cp + len;
+ while (isspace ((unsigned char) *cp) && cp < ep)
+ cp++;
+
+ if (cp < ep)
+ break;
+
+ dfm_fwd_record (data_file);
+ }
+
+ dfm_set_record (data_file, cp);
+
+ return 1;
+}
+
+/* Parse a MATRIX DATA token from data_file into mtok*. */
+static int
+(mget_token) (void)
+{
+ char *cp, *ep;
+ int len;
+ int first_column;
+
+ for (;;)
+ {
+ cp = dfm_get_record (data_file, &len);
+ if (!cp)
+ {
+ if (mtoken == MSTOP)
+ return 0;
+ mtoken = MSTOP;
+ return 1;
+ }
+
+ ep = cp + len;
+ while (isspace ((unsigned char) *cp) && cp < ep)
+ cp++;
+
+ if (cp < ep)
+ break;
+
+ dfm_fwd_record (data_file);
+ }
+
+ dfm_set_record (data_file, cp);
+ first_column = dfm_get_cur_col (data_file) + 1;
+
+ /* Three types of fields: quoted with ', quoted with ", unquoted. */
+ if (*cp == '\'' || *cp == '"')
+ {
+ int quote = *cp;
+
+ mtoken = MSTR;
+ mtokstr = ++cp;
+ while (cp < ep && *cp != quote)
+ cp++;
+ mtoklen = cp - mtokstr;
+ if (cp < ep)
+ cp++;
+ else
+ msg (SW, _("Scope of string exceeds line."));
+ }
+ else
+ {
+ int is_num = isdigit ((unsigned char) *cp) || *cp == '.';
+
+ mtokstr = cp++;
+ while (cp < ep && !isspace ((unsigned char) *cp) && *cp != ','
+ && *cp != '-' && *cp != '+')
+ {
+ if (isdigit ((unsigned char) *cp))
+ is_num = 1;
+
+ if ((tolower ((unsigned char) *cp) == 'd'
+ || tolower ((unsigned char) *cp) == 'e')
+ && (cp[1] == '+' || cp[1] == '-'))
+ cp += 2;
+ else
+ cp++;
+ }
+
+ mtoklen = cp - mtokstr;
+ assert (mtoklen);
+
+ if (is_num)
+ {
+ struct data_in di;
+
+ di.s = mtokstr;
+ di.e = mtokstr + mtoklen;
+ di.v = (union value *) &mtokval;
+ di.f1 = first_column;
+ di.format.type = FMT_F;
+ di.format.w = mtoklen;
+ di.format.d = 0;
+
+ if (!data_in (&di))
+ return 0;
+ }
+ else
+ mtoken = MSTR;
+ }
+
+ dfm_set_record (data_file, cp);
+
+ return 1;
+}
+
+/* Forcibly skip the end of a line for content type CONTENT in
+ data_file. */
+static int
+force_eol (const char *content)
+{
+ char *cp;
+ int len;
+
+ if (fmt == FREE)
+ return 1;
+
+ cp = dfm_get_record (data_file, &len);
+ if (!cp)
+ return 0;
+ while (len && isspace (*cp))
+ cp++, len--;
+
+ if (len)
+ {
+ msg (SE, _("End of line expected %s while reading %s."),
+ context (), content);
+ return 0;
+ }
+
+ dfm_fwd_record (data_file);
+
+ return 1;
+}
+\f
+/* Back end, omitting ROWTYPE_. */
+
+/* MATRIX DATA data. */
+static double ***nr_data;
+
+/* Factor values. */
+static double *nr_factor_values;
+
+/* Largest-numbered cell that we have read in thus far, plus one. */
+static int max_cell_index;
+
+/* SPLIT FILE variable values. */
+static double *split_values;
+
+static int nr_read_splits (int compare);
+static int nr_read_factors (int cell);
+static void nr_output_data (void);
+static int matrix_data_read_without_rowtype (void);
+
+/* Read from the data file and write it to the active file. */
+static void
+read_matrices_without_rowtype (void)
+{
+ if (cells == -1)
+ cells = 1;
+
+ mtoken = MNULL;
+ split_values = xmalloc (sizeof *split_values * default_dict.n_splits);
+ nr_factor_values = xmalloc (sizeof *nr_factor_values * n_factors * cells);
+ max_cell_index = 0;
+
+ matrix_data_source.read = (void (*)(void)) matrix_data_read_without_rowtype;
+ vfm_source = &matrix_data_source;
+
+ procedure (NULL, NULL, NULL);
+
+ free (split_values);
+ free (nr_factor_values);
+
+ fh_close_handle (data_file);
+}
+
+/* Mirror data across the diagonal of matrix CP which contains
+ CONTENT type data. */
+static void
+fill_matrix (int content, double *cp)
+{
+ int type = content_type[content];
+
+ if (type == 1 && section != FULL)
+ {
+ if (diag == NODIAGONAL)
+ {
+ const double fill = content == CORR ? 1.0 : SYSMIS;
+ int i;
+
+ for (i = 0; i < n_continuous; i++)
+ cp[i * (1 + n_continuous)] = fill;
+ }
+
+ {
+ int c, r;
+
+ if (section == LOWER)
+ {
+ int n_lines = n_continuous;
+ if (section != FULL && diag == NODIAGONAL)
+ n_lines--;
+
+ for (r = 1; r < n_lines; r++)
+ for (c = 0; c < r; c++)
+ cp[r + c * n_continuous] = cp[c + r * n_continuous];
+ }
+ else
+ {
+ assert (section == UPPER);
+ for (r = 1; r < n_continuous; r++)
+ for (c = 0; c < r; c++)
+ cp[c + r * n_continuous] = cp[r + c * n_continuous];
+ }
+ }
+ }
+ else if (type == 2)
+ {
+ int c;
+
+ for (c = 1; c < n_continuous; c++)
+ cp[c] = cp[0];
+ }
+}
+
+/* Read data lines for content type CONTENT from the data file. If
+ PER_FACTOR is nonzero, then factor information is read from the
+ data file. Data is for cell number CELL. */
+static int
+nr_read_data_lines (int per_factor, int cell, int content, int compare)
+{
+ /* Content type. */
+ const int type = content_type[content];
+
+ /* Number of lines that must be parsed from the data file for this
+ content type. */
+ int n_lines;
+
+ /* Current position in vector or matrix. */
+ double *cp;
+
+ /* Counter. */
+ int i;
+
+ if (type != 1)
+ n_lines = 1;
+ else
+ {
+ n_lines = n_continuous;
+ if (section != FULL && diag == NODIAGONAL)
+ n_lines--;
+ }
+
+ cp = nr_data[content][cell];
+ if (type == 1 && section == LOWER && diag == NODIAGONAL)
+ cp += n_continuous;
+
+ for (i = 0; i < n_lines; i++)
+ {
+ int n_cols;
+
+ if (!nr_read_splits (1))
+ return 0;
+ if (per_factor && !nr_read_factors (cell))
+ return 0;
+ compare = 1;
+
+ switch (type)
+ {
+ case 0:
+ n_cols = n_continuous;
+ break;
+ case 1:
+ switch (section)
+ {
+ case LOWER:
+ n_cols = i + 1;
+ break;
+ case UPPER:
+ cp += i;
+ n_cols = n_continuous - i;
+ if (diag == NODIAGONAL)
+ {
+ n_cols--;
+ cp++;
+ }
+ break;
+ case FULL:
+ n_cols = n_continuous;
+ break;
+ default:
+ assert (0);
+ }
+ break;
+ case 2:
+ n_cols = 1;
+ break;
+ default:
+ assert (0);
+ }
+
+ {
+ int j;
+
+ for (j = 0; j < n_cols; j++)
+ {
+ if (!mget_token ())
+ return 0;
+ if (mtoken != MNUM)
+ {
+ msg (SE, _("expecting value for %s %s"),
+ default_dict.var[j]->name, context ());
+ return 0;
+ }
+
+ *cp++ = mtokval;
+ }
+ if (!force_eol (content_names[content]))
+ return 0;
+ debug_printf (("\n"));
+ }
+
+ if (section == LOWER)
+ cp += n_continuous - n_cols;
+ }
+
+ fill_matrix (content, nr_data[content][cell]);
+
+ return 1;
+}
+
+/* When ROWTYPE_ does not appear in the data, reads the matrices and
+ writes them to the output file. Returns success. */
+static int
+matrix_data_read_without_rowtype (void)
+{
+ {
+ int *cp;
+
+ nr_data = pool_alloc (container, (PROX + 1) * sizeof *nr_data);
+
+ {
+ int i;
+
+ for (i = 0; i <= PROX; i++)
+ nr_data[i] = NULL;
+ }
+
+ for (cp = contents; *cp != EOC; cp++)
+ if (*cp != LPAREN && *cp != RPAREN)
+ {
+ int per_factor = is_per_factor[*cp];
+ int n_entries;
+
+ n_entries = n_continuous;
+ if (content_type[*cp] == 1)
+ n_entries *= n_continuous;
+
+ {
+ int n_vectors = per_factor ? cells : 1;
+ int i;
+
+ nr_data[*cp] = pool_alloc (container,
+ n_vectors * sizeof **nr_data);
+
+ for (i = 0; i < n_vectors; i++)
+ nr_data[*cp][i] = pool_alloc (container,
+ n_entries * sizeof ***nr_data);
+ }
+ }
+ }
+
+ for (;;)
+ {
+ int *bp, *ep, *np;
+
+ if (!nr_read_splits (0))
+ return 0;
+
+ for (bp = contents; *bp != EOC; bp = np)
+ {
+ int per_factor;
+
+ /* Trap the CONTENTS that we should parse in this pass
+ between bp and ep. Set np to the starting bp for next
+ iteration. */
+ if (*bp == LPAREN)
+ {
+ ep = ++bp;
+ while (*ep != RPAREN)
+ ep++;
+ np = &ep[1];
+ per_factor = 1;
+ }
+ else
+ {
+ ep = &bp[1];
+ while (*ep != EOC && *ep != LPAREN)
+ ep++;
+ np = ep;
+ per_factor = 0;
+ }
+
+ {
+ int i;
+
+ for (i = 0; i < (per_factor ? cells : 1); i++)
+ {
+ int *cp;
+
+ for (cp = bp; cp < ep; cp++)
+ if (!nr_read_data_lines (per_factor, i, *cp, cp != bp))
+ return 0;
+ }
+ }
+ }
+
+ nr_output_data ();
+
+ if (default_dict.n_splits == 0 || !another_token ())
+ return 1;
+ }
+}
+
+/* Read the split file variables. If COMPARE is 1, compares the
+ values read to the last values read and returns 1 if they're equal,
+ 0 otherwise. */
+static int
+nr_read_splits (int compare)
+{
+ static int just_read = 0;
+
+ if (compare && just_read)
+ {
+ just_read = 0;
+ return 1;
+ }
+
+ if (default_dict.n_splits == 0)
+ return 1;
+
+ if (single_split)
+ {
+ if (!compare)
+ split_values[0] = ++default_dict.splits[0]->p.mxd.subtype;
+ return 1;
+ }
+
+ if (!compare)
+ just_read = 1;
+
+ {
+ int i;
+
+ for (i = 0; i < default_dict.n_splits; i++)
+ {
+ if (!mget_token ())
+ return 0;
+ if (mtoken != MNUM)
+ {
+ msg (SE, _("Syntax error expecting SPLIT FILE value %s."),
+ context ());
+ return 0;
+ }
+
+ if (!compare)
+ split_values[i] = mtokval;
+ else if (split_values[i] != mtokval)
+ {
+ msg (SE, _("Expecting value %g for %s."),
+ split_values[i], default_dict.splits[i]->name);
+ return 0;
+ }
+ }
+ }
+
+ return 1;
+}
+
+/* Read the factors for cell CELL. If COMPARE is 1, compares the
+ values read to the last values read and returns 1 if they're equal,
+ 0 otherwise. */
+static int
+nr_read_factors (int cell)
+{
+ int compare;
+
+ if (n_factors == 0)
+ return 1;
+
+ assert (max_cell_index >= cell);
+ if (cell != max_cell_index)
+ compare = 1;
+ else
+ {
+ compare = 0;
+ max_cell_index++;
+ }
+
+ {
+ int i;
+
+ for (i = 0; i < n_factors; i++)
+ {
+ if (!mget_token ())
+ return 0;
+ if (mtoken != MNUM)
+ {
+ msg (SE, _("Syntax error expecting factor value %s."),
+ context ());
+ return 0;
+ }
+
+ if (!compare)
+ nr_factor_values[i + n_factors * cell] = mtokval;
+ else if (nr_factor_values[i + n_factors * cell] != mtokval)
+ {
+ msg (SE, _("Syntax error expecting value %g for %s %s."),
+ nr_factor_values[i + n_factors * cell],
+ factors[i]->name, context ());
+ return 0;
+ }
+ }
+ }
+
+ return 1;
+}
+
+/* Write the contents of a cell having content type CONTENT and data
+ CP to the active file. */
+static void
+dump_cell_content (int content, double *cp)
+{
+ int type = content_type[content];
+
+ {
+ st_bare_pad_copy (temp_case->data[rowtype_->fv].s,
+ content_names[content], 8);
+
+ if (type != 1)
+ memset (&temp_case->data[varname_->fv].s, ' ', 8);
+ }
+
+ {
+ int n_lines = (type == 1) ? n_continuous : 1;
+ int i;
+
+ for (i = 0; i < n_lines; i++)
+ {
+ int j;
+
+ for (j = 0; j < n_continuous; j++)
+ {
+ temp_case->data[(default_dict.var
+ [first_continuous + j]->fv)].f = *cp;
+ debug_printf (("c:%s(%g) ",
+ default_dict.var[first_continuous + j]->name,
+ *cp));
+ cp++;
+ }
+ if (type == 1)
+ st_bare_pad_copy (temp_case->data[varname_->fv].s,
+ default_dict.var[first_continuous + i]->name,
+ 8);
+ debug_printf (("\n"));
+ write_case ();
+ }
+ }
+}
+
+/* Finally dump out everything from nr_data[] to the output file. */
+static void
+nr_output_data (void)
+{
+ {
+ int i;
+
+ for (i = 0; i < default_dict.n_splits; i++)
+ temp_case->data[default_dict.splits[i]->fv].f = split_values[i];
+ }
+
+ if (n_factors)
+ {
+ int cell;
+
+ for (cell = 0; cell < cells; cell++)
+ {
+ {
+ int factor;
+
+ for (factor = 0; factor < n_factors; factor++)
+ {
+ temp_case->data[factors[factor]->fv].f
+ = nr_factor_values[factor + cell * n_factors];
+ debug_printf (("f:%s ", factors[factor]->name));
+ }
+ }
+
+ {
+ int content;
+
+ for (content = 0; content <= PROX; content++)
+ if (is_per_factor[content])
+ {
+ assert (nr_data[content] != NULL
+ && nr_data[content][cell] != NULL);
+
+ dump_cell_content (content, nr_data[content][cell]);
+ }
+ }
+ }
+ }
+
+ {
+ int content;
+
+ {
+ int factor;
+
+ for (factor = 0; factor < n_factors; factor++)
+ temp_case->data[factors[factor]->fv].f = SYSMIS;
+ }
+
+ for (content = 0; content <= PROX; content++)
+ if (!is_per_factor[content] && nr_data[content] != NULL)
+ dump_cell_content (content, nr_data[content][0]);
+ }
+}
+\f
+/* Back end, with ROWTYPE_. */
+
+/* Type of current row. */
+static int wr_content;
+
+/* All the data for one set of factor values. */
+struct factor_data
+ {
+ double *factors;
+ int n_rows[PROX + 1];
+ double *data[PROX + 1];
+ struct factor_data *next;
+ };
+
+/* All the data, period. */
+struct factor_data *wr_data;
+
+/* Current factor. */
+struct factor_data *wr_current;
+
+static int wr_read_splits (void);
+static int wr_output_data (void);
+static int wr_read_rowtype (void);
+static int wr_read_factors (void);
+static int wr_read_indeps (void);
+static int matrix_data_read_with_rowtype (void);
+
+/* When ROWTYPE_ appears in the data, reads the matrices and writes
+ them to the output file. */
+static void
+read_matrices_with_rowtype (void)
+{
+ mtoken = MNULL;
+ wr_data = wr_current = NULL;
+ split_values = NULL;
+ cells = 0;
+
+ matrix_data_source.read = (void (*)(void)) matrix_data_read_with_rowtype;
+ vfm_source = &matrix_data_source;
+
+ procedure (NULL, NULL, NULL);
+
+ free (split_values);
+ fh_close_handle (data_file);
+}
+
+/* Read from the data file and write it to the active file. */
+static int
+matrix_data_read_with_rowtype (void)
+{
+ do
+ {
+ if (!wr_read_splits ())
+ return 0;
+
+ if (!wr_read_factors ())
+ return 0;
+
+ if (!wr_read_indeps ())
+ return 0;
+ }
+ while (another_token ());
+
+ wr_output_data ();
+ return 1;
+}
+
+/* Read the split file variables. If they differ from the previous
+ set of split variables then output the data. Returns success. */
+static int
+wr_read_splits (void)
+{
+ int compare;
+
+ if (default_dict.n_splits == 0)
+ return 1;
+
+ if (split_values)
+ compare = 1;
+ else
+ {
+ compare = 0;
+ split_values = xmalloc (sizeof *split_values * default_dict.n_splits);
+ }
+
+ {
+ int different = 0;
+ int i;
+
+ for (i = 0; i < default_dict.n_splits; i++)
+ {
+ if (!mget_token ())
+ return 0;
+ if (mtoken != MNUM)
+ {
+ msg (SE, _("Syntax error %s expecting SPLIT FILE value."),
+ context ());
+ return 0;
+ }
+
+ if (compare && split_values[i] != mtokval && !different)
+ {
+ if (!wr_output_data ())
+ return 0;
+ different = 1;
+ cells = 0;
+ }
+ split_values[i] = mtokval;
+ }
+ }
+
+ return 1;
+}
+
+/* Return strcmp()-type comparison of the n_factors factors at _A and
+ _B. Sort missing values toward the end. */
+static int
+compare_factors (const void *pa, const void *pb)
+{
+ const double *a = (*(struct factor_data **) pa)->factors;
+ const double *b = (*(struct factor_data **) pb)->factors;
+ int i;
+
+ for (i = 0; i < n_factors; i++, a++, b++)
+ {
+ if (*a == *b)
+ continue;
+
+ if (*a == SYSMIS)
+ return 1;
+ else if (*b == SYSMIS)
+ return -1;
+ else
+ return *a - *b < 0 ? -1 : 1;
+ }
+
+ return 0;
+}
+
+/* Write out the data for the current split file to the active
+ file. */
+static int
+wr_output_data (void)
+{
+ {
+ int i;
+
+ for (i = 0; i < default_dict.n_splits; i++)
+ temp_case->data[default_dict.splits[i]->fv].f = split_values[i];
+ }
+
+ /* Sort the wr_data list. */
+ {
+ struct factor_data **factors;
+ struct factor_data *iter;
+ int i;
+
+ factors = xmalloc (sizeof *factors * cells);
+
+ for (i = 0, iter = wr_data; iter; iter = iter->next, i++)
+ factors[i] = iter;
+
+ qsort (factors, cells, sizeof *factors, compare_factors);
+
+ wr_data = factors[0];
+ for (i = 0; i < cells - 1; i++)
+ factors[i]->next = factors[i + 1];
+ factors[cells - 1]->next = NULL;
+
+ free (factors);
+ }
+
+ /* Write out records for every set of factor values. */
+ {
+ struct factor_data *iter;
+
+ for (iter = wr_data; iter; iter = iter->next)
+ {
+ {
+ int factor;
+
+ for (factor = 0; factor < n_factors; factor++)
+ {
+ temp_case->data[factors[factor]->fv].f
+ = iter->factors[factor];
+ debug_printf (("f:%s ", factors[factor]->name));
+ }
+ }
+
+ {
+ int content;
+
+ for (content = 0; content <= PROX; content++)
+ {
+ if (!iter->n_rows[content])
+ continue;
+
+ {
+ int type = content_type[content];
+ int n_lines = (type == 1
+ ? (n_continuous
+ - (section != FULL && diag == NODIAGONAL))
+ : 1);
+
+ if (n_lines != iter->n_rows[content])
+ {
+ msg (SE, _("Expected %d lines of data for %s content; "
+ "actually saw %d lines. No data will be "
+ "output for this content."),
+ n_lines, content_names[content],
+ iter->n_rows[content]);
+ continue;
+ }
+ }
+
+ fill_matrix (content, iter->data[content]);
+
+ dump_cell_content (content, iter->data[content]);
+ }
+ }
+ }
+ }
+
+ pool_destroy (container);
+ container = pool_create ();
+
+ wr_data = wr_current = NULL;
+
+ return 1;
+}
+
+/* Read ROWTYPE_ from the data file. Return success. */
+static int
+wr_read_rowtype (void)
+{
+ if (wr_content != -1)
+ {
+ msg (SE, _("Multiply specified ROWTYPE_ %s."), context ());
+ return 0;
+ }
+ if (mtoken != MSTR)
+ {
+ msg (SE, _("Syntax error %s expecting ROWTYPE_ string."), context ());
+ return 0;
+ }
+
+ {
+ char s[16];
+ char *cp;
+
+ memcpy (s, mtokstr, min (15, mtoklen));
+ s[min (15, mtoklen)] = 0;
+
+ for (cp = s; *cp; cp++)
+ *cp = toupper ((unsigned char) *cp);
+
+ wr_content = string_to_content_type (s, NULL);
+ }
+
+ if (wr_content == -1)
+ {
+ msg (SE, _("Syntax error %s."), context ());
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Read the factors for the current row. Select a set of factors and
+ point wr_current to it. */
+static int
+wr_read_factors (void)
+{
+ double *factor_values = local_alloc (sizeof *factor_values * n_factors);
+
+ wr_content = -1;
+ {
+ int i;
+
+ for (i = 0; i < n_factors; i++)
+ {
+ if (!mget_token ())
+ goto lossage;
+ if (mtoken == MSTR)
+ {
+ if (!wr_read_rowtype ())
+ goto lossage;
+ if (!mget_token ())
+ goto lossage;
+ }
+ if (mtoken != MNUM)
+ {
+ msg (SE, _("Syntax error expecting factor value %s."),
+ context ());
+ goto lossage;
+ }
+
+ factor_values[i] = mtokval;
+ }
+ }
+ if (wr_content == -1)
+ {
+ if (!mget_token ())
+ goto lossage;
+ if (!wr_read_rowtype ())
+ goto lossage;
+ }
+
+ /* Try the most recent factor first as a simple caching
+ mechanism. */
+ if (wr_current)
+ {
+ int i;
+
+ for (i = 0; i < n_factors; i++)
+ if (factor_values[i] != wr_current->factors[i])
+ goto cache_miss;
+ goto winnage;
+ }
+
+ /* Linear search through the list. */
+cache_miss:
+ {
+ struct factor_data *iter;
+
+ for (iter = wr_data; iter; iter = iter->next)
+ {
+ int i;
+
+ for (i = 0; i < n_factors; i++)
+ if (factor_values[i] != iter->factors[i])
+ goto next_item;
+
+ wr_current = iter;
+ goto winnage;
+
+ next_item: ;
+ }
+ }
+
+ /* Not found. Make a new item. */
+ {
+ struct factor_data *new = pool_alloc (container, sizeof *new);
+
+ new->factors = pool_alloc (container, sizeof *new->factors * n_factors);
+
+ {
+ int i;
+
+ for (i = 0; i < n_factors; i++)
+ new->factors[i] = factor_values[i];
+ }
+
+ {
+ int i;
+
+ for (i = 0; i <= PROX; i++)
+ {
+ new->n_rows[i] = 0;
+ new->data[i] = NULL;
+ }
+ }
+
+ new->next = wr_data;
+ wr_data = wr_current = new;
+ cells++;
+ }
+
+winnage:
+ local_free (factor_values);
+ return 1;
+
+lossage:
+ local_free (factor_values);
+ return 0;
+}
+
+/* Read the independent variables into wr_current. */
+static int
+wr_read_indeps (void)
+{
+ struct factor_data *c = wr_current;
+ const int type = content_type[wr_content];
+ const int n_rows = c->n_rows[wr_content];
+ double *cp;
+ int n_cols;
+
+ /* Allocate room for data if necessary. */
+ if (c->data[wr_content] == NULL)
+ {
+ int n_items = n_continuous;
+ if (type == 1)
+ n_items *= n_continuous;
+
+ c->data[wr_content] = pool_alloc (container,
+ sizeof **c->data * n_items);
+ }
+
+ cp = &c->data[wr_content][n_rows * n_continuous];
+
+ /* Figure out how much to read from this line. */
+ switch (type)
+ {
+ case 0:
+ case 2:
+ if (n_rows > 0)
+ {
+ msg (SE, _("Duplicate specification for %s."),
+ content_names[wr_content]);
+ return 0;
+ }
+ if (type == 0)
+ n_cols = n_continuous;
+ else
+ n_cols = 1;
+ break;
+ case 1:
+ if (n_rows >= n_continuous - (section != FULL && diag == NODIAGONAL))
+ {
+ msg (SE, _("Too many rows of matrix data for %s."),
+ content_names[wr_content]);
+ return 0;
+ }
+
+ switch (section)
+ {
+ case LOWER:
+ n_cols = n_rows + 1;
+ if (diag == NODIAGONAL)
+ cp += n_continuous;
+ break;
+ case UPPER:
+ cp += n_rows;
+ n_cols = n_continuous - n_rows;
+ if (diag == NODIAGONAL)
+ {
+ n_cols--;
+ cp++;
+ }
+ break;
+ case FULL:
+ n_cols = n_continuous;
+ break;
+ default:
+ assert (0);
+ }
+ break;
+ default:
+ assert (0);
+ }
+ c->n_rows[wr_content]++;
+
+ debug_printf ((" (c=%p,r=%d,n=%d)", c, n_rows + 1, n_cols));
+
+ /* Read N_COLS items at CP. */
+ {
+ int j;
+
+ for (j = 0; j < n_cols; j++)
+ {
+ if (!mget_token ())
+ return 0;
+ if (mtoken != MNUM)
+ {
+ msg (SE, _("Syntax error expecting value for %s %s."),
+ default_dict.var[first_continuous + j]->name, context ());
+ return 0;
+ }
+
+ *cp++ = mtokval;
+ }
+ if (!force_eol (content_names[wr_content]))
+ return 0;
+ debug_printf (("\n"));
+ }
+
+ return 1;
+}
+\f
+/* Matrix source. */
+
+struct case_stream matrix_data_source =
+ {
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ "MATRIX DATA",
+ };
+
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "matrix.h"
+\f
+/* Kahan summation formula, Thm. 8, _What Every Computer Scientist
+ Should Know About Floating-Point Arithmetic_, David Goldberg,
+ orig. March 1991 issue of Computing Surveys, also at
+ <URL:http://www.wam.umd.edu/whats_new/workshop3.0/common-tools/numerical_comp_guide/goldberg1.doc.html>.
+ Hopefully your compiler won't try to optimize the code below too
+ much, because that will ruin the precision. */
+#define KAHAN_SUMMATION_FORMULA(S) \
+ do \
+ { \
+ double S_c; \
+ int S_j; \
+ \
+ S = SUMMATION_ELEMENT (0); \
+ S_c = 0.; \
+ for (S_j = 1; S_j < SUMMATION_COUNT; S_j++) \
+ { \
+ double S_y = SUMMATION_ELEMENT (S_j) - S_c; \
+ double S_t = S + S_y; \
+ S_c = (S_t - S) - S_y; \
+ S = S_t; \
+ } \
+ } \
+ while (0)
+
+\f
+/* Vectors. */
+
+/* Allocate a new vector of length N. */
+struct vector *
+vec_alloc (int n)
+{
+ struct vector *vec = xmalloc (sizeof *vec);
+ vec->data = xmalloc (sizeof *vec->data * n);
+ vec->n = vec->m = n;
+ return vec;
+}
+
+/* Change the length of VEC to N. The amount of space allocated will
+ not be lowered, but may be enlarged. */
+void
+vec_realloc (struct vector *vec, int n)
+{
+ if (n < vec->m)
+ {
+ vec->m = n;
+ vec->data = xrealloc (vec->data, sizeof *vec->data * n);
+ }
+ vec->n = n;
+}
+
+/* Free vector VEC. */
+void
+vec_free (struct vector *vec)
+{
+ free (vec->data);
+ free (vec);
+}
+
+/* Set the values in vector VEC to constant VALUE. */
+#if 0
+void
+vec_init (struct vector *vec, double value)
+{
+ double *p;
+ int i;
+
+ p = vec->data;
+ for (i = 0; i < vec->n; i++)
+ *p++ = value;
+}
+#endif
+
+/* Print out vector VEC to stdout for debugging purposes. */
+#if GLOBAL_DEBUGGING
+#include <stdio.h>
+#include "settings.h"
+
+void
+vec_print (const struct vector *vec)
+{
+ int i;
+
+ for (i = 0; i < vec->n; i++)
+ {
+ if (i % ((set_viewwidth - 4) / 8) == 0)
+ {
+ if (i)
+ putchar ('\n');
+ printf ("%3d:", i);
+ }
+
+ printf ("%8g", vec_elem (vec, i));
+ }
+}
+#endif
+
+/* Return the sum of the values in VEC. */
+double
+vec_total (const struct vector *vec)
+{
+ double sum;
+
+#define SUMMATION_COUNT (vec->n)
+#define SUMMATION_ELEMENT(INDEX) (vec_elem (vec, (INDEX)))
+ KAHAN_SUMMATION_FORMULA (sum);
+#undef SUMMATION_COUNT
+#undef SUMMATION_ELEMENT
+
+ return sum;
+}
+\f
+/* Matrices. */
+
+/* Allocate a new matrix with NR rows and NC columns. */
+struct matrix *
+mat_alloc (int nr, int nc)
+{
+ struct matrix *mat = xmalloc (sizeof *mat);
+ mat->nr = nr;
+ mat->nc = nc;
+ mat->m = nr * nc;
+ mat->data = xmalloc (sizeof *mat->data * nr * nc);
+ return mat;
+}
+
+/* Set the size of matrix MAT to NR rows and NC columns. The matrix
+ data array will be enlarged if necessary but will not be shrunk. */
+void
+mat_realloc (struct matrix *mat, int nr, int nc)
+{
+ if (nc * nr > mat->m)
+ {
+ mat->m = nc * nr;
+ mat->data = xrealloc (mat->data, sizeof *mat->data * mat->m);
+ }
+ mat->nr = nr;
+ mat->nc = nc;
+}
+
+/* Free matrix MAT. */
+void
+mat_free (struct matrix *mat)
+{
+ free (mat->data);
+ free (mat);
+}
+
+/* Set all matrix MAT entries to VALUE. */
+void
+mat_init (struct matrix *mat, double value)
+{
+ double *p;
+ int i;
+
+ p = mat->data;
+ for (i = 0; i < mat->nr * mat->nc; i++)
+ *p++ = value;
+}
+
+/* Set all MAT entries in row R to VALUE. */
+void
+mat_init_row (struct matrix *mat, int r, double value)
+{
+ double *p;
+ int i;
+
+ p = &mat_elem (mat, r, 0);
+ for (i = 0; i < mat->nc; i++)
+ *p++ = value;
+}
+
+/* Set all MAT entries in column C to VALUE. */
+void
+mat_init_col (struct matrix *mat, int c, double value)
+{
+ double *p;
+ int i;
+
+ p = &mat_elem (mat, 0, c);
+ for (i = 0; i < mat->nr; i++)
+ {
+ *p = value;
+ p += mat->nc;
+ }
+}
+
+/* Print out MAT entries to stdout, optionally with row and column
+ labels ROW_LABELS and COL_LABELS. */
+#if GLOBAL_DEBUGGING
+void
+mat_print (const struct matrix *mat,
+ const struct vector *row_labels,
+ const struct vector *col_labels)
+{
+ int r, c;
+
+ assert (!row_labels || row_labels->n == mat->nr);
+ if (col_labels)
+ {
+ int c;
+
+ assert (col_labels->n == mat->nc);
+ if (row_labels)
+ printf (" ");
+ for (c = 0; c < mat->nc; c++)
+ printf ("%8g", vec_elem (col_labels, c));
+ }
+
+ for (r = 0; r < mat->nr; r++)
+ {
+ if (row_labels)
+ printf ("%8g:", vec_elem (row_labels, r));
+ for (c = 0; c < mat->nc; c++)
+ printf ("%8g", mat_elem (mat, r, c));
+ putchar ('\n');
+ }
+}
+#endif /* GLOBAL_DEBUGGING */
+
+/* Calculate row totals for matrix MAT into vector ROW_TOTS. */
+void
+mat_row_totals (const struct matrix *mat, struct vector *row_tots)
+{
+ int r;
+
+ vec_realloc (row_tots, mat->nr);
+ for (r = 0; r < mat->nr; r++)
+ {
+ double sum;
+
+#define SUMMATION_COUNT (mat->nc)
+#define SUMMATION_ELEMENT(INDEX) (mat_elem (mat, r, INDEX))
+ KAHAN_SUMMATION_FORMULA (sum);
+#undef SUMMATION_COUNT
+#undef SUMMATION_ELEMENT
+
+ vec_elem (row_tots, r) = sum;
+ }
+}
+
+/* Calculate column totals for matrix MAT into vector COL_TOTS. */
+void
+mat_col_totals (const struct matrix *mat, struct vector *col_tots)
+{
+ int c;
+
+ vec_realloc (col_tots, mat->nc);
+ for (c = 0; c < mat->nc; c++)
+ {
+ double sum;
+
+#define SUMMATION_COUNT (mat->nr)
+#define SUMMATION_ELEMENT(INDEX) (mat_elem (mat, INDEX, c))
+ KAHAN_SUMMATION_FORMULA (sum);
+#undef SUMMATION_COUNT
+#undef SUMMATION_ELEMENT
+
+ vec_elem (col_tots, c) = sum;
+ }
+}
+
+/* Return the grand total for matrix MAT. Of course, if you're also
+ calculating column or row totals, it would be faster to use
+ vec_total on one of those sets of totals. */
+double
+mat_grand_total (const struct matrix *mat)
+{
+ double sum;
+
+#define SUMMATION_COUNT (mat->nr * mat->nc)
+#define SUMMATION_ELEMENT(INDEX) (mat->data[INDEX])
+ KAHAN_SUMMATION_FORMULA (sum);
+#undef SUMMATION_COUNT
+#undef SUMMATION_ELEMENT
+
+ return sum;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !matrix_h
+#define matrix_h 1
+\f
+/* Vector representation. */
+struct vector
+ {
+ int n;
+ int m;
+ double *data;
+ };
+
+/* Allocate vectors. */
+struct vector *vec_alloc (int n);
+void vec_realloc (struct vector *, int n);
+void vec_free (struct vector *);
+
+/* Vector elements. */
+#define vec_elem(VEC, INDEX) ((VEC)->data[INDEX])
+
+/* Set the vector to a constant value. */
+void vec_init (struct vector *, double);
+
+/* Print out the vector to stdout. */
+#if GLOBAL_DEBUGGING
+void vec_print (const struct vector *);
+#endif
+
+/* Sum the vector values. */
+double vec_total (const struct vector *);
+\f
+/* Matrix representation. */
+struct matrix
+ {
+ int nr, nc;
+ int m;
+ double *data;
+ };
+
+/* Allocate matrices. */
+struct matrix *mat_alloc (int nr, int nc);
+void mat_realloc (struct matrix *, int nr, int nc);
+void mat_free (struct matrix *);
+
+/* Matrix elements. */
+#define mat_elem(MAT, R, C) ((MAT)->data[(C) + (R) * (MAT)->nc])
+
+/* Set matrix values to a constant. */
+void mat_init (struct matrix *, double);
+void mat_init_row (struct matrix *, int r, double);
+void mat_init_col (struct matrix *, int c, double);
+
+/* Print out the matrix values to stdout, optionally with row and
+ column labels (for debugging purposes). */
+#if GLOBAL_DEBUGGING
+void mat_print (const struct matrix *,
+ const struct vector *row_labels, const struct vector *col_labels);
+#endif
+
+/* Sum matrix values. */
+void mat_row_totals (const struct matrix *, struct vector *row_tots);
+void mat_col_totals (const struct matrix *, struct vector *col_tots);
+double mat_grand_total (const struct matrix *);
+
+/* Chi-square statistics. */
+enum
+ {
+ CHISQ_PEARSON,
+ CHISQ_LIKELIHOOD_RATIO,
+ CHISQ_FISHER,
+ CHISQ_CC,
+ CHISQ_LINEAR,
+ N_CHISQ
+ };
+
+void mat_chisq (const struct matrix *, double chisq[N_CHISQ], int df[N_CHISQ]);
+
+#endif /* matrix_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+#include "alloc.h"
+#include "avl.h"
+#include "command.h"
+#include "lexer.h"
+#include "error.h"
+#include "magic.h"
+#include "var.h"
+/* (headers) */
+
+#undef DEBUGGING
+#define DEBUGGING 1
+#include "debug-print.h"
+
+/* (specification)
+ means (mns_):
+ *tables=custom;
+ +variables=custom;
+ +crossbreak=custom;
+ +format=lab:!labels/nolabels/nocatlabs,
+ name:!names/nonames,
+ val:!values/novalues,
+ fmt:!table/tree;
+ +missing=miss:!table/include/dependent;
+ +cells[cl_]=default,count,sum,mean,stddev,variance,all;
+ +statistics[st_]=anova,linearity,all,none.
+*/
+/* (declarations) */
+/* (functions) */
+
+#if DEBUGGING
+static void debug_print (struct cmd_means *cmd);
+#endif
+
+/* TABLES: Variable lists for each dimension. */
+int n_dim; /* Number of dimensions. */
+int *nv_dim; /* Number of variables in each dimension. */
+struct variable ***v_dim; /* Variables in each dimension. */
+
+/* VARIABLES: List of variables. */
+int n_var;
+struct variable **v_var;
+
+/* Parses and executes the T-TEST procedure. */
+int
+cmd_means (void)
+{
+ struct cmd_means cmd;
+ int success = CMD_FAILURE;
+
+ n_dim = 0;
+ nv_dim = NULL;
+ v_dim = NULL;
+ v_var = NULL;
+
+ lex_match_id ("MEANS");
+ if (!parse_means (&cmd))
+ goto free;
+
+ if (cmd.sbc_cells)
+ {
+ int i;
+ for (i = 0; i < MNS_CL_count; i++)
+ if (cmd.a_cells[i])
+ break;
+ if (i >= MNS_CL_count)
+ cmd.a_cells[MNS_CL_ALL] = 1;
+ }
+ else
+ cmd.a_cells[MNS_CL_DEFAULT] = 1;
+ if (cmd.a_cells[MNS_CL_DEFAULT] || cmd.a_cells[MNS_CL_ALL])
+ cmd.a_cells[MNS_CL_MEAN] = cmd.a_cells[MNS_CL_STDDEV] = cmd.a_cells[MNS_CL_COUNT] = 1;
+ if (cmd.a_cells[MNS_CL_ALL])
+ cmd.a_cells[MNS_CL_SUM] = cmd.a_cells[MNS_CL_VARIANCE] = 1;
+
+ if (cmd.sbc_statistics)
+ {
+ if (!cmd.a_statistics[MNS_ST_ANOVA] && !cmd.a_statistics[MNS_ST_LINEARITY])
+ cmd.a_statistics[MNS_ST_ANOVA] = 1;
+ if (cmd.a_statistics[MNS_ST_ALL])
+ cmd.a_statistics[MNS_ST_ANOVA] = cmd.a_statistics[MNS_ST_LINEARITY] = 1;
+ }
+
+ if (!cmd.sbc_tables)
+ {
+ msg (SE, _("Missing required subcommand TABLES."));
+ goto free;
+ }
+
+#if DEBUGGING
+ debug_print (&cmd);
+#endif
+
+ success = CMD_SUCCESS;
+
+free:
+ {
+ int i;
+
+ for (i = 0; i < n_dim; i++)
+ free (v_dim[i]);
+ free (nv_dim);
+ free (v_dim);
+ free (v_var);
+ }
+
+ return success;
+}
+
+/* Returns nonzero only if value V is valid as an endpoint for a
+ dependent variable in integer mode. */
+int
+validate_dependent_endpoint (double V)
+{
+ return V == (int) V && V != LOWEST && V != HIGHEST;
+}
+
+/* Parses the TABLES subcommand. */
+static int
+mns_custom_tables (struct cmd_means *cmd)
+{
+ struct dictionary *dict;
+ struct dictionary temp_dict;
+
+ if (!lex_match_id ("TABLES")
+ && (token != T_ID || !is_varname (tokid))
+ && token != T_ALL)
+ return 2;
+ lex_match ('=');
+
+ if (cmd->sbc_tables || cmd->sbc_crossbreak)
+ {
+ msg (SE, _("TABLES or CROSSBREAK subcommand may not appear more "
+ "than once."));
+ return 0;
+ }
+
+ if (cmd->sbc_variables)
+ {
+ dict = &temp_dict;
+ temp_dict.var = v_var;
+ temp_dict.nvar = n_var;
+
+ {
+ int i;
+
+ temp_dict.var_by_name = avl_create (NULL, cmp_variable, NULL);
+ for (i = 0; i < temp_dict.nvar; i++)
+ avl_force_insert (temp_dict.var_by_name, temp_dict.var[i]);
+ }
+ }
+ else
+ dict = &default_dict;
+
+ do
+ {
+ int nvl;
+ struct variable **vl;
+
+ if (!parse_variables (dict, &vl, &nvl, PV_NO_DUPLICATE | PV_NO_SCRATCH))
+ return 0;
+
+ n_dim++;
+ nv_dim = xrealloc (nv_dim, n_dim * sizeof (int));
+ v_dim = xrealloc (v_dim, n_dim * sizeof (struct variable **));
+
+ nv_dim[n_dim - 1] = nvl;
+ v_dim[n_dim - 1] = vl;
+
+ if (cmd->sbc_variables)
+ {
+ int i;
+
+ for (i = 0; i < nv_dim[0]; i++)
+ {
+ struct means_proc *v_inf = &v_dim[0][i]->p.mns;
+
+ if (v_inf->min == SYSMIS)
+ {
+ msg (SE, _("Variable %s specified on TABLES or "
+ "CROSSBREAK, but not specified on "
+ "VARIABLES."),
+ v_dim[0][i]->name);
+ return 0;
+ }
+
+ if (n_dim == 1)
+ {
+ v_inf->min = (int) v_inf->min;
+ v_inf->max = (int) v_inf->max;
+ } else {
+ if (v_inf->min == LOWEST || v_inf->max == HIGHEST)
+ {
+ msg (SE, _("LOWEST and HIGHEST may not be used "
+ "for independent variables (%s)."),
+ v_dim[0][i]->name);
+ return 0;
+ }
+ if (v_inf->min != (int) v_inf->min
+ || v_inf->max != (int) v_inf->max)
+ {
+ msg (SE, _("Independent variables (%s) may not "
+ "have noninteger endpoints in their "
+ "ranges."),
+ v_dim[0][i]->name);
+ return 0;
+ }
+ }
+ }
+ }
+ }
+ while (lex_match (T_BY));
+
+ /* Check for duplicates. */
+ {
+ int i;
+
+ for (i = 0; i < default_dict.nvar; i++)
+ default_dict.var[i]->foo = 0;
+ for (i = 0; i < dict->nvar; i++)
+ if (dict->var[i]->foo++)
+ {
+ msg (SE, _("Variable %s is multiply specified on TABLES "
+ "or CROSSBREAK."),
+ dict->var[i]->name);
+ return 0;
+ }
+ }
+
+ if (cmd->sbc_variables)
+ avl_destroy (temp_dict.var_by_name, NULL);
+
+ return 1;
+}
+
+/* Parse CROSSBREAK subcommand. */
+static int
+mns_custom_crossbreak (struct cmd_means *cmd)
+{
+ return mns_custom_tables (cmd);
+}
+
+/* Parses the VARIABLES subcommand. */
+static int
+mns_custom_variables (struct cmd_means *cmd)
+{
+ if (cmd->sbc_tables)
+ {
+ msg (SE, _("VARIABLES must precede TABLES."));
+ return 0;
+ }
+
+ if (cmd->sbc_variables == 1)
+ {
+ int i;
+
+ for (i = 0; i < default_dict.nvar; i++)
+ default_dict.var[i]->p.mns.min = SYSMIS;
+ }
+
+ do
+ {
+ int orig_n = n_var;
+
+ double min, max;
+
+ if (!parse_variables (&default_dict, &v_var, &n_var,
+ PV_APPEND | PV_NO_DUPLICATE | PV_NO_SCRATCH))
+ return 0;
+
+ if (!lex_force_match ('('))
+ return 0;
+
+ /* Lower value. */
+ if (token == T_ID
+ && (!strcmp (tokid, "LO") || lex_id_match ("LOWEST", tokid)))
+ min = LOWEST;
+ else
+ {
+ if (!lex_force_num ())
+ return 0;
+ min = tokval;
+ }
+ lex_get ();
+
+ lex_match (',');
+
+ /* Higher value. */
+ if (token == T_ID
+ && (!strcmp (tokid, "HI") || lex_id_match ("HIGHEST", tokid)))
+ max = HIGHEST;
+ else
+ {
+ if (!lex_force_num ())
+ return 0;
+ max = tokval;
+ }
+ lex_get ();
+
+ if (!lex_force_match (')'))
+ return 0;
+
+ /* Range check. */
+ if (max < min)
+ {
+ msg (SE, _("Upper value (%g) is less than lower value "
+ "(%g) on VARIABLES subcommand."), max, min);
+ return 0;
+ }
+
+ {
+ int i;
+
+ for (i = orig_n; i < n_var; i++)
+ {
+ struct means_proc *v_inf = &v_var[i]->p.mns;
+
+ v_inf->min = min;
+ v_inf->max = max;
+ }
+ }
+ }
+ while (token != '/' && token != '.');
+
+ return 1;
+}
+
+#if DEBUGGING
+static void
+debug_print (struct cmd_means *cmd)
+{
+ int i;
+
+ printf ("MEANS");
+
+ if (cmd->sbc_variables)
+ {
+ int j = 0;
+
+ printf (" VARIABLES=");
+ for (i = 0; i < default_dict.nvar; i++)
+ {
+ struct variable *v = default_dict.var[i];
+
+ if (v->p.mns.min == SYSMIS)
+ continue;
+ if (j++)
+ printf (" ");
+ printf ("%s(", v->name);
+ if (v->p.mns.min == LOWEST)
+ printf ("LO");
+ else
+ printf ("%g", v->p.mns.min);
+ printf (",");
+ if (v->p.mns.max == HIGHEST)
+ printf ("HI");
+ else
+ printf ("%g", v->p.mns.max);
+ printf (")");
+ }
+ printf ("\n");
+ }
+
+ printf (" TABLES=");
+ for (i = 0; i < n_dim; i++)
+ {
+ int j;
+
+ if (i)
+ printf (" BY");
+
+ for (j = 0; j < nv_dim[i]; j++)
+ {
+ if (i || j)
+ printf (" ");
+ printf (v_dim[i][j]->name);
+ }
+ }
+ printf ("\n");
+}
+#endif /* DEBUGGING */
+
+/*
+ Local Variables:
+ mode: c
+ End:
+*/
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdlib.h>
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "magic.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+#if DEBUGGING
+static void debug_print ();
+#endif
+
+/* Variables on MIS VAL. */
+static struct variable **v;
+static int nv;
+
+/* Type of the variables on MIS VAL. */
+static int type;
+
+/* Width of string variables on MIS VAL. */
+static size_t width;
+
+/* Items to fill-in var structs with. */
+static int miss_type;
+static union value missing[3];
+
+static int parse_varnames (void);
+static int parse_numeric (void);
+static int parse_alpha (void);
+
+int
+cmd_missing_values (void)
+{
+ int i;
+
+ lex_match_id ("MISSING");
+ lex_match_id ("VALUES");
+ while (token != '.')
+ {
+#if __CHECKER__
+ memset (missing, 0, sizeof missing);
+#endif
+
+ if (!parse_varnames ())
+ goto fail;
+
+ if (token != ')')
+ {
+ if ((type == NUMERIC && !parse_numeric ())
+ || (type == ALPHA && !parse_alpha ()))
+ goto fail;
+ }
+ else
+ miss_type = MISSING_NONE;
+
+ if (!lex_match (')'))
+ {
+ msg (SE, _("`)' expected after value specification."));
+ goto fail;
+ }
+
+ for (i = 0; i < nv; i++)
+ {
+ v[i]->miss_type = miss_type;
+ memcpy (v[i]->missing, missing, sizeof v[i]->missing);
+ }
+
+ lex_match ('/');
+ free (v);
+ }
+
+#if DEBUGGING
+ debug_print ();
+#endif
+
+ return lex_end_of_command ();
+
+fail:
+ free (v);
+ return CMD_PART_SUCCESS_MAYBE;
+}
+
+static int
+parse_varnames (void)
+{
+ int i;
+
+ if (!parse_variables (NULL, &v, &nv, PV_SAME_TYPE))
+ return 0;
+ if (!lex_match ('('))
+ {
+ msg (SE, _("`(' expected after variable name%s."), nv > 1 ? "s" : "");
+ return 0;
+ }
+
+ type = v[0]->type;
+ if (type == NUMERIC)
+ return 1;
+
+ width = v[0]->width;
+ for (i = 1; i < nv; i++)
+ if (v[i]->type == ALPHA && v[i]->nv != 1)
+ {
+ msg (SE, _("Long string value specified."));
+ return 0;
+ }
+ else if (v[i]->type == ALPHA && (int) width != v[i]->width)
+ {
+ msg (SE, _("Short strings must be of equal width."));
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Number or range? */
+enum
+ {
+ MV_NOR_NOTHING, /* Empty. */
+ MV_NOR_NUMBER, /* Single number. */
+ MV_NOR_RANGE /* Range. */
+ };
+
+/* A single value or a range. */
+struct num_or_range
+ {
+ int type; /* One of NOR_*. */
+ double d[2]; /* d[0]=lower bound or value, d[1]=upper bound. */
+ };
+
+/* Parses something of the form <num>, or LO[WEST] THRU <num>, or
+ <num> THRU HI[GHEST], or <num> THRU <num>, and sets the appropriate
+ members of NOR. Returns success. */
+static int
+parse_num_or_range (struct num_or_range * nor)
+{
+ if (lex_match_id ("LO") || lex_match_id ("LOWEST"))
+ {
+ nor->type = MV_NOR_RANGE;
+ if (!lex_force_match_id ("THRU"))
+ return 0;
+ if (!lex_force_num ())
+ return 0;
+ nor->d[0] = LOWEST;
+ nor->d[1] = tokval;
+ }
+ else if (token == T_NUM)
+ {
+ nor->d[0] = tokval;
+ lex_get ();
+
+ if (lex_match_id ("THRU"))
+ {
+ nor->type = MV_NOR_RANGE;
+ if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
+ nor->d[1] = HIGHEST;
+ else
+ {
+ if (!lex_force_num ())
+ return 0;
+ nor->d[1] = tokval;
+ lex_get ();
+
+ if (nor->d[0] > nor->d[1])
+ {
+ msg (SE, _("Range %g THRU %g is not valid because %g is "
+ "greater than %g."),
+ nor->d[0], nor->d[1], nor->d[0], nor->d[1]);
+ return 0;
+ }
+ }
+ }
+ else
+ nor->type = MV_NOR_NUMBER;
+ }
+ else
+ return -1;
+
+ return 1;
+}
+
+/* Parses a set of numeric missing values and stores them into
+ `missing[]' and `miss_type' global variables. */
+static int
+parse_numeric (void)
+{
+ struct num_or_range set[3];
+ int r;
+
+ set[1].type = set[2].type = MV_NOR_NOTHING;
+
+ /* Get first number or range. */
+ r = parse_num_or_range (&set[0]);
+ if (r < 1)
+ {
+ if (r == -1)
+ msg (SE, _("Number or range expected."));
+ return 0;
+ }
+
+ /* Get second and third optional number or range. */
+ lex_match (',');
+ r = parse_num_or_range (&set[1]);
+ if (r == 1)
+ {
+ lex_match (',');
+ r = parse_num_or_range (&set[2]);
+ }
+ if (r == 0)
+ return 0;
+
+ /* Force range, if present, into set[0]. */
+ if (set[1].type == MV_NOR_RANGE)
+ {
+ struct num_or_range t = set[1];
+ set[1] = set[0];
+ set[0] = t;
+ }
+ if (set[2].type == MV_NOR_RANGE)
+ {
+ struct num_or_range t = set[2];
+ set[2] = set[0];
+ set[0] = t;
+ }
+
+ /* Ensure there's not more than one range, or one range
+ plus one value. */
+ if (set[1].type == MV_NOR_RANGE || set[2].type == MV_NOR_RANGE)
+ {
+ msg (SE, _("At most one range can exist in the missing values "
+ "for any one variable."));
+ return 0;
+ }
+ if (set[0].type == MV_NOR_RANGE && set[2].type != MV_NOR_NOTHING)
+ {
+ msg (SE, _("At most one individual value can be missing along "
+ "with one range."));
+ return 0;
+ }
+
+ /* Set missing[] from set[]. */
+ if (set[0].type == MV_NOR_RANGE)
+ {
+ int x = 0;
+
+ if (set[0].d[0] == LOWEST)
+ {
+ miss_type = MISSING_LOW;
+ missing[x++].f = set[0].d[1];
+ }
+ else if (set[0].d[1] == HIGHEST)
+ {
+ miss_type = MISSING_HIGH;
+ missing[x++].f = set[0].d[0];
+ }
+ else
+ {
+ miss_type = MISSING_RANGE;
+ missing[x++].f = set[0].d[0];
+ missing[x++].f = set[0].d[1];
+ }
+
+ if (set[1].type == MV_NOR_NUMBER)
+ {
+ miss_type += 3;
+ missing[x].f = set[1].d[0];
+ }
+ }
+ else
+ {
+ if (set[0].type == MV_NOR_NUMBER)
+ {
+ miss_type = MISSING_1;
+ missing[0].f = set[0].d[0];
+ }
+ if (set[1].type == MV_NOR_NUMBER)
+ {
+ miss_type = MISSING_2;
+ missing[1].f = set[1].d[0];
+ }
+ if (set[2].type == MV_NOR_NUMBER)
+ {
+ miss_type = MISSING_3;
+ missing[2].f = set[2].d[0];
+ }
+ }
+
+ return 1;
+}
+
+static int
+parse_alpha (void)
+{
+ for (miss_type = 0; token == T_STRING && miss_type < 3; miss_type++)
+ {
+ if (ds_length (&tokstr) != width)
+ {
+ msg (SE, _("String is not of proper length."));
+ return 0;
+ }
+ strncpy (missing[miss_type].s, ds_value (&tokstr), MAX_SHORT_STRING);
+ lex_get ();
+ lex_match (',');
+ }
+ if (miss_type < 1)
+ {
+ msg (SE, _("String expected."));
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Copy the missing values from variable SRC to variable DEST. */
+void
+copy_missing_values (struct variable *dest, const struct variable *src)
+{
+ static const int n_values[MISSING_COUNT] =
+ {
+ 0, 1, 2, 3, 2, 1, 1, 3, 2, 2,
+ };
+
+ assert (dest->width == src->width);
+ assert (src->miss_type >= 0 && src->miss_type < MISSING_COUNT);
+
+ {
+ int i;
+
+ dest->miss_type = src->miss_type;
+ for (i = 0; i < n_values[src->miss_type]; i++)
+ if (src->type == NUMERIC)
+ dest->missing[i].f = src->missing[i].f;
+ else
+ memcpy (dest->missing[i].s, src->missing[i].s, src->width);
+ }
+}
+
+\f
+/* Debug output. */
+
+#if DEBUGGING
+static void
+debug_print (void)
+{
+ int i, j;
+
+ puts (_("Missing value:"));
+ for (i = 0; i < nvar; i++)
+ {
+ printf (" %8s: ", var[i]->name);
+ if (var[i]->type == ALPHA && var[i]->nv > 1)
+ puts (_("(long string variable)"));
+ else
+ switch (var[i]->miss_type)
+ {
+ case MISSING_NONE:
+ printf (_("(no missing values)\n"));
+ break;
+ case MISSING_1:
+ case MISSING_2:
+ case MISSING_3:
+ printf ("(MISSING_%d)", var[i]->miss_type);
+ for (j = 0; j < var[i]->miss_type; j++)
+ if (var[i]->type == ALPHA)
+ printf (" \"%.*s\"", var[i]->width, var[i]->missing[j].s);
+ else
+ printf (" %.2g", var[i]->missing[j].f);
+ printf ("\n");
+ break;
+ case MISSING_RANGE:
+ printf ("(MISSING_RANGE) %.2g THRU %.2g\n",
+ var[i]->missing[0].f, var[i]->missing[1].f);
+ break;
+ case MISSING_RANGE_1:
+ printf ("(MISSING_RANGE_1) %.2g THRU %.2g, %.2g\n",
+ var[i]->missing[0].f, var[i]->missing[1].f,
+ var[i]->missing[2].f);
+ break;
+ default:
+ printf (_("(!!!INTERNAL ERROR--%d!!!)\n"), var[i]->miss_type);
+ }
+ }
+}
+#endif /* DEBUGGING */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include "misc.h"
+
+/* Returns the number of digits in X. */
+int
+intlog10 (unsigned x)
+{
+ int digits = 0;
+
+ do
+ {
+ digits++;
+ x /= 10;
+ }
+ while (x > 0);
+
+ return digits;
+}
+
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !math_misc_h
+#define math_misc_h 1
+
+#include <math.h>
+
+/* HUGE_VAL is traditionally defined as positive infinity, or
+ alternatively, DBL_MAX. */
+#if !HAVE_ISINF
+#define isinf(X) \
+ (fabs (X) == HUGE_VAL)
+#endif
+
+/* A Not a Number is not equal to itself. */
+#if !HAVE_ISNAN
+#define isnan(X) \
+ ((X) != (X))
+#endif
+
+/* Finite numbers are not infinities or NaNs. */
+#if !HAVE_FINITE
+#define finite(X) \
+ (!isinf (X) && !isnan (X))
+#elif HAVE_IEEEFP_H
+#include <ieeefp.h> /* Declares finite() under Solaris. */
+#endif
+
+#if __TURBOC__
+#include <stdlib.h> /* screwed-up Borland headers define min(), max(),
+ so we might as well let 'em */
+#endif
+
+#ifndef min
+#if __GNUC__ && !__STRICT_ANSI__
+#define min(A, B) \
+ ({ \
+ int _a = (A), _b = (B); \
+ _a < _b ? _a : _b; \
+ })
+#else /* !__GNUC__ */
+#define min(A, B) \
+ ((A) < (B) ? (A) : (B))
+#endif /* !__GNUC__ */
+#endif /* !min */
+
+#ifndef max
+#if __GNUC__ && !__STRICT_ANSI__
+#define max(A, B) \
+ ({ \
+ int _a = (A), _b = (B); \
+ _a > _b ? _a : _b; \
+ })
+#else /* !__GNUC__ */
+#define max(A, B) \
+ ((A) > (B) ? (A) : (B))
+#endif /* !__GNUC__ */
+#endif /* !max */
+
+/* Clamps A to be between B and C. */
+#define range(A, B, C) \
+ ((A) < (B) ? (B) : ((A) > (C) ? (C) : (A)))
+
+/* Divides nonnegative X by positive Y, rounding up. */
+#define DIV_RND_UP(X, Y) \
+ (((X) + ((Y) - 1)) / (Y))
+
+/* Returns nonnegative difference between {nonnegative X} and {the
+ least multiple of positive Y greater than or equal to X}. */
+#if __GNUC__ && !__STRICT_ANSI__
+#define REM_RND_UP(X, Y) \
+ ({ \
+ int rem = (X) % (Y); \
+ rem ? (Y) - rem : 0; \
+ })
+#else
+#define REM_RND_UP(X, Y) \
+ ((X) % (Y) ? (Y) - (X) % (Y) : 0)
+#endif
+
+/* Rounds X up to the next multiple of Y. */
+#define ROUND_UP(X, Y) \
+ (((X) + ((Y) - 1)) / (Y) * (Y))
+
+/* Rounds X down to the previous multiple of Y. */
+#define ROUND_DOWN(X, Y) \
+ ((X) / (Y) * (Y))
+
+int intlog10 (unsigned);
+
+#endif /* math/misc.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <stdlib.h>
+#include <assert.h>
+#include "alloc.h"
+#include "avl.h"
+#include "bitvector.h"
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "misc.h"
+#include "str.h"
+#include "var.h"
+#include "vfm.h"
+
+/* FIXME: should change weighting variable, etc. */
+/* These control the way that compare_variables() does its work. */
+static int forward; /* 1=FORWARD, 0=BACKWARD. */
+static int positional; /* 1=POSITIONAL, 0=ALPHA. */
+
+static int compare_variables (const void *pa, const void *pb);
+
+/* Explains how to modify the variables in a dictionary in conjunction
+ with the p.mfv field of `variable'. */
+struct var_modification
+ {
+ /* REORDER information. */
+ struct variable **reorder_list;
+
+ /* RENAME information. */
+ struct variable **old_names;
+ char **new_names;
+ int n_rename;
+
+ /* DROP/KEEP information. */
+ int n_drop; /* Number of variables being dropped. */
+ };
+
+static struct dictionary *rearrange_dict (struct dictionary *d,
+ struct var_modification *vm,
+ int permanent);
+
+/* Performs MODIFY VARS command. */
+int
+cmd_modify_vars (void)
+{
+ /* Bits indicated whether we've already encountered a subcommand of
+ this type. */
+ unsigned already_encountered = 0;
+
+ /* What we're gonna do to the active file. */
+ struct var_modification vm;
+
+ lex_match_id ("MODIFY");
+ lex_match_id ("VARS");
+
+ vm.reorder_list = NULL;
+ vm.old_names = NULL;
+ vm.new_names = NULL;
+ vm.n_rename = 0;
+ vm.n_drop = 0;
+
+ /* Parse each subcommand. */
+ lex_match ('/');
+ for (;;)
+ {
+ if (lex_match_id ("REORDER"))
+ {
+ struct variable **v = NULL;
+ int nv = 0;
+
+ if (already_encountered & 1)
+ {
+ msg (SE, _("REORDER subcommand may be given at most once."));
+ goto lossage;
+ }
+ already_encountered |= 1;
+
+ lex_match ('=');
+ do
+ {
+ int prev_nv = nv;
+
+ forward = positional = 1;
+ if (lex_match_id ("FORWARD"));
+ else if (lex_match_id ("BACKWARD"))
+ forward = 0;
+ if (lex_match_id ("POSITIONAL"));
+ else if (lex_match_id ("ALPHA"))
+ positional = 0;
+
+ if (lex_match (T_ALL) || token == '/' || token == '.')
+ {
+ if (prev_nv != 0)
+ {
+ msg (SE, _("Cannot specify ALL after specifying a set "
+ "of variables."));
+ goto lossage;
+ }
+ fill_all_vars (&v, &nv, FV_NO_SYSTEM);
+ }
+ else
+ {
+ if (!lex_match ('('))
+ {
+ msg (SE, _("`(' expected on REORDER subcommand."));
+ free (v);
+ goto lossage;
+ }
+ if (!parse_variables (&default_dict, &v, &nv,
+ PV_APPEND | PV_NO_DUPLICATE))
+ {
+ free (v);
+ goto lossage;
+ }
+ if (!lex_match (')'))
+ {
+ msg (SE, _("`)' expected following variable names on "
+ "REORDER subcommand."));
+ free (v);
+ goto lossage;
+ }
+ }
+ qsort (&v[prev_nv], nv - prev_nv, sizeof *v, compare_variables);
+ }
+ while (token != '/' && token != '.');
+
+ if (nv != default_dict.nvar)
+ {
+ size_t nbytes = DIV_RND_UP (default_dict.nvar, 8);
+ unsigned char *bits = local_alloc (nbytes);
+ int i;
+
+ memset (bits, 0, nbytes);
+ for (i = 0; i < nv; i++)
+ SET_BIT (bits, v[i]->index);
+ v = xrealloc (v, sizeof *v * default_dict.nvar);
+ for (i = 0; i < default_dict.nvar; i++)
+ if (!TEST_BIT (bits, i))
+ v[nv++] = default_dict.var[i];
+ local_free (bits);
+ }
+
+ vm.reorder_list = v;
+ }
+ else if (lex_match_id ("RENAME"))
+ {
+ if (already_encountered & 2)
+ {
+ msg (SE, _("RENAME subcommand may be given at most once."));
+ goto lossage;
+ }
+ already_encountered |= 2;
+
+ lex_match ('=');
+ do
+ {
+ int prev_nv_1 = vm.n_rename;
+ int prev_nv_2 = vm.n_rename;
+
+ if (!lex_match ('('))
+ {
+ msg (SE, _("`(' expected on RENAME subcommand."));
+ goto lossage;
+ }
+ if (!parse_variables (&default_dict, &vm.old_names, &vm.n_rename,
+ PV_APPEND | PV_NO_DUPLICATE))
+ goto lossage;
+ if (!lex_match ('='))
+ {
+ msg (SE, _("`=' expected between lists of new and old variable "
+ "names on RENAME subcommand."));
+ goto lossage;
+ }
+ if (!parse_DATA_LIST_vars (&vm.new_names, &prev_nv_1, PV_APPEND))
+ goto lossage;
+ if (prev_nv_1 != vm.n_rename)
+ {
+ int i;
+
+ msg (SE, _("Differing number of variables in old name list "
+ "(%d) and in new name list (%d)."),
+ vm.n_rename - prev_nv_2, prev_nv_1 - prev_nv_2);
+ for (i = 0; i < prev_nv_1; i++)
+ free (&vm.new_names[i]);
+ free (&vm.new_names);
+ vm.new_names = NULL;
+ goto lossage;
+ }
+ if (!lex_match (')'))
+ {
+ msg (SE, _("`)' expected after variable lists on RENAME "
+ "subcommand."));
+ goto lossage;
+ }
+ }
+ while (token != '.' && token != '/');
+ }
+ else if (lex_match_id ("KEEP"))
+ {
+ struct variable **keep_vars;
+ int nv;
+ int counter;
+ int i;
+
+ if (already_encountered & 4)
+ {
+ msg (SE, _("KEEP subcommand may be given at most once. It may not"
+ "be given in conjunction with the DROP subcommand."));
+ goto lossage;
+ }
+ already_encountered |= 4;
+
+ lex_match ('=');
+ if (!parse_variables (&default_dict, &keep_vars, &nv, PV_NONE))
+ goto lossage;
+
+ /* Transform the list of variables to keep into a list of
+ variables to drop. First sort the keep list, then figure
+ out which variables are missing. */
+ forward = positional = 1;
+ qsort (keep_vars, nv, sizeof *keep_vars, compare_variables);
+
+ vm.n_drop = default_dict.nvar - nv;
+
+ counter = 0;
+ for (i = 0; i < nv; i++)
+ {
+ while (counter < keep_vars[i]->index)
+ default_dict.var[counter++]->p.mfv.drop_this_var = 1;
+ default_dict.var[counter++]->p.mfv.drop_this_var = 0;
+ }
+ while (counter < nv)
+ default_dict.var[counter++]->p.mfv.drop_this_var = 1;
+
+ free (keep_vars);
+ }
+ else if (lex_match_id ("DROP"))
+ {
+ struct variable **drop_vars;
+ int nv;
+ int i;
+
+ if (already_encountered & 4)
+ {
+ msg (SE, _("DROP subcommand may be given at most once. It may not"
+ "be given in conjunction with the KEEP subcommand."));
+ goto lossage;
+ }
+ already_encountered |= 4;
+
+ lex_match ('=');
+ if (!parse_variables (&default_dict, &drop_vars, &nv, PV_NONE))
+ goto lossage;
+ for (i = 0; i < default_dict.nvar; i++)
+ default_dict.var[i]->p.mfv.drop_this_var = 0;
+ for (i = 0; i < nv; i++)
+ drop_vars[i]->p.mfv.drop_this_var = 1;
+ vm.n_drop = nv;
+ free (drop_vars);
+ }
+ else if (lex_match_id ("MAP"))
+ {
+ struct dictionary *new_dict = rearrange_dict (&default_dict, &vm, 0);
+ if (!new_dict)
+ goto lossage;
+ /* FIXME: display new dictionary. */
+ }
+ else
+ {
+ if (token == T_ID)
+ msg (SE, _("Unrecognized subcommand name `%s'."), tokid);
+ else
+ msg (SE, _("Subcommand name expected."));
+ goto lossage;
+ }
+
+ if (token == '.')
+ break;
+ if (token != '/')
+ {
+ msg (SE, _("`/' or `.' expected."));
+ goto lossage;
+ }
+ lex_get ();
+ }
+
+ {
+ int i;
+
+ if (already_encountered & (1 | 4))
+ {
+ /* Read the data. */
+ procedure (NULL, NULL, NULL);
+ }
+
+ if (NULL == rearrange_dict (&default_dict, &vm, 1))
+ goto lossage;
+
+ free (vm.reorder_list);
+ free (vm.old_names);
+ for (i = 0; i < vm.n_rename; i++)
+ free (vm.new_names[i]);
+ free (vm.new_names);
+
+ return CMD_SUCCESS;
+ }
+
+lossage:
+ {
+ int i;
+
+ free (vm.reorder_list);
+ free (vm.old_names);
+ for (i = 0; i < vm.n_rename; i++)
+ free (vm.new_names[i]);
+ free (vm.new_names);
+ return CMD_FAILURE;
+ }
+}
+
+/* Compares a pair of variables according to the settings in `forward'
+ and `positional', returning a strcmp()-type result. */
+static int
+compare_variables (const void *pa, const void *pb)
+{
+ const struct variable *a = *(const struct variable **) pa;
+ const struct variable *b = *(const struct variable **) pb;
+
+ int result = positional ? a->index - b->index : strcmp (a->name, b->name);
+ return forward ? result : -result;
+}
+
+/* (Possibly) rearranges variables and (possibly) removes some
+ variables and (possibly) renames some more variables in dictionary
+ D. There are two modes of operation, distinguished by the value of
+ PERMANENT:
+
+ If PERMANENT is nonzero, then the dictionary is modified in place.
+ Returns the new dictionary on success or NULL if there would have
+ been duplicate variable names in the resultant dictionary (in this
+ case the dictionary has not been modified).
+
+ If PERMANENT is zero, then the dictionary is copied to a new
+ dictionary structure that retains most of the same deep structure
+ as D. The p.mfv.new_name field of each variable is set to what
+ would become the variable's new name if PERMANENT were nonzero.
+ Returns the new dictionary. */
+static struct dictionary *
+rearrange_dict (struct dictionary * d, struct var_modification * vm, int permanent)
+{
+ struct dictionary *n;
+
+ struct variable **save_var;
+
+ /* Linked list of variables for deletion. */
+ struct variable *head, *tail;
+
+ int i;
+
+ /* First decide what dictionary to modify. */
+ if (permanent == 0)
+ {
+ n = xmalloc (sizeof *n);
+ *n = *d;
+ }
+ else
+ n = d;
+ save_var = n->var;
+
+ /* Perform first half of renaming. */
+ if (permanent)
+ {
+ for (i = 0; i < d->nvar; i++)
+ d->var[i]->p.mfv.new_name[0] = 0;
+ d->var = xmalloc (sizeof *d->var * d->nvar);
+ }
+ else
+ for (i = 0; i < d->nvar; i++)
+ strcpy (d->var[i]->p.mfv.new_name, d->var[i]->name);
+ for (i = 0; i < vm->n_rename; i++)
+ strcpy (vm->old_names[i]->p.mfv.new_name, vm->new_names[i]);
+
+ /* Copy the variable list, reordering if appropriate. */
+ if (vm->reorder_list)
+ memcpy (n->var, vm->reorder_list, sizeof *n->var * d->nvar);
+ else if (!permanent)
+ for (i = 0; i < d->nvar; i++)
+ n->var[i] = d->var[i];
+
+ /* Drop all the unwanted variables. */
+ head = NULL;
+ if (vm->n_drop)
+ {
+ int j;
+
+ n->nvar = d->nvar - vm->n_drop;
+ for (i = j = 0; i < n->nvar; i++)
+ {
+ while (n->var[j]->p.mfv.drop_this_var != 0)
+ {
+ if (permanent)
+ {
+ /* If this is permanent, then we have to keep a list
+ of all the dropped variables because they must be
+ free()'d, but can't be until we know that there
+ aren't any duplicate variable names. */
+ if (head)
+ tail = tail->p.mfv.next = n->var[j];
+ else
+ head = tail = n->var[j];
+ }
+ j++;
+ }
+ n->var[i] = n->var[j++];
+ }
+ if (permanent)
+ tail->p.mfv.next = NULL;
+ }
+
+ /* Check for duplicate variable names if appropriate. */
+ if (permanent && vm->n_rename)
+ {
+ struct variable **v;
+
+ if (vm->reorder_list)
+ v = vm->reorder_list; /* Reuse old buffer if possible. */
+ else
+ v = xmalloc (sizeof *v * n->nvar);
+ memcpy (v, n->var, sizeof *v * n->nvar);
+ forward = 1, positional = 0;
+ qsort (v, n->nvar, sizeof *v, compare_variables);
+ for (i = 1; i < n->nvar; i++)
+ if (!strcmp (n->var[i]->name, n->var[i - 1]->name))
+ {
+ msg (SE, _("Duplicate variable name `%s' after renaming."),
+ n->var[i]->name);
+ if (vm->reorder_list == NULL)
+ free (v);
+ n->var = save_var;
+ return NULL;
+ }
+ if (vm->reorder_list == NULL)
+ free (v);
+ }
+
+ /* Delete unwanted variables and finalize renaming if
+ appropriate. */
+ if (permanent)
+ {
+ /* Delete dropped variables for good. */
+ for (; head; head = tail)
+ {
+ tail = head->p.mfv.next;
+ clear_variable (n, head);
+ free (head);
+ }
+
+ /* Remove names from all renamed variables. */
+ head = NULL;
+ for (i = 0; i < n->nvar; i++)
+ if (n->var[i]->p.mfv.new_name[0])
+ {
+ avl_force_delete (n->var_by_name, n->var[i]);
+ if (head)
+ tail = tail->p.mfv.next = n->var[i];
+ else
+ head = tail = n->var[i];
+ }
+ if (head)
+ tail->p.mfv.next = NULL;
+
+ /* Put names onto renamed variables. */
+ for (; head; head = head->p.mfv.next)
+ {
+ strcpy (head->name, head->p.mfv.new_name);
+ avl_force_insert (n->var_by_name, head);
+ }
+ free (save_var);
+
+ /* As a final step the index fields must be redone. */
+ for (i = 0; i < n->nvar; i++)
+ n->var[i]->index = i;
+ }
+
+ return n;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdlib.h>
+#include "cases.h"
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* Parses the NUMERIC command. */
+int
+cmd_numeric (void)
+{
+ int i;
+
+ /* Names of variables to create. */
+ char **v;
+ int nv;
+
+ /* Format spec for variables to create. f.type==-1 if default is to
+ be used. */
+ struct fmt_spec f;
+
+ lex_match_id ("NUMERIC");
+ do
+ {
+ if (!parse_DATA_LIST_vars (&v, &nv, PV_NONE))
+ return CMD_PART_SUCCESS_MAYBE;
+
+ /* Get the optional format specification. */
+ if (lex_match ('('))
+ {
+ if (!parse_format_specifier (&f, 0))
+ goto fail;
+ if (formats[f.type].cat & FCAT_STRING)
+ {
+ msg (SE, _("Format type %s may not be used with a numeric "
+ "variable."), fmt_to_string (&f));
+ goto fail;
+ }
+
+ if (!lex_match (')'))
+ {
+ msg (SE, _("`)' expected after output format."));
+ goto fail;
+ }
+ }
+ else
+ f.type = -1;
+
+ /* Create each variable. */
+ for (i = 0; i < nv; i++)
+ {
+ struct variable *new_var = create_variable (&default_dict, v[i],
+ NUMERIC, 0);
+ if (!new_var)
+ msg (SE, _("There is already a variable named %s."), v[i]);
+ else
+ {
+ if (f.type != -1)
+ new_var->print = new_var->write = f;
+ envector (new_var);
+ }
+ }
+
+ /* Clean up. */
+ for (i = 0; i < nv; i++)
+ free (v[i]);
+ free (v);
+ }
+ while (lex_match ('/'));
+
+ return lex_end_of_command ();
+
+ /* If we have an error at a point where cleanup is required,
+ flow-of-control comes here. */
+fail:
+ for (i = 0; i < nv; i++)
+ free (v[i]);
+ free (v);
+ return CMD_PART_SUCCESS_MAYBE;
+}
+
+/* Parses the STRING command. */
+int
+cmd_string (void)
+{
+ int i;
+
+ /* Names of variables to create. */
+ char **v;
+ int nv;
+
+ /* Format spec for variables to create. */
+ struct fmt_spec f;
+
+ /* Width of variables to create. */
+ int width;
+
+ lex_match_id ("STRING");
+ do
+ {
+ if (!parse_DATA_LIST_vars (&v, &nv, PV_NONE))
+ return CMD_PART_SUCCESS_MAYBE;
+
+ if (!lex_force_match ('(')
+ || !parse_format_specifier (&f, 0))
+ goto fail;
+ if (!(formats[f.type].cat & FCAT_STRING))
+ {
+ msg (SE, _("Format type %s may not be used with a string "
+ "variable."), fmt_to_string (&f));
+ goto fail;
+ }
+
+ if (!lex_match (')'))
+ {
+ msg (SE, _("`)' expected after output format."));
+ goto fail;
+ }
+
+ switch (f.type)
+ {
+ case FMT_A:
+ width = f.w;
+ break;
+ case FMT_AHEX:
+ width = f.w / 2;
+ break;
+ default:
+ assert (0);
+ }
+
+ /* Create each variable. */
+ for (i = 0; i < nv; i++)
+ {
+ struct variable *new_var = create_variable (&default_dict, v[i],
+ ALPHA, width);
+ if (!new_var)
+ msg (SE, _("There is already a variable named %s."), v[i]);
+ else
+ {
+ new_var->print = new_var->write = f;
+ envector (new_var);
+ }
+ }
+
+ /* Clean up. */
+ for (i = 0; i < nv; i++)
+ free (v[i]);
+ free (v);
+ }
+ while (lex_match ('/'));
+
+ return lex_end_of_command ();
+
+ /* If we have an error at a point where cleanup is required,
+ flow-of-control comes here. */
+fail:
+ for (i = 0; i < nv; i++)
+ free (v[i]);
+ free (v);
+ return CMD_PART_SUCCESS_MAYBE;
+}
+
+/* Parses the LEAVE command. */
+int
+cmd_leave (void)
+{
+ struct variable **v;
+ int nv;
+
+ int i;
+
+ lex_match_id ("LEAVE");
+ if (!parse_variables (NULL, &v, &nv, PV_NONE))
+ return CMD_FAILURE;
+ for (i = 0; i < nv; i++)
+ {
+ if (v[i]->left)
+ continue;
+ devector (v[i]);
+ v[i]->left = 1;
+ envector (v[i]);
+ }
+ free (v);
+
+ return lex_end_of_command ();
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <errno.h>
+#include <ctype.h>
+#include "alloc.h"
+#include "approx.h"
+#include "error.h"
+#include "filename.h"
+#include "lexer.h"
+#include "misc.h"
+#include "output.h"
+#include "settings.h"
+#include "str.h"
+
+/* FIXME? Should the output configuration format be changed to
+ drivername:classname:devicetype:options, where devicetype is zero
+ or more of screen, printer, listing? */
+
+/* FIXME: Have the reentrancy problems been solved? */
+
+/* Where the output driver name came from. */
+enum
+ {
+ OUTP_S_COMMAND_LINE, /* Specified by the user. */
+ OUTP_S_INIT_FILE /* `default' or the init file. */
+ };
+
+/* Names the output drivers to be used. */
+struct outp_names
+ {
+ char *name; /* Name of the output driver. */
+ int source; /* OUTP_S_* */
+ struct outp_names *next, *prev;
+ };
+
+/* Defines an init file macro. */
+struct outp_defn
+ {
+ char *key;
+ char *value;
+ struct outp_defn *next, *prev;
+ };
+
+static struct outp_defn *outp_macros;
+static struct outp_names *outp_configure_vec;
+
+struct outp_driver_class_list *outp_class_list;
+struct outp_driver *outp_driver_list;
+
+char *outp_title;
+char *outp_subtitle;
+
+/* A set of OUTP_DEV_* bits indicating the devices that are
+ disabled. */
+int disabled_devices;
+
+static void destroy_driver (struct outp_driver *);
+static void configure_driver (char *);
+
+#if GLOBAL_DEBUGGING
+/* This mechanism attempts to catch reentrant use of outp_driver_list. */
+static int iterating_driver_list;
+
+#define reentrancy() msg (FE, _("Attempt to iterate driver list reentrantly."))
+#endif
+
+/* Add a class to the class list. */
+static void
+add_class (struct outp_class *class)
+{
+ struct outp_driver_class_list *new_list = xmalloc (sizeof *new_list);
+
+ new_list->class = class;
+ new_list->ref_count = 0;
+
+ if (!outp_class_list)
+ {
+ outp_class_list = new_list;
+ new_list->next = NULL;
+ }
+ else
+ {
+ new_list->next = outp_class_list;
+ outp_class_list = new_list;
+ }
+}
+
+/* Finds the outp_names in outp_configure_vec with name between BP and
+ EP exclusive. */
+static struct outp_names *
+search_names (char *bp, char *ep)
+{
+ struct outp_names *n;
+
+ for (n = outp_configure_vec; n; n = n->next)
+ if ((int) strlen (n->name) == ep - bp && !memcmp (n->name, bp, ep - bp))
+ return n;
+ return NULL;
+}
+
+/* Deletes outp_names NAME from outp_configure_vec. */
+static void
+delete_name (struct outp_names * n)
+{
+ free (n->name);
+ if (n->prev)
+ n->prev->next = n->next;
+ if (n->next)
+ n->next->prev = n->prev;
+ if (n == outp_configure_vec)
+ outp_configure_vec = n->next;
+ free (n);
+}
+
+/* Adds the name between BP and EP exclusive to list
+ outp_configure_vec with source SOURCE. */
+static void
+add_name (char *bp, char *ep, int source)
+{
+ struct outp_names *n = xmalloc (sizeof *n);
+ n->name = xmalloc (ep - bp + 1);
+ memcpy (n->name, bp, ep - bp);
+ n->name[ep - bp] = 0;
+ n->source = source;
+ n->next = outp_configure_vec;
+ n->prev = NULL;
+ if (outp_configure_vec)
+ outp_configure_vec->prev = n;
+ outp_configure_vec = n;
+}
+
+/* Checks that outp_configure_vec is empty, bitches & clears it if it
+ isn't. */
+static void
+check_configure_vec (void)
+{
+ struct outp_names *n;
+
+ for (n = outp_configure_vec; n; n = n->next)
+ if (n->source == OUTP_S_COMMAND_LINE)
+ msg (ME, _("Unknown output driver `%s'."), n->name);
+ else
+ msg (IE, _("Output driver `%s' referenced but never defined."), n->name);
+ outp_configure_clear ();
+}
+
+/* Searches outp_configure_vec for the name between BP and EP
+ exclusive. If found, it is deleted, then replaced by the names
+ given in EP+1, if any. */
+static void
+expand_name (char *bp, char *ep)
+{
+ struct outp_names *n = search_names (bp, ep);
+ if (!n)
+ return;
+ delete_name (n);
+
+ bp = ep + 1;
+ for (;;)
+ {
+ while (isspace ((unsigned char) *bp))
+ bp++;
+ ep = bp;
+ while (*ep && !isspace ((unsigned char) *ep))
+ ep++;
+ if (bp == ep)
+ return;
+ if (!search_names (bp, ep))
+ add_name (bp, ep, OUTP_S_INIT_FILE);
+ bp = ep;
+ }
+}
+
+/* Looks for a macro with key KEY, and returns the corresponding value
+ if found, or NULL if not. */
+const char *
+find_defn_value (const char *key)
+{
+ static char buf[INT_DIGITS + 1];
+ struct outp_defn *d;
+
+ for (d = outp_macros; d; d = d->next)
+ if (!strcmp (key, d->key))
+ return d->value;
+ if (!strcmp (key, "viewwidth"))
+ {
+ sprintf (buf, "%d", set_viewwidth);
+ return buf;
+ }
+ else if (!strcmp (key, "viewlength"))
+ {
+ sprintf (buf, "%d", set_viewlength);
+ return buf;
+ }
+ else
+ return getenv (key);
+}
+
+/* Initializes global variables. */
+int
+outp_init (void)
+{
+ extern struct outp_class ascii_class;
+#if !NO_POSTSCRIPT
+ extern struct outp_class postscript_class;
+ extern struct outp_class epsf_class;
+#endif
+#if !NO_HTML
+ extern struct outp_class html_class;
+#endif
+
+ char def[] = "default";
+
+#if !NO_HTML
+ add_class (&html_class);
+#endif
+#if !NO_POSTSCRIPT
+ add_class (&epsf_class);
+ add_class (&postscript_class);
+#endif
+ add_class (&ascii_class);
+
+ add_name (def, &def[strlen (def)], OUTP_S_INIT_FILE);
+
+ return 1;
+}
+
+/* Deletes all the output macros. */
+static void
+delete_macros (void)
+{
+ struct outp_defn *d, *next;
+
+ for (d = outp_macros; d; d = next)
+ {
+ next = d->next;
+ free (d->key);
+ free (d->value);
+ free (d);
+ }
+}
+
+/* Reads the initialization file; initializes outp_driver_list. */
+int
+outp_read_devices (void)
+{
+ int result = 0;
+
+ char *init_fn;
+
+ FILE *f = NULL;
+ struct string line;
+ struct file_locator where;
+
+#if GLOBAL_DEBUGGING
+ if (iterating_driver_list)
+ reentrancy ();
+#endif
+
+ init_fn = fn_search_path (fn_getenv_default ("STAT_OUTPUT_INIT_FILE",
+ "devices"),
+ fn_getenv_default ("STAT_OUTPUT_INIT_PATH",
+ config_path),
+ NULL);
+ where.filename = init_fn;
+ where.line_number = 0;
+ err_push_file_locator (&where);
+
+ if (init_fn == NULL)
+ {
+ msg (IE, _("Cannot find output initialization file. Use `-vv' to view "
+ "search path."));
+ goto exit;
+ }
+
+ msg (VM (1), _("%s: Opening device description file..."), init_fn);
+ f = fopen (init_fn, "r");
+ if (f == NULL)
+ {
+ msg (IE, _("Opening %s: %s."), init_fn, strerror (errno));
+ goto exit;
+ }
+
+ ds_init (NULL, &line, 128);
+ for (;;)
+ {
+ char *cp;
+
+ if (!ds_get_config_line (f, &line, &where))
+ {
+ if (ferror (f))
+ msg (ME, _("Reading %s: %s."), init_fn, strerror (errno));
+ break;
+ }
+ for (cp = ds_value (&line); isspace ((unsigned char) *cp); cp++);
+ if (!strncmp ("define", cp, 6) && isspace ((unsigned char) cp[6]))
+ outp_configure_macro (&cp[7]);
+ else if (*cp)
+ {
+ char *ep;
+ for (ep = cp; *ep && *ep != ':' && *ep != '='; ep++);
+ if (*ep == '=')
+ expand_name (cp, ep);
+ else if (*ep == ':')
+ {
+ struct outp_names *n = search_names (cp, ep);
+ if (n)
+ {
+ configure_driver (cp);
+ delete_name (n);
+ }
+ }
+ else
+ msg (IS, _("Syntax error."));
+ }
+ }
+ result = 1;
+
+ check_configure_vec ();
+
+exit:
+ err_pop_file_locator (&where);
+ if (f && -1 == fclose (f))
+ msg (MW, _("Closing %s: %s."), init_fn, strerror (errno));
+ free (init_fn);
+ ds_destroy (&line);
+ delete_macros ();
+ if (outp_driver_list == NULL)
+ msg (MW, _("No output drivers are active."));
+
+ if (result)
+ msg (VM (2), _("Device definition file read successfully."));
+ else
+ msg (VM (1), _("Error reading device definition file."));
+ return result;
+}
+
+/* Clear the list of drivers to configure. */
+void
+outp_configure_clear (void)
+{
+ struct outp_names *n, *next;
+
+ for (n = outp_configure_vec; n; n = next)
+ {
+ next = n->next;
+ free (n->name);
+ free (n);
+ }
+ outp_configure_vec = NULL;
+}
+
+/* Adds the name BP to the list of drivers to configure into
+ outp_driver_list. */
+void
+outp_configure_add (char *bp)
+{
+ char *ep = &bp[strlen (bp)];
+ if (!search_names (bp, ep))
+ add_name (bp, ep, OUTP_S_COMMAND_LINE);
+}
+
+/* Defines one configuration macro based on the text in BP, which
+ should be of the form `KEY=VALUE'. */
+void
+outp_configure_macro (char *bp)
+{
+ struct outp_defn *d;
+ char *ep;
+
+ while (isspace ((unsigned char) *bp))
+ bp++;
+ ep = bp;
+ while (*ep && !isspace ((unsigned char) *ep) && *ep != '=')
+ ep++;
+
+ d = xmalloc (sizeof *d);
+ d->key = xmalloc (ep - bp + 1);
+ memcpy (d->key, bp, ep - bp);
+ d->key[ep - bp] = 0;
+
+ /* Earlier definitions for a particular KEY override later ones. */
+ if (find_defn_value (d->key))
+ {
+ free (d->key);
+ free (d);
+ return;
+ }
+
+ if (*ep == '=')
+ ep++;
+ while (isspace ((unsigned char) *ep))
+ ep++;
+ d->value = fn_interp_vars (ep, find_defn_value);
+ d->next = outp_macros;
+ d->prev = NULL;
+ if (outp_macros)
+ outp_macros->prev = d;
+ outp_macros = d;
+}
+
+/* Destroys all the drivers in driver list *DL and sets *DL to
+ NULL. */
+void
+destroy_list (struct outp_driver ** dl)
+{
+ struct outp_driver *d, *next;
+
+ for (d = *dl; d; d = next)
+ {
+ destroy_driver (d);
+ next = d->next;
+ free (d);
+ }
+ *dl = NULL;
+}
+
+/* Closes all the output drivers. */
+int
+outp_done (void)
+{
+#if GLOBAL_DEBUGGING
+ if (iterating_driver_list)
+ reentrancy ();
+#endif
+ destroy_list (&outp_driver_list);
+
+ return 1;
+}
+
+/* Display on stdout a list of all registered driver classes. */
+void
+outp_list_classes (void)
+{
+ int width = set_viewwidth;
+ struct outp_driver_class_list *c;
+
+ printf (_("Driver classes:\n\t"));
+ width -= 8;
+ for (c = outp_class_list; c; c = c->next)
+ {
+ if ((int) strlen (c->class->name) + 1 > width)
+ {
+ printf ("\n\t");
+ width = set_viewwidth - 8;
+ }
+ else
+ putc (' ', stdout);
+ fputs (c->class->name, stdout);
+ }
+ putc('\n', stdout);
+}
+
+static int op_token; /* `=', 'a', 0. */
+static struct string op_tokstr;
+static char *prog;
+
+/* Parses a token from prog into op_token, op_tokstr. Sets op_token
+ to '=' on an equals sign, to 'a' on a string or identifier token,
+ or to 0 at end of line. Returns the new op_token. */
+static int
+tokener (void)
+{
+ if (op_token == 0)
+ {
+ msg (IS, _("Syntax error."));
+ return 0;
+ }
+
+ while (isspace ((unsigned char) *prog))
+ prog++;
+ if (!*prog)
+ {
+ op_token = 0;
+ return 0;
+ }
+
+ if (*prog == '=')
+ op_token = *prog++;
+ else
+ {
+ ds_clear (&op_tokstr);
+
+ if (*prog == '\'' || *prog == '"')
+ {
+ int quote = *prog++;
+
+ while (*prog && *prog != quote)
+ {
+ if (*prog != '\\')
+ ds_putchar (&op_tokstr, *prog++);
+ else
+ {
+ int c;
+
+ prog++;
+ assert ((int) *prog); /* How could a line end in `\'? */
+ switch (*prog++)
+ {
+ case '\'':
+ c = '\'';
+ break;
+ case '"':
+ c = '"';
+ break;
+ case '?':
+ c = '?';
+ break;
+ case '\\':
+ c = '\\';
+ break;
+ case '}':
+ c = '}';
+ break;
+ case 'a':
+ c = '\a';
+ break;
+ case 'b':
+ c = '\b';
+ break;
+ case 'f':
+ c = '\f';
+ break;
+ case 'n':
+ c = '\n';
+ break;
+ case 'r':
+ c = '\r';
+ break;
+ case 't':
+ c = '\t';
+ break;
+ case 'v':
+ c = '\v';
+ break;
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ {
+ c = prog[-1] - '0';
+ while (*prog >= '0' && *prog <= '7')
+ c = c * 8 + *prog++ - '0';
+ }
+ break;
+ case 'x':
+ case 'X':
+ {
+ c = 0;
+ while (isxdigit ((unsigned char) *prog))
+ {
+ c *= 16;
+ if (isdigit ((unsigned char) *prog))
+ c += *prog - '0';
+ else
+ c += (tolower ((unsigned char) (*prog))
+ - 'a' + 10);
+ prog++;
+ }
+ }
+ break;
+ default:
+ msg (IS, _("Syntax error in string constant."));
+ }
+ ds_putchar (&op_tokstr, (unsigned char) c);
+ }
+ }
+ prog++;
+ }
+ else
+ while (*prog && !isspace ((unsigned char) *prog) && *prog != '=')
+ ds_putchar (&op_tokstr, *prog++);
+ op_token = 'a';
+ }
+
+ return 1;
+}
+
+/* Applies the user-specified options in string S to output driver D
+ (at configuration time). */
+static void
+parse_options (char *s, struct outp_driver * d)
+{
+ prog = s;
+ op_token = -1;
+
+ ds_init (NULL, &op_tokstr, 64);
+ while (tokener ())
+ {
+ char key[65];
+
+ if (op_token != 'a')
+ {
+ msg (IS, _("Syntax error in options."));
+ break;
+ }
+
+ ds_truncate (&op_tokstr, 64);
+ strcpy (key, ds_value (&op_tokstr));
+
+ tokener ();
+ if (op_token != '=')
+ {
+ msg (IS, _("Syntax error in options (`=' expected)."));
+ break;
+ }
+
+ tokener ();
+ if (op_token != 'a')
+ {
+ msg (IS, _("Syntax error in options (value expected after `=')."));
+ break;
+ }
+ d->class->option (d, key, &op_tokstr);
+ }
+ ds_destroy (&op_tokstr);
+}
+
+/* Find the driver in outp_driver_list with name NAME. */
+static struct outp_driver *
+find_driver (char *name)
+{
+ struct outp_driver *d;
+
+#if GLOBAL_DEBUGGING
+ if (iterating_driver_list)
+ reentrancy ();
+#endif
+ for (d = outp_driver_list; d; d = d->next)
+ if (!strcmp (d->name, name))
+ return d;
+ return NULL;
+}
+
+/* Tokenize string S into colon-separated fields, removing leading and
+ trailing whitespace on tokens. Returns a pointer to the
+ null-terminated token, which is formed by setting a NUL character
+ into the string. After the first call, subsequent calls should set
+ S to NULL. CP should be consistent across calls. Returns NULL
+ after all fields have been used up.
+
+ FIXME: Should ignore colons inside double quotes. */
+static char *
+colon_tokenize (char *s, char **cp)
+{
+ char *token;
+
+ if (!s)
+ {
+ s = *cp;
+ if (*s == 0)
+ return NULL;
+ }
+ token = s += strspn (s, " \t\v\r");
+ *cp = strchr (s, ':');
+ if (*cp == NULL)
+ s = *cp = strchr (s, 0);
+ else
+ s = (*cp)++;
+ while (s > token && strchr (" \t\v\r", s[-1]))
+ s--;
+ *s = 0;
+ return token;
+}
+
+/* String S is in format:
+ DRIVERNAME:CLASSNAME:DEVICETYPE:OPTIONS
+ Adds a driver to outp_driver_list pursuant to the specification
+ provided. */
+static void
+configure_driver (char *s)
+{
+ char *token, *cp;
+ struct outp_driver *d = NULL, *iter;
+ struct outp_driver_class_list *c = NULL;
+
+ s = fn_interp_vars (s, find_defn_value);
+
+ /* Driver name. */
+ token = colon_tokenize (s, &cp);
+ if (!token)
+ {
+ msg (IS, _("Driver name expected."));
+ goto error;
+ }
+
+ d = xmalloc (sizeof *d);
+
+ d->class = NULL;
+ d->name = xstrdup (token);
+ d->driver_open = 0;
+ d->page_open = 0;
+
+ d->next = d->prev = NULL;
+
+ d->device = OUTP_DEV_NONE;
+
+ d->ext = NULL;
+
+ /* Class name. */
+ token = colon_tokenize (NULL, &cp);
+ if (!token)
+ {
+ msg (IS, _("Class name expected."));
+ goto error;
+ }
+
+ for (c = outp_class_list; c; c = c->next)
+ if (!strcmp (c->class->name, token))
+ break;
+ if (!c)
+ {
+ msg (IS, _("Unknown output driver class `%s'."), token);
+ goto error;
+ }
+
+ d->class = c->class;
+ if (!c->ref_count && !d->class->open_global (d->class))
+ {
+ msg (IS, _("Can't initialize output driver class `%s'."),
+ d->class->name);
+ goto error;
+ }
+ c->ref_count++;
+ if (!d->class->preopen_driver (d))
+ {
+ msg (IS, _("Can't initialize output driver `%s' of class `%s'."),
+ d->name, d->class->name);
+ goto error;
+ }
+
+ /* Device types. */
+ token = colon_tokenize (NULL, &cp);
+ if (token)
+ {
+ char *sp, *type;
+
+ for (type = strtok_r (token, " \t\r\v", &sp); type;
+ type = strtok_r (NULL, " \t\r\v", &sp))
+ {
+ if (!strcmp (type, "listing"))
+ d->device |= OUTP_DEV_LISTING;
+ else if (!strcmp (type, "screen"))
+ d->device |= OUTP_DEV_SCREEN;
+ else if (!strcmp (type, "printer"))
+ d->device |= OUTP_DEV_PRINTER;
+ else
+ {
+ msg (IS, _("Unknown device type `%s'."), type);
+ goto error;
+ }
+ }
+ }
+
+ /* Options. */
+ token = colon_tokenize (NULL, &cp);
+ if (token)
+ parse_options (token, d);
+ if (!d->class->postopen_driver (d))
+ {
+ msg (IS, _("Can't complete initialization of output driver `%s' of "
+ "class `%s'."), d->name, d->class->name);
+ goto error;
+ }
+
+ /* Find like-named driver and delete. */
+ iter = find_driver (d->name);
+ if (iter)
+ destroy_driver (iter);
+
+ /* Add to list. */
+ d->next = outp_driver_list;
+ d->prev = NULL;
+ if (outp_driver_list)
+ outp_driver_list->prev = d;
+ outp_driver_list = d;
+ goto exit;
+
+error:
+ if (d)
+ destroy_driver (d);
+exit:
+ free (s);
+}
+
+/* Destroys output driver D. */
+static void
+destroy_driver (struct outp_driver *d)
+{
+ if (d->page_open)
+ d->class->close_page (d);
+ if (d->class)
+ {
+ struct outp_driver_class_list *c;
+
+ if (d->driver_open)
+ d->class->close_driver (d);
+
+ for (c = outp_class_list; c; c = c->next)
+ if (c->class == d->class)
+ break;
+ assert (c != NULL);
+
+ c->ref_count--;
+ if (c->ref_count == 0)
+ {
+ if (!d->class->close_global (d->class))
+ msg (IS, _("Can't deinitialize output driver class `%s'."),
+ d->class->name);
+ }
+ }
+ free (d->name);
+
+ /* Remove this driver from the global driver list. */
+ if (d->prev)
+ d->prev->next = d->next;
+ if (d->next)
+ d->next->prev = d->prev;
+ if (d == outp_driver_list)
+ outp_driver_list = d->next;
+}
+
+static int
+option_cmp (const void *a, const void *b)
+{
+ const struct outp_option *o1 = a;
+ const struct outp_option *o2 = b;
+ return strcmp (o1->keyword, o2->keyword);
+}
+
+/* Tries to match S as one of the keywords in TAB, with corresponding
+ information structure INFO. Returns category code or 0 on failure;
+ if category code is negative then stores subcategory in *SUBCAT. */
+int
+outp_match_keyword (const char *s, struct outp_option *tab,
+ struct outp_option_info *info, int *subcat)
+{
+ char *cp;
+ struct outp_option *oip;
+
+ /* Form hash table. */
+ if (NULL == info->initial)
+ {
+ /* Count items. */
+ int count, i;
+ char s[256], *cp;
+ struct outp_option *ptr[255], **oip;
+
+ for (count = 0; tab[count].keyword[0]; count++)
+ ;
+
+ /* Sort items. */
+ qsort (tab, count, sizeof *tab, option_cmp);
+
+ cp = s;
+ oip = ptr;
+ *cp = tab[0].keyword[0];
+ *oip++ = &tab[0];
+ for (i = 0; i < count; i++)
+ if (tab[i].keyword[0] != *cp)
+ {
+ *++cp = tab[i].keyword[0];
+ *oip++ = &tab[i];
+ }
+ *++cp = 0;
+
+ info->initial = xstrdup (s);
+ info->options = xmalloc (sizeof *info->options * (cp - s));
+ memcpy (info->options, ptr, sizeof *info->options * (cp - s));
+ }
+
+ cp = info->initial;
+ oip = *info->options;
+
+ if (s[0] == 0)
+ return 0;
+ cp = strchr (info->initial, s[0]);
+ if (!cp)
+ return 0;
+#if 0
+ printf (_("Trying to find keyword `%s'...\n"), s);
+#endif
+ oip = info->options[cp - info->initial];
+ while (oip->keyword[0] == s[0])
+ {
+#if 0
+ printf ("- %s\n", oip->keyword);
+#endif
+ if (!strcmp (s, oip->keyword))
+ {
+ if (oip->cat < 0)
+ *subcat = oip->subcat;
+ return oip->cat;
+ }
+ oip++;
+ }
+
+ return 0;
+}
+
+/* Encapsulate two characters in a single int. */
+#define TWO_CHARS(A, B) \
+ ((A) + ((B)<<8))
+
+/* Determines the size of a dimensional measurement and returns the
+ size in units of 1/72000". Units if not specified explicitly are
+ inches for values under 50, millimeters otherwise. Returns 0,
+ stores NULL to *TAIL on error; otherwise returns dimension, stores
+ address of next */
+int
+outp_evaluate_dimension (char *dimen, char **tail)
+{
+ char *s = dimen;
+ char *ptail;
+ double value;
+
+ value = strtod (s, &ptail);
+ if (ptail == s)
+ goto lossage;
+ if (*ptail == '-')
+ {
+ double b, c;
+ s = &ptail[1];
+ b = strtod (s, &ptail);
+ if (b <= 0.0 || ptail == s)
+ goto lossage;
+ if (*ptail != '/')
+ goto lossage;
+ s = &ptail[1];
+ c = strtod (s, &ptail);
+ if (c <= 0.0 || ptail == s)
+ goto lossage;
+ s = ptail;
+ if (approx_eq (c, 0.0))
+ goto lossage;
+ if (value > 0)
+ value += b / c;
+ else
+ value -= b / c;
+ }
+ else if (*ptail == '/')
+ {
+ double b;
+ s = &ptail[1];
+ b = strtod (s, &ptail);
+ if (approx_le (b, 0.0) || ptail == s)
+ goto lossage;
+ s = ptail;
+ value /= b;
+ }
+ else
+ s = ptail;
+ if (*s == 0 || isspace ((unsigned char) *s))
+ {
+ if (value < 50.0)
+ value *= 72000;
+ else
+ value *= 72000 / 25.4;
+ }
+ else
+ {
+ double factor;
+
+ /* Standard TeX units are supported. */
+ if (*s == '"')
+ factor = 72000, s++;
+ else
+ switch (TWO_CHARS (s[0], s[1]))
+ {
+ case TWO_CHARS ('p', 't'):
+ factor = 72000 / 72.27;
+ break;
+ case TWO_CHARS ('p', 'c'):
+ factor = 72000 / 72.27 * 12.0;
+ break;
+ case TWO_CHARS ('i', 'n'):
+ factor = 72000;
+ break;
+ case TWO_CHARS ('b', 'p'):
+ factor = 72000 / 72.0;
+ break;
+ case TWO_CHARS ('c', 'm'):
+ factor = 72000 / 2.54;
+ break;
+ case TWO_CHARS ('m', 'm'):
+ factor = 72000 / 25.4;
+ break;
+ case TWO_CHARS ('d', 'd'):
+ factor = 72000 / 72.27 * 1.0700086;
+ break;
+ case TWO_CHARS ('c', 'c'):
+ factor = 72000 / 72.27 * 12.840104;
+ break;
+ case TWO_CHARS ('s', 'p'):
+ factor = 72000 / 72.27 / 65536.0;
+ break;
+ default:
+ msg (SE, _("Unit \"%s\" is unknown in dimension \"%s\"."), s, dimen);
+ *tail = NULL;
+ return 0;
+ }
+ ptail += 2;
+ value *= factor;
+ }
+ if (approx_lt (value, 0.0))
+ goto lossage;
+ if (tail)
+ *tail = ptail;
+ return value + 0.5;
+
+lossage:
+ *tail = NULL;
+ msg (SE, _("Bad dimension \"%s\"."), dimen);
+ return 0;
+}
+
+/* Stores the dimensions in 1/72000" units of paper identified by
+ SIZE, which is of form `HORZ x VERT' or `HORZ by VERT' where each
+ of HORZ and VERT are dimensions, into *H and *V. Return nonzero on
+ success. */
+static int
+internal_get_paper_size (char *size, int *h, int *v)
+{
+ char *tail;
+
+ while (isspace ((unsigned char) *size))
+ size++;
+ *h = outp_evaluate_dimension (size, &tail);
+ if (tail == NULL)
+ return 0;
+ while (isspace ((unsigned char) *tail))
+ tail++;
+ if (*tail == 'x')
+ tail++;
+ else if (*tail == 'b' && tail[1] == 'y')
+ tail += 2;
+ else
+ {
+ msg (SE, _("`x' expected in paper size `%s'."), size);
+ return 0;
+ }
+ *v = outp_evaluate_dimension (tail, &tail);
+ if (tail == NULL)
+ return 0;
+ while (isspace ((unsigned char) *tail))
+ tail++;
+ if (*tail)
+ {
+ msg (SE, _("Trailing garbage `%s' on paper size `%s'."), tail, size);
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Stores the dimensions, in 1/72000" units, of paper identified by
+ SIZE into *H and *V. SIZE may be a pair of dimensions of form `H x
+ V', or it may be a case-insensitive paper identifier, which is
+ looked up in the `papersize' configuration file. Returns nonzero
+ on success. May modify SIZE. */
+/* Don't read further unless you've got a strong stomach. */
+int
+outp_get_paper_size (char *size, int *h, int *v)
+{
+ struct paper_size
+ {
+ char *name;
+ int use;
+ int h, v;
+ };
+
+ static struct paper_size cache[4];
+ static int use;
+
+ FILE *f;
+ char *pprsz_fn;
+
+ struct string line;
+ struct file_locator where;
+
+ int free_it = 0;
+ int result = 0;
+ int min_value, min_index;
+ char *ep;
+ int i;
+
+ while (isspace ((unsigned char) *size))
+ size++;
+ if (isdigit ((unsigned char) *size))
+ return internal_get_paper_size (size, h, v);
+ ep = size;
+ while (*ep)
+ ep++;
+ while (isspace ((unsigned char) *ep) && ep >= size)
+ ep--;
+ if (ep == size)
+ {
+ msg (SE, _("Paper size name must not be empty."));
+ return 0;
+ }
+
+ ep++;
+ if (*ep)
+ *ep = 0;
+
+ use++;
+ for (i = 0; i < 4; i++)
+ if (cache[i].name != NULL && !strcasecmp (cache[i].name, size))
+ {
+ *h = cache[i].h;
+ *v = cache[i].v;
+ cache[i].use = use;
+ return 1;
+ }
+
+ pprsz_fn = fn_search_path (fn_getenv_default ("STAT_OUTPUT_PAPERSIZE_FILE",
+ "papersize"),
+ fn_getenv_default ("STAT_OUTPUT_INIT_PATH",
+ config_path),
+ NULL);
+
+ where.filename = pprsz_fn;
+ where.line_number = 0;
+ err_push_file_locator (&where);
+
+ if (pprsz_fn == NULL)
+ {
+ msg (IE, _("Cannot find `papersize' configuration file."));
+ goto exit;
+ }
+
+ msg (VM (1), _("%s: Opening paper size definition file..."), pprsz_fn);
+ f = fopen (pprsz_fn, "r");
+ if (!f)
+ {
+ msg (IE, _("Opening %s: %s."), pprsz_fn, strerror (errno));
+ goto exit;
+ }
+
+ ds_init (NULL, &line, 128);
+ for (;;)
+ {
+ char *cp, *bp, *ep;
+
+ if (!ds_get_config_line (f, &line, &where))
+ {
+ if (ferror (f))
+ msg (ME, _("Reading %s: %s."), pprsz_fn, strerror (errno));
+ break;
+ }
+ for (cp = ds_value (&line); isspace ((unsigned char) *cp); cp++);
+ if (*cp == 0)
+ continue;
+ if (*cp != '"')
+ goto lex_error;
+ for (bp = ep = cp + 1; *ep && *ep != '"'; ep++);
+ if (!*ep)
+ goto lex_error;
+ *ep = 0;
+ if (0 != strcasecmp (bp, size))
+ continue;
+
+ for (cp = ep + 1; isspace ((unsigned char) *cp); cp++);
+ if (*cp == '=')
+ {
+ size = xmalloc (ep - bp + 1);
+ strcpy (size, bp);
+ free_it = 1;
+ continue;
+ }
+ size = &ep[1];
+ break;
+
+ lex_error:
+ msg (IE, _("Syntax error in paper size definition."));
+ }
+
+ /* We found the one we want! */
+ result = internal_get_paper_size (size, h, v);
+ if (result)
+ {
+ min_value = cache[0].use;
+ min_index = 0;
+ for (i = 1; i < 4; i++)
+ if (cache[0].use < min_value)
+ {
+ min_value = cache[i].use;
+ min_index = i;
+ }
+ free (cache[min_index].name);
+ cache[min_index].name = xstrdup (size);
+ cache[min_index].use = use;
+ cache[min_index].h = *h;
+ cache[min_index].v = *v;
+ }
+
+exit:
+ err_pop_file_locator (&where);
+ ds_destroy (&line);
+ if (free_it)
+ free (size);
+
+ if (result)
+ msg (VM (2), _("Paper size definition file read successfully."));
+ else
+ msg (VM (1), _("Error reading paper size definition file."));
+
+ return result;
+}
+
+/* If D is NULL, returns the first enabled driver if any, NULL if
+ none. Otherwise D must be the last driver returned by this
+ function, in which case the next enabled driver is returned or NULL
+ if that was the last. */
+struct outp_driver *
+outp_drivers (struct outp_driver *d)
+{
+#if GLOBAL_DEBUGGING
+ struct outp_driver *orig_d = d;
+#endif
+
+ for (;;)
+ {
+ if (d == NULL)
+ d = outp_driver_list;
+ else
+ d = d->next;
+
+ if (d == NULL
+ || (d->driver_open
+ && (d->device == 0
+ || (d->device & disabled_devices) != d->device)))
+ break;
+ }
+
+#if GLOBAL_DEBUGGING
+ if (d && !orig_d)
+ {
+ if (iterating_driver_list++)
+ reentrancy ();
+ }
+ else if (orig_d && !d)
+ {
+ assert (iterating_driver_list == 1);
+ iterating_driver_list = 0;
+ }
+#endif
+
+ return d;
+}
+
+/* Enables (if ENABLE is nonzero) or disables (if ENABLE is zero) the
+ device(s) given in mask DEVICE. */
+void
+outp_enable_device (int enable, int device)
+{
+ if (enable)
+ disabled_devices &= ~device;
+ else
+ disabled_devices |= device;
+}
+
+/* Ejects the paper on device D, if the page is not blank. */
+int
+outp_eject_page (struct outp_driver *d)
+{
+ if (d->page_open == 0)
+ return 1;
+
+ if (d->cp_y != 0)
+ {
+ d->cp_x = d->cp_y = 0;
+
+ if (d->class->close_page (d) == 0)
+ msg (ME, _("Error closing page on %s device of %s class."),
+ d->name, d->class->name);
+ if (d->class->open_page (d) == 0)
+ {
+ msg (ME, _("Error opening page on %s device of %s class."),
+ d->name, d->class->name);
+ return 0;
+ }
+ }
+ return 1;
+}
+
+/* Returns the width of string S, in device units, when output on
+ device D. */
+int
+outp_string_width (struct outp_driver *d, const char *s)
+{
+ struct outp_text text;
+
+ text.options = OUTP_T_JUST_LEFT;
+ ls_init (&text.s, (char *) s, strlen (s));
+ d->class->text_metrics (d, &text);
+
+ return text.h;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !output_h
+#define output_h 1
+
+#include "str.h"
+
+/* A rectangle. */
+struct rect
+ {
+ int x1, y1; /* Upper left. */
+ int x2, y2; /* Lower right, not part of the rectangle. */
+ };
+
+#if __GNUC__ > 1 && defined(__OPTIMIZE__)
+extern inline int width (rect r) __attribute__ ((const));
+extern inline int height (rect r) __attribute__ ((const));
+
+extern inline int
+width (rect r)
+{
+ return r.x2 - r.x1 + 1;
+}
+
+extern inline int
+height (rect r)
+{
+ return r.y2 - r.y1 + 1;
+}
+#else /* !__GNUC__ */
+#define width(R) \
+ ((R).x2 - (R).x1 + 1)
+#define height(R) \
+ ((R).y2 - (R).y1 + 1)
+#endif /* !__GNUC__ */
+
+/* Color descriptor. */
+struct color
+ {
+ int flags; /* 0=normal, 1=transparent (ignore r,g,b). */
+ int r; /* Red component, 0-65535. */
+ int g; /* Green component, 0-65535. */
+ int b; /* Blue component, 0-65535. */
+ };
+
+/* Mount positions for the four basic fonts. Do not change the values. */
+enum
+ {
+ OUTP_F_R, /* Roman font. */
+ OUTP_F_I, /* Italic font. */
+ OUTP_F_B, /* Bold font. */
+ OUTP_F_BI /* Bold-italic font. */
+ };
+
+/* Line styles. These must match:
+ som.h:SLIN_*
+ ascii.c:ascii_line_*()
+ postscript.c:ps_line_*() */
+enum
+ {
+ OUTP_L_NONE = 0, /* No line. */
+ OUTP_L_SINGLE = 1, /* Single line. */
+ OUTP_L_DOUBLE = 2, /* Double line. */
+ OUTP_L_SPECIAL = 3, /* Special line of driver-defined style. */
+
+ OUTP_L_COUNT /* Number of line styles. */
+ };
+
+/* Contains a line style for each part of an intersection. */
+struct outp_styles
+ {
+ int l; /* left */
+ int t; /* top */
+ int r; /* right */
+ int b; /* bottom */
+ };
+
+/* Text display options. */
+enum
+ {
+ OUTP_T_NONE = 0,
+
+ /* Must match tab.h:TAB_*. */
+ OUTP_T_JUST_MASK = 00003, /* Justification mask. */
+ OUTP_T_JUST_RIGHT = 00000, /* Right justification. */
+ OUTP_T_JUST_LEFT = 00001, /* Left justification. */
+ OUTP_T_JUST_CENTER = 00002, /* Center justification. */
+
+ OUTP_T_HORZ = 00010, /* Horizontal size is specified. */
+ OUTP_T_VERT = 00020, /* (Max) vertical size is specified. */
+
+ OUTP_T_0 = 00140, /* Normal orientation. */
+ OUTP_T_CC90 = 00040, /* 90 degrees counterclockwise. */
+ OUTP_T_CC180 = 00100, /* 180 degrees counterclockwise. */
+ OUTP_T_CC270 = 00140, /* 270 degrees counterclockwise. */
+ OUTP_T_C90 = 00140, /* 90 degrees clockwise. */
+ OUTP_T_C180 = 00100, /* 180 degrees clockwise. */
+ OUTP_T_C270 = 00040, /* 270 degrees clockwise. */
+
+ /* Internal use by drivers only. */
+ OUTP_T_INTERNAL_DRAW = 01000 /* 1=Draw the text, 0=Metrics only. */
+ };
+
+/* Describes text output. */
+struct outp_text
+ {
+ /* Public. */
+ int options; /* What is specified. */
+ struct len_string s; /* String. */
+ int h, v; /* Horizontal, vertical size. */
+ int x, y; /* Position. */
+
+ /* Internal use only. */
+ int w, l; /* Width, length. */
+ };
+
+struct som_table;
+struct outp_driver;
+
+/* Defines a class of output driver. */
+struct outp_class
+ {
+ /* Basic class information. */
+ const char *name; /* Name of this driver class. */
+ int magic; /* Driver-specific constant. */
+ int special; /* Boolean value. */
+
+ /* Static member functions. */
+ int (*open_global) (struct outp_class *);
+ int (*close_global) (struct outp_class *);
+ int *(*font_sizes) (struct outp_class *, int *n_valid_sizes);
+
+ /* Virtual member functions. */
+ int (*preopen_driver) (struct outp_driver *);
+ void (*option) (struct outp_driver *, const char *key,
+ const struct string *value);
+ int (*postopen_driver) (struct outp_driver *);
+ int (*close_driver) (struct outp_driver *);
+
+ int (*open_page) (struct outp_driver *);
+ int (*close_page) (struct outp_driver *);
+
+ /* special != 0: Used to submit tables for output. */
+ void (*submit) (struct outp_driver *, struct som_table *);
+
+ /* special != 0: Methods below need not be defined. */
+
+ /* Line methods. */
+ void (*line_horz) (struct outp_driver *, const struct rect *,
+ const struct color *, int style);
+ void (*line_vert) (struct outp_driver *, const struct rect *,
+ const struct color *, int style);
+ void (*line_intersection) (struct outp_driver *, const struct rect *,
+ const struct color *,
+ const struct outp_styles *style);
+
+ /* Drawing methods. */
+ void (*box) (struct outp_driver *, const struct rect *,
+ const struct color *bord, const struct color *fill);
+ void (*polyline_begin) (struct outp_driver *, const struct color *);
+ void (*polyline_point) (struct outp_driver *, int, int);
+ void (*polyline_end) (struct outp_driver *);
+
+ /* Text methods. */
+ void (*text_set_font_by_name) (struct outp_driver *, const char *s);
+ void (*text_set_font_by_position) (struct outp_driver *, int);
+ void (*text_set_font_family) (struct outp_driver *, const char *s);
+ const char *(*text_get_font_name) (struct outp_driver *);
+ const char *(*text_get_font_family) (struct outp_driver *);
+ int (*text_set_size) (struct outp_driver *, int);
+ int (*text_get_size) (struct outp_driver *, int *em_width);
+ void (*text_metrics) (struct outp_driver *, struct outp_text *);
+ void (*text_draw) (struct outp_driver *, struct outp_text *);
+ };
+
+/* Device types. */
+enum
+ {
+ OUTP_DEV_NONE = 0, /* None of the below. */
+ OUTP_DEV_LISTING = 001, /* Listing device. */
+ OUTP_DEV_SCREEN = 002, /* Screen device. */
+ OUTP_DEV_PRINTER = 004, /* Printer device. */
+ OUTP_DEV_DISABLED = 010 /* Broken device. */
+ };
+
+/* Defines the configuration of an output driver. */
+struct outp_driver
+ {
+ struct outp_class *class; /* Driver class. */
+ char *name; /* Name of this driver. */
+ int driver_open; /* 1=driver is open, 0=driver is closed. */
+ int page_open; /* 1=page is open, 0=page is closed. */
+
+ struct outp_driver *next, *prev; /* Next, previous output driver in list. */
+
+ int device; /* Zero or more of OUTP_DEV_*. */
+ int res, horiz, vert; /* Device resolution. */
+ int width, length; /* Page size. */
+
+ int cp_x, cp_y; /* Current position. */
+ int font_height; /* Default font character height. */
+ int prop_em_width; /* Proportional font em width. */
+ int fixed_width; /* Fixed-pitch font character width. */
+ int horiz_line_width[OUTP_L_COUNT]; /* Width of horizontal lines. */
+ int vert_line_width[OUTP_L_COUNT]; /* Width of vertical lines. */
+ int horiz_line_spacing[1 << OUTP_L_COUNT];
+ int vert_line_spacing[1 << OUTP_L_COUNT];
+
+ void *ext; /* Private extension record. */
+ void *prc; /* Per-procedure extension record. */
+ };
+
+/* Option structure for the keyword recognizer. */
+struct outp_option
+ {
+ const char *keyword; /* Keyword name. */
+ int cat; /* Category. */
+ int subcat; /* Subcategory. */
+ };
+
+/* Information structure for the keyword recognizer. */
+struct outp_option_info
+ {
+ char *initial; /* Initial characters. */
+ struct outp_option **options; /* Search starting points. */
+ };
+
+/* A list of driver classes. */
+struct outp_driver_class_list
+ {
+ int ref_count;
+ struct outp_class *class;
+ struct outp_driver_class_list *next;
+ };
+
+/* List of known output driver classes. */
+extern struct outp_driver_class_list *outp_class_list;
+
+/* List of configured output drivers. */
+extern struct outp_driver *outp_driver_list;
+
+/* Title, subtitle. */
+extern char *outp_title;
+extern char *outp_subtitle;
+
+int outp_init (void);
+int outp_read_devices (void);
+int outp_done (void);
+
+void outp_configure_clear (void);
+void outp_configure_add (char *);
+void outp_configure_macro (char *);
+
+void outp_list_classes (void);
+
+void outp_enable_device (int enable, int device);
+struct outp_driver *outp_drivers (struct outp_driver *);
+
+int outp_match_keyword (const char *, struct outp_option *,
+ struct outp_option_info *, int *);
+
+int outp_evaluate_dimension (char *, char **);
+int outp_get_paper_size (char *, int *h, int *v);
+
+int outp_eject_page (struct outp_driver *);
+
+int outp_string_width (struct outp_driver *, const char *);
+
+/* Imported from som-frnt.c. */
+void som_destroy_driver (struct outp_driver *);
+
+#endif /* output.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <errno.h>
+#include <math.h>
+#include "alloc.h"
+#include "avl.h"
+#include "file-handle.h"
+#include "format.h"
+#include "getline.h"
+#include "magic.h"
+#include "misc.h"
+#include "pfm.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* pfm's file_handle extension. */
+struct pfm_fhuser_ext
+ {
+ FILE *file; /* Actual file. */
+
+ struct dictionary *dict; /* File's dictionary. */
+ int weight_index; /* 0-based index of weight variable, or -1. */
+
+ unsigned char *trans; /* 256-byte character set translation table. */
+
+ int nvars; /* Number of variables. */
+ int *vars; /* Variable widths, 0 for numeric. */
+ int case_size; /* Number of `value's per case. */
+
+ unsigned char buf[83]; /* Input buffer. */
+ unsigned char *bp; /* Buffer pointer. */
+ int cc; /* Current character. */
+ };
+
+static struct fh_ext_class pfm_r_class;
+
+static int
+corrupt_msg (struct file_handle *h, const char *format,...)
+ __attribute__ ((format (printf, 2, 3)));
+
+/* Displays a corruption error. */
+static int
+corrupt_msg (struct file_handle *h, const char *format, ...)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+ char buf[1024];
+
+ {
+ va_list args;
+
+ va_start (args, format);
+ vsnprintf (buf, 1024, format, args);
+ va_end (args);
+ }
+
+ {
+ char *title;
+ struct error e;
+
+ e.class = ME;
+ getl_location (&e.where.filename, &e.where.line_number);
+ e.title = title = local_alloc (strlen (h->fn) + 80);
+ sprintf (title, _("portable file %s corrupt at offset %ld: "),
+ h->fn, ftell (ext->file) - (82 - (long) (ext->bp - ext->buf)));
+ e.text = buf;
+
+ err_vmsg (&e);
+
+ local_free (title);
+ }
+
+ return 0;
+}
+
+/* Closes a portable file after we're done with it. */
+static void
+pfm_close (struct file_handle * h)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+
+ if (EOF == fclose (ext->file))
+ msg (ME, _("%s: Closing portable file: %s."), h->fn, strerror (errno));
+ free (ext->vars);
+ free (ext->trans);
+ free (h->ext);
+}
+
+/* Displays the message X with corrupt_msg, then jumps to the lossage
+ label. */
+#define lose(X) \
+ do \
+ { \
+ corrupt_msg X; \
+ goto lossage; \
+ } \
+ while (0)
+
+/* Read an 80-character line into handle H's buffer. Return
+ success. */
+static int
+fill_buf (struct file_handle *h)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+
+ if (80 != fread (ext->buf, 1, 80, ext->file))
+ lose ((h, _("Unexpected end of file.")));
+
+ /* PORTME: line ends. */
+ {
+ int c;
+
+ c = getc (ext->file);
+ if (c != '\n' && c != '\r')
+ lose ((h, _("Bad line end.")));
+
+ c = getc (ext->file);
+ if (c != '\n' && c != '\r')
+ ungetc (c, ext->file);
+ }
+
+ if (ext->trans)
+ {
+ int i;
+
+ for (i = 0; i < 80; i++)
+ ext->buf[i] = ext->trans[ext->buf[i]];
+ }
+
+ ext->bp = ext->buf;
+
+ return 1;
+
+ lossage:
+ return 0;
+}
+
+/* Read a single character into cur_char. Return success; */
+static int
+read_char (struct file_handle *h)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+
+ if (ext->bp >= &ext->buf[80] && !fill_buf (h))
+ return 0;
+ ext->cc = *ext->bp++;
+ return 1;
+}
+
+/* Advance a single character. */
+#define advance() if (!read_char (h)) goto lossage
+
+/* Skip a single character if present, and return whether it was
+ skipped. */
+static inline int
+skip_char (struct file_handle *h, int c)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+
+ if (ext->cc == c)
+ {
+ advance ();
+ return 1;
+ }
+ lossage:
+ return 0;
+}
+
+/* Skip a single character if present, and return whether it was
+ skipped. */
+#define match(C) skip_char (h, C)
+
+static int read_header (struct file_handle *h);
+static int read_version_data (struct file_handle *h, struct pfm_read_info *inf);
+static int read_variables (struct file_handle *h);
+static int read_value_label (struct file_handle *h);
+void dump_dictionary (struct dictionary *dict);
+
+/* Reads the dictionary from file with handle H, and returns it in a
+ dictionary structure. This dictionary may be modified in order to
+ rename, reorder, and delete variables, etc. */
+struct dictionary *
+pfm_read_dictionary (struct file_handle *h, struct pfm_read_info *inf)
+{
+ /* The file handle extension record. */
+ struct pfm_fhuser_ext *ext;
+
+ /* Check whether the file is already open. */
+ if (h->class == &pfm_r_class)
+ {
+ ext = h->ext;
+ return ext->dict;
+ }
+ else if (h->class != NULL)
+ {
+ msg (ME, _("Cannot read file %s as portable file: already opened "
+ "for %s."),
+ fh_handle_name (h), h->class->name);
+ return NULL;
+ }
+
+ msg (VM (1), _("%s: Opening portable-file handle %s for reading."),
+ fh_handle_filename (h), fh_handle_name (h));
+
+ /* Open the physical disk file. */
+ ext = xmalloc (sizeof (struct pfm_fhuser_ext));
+ ext->file = fopen (h->norm_fn, "rb");
+ if (ext->file == NULL)
+ {
+ msg (ME, _("An error occurred while opening \"%s\" for reading "
+ "as a portable file: %s."), h->fn, strerror (errno));
+ err_cond_fail ();
+ free (ext);
+ return NULL;
+ }
+
+ /* Initialize the sfm_fhuser_ext structure. */
+ h->class = &pfm_r_class;
+ h->ext = ext;
+ ext->dict = NULL;
+ ext->trans = NULL;
+ if (!fill_buf (h))
+ goto lossage;
+ advance ();
+
+ /* Read the header. */
+ if (!read_header (h))
+ goto lossage;
+
+ /* Read version, date info, product identification. */
+ if (!read_version_data (h, inf))
+ goto lossage;
+
+ /* Read variables. */
+ if (!read_variables (h))
+ goto lossage;
+
+ /* Value labels. */
+ while (match (77 /* D */))
+ if (!read_value_label (h))
+ goto lossage;
+
+ if (!match (79 /* F */))
+ lose ((h, _("Data record expected.")));
+
+ msg (VM (2), _("Read portable-file dictionary successfully."));
+
+#if DEBUGGING
+ dump_dictionary (ext->dict);
+#endif
+ return ext->dict;
+
+ lossage:
+ /* Come here on unsuccessful completion. */
+ msg (VM (1), _("Error reading portable-file dictionary."));
+
+ fclose (ext->file);
+ if (ext && ext->dict)
+ free_dictionary (ext->dict);
+ free (ext);
+ h->class = NULL;
+ h->ext = NULL;
+ return NULL;
+}
+\f
+/* Read a floating point value and return its value, or
+ second_lowest_value on error. */
+static double
+read_float (struct file_handle *h)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+ double num = 0.;
+ int got_dot = 0;
+ int got_digit = 0;
+ int exponent = 0;
+ int neg = 0;
+
+ /* Skip leading spaces. */
+ while (match (126 /* space */))
+ ;
+
+ if (match (137 /* * */))
+ {
+ advance (); /* Probably a dot (.) but doesn't appear to matter. */
+ return SYSMIS;
+ }
+ else if (match (141 /* - */))
+ neg = 1;
+
+ for (;;)
+ {
+ if (ext->cc >= 64 /* 0 */ && ext->cc <= 93 /* T */)
+ {
+ got_digit++;
+
+ /* Make sure that multiplication by 30 will not overflow. */
+ if (num > DBL_MAX * (1. / 30.))
+ /* The value of the digit doesn't matter, since we have already
+ gotten as many digits as can be represented in a `double'.
+ This doesn't necessarily mean the result will overflow.
+ The exponent may reduce it to within range.
+
+ We just need to record that there was another
+ digit so that we can multiply by 10 later. */
+ ++exponent;
+ else
+ num = (num * 30.0) + (ext->cc - 64);
+
+ /* Keep track of the number of digits after the decimal point.
+ If we just divided by 30 here, we would lose precision. */
+ if (got_dot)
+ --exponent;
+ }
+ else if (!got_dot && ext->cc == 127 /* . */)
+ /* Record that we have found the decimal point. */
+ got_dot = 1;
+ else
+ /* Any other character terminates the number. */
+ break;
+
+ advance ();
+ }
+
+ if (!got_digit)
+ lose ((h, "Number expected."));
+
+ if (ext->cc == 130 /* + */ || ext->cc == 141 /* - */)
+ {
+ /* Get the exponent. */
+ long int exp = 0;
+ int neg_exp = ext->cc == 141 /* - */;
+
+ for (;;)
+ {
+ advance ();
+
+ if (ext->cc < 64 /* 0 */ || ext->cc > 93 /* T */)
+ break;
+
+ if (exp > LONG_MAX / 30)
+ goto overflow;
+ exp = exp * 30 + (ext->cc - 64);
+ }
+
+ /* We don't check whether there were actually any digits, but we
+ probably should. */
+ if (neg_exp)
+ exp = -exp;
+ exponent += exp;
+ }
+
+ if (!match (142 /* / */))
+ lose ((h, _("Missing numeric terminator.")));
+
+ /* Multiply NUM by 30 to the EXPONENT power, checking for overflow. */
+
+ if (exponent < 0)
+ num *= pow (30.0, (double) exponent);
+ else if (exponent > 0)
+ {
+ if (num > DBL_MAX * pow (30.0, (double) -exponent))
+ goto overflow;
+ num *= pow (30.0, (double) exponent);
+ }
+
+ if (neg)
+ return -num;
+ else
+ return num;
+
+ overflow:
+ if (neg)
+ return -DBL_MAX / 10.;
+ else
+ return DBL_MAX / 10;
+
+ lossage:
+ return second_lowest_value;
+}
+
+/* Read an integer and return its value, or NOT_INT on failure. */
+int
+read_int (struct file_handle *h)
+{
+ double f = read_float (h);
+
+ if (f == second_lowest_value)
+ goto lossage;
+ if (floor (f) != f || f >= INT_MAX || f <= INT_MIN)
+ lose ((h, _("Bad integer format.")));
+ return f;
+
+ lossage:
+ return NOT_INT;
+}
+
+/* Reads a string and returns its value in a static buffer, or NULL on
+ failure. The buffer can be deallocated by calling with a NULL
+ argument. */
+static unsigned char *
+read_string (struct file_handle *h)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+ static char *buf;
+ int n;
+
+ if (h == NULL)
+ {
+ free (buf);
+ buf = NULL;
+ return NULL;
+ }
+ else if (buf == NULL)
+ buf = xmalloc (256);
+
+ n = read_int (h);
+ if (n == NOT_INT)
+ return NULL;
+ if (n < 0 || n > 255)
+ lose ((h, _("Bad string length %d."), n));
+
+ {
+ int i;
+
+ for (i = 0; i < n; i++)
+ {
+ buf[i] = ext->cc;
+ advance ();
+ }
+ }
+
+ buf[n] = 0;
+ return buf;
+
+ lossage:
+ return NULL;
+}
+\f
+/* Reads the 464-byte file header. */
+int
+read_header (struct file_handle *h)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+
+ /* For now at least, just ignore the vanity splash strings. */
+ {
+ int i;
+
+ for (i = 0; i < 200; i++)
+ advance ();
+ }
+
+ {
+ unsigned char src[256];
+ int trans_temp[256];
+ int i;
+
+ for (i = 0; i < 256; i++)
+ {
+ src[i] = (unsigned char) ext->cc;
+ advance ();
+ }
+
+ for (i = 0; i < 256; i++)
+ trans_temp[i] = -1;
+
+ /* 0 is used to mark untranslatable characters, so we have to mark
+ it specially. */
+ trans_temp[src[64]] = 64;
+ for (i = 0; i < 256; i++)
+ if (trans_temp[src[i]] == -1)
+ trans_temp[src[i]] = i;
+
+ ext->trans = xmalloc (256);
+ for (i = 0; i < 256; i++)
+ ext->trans[i] = trans_temp[i] == -1 ? 0 : trans_temp[i];
+
+ /* Translate the input buffer. */
+ for (i = 0; i < 80; i++)
+ ext->buf[i] = ext->trans[ext->buf[i]];
+ ext->cc = ext->trans[ext->cc];
+ }
+
+ {
+ unsigned char sig[8] = {92, 89, 92, 92, 89, 88, 91, 93};
+ int i;
+
+ for (i = 0; i < 8; i++)
+ if (!match (sig[i]))
+ lose ((h, "Missing SPSSPORT signature."));
+ }
+
+ return 1;
+
+ lossage:
+ return 0;
+}
+
+/* Reads the version and date info record, as well as product and
+ subproduct identification records if present. */
+int
+read_version_data (struct file_handle *h, struct pfm_read_info *inf)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+
+ /* Version. */
+ if (!match (74 /* A */))
+ lose ((h, "Unrecognized version code %d.", ext->cc));
+
+ /* Date. */
+ {
+ static const int map[] = {6, 7, 8, 9, 3, 4, 0, 1};
+ char *date = read_string (h);
+ int i;
+
+ if (!date)
+ return 0;
+ if (strlen (date) != 8)
+ lose ((h, _("Bad date string length %d."), strlen (date)));
+ for (i = 0; i < 8; i++)
+ {
+ if (date[i] < 64 /* 0 */ || date[i] > 73 /* 9 */)
+ lose ((h, _("Bad character in date.")));
+ if (inf)
+ inf->creation_date[map[i]] = date[i] - 64 /* 0 */ + '0';
+ }
+ if (inf)
+ {
+ inf->creation_date[2] = inf->creation_date[5] = ' ';
+ inf->creation_date[10] = 0;
+ }
+ }
+
+ /* Time. */
+ {
+ static const int map[] = {0, 1, 3, 4, 6, 7};
+ char *time = read_string (h);
+ int i;
+
+ if (!time)
+ return 0;
+ if (strlen (time) != 6)
+ lose ((h, _("Bad time string length %d."), strlen (time)));
+ for (i = 0; i < 6; i++)
+ {
+ if (time[i] < 64 /* 0 */ || time[i] > 73 /* 9 */)
+ lose ((h, _("Bad character in time.")));
+ if (inf)
+ inf->creation_time[map[i]] = time[i] - 64 /* 0 */ + '0';
+ }
+ if (inf)
+ {
+ inf->creation_time[2] = inf->creation_time[5] = ' ';
+ inf->creation_time[8] = 0;
+ }
+ }
+
+ /* Product. */
+ if (match (65 /* 1 */))
+ {
+ char *product;
+
+ product = read_string (h);
+ if (product == NULL)
+ return 0;
+ if (inf)
+ strncpy (inf->product, product, 61);
+ }
+ else if (inf)
+ inf->product[0] = 0;
+
+ /* Subproduct. */
+ if (match (67 /* 3 */))
+ {
+ char *subproduct;
+
+ subproduct = read_string (h);
+ if (subproduct == NULL)
+ return 0;
+ if (inf)
+ strncpy (inf->subproduct, subproduct, 61);
+ }
+ else if (inf)
+ inf->subproduct[0] = 0;
+ return 1;
+
+ lossage:
+ return 0;
+}
+
+static int
+convert_format (struct file_handle *h, int fmt[3], struct fmt_spec *v,
+ struct variable *vv)
+{
+ if (fmt[0] < 0
+ || (size_t) fmt[0] >= sizeof translate_fmt / sizeof *translate_fmt)
+ lose ((h, _("%s: Bad format specifier byte %d."), vv->name, fmt[0]));
+
+ v->type = translate_fmt[fmt[0]];
+ v->w = fmt[1];
+ v->d = fmt[2];
+
+ /* FIXME? Should verify the resulting specifier more thoroughly. */
+
+ if (v->type == -1)
+ lose ((h, _("%s: Bad format specifier byte (%d)."), vv->name, fmt[0]));
+ if ((vv->type == ALPHA) ^ ((formats[v->type].cat & FCAT_STRING) != 0))
+ lose ((h, _("%s variable %s has %s format specifier %s."),
+ vv->type == ALPHA ? _("String") : _("Numeric"),
+ vv->name,
+ formats[v->type].cat & FCAT_STRING ? _("string") : _("numeric"),
+ formats[v->type].name));
+ return 1;
+
+ lossage:
+ return 0;
+}
+
+/* Translation table from SPSS character code to this computer's
+ native character code (which is probably ASCII). */
+static const unsigned char spss2ascii[256] =
+ {
+ " "
+ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz ."
+ "<(+|&[]!$*);^-/|,%_>?`:$@'=\" ~- 0123456789 -() {}\\ "
+ " "
+ };
+
+/* Translate string S into ASCII. */
+static void
+asciify (char *s)
+{
+ for (; *s; s++)
+ *s = spss2ascii[(unsigned char) *s];
+}
+
+static int parse_value (struct file_handle *, union value *, struct variable *);
+
+/* Read information on all the variables. */
+static int
+read_variables (struct file_handle *h)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+ int i;
+
+ if (!match (68 /* 4 */))
+ lose ((h, _("Expected variable count record.")));
+
+ ext->nvars = read_int (h);
+ if (ext->nvars <= 0 || ext->nvars == NOT_INT)
+ lose ((h, _("Invalid number of variables %d."), ext->nvars));
+ ext->vars = xmalloc (sizeof *ext->vars * ext->nvars);
+
+ /* Purpose of this value is unknown. It is typically 161. */
+ {
+ int x = read_int (h);
+
+ if (x == NOT_INT)
+ goto lossage;
+ if (x != 161)
+ corrupt_msg (h, _("Unexpected flag value %d."), x);
+ }
+
+ ext->dict = new_dictionary (0);
+
+ if (match (70 /* 6 */))
+ {
+ char *name = read_string (h);
+ if (!name)
+ goto lossage;
+
+ strcpy (ext->dict->weight_var, name);
+ asciify (ext->dict->weight_var);
+ }
+
+ for (i = 0; i < ext->nvars; i++)
+ {
+ int width;
+ unsigned char *name;
+ int fmt[6];
+ struct variable *v;
+ int j;
+
+ if (!match (71 /* 7 */))
+ lose ((h, _("Expected variable record.")));
+
+ width = read_int (h);
+ if (width == NOT_INT)
+ goto lossage;
+ if (width < 0)
+ lose ((h, _("Invalid variable width %d."), width));
+ ext->vars[i] = width;
+
+ name = read_string (h);
+ if (name == NULL)
+ goto lossage;
+ for (j = 0; j < 6; j++)
+ {
+ fmt[j] = read_int (h);
+ if (fmt[j] == NOT_INT)
+ goto lossage;
+ }
+
+ /* Verify first character of variable name.
+
+ Weirdly enough, there is no # character in the SPSS portable
+ character set, so we can't check for it. */
+ if (strlen (name) > 8)
+ lose ((h, _("position %d: Variable name has %u characters."),
+ i, strlen (name)));
+ if ((name[0] < 74 /* A */ || name[0] > 125 /* Z */)
+ && name[0] != 152 /* @ */)
+ lose ((h, _("position %d: Variable name begins with invalid "
+ "character."), i));
+ if (name[0] >= 100 /* a */ && name[0] <= 125 /* z */)
+ {
+ corrupt_msg (h, _("position %d: Variable name begins with "
+ "lowercase letter %c."),
+ i, name[0] - 100 + 'a');
+ name[0] -= 26 /* a - A */;
+ }
+
+ /* Verify remaining characters of variable name. */
+ for (j = 1; j < (int) strlen (name); j++)
+ {
+ int c = name[j];
+
+ if (c >= 100 /* a */ && c <= 125 /* z */)
+ {
+ corrupt_msg (h, _("position %d: Variable name character %d "
+ "is lowercase letter %c."),
+ i, j + 1, c - 100 + 'a');
+ name[j] -= 26 /* z - Z */;
+ }
+ else if ((c >= 64 /* 0 */ && c <= 99 /* Z */)
+ || c == 127 /* . */ || c == 152 /* @ */
+ || c == 136 /* $ */ || c == 146 /* _ */)
+ name[j] = c;
+ else
+ lose ((h, _("position %d: character `\\%03o' is not "
+ "valid in a variable name."), i, c));
+ }
+
+ asciify (name);
+ if (width < 0 || width > 255)
+ lose ((h, "Bad width %d for variable %s.", width, name));
+
+ v = create_variable (ext->dict, name, width ? ALPHA : NUMERIC, width);
+ v->get.fv = v->fv;
+ if (v == NULL)
+ lose ((h, _("Duplicate variable name %s."), name));
+ if (!convert_format (h, &fmt[0], &v->print, v))
+ goto lossage;
+ if (!convert_format (h, &fmt[3], &v->write, v))
+ goto lossage;
+
+ /* Range missing values. */
+ if (match (75 /* B */))
+ {
+ v->miss_type = MISSING_RANGE;
+ if (!parse_value (h, &v->missing[0], v)
+ || !parse_value (h, &v->missing[1], v))
+ goto lossage;
+ }
+ else if (match (74 /* A */))
+ {
+ v->miss_type = MISSING_HIGH;
+ if (!parse_value (h, &v->missing[0], v))
+ goto lossage;
+ }
+ else if (match (73 /* 9 */))
+ {
+ v->miss_type = MISSING_LOW;
+ if (!parse_value (h, &v->missing[0], v))
+ goto lossage;
+ }
+
+ /* Single missing values. */
+ while (match (72 /* 8 */))
+ {
+ static const int map_next[MISSING_COUNT] =
+ {
+ MISSING_1, MISSING_2, MISSING_3, -1,
+ MISSING_RANGE_1, MISSING_LOW_1, MISSING_HIGH_1,
+ -1, -1, -1,
+ };
+
+ static const int map_ofs[MISSING_COUNT] =
+ {
+ -1, 0, 1, 2, -1, -1, -1, 2, 1, 1,
+ };
+
+ v->miss_type = map_next[v->miss_type];
+ if (v->miss_type == -1)
+ lose ((h, _("Bad missing values for %s."), v->name));
+
+ assert (map_ofs[v->miss_type] != -1);
+ if (!parse_value (h, &v->missing[map_ofs[v->miss_type]], v))
+ goto lossage;
+ }
+
+ if (match (76 /* C */))
+ {
+ char *label = read_string (h);
+
+ if (label == NULL)
+ goto lossage;
+
+ v->label = xstrdup (label);
+ asciify (v->label);
+ }
+ }
+ ext->case_size = ext->dict->nval;
+
+ if (ext->dict->weight_var[0] != 0
+ && !find_dict_variable (ext->dict, ext->dict->weight_var))
+ lose ((h, _("Weighting variable %s not present in dictionary."),
+ ext->dict->weight_var));
+
+ return 1;
+
+ lossage:
+ return 0;
+}
+
+/* Parse a value for variable VV into value V. Returns success. */
+static int
+parse_value (struct file_handle *h, union value *v, struct variable *vv)
+{
+ if (vv->type == ALPHA)
+ {
+ char *mv = read_string (h);
+ int j;
+
+ if (mv == NULL)
+ return 0;
+
+ strncpy (v->s, mv, 8);
+ for (j = 0; j < 8; j++)
+ if (v->s[j])
+ v->s[j] = spss2ascii[v->s[j]];
+ else
+ /* Value labels are always padded with spaces. */
+ v->s[j] = ' ';
+ }
+ else
+ {
+ v->f = read_float (h);
+ if (v->f == second_lowest_value)
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Parse a value label record and return success. */
+static int
+read_value_label (struct file_handle *h)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+
+ /* Variables. */
+ int nv;
+ struct variable **v;
+
+ /* Labels. */
+ int n_labels;
+
+ int i;
+
+ nv = read_int (h);
+ if (nv == NOT_INT)
+ return 0;
+
+ v = xmalloc (sizeof *v * nv);
+ for (i = 0; i < nv; i++)
+ {
+ char *name = read_string (h);
+ if (name == NULL)
+ goto lossage;
+ asciify (name);
+
+ v[i] = find_dict_variable (ext->dict, name);
+ if (v[i] == NULL)
+ lose ((h, _("Unknown variable %s while parsing value labels."), name));
+
+ if (v[0]->width != v[i]->width)
+ lose ((h, _("Cannot assign value labels to %s and %s, which "
+ "have different variable types or widths."),
+ v[0]->name, v[i]->name));
+ }
+
+ n_labels = read_int (h);
+ if (n_labels == NOT_INT)
+ goto lossage;
+
+ for (i = 0; i < n_labels; i++)
+ {
+ union value val;
+ char *label;
+ struct value_label *vl;
+
+ int j;
+
+ if (!parse_value (h, &val, v[0]))
+ goto lossage;
+
+ label = read_string (h);
+ if (label == NULL)
+ goto lossage;
+ asciify (label);
+
+ /* Create a label. */
+ vl = xmalloc (sizeof *vl);
+ vl->v = val;
+ vl->s = xstrdup (label);
+ vl->ref_count = nv;
+
+ /* Assign the value_label's to each variable. */
+ for (j = 0; j < nv; j++)
+ {
+ struct variable *var = v[j];
+ struct value_label *old;
+
+ /* Create AVL tree if necessary. */
+ if (!var->val_lab)
+ var->val_lab = avl_create (NULL, val_lab_cmp,
+ (void *) (var->width));
+
+ old = avl_replace (var->val_lab, vl);
+ if (old == NULL)
+ continue;
+
+ if (var->type == NUMERIC)
+ lose ((h, _("Duplicate label for value %g for variable %s."),
+ vl->v.f, var->name));
+ else
+ lose ((h, _("Duplicate label for value `%.*s' for variable %s."),
+ var->width, vl->v.s, var->name));
+
+ free_value_label (old);
+ }
+ }
+ free (v);
+ return 1;
+
+ lossage:
+ free (v);
+ return 0;
+}
+
+/* Reads one case from portable file H into the value array PERM
+ according to the instuctions given in associated dictionary DICT,
+ which must have the get.fv elements appropriately set. Returns
+ nonzero only if successful. */
+int
+pfm_read_case (struct file_handle *h, union value *perm, struct dictionary *dict)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+
+ union value *temp, *tp;
+ int i;
+
+ /* Check for end of file. */
+ if (ext->cc == 99 /* Z */)
+ return 0;
+
+ /* The first concern is to obtain a full case relative to the data
+ file. (Cases in the data file have no particular relationship to
+ cases in the active file.) */
+ tp = temp = local_alloc (sizeof *tp * ext->case_size);
+ for (tp = temp, i = 0; i < ext->nvars; i++)
+ if (ext->vars[i] == 0)
+ {
+ tp->f = read_float (h);
+ if (tp->f == second_lowest_value)
+ goto unexpected_eof;
+ tp++;
+ }
+ else
+ {
+ char *s = read_string (h);
+ if (s == NULL)
+ goto unexpected_eof;
+ asciify (s);
+
+ st_bare_pad_copy (tp->s, s, ext->vars[i]);
+ tp += DIV_RND_UP (ext->vars[i], MAX_SHORT_STRING);
+ }
+
+ /* Translate a case in data file format to a case in active file
+ format. */
+ for (i = 0; i < dict->nvar; i++)
+ {
+ struct variable *v = dict->var[i];
+
+ if (v->get.fv == -1)
+ continue;
+
+ if (v->type == NUMERIC)
+ perm[v->fv].f = temp[v->get.fv].f;
+ else
+ memcpy (&perm[v->fv].s, &temp[v->get.fv], v->width);
+ }
+
+ local_free (temp);
+ return 1;
+
+ unexpected_eof:
+ lose ((h, _("End of file midway through case.")));
+
+ lossage:
+ local_free (temp);
+ return 0;
+}
+
+static struct fh_ext_class pfm_r_class =
+{
+ 5,
+ N_("reading as a portable file"),
+ pfm_close,
+};
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <ctype.h>
+#include <errno.h>
+#include <float.h>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+#include "alloc.h"
+#include "avl.h"
+#include "error.h"
+#include "file-handle.h"
+#include "gmp/gmp.h"
+#include "magic.h"
+#include "pfm.h"
+#include "str.h"
+#include "var.h"
+#include "version.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+
+/* pfm writer file_handle extension. */
+struct pfm_fhuser_ext
+ {
+ FILE *file; /* Actual file. */
+
+ int lc; /* Number of characters on this line so far. */
+
+ int nvars; /* Number of variables. */
+ int *vars; /* Variable widths. */
+ };
+
+static struct fh_ext_class pfm_w_class;
+
+static int bufwrite (struct file_handle *h, const void *buf, size_t nbytes);
+static int write_header (struct file_handle *h);
+static int write_version_data (struct file_handle *h);
+static int write_variables (struct file_handle *h, struct dictionary *d);
+static int write_value_labels (struct file_handle *h, struct dictionary *d);
+
+/* Writes the dictionary DICT to portable file HANDLE. Returns
+ nonzero only if successful. */
+int
+pfm_write_dictionary (struct file_handle *handle, struct dictionary *dict)
+{
+ struct pfm_fhuser_ext *ext;
+
+ if (handle->class != NULL)
+ {
+ msg (ME, _("Cannot write file %s as portable file: already opened "
+ "for %s."),
+ fh_handle_name (handle), handle->class->name);
+ return 0;
+ }
+
+ msg (VM (1), _("%s: Opening portable-file handle %s for writing."),
+ fh_handle_filename (handle), fh_handle_name (handle));
+
+ /* Open the physical disk file. */
+ handle->class = &pfm_w_class;
+ handle->ext = ext = xmalloc (sizeof (struct pfm_fhuser_ext));
+ ext->file = fopen (handle->norm_fn, "wb");
+ ext->lc = 0;
+ if (ext->file == NULL)
+ {
+ msg (ME, _("An error occurred while opening \"%s\" for writing "
+ "as a portable file: %s."), handle->fn, strerror (errno));
+ err_cond_fail ();
+ free (ext);
+ return 0;
+ }
+
+ {
+ int i;
+
+ ext->nvars = dict->nvar;
+ ext->vars = xmalloc (sizeof *ext->vars * dict->nvar);
+ for (i = 0; i < dict->nvar; i++)
+ ext->vars[i] = dict->var[i]->width;
+ }
+
+ /* Write the file header. */
+ if (!write_header (handle))
+ goto lossage;
+
+ /* Write version data. */
+ if (!write_version_data (handle))
+ goto lossage;
+
+ /* Write variables. */
+ if (!write_variables (handle, dict))
+ goto lossage;
+
+ /* Write value labels. */
+ if (!write_value_labels (handle, dict))
+ goto lossage;
+
+ /* Write beginning of data marker. */
+ if (!bufwrite (handle, "F", 1))
+ goto lossage;
+
+ msg (VM (2), _("Wrote portable-file header successfully."));
+
+ return 1;
+
+lossage:
+ msg (VM (1), _("Error writing portable-file header."));
+ fclose (ext->file);
+ free (ext->vars);
+ handle->class = NULL;
+ handle->ext = NULL;
+ return 0;
+}
+\f
+/* Write NBYTES starting at BUF to the portable file represented by
+ H. Break lines properly every 80 characters. */
+static int
+bufwrite (struct file_handle *h, const void *buf, size_t nbytes)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+
+ assert (buf != NULL);
+ while (nbytes + ext->lc >= 80)
+ {
+ size_t n = 80 - ext->lc;
+
+ if (n && 1 != fwrite (buf, n, 1, ext->file))
+ goto lossage;
+
+ /* PORTME: line ends. */
+ if (1 != fwrite ("\r\n", 2, 1, ext->file))
+ goto lossage;
+
+ nbytes -= n;
+ *((char **) &buf) += n;
+ ext->lc = 0;
+ }
+
+ if (nbytes && 1 != fwrite (buf, nbytes, 1, ext->file))
+ goto lossage;
+ ext->lc += nbytes;
+
+ return 1;
+
+ lossage:
+ abort ();
+ msg (ME, _("%s: Writing portable file: %s."), h->fn, strerror (errno));
+ return 0;
+}
+
+/* Write D to the portable file as a floating-point field, and return
+ success. */
+static int
+write_float (struct file_handle *h, double d)
+{
+ int neg = 0;
+ char *mantissa;
+ int mantissa_len;
+ mp_exp_t exponent;
+ char *buf, *cp;
+ int success;
+
+ if (d < 0.)
+ {
+ d = -d;
+ neg = 1;
+ }
+
+ if (d == fabs (SYSMIS) || d == HUGE_VAL)
+ return bufwrite (h, "*.", 2);
+
+ /* Use GNU libgmp2 to convert D into base-30. */
+ {
+ mpf_t f;
+
+ mpf_init_set_d (f, d);
+ mantissa = mpf_get_str (NULL, &exponent, 30, 0, f);
+ mpf_clear (f);
+
+ for (cp = mantissa; *cp; cp++)
+ *cp = toupper (*cp);
+ }
+
+ /* Choose standard or scientific notation. */
+ mantissa_len = (int) strlen (mantissa);
+ cp = buf = local_alloc (mantissa_len + 32);
+ if (neg)
+ *cp++ = '-';
+ if (mantissa_len == 0)
+ *cp++ = '0';
+ else if (exponent < -4 || exponent > (mp_exp_t) mantissa_len)
+ {
+ /* Scientific notation. */
+ *cp++ = mantissa[0];
+ *cp++ = '.';
+ cp = stpcpy (cp, &mantissa[1]);
+ cp = spprintf (cp, "%+ld", (long) (exponent - 1));
+ }
+ else if (exponent <= 0)
+ {
+ /* Standard notation, D <= 1. */
+ *cp++ = '.';
+ memset (cp, '0', -exponent);
+ cp += -exponent;
+ cp = stpcpy (cp, mantissa);
+ }
+ else
+ {
+ /* Standard notation, D > 1. */
+ memcpy (cp, mantissa, exponent);
+ cp += exponent;
+ *cp++ = '.';
+ cp = stpcpy (cp, &mantissa[exponent]);
+ }
+ *cp++ = '/';
+
+ success = bufwrite (h, buf, cp - buf);
+ local_free (buf);
+ free (mantissa);
+ return success;
+}
+
+/* Write N to the portable file as an integer field, and return success. */
+static int
+write_int (struct file_handle *h, int n)
+{
+ char buf[64];
+ char *bp = &buf[64];
+ int neg = 0;
+
+ *--bp = '/';
+
+ if (n < 0)
+ {
+ n = -n;
+ neg = 1;
+ }
+
+ do
+ {
+ int r = n % 30;
+
+ /* PORTME: character codes. */
+ if (r < 10)
+ *--bp = r + '0';
+ else
+ *--bp = r - 10 + 'A';
+
+ n /= 30;
+ }
+ while (n > 0);
+
+ if (neg)
+ *--bp = '-';
+
+ return bufwrite (h, bp, &buf[64] - bp);
+}
+
+/* Write S to the portable file as a string field. */
+static int
+write_string (struct file_handle *h, const char *s)
+{
+ size_t n = strlen (s);
+ return write_int (h, (int) n) && bufwrite (h, s, n);
+}
+\f
+/* Write file header. */
+static int
+write_header (struct file_handle *h)
+{
+ /* PORTME. */
+ {
+ int i;
+
+ for (i = 0; i < 5; i++)
+ if (!bufwrite (h, "ASCII SPSS PORT FILE ", 40))
+ return 0;
+ }
+
+ {
+ /* PORTME: Translation table from SPSS character code to this
+ computer's native character code (which is probably ASCII). */
+ static const unsigned char spss2ascii[256] =
+ {
+ "0000000000000000000000000000000000000000000000000000000000000000"
+ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz ."
+ "<(+|&[]!$*);^-/|,%_>?`:$@'=\"000000~-0000123456789000-()0{}\\00000"
+ "0000000000000000000000000000000000000000000000000000000000000000"
+ };
+
+ if (!bufwrite (h, spss2ascii, 256))
+ return 0;
+ }
+
+ if (!bufwrite (h, "SPSSPORT", 8))
+ return 0;
+
+ return 1;
+}
+
+/* Writes version, date, and identification records. */
+static int
+write_version_data (struct file_handle *h)
+{
+ if (!bufwrite (h, "A", 1))
+ return 0;
+
+ {
+ char date_str[9];
+ char time_str[7];
+ time_t t;
+ struct tm tm;
+ struct tm *tmp;
+
+ if ((time_t) -1 == time (&t))
+ {
+ tm.tm_sec = tm.tm_min = tm.tm_hour = tm.tm_mon = tm.tm_year = 0;
+ tm.tm_mday = 1;
+ tmp = &tm;
+ }
+ else
+ tmp = localtime (&t);
+
+ sprintf (date_str, "%04d%02d%02d",
+ tmp->tm_year + 1900, tmp->tm_mon + 1, tmp->tm_mday);
+ sprintf (time_str, "%02d%02d%02d", tmp->tm_hour, tmp->tm_min, tmp->tm_sec);
+ if (!write_string (h, date_str) || !write_string (h, time_str))
+ return 0;
+ }
+
+ /* Product identification. */
+ if (!bufwrite (h, "1", 1) || !write_string (h, version))
+ return 0;
+
+ /* Subproduct identification. */
+ if (!bufwrite (h, "3", 1) || !write_string (h, host_system))
+ return 0;
+
+ return 1;
+}
+
+/* Write format F to file H, and return success. */
+static int
+write_format (struct file_handle *h, struct fmt_spec *f)
+{
+ return (write_int (h, formats[f->type].spss)
+ && write_int (h, f->w)
+ && write_int (h, f->d));
+}
+
+/* Write value V for variable VV to file H, and return success. */
+static int
+write_value (struct file_handle *h, union value *v, struct variable *vv)
+{
+ if (vv->type == NUMERIC)
+ return write_float (h, v->f);
+ else
+ return write_int (h, vv->width) && bufwrite (h, v->s, vv->width);
+}
+
+/* Write variable records, and return success. */
+static int
+write_variables (struct file_handle *h, struct dictionary *dict)
+{
+ int i;
+
+ if (!bufwrite (h, "4", 1) || !write_int (h, dict->nvar)
+ || !write_int (h, 161))
+ return 0;
+
+ for (i = 0; i < dict->nvar; i++)
+ {
+ static const char *miss_types[MISSING_COUNT] =
+ {
+ "", "8", "88", "888", "B ", "9", "A", "B 8", "98", "A8",
+ };
+
+ const char *m;
+ int j;
+
+ struct variable *v = dict->var[i];
+
+ if (!bufwrite (h, "7", 1) || !write_int (h, v->width)
+ || !write_string (h, v->name)
+ || !write_format (h, &v->print) || !write_format (h, &v->write))
+ return 0;
+
+ for (m = miss_types[v->miss_type], j = 0; j < (int) strlen (m); j++)
+ if ((m[j] != ' ' && !bufwrite (h, &m[j], 1))
+ || !write_value (h, &v->missing[j], v))
+ return 0;
+
+ if (v->label && (!bufwrite (h, "C", 1) || !write_string (h, v->label)))
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Write value labels to disk. FIXME: Inefficient. */
+static int
+write_value_labels (struct file_handle *h, struct dictionary *dict)
+{
+ int i;
+
+ for (i = 0; i < dict->nvar; i++)
+ {
+ avl_traverser iter;
+ struct variable *v = dict->var[i];
+ struct value_label *vl;
+
+ if (v->val_lab == NULL)
+ continue;
+
+ if (!bufwrite (h, "D", 1)
+ || !write_int (h, 1)
+ || !write_string (h, v->name)
+ || !write_int (h, avl_count (v->val_lab)))
+ return 0;
+
+ avl_traverser_init (iter);
+ while (NULL != (vl = avl_traverse (v->val_lab, &iter)))
+ if (!write_value (h, &vl->v, v)
+ || !write_string (h, vl->s))
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Writes case ELEM to the portable file represented by H. Returns
+ success. */
+int
+pfm_write_case (struct file_handle *h, const union value *elem)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+
+ int i;
+
+ for (i = 0; i < ext->nvars; i++)
+ {
+ const int width = ext->vars[i];
+
+ if (width == 0)
+ {
+ if (!write_float (h, elem[i].f))
+ return 0;
+ }
+ else
+ {
+ if (!write_int (h, width) || !bufwrite (h, elem->c, width))
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+/* Closes a portable file after we're done with it. */
+static void
+pfm_close (struct file_handle *h)
+{
+ struct pfm_fhuser_ext *ext = h->ext;
+
+ {
+ char buf[80];
+
+ int n = 80 - ext->lc;
+ if (n == 0)
+ n = 80;
+
+ memset (buf, 'Z', n);
+ bufwrite (h, buf, n);
+ }
+
+ if (EOF == fclose (ext->file))
+ msg (ME, _("%s: Closing portable file: %s."), h->fn, strerror (errno));
+
+ free (ext->vars);
+ free (ext);
+}
+
+static struct fh_ext_class pfm_w_class =
+{
+ 6,
+ N_("writing as a portable file"),
+ pfm_close,
+};
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !pfm_h
+#define pfm_h 1
+
+/* Portable file manager (pfm).
+
+ This module is in charge of reading and writing portable files.
+ pfm is an fhuser, so see file-handle.h for the fhuser interface. */
+
+/* Portable file types. */
+enum
+ {
+ PFM_COMM,
+ PFM_TAPE
+ };
+
+/* Information produced by pfm_read_dictionary() that doesn't fit into
+ a dictionary struct. */
+struct pfm_read_info
+ {
+ char creation_date[11]; /* `dd mm yyyy' plus a null. */
+ char creation_time[9]; /* `hh:mm:ss' plus a null. */
+ char product[61]; /* Product name plus a null. */
+ char subproduct[61]; /* Subproduct name plus a null. */
+ };
+
+struct dictionary;
+struct file_handle;
+union value;
+
+struct dictionary *pfm_read_dictionary (struct file_handle *,
+ struct pfm_read_info *);
+int pfm_read_case (struct file_handle *, union value *, struct dictionary *);
+
+int pfm_write_dictionary (struct file_handle *, struct dictionary *);
+int pfm_write_case (struct file_handle *, const union value *elem);
+
+#endif /* !pfm_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if HAVE_CONFIG_H
+#include <config.h>
+#endif
+#include <assert.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "pool.h"
+
+/* Fast, low-overhead memory block suballocator. */
+struct pool
+ {
+ struct pool *parent; /* Pool of which this pool is a subpool. */
+ struct pool_block *blocks; /* Blocks owned by the pool. */
+ struct pool_gizmo *gizmos; /* Other stuff owned by the pool. */
+ };
+
+/* Pool block. */
+struct pool_block
+ {
+ struct pool_block *prev;
+ struct pool_block *next;
+ size_t ofs;
+ };
+
+/* Gizmo types. */
+enum
+ {
+ POOL_GIZMO_MALLOC,
+ POOL_GIZMO_FILE,
+ POOL_GIZMO_SUBPOOL,
+ POOL_GIZMO_REGISTERED,
+ };
+
+/* Pool routines can maintain objects (`gizmos') as well as doing
+ suballocation.
+ This structure is used to keep track of them. */
+struct pool_gizmo
+ {
+ struct pool_gizmo *prev;
+ struct pool_gizmo *next;
+
+ long serial; /* Serial number. */
+ int type; /* Type of this gizmo. */
+
+ /* Type-dependent info. */
+ union
+ {
+ FILE *file; /* POOL_GIZMO_FILE. */
+ struct pool *subpool; /* POOL_GIZMO_SUBPOOL. */
+
+ /* POOL_GIZMO_REGISTERED. */
+ struct
+ {
+ void (*free) (void *p);
+ void *p;
+ }
+ registered;
+ }
+ p;
+ };
+
+/* Rounds X up to the next multiple of Y. */
+#ifndef ROUND_UP
+#define ROUND_UP(X, Y) \
+ (((X) + ((Y) - 1)) / (Y) * (Y))
+#endif
+
+/* Types that provide typically useful alignment sizes. */
+union align
+ {
+ void *op;
+ void (*fp) (void);
+ long l;
+ double d;
+ };
+
+/* This should be the alignment size used by malloc(). The size of
+ the union above is correct, if not optimal, in all known cases. */
+#if defined (i386) || defined (__i386__)
+#define ALIGN_SIZE 4 /* Save some extra memory. */
+#else
+#define ALIGN_SIZE sizeof (union align)
+#endif
+
+/* DISCRETE_BLOCKS may be declared as nonzero to prevent suballocation
+ of blocks. This is useful under memory debuggers like Checker
+ because it allows the source location of bugs to be more accurately
+ pinpointed.
+
+ On the other hand, if we're testing the library, then we want to
+ test the library's real functionality, not its crippled, slow,
+ simplified functionality. */
+#if __CHECKER__ && !SELF_TEST
+#define DISCRETE_BLOCKS 1
+#endif
+
+/* Enable debug code if appropriate. */
+#undef DEBUGGING
+#if SELF_TEST
+#define DEBUGGING 1
+#endif
+
+/* Size of each block allocated in the pool, in bytes.
+ Should be at least 1k. */
+#ifndef BLOCK_SIZE
+#define BLOCK_SIZE 1024
+#endif
+
+/* Maximum size of a suballocated block. Larger blocks are allocated
+ directly with malloc() to avoid memory wastage at the end of a
+ suballocation block. */
+#ifndef MAX_SUBALLOC
+#define MAX_SUBALLOC 64
+#endif
+
+/* Sizes of some structures with alignment padding included. */
+#define POOL_BLOCK_SIZE ROUND_UP (sizeof (struct pool_block), ALIGN_SIZE)
+#define POOL_GIZMO_SIZE ROUND_UP (sizeof (struct pool_gizmo), ALIGN_SIZE)
+#define POOL_SIZE ROUND_UP (sizeof (struct pool), ALIGN_SIZE)
+
+/* Serial number used to keep track of gizmos for mark/release. */
+static long serial = 0;
+
+/* Prototypes. */
+static void add_gizmo (struct pool *, struct pool_gizmo *);
+static void free_gizmo (struct pool_gizmo *);
+static void delete_gizmo (struct pool *, struct pool_gizmo *);
+
+#if !PSPP
+static void *xmalloc (size_t);
+static void *xrealloc (void *, size_t);
+#endif
+\f
+/* General routines. */
+
+/* Creates and returns a new memory pool, which allows malloc()'d
+ blocks to be suballocated in a time- and space-efficient manner.
+ The entire contents of the memory pool are freed at once.
+
+ In addition, other objects can be associated with a memory pool.
+ These are released when the pool is destroyed. */
+struct pool *
+pool_create (void)
+{
+ struct pool_block *block;
+ struct pool *pool;
+
+ block = xmalloc (BLOCK_SIZE);
+ block->prev = block->next = block;
+ block->ofs = POOL_BLOCK_SIZE + POOL_SIZE;
+
+ pool = (struct pool *) (((char *) block) + POOL_BLOCK_SIZE);
+ pool->parent = NULL;
+ pool->blocks = block;
+ pool->gizmos = NULL;
+
+ return pool;
+}
+
+/* Destroy the specified pool, including all subpools. */
+void
+pool_destroy (struct pool *pool)
+{
+ if (pool == NULL)
+ return;
+
+ if (pool->parent)
+ delete_gizmo (pool,
+ (void *) (((char *) pool) + POOL_SIZE + POOL_BLOCK_SIZE));
+
+ {
+ struct pool_gizmo *cur, *next;
+
+ for (cur = pool->gizmos; cur; cur = next)
+ {
+ next = cur->next;
+ free_gizmo (cur);
+ }
+ }
+
+ {
+ struct pool_block *cur, *next;
+
+ pool->blocks->prev->next = NULL;
+ for (cur = pool->blocks; cur; cur = next)
+ {
+ next = cur->next;
+ free (cur);
+ }
+ }
+}
+\f
+/* Suballocation routines. */
+
+/* Allocates a memory region AMT bytes in size from POOL and returns a
+ pointer to the region's start. */
+void *
+pool_alloc (struct pool *pool, size_t amt)
+{
+ assert (pool != NULL);
+
+#if !DISCRETE_BLOCKS /* Help identify source of bugs for Checker users. */
+ if (amt <= MAX_SUBALLOC)
+ {
+ struct pool_block *b = pool->blocks;
+ b->ofs = ROUND_UP (b->ofs, ALIGN_SIZE);
+ if (b->ofs + amt <= BLOCK_SIZE)
+ {
+ void *const p = ((char *) b) + b->ofs;
+ b->ofs += amt;
+ return p;
+ }
+
+ b = xmalloc (BLOCK_SIZE);
+ b->next = pool->blocks;
+ b->prev = pool->blocks->prev;
+ b->ofs = POOL_BLOCK_SIZE + amt;
+
+ pool->blocks->prev->next = b;
+ pool->blocks = pool->blocks->prev = b;
+
+ return ((char *) b) + POOL_BLOCK_SIZE;
+ }
+ else
+#endif /* !DISCRETE_BLOCKS */
+ return pool_malloc (pool, amt);
+}
+
+/* Duplicates STRING within POOL and returns a pointer to the
+ duplicate. */
+char *
+pool_strdup (struct pool *pool, const char *string)
+{
+ size_t amt;
+ void *p;
+
+ assert (pool && string);
+ amt = strlen (string) + 1;
+
+ /* Note that strings need not be aligned on any boundary. */
+ {
+#if !DISCRETE_BLOCKS
+ struct pool_block *const b = pool->blocks;
+
+ if (b->ofs + amt <= BLOCK_SIZE)
+ {
+ p = ((char *) b) + b->ofs;
+ b->ofs += amt;
+ }
+ else
+#endif
+ p = pool_alloc (pool, amt);
+ }
+
+ memcpy (p, string, amt);
+ return p;
+}
+\f
+/* Standard allocation routines. */
+
+/* Allocates AMT bytes using malloc(), to be managed by POOL, and
+ returns a pointer to the beginning of the block.
+ If POOL is a null pointer, then allocates a normal memory block
+ with malloc(). */
+void *
+pool_malloc (struct pool *pool, size_t amt)
+{
+ if (pool != NULL)
+ {
+ if (amt != 0)
+ {
+ struct pool_gizmo *g = xmalloc (amt + POOL_GIZMO_SIZE);
+ g->type = POOL_GIZMO_MALLOC;
+ add_gizmo (pool, g);
+
+ return ((char *) g) + POOL_GIZMO_SIZE;
+ }
+ else
+ return NULL;
+ }
+ else
+ return xmalloc (amt);
+}
+
+/* Changes the allocation size of the specified memory block P managed
+ by POOL to AMT bytes and returns a pointer to the beginning of the
+ block.
+ If POOL is a null pointer, then the block is reallocated in the
+ usual way with realloc(). */
+void *
+pool_realloc (struct pool *pool, void *p, size_t amt)
+{
+ if (pool != NULL)
+ {
+ if (p != NULL)
+ {
+ if (amt != 0)
+ {
+ struct pool_gizmo *g;
+
+ g = xrealloc (((char *) p) - POOL_GIZMO_SIZE,
+ amt + POOL_GIZMO_SIZE);
+ if (g->next)
+ g->next->prev = g;
+ if (g->prev)
+ g->prev->next = g;
+ else
+ pool->gizmos = g;
+
+ return ((char *) g) + POOL_GIZMO_SIZE;
+ }
+ else
+ {
+ pool_free (pool, p);
+ return NULL;
+ }
+ }
+ else
+ return pool_malloc (pool, amt);
+ }
+ else
+ return xrealloc (p, amt);
+}
+
+/* Frees block P managed by POOL.
+ If POOL is a null pointer, then the block is freed as usual with
+ free(). */
+void
+pool_free (struct pool *pool, void *p)
+{
+ if (pool != NULL && p != NULL)
+ {
+ struct pool_gizmo *g = (void *) (((char *) p) - POOL_GIZMO_SIZE);
+ delete_gizmo (pool, g);
+ free (g);
+ }
+ else
+ free (p);
+}
+\f
+/* Gizmo allocations. */
+
+/* Creates and returns a pool as a subpool of POOL.
+ The subpool will be destroyed automatically when POOL is destroyed.
+ It may also be destroyed explicitly in advance. */
+struct pool *
+pool_create_subpool (struct pool *pool)
+{
+ struct pool *subpool;
+ struct pool_gizmo *g;
+
+ assert (pool != NULL);
+ subpool = pool_create ();
+ subpool->parent = pool;
+
+ g = (void *) (((char *) subpool) + subpool->blocks->ofs);
+ subpool->blocks->ofs += POOL_GIZMO_SIZE;
+
+ g->type = POOL_GIZMO_SUBPOOL;
+ g->p.subpool = subpool;
+
+ add_gizmo (pool, g);
+
+ return subpool;
+}
+
+/* Opens file FILENAME with mode MODE and returns a handle to it
+ if successful or a null pointer if not.
+ The file will be closed automatically when POOL is destroyed, or it
+ may be closed explicitly in advance using pool_fclose. */
+FILE *
+pool_fopen (struct pool *pool, const char *filename, const char *mode)
+{
+ FILE *f;
+
+ assert (pool && filename && mode);
+ f = fopen (filename, mode);
+ if (f == NULL)
+ return NULL;
+
+ {
+ struct pool_gizmo *g = pool_alloc (pool, sizeof *g);
+ g->type = POOL_GIZMO_FILE;
+ g->p.file = f;
+ add_gizmo (pool, g);
+ }
+
+ return f;
+}
+
+/* Closes file FILE managed by POOL. */
+int
+pool_fclose (struct pool *pool, FILE *file)
+{
+ assert (pool && file);
+ if (fclose (file) == EOF)
+ return EOF;
+
+ {
+ struct pool_gizmo *g;
+
+ for (g = pool->gizmos; g; g = g->next)
+ if (g->type == POOL_GIZMO_FILE && g->p.file == file)
+ {
+ delete_gizmo (pool, g);
+ break;
+ }
+ }
+
+ return 0;
+}
+\f
+/* Registers FREE to be called with argument P.
+ P should be unique among those registered in POOL so that it can be
+ uniquely identified by pool_unregister().
+ If not unregistered, FREE will be called with argument P when POOL
+ is destroyed. */
+void
+pool_register (struct pool *pool, void (*free) (void *), void *p)
+{
+ assert (pool && free && p);
+
+ {
+ struct pool_gizmo *g = pool_alloc (pool, sizeof *g);
+ g->type = POOL_GIZMO_REGISTERED;
+ g->p.registered.free = free;
+ g->p.registered.p = p;
+ add_gizmo (pool, g);
+ }
+}
+
+/* Unregisters previously registered P from POOL.
+ Returns nonzero only if P was found to be registered in POOL. */
+int
+pool_unregister (struct pool *pool, void *p)
+{
+ assert (pool && p);
+
+ {
+ struct pool_gizmo *g;
+
+ for (g = pool->gizmos; g; g = g->next)
+ if (g->type == POOL_GIZMO_REGISTERED && g->p.registered.p == p)
+ {
+ delete_gizmo (pool, g);
+ return 1;
+ }
+ }
+
+ return 0;
+}
+\f
+/* Partial freeing. */
+
+/* Notes the state of POOL into MARK so that it may be restored
+ by a call to pool_release(). */
+void
+pool_mark (struct pool *pool, struct pool_mark *mark)
+{
+ assert (pool && mark);
+
+ mark->block = pool->blocks;
+ mark->ofs = pool->blocks->ofs;
+
+ mark->serial = serial;
+}
+
+/* Restores to POOL the state recorded in MARK. */
+void
+pool_release (struct pool *pool, const struct pool_mark *mark)
+{
+ assert (pool && mark);
+
+ {
+ struct pool_gizmo *cur, *next;
+
+ for (cur = pool->gizmos; cur && cur->serial >= mark->serial; cur = next)
+ {
+ next = cur->next;
+ free_gizmo (cur);
+ }
+
+ if (cur != NULL)
+ {
+ cur->prev = NULL;
+ pool->gizmos = cur;
+ }
+ else
+ pool->gizmos = NULL;
+ }
+
+ {
+ struct pool_block *cur, *next, *last;
+
+ last = pool->blocks->prev;
+ for (cur = pool->blocks; cur != mark->block; cur = next)
+ {
+ next = cur->next;
+ assert (next != cur);
+
+ free (cur);
+ }
+
+ cur->prev = last;
+ last->next = pool->blocks = cur;
+
+ cur->ofs = mark->ofs;
+ }
+}
+\f
+/* Private functions. */
+
+/* Adds GIZMO at the beginning of POOL's gizmo list. */
+static void
+add_gizmo (struct pool *pool, struct pool_gizmo *gizmo)
+{
+ assert (pool && gizmo);
+
+ gizmo->next = pool->gizmos;
+ gizmo->prev = NULL;
+ if (pool->gizmos)
+ pool->gizmos->prev = gizmo;
+ pool->gizmos = gizmo;
+
+ gizmo->serial = serial++;
+}
+
+/* Removes GIZMO from POOL's gizmo list. */
+static void
+delete_gizmo (struct pool *pool, struct pool_gizmo *gizmo)
+{
+ assert (pool && gizmo);
+
+ if (gizmo->prev)
+ gizmo->prev->next = gizmo->next;
+ else
+ pool->gizmos = gizmo->next;
+ if (gizmo->next)
+ gizmo->next->prev = gizmo->prev;
+}
+
+/* Frees any of GIZMO's internal state.
+ GIZMO's data must not be referenced after calling this function. */
+static void
+free_gizmo (struct pool_gizmo *gizmo)
+{
+ assert (gizmo != NULL);
+
+ switch (gizmo->type)
+ {
+ case POOL_GIZMO_MALLOC:
+ free (gizmo);
+ break;
+ case POOL_GIZMO_FILE:
+ fclose (gizmo->p.file); /* Ignore errors. */
+ break;
+ case POOL_GIZMO_SUBPOOL:
+ gizmo->p.subpool->parent = NULL;
+ pool_destroy (gizmo->p.subpool);
+ break;
+ case POOL_GIZMO_REGISTERED:
+ gizmo->p.registered.free (gizmo->p.registered.p);
+ break;
+ default:
+ assert (0);
+ }
+}
+\f
+/* Memory allocation. */
+
+#if !PSPP
+/* Allocates SIZE bytes of space using malloc(). Aborts if out of
+ memory. */
+static void *
+xmalloc (size_t size)
+{
+ void *vp;
+ if (size == 0)
+ return NULL;
+ vp = malloc (size);
+ assert (vp != NULL);
+ if (vp == NULL)
+ abort ();
+ return vp;
+}
+
+/* Reallocates P to be SIZE bytes long using realloc(). Aborts if out
+ of memory. */
+static void *
+xrealloc (void *p, size_t size)
+{
+ if (p == NULL)
+ return xmalloc (size);
+ if (size == 0)
+ {
+ free (p);
+ return NULL;
+ }
+ p = realloc (p, size);
+ if (p == NULL)
+ abort ();
+ return p;
+}
+#endif /* !PSPP */
+\f
+/* Self-test routine. */
+
+#if SELF_TEST
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+
+#define N_ITERATIONS 8192
+#define N_FILES 16
+
+/* Self-test routine.
+ This is not exhaustive, but it can be useful. */
+int
+main (int argc, char **argv)
+{
+ int seed;
+
+ if (argc == 2)
+ seed = atoi (argv[1]);
+ else
+ seed = time (0) * 257 % 32768;
+
+ for (;;)
+ {
+ struct pool *pool;
+ struct pool_mark m1, m2;
+ FILE *files[N_FILES];
+ int cur_file;
+ long i;
+
+ printf ("Random number seed: %d\n", seed);
+ srand (seed++);
+
+ printf ("Creating pool...\n");
+ pool = pool_create ();
+
+ printf ("Marking pool state...\n");
+ pool_mark (pool, &m1);
+
+ printf (" Populating pool with random-sized small objects...\n");
+ for (i = 0; i < N_ITERATIONS; i++)
+ {
+ size_t size = rand () % MAX_SUBALLOC;
+ void *p = pool_alloc (pool, size);
+ memset (p, 0, size);
+ }
+
+ printf (" Marking pool state...\n");
+ pool_mark (pool, &m2);
+
+ printf (" Populating pool with random-sized small "
+ "and large objects...\n");
+ for (i = 0; i < N_ITERATIONS; i++)
+ {
+ size_t size = rand () % (2 * MAX_SUBALLOC);
+ void *p = pool_alloc (pool, size);
+ memset (p, 0, size);
+ }
+
+ printf (" Releasing pool state...\n");
+ pool_release (pool, &m2);
+
+ printf (" Populating pool with random objects and gizmos...\n");
+ for (i = 0; i < N_FILES; i++)
+ files[i] = NULL;
+ cur_file = 0;
+ for (i = 0; i < N_ITERATIONS; i++)
+ {
+ int type = rand () % 32;
+
+ if (type == 0)
+ {
+ if (files[cur_file] != NULL
+ && EOF == pool_fclose (pool, files[cur_file]))
+ printf ("error on fclose: %s\n", strerror (errno));
+
+ files[cur_file] = pool_fopen (pool, "/dev/null", "r");
+
+ if (++cur_file >= N_FILES)
+ cur_file = 0;
+ }
+ else if (type == 1)
+ pool_create_subpool (pool);
+ else
+ {
+ size_t size = rand () % (2 * MAX_SUBALLOC);
+ void *p = pool_alloc (pool, size);
+ memset (p, 0, size);
+ }
+ }
+
+ printf ("Releasing pool state...\n");
+ pool_release (pool, &m1);
+
+ printf ("Destroying pool...\n");
+ pool_destroy (pool);
+
+ putchar ('\n');
+ }
+}
+
+#endif /* SELF_TEST */
+
+/*
+ Local variables:
+ compile-command: "gcc -DSELF_TEST=1 -W -Wall -I. -o pool_test pool.c"
+ End:
+*/
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !pool_h
+#define pool_h 1
+
+#include <stdio.h>
+
+/* Records the state of a pool for later restoration. */
+struct pool_mark
+ {
+ /* Current block and offset into it. */
+ struct pool_block *block;
+ size_t ofs;
+
+ /* Current serial number to allow freeing of gizmos. */
+ long serial;
+ };
+
+/* General routines. */
+struct pool *pool_create (void);
+void pool_destroy (struct pool *);
+
+/* Suballocation routines. */
+void *pool_alloc (struct pool *, size_t);
+char *pool_strdup (struct pool *, const char *);
+char *pool_strcat (struct pool *, const char *, ...);
+
+/* Standard allocation routines. */
+void *pool_malloc (struct pool *, size_t);
+void *pool_realloc (struct pool *, void *, size_t);
+void pool_free (struct pool *, void *);
+
+/* Gizmo allocations. */
+struct pool *pool_create_subpool (struct pool *);
+FILE *pool_fopen (struct pool *, const char *, const char *);
+int pool_fclose (struct pool *, FILE *);
+
+/* Custom allocations. */
+void pool_register (struct pool *, void (*free) (void *), void *p);
+int pool_unregister (struct pool *, void *);
+
+/* Partial freeing. */
+void pool_mark (struct pool *, struct pool_mark *);
+void pool_release (struct pool *, const struct pool_mark *);
+
+#if GLOBAL_DEBUGGING
+void pool_dump (const struct pool *, const char *title);
+#endif
+
+#endif /* pool.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+/*this #if encloses the remainder of the file. */
+#if !NO_POSTSCRIPT
+
+#include <ctype.h>
+#include <assert.h>
+#include <errno.h>
+#include <limits.h>
+#include <stdlib.h>
+
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#if TIME_WITH_SYS_TIME
+#include <sys/time.h>
+#include <time.h>
+#else
+#if HAVE_SYS_TIME_H
+#include <sys/time.h>
+#else
+#include <time.h>
+#endif
+#endif
+
+#include "alloc.h"
+#include "bitvector.h"
+#include "error.h"
+#include "filename.h"
+#include "font.h"
+#include "getline.h"
+#include "hash.h"
+#include "main.h"
+#include "misc.h"
+#include "misc.h"
+#include "output.h"
+#include "version.h"
+
+/* FIXMEs:
+
+ optimize-text-size not implemented.
+
+ Line buffering is the only possibility; page buffering should also
+ be possible.
+
+ max-fonts-simult
+
+ Should add a field to give a file that has a list of fonts
+ typically used.
+
+ Should add an option that tells the driver it can emit %%Include:'s.
+
+ Should have auto-encode=true stream-edit or whatever to allow
+ addition to list of encodings.
+
+ Should align fonts of different sizes along their baselines (see
+ text()). */
+
+/* PostScript driver options: (defaults listed first)
+
+ output-file="pspp.ps"
+ color=yes|no
+ data=clean7bit|clean8bit|binary
+ line-ends=lf|crlf
+
+ paper-size=letter (see "papersize" file)
+ orientation=portrait|landscape
+ headers=on|off
+
+ left-margin=0.5in
+ right-margin=0.5in
+ top-margin=0.5in
+ bottom-margin=0.5in
+
+ font-dir=devps
+ prologue-file=ps-prologue
+ device-file=DESC
+ encoding-file=ps-encodings
+ auto-encode=true|false
+
+ prop-font-family=T
+ fixed-font-family=C
+ font-size=10000
+
+ line-style=thick|double
+ line-gutter=0.5pt
+ line-spacing=0.5pt
+ line-width=0.5pt
+ line-width-thick=1pt
+
+ optimize-text-size=1|0|2
+ optimize-line-size=1|0
+ max-fonts-simult=0 Max # of fonts in printer memory at once (0=infinite)
+ */
+
+/* The number of `psus' (PostScript driver UnitS) per inch. Although
+ this is a #define, the value is expected never to change. If it
+ does, review all uses. */
+#define PSUS 72000
+
+/* Magic numbers for PostScript and EPSF drivers. */
+enum
+ {
+ MAGIC_PS,
+ MAGIC_EPSF
+ };
+
+/* Orientations. */
+enum
+ {
+ OTN_PORTRAIT, /* Portrait. */
+ OTN_LANDSCAPE /* Landscape. */
+ };
+
+/* Output options. */
+enum
+ {
+ OPO_MIRROR_HORZ = 001, /* 1=Mirror across a horizontal axis. */
+ OPO_MIRROR_VERT = 002, /* 1=Mirror across a vertical axis. */
+ OPO_ROTATE_180 = 004, /* 1=Rotate the page 180 degrees. */
+ OPO_COLOR = 010, /* 1=Enable color. */
+ OPO_HEADERS = 020, /* 1=Draw headers at top of page. */
+ OPO_AUTO_ENCODE = 040, /* 1=Add encodings semi-intelligently. */
+ OPO_DOUBLE_LINE = 0100 /* 1=Double lines instead of thick lines. */
+ };
+
+/* Data allowed in output. */
+enum
+ {
+ ODA_CLEAN7BIT, /* 0x09, 0x0a, 0x0d, 0x1b...0x7e */
+ ODA_CLEAN8BIT, /* 0x09, 0x0a, 0x0d, 0x1b...0xff */
+ ODA_BINARY, /* 0x00...0xff */
+ ODA_COUNT
+ };
+
+/* Types of lines for purpose of caching. */
+enum
+ {
+ horz, /* Single horizontal. */
+ dbl_horz, /* Double horizontal. */
+ spl_horz, /* Special horizontal. */
+ vert, /* Single vertical. */
+ dbl_vert, /* Double vertical. */
+ spl_vert, /* Special vertical. */
+ n_line_types
+ };
+
+/* Cached line. */
+struct line_form
+ {
+ int ind; /* Independent var. Don't reorder. */
+ int mdep; /* Maximum number of dependent var pairs. */
+ int ndep; /* Current number of dependent var pairs. */
+ int dep[1][2]; /* Dependent var pairs. */
+ };
+
+/* Contents of ps_driver_ext.loaded. */
+struct font_entry
+ {
+ char *dit; /* Font Groff name. */
+ struct font_desc *font; /* Font descriptor. */
+ };
+
+/* Combines a font with a font size for benefit of generated code. */
+struct ps_font_combo
+ {
+ struct font_entry *font; /* Font. */
+ int size; /* Font size. */
+ int index; /* PostScript index. */
+ };
+
+/* A font encoding. */
+struct ps_encoding
+ {
+ char *filename; /* Normalized filename of this encoding. */
+ int index; /* Index value. */
+ };
+
+/* PostScript output driver extension record. */
+struct ps_driver_ext
+ {
+ /* User parameters. */
+ int orientation; /* OTN_PORTRAIT or OTN_LANDSCAPE. */
+ int output_options; /* OPO_*. */
+ int data; /* ODA_*. */
+
+ int left_margin; /* Left margin in psus. */
+ int right_margin; /* Right margin in psus. */
+ int top_margin; /* Top margin in psus. */
+ int bottom_margin; /* Bottom margin in psus. */
+
+ char eol[3]; /* End of line--CR, LF, or CRLF. */
+
+ char *font_dir; /* Font directory relative to font path. */
+ char *prologue_fn; /* Prologue's filename relative to font dir. */
+ char *desc_fn; /* DESC filename relative to font dir. */
+ char *encoding_fn; /* Encoding's filename relative to font dir. */
+
+ char *prop_family; /* Default proportional font family. */
+ char *fixed_family; /* Default fixed-pitch font family. */
+ int font_size; /* Default font size (psus). */
+
+ int line_gutter; /* Space around lines. */
+ int line_space; /* Space between lines. */
+ int line_width; /* Width of lines. */
+ int line_width_thick; /* Width of thick lines. */
+
+ int text_opt; /* Text optimization level. */
+ int line_opt; /* Line optimization level. */
+ int max_fonts; /* Max # of simultaneous fonts (0=infinite). */
+
+ /* Internal state. */
+ struct file_ext file; /* Output file. */
+ int page_number; /* Current page number. */
+ int file_page_number; /* Page number in this file. */
+ int w, l; /* Paper size. */
+ struct hsh_table *lines[n_line_types]; /* Line buffers. */
+
+ struct font_entry *prop; /* Default Roman proportional font. */
+ struct font_entry *fixed; /* Default Roman fixed-pitch font. */
+ struct hsh_table *loaded; /* Fonts in memory. */
+
+ struct hsh_table *combos; /* Combinations of fonts with font sizes. */
+ struct ps_font_combo *last_font; /* PostScript selected font. */
+ int next_combo; /* Next font combo position index. */
+
+ struct hsh_table *encodings;/* Set of encodings. */
+ int next_encoding; /* Next font encoding index. */
+
+ /* Currently selected font. */
+ struct font_entry *current; /* Current font. */
+ char *family; /* Font family. */
+ int size; /* Size in psus. */
+ }
+ps_driver_ext;
+
+/* Transform logical y-ordinate Y into a page ordinate. */
+#define YT(Y) (this->length - (Y))
+
+/* Prototypes. */
+static int postopen (struct file_ext *);
+static int preclose (struct file_ext *);
+static void draw_headers (struct outp_driver *this);
+
+static int compare_font_entry (const void *, const void *, void *param);
+static unsigned hash_font_entry (const void *, void *param);
+static void free_font_entry (void *, void *foo);
+static struct font_entry *load_font (struct outp_driver *, const char *dit);
+static void init_fonts (void);
+
+static void dump_lines (struct outp_driver *this);
+
+static void read_ps_encodings (struct outp_driver *this);
+static int compare_ps_encoding (const void *pa, const void *pb, void *foo);
+static unsigned hash_ps_encoding (const void *pa, void *foo);
+static void free_ps_encoding (void *a, void *foo);
+static void add_encoding (struct outp_driver *this, char *filename);
+static struct ps_encoding *default_encoding (struct outp_driver *this);
+
+static int compare_ps_combo (const void *pa, const void *pb, void *foo);
+static unsigned hash_ps_combo (const void *pa, void *foo);
+static void free_ps_combo (void *a, void *foo);
+
+static char *quote_ps_name (char *dest, const char *string);
+static char *quote_ps_string (char *dest, const char *string);
+\f
+/* Driver initialization. */
+
+int
+ps_open_global (struct outp_class *this unused)
+{
+ init_fonts ();
+ groff_init ();
+ return 1;
+}
+
+int
+ps_close_global (struct outp_class *this unused)
+{
+ return 1;
+}
+
+int *
+ps_font_sizes (struct outp_class *this unused, int *n_valid_sizes)
+{
+ /* Allow fonts up to 1" in height. */
+ static int valid_sizes[] =
+ {1, PSUS, 0, 0};
+
+ assert (n_valid_sizes != NULL);
+ *n_valid_sizes = 1;
+ return valid_sizes;
+}
+
+int
+ps_preopen_driver (struct outp_driver *this)
+{
+ struct ps_driver_ext *x;
+
+ int i;
+
+ assert (this->driver_open == 0);
+ msg (VM (1), _("PostScript driver initializing as `%s'..."), this->name);
+
+ this->ext = x = xmalloc (sizeof (struct ps_driver_ext));
+ this->res = PSUS;
+ this->horiz = this->vert = 1;
+ this->width = this->length = 0;
+
+ x->orientation = OTN_PORTRAIT;
+ x->output_options = OPO_COLOR | OPO_HEADERS | OPO_AUTO_ENCODE;
+ x->data = ODA_CLEAN7BIT;
+
+ x->left_margin = x->right_margin =
+ x->top_margin = x->bottom_margin = PSUS / 2;
+
+ strcpy (x->eol, "\n");
+
+ x->font_dir = NULL;
+ x->prologue_fn = NULL;
+ x->desc_fn = NULL;
+ x->encoding_fn = NULL;
+
+ x->prop_family = NULL;
+ x->fixed_family = NULL;
+ x->font_size = PSUS * 10 / 72;
+
+ x->line_gutter = PSUS / 144;
+ x->line_space = PSUS / 144;
+ x->line_width = PSUS / 144;
+ x->line_width_thick = PSUS / 48;
+
+ x->text_opt = -1;
+ x->line_opt = -1;
+ x->max_fonts = 0;
+
+ x->file.filename = NULL;
+ x->file.mode = "wb";
+ x->file.file = NULL;
+ x->file.sequence_no = &x->page_number;
+ x->file.param = this;
+ x->file.postopen = postopen;
+ x->file.preclose = preclose;
+ x->page_number = 0;
+ x->w = x->l = 0;
+
+ x->file_page_number = 0;
+ for (i = 0; i < n_line_types; i++)
+ x->lines[i] = NULL;
+ x->last_font = NULL;
+
+ x->prop = NULL;
+ x->fixed = NULL;
+ x->loaded = NULL;
+
+ x->next_combo = 0;
+ x->combos = NULL;
+
+ x->encodings = hsh_create (31, compare_ps_encoding, hash_ps_encoding,
+ free_ps_encoding, NULL);
+ x->next_encoding = 0;
+
+ x->current = NULL;
+ x->family = NULL;
+ x->size = 0;
+
+ return 1;
+}
+
+int
+ps_postopen_driver (struct outp_driver *this)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ assert (this->driver_open == 0);
+
+ if (this->width == 0)
+ {
+ this->width = PSUS * 17 / 2; /* Defaults to 8.5"x11". */
+ this->length = PSUS * 11;
+ }
+
+ if (x->text_opt == -1)
+ x->text_opt = (this->device & OUTP_DEV_SCREEN) ? 0 : 1;
+ if (x->line_opt == -1)
+ x->line_opt = (this->device & OUTP_DEV_SCREEN) ? 0 : 1;
+
+ x->w = this->width;
+ x->l = this->length;
+ if (x->orientation == OTN_LANDSCAPE)
+ {
+ int temp = this->width;
+ this->width = this->length;
+ this->length = temp;
+ }
+ this->width -= x->left_margin + x->right_margin;
+ this->length -= x->top_margin + x->bottom_margin;
+ if (x->output_options & OPO_HEADERS)
+ {
+ this->length -= 3 * x->font_size;
+ x->top_margin += 3 * x->font_size;
+ }
+ if (NULL == x->file.filename)
+ x->file.filename = xstrdup ("pspp.ps");
+
+ if (x->font_dir == NULL)
+ x->font_dir = xstrdup ("devps");
+ if (x->prologue_fn == NULL)
+ x->prologue_fn = xstrdup ("ps-prologue");
+ if (x->desc_fn == NULL)
+ x->desc_fn = xstrdup ("DESC");
+ if (x->encoding_fn == NULL)
+ x->encoding_fn = xstrdup ("ps-encodings");
+
+ if (x->prop_family == NULL)
+ x->prop_family = xstrdup ("H");
+ if (x->fixed_family == NULL)
+ x->fixed_family = xstrdup ("C");
+
+ read_ps_encodings (this);
+
+ x->family = NULL;
+ x->size = PSUS / 6;
+
+ if (this->length / x->font_size < 15)
+ {
+ msg (SE, _("PostScript driver: The defined page is not long "
+ "enough to hold margins and headers, plus least 15 "
+ "lines of the default fonts. In fact, there's only "
+ "room for %d lines of each font at the default size "
+ "of %d.%03d points."),
+ this->length / x->font_size,
+ x->font_size / 1000, x->font_size % 1000);
+ return 0;
+ }
+
+ this->driver_open = 1;
+ msg (VM (2), _("%s: Initialization complete."), this->name);
+
+ return 1;
+}
+
+int
+ps_close_driver (struct outp_driver *this)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ int i;
+
+ assert (this->driver_open == 1);
+ msg (VM (2), _("%s: Beginning closing..."), this->name);
+
+ fn_close_ext (&x->file);
+ free (x->file.filename);
+ free (x->font_dir);
+ free (x->prologue_fn);
+ free (x->desc_fn);
+ free (x->encoding_fn);
+ free (x->prop_family);
+ free (x->fixed_family);
+ free (x->family);
+ for (i = 0; i < n_line_types; i++)
+ hsh_destroy (x->lines[i]);
+ hsh_destroy (x->encodings);
+ hsh_destroy (x->combos);
+ hsh_destroy (x->loaded);
+ free (x);
+
+ this->driver_open = 0;
+ msg (VM (3), _("%s: Finished closing."), this->name);
+
+ return 1;
+}
+
+/* font_entry comparison function for hash tables. */
+static int
+compare_font_entry (const void *a, const void *b, void *foobar unused)
+{
+ return strcmp (((struct font_entry *) a)->dit, ((struct font_entry *) b)->dit);
+}
+
+/* font_entry hash function for hash tables. */
+static unsigned
+hash_font_entry (const void *a, void *foobar unused)
+{
+ return hashpjw (((struct font_entry *) a)->dit);
+}
+
+/* font_entry destructor function for hash tables. */
+static void
+free_font_entry (void *pa, void *foo unused)
+{
+ struct font_entry *a = pa;
+ free (a->dit);
+ free (a);
+}
+
+/* Generic option types. */
+enum
+{
+ boolean_arg = -10,
+ pos_int_arg,
+ dimension_arg,
+ string_arg,
+ nonneg_int_arg
+};
+
+/* All the options that the PostScript driver supports. */
+static struct outp_option option_tab[] =
+{
+ /* *INDENT-OFF* */
+ {"output-file", 1, 0},
+ {"paper-size", 2, 0},
+ {"orientation", 3, 0},
+ {"color", boolean_arg, 0},
+ {"data", 4, 0},
+ {"auto-encode", boolean_arg, 5},
+ {"headers", boolean_arg, 1},
+ {"left-margin", pos_int_arg, 0},
+ {"right-margin", pos_int_arg, 1},
+ {"top-margin", pos_int_arg, 2},
+ {"bottom-margin", pos_int_arg, 3},
+ {"font-dir", string_arg, 0},
+ {"prologue-file", string_arg, 1},
+ {"device-file", string_arg, 2},
+ {"encoding-file", string_arg, 3},
+ {"prop-font-family", string_arg, 5},
+ {"fixed-font-family", string_arg, 6},
+ {"font-size", pos_int_arg, 4},
+ {"optimize-text-size", nonneg_int_arg, 0},
+ {"optimize-line-size", nonneg_int_arg, 1},
+ {"max-fonts-simult", nonneg_int_arg, 2},
+ {"line-ends", 6, 0},
+ {"line-style", 7, 0},
+ {"line-width", dimension_arg, 2},
+ {"line-gutter", dimension_arg, 3},
+ {"line-width", dimension_arg, 4},
+ {"line-width-thick", dimension_arg, 5},
+ {"", 0, 0},
+ /* *INDENT-ON* */
+};
+static struct outp_option_info option_info;
+
+void
+ps_option (struct outp_driver *this, const char *key, const struct string *val)
+{
+ struct ps_driver_ext *x = this->ext;
+ int cat, subcat;
+ char *value = ds_value (val);
+
+ cat = outp_match_keyword (key, option_tab, &option_info, &subcat);
+
+ switch (cat)
+ {
+ case 0:
+ msg (SE, _("Unknown configuration parameter `%s' for PostScript device "
+ "driver."), key);
+ break;
+ case 1:
+ free (x->file.filename);
+ x->file.filename = xstrdup (value);
+ break;
+ case 2:
+ outp_get_paper_size (value, &this->width, &this->length);
+ break;
+ case 3:
+ if (!strcmp (value, "portrait"))
+ x->orientation = OTN_PORTRAIT;
+ else if (!strcmp (value, "landscape"))
+ x->orientation = OTN_LANDSCAPE;
+ else
+ msg (SE, _("Unknown orientation `%s'. Valid orientations are "
+ "`portrait' and `landscape'."), value);
+ break;
+ case 4:
+ if (!strcmp (value, "clean7bit") || !strcmp (value, "Clean7Bit"))
+ x->data = ODA_CLEAN7BIT;
+ else if (!strcmp (value, "clean8bit")
+ || !strcmp (value, "Clean8Bit"))
+ x->data = ODA_CLEAN8BIT;
+ else if (!strcmp (value, "binary") || !strcmp (value, "Binary"))
+ x->data = ODA_BINARY;
+ else
+ msg (SE, _("Unknown value for `data'. Valid values are `clean7bit', "
+ "`clean8bit', and `binary'."));
+ break;
+ case 6:
+ if (!strcmp (value, "lf"))
+ strcpy (x->eol, "\n");
+ else if (!strcmp (value, "crlf"))
+ strcpy (x->eol, "\r\n");
+ else
+ msg (SE, _("Unknown value for `line-ends'. Valid values are `lf' and "
+ "`crlf'."));
+ break;
+ case 7:
+ if (!strcmp (value, "thick"))
+ x->output_options &= ~OPO_DOUBLE_LINE;
+ else if (!strcmp (value, "double"))
+ x->output_options |= OPO_DOUBLE_LINE;
+ else
+ msg (SE, _("Unknown value for `line-style'. Valid values are `thick' "
+ "and `double'."));
+ break;
+ case boolean_arg:
+ {
+ int setting;
+ int mask;
+
+ if (!strcmp (value, "on") || !strcmp (value, "true")
+ || !strcmp (value, "yes") || atoi (value))
+ setting = 1;
+ else if (!strcmp (value, "off") || !strcmp (value, "false")
+ || !strcmp (value, "no") || !strcmp (value, "0"))
+ setting = 0;
+ else
+ {
+ msg (SE, _("Boolean value expected for %s."), key);
+ return;
+ }
+ switch (subcat)
+ {
+ case 0:
+ mask = OPO_COLOR;
+ break;
+ case 1:
+ mask = OPO_HEADERS;
+ break;
+ case 2:
+ mask = OPO_MIRROR_HORZ;
+ break;
+ case 3:
+ mask = OPO_MIRROR_VERT;
+ break;
+ case 4:
+ mask = OPO_ROTATE_180;
+ break;
+ case 5:
+ mask = OPO_AUTO_ENCODE;
+ break;
+ default:
+ assert (0);
+ }
+ if (setting)
+ x->output_options |= mask;
+ else
+ x->output_options &= ~mask;
+ }
+ break;
+ case pos_int_arg:
+ {
+ char *tail;
+ int arg;
+
+ errno = 0;
+ arg = strtol (value, &tail, 0);
+ if (arg < 1 || errno == ERANGE || *tail)
+ {
+ msg (SE, _("Positive integer required as value for `%s'."), key);
+ break;
+ }
+ if ((subcat == 4 || subcat == 5) && arg < 1000)
+ {
+ msg (SE, _("Default font size must be at least 1 point (value "
+ "of 1000 for key `%s')."), key);
+ break;
+ }
+ switch (subcat)
+ {
+ case 0:
+ x->left_margin = arg;
+ break;
+ case 1:
+ x->right_margin = arg;
+ break;
+ case 2:
+ x->top_margin = arg;
+ break;
+ case 3:
+ x->bottom_margin = arg;
+ break;
+ case 4:
+ x->font_size = arg;
+ break;
+ default:
+ assert (0);
+ }
+ }
+ break;
+ case dimension_arg:
+ {
+ int dimension = outp_evaluate_dimension (value, NULL);
+
+ if (dimension <= 0)
+ {
+ msg (SE, _("Value for `%s' must be a dimension of positive "
+ "length (i.e., `1in')."), key);
+ break;
+ }
+ switch (subcat)
+ {
+ case 2:
+ x->line_width = dimension;
+ break;
+ case 3:
+ x->line_gutter = dimension;
+ break;
+ case 4:
+ x->line_width = dimension;
+ break;
+ case 5:
+ x->line_width_thick = dimension;
+ break;
+ default:
+ assert (0);
+ }
+ }
+ break;
+ case string_arg:
+ {
+ char **dest;
+ switch (subcat)
+ {
+ case 0:
+ dest = &x->font_dir;
+ break;
+ case 1:
+ dest = &x->prologue_fn;
+ break;
+ case 2:
+ dest = &x->desc_fn;
+ break;
+ case 3:
+ dest = &x->encoding_fn;
+ break;
+ case 5:
+ dest = &x->prop_family;
+ break;
+ case 6:
+ dest = &x->fixed_family;
+ break;
+ default:
+ assert (0);
+ }
+ if (*dest)
+ free (*dest);
+ *dest = xstrdup (value);
+ }
+ break;
+ case nonneg_int_arg:
+ {
+ char *tail;
+ int arg;
+
+ errno = 0;
+ arg = strtol (value, &tail, 0);
+ if (arg < 0 || errno == ERANGE || *tail)
+ {
+ msg (SE, _("Nonnegative integer required as value for `%s'."), key);
+ break;
+ }
+ switch (subcat)
+ {
+ case 0:
+ x->text_opt = arg;
+ break;
+ case 1:
+ x->line_opt = arg;
+ break;
+ case 2:
+ x->max_fonts = arg;
+ break;
+ default:
+ assert (0);
+ }
+ }
+ break;
+#if __CHECKER__
+ case 42000:
+ assert (0);
+#endif
+ default:
+ assert (0);
+ }
+}
+
+/* Looks for a PostScript font file or config file in all the
+ appropriate places. Returns the filename on success, NULL on
+ failure. */
+/* PORTME: Filename operations. */
+static char *
+find_ps_file (struct outp_driver *this, const char *name)
+{
+ struct ps_driver_ext *x = this->ext;
+ char *cp;
+
+ /* x->font_dir + name: "devps/ps-encodings". */
+ char *basename;
+
+ /* Usually equal to groff_font_path. */
+ char *pathname;
+
+ /* Final filename. */
+ char *fn;
+
+ /* Make basename. */
+ basename = local_alloc (strlen (x->font_dir) + 1 + strlen (name) + 1);
+ cp = stpcpy (basename, x->font_dir);
+ *cp++ = DIR_SEPARATOR;
+ strcpy (cp, name);
+
+ /* Decide on search path. */
+ {
+ const char *pre_pathname;
+
+ pre_pathname = getenv ("STAT_GROFF_FONT_PATH");
+ if (pre_pathname == NULL)
+ pre_pathname = getenv ("GROFF_FONT_PATH");
+ if (pre_pathname == NULL)
+ pre_pathname = groff_font_path;
+ pathname = fn_tilde_expand (pre_pathname);
+ }
+
+ /* Search all possible places for the file. */
+ fn = fn_search_path (basename, pathname, NULL);
+ if (fn == NULL)
+ fn = fn_search_path (basename, config_path, NULL);
+ if (fn == NULL)
+ fn = fn_search_path (name, pathname, NULL);
+ if (fn == NULL)
+ fn = fn_search_path (name, config_path, NULL);
+ free (pathname);
+ local_free (basename);
+
+ return fn;
+}
+\f
+/* Encodings. */
+
+/* Hash table comparison function for ps_encoding's. */
+static int
+compare_ps_encoding (const void *pa, const void *pb, void *foo unused)
+{
+ const struct ps_encoding *a = pa;
+ const struct ps_encoding *b = pb;
+
+ return strcmp (a->filename, b->filename);
+}
+
+/* Hash table hash function for ps_encoding's. */
+static unsigned
+hash_ps_encoding (const void *pa, void *foo unused)
+{
+ const struct ps_encoding *a = pa;
+
+ return hashpjw (a->filename);
+}
+
+/* Hash table free function for ps_encoding's. */
+static void
+free_ps_encoding (void *pa, void *foo unused)
+{
+ struct ps_encoding *a = pa;
+
+ free (a->filename);
+ free (a);
+}
+
+/* Iterates through the list of encodings used for this driver
+ instance, reads each of them from disk, and writes them as
+ PostScript code to the output file. */
+static void
+output_encodings (struct outp_driver *this)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ struct hsh_iterator iter;
+ struct ps_encoding *pe;
+
+ struct string line, buf;
+
+ ds_init (NULL, &line, 128);
+ ds_init (NULL, &buf, 128);
+ hsh_iterator_init (iter);
+ while ((pe = hsh_foreach (x->encodings, &iter)) != NULL)
+ {
+ FILE *f;
+
+ msg (VM (1), _("%s: %s: Opening PostScript font encoding..."),
+ this->name, pe->filename);
+
+ f = fopen (pe->filename, "r");
+ if (!f)
+ {
+ msg (IE, _("PostScript driver: Cannot open encoding file `%s': %s. "
+ "Substituting ISOLatin1Encoding for missing encoding."),
+ pe->filename, strerror (errno));
+ fprintf (x->file.file, "/E%x ISOLatin1Encoding def%s",
+ pe->index, x->eol);
+ }
+ else
+ {
+ struct file_locator where;
+
+ const char *tab[256];
+
+ char *pschar;
+ char *code;
+ int code_val;
+ char *fubar;
+
+ const char *notdef = ".notdef";
+
+ int i;
+
+ for (i = 0; i < 256; i++)
+ tab[i] = notdef;
+
+ where.filename = pe->filename;
+ where.line_number = 0;
+ err_push_file_locator (&where);
+
+ while (ds_get_config_line (f, &buf, &where))
+ {
+ char *sp;
+
+ pschar = strtok_r (ds_value (&buf), " \t\r\n", &sp);
+ code = strtok_r (NULL, " \t\r\n", &sp);
+ if (*pschar == 0 || *code == 0)
+ continue;
+ code_val = strtol (code, &fubar, 0);
+ if (*fubar)
+ {
+ msg (IS, _("PostScript driver: Invalid numeric format."));
+ continue;
+ }
+ if (code_val < 0 || code_val > 255)
+ {
+ msg (IS, _("PostScript driver: Codes must be between 0 "
+ "and 255. (%d is not allowed.)"), code_val);
+ break;
+ }
+ tab[code_val] = local_alloc (strlen (pschar) + 1);
+ strcpy ((char *) (tab[code_val]), pschar);
+ }
+ err_pop_file_locator (&where);
+
+ ds_clear (&line);
+ ds_printf (&line, "/E%x[", pe->index);
+ for (i = 0; i < 257; i++)
+ {
+ char temp[288];
+
+ if (i < 256)
+ {
+ quote_ps_name (temp, tab[i]);
+ if (tab[i] != notdef)
+ local_free (tab[i]);
+ }
+ else
+ strcpy (temp, "]def");
+
+ if (ds_length (&line) + strlen (temp) > 70)
+ {
+ ds_concat (&line, x->eol);
+ fputs (ds_value (&line), x->file.file);
+ ds_clear (&line);
+ }
+ ds_concat (&line, temp);
+ }
+ ds_concat (&line, x->eol);
+ fputs (ds_value (&line), x->file.file);
+
+ if (fclose (f) == EOF)
+ msg (MW, _("PostScript driver: Error closing encoding file `%s'."),
+ pe->filename);
+
+ msg (VM (2), _("%s: PostScript font encoding read successfully."),
+ this->name);
+ }
+ }
+ ds_destroy (&line);
+ ds_destroy (&buf);
+}
+
+/* Finds the ps_encoding in THIS that corresponds to the file with
+ name NORM_FILENAME, which must have previously been normalized with
+ normalize_filename(). */
+static struct ps_encoding *
+get_encoding (struct outp_driver *this, const char *norm_filename)
+{
+ struct ps_driver_ext *x = this->ext;
+ struct ps_encoding *pe;
+
+ pe = (struct ps_encoding *) hsh_find (x->encodings, (void *) &norm_filename);
+ return pe;
+}
+
+/* Searches the filesystem for an encoding file with name FILENAME;
+ returns its malloc'd, normalized name if found, otherwise NULL. */
+static char *
+find_encoding_file (struct outp_driver *this, char *filename)
+{
+ char *cp, *temp;
+
+ if (filename == NULL)
+ return NULL;
+ while (isspace ((unsigned char) *filename))
+ filename++;
+ for (cp = filename; *cp && !isspace ((unsigned char) *cp); cp++)
+ ;
+ if (cp == filename)
+ return NULL;
+ *cp = 0;
+
+ temp = find_ps_file (this, filename);
+ if (temp == NULL)
+ return NULL;
+
+ filename = fn_normalize (temp);
+ assert (filename != NULL);
+ free (temp);
+
+ return filename;
+}
+
+/* Adds the encoding represented by the not-necessarily-normalized
+ file FILENAME to the list of encodings, if it exists and is not
+ already in the list. */
+static void
+add_encoding (struct outp_driver *this, char *filename)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ struct ps_encoding **pe;
+
+ filename = find_encoding_file (this, filename);
+ if (!filename)
+ return;
+
+ pe = (struct ps_encoding **) hsh_probe (x->encodings, (void *) &filename);
+ if (*pe)
+ {
+ free (filename);
+ return;
+ }
+ *pe = xmalloc (sizeof **pe);
+ (*pe)->filename = filename;
+ (*pe)->index = x->next_encoding++;
+}
+
+/* Finds the file on disk that contains the list of encodings to
+ include in the output file, then adds those encodings to the list
+ of encodings. */
+static void
+read_ps_encodings (struct outp_driver *this)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ /* Encodings file. */
+ char *encoding_fn; /* `ps-encodings' filename. */
+ FILE *f;
+
+ struct string line;
+ struct file_locator where;
+
+ /* It's okay if there's no list of encodings; not everyone cares. */
+ encoding_fn = find_ps_file (this, x->encoding_fn);
+ if (encoding_fn == NULL)
+ return;
+ free (encoding_fn);
+
+ msg (VM (1), _("%s: %s: Opening PostScript encoding list file."),
+ this->name, encoding_fn);
+ f = fopen (encoding_fn, "r");
+ if (!f)
+ {
+ msg (IE, _("Opening %s: %s."), encoding_fn, strerror (errno));
+ return;
+ }
+
+ where.filename = encoding_fn;
+ where.line_number = 0;
+ err_push_file_locator (&where);
+
+ ds_init (NULL, &line, 128);
+
+ for (;;)
+ {
+ char *bp;
+
+ if (!ds_get_config_line (f, &line, &where))
+ {
+ if (ferror (f))
+ msg (ME, _("Reading %s: %s."), encoding_fn, strerror (errno));
+ break;
+ }
+
+ add_encoding (this, bp);
+ }
+
+ ds_destroy (&line);
+ err_pop_file_locator (&where);
+
+ if (-1 == fclose (f))
+ msg (MW, _("Closing %s: %s."), encoding_fn, strerror (errno));
+
+ msg (VM (2), _("%s: PostScript encoding list file read successfully."), this->name);
+}
+
+/* Creates a default encoding for driver D that can be substituted for
+ an unavailable encoding. */
+struct ps_encoding *
+default_encoding (struct outp_driver *d)
+{
+ struct ps_driver_ext *x = d->ext;
+ static struct ps_encoding *enc;
+
+ if (!enc)
+ {
+ enc = xmalloc (sizeof *enc);
+ enc->filename = xstrdup (_("<<default encoding>>"));
+ enc->index = x->next_encoding++;
+ }
+ return enc;
+}
+\f
+/* Basic file operations. */
+
+/* Variables for the prologue. */
+struct ps_variable
+ {
+ const char *key;
+ const char *value;
+ };
+
+static struct ps_variable *ps_var_tab;
+
+/* Searches ps_var_tab for a ps_variable with key KEY, and returns the
+ associated value. */
+static const char *
+ps_get_var (const char *key)
+{
+ struct ps_variable *v;
+
+ for (v = ps_var_tab; v->key; v++)
+ if (!strcmp (key, v->key))
+ return v->value;
+ return NULL;
+}
+
+/* Writes the PostScript prologue to file F. */
+static int
+postopen (struct file_ext *f)
+{
+ static struct ps_variable dict[] =
+ {
+ {"bounding-box", 0},
+ {"creator", 0},
+ {"date", 0},
+ {"data", 0},
+ {"orientation", 0},
+ {"user", 0},
+ {"host", 0},
+ {"prop-font", 0},
+ {"fixed-font", 0},
+ {"scale-factor", 0},
+ {"paper-width", 0},
+ {"paper-length", 0},
+ {"left-margin", 0},
+ {"top-margin", 0},
+ {"line-width", 0},
+ {"line-width-thick", 0},
+ {"title", 0},
+ {"source-file", 0},
+ {0, 0},
+ };
+ char boundbox[INT_DIGITS * 4 + 4];
+#if HAVE_UNISTD_H
+ char host[128];
+#endif
+ char scaling[INT_DIGITS + 5];
+ time_t curtime;
+ struct tm *loctime;
+ char *p, *cp;
+ char paper_width[INT_DIGITS + 1];
+ char paper_length[INT_DIGITS + 1];
+ char left_margin[INT_DIGITS + 1];
+ char top_margin[INT_DIGITS + 1];
+ char line_width[INT_DIGITS + 1];
+ char line_width_thick[INT_DIGITS + 1];
+
+ struct outp_driver *this = f->param;
+ struct ps_driver_ext *x = this->ext;
+
+ char *prologue_fn = find_ps_file (this, x->prologue_fn);
+ FILE *prologue_file;
+
+ char *buf = NULL;
+ size_t buf_size = 0;
+
+ x->loaded = hsh_create (31, compare_font_entry, hash_font_entry,
+ free_font_entry, NULL);
+
+ {
+ char *font_name = local_alloc (2 + max (strlen (x->prop_family),
+ strlen (x->fixed_family)));
+
+ strcpy (stpcpy (font_name, x->prop_family), "R");
+ x->prop = load_font (this, font_name);
+
+ strcpy (stpcpy (font_name, x->fixed_family), "R");
+ x->fixed = load_font (this, font_name);
+
+ local_free(font_name);
+ }
+
+ x->current = x->prop;
+ x->family = xstrdup (x->prop_family);
+ x->size = x->font_size;
+
+ {
+ int *h = this->horiz_line_width, *v = this->vert_line_width;
+
+ this->cp_x = this->cp_y = 0;
+ this->font_height = x->font_size;
+ {
+ struct char_metrics *metric;
+
+ metric = font_get_char_metrics (x->prop->font, '0');
+ this->prop_em_width = ((metric
+ ? metric->width : x->prop->font->space_width)
+ * x->font_size / 1000);
+
+ metric = font_get_char_metrics (x->fixed->font, '0');
+ this->fixed_width = ((metric
+ ? metric->width : x->fixed->font->space_width)
+ * x->font_size / 1000);
+ }
+
+ h[0] = v[0] = 0;
+ h[1] = v[1] = 2 * x->line_gutter + x->line_width;
+ if (x->output_options & OPO_DOUBLE_LINE)
+ h[2] = v[2] = 2 * x->line_gutter + 2 * x->line_width + x->line_space;
+ else
+ h[2] = v[2] = 2 * x->line_gutter + x->line_width_thick;
+ h[3] = v[3] = 2 * x->line_gutter + x->line_width;
+
+ {
+ int i;
+
+ for (i = 0; i < (1 << OUTP_L_COUNT); i++)
+ {
+ int bit;
+
+ /* Maximum width of any line type so far. */
+ int max = 0;
+
+ for (bit = 0; bit < OUTP_L_COUNT; bit++)
+ if ((i & (1 << bit)) && h[bit] > max)
+ max = h[bit];
+ this->horiz_line_spacing[i] = this->vert_line_spacing[i] = max;
+ }
+ }
+ }
+
+ if (x->output_options & OPO_AUTO_ENCODE)
+ {
+ /* It's okay if this is done more than once since add_encoding()
+ is idempotent over identical encodings. */
+ add_encoding (this, x->prop->font->encoding);
+ add_encoding (this, x->fixed->font->encoding);
+ }
+
+ x->file_page_number = 0;
+
+ errno = 0;
+ if (prologue_fn == NULL)
+ {
+ msg (IE, _("Cannot find PostScript prologue. The use of `-vv' "
+ "on the command line is suggested as a debugging aid."));
+ return 0;
+ }
+
+ msg (VM (1), _("%s: %s: Opening PostScript prologue..."),
+ this->name, prologue_fn);
+ prologue_file = fopen (prologue_fn, "rb");
+ if (prologue_file == NULL)
+ {
+ fclose (prologue_file);
+ free (prologue_fn);
+ msg (IE, "%s: %s", prologue_fn, strerror (errno));
+ goto error;
+ }
+
+ sprintf (boundbox, "0 0 %d %d",
+ x->w / (PSUS / 72) + (x->w % (PSUS / 72) > 0),
+ x->l / (PSUS / 72) + (x->l % (PSUS / 72) > 0));
+ dict[0].value = boundbox;
+
+ dict[1].value = (char *) version;
+
+ curtime = time (NULL);
+ loctime = localtime (&curtime);
+ dict[2].value = asctime (loctime);
+ cp = strchr (dict[2].value, '\n');
+ if (cp)
+ *cp = 0;
+
+ switch (x->data)
+ {
+ case ODA_CLEAN7BIT:
+ dict[3].value = "Clean7Bit";
+ break;
+ case ODA_CLEAN8BIT:
+ dict[3].value = "Clean8Bit";
+ break;
+ case ODA_BINARY:
+ dict[3].value = "Binary";
+ break;
+ default:
+ assert (0);
+ }
+
+ if (x->orientation == OTN_PORTRAIT)
+ dict[4].value = "Portrait";
+ else
+ dict[4].value = "Landscape";
+
+ /* PORTME: Determine username, net address. */
+#if HAVE_UNISTD_H
+ dict[5].value = getenv ("LOGNAME");
+ if (!dict[5].value)
+ dict[5].value = getlogin ();
+ if (!dict[5].value)
+ dict[5].value = _("nobody");
+
+ if (gethostname (host, 128) == -1)
+ {
+ if (errno == ENAMETOOLONG)
+ host[127] = 0;
+ else
+ strcpy (host, _("nowhere"));
+ }
+ dict[6].value = host;
+#else /* !HAVE_UNISTD_H */
+ dict[5].value = _("nobody");
+ dict[6].value = _("nowhere");
+#endif /* !HAVE_UNISTD_H */
+
+ cp = stpcpy (p = local_alloc (288), "font ");
+ quote_ps_string (cp, x->prop->font->internal_name);
+ dict[7].value = p;
+
+ cp = stpcpy (p = local_alloc (288), "font ");
+ quote_ps_string (cp, x->fixed->font->internal_name);
+ dict[8].value = p;
+
+ sprintf (scaling, "%.3f", PSUS / 72.0);
+ dict[9].value = scaling;
+
+ sprintf (paper_width, "%g", x->w / (PSUS / 72.0));
+ dict[10].value = paper_width;
+
+ sprintf (paper_length, "%g", x->l / (PSUS / 72.0));
+ dict[11].value = paper_length;
+
+ sprintf (left_margin, "%d", x->left_margin);
+ dict[12].value = left_margin;
+
+ sprintf (top_margin, "%d", x->top_margin);
+ dict[13].value = top_margin;
+
+ sprintf (line_width, "%d", x->line_width);
+ dict[14].value = line_width;
+
+ sprintf (line_width, "%d", x->line_width_thick);
+ dict[15].value = line_width_thick;
+
+ getl_location (&dict[17].value, NULL);
+ if (dict[17].value == NULL)
+ dict[17].value = "<stdin>";
+
+ if (!outp_title)
+ {
+ dict[16].value = cp = local_alloc (strlen (dict[17].value) + 30);
+ sprintf (cp, "PSPP (%s)", dict[17].value);
+ }
+ else
+ {
+ dict[16].value = local_alloc (strlen (outp_title) + 1);
+ strcpy ((char *) (dict[16].value), outp_title);
+ }
+
+ ps_var_tab = dict;
+ while (-1 != getline (&buf, &buf_size, prologue_file))
+ {
+ char *cp;
+ char *buf2;
+ int len;
+
+ cp = strstr (buf, "!eps");
+ if (cp)
+ {
+ if (this->class->magic == MAGIC_PS)
+ continue;
+ else
+ *cp = '\0';
+ }
+ else
+ {
+ cp = strstr (buf, "!ps");
+ if (cp)
+ {
+ if (this->class->magic == MAGIC_EPSF)
+ continue;
+ else
+ *cp = '\0';
+ } else {
+ if (strstr (buf, "!!!"))
+ continue;
+ }
+ }
+
+ if (!strncmp (buf, "!encodings", 10))
+ output_encodings (this);
+ else
+ {
+ char *beg;
+ beg = buf2 = fn_interp_vars (buf, ps_get_var);
+ len = strlen (buf2);
+ while (isspace (*beg))
+ beg++, len--;
+ if (beg[len - 1] == '\n')
+ len--;
+ if (beg[len - 1] == '\r')
+ len--;
+ fwrite (beg, len, 1, f->file);
+ fputs (x->eol, f->file);
+ free (buf2);
+ }
+ }
+ if (ferror (f->file))
+ msg (IE, _("Reading `%s': %s."), prologue_fn, strerror (errno));
+ fclose (prologue_file);
+
+ free (prologue_fn);
+ free (buf);
+
+ local_free (dict[7].value);
+ local_free (dict[8].value);
+ local_free (dict[16].value);
+
+ if (ferror (f->file))
+ goto error;
+
+ msg (VM (2), _("%s: PostScript prologue read successfully."), this->name);
+ return 1;
+
+error:
+ msg (VM (1), _("%s: Error reading PostScript prologue."), this->name);
+ return 0;
+}
+
+/* Writes the string STRING to buffer DEST (of at least 288
+ characters) as a PostScript name object. Returns a pointer
+ to the null terminator of the resultant string. */
+static char *
+quote_ps_name (char *dest, const char *string)
+{
+ const char *sp;
+
+ for (sp = string; *sp; sp++)
+ switch (*(unsigned char *) sp)
+ {
+ case 'a':
+ case 'f':
+ case 'k':
+ case 'p':
+ case 'u':
+ case 'b':
+ case 'g':
+ case 'l':
+ case 'q':
+ case 'v':
+ case 'c':
+ case 'h':
+ case 'm':
+ case 'r':
+ case 'w':
+ case 'd':
+ case 'i':
+ case 'n':
+ case 's':
+ case 'x':
+ case 'e':
+ case 'j':
+ case 'o':
+ case 't':
+ case 'y':
+ case 'z':
+ case 'A':
+ case 'F':
+ case 'K':
+ case 'P':
+ case 'U':
+ case 'B':
+ case 'G':
+ case 'L':
+ case 'Q':
+ case 'V':
+ case 'C':
+ case 'H':
+ case 'M':
+ case 'R':
+ case 'W':
+ case 'D':
+ case 'I':
+ case 'N':
+ case 'S':
+ case 'X':
+ case 'E':
+ case 'J':
+ case 'O':
+ case 'T':
+ case 'Y':
+ case 'Z':
+ case '@':
+ case '^':
+ case '_':
+ case '|':
+ case '!':
+ case '$':
+ case '&':
+ case ':':
+ case ';':
+ case '.':
+ case ',':
+ case '-':
+ case '+':
+ break;
+ default:
+ {
+ char *dp = dest;
+
+ *dp++ = '<';
+ for (sp = string; *sp && dp < &dest[256]; sp++)
+ {
+ sprintf (dp, "%02x", *(unsigned char *) sp);
+ dp += 2;
+ }
+ return stpcpy (dp, ">cvn");
+ }
+ }
+ dest[0] = '/';
+ return stpcpy (&dest[1], string);
+}
+
+/* Adds the string STRING to buffer DEST as a PostScript quoted
+ string; returns a pointer to the null terminator added. Will not
+ add more than 235 characters. */
+static char *
+quote_ps_string (char *dest, const char *string)
+{
+ const char *sp = string;
+ char *dp = dest;
+
+ *dp++ = '(';
+ for (; *sp && dp < &dest[235]; sp++)
+ if (*sp == '(')
+ dp = stpcpy (dp, "\\(");
+ else if (*sp == ')')
+ dp = stpcpy (dp, "\\)");
+ else if (*sp < 32 || *((unsigned char *) sp) > 127)
+ dp = spprintf (dp, "\\%3o", *sp);
+ else
+ *dp++ = *sp;
+ return stpcpy (dp, ")");
+}
+
+/* Writes the PostScript epilogue to file F. */
+static int
+preclose (struct file_ext *f)
+{
+ struct outp_driver *this = f->param;
+ struct ps_driver_ext *x = this->ext;
+ struct hsh_iterator iter;
+ struct font_entry *fe;
+
+ fprintf (f->file,
+ ("%%%%Trailer%s"
+ "%%%%Pages: %d%s"
+ "%%%%DocumentNeededResources:%s"),
+ x->eol, x->file_page_number, x->eol, x->eol);
+
+ hsh_iterator_init (iter);
+ while ((fe = hsh_foreach (x->loaded, &iter)) != NULL)
+ {
+ char buf[256], *cp;
+
+ cp = stpcpy (buf, "%%+ font ");
+ cp = quote_ps_string (cp, fe->font->internal_name);
+ strcpy (cp, x->eol);
+ fputs (buf, f->file);
+ }
+
+ hsh_destroy (x->loaded);
+ x->loaded = NULL;
+ hsh_destroy (x->combos);
+ x->combos = NULL;
+ x->last_font = NULL;
+ x->next_combo = 0;
+
+ fprintf (f->file, "%%EOF%s", x->eol);
+ if (ferror (f->file))
+ return 0;
+ return 1;
+}
+
+int
+ps_open_page (struct outp_driver *this)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ assert (this->driver_open && !this->page_open);
+
+ x->page_number++;
+ if (!fn_open_ext (&x->file))
+ {
+ if (errno)
+ msg (ME, _("PostScript output driver: %s: %s"), x->file.filename,
+ strerror (errno));
+ return 0;
+ }
+ x->file_page_number++;
+
+ hsh_destroy (x->combos);
+ x->combos = hsh_create (31, compare_ps_combo, hash_ps_combo,
+ free_ps_combo, NULL);
+ x->last_font = NULL;
+ x->next_combo = 0;
+
+ fprintf (x->file.file,
+ "%%%%Page: %d %d%s"
+ "%%%%BeginPageSetup%s"
+ "/pg save def 0.001 dup scale%s",
+ x->page_number, x->file_page_number, x->eol,
+ x->eol,
+ x->eol);
+
+ if (x->orientation == OTN_LANDSCAPE)
+ fprintf (x->file.file,
+ "%d 0 translate 90 rotate%s",
+ x->w, x->eol);
+
+ if (x->bottom_margin != 0 || x->left_margin != 0)
+ fprintf (x->file.file,
+ "%d %d translate%s",
+ x->left_margin, x->bottom_margin, x->eol);
+
+ fprintf (x->file.file,
+ "/LW %d def/TW %d def %d setlinewidth%s"
+ "%%%%EndPageSetup%s",
+ x->line_width, x->line_width_thick, x->line_width, x->eol,
+ x->eol);
+
+ if (!ferror (x->file.file))
+ {
+ this->page_open = 1;
+ if (x->output_options & OPO_HEADERS)
+ draw_headers (this);
+ }
+
+ return !ferror (x->file.file);
+}
+
+int
+ps_close_page (struct outp_driver *this)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ assert (this->driver_open && this->page_open);
+
+ if (x->line_opt)
+ dump_lines (this);
+
+ fprintf (x->file.file,
+ "%%PageTrailer%s"
+ "EP%s",
+ x->eol, x->eol);
+
+ this->page_open = 0;
+ return !ferror (x->file.file);
+}
+\f
+/* Lines. */
+
+/* qsort() comparison function for int tuples. */
+static int
+int_2_compare (const void *a, const void *b)
+{
+ return *((const int *) a) - *((const int *) b);
+}
+
+/* Hash table comparison function for cached lines. */
+static int
+compare_line (const void *a, const void *b, void *foo unused)
+{
+ return ((struct line_form *) a)->ind - ((struct line_form *) b)->ind;
+}
+
+/* Hash table hash function for cached lines. */
+static unsigned
+hash_line (const void *pa, void *foo unused)
+{
+ const struct line_form *a = pa;
+
+ return a->ind;
+}
+
+/* Hash table free function for cached lines. */
+static void
+free_line (void *pa, void *foo unused)
+{
+ free (pa);
+}
+
+/* Writes PostScript code to draw a line from (x1,y1) to (x2,y2) to
+ the output file. */
+#define dump_line(x1, y1, x2, y2) \
+ fprintf (ext->file.file, "%d %d %d %d L%s", \
+ x1, YT (y1), x2, YT (y2), ext->eol)
+
+/* Write PostScript code to draw a thick line from (x1,y1) to (x2,y2)
+ to the output file. */
+#define dump_thick_line(x1, y1, x2, y2) \
+ fprintf (ext->file.file, "%d %d %d %d TL%s", \
+ x1, YT (y1), x2, YT (y2), ext->eol)
+
+/* Writes a line of type TYPE to THIS driver's output file. The line
+ (or its center, in the case of double lines) has its independent
+ axis coordinate at IND; it extends from DEP1 to DEP2 on the
+ dependent axis. */
+static void
+dump_fancy_line (struct outp_driver *this, int type, int ind, int dep1, int dep2)
+{
+ struct ps_driver_ext *ext = this->ext;
+ int ofs = ext->line_space / 2 + ext->line_width / 2;
+
+ switch (type)
+ {
+ case horz:
+ dump_line (dep1, ind, dep2, ind);
+ break;
+ case dbl_horz:
+ if (ext->output_options & OPO_DOUBLE_LINE)
+ {
+ dump_line (dep1, ind - ofs, dep2, ind - ofs);
+ dump_line (dep1, ind + ofs, dep2, ind + ofs);
+ }
+ else
+ dump_thick_line (dep1, ind, dep2, ind);
+ break;
+ case spl_horz:
+ assert (0);
+ case vert:
+ dump_line (ind, dep1, ind, dep2);
+ break;
+ case dbl_vert:
+ if (ext->output_options & OPO_DOUBLE_LINE)
+ {
+ dump_line (ind - ofs, dep1, ind - ofs, dep2);
+ dump_line (ind + ofs, dep1, ind + ofs, dep2);
+ }
+ else
+ dump_thick_line (ind, dep1, ind, dep2);
+ break;
+ case spl_vert:
+ assert (0);
+ default:
+ assert (0);
+ }
+}
+
+#undef dump_line
+
+/* Writes all the cached lines to the output file, then clears the
+ cache. */
+static void
+dump_lines (struct outp_driver *this)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ struct hsh_iterator iter;
+ struct line_form *line;
+ int type;
+
+ hsh_iterator_init (iter);
+ for (type = 0; type < n_line_types; type++)
+ {
+ while (NULL != (line = hsh_foreach (x->lines[type], &iter)))
+ {
+ int i;
+ int lo = INT_MIN, hi;
+
+ qsort (line->dep, line->ndep, sizeof *line->dep, int_2_compare);
+ lo = line->dep[0][0];
+ hi = line->dep[0][1];
+ for (i = 1; i < line->ndep; i++)
+ if (line->dep[i][0] <= hi + 1)
+ {
+ int min_hi = line->dep[i][1];
+ if (min_hi > hi)
+ hi = min_hi;
+ }
+ else
+ {
+ dump_fancy_line (this, type, line->ind, lo, hi);
+ lo = line->dep[i][0];
+ hi = line->dep[i][1];
+ }
+ dump_fancy_line (this, type, line->ind, lo, hi);
+ }
+
+ hsh_destroy (x->lines[type]);
+ x->lines[type] = NULL;
+ }
+}
+
+/* (Same args as dump_fancy_line()). Either dumps the line directly
+ to the output file, or adds it to the cache, depending on the
+ user-selected line optimization mode. */
+static void
+line (struct outp_driver *this, int type, int ind, int dep1, int dep2)
+{
+ struct ps_driver_ext *ext = this->ext;
+ struct line_form **f;
+
+ assert (dep2 >= dep1);
+ if (ext->line_opt == 0)
+ {
+ dump_fancy_line (this, type, ind, dep1, dep2);
+ return;
+ }
+
+ if (ext->lines[type] == NULL)
+ ext->lines[type] = hsh_create (31, compare_line, hash_line,
+ free_line, NULL);
+ f = (struct line_form **) hsh_probe (ext->lines[type],
+ (struct line_form *) & ind);
+ if (*f == NULL)
+ {
+ *f = xmalloc (sizeof **f + sizeof (int[15][2]));
+ (*f)->ind = ind;
+ (*f)->mdep = 16;
+ (*f)->ndep = 1;
+ (*f)->dep[0][0] = dep1;
+ (*f)->dep[0][1] = dep2;
+ return;
+ }
+ if ((*f)->ndep >= (*f)->mdep)
+ {
+ (*f)->mdep += 16;
+ *f = xrealloc (*f, (sizeof **f + sizeof (int[2]) * ((*f)->mdep - 1)));
+ }
+ (*f)->dep[(*f)->ndep][0] = dep1;
+ (*f)->dep[(*f)->ndep][1] = dep2;
+ (*f)->ndep++;
+}
+
+void
+ps_line_horz (struct outp_driver *this, const struct rect *r,
+ const struct color *c unused, int style)
+{
+ /* Must match output.h:OUTP_L_*. */
+ static const int types[OUTP_L_COUNT] =
+ {-1, horz, dbl_horz, spl_horz};
+
+ int y = (r->y1 + r->y2) / 2;
+
+ assert (this->driver_open && this->page_open);
+ assert (style >= 0 && style < OUTP_L_COUNT);
+ style = types[style];
+ if (style != -1)
+ line (this, style, y, r->x1, r->x2);
+}
+
+void
+ps_line_vert (struct outp_driver *this, const struct rect *r,
+ const struct color *c unused, int style)
+{
+ /* Must match output.h:OUTP_L_*. */
+ static const int types[OUTP_L_COUNT] =
+ {-1, vert, dbl_vert, spl_vert};
+
+ int x = (r->x1 + r->x2) / 2;
+
+ assert (this->driver_open && this->page_open);
+ assert (style >= 0 && style < OUTP_L_COUNT);
+ style = types[style];
+ if (style != -1)
+ line (this, style, x, r->y1, r->y2);
+}
+
+#define L (style->l != OUTP_L_NONE)
+#define R (style->r != OUTP_L_NONE)
+#define T (style->t != OUTP_L_NONE)
+#define B (style->b != OUTP_L_NONE)
+
+void
+ps_line_intersection (struct outp_driver *this, const struct rect *r,
+ const struct color *c unused,
+ const struct outp_styles *style)
+{
+ struct ps_driver_ext *ext = this->ext;
+
+ int x = (r->x1 + r->x2) / 2;
+ int y = (r->y1 + r->y2) / 2;
+ int ofs = (ext->line_space + ext->line_width) / 2;
+ int x1 = x - ofs, x2 = x + ofs;
+ int y1 = y - ofs, y2 = y + ofs;
+
+ assert (this->driver_open && this->page_open);
+ assert (!((style->l != style->r && style->l != OUTP_L_NONE
+ && style->r != OUTP_L_NONE)
+ || (style->t != style->b && style->t != OUTP_L_NONE
+ && style->b != OUTP_L_NONE)));
+
+ switch ((style->l | style->r) | ((style->t | style->b) << 8))
+ {
+ case (OUTP_L_SINGLE) | (OUTP_L_SINGLE << 8):
+ case (OUTP_L_SINGLE) | (OUTP_L_NONE << 8):
+ case (OUTP_L_NONE) | (OUTP_L_SINGLE << 8):
+ if (L)
+ line (this, horz, y, r->x1, x);
+ if (R)
+ line (this, horz, y, x, r->x2);
+ if (T)
+ line (this, vert, x, r->y1, y);
+ if (B)
+ line (this, vert, x, y, r->y2);
+ break;
+ case (OUTP_L_SINGLE) | (OUTP_L_DOUBLE << 8):
+ case (OUTP_L_NONE) | (OUTP_L_DOUBLE << 8):
+ if (L)
+ line (this, horz, y, r->x1, x1);
+ if (R)
+ line (this, horz, y, x2, r->x2);
+ if (T)
+ line (this, dbl_vert, x, r->y1, y);
+ if (B)
+ line (this, dbl_vert, x, y, r->y2);
+ if ((L && R) && !(T && B))
+ line (this, horz, y, x1, x2);
+ break;
+ case (OUTP_L_DOUBLE) | (OUTP_L_SINGLE << 8):
+ case (OUTP_L_DOUBLE) | (OUTP_L_NONE << 8):
+ if (L)
+ line (this, dbl_horz, y, r->x1, x);
+ if (R)
+ line (this, dbl_horz, y, x, r->x2);
+ if (T)
+ line (this, vert, x, r->y1, y);
+ if (B)
+ line (this, vert, x, y, r->y2);
+ if ((T && B) && !(L && R))
+ line (this, vert, x, y1, y2);
+ break;
+ case (OUTP_L_DOUBLE) | (OUTP_L_DOUBLE << 8):
+ if (L)
+ line (this, dbl_horz, y, r->x1, x);
+ if (R)
+ line (this, dbl_horz, y, x, r->x2);
+ if (T)
+ line (this, dbl_vert, x, r->y1, y);
+ if (B)
+ line (this, dbl_vert, x, y, r->y2);
+ if (T && B && !L)
+ line (this, vert, x1, y1, y2);
+ if (T && B && !R)
+ line (this, vert, x2, y1, y2);
+ if (L && R && !T)
+ line (this, horz, y1, x1, x2);
+ if (L && R && !B)
+ line (this, horz, y2, x1, x2);
+ break;
+ default:
+ assert (0);
+ }
+}
+
+void
+ps_line_width (struct outp_driver *this, int *width, int *height)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ assert (this->driver_open && this->page_open);
+ width[0] = height[0] = 0;
+ width[1] = height[1] = 2 * x->line_gutter + x->line_width;
+ width[2] = height[2] = (2 * x->line_gutter + 2 * x->line_width
+ + x->line_space);
+ width[3] = height[3] = 2 * x->line_gutter + x->line_width;
+}
+
+void
+ps_box (struct outp_driver *this unused, const struct rect *r unused,
+ const struct color *bord unused, const struct color *fill unused)
+{
+ assert (this->driver_open && this->page_open);
+}
+
+void
+ps_polyline_begin (struct outp_driver *this unused,
+ const struct color *c unused)
+{
+ assert (this->driver_open && this->page_open);
+}
+void
+ps_polyline_point (struct outp_driver *this unused, int x unused, int y unused)
+{
+ assert (this->driver_open && this->page_open);
+}
+void
+ps_polyline_end (struct outp_driver *this unused)
+{
+ assert (this->driver_open && this->page_open);
+}
+
+/* Returns the width of string S for THIS driver. */
+static int
+text_width (struct outp_driver *this, char *s)
+{
+ struct outp_text text;
+
+ text.options = OUTP_T_JUST_LEFT;
+ ls_init (&text.s, s, strlen (s));
+ this->class->text_metrics (this, &text);
+ return text.h;
+}
+
+/* Write string S at location (X,Y) with width W for THIS driver. */
+static void
+out_text_plain (struct outp_driver *this, char *s, int x, int y, int w)
+{
+ struct outp_text text;
+
+ text.options = OUTP_T_JUST_LEFT | OUTP_T_HORZ | OUTP_T_VERT;
+ ls_init (&text.s, s, strlen (s));
+ text.h = w;
+ text.v = this->font_height;
+ text.x = x;
+ text.y = y;
+ this->class->text_draw (this, &text);
+}
+
+/* Draw top of page headers for THIS driver. */
+static void
+draw_headers (struct outp_driver *this)
+{
+ struct ps_driver_ext *ext = this->ext;
+
+ struct font_entry *old_current = ext->current;
+ char *old_family = xstrdup (ext->family); /* FIXME */
+ int old_size = ext->size;
+
+ int fh = this->font_height;
+ int y = -3 * fh;
+
+ fprintf (ext->file.file, "%d %d %d %d GB%s",
+ 0, YT (y), this->width, YT (y + 2 * fh + ext->line_gutter),
+ ext->eol);
+ this->class->text_set_font_family (this, "T");
+
+ y += ext->line_width + ext->line_gutter;
+
+ {
+ int rh_width;
+ char buf[128];
+
+ sprintf (buf, _("%s - Page %d"), curdate, ext->page_number);
+ rh_width = text_width (this, buf);
+
+ out_text_plain (this, buf, this->width - this->prop_em_width - rh_width,
+ y, rh_width);
+
+ if (outp_title && outp_subtitle)
+ out_text_plain (this, outp_title, this->prop_em_width, y,
+ this->width - 3 * this->prop_em_width - rh_width);
+
+ y += fh;
+ }
+
+ {
+ int rh_width;
+ char buf[128];
+ char *string = outp_subtitle ? outp_subtitle : outp_title;
+
+ sprintf (buf, "%s - %s", version, host_system);
+ rh_width = text_width (this, buf);
+
+ out_text_plain (this, buf, this->width - this->prop_em_width - rh_width,
+ y, rh_width);
+
+ if (string)
+ out_text_plain (this, string, this->prop_em_width, y,
+ this->width - 3 * this->prop_em_width - rh_width);
+
+ y += fh;
+ }
+
+ ext->current = old_current;
+ free (ext->family);
+ ext->family = old_family;
+ ext->size = old_size;
+}
+
+\f
+/* Text. */
+
+void
+ps_text_set_font_by_name (struct outp_driver *this, const char *dit)
+{
+ struct ps_driver_ext *x = this->ext;
+ struct font_entry *fe;
+
+ assert (this->driver_open && this->page_open);
+
+ /* Short-circuit common fonts. */
+ if (!strcmp (dit, "PROP"))
+ {
+ x->current = x->prop;
+ x->size = x->font_size;
+ return;
+ }
+ else if (!strcmp (dit, "FIXED"))
+ {
+ x->current = x->fixed;
+ x->size = x->font_size;
+ return;
+ }
+
+ /* Find font_desc corresponding to Groff name dit. */
+ fe = hsh_find (x->loaded, &dit);
+ if (fe == NULL)
+ fe = load_font (this, dit);
+ x->current = fe;
+}
+
+void
+ps_text_set_font_by_position (struct outp_driver *this, int pos)
+{
+ struct ps_driver_ext *x = this->ext;
+ char *dit;
+
+ assert (this->driver_open && this->page_open);
+
+ /* Determine font name by suffixing position string to font family
+ name. */
+ {
+ char *cp;
+
+ dit = local_alloc (strlen (x->family) + 3);
+ cp = stpcpy (dit, x->family);
+ switch (pos)
+ {
+ case OUTP_F_R:
+ *cp++ = 'R';
+ break;
+ case OUTP_F_I:
+ *cp++ = 'I';
+ break;
+ case OUTP_F_B:
+ *cp++ = 'B';
+ break;
+ case OUTP_F_BI:
+ *cp++ = 'B';
+ *cp++ = 'I';
+ break;
+ default:
+ assert(0);
+ }
+ *cp++ = 0;
+ }
+
+ /* Find font_desc corresponding to Groff name dit. */
+ {
+ struct font_entry *fe = hsh_find (x->loaded, &dit);
+ if (fe == NULL)
+ fe = load_font (this, dit);
+ x->current = fe;
+ }
+
+ local_free (dit);
+}
+
+void
+ps_text_set_font_family (struct outp_driver *this, const char *s)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ assert (this->driver_open && this->page_open);
+
+ free(x->family);
+ x->family = xstrdup (s);
+}
+
+const char *
+ps_text_get_font_name (struct outp_driver *this)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ assert (this->driver_open && this->page_open);
+ return x->current->font->name;
+}
+
+const char *
+ps_text_get_font_family (struct outp_driver *this)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ assert (this->driver_open && this->page_open);
+ return x->family;
+}
+
+int
+ps_text_set_size (struct outp_driver *this, int size)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ assert (this->driver_open && this->page_open);
+ x->size = PSUS / 72000 * size;
+ return 1;
+}
+
+int
+ps_text_get_size (struct outp_driver *this, int *em_width)
+{
+ struct ps_driver_ext *x = this->ext;
+
+ assert (this->driver_open && this->page_open);
+ if (em_width)
+ *em_width = (x->current->font->space_width * x->size) / 1000;
+ return x->size / (PSUS / 72000);
+}
+
+/* An output character. */
+struct output_char
+ {
+ struct font_entry *font; /* Font of character. */
+ int size; /* Size of character. */
+ int x, y; /* Location of character. */
+ unsigned char ch; /* Character. */
+ char separate; /* Must be separate from previous char. */
+ };
+
+/* Hash table comparison function for ps_combo structs. */
+static int
+compare_ps_combo (const void *pa, const void *pb, void *foo unused)
+{
+ const struct ps_font_combo *a = pa;
+ const struct ps_font_combo *b = pb;
+
+ return !((a->font == b->font) && (a->size == b->size));
+}
+
+/* Hash table hash function for ps_combo structs. */
+static unsigned
+hash_ps_combo (const void *pa, void *foo unused)
+{
+ const struct ps_font_combo *a = pa;
+
+ return hashpjw (a->font->font->internal_name) ^ a->size;
+}
+
+/* Hash table free function for ps_combo structs. */
+static void
+free_ps_combo (void *a, void *foo unused)
+{
+ free (a);
+}
+
+/* Causes PostScript code to be output that switches to the font
+ CP->FONT and font size CP->SIZE. The first time a particular
+ font/size combination is used on a particular page, this involves
+ outputting PostScript code to load the font. */
+static void
+switch_font (struct outp_driver *this, const struct output_char *cp)
+{
+ struct ps_driver_ext *ext = this->ext;
+ struct ps_font_combo srch, **fc;
+
+ srch.font = cp->font;
+ srch.size = cp->size;
+
+ fc = (struct ps_font_combo **) hsh_probe (ext->combos, &srch);
+ if (*fc)
+ {
+ fprintf (ext->file.file, "F%x%s", (*fc)->index, ext->eol);
+ }
+ else
+ {
+ char *filename;
+ struct ps_encoding *encoding;
+ char buf[512], *bp;
+
+ *fc = xmalloc (sizeof **fc);
+ (*fc)->font = cp->font;
+ (*fc)->size = cp->size;
+ (*fc)->index = ext->next_combo++;
+
+ filename = find_encoding_file (this, cp->font->font->encoding);
+ if (filename)
+ {
+ encoding = get_encoding (this, filename);
+ free (filename);
+ }
+ else
+ {
+ msg (IE, _("PostScript driver: Cannot find encoding `%s' for "
+ "PostScript font `%s'."), cp->font->font->encoding,
+ cp->font->font->internal_name);
+ encoding = default_encoding (this);
+ }
+
+ if (cp->font != ext->fixed && cp->font != ext->prop)
+ {
+ bp = stpcpy (buf, "%%IncludeResource: font ");
+ bp = quote_ps_string (bp, cp->font->font->internal_name);
+ bp = stpcpy (bp, ext->eol);
+ }
+ else
+ bp = buf;
+
+ bp = spprintf (bp, "/F%x E%x %d", (*fc)->index, encoding->index,
+ cp->size);
+ bp = quote_ps_name (bp, cp->font->font->internal_name);
+ sprintf (bp, " SF%s", ext->eol);
+ fputs (buf, ext->file.file);
+ }
+ ext->last_font = *fc;
+}
+
+/* (write_text) Writes the accumulated line buffer to the output
+ file. */
+#define output_line() \
+ do \
+ { \
+ lp = stpcpy (lp, ext->eol); \
+ *lp = 0; \
+ fputs (line, ext->file.file); \
+ lp = line; \
+ } \
+ while (0)
+
+/* (write_text) Adds the string representing number X to the line
+ buffer, flushing the buffer to disk beforehand if necessary. */
+#define put_number(X) \
+ do \
+ { \
+ int n = nsprintf (number, "%d", X); \
+ if (n + lp > &line[75]) \
+ output_line (); \
+ lp = stpcpy (lp, number); \
+ } \
+ while (0)
+
+/* Outputs PostScript code to THIS driver's output file to display the
+ characters represented by the output_char's between CP and END,
+ using the associated outp_text T to determine formatting. WIDTH is
+ the width of the output region; WIDTH_LEFT is the amount of the
+ WIDTH that is not taken up by text (so it can be used to determine
+ justification). */
+static void
+write_text (struct outp_driver *this,
+ const struct output_char *cp, const struct output_char *end,
+ struct outp_text *t, int width unused, int width_left)
+{
+ struct ps_driver_ext *ext = this->ext;
+ int ofs;
+
+ int last_y;
+
+ char number[INT_DIGITS + 1];
+ char line[80];
+ char *lp;
+
+ switch (t->options & OUTP_T_JUST_MASK)
+ {
+ case OUTP_T_JUST_LEFT:
+ ofs = 0;
+ break;
+ case OUTP_T_JUST_RIGHT:
+ ofs = width_left;
+ break;
+ case OUTP_T_JUST_CENTER:
+ ofs = width_left / 2;
+ break;
+ }
+
+ lp = line;
+ last_y = INT_MIN;
+ while (cp < end)
+ {
+ int x = cp->x + ofs;
+ int y = cp->y + (cp->font->font->ascent * cp->size / 1000);
+
+ if (ext->last_font == NULL
+ || cp->font != ext->last_font->font
+ || cp->size != ext->last_font->size)
+ switch_font (this, cp);
+
+ *lp++ = '(';
+ do
+ {
+ /* PORTME! */
+ static unsigned char literal_chars[ODA_COUNT][32] =
+ {
+ {0x00, 0x00, 0x00, 0xf8, 0xff, 0xfc, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ },
+ {0x00, 0x00, 0x00, 0xf8, 0xff, 0xfc, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
+ },
+ {0x7e, 0xd6, 0xff, 0xfb, 0xff, 0xfc, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
+ }
+ };
+
+ if (TEST_BIT (literal_chars[ext->data], cp->ch))
+ *lp++ = cp->ch;
+ else
+ switch (cp->ch)
+ {
+ case '(':
+ lp = stpcpy (lp, "\\(");
+ break;
+ case ')':
+ lp = stpcpy (lp, "\\)");
+ break;
+ default:
+ lp = spprintf (lp, "\\%03o", cp->ch);
+ break;
+ }
+ cp++;
+ }
+ while (cp < end && lp < &line[70] && cp->separate == 0);
+ *lp++ = ')';
+
+ put_number (x);
+
+ if (y != last_y)
+ {
+ *lp++ = ' ';
+ put_number (YT (y));
+ *lp++ = ' ';
+ *lp++ = 'S';
+ last_y = y;
+ }
+ else
+ {
+ *lp++ = ' ';
+ *lp++ = 'T';
+ }
+
+ if (lp >= &line[70])
+ output_line ();
+ }
+ if (lp != line)
+ output_line ();
+}
+
+#undef output_line
+#undef put_number
+
+/* Displays the text in outp_text T, if DRAW is nonzero; or, merely
+ determine the text metrics, if DRAW is zero. */
+static void
+text (struct outp_driver *this, struct outp_text *t, int draw)
+{
+ struct ps_driver_ext *ext = this->ext;
+
+ /* Output. */
+ struct output_char *buf; /* Output buffer. */
+ struct output_char *buf_end; /* End of output buffer. */
+ struct output_char *buf_loc; /* Current location in output buffer. */
+
+ /* Saved state. */
+ struct font_entry *old_current = ext->current;
+ char *old_family = xstrdup (ext->family); /* FIXME */
+ int old_size = ext->size;
+
+ /* Input string. */
+ char *cp, *end;
+
+ /* Current location. */
+ int x, y;
+
+ /* Keeping track of what's left over. */
+ int width; /* Width available for characters. */
+ int width_left, height_left; /* Width, height left over. */
+ int max_height; /* Tallest character on this line so far. */
+
+ /* Previous character. */
+ int prev_char;
+
+ /* Information about location of previous space. */
+ char *space_char; /* Character after space. */
+ struct output_char *space_buf_loc; /* Buffer location after space. */
+ int space_width_left; /* Width of characters before space. */
+
+ /* Name of the current character. */
+ const char *char_name;
+ char local_char_name[2] = {0, 0};
+
+ local_char_name[0] = local_char_name[1] = 0;
+
+ buf = local_alloc (sizeof *buf * 128);
+ buf_end = &buf[128];
+ buf_loc = buf;
+
+ assert (!ls_null_p (&t->s));
+ cp = ls_value (&t->s);
+ end = ls_end (&t->s);
+ if (draw)
+ {
+ x = t->x;
+ y = t->y;
+ }
+ width = width_left = (t->options & OUTP_T_HORZ) ? t->h : INT_MAX;
+ height_left = (t->options & OUTP_T_VERT) ? t->v : INT_MAX;
+ max_height = 0;
+ prev_char = -1;
+ space_char = NULL;
+
+ if (!width || !height_left)
+ goto exit;
+
+ while (cp < end)
+ {
+ struct char_metrics *metric;
+ int cur_char;
+ int kern_amt;
+ int char_width;
+ int separate = 0;
+
+ /* Set char_name to the name of the character or ligature at
+ *cp. */
+ if (ext->current->font->ligatures && *cp == 'f')
+ {
+ int lig = 0;
+
+ if (cp < end - 1)
+ switch (cp[1])
+ {
+ case 'i':
+ lig = LIG_fi, char_name = "fi";
+ break;
+ case 'l':
+ lig = LIG_fl, char_name = "fl";
+ break;
+ case 'f':
+ if (cp < end - 2)
+ switch (cp[2])
+ {
+ case 'i':
+ lig = LIG_ffi, char_name = "ffi";
+ goto got_ligature;
+ case 'l':
+ lig = LIG_ffl, char_name = "ffl";
+ goto got_ligature;
+ }
+ lig = LIG_ff, char_name = "ff";
+ got_ligature:
+ break;
+ }
+ if ((lig & ext->current->font->ligatures) == 0)
+ {
+ local_char_name[0] = *cp++; /* 'f' */
+ char_name = local_char_name;
+ }
+ else
+ cp += strlen (char_name);
+ }
+ else if (*cp == '\n')
+ {
+ if (draw)
+ {
+ write_text (this, buf, buf_loc, t, width, width_left);
+ buf_loc = buf;
+ x = t->x;
+ y += max_height;
+ }
+
+ width_left = width;
+ height_left -= max_height;
+ max_height = 0;
+ kern_amt = 0;
+ separate = 1;
+ cp++;
+
+ /* FIXME: when we're page buffering it will be necessary to
+ set separate to 1. */
+ continue;
+ }
+ else
+ {
+ local_char_name[0] = *cp++;
+ char_name = local_char_name;
+ }
+
+ /* Figure out what size this character is, and what kern
+ adjustment we need. */
+ cur_char = font_char_name_to_index (char_name);
+ metric = font_get_char_metrics (ext->current->font, cur_char);
+ if (!metric)
+ {
+ static struct char_metrics m;
+ metric = &m;
+ m.width = ext->current->font->space_width;
+ m.code = *char_name;
+ }
+ kern_amt = font_get_kern_adjust (ext->current->font, prev_char,
+ cur_char);
+ if (kern_amt)
+ {
+ kern_amt = (kern_amt * ext->size / 1000);
+ separate = 1;
+ }
+ char_width = metric->width * ext->size / 1000;
+
+ /* Record the current status if this is a space character. */
+ if (cur_char == space_index && buf_loc > buf)
+ {
+ space_char = cp;
+ space_buf_loc = buf_loc;
+ space_width_left = width_left;
+ }
+
+ /* Drop down to a new line if there's no room left on this
+ line. */
+ if (char_width + kern_amt > width_left)
+ {
+ /* Regress to previous space, if any. */
+ if (space_char)
+ {
+ cp = space_char;
+ width_left = space_width_left;
+ buf_loc = space_buf_loc;
+ }
+
+ if (draw)
+ {
+ write_text (this, buf, buf_loc, t, width, width_left);
+ buf_loc = buf;
+ x = t->x;
+ y += max_height;
+ }
+
+ width_left = width;
+ height_left -= max_height;
+ max_height = 0;
+ kern_amt = 0;
+
+ if (space_char)
+ {
+ space_char = NULL;
+ prev_char = -1;
+ /* FIXME: when we're page buffering it will be
+ necessary to set separate to 1. */
+ continue;
+ }
+ separate = 1;
+ }
+ if (ext->size > max_height)
+ max_height = ext->size;
+ if (max_height > height_left)
+ goto exit;
+
+ /* Actually draw the character. */
+ if (draw)
+ {
+ if (buf_loc >= buf_end)
+ {
+ int buf_len = buf_end - buf;
+
+ if (buf_len == 128)
+ {
+ struct output_char *new_buf;
+
+ new_buf = xmalloc (sizeof *new_buf * 256);
+ memcpy (new_buf, buf, sizeof *new_buf * 128);
+ buf_loc = new_buf + 128;
+ buf_end = new_buf + 256;
+ local_free (buf);
+ buf = new_buf;
+ }
+ else
+ {
+ buf = xrealloc (buf, sizeof *buf * buf_len * 2);
+ buf_loc = buf + buf_len;
+ buf_end = buf + buf_len * 2;
+ }
+ }
+
+ x += kern_amt;
+#if __CHECKER__
+ memset (buf_loc, 0, sizeof *buf_loc);
+#endif
+ buf_loc->font = ext->current;
+ buf_loc->size = ext->size;
+ buf_loc->x = x;
+ buf_loc->y = y;
+ buf_loc->ch = metric->code;
+ buf_loc->separate = separate;
+ buf_loc++;
+ x += char_width;
+ }
+
+ /* Prepare for next iteration. */
+ width_left -= char_width + kern_amt;
+ prev_char = cur_char;
+ }
+ height_left -= max_height;
+ if (buf_loc > buf && draw)
+ write_text (this, buf, buf_loc, t, width, width_left);
+
+exit:
+ if (!(t->options & OUTP_T_HORZ))
+ t->h = INT_MAX - width_left;
+ if (!(t->options & OUTP_T_VERT))
+ t->v = INT_MAX - height_left;
+ else
+ t->v -= height_left;
+ if (buf_end - buf == 128)
+ local_free (buf);
+ else
+ free (buf);
+ ext->current = old_current;
+ free (ext->family);
+ ext->family = old_family;
+ ext->size = old_size;
+}
+
+void
+ps_text_metrics (struct outp_driver *this, struct outp_text *t)
+{
+ assert (this->driver_open && this->page_open);
+ text (this, t, 0);
+}
+
+void
+ps_text_draw (struct outp_driver *this, struct outp_text *t)
+{
+ assert (this->driver_open && this->page_open);
+ text (this, t, 1);
+}
+\f
+/* Font loader. */
+
+/* Translate a filename to a font. */
+struct filename2font
+ {
+ char *filename; /* Normalized filename. */
+ struct font_desc *font;
+ };
+
+/* Table of `filename2font's. */
+static struct hsh_table *ps_fonts;
+
+/* Hash table comparison function for filename2font structs. */
+static int
+compare_filename2font (const void *a, const void *b, void *param unused)
+{
+ return strcmp (((struct filename2font *) a)->filename,
+ ((struct filename2font *) b)->filename);
+}
+
+/* Hash table hash function for filename2font structs. */
+static unsigned
+hash_filename2font (const void *a, void *param unused)
+{
+ /* I sure hope this works with long filenames. */
+ return hashpjw (((struct filename2font *) a)->filename);
+}
+
+/* Initializes the global font list by creating the hash table for
+ translation of filenames to font_desc structs. */
+static void
+init_fonts (void)
+{
+ ps_fonts = hsh_create (31, compare_filename2font, hash_filename2font,
+ NULL, NULL);
+}
+
+/* Loads the font having Groff name DIT into THIS driver instance.
+ Specifically, adds it into the THIS driver's `loaded' hash
+ table. */
+static struct font_entry *
+load_font (struct outp_driver *this, const char *dit)
+{
+ struct ps_driver_ext *x = this->ext;
+ char *filename1, *filename2;
+ void **entry;
+ struct font_entry *fe;
+
+ filename1 = find_ps_file (this, dit);
+ if (!filename1)
+ filename1 = xstrdup (dit);
+ filename2 = fn_normalize (filename1);
+ free (filename1);
+
+ entry = hsh_probe (ps_fonts, &filename2);
+ if (*entry == NULL)
+ {
+ struct filename2font *f2f;
+ struct font_desc *f = groff_read_font (filename2);
+
+ if (f == NULL)
+ {
+ if (x->fixed)
+ f = x->fixed->font;
+ else
+ f = default_font ();
+ }
+
+ f2f = xmalloc (sizeof *f2f);
+ f2f->filename = filename2;
+ f2f->font = f;
+ *entry = f2f;
+ }
+ else
+ free (filename2);
+
+ fe = xmalloc (sizeof *fe);
+ fe->dit = xstrdup (dit);
+ fe->font = ((struct filename2font *) * entry)->font;
+ *hsh_probe (x->loaded, &dit) = fe;
+
+ return fe;
+}
+
+/* PostScript driver class. */
+struct outp_class postscript_class =
+{
+ "postscript",
+ MAGIC_PS,
+ 0,
+
+ ps_open_global,
+ ps_close_global,
+ ps_font_sizes,
+
+ ps_preopen_driver,
+ ps_option,
+ ps_postopen_driver,
+ ps_close_driver,
+
+ ps_open_page,
+ ps_close_page,
+
+ NULL,
+
+ ps_line_horz,
+ ps_line_vert,
+ ps_line_intersection,
+
+ ps_box,
+ ps_polyline_begin,
+ ps_polyline_point,
+ ps_polyline_end,
+
+ ps_text_set_font_by_name,
+ ps_text_set_font_by_position,
+ ps_text_set_font_family,
+ ps_text_get_font_name,
+ ps_text_get_font_family,
+ ps_text_set_size,
+ ps_text_get_size,
+ ps_text_metrics,
+ ps_text_draw,
+};
+
+/* EPSF driver class. FIXME: Probably doesn't work right. */
+struct outp_class epsf_class =
+{
+ "epsf",
+ MAGIC_EPSF,
+ 0,
+
+ ps_open_global,
+ ps_close_global,
+ ps_font_sizes,
+
+ ps_preopen_driver,
+ ps_option,
+ ps_postopen_driver,
+ ps_close_driver,
+
+ ps_open_page,
+ ps_close_page,
+
+ NULL,
+
+ ps_line_horz,
+ ps_line_vert,
+ ps_line_intersection,
+
+ ps_box,
+ ps_polyline_begin,
+ ps_polyline_point,
+ ps_polyline_end,
+
+ ps_text_set_font_by_name,
+ ps_text_set_font_by_position,
+ ps_text_set_font_family,
+ ps_text_get_font_name,
+ ps_text_get_font_family,
+ ps_text_set_size,
+ ps_text_get_size,
+ ps_text_metrics,
+ ps_text_draw,
+};
+
+#endif /* NO_POSTSCRIPT */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "dfm.h"
+#include "error.h"
+#include "expr.h"
+#include "file-handle.h"
+#include "lexer.h"
+#include "misc.h"
+#include "som.h"
+#include "tab.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* Describes what to do when an output field is encountered. */
+enum
+ {
+ PRT_ERROR, /* Invalid value. */
+ PRT_NEWLINE, /* Newline. */
+ PRT_CONST, /* Constant string. */
+ PRT_VAR, /* Variable. */
+ PRT_SPACE /* A single space. */
+ };
+
+/* Describes how to output one field. */
+struct prt_out_spec
+ {
+ struct prt_out_spec *next;
+ int type; /* PRT_* constant. */
+ int fc; /* 0-based first column. */
+ union
+ {
+ char *c; /* PRT_CONST: Associated string. */
+ struct
+ {
+ struct variable *v; /* PRT_VAR: Associated variable. */
+ struct fmt_spec f; /* PRT_VAR: Output spec. */
+ }
+ v;
+ }
+ u;
+ };
+
+/* Enums for use with print_trns's `options' field. */
+enum
+ {
+ PRT_CMD_MASK = 1, /* Command type mask. */
+ PRT_PRINT = 0, /* PRINT transformation identifier. */
+ PRT_WRITE = 1, /* WRITE transformation identifier. */
+ PRT_EJECT = 002 /* Can be combined with CMD_PRINT only. */
+ };
+
+/* PRINT, PRINT EJECT, WRITE private data structure. */
+struct print_trns
+ {
+ struct trns_header h;
+ struct file_handle *handle; /* Output file, NULL=listing file. */
+ int options; /* PRT_* bitmapped field. */
+ struct prt_out_spec *spec; /* Output specifications. */
+ int max_width; /* Maximum line width including null. */
+#if !PAGED_STACK
+ char *line; /* Buffer for sticking lines in. */
+#endif
+ };
+
+/* PRT_PRINT or PRT_WRITE. */
+int which_cmd;
+
+/* Holds information on parsing the data file. */
+static struct print_trns prt;
+
+/* Last prt_out_spec in the chain. Used for building the linked-list. */
+static struct prt_out_spec *next;
+
+/* Number of records. */
+static int nrec;
+
+static int internal_cmd_print (int flags);
+static int print_trns_proc (struct trns_header *, struct ccase *);
+static void print_trns_free (struct trns_header *);
+static int parse_specs (void);
+static void dump_table (void);
+static void append_var_spec (struct prt_out_spec *spec);
+static void alloc_line (void);
+
+#if DEBUGGING
+void debug_print (void);
+#endif
+\f
+/* Basic parsing. */
+
+/* Parses PRINT command. */
+int
+cmd_print (void)
+{
+ lex_match_id ("PRINT");
+ return internal_cmd_print (PRT_PRINT);
+}
+
+/* Parses PRINT EJECT command. */
+int
+cmd_print_eject (void)
+{
+ lex_match_id ("EJECT");
+ return internal_cmd_print (PRT_PRINT | PRT_EJECT);
+}
+
+/* Parses WRITE command. */
+int
+cmd_write (void)
+{
+ lex_match_id ("WRITE");
+ return internal_cmd_print (PRT_WRITE);
+}
+
+/* Parses the output commands. F is PRT_PRINT, PRT_WRITE, or
+ PRT_PRINT|PRT_EJECT. */
+static int
+internal_cmd_print (int f)
+{
+ /* 0=print no table, 1=print table. (TABLE subcommand.) */
+ int table = 0;
+
+ /* malloc()'d transformation. */
+ struct print_trns *trns;
+
+ /* Fill in prt to facilitate error-handling. */
+ prt.h.proc = print_trns_proc;
+ prt.h.free = print_trns_free;
+ prt.handle = NULL;
+ prt.options = f;
+ prt.spec = NULL;
+#if !PAGED_STACK
+ prt.line = NULL;
+#endif
+ next = NULL;
+ nrec = 0;
+
+ which_cmd = f & PRT_CMD_MASK;
+
+ /* Parse the command options. */
+ while (!lex_match ('/'))
+ {
+ if (lex_match_id ("OUTFILE"))
+ {
+ lex_match ('=');
+
+ prt.handle = fh_parse_file_handle ();
+ if (!prt.handle)
+ goto lossage;
+ }
+ else if (lex_match_id ("RECORDS"))
+ {
+ lex_match ('=');
+ lex_match ('(');
+ if (!lex_force_int ())
+ goto lossage;
+ nrec = lex_integer ();
+ lex_get ();
+ lex_match (')');
+ }
+ else if (lex_match_id ("TABLE"))
+ table = 1;
+ else if (lex_match_id ("NOTABLE"))
+ table = 0;
+ else
+ {
+ lex_error (_("expecting a valid subcommand"));
+ goto lossage;
+ }
+ }
+
+ /* Parse variables and strings. */
+ if (!parse_specs ())
+ goto lossage;
+
+ /* Output the variable table if requested. */
+ if (table)
+ dump_table ();
+
+ /* Count the maximum line width. Allocate linebuffer if
+ applicable. */
+ alloc_line ();
+
+ /* Put the transformation in the queue. */
+ trns = xmalloc (sizeof *trns);
+ memcpy (trns, &prt, sizeof *trns);
+ add_transformation ((struct trns_header *) trns);
+
+#if DEBUGGING
+ debug_print ();
+#endif
+
+ return CMD_SUCCESS;
+
+ lossage:
+ print_trns_free ((struct trns_header *) & prt);
+ return CMD_FAILURE;
+}
+
+/* Appends the field output specification SPEC to the list maintained
+ in prt. */
+static void
+append_var_spec (struct prt_out_spec *spec)
+{
+ if (next == 0)
+ prt.spec = next = xmalloc (sizeof *spec);
+ else
+ next = next->next = xmalloc (sizeof *spec);
+
+ memcpy (next, spec, sizeof *spec);
+ next->next = NULL;
+}
+\f
+/* Field parsing. Mostly stolen from data-list.c. */
+
+/* Used for chaining together fortran-like format specifiers. */
+struct fmt_list
+{
+ struct fmt_list *next;
+ int count;
+ struct fmt_spec f;
+ struct fmt_list *down;
+};
+
+/* Used as "local" variables among the fixed-format parsing funcs. If
+ it were guaranteed that PSPP were going to be compiled by gcc,
+ I'd make all these functions a single set of nested functions. */
+static struct
+ {
+ struct variable **v; /* variable list */
+ int nv; /* number of variables in list */
+ int cv; /* number of variables from list used up so far
+ by the FORTRAN-like format specifiers */
+
+ int recno; /* current 1-based record number */
+ int sc; /* 1-based starting column for next variable */
+
+ struct prt_out_spec spec; /* next format spec to append to list */
+ int fc, lc; /* first, last 1-based column number of current
+ var */
+
+ int level; /* recursion level for FORTRAN-like format
+ specifiers */
+ }
+fx;
+
+static int fixed_parse_compatible (void);
+static struct fmt_list *fixed_parse_fortran (void);
+
+static int parse_string_argument (void);
+static int parse_variable_argument (void);
+
+/* Parses all the variable and string specifications on a single
+ PRINT, PRINT EJECT, or WRITE command into the prt structure.
+ Returns success. */
+static int
+parse_specs (void)
+{
+ /* Return code from called function. */
+ int code;
+
+ fx.recno = 1;
+ fx.sc = 1;
+
+ while (token != '.')
+ {
+ while (lex_match ('/'))
+ {
+ int prev_recno = fx.recno;
+
+ fx.recno++;
+ if (token == T_NUM)
+ {
+ if (!lex_force_int ())
+ return 0;
+ if (lex_integer () < fx.recno)
+ {
+ msg (SE, _("The record number specified, %ld, is "
+ "before the previous record, %d. Data "
+ "fields must be listed in order of "
+ "increasing record number."),
+ lex_integer (), fx.recno - 1);
+ return 0;
+ }
+ fx.recno = lex_integer ();
+ lex_get ();
+ }
+
+ fx.spec.type = PRT_NEWLINE;
+ while (prev_recno++ < fx.recno)
+ append_var_spec (&fx.spec);
+
+ fx.sc = 1;
+ }
+
+ if (token == T_STRING)
+ code = parse_string_argument ();
+ else
+ code = parse_variable_argument ();
+ if (!code)
+ return 0;
+ }
+ fx.spec.type = PRT_NEWLINE;
+ append_var_spec (&fx.spec);
+
+ if (!nrec)
+ nrec = fx.recno;
+ else if (fx.recno > nrec)
+ {
+ msg (SE, _("Variables are specified on records that "
+ "should not exist according to RECORDS subcommand."));
+ return 0;
+ }
+
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Parses a string argument to the PRINT commands. Returns success. */
+static int
+parse_string_argument (void)
+{
+ fx.spec.type = PRT_CONST;
+ fx.spec.fc = fx.sc - 1;
+ fx.spec.u.c = xstrdup (ds_value (&tokstr));
+ lex_get ();
+
+ /* Parse the included column range. */
+ if (token == T_NUM)
+ {
+ /* Width of column range in characters. */
+ int c_len;
+
+ /* Width of constant string in characters. */
+ int s_len;
+
+ /* 1-based index of last column in range. */
+ int lc;
+
+ if (!lex_integer_p () || lex_integer () <= 0)
+ {
+ msg (SE, _("%g is not a valid column location."), tokval);
+ goto fail;
+ }
+ fx.spec.fc = lex_integer () - 1;
+
+ lex_get ();
+ lex_negative_to_dash ();
+ if (lex_match ('-'))
+ {
+ if (!lex_integer_p ())
+ {
+ msg (SE, _("Column location expected following `%d-'."),
+ fx.spec.fc + 1);
+ goto fail;
+ }
+ if (lex_integer () <= 0)
+ {
+ msg (SE, _("%g is not a valid column location."), tokval);
+ goto fail;
+ }
+ if (lex_integer () < fx.spec.fc + 1)
+ {
+ msg (SE, _("%d-%ld is not a valid column range. The second "
+ "column must be greater than or equal to the first."),
+ fx.spec.fc + 1, lex_integer ());
+ goto fail;
+ }
+ lc = lex_integer () - 1;
+
+ lex_get ();
+ }
+ else
+ /* If only a starting location is specified then the field is
+ the width of the provided string. */
+ lc = fx.spec.fc + strlen (fx.spec.u.c) - 1;
+
+ /* Apply the range. */
+ c_len = lc - fx.spec.fc + 1;
+ s_len = strlen (fx.spec.u.c);
+ if (s_len > c_len)
+ fx.spec.u.c[c_len] = 0;
+ else if (s_len < c_len)
+ {
+ fx.spec.u.c = xrealloc (fx.spec.u.c, c_len + 1);
+ memset (&fx.spec.u.c[s_len], ' ', c_len - s_len);
+ fx.spec.u.c[c_len] = 0;
+ }
+
+ fx.sc = lc + 1;
+ }
+ else
+ /* If nothing is provided then the field is the width of the
+ provided string. */
+ fx.sc += strlen (fx.spec.u.c);
+
+ append_var_spec (&fx.spec);
+ return 1;
+
+fail:
+ free (fx.spec.u.c);
+ return 0;
+}
+
+/* Parses a variable argument to the PRINT commands by passing it off
+ to fixed_parse_compatible() or fixed_parse_fortran() as appropriate.
+ Returns success. */
+static int
+parse_variable_argument (void)
+{
+ if (!parse_variables (NULL, &fx.v, &fx.nv, PV_DUPLICATE))
+ return 0;
+
+ if (token == T_NUM)
+ {
+ if (!fixed_parse_compatible ())
+ goto fail;
+ }
+ else if (token == '(')
+ {
+ fx.level = 0;
+ fx.cv = 0;
+ if (!fixed_parse_fortran ())
+ goto fail;
+ }
+ else
+ {
+ /* User wants dictionary format specifiers. */
+ int i;
+
+ lex_match ('*');
+ for (i = 0; i < fx.nv; i++)
+ {
+ /* Variable. */
+ fx.spec.type = PRT_VAR;
+ fx.spec.fc = fx.sc - 1;
+ fx.spec.u.v.v = fx.v[i];
+ fx.spec.u.v.f = fx.v[i]->print;
+ append_var_spec (&fx.spec);
+ fx.sc += fx.v[i]->print.w;
+
+ /* Space. */
+ fx.spec.type = PRT_SPACE;
+ fx.spec.fc = fx.sc - 1;
+ append_var_spec (&fx.spec);
+ fx.sc++;
+ }
+ }
+
+ free (fx.v);
+ return 1;
+
+fail:
+ free (fx.v);
+ return 0;
+}
+
+/* Parses a column specification for parse_specs(). */
+static int
+fixed_parse_compatible (void)
+{
+ int dividend;
+ int type;
+ int i;
+
+ type = fx.v[0]->type;
+ for (i = 1; i < fx.nv; i++)
+ if (type != fx.v[i]->type)
+ {
+ msg (SE, _("%s is not of the same type as %s. To specify "
+ "variables of different types in the same variable "
+ "list, use a FORTRAN-like format specifier."),
+ fx.v[i]->name, fx.v[0]->name);
+ return 0;
+ }
+
+ if (!lex_force_int ())
+ return 0;
+ fx.fc = lex_integer () - 1;
+ if (fx.fc < 0)
+ {
+ msg (SE, _("Column positions for fields must be positive."));
+ return 0;
+ }
+ lex_get ();
+
+ lex_negative_to_dash ();
+ if (lex_match ('-'))
+ {
+ if (!lex_force_int ())
+ return 0;
+ fx.lc = lex_integer () - 1;
+ if (fx.lc < 0)
+ {
+ msg (SE, _("Column positions for fields must be positive."));
+ return 0;
+ }
+ else if (fx.lc < fx.fc)
+ {
+ msg (SE, _("The ending column for a field must not "
+ "be less than the starting column."));
+ return 0;
+ }
+ lex_get ();
+ }
+ else
+ fx.lc = fx.fc;
+
+ fx.spec.u.v.f.w = fx.lc - fx.fc + 1;
+ if (lex_match ('('))
+ {
+ struct fmt_desc *fdp;
+
+ if (token == T_ID)
+ {
+ const char *cp;
+
+ fx.spec.u.v.f.type = parse_format_specifier_name (&cp, 0);
+ if (fx.spec.u.v.f.type == -1)
+ return 0;
+ if (*cp)
+ {
+ msg (SE, _("A format specifier on this line "
+ "has extra characters on the end."));
+ return 0;
+ }
+ lex_get ();
+ lex_match (',');
+ }
+ else
+ fx.spec.u.v.f.type = FMT_F;
+
+ if (token == T_NUM)
+ {
+ if (!lex_force_int ())
+ return 0;
+ if (lex_integer () < 1)
+ {
+ msg (SE, _("The value for number of decimal places "
+ "must be at least 1."));
+ return 0;
+ }
+ fx.spec.u.v.f.d = lex_integer ();
+ lex_get ();
+ }
+ else
+ fx.spec.u.v.f.d = 0;
+
+ fdp = &formats[fx.spec.u.v.f.type];
+ if (fdp->n_args < 2 && fx.spec.u.v.f.d)
+ {
+ msg (SE, _("Input format %s doesn't accept decimal places."),
+ fdp->name);
+ return 0;
+ }
+ if (fx.spec.u.v.f.d > 16)
+ fx.spec.u.v.f.d = 16;
+
+ if (!lex_force_match (')'))
+ return 0;
+ }
+ else
+ {
+ fx.spec.u.v.f.type = FMT_F;
+ fx.spec.u.v.f.d = 0;
+ }
+
+ fx.sc = fx.lc + 1;
+
+ if ((fx.lc - fx.fc + 1) % fx.nv)
+ {
+ msg (SE, _("The %d columns %d-%d can't be evenly divided into %d "
+ "fields."), fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, fx.nv);
+ return 0;
+ }
+
+ dividend = (fx.lc - fx.fc + 1) / fx.nv;
+ fx.spec.u.v.f.w = dividend;
+ if (!check_output_specifier (&fx.spec.u.v.f))
+ return 0;
+ if ((type == ALPHA) ^ (formats[fx.spec.u.v.f.type].cat & FCAT_STRING))
+ {
+ msg (SE, _("%s variables cannot be displayed with format %s."),
+ type == ALPHA ? _("String") : _("Numeric"),
+ fmt_to_string (&fx.spec.u.v.f));
+ return 0;
+ }
+
+ /* Check that, for string variables, the user didn't specify a width
+ longer than an actual string width. */
+ if (type == ALPHA)
+ {
+ /* Minimum width of all the string variables specified. */
+ int min_len = fx.v[0]->width;
+
+ for (i = 1; i < fx.nv; i++)
+ min_len = min (min_len, fx.v[i]->width);
+ if (!check_string_specifier (&fx.spec.u.v.f, min_len))
+ return 0;
+ }
+
+ fx.spec.type = PRT_VAR;
+ for (i = 0; i < fx.nv; i++)
+ {
+ fx.spec.fc = fx.fc + dividend * i;
+ fx.spec.u.v.v = fx.v[i];
+ append_var_spec (&fx.spec);
+ }
+ return 1;
+}
+
+/* Destroy a format list and, optionally, all its sublists. */
+static void
+destroy_fmt_list (struct fmt_list * f, int recurse)
+{
+ struct fmt_list *next;
+
+ for (; f; f = next)
+ {
+ next = f->next;
+ if (recurse && f->f.type == FMT_DESCEND)
+ destroy_fmt_list (f->down, 1);
+ free (f);
+ }
+}
+
+/* Recursively puts the format list F (which represents a set of
+ FORTRAN-like format specifications, like 4(F10,2X)) into the
+ structure prt. */
+static int
+dump_fmt_list (struct fmt_list * f)
+{
+ int i;
+
+ for (; f; f = f->next)
+ if (f->f.type == FMT_X)
+ fx.sc += f->count;
+ else if (f->f.type == FMT_T)
+ fx.sc = f->f.w;
+ else if (f->f.type == FMT_NEWREC)
+ {
+ fx.recno += f->count;
+ fx.sc = 1;
+ fx.spec.type = PRT_NEWLINE;
+ for (i = 0; i < f->count; i++)
+ append_var_spec (&fx.spec);
+ }
+ else
+ for (i = 0; i < f->count; i++)
+ if (f->f.type == FMT_DESCEND)
+ {
+ if (!dump_fmt_list (f->down))
+ return 0;
+ }
+ else
+ {
+ struct variable *v;
+
+ if (fx.cv >= fx.nv)
+ {
+ msg (SE, _("The number of format "
+ "specifications exceeds the number of variable "
+ "names given."));
+ return 0;
+ }
+
+ v = fx.v[fx.cv++];
+ if ((v->type == ALPHA) ^ (formats[f->f.type].cat & FCAT_STRING))
+ {
+ msg (SE, _("Display format %s may not be used with a "
+ "%s variable."), fmt_to_string (&f->f),
+ v->type == ALPHA ? _("string") : _("numeric"));
+ return 0;
+ }
+ if (!check_string_specifier (&f->f, v->width))
+ return 0;
+
+ fx.spec.type = PRT_VAR;
+ fx.spec.u.v.v = v;
+ fx.spec.u.v.f = f->f;
+ fx.spec.fc = fx.sc - 1;
+ append_var_spec (&fx.spec);
+
+ fx.sc += f->f.w;
+ }
+ return 1;
+}
+
+/* Recursively parses a list of FORTRAN-like format specifiers. Calls
+ itself to parse nested levels of parentheses. Returns to its
+ original caller NULL, to indicate error, non-NULL, but nothing
+ useful, to indicate success (it returns a free()'d block). */
+static struct fmt_list *
+fixed_parse_fortran (void)
+{
+ struct fmt_list *head;
+ struct fmt_list *fl = NULL;
+
+ lex_get (); /* skip opening parenthesis */
+ while (token != ')')
+ {
+ if (fl)
+ fl = fl->next = xmalloc (sizeof *fl);
+ else
+ head = fl = xmalloc (sizeof *fl);
+
+ if (token == T_NUM)
+ {
+ if (!lex_integer_p ())
+ goto fail;
+ fl->count = lex_integer ();
+ lex_get ();
+ }
+ else
+ fl->count = 1;
+
+ if (token == '(')
+ {
+ fl->f.type = FMT_DESCEND;
+ fx.level++;
+ fl->down = fixed_parse_fortran ();
+ fx.level--;
+ if (!fl->down)
+ goto fail;
+ }
+ else if (lex_match ('/'))
+ fl->f.type = FMT_NEWREC;
+ else if (!parse_format_specifier (&fl->f, 1)
+ || !check_output_specifier (&fl->f))
+ goto fail;
+
+ lex_match (',');
+ }
+ fl->next = NULL;
+ lex_get ();
+
+ if (fx.level)
+ return head;
+
+ fl->next = NULL;
+ dump_fmt_list (head);
+ destroy_fmt_list (head, 1);
+ if (fx.cv < fx.nv)
+ {
+ msg (SE, _("There aren't enough format specifications "
+ "to match the number of variable names given."));
+ goto fail;
+ }
+ return head;
+
+fail:
+ fl->next = NULL;
+ destroy_fmt_list (head, 0);
+
+ return NULL;
+}
+
+/* Prints the table produced by the TABLE subcommand to the listing
+ file. */
+static void
+dump_table (void)
+{
+ struct prt_out_spec *spec;
+ const char *filename;
+ struct tab_table *t;
+ int recno;
+ int nspec;
+
+ for (nspec = 0, spec = prt.spec; spec; spec = spec->next)
+ if (spec->type == PRT_CONST || spec->type == PRT_VAR)
+ nspec++;
+ t = tab_create (4, nspec + 1, 0);
+ tab_columns (t, TAB_COL_DOWN, 1);
+ tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, nspec);
+ tab_hline (t, TAL_2, 0, 3, 1);
+ tab_headers (t, 0, 0, 1, 0);
+ tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
+ tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
+ tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
+ tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
+ tab_dim (t, tab_natural_dimensions);
+ for (nspec = recno = 0, spec = prt.spec; spec; spec = spec->next)
+ switch (spec->type)
+ {
+ case PRT_NEWLINE:
+ recno++;
+ break;
+ case PRT_CONST:
+ {
+ int len = strlen (spec->u.c);
+ nspec++;
+ tab_text (t, 0, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
+ "\"%s\"", spec->u.c);
+ tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
+ tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
+ spec->fc + 1, spec->fc + len);
+ tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
+ "A%d", len);
+ break;
+ }
+ case PRT_VAR:
+ {
+ nspec++;
+ tab_text (t, 0, nspec, TAB_LEFT, spec->u.v.v->name);
+ tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
+ tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
+ spec->fc + 1, spec->fc + spec->u.v.f.w);
+ tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX,
+ fmt_to_string (&spec->u.v.f));
+ break;
+ }
+ case PRT_SPACE:
+ break;
+ case PRT_ERROR:
+ assert (0);
+ }
+
+ filename = fh_handle_name (prt.handle);
+ tab_title (t, 1, (prt.handle != NULL
+ ? _("Writing %3d records to file %s.")
+ : _("Writing %3d records to the listing file.")),
+ recno, filename);
+ tab_submit (t);
+ fh_handle_name (NULL);
+}
+
+/* PORTME: The number of characters in a line terminator. */
+#if __MSDOS__
+#define LINE_END_WIDTH 2 /* \r\n */
+#else
+#define LINE_END_WIDTH 1 /* \n */
+#endif
+
+/* Calculates the maximum possible line width and allocates a buffer
+ big enough to contain it, if necessary (otherwise sets max_width).
+ (The action taken depends on compiler & OS as detected by pref.h.) */
+static void
+alloc_line (void)
+{
+ /* Cumulative maximum line width (excluding null terminator) so far. */
+ int w = 0;
+
+ /* Width required by current this prt_out_spec. */
+ int pot_w; /* Potential w. */
+
+ /* Iterator. */
+ struct prt_out_spec *i;
+
+ for (i = prt.spec; i; i = i->next)
+ {
+ switch (i->type)
+ {
+ case PRT_NEWLINE:
+ pot_w = 0;
+ break;
+ case PRT_CONST:
+ pot_w = i->fc + strlen (i->u.c);
+ break;
+ case PRT_VAR:
+ pot_w = i->fc + i->u.v.f.w;
+ break;
+ case PRT_SPACE:
+ pot_w = i->fc + 1;
+ break;
+ case PRT_ERROR:
+ assert (0);
+ break;
+ }
+ if (pot_w > w)
+ w = pot_w;
+ }
+ prt.max_width = w + LINE_END_WIDTH + 1;
+#if !PAGED_STACK
+ prt.line = xmalloc (prt.max_width);
+#endif
+}
+\f
+/* Transformation. */
+
+/* Performs the transformation inside print_trns T on case C. */
+static int
+print_trns_proc (struct trns_header * trns, struct ccase * c)
+{
+ /* Transformation. */
+ struct print_trns *t = (struct print_trns *) trns;
+
+ /* Iterator. */
+ struct prt_out_spec *i;
+
+ /* Line buffer. */
+#if PAGED_STACK
+#if __GNUC__ && !__STRICT_ANSI__
+ char buf[t->max_width];
+#else /* !__GNUC__ */
+ char *buf = alloca (t->max_width);
+#endif /* !__GNUC__ */
+#else /* !PAGED_STACK */
+ char *buf = t->line;
+#endif /* !PAGED_STACK */
+
+ /* Length of the line in buf. */
+ int len = 0;
+ memset (buf, ' ', t->max_width);
+
+ if (t->options & PRT_EJECT)
+ som_eject_page ();
+
+ /* Note that a field written to a place where a field has already
+ been written truncates the record. `PRINT /A B (T10,F8,T1,F8).'
+ only outputs B. This is an example of bug-for-bug compatibility,
+ in the author's opinion. */
+ for (i = t->spec; i; i = i->next)
+ switch (i->type)
+ {
+ case PRT_NEWLINE:
+ if (t->handle == NULL)
+ {
+ buf[len] = 0;
+ tab_output_text (TAT_FIX | TAT_NOWRAP, buf);
+ }
+ else
+ {
+ if ((t->options & PRT_CMD_MASK) == PRT_PRINT
+ || t->handle->mode != FH_MD_BINARY)
+ {
+ /* PORTME: Line ends. */
+#if __MSDOS__
+ buf[len++] = '\r';
+#endif
+ buf[len++] = '\n';
+ }
+
+ dfm_put_record (t->handle, buf, len);
+ }
+
+ memset (buf, ' ', t->max_width);
+ len = 0;
+ break;
+
+ case PRT_CONST:
+ /* FIXME: Should be revised to keep track of the string's
+ length outside the loop, probably in i->u.c[0]. */
+ memcpy (&buf[i->fc], i->u.c, strlen (i->u.c));
+ len = i->fc + strlen (i->u.c);
+ break;
+
+ case PRT_VAR:
+ if (i->u.v.v->type == NUMERIC)
+ data_out (&buf[i->fc], &i->u.v.f, &c->data[i->u.v.v->fv]);
+ else
+ {
+ union value t;
+ t.c = c->data[i->u.v.v->fv].s;
+ data_out (&buf[i->fc], &i->u.v.f, &t);
+ }
+ len = i->fc + i->u.v.f.w;
+ break;
+
+ case PRT_SPACE:
+ /* PRT_SPACE always immediately follows PRT_VAR. */
+ buf[len++] = ' ';
+ break;
+
+ case PRT_ERROR:
+ assert (0);
+ break;
+ }
+
+ return -1;
+}
+
+/* Frees all the data inside print_trns T. Does not free T. */
+static void
+print_trns_free (struct trns_header * t)
+{
+ struct prt_out_spec *i, *n;
+
+ for (i = ((struct print_trns *) t)->spec; i; i = n)
+ {
+ switch (i->type)
+ {
+ case PRT_CONST:
+ free (i->u.c);
+ /* fall through */
+ case PRT_NEWLINE:
+ case PRT_VAR:
+ case PRT_SPACE:
+ /* nothing to do */
+ break;
+ case PRT_ERROR:
+ assert (0);
+ break;
+ }
+ n = i->next;
+ free (i);
+ }
+#if !PAGED_STACK
+ free (((struct print_trns *) t)->line);
+#endif
+}
+\f
+/* PRINT SPACE. */
+
+/* PRINT SPACE transformation. */
+struct print_space_trns
+{
+ struct trns_header h;
+
+ struct file_handle *handle; /* Output file, NULL=listing file. */
+ struct expression *e; /* Number of lines; NULL=1. */
+}
+print_space_trns;
+
+static int print_space_trns_proc (struct trns_header *, struct ccase *);
+static void print_space_trns_free (struct trns_header *);
+
+int
+cmd_print_space (void)
+{
+ struct print_space_trns *t;
+ struct file_handle *handle;
+ struct expression *e;
+
+ lex_match_id ("SPACE");
+ if (lex_match_id ("OUTFILE"))
+ {
+ lex_match ('=');
+
+ if (token == T_ID)
+ handle = fh_get_handle_by_name (tokid);
+ else if (token == T_STRING)
+ handle = fh_get_handle_by_filename (tokid);
+ else
+ {
+ msg (SE, _("A file name or handle was expected in the "
+ "OUTFILE subcommand."));
+ return CMD_FAILURE;
+ }
+
+ if (!handle)
+ return CMD_FAILURE;
+ lex_get ();
+ }
+ else
+ handle = NULL;
+
+ if (token != '.')
+ {
+ e = expr_parse (PXP_NUMERIC);
+ if (token != '.')
+ {
+ expr_free (e);
+ lex_error (_("expecting end of command"));
+ return CMD_FAILURE;
+ }
+ }
+ else
+ e = NULL;
+
+ t = xmalloc (sizeof *t);
+ t->h.proc = print_space_trns_proc;
+ if (e)
+ t->h.free = print_space_trns_free;
+ else
+ t->h.free = NULL;
+ t->handle = handle;
+ t->e = e;
+
+ add_transformation ((struct trns_header *) t);
+ return CMD_SUCCESS;
+}
+
+static int
+print_space_trns_proc (struct trns_header * trns, struct ccase * c)
+{
+ struct print_space_trns *t = (struct print_space_trns *) trns;
+ int n;
+
+ if (t->e)
+ {
+ union value v;
+
+ expr_evaluate (t->e, c, &v);
+ n = v.f;
+ if (n < 0)
+ {
+ msg (SW, _("The expression on PRINT SPACE evaluated to %d. It's "
+ "not possible to PRINT SPACE a negative number of "
+ "lines."),
+ n);
+ n = 1;
+ }
+ }
+ else
+ n = 1;
+
+ if (t->handle == NULL)
+ while (n--)
+ som_blank_line ();
+ else
+ {
+ char buf[LINE_END_WIDTH];
+
+ /* PORTME: Line ends. */
+#if __MSDOS__
+ buf[0] = '\r';
+ buf[1] = '\n';
+#else
+ buf[0] = '\n';
+#endif
+ while (n--)
+ dfm_put_record (t->handle, buf, LINE_END_WIDTH);
+ }
+
+ return -1;
+}
+
+static void
+print_space_trns_free (struct trns_header * trns)
+{
+ expr_free (((struct print_space_trns *) trns)->e);
+}
+\f
+/* Debugging code. */
+
+#if DEBUGGING
+void
+debug_print (void)
+{
+ struct prt_out_spec *p;
+
+ if (prt.handle == NULL)
+ {
+ printf ("PRINT");
+ if (prt.eject)
+ printf (" EJECT");
+ }
+ else
+ printf ("WRITE OUTFILE=%s", handle_name (prt.handle));
+ printf (" MAX_WIDTH=%d", prt.max_width);
+ printf (" /");
+ for (p = prt.spec; p; p = p->next)
+ switch (p->type)
+ {
+ case PRT_ERROR:
+ printf (_("<ERROR>"));
+ break;
+ case PRT_NEWLINE:
+ printf ("\n /");
+ break;
+ case PRT_CONST:
+ printf (" \"%s\" %d-%d", p->u.c, p->fc + 1, p->fc + strlen (p->u.c));
+ break;
+ case PRT_VAR:
+ printf (" %s %d %d-%d (%s)", p->u.v.v->name, p->u.v.v->fv, p->fc + 1,
+ p->fc + p->u.v.v->print.w, fmt_to_string (&p->u.v.v->print));
+ break;
+ case PRT_SPACE:
+ printf (" \" \" %d", p->fc + 1);
+ break;
+ }
+ printf (".\n");
+}
+#endif /* DEBUGGING */
--- /dev/null
+/* q2c - parser generator for PSPP procedures.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <time.h>
+#include <errno.h>
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#include "str.h"
+
+/* Brokenness. */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+
+#ifndef EXIT_FAILURE
+#define EXIT_FAILURE 1
+#endif
+
+#if !HAVE_STRERROR
+#include "misc/strerror.c"
+#endif
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* Max length of an input line. */
+#define MAX_LINE_LEN 1024
+
+/* Max token length. */
+#define MAX_TOK_LEN 1024
+
+/* argv[0]. */
+char *pgmname;
+
+/* Have the input and output files been opened yet? */
+int is_open;
+
+/* Input, output files. */
+FILE *in, *out;
+
+/* Input, output file names. */
+char *ifn, *ofn;
+
+/* Input, output file line number. */
+int ln, oln = 1;
+
+/* Input line buffer, current position. */
+char *buf, *cp;
+
+/* Token types. */
+enum
+ {
+ T_STRING = 256, /* String literal. */
+ T_ID = 257 /* Identifier. */
+ };
+
+/* Current token: either one of the above, or a single character. */
+int token;
+
+/* Token string value. */
+char *tokstr;
+\f
+/* Utility functions. */
+
+#if !(__GNUC__ >= 2)
+#define nullstr ""
+#else
+const char nullstr[] = "";
+#endif
+
+/* Close all open files and delete the output file, on failure. */
+void
+finish_up (void)
+{
+ if (!is_open)
+ return;
+ is_open = 0;
+ fclose (in);
+ fclose (out);
+ if (remove (ofn) == -1)
+ fprintf (stderr, "%s: %s: remove: %s\n", pgmname, ofn, strerror (errno));
+}
+
+#if __GNUC__ >= 2
+void hcf (void) __attribute__ ((noreturn));
+#endif
+
+/* Terminate unsuccessfully. */
+void
+hcf (void)
+{
+ finish_up ();
+ exit (EXIT_FAILURE);
+}
+
+#if __GNUC__ >= 2
+int fail (const char *, ...) __attribute__ ((format (printf, 1, 2)));
+int error (const char *, ...) __attribute__ ((format (printf, 1, 2)));
+#endif
+
+/* Output an error message and terminate unsuccessfully. */
+int
+fail (const char *format, ...)
+{
+ va_list args;
+
+ va_start (args, format);
+ fprintf (stderr, "%s: ", pgmname);
+ vfprintf (stderr, format, args);
+ fprintf (stderr, "\n");
+ va_end (args);
+
+ hcf ();
+}
+
+/* Output a context-dependent error message and terminate
+ unsuccessfully. */
+int
+error (const char *format,...)
+{
+ va_list args;
+
+ va_start (args, format);
+ fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
+ vfprintf (stderr, format, args);
+ fprintf (stderr, "\n");
+ va_end (args);
+
+ hcf ();
+}
+
+#define VME "virtual memory exhausted"
+
+/* Allocate a block of SIZE bytes and return a pointer to its
+ beginning. */
+void *
+xmalloc (size_t size)
+{
+ void *vp;
+
+ if (size == 0)
+ return NULL;
+
+ vp = malloc (size);
+ if (!vp)
+ {
+#if DEBUGGING && __CHECKER__
+ error ("xmalloc(%lu): Inducing segfault.", (unsigned long) size);
+ *((int *) 0) = 0;
+#endif
+ fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
+ }
+
+ return vp;
+}
+
+/* Resize the block at PTR to size SIZE and return a pointer to the
+ beginning of the new block. */
+void *
+xrealloc (void *ptr, size_t size)
+{
+ void *vp;
+
+ if (!size)
+ {
+ if (ptr)
+ free (ptr);
+ return NULL;
+ }
+
+ if (ptr)
+ vp = realloc (ptr, size);
+ else
+ vp = malloc (size);
+
+ if (!vp)
+ fail ("xrealloc(%lu): %s", (unsigned long) size, VME);
+
+ return vp;
+}
+
+/* Make a dynamically allocated copy of string S and return a pointer
+ to the first character. */
+char *
+xstrdup (const char *s)
+{
+ size_t size;
+ char *t;
+
+ assert (s != NULL);
+ size = strlen (s) + 1;
+
+ t = malloc (size);
+ if (!t)
+ fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
+
+ memcpy (t, s, size);
+ return t;
+}
+
+/* Returns a pointer to one of 8 static buffers. The buffers are used
+ in rotation. */
+char *
+get_buffer (void)
+{
+ static char b[8][256];
+ static int cb;
+
+ if (++cb >= 8)
+ cb = 0;
+
+ return b[cb];
+}
+
+/* Copies a string to a static buffer, converting it to lowercase in
+ the process, and returns a pointer to the static buffer. */
+char *
+st_lower (const char *s)
+{
+ char *p, *cp;
+
+ p = cp = get_buffer ();
+ while (*s)
+ *cp++ = tolower ((unsigned char) (*s++));
+ *cp++ = '\0';
+
+ return p;
+}
+
+/* Copies a string to a static buffer, converting it to uppercase in
+ the process, and returns a pointer to the static buffer. */
+char *
+st_upper (const char *s)
+{
+ char *p, *cp;
+
+ p = cp = get_buffer ();
+ while (*s)
+ *cp++ = toupper ((unsigned char) (*s++));
+ *cp++ = '\0';
+
+ return p;
+}
+
+/* Returns the address of the first non-whitespace character in S, or
+ the address of the null terminator if none. */
+char *
+skip_ws (const char *s)
+{
+ while (isspace ((unsigned char) *s))
+ s++;
+ return (char *) s;
+}
+
+/* Read one line from the input file into buf. Lines having special
+ formats are handled specially. */
+int
+get_line (void)
+{
+ ln++;
+ if (0 == fgets (buf, MAX_LINE_LEN, in))
+ {
+ if (ferror (in))
+ fail ("%s: fgets: %s", ifn, strerror (errno));
+ return 0;
+ }
+
+ cp = strchr (buf, '\n');
+ if (cp != NULL)
+ *cp = '\0';
+
+ cp = buf;
+ return 1;
+}
+\f
+/* Symbol table manager. */
+
+/* Symbol table entry. */
+typedef struct symbol symbol;
+struct symbol
+ {
+ symbol *next; /* Next symbol in symbol table. */
+ char *name; /* Symbol name. */
+ int unique; /* 1=Name must be unique in this file. */
+ int ln; /* Line number of definition. */
+ int value; /* Symbol value. */
+ };
+
+/* Symbol table. */
+symbol *symtab;
+
+/* Add a symbol to the symbol table having name NAME, uniqueness
+ UNIQUE, and value VALUE. If a symbol having the same name is found
+ in the symbol table, its sequence number is returned and the symbol
+ table is not modified. Otherwise, the symbol is added and the next
+ available sequence number is returned. */
+int
+add_symbol (const char *name, int unique, int value)
+{
+ symbol *iter, *sym;
+ int x;
+
+ sym = xmalloc (sizeof (symbol));
+ sym->name = xstrdup (name);
+ sym->unique = unique;
+ sym->value = value;
+ sym->next = NULL;
+ sym->ln = ln;
+ if (!symtab)
+ {
+ symtab = sym;
+ return 1;
+ }
+ iter = symtab;
+ x = 1;
+ for (;;)
+ {
+ if (!strcmp (iter->name, name))
+ {
+ if (iter->unique)
+ {
+ fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
+ ln, name);
+ fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
+ iter->ln);
+ hcf ();
+ }
+ free (sym->name);
+ free (sym);
+ return x;
+ }
+ if (!iter->next)
+ break;
+ iter = iter->next;
+ x++;
+ }
+ iter->next = sym;
+ return ++x;
+}
+
+/* Finds the symbol having given sequence number X within the symbol
+ table, and returns the associated symbol structure. */
+symbol *
+find_symbol (int x)
+{
+ symbol *iter;
+
+ iter = symtab;
+ while (x > 1 && iter)
+ {
+ iter = iter->next;
+ x--;
+ }
+ assert (iter);
+ return iter;
+}
+
+#if DEBUGGING
+/* Writes a printable representation of the current token to
+ stdout. */
+void
+dump_token (void)
+{
+ switch (token)
+ {
+ case T_STRING:
+ printf ("STRING\t\"%s\"\n", tokstr);
+ break;
+ case T_ID:
+ printf ("ID\t%s\n", tokstr);
+ break;
+ default:
+ printf ("PUNCT\t%c\n", token);
+ }
+}
+#endif /* DEBUGGING */
+
+/* Reads a token from the input file. */
+int
+lex_get (void)
+{
+ /* Skip whitespace and check for end of file. */
+ for (;;)
+ {
+ cp = skip_ws (cp);
+ if (*cp != '\0')
+ break;
+
+ if (!get_line ())
+ fail ("%s: Unexpected end of file.", ifn);
+ }
+
+ if (*cp == '_' || isalnum ((unsigned char) *cp))
+ {
+ char *dest = tokstr;
+ token = T_ID;
+ while (*cp == '_' || isalnum ((unsigned char) *cp))
+ *dest++ = toupper ((unsigned char) (*cp++));
+ *dest++ = '\0';
+ }
+ else if (*cp == '"')
+ {
+ char *dest = tokstr;
+ token = T_STRING;
+ cp++;
+ while (*cp != '"' && *cp)
+ {
+ if (*cp == '\\')
+ {
+ cp++;
+ if (!*cp)
+ error ("Unterminated string literal.");
+ *dest++ = *cp++;
+ }
+ else
+ *dest++ = *cp++;
+ }
+ *dest++ = 0;
+ if (!*cp)
+ error ("Unterminated string literal.");
+ cp++;
+ }
+ else
+ token = *cp++;
+
+#if DEBUGGING
+ dump_token ();
+#endif
+
+ return token;
+}
+
+/* Force the current token to be an identifier token. */
+void
+force_id (void)
+{
+ if (token != T_ID)
+ error ("Identifier expected.");
+}
+
+/* Force the current token to be a string token. */
+void
+force_string (void)
+{
+ if (token != T_STRING)
+ error ("String expected.");
+}
+
+/* Checks whether the current token is the identifier S; if so, skips
+ the token and returns 1; otherwise, returns 0. */
+int
+match_id (const char *s)
+{
+ if (token == T_ID && !strcmp (tokstr, s))
+ {
+ lex_get ();
+ return 1;
+ }
+ return 0;
+}
+
+/* Checks whether the current token is T. If so, skips the token and
+ returns 1; otherwise, returns 0. */
+int
+match_token (int t)
+{
+ if (token == t)
+ {
+ lex_get ();
+ return 1;
+ }
+ return 0;
+}
+
+/* Force the current token to be T, and skip it. */
+void
+skip_token (int t)
+{
+ if (token != t)
+ error ("`%c' expected.", t);
+ lex_get ();
+}
+\f
+/* Structures. */
+
+/* Some specifiers have associated values. */
+enum
+ {
+ VAL_NONE, /* No value. */
+ VAL_INT, /* Integer value. */
+ VAL_DBL /* Floating point value. */
+ };
+
+/* For those specifiers with values, the syntax of those values. */
+enum
+ {
+ VT_PLAIN, /* Unadorned value. */
+ VT_PAREN /* Value must be enclosed in parentheses. */
+ };
+
+/* Forward definition. */
+typedef struct specifier specifier;
+
+/* A single setting. */
+typedef struct setting setting;
+struct setting
+ {
+ specifier *parent; /* Owning specifier. */
+ setting *next; /* Next in the chain. */
+ char *specname; /* Name of the setting. */
+ int con; /* Sequence number. */
+
+ /* Values. */
+ int valtype; /* One of VT_*. */
+ int value; /* One of VAL_*. */
+ int optvalue; /* 1=value is optional, 0=value is required. */
+ char *valname; /* Variable name for the value. */
+ char *restriction; /* !=NULL: expression specifying valid values. */
+ };
+
+/* A single specifier. */
+struct specifier
+ {
+ specifier *next; /* Next in the chain. */
+ char *varname; /* Variable name. */
+ setting *s; /* Associated settings. */
+
+ setting *def; /* Default setting. */
+ setting *omit_kw; /* Setting for which the keyword can be omitted. */
+
+ int index; /* Next array index. */
+ };
+
+/* Subcommand types. */
+typedef enum
+ {
+ SBC_PLAIN, /* The usual case. */
+ SBC_VARLIST, /* Variable list. */
+ SBC_INT, /* Integer value. */
+ SBC_PINT, /* Integer inside parentheses. */
+ SBC_DBL, /* Floating point value. */
+ SBC_INT_LIST, /* List of integers (?). */
+ SBC_DBL_LIST, /* List of floating points (?). */
+ SBC_CUSTOM, /* Custom. */
+ SBC_ARRAY, /* Array of boolean values. */
+ SBC_STRING, /* String value. */
+ SBC_VAR /* Single variable name. */
+ }
+subcommand_type;
+
+/* A single subcommand. */
+typedef struct subcommand subcommand;
+struct subcommand
+ {
+ subcommand *next; /* Next in the chain. */
+ char *name; /* Subcommand name. */
+ subcommand_type type; /* One of SBC_*. */
+ int once; /* 1=Subcommand may appear only once. */
+ int narray; /* Index of next array element. */
+ const char *prefix; /* Prefix for variable and constant names. */
+ specifier *spec; /* Array of specifiers. */
+
+ /* SBC_STRING only. */
+ char *restriction; /* Expression restricting string length. */
+ char *message; /* Error message. */
+ };
+
+/* Name of the command; i.e., DESCRIPTIVES. */
+char *cmdname;
+
+/* Short prefix for the command; i.e., `dsc_'. */
+char *prefix;
+
+/* List of subcommands. */
+subcommand *subcommands;
+
+/* Default subcommand if any, or NULL. */
+subcommand *def;
+\f
+/* Parsing. */
+
+void parse_subcommands (void);
+
+/* Parse an entire specification. */
+void
+parse (void)
+{
+ /* Get the command name and prefix. */
+ if (token != T_STRING && token != T_ID)
+ error ("Command name expected.");
+ cmdname = xstrdup (tokstr);
+ lex_get ();
+ skip_token ('(');
+ force_id ();
+ prefix = xstrdup (tokstr);
+ lex_get ();
+ skip_token (')');
+ skip_token (':');
+
+ /* Read all the subcommands. */
+ subcommands = NULL;
+ def = NULL;
+ parse_subcommands ();
+}
+
+/* Parses a single setting into S, given subcommand information SBC
+ and specifier information SPEC. */
+void
+parse_setting (setting *s, specifier *spec)
+{
+ s->parent = spec;
+
+ if (match_token ('*'))
+ {
+ if (spec->omit_kw)
+ error ("Cannot have two settings with omittable keywords.");
+ else
+ spec->omit_kw = s;
+ }
+
+ if (match_token ('!'))
+ {
+ if (spec->def)
+ error ("Cannot have two default settings.");
+ else
+ spec->def = s;
+ }
+
+ force_id ();
+ s->specname = xstrdup (tokstr);
+ s->con = add_symbol (s->specname, 0, 0);
+ s->value = VAL_NONE;
+
+ lex_get ();
+
+ /* Parse setting value info if necessary. */
+ if (token != '/' && token != ';' && token != '.' && token != ',')
+ {
+ if (token == '(')
+ {
+ s->valtype = VT_PAREN;
+ lex_get ();
+ }
+ else
+ s->valtype = VT_PLAIN;
+
+ s->optvalue = match_token ('*');
+
+ if (match_id ("N"))
+ s->value = VAL_INT;
+ else if (match_id ("D"))
+ s->value = VAL_DBL;
+ else
+ error ("`n' or `d' expected.");
+
+ skip_token (':');
+
+ force_id ();
+ s->valname = xstrdup (tokstr);
+ lex_get ();
+
+ if (token == ',')
+ {
+ lex_get ();
+ force_string ();
+ s->restriction = xstrdup (tokstr);
+ lex_get ();
+ }
+ else
+ s->restriction = NULL;
+
+ if (s->valtype == VT_PAREN)
+ skip_token (')');
+ }
+}
+
+/* Parse a single specifier into SPEC, given subcommand information
+ SBC. */
+void
+parse_specifier (specifier *spec, subcommand *sbc)
+{
+ spec->index = 0;
+ spec->s = NULL;
+ spec->def = NULL;
+ spec->omit_kw = NULL;
+ spec->varname = NULL;
+
+ if (token == T_ID)
+ {
+ spec->varname = xstrdup (st_lower (tokstr));
+ lex_get ();
+ }
+
+ /* Handle array elements. */
+ if (token != ':')
+ {
+ spec->index = sbc->narray;
+ if (sbc->type == SBC_ARRAY)
+ {
+ if (token == '|')
+ token = ',';
+ else
+ sbc->narray++;
+ }
+ spec->s = NULL;
+ return;
+ }
+ skip_token (':');
+
+ /* Parse all the settings. */
+ {
+ setting **s = &spec->s;
+
+ for (;;)
+ {
+ *s = xmalloc (sizeof (setting));
+ parse_setting (*s, spec);
+ if (token == ',' || token == ';' || token == '.')
+ break;
+ skip_token ('/');
+ s = &(*s)->next;
+ }
+ (*s)->next = NULL;
+ }
+}
+
+/* Parse a list of specifiers for subcommand SBC. */
+void
+parse_specifiers (subcommand *sbc)
+{
+ specifier **spec = &sbc->spec;
+
+ if (token == ';' || token == '.')
+ {
+ *spec = NULL;
+ return;
+ }
+
+ for (;;)
+ {
+ *spec = xmalloc (sizeof (specifier));
+ parse_specifier (*spec, sbc);
+ if (token == ';' || token == '.')
+ break;
+ skip_token (',');
+ spec = &(*spec)->next;
+ }
+ (*spec)->next = NULL;
+}
+
+/* Parse a subcommand into SBC. */
+void
+parse_subcommand (subcommand *sbc)
+{
+ if (match_token ('*'))
+ {
+ if (def)
+ error ("Multiple default subcommands.");
+ def = sbc;
+ }
+
+ sbc->once = match_token ('+');
+
+ force_id ();
+ sbc->name = xstrdup (tokstr);
+ lex_get ();
+
+ sbc->narray = 0;
+ sbc->type = SBC_PLAIN;
+ sbc->spec = NULL;
+
+ if (match_token ('['))
+ {
+ force_id ();
+ sbc->prefix = xstrdup (st_lower (tokstr));
+ lex_get ();
+
+ skip_token (']');
+ skip_token ('=');
+
+ sbc->type = SBC_ARRAY;
+ parse_specifiers (sbc);
+ }
+ else
+ {
+ if (match_token ('('))
+ {
+ force_id ();
+ sbc->prefix = xstrdup (st_lower (tokstr));
+ lex_get ();
+
+ skip_token (')');
+ }
+ else
+ sbc->prefix = "";
+
+ skip_token ('=');
+
+ if (match_id ("VAR"))
+ sbc->type = SBC_VAR;
+ if (match_id ("VARLIST"))
+ {
+ if (match_token ('('))
+ {
+ force_string ();
+ sbc->message = xstrdup (tokstr);
+ lex_get();
+
+ skip_token (')');
+ }
+ else sbc->message = NULL;
+
+ sbc->type = SBC_VARLIST;
+ }
+ else if (match_id ("INTEGER"))
+ sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
+ else if (match_id ("PINT"))
+ sbc->type = SBC_PINT;
+ else if (match_id ("DOUBLE"))
+ sbc->type = match_id ("LIST") ? SBC_DBL_LIST : SBC_DBL;
+ else if (match_id ("STRING"))
+ {
+ sbc->type = SBC_STRING;
+ if (token == T_STRING)
+ {
+ sbc->restriction = xstrdup (tokstr);
+ lex_get ();
+ force_string ();
+ sbc->message = xstrdup (tokstr);
+ lex_get ();
+ }
+ else
+ sbc->restriction = NULL;
+ }
+ else if (match_id ("CUSTOM"))
+ sbc->type = SBC_CUSTOM;
+ else
+ parse_specifiers (sbc);
+ }
+}
+
+/* Parse all the subcommands. */
+void
+parse_subcommands (void)
+{
+ subcommand **sbc = &subcommands;
+
+ for (;;)
+ {
+ *sbc = xmalloc (sizeof (subcommand));
+ (*sbc)->next = NULL;
+
+ parse_subcommand (*sbc);
+
+ if (token == '.')
+ return;
+
+ skip_token (';');
+ sbc = &(*sbc)->next;
+ }
+}
+\f
+/* Output. */
+
+#define BASE_INDENT 2 /* Starting indent. */
+#define INC_INDENT 2 /* Indent increment. */
+
+/* Increment the indent. */
+#define indent() indent += INC_INDENT
+#define outdent() indent -= INC_INDENT
+
+/* Size of the indent from the left margin. */
+int indent;
+
+#if __GNUC__ >= 2
+void dump (int, const char *, ...) __attribute__ ((format (printf, 2, 3)));
+#endif
+
+/* Write line FORMAT to the output file, formatted as with printf,
+ indented `indent' characters from the left margin. If INDENTION is
+ greater than 0, indents BASE_INDENT * INDENTION characters after
+ writing the line; if INDENTION is less than 0, dedents BASE_INDENT
+ * INDENTION characters _before_ writing the line. */
+void
+dump (int indention, const char *format, ...)
+{
+ va_list args;
+ int i;
+
+ if (indention < 0)
+ indent += BASE_INDENT * indention;
+
+ oln++;
+ va_start (args, format);
+ for (i = 0; i < indent; i++)
+ putc (' ', out);
+ vfprintf (out, format, args);
+ putc ('\n', out);
+ va_end (args);
+
+ if (indention > 0)
+ indent += BASE_INDENT * indention;
+}
+
+/* Write the structure members for specifier SPEC to the output file.
+ SBC is the including subcommand. */
+void
+dump_specifier_vars (const specifier *spec, const subcommand *sbc)
+{
+ if (spec->varname)
+ dump (0, "long %s%s;", sbc->prefix, spec->varname);
+
+ {
+ setting *s;
+
+ for (s = spec->s; s; s = s->next)
+ {
+ if (s->value != VAL_NONE)
+ {
+ const char *typename;
+
+ assert (s->value == VAL_INT || s->value == VAL_DBL);
+ typename = s->value == VAL_INT ? "long" : "double";
+
+ dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
+ }
+ }
+ }
+}
+
+/* Returns 1 if string T is a PSPP keyword, 0 otherwise. */
+int
+is_keyword (const char *t)
+{
+ static const char *kw[] =
+ {
+ "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
+ "NE", "ALL", "BY", "TO", "WITH", 0,
+ };
+ const char **cp;
+
+ for (cp = kw; *cp; cp++)
+ if (!strcmp (t, *cp))
+ return 1;
+ return 0;
+}
+
+/* Transforms a string NAME into a valid C identifier: makes
+ everything lowercase and maps nonalphabetic characters to
+ underscores. Returns a pointer to a static buffer. */
+char *
+make_identifier (const char *name)
+{
+ char *p = get_buffer ();
+ char *cp;
+
+ for (cp = p; *name; name++)
+ if (isalpha ((unsigned char) *name))
+ *cp++ = tolower ((unsigned char) (*name));
+ else
+ *cp++ = '_';
+ *cp = '\0';
+
+ return p;
+}
+
+/* Writes the struct and enum declarations for the parser. */
+void
+dump_declarations (void)
+{
+ indent = 0;
+
+ /* Write out enums for all the identifiers in the symbol table. */
+ {
+ int f, k;
+ symbol *sym;
+ char *buf = NULL;
+
+ /* Note the squirmings necessary to make sure that the last enum
+ is not followed by a comma, as mandated by ANSI C89. */
+ for (sym = symtab, f = k = 0; sym; sym = sym->next)
+ if (!sym->unique && !is_keyword (sym->name))
+ {
+ if (!f)
+ {
+ dump (0, "/* Settings for subcommand specifiers. */");
+ dump (1, "enum");
+ dump (1, "{");
+ f = 1;
+ }
+
+ if (buf == NULL)
+ buf = xmalloc (1024);
+ else
+ dump (0, buf);
+
+ if (k)
+ sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
+ else
+ {
+ k = 1;
+ sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
+ }
+ }
+ if (buf)
+ {
+ buf[strlen (buf) - 1] = 0;
+ dump (0, buf);
+ free (buf);
+ }
+ if (f)
+ {
+ dump (-1, "};");
+ dump (-1, nullstr);
+ }
+ }
+
+ /* For every array subcommand, write out the associated enumerated
+ values. */
+ {
+ subcommand *sbc;
+
+ for (sbc = subcommands; sbc; sbc = sbc->next)
+ if (sbc->type == SBC_ARRAY && sbc->narray)
+ {
+ dump (0, "/* Array indices for %s subcommand. */", sbc->name);
+
+ dump (1, "enum");
+ dump (1, "{");
+
+ {
+ specifier *spec;
+
+ for (spec = sbc->spec; spec; spec = spec->next)
+ if (!spec->s)
+ dump (0, "%s%s%s = %d,",
+ st_upper (prefix), st_upper (sbc->prefix),
+ st_upper (spec->varname), spec->index);
+
+ dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
+
+ dump (-1, "};");
+ dump (-1, nullstr);
+ }
+ }
+ }
+
+ /* Write out structure declaration. */
+ {
+ subcommand *sbc;
+
+ dump (0, "/* %s structure. */", cmdname);
+ dump (1, "struct cmd_%s", make_identifier (cmdname));
+ dump (1, "{");
+ for (sbc = subcommands; sbc; sbc = sbc->next)
+ {
+ int f = 0;
+
+ if (sbc != subcommands)
+ dump (0, nullstr);
+
+ dump (0, "/* %s subcommand. */", sbc->name);
+ dump (0, "int sbc_%s;", st_lower (sbc->name));
+
+ switch (sbc->type)
+ {
+ case SBC_ARRAY:
+ case SBC_PLAIN:
+ {
+ specifier *spec;
+
+ for (spec = sbc->spec; spec; spec = spec->next)
+ {
+ if (spec->s == 0)
+ {
+ if (sbc->type == SBC_PLAIN)
+ dump (0, "long int %s%s;", st_lower (sbc->prefix),
+ spec->varname);
+ else if (f == 0)
+ {
+ dump (0, "int a_%s[%d];",
+ st_lower (sbc->name), sbc->narray);
+ f = 1;
+ }
+ }
+ else
+ dump_specifier_vars (spec, sbc);
+ }
+ }
+ break;
+
+ case SBC_VARLIST:
+ dump (0, "int %sn_%s;", st_lower (sbc->prefix),
+ st_lower (sbc->name));
+ dump (0, "struct variable **%sv_%s;", st_lower (sbc->prefix),
+ st_lower (sbc->name));
+ break;
+
+ case SBC_VAR:
+ dump (0, "struct variable *%sv_%s;", st_lower (sbc->prefix),
+ st_lower (sbc->name));
+ break;
+
+ case SBC_STRING:
+ dump (0, "char *s_%s;", st_lower (sbc->name));
+ break;
+
+ case SBC_INT:
+ case SBC_PINT:
+ dump (0, "long n_%s;", st_lower (sbc->name));
+ break;
+
+ default:
+ /* nothing */
+ }
+ }
+
+ dump (-1, "};");
+ dump (-1, nullstr);
+ }
+
+ /* Write out prototypes for custom_*() functions as necessary. */
+ {
+ int seen = 0;
+ subcommand *sbc;
+
+ for (sbc = subcommands; sbc; sbc = sbc->next)
+ if (sbc->type == SBC_CUSTOM)
+ {
+ if (!seen)
+ {
+ seen = 1;
+ dump (0, "/* Prototype for custom subcommands of %s. */",
+ cmdname);
+ }
+ dump (0, "static int %scustom_%s (struct cmd_%s *);",
+ st_lower (prefix), st_lower (sbc->name),
+ make_identifier (cmdname));
+ }
+
+ if (seen)
+ dump (0, nullstr);
+ }
+
+ /* Prototypes for parsing and freeing functions. */
+ {
+ dump (0, "/* Command parsing functions. */");
+ dump (0, "static int parse_%s (struct cmd_%s *);",
+ make_identifier (cmdname), make_identifier (cmdname));
+ dump (0, "static void free_%s (struct cmd_%s *);",
+ make_identifier (cmdname), make_identifier (cmdname));
+ dump (0, nullstr);
+ }
+}
+
+/* Writes out code to initialize all the variables that need
+ initialization for particular specifier SPEC inside subcommand SBC. */
+void
+dump_specifier_init (const specifier *spec, const subcommand *sbc)
+{
+ if (spec->varname)
+ {
+ char s[256];
+
+ if (spec->def)
+ sprintf (s, "%s%s",
+ st_upper (prefix), find_symbol (spec->def->con)->name);
+ else
+ strcpy (s, "-1");
+ dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
+ }
+
+ {
+ setting *s;
+
+ for (s = spec->s; s; s = s->next)
+ {
+ if (s->value != VAL_NONE)
+ {
+ const char *init;
+
+ assert (s->value == VAL_INT || s->value == VAL_DBL);
+ init = s->value == VAL_INT ? "NOT_LONG" : "SYSMIS";
+
+ dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
+ }
+ }
+ }
+}
+
+/* Write code to initialize all variables. */
+void
+dump_vars_init (void)
+{
+ /* Loop through all the subcommands. */
+ {
+ subcommand *sbc;
+
+ for (sbc = subcommands; sbc; sbc = sbc->next)
+ {
+ int f = 0;
+
+ dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
+ switch (sbc->type)
+ {
+ case SBC_DBL:
+ case SBC_INT_LIST:
+ case SBC_DBL_LIST:
+ case SBC_CUSTOM:
+ /* nothing */
+ break;
+
+ case SBC_PLAIN:
+ case SBC_ARRAY:
+ {
+ specifier *spec;
+
+ for (spec = sbc->spec; spec; spec = spec->next)
+ if (spec->s == NULL)
+ {
+ if (sbc->type == SBC_PLAIN)
+ dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
+ else if (f == 0)
+ {
+ dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
+ st_lower (sbc->name), st_lower (sbc->name));
+ f = 1;
+ }
+ }
+ else
+ dump_specifier_init (spec, sbc);
+ }
+ break;
+
+ case SBC_VARLIST:
+ dump (0, "p->%sn_%s = 0;",
+ st_lower (sbc->prefix), st_lower (sbc->name));
+ dump (0, "p->%sv_%s = NULL;",
+ st_lower (sbc->prefix), st_lower (sbc->name));
+ break;
+
+ case SBC_VAR:
+ dump (0, "p->%sv_%s = NULL;",
+ st_lower (sbc->prefix), st_lower (sbc->name));
+ break;
+
+ case SBC_STRING:
+ dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
+ break;
+
+ case SBC_INT:
+ case SBC_PINT:
+ dump (0, "p->n_%s = NOT_LONG;", st_lower (sbc->name));
+ break;
+
+ default:
+ assert (0);
+ }
+ }
+ }
+}
+
+/* Return a pointer to a static buffer containing an expression that
+ will match token T. */
+char *
+make_match (const char *t)
+{
+ char *s;
+
+ s = get_buffer ();
+
+ while (*t == '_')
+ t++;
+
+ if (is_keyword (t))
+ sprintf (s, "lex_match (T_%s)", t);
+ else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
+ strcpy (s, "(lex_match_id (\"ON\") || lex_match_id (\"YES\") "
+ "|| lex_match_id (\"TRUE\"))");
+ else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
+ strcpy (s, "(lex_match_id (\"OFF\") || lex_match_id (\"NO\") "
+ "|| lex_match_id (\"FALSE\"))");
+ else if (isdigit ((unsigned char) t[0]))
+ sprintf (s, "lex_match_int (%s)", t);
+ else
+ sprintf (s, "lex_match_id (\"%s\")", t);
+
+ return s;
+}
+
+/* Write out the parsing code for specifier SPEC within subcommand
+ SBC. */
+void
+dump_specifier_parse (const specifier *spec, const subcommand *sbc)
+{
+ setting *s;
+
+ if (spec->omit_kw && spec->omit_kw->next)
+ error ("Omittable setting is not last setting in `%s' specifier.",
+ spec->varname);
+ if (spec->omit_kw && spec->omit_kw->parent->next)
+ error ("Default specifier is not in last specifier in `%s' "
+ "subcommand.", sbc->name);
+
+ for (s = spec->s; s; s = s->next)
+ {
+ int first = spec == sbc->spec && s == spec->s;
+
+ /* Match the setting's keyword. */
+ if (spec->omit_kw == s)
+ {
+ if (!first)
+ {
+ dump (1, "else");
+ dump (1, "{");
+ }
+ dump (1, "%s;", make_match (s->specname));
+ }
+ else
+ dump (1, "%sif (%s)", first ? "" : "else ",
+ make_match (s->specname));
+
+ /* Handle values. */
+ if (s->value == VAL_NONE)
+ dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
+ st_upper (prefix), find_symbol (s->con)->name);
+ else
+ {
+ if (spec->omit_kw != s)
+ dump (1, "{");
+
+ if (spec->varname)
+ dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
+ st_upper (prefix), find_symbol (s->con)->name);
+
+ if (s->valtype == VT_PAREN)
+ {
+ if (s->optvalue)
+ {
+ dump (1, "if (lex_match ('('))");
+ dump (1, "{");
+ }
+ else
+ {
+ dump (1, "if (!lex_match ('('))");
+ dump (1, "{");
+ dump (0, "msg (SE, _(\"`(' expected after %s "
+ "specifier of %s subcommand.\"));",
+ s->specname, sbc->name);
+ dump (0, "goto lossage;");
+ dump (-1, "}");
+ outdent ();
+ }
+ }
+
+ if (s->value == VAL_INT)
+ {
+ dump (1, "if (!lex_integer_p ())");
+ dump (1, "{");
+ dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
+ "requires an integer argument.\"));",
+ s->specname, sbc->name);
+ dump (0, "goto lossage;");
+ dump (-1, "}");
+ dump (-1, "p->%s%s = lex_integer ();",
+ sbc->prefix, st_lower (s->valname));
+ }
+ else
+ {
+ dump (1, "if (token != T_NUM)");
+ dump (1, "{");
+ dump (0, "msg (SE, _(\"Number expected after %s "
+ "specifier of %s subcommand.\"));",
+ s->specname, sbc->name);
+ dump (0, "goto lossage;");
+ dump (-1, "}");
+ dump (-1, "p->%s%s = tokval;", sbc->prefix,
+ st_lower (s->valname));
+ }
+
+ if (s->restriction)
+ {
+ {
+ char *str, *str2;
+ str = xmalloc (MAX_TOK_LEN);
+ str2 = xmalloc (MAX_TOK_LEN);
+ sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
+ sprintf (str, s->restriction, str2, str2, str2, str2,
+ str2, str2, str2, str2);
+ dump (1, "if (!(%s))", str);
+ free (str);
+ free (str2);
+ }
+
+ dump (1, "{");
+ dump (0, "msg (SE, _(\"Bad argument for %s "
+ "specifier of %s subcommand.\"));",
+ s->specname, sbc->name);
+ dump (0, "goto lossage;");
+ dump (-1, "}");
+ outdent ();
+ }
+
+ dump (0, "lex_get ();");
+
+ if (s->valtype == VT_PAREN)
+ {
+ dump (1, "if (!lex_match (')'))");
+ dump (1, "{");
+ dump (0, "msg (SE, _(\"`)' expected after argument for "
+ "%s specifier of %s.\"));",
+ s->specname, sbc->name);
+ dump (0, "goto lossage;");
+ dump (-1, "}");
+ outdent ();
+ if (s->optvalue)
+ {
+ dump (-1, "}");
+ outdent ();
+ }
+ }
+
+ if (s != spec->omit_kw)
+ dump (-1, "}");
+ }
+
+ if (s == spec->omit_kw)
+ {
+ dump (-1, "}");
+ outdent ();
+ }
+ outdent ();
+ }
+}
+
+/* Write out the code to parse subcommand SBC. */
+void
+dump_subcommand (const subcommand *sbc)
+{
+ if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
+ {
+ int count;
+
+ dump (1, "while (token != '/' && token != '.')");
+ dump (1, "{");
+
+ {
+ specifier *spec;
+
+ for (count = 0, spec = sbc->spec; spec; spec = spec->next)
+ {
+ if (spec->s)
+ dump_specifier_parse (spec, sbc);
+ else
+ {
+ count++;
+ dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
+ make_match (st_upper (spec->varname)));
+ if (sbc->type == SBC_PLAIN)
+ dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
+ spec->varname);
+ else
+ dump (0, "p->a_%s[%s%s%s] = 1;",
+ st_lower (sbc->name),
+ st_upper (prefix), st_upper (sbc->prefix),
+ st_upper (spec->varname));
+ outdent ();
+ }
+ }
+ }
+
+ {
+ specifier *spec;
+ setting *s;
+
+ /* This code first finds the last specifier in sbc. Then it
+ finds the last setting within that last specifier. Either
+ or both might be NULL. */
+ spec = sbc->spec;
+ s = NULL;
+ if (spec)
+ {
+ while (spec->next)
+ spec = spec->next;
+ s = spec->s;
+ if (s)
+ while (s->next)
+ s = s->next;
+ }
+
+ if (spec && (!spec->s || !spec->omit_kw))
+ {
+ dump (1, "else");
+ dump (1, "{");
+ dump (0, "lex_error (NULL);");
+ dump (0, "goto lossage;");
+ dump (-1, "}");
+ outdent ();
+ }
+ }
+
+ dump (0, "lex_match (',');");
+ dump (-1, "}");
+ outdent ();
+ }
+ else if (sbc->type == SBC_VARLIST)
+ {
+ dump (1, "if (!parse_variables (NULL, &p->%sv_%s, &p->%sn_%s, "
+ "PV_APPEND%s%s))",
+ st_lower (sbc->prefix), st_lower (sbc->name),
+ st_lower (sbc->prefix), st_lower (sbc->name),
+ sbc->message ? " |" : "",
+ sbc->message ? sbc->message : "");
+ dump (0, "goto lossage;");
+ outdent ();
+ }
+ else if (sbc->type == SBC_VAR)
+ {
+ dump (0, "p->%sv_%s = parse_variable ();",
+ st_lower (sbc->prefix), st_lower (sbc->name));
+ dump (1, "if (p->%sv_%s)",
+ st_lower (sbc->prefix), st_lower (sbc->name));
+ dump (0, "goto lossage;");
+ outdent ();
+ }
+ else if (sbc->type == SBC_STRING)
+ {
+ if (sbc->restriction)
+ {
+ dump (1, "{");
+ dump (0, "int x;");
+ }
+ dump (1, "if (!lex_force_string ())");
+ dump (0, "return 0;");
+ outdent ();
+ if (sbc->restriction)
+ {
+ dump (0, "x = ds_length (&tokstr);");
+ dump (1, "if (!(%s))", sbc->restriction);
+ dump (1, "{");
+ dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
+ sbc->name, sbc->message);
+ dump (0, "goto lossage;");
+ dump (-1, "}");
+ outdent ();
+ }
+ dump (0, "p->s_%s = xstrdup (ds_value (&tokstr));",
+ st_lower (sbc->name));
+ dump (0, "lex_get ();");
+ if (sbc->restriction)
+ dump (-1, "}");
+ }
+ else if (sbc->type == SBC_INT)
+ {
+ dump (1, "if (!lex_force_int ())");
+ dump (0, "goto lossage;");
+ dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
+ }
+ else if (sbc->type == SBC_PINT)
+ {
+ dump (0, "lex_match ('(');");
+ dump (1, "if (!lex_force_int ())");
+ dump (0, "goto lossage;");
+ dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
+ dump (0, "lex_match (')');");
+ }
+ else if (sbc->type == SBC_CUSTOM)
+ {
+ dump (1, "switch (%scustom_%s (p))",
+ st_lower (prefix), st_lower (sbc->name));
+ dump (0, "{");
+ dump (1, "case 0:");
+ dump (0, "goto lossage;");
+ dump (-1, "case 1:");
+ indent ();
+ dump (0, "break;");
+ dump (-1, "case 2:");
+ indent ();
+ dump (0, "lex_error (NULL);");
+ dump (0, "goto lossage;");
+ dump (-1, "default:");
+ indent ();
+ dump (0, "assert (0);");
+ dump (-1, "}");
+ outdent ();
+ }
+}
+
+/* Write out entire parser. */
+void
+dump_parser (void)
+{
+ int f;
+
+ indent = 0;
+
+ dump (0, "static int");
+ dump (0, "parse_%s (struct cmd_%s *p)", make_identifier (cmdname),
+ make_identifier (cmdname));
+ dump (1, "{");
+
+ dump_vars_init ();
+
+ dump (1, "for (;;)");
+ dump (1, "{");
+
+ f = 0;
+ if (def && (def->type == SBC_VARLIST))
+ {
+ if (def->type == SBC_VARLIST)
+ dump (1, "if (token == T_ID && is_varname (tokid) && "
+ "lex_look_ahead () != '=')");
+ else
+ {
+ dump (0, "if ((token == T_ID && is_varname (tokid) && "
+ "lex_look_ahead () != '=')");
+ dump (1, " || token == T_ALL)");
+ }
+ dump (1, "{");
+ dump (0, "p->sbc_%s++;", st_lower (def->name));
+ dump (1, "if (!parse_variables (NULL, &p->%sv_%s, &p->%sn_%s, "
+ "PV_APPEND))",
+ st_lower (def->prefix), st_lower (def->name),
+ st_lower (def->prefix), st_lower (def->name));
+ dump (0, "goto lossage;");
+ dump (-2, "}");
+ outdent ();
+ f = 1;
+ }
+ else if (def && def->type == SBC_CUSTOM)
+ {
+ dump (1, "switch (%scustom_%s (p))",
+ st_lower (prefix), st_lower (def->name));
+ dump (0, "{");
+ dump (1, "case 0:");
+ dump (0, "goto lossage;");
+ dump (-1, "case 1:");
+ indent ();
+ dump (0, "p->sbc_%s++;", st_lower (def->name));
+ dump (0, "continue;");
+ dump (-1, "case 2:");
+ indent ();
+ dump (0, "break;");
+ dump (-1, "default:");
+ indent ();
+ dump (0, "assert (0);");
+ dump (-1, "}");
+ outdent ();
+ }
+
+ {
+ subcommand *sbc;
+
+ for (sbc = subcommands; sbc; sbc = sbc->next)
+ {
+ dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
+ f = 1;
+ dump (1, "{");
+
+ dump (0, "lex_match ('=');");
+ dump (0, "p->sbc_%s++;", st_lower (sbc->name));
+ if (sbc->once)
+ {
+ dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
+ dump (1, "{");
+ dump (0, "msg (SE, _(\"%s subcommand may be given only once.\"));",
+ sbc->name);
+ dump (0, "goto lossage;");
+ dump (-1, "}");
+ outdent ();
+ }
+ dump_subcommand (sbc);
+ dump (-1, "}");
+ outdent ();
+ }
+ }
+
+ dump (1, "if (!lex_match ('/'))");
+ dump (0, "break;");
+ dump (-2, "}");
+ outdent ();
+ dump (0, nullstr);
+ dump (1, "if (token != '.')");
+ dump (1, "{");
+ dump (0, "lex_error (_(\"expecting end of command\"));");
+ dump (0, "goto lossage;");
+ dump (-1, "}");
+ dump (0, nullstr);
+ dump (-1, "return 1;");
+ dump (0, nullstr);
+ dump (-1, "lossage:");
+ indent ();
+ dump (0, "free_%s (p);", make_identifier (cmdname));
+ dump (0, "return 0;");
+ dump (-1, "}");
+ dump (0, nullstr);
+}
+
+/* Write the output file header. */
+void
+dump_header (void)
+{
+ time_t curtime;
+ struct tm *loctime;
+ char *timep;
+
+ indent = 0;
+ curtime = time (NULL);
+ loctime = localtime (&curtime);
+ timep = asctime (loctime);
+ timep[strlen (timep) - 1] = 0;
+ dump (0, "/* %s", ofn);
+ dump (0, nullstr);
+ dump (0, " Generated by q2c from %s on %s.", ifn, timep);
+ dump (0, " Do not modify!");
+ dump (0, " */");
+ dump (0, nullstr);
+}
+
+/* Write out commands to free variable state. */
+void
+dump_free (void)
+{
+ subcommand *sbc;
+ int used;
+
+ indent = 0;
+
+ used = 0;
+ for (sbc = subcommands; sbc; sbc = sbc->next)
+ if (sbc->type == SBC_STRING)
+ used = 1;
+
+ dump (0, "static void");
+ dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
+ make_identifier (cmdname), used ? "" : " unused");
+ dump (1, "{");
+
+ for (sbc = subcommands; sbc; sbc = sbc->next)
+ if (sbc->type == SBC_STRING)
+ dump (0, "free (p->s_%s);", st_lower (sbc->name));
+
+ dump (-1, "}");
+}
+
+/* Returns the name of a directive found on the current input line, if
+ any, or a null pointer if none found. */
+const char *
+recognize_directive (void)
+{
+ static char directive[16];
+ char *sp, *ep;
+
+ sp = skip_ws (buf);
+ if (strncmp (sp, "/*", 2))
+ return NULL;
+ sp = skip_ws (sp + 2);
+ if (*sp != '(')
+ return NULL;
+ sp++;
+
+ ep = strchr (sp, ')');
+ if (ep == NULL)
+ return NULL;
+
+ if (ep - sp > 15)
+ ep = sp + 15;
+ memcpy (directive, sp, ep - sp);
+ directive[ep - sp] = '\0';
+ return directive;
+}
+
+int
+main (int argc, char *argv[])
+{
+ pgmname = argv[0];
+ if (argc != 3)
+ fail ("Syntax: q2c input.q output.c");
+
+ ifn = argv[1];
+ in = fopen (ifn, "r");
+ if (!in)
+ fail ("%s: open: %s.", ifn, strerror (errno));
+
+ ofn = argv[2];
+ out = fopen (ofn, "w");
+ if (!out)
+ fail ("%s: open: %s.", ofn, strerror (errno));
+
+ is_open = 1;
+ buf = xmalloc (MAX_LINE_LEN);
+ tokstr = xmalloc (MAX_TOK_LEN);
+
+ dump_header ();
+
+ indent = 0;
+ dump (0, "#line %d \"%s\"", ln + 1, ifn);
+ while (get_line ())
+ {
+ const char *directive = recognize_directive ();
+ if (directive == NULL)
+ {
+ dump (0, "%s", buf);
+ continue;
+ }
+
+ dump (0, "#line %d \"%s\"", oln - 1, ofn);
+ if (!strcmp (directive, "specification"))
+ {
+ /* Skip leading slash-star line. */
+ get_line ();
+ lex_get ();
+
+ parse ();
+
+ /* Skip trailing star-slash line. */
+ get_line ();
+ }
+ else if (!strcmp (directive, "headers"))
+ {
+ indent = 0;
+
+ dump (0, "#include <assert.h>");
+ dump (0, "#include <stdlib.h>");
+ dump (0, "#include \"alloc.h\"");
+ dump (0, "#include \"error.h\"");
+ dump (0, "#include \"lexer.h\"");
+ dump (0, "#include \"str.h\"");
+ dump (0, "#include \"var.h\"");
+ dump (0, nullstr);
+ }
+ else if (!strcmp (directive, "declarations"))
+ dump_declarations ();
+ else if (!strcmp (directive, "functions"))
+ {
+ dump_parser ();
+ dump_free ();
+ }
+ else
+ error ("unknown directive `%s'", directive);
+ indent = 0;
+ dump (0, "#line %d \"%s\"", ln + 1, ifn);
+ }
+
+ return EXIT_SUCCESS;
+}
+
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <math.h>
+#include <stdlib.h>
+#include <time.h>
+#include "magic.h"
+#include "random.h"
+#include "settings.h"
+
+/* Deal with broken system random number generator. */
+#if HAVE_GOOD_RANDOM
+#define real_rand rand
+#define real_srand srand
+#define REAL_RAND_MAX RAND_MAX
+#else /* !HAVE_GOOD_RANDOM */
+#define REAL_RAND_MAX 32767
+
+/* Some systems are so broken that they do not supply a value for
+ RAND_MAX. There is absolutely no reliable way to determine this
+ value, either. So we must supply our own. This one is the one
+ presented in the ANSI C standard as strictly compliant. */
+static unsigned long int next = 1;
+
+int
+real_rand (void)
+{
+ next = next * 1103515245 + 12345;
+ return (unsigned int)(next / 65536) % 32768;
+}
+
+void
+real_srand (unsigned int seed)
+{
+ next = seed;
+}
+#endif /* !HAVE_GOOD_RANDOM */
+
+/* The random number generator here is an implementation in C of
+ Knuth's Algorithm 3.2.2B (Randomizing by Shuffling) in _The Art of
+ Computer Programming_, Vol. 2. */
+
+#define k 13
+static int V[k];
+static int Y;
+
+static double X2;
+
+/* Initializes the random number generator. Should be called once by
+ every cmd_*() that uses random numbers. Note that this includes
+ all procedures that use expressions since they may generate random
+ numbers. */
+void
+setup_randomize (void)
+{
+ static time_t curtime;
+ int i;
+
+ if (set_seed == NOT_LONG)
+ {
+ if (!curtime)
+ time (&curtime);
+ real_srand (curtime++);
+ }
+ else
+ real_srand (set_seed);
+
+ set_seed_used = 1;
+
+ for (i = 0; i < k; i++)
+ V[i] = real_rand ();
+ Y = real_rand ();
+ X2 = NOT_DOUBLE;
+}
+
+/* Standard shuffling procedure for increasing randomness of the ANSI
+ C random number generator. Returns a random number R where 0 <= R
+ <= RAND_MAX. */
+inline int
+shuffle (void)
+{
+ int j = k * Y / RAND_MAX;
+ Y = V[j];
+ V[j] = real_rand ();
+ return Y;
+}
+
+/* Returns a random number R where 0 <= R <= X. */
+double
+rand_uniform (double x)
+{
+ return ((double) shuffle ()) / (((double) RAND_MAX) / x);
+}
+
+/* Returns a random number from the distribution with mean 0 and
+ standard deviation X. This uses algorithm P in section 3.4.1C of
+ Knuth's _Art of Computer Programming_, Vol 2. */
+double
+rand_normal (double x)
+{
+ double U1, U2;
+ double V1, V2;
+ double S;
+ double X1;
+
+ if (X2 != NOT_DOUBLE)
+ {
+ double t = X2;
+ X2 = NOT_DOUBLE;
+ return t * x;
+ }
+ do
+ {
+ U1 = ((double) shuffle ()) / RAND_MAX;
+ U2 = ((double) shuffle ()) / RAND_MAX;
+ V1 = 2 * U1 - 1;
+ V2 = 2 * U2 - 1;
+ S = V1 * V1 + V2 * V2;
+ }
+ while (S >= 1);
+ X1 = V1 * sqrt (-2. * log (S) / S);
+ X2 = V2 * sqrt (-2. * log (S) / S);
+ return X1 * x;
+}
+
+/* Returns a random integer R, where 0 <= R < X. */
+int
+rand_simple (int x)
+{
+ return shuffle () % x;
+}
+
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !random_h
+#define random_h 1
+
+void setup_randomize (void);
+double rand_uniform (double x);
+double rand_normal (double x);
+int rand_simple (int x);
+
+#endif /* random.h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <ctype.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "approx.h"
+#include "cases.h"
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "magic.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+\f
+/* Definitions. */
+
+enum
+ {
+ RCD_END, /* sentinel value */
+ RCD_USER, /* user-missing => one */
+ RCD_SINGLE, /* one => one */
+ RCD_HIGH, /* x > a => one */
+ RCD_LOW, /* x < b => one */
+ RCD_RANGE, /* b < x < a => one */
+ RCD_ELSE, /* any but SYSMIS => one */
+ RCD_CONVERT /* "123" => 123 */
+ };
+
+/* Describes how to recode a single value or range of values into a
+ single value. */
+struct coding
+ {
+ int type; /* RCD_* */
+ union value f1, f2; /* Describe value or range as src. Long
+ strings are stored in `c'. */
+ union value t; /* Describes value as dest. Long strings in `c'. */
+ };
+
+/* Describes how to recode a single variable. */
+struct rcd_var
+ {
+ struct rcd_var *next;
+
+ unsigned flags; /* RCD_SRC_* | RCD_DEST_* | RCD_MISC_* */
+
+ struct variable *src; /* Source variable. */
+ struct variable *dest; /* Destination variable. */
+ char dest_name[9]; /* Name of dest variable if we're creating it. */
+
+ int has_sysmis; /* Do we recode for SYSMIS? */
+ union value sysmis; /* Coding for SYSMIS (if src is numeric). */
+
+ struct coding *map; /* Coding for other values. */
+ int nmap, mmap; /* Length of map, max capacity of map. */
+ };
+
+/* RECODE transformation. */
+struct recode_trns
+ {
+ struct trns_header h;
+ struct rcd_var *codings;
+ };
+
+/* What we're recoding from (`src'==`source'). */
+#define RCD_SRC_ERROR 0000u /* Bad value for src. */
+#define RCD_SRC_NUMERIC 0001u /* Src is numeric. */
+#define RCD_SRC_STRING 0002u /* Src is short string. */
+#define RCD_SRC_MASK 0003u /* AND mask to isolate src bits. */
+
+/* What we're recoding to (`dest'==`destination'). */
+#define RCD_DEST_ERROR 0000u /* Bad value for dest. */
+#define RCD_DEST_NUMERIC 0004u /* Dest is numeric. */
+#define RCD_DEST_STRING 0010u /* Dest is short string. */
+#define RCD_DEST_MASK 0014u /* AND mask to isolate dest bits. */
+
+/* Miscellaneous bits. */
+#define RCD_MISC_CREATE 0020u /* We create dest var (numeric only) */
+#define RCD_MISC_DUPLICATE 0040u /* This var_info has the same MAP
+ value as the previous var_info.
+ Prevents redundant free()ing. */
+#define RCD_MISC_MISSING 0100u /* Encountered MISSING or SYSMIS in
+ this input spec. */
+
+static int parse_dest_spec (struct rcd_var * rcd, union value *v,
+ size_t *max_dst_width);
+static int parse_src_spec (struct rcd_var * rcd, int type, size_t max_src_width);
+static int recode_trns_proc (struct trns_header *, struct ccase *);
+static void recode_trns_free (struct trns_header *);
+static double convert_to_double (char *, int);
+
+#if DEBUGGING
+static void debug_print (rcd_var * head);
+#endif
+\f
+/* Parser. */
+
+/* First transformation in the list. rcd is in this list. */
+static struct rcd_var *head;
+
+/* Variables in the current part of the recoding. */
+struct variable **v;
+int nv;
+
+/* Parses the RECODE transformation. */
+int
+cmd_recode (void)
+{
+ int i;
+
+ /* Transformation that we're constructing. */
+ struct rcd_var *rcd;
+
+ /* Type of the src variables. */
+ int type;
+
+ /* Length of longest src string. */
+ size_t max_src_width;
+
+ /* Length of longest dest string. */
+ size_t max_dst_width;
+
+ /* For stepping through, constructing the linked list of
+ recodings. */
+ struct rcd_var *iter;
+
+ /* The real transformation, just a wrapper for a list of
+ rcd_var's. */
+ struct recode_trns *trns;
+
+ lex_match_id ("RECODE");
+
+ /* Parses each specification between slashes. */
+ head = rcd = xmalloc (sizeof *rcd);
+ for (;;)
+ {
+ /* Whether we've already encountered a specification for SYSMIS. */
+ int had_sysmis = 0;
+
+ /* Initialize this rcd_var to ensure proper cleanup. */
+ rcd->next = NULL;
+ rcd->map = NULL;
+ rcd->nmap = rcd->mmap = 0;
+ rcd->has_sysmis = 0;
+ rcd->sysmis.f = 0;
+
+ /* Parse variable names. */
+ if (!parse_variables (NULL, &v, &nv, PV_SAME_TYPE))
+ goto lossage;
+
+ /* Ensure all variables are same type; find length of longest
+ source variable. */
+ type = v[0]->type;
+ max_src_width = v[0]->width;
+
+ if (type == ALPHA)
+ for (i = 0; i < nv; i++)
+ if (v[i]->width > (int) max_src_width)
+ max_src_width = v[i]->width;
+
+ /* Set up flags. */
+ rcd->flags = 0;
+ if (type == NUMERIC)
+ rcd->flags |= RCD_SRC_NUMERIC;
+ else
+ rcd->flags |= RCD_SRC_STRING;
+
+ /* Parse each coding in parentheses. */
+ max_dst_width = 0;
+ if (!lex_force_match ('('))
+ goto lossage;
+ for (;;)
+ {
+ /* Get the input value (before the `='). */
+ int mark = rcd->nmap;
+ int code = parse_src_spec (rcd, type, max_src_width);
+ if (!code)
+ goto lossage;
+
+ /* ELSE is the same as any other input spec except that it
+ precludes later sysmis specifications. */
+ if (code == 3)
+ {
+ had_sysmis = 1;
+ code = 1;
+ }
+
+ /* If keyword CONVERT was specified, there is no output
+ specification. */
+ if (code == 1)
+ {
+ union value output;
+
+ /* Get the output value (after the `='). */
+ lex_get (); /* Skip `='. */
+ if (!parse_dest_spec (rcd, &output, &max_dst_width))
+ goto lossage;
+
+ /* Set the value for SYSMIS if requested and if we don't
+ already have one. */
+ if ((rcd->flags & RCD_MISC_MISSING) && !had_sysmis)
+ {
+ rcd->has_sysmis = 1;
+ if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
+ rcd->sysmis.f = output.f;
+ else
+ rcd->sysmis.c = xstrdup (output.c);
+ had_sysmis = 1;
+
+ rcd->flags &= ~RCD_MISC_MISSING;
+ }
+
+ /* Since there may be multiple input values for a single
+ output, the output value need to propagated among all
+ of them. */
+ if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
+ for (i = mark; i < rcd->nmap; i++)
+ rcd->map[i].t.f = output.f;
+ else
+ {
+ for (i = mark; i < rcd->nmap; i++)
+ rcd->map[i].t.c = xstrdup (output.c);
+ free (output.c);
+ }
+ }
+ lex_get (); /* Skip `)'. */
+ if (!lex_match ('('))
+ break;
+ }
+
+ /* Append sentinel value. */
+ rcd->map[rcd->nmap++].type = RCD_END;
+
+ /* Since multiple variables may use the same recodings, it is
+ necessary to propogate the codings to all of them. */
+ rcd->src = v[0];
+ rcd->dest = v[0];
+ rcd->dest_name[0] = 0;
+ iter = rcd;
+ for (i = 1; i < nv; i++)
+ {
+ iter = iter->next = xmalloc (sizeof *iter);
+ iter->next = NULL;
+ iter->flags = rcd->flags | RCD_MISC_DUPLICATE;
+ iter->src = v[i];
+ iter->dest = v[i];
+ iter->dest_name[0] = 0;
+ iter->has_sysmis = rcd->has_sysmis;
+ iter->sysmis = rcd->sysmis;
+ iter->map = rcd->map;
+ }
+
+ if (lex_match_id ("INTO"))
+ {
+ char **names;
+ int nnames;
+
+ int success = 0;
+
+ if (!parse_mixed_vars (&names, &nnames, PV_NONE))
+ goto lossage;
+
+ if (nnames != nv)
+ {
+ for (i = 0; i < nnames; i++)
+ free (names[i]);
+ free (names);
+ msg (SE, _("%d variable(s) cannot be recoded into "
+ "%d variable(s). Specify the same number "
+ "of variables as input and output variables."),
+ nv, nnames);
+ goto lossage;
+ }
+
+ if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING)
+ for (i = 0, iter = rcd; i < nv; i++, iter = iter->next)
+ {
+ struct variable *v = find_variable (names[i]);
+
+ if (!v)
+ {
+ msg (SE, _("There is no string variable named "
+ "%s. (All string variables specified "
+ "on INTO must already exist. Use the "
+ "STRING command to create a string "
+ "variable.)"), names[i]);
+ goto INTO_fail;
+ }
+ if (v->type != ALPHA)
+ {
+ msg (SE, _("Type mismatch between input and output "
+ "variables. Output variable %s is not "
+ "a string variable, but all the input "
+ "variables are string variables."), v->name);
+ goto INTO_fail;
+ }
+ if (v->width > (int) max_dst_width)
+ max_dst_width = v->width;
+ iter->dest = v;
+ }
+ else
+ for (i = 0, iter = rcd; i < nv; i++, iter = iter->next)
+ {
+ struct variable *v = find_variable (names[i]);
+
+ if (v)
+ {
+ if (v->type != NUMERIC)
+ {
+ msg (SE, _("Type mismatch after INTO: %s "
+ "is not a numeric variable."), v->name);
+ goto INTO_fail;
+ }
+ else
+ iter->dest = v;
+ }
+ else
+ strcpy (iter->dest_name, names[i]);
+ }
+ success = 1;
+
+ /* Note that regardless of whether we succeed or fail,
+ flow-of-control comes here. `success' is the important
+ factor. Ah, if C had garbage collection... */
+ INTO_fail:
+ for (i = 0; i < nnames; i++)
+ free (names[i]);
+ free (names);
+ if (!success)
+ goto lossage;
+ }
+ else
+ {
+ if (max_src_width > max_dst_width)
+ max_dst_width = max_src_width;
+
+ if ((rcd->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC
+ && (rcd->flags & RCD_DEST_MASK) != RCD_DEST_NUMERIC)
+ {
+ msg (SE, _("INTO must be used when the input values are "
+ "numeric and output values are string."));
+ goto lossage;
+ }
+
+ if ((rcd->flags & RCD_SRC_MASK) != RCD_SRC_NUMERIC
+ && (rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
+ {
+ msg (SE, _("INTO must be used when the input values are "
+ "string and output values are numeric."));
+ goto lossage;
+ }
+ }
+
+ if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING)
+ {
+ struct coding *cp;
+
+ for (cp = rcd->map; cp->type != RCD_END; cp++)
+ if (cp->t.c)
+ {
+ if (strlen (cp->t.c) < max_dst_width)
+ {
+ /* The NULL is only really necessary for the
+ debugging code. */
+ char *repl = xmalloc (max_dst_width + 1);
+ st_pad_copy (repl, cp->t.c, max_dst_width + 1);
+ free (cp->t.c);
+ cp->t.c = repl;
+ }
+ else
+ /* The strings are guaranteed to be in order of
+ nondecreasing length. */
+ break;
+ }
+
+ }
+
+ if (!lex_match ('/'))
+ break;
+ while (rcd->next)
+ rcd = rcd->next;
+ rcd = rcd->next = xmalloc (sizeof *rcd);
+
+ free (v);
+ }
+
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ goto lossage;
+ }
+
+ for (rcd = head; rcd; rcd = rcd->next)
+ if (rcd->dest_name[0])
+ {
+ rcd->dest = create_variable (&default_dict, rcd->dest_name,
+ NUMERIC, 0);
+ if (!rcd->dest)
+ {
+ /* This can occur if a destname is duplicated. We could
+ give an error at parse time but I don't care enough. */
+ rcd->dest = find_variable (rcd->dest_name);
+ assert (rcd->dest != NULL);
+ }
+ else
+ envector (rcd->dest);
+ }
+
+ trns = xmalloc (sizeof *trns);
+ trns->h.proc = recode_trns_proc;
+ trns->h.free = recode_trns_free;
+ trns->codings = head;
+ add_transformation ((struct trns_header *) trns);
+
+#if DEBUGGING
+ debug_print (head);
+#endif
+
+ return CMD_SUCCESS;
+
+ lossage:
+ {
+ struct recode_trns t;
+
+ t.codings = head;
+ recode_trns_free ((struct trns_header *) &t);
+ return CMD_FAILURE;
+ }
+}
+
+static int
+parse_dest_spec (struct rcd_var * rcd, union value * v, size_t *max_dst_width)
+{
+ int flags;
+
+ v->c = NULL;
+
+ if (token == T_NUM)
+ {
+ v->f = tokval;
+ lex_get ();
+ flags = RCD_DEST_NUMERIC;
+ }
+ else if (lex_match_id ("SYSMIS"))
+ {
+ v->f = SYSMIS;
+ flags = RCD_DEST_NUMERIC;
+ }
+ else if (token == T_STRING)
+ {
+ size_t max = *max_dst_width;
+ size_t toklen = ds_length (&tokstr);
+ if (toklen > max)
+ max = toklen;
+ v->c = xmalloc (max + 1);
+ st_pad_copy (v->c, ds_value (&tokstr), max + 1);
+ flags = RCD_DEST_STRING;
+ *max_dst_width = max;
+ lex_get ();
+ }
+ else if (lex_match_id ("COPY"))
+ {
+ if ((rcd->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC)
+ {
+ flags = RCD_DEST_NUMERIC;
+ v->f = -SYSMIS;
+ }
+ else
+ {
+ flags = RCD_DEST_STRING;
+ v->c = NULL;
+ }
+ }
+
+ if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_ERROR)
+ rcd->flags |= flags;
+#if 0
+ else if (((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC
+ && flags != RCD_DEST_NUMERIC)
+ || ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING
+ && flags != RCD_DEST_STRING))
+#endif
+ else if ((rcd->flags & RCD_DEST_MASK) ^ flags)
+ {
+ msg (SE, _("Inconsistent output types. The output values "
+ "must be all numeric or all string."));
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Reads a set of source specifications and returns one of the
+ following values: 0 on failure; 1 for normal success; 2 for success
+ but with CONVERT as the keyword; 3 for success but with ELSE as the
+ keyword. */
+static int
+parse_src_spec (struct rcd_var * rcd, int type, size_t max_src_width)
+{
+ struct coding *c;
+
+ for (;;)
+ {
+ if (rcd->nmap >= rcd->mmap - 1)
+ {
+ rcd->mmap += 16;
+ rcd->map = xrealloc (rcd->map, rcd->mmap * sizeof *rcd->map);
+ }
+
+ c = &rcd->map[rcd->nmap];
+ c->f1.c = c->f2.c = NULL;
+ if (lex_match_id ("ELSE"))
+ {
+ c->type = RCD_ELSE;
+ rcd->nmap++;
+ return 3;
+ }
+ else if (type == NUMERIC)
+ {
+ if (token == T_ID)
+ {
+ if (lex_match_id ("LO") || lex_match_id ("LOWEST"))
+ {
+ if (!lex_force_match_id ("THRU"))
+ return 0;
+ if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
+ c->type = RCD_ELSE;
+ else if (token == T_NUM)
+ {
+ c->type = RCD_LOW;
+ c->f1.f = tokval;
+ lex_get ();
+ }
+ else
+ {
+ lex_error (_("following LO THRU"));
+ return 0;
+ }
+ }
+ else if (lex_match_id ("MISSING"))
+ {
+ c->type = RCD_USER;
+ rcd->flags |= RCD_MISC_MISSING;
+ }
+ else if (lex_match_id ("SYSMIS"))
+ {
+ c->type = RCD_END;
+ rcd->flags |= RCD_MISC_MISSING;
+ }
+ else
+ {
+ lex_error (_("in source value"));
+ return 0;
+ }
+ }
+ else if (token == T_NUM)
+ {
+ c->f1.f = tokval;
+ lex_get ();
+ if (lex_match_id ("THRU"))
+ {
+ if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
+ c->type = RCD_HIGH;
+ else if (token == T_NUM)
+ {
+ c->type = RCD_RANGE;
+ c->f2.f = tokval;
+ lex_get ();
+ }
+ else
+ {
+ lex_error (NULL);
+ return 0;
+ }
+ }
+ else
+ c->type = RCD_SINGLE;
+ }
+ else
+ {
+ lex_error (_("in source value"));
+ return 0;
+ }
+ }
+ else
+ {
+ assert (type == ALPHA);
+ if (lex_match_id ("CONVERT"))
+ {
+ if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_ERROR)
+ rcd->flags |= RCD_DEST_NUMERIC;
+ else if ((rcd->flags & RCD_DEST_MASK) != RCD_DEST_NUMERIC)
+ {
+ msg (SE, _("Keyword CONVERT may only be used with "
+ "string input values and numeric output "
+ "values."));
+ return 0;
+ }
+
+ c->type = RCD_CONVERT;
+ rcd->nmap++;
+ return 2;
+ }
+ else
+ {
+ /* Only the debugging code needs the NULLs at the ends
+ of the strings. However, changing code behavior more
+ than necessary based on the DEBUGGING `#define' is just
+ *inviting* bugs. */
+ c->type = RCD_SINGLE;
+ if (!lex_force_string ())
+ return 0;
+ c->f1.c = xmalloc (max_src_width + 1);
+ st_pad_copy (c->f1.c, ds_value (&tokstr), max_src_width + 1);
+ lex_get ();
+ }
+ }
+
+ if (c->type != RCD_END)
+ rcd->nmap++;
+
+ lex_match (',');
+ if (token == '=')
+ break;
+ }
+ return 1;
+}
+\f
+/* Data transformation. */
+
+static void
+recode_trns_free (struct trns_header * t)
+{
+ int i;
+ struct rcd_var *head, *next;
+
+ head = ((struct recode_trns *) t)->codings;
+ while (head)
+ {
+ if (head->map && !(head->flags & RCD_MISC_DUPLICATE))
+ {
+ if (head->flags & RCD_SRC_STRING)
+ for (i = 0; i < head->nmap; i++)
+ switch (head->map[i].type)
+ {
+ case RCD_RANGE:
+ free (head->map[i].f2.c);
+ /* fall through */
+ case RCD_USER:
+ case RCD_SINGLE:
+ case RCD_HIGH:
+ case RCD_LOW:
+ free (head->map[i].f1.c);
+ break;
+ case RCD_END:
+ case RCD_ELSE:
+ case RCD_CONVERT:
+ break;
+ default:
+ assert (0);
+ }
+ if (head->flags & RCD_DEST_STRING)
+ for (i = 0; i < head->nmap; i++)
+ if (head->map[i].type != RCD_CONVERT && head->map[i].type != RCD_END)
+ free (head->map[i].t.c);
+ free (head->map);
+ }
+ next = head->next;
+ free (head);
+ head = next;
+ }
+}
+
+static inline struct coding *
+find_src_numeric (struct rcd_var * v, struct ccase * c)
+{
+ double cmp = c->data[v->src->fv].f;
+ struct coding *cp;
+
+ if (cmp == SYSMIS)
+ {
+ if (v->sysmis.f != -SYSMIS)
+ {
+ if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
+ c->data[v->dest->fv].f = v->sysmis.f;
+ else
+ memcpy (c->data[v->dest->fv].s, v->sysmis.c,
+ v->dest->width);
+ }
+ return NULL;
+ }
+
+ for (cp = v->map;; cp++)
+ switch (cp->type)
+ {
+ case RCD_END:
+ return NULL;
+ case RCD_USER:
+ if (is_num_user_missing (cmp, v->src))
+ return cp;
+ break;
+ case RCD_SINGLE:
+ if (approx_eq (cmp, cp->f1.f))
+ return cp;
+ break;
+ case RCD_HIGH:
+ if (approx_ge (cmp, cp->f1.f))
+ return cp;
+ break;
+ case RCD_LOW:
+ if (approx_le (cmp, cp->f1.f))
+ return cp;
+ break;
+ case RCD_RANGE:
+ if (approx_in_range (cmp, cp->f1.f, cp->f2.f))
+ return cp;
+ break;
+ case RCD_ELSE:
+ return cp;
+ default:
+ assert (0);
+ }
+}
+
+static inline struct coding *
+find_src_string (struct rcd_var * v, struct ccase * c)
+{
+ char *cmp = c->data[v->src->fv].s;
+ int w = v->src->width;
+ struct coding *cp;
+
+ for (cp = v->map;; cp++)
+ switch (cp->type)
+ {
+ case RCD_END:
+ return NULL;
+ case RCD_SINGLE:
+ if (!memcmp (cp->f1.c, cmp, w))
+ return cp;
+ break;
+ case RCD_ELSE:
+ return cp;
+ case RCD_CONVERT:
+ {
+ double f = convert_to_double (cmp, w);
+ if (f != -SYSMIS)
+ {
+ c->data[v->dest->fv].f = f;
+ return NULL;
+ }
+ break;
+ }
+ default:
+ assert (0);
+ }
+}
+
+static int
+recode_trns_proc (struct trns_header * t, struct ccase * c)
+{
+ struct rcd_var *v;
+ struct coding *cp;
+
+ for (v = ((struct recode_trns *) t)->codings; v; v = v->next)
+ {
+ switch (v->flags & RCD_SRC_MASK)
+ {
+ case RCD_SRC_NUMERIC:
+ cp = find_src_numeric (v, c);
+ break;
+ case RCD_SRC_STRING:
+ cp = find_src_string (v, c);
+ break;
+ }
+ if (!cp)
+ continue;
+
+ /* A matching input value was found. */
+ if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
+ {
+ double val = cp->t.f;
+ if (val == -SYSMIS)
+ c->data[v->dest->fv].f = c->data[v->src->fv].f;
+ else
+ c->data[v->dest->fv].f = val;
+ }
+ else
+ {
+ char *val = cp->t.c;
+ if (val == NULL)
+ st_bare_pad_len_copy (c->data[v->dest->fv].s,
+ c->data[v->src->fv].c,
+ v->dest->width, v->src->width);
+ else
+ memcpy (c->data[v->dest->fv].s, cp->t.c, v->dest->width);
+ }
+ }
+
+ return -1;
+}
+\f
+/* Debug output. */
+
+#if DEBUGGING
+static void
+dump_dest (struct rcd_var * v, union value * c)
+{
+ if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
+ if (c->f == SYSMIS)
+ printf ("=SYSMIS");
+ else if (c->f == -SYSMIS)
+ printf ("=COPY");
+ else
+ printf ("=%g", c->f);
+ else if (c->c)
+ printf ("=\"%s\"", c->c);
+ else
+ printf ("=COPY");
+}
+
+static void
+debug_print (struct rcd_var * head)
+{
+ struct rcd_var *iter, *start;
+ struct coding *c;
+
+ printf ("RECODE\n");
+ for (iter = head; iter; iter = iter->next)
+ {
+ start = iter;
+ printf (" %s%s", iter == head ? "" : "/", iter->src->name);
+ while (iter->next && (iter->next->flags & RCD_MISC_DUPLICATE))
+ {
+ iter = iter->next;
+ printf (" %s", iter->src->name);
+ }
+ if (iter->has_sysmis)
+ {
+ printf ("(SYSMIS");
+ dump_dest (iter, &iter->sysmis);
+ printf (")");
+ }
+ for (c = iter->map; c->type != RCD_END; c++)
+ {
+ printf ("(");
+ if ((iter->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC)
+ switch (c->type)
+ {
+ case RCD_END:
+ printf (_("!!END!!"));
+ break;
+ case RCD_USER:
+ printf ("MISSING");
+ break;
+ case RCD_SINGLE:
+ printf ("%g", c->f1.f);
+ break;
+ case RCD_HIGH:
+ printf ("%g THRU HIGH", c->f1.f);
+ break;
+ case RCD_LOW:
+ printf ("LOW THRU %g", c->f1.f);
+ break;
+ case RCD_RANGE:
+ printf ("%g THRU %g", c->f1.f, c->f2.f);
+ break;
+ case RCD_ELSE:
+ printf ("ELSE");
+ break;
+ default:
+ printf (_("!!ERROR!!"));
+ break;
+ }
+ else
+ switch (c->type)
+ {
+ case RCD_SINGLE:
+ printf ("\"%s\"", c->f1.c);
+ break;
+ case RCD_ELSE:
+ printf ("ELSE");
+ break;
+ case RCD_CONVERT:
+ printf ("CONVERT");
+ break;
+ default:
+ printf (_("!!ERROR!!"));
+ break;
+ }
+ if (c->type != RCD_CONVERT)
+ dump_dest (iter, &c->t);
+ printf (")");
+ }
+ printf ("\n INTO");
+ for (;;)
+ {
+ printf (" %s",
+ start->dest_name[0] ? start->dest_name : start->dest->name);
+ if (start == iter)
+ break;
+ start = start->next;
+ }
+ printf ("\n");
+ }
+}
+#endif
+
+/* Convert NPTR to a `long int' in base 10. Returns the long int on
+ success, NOT_LONG on failure. On success stores a pointer to the
+ first character after the number into *ENDPTR. From the GNU C
+ library. */
+long int
+string_to_long (char *nptr, int width, char **endptr)
+{
+ int negative;
+ register unsigned long int cutoff;
+ register unsigned int cutlim;
+ register unsigned long int i;
+ register char *s;
+ register unsigned char c;
+ const char *save;
+
+ s = nptr;
+
+ /* Check for a sign. */
+ if (*s == '-')
+ {
+ negative = 1;
+ ++s;
+ }
+ else if (*s == '+')
+ {
+ negative = 0;
+ ++s;
+ }
+ else
+ negative = 0;
+ if (s >= nptr + width)
+ return NOT_LONG;
+
+ /* Save the pointer so we can check later if anything happened. */
+ save = s;
+
+ cutoff = ULONG_MAX / 10ul;
+ cutlim = ULONG_MAX % 10ul;
+
+ i = 0;
+ for (c = *s;;)
+ {
+ if (isdigit ((unsigned char) c))
+ c -= '0';
+ else
+ break;
+ /* Check for overflow. */
+ if (i > cutoff || (i == cutoff && c > cutlim))
+ return NOT_LONG;
+ else
+ i = i * 10ul + c;
+
+ s++;
+ if (s >= nptr + width)
+ break;
+ c = *s;
+ }
+
+ /* Check if anything actually happened. */
+ if (s == save)
+ return NOT_LONG;
+
+ /* Check for a value that is within the range of `unsigned long
+ int', but outside the range of `long int'. We limit LONG_MIN and
+ LONG_MAX by one point because we know that NOT_LONG is out there
+ somewhere. */
+ if (i > (negative
+ ? -((unsigned long int) LONG_MIN) - 1
+ : ((unsigned long int) LONG_MAX) - 1))
+ return NOT_LONG;
+
+ *endptr = s;
+
+ /* Return the result of the appropriate sign. */
+ return (negative ? -i : i);
+}
+
+/* Converts S to a double according to format Fx.0. Returns the value
+ found, or -SYSMIS if there was no valid number in s. WIDTH is the
+ length of string S. From the GNU C library. */
+static double
+convert_to_double (char *s, int width)
+{
+ register const char *end = &s[width];
+
+ short int sign;
+
+ /* The number so far. */
+ double num;
+
+ int got_dot; /* Found a decimal point. */
+ int got_digit; /* Count of digits. */
+
+ /* The exponent of the number. */
+ long int exponent;
+
+ /* Eat whitespace. */
+ while (s < end && isspace ((unsigned char) *s))
+ ++s;
+ if (s >= end)
+ return SYSMIS;
+
+ /* Get the sign. */
+ sign = *s == '-' ? -1 : 1;
+ if (*s == '-' || *s == '+')
+ {
+ ++s;
+ if (s >= end)
+ return -SYSMIS;
+ }
+
+ num = 0.0;
+ got_dot = 0;
+ got_digit = 0;
+ exponent = 0;
+ for (; s < end; ++s)
+ {
+ if (isdigit ((unsigned char) *s))
+ {
+ got_digit++;
+
+ /* Make sure that multiplication by 10 will not overflow. */
+ if (num > DBL_MAX * 0.1)
+ /* The value of the digit doesn't matter, since we have already
+ gotten as many digits as can be represented in a `double'.
+ This doesn't necessarily mean the result will overflow.
+ The exponent may reduce it to within range.
+
+ We just need to record that there was another
+ digit so that we can multiply by 10 later. */
+ ++exponent;
+ else
+ num = (num * 10.0) + (*s - '0');
+
+ /* Keep track of the number of digits after the decimal point.
+ If we just divided by 10 here, we would lose precision. */
+ if (got_dot)
+ --exponent;
+ }
+ else if (!got_dot && *s == '.')
+ /* Record that we have found the decimal point. */
+ got_dot = 1;
+ else
+ break;
+ }
+
+ if (!got_digit)
+ return -SYSMIS;
+
+ if (s < end && (tolower ((unsigned char) (*s)) == 'e'
+ || tolower ((unsigned char) (*s)) == 'd'))
+ {
+ /* Get the exponent specified after the `e' or `E'. */
+ long int exp;
+
+ s++;
+ if (s >= end)
+ return -SYSMIS;
+
+ exp = string_to_long (s, end - s, &s);
+ if (exp == NOT_LONG || end == s)
+ return -SYSMIS;
+ exponent += exp;
+ }
+
+ while (s < end && isspace ((unsigned char) *s))
+ s++;
+ if (s < end)
+ return -SYSMIS;
+
+ if (num == 0.0)
+ return 0.0;
+
+ /* Multiply NUM by 10 to the EXPONENT power,
+ checking for overflow and underflow. */
+
+ if (exponent < 0)
+ {
+ if (-exponent + got_digit > -(DBL_MIN_10_EXP) + 5
+ || num < DBL_MIN * pow (10.0, (double) -exponent))
+ return -SYSMIS;
+ num *= pow (10.0, (double) exponent);
+ }
+ else if (exponent > 0)
+ {
+ if (num > DBL_MAX * pow (10.0, (double) -exponent))
+ return -SYSMIS;
+ num *= pow (10.0, (double) exponent);
+ }
+
+ return sign > 0 ? num : -num;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <stdlib.h>
+#include <assert.h>
+#include "alloc.h"
+#include "avl.h"
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "str.h"
+#include "var.h"
+
+/* FIXME: should change weighting variable, etc. */
+static int compare_name (const void *, const void *);
+
+/* The code for this function is very similar to the code for the
+ RENAME subcommand of MODIFY VARS. */
+int
+cmd_rename_variables (void)
+{
+ char (*names)[8] = NULL;
+
+ struct variable **old_names = NULL;
+ char **new_names = NULL;
+ int n_rename = 0;
+
+ struct variable *head, *tail, *iter;
+
+ int i;
+
+ lex_match_id ("RENAME");
+ lex_match_id ("VARIABLES");
+
+ do
+ {
+ int prev_nv_1 = n_rename;
+ int prev_nv_2 = n_rename;
+
+ if (!lex_match ('('))
+ {
+ msg (SE, _("`(' expected."));
+ goto lossage;
+ }
+ if (!parse_variables (&default_dict, &old_names, &n_rename,
+ PV_APPEND | PV_NO_DUPLICATE))
+ goto lossage;
+ if (!lex_match ('='))
+ {
+ msg (SE, _("`=' expected between lists of new and old variable names."));
+ goto lossage;
+ }
+ if (!parse_DATA_LIST_vars (&new_names, &prev_nv_1, PV_APPEND))
+ goto lossage;
+ if (prev_nv_1 != n_rename)
+ {
+ msg (SE, _("Differing number of variables in old name list "
+ "(%d) and in new name list (%d)."),
+ n_rename - prev_nv_2, prev_nv_1 - prev_nv_2);
+ for (i = 0; i < prev_nv_1; i++)
+ free (new_names[i]);
+ free (new_names);
+ new_names = NULL;
+ goto lossage;
+ }
+ if (!lex_match (')'))
+ {
+ msg (SE, _("`)' expected after variable names."));
+ goto lossage;
+ }
+ }
+ while (token != '.');
+
+ /* Form a linked list of the variables to be renamed; also, set
+ their p.mfv.new_name members. */
+ head = NULL;
+ for (i = 0; i < n_rename; i++)
+ {
+ strcpy (old_names[i]->p.mfv.new_name, new_names[i]);
+ free (new_names[i]);
+ if (head != NULL)
+ tail = tail->p.mfv.next = old_names[i];
+ else
+ head = tail = old_names[i];
+ }
+ tail->p.mfv.next = NULL;
+ free (new_names);
+ free (old_names);
+ new_names = NULL;
+ old_names = NULL;
+
+ /* Construct a vector of all variables' new names. */
+ names = xmalloc (8 * default_dict.nvar);
+ for (i = 0; i < default_dict.nvar; i++)
+ strncpy (names[i], default_dict.var[i]->name, 8);
+ for (iter = head; iter; iter = iter->p.mfv.next)
+ strncpy (names[iter->index], iter->p.mfv.new_name, 8);
+
+ /* Sort the vector, then check for duplicates. */
+ qsort (names, default_dict.nvar, 8, compare_name);
+ for (i = 1; i < default_dict.nvar; i++)
+ if (memcmp (names[i], names[i - 1], 8) == 0)
+ {
+ char name[9];
+ strncpy (name, names[i], 8);
+ name[8] = 0;
+ msg (SE, _("Duplicate variable name `%s' after renaming."), name);
+ goto lossage;
+ }
+ free (names);
+
+ /* Finally, do the renaming. */
+ for (iter = head; iter; iter = iter->p.mfv.next)
+ avl_force_delete (default_dict.var_by_name, iter);
+ for (iter = head; iter; iter = iter->p.mfv.next)
+ {
+ strcpy (iter->name, iter->p.mfv.new_name);
+ avl_force_insert (default_dict.var_by_name, iter);
+ }
+
+ return CMD_SUCCESS;
+
+lossage:
+ if (new_names)
+ for (i = 0; i < n_rename; i++)
+ free (new_names[i]);
+ free (new_names);
+ free (old_names);
+ free (names);
+ return CMD_FAILURE;
+}
+
+static int
+compare_name (const void *a, const void *b)
+{
+ return memcmp (a, b, 8);
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <ctype.h>
+#include <math.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "cases.h"
+#include "command.h"
+#include "error.h"
+#include "getline.h"
+#include "lexer.h"
+#include "misc.h"
+#include "settings.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* Describes one DO REPEAT macro. */
+struct repeat_entry
+ {
+ int type; /* 1=variable names, 0=any other. */
+ char id[9]; /* Macro identifier. */
+ char **replacement; /* Macro replacement. */
+ struct repeat_entry *next;
+ };
+
+/* List of macro identifiers. */
+static struct repeat_entry *repeat_tab;
+
+/* Number of substitutions for each macro. */
+static int count;
+
+/* List of lines before it's actually assigned to a file. */
+static struct getl_line_list *line_buf_head;
+static struct getl_line_list *line_buf_tail;
+
+static int parse_ids (struct repeat_entry *);
+static int parse_numbers (struct repeat_entry *);
+static int parse_strings (struct repeat_entry *);
+static void clean_up (void);
+static int internal_cmd_do_repeat (void);
+
+#if DEBUGGING
+static void debug_print (void);
+static void debug_print_lines (void);
+#endif
+
+int
+cmd_do_repeat (void)
+{
+ if (internal_cmd_do_repeat ())
+ return CMD_SUCCESS;
+
+ clean_up ();
+ return CMD_FAILURE;
+}
+
+/* Garbage collects all the allocated memory that's no longer
+ needed. */
+static void
+clean_up (void)
+{
+ struct repeat_entry *iter, *next;
+ int i;
+
+ iter = repeat_tab;
+ repeat_tab = NULL;
+
+ while (iter)
+ {
+ if (iter->replacement)
+ {
+ for (i = 0; i < count; i++)
+ free (iter->replacement[i]);
+ free (iter->replacement);
+ }
+ next = iter->next;
+ free (iter);
+ iter = next;
+ }
+}
+
+/* Allocates & appends another record at the end of the line_buf_tail
+ chain. */
+static inline void
+append_record (void)
+{
+ struct getl_line_list *new = xmalloc (sizeof *new);
+
+ if (line_buf_head == NULL)
+ line_buf_head = line_buf_tail = new;
+ else
+ line_buf_tail = line_buf_tail->next = new;
+}
+
+/* Returns nonzero if KEYWORD appears beginning at CONTEXT. */
+static int
+recognize_keyword (const char *context, const char *keyword)
+{
+ const char *end = context;
+ while (isalpha ((unsigned char) *end))
+ end++;
+ return lex_id_match_len (keyword, strlen (keyword), context, end - context);
+}
+
+/* Does the real work of parsing the DO REPEAT command and its nested
+ commands. */
+static int
+internal_cmd_do_repeat (void)
+{
+ /* Name of first DO REPEAT macro. */
+ char first_name[9];
+
+ /* Current filename. */
+ const char *current_filename = NULL;
+
+ /* 1=Print lines after preprocessing. */
+ int print;
+
+ /* The first step is parsing the DO REPEAT command itself. */
+ lex_match_id ("DO");
+ lex_match_id ("REPEAT");
+
+ count = 0;
+ line_buf_head = NULL;
+ do
+ {
+ struct repeat_entry *e;
+ struct repeat_entry *iter;
+ int result;
+
+ /* Get a stand-in variable name and make sure it's unique. */
+ if (!lex_force_id ())
+ return 0;
+ for (iter = repeat_tab; iter; iter = iter->next)
+ if (!strcmp (iter->id, tokid))
+ {
+ msg (SE, _("Identifier %s is given twice."), tokid);
+ return 0;
+ }
+
+ /* Make a new stand-in variable entry and link it into the
+ list. */
+ e = xmalloc (sizeof *e);
+ e->type = 0;
+ e->next = repeat_tab;
+ strcpy (e->id, tokid);
+ repeat_tab = e;
+
+ /* Skip equals sign. */
+ lex_get ();
+ if (!lex_force_match ('='))
+ return 0;
+
+ /* Get the details of the variable's possible values. */
+
+ if (token == T_ID)
+ result = parse_ids (e);
+ else if (token == T_NUM)
+ result = parse_numbers (e);
+ else if (token == T_STRING)
+ result = parse_strings (e);
+ else
+ {
+ lex_error (NULL);
+ return 0;
+ }
+ if (!result)
+ return 0;
+
+ /* If this is the first variable then it defines how many
+ replacements there must be; otherwise enforce this number of
+ replacements. */
+ if (!count)
+ {
+ count = result;
+ strcpy (first_name, e->id);
+ }
+ else if (count != result)
+ {
+ msg (SE, _("There must be the same number of substitutions "
+ "for each dummy variable specified. Since there "
+ "were %d substitutions for %s, there must be %d "
+ "for %s as well, but %d were specified."),
+ count, first_name, count, e->id, result);
+ return 0;
+ }
+
+ /* Next! */
+ lex_match ('/');
+ }
+ while (token != '.');
+
+#if DEBUGGING
+ debug_print ();
+#endif
+
+ /* Read all the lines inside the DO REPEAT ... END REPEAT. */
+ {
+ int nest = 1;
+
+ for (;;)
+ {
+ if (!getl_read_line ())
+ msg (FE, _("Unexpected end of file."));
+
+ /* If the current file has changed then record the fact. */
+ {
+ const char *curfn;
+ int curln;
+
+ getl_location (&curfn, &curln);
+ if (current_filename != curfn)
+ {
+ assert (curln > 0 && curfn != NULL);
+
+ append_record ();
+ line_buf_tail->len = -curln;
+ line_buf_tail->line = xstrdup (curfn);
+ current_filename = curfn;
+ }
+ }
+
+ /* FIXME? This code is not strictly correct, however if you
+ have begun a line with DO REPEAT or END REPEAT and it's
+ *not* a command name, then you are obviously *trying* to
+ break this mechanism. And you will. Also, the entire
+ command names must appear on a single line--they can't be
+ spread out. */
+ {
+ char *cp = ds_value (&getl_buf);
+
+ /* Skip leading indentors and any whitespace. */
+ if (*cp == '+' || *cp == '-' || *cp == '.')
+ cp++;
+ while (isspace ((unsigned char) *cp))
+ cp++;
+
+ /* Find END REPEAT. */
+ if (recognize_keyword (cp, "end"))
+ {
+ while (isalpha ((unsigned char) *cp))
+ cp++;
+ while (isspace ((unsigned char) *cp))
+ cp++;
+ if (recognize_keyword (cp, "repeat"))
+ {
+ nest--;
+
+ if (!nest)
+ {
+ while (isalpha ((unsigned char) *cp))
+ cp++;
+ while (isspace ((unsigned char) *cp))
+ cp++;
+
+ print = recognize_keyword (cp, "print");
+ break;
+ }
+ }
+ }
+ else /* Find DO REPEAT. */
+ if (!strncasecmp (cp, "do", 2))
+ {
+ cp += 2;
+ while (isspace ((unsigned char) *cp))
+ cp++;
+ if (!strncasecmp (cp, "rep", 3))
+ nest++;
+ }
+ }
+
+ append_record ();
+ line_buf_tail->len = ds_length (&getl_buf);
+ line_buf_tail->line = xmalloc (ds_length (&getl_buf) + 1);
+ memcpy (line_buf_tail->line,
+ ds_value (&getl_buf), ds_length (&getl_buf) + 1);
+ }
+ }
+
+ /* FIXME: For the moment we simply discard the contents of the END
+ REPEAT line. We should actually check for the PRINT specifier.
+ This can be done easier when we buffer entire commands instead of
+ doing it token by token; see TODO. */
+ lex_entire_line ();
+
+ /* Tie up the loose end of the chain. */
+ if (line_buf_head == NULL)
+ {
+ msg (SW, _("No commands in scope."));
+ return 1;
+ }
+ line_buf_tail->next = NULL;
+
+ /* Show the line list. */
+#if DEBUGGING
+ debug_print_lines ();
+#endif
+
+ /* Make new variables. */
+ {
+ struct repeat_entry *iter;
+ for (iter = repeat_tab; iter; iter = iter->next)
+ if (iter->type == 1)
+ {
+ int i;
+ for (i = 0; i < count; i++)
+ {
+ /* Note that if the variable already exists there is no
+ harm done. */
+ struct variable *v = create_variable (&default_dict,
+ iter->replacement[i],
+ NUMERIC, 0);
+
+ /* If we created the variable then we need to initialize
+ its observations to SYSMIS. */
+ if (v)
+ envector (v);
+ }
+ }
+ }
+
+ /* Create the DO REPEAT virtual input file. */
+ {
+ struct getl_script *script = xmalloc (sizeof *script);
+
+ script->first_line = line_buf_head;
+ script->cur_line = NULL;
+ script->remaining_loops = count;
+ script->loop_index = -1;
+ script->macros = repeat_tab;
+ script->print = print;
+
+ getl_add_DO_REPEAT_file (script);
+ }
+
+ return 1;
+}
+
+/* Parses a set of ids for DO REPEAT. */
+static int
+parse_ids (struct repeat_entry * e)
+{
+ int i;
+ int n = 0;
+
+ e->type = 1;
+ e->replacement = NULL;
+
+ do
+ {
+ char **names;
+ int nnames;
+
+ if (!parse_mixed_vars (&names, &nnames, PV_NONE))
+ return 0;
+
+ e->replacement = xrealloc (e->replacement,
+ (nnames + n) * sizeof *e->replacement);
+ for (i = 0; i < nnames; i++)
+ {
+ e->replacement[n + i] = xstrdup (names[i]);
+ free (names[i]);
+ }
+ free (names);
+ n += nnames;
+ }
+ while (token != '/' && token != '.');
+
+ return n;
+}
+
+/* Stores VALUE into *REPL. */
+static inline void
+store_numeric (char **repl, long value)
+{
+ *repl = xmalloc (INT_DIGITS + 1);
+ sprintf (*repl, "%ld", value);
+}
+
+/* Parses a list of numbers for DO REPEAT. */
+static int
+parse_numbers (struct repeat_entry *e)
+{
+ /* First and last numbers for TO, plus the step factor. */
+ long a, b;
+
+ /* Alias to e->replacement. */
+ char **array;
+
+ /* Number of entries in array; maximum number for this allocation
+ size. */
+ int n, m;
+
+ n = m = 0;
+ e->type = 0;
+ e->replacement = array = NULL;
+
+ do
+ {
+ /* Parse A TO B into a, b. */
+ if (!lex_force_int ())
+ return 0;
+ a = lex_integer ();
+
+ lex_get ();
+ if (token == T_TO)
+ {
+ lex_get ();
+ if (!lex_force_int ())
+ return 0;
+ b = lex_integer ();
+
+ lex_get ();
+ }
+ else b = a;
+
+ if (n + (abs (b - a) + 1) > m)
+ {
+ m = n + (abs (b - a) + 1) + 16;
+ e->replacement = array = xrealloc (array,
+ m * sizeof *e->replacement);
+ }
+
+ if (a == b)
+ store_numeric (&array[n++], a);
+ else
+ {
+ long iter;
+
+ if (a < b)
+ for (iter = a; iter <= b; iter++)
+ store_numeric (&array[n++], iter);
+ else
+ for (iter = a; iter >= b; iter--)
+ store_numeric (&array[n++], iter);
+ }
+
+ lex_match (',');
+ }
+ while (token != '/' && token != '.');
+ e->replacement = xrealloc (array, n * sizeof *e->replacement);
+
+ return n;
+}
+
+/* Parses a list of strings for DO REPEAT. */
+int
+parse_strings (struct repeat_entry * e)
+{
+ char **string;
+ int n, m;
+
+ e->type = 0;
+ string = e->replacement = NULL;
+ n = m = 0;
+
+ do
+ {
+ if (token != T_STRING)
+ {
+ int i;
+ msg (SE, _("String expected."));
+ for (i = 0; i < n; i++)
+ free (string[i]);
+ free (string);
+ return 0;
+ }
+
+ if (n + 1 > m)
+ {
+ m += 16;
+ e->replacement = string = xrealloc (string,
+ m * sizeof *e->replacement);
+ }
+ string[n++] = lex_token_representation ();
+ lex_get ();
+
+ lex_match (',');
+ }
+ while (token != '/' && token != '.');
+ e->replacement = xrealloc (string, n * sizeof *e->replacement);
+
+ return n;
+}
+\f
+int
+cmd_end_repeat (void)
+{
+ msg (SE, _("No matching DO REPEAT."));
+ return CMD_FAILURE;
+}
+\f
+/* Finds a DO REPEAT macro with name MACRO_NAME and returns the
+ appropriate subsitution if found, or NULL if not. */
+char *
+find_DO_REPEAT_substitution (char *macro_name)
+{
+ struct getl_script *s;
+
+ for (s = getl_head; s; s = s->included_from)
+ {
+ struct repeat_entry *e;
+
+ if (s->first_line == NULL)
+ continue;
+
+ for (e = s->macros; e; e = e->next)
+ if (!strcasecmp (e->id, macro_name))
+ return e->replacement[s->loop_index];
+ }
+
+ return NULL;
+}
+
+/* Makes appropriate DO REPEAT macro substitutions within getl_buf. */
+void
+perform_DO_REPEAT_substitutions (void)
+{
+ /* Are we in an apostrophized string or a quoted string? */
+ int in_apos = 0, in_quote = 0;
+
+ /* Source pointer. */
+ char *cp;
+
+ /* Output buffer, size, pointer. */
+ struct string output;
+
+ /* Terminal dot. */
+ int dot = 0;
+
+ ds_init (NULL, &output, ds_size (&getl_buf));
+
+ /* Strip trailing whitespace, check for & remove terminal dot. */
+ while (ds_length (&getl_buf) > 0
+ && isspace ((unsigned char) ds_end (&getl_buf)[-1]))
+ ds_truncate (&getl_buf, ds_length (&getl_buf) - 1);
+ if (ds_length (&getl_buf) > 0 && ds_end (&getl_buf)[-1] == set_endcmd)
+ {
+ dot = 1;
+ ds_truncate (&getl_buf, ds_length (&getl_buf) - 1);
+ }
+
+ for (cp = ds_value (&getl_buf); cp < ds_end (&getl_buf); )
+ {
+ if (*cp == '\'' && !in_quote)
+ in_apos ^= 1;
+ else if (*cp == '"' && !in_apos)
+ in_quote ^= 1;
+
+ if (in_quote || in_apos || !CHAR_IS_ID1 (*cp))
+ {
+ ds_putchar (&output, *cp++);
+ continue;
+ }
+
+ /* Collect an identifier. */
+ {
+ char name[9];
+ char *start = cp;
+ char *np = name;
+ char *substitution;
+
+ while (CHAR_IS_IDN (*cp) && np < &name[8])
+ *np++ = *cp++;
+ while (CHAR_IS_IDN (*cp))
+ cp++;
+ *np = 0;
+
+ substitution = find_DO_REPEAT_substitution (name);
+ if (!substitution)
+ {
+ ds_concat_buffer (&output, start, cp - start);
+ continue;
+ }
+
+ /* Force output buffer size, copy substitution. */
+ ds_concat (&output, substitution);
+ }
+ }
+ if (dot)
+ ds_putchar (&output, (unsigned char) set_endcmd);
+
+ ds_destroy (&getl_buf);
+ getl_buf = output;
+}
+\f
+/* Debugging code. */
+
+#if DEBUGGING
+static void
+debug_print (void)
+{
+ struct repeat_entry *iter;
+ int j;
+
+ printf ("DO REPEAT\n");
+ for (iter = repeat_tab; iter; iter = iter->next)
+ {
+ printf (" %s%s=", iter->id, iter->type ? "(ids)" : "");
+ for (j = 0; j < count; j++)
+ printf ("%s ", iter->replacement[j]);
+ putc (iter->next ? '/' : '.', stdout);
+ printf ("\n");
+ }
+}
+
+static void
+debug_print_lines (void)
+{
+ struct getl_line_list *iter;
+ const char *fn = "(none)";
+ int ln = 65536;
+
+ printf ("---begin DO REPEAT lines---\n");
+ for (iter = line_buf_head; iter; iter = iter->next)
+ {
+ if (iter->len < 0)
+ {
+ ln = -iter->len;
+ fn = iter->line;
+ } else {
+ printf ("%s:%d: %s", fn, ln++, iter->line);
+ }
+ }
+ printf ("---end DO REPEAT lines---\n");
+}
+#endif /* DEBUGGING */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <stdio.h>
+#include <math.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "random.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+
+/* The two different types of samples. */
+enum
+ {
+ TYPE_A_FROM_B, /* 5 FROM 10 */
+ TYPE_FRACTION /* 0.5 */
+ };
+
+/* SAMPLE transformation. */
+struct sample_trns
+ {
+ struct trns_header h;
+ int type; /* One of TYPE_*. */
+ int n, N; /* TYPE_A_FROM_B: n from N. */
+ int m, t; /* TYPE_A_FROM_B: # selected so far; # so far. */
+ int frac; /* TYPE_FRACTION: a fraction out of 65536. */
+ };
+
+int sample_trns_proc (struct trns_header *, struct ccase *);
+
+int
+cmd_sample (void)
+{
+ struct sample_trns *trns;
+
+ int type;
+ int a, b;
+ int frac;
+
+ lex_match_id ("SAMPLE");
+
+ if (!lex_force_num ())
+ return CMD_FAILURE;
+ if (!lex_integer_p ())
+ {
+ type = TYPE_FRACTION;
+ if (tokval <= 0 || tokval >= 1)
+ {
+ msg (SE, _("The sampling factor must be between 0 and 1 "
+ "exclusive."));
+ return CMD_FAILURE;
+ }
+
+ frac = tokval * 65536;
+ a = b = 0;
+ }
+ else
+ {
+ type = TYPE_A_FROM_B;
+ a = lex_integer ();
+ lex_get ();
+ if (!lex_force_match_id ("FROM"))
+ return CMD_FAILURE;
+ if (!lex_force_int ())
+ return CMD_FAILURE;
+ b = lex_integer ();
+ if (a >= b)
+ {
+ msg (SE, _("Cannot sample %d observations from a population of "
+ "%d."),
+ a, b);
+ return CMD_FAILURE;
+ }
+
+ frac = 0;
+ }
+ lex_get ();
+
+#if DEBUGGING
+ if (type == TYPE_FRACTION)
+ printf ("SAMPLE %g.\n", frac / 65536.);
+ else
+ printf ("SAMPLE %d FROM %d.\n", a, b);
+#endif
+
+ trns = xmalloc (sizeof *trns);
+ trns->h.proc = sample_trns_proc;
+ trns->h.free = NULL;
+ trns->type = type;
+ trns->n = a;
+ trns->N = b;
+ trns->m = trns->t = 0;
+ trns->frac = frac;
+ add_transformation ((struct trns_header *) trns);
+
+ return lex_end_of_command ();
+}
+
+int
+sample_trns_proc (struct trns_header * trns, struct ccase *c unused)
+{
+ struct sample_trns *t = (struct sample_trns *) trns;
+ double U;
+
+ if (t->type == TYPE_FRACTION)
+ return (rand_simple (0x10000) <= t->frac) - 2;
+
+ if (t->m >= t->n)
+ return -2;
+
+ U = rand_uniform (1);
+ if ((t->N - t->t) * U >= t->n - t->m)
+ {
+ t->t++;
+ return -2;
+ }
+ else
+ {
+ t->m++;
+ t->t++;
+ return -1;
+ }
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "expr.h"
+#include "lexer.h"
+#include "str.h"
+#include "var.h"
+
+/* SELECT IF transformation. */
+struct select_if_trns
+ {
+ struct trns_header h;
+ struct expression *e; /* Test expression. */
+ };
+
+static int select_if_proc (struct trns_header *, struct ccase *);
+static void select_if_free (struct trns_header *);
+
+/* Parses the SELECT IF transformation. */
+int
+cmd_select_if (void)
+{
+ struct expression *e;
+ struct select_if_trns *t;
+
+ lex_match_id ("SELECT");
+ lex_match_id ("IF");
+
+ e = expr_parse (PXP_BOOLEAN);
+ if (!e)
+ return CMD_FAILURE;
+
+ if (token != '.')
+ {
+ expr_free (e);
+ lex_error (_("expecting end of command"));
+ return CMD_FAILURE;
+ }
+
+ t = xmalloc (sizeof *t);
+ t->h.proc = select_if_proc;
+ t->h.free = select_if_free;
+ t->e = e;
+ add_transformation ((struct trns_header *) t);
+
+ return CMD_SUCCESS;
+}
+
+/* Performs the SELECT IF transformation T on case C. */
+static int
+select_if_proc (struct trns_header * t, struct ccase * c)
+{
+ return (expr_evaluate (((struct select_if_trns *) t)->e, c, NULL) == 1.0) - 2;
+}
+
+/* Frees SELECT IF transformation T. */
+static void
+select_if_free (struct trns_header * t)
+{
+ expr_free (((struct select_if_trns *) t)->e);
+}
+
+/* Parses the FILTER command. */
+int
+cmd_filter (void)
+{
+ lex_match_id ("FILTER");
+
+ if (lex_match_id ("OFF"))
+ default_dict.filter_var[0] = 0;
+ else
+ {
+ struct variable *v;
+
+ lex_match (T_BY);
+ v = parse_variable ();
+ if (!v)
+ return CMD_FAILURE;
+
+ if (v->type == ALPHA)
+ {
+ msg (SE, _("The filter variable must be numeric."));
+ return CMD_FAILURE;
+ }
+
+ if (v->name[0] == '#')
+ {
+ msg (SE, _("The filter variable may not be scratch."));
+ return CMD_FAILURE;
+ }
+
+ strcpy (default_dict.filter_var, v->name);
+
+ FILTER_before_TEMPORARY = !temporary;
+ }
+
+ return CMD_SUCCESS;
+}
+
+/* Parses the PROCESS IF command. */
+int
+cmd_process_if (void)
+{
+ struct expression *e;
+
+ lex_match_id ("PROCESS");
+ lex_match_id ("IF");
+
+ e = expr_parse (PXP_BOOLEAN);
+ if (!e)
+ return CMD_FAILURE;
+
+ if (token != '.')
+ {
+ expr_free (e);
+ lex_error (_("expecting end of command"));
+ return CMD_FAILURE;
+ }
+
+ if (process_if_expr)
+ {
+ msg (MW, _("Only last instance of this command is in effect."));
+ expr_free (process_if_expr);
+ }
+ process_if_expr = e;
+
+ return CMD_SUCCESS;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/*
+ Categories of SET subcommands:
+
+ data input: BLANKS, DECIMAL, FORMAT.
+
+ program input: ENDCMD, NULLINE.
+
+ interaction: CPROMPT, DPROMPT, ERRORBREAK, MXERRS, MXWARNS, PROMPT.
+
+ program execution: MEXPAND, MITERATE, MNEST, MPRINT,
+ MXLOOPS, SEED, UNDEFINED.
+
+ data output: CCA...CCE, DECIMAL, FORMAT, RESULTS-p.
+
+ output routing: ECHO, ERRORS, INCLUDE, MESSAGES, PRINTBACK, ERRORS,
+ RESULTS-rw.
+
+ output activation: LISTING (on/off), SCREEN, PRINTER.
+
+ output driver options: HEADERS, MORE, PAGER, VIEWLENGTH, VIEWWIDTH,
+ LISTING (filename).
+
+ logging: LOG, JOURNAL.
+
+ system files: COMP/COMPRESSION, SCOMP/SCOMPRESSION.
+
+ security: SAFER.
+*/
+
+/*
+ FIXME
+
+ These subcommands remain to be implemented:
+ ECHO, PRINTBACK, INCLUDE
+ MORE, PAGER, VIEWLENGTH, VIEWWIDTH, HEADERS
+
+ These subcommands are not complete:
+ MESSAGES, ERRORS, RESULTS
+ LISTING/DISK, LOG/JOURNAL
+*/
+
+#include <config.h>
+#include <assert.h>
+#include <stdio.h>
+#include <errno.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "lexer.h"
+#include "error.h"
+#include "magic.h"
+#include "log.h"
+#include "output.h"
+#include "var.h"
+#include "format.h"
+#include "settings.h"
+
+double set_blanks;
+int set_compression;
+struct set_cust_currency set_cc[5];
+int set_cpi;
+char *set_cprompt;
+int set_decimal;
+int set_grouping;
+char *set_dprompt;
+int set_echo;
+int set_endcmd;
+int set_errorbreak;
+int set_errors, set_messages, set_results;
+struct fmt_spec set_format;
+int set_headers;
+int set_include;
+char *set_journal;
+int set_journaling;
+int set_lpi;
+int set_messages;
+int set_mexpand;
+int set_miterate;
+int set_mnest;
+int set_more;
+int set_mprint;
+int set_mxerrs;
+int set_mxloops;
+int set_mxwarns;
+int set_nullline;
+int set_printback;
+int set_output = 1;
+#if !USE_INTERNAL_PAGER
+char *set_pager;
+#endif /* !USE_INTERNAL_PAGER */
+int set_printer;
+char *set_prompt;
+char *set_results_file;
+int set_safer;
+int set_scompression;
+int set_screen;
+long set_seed;
+int set_seed_used;
+int set_testing_mode;
+int set_undefined;
+int set_viewlength;
+int set_viewwidth;
+
+static void set_routing (int q, int *setting);
+static int set_ccx (const char *cc_string, struct set_cust_currency * cc,
+ int cc_name);
+
+/* (specification)
+ "SET" (stc_):
+ automenu=automenu:on/off;
+ beep=beep:on/off;
+ blanks=custom;
+ block=string "x==1" "one character long";
+ boxstring=string "x==3 || x==11" "3 or 11 characters long";
+ case=size:upper/uplow;
+ cca=string;
+ ccb=string;
+ ccc=string;
+ ccd=string;
+ cce=string;
+ color=custom;
+ compression=compress:on/off;
+ cpi=integer;
+ cprompt=string;
+ decimal=dec:dot/_comma;
+ disk=custom;
+ dprompt=string;
+ echo=echo:on/off;
+ eject=eject:on/off;
+ endcmd=string "x==1" "one character long";
+ errorbreak=errbrk:on/off;
+ errors=errors:on/off/terminal/listing/both/none;
+ format=custom;
+ headers=headers:no/yes/blank;
+ helpwindows=helpwin:on/off;
+ highres=hires:on/off;
+ histogram=string "x==1" "one character long";
+ include=inc:on/off;
+ journal=custom;
+ length=custom;
+ listing=custom;
+ log=custom;
+ lowres=lores:auto/on/off;
+ lpi=integer;
+ menus=menus:standard/extended;
+ messages=messages:on/off/terminal/listing/both/none;
+ mexpand=mexp:on/off;
+ miterate=integer;
+ mnest=integer;
+ more=more:on/off;
+ mprint=mprint:on/off;
+ mxerrs=integer;
+ mxloops=integer;
+ mxmemory=integer;
+ mxwarns=integer;
+ nulline=null:on/off;
+ pager=custom;
+ printback=prtbck:on/off;
+ printer=prtr:on/off;
+ prompt=string;
+ ptranslate=ptrans:on/off;
+ rcolor=custom;
+ results=custom;
+ runreview=runrev:auto/manual;
+ safer=safe:on;
+ scompression=scompress:on/off;
+ screen=scrn:on/off;
+ scripttab=string "x==1" "one character long";
+ seed=custom;
+ tb1=string "x==3 || x==11" "3 or 11 characters long";
+ tbfonts=string;
+ undefined=undef:warn/nowarn;
+ viewlength=custom;
+ viewwidth=integer;
+ width=custom;
+ workdev=custom;
+ workspace=integer;
+ xsort=xsort:yes/no.
+*/
+
+/* (declarations) */
+/* (functions) */
+
+int internal_cmd_set (void);
+
+int
+cmd_set (void)
+{
+ struct cmd_set cmd;
+
+ lex_match_id ("SET");
+
+ if (!parse_set (&cmd))
+ return CMD_FAILURE;
+
+ if (cmd.sbc_block)
+ msg (SW, _("BLOCK is obsolete."));
+
+ if (cmd.sbc_boxstring)
+ msg (SW, _("BOXSTRING is obsolete."));
+
+ if (cmd.compress != -1)
+ {
+ msg (MW, _("Active file compression is not yet implemented "
+ "(and probably won't be)."));
+ set_compression = cmd.compress == STC_OFF ? 0 : 1;
+ }
+ if (cmd.scompress != -1)
+ set_scompression = cmd.scompress == STC_OFF ? 0 : 1;
+ if (cmd.n_cpi != NOT_LONG)
+ {
+ if (cmd.n_cpi <= 0)
+ msg (SE, _("CPI must be greater than 0."));
+ else
+ set_cpi = cmd.n_cpi;
+ }
+ if (cmd.sbc_histogram)
+ msg (MW, _("HISTOGRAM is obsolete."));
+ if (cmd.n_lpi != NOT_LONG)
+ {
+ if (cmd.n_lpi <= 0)
+ msg (SE, _("LPI must be greater than 0."));
+ else
+ set_lpi = cmd.n_lpi;
+ }
+
+ /* Windows compatible syntax. */
+ if (cmd.sbc_case)
+ msg (SW, _("CASE is not implemented and probably won't be. If you care, "
+ "complain about it."));
+ if (cmd.sbc_cca)
+ set_ccx (cmd.s_cca, &set_cc[0], 'A');
+ if (cmd.sbc_ccb)
+ set_ccx (cmd.s_ccb, &set_cc[1], 'B');
+ if (cmd.sbc_ccc)
+ set_ccx (cmd.s_ccc, &set_cc[2], 'C');
+ if (cmd.sbc_ccd)
+ set_ccx (cmd.s_ccd, &set_cc[3], 'D');
+ if (cmd.sbc_cce)
+ set_ccx (cmd.s_cce, &set_cc[4], 'E');
+ if (cmd.dec != -1)
+ {
+ set_decimal = cmd.dec == STC_DOT ? '.' : ',';
+ set_grouping = cmd.dec == STC_DOT ? ',' : '.';
+ }
+ if (cmd.errors != -1)
+ set_routing (cmd.errors, &set_errors);
+ if (cmd.headers != -1)
+ set_headers = cmd.headers == STC_NO ? 0 : (cmd.headers == STC_YES ? 1 : 2);
+ if (cmd.messages != -1)
+ set_routing (cmd.messages, &set_messages);
+ if (cmd.mexp != -1)
+ set_mexpand = cmd.mexp == STC_OFF ? 0 : 1;
+ if (cmd.n_miterate != NOT_LONG)
+ {
+ if (cmd.n_miterate > 0)
+ set_miterate = cmd.n_miterate;
+ else
+ msg (SE, _("Value for MITERATE (%ld) must be greater than 0."),
+ cmd.n_miterate);
+ }
+ if (cmd.n_mnest != NOT_LONG)
+ {
+ if (cmd.n_mnest > 0)
+ set_mnest = cmd.n_mnest;
+ else
+ msg (SE, _("Value for MNEST (%ld) must be greater than 0."),
+ cmd.n_mnest);
+ }
+ if (cmd.mprint != -1)
+ set_mprint = cmd.mprint == STC_OFF ? 0 : 1;
+ if (cmd.n_mxerrs != NOT_LONG)
+ {
+ if (set_mxerrs < 1)
+ msg (SE, _("MXERRS must be at least 1."));
+ else
+ set_mxerrs = cmd.n_mxerrs;
+ }
+ if (cmd.n_mxloops != NOT_LONG)
+ {
+ if (set_mxloops < 1)
+ msg (SE, _("MXLOOPS must be at least 1."));
+ else
+ set_mxloops = cmd.n_mxloops;
+ }
+ if (cmd.n_mxmemory != NOT_LONG)
+ msg (SE, _("MXMEMORY is obsolete."));
+ if (cmd.n_mxwarns != NOT_LONG)
+ set_mxwarns = cmd.n_mxwarns;
+ if (cmd.prtbck != -1)
+ set_printback = cmd.prtbck == STC_OFF ? 0 : 1;
+ if (cmd.s_scripttab)
+ msg (SE, _("SCRIPTTAB is obsolete."));
+ if (cmd.s_tbfonts)
+ msg (SW, _("TBFONTS not implemented."));
+ if (cmd.s_tb1)
+ msg (SW, _("TB1 not implemented."));
+ if (cmd.undef != -1)
+ set_undefined = cmd.undef == STC_NOWARN ? 0 : 1;
+ if (cmd.n_workspace != NOT_LONG)
+ msg (SE, _("WORKSPACE is obsolete."));
+
+ /* PC+ compatible syntax. */
+ if (cmd.scrn != -1)
+ outp_enable_device (cmd.scrn == STC_OFF ? 0 : 1, OUTP_DEV_SCREEN);
+
+ if (cmd.automenu != -1)
+ msg (SW, _("AUTOMENU is obsolete."));
+ if (cmd.beep != -1)
+ msg (SW, _("BEEP is obsolete."));
+
+ if (cmd.s_cprompt)
+ {
+ free (set_cprompt);
+ set_cprompt = cmd.s_cprompt;
+ cmd.s_cprompt = NULL;
+ }
+ if (cmd.s_dprompt)
+ {
+ free (set_dprompt);
+ set_dprompt = cmd.s_dprompt;
+ cmd.s_dprompt = NULL;
+ }
+ if (cmd.echo != -1)
+ set_echo = cmd.echo == STC_OFF ? 0 : 1;
+ if (cmd.s_endcmd)
+ set_endcmd = cmd.s_endcmd[0];
+ if (cmd.eject != -1)
+ msg (SW, _("EJECT is obsolete."));
+ if (cmd.errbrk != -1)
+ set_errorbreak = cmd.errbrk == STC_OFF ? 0 : 1;
+ if (cmd.helpwin != -1)
+ msg (SW, _("HELPWINDOWS is obsolete."));
+ if (cmd.inc != -1)
+ set_include = cmd.inc == STC_OFF ? 0 : 1;
+ if (cmd.menus != -1)
+ msg (MW, _("MENUS is obsolete."));
+ if (cmd.null != -1)
+ set_nullline = cmd.null == STC_OFF ? 0 : 1;
+ if (cmd.more != -1)
+ set_more = cmd.more == STC_OFF ? 0 : 1;
+ if (cmd.prtr != -1)
+ outp_enable_device (cmd.prtr == STC_OFF ? 0 : 1, OUTP_DEV_PRINTER);
+ if (cmd.s_prompt)
+ {
+ free (set_prompt);
+ set_prompt = cmd.s_prompt;
+ cmd.s_prompt = NULL;
+ }
+ if (cmd.ptrans != -1)
+ msg (SW, _("PTRANSLATE is obsolete."));
+ if (cmd.runrev != -1)
+ msg (SW, "RUNREVIEW is obsolete.");
+ if (cmd.safe == STC_ON)
+ set_safer = 1;
+ if (cmd.xsort != -1)
+ msg (SW, _("XSORT is obsolete."));
+
+ free_set (&cmd);
+
+ return CMD_SUCCESS;
+}
+
+/* Sets custom currency specifier CC having name CC_NAME ('A' through
+ 'E') to correspond to the settings in CC_STRING. */
+static int
+set_ccx (const char *cc_string, struct set_cust_currency * cc, int cc_name)
+{
+ if (strlen (cc_string) > 16)
+ {
+ msg (SE, _("CC%c: Length of custom currency string `%s' (%d) "
+ "exceeds maximum length of 16."),
+ cc_name, cc_string, strlen (cc_string));
+ return 0;
+ }
+
+ /* Determine separators. */
+ {
+ const char *sp;
+ int n_commas, n_periods;
+
+ /* Count the number of commas and periods. There must be exactly
+ three of one or the other. */
+ n_commas = n_periods = 0;
+ for (sp = cc_string; *sp; sp++)
+ if (*sp == ',')
+ n_commas++;
+ else if (*sp == '.')
+ n_periods++;
+
+ if (!((n_commas == 3) ^ (n_periods == 3)))
+ {
+ msg (SE, _("CC%c: Custom currency string `%s' does not contain "
+ "exactly three periods or commas (not both)."),
+ cc_name, cc_string);
+ return 0;
+ }
+ else if (n_commas == 3)
+ {
+ cc->decimal = '.';
+ cc->grouping = ',';
+ }
+ else
+ {
+ cc->decimal = ',';
+ cc->grouping = '.';
+ }
+ }
+
+ /* Copy cc_string to cc, changing separators to nulls. */
+ {
+ char *cp;
+
+ strcpy (cc->buf, cc_string);
+ cp = cc->neg_prefix = cc->buf;
+
+ while (*cp++ != cc->grouping)
+ ;
+ cp[-1] = '\0';
+ cc->prefix = cp;
+
+ while (*cp++ != cc->grouping)
+ ;
+ cp[-1] = '\0';
+ cc->suffix = cp;
+
+ while (*cp++ != cc->grouping)
+ ;
+ cp[-1] = '\0';
+ cc->neg_suffix = cp;
+ }
+
+ return 1;
+}
+
+/* Sets *SETTING, which is a combination of SET_ROUTE_* bits that
+ indicates what to do with some sort of output, to the value
+ indicated by Q, which is a value provided by the input parser. */
+static void
+set_routing (int q, int *setting)
+{
+ switch (q)
+ {
+ case STC_ON:
+ *setting |= SET_ROUTE_DISABLE;
+ break;
+ case STC_OFF:
+ *setting &= ~SET_ROUTE_DISABLE;
+ break;
+ case STC_TERMINAL:
+ *setting &= ~(SET_ROUTE_LISTING | SET_ROUTE_OTHER);
+ *setting |= SET_ROUTE_SCREEN;
+ break;
+ case STC_LISTING:
+ *setting &= ~SET_ROUTE_SCREEN;
+ *setting |= SET_ROUTE_LISTING | SET_ROUTE_OTHER;
+ break;
+ case STC_BOTH:
+ *setting |= SET_ROUTE_SCREEN | SET_ROUTE_LISTING | SET_ROUTE_OTHER;
+ break;
+ case STC_NONE:
+ *setting &= ~(SET_ROUTE_SCREEN | SET_ROUTE_LISTING | SET_ROUTE_OTHER);
+ break;
+ default:
+ assert (0);
+ }
+}
+
+static int
+stc_custom_pager (struct cmd_set *cmd unused)
+{
+ lex_match ('=');
+#if !USE_INTERNAL_PAGER
+ if (lex_match_id ("OFF"))
+ {
+ if (set_pager)
+ free (set_pager);
+ set_pager = NULL;
+ }
+ else
+ {
+ if (!lex_force_string ())
+ return 0;
+ if (set_pager)
+ free (set_pager);
+ set_pager = xstrdup (ds_value (&tokstr));
+ lex_get ();
+ }
+ return 1;
+#else /* USE_INTERNAL_PAGER */
+ if (match_id (OFF))
+ return 1;
+ msg (SW, "External pagers not supported.");
+ return 0;
+#endif /* USE_INTERNAL_PAGER */
+}
+
+/* Parses the BLANKS subcommand, which controls the value that
+ completely blank fields in numeric data imply. X, Wnd: Syntax is
+ SYSMIS or a numeric value; PC+: Syntax is '.', which is equivalent
+ to SYSMIS, or a numeric value. */
+static int
+stc_custom_blanks (struct cmd_set *cmd unused)
+{
+ lex_match ('=');
+ if ((token == T_ID && lex_id_match ("SYSMIS", tokid))
+ || (token == T_STRING && !strcmp (tokid, ".")))
+ {
+ lex_get ();
+ set_blanks = SYSMIS;
+ }
+ else
+ {
+ if (!lex_force_num ())
+ return 0;
+ set_blanks = tokval;
+ lex_get ();
+ }
+ return 1;
+}
+
+static int
+stc_custom_length (struct cmd_set *cmd unused)
+{
+ int page_length;
+
+ lex_match ('=');
+ if (lex_match_id ("NONE"))
+ page_length = -1;
+ else
+ {
+ if (!lex_force_int ())
+ return 0;
+ if (lex_integer () < 1)
+ {
+ msg (SE, _("LENGTH must be at least 1."));
+ return 0;
+ }
+ page_length = lex_integer ();
+ lex_get ();
+ }
+
+ /* FIXME: Set page length. */
+ return 1;
+}
+
+static int
+stc_custom_results (struct cmd_set *cmd unused)
+{
+ struct tuple
+ {
+ const char *s;
+ int v;
+ };
+
+ static struct tuple tab[] =
+ {
+ {"ON", STC_ON},
+ {"OFF", STC_OFF},
+ {"TERMINAL", STC_TERMINAL},
+ {"LISTING", STC_LISTING},
+ {"BOTH", STC_BOTH},
+ {"NONE", STC_NONE},
+ {NULL, 0},
+ };
+
+ struct tuple *t;
+
+ lex_match ('=');
+
+ if (token != T_ID)
+ {
+ msg (SE, _("Missing identifier in RESULTS subcommand."));
+ return 0;
+ }
+
+ for (t = tab; t->s; t++)
+ if (lex_id_match (t->s, tokid))
+ {
+ lex_get ();
+ set_routing (t->v, &set_results);
+ return 1;
+ }
+ msg (SE, _("Unrecognized identifier in RESULTS subcommand."));
+ return 0;
+}
+
+static int
+stc_custom_seed (struct cmd_set *cmd unused)
+{
+ lex_match ('=');
+ if (lex_match_id ("RANDOM"))
+ set_seed = NOT_LONG;
+ else
+ {
+ if (!lex_force_num ())
+ return 0;
+ set_seed = tokval;
+ lex_get ();
+ }
+ return 1;
+}
+
+static int
+stc_custom_width (struct cmd_set *cmd unused)
+{
+ int page_width;
+
+ lex_match ('=');
+ if (lex_match_id ("NARROW"))
+ page_width = 79;
+ else if (lex_match_id ("WIDE"))
+ page_width = 131;
+ else
+ {
+ if (!lex_force_int ())
+ return 0;
+ if (lex_integer () < 1)
+ {
+ msg (SE, _("WIDTH must be at least 1."));
+ return 0;
+ }
+ page_width = lex_integer ();
+ lex_get ();
+ }
+
+ /* FIXME: Set page width. */
+ return 1;
+}
+
+/* Parses FORMAT subcommand, which consists of a numeric format
+ specifier. */
+static int
+stc_custom_format (struct cmd_set *cmd unused)
+{
+ struct fmt_spec fmt;
+
+ lex_match ('=');
+ if (!parse_format_specifier (&fmt, 0))
+ return 0;
+ if ((formats[fmt.type].cat & FCAT_STRING) != 0)
+ {
+ msg (SE, _("FORMAT requires numeric output format as an argument. "
+ "Specified format %s is of type string."),
+ fmt_to_string (&fmt));
+ return 0;
+ }
+
+ set_format = fmt;
+ return 1;
+}
+
+static int
+stc_custom_journal (struct cmd_set *cmd unused)
+{
+ lex_match ('=');
+ if (lex_match_id ("ON"))
+ set_journaling = 1;
+ else if (lex_match_id ("OFF"))
+ set_journaling = 0;
+ if (token == T_STRING)
+ {
+ set_journal = xstrdup (ds_value (&tokstr));
+ lex_get ();
+ }
+ return 1;
+}
+
+/* Parses COLOR subcommand. PC+: either ON or OFF or two or three
+ comma-delimited numbers inside parentheses. */
+static int
+stc_custom_color (struct cmd_set *cmd unused)
+{
+ msg (MW, "COLOR is obsolete.");
+
+ lex_match ('=');
+ if (!lex_match_id ("ON") && !lex_match_id ("YES") && !lex_match_id ("OFF") && !lex_match_id ("NO"))
+ {
+ if (!lex_force_match ('('))
+ return 0;
+ if (!lex_match ('*'))
+ {
+ if (!lex_force_int ())
+ return 0;
+ if (lex_integer () < 0 || lex_integer () > 15)
+ {
+ msg (SE, _("Text color must be in range 0-15."));
+ return 0;
+ }
+ lex_get ();
+ }
+ if (!lex_force_match (','))
+ return 0;
+ if (!lex_match ('*'))
+ {
+ if (!lex_force_int ())
+ return 0;
+ if (lex_integer () < 0 || lex_integer () > 7)
+ {
+ msg (SE, _("Background color must be in range 0-7."));
+ return 0;
+ }
+ lex_get ();
+ }
+ if (lex_match (',') && !lex_match ('*'))
+ {
+ if (!lex_force_int ())
+ return 0;
+ if (lex_integer () < 0 || lex_integer () > 7)
+ {
+ msg (SE, _("Border color must be in range 0-7."));
+ return 0;
+ }
+ lex_get ();
+ }
+ if (!lex_force_match (')'))
+ return 0;
+ }
+ return 1;
+}
+
+static int
+stc_custom_listing (struct cmd_set *cmd unused)
+{
+ lex_match ('=');
+ if (lex_match_id ("ON") || lex_match_id ("YES"))
+ outp_enable_device (1, OUTP_DEV_LISTING);
+ else if (lex_match_id ("OFF") || lex_match_id ("NO"))
+ outp_enable_device (0, OUTP_DEV_LISTING);
+ else
+ {
+ /* FIXME */
+ }
+
+ return 0;
+}
+
+static int
+stc_custom_disk (struct cmd_set *cmd unused)
+{
+ stc_custom_listing (cmd);
+ return 0;
+}
+
+static int
+stc_custom_log (struct cmd_set *cmd unused)
+{
+ stc_custom_journal (cmd);
+ return 0;
+}
+
+static int
+stc_custom_rcolor (struct cmd_set *cmd unused)
+{
+ msg (SW, _("RCOLOR is obsolete."));
+
+ lex_match ('=');
+ if (!lex_force_match ('('))
+ return 0;
+
+ if (!lex_match ('*'))
+ {
+ if (!lex_force_int ())
+ return 0;
+ if (lex_integer () < 0 || lex_integer () > 6)
+ {
+ msg (SE, _("Lower window color must be between 0 and 6."));
+ return 0;
+ }
+ lex_get ();
+ }
+ if (!lex_force_match (','))
+ return 0;
+
+ if (!lex_match ('*'))
+ {
+ if (!lex_force_int ())
+ return 0;
+ if (lex_integer () < 0 || lex_integer () > 6)
+ {
+ msg (SE, _("Upper window color must be between 0 and 6."));
+ return 0;
+ }
+ lex_get ();
+ }
+
+ if (lex_match (',') && !lex_match ('*'))
+ {
+ if (!lex_force_int ())
+ return 0;
+ if (lex_integer () < 0 || lex_integer () > 6)
+ {
+ msg (SE, _("Frame color must be between 0 and 6."));
+ return 0;
+ }
+ lex_get ();
+ }
+ return 1;
+}
+
+static int
+stc_custom_viewlength (struct cmd_set *cmd unused)
+{
+ if (lex_match_id ("MINIMUM"))
+ set_viewlength = 25;
+ else if (lex_match_id ("MEDIAN"))
+ set_viewlength = 43; /* This is not correct for VGA displays. */
+ else if (lex_match_id ("MAXIMUM"))
+ set_viewlength = 43;
+ else
+ {
+ if (!lex_force_int ())
+ return 0;
+#if __MSDOS__
+ if (lex_integer () >= (43 + 25) / 2)
+ set_viewlength = 43;
+ else
+ set_viewlength = 25;
+#else /* not dos */
+ set_viewlength = lex_integer ();
+#endif /* not dos */
+ lex_get ();
+ }
+
+#if __MSDOS__
+ msg (SW, _("VIEWLENGTH not implemented."));
+#endif /* dos */
+ return 1;
+}
+
+static int
+stc_custom_workdev (struct cmd_set *cmd unused)
+{
+ char c[2];
+
+ msg (SW, _("WORKDEV is obsolete."));
+
+ c[1] = 0;
+ for (*c = 'A'; *c <= 'Z'; (*c)++)
+ if (token == T_ID && lex_id_match (c, tokid))
+ {
+ lex_get ();
+ return 1;
+ }
+ msg (SE, _("Drive letter expected in WORKDEV subcommand."));
+ return 0;
+}
+
+\f
+/* GSET. */
+
+int
+cmd_gset (void)
+{
+ /* FIXME */
+ return CMD_FAILURE;
+}
+
+/*
+ Local Variables:
+ mode: c
+ End:
+*/
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !settings_h
+#define settings_h 1
+
+/* Table of mode settings (x=X, w=Windows, p=PC+, f=has relevance for
+ PSPP):
+
+ AUTOMENU: p
+ BEEP: p
+ BLANKS: xwpf
+ BLKSIZE: x (only on SHOW, not on SET)
+ BLOCK: xwp
+ BOX/BOXSTRING: xwp
+ BUFNO: x (only on SHOW, not on SET)
+ CASE: xw
+ CCA...CCE: xwf
+ COLOR: p
+ COMP/COMPRESSION: xwpf (meaning varies between p and xw)
+ CPI: xwp
+ CPROMPT: pf
+ DECIMAL: wf
+ DPROMPT: f
+ ECHO: pf
+ EJECT: p
+ EMULATION: f
+ ENDCMD: xpf
+ ERRORBREAK: pf
+ ERRORS: wf
+ FORMAT: xwf
+ HEADERS: xwf
+ HELPWINDOWS: p
+ HIGHRES: w
+ HISTOGRAM: xp
+ INCLUDE: pf
+ JOURNAL: wf (equivalent to LOG)
+ LENGTH: xwp
+ LISTING: xpf
+ LOG: pf (equivalent to JOURNAL)
+ LOWRES: w
+ LPI: xwp
+ MENUS: p
+ MESSAGES: wf
+ MEXPAND: xwf
+ MITERATE: xwf
+ MNEST: xwf
+ MORE: pf
+ MPRINT: xwf
+ MXERRS: xf
+ MXLOOPS: xwf
+ MXMEMORY: w
+ MXWARNS: xwf
+ N: xw (only on SHOW, not on SET)
+ NULLINE: xpf
+ NUMBERED: x (only on SHOW, not on SET)
+ PAGER: f
+ PRINTBACK: xwf
+ PRINTER: pf
+ PROMPT: pf
+ PTRANSLATE: p
+ RCOLOR: p
+ RESULTS: wpf (semantics differ)
+ RUNREVIEW: p
+ SCOMP/SCOMPRESSION: xwf
+ SCREEN: pf
+ SCRIPTTAB: xw
+ SEED: xwpf (semantics differ)
+ SYSMIS: xwf (only on SHOW, not on SET)
+ TBFONTS: xw
+ TB1: xw
+ TB2: x
+ UNDEFINED: xwf
+ VIEWLENGTH: pf
+ VIEWWIDTH: f
+ WEIGHT: xwf (only on SHOW, not on SET)
+ WIDTH: xwp
+ WORKDEV: p
+ WORKSPACE: w
+ XSORT: x
+ $VARS: wf (only on SHOW, not on SET)
+
+ */
+
+#include <float.h>
+
+/* The value that blank numeric fields are set to when read in;
+ normally SYSMIS. */
+extern double set_blanks;
+
+/* Describes one custom currency specification. */
+struct set_cust_currency
+ {
+ char buf[32]; /* Buffer for strings. */
+ char *neg_prefix; /* Negative prefix. */
+ char *prefix; /* Prefix. */
+ char *suffix; /* Suffix. */
+ char *neg_suffix; /* Negative suffix. */
+ int decimal; /* Decimal point. */
+ int grouping; /* Grouping character. */
+ };
+
+/* CCA through CCE. */
+extern struct set_cust_currency set_cc[5];
+
+/* Whether the active file should be compressed. */
+extern int set_compression;
+
+/* Characters per inch (horizontal). */
+extern int set_cpi;
+
+/* Continuation prompt. */
+extern char *set_cprompt;
+
+/* The character used for a decimal point: ',' or '.'. Only respected
+ for data input and output. */
+extern int set_decimal;
+
+/* The character used for grouping in numbers: '.' or ','; the
+ opposite of set_decimal. Only used in COMMA data input and
+ output. */
+extern int set_grouping;
+
+/* Prompt used for lines between BEGIN DATA and END DATA. */
+extern char *set_dprompt;
+
+/* Whether we echo commands to the listing file/printer; 0=no, 1=yes. */
+extern int set_echo;
+
+/* The character used to terminate commands. */
+extern int set_endcmd;
+
+/* Types of routing. */
+enum
+ {
+ SET_ROUTE_SCREEN = 001, /* Output to screen devices? */
+ SET_ROUTE_LISTING = 002, /* Output to listing devices? */
+ SET_ROUTE_OTHER = 004, /* Output to other devices? */
+ SET_ROUTE_DISABLE = 010 /* Disable output--overrides all other bits. */
+ };
+
+/* Routing for errors, messages, and procedure results. */
+extern int set_errors, set_messages, set_results;
+
+/* Whether an error stops execution; 0=no, 1=yes. */
+extern int set_errorbreak;
+
+/* Default format for variables created by transformations and by DATA
+ LIST {FREE,LIST}. */
+extern struct fmt_spec set_format;
+
+/* I don't know what this setting means; 0=no, 1=yes, 2=blank. */
+extern int set_headers;
+
+/* If set_echo is on, whether commands from include files are echoed;
+ * 0=no, 1=yes. */
+extern int set_include;
+
+/* Journal file's name. */
+extern char *set_journal;
+
+/* Whether we're journaling. */
+extern int set_journaling;
+
+/* Lines per inch (vertical). */
+extern int set_lpi;
+
+/* 0=macro expansion is disabled, 1=macro expansion is enabled. */
+extern int set_mexpand;
+
+/* Maximum number of iterations in a macro loop. */
+extern int set_miterate;
+
+/* Maximum nesting level for macros. */
+extern int set_mnest;
+
+/* Whether we pause after each screen of output; 0=no, 1=yes. */
+extern int set_more;
+
+/* Independent of set_printback, controls whether the commands
+ generated by macro invocations are displayed. */
+extern int set_mprint;
+
+/* Maximum number of errors. */
+extern int set_mxerrs;
+
+/* Implied limit of unbounded loop. */
+extern int set_mxloops;
+
+/* Maximum number of warnings + errors. */
+extern int set_mxwarns;
+
+/* Whether a blank line is a command terminator; 0=no, 1=yes. */
+extern int set_nullline;
+
+/* Whether commands are written to the display; 0=off, 1=on. */
+extern int set_printback;
+
+#if !USE_INTERNAL_PAGER
+/* Name of the pager program. */
+extern char *set_pager;
+#endif /* !USE_INTERNAL_PAGER */
+
+/* The command prompt. */
+extern char *set_prompt;
+
+/* Name of the results file. */
+extern char *set_results_file;
+
+/* Whether to allow certain unsafe operations. Cannot be unset after
+ it is set. */
+extern int set_safer;
+
+/* Whether save files should be compressed by default. */
+extern int set_scompression;
+
+/* The random number seed; NOT_LONG if we want a "random" random
+ number seed. */
+extern long set_seed;
+
+/* 1=The user has modified or made use of the random number seed. */
+extern int set_seed_used;
+
+/* 1=Turn on some heuristics that make testing PSPP for correct
+ workings a little easier. */
+extern int set_testing_mode;
+
+/* Whether to warn on undefined values in numeric data. */
+extern int set_undefined;
+
+/* Requested "view length" in lines. */
+extern int set_viewlength;
+
+/* Screen width. */
+extern int set_viewwidth;
+
+#endif /* !settings_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <errno.h>
+#include <float.h>
+#include "alloc.h"
+#include "avl.h"
+#include "error.h"
+#include "file-handle.h"
+#include "format.h"
+#include "getline.h"
+#include "magic.h"
+#include "misc.h"
+#include "sfm.h"
+#include "sfmP.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* PORTME: This file may require substantial revision for those
+ systems that don't meet the typical 32-bit integer/64-bit double
+ model. It's kinda hard to tell without having one of them on my
+ desk. */
+
+/* sfm's file_handle extension. */
+struct sfm_fhuser_ext
+ {
+ FILE *file; /* Actual file. */
+ int opened; /* Reference count. */
+
+ struct dictionary *dict; /* File's dictionary. */
+
+ int reverse_endian; /* 1=file has endianness opposite us. */
+ int case_size; /* Number of `values's per case. */
+ long ncases; /* Number of cases, -1 if unknown. */
+ int compressed; /* 1=compressed, 0=not compressed. */
+ double bias; /* Compression bias, usually 100.0. */
+ int weight_index; /* 0-based index of weighting variable, or -1. */
+
+ /* File's special constants. */
+ flt64 sysmis;
+ flt64 highest;
+ flt64 lowest;
+
+ /* Uncompression buffer. */
+ flt64 *buf; /* Buffer data. */
+ flt64 *ptr; /* Current location in buffer. */
+ flt64 *end; /* End of buffer data. */
+
+ /* Compression instruction octet. */
+ unsigned char x[sizeof (flt64)];
+ /* Current instruction octet. */
+ unsigned char *y; /* Location in current instruction octet. */
+ };
+
+static struct fh_ext_class sfm_r_class;
+
+#if GLOBAL_DEBUGGING
+void dump_dictionary (struct dictionary * dict);
+#endif
+\f
+/* Utilities. */
+
+/* bswap_int32(): Reverse the byte order of 32-bit integer *X. */
+#if __linux__
+#include <asm/byteorder.h>
+static inline void
+bswap_int32 (int32 * x)
+{
+ *x = ntohl (*x);
+}
+#else /* not Linux */
+static inline void
+bswap_int32 (int32 * x)
+{
+ unsigned char *y = (char *) x;
+ unsigned char t;
+ t = y[0];
+ y[0] = y[3];
+ y[3] = t;
+ t = y[1];
+ y[1] = y[2];
+ y[2] = t;
+}
+#endif /* not Linux */
+
+/* Reverse the byte order of 64-bit floating point *X. */
+static inline void
+bswap_flt64 (flt64 * x)
+{
+ /* Note that under compilers of any quality, half of this function
+ should optimize out as dead code. */
+ unsigned char *y = (char *) x;
+
+ if (sizeof (flt64) == 8)
+ {
+ unsigned char t;
+ t = y[0];
+ y[0] = y[7];
+ y[7] = t;
+ t = y[1];
+ y[1] = y[6];
+ y[6] = t;
+ t = y[2];
+ y[2] = y[5];
+ y[5] = t;
+ t = y[3];
+ y[3] = y[4];
+ y[4] = t;
+ }
+ else
+ {
+ unsigned char t;
+ size_t x;
+
+ for (x = 0; x < sizeof (flt64) / 2; x++)
+ {
+ t = y[x];
+ y[x] = y[sizeof (flt64) - x];
+ y[sizeof (flt64) - x] = t;
+ }
+ }
+}
+
+static void
+corrupt_msg (int class, const char *format,...)
+ __attribute__ ((format (printf, 2, 3)));
+
+/* Displays a corrupt sysfile error. */
+static void
+corrupt_msg (int class, const char *format,...)
+{
+ char buf[1024];
+
+ {
+ va_list args;
+
+ va_start (args, format);
+ vsnprintf (buf, 1024, format, args);
+ va_end (args);
+ }
+
+ {
+ struct error e;
+
+ e.class = class;
+ getl_location (&e.where.filename, &e.where.line_number);
+ e.title = _("corrupt system file: ");
+ e.text = buf;
+
+ err_vmsg (&e);
+ }
+}
+
+/* Closes a system file after we're done with it. */
+static void
+sfm_close (struct file_handle * h)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+
+ ext->opened--;
+ assert (ext->opened == 0);
+ if (EOF == fclose (ext->file))
+ msg (ME, _("%s: Closing system file: %s."), h->fn, strerror (errno));
+ free (ext->buf);
+ free (h->ext);
+}
+
+/* Closes a system file if we're done with it. */
+void
+sfm_maybe_close (struct file_handle *h)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+
+ if (ext->opened == 1)
+ fh_close_handle (h);
+ else
+ ext->opened--;
+}
+\f
+/* Dictionary reader. */
+
+static void *bufread (struct file_handle * handle, void *buf, size_t nbytes,
+ size_t minalloc);
+
+static int read_header (struct file_handle * h, struct sfm_read_info * inf);
+static int parse_format_spec (struct file_handle * h, int32 s,
+ struct fmt_spec * v, struct variable *vv);
+static int read_value_labels (struct file_handle * h, struct variable ** var_by_index);
+static int read_variables (struct file_handle * h, struct variable *** var_by_index);
+static int read_machine_int32_info (struct file_handle * h, int size, int count);
+static int read_machine_flt64_info (struct file_handle * h, int size, int count);
+static int read_documents (struct file_handle * h);
+
+/* Displays the message X with corrupt_msg, then jumps to the lossage
+ label. */
+#define lose(X) \
+ do \
+ { \
+ corrupt_msg X; \
+ goto lossage; \
+ } \
+ while (0)
+
+/* Calls bufread with the specified arguments, and jumps to lossage if
+ the read fails. */
+#define assertive_bufread(a,b,c,d) \
+ do \
+ { \
+ if (!bufread (a,b,c,d)) \
+ goto lossage; \
+ } \
+ while (0)
+
+/* Reads the dictionary from file with handle H, and returns it in a
+ dictionary structure. This dictionary may be modified in order to
+ rename, reorder, and delete variables, etc. */
+struct dictionary *
+sfm_read_dictionary (struct file_handle * h, struct sfm_read_info * inf)
+{
+ /* The file handle extension record. */
+ struct sfm_fhuser_ext *ext;
+
+ /* Allows for quick reference to variables according to indexes
+ relative to position within a case. */
+ struct variable **var_by_index = NULL;
+
+ /* Check whether the file is already open. */
+ if (h->class == &sfm_r_class)
+ {
+ ext = h->ext;
+ ext->opened++;
+ return ext->dict;
+ }
+ else if (h->class != NULL)
+ {
+ msg (ME, _("Cannot read file %s as system file: already opened for %s."),
+ fh_handle_name (h), h->class->name);
+ return NULL;
+ }
+
+ msg (VM (1), _("%s: Opening system-file handle %s for reading."),
+ fh_handle_filename (h), fh_handle_name (h));
+
+ /* Open the physical disk file. */
+ ext = xmalloc (sizeof (struct sfm_fhuser_ext));
+ ext->file = fopen (h->norm_fn, "rb");
+ if (ext->file == NULL)
+ {
+ msg (ME, _("An error occurred while opening \"%s\" for reading "
+ "as a system file: %s."), h->fn, strerror (errno));
+ err_cond_fail ();
+ free (ext);
+ return NULL;
+ }
+
+ /* Initialize the sfm_fhuser_ext structure. */
+ h->class = &sfm_r_class;
+ h->ext = ext;
+ ext->dict = NULL;
+ ext->buf = ext->ptr = ext->end = NULL;
+ ext->y = ext->x + sizeof ext->x;
+ ext->opened = 1;
+
+ /* Default special constants. */
+ ext->sysmis = -FLT64_MAX;
+ ext->highest = FLT64_MAX;
+ ext->lowest = second_lowest_flt64;
+
+ /* Read the header. */
+ if (!read_header (h, inf))
+ goto lossage;
+
+ /* Read about the variables. */
+ if (!read_variables (h, &var_by_index))
+ goto lossage;
+
+ /* Handle weighting. */
+ if (ext->weight_index != -1)
+ {
+ struct variable *wv = var_by_index[ext->weight_index];
+
+ if (wv == NULL)
+ lose ((ME, _("%s: Weighting variable may not be a continuation of "
+ "a long string variable."), h->fn));
+ else if (wv->type == ALPHA)
+ lose ((ME, _("%s: Weighting variable may not be a string variable."),
+ h->fn));
+
+ strcpy (ext->dict->weight_var, wv->name);
+ }
+ else
+ ext->dict->weight_var[0] = 0;
+
+ /* Read records of types 3, 4, 6, and 7. */
+ for (;;)
+ {
+ int32 rec_type;
+
+ assertive_bufread (h, &rec_type, sizeof rec_type, 0);
+ if (ext->reverse_endian)
+ bswap_int32 (&rec_type);
+
+ switch (rec_type)
+ {
+ case 3:
+ if (!read_value_labels (h, var_by_index))
+ goto lossage;
+ break;
+
+ case 4:
+ lose ((ME, _("%s: Orphaned variable index record (type 4). Type 4 "
+ "records must always immediately follow type 3 records."),
+ h->fn));
+
+ case 6:
+ if (!read_documents (h))
+ goto lossage;
+ break;
+
+ case 7:
+ {
+ struct
+ {
+ int32 subtype P;
+ int32 size P;
+ int32 count P;
+ }
+ data;
+
+ int skip = 0;
+
+ assertive_bufread (h, &data, sizeof data, 0);
+ if (ext->reverse_endian)
+ {
+ bswap_int32 (&data.subtype);
+ bswap_int32 (&data.size);
+ bswap_int32 (&data.count);
+ }
+
+ /*if(data.size != sizeof(int32) && data.size != sizeof(flt64))
+ lose((ME, "%s: Element size in record type 7, subtype %d, is "
+ "not either the size of IN (%d) or OBS (%d); actual value "
+ "is %d.",
+ h->fn, data.subtype, sizeof(int32), sizeof(flt64),
+ data.size)); */
+
+ switch (data.subtype)
+ {
+ case 3:
+ if (!read_machine_int32_info (h, data.size, data.count))
+ goto lossage;
+ break;
+
+ case 4:
+ if (!read_machine_flt64_info (h, data.size, data.count))
+ goto lossage;
+ break;
+
+ case 5:
+ case 6:
+ case 11: /* ?? Used by SPSS 8.0. */
+ skip = 1;
+ break;
+
+ default:
+ msg (MW, _("%s: Unrecognized record type 7, subtype %d "
+ "encountered in system file."), h->fn, data.subtype);
+ skip = 1;
+ }
+
+ if (skip)
+ {
+ void *x = bufread (h, NULL, data.size * data.count, 0);
+ if (x == NULL)
+ goto lossage;
+ free (x);
+ }
+ }
+ break;
+
+ case 999:
+ {
+ int32 filler;
+
+ assertive_bufread (h, &filler, sizeof filler, 0);
+ goto break_out_of_loop;
+ }
+
+ default:
+ lose ((ME, _("%s: Unrecognized record type %d."), h->fn, rec_type));
+ }
+ }
+
+break_out_of_loop:
+ /* Come here on successful completion. */
+ msg (VM (2), _("Read system-file dictionary successfully."));
+
+#if DEBUGGING
+ dump_dictionary (ext->dict);
+#endif
+ free (var_by_index);
+ return ext->dict;
+
+lossage:
+ /* Come here on unsuccessful completion. */
+ msg (VM (1), _("Error reading system-file header."));
+
+ free (var_by_index);
+ fclose (ext->file);
+ if (ext && ext->dict)
+ free_dictionary (ext->dict);
+ free (ext);
+ h->class = NULL;
+ h->ext = NULL;
+ return NULL;
+}
+
+/* Read record type 7, subtype 3. */
+static int
+read_machine_int32_info (struct file_handle * h, int size, int count)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+
+ int32 data[8];
+ int file_endian;
+
+ int i;
+
+ if (size != sizeof (int32) || count != 8)
+ lose ((ME, _("%s: Bad size (%d) or count (%d) field on record type 7, "
+ "subtype 3. Expected size %d, count 8."),
+ h->fn, size, count, sizeof (int32)));
+
+ assertive_bufread (h, data, sizeof data, 0);
+ if (ext->reverse_endian)
+ for (i = 0; i < 8; i++)
+ bswap_int32 (&data[i]);
+
+ /* PORTME: Check floating-point representation. */
+ switch (FPREP)
+ {
+ case FPREP_IEEE754:
+ if (data[4] != 1)
+ lose ((ME, _("%s: Floating-point representation in system file is not "
+ "IEEE-754. PSPP cannot convert between floating-point "
+ "formats."), h->fn));
+ break;
+ default:
+ assert (0);
+ }
+
+ /* PORTME: Check recorded file endianness against intuited file
+ endianness. */
+ file_endian = endian;
+ if (ext->reverse_endian)
+ {
+ if (file_endian == BIG)
+ file_endian = LITTLE;
+ else if (file_endian == LITTLE)
+ file_endian = BIG;
+ else
+ assert (0);
+ }
+ if ((file_endian == BIG) ^ (data[6] == 1))
+ lose ((ME, _("%s: File-indicated endianness (%s) does not match endianness "
+ "intuited from file header (%s)."),
+ h->fn, file_endian == BIG ? _("big-endian") : _("little-endian"),
+ data[6] == 1 ? _("big-endian") : (data[6] == 2 ? _("little-endian")
+ : _("unknown"))));
+
+ /* PORTME: Character representation code. */
+ if (data[7] != 2 && data[7] != 3)
+ lose ((ME, _("%s: File-indicated character representation code (%s) is not "
+ "ASCII."), h->fn,
+ data[7] == 1 ? "EBCDIC" : (data[7] == 4 ? _("DEC Kanji") : _("Unknown"))));
+
+ return 1;
+
+lossage:
+ return 0;
+}
+
+/* Read record type 7, subtype 4. */
+static int
+read_machine_flt64_info (struct file_handle * h, int size, int count)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+
+ flt64 data[3];
+
+ int i;
+
+ if (size != sizeof (flt64) || count != 3)
+ lose ((ME, _("%s: Bad size (%d) or count (%d) field on record type 7, "
+ "subtype 4. Expected size %d, count 8."),
+ h->fn, size, count, sizeof (flt64)));
+
+ assertive_bufread (h, data, sizeof data, 0);
+ if (ext->reverse_endian)
+ for (i = 0; i < 3; i++)
+ bswap_flt64 (&data[i]);
+
+ if (data[0] != SYSMIS || data[1] != FLT64_MAX
+ || data[2] != second_lowest_flt64)
+ {
+ ext->sysmis = data[0];
+ ext->highest = data[1];
+ ext->lowest = data[2];
+ msg (MW, _("%s: File-indicated value is different from internal value "
+ "for at least one of the three system values. SYSMIS: "
+ "indicated %g, expected %g; HIGHEST: %g, %g; LOWEST: "
+ "%g, %g."),
+ h->fn, (double) data[0], (double) SYSMIS,
+ (double) data[1], (double) FLT64_MAX,
+ (double) data[2], (double) second_lowest_flt64);
+ }
+
+ return 1;
+
+lossage:
+ return 0;
+}
+
+static int
+read_header (struct file_handle * h, struct sfm_read_info * inf)
+{
+ struct sfm_fhuser_ext *ext = h->ext; /* File extension strcut. */
+ struct sysfile_header hdr; /* Disk buffer. */
+ struct dictionary *dict; /* File dictionary. */
+ char prod_name[sizeof hdr.prod_name + 1]; /* Buffer for product name. */
+ int skip_amt; /* Amount of product name to omit. */
+ int i;
+
+ /* Create the dictionary. */
+ dict = ext->dict = xmalloc (sizeof *dict);
+ dict->var = NULL;
+ dict->var_by_name = NULL;
+ dict->nvar = 0;
+ dict->N = 0;
+ dict->nval = -1; /* Unknown. */
+ dict->n_splits = 0;
+ dict->splits = NULL;
+ dict->weight_var[0] = 0;
+ dict->weight_index = -1;
+ dict->filter_var[0] = 0;
+ dict->label = NULL;
+ dict->n_documents = 0;
+ dict->documents = NULL;
+
+ /* Read header, check magic. */
+ assertive_bufread (h, &hdr, sizeof hdr, 0);
+ if (0 != strncmp ("$FL2", hdr.rec_type, 4))
+ lose ((ME, _("%s: Bad magic. Proper system files begin with "
+ "the four characters `$FL2'. This file will not be read."),
+ h->fn));
+
+ /* Check eye-catcher string. */
+ memcpy (prod_name, hdr.prod_name, sizeof hdr.prod_name);
+ for (i = 0; i < 60; i++)
+ if (!isprint ((unsigned char) prod_name[i]))
+ prod_name[i] = ' ';
+ for (i = 59; i >= 0; i--)
+ if (!isgraph ((unsigned char) prod_name[i]))
+ {
+ prod_name[i] = '\0';
+ break;
+ }
+ prod_name[60] = '\0';
+
+ {
+#define N_PREFIXES 2
+ static const char *prefix[N_PREFIXES] =
+ {
+ "@(#) SPSS DATA FILE",
+ "SPSS SYSTEM FILE.",
+ };
+
+ int i;
+
+ for (i = 0; i < N_PREFIXES; i++)
+ if (!strncmp (prefix[i], hdr.prod_name, strlen (prefix[i])))
+ {
+ skip_amt = strlen (prefix[i]);
+ break;
+ }
+ }
+
+ /* Check endianness. */
+ /* PORTME: endianness. */
+ if (hdr.layout_code == 2)
+ ext->reverse_endian = 0;
+ else
+ {
+ bswap_int32 (&hdr.layout_code);
+ if (hdr.layout_code != 2)
+ lose ((ME, _("%s: File layout code has unexpected value %d. Value "
+ "should be 2, in big-endian or little-endian format."),
+ h->fn, hdr.layout_code));
+
+ ext->reverse_endian = 1;
+ bswap_int32 (&hdr.case_size);
+ bswap_int32 (&hdr.compressed);
+ bswap_int32 (&hdr.weight_index);
+ bswap_int32 (&hdr.ncases);
+ bswap_flt64 (&hdr.bias);
+ }
+
+ /* Copy basic info and verify correctness. */
+ ext->case_size = hdr.case_size;
+ if (hdr.case_size <= 0 || ext->case_size > (INT_MAX
+ / (int) sizeof (union value) / 2))
+ lose ((ME, _("%s: Number of elements per case (%d) is not between 1 "
+ "and %d."), h->fn, hdr.case_size, INT_MAX / sizeof (union value) / 2));
+
+ ext->compressed = hdr.compressed;
+
+ ext->weight_index = hdr.weight_index - 1;
+ if (hdr.weight_index < 0 || hdr.weight_index > hdr.case_size)
+ lose ((ME, _("%s: Index of weighting variable (%d) is not between 0 "
+ "and number of elements per case (%d)."),
+ h->fn, hdr.weight_index, ext->case_size));
+
+ ext->ncases = hdr.ncases;
+ if (ext->ncases < -1 || ext->ncases > INT_MAX / 2)
+ lose ((ME, _("%s: Number of cases in file (%ld) is not between -1 and "
+ "%d."), h->fn, (long) ext->ncases, INT_MAX / 2));
+
+ ext->bias = hdr.bias;
+ if (ext->bias != 100.0)
+ corrupt_msg (MW, _("%s: Compression bias (%g) is not the usual "
+ "value of 100."), h->fn, ext->bias);
+
+ /* Make a file label only on the condition that the given label is
+ not all spaces or nulls. */
+ {
+ int i;
+
+ dict->label = NULL;
+ for (i = sizeof hdr.file_label - 1; i >= 0; i--)
+ if (!isspace ((unsigned char) hdr.file_label[i])
+ && hdr.file_label[i] != 0)
+ {
+ dict->label = xmalloc (i + 2);
+ memcpy (dict->label, hdr.file_label, i + 1);
+ dict->label[i + 1] = 0;
+ break;
+ }
+ }
+
+ if (inf)
+ {
+ char *cp;
+
+ memcpy (inf->creation_date, hdr.creation_date, 9);
+ inf->creation_date[9] = 0;
+
+ memcpy (inf->creation_time, hdr.creation_time, 8);
+ inf->creation_time[8] = 0;
+
+ if (!ext->reverse_endian)
+ inf->endianness = endian;
+ else
+ inf->endianness = endian == BIG ? LITTLE : BIG;
+
+ inf->compressed = hdr.compressed;
+
+ inf->ncases = hdr.ncases;
+
+ for (cp = &prod_name[skip_amt]; cp < &prod_name[60]; cp++)
+ if (isgraph ((unsigned char) *cp))
+ break;
+ strcpy (inf->product, cp);
+ }
+
+ return 1;
+
+lossage:
+ return 0;
+}
+
+/* Reads most of the dictionary from file H; also fills in the
+ associated VAR_BY_INDEX array.
+
+ Note: the dictionary returned by this function has an invalid NVAL
+ element, also the VAR[] array does not have the FV and LV elements
+ set, however the NV elements *are* set. This is because the caller
+ will probably modify the dictionary before reading it in from the
+ file. Also, the get.* elements are set to appropriate values to
+ allow the file to be read. */
+static int
+read_variables (struct file_handle * h, struct variable *** var_by_index)
+{
+ int i;
+
+ struct sfm_fhuser_ext *ext = h->ext; /* File extension record. */
+ struct dictionary *dict = ext->dict; /* Dictionary being constructed. */
+ struct sysfile_variable sv; /* Disk buffer. */
+ int long_string_count = 0; /* # of long string continuation
+ records still expected. */
+ int next_value = 0; /* Index to next `value' structure. */
+
+ /* Allocate variables. */
+ dict->var = xmalloc (sizeof *dict->var * ext->case_size);
+ *var_by_index = xmalloc (sizeof **var_by_index * ext->case_size);
+
+ /* Read in the entry for each variable and use the info to
+ initialize the dictionary. */
+ for (i = 0; i < ext->case_size; i++)
+ {
+ struct variable *vv;
+ int j;
+
+ assertive_bufread (h, &sv, sizeof sv, 0);
+
+ if (ext->reverse_endian)
+ {
+ bswap_int32 (&sv.rec_type);
+ bswap_int32 (&sv.type);
+ bswap_int32 (&sv.has_var_label);
+ bswap_int32 (&sv.n_missing_values);
+ bswap_int32 (&sv.print);
+ bswap_int32 (&sv.write);
+ }
+
+ if (sv.rec_type != 2)
+ lose ((ME, _("%s: position %d: Bad record type (%d); "
+ "the expected value was 2."), h->fn, i, sv.rec_type));
+
+ /* If there was a long string previously, make sure that the
+ continuations are present; otherwise make sure there aren't
+ any. */
+ if (long_string_count)
+ {
+ if (sv.type != -1)
+ lose ((ME, _("%s: position %d: String variable does not have "
+ "proper number of continuation records."), h->fn, i));
+
+ (*var_by_index)[i] = NULL;
+ long_string_count--;
+ continue;
+ }
+ else if (sv.type == -1)
+ lose ((ME, _("%s: position %d: Superfluous long string continuation "
+ "record."), h->fn, i));
+
+ /* Check fields for validity. */
+ if (sv.type < 0 || sv.type > 255)
+ lose ((ME, _("%s: position %d: Bad variable type code %d."),
+ h->fn, i, sv.type));
+ if (sv.has_var_label != 0 && sv.has_var_label != 1)
+ lose ((ME, _("%s: position %d: Variable label indicator field is not "
+ "0 or 1."), h->fn, i));
+ if (sv.n_missing_values < -3 || sv.n_missing_values > 3
+ || sv.n_missing_values == -1)
+ lose ((ME, _("%s: position %d: Missing value indicator field is not "
+ "-3, -2, 0, 1, 2, or 3."), h->fn, i));
+
+ /* Construct internal variable structure, initialize critical bits. */
+ vv = (*var_by_index)[i] = dict->var[dict->nvar++] = xmalloc (sizeof *vv);
+ vv->index = dict->nvar - 1;
+ vv->foo = -1;
+ vv->label = NULL;
+ vv->val_lab = NULL;
+
+ /* Copy first character of variable name. */
+ if (!isalpha ((unsigned char) sv.name[0])
+ && sv.name[0] != '@' && sv.name[0] != '#')
+ lose ((ME, _("%s: position %d: Variable name begins with invalid "
+ "character."), h->fn, i));
+ if (islower ((unsigned char) sv.name[0]))
+ msg (MW, _("%s: position %d: Variable name begins with lowercase letter "
+ "%c."), h->fn, i, sv.name[0]);
+ if (sv.name[0] == '#')
+ msg (MW, _("%s: position %d: Variable name begins with octothorpe "
+ "(`#'). Scratch variables should not appear in system "
+ "files."), h->fn, i);
+ vv->name[0] = toupper ((unsigned char) (sv.name[0]));
+
+ /* Copy remaining characters of variable name. */
+ for (j = 1; j < 8; j++)
+ {
+ int c = (unsigned char) sv.name[j];
+
+ if (isspace (c))
+ break;
+ else if (islower (c))
+ {
+ msg (MW, _("%s: position %d: Variable name character %d is "
+ "lowercase letter %c."), h->fn, i, j + 1, sv.name[j]);
+ vv->name[j] = toupper ((unsigned char) (c));
+ }
+ else if (isalnum (c) || c == '.' || c == '@'
+ || c == '#' || c == '$' || c == '_')
+ vv->name[j] = c;
+ else
+ lose ((ME, _("%s: position %d: character `\\%03o' (%c) is not valid in a "
+ "variable name."), h->fn, i, c, c));
+ }
+ vv->name[j] = 0;
+
+ /* Set type, width, and `left' fields and allocate `value'
+ indices. */
+ if (sv.type == 0)
+ {
+ vv->type = NUMERIC;
+ vv->width = 0;
+ vv->get.nv = 1;
+ vv->get.fv = next_value++;
+ vv->nv = 1;
+ }
+ else
+ {
+ vv->type = ALPHA;
+ vv->width = sv.type;
+ vv->nv = DIV_RND_UP (vv->width, MAX_SHORT_STRING);
+ vv->get.nv = DIV_RND_UP (vv->width, sizeof (flt64));
+ vv->get.fv = next_value;
+ next_value += vv->get.nv;
+ long_string_count = vv->get.nv - 1;
+ }
+ vv->left = (vv->name[0] == '#');
+
+ /* Get variable label, if any. */
+ if (sv.has_var_label == 1)
+ {
+ /* Disk buffer. */
+ int32 len;
+
+ /* Read length of label. */
+ assertive_bufread (h, &len, sizeof len, 0);
+ if (ext->reverse_endian)
+ bswap_int32 (&len);
+
+ /* Check len. */
+ if (len < 0 || len > 255)
+ lose ((ME, _("%s: Variable %s indicates variable label of invalid "
+ "length %d."), h->fn, vv->name, len));
+
+ /* Read label into variable structure. */
+ vv->label = bufread (h, NULL, ROUND_UP (len, sizeof (int32)), len + 1);
+ if (vv->label == NULL)
+ goto lossage;
+ vv->label[len] = '\0';
+ }
+
+ /* Set missing values. */
+ if (sv.n_missing_values != 0)
+ {
+ flt64 mv[3];
+
+ if (vv->width > MAX_SHORT_STRING)
+ lose ((ME, _("%s: Long string variable %s may not have missing "
+ "values."), h->fn, vv->name));
+
+ assertive_bufread (h, mv, sizeof *mv * abs (sv.n_missing_values), 0);
+
+ if (ext->reverse_endian && vv->type == NUMERIC)
+ for (j = 0; j < abs (sv.n_missing_values); j++)
+ bswap_flt64 (&mv[j]);
+
+ if (sv.n_missing_values > 0)
+ {
+ vv->miss_type = sv.n_missing_values;
+ if (vv->type == NUMERIC)
+ for (j = 0; j < sv.n_missing_values; j++)
+ vv->missing[j].f = mv[j];
+ else
+ for (j = 0; j < sv.n_missing_values; j++)
+ memcpy (vv->missing[j].s, &mv[j], vv->width);
+ }
+ else
+ {
+ int x = 0;
+
+ if (vv->type == ALPHA)
+ lose ((ME, _("%s: String variable %s may not have missing "
+ "values specified as a range."), h->fn, vv->name));
+
+ if (mv[0] == ext->lowest)
+ {
+ vv->miss_type = MISSING_LOW;
+ vv->missing[x++].f = mv[1];
+ }
+ else if (mv[1] == ext->highest)
+ {
+ vv->miss_type = MISSING_HIGH;
+ vv->missing[x++].f = mv[0];
+ }
+ else
+ {
+ vv->miss_type = MISSING_RANGE;
+ vv->missing[x++].f = mv[0];
+ vv->missing[x++].f = mv[1];
+ }
+
+ if (sv.n_missing_values == -3)
+ {
+ vv->miss_type += 3;
+ vv->missing[x++].f = mv[2];
+ }
+ }
+ }
+ else
+ vv->miss_type = MISSING_NONE;
+
+ if (!parse_format_spec (h, sv.print, &vv->print, vv)
+ || !parse_format_spec (h, sv.write, &vv->write, vv))
+ goto lossage;
+ }
+
+ /* Some consistency checks. */
+ if (long_string_count != 0)
+ lose ((ME, _("%s: Long string continuation records omitted at end of "
+ "dictionary."), h->fn));
+ if (next_value != ext->case_size)
+ lose ((ME, _("%s: System file header indicates %d variable positions but "
+ "%d were read from file."), h->fn, ext->case_size, next_value));
+ dict->var = xrealloc (dict->var, sizeof *dict->var * dict->nvar);
+
+ /* Construct AVL tree of dictionary in order to speed up later
+ processing and to check for duplicate varnames. */
+ dict->var_by_name = avl_create (NULL, cmp_variable, NULL);
+ for (i = 0; i < dict->nvar; i++)
+ if (NULL != avl_insert (dict->var_by_name, dict->var[i]))
+ lose ((ME, _("%s: Duplicate variable name `%s' within system file."),
+ h->fn, dict->var[i]->name));
+
+ return 1;
+
+lossage:
+ for (i = 0; i < dict->nvar; i++)
+ {
+ free (dict->var[i]->label);
+ free (dict->var[i]);
+ }
+ free (dict->var);
+ if (dict->var_by_name)
+ avl_destroy (dict->var_by_name, NULL);
+ free (dict);
+ ext->dict = NULL;
+
+ return 0;
+}
+
+/* Translates the format spec from sysfile format to internal
+ format. */
+static int
+parse_format_spec (struct file_handle *h, int32 s, struct fmt_spec *v, struct variable *vv)
+{
+ if ((size_t) ((s >> 16) & 0xff)
+ >= sizeof translate_fmt / sizeof *translate_fmt)
+ lose ((ME, _("%s: Bad format specifier byte (%d)."),
+ h->fn, (s >> 16) & 0xff));
+
+ v->type = translate_fmt[(s >> 16) & 0xff];
+ v->w = (s >> 8) & 0xff;
+ v->d = s & 0xff;
+
+ /* FIXME? Should verify the resulting specifier more thoroughly. */
+
+ if (v->type == -1)
+ lose ((ME, _("%s: Bad format specifier byte (%d)."),
+ h->fn, (s >> 16) & 0xff));
+ if ((vv->type == ALPHA) ^ ((formats[v->type].cat & FCAT_STRING) != 0))
+ lose ((ME, _("%s: %s variable %s has %s format specifier %s."),
+ h->fn, vv->type == ALPHA ? _("String") : _("Numeric"),
+ vv->name,
+ formats[v->type].cat & FCAT_STRING ? _("string") : _("numeric"),
+ formats[v->type].name));
+ return 1;
+
+lossage:
+ return 0;
+}
+
+/* Reads value labels from sysfile H and inserts them into the
+ associated dictionary. */
+int
+read_value_labels (struct file_handle * h, struct variable ** var_by_index)
+{
+ struct sfm_fhuser_ext *ext = h->ext; /* File extension record. */
+
+ flt64 *raw_label = NULL; /* Array of raw label values. */
+ struct value_label **cooked_label = NULL; /* Array of cooked labels. */
+ int32 n_labels; /* Number of labels. */
+
+ struct variable **var = NULL; /* Associated variables. */
+ int32 n_vars; /* Number of associated variables. */
+
+ int i;
+
+ /* First step: read the contents of the type 3 record and record its
+ contents. Note that we can't do much with the data since we
+ don't know yet whether it is of numeric or string type. */
+
+ /* Read number of labels. */
+ assertive_bufread (h, &n_labels, sizeof n_labels, 0);
+ if (ext->reverse_endian)
+ bswap_int32 (&n_labels);
+
+ /* Allocate memory. */
+ raw_label = xmalloc (sizeof *raw_label * n_labels);
+ cooked_label = xmalloc (sizeof *cooked_label * n_labels);
+ for (i = 0; i < n_labels; i++)
+ cooked_label[i] = NULL;
+
+ /* Read each value/label tuple. */
+ for (i = 0; i < n_labels; i++)
+ {
+ flt64 value;
+ unsigned char label_len;
+
+ int rem;
+
+ /* Read value, label length. */
+ assertive_bufread (h, &value, sizeof value, 0);
+ assertive_bufread (h, &label_len, 1, 0);
+ memcpy (&raw_label[i], &value, sizeof value);
+
+ /* Read label. */
+ cooked_label[i] = xmalloc (sizeof **cooked_label);
+ cooked_label[i]->s = xmalloc (label_len + 1);
+ assertive_bufread (h, cooked_label[i]->s, label_len, 0);
+ cooked_label[i]->s[label_len] = 0;
+
+ /* Skip padding. */
+ rem = REM_RND_UP (label_len + 1, sizeof (flt64));
+ if (rem)
+ assertive_bufread (h, &value, rem, 0);
+ }
+
+ /* Second step: Read the type 4 record that has the list of
+ variables to which the value labels are to be applied. */
+
+ /* Read record type of type 4 record. */
+ {
+ int32 rec_type;
+
+ assertive_bufread (h, &rec_type, sizeof rec_type, 0);
+ if (ext->reverse_endian)
+ bswap_int32 (&rec_type);
+
+ if (rec_type != 4)
+ lose ((ME, _("%s: Variable index record (type 4) does not immediately "
+ "follow value label record (type 3) as it ought."), h->fn));
+ }
+
+ /* Read number of variables associated with value label from type 4
+ record. */
+ assertive_bufread (h, &n_vars, sizeof n_vars, 0);
+ if (ext->reverse_endian)
+ bswap_int32 (&n_vars);
+ if (n_vars < 1 || n_vars > ext->dict->nvar)
+ lose ((ME, _("%s: Number of variables associated with a value label (%d) "
+ "is not between 1 and the number of variables (%d)."),
+ h->fn, n_vars, ext->dict->nvar));
+
+ /* Allocate storage. */
+ var = xmalloc (sizeof *var * n_vars);
+
+ /* Read the list of variables. */
+ for (i = 0; i < n_vars; i++)
+ {
+ int32 var_index;
+ struct variable *v;
+
+ /* Read variable index, check range. */
+ assertive_bufread (h, &var_index, sizeof var_index, 0);
+ if (ext->reverse_endian)
+ bswap_int32 (&var_index);
+ if (var_index < 1 || var_index > ext->case_size)
+ lose ((ME, _("%s: Variable index associated with value label (%d) is "
+ "not between 1 and the number of values (%d)."),
+ h->fn, var_index, ext->case_size));
+
+ /* Make sure it's a real variable. */
+ v = var_by_index[var_index - 1];
+ if (v == NULL)
+ lose ((ME, _("%s: Variable index associated with value label (%d) refers "
+ "to a continuation of a string variable, not to an actual "
+ "variable."), h->fn, var_index));
+ if (v->type == ALPHA && v->width > MAX_SHORT_STRING)
+ lose ((ME, _("%s: Value labels are not allowed on long string variables "
+ "(%s)."), h->fn, v->name));
+
+ /* Add it to the list of variables. */
+ var[i] = v;
+ }
+
+ /* Type check the variables. */
+ for (i = 1; i < n_vars; i++)
+ if (var[i]->type != var[0]->type)
+ lose ((ME, _("%s: Variables associated with value label are not all of "
+ "identical type. Variable %s has %s type, but variable %s has "
+ "%s type."), h->fn,
+ var[0]->name, var[0]->type == ALPHA ? _("string") : _("numeric"),
+ var[i]->name, var[i]->type == ALPHA ? _("string") : _("numeric")));
+
+ /* Create a value_label for each value/label tuple, now that we know
+ the desired type. */
+ for (i = 0; i < n_labels; i++)
+ {
+ if (var[0]->type == ALPHA)
+ {
+ const int copy_len = min (sizeof (flt64), MAX_SHORT_STRING);
+ memcpy (cooked_label[i]->v.s, (char *) &raw_label[i], copy_len);
+ if (MAX_SHORT_STRING > copy_len)
+ memset (&cooked_label[i]->v.s[copy_len], ' ',
+ MAX_SHORT_STRING - copy_len);
+ } else {
+ cooked_label[i]->v.f = raw_label[i];
+ if (ext->reverse_endian)
+ bswap_flt64 (&cooked_label[i]->v.f);
+ }
+ cooked_label[i]->ref_count = n_vars;
+ }
+
+ /* Assign the value_label's to each variable. */
+ for (i = 0; i < n_vars; i++)
+ {
+ struct variable *v = var[i];
+ int j;
+
+ /* Create AVL tree if necessary. */
+ if (!v->val_lab)
+ v->val_lab = avl_create (NULL, val_lab_cmp, (void *) (v->width));
+
+ /* Add each label to the variable. */
+ for (j = 0; j < n_labels; j++)
+ {
+ struct value_label *old = avl_replace (v->val_lab, cooked_label[j]);
+ if (old == NULL)
+ continue;
+
+ if (var[0]->type == NUMERIC)
+ msg (MW, _("%s: File contains duplicate label for value %g for "
+ "variable %s."), h->fn, cooked_label[j]->v.f, v->name);
+ else
+ msg (MW, _("%s: File contains duplicate label for value `%.*s' "
+ "for variable %s."), h->fn, v->width,
+ cooked_label[j]->v.s, v->name);
+
+ free_value_label (old);
+ }
+ }
+
+ free (cooked_label);
+ free (raw_label);
+ free (var);
+ return 1;
+
+lossage:
+ if (cooked_label)
+ for (i = 0; i < n_labels; i++)
+ if (cooked_label[i])
+ {
+ free (cooked_label[i]->s);
+ free (cooked_label[i]);
+ }
+ free (raw_label);
+ free (var);
+ return 0;
+}
+
+/* Reads NBYTES bytes from the file represented by H. If BUF is
+ non-NULL, uses that as the buffer; otherwise allocates at least
+ MINALLOC bytes. Returns a pointer to the buffer on success, NULL
+ on failure. */
+static void *
+bufread (struct file_handle * h, void *buf, size_t nbytes, size_t minalloc)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+
+ if (buf == NULL)
+ buf = xmalloc (max (nbytes, minalloc));
+ if (1 != fread (buf, nbytes, 1, ext->file))
+ {
+ if (ferror (ext->file))
+ msg (ME, _("%s: Reading system file: %s."), h->fn, strerror (errno));
+ else
+ corrupt_msg (ME, _("%s: Unexpected end of file."), h->fn);
+ return NULL;
+ }
+ return buf;
+}
+
+/* Reads a document record, type 6, from system file H, and sets up
+ the documents and n_documents fields in the associated
+ dictionary. */
+static int
+read_documents (struct file_handle * h)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+ struct dictionary *dict = ext->dict;
+ int32 n_lines;
+
+ if (dict->documents != NULL)
+ lose ((ME, _("%s: System file contains multiple type 6 (document) records."),
+ h->fn));
+
+ assertive_bufread (h, &n_lines, sizeof n_lines, 0);
+ dict->n_documents = n_lines;
+ if (dict->n_documents <= 0)
+ lose ((ME, _("%s: Number of document lines (%ld) must be greater than 0."),
+ h->fn, (long) dict->n_documents));
+
+ dict->documents = bufread (h, NULL, 80 * n_lines, 0);
+ if (dict->documents == NULL)
+ return 0;
+ return 1;
+
+lossage:
+ return 0;
+}
+
+#if GLOBAL_DEBUGGING
+#define DEBUGGING 1
+#include "debug-print.h"
+/* Displays dictionary DICT on stdout. */
+void
+dump_dictionary (struct dictionary * dict)
+{
+ int i;
+
+ debug_printf ((_("dictionary:\n")));
+ for (i = 0; i < dict->nvar; i++)
+ {
+ char print[32];
+ struct variable *v = dict->var[i];
+ int n, j;
+
+ debug_printf ((" var %s", v->name));
+ /*debug_printf (("(indices:%d,%d)", v->index, v->foo));*/
+ debug_printf (("(type:%s,%d)", (v->type == NUMERIC ? _("num")
+ : (v->type == ALPHA ? _("str") : "!!!")),
+ v->width));
+ debug_printf (("(fv:%d,%d)", v->fv, v->nv));
+ /*debug_printf (("(get.fv:%d,%d)", v->get.fv, v->get.nv));*/
+ debug_printf (("(left:%s)(miss:", v->left ? _("left") : _("right")));
+
+ switch (v->miss_type)
+ {
+ case MISSING_NONE:
+ n = 0;
+ debug_printf ((_("none")));
+ break;
+ case MISSING_1:
+ n = 1;
+ debug_printf ((_("one")));
+ break;
+ case MISSING_2:
+ n = 2;
+ debug_printf ((_("two")));
+ break;
+ case MISSING_3:
+ n = 3;
+ debug_printf ((_("three")));
+ break;
+ case MISSING_RANGE:
+ n = 2;
+ debug_printf ((_("range")));
+ break;
+ case MISSING_LOW:
+ n = 1;
+ debug_printf ((_("low")));
+ break;
+ case MISSING_HIGH:
+ n = 1;
+ debug_printf ((_("high")));
+ break;
+ case MISSING_RANGE_1:
+ n = 3;
+ debug_printf ((_("range+1")));
+ break;
+ case MISSING_LOW_1:
+ n = 2;
+ debug_printf ((_("low+1")));
+ break;
+ case MISSING_HIGH_1:
+ n = 2;
+ debug_printf ((_("high+1")));
+ break;
+ default:
+ assert (0);
+ }
+ for (j = 0; j < n; j++)
+ if (v->type == NUMERIC)
+ debug_printf ((",%g", v->missing[j].f));
+ else
+ debug_printf ((",\"%.*s\"", v->width, v->missing[j].s));
+ strcpy (print, fmt_to_string (&v->print));
+ debug_printf ((")(fmt:%s,%s)(lbl:%s)\n",
+ print, fmt_to_string (&v->write),
+ v->label ? v->label : "nolabel"));
+ }
+}
+#endif
+\f
+/* Data reader. */
+
+/* Reads compressed data into H->BUF and sets other pointers
+ appropriately. Returns nonzero only if both no errors occur and
+ data was read. */
+static int
+buffer_input (struct file_handle * h)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+ size_t amt;
+
+ if (ext->buf == NULL)
+ ext->buf = xmalloc (sizeof *ext->buf * 128);
+ amt = fread (ext->buf, sizeof *ext->buf, 128, ext->file);
+ if (ferror (ext->file))
+ {
+ msg (ME, _("%s: Error reading file: %s."), h->fn, strerror (errno));
+ return 0;
+ }
+ ext->ptr = ext->buf;
+ ext->end = &ext->buf[amt];
+ return amt;
+}
+
+/* Reads a single case consisting of compressed data from system file
+ H into the array TEMP[] according to dictionary DICT, and returns
+ nonzero only if successful. */
+/* Data in system files is compressed in the following manner:
+ data values are grouped into sets of eight; each of the eight has
+ one instruction byte, which are output together in an octet; each
+ byte gives a value for that byte or indicates that the value can be
+ found following the instructions. */
+static int
+read_compressed_data (struct file_handle * h, flt64 * temp)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+
+ const unsigned char *p_end = ext->x + sizeof (flt64);
+ unsigned char *p = ext->y;
+
+ const flt64 *temp_beg = temp;
+ const flt64 *temp_end = &temp[ext->case_size];
+
+ for (;;)
+ {
+ for (; p < p_end; p++)
+ switch (*p)
+ {
+ case 0:
+ /* Code 0 is ignored. */
+ continue;
+ case 252:
+ /* Code 252 is end of file. */
+ if (temp_beg != temp)
+ lose ((ME, _("%s: Compressed data is corrupted. Data ends "
+ "partway through a case."), h->fn));
+ goto lossage;
+ case 253:
+ /* Code 253 indicates that the value is stored explicitly
+ following the instruction bytes. */
+ if (ext->ptr == NULL || ext->ptr >= ext->end)
+ if (!buffer_input (h))
+ {
+ lose ((ME, _("%s: Unexpected end of file."), h->fn));
+ goto lossage;
+ }
+ memcpy (temp++, ext->ptr++, sizeof *temp);
+ if (temp >= temp_end)
+ goto winnage;
+ break;
+ case 254:
+ /* Code 254 indicates a string that is all blanks. */
+ memset (temp++, ' ', sizeof *temp);
+ if (temp >= temp_end)
+ goto winnage;
+ break;
+ case 255:
+ /* Code 255 indicates the system-missing value. */
+ *temp = ext->sysmis;
+ if (ext->reverse_endian)
+ bswap_flt64 (temp);
+ temp++;
+ if (temp >= temp_end)
+ goto winnage;
+ break;
+ default:
+ /* Codes 1 through 251 inclusive are taken to indicate a
+ value of (BYTE - BIAS), where BYTE is the byte's value
+ and BIAS is the compression bias (generally 100.0). */
+ *temp = *p - ext->bias;
+ if (ext->reverse_endian)
+ bswap_flt64 (temp);
+ temp++;
+ if (temp >= temp_end)
+ goto winnage;
+ break;
+ }
+
+ /* We have reached the end of this instruction octet. Read
+ another. */
+ if (ext->ptr == NULL || ext->ptr >= ext->end)
+ if (!buffer_input (h))
+ {
+ if (temp_beg != temp)
+ lose ((ME, _("%s: Unexpected end of file."), h->fn));
+ goto lossage;
+ }
+ memcpy (ext->x, ext->ptr++, sizeof *temp);
+ p = ext->x;
+ }
+
+ /* Not reached. */
+ assert (0);
+
+winnage:
+ /* We have filled up an entire record. Update state and return
+ successfully. */
+ ext->y = ++p;
+ return 1;
+
+lossage:
+ /* We have been unsuccessful at filling a record, either through i/o
+ error or through an end-of-file indication. Update state and
+ return unsuccessfully. */
+ return 0;
+}
+
+/* Reads one case from system file H into the value array PERM
+ according to the instructions given in associated dictionary DICT,
+ which must have the get.* elements appropriately set. Returns
+ nonzero only if successful. */
+int
+sfm_read_case (struct file_handle * h, union value * perm, struct dictionary * dict)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+
+ size_t nbytes;
+ flt64 *temp;
+
+ int i;
+
+ /* Make sure the caller remembered to finish polishing the
+ dictionary returned by sfm_read_dictionary(). */
+ assert (dict->nval > 0);
+
+ /* The first concern is to obtain a full case relative to the data
+ file. (Cases in the data file have no particular relationship to
+ cases in the active file.) */
+ nbytes = sizeof *temp * ext->case_size;
+ temp = local_alloc (nbytes);
+
+ if (ext->compressed == 0)
+ {
+ size_t amt = fread (temp, 1, nbytes, ext->file);
+
+ if (amt != nbytes)
+ {
+ if (ferror (ext->file))
+ msg (ME, _("%s: Reading system file: %s."), h->fn, strerror (errno));
+ else if (amt != 0)
+ msg (ME, _("%s: Partial record at end of system file."), h->fn);
+ goto lossage;
+ }
+ }
+ else if (!read_compressed_data (h, temp))
+ goto lossage;
+
+ /* Translate a case in data file format to a case in active file
+ format. */
+ for (i = 0; i < dict->nvar; i++)
+ {
+ struct variable *v = dict->var[i];
+
+ if (v->get.fv == -1)
+ continue;
+
+ if (v->type == NUMERIC)
+ {
+ flt64 src = temp[v->get.fv];
+ if (ext->reverse_endian)
+ bswap_flt64 (&src);
+ perm[v->fv].f = src == ext->sysmis ? SYSMIS : src;
+ }
+ else
+ memcpy (&perm[v->fv].s, &temp[v->get.fv], v->width);
+ }
+
+ local_free (temp);
+ return 1;
+
+lossage:
+ local_free (temp);
+ return 0;
+}
+
+static struct fh_ext_class sfm_r_class =
+{
+ 3,
+ N_("reading as a system file"),
+ sfm_close,
+};
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <errno.h>
+#include <time.h>
+#if HAVE_UNISTD_H
+#include <unistd.h> /* Required by SunOS4. */
+#endif
+#include "alloc.h"
+#include "approx.h"
+#include "avl.h"
+#include "error.h"
+#include "file-handle.h"
+#include "getline.h"
+#include "magic.h"
+#include "misc.h"
+#include "sfm.h"
+#include "sfmP.h"
+#include "str.h"
+#include "var.h"
+#include "version.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+
+/* PORTME: This file may require substantial revision for those
+ systems that don't meet the typical 32-bit integer/64-bit double
+ model. It's kinda hard to tell without having one of them on my
+ desk. */
+
+/* Compression bias used by PSPP. Values between (1 -
+ COMPRESSION_BIAS) and (251 - COMPRESSION_BIAS) inclusive can be
+ compressed. */
+#define COMPRESSION_BIAS 100
+
+/* sfm writer file_handle extension. */
+struct sfm_fhuser_ext
+ {
+ FILE *file; /* Actual file. */
+
+ int compressed; /* 1=compressed, 0=not compressed. */
+ flt64 *buf; /* Buffered data. */
+ flt64 *end; /* Buffer end. */
+ flt64 *ptr; /* Current location in buffer. */
+ unsigned char *x; /* Location in current instruction octet. */
+ unsigned char *y; /* End of instruction octet. */
+ int n_cases; /* Number of cases written so far. */
+
+ char *elem_type; /* ALPHA or NUMERIC for each flt64 element. */
+ };
+
+static struct fh_ext_class sfm_w_class;
+
+static char *append_string_max (char *, const char *, const char *);
+static int write_header (struct sfm_write_info *inf);
+static int bufwrite (struct file_handle *h, const void *buf, size_t nbytes);
+static int write_variable (struct sfm_write_info *inf, struct variable *v);
+static int write_value_labels (struct sfm_write_info *inf, struct variable * s, int index);
+static int write_rec_7_34 (struct sfm_write_info *inf);
+static int write_documents (struct sfm_write_info *inf);
+
+/* Writes the dictionary INF->dict to system file INF->h. The system
+ file is compressed if INF->compress is nonzero. INF->case_size is
+ set to the number of flt64 elements in a single case. Returns
+ nonzero only if successful. */
+int
+sfm_write_dictionary (struct sfm_write_info *inf)
+{
+ struct dictionary *d = inf->dict;
+ struct sfm_fhuser_ext *ext;
+ int i;
+ int index;
+
+ if (inf->h->class != NULL)
+ {
+ msg (ME, _("Cannot write file %s as system file: already opened for %s."),
+ fh_handle_name (inf->h), inf->h->class->name);
+ return 0;
+ }
+
+ msg (VM (1), _("%s: Opening system-file handle %s for writing."),
+ fh_handle_filename (inf->h), fh_handle_name (inf->h));
+
+ /* Open the physical disk file. */
+ inf->h->class = &sfm_w_class;
+ inf->h->ext = ext = xmalloc (sizeof (struct sfm_fhuser_ext));
+ ext->file = fopen (inf->h->norm_fn, "wb");
+ ext->elem_type = NULL;
+ if (ext->file == NULL)
+ {
+ msg (ME, _("An error occurred while opening \"%s\" for writing "
+ "as a system file: %s."), inf->h->fn, strerror (errno));
+ err_cond_fail ();
+ free (ext);
+ return 0;
+ }
+
+ /* Initialize the sfm_fhuser_ext structure. */
+ ext->compressed = inf->compress;
+ ext->buf = ext->ptr = NULL;
+ ext->x = ext->y = NULL;
+ ext->n_cases = 0;
+
+ /* Write the file header. */
+ if (!write_header (inf))
+ goto lossage;
+
+ /* Write basic variable info. */
+ for (i = 0; i < d->nvar; i++)
+ write_variable (inf, d->var[i]);
+
+ /* Write out value labels. */
+ for (index = i = 0; i < d->nvar; i++)
+ {
+ struct variable *v = d->var[i];
+
+ if (!write_value_labels (inf, v, index))
+ goto lossage;
+ index += (v->type == NUMERIC ? 1
+ : DIV_RND_UP (v->width, sizeof (flt64)));
+ }
+
+ if (d->documents != NULL && !write_documents (inf))
+ goto lossage;
+ if (!write_rec_7_34 (inf))
+ goto lossage;
+
+ /* Write record 999. */
+ {
+ struct
+ {
+ int32 rec_type P;
+ int32 filler P;
+ }
+ rec_999;
+
+ rec_999.rec_type = 999;
+ rec_999.filler = 0;
+
+ if (!bufwrite (inf->h, &rec_999, sizeof rec_999))
+ goto lossage;
+ }
+
+ msg (VM (2), _("Wrote system-file header successfully."));
+
+ return 1;
+
+lossage:
+ msg (VM (1), _("Error writing system-file header."));
+ fclose (ext->file);
+ inf->h->class = NULL;
+ inf->h->ext = NULL;
+ free (ext->elem_type);
+ ext->elem_type = NULL;
+ return 0;
+}
+
+/* Returns value of X truncated to two least-significant digits. */
+static int
+rerange (int x)
+{
+ if (x < 0)
+ x = -x;
+ if (x >= 100)
+ x %= 100;
+ return x;
+}
+
+/* Write the sysfile_header header to the system file represented by
+ INF. */
+static int
+write_header (struct sfm_write_info *inf)
+{
+ struct dictionary *d = inf->dict;
+ struct sfm_fhuser_ext *ext = inf->h->ext;
+ struct sysfile_header hdr;
+ char *p;
+ int i;
+
+ time_t t;
+
+ memcpy (hdr.rec_type, "$FL2", 4);
+
+ p = stpcpy (hdr.prod_name, "@(#) SPSS DATA FILE ");
+ p = append_string_max (p, version, &hdr.prod_name[60]);
+ p = append_string_max (p, " - ", &hdr.prod_name[60]);
+ p = append_string_max (p, host_system, &hdr.prod_name[60]);
+ memset (p, ' ', &hdr.prod_name[60] - p);
+
+ hdr.layout_code = 2;
+
+ hdr.case_size = 0;
+ for (i = 0; i < d->nvar; i++)
+ {
+ struct variable *v = d->var[i];
+ hdr.case_size += (v->type == NUMERIC ? 1
+ : DIV_RND_UP (v->width, sizeof (flt64)));
+ }
+ inf->case_size = hdr.case_size;
+
+ p = ext->elem_type = xmalloc (inf->case_size);
+ for (i = 0; i < d->nvar; i++)
+ {
+ struct variable *v = d->var[i];
+ int count = (v->type == NUMERIC ? 1
+ : DIV_RND_UP (v->width, sizeof (flt64)));
+ while (count--)
+ *p++ = v->type;
+ }
+
+ hdr.compressed = inf->compress;
+
+ update_weighting (d);
+ if (d->weight_index != -1)
+ {
+ int recalc_weight_index = 1;
+
+ for (i = 0; i < d->weight_index; i++)
+ {
+ struct variable *v = d->var[i];
+ recalc_weight_index += (v->type == NUMERIC ? 1
+ : DIV_RND_UP (v->width, sizeof (flt64)));
+ }
+ hdr.weight_index = recalc_weight_index;
+ }
+ else
+ hdr.weight_index = 0;
+
+ hdr.ncases = -1;
+ hdr.bias = COMPRESSION_BIAS;
+
+ if ((time_t) - 1 == time (&t))
+ {
+ memcpy (hdr.creation_date, "01 Jan 70", 9);
+ memcpy (hdr.creation_time, "00:00:00", 8);
+ }
+ else
+ {
+ static const char *month_name[12] =
+ {
+ "Jan", "Feb", "Mar", "Apr", "May", "Jun",
+ "Jul", "Aug", "Sep", "Oct", "Nov", "Dec",
+ };
+ struct tm *tmp = localtime (&t);
+ int day = rerange (tmp->tm_mday);
+ int mon = rerange (tmp->tm_mon + 1);
+ int year = rerange (tmp->tm_year);
+ int hour = rerange (tmp->tm_hour + 1);
+ int min = rerange (tmp->tm_min + 1);
+ int sec = rerange (tmp->tm_sec + 1);
+ char buf[10];
+
+ sprintf (buf, "%02d %s %02d", day, month_name[mon - 1], year);
+ memcpy (hdr.creation_date, buf, sizeof hdr.creation_date);
+ sprintf (buf, "%02d:%02d:%02d", hour - 1, min - 1, sec - 1);
+ memcpy (hdr.creation_time, buf, sizeof hdr.creation_time);
+ }
+
+ st_bare_pad_copy (hdr.file_label, d->label ? d->label : "",
+ sizeof hdr.file_label);
+ memset (hdr.padding, 0, sizeof hdr.padding);
+
+ if (!bufwrite (inf->h, &hdr, sizeof hdr))
+ return 0;
+ return 1;
+}
+
+/* Translates format spec from internal form in SRC to system file
+ format in DEST. */
+static inline void
+write_format_spec (struct fmt_spec *src, int32 *dest)
+{
+ *dest = (formats[src->type].spss << 16) | (src->w << 8) | src->d;
+}
+
+/* Write the variable record(s) for primary variable P and secondary
+ variable S to the system file represented by INF. */
+static int
+write_variable (struct sfm_write_info *inf, struct variable *v)
+{
+ struct sysfile_variable sv;
+
+ /* Missing values. */
+ flt64 m[3]; /* Missing value values. */
+ int nm; /* Number of missing values, possibly negative. */
+
+ sv.rec_type = 2;
+ sv.type = (v->type == NUMERIC ? 0 : v->width);
+ sv.has_var_label = (v->label != NULL);
+
+ switch (v->miss_type)
+ {
+ case MISSING_NONE:
+ nm = 0;
+ break;
+ case MISSING_1:
+ case MISSING_2:
+ case MISSING_3:
+ for (nm = 0; nm < v->miss_type; nm++)
+ m[nm] = v->missing[nm].f;
+ break;
+ case MISSING_RANGE:
+ m[0] = v->missing[0].f;
+ m[1] = v->missing[1].f;
+ nm = -2;
+ break;
+ case MISSING_LOW:
+ m[0] = second_lowest_flt64;
+ m[1] = v->missing[0].f;
+ nm = -2;
+ break;
+ case MISSING_HIGH:
+ m[0] = v->missing[0].f;
+ m[1] = FLT64_MAX;
+ nm = -2;
+ break;
+ case MISSING_RANGE_1:
+ m[0] = v->missing[0].f;
+ m[1] = v->missing[1].f;
+ m[2] = v->missing[2].f;
+ nm = -3;
+ break;
+ case MISSING_LOW_1:
+ m[0] = second_lowest_flt64;
+ m[1] = v->missing[0].f;
+ m[2] = v->missing[1].f;
+ nm = -3;
+ break;
+ case MISSING_HIGH_1:
+ m[0] = v->missing[0].f;
+ m[1] = second_lowest_flt64;
+ m[2] = v->missing[1].f;
+ nm = -3;
+ break;
+ default:
+ assert (0);
+ }
+
+ sv.n_missing_values = nm;
+ write_format_spec (&v->print, &sv.print);
+ write_format_spec (&v->write, &sv.write);
+ memcpy (sv.name, v->name, strlen (v->name));
+ memset (&sv.name[strlen (v->name)], ' ', 8 - strlen (v->name));
+ if (!bufwrite (inf->h, &sv, sizeof sv))
+ return 0;
+
+ if (v->label)
+ {
+ struct label
+ {
+ int32 label_len P;
+ char label[120] P;
+ }
+ l;
+
+ int ext_len;
+
+ l.label_len = min (strlen (v->label), 120);
+ ext_len = ROUND_UP (l.label_len, sizeof l.label_len);
+ memcpy (l.label, v->label, l.label_len);
+ memset (&l.label[l.label_len], ' ', ext_len - l.label_len);
+
+ if (!bufwrite (inf->h, &l, offsetof (struct label, label) + ext_len))
+ return 0;
+ }
+
+ if (nm && !bufwrite (inf->h, m, sizeof *m * nm))
+ return 0;
+
+ if (v->type == ALPHA && v->width > (int) sizeof (flt64))
+ {
+ int i;
+ int pad_count;
+
+ sv.type = -1;
+ sv.has_var_label = 0;
+ sv.n_missing_values = 0;
+ memset (&sv.print, 0, sizeof sv.print);
+ memset (&sv.write, 0, sizeof sv.write);
+ memset (&sv.name, 0, sizeof sv.name);
+
+ pad_count = DIV_RND_UP (v->width, (int) sizeof (flt64)) - 1;
+ for (i = 0; i < pad_count; i++)
+ if (!bufwrite (inf->h, &sv, sizeof sv))
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Writes the value labels for variable V having system file variable
+ index INDEX to the system file associated with INF. Returns
+ nonzero only if successful. */
+static int
+write_value_labels (struct sfm_write_info * inf, struct variable *v, int index)
+{
+ struct value_label_rec
+ {
+ int32 rec_type P;
+ int32 n_labels P;
+ flt64 labels[1] P;
+ };
+
+ struct variable_index_rec
+ {
+ int32 rec_type P;
+ int32 n_vars P;
+ int32 vars[1] P;
+ };
+
+ avl_traverser i;
+ struct value_label_rec *vlr;
+ struct variable_index_rec vir;
+ struct value_label *vl;
+ size_t vlr_size;
+ flt64 *loc;
+ avl_traverser_init (i);
+
+ if (v->val_lab == NULL || avl_count (v->val_lab) == 0)
+ return 1;
+
+ /* Pass 1: Count bytes. */
+ vlr_size = (sizeof (struct value_label_rec)
+ + sizeof (flt64) * (avl_count (v->val_lab) - 1));
+ while (NULL != (vl = avl_traverse (v->val_lab, &i)))
+ vlr_size += ROUND_UP (strlen (vl->s) + 1, sizeof (flt64));
+
+ /* Pass 2: Copy bytes. */
+ vlr = local_alloc (vlr_size);
+ vlr->rec_type = 3;
+ vlr->n_labels = avl_count (v->val_lab);
+ loc = vlr->labels;
+ while (NULL != (vl = avl_traverse (v->val_lab, &i)))
+ {
+ int len = strlen (vl->s);
+
+ *loc++ = vl->v.f;
+ *(unsigned char *) loc = len;
+ memcpy (&((unsigned char *) loc)[1], vl->s, len);
+ memset (&((unsigned char *) loc)[1 + len], ' ',
+ REM_RND_UP (len + 1, sizeof (flt64)));
+ loc += DIV_RND_UP (len + 1, sizeof (flt64));
+ }
+
+ if (!bufwrite (inf->h, vlr, vlr_size))
+ {
+ local_free (vlr);
+ return 0;
+ }
+ local_free (vlr);
+
+ vir.rec_type = 4;
+ vir.n_vars = 1;
+ vir.vars[0] = index + 1;
+ if (!bufwrite (inf->h, &vir, sizeof vir))
+ return 0;
+
+ return 1;
+}
+
+/* Writes record type 6, document record. */
+static int
+write_documents (struct sfm_write_info * inf)
+{
+ struct dictionary *d = inf->dict;
+ struct
+ {
+ int32 rec_type P; /* Always 6. */
+ int32 n_lines P; /* Number of lines of documents. */
+ }
+ rec_6;
+
+ rec_6.rec_type = 6;
+ rec_6.n_lines = d->n_documents;
+ if (!bufwrite (inf->h, &rec_6, sizeof rec_6))
+ return 0;
+ if (!bufwrite (inf->h, d->documents, 80 * d->n_documents))
+ return 0;
+
+ return 1;
+}
+
+/* Writes record type 7, subtypes 3 and 4. */
+static int
+write_rec_7_34 (struct sfm_write_info * inf)
+{
+ struct
+ {
+ int32 rec_type_3 P;
+ int32 subtype_3 P;
+ int32 data_type_3 P;
+ int32 n_elem_3 P;
+ int32 elem_3[8] P;
+ int32 rec_type_4 P;
+ int32 subtype_4 P;
+ int32 data_type_4 P;
+ int32 n_elem_4 P;
+ flt64 elem_4[3] P;
+ }
+ rec_7;
+
+ /* Components of the version number, from major to minor. */
+ int version_component[3];
+
+ /* Used to step through the version string. */
+ char *p;
+
+ /* Parses the version string, which is assumed to be of the form
+ #.#x, where each # is a string of digits, and x is a single
+ letter. */
+ version_component[0] = strtol (bare_version, &p, 10);
+ if (*p == '.')
+ p++;
+ version_component[1] = strtol (bare_version, &p, 10);
+ version_component[2] = (isalpha ((unsigned char) *p)
+ ? tolower ((unsigned char) *p) - 'a' : 0);
+
+ rec_7.rec_type_3 = 7;
+ rec_7.subtype_3 = 3;
+ rec_7.data_type_3 = sizeof (int32);
+ rec_7.n_elem_3 = 8;
+ rec_7.elem_3[0] = version_component[0];
+ rec_7.elem_3[1] = version_component[1];
+ rec_7.elem_3[2] = version_component[2];
+ rec_7.elem_3[3] = -1;
+
+ /* PORTME: 1=IEEE754, 2=IBM 370, 3=DEC VAX E. */
+#if FPREP==FPREP_IEEE754
+ rec_7.elem_3[4] = 1;
+#else
+#error Floating-point representation unknown here.
+#endif
+
+ rec_7.elem_3[5] = 1;
+
+ /* PORTME: 1=big-endian, 2=little-endian. */
+ if (endian == BIG)
+ rec_7.elem_3[6] = 1;
+ else if (endian == LITTLE)
+ rec_7.elem_3[6] = 2;
+ else
+ rec_7.elem_3[6] = 0;
+
+ /* PORTME: 1=EBCDIC, 2=7-bit ASCII, 3=8-bit ASCII, 4=DEC Kanji. */
+ rec_7.elem_3[7] = 2;
+
+ rec_7.rec_type_4 = 7;
+ rec_7.subtype_4 = 4;
+ rec_7.data_type_4 = sizeof (flt64);
+ rec_7.n_elem_4 = 3;
+ rec_7.elem_4[0] = -FLT64_MAX;
+ rec_7.elem_4[1] = FLT64_MAX;
+ rec_7.elem_4[2] = second_lowest_flt64;
+
+ if (!bufwrite (inf->h, &rec_7, sizeof rec_7))
+ return 0;
+ return 1;
+}
+
+/* Write NBYTES starting at BUF to the system file represented by
+ H. */
+static int
+bufwrite (struct file_handle * h, const void *buf, size_t nbytes)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+
+ assert (buf);
+ if (1 != fwrite (buf, nbytes, 1, ext->file))
+ {
+ msg (ME, _("%s: Writing system file: %s."), h->fn, strerror (errno));
+ return 0;
+ }
+ return 1;
+}
+
+/* Copies string DEST to SRC with the proviso that DEST does not reach
+ byte END; no null terminator is copied. Returns a pointer to the
+ byte after the last byte copied. */
+static char *
+append_string_max (char *dest, const char *src, const char *end)
+{
+ int nbytes = min (end - dest, (int) strlen (src));
+ memcpy (dest, src, nbytes);
+ return dest + nbytes;
+}
+
+/* Makes certain that the compression buffer of H has room for another
+ element. If there's not room, pads out the current instruction
+ octet with zero and dumps out the buffer. */
+static inline int
+ensure_buf_space (struct file_handle *h)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+
+ if (ext->ptr >= ext->end)
+ {
+ memset (ext->x, 0, ext->y - ext->x);
+ ext->x = ext->y;
+ ext->ptr = ext->buf;
+ if (!bufwrite (h, ext->buf, sizeof *ext->buf * 128))
+ return 0;
+ }
+ return 1;
+}
+
+/* Writes case ELEM consisting of N_ELEM flt64 elements to the system
+ file represented by H. Return success. */
+int
+sfm_write_case (struct file_handle * h, const flt64 *elem, int n_elem)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+ const flt64 *end_elem = &elem[n_elem];
+ char *elem_type = ext->elem_type;
+
+ ext->n_cases++;
+
+ if (ext->compressed == 0)
+ return bufwrite (h, elem, sizeof *elem * n_elem);
+
+ if (ext->buf == NULL)
+ {
+ ext->buf = xmalloc (sizeof *ext->buf * 128);
+ ext->ptr = ext->buf;
+ ext->end = &ext->buf[128];
+ ext->x = (unsigned char *) (ext->ptr++);
+ ext->y = (unsigned char *) (ext->ptr);
+ }
+ for (; elem < end_elem; elem++, elem_type++)
+ {
+ if (ext->x >= ext->y)
+ {
+ if (!ensure_buf_space (h))
+ return 0;
+ ext->x = (unsigned char *) (ext->ptr++);
+ ext->y = (unsigned char *) (ext->ptr);
+ }
+
+ if (*elem_type == NUMERIC)
+ {
+ if (*elem == -FLT64_MAX)
+ {
+ *ext->x++ = 255;
+ continue;
+ }
+ else
+ {
+ int value = *elem < 0 ? *elem - EPSILON : *elem + EPSILON;
+
+ if (value >= 1 - COMPRESSION_BIAS
+ && value <= 251 - COMPRESSION_BIAS
+ && approx_eq (value, *elem))
+ {
+ *ext->x++ = value + COMPRESSION_BIAS;
+ continue;
+ }
+ }
+ }
+ else
+ {
+ if (0 == memcmp ((char *) elem,
+ " ",
+ sizeof (flt64)))
+ {
+ *ext->x++ = 254;
+ continue;
+ }
+ }
+
+ *ext->x++ = 253;
+ if (!ensure_buf_space (h))
+ return 0;
+ *ext->ptr++ = *elem;
+ }
+
+ return 1;
+}
+
+/* Closes a system file after we're done with it. */
+static void
+sfm_close (struct file_handle * h)
+{
+ struct sfm_fhuser_ext *ext = h->ext;
+
+ if (ext->buf != NULL && ext->ptr > ext->buf)
+ {
+ memset (ext->x, 0, ext->y - ext->x);
+ bufwrite (h, ext->buf, (ext->ptr - ext->buf) * sizeof *ext->buf);
+ }
+
+ /* Attempt to seek back to the beginning in order to write the
+ number of cases. If that's not possible (i.e., we're writing to
+ a tty or a pipe), then it's not a big deal because we wrote the
+ code that indicates an unknown number of cases. */
+ if (0 == fseek (ext->file, offsetof (struct sysfile_header, ncases),
+ SEEK_SET))
+ {
+ int32 n_cases = ext->n_cases;
+
+ /* I don't really care about the return value: it doesn't matter
+ whether this data is written. This is the only situation in
+ which you will see me fail to check a return value. */
+ fwrite (&n_cases, sizeof n_cases, 1, ext->file);
+ }
+
+ if (EOF == fclose (ext->file))
+ msg (ME, _("%s: Closing system file: %s."), h->fn, strerror (errno));
+ free (ext->buf);
+
+ free (ext->elem_type);
+ free (ext);
+}
+
+static struct fh_ext_class sfm_w_class =
+{
+ 4,
+ N_("writing as a system file"),
+ sfm_close,
+};
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !sfm_h
+#define sfm_h 1
+
+/* System file manager (sfm).
+
+ This module is in charge of reading and writing system files. For
+ now, only ordinary system files are supported; in the future, PC+
+ compatible system files should be supported, too. sfm is an
+ fhuser, so see file-handle.h for the fhuser interface. */
+
+/* Information produced by sfm_read_dictionary() that doesn't fit into
+ a dictionary struct. */
+struct sfm_read_info
+ {
+ char creation_date[10]; /* `dd mmm yy' plus a null. */
+ char creation_time[9]; /* `hh:mm:ss' plus a null. */
+ int endianness; /* BIG or LITTLE. */
+ int compressed; /* 0=no, 1=yes. */
+ int ncases; /* -1 if unknown. */
+ char product[61]; /* Product name plus a null. */
+ };
+
+struct dictionary;
+struct file_handle;
+union value;
+
+struct dictionary *sfm_read_dictionary (struct file_handle *,
+ struct sfm_read_info *);
+int sfm_read_case (struct file_handle *, union value *, struct dictionary *);
+void sfm_maybe_close (struct file_handle *);
+
+/* Information needed by sfm_write_dictionary(). */
+struct sfm_write_info
+ {
+ /* Read by sfm_write_dictionary(). */
+ struct file_handle *h; /* File handle. */
+ struct dictionary *dict; /* Primary dictionary. */
+ int compress; /* 1=compress, 0=do not compress. */
+
+ /* Written by sfm_write_dictionary(). */
+ int case_size; /* Number of flt64 elements per case. */
+ };
+
+int sfm_write_dictionary (struct sfm_write_info *);
+int sfm_write_case (struct file_handle *, const flt64* elem, int n_elem);
+
+#endif /* !sfm_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* PORTME: There might easily be alignment problems with some of these
+ structures. */
+
+/* This attribute might avoid some problems. On the other hand... */
+#define P __attribute__((packed))
+
+#if __BORLANDC__
+#pragma option -a- /* Turn off alignment. */
+#endif
+
+/* Record Type 1: General Information. */
+struct sysfile_header
+ {
+ char rec_type[4] P; /* Record-type code, "$FL2". */
+ char prod_name[60] P; /* Product identification. */
+ int32 layout_code P; /* 2. */
+ int32 case_size P; /* Number of `value's per case. */
+ int32 compressed P; /* 1=compressed, 0=not compressed. */
+ int32 weight_index P; /* 1-based index of weighting var, or zero. */
+ int32 ncases P; /* Number of cases, -1 if unknown. */
+ flt64 bias P; /* Compression bias (100.0). */
+ char creation_date[9] P; /* `dd mmm yy' creation date of file. */
+ char creation_time[8] P; /* `hh:mm:ss' 24-hour creation time. */
+ char file_label[64] P; /* File label. */
+ char padding[3] P; /* Ignored padding. */
+ };
+
+/* Record Type 2: Variable. */
+struct sysfile_variable
+ {
+ int32 rec_type P; /* 2. */
+ int32 type P; /* 0=numeric, 1-255=string width,
+ -1=continued string. */
+ int32 has_var_label P; /* 1=has a variable label, 0=doesn't. */
+ int32 n_missing_values P; /* Missing value code of -3,-2,0,1,2, or 3. */
+ int32 print P; /* Print format. */
+ int32 write P; /* Write format. */
+ char name[8] P; /* Variable name. */
+ /* The rest of the structure varies. */
+ };
+
+#if __BORLANDC__
+#pragma -a4
+#endif
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdio.h>
+#include "output.h"
+#include "som.h"
+/*#undef DEBUGGING*/
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+
+/* Table. */
+int table_num = 1;
+int subtable_num;
+\f
+/* Increments table_num so different procedures' output can be
+ distinguished. */
+void
+som_new_series (void)
+{
+ if (subtable_num != 0)
+ {
+ table_num++;
+ subtable_num = 0;
+ }
+}
+
+/* Ejects the paper for all active devices. */
+void
+som_eject_page (void)
+{
+ struct outp_driver *d;
+
+ for (d = outp_drivers (NULL); d; d = outp_drivers (d))
+ outp_eject_page (d);
+}
+
+/* Skip down a single line on all active devices. */
+void
+som_blank_line (void)
+{
+ struct outp_driver *d;
+
+ for (d = outp_drivers (NULL); d; d = outp_drivers (d))
+ if (d->page_open && d->cp_y != 0)
+ d->cp_y += d->font_height;
+}
+\f
+/* Driver. */
+struct outp_driver *d;
+
+/* Table. */
+struct som_table *t;
+
+/* Flags. */
+static unsigned flags;
+
+/* Number of columns, rows. */
+static int nc, nr;
+
+/* Number of columns or rows in left, right, top, bottom headers. */
+static int hl, hr, ht, hb;
+
+/* Column style. */
+static int cs;
+
+/* Table height, width. */
+static int th, tw;
+
+static void render_columns (void);
+static void render_simple (void);
+static void render_segments (void);
+
+static void output_table (struct outp_driver *, struct som_table *);
+
+/* Output table T to appropriate output devices. */
+void
+som_submit (struct som_table *t)
+{
+#if GLOBAL_DEBUGGING
+ static int entry;
+
+ assert (entry++ == 0);
+#endif
+
+ t->class->table (t);
+ t->class->flags (&flags);
+ t->class->count (&nc, &nr);
+ t->class->headers (&hl, &hr, &ht, &hb);
+
+#if GLOBAL_DEBUGGING
+ if (hl + hr > nc || ht + hb > nr)
+ {
+ printf ("headers: (l,r)=(%d,%d), (t,b)=(%d,%d) in table size (%d,%d)\n",
+ hl, hr, ht, hb, nc, nr);
+ abort ();
+ }
+ else if (hl + hr == nc)
+ printf ("warning: headers (l,r)=(%d,%d) in table width %d\n", hl, hr, nc);
+ else if (ht + hb == nr)
+ printf ("warning: headers (t,b)=(%d,%d) in table height %d\n", ht, hb, nr);
+#endif
+
+ t->class->columns (&cs);
+
+ if (!(flags & SOMF_NO_TITLE))
+ subtable_num++;
+
+ {
+ struct outp_driver *d;
+
+ for (d = outp_drivers (NULL); d; d = outp_drivers (d))
+ output_table (d, t);
+ }
+
+#if GLOBAL_DEBUGGING
+ assert (--entry == 0);
+#endif
+}
+
+/* Output table TABLE to driver DRIVER. */
+static void
+output_table (struct outp_driver *driver, struct som_table *table)
+{
+ d = driver;
+ t = table;
+
+ assert (d->driver_open);
+ if (!d->page_open && !d->class->open_page (d))
+ {
+ d->device = OUTP_DEV_DISABLED;
+ return;
+ }
+
+ if (d->class->special)
+ {
+ driver->class->submit (d, t);
+ return;
+ }
+
+ t->class->driver (d);
+ t->class->area (&tw, &th);
+
+ if (!(flags & SOMF_NO_SPACING) && d->cp_y != 0)
+ d->cp_y += d->font_height;
+
+ if (cs != SOM_COL_NONE
+ && 2 * (tw + d->prop_em_width) <= d->width
+ && nr - (ht + hb) > 5)
+ render_columns ();
+ else if (tw < d->width && th + d->cp_y < d->length)
+ render_simple ();
+ else
+ render_segments ();
+}
+
+/* Render the table into multiple columns. */
+static void
+render_columns (void)
+{
+ int y0, y1;
+ int max_len = 0;
+ int index = 0;
+
+ assert (cs == SOM_COL_DOWN);
+ assert (d->cp_x == 0);
+
+ for (y0 = ht; y0 < nr - hb; y0 = y1)
+ {
+ int len;
+
+ t->class->cumulate (SOM_ROWS, y0, &y1, d->length - d->cp_y, &len);
+
+ if (y0 == y1)
+ {
+ assert (d->cp_y);
+ outp_eject_page (d);
+ } else {
+ if (len > max_len)
+ max_len = len;
+
+ t->class->title (index++, 0);
+ t->class->render (0, y0, nc, y1);
+
+ d->cp_x += tw + 2 * d->prop_em_width;
+ if (d->cp_x + tw > d->width)
+ {
+ d->cp_x = 0;
+ d->cp_y += max_len;
+ max_len = 0;
+ }
+ }
+ }
+
+ if (d->cp_x > 0)
+ {
+ d->cp_x = 0;
+ d->cp_y += max_len;
+ }
+}
+
+/* Render the table by itself on the current page. */
+static void
+render_simple (void)
+{
+ assert (d->cp_x == 0);
+ assert (tw < d->width && th + d->cp_y < d->length);
+
+ t->class->title (0, 0);
+ t->class->render (hl, ht, nc - hr, nr - hb);
+ d->cp_y += th;
+}
+
+/* General table breaking routine. */
+static void
+render_segments (void)
+{
+ int count = 0;
+
+ int x_index;
+ int x0, x1;
+
+ assert (d->cp_x == 0);
+
+ for (x_index = 0, x0 = hl; x0 < nc - hr; x0 = x1, x_index++)
+ {
+ int y_index;
+ int y0, y1;
+
+ t->class->cumulate (SOM_COLUMNS, x0, &x1, d->width, NULL);
+ if (x_index == 0 && x1 != nc - hr)
+ x_index++;
+
+ for (y_index = 0, y0 = ht; y0 < nr - hb; y0 = y1, y_index++)
+ {
+ int len;
+
+ if (count++ != 0 && d->cp_y != 0)
+ d->cp_y += d->font_height;
+
+ t->class->cumulate (SOM_ROWS, y0, &y1, d->length - d->cp_y, &len);
+ if (y_index == 0 && y1 != nr - hb)
+ y_index++;
+
+ if (y0 == y1)
+ {
+ assert (d->cp_y);
+ outp_eject_page (d);
+ } else {
+ t->class->title (x_index ? x_index : y_index,
+ x_index ? y_index : 0);
+ t->class->render (x0, y0, x1, y1);
+
+ d->cp_y += len;
+ }
+ }
+ }
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !som_h
+#define som_h 1
+
+/* Structured Output Manager.
+
+ som considers the output stream to be a series of tables. Each
+ table is made up of a rectangular grid of cells. Cells can be
+ joined to form larger cells. Rows and columns can be separated by
+ rules of various types. Tables too large to fit on a single page
+ will be divided into sections. Rows and columns can be designated
+ as headers, which causes them to be repeated in each section.
+
+ Every table is an instance of a particular table class. A table
+ class is responsible for keeping track of cell data, for handling
+ requests from the som, and finally for rendering cell data to the
+ output drivers. Tables may implement these operations in any way
+ desired, and in fact almost every operation performed by som may be
+ overridden in a table class. */
+
+/* Table. */
+struct som_table
+ {
+ struct som_table_class *class; /* Table class. */
+ void *ext; /* Owned by table class. */
+ };
+
+/* Group styles. */
+enum
+ {
+ SOM_COL_NONE, /* No columns. */
+ SOM_COL_DOWN /* Columns down first. */
+ };
+
+/* Cumulation types. */
+enum
+ {
+ SOM_ROWS, SOM_ROW = SOM_ROWS, /* Rows. */
+ SOM_COLUMNS, SOM_COLUMN = SOM_COLUMNS /* Columns. */
+ };
+
+/* Flags. */
+enum
+ {
+ SOMF_NONE = 0,
+ SOMF_NO_SPACING = 01, /* No spacing before the table. */
+ SOMF_NO_TITLE = 02 /* No title. */
+ };
+
+/* Table class. */
+struct outp_driver;
+struct som_table_class
+ {
+ /* Set table, driver. */
+ void (*table) (struct som_table *);
+ void (*driver) (struct outp_driver *);
+
+ /* Query columns and rows. */
+ void (*count) (int *n_columns, int *n_rows);
+ void (*area) (int *horiz, int *vert);
+ void (*width) (int *columns);
+ void (*height) (int *rows);
+ void (*columns) (int *style);
+ int (*breakable) (int row); /* ? */
+ void (*headers) (int *l, int *r, int *t, int *b);
+ void (*join) (int *(column[2]), int *(row[2])); /* ? */
+ void (*cumulate) (int cumtype, int start, int *end, int max, int *actual);
+ void (*flags) (unsigned *);
+
+ /* Set columns and rows. */
+ void (*set_width) (int column, int width); /* ? */
+ void (*set_height) (int row, int height); /* ? */
+
+ /* Rendering. */
+ void (*title) (int x, int y);
+ void (*render) (int x1, int y1, int x2, int y2);
+ };
+
+/* Table indexes. */
+extern int table_num;
+extern int subtable_num;
+
+/* Submission. */
+void som_new_series (void);
+void som_submit (struct som_table *t);
+
+/* Miscellaneous. */
+void som_eject_page (void);
+void som_blank_line (void);
+
+#endif /* som_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+#include "alloc.h"
+#include "approx.h"
+#include "command.h"
+#include "error.h"
+#include "expr.h"
+#include "heap.h"
+#include "lexer.h"
+#include "misc.h"
+#include "sort.h"
+#include "str.h"
+#include "var.h"
+#include "vfm.h"
+#include "vfmP.h"
+
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#if HAVE_SYS_TYPES_H
+#include <sys/types.h>
+#endif
+
+#if HAVE_SYS_STAT_H
+#include <sys/stat.h>
+#endif
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+/* Variables to sort. */
+struct variable **v_sort;
+int nv_sort;
+
+/* Used when internal-sorting to a separate file. */
+static struct case_list **separate_case_tab;
+
+/* Exported by qsort.c. */
+void blp_quicksort (void *pbase, size_t total_elems, size_t size,
+ int (*cmp) (const void *, const void *),
+ void *temp_buf);
+
+/* Other prototypes. */
+static int compare_case_lists (const void *, const void *);
+static int do_internal_sort (int separate);
+static int do_external_sort (int separate);
+int parse_sort_variables (void);
+void read_sort_output (int (*write_case) (void));
+
+/* Performs the SORT CASES procedures. */
+int
+cmd_sort_cases (void)
+{
+ /* First, just parse the command. */
+ lex_match_id ("SORT");
+ lex_match_id ("CASES");
+ lex_match (T_BY);
+
+ if (!parse_sort_variables ())
+ return CMD_FAILURE;
+
+ cancel_temporary ();
+
+ /* Then it's time to do the actual work. There are two cases:
+
+ (internal sort) All the data is in memory. In this case, we
+ perform an EXECUTE to get the data into the desired form, then
+ sort the cases in place, if it is still all in memory.
+
+ (external sort) The data is not in memory. It may be coming from
+ a system file or other data file, etc. In any case, it is now
+ time to perform an external sort. This is better explained in
+ do_external_sort(). */
+
+ /* Do all this dirty work. */
+ {
+ int success = sort_cases (0);
+ free (v_sort);
+ if (success)
+ return lex_end_of_command ();
+ else
+ return CMD_FAILURE;
+ }
+}
+
+/* Parses a list of sort variables into v_sort and nv_sort. */
+int
+parse_sort_variables (void)
+{
+ v_sort = NULL;
+ nv_sort = 0;
+ do
+ {
+ int prev_nv_sort = nv_sort;
+ int order = SRT_ASCEND;
+
+ if (!parse_variables (&default_dict, &v_sort, &nv_sort,
+ PV_NO_DUPLICATE | PV_APPEND | PV_NO_SCRATCH))
+ return 0;
+ if (lex_match ('('))
+ {
+ if (lex_match_id ("D") || lex_match_id ("DOWN"))
+ order = SRT_DESCEND;
+ else if (!lex_match_id ("A") && !lex_match_id ("UP"))
+ {
+ free (v_sort);
+ msg (SE, _("`A' or `D' expected inside parentheses."));
+ return 0;
+ }
+ if (!lex_match (')'))
+ {
+ free (v_sort);
+ msg (SE, _("`)' expected."));
+ return 0;
+ }
+ }
+ for (; prev_nv_sort < nv_sort; prev_nv_sort++)
+ v_sort[prev_nv_sort]->p.srt.order = order;
+ }
+ while (token != '.' && token != '/');
+
+ return 1;
+}
+
+/* Sorts the active file based on the key variables specified in
+ global variables v_sort and nv_sort. The output is either to the
+ active file, if SEPARATE is zero, or to a separate file, if
+ SEPARATE is nonzero. In the latter case the output cases can be
+ read with a call to read_sort_output(). (In the former case the
+ output cases should be dealt with through the usual vfm interface.)
+
+ The caller is responsible for freeing v_sort[]. */
+int
+sort_cases (int separate)
+{
+ assert (separate_case_tab == NULL);
+
+ /* Not sure this is necessary but it's good to be safe. */
+ if (separate && vfm_source == &sort_stream)
+ procedure (NULL, NULL, NULL);
+
+ /* SORT CASES cancels PROCESS IF. */
+ expr_free (process_if_expr);
+ process_if_expr = NULL;
+
+ if (do_internal_sort (separate))
+ return 1;
+
+ page_to_disk ();
+ return do_external_sort (separate);
+}
+
+/* If a reasonable situation is set up, do an internal sort of the
+ data. Return success. */
+static int
+do_internal_sort (int separate)
+{
+ if (vfm_source != &vfm_disk_stream)
+ {
+ if (vfm_source != &vfm_memory_stream)
+ procedure (NULL, NULL, NULL);
+ if (vfm_source == &vfm_memory_stream)
+ {
+ struct case_list **case_tab = malloc (sizeof *case_tab
+ * (vfm_source_info.ncases + 1));
+ if (vfm_source_info.ncases == 0)
+ {
+ free (case_tab);
+ return 1;
+ }
+ if (case_tab != NULL)
+ {
+ struct case_list *clp = memory_source_cases;
+ struct case_list **ctp = case_tab;
+ int i;
+
+ for (; clp; clp = clp->next)
+ *ctp++ = clp;
+ qsort (case_tab, vfm_source_info.ncases, sizeof *case_tab,
+ compare_case_lists);
+
+ if (!separate)
+ {
+ memory_source_cases = case_tab[0];
+ for (i = 1; i < vfm_source_info.ncases; i++)
+ case_tab[i - 1]->next = case_tab[i];
+ case_tab[vfm_source_info.ncases - 1]->next = NULL;
+ free (case_tab);
+ } else {
+ case_tab[vfm_source_info.ncases] = NULL;
+ separate_case_tab = case_tab;
+ }
+
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+/* Compares the NV_SORT variables in V_SORT[] between the `case_list's
+ at _A and _B, and returns a strcmp()-type result. */
+static int
+compare_case_lists (const void *pa, const void *pb)
+{
+ struct case_list *a = *(struct case_list **) pa;
+ struct case_list *b = *(struct case_list **) pb;
+ struct variable *v;
+ int result = 0;
+ int i;
+
+ for (i = 0; i < nv_sort; i++)
+ {
+ v = v_sort[i];
+
+ if (v->type == NUMERIC)
+ {
+ if (approx_ne (a->c.data[v->fv].f, b->c.data[v->fv].f))
+ {
+ result = (a->c.data[v->fv].f > b->c.data[v->fv].f) ? 1 : -1;
+ break;
+ }
+ }
+ else
+ {
+ result = memcmp (a->c.data[v->fv].s, b->c.data[v->fv].s, v->width);
+ if (result != 0)
+ break;
+ }
+ }
+
+ if (v->p.srt.order == SRT_ASCEND)
+ return result;
+ else
+ {
+ assert (v->p.srt.order == SRT_DESCEND);
+ return -result;
+ }
+}
+\f
+/* External sort. */
+
+/* Maximum number of input + output file handles. */
+#if defined FOPEN_MAX && (FOPEN_MAX - 5 < 18)
+#define MAX_FILE_HANDLES (FOPEN_MAX - 5)
+#else
+#define MAX_FILE_HANDLES 18
+#endif
+
+#if MAX_FILE_HANDLES < 3
+#error At least 3 file handles must be available for sorting.
+#endif
+
+/* Number of input buffers. */
+#define N_INPUT_BUFFERS (MAX_FILE_HANDLES - 1)
+
+/* Maximum order of merge. This is the value suggested by Knuth;
+ specifically, he said to use tree selection, which we don't
+ implement, for larger orders of merge. */
+#define MAX_MERGE_ORDER 7
+
+/* Minimum total number of records for buffers. */
+#define MIN_BUFFER_TOTAL_SIZE_RECS 64
+
+/* Minimum single input or output buffer size, in bytes and records. */
+#define MIN_BUFFER_SIZE_BYTES 4096
+#define MIN_BUFFER_SIZE_RECS 16
+
+/* Structure for replacement selection tree. */
+struct repl_sel_tree
+ {
+ struct repl_sel_tree *loser;/* Loser associated w/this internal node. */
+ int rn; /* Run number of `loser'. */
+ struct repl_sel_tree *fe; /* Internal node above this external node. */
+ struct repl_sel_tree *fi; /* Internal node above this internal node. */
+ union value record[1]; /* The case proper. */
+ };
+
+/* Static variables used for sorting. */
+static struct repl_sel_tree **x; /* Buffers. */
+static int x_max; /* Size of buffers, in records. */
+static int records_per_buffer; /* Number of records in each buffer. */
+
+/* In the merge phase, the first N_INPUT_BUFFERS handle[] elements are
+ input files and the last element is the output file. Before that,
+ they're all used as output files, although the last one is
+ segregated. */
+static FILE *handle[MAX_FILE_HANDLES]; /* File handles. */
+
+/* Now, MAX_FILE_HANDLES is the maximum number of files we will *try*
+ to open. But if we can't open that many, max_handles will be set
+ to the number we apparently can open. */
+static int max_handles; /* Maximum number of handles. */
+
+/* When we create temporary files, they are all put in the same
+ directory and numbered sequentially from zero. tmp_basename is the
+ drive/directory, etc., and tmp_extname can be sprintf() with "%08x"
+ to the file number, then tmp_basename used to open the file. */
+static char *tmp_basename; /* Temporary file basename. */
+static char *tmp_extname; /* Temporary file extension name. */
+
+/* We use Huffman's method to determine the merge pattern. This means
+ that we need to know which runs are the shortest at any given time.
+ Priority queues as implemented by heap.c are a natural for this
+ task (probably because I wrote the code specifically for it). */
+static struct heap *huffman_queue; /* Huffman priority queue. */
+
+/* Prototypes for helper functions. */
+static void sort_stream_write (void);
+static int write_initial_runs (int separate);
+static int allocate_cases (void);
+static int allocate_file_handles (void);
+static int merge (void);
+static void rmdir_temp_dir (void);
+
+/* Performs an external sort of the active file. A description of the
+ procedure follows. All page references refer to Knuth's _Art of
+ Computer Programming, Vol. 3: Sorting and Searching_, which is the
+ canonical resource for sorting.
+
+ 1. The data is read and S initial runs are formed through the
+ action of algorithm 5.4.1R (replacement selection).
+
+ 2. Huffman's method (p. 365-366) is used to determine the optimum
+ merge pattern.
+
+ 3. If an OS that supports overlapped reading, writing, and
+ computing is being run, we should use 5.4.6F for forecasting.
+ Otherwise, buffers are filled only when they run out of data.
+ FIXME: Since the author of PSPP uses GNU/Linux, which does not
+ yet implement overlapped r/w/c, 5.4.6F is not used.
+
+ 4. We perform P-way merges:
+
+ (a) The desired P is the smallest P such that ceil(ln(S)/ln(P))
+ is minimized. (FIXME: Since I don't have an algorithm for
+ minimizing this, it's just set to MAX_MERGE_ORDER.)
+
+ (b) P is reduced if the selected value would make input buffers
+ less than 4096 bytes each, or 16 records, whichever is larger.
+
+ (c) P is reduced if we run out of available file handles or space
+ for file handles.
+
+ (d) P is reduced if we don't have space for one or two output
+ buffers, which have the same minimum size as input buffers. (We
+ need two output buffers if 5.4.6F is in use for forecasting.) */
+static int
+do_external_sort (int separate)
+{
+ int success = 0;
+
+ assert (MAX_FILE_HANDLES >= 3);
+
+ x = NULL;
+ tmp_basename = NULL;
+
+ huffman_queue = heap_create (512);
+ if (huffman_queue == NULL)
+ return 0;
+
+ if (!allocate_cases ())
+ goto lossage;
+
+ if (!allocate_file_handles ())
+ goto lossage;
+
+ if (!write_initial_runs (separate))
+ goto lossage;
+
+ merge ();
+
+ success = 1;
+
+ /* Despite the name, flow of control comes here regardless of
+ whether or not the sort is successful. */
+lossage:
+ heap_destroy (huffman_queue);
+
+ if (x)
+ {
+ int i;
+
+ for (i = 0; i <= x_max; i++)
+ free (x[i]);
+ free (x);
+ }
+
+ if (!success)
+ rmdir_temp_dir ();
+
+ return success;
+}
+
+#if !HAVE_GETPID
+#define getpid() (0)
+#endif
+
+/* Sets up to open temporary files. */
+/* PORTME: This creates a directory for temporary files. Some OSes
+ might not have that concept... */
+static int
+allocate_file_handles (void)
+{
+ const char *dir; /* Directory prefix. */
+ char *buf; /* String buffer. */
+ char *cp; /* Pointer into buf. */
+
+ dir = getenv ("SPSSTMPDIR");
+ if (dir == NULL)
+ dir = getenv ("SPSSXTMPDIR");
+ if (dir == NULL)
+ dir = getenv ("TMPDIR");
+#ifdef P_tmpdir
+ if (dir == NULL)
+ dir = P_tmpdir;
+#endif
+#if __unix__
+ if (dir == NULL)
+ dir = "/tmp";
+#elif __MSDOS__
+ if (dir == NULL)
+ dir = getenv ("TEMP");
+ if (dir == NULL)
+ dir = getenv ("TMP");
+ if (dir == NULL)
+ dir = "\\";
+#else
+ dir = "";
+#endif
+
+ buf = xmalloc (strlen (dir) + 1 + 4 + 8 + 4 + 1 + INT_DIGITS + 1);
+ cp = spprintf (buf, "%s%c%04lX%04lXpspp", dir, DIR_SEPARATOR,
+ ((long) time (0)) & 0xffff, ((long) getpid ()) & 0xffff);
+ if (-1 == mkdir (buf, S_IRWXU))
+ {
+ free (buf);
+ msg (SE, _("%s: Cannot create temporary directory: %s."),
+ buf, strerror (errno));
+ return 0;
+ }
+ *cp++ = DIR_SEPARATOR;
+
+ tmp_basename = buf;
+ tmp_extname = cp;
+
+ max_handles = MAX_FILE_HANDLES;
+
+ return 1;
+}
+
+/* Removes the directory created for temporary files, if one exists.
+ Also frees tmp_basename. */
+static void
+rmdir_temp_dir (void)
+{
+ if (NULL == tmp_basename)
+ return;
+
+ tmp_extname[-1] = '\0';
+ if (rmdir (tmp_basename) == -1)
+ msg (SE, _("%s: Error removing directory for temporary files: %s."),
+ tmp_basename, strerror (errno));
+
+ free (tmp_basename);
+}
+
+/* Allocates room for lots of cases as a buffer. */
+static int
+allocate_cases (void)
+{
+ /* This is the size of one case. */
+ const int case_size = (sizeof (struct repl_sel_tree)
+ + sizeof (union value) * (default_dict.nval - 1)
+ + sizeof (struct repl_sel_tree *));
+
+ x = NULL;
+
+ /* Allocate as many cases as we can, assuming a space of four
+ void pointers for malloc()'s internal bookkeeping. */
+ x_max = MAX_WORKSPACE / (case_size + 4 * sizeof (void *));
+ x = malloc (sizeof (struct repl_sel_tree *) * x_max);
+ if (x != NULL)
+ {
+ int i;
+
+ for (i = 0; i < x_max; i++)
+ {
+ x[i] = malloc (sizeof (struct repl_sel_tree)
+ + sizeof (union value) * (default_dict.nval - 1));
+ if (x[i] == NULL)
+ break;
+ }
+ x_max = i;
+ }
+ if (x == NULL || x_max < MIN_BUFFER_TOTAL_SIZE_RECS)
+ {
+ if (x != NULL)
+ {
+ int i;
+
+ for (i = 0; i < x_max; i++)
+ free (x[i]);
+ }
+ free (x);
+ msg (SE, _("Out of memory. Could not allocate room for minimum of %d "
+ "cases of %d bytes each. (PSPP workspace is currently "
+ "restricted to a maximum of %d KB.)"),
+ MIN_BUFFER_TOTAL_SIZE_RECS, case_size, MAX_WORKSPACE / 1024);
+ x_max = 0;
+ x = NULL;
+ return 0;
+ }
+
+ /* The last element of the array is used to store lastkey. */
+ x_max--;
+
+ debug_printf ((_("allocated %d cases == %d bytes\n"),
+ x_max, x_max * case_size));
+ return 1;
+}
+\f
+/* Replacement selection. */
+
+static int rmax, rc, rq;
+static struct repl_sel_tree *q;
+static union value *lastkey;
+static int run_no, file_index;
+static int deferred_abort;
+static int run_length;
+
+static int compare_record (union value *, union value *);
+
+static inline void
+output_record (union value *v)
+{
+ union value *src_case;
+
+ if (deferred_abort)
+ return;
+
+ if (compaction_necessary)
+ {
+ compact_case (compaction_case, (struct ccase *) v);
+ src_case = (union value *) compaction_case;
+ }
+ else
+ src_case = (union value *) v;
+
+ if ((int) fwrite (src_case, sizeof *src_case, compaction_nval,
+ handle[file_index])
+ != compaction_nval)
+ {
+ deferred_abort = 1;
+ sprintf (tmp_extname, "%08x", run_no);
+ msg (SE, _("%s: Error writing temporary file: %s."),
+ tmp_basename, strerror (errno));
+ return;
+ }
+
+ run_length++;
+}
+
+static int
+close_handle (int i)
+{
+ int result = fclose (handle[i]);
+ msg (VM (2), _("SORT: Closing handle %d."), i);
+
+ handle[i] = NULL;
+ if (EOF == result)
+ {
+ sprintf (tmp_extname, "%08x", i);
+ msg (SE, _("%s: Error closing temporary file: %s."),
+ tmp_basename, strerror (errno));
+ return 0;
+ }
+ return 1;
+}
+
+static int
+close_handles (int beg, int end)
+{
+ int success = 1;
+ int i;
+
+ for (i = beg; i < end; i++)
+ success &= close_handle (i);
+ return success;
+}
+
+static int
+open_handle_w (int handle_no, int run_no)
+{
+ sprintf (tmp_extname, "%08x", run_no);
+ msg (VM (1), _("SORT: %s: Opening for writing as run %d."),
+ tmp_basename, run_no);
+
+ /* The `x' modifier causes the GNU C library to insist on creating a
+ new file--if the file already exists, an error is signaled. The
+ ANSI C standard says that other libraries should ignore anything
+ after the `w+b', so it shouldn't be a problem. */
+ return NULL != (handle[handle_no] = fopen (tmp_basename, "w+bx"));
+}
+
+static int
+open_handle_r (int handle_no, int run_no)
+{
+ FILE *f;
+
+ sprintf (tmp_extname, "%08x", run_no);
+ msg (VM (1), _("SORT: %s: Opening for writing as run %d."),
+ tmp_basename, run_no);
+ f = handle[handle_no] = fopen (tmp_basename, "rb");
+
+ if (f == NULL)
+ {
+ msg (SE, _("%s: Error opening temporary file for reading: %s."),
+ tmp_basename, strerror (errno));
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Begins a new initial run, specifically its output file. */
+static void
+begin_run (void)
+{
+ /* Decide which handle[] to use. If run_no is max_handles or
+ greater, then we've run out of handles so it's time to just do
+ one file at a time, which by default is handle 0. */
+ file_index = (run_no < max_handles ? run_no : 0);
+ run_length = 0;
+
+ /* Alright, now create the temporary file. */
+ if (open_handle_w (file_index, run_no) == 0)
+ {
+ /* Failure to create the temporary file. Check if there are
+ unacceptably few files already open. */
+ if (file_index < 3)
+ {
+ deferred_abort = 1;
+ msg (SE, _("%s: Error creating temporary file: %s."),
+ tmp_basename, strerror (errno));
+ return;
+ }
+
+ /* Close all the open temporary files. */
+ if (!close_handles (0, file_index))
+ return;
+
+ /* Now try again to create the temporary file. */
+ max_handles = file_index;
+ file_index = 0;
+ if (open_handle_w (0, run_no) == 0)
+ {
+ /* It still failed, report it this time. */
+ deferred_abort = 1;
+ msg (SE, _("%s: Error creating temporary file: %s."),
+ tmp_basename, strerror (errno));
+ return;
+ }
+ }
+}
+
+/* Ends the current initial run. Just increments run_no if no initial
+ run has been started yet. */
+static void
+end_run (void)
+{
+ /* Close file handles if necessary. */
+ {
+ int result;
+
+ if (run_no == max_handles - 1)
+ result = close_handles (0, max_handles);
+ else if (run_no >= max_handles)
+ result = close_handle (0);
+ else
+ result = 1;
+ if (!result)
+ deferred_abort = 1;
+ }
+
+ /* Advance to next run. */
+ run_no++;
+ if (run_no)
+ heap_insert (huffman_queue, run_no - 1, run_length);
+}
+
+/* Performs 5.4.1R. */
+static int
+write_initial_runs (int separate)
+{
+ run_no = -1;
+ deferred_abort = 0;
+
+ /* Steps R1, R2, R3. */
+ rmax = 0;
+ rc = 0;
+ lastkey = NULL;
+ q = x[0];
+ rq = 0;
+ {
+ int j;
+
+ for (j = 0; j < x_max; j++)
+ {
+ struct repl_sel_tree *J = x[j];
+
+ J->loser = J;
+ J->rn = 0;
+ J->fe = x[(x_max + j) / 2];
+ J->fi = x[j / 2];
+ memset (J->record, 0, default_dict.nval * sizeof (union value));
+ }
+ }
+
+ /* Most of the iterations of steps R4, R5, R6, R7, R2, R3, ... */
+ if (!separate)
+ {
+ if (vfm_sink)
+ vfm_sink->destroy_sink ();
+ vfm_sink = &sort_stream;
+ }
+ procedure (NULL, NULL, NULL);
+
+ /* Final iterations of steps R4, R5, R6, R7, R2, R3, ... */
+ for (;;)
+ {
+ struct repl_sel_tree *t;
+
+ /* R4. */
+ rq = rmax + 1;
+
+ /* R5. */
+ t = q->fe;
+
+ /* R6 and R7. */
+ for (;;)
+ {
+ /* R6. */
+ if (t->rn < rq
+ || (t->rn == rq
+ && compare_record (t->loser->record, q->record) < 0))
+ {
+ struct repl_sel_tree *temp_tree;
+ int temp_int;
+
+ temp_tree = t->loser;
+ t->loser = q;
+ q = temp_tree;
+
+ temp_int = t->rn;
+ t->rn = rq;
+ rq = temp_int;
+ }
+
+ /* R7. */
+ if (t == x[1])
+ break;
+ t = t->fi;
+ }
+
+ /* R2. */
+ if (rq != rc)
+ {
+ end_run ();
+ if (rq > rmax)
+ break;
+ begin_run ();
+ rc = rq;
+ }
+
+ /* R3. */
+ if (rq != 0)
+ {
+ output_record (q->record);
+ lastkey = x[x_max]->record;
+ memcpy (lastkey, q->record, sizeof (union value) * vfm_sink_info.nval);
+ }
+ }
+ assert (run_no == rmax);
+
+ /* If an unrecoverable error occurred somewhere in the above code,
+ then the `deferred_abort' flag would have been set. */
+ if (deferred_abort)
+ {
+ int i;
+
+ for (i = 0; i < max_handles; i++)
+ if (handle[i] != NULL)
+ {
+ sprintf (tmp_extname, "%08x", i);
+
+ if (fclose (handle[i]) == EOF)
+ msg (SE, _("%s: Error closing temporary file: %s."),
+ tmp_basename, strerror (errno));
+
+ if (remove (tmp_basename) != 0)
+ msg (SE, _("%s: Error removing temporary file: %s."),
+ tmp_basename, strerror (errno));
+
+ handle[i] = NULL;
+ }
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Compares the NV_SORT variables in V_SORT[] between the `value's at
+ A and B, and returns a strcmp()-type result. */
+static int
+compare_record (union value * a, union value * b)
+{
+ int i;
+ int result = 0;
+ struct variable *v;
+
+ assert (a != NULL);
+ if (b == NULL) /* Sort NULLs after everything else. */
+ return -1;
+
+ for (i = 0; i < nv_sort; i++)
+ {
+ v = v_sort[i];
+
+ if (v->type == NUMERIC)
+ {
+ if (approx_ne (a[v->fv].f, b[v->fv].f))
+ {
+ result = (a[v->fv].f > b[v->fv].f) ? 1 : -1;
+ break;
+ }
+ }
+ else
+ {
+ result = memcmp (a[v->fv].s, b[v->fv].s, v->width);
+ if (result != 0)
+ break;
+ }
+ }
+
+ if (v->p.srt.order == SRT_ASCEND)
+ return result;
+ else
+ {
+ assert (v->p.srt.order == SRT_DESCEND);
+ return -result;
+ }
+}
+\f
+/* Merging. */
+
+static int merge_once (int run_index[], int run_length[], int n_runs);
+
+/* Modula function as defined by Knuth. */
+static int
+mod (int x, int y)
+{
+ int result;
+
+ if (y == 0)
+ return x;
+ result = abs (x) % abs (y);
+ if (y < 0)
+ result = -result;
+ return result;
+}
+
+/* Performs a series of P-way merges of initial runs using Huffman's
+ method. */
+static int
+merge (void)
+{
+ /* Order of merge. */
+ int order;
+
+ /* Idiot check. */
+ assert (MIN_BUFFER_SIZE_RECS * 2 <= MIN_BUFFER_TOTAL_SIZE_RECS - 1);
+
+ /* Close all the input files. I hope that the boundary conditions
+ are correct on this but I'm not sure. */
+ if (run_no < max_handles)
+ {
+ int i;
+
+ for (i = 0; i < run_no; )
+ if (!close_handle (i++))
+ {
+ for (; i < run_no; i++)
+ close_handle (i);
+ return 0;
+ }
+ }
+
+ /* Determine order of merge. */
+ order = MAX_MERGE_ORDER;
+ if (x_max / order < MIN_BUFFER_SIZE_RECS)
+ order = x_max / MIN_BUFFER_SIZE_RECS;
+ else if (x_max / order * sizeof (union value) * default_dict.nval
+ < MIN_BUFFER_SIZE_BYTES)
+ order = x_max / (MIN_BUFFER_SIZE_BYTES
+ / (sizeof (union value) * (default_dict.nval - 1)));
+
+ /* Make sure the order of merge is bounded. */
+ if (order < 2)
+ order = 2;
+ if (order > rmax)
+ order = rmax;
+ assert (x_max / order > 0);
+
+ /* Calculate number of records per buffer. */
+ records_per_buffer = x_max / order;
+
+ /* Add (1 - S) mod (P - 1) dummy runs of length 0. */
+ {
+ int n_dummy_runs = mod (1 - rmax, order - 1);
+ debug_printf (("rmax=%d, order=%d, n_dummy_runs=%d\n",
+ rmax, order, n_dummy_runs));
+ assert (n_dummy_runs >= 0);
+ while (n_dummy_runs--)
+ {
+ heap_insert (huffman_queue, -2, 0);
+ rmax++;
+ }
+ }
+
+ /* Repeatedly merge the P shortest existing runs until only one run
+ is left. */
+ while (rmax > 1)
+ {
+ int run_index[MAX_MERGE_ORDER];
+ int run_length[MAX_MERGE_ORDER];
+ int total_run_length = 0;
+ int i;
+
+ assert (rmax >= order);
+
+ /* Find the shortest runs; put them in runs[] in reverse order
+ of length, to force dummy runs of length 0 to the end of the
+ list. */
+ debug_printf ((_("merging runs")));
+ for (i = order - 1; i >= 0; i--)
+ {
+ run_index[i] = heap_delete (huffman_queue, &run_length[i]);
+ assert (run_index[i] != -1);
+ total_run_length += run_length[i];
+ debug_printf ((" %d(%d)", run_index[i], run_length[i]));
+ }
+ debug_printf ((_(" into run %d(%d)\n"), run_no, total_run_length));
+
+ if (!merge_once (run_index, run_length, order))
+ {
+ int index;
+
+ while (-1 != (index = heap_delete (huffman_queue, NULL)))
+ {
+ sprintf (tmp_extname, "%08x", index);
+ if (remove (tmp_basename) != 0)
+ msg (SE, _("%s: Error removing temporary file: %s."),
+ tmp_basename, strerror (errno));
+ }
+
+ return 0;
+ }
+
+ if (!heap_insert (huffman_queue, run_no++, total_run_length))
+ {
+ msg (SE, _("Out of memory expanding Huffman priority queue."));
+ return 0;
+ }
+
+ rmax -= order - 1;
+ }
+
+ /* There should be exactly one element in the priority queue after
+ all that merging. This represents the entire sorted active file.
+ So we could find a total case count by deleting this element from
+ the queue. */
+ assert (heap_size (huffman_queue) == 1);
+
+ return 1;
+}
+
+/* Merges N_RUNS initial runs into a new run. The jth run for 0 <= j
+ < N_RUNS is taken from temporary file RUN_INDEX[j]; it is composed
+ of RUN_LENGTH[j] cases. */
+static int
+merge_once (int run_index[], int run_length[], int n_runs)
+{
+ /* For each run, the number of records remaining in its buffer. */
+ int buffered[MAX_MERGE_ORDER];
+
+ /* For each run, the index of the next record in the buffer. */
+ int buffer_ptr[MAX_MERGE_ORDER];
+
+ /* Open input files. */
+ {
+ int i;
+
+ for (i = 0; i < n_runs; i++)
+ if (run_index[i] != -2 && !open_handle_r (i, run_index[i]))
+ {
+ /* Close and remove temporary files. */
+ while (i--)
+ {
+ close_handle (i);
+ sprintf (tmp_extname, "%08x", i);
+ if (remove (tmp_basename) != 0)
+ msg (SE, _("%s: Error removing temporary file: %s."),
+ tmp_basename, strerror (errno));
+ }
+
+ return 0;
+ }
+ }
+
+ /* Create output file. */
+ if (!open_handle_w (N_INPUT_BUFFERS, run_no))
+ {
+ msg (SE, _("%s: Error creating temporary file for merge: %s."),
+ tmp_basename, strerror (errno));
+ goto lossage;
+ }
+
+ /* Prime each buffer. */
+ {
+ int i;
+
+ for (i = 0; i < n_runs; i++)
+ if (run_index[i] == -2)
+ {
+ n_runs = i;
+ break;
+ }
+ else
+ {
+ int j;
+ int ofs = records_per_buffer * i;
+
+ buffered[i] = min (records_per_buffer, run_length[i]);
+ for (j = 0; j < buffered[i]; j++)
+ if ((int) fread (x[j + ofs]->record, sizeof (union value),
+ default_dict.nval, handle[i])
+ != default_dict.nval)
+ {
+ sprintf (tmp_extname, "%08x", run_index[i]);
+ if (ferror (handle[i]))
+ msg (SE, _("%s: Error reading temporary file in merge: %s."),
+ tmp_basename, strerror (errno));
+ else
+ msg (SE, _("%s: Unexpected end of temporary file in merge."),
+ tmp_basename);
+ goto lossage;
+ }
+ buffer_ptr[i] = ofs;
+ run_length[i] -= buffered[i];
+ }
+ }
+
+ /* Perform the merge proper. */
+ while (n_runs) /* Loop while some data is left. */
+ {
+ int i;
+ int min = 0;
+
+ for (i = 1; i < n_runs; i++)
+ if (compare_record (x[buffer_ptr[min]]->record,
+ x[buffer_ptr[i]]->record) > 0)
+ min = i;
+
+ if ((int) fwrite (x[buffer_ptr[min]]->record, sizeof (union value),
+ default_dict.nval, handle[N_INPUT_BUFFERS])
+ != default_dict.nval)
+ {
+ sprintf (tmp_extname, "%08x", run_index[i]);
+ msg (SE, _("%s: Error writing temporary file in "
+ "merge: %s."), tmp_basename, strerror (errno));
+ goto lossage;
+ }
+
+ /* Remove one case from the buffer for this input file. */
+ if (--buffered[min] == 0)
+ {
+ /* The input buffer is empty. Do any cases remain in the
+ initial run on disk? */
+ if (run_length[min])
+ {
+ /* Yes. Read them in. */
+
+ int j;
+ int ofs;
+
+ /* Reset the buffer pointer. Note that we can't simply
+ set it to (i * records_per_buffer) since the run
+ order might have changed. */
+ ofs = buffer_ptr[min] -= buffer_ptr[min] % records_per_buffer;
+
+ buffered[min] = min (records_per_buffer, run_length[min]);
+ for (j = 0; j < buffered[min]; j++)
+ if ((int) fread (x[j + ofs]->record, sizeof (union value),
+ default_dict.nval, handle[min])
+ != default_dict.nval)
+ {
+ sprintf (tmp_extname, "%08x", run_index[min]);
+ if (ferror (handle[min]))
+ msg (SE, _("%s: Error reading temporary file in "
+ "merge: %s."),
+ tmp_basename, strerror (errno));
+ else
+ msg (SE, _("%s: Unexpected end of temporary file "
+ "in merge."),
+ tmp_basename);
+ goto lossage;
+ }
+ run_length[min] -= buffered[min];
+ }
+ else
+ {
+ /* No. Delete this run. */
+
+ /* Close the file. */
+ FILE *f = handle[min];
+ handle[min] = NULL;
+ sprintf (tmp_extname, "%08x", run_index[min]);
+ if (fclose (f) == EOF)
+ msg (SE, _("%s: Error closing temporary file in merge: "
+ "%s."), tmp_basename, strerror (errno));
+
+ /* Delete the file. */
+ if (remove (tmp_basename) != 0)
+ msg (SE, _("%s: Error removing temporary file in merge: "
+ "%s."), tmp_basename, strerror (errno));
+
+ n_runs--;
+ if (min != n_runs)
+ {
+ /* Since this isn't the last run, we move the last
+ run into its spot to force all the runs to be
+ contiguous. */
+ run_index[min] = run_index[n_runs];
+ run_length[min] = run_length[n_runs];
+ buffer_ptr[min] = buffer_ptr[n_runs];
+ buffered[min] = buffered[n_runs];
+ handle[min] = handle[n_runs];
+ }
+ }
+ }
+ else
+ buffer_ptr[min]++;
+ }
+
+ /* Close output file. */
+ {
+ FILE *f = handle[N_INPUT_BUFFERS];
+ handle[N_INPUT_BUFFERS] = NULL;
+ if (fclose (f) == EOF)
+ {
+ sprintf (tmp_extname, "%08x", run_no);
+ msg (SE, _("%s: Error closing temporary file in merge: "
+ "%s."),
+ tmp_basename, strerror (errno));
+ return 0;
+ }
+ }
+
+ return 1;
+
+lossage:
+ /* Close all the input and output files. */
+ {
+ int i;
+
+ for (i = 0; i < n_runs; i++)
+ if (run_length[i] != 0)
+ {
+ close_handle (i);
+ sprintf (tmp_basename, "%08x", run_index[i]);
+ if (remove (tmp_basename) != 0)
+ msg (SE, _("%s: Error removing temporary file: %s."),
+ tmp_basename, strerror (errno));
+ }
+ }
+ close_handle (N_INPUT_BUFFERS);
+ sprintf (tmp_basename, "%08x", run_no);
+ if (remove (tmp_basename) != 0)
+ msg (SE, _("%s: Error removing temporary file: %s."),
+ tmp_basename, strerror (errno));
+ return 0;
+}
+\f
+/* External sort input program. */
+
+/* Reads all the records from the source stream and passes them
+ to write_case(). */
+void
+sort_stream_read (void)
+{
+ read_sort_output (write_case);
+}
+
+/* Reads all the records from the output stream and passes them to the
+ function provided, which must have an interface identical to
+ write_case(). */
+void
+read_sort_output (int (*write_case) (void))
+{
+ int i;
+ FILE *f;
+
+ if (separate_case_tab)
+ {
+ struct ccase *save_temp_case = temp_case;
+ struct case_list **p;
+
+ for (p = separate_case_tab; *p; p++)
+ {
+ temp_case = &(*p)->c;
+ write_case ();
+ }
+
+ free (separate_case_tab);
+ separate_case_tab = NULL;
+
+ temp_case = save_temp_case;
+ } else {
+ sprintf (tmp_extname, "%08x", run_no - 1);
+ f = fopen (tmp_basename, "rb");
+ if (!f)
+ {
+ msg (ME, _("%s: Cannot open sort result file: %s."), tmp_basename,
+ strerror (errno));
+ err_failure ();
+ return;
+ }
+
+ for (i = 0; i < vfm_source_info.ncases; i++)
+ {
+ if (!fread (temp_case, vfm_source_info.case_size, 1, f))
+ {
+ if (ferror (f))
+ msg (ME, _("%s: Error reading sort result file: %s."),
+ tmp_basename, strerror (errno));
+ else
+ msg (ME, _("%s: Unexpected end of sort result file: %s."),
+ tmp_basename, strerror (errno));
+ err_failure ();
+ break;
+ }
+
+ if (!write_case ())
+ break;
+ }
+
+ if (fclose (f) == EOF)
+ msg (ME, _("%s: Error closing sort result file: %s."), tmp_basename,
+ strerror (errno));
+
+ if (remove (tmp_basename) != 0)
+ msg (ME, _("%s: Error removing sort result file: %s."), tmp_basename,
+ strerror (errno));
+ else
+ rmdir_temp_dir ();
+ }
+}
+
+#if 0 /* dead code */
+/* Alternate interface to sort_stream_write used for external sorting
+ when SEPARATE is true. */
+static int
+write_separate (struct ccase *c)
+{
+ assert (c == temp_case);
+
+ sort_stream_write ();
+ return 1;
+}
+#endif
+
+/* Performs one iteration of 5.4.1R steps R4, R5, R6, R7, R2, and
+ R3. */
+static void
+sort_stream_write (void)
+{
+ struct repl_sel_tree *t;
+
+ /* R4. */
+ memcpy (q->record, temp_case->data, vfm_sink_info.case_size);
+ if (compare_record (q->record, lastkey) < 0)
+ if (++rq > rmax)
+ rmax = rq;
+
+ /* R5. */
+ t = q->fe;
+
+ /* R6 and R7. */
+ for (;;)
+ {
+ /* R6. */
+ if (t->rn < rq
+ || (t->rn == rq && compare_record (t->loser->record, q->record) < 0))
+ {
+ struct repl_sel_tree *temp_tree;
+ int temp_int;
+
+ temp_tree = t->loser;
+ t->loser = q;
+ q = temp_tree;
+
+ temp_int = t->rn;
+ t->rn = rq;
+ rq = temp_int;
+ }
+
+ /* R7. */
+ if (t == x[1])
+ break;
+ t = t->fi;
+ }
+
+ /* R2. */
+ if (rq != rc)
+ {
+ end_run ();
+ begin_run ();
+ assert (rq <= rmax);
+ rc = rq;
+ }
+
+ /* R3. */
+ if (rq != 0)
+ {
+ output_record (q->record);
+ lastkey = x[x_max]->record;
+ memcpy (lastkey, q->record, vfm_sink_info.case_size);
+ }
+}
+
+/* Switches mode from sink to source. */
+void
+sort_stream_mode (void)
+{
+ /* If this is not done, then we get the following source/sink pairs:
+ source=memory/disk/DATA LIST/etc., sink=SORT; source=SORT,
+ sink=SORT; which is not good. */
+ vfm_sink = NULL;
+}
+
+struct case_stream sort_stream =
+ {
+ NULL,
+ sort_stream_read,
+ sort_stream_write,
+ sort_stream_mode,
+ NULL,
+ NULL,
+ "SORT",
+ };
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !sort_h
+#define sort_h 1
+
+/* SORT CASES programmatic interface. */
+int sort_cases (int separate);
+void read_sort_output (int (*write_case)(void));
+
+/* Variables to sort. */
+extern struct variable **v_sort;
+extern int nv_sort;
+
+#endif /* !sort_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "str.h"
+#include "var.h"
+
+int
+cmd_split_file (void)
+{
+ lex_match_id ("SPLIT");
+ lex_match_id ("FILE");
+
+ if (lex_match_id ("OFF"))
+ {
+ default_dict.n_splits = 0;
+ free (default_dict.splits);
+ default_dict.splits = NULL;
+ }
+ else
+ {
+ struct variable **v;
+ int n;
+
+ lex_match (T_BY);
+ if (!parse_variables (NULL, &v, &n, PV_NO_DUPLICATE))
+ return CMD_FAILURE;
+
+ default_dict.n_splits = n;
+ default_dict.splits = v = xrealloc (v, sizeof *v * (n + 1));
+ v[n] = NULL;
+ }
+
+ return lex_end_of_command ();
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <sys/stat.h>
+
+#ifdef STAT_MACROS_BROKEN
+#undef S_ISBLK
+#undef S_ISCHR
+#undef S_ISDIR
+#undef S_ISFIFO
+#undef S_ISLNK
+#undef S_ISMPB
+#undef S_ISMPC
+#undef S_ISNWK
+#undef S_ISREG
+#undef S_ISSOCK
+#endif /* STAT_MACROS_BROKEN. */
+
+#if !defined(S_ISBLK) && defined(S_IFBLK)
+#define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
+#endif
+#if !defined(S_ISCHR) && defined(S_IFCHR)
+#define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR)
+#endif
+#if !defined(S_ISDIR) && defined(S_IFDIR)
+#define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
+#endif
+#if !defined(S_ISREG) && defined(S_IFREG)
+#define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
+#endif
+#if !defined(S_ISFIFO) && defined(S_IFIFO)
+#define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
+#endif
+#if !defined(S_ISLNK) && defined(S_IFLNK)
+#define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
+#endif
+#if !defined(S_ISSOCK) && defined(S_IFSOCK)
+#define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK)
+#endif
+#if !defined(S_ISMPB) && defined(S_IFMPB) /* V7 */
+#define S_ISMPB(m) (((m) & S_IFMT) == S_IFMPB)
+#define S_ISMPC(m) (((m) & S_IFMT) == S_IFMPC)
+#endif
+#if !defined(S_ISNWK) && defined(S_IFNWK) /* HP/UX */
+#define S_ISNWK(m) (((m) & S_IFMT) == S_IFNWK)
+#endif
+#if !defined(HAVE_MKFIFO)
+#define mkfifo(path, mode) (mknod ((path), (mode) | S_IFIFO, 0))
+#endif
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <math.h>
+#include "stats.h"
+
+/* Returns the fourth power of its argument. */
+double
+hypercube (double x)
+{
+ x *= x;
+ return x * x;
+}
+
+/* Returns the cube of its argument. */
+double
+cube (double x)
+{
+ return x * x * x;
+}
+
+/* Returns the square of its argument. */
+double
+sqr (double x)
+{
+ return x * x;
+}
+
+/*
+ * kurtosis = [(n+1){n*sum(X**4) - 4*sum(X)*sum(X**3)
+ * + 6*sum(X)**2*sum(X**2)/n - 3*sum(X)**4/n**2}]
+ * /[(n-1)(n-2)(n-3)*(variance)**2]
+ * -[3*{(n-1)**2}]
+ * /[(n-2)(n-3)]
+ *
+ * This and other formulas from _Biometry_, Sokal and Rohlf,
+ * W. H. Freeman and Company, 1969. See pages 117 and 136 especially.
+ */
+double
+calc_kurt (const double d[4], double n, double variance)
+{
+ return
+ (((n + 1) * (n * d[3]
+ - 4.0 * d[0] * d[2]
+ + 6.0 * sqr (d[0]) * d[1] / n
+ - 3.0 * hypercube (d[0]) / sqr (n)))
+ / ((n - 1.0) * (n - 2.0) * (n - 3.0) * sqr (variance))
+ - (3.0 * sqr (n - 1.0))
+ / ((n - 2.0) * (n - 3.)));
+}
+
+/*
+ * standard error of kurtosis = sqrt([24n((n-1)**2)]/[(n-3)(n-2)(n+3)(n+5)])
+ */
+double
+calc_sekurt (double n)
+{
+ return sqrt ((24.0 * n * sqr (n - 1.0))
+ / ((n - 3.0) * (n - 2.0) * (n + 3.0) * (n + 5.0)));
+}
+
+/*
+ * skewness = [n*sum(X**3) - 3*sum(X)*sum(X**2) + 2*sum(X)**3/n]/
+ * /[(n-1)(n-2)*(variance)**3]
+ */
+double
+calc_skew (const double d[3], double n, double stddev)
+{
+ return
+ ((n * d[2] - 3.0 * d[0] * d[1] + 2.0 * cube (d[0]) / n)
+ / ((n - 1.0) * (n - 2.0) * cube (stddev)));
+}
+
+/*
+ * standard error of skewness = sqrt([6n(n-1)] / [(n-2)(n+1)(n+3)])
+ */
+double
+calc_seskew (double n)
+{
+ return
+ sqrt ((6.0 * n * (n - 1.0))
+ / ((n - 2.0) * (n + 1.0) * (n + 3.0)));
+}
+
+/* Returns one-sided significance level corresponding to standard
+ normal deviate X. Algorithm from _SPSS Statistical Algorithms_,
+ Appendix 1. */
+#if 0
+double
+normal_sig (double x)
+{
+ const double a1 = .070523078;
+ const double a2 = .0422820123;
+ const double a3 = .0092705272;
+ const double a4 = .0001520143;
+ const double a5 = .0002765672;
+ const double a6 = .0000430638;
+
+ const double z = fabs (x) <= 14.14 ? 0.7071067812 * fabs (x) : 10.;
+ double r;
+
+ r = 1. + z * (a1 + z * (a2 + z * (a3 + z * (a4 + z * (a5 + z * a6)))));
+ r *= r; /* r ** 2 */
+ r *= r; /* r ** 4 */
+ r *= r; /* r ** 16 */
+
+ return .5 / r;
+}
+#else /* 1 */
+/* Taken from _BASIC Statistics: An Introduction to Problem Solving
+ with Your Personal Computer_, Jerry W. O'Dell, TAB 1984, page 314-5. */
+double
+normal_sig (double z)
+{
+ double h;
+
+ h = 1 + 0.0498673470 * z;
+ z *= z;
+ h += 0.0211410061 * z;
+ z *= z;
+ h += 0.0032776263 * z;
+ z *= z;
+ h += 0.0000380036 * z;
+ z *= z;
+ h += 0.0000488906 * z;
+ z *= z;
+ h += 0.0000053830 * z;
+ return pow (h, -16.) / 2.;
+}
+#endif /* 1 */
+
+/* Algorithm from _Turbo Pascal Programmer's Toolkit_, Rugg and
+ Feldman, Que 1989. Returns the significance level of chi-square
+ value CHISQ with DF degrees of freedom, correct to at least 7
+ decimal places. */
+double
+chisq_sig (double x, int k)
+{
+ if (x <= 0. || k < 1)
+ return 1.0;
+ else if (k == 1)
+ return 2. * normal_sig (sqrt (x));
+ else if (k <= 30)
+ {
+ double z, z_partial, term, denom, numerator, value;
+
+ z = 1.;
+ z_partial = 1.;
+ term = k;
+ do
+ {
+ term += 2;
+ z_partial *= x / term;
+ if (z_partial >= 10000000.)
+ return 0.;
+ z += z_partial;
+ }
+ while (z_partial >= 1.e-7);
+ denom = term = 2 - k % 2;
+ while (term < k)
+ {
+ term += 2;
+ denom *= term;
+ }
+ if (k % 2)
+ {
+ value = ((k + 1) / 2) * log (x) - x / 2.;
+ numerator = exp (value) * sqrt (2. / x / PI);
+ }
+ else
+ {
+ value = k / 2. * log (x) - x / 2.;
+ numerator = exp (value);
+ }
+ return 1. - numerator * z / denom;
+ }
+ else
+ {
+ double term, numer, norm_x;
+
+ term = 2. / 9. / k;
+ numer = pow (x / k, 1. / 3.);
+ norm_x = numer / sqrt (term);
+ return 1.0 - normal_sig (norm_x);
+ }
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !statistics_h
+#define statistics_h 1
+
+/* These are all sample statistics except for mean since uses
+ population statistics for whatever reason. */
+
+/* Define pi to the maximum precision available. */
+#include <math.h> /* defines M_PI on many systems */
+#ifndef PI
+#ifdef M_PI
+#define PI M_PI
+#else /* !PI && !M_PI */
+#define PI 3.14159265358979323846264338327
+#endif /* !PI && !M_PI */
+#endif /* !PI */
+
+/* Returns the fourth power of its argument. */
+extern inline double
+hypercube (double x)
+{
+ x *= x;
+ return x * x;
+}
+
+/* Returns the cube of its argument. */
+extern inline double
+cube (double x)
+{
+ return x * x * x;
+}
+
+/* Returns the square of its argument. */
+extern inline double
+sqr (double x)
+{
+ return x * x;
+}
+
+/* Mean, standard error of mean. */
+#define calc_mean(D, N) \
+ ((D)[0] / (N))
+#define calc_semean(STDDEV, N) \
+ ((STDDEV) / sqrt (N))
+
+/* Variance, standard deviation, coefficient of variance. */
+#define calc_variance(D, N) \
+ ( ((D)[1] - sqr ((D)[0])/(N)) / ((N)-1) )
+#define calc_stddev(VARIANCE) \
+ (sqrt (VARIANCE))
+#define calc_cfvar(D, N) \
+ ( calc_stddev (calc_variance (D, N)) / calc_mean (D, N) )
+
+/* Kurtosis, standard error of kurtosis. */
+double calc_kurt (const double d[4], double n, double variance);
+double calc_sekurt (double n);
+
+/* Skewness, standard error of skewness. */
+double calc_skew (const double d[3], double n, double stddev);
+double calc_seskew (double n);
+
+/* Significance. */
+double normal_sig (double x);
+double chisq_sig (double chisq, int df);
+
+#endif /* !statistics_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <ctype.h>
+#include <limits.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "error.h"
+#include "pool.h"
+#include "str.h"
+\f
+/* sprintf() wrapper functions for convenience. */
+
+#if !__GNUC__
+char *
+spprintf (char *buf, const char *format,...)
+{
+#if HAVE_GOOD_SPRINTF
+ int count;
+#endif
+ va_list args;
+
+ va_start (args, format);
+#if HAVE_GOOD_SPRINTF
+ count =
+#endif
+ vsprintf (buf, format, args);
+ va_end (args);
+
+#if HAVE_GOOD_SPRINTF
+ return &buf[count];
+#else
+ return strchr (buf, 0);
+#endif
+}
+#endif /* !__GNUC__ */
+
+#if !__GNUC__ && !HAVE_GOOD_SPRINTF
+int
+nsprintf (char *buf, const char *format,...)
+{
+ va_list args;
+
+ va_start (args, format);
+ vsprintf (buf, format, args);
+ va_end (args);
+
+ return strlen (buf);
+}
+
+int
+nvsprintf (char *buf, const char *format, va_list args)
+{
+ vsprintf (buf, format, args);
+ return strlen (buf);
+}
+#endif /* Not GNU C and not good sprintf(). */
+\f
+/* Reverses the order of NBYTES bytes at address P, thus converting
+ between little- and big-endian byte orders. */
+void
+mm_reverse (void *p, size_t nbytes)
+{
+ unsigned char *h = p, *t = &h[nbytes - 1];
+ unsigned char temp;
+
+ nbytes /= 2;
+ while (nbytes--)
+ {
+ temp = *h;
+ *h++ = *t;
+ *t-- = temp;
+ }
+}
+
+/* Finds the last NEEDLE of length NEEDLE_LEN in a HAYSTACK of length
+ HAYSTACK_LEN. Returns a pointer to the needle found. */
+char *
+mm_find_reverse (const char *haystack, size_t haystack_len,
+ const char *needle, size_t needle_len)
+{
+ int i;
+ for (i = haystack_len - needle_len; i >= 0; i--)
+ if (!memcmp (needle, &haystack[i], needle_len))
+ return (char *) &haystack[i];
+ return 0;
+}
+
+/* Compares S0 of length S0L to S1 of length S1L. The shorter string
+ is considered to be padded with spaces to the length of the
+ longer. */
+int
+st_compare_pad (const char *s0, int s0l, const char *s1, int s1l)
+{
+ /* 254 spaces. */
+ static char blanks[254] =
+ " "
+ " "
+ " "
+ " "
+ " ";
+
+ int diff = s0l - s1l;
+ int r;
+
+ if (diff == 0)
+ {
+ if (s0l == 0)
+ return 0;
+ return memcmp (s0, s1, s0l);
+ }
+ else if (diff > 0)
+ {
+ /* s0l > s1l */
+ if (s1l)
+ {
+ r = memcmp (s0, s1, s1l);
+ if (r)
+ return r;
+ }
+ return memcmp (&s0[s1l], blanks, diff);
+ }
+ else
+ /* diff<0 */
+ {
+ /* s0l < s1l */
+ if (s0l)
+ {
+ r = memcmp (s0, s1, s0l);
+ if (r)
+ return r;
+ }
+ return memcmp (blanks, &s1[s0l], -diff);
+ }
+}
+
+/* Copies SRC to DEST, truncating to N characters or right-padding
+ with spaces to N characters as necessary. Does not append a null
+ character. SRC must be null-terminated. */
+void
+st_bare_pad_copy (char *dest, const char *src, size_t n)
+{
+ size_t len;
+
+ len = strlen (src);
+ if (len >= n)
+ memcpy (dest, src, n);
+ else
+ {
+ memcpy (dest, src, len);
+ memset (&dest[len], ' ', n - len);
+ }
+}
+
+/* Copies SRC to DEST, truncating SRC to N characters or right-padding
+ with spaces to N characters if necessary. Does not append a null
+ character. SRC must be LEN characters long but does not need to be
+ null-terminated. */
+void
+st_bare_pad_len_copy (char *dest, const char *src, size_t n, size_t len)
+{
+ if (len >= n)
+ memcpy (dest, src, n);
+ else
+ {
+ memcpy (dest, src, len);
+ memset (&dest[len], ' ', n - len);
+ }
+}
+
+/* Copies SRC to DEST, truncating SRC to N-1 characters or
+ right-padding with spaces to N-1 characters if necessary. Always
+ appends a null character. */
+void
+st_pad_copy (char *dest, const char *src, size_t n)
+{
+ size_t len;
+
+ len = strlen (src);
+ if (len == n - 1)
+ strcpy (dest, src);
+ else if (len < n - 1)
+ {
+ memcpy (dest, src, len);
+ memset (&dest[len], ' ', n - 1 - len);
+ dest[n - 1] = 0;
+ }
+ else
+ {
+ memcpy (dest, src, n - 1);
+ dest[n - 1] = 0;
+ }
+}
+\f
+/* Initializes ST inside pool POOL (which may be a null pointer) with
+ initial contents S. */
+void
+ds_create (struct pool *pool, struct string *st, const char *s)
+{
+ st->pool = pool;
+ st->length = strlen (s);
+ st->size = 8 + st->length * 2;
+ st->string = pool_malloc (pool, st->size + 1);
+ strcpy (st->string, s);
+}
+
+/* Initializes ST inside POOL (which may be null), making room for at
+ least SIZE characters. */
+void
+ds_init (struct pool *pool, struct string *st, size_t size)
+{
+ st->pool = pool;
+ st->length = 0;
+ if (size > 8)
+ st->size = size;
+ else
+ st->size = 8;
+ st->string = pool_malloc (pool, st->size + 1);
+}
+
+/* Replaces the contents of ST with STRING. STRING may overlap with
+ ST. */
+void
+ds_replace (struct string *st, const char *string)
+{
+ char *s = st->string;
+ st->string = NULL;
+ ds_create (st->pool, st, string);
+ pool_free (st->pool, s);
+}
+
+/* Frees ST. */
+void
+ds_destroy (struct string *st)
+{
+ pool_free (st->pool, st->string);
+}
+
+/* Truncates ST to zero length. */
+void
+ds_clear (struct string *st)
+{
+ st->length = 0;
+}
+
+/* Ensures that ST can hold at least MIN_SIZE characters plus a null
+ terminator. */
+void
+ds_extend (struct string *st, size_t min_size)
+{
+ if (min_size > st->size)
+ {
+ st->size *= 2;
+ if (st->size < min_size)
+ st->size = min_size * 2;
+
+ st->string = pool_realloc (st->pool, st->string, st->size + 1);
+ }
+}
+
+/* Shrink ST to the minimum size need to contain its content. */
+void
+ds_shrink (struct string *st)
+{
+ if (st->size != st->length)
+ {
+ st->size = st->length;
+ st->string = pool_realloc (st->pool, st->string, st->size + 1);
+ }
+}
+
+/* Truncates ST to at most LENGTH characters long. */
+void
+ds_truncate (struct string *st, size_t length)
+{
+ if (length >= st->length)
+ return;
+ st->length = length;
+}
+
+/* Returns the length of ST. */
+size_t
+ds_length (const struct string *st)
+{
+ return st->length;
+}
+
+/* Returns the allocation size of ST. */
+size_t
+ds_size (const struct string *st)
+{
+ return st->size;
+}
+
+/* Returns the value of ST as a null-terminated string. */
+char *
+ds_value (const struct string *st)
+{
+ ((char *) st->string)[st->length] = '\0';
+ return st->string;
+}
+
+/* Returns a pointer to the null terminator ST.
+ This might not be an actual null character unless ds_value() has
+ been called since the last modification to ST. */
+char *
+ds_end (const struct string *st)
+{
+ return st->string + st->length;
+}
+
+/* Concatenates S onto ST. */
+void
+ds_concat (struct string *st, const char *s)
+{
+ size_t s_len = strlen (s);
+ ds_extend (st, st->length + s_len);
+ strcpy (st->string + st->length, s);
+ st->length += s_len;
+}
+
+/* Concatenates LEN characters from BUF onto ST. */
+void
+ds_concat_buffer (struct string *st, const char *buf, size_t len)
+{
+ ds_extend (st, st->length + len);
+ memcpy (st->string + st->length, buf, len);
+ st->length += len;
+}
+
+/* Formats FORMAT as a printf string and appends the result to ST. */
+void
+ds_printf (struct string *st, const char *format, ...)
+{
+ /* Fscking glibc silently changed behavior between 2.0 and 2.1.
+ Fsck fsck fsck. Before, it returned -1 on buffer overflow. Now,
+ it returns the number of characters (not bytes) that would have
+ been written. */
+ va_list args;
+
+ int avail, needed;
+
+ va_start (args, format);
+ avail = st->size - st->length + 1;
+ needed = vsnprintf (st->string + st->length, avail, format, args);
+ va_end (args);
+
+ if (needed >= avail)
+ {
+ ds_extend (st, st->length + needed);
+
+ va_start (args, format);
+ vsprintf (st->string + st->length, format, args);
+ va_end (args);
+ }
+ else
+ while (needed == -1)
+ {
+ ds_extend (st, (st->size + 1) * 2);
+ avail = st->size - st->length + 1;
+
+ va_start (args, format);
+ needed = vsnprintf (st->string + st->length, avail, format, args);
+ va_end (args);
+ }
+
+ st->length += needed;
+}
+
+/* Appends character CH to ST. */
+void
+ds_putchar (struct string *st, int ch)
+{
+ if (st->length == st->size)
+ ds_extend (st, st->length + 1);
+ st->string[st->length++] = ch;
+}
+
+/* Reads a newline-terminated line from STREAM into ST.
+ Newline is the last character of ST on return, unless an I/O error
+ or end of file is encountered after reading some characters.
+ Returns 1 if a line is successfully read, or 0 if no characters at
+ all were read before an I/O error or end of file was
+ encountered. */
+int
+ds_getline (struct string *st, FILE *stream)
+{
+ int c;
+
+ c = getc (stream);
+ if (c == EOF)
+ return 0;
+
+ for (;;)
+ {
+ ds_putchar (st, c);
+ if (c == '\n')
+ return 1;
+
+ c = getc (stream);
+ if (c == EOF)
+ return 1;
+ }
+}
+
+/* Reads a line from STREAM into ST, then preprocesses as follows:
+
+ - Splices lines terminated with `\'.
+
+ - Deletes comments introduced by `#' outside of single or double
+ quotes.
+
+ - Trailing whitespace will be deleted.
+
+ Increments cust_ln as appropriate.
+
+ Returns nonzero only if a line was successfully read. */
+int
+ds_get_config_line (FILE *stream, struct string *st, struct file_locator *where)
+{
+ /* Read the first line. */
+ ds_clear (st);
+ where->line_number++;
+ if (!ds_getline (st, stream))
+ return 0;
+
+ /* Read additional lines, if any. */
+ for (;;)
+ {
+ /* Remove trailing whitespace. */
+ {
+ char *s = ds_value (st);
+ size_t len = ds_length (st);
+
+ while (len > 0 && isspace ((unsigned char) s[len - 1]))
+ len--;
+ ds_truncate (st, len);
+ }
+
+ /* Check for trailing \. Remove if found, bail otherwise. */
+ if (ds_length (st) == 0 || ds_value (st)[ds_length (st) - 1] != '\\')
+ break;
+ ds_truncate (st, ds_length (st) - 1);
+
+ /* Append another line and go around again. */
+ {
+ int success = ds_getline (st, stream);
+ where->line_number++;
+ if (!success)
+ return 1;
+ }
+ }
+
+ /* Find a comment and remove. */
+ {
+ char *cp;
+ int quote = 0;
+
+ for (cp = ds_value (st); *cp; cp++)
+ if (quote)
+ {
+ if (*cp == quote)
+ quote = 0;
+ else if (*cp == '\\')
+ cp++;
+ }
+ else if (*cp == '\'' || *cp == '"')
+ quote = *cp;
+ else if (*cp == '#')
+ {
+ ds_truncate (st, cp - ds_value (st));
+ break;
+ }
+ }
+
+ return 1;
+}
+\f
+/* Lengthed strings. */
+
+/* Creates a new lengthed string LS in POOL with contents as a copy of
+ S. */
+void
+ls_create (struct pool *pool, struct len_string *ls, const char *s)
+{
+ ls->length = strlen (s);
+ ls->string = pool_alloc (pool, ls->length + 1);
+ memcpy (ls->string, s, ls->length + 1);
+}
+
+/* Creates a new lengthed string LS in POOL with contents as a copy of
+ BUFFER with length LEN. */
+void
+ls_create_buffer (struct pool *pool, struct len_string *ls,
+ const char *buffer, size_t len)
+{
+ ls->length = len;
+ ls->string = pool_malloc (pool, len + 1);
+ memcpy (ls->string, buffer, len);
+ ls->string[len] = '\0';
+}
+
+/* Sets the fields of LS to the specified values. */
+void
+ls_init (struct len_string *ls, const char *string, size_t length)
+{
+ ls->string = (char *) string;
+ ls->length = length;
+}
+
+/* Copies the fields of SRC to DST. */
+void
+ls_shallow_copy (struct len_string *dst, const struct len_string *src)
+{
+ *dst = *src;
+}
+
+/* Frees the memory in POOL backing LS. */
+void
+ls_destroy (struct pool *pool, struct len_string *ls)
+{
+ pool_free (pool, ls->string);
+}
+
+/* Sets LS to a null pointer value. */
+void
+ls_null (struct len_string *ls)
+{
+ ls->string = NULL;
+}
+
+/* Returns nonzero only if LS has a null pointer value. */
+int
+ls_null_p (const struct len_string *ls)
+{
+ return ls->string == NULL;
+}
+
+/* Returns nonzero only if LS is a null pointer or has length 0. */
+int
+ls_empty_p (const struct len_string *ls)
+{
+ return ls->string == NULL || ls->length == 0;
+}
+
+/* Returns the length of LS, which must not be null. */
+size_t
+ls_length (const struct len_string *ls)
+{
+ return ls->length;
+}
+
+/* Returns a pointer to the character string in LS. */
+char *
+ls_value (const struct len_string *ls)
+{
+ return (char *) ls->string;
+}
+
+/* Returns a pointer to the null terminator of the character string in
+ LS. */
+char *
+ls_end (const struct len_string *ls)
+{
+ return (char *) (ls->string + ls->length);
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !str_h
+#define str_h 1
+
+/* Headers and miscellaneous. */
+
+#include <stdarg.h>
+#include <stdio.h>
+
+#if STDC_HEADERS
+ #include <string.h>
+#else
+ #ifndef HAVE_STRCHR
+ #define strchr index
+ #define strrchr rindex
+ #endif
+
+ char *strchr (), *strrchr ();
+#endif
+
+#if !HAVE_STRTOK_R
+ char *strtok_r (char *, const char *, char **);
+#endif
+
+#if !HAVE_STPCPY && !__linux__
+ char *stpcpy (char *dest, const char *src);
+#endif
+
+#if !HAVE_STRCASECMP
+ int strcasecmp (const char *s1, const char *s2);
+#endif
+
+#if !HAVE_STRNCASECMP
+ int strncasecmp (const char *s1, const char *s2, size_t n);
+#endif
+
+#if !HAVE_MEMMEM
+ void *memmem (const void *haystack, size_t haystack_len,
+ const void *needle, size_t needle_len);
+#endif
+\f
+/* sprintf() wrapper functions for convenience. */
+
+/* spprintf() calls sprintf() and returns the address of the null
+ terminator in the resulting string. It should be portable the way
+ it's been implemented. */
+#if __GNUC__
+ #if HAVE_GOOD_SPRINTF
+ #define spprintf(BUF, FORMAT, ARGS...) \
+ ((BUF) + sprintf ((BUF), (FORMAT) , ## ARGS))
+ #else
+ #define spprintf(BUF, FORMAT, ARGS...) \
+ ({ sprintf ((BUF), (FORMAT) , ## ARGS); \
+ strchr ((BUF), 0); })
+ #endif
+#else /* Not GNU C. */
+ char *spprintf (char *buf, const char *format, ...);
+#endif /* Not GNU C. */
+
+/* nsprintf() calls sprintf() and returns the strlen() of the
+ resulting string. It should be portable the way it's been
+ implemented. */
+#if __GNUC__
+ #if HAVE_GOOD_SPRINTF
+ #define nsprintf(BUF, FORMAT, ARGS...) \
+ (sprintf ((BUF), (FORMAT) , ## ARGS))
+ #define nvsprintf(BUF, FORMAT, ARGS) \
+ (vsprintf ((BUF), (FORMAT), (ARGS)))
+ #else /* Not good sprintf(). */
+ #define nsprintf(BUF, FORMAT, ARGS...) \
+ ({ \
+ char *pbuf = BUF; \
+ sprintf ((pbuf), (FORMAT) , ## ARGS); \
+ strlen (pbuf); \
+ })
+ #define nvsprintf(BUF, FORMAT, ARGS) \
+ ({ \
+ char *pbuf = BUF; \
+ vsprintf ((pbuf), (FORMAT), (ARGS)); \
+ strlen (pbuf); \
+ })
+ #endif /* Not good sprintf(). */
+#else /* Not GNU C. */
+ #if HAVE_GOOD_SPRINTF
+ #define nsprintf sprintf
+ #define nvsprintf vsprintf
+ #else /* Not good sprintf(). */
+ int nsprintf (char *buf, const char *format, ...);
+ int nvsprintf (char *buf, const char *format, va_list args);
+ #endif /* Not good sprintf(). */
+#endif /* Not GNU C. */
+
+#if !HAVE_GETLINE
+long getline (char **lineptr, size_t *n, FILE *stream);
+#endif
+
+#if !HAVE_GETDELIM
+long getdelim (char **lineptr, size_t * n, int delimiter, FILE * stream);
+#endif
+\f
+/* Miscellaneous. */
+
+void mm_reverse (void *, size_t);
+char *mm_find_reverse (const char *, size_t, const char *, size_t);
+
+int st_compare_pad (const char *, int, const char *, int);
+char *st_spaces (int);
+void st_bare_pad_copy (char *dest, const char *src, size_t n);
+void st_bare_pad_len_copy (char *dest, const char *src, size_t n, size_t len);
+void st_pad_copy (char *dest, const char *src, size_t n);
+\f
+/* Lengthed strings. */
+struct len_string
+ {
+ char *string;
+ size_t length;
+ };
+
+struct pool;
+void ls_create (struct pool *, struct len_string *, const char *);
+void ls_create_buffer (struct pool *, struct len_string *,
+ const char *, size_t len);
+void ls_init (struct len_string *, const char *, size_t);
+void ls_shallow_copy (struct len_string *, const struct len_string *);
+void ls_destroy (struct pool *, struct len_string *);
+
+void ls_null (struct len_string *);
+int ls_null_p (const struct len_string *);
+int ls_empty_p (const struct len_string *);
+
+size_t ls_length (const struct len_string *);
+char *ls_value (const struct len_string *);
+char *ls_end (const struct len_string *);
+\f
+/* Dynamic strings. */
+
+struct string
+ {
+ struct pool *pool;
+ size_t length;
+ size_t size;
+ char *string;
+ };
+
+void ds_create (struct pool *, struct string *, const char *);
+void ds_init (struct pool *, struct string *, size_t size);
+void ds_replace (struct string *, const char *);
+void ds_destroy (struct string *);
+void ds_clear (struct string *);
+void ds_extend (struct string *, size_t min_size);
+void ds_shrink (struct string *);
+void ds_truncate (struct string *, size_t length);
+
+size_t ds_length (const struct string *);
+char *ds_value (const struct string *);
+char *ds_end (const struct string *);
+size_t ds_size (const struct string *);
+
+struct file_locator;
+int ds_getline (struct string *st, FILE *stream);
+int ds_get_config_line (FILE *, struct string *, struct file_locator *);
+void ds_putchar (struct string *, int ch);
+void ds_concat (struct string *, const char *);
+void ds_concat_buffer (struct string *, const char *buf, size_t len);
+void ds_printf (struct string *, const char *, ...)
+ __attribute__ ((format (printf, 2, 3)));
+
+#if __GNUC__ > 1
+extern inline void
+ds_putchar (struct string *st, int ch)
+{
+ if (st->length == st->size)
+ ds_extend (st, st->length + 1);
+ st->string[st->length++] = ch;
+}
+
+extern inline size_t
+ds_length (const struct string *st)
+{
+ return st->length;
+}
+
+extern inline char *
+ds_value (const struct string *st)
+{
+ ((char *) st->string)[st->length] = '\0';
+ return st->string;
+}
+
+extern inline char *
+ds_end (const struct string *st)
+{
+ return st->string + st->length;
+}
+#endif
+
+#endif /* str_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <ctype.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "avl.h"
+#include "command.h"
+#include "error.h"
+#include "file-handle.h"
+#include "lexer.h"
+#include "misc.h"
+#include "output.h"
+#include "sfm.h"
+#include "som.h"
+#include "tab.h"
+#include "var.h"
+#include "vector.h"
+
+/* Constants for DISPLAY utility. */
+enum
+ {
+ AS_NAMES = 0,
+ AS_INDEX,
+ AS_VARIABLES,
+ AS_LABELS,
+ AS_DICTIONARY,
+ AS_SCRATCH,
+ AS_VECTOR
+ };
+
+int describe_variable (struct variable *v, struct tab_table *t, int r, int as);
+
+/* Sets the widths of all the columns and heights of all the rows in
+ table T for driver D. */
+static void
+sysfile_info_dim (struct tab_table *t, struct outp_driver *d)
+{
+ static const int max[] = {20, 5, 35, 3, 0};
+ const int *p;
+ int i;
+
+ for (p = max; *p; p++)
+ t->w[p - max] = min (tab_natural_width (t, d, p - max),
+ *p * d->prop_em_width);
+ for (i = 0; i < t->nr; i++)
+ t->h[i] = tab_natural_height (t, d, i);
+}
+
+/* SYSFILE INFO utility. */
+int
+cmd_sysfile_info (void)
+{
+ struct file_handle *h;
+ struct dictionary *d;
+ struct tab_table *t;
+ struct sfm_read_info inf;
+ int r, nr;
+ int i;
+
+ lex_match_id ("SYSFILE");
+ lex_match_id ("INFO");
+
+ lex_match_id ("FILE");
+ lex_match ('=');
+
+ h = fh_parse_file_handle ();
+ if (!h)
+ return CMD_FAILURE;
+
+ d = sfm_read_dictionary (h, &inf);
+ fh_close_handle (h);
+ if (!d)
+ return CMD_FAILURE;
+
+ t = tab_create (2, 9, 0);
+ tab_vline (t, TAL_1 | TAL_SPACING, 1, 0, 8);
+ tab_text (t, 0, 0, TAB_LEFT, _("File:"));
+ tab_text (t, 1, 0, TAB_LEFT, fh_handle_filename (h));
+ tab_text (t, 0, 1, TAB_LEFT, _("Label:"));
+ tab_text (t, 1, 1, TAB_LEFT,
+ d->label ? d->label : _("No label."));
+ tab_text (t, 0, 2, TAB_LEFT, _("Created:"));
+ tab_text (t, 1, 2, TAB_LEFT | TAT_PRINTF, "%s %s by %s",
+ inf.creation_date, inf.creation_time, inf.product);
+ tab_text (t, 0, 3, TAB_LEFT, _("Endian:"));
+ tab_text (t, 1, 3, TAB_LEFT,
+ (inf.endianness == BIG ? _("Big.")
+ : (inf.endianness == LITTLE ? _("Little.")
+ : (assert (0), _("<internal error>")))));
+ tab_text (t, 0, 4, TAB_LEFT, _("Variables:"));
+ tab_text (t, 1, 4, TAB_LEFT | TAT_PRINTF, "%d",
+ d->nvar);
+ tab_text (t, 0, 5, TAB_LEFT, _("Cases:"));
+ tab_text (t, 1, 5, TAB_LEFT | TAT_PRINTF,
+ inf.ncases == -1 ? _("Unknown") : "%d", inf.ncases);
+ tab_text (t, 0, 6, TAB_LEFT, _("Type:"));
+ tab_text (t, 1, 6, TAB_LEFT, _("System File."));
+ tab_text (t, 0, 7, TAB_LEFT, _("Weight:"));
+ tab_text (t, 1, 7, TAB_LEFT,
+ d->weight_var[0] ? d->weight_var : _("Not weighted."));
+ tab_text (t, 0, 8, TAB_LEFT, _("Mode:"));
+ tab_text (t, 1, 8, TAB_LEFT | TAT_PRINTF,
+ _("Compression %s."), inf.compressed ? _("on") : _("off"));
+ tab_dim (t, tab_natural_dimensions);
+ tab_submit (t);
+
+ nr = 1 + 2 * d->nvar;
+ t = tab_create (4, nr, 1);
+ tab_dim (t, sysfile_info_dim);
+ tab_headers (t, 0, 0, 1, 0);
+ tab_text (t, 0, 0, TAB_LEFT | TAT_TITLE, _("Variable"));
+ tab_joint_text (t, 1, 0, 2, 0, TAB_LEFT | TAT_TITLE, _("Description"));
+ tab_text (t, 3, 0, TAB_LEFT | TAT_TITLE, _("Position"));
+ tab_hline (t, TAL_2, 0, 3, 1);
+ for (r = 1, i = 0; i < d->nvar; i++)
+ {
+ int nvl = d->var[i]->val_lab ? avl_count (d->var[i]->val_lab) : 0;
+
+ if (r + 10 + nvl > nr)
+ {
+ nr = max (nr * d->nvar / (i + 1), nr);
+ nr += 10 + nvl;
+ tab_realloc (t, 4, nr);
+ }
+
+ r = describe_variable (d->var[i], t, r, AS_DICTIONARY);
+ }
+ tab_box (t, TAL_1, TAL_1, -1, -1, 0, 0, 3, r);
+ tab_vline (t, TAL_1, 0, 0, r);
+ tab_vline (t, TAL_1, 1, 0, r);
+ tab_vline (t, TAL_1, 3, 0, r);
+ tab_resize (t, -1, r);
+ tab_flags (t, SOMF_NO_TITLE);
+ tab_submit (t);
+
+ free_dictionary (d);
+
+ return lex_end_of_command ();
+}
+\f
+/* DISPLAY utility. */
+
+static void display_macros (void);
+static void display_documents (void);
+static void display_variables (struct variable **, int, int);
+static void display_vectors (int sorted);
+
+static int cmp_var_by_name (const void *, const void *);
+
+int
+cmd_display (void)
+{
+ /* Whether to sort the list of variables alphabetically. */
+ int sorted;
+
+ /* Variables to display. */
+ int n;
+ struct variable **vl;
+
+ lex_match_id ("DISPLAY");
+
+ if (lex_match_id ("MACROS"))
+ display_macros ();
+ else if (lex_match_id ("DOCUMENTS"))
+ display_documents ();
+ else if (lex_match_id ("FILE"))
+ {
+ som_blank_line ();
+ if (!lex_force_match_id ("LABEL"))
+ return CMD_FAILURE;
+ if (default_dict.label == NULL)
+ tab_output_text (TAB_LEFT,
+ _("The active file does not have a file label."));
+ else
+ {
+ tab_output_text (TAB_LEFT | TAT_TITLE, _("File label:"));
+ tab_output_text (TAB_LEFT | TAT_FIX, default_dict.label);
+ }
+ }
+ else
+ {
+ static const char *sbc[] =
+ {"NAMES", "INDEX", "VARIABLES", "LABELS",
+ "DICTIONARY", "SCRATCH", "VECTORS", NULL};
+ const char **cp;
+ int as;
+
+ sorted = lex_match_id ("SORTED");
+
+ for (cp = sbc; *cp; cp++)
+ if (token == T_ID && lex_id_match (*cp, tokid))
+ {
+ lex_get ();
+ break;
+ }
+ as = cp - sbc;
+
+ if (*cp == NULL)
+ as = AS_NAMES;
+
+ if (as == AS_VECTOR)
+ {
+ display_vectors (sorted);
+ return CMD_SUCCESS;
+ }
+
+ lex_match ('/');
+ lex_match_id ("VARIABLES");
+ lex_match ('=');
+
+ if (token != '.')
+ {
+ if (!parse_variables (NULL, &vl, &n, PV_NONE))
+ {
+ free (vl);
+ return CMD_FAILURE;
+ }
+ as = AS_DICTIONARY;
+ }
+ else
+ fill_all_vars (&vl, &n, FV_NONE);
+
+ if (as == AS_SCRATCH)
+ {
+ int i, m;
+ for (i = 0, m = n; i < n; i++)
+ if (vl[i]->name[0] != '#')
+ {
+ vl[i] = NULL;
+ m--;
+ }
+ as = AS_NAMES;
+ n = m;
+ }
+
+ if (n == 0)
+ {
+ msg (SW, _("No variables to display."));
+ return CMD_FAILURE;
+ }
+
+ if (sorted)
+ qsort (vl, n, sizeof *vl, cmp_var_by_name);
+
+ display_variables (vl, n, as);
+
+ free (vl);
+ }
+
+ return lex_end_of_command ();
+}
+
+static int
+cmp_var_by_name (const void *a, const void *b)
+{
+ return strcmp ((*((struct variable **) a))->name, (*((struct variable **) b))->name);
+}
+
+static void
+display_macros (void)
+{
+ som_blank_line ();
+ tab_output_text (TAB_LEFT, _("Macros not supported."));
+}
+
+static void
+display_documents (void)
+{
+ som_blank_line ();
+ if (default_dict.n_documents == 0)
+ tab_output_text (TAB_LEFT, _("The active file dictionary does not "
+ "contain any documents."));
+ else
+ {
+ char buf[81];
+ int i;
+
+ tab_output_text (TAB_LEFT | TAT_TITLE,
+ _("Documents in the active file:"));
+ som_blank_line ();
+ buf[80] = 0;
+ for (i = 0; i < default_dict.n_documents; i++)
+ {
+ int len = 79;
+
+ memcpy (buf, &default_dict.documents[i * 80], 80);
+ while ((isspace ((unsigned char) buf[len]) || buf[len] == 0)
+ && len > 0)
+ len--;
+ buf[len + 1] = 0;
+ tab_output_text (TAB_LEFT | TAT_FIX | TAT_NOWRAP, buf);
+ }
+ }
+}
+
+static int _as;
+
+/* Sets the widths of all the columns and heights of all the rows in
+ table T for driver D. */
+static void
+variables_dim (struct tab_table *t, struct outp_driver *d)
+{
+ int pc;
+ int i;
+
+ t->w[0] = tab_natural_width (t, d, 0);
+ if (_as == AS_DICTIONARY || _as == AS_VARIABLES || _as == AS_LABELS)
+ {
+ t->w[1] = max (tab_natural_width (t, d, 1), d->prop_em_width * 5);
+ t->w[2] = max (tab_natural_width (t, d, 2), d->prop_em_width * 35);
+ pc = 3;
+ }
+ else pc = 1;
+ if (_as != AS_NAMES)
+ t->w[pc] = tab_natural_width (t, d, pc);
+
+ for (i = 0; i < t->nr; i++)
+ t->h[i] = tab_natural_height (t, d, i);
+}
+
+static void
+display_variables (struct variable **vl, int n, int as)
+{
+ struct variable **vp = vl; /* Variable pointer. */
+ struct tab_table *t;
+ int nc; /* Number of columns. */
+ int nr; /* Number of rows. */
+ int pc; /* `Position column' */
+ int r; /* Current row. */
+ int i;
+
+ _as = as;
+ switch (as)
+ {
+ case AS_INDEX:
+ nc = 2;
+ break;
+ case AS_NAMES:
+ nc = 1;
+ break;
+ default:
+ nc = 4;
+ break;
+ }
+
+ t = tab_create (nc, n + 5, 1);
+ tab_headers (t, 0, 0, 1, 0);
+ nr = n + 5;
+ tab_hline (t, TAL_2, 0, nc - 1, 1);
+ tab_text (t, 0, 0, TAB_LEFT | TAT_TITLE, _("Variable"));
+ if (as != AS_NAMES)
+ {
+ pc = (as == AS_INDEX ? 1 : 3);
+ tab_text (t, pc, 0, TAB_LEFT | TAT_TITLE, _("Position"));
+ }
+ if (as == AS_DICTIONARY || as == AS_VARIABLES)
+ tab_joint_text (t, 1, 0, 2, 0, TAB_LEFT | TAT_TITLE, _("Description"));
+ else if (as == AS_LABELS)
+ tab_joint_text (t, 1, 0, 2, 0, TAB_LEFT | TAT_TITLE, _("Label"));
+ tab_dim (t, variables_dim);
+
+ for (i = r = 1; i <= n; i++)
+ {
+ struct variable *v;
+
+ while (*vp == NULL)
+ vp++;
+ v = *vp++;
+
+ if (as == AS_DICTIONARY || as == AS_VARIABLES)
+ {
+ int nvl = v->val_lab ? avl_count (v->val_lab) : 0;
+
+ if (r + 10 + nvl > nr)
+ {
+ nr = max (nr * n / (i + 1), nr);
+ nr += 10 + nvl;
+ tab_realloc (t, nc, nr);
+ }
+
+ r = describe_variable (v, t, r, as);
+ } else {
+ tab_text (t, 0, r, TAB_LEFT, v->name);
+ if (as == AS_LABELS)
+ tab_joint_text (t, 1, r, 2, r, TAB_LEFT,
+ v->label == NULL ? "(no label)" : v->label);
+ if (as != AS_NAMES)
+ {
+ tab_text (t, pc, r, TAT_PRINTF, "%d", v->index + 1);
+ tab_hline (t, TAL_1, 0, nc - 1, r);
+ }
+ r++;
+ }
+ }
+ tab_hline (t, as == AS_NAMES ? TAL_1 : TAL_2, 0, nc - 1, 1);
+ if (as != AS_NAMES)
+ {
+ tab_box (t, TAL_1, TAL_1, -1, -1, 0, 0, nc - 1, r - 1);
+ tab_vline (t, TAL_1, 1, 0, r - 1);
+ }
+ else
+ tab_flags (t, SOMF_NO_TITLE);
+ if (as == AS_DICTIONARY || as == AS_VARIABLES || as == AS_LABELS)
+ tab_vline (t, TAL_1, 3, 0, r - 1);
+ tab_resize (t, -1, r);
+ tab_columns (t, TAB_COL_DOWN, 1);
+ tab_submit (t);
+}
+\f
+/* Puts a description of variable V into table T starting at row R.
+ The variable will be described in the format AS. Returns the next
+ row available for use in the table. */
+int
+describe_variable (struct variable *v, struct tab_table *t, int r, int as)
+{
+ /* Put the name, var label, and position into the first row. */
+ tab_text (t, 0, r, TAB_LEFT, v->name);
+ tab_text (t, 3, r, TAT_PRINTF, "%d", v->index + 1);
+
+ if (as == AS_DICTIONARY && v->label)
+ {
+ tab_joint_text (t, 1, r, 2, r, TAB_LEFT, v->label);
+ r++;
+ }
+
+ /* Print/write format, or print and write formats. */
+ if (v->print.type == v->write.type
+ && v->print.w == v->write.w
+ && v->print.d == v->write.d)
+ {
+ tab_joint_text (t, 1, r, 2, r, TAB_LEFT | TAT_PRINTF, _("Format: %s"),
+ fmt_to_string (&v->print));
+ r++;
+ }
+ else
+ {
+ tab_joint_text (t, 1, r, 2, r, TAB_LEFT | TAT_PRINTF,
+ _("Print Format: %s"), fmt_to_string (&v->print));
+ r++;
+ tab_joint_text (t, 1, r, 2, r, TAB_LEFT | TAT_PRINTF,
+ _("Write Format: %s"), fmt_to_string (&v->write));
+ r++;
+ }
+
+ /* Missing values if any. */
+ if (v->miss_type != MISSING_NONE)
+ {
+ char buf[80];
+ char *cp = stpcpy (buf, _("Missing Values: "));
+
+ if (v->type == NUMERIC)
+ switch (v->miss_type)
+ {
+ case MISSING_1:
+ sprintf (cp, "%g", v->missing[0].f);
+ break;
+ case MISSING_2:
+ sprintf (cp, "%g; %g", v->missing[0].f, v->missing[1].f);
+ break;
+ case MISSING_3:
+ sprintf (cp, "%g; %g; %g", v->missing[0].f,
+ v->missing[1].f, v->missing[2].f);
+ break;
+ case MISSING_RANGE:
+ sprintf (cp, "%g THRU %g", v->missing[0].f, v->missing[1].f);
+ break;
+ case MISSING_LOW:
+ sprintf (cp, "LOWEST THRU %g", v->missing[0].f);
+ break;
+ case MISSING_HIGH:
+ sprintf (cp, "%g THRU HIGHEST", v->missing[0].f);
+ break;
+ case MISSING_RANGE_1:
+ sprintf (cp, "%g THRU %g; %g",
+ v->missing[0].f, v->missing[1].f, v->missing[2].f);
+ break;
+ case MISSING_LOW_1:
+ sprintf (cp, "LOWEST THRU %g; %g",
+ v->missing[0].f, v->missing[1].f);
+ break;
+ case MISSING_HIGH_1:
+ sprintf (cp, "%g THRU HIGHEST; %g",
+ v->missing[0].f, v->missing[1].f);
+ break;
+ default:
+ assert (0);
+ }
+ else
+ {
+ int i;
+
+ for (i = 0; i < v->miss_type; i++)
+ {
+ if (i != 0)
+ cp = stpcpy (cp, "; ");
+ *cp++ = '"';
+ memcpy (cp, v->missing[i].s, v->width);
+ cp += v->width;
+ *cp++ = '"';
+ }
+ *cp = 0;
+ }
+
+ tab_joint_text (t, 1, r, 2, r, TAB_LEFT, buf);
+ r++;
+ }
+
+ /* Value labels. */
+ if (as == AS_DICTIONARY && v->val_lab)
+ {
+ avl_traverser trav;
+ struct value_label *vl;
+ int nvl = avl_count (v->val_lab);
+ int orig_r = r;
+ int i;
+
+#if 0
+ tab_text (t, 1, r, TAB_LEFT, _("Value"));
+ tab_text (t, 2, r, TAB_LEFT, _("Label"));
+ r++;
+#endif
+
+ tab_hline (t, TAL_1, 1, 2, r);
+ avl_traverser_init (trav);
+ for (i = 1, vl = avl_traverse (v->val_lab, &trav); vl;
+ i++, vl = avl_traverse (v->val_lab, &trav))
+ {
+ char buf[128];
+
+ if (v->type == ALPHA)
+ {
+ memcpy (buf, vl->v.s, v->width);
+ buf[v->width] = 0;
+ }
+ else
+ sprintf (buf, "%g", vl->v.f);
+
+ tab_text (t, 1, r, TAB_NONE, buf);
+ tab_text (t, 2, r, TAB_LEFT, vl->s);
+ r++;
+
+ if (i == nvl)
+ break;
+ }
+
+ for (;;)
+ {
+ if (vl == NULL)
+ break;
+ vl = avl_traverse (v->val_lab, &trav);
+ }
+
+ tab_vline (t, TAL_1, 2, orig_r, r - 1);
+ }
+
+ /* Draw a line below the last row of information on this variable. */
+ tab_hline (t, TAL_1, 0, 3, r);
+
+ return r;
+}
+
+static int
+compare_vectors_by_name (const void *a, const void *b)
+{
+ return strcmp ((*((struct vector **) a))->name, (*((struct vector **) b))->name);
+}
+
+/* Display a list of vectors. If SORTED is nonzero then they are
+ sorted alphabetically. */
+static void
+display_vectors (int sorted)
+{
+ struct vector **vl;
+ int i;
+ struct tab_table *t;
+
+ if (nvec == 0)
+ {
+ msg (SW, _("No vectors defined."));
+ return;
+ }
+
+ vl = xmalloc (sizeof *vl * nvec);
+ for (i = 0; i < nvec; i++)
+ vl[i] = &vec[i];
+ if (sorted)
+ qsort (vl, nvec, sizeof *vl, compare_vectors_by_name);
+
+ t = tab_create (1, nvec + 1, 0);
+ tab_headers (t, 0, 0, 1, 0);
+ tab_columns (t, TAB_COL_DOWN, 1);
+ tab_dim (t, tab_natural_dimensions);
+ tab_hline (t, TAL_1, 0, 0, 1);
+ tab_text (t, 0, 0, TAT_TITLE | TAB_LEFT, _("Vector"));
+ tab_flags (t, SOMF_NO_TITLE);
+ for (i = 0; i < nvec; i++)
+ tab_text (t, 0, i + 1, TAB_LEFT, vl[i]->name);
+ tab_submit (t);
+
+ free (vl);
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "alloc.h"
+#include "str.h"
+#include "dcdflib/cdflib.h"
+#include "command.h"
+#include "lexer.h"
+#include "error.h"
+#include "magic.h"
+#include "var.h"
+#include "vfm.h"
+
+/* (specification)
+ "T-TEST" (tts_):
+ groups=custom;
+ variables=varlist("PV_NO_SCRATCH | PV_NUMERIC");
+ *+pairs=custom;
+ +missing=miss:!analysis/listwise,
+ incl:include/!exclude;
+ +format=fmt:!labels/nolabels;
+ +criteria=:ci(d:criteria,"%s > 0. && %s < 1.").
+*/
+/* (declarations) */
+/* (functions) */
+
+#undef DEBUGGING
+#define DEBUGGING 1
+#include "debug-print.h"
+
+/* Command parsing information. */
+static struct cmd_t_test cmd;
+
+/* Variable for the GROUPS subcommand, if given. */
+static struct variable *groups;
+
+/* GROUPS: Number of values specified by the user; the values
+ specified if any. */
+static int n_groups_values;
+static union value groups_values[2];
+
+/* PAIRED: Number of pairs; each pair. */
+static int n_pairs;
+static struct variable *(*pairs)[2];
+
+/* Routines to scan data and perform t-tests */
+static void precalc (void);
+static void postcalc (void);
+static void g_postcalc (void);
+static void t_pairs (void);
+static void t_groups (void);
+static int groups_calc (struct ccase *);
+static int pairs_calc (struct ccase *);
+static int z_calc (struct ccase *);
+
+struct value_list
+ {
+ double sum;
+ double ss;
+ double n;
+ struct value_list *next;
+ };
+
+/* general workhorses - should move these to a separate library... */
+double variance (double n, double ss, double sum);
+
+double covariance (double x_sum, double x_n,
+ double y_sum, double y_n, double ss);
+
+double pooled_variance (double n_1, double var_1,
+ double n_2, double var_2);
+
+double oneway (double *f, double *p, struct value_list *list);
+
+double pearson_r (double c_xy, double c_xx, double c_yy);
+
+double f_sig (double f, double dfn, double dfd);
+double t_crt (double df, double q);
+double t_sig (double t, double df);
+
+/* massive function simply to remove any responsibility for output
+ from the function which does the actual t-test calculations */
+void print_t_groups (struct variable * grps, union value * g1, union value * g2,
+ double n1, double n2, double mean1, double mean2,
+ double sd1, double sd2, double se1, double se2,
+ double diff, double l_f, double l_p,
+ double p_t, double p_sig, double p_df, double p_sed,
+ double p_l, double p_h,
+ double s_t, double s_sig, double s_df, double s_sed,
+ double s_l, double s_h);
+
+/* Global variables to communicate between calc() and postcalc()
+ should move to a structure in the p union of variable... */
+static double v1_n, v1_ss, v1_sum, v1_se, v1_var, v1_mean;
+static double v2_n, v2_ss, v2_sum, v2_se, v2_var, v2_mean;
+static double v1_z_sum, v1_z_ss;
+static double v2_z_sum, v2_z_ss;
+static double diff, se_diff, sp, xy_sum, xy_diff, xy_ss;
+static int cur_var;
+
+/* some defines for CDFlib */
+#define FIND_P 1
+#define FIND_CRITICAL_VALUE 2
+#define ERROR_SIG -1
+
+#ifdef DEBUGGING
+static void debug_print (void);
+#endif
+
+/* Parses and executes the T-TEST procedure. */
+int
+cmd_t_test (void)
+{
+ struct cmd_t_test cmd;
+
+ if (!lex_force_match_id ("T"))
+ return CMD_FAILURE;
+ lex_match ('-');
+ lex_match_id ("TEST");
+
+ if (!parse_t_test (&cmd))
+ return CMD_FAILURE;
+
+#if DEBUGGING
+ debug_print ();
+#endif
+
+ if (n_pairs > 0)
+ procedure (precalc, pairs_calc, postcalc);
+ else
+ /* probably groups then... */
+ {
+ printf ("\n\n t-tests for independent samples of %s %s\n",
+ groups->name, groups->label);
+
+ for (cur_var = 0; cur_var < cmd.n_variables; cur_var++)
+ {
+ v1_n = v1_ss = v1_sum = v1_se = v1_var = v1_mean = 0.0;
+ v2_n = v2_ss = v2_sum = v2_se = v2_var = v2_mean = 0.0;
+ v1_z_sum = v1_z_ss = v2_z_sum = v2_z_ss = 0.0;
+ diff = se_diff = sp = xy_diff = xy_ss = xy_sum = 0.0;
+
+ procedure (precalc, groups_calc, g_postcalc);
+ procedure (precalc, z_calc, postcalc);
+ }
+ }
+
+ return CMD_SUCCESS;
+}
+
+void
+precalc (void)
+{
+ return; /* rilly void... */
+}
+
+int
+groups_calc (struct ccase * c)
+{
+ int bad_weight;
+ double group, w;
+ struct variable *v = cmd.v_variables[cur_var];
+ double X = c->data[v->fv].f;
+
+ /* Get the weight for this case. */
+ if (default_dict.weight_index == -1)
+ w = 1.0;
+ else
+ {
+ w = c->data[default_dict.weight_index].f;
+ if (w <= 0.0 || w == SYSMIS)
+ {
+ w = 0.0;
+ bad_weight = 1;
+ printf ("Bad weight\n");
+ }
+ }
+
+ if (X == SYSMIS || X == 0.0) /* FIXME: should be USER_MISSING? */
+ {
+ /* printf("Missing value\n"); */
+ return 1;
+ }
+ else
+ {
+ X = X * w;
+ group = c->data[groups->fv].f;
+
+ if (group == groups_values[0].f)
+ {
+ v1_sum += X;
+ v1_ss += X * X;
+ v1_n += w;
+ }
+ else if (group == groups_values[1].f)
+ {
+ v2_sum += X;
+ v2_ss += X * X;
+ v2_n += w;
+ }
+ }
+
+ return 1;
+}
+
+void
+g_postcalc (void)
+{
+ v1_mean = v1_sum / v1_n;
+ v2_mean = v2_sum / v2_n;
+ return;
+}
+
+int /* this pass generates the z-zcores */
+z_calc (struct ccase * c)
+{
+ int bad_weight;
+ double group, z, w;
+ struct variable *v = cmd.v_variables[cur_var];
+ double X = c->data[v->fv].f;
+
+ z = 0.0;
+
+ /* Get the weight for this case. */
+ if (default_dict.weight_index == -1)
+ w = 1.0;
+ else
+ {
+ w = c->data[default_dict.weight_index].f;
+ if (w <= 0.0 || w == SYSMIS)
+ {
+ w = 0.0;
+ bad_weight = 1;
+ }
+ }
+
+ if (X == SYSMIS || X == 0.0) /* FIXME: how to specify user missing? */
+ {
+ return 1;
+ }
+ else
+ {
+ group = c->data[groups->fv].f;
+ X = w * X;
+
+ if (group == groups_values[0].f)
+ {
+ z = fabs (X - v1_mean);
+ v1_z_sum += z;
+ v1_z_ss += pow (z, 2);
+ }
+ else if (group == groups_values[1].f)
+ {
+ z = fabs (X - v2_mean);
+ v2_z_ss += pow (z, 2);
+ v2_z_sum += z;
+ }
+ }
+
+ return 1;
+}
+
+
+int
+pairs_calc (struct ccase * c)
+{
+ int i;
+ struct variable *v1, *v2;
+ double X, Y;
+
+ for (i = 0; i < n_pairs; i++)
+ {
+
+ v1 = pairs[i][0];
+ v2 = pairs[i][1];
+ X = c->data[v1->fv].f;
+ Y = c->data[v2->fv].f;
+
+ if (X == SYSMIS || Y == SYSMIS)
+ {
+ printf ("Missing value\n");
+ }
+ else
+ {
+ xy_sum += X * Y;
+ xy_diff += (X - Y);
+ xy_ss += pow ((X - Y), 2);
+ v1_sum += X;
+ v2_sum += Y;
+ v1_n++;
+ v2_n++;
+ v1_ss += (X * X);
+ v2_ss += (Y * Y);
+ }
+ }
+
+ return 1;
+}
+
+void
+postcalc (void)
+{
+ /* Calculate basic statistics */
+ v1_var = variance (v1_n, v1_ss, v1_sum); /* variances */
+ v2_var = variance (v2_n, v2_ss, v2_sum);
+ v1_se = sqrt (v1_var / v1_n); /* standard errors */
+ v2_se = sqrt (v2_var / v2_n);
+ diff = v1_mean - v2_mean;
+
+ if (n_pairs > 0)
+ {
+ t_pairs ();
+ }
+ else
+ {
+ t_groups ();
+ }
+
+ return;
+}
+
+void
+t_groups (void)
+{
+ double df_pooled, t_pooled, t_sep, p_pooled, p_sep;
+ double crt_t_p, crt_t_s, tmp, v1_z, v2_z, f_levene, p_levene;
+ double df_sep, se_diff_s, se_diff_p;
+ struct value_list *val_1, *val_2;
+
+ /* Levene's test */
+ val_1 = malloc (sizeof (struct value_list));
+ val_1->sum = v1_z_sum;
+ val_1->ss = v1_z_ss;
+ val_1->n = v1_n;
+ val_2 = malloc (sizeof (struct value_list));
+ val_2->sum = v2_z_sum;
+ val_2->ss = v2_z_ss;
+ val_2->n = v2_n;
+
+ val_1->next = val_2;
+ val_2->next = NULL;
+
+ f_levene = oneway (&f_levene, &p_levene, val_1);
+
+ /* T test results for pooled variances */
+ se_diff_p = sqrt (pooled_variance (v1_n, v1_var, v2_n, v2_var));
+ df_pooled = v1_n + v2_n - 2.0;
+ t_pooled = diff / se_diff_p;
+ p_pooled = t_sig (t_pooled, df_pooled);
+ crt_t_p = t_crt (df_pooled, 0.025);
+
+ if ((2.0 * p_pooled) >= 1.0)
+ p_pooled = 1.0 - p_pooled;
+
+ /* oh god, the separate variance calculations... */
+ t_sep = diff / sqrt ((v1_var / v1_n) + (v2_var / v2_n));
+
+ tmp = (v1_var / v1_n) + (v2_var / v2_n);
+ tmp = (v1_var / v1_n) / tmp;
+ tmp = pow (tmp, 2);
+ tmp = tmp / (v1_n - 1.0);
+ v1_z = tmp;
+
+ tmp = (v1_var / v1_n) + (v2_var / v2_n);
+ tmp = (v2_var / v2_n) / tmp;
+ tmp = pow (tmp, 2);
+ tmp = tmp / (v2_n - 1.0);
+ v2_z = tmp;
+
+ tmp = 1.0 / (v1_z + v2_z);
+
+ df_sep = tmp;
+ p_sep = t_sig (t_sep, df_sep);
+ if ((2.0 * p_sep) >= 1.0)
+ p_sep = 1.0 - p_sep;
+ crt_t_s = t_crt (df_sep, 0.025);
+ se_diff_s = sqrt ((v1_var / v1_n) + (v2_var / v2_n));
+
+ /* FIXME: convert to a proper PSPP output call */
+ print_t_groups (groups, &groups_values[0], &groups_values[1],
+ v1_n, v2_n, v1_mean, v2_mean,
+ sqrt (v1_var), sqrt (v2_var), v1_se, v2_se,
+ diff, f_levene, p_levene,
+ t_pooled, 2.0 * p_pooled, df_pooled, se_diff_p,
+ diff - (crt_t_p * se_diff_p), diff + (crt_t_p * se_diff_p),
+ t_sep, 2.0 * p_sep, df_sep, se_diff_s,
+ diff - (crt_t_s * se_diff_s), diff + (crt_t_s * se_diff_s));
+ return;
+}
+
+void
+t_pairs (void)
+{
+ double cov12, cov11, cov22, r, t, p, crt_t, sp, r_t, r_p;
+ struct variable *v1, *v2;
+
+ v1 = pairs[0][0];
+ v2 = pairs[0][1];
+ cov12 = covariance (v1_sum, v1_n, v2_sum, v2_n, xy_sum);
+ cov11 = covariance (v1_sum, v1_n, v1_sum, v1_n, v1_ss);
+ cov22 = covariance (v2_sum, v2_n, v2_sum, v2_n, v2_ss);
+ r = pearson_r (cov12, cov11, cov22);
+ /* this t and it's associated p is a significance test for the pearson's r */
+ r_t = r * sqrt ((v1_n - 2.0) / (1.0 - (r * r)));
+ r_p = t_sig (r_t, v1_n - 2.0);
+
+ /* now we move to the t test for the difference in means */
+ diff = xy_diff / v1_n;
+ sp = sqrt (variance (v1_n, xy_ss, xy_diff));
+ se_diff = sp / sqrt (v1_n);
+ t = diff / se_diff;
+ crt_t = t_crt (v1_n - 1.0, 0.025);
+ p = t_sig (t, v1_n - 1.0);
+
+
+ printf (" Number of 2-tail\n");
+ printf (" Variable pairs Corr Sig Mean SD SE of Mean\n");
+ printf ("---------------------------------------------------------------\n");
+ printf ("%s %8.4f %8.4f %8.4f\n",
+ v1->name, v1_mean, sqrt (v1_var), v1_se);
+ printf (" %8.4f %0.4f %0.4f\n", v1_n, r, r_p);
+ printf ("%s %8.4f %8.4f %8.4f\n",
+ v2->name, v2_mean, sqrt (v2_var), v2_se);
+ printf ("---------------------------------------------------------------\n");
+
+ printf ("\n\n\n");
+ printf (" Paired Differences |\n");
+ printf (" Mean SD SE of Mean | t-value df 2-tail Sig\n");
+ printf ("--------------------------------------|---------------------------\n");
+
+ printf ("%8.4f %8.4f %8.4f | %8.4f %8.4f %8.4f\n",
+ diff, sp, se_diff, t, v1_n - 1.0, 2.0 * (1.0 - p));
+
+ printf ("95pc CI (%8.4f, %8.4f) |\n\n",
+ diff - (se_diff * crt_t), diff + (se_diff * crt_t));
+
+ return;
+}
+
+static int parse_value (union value *);
+
+/* Parses the GROUPS subcommand. */
+int
+tts_custom_groups (struct cmd_t_test *cmd unused)
+{
+ groups = parse_variable ();
+ if (!groups)
+ {
+ lex_error (_("expecting variable name in GROUPS subcommand"));
+ return 0;
+ }
+ if (groups->type == T_STRING && groups->width > MAX_SHORT_STRING)
+ {
+ msg (SE, _("Long string variable %s is not valid here."),
+ groups->name);
+ return 0;
+ }
+
+ if (!lex_match ('('))
+ {
+ if (groups->type == NUMERIC)
+ {
+ n_groups_values = 2;
+ groups_values[0].f = 1;
+ groups_values[1].f = 2;
+ return 1;
+ }
+ else
+ {
+ msg (SE, _("When applying GROUPS to a string variable, at "
+ "least one value must be specified."));
+ return 0;
+ }
+ }
+
+ if (!parse_value (&groups_values[0]))
+ return 0;
+ n_groups_values = 1;
+
+ lex_match (',');
+
+ if (lex_match (')'))
+ return 1;
+
+ if (!parse_value (&groups_values[1]))
+ return 0;
+ n_groups_values = 2;
+
+ if (!lex_force_match (')'))
+ return 0;
+
+ return 1;
+}
+
+/* Parses the current token (numeric or string, depending on the
+ variable in `groups') into value V and returns success. */
+static int
+parse_value (union value * v)
+{
+ if (groups->type == NUMERIC)
+ {
+ if (!lex_force_num ())
+ return 0;
+ v->f = tokval;
+ }
+ else
+ {
+ if (!lex_force_string ())
+ return 0;
+ strncpy (v->s, ds_value (&tokstr), ds_length (&tokstr));
+ }
+
+ lex_get ();
+
+ return 1;
+}
+
+/* Parses the PAIRS subcommand. */
+static int
+tts_custom_pairs (struct cmd_t_test *cmd unused)
+{
+ struct variable **vars;
+ int n_before_WITH;
+ int n_vars;
+ int paired;
+ int extra;
+#if DEBUGGING
+ int n_predicted;
+#endif
+
+ if ((token != T_ID || !is_varname (tokid)) && token != T_ALL)
+ return 2;
+ if (!parse_variables (&default_dict, &vars, &n_vars,
+ PV_DUPLICATE | PV_NUMERIC | PV_NO_SCRATCH))
+ return 0;
+
+ assert (n_vars);
+ if (lex_match (T_WITH))
+ {
+ n_before_WITH = n_vars;
+
+ if (!parse_variables (&default_dict, &vars, &n_vars,
+ PV_DUPLICATE | PV_APPEND
+ | PV_NUMERIC | PV_NO_SCRATCH))
+ {
+ free (vars);
+ return 0;
+ }
+ }
+ else
+ n_before_WITH = 0;
+
+ paired = (lex_match ('(') && lex_match_id ("PAIRED") && lex_match (')'));
+
+ if (paired)
+ {
+ if (n_before_WITH * 2 != n_vars)
+ {
+ free (vars);
+ msg (SE, _("PAIRED was specified but the number of variables "
+ "preceding WITH (%d) did not match the number "
+ "following (%d)."),
+ n_before_WITH, n_vars - n_before_WITH);
+ return 0;
+ }
+
+ extra = n_before_WITH;
+ }
+ else if (n_before_WITH)
+ extra = n_before_WITH * (n_vars - n_before_WITH);
+ else
+ {
+ if (n_vars < 2)
+ {
+ free (vars);
+ msg (SE, _("At least two variables must be specified "
+ "on PAIRS."));
+ return 0;
+ }
+
+ extra = n_vars * (n_vars - 1) / 2;
+ }
+
+#if DEBUGGING
+ n_predicted = n_pairs + extra;
+#endif
+
+ pairs = xrealloc (pairs, sizeof (struct variable *[2]) * (n_pairs + extra));
+
+ if (paired)
+ {
+ int i;
+
+ for (i = 0; i < extra; i++)
+ {
+ pairs[n_pairs][0] = vars[i];
+ pairs[n_pairs++][1] = vars[i + extra];
+ }
+ }
+ else if (n_before_WITH)
+ {
+ int i;
+
+ for (i = 0; i < n_before_WITH; i++)
+ {
+ int j;
+
+ for (j = n_before_WITH; j < n_vars; j++)
+ {
+ pairs[n_pairs][0] = vars[i];
+ pairs[n_pairs++][1] = vars[j];
+ }
+ }
+ }
+ else
+ {
+ int i;
+
+ for (i = 0; i < n_vars; i++)
+ {
+ int j;
+
+ for (j = i + 1; j < n_vars; j++)
+ {
+ pairs[n_pairs][0] = vars[i];
+ pairs[n_pairs++][1] = vars[j];
+ }
+ }
+ }
+
+#if DEBUGGING
+ assert (n_pairs == n_predicted);
+#endif
+
+ free (vars);
+ return 1;
+}
+
+#if DEBUGGING
+static void
+debug_print (void)
+{
+ printf ("T-TEST\n");
+ if (groups)
+ {
+ printf (" GROUPS=%s", groups->name);
+ if (n_groups_values)
+ {
+ int i;
+
+ printf (" (");
+ for (i = 0; i < n_groups_values; i++)
+ if (groups->type == NUMERIC)
+ printf ("%g%s", groups_values[i].f, i ? " " : "");
+ else
+ printf ("%.*s%s", groups->width, groups_values[i].s,
+ i ? " " : "");
+ printf (")");
+ }
+ printf ("\n");
+ }
+ if (cmd.n_variables)
+ {
+ int i;
+
+ printf (" VARIABLES=");
+ for (i = 0; i < cmd.n_variables; i++)
+ printf ("%s ", cmd.v_variables[i]->name);
+ printf ("\n");
+ }
+ if (cmd.sbc_pairs)
+ {
+ int i;
+
+ printf (" PAIRS=");
+ for (i = 0; i < n_pairs; i++)
+ printf ("%s ", pairs[i][0]->name);
+ printf ("WITH");
+ for (i = 0; i < n_pairs; i++)
+ printf (" %s", pairs[i][1]->name);
+ printf (" (PAIRED)\n");
+ }
+ printf (" MISSING=%s %s\n",
+ cmd.miss == TTS_ANALYSIS ? "ANALYSIS" : "LISTWISE",
+ cmd.miss == TTS_INCLUDE ? "INCLUDE" : "EXCLUDE");
+ printf (" FORMAT=%s\n",
+ cmd.fmt == TTS_LABELS ? "LABELS" : "NOLABELS");
+ if (cmd.criteria != NOT_LONG)
+ printf (" CRITERIA=%f\n", cmd.criteria);
+}
+
+#endif /* DEBUGGING */
+
+/* Here are some general routines tha should probably be moved into
+ a separate library and documented as part of the PSPP "API" */
+double
+variance (double n, double ss, double sum)
+{
+ return ((ss - ((sum * sum) / n)) / (n - 1.0));
+}
+
+double
+pooled_variance (double n_1, double var_1, double n_2, double var_2)
+{
+ double tmp;
+
+ tmp = n_1 + n_2 - 2.0;
+ tmp = (((n_1 - 1.0) * var_1) + ((n_2 - 1.0) * var_2)) / tmp;
+ tmp = tmp * ((n_1 + n_2) / (n_1 * n_2));
+ return tmp;
+}
+
+double
+oneway (double *f, double *p, struct value_list *levels)
+{
+ double k, SSTR, SSE, SSTO, N, MSTR, MSE, sum, dftr, dfe, print;
+ struct value_list *g;
+
+ k = 0.0;
+
+ for (g = levels; g != NULL; g = g->next)
+ {
+ k++;
+ sum += g->sum;
+ N += g->n;
+ SSTR += g->ss - (pow (g->sum, 2) / g->n);
+ SSTO += g->ss;
+ }
+
+ SSTO = SSTO - (pow (sum, 2) / N);
+ SSE = SSTO - SSTR;
+
+ dftr = N - k;
+ dfe = k - 1.0;
+ MSTR = SSTR / dftr;
+ MSE = SSE / dfe;
+
+ *f = (MSE / MSTR);
+ *p = f_sig (*f, dfe, dftr);
+
+ print = 1.0;
+ if (print == 1.0)
+ {
+ printf ("sum1 %f, sum2 %f, ss1 %f, ss2 %f\n",
+ levels->sum, levels->next->sum, levels->ss, levels->next->ss);
+ printf (" - - - - - - O N E W A Y - - - - - -\n\n");
+ printf (" Variable %s %s\n",
+ cmd.v_variables[0]->name, cmd.v_variables[0]->label);
+ printf ("By Variable %s %s\n", groups->name, groups->label);
+ printf ("\n Analysis of Variance\n\n");
+ printf (" Sum of Mean F F\n");
+ printf ("Source D.F. Squares Squares Ratio Prob\n\n");
+ printf ("Between %8.0f %8.4f %8.4f %8.4f %8.4f\n",
+ dfe, SSE, MSE, *f, *p);
+ printf ("Within %8.0f %8.4f %8.4f\n", dftr, SSTR, MSTR);
+ printf ("Total %8.0f %8.4f\n\n\n", N - 1.0, SSTO);
+ }
+ return (*f);
+}
+
+double
+f_sig (double f, double dfn, double dfd)
+{
+ int which, status;
+ double p, q, bound;
+
+ which = FIND_P;
+ status = 1;
+ p = q = bound = 0.0;
+ cdff (&which, &p, &q, &f, &dfn, &dfd, &status, &bound);
+
+ switch (status)
+ {
+ case -1:
+ {
+ printf ("Parameter 1 is out of range\n");
+ break;
+ }
+ case -2:
+ {
+ printf ("Parameter 2 is out of range\n");
+ break;
+ }
+ case -3:
+ {
+ printf ("Parameter 3 is out of range\n");
+ break;
+ }
+ case -4:
+ {
+ printf ("Parameter 4 is out of range\n");
+ break;
+ }
+ case -5:
+ {
+ printf ("Parameter 5 is out of range\n");
+ break;
+ }
+ case -6:
+ {
+ printf ("Parameter 6 is out of range\n");
+ break;
+ }
+ case -7:
+ {
+ printf ("Parameter 7 is out of range\n");
+ break;
+ }
+ case -8:
+ {
+ printf ("Parameter 8 is out of range\n");
+ break;
+ }
+ case 0:
+ {
+ /* printf( "Command completed successfully\n" ); */
+ break;
+ }
+ case 1:
+ {
+ printf ("Answer appears to be lower than the lowest search bound\n");
+ break;
+ }
+ case 2:
+ {
+ printf ("Answer appears to be higher than the greatest search bound\n");
+ break;
+ }
+ case 3:
+ {
+ printf ("P - Q NE 1\n");
+ break;
+ }
+ }
+
+ if (status)
+ {
+ return (double) ERROR_SIG;
+ }
+ else
+ {
+ return q;
+ }
+}
+
+double
+t_crt (double df, double q)
+{
+ int which, status;
+ double p, bound, t;
+
+ which = FIND_CRITICAL_VALUE;
+ bound = 0.0;
+ p = 1.0 - q;
+ t = 0.0;
+
+ cdft (&which, &p, &q, &t, &df, &status, &bound);
+
+ switch (status)
+ {
+ case -1:
+ {
+ printf ("t_crt: Parameter 1 is out of range\n");
+ break;
+ }
+ case -2:
+ {
+ printf ("t_crt: value of p (%f) is out of range\n", p);
+ break;
+ }
+ case -3:
+ {
+ printf ("t_crt: value of q (%f) is out of range\n", q);
+ break;
+ }
+ case -4:
+ {
+ printf ("t_crt: value of df (%f) is out of range\n", df);
+ break;
+ }
+ case -5:
+ {
+ printf ("t_crt: Parameter 5 is out of range\n");
+ break;
+ }
+ case -6:
+ {
+ printf ("t_crt: Parameter 6 is out of range\n");
+ break;
+ }
+ case -7:
+ {
+ printf ("t_crt: Parameter 7 is out of range\n");
+ break;
+ }
+ case 0:
+ {
+ /* printf( "Command completed successfully\n" ); */
+ break;
+ }
+ case 1:
+ {
+ printf ("t_crt: Answer appears to be lower than the lowest search bound\n");
+ break;
+ }
+ case 2:
+ {
+ printf ("t_crt: Answer appears to be higher than the greatest search bound\n");
+ break;
+ }
+ case 3:
+ {
+ printf ("t_crt: P - Q NE 1\n");
+ break;
+ }
+ }
+
+ if (status)
+ {
+ return (double) ERROR_SIG;
+ }
+ else
+ {
+ return t;
+ }
+}
+
+double
+t_sig (double t, double df)
+{
+ int which, status;
+ double p, q, bound;
+
+ which = FIND_P;
+ q = 0.0;
+ p = 0.0;
+ bound = 0.0;
+
+ cdft (&which, &p, &q, &t, &df, &status, &bound);
+
+ switch (status)
+ {
+ case -1:
+ {
+ printf ("t-sig: Parameter 1 is out of range\n");
+ break;
+ }
+ case -2:
+ {
+ printf ("t-sig: Parameter 2 is out of range\n");
+ break;
+ }
+ case -3:
+ {
+ printf ("t-sig: Parameter 3 is out of range\n");
+ break;
+ }
+ case -4:
+ {
+ printf ("t-sig: Parameter 4 is out of range\n");
+ break;
+ }
+ case -5:
+ {
+ printf ("t-sig: Parameter 5 is out of range\n");
+ break;
+ }
+ case -6:
+ {
+ printf ("t-sig: Parameter 6 is out of range\n");
+ break;
+ }
+ case -7:
+ {
+ printf ("t-sig: Parameter 7 is out of range\n");
+ break;
+ }
+ case 0:
+ {
+ /* printf( "Command completed successfully\n" ); */
+ break;
+ }
+ case 1:
+ {
+ printf ("t-sig: Answer appears to be lower than the lowest search bound\n");
+ break;
+ }
+ case 2:
+ {
+ printf ("t-sig: Answer appears to be higher than the greatest search bound\n");
+ break;
+ }
+ case 3:
+ {
+ printf ("t-sig: P - Q NE 1\n");
+ break;
+ }
+ }
+
+ if (status)
+ {
+ return (double) ERROR_SIG;
+ }
+ else
+ {
+ return q;
+ }
+}
+
+double
+covariance (double x_sum, double x_n, double y_sum, double y_n, double ss)
+{
+ double tmp;
+
+ tmp = x_sum * y_sum;
+ tmp = tmp / x_n;
+ tmp = ss - tmp;
+ tmp = (tmp / (x_n + y_n - 1.0));
+ return tmp;
+}
+
+double
+pearson_r (double c_xy, double c_xx, double c_yy)
+{
+ return (c_xy / (sqrt (c_xx * c_yy)));
+}
+
+void
+print_t_groups (struct variable * grps, union value * g1, union value * g2,
+ double n1, double n2, double mean1, double mean2,
+ double sd1, double sd2, double se1, double se2,
+ double diff, double l_f, double l_p,
+ double p_t, double p_sig, double p_df, double p_sed,
+ double p_l, double p_h,
+ double s_t, double s_sig, double s_df, double s_sed,
+ double s_l, double s_h)
+{
+
+ /* Display all this shit as SPSS 6.0 does (roughly) */
+ printf ("\n\n Number \n");
+ printf (" Variable of Cases Mean SD SE of Mean\n");
+ printf ("-----------------------------------------------------------\n");
+ printf (" %s %s\n\n", cmd.v_variables[cur_var]->name, cmd.v_variables[cur_var]->label);
+ printf ("%s %8.4f %8.0f %8.4f %8.3f %8.3f\n",
+ get_val_lab (grps, *g1, 0), g1->f, n1, mean1, sd1, se1);
+ printf ("%s %8.4f %8.0f %8.4f %8.3f %8.3f\n",
+ get_val_lab (grps, *g2, 0), g2->f, n2, mean2, sd2, se2);
+ printf ("-----------------------------------------------------------\n");
+ printf ("\n Mean Difference = %8.4f\n", diff);
+ printf ("\n Levene's Test for Equality of Variances: F= %.3f P= %.3f\n",
+ l_f, l_p);
+ printf ("\n\n t-test for Equality of Means 95pc \n");
+ printf ("Variances t-value df 2-Tail Sig SE of Diff CI for Diff \n");
+ printf ("-----------------------------------------------------------------\n");
+ printf ("Equal %8.2f %8.0f %8.3f %8.3f (%8.3f, %8.3f)\n",
+ p_t, p_df, p_sig, p_sed, p_l, p_h);
+ printf ("Unequal %8.2f %8.2f %8.3f %8.3f (%8.3f, %8.3f)\n",
+ s_t, s_df, s_sig, s_sed, s_l, s_h);
+ printf ("-----------------------------------------------------------------\n");
+}
+
+/*
+ Local Variables:
+ mode: c
+ End:
+*/
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <ctype.h>
+#include <assert.h>
+#include <stdarg.h>
+#include <limits.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "format.h"
+#include "magic.h"
+#include "misc.h"
+#include "output.h"
+#include "pool.h"
+#include "som.h"
+#include "tab.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+\f
+extern struct som_table_class tab_table_class;
+
+#if DEBUGGING
+#define DEFFIRST(NAME, LABEL) LABEL,
+#define DEFTAB(NAME, LABEL) LABEL,
+static const char *tab_names[] =
+ {
+#include "tab.def"
+ };
+#undef DEFFIRST
+#undef DEFTAB
+#endif
+
+/* Creates a table with NC columns and NR rows. If REALLOCABLE is
+ nonzero then the table's size can be increased later; otherwise,
+ its size can only be reduced. */
+struct tab_table *
+tab_create (int nc, int nr, int reallocable)
+{
+ void *(*alloc_func) (struct pool *, size_t);
+
+ struct tab_table *t;
+
+ {
+ struct pool *container = pool_create ();
+ t = pool_alloc (container, sizeof *t);
+ t->container = container;
+ }
+
+ t->col_style = TAB_COL_NONE;
+ t->col_group = 0;
+ ls_null (&t->title);
+ t->flags = SOMF_NONE;
+ t->nr = nr;
+ t->nc = t->cf = nc;
+ t->l = t->r = t->t = t->b = 0;
+
+ alloc_func = reallocable ? pool_malloc : pool_alloc;
+#if GLOBAL_DEBUGGING
+ t->reallocable = reallocable;
+#endif
+
+ t->cc = alloc_func (t->container, nr * nc * sizeof *t->cc);
+ t->ct = alloc_func (t->container, nr * nc);
+ memset (t->ct, TAB_EMPTY, nc * nr);
+
+ t->rh = alloc_func (t->container, nc * (nr + 1));
+ memset (t->rh, 0, nc * (nr + 1));
+
+ t->hrh = alloc_func (t->container, sizeof *t->hrh * (nr + 1));
+ memset (t->hrh, 0, sizeof *t->hrh * (nr + 1));
+
+ t->trh = alloc_func (t->container, nr + 1);
+ memset (t->trh, 0, nr + 1);
+
+ t->rv = alloc_func (t->container, (nc + 1) * nr);
+ memset (t->rv, 0, (nc + 1) * nr);
+
+ t->wrv = alloc_func (t->container, sizeof *t->wrv * (nc + 1));
+ memset (t->wrv, 0, sizeof *t->wrv * (nc + 1));
+
+ t->trv = alloc_func (t->container, nc + 1);
+ memset (t->trv, 0, nc + 1);
+
+ t->dim = NULL;
+ t->w = t->h = NULL;
+ t->col_ofs = t->row_ofs = 0;
+
+ return t;
+}
+
+/* Destroys table T. */
+void
+tab_destroy (struct tab_table *t)
+{
+ assert (t != NULL);
+ pool_destroy (t->container);
+}
+
+/* Sets the width and height of a table, in columns and rows,
+ respectively. Use only to reduce the size of a table, since it
+ does not change the amount of allocated memory. */
+void
+tab_resize (struct tab_table *t, int nc, int nr)
+{
+ assert (t != NULL);
+ if (nc != -1)
+ {
+ assert (nc + t->col_ofs <= t->cf);
+ t->nc = nc + t->col_ofs;
+ }
+ if (nr != -1)
+ {
+ assert (nr + t->row_ofs <= t->nr);
+ t->nr = nr + t->row_ofs;
+ }
+}
+
+/* Changes either or both dimensions of a table. Consider using the
+ above routine instead if it won't waste a lot of space.
+
+ Changing the number of columns in a table is particularly expensive
+ in space and time. Avoid doing such. FIXME: In fact, transferring
+ of rules isn't even implemented yet. */
+void
+tab_realloc (struct tab_table *t, int nc, int nr)
+{
+ int ro, co;
+
+ assert (t != NULL);
+#if GLOBAL_DEBUGGING
+ assert (t->reallocable);
+#endif
+ ro = t->row_ofs;
+ co = t->col_ofs;
+ if (ro || co)
+ tab_offset (t, 0, 0);
+
+ if (nc == -1)
+ nc = t->nc;
+ if (nr == -1)
+ nr = t->nr;
+
+ assert (nc == t->nc);
+
+ if (nc > t->cf)
+ {
+ int mr1 = min (nr, t->nr);
+ int mc1 = min (nc, t->nc);
+
+ struct len_string *new_cc;
+ unsigned char *new_ct;
+ int r;
+
+ new_cc = pool_malloc (t->container, nr * nc * sizeof *new_cc);
+ new_ct = pool_malloc (t->container, nr * nc);
+ for (r = 0; r < mr1; r++)
+ {
+ memcpy (&new_cc[r * nc], &t->cc[r * t->nc], mc1 * sizeof *t->cc);
+ memcpy (&new_ct[r * nc], &t->ct[r * t->nc], mc1);
+ memset (&new_ct[r * nc + t->nc], TAB_EMPTY, nc - t->nc);
+ }
+ pool_free (t->container, t->cc);
+ pool_free (t->container, t->ct);
+ t->cc = new_cc;
+ t->ct = new_ct;
+ t->cf = nc;
+ }
+ else if (nr != t->nr)
+ {
+ t->cc = pool_realloc (t->container, t->cc, nr * nc * sizeof *t->cc);
+ t->ct = pool_realloc (t->container, t->ct, nr * nc);
+
+ t->rh = pool_realloc (t->container, t->rh, nc * (nr + 1));
+ t->rv = pool_realloc (t->container, t->rv, (nc + 1) * nr);
+ t->trh = pool_realloc (t->container, t->trh, nr + 1);
+ t->hrh = pool_realloc (t->container, t->hrh,
+ sizeof *t->hrh * (nr + 1));
+
+ if (nr > t->nr)
+ {
+ memset (&t->rh[nc * (t->nr + 1)], 0, (nr - t->nr) * nc);
+ memset (&t->rv[(nc + 1) * t->nr], 0, (nr - t->nr) * (nc + 1));
+ memset (&t->trh[t->nr + 1], 0, nr - t->nr);
+ }
+ }
+
+ memset (&t->ct[nc * t->nr], TAB_EMPTY, nc * (nr - t->nr));
+
+ t->nr = nr;
+ t->nc = nc;
+
+ if (ro || co)
+ tab_offset (t, co, ro);
+}
+
+/* Sets the number of header rows on each side of TABLE to L on the
+ left, R on the right, T on the top, B on the bottom. Header rows
+ are repeated when a table is broken across multiple columns or
+ multiple pages. */
+void
+tab_headers (struct tab_table *table, int l, int r, int t, int b)
+{
+ assert (table != NULL);
+ table->l = l;
+ table->r = r;
+ table->t = t;
+ table->b = b;
+}
+
+/* Set up table T so that, when it is an appropriate size, it will be
+ displayed across the page in columns.
+
+ STYLE is a TAB_COL_* constant. GROUP is the number of rows to take
+ as a unit. */
+void
+tab_columns (struct tab_table *t, int style, int group)
+{
+ assert (t != NULL);
+ t->col_style = style;
+ t->col_group = group;
+}
+\f
+/* Rules. */
+
+/* Draws a vertical line to the left of cells at horizontal position X
+ from Y1 to Y2 inclusive in style STYLE, if style is not -1. */
+void
+tab_vline (struct tab_table *t, int style, int x, int y1, int y2)
+{
+ int y;
+
+ assert (t != NULL);
+#if GLOBAL_DEBUGGING
+ if (x + t->col_ofs < 0 || x + t->col_ofs > t->nc
+ || y1 + t->row_ofs < 0 || y1 + t->row_ofs >= t->nr
+ || y2 + t->row_ofs < 0 || y2 + t->row_ofs >= t->nr)
+ {
+ printf (_("bad vline: x=%d+%d=%d y=(%d+%d=%d,%d+%d=%d) in "
+ "table size (%d,%d)\n"),
+ x, t->col_ofs, x + t->col_ofs,
+ y1, t->row_ofs, y1 + t->row_ofs,
+ y2, t->row_ofs, y2 + t->row_ofs,
+ t->nc, t->nr);
+ return;
+ }
+#endif
+
+ x += t->col_ofs;
+ y1 += t->row_ofs;
+ y2 += t->row_ofs;
+
+ if (style != -1)
+ {
+ if ((style & TAL_SPACING) == 0)
+ for (y = y1; y <= y2; y++)
+ t->rv[x + (t->cf + 1) * y] = style;
+ t->trv[x] |= (1 << (style & ~TAL_SPACING));
+ }
+}
+
+/* Draws a horizontal line above cells at vertical position Y from X1
+ to X2 inclusive in style STYLE, if style is not -1. */
+void
+tab_hline (struct tab_table * t, int style, int x1, int x2, int y)
+{
+ int x;
+
+ assert (t != NULL);
+#if GLOBAL_DEBUGGING
+ if (x1 + t->col_ofs < 0 || x1 + t->col_ofs >= t->nc
+ || x2 + t->col_ofs < 0 || x2 + t->col_ofs >= t->nc
+ || y + t->row_ofs < 0 || y + t->row_ofs > t->nr)
+ {
+ printf (_("bad hline: x=(%d+%d=%d,%d+%d=%d) y=%d+%d=%d "
+ "in table size (%d,%d)\n"),
+ x1, t->col_ofs, x1 + t->col_ofs,
+ x2, t->col_ofs, x2 + t->col_ofs,
+ y, t->row_ofs, y + t->row_ofs,
+ t->nc, t->nr);
+ return;
+ }
+#endif
+
+ x1 += t->col_ofs;
+ x2 += t->col_ofs;
+ y += t->row_ofs;
+
+ if (style != -1)
+ {
+ if ((style & TAL_SPACING) == 0)
+ for (x = x1; x <= x2; x++)
+ t->rh[x + t->cf * y] = style;
+ t->trh[y] |= (1 << (style & ~TAL_SPACING));
+ }
+}
+
+/* Draws a box around cells (X1,Y1)-(X2,Y2) inclusive with horizontal
+ lines of style F_H and vertical lines of style F_V. Fills the
+ interior of the box with horizontal lines of style I_H and vertical
+ lines of style I_V. Any of the line styles may be -1 to avoid
+ drawing those lines. This is distinct from 0, which draws a null
+ line. */
+void
+tab_box (struct tab_table *t, int f_h, int f_v, int i_h, int i_v,
+ int x1, int y1, int x2, int y2)
+{
+ assert (t != NULL);
+#if GLOBAL_DEBUGGING
+ if (x1 + t->col_ofs < 0 || x1 + t->col_ofs >= t->nc
+ || x2 + t->col_ofs < 0 || x2 + t->col_ofs >= t->nc
+ || y1 + t->row_ofs < 0 || y1 + t->row_ofs >= t->nr
+ || y2 + t->row_ofs < 0 || y2 + t->row_ofs >= t->nr)
+ {
+ printf (_("bad box: (%d+%d=%d,%d+%d=%d)-(%d+%d=%d,%d+%d=%d) "
+ "in table size (%d,%d)\n"),
+ x1, t->col_ofs, x1 + t->col_ofs,
+ y1, t->row_ofs, y1 + t->row_ofs,
+ x2, t->col_ofs, x2 + t->col_ofs,
+ y2, t->row_ofs, y2 + t->row_ofs,
+ t->nc, t->nr);
+ abort ();
+ }
+#endif
+
+ x1 += t->col_ofs;
+ x2 += t->col_ofs;
+ y1 += t->row_ofs;
+ y2 += t->row_ofs;
+
+ if (f_h != -1)
+ {
+ int x;
+ if ((f_h & TAL_SPACING) == 0)
+ for (x = x1; x <= x2; x++)
+ {
+ t->rh[x + t->cf * y1] = f_h;
+ t->rh[x + t->cf * (y2 + 1)] = f_h;
+ }
+ t->trh[y1] |= (1 << (f_h & ~TAL_SPACING));
+ t->trh[y2 + 1] |= (1 << (f_h & ~TAL_SPACING));
+ }
+ if (f_v != -1)
+ {
+ int y;
+ if ((f_v & TAL_SPACING) == 0)
+ for (y = y1; y <= y2; y++)
+ {
+ t->rv[x1 + (t->cf + 1) * y] = f_v;
+ t->rv[(x2 + 1) + (t->cf + 1) * y] = f_v;
+ }
+ t->trv[x1] |= (1 << (f_v & ~TAL_SPACING));
+ t->trv[x2 + 1] |= (1 << (f_v & ~TAL_SPACING));
+ }
+
+ if (i_h != -1)
+ {
+ int y;
+
+ for (y = y1 + 1; y <= y2; y++)
+ {
+ int x;
+
+ if ((i_h & TAL_SPACING) == 0)
+ for (x = x1; x <= x2; x++)
+ t->rh[x + t->cf * y] = i_h;
+
+ t->trh[y] |= (1 << (i_h & ~TAL_SPACING));
+ }
+ }
+ if (i_v != -1)
+ {
+ int x;
+
+ for (x = x1 + 1; x <= x2; x++)
+ {
+ int y;
+
+ if ((i_v & TAL_SPACING) == 0)
+ for (y = y1; y <= y2; y++)
+ t->rv[x + (t->cf + 1) * y] = i_v;
+
+ t->trv[x] |= (1 << (i_v & ~TAL_SPACING));
+ }
+ }
+}
+
+/* Formats text TEXT and arguments ARGS as indicated in OPT and sets
+ the resultant string into S in TABLE's pool. */
+static void
+text_format (struct tab_table *table, int opt, const char *text, va_list args,
+ struct len_string *s)
+{
+ int len;
+
+ assert (table != NULL && text != NULL && s != NULL);
+
+ if (opt & TAT_PRINTF)
+ {
+ char *temp_buf = local_alloc (1024);
+
+ len = nvsprintf (temp_buf, text, args);
+ text = temp_buf;
+ }
+ else
+ len = strlen (text);
+
+ ls_create_buffer (table->container, s, text, len);
+
+ if (opt & TAT_PRINTF)
+ local_free (text);
+}
+
+/* Set the title of table T to TITLE, which is formatted with printf
+ if FORMAT is nonzero. */
+void
+tab_title (struct tab_table *t, int format, const char *title, ...)
+{
+ va_list args;
+
+ assert (t != NULL && title != NULL);
+ va_start (args, title);
+ text_format (t, format ? TAT_PRINTF : TAT_NONE, title, args, &t->title);
+ va_end (args);
+}
+
+/* Set DIM_FUNC as the dimension function for table T. */
+void
+tab_dim (struct tab_table *t, tab_dim_func *dim_func)
+{
+ assert (t != NULL && t->dim == NULL);
+ t->dim = dim_func;
+}
+
+/* Returns the natural width of column C in table T for driver D, that
+ is, the smallest width necessary to display all its cells without
+ wrapping. The width will be no larger than the page width minus
+ left and right rule widths. */
+int
+tab_natural_width (struct tab_table *t, struct outp_driver *d, int c)
+{
+ int width;
+
+ assert (t != NULL && c >= 0 && c < t->nc);
+ {
+ int r;
+
+ for (width = r = 0; r < t->nr; r++)
+ {
+ struct outp_text text;
+ unsigned char opt = t->ct[c + r * t->cf];
+
+ if (opt & (TAB_JOIN | TAB_EMPTY))
+ continue;
+
+ text.s = t->cc[c + r * t->cf];
+ assert (!ls_null_p (&text.s));
+ text.options = OUTP_T_JUST_LEFT;
+
+ d->class->text_metrics (d, &text);
+ if (text.h > width)
+ width = text.h;
+ }
+ }
+
+ if (width == 0)
+ {
+ width = d->prop_em_width * 8;
+#if GLOBAL_DEBUGGING
+ printf ("warning: table column %d contains no data.\n", c);
+#endif
+ }
+
+ {
+ const int clamp = d->width - t->wrv[0] - t->wrv[t->nc];
+
+ if (width > clamp)
+ width = clamp;
+ }
+
+ return width;
+}
+
+/* Returns the natural height of row R in table T for driver D, that
+ is, the minimum height necessary to display the information in the
+ cell at the widths set for each column. */
+int
+tab_natural_height (struct tab_table *t, struct outp_driver *d, int r)
+{
+ int height;
+
+ assert (t != NULL && r >= 0 && r < t->nr);
+
+ {
+ int c;
+
+ for (height = d->font_height, c = 0; c < t->nc; c++)
+ {
+ struct outp_text text;
+ unsigned char opt = t->ct[c + r * t->cf];
+
+ assert (t->w[c] != NOT_INT);
+ if (opt & (TAB_JOIN | TAB_EMPTY))
+ continue;
+
+ text.s = t->cc[c + r * t->cf];
+ assert (!ls_null_p (&text.s));
+ text.options = OUTP_T_HORZ | OUTP_T_JUST_LEFT;
+ text.h = t->w[c];
+ d->class->text_metrics (d, &text);
+
+ if (text.v > height)
+ height = text.v;
+ }
+ }
+
+ return height;
+}
+
+/* Callback function to set all columns and rows to their natural
+ dimensions. Not really meant to be called directly. */
+void
+tab_natural_dimensions (struct tab_table *t, struct outp_driver *d)
+{
+ int i;
+
+ assert (t != NULL);
+
+ for (i = 0; i < t->nc; i++)
+ t->w[i] = tab_natural_width (t, d, i);
+
+ for (i = 0; i < t->nr; i++)
+ t->h[i] = tab_natural_height (t, d, i);
+}
+
+\f
+/* Cells. */
+
+/* Sets cell (C,R) in TABLE, with options OPT, to have a value taken
+ from V, displayed with format spec F. */
+void
+tab_value (struct tab_table *table, int c, int r, unsigned char opt,
+ const union value *v, const struct fmt_spec *f)
+{
+ char *contents;
+ union value temp_val;
+
+ assert (table != NULL && v != NULL && f != NULL);
+#if GLOBAL_DEBUGGING
+ if (c + table->col_ofs < 0 || r + table->row_ofs < 0
+ || c + table->col_ofs >= table->nc
+ || r + table->row_ofs >= table->nr)
+ {
+ printf ("tab_value(): bad cell (%d+%d=%d,%d+%d=%d) in table size "
+ "(%d,%d)\n",
+ c, table->col_ofs, c + table->col_ofs,
+ r, table->row_ofs, r + table->row_ofs,
+ table->nc, table->nr);
+ return;
+ }
+#endif
+
+ contents = pool_alloc (table->container, f->w);
+ ls_init (&table->cc[c + r * table->cf], contents, f->w);
+ table->ct[c + r * table->cf] = opt;
+
+ if (formats[f->type].cat & FCAT_STRING)
+ {
+ temp_val.c = (char *) v->s;
+ v = &temp_val;
+ }
+ data_out (contents, f, v);
+}
+
+/* Sets cell (C,R) in TABLE, with options OPT, to have value VAL
+ with NDEC decimal places. */
+void
+tab_float (struct tab_table *table, int c, int r, unsigned char opt,
+ double val, int w, int d)
+{
+ char *contents;
+ char buf[40], *cp;
+
+ struct fmt_spec f;
+
+ assert (table != NULL && w <= 40);
+
+ f.type = FMT_F;
+ f.w = w;
+ f.d = d;
+
+#if GLOBAL_DEBUGGING
+ if (c + table->col_ofs < 0 || r + table->row_ofs < 0
+ || c + table->col_ofs >= table->nc
+ || r + table->row_ofs >= table->nr)
+ {
+ printf ("tab_float(): bad cell (%d+%d=%d,%d+%d=%d) in table size "
+ "(%d,%d)\n",
+ c, table->col_ofs, c + table->col_ofs,
+ r, table->row_ofs, r + table->row_ofs,
+ table->nc, table->nr);
+ return;
+ }
+#endif
+
+ data_out (buf, &f, (union value *) &val);
+ cp = buf;
+ while (isspace ((unsigned char) *cp) && cp < &buf[w])
+ cp++;
+ f.w = w - (cp - buf);
+
+ contents = pool_alloc (table->container, f.w);
+ ls_init (&table->cc[c + r * table->cf], contents, f.w);
+ table->ct[c + r * table->cf] = opt;
+ memcpy (contents, cp, f.w);
+}
+
+/* Sets cell (C,R) in TABLE, with options OPT, to have text value
+ TEXT. */
+void
+tab_text (struct tab_table *table, int c, int r, unsigned opt, const char *text, ...)
+{
+ va_list args;
+
+ assert (table != NULL && text != NULL);
+#if GLOBAL_DEBUGGING
+ if (c + table->col_ofs < 0 || r + table->row_ofs < 0
+ || c + table->col_ofs >= table->nc
+ || r + table->row_ofs >= table->nr)
+ {
+ printf ("tab_text(): bad cell (%d+%d=%d,%d+%d=%d) in table size "
+ "(%d,%d)\n",
+ c, table->col_ofs, c + table->col_ofs,
+ r, table->row_ofs, r + table->row_ofs,
+ table->nc, table->nr);
+ return;
+ }
+#endif
+
+ va_start (args, text);
+ text_format (table, opt, text, args, &table->cc[c + r * table->cf]);
+ table->ct[c + r * table->cf] = opt;
+ va_end (args);
+}
+
+/* Joins cells (X1,X2)-(Y1,Y2) inclusive in TABLE, and sets them with
+ options OPT to have text value TEXT. */
+void
+tab_joint_text (struct tab_table *table, int x1, int y1, int x2, int y2,
+ unsigned opt, const char *text, ...)
+{
+ struct tab_joined_cell *j;
+
+ assert (table != NULL && text != NULL);
+#if GLOBAL_DEBUGGING
+ if (x1 + table->col_ofs < 0 || x1 + table->col_ofs >= table->nc
+ || y1 + table->row_ofs < 0 || y1 + table->row_ofs >= table->nr
+ || x2 < x1 || x2 + table->col_ofs >= table->nc
+ || y2 < y2 || y2 + table->row_ofs >= table->nr)
+ {
+ printf ("tab_joint_text(): bad cell "
+ "(%d+%d=%d,%d+%d=%d)-(%d+%d=%d,%d+%d=%d) in table size (%d,%d)\n",
+ x1, table->col_ofs, x1 + table->col_ofs,
+ y1, table->row_ofs, y1 + table->row_ofs,
+ x2, table->col_ofs, x2 + table->col_ofs,
+ y2, table->row_ofs, y2 + table->row_ofs,
+ table->nc, table->nr);
+ return;
+ }
+#endif
+
+ j = pool_alloc (table->container, sizeof *j);
+ j->hit = 0;
+ j->x1 = x1 + table->col_ofs;
+ j->y1 = y1 + table->row_ofs;
+ j->x2 = ++x2 + table->col_ofs;
+ j->y2 = ++y2 + table->row_ofs;
+
+ {
+ va_list args;
+
+ va_start (args, text);
+ text_format (table, opt, text, args, &j->contents);
+ va_end (args);
+ }
+
+ opt |= TAB_JOIN;
+
+ {
+ struct len_string *cc = &table->cc[x1 + y1 * table->cf];
+ unsigned char *ct = &table->ct[x1 + y1 * table->cf];
+ const int ofs = table->cf - (x2 - x1);
+
+ int y;
+
+ for (y = y1; y < y2; y++)
+ {
+ int x;
+
+ for (x = x1; x < x2; x++)
+ {
+ ls_init (cc++, (char *) j, 0);
+ *ct++ = opt;
+ }
+
+ cc += ofs;
+ ct += ofs;
+ }
+ }
+}
+
+/* Sets cell (C,R) in TABLE, with options OPT, to contents STRING. */
+void
+tab_raw (struct tab_table *table, int c, int r, unsigned opt,
+ struct len_string *string)
+{
+ assert (table != NULL && string != NULL);
+
+#if GLOBAL_DEBUGGING
+ if (c + table->col_ofs < 0 || r + table->row_ofs < 0
+ || c + table->col_ofs >= table->nc
+ || r + table->row_ofs >= table->nr)
+ {
+ printf ("tab_float(): bad cell (%d+%d=%d,%d+%d=%d) in table size "
+ "(%d,%d)\n",
+ c, table->col_ofs, c + table->col_ofs,
+ r, table->row_ofs, r + table->row_ofs,
+ table->nc, table->nr);
+ return;
+ }
+#endif
+
+ table->cc[c + r * table->cf] = *string;
+ table->ct[c + r * table->cf] = opt;
+}
+\f
+/* Miscellaneous. */
+
+/* Sets the widths of all the columns and heights of all the rows in
+ table T for driver D. */
+static void
+nowrap_dim (struct tab_table *t, struct outp_driver *d)
+{
+ t->w[0] = tab_natural_width (t, d, 0);
+ t->h[0] = d->font_height;
+}
+
+/* Sets the widths of all the columns and heights of all the rows in
+ table T for driver D. */
+static void
+wrap_dim (struct tab_table *t, struct outp_driver *d)
+{
+ t->w[0] = tab_natural_width (t, d, 0);
+ t->h[0] = tab_natural_height (t, d, 0);
+}
+
+/* Outputs text BUF as a table with a single cell having cell options
+ OPTIONS, which is a combination of the TAB_* and TAT_*
+ constants. */
+void
+tab_output_text (int options, const char *buf, ...)
+{
+ struct tab_table *t = tab_create (1, 1, 0);
+
+ assert (buf != NULL);
+ if (options & TAT_PRINTF)
+ {
+ va_list args;
+ char *temp_buf = local_alloc (4096);
+
+ va_start (args, buf);
+ nvsprintf (temp_buf, buf, args);
+ buf = temp_buf;
+ va_end (args);
+ }
+
+ if (options & TAT_FIX)
+ {
+ struct outp_driver *d;
+
+ for (d = outp_drivers (NULL); d; d = outp_drivers (d))
+ {
+ if (!d->page_open)
+ d->class->open_page (d);
+
+ d->class->text_set_font_by_name (d, "FIXED");
+ }
+ }
+
+ tab_text (t, 0, 0, options &~ TAT_PRINTF, buf);
+ tab_flags (t, SOMF_NO_TITLE | SOMF_NO_SPACING);
+ if (options & TAT_NOWRAP)
+ tab_dim (t, nowrap_dim);
+ else
+ tab_dim (t, wrap_dim);
+ tab_submit (t);
+
+ if (options & TAT_FIX)
+ {
+ struct outp_driver *d;
+
+ for (d = outp_drivers (NULL); d; d = outp_drivers (d))
+ d->class->text_set_font_by_name (d, "PROP");
+ }
+
+ if (options & TAT_PRINTF)
+ local_free (buf);
+}
+
+/* Set table flags to FLAGS. */
+void
+tab_flags (struct tab_table *t, unsigned flags)
+{
+ assert (t != NULL);
+ t->flags = flags;
+}
+
+/* Easy, type-safe way to submit a tab table to som. */
+void
+tab_submit (struct tab_table *t)
+{
+ struct som_table s;
+
+ assert (t != NULL);
+ s.class = &tab_table_class;
+ s.ext = t;
+ som_submit (&s);
+ tab_destroy (t);
+}
+\f
+/* Editing. */
+
+/* Set table row and column offsets for all functions that affect
+ cells or rules. */
+void
+tab_offset (struct tab_table *t, int col, int row)
+{
+ int diff = 0;
+
+ assert (t != NULL);
+#if GLOBAL_DEBUGGING
+ if (row < -1 || row >= t->nr)
+ {
+ printf ("tab_offset(): row=%d in %d-row table\n", row, t->nr);
+ abort ();
+ }
+ if (col < -1 || col >= t->nc)
+ {
+ printf ("tab_offset(): col=%d in %d-column table\n", col, t->nc);
+ abort ();
+ }
+#endif
+
+ if (row != -1)
+ diff += (row - t->row_ofs) * t->cf, t->row_ofs = row;
+ if (col != -1)
+ diff += (col - t->col_ofs), t->col_ofs = col;
+
+ t->cc += diff;
+ t->ct += diff;
+}
+
+/* Increment the row offset by one. If the table is too small,
+ increase its size. */
+void
+tab_next_row (struct tab_table *t)
+{
+ assert (t != NULL);
+ t->cc += t->cf;
+ t->ct += t->cf;
+ if (++t->row_ofs >= t->nr)
+ tab_realloc (t, -1, t->nr * 4 / 3);
+}
+\f
+static struct tab_table *t;
+static struct outp_driver *d;
+int tab_hit;
+
+/* Set the current table to TABLE. */
+static void
+tabi_table (struct som_table *table)
+{
+ assert (table != NULL);
+ t = table->ext;
+ tab_offset (t, 0, 0);
+
+ assert (t->w == NULL && t->h == NULL);
+ t->w = pool_alloc (t->container, sizeof *t->w * t->nc);
+ t->h = pool_alloc (t->container, sizeof *t->h * t->nr);
+}
+
+/* Set the current output device to DRIVER. */
+static void
+tabi_driver (struct outp_driver *driver)
+{
+ int i;
+
+ assert (driver != NULL);
+ d = driver;
+
+ /* Figure out sizes of rules. */
+ for (t->hr_tot = i = 0; i <= t->nr; i++)
+ t->hr_tot += t->hrh[i] = d->horiz_line_spacing[t->trh[i]];
+ for (t->vr_tot = i = 0; i <= t->nc; i++)
+ t->vr_tot += t->wrv[i] = d->vert_line_spacing[t->trv[i]];
+
+#if GLOBAL_DEBUGGING
+ for (i = 0; i < t->nr; i++)
+ t->h[i] = -1;
+ for (i = 0; i < t->nc; i++)
+ t->w[i] = -1;
+#endif
+
+ assert (t->dim != NULL);
+ t->dim (t, d);
+
+#if GLOBAL_DEBUGGING
+ {
+ int error = 0;
+
+ for (i = 0; i < t->nr; i++)
+ {
+ if (t->h[i] == -1)
+ {
+ printf ("Table row %d height not initialized.\n", i);
+ error = 1;
+ }
+ assert (t->h[i] > 0);
+ }
+
+ for (i = 0; i < t->nc; i++)
+ {
+ if (t->w[i] == -1)
+ {
+ printf ("Table column %d width not initialized.\n", i);
+ error = 1;
+ }
+ assert (t->w[i] > 0);
+ }
+ }
+#endif
+
+ /* Add up header sizes. */
+ for (i = 0, t->wl = t->wrv[0]; i < t->l; i++)
+ t->wl += t->w[i] + t->wrv[i + 1];
+ for (i = 0, t->ht = t->hrh[0]; i < t->t; i++)
+ t->ht += t->h[i] + t->hrh[i + 1];
+ for (i = t->nc - t->r, t->wr = t->wrv[i]; i < t->nc; i++)
+ t->wr += t->w[i] + t->wrv[i + 1];
+ for (i = t->nr - t->b, t->hb = t->hrh[i]; i < t->nr; i++)
+ t->hb += t->h[i] + t->hrh[i + 1];
+
+ /* Title. */
+ if (!(t->flags & SOMF_NO_TITLE))
+ t->ht += d->font_height;
+}
+
+/* Return the number of columns and rows in the table into N_COLUMNS
+ and N_ROWS, respectively. */
+static void
+tabi_count (int *n_columns, int *n_rows)
+{
+ assert (n_columns != NULL && n_rows != NULL);
+ *n_columns = t->nc;
+ *n_rows = t->nr;
+}
+
+static void tabi_cumulate (int cumtype, int start, int *end, int max, int *actual);
+
+/* Return the horizontal and vertical size of the entire table,
+ including headers, for the current output device, into HORIZ and
+ VERT. */
+static void
+tabi_area (int *horiz, int *vert)
+{
+ assert (horiz != NULL && vert != NULL);
+
+ {
+ int w, c;
+
+ for (c = t->l + 1, w = t->wl + t->wr + t->w[t->l];
+ c < t->nc - t->r; c++)
+ w += t->w[c] + t->wrv[c];
+ *horiz = w;
+ }
+
+ {
+ int h, r;
+ for (r = t->t + 1, h = t->ht + t->hb + t->h[t->t];
+ r < t->nr - t->b; r++)
+ h += t->h[r] + t->hrh[r];
+ *vert = h;
+ }
+}
+
+/* Return the column style for this table into STYLE. */
+static void
+tabi_columns (int *style)
+{
+ assert (style != NULL);
+ *style = t->col_style;
+}
+
+/* Return the number of header rows/columns on the left, right, top,
+ and bottom sides into HL, HR, HT, and HB, respectively. */
+static void
+tabi_headers (int *hl, int *hr, int *ht, int *hb)
+{
+ assert (hl != NULL && hr != NULL && ht != NULL && hb != NULL);
+ *hl = t->l;
+ *hr = t->r;
+ *ht = t->t;
+ *hb = t->b;
+}
+
+/* Determines the number of rows or columns (including appropriate
+ headers), depending on CUMTYPE, that will fit into the space
+ specified. Takes rows/columns starting at index START and attempts
+ to fill up available space MAX. Returns in END the index of the
+ last row/column plus one; returns in ACTUAL the actual amount of
+ space the selected rows/columns (including appropriate headers)
+ filled. */
+static void
+tabi_cumulate (int cumtype, int start, int *end, int max, int *actual)
+{
+ int n;
+ int *d;
+ int *r;
+ int total;
+
+ assert (end != NULL && (cumtype == SOM_ROWS || cumtype == SOM_COLUMNS));
+ if (cumtype == SOM_ROWS)
+ {
+ assert (start >= 0 && start < t->nr);
+ n = t->nr - t->b;
+ d = &t->h[start];
+ r = &t->hrh[start + 1];
+ total = t->ht + t->hb;
+ } else {
+ assert (start >= 0 && start < t->nc);
+ n = t->nc - t->r;
+ d = &t->w[start];
+ r = &t->wrv[start + 1];
+ total = t->wl + t->wr;
+ }
+
+ total += *d++;
+ if (total > max)
+ {
+ if (end)
+ *end = start;
+ if (actual)
+ *actual = 0;
+ return;
+ }
+
+ {
+ int x;
+
+ for (x = start + 1; x < n; x++)
+ {
+ int amt = *d++ + *r++;
+
+ total += amt;
+ if (total > max)
+ {
+ total -= amt;
+ break;
+ }
+ }
+
+ if (end)
+ *end = x;
+
+ if (actual)
+ *actual = total;
+ }
+}
+
+/* Return flags set for the current table into FLAGS. */
+static void
+tabi_flags (unsigned *flags)
+{
+ assert (flags != NULL);
+ *flags = t->flags;
+}
+
+/* Render title for current table, with major index X and minor index
+ Y. Y may be zero, or X and Y may be zero, but X should be nonzero
+ if Y is nonzero. */
+static void
+tabi_title (int x, int y)
+{
+ char buf[1024];
+ char *cp;
+
+ if (t->flags & SOMF_NO_TITLE)
+ return;
+
+ cp = spprintf (buf, "%d.%d", table_num, subtable_num);
+ if (x && y)
+ cp = spprintf (cp, "(%d:%d)", x, y);
+ else if (x)
+ cp = spprintf (cp, "(%d)", x);
+ if (cur_proc)
+ cp = spprintf (cp, " %s", cur_proc);
+ cp = stpcpy (cp, ". ");
+ if (!ls_empty_p (&t->title))
+ {
+ memcpy (cp, ls_value (&t->title), ls_length (&t->title));
+ cp += ls_length (&t->title);
+ }
+ *cp = 0;
+
+ {
+ struct outp_text text;
+
+ text.options = OUTP_T_JUST_LEFT | OUTP_T_HORZ | OUTP_T_VERT;
+ ls_init (&text.s, buf, cp - buf);
+ text.h = d->width;
+ text.v = d->font_height;
+ text.x = 0;
+ text.y = d->cp_y;
+ d->class->text_draw (d, &text);
+ }
+}
+
+static int render_strip (int x, int y, int r, int c1, int c2, int r1, int r2);
+
+/* Execute BODY for each value of X from A to B exclusive. */
+#define UNROLL_LOOP(X, A, B, BODY) \
+ do \
+ { \
+ for (X = A; X < B; X++) \
+ { \
+ BODY \
+ } \
+ } \
+ while (0)
+
+/* Execute PREP, then BODY for each specified value of X: A1...A2, B1...B2,
+ C1...C2, in each case not including the second value. */
+#define UNROLL_3_LOOPS(X, A1, A2, B1, B2, C1, C2, BODY) \
+ do \
+ { \
+ UNROLL_LOOP (X, A1, A2, BODY); \
+ UNROLL_LOOP (X, B1, B2, BODY); \
+ UNROLL_LOOP (X, C1, C2, BODY); \
+ } \
+ while (0)
+
+/* Draws the table region in rectangle (X1,Y1)-(X2,Y2), where column
+ X2 and row Y2 are not included in the rectangle, at the current
+ position on the current output device. Draws headers as well. */
+static void
+tabi_render (int x1, int y1, int x2, int y2)
+{
+ int y, r;
+
+ tab_hit++;
+ y = d->cp_y;
+ if (!(t->flags & SOMF_NO_TITLE))
+ y += d->font_height;
+ UNROLL_3_LOOPS (r, 0, t->t * 2 + 1, y1 * 2 + 1, y2 * 2,
+ (t->nr - t->b) * 2, t->nr * 2 + 1,
+
+ int x = d->cp_x;
+ x += render_strip (x, y, r, 0, t->l * 2 + 1, y1, y2);
+ x += render_strip (x, y, r, x1 * 2 + 1, x2 * 2, y1, y2);
+ x += render_strip (x, y, r, (t->nc - t->r) * 2,
+ t->nc * 2 + 1, y1, y2);
+ y += (r & 1) ? t->h[r / 2] : t->hrh[r / 2];
+ );
+}
+
+struct som_table_class tab_table_class =
+ {
+ tabi_table,
+ tabi_driver,
+
+ tabi_count,
+ tabi_area,
+ NULL,
+ NULL,
+ tabi_columns,
+ NULL,
+ tabi_headers,
+ NULL,
+ tabi_cumulate,
+ tabi_flags,
+
+ NULL,
+ NULL,
+
+ tabi_title,
+ tabi_render,
+ };
+\f
+/* Render contiguous strip consisting of columns C1...C2, exclusive,
+ on row R, at location (X,Y). Return width of the strip thus
+ rendered.
+
+ Renders joined cells, even those outside the strip, within the
+ rendering region (C1,R1)-(C2,R2).
+
+ For the purposes of counting rows and columns in this function
+ only, horizontal rules are considered rows and vertical rules are
+ considered columns.
+
+ FIXME: Doesn't use r1? Huh? */
+static int
+render_strip (int x, int y, int r, int c1, int c2, int r1 unused, int r2)
+{
+ int x_origin = x;
+
+ /* Horizontal rules. */
+ if ((r & 1) == 0)
+ {
+ int hrh = t->hrh[r / 2];
+ int c;
+
+ for (c = c1; c < c2; c++)
+ {
+ if (c & 1)
+ {
+ int style = t->rh[(c / 2) + (r / 2 * t->cf)];
+
+ if (style != TAL_0)
+ {
+ const struct color clr = {0, 0, 0, 0};
+ struct rect rct;
+
+ rct.x1 = x;
+ rct.y1 = y;
+ rct.x2 = x + t->w[c / 2];
+ rct.y2 = y + hrh;
+ d->class->line_horz (d, &rct, &clr, style);
+ }
+ x += t->w[c / 2];
+ } else {
+ const struct color clr = {0, 0, 0, 0};
+ struct rect rct;
+ struct outp_styles s;
+
+ rct.x1 = x;
+ rct.y1 = y;
+ rct.x2 = x + t->wrv[c / 2];
+ rct.y2 = y + hrh;
+
+ s.t = r > 0 ? t->rv[(c / 2) + (t->cf + 1) * (r / 2 - 1)] : 0;
+ s.b = r < 2 * t->nr ? t->rv[(c / 2) + (t->cf + 1) * (r / 2)] : 0;
+ s.l = c > 0 ? t->rh[(c / 2 - 1) + t->cf * (r / 2)] : 0;
+ s.r = c < 2 * t->nc ? t->rh[(c / 2) + t->cf * (r / 2)] : 0;
+
+ if (s.t | s.b | s.l | s.r)
+ d->class->line_intersection (d, &rct, &clr, &s);
+
+ x += t->wrv[c / 2];
+ }
+ }
+ } else {
+ int c;
+
+ for (c = c1; c < c2; c++)
+ {
+ if (c & 1)
+ {
+ const int index = (c / 2) + (r / 2 * t->cf);
+
+ if (!(t->ct[index] & TAB_JOIN))
+ {
+ struct outp_text text;
+
+ text.options = ((t->ct[index] & OUTP_T_JUST_MASK)
+ | OUTP_T_HORZ | OUTP_T_VERT);
+ if ((t->ct[index] & TAB_EMPTY) == 0)
+ {
+ text.s = t->cc[index];
+ assert (!ls_null_p (&text.s));
+ text.h = t->w[c / 2];
+ text.v = t->h[r / 2];
+ text.x = x;
+ text.y = y;
+ d->class->text_draw (d, &text);
+ }
+ } else {
+ struct tab_joined_cell *j =
+ (struct tab_joined_cell *) ls_value (&t->cc[index]);
+
+ if (j->hit != tab_hit)
+ {
+ j->hit = tab_hit;
+
+ if (j->x1 == c / 2 && j->y1 == r / 2
+ && j->x2 <= c2 && j->y2 <= r2)
+ {
+ struct outp_text text;
+
+ text.options = ((t->ct[index] & OUTP_T_JUST_MASK)
+ | OUTP_T_HORZ | OUTP_T_VERT);
+ text.s = j->contents;
+ text.x = x;
+ text.y = y;
+
+ {
+ int c;
+
+ for (c = j->x1, text.h = -t->wrv[j->x2];
+ c < j->x2; c++)
+ text.h += t->w[c] + t->wrv[c + 1];
+ }
+
+ {
+ int r;
+
+ for (r = j->y1, text.v = -t->hrh[j->y2];
+ r < j->y2; r++)
+ text.v += t->h[r] + t->hrh[r + 1];
+ }
+ d->class->text_draw (d, &text);
+ }
+ }
+ }
+ x += t->w[c / 2];
+ } else {
+ int style = t->rv[(c / 2) + (r / 2 * (t->cf + 1))];
+
+ if (style != TAL_0)
+ {
+ const struct color clr = {0, 0, 0, 0};
+ struct rect rct;
+
+ rct.x1 = x;
+ rct.y1 = y;
+ rct.x2 = x + t->wrv[c / 2];
+ rct.y2 = y + t->h[r / 2];
+ d->class->line_vert (d, &rct, &clr, style);
+ }
+ x += t->wrv[c / 2];
+ }
+ }
+ }
+
+ return x - x_origin;
+}
+
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !tab_h
+#define tab_h 1
+
+#include <limits.h>
+#include "str.h"
+
+/* Cell options. */
+enum
+ {
+ TAB_NONE = 0,
+
+ /* Must match output.h: OUTP_T_JUST_*. */
+ TAB_ALIGN_MASK = 03, /* Alignment mask. */
+ TAB_RIGHT = 00, /* Right justify. */
+ TAB_LEFT = 01, /* Left justify. */
+ TAB_CENTER = 02, /* Center. */
+
+ /* Oddball cell types. */
+ TAB_JOIN = 010, /* Joined cell. */
+ TAB_EMPTY = 020 /* Empty cell. */
+ };
+
+/* Line styles. These must match output.h:OUTP_L_*. */
+enum
+ {
+ TAL_0 = 0, /* No line. */
+ TAL_1 = 1, /* Single line. */
+ TAL_2 = 2, /* Double line. */
+ TAL_3 = 3, /* Special line of driver-defined style. */
+ TAL_COUNT, /* Number of line styles. */
+
+ TAL_SPACING = 0200 /* Don't draw the line, just reserve space. */
+ };
+
+/* Column styles. Must correspond to SOM_COL_*. */
+enum
+ {
+ TAB_COL_NONE, /* No columns. */
+ TAB_COL_DOWN /* Columns down first. */
+ };
+
+/* Joined cell. */
+struct tab_joined_cell
+ {
+ int x1, y1;
+ int x2, y2;
+ int hit;
+ struct len_string contents;
+ };
+
+struct outp_driver;
+struct tab_table;
+typedef void tab_dim_func (struct tab_table *, struct outp_driver *);
+
+/* A table. */
+struct tab_table
+ {
+ struct pool *container;
+
+ /* Contents. */
+ int col_style; /* Columns: One of TAB_COL_*. */
+ int col_group; /* Number of rows per column group. */
+ struct len_string title; /* Table title. */
+ unsigned flags; /* SOMF_*. */
+ int nc, nr; /* Number of columns, rows. */
+ int cf; /* Column factor for indexing purposes. */
+ int l, r, t, b; /* Number of header rows on each side. */
+ struct len_string *cc; /* Cell contents; len_string *[nr][nc]. */
+ unsigned char *ct; /* Cell types; unsigned char[nr][nc]. */
+ unsigned char *rh; /* Horiz rules; unsigned char[nr+1][nc]. */
+ unsigned char *trh; /* Types of horiz rules; [nr+1]. */
+ unsigned char *rv; /* Vert rules; unsigned char[nr][nc+1]. */
+ unsigned char *trv; /* Types of vert rules; [nc+1]. */
+ tab_dim_func *dim; /* Calculates cell widths and heights. */
+
+ /* Calculated during output. */
+ int *w; /* Column widths; [nc]. */
+ int *h; /* Row heights; [nr]. */
+ int *hrh; /* Heights of horizontal rules; [nr+1]. */
+ int *wrv; /* Widths of vertical rules; [nc+1]. */
+ int wl, wr, ht, hb; /* Width/height of header rows/columns. */
+ int hr_tot, vr_tot; /* Hrules total height, vrules total width. */
+
+ /* Editing info. */
+ int col_ofs, row_ofs; /* X and Y offsets. */
+#if GLOBAL_DEBUGGING
+ int reallocable; /* Can table be reallocated? */
+#endif
+ };
+
+extern int tab_hit;
+
+/* Number of rows in TABLE. */
+#define tab_nr(TABLE) ((TABLE)->nr)
+
+/* Number of columns in TABLE. */
+#define tab_nc(TABLE) ((TABLE)->nc)
+
+/* Number of left header columns in TABLE. */
+#define tab_l(TABLE) ((TABLE)->l)
+
+/* Number of right header columns in TABLE. */
+#define tab_r(TABLE) ((TABLE)->r)
+
+/* Number of top header rows in TABLE. */
+#define tab_t(TABLE) ((TABLE)->t)
+
+/* Number of bottom header rows in TABLE. */
+#define tab_b(TABLE) ((TABLE)->b)
+
+/* Tables. */
+struct tab_table *tab_create (int nc, int nr, int reallocable);
+void tab_destroy (struct tab_table *);
+void tab_resize (struct tab_table *, int nc, int nr);
+void tab_realloc (struct tab_table *, int nc, int nr);
+void tab_headers (struct tab_table *, int l, int r, int t, int b);
+void tab_columns (struct tab_table *, int style, int group);
+void tab_title (struct tab_table *, int format, const char *, ...);
+void tab_flags (struct tab_table *, unsigned);
+void tab_submit (struct tab_table *);
+
+/* Dimensioning. */
+tab_dim_func tab_natural_dimensions;
+int tab_natural_width (struct tab_table *t, struct outp_driver *d, int c);
+int tab_natural_height (struct tab_table *t, struct outp_driver *d, int r);
+void tab_dim (struct tab_table *, tab_dim_func *);
+
+/* Rules. */
+void tab_hline (struct tab_table *, int style, int x1, int x2, int y);
+void tab_vline (struct tab_table *, int style, int x, int y1, int y2);
+void tab_box (struct tab_table *, int f_h, int f_v, int i_h, int i_v,
+ int x1, int y1, int x2, int y2);
+
+/* Text options, passed in the `opt' argument. */
+enum
+ {
+ TAT_NONE = 0, /* No options. */
+ TAT_PRINTF = 0x0100, /* Format the text string with sprintf. */
+ TAT_TITLE = 0x0204, /* Title attributes. */
+ TAT_FIX = 0x0400, /* Use fixed-pitch font. */
+ TAT_NOWRAP = 0x0800 /* No text wrap (tab_output_text() only). */
+ };
+
+/* Cells. */
+struct fmt_spec;
+union value;
+void tab_value (struct tab_table *, int c, int r, unsigned char opt,
+ const union value *, const struct fmt_spec *);
+void tab_float (struct tab_table *, int c, int r, unsigned char opt,
+ double v, int w, int d);
+void tab_text (struct tab_table *, int c, int r, unsigned opt,
+ const char *, ...)
+ __attribute__ ((format (printf, 5, 6)));
+void tab_joint_text (struct tab_table *, int x1, int y1, int x2, int y2,
+ unsigned opt, const char *, ...)
+ __attribute__ ((format (printf, 7, 8)));
+
+/* Cell low-level access. */
+#define tab_alloc(TABLE, AMT) pool_alloc ((TABLE)->container, (AMT))
+void tab_raw (struct tab_table *, int c, int r, unsigned opt,
+ struct len_string *);
+
+/* Editing. */
+void tab_offset (struct tab_table *, int col, int row);
+void tab_next_row (struct tab_table *);
+
+/* Current row/column offset. */
+#define tab_row(TABLE) ((TABLE)->row_ofs)
+#define tab_col(TABLE) ((TABLE)->col_ofs)
+
+/* Simple output. */
+void tab_output_text (int options, const char *string, ...)
+ __attribute__ ((format (printf, 2, 3)));
+
+#endif /* tab_h */
+
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "avl.h"
+#include "command.h"
+#include "do-ifP.h"
+#include "error.h"
+#include "lexer.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+int temporary;
+struct dictionary *temp_dict;
+int temp_trns;
+
+#if 0
+/* Displays all the value labels in TREE, with label S. */
+void
+display_tree (char *s, avl_tree *tree)
+{
+ value_label *iter;
+ avl_traverser *trav = NULL;
+
+ printf("%s tree:\n", s);
+ fflush(stdout);
+ while ((iter = avl_traverse (tree, &trav)) != NULL)
+ printf (" %g: %s\n", iter->v.f, iter->s);
+}
+#endif
+
+/* Parses the TEMPORARY command. */
+int
+cmd_temporary (void)
+{
+ lex_match_id ("TEMPORARY");
+
+ /* TEMPORARY is not allowed inside DO IF or LOOP. */
+ if (ctl_stack)
+ {
+ msg (SE, _("This command is not valid inside DO IF or LOOP."));
+ return CMD_FAILURE;
+ }
+
+ /* TEMPORARY can only appear once! */
+ if (temporary)
+ {
+ msg (SE, _("This command may only appear once between "
+ "procedures and procedure-like commands."));
+ return CMD_FAILURE;
+ }
+
+ /* Everything is temporary, even if we think it'll last forever.
+ Especially then. */
+ temporary = 1;
+ temp_dict = save_dictionary ();
+ if (f_trns == n_trns)
+ temp_trns = -1;
+ else
+ temp_trns = n_trns;
+ debug_printf (("TEMPORARY: temp_trns=%d\n", temp_trns));
+
+ return lex_end_of_command ();
+}
+
+/* Copies a variable structure. */
+void
+copy_variable (struct variable *dest, const struct variable *src)
+{
+ int i, n;
+
+ assert (dest != src);
+ dest->type = src->type;
+ dest->left = src->left;
+ dest->width = src->width;
+ dest->fv = src->fv;
+ dest->nv = src->nv;
+ dest->miss_type = src->miss_type;
+
+ switch (src->miss_type)
+ {
+ case MISSING_NONE:
+ n = 0;
+ break;
+ case MISSING_1:
+ n = 1;
+ break;
+ case MISSING_2:
+ case MISSING_RANGE:
+ n = 2;
+ break;
+ case MISSING_3:
+ case MISSING_RANGE_1:
+ n = 3;
+ break;
+ default:
+ assert (0);
+ break;
+ }
+
+ for (i = 0; i < n; i++)
+ dest->missing[i] = src->missing[i];
+ dest->print = src->print;
+ dest->write = src->write;
+
+ dest->val_lab = copy_value_labels (src->val_lab);
+ dest->label = src->label ? xstrdup (src->label) : NULL;
+}
+
+/* Returns a newly created empty dictionary. The file label and
+ documents are copied from default_dict if COPY is nonzero. */
+struct dictionary *
+new_dictionary (int copy)
+{
+ struct dictionary *d = xmalloc (sizeof *d);
+
+ d->var = NULL;
+ d->var_by_name = avl_create (NULL, cmp_variable, NULL);
+ d->nvar = 0;
+
+ d->N = 0;
+
+ d->nval = 0;
+
+ d->n_splits = 0;
+ d->splits = NULL;
+
+ if (default_dict.label && copy)
+ d->label = xstrdup (default_dict.label);
+ else
+ d->label = NULL;
+
+ if (default_dict.n_documents && copy)
+ {
+ d->n_documents = default_dict.n_documents;
+ if (d->n_documents)
+ {
+ d->documents = malloc (default_dict.n_documents * 80);
+ memcpy (d->documents, default_dict.documents,
+ default_dict.n_documents * 80);
+ }
+ }
+ else
+ {
+ d->n_documents = 0;
+ d->documents = NULL;
+ }
+
+ d->weight_index = -1;
+ d->weight_var[0] = 0;
+
+ d->filter_var[0] = 0;
+
+ return d;
+}
+
+/* Copies the current dictionary info into a newly allocated
+ dictionary structure, which is returned. */
+struct dictionary *
+save_dictionary (void)
+{
+ /* Dictionary being created. */
+ struct dictionary *d;
+
+ int i;
+
+ d = xmalloc (sizeof *d);
+
+ /* First the easy stuff. */
+ *d = default_dict;
+ d->label = default_dict.label ? xstrdup (default_dict.label) : NULL;
+ if (default_dict.n_documents)
+ {
+ d->documents = malloc (default_dict.n_documents * 80);
+ memcpy (d->documents, default_dict.documents,
+ default_dict.n_documents * 80);
+ }
+ else d->documents = NULL;
+
+ /* Then the variables. */
+ d->var_by_name = avl_create (NULL, cmp_variable, NULL);
+ d->var = xmalloc (default_dict.nvar * sizeof *d->var);
+ for (i = 0; i < default_dict.nvar; i++)
+ {
+ d->var[i] = xmalloc (sizeof *d->var[i]);
+ copy_variable (d->var[i], default_dict.var[i]);
+ strcpy (d->var[i]->name, default_dict.var[i]->name);
+ d->var[i]->index = i;
+ avl_force_insert (d->var_by_name, d->var[i]);
+ }
+
+ /* Then the SPLIT FILE variables. */
+ if (default_dict.splits)
+ {
+ int i;
+
+ d->n_splits = default_dict.n_splits;
+ d->splits = xmalloc ((default_dict.n_splits + 1) * sizeof *d->splits);
+ for (i = 0; i < default_dict.n_splits; i++)
+ d->splits[i] = d->var[default_dict.splits[i]->index];
+ d->splits[default_dict.n_splits] = NULL;
+ }
+ else
+ {
+ d->n_splits = 0;
+ d->splits = NULL;
+ }
+
+ return d;
+}
+
+/* Copies dictionary D into the active file dictionary. Deletes
+ dictionary D. */
+void
+restore_dictionary (struct dictionary * d)
+{
+ int i;
+
+ /* 1. Delete the current dictionary. */
+ default_dict.n_splits = 0;
+ free (default_dict.splits);
+ default_dict.splits = NULL;
+
+ avl_destroy (default_dict.var_by_name, NULL);
+ default_dict.var_by_name = NULL;
+
+ for (i = 0; i < default_dict.nvar; i++)
+ {
+ clear_variable (&default_dict, default_dict.var[i]);
+ free (default_dict.var[i]);
+ }
+
+ free (default_dict.var);
+ free (default_dict.label);
+ free (default_dict.documents);
+
+ /* 2. Copy dictionary D into the active file dictionary. */
+#if __CHECKER__
+ {
+ size_t offset;
+
+ offset = offsetof (struct dictionary, filter_var) + sizeof d->filter_var;
+ strncpy (d->weight_var, d->weight_var, 9);
+ strncpy (d->filter_var, d->filter_var, 9);
+ memset (&((char *) d)[offset], '*', sizeof *d - offset);
+ }
+#endif
+ default_dict = *d;
+ if (!default_dict.var_by_name)
+ {
+ default_dict.var_by_name = avl_create (NULL, cmp_variable, NULL);
+
+ for (i = 0; i < default_dict.nvar; i++)
+ avl_force_insert (default_dict.var_by_name, default_dict.var[i]);
+ }
+
+ /* 3. Destroy dictionary D. */
+ free (d);
+}
+
+/* Destroys dictionary D. */
+void
+free_dictionary (struct dictionary * d)
+{
+ int i;
+
+ d->n_splits = 0;
+ free (d->splits);
+ d->splits = NULL;
+
+ if (d->var_by_name)
+ avl_destroy (d->var_by_name, NULL);
+
+ for (i = 0; i < d->nvar; i++)
+ {
+ struct variable *v = d->var[i];
+
+ if (v->val_lab)
+ {
+ avl_destroy (v->val_lab, free_val_lab);
+ v->val_lab = NULL;
+ }
+ if (v->label)
+ {
+ free (v->label);
+ v->label = NULL;
+ }
+ free (d->var[i]);
+ }
+ free (d->var);
+
+ free (d->label);
+ free (d->documents);
+
+ free (d);
+}
+
+/* Cancels the temporary transformation, if any. */
+void
+cancel_temporary (void)
+{
+ if (temporary)
+ {
+ if (temp_dict)
+ free_dictionary (temp_dict);
+ temporary = 0;
+ temp_trns = 0;
+ }
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <ctype.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "main.h"
+#include "output.h"
+#include "var.h"
+#include "version.h"
+#include "vfm.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+
+static int get_title (const char *cmd, char **title);
+
+int
+cmd_title (void)
+{
+ return get_title ("TITLE", &outp_title);
+}
+
+int
+cmd_subtitle (void)
+{
+ return get_title ("SUBTITLE", &outp_subtitle);
+}
+
+static int
+get_title (const char *cmd, char **title)
+{
+ int c;
+
+ c = lex_look_ahead ();
+ debug_printf ((_("%s before: %s\n"), cmd, *title ? *title : _("<none>")));
+ if (c == '"' || c == '\'')
+ {
+ lex_get ();
+ if (!lex_force_string ())
+ return CMD_FAILURE;
+ if (*title)
+ free (*title);
+ *title = xstrdup (ds_value (&tokstr));
+ lex_get ();
+ if (token != '.')
+ {
+ msg (SE, _("%s: `.' expected after string."), cmd);
+ return CMD_FAILURE;
+ }
+ }
+ else
+ {
+ char *cp;
+
+ if (*title)
+ free (*title);
+ *title = xstrdup (lex_rest_of_line (NULL));
+ for (cp = *title; *cp; cp++)
+ *cp = toupper ((unsigned char) (*cp));
+ token = '.';
+ }
+ debug_printf ((_("%s after: %s\n"), cmd, *title));
+ return CMD_SUCCESS;
+}
+
+/* Performs the FILE LABEL command. */
+int
+cmd_file_label (void)
+{
+ char *label;
+
+ label = lex_rest_of_line (NULL);
+ while (isspace ((unsigned char) *label))
+ label++;
+
+ free (default_dict.label);
+ default_dict.label = xstrdup (label);
+ if (strlen (default_dict.label) > 60)
+ default_dict.label[60] = 0;
+ token = '.';
+
+ return CMD_SUCCESS;
+}
+
+/* Add LINE as a line of document information to default_dict,
+ indented by INDENT spaces. */
+static void
+add_document_line (const char *line, int indent)
+{
+ char *doc;
+
+ default_dict.n_documents++;
+ default_dict.documents = xrealloc (default_dict.documents,
+ 80 * default_dict.n_documents);
+ doc = &default_dict.documents[80 * (default_dict.n_documents - 1)];
+ memset (doc, ' ', indent);
+ st_bare_pad_copy (&doc[indent], line, 80 - indent);
+}
+
+/* Performs the DOCUMENT command. */
+int
+cmd_document (void)
+{
+ /* Add a few header lines for reference. */
+ {
+ char buf[256];
+ struct tm *tmp = localtime (&last_vfm_invocation);
+
+ if (default_dict.n_documents)
+ add_document_line ("", 0);
+
+ sprintf (buf, _("Document entered %s %02d:%02d:%02d by %s (%s):"),
+ curdate, tmp->tm_hour, tmp->tm_min, tmp->tm_sec, version,
+ host_system);
+ add_document_line (buf, 1);
+ }
+
+ for (;;)
+ {
+ int had_dot;
+ char *line;
+
+ line = lex_rest_of_line (&had_dot);
+ while (isspace ((unsigned char) *line))
+ line++;
+
+ if (had_dot)
+ {
+ char *cp = strchr (line, 0);
+ *cp++ = '.';
+ *cp = 0;
+ }
+
+ add_document_line (line, 3);
+
+ lex_get_line ();
+ if (had_dot)
+ break;
+ }
+
+ token = '.';
+ return CMD_SUCCESS;
+}
+
+/* Performs the DROP DOCUMENTS command. */
+int
+cmd_drop_documents (void)
+{
+ lex_match_id ("DROP");
+ lex_match_id ("DOCUMENTS");
+
+ free (default_dict.documents);
+ default_dict.documents = NULL;
+ default_dict.n_documents = 0;
+
+ return lex_end_of_command ();
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "avl.h"
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "str.h"
+#include "var.h"
+\f
+/* Declarations. */
+
+#undef DEBUGGING
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+
+/* Variable list. */
+static struct variable **v;
+
+/* Number of variables. */
+static int nv;
+
+static int do_value_labels (int);
+static int verify_val_labs (int erase);
+static int get_label (void);
+
+#if DEBUGGING
+static void debug_print (void);
+#endif
+\f
+/* Stubs. */
+
+static void
+init (void)
+{
+ v = NULL;
+}
+
+static void
+done (void)
+{
+ free (v);
+}
+
+int
+cmd_value_labels (void)
+{
+ int code;
+ init ();
+ lex_match_id ("VALUE");
+ lex_match_id ("LABELS");
+ code = do_value_labels (1);
+ done ();
+ return code;
+}
+
+int
+cmd_add_value_labels (void)
+{
+ int code;
+ lex_match_id ("ADD");
+ lex_match_id ("VALUE");
+ lex_match_id ("LABELS");
+ code = do_value_labels (0);
+ done ();
+ return code;
+}
+\f
+/* Do it. */
+
+static int
+do_value_labels (int erase)
+{
+ lex_match ('/');
+
+ while (token != '.')
+ {
+ parse_variables (NULL, &v, &nv, PV_SAME_TYPE);
+ if (!verify_val_labs (erase))
+ return CMD_PART_SUCCESS_MAYBE;
+ while (token != '/' && token != '.')
+ if (!get_label ())
+ return CMD_PART_SUCCESS_MAYBE;
+
+ if (token != '/')
+ break;
+ lex_get ();
+
+ free (v);
+ v = NULL;
+ }
+
+ if (token != '.')
+ {
+ lex_error (NULL);
+ return CMD_TRAILING_GARBAGE;
+ }
+
+#if DEBUGGING
+ debug_print ();
+#endif
+ return CMD_SUCCESS;
+}
+
+static int
+verify_val_labs (int erase)
+{
+ int i;
+
+ if (!nv)
+ return 1;
+
+ for (i = 0; i < nv; i++)
+ {
+ struct variable *vp = v[i];
+
+ if (vp->type == ALPHA && vp->width > 8)
+ {
+ msg (SE, _("It is not possible to assign value labels to long "
+ "string variables such as %s."), vp->name);
+ return 0;
+ }
+
+ if (erase && v[i]->val_lab)
+ {
+ avl_destroy (vp->val_lab, free_val_lab);
+ vp->val_lab = NULL;
+ }
+ }
+ return 1;
+}
+
+/* Parse all the labels for a particular set of variables and add the
+ specified labels to those variables. */
+static int
+get_label (void)
+{
+ int i;
+
+ /* Make sure there's some variables. */
+ if (!nv)
+ {
+ if (token != T_STRING && token != T_NUM)
+ return 0;
+ lex_get ();
+ return 1;
+ }
+
+ /* Parse all the labels and add them to the variables. */
+ do
+ {
+ struct value_label *label;
+
+ /* Allocate label. */
+ label = xmalloc (sizeof *label);
+#if __CHECKER__
+ memset (&label->v, 0, sizeof label->v);
+#endif
+ label->ref_count = nv;
+
+ /* Set label->v. */
+ if (v[0]->type == ALPHA)
+ {
+ if (token != T_STRING)
+ {
+ msg (SE, _("String expected for value."));
+ return 0;
+ }
+ st_bare_pad_copy (label->v.s, ds_value (&tokstr), MAX_SHORT_STRING);
+ }
+ else
+ {
+ if (token != T_NUM)
+ {
+ msg (SE, _("Number expected for value."));
+ return 0;
+ }
+ if (!lex_integer_p ())
+ msg (SW, _("Value label `%g' is not integer."), tokval);
+ label->v.f = tokval;
+ }
+
+ /* Set label->s. */
+ lex_get ();
+ if (!lex_force_string ())
+ return 0;
+ if (ds_length (&tokstr) > 60)
+ {
+ msg (SW, _("Truncating value label to 60 characters."));
+ ds_truncate (&tokstr, 60);
+ }
+ label->s = xstrdup (ds_value (&tokstr));
+
+ for (i = 0; i < nv; i++)
+ {
+ if (!v[i]->val_lab)
+ v[i]->val_lab = avl_create (NULL, val_lab_cmp,
+ (void *) (v[i]->width));
+
+ {
+ struct value_label *old;
+
+ old = avl_replace (v[i]->val_lab, label);
+ if (old)
+ free_value_label (old);
+ }
+ }
+
+ lex_get ();
+ }
+ while (token != '/' && token != '.');
+
+ return 1;
+}
+
+#if DEBUGGING
+static void
+debug_print ()
+{
+ int i;
+
+ puts (_("Value labels:"));
+ for (i = 0; i < nvar; i++)
+ {
+ AVLtraverser *t = NULL;
+ struct value_label *val;
+
+ printf (" %s\n", var[i]->name);
+ if (var[i]->val_lab)
+ if (var[i]->type == NUMERIC)
+ for (val = avltrav (var[i]->val_lab, &t);
+ val; val = avltrav (var[i]->val_lab, &t))
+ printf (" %g: `%s'\n", val->v.f, val->s);
+ else
+ for (val = avltrav (var[i]->val_lab, &t);
+ val; val = avltrav (var[i]->val_lab, &t))
+ printf (" `%.8s': `%s'\n", val->v.s, val->s);
+ else
+ printf (_(" (no value labels)\n"));
+ }
+}
+#endif /* DEBUGGING */
+
+/* Compares two value labels and returns a strcmp()-type result. */
+int
+val_lab_cmp (const void *a, const void *b, void *param)
+{
+ if ((int) param)
+ return strncmp (((struct value_label *) a)->v.s,
+ ((struct value_label *) b)->v.s,
+ (int) param);
+ else
+ {
+ int temp = (((struct value_label *) a)->v.f
+ - ((struct value_label *) b)->v.f);
+ if (temp > 0)
+ return 1;
+ else if (temp < 0)
+ return -1;
+ else
+ return 0;
+ }
+}
+
+/* Callback function to increment the reference count for a value
+ label. */
+void *
+inc_ref_count (void *pv, void *param unused)
+{
+ ((struct value_label *) pv)->ref_count++;
+ return pv;
+}
+
+/* Copy the avl tree of value labels and return a pointer to the
+ copy. */
+avl_tree *
+copy_value_labels (avl_tree *src)
+{
+ avl_tree *dest;
+
+ if (src == NULL)
+ return NULL;
+ dest = avl_copy (NULL, src, inc_ref_count);
+
+ return dest;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "str.h"
+#include "var.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+#if DEBUGGING
+static void debug_print (void);
+#endif
+
+int
+cmd_variable_labels (void)
+{
+ struct variable **v;
+ int nv;
+
+ int i;
+
+ lex_match_id ("VARIABLE");
+ lex_match_id ("LABELS");
+ lex_match ('/');
+ do
+ {
+ parse_variables (NULL, &v, &nv, PV_NONE);
+
+ if (token != T_STRING)
+ {
+ msg (SE, _("String expected for variable label."));
+ free (v);
+ return CMD_PART_SUCCESS_MAYBE;
+ }
+ if (ds_length (&tokstr) > 120)
+ {
+ msg (SW, _("Truncating variable label to 120 characters."));
+ ds_truncate (&tokstr, 120);
+ }
+ for (i = 0; i < nv; i++)
+ {
+ if (v[i]->label)
+ free (v[i]->label);
+ v[i]->label = xstrdup (ds_value (&tokstr));
+ }
+
+ lex_get ();
+ while (token == '/')
+ lex_get ();
+ free (v);
+ }
+ while (token != '.');
+#if DEBUGGING
+ debug_print ();
+#endif
+ return CMD_SUCCESS;
+}
+
+#if DEBUGGING
+static void
+debug_print (void)
+{
+ int i;
+
+ printf (_("Variable labels:\n"));
+ for (i = 0; i < nvar; i++)
+ {
+ printf (" %8s: ", var[i]->name);
+ if (var[i]->label)
+ printf ("`%s'", var[i]->label);
+ else
+ printf (_("(no variable label)"));
+ printf ("\n");
+ }
+}
+#endif /* DEBUGGING */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !var_h
+#define var_h 1
+
+#include "format.h"
+
+/* Values. */
+
+/* Definition of the max length of a short string value, generally
+ eight characters. */
+#define MAX_SHORT_STRING ((SIZEOF_DOUBLE)>=8 ? ((SIZEOF_DOUBLE)+1)/2*2 : 8)
+#define MIN_LONG_STRING (MAX_SHORT_STRING+1)
+
+/* FYI: It is a bad situation if sizeof(flt64) < MAX_SHORT_STRING:
+ then short string missing values can be truncated in system files
+ because there's only room for as many characters as can fit in a
+ flt64. */
+#if MAX_SHORT_STRING > 8
+#error MAX_SHORT_STRING must be less than 8.
+#endif
+
+/* Special values. */
+#define SYSMIS (-DBL_MAX)
+#define LOWEST second_lowest_value
+#define HIGHEST DBL_MAX
+
+/* Describes one value, which is either a floating-point number or a
+ short string. */
+union value
+ {
+ /* A numeric value. */
+ double f;
+
+ /* A short-string value. */
+ unsigned char s[MAX_SHORT_STRING];
+
+ /* This member is used by data-in.c to return a string result,
+ since it may need to return a long string. As currently
+ implemented, it's a pointer to a static internal buffer in
+ data-in.c.
+
+ Also used by evaluate_expression() to return a string result.
+ As currently implemented, it's a pointer to a dynamic buffer in
+ the appropriate expression.
+
+ Also used by the AGGREGATE procedure in handling string
+ values. */
+ unsigned char *c;
+
+ /* Sometimes we insert value's in a hash table. */
+ unsigned long hash[SIZEOF_DOUBLE / SIZEOF_LONG];
+ };
+
+/* Describes one value label. */
+struct value_label
+ {
+ union value v; /* The value being labeled. */
+ char *s; /* Pointer to malloc()'d label. */
+ int ref_count; /* Reference count. */
+ };
+\f
+/* Frequency tables. */
+
+/* Frequency table entry. */
+struct freq
+ {
+ union value v; /* The value. */
+ double c; /* The number of occurrences of the value. */
+ };
+
+/* Types of frequency tables. */
+enum
+ {
+ FRQM_GENERAL,
+ FRQM_INTEGER
+ };
+
+/* Entire frequency table. */
+struct freq_tab
+ {
+ int mode; /* FRQM_GENERAL or FRQM_INTEGER. */
+
+ /* General mode. */
+ struct avl_tree *tree; /* Undifferentiated data. */
+
+ /* Integer mode. */
+ double *vector; /* Frequencies proper. */
+ int min, max; /* The boundaries of the table. */
+ double out_of_range; /* Sum of weights of out-of-range values. */
+ double sysmis; /* Sum of weights of SYSMIS values. */
+
+ /* All modes. */
+ struct freq *valid; /* Valid freqs. */
+ int n_valid; /* Number of total freqs. */
+
+ struct freq *missing; /* Missing freqs. */
+ int n_missing; /* Number of missing freqs. */
+
+ /* Statistics. */
+ double total_cases; /* Sum of weights of all cases. */
+ double valid_cases; /* Sum of weights of valid cases. */
+ };
+
+/* A complete set of 3 frequency tables. */
+struct freq_tab_set
+ {
+ struct freq_tab miss; /* Includes user-missing values. */
+ struct freq_tab no_miss; /* Excludes user-missing values. */
+ struct freq_tab sel; /* Identical to either miss or no_miss. */
+ };
+\f
+/* Procedures' private per-variable data. */
+
+/* Structure name suffixes for private data:
+ _proc: for a procedure (i.e., LIST -> list_proc).
+ _trns: for a transformation (i.e., COMPUTE -> compute_trns.
+ _pgm: for an input program (i.e., DATA LIST -> data_list_pgm). */
+
+/* CROSSTABS private data. */
+struct crosstab_proc
+ {
+ /* Integer mode only. */
+ int min; /* Minimum value. */
+ int max; /* Maximum value + 1. */
+ int count; /* max - min. */
+ };
+
+/* FREQUENCIES private data. */
+enum
+ {
+ frq_mean = 0, frq_semean, frq_median, frq_mode, frq_stddev, frq_variance,
+ frq_kurt, frq_sekurt, frq_skew, frq_seskew, frq_range, frq_min, frq_max,
+ frq_sum, frq_n_stats
+ };
+
+struct frequencies_proc
+ {
+ /* General mode. */
+ struct freq_tab tab; /* Frequencies table to use. */
+
+ /* Percentiles. */
+ int n_groups; /* Number of groups. */
+ double *groups; /* Groups. */
+
+ /* Statistics. */
+ double stat[frq_n_stats];
+ };
+
+/* LIST private data. */
+struct list_proc
+ {
+ int newline; /* Whether a new line begins here. */
+ int width; /* Field width. */
+ int vert; /* Whether to print the varname vertically. */
+ };
+
+/* DESCRIPTIVES private data. Note that the DESCRIPTIVES procedure also
+ has a transformation, descriptives_trns. */
+enum
+ {
+ /* As these are used as bit indexes, there must be 32 or fewer.
+ Be very careful in adjusting these, see the structure below
+ and the table in descriptives.q. */
+ dsc_mean = 0, dsc_semean, dsc_stddev, dsc_variance, dsc_kurt,
+ dsc_sekurt, dsc_skew, dsc_seskew, dsc_range, dsc_min,
+ dsc_max, dsc_sum, dsc_n_stats
+ };
+
+struct descriptives_proc
+ {
+ /* Miscellaneous. */
+ int dup; /* Finds duplicates in list of
+ variables. */
+ char zname[10]; /* Name for z-score variable. */
+
+ /* Counts. */
+ double valid, miss; /* Valid, missing--general. */
+
+ /* Mean, moments about the mean. */
+ double X_bar, M2, M3, M4;
+ double min, max;
+
+ /* Statistics. */
+ double stats[dsc_n_stats]; /* Everything glommed together. */
+ };
+
+/* GET private data. */
+struct get_proc
+ {
+ int fv, nv; /* First, last, # of values. */
+ };
+
+/* Sort order. */
+enum
+ {
+ SRT_ASCEND, /* A, B, C, ..., X, Y, Z. */
+ SRT_DESCEND /* Z, Y, X, ..., C, B, A. */
+ };
+
+/* SORT CASES private data. */
+struct sort_cases_proc
+ {
+ int order; /* SRT_ASCEND or SRT_DESCEND. */
+ };
+
+/* MODIFY VARS private data. */
+struct modify_vars_proc
+ {
+ char new_name[9]; /* Variable's new name. */
+ int drop_this_var; /* 0=keep this var, 1=drop this var. */
+ struct variable *next; /* Next in linked list. */
+ };
+
+/* MEANS private data. */
+struct means_proc
+ {
+ double min, max; /* Range for integer mode. */
+ };
+
+/* Different types of variables for MATRIX DATA procedure. Order is
+ important: these are used for sort keys. */
+enum
+ {
+ MXD_SPLIT, /* SPLIT FILE variables. */
+ MXD_ROWTYPE, /* ROWTYPE_. */
+ MXD_FACTOR, /* Factor variables. */
+ MXD_VARNAME, /* VARNAME_. */
+ MXD_CONTINUOUS, /* Continuous variables. */
+
+ MXD_COUNT
+ };
+
+/* MATRIX DATA private data. */
+struct matrix_data_proc
+ {
+ int vartype; /* Variable type. */
+ int subtype; /* Subtype. */
+ };
+
+/* MATCH FILES private data. */
+struct match_files_proc
+ {
+ struct variable *master; /* Corresponding master file variable. */
+ };
+
+\f
+/* Script variables. */
+
+/* Variable type. */
+enum
+ {
+ NUMERIC, /* A numeric variable. */
+ ALPHA /* A string variable. (STRING is pre-empted by lexer.h) */
+ };
+
+/* Types of missing values. Order is significant, see
+ mis-val.c:parse_numeric(), sfm-read.c:sfm_read_dictionary()
+ sfm-write.c:sfm_write_dictionary(),
+ sysfile-info.c:cmd_sysfile_info(), mis-val.c:copy_missing_values(),
+ pfm-read.c:read_variables(), pfm-write.c:write_variables(),
+ apply-dict.c:cmd_apply_dictionary(), and more (?). */
+enum
+ {
+ MISSING_NONE, /* No user-missing values. */
+ MISSING_1, /* One user-missing value. */
+ MISSING_2, /* Two user-missing values. */
+ MISSING_3, /* Three user-missing values. */
+ MISSING_RANGE, /* [a,b]. */
+ MISSING_LOW, /* (-inf,a]. */
+ MISSING_HIGH, /* (a,+inf]. */
+ MISSING_RANGE_1, /* [a,b], c. */
+ MISSING_LOW_1, /* (-inf,a], b. */
+ MISSING_HIGH_1, /* (a,+inf), b. */
+ MISSING_COUNT
+ };
+
+/* A variable's dictionary entry. Note: don't reorder name[] from the
+ first element; a pointer to `variable' should be a pointer to
+ member `name'.*/
+struct variable
+ {
+ /* Required by parse_variables() to be in this order. */
+ char name[9]; /* As a string. */
+ int index; /* Index into its dictionary's var[]. */
+ int type; /* NUMERIC or ALPHA. */
+ int foo; /* Used for temporary storage. */
+
+ /* Also important but parse_variables() doesn't need it. Still,
+ check before reordering. */
+ int width; /* Size of string variables in chars. */
+ int fv, nv; /* Index into `value's, number of values. */
+ int left; /* 0=do not LEAVE, 1=LEAVE. */
+
+ /* Missing values. */
+ int miss_type; /* One of the MISSING_* constants. */
+ union value missing[3]; /* User-missing value. */
+
+ /* Display formats. */
+ struct fmt_spec print; /* Default format for PRINT. */
+ struct fmt_spec write; /* Default format for WRITE. */
+
+ /* Labels. */
+ struct avl_tree *val_lab; /* Avltree of value_label structures. */
+ char *label; /* Variable label. */
+
+ /* Per-procedure info. */
+ struct get_proc get;
+ union
+ {
+ struct crosstab_proc crs;
+ struct descriptives_proc dsc;
+ struct frequencies_proc frq;
+ struct list_proc lst;
+ struct means_proc mns;
+ struct sort_cases_proc srt;
+ struct modify_vars_proc mfv;
+ struct matrix_data_proc mxd;
+ struct match_files_proc mtf;
+ }
+ p;
+ };
+\f
+/* Cases. */
+
+/* A single case. (This doesn't need to be a struct anymore, but it
+ remains so for hysterical raisins.) */
+struct ccase
+ {
+ union value data[1];
+ };
+\f
+/* Dictionary. */
+
+/* Complete dictionary state. */
+struct dictionary
+ {
+ struct variable **var; /* Variable descriptions. */
+ struct avl_tree *var_by_name; /* Variables arranged by name. */
+ int nvar; /* Number of variables. */
+
+ int N; /* Current case limit (N command). */
+ int nval; /* Number of value structures per case. */
+
+ int n_splits; /* Number of SPLIT FILE variables. */
+ struct variable **splits; /* List of SPLIT FILE vars. */
+
+ char *label; /* File label. */
+
+ int n_documents; /* Number of lines of documents. */
+ char *documents; /* Documents; 80*n_documents bytes in size. */
+
+ int weight_index; /* `value' index of $WEIGHT, or -1 if none.
+ Call update_weighting() before using! */
+ char weight_var[9]; /* Name of WEIGHT variable. */
+
+ char filter_var[9]; /* Name of FILTER variable. */
+ /* Do not make another field the last field! or see
+ temporary.c:restore_dictionary() before doing so! */
+ };
+
+/* This is the active file dictionary. */
+extern struct dictionary default_dict;
+\f
+/* Transformation state. */
+
+/* Default file handle for DATA LIST, REREAD, REPEATING DATA
+ commands. */
+extern struct file_handle *default_handle;
+
+/* PROCESS IF expression. */
+extern struct expression *process_if_expr;
+\f
+/* TEMPORARY support. */
+
+/* 1=TEMPORARY has been executed at some point. */
+extern int temporary;
+
+/* If temporary!=0, the saved dictionary. */
+extern struct dictionary *temp_dict;
+
+/* If temporary!=0, index into t_trns[] (declared far below) that
+ gives the point at which data should be written out. -1 means that
+ the data shouldn't be changed since all transformations are
+ temporary. */
+extern int temp_trns;
+
+/* If FILTER is active, whether it was executed before or after
+ TEMPORARY. */
+extern int FILTER_before_TEMPORARY;
+
+void cancel_temporary (void);
+\f
+/* Functions. */
+
+int is_varname (const char *);
+int is_dict_varname (const struct dictionary *, const char *);
+
+/* Flags for passing to fill_all_vars(). */
+enum
+ {
+ FV_NONE = 0, /* No flags. */
+ FV_NO_SYSTEM = 001, /* Don't include system variables. */
+ FV_NO_SCRATCH = 002 /* Don't include scratch variables. */
+ };
+
+void fill_all_vars (struct variable ***, int *, int flags);
+
+int val_lab_cmp (const void *, const void *, void *);
+char *get_val_lab (const struct variable *, union value, int);
+void free_val_lab (void *, void *);
+void free_value_label (struct value_label *);
+struct avl_tree *copy_value_labels (struct avl_tree *);
+
+void dump_split_vars (const struct ccase *);
+
+int is_num_user_missing (double, const struct variable *);
+int is_str_user_missing (const unsigned char[], const struct variable *);
+int is_missing (const union value *, const struct variable *);
+int is_system_missing (const union value *, const struct variable *);
+int is_user_missing (const union value *, const struct variable *);
+void copy_missing_values (struct variable *dest, const struct variable *src);
+
+int cmp_variable (const void *, const void *, void *);
+
+#if GLOBAL_DEBUGGING
+struct variable *force_create_variable (struct dictionary *, const char *name,
+ int type, int width);
+struct variable *force_dup_variable (struct dictionary *,
+ const struct variable *src,
+ const char *name);
+#else
+#define force_create_variable(A, B, C, D) \
+ create_variable (A, B, C, D)
+#define force_dup_variable(A, B, C) \
+ dup_variable (A, B, C)
+#endif
+
+struct variable *create_variable (struct dictionary *, const char *name,
+ int type, int width);
+void delete_variable (struct dictionary *, struct variable *v);
+struct variable *find_variable (const char *name);
+struct variable *find_dict_variable (const struct dictionary *,
+ const char *name);
+void init_variable (struct dictionary *, struct variable *, const char *name,
+ int type, int width);
+void replace_variable (struct variable *, const char *name,
+ int type, int width);
+void clear_variable (struct dictionary *, struct variable *);
+void rename_variable (struct dictionary *, struct variable *v,
+ const char *new_name);
+void discard_variables (void);
+void clear_default_dict (void);
+void copy_variable (struct variable *dest, const struct variable *src);
+struct variable *dup_variable (struct dictionary *dict,
+ const struct variable *src, const char *name);
+
+struct variable *update_weighting (struct dictionary *);
+void stop_weighting (struct dictionary *);
+
+struct dictionary *save_dictionary (void);
+void restore_dictionary (struct dictionary *);
+void free_dictionary (struct dictionary *);
+struct dictionary *new_dictionary (int copy);
+\f
+/* Transformations. */
+
+/* Header for all transformations. */
+struct trns_header
+ {
+ /* Index into t_trns[]. */
+ int index;
+
+ /* Transformation proc. */
+ int (*proc) (struct trns_header *, struct ccase *);
+
+ /* Garbage collector proc. */
+ void (*free) (struct trns_header *);
+ };
+
+/* Array of transformations */
+extern struct trns_header **t_trns;
+
+/* Number of transformations, maximum number in array currently. */
+extern int n_trns, m_trns;
+
+/* Index of first transformation that is really a transformation. Any
+ transformations before this belong to INPUT PROGRAM. */
+extern int f_trns;
+
+void add_transformation (struct trns_header *trns);
+void cancel_transformations (void);
+\f
+/* Variable parsers. */
+
+/* Only parse_variables() supports options other than PV_APPEND,
+ PV_SINGLE. */
+enum
+ {
+ PV_NONE = 0, /* No options. */
+ PV_SINGLE = 0001, /* Restrict to a single varname or TO use. */
+ PV_DUPLICATE = 0002, /* Don't merge duplicates. */
+ PV_APPEND = 0004, /* Append to existing list. */
+ PV_NO_DUPLICATE = 0010, /* Error on duplicates. */
+ PV_NUMERIC = 0020, /* Vars must be numeric. */
+ PV_STRING = 0040, /* Vars must be string. */
+ PV_SAME_TYPE = 00100, /* All vars must be the same type. */
+ PV_NO_SCRATCH = 00200 /* Disallow scratch variables. */
+ };
+
+struct variable *parse_variable (void);
+struct variable *parse_dict_variable (struct dictionary *);
+int parse_variables (struct dictionary *dict, struct variable ***v,
+ int *nv, int pv_opts);
+int parse_DATA_LIST_vars (char ***names, int *nnames, int pv_opts);
+int parse_mixed_vars (char ***names, int *nnames, int pv_opts);
+
+#endif /* !var_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "approx.h"
+#include "avl.h"
+#include "command.h"
+#include "do-ifP.h"
+#include "expr.h"
+#include "file-handle.h"
+#include "inpt-pgm.h"
+#include "misc.h"
+#include "str.h"
+#include "var.h"
+#include "vector.h"
+#include "vfm.h"
+
+#undef DEBUGGING
+/*#define DEBUGGING 1*/
+#include "debug-print.h"
+
+#if DEBUGGING
+/* Dumps one variable to standard output. */
+void
+dump_one_var_node (void * pnode, void *param, int level)
+{
+ variable *node = pnode;
+ int i;
+
+ for (i = 0; i < level - 1; i++)
+ printf (" ");
+ if (node == NULL)
+ printf ("NULL_TREE\n");
+ else
+ printf ("%p=>%s\n", node, node->name ? node->name : "<null>");
+}
+
+/* Dumps a tree of the variables to standard output. */
+void
+dump_var_tree (void)
+{
+ printf (_("Vartree:\n"));
+ avl_walk_inorder (default_dict.var_by_name, dump_one_var_node, NULL);
+}
+#endif
+
+/* Clear the default dictionary. Note: This is probably not what you
+ want to do. Use discard_variables() instead. */
+void
+clear_default_dict (void)
+{
+ int i;
+
+ for (i = 0; i < default_dict.nvar; i++)
+ {
+ clear_variable (&default_dict, default_dict.var[i]);
+ free (default_dict.var[i]);
+ }
+
+ assert (default_dict.splits == NULL);
+
+ default_dict.nvar = 0;
+ default_dict.N = 0;
+ default_dict.nval = 0;
+ default_handle = inline_file;
+ stop_weighting (&default_dict);
+}
+
+/* Discards all the current state in preparation for a data-input
+ command like DATA LIST or GET. */
+void
+discard_variables (void)
+{
+ clear_default_dict ();
+
+ n_lag = 0;
+
+ if (vfm_source)
+ {
+ vfm_source->destroy_source ();
+ vfm_source = NULL;
+ }
+
+ cancel_transformations ();
+
+ ctl_stack = NULL;
+
+ free (vec);
+ vec = NULL;
+ nvec = 0;
+
+ expr_free (process_if_expr);
+ process_if_expr = NULL;
+
+ cancel_temporary ();
+
+ pgm_state = STATE_INIT;
+}
+
+/* Find and return the variable in default_dict having name NAME, or
+ NULL if no such variable exists in default_dict. */
+struct variable *
+find_variable (const char *name)
+{
+ return avl_find (default_dict.var_by_name, (struct variable *) name);
+}
+
+/* Find and return the variable in dictionary D having name NAME, or
+ NULL if no such variable exists in D. */
+struct variable *
+find_dict_variable (const struct dictionary *d, const char *name)
+{
+ return avl_find (d->var_by_name, (struct variable *) name);
+}
+
+/* Creates a variable named NAME in dictionary DICT having type TYPE
+ (ALPHA or NUMERIC) and, if type==ALPHA, width WIDTH. Returns a
+ pointer to the newly created variable if successful. On failure
+ (which indicates that a variable having the specified name already
+ exists), returns NULL. */
+struct variable *
+create_variable (struct dictionary *dict, const char *name,
+ int type, int width)
+{
+ if (find_dict_variable (dict, name))
+ return NULL;
+
+ {
+ struct variable *new_var;
+
+ dict->var = xrealloc (dict->var, (dict->nvar + 1) * sizeof *dict->var);
+ new_var = dict->var[dict->nvar] = xmalloc (sizeof *new_var);
+
+ new_var->index = dict->nvar;
+ dict->nvar++;
+
+ init_variable (dict, new_var, name, type, width);
+
+ return new_var;
+ }
+}
+
+#if GLOBAL_DEBUGGING
+/* For situations in which we know that there are no variables with an
+ identical name in the dictionary. */
+struct variable *
+force_create_variable (struct dictionary *dict, const char *name,
+ int type, int width)
+{
+ struct variable *new_var = create_variable (dict, name, type, width);
+ assert (new_var != NULL);
+ return new_var;
+}
+
+/* For situations in which we know that there are no variables with an
+ identical name in the dictionary. */
+struct variable *
+force_dup_variable (struct dictionary *dict, const struct variable *src,
+ const char *name)
+{
+ struct variable *new_var = dup_variable (dict, src, name);
+ assert (new_var != NULL);
+ return new_var;
+}
+#endif
+
+/* Delete variable V from DICT. It should only be used when there are
+ guaranteed to be absolutely NO REFERENCES to it, for instance in
+ the very same function that created it. */
+void
+delete_variable (struct dictionary *dict, struct variable *v)
+{
+ int i;
+
+ clear_variable (dict, v);
+ dict->nvar--;
+ for (i = v->index; i < dict->nvar; i++)
+ {
+ dict->var[i] = dict->var[i + 1];
+ dict->var[i]->index = i;
+ }
+ free (v);
+}
+
+/* Initialize fields in variable V inside dictionary D with name NAME,
+ type TYPE, and width WIDTH. Initializes some other fields too. */
+static inline void
+common_init_stuff (struct dictionary *dict, struct variable *v,
+ const char *name, int type, int width)
+{
+ if (v->name != name)
+ /* Avoid problems with overlap. */
+ strcpy (v->name, name);
+
+ avl_force_insert (dict->var_by_name, v);
+
+ v->type = type;
+ v->left = name[0] == '#';
+ v->width = type == NUMERIC ? 0 : width;
+ v->miss_type = MISSING_NONE;
+ if (v->type == NUMERIC)
+ {
+ v->print.type = FMT_F;
+ v->print.w = 8;
+ v->print.d = 2;
+ }
+ else
+ {
+ v->print.type = FMT_A;
+ v->print.w = v->width;
+ v->print.d = 0;
+ }
+ v->write = v->print;
+}
+
+/* Initialize (for the first time) a variable V in dictionary DICT
+ with name NAME, type TYPE, and width WIDTH. */
+void
+init_variable (struct dictionary *dict, struct variable *v, const char *name,
+ int type, int width)
+{
+ common_init_stuff (dict, v, name, type, width);
+ v->nv = type == NUMERIC ? 1 : DIV_RND_UP (width, 8);
+ v->fv = dict->nval;
+ dict->nval += v->nv;
+ v->label = NULL;
+ v->val_lab = NULL;
+ v->get.fv = -1;
+
+ if (vfm_source == &input_program_source
+ || vfm_source == &file_type_source)
+ {
+ size_t nbytes = DIV_RND_UP (v->fv + 1, 4);
+ unsigned val = 0;
+
+ if (inp_init_size < nbytes)
+ {
+ inp_init = xrealloc (inp_init, nbytes);
+ memset (&inp_init[inp_init_size], 0, nbytes - inp_init_size);
+ inp_init_size = nbytes;
+ }
+
+ if (v->type == ALPHA)
+ val |= INP_STRING;
+ if (v->left)
+ val |= INP_LEFT;
+ inp_init[v->fv / 4] |= val << ((unsigned) (v->fv) % 4 * 2);
+ }
+}
+
+/* Replace variable V in default_dict with a different variable having
+ name NAME, type TYPE, and width WIDTH. */
+void
+replace_variable (struct variable *v, const char *name, int type, int width)
+{
+ int nv;
+
+ assert (v && name && (type == NUMERIC || type == ALPHA) && width >= 0
+ && (type == ALPHA || width == 0));
+ clear_variable (&default_dict, v);
+ common_init_stuff (&default_dict, v, name, type, width);
+
+ nv = (type == NUMERIC) ? 1 : DIV_RND_UP (width, 8);
+ if (nv > v->nv)
+ {
+ v->fv = v->nv = 0;
+ v->fv = default_dict.nval;
+ default_dict.nval += nv;
+ }
+ v->nv = nv;
+}
+
+/* Changes the name of variable V in dictionary DICT to name NEW_NAME.
+ NEW_NAME must be known not to already exist in dictionary DICT. */
+void
+rename_variable (struct dictionary * dict, struct variable *v,
+ const char *new_name)
+{
+ assert (dict && dict->var_by_name && v && new_name);
+ avl_delete (dict->var_by_name, v);
+ strncpy (v->name, new_name, 9);
+ avl_force_insert (dict->var_by_name, v);
+}
+
+/* Delete the contents of variable V within dictionary DICT. Does not
+ remove the variable from the vector of variables in the dictionary.
+ Use with caution. */
+void
+clear_variable (struct dictionary *dict, struct variable *v)
+{
+ assert (dict && v);
+
+#if DEBUGGING
+ printf (_("clearing variable %d:%s %s\n"), v->index, v->name,
+ (dict == &default_dict ? _("in default dictionary")
+ : _("in auxiliary dictionary")));
+ if (dict->var_by_name != NULL)
+ dump_var_tree ();
+#endif
+
+ if (dict->var_by_name != NULL)
+ avl_force_delete (dict->var_by_name, v);
+
+ if (v->val_lab)
+ {
+ avl_destroy (v->val_lab, free_val_lab);
+ v->val_lab = NULL;
+ }
+
+ if (v->label)
+ {
+ free (v->label);
+ v->label = NULL;
+ }
+
+ if (dict->splits)
+ {
+ struct variable **iter, **trailer;
+
+ for (trailer = iter = dict->splits; *iter; iter++)
+ if (*iter != v)
+ *trailer++ = *iter;
+ else
+ dict->n_splits--;
+
+ *trailer = NULL;
+
+ if (dict->n_splits == 0)
+ {
+ free (dict->splits);
+ dict->splits = NULL;
+ }
+ }
+
+#if DEBUGGING
+ if (dict->var_by_name != NULL)
+ dump_var_tree ();
+#endif
+}
+
+/* Creates a new variable in dictionary DICT, whose properties are
+ copied from variable SRC, and returns a pointer to the new variable
+ of name NAME, if successful. If unsuccessful (which only happens
+ if a variable of the same name NAME exists in DICT), returns
+ NULL. */
+struct variable *
+dup_variable (struct dictionary *dict, const struct variable *src,
+ const char *name)
+{
+ if (find_dict_variable (dict, name))
+ return NULL;
+
+ {
+ struct variable *new_var;
+
+ dict->var = xrealloc (dict->var, (dict->nvar + 1) * sizeof *dict->var);
+ new_var = dict->var[dict->nvar] = xmalloc (sizeof *new_var);
+
+ new_var->index = dict->nvar;
+ new_var->foo = -1;
+ new_var->get.fv = -1;
+ new_var->get.nv = -1;
+ dict->nvar++;
+
+ copy_variable (new_var, src);
+
+ assert (new_var->nv >= 0);
+ new_var->fv = dict->nval;
+ dict->nval += new_var->nv;
+
+ strcpy (new_var->name, name);
+ avl_force_insert (dict->var_by_name, new_var);
+
+ return new_var;
+ }
+}
+
+
+/* Decrements the reference count for value label V. Destroys the
+ value label if the reference count reaches zero. */
+void
+free_value_label (struct value_label * v)
+{
+ assert (v->ref_count >= 1);
+ if (--v->ref_count == 0)
+ {
+ free (v->s);
+ free (v);
+ }
+}
+
+/* Frees value label P. PARAM is ignored. Used as a callback with
+ avl_destroy(). */
+void
+free_val_lab (void *p, void *param unused)
+{
+ free_value_label ((struct value_label *) p);
+}
+
+/* Returns a value label corresponding to VAL in variable V padded to
+ length N. If N==0 then no padding is performed, and NULL is
+ returned if no label exists. (Normally a string of spaces is
+ returned in this case.) */
+char *
+get_val_lab (const struct variable *v, union value val, int n)
+{
+ static char *buf;
+ static int bufsize;
+ struct value_label template, *find;
+
+ if (bufsize < n)
+ {
+ buf = xrealloc (buf, n + 1);
+ bufsize = n;
+ }
+ if (n)
+ buf[0] = 0;
+ template.v = val;
+ find = NULL;
+ if (v->val_lab)
+ find = avl_find (v->val_lab, &template);
+ if (find)
+ {
+ if (n)
+ {
+ st_pad_copy (buf, find->s, n + 1);
+ return buf;
+ }
+ else
+ return find->s;
+ }
+ else
+ {
+ if (n)
+ {
+ memset (buf, ' ', n);
+ buf[n] = '\0';
+ return buf;
+ }
+ else
+ return NULL;
+ }
+}
+
+/* Return nonzero only if X is a user-missing value for numeric
+ variable V. */
+inline int
+is_num_user_missing (double x, const struct variable *v)
+{
+ switch (v->miss_type)
+ {
+ case MISSING_NONE:
+ return 0;
+ case MISSING_1:
+ return approx_eq (x, v->missing[0].f);
+ case MISSING_2:
+ return (approx_eq (x, v->missing[0].f)
+ || approx_eq (x, v->missing[1].f));
+ case MISSING_3:
+ return (approx_eq (x, v->missing[0].f)
+ || approx_eq (x, v->missing[1].f)
+ || approx_eq (x, v->missing[2].f));
+ case MISSING_RANGE:
+ return (approx_ge (x, v->missing[0].f)
+ && approx_le (x, v->missing[1].f));
+ case MISSING_LOW:
+ return approx_le (x, v->missing[0].f);
+ case MISSING_HIGH:
+ return approx_ge (x, v->missing[0].f);
+ case MISSING_RANGE_1:
+ return ((approx_ge (x, v->missing[0].f)
+ && approx_le (x, v->missing[1].f))
+ || approx_eq (x, v->missing[2].f));
+ case MISSING_LOW_1:
+ return (approx_le (x, v->missing[0].f)
+ || approx_eq (x, v->missing[1].f));
+ case MISSING_HIGH_1:
+ return (approx_ge (x, v->missing[0].f)
+ || approx_eq (x, v->missing[1].f));
+ default:
+ assert (0);
+ }
+ abort ();
+}
+
+/* Return nonzero only if string S is a user-missing variable for
+ string variable V. */
+inline int
+is_str_user_missing (const unsigned char s[], const struct variable *v)
+{
+ switch (v->miss_type)
+ {
+ case MISSING_NONE:
+ return 0;
+ case MISSING_1:
+ return !strncmp (s, v->missing[0].s, v->width);
+ case MISSING_2:
+ return (!strncmp (s, v->missing[0].s, v->width)
+ || !strncmp (s, v->missing[1].s, v->width));
+ case MISSING_3:
+ return (!strncmp (s, v->missing[0].s, v->width)
+ || !strncmp (s, v->missing[1].s, v->width)
+ || !strncmp (s, v->missing[2].s, v->width));
+ default:
+ assert (0);
+ }
+ abort ();
+}
+
+/* Return nonzero only if value VAL is system-missing for variable
+ V. */
+int
+is_system_missing (const union value *val, const struct variable *v)
+{
+ return v->type == NUMERIC && val->f == SYSMIS;
+}
+
+/* Return nonzero only if value VAL is system- or user-missing for
+ variable V. */
+int
+is_missing (const union value *val, const struct variable *v)
+{
+ switch (v->type)
+ {
+ case NUMERIC:
+ if (val->f == SYSMIS)
+ return 1;
+ return is_num_user_missing (val->f, v);
+ case ALPHA:
+ return is_str_user_missing (val->s, v);
+ default:
+ assert (0);
+ }
+ abort ();
+}
+
+/* Return nonzero only if value VAL is user-missing for variable V. */
+int
+is_user_missing (const union value *val, const struct variable *v)
+{
+ switch (v->type)
+ {
+ case NUMERIC:
+ return is_num_user_missing (val->f, v);
+ case ALPHA:
+ return is_str_user_missing (val->s, v);
+ default:
+ assert (0);
+ }
+ abort ();
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <ctype.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "avl.h"
+#include "bitvector.h"
+#include "error.h"
+#include "lexer.h"
+#include "misc.h"
+#include "str.h"
+#include "var.h"
+
+/* Allocates an array at *V to contain all the variables in
+ default_dict. If FV_NO_SYSTEM is set in FLAGS then system
+ variables will not be included. If FV_NO_SCRATCH is set in FLAGS
+ then scratch variables will not be included. *C is set to the
+ number of variables in *V. */
+void
+fill_all_vars (struct variable ***varlist, int *c, int flags)
+{
+ int i;
+
+ *varlist = xmalloc (default_dict.nvar * sizeof **varlist);
+ if (flags == FV_NONE)
+ {
+ *c = default_dict.nvar;
+ for (i = 0; i < default_dict.nvar; i++)
+ (*varlist)[i] = default_dict.var[i];
+ }
+ else
+ {
+ *c = 0;
+
+ for (i = 0; i < default_dict.nvar; i++)
+ {
+ struct variable *v = default_dict.var[i];
+
+ if ((flags & FV_NO_SYSTEM) && v->name[0] == '$')
+ continue;
+ if ((flags & FV_NO_SCRATCH) && v->name[0] == '#')
+ continue;
+
+ (*varlist)[*c] = v;
+ (*c)++;
+ }
+
+ if (*c != default_dict.nvar)
+ *varlist = xrealloc (*varlist, *c * sizeof **varlist);
+ }
+}
+
+int
+is_varname (const char *s)
+{
+ return avl_find (default_dict.var_by_name, (struct variable *) s) != 0;
+}
+
+int
+is_dict_varname (const struct dictionary *dict, const char *s)
+{
+ return avl_find (dict->var_by_name, (struct variable *) s) != 0;
+}
+
+struct variable *
+parse_variable (void)
+{
+ struct variable *vp;
+
+ if (token != T_ID)
+ {
+ lex_error ("expecting variable name");
+ return NULL;
+ }
+ vp = find_variable (tokid);
+ if (!vp)
+ msg (SE, _("%s is not declared as a variable."), tokid);
+ lex_get ();
+ return vp;
+}
+
+struct variable *
+parse_dict_variable (struct dictionary * dict)
+{
+ struct variable *vp;
+
+ if (token != T_ID)
+ {
+ lex_error ("expecting variable name");
+ return NULL;
+ }
+
+ vp = avl_find (dict->var_by_name, (struct variable *) tokid);
+ if (!vp)
+ msg (SE, _("%s is not a variable name."), tokid);
+ lex_get ();
+
+ return vp;
+}
+
+/* Returns the dictionary class of an identifier based on its
+ first letter: `X' if is an ordinary identifier, `$' if it
+ designates a system variable, `#' if it designates a scratch
+ variable. */
+#define id_dict(C) \
+ ((C) == '$' ? '$' : ((C) == '#' ? '#' : 'X'))
+
+/* FIXME: One interesting variation in the case of PV_APPEND would be
+ to keep the bitmap, reducing time required to an actual O(n log n)
+ instead of having to reproduce the bitmap *every* *single* *time*.
+ Later though. (Another idea would be to keep a marker bit in each
+ variable.) */
+/* Note that if parse_variables() returns 0, *v is free()'d.
+ Conversely, if parse_variables() returns non-zero, then *nv is
+ nonzero and *v is non-NULL. */
+int
+parse_variables (struct dictionary * dict, struct variable *** v, int *nv, int pv_opts)
+{
+ int i;
+ int nbytes;
+ unsigned char *bits;
+
+ struct variable *v1, *v2;
+ int count, mv;
+ int scratch; /* Dictionary we're reading from. */
+ int delayed_fail = 0;
+
+ if (dict == NULL)
+ dict = &default_dict;
+
+ if (!(pv_opts & PV_APPEND))
+ {
+ *v = NULL;
+ *nv = 0;
+ mv = 0;
+ }
+ else
+ mv = *nv;
+
+#if GLOBAL_DEBUGGING
+ {
+ int corrupt = 0;
+ int i;
+
+ for (i = 0; i < dict->nvar; i++)
+ if (dict->var[i]->index != i)
+ {
+ printf ("%s index corruption: variable %s\n",
+ dict == &default_dict ? "default_dict" : "aux dict",
+ dict->var[i]->name);
+ corrupt = 1;
+ }
+
+ assert (!corrupt);
+ }
+#endif
+
+ nbytes = DIV_RND_UP (dict->nvar, 8);
+ if (!(pv_opts & PV_DUPLICATE))
+ {
+ bits = local_alloc (nbytes);
+ memset (bits, 0, nbytes);
+ for (i = 0; i < *nv; i++)
+ SET_BIT (bits, (*v)[i]->index);
+ }
+
+ do
+ {
+ if (lex_match (T_ALL))
+ {
+ v1 = dict->var[0];
+ v2 = dict->var[dict->nvar - 1];
+ count = dict->nvar;
+ scratch = id_dict ('X');
+ }
+ else
+ {
+ v1 = parse_dict_variable (dict);
+ if (!v1)
+ goto fail;
+
+ if (lex_match (T_TO))
+ {
+ v2 = parse_dict_variable (dict);
+ if (!v2)
+ {
+ lex_error ("expecting variable name");
+ goto fail;
+ }
+
+ count = v2->index - v1->index + 1;
+ if (count < 1)
+ {
+ msg (SE, _("%s TO %s is not valid syntax since %s "
+ "precedes %s in the dictionary."),
+ v1->name, v2->name, v2->name, v1->name);
+ goto fail;
+ }
+
+ scratch = id_dict (v1->name[0]);
+ if (scratch != id_dict (v2->name[0]))
+ {
+ msg (SE, _("When using the TO keyword to specify several "
+ "variables, both variables must be from "
+ "the same variable dictionaries, of either "
+ "ordinary, scratch, or system variables. "
+ "%s and %s are from different dictionaries."),
+ v1->name, v2->name);
+ goto fail;
+ }
+ }
+ else
+ {
+ v2 = v1;
+ count = 1;
+ scratch = id_dict (v1->name[0]);
+ }
+ if (scratch == id_dict ('#') && (pv_opts & PV_NO_SCRATCH))
+ {
+ msg (SE, _("Scratch variables (such as %s) are not allowed "
+ "here."), v1->name);
+ goto fail;
+ }
+ }
+
+ if (*nv + count > mv)
+ {
+ mv += ROUND_UP (count, 16);
+ *v = xrealloc (*v, mv * sizeof **v);
+ }
+
+ for (i = v1->index; i <= v2->index; i++)
+ {
+ struct variable *add = dict->var[i];
+
+ /* Skip over other dictionaries. */
+ if (scratch != id_dict (add->name[0]))
+ continue;
+
+ if ((pv_opts & PV_NUMERIC) && add->type != NUMERIC)
+ {
+ delayed_fail = 1;
+ msg (SW, _("%s is not a numeric variable. It will not be "
+ "included in the variable list."), add->name);
+ }
+ else if ((pv_opts & PV_STRING) && add->type != ALPHA)
+ {
+ delayed_fail = 1;
+ msg (SE, _("%s is not a string variable. It will not be "
+ "included in the variable list."), add->name);
+ }
+ else if ((pv_opts & PV_SAME_TYPE) && *nv && add->type != (*v)[0]->type)
+ {
+ delayed_fail = 1;
+ msg (SE, _("%s and %s are not the same type. All variables in "
+ "this variable list must be of the same type. %s "
+ "will be omitted from list."),
+ (*v)[0]->name, add->name, add->name);
+ }
+ else if ((pv_opts & PV_NO_DUPLICATE) && TEST_BIT (bits, add->index))
+ {
+ delayed_fail = 1;
+ msg (SE, _("Variable %s appears twice in variable list."),
+ add->name);
+ }
+ else if ((pv_opts & PV_DUPLICATE) || !TEST_BIT (bits, add->index))
+ {
+ (*v)[(*nv)++] = dict->var[i];
+ if (!(pv_opts & PV_DUPLICATE))
+ SET_BIT (bits, add->index);
+ }
+ }
+
+ if (pv_opts & PV_SINGLE)
+ {
+ if (delayed_fail)
+ goto fail;
+ else
+ return 1;
+ }
+ lex_match (',');
+ }
+ while ((token == T_ID && is_dict_varname (dict, tokid)) || token == T_ALL);
+
+ if (!(pv_opts & PV_DUPLICATE))
+ local_free (bits);
+ if (!nv)
+ goto fail;
+ return 1;
+
+fail:
+ free (*v);
+ *v = NULL;
+ *nv = 0;
+ if (!(pv_opts & PV_DUPLICATE))
+ local_free (bits);
+ return 0;
+}
+
+static int
+extract_num (char *s, char *r, int *n, int *d)
+{
+ char *cp;
+
+ /* Find first digit. */
+ cp = s + strlen (s) - 1;
+ while (isdigit ((unsigned char) *cp) && cp > s)
+ cp--;
+ cp++;
+
+ /* Extract root. */
+ strncpy (r, s, cp - s);
+ r[cp - s] = 0;
+
+ /* Count initial zeros. */
+ *n = *d = 0;
+ while (*cp == '0')
+ {
+ (*d)++;
+ cp++;
+ }
+
+ /* Extract value. */
+ while (isdigit ((unsigned char) *cp))
+ {
+ (*d)++;
+ *n = (*n * 10) + (*cp - '0');
+ cp++;
+ }
+
+ /* Sanity check. */
+ if (*n == 0 && *d == 0)
+ {
+ msg (SE, _("incorrect use of TO convention"));
+ return 0;
+ }
+ return 1;
+}
+
+/* Parses a list of variable names according to the DATA LIST version
+ of the TO convention. */
+int
+parse_DATA_LIST_vars (char ***names, int *nnames, int pv_opts)
+{
+ int n1, n2;
+ int d1, d2;
+ int n;
+ int nvar, mvar;
+ char *name1, *name2;
+ char *root1, *root2;
+ int success = 0;
+
+ if (pv_opts & PV_APPEND)
+ nvar = mvar = *nnames;
+ else
+ {
+ nvar = mvar = 0;
+ *names = NULL;
+ }
+
+ name1 = xmalloc (36);
+ name2 = &name1[1 * 9];
+ root1 = &name1[2 * 9];
+ root2 = &name1[3 * 9];
+ do
+ {
+ if (token != T_ID)
+ {
+ lex_error ("expecting variable name");
+ goto fail;
+ }
+ if (tokid[0] == '#' && (pv_opts & PV_NO_SCRATCH))
+ {
+ msg (SE, _("Scratch variables not allowed here."));
+ goto fail;
+ }
+ strcpy (name1, tokid);
+ lex_get ();
+ if (token == T_TO)
+ {
+ lex_get ();
+ if (token != T_ID)
+ {
+ lex_error ("expecting variable name");
+ goto fail;
+ }
+ strcpy (name2, tokid);
+ lex_get ();
+
+ if (!extract_num (name1, root1, &n1, &d1)
+ || !extract_num (name2, root2, &n2, &d2))
+ goto fail;
+
+ if (strcmp (root1, root2))
+ {
+ msg (SE, _("Prefixes don't match in use of TO convention."));
+ goto fail;
+ }
+ if (n1 > n2)
+ {
+ msg (SE, _("Bad bounds in use of TO convention."));
+ goto fail;
+ }
+ if (d2 > d1)
+ d2 = d1;
+
+ if (mvar < nvar + (n2 - n1 + 1))
+ {
+ mvar += ROUND_UP (n2 - n1 + 1, 16);
+ *names = xrealloc (*names, mvar * sizeof **names);
+ }
+
+ for (n = n1; n <= n2; n++)
+ {
+ (*names)[nvar] = xmalloc (9);
+ sprintf ((*names)[nvar], "%s%0*d", root1, d1, n);
+ nvar++;
+ }
+ }
+ else
+ {
+ if (nvar >= mvar)
+ {
+ mvar += 16;
+ *names = xrealloc (*names, mvar * sizeof **names);
+ }
+ (*names)[nvar++] = xstrdup (name1);
+ }
+
+ lex_match (',');
+
+ if (pv_opts & PV_SINGLE)
+ break;
+ }
+ while (token == T_ID);
+ success = 1;
+
+fail:
+ *nnames = nvar;
+ free (name1);
+ if (!success)
+ {
+ int i;
+ for (i = 0; i < nvar; i++)
+ free ((*names)[i]);
+ free (*names);
+ *names = NULL;
+ *nnames = 0;
+ }
+ return success;
+}
+
+/* Parses a list of variables where some of the variables may be
+ existing and the rest are to be created. Same args as
+ parse_variables(). */
+int
+parse_mixed_vars (char ***names, int *nnames, int pv_opts)
+{
+ int i;
+
+ if (!(pv_opts & PV_APPEND))
+ {
+ *names = NULL;
+ *nnames = 0;
+ }
+ while (token == T_ID || token == T_ALL)
+ {
+ if (token == T_ALL || is_varname (tokid))
+ {
+ struct variable **v;
+ int nv;
+
+ if (!parse_variables (NULL, &v, &nv, PV_NONE))
+ goto fail;
+ *names = xrealloc (*names, (*nnames + nv) * sizeof **names);
+ for (i = 0; i < nv; i++)
+ (*names)[*nnames + i] = xstrdup (v[i]->name);
+ free (v);
+ *nnames += nv;
+ }
+ else if (!parse_DATA_LIST_vars (names, nnames, PV_APPEND))
+ goto fail;
+ }
+ return 1;
+
+fail:
+ for (i = 0; i < *nnames; i++)
+ free ((*names)[*nnames]);
+ free (names);
+ *names = NULL;
+ *nnames = 0;
+ return 0;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "cases.h"
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "misc.h"
+#include "str.h"
+#include "var.h"
+#include "vector.h"
+
+/* Vectors created on VECTOR. */
+struct vector *vec;
+
+/* Number of vectors in vec. */
+int nvec;
+
+int
+cmd_vector (void)
+{
+ /* Just to be different, points to a set of null terminated strings
+ containing the names of the vectors to be created. The list
+ itself is terminated by a empty string. So a list of three
+ elements, A B C, would look like this: "A\0B\0C\0\0". */
+ char *vecnames;
+
+ /* vecnames iterators. */
+ char *cp, *cp2;
+
+ /* Maximum allocated position for vecnames, plus one position. */
+ char *endp = NULL;
+
+ /* Variables on list (long form only). */
+ struct variable **v = NULL;
+ int nv;
+
+ lex_match_id ("VECTOR");
+
+ cp = vecnames = xmalloc (256);
+ endp = &vecnames[256];
+ do
+ {
+ /* Get the name(s) of the new vector(s). */
+ if (!lex_force_id ())
+ return CMD_FAILURE;
+ while (token == T_ID)
+ {
+ if (cp + 16 > endp)
+ {
+ char *old_vecnames = vecnames;
+ vecnames = xrealloc (vecnames, endp - vecnames + 256);
+ cp = (cp - old_vecnames) + vecnames;
+ endp = (endp - old_vecnames) + vecnames + 256;
+ }
+
+ for (cp2 = cp; cp2 < cp; cp2 += strlen (cp))
+ if (!strcmp (cp2, tokid))
+ {
+ msg (SE, _("Vector name %s is given twice."), tokid);
+ goto fail;
+ }
+
+ if (find_vector (tokid))
+ {
+ msg (SE, _("There is already a vector with name %s."), tokid);
+ goto fail;
+ }
+
+ cp = stpcpy (cp, tokid) + 1;
+ lex_get ();
+ lex_match (',');
+ }
+ *cp++ = 0;
+
+ /* Now that we have the names it's time to check for the short
+ or long forms. */
+ if (lex_match ('='))
+ {
+ /* Long form. */
+
+ if (strchr (vecnames, '\0')[1])
+ {
+ /* There's more than one vector name. */
+ msg (SE, _("A slash must be used to separate each vector "
+ "specification when using the long form. Commands "
+ "such as VECTOR A,B=Q1 TO Q20 are not supported."));
+ goto fail;
+ }
+
+ if (!parse_variables (NULL, &v, &nv, PV_SAME_TYPE | PV_DUPLICATE))
+ goto fail;
+
+ vec = xrealloc (vec, sizeof *vec * (nvec + 1));
+ vec[nvec].index = nvec;
+ strcpy (vec[nvec].name, vecnames);
+ vec[nvec].v = v;
+ vec[nvec].nv = nv;
+ nvec++;
+ v = NULL; /* prevent block from being freed on error */
+ }
+ else if (lex_match ('('))
+ {
+ int i;
+
+ /* Maximum number of digits in a number to add to the base
+ vecname. */
+ int ndig;
+
+ /* Name of an individual variable to be created. */
+ char name[9];
+
+ if (!lex_force_int ())
+ return CMD_FAILURE;
+ nv = lex_integer ();
+ lex_get ();
+ if (nv <= 0)
+ {
+ msg (SE, _("Vectors must have at least one element."));
+ goto fail;
+ }
+ if (!lex_force_match (')'))
+ goto fail;
+
+ /* First check that all the generated variable names are 8
+ characters or shorter. */
+ ndig = intlog10 (nv);
+ for (cp = vecnames; *cp;)
+ {
+ int len = strlen (cp);
+ if (len + ndig > 8)
+ {
+ msg (SE, _("%s%d is too long for a variable name."), cp, nv);
+ goto fail;
+ }
+ cp += len + 1;
+ }
+
+ /* Next check that none of the variables exist. */
+ for (cp = vecnames; *cp;)
+ {
+ for (i = 0; i < nv; i++)
+ {
+ sprintf (name, "%s%d", cp, i + 1);
+ if (is_varname (name))
+ {
+ msg (SE, _("There is already a variable named %s."), name);
+ goto fail;
+ }
+ }
+ cp += strlen (cp) + 1;
+ }
+
+ /* Finally create the variables and vectors. */
+ vec = xrealloc (vec, sizeof *vec * (nvec + nv));
+ for (cp = vecnames; *cp;)
+ {
+ vec[nvec].index = nvec;
+ strcpy (vec[nvec].name, cp);
+ vec[nvec].v = xmalloc (sizeof *vec[nvec].v * nv);
+ vec[nvec].nv = nv;
+ for (i = 0; i < nv; i++)
+ {
+ sprintf (name, "%s%d", cp, i + 1);
+ vec[nvec].v[i] = force_create_variable (&default_dict, name,
+ NUMERIC, 0);
+ envector (vec[nvec].v[i]);
+ }
+ nvec++;
+ cp += strlen (cp) + 1;
+ }
+ }
+ else
+ {
+ msg (SE, _("The syntax for this command does not match "
+ "the expected syntax for either the long form "
+ "or the short form of VECTOR."));
+ goto fail;
+ }
+
+ free (vecnames);
+ vecnames = NULL;
+ }
+ while (lex_match ('/'));
+
+ if (token != '.')
+ {
+ lex_error (_("expecting end of command"));
+ goto fail;
+ }
+ return CMD_SUCCESS;
+
+fail:
+ free (vecnames);
+ free (v);
+ return CMD_PART_SUCCESS_MAYBE;
+}
+
+/* Returns a pointer to the vector with name NAME, or NULL on
+ failure. */
+struct vector *
+find_vector (const char *name)
+{
+ int i;
+
+ for (i = 0; i < nvec; i++)
+ if (!strcmp (vec[i].name, name))
+ return &vec[i];
+ return NULL;
+}
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !vector_h
+#define vector_h 1
+
+/* Represents a vector as created by the VECTOR transformation. */
+struct vector
+ {
+ int index; /* Index into vec[]. */
+ char name[9]; /* Name. */
+ struct variable **v; /* Vector of variables. */
+ int nv; /* Number of variables. */
+ };
+
+extern struct vector *vec;
+extern int nvec;
+
+struct vector *find_vector (const char *name);
+
+#endif /* !vector_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !version_h
+#define version_h 1
+
+/* "A.B.C" */
+extern const char bare_version[];
+
+/* "GNU PSPP A.B.C" */
+extern const char version[];
+
+/* "GNU PSPP version A.B (date), Copyright (C) XXXX Free Software
+ Foundation, Inc." */
+extern const char stat_version[];
+
+/* Canonical name of host system type. */
+extern const char host_system[];
+
+/* Canonical name of build system type. */
+extern const char build_system[];
+
+/* Configuration path at build time. */
+extern const char default_config_path[];
+
+/* Include path. */
+extern const char include_path[];
+
+/* Font path. */
+extern const char groff_font_path[];
+
+/* Locale directory. */
+extern const char locale_dir[];
+
+#endif /* !version_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* AIX requires this to be the first thing in the file. */
+#include <config.h>
+#if __GNUC__
+#define alloca __builtin_alloca
+#else
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else
+#ifdef _AIX
+#pragma alloca
+#else
+#ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#endif
+#endif
+#endif
+#endif
+
+#include <assert.h>
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#if HAVE_UNISTD_H
+#include <unistd.h> /* Required by SunOS4. */
+#endif
+#include "alloc.h"
+#include "approx.h"
+#include "do-ifP.h"
+#include "error.h"
+#include "expr.h"
+#include "misc.h"
+#include "random.h"
+#include "som.h"
+#include "str.h"
+#include "tab.h"
+#include "var.h"
+#include "vector.h"
+#include "vfm.h"
+#include "vfmP.h"
+
+/*
+ Virtual File Manager (vfm):
+
+ vfm is used to process data files. It uses the model that data is
+ read from one stream (the data source), then written to another
+ (the data sink). The data source is then deleted and the data sink
+ becomes the data source for the next procedure. */
+
+#undef DEBUGGING
+/*#define DEBUGGING 1 */
+#include "debug-print.h"
+
+/* This is used to read from the active file. */
+struct case_stream *vfm_source;
+
+/* `value' indexes to initialize to particular values for certain cases. */
+struct long_vec reinit_sysmis; /* SYSMIS for every case. */
+struct long_vec reinit_blanks; /* Blanks for every case. */
+struct long_vec init_zero; /* Zero for first case only. */
+struct long_vec init_blanks; /* Blanks for first case only. */
+
+/* This is used to write to the replacement active file. */
+struct case_stream *vfm_sink;
+
+/* Information about the data source. */
+struct stream_info vfm_source_info;
+
+/* Information about the data sink. */
+struct stream_info vfm_sink_info;
+
+/* Filter variable and `value' index. */
+static struct variable *filter_var;
+static int filter_index;
+
+#define FILTERED \
+ (filter_index != -1 \
+ && (temp_case->data[filter_index].f == 0.0 \
+ || temp_case->data[filter_index].f == SYSMIS \
+ || is_num_user_missing (temp_case->data[filter_index].f, \
+ filter_var)))
+
+/* Nonzero if the case needs to have values deleted before being
+ stored, zero otherwise. */
+int compaction_necessary;
+
+/* Number of values after compaction, or the same as
+ vfm_sink_info.nval, if compaction is not necessary. */
+int compaction_nval;
+
+/* Temporary case buffer with enough room for `compaction_nval'
+ `value's. */
+struct ccase *compaction_case;
+
+/* Within a session, when paging is turned on, it is never turned back
+ off. This policy might be too aggressive. */
+static int paging = 0;
+
+/* Time at which vfm was last invoked. */
+time_t last_vfm_invocation;
+
+/* Functions called during procedure processing. */
+static int (*proc_func) (struct ccase *); /* Called for each case. */
+static int (*virt_proc_func) (struct ccase *); /* From SPLIT_FILE_procfunc. */
+static void (*begin_func) (void); /* Called at beginning of a series. */
+static void (*virt_begin_func) (void); /* Called by SPLIT_FILE_procfunc. */
+static void (*end_func) (void); /* Called after end of a series. */
+int (*write_case) (void);
+
+/* Number of cases passed to proc_func(). */
+static int case_count;
+
+/* Lag queue. */
+int n_lag; /* Number of cases to lag. */
+static int lag_count; /* Number of cases in lag_queue so far. */
+static int lag_head; /* Index where next case will be added. */
+static struct ccase **lag_queue; /* Array of n_lag ccase * elements. */
+
+static void open_active_file (void);
+static void close_active_file (void);
+static int SPLIT_FILE_procfunc (struct ccase *);
+static void finish_compaction (void);
+static void lag_case (void);
+static int procedure_write_case (void);
+\f
+/* Public functions. */
+
+/* Reads all the cases from the active file, transforms them by the
+ active set of transformations, calls PROCFUNC with CURCASE set to
+ the case and CASENUM set to the case number, and writes them to a
+ new active file.
+
+ Divides the active file into zero or more series of one or more
+ cases each. BEGINFUNC is called before each series. ENDFUNC is
+ called after each series. */
+void
+procedure (void (*beginfunc) (void),
+ int (*procfunc) (struct ccase *curcase),
+ void (*endfunc) (void))
+{
+ end_func = endfunc;
+ write_case = procedure_write_case;
+
+ if (default_dict.n_splits && procfunc != NULL)
+ {
+ virt_proc_func = procfunc;
+ proc_func = SPLIT_FILE_procfunc;
+
+ virt_begin_func = beginfunc;
+ begin_func = NULL;
+ } else {
+ begin_func = beginfunc;
+ proc_func = procfunc;
+ }
+
+ last_vfm_invocation = time (NULL);
+
+ open_active_file ();
+ vfm_source->read ();
+ close_active_file ();
+}
+\f
+/* Active file processing support. Subtly different semantics from
+ procedure(). */
+
+static int process_active_file_write_case (void);
+
+/* The casefunc might want us to stop calling it. */
+static int not_canceled;
+
+/* Reads all the cases from the active file and passes them one-by-one
+ to CASEFUNC in temp_case. Before any cases are passed, calls
+ BEGINFUNC. After all the cases have been passed, calls ENDFUNC.
+ BEGINFUNC, CASEFUNC, and ENDFUNC can write temp_case to the output
+ file by calling process_active_file_output_case().
+
+ process_active_file() ignores TEMPORARY, SPLIT FILE, and N. */
+void
+process_active_file (void (*beginfunc) (void),
+ int (*casefunc) (struct ccase *curcase),
+ void (*endfunc) (void))
+{
+ proc_func = casefunc;
+ write_case = process_active_file_write_case;
+ not_canceled = 1;
+
+ open_active_file ();
+ beginfunc ();
+
+ /* There doesn't necessarily need to be an active file. */
+ if (vfm_source)
+ vfm_source->read ();
+
+ endfunc ();
+ close_active_file ();
+}
+
+/* Pass the current case to casefunc. */
+static int
+process_active_file_write_case (void)
+{
+ /* Index of current transformation. */
+ int cur_trns;
+
+ for (cur_trns = f_trns ; cur_trns != temp_trns; )
+ {
+ int code;
+
+ code = t_trns[cur_trns]->proc (t_trns[cur_trns], temp_case);
+ switch (code)
+ {
+ case -1:
+ /* Next transformation. */
+ cur_trns++;
+ break;
+ case -2:
+ /* Delete this case. */
+ goto done;
+ default:
+ /* Go to that transformation. */
+ cur_trns = code;
+ break;
+ }
+ }
+
+ if (n_lag)
+ lag_case ();
+
+ /* Call the procedure if FILTER and PROCESS IF don't prohibit it. */
+ if (not_canceled
+ && !FILTERED
+ && (process_if_expr == NULL ||
+ expr_evaluate (process_if_expr, temp_case, NULL) == 1.0))
+ not_canceled = proc_func (temp_case);
+
+ case_count++;
+
+ done:
+ {
+ long *lp;
+
+ /* This case is finished. Initialize the variables for the next case. */
+ for (lp = reinit_sysmis.vec; *lp != -1;)
+ temp_case->data[*lp++].f = SYSMIS;
+ for (lp = reinit_blanks.vec; *lp != -1;)
+ memset (temp_case->data[*lp++].s, ' ', MAX_SHORT_STRING);
+ }
+
+ return 1;
+}
+
+/* Write temp_case to the active file. */
+void
+process_active_file_output_case (void)
+{
+ vfm_sink_info.ncases++;
+ vfm_sink->write ();
+}
+\f
+/* Opening the active file. */
+
+/* It might be usefully noted that the following several functions are
+ given in the order that they are called by open_active_file(). */
+
+/* Prepare to write to the replacement active file. */
+static void
+prepare_for_writing (void)
+{
+ /* FIXME: If ALL the conditions listed below hold true, then the
+ replacement active file is guaranteed to be identical to the
+ original active file:
+
+ 1. TEMPORARY was the first transformation, OR, there were no
+ transformations at all.
+
+ 2. Input is not coming from an input program.
+
+ 3. Compaction is not necessary.
+
+ So, in this case, we shouldn't have to replace the active
+ file--it's just a waste of time and space. */
+
+ vfm_sink_info.ncases = 0;
+ vfm_sink_info.nval = default_dict.nval;
+ vfm_sink_info.case_size = (sizeof (struct ccase)
+ + (default_dict.nval - 1) * sizeof (union value));
+
+ if (vfm_sink == NULL)
+ {
+ if (vfm_sink_info.case_size * vfm_source_info.ncases > MAX_WORKSPACE
+ && !paging)
+ {
+ msg (MW, _("Workspace overflow predicted. Max workspace is "
+ "currently set to %d KB (%d cases at %d bytes each). "
+ "Paging active file to disk."),
+ MAX_WORKSPACE / 1024, MAX_WORKSPACE / vfm_sink_info.case_size,
+ vfm_sink_info.case_size);
+
+ paging = 1;
+ }
+
+ vfm_sink = paging ? &vfm_disk_stream : &vfm_memory_stream;
+ }
+}
+
+/* Arrange for compacting the output cases for storage. */
+static void
+arrange_compaction (void)
+{
+ int count_values = 0;
+
+ {
+ int i;
+
+ /* Count up the number of `value's that will be output. */
+ for (i = 0; i < temp_dict->nvar; i++)
+ if (temp_dict->var[i]->name[0] != '#')
+ {
+ assert (temp_dict->var[i]->nv > 0);
+ count_values += temp_dict->var[i]->nv;
+ }
+ assert (temporary == 2 || count_values <= temp_dict->nval);
+ }
+
+ /* Compaction is only necessary if the number of `value's to output
+ differs from the number already present. */
+ compaction_nval = count_values;
+ compaction_necessary = temporary == 2 || count_values != temp_dict->nval;
+
+ if (vfm_sink->init)
+ vfm_sink->init ();
+}
+
+/* Prepares the temporary case and compaction case. */
+static void
+make_temp_case (void)
+{
+ temp_case = xmalloc (vfm_sink_info.case_size);
+
+ if (compaction_necessary)
+ compaction_case = xmalloc (sizeof (struct ccase)
+ + sizeof (union value) * (compaction_nval - 1));
+
+#if __CHECKER__
+ /* Initialize the unused trailing parts of string variables to avoid
+ spurious warnings from Checker. */
+ {
+ int i;
+
+ for (i = 0; i < default_dict.nvar; i++)
+ {
+ struct variable *v = default_dict.var[i];
+
+ if (v->type == ALPHA && v->width % 8 != 0)
+ memcpy (&temp_case->data[v->fv + v->nv - 1]
+ .s[v->width % 8], _("!ERROR!"), 8 - v->width % 8);
+ }
+ }
+#endif
+}
+
+#if DEBUGGING
+/* Returns the name of the variable that owns the index CCASE_INDEX
+ into ccase. */
+static const char *
+index_to_varname (int ccase_index)
+{
+ int i;
+
+ for (i = 0; i < default_dict.nvar; i++)
+ {
+ variable *v = default_dict.var[i];
+
+ if (ccase_index >= v->fv && ccase_index < v->fv + v->nv)
+ return default_dict.var[i]->name;
+ }
+ return _("<NOVAR>");
+}
+#endif
+
+/* Initializes temp_case from the vectors that say which `value's need
+ to be initialized just once, and which ones need to be
+ re-initialized before every case. */
+static void
+vector_initialization (void)
+{
+ int i;
+ long *lp;
+
+ /* Just once. */
+ for (i = 0; i < init_zero.n; i++)
+ temp_case->data[init_zero.vec[i]].f = 0.0;
+ for (i = 0; i < init_blanks.n; i++)
+ memset (temp_case->data[init_blanks.vec[i]].s, ' ', MAX_SHORT_STRING);
+
+ /* These vectors need to be repeatedly accessed, so we add a
+ sentinel to (hopefully) improve speed. */
+ vec_insert (&reinit_sysmis, -1);
+ vec_insert (&reinit_blanks, -1);
+
+ for (lp = reinit_sysmis.vec; *lp != -1;)
+ temp_case->data[*lp++].f = SYSMIS;
+ for (lp = reinit_blanks.vec; *lp != -1;)
+ memset (temp_case->data[*lp++].s, ' ', MAX_SHORT_STRING);
+
+#if DEBUGGING
+ printf ("vfm: init_zero=");
+ for (i = 0; i < init_zero.n; i++)
+ printf ("%s%s", i ? "," : "", index_to_varname (init_zero.vec[i]));
+ printf (" init_blanks=");
+ for (i = 0; i < init_blanks.n; i++)
+ printf ("%s%s", i ? "," : "", index_to_varname (init_blanks.vec[i]));
+ printf (" reinit_sysmis=");
+ for (lp = reinit_sysmis.vec; *lp != -1; lp++)
+ printf ("%s%s", lp != reinit_sysmis.vec ? "," : "",
+ index_to_varname (*lp));
+ printf (" reinit_blanks=");
+ for (lp = reinit_blanks.vec; *lp != -1; lp++)
+ printf ("%s%s", lp != reinit_blanks.vec ? "," : "",
+ index_to_varname (*lp));
+ printf ("\n");
+#endif
+}
+
+/* Sets filter_index to an appropriate value. */
+static void
+setup_filter (void)
+{
+ filter_index = -1;
+
+ if (default_dict.filter_var[0])
+ {
+ struct variable *fv = find_variable (default_dict.filter_var);
+
+ if (fv == NULL || fv->type == ALPHA)
+ default_dict.filter_var[0] = 0;
+ else
+ {
+ filter_index = fv->index;
+ filter_var = fv;
+ }
+ }
+}
+
+/* Sets all the lag-related variables based on value of n_lag. */
+static void
+setup_lag (void)
+{
+ int i;
+
+ if (n_lag == 0)
+ return;
+
+ lag_count = 0;
+ lag_head = 0;
+ lag_queue = xmalloc (n_lag * sizeof *lag_queue);
+ for (i = 0; i < n_lag; i++)
+ lag_queue[i] = xmalloc (temp_dict->nval * sizeof **lag_queue);
+}
+
+/* There is a lot of potential confusion in the vfm and related
+ routines over the number of `value's at each stage of the process.
+ Here is each nval count, with explanation, as set up by
+ open_active_file():
+
+ vfm_source_info.nval: Number of `value's in the cases returned by
+ the source stream. This value turns out not to be very useful, but
+ we maintain it anyway.
+
+ vfm_sink_info.nval: Number of `value's in the cases after all
+ transformations have been performed. Never less than
+ vfm_source_info.nval.
+
+ temp_dict->nval: Number of `value's in the cases after the
+ transformations leading up to TEMPORARY have been performed. If
+ TEMPORARY was not specified, this is equal to vfm_sink_info.nval.
+ Never less than vfm_sink_info.nval.
+
+ compaction_nval: Number of `value's in the cases after the
+ transformations leading up to TEMPORARY have been performed and the
+ case has been compacted by compact_case(), if compaction is
+ necessary. This the number of `value's in the cases saved by the
+ sink stream. (However, note that the cases passed to the sink
+ stream have not yet been compacted. It is the responsibility of
+ the data sink to call compact_case().) This may be less than,
+ greater than, or equal to vfm_source_info.nval. `compaction'
+ becomes the new value of default_dict.nval after the procedure is
+ completed.
+
+ default_dict.nval: This is often an alias for temp_dict->nval. As
+ such it can really have no separate existence until the procedure
+ is complete. For this reason it should *not* be referenced inside
+ the execution of a procedure. */
+/* Makes all preparations for reading from the data source and writing
+ to the data sink. */
+static void
+open_active_file (void)
+{
+ /* Sometimes we want to refer to the dictionary that applies to the
+ data actually written to the sink. This is either temp_dict or
+ default_dict. However, if TEMPORARY is not on, then temp_dict
+ does not apply. So, we can set temp_dict to default_dict in this
+ case. */
+ if (!temporary)
+ {
+ temp_trns = n_trns;
+ temp_dict = &default_dict;
+ }
+
+ /* No cases passed to the procedure yet. */
+ case_count = 0;
+
+ /* The rest. */
+ prepare_for_writing ();
+ arrange_compaction ();
+ make_temp_case ();
+ vector_initialization ();
+ setup_randomize ();
+ discard_ctl_stack ();
+ setup_filter ();
+ setup_lag ();
+
+ /* Debug output. */
+ debug_printf (("vfm: reading from %s source, writing to %s sink.\n",
+ vfm_source->name, vfm_sink->name));
+ debug_printf (("vfm: vfm_source_info.nval=%d, vfm_sink_info.nval=%d, "
+ "temp_dict->nval=%d, compaction_nval=%d, "
+ "default_dict.nval=%d\n",
+ vfm_source_info.nval, vfm_sink_info.nval, temp_dict->nval,
+ compaction_nval, default_dict.nval));
+}
+\f
+/* Closes the active file. */
+static void
+close_active_file (void)
+{
+ /* Close the current case group. */
+ if (case_count && end_func != NULL)
+ end_func ();
+
+ /* Stop lagging (catch up?). */
+ if (n_lag)
+ {
+ int i;
+
+ for (i = 0; i < n_lag; i++)
+ free (lag_queue[i]);
+ free (lag_queue);
+ n_lag = 0;
+ }
+
+ /* Assume the dictionary from right before TEMPORARY, if any. Turn
+ off TEMPORARY. */
+ if (temporary)
+ {
+ restore_dictionary (temp_dict);
+ temp_dict = NULL;
+ }
+
+ /* The default dictionary assumes the compacted data size. */
+ default_dict.nval = compaction_nval;
+
+ /* Old data sink --> New data source. */
+ if (vfm_source && vfm_source->destroy_source)
+ vfm_source->destroy_source ();
+
+ vfm_source = vfm_sink;
+ vfm_source_info.ncases = vfm_sink_info.ncases;
+ vfm_source_info.nval = compaction_nval;
+ vfm_source_info.case_size = (sizeof (struct ccase)
+ + (compaction_nval - 1) * sizeof (union value));
+ if (vfm_source->mode)
+ vfm_source->mode ();
+
+ /* Old data sink is gone now. */
+ vfm_sink = NULL;
+
+ /* Finish compaction. */
+ if (compaction_necessary)
+ finish_compaction ();
+ cancel_temporary ();
+
+ /* Free temporary cases. */
+ free (temp_case);
+ temp_case = NULL;
+
+ free (compaction_case);
+ compaction_case = NULL;
+
+ /* Cancel PROCESS IF. */
+ expr_free (process_if_expr);
+ process_if_expr = NULL;
+
+ /* Cancel FILTER if temporary. */
+ if (filter_index != -1 && !FILTER_before_TEMPORARY)
+ default_dict.filter_var[0] = 0;
+
+ /* Cancel transformations. */
+ cancel_transformations ();
+
+ /* Clear value-initialization vectors. */
+ vec_clear (&init_zero);
+ vec_clear (&init_blanks);
+ vec_clear (&reinit_sysmis);
+ vec_clear (&reinit_blanks);
+
+ /* Turn off case limiter. */
+ default_dict.N = 0;
+
+ /* Clear VECTOR vectors. */
+ {
+ int i;
+
+ for (i = 0; i < nvec; i++)
+ free (vec[i].v);
+ free (vec);
+ vec = NULL;
+ nvec = 0;
+ }
+
+ debug_printf (("vfm: procedure complete\n\n"));
+}
+\f
+/* Disk case stream. */
+
+/* Associated files. */
+FILE *disk_source_file;
+FILE *disk_sink_file;
+
+/* Initializes the disk sink. */
+static void
+disk_stream_init (void)
+{
+ disk_sink_file = tmpfile ();
+ if (!disk_sink_file)
+ {
+ msg (ME, _("An error occurred attempting to create a temporary "
+ "file for use as the active file: %s."),
+ strerror (errno));
+ err_failure ();
+ }
+}
+
+/* Reads all cases from the disk source and passes them one by one to
+ write_case(). */
+static void
+disk_stream_read (void)
+{
+ int i;
+
+ for (i = 0; i < vfm_source_info.ncases; i++)
+ {
+ if (!fread (temp_case, vfm_source_info.case_size, 1, disk_source_file))
+ {
+ msg (ME, _("An error occurred while attempting to read from "
+ "a temporary file created for the active file: %s."),
+ strerror (errno));
+ err_failure ();
+ return;
+ }
+
+ if (!write_case ())
+ return;
+ }
+}
+
+/* Writes temp_case to the disk sink. */
+static void
+disk_stream_write (void)
+{
+ union value *src_case;
+
+ if (compaction_necessary)
+ {
+ compact_case (compaction_case, temp_case);
+ src_case = (union value *) compaction_case;
+ }
+ else src_case = (union value *) temp_case;
+
+ if (fwrite (src_case, sizeof *src_case * compaction_nval, 1,
+ disk_sink_file) != 1)
+ {
+ msg (ME, _("An error occurred while attempting to write to a "
+ "temporary file used as the active file: %s."),
+ strerror (errno));
+ err_failure ();
+ }
+}
+
+/* Switches the stream from a sink to a source. */
+static void
+disk_stream_mode (void)
+{
+ /* Rewind the sink. */
+ if (fseek (disk_sink_file, 0, SEEK_SET) != 0)
+ {
+ msg (ME, _("An error occurred while attempting to rewind a "
+ "temporary file used as the active file: %s."),
+ strerror (errno));
+ err_failure ();
+ }
+
+ /* Sink --> source variables. */
+ disk_source_file = disk_sink_file;
+}
+
+/* Destroys the source's internal data. */
+static void
+disk_stream_destroy_source (void)
+{
+ if (disk_source_file)
+ {
+ fclose (disk_source_file);
+ disk_source_file = NULL;
+ }
+}
+
+/* Destroys the sink's internal data. */
+static void
+disk_stream_destroy_sink (void)
+{
+ if (disk_sink_file)
+ {
+ fclose (disk_sink_file);
+ disk_sink_file = NULL;
+ }
+}
+
+/* Disk stream. */
+struct case_stream vfm_disk_stream =
+ {
+ disk_stream_init,
+ disk_stream_read,
+ disk_stream_write,
+ disk_stream_mode,
+ disk_stream_destroy_source,
+ disk_stream_destroy_sink,
+ "disk",
+ };
+\f
+/* Memory case stream. */
+
+/* List of cases stored in the stream. */
+struct case_list *memory_source_cases;
+struct case_list *memory_sink_cases;
+
+/* Current case. */
+struct case_list *memory_sink_iter;
+
+/* Maximum number of cases. */
+int memory_sink_max_cases;
+
+/* Initializes the memory stream variables for writing. */
+static void
+memory_stream_init (void)
+{
+ memory_sink_cases = NULL;
+ memory_sink_iter = NULL;
+
+ assert (compaction_nval);
+ memory_sink_max_cases = MAX_WORKSPACE / (sizeof (union value) * compaction_nval);
+}
+
+/* Reads the case stream from memory and passes it to write_case(). */
+static void
+memory_stream_read (void)
+{
+ while (memory_source_cases != NULL)
+ {
+ memcpy (temp_case, &memory_source_cases->c, vfm_source_info.case_size);
+
+ {
+ struct case_list *current = memory_source_cases;
+ memory_source_cases = memory_source_cases->next;
+ free (current);
+ }
+
+ if (!write_case ())
+ return;
+ }
+}
+
+/* Writes temp_case to the memory stream. */
+static void
+memory_stream_write (void)
+{
+ struct case_list *new_case = malloc (sizeof (struct case_list)
+ + ((compaction_nval - 1)
+ * sizeof (union value)));
+
+ /* If we've got memory to spare then add it to the linked list. */
+ if (vfm_sink_info.ncases <= memory_sink_max_cases && new_case != NULL)
+ {
+ if (compaction_necessary)
+ compact_case (&new_case->c, temp_case);
+ else
+ memcpy (&new_case->c, temp_case, sizeof (union value) * compaction_nval);
+
+ /* Append case to linked list. */
+ if (memory_sink_cases)
+ memory_sink_iter = memory_sink_iter->next = new_case;
+ else
+ memory_sink_iter = memory_sink_cases = new_case;
+ }
+ else
+ {
+ /* Out of memory. Write the active file to disk. */
+ struct case_list *cur, *next;
+
+ /* Notify the user. */
+ if (!new_case)
+ msg (MW, _("Virtual memory exhausted. Paging active file "
+ "to disk."));
+ else
+ msg (MW, _("Workspace limit of %d KB (%d cases at %d bytes each) "
+ "overflowed. Paging active file to disk."),
+ MAX_WORKSPACE / 1024, memory_sink_max_cases,
+ compaction_nval * sizeof (union value));
+
+ free (new_case);
+
+ /* Switch to a disk sink. */
+ vfm_sink = &vfm_disk_stream;
+ vfm_sink->init ();
+ paging = 1;
+
+ /* Terminate the list. */
+ if (memory_sink_iter)
+ memory_sink_iter->next = NULL;
+
+ /* Write the cases to disk and destroy them. We can't call
+ vfm->sink->write() because of compaction. */
+ for (cur = memory_sink_cases; cur; cur = next)
+ {
+ next = cur->next;
+ if (fwrite (cur->c.data, sizeof (union value) * compaction_nval, 1,
+ disk_sink_file) != 1)
+ {
+ msg (ME, _("An error occurred while attempting to "
+ "write to a temporary file created as the "
+ "active file, while paging to disk: %s."),
+ strerror (errno));
+ err_failure ();
+ }
+ free (cur);
+ }
+
+ /* Write the current case to disk. */
+ vfm_sink->write ();
+ }
+}
+
+/* If the data is stored in memory, causes it to be written to disk.
+ To be called only *between* procedure()s, not within them. */
+void
+page_to_disk (void)
+{
+ if (vfm_source == &vfm_memory_stream)
+ {
+ /* Switch to a disk sink. */
+ vfm_sink = &vfm_disk_stream;
+ vfm_sink->init ();
+ paging = 1;
+
+ /* Write the cases to disk and destroy them. We can't call
+ vfm->sink->write() because of compaction. */
+ {
+ struct case_list *cur, *next;
+
+ for (cur = memory_source_cases; cur; cur = next)
+ {
+ next = cur->next;
+ if (fwrite (cur->c.data, sizeof *cur->c.data * compaction_nval, 1,
+ disk_sink_file) != 1)
+ {
+ msg (ME, _("An error occurred while attempting to "
+ "write to a temporary file created as the "
+ "active file, while paging to disk: %s."),
+ strerror (errno));
+ err_failure ();
+ }
+ free (cur);
+ }
+ }
+
+ vfm_source = &vfm_disk_stream;
+ vfm_source->mode ();
+
+ vfm_sink = NULL;
+ }
+}
+
+/* Switch the memory stream from sink to source mode. */
+static void
+memory_stream_mode (void)
+{
+ /* Terminate the list. */
+ if (memory_sink_iter)
+ memory_sink_iter->next = NULL;
+
+ /* Sink --> source variables. */
+ memory_source_cases = memory_sink_cases;
+ memory_sink_cases = NULL;
+}
+
+/* Destroy all memory source data. */
+static void
+memory_stream_destroy_source (void)
+{
+ struct case_list *cur, *next;
+
+ for (cur = memory_source_cases; cur; cur = next)
+ {
+ next = cur->next;
+ free (cur);
+ }
+ memory_source_cases = NULL;
+}
+
+/* Destroy all memory sink data. */
+static void
+memory_stream_destroy_sink (void)
+{
+ struct case_list *cur, *next;
+
+ for (cur = memory_sink_cases; cur; cur = next)
+ {
+ next = cur->next;
+ free (cur);
+ }
+ memory_sink_cases = NULL;
+}
+
+/* Memory stream. */
+struct case_stream vfm_memory_stream =
+ {
+ memory_stream_init,
+ memory_stream_read,
+ memory_stream_write,
+ memory_stream_mode,
+ memory_stream_destroy_source,
+ memory_stream_destroy_sink,
+ "memory",
+ };
+\f
+#undef DEBUGGING
+#include "debug-print.h"
+
+/* Add temp_case to the lag queue. */
+static void
+lag_case (void)
+{
+ if (lag_count < n_lag)
+ lag_count++;
+ memcpy (lag_queue[lag_head], temp_case, sizeof (union value) * temp_dict->nval);
+ if (++lag_head >= n_lag)
+ lag_head = 0;
+}
+
+/* Returns a pointer to the lagged case from N_BEFORE cases before the
+ current one, or NULL if there haven't been that many cases yet. */
+struct ccase *
+lagged_case (int n_before)
+{
+ assert (n_before <= n_lag);
+ if (n_before > lag_count)
+ return NULL;
+
+ {
+ int index = lag_head - n_before;
+ if (index < 0)
+ index += n_lag;
+ return lag_queue[index];
+ }
+}
+
+/* Transforms temp_case and writes it to the replacement active file
+ if advisable. Returns nonzero if more cases can be accepted, zero
+ otherwise. Do not call this function again after it has returned
+ zero once. */
+int
+procedure_write_case (void)
+{
+ /* Index of current transformation. */
+ int cur_trns;
+
+ /* Return value: whether it's reasonable to write any more cases. */
+ int more_cases = 1;
+
+ debug_printf ((_("transform: ")));
+
+ cur_trns = f_trns;
+ for (;;)
+ {
+ /* Output the case if this is temp_trns. */
+ if (cur_trns == temp_trns)
+ {
+ debug_printf (("REC"));
+
+ if (n_lag)
+ lag_case ();
+
+ vfm_sink_info.ncases++;
+ vfm_sink->write ();
+
+ if (default_dict.N)
+ more_cases = vfm_sink_info.ncases < default_dict.N;
+ }
+
+ /* Are we done? */
+ if (cur_trns >= n_trns)
+ break;
+
+ debug_printf (("$%d", cur_trns));
+
+ /* Decide which transformation should come next. */
+ {
+ int code;
+
+ code = t_trns[cur_trns]->proc (t_trns[cur_trns], temp_case);
+ switch (code)
+ {
+ case -1:
+ /* Next transformation. */
+ cur_trns++;
+ break;
+ case -2:
+ /* Delete this case. */
+ goto done;
+ default:
+ /* Go to that transformation. */
+ cur_trns = code;
+ break;
+ }
+ }
+ }
+
+ /* Call the beginning of group function. */
+ if (!case_count && begin_func != NULL)
+ begin_func ();
+
+ /* Call the procedure if there is one and FILTER and PROCESS IF
+ don't prohibit it. */
+ if (proc_func != NULL
+ && !FILTERED
+ && (process_if_expr == NULL ||
+ expr_evaluate (process_if_expr, temp_case, NULL) == 1.0))
+ proc_func (temp_case);
+
+ case_count++;
+
+done:
+ debug_putc ('\n', stdout);
+
+ {
+ long *lp;
+
+ /* This case is finished. Initialize the variables for the next case. */
+ for (lp = reinit_sysmis.vec; *lp != -1;)
+ temp_case->data[*lp++].f = SYSMIS;
+ for (lp = reinit_blanks.vec; *lp != -1;)
+ memset (temp_case->data[*lp++].s, ' ', MAX_SHORT_STRING);
+ }
+
+ /* Return previously determined value. */
+ return more_cases;
+}
+
+/* Appends TRNS to t_trns[], the list of all transformations to be
+ performed on data as it is read from the active file. */
+void
+add_transformation (struct trns_header * trns)
+{
+ if (n_trns >= m_trns)
+ {
+ m_trns += 16;
+ t_trns = xrealloc (t_trns, sizeof *t_trns * m_trns);
+ }
+ t_trns[n_trns] = trns;
+ trns->index = n_trns++;
+}
+
+/* Cancels all active transformations, including any transformations
+ created by the input program. */
+void
+cancel_transformations (void)
+{
+ int i;
+ for (i = 0; i < n_trns; i++)
+ {
+ if (t_trns[i]->free)
+ t_trns[i]->free (t_trns[i]);
+ free (t_trns[i]);
+ }
+ n_trns = f_trns = 0;
+ if (m_trns > 32)
+ {
+ free (t_trns);
+ m_trns = 0;
+ }
+}
+
+/* Dumps out the values of all the split variables for the case C. */
+static void
+dump_splits (struct ccase *c)
+{
+ struct variable **iter;
+ struct tab_table *t;
+ int i;
+
+ t = tab_create (3, default_dict.n_splits + 1, 0);
+ tab_dim (t, tab_natural_dimensions);
+ tab_vline (t, TAL_1 | TAL_SPACING, 1, 0, default_dict.n_splits);
+ tab_vline (t, TAL_1 | TAL_SPACING, 2, 0, default_dict.n_splits);
+ tab_text (t, 0, 0, TAB_NONE, _("Variable"));
+ tab_text (t, 1, 0, TAB_LEFT, _("Value"));
+ tab_text (t, 2, 0, TAB_LEFT, _("Label"));
+ for (iter = default_dict.splits, i = 0; *iter; iter++, i++)
+ {
+ struct variable *v = *iter;
+ char temp_buf[80];
+ char *val_lab;
+
+ assert (v->type == NUMERIC || v->type == ALPHA);
+ tab_text (t, 0, i + 1, TAB_LEFT | TAT_PRINTF, "%s", v->name);
+
+ {
+ union value val = c->data[v->fv];
+ if (v->type == ALPHA)
+ val.c = c->data[v->fv].s;
+ data_out (temp_buf, &v->print, &val);
+ }
+
+ temp_buf[v->print.w] = 0;
+ tab_text (t, 1, i + 1, TAT_PRINTF, "%.*s", v->print.w, temp_buf);
+
+ val_lab = get_val_lab (v, c->data[v->fv], 0);
+ if (val_lab)
+ tab_text (t, 2, i + 1, TAB_LEFT, val_lab);
+ }
+ tab_flags (t, SOMF_NO_TITLE);
+ tab_submit (t);
+}
+
+/* This procfunc is substituted for the user-supplied procfunc when
+ SPLIT FILE is active. This function forms a wrapper around that
+ procfunc by dividing the input into series. */
+static int
+SPLIT_FILE_procfunc (struct ccase *c)
+{
+ static struct ccase *prev_case;
+ struct variable **iter;
+
+ /* The first case always begins a new series. We also need to
+ preserve the values of the case for later comparison. */
+ if (case_count == 0)
+ {
+ if (prev_case)
+ free (prev_case);
+ prev_case = xmalloc (vfm_sink_info.case_size);
+ memcpy (prev_case, c, vfm_sink_info.case_size);
+
+ dump_splits (c);
+ if (virt_begin_func != NULL)
+ virt_begin_func ();
+
+ return virt_proc_func (c);
+ }
+
+ /* Compare the value of each SPLIT FILE variable to the values on
+ the previous case. */
+ for (iter = default_dict.splits; *iter; iter++)
+ {
+ struct variable *v = *iter;
+
+ switch (v->type)
+ {
+ case NUMERIC:
+ if (approx_ne (c->data[v->fv].f, prev_case->data[v->fv].f))
+ goto not_equal;
+ break;
+ case ALPHA:
+ if (memcmp (c->data[v->fv].s, prev_case->data[v->fv].s, v->width))
+ goto not_equal;
+ break;
+ default:
+ assert (0);
+ }
+ }
+ return virt_proc_func (c);
+
+not_equal:
+ /* The values of the SPLIT FILE variable are different from the
+ values on the previous case. That means that it's time to begin
+ a new series. */
+ if (end_func != NULL)
+ end_func ();
+ dump_splits (c);
+ if (virt_begin_func != NULL)
+ virt_begin_func ();
+ memcpy (prev_case, c, vfm_sink_info.case_size);
+ return virt_proc_func (c);
+}
+\f
+/* Case compaction. */
+
+/* Copies case SRC to case DEST, compacting it in the process. */
+void
+compact_case (struct ccase *dest, const struct ccase *src)
+{
+ int i;
+ int nval = 0;
+
+ assert (compaction_necessary);
+
+ if (temporary == 2)
+ {
+ if (dest != compaction_case)
+ memcpy (dest, compaction_case, sizeof (union value) * compaction_nval);
+ return;
+ }
+
+ /* Copy all the variables except the scratch variables from SRC to
+ DEST. */
+ for (i = 0; i < default_dict.nvar; i++)
+ {
+ struct variable *v = default_dict.var[i];
+
+ if (v->name[0] == '#')
+ continue;
+
+ if (v->type == NUMERIC)
+ dest->data[nval++] = src->data[v->fv];
+ else
+ {
+ int w = DIV_RND_UP (v->width, sizeof (union value));
+
+ memcpy (&dest->data[nval], &src->data[v->fv], w * sizeof (union value));
+ nval += w;
+ }
+ }
+}
+
+/* Reassigns `fv' for each variable. Deletes scratch variables. */
+static void
+finish_compaction (void)
+{
+ int copy_index = 0;
+ int nval = 0;
+ int i;
+
+ for (i = 0; i < default_dict.nvar; i++)
+ {
+ struct variable *v = default_dict.var[i];
+
+ if (v->name[0] == '#')
+ {
+ clear_variable (&default_dict, v);
+ free (v);
+ continue;
+ }
+
+ v->fv = nval;
+ if (v->type == NUMERIC)
+ nval++;
+ else
+ nval += DIV_RND_UP (v->width, sizeof (union value));
+
+ default_dict.var[copy_index++] = v;
+ }
+ if (copy_index != default_dict.nvar)
+ {
+ default_dict.var = xrealloc (default_dict.var,
+ sizeof *default_dict.var * copy_index);
+ default_dict.nvar = copy_index;
+ }
+}
+
+
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !vfm_h
+#define vfm_h 1
+
+#include "cases.h"
+#include <time.h>
+
+/* This is the time at which vfm was last invoked. */
+extern time_t last_vfm_invocation;
+
+/* This is the case that is to be filled in by input programs. */
+extern struct ccase *temp_case;
+
+/* `value' indexes to initialize to particular values for certain cases. */
+extern struct long_vec reinit_sysmis; /* SYSMIS for every case. */
+extern struct long_vec reinit_blanks; /* Blanks for every case. */
+extern struct long_vec init_zero; /* Zero for first case only. */
+extern struct long_vec init_blanks; /* Blanks for first case only. */
+
+/* A case stream: either a source or a sink, depending on context. */
+struct case_stream
+ {
+ /* Initializes sink. */
+ void (*init) (void);
+
+ /* Reads all the cases and passes them to WRITE_CASE. */
+ void (*read) (void);
+
+ /* Writes a single case, temp_case. */
+ void (*write) (void);
+
+ /* Switches mode from sink to source. */
+ void (*mode) (void);
+
+ /* Discards source's internal data. */
+ void (*destroy_source) (void);
+
+ /* Discards sink's internal data. */
+ void (*destroy_sink) (void);
+
+ /* Identifying name for the stream. */
+ const char *name;
+ };
+
+/* This is used to read from the active file. */
+extern struct case_stream *vfm_source;
+
+/* This is used to write to the replacement active file. */
+extern struct case_stream *vfm_sink;
+
+/* General data streams. */
+extern struct case_stream vfm_memory_stream;
+extern struct case_stream vfm_disk_stream;
+extern struct case_stream sort_stream;
+extern struct case_stream flip_stream;
+
+/* Streams that are only sources. */
+extern struct case_stream data_list_source;
+extern struct case_stream input_program_source;
+extern struct case_stream file_type_source;
+extern struct case_stream get_source;
+extern struct case_stream import_source;
+extern struct case_stream matrix_data_source;
+
+/* Number of cases to lag. */
+extern int n_lag;
+
+extern int (*write_case) (void);
+
+void procedure (void (*beginfunc) (void),
+ int (*procfunc) (struct ccase *curcase),
+ void (*endfunc) (void));
+struct ccase *lagged_case (int n_before);
+void compact_case (struct ccase *dest, const struct ccase *src);
+void page_to_disk (void);
+
+void process_active_file (void (*beginfunc) (void),
+ int (*casefunc) (struct ccase *curcase),
+ void (*endfunc) (void));
+void process_active_file_output_case (void);
+
+#endif /* !vfm_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#if !vfmP_h
+#define vfmP_h 1
+
+#include "var.h"
+
+/* Linked list of cases. */
+struct case_list
+ {
+ struct case_list *next;
+ struct ccase c;
+ };
+
+/* Describes a data stream, either a source or a sink. */
+struct stream_info
+ {
+ int case_size; /* Size of one case in bytes. */
+ int ncases; /* Number of cases. */
+ int nval; /* Number of `value' elements per case. */
+ };
+
+/* Information about the data source. */
+extern struct stream_info vfm_source_info;
+
+/* Information about the data sink. */
+extern struct stream_info vfm_sink_info;
+
+/* Memory case stream. */
+
+/* List of cases stored in the stream. */
+extern struct case_list *memory_source_cases;
+extern struct case_list *memory_sink_cases;
+
+/* Current case. */
+extern struct case_list *memory_sink_iter;
+
+/* Maximum number of cases. */
+extern int memory_sink_max_cases;
+
+/* Nonzero if the case needs to have values deleted before being
+ stored, zero otherwise. */
+extern int compaction_necessary;
+
+/* Number of values after compaction, or the same as
+ vfm_sink_info.nval, if compaction is not necessary. */
+extern int compaction_nval;
+
+/* Temporary case buffer with enough room for `compaction_nval'
+ `value's. */
+extern struct ccase *compaction_case;
+
+void compact_case (struct ccase *dest, const struct ccase *src);
+
+#endif /* !vfmP_h */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <config.h>
+#include <assert.h>
+#include <stdio.h>
+#include "command.h"
+#include "error.h"
+#include "lexer.h"
+#include "str.h"
+#include "var.h"
+
+/* Notes:
+
+ If the weighting variable is deleted somehow (for instance by
+ end-of-scope of TEMPORARY), weighting must be canceled.
+
+ Scratch vars may not be used for weighting. */
+
+/* WEIGHT transformation. */
+struct weight_trns
+ {
+ struct trns_header h;
+ int src; /* `value' index of weighting variable. */
+ int dest; /* `value' index of $WEIGHT. */
+ };
+
+int
+cmd_weight (void)
+{
+ lex_match_id ("WEIGHT");
+
+ if (lex_match_id ("OFF"))
+ default_dict.weight_var[0] = 0;
+ else
+ {
+ struct variable *v;
+
+ lex_match (T_BY);
+ v = parse_variable ();
+ if (!v)
+ return CMD_FAILURE;
+ if (v->type == ALPHA)
+ {
+ msg (SE, _("The weighting variable must be numeric."));
+ return CMD_FAILURE;
+ }
+ if (v->name[0] == '#')
+ {
+ msg (SE, _("The weighting variable may not be scratch."));
+ return CMD_FAILURE;
+ }
+
+ strcpy (default_dict.weight_var, v->name);
+ }
+
+ return lex_end_of_command ();
+}
+
+#if 0 /* FIXME: dead code. */
+static int
+weight_trns_proc (any_trns * pt, ccase * c)
+{
+ weight_trns *t = (weight_trns *) pt;
+
+ c->data[t->dest].f = c->data[t->src].f;
+ return -1;
+}
+#endif
+\f
+/* Global functions. */
+
+/* Sets the weight_index member of dictionary D to an appropriate
+ value for the value of weight_var, and returns the weighting
+ variable if any or NULL if none. */
+struct variable *
+update_weighting (struct dictionary * d)
+{
+ if (d->weight_var[0])
+ {
+ struct variable *v = find_dict_variable (d, d->weight_var);
+ if (v && v->type == NUMERIC)
+ {
+ d->weight_index = v->fv;
+ return v;
+ }
+ else
+ {
+#if GLOBAL_DEBUGGING
+ printf (_("bad weighting variable, canceling\n"));
+#endif
+ d->weight_var[0] = 0;
+ }
+ }
+
+ d->weight_index = -1;
+ return NULL;
+}
+
+/* Turns off case weighting for dictionary D. */
+void
+stop_weighting (struct dictionary * d)
+{
+ d->weight_var[0] = 0;
+}
--- /dev/null
+Sun Aug 9 11:17:39 1998 Ben Pfaff <blp@gnu.org>
+
+ * README: New file.
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+-*- text -*-
+
+The files in this directory were at one time useful for compiling PSPP
+under Borland C++ 5.0 for Windows. They may or may not be useful any
+longer. They are provided without any assurance that they are up to
+date. Use at your own risk.
+
+-blp
--- /dev/null
+Sun Aug 9 11:15:17 1998 Ben Pfaff <blp@gnu.org>
+
+ * pspp.iwz.in: Update name of sm-gnu-head.bmp.
+
+ * sm-gnu-head.bmp: Renamed sm-gnu-hd.bmp.
+
+Fri Dec 5 23:01:44 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.ico: Renamed pspp.ico.
+
+ * fiasco.ide: Renamed pspp.ide.
+
+ * fiasco.iwz.in: Renamed pspp.iwz.in.
+
+Wed Aug 20 12:52:43 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.iwz.in: Updated.
+
+Sat Aug 16 11:02:38 1997 Ben Pfaff <blp@gnu.org>
+
+ * mk-bc5-dist: No longer run from toplevel Makefile.
+
+ * unix2dos.pl: Moved here from the top level.
+
+ * pref.h: Removed.
+
+Thu Aug 14 22:19:46 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.iwz.in: Revised.
+
+ * pref.h: Updated from pref.h.orig.
+
+ * fiasco.ide: Updated.
+
+Sun Aug 3 11:50:23 1997 Ben Pfaff <blp@gnu.org>
+
+ * fiasco.ico: New file, icon for Fiasco.
+
+ * fiasco.iwz.in: New file, InstallShield template for Fiasco.
+
+ * setup1.bmp: New file, Bitmap displayed during installation.
+
+ * sm-gnu-head.bmp: New file, small GNU head from
+ www.gnu.org converted to BMP format.
+
+Thu Jul 17 02:20:09 1997 Ben Pfaff <blp@gnu.org>
+
+ * New directory for Windows support via Borland C++ 5.0.
+
+ * bc5-con32s.c: Combines _read.c and _write from the old
+ sysdeps/borlandc4.0 directory.
+
+ * config.h, libintl.h, pref.h, version.c: Standard files adapted
+ to Borland C++ 5.0.
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+/* con32s - emulates console under Windows.
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* This replaces a few of the Borland C++ library functions. It does
+ not use any of the runtime library header files, so you do not need
+ the runtime library source in order to compile it. */
+
+#include <io.h>
+#include <windef.h>
+#include <wincon.h>
+
+/* 1=It is necessary to emulate the console window. */
+int _emu_console;
+
+/* Exported by con32s.c. */
+extern int _blp_console_read (void *buf, unsigned len);
+
+/* Exported by Borland runtime library. */
+extern long _handles[];
+extern int __IOerror (int);
+extern int __NTerror (void);
+
+/* Replaces Borland library function. */
+int
+_rtl_read (int fd, void *buf, unsigned len)
+{
+ DWORD nread;
+
+ if ((unsigned) fd >= _nfile)
+ return __IOerror (ERROR_INVALID_HANDLE);
+
+ /* Redirect stdin to the faked console window. */
+ if (_emu_console && fd < 3)
+ return _blp_console_read (buf, len);
+
+ if (ReadFile ((HANDLE) _handles[fd], buf, (DWORD) len, &nread, NULL) != 1)
+ return __NTerror ();
+ else
+ return (int) nread;
+}
+
+/* Replaces Borland library function. */
+int
+_rtl_write (int fd, const void *buf, unsigned int len)
+{
+ DWORD written;
+
+ if ((unsigned) fd >= _nfile)
+ return __IOerror (ERROR_INVALID_HANDLE);
+
+ /* Redirect stdout, stderr to the faked console window. */
+ if (_emu_console && fd < 3)
+ return _blp_console_write (buf, len);
+
+ if (WriteFile ((HANDLE) _handles[fd], (PVOID) buf, (DWORD) len, &written,
+ NULL) != 1)
+ return __NTerror ();
+ else
+ return (int) written;
+}
+
+void
+determine_os (void)
+{
+#pragma startup determine_os 64
+ DWORD nButtons;
+
+ /* Try out a random console function. If it fails then we must not
+ have a console.
+
+ Believe it or not, this seems to be the only way to determine
+ reliably whether we're running under 3.1. If you know a better
+ way, let me know. */
+ if (GetNumberOfConsoleMouseButtons (&nButtons))
+ _emu_console = 0;
+ else
+ _emu_console = 1;
+}
+
--- /dev/null
+/* config.h.in. Generated automatically from configure.in by autoheader. */
+/* Special definitions, to process by autoheader.
+ Copyright (C) 1997 Free Software Foundation. */
+
+/* Definitions for byte order, according to significance of bytes, from low
+ addresses to high addresses. The value is what you get by putting '4'
+ in the most significant byte, '3' in the second most significant byte,
+ '2' in the second least significant byte, and '1' in the least
+ significant byte. These definitions never need to be modified. */
+#define BIG 4321 /* 68k */
+#define LITTLE 1234 /* i[3456]86 */
+#define UNKNOWN 0000 /* Endianness must be determined at runtime. */
+
+/* Definitions for floating-point representation. */
+#define FPREP_IEEE754 754 /* The usual IEEE-754 format. */
+#define FPREP_UNKNOWN 666 /* Triggers an error at compile time. */
+
+/* We want prototypes for all the GNU extensions. */
+#define _GNU_SOURCE 1
+
+/* The concatenation of the strings "GNU ", and PACKAGE. */
+#define GNU_PACKAGE "GNU PSPP"
+
+/* Define to the name of the distribution. */
+#define PACKAGE "PSPP"
+
+/* Define to 1 if ANSI function prototypes are usable. */
+#define PROTOTYPES 1
+
+/* Define to the version of the distribution. */
+#define VERSION "0.1.0"
+
+/* Define if using alloca.c. */
+#undef C_ALLOCA
+
+/* Define to empty if the keyword does not work. */
+#undef const
+
+/* Define to one of _getb67, GETB67, getb67 for Cray-2 and Cray-YMP systems.
+ This function is required for alloca.c support on those systems. */
+#define CRAY_STACKSEG_END
+
+/* Define if you have alloca, as a function or macro. */
+#undef HAVE_ALLOCA
+
+/* Define if you have <alloca.h> and it should be used (not on Ultrix). */
+#undef HAVE_ALLOCA_H
+
+/* Define if you don't have vprintf but do have _doprnt. */
+#undef HAVE_DOPRNT
+
+/* Define if you have a working `mmap' system call. */
+#undef HAVE_MMAP
+
+/* Define if you have the vprintf function. */
+#define HAVE_VPRINTF 1
+
+/* Define as __inline if that's what the C compiler calls it. */
+#define inline
+
+/* Define to `long' if <sys/types.h> doesn't define. */
+#undef off_t
+
+/* Define if you need to in order for stat and other things to work. */
+#undef _POSIX_SOURCE
+
+/* Define to `unsigned' if <sys/types.h> doesn't define. */
+#undef size_t
+
+/* If using the C implementation of alloca, define if you know the
+ direction of stack growth for your system; otherwise it will be
+ automatically deduced at run-time.
+ STACK_DIRECTION > 0 => grows toward higher addresses
+ STACK_DIRECTION < 0 => grows toward lower addresses
+ STACK_DIRECTION = 0 => direction of growth unknown
+ */
+#undef STACK_DIRECTION
+
+/* Define if the `S_IS*' macros in <sys/stat.h> do not work properly. */
+#undef STAT_MACROS_BROKEN
+
+/* Define if you have the ANSI C header files. */
+#define STDC_HEADERS 1
+
+/* Define if you can safely include both <sys/time.h> and <time.h>. */
+#undef TIME_WITH_SYS_TIME
+
+/* Define if your <sys/time.h> declares struct tm. */
+#undef TM_IN_SYS_TIME
+
+/* Define if sprintf() returns the number of characters written to
+ the destination string, excluding the null terminator. */
+#define HAVE_GOOD_SPRINTF 1
+
+/* Define endianness of computer here as BIG or LITTLE, if known.
+ If not known, define as UNKNOWN. */
+#define ENDIAN LITTLE
+
+/* Define as floating-point representation of this computer. For
+ i386, m68k, and other common chips, this is FPREP_IEEE754. */
+#define FPREP FPREP_IEEE754
+
+/* Number of digits in longest `long' value, including sign. This is
+ usually 11, for 32-bit `long's, or 19, for 64-bit `long's. */
+#define INT_DIGITS 11
+
+/* Define if you have the history library (-lhistory). */
+#undef HAVE_LIBHISTORY
+
+/* Define if you have the termcap library (-ltermcap). */
+#undef HAVE_LIBTERMCAP
+
+/* Define if your locale.h file contains LC_MESSAGES. */
+#define HAVE_LC_MESSAGES 1
+
+/* Define to 1 if NLS is requested. */
+#undef ENABLE_NLS
+
+/* Define as 1 if you have catgets and don't want to use GNU gettext. */
+#undef HAVE_CATGETS
+
+/* Define as 1 if you have gettext and don't want to use GNU gettext. */
+#undef HAVE_GETTEXT
+
+/* Define as 1 if you have the stpcpy function. */
+#define HAVE_STPCPY 1
+
+/* The number of bytes in a double. */
+#define SIZEOF_DOUBLE 8
+
+/* The number of bytes in a float. */
+#define SIZEOF_FLOAT 4
+
+/* The number of bytes in a int. */
+#define SIZEOF_INT 4
+
+/* The number of bytes in a long. */
+#define SIZEOF_LONG 4
+
+/* The number of bytes in a long double. */
+#define SIZEOF_LONG_DOUBLE 12
+
+/* The number of bytes in a long long. */
+#define SIZEOF_LONG_LONG
+
+/* The number of bytes in a short. */
+#define SIZEOF_SHORT 2
+
+/* Define if you have the __argz_count function. */
+#undef HAVE___ARGZ_COUNT
+
+/* Define if you have the __argz_next function. */
+#undef HAVE___ARGZ_NEXT
+
+/* Define if you have the __argz_stringify function. */
+#undef HAVE___ARGZ_STRINGIFY
+
+/* Define if you have the __setfpucw function. */
+#undef HAVE___SETFPUCW
+
+/* Define if you have the dcgettext function. */
+#undef HAVE_DCGETTEXT
+
+/* Define if you have the finite function. */
+#undef HAVE_FINITE
+
+/* Define if you have the getcwd function. */
+#undef HAVE_GETCWD
+
+/* Define if you have the getdelim function. */
+#undef HAVE_GETDELIM
+
+/* Define if you have the gethostname function. */
+#undef HAVE_GETHOSTNAME
+
+/* Define if you have the getline function. */
+#undef HAVE_GETLINE
+
+/* Define if you have the getpagesize function. */
+#undef HAVE_GETPAGESIZE
+
+/* Define if you have the getpid function. */
+#define HAVE_GETPID 1
+
+/* Define if you have the isinf function. */
+#undef HAVE_ISINF
+
+/* Define if you have the isnan function. */
+#undef HAVE_ISNAN
+
+/* Define if you have the memchr function. */
+#define HAVE_MEMCHR 1
+
+/* Define if you have the memmem function. */
+#define HAVE_MEMMEM 0
+
+/* Define if you have the memmove function. */
+#define HAVE_MEMMOVE 1
+
+/* Define if you have the memset function. */
+#define HAVE_MEMSET 1
+
+/* Define if you have the munmap function. */
+#undef HAVE_MUNMAP
+
+/* Define if you have the putenv function. */
+#define HAVE_PUTENV 1
+
+/* Define if you have the setenv function. */
+#undef HAVE_SETENV
+
+/* Define if you have the setlocale function. */
+#define HAVE_SETLOCALE 1
+
+/* Define if you have the stpcpy function. */
+#define HAVE_STPCPY 1
+
+/* Define if you have the strcasecmp function. */
+#undef HAVE_STRCASECMP
+
+/* Define if you have the strchr function. */
+#undef HAVE_STRCHR
+
+/* Define if you have the strerror function. */
+#define HAVE_STRERROR 1
+
+/* Define if you have the strncasecmp function. */
+#undef HAVE_STRNCASECMP
+
+/* Define if you have the strpbrk function. */
+#define HAVE_STRPBRK 1
+
+/* Define if you have the strstr function. */
+#define HAVE_STRSTR 1
+
+/* Define if you have the strtod function. */
+#define HAVE_STRTOD 1
+
+/* Define if you have the strtol function. */
+#define HAVE_STRTOL 1
+
+/* Define if you have the strtoul function. */
+#define HAVE_STRTOUL 1
+
+/* Define if you have the <argz.h> header file. */
+#undef HAVE_ARGZ_H
+
+/* Define if you have the <fpu_control.h> header file. */
+#undef HAVE_FPU_CONTROL_H
+
+/* Define if you have the <limits.h> header file. */
+#define HAVE_LIMITS_H 1
+
+/* Define if you have the <locale.h> header file. */
+#define HAVE_LOCALE_H 1
+
+/* Define if you have the <malloc.h> header file. */
+#define HAVE_MALLOC_H 1
+
+/* Define if you have the <memory.h> header file. */
+#define HAVE_MEMORY_H 1
+
+/* Define if you have the <nl_types.h> header file. */
+#undef HAVE_NL_TYPES_H
+
+/* Define if you have the <readline/history.h> header file. */
+#undef HAVE_READLINE_HISTORY_H
+
+/* Define if you have the <readline/readline.h> header file. */
+#undef HAVE_READLINE_READLINE_H
+
+/* Define if you have the <string.h> header file. */
+#define HAVE_STRING_H 1
+
+/* Define if you have the <sys/time.h> header file. */
+#undef HAVE_SYS_TIME_H
+
+/* Define if you have the <sys/types.h> header file. */
+#define HAVE_SYS_TYPES_H 1
+
+/* Define if you have the <termcap.h> header file. */
+#undef HAVE_TERMCAP_H
+
+/* Define if you have the <unistd.h> header file. */
+#undef HAVE_UNISTD_H
+
+/* Define if you have the <values.h> header file. */
+#define HAVE_VALUES_H 1
+
+/* Define if you have the i library (-li). */
+#undef HAVE_LIBI
+
+/* Define if you have the m library (-lm). */
+#undef HAVE_LIBM
+
+/* Define if you have the readline library (-lreadline). */
+#undef HAVE_LIBREADLINE
+
+#include <pref.h>
+
+/* Local Variables: */
+/* mode:c */
+/* End: */
--- /dev/null
+/* PSPP - computes sample statistics.
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+/* Nothing needed here. */
--- /dev/null
+#! /bin/sh -e
+
+# This script makes a source distribution for compilation under
+# Borland C++ 5.0. It also produces a .iwz file for use with
+# InstallShield Express.
+
+if test "$1" = ""; then
+ echo "usage: $0 \'DOS-path-to-PSPP-source\' \'DOS-path-to-Borland-C++-5.0-root\'"
+fi
+
+test -f src/q2c.c || (echo "Not in PSPP source directory" && exit 1)
+
+make distdir
+
+DOSROOT="$1"
+VERSION=`sed -ne 's/^.*\[//;s/].*$//;/^[0-9]*\.[0-9]*\.[0-9]*$/p' < configure.in`
+BC5ROOT=`pwd`/pspp-$VERSION-bc5
+DISTROOT=`pwd`
+
+rm -rf $BC5ROOT
+cp -r pspp-$VERSION $BC5ROOT
+rm -f $DISTROOT/manualfiles.tmp
+rm -f $DISTROOT/testsfiles.tmp
+
+cd $BC5ROOT/doc
+texi2html -number -monolithic FAQ.texi
+
+mkdir $BC5ROOT/manual
+cd $BC5ROOT/manual
+texi2html -menu -number -split_node ../doc/pspp.texi
+cp pspp_toc.html index.html
+
+n_manual=0
+for d in *; do
+ n_manual=`expr $n_manual + 1`
+ echo "Group5File$n_manual=${DOSROOT}\\MANUAL\\$d" >> $DISTROOT/manualfiles.tmp
+done
+
+cd $BC5ROOT/tests
+n_tests=0
+for d in *; do
+ n_tests=`expr $n_tests + 1`
+ echo "Group3File$n_tests=${DOSROOT}\\TESTS\\$d" >> $DISTROOT/testsfiles.tmp
+done
+
+SEDDOSROOT=`echo "$1" | sed 's/\\\\/\\\\\\\\/'`
+echo "s%@BASEDIR@%$SEDDOSROOT%g" > $DISTROOT/bc5.sed
+SEDBC5BASEDIR=`echo "$2" | sed 's/\\\\/\\\\\\\\/'`
+echo "s%@BC5BASEDIR@%$SEDBC5BASEDIR%g" >> $DISTROOT/bc5.sed
+echo "s%@MANUALCOUNT@%$n_manual%g" >> $DISTROOT/bc5.sed
+echo "s%@TESTSCOUNT@%$n_tests%g" >> $DISTROOT/bc5.sed
+
+IN=$BC5ROOT/sysdeps/borlandc5.0/pspp.iwz.in
+OUT=$BC5ROOT/pspp.iwz
+sed -n -f $DISTROOT/bc5.sed -e '1,/^Group3Dir/p' < $IN > $OUT
+cat $DISTROOT/testsfiles.tmp >> $OUT
+sed -n -f $DISTROOT/bc5.sed -e '/^Group4Size/,/^Group5Dir/p' < $IN >> $OUT
+cat $DISTROOT/manualfiles.tmp < $IN >> $OUT
+sed -n -f $DISTROOT/bc5.sed -e '/^Group5Size/,$p' < $IN >> $OUT
+
+cp $BC5ROOT/sysdeps/borlandc5.0/pspp.ide $BC5ROOT/pspp.ide
+cp $BC5ROOT/pref.h.orig $BC5ROOT/sysdeps/borlandc5.0/pref.h
+
+rm $DISTROOT/manualfiles.tmp
+rm $DISTROOT/testsfiles.tmp
+rm $DISTROOT/bc5.sed
+
+find $BC5ROOT -type f | xargs perl $DISTROOT/sysdeps/borlandc5.0/unix2dos.pl
+find $BC5ROOT -name \*.bak | xargs rm -f
--- /dev/null
+[InstallShield Wizard]
+iDate=0
+iTime=0
+Flag=0
+ISX.EXE Size=668160
+ISX.EXE Date=12:49:10AM 12/18/1996
+ISX.EXE Ver=1.11.0.0
+SETUP.EXE Size=44928
+SETUP.EXE Date=1:04:12PM 11/4/1996
+SETUP.EXE Ver=3.0.107.0
+SETUP.INS Size=66760
+SETUP.INS Date=5:50:16PM 3/7/1997
+SETUP.INS Ver=Not available
+_INST16.EX_ Size=66760
+_INST16.EX_ Date=5:50:16PM 3/7/1997
+_INST16.EX_ Ver=Not available
+_INST32I.EX_ Size=320276
+_INST32I.EX_ Date=4:17:32PM 11/5/1996
+_INST32I.EX_ Ver=Not available
+ISDEPEND.INI Size=5102
+ISDEPEND.INI Date=4:31:20PM 6/11/1996
+ISDEPEND.INI Ver=Not available
+SWDEPEND.INI Size=4605
+SWDEPEND.INI Date=1:12:52AM 3/12/1997
+SWDEPEND.INI Ver=Not available
+ICOMP.EXE Size=119808
+ICOMP.EXE Date=3:05:10PM 1/15/1996
+ICOMP.EXE Ver=3.00.062
+SPLIT.EXE Size=90624
+SPLIT.EXE Date=3:09:36PM 1/15/1996
+SPLIT.EXE Ver=3.00.060
+PACKLIST.EXE Size=87552
+PACKLIST.EXE Date=3:10:30PM 1/15/1996
+PACKLIST.EXE Ver=3.00.060
+Version=1.11a
+DevTool=for Borland C++ 5.0
+Platform=Win32
+PtrBase=30100
+PtrPosY=227
+PtrPage=4
+DisksBuilt=1
+DisksDir=PSPP\144MB\
+TabsVisit=1111111110000111111
+LangNum=0
+
+[VisualDesign]
+AppName=PSPP
+AppExe=[Program Files]\pspp.exe
+Version=0.1.0
+Company=Free Software Foundation
+Title=PSPP
+TitleType=1
+BackgrndBmp=@BASEDIR@\sysdeps\borlandc5.0\sm-gnu-hd.bmp
+BackgrndAlign=4
+Backgrnd=1
+BackgrndColor=0
+Uninstall=1
+Silent=1
+SmsMode=0
+
+[RegEntries]
+Reg1Path=HKEY_CLASSES_ROOT
+Reg1Val1Type=0
+Reg1Val1Name=(Default)
+Reg1Val1Data=(value not set)
+Reg1Vals=1
+Reg2Path=HKEY_CURRENT_USER
+Reg2Val1Type=0
+Reg2Val1Name=(Default)
+Reg2Val1Data=(value not set)
+Reg2Vals=1
+Reg3Path=HKEY_LOCAL_MACHINE
+Reg3Val1Type=0
+Reg3Val1Name=(Default)
+Reg3Val1Data=(value not set)
+Reg3Vals=1
+Reg4Path=HKEY_USERS
+Reg4Val1Type=0
+Reg4Val1Name=(Default)
+Reg4Val1Data=(value not set)
+Reg4Vals=1
+Reg5Path=HKEY_CURRENT_CONFIG
+Reg5Val1Type=0
+Reg5Val1Name=(Default)
+Reg5Val1Data=(value not set)
+Reg5Vals=1
+Reg6Path=HKEY_DYN_DATA
+Reg6Val1Type=0
+Reg6Val1Name=(Default)
+Reg6Val1Data=(value not set)
+Reg6Vals=1
+Reg7Path=HKEY_CLASSES_ROOT\PSPP.Script
+Reg7PathUninstall=1
+Reg7Val1Type=0
+Reg7Val1Name=(Default)
+Reg7Val1Data=PSPP Script
+Reg7Vals=1
+Reg8Path=HKEY_CLASSES_ROOT\PSPP.Script\shell
+Reg8PathUninstall=1
+Reg8Val1Type=0
+Reg8Val1Name=(Default)
+Reg8Val1Data=(value not set)
+Reg8Vals=1
+Reg9Path=HKEY_CLASSES_ROOT\PSPP.Script\shell\open
+Reg9PathUninstall=1
+Reg9Val1Type=0
+Reg9Val1Name=(Default)
+Reg9Val1Data=(value not set)
+Reg9Vals=1
+Reg10Path=HKEY_CLASSES_ROOT\.stat
+Reg10PathUninstall=1
+Reg10Val1Type=0
+Reg10Val1Name=(Default)
+Reg10Val1Data=PSPP.Script
+Reg10Vals=1
+Reg11Path=HKEY_CLASSES_ROOT\PSPP.Script\DefaultIcon
+Reg11PathUninstall=1
+Reg11Val1Type=0
+Reg11Val1Name=(Default)
+Reg11Val1Data=<INSTALLDIR>\PSPP.ICO
+Reg11Vals=1
+Reg12Path=HKEY_CLASSES_ROOT\.sps
+Reg12PathUninstall=1
+Reg12Val1Type=0
+Reg12Val1Name=(Default)
+Reg12Val1Data=PSPP.Script
+Reg12Vals=1
+Reg13Path=HKEY_CLASSES_ROOT\.spss
+Reg13PathUninstall=1
+Reg13Val1Type=0
+Reg13Val1Name=(Default)
+Reg13Val1Data=PSPP.Script
+Reg13Vals=1
+Reg14Path=HKEY_CLASSES_ROOT\PSPP.Script\shell\open\command
+Reg14PathUninstall=1
+Reg14Val1Type=0
+Reg14Val1Name=(Default)
+Reg14Val1Data=<INSTALLDIR>\PSPP.EXE %1
+Reg14Vals=1
+Reg15Path=HKEY_CLASSES_ROOT\.lst
+Reg15PathUninstall=1
+Reg15Val1Type=0
+Reg15Val1Name=(Default)
+Reg15Val1Data=PSPP.Listing
+Reg15Vals=1
+Reg16Path=HKEY_CLASSES_ROOT\.list
+Reg16PathUninstall=1
+Reg16Val1Type=0
+Reg16Val1Name=(Default)
+Reg16Val1Data=PSPP.Listing
+Reg16Vals=1
+Reg17Path=HKEY_CLASSES_ROOT\PSPP.Listing
+Reg17PathUninstall=1
+Reg17Val1Type=0
+Reg17Val1Name=(Default)
+Reg17Val1Data=PSPP Listing Output
+Reg17Vals=1
+Reg18Path=HKEY_CLASSES_ROOT\PSPP.Listing\shell
+Reg18PathUninstall=1
+Reg18Val1Type=0
+Reg18Val1Name=(Default)
+Reg18Val1Data=(value not set)
+Reg18Vals=1
+Reg19Path=HKEY_CLASSES_ROOT\PSPP.Listing\shell\open
+Reg19PathUninstall=1
+Reg19Val1Type=0
+Reg19Val1Name=(Default)
+Reg19Val1Data=(value not set)
+Reg19Vals=1
+Reg20Path=HKEY_CLASSES_ROOT\PSPP.Listing\shell\open\command
+Reg20PathUninstall=1
+Reg20Val1Type=0
+Reg20Val1Name=(Default)
+Reg20Val1Data=<WINDIR>\NOTEPAD.EXE %1
+Reg20Vals=1
+Reg21Path=HKEY_CLASSES_ROOT\PSPP.Listing\DefaultIcon
+Reg21PathUninstall=1
+Reg21Val1Type=0
+Reg21Val1Name=(Default)
+Reg21Val1Data=<INSTALLDIR>\PSPP.ICO
+Reg21Vals=1
+Regs=21
+
+[Registry]
+Reg1Path=HKEY_CLASSES_ROOT\PSPP.Script
+Reg1PathUninstall=1
+Reg1ValName=(Default)
+Reg1ValType=0
+Reg1ValData=PSPP Script
+Reg2Path=HKEY_CLASSES_ROOT\PSPP.Script\shell
+Reg2PathUninstall=1
+Reg3Path=HKEY_CLASSES_ROOT\PSPP.Script\shell\open
+Reg3PathUninstall=1
+Reg4Path=HKEY_CLASSES_ROOT\.stat
+Reg4PathUninstall=1
+Reg4ValName=(Default)
+Reg4ValType=0
+Reg4ValData=PSPP.Script
+Reg5Path=HKEY_CLASSES_ROOT\PSPP.Script\DefaultIcon
+Reg5PathUninstall=1
+Reg5ValName=(Default)
+Reg5ValType=0
+Reg5ValData=<INSTALLDIR>\PSPP.ICO
+Reg6Path=HKEY_CLASSES_ROOT\.sps
+Reg6PathUninstall=1
+Reg6ValName=(Default)
+Reg6ValType=0
+Reg6ValData=PSPP.Script
+Reg7Path=HKEY_CLASSES_ROOT\.spss
+Reg7PathUninstall=1
+Reg7ValName=(Default)
+Reg7ValType=0
+Reg7ValData=PSPP.Script
+Reg8Path=HKEY_CLASSES_ROOT\PSPP.Script\shell\open\command
+Reg8PathUninstall=1
+Reg8ValName=(Default)
+Reg8ValType=0
+Reg8ValData=<INSTALLDIR>\PSPP.EXE %1
+Reg9Path=HKEY_CLASSES_ROOT\.lst
+Reg9PathUninstall=1
+Reg9ValName=(Default)
+Reg9ValType=0
+Reg9ValData=PSPP.Listing
+Reg10Path=HKEY_CLASSES_ROOT\.list
+Reg10PathUninstall=1
+Reg10ValName=(Default)
+Reg10ValType=0
+Reg10ValData=PSPP.Listing
+Reg11Path=HKEY_CLASSES_ROOT\PSPP.Listing
+Reg11PathUninstall=1
+Reg11ValName=(Default)
+Reg11ValType=0
+Reg11ValData=PSPP Listing Output
+Reg12Path=HKEY_CLASSES_ROOT\PSPP.Listing\shell
+Reg12PathUninstall=1
+Reg13Path=HKEY_CLASSES_ROOT\PSPP.Listing\shell\open
+Reg13PathUninstall=1
+Reg14Path=HKEY_CLASSES_ROOT\PSPP.Listing\shell\open\command
+Reg14PathUninstall=1
+Reg14ValName=(Default)
+Reg14ValType=0
+Reg14ValData=<WINDIR>\NOTEPAD.EXE %1
+Reg15Path=HKEY_CLASSES_ROOT\PSPP.Listing\DefaultIcon
+Reg15PathUninstall=1
+Reg15ValName=(Default)
+Reg15ValType=0
+Reg15ValData=<INSTALLDIR>\PSPP.ICO
+Regs=15
+
+[Groups]
+Groups=6
+Group1Size=421589
+Group1Files=6
+Group1Name=Program Files
+Group1Dir=<INSTALLDIR>
+Group1File1=@BASEDIR@\pspp.exe
+Group1File2=@BASEDIR@\config\devices
+Group1File3=@BASEDIR@\config\papersize
+Group1File4=@BASEDIR@\config\ps-prologue
+Group1File5=@BASEDIR@\COPYING
+Group1File6=@BASEDIR@\sysdeps\borlandc5.0\pspp.ICO
+Group2Size=43097
+Group2Files=4
+Group2Name=Help Files - HTML
+Group2Dir=<INSTALLDIR>\HELP
+Group2File1=@BASEDIR@\doc\BUGS.html
+Group2File2=@BASEDIR@\doc\LANGUAGE.html
+Group2File3=@BASEDIR@\doc\README.html
+Group2File4=@BASEDIR@\doc\THANKS.html
+Group3Size=104388
+Group3Files=@TESTSCOUNT@
+Group3Name=Test Files
+Group3Dir=<INSTALLDIR>\TESTS
+Group4Size=63652
+Group4Files=7
+Group4Name=Help Files - ASCII
+Group4Dir=<INSTALLDIR>\HELP\ASCII
+Group4File1=@BASEDIR@\BUGS
+Group4File2=@BASEDIR@\LANGUAGE
+Group4File3=@BASEDIR@\NEWS
+Group4File4=@BASEDIR@\README
+Group4File5=@BASEDIR@\THANKS
+Group4File6=@BASEDIR@\TODO
+Group4File7=@BASEDIR@\AUTHORS
+Group5Size=336614
+Group5Files=@MANUALCOUNT@
+Group5Name=Manual - HTML
+Group5Dir=<INSTALLDIR>\HELP\MANUAL
+Group6Size=229376
+Group6Files=1
+Group6Auto=108
+Group6ID=38308
+Group6Name=System Files
+Group6Dir=<WINSYSDIR>
+Group6File1=@BC5BASEDIR@\BIN\CW3220.DLL
+Group6File1Auto=108
+
+[Components]
+Components=4
+Component1Groups=2
+Component1Name=Application Files
+Component1Description=Application files needed to run the application
+Component1GroupList=1 6
+Component2Groups=2
+Component2Name=Help and Tutorial Files
+Component2Description=Help and tutorial needed for online help
+Component2GroupList=2 4
+Component3Groups=1
+Component3Name=Sample Files
+Component3Description=Sample data files
+Component3GroupList=3
+Component4Groups=1
+Component4Name=Manual - HTML
+Component4Description=On-line manual in World Wide Web HTML format.
+Component4GroupList=5
+
+[Types]
+Types=3
+Type1Components=4
+Type1Name=Custom
+Type1ComponentList=1 2 3 4
+Type2Components=4
+Type2Name=Typical
+Type2ComponentList=1 2 3 4
+Type3Components=1
+Type3Name=Compact
+Type3ComponentList=1
+
+[Sequence]
+DestinationLocationDir=<ProgramFilesDir>\Free Software Foundation\PSPP
+SelectProgramFolderName=PSPP
+WelcomeMessage=1
+LicenseAgreement=1
+LicenseAgreementFile=@BASEDIR@\copying
+DestinationLocation=1
+SetupType=1
+CustomSetup=1
+CustomSetupGroupSel=1
+SelectProgramFolder=1
+BeginFileTransfer=1
+ProgressBar=1
+Billboards=1
+BillboardsFile=@BASEDIR@\sysdeps\borlandc5.0\
+SetupComplete=1
+
+[Icons]
+Icons=5
+Icon1Cmd=[Program Files]\pspp.exe
+Icon1Description=PSPP
+Icon1WorkingDir=[Program Files]
+Icon1IconFile=[Program Files]\pspp.ICO
+Icon1RealFile=@BASEDIR@\sysdeps\borlandc5.0\pspp.ICO
+Icon1WhichIcon=0
+Icon1KeyVirtual=0
+Icon1KeyFlags=0
+Icon2Cmd=[Help Files - HTML]\BUGS.html
+Icon2Description=Bugs
+Icon2WorkingDir=[Help Files - HTML]
+Icon2RealFile=@BASEDIR@\doc\BUGS.html
+Icon2WhichIcon=0
+Icon2KeyVirtual=0
+Icon2KeyFlags=0
+Icon3Cmd=[Help Files - HTML]\LANGUAGE.html
+Icon3Description=Language Notes
+Icon3WorkingDir=[Help Files - HTML]
+Icon3RealFile=@BASEDIR@\doc\LANGUAGE.html
+Icon3WhichIcon=0
+Icon3KeyVirtual=0
+Icon3KeyFlags=0
+Icon4Cmd=[Help Files - HTML]\README.html
+Icon4Description=README
+Icon4WorkingDir=[Help Files - HTML]
+Icon4RealFile=@BASEDIR@\doc\README.html
+Icon4WhichIcon=0
+Icon4KeyVirtual=0
+Icon4KeyFlags=0
+Icon5Cmd=[Manual - HTML]\pspp_toc.html
+Icon5Description=Manual
+Icon5WorkingDir=[Manual - HTML]
+Icon5RealFile=@BASEDIR@\MANUAL\pspp_toc.html
+Icon5WhichIcon=0
+Icon5KeyVirtual=0
+Icon5KeyFlags=0
--- /dev/null
+#!/usr/bin/perl
+while (<>) {
+ if ($ARGV ne $oldargv) {
+ $translate = -T $ARGV;
+ rename($ARGV, $ARGV . '.bak');
+ open(ARGVOUT, ">$ARGV");
+ select(ARGVOUT);
+ $oldargv = $ARGV;
+ }
+ if ($translate) {
+ chop;
+ $_ .= "\r
+";
+ }
+}
+continue {
+ print; # this prints to original filename
+}
+select(STDOUT);
--- /dev/null
+#include <config.h>\r
+char bare_version[] = VERSION;\r
+char version[] = GNU_PACKAGE " " VERSION;\r
+char stat_version[] = GNU_PACKAGE " " VERSION \r
+ " (Fri Jul 11 12:33:09 GMT-5:00 1997).";\r
+char host_system[] = "i586-borlandc5.0";\r
+char build_system[] = "i586-borlandc5.0";\r
--- /dev/null
+PSPP currently runs only as a console-mode application under Windows
+environments. Since Windows 3.1 does not provide a console, PSPP
+needs special assistance to run under Windows 3.1. con32s is a small
+library that I have developed to do this. This directory contains the
+compiler-independent portion of con32s. There is also a small
+compiler-dependent portion that need to be written for each compiler.
+See the example for Borland C++ for more details.
+
+ -blp
+
--- /dev/null
+/* con32s - emulates Windows console.
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <winbase.h>
+#include <wingdi.h>
+#include <winuser.h>
+#include <stdio.h>
+#include <assert.h>
+#include <stdlib.h>
+#include <stdarg.h>
+
+typedef struct line_struct line;
+struct line_struct
+ {
+ line *next, *prev; /* next and previous lines */
+ char *text; /* text */
+ int len; /* number of characters in text */
+ int size; /* maximum allocated size for text */
+ }; /* line */
+
+/* Pointer to tail end of text lines. */
+static line *tail;
+
+/* Console window created. */
+static int inited = 0;
+
+/* Console window title. */
+static const char *title = _("Con32s Console Emulator by Ben Pfaff");
+
+/* Important variables. */
+HINSTANCE _hInstance;
+HINSTANCE _hPrev;
+LPSTR _cmdline;
+int _nCmdShow;
+
+/* Console window. */
+HWND wnd;
+
+/* Width, height of a single character in the console font. */
+int cw, ch;
+
+/* Width, height of console window in characters. */
+int nw, nh;
+
+/* Keyboard buffer. */
+#define MAX_KBD_BUF 80 /* Maximum number of characters to buffer. */
+char kbd[MAX_KBD_BUF];
+char *hp, *tp; /* Keyboard buffer head, tail. */
+
+static void
+outmsg (char *format,...)
+{
+ va_list args;
+ char s[128];
+
+ va_start (args, format);
+ vsprintf (s, format, args);
+ va_end (args);
+ MessageBox (_hInstance, s, "Con32s",
+ MB_OK | MB_ICONHAND | MB_SYSTEMMODAL);
+}
+
+static void *
+xmalloc (size_t size)
+{
+ void *vp;
+ if (size == 0)
+ return NULL;
+ vp = malloc (size);
+ if (!vp)
+ {
+ MessageBox (NULL, _("xmalloc(): out of memory"), NULL, MB_OK);
+ exit (EXIT_FAILURE);
+ }
+ return vp;
+}
+
+static void *
+xrealloc (void *ptr, size_t size)
+{
+ void *vp;
+ if (!size)
+ {
+ if (ptr)
+ free (ptr);
+ return NULL;
+ }
+ if (ptr)
+ vp = realloc (ptr, size);
+ else
+ vp = malloc (size);
+ if (!vp)
+ {
+ MessageBox (NULL, _("xrealloc(): out of memory"), NULL, MB_OK);
+ exit (EXIT_FAILURE);
+ }
+ return vp;
+}
+
+void _blp_console_init (void);
+void _blp_console_yield (void);
+void _blp_console_paint (void);
+void find_console_top (line ** top);
+void find_console_bottom (int *x, int *y, line ** bottom);
+
+static void
+writechar (int c)
+{
+ int x, y;
+ line *bottom;
+
+ static HDC dc;
+
+ if (c == 10000)
+ {
+ if (dc)
+ {
+ ReleaseDC (wnd, dc);
+ dc = 0;
+ }
+ return;
+ }
+
+ if (!tail)
+ {
+ tail = xmalloc (sizeof (line));
+ tail->next = tail->prev = NULL;
+ tail->text = NULL;
+ tail->len = tail->size = 0;
+ }
+
+ switch (c)
+ {
+ case '\n':
+ {
+ tail->next = xmalloc (sizeof (line));
+ tail->next->prev = tail;
+ tail = tail->next;
+ tail->next = NULL;
+ tail->text = NULL;
+ tail->len = tail->size = 0;
+ }
+ break;
+ case '\r':
+ break;
+ case '\b':
+ {
+ find_console_bottom (&x, &y, &bottom);
+ if (tail->len)
+ tail->len--;
+ else
+ {
+ tail = tail->prev;
+ free (tail->next);
+ tail->next = NULL;
+ }
+
+ if (x > 1)
+ {
+ if (!dc)
+ {
+ dc = GetDC (wnd);
+ SelectObject (dc, GetStockObject (ANSI_FIXED_FONT));
+ assert (dc);
+ }
+ TextOut (dc, x * cw, y * ch, " ", 1);
+ return;
+ }
+ }
+ break;
+ default:
+ {
+ if (tail->len + 1 > tail->size)
+ {
+ tail->size += 16;
+ tail->text = xrealloc (tail->text, tail->size);
+ }
+
+ find_console_bottom (&x, &y, &bottom);
+ tail->text[tail->len++] = c;
+ if (y < nh)
+ {
+ if (!dc)
+ {
+ dc = GetDC (wnd);
+ SelectObject (dc, GetStockObject (ANSI_FIXED_FONT));
+ assert (dc);
+ }
+ TextOut (dc, x * cw, y * ch, &tail->text[tail->len - 1], 1);
+ return;
+ }
+ }
+ break;
+ }
+ InvalidateRect (wnd, NULL, TRUE);
+}
+
+/* Writes LEN bytes from BUF to the fake console window. */
+int
+_blp_console_write (const void *buf, unsigned len)
+{
+ int i;
+
+ if (!inited)
+ _blp_console_init ();
+ for (i = 0; i < len; i++)
+ writechar (((char *) buf)[i]);
+ writechar (10000);
+ return len;
+}
+
+/* Reads one character from the fake console window. A whole line
+ is read at once, then spoon-fed to the runtime library. */
+#if __BORLANDC__
+#pragma argsused
+#endif
+int
+_blp_console_read (const void *t1, unsigned t2)
+{
+ static char buf[1024];
+ static int len;
+ static int n;
+
+ MSG msg;
+
+ int c;
+
+ if (!inited)
+ _blp_console_init ();
+ if (n < len)
+ {
+ *(char *) t1 = buf[n];
+ n++;
+ return 1;
+ }
+
+ printf ("_");
+ len = n = 0;
+ while (GetMessage ((LPMSG) & msg, NULL, 0, 0))
+ {
+ TranslateMessage ((LPMSG) & msg);
+ DispatchMessage ((LPMSG) & msg);
+
+ while (hp != tp)
+ {
+ c = *(unsigned char *) tp;
+ if (++tp >= &kbd[MAX_KBD_BUF])
+ tp = kbd;
+ if ((c >= 32 && c < 128) || c == '\b' || c == '\r')
+ switch (c)
+ {
+ case '\b':
+ if (len <= 0)
+ break;
+ printf ("\b\b_");
+ len--;
+ break;
+ default:
+ if (len >= 1022)
+ break;
+ if (c == '\r')
+ {
+ buf[len++] = '\n';
+ printf ("\b\n");
+ *(char *) t1 = buf[n];
+ n++;
+ return 1;
+ }
+ buf[len++] = c;
+ printf ("\b%c_", c);
+ break;
+ }
+ }
+ }
+ len = 0;
+ return 0;
+}
+
+LRESULT CALLBACK _export _blp_console_wndproc (HWND, UINT, WPARAM, LPARAM);
+
+void
+_blp_console_init (void)
+{
+ WNDCLASS wc;
+
+ if (inited)
+ return;
+ inited = 1;
+ wc.style = CS_HREDRAW | CS_VREDRAW;
+ wc.lpfnWndProc = _blp_console_wndproc;
+ wc.cbClsExtra = 0;
+ wc.cbWndExtra = 0;
+ wc.hInstance = (HINSTANCE) _hInstance;
+ wc.hIcon = LoadIcon (NULL, IDI_APPLICATION);
+ wc.hCursor = LoadCursor (NULL, IDC_ARROW);
+ wc.hbrBackground = CreateSolidBrush (RGB (255, 255, 255));
+ wc.lpszMenuName = NULL;
+ wc.lpszClassName = "blp_console";
+ if (!RegisterClass (&wc))
+ {
+ MessageBox ((HWND) 0, _("RegisterClass(): returned 0."),
+ "_blp_console_init()", MB_APPLMODAL | MB_OK);
+ exit (EXIT_FAILURE);
+ }
+
+ wnd = CreateWindow ("blp_console", title, WS_OVERLAPPEDWINDOW,
+ CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
+ CW_USEDEFAULT, NULL, (HMENU) 0, (HINSTANCE) _hInstance,
+ NULL);
+ if (!wnd)
+ {
+ MessageBox ((HWND) 0, _("CreateWindow(): returned 0."),
+ "_blp_console_init()", MB_APPLMODAL | MB_OK);
+ exit (EXIT_FAILURE);
+ }
+
+ ShowWindow (wnd, _nCmdShow);
+
+ hp = tp = kbd;
+}
+
+LRESULT CALLBACK _export
+_blp_console_wndproc (HWND hwnd, UINT msg, WPARAM wp, LPARAM lp)
+{
+ char s[80];
+
+ switch (msg)
+ {
+ case WM_CREATE:
+ {
+ HDC dc = GetDC (hwnd);
+ TEXTMETRIC tm;
+ int success;
+
+ SelectObject (dc, GetStockObject (ANSI_FIXED_FONT));
+ success = GetTextMetrics (dc, &tm);
+ assert (success);
+ cw = tm.tmMaxCharWidth;
+ ch = tm.tmHeight;
+ success = ReleaseDC (hwnd, dc);
+ assert (success);
+ return 0;
+ }
+ case WM_PAINT:
+ _blp_console_paint ();
+ return 0;
+ case WM_CHAR:
+ {
+ if (hp + 1 != tp && (hp != &kbd[MAX_KBD_BUF - 1] || tp != kbd))
+ {
+ *hp++ = wp;
+ if (hp >= &kbd[MAX_KBD_BUF])
+ hp = kbd;
+ }
+ }
+ break;
+ }
+ return DefWindowProc (hwnd, msg, wp, lp);
+}
+
+static void
+find_console_top (line ** top)
+{
+ int success;
+
+ /* Line count. */
+ int lc;
+
+ /* Line iterator. */
+ line *iter;
+
+ /* Scratch line. */
+ static line temp;
+
+ /* Client rectangle. */
+ RECT r;
+
+ success = GetClientRect (wnd, &r);
+ assert (success);
+ nw = r.right / cw;
+ if (nw < 1)
+ nw = 1;
+ nh = r.bottom / ch;
+ if (nh < 1)
+ nh = 1;
+
+ /* Find the beginning of the text to display. */
+ for (lc = 0, iter = tail; iter; iter = iter->prev)
+ {
+ if (!iter->len)
+ lc++;
+ else
+ lc += (iter->len / nw) + (iter->len % nw > 0);
+ if (lc >= nh || !iter->prev)
+ break;
+ }
+ if (lc > nh)
+ {
+ temp = *iter;
+ temp.text += nw * (lc - nh);
+ temp.len -= nw * (lc - nh);
+ *top = &temp;
+ }
+ else
+ *top = iter;
+}
+
+static void
+find_console_bottom (int *x, int *y, line ** bottom)
+{
+ find_console_top (bottom);
+ *x = *y = 0;
+ if (!*bottom)
+ return;
+ while (1)
+ {
+ if ((*bottom)->len == 0)
+ (*y)++;
+ else
+ (*y) += ((*bottom)->len / nw) + ((*bottom)->len % nw > 0);
+ if (!(*bottom)->next)
+ break;
+ *bottom = (*bottom)->next;
+ }
+ *x = (*bottom)->len % nw;
+ (*y)--;
+}
+
+void
+_blp_console_paint (void)
+{
+ PAINTSTRUCT ps;
+ HDC dc;
+
+ /* Current screen location. */
+ int x, y;
+
+ /* Current line. */
+ line *iter;
+
+ dc = BeginPaint (wnd, &ps);
+ assert (dc);
+
+ find_console_top (&iter);
+
+ /* Display the text. */
+ SelectObject (dc, GetStockObject (ANSI_FIXED_FONT));
+ SetTextColor (dc, RGB (0, 0, 0));
+ for (y = 0; iter; iter = iter->next)
+ {
+ if (!iter->len)
+ {
+ y += ch;
+ continue;
+ }
+ for (x = 0; x < iter->len; x += nw)
+ {
+ TextOut (dc, 0, y, &iter->text[x],
+ iter->len - x > nw ? nw : iter->len - x);
+ y += ch;
+ }
+ }
+
+ EndPaint (wnd, &ps);
+}
+
+int main (int argc, char *argv[], char *env[]);
+
+#if __BORLANDC__
+#pragma argsused
+#endif
+int CALLBACK
+WinMain (HINSTANCE inst, HINSTANCE prev, LPSTR cmdline, int nCmdShow)
+{
+ int result;
+ MSG msg;
+
+ char *pgmname = "PSPP";
+
+ _hInstance = inst;
+ _hPrev = prev;
+ _cmdline = cmdline;
+ _nCmdShow = nCmdShow;
+
+ result = main (1, &pgmname, NULL);
+
+ return result;
+}
--- /dev/null
+Fri Jan 7 20:30:23 2000 Ben Pfaff <blp@gnu.org>
+
+ * data-fmts.stat: Add more date tests.
+
+ * do-repeat.stat: SET ECHO ON.
+
+ * syntax: Replace test -L with test -h.
+
+Tue Jan 5 14:21:52 1999 Ben Pfaff <blp@gnu.org>
+
+ * data-list.stat, data-list.data: Adjust so that it can tell if
+ DATA LIST FREE properly parses and pads string values.
+
+ * list.stat: Remove anachronistic `SET EMULATION PC'.
+
+ * Rebuilt benchmark.
+
+Tue Jan 5 14:12:58 1999 Ben Pfaff <blp@gnu.org>
+
+ * syntax: Replaced `test' calls with `['. This may or may not fix
+ the problems some people have reported.
+
+Sun Aug 9 11:15:38 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) Update for renamed files.
+
+ * autorecode.stat: Renamed autorecod.stat.
+
+ * begin-data.stat: Renamed beg-data.stat.
+
+ * data-formats.stat: Renamed data-fmts.stat.
+
+ * expression.stat: Renamed expr.stat.
+
+ * file-label.stat: Renamed file-lab.stat.
+
+ * input-program.stat: Renamed inpt-pgm.stat.
+
+ * modify-vars.stat: Renamed mdfy-vars.stat.
+
+ * match-files.stat: Renamed mtch-file.stat.
+
+ * process-if.stat: Renamed pcs-if.stat.
+
+ * split-file.stat: Renamed splt-file.stat.
+
+ * sysfile-info.stat: Renamed sys-info.stat.
+
+ * expect/: Refreshed.
+
+Sat Aug 8 00:27:07 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) Add `syntax'.
+ (dist-hook) New target.
+
+Wed Aug 5 00:04:16 1998 Ben Pfaff <blp@gnu.org>
+
+ * TEST-RESULTS: Removed.
+
+ * show-check-msg: Removed.
+
+ * expect/: New.
+
+ * syntax: New. Thanks to James R. Van Zandt <jrv@vanzandt.mv.com>
+ for this implementation of automatic testing.
+
+ * Makefile: (TESTS) Set to the syntax script.
+ (bench) New target.
+ (EXTRA_DIST) Remove TEST-RESULTS. Add `syntax'.
+
+Sun Jul 5 14:16:18 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) Add flip.stat.
+
+Sun Jul 5 00:50:41 1998 Ben Pfaff <blp@gnu.org>
+
+ * crosstabs.stat: Change to test /MISSING=REPORT.
+
+Tue Jun 2 23:42:23 1998 Ben Pfaff <blp@gnu.org>
+
+ * flip.stat: New file.
+
+ * weighting.stat: Update.
+
+Mon May 25 12:45:46 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) Add crosstabs.stat, match-files.stat.
+
+ * crosstabs.stat: Turn off cells=all.
+
+Tue May 12 16:22:06 1998 Ben Pfaff <blp@gnu.org>
+
+ * crosstabs.stat: Minor changes.
+
+Thu May 7 23:16:03 1998 Ben Pfaff <blp@gnu.org>
+
+ * crosstabs.stat: Replace with a test that is hopefully better.
+
+Tue Apr 14 01:00:46 1998 Ben Pfaff <blp@gnu.org>
+
+ * crosstabs.stat: New.
+
+Mon Mar 9 15:40:25 1998 Ben Pfaff <blp@gnu.org>
+
+ * match-files.stat: More thorough.
+
+Mon Mar 9 01:14:14 1998 Ben Pfaff <blp@gnu.org>
+
+ * match-files.stat: More thorough.
+
+1998-03-05 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Use ./gengarbage instead of gengarbage.
+
+1998-02-23 Ben Pfaff <blp@gnu.org>
+
+ * Many tests: Remove final finish command.
+
+1998-02-16 Ben Pfaff <blp@gnu.org>
+
+ * (DISTCLEANFILES) Clean *.save, pspp.*, foo*
+
+ * file-label.stat, sysfile-info.stat: Replace .sav with .save.
+
+ * match-files.stat: New file.
+
+Fri Feb 13 15:58:11 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) Add TEST-RESULTS.
+
+Tue Jan 13 01:11:36 1998 Ben Pfaff <blp@gnu.org>
+
+ * aggregate.stat: Some more testing.
+
+Sat Jan 10 23:57:14 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (DISTCLEANFILES) Add aggregate.save.
+
+ * aggregate.stat: Slightly more thorough.
+
+Sat Jan 10 02:17:00 1998 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) Add means.stat, t-test.stat.
+
+ * means.stat: New file.
+
+Thu Jan 8 22:38:59 1998 Ben Pfaff <blp@gnu.org>
+
+ * Many tests: Removed extra newlines from REMARKs.
+
+Mon Jan 5 11:18:44 1998 Ben Pfaff <blp@gnu.org>
+
+ * sysfile-info.stat: Test most of the DISPLAY commands. Update
+ title.
+
+ * vector.stat: Display vectors.
+
+Sun Jan 4 18:31:36 1998 Ben Pfaff <blp@gnu.org>
+
+ * All tests: Added title.
+
+ * begin-data.stat: Updated REMARK format.
+
+ * descript.stat: Comment fix.
+
+Sun Dec 21 16:57:31 1997 Ben Pfaff <blp@gnu.org>
+
+ * TEST-RESULTS: New file.
+
+Fri Dec 5 22:02:20 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (DISTCLEANFILES) Add fiasco.html.
+
+Tue Dec 2 14:55:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * t-test.stat: New file.
+
+Fri Nov 14 00:17:25 1997 Ben Pfaff <blp@gnu.org>
+
+ * aggregate.stat: Changed.
+
+Tue Oct 28 16:26:25 1997 Ben Pfaff <blp@gnu.org>
+
+ * aggregate.stat: New file.
+
+ * Makefile.am: (EXTRA_DIST) Add aggregate.stat.
+
+Sun Oct 5 16:02:02 1997 Ben Pfaff <blp@gnu.org>
+
+ * fall92.stat, fall92.data: Removed (unknown copyright).
+
+ * gengarbage.c: Define EXIT_SUCCESS if not defined by headers.
+ From Alexandre Oliva <oliva@dcc.unicamp.br>.
+
+Sat Oct 4 16:35:59 1997 Ben Pfaff <blp@gnu.org>
+
+ * repeating.stat: New file.
+
+ * Makefile.am: (EXTRA_DIST) Add repeating.stat.
+
+Thu Sep 18 21:40:50 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) Add lag.stat.
+
+Mon Aug 18 18:31:42 1997 Ben Pfaff <blp@gnu.org>
+
+ * do-repeat.stat: Even more useful.
+
+ * lag.stat: New file.
+
+Sun Aug 17 22:47:53 1997 Ben Pfaff <blp@gnu.org>
+
+ * do-repeat.stat: Made actually useful, not stupid.
+
+Sun Aug 3 11:46:00 1997 Ben Pfaff <blp@gnu.org>
+
+ * In several files, replace usage of deprecated term `script' by
+ `syntax file'.
+
+Thu Jul 17 02:12:17 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) Add tabs.stat.
+
+ * file-label.stat: Improved.
+
+ * sysfile-info.stat: Tests DISPLAY DICTIONARY now as well.
+
+Fri Jul 11 14:13:49 1997 Ben Pfaff <blp@gnu.org>
+
+ * gengarbage.c: Reformat. #include's <time.h>. Uses ANSI C
+ rand() in place of random(). Calls the randomizer srand().
+
+Thu Jul 10 22:16:34 1997 Ben Pfaff <blp@gnu.org>
+
+ * tabs.stat: New file.
+
+Wed Jun 25 22:54:40 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: (EXTRA_DIST) Removed bug.stat, file-type.stat.
+
+Sun Jun 8 01:24:55 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Added fiasco.ps, fiasco.list, foo, foo.sav, msgs to
+ DISTCLEANFILES.
+
+ * input-program.stat: Made some variables scratch.
+
+Fri Jun 6 22:53:03 1997 Ben Pfaff <blp@gnu.org>
+
+ * Many files: Comment fixes, removed `set output raw.' commands.
+
+ * Other miscellaneous changes.
+
+Tue Jun 3 23:44:46 1997 Ben Pfaff <blp@gnu.org>
+
+ * list.stat: Re-enabled some of it.
+
+Wed Apr 23 21:33:48 1997 Ben Pfaff <blp@gnu.org>
+
+ * sysfile-info.stat: A little more generalized now.
+
+Fri Apr 18 15:42:22 1997 Ben Pfaff <blp@gnu.org>
+
+ * Makefile.am: Maintainer-clean Makefile.in.
+
+Thu Mar 27 01:11:29 1997 Ben Pfaff <blp@gnu.org>
+
+ * gengarbage.pl: Removed.
+
+Sat Feb 15 21:26:53 1997 Ben Pfaff <blp@gnu.org>
+
+ * descript.stat: Syntax fixes.
+
+ * process-if.stat: New test for PROCESS IF.
+
+Sun Jan 19 14:22:11 1997 Ben Pfaff <blp@gnu.org>
+
+ * autorecode.stat, modify-vars.stat: More thorough.
+
+ * data-formats.stat, file-label.stat: New tests.
+
+Thu Jan 16 13:08:57 1997 Ben Pfaff <blp@gnu.org>
+
+ * bug.stat: Comment fix.
+
+Wed Jan 1 22:08:10 1997 Ben Pfaff <blp@gnu.org>
+
+ * filter.stat: New file; tests FILTER behavior.
+
+Wed Jan 1 17:00:59 1997 Ben Pfaff <blp@gnu.org>
+
+ * gengarbage.pl: New perl program equivalent to gengarbage.c.
+
+Sun Dec 29 21:36:48 1996 Ben Pfaff <blp@gnu.org>
+
+ * gengarbage.c: Changed.
+
+ * sort.stat: Changed.
+
+Sun Dec 22 23:10:39 1996 Ben Pfaff <blp@gnu.org>
+
+ * sort.stat: New file.
+
+Fri Dec 13 21:30:53 1996 Ben Pfaff <blp@gnu.org>
+
+ * autorecode.stat: New file.
+
+ * fall92.stat: Mods for practicality.
+
+ * test.bat, testall.bat: Removed.
+
+Thu Nov 28 23:14:07 1996 Ben Pfaff <blp@gnu.org>
+
+ * list.stat, weighting.stat: Changed SET COMPATIBILITY subcommand
+ to SET EMULATION in anticipation of change.
+
+Sat Oct 26 23:06:06 1996 Ben Pfaff <blp@gnu.org>
+
+ * recode.stat: Removed comment about bug, since I fixed that.
+
+Thu Oct 24 20:13:42 1996 Ben Pfaff <blp@gnu.org>
+
+ * print.stat: Slightly more thorough.
+
+Thu Oct 24 17:47:14 1996 Ben Pfaff <blp@gnu.org>
+
+ * time-date.stat: Slightly more thorough.
+
+Wed Oct 23 21:53:43 1996 Ben Pfaff <blp@gnu.org>
+
+ * time-date.stat: New file.
+
+Thu Sep 26 22:20:26 1996 Ben Pfaff <blp@gnu.org>
+
+ * list.data: More data.
+
+ * list.stat: Handles all that extra data.
+
+ * weighting.stat: Doesn't try to list $WEIGHT because PC+ isn't
+ quite supported yet.
+
+Wed Sep 4 21:45:35 1996 Ben Pfaff <blp@gnu.org>
+
+ * weighting.stat: Tests for proper ligatures. Won't work until
+ encodings are correct, of course...
+
+----------------------------------------------------------------------
+Local Variables:
+mode: change-log
+version-control: never
+End:
--- /dev/null
+## Process this file with automake to produce Makefile.in -*- makefile -*-
+
+bench:
+ make BENCHMARK=1 check
+
+TESTS = syntax
+
+noinst_PROGRAMS = gengarbage
+
+noinst_DATA = sort.data
+sort.data: gengarbage
+ ./gengarbage | head -1000 > $@
+
+EXTRA_DIST = aggregate.stat autorecod.stat beg-data.stat bignum.data \
+bignum.stat compute.stat count.stat crosstabs.stat data-fmts.stat \
+data-list.data data-list.stat descript.stat do-if.stat do-repeat.stat \
+expr.stat file-lab.stat filter.stat flip.stat gengarbage.c \
+inpt-pgm.stat lag.stat list.data list.stat loop.stat mtch-file.stat \
+means.stat mdfy-vars.stat print.stat pcs-if.stat recode.stat \
+repeating.stat reread.data reread.stat sample.stat sort.stat \
+splt-file.stat sys-info.stat t-test.stat tabs.stat temporary.stat \
+time-date.stat vector.stat weighting.data weighting.stat syntax
+
+dist-hook:
+ cp -rp $(srcdir)/expect $(distdir)
+
+DISTCLEANFILES = *.save sort.data pspp.* foo* msgs *.actual
+
+MAINTAINERCLEANFILES = Makefile.in
--- /dev/null
+title 'Test for AGGREGATE procedure'.
+
+data list /x y 1-2.
+begin data.
+13
+27
+30
+12
+26
+11
+10
+28
+29
+14
+15
+end data.
+sort cases by x.
+list.
+aggregate outfile='aggregate.save'/missing=columnwise /document /presorted/break=x(a) /z'label for z'=sum(y)/foo=nu.
+list.
--- /dev/null
+title 'Test for AUTORECODE procedure'.
+
+/* Tries AUTORECODE on some random but similar strings of characters.
+data list /x 1-5(a) y 7.
+begin data.
+lasdj 1 1 3
+asdfk 0 3 <---- These are the numbers that should be produced for a 4
+asdfj 2 4 2
+asdfj 1 4 3
+asdfk 2 3 2
+asdfj 9 4 1
+lajks 9 2 1
+asdfk 0 3 These are the numbers that should be produced for b ----> 4
+asdfk 1 3 3
+end data.
+list.
+autorecode x y into a b/descend.
+
+/* This should produce the values indicated in the data above.
+list.
+
+/* Just to make sure it works on second & subsequent executions,
+/* try it again.
+compute z=trunc(y/2).
+autorecode z into w.
+
+/* This should display:
+/* z 0 0 1 0 1 4 4 0 0
+/* w 1 1 2 1 2 3 3 1 1
+list z w.
--- /dev/null
+title 'Test BEGIN DATA ... END DATA'.
+
+remark EOF
+----------------------------------------------------------------------
+First we show that we can input data with BEGIN DATA/END DATA after
+a procedure.
+----------------------------------------------------------------------
+EOF
+data list /A B 1-2.
+list.
+begin data.
+12
+34
+56
+78
+90
+end data.
+
+remark EOF
+----------------------------------------------------------------------
+Next we show that BEGIN DATA/END DATA work fine on their own as well.
+----------------------------------------------------------------------
+EOF
+data list /A B 1-2.
+begin data.
+09
+87
+65
+43
+21
+end data.
+list.
--- /dev/null
+0
+0.1
+0.5
+0.8
+0.9
+0.999
+1
+2
+3
+4
+5
+12
+123
+1234
+12345
+123456
+1234567
+12345678
+123456789
+1234567890
+19999999999
+199999999999
+1234567890123
+19999999999999
+199999999999999
+1234567890123456
+19999999999999999
+123456789012345678
+1999999999999999999
+12345678901234567890
+199999999999999999999
+1234567890123456789012
+19999999999999999999999
+123456789012345678901234
+1999999999999999999999999
+12345678901234567890123456
+199999999999999999999999999
+1234567890123456789012345678
+19999999999999999999999999999
+123456789012345678901234567890
+1999999999999999999999999999999
+12345678901234567890123456789012
+199999999999999999999999999999999
+1234567890123456789012345678901234
+19999999999999999999999999999999999
+123456789012345678901234567890123456
+1999999999999999999999999999999999999
+12345678901234567890123456789012345678
+199999999999999999999999999999999999999
+1234567890123456789012345678901234567890
+1999999999999999999999999999999999999999
+1e40
+1.1e40
+1.5e40
+1e41
+1e50
+1e100
+1e150
+1e200
+1e250
+1e300
+1.79641e308
--- /dev/null
+title 'Test use of big numbers'.
+
+*** Do the portable output.
+remark EOF
+----------------------------------------------------------------------
+Testing use of big numbers.\n
+The numbers in the data file are designed for IEEE754 double
+format--if your system uses something different then the test needs to
+be adjusted for whatever are big numbers to your system.
+----------------------------------------------------------------------
+EOF
+data list file='bignum.data'/BIGNUM 1-40.
+list.
+
+*** Do the nonportable output for fun.
+remark EOF
+NOCOMP
+SUCCESS?
+----------------------------------------------------------------------
+This test merely shows whether your system can successfully handle
+floating-point overflow. If you get a fatal exception at this point,
+the source needs some editing--glob.c should mask overflow exceptions
+in init_glob(). Again, the numbers are specific to IEEE754 double
+format.
+----------------------------------------------------------------------
+EOF
+descriptives BIGNUM.
+rem-SUCCESS
--- /dev/null
+title 'Test COMPUTE expressions'.
+
+data list /w 1-3(a).
+begin data.
+123
+456
+919
+572
+end data.
+*string y z(a6).
+*compute y=ltrim(lpad(w,6,'*'),'*').
+*compute z=rtrim(rpad(w,6,'*'),'*').
+string z(a6).
+compute x=number(w).
+compute y=number(w,f8).
+compute z=lpad(rpad(substr(string(x,f6),4,1),3,'@'),6,'*').
+compute y=y+1e-10.
+if(x<=456) y=500.
+select if x<=456.
+compute #caseseq=#caseseq+1.
+list.
+list.
--- /dev/null
+title 'Test COUNT transformation'.
+
+data list /v1 to v2 1-4(a).
+begin data.
+1234
+321
+2 13
+4121
+1104
+03 4
+0193
+end data.
+*count c=v1 to v4(1).
+count c=v1 to v2('2',' 4','1').
+list.
--- /dev/null
+clear transformations.
+input program.
+loop a=1 to 1000.
+compute a=trunc(uniform(5)).
+compute b=trunc(uniform(5)).
+compute c=trunc(uniform(5)).
+compute d=trunc(uniform(5)).
+compute e=trunc(uniform(5)).
+compute f=trunc(uniform(5)).
+end case.
+end loop.
+end file.
+end input program.
+select if not ((a=1 and e=3) or (c=2)).
+print /all.
+missing value all (2).
+*crosstabs/missing=report/variables=a to f(0,4)/tables=a by e by f/statistics=all/pivot on.
+crosstabs a by e by f/statistics=all/pivot on.
+execute.
--- /dev/null
+set echo off.
+title 'Test non-binary data input formats'.
+
+data list /a 1-8(a) /* 1
+ ahex 9-16(ahex) /* 2
+ comma 17-24(comma) /* 3
+ dollar 25-32(dollar) /* 4
+ f 33-40(f) /* 5
+ pibhex 41-48(pibhex) /* 6
+ n 49-56(n) /* 7
+ e 57-64(e). /* 8
+formats comma(comma8.2) dollar(dollar8.2).
+print /a ahex comma dollar f pibhex n e.
+
+/* This set of data should produce errors:
+/*
+/* - First line should be error-free.
+/* - Second line should have errors for F, PIBHEX, and N fields.
+/* - Third line should have errors for COMMA, DOLLAR, F, and N fields.
+/* - Fourth line should have errors for F and N fields.
+/*
+/* 2 3 4 5 6 7 8 .
+begin data.
+abcdefgh414243441,2,3.4,$1,2,3.4123456.6100023451234567812345678
+ 4a4b4c4d1,234.56$1234.56 abcd ghjk -12345671234+56
+ 4C4D4E4F1234+56 $1234+56 0 1 abcd 12345e671234e+56
+ 555657581234e+561234e+56 1.2 3 000000001234e67 1234-5
+end data.
+
+data list /date 1-32(date) /* 1
+ time 33-64(time,4). /* 2
+print /date time.
+
+/* This set of data should produce errors:
+/*
+/* 2
+begin data.
+11-july-1982 12:10:55.59
+8-xii-23 55:56:75.105
+end data.
+
+data list /datetime 1-32(datetime,4) /* 1
+ adate 33-64(adate). /* 2
+print /datetime adate.
+/* 2
+begin data.
+7-7-8 12:10:55.5 10/15/1582
+11-jul-1982 9:00 10/01/78
+end data.
+
+data list /jdate 1-32(jdate) /* 1
+ dtime 33-64(dtime). /* 2
+print /jdate dtime.
+/* 2
+begin data.
+1582365 10 15:30:00.32
+1996001 0 8:23:59.99
+end data.
+
+data list /wkday 1-32(wkday) /* 1
+ month 33-64(month). /* 2
+print /wkday month.
+/* 2
+begin data.
+mon xii
+Saturday 12
+thursday march
+ ixiii
+end data.
+
+data list /moyr 1-32(moyr) /* 1
+ qyr 33-64(qyr). /* 2
+print /moyr qyr.
+/* 2
+begin data.
+jan 96 4 q 1986
+mar 1896 1q1600
+end data.
+
+data list /wkyr 1-32(wkyr) /* 1
+ pct 33-64(pct). /* 2
+print /wkyr pct.
+/* 2
+begin data.
+4 wk 97 105%
+52 wk 1996 55.5%
+end data.
+
+data list /dot 1-32(dot) /* 1
+ edate 33-64(edate). /* 2
+formats dot(dot32.3).
+print /dot edate.
+/* 2
+begin data.
+123.456.789,348 1.10.1978
+ 30.12.1996
+end data.
+
+formats dot (comma32.3).
+set decimal comma.
+print /dot.
+execute.
+
+set decimal dot.
+print /dot.
+execute.
+
+data list /sdate 1-32(sdate). /* 1
+print /sdate.
+begin data.
+1923/7/3
+1992.5.2
+end data.
+
+data list /date 1-32.
+compute date = date * 86400.
+print /date (date32).
+begin data.
+1
+50000
+102
+1157
+14288
+87365
+109623
+153211
+152371
+144623
+end data.
+
+data list /date 1-32(date).
+compute jdate = date / 86400.
+print /jdate.
+begin data.
+15-OCT-1582
+06-SEP-1719
+24-JAN-1583
+14-DEC-1585
+26-NOV-1621
+25-DEC-1821
+03-DEC-1882
+06-APR-2002
+18-DEC-1999
+01-OCT-1978
+end data.
+
+set cca 'NPX,PFX,SFX,NSX'.
+set ccb 'NPX.PFX.SFX.NSX'.
+set ccc '-,$,,'.
+set ccd '(.SFR..)'.
+set cce 'asld,adl,lfj,lfs'.
+
+data list /cc 1-32(f).
+print /'cca: ' cc (cca32.2).
+print /'ccb: ' cc (ccb32.2).
+print /'ccc: ' cc (ccc32.2).
+print /'ccd: ' cc (ccd32.2).
+print /'cce: ' cc (cce32.2).
+begin data.
+78.19
+-78.19
+123456789.12
+1e23
+end data.
+
+print /'cca: ' cc (cca16.2).
+print /'ccb: ' cc (ccb16.2).
+print /'ccc: ' cc (ccc16.2).
+print /'ccd: ' cc (ccd16.2).
+print /'cce: ' cc (cce16.2).
+execute.
+
+print /'cca: ' cc (cca8.2).
+print /'ccb: ' cc (ccb8.2).
+print /'ccc: ' cc (ccc8.2).
+print /'ccd: ' cc (ccd8.2).
+print /'cce: ' cc (cce8.2).
+execute.
+
--- /dev/null
+SHORT 2 3 4
+RIGHTLEN 6
+7
+8 TOOLONGLEN
+10 11
+12
--- /dev/null
+title 'Test DATA LIST FREE and DATA LIST LIST'.
+
+remark EOF
+----------------------------------------------------------------------
+There is no test for DATA LIST FIXED since it is imagined that the
+rest of the tests give it a pretty good workout.
+----------------------------------------------------------------------
+EOF
+remark EOF
+----------------------------------------------------------------------
+Testing use of DATA LIST FREE.
+----------------------------------------------------------------------
+EOF
+data list free table file='data-list.data'/A(A8) B C D.
+list.
+
+remark EOF
+----------------------------------------------------------------------
+Testing use of DATA LIST LIST.
+----------------------------------------------------------------------
+EOF
+data list list table file='data-list.data'/A(A8) B C D.
+list.
+
--- /dev/null
+title 'Test DESCRIPTIVES procedure'.
+
+data list / v0 to v16 1-17.
+begin data.
+12128989012389023
+34128080123890128
+56127781237893217
+78127378123793112
+90913781237892318
+37978547878935789
+52878237892378279
+12377912789378932
+26787654347894348
+29137178947891888
+end data.
+
+descript all/stat=all/format=serial.
--- /dev/null
+title 'Test DO IF control structure'.
+
+data list /x y z 1-6.
+begin data.
+000099
+019900
+019820
+001089
+020000
+end data.
+do if x~=2.
+loop i=1 to x.
+do if x=0.
+print /i x z.
+else.
+do if x=1.
+print /i x y.
+else.
+print /i 'Huh?'.
+end if.
+end if.
+end loop.
+end if.
+execute.
--- /dev/null
+title 'Test DO REPEAT control structure'.
+
+set echo on.
+data list file='list.data'/var00001 to var00005 1-5.
+string s1 to s5(a8).
+vector s=s1 to s5.
+do repeat v=var1 to var5/r=region1 to region5/x=0 to 4
+ /y=10 to 6/z='abcd',x'010203','alksdj'+'fklasdjfladsf','al''ksj','iouio'
+ /longname=var00001 to var00005.
+compute v=2**x.
+compute v=x.
+compute r=v.
+compute longname=r.
+compute s(x+1)=z.
+end repeat print.
+list.
+
--- /dev/null
+crosstabs.stat:1: CLEAR TRANSFORMATIONS is not allowed (1) before a command to
+ specify the input program, such as DATA LIST, (2) between FILE TYPE and
+ END FILE TYPE, (3) between INPUT PROGRAM and END INPUT PROGRAM.
+crosstabs.stat:1: warning: This command not executed.
+crosstabs.stat:17: CROSSTABS: Syntax error expecting end of command at
+ `PIVOT'.
+crosstabs.stat:17: warning: This command not executed.
--- /dev/null
+data-fmts.stat:24: data-file error: (columns 33-40, field type F8.0) Field
+ does not form a valid floating-point constant: " abcd ".
+data-fmts.stat:24: data-file error: (columns 41-48, field type PIBHEX8.0)
+ Trailing characters in field: " ghjk ".
+data-fmts.stat:24: data-file error: (columns 49-56, field type N8.0) All
+ characters in field must be digits. Field actually contained:
+ "-1234567".
+data-fmts.stat:25: data-file error: (columns 17-24, field type COMMA8.0)
+ Trailing characters in field: "1234+56 ".
+data-fmts.stat:25: data-file error: (columns 25-32, field type DOLLAR8.0)
+ Trailing characters in field: "$1234+56".
+data-fmts.stat:25: data-file error: (columns 33-40, field type F8.0) Trailing
+ characters in field: " 0 1 ".
+data-fmts.stat:25: data-file error: (columns 49-56, field type N8.0) All
+ characters in field must be digits. Field actually contained:
+ "12345e67".
+data-fmts.stat:26: data-file error: (columns 33-40, field type F8.0) Trailing
+ characters in field: " 1.2 3 ".
+data-fmts.stat:26: data-file error: (columns 49-56, field type N8.0) All
+ characters in field must be digits. Field actually contained:
+ "1234e67 ".
--- /dev/null
+data-list.data:2: warning: LIST: Missing value(s) for all variables from C
+ onward. These will be filled with the system-missing value or blanks,
+ as appropriate.
+data-list.data:3: warning: LIST: Missing value(s) for all variables from B
+ onward. These will be filled with the system-missing value or blanks,
+ as appropriate.
+data-list.data:4: data-file error: (columns 3-10, field type F8.0) Field does
+ not form a valid floating-point constant: "TOOLONGL".
+data-list.data:4: warning: LIST: Missing value(s) for all variables from C
+ onward. These will be filled with the system-missing value or blanks,
+ as appropriate.
+data-list.data:5: warning: LIST: Missing value(s) for all variables from C
+ onward. These will be filled with the system-missing value or blanks,
+ as appropriate.
+data-list.data:6: warning: LIST: Missing value(s) for all variables from B
+ onward. These will be filled with the system-missing value or blanks,
+ as appropriate.
--- /dev/null
+expr.stat:10: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:10: warning: This command not executed.
+expr.stat:11: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:11: warning: This command not executed.
+expr.stat:12: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:12: warning: This command not executed.
+expr.stat:15: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:15: warning: This command not executed.
+expr.stat:16: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:16: warning: This command not executed.
+expr.stat:17: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:17: warning: This command not executed.
+expr.stat:18: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:18: warning: This command not executed.
+expr.stat:20: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:20: warning: This command not executed.
+expr.stat:21: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:21: warning: This command not executed.
+expr.stat:22: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:22: warning: This command not executed.
+expr.stat:23: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:23: warning: This command not executed.
+expr.stat:25: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:25: warning: This command not executed.
+expr.stat:26: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:26: warning: This command not executed.
+expr.stat:28: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:28: warning: This command not executed.
+expr.stat:29: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:29: warning: This command not executed.
+expr.stat:30: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:30: warning: This command not executed.
+expr.stat:32: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:32: warning: This command not executed.
+expr.stat:33: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:33: warning: This command not executed.
+expr.stat:34: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:34: warning: This command not executed.
+expr.stat:35: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:35: warning: This command not executed.
+expr.stat:36: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:36: warning: This command not executed.
+expr.stat:37: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:37: warning: This command not executed.
+expr.stat:38: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:38: warning: This command not executed.
+expr.stat:39: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:39: warning: This command not executed.
+expr.stat:40: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:40: warning: This command not executed.
+expr.stat:41: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:41: warning: This command not executed.
+expr.stat:42: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:42: warning: This command not executed.
+expr.stat:43: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:43: warning: This command not executed.
+expr.stat:44: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:44: warning: This command not executed.
+expr.stat:45: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:45: warning: This command not executed.
+expr.stat:46: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:46: warning: This command not executed.
+expr.stat:47: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:47: warning: This command not executed.
+expr.stat:48: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:48: warning: This command not executed.
+expr.stat:49: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:49: warning: This command not executed.
+expr.stat:50: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:50: warning: This command not executed.
+expr.stat:51: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:51: warning: This command not executed.
+expr.stat:52: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:52: warning: This command not executed.
+expr.stat:53: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:53: warning: This command not executed.
+expr.stat:54: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:54: warning: This command not executed.
+expr.stat:55: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:55: warning: This command not executed.
+expr.stat:56: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:56: warning: This command not executed.
+expr.stat:57: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:57: warning: This command not executed.
+expr.stat:58: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:58: warning: This command not executed.
+expr.stat:59: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:59: warning: This command not executed.
+expr.stat:60: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:60: warning: This command not executed.
+expr.stat:61: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:61: warning: This command not executed.
+expr.stat:63: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:63: warning: This command not executed.
+expr.stat:64: The identifier(s) specified do not form a valid command name:
+ EVAL.
+expr.stat:64: warning: This command not executed.
--- /dev/null
+loop.stat:12: warning: BREAK: BREAK not enclosed in DO IF structure.
--- /dev/null
+mdfy-vars.stat:22: RENAME VARIABLES: Duplicate variable name `T2' after
+ renaming.
+mdfy-vars.stat:22: warning: This command not executed.
--- /dev/null
+MEANS VARIABLES=V1(1,4) V2(1,9) V3(LO,HI)
+ TABLES=V1 BY V2 BY V3
--- /dev/null
+data-list.data:1: data-file error: (columns 1-8, field type F8.0) Field does
+ not form a valid floating-point constant: "SHORT ".
+data-list.data:1: warning: LIST: The expression on PRINT SPACE evaluated to -
+ 2147483648. It's not possible to PRINT SPACE a negative number of
+ lines.
+data-list.data:2: data-file error: (columns 1-8, field type F8.0) Field does
+ not form a valid floating-point constant: "RIGHTLEN".
+data-list.data:4: warning: LIST: The expression on PRINT SPACE evaluated to -
+ 2147483648. It's not possible to PRINT SPACE a negative number of
+ lines.
+data-list.data:4: data-file error: (columns 3-10, field type F8.0) Field does
+ not form a valid floating-point constant: "TOOLONGL".
+data-list.data:6: warning: LIST: The expression on PRINT SPACE evaluated to -
+ 2147483648. It's not possible to PRINT SPACE a negative number of
+ lines.
+data-list.data:1: data-file error: (columns 1-8, field type F8.0) Field does
+ not form a valid floating-point constant: "SHORT ".
+data-list.data:2: data-file error: (columns 1-8, field type F8.0) Field does
+ not form a valid floating-point constant: "RIGHTLEN".
+data-list.data:2: warning: LIST: Missing value(s) for all variables from C
+ onward. These will be filled with the system-missing value or blanks,
+ as appropriate.
+data-list.data:3: warning: LIST: Missing value(s) for all variables from B
+ onward. These will be filled with the system-missing value or blanks,
+ as appropriate.
+data-list.data:4: data-file error: (columns 3-10, field type F8.0) Field does
+ not form a valid floating-point constant: "TOOLONGL".
+data-list.data:4: warning: LIST: Missing value(s) for all variables from C
+ onward. These will be filled with the system-missing value or blanks,
+ as appropriate.
+data-list.data:5: warning: LIST: Missing value(s) for all variables from C
+ onward. These will be filled with the system-missing value or blanks,
+ as appropriate.
+data-list.data:6: warning: LIST: Missing value(s) for all variables from B
+ onward. These will be filled with the system-missing value or blanks,
+ as appropriate.
--- /dev/null
+T-TEST
+ PAIRS=V1 V2 WITH V3 V4 (PAIRED)
+ MISSING=ANALYSIS EXCLUDE
+ FORMAT=LABELS
+Missing value
+Missing value
+Missing value
+ Number of 2-tail
+ Variable pairs Corr Sig Mean SD SE of Mean
+---------------------------------------------------------------
+V1 0.0000 1.1909 0.3591
+ 11.0000 -0.3835 0.8779
+V3 0.0000 2.4680 0.7441
+---------------------------------------------------------------
+
+
+
+ Paired Differences |
+ Mean SD SE of Mean | t-value df 2-tail Sig
+--------------------------------------|---------------------------
+ -1.1818 3.1247 0.9421 | -1.2544 10.0000 0.2382
+95pc CI ( -3.2810, 0.9174) |
+
--- /dev/null
+vector.stat:24: LIST: 6 is not a valid index value for vector X. The result
+ will be set to the empty string.
--- /dev/null
+weighting.stat:6: warning: VALUE LABELS: Truncating value label to 60
+ characters.
--- /dev/null
+title 'Test optimization of constant expressions'.
+
+remark EOF
+----------------------------------------------------------------------
+Testing ability of stat to optimize constant expressions.
+stat must have been compiled with debugging enabled in order to
+run these tests.
+----------------------------------------------------------------------
+EOF
+eval 1+2+3+(4*5).
+eval (4-2+6.323)*(0/4-1)*(1-3+abs(-9.78)).
+eval 3**(2**(8/2*3/4)).
+
+* Truth tables.
+eval 0 and 0.
+eval 0 and 1.
+eval 1 and 0.
+eval 1 and 1.
+
+eval 0 or 0.
+eval 0 or 1.
+eval 1 or 0.
+eval 1 or 1.
+
+eval not 0.
+eval not 1.
+
+eval (1 gt 2) and (2 gt 1).
+eval (7/8+1 lt 2) or (2-1/6 lt 1).
+eval not (7 ne 6).
+
+eval -(7/8).
+eval abs(-6.5).
+eval arcos(1.0).
+eval arcos(sqrt(2)/2).
+eval arsin(sqrt(2)/2).
+eval artan(0).
+eval artan(1.0).
+eval cos(3.141592654/4).
+eval cos(3.141592654/6).
+eval exp(1).
+eval exp(-1).
+eval lg10(10).
+eval lg10(128.910).
+eval ln(2.71828182846).
+eval ln(50).
+eval mod10(128.910).
+eval rnd(128.9).
+eval rnd(-128.9).
+eval rnd(128.1).
+eval rnd(-128.1).
+eval rnd(128).
+eval rnd(-128).
+eval rnd(128.5).
+eval rnd(-128.5).
+eval sin(2*3.141592654).
+eval sin(3.141592654/6).
+eval tan(0).
+eval tan(3.141592654/8).
+eval trunc(3.141592654).
+eval trunc(-9.99).
+
+eval 'x'.
+eval concat('x','y').
+
--- /dev/null
+title 'Test FILE LABEL, DOCUMENT, DROP DOCUMENTS'.
+
+/* Set up a dummy active file in memory.
+data list /x 1 y 2.
+begin data.
+16
+27
+38
+49
+50
+end data.
+
+/* Add value labels for some further testing of value labels.
+value labels x y 1 'first label' 2 'second label' 3 'third label'.
+add value labels x 1 'first label mark two'.
+
+/* Add a file label and a few documents.
+file label This is a test file label.
+document First line of a document
+This is the second very long line of a document in an attempt to overflow the input buffer with a really long line
+Note that the last line should end with a period: .
+
+/* Display the documents.
+display documents.
+display file label. /* undocumented feature of PSPP
+
+/* Save the active file then get it and display the documents again.
+save 'foo.save'.
+get 'foo.save'.
+display documents.
+display file label. /* undocumented feature of PSPP
+
+/* There is an interesting interaction that occurs if the `execute'
+/* command below. What happens is that an error message is output
+/* at the next `save' command that `foo.save' is already open for
+/* input. This is because the `get' hasn't been executed yet and
+/* therefore PSPP would be reading from and writing to the same
+/* file at once, which is obviously a Bad Thing. But `execute'
+/* here clears up that potential problem.
+execute.
+
+/* Add another (shorter) document and try again.
+document There should be another document now.
+display documents.
+
+/* Save and get.
+save 'foo.save'.
+get 'foo.save'.
+display documents.
+display file label. /* undocumented feature of PSPP
+
+/* Done.
+
--- /dev/null
+title 'Test FILTER'.
+
+data list /x 1-2.
+begin data.
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+end data.
+compute filter_$ = mod(x,2).
+filter by filter_$.
+list.
+compute filter_$ = 1 - filter_$.
+list.
+
--- /dev/null
+data list /n 1 (a) a b c d 2-9.
+list.
+begin data.
+v 1 2 3 4 5
+w 6 7 8 910
+x1112131415
+y1617181920
+z2122232425
+end data.
+flip newnames=n.
+list.
+flip.
+list.
--- /dev/null
+/* gengarbage - Generates 127-character lines of random digits.
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ Written by Ben Pfaff <blp@gnu.org>.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <time.h>
+
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+
+int
+main (void)
+{
+ srand (time (0));
+ for (;;)
+ {
+ int c;
+
+ for (c = 0; c < 127; c++)
+ putchar ('0' + rand() % 10);
+ putchar ('\n');
+ }
+ exit (EXIT_SUCCESS);
+}
--- /dev/null
+/*
+/*
+/* Tests for INPUT PROGRAM.
+/*
+/*
+
+remark EOF
+----------------------------------------------------------------------
+Testing use of INPUT PROGRAM.
+----------------------------------------------------------------------
+EOF
+input program.
+data list free/A #B.
+end case.
+data list free/C D.
+end case.
+data list fixed/#E 2.
+end case.
+end input program.
+list.
+
+begin data.
+1 2 3 4 5
+6 7 8 9 0
+end data.
+
--- /dev/null
+title 'Test LAG'.
+
+data list /w 1.
+begin data.
+1
+2
+3
+4
+5
+end data.
+
+compute x=lag(w,1).
+compute y=lag(x).
+compute z=lag(w,2).
+list.
+
--- /dev/null
+7675324663485137890734831064091758592958428152951137532659418752338157675324663485137890734831064091758592958428152951137532658
+8886930894241775423783341867603681475586900279731022668741684555067148886930894241775423783341867603681475586900279731022668746
+4926115079091871527264278522424838562069980278342188725586260041526024926115079091871527264278522424838562069980278342188725589
+8198488920231958758793320014917736896880133221016088440640236265727008198488920231958758793320014917736896880133221016088440641
+4527778987095637298455415166506950647746645120849887640160659505391494527778987095637298455415166506950647746645120849887640166
+2399619670777327606635251150735186059118186910880465190328196246896752399619670777327606635251150735186059118186910880465190325
+1667799691266476994404743989237315394276412079760310706395103299441571667799691266476994404743989237315394276412079760310706394
+1623914684196892316847117011543627119597908599740525246164191508013201623914684196892316847117011543627119597908599740525246168
+3681393233760129489113121829599857288501099123283196628714148965084573681393233760129489113121829599857288501099123283196628710
+6418731145431082994856816505035997982096732150359754547299618487885306418731145431082994856816505035997982096732150359754547297
+2284534083749507716651086429071219765163759829793478587147234341234422284534083749507716651086429071219765163759829793478587149
+6617637452040749181349911788974757522469664838867901014182486697572956617637452040749181349911788974757522469664838867901014185
+9865713582686612007222010782682778269839299871393015436402026985409089865713582686612007222010782682778269839299871393015436406
+1163234537762200807794960252447773098443340762844734350378750440902951163234537762200807794960252447773098443340762844734350377
+9981663637563833300035426136702893989464123526087380834445132807905549981663637563833300035426136702893989464123526087380834449
+6821567746059103565005738960248842198995590602288700476282307110291686821567746059103565005738960248842198995590602288700476284
+0952774952675261545955280805340357545942400156201918638742082134243330952774952675261545955280805340357545942400156201918638748
+1641790193211861509106839217119496865877118406579619492614744114869021641790193211861509106839217119496865877118406579619492615
+3763182871580174789328837194968536876074344562932187960893275881656443763182871580174789328837194968536876074344562932187960891
+2046820753062224045535890932721137819807333757171926425442973439426792046820753062224045535890932721137819807333757171926425441
+7970620091940385928762632764618525899890186135929797170456339589318347970620091940385928762632764618525899890186135929797170458
+4841176017025105774506500896252757076690392034601283834048308843632644841176017025105774506500896252757076690392034601283834045
+6949973797990956291072158123887473582962673878519619834868801568536326949973797990956291072158123887473582962673878519619834868
+1396285996535489440816124700682933874365128786823824758133461156649721396285996535489440816124700682933874365128786823824758138
+0700489524358208358697349450036208378421878800636427151211185320194660700489524358208358697349450036208378421878800636427151218
--- /dev/null
+title 'Test LIST procedure.'
+
+*** Single lines.
+remark EOF
+----------------------------------------------------------------------
+Testing use of LIST in single-line cases.
+----------------------------------------------------------------------
+EOF
+data list file='weighting.data'/AVAR 1-5 BVAR 6-10.
+weight by BVAR.
+list.
+*list /cases=from 5 to 20 by 2 /format numbered.
+list /format numbered weight.
+
+*** Multiple lines.
+remark EOF
+----------------------------------------------------------------------
+Testing use of LIST in multi-line cases.
+----------------------------------------------------------------------
+EOF
+data list file='list.data' notable /X000 to X126 1-127.
+*list /cases=from 1 to 25 by 5 /format numbered.
+list x000 to x030.
+list /cases=from 1 to 25.
+
--- /dev/null
+title 'Test LOOP procedure'.
+
+data list /x 1 y 2 z 3.
+begin data.
+125
+256
+397
+401
+end data.
+loop i=y to z by abs(z-y)/(z-y).
+print /x i.
+break. /* Generates warning.
+end loop.
+execute.
--- /dev/null
+title 'Test MODIFY VARS, RENAME VARIABLES'.
+
+/* Note that these are not quite in alphabetic order.
+data list /a b c d e f g h i j k m n o p l q r s t u v w x y z 1-26 (a).
+
+/* Dummy data that's not actually examined.
+begin data.
+ABCDEFGHIJKLMNOPQRSTUVWXYZ
+NOPQRSTUVWXYZABCDEFGHIJKLM
+end data.
+
+/* This should display z y x w s q p n m l k j i h t7 t6 t5 t4 t3 t2 t1.
+modify vars /reorder=backward alpha/drop o r t u v/rename (a to g=t1 to t7).
+display var.
+
+/* This should display z y x w s q p n m l x14 x13 x12 x11 t1 t6 t5 t4 t3
+/* t2 t7.
+rename variables (t1=t7)(t7=t1)(h i j k=x11 to x14).
+display var.
+
+/* The command below should fail with an error message.
+rename variables (t1=t2)(t2=t2).
+
+/* This should display y x w s q p n m l x14 x13 x12 x11 t1 t6 t5 t3 t7.
+modify vars /reorder=forward positional/keep y to t5 t3 x14 t7.
+display var.
+
+/* This should display t7 x11 q s x y. */
+modify vars /reorder=backward positional/keep x s y x11 t7 q.
+display var.
+
--- /dev/null
+title 'Preliminary test for MEANS procedure'.
+
+data list /v1 to v4 1-4.
+begin data.
+1234
+321
+2 13
+4121
+1104
+03 4
+0193
+end data.
+means variables=v1(1,4) v2(1,9) v3(lo,hi)
+ /tables=v1 by v2 by v3.
--- /dev/null
+title 'Test MATCH FILES'.
+data list /x a b c 1-4.
+begin data.
+0243
+1983
+2924
+2853
+3195
+4862
+2056
+end data.
+save 'mtf-1.save'.
+
+data list /x d e f 1-4.
+begin data.
+0837
+1834
+2843
+2049
+3853
+5029
+2853
+end data.
+save 'mtf-2.save'.
+
+data list /x g h i 1-4.
+begin data.
+0743
+1823
+6845
+2875
+3945
+4341
+2723
+end data.
+
+match files /file='mtf-1.save' /file='mtf-2.save' /table=* /by x.
+list.
+
+data list /x g h i 1-4.
+begin data.
+0743
+1823
+6845
+2875
+3945
+4341
+2723
+end data.
+
+match files /file='mtf-1.save' /file='mtf-2.save' /file=* /by x.
+list.
+
+match files/file='mtf-1.save' /file='mtf-2.save'/by x.
+list.
--- /dev/null
+title 'Test PROCESS IF utility'.
+
+data list /x 1-2.
+begin data.
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+end data.
+process if mod(x,2) ~= 0.
+list.
+compute x = x*3.
+process if mod(x,2) = 0.
+list.
+
--- /dev/null
+title 'Test PRINT transformation'.
+
+remark EOF
+----------------------------------------------------------------------
+There is no test for DATA LIST FIXED since it is imagined that the
+rest of the tests give it a pretty good workout.
+----------------------------------------------------------------------
+EOF
+remark EOF
+----------------------------------------------------------------------
+Testing use of DATA LIST FREE.
+----------------------------------------------------------------------
+EOF
+data list free table file='data-list.data'/A B C D.
+print outfile="foo" table/A(f8.2) '/' B(e8.2) '/' C(n10) '/' D(rbhex16) '/'.
+print space a.
+print outfile="foo" /a b c d.
+list.
+
+remark EOF
+----------------------------------------------------------------------
+Testing use of DATA LIST LIST.
+----------------------------------------------------------------------
+EOF
+data list list table file='data-list.data'/A B C D.
+print table/A B C D.
+list.
+
--- /dev/null
+title 'Test RECODE transformation'.
+
+data list /A B 1-20(a).
+begin data.
+12345678901234567890
+a b
+jkl; aklsdf
+aklsd ioqeur
+ ioquer pasdflk
+end data.
+*recode A B(1,2,3,4=5)(5 thru hi=9)(lo thru 10=4) into A D
+ /A B(lo thru hi=copy)(sysmis=0)(else=sysmis) into C D.
+string c d(a10).
+leave c d.
+recode A B('a'='b')('jkl;'='jkl;p')('ioqeur'='sdjfkla') into C D.
+*recode A B(1,2,3,4="asdf")(else="xyzw")(sysmis="bdfg") into C D.
+*recode A B("asdf"=copy)(convert)("lkjf"=sysmis)(convert)(else=123) into C D.
+*recode A B(1,3,5,6,7=COPY)(SYSMIS=5e5) into C D.
+*recode a (convert)('xx'=50) into b.
+list.
+
--- /dev/null
+title 'Test REPEATING DATA utility'.
+
+input program.
+data list /x 1 n 3.
+repeating data starts=11-20 /continues=2-11 /length=10 /occurs=n
+ /id=1=x /data=name 1-5 (a) number 6-10.
+end input program.
+
+begin data.
+1 3 foo 1
+1bar 2
+1baz 3
+end data.
+
+list.
+
--- /dev/null
+5510ACME 5
+ 5MISC 8901
+8974ACME 9
+1928ACME 4
+ 6MISC 8973
--- /dev/null
+title 'Test REREAD transformation'.
+
+file handle INPUT /name='reread.data'.
+
+input program.
+ data list file=INPUT/BRAND 5-10(a).
+ do if(BRAND='ACME').
+ reread.
+ data list /PART 1-4 COUNT 11-15.
+ else if(BRAND='MISC').
+ reread.
+ data list /PART 11-15 COUNT 1-4.
+ end if.
+ end case.
+end input program.
+list.
--- /dev/null
+title 'Test SAMPLE utility'.
+
+set seed=random.
+data list /a 1-2.
+begin data.
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+end data.
+sample .5.
+n 5.
+list.
--- /dev/null
+title 'Test SORT procedure'.
+
+data list file='sort.data' notable /X000 to X126 1-127(a).
+*data list file='sort.data' notable /X000 to X005 1-6(a).
+sort by X000 to x005.
+print /X000 to X005.
+execute.
+
--- /dev/null
+title 'Test SPLIT FILE utility'.
+
+data list /x 1 y 2.
+begin data.
+12
+16
+17
+19
+15
+14
+27
+20
+26
+25
+28
+29
+24
+end data.
+split file by x.
+formats x(e20.2).
+value labels x 1 'This is the value label for value 1.'
+ 2 'This is the value label for value 2.'.
+descriptives y.
--- /dev/null
+#! /bin/sh
+set -e
+RESULT=pass
+
+srcdir=${srcdir:-.}
+for x in `cd $srcdir; echo *.stat *.data`; do
+ if [ ! -e $x ]; then
+ ln -s $srcdir/$x .
+ fi
+done
+
+rm -f *.actual
+if [ -z "$BENCHMARK" ]; then
+ for x in *.stat; do
+ echo -n "$x ... "
+ ../src/pspp --testing-mode $x >$x.actual
+ if [ -f $srcdir/expect/$x ]; then
+ if diff -u $srcdir/expect/$x $x.actual; then
+ echo "pass"; rm $x.actual
+ else
+ echo "FAIL"; RESULT=fail
+ fi
+ else
+ if [ -s $x.actual ]; then
+ echo "FAIL"; RESULT=fail
+ else
+ echo "pass"; rm $x.actual
+ fi
+ fi
+ done
+else
+ mkdir benchmark || true
+ rm -f benchmark/*
+ for x in *.stat; do
+ echo -n "$x ... "
+ ../src/pspp --testing-mode $x > benchmark/$x
+ if [ ! -s benchmark/$x ]; then
+ rm benchmark/$x
+ fi
+ echo
+ done
+fi
+
+for x in *.stat *.data; do
+ if [ -h $x ]; then
+ rm $x
+ fi
+done
+
+if [ $RESULT = fail ]; then exit 1; fi
+
--- /dev/null
+title 'Test SYSFILE INFO, DISPLAY utilities'.
+
+/* Run file-label.stat before running this syntax file, as it
+/* creates foo.save.
+sysfile info file='foo.save'.
+
+get 'foo.save'.
+display names.
+display index.
+display labels.
+display variables.
+display dictionary.
+
--- /dev/null
+title 'Preliminary test for T-TEST procedure'.
+
+data list /v1 to v4 1-4.
+begin data.
+1234
+321
+2 13
+4121
+1104
+03 4
+0193
+end data.
+t-test v1 v2 with v3 v4 (paired).
--- /dev/null
+title 'Test handling of tab characters in user data'.
+
+/* The program contains separate code for the case of a single
+/* tab on a line and multiple tabs, so we try both below.
+data list /x 1-80 (a).
+begin data.
+ 1 12 123 1234 12345 123456 1234567 12345678
+asdf jkl;
+end data.
+print /x.
+execute.
+
--- /dev/null
+title 'Test TEMPORARY transformation'.
+
+set echo on/screen on.
+data list /z 1 x 2.
+formats x(f3).
+split file by z.
+list.
+begin data.
+12
+13
+14
+15
+16
+23
+24
+25
+26
+27
+28
+end data.
+compute x=x+1.
+temporary.
+compute x=x+1.
+compute y=x+1.
+sel if y<7.
+descriptives x y.
+list.
+compute x=x-10.
+list.
--- /dev/null
+title 'Test time and date input and output formats'.
+
+data list fixed
+ /a(date20)/b(adate20)/c(jdate20)/d(qyr20)/e(moyr20)/f(wkyr20)/g(wkday20)
+ /h(month20)/i(time20.2)/j(dtime20.2)/k(datetime24.2).
+begin data.
+01-oct-78
+10/1/78
+78101
+3q96
+nov 52
+38wk23
+saturday
+xi
+10:01
+4 5:12.9
+01-feb-1903 04:05:06.07
+end data.
+print /a to e.
+print /f to k.
+execute.
+
+data list /x 1.
+begin data.
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+end data.
+compute y=$time.
+formats y(datetime25).
+list.
+compute z=$time.
+formats z(datetime25).
+list.
+compute p=$time.
+formats p(datetime25).
+list.
+
--- /dev/null
+title 'Test VECTOR utility'.
+
+data list /c 1(a).
+begin data.
+5
+3
+4
+1
+2
+end data.
+
+string x1 to x5 y1 to y5(a1).
+vector x=x1 to x5.
+*formats all(f1).
+compute x(number(c))=c.
+leave x1 to x5.
+list.
+
+vector x=x1 to x5.
+vector y=y1 to y5.
+*formats all(f1).
+compute y(number(c))=x(number(c)+1).
+display vector.
+list.
--- /dev/null
+ 18 1
+ 19 7
+ 20 26
+ 21 76
+ 22 57
+ 23 58
+ 24 38
+ 25 38
+ 26 30
+ 27 21
+ 28 23
+ 29 24
+ 30 23
+ 31 14
+ 32 21
+ 33 21
+ 34 14
+ 35 14
+ 36 17
+ 37 11
+ 38 16
+ 39 14
+ 40 15
+ 41 14
+ 42 14
+ 43 8
+ 44 15
+ 45 10
+ 46 12
+ 47 13
+ 48 13
+ 49 5
+ 50 5
+ 51 3
+ 52 7
+ 53 6
+ 54 2
+ 55 2
+ 56 2
+ 57 3
+ 58 1
+ 59 3
+ 61 1
+ 62 3
+ 63 1
+ 64 1
+ 65 2
+ 70 1
+ 78 1
+ 79 1
+ 80 1
+ 94 1
\ No newline at end of file
--- /dev/null
+title 'Test WEIGHT'.
+
+data list file='weighting.data'/AVAR 1-5 BVAR 6-10.
+weight by BVAR.
+value labels avar 18 'This is a value label that is really long so it takes up lots of room.'
+ 19 'flustered and flim-flammed by fields'.
+descriptives AVAR /statistics all /format serial.
+frequencies AVAR /statistics all /format condensed.
projects / pspp / commitdiff
