From 4944c86a9318bc5b5578ab145a95c116ffd2c9fd Mon Sep 17 00:00:00 2001 From: John Darrington Date: Wed, 10 Dec 2003 23:27:28 +0000 Subject: [PATCH] checkin of 0.3.0 --- AUTHORS | 7 + COPYING | 339 + ChangeLog | 1751 +++++ INSTALL | 176 + Makefile.am | 29 + NEWS | 260 + ONEWS | 540 ++ README | 18 + THANKS | 12 + TODO | 334 + acconfig.h | 84 + acinclude.m4 | 433 ++ config/ChangeLog | 158 + config/Makefile.am | 18 + config/devices | 165 + config/html-prologue | 23 + config/papersize | 60 + config/ps-prologue | 75 + configure.in | 241 + doc/ChangeLog | 481 ++ doc/Makefile.am | 11 + doc/mdate-sh | 91 + doc/pspp.man | 45 + doc/pspp.texi | 9832 +++++++++++++++++++++++++++++ doc/texinfo.tex | 4424 +++++++++++++ examples/ChangeLog | 15 + examples/descript.stat | 29 + intl/ChangeLog | 1026 +++ intl/Makefile.in | 214 + intl/VERSION | 1 + intl/bindtextdom.c | 199 + intl/cat-compat.c | 262 + intl/dcgettext.c | 593 ++ intl/dgettext.c | 59 + intl/explodename.c | 181 + intl/finddomain.c | 189 + intl/gettext.c | 70 + intl/gettext.h | 105 + intl/gettextP.h | 73 + intl/hash-string.h | 63 + intl/intl-compat.c | 76 + intl/l10nflist.c | 409 ++ intl/libgettext.h | 182 + intl/linux-msg.sed | 100 + intl/loadinfo.h | 58 + intl/loadmsgcat.c | 199 + intl/localealias.c | 378 ++ intl/po2tbl.sed.in | 102 + intl/textdomain.c | 106 + intl/xopen-msg.sed | 104 + lib/ChangeLog | 30 + lib/Makefile.am | 6 + lib/dcdflib/COPYING | 41 + lib/dcdflib/ChangeLog | 32 + lib/dcdflib/Makefile.am | 13 + lib/dcdflib/README | 5 + lib/dcdflib/cdflib.h | 80 + lib/dcdflib/dcdflib.c | 9093 ++++++++++++++++++++++++++ lib/dcdflib/ipmpar.c | 97 + lib/gmp/COPYING.LIB | 481 ++ lib/gmp/ChangeLog | 29 + lib/gmp/INSTALL | 43 + lib/gmp/Makefile.am | 11 + lib/gmp/extract-dbl.c | 161 + lib/gmp/gmp-impl.h | 374 ++ lib/gmp/gmp-mparam.h | 27 + lib/gmp/gmp.h | 632 ++ lib/gmp/longlong.h | 1410 +++++ lib/gmp/memory.c | 98 + lib/gmp/mp_clz_tab.c | 40 + lib/gmp/mpf/Makefile.am | 9 + lib/gmp/mpf/clear.c | 36 + lib/gmp/mpf/get_str.c | 501 ++ lib/gmp/mpf/iset_d.c | 40 + lib/gmp/mpf/set_d.c | 48 + lib/gmp/mpf/set_dfl_prec.c | 41 + lib/gmp/mpn/Makefile.am | 10 + lib/gmp/mpn/add_n.c | 63 + lib/gmp/mpn/addmul_1.c | 66 + lib/gmp/mpn/cmp.c | 57 + lib/gmp/mpn/divrem.c | 246 + lib/gmp/mpn/get_str.c | 212 + lib/gmp/mpn/inlines.c | 4 + lib/gmp/mpn/lshift.c | 88 + lib/gmp/mpn/mp_bases.c | 550 ++ lib/gmp/mpn/mul.c | 153 + lib/gmp/mpn/mul_1.c | 60 + lib/gmp/mpn/mul_n.c | 402 ++ lib/gmp/mpn/sub_n.c | 63 + lib/gmp/mpn/submul_1.c | 66 + lib/julcal/ChangeLog | 49 + lib/julcal/Makefile.am | 11 + lib/julcal/README | 5 + lib/julcal/julcal.c | 183 + lib/julcal/julcal.h | 15 + lib/misc/ChangeLog | 148 + lib/misc/Makefile.am | 16 + lib/misc/alloca.c | 178 + lib/misc/getdelim.c | 72 + lib/misc/getline.c | 32 + lib/misc/getopt.c | 754 +++ lib/misc/getopt1.c | 183 + lib/misc/memchr.c | 199 + lib/misc/memcmp.c | 364 ++ lib/misc/memcpy.c | 20 + lib/misc/memmem.c | 42 + lib/misc/memmove.c | 36 + lib/misc/memset.c | 29 + lib/misc/qsort.c | 257 + lib/misc/stpcpy.c | 47 + lib/misc/strcasecmp.c | 33 + lib/misc/strerror.c | 48 + lib/misc/strncasecmp.c | 37 + lib/misc/strpbrk.c | 38 + lib/misc/strstr.c | 24 + lib/misc/strtok_r.c | 62 + lib/misc/strtol.c | 368 ++ lib/misc/strtoul.c | 22 + po/ChangeLog | 53 + po/Makefile.in.in | 247 + po/POTFILES.in | 138 + po/pspp.pot | 5355 ++++++++++++++++ pref.h.orig | 268 + reconfigure | 61 + src/ChangeLog | 7067 +++++++++++++++++++++ src/Makefile.am | 87 + src/aggregate.c | 1523 +++++ src/alloc.c | 122 + src/alloc.h | 31 + src/apply-dict.c | 184 + src/approx.h | 59 + src/ascii.c | 1631 +++++ src/autorecode.c | 342 + src/avl.c | 1122 ++++ src/avl.h | 142 + src/bitvector.h | 45 + src/cases.c | 129 + src/cases.h | 42 + src/cmdline.c | 257 + src/command.c | 791 +++ src/command.def | 134 + src/command.h | 49 + src/compute.c | 477 ++ src/correlations.q | 166 + src/count.c | 641 ++ src/crosstabs.q | 3311 ++++++++++ src/data-in.c | 1591 +++++ src/data-in.h | 59 + src/data-list.c | 1935 ++++++ src/data-out.c | 1231 ++++ src/debug-print.h | 54 + src/descript.q | 866 +++ src/dfm.c | 718 +++ src/dfm.h | 44 + src/do-if.c | 333 + src/do-ifP.h | 83 + src/error.c | 517 ++ src/error.h | 90 + src/expr-evl.c | 1395 ++++ src/expr-opt.c | 1142 ++++ src/expr-prs.c | 1805 ++++++ src/expr.h | 44 + src/exprP.h | 296 + src/file-handle.h | 99 + src/file-handle.q | 362 ++ src/file-type.c | 729 +++ src/filename.c | 881 +++ src/filename.h | 73 + src/flip.c | 549 ++ src/font.h | 141 + src/format.c | 343 + src/format.def | 65 + src/format.h | 92 + src/formats.c | 165 + src/frequencies.g | 89 + src/frequencies.q | 1818 ++++++ src/get.c | 1610 +++++ src/getline.c | 519 ++ src/getline.h | 117 + src/glob.c | 431 ++ src/groff-font.c | 1010 +++ src/hash.c | 344 + src/hash.h | 95 + src/heap.c | 269 + src/heap.h | 52 + src/html.c | 623 ++ src/htmlP.h | 38 + src/include.c | 76 + src/inpt-pgm.c | 465 ++ src/inpt-pgm.h | 38 + src/lexer.c | 1195 ++++ src/lexer.h | 133 + src/list.q | 781 +++ src/log.h | 38 + src/loop.c | 612 ++ src/magic.c | 33 + src/magic.h | 45 + src/main.c | 154 + src/main.h | 28 + src/matrix-data.c | 2020 ++++++ src/matrix.c | 302 + src/matrix.h | 96 + src/means.q | 409 ++ src/mis-val.c | 409 ++ src/misc.c | 38 + src/misc.h | 108 + src/modify-vars.c | 522 ++ src/numeric.c | 213 + src/output.c | 1324 ++++ src/output.h | 289 + src/pfm-read.c | 1065 ++++ src/pfm-write.c | 510 ++ src/pfm.h | 56 + src/pool.c | 734 +++ src/pool.h | 67 + src/postscript.c | 2966 +++++++++ src/print.c | 1211 ++++ src/q2c.c | 1871 ++++++ src/random.c | 149 + src/random.h | 28 + src/recode.c | 1121 ++++ src/rename-vars.c | 154 + src/repeat.c | 650 ++ src/sample.c | 146 + src/sel-if.c | 148 + src/set.q | 882 +++ src/settings.h | 253 + src/sfm-read.c | 1540 +++++ src/sfm-write.c | 756 +++ src/sfm.h | 66 + src/sfmP.h | 63 + src/som.c | 275 + src/som.h | 109 + src/sort.c | 1385 ++++ src/sort.h | 31 + src/split-file.c | 56 + src/stat.h | 65 + src/stats.c | 203 + src/stats.h | 84 + src/str.c | 584 ++ src/str.h | 215 + src/sysfile-info.c | 620 ++ src/t-test.q | 1087 ++++ src/tab.c | 1383 ++++ src/tab.h | 195 + src/temporary.c | 333 + src/title.c | 179 + src/val-labs.c | 306 + src/var-labs.c | 100 + src/var.h | 535 ++ src/vars-atr.c | 570 ++ src/vars-prs.c | 529 ++ src/vector.c | 230 + src/vector.h | 37 + src/version.h | 51 + src/vfm.c | 1297 ++++ src/vfm.h | 100 + src/vfmP.h | 72 + src/weight.c | 121 + stamp-h.in | 1 + sysdeps/ChangeLog | 9 + sysdeps/README | 8 + sysdeps/borlandc5.0/ChangeLog | 60 + sysdeps/borlandc5.0/bc5-con32s.c | 95 + sysdeps/borlandc5.0/config.h | 303 + sysdeps/borlandc5.0/libintl.h | 20 + sysdeps/borlandc5.0/mk-bc5-dist | 69 + sysdeps/borlandc5.0/pspp.ico | Bin 0 -> 16790 bytes sysdeps/borlandc5.0/pspp.ide | Bin 0 -> 86840 bytes sysdeps/borlandc5.0/pspp.iwz.in | 383 ++ sysdeps/borlandc5.0/setup1.bmp | Bin 0 -> 36082 bytes sysdeps/borlandc5.0/sm-gnu-hd.bmp | Bin 0 -> 8414 bytes sysdeps/borlandc5.0/unix2dos.pl | 19 + sysdeps/borlandc5.0/version.c | 7 + sysdeps/windows/README | 10 + sysdeps/windows/con32s.c | 504 ++ tests/ChangeLog | 351 + tests/Makefile.am | 29 + tests/aggregate.stat | 20 + tests/autorecod.stat | 30 + tests/beg-data.stat | 32 + tests/bignum.data | 62 + tests/bignum.stat | 28 + tests/compute.stat | 22 + tests/count.stat | 15 + tests/crosstabs.stat | 19 + tests/data-fmts.stat | 179 + tests/data-list.data | 6 + tests/data-list.stat | 24 + tests/descript.stat | 17 + tests/do-if.stat | 24 + tests/do-repeat.stat | 17 + tests/expect/crosstabs.stat | 7 + tests/expect/data-fmts.stat | 21 + tests/expect/data-list.stat | 17 + tests/expect/expr.stat | 144 + tests/expect/loop.stat | 1 + tests/expect/mdfy-vars.stat | 3 + tests/expect/means.stat | 2 + tests/expect/print.stat | 36 + tests/expect/t-test.stat | 23 + tests/expect/vector.stat | 2 + tests/expect/weighting.stat | 2 + tests/expr.stat | 65 + tests/file-lab.stat | 53 + tests/filter.stat | 21 + tests/flip.stat | 13 + tests/gengarbage.c | 41 + tests/inpt-pgm.stat | 26 + tests/lag.stat | 16 + tests/list.data | 25 + tests/list.stat | 25 + tests/loop.stat | 14 + tests/mdfy-vars.stat | 31 + tests/means.stat | 14 + tests/mtch-file.stat | 55 + tests/pcs-if.stat | 21 + tests/print.stat | 28 + tests/recode.stat | 21 + tests/repeating.stat | 16 + tests/reread.data | 5 + tests/reread.stat | 16 + tests/sample.stat | 19 + tests/sort.stat | 8 + tests/splt-file.stat | 23 + tests/syntax | 51 + tests/sys-info.stat | 13 + tests/t-test.stat | 13 + tests/tabs.stat | 12 + tests/temporary.stat | 29 + tests/time-date.stat | 77 + tests/vector.stat | 24 + tests/weighting.data | 52 + tests/weighting.stat | 8 + 334 files changed, 128253 insertions(+) create mode 100644 AUTHORS create mode 100644 COPYING create mode 100644 ChangeLog create mode 100644 INSTALL create mode 100644 Makefile.am create mode 100644 NEWS create mode 100644 ONEWS create mode 100644 README create mode 100644 THANKS create mode 100644 TODO create mode 100644 acconfig.h create mode 100644 acinclude.m4 create mode 100644 config/ChangeLog create mode 100644 config/Makefile.am create mode 100644 config/devices create mode 100644 config/html-prologue create mode 100644 config/papersize create mode 100644 config/ps-prologue create mode 100644 configure.in create mode 100644 doc/ChangeLog create mode 100644 doc/Makefile.am create mode 100755 doc/mdate-sh create mode 100644 doc/pspp.man create mode 100644 doc/pspp.texi create mode 100644 doc/texinfo.tex create mode 100644 examples/ChangeLog create mode 100644 examples/descript.stat create mode 100644 intl/ChangeLog create mode 100644 intl/Makefile.in create mode 100644 intl/VERSION create mode 100644 intl/bindtextdom.c create mode 100644 intl/cat-compat.c create mode 100644 intl/dcgettext.c create mode 100644 intl/dgettext.c create mode 100644 intl/explodename.c create mode 100644 intl/finddomain.c create mode 100644 intl/gettext.c create mode 100644 intl/gettext.h create mode 100644 intl/gettextP.h create mode 100644 intl/hash-string.h create mode 100644 intl/intl-compat.c create mode 100644 intl/l10nflist.c create mode 100644 intl/libgettext.h create mode 100644 intl/linux-msg.sed create mode 100644 intl/loadinfo.h create mode 100644 intl/loadmsgcat.c create mode 100644 intl/localealias.c create mode 100644 intl/po2tbl.sed.in create mode 100644 intl/textdomain.c create mode 100644 intl/xopen-msg.sed create mode 100644 lib/ChangeLog create mode 100644 lib/Makefile.am create mode 100644 lib/dcdflib/COPYING create mode 100644 lib/dcdflib/ChangeLog create mode 100644 lib/dcdflib/Makefile.am create mode 100644 lib/dcdflib/README create mode 100644 lib/dcdflib/cdflib.h create mode 100644 lib/dcdflib/dcdflib.c create mode 100644 lib/dcdflib/ipmpar.c create mode 100644 lib/gmp/COPYING.LIB create mode 100644 lib/gmp/ChangeLog create mode 100644 lib/gmp/INSTALL create mode 100644 lib/gmp/Makefile.am create mode 100644 lib/gmp/extract-dbl.c create mode 100644 lib/gmp/gmp-impl.h create mode 100644 lib/gmp/gmp-mparam.h create mode 100644 lib/gmp/gmp.h create mode 100644 lib/gmp/longlong.h create mode 100644 lib/gmp/memory.c create mode 100644 lib/gmp/mp_clz_tab.c create mode 100644 lib/gmp/mpf/Makefile.am create mode 100644 lib/gmp/mpf/clear.c create mode 100644 lib/gmp/mpf/get_str.c create mode 100644 lib/gmp/mpf/iset_d.c create mode 100644 lib/gmp/mpf/set_d.c create mode 100644 lib/gmp/mpf/set_dfl_prec.c create mode 100644 lib/gmp/mpn/Makefile.am create mode 100644 lib/gmp/mpn/add_n.c create mode 100644 lib/gmp/mpn/addmul_1.c create mode 100644 lib/gmp/mpn/cmp.c create mode 100644 lib/gmp/mpn/divrem.c create mode 100644 lib/gmp/mpn/get_str.c create mode 100644 lib/gmp/mpn/inlines.c create mode 100644 lib/gmp/mpn/lshift.c create mode 100644 lib/gmp/mpn/mp_bases.c create mode 100644 lib/gmp/mpn/mul.c create mode 100644 lib/gmp/mpn/mul_1.c create mode 100644 lib/gmp/mpn/mul_n.c create mode 100644 lib/gmp/mpn/sub_n.c create mode 100644 lib/gmp/mpn/submul_1.c create mode 100644 lib/julcal/ChangeLog create mode 100644 lib/julcal/Makefile.am create mode 100644 lib/julcal/README create mode 100644 lib/julcal/julcal.c create mode 100644 lib/julcal/julcal.h create mode 100644 lib/misc/ChangeLog create mode 100644 lib/misc/Makefile.am create mode 100644 lib/misc/alloca.c create mode 100644 lib/misc/getdelim.c create mode 100644 lib/misc/getline.c create mode 100644 lib/misc/getopt.c create mode 100644 lib/misc/getopt1.c create mode 100644 lib/misc/memchr.c create mode 100644 lib/misc/memcmp.c create mode 100644 lib/misc/memcpy.c create mode 100644 lib/misc/memmem.c create mode 100644 lib/misc/memmove.c create mode 100644 lib/misc/memset.c create mode 100644 lib/misc/qsort.c create mode 100644 lib/misc/stpcpy.c create mode 100644 lib/misc/strcasecmp.c create mode 100644 lib/misc/strerror.c create mode 100644 lib/misc/strncasecmp.c create mode 100644 lib/misc/strpbrk.c create mode 100644 lib/misc/strstr.c create mode 100644 lib/misc/strtok_r.c create mode 100644 lib/misc/strtol.c create mode 100644 lib/misc/strtoul.c create mode 100644 po/ChangeLog create mode 100644 po/Makefile.in.in create mode 100644 po/POTFILES.in create mode 100644 po/pspp.pot create mode 100644 pref.h.orig create mode 100755 reconfigure create mode 100644 src/ChangeLog create mode 100644 src/Makefile.am create mode 100644 src/aggregate.c create mode 100644 src/alloc.c create mode 100644 src/alloc.h create mode 100644 src/apply-dict.c create mode 100644 src/approx.h create mode 100644 src/ascii.c create mode 100644 src/autorecode.c create mode 100644 src/avl.c create mode 100644 src/avl.h create mode 100644 src/bitvector.h create mode 100644 src/cases.c create mode 100644 src/cases.h create mode 100644 src/cmdline.c create mode 100644 src/command.c create mode 100644 src/command.def create mode 100644 src/command.h create mode 100644 src/compute.c create mode 100644 src/correlations.q create mode 100644 src/count.c create mode 100644 src/crosstabs.q create mode 100644 src/data-in.c create mode 100644 src/data-in.h create mode 100644 src/data-list.c create mode 100644 src/data-out.c create mode 100644 src/debug-print.h create mode 100644 src/descript.q create mode 100644 src/dfm.c create mode 100644 src/dfm.h create mode 100644 src/do-if.c create mode 100644 src/do-ifP.h create mode 100644 src/error.c create mode 100644 src/error.h create mode 100644 src/expr-evl.c create mode 100644 src/expr-opt.c create mode 100644 src/expr-prs.c create mode 100644 src/expr.h create mode 100644 src/exprP.h create mode 100644 src/file-handle.h create mode 100644 src/file-handle.q create mode 100644 src/file-type.c create mode 100644 src/filename.c create mode 100644 src/filename.h create mode 100644 src/flip.c create mode 100644 src/font.h create mode 100644 src/format.c create mode 100644 src/format.def create mode 100644 src/format.h create mode 100644 src/formats.c create mode 100644 src/frequencies.g create mode 100644 src/frequencies.q create mode 100644 src/get.c create mode 100644 src/getline.c create mode 100644 src/getline.h create mode 100644 src/glob.c create mode 100644 src/groff-font.c create mode 100644 src/hash.c create mode 100644 src/hash.h create mode 100644 src/heap.c create mode 100644 src/heap.h create mode 100644 src/html.c create mode 100644 src/htmlP.h create mode 100644 src/include.c create mode 100644 src/inpt-pgm.c create mode 100644 src/inpt-pgm.h create mode 100644 src/lexer.c create mode 100644 src/lexer.h create mode 100644 src/list.q create mode 100644 src/log.h create mode 100644 src/loop.c create mode 100644 src/magic.c create mode 100644 src/magic.h create mode 100644 src/main.c create mode 100644 src/main.h create mode 100644 src/matrix-data.c create mode 100644 src/matrix.c create mode 100644 src/matrix.h create mode 100644 src/means.q create mode 100644 src/mis-val.c create mode 100644 src/misc.c create mode 100644 src/misc.h create mode 100644 src/modify-vars.c create mode 100644 src/numeric.c create mode 100644 src/output.c create mode 100644 src/output.h create mode 100644 src/pfm-read.c create mode 100644 src/pfm-write.c create mode 100644 src/pfm.h create mode 100644 src/pool.c create mode 100644 src/pool.h create mode 100644 src/postscript.c create mode 100644 src/print.c create mode 100644 src/q2c.c create mode 100644 src/random.c create mode 100644 src/random.h create mode 100644 src/recode.c create mode 100644 src/rename-vars.c create mode 100644 src/repeat.c create mode 100644 src/sample.c create mode 100644 src/sel-if.c create mode 100644 src/set.q create mode 100644 src/settings.h create mode 100644 src/sfm-read.c create mode 100644 src/sfm-write.c create mode 100644 src/sfm.h create mode 100644 src/sfmP.h create mode 100644 src/som.c create mode 100644 src/som.h create mode 100644 src/sort.c create mode 100644 src/sort.h create mode 100644 src/split-file.c create mode 100644 src/stat.h create mode 100644 src/stats.c create mode 100644 src/stats.h create mode 100644 src/str.c create mode 100644 src/str.h create mode 100644 src/sysfile-info.c create mode 100644 src/t-test.q create mode 100644 src/tab.c create mode 100644 src/tab.h create mode 100644 src/temporary.c create mode 100644 src/title.c create mode 100644 src/val-labs.c create mode 100644 src/var-labs.c create mode 100644 src/var.h create mode 100644 src/vars-atr.c create mode 100644 src/vars-prs.c create mode 100644 src/vector.c create mode 100644 src/vector.h create mode 100644 src/version.h create mode 100644 src/vfm.c create mode 100644 src/vfm.h create mode 100644 src/vfmP.h create mode 100644 src/weight.c create mode 100644 stamp-h.in create mode 100644 sysdeps/ChangeLog create mode 100644 sysdeps/README create mode 100644 sysdeps/borlandc5.0/ChangeLog create mode 100644 sysdeps/borlandc5.0/bc5-con32s.c create mode 100644 sysdeps/borlandc5.0/config.h create mode 100644 sysdeps/borlandc5.0/libintl.h create mode 100755 sysdeps/borlandc5.0/mk-bc5-dist create mode 100755 sysdeps/borlandc5.0/pspp.ico create mode 100644 sysdeps/borlandc5.0/pspp.ide create mode 100755 sysdeps/borlandc5.0/pspp.iwz.in create mode 100755 sysdeps/borlandc5.0/setup1.bmp create mode 100755 sysdeps/borlandc5.0/sm-gnu-hd.bmp create mode 100644 sysdeps/borlandc5.0/unix2dos.pl create mode 100644 sysdeps/borlandc5.0/version.c create mode 100644 sysdeps/windows/README create mode 100644 sysdeps/windows/con32s.c create mode 100644 tests/ChangeLog create mode 100644 tests/Makefile.am create mode 100644 tests/aggregate.stat create mode 100644 tests/autorecod.stat create mode 100644 tests/beg-data.stat create mode 100644 tests/bignum.data create mode 100644 tests/bignum.stat create mode 100644 tests/compute.stat create mode 100644 tests/count.stat create mode 100644 tests/crosstabs.stat create mode 100644 tests/data-fmts.stat create mode 100644 tests/data-list.data create mode 100644 tests/data-list.stat create mode 100644 tests/descript.stat create mode 100644 tests/do-if.stat create mode 100644 tests/do-repeat.stat create mode 100644 tests/expect/crosstabs.stat create mode 100644 tests/expect/data-fmts.stat create mode 100644 tests/expect/data-list.stat create mode 100644 tests/expect/expr.stat create mode 100644 tests/expect/loop.stat create mode 100644 tests/expect/mdfy-vars.stat create mode 100644 tests/expect/means.stat create mode 100644 tests/expect/print.stat create mode 100644 tests/expect/t-test.stat create mode 100644 tests/expect/vector.stat create mode 100644 tests/expect/weighting.stat create mode 100644 tests/expr.stat create mode 100644 tests/file-lab.stat create mode 100644 tests/filter.stat create mode 100644 tests/flip.stat create mode 100644 tests/gengarbage.c create mode 100644 tests/inpt-pgm.stat create mode 100644 tests/lag.stat create mode 100644 tests/list.data create mode 100644 tests/list.stat create mode 100644 tests/loop.stat create mode 100644 tests/mdfy-vars.stat create mode 100644 tests/means.stat create mode 100644 tests/mtch-file.stat create mode 100644 tests/pcs-if.stat create mode 100644 tests/print.stat create mode 100644 tests/recode.stat create mode 100644 tests/repeating.stat create mode 100644 tests/reread.data create mode 100644 tests/reread.stat create mode 100644 tests/sample.stat create mode 100644 tests/sort.stat create mode 100644 tests/splt-file.stat create mode 100755 tests/syntax create mode 100644 tests/sys-info.stat create mode 100644 tests/t-test.stat create mode 100644 tests/tabs.stat create mode 100644 tests/temporary.stat create mode 100644 tests/time-date.stat create mode 100644 tests/vector.stat create mode 100644 tests/weighting.data create mode 100644 tests/weighting.stat diff --git a/AUTHORS b/AUTHORS new file mode 100644 index 00000000..0262209b --- /dev/null +++ b/AUTHORS @@ -0,0 +1,7 @@ + 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. diff --git a/COPYING b/COPYING new file mode 100644 index 00000000..e77696ae --- /dev/null +++ b/COPYING @@ -0,0 +1,339 @@ + 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. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + 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. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 00000000..7ee9ca18 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,1751 @@ +Sun Jan 2 21:24:32 2000 Ben Pfaff + + * 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 + + * Forked 0.3.0. + +Tue Mar 9 12:46:31 1999 Ben Pfaff + + * Released 0.2.3. + + * TODO: Updated. + +Tue Jan 5 15:18:07 1999 Ben Pfaff + + * Released 0.2.2. + + * TODO: Update from Zvi Grauer . + +Thu Nov 19 12:34:55 1998 Ben Pfaff + + * Released 0.2.1. + +Sun Aug 9 11:11:32 1998 Ben Pfaff + + * LANGUAGE: Updated. + +Sat Aug 8 00:19:08 1998 Ben Pfaff + + * LANGUAGE: Updated. + + * examples/: New directory. + + * Made patchlevel 95. + +Tue Aug 4 23:47:31 1998 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * 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 + + * LANGUAGE: Updated. + + * configure.in: Bump version to 0.1.19. + + * Made patchlevel 92. + +Sun May 31 00:55:13 1998 Ben Pfaff + + * TODO: Updated. + + * configure.in: Generate Makefiles for lib/gmp/{,mpn,mpf}/. + + * Made patchlevel 91. + +Fri May 29 21:43:09 1998 Ben Pfaff + + * TODO: Updated. + + * LANGUAGE: Updated. + + * unconfigure: Remove TeX cruft from doc/. + + * Made patchlevel 90. + +Mon May 25 12:41:54 1998 Ben Pfaff + + * 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 + + * TODO: Updated. + + * Made patchlevel 88. + +Sat May 23 23:21:43 1998 Ben Pfaff + + * TODO: Updated. + + * configure.in: Remove gamma from replaceable functions. + + * Made patchlevel 87. + +Fri May 22 00:02:33 1998 Ben Pfaff + + * configure.in: Add gamma to list of functions with replacements. + + * Made patchlevel 86. + +Wed May 20 00:00:12 1998 Ben Pfaff + + * TODO: Updated. + + * Made patchlevel 85. + +Sat May 16 19:38:49 1998 Ben Pfaff + + * TODO: Updated. + + * Made patchlevel 84. + +Tue May 12 16:13:48 1998 Ben Pfaff + + * TODO: Updated. + + * unconfigure: Don't delete Makefile.in under intl/. + + * Made patchlevel 83. + +Thu May 7 23:16:26 1998 Ben Pfaff + + * unconfigure: Add some more files to reap. + + * Made patchlevel 82. + +Tue May 5 13:17:59 1998 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * 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 + + * Made patchlevel 76. + + * configure.in: Bumped version up to 0.1.16. + +1998-03-05 Ben Pfaff + + * configure.in: Bumped version up to 0.1.15. + +1998-02-23 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * 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 + + * Made patchlevel 71. + + * configure.in: Bump version up to 0.1.11. + +Tue Feb 3 16:12:34 1998 Ben Pfaff + + * TODO: Updated. + + * Made patchlevel 70. + + * configure.in: Bump version up to 0.1.10. + +Fri Jan 23 00:17:18 1998 Ben Pfaff + + * Made patchlevel 69. + +Thu Jan 22 00:35:52 1998 Ben Pfaff + + * Made patchlevel 68. + +Sun Jan 18 00:30:18 1998 Ben Pfaff + + * configure.in: Add ieeefp.h to list of headers to check for. + + * Made patchlevel 67. + +Tue Jan 13 23:44:16 1998 Ben Pfaff + + * 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 + + * configure.in: Bump version up to 0.1.9. + + * pref.h.orig (STORE_2): Fix parentheses. From Alexandre + Oliva . + + * Made patchlevel 65. + +Sat Jan 10 23:59:06 1998 Ben Pfaff + + * Made patchlevel 64. + +Sat Jan 10 02:10:15 1998 Ben Pfaff + + * TODO: Updated. + + * pref.h.orig: Comment fixes. + (macro second_lowest_flt64) New. + + * Made patchlevel 63. + +Thu Jan 8 22:27:03 1998 Ben Pfaff + + * TODO: Updated. + + * Made patchlevel 62. + +Mon Jan 5 11:18:37 1998 Ben Pfaff + + * Made patchlevel 61. + +Sun Jan 4 18:10:29 1998 Ben Pfaff + + * 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 + + * TODO: Updated. + + * Made patchlevel 59. + +Fri Jan 2 01:38:37 1998 Ben Pfaff + + * 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 + + * TODO: Updated. + + * Made patchlevel 57. + +Fri Dec 26 15:43:17 1997 Ben Pfaff + + * TODO: Updated. + + * Made patchlevel 56. + +Wed Dec 24 22:34:55 1997 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * Replaced remaining instances of Fiasco with PSPP. + + * Made patchlevel 53. + +Fri Dec 5 22:51:18 1997 Ben Pfaff + + * 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 + + * 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 + + * TODO: Updated. + + * configure.in: Bumped version to 0.1.6. + + * Made patchlevel 50. + +Sat Nov 22 01:20:32 1997 Ben Pfaff + + * Made patchlevel 49. + +Fri Nov 21 00:11:41 1997 Ben Pfaff + + * Made patchlevel 48. + +Sun Nov 16 01:31:38 1997 Ben Pfaff + + * Made patchlevel 47. + +Fri Nov 14 00:17:48 1997 Ben Pfaff + + * Made patchlevel 46. + + * configure.in: Bumped version to 0.1.5. + +Tue Oct 28 16:07:17 1997 Ben Pfaff + + * configure.in: Bumped version to 0.1.4. + + * TODO: Updated. + + * Made patchlevel 45. + +Wed Oct 8 15:55:50 1997 Ben Pfaff + + * 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 + + * 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 + + * configure.in: Bumped version to 0.1.2. + (strerror) Replace instead of check. From Alexandre Oliva + . + + * pref.h.orig: Include `debug-print' instead of + `src/debug-print.h'. + + * Made patchlevel 42. + +Sat Oct 4 16:19:44 1997 Ben Pfaff + + * 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 + + * Made patchlevel 40. + +Sun Sep 21 00:07:09 1997 Ben Pfaff + + * Made patchlevel 39. + +Thu Sep 18 21:42:27 1997 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * TODO: Updated. + + * pref.h.orig: (macro DEFAULT_COMPAT) Removed. + + * Made patchlevel 35. + +Sun Aug 17 22:48:36 1997 Ben Pfaff + + * Made patchlevel 34. + +Sat Aug 16 10:48:29 1997 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * Makefile.am: (MAINTAINERCLEANFILES) Add HELP-WANTED. + (EXTRA_DIST) Add ONEWS. + + * Made patchlevel 30. + +Sun Aug 3 11:30:17 1997 Ben Pfaff + + * 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 + + * Made patchlevel 28. + +Thu Jul 17 01:43:25 1997 Ben Pfaff + + * 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 + + * TODO: Updates. + + * Made patchlevel 26. + +Fri Jul 11 14:08:21 1997 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * TODO: Updates. + + * Made patchlevel 22. + +Fri Jul 4 13:20:47 1997 Ben Pfaff + + * 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 + + * 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 + + * Made patchlevel 19. + +Sun Jun 15 16:44:14 1997 Ben Pfaff + + * 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 + + * Made patchlevel 17. + +Fri Jun 6 22:41:08 1997 Ben Pfaff + + * 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 + + * Made patchlevel 15. + +Tue Jun 3 23:24:08 1997 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * Made patchlevel 11. + +Sun Jun 1 11:58:43 1997 Ben Pfaff + + * 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 + + * pref.h.orig: [__MSDOS__] Reordered INCLUDE_PATH. + + * Made patchlevel 9. + +Sun May 25 22:32:57 1997 Ben Pfaff + + * acconfig.h: For support of glibc 2, define _GNU_SOURCE. + + * Made patchlevel 8. + +Mon May 5 21:58:22 1997 Ben Pfaff + + * Made patchlevel 7. + +Fri May 2 22:27:36 1997 Ben Pfaff + + * Made patchlevel 6. + +Thu May 1 15:34:01 1997 Ben Pfaff + + * All files: Changed copyright from `Ben Pfaff' to `Free Software + Foundation, Inc'. + + * Made patchlevel 5. + +Thu May 1 15:00:51 1997 Ben Pfaff + + * Made patchlevel 4. + +Sat Apr 26 11:34:05 1997 Ben Pfaff + + * ChangeLog: Split into one ChangeLog per directory. + + * Made patchlevel 3. + +Wed Apr 23 21:33:48 1997 Ben Pfaff + + * TODO: Update. + + * Made patchlevel 2. + +Fri Apr 18 16:48:41 1997 Ben Pfaff + + * 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 + + * 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 + + * 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 + + 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 + + * 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 + + 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 + + * TODO: Updated. + + * Made patchlevel 192. + +Sun Feb 16 20:57:20 1997 Ben Pfaff + + * Made patchlevel 191. + +Sat Feb 15 21:26:53 1997 Ben Pfaff + + * Makefile.am: Removed `descript.g' from sources. + + * Made patchlevel 190. + +Fri Feb 14 23:32:58 1997 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * Made patchlevel 182. + +Wed Jan 1 22:08:10 1997 Ben Pfaff + + * TODO: Updated. + + * Made patchlevel 181. + +Wed Jan 1 17:00:59 1997 Ben Pfaff + + * Makefile.am: New target for test/sort.data. + + * Made patchlevel 180. + +Sun Dec 29 21:36:48 1996 Ben Pfaff + + * Made patchlevel 179. + +Tue Dec 24 20:42:32 1996 Ben Pfaff + + * Made patchlevel 178. + +Sun Dec 22 23:10:39 1996 Ben Pfaff + + * 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 + + * 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 + + * Made patchlevel 175. + +Sun Dec 15 15:32:16 1996 Ben Pfaff + + * 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 + + * Made patchlevel 173. + +Fri Dec 13 21:30:53 1996 Ben Pfaff + + * 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 + + * TODO: Updated. + + * Made patchlevel 171. + +Wed Dec 4 21:34:17 1996 Ben Pfaff + + * Made patchlevel 170. + +Sun Dec 1 17:19:00 1996 Ben Pfaff + + * Made patchlevel 169. + +Thu Nov 28 23:14:07 1996 Ben Pfaff + + * Makefile.am: Added `set.q' to list of source files. + + * Made patchlevel 168. + +Thu Nov 28 19:46:10 1996 Ben Pfaff + + * Made patchlevel 167. + +Wed Nov 27 23:18:35 1996 Ben Pfaff + + * 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 + + * 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 + + * Made patchlevel 164. + +Thu Nov 7 20:52:28 1996 Ben Pfaff + + * Made patchlevel 163. + +Thu Nov 7 17:29:16 1996 Ben Pfaff + + * Made patchlevel 162. + +Thu Nov 7 15:48:52 1996 Ben Pfaff + + * Made patchlevel 161. + +Tue Nov 5 18:34:59 1996 Ben Pfaff + + * TODO: Updated. + + * Made patchlevel 160. + +Mon Nov 4 22:03:28 1996 Ben Pfaff + + * Makefile.am: Added get.c. + + * TODO: Updated. + + * Made patchlevel 159. + +Sun Nov 3 12:24:36 1996 Ben Pfaff + + * Makefile.am: Added sfm.h, sfm-read.c to source files. + + * Made patchlevel 158. + +Wed Oct 30 17:13:08 1996 Ben Pfaff + + * 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 + + * 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 + + * Made patchlevel 155. + +Sat Oct 26 10:39:25 1996 Ben Pfaff + + * TODO: Updated. + + * Made patchlevel 154. + +Thu Oct 24 20:13:42 1996 Ben Pfaff + + * 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 + + * TODO: Updated. + + * Made patchlevel 152. + +Wed Oct 23 21:53:43 1996 Ben Pfaff + + * TODO: Organized. + + * Made patchlevel 151. + +Tue Oct 22 17:27:04 1996 Ben Pfaff + + * TODO: Culled old notes. + + * Made patchlevel 150. + +Mon Oct 21 20:39:59 1996 Ben Pfaff + + * Made patchlevel 149. + +Sun Oct 20 13:45:28 1996 Ben Pfaff + + * 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 + + * Made patchlevel 147. + +Fri Oct 18 19:46:49 1996 Ben Pfaff + + * Made patchlevel 146. + +Sun Sep 29 19:37:03 1996 Ben Pfaff + + * Made patchlevel 145. + +Sat Sep 28 21:28:07 1996 Ben Pfaff + + * Makefile.am: Added to DISTCLEANFILES. + + * Made patchlevel 144. + +Fri Sep 27 20:08:39 1996 Ben Pfaff + + * Made patchlevel 143. + +Thu Sep 26 22:20:26 1996 Ben Pfaff + + * Makefile.am: Added list.c back into the list of source files. + + * Made patchlevel 142. + +Wed Sep 25 19:36:11 1996 Ben Pfaff + + * Makefile.am: Updated for new files. + + * Made patchlevel 141. + +Tue Sep 24 18:39:09 1996 Ben Pfaff + + * Made patchlevel 140. + +Sat Sep 21 23:16:31 1996 Ben Pfaff + + * Made patchlevel 139. + +Fri Sep 20 22:52:28 1996 Ben Pfaff + + * Made patchlevel 138. + +Thu Sep 12 18:40:33 1996 Ben Pfaff + + * Made patchlevel 137. + +Wed Sep 11 22:01:41 1996 Ben Pfaff + + * 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 + + * Makefile.am: Added `display.c' back in. + + * TODO: Addition. + + * Made patchlevel 135. + +Mon Sep 9 21:43:13 1996 Ben Pfaff + + * Makefile.am: Added `split-file.c' back into the project. + + * Made patchlevel 134. + +Sat Sep 7 22:35:12 1996 Ben Pfaff + + * TODO: Updated. + + * prefh.orig: (local_strdup) Moved to misc.h. + + * Made patchlevel 133. + +Thu Sep 5 22:05:56 1996 Ben Pfaff + + * Makefile.am: Changed `prologue.ps' references to `ps-prologue'. + + * Made patchlevel 132. + +Wed Sep 4 21:45:35 1996 Ben Pfaff + + * prefh.orig: New i18n defines. + + * This patchlevel doesn't even compile. + + * Made patchlevel 131. + +Sat Aug 31 23:52:38 1996 Ben Pfaff + + * TODO: Addition. + + * Made patchlevel 130. + +Thu Aug 29 21:36:41 1996 Ben Pfaff + + * Made patchlevel 129. + +Sat Aug 24 23:26:00 1996 Ben Pfaff + + * 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 + + * Makefile.am: Changed DISTCLEANFILES. + + * Does not compile. + + * Made patchlevel 126. + +Sat Aug 10 23:28:17 1996 Ben Pfaff + + * 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 + + * reconfigure: `autoheader' now first operation performed. + + * Made patchlevel 124. + +Sat Aug 3 20:50:35 1996 Ben Pfaff + + * 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 + + * 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 + + * Made patchlevel 121. + +Wed Jul 17 21:23:36 1996 Ben Pfaff + + * Made patchlevel 120. + +Tue Jul 16 22:10:04 1996 Ben Pfaff + + * Made patchlevel 119. + +Sun Jul 14 15:45:31 1996 Ben Pfaff + + * Made patchlevel 118. + +Fri Jul 12 22:03:36 1996 Ben Pfaff + + * Makefile.am: Added list.c to sources. + + * Made patchlevel 117. + +Sat Jul 6 22:22:25 1996 Ben Pfaff + + * configure.in: Removed reference to `malloc.h'. + + * Made patchlevel 116. + +Fri Jul 5 20:16:19 1996 Ben Pfaff + + * Made patchlevel 115. + +Thu Jul 4 20:20:24 1996 Ben Pfaff + + * 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 + + * TODO: doc fix. + + * Made patchlevel 114. + +Tue Jul 2 22:13:23 1996 Ben Pfaff + + * 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 + + * Made patchlevel 112. + +Mon Jul 1 13:00:00 1996 Ben Pfaff + + * 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 + + * prefh.orig: changed default file search paths + + * Made patchlevel 110. + +Fri Jun 28 11:59:48 1996 Ben Pfaff + + * Added automake support; removed GNUmakefile and GNUmakefile.in. + +---------------------------------------------------------------------- +Local Variables: +mode: change-log +version-control: never +End: diff --git a/INSTALL b/INSTALL new file mode 100644 index 00000000..3b50ea95 --- /dev/null +++ b/INSTALL @@ -0,0 +1,176 @@ +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. + diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 00000000..b945ea95 --- /dev/null +++ b/Makefile.am @@ -0,0 +1,29 @@ +## 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 + diff --git a/NEWS b/NEWS new file mode 100644 index 00000000..58d47725 --- /dev/null +++ b/NEWS @@ -0,0 +1,260 @@ +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. + +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 for reporting this bug. + + * The TABLE subcommand on MATCH FILES worked only erratically at + best. This fixes it. Thanks to Dr. Dirk Melcher + for reporting this bug. + + * VARIABLE LABELS rejected a slash before the first variable + specification, contradicting the documentation. Thanks to Walter + M. Gray 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 for + reporting this bug. + + * CROSSTABS didn't display value labels for column and row + variables. Thanks to Walter M. Gray for + reporting this bug. + + * WRITE didn't write line ends. Fixed. Thanks to Dr. Dirk Melcher + for reporting this bug. + + * The TABLE subcommand on MATCH FILES worked only erratically at + best. This fixes it. Thanks to Dr. Dirk Melcher + for reporting this bug. + + * VARIABLE LABELS rejected a slash before the first variable + specification, contradicting the documentation. Thanks to Walter + M. Gray 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 for + reporting this bug. + + * CROSSTABS didn't display value labels for column and row + variables. Thanks to Walter M. Gray for + reporting this bug. + + * WRITE didn't write line ends. Fixed. Thanks to Dr. Dirk Melcher + 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 + for reporting this bug. + + * KEEP didn't work properly on the SAVE procedure. Fixed. Thanks + to Ralf Geschke for reporting this bug. + + * Memory leak fix. + + * Some systems didn't like the way open_file was coded. Thanks to + Hankin for pointing this out. + + * The SAVE procedure didn't save long string variables properly. + Fixed by this patch. Thanks to Hankin + 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 + for this bug report. + + * Fix problems with some string format specifiers. + + * Fix use of $CASENUM in expressions. Thanks to Dirk Melcher + for reporting this bug. + + * Additional DATA LIST FREE and DATA LIST LIST fixes. Thanks to + Hankin 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 + 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 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 . + +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. + +---------------------------------------------------------------------- +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. + +Local variables: +version-control: never +mode: indented-text +end: diff --git a/ONEWS b/ONEWS new file mode 100644 index 00000000..ec1ff99c --- /dev/null +++ b/ONEWS @@ -0,0 +1,540 @@ +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. + +* 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. + +---------------------------------------------------------------------- +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. + +Local variables: +version-control: never +mode: text +mode: outline-minor +end: diff --git a/README b/README new file mode 100644 index 00000000..51fb8eae --- /dev/null +++ b/README @@ -0,0 +1,18 @@ +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 +. PSPP bug reports should be sent to +bug-gnu-pspp@gnu.org. diff --git a/THANKS b/THANKS new file mode 100644 index 00000000..914eadf2 --- /dev/null +++ b/THANKS @@ -0,0 +1,12 @@ +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. diff --git a/TODO b/TODO new file mode 100644 index 00000000..7486135d --- /dev/null +++ b/TODO @@ -0,0 +1,334 @@ +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 +: "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 . + +From Zvi Grauer and : + + 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 : 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: diff --git a/acconfig.h b/acconfig.h new file mode 100644 index 00000000..4c06d672 --- /dev/null +++ b/acconfig.h @@ -0,0 +1,84 @@ +/* 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, 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 + +/* Local Variables: */ +/* mode:c */ +/* End: */ diff --git a/acinclude.m4 b/acinclude.m4 new file mode 100644 index 00000000..5f811319 --- /dev/null +++ b/acinclude.m4 @@ -0,0 +1,433 @@ +dnl --------------------------------------------------------- ## +dnl The following definitions are from gettext-0.10.27. ## +dnl --------------------------------------------------------- ## + +# Macro to add for using GNU gettext. +# Ulrich Drepper , 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 ], [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 , 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 . +# Ulrich Drepper , 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 ], [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 + #include + 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 + 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 ], [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 diff --git a/config/ChangeLog b/config/ChangeLog new file mode 100644 index 00000000..12f1ea87 --- /dev/null +++ b/config/ChangeLog @@ -0,0 +1,158 @@ +Sun May 24 22:40:13 1998 Ben Pfaff + + * ps-prologue: Add %%DocumentMedia: comment. + +Wed May 20 00:02:51 1998 Ben Pfaff + + * ps-prologue: Comment out misleading Bounding-Box comment for + now. SF arguments rearranged. BP removed. + +Wed Apr 15 13:00:46 1998 Ben Pfaff + + * 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 + + * ps-prologue: Minor reorganization. New GB macro to draw a gray + box. + +Wed Dec 24 22:35:13 1997 Ben Pfaff + + * devices: Added devicetype options and documentation for them. + +Fri Dec 5 21:51:08 1997 Ben Pfaff + + * 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 + + * Makefile.am: (pkgsysconfdir) Changed from $(pkgdatadir) to + $(sysconfdir)/$(PACKAGE). + +Thu Aug 14 22:05:54 1997 Ben Pfaff + + * devices: (tty) Define as null instead of not defining. + +Sun Aug 3 11:33:28 1997 Ben Pfaff + + * devices: tty-ascii has no bold or italic by default. + +Wed Jun 25 22:50:19 1997 Ben Pfaff + + * Makefile.am: (EXTRA_DIST) New target. + +Mon May 5 21:56:54 1997 Ben Pfaff + + * devices, papersize, ps-prologue: Comment fixes. + +Fri May 2 22:05:44 1997 Ben Pfaff + + * 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 + + * ps-prologue: (BP) New argument, SF or scale factor. + +Fri Apr 18 16:48:41 1997 Ben Pfaff + + * Makefile.am: New file. + + * environment: Comment fix. + +Sat Feb 15 21:26:53 1997 Ben Pfaff + + * devices: Added ml520 and ml520-ul printer devices. + +Sat Jan 11 15:44:15 1997 Ben Pfaff + + * devices: Default listing device is list-ascii, not list-ibmpc. + +Sun Dec 29 21:36:48 1996 Ben Pfaff + + * devices: Changed default devices. + +Sat Sep 7 22:35:12 1996 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * prologue.ps: One minor comment change. + +Thu Aug 29 21:36:41 1996 Ben Pfaff + + * prologue.ps: Portions other than DSC comments are essentially + completely new. + +Sat Aug 24 23:26:00 1996 Ben Pfaff + + * devices: Added PostScript driver. + +Sun Aug 11 21:31:22 1996 Ben Pfaff + + * prologue.ps: Calls `setlinecap' in setup code. + +Sat Aug 10 23:28:17 1996 Ben Pfaff + + * prologue.ps: DSC comment changes. New call to `setlinewidth' in + setup code. + +Thu Aug 8 22:31:11 1996 Ben Pfaff + + * prologue.ps: Changes to scaling & translating code. + +Sat Aug 3 20:50:35 1996 Ben Pfaff + + * 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 + + * ps-fontmap: New configuration file. Added to Makefile.am. + +---------------------------------------------------------------------- +Local Variables: +mode: change-log +version-control: never +End: diff --git a/config/Makefile.am b/config/Makefile.am new file mode 100644 index 00000000..9924e256 --- /dev/null +++ b/config/Makefile.am @@ -0,0 +1,18 @@ +## 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 diff --git a/config/devices b/config/devices new file mode 100644 index 00000000..c1aa6c00 --- /dev/null +++ b/config/devices @@ -0,0 +1,165 @@ +# 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: diff --git a/config/html-prologue b/config/html-prologue new file mode 100644 index 00000000..fa0b57df --- /dev/null +++ b/config/html-prologue @@ -0,0 +1,23 @@ +!!! +!!! 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. +!!! + + + + +${title} !title + + + + +

${title}

!title +

${subtitle}

!subtitle +!!! Local Variables: +!!! fill-prefix: "!!! " +!!! End: diff --git a/config/papersize b/config/papersize new file mode 100644 index 00000000..f3866ed9 --- /dev/null +++ b/config/papersize @@ -0,0 +1,60 @@ +# 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: diff --git a/config/ps-prologue b/config/ps-prologue new file mode 100644 index 00000000..3c75230c --- /dev/null +++ b/config/ps-prologue @@ -0,0 +1,75 @@ +!!! +!!! 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: diff --git a/configure.in b/configure.in new file mode 100644 index 00000000..64bbc411 --- /dev/null +++ b/configure.in @@ -0,0 +1,241 @@ +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 + #include ], + [#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 + #include ], + [#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 diff --git a/doc/ChangeLog b/doc/ChangeLog new file mode 100644 index 00000000..15eb0585 --- /dev/null +++ b/doc/ChangeLog @@ -0,0 +1,481 @@ +Sun Jan 2 21:30:53 2000 Ben Pfaff + + * pspp.texi: Updated. + +Tue Mar 9 12:47:20 1999 Ben Pfaff + + * pspp.texi: Updated. + +Mon Jan 18 19:29:21 1999 Ben Pfaff + + * pspp.texi: Updated. + +Tue Jan 5 12:04:09 1999 Ben Pfaff + + * pspp.texi: Updated. + +Thu Nov 19 12:35:01 1998 Ben Pfaff + + * pspp.texi: Revised. + +Sun Aug 9 11:11:43 1998 Ben Pfaff + + * pspp.texi: Revised. + +Sat Aug 8 00:19:22 1998 Ben Pfaff + + * pspp.texi: Revised. + +Sun Jul 5 00:14:24 1998 Ben Pfaff + + * pspp.texi: Updated. + +Fri May 29 21:43:52 1998 Ben Pfaff + + * pspp.texi: Revised. + +Wed May 20 00:03:50 1998 Ben Pfaff + + * pspp.texi: Updated. + +Fri Apr 24 12:51:28 1998 Ben Pfaff + + * pspp.texi: Updated. + +Wed Apr 15 13:01:28 1998 Ben Pfaff + + * 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 + + * LANGUAGE.html: Updated. + +1998-03-05 Ben Pfaff + + * pspp.texi: Updated. + +1998-02-23 Ben Pfaff + + * pspp.texi: Updated. + +Fri Feb 13 15:35:44 1998 Ben Pfaff + + * LANGUAGE.html: Updated. + +Thu Feb 5 00:18:10 1998 Ben Pfaff + + * LANGUAGE.html: Updated. + + * pspp.texi: Revised. + +Tue Jan 13 23:44:43 1998 Ben Pfaff + + * BUGS.html: Updated. + + * LANGUAGE.html: Updated. + +Thu Jan 8 22:27:29 1998 Ben Pfaff + + * pspp.texi: Updated. + +Sun Jan 4 18:12:11 1998 Ben Pfaff + + * LANGUAGE.html: Updated. + +Wed Dec 24 22:36:09 1997 Ben Pfaff + + * pspp.texi: Updated. + +Sun Dec 21 16:18:18 1997 Ben Pfaff + + * pspp.texi: Updated. + +Fri Dec 5 22:53:35 1997 Ben Pfaff + + * fiasco.man: Renamed pspp.man. + + * fiasco.texi: Renamed pspp.texi. + +Fri Dec 5 21:52:29 1997 Ben Pfaff + + * fiasco.texi: Updated. + +Tue Dec 2 14:35:34 1997 Ben Pfaff + + * BUGS.html: Updated. + +Sat Nov 22 01:20:41 1997 Ben Pfaff + + * fiasco.texi: Revised. + +Fri Nov 21 00:02:36 1997 Ben Pfaff + + * fiasco.man, fiasco.texi: Revised. + +Tue Oct 28 16:08:01 1997 Ben Pfaff + + * fiasco.texi: Revised. + +Tue Oct 7 20:22:14 1997 Ben Pfaff + + * LANGUAGE.html: Updated. + +Sat Oct 4 16:19:27 1997 Ben Pfaff + + * LANGUAGE.html: Updated. + +Thu Sep 18 21:33:44 1997 Ben Pfaff + + * BUGS.html, LANGUAGE.html: Updated. + +Wed Aug 20 14:21:35 1997 Ben Pfaff + + * Makefile.am: (info_TEXINFOS) Remove FAQ.texi. + +Wed Aug 20 12:49:40 1997 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * 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 + + * FAQ.texi, fiasco.texi: Updated. + +Sun Aug 3 11:34:43 1997 Ben Pfaff + + * 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 + + * Makefile.am: Generates fiasco.lsm from fiasco.lsm.in. + +Thu Jul 17 01:49:06 1997 Ben Pfaff + + * 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 + + * fiasco.texi: Updated. + +Sun Jul 6 20:46:38 1997 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * FAQ.texi: Finished. + + * README.html: Updates. + +Sun Jun 22 21:59:07 1997 Ben Pfaff + + * 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 + + * AUTHORS.html, BUGS.html, README.html, THANKS.html: Updates. + + * fiasco.texi: Update. + +Sun Jun 1 11:58:27 1997 Ben Pfaff + + * fiasco.texi: Development. + +Fri May 30 19:39:37 1997 Ben Pfaff + + * fiasco.texi: Development. + +Mon May 5 21:57:20 1997 Ben Pfaff + + * fiasco.texi: Development. + +Fri May 2 22:07:26 1997 Ben Pfaff + + * fiasco.texi: Development. + +Thu May 1 14:58:31 1997 Ben Pfaff + + * BUGS.html: Update. + + * fiasco.texi: Development. + +Wed Apr 23 21:33:48 1997 Ben Pfaff + + * THANKS.html: Update. + +Fri Apr 18 15:42:22 1997 Ben Pfaff + + * Makefile.am: Maintainer-clean Makefile.in. + +Thu Mar 27 01:11:29 1997 Ben Pfaff + + * THANKS.html: Added Fran,cois Pinard. + +Mon Mar 24 21:47:31 1997 Ben Pfaff + + * THANKS.html: Spelling fix. + +Sat Feb 15 21:26:53 1997 Ben Pfaff + + * LANGUAGE.html: Updated. + +Fri Feb 14 23:32:58 1997 Ben Pfaff + + * BUGS.html: Updated. + +Wed Jan 22 21:54:00 1997 Ben Pfaff + + * LANGUAGE.html: RENAME VARIABLES is implemented. + +Thu Jan 16 13:08:57 1997 Ben Pfaff + + * 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 + + * README.html: Commented out sunsite reference and added + ALPHA-release warning. + +Fri Jan 10 20:22:08 1997 Ben Pfaff + + * LANGUAGE.html: Reformatted. + +Thu Jan 2 19:08:23 1997 Ben Pfaff + + * LANGUAGE.html: Updated. + +Wed Jan 1 22:08:10 1997 Ben Pfaff + + * LANGUAGE.html: Updated. + +Sun Dec 29 21:36:48 1996 Ben Pfaff + + * LANGUAGE.html: Updated. + + * fiasco.texi: Updated. + +Tue Dec 24 20:42:32 1996 Ben Pfaff + + * LANGUAGE.html, README.html: Miscellaneous changes. + +Sun Dec 22 23:10:39 1996 Ben Pfaff + + * 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 + + * 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 + + * LANGUAGE: Updated. + +Fri Dec 6 23:53:47 1996 Ben Pfaff + + * AUTHORS, BUGS, LANGUAGE, README: Updated. + + * fiasco.texi: Fixes. + +Wed Dec 4 21:34:17 1996 Ben Pfaff + + * LANGUAGE: Updated. + +Sun Dec 1 17:19:00 1996 Ben Pfaff + + * BUGS, LANGUAGE, NEWS: Misc. changes. + +Sun Nov 24 14:53:53 1996 Ben Pfaff + + * fiasco.texi: Changed many instances of `illegal' to `invalid'. + +Wed Oct 30 17:13:08 1996 Ben Pfaff + + * LANGUAGE: Updated. + + * README: Updated. + +Sat Oct 26 23:06:06 1996 Ben Pfaff + + * LANGUAGE: Updated. + +Sat Oct 26 10:39:25 1996 Ben Pfaff + + * LANGUAGE: Updated. + +Thu Oct 24 20:13:42 1996 Ben Pfaff + + * LANGUAGE: Updated. + + * README: Updated. + + * fiasco.texi: Updated. + +Thu Oct 24 17:47:14 1996 Ben Pfaff + + * LANGUAGE: Updated. + +Wed Oct 23 21:53:43 1996 Ben Pfaff + + * LANGUAGE: Updated. + +Tue Oct 22 17:27:04 1996 Ben Pfaff + + * LANGUAGE: Updated. + + * fiasco.texi: Very minor changes. + +Sun Sep 29 19:37:03 1996 Ben Pfaff + + * fiasco.texi: Continued development. + +Tue Sep 24 18:39:09 1996 Ben Pfaff + + * 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 + + * fiasco.texi: Continued work--added to configuration chapter. + +Fri Sep 20 22:52:28 1996 Ben Pfaff + + * fiasco.texi: Continued work--added to configuration chapter. + +Thu Sep 12 18:40:33 1996 Ben Pfaff + + * fiasco.texi: Continued work--added section on bug reports. + +Wed Sep 11 22:01:41 1996 Ben Pfaff + + * fiasco.texi: Added timestamp. Started some updating. + +Tue Sep 10 21:39:00 1996 Ben Pfaff + + * LANGUAGE: Updated. + + * README: Minor change. + +Mon Sep 9 21:43:13 1996 Ben Pfaff + + * NEWS: Added automagic timestamp. + + * README: Restructured, extended. + + * BUGS, LANGUAGE: New files. + +Sat Jul 6 22:22:25 1996 Ben Pfaff + + * fiasco.texi: Remarked on broken Borland alloca(). + +Mon Jul 1 13:00:00 1996 Ben Pfaff + + * stat.texi: Renamed to `fiasco.texi'. + +---------------------------------------------------------------------- +Local Variables: +mode: change-log +version-control: never +End: diff --git a/doc/Makefile.am b/doc/Makefile.am new file mode 100644 index 00000000..77de9770 --- /dev/null +++ b/doc/Makefile.am @@ -0,0 +1,11 @@ +## 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 diff --git a/doc/mdate-sh b/doc/mdate-sh new file mode 100755 index 00000000..0c7ad12e --- /dev/null +++ b/doc/mdate-sh @@ -0,0 +1,91 @@ +#!/bin/sh +# mdate-sh - get modification time of a file and pretty-print it +# Copyright (C) 1995 Software Foundation, Inc. +# Written by Ulrich Drepper , 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 diff --git a/doc/pspp.man b/doc/pspp.man new file mode 100644 index 00000000..05792309 --- /dev/null +++ b/doc/pspp.man @@ -0,0 +1,45 @@ +.\" PSPP - computes sample statistics. +.\" Copyright (C) 1997, 1998 Free Software Foundation, Inc. +.\" Written by Ben Pfaff . +.\" +.\" 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. diff --git a/doc/pspp.texi b/doc/pspp.texi new file mode 100644 index 00000000..86a9be03 --- /dev/null +++ b/doc/pspp.texi @@ -0,0 +1,9832 @@ +\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 +()}. + +@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 +. +@end ifinfo +@iftex +@code{}. +@end iftex + +PSPP bug reports should be sent to +@ifinfo +. +@end ifinfo +@iftex +@code{}. +@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: diff --git a/doc/texinfo.tex b/doc/texinfo.tex new file mode 100644 index 00000000..4c03dfac --- /dev/null +++ b/doc/texinfo.tex @@ -0,0 +1,4424 @@ +%% 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 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 . + % + \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 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 to achieve this: TeX expands \the only once, +% simply yielding the contents of the . +\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 `\=\other +\catcode `\=\other +\catcode `\^^C=\other +\catcode `\^^D=\other +\catcode `\^^E=\other +\catcode `\^^F=\other +\catcode `\^^G=\other +\catcode `\^^H=\other +\catcode `\ =\other +\catcode `\^^L=\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 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: diff --git a/examples/ChangeLog b/examples/ChangeLog new file mode 100644 index 00000000..c41d21b4 --- /dev/null +++ b/examples/ChangeLog @@ -0,0 +1,15 @@ +Sun Aug 9 11:16:13 1998 Ben Pfaff + + * descriptives.stat: Renamed descript.stat. + +Sat Aug 8 00:28:24 1998 Ben Pfaff + + * New directory. + + * descriptives.stat: New file. + +---------------------------------------------------------------------- +Local Variables: +mode: change-log +version-control: never +End: diff --git a/examples/descript.stat b/examples/descript.stat new file mode 100644 index 00000000..2f2ad562 --- /dev/null +++ b/examples/descript.stat @@ -0,0 +1,29 @@ +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. diff --git a/intl/ChangeLog b/intl/ChangeLog new file mode 100644 index 00000000..743b3f5a --- /dev/null +++ b/intl/ChangeLog @@ -0,0 +1,1026 @@ +Thu Oct 9 13:41:22 1997 Ben Pfaff + + * Makefile.in: (INCLUDES) Add -I$(top_srcdir)/src. + +1997-09-06 02:10 Ulrich Drepper + + * intlh.inst.in: Reformat copyright. + +1997-08-19 15:22 Ulrich Drepper + + * dcgettext.c (DCGETTEXT): Remove wrong comment. + +1997-08-16 00:13 Ulrich Drepper + + * Makefile.in (install-data): Don't change directory to install. + +1997-08-01 14:30 Ulrich Drepper + + * 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 . + + * 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 + + * dcgettext.c (guess_category_value): Don't depend on + HAVE_LC_MESSAGES. We don't need the macro here. + Patch by Bruno Haible . + + * 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 . + + * Makefile.in (CPPFLAGS): New variable. Reported by Franc,ois + Pinard. + +Mon Mar 10 06:51:17 1997 Ulrich Drepper + + * 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 + + * 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 + + * textdomain.c: Move definition of `memcpy` macro to right + position. + +Fri Nov 22 04:01:58 1996 Ulrich Drepper + + * 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 + + * Makefile.in (libdir): Change to use exec_prefix instead of + prefix. Reported by Knut-HåvardAksnes . + +Sat Aug 31 03:07:09 1996 Ulrich Drepper + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * l10nflist.c: Correct presence test macros of __argz_* functions. + + * l10nflist.c: Include based on test of it instead when + __argz_* functions are available. + Reported by Andreas Schwab. + +Thu Jun 13 15:17:44 1996 Ulrich Drepper + + * explodename.c, l10nflist.c: Define NULL for dumb systems. + +Tue Jun 11 17:05:13 1996 Ulrich Drepper + + * 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 + + * Makefile.in (install): Remove comment. + +Thu Jun 6 17:28:17 1996 Ulrich Drepper + + * 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 + + * 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 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 + + * intlh.inst.in: Don't depend including 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 + + * 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 + + * loadmsgcat.c (_nl_load_domain): Parameter is now comes from + find_l10nfile. + +Sat Jun 1 02:23:03 1996 Ulrich Drepper + + * 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 + + * Makefile.in (all-gettext): New goal. Same as all-yes. + +Thu Mar 28 23:01:22 1996 Karl Eichwalder + + * Makefile.in (gettextsrcdir): Define using @datadir@. + +Tue Mar 26 12:39:14 1996 Ulrich Drepper + + * finddomain.c: Include . Reported by Roland McGrath. + +Sat Mar 23 02:00:35 1996 Ulrich Drepper + + * finddomain.c (stpcpy): Rename to stpcpy__ to prevent clashing + with external declaration. + +Sat Mar 2 00:47:09 1996 Ulrich Drepper + + * Makefile.in (all-no): Rename from all_no. + +Sat Feb 17 00:25:59 1996 Ulrich Drepper + + * 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 + + * 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 + + * localealias.c (alias_compare): Increment string pointers in loop + of strcasecmp replacement. + +Fri Dec 29 21:16:34 1995 Ulrich Drepper + + * Makefile.in (install-src): Who commented this goal out ? :-) + +Fri Dec 29 15:08:16 1995 Ulrich Drepper + + * dcgettext.c (DCGETTEXT): Save `errno'. Failing system calls + should not effect it because a missing catalog is no error. + Reported by Harald Knig . + +Tue Dec 19 22:09:13 1995 Ulrich Drepper + + * Makefile.in (Makefile): Explicitly use $(SHELL) for running + shell scripts. + +Fri Dec 15 17:34:59 1995 Andreas Schwab + + * 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 + + * 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 + + * 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 + + * Makefile.in (install-src): + Install libintl.inst instead of libintl.h.install. + +Sat Dec 2 22:51:38 1995 Marcus Daniels + + * 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 + + * cat-compat.c (bindtextdomain): Add missing { }. + +Sun Nov 26 18:21:41 1995 Ulrich Drepper + + * 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 + + * hash-string.h: Capitalize arguments of macros. + +Sat Nov 25 12:01:36 1995 Ulrich Drepper + + * 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 + + * dcgettext.c: Fix bug in preprocessor conditionals. + +Sat Nov 25 02:35:27 1995 Nelson H. F. Beebe + + * libgettext.h: Solaris cc does not understand + #if !SYMBOL1 && !SYMBOL2. Sad but true. + +Thu Nov 23 16:22:14 1995 Ulrich Drepper + + * 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 + + * 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 + + * 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 + + * hash-string.h: Correct prototype for hash_string. + +Sun Nov 12 12:42:30 1995 Ulrich Drepper + + * hash-string.h (hash_string): Add prototype. + + * gettextP.h: Fix copyright. + (SWAP): Add prototype. + +Wed Nov 8 22:56:33 1995 Ulrich Drepper + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * po2tbl.sed.in: Serious typo bug fixed by Jim Meyering. + +Sat Oct 28 23:20:47 1995 Ulrich Drepper + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * cat-compat.c: Include 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 + + * 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 + + * finddomain.c: Correct some bugs in handling of CEN standard + locale definitions. + +Thu Sep 7 01:49:28 1995 Ulrich Drepper + + * finddomain.c: Implement CEN syntax. + + * gettextP.h (loaded_domain): Extend number of successors to 31. + +Sat Aug 19 19:25:29 1995 Ulrich Drepper + + * 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 + + * Makefile.in (uninstall): Remove stuff installed by install-src. + +Tue Aug 15 13:13:53 1995 Ulrich Drepper + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * finddomain.c (unistd.h): + Include to get _PC_PATH_MAX defined on system having it. + +Fri Aug 4 22:42:00 1995 Ulrich Drepper + + * finddomain.c (stpcpy): Include prototype. + + * Makefile.in (dist): Remove `copying instead' message. + +Wed Aug 2 18:52:03 1995 Ulrich Drepper + + * Makefile.in (ID, TAGS): Do not use $^. + +Tue Aug 1 20:07:11 1995 Ulrich Drepper + + * 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 + + * 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 + + * 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 + + * intl-compat.c (textdomain): Correct typo. + +Wed Jul 19 01:51:35 1995 Ulrich Drepper + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * cat-compat.c: If !STDC_HEADERS try to include malloc.h. + +Thu Jul 13 20:55:02 1995 Ulrich Drepper + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * tupdate.perl.in: Complete rewrite for new .po file format. + +Sun Jul 2 02:06:50 1995 Ulrich Drepper + + * 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. diff --git a/intl/Makefile.in b/intl/Makefile.in new file mode 100644 index 00000000..c5e0ca9e --- /dev/null +++ b/intl/Makefile.in @@ -0,0 +1,214 @@ +# 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: diff --git a/intl/VERSION b/intl/VERSION new file mode 100644 index 00000000..d0e8c699 --- /dev/null +++ b/intl/VERSION @@ -0,0 +1 @@ +0.10.32 diff --git a/intl/bindtextdom.c b/intl/bindtextdom.c new file mode 100644 index 00000000..9fcb8d9f --- /dev/null +++ b/intl/bindtextdom.c @@ -0,0 +1,199 @@ +/* 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 +#endif + +#if defined STDC_HEADERS || defined _LIBC +# include +#else +# ifdef HAVE_MALLOC_H +# include +# else +void free (); +# endif +#endif + +#if defined HAVE_STRING_H || defined _LIBC +# include +#else +# include +# ifndef memcpy +# define memcpy(Dst, Src, Num) bcopy (Src, Dst, Num) +# endif +#endif + +#ifdef _LIBC +# include +#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 diff --git a/intl/cat-compat.c b/intl/cat-compat.c new file mode 100644 index 00000000..867d901b --- /dev/null +++ b/intl/cat-compat.c @@ -0,0 +1,262 @@ +/* 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 +#endif + +#include + +#ifdef STDC_HEADERS +# include +# include +#else +char *getenv (); +# ifdef HAVE_MALLOC_H +# include +# endif +#endif + +#ifdef HAVE_NL_TYPES_H +# include +#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 diff --git a/intl/dcgettext.c b/intl/dcgettext.c new file mode 100644 index 00000000..a316bfd1 --- /dev/null +++ b/intl/dcgettext.c @@ -0,0 +1,593 @@ +/* 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 +#endif + +#include + +#ifdef __GNUC__ +# define alloca __builtin_alloca +# define HAVE_ALLOCA 1 +#else +# if defined HAVE_ALLOCA_H || defined _LIBC +# include +# else +# ifdef _AIX + #pragma alloca +# else +# ifndef alloca +char *alloca (); +# endif +# endif +# endif +#endif + +#include +#ifndef errno +extern int errno; +#endif +#ifndef __set_errno +# define __set_errno(val) errno = (val) +#endif + +#if defined STDC_HEADERS || defined _LIBC +# include +#else +char *getenv (); +# ifdef HAVE_MALLOC_H +# include +# else +void free (); +# endif +#endif + +#if defined HAVE_STRING_H || defined _LIBC +# ifndef _GNU_SOURCE +# define _GNU_SOURCE 1 +# endif +# include +#else +# include +#endif +#if !HAVE_STRCHR && !defined _LIBC +# ifndef strchr +# define strchr index +# endif +#endif + +#if defined HAVE_UNISTD_H || defined _LIBC +# include +#endif + +#include "gettext.h" +#include "gettextP.h" +#ifdef _LIBC +# include +#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 +#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 +#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 diff --git a/intl/dgettext.c b/intl/dgettext.c new file mode 100644 index 00000000..2fde6770 --- /dev/null +++ b/intl/dgettext.c @@ -0,0 +1,59 @@ +/* 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 +#endif + +#if defined HAVE_LOCALE_H || defined _LIBC +# include +#endif + +#ifdef _LIBC +# include +#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 diff --git a/intl/explodename.c b/intl/explodename.c new file mode 100644 index 00000000..e45b2a21 --- /dev/null +++ b/intl/explodename.c @@ -0,0 +1,181 @@ +/* Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. + Contributed by Ulrich Drepper , 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 +#endif + +#include +#include +#include + +#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; +} diff --git a/intl/finddomain.c b/intl/finddomain.c new file mode 100644 index 00000000..fd27f6f7 --- /dev/null +++ b/intl/finddomain.c @@ -0,0 +1,189 @@ +/* Handle list of needed message catalogs + Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. + Written by Ulrich Drepper , 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 +#endif + +#include +#include +#include +#include + +#if defined STDC_HEADERS || defined _LIBC +# include +#else +# ifdef HAVE_MALLOC_H +# include +# else +void free (); +# endif +#endif + +#if defined HAVE_STRING_H || defined _LIBC +# include +#else +# include +# 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 +#endif + +#include "gettext.h" +#include "gettextP.h" +#ifdef _LIBC +# include +#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; +} diff --git a/intl/gettext.c b/intl/gettext.c new file mode 100644 index 00000000..1336d21e --- /dev/null +++ b/intl/gettext.c @@ -0,0 +1,70 @@ +/* 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 +#endif + +#ifdef _LIBC +# define __need_NULL +# include +#else +# ifdef STDC_HEADERS +# include /* Just for NULL. */ +# else +# ifdef HAVE_STRING_H +# include +# else +# define NULL ((void *) 0) +# endif +# endif +#endif + +#ifdef _LIBC +# include +#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 diff --git a/intl/gettext.h b/intl/gettext.h new file mode 100644 index 00000000..6b4b9e33 --- /dev/null +++ b/intl/gettext.h @@ -0,0 +1,105 @@ +/* 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 + +#if HAVE_LIMITS_H || _LIBC +# include +#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 ) 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 */ diff --git a/intl/gettextP.h b/intl/gettextP.h new file mode 100644 index 00000000..bb8d5523 --- /dev/null +++ b/intl/gettextP.h @@ -0,0 +1,73 @@ +/* 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 */ diff --git a/intl/hash-string.h b/intl/hash-string.h new file mode 100644 index 00000000..e66e8417 --- /dev/null +++ b/intl/hash-string.h @@ -0,0 +1,63 @@ +/* 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 +#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; +} diff --git a/intl/intl-compat.c b/intl/intl-compat.c new file mode 100644 index 00000000..503efa0f --- /dev/null +++ b/intl/intl-compat.c @@ -0,0 +1,76 @@ +/* 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 +#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); +} diff --git a/intl/l10nflist.c b/intl/l10nflist.c new file mode 100644 index 00000000..1b1da1ff --- /dev/null +++ b/intl/l10nflist.c @@ -0,0 +1,409 @@ +/* Handle list of needed message catalogs + Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. + Written by Ulrich Drepper , 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 +#endif + + +#if defined HAVE_STRING_H || defined _LIBC +# ifndef _GNU_SOURCE +# define _GNU_SOURCE 1 +# endif +# include +#else +# include +# 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 +#endif +#include +#include + +#if defined STDC_HEADERS || defined _LIBC +# include +#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; +} + + +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; +} + +/* 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 diff --git a/intl/libgettext.h b/intl/libgettext.h new file mode 100644 index 00000000..0d4de4d0 --- /dev/null +++ b/intl/libgettext.h @@ -0,0 +1,182 @@ +/* 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 + +#if HAVE_LOCALE_H +# include +#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 diff --git a/intl/linux-msg.sed b/intl/linux-msg.sed new file mode 100644 index 00000000..7feb38d6 --- /dev/null +++ b/intl/linux-msg.sed @@ -0,0 +1,100 @@ +# po2msg.sed - Convert Uniforum style .po file to Linux style .msg file +# Copyright (C) 1995 Free Software Foundation, Inc. +# Ulrich Drepper , 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 + 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 diff --git a/intl/loadinfo.h b/intl/loadinfo.h new file mode 100644 index 00000000..c67c2eb2 --- /dev/null +++ b/intl/loadinfo.h @@ -0,0 +1,58 @@ +#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)); diff --git a/intl/loadmsgcat.c b/intl/loadmsgcat.c new file mode 100644 index 00000000..73e90a91 --- /dev/null +++ b/intl/loadmsgcat.c @@ -0,0 +1,199 @@ +/* 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 +#endif + +#include +#include +#include + +#if defined STDC_HEADERS || defined _LIBC +# include +#endif + +#if defined HAVE_UNISTD_H || defined _LIBC +# include +#endif + +#if (defined HAVE_MMAP && defined HAVE_MUNMAP) || defined _LIBC +# include +#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; +} diff --git a/intl/localealias.c b/intl/localealias.c new file mode 100644 index 00000000..64e8ca78 --- /dev/null +++ b/intl/localealias.c @@ -0,0 +1,378 @@ +/* Handle aliases for locale names + Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. + Written by Ulrich Drepper , 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 +#endif + +#include +#include +#include + +#ifdef __GNUC__ +# define alloca __builtin_alloca +# define HAVE_ALLOCA 1 +#else +# if defined HAVE_ALLOCA_H || defined _LIBC +# include +# else +# ifdef _AIX + #pragma alloca +# else +# ifndef alloca +char *alloca (); +# endif +# endif +# endif +#endif + +#if defined STDC_HEADERS || defined _LIBC +# include +#else +char *getenv (); +# ifdef HAVE_MALLOC_H +# include +# else +void free (); +# endif +#endif + +#if defined HAVE_STRING_H || defined _LIBC +# ifndef _GNU_SOURCE +# define _GNU_SOURCE 1 +# endif +# include +#else +# include +# 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 +} diff --git a/intl/po2tbl.sed.in b/intl/po2tbl.sed.in new file mode 100644 index 00000000..247b668a --- /dev/null +++ b/intl/po2tbl.sed.in @@ -0,0 +1,102 @@ +# po2tbl.sed - Convert Uniforum style .po file to lookup table for catgets +# Copyright (C) 1995 Free Software Foundation, Inc. +# Ulrich Drepper , 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 \ +#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 + 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 diff --git a/intl/textdomain.c b/intl/textdomain.c new file mode 100644 index 00000000..beb1f06d --- /dev/null +++ b/intl/textdomain.c @@ -0,0 +1,106 @@ +/* Implementation of the textdomain(3) function + Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. + Written by Ulrich Drepper , 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 +#endif + +#if defined STDC_HEADERS || defined _LIBC +# include +#endif + +#if defined STDC_HEADERS || defined HAVE_STRING_H || defined _LIBC +# include +#else +# include +# ifndef memcpy +# define memcpy(Dst, Src, Num) bcopy (Src, Dst, Num) +# endif +#endif + +#ifdef _LIBC +# include +#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 diff --git a/intl/xopen-msg.sed b/intl/xopen-msg.sed new file mode 100644 index 00000000..b35588f0 --- /dev/null +++ b/intl/xopen-msg.sed @@ -0,0 +1,104 @@ +# po2msg.sed - Convert Uniforum style .po file to X/Open style .msg file +# Copyright (C) 1995 Free Software Foundation, Inc. +# Ulrich Drepper , 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 + 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 ` ' + 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 diff --git a/lib/ChangeLog b/lib/ChangeLog new file mode 100644 index 00000000..211133d4 --- /dev/null +++ b/lib/ChangeLog @@ -0,0 +1,30 @@ +Sun Jan 2 21:31:48 2000 Ben Pfaff + + * Makefile.am: (SUBDIRS) Only include gmp if libgmp not installed + on this system already. + +Sun May 31 00:55:51 1998 Ben Pfaff + + * 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 + + * Makefile.am: (SUBDIRS) Remove avllib. + + * avllib/: Removed. + +Wed Dec 24 22:36:50 1997 Ben Pfaff + + * Makefile.am: (SUBDIRS) Add dcdflib. + + * dcdflib: New subdirectory. + +---------------------------------------------------------------------- +Local Variables: +mode: change-log +version-control: never +End: diff --git a/lib/Makefile.am b/lib/Makefile.am new file mode 100644 index 00000000..99184378 --- /dev/null +++ b/lib/Makefile.am @@ -0,0 +1,6 @@ +## 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 diff --git a/lib/dcdflib/COPYING b/lib/dcdflib/COPYING new file mode 100644 index 00000000..173ab1a9 --- /dev/null +++ b/lib/dcdflib/COPYING @@ -0,0 +1,41 @@ +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.) diff --git a/lib/dcdflib/ChangeLog b/lib/dcdflib/ChangeLog new file mode 100644 index 00000000..6cef35fc --- /dev/null +++ b/lib/dcdflib/ChangeLog @@ -0,0 +1,32 @@ +Sun Aug 9 11:16:26 1998 Ben Pfaff + + * dcdflib.COPYING: Renamed COPYING. + +Sun Jul 5 00:14:51 1998 Ben Pfaff + + * cdflib.h: Move E0000, E0001 prototypes into dcdflib.c. + +Thu May 7 22:56:48 1998 Ben Pfaff + + * 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 + + * README: New file. + +Wed Dec 24 22:37:21 1997 Ben Pfaff + + * 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. + + diff --git a/lib/dcdflib/Makefile.am b/lib/dcdflib/Makefile.am new file mode 100644 index 00000000..e2ee995c --- /dev/null +++ b/lib/dcdflib/Makefile.am @@ -0,0 +1,13 @@ +## 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 diff --git a/lib/dcdflib/README b/lib/dcdflib/README new file mode 100644 index 00000000..cfafc4d4 --- /dev/null +++ b/lib/dcdflib/README @@ -0,0 +1,5 @@ +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 diff --git a/lib/dcdflib/cdflib.h b/lib/dcdflib/cdflib.h new file mode 100644 index 00000000..5f1ce3c2 --- /dev/null +++ b/lib/dcdflib/cdflib.h @@ -0,0 +1,80 @@ +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*); + diff --git a/lib/dcdflib/dcdflib.c b/lib/dcdflib/dcdflib.c new file mode 100644 index 00000000..91f606bc --- /dev/null +++ b/lib/dcdflib/dcdflib.c @@ -0,0 +1,9093 @@ +#include +#include +#include +#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 */ +} diff --git a/lib/dcdflib/ipmpar.c b/lib/dcdflib/ipmpar.c new file mode 100644 index 00000000..bdf42d92 --- /dev/null +++ b/lib/dcdflib/ipmpar.c @@ -0,0 +1,97 @@ +#include + +#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; +} diff --git a/lib/gmp/COPYING.LIB b/lib/gmp/COPYING.LIB new file mode 100644 index 00000000..92b8903f --- /dev/null +++ b/lib/gmp/COPYING.LIB @@ -0,0 +1,481 @@ + 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. + + 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. + + 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. + + 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. + + 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. + + 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. + + 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. + + 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. + + 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 + + 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. + + + Copyright (C) + + 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. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/lib/gmp/ChangeLog b/lib/gmp/ChangeLog new file mode 100644 index 00000000..e398ea69 --- /dev/null +++ b/lib/gmp/ChangeLog @@ -0,0 +1,29 @@ +Mon Dec 14 11:52:05 1998 Ben Pfaff + + * Makefile.am, mpn/Makefile.am, mpf/Makefile.am: (INCLUDES) Add + -I$(top_srcdir)/intl. Thanks to OKUJI Yoshinori + . + +Thu Nov 19 12:35:13 1998 Ben Pfaff + + * Thanks to Hans Olav Eggestad 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 + + * Makefile.am: Fixed for renamed file. + + * extract-double.c: Renamed extract-dbl.c. + +---------------------------------------------------------------------- +Local Variables: +mode: change-log +version-control: never +End: diff --git a/lib/gmp/INSTALL b/lib/gmp/INSTALL new file mode 100644 index 00000000..7e4ae38d --- /dev/null +++ b/lib/gmp/INSTALL @@ -0,0 +1,43 @@ +(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 "" diff --git a/lib/gmp/Makefile.am b/lib/gmp/Makefile.am new file mode 100644 index 00000000..b563f67b --- /dev/null +++ b/lib/gmp/Makefile.am @@ -0,0 +1,11 @@ +## 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 diff --git a/lib/gmp/extract-dbl.c b/lib/gmp/extract-dbl.c new file mode 100644 index 00000000..84bd661a --- /dev/null +++ b/lib/gmp/extract-dbl.c @@ -0,0 +1,161 @@ +/* __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 +#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; +} diff --git a/lib/gmp/gmp-impl.h b/lib/gmp/gmp-impl.h new file mode 100644 index 00000000..a838ba65 --- /dev/null +++ b/lib/gmp/gmp-impl.h @@ -0,0 +1,374 @@ +/* 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 +#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)); diff --git a/lib/gmp/gmp-mparam.h b/lib/gmp/gmp-mparam.h new file mode 100644 index 00000000..f3cbe781 --- /dev/null +++ b/lib/gmp/gmp-mparam.h @@ -0,0 +1,27 @@ +/* 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 diff --git a/lib/gmp/gmp.h b/lib/gmp/gmp.h new file mode 100644 index 00000000..a1cc1ac7 --- /dev/null +++ b/lib/gmp/gmp.h @@ -0,0 +1,632 @@ +/* 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 +#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__ */ diff --git a/lib/gmp/longlong.h b/lib/gmp/longlong.h new file mode 100644 index 00000000..e9c25212 --- /dev/null +++ b/lib/gmp/longlong.h @@ -0,0 +1,1410 @@ +/* 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 diff --git a/lib/gmp/memory.c b/lib/gmp/memory.c new file mode 100644 index 00000000..2cd64a1f --- /dev/null +++ b/lib/gmp/memory.c @@ -0,0 +1,98 @@ +/* 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 +#include + +#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); +} diff --git a/lib/gmp/mp_clz_tab.c b/lib/gmp/mp_clz_tab.c new file mode 100644 index 00000000..6fd7e908 --- /dev/null +++ b/lib/gmp/mp_clz_tab.c @@ -0,0 +1,40 @@ +/* __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, +}; diff --git a/lib/gmp/mpf/Makefile.am b/lib/gmp/mpf/Makefile.am new file mode 100644 index 00000000..c048998c --- /dev/null +++ b/lib/gmp/mpf/Makefile.am @@ -0,0 +1,9 @@ +## 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 diff --git a/lib/gmp/mpf/clear.c b/lib/gmp/mpf/clear.c new file mode 100644 index 00000000..00284f55 --- /dev/null +++ b/lib/gmp/mpf/clear.c @@ -0,0 +1,36 @@ +/* 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 +#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); +} diff --git a/lib/gmp/mpf/get_str.c b/lib/gmp/mpf/get_str.c new file mode 100644 index 00000000..f6cf10d2 --- /dev/null +++ b/lib/gmp/mpf/get_str.c @@ -0,0 +1,501 @@ +/* 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 +#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 diff --git a/lib/gmp/mpf/iset_d.c b/lib/gmp/mpf/iset_d.c new file mode 100644 index 00000000..3d4427ea --- /dev/null +++ b/lib/gmp/mpf/iset_d.c @@ -0,0 +1,40 @@ +/* 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 +#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); +} diff --git a/lib/gmp/mpf/set_d.c b/lib/gmp/mpf/set_d.c new file mode 100644 index 00000000..a9fcfed6 --- /dev/null +++ b/lib/gmp/mpf/set_d.c @@ -0,0 +1,48 @@ +/* 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 +#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; +} diff --git a/lib/gmp/mpf/set_dfl_prec.c b/lib/gmp/mpf/set_dfl_prec.c new file mode 100644 index 00000000..c8db2d6e --- /dev/null +++ b/lib/gmp/mpf/set_dfl_prec.c @@ -0,0 +1,41 @@ +/* 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 +#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; +} diff --git a/lib/gmp/mpn/Makefile.am b/lib/gmp/mpn/Makefile.am new file mode 100644 index 00000000..80b7c64d --- /dev/null +++ b/lib/gmp/mpn/Makefile.am @@ -0,0 +1,10 @@ +## 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 diff --git a/lib/gmp/mpn/add_n.c b/lib/gmp/mpn/add_n.c new file mode 100644 index 00000000..ecaec46c --- /dev/null +++ b/lib/gmp/mpn/add_n.c @@ -0,0 +1,63 @@ +/* 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 +#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; +} diff --git a/lib/gmp/mpn/addmul_1.c b/lib/gmp/mpn/addmul_1.c new file mode 100644 index 00000000..ec580917 --- /dev/null +++ b/lib/gmp/mpn/addmul_1.c @@ -0,0 +1,66 @@ +/* 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 +#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; +} diff --git a/lib/gmp/mpn/cmp.c b/lib/gmp/mpn/cmp.c new file mode 100644 index 00000000..95d44f95 --- /dev/null +++ b/lib/gmp/mpn/cmp.c @@ -0,0 +1,57 @@ +/* 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 +#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; +} diff --git a/lib/gmp/mpn/divrem.c b/lib/gmp/mpn/divrem.c new file mode 100644 index 00000000..1b41f6c9 --- /dev/null +++ b/lib/gmp/mpn/divrem.c @@ -0,0 +1,246 @@ +/* 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 +#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; +} diff --git a/lib/gmp/mpn/get_str.c b/lib/gmp/mpn/get_str.c new file mode 100644 index 00000000..77c16436 --- /dev/null +++ b/lib/gmp/mpn/get_str.c @@ -0,0 +1,212 @@ +/* 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 +#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; + } +} diff --git a/lib/gmp/mpn/inlines.c b/lib/gmp/mpn/inlines.c new file mode 100644 index 00000000..5c137d34 --- /dev/null +++ b/lib/gmp/mpn/inlines.c @@ -0,0 +1,4 @@ +#include +#define _FORCE_INLINES +#define _EXTERN_INLINE /* empty */ +#include "gmp.h" diff --git a/lib/gmp/mpn/lshift.c b/lib/gmp/mpn/lshift.c new file mode 100644 index 00000000..1d73afbc --- /dev/null +++ b/lib/gmp/mpn/lshift.c @@ -0,0 +1,88 @@ +/* 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 +#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; +} diff --git a/lib/gmp/mpn/mp_bases.c b/lib/gmp/mpn/mp_bases.c new file mode 100644 index 00000000..f2f6daef --- /dev/null +++ b/lib/gmp/mpn/mp_bases.c @@ -0,0 +1,550 @@ +/* __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 +#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 diff --git a/lib/gmp/mpn/mul.c b/lib/gmp/mpn/mul.c new file mode 100644 index 00000000..960eb94e --- /dev/null +++ b/lib/gmp/mpn/mul.c @@ -0,0 +1,153 @@ +/* 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 +#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; +} diff --git a/lib/gmp/mpn/mul_1.c b/lib/gmp/mpn/mul_1.c new file mode 100644 index 00000000..21aa9510 --- /dev/null +++ b/lib/gmp/mpn/mul_1.c @@ -0,0 +1,60 @@ +/* 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 +#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; +} diff --git a/lib/gmp/mpn/mul_n.c b/lib/gmp/mpn/mul_n.c new file mode 100644 index 00000000..104d332f --- /dev/null +++ b/lib/gmp/mpn/mul_n.c @@ -0,0 +1,402 @@ +/* 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 +#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); +} diff --git a/lib/gmp/mpn/sub_n.c b/lib/gmp/mpn/sub_n.c new file mode 100644 index 00000000..09478577 --- /dev/null +++ b/lib/gmp/mpn/sub_n.c @@ -0,0 +1,63 @@ +/* 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 +#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; +} diff --git a/lib/gmp/mpn/submul_1.c b/lib/gmp/mpn/submul_1.c new file mode 100644 index 00000000..8af60a7c --- /dev/null +++ b/lib/gmp/mpn/submul_1.c @@ -0,0 +1,66 @@ +/* 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 +#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; +} diff --git a/lib/julcal/ChangeLog b/lib/julcal/ChangeLog new file mode 100644 index 00000000..29810492 --- /dev/null +++ b/lib/julcal/ChangeLog @@ -0,0 +1,49 @@ +Sun Jan 2 21:32:13 2000 Ben Pfaff + + * 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 + + * README: New file. + +Fri Dec 26 15:43:57 1997 Ben Pfaff + + * julcal.c: (julian_offset) Move glob var definition here. + +Sun Jul 6 19:12:18 1997 Ben Pfaff + + * Makefile.am: Fixed INCLUDES to include intl; fixed directories. + +Sun Jun 1 17:27:17 1997 Ben Pfaff + + * julcal.h: Made the declaration of macros with arguments a lot + nicer looking. + +Fri Apr 18 16:48:41 1997 Ben Pfaff + + * Makefile.am: Refers to src/ as include directory instead of + include/. + +Fri Apr 18 15:42:22 1997 Ben Pfaff + + * Makefile.am: Maintainer-clean Makefile.in. + +Thu Oct 24 17:47:14 1996 Ben Pfaff + + * julcal.h: Comment fix. + +---------------------------------------------------------------------- +Local Variables: +mode: change-log +version-control: never +End: diff --git a/lib/julcal/Makefile.am b/lib/julcal/Makefile.am new file mode 100644 index 00000000..90674584 --- /dev/null +++ b/lib/julcal/Makefile.am @@ -0,0 +1,11 @@ +## 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 diff --git a/lib/julcal/README b/lib/julcal/README new file mode 100644 index 00000000..7cc95aa3 --- /dev/null +++ b/lib/julcal/README @@ -0,0 +1,5 @@ +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 diff --git a/lib/julcal/julcal.c b/lib/julcal/julcal.c new file mode 100644 index 00000000..46b07657 --- /dev/null +++ b/lib/julcal/julcal.c @@ -0,0 +1,183 @@ +/* + 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 */ +#include +#include +#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 + +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 diff --git a/lib/julcal/julcal.h b/lib/julcal/julcal.h new file mode 100644 index 00000000..e1a4415b --- /dev/null +++ b/lib/julcal/julcal.h @@ -0,0 +1,15 @@ +/* + 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 */ diff --git a/lib/misc/ChangeLog b/lib/misc/ChangeLog new file mode 100644 index 00000000..9bcae51a --- /dev/null +++ b/lib/misc/ChangeLog @@ -0,0 +1,148 @@ +Sun Jan 2 21:35:47 2000 Ben Pfaff + + * 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 + + * strcasecmp.c: (strcasecmp) Fix behavior for zero-length strings. + +Sun Jul 5 00:15:44 1998 Ben Pfaff + + * qsort.c: (blp_quicksort) Add unused qualifier to temp_buf when + alloca is in use. + +1998-02-23 Ben Pfaff + + * Makefile.am: (EXTRA_DIST) Add strtok_r.c. + + * strtok_r.c: New file. + +1998-02-16 Ben Pfaff + + * memmem.c: Cast void * to char * before dereferencing, in a + different place. + +Fri Feb 13 15:35:55 1998 Ben Pfaff + + * 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 + + * memmem.c: Fix argument types. + +Sun Oct 5 15:54:37 1997 Ben Pfaff + + * Makefile.am: (EXTRA_DIST) Add strerror.c. From Alexandre Oliva + . + + * strerror.c: New file. From Alexandre Oliva + . + +Thu Sep 18 21:34:07 1997 Ben Pfaff + + * 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 + + * strncasecmp.c: (strncasecmp) Rewritten to fix undefined + behavior. + +Fri Jul 11 14:06:04 1997 Ben Pfaff + + * getdelim.c: Added in some necessary #include's. + + * getline.c: #include's . Added getdelim() prototype. + + * memmem.c: #include's . + (memmem) `i' now a size_t. Avoid subtraction of unsigned's. + +Sun Jul 6 19:12:35 1997 Ben Pfaff + + * Makefile.am: Fixed INCLUDES to include intl; fixed directories. + +Mon Jun 2 14:22:24 1997 Ben Pfaff + + * getopt.c: Marked strings for gettext. + +Fri Apr 18 16:48:41 1997 Ben Pfaff + + * Makefile.am: Refers to src/ as include directory instead of + include/. + +Fri Apr 18 15:42:22 1997 Ben Pfaff + + * Makefile.am: Maintainer-clean Makefile.in. + +Thu Mar 27 01:11:29 1997 Ben Pfaff + + * 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 + + * qsort.c: New file, essentially unchanged from the glibc-1.09 + distribution. + +Mon Nov 11 15:34:09 1996 Ben Pfaff + + * 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 + + * 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 + + * stpcpy.c: Comment fix. + +Fri Sep 20 22:52:28 1996 Ben Pfaff + + * alloca.c: Changed conditions for inclusion. + +Tue Jul 23 21:48:36 1996 Ben Pfaff + + * 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 + + * 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: diff --git a/lib/misc/Makefile.am b/lib/misc/Makefile.am new file mode 100644 index 00000000..bedc884d --- /dev/null +++ b/lib/misc/Makefile.am @@ -0,0 +1,16 @@ +## 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 diff --git a/lib/misc/alloca.c b/lib/misc/alloca.c new file mode 100644 index 00000000..be1f0c42 --- /dev/null +++ b/lib/misc/alloca.c @@ -0,0 +1,178 @@ +/* + 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 +#include +#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__ */ diff --git a/lib/misc/getdelim.c b/lib/misc/getdelim.c new file mode 100644 index 00000000..3e74f947 --- /dev/null +++ b/lib/misc/getdelim.c @@ -0,0 +1,72 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997, 1998 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#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; +} diff --git a/lib/misc/getline.c b/lib/misc/getline.c new file mode 100644 index 00000000..5da0e0bd --- /dev/null +++ b/lib/misc/getline.c @@ -0,0 +1,32 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997, 1998 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include + +#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); +} diff --git a/lib/misc/getopt.c b/lib/misc/getopt.c new file mode 100644 index 00000000..fa215170 --- /dev/null +++ b/lib/misc/getopt.c @@ -0,0 +1,754 @@ +/* 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. */ + +/* This file has been modified from the GNU libc distribution. */ + +/* This tells Alpha OSF/1 not to define a getopt prototype in . + Ditto for AIX 3.2 and . */ +#ifndef _NO_PROTO +#define _NO_PROTO +#endif + +#include + +#if !defined (__STDC__) || !__STDC__ +/* This is a separate conditional since some stdc systems + reject `defined (const)'. */ +#ifndef const +#define const +#endif +#endif + +#include + +/* 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 +#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; + +#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 +#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__ */ + +/* 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; +} + +/* 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__. */ + +#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 */ diff --git a/lib/misc/getopt1.c b/lib/misc/getopt1.c new file mode 100644 index 00000000..361872a3 --- /dev/null +++ b/lib/misc/getopt1.c @@ -0,0 +1,183 @@ +/* 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. */ + +/* This file has been modified from the GNU libc distribution. */ +#include + +#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 + +/* 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 +#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__. */ + +#ifdef TEST + +#include + +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 */ diff --git a/lib/misc/memchr.c b/lib/misc/memchr.c new file mode 100644 index 00000000..44482489 --- /dev/null +++ b/lib/misc/memchr.c @@ -0,0 +1,199 @@ +/* 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 +#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 +#endif + +#if defined (HAVE_LIMITS_H) || defined (_LIBC) +# include +#endif + +#define LONG_MAX_32_BITS 2147483647 + +#ifndef LONG_MAX +#define LONG_MAX LONG_MAX_32_BITS +#endif + +#include + + +/* 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; +} diff --git a/lib/misc/memcmp.c b/lib/misc/memcmp.c new file mode 100644 index 00000000..ae4644e2 --- /dev/null +++ b/lib/misc/memcmp.c @@ -0,0 +1,364 @@ +/* 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 +#endif + +#ifdef _LIBC + +#include + +#else /* Not in the GNU C library. */ + +#include + +/* 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; +} diff --git a/lib/misc/memcpy.c b/lib/misc/memcpy.c new file mode 100644 index 00000000..d36cef20 --- /dev/null +++ b/lib/misc/memcpy.c @@ -0,0 +1,20 @@ +/* Copy LEN bytes starting at SRCADDR to DESTADDR. Result undefined + if the source overlaps with the destination. + Return DESTADDR. */ + +#if HAVE_CONFIG_H +# include +#endif + +char * +memcpy (destaddr, srcaddr, len) + char *destaddr; + const char *srcaddr; + int len; +{ + char *dest = destaddr; + + while (len-- > 0) + *destaddr++ = *srcaddr++; + return dest; +} diff --git a/lib/misc/memmem.c b/lib/misc/memmem.c new file mode 100644 index 00000000..1ffbc29b --- /dev/null +++ b/lib/misc/memmem.c @@ -0,0 +1,42 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997, 1998 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +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; +} + diff --git a/lib/misc/memmove.c b/lib/misc/memmove.c new file mode 100644 index 00000000..d83cad32 --- /dev/null +++ b/lib/misc/memmove.c @@ -0,0 +1,36 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997, 1998 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 . */ + +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--; + } +} + diff --git a/lib/misc/memset.c b/lib/misc/memset.c new file mode 100644 index 00000000..a0db560a --- /dev/null +++ b/lib/misc/memset.c @@ -0,0 +1,29 @@ +/* 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; +} diff --git a/lib/misc/qsort.c b/lib/misc/qsort.c new file mode 100644 index 00000000..23f47c58 --- /dev/null +++ b/lib/misc/qsort.c @@ -0,0 +1,257 @@ +/* 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 +#include +#include +#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; + } + } + } + } +} diff --git a/lib/misc/stpcpy.c b/lib/misc/stpcpy.c new file mode 100644 index 00000000..b9df2972 --- /dev/null +++ b/lib/misc/stpcpy.c @@ -0,0 +1,47 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997, 1998 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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]; +} diff --git a/lib/misc/strcasecmp.c b/lib/misc/strcasecmp.c new file mode 100644 index 00000000..c71940b7 --- /dev/null +++ b/lib/misc/strcasecmp.c @@ -0,0 +1,33 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997, 1998 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +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++; + } +} diff --git a/lib/misc/strerror.c b/lib/misc/strerror.c new file mode 100644 index 00000000..f2ed4d74 --- /dev/null +++ b/lib/misc/strerror.c @@ -0,0 +1,48 @@ +/* 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 +#endif + +#include +#ifdef HAVE_ERRNO_H +#include +#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; + } +} diff --git a/lib/misc/strncasecmp.c b/lib/misc/strncasecmp.c new file mode 100644 index 00000000..ad14c2f0 --- /dev/null +++ b/lib/misc/strncasecmp.c @@ -0,0 +1,37 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997, 1998 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +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; +} diff --git a/lib/misc/strpbrk.c b/lib/misc/strpbrk.c new file mode 100644 index 00000000..75b2ed14 --- /dev/null +++ b/lib/misc/strpbrk.c @@ -0,0 +1,38 @@ +/* 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 + + +/* 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; +} diff --git a/lib/misc/strstr.c b/lib/misc/strstr.c new file mode 100644 index 00000000..990cae53 --- /dev/null +++ b/lib/misc/strstr.c @@ -0,0 +1,24 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997, 1998 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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)); +} diff --git a/lib/misc/strtok_r.c b/lib/misc/strtok_r.c new file mode 100644 index 00000000..fb68ad8c --- /dev/null +++ b/lib/misc/strtok_r.c @@ -0,0 +1,62 @@ +/* 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 + + +/* 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; +} diff --git a/lib/misc/strtol.c b/lib/misc/strtol.c new file mode 100644 index 00000000..025287a3 --- /dev/null +++ b/lib/misc/strtol.c @@ -0,0 +1,368 @@ +/* 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 +#endif + +#ifdef _LIBC +# define USE_NUMBER_GROUPING +# define STDC_HEADERS +# define HAVE_LIMITS_H +#endif + +#include +#include +#ifndef errno +extern int errno; +#endif +#ifndef __set_errno +# define __set_errno(Val) errno = (Val) +#endif + +#ifdef HAVE_LIMITS_H +# include +#endif + +#ifdef STDC_HEADERS +# include +# include +# include +#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 +# include +# 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 . */ + 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; +} + +/* 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); +} diff --git a/lib/misc/strtoul.c b/lib/misc/strtoul.c new file mode 100644 index 00000000..715ba30b --- /dev/null +++ b/lib/misc/strtoul.c @@ -0,0 +1,22 @@ +/* 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 diff --git a/po/ChangeLog b/po/ChangeLog new file mode 100644 index 00000000..b7fcbbb8 --- /dev/null +++ b/po/ChangeLog @@ -0,0 +1,53 @@ +Sat Jan 1 23:27:03 2000 Ben Pfaff + + * POTFILES.in: Update. + +Thu Jan 8 22:27:38 1998 Ben Pfaff + + * POTFILES.in: Recreate. + + * Makefile.in.in: Upcase `pspp' within maintainer-clean target. + +Tue Dec 2 14:35:47 1997 Ben Pfaff + + * POTFILES.in: Add src/aggregate.c; alphabetize. + +Wed Oct 8 15:53:13 1997 Ben Pfaff + + * Makefile.in.in: Updated to gettext-0.10.32 while retaining local + fixes. + +Tue Oct 7 20:22:25 1997 Ben Pfaff + + * Makefile.in.in: Maintainer-cleans Makefile. + +Thu Jul 17 01:51:23 1997 Ben Pfaff + + * POTFILES.in: Remove src/display.c. + +Sat Jul 5 23:44:30 1997 Ben Pfaff + + * POTFILES.in: Fix file list. + +Tue Jun 3 23:29:57 1997 Ben Pfaff + + * Makefile.in.in: Maintainer-cleans fiasco.pot. + +Mon Jun 2 14:22:59 1997 Ben Pfaff + + * 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 + + * 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: diff --git a/po/Makefile.in.in b/po/Makefile.in.in new file mode 100644 index 00000000..280fae2c --- /dev/null +++ b/po/Makefile.in.in @@ -0,0 +1,247 @@ +# Makefile for program source directory in GNU NLS utilities package. +# Copyright (C) 1995, 1996, 1997 by Ulrich Drepper +# +# 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: diff --git a/po/POTFILES.in b/po/POTFILES.in new file mode 100644 index 00000000..2a206113 --- /dev/null +++ b/po/POTFILES.in @@ -0,0 +1,138 @@ +# 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 + diff --git a/po/pspp.pot b/po/pspp.pot new file mode 100644 index 00000000..ba2ecf3d --- /dev/null +++ b/po/pspp.pot @@ -0,0 +1,5355 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR Free Software Foundation, Inc. +# FIRST AUTHOR , 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 \n" +"Language-Team: LANGUAGE \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 "<>" +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 "" +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 "" +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 "" +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 ." +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 .\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 '." +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 "<>" +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 "<>" +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 "" +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 "" +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 "" diff --git a/pref.h.orig b/pref.h.orig new file mode 100644 index 00000000..15770947 --- /dev/null +++ b/pref.h.orig @@ -0,0 +1,268 @@ +/* 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 + +/* 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 + +/* 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 + +/* Environments. */ + +/* Internationalization. */ +#include + +#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__ */ + +/* 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 + +/* 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 + +/* 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 */ + +/* 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) diff --git a/reconfigure b/reconfigure new file mode 100755 index 00000000..8fc43d52 --- /dev/null +++ b/reconfigure @@ -0,0 +1,61 @@ +#! /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 diff --git a/src/ChangeLog b/src/ChangeLog new file mode 100644 index 00000000..c3877c4a --- /dev/null +++ b/src/ChangeLog @@ -0,0 +1,7067 @@ +Sun Jan 2 21:40:13 2000 Ben Pfaff + + * 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 + + Using alphanumeric variables in functions under AGGREGATE + segfaulted. Fixed. Thanks to Dr. Dirk Melcher + 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 + + Under certain circumstances, the final case would be omitted from + the results of an AGGREGATE operation. Fixed. Thanks to Dr. Dirk + Melcher 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 + + 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 + + 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 + + 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 + + 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 + + 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 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 + + * Makefile.cygwin: New file supplied by Hankin + for compilation with Cygnus Windows B20. Not used by other + systems. + +Sat May 29 20:36:04 1999 Ben Pfaff + + SORT always sorted in ascending order. Fixed. Thanks to Dr. Dirk + Melcher 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 + + 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 + + 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 + + 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 + + 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 + + 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 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 + + The TABLE subcommand on MATCH FILES worked only erratically at + best. This fixes it. Thanks to Dr. Dirk Melcher + 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 + + VARIABLE LABELS rejected a slash before the first variable + specification, contradicting the documentation. Thanks to Walter + M. Gray 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 + + Because of an incorrect optimization in memory allocation, + CROSSTABS sometimes segfaulted when asked to output multiple + tables. Thanks to Walter M. Gray 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 + + CROSSTABS didn't display value labels for column and row + variables. Thanks to Walter M. Gray 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 + + WRITE didn't write line ends. Fixed. Thanks to Dr. Dirk Melcher + 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 + + 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 + + MATCH FILES should set numeric values not available to the + system-missing value, not to 0. Thanks to Dr. Dirk Melcher + 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 + + KEEP didn't work properly on the SAVE procedure. Fixed. Thanks + to Ralf Geschke 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 + + 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 + + Some systems didn't like the way open_file was coded. Thanks to + Hankin 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 + + The SAVE procedure didn't save long string variables properly. + Fixed by this patch. Thanks to Hankin + 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 + + 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 + + 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 + + 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 for this + bug report. + + * list.q: (determine_layout) Allocate 1022 bytes instead of 256. + +Tue Jan 5 13:34:34 1999 Ben Pfaff + + Typo meant string format specifiers weren't checked properly. I + think that Hankin 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 + + Using $CASENUM in an expression didn't work. Here's a fix. + Thanks to Dirk Melcher 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 + + 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 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 + + 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 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 + + 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 + + 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 + + * 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 + . 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 . + + * 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 . + (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 + . + + * print.c: Needed to include alloca.h. Reported by Micah Altman + . + + * 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 . + +Thu Feb 5 00:18:21 1998 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + . + + * get.c: (cmd_get, cmd_save_internal) Allow extraneous slash + before file specification on GET, SAVE, XSAVE. Bug reported by Dr + Eberhard W Lisse . + + * q2c.c: [!HAVE_STRERROR] Include misc/strerror.c, not + strerror.c. Bug reported by Alexandre Oliva + . + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + . 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 + + * 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 + . 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * sfm-write.c, vfm.c: [HAVE_UNISTD] #include , needed by + SunOS4. From Alexandre Oliva . + +Wed Oct 8 18:55:24 1997 Ben Pfaff + + * vfm.c: (page_to_disk) Added missing local variables. + +Tue Oct 7 20:23:17 1997 Ben Pfaff + + * 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 + + * Makefile.am: (INCLUDES) Include .. instead of $(top_srcdir). + + * common.h: (macro strerror) Remove. From Alexandre Oliva + . + + * 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 + . + + * set.q: #undef ON and OFF. From Alexandre Oliva + . + + * 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 . + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 before . + + * frequencies.q: (custom_grouped, add_percentile) Don't use a + non-constant expression as an argument to sizeof. + + * glob.c: [__WIN32__ && __BORLANDC__] When including , + 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 + + 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 + + * 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 #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 with . + +Thu Jul 10 22:13:53 1997 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * get.c: Comment fix. + (cmd_save_internal) Always passes GTSV_OPT_SAVE option. + +Wed Jun 25 22:52:28 1997 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 . + Comment fixes. + +Sun Jun 1 12:02:06 1997 Ben Pfaff + + * 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 + + * 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 + + * ascii.c, postscript.c, sfm-read.c, sfm-write.c, sort.c: Include + . 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 + + * 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 + + * 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 + + * 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 + + * postscript.c: Comment fix. + (ps_open_page) Puts scale factor in PostScript output. + +Sat Apr 26 11:49:32 1997 Ben Pfaff + + * Makefile.am: Distcleans q2c. + +Wed Apr 23 21:33:48 1997 Ben Pfaff + + * 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 + + * 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 + + * 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 + + 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 . + (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 . + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 and + 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * output.c: (outp_read_devices) Changed criteria for + distinguishing different types of lines. + +Fri Sep 20 22:52:28 1996 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * 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 `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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 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 + + * 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 + + * approx.h: #includes . + + * 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 + + * 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 + + 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 + + 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 + + * 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 + + * 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 + + * 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 + + * data-out.c: Changed `#include ' 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 + + * 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 + + * 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 + + * 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 + + [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 + + * 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 + + * 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 + + * 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: diff --git a/src/Makefile.am b/src/Makefile.am new file mode 100644 index 00000000..87061dd8 --- /dev/null +++ b/src/Makefile.am @@ -0,0 +1,87 @@ +## 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 " > 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 + +# 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 diff --git a/src/aggregate.c b/src/aggregate.c new file mode 100644 index 00000000..d49ebf9e --- /dev/null +++ b/src/aggregate.c @@ -0,0 +1,1523 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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[] = + { + {"", 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 + +/* 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); + } +} + +/* 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; + } + } +} + +/* 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; +} + +/* 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 */ diff --git a/src/alloc.c b/src/alloc.c new file mode 100644 index 00000000..763dab3d --- /dev/null +++ b/src/alloc.c @@ -0,0 +1,122 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include "str.h" + +static void out_of_memory (void); + +/* 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; +} + +/* 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 +} diff --git a/src/alloc.h b/src/alloc.h new file mode 100644 index 00000000..50e7ab1f --- /dev/null +++ b/src/alloc.h @@ -0,0 +1,31 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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 */ diff --git a/src/apply-dict.c b/src/apply-dict.c new file mode 100644 index 00000000..f4674531 --- /dev/null +++ b/src/apply-dict.c @@ -0,0 +1,184 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#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 (); +} diff --git a/src/approx.h b/src/approx.h new file mode 100644 index 00000000..8dda9d2f --- /dev/null +++ b/src/approx.h @@ -0,0 +1,59 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include + +/* 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 */ diff --git a/src/ascii.c b/src/ascii.c new file mode 100644 index 00000000..c6f48f00 --- /dev/null +++ b/src/ascii.c @@ -0,0 +1,1631 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include +#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<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; + } +} + +/* 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, +}; diff --git a/src/autorecode.c b/src/autorecode.c new file mode 100644 index 00000000..5ae1e7f6 --- /dev/null +++ b/src/autorecode.c @@ -0,0 +1,342 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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; +} + +/* 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); +} + +/* 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; +} diff --git a/src/avl.c b/src/avl.c new file mode 100644 index 00000000..75d9b2e7 --- /dev/null +++ b/src/avl.c @@ -0,0 +1,1122 @@ +/* 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 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 +#endif +#if PSPP +#include "pool.h" +#define HAVE_XMALLOC 1 +#endif +#if SELF_TEST +#include +#include +#endif +#include +#include +#include +#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; +} + +#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: +*/ + diff --git a/src/avl.h b/src/avl.h new file mode 100644 index 00000000..8835f179 --- /dev/null +++ b/src/avl.h @@ -0,0 +1,142 @@ +/* libavl - manipulates AVL trees. + Copyright (C) 1998-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/bitvector.h b/src/bitvector.h new file mode 100644 index 00000000..6c3a878b --- /dev/null +++ b/src/bitvector.h @@ -0,0 +1,45 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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 */ diff --git a/src/cases.c b/src/cases.c new file mode 100644 index 00000000..814a8726 --- /dev/null +++ b/src/cases.c @@ -0,0 +1,129 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#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); +} diff --git a/src/cases.h b/src/cases.h new file mode 100644 index 00000000..b7867232 --- /dev/null +++ b/src/cases.h @@ -0,0 +1,42 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/cmdline.c b/src/cmdline.c new file mode 100644 index 00000000..bb9b9bab --- /dev/null +++ b/src/cmdline.c @@ -0,0 +1,257 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include +#include +#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 .")); + 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 .\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); +} diff --git a/src/command.c b/src/command.c new file mode 100644 index 00000000..40c186ef --- /dev/null +++ b/src/command.c @@ -0,0 +1,791 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#include +#include +#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 +#endif + +#if HAVE_SYS_WAIT_H +#include +#endif + +#undef DEBUGGING +/*#define DEBUGGING 1*/ +#include "debug-print.h" + +/* 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; + +/* 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 + +/* 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; +} + +/* 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; +} diff --git a/src/command.def b/src/command.def new file mode 100644 index 00000000..beaf7741 --- /dev/null +++ b/src/command.def @@ -0,0 +1,134 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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) diff --git a/src/command.h b/src/command.h new file mode 100644 index 00000000..0a61996d --- /dev/null +++ b/src/command.h @@ -0,0 +1,49 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/compute.c b/src/compute.c new file mode 100644 index 00000000..c4ed544f --- /dev/null +++ b/src/compute.c @@ -0,0 +1,477 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#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 *); + +/* 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; +} + +/* 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; +} + +/* 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; +} + +/* 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 diff --git a/src/correlations.q b/src/correlations.q new file mode 100644 index 00000000..6b708f64 --- /dev/null +++ b/src/correlations.q @@ -0,0 +1,166 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#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); + } +} diff --git a/src/count.c b/src/count.c new file mode 100644 index 00000000..25469665 --- /dev/null +++ b/src/count.c @@ -0,0 +1,641 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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" + +/* 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; + +/* 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; +} + +/* 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); + } +} + +/* 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 ("", 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 ("", s->type); + } + } + printf (") "); + } + printf ("\n"); + } +} +#endif /* DEBUGGING */ diff --git a/src/crosstabs.q b/src/crosstabs.q new file mode 100644 index 00000000..5ea9a1d5 --- /dev/null +++ b/src/crosstabs.q @@ -0,0 +1,3311 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#include +#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 */ + +/* 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; +} + +/* 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); +} + +/* 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); +} + +/* 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: +*/ diff --git a/src/data-in.c b/src/data-in.c new file mode 100644 index 00000000..04c035d4 --- /dev/null +++ b/src/data-in.c @@ -0,0 +1,1591 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include +#include +#include +#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" + +#undef DEBUGGING +/*#define DEBUGGING 1 */ +#include "debug-print.h" + + +/* 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; +} + +/* 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; +} + +/* 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; +} + +/* 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; +} + +/* 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; + } +} + +/* 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); +} diff --git a/src/data-in.h b/src/data-in.h new file mode 100644 index 00000000..c5209205 --- /dev/null +++ b/src/data-in.h @@ -0,0 +1,59 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/data-list.c b/src/data-list.c new file mode 100644 index 00000000..c775c8da --- /dev/null +++ b/src/data-list.c @@ -0,0 +1,1935 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#include +#include +#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" + +/* 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; +} + +/* 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); +} + +/* 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); +} + +/* 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); +} + +/* 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", + }; + +/* 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; +} diff --git a/src/data-out.c b/src/data-out.c new file mode 100644 index 00000000..24428c6a --- /dev/null +++ b/src/data-out.c @@ -0,0 +1,1231 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include +#include +#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 + +/* 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 +} + +/* 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; +} + +/* 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? */ + } +} diff --git a/src/debug-print.h b/src/debug-print.h new file mode 100644 index 00000000..061b2195 --- /dev/null +++ b/src/debug-print.h @@ -0,0 +1,54 @@ +/* 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 */ diff --git a/src/descript.q b/src/descript.q new file mode 100644 index 00000000..168f29aa --- /dev/null +++ b/src/descript.q @@ -0,0 +1,866 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#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); + +/* 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; +} + +/* 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); +} + +/* 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 (); +} + +/* 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: +*/ diff --git a/src/dfm.c b/src/dfm.c new file mode 100644 index 00000000..9e9d080c --- /dev/null +++ b/src/dfm.c @@ -0,0 +1,718 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#include +#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); + +/* 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, _("<>")); +#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; +} + +/* 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); +} + +/* 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, +}; diff --git a/src/dfm.h b/src/dfm.h new file mode 100644 index 00000000..ef915695 --- /dev/null +++ b/src/dfm.h @@ -0,0 +1,44 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/do-if.c b/src/do-if.c new file mode 100644 index 00000000..b42e0eb8 --- /dev/null +++ b/src/do-if.c @@ -0,0 +1,333 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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 +#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<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>V + V V + >>1. ELSE IF V + V<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>V + V V + >>1. ELSE IF V + V<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>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; + } + } +} diff --git a/src/do-ifP.h b/src/do-ifP.h new file mode 100644 index 00000000..6ea1b943 --- /dev/null +++ b/src/do-ifP.h @@ -0,0 +1,83 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/error.c b/src/error.c new file mode 100644 index 00000000..1983df4d --- /dev/null +++ b/src/error.c @@ -0,0 +1,517 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#include +#include +#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; + +/* 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 (); + } +} + +/* 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); +} + +/* 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); +} + +/* 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 diff --git a/src/error.h b/src/error.h new file mode 100644 index 00000000..6eb77a14 --- /dev/null +++ b/src/error.h @@ -0,0 +1,90 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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 */ diff --git a/src/expr-evl.c b/src/expr-evl.c new file mode 100644 index 00000000..15b4434c --- /dev/null +++ b/src/expr-evl.c @@ -0,0 +1,1395 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#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 +#include +#else +#if HAVE_SYS_TIME_H +#include +#else +#include +#endif +#endif + +#include +#include +#include +#include +#include +#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; + } +} diff --git a/src/expr-opt.c b/src/expr-opt.c new file mode 100644 index 00000000..e221d4e2 --- /dev/null +++ b/src/expr-opt.c @@ -0,0 +1,1142 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include +#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); +} + +/* 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; +} diff --git a/src/expr-prs.c b/src/expr-prs.c new file mode 100644 index 00000000..d447afdf --- /dev/null +++ b/src/expr-prs.c @@ -0,0 +1,1805 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#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" + +/* 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 + +/* 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; +} + +/* 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; + } +} + +/* 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; +} + +/* 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 + + +/* 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; +} + +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); +} + +/* 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 */ diff --git a/src/expr.h b/src/expr.h new file mode 100644 index 00000000..30824966 --- /dev/null +++ b/src/expr.h @@ -0,0 +1,44 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/exprP.h b/src/exprP.h new file mode 100644 index 00000000..873f0ce7 --- /dev/null +++ b/src/exprP.h @@ -0,0 +1,296 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/file-handle.h b/src/file-handle.h new file mode 100644 index 00000000..34a85953 --- /dev/null +++ b/src/file-handle.h @@ -0,0 +1,99 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#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 */ diff --git a/src/file-handle.q b/src/file-handle.q new file mode 100644 index 00000000..309c4097 --- /dev/null +++ b/src/file-handle.q @@ -0,0 +1,362 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#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; +} + +/* 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->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: +*/ diff --git a/src/file-type.c b/src/file-type.c new file mode 100644 index 00000000..3400c8a0 --- /dev/null +++ b/src/file-type.c @@ -0,0 +1,729 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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); +} + +/* 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; +} + +/* 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; +} + +/* 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", + }; diff --git a/src/filename.c b/src/filename.c new file mode 100644 index 00000000..4aaf7d17 --- /dev/null +++ b/src/filename.c @@ -0,0 +1,881 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#include +#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 +#if HAVE_UNISTD_H +#include +#endif +#include "stat.h" +#endif + +#if __WIN32__ +#define NOGDI +#define NOUSER +#define NONLS +#include +#endif + +#if __DJGPP__ +#include +#endif + +/* Initialization. */ + +const char *config_path; + +void +fn_init (void) +{ + config_path = fn_getenv_default ("STAT_CONFIG_PATH", default_config_path); +} + +/* 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 . + 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 + +/* 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); + } +} + +/* 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. */ + +/* 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; +} + +/* 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); +} + +/* 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; +} diff --git a/src/filename.h b/src/filename.h new file mode 100644 index 00000000..499e693b --- /dev/null +++ b/src/filename.h @@ -0,0 +1,73 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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); + +/* 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 */ diff --git a/src/flip.c b/src/flip.c new file mode 100644 index 00000000..7ee4e703 --- /dev/null +++ b/src/flip.c @@ -0,0 +1,549 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include +#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", + }; diff --git a/src/font.h b/src/font.h new file mode 100644 index 00000000..67c276cd --- /dev/null +++ b/src/font.h @@ -0,0 +1,141 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/format.c b/src/format.c new file mode 100644 index 00000000..61b223e2 --- /dev/null +++ b/src/format.c @@ -0,0 +1,343 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +#include +#include +#include +#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; +} + diff --git a/src/format.def b/src/format.def new file mode 100644 index 00000000..fda776df --- /dev/null +++ b/src/format.def @@ -0,0 +1,65 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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) diff --git a/src/format.h b/src/format.h new file mode 100644 index 00000000..ad6d2f7b --- /dev/null +++ b/src/format.h @@ -0,0 +1,92 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/formats.c b/src/formats.c new file mode 100644 index 00000000..8d2918a7 --- /dev/null +++ b/src/formats.c @@ -0,0 +1,165 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#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 */ diff --git a/src/frequencies.g b/src/frequencies.g new file mode 100644 index 00000000..eebb20c2 --- /dev/null +++ b/src/frequencies.g @@ -0,0 +1,89 @@ +/* PSPP - computes sample statistics. -*- C -*- + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 diff --git a/src/frequencies.q b/src/frequencies.q new file mode 100644 index 00000000..d40267e2 --- /dev/null +++ b/src/frequencies.q @@ -0,0 +1,1818 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#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 *); + +/* 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; +} + +/* 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); +} + +/* 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); +} + +/* 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); +} + +#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; +} + +/* 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 (); + } +} + +/* 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; +} + +/* 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: +*/ diff --git a/src/get.c b/src/get.c new file mode 100644 index 00000000..8f4a05f3 --- /dev/null +++ b/src/get.c @@ -0,0 +1,1610 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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 + +/* 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", + }; + + +/* 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; +} + +/* 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", + }; + +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; +} diff --git a/src/getline.c b/src/getline.c new file mode 100644 index 00000000..5b8588c8 --- /dev/null +++ b/src/getline.c @@ -0,0 +1,519 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#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 +#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 +#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; +} diff --git a/src/getline.h b/src/getline.h new file mode 100644 index 00000000..f04bacdc --- /dev/null +++ b/src/getline.h @@ -0,0 +1,117 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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 */ diff --git a/src/glob.c b/src/glob.c new file mode 100644 index 00000000..f9d443b5 --- /dev/null +++ b/src/glob.c @@ -0,0 +1,431 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +#include +#include + +#if TIME_WITH_SYS_TIME +#include +#include +#else +#if HAVE_SYS_TIME_H +#include +#else +#include +#endif +#endif + +#if HAVE_LIBTERMCAP +#if HAVE_TERMCAP_H +#include +#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 +#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 +#elif __BORLANDC__ +#include +#include +#endif + +#if __DJGPP__ +#include +#elif __WIN32__ && __BORLANDC__ +#undef gettext +#include +#define gettext(STRING) \ + STRING +#endif + +#if HAVE_LOCALE_H +#include +#endif + +#if HAVE_FENV_H +#include +#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; + +/* 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 '.")); + +#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 diff --git a/src/groff-font.c b/src/groff-font.c new file mode 100644 index 00000000..2510b894 --- /dev/null +++ b/src/groff-font.c @@ -0,0 +1,1010 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include +#include +#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 ? "" : 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 = ' '; + } +} + +/* 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); +} + +/* 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]; +} + +/* 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, _("<>")); + 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; +} diff --git a/src/hash.c b/src/hash.c new file mode 100644 index 00000000..9ade76f6 --- /dev/null +++ b/src/hash.c @@ -0,0 +1,344 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#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. */ + +/* 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)]); +} + +/*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; +} + +/* 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 + +/* 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 diff --git a/src/hash.h b/src/hash.h new file mode 100644 index 00000000..048d2f24 --- /dev/null +++ b/src/hash.h @@ -0,0 +1,95 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/heap.c b/src/heap.c new file mode 100644 index 00000000..a90aefda --- /dev/null +++ b/src/heap.c @@ -0,0 +1,269 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#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 + +/* 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 diff --git a/src/heap.h b/src/heap.h new file mode 100644 index 00000000..7644356b --- /dev/null +++ b/src/heap.h @@ -0,0 +1,52 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/html.c b/src/html.c new file mode 100644 index 00000000..c647f34b --- /dev/null +++ b/src/html.c @@ -0,0 +1,623 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include + +#if HAVE_UNISTD_H +#include +#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 = ""; + + 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, + "\n" + "\n" + "\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 ("", f); + if (*old_attr & OUTP_F_I) + fputs ("", f); + if (new_attr & OUTP_F_I) + fputs ("", f); + if (new_attr & OUTP_F_B) + fputs ("", 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 ("

", x->file.file); + if (!ls_empty_p (t->cc)) + escape_string (x->file.file, ls_value (t->cc), ls_length (t->cc)); + fputs ("

\n", x->file.file); + + return; + } + + fputs ("\n", x->file.file); + + if (!ls_empty_p (&t->title)) + { + fprintf (x->file.file, " \n \n \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 (" \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, " 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, "\n", tag); + } + fputs (" \n", x->file.file); + } + } + + fputs ("
", t->nc); + escape_string (x->file.file, ls_value (&t->title), + ls_length (&t->title)); + fputs ("
\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 */ + diff --git a/src/htmlP.h b/src/htmlP.h new file mode 100644 index 00000000..28416fda --- /dev/null +++ b/src/htmlP.h @@ -0,0 +1,38 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/include.c b/src/include.c new file mode 100644 index 00000000..78557bdd --- /dev/null +++ b/src/include.c @@ -0,0 +1,76 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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 (); +} diff --git a/src/inpt-pgm.c b/src/inpt-pgm.c new file mode 100644 index 00000000..a4e9a180 --- /dev/null +++ b/src/inpt-pgm.c @@ -0,0 +1,465 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#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", + }; + +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; +} diff --git a/src/inpt-pgm.h b/src/inpt-pgm.h new file mode 100644 index 00000000..c46fe7ad --- /dev/null +++ b/src/inpt-pgm.h @@ -0,0 +1,38 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/lexer.c b/src/lexer.c new file mode 100644 index 00000000..6bcb46eb --- /dev/null +++ b/src/lexer.c @@ -0,0 +1,1195 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include +#include +#include +#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*/ + + +/* 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; + +/* 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 + +/* Initialization. */ + +/* Initializes the lexer. */ +void +lex_init (void) +{ + if (!lex_get_line ()) + unexpected_eof (); +} + +/* 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; +} + +/* 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; +} + +/* 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; +} + +/* 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; + } +} + +/* 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)); +} + +/* 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; +} + +/* 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; +} + +/* 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); +} + +/* 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 _(""); +} + +/* 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); +} + +/* 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; + } +} + +/* 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; +} + +#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 */ diff --git a/src/lexer.h b/src/lexer.h new file mode 100644 index 00000000..542721b9 --- /dev/null +++ b/src/lexer.h @@ -0,0 +1,133 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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 */ diff --git a/src/list.q b/src/list.q new file mode 100644 index 00000000..45046a02 --- /dev/null +++ b/src/list.q @@ -0,0 +1,781 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#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 ("\n \n", x->file.file); + + { + int i; + + for (i = 0; i < cmd.n_variables; i++) + fprintf (x->file.file, " \n", + cmd.v_variables[i]->name); + } + + fputs (" \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 ("
%s
\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 (" \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, " %s\n", + &buf[strspn (buf, " ")]); + } + + fputs (" \n", x->file.file); + } + else + assert (0); + + return 1; +} + +/* 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: +*/ diff --git a/src/log.h b/src/log.h new file mode 100644 index 00000000..0598206b --- /dev/null +++ b/src/log.h @@ -0,0 +1,38 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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 */ diff --git a/src/loop.c b/src/loop.c new file mode 100644 index 00000000..b7dac895 --- /dev/null +++ b/src/loop.c @@ -0,0 +1,612 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#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 + ^<<<>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); + +/* 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 initloop_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); +} + +/* 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; +} + +/* 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; +} diff --git a/src/magic.c b/src/magic.c new file mode 100644 index 00000000..d114a912 --- /dev/null +++ b/src/magic.c @@ -0,0 +1,33 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#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 + diff --git a/src/magic.h b/src/magic.h new file mode 100644 index 00000000..3693f23f --- /dev/null +++ b/src/magic.h @@ -0,0 +1,45 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include + +#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 */ diff --git a/src/main.c b/src/main.c new file mode 100644 index 00000000..e2599186 --- /dev/null +++ b/src/main.c @@ -0,0 +1,154 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include "command.h" +#include "error.h" +#include "getline.h" +#include "lexer.h" +#include "output.h" + +#include + +#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 (); +} diff --git a/src/main.h b/src/main.h new file mode 100644 index 00000000..076882b9 --- /dev/null +++ b/src/main.h @@ -0,0 +1,28 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/matrix-data.c b/src/matrix-data.c new file mode 100644 index 00000000..5e4d5f5d --- /dev/null +++ b/src/matrix-data.c @@ -0,0 +1,2020 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#include +#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 */ + +/* 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 (" "); + break; + case MNUM: + printf (" #%g", mtokval); + break; + case MSTR: + printf (" #'%.*s'", mtoklen, mtokstr); + break; + case MSTOP: + printf (" "); + 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; +} + +/* 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]); + } +} + +/* 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; +} + +/* Matrix source. */ + +struct case_stream matrix_data_source = + { + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + "MATRIX DATA", + }; + diff --git a/src/matrix.c b/src/matrix.c new file mode 100644 index 00000000..7e474677 --- /dev/null +++ b/src/matrix.c @@ -0,0 +1,302 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include "alloc.h" +#include "matrix.h" + +/* 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 + . + 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) + + +/* 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 +#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; +} + +/* 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; +} diff --git a/src/matrix.h b/src/matrix.h new file mode 100644 index 00000000..c1e5c612 --- /dev/null +++ b/src/matrix.h @@ -0,0 +1,96 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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 *); + +/* 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 */ diff --git a/src/means.q b/src/means.q new file mode 100644 index 00000000..99432a35 --- /dev/null +++ b/src/means.q @@ -0,0 +1,409 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#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: +*/ diff --git a/src/mis-val.c b/src/mis-val.c new file mode 100644 index 00000000..a048e405 --- /dev/null +++ b/src/mis-val.c @@ -0,0 +1,409 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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 , or LO[WEST] THRU , or + THRU HI[GHEST], or THRU , 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); + } +} + + +/* 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 */ diff --git a/src/misc.c b/src/misc.c new file mode 100644 index 00000000..7c517ad5 --- /dev/null +++ b/src/misc.c @@ -0,0 +1,38 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#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; +} + diff --git a/src/misc.h b/src/misc.h new file mode 100644 index 00000000..d8d19702 --- /dev/null +++ b/src/misc.h @@ -0,0 +1,108 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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 /* Declares finite() under Solaris. */ +#endif + +#if __TURBOC__ +#include /* 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 */ diff --git a/src/modify-vars.c b/src/modify-vars.c new file mode 100644 index 00000000..4fa71fd4 --- /dev/null +++ b/src/modify-vars.c @@ -0,0 +1,522 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#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; +} diff --git a/src/numeric.c b/src/numeric.c new file mode 100644 index 00000000..f80865d1 --- /dev/null +++ b/src/numeric.c @@ -0,0 +1,213 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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 (); +} diff --git a/src/output.c b/src/output.c new file mode 100644 index 00000000..8cf5bafa --- /dev/null +++ b/src/output.c @@ -0,0 +1,1324 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include +#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; +} diff --git a/src/output.h b/src/output.h new file mode 100644 index 00000000..00e5b23d --- /dev/null +++ b/src/output.h @@ -0,0 +1,289 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/pfm-read.c b/src/pfm-read.c new file mode 100644 index 00000000..d5ddd21d --- /dev/null +++ b/src/pfm-read.c @@ -0,0 +1,1065 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#include +#include +#include +#include +#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; +} + +/* 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; +} + +/* 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, +}; diff --git a/src/pfm-write.c b/src/pfm-write.c new file mode 100644 index 00000000..0683f39a --- /dev/null +++ b/src/pfm-write.c @@ -0,0 +1,510 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include +#include +#include +#include +#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; +} + +/* 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); +} + +/* 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, +}; diff --git a/src/pfm.h b/src/pfm.h new file mode 100644 index 00000000..ebf4401e --- /dev/null +++ b/src/pfm.h @@ -0,0 +1,56 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/pool.c b/src/pool.c new file mode 100644 index 00000000..cce54af9 --- /dev/null +++ b/src/pool.c @@ -0,0 +1,734 @@ +/* PSPP - computes sample statistics. + Copyright (C) 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#endif +#include +#include +#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 + +/* 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); + } + } +} + +/* 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; +} + +/* 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); +} + +/* 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; +} + +/* 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; +} + +/* 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; + } +} + +/* 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); + } +} + +/* 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 */ + +/* Self-test routine. */ + +#if SELF_TEST +#include +#include +#include +#include +#include + +#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: +*/ diff --git a/src/pool.h b/src/pool.h new file mode 100644 index 00000000..117e0c5b --- /dev/null +++ b/src/pool.h @@ -0,0 +1,67 @@ +/* PSPP - computes sample statistics. + Copyright (C) 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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 */ diff --git a/src/postscript.c b/src/postscript.c new file mode 100644 index 00000000..8e6fa488 --- /dev/null +++ b/src/postscript.c @@ -0,0 +1,2966 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#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 +#include +#include +#include +#include + +#if HAVE_UNISTD_H +#include +#endif + +#if TIME_WITH_SYS_TIME +#include +#include +#else +#if HAVE_SYS_TIME_H +#include +#else +#include +#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); + +/* 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; +} + +/* 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 (_("<>")); + enc->index = x->next_encoding++; + } + return enc; +} + +/* 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 = ""; + + 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); +} + +/* 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; +} + + +/* 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); +} + +/* 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 */ diff --git a/src/print.c b/src/print.c new file mode 100644 index 00000000..70a41763 --- /dev/null +++ b/src/print.c @@ -0,0 +1,1211 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#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 + +/* 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; +} + +/* 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 +} + +/* 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 +} + +/* 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); +} + +/* 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 (_("")); + 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 */ diff --git a/src/q2c.c b/src/q2c.c new file mode 100644 index 00000000..839d4a77 --- /dev/null +++ b/src/q2c.c @@ -0,0 +1,1871 @@ +/* q2c - parser generator for PSPP procedures. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include +#include +#include +#if HAVE_UNISTD_H +#include +#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; + +/* 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; +} + +/* 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 (); +} + +/* 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; + +/* 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; + } +} + +/* 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 "); + dump (0, "#include "); + 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; +} + diff --git a/src/random.c b/src/random.c new file mode 100644 index 00000000..7f63f477 --- /dev/null +++ b/src/random.c @@ -0,0 +1,149 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#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; +} + diff --git a/src/random.h b/src/random.h new file mode 100644 index 00000000..b76f2e45 --- /dev/null +++ b/src/random.h @@ -0,0 +1,28 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/recode.c b/src/recode.c new file mode 100644 index 00000000..d799a38b --- /dev/null +++ b/src/recode.c @@ -0,0 +1,1121 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#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" + +/* 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 + +/* 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; +} + +/* 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; +} + +/* 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; +} diff --git a/src/rename-vars.c b/src/rename-vars.c new file mode 100644 index 00000000..fb214785 --- /dev/null +++ b/src/rename-vars.c @@ -0,0 +1,154 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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); +} diff --git a/src/repeat.c b/src/repeat.c new file mode 100644 index 00000000..8b66a712 --- /dev/null +++ b/src/repeat.c @@ -0,0 +1,650 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#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; +} + +int +cmd_end_repeat (void) +{ + msg (SE, _("No matching DO REPEAT.")); + return CMD_FAILURE; +} + +/* 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; +} + +/* 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 */ diff --git a/src/sample.c b/src/sample.c new file mode 100644 index 00000000..84f2e899 --- /dev/null +++ b/src/sample.c @@ -0,0 +1,146 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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; + } +} diff --git a/src/sel-if.c b/src/sel-if.c new file mode 100644 index 00000000..f4afd9c6 --- /dev/null +++ b/src/sel-if.c @@ -0,0 +1,148 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#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; +} diff --git a/src/set.q b/src/set.q new file mode 100644 index 00000000..8683bff7 --- /dev/null +++ b/src/set.q @@ -0,0 +1,882 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#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; +} + + +/* GSET. */ + +int +cmd_gset (void) +{ + /* FIXME */ + return CMD_FAILURE; +} + +/* + Local Variables: + mode: c + End: +*/ diff --git a/src/settings.h b/src/settings.h new file mode 100644 index 00000000..3a8eaede --- /dev/null +++ b/src/settings.h @@ -0,0 +1,253 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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 */ diff --git a/src/sfm-read.c b/src/sfm-read.c new file mode 100644 index 00000000..f6353d8a --- /dev/null +++ b/src/sfm-read.c @@ -0,0 +1,1540 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#include +#include +#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 + +/* Utilities. */ + +/* bswap_int32(): Reverse the byte order of 32-bit integer *X. */ +#if __linux__ +#include +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--; +} + +/* 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 + +/* 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, +}; diff --git a/src/sfm-write.c b/src/sfm-write.c new file mode 100644 index 00000000..0e99013f --- /dev/null +++ b/src/sfm-write.c @@ -0,0 +1,756 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#include +#include +#if HAVE_UNISTD_H +#include /* 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, +}; diff --git a/src/sfm.h b/src/sfm.h new file mode 100644 index 00000000..6b3f6a1b --- /dev/null +++ b/src/sfm.h @@ -0,0 +1,66 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/sfmP.h b/src/sfmP.h new file mode 100644 index 00000000..d03ba042 --- /dev/null +++ b/src/sfmP.h @@ -0,0 +1,63 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 diff --git a/src/som.c b/src/som.c new file mode 100644 index 00000000..dde12b5f --- /dev/null +++ b/src/som.c @@ -0,0 +1,275 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include "output.h" +#include "som.h" +/*#undef DEBUGGING*/ +/*#define DEBUGGING 1 */ +#include "debug-print.h" + +/* Table. */ +int table_num = 1; +int subtable_num; + +/* 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; +} + +/* 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; + } + } + } +} diff --git a/src/som.h b/src/som.h new file mode 100644 index 00000000..9ac69c86 --- /dev/null +++ b/src/som.h @@ -0,0 +1,109 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/sort.c b/src/sort.c new file mode 100644 index 00000000..e5feef94 --- /dev/null +++ b/src/sort.c @@ -0,0 +1,1385 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#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 +#endif + +#if HAVE_SYS_TYPES_H +#include +#endif + +#if HAVE_SYS_STAT_H +#include +#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; + } +} + +/* 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; +} + +/* 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; + } +} + +/* 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; +} + +/* 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", + }; diff --git a/src/sort.h b/src/sort.h new file mode 100644 index 00000000..e6c9fed9 --- /dev/null +++ b/src/sort.h @@ -0,0 +1,31 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/split-file.c b/src/split-file.c new file mode 100644 index 00000000..29fc432e --- /dev/null +++ b/src/split-file.c @@ -0,0 +1,56 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#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 (); +} diff --git a/src/stat.h b/src/stat.h new file mode 100644 index 00000000..69580857 --- /dev/null +++ b/src/stat.h @@ -0,0 +1,65 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +#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 diff --git a/src/stats.c b/src/stats.c new file mode 100644 index 00000000..a52ab402 --- /dev/null +++ b/src/stats.c @@ -0,0 +1,203 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#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); + } +} diff --git a/src/stats.h b/src/stats.h new file mode 100644 index 00000000..81a3f112 --- /dev/null +++ b/src/stats.h @@ -0,0 +1,84 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 /* 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 */ diff --git a/src/str.c b/src/str.c new file mode 100644 index 00000000..4bf2d60c --- /dev/null +++ b/src/str.c @@ -0,0 +1,584 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include "alloc.h" +#include "error.h" +#include "pool.h" +#include "str.h" + +/* 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(). */ + +/* 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; + } +} + +/* 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; +} + +/* 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); +} diff --git a/src/str.h b/src/str.h new file mode 100644 index 00000000..dedcc10d --- /dev/null +++ b/src/str.h @@ -0,0 +1,215 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include + +#if STDC_HEADERS + #include +#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 + +/* 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 + +/* 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); + +/* 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 *); + +/* 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 */ diff --git a/src/sysfile-info.c b/src/sysfile-info.c new file mode 100644 index 00000000..dda4f546 --- /dev/null +++ b/src/sysfile-info.c @@ -0,0 +1,620 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#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), _(""))))); + 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 (); +} + +/* 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); +} + +/* 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); +} diff --git a/src/t-test.q b/src/t-test.q new file mode 100644 index 00000000..6b65d0ec --- /dev/null +++ b/src/t-test.q @@ -0,0 +1,1087 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#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: +*/ diff --git a/src/tab.c b/src/tab.c new file mode 100644 index 00000000..412bb0ac --- /dev/null +++ b/src/tab.c @@ -0,0 +1,1383 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#include +#include +#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" + +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; +} + +/* 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); +} + + +/* 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; +} + +/* 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); +} + +/* 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); +} + +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, + }; + +/* 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; +} + diff --git a/src/tab.h b/src/tab.h new file mode 100644 index 00000000..37e045c9 --- /dev/null +++ b/src/tab.h @@ -0,0 +1,195 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#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 */ + diff --git a/src/temporary.c b/src/temporary.c new file mode 100644 index 00000000..316fd649 --- /dev/null +++ b/src/temporary.c @@ -0,0 +1,333 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#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; + } +} diff --git a/src/title.c b/src/title.c new file mode 100644 index 00000000..cea04c63 --- /dev/null +++ b/src/title.c @@ -0,0 +1,179 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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 : _(""))); + 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 (); +} diff --git a/src/val-labs.c b/src/val-labs.c new file mode 100644 index 00000000..ae9ac296 --- /dev/null +++ b/src/val-labs.c @@ -0,0 +1,306 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include "alloc.h" +#include "avl.h" +#include "command.h" +#include "error.h" +#include "lexer.h" +#include "str.h" +#include "var.h" + +/* 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 + +/* 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; +} + +/* 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; +} diff --git a/src/var-labs.c b/src/var-labs.c new file mode 100644 index 00000000..b573a4e8 --- /dev/null +++ b/src/var-labs.c @@ -0,0 +1,100 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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 */ diff --git a/src/var.h b/src/var.h new file mode 100644 index 00000000..38f0d74a --- /dev/null +++ b/src/var.h @@ -0,0 +1,535 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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. */ + }; + +/* 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. */ + }; + +/* 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. */ + }; + + +/* 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; + }; + +/* 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]; + }; + +/* 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; + +/* 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; + +/* 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); + +/* 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); + +/* 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); + +/* 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 */ diff --git a/src/vars-atr.c b/src/vars-atr.c new file mode 100644 index 00000000..3f4ea7fd --- /dev/null +++ b/src/vars-atr.c @@ -0,0 +1,570 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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 : ""); +} + +/* 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 (); +} diff --git a/src/vars-prs.c b/src/vars-prs.c new file mode 100644 index 00000000..f12ebf4c --- /dev/null +++ b/src/vars-prs.c @@ -0,0 +1,529 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#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; +} diff --git a/src/vector.c b/src/vector.c new file mode 100644 index 00000000..acaa0787 --- /dev/null +++ b/src/vector.c @@ -0,0 +1,230 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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; +} diff --git a/src/vector.h b/src/vector.h new file mode 100644 index 00000000..c75f569f --- /dev/null +++ b/src/vector.h @@ -0,0 +1,37 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/version.h b/src/version.h new file mode 100644 index 00000000..c7912d75 --- /dev/null +++ b/src/version.h @@ -0,0 +1,51 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/vfm.c b/src/vfm.c new file mode 100644 index 00000000..333851d6 --- /dev/null +++ b/src/vfm.c @@ -0,0 +1,1297 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#if __GNUC__ +#define alloca __builtin_alloca +#else +#if HAVE_ALLOCA_H +#include +#else +#ifdef _AIX +#pragma alloca +#else +#ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +#endif +#endif +#endif +#endif + +#include +#include +#include +#include +#if HAVE_UNISTD_H +#include /* 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); + +/* 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 (); +} + +/* 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 (); +} + +/* 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 _(""); +} +#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)); +} + +/* 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")); +} + +/* 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", + }; + +/* 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", + }; + +#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); +} + +/* 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; + } +} + + diff --git a/src/vfm.h b/src/vfm.h new file mode 100644 index 00000000..b2a1e6ef --- /dev/null +++ b/src/vfm.h @@ -0,0 +1,100 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 + +/* 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 */ diff --git a/src/vfmP.h b/src/vfmP.h new file mode 100644 index 00000000..6454da89 --- /dev/null +++ b/src/vfmP.h @@ -0,0 +1,72 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 */ diff --git a/src/weight.c b/src/weight.c new file mode 100644 index 00000000..1d7fe9eb --- /dev/null +++ b/src/weight.c @@ -0,0 +1,121 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#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 + +/* 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; +} diff --git a/stamp-h.in b/stamp-h.in new file mode 100644 index 00000000..9788f702 --- /dev/null +++ b/stamp-h.in @@ -0,0 +1 @@ +timestamp diff --git a/sysdeps/ChangeLog b/sysdeps/ChangeLog new file mode 100644 index 00000000..74e6766d --- /dev/null +++ b/sysdeps/ChangeLog @@ -0,0 +1,9 @@ +Sun Aug 9 11:17:39 1998 Ben Pfaff + + * README: New file. + +---------------------------------------------------------------------- +Local Variables: +mode: change-log +version-control: never +End: diff --git a/sysdeps/README b/sysdeps/README new file mode 100644 index 00000000..5a4ede64 --- /dev/null +++ b/sysdeps/README @@ -0,0 +1,8 @@ +-*- 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 diff --git a/sysdeps/borlandc5.0/ChangeLog b/sysdeps/borlandc5.0/ChangeLog new file mode 100644 index 00000000..0beaf5b3 --- /dev/null +++ b/sysdeps/borlandc5.0/ChangeLog @@ -0,0 +1,60 @@ +Sun Aug 9 11:15:17 1998 Ben Pfaff + + * 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 + + * 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 + + * fiasco.iwz.in: Updated. + +Sat Aug 16 11:02:38 1997 Ben Pfaff + + * 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 + + * fiasco.iwz.in: Revised. + + * pref.h: Updated from pref.h.orig. + + * fiasco.ide: Updated. + +Sun Aug 3 11:50:23 1997 Ben Pfaff + + * 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 + + * 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: diff --git a/sysdeps/borlandc5.0/bc5-con32s.c b/sysdeps/borlandc5.0/bc5-con32s.c new file mode 100644 index 00000000..ec55ab84 --- /dev/null +++ b/sysdeps/borlandc5.0/bc5-con32s.c @@ -0,0 +1,95 @@ +/* con32s - emulates console under Windows. + Copyright (C) 1997, 1998 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include + +/* 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; +} + diff --git a/sysdeps/borlandc5.0/config.h b/sysdeps/borlandc5.0/config.h new file mode 100644 index 00000000..a90e84ce --- /dev/null +++ b/sysdeps/borlandc5.0/config.h @@ -0,0 +1,303 @@ +/* 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 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 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 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 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 and . */ +#undef TIME_WITH_SYS_TIME + +/* Define if your 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 header file. */ +#undef HAVE_ARGZ_H + +/* Define if you have the header file. */ +#undef HAVE_FPU_CONTROL_H + +/* Define if you have the header file. */ +#define HAVE_LIMITS_H 1 + +/* Define if you have the header file. */ +#define HAVE_LOCALE_H 1 + +/* Define if you have the header file. */ +#define HAVE_MALLOC_H 1 + +/* Define if you have the header file. */ +#define HAVE_MEMORY_H 1 + +/* Define if you have the header file. */ +#undef HAVE_NL_TYPES_H + +/* Define if you have the header file. */ +#undef HAVE_READLINE_HISTORY_H + +/* Define if you have the header file. */ +#undef HAVE_READLINE_READLINE_H + +/* Define if you have the header file. */ +#define HAVE_STRING_H 1 + +/* Define if you have the header file. */ +#undef HAVE_SYS_TIME_H + +/* Define if you have the header file. */ +#define HAVE_SYS_TYPES_H 1 + +/* Define if you have the header file. */ +#undef HAVE_TERMCAP_H + +/* Define if you have the header file. */ +#undef HAVE_UNISTD_H + +/* Define if you have the 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 + +/* Local Variables: */ +/* mode:c */ +/* End: */ diff --git a/sysdeps/borlandc5.0/libintl.h b/sysdeps/borlandc5.0/libintl.h new file mode 100644 index 00000000..67dbe228 --- /dev/null +++ b/sysdeps/borlandc5.0/libintl.h @@ -0,0 +1,20 @@ +/* PSPP - computes sample statistics. + Copyright (C) 1997, 1998 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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. */ diff --git a/sysdeps/borlandc5.0/mk-bc5-dist b/sysdeps/borlandc5.0/mk-bc5-dist new file mode 100755 index 00000000..fc6e9012 --- /dev/null +++ b/sysdeps/borlandc5.0/mk-bc5-dist @@ -0,0 +1,69 @@ +#! /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 diff --git a/sysdeps/borlandc5.0/pspp.ico b/sysdeps/borlandc5.0/pspp.ico new file mode 100755 index 0000000000000000000000000000000000000000..4157a06a94e1c5111b8e8bcf7019cf994f7b1b03 GIT binary patch literal 16790 zcmeI2y>1&zmdDRs4w{VxX1&;8V}+N%2E-7!a<=^h^9YLu1hhJnKmj7NF2DfUnO;Gm zo`A6)L6H)^z(xZ{Zo)~;?|-WJVPDzT_5{WZRMP2Y)%ia4U0r6sSYc;p|7lA9|8Hgu z@2X1q_TSC^Ix_H(kseC3&7Xx&`CtFr?Eir2G}9MmtN&3x)BlIr-~M9uE4*hw1^i-v z;%OGp^>PXz!Gw@rJo#ylkB_{Ci2iRe>KDMDig-*(Wxr}{wYnIMFnns))~?KID@Hb& z&Sr0$RZ%xhU05@l&7kP(qIRciUZb~lFy$$2>e+M@in?eK*f-4z{&C+2Yr%^pw6k*6 znze+Ce6cF6484W6USV=gzJ6PmMS$N{o^RTEfozj}Yx)8n@=Ni8?~9^rmPNm`9*$tE zqPQ$P-=e&h%*$eMdRyWUQrCT4wacby7AtG}roUUnMNWO+H>;~MuKGAE`^BP>%yE5b zO&6E8SYS4$-(Ho=PRt9t#00y2Q|=-Lmf*3mH04o7eoYvyjm0hwI~x|(7rjld*Tt@j zJ6kNVw6*DbtI4lyxGk1e&TQG=+MOyV6ib}2X&HwY2W(p4w(95VeHRy9ylro7WV4&M zce}ft6}LsXyqMkCY`W;KJ}4q%>TgE78rk`PT^G~QY;4VMzs>NzY1)h5E`FO`NaW8< zzoNVX0wQE0 z-COd9;hoKFsvf8At3hcx(*JDq#_{o8%9r$&rm=FhvJ1zXy#h=tn$5Po42NU=38`gh&5q*4JpVQv3~u6bvI5vuUy){9ASLq9KrsKMX)lGt(GE zd}0`d8t0W@O?b#JW_$m~t5u760_0*)f7LA(jIzfG z!MikuIv)L3VH|gD-)SgD3<6Y9WpMktF1)FW4*ea&H8r{L87AOm)*q;!b#2A^6ps(N z{)TW_ge!%Xd3n#TS6rS0a z8A<*T|1#8X!qx6BQa8fGuw2y{ui(75%N?^@Tq2(d4m_36jLyZ6|MtG_m|bJst#|Sd zJnrT8w}`=-t9V^9n+?JbjxT72t{?vCxLCh0cL>P*#ey~+QvV)?Fnv?ohho>nsIU&I zO6vICp?}%93zQIG%qr0*d^=0=!9P1M?z;C@+(qVm;Y;T5ccX*;*$g*^{*w6K+Bhz1 z+Ca^q=dZZye=_meZx)=`o2Ky}msV|8j9St!w@M z6*td-3iyT9uu}Mwzkc_qgafo!5>o{PAOaFl0Re~r)2CHH03sm93J3rrkl8(XAOI1t zNAf@bA|NFd5VYja3M-TbAOhM*RzLtEAY&>Z01>d7JP?2g$j}N1Km_cbJP?2g*duu$ z01=Q=6%c@!9jtIN01>b=azFqgAm=L}01>d7JP?2gC@>WefC$(@f8q&2-rP&AOI1tNAf@bA^;Kk$pbMr zn2JUdfC$*xJ^IN55kMIF$paCvnmiDI2%rf4=~GV=Vkfvz|SYho}L~aU;qa*0whBJlLt@Ej&Ls$yU6rRawG%X z{D|1oLWXSc;9Ms9-9mpzpX;}eDi(h#lH??8P6+};p2Y73Io`=t4zJinjU6znkXO#) zTS8JmQbx!<-W}g;B+`xWH&{$2??2{~t>ZTmocI#I@KQP1O8J~8GO`W`(W8KFEaSzG zQSPP$Cp#xwo5WN3wvmBZ4|Tbn&tnwZmWR^D3FM7zoX5>J#_dVkkYtAACzEK-FDZ~w zD!g-|1{*dQxs|_&iSl6!Ug~9p-Vh^WGvCH-)~tBomq)<`NQbl}p1I?tUjkH?@!2!S zBhb;(Kr^0*KW-z`Scz;!U-BMoYjeeDzJWk^Tm?roaYA_d1ePScWMU>Rd2OlvcmvzY zSJ-8c3jq(iTL4MYE%`)F&y95Cr2aF3Rr=8_G_2^L{i6TjnH~U>gGi-a@tV;5pP_id zi06-+hzz$%HDep^SD@5Qv!so;1N6d~+4wzq(%)06dw)tY#ZP)UvjqICq;*OK1Yo~T zvHv3TLaHbWfLFsAd_Vy5G|o6l9>~)w<0N??Pjifu6$x#G>KnR#E&NDXLkJ2B!1@aI6qk@eCto?%=));pO}2&)71LR9G|Co z%~YZi!Qo$vQ#U&EN1u=n__SO~%Ni&o3>li!@;|R5zm_>}h)UCv7GjKZy_6&acsoA@ z%)cl6d3m8?a9VbXF)sqdy%)r?LKCntdqe8gPAGJu@&q=QqMRGA9KV?RbNbYO zmnstXJ+Vr-Qj+99vME^cbl}hayY;dg3l3cRkxlU*NtTxVNB-yqDM;4PLrN~IY=l(zY z{>F(t3fX9xogJJC=3r^lt0EoxjmluAjfKlMl@g!18NfA&9l zDTc4`rz&)RPW1cooV7Wj((>1}oyHHXDJb4762YSy z`n~_tblI?Eel{~%r6i>&WV0y8Rc#EiS=oP@4;u>c6CQ1q(l4>+C?>Py;3xcE|7?>e z^}U{$eJ=tbKeg#fst^3y8=mO*_OE?Y=9k7)o8EL&%%v28DJ&9rus`+xxo>3-yOXrf zfkRBbCrLk#{Kxj^+pDxqWuKGj4wA(04oFhAMIN2#_X%hl@t;__nWy_CMIj0BSn4PK z9r?Zf*+rt8hl^!8(vB-7_EZv(`aebK2OB? zWyPQBpFCSu>6euf)1 zA5NR?q+R}sUoX|7V)qHZ`~Qr;P*4H%;?$7bL5L|m@~6Cxpg!{-)#%@NC|$j**r;NV zm%DT7l!`OyV82?MN(ehfP>q~Qnp{Ax)_5YK%j9{5xInNc~-Aa2f|EZFnIu70V0 zBsK2-$@onJoNHyI7MLo4AgTUy{muR4!};BPW3~1B`3wDWmop%F=Pfvo8#=^DWvOw` zeHCHJEgg7Z^--iOlB#^?TPPA9>InqbMb!{7gTEu3yd1>p)COE=YR)Y{wmO$^*YBJfhDm z3_otguTG@#Ou95C`VZBgj%RfGLptzdtrMsa6Fwr3j>I!n7Ht}KwYm8wuRs0#=)j-H zA2}fY=a1B*tA*bij3_08v!!QQln9UY=LW)={1=grB&sxxH;jz3WDc+7?+K6kG1c4O zo}c%}XSxzzh)-Q&@|<{+iB5RnN4>WXor$4?;G{+T1SWMVY@o!C%zWXUtvK>4em|IG zAm)2TfA2#o#s7os3<-(JzO@UL8+V6xeyO;&71wJ7++VqwE|Jeg!@l7T5_b=|HDxQ^ zJd_-6y#($PHTd69-qto6?fPy>_;gdw%cZ-qvC4P$78>ry=nf$lCAn#(OS#Aiwfjba z%DKdMft|=%t+@Z<*Xde>akEV2*azQx?}|YgFSNm$8vkyPUS<=FcLeyO|-E zce|!31NZd;H*}y^c?tcnE4bNK`0Z`^Dmf*3n+XB7BU;gUy zTrLk@&V{rhyvL_Qd0iL80XrAhAByFA;Idn@UUC0>Rb057Q16P}-9XF~C7hOD-IAMQ zU08Ml@h?XQ2ZA=Zo3V}Ww+(d?!27ZM*ed2rhZd%iEX!{ z+;olc9rZ|kjk_@p=x&(S=42w8xPaxWS^D~uc!!LT0e(KPHuWox;eq_R;UAtZ>;ERbL3}o>KHGWG)+jzxB_G{Pg zUzhykOtO7juQ#HOAH}q#Plo|I3-C{2PAhxGlj!sJIP4OAIy`X`IVq4l(J8qTdZ!Xj zAQHXo_seIZc0-cO>B)J63z37eKiQ+RNizH76lCDm`Gm`X;b@P(MTr;%B1`u8(PauT zXrko)dOSr-a=J`@^aBJ^2)WbyVTojlTpXeo9D?hDgx%Zo><5=lCwe8P*F(&r-G35F z^-F1z`x3p3am`7-w+HC*X<@FOLNE6Y@pN|;1cgTS-~_)_3wvfA{ib53LA${L{!}b2xO#u6TW*37LC)Xw-g$En{?OnG;UPGv)l{pD@(^k>uY# zG&&qlqg1%(6@B{TA$#zTfB#gG4_akZK3;Wu6oTw;I-H{*ecAETR6nrP2Lpu&bL4-f z_x`BEQeQnuueSN0$_MTA-oIpze|ylWDfS|OrwBL=*IP>Xr-AO{gH9yCrwHhr)eWH3 zV=Jd&qfGR&hmQlY9|jMr)Ixxbncg#W$b&upEkH&~yed#J(`NuF@_P5q=JGv0_=%I! zsFVL~qSsKI=~IkE?}c=IbOLItu0RIkxU5S3NP}jwU%GWRpO5DKWSJ5jEDMu9x%!#B z+wb=1ES`}|Zj0U*vYB4@Hs^CcgLiu*1zk`kL;TZ)Y|yd0DpIxl;Pb|T-iLn|?PmD- zsno!x?k}?>ac@83IUDz*aR~CkIPQv0_UlkwN4qZHgGL5^j>3t^{vcfB{_pdP2=?+_ z9rU_QndntV!t&arLvPV5KJ*ZsC(B>?#7T8NsOB;$jS8xyTLf;8M_Kccj;8%&S_ji= m*b+mLA4-ca(PRJjB--bS?&nj4awzD|s@%h~(-SMQ9! zFyJ^L$H`ih;N;=2fHQ1d>*zhP4qT=4va@-|OZ?O4QhyTX9E=Y@wk6OK*aiPZ&~DI6 zpqD|ffcAi11?>gB2HFSuKInDO4?z1tKLou2dJ}X2^drzg(2qffKtBP!1^OxIFz9X2 zJD{I|j(~m+`UU7+(0ia?g5C#x06Gf#73f3IuR+H^{|5R9^c&D|&~HH>gZ>@#3FvpA z--G@GbOQ7T&>um60(}blGw3tWe}Ybe{sQ_O^k1M;pud8Gpud5>1pPPYE71Rdz6Sjr z^bgQKK~7@834mfiv7k6mJSYfC0EIw_pd?T-CpL)49WrRM4Y|=4Z+_-LBm10ptC?DL3yBjPyuKZs1P(7 zGzK&lR0J9aIvaEjXgug#&;-y#&?L}#pz}eKLB*gcpb}6is0=g}R1TUBngOZ+%>>N? z%?4G1E&|N~Re`EO^FSAa=7TN)T?)DkR0FykbOmT3s1~#cR0paDEe0(CHG-NzSAwnr zHG^6}t)MngJLqaq1k?fQ1T6(E1FZn91g!$C0o?>z3%VI}3+PtRI?#I12GAX#?|?Rf z?gHHnx(Bog^j*-sp!+}%fVP0H16>b#5cCk}VbG(Xt)TlskAb#<9tS-EdJ?o9^c3i6 z(DR_3pcg>9Krew_0qp_33fc$yKInDO4?z1the5vpy$c!v`X%Un&LZ>S?H*<8WaJo0Nn&y3%Uh#E9eE#i=dZ4FN0nIy#YD^`Vr_5=v~lzp!Y#1Kz{)J z2{a7)Zvfp0x&Sl{bRlRir~z~>=r+*ppgTdELEi)I09^xG4SE*z9Oz}xUeFIgZ-Nej z-UdAr`qbG0dKUB?=y}ji&19}y-7xWrvAL#p_*Fir3?Fao3 z^akin&;ihoKnFo7q0gLDP#UNoC>t~o6b20e<$#8R#(>6xia_H)XM@fGjR&0zngE&! zssTL#dJ?o9^c3i6&@-SNpl3nPfu0BL1ks(i({XY{ZKW%B)GtnPdwbci73~d?&Vqsh zA(Jg?22Uo=DQzolb3(*tA$L%dDHr3Qc2F3;5wuHk;+%r|hQ$(-E#4HGhkDN`h;+I< zzCpChz+0-I(Q#^pt!(jT(L8}`jMQnJeB)>rbYh{i(V4Drd=qIWa80c)j&CUK1h2NE zN$cdBOS@FYvu)9pn#VVqc74ffZd#;yeA8(cE7I4{A$hst4XAmj!=0+mNK z^x8#ukLw(iQkJJ|(E`xC7!j9Rl_xo(WuSR@FFM0Y!X<4j?P$?B&LaxXmVhmG8|_4yX>4}y z0b4!Vr7%s6?W!DxMQcd&Vw^+=w{8?@>=+T}8qreHe7t8*kJFUdb1Gz+xww&2>s~K4@)+)|yfoX?!j8o9$IGYrYEi>(6n2*JCrd6qY zWQ$F^o(}R+WyUQE%hsHB@ho#!EmC=$En0aVPn4@Ax?HjKr(HbrsdGiA=CM_%U68yE zUB+`oYfB;qTa;l2wm4%BdD#AI{rMRW@%a~1JCe@iGFu9@y z>S5BIVbx0`i`v4a4U3j8S<(=3iiO-H(Mt8?hB|(+a9eA*ZfPXa(ApX9tc@&b==7f7 zJkh%Ku$d^crQ!T$D?%!7*$UP!4)XR<=H!ZknE8SCV?jtr~k z#(iw2%_*xCMKq^!&g_|$)!}7rP4(fNsxM?PFRkSm#2jVDP*-m4tE2T`Tpc~sb}5Iqu4SCO`N`DhvRFIWf8nO0UE z&Y#n;q^co;^g3wiF+WO056P3w!@Gz28Y1D&#s(chU1V!J!nLj8*%f7ouh1fN=>lHZgQA5PGsj&(G6? z`lCIf>fjvFBhK)oF!;jv>DHFYL6)}f*0KJQ`C zbJZBWJN*0{(W}*b^gmJV#LKq4q7ttck*-Oi*Xzj)bw;gd)z7b2w5OHLDw{LC#Cw6T z>{N)}vWFd`^@ke~_i(!!uwbJl%r_p3^2JT9^=->L!bJszxP~_*>MZKY5j|H=SCX^1 zskWo8O+LFDRUWZdt{v;Ql1M{sX9LS5TfL$spv|IXPrYH$i`SS$Cy4UhQCHi_E7C4| z_}Yb#M@{v!mv*)z@q{!s)Yju+;jQdo0wWD|GEyv@UaabC zJ8Ku!cA%Z}n21-l7*X(aqCD2NuaNd~#YltZ@qIR@WC2U!g0lLi&Ne)|x2injXoPmW zzvLr*vKkZV%N3&)o=m!s2@lg!9k_=wAH;};667;LT}X{mMwx6e;^FB+oENut%6!Zd zBOxBIyECP!v!%A(A8#p}D@IH_*)(BG%8LgMEE%U*^z5|L=?f2&l3FItCzCAWjfVxs zm7Z)dD&y%vyce~ADbp16;lYcrHA-Hd7{&2$-JO!9k&d>AKTSUu`Ijq3dpud0CMhq| zbWr7UqR*bZXW?N|Qs4h1pG<~K6Pgb&E-MY8D_e{zc{UMu$Y>oYmX7IlZLPkTtN5h) zWEp~_EdZDgfauG11}uTYGvd9uA!+@~~AI_!yK1W(2<(-#NCuRgL& z#xGlp&Uw1PTee6&v)N+Q&c~~3cl%4dZJmpeb1HAMe7sa=dTH5$l4%vwTiV-HyCzSJ z0(!bp4pF5}TUr~buV`DM1Tp%;_~(hyLQl4*GfWDET}&7tQNAn1sG=u(wsV?jbK4Se z`@*>eh|>sGaIDv6Hgt5UF>bub->?|f)jZKxEL?$x9|tvL-f^T&JNB;^HPv@4ZW1FK z&b6w%4L4+B_`VYb4Qkx+kFXdu)_R1U=S`D|o3 zP+e2ItXX;JkqNmxF)FR~#5g^K+?7k4>uQ^8qz6$s22?0UuRYmbLbj!;qpqf-Gtydz zS8H7h`X!EYzS5oVi$ix$9(^zNhbTKn#kasG+s!B2*4_zGraMoJntO5Z>xA5B>g=y{ z7IvkxrJ)7?U7e$Say>oUNSBu^X@87QR_2$;1Ei_Gp}C1#2dd|7tWP%0>4?AL%x|Vu%OJq47A5EsMr3I~RXp%DL`eah19>}z{dhwaylTo(N24339NJ~8v zeKIP}ZA)8u*EgtiP4dY|J#5kCH_;gN>XiDrCdXWS`DNsdKR|V>#kW zjn>66VqvqXqrJIyrHX%!_>!Y#VjP(d^=iL^x^GezZ9sV^?7 zJYn3U7Bc558Gb3!j{S7Tr@5_7JimoPCRcn(@??zi+a6(Y!st5lJx_d1&~n}Ed@8BF zq_V7_T;@}*_%fwsb>1&V!@9M$Mbrm9l6qb@lli*1Ez(lk z$tcSB@k@txDR%s-s!ONO*6|CAuVq@6^)B-TkG9g4Bfg|*eyqBWUUeqR^DM)j&f6u; zZHt&^e^=?_mpJWWForGcMA{ZF&PT(9=2ZGBeRA?XHP&`CQr91q%tg^;8fwM8{H>Ci zw=ZotDM?auS*Gs>B)_*I$B6<;W|PF;37+FJ4#M?{V}qg4Fn`}D~?V;#*j z3{^6h_+(^$Kqh}#Evsf3uS+DnNLpYYF*mW5NV=GDO2N< zk#!}i8`OgkQFT1Ov}&izM0;CDXNMRF(Q-NBYpf?H^S?dPBr+jg)$t2`x}-h-yCPS7 z&Gq!i^s$;~Y4E3yUwpM=dxd2cLy+kBBTgzm>!QeX)V8$aHoG$Q(PSE$Wd*0o4ZlWe zS7AS^3tE>pH|sh#SA2cevTk`;+>(#pKVMRq`5^D(5<@53y^MbcRK zt(|^uTWZA%245}ZeQff{$h=tI(6pqHd7fu*%?X)fQErk}T zCs%w$_he)pfj34|XTErRTzf4(U9voMbjlj=EnzP#zQlXFWW9#wjfzj6!>{z(#bCTr zSnjg{A~Bh%KYqXU?UbCItXIk2i^-g;)}nhQ^u>asZ$h*fGYD5 zpDy|A;~C6vu3aSFF^x*DBdT1)mAgX8bw-!#$gdTN#cT(ehNWG}sdw89A(ta&D0pd* z_j?(}iNy<7$b`k0d@YlKZ!K4ksdLb6Q}tU|%y7_r{Z3itwheN{><5o8^MK{05ygu6 zK1|pt6f-2W9OkGvWfP*dNYr<{9P#B|%MZkJTQ#SoreyZanX_l%eW!Ht%f5DHc0JwE ziALcfq@x@&IGAsFVy1wWPqF3kF2%PzD3|x2GcUAbU#I}qXHA_x4FZ^*L7A|anc>NV zAk!XcSPYYbpDSjBXnt}m`fTzu@0^Ck4XCQ{sX)bxvm3O-93I)X6NT8#$kBx&UU^~` zgq9s*r=hs2s%%cRN<*QTjiO~SC&O?WQ~#VngM=wG1U+RZBN zoH3$ZoSly-3-|(|@-ZxC?`YW)w5wPaS^vm3K%SU+qWPGM)kPoK#qq<(jE7Layn zC|A@aT1`mHR1vovF-u6xT!6MTWoktmxY0RJ#s5x2Pm=wvDVsBAmeDTcj3ezPs`#T3 zpyHn+W+Q3-Bo!yoPD7k-6=gI>%vRDe7pUhEpYdAIUsC10P|Rl1GEvGKI+#sp**2nH zlK1Q$BVJMJgvHHmcuOM=R|@%DF-uD8pNMf8k$0@*8_~0K+hloSCY6@s^JLXEolR)2 z%X^n2W?X66i7M^v=hAMuO8b3AJSVBNceY*C(8|OJnXs63r1hkzJg%yq<35Y`8#GB0i7~PBR9YV}9(cwPlP425XBg<@uywp)QbLA5ceo*$RkEi5tpqR&nNxH|?UxH@9KLhj+A2$mfXJaaul3-BY}iDj8onzEUV=&S{w_ zWe?rbR#Cs`cPVGtX&2IUKwAq{I(h23yc^C5wrBPOi-1j+ID>G zS^-r`=1D_OKNWw`2Y|6WCBs>M+Qlk8qQA{ls`xx*$nYJ;=LPR>kq_BIPp+6HsP*Ki zXUboG81FnWn@-D3JN^EuH;KHz&l+~i?Yc?V+$@ypo%Wm|e_GjbYYmxyoYAOVqDr^w zi@4(%I}I6r=V!XnW=6(H9h?oRU7Wg4vd!6u8O2g&mm#C`4j=2UxvZIF8Q~04?LzALDw|&^>f1dc z&+^0!Q!O*eZX2jK(K9N4IrCOK_EpvW=178DH@t1g^ieivPOmEAysie6Ijbn!}r{(OR7rCDywQZbESAzY00>P zLa&u9^0P?H9M+f$JR{LCs@1IK!WD^`#vZ1BRE+lu;=RD!EF)inUBpd&2~v4kBxW*e zJ26gw2M=t0LwiTfBDrp&j_J|Qi7emQV#c$^^x>Shs~yb5W*iE|OlZxEL3`Vs|0n0S zh4pu)>l0a{YWI1({_Fqw|F?3WR}f!kf-{1PgEs~r3GNNPAN)L+mT*?W)PzL|>l0p1 z_#&Zus30^Wv^aEQ=#kJHp^ri_i31YPPh6FFZ{n`RUnCYJ%}83DbW76Kq}P)^O!^{e zK=PdARmm?Wf1Lb}F(#umV{gVs8Qr^$={B$1)7=hs`>b2{?i0FS(S23-C%V7W{qydBmX)cYU32WL&qTAX!D)^k}OW+nAGyU!JU*7w=f=c7JJeaG~j z*Y~=w7vV3$ zeFvRC=*mHN586BEqd_r)hYg-FI5PO&!7mT~cyQ8?f+6#UTsP#2A@2L>(F^ziqGe=)po z?)kZ`xsT)?%>6vK*N6!tE*-Ic#I6w^kLZ4u<4ibf@mcqtb?~e|p4E5c`6CyNyk+Fm zBi|YM`AEmRIYS>D#XgL%KtOUh?yD#%}ye`o%#{P**}${$cLrQphf^#!{MJ}QVA z1s=$8=7?YZApIxP zrT>`nx58(B?NZ?3qMf|EAa>~Ck zezZ@gCNm?FFDcmQh{G@PsqOG)7z^Hy*Um!S-$u(etvzuA@ehz zzN{|vzYk=O`1JO*^@cDr z809#{ksSG~^@9{w$6-FK`>fsQ42bI+V0g*ecs&2vkjWA4kN^_|*B@7?D@**90yNe% zV3|oQcoH+fhnYWYU0@5IK^fODcteCfJ}0|F>jGn=JfBj}FrOaU9`4%aUw+#%O}V(v zxfYm@>ZWO(a|_bMu#_1AnUR*vZI;Ygkjb-T)>|?oA;UQprmfq3GI{7nqdn!y98U;` zoX`eWW?$lo#LT40NitsfkR9d9GQCdd4p&yn6hMaaC`_AoS~8;`!#NbD%y%rALdbCL zgekMpk{Jyd&Y3V}?y_XYK!)=rOqshanX!=Jd5kl|bjQ|3NPW;|p#SHhIpY{{Gp8P1h3W$w3RCO~GACG&tKGZ8Z9 zSuzh=GLs;~c@n0rhb)=%Aj4ILrp&{Z%=wVv+z3Fv~VCs3N#Y|G(m>*6-=3*STa{a zrrDBt%aXYYGA)+OPc4~d$h2BAhb@^F$h289Z(B00kl{Q9GtTc=GHsB#+LHO1CDRTW z&QUP+9I<4sh79K?m@+@NWFnB^+yqnR7nV#1WH>LulzG>Z>4eNOOXfXGW+`NTWy$=~ zl350s6_(8VmdtXw?e$*u>jM)KKSN7dI@y0-1(_`88uZt{ z@9aSTnf>XBjk3+X+K2ya(fYt7;3e;RAMa)G&Ubk?`gp5q*9RuMyqkTzSqs+(rntOy zKHgVXtPhmByxV=e-(S8yFxBPV>Epdovp!Jn^6v8S?p?J$FvI0-^6|E(M1nCG*^ueG z&&MlGjs)Xe-UB|~ilj&|=<*)+@jgk61Vb)wi;s6S6bUA|yvKaJ(u7Db#pONW<9!() z38uNcr+mBvagkt#%iH1OEsTu>ySu#SeY~#&kzl6F+vVe}!-!8Wm-mv7cRV{1%yM~q ze7rsVBEh~c?=>H9Q{PB1+vUCPCHUb9rz3cssgBg1Ij5h>zFUEfPG-<-P0Um1abOc`omLAFnVy5-f0e zzw+^%v`DbfEe7yN1Bf%n<_py(ca#kdGw#)mSkGCf`5*+XHPWX5m zhDU-ET;892yzRpx!AUOfGaoMnyz^b&Uwpjsp^@NZmv_p?`+7(uIK}1t&Bxn0I1(&% zd0+W>6@wzdsV?vDKHiCekzl#Ya}v$^@Sy>b;0%`+>*Iyaiv%lNUeL$eGBFaIHW_?$?v+U0fk@!HRh1n0TDo<82%agpGBmzU+^g^MD= zOI=<+AMeC0P#+^6}b7M}k+lxEvp^s4x;-=<4^XS>Z#PMv`J|T z)7GYKPdl7;GA%QGe0oj#n)GeyhteJAQ&1>_QO*&+lf`e1_+24>H;Lb!;`gxlJt2PM zx)Bu?zmvr8eDT{Uem9EW9pd+p`29ruVuC1Kw)h<{eyhcAyZGH8ez%L?1LF6%`2AY^ zX7wPpNc>ic-)8ZyH@;e5x@Jy?@{r4O8jQ@ zBq~q*mW$td@w-O+J|uqkh~M|b?@95S(u=5E@mtz!Ljv~jLiWZwhkIuC+)0-BUg0?B z;EMomn$s74oKrNH-xC6mll%F6_0NC)bI0PBfIKFya5z)S#6TubjBfq|GTX0z4l?OZ zKCbZM;p6Cq;yW((>~LjpSvbmQHwu4;5r~05H84nBrf%Uvx(&vV)ENg}A*3CLcInfZ zI!A*W#x?3Jh@w*z8G_)X&Uok?b4HzG4V|N+=g3*klfi8y&efS2(GclyTm z4VXHUp|iM4om0Rm0bz3*eB@$0Wvq~3H=ZKz@Lht{r;KL`c%@zHECXjMXyF-jjv&vc zGZi|gb*Zx)oavye1TK1h;^QZrnf5g3oYAFDZthqCy7CMQPfx+~S5_w1|>J~0E zR{G*srneV(O|H(}!tOcFmAJx-GM{@x<|bziNix0>U;1#xuwObqg07Cp=jW zrQIy>T3wwdh23+VHeBIFX}1q#+Fco`$`LZ$7{PrLgxvuuVHrpcx!~tzoR^7 zJ;wL%WUE{agv^buj8rAd6?f&j37oZ{jby;CEa!(4`UI#ObsC<{3p5D6OiLKNo4eF` z3plre?jkOVPL%Rcv7u9znL*IG&eb{pX5PDLR$2x_X1yz;RWQ!nMeKI?8$jZ@zbIDJ z$&Rx*)F(jQs4HN1iUz@#c87p>hpY35usg%Dn**8exH4LW%q!#_ICp`HHADCriG2dp zEuPy@xxtfmhk|#vr}ILlx5BbJ3^Mn4GD-*Sn)}(_&FiDJfpxG;-FSA8-V60*`10Nj z2k*O4b#h-^e4cjh0|}i%iV8fP4bVB$&?(cB3!R%?ohi34EwjZQySymvj)2Vlu8dZp zcOZKJoCiSz6@%|n)bL4t0@UsB$q9)M_lhrdo(0}RQFU@}U+R413_9`5h46^GPU;*9 zo!^V9lVyxLA3cN4M(DiA)u_u@9&|qC>Z}y`Q{_C3E4(P}=0oNgS4OL#4EHGB0smQ$ z$e#?&?M&_ypl-BhV0Vtb3}4=t0`OiGI=@E!utC_Z7Q3+VqO>~-GP_+FtwQgK{1P}X zgM{6Mn)@m2Qupaj+ARd{6<6mWVRx?Bk&PFn-O-TQEUgz zBiHU~VfQl2?m0dgt%7#Vy{u2SOWneSF4Z9T((ZWh-Vt{B-Z>@gUSZW;=lW!{3f5hG zj(#T4j9GFpNvp}ADz#7|M5r32*fD%j`ThO z>c$QcNN=6GN>8SDGI-Cqb~7$x-+!@Xx7a76RcN~}0KE&eh79DhbU7J)0@UrWeHRjK zO2v_Or+~+u(q$f22)m7z-4dUSf(se$zJ`$uvBTO8WC*)_ejkEe>K1Lv&=TjYguZAK z#33y0mV(C}*=0T-5O%M!?3O`B?vciO0a4*}di6f;;#ujY+a8(S`UI%kaXOG*(dSe+ zX?H4kfkbV0MGf=0&9XZUGBK`H?Di10ChXgQrKy-O{- z7eXf0mC-7+-8690L6?)^+FcF1)a^LSV7Ehq;7hv|;B|9#Zn}bYud(dTgiLo=Myt?v zdw|1T?XDoB8}`2EO><7cE_FN3a@bwQOUg;Rv%t%8b*3z!-Rms7vmw*RmC<;qA0u+$ z^aJfA!?oMoqfdakvEmhWS8EV_X}1!*{;tlo!tM=XH!Mb5)>jw#WVDI_KygQ`FlZ3} zCZkZN_Y>HqZpT>(yVq+Fe5rE|c*}wE*MZy%o_oFPec*-8O4fl?kn8lp_f+b<0Xjc) zzsl;gRDs7`%%#q+_Z~nVe(vU>Oz&LCaA$KV)Bf6$!Z!5AUPQ-&`5S zqrz!-4&bY9vlv|;AG0CmcuZ03y4Yi}g>lt!+vC2D3&(fHZ;t;oJ|kEkTo*hRbP}o) zRwNuwIGIoy+8o*!%1A6qT$i{b(MhUKT9I@(DV*GyygB*PN4)D@|R zQ%|OrrZuMROFN!cls-RwNBWWUoQ(2}hcfnOWOf_hZ9})6-Qv3Ec3<6nOZQXVvwAf5 z*x2Kf9-+*d%$=Ez^B(BS%+O~Em}AP(+M`L!k~j(?$8xvtd&A+09Pc;*@J8WZ4E$J7 z9EdZ)gP;UZ2$Tp)0wse|KaG8!rHp@08=6z;{?R#-TD?409<~luHvM z{th9(4ac!vX@|MWLhpy|zJaZi{!Sy>7HkVO2l`;XfX47Hn7iUj#k;R3Ce@c7j-N|A zylXsHC5j8B`7U}G-eq$aeJQr(m#@K2H`mSqJcC}ou~fX=g&pzX!?opMSc=SD_oYaA zC2PDMt{qfZz=iVF>P)3Y7V565by9o7=u(ckQgIyjNy71$Z#re_1j@HzG`F|1X1)=v}{8tPv3 zV^|BByZcMAMlsTOwrhu1Ild|Fu-4)^LejB@<6m3EC~!d+^#N-+b2okk?!uFHSSy;l z^h@Dmzj+aPFwqw`jzvlgYf*Ct{Vois%M!y{*W4XnGPjA*#}c0%awLYeG|xuzyW;{= z>c8k>SgV`6=}WO}F;Z66g&n>H%w6^+ChPmGucx}04#I;yGp8UOQ=rZ%K0(VaDp|>H@P;i@LtVuocm}3(P84R{tR} zY;|P27`9L}-w9poY(#y{wz+l^!&b^*1Jm2UtifxmPk`-e?Ieb+nh$}A*O!IgEWW7! z+I<#kfMxqxV%Q4e89tW#=bI=8|LI~hS7O*|;+a3v@ov#=Lz~tKo$La`Ru<0%l1_eG zz}Jtxv~x;bHN9--kIsO=oWL!Cy@AgHgJb5!tdDs;=JS|gv6sf)8T&@;7qMr>T@iP8 z+`+i7;tJvy#ortMR{THW$6)R41HpHKF$rfUT$%7l!Y>knp$VbZ(ALoVp(L!djU+yi z_+esN(v+miCbSS?JKkCAtWj?(uBptu_9d**|EhF-U>jn~7Vf2J;l^Y7Mt8AtF&Q(N zQbFmUZlE5Zo}k_!uJYpQsq@eWSq@qU+6_7g`T+DP=qYzC)i5WcK1R%w2x8=Oms&r^ zI8-0{A!g!ap_RZr?XdSHVzC~5mmqqDSKyr2A#$o2{@^OSLD?%)M!qOkm2`Y*-q4V+AIA7flm_6e7Pb}BBZ`pph%8G zefwZD4k22I7gsS>5StZX`S9E-=)1{@y8-*r;j;_Q@)43!A5jvi;}^sgX~Dr0o8Yu# zbs+P?b^%u(5spf40{$k+_z@FANb5_)-5wAHc!V#H1aCFs z!5Dsuc(A^(omVbsRmZ6t{w7I%YoPCDLmw?=#AgLq_t?%$S9eH}q>k3b>jURtmbWhV zeZk3%TOHuDXgg0w4@i+zx-et$CL9s0eYqbHCwRJQ&0IhzILn+j(i>-6TmJl*>X$=Ld7@ z6!L@hlI>XbHymep1T?Obi&A|5s)G&9n&Jg79$>v;UUC>Z8F<=>7rGgu95hgB=v1Cj|8tW z^wH9%(8ulHdM}kd8 zJQ%}_ge-hxjUEqK57DYl*C_l=lKR3IMuJNWeY8{reQdAV&P&&5NRd?DR78Reh7M|< z4;^gp+RoE47E&asV+-Clb%qXVUkx2>FWb)3F%D8BsUs6J@M{en)V>8e*xt6Cr{f$* zk))1F%EIJfk~;FR+T|ic2et2q4))({=joUZDU#H& z2CHdi8#-89d;%Tp|JlydaUrBgQpbr&k>E^22epS1voIEQCLJ>&MUpyJ4~PUWG;~mV z9(1t(X*(|-teHtt$04jXnr`Tz_Dbkr|J8P$j*B2gk~;FRnrWJ$gKvdS=wScXcAkzZ zNRgzDjaV&JX6T^y&CtRAv+X<`b0I~NI*wsAR*9j5+V?>R``@?{isiPb#OGg_zg!bgD0LO1^=jmtyo+Nc-U^V3^LkG3zKnKTvZ0G5?3Q{Dg zBL}NB^9>!;UJe}`KeC;tqXkkVl@_c99ck#G_Gakd_>=8C9c_>zNgW%o+H{1WgW5Mj z2gk2$=jpf_QY4ihSj{@z&_V6Hp@ZXJw)1p!K#C-Flw!5)P(uf`AB7H%pV`jSu@q7y zsbdRP;|?)&Q2W==!SOfSc{)}?iX?T!VYTldLkG2oQ?dfwf5LX2j%y%Ak~(s+ns}h0 zgW5}>gX4d;^K@JbDU#IDiPg&e4IR|p2pt?hw4JBpdPtF^j?GvN-OtcL?HizjNtkg z;yn!=?BRV09UMQkou}hgNRgzD$yklv!_YzP*{N9pj=$Q@({UT5NK(f(tak5a=%Dt= z(82Lr+j%-}hZITbIEvNu>4pw!uZIqf|Ju&eaR;PGQb$fgB$#UGp!Rjp!SQ3;c{;uW zDU#H&2fG0z8#<_c2Xt`!*>;|eyC6l9Iu2mBfkZ}HT) z=%9A2Zw+w#+jgFg??Q^C@&mgi#2Y%OJu3~fkj|*%K1h+Ij&<0LA=c1A?USH`sq)1Z7 zozQWvp@Z7DK?lG8cz0gg3}*B8$d@unWE+Fz1$9G`%_ zWM?S;asFrwCj-96yb`c&(h{nd;1NrW)zb`kyyNexHSOr{cuaAnIGpAqH`c)mb2}Vbb#< zdFQmIG%NpUN#E}@k^j`B?Pt!D_S0c~ieZ1n%QF9m!G1bsHN*@1oTJBiZJgtnU}(|l z&#+RVZ8H@aA{EhQq;lS;j*m`7H>~=-!iZ1lS291QKvOq-N9C8)SbUv~#oX3dd{xAp za}d{Cr-5=n-;__?&yY{uMLyAj9j_kN9X_e<6Q7G7;tmrP?Y?B5!Cq#U_IjQH)w4@f zFDsV2RqipCy`sia-@)F_`M{q3+z$Y|bF{#O1T{_Y_WQ|51fk-tQ7E-}~qXta*)fHOQ_1H|)X&*o6i>4+C?kxVP_U%>y@PK>Paa;O2e3^%ee|Tzr)g2)`hk~ zR(y~D;GoDi)(3;!_;QXn=eUMJtOJIDhJ&~+k89*u0yy8xo4@7Nn}ac*b(Rrd<~_^M z7+4tWU}IttUs~WySe8OsFg5GDrR%UER-E56@_2|F=dS87JD<%w*5v`G@OJs+o>b^J6^zcGecWpTfHW3a9tCd#5l+9gP9(y173Jrk23e%pN} zhKpw+S_(8e*FsY}?;D?}To=uJFw?KmBhG*x@r~%S&VWAa8_^@rfFAjc=sfG*=VZ!U zW38Dd?mgE=a6YtN-J$bcm(P4>F-oZSgnq4_sj1MAk5hwEF?;&V&lBq?{XB7+sBO< zpCfEji*(*wdi)ull=0$8;r(OVI$AEBYuU`*Bg+l%$hpF%*{0CB#Qu-jZ(^KuE=^D< z?~dqaYNGYlTWGxXCW^P7nM3(VE7ufrjX<>Anqs$E7|rguyFl1uO~hJABelKB7Segud!i=`q<))g zq`o`F7INF_-Qw=hW^q)T8ac&@IITvl7x(-Dft&;66m;eB4>9E%hwlsaP53mhY;ny8 zpLni=vRA{ItJ-v2b(tu!a&`RIvaQAPS0ZxNy!RSaYN6H`D9mlezi6m33w6jqm34`l zYUO6e-(?J$n^Q$@as`KJPv605mc4Ry2bs2Mr`gl@pxmlUPTnr>9_x~F)!URS40#W_ zdVfu~Y%|~W6FObkW(!T<4ISed7HXpr;~A%+bc`>wa%lVpue@CtwY+J26&CWSQN}9- zQnyldOtsCK7IL#;b7oYV8ad0Vg^sV1v1QwPmZ*iyGS2eNa;?j_j)zXcY^(MS@0Cv} zTUfJ2?Q7O)8m;3}X~iY?8ZR!D-#RW@+eMbPc0=1m|Hso%&|LhUqA)dDpt3Tm!}`qDtn6{yh$O6Sr%3&ptTCu5#K@&4N} zyx2lbe$9JNUMx`T>uHp>HQ#E7l22P~ht5A^J5=ZAC6?WFhTThqUG}nUyO*B9?xo+# z?q!zUBZl3}gkAO-ZM!wrQ~7DC_qMAMPbJq1bIqDY>KgrW%O3gqu3RqcvEQ#zI(M$H zP+4mAH%r?Ur=j#+Szw{o-u#+tYk@#<^`32Op@mv#*jgx1d=F@pwpDAP$k*wr6{u)W z(IN|#`=<9+TqICz8QHe#th(qu)z)BLR43{p=DzOvXtd7Dddp_1VY6P?WdB2>bov^s zJHGSWy&`>lJ2trWFnd}WsqHPc>@76xEf)6J*U>0#Z;54(eC8+ZEjgpTM$6uI!(OAX zXZFyvy(Y`vmqz-Uggw3;#Og>9Rj*HQrDadYlx6cuVUOcE(q%h3SFW;9CyiKMbs9>? zve}B|LT1>93)b{jq*J9ZtUzg7oVb5Em>7}jp45-%AP&#dG7Ha$fuT;04 zhSF(kw@~X;+L({+0>$;8cDk;%P-eQW7O3e_azA3B))+C2oQBdd?66Qrj2LzZ)UYTq z?6gp33_Att!YDCZYM~ApF_)5t(b0CqfLzI z^}d*Lm9Ms`@825BCi%LiSR-tjBgZv zqpIb(21b81_r9>+WZBCwzOddT>~STmPMfy3)6f?8+gW9VmIKCTn_mvXGw|$h!n`AdulG$h$3M=mYP5-Yt-Wfb1Uyd5?w6%9Lf6Pw_nhIRwbQQIMM~ zWVn}y+$4}gf$SXx`CSW{o8=+DE0Dv1%#4D(*FqNd^^o@p!Qkee;!+e%L}b=6cA71@asqdA5j+e8fVwpXDJR z5y*3a zVEM$1HhkQyPX9LOeg>2;07P5MZhkRNfF9MRM7TL&WEabXU z5BZEhRss1{6yy#Ixo@h6+#!&2f&5z(CS$a~3k^LJ#?zKwbjm zU!owNw~+H^ddTMm@-iSli-O!~AvetSkUItPav=W{1^I%7+<%dWd_f==0C^$`a+ifX zRplXf31lshzl(x=(L(0V^N=qJWF3$nM?vnkkTvr?mutxct5|DRq3R?8$MSDp$RRQ+ak{X6nzKpNrGZA6WaB!2wkgc(S<} z<|*c8m?xH-;Q}kn6Ua?IPa8MGJXzcf^AvG2%oD@SFi!_J!#oMx4D-})Gt3jd%`i{% zHpAyyVV=@$@_8b+8RqHRW|${!n_-@+ZH6yEIGh_AG)v{@WQ$*nFrCitDHgxP3iAYP zQ$J6;Hp4vG+6+%anD#NPTDWqH&(o<*d7eaVhA&ijOz{?uCrnR%!Ydy zFCXyuJSE!H#}lE=Fi(Fr!#wHP4D(cHGt3j5&G1}=nZ6k+emt4k~<%Jt9JWmWZ_3?CIGt85K%`i{>HN!mN*9^B>VV>M;@_9f9dW_KxWqh-l)QpRQN6ne>cK(+TJ}@c$1RX`o3%N@3r{%sj#-US%vle zxZlD*V97tI!uol6$dZ593V#n_=4Yu&-xiDis1@FdF!NjI|6>+^o8s#&5g%9KK}!D< zDjZbdCsnwg3U60oJ>L723hVrRT7`3z{0@W}|7j}xtO}Q_@N+7x)Azi>W4VuTI}xVS z`d?6doxWWvtobil@-HK7=HDwyUZ;PLCI718YyEpwxW9-6)(fey?puFfg|+?HRaoyM z`2!W!`L*AY{~^MRpFB6pao$vX9lwK$uglwE#n_xc$_P-3)@~=h|AQ*5pN|ym1j_rP%WJ9%>-eTw{C)^CJz73n z@pXO-RAC+8unKE^LljspCk*8!u~rIA0dkoBz|@&^KW4Uj*Kg4}N*H@ADp z{Q`L{kgrEU{?I}mj(Er)3gq=bz7_@fhJ|#NddN2f@&+LHL_xl3A&ZuK$TtP@CLmvm zf;?a$8&`VB0|I$7kh`KFe`Fyay2eBPNFZ+o^7$ypgBJ40wI1@IK;8!Ajwr|0{JMA>!KjvwUC_;c*u7J@-ZN9j)Hv8LT-P^L%t`Fj{|vQ z6yz^0%+M~z&mrvASC3sGB#&RkJlGci3cAeY@!PP+JBFQ0SGYWWarSsw;H`3b{EqGM4qyk> z)h>@;$30#nc-Of+eslMDld;5FT&mWs%@|m&Z8=9&ZbDt_3fA0{ab!UDe+e<%R94&Y0EMx$vlLuo}M{d(Fc- z`lFbsm>vGYGzKaD&gs)H~~tQwF`VUscJH=P){!QAv}uRyeB(D9QN7& zXWpL%bL@a^JB}&P=U4-Mj!DpGUz2j|!_(*3!Cx2sX)ycT46`pzpM7-7vv18X`|$KR z7LfM9$-(SXlh3gPUT2@5VfNh^W*?9~`)c&JC_ekb40FtY^6Wd)U#EQb?HT5n34M;; z&}ScjFaeeMCxj;9#dCP=SUsg2bwZC3rEk23Vr0B(k1UzC-^zAEbEL$ z?3TO~S9q_ou*=m^tY;0NCW^y%;lKI$`k#S+ZYljunj!GIXNgdqBm+{5fYS25D&qV0ood**8VwdPR z@eG8qo0a+8J%`;>#$)%CH5u~W<%tv3w2d?;&8d#mwsthvb~c1N+rlLdPo2c>z>Lp$ zXRQ&RG^f8aXK8CkxU;b#jEIHXYa<;Ek?@j+)`m!JXIn(XN8YDf3>;1db8^Z`XBE#Z z3+Gf9&zV+M4fB-C!){exdQm3j{p>(t5;tI+ii@l>)MUFl6yQ6J^Df=W{blJ~!Mqn6fh6 z$nA;Lq3b4T_fI}unO+(26rQWo%oA3mJkz`xI}`ueK+AaQXWZjt2}Y6ltrWk_;&+|+ z-6nqbi{E47_e=4c$=48%tc0r&zjzhG;p70gE#h~d_{9!N!apT`GZ3{rP{G|AW@oUs@*EaYE;!ol?H&_{59o(*mO%bcz z#^3*HB=-kD!2uyf2@4Z8B;ZJtDDDu>waf}l3U!9Igm&mbW1rm7(AS}y#PY-yiQ9}O zohhOmuqy1 z`cR*X4xxz*^A{dVUI{{PmhBAn`LkR;}XSQ z*}n;UJg#!L+db5A zfs$uq5a-R0{;iFA%0vBDpybIDe$>Y{>S+)4u|Ual9sH<&w^7e{sDBqId1``0>D>6l zLRA{5PXvms5b3;h{mw@1@NE4~pyY`qep|n{P@4_Z?*)o22iw+v*r;bcTmKPcfMAZ}70$s8v5>!1A`L^RJN?xy^q!^IUT3@dqSDZLC%x&>k zm6laHp_|in*m_&Zt1LBQ8J)y8oJ<>@04o?Wk)jsOxBPV$m6)yE+30+9iZ?^pKHJv8!pR z?QAS)bUstE{D!9;&Mo%K&MdAjFDO^CIS#+?Y1bVkgRRQy*%y}0s)Ep9+79EyXiugu zddHNRS3Cy-GH(0^s9hpj%jBb1R55*48Dt#icC@~9+;;k8rM=?H$~m*=3sIjeza47V z9jDNmcciASb7gx25-sAGhc5-5Y?3Y85Q((5K~}^!jNXeU8>iA!I(4Q>PZ;OoozAbC zt@(NQp5gI(J3amJs_j50vJ=K+-tc>+cG!bY#eFTEiId> z;+TuCF`g_=u@u8cvJA5*Lrmohzkg~Muk54qRXMlXwjaj%z@9Aj4is^%a`Pn*-;O*! zdz-w^YxCFXt3!AXm!%T`qv(<;7JGH(hUep}U!Jt*J(?O53{s-v@(IT;XnS%|M* zrhL}v@+=Y^`ab74{5Gqdj_PG6-Lk0l$Ckk+_uCmNBl0VUEuVxF=zU$X@~*i zn2X+}CmW9*4)4>{=@p3NO!+`6Ietsl4r^27{VuDnhAyU9)L5GTzv*ZFZz}))Rd>C! z+S!7Adp}iYuvZ6;2I69}W7xmi9J43plbDRyN!Yu0UF`PQ_hOy6ytr!ggto*Tjyo9_ z#vZ<%@!R5$#D5*19V`#F2X))x&sN)F|2D5h@@G6P0ep$ncQ)J6ZHv#GMSTwUx>xk+ z*tU@6nezv@)dzKLtxfKGBoAxpO<5})&24qH7;Ta7fgFePBD9ND z@5p&&bE>A#o~7cKhn;slnbV%}i4U66Sfb%G{J1w4&ZDqwN(p`kzd`;QD{xm^$ z?3fxCAu)y6x6#B{b#r@1V|#7gRYf!*Y+(O5pL{RBjrO*7$_sHN&v_i$omTfN{i6;2 zoadok0DCk0?h9hSsJ4Td4afUfg!QbZeD-PbGR+!AOd)nUHZfM3VFS&Gwul?2JnWWf z%3Eb+YQ=2vwiEHm!6~w)tZWCMjWoMbls?%`KnwX@IS$)i&f#jBg}sKK!jHsKqWs&G(xLzkOm@bJ-?PQNm~nfR|C;jmDcfHu|9_MpLPYB!p8%gz9{-`P|5N#n zifd3M=*AeSf0^=ED1Rw@y4A|RMfqzLf06RnD1W{3S1SKzy>}G@~=?-D&;SSPj{#CJJj`Sl;5JR zZ&u;!l;5WOTNVE%<=>#LU#tA9)%ELD_#WlAs_XYF|3T$Hr1%dj{}JVXPx)Jv|0sOA zt;&B)UGIkbO1D$p?%Fj@GeyPgK3+npg%HN}||3HPi zD|tQ0@mE!GeV7sNj4c>l==_(u@Fjdk;46m1j`J6F{cUx9XB@8MQM+FmxDh^wUvFR- zXAc}v*Kbz-TH#N2?uAdiKUdc`D1W{3Z&&_d<-e``ca;A#<-aTZ4Cg)iuy>OR|AIc^ zd#eaL&Ucl+89wcD^oEY3Idq>Z{|+U0r}8%{|1Rad$PHU3af2I6~l>CF#hyRZ#|6%%YQ`HUYRN-rse>Hs8xL>FnyG~vIZxxpB z=WNV)^WJPh>}XhUW$m(B@vh9qnH?6dv9qOF@bWO8R`}!?T})uapIK&FJwnN2JXi z2A}O!YN@V`ENSTUWS;fOq&T^r&y&Oh8|UqPq-*Q>G&~FaiARz!1!!SqZz} zCLMbAzMj>t)1zmp>(vH&)dgp~P%mfN(6{5O)61DTy(&hp-qEXe^lA;gDo3w=;LIQDKktg0TANwI6W704m4tdD; zhR(-HZa%J1xNj;CI=^)O=~V%CdUgKj^mUbwcDi*w+3DB$s_)OY%@2Ja_5FQ9rBmN8 zegC$r>w49WzdZ8vA)Sw`4cb5<{vn<#?BNW49_qq)N3RO`rhJt5hbJRxz0cuWX(`@+ z{2DCpPex!e_;GicKk zZ~K0JQ#sb6k)m6Ue{Qp<;N0(du{?X-DuS)Vi?>v2t z`Pd)j>^(e><3Svvkmc-zGZp+}PCxw9t6;zBdDr=&>&>~yf4(PlKI(ka>D1-Seje>| z)m47|tNG;52cBf7^I<=pHO@<6M_A^=mrgnOSQUkTk#AX^{SoU6ZOzUX>Kmk+xf*yTj$qb^6^R8H*td0xd! zw?pnw;cuI7-&7yHs`Tmdgv^QRvYb-!WJP5<8=O6YaSU%k{*fDCjpjIO#4rCc-L}9H zoUKUP?vEsg%srNoh4{Yty%-A4~r_J*8V-x4iBZ-8*}1>ajZWq0CJ^ zclXrutNzpaF4OpDZ&ucSI{YqU&aKj@lNRdmu|4jdnkP>~={+?+$JrYNYK(wibHeN8 zH=ypATlKk40DN!1-cuH$^WC?E9U@No5ZcCHEkw@NAG?UZMn(M1LQFOgfAb;qSE(w;e7=7v1j7;P{U@7z8vWFUo0Y5V^*ct4!f6JQDZh`1^!@5TNS6d)< z%T}*H?y4r#Em2)F>lTD=seMz8XupA?w>)?bF5fJ#Vx{u{^xik3{>etKK<3~0Kpgma z0iGJ!_Aln&G~n3su;brVx^+uL=eJI$&IjFc`KC8gS1ngNU+nwxwo0dNIqP-d`pu=+ zo$K}C`abFVDO<)oqnPv&v%d@M&C%G`Jy#|biDI`3hXR9~n0TgJoACmkPcx2ycp`KKWMe+c%A@-HCMa z`L%mcIv?!k=bL&~x_s*UVCT2a=YKWd^ga#xIoA6$==~Y=z6`oP($BBnpF!`-pj(pi zKJX0o|F5{S0n(~E@A$n)bz=Zm3%UZz3hS~g2+Q{?psswm3qlB?W~0QeXbqv(Zlg&k zwG)z>l-Pw*ODRQTs70h!VWm`=4%JP@QsPL5v3^jeb#^jLN;6J|nOeJJN!tJ6JinW} z&-muOylT75%QN>q_r3R=-}yh!`MCF<8|q=4>ft+j%W#{txLC0=)2@kk=o^YgHg$F!~a%BA! zW{jR1pub;6e_8=;oGxPxk?)?$^>c=w<=U!#&KLB%uufW~IO=D1X-Ci#?K2$FBYw|J zHs!~kpE14RuW*M)IiAD`;>Yt=e&Rw;D3^M9=n>BFEjPn|DEv0JzYz7>mR_p#dFl9Md~&yr6V{`v#MS#X^$9=vlUsDW;Fpzj>p4 zPjm|BavZ%MM4eu4{KkvStBR*#mi60N`*T|B%J(NHH3lA?+-3Qyq*L+>2ROnF9-b@Z zquf5f+wJ@xRezHDqMjm;Q8^xC6bD0l{0AA2{$#Y$<4o(F1$j_TIN*2i;QXE&oGNjl z93K@II1lu*D~wB%bTWU4Zf_BrV_7>HV&vbQ1L4I&RSMVWzkq=)EUvB)A z^1-1J-*b&O=oGz2f4j=KOpva2Yy5CjW4JG6SIMAl;r|2u_iE$WES=8PQjdGppZlJ!?8g3FP1>mRI8OU~L7vnb{)^wz zuOQ!)3qQrr@&8JGy4mvM{r(C2o_;awg3>>xp8`kkzx(a?^nau7#v7-J;a#9wR(iY=dRvv;KdirdesIGN z@jtIqIN_IYLf1uk!FixxPc&|mq}P(J-R%uyhiqO!ZI9ApfA7|U+|UnxjlbgGcC_Tpgj)ENUXUdN*Xb5gi z@Pjv;;Yhju&d!H^D)n1Dcl;A>@PP|{OubMa19dhx$0uC(*{C*Wr9QD8K9tN;`qO$6 zdPK6aARlxC7tiZlIr(yp0HX02K+kaTe&^$j_dDW`=SMsu&iVO}7mXirey?puev5Ma zHi%tV4RB@VH>Gs3(&IelGW%U6e%@~?=@0#&C(jLD)PvV0y5V|WrFn|YRu0eCb3_Ne zUc4UZr}6%a$n_@U`cqv;ZP#O{FG-WlnJ!CdTgLTfMC zBi?t!dyaU&5&d=EZ^V0zc%KpPG2;D2ytgQF{IqeLEspm|lLys5{P}!llCD&G9AAZ% zp9Af4jdP4ksc-!BT=nVwmwpJks1!%hSEaZI@5tvfIX+u-ztSP~q5n(szOg;f^FEo* z7FVe=bmjGQu6(@ze%$j)_%m@5KmOqPq+c8(nS_VlFw@6yf5F!9mnu9 zI1&E`j$=P>+`=0!_Yc)|KWXy$EPl17w<~={+L$yZtyOYEkJLB)H1tQm!}Fp3(Jg)j zf8sNGrM%uB(KmX=AH0rsTKP7cE!wW)AM_959Ci7t#&@pxCiU`nU30!8o2RNxJC!~- ztyfZbBSWZ#bM1#vF3$tLjBhCSlU6=B!k2ns{N*`P&T^dKT&W-OteyV}vs`b8yza>H zY8$P!pEXAPcg?TF_}G@NQF^?O`g;5Q>$1OSUdoRr&?DEy!kUC(9Om0ecvb87Ue8>w zVjO^;(IN8##BF$%<4*l}oo+WSj4!?<3b=Gp^T(>*{g3A4+|~ zCpGqn`dyLUt@L<3cV3lT(JeZrJ@uR`wJ)AOoU(YT`~|-tE_i;GxR>KgTu1ltL>K4) z?$iV0EyjhB_ZM=!XG+82T`XVC+OPU_tzh?cWBweTUI8L5ZkRSPl7xP>Ac~Ne@ zeV`pfA3n}`Zj`quFWSX{e11L0XN0)y)_7#EKGC0R)9}{G!Drj=YYXz>IviZkvyXS4 z7wx3y>-`dL&s%;d7u*ip_vQF_jz#qq_4FIY>qhD6ZQU>XisqSD=lVP0O`MTesY+hu zIKk1^w=WO6gcDrh1s~c8c%xf*!>=eG`c(t<^_w|fC**tE)IS`R`Cn%m-cGtIZPxO% zvkUSn*Wans{|@Udhxu;C$3E^+e)z)yPJe6pgD3NS#Ct!EBYye%IcCQ}ue1|B{=uF4 zDH{Kne~fzlE#p65dVN#eRRy`{e@<(?MxKY7Rgk~;Z+Ov;;@9{kdZfH?_FO2Z=Z+4& z?%`93%RoKem*eqo>U)QGp@mhJV!Ufg!&`6T{PWC$JiH#u&6~ghKIjh~o}=gB^;hmX zIPGl4)1GIpmLL2Fa{RJ!Tp(Rta<)$;N@wp)JbXL-LxAC>ggYsW!HFWNS|pSA56w|+av^Q2;yhRSE}C5nE! zBMEPkj`!_Mv)`TTIN7iF|05g6bn3nFoPTn` z^HX2t&P)E{`F}5W{!v!`hFtj{%+7yJ!SkaF&JS;Rz#*Rho4NDfYUgjt&fk=LOX*P; zlkEH-tc%~z9cQBWg)%J7+OMu;lhWh;brTDg!}~Mkp?s8!c=VzjHnK* z&$4IV1gy`&q@-*tZP1$`Hss;T)z>xG>c?)c=PPbNd_hqeyu9Jb=3u8Y>z zZmQjT@zINWFX_9aZg^?<+7X*ZY`wJS(we%ay4K4(FYg$+eq`sUjia`X?iqdjiqluL zj_Dk;v3^(m(W_2fb!u$QxZZJn<5o0uHPl?)bah+f+Qv=e_m1ytN+y(=JDS%|+%a+M zq@GEA*CdmhrnF6IYgyZ}b!yMlzG=zy-syeQ>t>c_u9(#|t7rD{*?pzt+O|1s=j@u> zJGb__mg`nr-*tW04O?&6)!N&7{KnHau2|5upmX8Ig?kqrU36&iiN!T-O>MnxeQh=E zP3;}+>)TJX_qTT}S-<4OlKv(2OIw%rEIq!o^v%H`uE~>=nll#+mPwMZTH8Ap)ukJ1 z1|?e$|5EZV7ow_36=^+@R$eKj~S{f4o!o0Z2Q0?$!O)+NW8| zAU`Kf_jTzva@HZ;iB`l*lKHZ8WFN5Y1F}c7y?%52{($TfZJ&`1`%l}VwR=LkZ212B zvTI};{xGKBDjSZs&9+}Qn{18W&yl@8{9ZO3Z=dXZ+0&NZ{6}%WyJSQ9PT8>k3E6PI zu@A@dJt(_e+ppU8j6aU|`hH6`ld|FW zjoXvtZrN_x@cTDpL-}g808hx@VzUpJJz(~f*(-O%{Z`2aZaZ!JxNOMBus@6G3(anj z4dps&+dq>H=PT`u``s%Ww)dL-q1n-TQ2a~!ev53#*Gp#KH{0@P{M|a)kiJVc^-u9?>^f; zY1@r|9`{=<8}hN;wqG$j=<%3dGJCJt-DcmC4f(74i@4u%*>Idqw*7)__uKa5-7$Tw zY{>s(W?!@KhdmL$UubrN*&ee$GCO)t+;64XO=e#(`>t%L*ZH~uESzV(*?neDnjN_} zrmv6<<=A4|FPVMczAyb{-0xnqyJbT;-?r`HPsQ{lW;dFB&g?s~VgJUzini12PP4C> z9rkogZ!`N1vxm*TXSU^;xZgUnyUo6Bwr*ccUum}6>=Coc{+K?;?EPlp# zhiu6I!)9MGd;YWW`&P3X%pNrR6SGYR;(lw)K5F(2v$cO6)0dci(CiCl`^`=}827u! z>>jgyW=H-_OkZVoi`k=Q2R#?l=b8PA*&ee$mYp|L_4HEQuhZ;Kv#*&Q_V+Qp&FnYK z9ya@)*_I=5zjbDJn|<4C-9NOKnd(FNl8|t;?&G`M@vSE9d*|+Tb+7mH-vDpXA9x!{#?3Mo<_giK5 zA+x<^-!nVut+?MBvpZxPYm(%JAI9(Bm0fdrlH778Zg-ni*3SNYU)$5zkbT#-8-F_R S`wrWFNOs?{+z*oa\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=\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=\NOTEPAD.EXE %1 +Reg20Vals=1 +Reg21Path=HKEY_CLASSES_ROOT\PSPP.Listing\DefaultIcon +Reg21PathUninstall=1 +Reg21Val1Type=0 +Reg21Val1Name=(Default) +Reg21Val1Data=\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=\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=\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=\NOTEPAD.EXE %1 +Reg15Path=HKEY_CLASSES_ROOT\PSPP.Listing\DefaultIcon +Reg15PathUninstall=1 +Reg15ValName=(Default) +Reg15ValType=0 +Reg15ValData=\PSPP.ICO +Regs=15 + +[Groups] +Groups=6 +Group1Size=421589 +Group1Files=6 +Group1Name=Program Files +Group1Dir= +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=\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=\TESTS +Group4Size=63652 +Group4Files=7 +Group4Name=Help Files - ASCII +Group4Dir=\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=\HELP\MANUAL +Group6Size=229376 +Group6Files=1 +Group6Auto=108 +Group6ID=38308 +Group6Name=System Files +Group6Dir= +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=\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 diff --git a/sysdeps/borlandc5.0/setup1.bmp b/sysdeps/borlandc5.0/setup1.bmp new file mode 100755 index 0000000000000000000000000000000000000000..620981e014c3880b5dad04fe8167f0949c98b81b GIT binary patch literal 36082 zcmeHQz0Tyga@7S4bZ7k(2K*EbZs5%CqQI~^lQJn&cAsY-Nq_?>YoAlaB8xv#chAg@ zFW}|wv?#JzJgh1fe?;l~`+xq|e{>T58^8aCfB*WouKOQc|JMDBr2jke|A83)Wnr2+ z{?~P{4pCnCKjKsO#~**-=7oEv;8!nt$Mk=?u>FPUBb|IMr{g1jzk=ur(|S?C!aOAa z*!6XU8!3YH*n*r%x{Cynj}+xkiD{Szl-uVg@)$e#^IDJBa32ww2PBb1@<2$k;WaD+ z3LHI2a4%(!+ko3?*cX;U{@y?5*Q;Om`)eMLCkpH!MBbBxE|i#dwR!$dH~eJd=SgNf;;}9GIzA2MJM{`-sK@4O&7>cahU! z^&=@_0(}Tf9f@hU0r)ob=vET??&;(Ni9=T1D#}8PCVLxtB&(c8N>XYJx)V786ATTy z6FEVHsyoycg2w~~8jfxrdRDP65cquuJfSzC=2UtRv$gLYU@V>v60sN;YJ(xC_+(r~f8FXHhm>M^H=&^J7<*S;BXowibj7Q zmVZJ{>xP;%P!8|`r-Av$>a#on36pSrepMU68D%$ZM9T{NSGez@);(h zqL*M;o4LqvnAkE62W)(?qLzqj|5{)OfkyhZ%PgW8;hr$DI?%8!NbPnLuT4yFs0gX3 zQ6Js#9PMTX@0!GN;nonE`Sh?MOcu$m4pY)yMsa#`rMc5W$aq^$yl3clk1I~UG4Chj z^b1fXEqZ4E@8$H?l2lqwPT$(N7x$;}wz7)Szt^7jXHk9g_IJwZ=(|n_^Cpy-_#5Rk zchA>j)>%)izZLmSa$1kM<7kNq$;{csW%x~Uk_jqYINdVVf|rnFRu$F=e_p>kdQ6!m z5EG`1Y5u0k`S0(L6Q<0eQjrtl{iXhXgFWq-a$68N;RZA0AUVr%*FPVVhZJY2msa&> zW5V*wNx)%(0?$m{VKQZV9zPpDupsnGGTjN^Xl6w%4%45|?~bmRYG#&`q| zP4y!wGT4>{t11p`W|YBWs&h-~FYe=Tl9j121*v32PIuUe_ys}dx6?^KZ>TdZb**+; zl>Rb%TIP9KV6_u>gj=DpkmWv49=z^;R!*2kN_ZS$S1+%Mca03$8ObPRlSAe7v%X*p z!Z~{FIaxj7Mnq6#WP=a$oSe87_%lIFQy5@t>?9sWEB#Nd!X3gdsa;++1_>7DP9=OLWSuIIaQ{RP@#_fuJ%NCb8lhl@x)C1 zR{?9w5aQ;?*x z_WOMTcdOub%+m|(dp@)))v;l|DO&~F@3?W0DyuQEm6tX?K;So;ftt^g7$P6J!;iD4mhQSR59Eqy@A%BmrfR!As3WJj3$5;z zV^MWl2xs+&-Ha@a+@y5ST`eb>m~oE=&!F}&#HzxOz~W_qku#l-4kakqsHVcu=*qs8 z6K8o4@qi~tafuHvBQkGeLKT8ZH3g+o>2B6m$Yh}@6lrgC2gOQLfNP9RU-4ibhTtj^ ziNqhlgddhw>+54)At$uB#{>72tub#;rS3R+=}L z)&Cm0(s6ius%#vhu~o$sum#=_)R~;bK&f=}HHrZ}?m|xBSI>Q~dzw2mCS6tg*2Rb*W&c=Ky1h!CHody|F*wD7A=;0&O{=2L-WWtgnJ^F)<-5 zi(ci)yrPqYS(EwOYF&+qW!so=ASYB-^;VQ|jSplK^d(4eRwA8S0ja~Z-)9FFc?dP8 z5vgrV`_nMF`pJaB_ZD?kcrc5>|3If?OL#oXLc&DYJU8K;ot*44Qn_B()5c+5g6qsy z_y~I9y*?fnhsBu#b9ksE1`{*(HWy6kK$Gp>eIuu&yQ);IP9mHBj#+9jMW$&!ov7)J zbFzrbQ7VTEIbk+pa>{C}ZUQE&Q1flZggfRRaH1owoa|t&FhI{TJ|n5dM8Xq$dIUqM zOQDPliiyMy7AJa2gEK!e!&+Zh_|c$J5CwdP3G)tGW4-g?03jN5Q}V_k85~u_@Qo9N zoFC&K9O)uu5119^Kw^AoOCDs{YRd_l3)PghFIMqpwGAR)TR5Vbm(k;qlJA7NUCA zOG)s1g-OqsvP>jzMr`N{b1|G3J09!pFi!$EDLE*6f=N#oMcy7$H07Y*2{URTv`S;C zJYrg4jneV^eLSY!O=^vS$K)Go`O4Q}N?kr+LY~fjg(%12?;=N7jo9=Al$cAT>5QTF zj6T9-JwGlC(5f(%HRJF|Qaob9saXp4m;ermNh)SLXP6Qtxe8V3pD+OuQ9+r~8tYLB zMi$$GKf<~JruP?o39(_t5{p@6bH#$ol9U5;subFoaBPp%YTmvZ$*Fsy)xUF`ww#TVc1}z z9qG1i<}bVxw(GVeU6YetS=z^QfG76!dOU7y?ts0?F~gK9B4Y_Kof&T}AihDo5+*#t zo8`q5xwZQ3%0wT}Z$!SO&xBx?v6tGr*8-));S}(!-%DluIUayA%ghdMi;a?gf8B@u ziEhh)xwuB+mA77xSw?10(IjaXk4Y9s07iy^J9()cGZw-QOgqlB5 z6YkMTU?hj1EiIRJV7}n+|yD)>t2AZyGOSoOIr}zTh9+C(Iz%4 z6p7fsVzL_G?DeSRCBMk!R{gqpfL!hzw5+wlDu*vCuYvaOlDYj(fky4{oaH#sp~ zgW90PWdUgEytZ_w^Jp6y@J2*Lcui6y`e$ zw(v^)vZm!Wo-l0#Ca)NPU#x`+3X7z~Mq`j*3O%)i-U@Qe6Q=n_(t{u|zqyl$^q?C_uVeX#vbTDcoV|$51$4Ov9ESvZ*maY1pY9P+Vu& zP2X5_JJrB}8bXiYyYd=h|HO;t(t9jJuBmTnvRH&+8WSmoa=c8t4uj4o+L&apjAgdK z5f7zeT8NnHckDcudFqaQsx+>F2|KrVl@-q*RDrf}>x(A0qp2ct>|*MJDNngQ6y@Gw zyyYWeWvV2V167kZOuh~Brgb!k+Azt`86fXQrtQnE=tk%vvd{`7ilku%PwHbRmkGj+&lX&IZ^ zm|F0ZRQBkKh3vEd;}%46hN%{#kSOL!;EYhMVWDg^Ibv|f3*Laoazxf5(=isOp^*Zx#@S=88&ydhaV#8DphQcWPG>mcg`DEjk$3Cl&F~$e_ zrMQ&$q>StIBx14#m1MZT(5q2nPkpqwzsl^Xkg?A%;yI?=k>{i*vtLKFKewhA3$yW$ zK`9fH(}g2Pk8;(YM6qAj3Onrji=b9wm^kx33vskMBS3oJ#R%2*E#B|be0y(C^*S#VNxE|Q1e1c<{WW6D;%SlM(*r{U9f6PrR1dUDf)2?>t6aLHKcTn z$!*!-J6{|hqkU!ECXNh z(aBbOvB3fsRNo#G8gvmRojoi22A#tst6Sac!&8z8pZ<|PecegOvcmK{txgf>>(8NB z4ho&_kR1a{mcuR_0rA;3v;M1*Ldy+7D$&M)@>DNUWM?}YjE`l8^BJBvK(iPoY4Pxc zbz|RvHNo@Xj2@PESHTvg4%3w<7gkt=;wxQcfaSpLV8dHhZ=qH$U}SmUkAey2Jz~jJ zN9lVD6Fyz#gcsc+B4`5xa-s5rFIG50$;y5rlo%16XEgNv@)+esR1@ zfrb>18KkLSA_%c05s%5nn~K~e)Vn#FiO(%MDlZOV!p4irQEnWei>AhAn6kHP9J!B1 zOZ17rlUO3di$h?T5bUXfFC5}&7|Aff|GW)eNuD?ppjZK!0W9If=Lgx;&lmR=nPGbG z$-zFnPM0y{jn`Kc6xMgd)Q>jT%&0sMS9gX;Z<1l6*Yu|9%f$FS_~)2F)kttDVGN?r!7O+YNr@ZTJduwlb8_=c67-)K z)T5%}gB1XKq&il>U?8RuS5AM$*`IbiH+#$FkmUywNq4;jJLXi1DTe;GjVYTa z6_`FTD7Yvb*oivuEyRPnQdDfE^(m43hzzN29kS~fPGvBP_lO)?x8!>cS2HQhoR zlSxvTl$bCId=i3}q^m43VfixS4ARKQ`2Yc#LOL2a0ymvOW=@6A487KPTwNg{1iS;` zF~!=cwgVf~IR{!zYZR7GWhc^7P9G{SF^F~W03A#y1-#!TrsYyjFok__Bdjp>8DAs2 zxCS|?Hlv4!#Og<9@@8J3&p2l0ROzlx$O<=Zf(1*D#beBfiW_@C=7Y@WqQ$42qPJIa zimUciUZykC0hms-9r9 zFcsaPS&>WB>18&uyIe-YVOI4FKqH7(S{l#Q!7^VXfZrn2MZl$gN`I{FoKQhtVi$m9epY7nJIRoG5Ni2z*w4*?o*vFmFQBK6vQ|u%XC?>U_djr0W$Xh)D=fM4Xr)7BF%brQ z1HLDf!jz(A4Cj#<@Q1P#T$zviOH6@&!+RJium%H5@?Tgoi?=*?#YZ9Ku3w4=p^oMP zQ+!-7b$B4}#o)@PsO#BgTq)CH0HPgd8ZD{5USP7(NdC^k6%Xa==HqVCQq&0Glk5du z9UHvBB);}FVha$fjR`~e8&L(%0Tid6V1nZG{B(0N7aDMZNe6Zed9=#-xzVEG{?@dY znU*KOaPmYirbS)!f-4&jmMWezxXn}7D>YkBI;#&IrAKFzBM?_IzmSu-C7_^noLh*O z1D?>W`15iPpO)g2;6Vqzs*~hb`8Kwrj%x2CRpnz7zLDC^Z5d25pu;wy!O<70;#Zgi ziKr`%cw@W1$o4pO&cTj2!Tc#q@CNz@YjD!Cvj&~H~fk>~oAVFHi+%8C-l4=@=k z@d%SnU9*{P;^t$}_{e*F-C2^)MrO&(em=pZ1^A{dq^}|~OglaflJV0Urit6;t$Nyc zK3XZRe!sxPhT3}CbccDL&6-jzcoiG=7mu~zd-lvbpAe^#8v7iR92K&)j41;0(m5|4 zJxR?3J3Y8@jFp8}VMlz-2^MwV)oWQnaCeazd7Q^@oXIH=_4rp11`G5!g+-TH+>YcbE$KE|ZeM>Fv>M0+{31%ejAr43^`bqc>lN{QE z3Ljw2Sv8lXRxgr(0?_2o?*KgC3swlw@Tjqme!s*N>Yy6n7G=wj7X*$r=y9AoU>VPe zWSEvBZ~h7rnkF2-`N4OLNq)dz;zJE^+7cijdP%Af%bf`l!XLBOtPfYLftccs(T^jT zWf`@UbyvzsPk+3B uXR|EVxc^nU^ literal 0 HcmV?d00001 diff --git a/sysdeps/borlandc5.0/sm-gnu-hd.bmp b/sysdeps/borlandc5.0/sm-gnu-hd.bmp new file mode 100755 index 0000000000000000000000000000000000000000..6aaa8afc96f286353a947874806301d7896cb112 GIT binary patch literal 8414 zcmd6sJF?`i6~=Lut5DWnh8N%!IQK>z5gF>ANRA*Q^Ll1UHxrrsJBNo*xB5=cI59J~ zTMzj7&XWWE_kaBJFGkzH`1~t>|K{%x{{CeC%%?Gb!Oc1aLP=|~~wbnm9$VDu?-E;4#c z>%AnO_=iLann*t0*;UN+Go8{UXD^)gAW(PhJw|RZnoF!=5ini8E7DtxvT8>Rn)W&* zrSiBAZg+1nx;G`!sJ4=G_$7=Iswg=VYz+ga{}qh9*MWEkj{bWXM;#}g9-4ECoBonM zWB{!&J_rzvP-%MB+v($tPP_7urRxBZwu(Fr*UNj1Mnj3z>lCBUzvLf%Ze_2N$7t+w zn}Oc>dKcyBcFntW*8ECN9-^eZX#nLWRx_hXaG-cLp1ckTU< z<{ONuPG~{jXtgx?9Y&p=rHQ1|`dwx&{%P60;n6UrWvxeEMQo{d(73a0oqTrm9zQZH zms2+l=7vXgk5i$?v5Yy3PdyIDv-dnE{?p~*y&DGaC^tN+i%mRcpD)pUB8%!{mU^uk zs?(PEl7((~=!iJY)+>MtRs5-*3VVa0I;HCAjeAu=Uo*2i-)WyK20=x!A}>x1F|w*C zb!xMm()WsyqPG<1JfCeL{b*;L^aN9%KVjs<#jLApH%tE}Y){8HA1cZd4`^FeXYW?s zmBqp>XC~+`Z+RdA8_fHi=kc}9Ud@;2sOyMThXYn!op9=y2^5B zOtPZEWp44Iccr=4_ZY{jozv`MJPC`sNO$v7yW0DSN7utsbOtL5-4+>wGPDD795d)0IC{`9{J@`eW<#l)zuHgTDjlrY-WX0JR(1{a4GhpjF8==7>s`4Tdx zK+il*S&{q1VB1i^b}?8qYn;^nf-&rd7AK5~fNLP5^OEzwRKxQ86{Gh)sMN>xxCrU+ z^|7zQ-C+zp9{aQI=w8;f6J48h-}2CdhC!fSl(eqx>LmFj3kjt4q35ajI*iXaGQi3A zNgs(sc4C|^J?2cO?Fa4^BT5Dz{ngEC&++W61tyZSEW2kfJV~I5^~hfGNo_m9SKFD8 zE;?oF6nq|KEk=;(A)k9`dc<)M^9Cc5z1a7inL}q^4kr?7D>i9j=DsbMXRhY?Mnfx$)zklIKrG$tU4sAyUER3bELfBlJ>Wy#Hy6;$%EV#LL55#<9SiE3b^eY1YCE2n~{yP!*bmw@|nCS=#ThIyuQ&hnwD zqG7}wJx93Sg&gsSwN4y^Q@J#T@Ky+lPWJ`E&H%HZ#leH2esOl$aK8wVPTuJOt!zR# z2VwD3SC5QF9qdyP28A>poW!9~E33#JnW3kNsIekvWG)Cfp;0`Wp(rY~vMXYhz?J14 zrHip%O&BRaTvv%cp@ZLoc+1M4LlkC9iwTS7&W>@&!9p#Fi95*3jM8Kzl@uY%w}=u$ zSOhO@1dS<$PrNgy)+6g7YKvERjG0raqFIggQL8*<$il6$}PZ?6y zjhhMKh+gJ|VagcNA-S`UI#t+3tLSQA;4(|mnW3(oD~@A>c$^5FO^`B1Gd7<<~Bl{w`Z%0v8=C4btgc|7xkFy>1$98ZGS zx;C|S92hGGMY{1CB4`BjGfL7U!LEq*F)ba0C#78+Jn#u`ruWCf;;Z%rghbIeExAV{ zRL~%1IWbDXpC8cajYSe$@T(937RX&sRCgabi8%jN=_!P)ljWHSWPJ= zVz5CrB!pAsz;9wfE=rpxWT#+GpSN`O!v3OOaePe<5>8tbLgf^q0nuPjf zOeD&0mbkv7Puvm3pR$lBF}0lvDFveTm}83Qi^outKwXoM)%sGD(cI;qB>;H_o#m3J2mK=61X zG+O)6T4Nr5UgJknjrDYL#Q;QpNkj9>;vDsK#qSra{X$gQ6UGr2KzQC4Rqgcp!I28O eZPE0MAxi{$y>+h{3V$3y@q#gT{P6n!3FE(htO2qB literal 0 HcmV?d00001 diff --git a/sysdeps/borlandc5.0/unix2dos.pl b/sysdeps/borlandc5.0/unix2dos.pl new file mode 100644 index 00000000..95ee10d9 --- /dev/null +++ b/sysdeps/borlandc5.0/unix2dos.pl @@ -0,0 +1,19 @@ +#!/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; + $_ .= " +"; + } +} +continue { + print; # this prints to original filename +} +select(STDOUT); diff --git a/sysdeps/borlandc5.0/version.c b/sysdeps/borlandc5.0/version.c new file mode 100644 index 00000000..e7284769 --- /dev/null +++ b/sysdeps/borlandc5.0/version.c @@ -0,0 +1,7 @@ +#include +char bare_version[] = VERSION; +char version[] = GNU_PACKAGE " " VERSION; +char stat_version[] = GNU_PACKAGE " " VERSION + " (Fri Jul 11 12:33:09 GMT-5:00 1997)."; +char host_system[] = "i586-borlandc5.0"; +char build_system[] = "i586-borlandc5.0"; diff --git a/sysdeps/windows/README b/sysdeps/windows/README new file mode 100644 index 00000000..63258b4e --- /dev/null +++ b/sysdeps/windows/README @@ -0,0 +1,10 @@ +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 + diff --git a/sysdeps/windows/con32s.c b/sysdeps/windows/con32s.c new file mode 100644 index 00000000..f184f870 --- /dev/null +++ b/sysdeps/windows/con32s.c @@ -0,0 +1,504 @@ +/* con32s - emulates Windows console. + Copyright (C) 1997, 1998 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include +#include +#include +#include +#include + +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; +} diff --git a/tests/ChangeLog b/tests/ChangeLog new file mode 100644 index 00000000..5ae181d9 --- /dev/null +++ b/tests/ChangeLog @@ -0,0 +1,351 @@ +Fri Jan 7 20:30:23 2000 Ben Pfaff + + * 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 + + * 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 + + * 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 + + * 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 + + * Makefile.am: (EXTRA_DIST) Add `syntax'. + (dist-hook) New target. + +Wed Aug 5 00:04:16 1998 Ben Pfaff + + * TEST-RESULTS: Removed. + + * show-check-msg: Removed. + + * expect/: New. + + * syntax: New. Thanks to James R. Van Zandt + 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 + + * Makefile.am: (EXTRA_DIST) Add flip.stat. + +Sun Jul 5 00:50:41 1998 Ben Pfaff + + * crosstabs.stat: Change to test /MISSING=REPORT. + +Tue Jun 2 23:42:23 1998 Ben Pfaff + + * flip.stat: New file. + + * weighting.stat: Update. + +Mon May 25 12:45:46 1998 Ben Pfaff + + * 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 + + * crosstabs.stat: Minor changes. + +Thu May 7 23:16:03 1998 Ben Pfaff + + * crosstabs.stat: Replace with a test that is hopefully better. + +Tue Apr 14 01:00:46 1998 Ben Pfaff + + * crosstabs.stat: New. + +Mon Mar 9 15:40:25 1998 Ben Pfaff + + * match-files.stat: More thorough. + +Mon Mar 9 01:14:14 1998 Ben Pfaff + + * match-files.stat: More thorough. + +1998-03-05 Ben Pfaff + + * Makefile.am: Use ./gengarbage instead of gengarbage. + +1998-02-23 Ben Pfaff + + * Many tests: Remove final finish command. + +1998-02-16 Ben Pfaff + + * (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 + + * Makefile.am: (EXTRA_DIST) Add TEST-RESULTS. + +Tue Jan 13 01:11:36 1998 Ben Pfaff + + * aggregate.stat: Some more testing. + +Sat Jan 10 23:57:14 1998 Ben Pfaff + + * Makefile.am: (DISTCLEANFILES) Add aggregate.save. + + * aggregate.stat: Slightly more thorough. + +Sat Jan 10 02:17:00 1998 Ben Pfaff + + * Makefile.am: (EXTRA_DIST) Add means.stat, t-test.stat. + + * means.stat: New file. + +Thu Jan 8 22:38:59 1998 Ben Pfaff + + * Many tests: Removed extra newlines from REMARKs. + +Mon Jan 5 11:18:44 1998 Ben Pfaff + + * sysfile-info.stat: Test most of the DISPLAY commands. Update + title. + + * vector.stat: Display vectors. + +Sun Jan 4 18:31:36 1998 Ben Pfaff + + * All tests: Added title. + + * begin-data.stat: Updated REMARK format. + + * descript.stat: Comment fix. + +Sun Dec 21 16:57:31 1997 Ben Pfaff + + * TEST-RESULTS: New file. + +Fri Dec 5 22:02:20 1997 Ben Pfaff + + * Makefile.am: (DISTCLEANFILES) Add fiasco.html. + +Tue Dec 2 14:55:22 1997 Ben Pfaff + + * t-test.stat: New file. + +Fri Nov 14 00:17:25 1997 Ben Pfaff + + * aggregate.stat: Changed. + +Tue Oct 28 16:26:25 1997 Ben Pfaff + + * aggregate.stat: New file. + + * Makefile.am: (EXTRA_DIST) Add aggregate.stat. + +Sun Oct 5 16:02:02 1997 Ben Pfaff + + * fall92.stat, fall92.data: Removed (unknown copyright). + + * gengarbage.c: Define EXIT_SUCCESS if not defined by headers. + From Alexandre Oliva . + +Sat Oct 4 16:35:59 1997 Ben Pfaff + + * repeating.stat: New file. + + * Makefile.am: (EXTRA_DIST) Add repeating.stat. + +Thu Sep 18 21:40:50 1997 Ben Pfaff + + * Makefile.am: (EXTRA_DIST) Add lag.stat. + +Mon Aug 18 18:31:42 1997 Ben Pfaff + + * do-repeat.stat: Even more useful. + + * lag.stat: New file. + +Sun Aug 17 22:47:53 1997 Ben Pfaff + + * do-repeat.stat: Made actually useful, not stupid. + +Sun Aug 3 11:46:00 1997 Ben Pfaff + + * In several files, replace usage of deprecated term `script' by + `syntax file'. + +Thu Jul 17 02:12:17 1997 Ben Pfaff + + * 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 + + * gengarbage.c: Reformat. #include's . Uses ANSI C + rand() in place of random(). Calls the randomizer srand(). + +Thu Jul 10 22:16:34 1997 Ben Pfaff + + * tabs.stat: New file. + +Wed Jun 25 22:54:40 1997 Ben Pfaff + + * Makefile.am: (EXTRA_DIST) Removed bug.stat, file-type.stat. + +Sun Jun 8 01:24:55 1997 Ben Pfaff + + * 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 + + * Many files: Comment fixes, removed `set output raw.' commands. + + * Other miscellaneous changes. + +Tue Jun 3 23:44:46 1997 Ben Pfaff + + * list.stat: Re-enabled some of it. + +Wed Apr 23 21:33:48 1997 Ben Pfaff + + * sysfile-info.stat: A little more generalized now. + +Fri Apr 18 15:42:22 1997 Ben Pfaff + + * Makefile.am: Maintainer-clean Makefile.in. + +Thu Mar 27 01:11:29 1997 Ben Pfaff + + * gengarbage.pl: Removed. + +Sat Feb 15 21:26:53 1997 Ben Pfaff + + * descript.stat: Syntax fixes. + + * process-if.stat: New test for PROCESS IF. + +Sun Jan 19 14:22:11 1997 Ben Pfaff + + * autorecode.stat, modify-vars.stat: More thorough. + + * data-formats.stat, file-label.stat: New tests. + +Thu Jan 16 13:08:57 1997 Ben Pfaff + + * bug.stat: Comment fix. + +Wed Jan 1 22:08:10 1997 Ben Pfaff + + * filter.stat: New file; tests FILTER behavior. + +Wed Jan 1 17:00:59 1997 Ben Pfaff + + * gengarbage.pl: New perl program equivalent to gengarbage.c. + +Sun Dec 29 21:36:48 1996 Ben Pfaff + + * gengarbage.c: Changed. + + * sort.stat: Changed. + +Sun Dec 22 23:10:39 1996 Ben Pfaff + + * sort.stat: New file. + +Fri Dec 13 21:30:53 1996 Ben Pfaff + + * autorecode.stat: New file. + + * fall92.stat: Mods for practicality. + + * test.bat, testall.bat: Removed. + +Thu Nov 28 23:14:07 1996 Ben Pfaff + + * list.stat, weighting.stat: Changed SET COMPATIBILITY subcommand + to SET EMULATION in anticipation of change. + +Sat Oct 26 23:06:06 1996 Ben Pfaff + + * recode.stat: Removed comment about bug, since I fixed that. + +Thu Oct 24 20:13:42 1996 Ben Pfaff + + * print.stat: Slightly more thorough. + +Thu Oct 24 17:47:14 1996 Ben Pfaff + + * time-date.stat: Slightly more thorough. + +Wed Oct 23 21:53:43 1996 Ben Pfaff + + * time-date.stat: New file. + +Thu Sep 26 22:20:26 1996 Ben Pfaff + + * 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 + + * weighting.stat: Tests for proper ligatures. Won't work until + encodings are correct, of course... + +---------------------------------------------------------------------- +Local Variables: +mode: change-log +version-control: never +End: diff --git a/tests/Makefile.am b/tests/Makefile.am new file mode 100644 index 00000000..1109a24f --- /dev/null +++ b/tests/Makefile.am @@ -0,0 +1,29 @@ +## 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 diff --git a/tests/aggregate.stat b/tests/aggregate.stat new file mode 100644 index 00000000..3a95532c --- /dev/null +++ b/tests/aggregate.stat @@ -0,0 +1,20 @@ +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. diff --git a/tests/autorecod.stat b/tests/autorecod.stat new file mode 100644 index 00000000..b035c336 --- /dev/null +++ b/tests/autorecod.stat @@ -0,0 +1,30 @@ +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. diff --git a/tests/beg-data.stat b/tests/beg-data.stat new file mode 100644 index 00000000..6bf5a8f5 --- /dev/null +++ b/tests/beg-data.stat @@ -0,0 +1,32 @@ +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. diff --git a/tests/bignum.data b/tests/bignum.data new file mode 100644 index 00000000..1a1421f7 --- /dev/null +++ b/tests/bignum.data @@ -0,0 +1,62 @@ +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 diff --git a/tests/bignum.stat b/tests/bignum.stat new file mode 100644 index 00000000..df5cae31 --- /dev/null +++ b/tests/bignum.stat @@ -0,0 +1,28 @@ +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 diff --git a/tests/compute.stat b/tests/compute.stat new file mode 100644 index 00000000..55387244 --- /dev/null +++ b/tests/compute.stat @@ -0,0 +1,22 @@ +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. diff --git a/tests/count.stat b/tests/count.stat new file mode 100644 index 00000000..f118947b --- /dev/null +++ b/tests/count.stat @@ -0,0 +1,15 @@ +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. diff --git a/tests/crosstabs.stat b/tests/crosstabs.stat new file mode 100644 index 00000000..e201d260 --- /dev/null +++ b/tests/crosstabs.stat @@ -0,0 +1,19 @@ +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. diff --git a/tests/data-fmts.stat b/tests/data-fmts.stat new file mode 100644 index 00000000..87b86bb2 --- /dev/null +++ b/tests/data-fmts.stat @@ -0,0 +1,179 @@ +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. + diff --git a/tests/data-list.data b/tests/data-list.data new file mode 100644 index 00000000..71ea15d5 --- /dev/null +++ b/tests/data-list.data @@ -0,0 +1,6 @@ +SHORT 2 3 4 +RIGHTLEN 6 +7 +8 TOOLONGLEN +10 11 +12 diff --git a/tests/data-list.stat b/tests/data-list.stat new file mode 100644 index 00000000..5df73cbf --- /dev/null +++ b/tests/data-list.stat @@ -0,0 +1,24 @@ +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. + diff --git a/tests/descript.stat b/tests/descript.stat new file mode 100644 index 00000000..334ea2b4 --- /dev/null +++ b/tests/descript.stat @@ -0,0 +1,17 @@ +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. diff --git a/tests/do-if.stat b/tests/do-if.stat new file mode 100644 index 00000000..8f1816e5 --- /dev/null +++ b/tests/do-if.stat @@ -0,0 +1,24 @@ +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. diff --git a/tests/do-repeat.stat b/tests/do-repeat.stat new file mode 100644 index 00000000..c26951f5 --- /dev/null +++ b/tests/do-repeat.stat @@ -0,0 +1,17 @@ +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. + diff --git a/tests/expect/crosstabs.stat b/tests/expect/crosstabs.stat new file mode 100644 index 00000000..db64d4a1 --- /dev/null +++ b/tests/expect/crosstabs.stat @@ -0,0 +1,7 @@ +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. diff --git a/tests/expect/data-fmts.stat b/tests/expect/data-fmts.stat new file mode 100644 index 00000000..531d1fe1 --- /dev/null +++ b/tests/expect/data-fmts.stat @@ -0,0 +1,21 @@ +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 ". diff --git a/tests/expect/data-list.stat b/tests/expect/data-list.stat new file mode 100644 index 00000000..4e4a0799 --- /dev/null +++ b/tests/expect/data-list.stat @@ -0,0 +1,17 @@ +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. diff --git a/tests/expect/expr.stat b/tests/expect/expr.stat new file mode 100644 index 00000000..1a3b1ca8 --- /dev/null +++ b/tests/expect/expr.stat @@ -0,0 +1,144 @@ +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. diff --git a/tests/expect/loop.stat b/tests/expect/loop.stat new file mode 100644 index 00000000..af217334 --- /dev/null +++ b/tests/expect/loop.stat @@ -0,0 +1 @@ +loop.stat:12: warning: BREAK: BREAK not enclosed in DO IF structure. diff --git a/tests/expect/mdfy-vars.stat b/tests/expect/mdfy-vars.stat new file mode 100644 index 00000000..c9a9472f --- /dev/null +++ b/tests/expect/mdfy-vars.stat @@ -0,0 +1,3 @@ +mdfy-vars.stat:22: RENAME VARIABLES: Duplicate variable name `T2' after + renaming. +mdfy-vars.stat:22: warning: This command not executed. diff --git a/tests/expect/means.stat b/tests/expect/means.stat new file mode 100644 index 00000000..03dee4e5 --- /dev/null +++ b/tests/expect/means.stat @@ -0,0 +1,2 @@ +MEANS VARIABLES=V1(1,4) V2(1,9) V3(LO,HI) + TABLES=V1 BY V2 BY V3 diff --git a/tests/expect/print.stat b/tests/expect/print.stat new file mode 100644 index 00000000..09ac7ff3 --- /dev/null +++ b/tests/expect/print.stat @@ -0,0 +1,36 @@ +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. diff --git a/tests/expect/t-test.stat b/tests/expect/t-test.stat new file mode 100644 index 00000000..f423900b --- /dev/null +++ b/tests/expect/t-test.stat @@ -0,0 +1,23 @@ +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) | + diff --git a/tests/expect/vector.stat b/tests/expect/vector.stat new file mode 100644 index 00000000..01682e27 --- /dev/null +++ b/tests/expect/vector.stat @@ -0,0 +1,2 @@ +vector.stat:24: LIST: 6 is not a valid index value for vector X. The result + will be set to the empty string. diff --git a/tests/expect/weighting.stat b/tests/expect/weighting.stat new file mode 100644 index 00000000..10f28d02 --- /dev/null +++ b/tests/expect/weighting.stat @@ -0,0 +1,2 @@ +weighting.stat:6: warning: VALUE LABELS: Truncating value label to 60 + characters. diff --git a/tests/expr.stat b/tests/expr.stat new file mode 100644 index 00000000..0b9a4dab --- /dev/null +++ b/tests/expr.stat @@ -0,0 +1,65 @@ +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'). + diff --git a/tests/file-lab.stat b/tests/file-lab.stat new file mode 100644 index 00000000..741a6dd8 --- /dev/null +++ b/tests/file-lab.stat @@ -0,0 +1,53 @@ +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. + diff --git a/tests/filter.stat b/tests/filter.stat new file mode 100644 index 00000000..3761e387 --- /dev/null +++ b/tests/filter.stat @@ -0,0 +1,21 @@ +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. + diff --git a/tests/flip.stat b/tests/flip.stat new file mode 100644 index 00000000..e1ee8bed --- /dev/null +++ b/tests/flip.stat @@ -0,0 +1,13 @@ +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. diff --git a/tests/gengarbage.c b/tests/gengarbage.c new file mode 100644 index 00000000..f079e911 --- /dev/null +++ b/tests/gengarbage.c @@ -0,0 +1,41 @@ +/* gengarbage - Generates 127-character lines of random digits. + Copyright (C) 1997, 1998 Free Software Foundation, Inc. + Written by Ben Pfaff . + + 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 +#include +#include + +#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); +} diff --git a/tests/inpt-pgm.stat b/tests/inpt-pgm.stat new file mode 100644 index 00000000..69e934c6 --- /dev/null +++ b/tests/inpt-pgm.stat @@ -0,0 +1,26 @@ +/* +/* +/* 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. + diff --git a/tests/lag.stat b/tests/lag.stat new file mode 100644 index 00000000..5b9e936a --- /dev/null +++ b/tests/lag.stat @@ -0,0 +1,16 @@ +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. + diff --git a/tests/list.data b/tests/list.data new file mode 100644 index 00000000..1205b46c --- /dev/null +++ b/tests/list.data @@ -0,0 +1,25 @@ +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 diff --git a/tests/list.stat b/tests/list.stat new file mode 100644 index 00000000..22643348 --- /dev/null +++ b/tests/list.stat @@ -0,0 +1,25 @@ +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. + diff --git a/tests/loop.stat b/tests/loop.stat new file mode 100644 index 00000000..b1aa4c15 --- /dev/null +++ b/tests/loop.stat @@ -0,0 +1,14 @@ +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. diff --git a/tests/mdfy-vars.stat b/tests/mdfy-vars.stat new file mode 100644 index 00000000..d53cddb0 --- /dev/null +++ b/tests/mdfy-vars.stat @@ -0,0 +1,31 @@ +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. + diff --git a/tests/means.stat b/tests/means.stat new file mode 100644 index 00000000..dbc00dfd --- /dev/null +++ b/tests/means.stat @@ -0,0 +1,14 @@ +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. diff --git a/tests/mtch-file.stat b/tests/mtch-file.stat new file mode 100644 index 00000000..ba6a033a --- /dev/null +++ b/tests/mtch-file.stat @@ -0,0 +1,55 @@ +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. diff --git a/tests/pcs-if.stat b/tests/pcs-if.stat new file mode 100644 index 00000000..29ee48c4 --- /dev/null +++ b/tests/pcs-if.stat @@ -0,0 +1,21 @@ +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. + diff --git a/tests/print.stat b/tests/print.stat new file mode 100644 index 00000000..36520961 --- /dev/null +++ b/tests/print.stat @@ -0,0 +1,28 @@ +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. + diff --git a/tests/recode.stat b/tests/recode.stat new file mode 100644 index 00000000..07a64f32 --- /dev/null +++ b/tests/recode.stat @@ -0,0 +1,21 @@ +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. + diff --git a/tests/repeating.stat b/tests/repeating.stat new file mode 100644 index 00000000..fdfd330c --- /dev/null +++ b/tests/repeating.stat @@ -0,0 +1,16 @@ +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. + diff --git a/tests/reread.data b/tests/reread.data new file mode 100644 index 00000000..caa7a044 --- /dev/null +++ b/tests/reread.data @@ -0,0 +1,5 @@ +5510ACME 5 + 5MISC 8901 +8974ACME 9 +1928ACME 4 + 6MISC 8973 diff --git a/tests/reread.stat b/tests/reread.stat new file mode 100644 index 00000000..694e61d4 --- /dev/null +++ b/tests/reread.stat @@ -0,0 +1,16 @@ +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. diff --git a/tests/sample.stat b/tests/sample.stat new file mode 100644 index 00000000..9a2c0071 --- /dev/null +++ b/tests/sample.stat @@ -0,0 +1,19 @@ +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. diff --git a/tests/sort.stat b/tests/sort.stat new file mode 100644 index 00000000..ff85e436 --- /dev/null +++ b/tests/sort.stat @@ -0,0 +1,8 @@ +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. + diff --git a/tests/splt-file.stat b/tests/splt-file.stat new file mode 100644 index 00000000..422d3810 --- /dev/null +++ b/tests/splt-file.stat @@ -0,0 +1,23 @@ +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. diff --git a/tests/syntax b/tests/syntax new file mode 100755 index 00000000..3f2ced76 --- /dev/null +++ b/tests/syntax @@ -0,0 +1,51 @@ +#! /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 + diff --git a/tests/sys-info.stat b/tests/sys-info.stat new file mode 100644 index 00000000..070e0d5e --- /dev/null +++ b/tests/sys-info.stat @@ -0,0 +1,13 @@ +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. + diff --git a/tests/t-test.stat b/tests/t-test.stat new file mode 100644 index 00000000..3395a500 --- /dev/null +++ b/tests/t-test.stat @@ -0,0 +1,13 @@ +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). diff --git a/tests/tabs.stat b/tests/tabs.stat new file mode 100644 index 00000000..fbeede6b --- /dev/null +++ b/tests/tabs.stat @@ -0,0 +1,12 @@ +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. + diff --git a/tests/temporary.stat b/tests/temporary.stat new file mode 100644 index 00000000..08645a35 --- /dev/null +++ b/tests/temporary.stat @@ -0,0 +1,29 @@ +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. diff --git a/tests/time-date.stat b/tests/time-date.stat new file mode 100644 index 00000000..f9a9c736 --- /dev/null +++ b/tests/time-date.stat @@ -0,0 +1,77 @@ +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. + diff --git a/tests/vector.stat b/tests/vector.stat new file mode 100644 index 00000000..8f702261 --- /dev/null +++ b/tests/vector.stat @@ -0,0 +1,24 @@ +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. diff --git a/tests/weighting.data b/tests/weighting.data new file mode 100644 index 00000000..bf74fa04 --- /dev/null +++ b/tests/weighting.data @@ -0,0 +1,52 @@ + 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 diff --git a/tests/weighting.stat b/tests/weighting.stat new file mode 100644 index 00000000..2611e74e --- /dev/null +++ b/tests/weighting.stat @@ -0,0 +1,8 @@ +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. -- 2.30.2