slice-1.3.8/0040755000000000000000000000000007417570304012072 5ustar barbiersliceslice-1.3.8/aclocal.m40100664000000000000000000000611007417570304013727 0ustar barbierslicednl # dnl # aclocal.m4 -- Local M4 functions for GNU autoconf 2.x dnl # Copyright (c) Ralf S. Engelschall, dnl # dnl # NOTICE: dnl # all defined macros are named AC_* dnl # all defined and used variables are named acl-* dnl # dnl dnl ########################################################## dnl ## dnl ## check for Perl 5 module dnl ## dnl ########################################################## dnl define(AC_CHECK_PERL_MODULE,[dnl AC_MSG_CHECKING([for Perl module $1 ($2)]) if test ".$have_$3" = .0; then AC_MSG_RESULT([forced: closed world]) else rc=`$PATH_PERL -e 'eval "use $1 ifelse($2, ANY, , $2)"; print "ok" unless [$]@'`; if test ".$rc" = .ok; then have_$3=1 AC_MSG_RESULT([found]) else have_$3=0 AC_MSG_RESULT([not found]) fi fi AC_SUBST(have_$3) ])dnl dnl dnl dnl ########################################################## dnl ## dnl ## check for latest Perl interpreter dnl ## dnl ########################################################## dnl dnl define(AC_CHECK_PERL_INTERPRETER,[dnl AC_MSG_CHECKING([for Perl interpreter]) AC_ARG_WITH(perl,dnl [ --with-perl=PATH force the usage of a specific Perl 5 interpreter],[ dnl [[ perlprog=$with_perl perlvers=`$perlprog -e 'printf "%.3f",$]'` dnl ] ],[ perlvers= for dir in `echo $PATH | sed -e 's/:/ /g'`; do for perl in perl5 perl miniperl; do if test -f "$dir/$perl"; then if test -x "$dir/$perl"; then perlprog="$dir/$perl" if $perlprog -e 'require 5.003'; then dnl [[ perlvers=`$perlprog -e 'printf "%.3f",$]'` dnl ] break 2 fi fi fi done done ])dnl AC_MSG_RESULT([$perlprog v$perlvers]) if test -f $perlprog; then : else AC_ERROR([required program ``perl'' not found]) fi AC_SUBST(perlprog) AC_SUBST(perlvers) PATH_PERL=$perlprog AC_SUBST(PATH_PERL) ])dnl dnl dnl ########################################################## dnl ## dnl ## check for MakeMaker install paths dnl ## dnl ########################################################## dnl define(AC_CHECK_PERL_MM_PATHS,[dnl AC_MSG_CHECKING([for MakeMaker's private install paths]) MYTMPDIR=${TMPDIR-/tmp}/ac.$$ rm -rf $MYTMPDIR 2>/dev/null mkdir $MYTMPDIR cat >$MYTMPDIR/Makefile.PL <<'EOT' use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Dummy::Dummy', 'VERSION' => '0.0' ); sub MY::postamble { q{ abs2prefix = sed -e "s|^$(PREFIX)|'\\\\$$(libdir)'/perl|" dummy: @echo INSTALLPRIVLIB=`echo $(INSTALLPRIVLIB) | $(abs2prefix)` @echo INSTALLARCHLIB=`echo $(INSTALLARCHLIB) | $(abs2prefix)` }; } EOT test "x$prefix" = xNONE && prefix=$ac_default_prefix test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' eval "dir=$libdir$libsubdir" ( cd $MYTMPDIR; eval "$PATH_PERL Makefile.PL PREFIX=$dir/perl LIB=$dir/perl/lib >/dev/null 2>/dev/null" ) for line in `make -f $MYTMPDIR/Makefile dummy | grep '^INSTALL'`; do eval "$line" done rm -rf $MYTMPDIR 2>/dev/null AC_MSG_RESULT([ok]) AC_SUBST(INSTALLPRIVLIB) AC_SUBST(INSTALLARCHLIB) ])dnl dnl slice-1.3.8/ChangeLog0100664000000000000000000002573607431570136013657 0ustar barbierslice _ _ ___| (_) ___ ___ / __| | |/ __/ _ \ \__ \ | | (_| __/ |___/_|_|\___\___| ChangeLog This file summarizes *all* types of changes to the Slice sources, i.e. changes between each patchlevel (1.x.y->1.x.(y+1) and 1.x.y->1.(x+1).0). Take this logfile for concrete and detailed information about every single change. ___________________________________________________________________________ Changes between 1.3.7 and 1.3.8: *) New -y flag (12-Jan-2002): This flag changes output policy, by defining which action is to be taken when unknown slice sets are requested, or when input is empty. Note that an undefined set used was previously considered as an error, and it is now silently ignored by default. [Denis Barbier] *) Change detection of Perl modules (12-Jan-2002): [Denis Barbier] *) Cosmetic changes (22-Jul-2001): Remove ampersands before function calls. [Denis Barbier] *) Upgrade to Autoconf 2.50 (22-Jul-2001): [Denis Barbier] *) Fix compilation of Bit::Vector with perl < 5.005 (20-Jun-2001): Apply the 2001-08-27 patch by Max H. Duenki. [Denis Barbier] *) Upgraded to Bit::Vector 6.0 (04-May-2001): [Denis Barbier] Changes between 1.3.6 and 1.3.7: *) Fix an infinite loop in slice 1.3.6 (27-Aug-2000): Previous patch about speed improvements made slice hang up with some files. This patch has been entirely revisited. [Josip Rodin ] *) New `all except' operator (27-Aug-2000): The wildcard sign accepts a new syntax. When followed by braces, it replaces ``all strings except the one enclosed within braces''. This construct could not be emulated with previous operators with nested slices. [Denis Barbier] *) Fix `%' operator (27-Aug-2000): This operator, which is a synonym for `n' i.e. intersection of slices, was only partially implemented [Denis Barbier] *) Fix compilation of Bit::Vector with perl < 5.005 (27-Aug-2000): [Max H. Duenki ] Changes between 1.3.5 and 1.3.6: *) Improve processing speed on large files (29-Jul-2000): On very large files, this program was dramatically slow. A speed-up factor of 15 is obtained on a 300KB file containing 16000 slices. [Denis Barbier] *) Fix compilation on threaded Perl 5.6.0 (29-Jul-2000): [Denis Barbier] *) Upgrade of Bit::Vector (28-Jul-2000): Upgraded Bit::Vector from version 5.7 to 5.8. [Ralf S. Engelschall] *) Upgraded to GNU shtool 1.5.0 (01-Jul-2000): Upgraded to GNU shtool 1.5.0. This involved especially a major adjustment because of the rewritten "shtool version" command. [Ralf S. Engelschall] Changes between 1.3.4 and 1.3.5: *) Fix compilation on FreeBSD (27-Apr-2000): [Denis Barbier] *) Fix detection of Perl at configure time (27-Apr-2000): Perl 5.6.0 uses a versioning scheme different than previous versions, which breaks our detection scheme. [Denis Barbier] Changes between 1.3.3 and 1.3.4: *) Use of the TMPDIR environment variable (28-Aug-1999): To conform with POSIX standard, this variable contains the directory name where temporary files are kept. By default, this directory is /tmp. [Thomas Roessler ] *) Use GNU shtool for configuring (25-Aug-1999): All scripts in etc/ sub-directories were still replaced by Ralf's shtool since 01-Jul-1999. They are now removed. [Denis Barbier] *) Write empty file (23-Aug-1999): An empty output implies an empty file. Previous versions did not write empty files. [Denis Barbier] *) Fix installation of Perl modules (05-Jul-1999): On some platforms, Perl modules are not installed according to the prefix passed to the configure command-line. Rules in Makefiles now invoke pure_perl_install [Tobias Oetiker ] Changes between 1.3.2 and 1.3.3: *) Upgrade Perl modules (21-May-1999): - Bit-Vector 5.6 - IO 1.20 - Getopt-Long 2.19 [Denis Barbier ] *) Fixed slice_term.y (10-May-1999): An undefined slice reports a warning instead of an error [Michael McNamara ] ___________________________________________________________________________ Slice is now maintained by Denis Barbier I've now changed the syntax of the ChangeLog file for more readability ___________________________________________________________________________ Changes between 1.3.1 and 1.3.2 980218 - Upgraded to Bit-Vector 5.0b4 - Upgraded to IO 1.19 - Fixed copyright notice and FSF address Changes between 1.3.0 and 1.3.1 980128 - fixed the "Some slices were not closed" error message. Now the slice named are printed as expected. - Upgraded to IO 1.1804 Changes between 1.2.9 and 1.3.0 980106 - Added support for wildcarded slice at the -o option. This is very useful to avoid endless union-constructs in slice terms. To avoid conflicts the intersection now uses the characters [n%] instead of [n*]. - Upgraded to BIt::Vector 5.0b2 - Fixed Getopt::Long check in configure.in - Added Version display to configure.in - Added subdir movement display to Makefile.in - Removed "All Rights Reserved" from copyright messages because this conflicts with GNU GPL. - Adjusted slice.pod for new features and added Version, Copyright and See Also sections Changes between 1.2.8 and 1.2.9 971228 - slice.1 now is installed as PREFIX/man/man1/slice.1 instead of just PREFIX/man/slice.1 [Thanks to Anthony Fok for patch] - changed Perl module version check according to the way WML does it [Thanks to Anthony Fok for patch] - upgraded to GetoptLong 2.13 - upgraded to IO 1.1803 Changes between 1.2.7 and 1.2.8 971212 - disabled Perl warnings - fixed lib/00README file - fixed destroyed COPYING file - adjusted ChangeLog file to WML format - added longoptions to usage page - changed -v to -V option - changed -x to -v option - added -h option Changes between 1.2.6 and 1.2.7 971127 - upgraded to Bit::Vector 5.0b1 Changes between 1.2.5 and 1.2.6 971014 - upgraded to Getopt::Long 2.12 971112 - upgraded to IO 1.1801 - fixed nasty bug when some slices are used more then once (for different output files but one with a negation). [Thanks to Sebastian Wilhelmi for hint ] - fixed Debug output - fixed Perl interpreter determination because of Perl 5.004_04 where -v output changed. Changes between 1.2.4 and 1.2.5 970828 - slightly changes the verbose and error messages - slightly fixed slice.pod Changes between 1.2.3 and 1.2.4 970819 - upgraded to Getopt::Long 2.10 - let slice accept empty input files without complaining it - added RESTRICTION section to slice.pod to make it clear that anon end delimiters can lead to problems. Changes between 1.2.2 and 1.2.3 970815 - made it workable under Perl 5.003 again - removed perl -c check in Makefile.in - fixed distclean target - fixed lib/Makefile.in - fixed lib/getoptlong/Makefile.PL - fixed lib/io/Makefile.PL - disabled $Getopt::Long::getopt_compat option Changes between 1.2.1 and 1.2.2 970814 - improved the %!slice support [Thanks to Andrew Pimlott for providing the patch] - overhauled the ChangeLog file format ;-) Changes between 1.2.0 and 1.2.1 970812 - Perl 5.004 not needed, 5.003 works too. - added support for ``%!slice ...'' lines which can overwrite the options from within the file Changes between 1.1.1 and 1.2.0 970715 - upgraded etc/newvers - upgraded to Bit::Vector 4.2 module - added --with-perl option to configure - added IO package to lib/ - added etc/crunch - added SLICE@ syntax (see slice.pod) 970805 - greatly overhauled and optimized the output generation Changes between 1.1.0 and 1.1.1 970523 - fixed problem with existing /tmp/x in configure, no /tmp/ac.$$ - fixed new-patchlevel target in Makefile.in - added fixperm script and fixperm target Changes between 1.0.7 and 1.1.0 970423 - upgraded from Set::IntegerFast 3.2 to Bit::Vector 4.0 module Changes between 1.0.6 and 1.0.7 970402 - again fixed MakeMaker install path determination. in GNU autoconf again. Now it should really work correctly ;_) Changes between 1.0.5 and 1.0.6 970221 - fixed MakeMaker install path determination in GNU autoconf again. Now it should work correctly ;_) Changes between 1.0.4 and 1.0.5 970215 - changed COPYRIGHT header to LICENSE header in file LICENSE - changed library hack with BEGIN to "use lib" variant - made autoconf part for MakeMaker install paths more robust, at least for Linux - the slice.1 is pre-generated because pod2man is broken on some Linux machines - added MKDIR to Makefile.in's install target Changes between 1.0.3 and 1.0.4 970205 - fixed the lib/Makefile - changed local() to my() where appropriate - fixed a few bugs in slice.pod - added "make update-version" Changes between 1.0.2 and 1.0.3 970204 - updated to Steffen Beyers official Set::IntegerFast 3.0 module from Set-IntegerFast-3.2 bundle. Changes between 1.0.1 and 1.0.2 970131 - fixed setting of empty sets where low = high+1 - added check for existing slice names Changes between 1.0.0 and 1.0.1 970131 - changed signature of rse - used new Set::IntegerFast::Fill_Interval method - used new Set::IntegerFast::Size method - fixed "make clean" inside lib/ - fixed "configure" target in Makefile - fixed "make clean" for t/ Changes between *GENESIS* and 1.0.1 9701xx - *GENESIS* slice-1.3.8/configure0100775000000000000000000015374107417570247014021 0ustar barbierslice#! /bin/sh # From configure.ac Revision: 1.1 . # Guess values for system-dependent variables and create Makefiles. # Generated by Autoconf 2.52. # # Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001 # Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # Sed expression to map a string onto a valid variable name. as_tr_sh="sed y%*+%pp%;s%[^_$as_cr_alnum]%_%g" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="sed y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi # Name of the executable. as_me=`echo "$0" |sed 's,.*[\\/],,'` if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file as_executable_p="test -f" # Support unset when possible. if (FOO=FOO; unset FOO) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # NLS nuisances. $as_unset LANG || test "${LANG+set}" != set || { LANG=C; export LANG; } $as_unset LC_ALL || test "${LC_ALL+set}" != set || { LC_ALL=C; export LC_ALL; } $as_unset LC_TIME || test "${LC_TIME+set}" != set || { LC_TIME=C; export LC_TIME; } $as_unset LC_CTYPE || test "${LC_CTYPE+set}" != set || { LC_CTYPE=C; export LC_CTYPE; } $as_unset LANGUAGE || test "${LANGUAGE+set}" != set || { LANGUAGE=C; export LANGUAGE; } $as_unset LC_COLLATE || test "${LC_COLLATE+set}" != set || { LC_COLLATE=C; export LC_COLLATE; } $as_unset LC_NUMERIC || test "${LC_NUMERIC+set}" != set || { LC_NUMERIC=C; export LC_NUMERIC; } $as_unset LC_MESSAGES || test "${LC_MESSAGES+set}" != set || { LC_MESSAGES=C; export LC_MESSAGES; } # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH || test "${CDPATH+set}" != set || { CDPATH=:; export CDPATH; } # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` exec 6>&1 # # Initializations. # ac_default_prefix=/usr/local cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. # This variable seems obsolete. It should probably be removed, and # only ac_max_sed_lines should be used. : ${ac_max_here_lines=38} ac_unique_file="README" ac_default_prefix=/usr/local # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' # Identity of this package. PACKAGE_NAME= PACKAGE_TARNAME= PACKAGE_VERSION= PACKAGE_STRING= PACKAGE_BUGREPORT= ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` eval "$ac_envvar='$ac_optarg'" export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute paths. for ac_var in exec_prefix prefix do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* | NONE | '' ) ;; *) { echo "$as_me: error: expected an absolute path for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # Be sure to have absolute paths. for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ localstatedir libdir includedir oldincludedir infodir mandir do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* ) ;; *) { echo "$as_me: error: expected an absolute path for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. build=$build_alias host=$host_alias target=$target_alias # FIXME: should be removed in autoconf 3.0. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_prog=$0 ac_confdir=`echo "$ac_prog" | sed 's%[\\/][^\\/][^\\/]*$%%'` test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "$as_me: error: cannot find sources in $ac_confdir or .." >&2 { (exit 1); exit 1; }; } else { echo "$as_me: error: cannot find sources in $srcdir" >&2 { (exit 1); exit 1; }; } fi fi srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` ac_env_build_alias_set=${build_alias+set} ac_env_build_alias_value=$build_alias ac_cv_env_build_alias_set=${build_alias+set} ac_cv_env_build_alias_value=$build_alias ac_env_host_alias_set=${host_alias+set} ac_env_host_alias_value=$host_alias ac_cv_env_host_alias_set=${host_alias+set} ac_cv_env_host_alias_value=$host_alias ac_env_target_alias_set=${target_alias+set} ac_env_target_alias_value=$target_alias ac_cv_env_target_alias_set=${target_alias+set} ac_cv_env_target_alias_value=$target_alias # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <&2 fi cd $ac_popdir done fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\EOF Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. EOF exit 0 fi exec 5>config.log cat >&5 </dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` hostinfo = `(hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` PATH = $PATH _ASUNAME } >&5 cat >&5 <\?\"\']*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" ac_sep=" " ;; *) ac_configure_args="$ac_configure_args$ac_sep$ac_arg" ac_sep=" " ;; esac # Get rid of the leading space. done # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. trap 'exit_status=$? # Save into config.log some information that might help in debugging. echo >&5 echo "## ----------------- ##" >&5 echo "## Cache variables. ##" >&5 echo "## ----------------- ##" >&5 echo >&5 # The following way of writing the cache mishandles newlines in values, { (set) 2>&1 | case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in *ac_space=\ *) sed -n \ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" ;; *) sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } >&5 sed "/^$/d" confdefs.h >conftest.log if test -s conftest.log; then echo >&5 echo "## ------------ ##" >&5 echo "## confdefs.h. ##" >&5 echo "## ------------ ##" >&5 echo >&5 cat conftest.log >&5 fi (echo; echo) >&5 test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" >&5 echo "$as_me: exit $exit_status" >&5 rm -rf conftest* confdefs* core core.* *.core conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo >confdefs.h # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then { echo "$as_me:795: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} cat "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:806: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . $cache_file;; *) . ./$cache_file;; esac fi else { echo "$as_me:814: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in `(set) 2>&1 | sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val="\$ac_cv_env_${ac_var}_value" eval ac_new_val="\$ac_env_${ac_var}_value" case $ac_old_set,$ac_new_set in set,) { echo "$as_me:830: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:834: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:840: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:842: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:844: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. It doesn't matter if # we pass some twice (in addition to the command line arguments). if test "$ac_new_set" = set; then case $ac_new_val in *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ac_configure_args="$ac_configure_args '$ac_arg'" ;; *) ac_configure_args="$ac_configure_args $ac_var=$ac_new_val" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:863: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:865: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac echo "#! $SHELL" >conftest.sh echo "exit 0" >>conftest.sh chmod +x conftest.sh if { (echo "$as_me:885: PATH=\".;.\"; conftest.sh") >&5 (PATH=".;."; conftest.sh) 2>&5 ac_status=$? echo "$as_me:888: \$? = $ac_status" >&5 (exit $ac_status); }; then ac_path_separator=';' else ac_path_separator=: fi PATH_SEPARATOR="$ac_path_separator" rm -f conftest.sh shtool="./etc/shtool" SLICE_VERSION="`$shtool version -l perl -d long slice_vers.pl`" $shtool echo -e "%BConfiguring for Slice $SLICE_VERSION %b" echo "$as_me:902: checking whether ${MAKE-make} sets \${MAKE}" >&5 echo $ECHO_N "checking whether ${MAKE-make} sets \${MAKE}... $ECHO_C" >&6 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,./+-,__p_,'` if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.make <<\EOF all: @echo 'ac_maketemp="${MAKE}"' EOF # GNU make sometimes prints "make[1]: Entering...", which would confuse us. eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=` if test -n "$ac_maketemp"; then eval ac_cv_prog_make_${ac_make}_set=yes else eval ac_cv_prog_make_${ac_make}_set=no fi rm -f conftest.make fi if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then echo "$as_me:922: result: yes" >&5 echo "${ECHO_T}yes" >&6 SET_MAKE= else echo "$as_me:926: result: no" >&5 echo "${ECHO_T}no" >&6 SET_MAKE="MAKE=${MAKE-make}" fi test "x$prefix" = xNONE && prefix=$ac_default_prefix eval "dir=$prefix" case $dir in *slice* ) libsubdir= ;; * ) libsubdir="/slice" ;; esac echo "$as_me:938: checking for Perl interpreter" >&5 echo $ECHO_N "checking for Perl interpreter... $ECHO_C" >&6 # Check whether --with-perl or --without-perl was given. if test "${with_perl+set}" = set; then withval="$with_perl" perlprog=$with_perl perlvers=`$perlprog -e 'printf "%.3f",$]'` else perlvers= for dir in `echo $PATH | sed -e 's/:/ /g'`; do for perl in perl5 perl miniperl; do if test -f "$dir/$perl"; then if test -x "$dir/$perl"; then perlprog="$dir/$perl" if $perlprog -e 'require 5.003'; then perlvers=`$perlprog -e 'printf "%.3f",$]'` break 2 fi fi fi done done fi; echo "$as_me:965: result: $perlprog v$perlvers" >&5 echo "${ECHO_T}$perlprog v$perlvers" >&6 if test -f $perlprog; then : else { { echo "$as_me:970: error: required program \`\`perl'' not found" >&5 echo "$as_me: error: required program \`\`perl'' not found" >&2;} { (exit 1); exit 1; }; } fi PATH_PERL=$perlprog echo "$as_me:977: checking for MakeMaker's private install paths" >&5 echo $ECHO_N "checking for MakeMaker's private install paths... $ECHO_C" >&6 MYTMPDIR=${TMPDIR-/tmp}/ac.$$ rm -rf $MYTMPDIR 2>/dev/null mkdir $MYTMPDIR cat >$MYTMPDIR/Makefile.PL <<'EOT' use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Dummy::Dummy', 'VERSION' => '0.0' ); sub MY::postamble { q{ abs2prefix = sed -e "s|^$(PREFIX)|'\\\\$$(libdir)'/perl|" dummy: @echo INSTALLPRIVLIB=`echo $(INSTALLPRIVLIB) | $(abs2prefix)` @echo INSTALLARCHLIB=`echo $(INSTALLARCHLIB) | $(abs2prefix)` }; } EOT test "x$prefix" = xNONE && prefix=$ac_default_prefix test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' eval "dir=$libdir$libsubdir" ( cd $MYTMPDIR; eval "$PATH_PERL Makefile.PL PREFIX=$dir/perl LIB=$dir/perl/lib >/dev/null 2>/dev/null" ) for line in `make -f $MYTMPDIR/Makefile dummy | grep '^INSTALL'`; do eval "$line" done rm -rf $MYTMPDIR 2>/dev/null echo "$as_me:1006: result: ok" >&5 echo "${ECHO_T}ok" >&6 # Check whether --with-closedworld or --without-closedworld was given. if test "${with_closedworld+set}" = set; then withval="$with_closedworld" have_getoptlong=0 have_bitvector=0 have_io=0 fi; echo "$as_me:1017: checking for Perl module Getopt::Long (2.13)" >&5 echo $ECHO_N "checking for Perl module Getopt::Long (2.13)... $ECHO_C" >&6 if test ".$have_getoptlong" = .0; then echo "$as_me:1020: result: forced: closed world" >&5 echo "${ECHO_T}forced: closed world" >&6 else rc=`$PATH_PERL -e 'eval "use Getopt::Long 2.13"; print "ok" unless $@'`; if test ".$rc" = .ok; then have_getoptlong=1 echo "$as_me:1026: result: found" >&5 echo "${ECHO_T}found" >&6 else have_getoptlong=0 echo "$as_me:1030: result: not found" >&5 echo "${ECHO_T}not found" >&6 fi fi echo "$as_me:1035: checking for Perl module Bit::Vector (5.0)" >&5 echo $ECHO_N "checking for Perl module Bit::Vector (5.0)... $ECHO_C" >&6 if test ".$have_bitvector" = .0; then echo "$as_me:1038: result: forced: closed world" >&5 echo "${ECHO_T}forced: closed world" >&6 else rc=`$PATH_PERL -e 'eval "use Bit::Vector 5.0"; print "ok" unless $@'`; if test ".$rc" = .ok; then have_bitvector=1 echo "$as_me:1044: result: found" >&5 echo "${ECHO_T}found" >&6 else have_bitvector=0 echo "$as_me:1048: result: not found" >&5 echo "${ECHO_T}not found" >&6 fi fi echo "$as_me:1053: checking for Perl module IO::File (1.07)" >&5 echo $ECHO_N "checking for Perl module IO::File (1.07)... $ECHO_C" >&6 if test ".$have_io" = .0; then echo "$as_me:1056: result: forced: closed world" >&5 echo "${ECHO_T}forced: closed world" >&6 else rc=`$PATH_PERL -e 'eval "use IO::File 1.07"; print "ok" unless $@'`; if test ".$rc" = .ok; then have_io=1 echo "$as_me:1062: result: found" >&5 echo "${ECHO_T}found" >&6 else have_io=0 echo "$as_me:1066: result: not found" >&5 echo "${ECHO_T}not found" >&6 fi fi ac_config_files="$ac_config_files Makefile t/Makefile lib/Makefile" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overriden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. { (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } | sed ' t clear : clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ : end' >>confcache if cmp -s $cache_file confcache; then :; else if test -w $cache_file; then test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/; s/:*\${srcdir}:*/:/; s/:*@srcdir@:*/:/; s/^\([^=]*=[ ]*\):*/\1/; s/:*$//; s/^[^=]*=[ ]*$//; }' fi # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then we branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. cat >confdef2opt.sed <<\EOF t clear : clear s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g t quote s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g t quote d : quote s,[ `~#$^&*(){}\\|;'"<>?],\\&,g s,\[,\\&,g s,\],\\&,g s,\$,$$,g p EOF # We use echo to avoid assuming a particular line-breaking character. # The extra dot is to prevent the shell from consuming trailing # line-breaks from the sub-command output. A line-break within # single-quotes doesn't work because, if this script is created in a # platform that uses two characters for line-breaks (e.g., DOS), tr # would break. ac_LF_and_DOT=`echo; echo .` DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` rm -f confdef2opt.sed : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:1182: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated automatically by configure. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false SHELL=\${CONFIG_SHELL-$SHELL} ac_cs_invocation="\$0 \$@" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi # Name of the executable. as_me=`echo "$0" |sed 's,.*[\\/],,'` if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file as_executable_p="test -f" # Support unset when possible. if (FOO=FOO; unset FOO) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # NLS nuisances. $as_unset LANG || test "${LANG+set}" != set || { LANG=C; export LANG; } $as_unset LC_ALL || test "${LC_ALL+set}" != set || { LC_ALL=C; export LC_ALL; } $as_unset LC_TIME || test "${LC_TIME+set}" != set || { LC_TIME=C; export LC_TIME; } $as_unset LC_CTYPE || test "${LC_CTYPE+set}" != set || { LC_CTYPE=C; export LC_CTYPE; } $as_unset LANGUAGE || test "${LANGUAGE+set}" != set || { LANGUAGE=C; export LANGUAGE; } $as_unset LC_COLLATE || test "${LC_COLLATE+set}" != set || { LC_COLLATE=C; export LC_COLLATE; } $as_unset LC_NUMERIC || test "${LC_NUMERIC+set}" != set || { LC_NUMERIC=C; export LC_NUMERIC; } $as_unset LC_MESSAGES || test "${LC_MESSAGES+set}" != set || { LC_MESSAGES=C; export LC_MESSAGES; } # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH || test "${CDPATH+set}" != set || { CDPATH=:; export CDPATH; } exec 6>&1 _ACEOF # Files that config.status was made for. if test -n "$ac_config_files"; then echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS fi if test -n "$ac_config_headers"; then echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS fi if test -n "$ac_config_links"; then echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS fi if test -n "$ac_config_commands"; then echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS fi cat >>$CONFIG_STATUS <<\EOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number, then exit -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Report bugs to ." EOF cat >>$CONFIG_STATUS <>$CONFIG_STATUS <<\EOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "x$1" : 'x\([^=]*\)='` ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` shift set dummy "$ac_option" "$ac_optarg" ${1+"$@"} shift ;; -*);; *) # This is not an option, so the user has probably given explicit # arguments. ac_need_defaults=false;; esac case $1 in # Handling of the options. EOF cat >>$CONFIG_STATUS <>$CONFIG_STATUS <<\EOF --version | --vers* | -V ) echo "$ac_cs_version"; exit 0 ;; --he | --h) # Conflict between --help and --header { { echo "$as_me:1349: error: ambiguous option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit 0 ;; --debug | --d* | -d ) debug=: ;; --file | --fil | --fi | --f ) shift CONFIG_FILES="$CONFIG_FILES $1" ac_need_defaults=false;; --header | --heade | --head | --hea ) shift CONFIG_HEADERS="$CONFIG_HEADERS $1" ac_need_defaults=false;; # This is an error. -*) { { echo "$as_me:1368: error: unrecognized option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ;; esac shift done exec 5>>config.log cat >&5 << _ACEOF ## ----------------------- ## ## Running config.status. ## ## ----------------------- ## This file was extended by $as_me 2.52, executed with CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS > $ac_cs_invocation on `(hostname || uname -n) 2>/dev/null | sed 1q` _ACEOF EOF cat >>$CONFIG_STATUS <<\EOF for ac_config_target in $ac_config_targets do case "$ac_config_target" in # Handling of arguments. "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; "t/Makefile" ) CONFIG_FILES="$CONFIG_FILES t/Makefile" ;; "lib/Makefile" ) CONFIG_FILES="$CONFIG_FILES lib/Makefile" ;; *) { { echo "$as_me:1406: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files fi # Create a temporary directory, and hook for its removal unless debugging. $debug || { trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. : ${TMPDIR=/tmp} { tmp=`(umask 077 && mktemp -d -q "$TMPDIR/csXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=$TMPDIR/cs$$-$RANDOM (umask 077 && mkdir $tmp) } || { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 { (exit 1); exit 1; } } EOF cat >>$CONFIG_STATUS <\$tmp/subs.sed <<\\CEOF s,@SHELL@,$SHELL,;t t s,@exec_prefix@,$exec_prefix,;t t s,@prefix@,$prefix,;t t s,@program_transform_name@,$program_transform_name,;t t s,@bindir@,$bindir,;t t s,@sbindir@,$sbindir,;t t s,@libexecdir@,$libexecdir,;t t s,@datadir@,$datadir,;t t s,@sysconfdir@,$sysconfdir,;t t s,@sharedstatedir@,$sharedstatedir,;t t s,@localstatedir@,$localstatedir,;t t s,@libdir@,$libdir,;t t s,@includedir@,$includedir,;t t s,@oldincludedir@,$oldincludedir,;t t s,@infodir@,$infodir,;t t s,@mandir@,$mandir,;t t s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t s,@build_alias@,$build_alias,;t t s,@host_alias@,$host_alias,;t t s,@target_alias@,$target_alias,;t t s,@ECHO_C@,$ECHO_C,;t t s,@ECHO_N@,$ECHO_N,;t t s,@ECHO_T@,$ECHO_T,;t t s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t s,@DEFS@,$DEFS,;t t s,@LIBS@,$LIBS,;t t s,@SET_MAKE@,$SET_MAKE,;t t s,@libsubdir@,$libsubdir,;t t s,@perlprog@,$perlprog,;t t s,@perlvers@,$perlvers,;t t s,@PATH_PERL@,$PATH_PERL,;t t s,@INSTALLPRIVLIB@,$INSTALLPRIVLIB,;t t s,@INSTALLARCHLIB@,$INSTALLARCHLIB,;t t s,@have_getoptlong@,$have_getoptlong,;t t s,@have_bitvector@,$have_bitvector,;t t s,@have_io@,$have_io,;t t CEOF EOF cat >>$CONFIG_STATUS <<\EOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_lines=48 ac_sed_frag=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_lines # Line after last line for current file. ac_more_lines=: ac_sed_cmds= while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag else sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag fi if test ! -s $tmp/subs.frag; then ac_more_lines=false else # The purpose of the label and of the branching condition is to # speed up the sed processing (if there are no `@' at all, there # is no need to browse any of the substitutions). # These are the two extra sed commands mentioned above. (echo ':t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" else ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" fi ac_sed_frag=`expr $ac_sed_frag + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_lines` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi fi # test -n "$CONFIG_FILES" EOF cat >>$CONFIG_STATUS <<\EOF for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. ac_dir=`$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then { case "$ac_dir" in [\\/]* | ?:[\\/]* ) as_incr_dir=;; *) as_incr_dir=.;; esac as_dummy="$ac_dir" for as_mkdir_dir in `IFS='/\\'; set X $as_dummy; shift; echo "$@"`; do case $as_mkdir_dir in # Skip DOS drivespec ?:) as_incr_dir=$as_mkdir_dir ;; *) as_incr_dir=$as_incr_dir/$as_mkdir_dir test -d "$as_incr_dir" || mkdir "$as_incr_dir" ;; esac done; } ac_dir_suffix="/`echo $ac_dir|sed 's,^\./,,'`" # A "../" for each directory in $ac_dir_suffix. ac_dots=`echo "$ac_dir_suffix" | sed 's,/[^/]*,../,g'` else ac_dir_suffix= ac_dots= fi case $srcdir in .) ac_srcdir=. if test -z "$ac_dots"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_dots | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_dots$srcdir$ac_dir_suffix ac_top_srcdir=$ac_dots$srcdir ;; esac if test x"$ac_file" != x-; then { echo "$as_me:1605: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} rm -f "$ac_file" fi # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated automatically by config.status. */ configure_input="Generated automatically from `echo $ac_file_in | sed 's,.*/,,'` by configure." # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:1623: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo $f;; *) # Relative if test -f "$f"; then # Build tree echo $f elif test -f "$srcdir/$f"; then # Source tree echo $srcdir/$f else # /dev/null tree { { echo "$as_me:1636: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } EOF cat >>$CONFIG_STATUS <>$CONFIG_STATUS <<\EOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s,@configure_input@,$configure_input,;t t s,@srcdir@,$ac_srcdir,;t t s,@top_srcdir@,$ac_top_srcdir,;t t " $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out rm -f $tmp/stdin if test x"$ac_file" != x-; then mv $tmp/out $ac_file else cat $tmp/out rm -f $tmp/out fi done EOF cat >>$CONFIG_STATUS <<\EOF { (exit 0); exit 0; } EOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: exec 5>/dev/null $SHELL $CONFIG_STATUS || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi slice-1.3.8/configure.ac0100664000000000000000000000175507326641132014364 0ustar barbierslicednl ## dnl ## configure.in -- GNU autoconf configuration source dnl ## AC_PREREQ(2.50)dnl AC_REVISION($Revision: 1.1 $)dnl AC_INIT shtool="./etc/shtool" dnl ## version id SLICE_VERSION="`$shtool version -l perl -d long slice_vers.pl`" $shtool echo -e "%BConfiguring for Slice $SLICE_VERSION %b" AC_CONFIG_SRCDIR([README]) AC_PREFIX_DEFAULT(/usr/local) AC_PROG_MAKE_SET test "x$prefix" = xNONE && prefix=$ac_default_prefix eval "dir=$prefix" case $dir in *slice* ) libsubdir= ;; * ) libsubdir="/slice" ;; esac AC_SUBST(libsubdir) AC_CHECK_PERL_INTERPRETER AC_CHECK_PERL_MM_PATHS AC_ARG_WITH(closedworld,dnl [ --with-closedworld force the private install of all Perl modules],[ have_getoptlong=0 have_bitvector=0 have_io=0 ],)dnl AC_CHECK_PERL_MODULE(Getopt::Long, 2.13, getoptlong) AC_CHECK_PERL_MODULE(Bit::Vector, 5.0, bitvector) AC_CHECK_PERL_MODULE(IO::File, 1.07, io) AC_CONFIG_FILES([ Makefile t/Makefile lib/Makefile ]) AC_OUTPUT dnl ##EOF## slice-1.3.8/COPYING0100664000000000000000000004312706715575414013142 0ustar barbierslice GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 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. slice-1.3.8/etc/expand.in0100664000000000000000000000127406715575415014467 0ustar barbierslice#!@PATH_PERL@ ## ## expand -- recursive filter to substitute each Perl ## 'require' command with the contents of the file ## ## Copyright (c) 1995 Ralf S. Engelschall, ## ## Usage: unrequire file.pl >file ## sub ProcessFile { local ($file) = @_[0]; open($file, "<$file"); while(<$file>) { # include a file if (m|^(.*)require[ \"\(]+([^ \"\(]+)[ \"\)]+;(.*)$|) { print $1; &ProcessFile($2); print $3; break; } # remove a require result code if (m|^1;$|) { next; } print; } close($file); } &ProcessFile($ARGV[0]); ##EOF## slice-1.3.8/etc/fixconfigure0100775000000000000000000000122706715575415015274 0ustar barbierslice: eval 'exec perl -S $0 ${1+"$@"}' if $running_under_some_shell; ## ## add BASH bootstrap hack to a configure script ## Copyright (c) Ralf S. Engelschall, All Rights Reserved. ## open(FPI, "<$ARGV[0]"); open(FPO, ">$ARGV[0].n"); while () { if (m|#! /bin/sh\n|) { print FPO "#! /bin/sh\n"; print FPO <<'EOF' # if we can run at the top, why should we stay at the bottom any longer? if [ ".$BASH" = . ]; then BASH=`which bash`; if [ ".$BASH" != . ]; then exec $BASH $0 $*; fi; fi EOF ; } else { print FPO $_; } } close(FPO); close(FPI); unlink("$ARGV[0]"); link("$ARGV[0].n", "$ARGV[0]"); unlink("$ARGV[0].n"); ##EOF## slice-1.3.8/etc/shtool0100775000000000000000000011155507152056416014111 0ustar barbierslice#!/bin/sh ## ## GNU shtool -- The GNU Portable Shell Tool ## Copyright (c) 1994-2000 Ralf S. Engelschall ## ## See http://www.gnu.org/software/shtool/ for more information. ## See ftp://ftp.gnu.org/gnu/shtool/ for latest version. ## ## Version: 1.5.1 (29-Jul-2000) ## Contents: 5/17 available modules ## ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2 of the License, or ## (at your option) any later version. ## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ## General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ## USA, or contact Ralf S. Engelschall . ## ## Notice: Given that you include this file verbatim into your own ## source tree, you are justified in saying that it remains separate ## from your package, and that this way you are simply just using GNU ## shtool. So, in this situation, there is no requirement that your ## package itself is licensed under the GNU General Public License in ## order to take advantage of GNU shtool. ## ## ## Usage: shtool [] [ [] []] ## ## Available commands: ## echo Print string with optional construct expansion ## install Install a program, script or datafile ## mkdir Make one or more directories ## fixperm Fix file permissions inside a source tree ## version Maintain a version information file ## ## Not available commands (because module was not built-in): ## mdate Pretty-print modification time of a file or dir ## table Pretty-print a field-separated list as a table ## prop Display progress with a running propeller ## move Move files with simultaneous substitution ## mkln Make link with calculation of relative paths ## mkshadow Make a shadow tree through symbolic links ## tarball Roll distribution tarballs ## guessos Simple operating system guesser ## arx Extended archive command ## slo Separate linker options by library class ## scpp Sharing C Pre-Processor ## path Deal with program paths ## if [ $# -eq 0 ]; then echo "$0:Error: invalid command line" 1>&2 echo "$0:Hint: run \`$0 -h' for usage" 1>&2 exit 1 fi if [ ".$1" = ".-h" -o ".$1" = ".--help" ]; then echo "This is GNU shtool, version 1.5.1 (29-Jul-2000)" echo "Copyright (c) 1994-2000 Ralf S. Engelschall " echo "Report bugs to " echo '' echo "Usage: shtool [] [ [] []]" echo '' echo 'Available global :' echo ' -v, --version display shtool version information' echo ' -h, --help display shtool usage help page (this one)' echo ' -d, --debug display shell trace information' echo ' -r, --recreate recreate this shtool script via shtoolize' echo '' echo 'Available [] []:' echo ' echo [-n] [-e] [ ...]' echo ' install [-v] [-t] [-c] [-C] [-s] [-m] [-o] [-g]' echo ' [-e] [ ...] ' echo ' mkdir [-t] [-f] [-p] [-m] [ ...]' echo ' fixperm [-v] [-t] [ ...]' echo ' version [-l] [-n] [-p] [-s] [-e]' echo ' [-i] [-d] ' echo '' echo 'Not available (because module was not built-in):' echo ' mdate [-n] [-z] [-s] [-d] [-f] [-o] ' echo ' table [-F] [-w] [-c] [-s] ...' echo ' prop [-p]' echo ' move [-v] [-t] [-e] [-p] ' echo ' mkln [-t] [-f] [-s] [ ...] ' echo ' mkshadow [-v] [-t] [-a] ' echo ' tarball [-t] [-v] [-o ] [-c ] [-d ] [-u' echo ' ] [-g ] [-e ] [ ...]' echo ' guessos ' echo ' arx [-t] [-C] [ ...]' echo ' slo [-p] -- -L -l [-L -l ...]' echo ' scpp [-v] [-p] [-f] [-o] [-t] [-M]' echo ' [-D] [-C] [ ...]' echo ' path [-s] [-r] [-d] [-b] [-m] [-p] [ ...]' echo '' exit 0 fi if [ ".$1" = ".-v" -o ".$1" = ."--version" ]; then echo "GNU shtool 1.5.1 (29-Jul-2000)" exit 0 fi if [ ".$1" = ".-r" -o ".$1" = ."--recreate" ]; then shtoolize -oetc/shtool echo install mkdir fixperm version exit 0 fi if [ ".$1" = ".-d" -o ".$1" = ."--debug" ]; then shift set -x fi name=`echo "$0" | sed -e 's;.*/\([^/]*\)$;\1;' -e 's;-sh$;;' -e 's;\.sh$;;'` case "$name" in echo|install|mkdir|fixperm|version ) # implicit tool command selection tool="$name" ;; * ) # explicit tool command selection tool="$1" shift ;; esac arg_spec="" opt_spec="" gen_tmpfile=no ## ## DISPATCH INTO SCRIPT PROLOG ## case $tool in echo ) str_tool="echo" str_usage="[-n] [-e] [ ...]" arg_spec="0+" opt_spec="n.e." opt_n=no opt_e=no ;; install ) str_tool="install" str_usage="[-v] [-t] [-c] [-C] [-s] [-m] [-o] [-g] [-e] [ ...] " arg_spec="2+" opt_spec="v.t.c.C.s.m:o:g:e:" opt_v=no opt_t=no opt_c=no opt_C=no opt_s=no opt_m="" opt_o="" opt_g="" opt_e="" ;; mkdir ) str_tool="mkdir" str_usage="[-t] [-f] [-p] [-m] [ ...]" arg_spec="1+" opt_spec="t.f.p.m:" opt_t=no opt_f=no opt_p=no opt_m="" ;; fixperm ) str_tool="fixperm" str_usage="[-v] [-t] [ ...]" arg_spec="1+" opt_spec="v.t." opt_v=no opt_t=no ;; version ) str_tool="version" str_usage="[-l] [-n] [-p] [-s] [-e] [-i] [-d] " arg_spec="1=" opt_spec="l:n:p:s:i:e.d:" opt_l="txt" opt_n="unknown" opt_p="" opt_s="" opt_e="no" opt_i="" opt_d="short" ;; -* ) echo "$0:Error: unknown option \`$tool'" 2>&1 echo "$0:Hint: run \`$0 -h' for usage" 2>&1 exit 1 ;; * ) echo "$0:Error: unknown command \`$tool'" 2>&1 echo "$0:Hint: run \`$0 -h' for usage" 2>&1 exit 1 ;; esac ## ## COMMON UTILITY CODE ## # determine name of tool if [ ".$tool" != . ]; then # used inside shtool script toolcmd="$0 $tool" toolcmdhelp="shtool $tool" msgprefix="shtool:$tool" else # used as standalone script toolcmd="$0" toolcmdhelp="sh $0" msgprefix="$str_tool" fi # parse argument specification string eval `echo $arg_spec |\ sed -e 's/^\([0-9]*\)\([+=]\)/arg_NUMS=\1; arg_MODE=\2/'` # parse option specification string eval `echo h.$opt_spec |\ sed -e 's/\([a-zA-Z0-9]\)\([.:+]\)/opt_MODE_\1=\2;/g'` # interate over argument line opt_PREV='' while [ $# -gt 0 ]; do # special option stops processing if [ ".$1" = ".--" ]; then shift break fi # determine option and argument opt_ARG_OK=no if [ ".$opt_PREV" != . ]; then # merge previous seen option with argument opt_OPT="$opt_PREV" opt_ARG="$1" opt_ARG_OK=yes opt_PREV='' else # split argument into option and argument case "$1" in -[a-zA-Z0-9]*) eval `echo "x$1" |\ sed -e 's/^x-\([a-zA-Z0-9]\)/opt_OPT="\1";/' \ -e 's/";\(.*\)$/"; opt_ARG="\1"/'` ;; -[a-zA-Z0-9]) opt_OPT=`echo "x$1" | cut -c3-` opt_ARG='' ;; *) break ;; esac fi # eat up option shift # determine whether option needs an argument eval "opt_MODE=\$opt_MODE_${opt_OPT}" if [ ".$opt_ARG" = . -a ".$opt_ARG_OK" != .yes ]; then if [ ".$opt_MODE" = ".:" -o ".$opt_MODE" = ".+" ]; then opt_PREV="$opt_OPT" continue fi fi # process option case $opt_MODE in '.' ) # boolean option eval "opt_${opt_OPT}=yes" ;; ':' ) # option with argument (multiple occurances override) eval "opt_${opt_OPT}=\"\$opt_ARG\"" ;; '+' ) # option with argument (multiple occurances append) eval "opt_${opt_OPT}=\"\$opt_${opt_OPT} \$opt_ARG\"" ;; * ) echo "$msgprefix:Error: unknown option: \`-$opt_OPT'" 1>&2 echo "$msgprefix:Hint: run \`$toolcmdhelp -h' or \`man shtool' for details" 1>&2 exit 1 ;; esac done if [ ".$opt_PREV" != . ]; then echo "$msgprefix:Error: missing argument to option \`-$opt_PREV'" 1>&2 echo "$msgprefix:Hint: run \`$toolcmdhelp -h' or \`man shtool' for details" 1>&2 exit 1 fi # process help option if [ ".$opt_h" = .yes ]; then echo "Usage: $toolcmdhelp $str_usage" exit 0 fi # complain about incorrect number of arguments case $arg_MODE in '=' ) if [ $# -ne $arg_NUMS ]; then echo "$msgprefix:Error: invalid number of arguments (exactly $arg_NUMS expected)" 1>&2 echo "$msgprefix:Hint: run \`$toolcmd -h' or \`man shtool' for details" 1>&2 exit 1 fi ;; '+' ) if [ $# -lt $arg_NUMS ]; then echo "$msgprefix:Error: invalid number of arguments (at least $arg_NUMS expected)" 1>&2 echo "$msgprefix:Hint: run \`$toolcmd -h' or \`man shtool' for details" 1>&2 exit 1 fi ;; esac # establish a temporary file on request if [ ".$gen_tmpfile" = .yes ]; then if [ ".$TMPDIR" != . ]; then tmpdir="$TMPDIR" elif [ ".$TEMPDIR" != . ]; then tmpdir="$TEMPDIR" else tmpdir="/tmp" fi tmpfile="$tmpdir/.shtool.$$" rm -f $tmpfile >/dev/null 2>&1 touch $tmpfile fi ## ## DISPATCH INTO SCRIPT BODY ## case $tool in echo ) ## ## echo -- Print string with optional construct expansion ## Copyright (c) 1998-2000 Ralf S. Engelschall ## Originally written for WML as buildinfo ## text="$*" # check for broken escape sequence expansion seo='' bytes=`echo '\1' | wc -c | awk '{ printf("%s", $1); }'` if [ ".$bytes" != .3 ]; then bytes=`echo -E '\1' | wc -c | awk '{ printf("%s", $1); }'` if [ ".$bytes" = .3 ]; then seo='-E' fi fi # check for existing -n option (to suppress newline) minusn='' bytes=`echo -n 123 2>/dev/null | wc -c | awk '{ printf("%s", $1); }'` if [ ".$bytes" = .3 ]; then minusn='-n' fi # determine terminal bold sequence term_bold='' term_norm='' if [ ".$opt_e" = .yes -a ".`echo $text | egrep '%[Bb]'`" != . ]; then case $TERM in # for the most important terminal types we directly know the sequences xterm|xterm*|vt220|vt220*) term_bold=`awk 'BEGIN { printf("%c%c%c%c", 27, 91, 49, 109); }' /dev/null` term_norm=`awk 'BEGIN { printf("%c%c%c", 27, 91, 109); }' /dev/null` ;; vt100|vt100*) term_bold=`awk 'BEGIN { printf("%c%c%c%c%c%c", 27, 91, 49, 109, 0, 0); }' /dev/null` term_norm=`awk 'BEGIN { printf("%c%c%c%c%c", 27, 91, 109, 0, 0); }' /dev/null` ;; # for all others, we try to use a possibly existing `tput' or `tcout' utility * ) paths=`echo $PATH | sed -e 's/:/ /g'` for tool in tput tcout; do for dir in $paths; do if [ -r "$dir/$tool" ]; then for seq in bold md smso; do # 'smso' is last bold="`$dir/$tool $seq 2>/dev/null`" if [ ".$bold" != . ]; then term_bold="$bold" break fi done if [ ".$term_bold" != . ]; then for seq in sgr0 me rmso reset; do # 'reset' is last norm="`$dir/$tool $seq 2>/dev/null`" if [ ".$norm" != . ]; then term_norm="$norm" break fi done fi break fi done if [ ".$term_bold" != . -a ".$term_norm" != . ]; then break; fi done ;; esac if [ ".$term_bold" = . -o ".$term_norm" = . ]; then echo "$msgprefix:Warning: unable to determine terminal sequence for bold mode" 1>&2 fi fi # determine user name username='' if [ ".$opt_e" = .yes -a ".`echo $text | egrep '%[uU]'`" != . ]; then username="$LOGNAME" if [ ".$username" = . ]; then username="$USER" if [ ".$username" = . ]; then username="`(whoami) 2>/dev/null |\ awk '{ printf("%s", $1); }'`" if [ ".$username" = . ]; then username="`(who am i) 2>/dev/null |\ awk '{ printf("%s", $1); }'`" if [ ".$username" = . ]; then username='unknown' fi fi fi fi fi # determine user id userid='' if [ ".$opt_e" = .yes -a ".`echo $text | egrep '%U'`" != . ]; then userid="`(id -u) 2>/dev/null`" if [ ".$userid" = . ]; then str="`(id) 2>/dev/null`" if [ ".`echo $str | grep '^uid[ ]*=[ ]*[0-9]*('`" != . ]; then userid=`echo $str | sed -e 's/^uid[ ]*=[ ]*//' -e 's/(.*//'` fi if [ ".$userid" = . ]; then userid=`egrep "^${username}:" /etc/passwd 2>/dev/null | \ sed -e 's/[^:]*:[^:]*://' -e 's/:.*$//'` if [ ".$userid" = . ]; then userid=`(ypcat passwd) 2>/dev/null | egrep "^${username}:" | \ sed -e 's/[^:]*:[^:]*://' -e 's/:.*$//'` if [ ".$userid" = . ]; then userid='?' fi fi fi fi fi # determine host name hostname='' if [ ".$opt_e" = .yes -a ".`echo $text | egrep '%h'`" != . ]; then hostname="`(uname -n) 2>/dev/null |\ awk '{ printf("%s", $1); }'`" if [ ".$hostname" = . ]; then hostname="`(hostname) 2>/dev/null |\ awk '{ printf("%s", $1); }'`" if [ ".$hostname" = . ]; then hostname='unknown' fi fi case $hostname in *.* ) domainname=".`echo $hostname | cut -d. -f2-`" hostname="`echo $hostname | cut -d. -f1`" ;; esac fi # determine domain name domainname='' if [ ".$opt_e" = .yes -a ".`echo $text | egrep '%d'`" != . ]; then if [ ".$domainname" = . ]; then if [ -f /etc/resolv.conf ]; then domainname="`egrep '^[ ]*domain' /etc/resolv.conf | head -1 |\ sed -e 's/.*domain//' \ -e 's/^[ ]*//' -e 's/^ *//' -e 's/^ *//' \ -e 's/^\.//' -e 's/^/./' |\ awk '{ printf("%s", $1); }'`" if [ ".$domainname" = . ]; then domainname="`egrep '^[ ]*search' /etc/resolv.conf | head -1 |\ sed -e 's/.*search//' \ -e 's/^[ ]*//' -e 's/^ *//' -e 's/^ *//' \ -e 's/ .*//' -e 's/ .*//' \ -e 's/^\.//' -e 's/^/./' |\ awk '{ printf("%s", $1); }'`" fi fi fi fi # determine current time time_day='' time_month='' time_year='' time_monthname='' if [ ".$opt_e" = .yes -a ".`echo $text | egrep '%[DMYm]'`" != . ]; then time_day=`date '+%d'` time_month=`date '+%m'` time_year=`date '+%Y' 2>/dev/null` if [ ".$time_year" = . ]; then time_year=`date '+%y'` case $time_year in [5-9][0-9]) time_year="19$time_year" ;; [0-4][0-9]) time_year="20$time_year" ;; esac fi case $time_month in 1|01) time_monthname='Jan' ;; 2|02) time_monthname='Feb' ;; 3|03) time_monthname='Mar' ;; 4|04) time_monthname='Apr' ;; 5|05) time_monthname='May' ;; 6|06) time_monthname='Jun' ;; 7|07) time_monthname='Jul' ;; 8|08) time_monthname='Aug' ;; 9|09) time_monthname='Sep' ;; 10) time_monthname='Oct' ;; 11) time_monthname='Nov' ;; 12) time_monthname='Dec' ;; esac fi # expand special ``%x'' constructs if [ ".$opt_e" = .yes ]; then text=`echo $seo "$text" |\ sed -e "s/%B/${term_bold}/g" \ -e "s/%b/${term_norm}/g" \ -e "s/%u/${username}/g" \ -e "s/%U/${userid}/g" \ -e "s/%h/${hostname}/g" \ -e "s/%d/${domainname}/g" \ -e "s/%D/${time_day}/g" \ -e "s/%M/${time_month}/g" \ -e "s/%Y/${time_year}/g" \ -e "s/%m/${time_monthname}/g" 2>/dev/null` fi # create output if [ .$opt_n = .no ]; then echo $seo "$text" else # the harder part: echo -n is best, because # awk may complain about some \xx sequences. if [ ".$minusn" != . ]; then echo $seo $minusn "$text" else echo dummy | awk '{ printf("%s", TEXT); }' TEXT="$text" fi fi ;; install ) ## ## install -- Install a program, script or datafile ## Copyright (c) 1997-2000 Ralf S. Engelschall ## Originally written for shtool ## # determine source(s) and destination argc=$# srcs="" while [ $# -gt 1 ]; do srcs="$srcs $1" shift done dstpath="$1" # type check for destination dstisdir=0 if [ -d $dstpath ]; then dstpath=`echo "$dstpath" | sed -e 's:/$::'` dstisdir=1 fi # consistency check for destination if [ $argc -gt 2 -a $dstisdir = 0 ]; then echo "$msgprefix:Error: multiple sources require destination to be directory" 1>&2 exit 1 fi # iterate over all source(s) for src in $srcs; do dst=$dstpath # If destination is a directory, append the input filename if [ $dstisdir = 1 ]; then dstfile=`echo "$src" | sed -e 's;.*/\([^/]*\)$;\1;'` dst="$dst/$dstfile" fi # Add a possible extension to src and dst if [ ".$opt_e" != . ]; then src="$src$opt_e" dst="$dst$opt_e" fi # Check for correct arguments if [ ".$src" = ".$dst" ]; then echo "$msgprefix:Warning: source and destination are the same - skipped" 1>&2 continue fi if [ -d "$src" ]; then echo "$msgprefix:Warning: source \`$src' is a directory - skipped" 1>&2 continue fi # Make a temp file name in the destination directory dsttmp=`echo $dst |\ sed -e 's;[^/]*$;;' -e 's;\(.\)/$;\1;' -e 's;^$;.;' \ -e "s;\$;/#INST@$$#;"` # Verbosity if [ ".$opt_v" = .yes ]; then echo "$src -> $dst" 1>&2 fi # Copy or move the file name to the temp name # (because we might be not allowed to change the source) if [ ".$opt_C" = .yes ]; then opt_c=yes fi if [ ".$opt_c" = .yes ]; then if [ ".$opt_t" = .yes ]; then echo "cp $src $dsttmp" 1>&2 fi cp $src $dsttmp || exit $? else if [ ".$opt_t" = .yes ]; then echo "mv $src $dsttmp" 1>&2 fi mv $src $dsttmp || exit $? fi # Adjust the target file # (we do chmod last to preserve setuid bits) if [ ".$opt_s" = .yes ]; then if [ ".$opt_t" = .yes ]; then echo "strip $dsttmp" 1>&2 fi strip $dsttmp || exit $? fi if [ ".$opt_o" != . ]; then if [ ".$opt_t" = .yes ]; then echo "chown $opt_o $dsttmp" 1>&2 fi chown $opt_o $dsttmp || exit $? fi if [ ".$opt_g" != . ]; then if [ ".$opt_t" = .yes ]; then echo "chgrp $opt_g $dsttmp" 1>&2 fi chgrp $opt_g $dsttmp || exit $? fi if [ ".$opt_m" != . ]; then if [ ".$opt_t" = .yes ]; then echo "chmod $opt_m $dsttmp" 1>&2 fi chmod $opt_m $dsttmp || exit $? fi # Determine whether to do a quick install # (has to be done _after_ the strip was already done) quick=no if [ ".$opt_C" = .yes ]; then if [ -r $dst ]; then if cmp -s $src $dst; then quick=yes fi fi fi # Finally install the file to the real destination if [ $quick = yes ]; then if [ ".$opt_t" = .yes ]; then echo "rm -f $dsttmp" 1>&2 fi rm -f $dsttmp else if [ ".$opt_t" = .yes ]; then echo "rm -f $dst && mv $dsttmp $dst" 1>&2 fi rm -f $dst && mv $dsttmp $dst fi done ;; mkdir ) ## ## mkdir -- Make one or more directories ## Copyright (c) 1996-2000 Ralf S. Engelschall ## Originally written for public domain by Noah Friedman ## Cleaned up and enhanced for shtool ## errstatus=0 for p in ${1+"$@"}; do # if the directory already exists... if [ -d "$p" ]; then if [ ".$opt_f" = .no ] && [ ".$opt_p" = .no ]; then echo "$msgprefix:Error: directory already exists: $p" 1>&2 errstatus=1 break else continue fi fi # if the directory has to be created... if [ ".$opt_p" = .no ]; then if [ ".$opt_t" = .yes ]; then echo "mkdir $p" 1>&2 fi mkdir $p || errstatus=$? else # the smart situation set fnord `echo ":$p" |\ sed -e 's/^:\//%/' \ -e 's/^://' \ -e 's/\// /g' \ -e 's/^%/\//'` shift pathcomp='' for d in ${1+"$@"}; do pathcomp="$pathcomp$d" case "$pathcomp" in -* ) pathcomp="./$pathcomp" ;; esac if [ ! -d "$pathcomp" ]; then if [ ".$opt_t" = .yes ]; then echo "mkdir $pathcomp" 1>&2 fi mkdir $pathcomp || errstatus=$? if [ ".$opt_m" != . ]; then if [ ".$opt_t" = .yes ]; then echo "chmod $opt_m $pathcomp" 1>&2 fi chmod $opt_m $pathcomp || errstatus=$? fi fi pathcomp="$pathcomp/" done fi done exit $errstatus ;; fixperm ) ## ## fixperm -- Fix file permissions inside a source tree ## Copyright (c) 1996-2000 Ralf S. Engelschall ## Originally written for ePerl ## paths="$*" # check whether the test command supports the -x option if [ -x /bin/sh ] 2>/dev/null; then minusx="-x" else minusx="-r" fi # iterate over paths for p in $paths; do for file in `find $p -depth -print`; do if [ -f $file ]; then if [ $minusx $file ]; then if [ ".$opt_v" = .yes ]; then echo "-rwxrwxr-x $file" 2>&1 fi if [ ".$opt_t" = .yes ]; then echo "chmod 775 $file" 2>&1 fi chmod 775 $file else if [ ".$opt_v" = .yes ]; then echo "-rw-rw-r-- $file" 2>&1 fi if [ ".$opt_t" = .yes ]; then echo "chmod 664 $file" 2>&1 fi chmod 664 $file fi continue fi if [ -d $file ]; then if [ ".$opt_v" = .yes ]; then echo "drwxrwxr-x $file" 2>&1 fi if [ ".$opt_t" = .yes ]; then echo "chmod 775 $file" 2>&1 fi chmod 775 $file continue fi if [ ".$opt_v" = .yes ]; then echo "?????????? $file" 2>&1 fi done done ;; version ) ## ## version -- Maintain a version information file ## Copyright (c) 1994-2000 Ralf S. Engelschall ## Originally written for ePerl, rewritten from scratch for shtool ## file="$1" # determine prefix and name name="$opt_n" prefix="$opt_p" # determine current version triple="$opt_s" if [ ".$triple" != . ]; then # use given triple if [ ".`echo $triple | grep '[0-9]*.[0-9]*[sabp.][0-9]*'`" = . ]; then echo "$msgprefix:Error: invalid argument to option \`-s': \`$opt_s'" 1>&2 exit 1 fi eval `echo $triple |\ sed -e 's%\([0-9]*\)\.\([0-9]*\)\([sabp.]\)\([0-9]*\).*%\ ver="\1";rev="\2";typ="\3";lev="\4"%'` tim=calc elif [ -r $file ]; then # determine triple from given file eval `grep 'Version [0-9]*.[0-9]*[sabp.][0-9]* ([0-9]*-[a-zA-Z]*-[0-9]*)' $file |\ head -1 | sed -e 's%.*Version \([0-9]*\)\.\([0-9]*\)\([sabp.]\)\([0-9]*\) (\([0-9]*-[a-zA-Z]*-[0-9]*\)).*%\ ver="\1";rev="\2";typ="\3";lev="\4";tim="\5"%'` else # intialise to first version ver=0 rev=1 typ=. lev=0 tim=calc fi # determine new version in batch if [ ".$opt_i" != . ]; then case $opt_i in v ) ver=`expr $ver + 1` rev=0 lev=0 ;; r ) rev=`expr $rev + 1` lev=0 ;; l ) lev=`expr $lev + 1` ;; * ) echo "$msgprefix:Error: invalid argument to option \`-i': \`$opt_i'" 1>&2 exit 1 ;; esac tim=calc fi # determine new version interactively if [ ".$opt_e" = .yes ]; then echo "old version: ${ver}.${rev}${typ}${lev}" while [ 1 ]; do echo dummy | awk '{ printf("new version: "); }' read triple case $triple in [0-9]*.[0-9]*[sabp.][0-9]* ) ;; * ) echo "$msgprefix:Error: invalid version string entered: \`$triple'" 1>&2 continue ;; esac break done eval `echo $triple |\ sed -e 's%^\([0-9]*\)\.\([0-9]*\)\([sabp.]\)\([0-9]*\)$%\ ver="\1";rev="\2";typ="\3";lev="\4"%'` tim=calc fi # determine hexadecimal and libtool value of version case $typ in a ) typnum=0; levnum=$lev ;; b ) typnum=1; levnum=$lev ;; p | . ) typnum=2; levnum=$lev ;; s ) typnum=15; levnum=255 ;; # snapshots are special esac hex=`echo "$ver:$rev:$typnum:$levnum" |\ awk -F: '{ printf("0x%x%02x%1x%02x", $1, $2, $3, $4); }' |\ tr 'abcdef' 'ABCDEF'` ltv=`echo "$ver:$rev:$typnum:$levnum" |\ awk -F: '{ printf("%d:%d", $1*10 + $2, $3*10 + $4); }'` # determine date if [ ".$tim" = .calc ]; then day=`date '+%d'` month=`date '+%m'` year=`date '+%Y' 2>/dev/null` if [ ".$time_year" = . ]; then year=`date '+%y'` case $year in [5-9][0-9]) year="19$year" ;; [0-4][0-9]) year="20$year" ;; esac fi case $month in 1|01) month='Jan' ;; 2|02) month='Feb' ;; 3|03) month='Mar' ;; 4|04) month='Apr' ;; 5|05) month='May' ;; 6|06) month='Jun' ;; 7|07) month='Jul' ;; 8|08) month='Aug' ;; 9|09) month='Sep' ;; 10) month='Oct' ;; 11) month='Nov' ;; 12) month='Dec' ;; esac tim="${day}-${month}-${year}" fi # perform result actions mode=show if [ ".$opt_i" != . ]; then mode=edit elif [ ".$opt_e" = .yes ]; then mode=edit elif [ ".$opt_s" != . ]; then mode=edit fi if [ ".$mode" = .show ]; then # just display the current version case $opt_d in short ) echo "${ver}.${rev}${typ}${lev}" ;; long ) echo "${ver}.${rev}${typ}${lev} ($tim)" ;; libtool ) echo "${ltv}" ;; hex ) echo "${hex}" ;; * ) echo "$msgprefix:Error: invalid argument to option \`-d': \`$opt_d'" 1>&2 exit 1 ;; esac else # update the version file # pre-generate various strings triple="${ver}.${rev}${typ}${lev}" vHex="$hex" vShort="${triple}" vLong="${triple} (${tim})" vTeX="This is ${name}, Version ${triple} (${tim})" vGNU="${name} ${triple} (${tim})" vWeb="${name}/${triple}" vSCCS="@(#)${name} ${triple} (${tim})" vRCS="\$Id: ${name} ${triple} (${tim}) \$" # determine string out of filename # (do NOT try to optimize this in any way because of portability) filestr=`echo $file |\ tr 'abcdefghijklmnopqrstuvwxyz./%+' \ 'ABCDEFGHIJKLMNOPQRSTUVWXYZ____' | sed -e 's/-/_/g'` # generate uppercase prefix prefixupper=`echo $prefix |\ tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` # create the version file according the the selected language echo "new version: ${vLong}" cp /dev/null $file case $opt_l in txt ) echo >>$file "" echo >>$file " ${file} -- Version Information for ${name} (syntax: Text)" echo >>$file " [automatically generated and maintained by GNU shtool]" echo >>$file "" echo >>$file " $vTeX" echo >>$file "" ;; c ) echo >>$file "/*" echo >>$file "** ${file} -- Version Information for ${name} (syntax: C/C++)" echo >>$file "** [automatically generated and maintained by GNU shtool]" echo >>$file "*/" echo >>$file "" echo >>$file "#ifdef _${filestr}_AS_HEADER_" echo >>$file "" echo >>$file "#ifndef _${filestr}_" echo >>$file "#define _${filestr}_" echo >>$file "" echo >>$file "#define ${prefixupper}VERSION ${vHex}" echo >>$file "" echo >>$file "typedef struct {" echo >>$file " const int v_hex;" echo >>$file " const char *v_short;" echo >>$file " const char *v_long;" echo >>$file " const char *v_tex;" echo >>$file " const char *v_gnu;" echo >>$file " const char *v_web;" echo >>$file " const char *v_sccs;" echo >>$file " const char *v_rcs;" echo >>$file "} ${prefix}version_t;" echo >>$file "" echo >>$file "extern ${prefix}version_t ${prefix}version;" echo >>$file "" echo >>$file "#endif /* _${filestr}_ */" echo >>$file "" echo >>$file "#else /* _${filestr}_AS_HEADER_ */" echo >>$file "" echo >>$file "#define _${filestr}_AS_HEADER_" echo >>$file "#include \"${file}\"" echo >>$file "#undef _${filestr}_AS_HEADER_" echo >>$file "" echo >>$file "${prefix}version_t ${prefix}version = {" echo >>$file " ${vHex}," echo >>$file " \"${vShort}\"," echo >>$file " \"${vLong}\"," echo >>$file " \"${vTeX}\"," echo >>$file " \"${vGNU}\"," echo >>$file " \"${vWeb}\"," echo >>$file " \"${vSCCS}\"," echo >>$file " \"${vRCS}\"" echo >>$file "};" echo >>$file "" echo >>$file "#endif /* _${filestr}_AS_HEADER_ */" echo >>$file "" ;; perl ) echo >>$file "##" echo >>$file "## ${file} -- Version Information for ${name} (syntax: Perl)" echo >>$file "## [automatically generated and maintained by GNU shtool]" echo >>$file "##" echo >>$file "" echo >>$file "my \$${prefix}version = {" echo >>$file " 'v_hex' => ${vHex}," echo >>$file " 'v_short' => \"${vShort}\"," echo >>$file " 'v_long' => \"${vLong}\"," echo >>$file " 'v_tex' => \"${vTeX}\"," echo >>$file " 'v_gnu' => \"${vGNU}\"," echo >>$file " 'v_web' => \"${vWeb}\"," echo >>$file " 'v_sccs' => \"${vSCCS}\"," echo >>$file " 'v_rcs' => \"\\${vRCS}/\"" echo >>$file "};" echo >>$file "" echo >>$file "1;" echo >>$file "" ;; python ) echo >>$file "##" echo >>$file "## ${file} -- Version Information for ${name} (syntax: Python)" echo >>$file "## [automatically generated and maintained by GNU shtool]" echo >>$file "##" echo >>$file "" echo >>$file "class ${prefix}version:" echo >>$file " v_hex = ${vHex}" echo >>$file " v_short = \"${vShort}\"" echo >>$file " v_long = \"${vLong}\"" echo >>$file " v_tex = \"${vTeX}\"" echo >>$file " v_gnu = \"${vGNU}\"" echo >>$file " v_web = \"${vWeb}\"" echo >>$file " v_sccs = \"${vSCCS}\"" echo >>$file " v_rcs = \"${vRCS}\"" echo >>$file "" ;; * ) echo "$msgprefix:Error: invalid argument to option \`-l': \`$opt_l'" 1>&2 exit 1 ;; esac fi ;; esac exit 0 ##EOF## slice-1.3.8/INSTALL0100664000000000000000000000070606715575414013134 0ustar barbierslice _ _ ___| (_) ___ ___ / __| | |/ __/ _ \ \__ \ | | (_| __/ |___/_|_|\___\___| Slice -- Extract pre-defined slices of an ASCII file INSTALLATION 1. Make sure you have Perl Version 5.003 or 5.004 already installed on your system. 2. Configure the package and create the script: $ ./configure --prefix=/usr/local $ make 3. Install the binary and manual page: $ make install slice-1.3.8/lib/00README0100664000000000000000000000024406715575415013667 0ustar barbierslice getoptlong/ ........ GetoptLong-2.13 from Johan Vromans bitvector/ .... .... Bit-Vector-5.0b4 from Steffen Beyer io/ ................ IO-1.19 from Graham Barr slice-1.3.8/lib/bitvector/BitVector.c0100664000000000000000000031136607257724263016726 0ustar barbierslice#ifndef MODULE_BIT_VECTOR #define MODULE_BIT_VECTOR /*****************************************************************************/ /* MODULE NAME: BitVector.c MODULE TYPE: (adt) */ /*****************************************************************************/ /* MODULE IMPORTS: */ /*****************************************************************************/ #include /* MODULE TYPE: (sys) */ #include /* MODULE TYPE: (sys) */ #include /* MODULE TYPE: (sys) */ #include /* MODULE TYPE: (sys) */ #include "ToolBox.h" /* MODULE TYPE: (dat) */ /*****************************************************************************/ /* MODULE INTERFACE: */ /*****************************************************************************/ typedef enum { ErrCode_Ok = 0, /* everything went allright */ ErrCode_Type, /* types word and size_t have incompatible sizes */ ErrCode_Bits, /* bits of word and sizeof(word) are inconsistent */ ErrCode_Word, /* size of word is less than 16 bits */ ErrCode_Long, /* size of word is greater than size of long */ ErrCode_Powr, /* number of bits of word is not a power of two */ ErrCode_Loga, /* error in calculation of logarithm */ ErrCode_Null, /* unable to allocate memory */ ErrCode_Indx, /* index out of range */ ErrCode_Ordr, /* minimum > maximum index */ ErrCode_Size, /* bit vector size mismatch */ ErrCode_Pars, /* input string syntax error */ ErrCode_Ovfl, /* numeric overflow error */ ErrCode_Same, /* operands must be distinct */ ErrCode_Expo, /* exponent must be positive */ ErrCode_Zero /* division by zero error */ } ErrCode; /* ===> MISCELLANEOUS: <=== */ ErrCode BitVector_Boot (void); /* 0 = ok, 1..7 = error */ N_word BitVector_Size (N_int bits); /* bit vector size (# of words) */ N_word BitVector_Mask (N_int bits); /* bit vector mask (unused bits) */ /* ===> CLASS METHODS: <=== */ charptr BitVector_Version (void); /* returns version string */ N_int BitVector_Word_Bits (void); /* returns # of bits in machine word */ N_int BitVector_Long_Bits (void); /* returns # of bits in unsigned long */ wordptr BitVector_Create(N_int bits, boolean clear); /* malloc */ /* ===> OBJECT METHODS: <=== */ wordptr BitVector_Shadow (wordptr addr); /* makes new, same size but empty */ wordptr BitVector_Clone (wordptr addr); /* makes exact duplicate */ wordptr BitVector_Concat (wordptr X, wordptr Y); /* returns concatenation */ wordptr BitVector_Resize (wordptr oldaddr, N_int bits); /* realloc */ void BitVector_Destroy (wordptr addr); /* free */ /* ===> bit vector copy function: */ void BitVector_Copy (wordptr X, wordptr Y); /* X = Y */ /* ===> bit vector initialization: */ void BitVector_Empty (wordptr addr); /* X = {} */ void BitVector_Fill (wordptr addr); /* X = ~{} */ void BitVector_Flip (wordptr addr); /* X = ~X */ void BitVector_Primes (wordptr addr); /* ===> miscellaneous functions: */ void BitVector_Reverse (wordptr X, wordptr Y); /* ===> bit vector interval operations and functions: */ void BitVector_Interval_Empty (wordptr addr, N_int lower, N_int upper); void BitVector_Interval_Fill (wordptr addr, N_int lower, N_int upper); void BitVector_Interval_Flip (wordptr addr, N_int lower, N_int upper); void BitVector_Interval_Reverse (wordptr addr, N_int lower, N_int upper); boolean BitVector_interval_scan_inc(wordptr addr, N_int start, N_intptr min, N_intptr max); boolean BitVector_interval_scan_dec(wordptr addr, N_int start, N_intptr min, N_intptr max); void BitVector_Interval_Copy (wordptr X, wordptr Y, N_int Xoffset, N_int Yoffset, N_int length); wordptr BitVector_Interval_Substitute(wordptr X, wordptr Y, N_int Xoffset, N_int Xlength, N_int Yoffset, N_int Ylength); /* ===> bit vector test functions: */ boolean BitVector_is_empty (wordptr addr); /* X == {} ? */ boolean BitVector_is_full (wordptr addr); /* X == ~{} ? */ boolean BitVector_equal (wordptr X, wordptr Y); /* X == Y ? */ Z_int BitVector_Lexicompare (wordptr X, wordptr Y); /* X <,=,> Y ? */ Z_int BitVector_Compare (wordptr X, wordptr Y); /* X <,=,> Y ? */ /* ===> bit vector string conversion functions: */ charptr BitVector_to_Hex (wordptr addr); ErrCode BitVector_from_Hex(wordptr addr, charptr string); charptr BitVector_to_Bin (wordptr addr); ErrCode BitVector_from_Bin(wordptr addr, charptr string); charptr BitVector_to_Dec (wordptr addr); ErrCode BitVector_from_Dec(wordptr addr, charptr string); charptr BitVector_to_Enum (wordptr addr); ErrCode BitVector_from_Enum(wordptr addr, charptr string); void BitVector_Dispose (charptr string); /* ===> bit vector bit operations, functions & tests: */ void BitVector_Bit_Off (wordptr addr, N_int index); /* X = X \ {x} */ void BitVector_Bit_On (wordptr addr, N_int index); /* X = X + {x} */ boolean BitVector_bit_flip(wordptr addr, N_int index); /* X=(X+{x})\(X*{x}) */ boolean BitVector_bit_test(wordptr addr, N_int index); /* {x} in X ? */ void BitVector_Bit_Copy(wordptr addr, N_int index, boolean bit); /* ===> bit vector bit shift & rotate functions: */ void BitVector_LSB (wordptr addr, boolean bit); void BitVector_MSB (wordptr addr, boolean bit); boolean BitVector_lsb (wordptr addr); boolean BitVector_msb (wordptr addr); boolean BitVector_rotate_left (wordptr addr); boolean BitVector_rotate_right(wordptr addr); boolean BitVector_shift_left (wordptr addr, boolean carry_in); boolean BitVector_shift_right (wordptr addr, boolean carry_in); void BitVector_Move_Left (wordptr addr, N_int bits); void BitVector_Move_Right (wordptr addr, N_int bits); /* ===> bit vector insert/delete bits: */ void BitVector_Insert (wordptr addr, N_int offset, N_int count, boolean clear); void BitVector_Delete (wordptr addr, N_int offset, N_int count, boolean clear); /* ===> bit vector arithmetic: */ boolean BitVector_increment (wordptr addr); /* X++ */ boolean BitVector_decrement (wordptr addr); /* X-- */ boolean BitVector_compute (wordptr X, wordptr Y, wordptr Z, boolean minus, boolean *carry); boolean BitVector_add (wordptr X, wordptr Y, wordptr Z, boolean *carry); boolean BitVector_sub (wordptr X, wordptr Y, wordptr Z, boolean *carry); boolean BitVector_inc (wordptr X, wordptr Y); boolean BitVector_dec (wordptr X, wordptr Y); void BitVector_Negate (wordptr X, wordptr Y); void BitVector_Absolute(wordptr X, wordptr Y); Z_int BitVector_Sign (wordptr addr); ErrCode BitVector_Mul_Pos (wordptr X, wordptr Y, wordptr Z, boolean heedsign); ErrCode BitVector_Multiply(wordptr X, wordptr Y, wordptr Z); ErrCode BitVector_Div_Pos (wordptr Q, wordptr X, wordptr Y, wordptr R); ErrCode BitVector_Divide (wordptr Q, wordptr X, wordptr Y, wordptr R); ErrCode BitVector_GCD (wordptr X, wordptr Y, wordptr Z); ErrCode BitVector_Power (wordptr X, wordptr Y, wordptr Z); /* ===> direct memory access functions: */ void BitVector_Block_Store (wordptr addr, charptr buffer, N_int length); charptr BitVector_Block_Read (wordptr addr, N_intptr length); /* ===> word array functions: */ void BitVector_Word_Store (wordptr addr, N_int offset, N_int value); N_int BitVector_Word_Read (wordptr addr, N_int offset); void BitVector_Word_Insert (wordptr addr, N_int offset, N_int count, boolean clear); void BitVector_Word_Delete (wordptr addr, N_int offset, N_int count, boolean clear); /* ===> arbitrary size chunk functions: */ void BitVector_Chunk_Store (wordptr addr, N_int chunksize, N_int offset, N_long value); N_long BitVector_Chunk_Read (wordptr addr, N_int chunksize, N_int offset); /* ===> set operations: */ void Set_Union (wordptr X, wordptr Y, wordptr Z); /* X = Y + Z */ void Set_Intersection(wordptr X, wordptr Y, wordptr Z); /* X = Y * Z */ void Set_Difference (wordptr X, wordptr Y, wordptr Z); /* X = Y \ Z */ void Set_ExclusiveOr (wordptr X, wordptr Y, wordptr Z); /* X=(Y+Z)\(Y*Z) */ void Set_Complement (wordptr X, wordptr Y); /* X = ~Y */ /* ===> set functions: */ boolean Set_subset (wordptr X, wordptr Y); /* X subset Y ? */ N_int Set_Norm (wordptr addr); /* = | X | */ Z_long Set_Min (wordptr addr); /* = min(X) */ Z_long Set_Max (wordptr addr); /* = max(X) */ /* ===> matrix-of-booleans operations: */ void Matrix_Multiplication(wordptr X, N_int rowsX, N_int colsX, wordptr Y, N_int rowsY, N_int colsY, wordptr Z, N_int rowsZ, N_int colsZ); void Matrix_Product (wordptr X, N_int rowsX, N_int colsX, wordptr Y, N_int rowsY, N_int colsY, wordptr Z, N_int rowsZ, N_int colsZ); void Matrix_Closure (wordptr addr, N_int rows, N_int cols); void Matrix_Transpose (wordptr X, N_int rowsX, N_int colsX, wordptr Y, N_int rowsY, N_int colsY); /*****************************************************************************/ /* MODULE RESOURCES: */ /*****************************************************************************/ #define bits_(BitVector) *(BitVector-3) #define size_(BitVector) *(BitVector-2) #define mask_(BitVector) *(BitVector-1) /*****************************************************************************/ /* MODULE IMPLEMENTATION: */ /*****************************************************************************/ /**********************************************/ /* global implementation-intrinsic constants: */ /**********************************************/ #define BIT_VECTOR_HIDDEN_WORDS 3 /*****************************************************************/ /* global machine-dependent constants (set by "BitVector_Boot"): */ /*****************************************************************/ static N_word BITS; /* = # of bits in machine word (must be power of 2) */ static N_word MODMASK; /* = BITS - 1 (mask for calculating modulo BITS) */ static N_word LOGBITS; /* = ld(BITS) (logarithmus dualis) */ static N_word FACTOR; /* = ld(BITS / 8) (ld of # of bytes) */ static N_word LSB = 1; /* = mask for least significant bit */ static N_word MSB; /* = mask for most significant bit */ static N_word LONGBITS; /* = # of bits in unsigned long */ static N_word LOG10; /* = logarithm to base 10 of BITS - 1 */ static N_word EXP10; /* = largest possible power of 10 in signed int */ /********************************************************************/ /* global bit mask table for fast access (set by "BitVector_Boot"): */ /********************************************************************/ static wordptr BITMASKTAB; /*****************************/ /* global macro definitions: */ /*****************************/ #define BIT_VECTOR_ZERO_WORDS(target,count) \ while (count-- > 0) *target++ = 0; #define BIT_VECTOR_FILL_WORDS(target,fill,count) \ while (count-- > 0) *target++ = fill; #define BIT_VECTOR_FLIP_WORDS(target,flip,count) \ while (count-- > 0) *target++ ^= flip; #define BIT_VECTOR_COPY_WORDS(target,source,count) \ while (count-- > 0) *target++ = *source++; #define BIT_VECTOR_BACK_WORDS(target,source,count) \ { target += count; source += count; while (count-- > 0) *--target = *--source; } #define BIT_VECTOR_CLR_BIT(address,index) \ *(address+(index>>LOGBITS)) &= NOT BITMASKTAB[index AND MODMASK]; #define BIT_VECTOR_SET_BIT(address,index) \ *(address+(index>>LOGBITS)) |= BITMASKTAB[index AND MODMASK]; #define BIT_VECTOR_TST_BIT(address,index) \ ((*(address+(index>>LOGBITS)) AND BITMASKTAB[index AND MODMASK]) != 0) #define BIT_VECTOR_FLP_BIT(address,index,mask) \ (mask = BITMASKTAB[index AND MODMASK]), \ (((*(addr+(index>>LOGBITS)) ^= mask) AND mask) != 0) #define BIT_VECTOR_DIGITIZE(type,value,digit) \ value = (type) ((digit = value) / 10); \ digit -= value * 10; \ digit += (type) '0'; /*********************************************************/ /* private low-level functions (potentially dangerous!): */ /*********************************************************/ static N_word power10(N_word x) { N_word y = 1; while (x-- > 0) y *= 10; return(y); } static void BIT_VECTOR_zro_words(wordptr addr, N_word count) { BIT_VECTOR_ZERO_WORDS(addr,count) } static void BIT_VECTOR_cpy_words(wordptr target, wordptr source, N_word count) { BIT_VECTOR_COPY_WORDS(target,source,count) } static void BIT_VECTOR_mov_words(wordptr target, wordptr source, N_word count) { if (target != source) { if (target < source) BIT_VECTOR_COPY_WORDS(target,source,count) else BIT_VECTOR_BACK_WORDS(target,source,count) } } static void BIT_VECTOR_ins_words(wordptr addr, N_word total, N_word count, boolean clear) { N_word length; if ((total > 0) and (count > 0)) { if (count > total) count = total; length = total - count; if (length > 0) BIT_VECTOR_mov_words(addr+count,addr,length); if (clear) BIT_VECTOR_zro_words(addr,count); } } static void BIT_VECTOR_del_words(wordptr addr, N_word total, N_word count, boolean clear) { N_word length; if ((total > 0) and (count > 0)) { if (count > total) count = total; length = total - count; if (length > 0) BIT_VECTOR_mov_words(addr,addr+count,length); if (clear) BIT_VECTOR_zro_words(addr+length,count); } } static void BIT_VECTOR_reverse(charptr string, N_word length) { charptr last; N_char temp; if (length > 1) { last = string + length - 1; while (string < last) { temp = *string; *string = *last; *last = temp; string++; last--; } } } static N_word BIT_VECTOR_int2str(charptr string, N_word value) { N_word length; N_word digit; charptr work; work = string; if (value > 0) { length = 0; while (value > 0) { BIT_VECTOR_DIGITIZE(N_word,value,digit) *work++ = (N_char) digit; length++; } BIT_VECTOR_reverse(string,length); } else { length = 1; *work++ = (N_char) '0'; } return(length); } static N_word BIT_VECTOR_str2int(charptr string, N_word *value) { N_word length; N_word digit; *value = 0; length = 0; digit = (N_word) *string++; /* separate because isdigit() is likely a macro! */ while (isdigit(digit) != 0) { length++; digit -= (N_word) '0'; if (*value) *value *= 10; *value += digit; digit = (N_word) *string++; } return(length); } /*****************************************/ /* automatic self-configuration routine: */ /*****************************************/ /*******************************************************/ /* */ /* MUST be called once prior to any other function */ /* to initialize the machine dependent constants */ /* of this package! (But call only ONCE!) */ /* */ /*******************************************************/ ErrCode BitVector_Boot(void) { N_long longsample = 1L; N_word sample = LSB; N_word lsb; if (sizeof(N_word) > sizeof(size_t)) return(ErrCode_Type); BITS = 1; while (sample <<= 1) BITS++; /* determine # of bits in a machine word */ if (BITS != (sizeof(N_word) << 3)) return(ErrCode_Bits); if (BITS < 16) return(ErrCode_Word); LONGBITS = 1; while (longsample <<= 1) LONGBITS++; /* = # of bits in an unsigned long */ if (BITS > LONGBITS) return(ErrCode_Long); LOGBITS = 0; sample = BITS; lsb = (sample AND LSB); while ((sample >>= 1) and (not lsb)) { LOGBITS++; lsb = (sample AND LSB); } if (sample) return(ErrCode_Powr); /* # of bits is not a power of 2! */ if (BITS != (LSB << LOGBITS)) return(ErrCode_Loga); MODMASK = BITS - 1; FACTOR = LOGBITS - 3; /* ld(BITS / 8) = ld(BITS) - ld(8) = ld(BITS) - 3 */ MSB = (LSB << MODMASK); BITMASKTAB = (wordptr) malloc((size_t) (BITS << FACTOR)); if (BITMASKTAB == NULL) return(ErrCode_Null); for ( sample = 0; sample < BITS; sample++ ) { BITMASKTAB[sample] = (LSB << sample); } LOG10 = (N_word) (MODMASK * 0.30103); /* = (BITS - 1) * ( ln 2 / ln 10 ) */ EXP10 = power10(LOG10); return(ErrCode_Ok); } N_word BitVector_Size(N_int bits) /* bit vector size (# of words) */ { N_word size; size = bits >> LOGBITS; if (bits AND MODMASK) size++; return(size); } N_word BitVector_Mask(N_int bits) /* bit vector mask (unused bits) */ { N_word mask; mask = bits AND MODMASK; if (mask) mask = (N_word) ~(~0L << mask); else mask = (N_word) ~0L; return(mask); } charptr BitVector_Version(void) { return((charptr)"6.0"); } N_int BitVector_Word_Bits(void) { return(BITS); } N_int BitVector_Long_Bits(void) { return(LONGBITS); } wordptr BitVector_Create(N_int bits, boolean clear) /* malloc */ { N_word size; N_word mask; N_word bytes; wordptr addr; wordptr zero; size = BitVector_Size(bits); mask = BitVector_Mask(bits); bytes = (size + BIT_VECTOR_HIDDEN_WORDS) << FACTOR; addr = (wordptr) malloc((size_t) bytes); if (addr != NULL) { *addr++ = bits; *addr++ = size; *addr++ = mask; if (clear) { zero = addr; BIT_VECTOR_ZERO_WORDS(zero,size) } } return(addr); } wordptr BitVector_Shadow(wordptr addr) /* makes new, same size but empty */ { return( BitVector_Create(bits_(addr),true) ); } wordptr BitVector_Clone(wordptr addr) /* makes exact duplicate */ { N_word bits; wordptr twin; bits = bits_(addr); twin = BitVector_Create(bits,false); if ((twin != NULL) and (bits > 0)) BIT_VECTOR_cpy_words(twin,addr,size_(addr)); return(twin); } wordptr BitVector_Concat(wordptr X, wordptr Y) /* returns concatenation */ { /* BEWARE that X = most significant part, Y = least significant part! */ N_word bitsX; N_word bitsY; N_word bitsZ; wordptr Z; bitsX = bits_(X); bitsY = bits_(Y); bitsZ = bitsX + bitsY; Z = BitVector_Create(bitsZ,false); if ((Z != NULL) and (bitsZ > 0)) { BIT_VECTOR_cpy_words(Z,Y,size_(Y)); BitVector_Interval_Copy(Z,X,bitsY,0,bitsX); *(Z+size_(Z)-1) &= mask_(Z); } return(Z); } wordptr BitVector_Resize(wordptr oldaddr, N_int bits) /* realloc */ { N_word bytes; N_word oldsize; N_word oldmask; N_word newsize; N_word newmask; wordptr newaddr; wordptr source; wordptr target; oldsize = size_(oldaddr); oldmask = mask_(oldaddr); newsize = BitVector_Size(bits); newmask = BitVector_Mask(bits); if (oldsize > 0) *(oldaddr+oldsize-1) &= oldmask; if (newsize <= oldsize) { newaddr = oldaddr; bits_(newaddr) = bits; size_(newaddr) = newsize; mask_(newaddr) = newmask; if (newsize > 0) *(newaddr+newsize-1) &= newmask; } else { bytes = (newsize + BIT_VECTOR_HIDDEN_WORDS) << FACTOR; newaddr = (wordptr) malloc((size_t) bytes); if (newaddr != NULL) { *newaddr++ = bits; *newaddr++ = newsize; *newaddr++ = newmask; target = newaddr; source = oldaddr; newsize -= oldsize; BIT_VECTOR_COPY_WORDS(target,source,oldsize) BIT_VECTOR_ZERO_WORDS(target,newsize) } BitVector_Destroy(oldaddr); } return(newaddr); } void BitVector_Destroy(wordptr addr) /* free */ { if (addr != NULL) { addr -= BIT_VECTOR_HIDDEN_WORDS; free((voidptr) addr); } } void BitVector_Copy(wordptr X, wordptr Y) /* X = Y */ { N_word sizeX = size_(X); N_word sizeY = size_(Y); N_word maskX = mask_(X); N_word maskY = mask_(Y); N_word fill = 0; wordptr lastX; wordptr lastY; if ((X != Y) and (sizeX > 0)) { lastX = X + sizeX - 1; if (sizeY > 0) { lastY = Y + sizeY - 1; *lastY &= maskY; while ((sizeX > 0) and (sizeY > 0)) { *X++ = *Y++; sizeX--; sizeY--; } if ( (*lastY AND (maskY AND NOT (maskY >> 1))) != 0 ) { fill = (N_word) ~0L; *(X-1) |= NOT maskY; } } while (sizeX-- > 0) *X++ = fill; *lastX &= maskX; } } void BitVector_Empty(wordptr addr) /* X = {} clr all */ { N_word size = size_(addr); BIT_VECTOR_ZERO_WORDS(addr,size) } void BitVector_Fill(wordptr addr) /* X = ~{} set all */ { N_word size = size_(addr); N_word mask = mask_(addr); N_word fill = (N_word) ~0L; if (size > 0) { BIT_VECTOR_FILL_WORDS(addr,fill,size) *(--addr) &= mask; } } void BitVector_Flip(wordptr addr) /* X = ~X flip all */ { N_word size = size_(addr); N_word mask = mask_(addr); N_word flip = (N_word) ~0L; if (size > 0) { BIT_VECTOR_FLIP_WORDS(addr,flip,size) *(--addr) &= mask; } } void BitVector_Primes(wordptr addr) { N_word bits = bits_(addr); N_word size = size_(addr); wordptr work; N_word temp; N_word i,j; if (size > 0) { temp = 0xAAAA; i = BITS >> 4; while (--i > 0) { temp <<= 16; temp |= 0xAAAA; } i = size; work = addr; *work++ = temp XOR 0x0006; while (--i > 0) *work++ = temp; for ( i = 3; (j = i * i) < bits; i += 2 ) { for ( ; j < bits; j += i ) BIT_VECTOR_CLR_BIT(addr,j) } *(addr+size-1) &= mask_(addr); } } void BitVector_Reverse(wordptr X, wordptr Y) { N_word bits = bits_(X); N_word mask; N_word bit; N_word value; if (bits > 0) { if (X == Y) BitVector_Interval_Reverse(X,0,bits-1); else if (bits == bits_(Y)) { /* mask = mask_(Y); */ /* mask &= NOT (mask >> 1); */ mask = BITMASKTAB[(bits-1) AND MODMASK]; Y += size_(Y) - 1; value = 0; bit = LSB; while (bits-- > 0) { if ((*Y AND mask) != 0) { value |= bit; } if (not (mask >>= 1)) { Y--; mask = MSB; } if (not (bit <<= 1)) { *X++ = value; value = 0; bit = LSB; } } if (bit > LSB) *X = value; } } } void BitVector_Interval_Empty(wordptr addr, N_int lower, N_int upper) { /* X = X \ [lower..upper] */ N_word bits = bits_(addr); N_word size = size_(addr); wordptr loaddr; wordptr hiaddr; N_word lobase; N_word hibase; N_word lomask; N_word himask; N_word diff; if ((size > 0) and (lower < bits) and (upper < bits) and (lower <= upper)) { lobase = lower >> LOGBITS; hibase = upper >> LOGBITS; diff = hibase - lobase; loaddr = addr + lobase; hiaddr = addr + hibase; lomask = (N_word) (~0L << (lower AND MODMASK)); himask = (N_word) ~((~0L << (upper AND MODMASK)) << 1); if (diff == 0) { *loaddr &= NOT (lomask AND himask); } else { *loaddr++ &= NOT lomask; while (--diff > 0) { *loaddr++ = 0; } *hiaddr &= NOT himask; } } } void BitVector_Interval_Fill(wordptr addr, N_int lower, N_int upper) { /* X = X + [lower..upper] */ N_word bits = bits_(addr); N_word size = size_(addr); N_word fill = (N_word) ~0L; wordptr loaddr; wordptr hiaddr; N_word lobase; N_word hibase; N_word lomask; N_word himask; N_word diff; if ((size > 0) and (lower < bits) and (upper < bits) and (lower <= upper)) { lobase = lower >> LOGBITS; hibase = upper >> LOGBITS; diff = hibase - lobase; loaddr = addr + lobase; hiaddr = addr + hibase; lomask = (N_word) (~0L << (lower AND MODMASK)); himask = (N_word) ~((~0L << (upper AND MODMASK)) << 1); if (diff == 0) { *loaddr |= (lomask AND himask); } else { *loaddr++ |= lomask; while (--diff > 0) { *loaddr++ = fill; } *hiaddr |= himask; } *(addr+size-1) &= mask_(addr); } } void BitVector_Interval_Flip(wordptr addr, N_int lower, N_int upper) { /* X = X ^ [lower..upper] */ N_word bits = bits_(addr); N_word size = size_(addr); N_word flip = (N_word) ~0L; wordptr loaddr; wordptr hiaddr; N_word lobase; N_word hibase; N_word lomask; N_word himask; N_word diff; if ((size > 0) and (lower < bits) and (upper < bits) and (lower <= upper)) { lobase = lower >> LOGBITS; hibase = upper >> LOGBITS; diff = hibase - lobase; loaddr = addr + lobase; hiaddr = addr + hibase; lomask = (N_word) (~0L << (lower AND MODMASK)); himask = (N_word) ~((~0L << (upper AND MODMASK)) << 1); if (diff == 0) { *loaddr ^= (lomask AND himask); } else { *loaddr++ ^= lomask; while (--diff > 0) { *loaddr++ ^= flip; } *hiaddr ^= himask; } *(addr+size-1) &= mask_(addr); } } void BitVector_Interval_Reverse(wordptr addr, N_int lower, N_int upper) { N_word bits = bits_(addr); wordptr loaddr; wordptr hiaddr; N_word lomask; N_word himask; if ((bits > 0) and (lower < bits) and (upper < bits) and (lower < upper)) { loaddr = addr + (lower >> LOGBITS); hiaddr = addr + (upper >> LOGBITS); lomask = BITMASKTAB[lower AND MODMASK]; himask = BITMASKTAB[upper AND MODMASK]; for ( bits = upper - lower + 1; bits > 1; bits -= 2 ) { if (((*loaddr AND lomask) != 0) XOR ((*hiaddr AND himask) != 0)) { *loaddr ^= lomask; /* swap bits only if they differ! */ *hiaddr ^= himask; } if (not (lomask <<= 1)) { lomask = LSB; loaddr++; } if (not (himask >>= 1)) { himask = MSB; hiaddr--; } } } } boolean BitVector_interval_scan_inc(wordptr addr, N_int start, N_intptr min, N_intptr max) { N_word size = size_(addr); N_word mask = mask_(addr); N_word offset; N_word bitmask; N_word value; boolean empty; if ((size == 0) or (start >= bits_(addr))) return(false); *min = start; *max = start; offset = start >> LOGBITS; *(addr+size-1) &= mask; addr += offset; size -= offset; bitmask = BITMASKTAB[start AND MODMASK]; mask = NOT (bitmask OR (bitmask - 1)); value = *addr++; if ((value AND bitmask) == 0) { value &= mask; if (value == 0) { offset++; empty = true; while (empty and (--size > 0)) { if (value = *addr++) empty = false; else offset++; } if (empty) return(false); } start = offset << LOGBITS; bitmask = LSB; mask = value; while (not (mask AND LSB)) { bitmask <<= 1; mask >>= 1; start++; } mask = NOT (bitmask OR (bitmask - 1)); *min = start; *max = start; } value = NOT value; value &= mask; if (value == 0) { offset++; empty = true; while (empty and (--size > 0)) { if (value = NOT *addr++) empty = false; else offset++; } if (empty) value = LSB; } start = offset << LOGBITS; while (not (value AND LSB)) { value >>= 1; start++; } *max = --start; return(true); } boolean BitVector_interval_scan_dec(wordptr addr, N_int start, N_intptr min, N_intptr max) { N_word size = size_(addr); N_word mask = mask_(addr); N_word offset; N_word bitmask; N_word value; boolean empty; if ((size == 0) or (start >= bits_(addr))) return(false); *min = start; *max = start; offset = start >> LOGBITS; if (offset >= size) return(false); *(addr+size-1) &= mask; addr += offset; size = ++offset; bitmask = BITMASKTAB[start AND MODMASK]; mask = (bitmask - 1); value = *addr--; if ((value AND bitmask) == 0) { value &= mask; if (value == 0) { offset--; empty = true; while (empty and (--size > 0)) { if (value = *addr--) empty = false; else offset--; } if (empty) return(false); } start = offset << LOGBITS; bitmask = MSB; mask = value; while (not (mask AND MSB)) { bitmask >>= 1; mask <<= 1; start--; } mask = (bitmask - 1); *max = --start; *min = start; } value = NOT value; value &= mask; if (value == 0) { offset--; empty = true; while (empty and (--size > 0)) { if (value = NOT *addr--) empty = false; else offset--; } if (empty) value = MSB; } start = offset << LOGBITS; while (not (value AND MSB)) { value <<= 1; start--; } *min = start; return(true); } void BitVector_Interval_Copy(wordptr X, wordptr Y, N_int Xoffset, N_int Yoffset, N_int length) { N_word bitsX = bits_(X); N_word bitsY = bits_(Y); N_word source; N_word target; N_word s_lo_base; N_word s_hi_base; N_word s_lo_bit; N_word s_hi_bit; N_word s_base; N_word s_lower; N_word s_upper; N_word s_bits; N_word s_min; N_word s_max; N_word t_lo_base; N_word t_hi_base; N_word t_lo_bit; N_word t_hi_bit; N_word t_base; N_word t_lower; N_word t_upper; N_word t_bits; N_word t_min; N_word mask; N_word bits; N_word select; boolean ascending; boolean notfirst; wordptr Z = X; if ((length > 0) and (Xoffset < bitsX) and (Yoffset < bitsY)) { if ((Xoffset + length) > bitsX) length = bitsX - Xoffset; if ((Yoffset + length) > bitsY) length = bitsY - Yoffset; ascending = (Xoffset <= Yoffset); s_lo_base = Yoffset >> LOGBITS; s_lo_bit = Yoffset AND MODMASK; Yoffset += --length; s_hi_base = Yoffset >> LOGBITS; s_hi_bit = Yoffset AND MODMASK; t_lo_base = Xoffset >> LOGBITS; t_lo_bit = Xoffset AND MODMASK; Xoffset += length; t_hi_base = Xoffset >> LOGBITS; t_hi_bit = Xoffset AND MODMASK; if (ascending) { s_base = s_lo_base; t_base = t_lo_base; } else { s_base = s_hi_base; t_base = t_hi_base; } s_bits = 0; t_bits = 0; Y += s_base; X += t_base; notfirst = false; while (true) { if (t_bits == 0) { if (notfirst) { *X = target; if (ascending) { if (t_base == t_hi_base) break; t_base++; X++; } else { if (t_base == t_lo_base) break; t_base--; X--; } } select = ((t_base == t_hi_base) << 1) OR (t_base == t_lo_base); switch (select) { case 0: t_lower = 0; t_upper = BITS - 1; t_bits = BITS; target = 0; break; case 1: t_lower = t_lo_bit; t_upper = BITS - 1; t_bits = BITS - t_lo_bit; mask = (N_word) (~0L << t_lower); target = *X AND NOT mask; break; case 2: t_lower = 0; t_upper = t_hi_bit; t_bits = t_hi_bit + 1; mask = (N_word) ((~0L << t_upper) << 1); target = *X AND mask; break; case 3: t_lower = t_lo_bit; t_upper = t_hi_bit; t_bits = t_hi_bit - t_lo_bit + 1; mask = (N_word) (~0L << t_lower); mask &= (N_word) ~((~0L << t_upper) << 1); target = *X AND NOT mask; break; } } if (s_bits == 0) { if (notfirst) { if (ascending) { if (s_base == s_hi_base) break; s_base++; Y++; } else { if (s_base == s_lo_base) break; s_base--; Y--; } } source = *Y; select = ((s_base == s_hi_base) << 1) OR (s_base == s_lo_base); switch (select) { case 0: s_lower = 0; s_upper = BITS - 1; s_bits = BITS; break; case 1: s_lower = s_lo_bit; s_upper = BITS - 1; s_bits = BITS - s_lo_bit; break; case 2: s_lower = 0; s_upper = s_hi_bit; s_bits = s_hi_bit + 1; break; case 3: s_lower = s_lo_bit; s_upper = s_hi_bit; s_bits = s_hi_bit - s_lo_bit + 1; break; } } notfirst = true; if (s_bits > t_bits) { bits = t_bits - 1; if (ascending) { s_min = s_lower; s_max = s_lower + bits; } else { s_max = s_upper; s_min = s_upper - bits; } t_min = t_lower; } else { bits = s_bits - 1; if (ascending) t_min = t_lower; else t_min = t_upper - bits; s_min = s_lower; s_max = s_upper; } bits++; mask = (N_word) (~0L << s_min); mask &= (N_word) ~((~0L << s_max) << 1); if (s_min == t_min) target |= (source AND mask); else { if (s_min < t_min) target |= (source AND mask) << (t_min-s_min); else target |= (source AND mask) >> (s_min-t_min); } if (ascending) { s_lower += bits; t_lower += bits; } else { s_upper -= bits; t_upper -= bits; } s_bits -= bits; t_bits -= bits; } *(Z+size_(Z)-1) &= mask_(Z); } } wordptr BitVector_Interval_Substitute(wordptr X, wordptr Y, N_int Xoffset, N_int Xlength, N_int Yoffset, N_int Ylength) { N_word Xbits = bits_(X); N_word Ybits = bits_(Y); N_word limit; N_word diff; if ((Xoffset <= Xbits) and (Yoffset <= Ybits)) { limit = Xoffset + Xlength; if (limit > Xbits) { limit = Xbits; Xlength = Xbits - Xoffset; } if ((Yoffset + Ylength) > Ybits) { Ylength = Ybits - Yoffset; } if (Xlength == Ylength) { if ((Ylength > 0) and ((X != Y) or (Xoffset != Yoffset))) { BitVector_Interval_Copy(X,Y,Xoffset,Yoffset,Ylength); } } else /* Xlength != Ylength */ { if (Xlength > Ylength) { diff = Xlength - Ylength; if (Ylength > 0) BitVector_Interval_Copy(X,Y,Xoffset,Yoffset,Ylength); if (limit < Xbits) BitVector_Delete(X,Xoffset+Ylength,diff,false); if ((X = BitVector_Resize(X,Xbits-diff)) == NULL) return(NULL); } else /* Ylength > Xlength ==> Ylength > 0 */ { diff = Ylength - Xlength; if (X != Y) { if ((X = BitVector_Resize(X,Xbits+diff)) == NULL) return(NULL); if (limit < Xbits) BitVector_Insert(X,limit,diff,false); BitVector_Interval_Copy(X,Y,Xoffset,Yoffset,Ylength); } else /* in-place */ { if ((Y = X = BitVector_Resize(X,Xbits+diff)) == NULL) return(NULL); if (limit >= Xbits) { BitVector_Interval_Copy(X,Y,Xoffset,Yoffset,Ylength); } else /* limit < Xbits */ { BitVector_Insert(X,limit,diff,false); if ((Yoffset+Ylength) <= limit) { BitVector_Interval_Copy(X,Y,Xoffset,Yoffset,Ylength); } else /* overlaps or lies above critical area */ { if (limit <= Yoffset) { Yoffset += diff; BitVector_Interval_Copy(X,Y,Xoffset,Yoffset,Ylength); } else /* Yoffset < limit */ { Xlength = limit - Yoffset; BitVector_Interval_Copy(X,Y,Xoffset,Yoffset,Xlength); Yoffset = Xoffset + Ylength; /* = limit + diff */ Xoffset += Xlength; Ylength -= Xlength; BitVector_Interval_Copy(X,Y,Xoffset,Yoffset,Ylength); } } } } } } } return(X); } boolean BitVector_is_empty(wordptr addr) /* X == {} ? */ { N_word size = size_(addr); boolean r = true; if (size > 0) { *(addr+size-1) &= mask_(addr); while (r and (size-- > 0)) r = ( *addr++ == 0 ); } return(r); } boolean BitVector_is_full(wordptr addr) /* X == ~{} ? */ { N_word size = size_(addr); N_word mask = mask_(addr); boolean r = false; wordptr last; if (size > 0) { r = true; last = addr + size - 1; *last |= NOT mask; while (r and (size-- > 0)) r = ( NOT *addr++ == 0 ); *last &= mask; } return(r); } boolean BitVector_equal(wordptr X, wordptr Y) /* X == Y ? */ { N_word size = size_(X); N_word mask = mask_(X); boolean r = false; if (bits_(X) == bits_(Y)) { r = true; if (size > 0) { *(X+size-1) &= mask; *(Y+size-1) &= mask; while (r and (size-- > 0)) r = (*X++ == *Y++); } } return(r); } Z_int BitVector_Lexicompare(wordptr X, wordptr Y) /* X <,=,> Y ? */ { /* unsigned */ N_word bitsX = bits_(X); N_word bitsY = bits_(Y); N_word size = size_(X); boolean r = true; if (bitsX == bitsY) { if (size > 0) { X += size; Y += size; while (r and (size-- > 0)) r = (*(--X) == *(--Y)); } if (r) return((Z_int) 0); else { if (*X < *Y) return((Z_int) -1); else return((Z_int) 1); } } else { if (bitsX < bitsY) return((Z_int) -1); else return((Z_int) 1); } } Z_int BitVector_Compare(wordptr X, wordptr Y) /* X <,=,> Y ? */ { /* signed */ N_word bitsX = bits_(X); N_word bitsY = bits_(Y); N_word size = size_(X); N_word mask = mask_(X); N_word sign; boolean r = true; if (bitsX == bitsY) { if (size > 0) { X += size; Y += size; mask &= NOT (mask >> 1); if ((sign = (*(X-1) AND mask)) != (*(Y-1) AND mask)) { if (sign) return((Z_int) -1); else return((Z_int) 1); } while (r and (size-- > 0)) r = (*(--X) == *(--Y)); } if (r) return((Z_int) 0); else { if (*X < *Y) return((Z_int) -1); else return((Z_int) 1); } } else { if (bitsX < bitsY) return((Z_int) -1); else return((Z_int) 1); } } charptr BitVector_to_Hex(wordptr addr) { N_word bits = bits_(addr); N_word size = size_(addr); N_word value; N_word count; N_word digit; N_word length; charptr string; length = bits >> 2; if (bits AND 0x0003) length++; string = (charptr) malloc((size_t) (length+1)); if (string == NULL) return(NULL); string += length; *string = (N_char) '\0'; if (size > 0) { *(addr+size-1) &= mask_(addr); while ((size-- > 0) and (length > 0)) { value = *addr++; count = BITS >> 2; while ((count-- > 0) and (length > 0)) { digit = value AND 0x000F; if (digit > 9) digit += (N_word) 'A' - 10; else digit += (N_word) '0'; *(--string) = (N_char) digit; length--; if ((count > 0) and (length > 0)) value >>= 4; } } } return(string); } ErrCode BitVector_from_Hex(wordptr addr, charptr string) { N_word size = size_(addr); N_word mask = mask_(addr); boolean ok = true; N_word length; N_word value; N_word count; int digit; if (size > 0) { length = strlen((char *) string); string += length; while (size-- > 0) { value = 0; for ( count = 0; (ok and (length > 0) and (count < BITS)); count += 4 ) { digit = (int) *(--string); length--; /* separate because toupper() is likely a macro! */ digit = toupper(digit); if (ok = (isxdigit(digit) != 0)) { if (digit >= (int) 'A') digit -= (int) 'A' - 10; else digit -= (int) '0'; value |= (((N_word) digit) << count); } } *addr++ = value; } *(--addr) &= mask; } if (ok) return(ErrCode_Ok); else return(ErrCode_Pars); } charptr BitVector_to_Bin(wordptr addr) { N_word size = size_(addr); N_word value; N_word count; N_word digit; N_word length; charptr string; length = bits_(addr); string = (charptr) malloc((size_t) (length+1)); if (string == NULL) return(NULL); string += length; *string = (N_char) '\0'; if (size > 0) { *(addr+size-1) &= mask_(addr); while (size-- > 0) { value = *addr++; count = BITS; if (count > length) count = length; while (count-- > 0) { digit = value AND 0x0001; digit += (N_word) '0'; *(--string) = (N_char) digit; length--; if (count > 0) value >>= 1; } } } return(string); } ErrCode BitVector_from_Bin(wordptr addr, charptr string) { N_word size = size_(addr); N_word mask = mask_(addr); boolean ok = true; N_word length; N_word value; N_word count; int digit; if (size > 0) { length = strlen((char *) string); string += length; while (size-- > 0) { value = 0; for ( count = 0; (ok and (length > 0) and (count < BITS)); count++ ) { digit = (int) *(--string); length--; switch (digit) { case (int) '0': break; case (int) '1': value |= BITMASKTAB[count]; break; default: ok = false; break; } } *addr++ = value; } *(--addr) &= mask; } if (ok) return(ErrCode_Ok); else return(ErrCode_Pars); } charptr BitVector_to_Dec(wordptr addr) { N_word bits = bits_(addr); N_word length; N_word digits; N_word count; N_word q; N_word r; boolean loop; charptr result; charptr string; wordptr quot; wordptr rest; wordptr temp; wordptr base; Z_int sign; length = (N_word) (bits / 3.3); /* digits = bits * ln(2) / ln(10) */ length += 2; /* compensate for truncating & provide space for minus sign */ result = (charptr) malloc((size_t) (length+1)); /* remember the '\0'! */ if (result == NULL) return(NULL); string = result; sign = BitVector_Sign(addr); if ((bits < 4) or (sign == 0)) { if (bits > 0) digits = *addr; else digits = (N_word) 0; if (sign < 0) digits = -digits AND mask_(addr); *string++ = (N_char) digits + (N_char) '0'; digits = 1; } else { quot = BitVector_Create(bits,false); if (quot == NULL) { BitVector_Dispose(result); return(NULL); } rest = BitVector_Create(bits,false); if (rest == NULL) { BitVector_Dispose(result); BitVector_Destroy(quot); return(NULL); } temp = BitVector_Create(bits,false); if (temp == NULL) { BitVector_Dispose(result); BitVector_Destroy(quot); BitVector_Destroy(rest); return(NULL); } base = BitVector_Create(bits,true); if (base == NULL) { BitVector_Dispose(result); BitVector_Destroy(quot); BitVector_Destroy(rest); BitVector_Destroy(temp); return(NULL); } if (sign < 0) BitVector_Negate(quot,addr); else BitVector_Copy(quot,addr); digits = 0; *base = EXP10; loop = (bits >= BITS); do { if (loop) { BitVector_Copy(temp,quot); if (BitVector_Div_Pos(quot,temp,base,rest)) { BitVector_Dispose(result); /* emergency exit */ BitVector_Destroy(quot); BitVector_Destroy(rest); /* should never occur */ BitVector_Destroy(temp); /* under normal operation */ BitVector_Destroy(base); return(NULL); } loop = not BitVector_is_empty(quot); q = *rest; } else q = *quot; count = LOG10; while (((loop and (count-- > 0)) or ((not loop) and (q != 0))) and (digits < length)) { if (q != 0) { BIT_VECTOR_DIGITIZE(N_word,q,r) } else r = (N_word) '0'; *string++ = (N_char) r; digits++; } } while (loop and (digits < length)); BitVector_Destroy(quot); BitVector_Destroy(rest); BitVector_Destroy(temp); BitVector_Destroy(base); } if ((sign < 0) and (digits < length)) { *string++ = (N_char) '-'; digits++; } *string = (N_char) '\0'; BIT_VECTOR_reverse(result,digits); return(result); } ErrCode BitVector_from_Dec(wordptr addr, charptr string) { ErrCode error = ErrCode_Ok; N_word bits = bits_(addr); N_word mask = mask_(addr); boolean init = (bits > BITS); boolean minus; boolean shift; boolean carry; wordptr term; wordptr base; wordptr prod; wordptr rank; wordptr temp; N_word prev; N_word accu; N_word powr; N_word count; N_word length; int digit; if (bits > 0) { length = strlen((char *) string); if (length == 0) return(ErrCode_Pars); digit = (int) *string; if ((minus = (digit == (int) '-')) or (digit == (int) '+')) { string++; if (--length == 0) return(ErrCode_Pars); } string += length; term = BitVector_Create(BITS,false); if (term == NULL) { return(ErrCode_Null); } base = BitVector_Create(BITS,false); if (base == NULL) { BitVector_Destroy(term); return(ErrCode_Null); } prod = BitVector_Create(bits,init); if (prod == NULL) { BitVector_Destroy(term); BitVector_Destroy(base); return(ErrCode_Null); } rank = BitVector_Create(bits,init); if (rank == NULL) { BitVector_Destroy(term); BitVector_Destroy(base); BitVector_Destroy(prod); return(ErrCode_Null); } temp = BitVector_Create(bits,false); if (temp == NULL) { BitVector_Destroy(term); BitVector_Destroy(base); BitVector_Destroy(prod); BitVector_Destroy(rank); return(ErrCode_Null); } BitVector_Empty(addr); *base = EXP10; shift = false; while ((not error) and (length > 0)) { accu = 0; powr = 1; count = LOG10; while ((not error) and (length > 0) and (count-- > 0)) { digit = (int) *(--string); length--; /* separate because isdigit() is likely a macro! */ if (isdigit(digit) != 0) { accu += ((N_word) digit - (N_word) '0') * powr; powr *= 10; } else error = ErrCode_Pars; } if (not error) { if (shift) { *term = accu; BitVector_Copy(temp,rank); error = BitVector_Mul_Pos(prod,temp,term,false); } else { *prod = accu; if ((not init) and ((accu AND NOT mask) != 0)) error = ErrCode_Ovfl; } if (not error) { carry = false; BitVector_compute(addr,addr,prod,false,&carry); /* ignores sign change (= overflow) but not */ /* numbers too large (= carry) for resulting bit vector */ if (carry) error = ErrCode_Ovfl; else { if (length > 0) { if (shift) { BitVector_Copy(temp,rank); error = BitVector_Mul_Pos(rank,temp,base,false); } else { *rank = *base; shift = true; } } } } } } BitVector_Destroy(term); BitVector_Destroy(base); BitVector_Destroy(prod); BitVector_Destroy(rank); BitVector_Destroy(temp); if (not error and minus) { BitVector_Negate(addr,addr); if ((*(addr + size_(addr) - 1) AND mask AND NOT (mask >> 1)) == 0) error = ErrCode_Ovfl; } } return(error); } charptr BitVector_to_Enum(wordptr addr) { N_word bits = bits_(addr); N_word sample; N_word length; N_word digits; N_word factor; N_word power; N_word start; N_word min; N_word max; charptr string; charptr target; boolean comma; if (bits > 0) { sample = bits - 1; /* greatest possible index */ length = 2; /* account for index 0 and terminating '\0' */ digits = 1; /* account for intervening dashes and commas */ factor = 1; power = 10; while (sample >= (power-1)) { length += ++digits * factor * 6; /* 9,90,900,9000,... (9*2/3 = 6) */ factor = power; power *= 10; } if (sample > --factor) { sample -= factor; factor = (N_word) ( sample / 3 ); factor = (factor << 1) + (sample - (factor * 3)); length += ++digits * factor; } } else length = 1; string = (charptr) malloc((size_t) length); if (string == NULL) return(NULL); start = 0; comma = false; target = string; while ((start < bits) and BitVector_interval_scan_inc(addr,start,&min,&max)) { start = max + 2; if (comma) *target++ = (N_char) ','; if (min == max) { target += BIT_VECTOR_int2str(target,min); } else { if (min+1 == max) { target += BIT_VECTOR_int2str(target,min); *target++ = (N_char) ','; target += BIT_VECTOR_int2str(target,max); } else { target += BIT_VECTOR_int2str(target,min); *target++ = (N_char) '-'; target += BIT_VECTOR_int2str(target,max); } } comma = true; } *target = (N_char) '\0'; return(string); } ErrCode BitVector_from_Enum(wordptr addr, charptr string) { ErrCode error = ErrCode_Ok; N_word bits = bits_(addr); N_word state = 1; N_word token; N_word index; N_word start; if (bits > 0) { BitVector_Empty(addr); while ((not error) and (state != 0)) { token = (N_word) *string; /* separate because isdigit() is likely a macro! */ if (isdigit(token) != 0) { string += BIT_VECTOR_str2int(string,&index); if (index < bits) token = (N_word) '0'; else error = ErrCode_Indx; } else string++; if (not error) switch (state) { case 1: switch (token) { case (N_word) '0': state = 2; break; case (N_word) '\0': state = 0; break; default: error = ErrCode_Pars; break; } break; case 2: switch (token) { case (N_word) '-': start = index; state = 3; break; case (N_word) ',': BIT_VECTOR_SET_BIT(addr,index) state = 5; break; case (N_word) '\0': BIT_VECTOR_SET_BIT(addr,index) state = 0; break; default: error = ErrCode_Pars; break; } break; case 3: switch (token) { case (N_word) '0': if (start < index) BitVector_Interval_Fill(addr,start,index); else if (start == index) BIT_VECTOR_SET_BIT(addr,index) else error = ErrCode_Ordr; state = 4; break; default: error = ErrCode_Pars; break; } break; case 4: switch (token) { case (N_word) ',': state = 5; break; case (N_word) '\0': state = 0; break; default: error = ErrCode_Pars; break; } break; case 5: switch (token) { case (N_word) '0': state = 2; break; default: error = ErrCode_Pars; break; } break; } } } return(error); } void BitVector_Dispose(charptr string) { if (string != NULL) free((voidptr) string); } void BitVector_Bit_Off(wordptr addr, N_int index) /* X = X \ {x} */ { if (index < bits_(addr)) BIT_VECTOR_CLR_BIT(addr,index) } void BitVector_Bit_On(wordptr addr, N_int index) /* X = X + {x} */ { if (index < bits_(addr)) BIT_VECTOR_SET_BIT(addr,index) } boolean BitVector_bit_flip(wordptr addr, N_int index) /* X=(X+{x})\(X*{x}) */ { N_word mask; if (index < bits_(addr)) return( BIT_VECTOR_FLP_BIT(addr,index,mask) ); else return( false ); } boolean BitVector_bit_test(wordptr addr, N_int index) /* {x} in X ? */ { if (index < bits_(addr)) return( BIT_VECTOR_TST_BIT(addr,index) ); else return( false ); } void BitVector_Bit_Copy(wordptr addr, N_int index, boolean bit) { if (index < bits_(addr)) { if (bit) BIT_VECTOR_SET_BIT(addr,index) else BIT_VECTOR_CLR_BIT(addr,index) } } void BitVector_LSB(wordptr addr, boolean bit) { if (bits_(addr) > 0) { if (bit) *addr |= LSB; else *addr &= NOT LSB; } } void BitVector_MSB(wordptr addr, boolean bit) { N_word size = size_(addr); N_word mask = mask_(addr); if (size-- > 0) { if (bit) *(addr+size) |= mask AND NOT (mask >> 1); else *(addr+size) &= NOT mask OR (mask >> 1); } } boolean BitVector_lsb(wordptr addr) { if (size_(addr) > 0) return( (*addr AND LSB) != 0 ); else return( false ); } boolean BitVector_msb(wordptr addr) { N_word size = size_(addr); N_word mask = mask_(addr); if (size-- > 0) return( (*(addr+size) AND (mask AND NOT (mask >> 1))) != 0 ); else return( false ); } boolean BitVector_rotate_left(wordptr addr) { N_word size = size_(addr); N_word mask = mask_(addr); N_word msb; boolean carry_in; boolean carry_out = false; if (size > 0) { msb = mask AND NOT (mask >> 1); carry_in = ((*(addr+size-1) AND msb) != 0); while (size-- > 1) { carry_out = ((*addr AND MSB) != 0); *addr <<= 1; if (carry_in) *addr |= LSB; carry_in = carry_out; addr++; } carry_out = ((*addr AND msb) != 0); *addr <<= 1; if (carry_in) *addr |= LSB; *addr &= mask; } return(carry_out); } boolean BitVector_rotate_right(wordptr addr) { N_word size = size_(addr); N_word mask = mask_(addr); N_word msb; boolean carry_in; boolean carry_out = false; if (size > 0) { msb = mask AND NOT (mask >> 1); carry_in = ((*addr AND LSB) != 0); addr += size-1; *addr &= mask; carry_out = ((*addr AND LSB) != 0); *addr >>= 1; if (carry_in) *addr |= msb; carry_in = carry_out; addr--; size--; while (size-- > 0) { carry_out = ((*addr AND LSB) != 0); *addr >>= 1; if (carry_in) *addr |= MSB; carry_in = carry_out; addr--; } } return(carry_out); } boolean BitVector_shift_left(wordptr addr, boolean carry_in) { N_word size = size_(addr); N_word mask = mask_(addr); N_word msb; boolean carry_out = carry_in; if (size > 0) { msb = mask AND NOT (mask >> 1); while (size-- > 1) { carry_out = ((*addr AND MSB) != 0); *addr <<= 1; if (carry_in) *addr |= LSB; carry_in = carry_out; addr++; } carry_out = ((*addr AND msb) != 0); *addr <<= 1; if (carry_in) *addr |= LSB; *addr &= mask; } return(carry_out); } boolean BitVector_shift_right(wordptr addr, boolean carry_in) { N_word size = size_(addr); N_word mask = mask_(addr); N_word msb; boolean carry_out = carry_in; if (size > 0) { msb = mask AND NOT (mask >> 1); addr += size-1; *addr &= mask; carry_out = ((*addr AND LSB) != 0); *addr >>= 1; if (carry_in) *addr |= msb; carry_in = carry_out; addr--; size--; while (size-- > 0) { carry_out = ((*addr AND LSB) != 0); *addr >>= 1; if (carry_in) *addr |= MSB; carry_in = carry_out; addr--; } } return(carry_out); } void BitVector_Move_Left(wordptr addr, N_int bits) { N_word count; N_word words; if (bits > 0) { count = bits AND MODMASK; words = bits >> LOGBITS; if (bits >= bits_(addr)) BitVector_Empty(addr); else { while (count-- > 0) BitVector_shift_left(addr,0); BitVector_Word_Insert(addr,0,words,true); } } } void BitVector_Move_Right(wordptr addr, N_int bits) { N_word count; N_word words; if (bits > 0) { count = bits AND MODMASK; words = bits >> LOGBITS; if (bits >= bits_(addr)) BitVector_Empty(addr); else { while (count-- > 0) BitVector_shift_right(addr,0); BitVector_Word_Delete(addr,0,words,true); } } } void BitVector_Insert(wordptr addr, N_int offset, N_int count, boolean clear) { N_word bits = bits_(addr); N_word last; if ((count > 0) and (offset < bits)) { last = offset + count; if (last < bits) { BitVector_Interval_Copy(addr,addr,last,offset,(bits-last)); } else last = bits; if (clear) BitVector_Interval_Empty(addr,offset,(last-1)); } } void BitVector_Delete(wordptr addr, N_int offset, N_int count, boolean clear) { N_word bits = bits_(addr); N_word last; if ((count > 0) and (offset < bits)) { last = offset + count; if (last < bits) { BitVector_Interval_Copy(addr,addr,offset,last,(bits-last)); } else count = bits - offset; if (clear) BitVector_Interval_Empty(addr,(bits-count),(bits-1)); } } boolean BitVector_increment(wordptr addr) /* X++ */ { N_word size = size_(addr); N_word mask = mask_(addr); wordptr last = addr + size - 1; boolean carry = true; if (size > 0) { *last |= NOT mask; while (carry and (size-- > 0)) { carry = (++(*addr++) == 0); } *last &= mask; } return(carry); } boolean BitVector_decrement(wordptr addr) /* X-- */ { N_word size = size_(addr); N_word mask = mask_(addr); wordptr last = addr + size - 1; boolean carry = true; if (size > 0) { *last &= mask; while (carry and (size-- > 0)) { carry = (*addr == 0); --(*addr++); } *last &= mask; } return(carry); } boolean BitVector_compute(wordptr X, wordptr Y, wordptr Z, boolean minus, boolean *carry) { N_word size = size_(X); N_word mask = mask_(X); N_word vv = 0; N_word cc; N_word mm; N_word yy; N_word zz; N_word lo; N_word hi; if (size > 0) { if (minus) cc = (*carry == 0); else cc = (*carry != 0); /* deal with (size-1) least significant full words first: */ while (--size > 0) { yy = *Y++; if (minus) { if (Z) zz = NOT *Z++; else zz = NOT 0; } else { if (Z) zz = *Z++; else zz = 0; } lo = (yy AND LSB) + (zz AND LSB) + cc; hi = (yy >> 1) + (zz >> 1) + (lo >> 1); cc = ((hi AND MSB) != 0); *X++ = (hi << 1) OR (lo AND LSB); } /* deal with most significant word (may be used only partially): */ yy = *Y AND mask; if (minus) { if (Z) zz = NOT *Z; else zz = NOT 0; } else { if (Z) zz = *Z; else zz = 0; } zz &= mask; if (mask == LSB) /* special case, only one bit used */ { vv = cc; lo = yy + zz + cc; cc = (lo >> 1); vv ^= cc; *X = lo AND LSB; } else { if (NOT mask) /* not all bits are used, but more than one */ { mm = (mask >> 1); vv = (yy AND mm) + (zz AND mm) + cc; mm = mask AND NOT mm; lo = yy + zz + cc; cc = (lo >> 1); vv ^= cc; vv &= mm; cc &= mm; *X = lo AND mask; } else /* other special case, all bits are used */ { mm = NOT MSB; lo = (yy AND mm) + (zz AND mm) + cc; vv = lo AND MSB; hi = ((yy AND MSB) >> 1) + ((zz AND MSB) >> 1) + (vv >> 1); cc = hi AND MSB; vv ^= cc; *X = (hi << 1) OR (lo AND mm); } } if (minus) *carry = (cc == 0); else *carry = (cc != 0); } return(vv != 0); } boolean BitVector_add(wordptr X, wordptr Y, wordptr Z, boolean *carry) { return(BitVector_compute(X,Y,Z,false,carry)); } boolean BitVector_sub(wordptr X, wordptr Y, wordptr Z, boolean *carry) { return(BitVector_compute(X,Y,Z,true,carry)); } boolean BitVector_inc(wordptr X, wordptr Y) { boolean carry = true; return(BitVector_compute(X,Y,NULL,false,&carry)); } boolean BitVector_dec(wordptr X, wordptr Y) { boolean carry = true; return(BitVector_compute(X,Y,NULL,true,&carry)); } void BitVector_Negate(wordptr X, wordptr Y) { N_word size = size_(X); N_word mask = mask_(X); boolean carry = true; if (size > 0) { while (size-- > 0) { *X = NOT *Y++; if (carry) { carry = (++(*X) == 0); } X++; } *(--X) &= mask; } } void BitVector_Absolute(wordptr X, wordptr Y) { N_word size = size_(Y); N_word mask = mask_(Y); if (size > 0) { if (*(Y+size-1) AND (mask AND NOT (mask >> 1))) BitVector_Negate(X,Y); else BitVector_Copy(X,Y); } } Z_int BitVector_Sign(wordptr addr) { N_word size = size_(addr); N_word mask = mask_(addr); wordptr last = addr + size - 1; boolean r = true; if (size > 0) { *last &= mask; while (r and (size-- > 0)) r = ( *addr++ == 0 ); } if (r) return((Z_int) 0); else { if (*last AND (mask AND NOT (mask >> 1))) return((Z_int) -1); else return((Z_int) 1); } } ErrCode BitVector_Mul_Pos(wordptr X, wordptr Y, wordptr Z, boolean heedsign) { N_word mask; N_word limit; N_word count; Z_long last; wordptr sign; boolean carry; boolean overflow; boolean ok = true; /* Requirements: - X and Y must have equal sizes (whereas Z may be any size!) - Z should always contain the SMALLER of the two factors Y and Z Constraints: - The contents of Y (and of X, of course) are destroyed (only Z is preserved!) */ if (bits_(X) != bits_(Y)) return(ErrCode_Size); BitVector_Empty(X); if (BitVector_is_empty(Y)) return(ErrCode_Ok); /* exit also taken if bits_(Y)==0 */ if ((last = Set_Max(Z)) < 0L) return(ErrCode_Ok); limit = (N_word) last; sign = Y + size_(Y) - 1; mask = mask_(Y); *sign &= mask; mask &= NOT (mask >> 1); for ( count = 0; (ok and (count <= limit)); count++ ) { if ( BIT_VECTOR_TST_BIT(Z,count) ) { carry = false; overflow = BitVector_compute(X,X,Y,false,&carry); if (heedsign) ok = not (carry or overflow); else ok = not carry; } if (ok and (count < limit)) { carry = BitVector_shift_left(Y,0); if (heedsign) { overflow = ((*sign AND mask) != 0); ok = not (carry or overflow); } else ok = not carry; } } if (ok) return(ErrCode_Ok); else return(ErrCode_Ovfl); } ErrCode BitVector_Multiply(wordptr X, wordptr Y, wordptr Z) { ErrCode error = ErrCode_Ok; N_word bit_x = bits_(X); N_word bit_y = bits_(Y); N_word bit_z = bits_(Z); N_word size; N_word mask; N_word msb; wordptr ptr_y; wordptr ptr_z; boolean sgn_x; boolean sgn_y; boolean sgn_z; boolean zero; wordptr A; wordptr B; /* Requirements: - Y and Z must have equal sizes - X must have at least the same size as Y and Z but may be larger (!) Features: - The contents of Y and Z are preserved - X may be identical with Y or Z (or both!) (in-place multiplication is possible!) */ if ((bit_y != bit_z) or (bit_x < bit_y)) return(ErrCode_Size); if (BitVector_is_empty(Y) or BitVector_is_empty(Z)) { BitVector_Empty(X); } else { A = BitVector_Create(bit_y,false); if (A == NULL) return(ErrCode_Null); B = BitVector_Create(bit_z,false); if (B == NULL) { BitVector_Destroy(A); return(ErrCode_Null); } size = size_(Y); mask = mask_(Y); msb = (mask AND NOT (mask >> 1)); sgn_y = (((*(Y+size-1) &= mask) AND msb) != 0); sgn_z = (((*(Z+size-1) &= mask) AND msb) != 0); sgn_x = sgn_y XOR sgn_z; if (sgn_y) BitVector_Negate(A,Y); else BitVector_Copy(A,Y); if (sgn_z) BitVector_Negate(B,Z); else BitVector_Copy(B,Z); ptr_y = A + size; ptr_z = B + size; zero = true; while (zero and (size-- > 0)) { zero &= (*(--ptr_y) == 0); zero &= (*(--ptr_z) == 0); } if (*ptr_y > *ptr_z) { if (bit_x > bit_y) { A = BitVector_Resize(A,bit_x); if (A == NULL) { BitVector_Destroy(B); return(ErrCode_Null); } } error = BitVector_Mul_Pos(X,A,B,true); } else { if (bit_x > bit_z) { B = BitVector_Resize(B,bit_x); if (B == NULL) { BitVector_Destroy(A); return(ErrCode_Null); } } error = BitVector_Mul_Pos(X,B,A,true); } if ((not error) and sgn_x) BitVector_Negate(X,X); BitVector_Destroy(A); BitVector_Destroy(B); } return(error); } ErrCode BitVector_Div_Pos(wordptr Q, wordptr X, wordptr Y, wordptr R) { N_word bits = bits_(Q); N_word mask; wordptr addr; Z_long last; boolean flag; boolean copy = false; /* flags whether valid rest is in R (0) or X (1) */ /* Requirements: - All bit vectors must have equal sizes - Q, X, Y and R must all be distinct bit vectors - Y must be non-zero (of course!) Constraints: - The contents of X (and Q and R, of course) are destroyed (only Y is preserved!) */ if ((bits != bits_(X)) or (bits != bits_(Y)) or (bits != bits_(R))) return(ErrCode_Size); if ((Q == X) or (Q == Y) or (Q == R) or (X == Y) or (X == R) or (Y == R)) return(ErrCode_Same); if (BitVector_is_empty(Y)) return(ErrCode_Zero); BitVector_Empty(R); BitVector_Copy(Q,X); if ((last = Set_Max(Q)) < 0L) return(ErrCode_Ok); bits = (N_word) ++last; while (bits-- > 0) { addr = Q + (bits >> LOGBITS); mask = BITMASKTAB[bits AND MODMASK]; flag = ((*addr AND mask) != 0); if (copy) { BitVector_shift_left(X,flag); flag = false; BitVector_compute(R,X,Y,true,&flag); } else { BitVector_shift_left(R,flag); flag = false; BitVector_compute(X,R,Y,true,&flag); } if (flag) *addr &= NOT mask; else { *addr |= mask; copy = not copy; } } if (copy) BitVector_Copy(R,X); return(ErrCode_Ok); } ErrCode BitVector_Divide(wordptr Q, wordptr X, wordptr Y, wordptr R) { ErrCode error = ErrCode_Ok; N_word bits = bits_(Q); N_word size = size_(Q); N_word mask = mask_(Q); N_word msb = (mask AND NOT (mask >> 1)); boolean sgn_q; boolean sgn_x; boolean sgn_y; wordptr A; wordptr B; /* Requirements: - All bit vectors must have equal sizes - Q and R must be two distinct bit vectors - Y must be non-zero (of course!) Features: - The contents of X and Y are preserved - Q may be identical with X or Y (or both) (in-place division is possible!) - R may be identical with X or Y (or both) (but not identical with Q!) */ if ((bits != bits_(X)) or (bits != bits_(Y)) or (bits != bits_(R))) return(ErrCode_Size); if (Q == R) return(ErrCode_Same); if (BitVector_is_empty(Y)) return(ErrCode_Zero); if (BitVector_is_empty(X)) { BitVector_Empty(Q); BitVector_Empty(R); } else { A = BitVector_Create(bits,false); if (A == NULL) return(ErrCode_Null); B = BitVector_Create(bits,false); if (B == NULL) { BitVector_Destroy(A); return(ErrCode_Null); } size--; sgn_x = (((*(X+size) &= mask) AND msb) != 0); sgn_y = (((*(Y+size) &= mask) AND msb) != 0); sgn_q = sgn_x XOR sgn_y; if (sgn_x) BitVector_Negate(A,X); else BitVector_Copy(A,X); if (sgn_y) BitVector_Negate(B,Y); else BitVector_Copy(B,Y); if (not (error = BitVector_Div_Pos(Q,A,B,R))) { if (sgn_q) BitVector_Negate(Q,Q); if (sgn_x) BitVector_Negate(R,R); } BitVector_Destroy(A); BitVector_Destroy(B); } return(error); } ErrCode BitVector_GCD(wordptr X, wordptr Y, wordptr Z) { ErrCode error = ErrCode_Ok; N_word bits = bits_(X); N_word size = size_(X); N_word mask = mask_(X); N_word msb = (mask AND NOT (mask >> 1)); wordptr Q; wordptr R; wordptr A; wordptr B; wordptr T; /* Requirements: - All bit vectors must have equal sizes - Y and Z must be non-zero (of course!) Features: - The contents of Y and Z are preserved - X may be identical with Y or Z (or both) (in-place is possible!) */ if ((bits != bits_(Y)) or (bits != bits_(Z))) return(ErrCode_Size); if (BitVector_is_empty(Y) or BitVector_is_empty(Z)) return(ErrCode_Zero); Q = BitVector_Create(bits,false); if (Q == NULL) { return(ErrCode_Null); } R = BitVector_Create(bits,false); if (R == NULL) { BitVector_Destroy(Q); return(ErrCode_Null); } A = BitVector_Create(bits,false); if (A == NULL) { BitVector_Destroy(Q); BitVector_Destroy(R); return(ErrCode_Null); } B = BitVector_Create(bits,false); if (B == NULL) { BitVector_Destroy(Q); BitVector_Destroy(R); BitVector_Destroy(A); return(ErrCode_Null); } size--; if (((*(Y+size) &= mask) AND msb) != 0) BitVector_Negate(A,Y); else BitVector_Copy(A,Y); if (((*(Z+size) &= mask) AND msb) != 0) BitVector_Negate(B,Z); else BitVector_Copy(B,Z); while (not error) { if (not (error = BitVector_Div_Pos(Q,A,B,R))) { if (BitVector_is_empty(R)) break; T = A; A = B; B = R; R = T; } } if (not error) BitVector_Copy(X,B); BitVector_Destroy(Q); BitVector_Destroy(R); BitVector_Destroy(A); BitVector_Destroy(B); return(error); } ErrCode BitVector_Power(wordptr X, wordptr Y, wordptr Z) { ErrCode error = ErrCode_Ok; N_word bits = bits_(X); boolean first = true; Z_long last; N_word limit; N_word count; wordptr T; /* Requirements: - X must have at least the same size as Y but may be larger (!) - X may not be identical with Z - Z must be positive Features: - The contents of Y and Z are preserved */ if (X == Z) return(ErrCode_Same); if (bits < bits_(Y)) return(ErrCode_Size); if (BitVector_msb(Z)) return(ErrCode_Expo); if ((last = Set_Max(Z)) < 0L) { if (bits < 2) return(ErrCode_Ovfl); BitVector_Empty(X); *X |= LSB; return(ErrCode_Ok); /* anything ^ 0 == 1 */ } if (BitVector_is_empty(Y)) { if (X != Y) BitVector_Empty(X); return(ErrCode_Ok); /* 0 ^ anything not zero == 0 */ } T = BitVector_Create(bits,false); if (T == NULL) return(ErrCode_Null); limit = (N_word) last; for ( count = 0; ((!error) and (count <= limit)); count++ ) { if ( BIT_VECTOR_TST_BIT(Z,count) ) { if (first) { first = false; if (count) { BitVector_Copy(X,T); } else { if (X != Y) BitVector_Copy(X,Y); } } else error = BitVector_Multiply(X,T,X); /* order important because T > X */ } if ((!error) and (count < limit)) { if (count) error = BitVector_Multiply(T,T,T); else error = BitVector_Multiply(T,Y,Y); } } BitVector_Destroy(T); return(error); } void BitVector_Block_Store(wordptr addr, charptr buffer, N_int length) { N_word size = size_(addr); N_word mask = mask_(addr); N_word value; N_word count; /* provide translation for independence of endian-ness: */ if (size > 0) { while (size-- > 0) { value = 0; for ( count = 0; (length > 0) and (count < BITS); count += 8 ) { value |= (((N_word) *buffer++) << count); length--; } *addr++ = value; } *(--addr) &= mask; } } charptr BitVector_Block_Read(wordptr addr, N_intptr length) { N_word size = size_(addr); N_word value; N_word count; charptr buffer; charptr target; /* provide translation for independence of endian-ness: */ *length = size << FACTOR; buffer = (charptr) malloc((size_t) ((*length)+1)); if (buffer == NULL) return(NULL); target = buffer; if (size > 0) { *(addr+size-1) &= mask_(addr); while (size-- > 0) { value = *addr++; count = BITS >> 3; while (count-- > 0) { *target++ = (N_char) (value AND 0x00FF); if (count > 0) value >>= 8; } } } *target = (N_char) '\0'; return(buffer); } void BitVector_Word_Store(wordptr addr, N_int offset, N_int value) { N_word size = size_(addr); if (size > 0) { if (offset < size) *(addr+offset) = value; *(addr+size-1) &= mask_(addr); } } N_int BitVector_Word_Read(wordptr addr, N_int offset) { N_word size = size_(addr); if (size > 0) { *(addr+size-1) &= mask_(addr); if (offset < size) return( *(addr+offset) ); } return( (N_int) 0 ); } void BitVector_Word_Insert(wordptr addr, N_int offset, N_int count, boolean clear) { N_word size = size_(addr); N_word mask = mask_(addr); wordptr last = addr+size-1; if (size > 0) { *last &= mask; if (offset > size) offset = size; BIT_VECTOR_ins_words(addr+offset,size-offset,count,clear); *last &= mask; } } void BitVector_Word_Delete(wordptr addr, N_int offset, N_int count, boolean clear) { N_word size = size_(addr); N_word mask = mask_(addr); wordptr last = addr+size-1; if (size > 0) { *last &= mask; if (offset > size) offset = size; BIT_VECTOR_del_words(addr+offset,size-offset,count,clear); *last &= mask; } } void BitVector_Chunk_Store(wordptr addr, N_int chunksize, N_int offset, N_long value) { N_word bits = bits_(addr); N_word mask; N_word temp; if ((chunksize > 0) and (offset < bits)) { if (chunksize > LONGBITS) chunksize = LONGBITS; if ((offset + chunksize) > bits) chunksize = bits - offset; addr += offset >> LOGBITS; offset &= MODMASK; while (chunksize > 0) { mask = (N_word) (~0L << offset); bits = offset + chunksize; if (bits < BITS) { mask &= (N_word) ~(~0L << bits); bits = chunksize; } else bits = BITS - offset; temp = (N_word) (value << offset); temp &= mask; *addr &= NOT mask; *addr++ |= temp; value >>= bits; chunksize -= bits; offset = 0; } } } N_long BitVector_Chunk_Read(wordptr addr, N_int chunksize, N_int offset) { N_word bits = bits_(addr); N_word chunkbits = 0; N_long value = 0L; N_long temp; N_word mask; if ((chunksize > 0) and (offset < bits)) { if (chunksize > LONGBITS) chunksize = LONGBITS; if ((offset + chunksize) > bits) chunksize = bits - offset; addr += offset >> LOGBITS; offset &= MODMASK; while (chunksize > 0) { bits = offset + chunksize; if (bits < BITS) { mask = (N_word) ~(~0L << bits); bits = chunksize; } else { mask = (N_word) ~0L; bits = BITS - offset; } temp = (N_long) ((*addr++ AND mask) >> offset); value |= temp << chunkbits; chunkbits += bits; chunksize -= bits; offset = 0; } } return(value); } /*******************/ /* set operations: */ /*******************/ void Set_Union(wordptr X, wordptr Y, wordptr Z) /* X = Y + Z */ { N_word bits = bits_(X); N_word size = size_(X); N_word mask = mask_(X); if ((size > 0) and (bits == bits_(Y)) and (bits == bits_(Z))) { while (size-- > 0) *X++ = *Y++ OR *Z++; *(--X) &= mask; } } void Set_Intersection(wordptr X, wordptr Y, wordptr Z) /* X = Y * Z */ { N_word bits = bits_(X); N_word size = size_(X); N_word mask = mask_(X); if ((size > 0) and (bits == bits_(Y)) and (bits == bits_(Z))) { while (size-- > 0) *X++ = *Y++ AND *Z++; *(--X) &= mask; } } void Set_Difference(wordptr X, wordptr Y, wordptr Z) /* X = Y \ Z */ { N_word bits = bits_(X); N_word size = size_(X); N_word mask = mask_(X); if ((size > 0) and (bits == bits_(Y)) and (bits == bits_(Z))) { while (size-- > 0) *X++ = *Y++ AND NOT *Z++; *(--X) &= mask; } } void Set_ExclusiveOr(wordptr X, wordptr Y, wordptr Z) /* X=(Y+Z)\(Y*Z) */ { N_word bits = bits_(X); N_word size = size_(X); N_word mask = mask_(X); if ((size > 0) and (bits == bits_(Y)) and (bits == bits_(Z))) { while (size-- > 0) *X++ = *Y++ XOR *Z++; *(--X) &= mask; } } void Set_Complement(wordptr X, wordptr Y) /* X = ~Y */ { N_word size = size_(X); N_word mask = mask_(X); if ((size > 0) and (bits_(X) == bits_(Y))) { while (size-- > 0) *X++ = NOT *Y++; *(--X) &= mask; } } /******************/ /* set functions: */ /******************/ boolean Set_subset(wordptr X, wordptr Y) /* X subset Y ? */ { N_word size = size_(X); boolean r = false; if ((size > 0) and (bits_(X) == bits_(Y))) { r = true; while (r and (size-- > 0)) r = ((*X++ AND NOT *Y++) == 0); } return(r); } N_int Set_Norm(wordptr addr) /* = | X | */ { N_word size = size_(addr); N_int count = 0; N_word c; while (size-- > 0) { c = *addr++; while (c) { c &= c - 1; count++; } } return(count); } Z_long Set_Min(wordptr addr) /* = min(X) */ { boolean empty = true; N_word size = size_(addr); N_word i = 0; N_word c; while (empty and (size-- > 0)) { if (c = *addr++) empty = false; else i++; } if (empty) return((Z_long) LONG_MAX); /* plus infinity */ i <<= LOGBITS; while (not (c AND LSB)) { c >>= 1; i++; } return((Z_long) i); } Z_long Set_Max(wordptr addr) /* = max(X) */ { boolean empty = true; N_word size = size_(addr); N_word i = size; N_word c; addr += size-1; while (empty and (size-- > 0)) { if (c = *addr--) empty = false; else i--; } if (empty) return((Z_long) LONG_MIN); /* minus infinity */ i <<= LOGBITS; while (not (c AND MSB)) { c <<= 1; i--; } return((Z_long) --i); } /**********************************/ /* matrix-of-booleans operations: */ /**********************************/ void Matrix_Multiplication(wordptr X, N_int rowsX, N_int colsX, wordptr Y, N_int rowsY, N_int colsY, wordptr Z, N_int rowsZ, N_int colsZ) { N_word i; N_word j; N_word k; N_word indxX; N_word indxY; N_word indxZ; N_word termX; N_word termY; N_word sum; if ((colsY == rowsZ) and (rowsX == rowsY) and (colsX == colsZ) and (bits_(X) == rowsX*colsX) and (bits_(Y) == rowsY*colsY) and (bits_(Z) == rowsZ*colsZ)) { for ( i = 0; i < rowsY; i++ ) { termX = i * colsX; termY = i * colsY; for ( j = 0; j < colsZ; j++ ) { indxX = termX + j; sum = 0; for ( k = 0; k < colsY; k++ ) { indxY = termY + k; indxZ = k * colsZ + j; if ( BIT_VECTOR_TST_BIT(Y,indxY) && BIT_VECTOR_TST_BIT(Z,indxZ) ) sum ^= 1; } if (sum) BIT_VECTOR_SET_BIT(X,indxX) else BIT_VECTOR_CLR_BIT(X,indxX) } } } } void Matrix_Product(wordptr X, N_int rowsX, N_int colsX, wordptr Y, N_int rowsY, N_int colsY, wordptr Z, N_int rowsZ, N_int colsZ) { N_word i; N_word j; N_word k; N_word indxX; N_word indxY; N_word indxZ; N_word termX; N_word termY; N_word sum; if ((colsY == rowsZ) and (rowsX == rowsY) and (colsX == colsZ) and (bits_(X) == rowsX*colsX) and (bits_(Y) == rowsY*colsY) and (bits_(Z) == rowsZ*colsZ)) { for ( i = 0; i < rowsY; i++ ) { termX = i * colsX; termY = i * colsY; for ( j = 0; j < colsZ; j++ ) { indxX = termX + j; sum = 0; for ( k = 0; k < colsY; k++ ) { indxY = termY + k; indxZ = k * colsZ + j; if ( BIT_VECTOR_TST_BIT(Y,indxY) && BIT_VECTOR_TST_BIT(Z,indxZ) ) sum |= 1; } if (sum) BIT_VECTOR_SET_BIT(X,indxX) else BIT_VECTOR_CLR_BIT(X,indxX) } } } } void Matrix_Closure(wordptr addr, N_int rows, N_int cols) { N_word i; N_word j; N_word k; N_word ii; N_word ij; N_word ik; N_word kj; N_word termi; N_word termk; if ((rows == cols) and (bits_(addr) == rows*cols)) { for ( i = 0; i < rows; i++ ) { ii = i * cols + i; BIT_VECTOR_SET_BIT(addr,ii) } for ( k = 0; k < rows; k++ ) { termk = k * cols; for ( i = 0; i < rows; i++ ) { termi = i * cols; ik = termi + k; for ( j = 0; j < rows; j++ ) { ij = termi + j; kj = termk + j; if ( BIT_VECTOR_TST_BIT(addr,ik) && BIT_VECTOR_TST_BIT(addr,kj) ) BIT_VECTOR_SET_BIT(addr,ij) } } } } } void Matrix_Transpose(wordptr X, N_int rowsX, N_int colsX, wordptr Y, N_int rowsY, N_int colsY) { N_word i; N_word j; N_word ii; N_word ij; N_word ji; N_word addii; N_word addij; N_word addji; N_word bitii; N_word bitij; N_word bitji; N_word termi; N_word termj; boolean swap; /* BEWARE that "in-place" is ONLY possible if the matrix is quadratic!! */ if ((rowsX == colsY) and (colsX == rowsY) and (bits_(X) == rowsX*colsX) and (bits_(Y) == rowsY*colsY)) { if (rowsY == colsY) /* in-place is possible! */ { for ( i = 0; i < rowsY; i++ ) { termi = i * colsY; for ( j = 0; j < i; j++ ) { termj = j * colsX; ij = termi + j; ji = termj + i; addij = ij >> LOGBITS; addji = ji >> LOGBITS; bitij = BITMASKTAB[ij AND MODMASK]; bitji = BITMASKTAB[ji AND MODMASK]; swap = ((*(Y+addij) AND bitij) != 0); if ((*(Y+addji) AND bitji) != 0) *(X+addij) |= bitij; else *(X+addij) &= NOT bitij; if (swap) *(X+addji) |= bitji; else *(X+addji) &= NOT bitji; } ii = termi + i; addii = ii >> LOGBITS; bitii = BITMASKTAB[ii AND MODMASK]; if ((*(Y+addii) AND bitii) != 0) *(X+addii) |= bitii; else *(X+addii) &= NOT bitii; } } else /* rowsX != colsX, in-place is NOT possible! */ { for ( i = 0; i < rowsY; i++ ) { termi = i * colsY; for ( j = 0; j < colsY; j++ ) { termj = j * colsX; ij = termi + j; ji = termj + i; addij = ij >> LOGBITS; addji = ji >> LOGBITS; bitij = BITMASKTAB[ij AND MODMASK]; bitji = BITMASKTAB[ji AND MODMASK]; if ((*(Y+addij) AND bitij) != 0) *(X+addji) |= bitji; else *(X+addji) &= NOT bitji; } } } } } /*****************************************************************************/ /* VERSION: 6.0 */ /*****************************************************************************/ /* VERSION HISTORY: */ /*****************************************************************************/ /* */ /* Version 6.0 08.10.00 Corrected overflow handling. */ /* Version 5.8 14.07.00 Added "Power()". Changed "Copy()". */ /* Version 5.7 19.05.99 Quickened "Div_Pos()". Added "Product()". */ /* Version 5.6 02.11.98 Leading zeros eliminated in "to_Hex()". */ /* Version 5.5 21.09.98 Fixed bug of uninitialized "error" in Multiply. */ /* Version 5.4 07.09.98 Fixed bug of uninitialized "error" in Divide. */ /* Version 5.3 12.05.98 Improved Norm. Completed history. */ /* Version 5.2 31.03.98 Improved Norm. */ /* Version 5.1 09.03.98 No changes. */ /* Version 5.0 01.03.98 Major additions and rewrite. */ /* Version 4.2 16.07.97 Added is_empty, is_full. */ /* Version 4.1 30.06.97 Added word-ins/del, move-left/right, inc/dec. */ /* Version 4.0 23.04.97 Rewrite. Added bit shift and bool. matrix ops. */ /* Version 3.2 04.02.97 Added interval methods. */ /* Version 3.1 21.01.97 Fixed bug on 64 bit machines. */ /* Version 3.0 12.01.97 Added flip. */ /* Version 2.0 14.12.96 Efficiency and consistency improvements. */ /* Version 1.1 08.01.96 Added Resize and ExclusiveOr. */ /* Version 1.0 14.12.95 First version under UNIX (with Perl module). */ /* Version 0.9 01.11.93 First version of C library under MS-DOS. */ /* Version 0.1 ??.??.89 First version in Turbo Pascal under CP/M. */ /* */ /*****************************************************************************/ /* AUTHOR: */ /*****************************************************************************/ /* */ /* Steffen Beyer */ /* Ainmillerstr. 5 / App. 513 */ /* D-80801 Munich */ /* Germany */ /* */ /* mailto:sb@engelschall.com */ /* http://www.engelschall.com/u/sb/download/ */ /* */ /*****************************************************************************/ /* COPYRIGHT: */ /*****************************************************************************/ /* */ /* Copyright (c) 1995 - 2000 by Steffen Beyer. */ /* All rights reserved. */ /* */ /*****************************************************************************/ /* LICENSE: */ /*****************************************************************************/ /* */ /* 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 Software Foundation, Inc., */ /* 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ /* */ /* or download a copy from ftp://ftp.gnu.org/pub/gnu/COPYING.LIB-2.0 */ /* */ /*****************************************************************************/ #endif slice-1.3.8/lib/bitvector/BitVector.h0100664000000000000000000004066307257724263016732 0ustar barbierslice#ifndef MODULE_BIT_VECTOR #define MODULE_BIT_VECTOR /*****************************************************************************/ /* MODULE NAME: BitVector.h MODULE TYPE: (adt) */ /*****************************************************************************/ /* MODULE IMPORTS: */ /*****************************************************************************/ #include /* MODULE TYPE: (sys) */ #include /* MODULE TYPE: (sys) */ #include /* MODULE TYPE: (sys) */ #include /* MODULE TYPE: (sys) */ #include "ToolBox.h" /* MODULE TYPE: (dat) */ /*****************************************************************************/ /* MODULE INTERFACE: */ /*****************************************************************************/ typedef enum { ErrCode_Ok = 0, /* everything went allright */ ErrCode_Type, /* types word and size_t have incompatible sizes */ ErrCode_Bits, /* bits of word and sizeof(word) are inconsistent */ ErrCode_Word, /* size of word is less than 16 bits */ ErrCode_Long, /* size of word is greater than size of long */ ErrCode_Powr, /* number of bits of word is not a power of two */ ErrCode_Loga, /* error in calculation of logarithm */ ErrCode_Null, /* unable to allocate memory */ ErrCode_Indx, /* index out of range */ ErrCode_Ordr, /* minimum > maximum index */ ErrCode_Size, /* bit vector size mismatch */ ErrCode_Pars, /* input string syntax error */ ErrCode_Ovfl, /* numeric overflow error */ ErrCode_Same, /* operands must be distinct */ ErrCode_Expo, /* exponent must be positive */ ErrCode_Zero /* division by zero error */ } ErrCode; /* ===> MISCELLANEOUS: <=== */ ErrCode BitVector_Boot (void); /* 0 = ok, 1..7 = error */ N_word BitVector_Size (N_int bits); /* bit vector size (# of words) */ N_word BitVector_Mask (N_int bits); /* bit vector mask (unused bits) */ /* ===> CLASS METHODS: <=== */ charptr BitVector_Version (void); /* returns version string */ N_int BitVector_Word_Bits (void); /* returns # of bits in machine word */ N_int BitVector_Long_Bits (void); /* returns # of bits in unsigned long */ wordptr BitVector_Create(N_int bits, boolean clear); /* malloc */ /* ===> OBJECT METHODS: <=== */ wordptr BitVector_Shadow (wordptr addr); /* makes new, same size but empty */ wordptr BitVector_Clone (wordptr addr); /* makes exact duplicate */ wordptr BitVector_Concat (wordptr X, wordptr Y); /* returns concatenation */ wordptr BitVector_Resize (wordptr oldaddr, N_int bits); /* realloc */ void BitVector_Destroy (wordptr addr); /* free */ /* ===> bit vector copy function: */ void BitVector_Copy (wordptr X, wordptr Y); /* X = Y */ /* ===> bit vector initialization: */ void BitVector_Empty (wordptr addr); /* X = {} */ void BitVector_Fill (wordptr addr); /* X = ~{} */ void BitVector_Flip (wordptr addr); /* X = ~X */ void BitVector_Primes (wordptr addr); /* ===> miscellaneous functions: */ void BitVector_Reverse (wordptr X, wordptr Y); /* ===> bit vector interval operations and functions: */ void BitVector_Interval_Empty (wordptr addr, N_int lower, N_int upper); void BitVector_Interval_Fill (wordptr addr, N_int lower, N_int upper); void BitVector_Interval_Flip (wordptr addr, N_int lower, N_int upper); void BitVector_Interval_Reverse (wordptr addr, N_int lower, N_int upper); boolean BitVector_interval_scan_inc(wordptr addr, N_int start, N_intptr min, N_intptr max); boolean BitVector_interval_scan_dec(wordptr addr, N_int start, N_intptr min, N_intptr max); void BitVector_Interval_Copy (wordptr X, wordptr Y, N_int Xoffset, N_int Yoffset, N_int length); wordptr BitVector_Interval_Substitute(wordptr X, wordptr Y, N_int Xoffset, N_int Xlength, N_int Yoffset, N_int Ylength); /* ===> bit vector test functions: */ boolean BitVector_is_empty (wordptr addr); /* X == {} ? */ boolean BitVector_is_full (wordptr addr); /* X == ~{} ? */ boolean BitVector_equal (wordptr X, wordptr Y); /* X == Y ? */ Z_int BitVector_Lexicompare (wordptr X, wordptr Y); /* X <,=,> Y ? */ Z_int BitVector_Compare (wordptr X, wordptr Y); /* X <,=,> Y ? */ /* ===> bit vector string conversion functions: */ charptr BitVector_to_Hex (wordptr addr); ErrCode BitVector_from_Hex(wordptr addr, charptr string); charptr BitVector_to_Bin (wordptr addr); ErrCode BitVector_from_Bin(wordptr addr, charptr string); charptr BitVector_to_Dec (wordptr addr); ErrCode BitVector_from_Dec(wordptr addr, charptr string); charptr BitVector_to_Enum (wordptr addr); ErrCode BitVector_from_Enum(wordptr addr, charptr string); void BitVector_Dispose (charptr string); /* ===> bit vector bit operations, functions & tests: */ void BitVector_Bit_Off (wordptr addr, N_int index); /* X = X \ {x} */ void BitVector_Bit_On (wordptr addr, N_int index); /* X = X + {x} */ boolean BitVector_bit_flip(wordptr addr, N_int index); /* X=(X+{x})\(X*{x}) */ boolean BitVector_bit_test(wordptr addr, N_int index); /* {x} in X ? */ void BitVector_Bit_Copy(wordptr addr, N_int index, boolean bit); /* ===> bit vector bit shift & rotate functions: */ void BitVector_LSB (wordptr addr, boolean bit); void BitVector_MSB (wordptr addr, boolean bit); boolean BitVector_lsb (wordptr addr); boolean BitVector_msb (wordptr addr); boolean BitVector_rotate_left (wordptr addr); boolean BitVector_rotate_right(wordptr addr); boolean BitVector_shift_left (wordptr addr, boolean carry_in); boolean BitVector_shift_right (wordptr addr, boolean carry_in); void BitVector_Move_Left (wordptr addr, N_int bits); void BitVector_Move_Right (wordptr addr, N_int bits); /* ===> bit vector insert/delete bits: */ void BitVector_Insert (wordptr addr, N_int offset, N_int count, boolean clear); void BitVector_Delete (wordptr addr, N_int offset, N_int count, boolean clear); /* ===> bit vector arithmetic: */ boolean BitVector_increment (wordptr addr); /* X++ */ boolean BitVector_decrement (wordptr addr); /* X-- */ boolean BitVector_compute (wordptr X, wordptr Y, wordptr Z, boolean minus, boolean *carry); boolean BitVector_add (wordptr X, wordptr Y, wordptr Z, boolean *carry); boolean BitVector_sub (wordptr X, wordptr Y, wordptr Z, boolean *carry); boolean BitVector_inc (wordptr X, wordptr Y); boolean BitVector_dec (wordptr X, wordptr Y); void BitVector_Negate (wordptr X, wordptr Y); void BitVector_Absolute(wordptr X, wordptr Y); Z_int BitVector_Sign (wordptr addr); ErrCode BitVector_Mul_Pos (wordptr X, wordptr Y, wordptr Z, boolean heedsign); ErrCode BitVector_Multiply(wordptr X, wordptr Y, wordptr Z); ErrCode BitVector_Div_Pos (wordptr Q, wordptr X, wordptr Y, wordptr R); ErrCode BitVector_Divide (wordptr Q, wordptr X, wordptr Y, wordptr R); ErrCode BitVector_GCD (wordptr X, wordptr Y, wordptr Z); ErrCode BitVector_Power (wordptr X, wordptr Y, wordptr Z); /* ===> direct memory access functions: */ void BitVector_Block_Store (wordptr addr, charptr buffer, N_int length); charptr BitVector_Block_Read (wordptr addr, N_intptr length); /* ===> word array functions: */ void BitVector_Word_Store (wordptr addr, N_int offset, N_int value); N_int BitVector_Word_Read (wordptr addr, N_int offset); void BitVector_Word_Insert (wordptr addr, N_int offset, N_int count, boolean clear); void BitVector_Word_Delete (wordptr addr, N_int offset, N_int count, boolean clear); /* ===> arbitrary size chunk functions: */ void BitVector_Chunk_Store (wordptr addr, N_int chunksize, N_int offset, N_long value); N_long BitVector_Chunk_Read (wordptr addr, N_int chunksize, N_int offset); /* ===> set operations: */ void Set_Union (wordptr X, wordptr Y, wordptr Z); /* X = Y + Z */ void Set_Intersection(wordptr X, wordptr Y, wordptr Z); /* X = Y * Z */ void Set_Difference (wordptr X, wordptr Y, wordptr Z); /* X = Y \ Z */ void Set_ExclusiveOr (wordptr X, wordptr Y, wordptr Z); /* X=(Y+Z)\(Y*Z) */ void Set_Complement (wordptr X, wordptr Y); /* X = ~Y */ /* ===> set functions: */ boolean Set_subset (wordptr X, wordptr Y); /* X subset Y ? */ N_int Set_Norm (wordptr addr); /* = | X | */ Z_long Set_Min (wordptr addr); /* = min(X) */ Z_long Set_Max (wordptr addr); /* = max(X) */ /* ===> matrix-of-booleans operations: */ void Matrix_Multiplication(wordptr X, N_int rowsX, N_int colsX, wordptr Y, N_int rowsY, N_int colsY, wordptr Z, N_int rowsZ, N_int colsZ); void Matrix_Product (wordptr X, N_int rowsX, N_int colsX, wordptr Y, N_int rowsY, N_int colsY, wordptr Z, N_int rowsZ, N_int colsZ); void Matrix_Closure (wordptr addr, N_int rows, N_int cols); void Matrix_Transpose (wordptr X, N_int rowsX, N_int colsX, wordptr Y, N_int rowsY, N_int colsY); /*****************************************************************************/ /* MODULE RESOURCES: */ /*****************************************************************************/ #define bits_(BitVector) *(BitVector-3) #define size_(BitVector) *(BitVector-2) #define mask_(BitVector) *(BitVector-1) /*****************************************************************************/ /* MODULE IMPLEMENTATION: */ /*****************************************************************************/ /*****************************************************************************/ /* VERSION: 6.0 */ /*****************************************************************************/ /* VERSION HISTORY: */ /*****************************************************************************/ /* */ /* Version 6.0 08.10.00 Corrected overflow handling. */ /* Version 5.8 14.07.00 Added "Power()". Changed "Copy()". */ /* Version 5.7 19.05.99 Quickened "Div_Pos()". Added "Product()". */ /* Version 5.6 02.11.98 Leading zeros eliminated in "to_Hex()". */ /* Version 5.5 21.09.98 Fixed bug of uninitialized "error" in Multiply. */ /* Version 5.4 07.09.98 Fixed bug of uninitialized "error" in Divide. */ /* Version 5.3 12.05.98 Improved Norm. Completed history. */ /* Version 5.2 31.03.98 Improved Norm. */ /* Version 5.1 09.03.98 No changes. */ /* Version 5.0 01.03.98 Major additions and rewrite. */ /* Version 4.2 16.07.97 Added is_empty, is_full. */ /* Version 4.1 30.06.97 Added word-ins/del, move-left/right, inc/dec. */ /* Version 4.0 23.04.97 Rewrite. Added bit shift and bool. matrix ops. */ /* Version 3.2 04.02.97 Added interval methods. */ /* Version 3.1 21.01.97 Fixed bug on 64 bit machines. */ /* Version 3.0 12.01.97 Added flip. */ /* Version 2.0 14.12.96 Efficiency and consistency improvements. */ /* Version 1.1 08.01.96 Added Resize and ExclusiveOr. */ /* Version 1.0 14.12.95 First version under UNIX (with Perl module). */ /* Version 0.9 01.11.93 First version of C library under MS-DOS. */ /* Version 0.1 ??.??.89 First version in Turbo Pascal under CP/M. */ /* */ /*****************************************************************************/ /* AUTHOR: */ /*****************************************************************************/ /* */ /* Steffen Beyer */ /* Ainmillerstr. 5 / App. 513 */ /* D-80801 Munich */ /* Germany */ /* */ /* mailto:sb@engelschall.com */ /* http://www.engelschall.com/u/sb/download/ */ /* */ /*****************************************************************************/ /* COPYRIGHT: */ /*****************************************************************************/ /* */ /* Copyright (c) 1995 - 2000 by Steffen Beyer. */ /* All rights reserved. */ /* */ /*****************************************************************************/ /* LICENSE: */ /*****************************************************************************/ /* */ /* 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 Software Foundation, Inc., */ /* 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ /* */ /* or download a copy from ftp://ftp.gnu.org/pub/gnu/COPYING.LIB-2.0 */ /* */ /*****************************************************************************/ #endif slice-1.3.8/lib/bitvector/Makefile.PL0100664000000000000000000000263107257724263016623 0ustar barbierslice ############################################################################### ## ## ## Copyright (c) 1995 - 2000 by Steffen Beyer. ## ## All rights reserved. ## ## ## ## This package is free software; you can redistribute it ## ## and/or modify it under the same terms as Perl itself. ## ## ## ############################################################################### use ExtUtils::MakeMaker; use Config; WriteMakefile( 'NAME' => 'Bit::Vector', 'VERSION_FROM' => 'Vector.pm', 'OBJECT' => '$(O_FILES)', 'LIBS' => [''], # e.g., '-lm' 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' 'INC' => '', # e.g., '-I/usr/include/other' # ($] >= 5.005 ? # ('ABSTRACT' => 'Efficient base class implementing bit vectors', # 'AUTHOR' => 'Steffen Beyer (sb@engelschall.com)') : ()), # ($] >= 5.005 && $ eq 'MSWin32' && $Config{archname} =~ /-object\b/i ? # ('CAPI' => 'TRUE') : ()), 'dist' => { COMPRESS => "gzip -9", SUFFIX => "gz" } ); slice-1.3.8/lib/bitvector/MANIFEST0100664000000000000000000000013607260212035015757 0ustar barbiersliceBitVector.c BitVector.h MANIFEST Makefile.PL README.txt ToolBox.h Vector.pm Vector.xs typemap slice-1.3.8/lib/bitvector/README.txt0100664000000000000000000002711507257724263016353 0ustar barbierslice ===================================== Package "Bit::Vector" Version 6.0 ===================================== This package is available for download either from my web site at http://www.engelschall.com/u/sb/download/ or from any CPAN (= "Comprehensive Perl Archive Network") mirror server: http://www.perl.com/CPAN/authors/id/S/ST/STBEY/ Abstract: --------- Bit::Vector is an efficient C library which allows you to handle bit vectors, sets (of integers), "big integer arithmetic" and boolean matrices, all of arbitrary sizes. The library is efficient (in terms of algorithmical complexity) and therefore fast (in terms of execution speed) for instance through the widespread use of divide-and-conquer algorithms. The package also includes an object-oriented Perl module for accessing the C library from Perl, and optionally features overloaded operators for maximum ease of use. The C library can nevertheless be used stand-alone, without Perl. Legal issues: ------------- This package with all its parts is Copyright (c) 1995 - 2000 by Steffen Beyer. All rights reserved. This package is free software; you can use, modify and redistribute it under the same terms as Perl itself, i.e., under the terms of the "Artistic License" or the "GNU General Public License". The C library at the core of this Perl module can additionally be used, modified and redistributed under the terms of the "GNU Library General Public License". Please refer to the files "Artistic.txt", "GNU_GPL.txt" and "GNU_LGPL.txt" in this distribution, respectively, for details! Prerequisites: -------------- Perl version 5.000 or higher, and an ANSI C compiler (!) ^^^^^^ If you compile under Windows, note that you will need exactly the same compiler your Perl itself was compiled with! (This is also true for Unix, but rarely a problem.) Moreover, you usually cannot build any modules under Windows 95/98, the Win 95/98 command shell is too dumb. You will need the Windows NT command shell ("command.com") or the "4DOS" shell. Note that ActiveState provides precompiled binaries of this module for their Win32 port of Perl ("ActivePerl") on their web site, which you should be able to install simply by typing "ppm install Bit-Vector" in your MS-DOS command shell. This also works under Windows 95/98. If your firewall prevents "ppm" from downloading this package, you can also download it manually from http://www.activestate.com/ppmpackages/5.005/zips/ or http://www.activestate.com/ppmpackages/5.6/zips/. Follow the installation instructions included in the "zip" archive. Installation: ------------- Please see the file "INSTALL.txt" in this distribution for instructions on how to install this package. It is essential that you read this file since one of the special cases described in it might apply to you, especially if you are running Perl under Windows. Changes over previous versions: ------------------------------- Please refer to the file "CHANGES.txt" in this distribution for a detailed version history. Documentation: -------------- The documentation of this package is included in POD format (= "Plain Old Documentation") in the files "Vector.pod" and "Overload.pod" in this distribution, the human-readable markup-language standard for Perl documentation. By building this package, this documentation will automatically be converted into a man page, which will automatically be installed in your Perl tree through the installation process for further reference, where it can be accessed by the commands "man Bit::Vector" (UNIX) and "perldoc Bit::Vector" (UNIX and Win32), or "man Bit::Vector::Overload" (UNIX) and "perldoc Bit::Vector::Overload" (UNIX and Win32). If Perl is not available on your system, you can also read these files directly. What does it do: ---------------- This module implements bit vectors of arbitrary size and provides efficient methods for handling them. This goes far beyond the built-in capabilities of Perl for handling bit vectors (compare with the method list below!). Moreover, the C core of this module can be used "stand-alone" in other C applications; Perl is not necessarily required. The module is intended to serve as a base class for other applications or application classes, such as implementing sets or performing big integer arithmetic. All methods are implemented in C internally for maximum performance. An add-on module (named "Bit::Vector::Overload") provides overloaded arithmetic and relational operators for maximum ease of use (Perl only). Note that there is (of course) a little speed penalty to pay for overloaded operators. If speed is crucial, use the "Bit::Vector" module alone! This module is useful for a large range of different tasks: - For example for implementing sets and performing set operations (like union, difference, intersection, complement, check for subset relationship etc.), - as a basis for many efficient algorithms, for instance the "Sieve of Erathostenes" (for calculating prime numbers), (The complexities of the methods in this module are usually either O(1) or O(n/b), where "b" is the number of bits in a machine word on your system.) - for shift registers of arbitrary length (for example for cyclic redundancy checksums), - to calculate "look-ahead", "first" and "follow" character sets for parsers and compiler-compilers, - for graph algorithms, - for efficient storage and retrieval of status information, - for performing text synthesis ruled by boolean expressions, - for "big integer" arithmetic with arbitrarily large integers, - for manipulations of chunks of bits of arbitrary size, - for bitwise processing of audio CD wave files, - to convert formats of data files, and more. (A number of example applications is available from my web site at http://www.engelschall.com/u/sb/download/.) A large number of import/export methods allow you to access individual bits, contiguous ranges of bits, machine words, arbitrary chunks of bits, lists (arrays) of chunks of bits or machine words and a whole bit vector at once (for instance for blockwrite/-read to and from a file). You can also import and export the contents of a bit vector in binary, hexadecimal and decimal representation as well as ".newsrc" style enumerations. Note that this module is specifically designed for efficiency, which is also the reason why its methods are implemented in C. To further increase execution speed, the module doesn't use bytes as its basic storage unit, but rather uses machine words, assuming that a machine word is the most efficiently handled size of all scalar types on all machines (that's what the ANSI C standard proposes and assumes anyway). In order to achieve this, it automatically determines the number of bits in a machine word on your system and then adjusts its internal configuration constants accordingly. The greater the size of this basic storage unit, the better the complexity (= execution speed) of the methods in this module, but also the greater the average waste of unused bits in the last word. The range of available methods is exceptionally large for this kind of library; in detail: Version() Word_Bits() Long_Bits() new() new_Hex() new_Bin() new_Dec() new_Enum() Shadow() Clone() Concat() Concat_List() Size() Resize() Copy() Empty() Fill() Flip() Primes() Reverse() Interval_Empty() Interval_Fill() Interval_Flip() Interval_Reverse() Interval_Scan_inc() Interval_Scan_dec() Interval_Copy() Interval_Substitute() is_empty() is_full() equal() Lexicompare() Compare() to_Hex() from_Hex() to_Bin() from_Bin() to_Dec() from_Dec() to_Enum() from_Enum() Bit_Off() Bit_On() bit_flip() bit_test() Bit_Copy() LSB() MSB() lsb() msb() rotate_left() rotate_right() shift_left() shift_right() Move_Left() Move_Right() Insert() Delete() increment() decrement() inc() dec() add() subtract() Negate() Absolute() Sign() Multiply() Divide() GCD() Power() Block_Store() Block_Read() Word_Size() Word_Store() Word_Read() Word_List_Store() Word_List_Read() Word_Insert() Word_Delete() Chunk_Store() Chunk_Read() Chunk_List_Store() Chunk_List_Read() Index_List_Remove() Index_List_Store() Index_List_Read() Union() Intersection() Difference() ExclusiveOr() Complement() subset() Norm() Min() Max() Multiplication() Product() Closure() Transpose() Note to C developers: --------------------- Note again that the C library at the core of this module can also be used stand-alone (i.e., it contains no inter-dependencies whatsoever with Perl). The library itself consists of three files: "BitVector.c", "BitVector.h" and "ToolBox.h". Just compile "BitVector.c" (which automatically includes "ToolBox.h") and link the resulting output file "BitVector.o" with your application, which in turn should include "ToolBox.h" and "BitVector.h" (in this order). Example applications: --------------------- See the module "Set::IntRange" for an easy-to-use module for sets of integers within arbitrary ranges. See the module "Math::MatrixBool" for an efficient implementation of boolean matrices and boolean matrix operations. (Both modules are also available from my web site at http://www.engelschall.com/u/sb/download/ or any CPAN server.) See the file "SetObject.pl" in the "examples" subdirectory of this distribution for a way to emulate the "Set::Object" module from CPAN using "Bit::Vector" - this is a way to perform set operations on sets of arbitrary objects (any Perl objects or Perl data structures you want!). An application relying crucially on this "Bit::Vector" module is "Slice", a tool for generating different document versions out of a single master file, ruled by boolean expressions ("include english version of text plus examples but not ..."). (See also http://www.engelschall.com/sw/slice/.) This tool is itself part of another tool, "Website META Language" ("WML"), which allows you to generate and maintain large web sites. Among many other features, it allows you to define your own HTML tags which will be expanded either at generation or at run time, depending on your choice. (See also http://www.engelschall.com/sw/wml/.) Both tools are written by Ralf S. Engelschall. Credits: -------- Please refer to the file "CREDITS.txt" in this distribution for a list of contributors. Author's note: -------------- If you have any questions, suggestions or need any assistance, please let me know! Please do send feedback, this is essential for improving this module according to your needs! I hope you will find this module beneficial. Yours, -- Steffen Beyer http://www.engelschall.com/u/sb/ "There is enough for the need of everyone in this world, but not for the greed of everyone." - Mohandas Karamchand "Mahatma" Gandhi slice-1.3.8/lib/bitvector/ToolBox.h0100664000000000000000000002126707257724263016416 0ustar barbierslice#ifndef MODULE_TOOLBOX #define MODULE_TOOLBOX /*****************************************************************************/ /* MODULE NAME: ToolBox.h MODULE TYPE: (dat) */ /*****************************************************************************/ /* MODULE IMPORTS: */ /*****************************************************************************/ /*****************************************************************************/ /* MODULE INTERFACE: */ /*****************************************************************************/ /*****************************************************************************/ /* MODULE RESOURCES: */ /*****************************************************************************/ /*****************************************************************************/ /* NOTE: The type names that have been chosen here are somewhat weird on */ /* purpose, in order to avoid name clashes with system header files */ /* and your own application(s) which might - directly or indirectly - */ /* include this definitions file. */ /*****************************************************************************/ typedef unsigned char N_char; typedef unsigned char N_byte; typedef unsigned short N_short; typedef unsigned short N_shortword; typedef unsigned int N_int; typedef unsigned int N_word; typedef unsigned long N_long; typedef unsigned long N_longword; /* Mnemonic 1: The natural numbers, N = { 0, 1, 2, 3, ... } */ /* Mnemonic 2: Nnnn = u_N_signed, _N_ot signed */ typedef signed char Z_char; typedef signed char Z_byte; typedef signed short Z_short; typedef signed short Z_shortword; typedef signed int Z_int; typedef signed int Z_word; typedef signed long Z_long; typedef signed long Z_longword; /* Mnemonic 1: The whole numbers, Z = { 0, -1, 1, -2, 2, -3, 3, ... } */ /* Mnemonic 2: Zzzz = Ssss_igned */ typedef void *voidptr; typedef N_char *charptr; typedef N_byte *byteptr; typedef N_short *shortptr; typedef N_shortword *shortwordptr; typedef N_int *intptr; typedef N_word *wordptr; typedef N_long *longptr; typedef N_longword *longwordptr; typedef N_char *N_charptr; typedef N_byte *N_byteptr; typedef N_short *N_shortptr; typedef N_shortword *N_shortwordptr; typedef N_int *N_intptr; typedef N_word *N_wordptr; typedef N_long *N_longptr; typedef N_longword *N_longwordptr; typedef Z_char *Z_charptr; typedef Z_byte *Z_byteptr; typedef Z_short *Z_shortptr; typedef Z_shortword *Z_shortwordptr; typedef Z_int *Z_intptr; typedef Z_word *Z_wordptr; typedef Z_long *Z_longptr; typedef Z_longword *Z_longwordptr; #undef FALSE #define FALSE (0!=0) #undef TRUE #define TRUE (0==0) typedef enum { false = FALSE , true = TRUE } boolean; #define and && /* logical (boolean) operators: lower case */ #define or || #define not ! #define AND & /* binary (bitwise) operators: UPPER CASE */ #define OR | #define XOR ^ #define NOT ~ #define SHL << #define SHR >> #ifdef ENABLE_MODULO #define mod % /* arithmetic operators */ #endif #define blockdef(name,size) unsigned char name[size] #define blocktypedef(name,size) typedef unsigned char name[size] /*****************************************************************************/ /* MODULE IMPLEMENTATION: */ /*****************************************************************************/ /*****************************************************************************/ /* VERSION: 5.3 */ /*****************************************************************************/ /* VERSION HISTORY: */ /*****************************************************************************/ /* */ /* Version 5.3 12.05.98 Completed history. */ /* Version 5.0 01.03.98 "Definitions.h" -> "ToolBox.h". */ /* Version 4.0 24.03.97 "lib_defs.h" -> "Definitions.h". */ /* Version 3.0 16.02.97 Changed frames from 40 to 80 columns. */ /* Version 2.0 30.11.96 byte -> base etc. */ /* Version 1.2a 21.11.95 unchar -> N_char etc. Added MS-DOS specifics. */ /* Version 1.1 18.11.95 uchar -> unchar etc. */ /* Version 1.01 16.11.95 Removed MS-DOS specifics. */ /* Version 1.0 12.11.95 First version under UNIX (with Perl modules). */ /* Version 0.9 01.11.93 First version under MS-DOS. */ /* */ /*****************************************************************************/ /* AUTHOR: */ /*****************************************************************************/ /* */ /* Steffen Beyer */ /* Ainmillerstr. 5 / App. 513 */ /* D-80801 Munich */ /* Germany */ /* */ /* mailto:sb@engelschall.com */ /* http://www.engelschall.com/u/sb/download/ */ /* */ /*****************************************************************************/ /* COPYRIGHT: */ /*****************************************************************************/ /* */ /* Copyright (c) 1995 - 2000 by Steffen Beyer. */ /* All rights reserved. */ /* */ /*****************************************************************************/ /* LICENSE: */ /*****************************************************************************/ /* */ /* 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 Software Foundation, Inc., */ /* 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ /* */ /* or download a copy from ftp://ftp.gnu.org/pub/gnu/COPYING.LIB-2.0 */ /* */ /*****************************************************************************/ #endif slice-1.3.8/lib/bitvector/typemap0100664000000000000000000000174307140346126016243 0ustar barbierslice ############################################################################### ## ## ## Typemap for module "Bit::Vector" version 5.8. ## ## ## ## Copyright (c) 1995 - 2000 by Steffen Beyer. ## ## All rights reserved. ## ## ## ## This package is free software; you can redistribute it ## ## and/or modify it under the same terms as Perl itself. ## ## ## ############################################################################### TYPEMAP N_int T_IV N_long T_IV Z_int T_IV Z_long T_IV boolean T_IV BitVector_Object T_SV BitVector_Scalar T_SV slice-1.3.8/lib/bitvector/Vector.pm0100664000000000000000000000173207257724263016452 0ustar barbierslice ############################################################################### ## ## ## Copyright (c) 1995 - 2000 by Steffen Beyer. ## ## All rights reserved. ## ## ## ## This package is free software; you can redistribute it ## ## and/or modify it under the same terms as Perl itself. ## ## ## ############################################################################### package Bit::Vector; use strict; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION @CONFIG); require Exporter; require DynaLoader; @ISA = qw(Exporter DynaLoader); @EXPORT = qw(); @EXPORT_OK = qw(); $VERSION = '6.0'; bootstrap Bit::Vector $VERSION; 1; __END__ slice-1.3.8/lib/bitvector/Vector.xs0100664000000000000000000022474607314252757016502 0ustar barbierslice /*****************************************************************************/ /* */ /* Copyright (c) 1995 - 2000 by Steffen Beyer. */ /* All rights reserved. */ /* */ /* This package is free software; you can redistribute it */ /* and/or modify it under the same terms as Perl itself. */ /* */ /*****************************************************************************/ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "BitVector.h" static char *BitVector_Class = "Bit::Vector"; static HV *BitVector_Stash; typedef SV *BitVector_Object; typedef SV *BitVector_Handle; typedef N_word *BitVector_Address; typedef SV *BitVector_Scalar; /* Needed by Perl < 5.005 */ #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) #define PL_na na #endif #define BIT_VECTOR_OBJECT(ref,hdl,adr) \ ( ref && \ SvROK(ref) && \ (hdl = (BitVector_Handle)SvRV(ref)) && \ SvOBJECT(hdl) && \ SvREADONLY(hdl) && \ (SvTYPE(hdl) == SVt_PVMG) && \ (SvSTASH(hdl) == BitVector_Stash) && \ (adr = (BitVector_Address)SvIV(hdl)) ) #define BIT_VECTOR_SCALAR(ref,typ,var) \ ( ref && !(SvROK(ref)) && ((var = (typ)SvIV(ref)) | 1) ) #define BIT_VECTOR_STRING(ref,var) \ ( ref && !(SvROK(ref)) && (var = (charptr)SvPV(ref,PL_na)) ) #define BIT_VECTOR_BUFFER(ref,var,len) \ ( ref && !(SvROK(ref)) && SvPOK(ref) && \ (var = (charptr)SvPV(ref,PL_na)) && \ ((len = (N_int)SvCUR(ref)) | 1) ) #define BIT_VECTOR_ERROR(name,error) \ croak("Bit::Vector::" name "(): " error) #define BIT_VECTOR_MEMORY_ERROR(name) \ BIT_VECTOR_ERROR(name,"unable to allocate memory") #define BIT_VECTOR_OBJECT_ERROR(name) \ BIT_VECTOR_ERROR(name,"item is not a \"Bit::Vector\" object") #define BIT_VECTOR_SCALAR_ERROR(name) \ BIT_VECTOR_ERROR(name,"item is not a scalar") #define BIT_VECTOR_STRING_ERROR(name) \ BIT_VECTOR_ERROR(name,"item is not a string") #define BIT_VECTOR_INDEX_ERROR(name) \ BIT_VECTOR_ERROR(name,"index out of range") #define BIT_VECTOR_MIN_ERROR(name) \ BIT_VECTOR_ERROR(name,"minimum index out of range") #define BIT_VECTOR_MAX_ERROR(name) \ BIT_VECTOR_ERROR(name,"maximum index out of range") #define BIT_VECTOR_ORDER_ERROR(name) \ BIT_VECTOR_ERROR(name,"minimum > maximum index") #define BIT_VECTOR_START_ERROR(name) \ BIT_VECTOR_ERROR(name,"start index out of range") #define BIT_VECTOR_OFFSET_ERROR(name) \ BIT_VECTOR_ERROR(name,"offset out of range") #define BIT_VECTOR_CHUNK_ERROR(name) \ BIT_VECTOR_ERROR(name,"chunk size out of range") #define BIT_VECTOR_SIZE_ERROR(name) \ BIT_VECTOR_ERROR(name,"bit vector size mismatch") #define BIT_VECTOR_SET_ERROR(name) \ BIT_VECTOR_ERROR(name,"set size mismatch") #define BIT_VECTOR_MATRIX_ERROR(name) \ BIT_VECTOR_ERROR(name,"matrix size mismatch") #define BIT_VECTOR_SHAPE_ERROR(name) \ BIT_VECTOR_ERROR(name,"not a square matrix") #define BIT_VECTOR_SYNTAX_ERROR(name) \ BIT_VECTOR_ERROR(name,"input string syntax error") #define BIT_VECTOR_OVERFLOW_ERROR(name) \ BIT_VECTOR_ERROR(name,"numeric overflow error") #define BIT_VECTOR_DISTINCT_ERROR(name) \ BIT_VECTOR_ERROR(name,"result vector(s) must be distinct") #define BIT_VECTOR_ZERO_ERROR(name) \ BIT_VECTOR_ERROR(name,"division by zero error") #define BIT_VECTOR_EXPONENT_ERROR(name) \ BIT_VECTOR_ERROR(name,"exponent must be positive") #define BIT_VECTOR_INTERNAL_ERROR(name) \ BIT_VECTOR_ERROR(name,"unexpected internal error - please contact author") #define BIT_VECTOR_EXCEPTION(code,name) \ { switch (code) { case ErrCode_Ok: break; \ case ErrCode_Null: BIT_VECTOR_MEMORY_ERROR(name); break; \ case ErrCode_Indx: BIT_VECTOR_INDEX_ERROR(name); break; \ case ErrCode_Ordr: BIT_VECTOR_ORDER_ERROR(name); break; \ case ErrCode_Size: BIT_VECTOR_SIZE_ERROR(name); break; \ case ErrCode_Pars: BIT_VECTOR_SYNTAX_ERROR(name); break; \ case ErrCode_Ovfl: BIT_VECTOR_OVERFLOW_ERROR(name); break; \ case ErrCode_Same: BIT_VECTOR_DISTINCT_ERROR(name); break; \ case ErrCode_Expo: BIT_VECTOR_EXPONENT_ERROR(name); break; \ case ErrCode_Zero: BIT_VECTOR_ZERO_ERROR(name); break; \ default: BIT_VECTOR_INTERNAL_ERROR(name); break; } } MODULE = Bit::Vector PACKAGE = Bit::Vector PREFIX = BitVector_ PROTOTYPES: DISABLE BOOT: { ErrCode rc; if (rc = BitVector_Boot()) { switch (rc) { case ErrCode_Type: BIT_VECTOR_ERROR("Boot","sizeof(word) > sizeof(size_t)"); break; case ErrCode_Bits: BIT_VECTOR_ERROR("Boot","bits(word) != sizeof(word)*8"); break; case ErrCode_Word: BIT_VECTOR_ERROR("Boot","bits(word) < 16"); break; case ErrCode_Long: BIT_VECTOR_ERROR("Boot","bits(word) > bits(long)"); break; case ErrCode_Powr: BIT_VECTOR_ERROR("Boot","bits(word) != 2^x"); break; case ErrCode_Loga: BIT_VECTOR_ERROR("Boot","bits(word) != 2^ld(bits(word))"); break; case ErrCode_Null: BIT_VECTOR_MEMORY_ERROR("Boot"); break; default: BIT_VECTOR_INTERNAL_ERROR("Boot"); break; } exit(rc); } BitVector_Stash = gv_stashpv(BitVector_Class,1); } void BitVector_Version(...) PPCODE: { charptr string; if ((items >= 0) and (items <= 1)) { string = BitVector_Version(); if (string != NULL) { EXTEND(sp,1); PUSHs(sv_2mortal(newSVpv((char *)string,0))); } else BIT_VECTOR_MEMORY_ERROR("Version"); } else croak("Usage: Bit::Vector->Version()"); } N_int BitVector_Word_Bits(...) CODE: { if ((items >= 0) and (items <= 1)) { RETVAL = BitVector_Word_Bits(); } else croak("Usage: Bit::Vector->Word_Bits()"); } OUTPUT: RETVAL N_int BitVector_Long_Bits(...) CODE: { if ((items >= 0) and (items <= 1)) { RETVAL = BitVector_Long_Bits(); } else croak("Usage: Bit::Vector->Long_Bits()"); } OUTPUT: RETVAL void BitVector_Create(class,bits) BitVector_Object class BitVector_Scalar bits ALIAS: new = 1 PPCODE: { BitVector_Address address; BitVector_Handle handle; BitVector_Object reference; N_int size; if ( BIT_VECTOR_SCALAR(bits,N_int,size) ) { if ((address = BitVector_Create(size,true)) != NULL) { handle = newSViv((IV)address); reference = sv_bless(sv_2mortal(newRV(handle)), BitVector_Stash); SvREFCNT_dec(handle); SvREADONLY_on(handle); PUSHs(reference); } else BIT_VECTOR_MEMORY_ERROR("Create"); } else BIT_VECTOR_SCALAR_ERROR("Create"); } void BitVector_new_Hex(class,bits,string) BitVector_Object class BitVector_Scalar bits BitVector_Scalar string PPCODE: { BitVector_Address address; BitVector_Handle handle; BitVector_Object reference; N_int size; charptr pointer; ErrCode code; if ( BIT_VECTOR_SCALAR(bits,N_int,size) ) { if ( BIT_VECTOR_STRING(string,pointer) ) { if ((address = BitVector_Create(size,false)) != NULL) { if (code = BitVector_from_Hex(address,pointer)) { BitVector_Destroy(address); BIT_VECTOR_EXCEPTION(code,"new_Hex"); } else { handle = newSViv((IV)address); reference = sv_bless(sv_2mortal(newRV(handle)), BitVector_Stash); SvREFCNT_dec(handle); SvREADONLY_on(handle); PUSHs(reference); } } else BIT_VECTOR_MEMORY_ERROR("new_Hex"); } else BIT_VECTOR_STRING_ERROR("new_Hex"); } else BIT_VECTOR_SCALAR_ERROR("new_Hex"); } void BitVector_new_Bin(class,bits,string) BitVector_Object class BitVector_Scalar bits BitVector_Scalar string PPCODE: { BitVector_Address address; BitVector_Handle handle; BitVector_Object reference; N_int size; charptr pointer; ErrCode code; if ( BIT_VECTOR_SCALAR(bits,N_int,size) ) { if ( BIT_VECTOR_STRING(string,pointer) ) { if ((address = BitVector_Create(size,false)) != NULL) { if (code = BitVector_from_Bin(address,pointer)) { BitVector_Destroy(address); BIT_VECTOR_EXCEPTION(code,"new_Bin"); } else { handle = newSViv((IV)address); reference = sv_bless(sv_2mortal(newRV(handle)), BitVector_Stash); SvREFCNT_dec(handle); SvREADONLY_on(handle); PUSHs(reference); } } else BIT_VECTOR_MEMORY_ERROR("new_Bin"); } else BIT_VECTOR_STRING_ERROR("new_Bin"); } else BIT_VECTOR_SCALAR_ERROR("new_Bin"); } void BitVector_new_Dec(class,bits,string) BitVector_Object class BitVector_Scalar bits BitVector_Scalar string PPCODE: { BitVector_Address address; BitVector_Handle handle; BitVector_Object reference; N_int size; charptr pointer; ErrCode code; if ( BIT_VECTOR_SCALAR(bits,N_int,size) ) { if ( BIT_VECTOR_STRING(string,pointer) ) { if ((address = BitVector_Create(size,false)) != NULL) { if (code = BitVector_from_Dec(address,pointer)) { BitVector_Destroy(address); BIT_VECTOR_EXCEPTION(code,"new_Dec"); } else { handle = newSViv((IV)address); reference = sv_bless(sv_2mortal(newRV(handle)), BitVector_Stash); SvREFCNT_dec(handle); SvREADONLY_on(handle); PUSHs(reference); } } else BIT_VECTOR_MEMORY_ERROR("new_Dec"); } else BIT_VECTOR_STRING_ERROR("new_Dec"); } else BIT_VECTOR_SCALAR_ERROR("new_Dec"); } void BitVector_new_Enum(class,bits,string) BitVector_Object class BitVector_Scalar bits BitVector_Scalar string PPCODE: { BitVector_Address address; BitVector_Handle handle; BitVector_Object reference; N_int size; charptr pointer; ErrCode code; if ( BIT_VECTOR_SCALAR(bits,N_int,size) ) { if ( BIT_VECTOR_STRING(string,pointer) ) { if ((address = BitVector_Create(size,false)) != NULL) { if (code = BitVector_from_Enum(address,pointer)) { BitVector_Destroy(address); BIT_VECTOR_EXCEPTION(code,"new_Enum"); } else { handle = newSViv((IV)address); reference = sv_bless(sv_2mortal(newRV(handle)), BitVector_Stash); SvREFCNT_dec(handle); SvREADONLY_on(handle); PUSHs(reference); } } else BIT_VECTOR_MEMORY_ERROR("new_Enum"); } else BIT_VECTOR_STRING_ERROR("new_Enum"); } else BIT_VECTOR_SCALAR_ERROR("new_Enum"); } void BitVector_Shadow(reference) BitVector_Object reference PPCODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ((address = BitVector_Shadow(address)) != NULL) { handle = newSViv((IV)address); reference = sv_bless(sv_2mortal(newRV(handle)), BitVector_Stash); SvREFCNT_dec(handle); SvREADONLY_on(handle); PUSHs(reference); } else BIT_VECTOR_MEMORY_ERROR("Shadow"); } else BIT_VECTOR_OBJECT_ERROR("Shadow"); } void BitVector_Clone(reference) BitVector_Object reference PPCODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ((address = BitVector_Clone(address)) != NULL) { handle = newSViv((IV)address); reference = sv_bless(sv_2mortal(newRV(handle)), BitVector_Stash); SvREFCNT_dec(handle); SvREADONLY_on(handle); PUSHs(reference); } else BIT_VECTOR_MEMORY_ERROR("Clone"); } else BIT_VECTOR_OBJECT_ERROR("Clone"); } void BitVector_Concat(Xref,Yref) BitVector_Object Xref BitVector_Object Yref PPCODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Object reference; BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if ((address = BitVector_Concat(Xadr,Yadr)) != NULL) { handle = newSViv((IV)address); reference = sv_bless(sv_2mortal(newRV(handle)), BitVector_Stash); SvREFCNT_dec(handle); SvREADONLY_on(handle); PUSHs(reference); } else BIT_VECTOR_MEMORY_ERROR("Concat"); } else BIT_VECTOR_OBJECT_ERROR("Concat"); } void BitVector_Concat_List(...) PPCODE: { BitVector_Object Xref; BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Object reference; BitVector_Handle handle; BitVector_Address address; N_int offset; N_int bits; I32 index; bits = 0; index = items; while (index-- > 0) { Xref = ST(index); if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) ) { bits += bits_(Xadr); } else if ((index != 0) or SvROK(Xref)) BIT_VECTOR_OBJECT_ERROR("Concat_List"); } if ((address = BitVector_Create(bits,false)) != NULL) { offset = 0; index = items; while (index-- > 0) { Xref = ST(index); if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) ) { if ((bits = bits_(Xadr)) > 0) { BitVector_Interval_Copy(address,Xadr,offset,0,bits); offset += bits; } } else if ((index != 0) or SvROK(Xref)) BIT_VECTOR_OBJECT_ERROR("Concat_List"); } handle = newSViv((IV)address); reference = sv_bless(sv_2mortal(newRV(handle)), BitVector_Stash); SvREFCNT_dec(handle); SvREADONLY_on(handle); PUSHs(reference); } else BIT_VECTOR_MEMORY_ERROR("Concat_List"); } N_int BitVector_Size(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = bits_(address); } else BIT_VECTOR_OBJECT_ERROR("Size"); } OUTPUT: RETVAL void BitVector_Resize(reference,bits) BitVector_Object reference BitVector_Scalar bits CODE: { BitVector_Handle handle; BitVector_Address address; N_int size; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(bits,N_int,size) ) { address = BitVector_Resize(address,size); SvREADONLY_off(handle); sv_setiv(handle,(IV)address); SvREADONLY_on(handle); if (address == NULL) BIT_VECTOR_MEMORY_ERROR("Resize"); } else BIT_VECTOR_SCALAR_ERROR("Resize"); } else BIT_VECTOR_OBJECT_ERROR("Resize"); } void BitVector_DESTROY(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { BitVector_Destroy(address); SvREADONLY_off(handle); sv_setiv(handle,(IV)NULL); SvREADONLY_on(handle); } /* else BIT_VECTOR_OBJECT_ERROR("DESTROY"); */ } void BitVector_Copy(Xref,Yref) BitVector_Object Xref BitVector_Object Yref CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { BitVector_Copy(Xadr,Yadr); } else BIT_VECTOR_OBJECT_ERROR("Copy"); } void BitVector_Empty(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { BitVector_Empty(address); } else BIT_VECTOR_OBJECT_ERROR("Empty"); } void BitVector_Fill(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { BitVector_Fill(address); } else BIT_VECTOR_OBJECT_ERROR("Fill"); } void BitVector_Flip(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { BitVector_Flip(address); } else BIT_VECTOR_OBJECT_ERROR("Flip"); } void BitVector_Primes(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { BitVector_Primes(address); } else BIT_VECTOR_OBJECT_ERROR("Primes"); } void BitVector_Reverse(Xref,Yref) BitVector_Object Xref BitVector_Object Yref CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if (bits_(Xadr) == bits_(Yadr)) { BitVector_Reverse(Xadr,Yadr); } else BIT_VECTOR_SIZE_ERROR("Reverse"); } else BIT_VECTOR_OBJECT_ERROR("Reverse"); } void BitVector_Interval_Empty(reference,min,max) BitVector_Object reference BitVector_Scalar min BitVector_Scalar max ALIAS: Empty_Interval = 2 CODE: { BitVector_Handle handle; BitVector_Address address; N_int lower; N_int upper; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(min,N_int,lower) && BIT_VECTOR_SCALAR(max,N_int,upper) ) { if (lower >= bits_(address)) BIT_VECTOR_MIN_ERROR("Interval_Empty"); else if (upper >= bits_(address)) BIT_VECTOR_MAX_ERROR("Interval_Empty"); else if (lower > upper) BIT_VECTOR_ORDER_ERROR("Interval_Empty"); else BitVector_Interval_Empty(address,lower,upper); } else BIT_VECTOR_SCALAR_ERROR("Interval_Empty"); } else BIT_VECTOR_OBJECT_ERROR("Interval_Empty"); } void BitVector_Interval_Fill(reference,min,max) BitVector_Object reference BitVector_Scalar min BitVector_Scalar max ALIAS: Fill_Interval = 2 CODE: { BitVector_Handle handle; BitVector_Address address; N_int lower; N_int upper; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(min,N_int,lower) && BIT_VECTOR_SCALAR(max,N_int,upper) ) { if (lower >= bits_(address)) BIT_VECTOR_MIN_ERROR("Interval_Fill"); else if (upper >= bits_(address)) BIT_VECTOR_MAX_ERROR("Interval_Fill"); else if (lower > upper) BIT_VECTOR_ORDER_ERROR("Interval_Fill"); else BitVector_Interval_Fill(address,lower,upper); } else BIT_VECTOR_SCALAR_ERROR("Interval_Fill"); } else BIT_VECTOR_OBJECT_ERROR("Interval_Fill"); } void BitVector_Interval_Flip(reference,min,max) BitVector_Object reference BitVector_Scalar min BitVector_Scalar max ALIAS: Flip_Interval = 2 CODE: { BitVector_Handle handle; BitVector_Address address; N_int lower; N_int upper; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(min,N_int,lower) && BIT_VECTOR_SCALAR(max,N_int,upper) ) { if (lower >= bits_(address)) BIT_VECTOR_MIN_ERROR("Interval_Flip"); else if (upper >= bits_(address)) BIT_VECTOR_MAX_ERROR("Interval_Flip"); else if (lower > upper) BIT_VECTOR_ORDER_ERROR("Interval_Flip"); else BitVector_Interval_Flip(address,lower,upper); } else BIT_VECTOR_SCALAR_ERROR("Interval_Flip"); } else BIT_VECTOR_OBJECT_ERROR("Interval_Flip"); } void BitVector_Interval_Reverse(reference,min,max) BitVector_Object reference BitVector_Scalar min BitVector_Scalar max CODE: { BitVector_Handle handle; BitVector_Address address; N_int lower; N_int upper; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(min,N_int,lower) && BIT_VECTOR_SCALAR(max,N_int,upper) ) { if (lower >= bits_(address)) BIT_VECTOR_MIN_ERROR("Interval_Reverse"); else if (upper >= bits_(address)) BIT_VECTOR_MAX_ERROR("Interval_Reverse"); else if (lower > upper) BIT_VECTOR_ORDER_ERROR("Interval_Reverse"); else BitVector_Interval_Reverse(address,lower,upper); } else BIT_VECTOR_SCALAR_ERROR("Interval_Reverse"); } else BIT_VECTOR_OBJECT_ERROR("Interval_Reverse"); } void BitVector_Interval_Scan_inc(reference,start) BitVector_Object reference BitVector_Scalar start PPCODE: { BitVector_Handle handle; BitVector_Address address; N_int first; N_int min; N_int max; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(start,N_int,first) ) { if (first < bits_(address)) { if ( BitVector_interval_scan_inc(address,first,&min,&max) ) { EXTEND(sp,2); PUSHs(sv_2mortal(newSViv((IV)min))); PUSHs(sv_2mortal(newSViv((IV)max))); } /* else return empty list */ } else BIT_VECTOR_START_ERROR("Interval_Scan_inc"); } else BIT_VECTOR_SCALAR_ERROR("Interval_Scan_inc"); } else BIT_VECTOR_OBJECT_ERROR("Interval_Scan_inc"); } void BitVector_Interval_Scan_dec(reference,start) BitVector_Object reference BitVector_Scalar start PPCODE: { BitVector_Handle handle; BitVector_Address address; N_int first; N_int min; N_int max; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(start,N_int,first) ) { if (first < bits_(address)) { if ( BitVector_interval_scan_dec(address,first,&min,&max) ) { EXTEND(sp,2); PUSHs(sv_2mortal(newSViv((IV)min))); PUSHs(sv_2mortal(newSViv((IV)max))); } /* else return empty list */ } else BIT_VECTOR_START_ERROR("Interval_Scan_dec"); } else BIT_VECTOR_SCALAR_ERROR("Interval_Scan_dec"); } else BIT_VECTOR_OBJECT_ERROR("Interval_Scan_dec"); } void BitVector_Interval_Copy(Xref,Yref,Xoffset,Yoffset,length) BitVector_Object Xref BitVector_Object Yref BitVector_Scalar Xoffset BitVector_Scalar Yoffset BitVector_Scalar length CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; N_int Xoff; N_int Yoff; N_int len; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if ( BIT_VECTOR_SCALAR(Xoffset,N_int,Xoff) && BIT_VECTOR_SCALAR(Yoffset,N_int,Yoff) && BIT_VECTOR_SCALAR(length, N_int,len) ) { if ((Xoff < bits_(Xadr)) and (Yoff < bits_(Yadr))) { if (len > 0) BitVector_Interval_Copy(Xadr,Yadr,Xoff,Yoff,len); } else BIT_VECTOR_OFFSET_ERROR("Interval_Copy"); } else BIT_VECTOR_SCALAR_ERROR("Interval_Copy"); } else BIT_VECTOR_OBJECT_ERROR("Interval_Copy"); } void BitVector_Interval_Substitute(Xref,Yref,Xoffset,Xlength,Yoffset,Ylength) BitVector_Object Xref BitVector_Object Yref BitVector_Scalar Xoffset BitVector_Scalar Xlength BitVector_Scalar Yoffset BitVector_Scalar Ylength CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; N_int Xoff; N_int Xlen; N_int Yoff; N_int Ylen; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if ( BIT_VECTOR_SCALAR(Xoffset,N_int,Xoff) && BIT_VECTOR_SCALAR(Xlength,N_int,Xlen) && BIT_VECTOR_SCALAR(Yoffset,N_int,Yoff) && BIT_VECTOR_SCALAR(Ylength,N_int,Ylen) ) { if ((Xoff <= bits_(Xadr)) and (Yoff <= bits_(Yadr))) { Xadr = BitVector_Interval_Substitute(Xadr,Yadr,Xoff,Xlen,Yoff,Ylen); SvREADONLY_off(Xhdl); sv_setiv(Xhdl,(IV)Xadr); SvREADONLY_on(Xhdl); if (Xadr == NULL) BIT_VECTOR_MEMORY_ERROR("Interval_Substitute"); } else BIT_VECTOR_OFFSET_ERROR("Interval_Substitute"); } else BIT_VECTOR_SCALAR_ERROR("Interval_Substitute"); } else BIT_VECTOR_OBJECT_ERROR("Interval_Substitute"); } boolean BitVector_is_empty(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = BitVector_is_empty(address); } else BIT_VECTOR_OBJECT_ERROR("is_empty"); } OUTPUT: RETVAL boolean BitVector_is_full(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = BitVector_is_full(address); } else BIT_VECTOR_OBJECT_ERROR("is_full"); } OUTPUT: RETVAL boolean BitVector_equal(Xref,Yref) BitVector_Object Xref BitVector_Object Yref CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if (bits_(Xadr) == bits_(Yadr)) { RETVAL = BitVector_equal(Xadr,Yadr); } else BIT_VECTOR_SIZE_ERROR("equal"); } else BIT_VECTOR_OBJECT_ERROR("equal"); } OUTPUT: RETVAL Z_int BitVector_Lexicompare(Xref,Yref) BitVector_Object Xref BitVector_Object Yref CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if (bits_(Xadr) == bits_(Yadr)) { RETVAL = BitVector_Lexicompare(Xadr,Yadr); } else BIT_VECTOR_SIZE_ERROR("Lexicompare"); } else BIT_VECTOR_OBJECT_ERROR("Lexicompare"); } OUTPUT: RETVAL Z_int BitVector_Compare(Xref,Yref) BitVector_Object Xref BitVector_Object Yref CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if (bits_(Xadr) == bits_(Yadr)) { RETVAL = BitVector_Compare(Xadr,Yadr); } else BIT_VECTOR_SIZE_ERROR("Compare"); } else BIT_VECTOR_OBJECT_ERROR("Compare"); } OUTPUT: RETVAL void BitVector_to_Hex(reference) BitVector_Object reference ALIAS: to_String = 2 PPCODE: { BitVector_Handle handle; BitVector_Address address; charptr string; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { string = BitVector_to_Hex(address); if (string != NULL) { EXTEND(sp,1); PUSHs(sv_2mortal(newSVpv((char *)string,0))); BitVector_Dispose(string); } else BIT_VECTOR_MEMORY_ERROR("to_Hex"); } else BIT_VECTOR_OBJECT_ERROR("to_Hex"); } void BitVector_from_Hex(reference,string) BitVector_Object reference BitVector_Scalar string ALIAS: from_string = 2 CODE: { BitVector_Handle handle; BitVector_Address address; charptr pointer; ErrCode code; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_STRING(string,pointer) ) { if (code = BitVector_from_Hex(address,pointer)) { BIT_VECTOR_EXCEPTION(code,"from_Hex"); } } else BIT_VECTOR_STRING_ERROR("from_Hex"); } else BIT_VECTOR_OBJECT_ERROR("from_Hex"); } void BitVector_to_Bin(reference) BitVector_Object reference PPCODE: { BitVector_Handle handle; BitVector_Address address; charptr string; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { string = BitVector_to_Bin(address); if (string != NULL) { EXTEND(sp,1); PUSHs(sv_2mortal(newSVpv((char *)string,0))); BitVector_Dispose(string); } else BIT_VECTOR_MEMORY_ERROR("to_Bin"); } else BIT_VECTOR_OBJECT_ERROR("to_Bin"); } void BitVector_from_Bin(reference,string) BitVector_Object reference BitVector_Scalar string CODE: { BitVector_Handle handle; BitVector_Address address; charptr pointer; ErrCode code; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_STRING(string,pointer) ) { if (code = BitVector_from_Bin(address,pointer)) { BIT_VECTOR_EXCEPTION(code,"from_Bin"); } } else BIT_VECTOR_STRING_ERROR("from_Bin"); } else BIT_VECTOR_OBJECT_ERROR("from_Bin"); } void BitVector_to_Dec(reference) BitVector_Object reference PPCODE: { BitVector_Handle handle; BitVector_Address address; charptr string; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { string = BitVector_to_Dec(address); if (string != NULL) { EXTEND(sp,1); PUSHs(sv_2mortal(newSVpv((char *)string,0))); BitVector_Dispose(string); } else BIT_VECTOR_MEMORY_ERROR("to_Dec"); } else BIT_VECTOR_OBJECT_ERROR("to_Dec"); } void BitVector_from_Dec(reference,string) BitVector_Object reference BitVector_Scalar string CODE: { BitVector_Handle handle; BitVector_Address address; charptr pointer; ErrCode code; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_STRING(string,pointer) ) { if (code = BitVector_from_Dec(address,pointer)) { BIT_VECTOR_EXCEPTION(code,"from_Dec"); } } else BIT_VECTOR_STRING_ERROR("from_Dec"); } else BIT_VECTOR_OBJECT_ERROR("from_Dec"); } void BitVector_to_Enum(reference) BitVector_Object reference ALIAS: to_ASCII = 2 PPCODE: { BitVector_Handle handle; BitVector_Address address; charptr string; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { string = BitVector_to_Enum(address); if (string != NULL) { EXTEND(sp,1); PUSHs(sv_2mortal(newSVpv((char *)string,0))); BitVector_Dispose(string); } else BIT_VECTOR_MEMORY_ERROR("to_Enum"); } else BIT_VECTOR_OBJECT_ERROR("to_Enum"); } void BitVector_from_Enum(reference,string) BitVector_Object reference BitVector_Scalar string ALIAS: from_ASCII = 2 CODE: { BitVector_Handle handle; BitVector_Address address; charptr pointer; ErrCode code; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_STRING(string,pointer) ) { if (code = BitVector_from_Enum(address,pointer)) { BIT_VECTOR_EXCEPTION(code,"from_Enum"); } } else BIT_VECTOR_STRING_ERROR("from_Enum"); } else BIT_VECTOR_OBJECT_ERROR("from_Enum"); } void BitVector_Bit_Off(reference,index) BitVector_Object reference BitVector_Scalar index CODE: { BitVector_Handle handle; BitVector_Address address; N_int idx; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(index,N_int,idx) ) { if (idx < bits_(address)) { BitVector_Bit_Off(address,idx); } else BIT_VECTOR_INDEX_ERROR("Bit_Off"); } else BIT_VECTOR_SCALAR_ERROR("Bit_Off"); } else BIT_VECTOR_OBJECT_ERROR("Bit_Off"); } void BitVector_Bit_On(reference,index) BitVector_Object reference BitVector_Scalar index CODE: { BitVector_Handle handle; BitVector_Address address; N_int idx; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(index,N_int,idx) ) { if (idx < bits_(address)) { BitVector_Bit_On(address,idx); } else BIT_VECTOR_INDEX_ERROR("Bit_On"); } else BIT_VECTOR_SCALAR_ERROR("Bit_On"); } else BIT_VECTOR_OBJECT_ERROR("Bit_On"); } boolean BitVector_bit_flip(reference,index) BitVector_Object reference BitVector_Scalar index ALIAS: flip = 2 CODE: { BitVector_Handle handle; BitVector_Address address; N_int idx; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(index,N_int,idx) ) { if (idx < bits_(address)) { RETVAL = BitVector_bit_flip(address,idx); } else BIT_VECTOR_INDEX_ERROR("bit_flip"); } else BIT_VECTOR_SCALAR_ERROR("bit_flip"); } else BIT_VECTOR_OBJECT_ERROR("bit_flip"); } OUTPUT: RETVAL boolean BitVector_bit_test(reference,index) BitVector_Object reference BitVector_Scalar index ALIAS: contains = 1 in = 2 CODE: { BitVector_Handle handle; BitVector_Address address; N_int idx; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(index,N_int,idx) ) { if (idx < bits_(address)) { RETVAL = BitVector_bit_test(address,idx); } else BIT_VECTOR_INDEX_ERROR("bit_test"); } else BIT_VECTOR_SCALAR_ERROR("bit_test"); } else BIT_VECTOR_OBJECT_ERROR("bit_test"); } OUTPUT: RETVAL void BitVector_Bit_Copy(reference,index,bit) BitVector_Object reference BitVector_Scalar index BitVector_Scalar bit CODE: { BitVector_Handle handle; BitVector_Address address; N_int idx; boolean b; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(index,N_int,idx) && BIT_VECTOR_SCALAR(bit,boolean,b) ) { if (idx < bits_(address)) { BitVector_Bit_Copy(address,idx,b); } else BIT_VECTOR_INDEX_ERROR("Bit_Copy"); } else BIT_VECTOR_SCALAR_ERROR("Bit_Copy"); } else BIT_VECTOR_OBJECT_ERROR("Bit_Copy"); } void BitVector_LSB(reference,bit) BitVector_Object reference BitVector_Scalar bit CODE: { BitVector_Handle handle; BitVector_Address address; boolean b; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(bit,boolean,b) ) { BitVector_LSB(address,b); } else BIT_VECTOR_SCALAR_ERROR("LSB"); } else BIT_VECTOR_OBJECT_ERROR("LSB"); } void BitVector_MSB(reference,bit) BitVector_Object reference BitVector_Scalar bit CODE: { BitVector_Handle handle; BitVector_Address address; boolean b; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(bit,boolean,b) ) { BitVector_MSB(address,b); } else BIT_VECTOR_SCALAR_ERROR("MSB"); } else BIT_VECTOR_OBJECT_ERROR("MSB"); } boolean BitVector_lsb(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = BitVector_lsb(address); } else BIT_VECTOR_OBJECT_ERROR("lsb"); } OUTPUT: RETVAL boolean BitVector_msb(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = BitVector_msb(address); } else BIT_VECTOR_OBJECT_ERROR("msb"); } OUTPUT: RETVAL boolean BitVector_rotate_left(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = BitVector_rotate_left(address); } else BIT_VECTOR_OBJECT_ERROR("rotate_left"); } OUTPUT: RETVAL boolean BitVector_rotate_right(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = BitVector_rotate_right(address); } else BIT_VECTOR_OBJECT_ERROR("rotate_right"); } OUTPUT: RETVAL boolean BitVector_shift_left(reference,carry) BitVector_Object reference BitVector_Scalar carry CODE: { BitVector_Handle handle; BitVector_Address address; boolean c; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(carry,boolean,c) ) { RETVAL = BitVector_shift_left(address,c); } else BIT_VECTOR_SCALAR_ERROR("shift_left"); } else BIT_VECTOR_OBJECT_ERROR("shift_left"); } OUTPUT: RETVAL boolean BitVector_shift_right(reference,carry) BitVector_Object reference BitVector_Scalar carry CODE: { BitVector_Handle handle; BitVector_Address address; boolean c; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(carry,boolean,c) ) { RETVAL = BitVector_shift_right(address,c); } else BIT_VECTOR_SCALAR_ERROR("shift_right"); } else BIT_VECTOR_OBJECT_ERROR("shift_right"); } OUTPUT: RETVAL void BitVector_Move_Left(reference,bits) BitVector_Object reference BitVector_Scalar bits CODE: { BitVector_Handle handle; BitVector_Address address; N_int cnt; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(bits,N_int,cnt) ) { BitVector_Move_Left(address,cnt); } else BIT_VECTOR_SCALAR_ERROR("Move_Left"); } else BIT_VECTOR_OBJECT_ERROR("Move_Left"); } void BitVector_Move_Right(reference,bits) BitVector_Object reference BitVector_Scalar bits CODE: { BitVector_Handle handle; BitVector_Address address; N_int cnt; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(bits,N_int,cnt) ) { BitVector_Move_Right(address,cnt); } else BIT_VECTOR_SCALAR_ERROR("Move_Right"); } else BIT_VECTOR_OBJECT_ERROR("Move_Right"); } void BitVector_Insert(reference,offset,count) BitVector_Object reference BitVector_Scalar offset BitVector_Scalar count CODE: { BitVector_Handle handle; BitVector_Address address; N_int off; N_int cnt; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(offset,N_int,off) && BIT_VECTOR_SCALAR(count,N_int,cnt) ) { if (off < bits_(address)) { BitVector_Insert(address,off,cnt,true); } else BIT_VECTOR_OFFSET_ERROR("Insert"); } else BIT_VECTOR_SCALAR_ERROR("Insert"); } else BIT_VECTOR_OBJECT_ERROR("Insert"); } void BitVector_Delete(reference,offset,count) BitVector_Object reference BitVector_Scalar offset BitVector_Scalar count CODE: { BitVector_Handle handle; BitVector_Address address; N_int off; N_int cnt; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(offset,N_int,off) && BIT_VECTOR_SCALAR(count,N_int,cnt) ) { if (off < bits_(address)) { BitVector_Delete(address,off,cnt,true); } else BIT_VECTOR_OFFSET_ERROR("Delete"); } else BIT_VECTOR_SCALAR_ERROR("Delete"); } else BIT_VECTOR_OBJECT_ERROR("Delete"); } boolean BitVector_increment(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = BitVector_increment(address); } else BIT_VECTOR_OBJECT_ERROR("increment"); } OUTPUT: RETVAL boolean BitVector_decrement(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = BitVector_decrement(address); } else BIT_VECTOR_OBJECT_ERROR("decrement"); } OUTPUT: RETVAL boolean BitVector_add(Xref,Yref,Zref,carry) BitVector_Object Xref BitVector_Object Yref BitVector_Object Zref BitVector_Scalar carry PPCODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Handle Zhdl; BitVector_Address Zadr; boolean c; boolean v; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) && BIT_VECTOR_OBJECT(Zref,Zhdl,Zadr) ) { if ( BIT_VECTOR_SCALAR(carry,boolean,c) ) { if ((bits_(Xadr) == bits_(Yadr)) and (bits_(Xadr) == bits_(Zadr))) { v = BitVector_compute(Xadr,Yadr,Zadr,false,&c); if (GIMME == G_ARRAY) { EXTEND(sp,2); PUSHs(sv_2mortal(newSViv((IV)c))); PUSHs(sv_2mortal(newSViv((IV)v))); } else { EXTEND(sp,1); PUSHs(sv_2mortal(newSViv((IV)c))); } } else BIT_VECTOR_SIZE_ERROR("add"); } else BIT_VECTOR_SCALAR_ERROR("add"); } else BIT_VECTOR_OBJECT_ERROR("add"); } boolean BitVector_subtract(Xref,Yref,Zref,carry) BitVector_Object Xref BitVector_Object Yref BitVector_Object Zref BitVector_Scalar carry ALIAS: sub = 2 PPCODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Handle Zhdl; BitVector_Address Zadr; boolean c; boolean v; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) && BIT_VECTOR_OBJECT(Zref,Zhdl,Zadr) ) { if ( BIT_VECTOR_SCALAR(carry,boolean,c) ) { if ((bits_(Xadr) == bits_(Yadr)) and (bits_(Xadr) == bits_(Zadr))) { v = BitVector_compute(Xadr,Yadr,Zadr,true,&c); if (GIMME == G_ARRAY) { EXTEND(sp,2); PUSHs(sv_2mortal(newSViv((IV)c))); PUSHs(sv_2mortal(newSViv((IV)v))); } else { EXTEND(sp,1); PUSHs(sv_2mortal(newSViv((IV)c))); } } else BIT_VECTOR_SIZE_ERROR("subtract"); } else BIT_VECTOR_SCALAR_ERROR("subtract"); } else BIT_VECTOR_OBJECT_ERROR("subtract"); } boolean BitVector_inc(Xref,Yref) BitVector_Object Xref BitVector_Object Yref CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; boolean c = true; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if (bits_(Xadr) == bits_(Yadr)) { RETVAL = BitVector_compute(Xadr,Yadr,NULL,false,&c); } else BIT_VECTOR_SIZE_ERROR("inc"); } else BIT_VECTOR_OBJECT_ERROR("inc"); } OUTPUT: RETVAL boolean BitVector_dec(Xref,Yref) BitVector_Object Xref BitVector_Object Yref CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; boolean c = true; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if (bits_(Xadr) == bits_(Yadr)) { RETVAL = BitVector_compute(Xadr,Yadr,NULL,true,&c); } else BIT_VECTOR_SIZE_ERROR("dec"); } else BIT_VECTOR_OBJECT_ERROR("dec"); } OUTPUT: RETVAL void BitVector_Negate(Xref,Yref) BitVector_Object Xref BitVector_Object Yref ALIAS: Neg = 1 CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if (bits_(Xadr) == bits_(Yadr)) { BitVector_Negate(Xadr,Yadr); } else BIT_VECTOR_SIZE_ERROR("Negate"); } else BIT_VECTOR_OBJECT_ERROR("Negate"); } void BitVector_Absolute(Xref,Yref) BitVector_Object Xref BitVector_Object Yref CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if (bits_(Xadr) == bits_(Yadr)) { BitVector_Absolute(Xadr,Yadr); } else BIT_VECTOR_SIZE_ERROR("Absolute"); } else BIT_VECTOR_OBJECT_ERROR("Absolute"); } Z_int BitVector_Sign(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = BitVector_Sign(address); } else BIT_VECTOR_OBJECT_ERROR("Sign"); } OUTPUT: RETVAL void BitVector_Multiply(Xref,Yref,Zref) BitVector_Object Xref BitVector_Object Yref BitVector_Object Zref CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Handle Zhdl; BitVector_Address Zadr; ErrCode code; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) && BIT_VECTOR_OBJECT(Zref,Zhdl,Zadr) ) { if ((bits_(Xadr) >= bits_(Yadr)) and (bits_(Yadr) == bits_(Zadr))) { if (code = BitVector_Multiply(Xadr,Yadr,Zadr)) BIT_VECTOR_EXCEPTION(code,"Multiply"); } else BIT_VECTOR_SIZE_ERROR("Multiply"); } else BIT_VECTOR_OBJECT_ERROR("Multiply"); } void BitVector_Divide(Qref,Xref,Yref,Rref) BitVector_Object Qref BitVector_Object Xref BitVector_Object Yref BitVector_Object Rref CODE: { BitVector_Handle Qhdl; BitVector_Address Qadr; BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Handle Rhdl; BitVector_Address Radr; ErrCode code; if ( BIT_VECTOR_OBJECT(Qref,Qhdl,Qadr) && BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) && BIT_VECTOR_OBJECT(Rref,Rhdl,Radr) ) { if ((bits_(Qadr) == bits_(Xadr)) and (bits_(Qadr) == bits_(Yadr)) and (bits_(Qadr) == bits_(Radr))) { if (Qadr != Radr) { if (not BitVector_is_empty(Yadr)) { if (code = BitVector_Divide(Qadr,Xadr,Yadr,Radr)) BIT_VECTOR_EXCEPTION(code,"Divide"); } else BIT_VECTOR_ZERO_ERROR("Divide"); } else BIT_VECTOR_DISTINCT_ERROR("Divide"); } else BIT_VECTOR_SIZE_ERROR("Divide"); } else BIT_VECTOR_OBJECT_ERROR("Divide"); } void BitVector_GCD(Xref,Yref,Zref) BitVector_Object Xref BitVector_Object Yref BitVector_Object Zref CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Handle Zhdl; BitVector_Address Zadr; ErrCode code; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) && BIT_VECTOR_OBJECT(Zref,Zhdl,Zadr) ) { if ((bits_(Xadr) == bits_(Yadr)) and (bits_(Xadr) == bits_(Zadr))) { if ((not BitVector_is_empty(Yadr)) and (not BitVector_is_empty(Zadr))) { if (code = BitVector_GCD(Xadr,Yadr,Zadr)) BIT_VECTOR_EXCEPTION(code,"GCD"); } else BIT_VECTOR_ZERO_ERROR("GCD"); } else BIT_VECTOR_SIZE_ERROR("GCD"); } else BIT_VECTOR_OBJECT_ERROR("GCD"); } void BitVector_Power(Xref,Yref,Zref) BitVector_Object Xref BitVector_Object Yref BitVector_Object Zref CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Handle Zhdl; BitVector_Address Zadr; ErrCode code; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) && BIT_VECTOR_OBJECT(Zref,Zhdl,Zadr) ) { if (code = BitVector_Power(Xadr,Yadr,Zadr)) BIT_VECTOR_EXCEPTION(code,"Power"); } else BIT_VECTOR_OBJECT_ERROR("Power"); } void BitVector_Block_Store(reference,buffer) BitVector_Object reference BitVector_Scalar buffer CODE: { BitVector_Handle handle; BitVector_Address address; charptr string; N_int length; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_BUFFER(buffer,string,length) ) { BitVector_Block_Store(address,string,length); } else BIT_VECTOR_STRING_ERROR("Block_Store"); } else BIT_VECTOR_OBJECT_ERROR("Block_Store"); } void BitVector_Block_Read(reference) BitVector_Object reference PPCODE: { BitVector_Handle handle; BitVector_Address address; charptr string; N_int length; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { string = BitVector_Block_Read(address,&length); if (string != NULL) { EXTEND(sp,1); PUSHs(sv_2mortal(newSVpv((char *)string,(int)length))); BitVector_Dispose(string); } else BIT_VECTOR_MEMORY_ERROR("Block_Read"); } else BIT_VECTOR_OBJECT_ERROR("Block_Read"); } N_int BitVector_Word_Size(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = size_(address); } else BIT_VECTOR_OBJECT_ERROR("Word_Size"); } OUTPUT: RETVAL void BitVector_Word_Store(reference,offset,value) BitVector_Object reference BitVector_Scalar offset BitVector_Scalar value CODE: { BitVector_Handle handle; BitVector_Address address; N_int off; N_int val; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(offset,N_int,off) && BIT_VECTOR_SCALAR(value,N_int,val) ) { if (off < size_(address)) { BitVector_Word_Store(address,off,val); } else BIT_VECTOR_OFFSET_ERROR("Word_Store"); } else BIT_VECTOR_SCALAR_ERROR("Word_Store"); } else BIT_VECTOR_OBJECT_ERROR("Word_Store"); } N_int BitVector_Word_Read(reference,offset) BitVector_Object reference BitVector_Scalar offset CODE: { BitVector_Handle handle; BitVector_Address address; N_int off; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(offset,N_int,off) ) { if (off < size_(address)) { RETVAL = BitVector_Word_Read(address,off); } else BIT_VECTOR_OFFSET_ERROR("Word_Read"); } else BIT_VECTOR_SCALAR_ERROR("Word_Read"); } else BIT_VECTOR_OBJECT_ERROR("Word_Read"); } OUTPUT: RETVAL void BitVector_Word_List_Store(reference,...) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; BitVector_Scalar scalar; N_int offset; N_int value; N_int size; I32 index; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { size = size_(address); for ( offset = 0, index = 1; ((offset < size) and (index < items)); offset++, index++ ) { scalar = ST(index); if ( BIT_VECTOR_SCALAR(scalar,N_int,value) ) { BitVector_Word_Store(address,offset,value); } else BIT_VECTOR_SCALAR_ERROR("Word_List_Store"); } for ( ; (offset < size); offset++ ) { BitVector_Word_Store(address,offset,0); } } else BIT_VECTOR_OBJECT_ERROR("Word_List_Store"); } void BitVector_Word_List_Read(reference) BitVector_Object reference PPCODE: { BitVector_Handle handle; BitVector_Address address; N_int offset; N_int value; N_int size; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { size = size_(address); EXTEND(sp,size); for ( offset = 0; (offset < size); offset++ ) { value = BitVector_Word_Read(address,offset); PUSHs(sv_2mortal(newSViv((IV)value))); } } else BIT_VECTOR_OBJECT_ERROR("Word_List_Read"); } void BitVector_Word_Insert(reference,offset,count) BitVector_Object reference BitVector_Scalar offset BitVector_Scalar count CODE: { BitVector_Handle handle; BitVector_Address address; N_int off; N_int cnt; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(offset,N_int,off) && BIT_VECTOR_SCALAR(count,N_int,cnt) ) { if (off < size_(address)) { BitVector_Word_Insert(address,off,cnt,true); } else BIT_VECTOR_OFFSET_ERROR("Word_Insert"); } else BIT_VECTOR_SCALAR_ERROR("Word_Insert"); } else BIT_VECTOR_OBJECT_ERROR("Word_Insert"); } void BitVector_Word_Delete(reference,offset,count) BitVector_Object reference BitVector_Scalar offset BitVector_Scalar count CODE: { BitVector_Handle handle; BitVector_Address address; N_int off; N_int cnt; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(offset,N_int,off) && BIT_VECTOR_SCALAR(count,N_int,cnt) ) { if (off < size_(address)) { BitVector_Word_Delete(address,off,cnt,true); } else BIT_VECTOR_OFFSET_ERROR("Word_Delete"); } else BIT_VECTOR_SCALAR_ERROR("Word_Delete"); } else BIT_VECTOR_OBJECT_ERROR("Word_Delete"); } void BitVector_Chunk_Store(reference,chunksize,offset,value) BitVector_Object reference BitVector_Scalar chunksize BitVector_Scalar offset BitVector_Scalar value CODE: { BitVector_Handle handle; BitVector_Address address; N_int bits; N_int off; N_long val; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(chunksize,N_int,bits) && BIT_VECTOR_SCALAR(offset,N_int,off) && BIT_VECTOR_SCALAR(value,N_long,val) ) { if ((bits > 0) and (bits <= BitVector_Long_Bits())) { if (off < bits_(address)) { BitVector_Chunk_Store(address,bits,off,val); } else BIT_VECTOR_OFFSET_ERROR("Chunk_Store"); } else BIT_VECTOR_CHUNK_ERROR("Chunk_Store"); } else BIT_VECTOR_SCALAR_ERROR("Chunk_Store"); } else BIT_VECTOR_OBJECT_ERROR("Chunk_Store"); } N_long BitVector_Chunk_Read(reference,chunksize,offset) BitVector_Object reference BitVector_Scalar chunksize BitVector_Scalar offset CODE: { BitVector_Handle handle; BitVector_Address address; N_int bits; N_int off; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(chunksize,N_int,bits) && BIT_VECTOR_SCALAR(offset,N_int,off) ) { if ((bits > 0) and (bits <= BitVector_Long_Bits())) { if (off < bits_(address)) { RETVAL = BitVector_Chunk_Read(address,bits,off); } else BIT_VECTOR_OFFSET_ERROR("Chunk_Read"); } else BIT_VECTOR_CHUNK_ERROR("Chunk_Read"); } else BIT_VECTOR_SCALAR_ERROR("Chunk_Read"); } else BIT_VECTOR_OBJECT_ERROR("Chunk_Read"); } OUTPUT: RETVAL void BitVector_Chunk_List_Store(reference,chunksize,...) BitVector_Object reference BitVector_Scalar chunksize CODE: { BitVector_Handle handle; BitVector_Address address; BitVector_Scalar scalar; N_int chunkspan; N_long chunkmask; N_long mask; N_long chunk; N_long value; N_int chunkbits; N_int wordbits; N_int wordsize; N_int offset; N_int size; N_int bits; I32 index; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(chunksize,N_int,chunkspan) ) { if ((chunkspan > 0) and (chunkspan <= BitVector_Long_Bits())) { wordsize = BitVector_Word_Bits(); size = size_(address); chunkmask = ~((~0L << (chunkspan-1)) << 1); /* C bug work-around */ chunk = 0L; value = 0L; index = 2; offset = 0; wordbits = 0; chunkbits = 0; while (offset < size) { if ((chunkbits == 0) and (index < items)) { scalar = ST(index); if ( BIT_VECTOR_SCALAR(scalar,N_long,chunk) ) { chunk &= chunkmask; chunkbits = chunkspan; index++; } else BIT_VECTOR_SCALAR_ERROR("Chunk_List_Store"); } bits = wordsize - wordbits; if (chunkbits <= bits) { chunk <<= wordbits; value |= chunk; wordbits += chunkbits; chunk = 0L; chunkbits = 0; } else { mask = ~(~0L << bits); mask &= chunk; mask <<= wordbits; value |= mask; wordbits += bits; chunk >>= bits; chunkbits -= bits; } if ((wordbits >= wordsize) or (index >= items)) { BitVector_Word_Store(address,offset,(N_int)value); value = 0L; wordbits = 0; offset++; } } } else BIT_VECTOR_CHUNK_ERROR("Chunk_List_Store"); } else BIT_VECTOR_SCALAR_ERROR("Chunk_List_Store"); } else BIT_VECTOR_OBJECT_ERROR("Chunk_List_Store"); } void BitVector_Chunk_List_Read(reference,chunksize) BitVector_Object reference BitVector_Scalar chunksize PPCODE: { BitVector_Handle handle; BitVector_Address address; N_int chunkspan; N_long chunk; N_long value; N_long mask; N_int chunkbits; N_int wordbits; N_int wordsize; N_int length; N_int index; N_int offset; N_int size; N_int bits; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(chunksize,N_int,chunkspan) ) { if ((chunkspan > 0) and (chunkspan <= BitVector_Long_Bits())) { wordsize = BitVector_Word_Bits(); bits = bits_(address); size = size_(address); length = (N_int) (bits / chunkspan); if ((length * chunkspan) < bits) length++; EXTEND(sp,length); chunk = 0L; value = 0L; index = 0; offset = 0; wordbits = 0; chunkbits = 0; while (index < length) { if ((wordbits == 0) and (offset < size)) { value = (N_long) BitVector_Word_Read(address,offset); wordbits = wordsize; offset++; } bits = chunkspan - chunkbits; if (wordbits <= bits) { value <<= chunkbits; chunk |= value; chunkbits += wordbits; value = 0L; wordbits = 0; } else { mask = ~(~0L << bits); mask &= value; mask <<= chunkbits; chunk |= mask; chunkbits += bits; value >>= bits; wordbits -= bits; } if ((chunkbits >= chunkspan) or ((offset >= size) and (chunkbits > 0))) { PUSHs(sv_2mortal(newSViv((IV)chunk))); chunk = 0L; chunkbits = 0; index++; } } } else BIT_VECTOR_CHUNK_ERROR("Chunk_List_Read"); } else BIT_VECTOR_SCALAR_ERROR("Chunk_List_Read"); } else BIT_VECTOR_OBJECT_ERROR("Chunk_List_Read"); } void BitVector_Index_List_Remove(reference,...) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; BitVector_Scalar scalar; N_int value; N_int bits; I32 index; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { bits = bits_(address); for ( index = 1; index < items; index++ ) { scalar = ST(index); if ( BIT_VECTOR_SCALAR(scalar,N_int,value) ) { if (value < bits) { BitVector_Bit_Off(address,value); } else BIT_VECTOR_INDEX_ERROR("Index_List_Remove"); } else BIT_VECTOR_SCALAR_ERROR("Index_List_Remove"); } } else BIT_VECTOR_OBJECT_ERROR("Index_List_Remove"); } void BitVector_Index_List_Store(reference,...) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; BitVector_Scalar scalar; N_int value; N_int bits; I32 index; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { bits = bits_(address); for ( index = 1; index < items; index++ ) { scalar = ST(index); if ( BIT_VECTOR_SCALAR(scalar,N_int,value) ) { if (value < bits) { BitVector_Bit_On(address,value); } else BIT_VECTOR_INDEX_ERROR("Index_List_Store"); } else BIT_VECTOR_SCALAR_ERROR("Index_List_Store"); } } else BIT_VECTOR_OBJECT_ERROR("Index_List_Store"); } void BitVector_Index_List_Read(reference) BitVector_Object reference PPCODE: { BitVector_Handle handle; BitVector_Address address; N_int size; N_int bits; N_int norm; N_int base; N_int word; N_int index; N_int value; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { size = size_(address); bits = BitVector_Word_Bits(); norm = Set_Norm(address); if (norm > 0) { EXTEND(sp,norm); for ( base = word = 0; word < size; word++, base += bits ) { index = base; value = BitVector_Word_Read(address,word); while (value) { if (value AND 0x0001) PUSHs(sv_2mortal(newSViv((IV)index))); value >>= 1; index++; } } } } else BIT_VECTOR_OBJECT_ERROR("Index_List_Read"); } MODULE = Bit::Vector PACKAGE = Bit::Vector PREFIX = Set_ void Set_Union(Xref,Yref,Zref) BitVector_Object Xref BitVector_Object Yref BitVector_Object Zref ALIAS: Or = 1 CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Handle Zhdl; BitVector_Address Zadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) && BIT_VECTOR_OBJECT(Zref,Zhdl,Zadr) ) { if ((bits_(Xadr) == bits_(Yadr)) and (bits_(Xadr) == bits_(Zadr))) { Set_Union(Xadr,Yadr,Zadr); } else BIT_VECTOR_SET_ERROR("Union"); } else BIT_VECTOR_OBJECT_ERROR("Union"); } void Set_Intersection(Xref,Yref,Zref) BitVector_Object Xref BitVector_Object Yref BitVector_Object Zref ALIAS: And = 1 CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Handle Zhdl; BitVector_Address Zadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) && BIT_VECTOR_OBJECT(Zref,Zhdl,Zadr) ) { if ((bits_(Xadr) == bits_(Yadr)) and (bits_(Xadr) == bits_(Zadr))) { Set_Intersection(Xadr,Yadr,Zadr); } else BIT_VECTOR_SET_ERROR("Intersection"); } else BIT_VECTOR_OBJECT_ERROR("Intersection"); } void Set_Difference(Xref,Yref,Zref) BitVector_Object Xref BitVector_Object Yref BitVector_Object Zref ALIAS: AndNot = 1 CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Handle Zhdl; BitVector_Address Zadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) && BIT_VECTOR_OBJECT(Zref,Zhdl,Zadr) ) { if ((bits_(Xadr) == bits_(Yadr)) and (bits_(Xadr) == bits_(Zadr))) { Set_Difference(Xadr,Yadr,Zadr); } else BIT_VECTOR_SET_ERROR("Difference"); } else BIT_VECTOR_OBJECT_ERROR("Difference"); } void Set_ExclusiveOr(Xref,Yref,Zref) BitVector_Object Xref BitVector_Object Yref BitVector_Object Zref ALIAS: Xor = 1 CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Handle Zhdl; BitVector_Address Zadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) && BIT_VECTOR_OBJECT(Zref,Zhdl,Zadr) ) { if ((bits_(Xadr) == bits_(Yadr)) and (bits_(Xadr) == bits_(Zadr))) { Set_ExclusiveOr(Xadr,Yadr,Zadr); } else BIT_VECTOR_SET_ERROR("ExclusiveOr"); } else BIT_VECTOR_OBJECT_ERROR("ExclusiveOr"); } void Set_Complement(Xref,Yref) BitVector_Object Xref BitVector_Object Yref ALIAS: Not = 1 CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if (bits_(Xadr) == bits_(Yadr)) { Set_Complement(Xadr,Yadr); } else BIT_VECTOR_SET_ERROR("Complement"); } else BIT_VECTOR_OBJECT_ERROR("Complement"); } boolean Set_subset(Xref,Yref) BitVector_Object Xref BitVector_Object Yref ALIAS: inclusion = 2 CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if (bits_(Xadr) == bits_(Yadr)) { RETVAL = Set_subset(Xadr,Yadr); } else BIT_VECTOR_SET_ERROR("subset"); } else BIT_VECTOR_OBJECT_ERROR("subset"); } OUTPUT: RETVAL N_int Set_Norm(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = Set_Norm(address); } else BIT_VECTOR_OBJECT_ERROR("Norm"); } OUTPUT: RETVAL Z_long Set_Min(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = Set_Min(address); } else BIT_VECTOR_OBJECT_ERROR("Min"); } OUTPUT: RETVAL Z_long Set_Max(reference) BitVector_Object reference CODE: { BitVector_Handle handle; BitVector_Address address; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { RETVAL = Set_Max(address); } else BIT_VECTOR_OBJECT_ERROR("Max"); } OUTPUT: RETVAL MODULE = Bit::Vector PACKAGE = Bit::Vector PREFIX = Matrix_ void Matrix_Multiplication(Xref,Xrows,Xcols,Yref,Yrows,Ycols,Zref,Zrows,Zcols) BitVector_Object Xref BitVector_Scalar Xrows BitVector_Scalar Xcols BitVector_Object Yref BitVector_Scalar Yrows BitVector_Scalar Ycols BitVector_Object Zref BitVector_Scalar Zrows BitVector_Scalar Zcols CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Handle Zhdl; BitVector_Address Zadr; N_int rowsX; N_int colsX; N_int rowsY; N_int colsY; N_int rowsZ; N_int colsZ; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) && BIT_VECTOR_OBJECT(Zref,Zhdl,Zadr) ) { if ( BIT_VECTOR_SCALAR(Xrows,N_int,rowsX) && BIT_VECTOR_SCALAR(Xcols,N_int,colsX) && BIT_VECTOR_SCALAR(Yrows,N_int,rowsY) && BIT_VECTOR_SCALAR(Ycols,N_int,colsY) && BIT_VECTOR_SCALAR(Zrows,N_int,rowsZ) && BIT_VECTOR_SCALAR(Zcols,N_int,colsZ) ) { if ((colsY == rowsZ) and (rowsX == rowsY) and (colsX == colsZ) and (bits_(Xadr) == rowsX*colsX) and (bits_(Yadr) == rowsY*colsY) and (bits_(Zadr) == rowsZ*colsZ)) { Matrix_Multiplication(Xadr,rowsX,colsX, Yadr,rowsY,colsY, Zadr,rowsZ,colsZ); } else BIT_VECTOR_MATRIX_ERROR("Multiplication"); } else BIT_VECTOR_SCALAR_ERROR("Multiplication"); } else BIT_VECTOR_OBJECT_ERROR("Multiplication"); } void Matrix_Product(Xref,Xrows,Xcols,Yref,Yrows,Ycols,Zref,Zrows,Zcols) BitVector_Object Xref BitVector_Scalar Xrows BitVector_Scalar Xcols BitVector_Object Yref BitVector_Scalar Yrows BitVector_Scalar Ycols BitVector_Object Zref BitVector_Scalar Zrows BitVector_Scalar Zcols CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; BitVector_Handle Zhdl; BitVector_Address Zadr; N_int rowsX; N_int colsX; N_int rowsY; N_int colsY; N_int rowsZ; N_int colsZ; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) && BIT_VECTOR_OBJECT(Zref,Zhdl,Zadr) ) { if ( BIT_VECTOR_SCALAR(Xrows,N_int,rowsX) && BIT_VECTOR_SCALAR(Xcols,N_int,colsX) && BIT_VECTOR_SCALAR(Yrows,N_int,rowsY) && BIT_VECTOR_SCALAR(Ycols,N_int,colsY) && BIT_VECTOR_SCALAR(Zrows,N_int,rowsZ) && BIT_VECTOR_SCALAR(Zcols,N_int,colsZ) ) { if ((colsY == rowsZ) and (rowsX == rowsY) and (colsX == colsZ) and (bits_(Xadr) == rowsX*colsX) and (bits_(Yadr) == rowsY*colsY) and (bits_(Zadr) == rowsZ*colsZ)) { Matrix_Product(Xadr,rowsX,colsX, Yadr,rowsY,colsY, Zadr,rowsZ,colsZ); } else BIT_VECTOR_MATRIX_ERROR("Product"); } else BIT_VECTOR_SCALAR_ERROR("Product"); } else BIT_VECTOR_OBJECT_ERROR("Product"); } void Matrix_Closure(reference,rows,cols) BitVector_Object reference BitVector_Scalar rows BitVector_Scalar cols CODE: { BitVector_Handle handle; BitVector_Address address; N_int r; N_int c; if ( BIT_VECTOR_OBJECT(reference,handle,address) ) { if ( BIT_VECTOR_SCALAR(rows,N_int,r) && BIT_VECTOR_SCALAR(cols,N_int,c) ) { if (bits_(address) == r*c) { if (r == c) { Matrix_Closure(address,r,c); } else BIT_VECTOR_SHAPE_ERROR("Closure"); } else BIT_VECTOR_MATRIX_ERROR("Closure"); } else BIT_VECTOR_SCALAR_ERROR("Closure"); } else BIT_VECTOR_OBJECT_ERROR("Closure"); } void Matrix_Transpose(Xref,Xrows,Xcols,Yref,Yrows,Ycols) BitVector_Object Xref BitVector_Scalar Xrows BitVector_Scalar Xcols BitVector_Object Yref BitVector_Scalar Yrows BitVector_Scalar Ycols CODE: { BitVector_Handle Xhdl; BitVector_Address Xadr; BitVector_Handle Yhdl; BitVector_Address Yadr; N_int rowsX; N_int colsX; N_int rowsY; N_int colsY; if ( BIT_VECTOR_OBJECT(Xref,Xhdl,Xadr) && BIT_VECTOR_OBJECT(Yref,Yhdl,Yadr) ) { if ( BIT_VECTOR_SCALAR(Xrows,N_int,rowsX) && BIT_VECTOR_SCALAR(Xcols,N_int,colsX) && BIT_VECTOR_SCALAR(Yrows,N_int,rowsY) && BIT_VECTOR_SCALAR(Ycols,N_int,colsY) ) { if ((rowsX == colsY) and (colsX == rowsY) and (bits_(Xadr) == rowsX*colsX) and (bits_(Yadr) == rowsY*colsY)) { if ((Xadr != Yadr) or (rowsY == colsY)) { Matrix_Transpose(Xadr,rowsX,colsX, Yadr,rowsY,colsY); } else BIT_VECTOR_SHAPE_ERROR("Transpose"); } else BIT_VECTOR_MATRIX_ERROR("Transpose"); } else BIT_VECTOR_SCALAR_ERROR("Transpose"); } else BIT_VECTOR_OBJECT_ERROR("Transpose"); } slice-1.3.8/lib/getoptlong/GetoptLong.pm0100664000000000000000000011663406722550650017454 0ustar barbierslice# GetOpt::Long.pm -- Universal options parsing package Getopt::Long; # RCS Status : $Id: GetoptLong.pl,v 2.18 1998-06-14 15:02:19+02 jv Exp $ # Author : Johan Vromans # Created On : Tue Sep 11 15:00:12 1990 # Last Modified By: Johan Vromans # Last Modified On: Fri Jan 8 14:48:43 1999 # Update Count : 707 # Status : Released ################ Copyright ################ # This program is Copyright 1990,1999 by Johan Vromans. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # If you do not have a copy of the GNU General Public License write to # the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, # MA 02139, USA. ################ Module Preamble ################ use strict; BEGIN { require 5.004; use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = "2.19"; @ISA = qw(Exporter); @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER); %EXPORT_TAGS = qw(); @EXPORT_OK = qw(); use AutoLoader qw(AUTOLOAD); } # User visible variables. use vars @EXPORT, @EXPORT_OK; use vars qw($error $debug $major_version $minor_version); # Deprecated visible variables. use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order $passthrough); # Official invisible variables. use vars qw($genprefix); # Public subroutines. sub Configure (@); sub config (@); # deprecated name sub GetOptions; # Private subroutines. sub ConfigDefaults (); sub FindOption ($$$$$$$); sub Croak (@); # demand loading the real Croak ################ Local Variables ################ ################ Resident subroutines ################ sub ConfigDefaults () { # Handle POSIX compliancy. if ( defined $ENV{"POSIXLY_CORRECT"} ) { $genprefix = "(--|-)"; $autoabbrev = 0; # no automatic abbrev of options $bundling = 0; # no bundling of single letter switches $getopt_compat = 0; # disallow '+' to start options $order = $REQUIRE_ORDER; } else { $genprefix = "(--|-|\\+)"; $autoabbrev = 1; # automatic abbrev of options $bundling = 0; # bundling off by default $getopt_compat = 1; # allow '+' to start options $order = $PERMUTE; } # Other configurable settings. $debug = 0; # for debugging $error = 0; # error tally $ignorecase = 1; # ignore case when matching options $passthrough = 0; # leave unrecognized options alone } ################ Initialization ################ # Values for $order. See GNU getopt.c for details. ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2); # Version major/minor numbers. ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/; # Set defaults. ConfigDefaults (); ################ Package return ################ 1; __END__ ################ AutoLoading subroutines ################ # RCS Status : $Id: GetoptLongAl.pl,v 2.20 1998-06-14 15:02:19+02 jv Exp $ # Author : Johan Vromans # Created On : Fri Mar 27 11:50:30 1998 # Last Modified By: Johan Vromans # Last Modified On: Sun Jun 14 13:54:35 1998 # Update Count : 24 # Status : Released sub GetOptions { my @optionlist = @_; # local copy of the option descriptions my $argend = '--'; # option list terminator my %opctl = (); # table of arg.specs (long and abbrevs) my %bopctl = (); # table of arg.specs (bundles) my $pkg = (caller)[0]; # current context # Needed if linkage is omitted. my %aliases= (); # alias table my @ret = (); # accum for non-options my %linkage; # linkage my $userlinkage; # user supplied HASH my $opt; # current option my $genprefix = $genprefix; # so we can call the same module many times my @opctl; # the possible long option names $error = ''; print STDERR ("GetOpt::Long $Getopt::Long::VERSION ", "called from package \"$pkg\".", "\n ", 'GetOptionsAl $Revision: 2.20 $ ', "\n ", "ARGV: (@ARGV)", "\n ", "autoabbrev=$autoabbrev,". "bundling=$bundling,", "getopt_compat=$getopt_compat,", "order=$order,", "\n ", "ignorecase=$ignorecase,", "passthrough=$passthrough,", "genprefix=\"$genprefix\".", "\n") if $debug; # Check for ref HASH as first argument. # First argument may be an object. It's OK to use this as long # as it is really a hash underneath. $userlinkage = undef; if ( ref($optionlist[0]) and "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) { $userlinkage = shift (@optionlist); print STDERR ("=> user linkage: $userlinkage\n") if $debug; } # See if the first element of the optionlist contains option # starter characters. if ( $optionlist[0] =~ /^\W+$/ ) { $genprefix = shift (@optionlist); # Turn into regexp. Needs to be parenthesized! $genprefix =~ s/(\W)/\\$1/g; $genprefix = "([" . $genprefix . "])"; } # Verify correctness of optionlist. %opctl = (); %bopctl = (); while ( @optionlist > 0 ) { my $opt = shift (@optionlist); # Strip leading prefix so people can specify "--foo=i" if they like. $opt = $+ if $opt =~ /^$genprefix+(.*)$/s; if ( $opt eq '<>' ) { if ( (defined $userlinkage) && !(@optionlist > 0 && ref($optionlist[0])) && (exists $userlinkage->{$opt}) && ref($userlinkage->{$opt}) ) { unshift (@optionlist, $userlinkage->{$opt}); } unless ( @optionlist > 0 && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) { $error .= "Option spec <> requires a reference to a subroutine\n"; next; } $linkage{'<>'} = shift (@optionlist); next; } # Match option spec. Allow '?' as an alias. if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?([!~+]|[=:][infse][@%]?)?$/ ) { $error .= "Error in option spec: \"$opt\"\n"; next; } my ($o, $c, $a) = ($1, $5); $c = '' unless defined $c; if ( ! defined $o ) { # empty -> '-' option $opctl{$o = ''} = $c; } else { # Handle alias names my @o = split (/\|/, $o); my $linko = $o = $o[0]; # Force an alias if the option name is not locase. $a = $o unless $o eq lc($o); $o = lc ($o) if $ignorecase > 1 || ($ignorecase && ($bundling ? length($o) > 1 : 1)); foreach ( @o ) { if ( $bundling && length($_) == 1 ) { $_ = lc ($_) if $ignorecase > 1; if ( $c eq '!' ) { $opctl{"no$_"} = $c; warn ("Ignoring '!' modifier for short option $_\n"); $c = ''; } $opctl{$_} = $bopctl{$_} = $c; } else { $_ = lc ($_) if $ignorecase; if ( $c eq '!' ) { $opctl{"no$_"} = $c; $c = ''; } $opctl{$_} = $c; } if ( defined $a ) { # Note alias. $aliases{$_} = $a; } else { # Set primary name. $a = $_; } } $o = $linko; } # If no linkage is supplied in the @optionlist, copy it from # the userlinkage if available. if ( defined $userlinkage ) { unless ( @optionlist > 0 && ref($optionlist[0]) ) { if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) { print STDERR ("=> found userlinkage for \"$o\": ", "$userlinkage->{$o}\n") if $debug; unshift (@optionlist, $userlinkage->{$o}); } else { # Do nothing. Being undefined will be handled later. next; } } } # Copy the linkage. If omitted, link to global variable. if ( @optionlist > 0 && ref($optionlist[0]) ) { print STDERR ("=> link \"$o\" to $optionlist[0]\n") if $debug; if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) { $linkage{$o} = shift (@optionlist); } elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) { $linkage{$o} = shift (@optionlist); $opctl{$o} .= '@' if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/; $bopctl{$o} .= '@' if $bundling and defined $bopctl{$o} and $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/; } elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) { $linkage{$o} = shift (@optionlist); $opctl{$o} .= '%' if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/; $bopctl{$o} .= '%' if $bundling and defined $bopctl{$o} and $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/; } else { $error .= "Invalid option linkage for \"$opt\"\n"; } } else { # Link to global $opt_XXX variable. # Make sure a valid perl identifier results. my $ov = $o; $ov =~ s/\W/_/g; if ( $c =~ /@/ ) { print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n") if $debug; eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;"); } elsif ( $c =~ /%/ ) { print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n") if $debug; eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;"); } else { print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n") if $debug; eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;"); } } } # Bail out if errors found. die ($error) if $error; $error = 0; # Sort the possible long option names. @opctl = sort(keys (%opctl)) if $autoabbrev; # Show the options tables if debugging. if ( $debug ) { my ($arrow, $k, $v); $arrow = "=> "; while ( ($k,$v) = each(%opctl) ) { print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n"); $arrow = " "; } $arrow = "=> "; while ( ($k,$v) = each(%bopctl) ) { print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n"); $arrow = " "; } } # Process argument list while ( @ARGV > 0 ) { #### Get next argument #### $opt = shift (@ARGV); print STDERR ("=> option \"", $opt, "\"\n") if $debug; #### Determine what we have #### # Double dash is option list terminator. if ( $opt eq $argend ) { # Finish. Push back accumulated arguments and return. unshift (@ARGV, @ret) if $order == $PERMUTE; return ($error == 0); } my $tryopt = $opt; my $found; # success status my $dsttype; # destination type ('@' or '%') my $incr; # destination increment my $key; # key (if hash type) my $arg; # option argument ($found, $opt, $arg, $dsttype, $incr, $key) = FindOption ($genprefix, $argend, $opt, \%opctl, \%bopctl, \@opctl, \%aliases); if ( $found ) { # FindOption undefines $opt in case of errors. next unless defined $opt; if ( defined $arg ) { $opt = $aliases{$opt} if defined $aliases{$opt}; if ( defined $linkage{$opt} ) { print STDERR ("=> ref(\$L{$opt}) -> ", ref($linkage{$opt}), "\n") if $debug; if ( ref($linkage{$opt}) eq 'SCALAR' ) { if ( $incr ) { print STDERR ("=> \$\$L{$opt} += \"$arg\"\n") if $debug; if ( defined ${$linkage{$opt}} ) { ${$linkage{$opt}} += $arg; } else { ${$linkage{$opt}} = $arg; } } else { print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug; ${$linkage{$opt}} = $arg; } } elsif ( ref($linkage{$opt}) eq 'ARRAY' ) { print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n") if $debug; push (@{$linkage{$opt}}, $arg); } elsif ( ref($linkage{$opt}) eq 'HASH' ) { print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n") if $debug; $linkage{$opt}->{$key} = $arg; } elsif ( ref($linkage{$opt}) eq 'CODE' ) { print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n") if $debug; &{$linkage{$opt}}($opt, $arg); } else { print STDERR ("Invalid REF type \"", ref($linkage{$opt}), "\" in linkage\n"); Croak ("Getopt::Long -- internal error!\n"); } } # No entry in linkage means entry in userlinkage. elsif ( $dsttype eq '@' ) { if ( defined $userlinkage->{$opt} ) { print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n") if $debug; push (@{$userlinkage->{$opt}}, $arg); } else { print STDERR ("=>\$L{$opt} = [\"$arg\"]\n") if $debug; $userlinkage->{$opt} = [$arg]; } } elsif ( $dsttype eq '%' ) { if ( defined $userlinkage->{$opt} ) { print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n") if $debug; $userlinkage->{$opt}->{$key} = $arg; } else { print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n") if $debug; $userlinkage->{$opt} = {$key => $arg}; } } else { if ( $incr ) { print STDERR ("=> \$L{$opt} += \"$arg\"\n") if $debug; if ( defined $userlinkage->{$opt} ) { $userlinkage->{$opt} += $arg; } else { $userlinkage->{$opt} = $arg; } } else { print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug; $userlinkage->{$opt} = $arg; } } } } # Not an option. Save it if we $PERMUTE and don't have a <>. elsif ( $order == $PERMUTE ) { # Try non-options call-back. my $cb; if ( (defined ($cb = $linkage{'<>'})) ) { &$cb ($tryopt); } else { print STDERR ("=> saving \"$tryopt\" ", "(not an option, may permute)\n") if $debug; push (@ret, $tryopt); } next; } # ...otherwise, terminate. else { # Push this one back and exit. unshift (@ARGV, $tryopt); return ($error == 0); } } # Finish. if ( $order == $PERMUTE ) { # Push back accumulated arguments print STDERR ("=> restoring \"", join('" "', @ret), "\"\n") if $debug && @ret > 0; unshift (@ARGV, @ret) if @ret > 0; } return ($error == 0); } # Option lookup. sub FindOption ($$$$$$$) { # returns (1, $opt, $arg, $dsttype, $incr, $key) if okay, # returns (0) otherwise. my ($prefix, $argend, $opt, $opctl, $bopctl, $names, $aliases) = @_; my $key; # hash key for a hash option my $arg; print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug; return (0) unless $opt =~ /^$prefix(.*)$/s; $opt = $+; my ($starter) = $1; print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug; my $optarg = undef; # value supplied with --opt=value my $rest = undef; # remainder from unbundling # If it is a long option, it may include the value. if (($starter eq "--" || ($getopt_compat && !$bundling)) && $opt =~ /^([^=]+)=(.*)$/s ) { $opt = $1; $optarg = $2; print STDERR ("=> option \"", $opt, "\", optarg = \"$optarg\"\n") if $debug; } #### Look it up ### my $tryopt = $opt; # option to try my $optbl = $opctl; # table to look it up (long names) my $type; my $dsttype = ''; my $incr = 0; if ( $bundling && $starter eq '-' ) { # Unbundle single letter option. $rest = substr ($tryopt, 1); $tryopt = substr ($tryopt, 0, 1); $tryopt = lc ($tryopt) if $ignorecase > 1; print STDERR ("=> $starter$tryopt unbundled from ", "$starter$tryopt$rest\n") if $debug; $rest = undef unless $rest ne ''; $optbl = $bopctl; # look it up in the short names table # If bundling == 2, long options can override bundles. if ( $bundling == 2 and defined ($rest) and defined ($type = $opctl->{$tryopt.$rest}) ) { print STDERR ("=> $starter$tryopt rebundled to ", "$starter$tryopt$rest\n") if $debug; $tryopt .= $rest; undef $rest; } } # Try auto-abbreviation. elsif ( $autoabbrev ) { # Downcase if allowed. $tryopt = $opt = lc ($opt) if $ignorecase; # Turn option name into pattern. my $pat = quotemeta ($opt); # Look up in option names. my @hits = grep (/^$pat/, @{$names}); print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ", "out of ", scalar(@{$names}), "\n") if $debug; # Check for ambiguous results. unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) { # See if all matches are for the same option. my %hit; foreach ( @hits ) { $_ = $aliases->{$_} if defined $aliases->{$_}; $hit{$_} = 1; } # Now see if it really is ambiguous. unless ( keys(%hit) == 1 ) { return (0) if $passthrough; warn ("Option ", $opt, " is ambiguous (", join(", ", @hits), ")\n"); $error++; undef $opt; return (1, $opt,$arg,$dsttype,$incr,$key); } @hits = keys(%hit); } # Complete the option name, if appropriate. if ( @hits == 1 && $hits[0] ne $opt ) { $tryopt = $hits[0]; $tryopt = lc ($tryopt) if $ignorecase; print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n") if $debug; } } # Map to all lowercase if ignoring case. elsif ( $ignorecase ) { $tryopt = lc ($opt); } # Check validity by fetching the info. $type = $optbl->{$tryopt} unless defined $type; unless ( defined $type ) { return (0) if $passthrough; warn ("Unknown option: ", $opt, "\n"); $error++; return (1, $opt,$arg,$dsttype,$incr,$key); } # Apparently valid. $opt = $tryopt; print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug; #### Determine argument status #### # If it is an option w/o argument, we're almost finished with it. if ( $type eq '' || $type eq '!' || $type eq '+' ) { if ( defined $optarg ) { return (0) if $passthrough; warn ("Option ", $opt, " does not take an argument\n"); $error++; undef $opt; } elsif ( $type eq '' || $type eq '+' ) { $arg = 1; # supply explicit value $incr = $type eq '+'; } else { substr ($opt, 0, 2) = ''; # strip NO prefix $arg = 0; # supply explicit value } unshift (@ARGV, $starter.$rest) if defined $rest; return (1, $opt,$arg,$dsttype,$incr,$key); } # Get mandatory status and type info. my $mand; ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/; # Check if there is an option argument available. if ( defined $optarg ? ($optarg eq '') : !(defined $rest || @ARGV > 0) ) { # Complain if this option needs an argument. if ( $mand eq "=" ) { return (0) if $passthrough; warn ("Option ", $opt, " requires an argument\n"); $error++; undef $opt; } if ( $mand eq ":" ) { $arg = $type eq "s" ? '' : 0; } return (1, $opt,$arg,$dsttype,$incr,$key); } # Get (possibly optional) argument. $arg = (defined $rest ? $rest : (defined $optarg ? $optarg : shift (@ARGV))); # Get key if this is a "name=value" pair for a hash option. $key = undef; if ($dsttype eq '%' && defined $arg) { ($key, $arg) = ($arg =~ /^(.*)=(.*)$/s) ? ($1, $2) : ($arg, 1); } #### Check if the argument is valid for this option #### if ( $type eq "s" ) { # string # A mandatory string takes anything. return (1, $opt,$arg,$dsttype,$incr,$key) if $mand eq "="; # An optional string takes almost anything. return (1, $opt,$arg,$dsttype,$incr,$key) if defined $optarg || defined $rest; return (1, $opt,$arg,$dsttype,$incr,$key) if $arg eq "-"; # ?? # Check for option or option list terminator. if ($arg eq $argend || $arg =~ /^$prefix.+/) { # Push back. unshift (@ARGV, $arg); # Supply empty value. $arg = ''; } } elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer if ( $bundling && defined $rest && $rest =~ /^(-?[0-9]+)(.*)$/s ) { $arg = $1; $rest = $2; unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne ''; } elsif ( $arg !~ /^-?[0-9]+$/ ) { if ( defined $optarg || $mand eq "=" ) { if ( $passthrough ) { unshift (@ARGV, defined $rest ? $starter.$rest : $arg) unless defined $optarg; return (0); } warn ("Value \"", $arg, "\" invalid for option ", $opt, " (number expected)\n"); $error++; undef $opt; # Push back. unshift (@ARGV, $starter.$rest) if defined $rest; } else { # Push back. unshift (@ARGV, defined $rest ? $starter.$rest : $arg); # Supply default value. $arg = 0; } } } elsif ( $type eq "f" ) { # real number, int is also ok # We require at least one digit before a point or 'e', # and at least one digit following the point and 'e'. # [-]NN[.NN][eNN] if ( $bundling && defined $rest && $rest =~ /^(-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?)(.*)$/s ) { $arg = $1; $rest = $+; unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne ''; } elsif ( $arg !~ /^-?[0-9.]+(\.[0-9]+)?([eE]-?[0-9]+)?$/ ) { if ( defined $optarg || $mand eq "=" ) { if ( $passthrough ) { unshift (@ARGV, defined $rest ? $starter.$rest : $arg) unless defined $optarg; return (0); } warn ("Value \"", $arg, "\" invalid for option ", $opt, " (real number expected)\n"); $error++; undef $opt; # Push back. unshift (@ARGV, $starter.$rest) if defined $rest; } else { # Push back. unshift (@ARGV, defined $rest ? $starter.$rest : $arg); # Supply default value. $arg = 0.0; } } } else { Croak ("GetOpt::Long internal error (Can't happen)\n"); } return (1, $opt, $arg, $dsttype, $incr, $key); } # Getopt::Long Configuration. sub Configure (@) { my (@options) = @_; my $opt; foreach $opt ( @options ) { my $try = lc ($opt); my $action = 1; if ( $try =~ /^no_?(.*)$/s ) { $action = 0; $try = $+; } if ( $try eq 'default' or $try eq 'defaults' ) { ConfigDefaults () if $action; } elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) { $autoabbrev = $action; } elsif ( $try eq 'getopt_compat' ) { $getopt_compat = $action; } elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) { $ignorecase = $action; } elsif ( $try eq 'ignore_case_always' ) { $ignorecase = $action ? 2 : 0; } elsif ( $try eq 'bundling' ) { $bundling = $action; } elsif ( $try eq 'bundling_override' ) { $bundling = $action ? 2 : 0; } elsif ( $try eq 'require_order' ) { $order = $action ? $REQUIRE_ORDER : $PERMUTE; } elsif ( $try eq 'permute' ) { $order = $action ? $PERMUTE : $REQUIRE_ORDER; } elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) { $passthrough = $action; } elsif ( $try =~ /^prefix=(.+)$/ ) { $genprefix = $1; # Turn into regexp. Needs to be parenthesized! $genprefix = "(" . quotemeta($genprefix) . ")"; eval { '' =~ /$genprefix/; }; Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@; } elsif ( $try =~ /^prefix_pattern=(.+)$/ ) { $genprefix = $1; # Parenthesize if needed. $genprefix = "(" . $genprefix . ")" unless $genprefix =~ /^\(.*\)$/; eval { '' =~ /$genprefix/; }; Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@; } elsif ( $try eq 'debug' ) { $debug = $action; } else { Croak ("Getopt::Long: unknown config parameter \"$opt\"") } } } # Deprecated name. sub config (@) { Configure (@_); } # To prevent Carp from being loaded unnecessarily. sub Croak (@) { require 'Carp.pm'; $Carp::CarpLevel = 1; Carp::croak(@_); }; ################ Documentation ################ =head1 NAME GetOptions - extended processing of command line options =head1 SYNOPSIS use Getopt::Long; $result = GetOptions (...option-descriptions...); =head1 DESCRIPTION The Getopt::Long module implements an extended getopt function called GetOptions(). This function adheres to the POSIX syntax for command line options, with GNU extensions. In general, this means that options have long names instead of single letters, and are introduced with a double dash "--". Support for bundling of command line options, as was the case with the more traditional single-letter approach, is provided but not enabled by default. For example, the UNIX "ps" command can be given the command line "option" -vax which means the combination of B<-v>, B<-a> and B<-x>. With the new syntax B<--vax> would be a single option, probably indicating a computer architecture. Command line options can be used to set values. These values can be specified in one of two ways: --size 24 --size=24 GetOptions is called with a list of option-descriptions, each of which consists of two elements: the option specifier and the option linkage. The option specifier defines the name of the option and, optionally, the value it can take. The option linkage is usually a reference to a variable that will be set when the option is used. For example, the following call to GetOptions: GetOptions("size=i" => \$offset); will accept a command line option "size" that must have an integer value. With a command line of "--size 24" this will cause the variable $offset to get the value 24. Alternatively, the first argument to GetOptions may be a reference to a HASH describing the linkage for the options, or an object whose class is based on a HASH. The following call is equivalent to the example above: %optctl = ("size" => \$offset); GetOptions(\%optctl, "size=i"); Linkage may be specified using either of the above methods, or both. Linkage specified in the argument list takes precedence over the linkage specified in the HASH. The command line options are taken from array @ARGV. Upon completion of GetOptions, @ARGV will contain the rest (i.e. the non-options) of the command line. Each option specifier designates the name of the option, optionally followed by an argument specifier. Options that do not take arguments will have no argument specifier. The option variable will be set to 1 if the option is used. For the other options, the values for argument specifiers are: =over 8 =item ! Option does not take an argument and may be negated, i.e. prefixed by "no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo> (with value 0). The option variable will be set to 1, or 0 if negated. =item + Option does not take an argument and will be incremented by 1 every time it appears on the command line. E.g. "more+", when used with B<--more --more --more>, will set the option variable to 3 (provided it was 0 or undefined at first). The B<+> specifier is ignored if the option destination is not a SCALAR. =item =s Option takes a mandatory string argument. This string will be assigned to the option variable. Note that even if the string argument starts with B<-> or B<-->, it will not be considered an option on itself. =item :s Option takes an optional string argument. This string will be assigned to the option variable. If omitted, it will be assigned "" (an empty string). If the string argument starts with B<-> or B<-->, it will be considered an option on itself. =item =i Option takes a mandatory integer argument. This value will be assigned to the option variable. Note that the value may start with B<-> to indicate a negative value. =item :i Option takes an optional integer argument. This value will be assigned to the option variable. If omitted, the value 0 will be assigned. Note that the value may start with B<-> to indicate a negative value. =item =f Option takes a mandatory real number argument. This value will be assigned to the option variable. Note that the value may start with B<-> to indicate a negative value. =item :f Option takes an optional real number argument. This value will be assigned to the option variable. If omitted, the value 0 will be assigned. =back A lone dash B<-> is considered an option, the corresponding option name is the empty string. A double dash on itself B<--> signals end of the options list. =head2 Linkage specification The linkage specifier is optional. If no linkage is explicitly specified but a ref HASH is passed, GetOptions will place the value in the HASH. For example: %optctl = (); GetOptions (\%optctl, "size=i"); will perform the equivalent of the assignment $optctl{"size"} = 24; For array options, a reference to an array is used, e.g.: %optctl = (); GetOptions (\%optctl, "sizes=i@"); with command line "-sizes 24 -sizes 48" will perform the equivalent of the assignment $optctl{"sizes"} = [24, 48]; For hash options (an option whose argument looks like "name=value"), a reference to a hash is used, e.g.: %optctl = (); GetOptions (\%optctl, "define=s%"); with command line "--define foo=hello --define bar=world" will perform the equivalent of the assignment $optctl{"define"} = {foo=>'hello', bar=>'world') If no linkage is explicitly specified and no ref HASH is passed, GetOptions will put the value in a global variable named after the option, prefixed by "opt_". To yield a usable Perl variable, characters that are not part of the syntax for variables are translated to underscores. For example, "--fpp-struct-return" will set the variable $opt_fpp_struct_return. Note that this variable resides in the namespace of the calling program, not necessarily B
. For example: GetOptions ("size=i", "sizes=i@"); with command line "-size 10 -sizes 24 -sizes 48" will perform the equivalent of the assignments $opt_size = 10; @opt_sizes = (24, 48); A lone dash B<-> is considered an option, the corresponding Perl identifier is $opt_ . The linkage specifier can be a reference to a scalar, a reference to an array, a reference to a hash or a reference to a subroutine. Note that, if your code is running under the recommended C pragma, it may be helpful to declare these package variables via C perhaps something like this: use vars qw/ $opt_size @opt_sizes $opt_bar /; If a REF SCALAR is supplied, the new value is stored in the referenced variable. If the option occurs more than once, the previous value is overwritten. If a REF ARRAY is supplied, the new value is appended (pushed) to the referenced array. If a REF HASH is supplied, the option value should look like "key" or "key=value" (if the "=value" is omitted then a value of 1 is implied). In this case, the element of the referenced hash with the key "key" is assigned "value". If a REF CODE is supplied, the referenced subroutine is called with two arguments: the option name and the option value. The option name is always the true name, not an abbreviation or alias. =head2 Aliases and abbreviations The option name may actually be a list of option names, separated by "|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name of this option. If no linkage is specified, options "foo", "bar" and "blech" all will set $opt_foo. For convenience, the single character "?" is allowed as an alias, e.g. "help|?". Option names may be abbreviated to uniqueness, depending on configuration option B. =head2 Non-option call-back routine A special option specifier, EE, can be used to designate a subroutine to handle non-option arguments. GetOptions will immediately call this subroutine for every non-option it encounters in the options list. This subroutine gets the name of the non-option passed. This feature requires configuration option B, see section CONFIGURATION OPTIONS. See also the examples. =head2 Option starters On the command line, options can start with B<-> (traditional), B<--> (POSIX) and B<+> (GNU, now being phased out). The latter is not allowed if the environment variable B has been defined. Options that start with "--" may have an argument appended, separated with an "=", e.g. "--foo=bar". =head2 Return values and Errors Configuration errors and errors in the option definitions are signalled using C and will terminate the calling program unless the call to C was embedded in C or C was trapped using C<$SIG{__DIE__}>. A return value of 1 (true) indicates success. A return status of 0 (false) indicates that the function detected one or more errors during option parsing. These errors are signalled using C and can be trapped with C<$SIG{__WARN__}>. Errors that can't happen are signalled using C. =head1 COMPATIBILITY Getopt::Long::GetOptions() is the successor of B that came with Perl 4. It is fully upward compatible. In fact, the Perl 5 version of newgetopt.pl is just a wrapper around the module. If an "@" sign is appended to the argument specifier, the option is treated as an array. Value(s) are not set, but pushed into array @opt_name. If explicit linkage is supplied, this must be a reference to an ARRAY. If an "%" sign is appended to the argument specifier, the option is treated as a hash. Value(s) of the form "name=value" are set by setting the element of the hash %opt_name with key "name" to "value" (if the "=value" portion is omitted it defaults to 1). If explicit linkage is supplied, this must be a reference to a HASH. If configuration option B is set (see section CONFIGURATION OPTIONS), options that start with "+" or "-" may also include their arguments, e.g. "+foo=bar". This is for compatiblity with older implementations of the GNU "getopt" routine. If the first argument to GetOptions is a string consisting of only non-alphanumeric characters, it is taken to specify the option starter characters. Everything starting with one of these characters from the starter will be considered an option. B For convenience, option specifiers may have a leading B<-> or B<-->, so it is possible to write: GetOptions qw(-foo=s --bar=i --ar=s); =head1 EXAMPLES If the option specifier is "one:i" (i.e. takes an optional integer argument), then the following situations are handled: -one -two -> $opt_one = '', -two is next option -one -2 -> $opt_one = -2 Also, assume specifiers "foo=s" and "bar:s" : -bar -xxx -> $opt_bar = '', '-xxx' is next option -foo -bar -> $opt_foo = '-bar' -foo -- -> $opt_foo = '--' In GNU or POSIX format, option names and values can be combined: +foo=blech -> $opt_foo = 'blech' --bar= -> $opt_bar = '' --bar=-- -> $opt_bar = '--' Example of using variable references: $ret = GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar); With command line options "-foo blech -bar 24 -ar xx -ar yy" this will result in: $foo = 'blech' $opt_bar = 24 @ar = ('xx','yy') Example of using the EE option specifier: @ARGV = qw(-foo 1 bar -foo 2 blech); GetOptions("foo=i", \$myfoo, "<>", \&mysub); Results: mysub("bar") will be called (with $myfoo being 1) mysub("blech") will be called (with $myfoo being 2) Compare this with: @ARGV = qw(-foo 1 bar -foo 2 blech); GetOptions("foo=i", \$myfoo); This will leave the non-options in @ARGV: $myfoo -> 2 @ARGV -> qw(bar blech) =head1 CONFIGURATION OPTIONS B can be configured by calling subroutine B. This subroutine takes a list of quoted strings, each specifying a configuration option to be set, e.g. B. Options can be reset by prefixing with B, e.g. B. Case does not matter. Multiple calls to B are possible. Previous versions of Getopt::Long used variables for the purpose of configuring. Although manipulating these variables still work, it is strongly encouraged to use the new B routine. Besides, it is much easier. The following options are available: =over 12 =item default This option causes all configuration options to be reset to their default values. =item auto_abbrev Allow option names to be abbreviated to uniqueness. Default is set unless environment variable POSIXLY_CORRECT has been set, in which case B is reset. =item getopt_compat Allow '+' to start options. Default is set unless environment variable POSIXLY_CORRECT has been set, in which case B is reset. =item require_order Whether non-options are allowed to be mixed with options. Default is set unless environment variable POSIXLY_CORRECT has been set, in which case b is reset. See also B, which is the opposite of B. =item permute Whether non-options are allowed to be mixed with options. Default is set unless environment variable POSIXLY_CORRECT has been set, in which case B is reset. Note that B is the opposite of B. If B is set, this means that -foo arg1 -bar arg2 arg3 is equivalent to -foo -bar arg1 arg2 arg3 If a non-option call-back routine is specified, @ARGV will always be empty upon succesful return of GetOptions since all options have been processed, except when B<--> is used: -foo arg1 -bar arg2 -- arg3 will call the call-back routine for arg1 and arg2, and terminate leaving arg2 in @ARGV. If B is set, options processing terminates when the first non-option is encountered. -foo arg1 -bar arg2 arg3 is equivalent to -foo -- arg1 -bar arg2 arg3 =item bundling (default: reset) Setting this variable to a non-zero value will allow single-character options to be bundled. To distinguish bundles from long option names, long options must be introduced with B<--> and single-character options (and bundles) with B<->. For example, ps -vax --vax would be equivalent to ps -v -a -x --vax provided "vax", "v", "a" and "x" have been defined to be valid options. Bundled options can also include a value in the bundle; for strings this value is the rest of the bundle, but integer and floating values may be combined in the bundle, e.g. scale -h24w80 is equivalent to scale -h 24 -w 80 Note: resetting B also resets B. =item bundling_override (default: reset) If B is set, bundling is enabled as with B but now long option names override option bundles. In the above example, B<-vax> would be interpreted as the option "vax", not the bundle "v", "a", "x". Note: resetting B also resets B. B Using option bundling can easily lead to unexpected results, especially when mixing long options and bundles. Caveat emptor. =item ignore_case (default: set) If set, case is ignored when matching options. Note: resetting B also resets B. =item ignore_case_always (default: reset) When bundling is in effect, case is ignored on single-character options also. Note: resetting B also resets B. =item pass_through (default: reset) Unknown options are passed through in @ARGV instead of being flagged as errors. This makes it possible to write wrapper scripts that process only part of the user supplied options, and passes the remaining options to some other program. This can be very confusing, especially when B is also set. =item prefix The string that starts options. See also B. =item prefix_pattern A Perl pattern that identifies the strings that introduce options. Default is C<(--|-|\+)> unless environment variable POSIXLY_CORRECT has been set, in which case it is C<(--|-)>. =item debug (default: reset) Enable copious debugging output. =back =head1 OTHER USEFUL VARIABLES =over 12 =item $Getopt::Long::VERSION The version number of this Getopt::Long implementation in the format C.C. This can be used to have Exporter check the version, e.g. use Getopt::Long 3.00; You can inspect $Getopt::Long::major_version and $Getopt::Long::minor_version for the individual components. =item $Getopt::Long::error Internal error flag. May be incremented from a call-back routine to cause options parsing to fail. =back =head1 AUTHOR Johan Vromans Ejvromans@squirrel.nlE =head1 COPYRIGHT AND DISCLAIMER This program is Copyright 1990,1999 by Johan Vromans. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. If you do not have a copy of the GNU General Public License write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. =cut slice-1.3.8/lib/getoptlong/Makefile.PL0100664000000000000000000000060406722550651016774 0ustar barbierslice# $Id: Makefile.PL,v 1.7 1998-06-14 15:03:32+02 jv Exp $ use ExtUtils::MakeMaker 5.0; require "./GetoptLong.pm"; WriteMakefile( NAME => "Getopt::Long", DISTNAME => 'GetoptLong', VERSION => $Getopt::Long::VERSION, INSTALLDIRS => 'perl', PM => { "GetoptLong.pm" => '$(INST_LIB)/Getopt/Long.pm' }, dist => { COMPRESS => 'gzip', SUFFIX => 'gz', }, ); slice-1.3.8/lib/getoptlong/MANIFEST0100664000000000000000000000005206721247705016152 0ustar barbiersliceMANIFEST README Makefile.PL GetoptLong.pm slice-1.3.8/lib/getoptlong/README0100664000000000000000000001324606722550651015710 0ustar barbiersliceModule Getopt::Long - extended processing of command line options ================================================================= Module Getopt::Long implements an extended getopt function called GetOptions(). This function implements the POSIX standard for command line options, with GNU extensions, while still capable of handling the traditional one-letter options. In general, this means that command line options can have long names instead of single letters, and are introduced with a double dash `--'. Optionally, Getopt::Long can support the traditional bundling of single-letter command line options. Getopt::Long::GetOptions() is part of the Perl 5 distribution. It is the successor of newgetopt.pl that came with Perl 4. It is fully upward compatible. In fact, the Perl 5 version of newgetopt.pl is just a wrapper around the module. For complete documentation, see the Getopt::Long POD document or use the command perldoc Getopt::Long FEATURES ======== * Long option names Major advantage of using long option names is that it is much easier to memorize the option names. Using single-letter names one quickly runs into the problem that there is no logical relationship between the semantics of the selected option and its option letter. Disadvantage is that it requires more typing. Getopt::Long provides for option name abbreviation, so option names may be abbreviated to uniqueness. Also, modern shells like Cornell's tcsh support option name completion. As a rule of thumb, you can use abbreviations freely while running commands interactively but always use the full names in scripts. Examples (POSIX): --long --width=80 --height=24 Extensions: -long (convenience) +width=80 (deprecated) -height 24 (traditional) By default, long option names are case insensitive. * Single-letter options and bundling When single-letter options are requested, Getopt::Long allows the option names to be bundled, e.g. "-abc" is equivalent to "-a -b -c". In this case, long option names must be introduced with the POSIX "--" introducer. Examples: -lgAd (bundle) -xw 80 (bundle, w takes a value) -xw80 (same) even -l24w80 (l = 24 and w = 80) By default, single-letter option names are case sensitive. * Flexibility: - options can have alternative names, using an alternative name will behave as if the primary name was used; - options can be negatable, e.g. "debug" will switch it on, while "nodebug" will switch it off. - options can set values, but also add values producing an array of values instead of a single scalar value, or set values in a hash. * Options linkage Using Getopt::Long gives the programmer ultimate control over the command line options and how they must be handled: - by setting a global variable in the calling program; - by setting a specified variable; - by entering the option name and the value in an associative array (hash) or object (if it is a blessed hash); - by calling a user-specified subroutine with the option name and the value as arguments; - combinations of the above. * Customization: The module contains a special method, Getopt::Long::Configure, to control configuration variables to activate (or de-activate) specific behavior. It can be called with one or more names of options: - default Restore default settings. - auto_abbrev Allow option names to be abbreviated to uniqueness. - getopt_compat Allow '+' to start options. - permute - require_order Whether non-options are allowed to be mixed with options. permute means that -foo arg1 -bar arg2 arg3 is equivalent to -foo -bar arg1 arg2 arg3 (provided -foo does not take an argument value). require_order means that options processing terminates when the first non-option is encountered. -foo arg1 -bar arg2 arg3 is equivalent to -foo -- arg1 -bar arg2 arg3 - bundling Setting this variable to a non-zero value will allow single-character options to be bundled. To distinguish bundles from long option names, long options must be introduced with "--" and single-character options (and bundles) with "-". - ignore_case Ignore case when matching options. - pass_through Do not issue error messages for unknown options, but leave them (pass-through) in @ARGV. - prefix The string that starts options. See also prefix_pattern. - prefix_pattern A Perl pattern that identifies the strings that introduce options. Default is (--|-|\+) unless environment variable POSIXLY_CORRECT has been set, in which case it is (--|-). * Usable variables - $Getopt::Long::error Internal error flag. May be incremented from a call-back routine to cause options parsing to fail. - $Getopt::Long::debug Enable copious debugging output. Default is 0. AVAILABILITY ============ The official version for module Getopt::Long comes with the Perl 5 distribution. Newer versions will be made available on the Comprehensive Perl Archive Network (CPAN), see "http://www.perl.com/CPAN/authors/Johan_Vromans". COPYRIGHT AND DISCLAIMER ======================== Module Getopt::Long is Copyright 1990,1999 by Johan Vromans. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. ------------------------------------------------------------------- Johan Vromans jvromans@squirrel.nl Squirrel Consultancy Haarlem, the Netherlands http://www.squirrel.nl http://www.squirrel.nl/people/jvromans ------------------ "Arms are made for hugging" -------------------- slice-1.3.8/lib/io/0040755000000000000000000000000007140402256013240 5ustar barbiersliceslice-1.3.8/lib/io/IO/Dir.pm0100664000000000000000000001152007140402256014621 0ustar barbierslice# IO::Dir.pm # # Copyright (c) 1997-8 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Dir; use 5.003_26; use strict; use Carp; use Symbol; use Exporter; use IO::File; use vars qw(@ISA $VERSION @EXPORT_OK); use Tie::Hash; use File::stat; @ISA = qw(Tie::Hash Exporter); $VERSION = "1.03"; @EXPORT_OK = qw(DIR_UNLINK); sub DIR_UNLINK () { 1 } sub new { @_ >= 1 && @_ <= 2 or croak 'usage: new IO::Dir [DIRNAME]'; my $class = shift; my $dh = gensym; if (@_) { IO::Dir::open($dh, $_[0]) or return undef; } bless $dh, $class; } sub DESTROY { my ($dh) = @_; closedir($dh); } sub open { @_ == 2 or croak 'usage: $dh->open(DIRNAME)'; my ($dh, $dirname) = @_; return undef unless opendir($dh, $dirname); ${*$dh}{io_dir_path} = $dirname; 1; } sub close { @_ == 1 or croak 'usage: $dh->close()'; my ($dh) = @_; closedir($dh); } sub read { @_ == 1 or croak 'usage: $dh->read()'; my ($dh) = @_; readdir($dh); } sub seek { @_ == 2 or croak 'usage: $dh->seek(POS)'; my ($dh,$pos) = @_; seekdir($dh,$pos); } sub tell { @_ == 1 or croak 'usage: $dh->tell()'; my ($dh) = @_; telldir($dh); } sub rewind { @_ == 1 or croak 'usage: $dh->rewind()'; my ($dh) = @_; rewinddir($dh); } sub TIEHASH { my($class,$dir,$options) = @_; my $dh = $class->new($dir) or return undef; $options ||= 0; ${*$dh}{io_dir_unlink} = $options & DIR_UNLINK; $dh; } sub FIRSTKEY { my($dh) = @_; $dh->rewind; scalar $dh->read; } sub NEXTKEY { my($dh) = @_; scalar $dh->read; } sub EXISTS { my($dh,$key) = @_; -e ${*$dh}{io_dir_path} . "/" . $key; } sub FETCH { my($dh,$key) = @_; &lstat(${*$dh}{io_dir_path} . "/" . $key); } sub STORE { my($dh,$key,$data) = @_; my($atime,$mtime) = ref($data) ? @$data : ($data,$data); my $file = ${*$dh}{io_dir_path} . "/" . $key; unless(-e $file) { my $io = IO::File->new($file,O_CREAT | O_RDWR); $io->close if $io; } utime($atime,$mtime, $file); } sub DELETE { my($dh,$key) = @_; # Only unlink if unlink-ing is enabled my $file = ${*$dh}{io_dir_path} . "/" . $key; return 0 unless ${*$dh}{io_dir_unlink}; -d $file ? rmdir($file) : unlink($file); } 1; __END__ =head1 NAME IO::Dir - supply object methods for directory handles =head1 SYNOPSIS use IO::Dir; $d = new IO::Dir "."; if (defined $d) { while (defined($_ = $d->read)) { something($_); } $d->rewind; while (defined($_ = $d->read)) { something_else($_); } undef $d; } tie %dir, IO::Dir, "."; foreach (keys %dir) { print $_, " " , $dir{$_}->size,"\n"; } =head1 DESCRIPTION The C package provides two interfaces to perl's directory reading routines. The first interface is an object approach. C provides an object constructor and methods, which are just wrappers around perl's built in directory reading routines. =over 4 =item new ( [ DIRNAME ] ) C is the constuctor for C objects. It accepts one optional argument which, if given, C will pass to C =back The following methods are wrappers for the directory related functions built into perl (the trailing `dir' has been removed from the names). See L for details of these functions. =over 4 =item open ( DIRNAME ) =item read () =item seek ( POS ) =item tell () =item rewind () =item close () =back C also provides a interface to reading directories via a tied HASH. The tied HASH extends the interface beyond just the directory reading routines by the use of C, from the C package, C, C and C. =over 4 =item tie %hash, IO::Dir, DIRNAME [, OPTIONS ] =back The keys of the HASH will be the names of the entries in the directory. Reading a value from the hash will be the result of calling C. Deleting an element from the hash will call C providing that C is passed in the C. Assigning to an entry in the HASH will cause the time stamps of the file to be modified. If the file does not exist then it will be created. Assigning a single integer to a HASH element will cause both the access and modification times to be changed to that value. Alternatively a reference to an array of two values can be passed. The first array element will be used to set the access time and the second element will be used to set the modification time. =head1 SEE ALSO L =head1 AUTHOR Graham Barr EFE =head1 COPYRIGHT Copyright (c) 1997-8 Graham Barr . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut slice-1.3.8/lib/io/IO/File.pm0100664000000000000000000000746407140402256014776 0ustar barbierslice# package IO::File; =head1 NAME IO::File - supply object methods for filehandles =head1 SYNOPSIS use IO::File; $fh = new IO::File; if ($fh->open("< file")) { print <$fh>; $fh->close; } $fh = new IO::File "> file"; if (defined $fh) { print $fh "bar\n"; $fh->close; } $fh = new IO::File "file", "r"; if (defined $fh) { print <$fh>; undef $fh; # automatically closes the file } $fh = new IO::File "file", O_WRONLY|O_APPEND; if (defined $fh) { print $fh "corge\n"; $pos = $fh->getpos; $fh->setpos($pos); undef $fh; # automatically closes the file } autoflush STDOUT 1; =head1 DESCRIPTION C inherits from C and C. It extends these classes with methods that are specific to file handles. =head1 CONSTRUCTOR =over 4 =item new ( FILENAME [,MODE [,PERMS]] ) Creates a C. If it receives any parameters, they are passed to the method C; if the open fails, the object is destroyed. Otherwise, it is returned to the caller. =item new_tmpfile Creates an C opened for read/write on a newly created temporary file. On systems where this is possible, the temporary file is anonymous (i.e. it is unlinked after creation, but held open). If the temporary file cannot be created or opened, the C object is destroyed. Otherwise, it is returned to the caller. =back =head1 METHODS =over 4 =item open( FILENAME [,MODE [,PERMS]] ) C accepts one, two or three parameters. With one parameter, it is just a front end for the built-in C function. With two or three parameters, the first parameter is a filename that may include whitespace or other special characters, and the second parameter is the open mode, optionally followed by a file permission value. If C receives a Perl mode string ("E", "+E", etc.) or a ANSI C fopen() mode string ("w", "r+", etc.), it uses the basic Perl C operator (but protects any special characters). If C is given a numeric mode, it passes that mode and the optional permissions value to the Perl C operator. The permissions default to 0666. For convenience, C exports the O_XXX constants from the Fcntl module, if this module is available. =back =head1 SEE ALSO L, L, L L =head1 HISTORY Derived from FileHandle.pm by Graham Barr EFE. =cut require 5.000; use strict; use vars qw($VERSION @EXPORT @EXPORT_OK @ISA); use Carp; use Symbol; use SelectSaver; use IO::Seekable; require Exporter; require DynaLoader; @ISA = qw(IO::Handle IO::Seekable Exporter DynaLoader); $VERSION = "1.08"; @EXPORT = @IO::Seekable::EXPORT; eval { # Make all Fcntl O_XXX constants available for importing require Fcntl; my @O = grep /^O_/, @Fcntl::EXPORT; Fcntl->import(@O); # first we import what we want to export push(@EXPORT, @O); }; ################################################ ## Constructor ## sub new { my $type = shift; my $class = ref($type) || $type || "IO::File"; @_ >= 0 && @_ <= 3 or croak "usage: new $class [FILENAME [,MODE [,PERMS]]]"; my $fh = $class->SUPER::new(); if (@_) { $fh->open(@_) or return undef; } $fh; } ################################################ ## Open ## sub open { @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])'; my ($fh, $file) = @_; if (@_ > 2) { my ($mode, $perms) = @_[2, 3]; if ($mode =~ /^\d+$/) { defined $perms or $perms = 0666; return sysopen($fh, $file, $mode, $perms); } $file = './' . $file if $file =~ m{\A[^\\/\w]}; $file = IO::Handle::_open_mode_string($mode) . " $file\0"; } open($fh, $file); } 1; slice-1.3.8/lib/io/IO/Handle.pm0100664000000000000000000003473007140402256015306 0ustar barbierslice package IO::Handle; =head1 NAME IO::Handle - supply object methods for I/O handles =head1 SYNOPSIS use IO::Handle; $io = new IO::Handle; if ($io->fdopen(fileno(STDIN),"r")) { print $io->getline; $io->close; } $io = new IO::Handle; if ($io->fdopen(fileno(STDOUT),"w")) { $io->print("Some text\n"); } use IO::Handle '_IOLBF'; $io->setvbuf($buffer_var, _IOLBF, 1024); undef $io; # automatically closes the file if it's open autoflush STDOUT 1; =head1 DESCRIPTION C is the base class for all other IO handle classes. It is not intended that objects of C would be created directly, but instead C is inherited from by several other classes in the IO hierarchy. If you are reading this documentation, looking for a replacement for the C package, then I suggest you read the documentation for C too. =head1 CONSTRUCTOR =over 4 =item new () Creates a new C object. =item new_from_fd ( FD, MODE ) Creates a C like C does. It requires two parameters, which are passed to the method C; if the fdopen fails, the object is destroyed. Otherwise, it is returned to the caller. =back =head1 METHODS See L for complete descriptions of each of the following supported C methods, which are just front ends for the corresponding built-in functions: $io->close $io->eof $io->fileno $io->format_write( [FORMAT_NAME] ) $io->getc $io->read ( BUF, LEN, [OFFSET] ) $io->print ( ARGS ) $io->printf ( FMT, [ARGS] ) $io->stat $io->sysread ( BUF, LEN, [OFFSET] ) $io->syswrite ( BUF, LEN, [OFFSET] ) $io->truncate ( LEN ) See L for complete descriptions of each of the following supported C methods. All of them return the previous value of the attribute and takes an optional single argument that when given will set the value. If no argument is given the previous value is unchanged (except for $io->autoflush will actually turn ON autoflush by default). $io->autoflush ( [BOOL] ) $| $io->format_page_number( [NUM] ) $% $io->format_lines_per_page( [NUM] ) $= $io->format_lines_left( [NUM] ) $- $io->format_name( [STR] ) $~ $io->format_top_name( [STR] ) $^ $io->input_line_number( [NUM]) $. The following methods are not supported on a per-filehandle basis. IO::Handle->format_line_break_characters( [STR] ) $: IO::Handle->format_formfeed( [STR]) $^L IO::Handle->output_field_separator( [STR] ) $, IO::Handle->output_record_separator( [STR] ) $\ IO::Handle->input_record_separator( [STR] ) $/ Furthermore, for doing normal I/O you might need these: =over =item $io->fdopen ( FD, MODE ) C is like an ordinary C except that its first parameter is not a filename but rather a file handle name, a IO::Handle object, or a file descriptor number. =item $io->opened Returns true if the object is currently a valid file descriptor. =item $io->getline This works like <$io> described in L except that it's more readable and can be safely called in an array context but still returns just one line. =item $io->getlines This works like <$io> when called in an array context to read all the remaining lines in a file, except that it's more readable. It will also croak() if accidentally called in a scalar context. =item $io->ungetc ( ORD ) Pushes a character with the given ordinal value back onto the given handle's input stream. Only one character of pushback per handle is guaranteed. =item $io->write ( BUF, LEN [, OFFSET ] ) This C is like C found in C, that is it is the opposite of read. The wrapper for the perl C function is called C. =item $io->error Returns a true value if the given handle has experienced any errors since it was opened or since the last call to C. =item $io->clearerr Clear the given handle's error indicator. =item $io->sync C synchronizes a file's in-memory state with that on the physical medium. C does not operate at the perlio api level, but operates on the file descriptor, this means that any data held at the perlio api level will not be synchronized. To synchronize data that is buffered at the perlio api level you must use the flush method. C is not implemented on all platforms. See L. =item $io->flush C causes perl to flush any buffered data at the perlio api level. Any unread data in the buffer will be discarded, and any unwritten data will be written to the underlying file descriptor. =item $io->printflush ( ARGS ) Turns on autoflush, print ARGS and then restores the autoflush status of the C object. =item $io->blocking ( [ BOOL ] ) If called with an argument C will turn on non-blocking IO if C is false, and turn it off if C is true. C will return the value of the previous setting, or the current setting if C is not given. If an error occurs C will return undef and C<$!> will be set. =back If the C functions setbuf() and/or setvbuf() are available, then C and C set the buffering policy for an IO::Handle. The calling sequences for the Perl functions are the same as their C counterparts--including the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter specifies a scalar variable to use as a buffer. WARNING: A variable used as a buffer by C or C must not be modified in any way until the IO::Handle is closed or C or C is called again, or memory corruption may result! Note that you need to import the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Lastly, there is a special method for working under B<-T> and setuid/gid scripts: =over =item $io->untaint Marks the object as taint-clean, and as such data read from it will also be considered taint-clean. Note that this is a very trusting action to take, and appropriate consideration for the data source and potential vulnerability should be kept in mind. =back =head1 NOTE A C object is a reference to a symbol/GLOB reference (see the C package). Some modules that inherit from C may want to keep object related variables in the hash table part of the GLOB. In an attempt to prevent modules trampling on each other I propose the that any such module should prefix its variables with its own name separated by _'s. For example the IO::Socket module keeps a C variable in 'io_socket_timeout'. =head1 SEE ALSO L, L, L =head1 BUGS Due to backwards compatibility, all filehandles resemble objects of class C, or actually classes derived from that class. They actually aren't. Which means you can't derive your own class from C and inherit those methods. =head1 HISTORY Derived from FileHandle.pm by Graham Barr EFE =cut require 5.000; use strict; use vars qw($VERSION @EXPORT_OK @ISA); use Carp; use Symbol; use SelectSaver; use IO (); # Load the XS module require Exporter; @ISA = qw(Exporter); $VERSION = "1.21"; @EXPORT_OK = qw( autoflush output_field_separator output_record_separator input_record_separator input_line_number format_page_number format_lines_per_page format_lines_left format_name format_top_name format_line_break_characters format_formfeed format_write print printf getline getlines printflush flush SEEK_SET SEEK_CUR SEEK_END _IOFBF _IOLBF _IONBF ); ################################################ ## Constructors, destructors. ## sub new { my $class = ref($_[0]) || $_[0] || "IO::Handle"; @_ == 1 or croak "usage: new $class"; my $io = gensym; bless $io, $class; } sub new_from_fd { my $class = ref($_[0]) || $_[0] || "IO::Handle"; @_ == 3 or croak "usage: new_from_fd $class FD, MODE"; my $io = gensym; shift; IO::Handle::fdopen($io, @_) or return undef; bless $io, $class; } # # There is no need for DESTROY to do anything, because when the # last reference to an IO object is gone, Perl automatically # closes its associated files (if any). However, to avoid any # attempts to autoload DESTROY, we here define it to do nothing. # sub DESTROY {} ################################################ ## Open and close. ## sub _open_mode_string { my ($mode) = @_; $mode =~ /^\+?(<|>>?)$/ or $mode =~ s/^r(\+?)$/$1/ or $mode =~ s/^a(\+?)$/$1>>/ or croak "IO::Handle: bad open mode: $mode"; $mode; } sub fdopen { @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)'; my ($io, $fd, $mode) = @_; local(*GLOB); if (ref($fd) && "".$fd =~ /GLOB\(/o) { # It's a glob reference; Alias it as we cannot get name of anon GLOBs my $n = qualify(*GLOB); *GLOB = *{*$fd}; $fd = $n; } elsif ($fd =~ m#^\d+$#) { # It's an FD number; prefix with "=". $fd = "=$fd"; } open($io, _open_mode_string($mode) . '&' . $fd) ? $io : undef; } sub close { @_ == 1 or croak 'usage: $io->close()'; my($io) = @_; close($io); } ################################################ ## Normal I/O functions. ## # flock # select sub opened { @_ == 1 or croak 'usage: $io->opened()'; defined fileno($_[0]); } sub fileno { @_ == 1 or croak 'usage: $io->fileno()'; fileno($_[0]); } sub getc { @_ == 1 or croak 'usage: $io->getc()'; getc($_[0]); } sub eof { @_ == 1 or croak 'usage: $io->eof()'; eof($_[0]); } sub print { @_ or croak 'usage: $io->print(ARGS)'; my $this = shift; print $this @_; } sub printf { @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])'; my $this = shift; printf $this @_; } sub getline { @_ == 1 or croak 'usage: $io->getline()'; my $this = shift; return scalar <$this>; } *gets = \&getline; # deprecated sub getlines { @_ == 1 or croak 'usage: $io->getlines()'; wantarray or croak 'Can\'t call $io->getlines in a scalar context, use $io->getline'; my $this = shift; return <$this>; } sub truncate { @_ == 2 or croak 'usage: $io->truncate(LEN)'; truncate($_[0], $_[1]); } sub read { @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])'; read($_[0], $_[1], $_[2], $_[3] || 0); } sub sysread { @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])'; sysread($_[0], $_[1], $_[2], $_[3] || 0); } sub write { @_ == 3 || @_ == 4 or croak 'usage: $io->write(BUF, LEN [, OFFSET])'; local($\) = ""; print { $_[0] } substr($_[1], $_[3] || 0, $_[2]); } sub syswrite { @_ == 3 || @_ == 4 or croak 'usage: $io->syswrite(BUF, LEN [, OFFSET])'; syswrite($_[0], $_[1], $_[2], $_[3] || 0); } sub stat { @_ == 1 or croak 'usage: $io->stat()'; stat($_[0]); } ################################################ ## State modification functions. ## sub autoflush { my $old = new SelectSaver qualify($_[0], caller); my $prev = $|; $| = @_ > 1 ? $_[1] : 1; $prev; } sub output_field_separator { carp "output_field_separator is not supported on a per-handle basis" if ref($_[0]); my $prev = $,; $, = $_[1] if @_ > 1; $prev; } sub output_record_separator { carp "output_record_separator is not supported on a per-handle basis" if ref($_[0]); my $prev = $\; $\ = $_[1] if @_ > 1; $prev; } sub input_record_separator { carp "input_record_separator is not supported on a per-handle basis" if ref($_[0]); my $prev = $/; $/ = $_[1] if @_ > 1; $prev; } sub input_line_number { my $now = select; my $keep = $.; my $tell = tell qualify($_[0], caller) if ref($_[0]); my $prev = $.; $. = $_[1] if @_ > 1; $tell = tell $now; $. = $keep; $prev; } sub format_page_number { my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); my $prev = $%; $% = $_[1] if @_ > 1; $prev; } sub format_lines_per_page { my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); my $prev = $=; $= = $_[1] if @_ > 1; $prev; } sub format_lines_left { my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); my $prev = $-; $- = $_[1] if @_ > 1; $prev; } sub format_name { my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); my $prev = $~; $~ = qualify($_[1], caller) if @_ > 1; $prev; } sub format_top_name { my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); my $prev = $^; $^ = qualify($_[1], caller) if @_ > 1; $prev; } sub format_line_break_characters { carp "format_line_break_characters is not supported on a per-handle basis" if ref($_[0]); my $prev = $:; $: = $_[1] if @_ > 1; $prev; } sub format_formfeed { carp "format_formfeed is not supported on a per-handle basis" if ref($_[0]); my $prev = $^L; $^L = $_[1] if @_ > 1; $prev; } sub formline { my $io = shift; my $picture = shift; local($^A) = $^A; local($\) = ""; formline($picture, @_); print $io $^A; } sub format_write { @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )'; if (@_ == 2) { my ($io, $fmt) = @_; my $oldfmt = $io->format_name($fmt); CORE::write($io); $io->format_name($oldfmt); } else { CORE::write($_[0]); } } sub fcntl { @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );'; my ($io, $op, $val) = @_; my $r = fcntl($io, $op, $val); defined $r && $r eq "0 but true" ? 0 : $r; } sub ioctl { @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );'; my ($io, $op, $val) = @_; my $r = ioctl($io, $op, $val); defined $r && $r eq "0 but true" ? 0 : $r; } # this sub is for compatability with older releases of IO that used # a sub called constant to detemine if a constant existed -- GMB # # The SEEK_* and _IO?BF constants were the only constants at that time # any new code should just chech defined(&CONSTANT_NAME) sub constant { no strict 'refs'; my $name = shift; (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name}) ? &{$name}() : undef; } # so that flush.pl can be depriciated sub printflush { my $io = shift; my $old = new SelectSaver qualify($io, caller) if ref($io); local $| = 1; if(ref($io)) { print $io @_; } else { print @_; } } 1; slice-1.3.8/lib/io/IO/Pipe.pm0100664000000000000000000001231207140402256015000 0ustar barbierslice# IO::Pipe.pm # # Copyright (c) 1996-8 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Pipe; require 5.000; use IO::Handle; use strict; use vars qw($VERSION); use Carp; use Symbol; $VERSION = "1.12"; sub new { my $type = shift; my $class = ref($type) || $type || "IO::Pipe"; @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]"; my $me = bless gensym(), $class; my($readfh,$writefh) = @_ ? @_ : $me->handles; pipe($readfh, $writefh) or return undef; @{*$me} = ($readfh, $writefh); $me; } sub handles { @_ == 1 or croak 'usage: $pipe->handles()'; (IO::Pipe::End->new(), IO::Pipe::End->new()); } my $do_spawn = $^O eq 'os2'; sub _doit { my $me = shift; my $rw = shift; my $pid = $do_spawn ? 0 : fork(); if($pid) { # Parent return $pid; } elsif(defined $pid) { # Child or spawn my $fh; my $io = $rw ? \*STDIN : \*STDOUT; my ($mode, $save) = $rw ? "r" : "w"; if ($do_spawn) { require Fcntl; $save = IO::Handle->new_from_fd($io, $mode); # Close in child: fcntl(shift, Fcntl::F_SETFD(), 1) or croak "fcntl: $!"; $fh = $rw ? ${*$me}[0] : ${*$me}[1]; } else { shift; $fh = $rw ? $me->reader() : $me->writer(); # close the other end } bless $io, "IO::Handle"; $io->fdopen($fh, $mode); $fh->close; if ($do_spawn) { $pid = eval { system 1, @_ }; # 1 == P_NOWAIT my $err = $!; $io->fdopen($save, $mode); $save->close or croak "Cannot close $!"; croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0; return $pid; } else { exec @_ or croak "IO::Pipe: Cannot exec: $!"; } } else { croak "IO::Pipe: Cannot fork: $!"; } # NOT Reached } sub reader { @_ >= 1 or croak 'usage: $pipe->reader( [SUB_COMMAND_ARGS] )'; my $me = shift; return undef unless(ref($me) || ref($me = $me->new)); my $fh = ${*$me}[0]; my $pid = $me->_doit(0, $fh, @_) if(@_); close ${*$me}[1]; bless $me, ref($fh); *{*$me} = *{*$fh}; # Alias self to handle $me->fdopen($fh->fileno,"r") unless defined($me->fileno); bless $fh; # Really wan't un-bless here ${*$me}{'io_pipe_pid'} = $pid if defined $pid; $me; } sub writer { @_ >= 1 or croak 'usage: $pipe->writer( [SUB_COMMAND_ARGS] )'; my $me = shift; return undef unless(ref($me) || ref($me = $me->new)); my $fh = ${*$me}[1]; my $pid = $me->_doit(1, $fh, @_) if(@_); close ${*$me}[0]; bless $me, ref($fh); *{*$me} = *{*$fh}; # Alias self to handle $me->fdopen($fh->fileno,"w") unless defined($me->fileno); bless $fh; # Really wan't un-bless here ${*$me}{'io_pipe_pid'} = $pid if defined $pid; $me; } package IO::Pipe::End; use vars qw(@ISA); @ISA = qw(IO::Handle); sub close { my $fh = shift; my $r = $fh->SUPER::close(@_); waitpid(${*$fh}{'io_pipe_pid'},0) if(defined ${*$fh}{'io_pipe_pid'}); $r; } 1; __END__ =head1 NAME IO::Pipe - supply object methods for pipes =head1 SYNOPSIS use IO::Pipe; $pipe = new IO::Pipe; if($pid = fork()) { # Parent $pipe->reader(); while(<$pipe> { .... } } elsif(defined $pid) { # Child $pipe->writer(); print $pipe .... } or $pipe = new IO::Pipe; $pipe->reader(qw(ls -l)); while(<$pipe>) { .... } =head1 DESCRIPTION C provides an interface to createing pipes between processes. =head1 CONSTRCUTOR =over 4 =item new ( [READER, WRITER] ) Creates a C, which is a reference to a newly created symbol (see the C package). C optionally takes two arguments, which should be objects blessed into C, or a subclass thereof. These two objects will be used for the system call to C. If no arguments are given then method C is called on the new C object. These two handles are held in the array part of the GLOB until either C or C is called. =back =head1 METHODS =over 4 =item reader ([ARGS]) The object is re-blessed into a sub-class of C, and becomes a handle at the reading end of the pipe. If C are given then C is called and C are passed to exec. =item writer ([ARGS]) The object is re-blessed into a sub-class of C, and becomes a handle at the writing end of the pipe. If C are given then C is called and C are passed to exec. =item handles () This method is called during construction by C on the newly created C object. It returns an array of two objects blessed into C, or a subclass thereof. =back =head1 SEE ALSO L =head1 AUTHOR Graham Barr =head1 COPYRIGHT Copyright (c) 1996-8 Graham Barr . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut slice-1.3.8/lib/io/IO.pm0100664000000000000000000000134607140402242014103 0ustar barbierslice# package IO; require DynaLoader; require Exporter; use Carp; use vars qw(@ISA $VERSION @EXPORT); @ISA = qw(DynaLoader); $VERSION = "1.20"; bootstrap IO $VERSION; sub import { shift; my @l = @_ ? @_ : qw(Handle Seekable File Pipe Socket Dir); eval join("", map { "require IO::" . (/(\w+)/)[0] . ";\n" } @l) or croak $@; } 1; __END__ =head1 NAME IO - load various IO modules =head1 SYNOPSIS use IO; =head1 DESCRIPTION C provides a simple mechanism to load some of the IO modules at one go. Currently this includes: IO::Handle IO::Seekable IO::File IO::Pipe IO::Socket IO::Dir For more information on any of these modules, please see its respective documentation. =cut slice-1.3.8/lib/io/IO/Poll.pm0100664000000000000000000000755507140402256015026 0ustar barbierslice# IO::Poll.pm # # Copyright (c) 1997-8 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Poll; use strict; use IO::Handle; use Exporter (); use vars qw(@ISA @EXPORT_OK @EXPORT $VERSION); @ISA = qw(Exporter); $VERSION = "0.01"; @EXPORT = qw(poll); @EXPORT_OK = qw( POLLIN POLLPRI POLLOUT POLLRDNORM POLLWRNORM POLLRDBAND POLLWRBAND POLLNORM POLLERR POLLHUP POLLNVAL ); sub new { my $class = shift; my $self = bless [{},{}], $class; $self; } sub mask { my $self = shift; my $io = shift; my $fd = fileno($io); if(@_) { my $mask = shift; $self->[0]{$fd} ||= {}; if($mask) { $self->[0]{$fd}{$io} = $mask; } else { delete $self->[0]{$fd}{$io}; } } elsif(exists $self->[0]{$fd}{$io}) { return $self->[0]{$fd}{$io}; } return; } sub poll { my($self,$timeout) = @_; $self->[1] = {}; my($fd,$ref); my @poll = (); while(($fd,$ref) = each %{$self->[0]}) { my $events = 0; map { $events |= $_ } values %{$ref}; push(@poll,$fd, $events); } my $ret = @poll ? _poll(defined($timeout) ? $timeout * 1000 : -1,@poll) : 0; return $ret unless $ret > 0; while(@poll) { my($fd,$got) = splice(@poll,0,2); $self->[1]{$fd} = $got if $got; } return $ret; } sub events { my $self = shift; my $io = shift; my $fd = fileno($io); exists $self->[1]{$fd} && exists $self->[0]{$fd}{$io} ? $self->[1]{$fd} & $self->[0]{$fd}{$io} : 0; } sub remove { my $self = shift; my $io = shift; $self->mask($io,0); } sub handles { my $self = shift; return map { keys %$_ } values %{$self->[0]} unless(@_); my $events = shift || 0; my($fd,$ev,$io,$mask); my @handles = (); while(($fd,$ev) = each %{$self->[1]}) { if($ev & $events) { while(($io,$mask) = each %{$self->[0][$fd]}) { push(@handles, $io) if $events & $mask; } } } return @handles; } 1; __END__ =head1 NAME IO::Poll - Object interface to system poll call =head1 SYNOPSIS use IO::Poll qw(POLLRDNORM POLLWRNORM POLLIN POLLHUP); $poll = new IO::Poll; $poll->mask($input_handle => POLLRDNORM | POLLIN | POLLHUP); $poll->mask($output_handle => POLLWRNORM); $poll->poll($timeout); $ev = $poll->events($input); =head1 DESCRIPTION C is a simple interface to the system level poll routine. =head1 METHODS =over 4 =item mask ( IO [, EVENT_MASK ] ) If EVENT_MASK is given, then, if EVENT_MASK is non-zero, IO is added to the list of file descriptors and the next call to poll will check for any event specified in EVENT_MASK. If EVENT_MASK is zero then IO will be removed from the list of file descriptors. If EVENT_MASK is not given then the return value will be the current event mask value for IO. =item poll ( [ TIMEOUT ] ) Call the system level poll routine. If TIMEOUT is not specified then the call will block. Returns the number of handles which had events happen, or -1 on error. =item events ( IO ) Returns the event mask which represents the events that happend on IO during the last call to C. =item remove ( IO ) Remove IO from the list of file descriptors for the next poll. =item handles( [ EVENT_MASK ] ) Returns a list of handles. If EVENT_MASK is not given then a list of all handles known will be returned. If EVENT_MASK is given then a list of handles will be returned which had one of the events specified by EVENT_MASK happen during the last call ti C =back =head1 SEE ALSO L, L, L =head1 AUTHOR Graham Barr =head1 COPYRIGHT Copyright (c) 1997-8 Graham Barr . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut slice-1.3.8/lib/io/IO/Seekable.pm0100664000000000000000000000304707140402256015623 0ustar barbierslice# package IO::Seekable; =head1 NAME IO::Seekable - supply seek based methods for I/O objects =head1 SYNOPSIS use IO::Seekable; package IO::Something; @ISA = qw(IO::Seekable); =head1 DESCRIPTION C does not have a constuctor of its own as is intended to be inherited by other C based objects. It provides methods which allow seeking of the file descriptors. If the C functions fgetpos() and fsetpos() are available, then C<$io-Egetpos> returns an opaque value that represents the current position of the IO::File, and C<$io-Esetpos(POS)> uses that value to return to a previously visited position. See L for complete descriptions of each of the following supported C methods, which are just front ends for the corresponding built-in functions: $io->seek( POS, WHENCE ) $io->sysseek( POS, WHENCE ) $io->tell =head1 SEE ALSO L, L, L L =head1 HISTORY Derived from FileHandle.pm by Graham Barr Egbarr@pobox.comE =cut require 5.000; use Carp; use strict; use vars qw($VERSION @EXPORT @ISA); use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); require Exporter; @EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END); @ISA = qw(Exporter); $VERSION = "1.08"; sub seek { @_ == 3 or croak 'usage: $io->seek(POS, WHENCE)'; seek($_[0], $_[1], $_[2]); } sub sysseek { @_ == 3 or croak 'usage: $io->sysseek(POS, WHENCE)'; sysseek($_[0], $_[1], $_[2]); } sub tell { @_ == 1 or croak 'usage: $io->tell()'; tell($_[0]); } 1; slice-1.3.8/lib/io/IO/Select.pm0100664000000000000000000001721207140402256015326 0ustar barbierslice# IO::Select.pm # # Copyright (c) 1997-8 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Select; use strict; use vars qw($VERSION @ISA); require Exporter; $VERSION = "1.13"; @ISA = qw(Exporter); # This is only so we can do version checking sub VEC_BITS () {0} sub FD_COUNT () {1} sub FIRST_FD () {2} sub new { my $self = shift; my $type = ref($self) || $self; my $vec = bless [undef,0], $type; $vec->add(@_) if @_; $vec; } sub add { shift->_update('add', @_); } sub remove { shift->_update('remove', @_); } sub exists { my $vec = shift; $vec->[$vec->_fileno(shift) + FIRST_FD]; } sub _fileno { my($self, $f) = @_; $f = $f->[0] if ref($f) eq 'ARRAY'; ($f =~ /^\d+$/) ? $f : fileno($f); } sub _update { my $vec = shift; my $add = shift eq 'add'; my $bits = $vec->[VEC_BITS]; $bits = '' unless defined $bits; my $count = 0; my $f; foreach $f (@_) { my $fn = $vec->_fileno($f); next unless defined $fn; my $i = $fn + FIRST_FD; if ($add) { if (defined $vec->[$i]) { $vec->[$i] = $f; # if array rest might be different, so we update next; } $vec->[FD_COUNT]++; vec($bits, $fn, 1) = 1; $vec->[$i] = $f; } else { # remove next unless defined $vec->[$i]; $vec->[FD_COUNT]--; vec($bits, $fn, 1) = 0; $vec->[$i] = undef; } $count++; } $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef; $count; } sub can_read { my $vec = shift; my $timeout = shift; my $r = $vec->[VEC_BITS]; defined($r) && (select($r,undef,undef,$timeout) > 0) ? handles($vec, $r) : (); } sub can_write { my $vec = shift; my $timeout = shift; my $w = $vec->[VEC_BITS]; defined($w) && (select(undef,$w,undef,$timeout) > 0) ? handles($vec, $w) : (); } sub has_exception { my $vec = shift; my $timeout = shift; my $e = $vec->[VEC_BITS]; defined($e) && (select(undef,undef,$e,$timeout) > 0) ? handles($vec, $e) : (); } sub has_error { require Carp; Carp::carp("Call to depreciated method 'has_error', use 'has_exception'") if $^W; goto &has_exception; } sub count { my $vec = shift; $vec->[FD_COUNT]; } sub bits { my $vec = shift; $vec->[VEC_BITS]; } sub as_string # for debugging { my $vec = shift; my $str = ref($vec) . ": "; my $bits = $vec->bits; my $count = $vec->count; $str .= defined($bits) ? unpack("b*", $bits) : "undef"; $str .= " $count"; my @handles = @$vec; splice(@handles, 0, FIRST_FD); for (@handles) { $str .= " " . (defined($_) ? "$_" : "-"); } $str; } sub _max { my($a,$b,$c) = @_; $a > $b ? $a > $c ? $a : $c : $b > $c ? $b : $c; } sub select { shift if defined $_[0] && !ref($_[0]); my($r,$w,$e,$t) = @_; my @result = (); my $rb = defined $r ? $r->[VEC_BITS] : undef; my $wb = defined $w ? $w->[VEC_BITS] : undef; my $eb = defined $e ? $e->[VEC_BITS] : undef; if(select($rb,$wb,$eb,$t) > 0) { my @r = (); my @w = (); my @e = (); my $i = _max(defined $r ? scalar(@$r)-1 : 0, defined $w ? scalar(@$w)-1 : 0, defined $e ? scalar(@$e)-1 : 0); for( ; $i >= FIRST_FD ; $i--) { my $j = $i - FIRST_FD; push(@r, $r->[$i]) if defined $rb && defined $r->[$i] && vec($rb, $j, 1); push(@w, $w->[$i]) if defined $wb && defined $w->[$i] && vec($wb, $j, 1); push(@e, $e->[$i]) if defined $eb && defined $e->[$i] && vec($eb, $j, 1); } @result = (\@r, \@w, \@e); } @result; } sub handles { my $vec = shift; my $bits = shift; my @h = (); my $i; my $max = scalar(@$vec) - 1; for ($i = FIRST_FD; $i <= $max; $i++) { next unless defined $vec->[$i]; push(@h, $vec->[$i]) if !defined($bits) || vec($bits, $i - FIRST_FD, 1); } @h; } 1; __END__ =head1 NAME IO::Select - OO interface to the select system call =head1 SYNOPSIS use IO::Select; $s = IO::Select->new(); $s->add(\*STDIN); $s->add($some_handle); @ready = $s->can_read($timeout); @ready = IO::Select->new(@handles)->read(0); =head1 DESCRIPTION The C package implements an object approach to the system C static method. =item bits() Return the bit string suitable as argument to the core select() call. =item select ( READ, WRITE, ERROR [, TIMEOUT ] ) C