perl 2.0 (no announcement message available) perl-2.0
authorLarry Wall <larry@wall.org>
Sun, 5 Jun 1988 00:00:00 +0000 (00:00 +0000)
committerLarry Wall <larry@wall.org>
Sun, 5 Jun 1988 00:00:00 +0000 (00:00 +0000)
Some of the enhancements from Perl1 included:

    * New regexp routines derived from Henry Spencer's.
          o Support for /(foo|bar)/.
          o Support for /(foo)*/ and /(foo)+/.
          o \s for whitespace, \S for non-, \d for digit, \D nondigit
    * Local variables in blocks, subroutines and evals.
    * Recursive subroutine calls are now supported.
    * Array values may now be interpolated into lists: unlink 'foo', 'bar', @trashcan, 'tmp';
    * File globbing.
    * Use of <> in array contexts returns the whole file or glob list.
    * New iterator for normal arrays, foreach, that allows both read and write.
    * Ability to open pipe to a forked off script for secure pipes in setuid scripts.
    * File inclusion via do 'foo.pl';
    * More file tests, including -t to see if, for instance, stdin is a terminal. File tests now behave in a more correct manner. You can do file tests on filehandles as well as filenames. The special filetests -T and -B test a file to see if it's text or binary.
    * An eof can now be used on each file of the <> input for such purposes as resetting the line numbers or appending to each file of an inplace edit.
    * Assignments can now function as lvalues, so you can say things like ($HOST = $host) =~ tr/a-z/A-Z/; ($obj = $src) =~ s/\.c$/.o/;
    * You can now do certain file operations with a variable which holds the name of a filehandle, e.g. open(++$incl,$includefilename); $foo = <$incl>;
    * Warnings are now available (with -w) on use of uninitialized variables and on identifiers that are mentioned only once, and on reference to various undefined things.
    * There is now a wait operator.
    * There is now a sort operator.
    * The manual is now not lying when it says that perl is generally faster than sed. I hope.

152 files changed:
Changes [new file with mode: 0644]
Configure
EXTERN.h
INTERN.h
MANIFEST
Makefile.SH
README
Wishlist
arg.c
arg.h
array.c
array.h
cmd.c
cmd.h
config.h.SH
dump.c
eg/ADB [new file with mode: 0644]
eg/README [new file with mode: 0644]
eg/changes [new file with mode: 0644]
eg/dus [new file with mode: 0644]
eg/findcp [new file with mode: 0644]
eg/findtar [new file with mode: 0644]
eg/g/gcp [new file with mode: 0644]
eg/g/gcp.man [new file with mode: 0644]
eg/g/ged [new file with mode: 0644]
eg/g/ghosts [new file with mode: 0644]
eg/g/gsh [new file with mode: 0644]
eg/g/gsh.man [new file with mode: 0644]
eg/myrup [new file with mode: 0644]
eg/nih [new file with mode: 0644]
eg/rmfrom [new file with mode: 0644]
eg/scan/scan_df [new file with mode: 0644]
eg/scan/scan_last [new file with mode: 0644]
eg/scan/scan_messages [new file with mode: 0644]
eg/scan/scan_passwd [new file with mode: 0644]
eg/scan/scan_ps [new file with mode: 0644]
eg/scan/scan_sudo [new file with mode: 0644]
eg/scan/scan_suid [new file with mode: 0644]
eg/scan/scanner [new file with mode: 0644]
eg/shmkill [new file with mode: 0644]
eg/van/empty [new file with mode: 0644]
eg/van/unvanish [new file with mode: 0644]
eg/van/vanexp [new file with mode: 0644]
eg/van/vanish [new file with mode: 0644]
eval.c [new file with mode: 0644]
form.c
form.h
handy.h
hash.c
hash.h
lib/getopt.pl [new file with mode: 0644]
lib/importenv.pl [new file with mode: 0644]
lib/stat.pl [new file with mode: 0644]
makedepend.SH
makedir.SH
malloc.c
patchlevel.h
perl.h
perl.man.1
perl.man.2
perl.y
perldb
perldb.man
perlsh [new file with mode: 0644]
perly.c
regexp.c [new file with mode: 0644]
regexp.h [new file with mode: 0644]
search.c [deleted file]
search.h [deleted file]
spat.h
stab.c
stab.h
str.c
str.h
t/TEST
t/base.cond
t/base.if
t/base.lex
t/base.pat
t/base.term
t/cmd.elsif
t/cmd.for
t/cmd.mod
t/cmd.subval
t/cmd.while
t/comp.cmdopt
t/comp.cpp
t/comp.decl
t/comp.multiline
t/comp.script
t/comp.term
t/io.argv
t/io.dup [new file with mode: 0644]
t/io.fs
t/io.inplace
t/io.pipe [new file with mode: 0644]
t/io.print
t/io.tell
t/op.append
t/op.auto
t/op.chop
t/op.cond
t/op.crypt [deleted file]
t/op.delete [new file with mode: 0644]
t/op.do
t/op.each
t/op.eval
t/op.exec
t/op.exp
t/op.flip
t/op.fork
t/op.goto
t/op.int
t/op.join
t/op.list
t/op.magic
t/op.oct
t/op.ord
t/op.pat
t/op.push
t/op.regexp [new file with mode: 0644]
t/op.repeat
t/op.sleep
t/op.split
t/op.sprintf
t/op.stat
t/op.study [new file with mode: 0644]
t/op.subst
t/op.time
t/op.unshift
t/re_tests [new file with mode: 0644]
toke.c [new file with mode: 0644]
util.c
util.h
version.c
x2p/EXTERN.h
x2p/INTERN.h
x2p/Makefile.SH
x2p/a2p.h
x2p/a2p.man
x2p/a2p.y
x2p/a2py.c
x2p/handy.h
x2p/hash.c
x2p/hash.h
x2p/s2p
x2p/s2p.man
x2p/str.c
x2p/str.h
x2p/util.c
x2p/util.h
x2p/walk.c

new file mode 100644 (file)
index 0000000..c2f50c2
--- /dev/null
+++ b/Changes
@@ -0,0 +1,89 @@
+New regexp routines derived from Henry Spencer's.
+       Support for /(foo|bar)/.
+       Support for /(foo)*/ and /(foo)+/.
+       \s for whitespace, \S nonwhitespace
+       \d for digit, \D nondigit
+
+Local variables in blocks, subroutines and evals.
+
+Recursive subroutine calls are now supported.
+
+Array values may now be interpolated into lists:
+       unlink 'foo', 'bar', @trashcan, 'tmp';
+
+File globbing via <*.foo>.
+
+Use of <> in array contexts returns the whole file or glob list:
+       unlink <*.foo>;
+
+New iterator for normal arrays, foreach, that allows both read and write:
+       foreach $elem ($array) {
+               $elem =~ s/foo/bar/;
+       }
+
+Ability to open pipe to a forked off script for secure pipes in setuid scripts.
+
+File inclusion via
+       do 'foo.pl';
+
+More file tests, including -t to see if, for instance, stdin is
+a terminal.  File tests now behave in a more correct manner.  You can do
+file tests on filehandles as well as filenames.  The special filetests
+-T and -B test a file to see if it's text or binary.
+
+An eof can now be used on each file of the <> input for such purposes
+as resetting the line numbers or appending to each file of an inplace edit.
+
+Assignments can now function as lvalues, so you can say things like
+       ($HOST = $host) =~ tr/a-z/A-Z/;
+       ($obj = $src) =~ s/\.c$/.o/;
+
+You can now do certain file operations with a variable which holds the name
+of a filehandle, e.g. open(++$incl,$includefilename); $foo = <$incl>;
+
+You can now a subroutine indirectly through a scalar variable:
+       $which = 'xyz';
+       do $which('foo');       # calls xyz
+
+Warnings are now available (with -w) on use of uninitialized variables and on
+identifiers that are mentioned only once, and on reference to various
+undefined things.
+
+The -S switch causes perl to search the PATH for the script so that you can say
+       eval "exec /usr/bin/perl -S $0 $*"
+               if $running_under_some_shell;
+
+Reset now resets arrays and associative arrays as well as string variables.
+
+Assigning off the end of an array now nulls out any intervening values.
+
+$#foo is now an lvalue.  You can preallocate or truncate arrays, or recover
+values lost to prior truncation.
+
+$#foo is now indexed to $[ properly.
+
+s/foo/bar/i optimization bug fixed.
+
+The $x = "...$x..."; bug is fixed.
+
+The @ary = (1); bug is now fixed.  You can even say @ary = 1;
+
+$= now returns the correct value.
+
+Several of the larger files are now split into smaller pieces for easier
+compilation.
+
+Pattern matches evaluated in an array context now return ($1, $2...).
+
+There is now a wait operator.
+
+There is now a sort operator.
+
+The requirement of parens around certain expressions when taking their value
+has been lifted.  In particular, you can say
+       $x = print "foo","bar";
+       $x = unlink "foo","bar";
+       chdir "foo" || die "Can't chdir to foo\n";
+
+The manual is now not lying when it says that perl is generally faster than
+sed.  I hope.
index 991f3bb..8d5a95a 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -8,14 +8,14 @@
 # and edit it to reflect your system.  Some packages may include samples
 # of config.h for certain machines, so you might look for one of those.)
 #
-# $Header: Configure,v 1.0.1.6 88/02/02 11:20:07 root Exp $
+# $Header: Configure,v 2.0 88/06/05 00:07:37 root Exp $
 #
 # Yes, you may rip this off to use in other distribution packages.
 # (Note: this Configure script was generated automatically.  Rather than
 # working with this copy of Configure, you may wish to get metaconfig.)
 
 : sanity checks
-PATH='.:/bin:/usr/bin:/usr/local/bin:/usr/ucb:/usr/local:/usr/lbin:/etc'
+PATH='.:/bin:/usr/bin:/usr/local/bin:/usr/ucb:/usr/local:/usr/lbin:/etc:/usr/new:/usr/new/bin:/usr/nbin'
 export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh $0; kill $$)
 
 if test ! -t 0; then
@@ -34,6 +34,10 @@ if test ! -d ../UU; then
     cd UU
 fi
 
+case "$1" in
+-d) shift; fastread='yes';;
+esac
+
 d_eunice=''
 eunicefix=''
 define=''
@@ -61,24 +65,37 @@ Mcc=''
 vi=''
 mailx=''
 mail=''
+cpp=''
 Log=''
 Header=''
 bin=''
 cc=''
 contains=''
-cpp=''
+cppstdin=''
 cppminus=''
 d_bcopy=''
 d_charsprf=''
 d_crypt=''
+d_fchmod=''
+d_fchown=''
+d_getgrps=''
 d_index=''
+d_killpg=''
+d_memcpy=''
+d_rename=''
+d_setegid=''
+d_seteuid=''
+d_setrgid=''
+d_setruid=''
 d_statblks=''
 d_stdstdio=''
+d_strcspn=''
 d_strctcpy=''
 d_symlink=''
 d_tminsys=''
 d_vfork=''
 d_voidsig=''
+gidtype=''
 libc=''
 libnm=''
 mallocsrc=''
@@ -102,8 +119,10 @@ shsharp=''
 sharpbang=''
 startsh=''
 stdchar=''
+uidtype=''
 voidflags=''
 defvoidused=''
+privlib=''
 CONFIG=''
 
 : set package name
@@ -120,10 +139,23 @@ libpth='/usr/lib /usr/local/lib /lib'
 smallmach='pdp11 i8086 z8000 i80286 iAPX286'
 rmlist='kit[1-9]isdone kit[1-9][0-9]isdone'
 trap 'echo " "; rm -f $rmlist; exit 1' 1 2 3
+
+: We must find out about Eunice early
+eunicefix=':'
+if test -f /etc/unixtovms; then
+    eunicefix=/etc/unixtovms
+fi
+if test -f /etc/unixtovms.exe; then
+    eunicefix=/etc/unixtovms.exe
+fi
+
 attrlist="mc68000 sun gcos unix ibm gimpel interdata tss os mert pyr"
 attrlist="$attrlist vax pdp11 i8086 z8000 u3b2 u3b5 u3b20 u3b200"
 attrlist="$attrlist ns32000 ns16000 iAPX286 mc300 mc500 mc700 sparc"
-pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /etc /usr/lib"
+attrlist="$attrlist nsc32000 sinix xenix venix posix ansi M_XENIX"
+attrlist="$attrlist $mc68k __STDC__"
+pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /etc /usr/lib /lib"
+d_newshome="../../NeWS"
 defvoidused=7
 
 : some greps do not return status, grrr.
@@ -144,7 +176,7 @@ contains*)
     cat >contains <<'EOSS'
 grep "$1" "$2" >.greptmp && cat .greptmp && test -s .greptmp
 EOSS
-chmod 755 contains
+chmod +x contains
 esac
 
 : first determine how to suppress newline on echo command
@@ -167,7 +199,10 @@ rm -f .echotmp
 
 : now set up to do reads with possible shell escape and default assignment
 cat <<EOSC >myread
-ans='!'
+case "\$fastread" in
+yes) ans=''; echo " " ;;
+*) ans='!';;
+esac
 while expr "X\$ans" : "X!" >/dev/null; do
     read ans
     case "\$ans" in
@@ -273,6 +308,10 @@ for dir in \$*; do
        if test -f \$dir/\$thing; then
            echo \$dir/\$thing
            exit 0
+       elif test -f \$dir/\$thing.exe; then
+           : on Eunice apparently
+           echo \$dir/\$thing
+           exit 0
        fi
        ;;
     esac
@@ -280,7 +319,7 @@ done
 echo \$dflt
 exit 1
 EOSC
-chmod 755 loc
+chmod +x loc
 $eunicefix loc
 loclist="
 expr
@@ -300,6 +339,7 @@ trylist="
 test
 egrep
 Mcc
+cpp
 "
 for file in $loclist; do
     xxx=`loc $file $file $pth`
@@ -398,6 +438,12 @@ if test -f /lib/libc.a; then
     libc=/lib/libc.a
 else
     ans=`loc libc.a blurfl/dyick $libpth`
+    if test ! -f $ans; then
+       ans=`loc clib blurfl/dyick $libpth`
+    fi
+    if test ! -f $ans; then
+       ans=`loc libc blurfl/dyick $libpth`
+    fi
     if test -f $ans; then
        echo "Your C library is in $ans, of all places."
        libc=$ans
@@ -423,17 +469,23 @@ EOM
 fi
 echo " "
 $echo $n "Extracting names from $libc for later perusal...$c"
-if ar t $libc > libc.list; then
+nm $libc 2>/dev/null | sed -n -e 's/^.* T _//p' -e 's/^.* T //p' > libc.list
+if $contains '^printf$' libc.list >/dev/null 2>&1; then
     echo "done"
 else
-    echo " "
-    echo "The archiver doesn't think $libc is a reasonable library."
-    echo "Trying nm instead..."
-    if nm -g $libc > libc.list; then
-       echo "Done.  Maybe this is Unicos, or an Apollo?"
+    nm $libc 2>/dev/null | sed -n -e 's/^.* D _//p' -e 's/^.* D //p' > libc.list
+    if $contains '^printf$' libc.list >/dev/null 2>&1; then
+       echo "done"
     else
-       echo "That didn't work either.  Giving up."
-       exit 1
+       echo " "
+       echo "nm didn't seem to work right."
+       echo "Trying ar instead..."
+       if ar t $libc | sed -e 's/\.o$//' > libc.list; then
+           echo "Ok."
+       else
+           echo "That didn't work either.  Giving up."
+           exit 1
+       fi
     fi
 fi
 rmlist="$rmlist libc.list"
@@ -446,7 +498,7 @@ if $contains SIGTSTP /usr/include/signal.h >/dev/null 2>&1 ; then
     echo exit 0 >bsd
     echo exit 1 >usg
     echo exit 1 >v7
-elif $contains fcntl libc.list >/dev/null 2>&1 ; then
+elif $contains '^fcntl$' libc.list >/dev/null 2>&1 ; then
     echo "Looks kind of like a USG system, but we'll see..."
     echo exit 1 >bsd
     echo exit 0 >usg
@@ -457,7 +509,7 @@ else
     echo exit 1 >usg
     echo exit 0 >v7
 fi
-if $contains vmssystem libc.list >/dev/null 2>&1 ; then
+if $contains '^vmssystem$' libc.list >/dev/null 2>&1 ; then
     cat <<'EOI'
 There is, however, a strange, musty smell in the air that reminds me of
 something...hmm...yes...I've got it...there's a VMS nearby, or I'm a Blit.
@@ -481,7 +533,8 @@ else
     echo "It's not Xenix..."
     echo "exit 1" >xenix
 fi
-chmod 755 xenix
+chmod +x xenix
+$eunicefix xenix
 if test -f /venix; then
     echo "Actually, this looks more like a VENIX system..."
     echo "exit 0" >venix
@@ -494,8 +547,8 @@ else
     fi
     echo "exit 1" >venix
 fi
-chmod 755 bsd usg v7 eunice venix xenix
-$eunicefix bsd usg v7 eunice venix xenix
+chmod +x bsd usg v7 eunice venix
+$eunicefix bsd usg v7 eunice venix
 rmlist="$rmlist bsd usg v7 eunice venix xenix"
 
 : see if sh knows # comments
@@ -509,15 +562,15 @@ if sh -c '#' >/dev/null 2>&1 ; then
     echo "Okay, let's see if #! works on this system..."
     echo "#!/bin/echo hi" > try
     $eunicefix try
-    chmod 755 try
+    chmod +x try
     try > today
-    if test -s today; then
+    if $contains hi today >/dev/null 2>&1; then
        echo "It does."
        sharpbang='#!'
     else
        echo "#! /bin/echo hi" > try
        $eunicefix try
-       chmod 755 try
+       chmod +x try
        try > today
        if test -s today; then
            echo "It does."
@@ -531,7 +584,7 @@ else
     echo "Your sh doesn't grok # comments--I will strip them later on."
     shsharp=false
     echo "exec grep -v '^#'" >spitshell
-    chmod 755 spitshell
+    chmod +x spitshell
     $eunicefix spitshell
     spitshell=`pwd`/spitshell
     echo "I presume that if # doesn't work, #! won't work either!"
@@ -549,7 +602,7 @@ set abc
 test "$?abc" != 1
 EOSS
 
-chmod 755 try
+chmod +x try
 $eunicefix try
 if try; then
     echo "Yup, it does."
@@ -566,61 +619,61 @@ cat <<'EOT' >testcpp.c
 #define XYZ xyz
 ABC.XYZ
 EOT
-echo 'Maybe "/lib/cpp" will work...'
-/lib/cpp <testcpp.c >testcpp.out 2>&1
+echo 'Maybe "'$cpp'" will work...'
+$cpp <testcpp.c >testcpp.out 2>&1
 if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
     echo "Yup, it does."
-    cpp='/lib/cpp'
+    cppstdin="$cpp"
     cppminus='';
 else
-    echo 'Nope, maybe "/lib/cpp -" will work...'
-    /lib/cpp - <testcpp.c >testcpp.out 2>&1
+    echo 'Nope, maybe "'$cpp' -" will work...'
+    $cpp - <testcpp.c >testcpp.out 2>&1
     if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
        echo "Yup, it does."
-       cpp='/lib/cpp'
+       cppstdin="$cpp"
        cppminus='-';
     else
        echo 'No such luck...maybe "cc -E" will work...'
        cc -E <testcpp.c >testcpp.out 2>&1
        if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
            echo "It works!"
-           cpp='cc -E'
+           cppstdin='cc -E'
            cppminus='';
        else
            echo 'Nixed again...maybe "cc -E -" will work...'
            cc -E - <testcpp.c >testcpp.out 2>&1
            if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
                echo "Hooray, it works!  I was beginning to wonder."
-               cpp='cc -E'
+               cppstdin='cc -E'
                cppminus='-';
            else
                echo 'Nope...maybe "cc -P" will work...'
                cc -P <testcpp.c >testcpp.out 2>&1
                if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
                    echo "Yup, that does."
-                   cpp='cc -P'
+                   cppstdin='cc -P'
                    cppminus='';
                else
                    echo 'Nope...maybe "cc -P -" will work...'
                    cc -P - <testcpp.c >testcpp.out 2>&1
                    if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
                        echo "Yup, that does."
-                       cpp='cc -P'
+                       cppstdin='cc -P'
                        cppminus='-';
                    else
                        echo 'Hmm...perhaps you already told me...'
-                       case "$cpp" in
+                       case "$cppstdin" in
                        '') ;;
-                       *) $cpp $cppminus <testcpp.c >testcpp.out 2>&1;;
+                       *) $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1;;
                        esac
                        if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
                            echo "Hooray, you did!  I was beginning to wonder."
                        else
                            echo 'Uh-uh.  Time to get fancy...'
                            echo 'Trying (cat >/tmp/$$.c; cc -E /tmp/$$.c; rm /tmp/$$.c)'
-                           cpp='(cat >/tmp/$$.c; cc -E /tmp/$$.c; rm /tmp/$$.c)'
+                           cppstdin='(cat >/tmp/$$.c; cc -E /tmp/$$.c; rm /tmp/$$.c)'
                            cppminus='';
-                           $cpp <testcpp.c >testcpp.out 2>&1
+                           $cppstdin <testcpp.c >testcpp.out 2>&1
                            if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
                                echo "Eureka!."
                            else
@@ -628,8 +681,8 @@ else
                                $echo $n "No dice.  I can't find a C preprocessor.  Name one: $c"
                                rp='Name a C preprocessor:'
                                . myread
-                               cpp="$ans"
-                               $cpp <testcpp.c >testcpp.out 2>&1
+                               cppstdin="$ans"
+                               $cppstdin <testcpp.c >testcpp.out 2>&1
                                if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
                                    echo "OK, that will do."
                                else
@@ -648,7 +701,7 @@ rm -f testcpp.c testcpp.out
 
 : see if bcopy exists
 echo " "
-if $contains bcopy libc.list >/dev/null 2>&1; then
+if $contains '^bcopy$' libc.list >/dev/null 2>&1; then
     echo 'bcopy() found.'
     d_bcopy="$define"
 else
@@ -658,17 +711,21 @@ fi
 
 : see if sprintf is declared as int or pointer to char
 echo " "
-if $contains 'char.*sprintf' /usr/include/stdio.h >/dev/null 2>&1 ; then
-    echo "Your sprintf() returns (char*)."
-    d_charsprf="$define"
-else
+cat >.ucbsprf.c <<'EOF'
+main() { char buf[10]; exit((unsigned long)sprintf(buf,"%s","foo") > 10L); }
+EOF
+if cc .ucbsprf.c -o .ucbsprf >/dev/null 2>&1 && .ucbsprf; then
     echo "Your sprintf() returns (int)."
     d_charsprf="$undef"
+else
+    echo "Your sprintf() returns (char*)."
+    d_charsprf="$define"
 fi
+/bin/rm -f .ucbsprf.c .ucbsprf
 
 : see if crypt exists
 echo " "
-if $contains crypt libc.list >/dev/null 2>&1; then
+if $contains '^crypt$' libc.list >/dev/null 2>&1; then
     echo 'crypt() found.'
     d_crypt="$define"
 else
@@ -676,27 +733,134 @@ else
     d_crypt="$undef"
 fi
 
+: see if fchmod exists
+echo " "
+if $contains '^fchmod$' libc.list >/dev/null 2>&1; then
+    echo 'fchmod() found.'
+    d_fchmod="$define"
+else
+    echo 'fchmod() not found.'
+    d_fchmod="$undef"
+fi
+
+: see if fchown exists
+echo " "
+if $contains '^fchown$' libc.list >/dev/null 2>&1; then
+    echo 'fchown() found.'
+    d_fchown="$define"
+else
+    echo 'fchown() not found.'
+    d_fchown="$undef"
+fi
+
+: see if getgroups exists
+echo " "
+if $contains '^getgroups$' libc.list >/dev/null 2>&1; then
+    echo 'getgroups() found.'
+    d_getgrps="$define"
+else
+    echo 'getgroups() not found.'
+    d_getgrps="$undef"
+fi
+
 : index or strcpy
 echo " "
-dflt=y
-if $contains index libc.list >/dev/null 2>&1 ; then
-    echo "Your system appears to use index() and rindex() rather than strchr()"
-    $echo $n "and strrchr().  Is this correct? [$dflt] $c"
-    rp='index() rather than strchr()? [$dflt]'
-    . myread
-    case "$ans" in
-       n*|f*) d_index="$define" ;;
-       *)     d_index="$undef" ;;
-    esac
+case "$d_index" in
+n) dflt=n;;
+*) dflt=y;;
+esac
+if $contains '^index$' libc.list >/dev/null 2>&1 ; then
+    if $contains '^strchr$' libc.list >/dev/null 2>&1 ; then
+       echo "Your system has both index() and strchr().  Shall I use"
+       rp="index() rather than strchr()? [$dflt]"
+       $echo $n "$rp $c"
+       . myread
+       case "$ans" in
+           n*) d_index="$define" ;;
+           *)  d_index="$undef" ;;
+       esac
+    else
+       d_index="$undef"
+       echo "index() found."
+    fi
 else
-    echo "Your system appears to use strchr() and strrchr() rather than index()"
-    $echo $n "and rindex().  Is this correct? [$dflt] $c"
-    rp='strchr() rather than index()? [$dflt]'
-    . myread
-    case "$ans" in
-       n*|f*) d_index="$undef" ;;
-       *)     d_index="$define" ;;
-    esac
+    if $contains '^strchr$' libc.list >/dev/null 2>&1 ; then
+       d_index="$define"
+       echo "strchr() found."
+    else
+       echo "No index() or strchr() found!"
+       d_index="$undef"
+    fi
+fi
+
+: see if killpg exists
+echo " "
+if $contains '^killpg$' libc.list >/dev/null 2>&1; then
+    echo 'killpg() found.'
+    d_killpg="$define"
+else
+    echo 'killpg() not found.'
+    d_killpg="$undef"
+fi
+
+: see if memcpy exists
+echo " "
+if $contains '^memcpy$' libc.list >/dev/null 2>&1; then
+    echo 'memcpy() found.'
+    d_memcpy="$define"
+else
+    echo 'memcpy() not found.'
+    d_memcpy="$undef"
+fi
+
+: see if rename exists
+echo " "
+if $contains '^rename$' libc.list >/dev/null 2>&1; then
+    echo 'rename() found.'
+    d_rename="$define"
+else
+    echo 'rename() not found.'
+    d_rename="$undef"
+fi
+
+: see if setegid exists
+echo " "
+if $contains '^setegid$' libc.list >/dev/null 2>&1; then
+    echo 'setegid() found.'
+    d_setegid="$define"
+else
+    echo 'setegid() not found.'
+    d_setegid="$undef"
+fi
+
+: see if seteuid exists
+echo " "
+if $contains '^seteuid$' libc.list >/dev/null 2>&1; then
+    echo 'seteuid() found.'
+    d_seteuid="$define"
+else
+    echo 'seteuid() not found.'
+    d_seteuid="$undef"
+fi
+
+: see if setrgid exists
+echo " "
+if $contains '^setrgid$' libc.list >/dev/null 2>&1; then
+    echo 'setrgid() found.'
+    d_setrgid="$define"
+else
+    echo 'setrgid() not found.'
+    d_setrgid="$undef"
+fi
+
+: see if setruid exists
+echo " "
+if $contains '^setruid$' libc.list >/dev/null 2>&1; then
+    echo 'setruid() found.'
+    d_setruid="$define"
+else
+    echo 'setruid() not found.'
+    d_setruid="$undef"
 fi
 
 : see if stat knows about block sizes
@@ -729,6 +893,16 @@ else
     d_stdstdio="$undef"
 fi
 
+: see if strcspn exists
+echo " "
+if $contains '^strcspn$' libc.list >/dev/null 2>&1; then
+    echo 'strcspn() found.'
+    d_strcspn="$define"
+else
+    echo 'strcspn() not found.'
+    d_strcspn="$undef"
+fi
+
 : check for structure copying
 echo " "
 echo "Checking to see if your C compiler can copy structs..."
@@ -751,6 +925,16 @@ else
 fi
 $rm -f try.*
 
+: see if symlink exists
+echo " "
+if $contains '^symlink$' libc.list >/dev/null 2>&1; then
+    echo 'symlink() found.'
+    d_symlink="$define"
+else
+    echo 'symlink() not found.'
+    d_symlink="$undef"
+fi
+
 : see if struct tm is defined in sys/time.h
 echo " "
 if $contains 'struct tm' /usr/include/time.h >/dev/null 2>&1 ; then
@@ -763,7 +947,7 @@ fi
 
 : see if there is a vfork
 echo " "
-if $contains vfork libc.list >/dev/null 2>&1 ; then
+if $contains '^vfork$' libc.list >/dev/null 2>&1 ; then
     echo "vfork() found."
     d_vfork="$undef"
 else
@@ -801,13 +985,13 @@ void main() {
 main() {
 #endif
        extern void *moo();
-       void (*goo)();
+       void *(*goo)();
 #if TRY & 2
        void (*foo[10])();
 #endif
 
 #if TRY & 4
-       if(goo == moo) {
+       if(*goo == moo) {
                exit(0);
        }
 #endif
@@ -851,19 +1035,28 @@ $echo $n "$rp $c"
 voidflags="$ans"
 $rm -f try.* .out
 
-: see what type of char stdio uses.
+: see what type gids are declared as in the kernel
+case "$gidtype" in
+'')
+    if $contains 'gid_t;' /usr/include/sys/types.h >/dev/null 2>&1 ; then
+       dflt='gid_t';
+    else
+       set `grep 'groups\[NGROUPS\];' /usr/include/sys/user.h 2>/dev/null` unsigned short
+       case $1 in
+       unsigned) dflt="$1 $2" ;;
+       *) dflt="$1" ;;
+       esac
+    fi
+    ;;
+*)  dflt="$gidtype"
+    ;;
+esac
+cont=true
 echo " "
-if $contains 'unsigned.*char.*_ptr;' /usr/include/stdio.h >/dev/null 2>&1 ; then
-    echo "Your stdio uses unsigned chars."
-    stdchar="unsigned char"
-else
-    echo "Your stdio uses signed chars."
-    stdchar="char"
-fi
-
-: preserve RCS keywords in files with variable substitution, grrr
-Log='$Log'
-Header='$Header'
+rp="What type are group ids on this system declared as? [$dflt]"
+$echo $n "$rp $c"
+. myread
+gidtype="$ans"
 
 : set up shell script to do ~ expansion
 cat >filexp <<EOSS
@@ -900,9 +1093,65 @@ case "\$1" in
     ;;
 esac
 EOSS
-chmod 755 filexp
+chmod +x filexp
 $eunicefix filexp
 
+: determine where private executables go
+case "$privlib" in
+'')
+    dflt=/usr/lib/perl
+    test -d /usr/local/lib && dflt=/usr/local/lib/perl
+    ;;
+*)  dflt="$privlib"
+    ;;
+esac
+$cat <<EOM
+
+The perl package has some perl subroutine libraries that should be put in
+a directory that is accessible by everyone.  Where do you want to put these
+EOM
+$echo $n "libraries? [$dflt] $c"
+rp="Put perl libraries where? [$dflt]"
+. myread
+privlib=`filexp $ans`
+
+: see what type of char stdio uses.
+echo " "
+if $contains 'unsigned.*char.*_ptr;' /usr/include/stdio.h >/dev/null 2>&1 ; then
+    echo "Your stdio uses unsigned chars."
+    stdchar="unsigned char"
+else
+    echo "Your stdio uses signed chars."
+    stdchar="char"
+fi
+
+: see what type uids are declared as in the kernel
+case "$uidtype" in
+'')
+    if $contains 'uid_t;' /usr/include/sys/types.h >/dev/null 2>&1 ; then
+       dflt='uid_t';
+    else
+       set `grep '_ruid;' /usr/include/sys/user.h 2>/dev/null` unsigned short
+       case $1 in
+       unsigned) dflt="$1 $2" ;;
+       *) dflt="$1" ;;
+       esac
+    fi
+    ;;
+*)  dflt="$uidtype"
+    ;;
+esac
+cont=true
+echo " "
+rp="What type are user ids on this system declared as? [$dflt]"
+$echo $n "$rp $c"
+. myread
+uidtype="$ans"
+
+: preserve RCS keywords in files with variable substitution, grrr
+Log='$Log'
+Header='$Header'
+
 : determine where public executables go
 case "$bin" in
 '')
@@ -968,6 +1217,9 @@ case "$mansrc" in
 *n)
     manext=n
     ;;
+*C)
+    manext=C
+    ;;
 *)
     manext=1
     ;;
@@ -1008,7 +1260,7 @@ exit 0; _ _ _ _\1\\        \1\\
 #endif\\
 /' >/tmp/Cppsym\$\$
 echo exit 1 >>/tmp/Cppsym\$\$
-$cpp $cppminus </tmp/Cppsym\$\$ >/tmp/Cppsym2\$\$
+$cppstdin $cppminus </tmp/Cppsym\$\$ >/tmp/Cppsym2\$\$
 case "\$list" in
 true) awk 'NF > 5 {print substr(\$6,2,100)}' </tmp/Cppsym2\$\$ ;;
 *)
@@ -1019,7 +1271,7 @@ esac
 $rm -f /tmp/Cppsym\$\$ /tmp/Cppsym2\$\$
 exit \$status
 EOSS
-chmod 755 Cppsym
+chmod +x Cppsym
 $eunicefix Cppsym
 echo "Your C preprocessor defines the following symbols:"
 Cppsym -l $attrlist >Cppsym.true
@@ -1245,16 +1497,6 @@ else
     cc=cc
 fi
 
-: see if symlink exists
-echo " "
-if $contains symlink libc.list >/dev/null 2>&1; then
-    echo 'symlink() found.'
-    d_symlink="$define"
-else
-    echo 'symlink() not found.'
-    d_symlink="$undef"
-fi
-
 : see if we should include -lnm
 echo " "
 if $test -r /usr/lib/libnm.a || $test -r /usr/local/lib/libnm.a ; then
@@ -1341,24 +1583,37 @@ Mcc='$Mcc'
 vi='$vi'
 mailx='$mailx'
 mail='$mail'
+cpp='$cpp'
 Log='$Log'
 Header='$Header'
 bin='$bin'
 cc='$cc'
 contains='$contains'
-cpp='$cpp'
+cppstdin='$cppstdin'
 cppminus='$cppminus'
 d_bcopy='$d_bcopy'
 d_charsprf='$d_charsprf'
 d_crypt='$d_crypt'
+d_fchmod='$d_fchmod'
+d_fchown='$d_fchown'
+d_getgrps='$d_getgrps'
 d_index='$d_index'
+d_killpg='$d_killpg'
+d_memcpy='$d_memcpy'
+d_rename='$d_rename'
+d_setegid='$d_setegid'
+d_seteuid='$d_seteuid'
+d_setrgid='$d_setrgid'
+d_setruid='$d_setruid'
 d_statblks='$d_statblks'
 d_stdstdio='$d_stdstdio'
+d_strcspn='$d_strcspn'
 d_strctcpy='$d_strctcpy'
 d_symlink='$d_symlink'
 d_tminsys='$d_tminsys'
 d_vfork='$d_vfork'
 d_voidsig='$d_voidsig'
+gidtype='$gidtype'
 libc='$libc'
 libnm='$libnm'
 mallocsrc='$mallocsrc'
@@ -1382,8 +1637,10 @@ shsharp='$shsharp'
 sharpbang='$sharpbang'
 startsh='$startsh'
 stdchar='$stdchar'
+uidtype='$uidtype'
 voidflags='$voidflags'
 defvoidused='$defvoidused'
+privlib='$privlib'
 CONFIG=true
 EOT
  
@@ -1391,6 +1648,7 @@ CONFIG=true
 
 echo " "
 dflt=''
+fastread=''
 echo "If you didn't make any mistakes, then just type a carriage return here."
 rp="If you need to edit config.sh, do it as a shell escape here:"
 $echo $n "$rp $c"
@@ -1400,6 +1658,7 @@ case "$ans" in
 *) : in case they cannot read
     eval $ans;;
 esac
+. ./config.sh
 
 echo " "
 echo "Doing variable substitutions on .SH files..."
index a5fff1f..793da6d 100644 (file)
--- a/EXTERN.h
+++ b/EXTERN.h
@@ -1,8 +1,8 @@
-/* $Header: EXTERN.h,v 1.0 87/12/18 13:02:26 root Exp $
+/* $Header: EXTERN.h,v 2.0 88/06/05 00:07:46 root Exp $
  *
  * $Log:       EXTERN.h,v $
- * Revision 1.0  87/12/18  13:02:26  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:07:46  root
+ * Baseline version 2.0.
  * 
  */
 
index 06a59f0..a070e53 100644 (file)
--- a/INTERN.h
+++ b/INTERN.h
@@ -1,8 +1,8 @@
-/* $Header: INTERN.h,v 1.0 87/12/18 13:02:39 root Exp $
+/* $Header: INTERN.h,v 2.0 88/06/05 00:07:49 root Exp $
  *
  * $Log:       INTERN.h,v $
- * Revision 1.0  87/12/18  13:02:39  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:07:49  root
+ * Baseline version 2.0.
  * 
  */
 
index 085b831..39abd2a 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2,111 +2,154 @@ After all the perl kits are run you should have the following files:
 
 Filename               Kit Description
 --------               --- -----------
-Configure                6  Run this first
-EXTERN.h                10  Included before foreign .h files
-INTERN.h                10  Included before domestic .h files
-MANIFEST                 8  This list of files
-Makefile.SH              4  Precursor to Makefile
-README                   1  The Instructions
-Wishlist                10  Some things that may or may not happen
-arg.c                    3  Expression evaluation
-arg.h                    8  Public declarations for the above
-array.c                  6  Numerically subscripted arrays
-array.h                 10  Public declarations for the above
-cmd.c                    7  Command interpreter
-cmd.h                    9  Public declarations for the above
-config.H                 9  Sample config.h
-config.h.SH              9  Produces config.h.
-dump.c                   8  Debugging output
-form.c                   8  Format processing
-form.h                  10  Public declarations for the above
-handy.h                 10  Handy definitions
-hash.c                   9  Associative arrays
-hash.h                  10  Public declarations for the above
-makedepend.SH            9  Precursor to makedepend
-makedir.SH              10  Precursor to makedir
-malloc.c                 7  A version of malloc you might not want
-patchlevel.h             1  The current patch level of perl
-perl.h                   9  Global declarations
-perl.man.1               5  The manual page(s), first half
-perl.man.2               4  The manual page(s), second half
-perl.y                   5  Yacc grammar for perl
-perly.c                  2  The perl compiler
-search.c                 6  String matching
-search.h                10  Public declarations for the above
-spat.h                  10  Search pattern declarations
-stab.c                   8  Symbol table stuff
-stab.h                  10  Public declarations for the above
-str.c                    4  String handling package
-str.h                   10  Public declarations for the above
-t/README                10  Instructions for regression tests
-t/TEST                  10  The regression tester
-t/base.cond             10  See if conditionals work
-t/base.if               10  See if if works
-t/base.lex              10  See if lexical items work
-t/base.pat              10  See if pattern matching works
-t/base.term             10  See if various terms work
-t/cmd.elsif             10  See if else-if works
-t/cmd.for               10  See if for loops work
-t/cmd.mod               10  See if statement modifiers work
-t/cmd.subval            10  See if subroutine values work
-t/cmd.while              7  See if while loops work
-t/comp.cmdopt            9  See if command optimization works
-t/comp.cpp              10  See if C preprocessor works
-t/comp.decl             10  See if declarations work
-t/comp.multiline        10  See if multiline strings work
-t/comp.script           10  See if script invokation works
-t/comp.term             10  See if more terms work
-t/io.argv               10  See if ARGV stuff works
-t/io.fs                  5  See if directory manipulations work
-t/io.inplace            10  See if inplace editing works
-t/io.print              10  See if print commands work
-t/io.tell               10  See if file seeking works
-t/op.append             10  See if . works
-t/op.auto                9  See if autoincrement et all work
-t/op.chop               10  See if chop works
-t/op.cond               10  See if conditional expressions work
-t/op.crypt              10  See if crypt works
-t/op.do                 10  See if subroutines work
-t/op.each               10  See if associative iterators work
-t/op.exec               10  See if exec and system work
-t/op.exp                10  See if math functions work
-t/op.flip               10  See if range operator works
-t/op.fork               10  See if fork works
-t/op.goto               10  See if goto works
-t/op.int                10  See if int works
-t/op.join               10  See if join works
-t/op.list               10  See if array lists work
-t/op.magic              10  See if magic variables work
-t/op.oct                10  See if oct and hex work
-t/op.ord                10  See if ord works
-t/op.pat                 9  See if esoteric patterns work
-t/op.push                7  See if push and pop work
-t/op.repeat             10  See if x operator works
-t/op.sleep               6  See if sleep works
-t/op.split              10  See if split works
-t/op.sprintf            10  See if sprintf work
-t/op.stat               10  See if stat work
-t/op.subst              10  See if substitutions work
-t/op.time               10  See if time functions work
-t/op.unshift            10  See if unshift works
-util.c                   9  Utility routines
-util.h                  10  Public declarations for the above
-version.c               10  Prints version of perl
-x2p/EXTERN.h            10  Same as above
-x2p/INTERN.h            10  Same as above
-x2p/Makefile.SH          9  Precursor to Makefile
-x2p/a2p.h                8  Global declarations
-x2p/a2p.man              8  Manual page for awk to perl translator
-x2p/a2p.y                8  A yacc grammer for awk
-x2p/a2py.c               7  Awk compiler, sort of
-x2p/handy.h             10  Handy definitions
-x2p/hash.c               9  Associative arrays again
-x2p/hash.h              10  Public declarations for the above
-x2p/s2p                  1  Sed to perl translator
-x2p/s2p.man             10  Manual page for sed to perl translator
-x2p/str.c                7  String handling package
-x2p/str.h               10  Public declarations for the above
-x2p/util.c               9  Utility routines
-x2p/util.h              10  Public declarations for the above
-x2p/walk.c               1  Parse tree walker
+Changes                 13 Differences between 1.0 level 29 and 2.0 level 0
+Configure                6 Run this first
+EXTERN.h                 6 Included before foreign .h files
+INTERN.h                15 Included before domestic .h files
+MANIFEST                11 This list of files
+Makefile.SH             13 Precursor to Makefile
+README                   1 The Instructions
+Wishlist                 4 Some things that may or may not happen
+arg.c                    1 Expression evaluation
+arg.h                   12 Public declarations for the above
+array.c                 13 Numerically subscripted arrays
+array.h                 15 Public declarations for the above
+cmd.c                   10 Command interpreter
+cmd.h                   13 Public declarations for the above
+config.H                13 Sample config.h
+config.h.SH             11 Produces config.h.
+dump.c                  12 Debugging output
+eg/ADB                  15 An adb wrapper to put in your crash dir
+eg/README                1 Intro to example perl scripts
+eg/changes              15 A program to list recently changed files
+eg/dus                  15 A program to do du -s on non-mounted dirs
+eg/findcp               14 A find wrapper that implements a -cp switch
+eg/findtar              15 A find wrapper that pumps out a tar file
+eg/g/gcp                14 A program to do a global rcp
+eg/g/gcp.man            14 Manual page for gcp
+eg/g/ged                 1 A program to do a global edit
+eg/g/ghosts             15 A sample /etc/ghosts file
+eg/g/gsh                10 A program to do a global rsh
+eg/g/gsh.man            14 Manual page for gsh
+eg/myrup                15 A program to find lightly loaded machines
+eg/nih                  15 Script to insert #! workaround
+eg/rmfrom               15 A program to feed doomed filenames to
+eg/scan/scan_df         14 Scan for filesystem anomalies
+eg/scan/scan_last       14 Scan for login anomalies
+eg/scan/scan_messages   13 Scan for console message anomalies
+eg/scan/scan_passwd     15 Scan for passwd file anomalies
+eg/scan/scan_ps         15 Scan for process anomalies
+eg/scan/scan_sudo       14 Scan for sudo anomalies
+eg/scan/scan_suid        8 Scan for setuid anomalies
+eg/scan/scanner         14 An anomaly reporter
+eg/shmkill              15 A program to remove unused shared memory
+eg/van/empty            15 A program to empty the trashcan
+eg/van/unvanish         14 A program to undo what vanish does
+eg/van/vanexp           15 A program to expire vanished files
+eg/van/vanish           14 A program to put files in a trashcan
+eval.c                   8 The expression evaluator
+form.c                  12 Format processing
+form.h                  15 Public declarations for the above
+handy.h                 15 Handy definitions
+hash.c                  12 Associative arrays
+hash.h                  14 Public declarations for the above
+lib/getopt.pl           14 Perl library supporting option parsing
+lib/importenv.pl        15 Perl routine to get environment into variables.
+lib/stat.pl             15 Perl library supporting stat function
+makedepend.SH            5 Precursor to makedepend
+makedir.SH              14 Precursor to makedir
+malloc.c                11 A version of malloc you might not want
+patchlevel.h            12 The current patch level of perl
+perl.h                  12 Global declarations
+perl.man.1               5 The manual page(s), first half
+perl.man.2               3 The manual page(s), second half
+perl.y                  10 Yacc grammar for perl
+perldb                  11 Perl symbolic debugger
+perldb.man              13 Manual page for perl debugger
+perlsh                  15 A poor man's perl shell.
+perly.c                  4 The perl compiler
+regexp.c                 2 String matching
+regexp.h                14 Public declarations for the above
+spat.h                  14 Search pattern declarations
+stab.c                   6 Symbol table stuff
+stab.h                   3 Public declarations for the above
+str.c                    7 String handling package
+str.h                   14 Public declarations for the above
+t/README                 1 Instructions for regression tests
+t/TEST                  14 The regression tester
+t/base.cond             15 See if conditionals work
+t/base.if               15 See if if works
+t/base.lex              15 See if lexical items work
+t/base.pat              15 See if pattern matching works
+t/base.term             15 See if various terms work
+t/cmd.elsif             15 See if else-if works
+t/cmd.for               15 See if for loops work
+t/cmd.mod               15 See if statement modifiers work
+t/cmd.subval            14 See if subroutine values work
+t/cmd.while             14 See if while loops work
+t/comp.cmdopt           13 See if command optimization works
+t/comp.cpp              15 See if C preprocessor works
+t/comp.decl             15 See if declarations work
+t/comp.multiline        15 See if multiline strings work
+t/comp.script           14 See if script invokation works
+t/comp.term             15 See if more terms work
+t/io.argv               15 See if ARGV stuff works
+t/io.dup                15 See if >& works right
+t/io.fs                 12 See if directory manipulations work
+t/io.inplace            15 See if inplace editing works
+t/io.pipe               15 See if secure pipes work
+t/io.print              15 See if print commands work
+t/io.tell               13 See if file seeking works
+t/op.append             15 See if . works
+t/op.auto               14 See if autoincrement et all work
+t/op.chop               15 See if chop works
+t/op.cond                5 See if conditional expressions work
+t/op.delete             15 See if delete works
+t/op.do                 14 See if subroutines work
+t/op.each               14 See if associative iterators work
+t/op.eval               14 See if eval operator works
+t/op.exec               15 See if exec and system work
+t/op.exp                15 See if math functions work
+t/op.flip               15 See if range operator works
+t/op.fork               15 See if fork works
+t/op.goto               15 See if goto works
+t/op.int                15 See if int works
+t/op.join               15 See if join works
+t/op.list               14 See if array lists work
+t/op.magic              15 See if magic variables work
+t/op.oct                15 See if oct and hex work
+t/op.ord                15 See if ord works
+t/op.pat                14 See if esoteric patterns work
+t/op.push               15 See if push and pop work
+t/op.regexp             15 See if regular expressions work
+t/op.repeat             15 See if x operator works
+t/op.sleep              15 See if sleep works
+t/op.split               7 See if split works
+t/op.sprintf            15 See if sprintf works
+t/op.stat               11 See if stat works
+t/op.study              14 See if study works
+t/op.subst              14 See if substitutions work
+t/op.time               14 See if time functions work
+t/op.unshift            15 See if unshift works
+t/re_tests              13 Input file for op.regexp
+toke.c                   9 The tokener
+util.c                   8 Utility routines
+util.h                  15 Public declarations for the above
+version.c               15 Prints version of perl
+x2p/EXTERN.h            15 Same as above
+x2p/INTERN.h            15 Same as above
+x2p/Makefile.SH          4 Precursor to Makefile
+x2p/a2p.h               13 Global declarations
+x2p/a2p.man             12 Manual page for awk to perl translator
+x2p/a2p.y               12 A yacc grammer for awk
+x2p/a2py.c               9 Awk compiler, sort of
+x2p/handy.h             15 Handy definitions
+x2p/hash.c              13 Associative arrays again
+x2p/hash.h              14 Public declarations for the above
+x2p/s2p                 10 Sed to perl translator
+x2p/s2p.man              9 Manual page for     sed to perl translator
+x2p/str.c               11 String handling package
+x2p/str.h               15 Public declarations for the above
+x2p/util.c              13 Utility routines
+x2p/util.h              15 Public declarations for the above
+x2p/walk.c               7 Parse tree walker
index 8845396..25ad1f8 100644 (file)
@@ -6,7 +6,7 @@ case $CONFIG in
        ln ../../../config.sh . || \
        (echo "Can't find config.sh."; exit 1)
     fi
-    . config.sh
+    . ./config.sh
     ;;
 esac
 case "$0" in
@@ -20,31 +20,17 @@ esac
 
 echo "Extracting Makefile (with variable substitutions)"
 cat >Makefile <<!GROK!THIS!
-# $Header: Makefile.SH,v 1.0.1.5 88/02/02 11:20:49 root Exp $
+# $Header: Makefile.SH,v 2.0 88/06/05 00:07:54 root Exp $
 #
 # $Log:        Makefile.SH,v $
-# Revision 1.0.1.5  88/02/02  11:20:49  root
-# patch13: added d_symlink dependency, changed TEST to ./perl TEST.
+# Revision 2.0  88/06/05  00:07:54  root
+# Baseline version 2.0.
 # 
-# Revision 1.0.1.4  88/01/28  10:17:59  root
-# patch8: added perldb.man
-# 
-# Revision 1.0.1.3  88/01/26  14:14:52  root
-# Added mallocsrc stuff.
-# 
-# Revision 1.0.1.2  88/01/26  08:46:04  root
-# patch 4: make depend didn't work right if . wasn't in PATH.
-# 
-# Revision 1.0.1.1  88/01/24  03:55:18  root
-# patch 2: remove extra Log lines.
-# 
-# Revision 1.0  87/12/18  16:11:50  root
-# Initial revision
 # 
 
 CC = $cc
 bin = $bin
-lib = $lib
+lib = $privlib
 mansrc = $mansrc
 manext = $manext
 CFLAGS = $ccflags -O
@@ -71,17 +57,17 @@ util =
 sh = Makefile.SH makedepend.SH
 
 h1 = EXTERN.h INTERN.h arg.h array.h cmd.h config.h form.h handy.h
-h2 = hash.h perl.h search.h spat.h stab.h str.h util.h
+h2 = hash.h perl.h regexp.h spat.h stab.h str.h util.h
 
 h = $(h1) $(h2)
 
-c1 = arg.c array.c cmd.c dump.c form.c hash.c $(mallocsrc)
-c2 = search.c stab.c str.c util.c version.c
+c1 = arg.c array.c cmd.c dump.c eval.c form.c hash.c $(mallocsrc)
+c2 = perly.c regexp.c stab.c str.c toke.c util.c version.c
 
 c = $(c1) $(c2)
 
-obj1 = arg.o array.o cmd.o dump.o form.o hash.o $(mallocobj)
-obj2 = search.o stab.o str.o util.o version.o
+obj1 = arg.o array.o cmd.o dump.o eval.o form.o hash.o $(mallocobj)
+obj2 = perly.o regexp.o stab.o str.o toke.o util.o version.o
 
 obj = $(obj1) $(obj2)
 
@@ -101,12 +87,13 @@ all: $(public) $(private) $(util)
 perl: $(obj) perl.o
        $(CC) $(LDFLAGS) $(LARGE) $(obj) perl.o $(libs) -o perl
 
-perl.c: perl.y
-       @ echo Expect 2 shift/reduce errors...
-       yacc perl.y
+perl.c perly.h: perl.y
+       @ echo Expect 37 shift/reduce errors...
+       yacc -d perl.y
        mv y.tab.c perl.c
+       mv y.tab.h perly.h
 
-perl.o: perl.c perly.c perl.h EXTERN.h search.h util.h INTERN.h handy.h
+perl.o: perl.c perly.h perl.h EXTERN.h regexp.h util.h INTERN.h handy.h config.h
        $(CC) -c $(CFLAGS) $(LARGE) perl.c
 
 # if a .h file depends on another .h file...
@@ -119,23 +106,23 @@ perl.man: perl.man.1 perl.man.2
 install: perl perl.man
 # won't work with csh
        export PATH || exit 1
-       - mv $(bin)/perl $(bin)/perl.old
+       - mv $(bin)/perl $(bin)/perl.old 2>/dev/null
        - if test `pwd` != $(bin); then cp $(public) $(bin); fi
        cd $(bin); \
 for pub in $(public); do \
-chmod 755 `basename $$pub`; \
+chmod +x `basename $$pub`; \
 done
-       - test $(bin) = /bin || rm -f /bin/perl
-       - test $(bin) = /bin || ln -s $(bin)/perl /bin || cp $(bin)/perl /bin
-#      chmod 755 makedir
-#      - makedir `filexp $(lib)`
-#      - \
-#if test `pwd` != `filexp $(lib)`; then \
-#cp $(private) `filexp $(lib)`; \
-#fi
-#      cd `filexp $(lib)`; \
+       - test $(bin) = /usr/bin || rm -f /usr/bin/perl
+       - test $(bin) = /usr/bin || $(SLN) $(bin)/perl /usr/bin || cp $(bin)/perl /usr/bin
+       chmod +x makedir
+       - ./makedir $(lib)
+       - \
+if test `pwd` != $(lib); then \
+cp $(private) lib/*.pl $(lib); \
+fi
+#      cd $(lib); \
 #for priv in $(private); do \
-#chmod 755 `basename $$priv`; \
+#chmod +x `basename $$priv`; \
 #done
        - if test `pwd` != $(mansrc); then \
 for page in $(manpages); do \
@@ -154,14 +141,16 @@ realclean:
 # If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message
 # for that spot.
 
-lint:
-       lint $(lintflags) $(defs) $(c) > perl.fuzz
+lint: perl.c $(c)
+       lint $(lintflags) $(defs) perl.c $(c) > perl.fuzz
 
 depend: makedepend
+       - test -f perly.h || cp /dev/null perly.h
        ./makedepend
+       - test -s perly.h || /bin/rm -f perly.h
 
 test: perl
-       chmod 755 t/TEST t/base.* t/comp.* t/cmd.* t/io.* t/op.*
+       chmod +x t/TEST t/base.* t/comp.* t/cmd.* t/io.* t/op.*
        cd t && (rm -f perl; $(SLN) ../perl .) && ./perl TEST
 
 clist:
diff --git a/README b/README
index b5d95e1..0fb953a 100644 (file)
--- a/README
+++ b/README
@@ -1,7 +1,7 @@
 
-                       Perl Kit, Version 1.0
+                       Perl Kit, Version 2.0
 
-                   Copyright (c) 1987, Larry Wall
+                   Copyright (c) 1988, Larry Wall
 
 You may copy the perl kit in whole or in part as long as you don't try to
 make money off it, or pretend that you wrote it.
@@ -52,7 +52,9 @@ Installation
 
     This will run the regression tests on the perl you just made.
     If it doesn't say "All tests successful" then something went wrong.
-    See the README in the t subdirectory.
+    See the README in the t subdirectory.  Note that you can't run it
+    in background if this disables opening of /dev/tty.  If in doubt, just
+    cd to the t directory and run TEST by hand.
 
 6)  make install
 
index 1233293..04e757d 100644 (file)
--- a/Wishlist
+++ b/Wishlist
@@ -2,4 +2,3 @@ date support
 case statement
 ioctl() support
 random numbers
-directory reading via <>
diff --git a/arg.c b/arg.c
index 74da53c..4cdb889 100644 (file)
--- a/arg.c
+++ b/arg.c
-/* $Header: arg.c,v 1.0.1.7 88/02/02 11:22:19 root Exp $
+/* $Header: arg.c,v 2.0 88/06/05 00:08:04 root Exp $
  *
  * $Log:       arg.c,v $
- * Revision 1.0.1.7  88/02/02  11:22:19  root
- * patch13: fixed split(' ') to work right second time.  Added CRYPT dependency.
- * 
- * Revision 1.0.1.6  88/02/01  17:32:26  root
- * patch12: made split(' ') behave like awk in ignoring leading white space.
- * 
- * Revision 1.0.1.5  88/01/30  08:53:16  root
- * patch9: fixed some missing right parens introduced (?) by patch 2
- * 
- * Revision 1.0.1.4  88/01/28  10:22:06  root
- * patch8: added eval operator.
- * 
- * Revision 1.0.1.2  88/01/24  03:52:34  root
- * patch 2: added STATBLKS dependencies.
- * 
- * Revision 1.0.1.1  88/01/21  21:27:10  root
- * Now defines signal return values correctly using VOIDSIG.
- * 
- * Revision 1.0  87/12/18  13:04:33  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:08:04  root
+ * Baseline version 2.0.
  * 
  */
 
-#include <signal.h>
-#include "handy.h"
 #include "EXTERN.h"
-#include "search.h"
-#include "util.h"
 #include "perl.h"
 
-ARG *debarg;
+#include <signal.h>
+#include <errno.h>
+
+extern int errno;
 
-bool
-do_match(s,arg)
-register char *s;
+STR *
+do_match(arg,retary,sarg,ptrmaxsarg,sargoff,cushion)
 register ARG *arg;
+STR ***retary;
+register STR **sarg;
+int *ptrmaxsarg;
+int sargoff;
+int cushion;
 {
     register SPAT *spat = arg[2].arg_ptr.arg_spat;
-    register char *d;
     register char *t;
+    register char *s = str_get(sarg[1]);
+    char *strend = s + sarg[1]->str_cur;
 
-    if (!spat || !s)
-       fatal("panic: do_match\n");
+    if (!spat)
+       return &str_yes;
+    if (!s)
+       fatal("panic: do_match");
+    if (retary) {
+       *retary = sarg;         /* assume no match */
+       *ptrmaxsarg = sargoff;
+    }
     if (spat->spat_flags & SPAT_USED) {
 #ifdef DEBUGGING
        if (debug & 8)
            deb("2.SPAT USED\n");
 #endif
-       return FALSE;
+       return &str_no;
     }
     if (spat->spat_runtime) {
-       t = str_get(eval(spat->spat_runtime,Null(STR***)));
+       t = str_get(eval(spat->spat_runtime,Null(STR***),-1));
 #ifdef DEBUGGING
        if (debug & 8)
            deb("2.SPAT /%s/\n",t);
 #endif
-       if (d = compile(&spat->spat_compex,t,TRUE,FALSE)) {
-#ifdef DEBUGGING
-           deb("/%s/: %s\n", t, d);
-#endif
-           return FALSE;
-       }
-       if (spat->spat_compex.complen <= 1 && curspat)
-           spat = curspat;
-       if (execute(&spat->spat_compex, s, TRUE, 0)) {
-           if (spat->spat_compex.numsubs)
+       spat->spat_regexp = regcomp(t,spat->spat_flags & SPAT_FOLD,1);
+       if (!*spat->spat_regexp->precomp && lastspat)
+           spat = lastspat;
+       if (regexec(spat->spat_regexp, s, strend, TRUE, 0,
+         sarg[1]->str_pok & 4 ? sarg[1] : Nullstr)) {
+           if (spat->spat_regexp->subbase)
                curspat = spat;
-           return TRUE;
+           lastspat = spat;
+           goto gotcha;
        }
        else
-           return FALSE;
+           return &str_no;
     }
     else {
 #ifdef DEBUGGING
        if (debug & 8) {
            char ch;
 
-           if (spat->spat_flags & SPAT_USE_ONCE)
+           if (spat->spat_flags & SPAT_ONCE)
                ch = '?';
            else
                ch = '/';
-           deb("2.SPAT %c%s%c\n",ch,spat->spat_compex.precomp,ch);
+           deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
        }
 #endif
-       if (spat->spat_compex.complen <= 1 && curspat)
-           spat = curspat;
-       if (spat->spat_first) {
+       if (!*spat->spat_regexp->precomp && lastspat)
+           spat = lastspat;
+       t = s;
+       if (hint) {
+           if (hint < s || hint > strend)
+               fatal("panic: hint in do_match");
+           s = hint;
+           hint = Nullch;
+           if (spat->spat_regexp->regback >= 0) {
+               s -= spat->spat_regexp->regback;
+               if (s < t)
+                   s = t;
+           }
+           else
+               s = t;
+       }
+       else if (spat->spat_short) {
            if (spat->spat_flags & SPAT_SCANFIRST) {
-               str_free(spat->spat_first);
-               spat->spat_first = Nullstr;     /* disable optimization */
+               if (sarg[1]->str_pok == 5) {
+                   if (screamfirst[spat->spat_short->str_rare] < 0)
+                       goto nope;
+                   else if (!(s = screaminstr(sarg[1],spat->spat_short)))
+                       goto nope;
+                   else if (spat->spat_flags & SPAT_ALL)
+                       goto yup;
+               }
+               else if (!(s = fbminstr(s, strend, spat->spat_short)))
+                   goto nope;
+               else if (spat->spat_flags & SPAT_ALL)
+                   goto yup;
+               else if (spat->spat_regexp->regback >= 0) {
+                   ++*(long*)&spat->spat_short->str_nval;
+                   s -= spat->spat_regexp->regback;
+                   if (s < t)
+                       s = t;
+               }
+               else
+                   s = t;
+           }
+           else if (!multiline && (*spat->spat_short->str_ptr != *s ||
+             strnNE(spat->spat_short->str_ptr, s, spat->spat_slen) ))
+               goto nope;
+           if (--*(long*)&spat->spat_short->str_nval < 0) {
+               str_free(spat->spat_short);
+               spat->spat_short = Nullstr;     /* opt is being useless */
            }
-           else if (*spat->spat_first->str_ptr != *s ||
-             strnNE(spat->spat_first->str_ptr, s, spat->spat_flen) )
-               return FALSE;
        }
-       if (execute(&spat->spat_compex, s, TRUE, 0)) {
-           if (spat->spat_compex.numsubs)
+       if (regexec(spat->spat_regexp, s, strend, s == t, 0,
+         sarg[1]->str_pok & 4 ? sarg[1] : Nullstr)) {
+           if (spat->spat_regexp->subbase)
                curspat = spat;
-           if (spat->spat_flags & SPAT_USE_ONCE)
+           lastspat = spat;
+           if (spat->spat_flags & SPAT_ONCE)
                spat->spat_flags |= SPAT_USED;
-           return TRUE;
+           goto gotcha;
        }
        else
-           return FALSE;
+           return &str_no;
     }
     /*NOTREACHED*/
+
+  gotcha:
+    if (retary && curspat == spat) {
+       int iters, i, len;
+
+       iters = spat->spat_regexp->nparens;
+       *ptrmaxsarg = iters + sargoff;
+       sarg = (STR**)saferealloc((char*)(sarg - sargoff),
+         (iters+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
+
+       for (i = 1; i <= iters; i++) {
+           sarg[i] = str_static(&str_no);
+           if (s = spat->spat_regexp->startp[i]) {
+               len = spat->spat_regexp->endp[i] - s;
+               if (len > 0)
+                   str_nset(sarg[i],s,len);
+           }
+       }
+       *retary = sarg;
+    }
+    return &str_yes;
+
+yup:
+    ++*(long*)&spat->spat_short->str_nval;
+    return &str_yes;
+
+nope:
+    ++*(long*)&spat->spat_short->str_nval;
+    return &str_no;
 }
 
 int
@@ -116,63 +172,96 @@ register ARG *arg;
 {
     register SPAT *spat;
     register STR *dstr;
-    register char *s;
+    register char *s = str_get(str);
+    char *strend = s + str->str_cur;
     register char *m;
 
     spat = arg[2].arg_ptr.arg_spat;
-    s = str_get(str);
     if (!spat || !s)
-       fatal("panic: do_subst\n");
+       fatal("panic: do_subst");
     else if (spat->spat_runtime) {
-       char *d;
-
-       m = str_get(eval(spat->spat_runtime,Null(STR***)));
-       if (d = compile(&spat->spat_compex,m,TRUE,FALSE)) {
-#ifdef DEBUGGING
-           deb("/%s/: %s\n", m, d);
-#endif
-           return 0;
-       }
+       m = str_get(eval(spat->spat_runtime,Null(STR***),-1));
+       spat->spat_regexp = regcomp(m,spat->spat_flags & SPAT_FOLD,1);
     }
 #ifdef DEBUGGING
     if (debug & 8) {
-       deb("2.SPAT /%s/\n",spat->spat_compex.precomp);
+       deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
     }
 #endif
-    if (spat->spat_compex.complen <= 1 && curspat)
-       spat = curspat;
-    if (spat->spat_first) {
+    if (!*spat->spat_regexp->precomp && lastspat)
+       spat = lastspat;
+    m = s;
+    if (hint) {
+       if (hint < s || hint > strend)
+           fatal("panic: hint in do_match");
+       s = hint;
+       hint = Nullch;
+       if (spat->spat_regexp->regback >= 0) {
+           s -= spat->spat_regexp->regback;
+           if (s < m)
+               s = m;
+       }
+       else
+           s = m;
+    }
+    else if (spat->spat_short) {
        if (spat->spat_flags & SPAT_SCANFIRST) {
-           str_free(spat->spat_first);
-           spat->spat_first = Nullstr; /* disable optimization */
+           if (str->str_pok == 5) {
+               if (screamfirst[spat->spat_short->str_rare] < 0)
+                   goto nope;
+               else if (!(s = screaminstr(str,spat->spat_short)))
+                   goto nope;
+           }
+           else if (!(s = fbminstr(s, strend, spat->spat_short)))
+               goto nope;
+           else if (spat->spat_regexp->regback >= 0) {
+               ++*(long*)&spat->spat_short->str_nval;
+               s -= spat->spat_regexp->regback;
+               if (s < m)
+                   s = m;
+           }
+           else
+               s = m;
+       }
+       else if (!multiline && (*spat->spat_short->str_ptr != *s ||
+         strnNE(spat->spat_short->str_ptr, s, spat->spat_slen) ))
+           goto nope;
+       if (--*(long*)&spat->spat_short->str_nval < 0) {
+           str_free(spat->spat_short);
+           spat->spat_short = Nullstr; /* opt is being useless */
        }
-       else if (*spat->spat_first->str_ptr != *s ||
-         strnNE(spat->spat_first->str_ptr, s, spat->spat_flen) )
-           return 0;
     }
-    if (m = execute(&spat->spat_compex, s, TRUE, 1)) {
+    if (regexec(spat->spat_regexp, s, strend, s == m, 1,
+      str->str_pok & 4 ? str : Nullstr)) {
        int iters = 0;
 
        dstr = str_new(str_len(str));
-       if (spat->spat_compex.numsubs)
+       str_nset(dstr,m,s-m);
+       if (spat->spat_regexp->subbase)
            curspat = spat;
+       lastspat = spat;
        do {
+           m = spat->spat_regexp->startp[0];
            if (iters++ > 10000)
-               fatal("Substitution loop?\n");
-           if (spat->spat_compex.numsubs)
-               s = spat->spat_compex.subbase;
+               fatal("Substitution loop");
+           if (spat->spat_regexp->subbase)
+               s = spat->spat_regexp->subbase;
            str_ncat(dstr,s,m-s);
-           s = spat->spat_compex.subend[0];
-           str_scat(dstr,eval(spat->spat_repl,Null(STR***)));
-           if (spat->spat_flags & SPAT_USE_ONCE)
+           s = spat->spat_regexp->endp[0];
+           str_scat(dstr,eval(spat->spat_repl,Null(STR***),-1));
+           if (spat->spat_flags & SPAT_ONCE)
                break;
-       } while (m = execute(&spat->spat_compex, s, FALSE, 1));
+       } while (regexec(spat->spat_regexp, s, strend, FALSE, 1, Nullstr));
        str_cat(dstr,s);
        str_replace(str,dstr);
        STABSET(str);
        return iters;
     }
     return 0;
+
+nope:
+    ++*(long*)&spat->spat_short->str_nval;
+    return 0;
 }
 
 int
@@ -188,7 +277,7 @@ register ARG *arg;
     tbl = arg[2].arg_ptr.arg_cval;
     s = str_get(str);
     if (!tbl || !s)
-       fatal("panic: do_trans\n");
+       fatal("panic: do_trans");
 #ifdef DEBUGGING
     if (debug & 8) {
        deb("2.TBL\n");
@@ -206,28 +295,29 @@ register ARG *arg;
 }
 
 int
-do_split(s,spat,retary)
-register char *s;
+do_split(spat,retary,sarg,ptrmaxsarg,sargoff,cushion)
 register SPAT *spat;
 STR ***retary;
+register STR **sarg;
+int *ptrmaxsarg;
+int sargoff;
+int cushion;
 {
+    register char *s = str_get(sarg[1]);
+    char *strend = s + sarg[1]->str_cur;
     register STR *dstr;
     register char *m;
     register ARRAY *ary;
     static ARRAY *myarray = Null(ARRAY*);
     int iters = 0;
-    STR **sarg;
-    register char *e;
     int i;
 
     if (!spat || !s)
-       fatal("panic: do_split\n");
+       fatal("panic: do_split");
     else if (spat->spat_runtime) {
-       char *d;
-
-       m = str_get(eval(spat->spat_runtime,Null(STR***)));
+       m = str_get(eval(spat->spat_runtime,Null(STR***),-1));
        if (!*m || (*m == ' ' && !m[1])) {
-           m = "[ \\t\\n]+";
+           m = "\\s+";
            spat->spat_flags |= SPAT_SKIPWHITE;
        }
        if (spat->spat_runtime->arg_type == O_ITEM &&
@@ -235,16 +325,11 @@ STR ***retary;
            arg_free(spat->spat_runtime);       /* it won't change, so */
            spat->spat_runtime = Nullarg;       /* no point compiling again */
        }
-       if (d = compile(&spat->spat_compex,m,TRUE,FALSE)) {
-#ifdef DEBUGGING
-           deb("/%s/: %s\n", m, d);
-#endif
-           return FALSE;
-       }
+       spat->spat_regexp = regcomp(m,spat->spat_flags & SPAT_FOLD,1);
     }
 #ifdef DEBUGGING
     if (debug & 8) {
-       deb("2.SPAT /%s/\n",spat->spat_compex.precomp);
+       deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
     }
 #endif
     if (retary)
@@ -252,21 +337,36 @@ STR ***retary;
     else
        ary = spat->spat_repl[1].arg_ptr.arg_stab->stab_array;
     if (!ary)
-       myarray = ary = anew();
+       myarray = ary = anew(Nullstab);
     ary->ary_fill = -1;
     if (spat->spat_flags & SPAT_SKIPWHITE) {
        while (isspace(*s))
            s++;
     }
-    while (*s && (m = execute(&spat->spat_compex, s, (iters == 0), 1))) {
-       if (spat->spat_compex.numsubs)
-           s = spat->spat_compex.subbase;
-       dstr = str_new(m-s);
-       str_nset(dstr,s,m-s);
-       astore(ary, iters++, dstr);
-       if (iters > 10000)
-           fatal("Substitution loop?\n");
-       s = spat->spat_compex.subend[0];
+    if (spat->spat_short) {
+       i = spat->spat_short->str_cur;
+       while (*s && (m = fbminstr(s, strend, spat->spat_short))) {
+           dstr = str_new(m-s);
+           str_nset(dstr,s,m-s);
+           astore(ary, iters++, dstr);
+           if (iters > 10000)
+               fatal("Substitution loop");
+           s = m + i;
+       }
+    }
+    else {
+       while (*s && regexec(spat->spat_regexp, s, strend, (iters == 0), 1,
+         Nullstr)) {
+           m = spat->spat_regexp->startp[0];
+           if (spat->spat_regexp->subbase)
+               s = spat->spat_regexp->subbase;
+           dstr = str_new(m-s);
+           str_nset(dstr,s,m-s);
+           astore(ary, iters++, dstr);
+           if (iters > 10000)
+               fatal("Substitution loop");
+           s = spat->spat_regexp->endp[0];
+       }
     }
     if (*s) {                  /* ignore field after final "whitespace" */
        dstr = str_new(0);      /*   if they interpolate, it's null anyway */
@@ -278,10 +378,10 @@ STR ***retary;
            iters--;
     }
     if (retary) {
-       sarg = (STR**)safemalloc((iters+2)*sizeof(STR*));
+       *ptrmaxsarg = iters + sargoff;
+       sarg = (STR**)saferealloc((char*)(sarg - sargoff),
+         (iters+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
 
-       sarg[0] = Nullstr;
-       sarg[iters+1] = Nullstr;
        for (i = 1; i <= iters; i++)
            sarg[i] = afetch(ary,i-1);
        *retary = sarg;
@@ -297,12 +397,14 @@ register STR *str;
 {
     STR **tmpary;      /* must not be register */
     register STR **elem;
+    register int items;
 
-    (void)eval(arg[2].arg_ptr.arg_arg,&tmpary);
+    (void)eval(arg[2].arg_ptr.arg_arg,&tmpary,-1);
+    items = (int)str_gnum(*tmpary);
     elem = tmpary+1;
-    if (*elem)
-    str_sset(str,*elem++);
-    for (; *elem; elem++) {
+    if (items-- > 0)
+       str_sset(str,*elem++);
+    for (; items > 0; items--,elem++) {
        str_cat(str,delim);
        str_scat(str,*elem);
     }
@@ -310,6 +412,49 @@ register STR *str;
     safefree((char*)tmpary);
 }
 
+FILE *
+forkopen(name,mode)
+char *name;
+char *mode;
+{
+    int pfd[2];
+
+    if (pipe(pfd) < 0)
+       return Nullfp;
+    while ((forkprocess = fork()) == -1) {
+       if (errno != EAGAIN)
+           return Nullfp;
+       sleep(5);
+    }
+    if (*mode == 'w') {
+       if (forkprocess) {
+           close(pfd[0]);
+           return fdopen(pfd[1],"w");
+       }
+       else {
+           close(pfd[1]);
+           close(0);
+           dup(pfd[0]);        /* substitute our pipe for stdin */
+           close(pfd[0]);
+           return Nullfp;
+       }
+    }
+    else {
+       if (forkprocess) {
+           close(pfd[1]);
+           return fdopen(pfd[0],"r");
+       }
+       else {
+           close(pfd[0]);
+           close(1);
+           if (dup(pfd[1]) == 0)
+               dup(pfd[1]);    /* substitute our pipe for stdout */
+           close(pfd[1]);
+           return Nullfp;
+       }
+    }
+}
+
 bool
 do_open(stab,name)
 STAB *stab;
@@ -318,27 +463,61 @@ register char *name;
     FILE *fp;
     int len = strlen(name);
     register STIO *stio = stab->stab_io;
+    char *myname = savestr(name);
+    int result;
+    int fd;
 
+    name = myname;
+    forkprocess = 1;           /* assume true if no fork */
     while (len && isspace(name[len-1]))
        name[--len] = '\0';
     if (!stio)
        stio = stab->stab_io = stio_new();
     if (stio->fp) {
+       fd = fileno(stio->fp);
        if (stio->type == '|')
-           pclose(stio->fp);
+           result = pclose(stio->fp);
        else if (stio->type != '-')
-           fclose(stio->fp);
+           result = fclose(stio->fp);
+       else
+           result = 0;
+       if (result == EOF && fd > 2)
+           fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
+             stab->stab_name);
        stio->fp = Nullfp;
     }
     stio->type = *name;
     if (*name == '|') {
        for (name++; isspace(*name); name++) ;
-       fp = popen(name,"w");
+       if (strNE(name,"-"))
+           fp = popen(name,"w");
+       else {
+           fp = forkopen(name,"w");
+           stio->subprocess = forkprocess;
+           stio->type = '%';
+       }
     }
     else if (*name == '>' && name[1] == '>') {
+       stio->type = 'a';
        for (name += 2; isspace(*name); name++) ;
        fp = fopen(name,"a");
     }
+    else if (*name == '>' && name[1] == '&') {
+       for (name += 2; isspace(*name); name++) ;
+       if (isdigit(*name))
+           fd = atoi(name);
+       else {
+           stab = stabent(name,FALSE);
+           if (stab->stab_io && stab->stab_io->fp) {
+               fd = fileno(stab->stab_io->fp);
+               stio->type = stab->stab_io->type;
+           }
+           else
+               fd = -1;
+       }
+       fp = fdopen(dup(fd),stio->type == 'a' ? "a" :
+         (stio->type == '<' ? "r" : "w") );
+    }
     else if (*name == '>') {
        for (name++; isspace(*name); name++) ;
        if (strEQ(name,"-")) {
@@ -363,8 +542,15 @@ register char *name;
            while (len && isspace(name[len-1]))
                name[--len] = '\0';
            for (; isspace(*name); name++) ;
-           fp = popen(name,"r");
-           stio->type = '|';
+           if (strNE(name,"-")) {
+               fp = popen(name,"r");
+               stio->type = '|';
+           }
+           else {
+               fp = forkopen(name,"r");
+               stio->subprocess = forkprocess;
+               stio->type = '%';
+           }
        }
        else {
            stio->type = '<';
@@ -377,9 +563,11 @@ register char *name;
                fp = fopen(name,"r");
        }
     }
+    safefree(myname);
     if (!fp)
        return FALSE;
-    if (stio->type != '|' && stio->type != '-') {
+    if (stio->type &&
+      stio->type != '|' && stio->type != '-' && stio->type != '%') {
        if (fstat(fileno(fp),&statbuf) < 0) {
            fclose(fp);
            return FALSE;
@@ -400,14 +588,18 @@ register STAB *stab;
 {
     register STR *str;
     char *oldname;
+    int filemode,fileuid,filegid;
 
-    while (alen(stab->stab_array) >= 0L) {
+    while (alen(stab->stab_array) >= 0) {
        str = ashift(stab->stab_array);
        str_sset(stab->stab_val,str);
        STABSET(stab->stab_val);
        oldname = str_get(stab->stab_val);
        if (do_open(stab,oldname)) {
            if (inplace) {
+               filemode = statbuf.st_mode;
+               fileuid = statbuf.st_uid;
+               filegid = statbuf.st_gid;
                if (*inplace) {
                    str_cat(str,inplace);
 #ifdef RENAME
@@ -418,9 +610,23 @@ register STAB *stab;
                    UNLINK(oldname);
 #endif
                }
+               else {
+                   UNLINK(oldname);
+               }
                sprintf(tokenbuf,">%s",oldname);
+               errno = 0;              /* in case sprintf set errno */
                do_open(argvoutstab,tokenbuf);
                defoutstab = argvoutstab;
+#ifdef FCHMOD
+               fchmod(fileno(argvoutstab->stab_io->fp),filemode);
+#else
+               chmod(oldname,filemode);
+#endif
+#ifdef FCHOWN
+               fchown(fileno(argvoutstab->stab_io->fp),fileuid,filegid);
+#else
+               chown(oldname,fileuid,filegid);
+#endif
            }
            str_free(str);
            return stab->stab_io->fp;
@@ -443,16 +649,30 @@ bool explicit;
 {
     bool retval = FALSE;
     register STIO *stio = stab->stab_io;
+    int status;
+    int tmp;
 
-    if (!stio)         /* never opened */
+    if (!stio) {               /* never opened */
+       if (dowarn && explicit)
+           warn("Close on unopened file <%s>",stab->stab_name);
        return FALSE;
+    }
     if (stio->fp) {
        if (stio->type == '|')
            retval = (pclose(stio->fp) >= 0);
        else if (stio->type == '-')
            retval = TRUE;
-       else
+       else {
            retval = (fclose(stio->fp) != EOF);
+           if (stio->type == '%' && stio->subprocess) {
+               while ((tmp = wait(&status)) != stio->subprocess && tmp != -1)
+                   ;
+               if (tmp == -1)
+                   statusvalue = -1;
+               else
+                   statusvalue = (unsigned)status & 0xffff;
+           }
+       }
        stio->fp = Nullfp;
     }
     if (explicit)
@@ -468,10 +688,11 @@ STAB *stab;
     register STIO *stio;
     int ch;
 
-    if (!stab)
-       return TRUE;
+    if (!stab)                 /* eof() */
+       stio = argvstab->stab_io;
+    else
+       stio = stab->stab_io;
 
-    stio = stab->stab_io;
     if (!stio)
        return TRUE;
 
@@ -487,8 +708,8 @@ STAB *stab;
            ungetc(ch, stio->fp);
            return FALSE;
        }
-       if (stio->flags & IOF_ARGV) {   /* not necessarily a real EOF yet? */
-           if (!nextargv(stab))        /* get another fp handy */
+       if (!stab) {                    /* not necessarily a real EOF yet? */
+           if (!nextargv(argvstab))    /* get another fp handy */
                return TRUE;
        }
        else
@@ -502,16 +723,20 @@ do_tell(stab)
 STAB *stab;
 {
     register STIO *stio;
-    int ch;
 
     if (!stab)
-       return -1L;
+       goto phooey;
 
     stio = stab->stab_io;
     if (!stio || !stio->fp)
-       return -1L;
+       goto phooey;
 
     return ftell(stio->fp);
+
+phooey:
+    if (dowarn)
+       warn("tell() on unopened file");
+    return -1L;
 }
 
 bool
@@ -523,19 +748,113 @@ int whence;
     register STIO *stio;
 
     if (!stab)
-       return FALSE;
+       goto nuts;
 
     stio = stab->stab_io;
     if (!stio || !stio->fp)
-       return FALSE;
+       goto nuts;
 
     return fseek(stio->fp, pos, whence) >= 0;
+
+nuts:
+    if (dowarn)
+       warn("seek() on unopened file");
+    return FALSE;
 }
 
-do_stat(arg,sarg,retary)
+static CMD *sortcmd;
+static STAB *firststab = Nullstab;
+static STAB *secondstab = Nullstab;
+
+do_sort(arg,stab,retary,sarg,ptrmaxsarg,sargoff,cushion)
 register ARG *arg;
+STAB *stab;
+STR ***retary;
 register STR **sarg;
+int *ptrmaxsarg;
+int sargoff;
+int cushion;
+{
+    STR **tmpary;      /* must not be register */
+    register STR **elem;
+    register bool retval;
+    register int max;
+    register int i;
+    int sortcmp();
+    int sortsub();
+    STR *oldfirst;
+    STR *oldsecond;
+
+    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
+    max = (int)str_gnum(*tmpary);
+
+    if (retary) {
+       sarg = (STR**)saferealloc((char*)(sarg - sargoff),
+         (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
+       for (i = 1; i <= max; i++)
+           sarg[i] = tmpary[i];
+       *retary = sarg;
+       if (max > 1) {
+           if (stab->stab_sub && (sortcmd = stab->stab_sub->cmd)) {
+               if (!firststab) {
+                   firststab = stabent("a",TRUE);
+                   secondstab = stabent("b",TRUE);
+               }
+               oldfirst = firststab->stab_val;
+               oldsecond = secondstab->stab_val;
+               qsort((char*)(sarg+1),max,sizeof(STR*),sortsub);
+               firststab->stab_val = oldfirst;
+               secondstab->stab_val = oldsecond;
+           }
+           else
+               qsort((char*)(sarg+1),max,sizeof(STR*),sortcmp);
+       }
+       while (max > 0 && !sarg[max])
+           max--;
+       *ptrmaxsarg = max + sargoff;
+    }
+    safefree((char*)tmpary);
+    return max;
+}
+
+int
+sortcmp(str1,str2)
+STR **str1;
+STR **str2;
+{
+    char *tmps;
+
+    if (!*str1)
+       return -1;
+    if (!*str2)
+       return 1;
+    tmps = str_get(*str1);
+    return strcmp(tmps,str_get(*str2));
+}
+
+int
+sortsub(str1,str2)
+STR **str1;
+STR **str2;
+{
+    STR *str;
+
+    if (!*str1)
+       return -1;
+    if (!*str2)
+       return 1;
+    firststab->stab_val = *str1;
+    secondstab->stab_val = *str2;
+    return (int)str_gnum(cmd_exec(sortcmd));
+}
+
+do_stat(arg,retary,sarg,ptrmaxsarg,sargoff,cushion)
+register ARG *arg;
 STR ***retary;
+register STR **sarg;
+int *ptrmaxsarg;
+int sargoff;
+int cushion;
 {
     register ARRAY *ary;
     static ARRAY *myarray = Null(ARRAY*);
@@ -544,7 +863,7 @@ STR ***retary;
 
     ary = myarray;
     if (!ary)
-       myarray = ary = anew();
+       myarray = ary = anew(Nullstab);
     ary->ary_fill = -1;
     if (arg[1].arg_type == A_LVAL) {
        tmpstab = arg[1].arg_ptr.arg_stab;
@@ -578,9 +897,9 @@ STR ***retary;
            apush(ary,str_make(""));
 #endif
        }
-       sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
-       sarg[0] = Nullstr;
-       sarg[max+1] = Nullstr;
+       *ptrmaxsarg = max + sargoff;
+       sarg = (STR**)saferealloc((char*)(sarg - sargoff),
+         (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
        for (i = 1; i <= max; i++)
            sarg[i] = afetch(ary,i-1);
        *retary = sarg;
@@ -588,32 +907,38 @@ STR ***retary;
     return max;
 }
 
-do_tms(retary)
+do_tms(retary,sarg,ptrmaxsarg,sargoff,cushion)
 STR ***retary;
+STR **sarg;
+int *ptrmaxsarg;
+int sargoff;
+int cushion;
 {
     register ARRAY *ary;
     static ARRAY *myarray = Null(ARRAY*);
-    register STR **sarg;
     int max = 4;
     register int i;
 
     ary = myarray;
     if (!ary)
-       myarray = ary = anew();
+       myarray = ary = anew(Nullstab);
     ary->ary_fill = -1;
-    if (times(&timesbuf) < 0)
-       max = 0;
+    times(&timesbuf);
+
+#ifndef HZ
+#define HZ 60
+#endif
 
     if (retary) {
        if (max) {
-           apush(ary,str_nmake(((double)timesbuf.tms_utime)/60.0));
-           apush(ary,str_nmake(((double)timesbuf.tms_stime)/60.0));
-           apush(ary,str_nmake(((double)timesbuf.tms_cutime)/60.0));
-           apush(ary,str_nmake(((double)timesbuf.tms_cstime)/60.0));
-       }
-       sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
-       sarg[0] = Nullstr;
-       sarg[max+1] = Nullstr;
+           apush(ary,str_nmake(((double)timesbuf.tms_utime)/HZ));
+           apush(ary,str_nmake(((double)timesbuf.tms_stime)/HZ));
+           apush(ary,str_nmake(((double)timesbuf.tms_cutime)/HZ));
+           apush(ary,str_nmake(((double)timesbuf.tms_cstime)/HZ));
+       }
+       *ptrmaxsarg = max + sargoff;
+       sarg = (STR**)saferealloc((char*)(sarg - sargoff),
+         (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
        for (i = 1; i <= max; i++)
            sarg[i] = afetch(ary,i-1);
        *retary = sarg;
@@ -621,20 +946,22 @@ STR ***retary;
     return max;
 }
 
-do_time(tmbuf,retary)
+do_time(tmbuf,retary,sarg,ptrmaxsarg,sargoff,cushion)
 struct tm *tmbuf;
 STR ***retary;
+STR **sarg;
+int *ptrmaxsarg;
+int sargoff;
+int cushion;
 {
     register ARRAY *ary;
     static ARRAY *myarray = Null(ARRAY*);
-    register STR **sarg;
     int max = 9;
     register int i;
-    STR *str;
 
     ary = myarray;
     if (!ary)
-       myarray = ary = anew();
+       myarray = ary = anew(Nullstab);
     ary->ary_fill = -1;
     if (!tmbuf)
        max = 0;
@@ -651,9 +978,9 @@ STR ***retary;
            apush(ary,str_nmake((double)tmbuf->tm_yday));
            apush(ary,str_nmake((double)tmbuf->tm_isdst));
        }
-       sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
-       sarg[0] = Nullstr;
-       sarg[max+1] = Nullstr;
+       *ptrmaxsarg = max + sargoff;
+       sarg = (STR**)saferealloc((char*)(sarg - sargoff),
+         (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
        for (i = 1; i <= max; i++)
            sarg[i] = afetch(ary,i-1);
        *retary = sarg;
@@ -688,6 +1015,7 @@ register STR **sarg;
        for (t++; *sarg && *t && t != s; t++) {
            switch (*t) {
            case '\0':
+               t--;
                break;
            case '%':
                ch = *(++t);
@@ -702,7 +1030,7 @@ register STR **sarg;
            case 'D': case 'X': case 'O':
                dolong = TRUE;
                /* FALL THROUGH */
-           case 'd': case 'x': case 'o': case 'c':
+           case 'd': case 'x': case 'o': case 'c': case 'u':
                ch = *(++t);
                *t = '\0';
                if (dolong)
@@ -722,7 +1050,12 @@ register STR **sarg;
            case 's':
                ch = *(++t);
                *t = '\0';
-               sprintf(buf,s,str_get(*(sarg++)));
+               if (strEQ(s,"%s")) {    /* some printfs fail on >128 chars */
+                   *buf = '\0';
+                   str_scat(str,*(sarg++));  /* so handle simple case */
+               }
+               else
+                   sprintf(buf,s,str_get(*(sarg++)));
                s = t;
                *(t--) = ch;
                break;
@@ -736,13 +1069,22 @@ register STR **sarg;
 }
 
 bool
-do_print(s,fp)
-char *s;
+do_print(str,fp)
+register STR *str;
 FILE *fp;
 {
-    if (!fp || !s)
+    if (!fp) {
+       if (dowarn)
+           warn("print to unopened file");
+       return FALSE;
+    }
+    if (!str)
        return FALSE;
-    fputs(s,fp);
+    if (ofmt &&
+      ((str->str_nok && str->str_nval != 0.0) || str_gnum(str) != 0.0) )
+       fprintf(fp, ofmt, str->str_nval);
+    else
+       fputs(str_get(str),fp);
     return TRUE;
 }
 
@@ -754,30 +1096,30 @@ register FILE *fp;
     STR **tmpary;      /* must not be register */
     register STR **elem;
     register bool retval;
-    double value;
+    register int items;
 
-    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
+    if (!fp) {
+       if (dowarn)
+           warn("print to unopened file");
+       return FALSE;
+    }
+    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
+    items = (int)str_gnum(*tmpary);
     if (arg->arg_type == O_PRTF) {
-       do_sprintf(arg->arg_ptr.arg_str,32767,tmpary);
-       retval = do_print(str_get(arg->arg_ptr.arg_str),fp);
+       do_sprintf(arg->arg_ptr.arg_str,items,tmpary);
+       retval = do_print(arg->arg_ptr.arg_str,fp);
     }
     else {
        retval = FALSE;
-       for (elem = tmpary+1; *elem; elem++) {
+       for (elem = tmpary+1; items > 0; items--,elem++) {
            if (retval && ofs)
-               do_print(ofs, fp);
-           if (ofmt && fp) {
-               if ((*elem)->str_nok || str_gnum(*elem) != 0.0)
-                   fprintf(fp, ofmt, str_gnum(*elem));
-               retval = TRUE;
-           }
-           else
-               retval = do_print(str_get(*elem), fp);
+               fputs(ofs, fp);
+           retval = do_print(*elem, fp);
            if (!retval)
                break;
        }
        if (ors)
-           retval = do_print(ors, fp);
+           fputs(ors, fp);
     }
     safefree((char*)tmpary);
     return retval;
@@ -790,18 +1132,19 @@ register ARG *arg;
     STR **tmpary;      /* must not be register */
     register STR **elem;
     register char **a;
-    register int i;
+    register int items;
     char **argv;
 
-    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
-    i = 0;
-    for (elem = tmpary+1; *elem; elem++)
-       i++;
-    if (i) {
-       argv = (char**)safemalloc((i+1)*sizeof(char*));
+    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
+    items = (int)str_gnum(*tmpary);
+    if (items) {
+       argv = (char**)safemalloc((items+1)*sizeof(char*));
        a = argv;
-       for (elem = tmpary+1; *elem; elem++) {
-           *a++ = str_get(*elem);
+       for (elem = tmpary+1; items > 0; items--,elem++) {
+           if (*elem)
+               *a++ = str_get(*elem);
+           else
+               *a++ = "";
        }
        *a = Nullch;
        execvp(argv[0],argv);
@@ -812,19 +1155,19 @@ register ARG *arg;
 }
 
 bool
-do_exec(cmd)
-char *cmd;
+do_exec(str)
+STR *str;
 {
-    STR **tmpary;      /* must not be register */
     register char **a;
     register char *s;
     char **argv;
+    char *cmd = str_get(str);
 
     /* see if there are shell metacharacters in it */
 
     for (s = cmd; *s; s++) {
        if (*s != ' ' && !isalpha(*s) && index("$&*(){}[]'\";\\|?<>~`",*s)) {
-           execl("/bin/sh","sh","-c",cmd,0);
+           execl("/bin/sh","sh","-c",cmd,(char*)0);
            return FALSE;
        }
     }
@@ -854,11 +1197,14 @@ register ARRAY *ary;
     STR **tmpary;      /* must not be register */
     register STR **elem;
     register STR *str = &str_no;
+    register int items;
 
-    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
-    for (elem = tmpary+1; *elem; elem++) {
+    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
+    items = (int)str_gnum(*tmpary);
+    for (elem = tmpary+1; items > 0; items--,elem++) {
        str = str_new(0);
-       str_sset(str,*elem);
+       if (*elem)
+           str_sset(str,*elem);
        apush(ary,str);
     }
     safefree((char*)tmpary);
@@ -873,17 +1219,16 @@ register ARRAY *ary;
     register STR **elem;
     register STR *str = &str_no;
     register int i;
+    register int items;
 
-    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
-    i = 0;
-    for (elem = tmpary+1; *elem; elem++)
-       i++;
-    aunshift(ary,i);
+    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
+    items = (int)str_gnum(*tmpary);
+    aunshift(ary,items);
     i = 0;
-    for (elem = tmpary+1; *elem; elem++) {
+    for (elem = tmpary+1; i < items; i++,elem++) {
        str = str_new(0);
        str_sset(str,*elem);
-       astore(ary,i++,str);
+       astore(ary,i,str);
     }
     safefree((char*)tmpary);
 }
@@ -895,69 +1240,133 @@ STR **sarg;
 {
     STR **tmpary;      /* must not be register */
     register STR **elem;
-    register int i;
+    register int items;
     register int val;
     register int val2;
+    char *s;
 
-    if (sarg)
+    if (sarg) {
        tmpary = sarg;
-    else
-       (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
-    i = 0;
-    for (elem = tmpary+1; *elem; elem++)
-       i++;
+       items = 0;
+       for (elem = tmpary+1; *elem; elem++)
+           items++;
+    }
+    else {
+       (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
+       items = (int)str_gnum(*tmpary);
+    }
     switch (type) {
     case O_CHMOD:
-       if (--i > 0) {
+       if (--items > 0) {
            val = (int)str_gnum(tmpary[1]);
            for (elem = tmpary+2; *elem; elem++)
                if (chmod(str_get(*elem),val))
-                   i--;
+                   items--;
        }
        break;
     case O_CHOWN:
-       if (i > 2) {
-           i -= 2;
+       if (items > 2) {
+           items -= 2;
            val = (int)str_gnum(tmpary[1]);
            val2 = (int)str_gnum(tmpary[2]);
            for (elem = tmpary+3; *elem; elem++)
                if (chown(str_get(*elem),val,val2))
-                   i--;
+                   items--;
        }
        else
-           i = 0;
+           items = 0;
        break;
     case O_KILL:
-       if (--i > 0) {
+       if (--items > 0) {
            val = (int)str_gnum(tmpary[1]);
-           if (val < 0)
+           if (val < 0) {
                val = -val;
-           for (elem = tmpary+2; *elem; elem++)
-               if (kill(atoi(str_get(*elem)),val))
-                   i--;
+               for (elem = tmpary+2; *elem; elem++)
+#ifdef KILLPG
+                   if (killpg((int)(str_gnum(*elem)),val))     /* BSD */
+#else
+                   if (kill(-(int)(str_gnum(*elem)),val))      /* SYSV */
+#endif
+                       items--;
+           }
+           else {
+               for (elem = tmpary+2; *elem; elem++)
+                   if (kill((int)(str_gnum(*elem)),val))
+                       items--;
+           }
        }
        break;
     case O_UNLINK:
-       for (elem = tmpary+1; *elem; elem++)
-           if (UNLINK(str_get(*elem)))
-               i--;
+       for (elem = tmpary+1; *elem; elem++) {
+           s = str_get(*elem);
+           if (euid || unsafe) {
+               if (UNLINK(s))
+                   items--;
+           }
+           else {      /* don't let root wipe out directories without -U */
+               if (stat(s,&statbuf) < 0 ||
+                 (statbuf.st_mode & S_IFMT) == S_IFDIR )
+                   items--;
+               else {
+                   if (UNLINK(s))
+                       items--;
+               }
+           }
+       }
+       break;
+    case O_UTIME:
+       if (items > 2) {
+           struct {
+               long    atime,
+                       mtime;
+           } utbuf;
+
+           utbuf.atime = (long)str_gnum(tmpary[1]);    /* time accessed */
+           utbuf.mtime = (long)str_gnum(tmpary[2]);    /* time modified */
+           items -= 2;
+           for (elem = tmpary+3; *elem; elem++)
+               if (utime(str_get(*elem),&utbuf))
+                   items--;
+       }
+       else
+           items = 0;
        break;
     }
     if (!sarg)
        safefree((char*)tmpary);
-    return i;
+    return items;
 }
 
 STR *
 do_subr(arg,sarg)
 register ARG *arg;
-register char **sarg;
+register STR **sarg;
 {
+    register SUBR *sub;
     ARRAY *savearray;
     STR *str;
+    STAB *stab;
+    char *oldfile = filename;
+    int oldsave = savestack->ary_fill;
+    int oldtmps_base = tmps_base;
 
+    if (arg[2].arg_type == A_WORD)
+       stab = arg[2].arg_ptr.arg_stab;
+    else
+       stab = stabent(str_get(arg[2].arg_ptr.arg_stab->stab_val),TRUE);
+    if (!stab) {
+       if (dowarn)
+           warn("Undefined subroutine called");
+       return &str_no;
+    }
+    sub = stab->stab_sub;
+    if (!sub) {
+       if (dowarn)
+           warn("Undefined subroutine \"%s\" called", stab->stab_name);
+       return &str_no;
+    }
     savearray = defstab->stab_array;
-    defstab->stab_array = anew();
+    defstab->stab_array = anew(defstab);
     if (arg[1].arg_flags & AF_SPECIAL)
        (void)do_push(arg,defstab->stab_array);
     else if (arg[1].arg_type != A_NULL) {
@@ -965,16 +1374,34 @@ register char **sarg;
        str_sset(str,sarg[1]);
        apush(defstab->stab_array,str);
     }
-    str = cmd_exec(arg[2].arg_ptr.arg_stab->stab_sub);
+    sub->depth++;
+    if (sub->depth >= 2) {     /* save temporaries on recursion? */
+       if (sub->depth == 100 && dowarn)
+           warn("Deep recursion on subroutine \"%s\"",stab->stab_name);
+       savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
+    }
+    filename = sub->filename;
+    tmps_base = tmps_max;
+
+    str = cmd_exec(sub->cmd);          /* so do it already */
+
+    sub->depth--;      /* assuming no longjumps out of here */
     afree(defstab->stab_array);  /* put back old $_[] */
     defstab->stab_array = savearray;
+    filename = oldfile;
+    tmps_base = oldtmps_base;
+    if (savestack->ary_fill > oldsave) {
+       str = str_static(str);  /* in case restore wipes old str */
+       restorelist(oldsave);
+    }
     return str;
 }
 
 void
-do_assign(retstr,arg)
+do_assign(retstr,arg,sarg)
 STR *retstr;
 register ARG *arg;
+register STR **sarg;
 {
     STR **tmpary;      /* must not be register */
     register ARG *larg = arg[1].arg_ptr.arg_arg;
@@ -982,60 +1409,76 @@ register ARG *arg;
     register STR *str;
     register ARRAY *ary;
     register int i;
-    register int lasti;
-    char *s;
+    register int items;
+    STR *tmpstr;
 
-    (void)eval(arg[2].arg_ptr.arg_arg,&tmpary);
+    if (arg[2].arg_flags & AF_SPECIAL) {
+       (void)eval(arg[2].arg_ptr.arg_arg,&tmpary,-1);
+       items = (int)str_gnum(*tmpary);
+    }
+    else {
+       tmpary = sarg;
+       sarg[1] = sarg[2];
+       sarg[2] = Nullstr;
+       items = 1;
+    }
 
-    if (arg->arg_flags & AF_COMMON) {
+    if (arg->arg_flags & AF_COMMON) {  /* always true currently, alas */
        if (*(tmpary+1)) {
-           for (elem=tmpary+2; *elem; elem++) {
+           for (i=2,elem=tmpary+2; i <= items; i++,elem++) {
                *elem = str_static(*elem);
            }
        }
     }
     if (larg->arg_type == O_LIST) {
-       lasti = larg->arg_len;
-       for (i=1,elem=tmpary+1; i <= lasti; i++) {
-           if (*elem)
-               s = str_get(*(elem++));
-           else
-               s = "";
+       for (i=1,elem=tmpary+1; i <= larg->arg_len; i++) {
            switch (larg[i].arg_type) {
            case A_STAB:
            case A_LVAL:
                str = STAB_STR(larg[i].arg_ptr.arg_stab);
                break;
            case A_LEXPR:
-               str = eval(larg[i].arg_ptr.arg_arg,Null(STR***));
+               str = eval(larg[i].arg_ptr.arg_arg,Null(STR***),-1);
                break;
            }
-           str_set(str,s);
+           if (larg->arg_flags & AF_LOCAL) {
+               apush(savestack,str);   /* save pointer */
+               tmpstr = str_new(0);
+               str_sset(tmpstr,str);
+               apush(savestack,tmpstr); /* save value */
+           }
+           if (*elem)
+               str_sset(str,*(elem++));
+           else
+               str_set(str,"");
            STABSET(str);
        }
-       i = elem - tmpary - 1;
     }
     else {                     /* should be an array name */
        ary = larg[1].arg_ptr.arg_stab->stab_array;
-       for (i=0,elem=tmpary+1; *elem; i++) {
+       for (i=0,elem=tmpary+1; i < items; i++) {
            str = str_new(0);
            if (*elem)
                str_sset(str,*(elem++));
            astore(ary,i,str);
        }
-       ary->ary_fill = i - 1;  /* they can get the extra ones back by */
-    }                          /*   setting an element larger than old fill */
-    str_numset(retstr,(double)i);
+       ary->ary_fill = items - 1;/* they can get the extra ones back by */
+    }                          /*   setting $#ary larger than old fill */
+    str_numset(retstr,(double)items);
     STABSET(retstr);
-    safefree((char*)tmpary);
+    if (tmpary != sarg);
+       safefree((char*)tmpary);
 }
 
 int
-do_kv(hash,kv,sarg,retary)
+do_kv(hash,kv,retary,sarg,ptrmaxsarg,sargoff,cushion)
 HASH *hash;
 int kv;
-register STR **sarg;
 STR ***retary;
+register STR **sarg;
+int *ptrmaxsarg;
+int sargoff;
+int cushion;
 {
     register ARRAY *ary;
     int max = 0;
@@ -1045,7 +1488,7 @@ STR ***retary;
 
     ary = myarray;
     if (!ary)
-       myarray = ary = anew();
+       myarray = ary = anew(Nullstab);
     ary->ary_fill = -1;
 
     hiterinit(hash);
@@ -1057,9 +1500,9 @@ STR ***retary;
            apush(ary,str_make(str_get(hiterval(entry))));
     }
     if (retary) { /* array wanted */
-       sarg = (STR**)saferealloc((char*)sarg,(max+2)*sizeof(STR*));
-       sarg[0] = Nullstr;
-       sarg[max+1] = Nullstr;
+       *ptrmaxsarg = max + sargoff;
+       sarg = (STR**)saferealloc((char*)(sarg - sargoff),
+         (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
        for (i = 1; i <= max; i++)
            sarg[i] = afetch(ary,i-1);
        *retary = sarg;
@@ -1068,10 +1511,13 @@ STR ***retary;
 }
 
 STR *
-do_each(hash,sarg,retary)
+do_each(hash,retary,sarg,ptrmaxsarg,sargoff,cushion)
 HASH *hash;
-register STR **sarg;
 STR ***retary;
+STR **sarg;
+int *ptrmaxsarg;
+int sargoff;
+int cushion;
 {
     static STR *mystr = Nullstr;
     STR *retstr;
@@ -1084,17 +1530,18 @@ STR ***retary;
 
     if (retary) { /* array wanted */
        if (entry) {
-           sarg = (STR**)saferealloc((char*)sarg,4*sizeof(STR*));
-           sarg[0] = Nullstr;
-           sarg[3] = Nullstr;
+           *ptrmaxsarg = 2 + sargoff;
+           sarg = (STR**)saferealloc((char*)(sarg - sargoff),
+             (2+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
            sarg[1] = mystr = str_make(hiterkey(entry));
            retstr = sarg[2] = hiterval(entry);
            *retary = sarg;
        }
        else {
-           sarg = (STR**)saferealloc((char*)sarg,2*sizeof(STR*));
-           sarg[0] = Nullstr;
-           sarg[1] = retstr = Nullstr;
+           *ptrmaxsarg = sargoff;
+           sarg = (STR**)saferealloc((char*)(sarg - sargoff),
+             (2+cushion+sargoff)*sizeof(STR*)) + sargoff;
+           retstr = Nullstr;
            *retary = sarg;
        }
     }
@@ -1104,32 +1551,172 @@ STR ***retary;
     return retstr;
 }
 
-init_eval()
+int
+mystat(arg,str)
+ARG *arg;
+STR *str;
 {
-    register int i;
+    STIO *stio;
 
-#define A(e1,e2,e3) (e1+(e2<<1)+(e3<<2))
-    opargs[O_ITEM] =           A(1,0,0);
-    opargs[O_ITEM2] =          A(0,0,0);
-    opargs[O_ITEM3] =          A(0,0,0);
-    opargs[O_CONCAT] =         A(1,1,0);
-    opargs[O_MATCH] =          A(1,0,0);
-    opargs[O_NMATCH] =         A(1,0,0);
-    opargs[O_SUBST] =          A(1,0,0);
-    opargs[O_NSUBST] =         A(1,0,0);
-    opargs[O_ASSIGN] =         A(1,1,0);
-    opargs[O_MULTIPLY] =       A(1,1,0);
-    opargs[O_DIVIDE] =         A(1,1,0);
-    opargs[O_MODULO] =         A(1,1,0);
-    opargs[O_ADD] =            A(1,1,0);
-    opargs[O_SUBTRACT] =       A(1,1,0);
-    opargs[O_LEFT_SHIFT] =     A(1,1,0);
-    opargs[O_RIGHT_SHIFT] =    A(1,1,0);
-    opargs[O_LT] =             A(1,1,0);
-    opargs[O_GT] =             A(1,1,0);
-    opargs[O_LE] =             A(1,1,0);
-    opargs[O_GE] =             A(1,1,0);
-    opargs[O_EQ] =             A(1,1,0);
+    if (arg[1].arg_flags & AF_SPECIAL) {
+       stio = arg[1].arg_ptr.arg_stab->stab_io;
+       if (stio && stio->fp)
+           return fstat(fileno(stio->fp), &statbuf);
+       else {
+           if (dowarn)
+               warn("Stat on unopened file <%s>",
+                 arg[1].arg_ptr.arg_stab->stab_name);
+           return -1;
+       }
+    }
+    else
+       return stat(str_get(str),&statbuf);
+}
+
+STR *
+do_fttext(arg,str)
+register ARG *arg;
+STR *str;
+{
+    int i;
+    int len;
+    int odd = 0;
+    STDCHAR tbuf[512];
+    register STDCHAR *s;
+    register STIO *stio;
+
+    if (arg[1].arg_flags & AF_SPECIAL) {
+       stio = arg[1].arg_ptr.arg_stab->stab_io;
+       if (stio && stio->fp) {
+#ifdef STDSTDIO
+           if (stio->fp->_cnt <= 0) {
+               i = getc(stio->fp);
+               ungetc(i,stio->fp);
+           }
+           if (stio->fp->_cnt <= 0)    /* null file is anything */
+               return &str_yes;
+           len = stio->fp->_cnt + (stio->fp->_ptr - stio->fp->_base);
+           s = stio->fp->_base;
+#else
+           fatal("-T and -B not implemented on filehandles\n");
+#endif
+       }
+       else {
+           if (dowarn)
+               warn("Test on unopened file <%s>",
+                 arg[1].arg_ptr.arg_stab->stab_name);
+           return &str_no;
+       }
+    }
+    else {
+       i = open(str_get(str),0);
+       if (i < 0)
+           return &str_no;
+       len = read(i,tbuf,512);
+       if (len <= 0)           /* null file is anything */
+           return &str_yes;
+       close(i);
+       s = tbuf;
+    }
+
+    /* now scan s to look for textiness */
+
+    for (i = 0; i < len; i++,s++) {
+       if (!*s) {                      /* null never allowed in text */
+           odd += len;
+           break;
+       }
+       else if (*s & 128)
+           odd++;
+       else if (*s < 32 &&
+         *s != '\n' && *s != '\r' && *s != '\b' &&
+         *s != '\t' && *s != '\f' && *s != 27)
+           odd++;
+    }
+
+    if ((odd * 10 > len) == (arg->arg_type == O_FTTEXT)) /* allow 10% odd */
+       return &str_no;
+    else
+       return &str_yes;
+}
+
+int
+do_study(str)
+STR *str;
+{
+    register char *s = str_get(str);
+    register int pos = str->str_cur;
+    register int ch;
+    register int *sfirst;
+    register int *snext;
+    static int maxscream = -1;
+    static STR *lastscream = Nullstr;
+
+    if (lastscream && lastscream->str_pok == 5)
+       lastscream->str_pok &= ~4;
+    lastscream = str;
+    if (pos <= 0)
+       return 0;
+    if (pos > maxscream) {
+       if (maxscream < 0) {
+           maxscream = pos + 80;
+           screamfirst = (int*)safemalloc((MEM_SIZE)(256 * sizeof(int)));
+           screamnext = (int*)safemalloc((MEM_SIZE)(maxscream * sizeof(int)));
+       }
+       else {
+           maxscream = pos + pos / 4;
+           screamnext = (int*)saferealloc((char*)screamnext,
+               (MEM_SIZE)(maxscream * sizeof(int)));
+       }
+    }
+
+    sfirst = screamfirst;
+    snext = screamnext;
+
+    if (!sfirst || !snext)
+       fatal("do_study: out of memory");
+
+    for (ch = 256; ch; --ch)
+       *sfirst++ = -1;
+    sfirst -= 256;
+
+    while (--pos >= 0) {
+       ch = s[pos];
+       if (sfirst[ch] >= 0)
+           snext[pos] = sfirst[ch] - pos;
+       else
+           snext[pos] = -pos;
+       sfirst[ch] = pos;
+    }
+
+    str->str_pok |= 4;
+    return 1;
+}
+
+init_eval()
+{
+#define A(e1,e2,e3) (e1+(e2<<1)+(e3<<2))
+    opargs[O_ITEM] =           A(1,0,0);
+    opargs[O_ITEM2] =          A(0,0,0);
+    opargs[O_ITEM3] =          A(0,0,0);
+    opargs[O_CONCAT] =         A(1,1,0);
+    opargs[O_MATCH] =          A(1,0,0);
+    opargs[O_NMATCH] =         A(1,0,0);
+    opargs[O_SUBST] =          A(1,0,0);
+    opargs[O_NSUBST] =         A(1,0,0);
+    opargs[O_ASSIGN] =         A(1,1,0);
+    opargs[O_MULTIPLY] =       A(1,1,0);
+    opargs[O_DIVIDE] =         A(1,1,0);
+    opargs[O_MODULO] =         A(1,1,0);
+    opargs[O_ADD] =            A(1,1,0);
+    opargs[O_SUBTRACT] =       A(1,1,0);
+    opargs[O_LEFT_SHIFT] =     A(1,1,0);
+    opargs[O_RIGHT_SHIFT] =    A(1,1,0);
+    opargs[O_LT] =             A(1,1,0);
+    opargs[O_GT] =             A(1,1,0);
+    opargs[O_LE] =             A(1,1,0);
+    opargs[O_GE] =             A(1,1,0);
+    opargs[O_EQ] =             A(1,1,0);
     opargs[O_NE] =             A(1,1,0);
     opargs[O_BIT_AND] =                A(1,1,0);
     opargs[O_XOR] =            A(1,1,0);
@@ -1165,15 +1752,15 @@ init_eval()
     opargs[O_SEQ] =            A(1,1,0);
     opargs[O_SNE] =            A(1,1,0);
     opargs[O_SUBR] =           A(1,0,0);
-    opargs[O_PRINT] =          A(1,0,0);
+    opargs[O_PRINT] =          A(1,1,0);
     opargs[O_CHDIR] =          A(1,0,0);
     opargs[O_DIE] =            A(1,0,0);
     opargs[O_EXIT] =           A(1,0,0);
     opargs[O_RESET] =          A(1,0,0);
     opargs[O_LIST] =           A(0,0,0);
-    opargs[O_EOF] =            A(0,0,0);
-    opargs[O_TELL] =           A(0,0,0);
-    opargs[O_SEEK] =           A(0,1,1);
+    opargs[O_EOF] =            A(1,0,0);
+    opargs[O_TELL] =           A(1,0,0);
+    opargs[O_SEEK] =           A(1,1,1);
     opargs[O_LAST] =           A(1,0,0);
     opargs[O_NEXT] =           A(1,0,0);
     opargs[O_REDO] =           A(1,0,0);
@@ -1189,7 +1776,7 @@ init_eval()
     opargs[O_LOG] =            A(1,0,0);
     opargs[O_SQRT] =           A(1,0,0);
     opargs[O_INT] =            A(1,0,0);
-    opargs[O_PRTF] =           A(1,0,0);
+    opargs[O_PRTF] =           A(1,1,0);
     opargs[O_ORD] =            A(1,0,0);
     opargs[O_SLEEP] =          A(1,0,0);
     opargs[O_FLIP] =           A(1,0,0);
@@ -1213,956 +1800,35 @@ init_eval()
     opargs[O_LINK] =           A(1,1,0);
     opargs[O_REPEAT] =         A(1,1,0);
     opargs[O_EVAL] =           A(1,0,0);
-}
-
-#ifdef VOIDSIG
-static void (*ihand)();
-static void (*qhand)();
-#else
-static int (*ihand)();
-static int (*qhand)();
-#endif
-
-STR *
-eval(arg,retary)
-register ARG *arg;
-STR ***retary;         /* where to return an array to, null if nowhere */
-{
-    register STR *str;
-    register int anum;
-    register int optype;
-    register int maxarg;
-    double value;
-    STR *quicksarg[5];
-    register STR **sarg = quicksarg;
-    register char *tmps;
-    char *tmps2;
-    int argflags;
-    long tmplong;
-    FILE *fp;
-    STR *tmpstr;
-    FCMD *form;
-    STAB *stab;
-    ARRAY *ary;
-    bool assigning = FALSE;
-    double exp(), log(), sqrt(), modf();
-    char *crypt(), *getenv();
-
-    if (!arg)
-       return &str_no;
-    str = arg->arg_ptr.arg_str;
-    optype = arg->arg_type;
-    maxarg = arg->arg_len;
-    if (maxarg > 3 || retary) {
-       sarg = (STR **)safemalloc((maxarg+2) * sizeof(STR*));
-    }
-#ifdef DEBUGGING
-    if (debug & 8) {
-       deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
-    }
-    debname[dlevel] = opname[optype][0];
-    debdelim[dlevel++] = ':';
-#endif
-    for (anum = 1; anum <= maxarg; anum++) {
-       argflags = arg[anum].arg_flags;
-       if (argflags & AF_SPECIAL)
-           continue;
-      re_eval:
-       switch (arg[anum].arg_type) {
-       default:
-           sarg[anum] = &str_no;
-#ifdef DEBUGGING
-           tmps = "NULL";
-#endif
-           break;
-       case A_EXPR:
-#ifdef DEBUGGING
-           if (debug & 8) {
-               tmps = "EXPR";
-               deb("%d.EXPR =>\n",anum);
-           }
-#endif
-           sarg[anum] = eval(arg[anum].arg_ptr.arg_arg, Null(STR***));
-           break;
-       case A_CMD:
-#ifdef DEBUGGING
-           if (debug & 8) {
-               tmps = "CMD";
-               deb("%d.CMD (%lx) =>\n",anum,arg[anum].arg_ptr.arg_cmd);
-           }
-#endif
-           sarg[anum] = cmd_exec(arg[anum].arg_ptr.arg_cmd);
-           break;
-       case A_STAB:
-           sarg[anum] = STAB_STR(arg[anum].arg_ptr.arg_stab);
-#ifdef DEBUGGING
-           if (debug & 8) {
-               sprintf(buf,"STAB $%s ==",arg[anum].arg_ptr.arg_stab->stab_name);
-               tmps = buf;
-           }
-#endif
-           break;
-       case A_LEXPR:
-#ifdef DEBUGGING
-           if (debug & 8) {
-               tmps = "LEXPR";
-               deb("%d.LEXPR =>\n",anum);
-           }
-#endif
-           str = eval(arg[anum].arg_ptr.arg_arg,Null(STR***));
-           if (!str)
-               fatal("panic: A_LEXPR\n");
-           goto do_crement;
-       case A_LVAL:
-#ifdef DEBUGGING
-           if (debug & 8) {
-               sprintf(buf,"LVAL $%s ==",arg[anum].arg_ptr.arg_stab->stab_name);
-               tmps = buf;
-           }
-#endif
-           str = STAB_STR(arg[anum].arg_ptr.arg_stab);
-           if (!str)
-               fatal("panic: A_LVAL\n");
-         do_crement:
-           assigning = TRUE;
-           if (argflags & AF_PRE) {
-               if (argflags & AF_UP)
-                   str_inc(str);
-               else
-                   str_dec(str);
-               STABSET(str);
-               sarg[anum] = str;
-               str = arg->arg_ptr.arg_str;
-           }
-           else if (argflags & AF_POST) {
-               sarg[anum] = str_static(str);
-               if (argflags & AF_UP)
-                   str_inc(str);
-               else
-                   str_dec(str);
-               STABSET(str);
-               str = arg->arg_ptr.arg_str;
-           }
-           else {
-               sarg[anum] = str;
-           }
-           break;
-       case A_ARYLEN:
-           sarg[anum] = str_static(&str_no);
-           str_numset(sarg[anum],
-               (double)alen(arg[anum].arg_ptr.arg_stab->stab_array));
-#ifdef DEBUGGING
-           tmps = "ARYLEN";
-#endif
-           break;
-       case A_SINGLE:
-           sarg[anum] = arg[anum].arg_ptr.arg_str;
-#ifdef DEBUGGING
-           tmps = "SINGLE";
-#endif
-           break;
-       case A_DOUBLE:
-           (void) interp(str,str_get(arg[anum].arg_ptr.arg_str));
-           sarg[anum] = str;
-#ifdef DEBUGGING
-           tmps = "DOUBLE";
-#endif
-           break;
-       case A_BACKTICK:
-           tmps = str_get(arg[anum].arg_ptr.arg_str);
-           fp = popen(str_get(interp(str,tmps)),"r");
-           tmpstr = str_new(80);
-           str_set(str,"");
-           if (fp) {
-               while (str_gets(tmpstr,fp) != Nullch) {
-                   str_scat(str,tmpstr);
-               }
-               statusvalue = pclose(fp);
-           }
-           else
-               statusvalue = -1;
-           str_free(tmpstr);
-
-           sarg[anum] = str;
-#ifdef DEBUGGING
-           tmps = "BACK";
-#endif
-           break;
-       case A_READ:
-           fp = Nullfp;
-           last_in_stab = arg[anum].arg_ptr.arg_stab;
-           if (last_in_stab->stab_io) {
-               fp = last_in_stab->stab_io->fp;
-               if (!fp && (last_in_stab->stab_io->flags & IOF_ARGV)) {
-                   if (last_in_stab->stab_io->flags & IOF_START) {
-                       last_in_stab->stab_io->flags &= ~IOF_START;
-                       last_in_stab->stab_io->lines = 0;
-                       if (alen(last_in_stab->stab_array) < 0L) {
-                           tmpstr = str_make("-");     /* assume stdin */
-                           apush(last_in_stab->stab_array, tmpstr);
-                       }
-                   }
-                   fp = nextargv(last_in_stab);
-                   if (!fp)    /* Note: fp != last_in_stab->stab_io->fp */
-                       do_close(last_in_stab,FALSE);   /* now it does */
-               }
-           }
-         keepgoing:
-           if (!fp)
-               sarg[anum] = &str_no;
-           else if (!str_gets(str,fp)) {
-               if (last_in_stab->stab_io->flags & IOF_ARGV) {
-                   fp = nextargv(last_in_stab);
-                   if (fp)
-                       goto keepgoing;
-                   do_close(last_in_stab,FALSE);
-                   last_in_stab->stab_io->flags |= IOF_START;
-               }
-               if (fp == stdin) {
-                   clearerr(fp);
-               }
-               sarg[anum] = &str_no;
-               break;
-           }
-           else {
-               last_in_stab->stab_io->lines++;
-               sarg[anum] = str;
-           }
-#ifdef DEBUGGING
-           tmps = "READ";
-#endif
-           break;
-       }
-#ifdef DEBUGGING
-       if (debug & 8)
-           deb("%d.%s = '%s'\n",anum,tmps,str_peek(sarg[anum]));
-#endif
-    }
-    switch (optype) {
-    case O_ITEM:
-       if (str != sarg[1])
-           str_sset(str,sarg[1]);
-       STABSET(str);
-       break;
-    case O_ITEM2:
-       if (str != sarg[2])
-           str_sset(str,sarg[2]);
-       STABSET(str);
-       break;
-    case O_ITEM3:
-       if (str != sarg[3])
-           str_sset(str,sarg[3]);
-       STABSET(str);
-       break;
-    case O_CONCAT:
-       if (str != sarg[1])
-           str_sset(str,sarg[1]);
-       str_scat(str,sarg[2]);
-       STABSET(str);
-       break;
-    case O_REPEAT:
-       if (str != sarg[1])
-           str_sset(str,sarg[1]);
-       anum = (long)str_gnum(sarg[2]);
-       if (anum >= 1) {
-           tmpstr = str_new(0);
-           str_sset(tmpstr,str);
-           for (anum--; anum; anum--)
-               str_scat(str,tmpstr);
-       }
-       else
-           str_sset(str,&str_no);
-       STABSET(str);
-       break;
-    case O_MATCH:
-       str_set(str, do_match(str_get(sarg[1]),arg) ? Yes : No);
-       STABSET(str);
-       break;
-    case O_NMATCH:
-       str_set(str, do_match(str_get(sarg[1]),arg) ? No : Yes);
-       STABSET(str);
-       break;
-    case O_SUBST:
-       value = (double) do_subst(str, arg);
-       str = arg->arg_ptr.arg_str;
-       goto donumset;
-    case O_NSUBST:
-       str_set(arg->arg_ptr.arg_str, do_subst(str, arg) ? No : Yes);
-       str = arg->arg_ptr.arg_str;
-       break;
-    case O_ASSIGN:
-       if (arg[2].arg_flags & AF_SPECIAL)
-           do_assign(str,arg);
-       else {
-           if (str != sarg[2])
-               str_sset(str, sarg[2]);
-           STABSET(str);
-       }
-       break;
-    case O_CHOP:
-       tmps = str_get(str);
-       tmps += str->str_cur - (str->str_cur != 0);
-       str_set(arg->arg_ptr.arg_str,tmps);     /* remember last char */
-       *tmps = '\0';                           /* wipe it out */
-       str->str_cur = tmps - str->str_ptr;
-       str->str_nok = 0;
-       str = arg->arg_ptr.arg_str;
-       break;
-    case O_MULTIPLY:
-       value = str_gnum(sarg[1]);
-       value *= str_gnum(sarg[2]);
-       goto donumset;
-    case O_DIVIDE:
-       value = str_gnum(sarg[1]);
-       value /= str_gnum(sarg[2]);
-       goto donumset;
-    case O_MODULO:
-       value = str_gnum(sarg[1]);
-       value = (double)(((long)value) % (long)str_gnum(sarg[2]));
-       goto donumset;
-    case O_ADD:
-       value = str_gnum(sarg[1]);
-       value += str_gnum(sarg[2]);
-       goto donumset;
-    case O_SUBTRACT:
-       value = str_gnum(sarg[1]);
-       value -= str_gnum(sarg[2]);
-       goto donumset;
-    case O_LEFT_SHIFT:
-       value = str_gnum(sarg[1]);
-       value = (double)(((long)value) << (long)str_gnum(sarg[2]));
-       goto donumset;
-    case O_RIGHT_SHIFT:
-       value = str_gnum(sarg[1]);
-       value = (double)(((long)value) >> (long)str_gnum(sarg[2]));
-       goto donumset;
-    case O_LT:
-       value = str_gnum(sarg[1]);
-       value = (double)(value < str_gnum(sarg[2]));
-       goto donumset;
-    case O_GT:
-       value = str_gnum(sarg[1]);
-       value = (double)(value > str_gnum(sarg[2]));
-       goto donumset;
-    case O_LE:
-       value = str_gnum(sarg[1]);
-       value = (double)(value <= str_gnum(sarg[2]));
-       goto donumset;
-    case O_GE:
-       value = str_gnum(sarg[1]);
-       value = (double)(value >= str_gnum(sarg[2]));
-       goto donumset;
-    case O_EQ:
-       value = str_gnum(sarg[1]);
-       value = (double)(value == str_gnum(sarg[2]));
-       goto donumset;
-    case O_NE:
-       value = str_gnum(sarg[1]);
-       value = (double)(value != str_gnum(sarg[2]));
-       goto donumset;
-    case O_BIT_AND:
-       value = str_gnum(sarg[1]);
-       value = (double)(((long)value) & (long)str_gnum(sarg[2]));
-       goto donumset;
-    case O_XOR:
-       value = str_gnum(sarg[1]);
-       value = (double)(((long)value) ^ (long)str_gnum(sarg[2]));
-       goto donumset;
-    case O_BIT_OR:
-       value = str_gnum(sarg[1]);
-       value = (double)(((long)value) | (long)str_gnum(sarg[2]));
-       goto donumset;
-    case O_AND:
-       if (str_true(sarg[1])) {
-           anum = 2;
-           optype = O_ITEM2;
-           maxarg = 0;
-           argflags = arg[anum].arg_flags;
-           goto re_eval;
-       }
-       else {
-           if (assigning) {
-               str_sset(str, sarg[1]);
-               STABSET(str);
-           }
-           else
-               str = sarg[1];
-           break;
-       }
-    case O_OR:
-       if (str_true(sarg[1])) {
-           if (assigning) {
-               str_set(str, sarg[1]);
-               STABSET(str);
-           }
-           else
-               str = sarg[1];
-           break;
-       }
-       else {
-           anum = 2;
-           optype = O_ITEM2;
-           maxarg = 0;
-           argflags = arg[anum].arg_flags;
-           goto re_eval;
-       }
-    case O_COND_EXPR:
-       anum = (str_true(sarg[1]) ? 2 : 3);
-       optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
-       maxarg = 0;
-       argflags = arg[anum].arg_flags;
-       goto re_eval;
-    case O_COMMA:
-       str = sarg[2];
-       break;
-    case O_NEGATE:
-       value = -str_gnum(sarg[1]);
-       goto donumset;
-    case O_NOT:
-       value = (double) !str_true(sarg[1]);
-       goto donumset;
-    case O_COMPLEMENT:
-       value = (double) ~(long)str_gnum(sarg[1]);
-       goto donumset;
-    case O_SELECT:
-       if (arg[1].arg_type == A_LVAL)
-           defoutstab = arg[1].arg_ptr.arg_stab;
-       else
-           defoutstab = stabent(str_get(sarg[1]),TRUE);
-       if (!defoutstab->stab_io)
-           defoutstab->stab_io = stio_new();
-       curoutstab = defoutstab;
-       str_set(str,curoutstab->stab_io->fp ? Yes : No);
-       STABSET(str);
-       break;
-    case O_WRITE:
-       if (maxarg == 0)
-           stab = defoutstab;
-       else if (arg[1].arg_type == A_LVAL)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(sarg[1]),TRUE);
-       if (!stab->stab_io) {
-           str_set(str, No);
-           STABSET(str);
-           break;
-       }
-       curoutstab = stab;
-       fp = stab->stab_io->fp;
-       debarg = arg;
-       if (stab->stab_io->fmt_stab)
-           form = stab->stab_io->fmt_stab->stab_form;
-       else
-           form = stab->stab_form;
-       if (!form || !fp) {
-           str_set(str, No);
-           STABSET(str);
-           break;
-       }
-       format(&outrec,form);
-       do_write(&outrec,stab->stab_io);
-       if (stab->stab_io->flags & IOF_FLUSH)
-           fflush(fp);
-       str_set(str, Yes);
-       STABSET(str);
-       break;
-    case O_OPEN:
-       if (do_open(arg[1].arg_ptr.arg_stab,str_get(sarg[2]))) {
-           str_set(str, Yes);
-           arg[1].arg_ptr.arg_stab->stab_io->lines = 0;
-       }
-       else
-           str_set(str, No);
-       STABSET(str);
-       break;
-    case O_TRANS:
-       value = (double) do_trans(str,arg);
-       str = arg->arg_ptr.arg_str;
-       goto donumset;
-    case O_NTRANS:
-       str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
-       str = arg->arg_ptr.arg_str;
-       break;
-    case O_CLOSE:
-       str_set(str,
-           do_close(arg[1].arg_ptr.arg_stab,TRUE) ? Yes : No );
-       STABSET(str);
-       break;
-    case O_EACH:
-       str_sset(str,do_each(arg[1].arg_ptr.arg_stab->stab_hash,sarg,retary));
-       retary = Null(STR***);          /* do_each already did retary */
-       STABSET(str);
-       break;
-    case O_VALUES:
-    case O_KEYS:
-       value = (double) do_kv(arg[1].arg_ptr.arg_stab->stab_hash,
-         optype,sarg,retary);
-       retary = Null(STR***);          /* do_keys already did retary */
-       goto donumset;
-    case O_ARRAY:
-       if (maxarg == 1) {
-           ary = arg[1].arg_ptr.arg_stab->stab_array;
-           maxarg = ary->ary_fill;
-           if (retary) { /* array wanted */
-               sarg =
-                 (STR **)saferealloc((char*)sarg,(maxarg+3)*sizeof(STR*));
-               for (anum = 0; anum <= maxarg; anum++) {
-                   sarg[anum+1] = str = afetch(ary,anum);
-               }
-               maxarg++;
-           }
-           else
-               str = afetch(ary,maxarg);
-       }
-       else
-           str = afetch(arg[2].arg_ptr.arg_stab->stab_array,
-               ((int)str_gnum(sarg[1])) - arybase);
-       if (!str)
-           return &str_no;
-       break;
-    case O_HASH:
-       tmpstab = arg[2].arg_ptr.arg_stab;              /* XXX */
-       str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
-       if (!str)
-           return &str_no;
-       break;
-    case O_LARRAY:
-       anum = ((int)str_gnum(sarg[1])) - arybase;
-       str = afetch(arg[2].arg_ptr.arg_stab->stab_array,anum);
-       if (!str || str == &str_no) {
-           str = str_new(0);
-           astore(arg[2].arg_ptr.arg_stab->stab_array,anum,str);
-       }
-       break;
-    case O_LHASH:
-       tmpstab = arg[2].arg_ptr.arg_stab;
-       str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
-       if (!str) {
-           str = str_new(0);
-           hstore(tmpstab->stab_hash,str_get(sarg[1]),str);
-       }
-       if (tmpstab == envstab) {       /* heavy wizardry going on here */
-           str->str_link.str_magic = tmpstab;/* str is now magic */
-           envname = savestr(str_get(sarg[1]));
-                                       /* he threw the brick up into the air */
-       }
-       else if (tmpstab == sigstab) {  /* same thing, only different */
-           str->str_link.str_magic = tmpstab;
-           signame = savestr(str_get(sarg[1]));
-       }
-       break;
-    case O_PUSH:
-       if (arg[1].arg_flags & AF_SPECIAL)
-           str = do_push(arg,arg[2].arg_ptr.arg_stab->stab_array);
-       else {
-           str = str_new(0);           /* must copy the STR */
-           str_sset(str,sarg[1]);
-           apush(arg[2].arg_ptr.arg_stab->stab_array,str);
-       }
-       break;
-    case O_POP:
-       str = apop(arg[1].arg_ptr.arg_stab->stab_array);
-       if (!str)
-           return &str_no;
-#ifdef STRUCTCOPY
-       *(arg->arg_ptr.arg_str) = *str;
-#else
-       bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
-#endif
-       safefree((char*)str);
-       str = arg->arg_ptr.arg_str;
-       break;
-    case O_SHIFT:
-       str = ashift(arg[1].arg_ptr.arg_stab->stab_array);
-       if (!str)
-           return &str_no;
-#ifdef STRUCTCOPY
-       *(arg->arg_ptr.arg_str) = *str;
-#else
-       bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
-#endif
-       safefree((char*)str);
-       str = arg->arg_ptr.arg_str;
-       break;
-    case O_SPLIT:
-       value = (double) do_split(str_get(sarg[1]),arg[2].arg_ptr.arg_spat,retary);
-       retary = Null(STR***);          /* do_split already did retary */
-       goto donumset;
-    case O_LENGTH:
-       value = (double) str_len(sarg[1]);
-       goto donumset;
-    case O_SPRINTF:
-       sarg[maxarg+1] = Nullstr;
-       do_sprintf(str,arg->arg_len,sarg);
-       break;
-    case O_SUBSTR:
-       anum = ((int)str_gnum(sarg[2])) - arybase;
-       for (tmps = str_get(sarg[1]); *tmps && anum > 0; tmps++,anum--) ;
-       anum = (int)str_gnum(sarg[3]);
-       if (anum >= 0 && strlen(tmps) > anum)
-           str_nset(str, tmps, anum);
-       else
-           str_set(str, tmps);
-       break;
-    case O_JOIN:
-       if (arg[2].arg_flags & AF_SPECIAL && arg[2].arg_type == A_EXPR)
-           do_join(arg,str_get(sarg[1]),str);
-       else
-           ajoin(arg[2].arg_ptr.arg_stab->stab_array,str_get(sarg[1]),str);
-       break;
-    case O_SLT:
-       tmps = str_get(sarg[1]);
-       value = (double) strLT(tmps,str_get(sarg[2]));
-       goto donumset;
-    case O_SGT:
-       tmps = str_get(sarg[1]);
-       value = (double) strGT(tmps,str_get(sarg[2]));
-       goto donumset;
-    case O_SLE:
-       tmps = str_get(sarg[1]);
-       value = (double) strLE(tmps,str_get(sarg[2]));
-       goto donumset;
-    case O_SGE:
-       tmps = str_get(sarg[1]);
-       value = (double) strGE(tmps,str_get(sarg[2]));
-       goto donumset;
-    case O_SEQ:
-       tmps = str_get(sarg[1]);
-       value = (double) strEQ(tmps,str_get(sarg[2]));
-       goto donumset;
-    case O_SNE:
-       tmps = str_get(sarg[1]);
-       value = (double) strNE(tmps,str_get(sarg[2]));
-       goto donumset;
-    case O_SUBR:
-       str_sset(str,do_subr(arg,sarg));
-       STABSET(str);
-       break;
-    case O_PRTF:
-    case O_PRINT:
-       if (maxarg <= 1)
-           stab = defoutstab;
-       else {
-           stab = arg[2].arg_ptr.arg_stab;
-           if (!stab)
-               stab = defoutstab;
-       }
-       if (!stab->stab_io)
-           value = 0.0;
-       else if (arg[1].arg_flags & AF_SPECIAL)
-           value = (double)do_aprint(arg,stab->stab_io->fp);
-       else {
-           value = (double)do_print(str_get(sarg[1]),stab->stab_io->fp);
-           if (ors && optype == O_PRINT)
-               do_print(ors, stab->stab_io->fp);
-       }
-       if (stab->stab_io->flags & IOF_FLUSH)
-           fflush(stab->stab_io->fp);
-       goto donumset;
-    case O_CHDIR:
-       tmps = str_get(sarg[1]);
-       if (!tmps || !*tmps)
-           tmps = getenv("HOME");
-       if (!tmps || !*tmps)
-           tmps = getenv("LOGDIR");
-       value = (double)(chdir(tmps) >= 0);
-       goto donumset;
-    case O_DIE:
-       tmps = str_get(sarg[1]);
-       if (!tmps || !*tmps)
-           exit(1);
-       fatal("%s\n",str_get(sarg[1]));
-       value = 0.0;
-       goto donumset;
-    case O_EXIT:
-       exit((int)str_gnum(sarg[1]));
-       value = 0.0;
-       goto donumset;
-    case O_RESET:
-       str_reset(str_get(sarg[1]));
-       value = 1.0;
-       goto donumset;
-    case O_LIST:
-       if (maxarg > 0)
-           str = sarg[maxarg]; /* unwanted list, return last item */
-       else
-           str = &str_no;
-       break;
-    case O_EOF:
-       str_set(str, do_eof(maxarg > 0 ? arg[1].arg_ptr.arg_stab : last_in_stab) ? Yes : No);
-       STABSET(str);
-       break;
-    case O_TELL:
-       value = (double)do_tell(maxarg > 0 ? arg[1].arg_ptr.arg_stab : last_in_stab);
-       goto donumset;
-       break;
-    case O_SEEK:
-       value = str_gnum(sarg[2]);
-       str_set(str, do_seek(arg[1].arg_ptr.arg_stab,
-         (long)value, (int)str_gnum(sarg[3]) ) ? Yes : No);
-       STABSET(str);
-       break;
-    case O_REDO:
-    case O_NEXT:
-    case O_LAST:
-       if (maxarg > 0) {
-           tmps = str_get(sarg[1]);
-           while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
-             strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
-#ifdef DEBUGGING
-               if (debug & 4) {
-                   deb("(Skipping label #%d %s)\n",loop_ptr,
-                       loop_stack[loop_ptr].loop_label);
-               }
-#endif
-               loop_ptr--;
-           }
-#ifdef DEBUGGING
-           if (debug & 4) {
-               deb("(Found label #%d %s)\n",loop_ptr,
-                   loop_stack[loop_ptr].loop_label);
-           }
-#endif
-       }
-       if (loop_ptr < 0)
-           fatal("Bad label: %s\n", maxarg > 0 ? tmps : "<null>");
-       longjmp(loop_stack[loop_ptr].loop_env, optype);
-    case O_GOTO:/* shudder */
-       goto_targ = str_get(sarg[1]);
-       longjmp(top_env, 1);
-    case O_INDEX:
-       tmps = str_get(sarg[1]);
-       if (!(tmps2 = instr(tmps,str_get(sarg[2]))))
-           value = (double)(-1 + arybase);
-       else
-           value = (double)(tmps2 - tmps + arybase);
-       goto donumset;
-    case O_TIME:
-       value = (double) time(0);
-       goto donumset;
-    case O_TMS:
-       value = (double) do_tms(retary);
-       retary = Null(STR***);          /* do_tms already did retary */
-       goto donumset;
-    case O_LOCALTIME:
-       tmplong = (long) str_gnum(sarg[1]);
-       value = (double) do_time(localtime(&tmplong),retary);
-       retary = Null(STR***);          /* do_localtime already did retary */
-       goto donumset;
-    case O_GMTIME:
-       tmplong = (long) str_gnum(sarg[1]);
-       value = (double) do_time(gmtime(&tmplong),retary);
-       retary = Null(STR***);          /* do_gmtime already did retary */
-       goto donumset;
-    case O_STAT:
-       value = (double) do_stat(arg,sarg,retary);
-       retary = Null(STR***);          /* do_stat already did retary */
-       goto donumset;
-    case O_CRYPT:
-#ifdef CRYPT
-       tmps = str_get(sarg[1]);
-       str_set(str,crypt(tmps,str_get(sarg[2])));
-#else
-       fatal(
-         "The crypt() function is unimplemented due to excessive paranoia.");
-#endif
-       break;
-    case O_EXP:
-       value = exp(str_gnum(sarg[1]));
-       goto donumset;
-    case O_LOG:
-       value = log(str_gnum(sarg[1]));
-       goto donumset;
-    case O_SQRT:
-       value = sqrt(str_gnum(sarg[1]));
-       goto donumset;
-    case O_INT:
-       modf(str_gnum(sarg[1]),&value);
-       goto donumset;
-    case O_ORD:
-       value = (double) *str_get(sarg[1]);
-       goto donumset;
-    case O_SLEEP:
-       tmps = str_get(sarg[1]);
-       time(&tmplong);
-       if (!tmps || !*tmps)
-           sleep((32767<<16)+32767);
-       else
-           sleep(atoi(tmps));
-       value = (double)tmplong;
-       time(&tmplong);
-       value = ((double)tmplong) - value;
-       goto donumset;
-    case O_FLIP:
-       if (str_true(sarg[1])) {
-           str_numset(str,0.0);
-           anum = 2;
-           arg->arg_type = optype = O_FLOP;
-           maxarg = 0;
-           arg[2].arg_flags &= ~AF_SPECIAL;
-           arg[1].arg_flags |= AF_SPECIAL;
-           argflags = arg[anum].arg_flags;
-           goto re_eval;
-       }
-       str_set(str,"");
-       break;
-    case O_FLOP:
-       str_inc(str);
-       if (str_true(sarg[2])) {
-           arg->arg_type = O_FLIP;
-           arg[1].arg_flags &= ~AF_SPECIAL;
-           arg[2].arg_flags |= AF_SPECIAL;
-           str_cat(str,"E0");
-       }
-       break;
-    case O_FORK:
-       value = (double)fork();
-       goto donumset;
-    case O_SYSTEM:
-       if (anum = vfork()) {
-           ihand = signal(SIGINT, SIG_IGN);
-           qhand = signal(SIGQUIT, SIG_IGN);
-           while ((maxarg = wait(&argflags)) != anum && maxarg != -1)
-               ;
-           if (maxarg == -1)
-               argflags = -1;
-           signal(SIGINT, ihand);
-           signal(SIGQUIT, qhand);
-           value = (double)argflags;
-           goto donumset;
-       }
-       /* FALL THROUGH */
-    case O_EXEC:
-       if (arg[1].arg_flags & AF_SPECIAL)
-           value = (double)do_aexec(arg);
-       else {
-           value = (double)do_exec(str_get(sarg[1]));
-       }
-       goto donumset;
-    case O_HEX:
-       maxarg = 4;
-       goto snarfnum;
-
-    case O_OCT:
-       maxarg = 3;
-
-      snarfnum:
-       anum = 0;
-       tmps = str_get(sarg[1]);
-       for (;;) {
-           switch (*tmps) {
-           default:
-               goto out;
-           case '8': case '9':
-               if (maxarg != 4)
-                   goto out;
-               /* FALL THROUGH */
-           case '0': case '1': case '2': case '3': case '4':
-           case '5': case '6': case '7':
-               anum <<= maxarg;
-               anum += *tmps++ & 15;
-               break;
-           case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
-           case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
-               if (maxarg != 4)
-                   goto out;
-               anum <<= 4;
-               anum += (*tmps++ & 7) + 9;
-               break;
-           case 'x':
-               maxarg = 4;
-               tmps++;
-               break;
-           }
-       }
-      out:
-       value = (double)anum;
-       goto donumset;
-    case O_CHMOD:
-    case O_CHOWN:
-    case O_KILL:
-    case O_UNLINK:
-       if (arg[1].arg_flags & AF_SPECIAL)
-           value = (double)apply(optype,arg,Null(STR**));
-       else {
-           sarg[2] = Nullstr;
-           value = (double)apply(optype,arg,sarg);
-       }
-       goto donumset;
-    case O_UMASK:
-       value = (double)umask((int)str_gnum(sarg[1]));
-       goto donumset;
-    case O_RENAME:
-       tmps = str_get(sarg[1]);
-#ifdef RENAME
-       value = (double)(rename(tmps,str_get(sarg[2])) >= 0);
-#else
-       tmps2 = str_get(sarg[2]);
-       UNLINK(tmps2);
-       if (!(anum = link(tmps,tmps2)))
-           anum = UNLINK(tmps);
-       value = (double)(anum >= 0);
-#endif
-       goto donumset;
-    case O_LINK:
-       tmps = str_get(sarg[1]);
-       value = (double)(link(tmps,str_get(sarg[2])) >= 0);
-       goto donumset;
-    case O_UNSHIFT:
-       ary = arg[2].arg_ptr.arg_stab->stab_array;
-       if (arg[1].arg_flags & AF_SPECIAL)
-           do_unshift(arg,ary);
-       else {
-           str = str_new(0);           /* must copy the STR */
-           str_sset(str,sarg[1]);
-           aunshift(ary,1);
-           astore(ary,0,str);
-       }
-       value = (double)(ary->ary_fill + 1);
-       break;
-    case O_EVAL:
-       str_sset(str,
-           do_eval(arg[1].arg_type != A_NULL ? sarg[1] : defstab->stab_val) );
-       STABSET(str);
-       break;
-    }
-#ifdef DEBUGGING
-    dlevel--;
-    if (debug & 8)
-       deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
-#endif
-    goto freeargs;
-
-donumset:
-    str_numset(str,value);
-    STABSET(str);
-#ifdef DEBUGGING
-    dlevel--;
-    if (debug & 8)
-       deb("%s RETURNS \"%f\"\n",opname[optype],value);
-#endif
-
-freeargs:
-    if (sarg != quicksarg) {
-       if (retary) {
-           if (optype == O_LIST)
-               sarg[0] = &str_no;
-           else
-               sarg[0] = Nullstr;
-           sarg[maxarg+1] = Nullstr;
-           *retary = sarg;     /* up to them to free it */
-       }
-       else
-           safefree(sarg);
-    }
-    return str;
-
-nullarray:
-    maxarg = 0;
-#ifdef DEBUGGING
-    dlevel--;
-    if (debug & 8)
-       deb("%s RETURNS ()\n",opname[optype],value);
-#endif
-    goto freeargs;
+    opargs[O_FTEREAD] =                A(1,0,0);
+    opargs[O_FTEWRITE] =       A(1,0,0);
+    opargs[O_FTEEXEC] =                A(1,0,0);
+    opargs[O_FTEOWNED] =       A(1,0,0);
+    opargs[O_FTRREAD] =                A(1,0,0);
+    opargs[O_FTRWRITE] =       A(1,0,0);
+    opargs[O_FTREXEC] =                A(1,0,0);
+    opargs[O_FTROWNED] =       A(1,0,0);
+    opargs[O_FTIS] =           A(1,0,0);
+    opargs[O_FTZERO] =         A(1,0,0);
+    opargs[O_FTSIZE] =         A(1,0,0);
+    opargs[O_FTFILE] =         A(1,0,0);
+    opargs[O_FTDIR] =          A(1,0,0);
+    opargs[O_FTLINK] =         A(1,0,0);
+    opargs[O_SYMLINK] =                A(1,1,0);
+    opargs[O_FTPIPE] =         A(1,0,0);
+    opargs[O_FTSUID] =         A(1,0,0);
+    opargs[O_FTSGID] =         A(1,0,0);
+    opargs[O_FTSVTX] =         A(1,0,0);
+    opargs[O_FTCHR] =          A(1,0,0);
+    opargs[O_FTBLK] =          A(1,0,0);
+    opargs[O_FTSOCK] =         A(1,0,0);
+    opargs[O_FTTTY] =          A(1,0,0);
+    opargs[O_DOFILE] =         A(1,0,0);
+    opargs[O_FTTEXT] =         A(1,0,0);
+    opargs[O_FTBINARY] =       A(1,0,0);
+    opargs[O_UTIME] =          A(1,0,0);
+    opargs[O_WAIT] =           A(0,0,0);
+    opargs[O_SORT] =           A(1,0,0);
+    opargs[O_STUDY] =          A(1,0,0);
+    opargs[O_DELETE] =         A(1,0,0);
 }
diff --git a/arg.h b/arg.h
index d442b02..efb3e36 100644 (file)
--- a/arg.h
+++ b/arg.h
@@ -1,11 +1,8 @@
-/* $Header: arg.h,v 1.0.1.1 88/01/28 10:22:40 root Exp $
+/* $Header: arg.h,v 2.0 88/06/05 00:08:14 root Exp $
  *
  * $Log:       arg.h,v $
- * Revision 1.0.1.1  88/01/28  10:22:40  root
- * patch8: added eval operator.
- * 
- * Revision 1.0  87/12/18  13:04:39  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:08:14  root
+ * Baseline version 2.0.
  * 
  */
 
 #define O_LINK 103
 #define O_REPEAT 104
 #define O_EVAL 105
-#define MAXO 106
+#define O_FTEREAD 106
+#define O_FTEWRITE 107
+#define O_FTEEXEC 108
+#define O_FTEOWNED 109
+#define O_FTRREAD 110
+#define O_FTRWRITE 111
+#define O_FTREXEC 112
+#define O_FTROWNED 113
+#define O_FTIS 114
+#define O_FTZERO 115
+#define O_FTSIZE 116
+#define O_FTFILE 117
+#define O_FTDIR 118
+#define O_FTLINK 119
+#define O_SYMLINK 120
+#define O_FTPIPE 121
+#define O_FTSOCK 122
+#define O_FTBLK 123
+#define O_FTCHR 124
+#define O_FTSUID 125
+#define O_FTSGID 126
+#define O_FTSVTX 127
+#define O_FTTTY 128
+#define O_DOFILE 129
+#define O_FTTEXT 130
+#define O_FTBINARY 131
+#define O_UTIME 132
+#define O_WAIT 133
+#define O_SORT 134
+#define O_DELETE 135
+#define O_STUDY 136
+#define MAXO 137
 
 #ifndef DOINIT
 extern char *opname[];
@@ -227,7 +255,38 @@ char *opname[] = {
     "LINK",
     "REPEAT",
     "EVAL",
-    "106"
+    "FTEREAD",
+    "FTEWRITE",
+    "FTEEXEC",
+    "FTEOWNED",
+    "FTRREAD",
+    "FTRWRITE",
+    "FTREXEC",
+    "FTROWNED",
+    "FTIS",
+    "FTZERO",
+    "FTSIZE",
+    "FTFILE",
+    "FTDIR",
+    "FTLINK",
+    "SYMLINK",
+    "FTPIPE",
+    "FTSOCK",
+    "FTBLK",
+    "FTCHR",
+    "FTSUID",
+    "FTSGID",
+    "FTSVTX",
+    "FTTTY",
+    "DOFILE",
+    "FTTEXT",
+    "FTBINARY",
+    "UTIME",
+    "WAIT",
+    "SORT",
+    "DELETE",
+    "STUDY",
+    "135"
 };
 #endif
 
@@ -244,6 +303,10 @@ char *opname[] = {
 #define A_LEXPR 10
 #define A_ARYLEN 11
 #define A_NUMBER 12
+#define A_LARYLEN 13
+#define A_GLOB 14
+#define A_WORD 15
+#define A_INDREAD 16
 
 #ifndef DOINIT
 extern char *argname[];
@@ -262,29 +325,35 @@ char *argname[] = {
     "LEXPR",
     "ARYLEN",
     "NUMBER",
-    "13"
+    "LARYLEN",
+    "GLOB",
+    "WORD",
+    "INDREAD",
+    "17"
 };
 #endif
 
 #ifndef DOINIT
 extern bool hoistable[];
 #else
-bool hoistable[] = {0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0};
+bool hoistable[] = {0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0};
 #endif
 
+union argptr {
+    ARG                *arg_arg;
+    char       *arg_cval;
+    STAB       *arg_stab;
+    SPAT       *arg_spat;
+    CMD                *arg_cmd;
+    STR                *arg_str;
+    double     arg_nval;
+};
+
 struct arg {
-    union argptr {
-       ARG     *arg_arg;
-       char    *arg_cval;
-       STAB    *arg_stab;
-       SPAT    *arg_spat;
-       CMD     *arg_cmd;
-       STR     *arg_str;
-       double  arg_nval;
-    } arg_ptr;
+    union argptr arg_ptr;
     short      arg_len;
-    char       arg_type;
-    char       arg_flags;
+    unsigned char arg_type;
+    unsigned char arg_flags;
 };
 
 #define AF_SPECIAL 1           /* op wants to evaluate this arg itself */
@@ -294,6 +363,7 @@ struct arg {
 #define AF_COMMON 16           /* left and right have symbols in common */
 #define AF_NUMERIC 32          /* return as numeric rather than string */
 #define AF_LISTISH 64          /* turn into list if important */
+#define AF_LOCAL 128           /* list of local variables */
 
 /*
  * Most of the ARG pointers are used as pointers to arrays of ARG.  When
@@ -317,3 +387,6 @@ bool do_seek();
 int do_tms();
 int do_time();
 int do_stat();
+STR *do_push();
+FILE *nextargv();
+STR *do_fttext();
diff --git a/array.c b/array.c
index 156b783..f1446a7 100644 (file)
--- a/array.c
+++ b/array.c
@@ -1,16 +1,12 @@
-/* $Header: array.c,v 1.0 87/12/18 13:04:42 root Exp $
+/* $Header: array.c,v 2.0 88/06/05 00:08:17 root Exp $
  *
  * $Log:       array.c,v $
- * Revision 1.0  87/12/18  13:04:42  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:08:17  root
+ * Baseline version 2.0.
  * 
  */
 
-#include <stdio.h>
 #include "EXTERN.h"
-#include "handy.h"
-#include "util.h"
-#include "search.h"
 #include "perl.h"
 
 STR *
@@ -18,7 +14,7 @@ afetch(ar,key)
 register ARRAY *ar;
 int key;
 {
-    if (key < 0 || key > ar->ary_max)
+    if (key < 0 || key > ar->ary_fill)
        return Nullstr;
     return ar->ary_array[key];
 }
@@ -42,8 +38,12 @@ STR *val;
            (newmax - ar->ary_max) * sizeof(STR*));
        ar->ary_max = newmax;
     }
-    if (key > ar->ary_fill)
-       ar->ary_fill = key;
+    while (ar->ary_fill < key) {
+       if (++ar->ary_fill < key && ar->ary_array[ar->ary_fill] != Nullstr) {
+           str_free(ar->ary_array[ar->ary_fill]);
+           ar->ary_array[ar->ary_fill] = Nullstr;
+       }
+    }
     retval = (ar->ary_array[key] != Nullstr);
     if (retval)
        str_free(ar->ary_array[key]);
@@ -67,18 +67,36 @@ int key;
 }
 
 ARRAY *
-anew()
+anew(stab)
+STAB *stab;
 {
     register ARRAY *ar = (ARRAY*)safemalloc(sizeof(ARRAY));
 
     ar->ary_array = (STR**) safemalloc(5 * sizeof(STR*));
+    ar->ary_magic = str_new(0);
+    ar->ary_magic->str_link.str_magic = stab;
     ar->ary_fill = -1;
+    ar->ary_index = -1;
     ar->ary_max = 4;
     bzero((char*)ar->ary_array, 5 * sizeof(STR*));
     return ar;
 }
 
 void
+aclear(ar)
+register ARRAY *ar;
+{
+    register int key;
+
+    if (!ar)
+       return;
+    for (key = 0; key <= ar->ary_max; key++)
+       str_free(ar->ary_array[key]);
+    ar->ary_fill = -1;
+    bzero((char*)ar->ary_array, (ar->ary_max+1) * sizeof(STR*));
+}
+
+void
 afree(ar)
 register ARRAY *ar;
 {
@@ -86,8 +104,9 @@ register ARRAY *ar;
 
     if (!ar)
        return;
-    for (key = 0; key <= ar->ary_fill; key++)
+    for (key = 0; key <= ar->ary_max; key++)
        str_free(ar->ary_array[key]);
+    str_free(ar->ary_magic);
     safefree((char*)ar->ary_array);
     safefree((char*)ar);
 }
@@ -123,8 +142,8 @@ register int num;
     if (num <= 0)
        return;
     astore(ar,ar->ary_fill+num,(STR*)0);       /* maybe extend array */
-    sstr = ar->ary_array + ar->ary_fill;
-    dstr = sstr + num;
+    dstr = ar->ary_array + ar->ary_fill;
+    sstr = dstr - num;
     for (i = ar->ary_fill; i >= 0; i--) {
        *dstr-- = *sstr--;
     }
@@ -146,11 +165,23 @@ register ARRAY *ar;
     return retval;
 }
 
-long
+int
 alen(ar)
 register ARRAY *ar;
 {
-    return (long)ar->ary_fill;
+    return ar->ary_fill;
+}
+
+afill(ar, fill)
+register ARRAY *ar;
+int fill;
+{
+    if (fill < 0)
+       fill = -1;
+    if (fill <= ar->ary_max)
+       ar->ary_fill = fill;
+    else
+       astore(ar,fill,Nullstr);
 }
 
 void
diff --git a/array.h b/array.h
index 4ad9487..d8dfe54 100644 (file)
--- a/array.h
+++ b/array.h
@@ -1,15 +1,17 @@
-/* $Header: array.h,v 1.0 87/12/18 13:04:46 root Exp $
+/* $Header: array.h,v 2.0 88/06/05 00:08:21 root Exp $
  *
  * $Log:       array.h,v $
- * Revision 1.0  87/12/18  13:04:46  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:08:21  root
+ * Baseline version 2.0.
  * 
  */
 
 struct atbl {
     STR        **ary_array;
-    int        ary_max;
-    int        ary_fill;
+    STR *ary_magic;
+    int ary_max;
+    int ary_fill;
+    int ary_index;
 };
 
 STR *afetch();
@@ -17,6 +19,8 @@ bool astore();
 bool adelete();
 STR *apop();
 STR *ashift();
+void afree();
+void aclear();
 bool apush();
-long alen();
+int alen();
 ARRAY *anew();
diff --git a/cmd.c b/cmd.c
index c2be1a2..f5649b6 100644 (file)
--- a/cmd.c
+++ b/cmd.c
@@ -1,18 +1,12 @@
-/* $Header: cmd.c,v 1.0.1.1 88/01/21 21:24:16 root Exp $
+/* $Header: cmd.c,v 2.0 88/06/05 00:08:24 root Exp $
  *
  * $Log:       cmd.c,v $
- * Revision 1.0.1.1  88/01/21  21:24:16  root
- * The redo cmd got a segmentation fault because trace context stack overflowed.
- * 
- * Revision 1.0  87/12/18  13:04:51  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:08:24  root
+ * Baseline version 2.0.
  * 
  */
 
-#include "handy.h"
 #include "EXTERN.h"
-#include "search.h"
-#include "util.h"
 #include "perl.h"
 
 static STR str_chop;
@@ -24,9 +18,14 @@ static STR str_chop;
 
 STR *
 cmd_exec(cmd)
+#ifdef cray    /* nobody else has complained yet */
+CMD *cmd;
+#else
 register CMD *cmd;
+#endif
 {
     SPAT *oldspat;
+    int oldsave;
 #ifdef DEBUGGING
     int olddlevel;
     int entdlevel;
@@ -34,10 +33,10 @@ register CMD *cmd;
     register STR *retstr;
     register char *tmps;
     register int cmdflags;
-    register bool match;
+    register int match;
     register char *go_to = goto_targ;
-    ARG *arg;
     FILE *fp;
+    ARRAY *ar;
 
     retstr = &str_no;
 #ifdef DEBUGGING
@@ -57,14 +56,17 @@ tail_recursion_entry:
            switch (cmd->c_type) {
            case C_IF:
                oldspat = curspat;
+               oldsave = savestack->ary_fill;
 #ifdef DEBUGGING
                olddlevel = dlevel;
 #endif
                retstr = &str_yes;
                if (cmd->ucmd.ccmd.cc_true) {
 #ifdef DEBUGGING
-                   debname[dlevel] = 't';
-                   debdelim[dlevel++] = '_';
+                   if (debug) {
+                       debname[dlevel] = 't';
+                       debdelim[dlevel++] = '_';
+                   }
 #endif
                    retstr = cmd_exec(cmd->ucmd.ccmd.cc_true);
                }
@@ -74,8 +76,10 @@ tail_recursion_entry:
                    retstr = &str_no;
                    if (cmd->ucmd.ccmd.cc_alt) {
 #ifdef DEBUGGING
-                       debname[dlevel] = 'e';
-                       debdelim[dlevel++] = '_';
+                       if (debug) {
+                           debname[dlevel] = 'e';
+                           debdelim[dlevel++] = '_';
+                       }
 #endif
                        retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt);
                    }
@@ -83,6 +87,8 @@ tail_recursion_entry:
                if (!goto_targ)
                    go_to = Nullch;
                curspat = oldspat;
+               if (savestack->ary_fill > oldsave)
+                   restorelist(oldsave);
 #ifdef DEBUGGING
                dlevel = olddlevel;
 #endif
@@ -108,15 +114,9 @@ tail_recursion_entry:
                    olddlevel = dlevel;
 #endif
                    curspat = oldspat;
-#ifdef DEBUGGING
-                   if (debug & 4) {
-                       deb("(Popping label #%d %s)\n",loop_ptr,
-                           loop_stack[loop_ptr].loop_label);
-                   }
-#endif
-                   loop_ptr--;
-                   cmd = cmd->c_next;
-                   goto tail_recursion_entry;
+                   if (savestack->ary_fill > oldsave)
+                       restorelist(oldsave);
+                   goto next_cmd;
                case O_NEXT:    /* not done unless go_to found */
                    go_to = Nullch;
                    goto next_iter;
@@ -125,13 +125,16 @@ tail_recursion_entry:
                    goto doit;
                }
                oldspat = curspat;
+               oldsave = savestack->ary_fill;
 #ifdef DEBUGGING
                olddlevel = dlevel;
 #endif
                if (cmd->ucmd.ccmd.cc_true) {
 #ifdef DEBUGGING
-                   debname[dlevel] = 't';
-                   debdelim[dlevel++] = '_';
+                   if (debug) {
+                       debname[dlevel] = 't';
+                       debdelim[dlevel++] = '_';
+                   }
 #endif
                    cmd_exec(cmd->ucmd.ccmd.cc_true);
                }
@@ -144,8 +147,10 @@ tail_recursion_entry:
 #endif
                if (cmd->ucmd.ccmd.cc_alt) {
 #ifdef DEBUGGING
-                   debname[dlevel] = 'a';
-                   debdelim[dlevel++] = '_';
+                   if (debug) {
+                       debname[dlevel] = 'a';
+                       debdelim[dlevel++] = '_';
+                   }
 #endif
                    cmd_exec(cmd->ucmd.ccmd.cc_alt);
                }
@@ -155,24 +160,41 @@ tail_recursion_entry:
                goto finish_while;
            }
            cmd = cmd->c_next;
-           if (cmd && cmd->c_head == cmd)      /* reached end of while loop */
+           if (cmd && cmd->c_head == cmd)
+                                       /* reached end of while loop */
                return retstr;          /* targ isn't in this block */
+           if (cmdflags & CF_ONCE) {
+#ifdef DEBUGGING
+               if (debug & 4) {
+                   deb("(Popping label #%d %s)\n",loop_ptr,
+                       loop_stack[loop_ptr].loop_label);
+               }
+#endif
+               loop_ptr--;
+           }
            goto tail_recursion_entry;
        }
     }
 
 until_loop:
 
+    /* Set line number so run-time errors can be located */
+
+    line = cmd->c_line;
+
 #ifdef DEBUGGING
-    if (debug & 2) {
-       deb("%s (%lx)   r%lx    t%lx    a%lx    n%lx    cs%lx\n",
-           cmdname[cmd->c_type],cmd,cmd->c_expr,
-           cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt,cmd->c_next,curspat);
+    if (debug) {
+       if (debug & 2) {
+           deb("%s     (%lx)   r%lx    t%lx    a%lx    n%lx    cs%lx\n",
+               cmdname[cmd->c_type],cmd,cmd->c_expr,
+               cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt,cmd->c_next,
+               curspat);
+       }
+       debname[dlevel] = cmdname[cmd->c_type][0];
+       debdelim[dlevel++] = '!';
     }
-    debname[dlevel] = cmdname[cmd->c_type][0];
-    debdelim[dlevel++] = '!';
 #endif
-    while (tmps_max >= 0)              /* clean up after last eval */
+    while (tmps_max > tmps_base)               /* clean up after last eval */
        str_free(tmps_list[tmps_max--]);
 
     /* Here is some common optimization */
@@ -181,13 +203,13 @@ until_loop:
        switch (cmdflags & CF_OPTIMIZE) {
 
        case CFT_FALSE:
-           retstr = cmd->c_first;
+           retstr = cmd->c_short;
            match = FALSE;
            if (cmdflags & CF_NESURE)
                goto maybe;
            break;
        case CFT_TRUE:
-           retstr = cmd->c_first;
+           retstr = cmd->c_short;
            match = TRUE;
            if (cmdflags & CF_EQSURE)
                goto flipmaybe;
@@ -202,7 +224,7 @@ until_loop:
 
        case CFT_ANCHOR:        /* /^pat/ optimization */
            if (multiline) {
-               if (*cmd->c_first->str_ptr && !(cmdflags & CF_EQSURE))
+               if (*cmd->c_short->str_ptr && !(cmdflags & CF_EQSURE))
                    goto scanner;       /* just unanchor it */
                else
                    break;              /* must evaluate */
@@ -210,9 +232,9 @@ until_loop:
            /* FALL THROUGH */
        case CFT_STROP:         /* string op optimization */
            retstr = STAB_STR(cmd->c_stab);
-           if (*cmd->c_first->str_ptr == *str_get(retstr) &&
-                   strnEQ(cmd->c_first->str_ptr, str_get(retstr),
-                     cmd->c_flen) ) {
+           if (*cmd->c_short->str_ptr == *str_get(retstr) &&
+                   strnEQ(cmd->c_short->str_ptr, str_get(retstr),
+                     cmd->c_slen) ) {
                if (cmdflags & CF_EQSURE) {
                    match = !(cmdflags & CF_FIRSTNEG);
                    retstr = &str_yes;
@@ -229,27 +251,92 @@ until_loop:
        case CFT_SCAN:                  /* non-anchored search */
          scanner:
            retstr = STAB_STR(cmd->c_stab);
-           if (instr(str_get(retstr),cmd->c_first->str_ptr)) {
+           if (retstr->str_pok == 5)
+               if (screamfirst[cmd->c_short->str_rare] >= 0)
+                   tmps = screaminstr(retstr, cmd->c_short);
+               else
+                   tmps = Nullch;
+           else {
+               tmps = str_get(retstr);         /* make sure it's pok */
+               tmps = fbminstr(tmps, tmps + retstr->str_cur, cmd->c_short);
+           }
+           if (tmps) {
                if (cmdflags & CF_EQSURE) {
+                   ++*(long*)&cmd->c_short->str_nval;
                    match = !(cmdflags & CF_FIRSTNEG);
                    retstr = &str_yes;
                    goto flipmaybe;
                }
+               else
+                   hint = tmps;
+           }
+           else {
+               if (cmdflags & CF_NESURE) {
+                   ++*(long*)&cmd->c_short->str_nval;
+                   match = cmdflags & CF_FIRSTNEG;
+                   retstr = &str_no;
+                   goto flipmaybe;
+               }
+           }
+           if (--*(long*)&cmd->c_short->str_nval < 0) {
+               str_free(cmd->c_short);
+               cmd->c_short = Nullstr;
+               cmdflags &= ~CF_OPTIMIZE;
+               cmdflags |= CFT_EVAL;   /* never try this optimization again */
+               cmd->c_flags = cmdflags;
+           }
+           break;                      /* must evaluate */
+
+       case CFT_NUMOP:         /* numeric op optimization */
+           retstr = STAB_STR(cmd->c_stab);
+           switch (cmd->c_slen) {
+           case O_EQ:
+               match = (str_gnum(retstr) == cmd->c_short->str_nval);
+               break;
+           case O_NE:
+               match = (str_gnum(retstr) != cmd->c_short->str_nval);
+               break;
+           case O_LT:
+               match = (str_gnum(retstr) <  cmd->c_short->str_nval);
+               break;
+           case O_LE:
+               match = (str_gnum(retstr) <= cmd->c_short->str_nval);
+               break;
+           case O_GT:
+               match = (str_gnum(retstr) >  cmd->c_short->str_nval);
+               break;
+           case O_GE:
+               match = (str_gnum(retstr) >= cmd->c_short->str_nval);
+               break;
+           }
+           if (match) {
+               if (cmdflags & CF_EQSURE) {
+                   retstr = &str_yes;
+                   goto flipmaybe;
+               }
            }
            else if (cmdflags & CF_NESURE) {
-               match = cmdflags & CF_FIRSTNEG;
                retstr = &str_no;
                goto flipmaybe;
            }
            break;                      /* must evaluate */
 
+       case CFT_INDGETS:               /* while (<$foo>) */
+           last_in_stab = stabent(str_get(STAB_STR(cmd->c_stab)),TRUE);
+           if (!last_in_stab->stab_io)
+               last_in_stab->stab_io = stio_new();
+           goto dogets;
        case CFT_GETS:                  /* really a while (<file>) */
            last_in_stab = cmd->c_stab;
+         dogets:
            fp = last_in_stab->stab_io->fp;
            retstr = defstab->stab_val;
            if (fp && str_gets(retstr, fp)) {
+               if (*retstr->str_ptr == '0' && !retstr->str_ptr[1])
+                   match = FALSE;
+               else
+                   match = TRUE;
                last_in_stab->stab_io->lines++;
-               match = TRUE;
            }
            else if (last_in_stab->stab_io->flags & IOF_ARGV)
                goto doeval;    /* doesn't necessarily count as EOF yet */
@@ -261,7 +348,7 @@ until_loop:
        case CFT_EVAL:
            break;
        case CFT_UNFLIP:
-           retstr = eval(cmd->c_expr,Null(char***));
+           retstr = eval(cmd->c_expr,Null(STR***),-1);
            match = str_true(retstr);
            if (cmd->c_expr->arg_type == O_FLIP)        /* undid itself? */
                cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
@@ -277,12 +364,32 @@ until_loop:
            retstr->str_cur = tmps - retstr->str_ptr;
            retstr = &str_chop;
            goto flipmaybe;
+       case CFT_ARRAY:
+           ar = cmd->c_expr[1].arg_ptr.arg_stab->stab_array;
+           match = ar->ary_index;      /* just to get register */
+
+           if (match < 0)              /* first time through here? */
+               cmd->c_short = cmd->c_stab->stab_val;
+
+           if (match >= ar->ary_fill) {
+               ar->ary_index = -1;
+/*             cmd->c_stab->stab_val = cmd->c_short; - Can't be done in LAST */
+               match = FALSE;
+           }
+           else {
+               match++;
+               retstr = cmd->c_stab->stab_val = ar->ary_array[match];
+               ar->ary_index = match;
+               match = TRUE;
+           }
+           goto maybe;
        }
 
     /* we have tried to make this normal case as abnormal as possible */
 
     doeval:
-       retstr = eval(cmd->c_expr,Null(char***));
+       lastretstr = retstr;
+       retstr = eval(cmd->c_expr,Null(STR***),-1);
        match = str_true(retstr);
        goto maybe;
 
@@ -291,11 +398,11 @@ until_loop:
     flipmaybe:
        if (match && cmdflags & CF_FLIP) {
            if (cmd->c_expr->arg_type == O_FLOP) {      /* currently toggled? */
-               retstr = eval(cmd->c_expr,Null(char***)); /* let eval undo it */
+               retstr = eval(cmd->c_expr,Null(STR***),-1);/*let eval undo it*/
                cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
            }
            else {
-               retstr = eval(cmd->c_expr,Null(char***)); /* let eval do it */
+               retstr = eval(cmd->c_expr,Null(STR***),-1);/* let eval do it */
                if (cmd->c_expr->arg_type == O_FLOP)    /* still toggled? */
                    cmdflags = copyopt(cmd,cmd->c_expr[4].arg_ptr.arg_cmd);
            }
@@ -311,24 +418,24 @@ until_loop:
     maybe:
        if (cmdflags & CF_INVERT)
            match = !match;
-       if (!match && cmd->c_type != C_IF) {
-           cmd = cmd->c_next;
-           goto tail_recursion_entry;
-       }
+       if (!match && cmd->c_type != C_IF)
+           goto next_cmd;
     }
 
     /* now to do the actual command, if any */
 
     switch (cmd->c_type) {
     case C_NULL:
-       fatal("panic: cmd_exec\n");
+       fatal("panic: cmd_exec");
     case C_EXPR:                       /* evaluated for side effects */
        if (cmd->ucmd.acmd.ac_expr) {   /* more to do? */
-           retstr = eval(cmd->ucmd.acmd.ac_expr,Null(char***));
+           lastretstr = retstr;
+           retstr = eval(cmd->ucmd.acmd.ac_expr,Null(STR***),-1);
        }
        break;
     case C_IF:
        oldspat = curspat;
+       oldsave = savestack->ary_fill;
 #ifdef DEBUGGING
        olddlevel = dlevel;
 #endif
@@ -336,8 +443,10 @@ until_loop:
            retstr = &str_yes;
            if (cmd->ucmd.ccmd.cc_true) {
 #ifdef DEBUGGING
-               debname[dlevel] = 't';
-               debdelim[dlevel++] = '_';
+               if (debug) {
+                   debname[dlevel] = 't';
+                   debdelim[dlevel++] = '_';
+               }
 #endif
                retstr = cmd_exec(cmd->ucmd.ccmd.cc_true);
            }
@@ -346,13 +455,17 @@ until_loop:
            retstr = &str_no;
            if (cmd->ucmd.ccmd.cc_alt) {
 #ifdef DEBUGGING
-               debname[dlevel] = 'e';
-               debdelim[dlevel++] = '_';
+               if (debug) {
+                   debname[dlevel] = 'e';
+                   debdelim[dlevel++] = '_';
+               }
 #endif
                retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt);
            }
        }
        curspat = oldspat;
+       if (savestack->ary_fill > oldsave)
+           restorelist(oldsave);
 #ifdef DEBUGGING
        dlevel = olddlevel;
 #endif
@@ -372,17 +485,11 @@ until_loop:
        }
        switch (setjmp(loop_stack[loop_ptr].loop_env)) {
        case O_LAST:
-           retstr = &str_no;
+           retstr = lastretstr;
            curspat = oldspat;
-#ifdef DEBUGGING
-           if (debug & 4) {
-               deb("(Popping label #%d %s)\n",loop_ptr,
-                   loop_stack[loop_ptr].loop_label);
-           }
-#endif
-           loop_ptr--;
-           cmd = cmd->c_next;
-           goto tail_recursion_entry;
+           if (savestack->ary_fill > oldsave)
+               restorelist(oldsave);
+           goto next_cmd;
        case O_NEXT:
            goto next_iter;
        case O_REDO:
@@ -392,18 +499,21 @@ until_loop:
            goto doit;
        }
        oldspat = curspat;
+       oldsave = savestack->ary_fill;
 #ifdef DEBUGGING
        olddlevel = dlevel;
 #endif
     doit:
        if (cmd->ucmd.ccmd.cc_true) {
 #ifdef DEBUGGING
-           debname[dlevel] = 't';
-           debdelim[dlevel++] = '_';
+           if (debug) {
+               debname[dlevel] = 't';
+               debdelim[dlevel++] = '_';
+           }
 #endif
            cmd_exec(cmd->ucmd.ccmd.cc_true);
        }
-       /* actually, this spot is never reached anymore since the above
+       /* actually, this spot is rarely reached anymore since the above
         * cmd_exec() returns through longjmp().  Hooray for structure.
         */
       next_iter:
@@ -412,13 +522,17 @@ until_loop:
 #endif
        if (cmd->ucmd.ccmd.cc_alt) {
 #ifdef DEBUGGING
-           debname[dlevel] = 'a';
-           debdelim[dlevel++] = '_';
+           if (debug) {
+               debname[dlevel] = 'a';
+               debdelim[dlevel++] = '_';
+           }
 #endif
            cmd_exec(cmd->ucmd.ccmd.cc_alt);
        }
       finish_while:
        curspat = oldspat;
+       if (savestack->ary_fill > oldsave)
+           restorelist(oldsave);
 #ifdef DEBUGGING
        dlevel = olddlevel - 1;
 #endif
@@ -427,8 +541,24 @@ until_loop:
     }
     if (cmdflags & CF_LOOP) {
        cmdflags |= CF_COND;            /* now test the condition */
+#ifdef DEBUGGING
+       dlevel = entdlevel;
+#endif
        goto until_loop;
     }
+  next_cmd:
+    if (cmdflags & CF_ONCE) {
+#ifdef DEBUGGING
+       if (debug & 4) {
+           deb("(Popping label #%d %s)\n",loop_ptr,
+               loop_stack[loop_ptr].loop_label);
+       }
+#endif
+       loop_ptr--;
+       if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY) {
+           cmd->c_stab->stab_val = cmd->c_short;
+       }
+    }
     cmd = cmd->c_next;
     goto tail_recursion_entry;
 }
@@ -440,6 +570,7 @@ char *pat;
 {
     register int i;
 
+    fprintf(stderr,"%-4ld",(long)line);
     for (i=0; i<dlevel; i++)
        fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
     fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
@@ -452,8 +583,40 @@ register CMD *which;
 {
     cmd->c_flags &= CF_ONCE|CF_COND|CF_LOOP;
     cmd->c_flags |= which->c_flags;
-    cmd->c_first = which->c_first;
-    cmd->c_flen = which->c_flen;
+    cmd->c_short = which->c_short;
+    cmd->c_slen = which->c_slen;
     cmd->c_stab = which->c_stab;
     return cmd->c_flags;
 }
+
+void
+savelist(sarg,maxsarg)
+register STR **sarg;
+int maxsarg;
+{
+    register STR *str;
+    register int i;
+
+    for (i = 1; i <= maxsarg; i++) {
+       apush(savestack,sarg[i]);               /* remember the pointer */
+       str = str_new(0);
+       str_sset(str,sarg[i]);
+       apush(savestack,str);                   /* remember the value */
+    }
+}
+
+void
+restorelist(base)
+int base;
+{
+    register STR *str;
+    register STR *value;
+
+    while (savestack->ary_fill > base) {
+       value = apop(savestack);
+       str = apop(savestack);
+       str_sset(str,value);
+       STABSET(str);
+       str_free(value);
+    }
+}
diff --git a/cmd.h b/cmd.h
index 9a019f2..e320ee2 100644 (file)
--- a/cmd.h
+++ b/cmd.h
@@ -1,11 +1,8 @@
-/* $Header: cmd.h,v 1.0.1.1 88/01/28 10:23:07 root Exp $
+/* $Header: cmd.h,v 2.0 88/06/05 00:08:28 root Exp $
  *
  * $Log:       cmd.h,v $
- * Revision 1.0.1.1  88/01/28  10:23:07  root
- * patch8: added eval_root for eval operator.
- * 
- * Revision 1.0  87/12/18  13:04:59  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:08:28  root
+ * Baseline version 2.0.
  * 
  */
 
@@ -15,6 +12,7 @@
 #define C_EXPR 3
 #define C_BLOCK 4
 
+#ifdef DEBUGGING
 #ifndef DOINIT
 extern char *cmdname[];
 #else
@@ -38,11 +36,12 @@ char *cmdname[] = {
     "16"
 };
 #endif
+#endif /* DEBUGGING */
 
 #define CF_OPTIMIZE 077        /* type of optimization */
 #define CF_FIRSTNEG 0100/* conditional is ($register NE 'string') */
-#define CF_NESURE 0200 /* if first doesn't match we're sure */
-#define CF_EQSURE 0400 /* if first does match we're sure */
+#define CF_NESURE 0200 /* if short doesn't match we're sure */
+#define CF_EQSURE 0400 /* if short does match we're sure */
 #define CF_COND        01000   /* test c_expr as conditional first, if not null. */
                        /* Set for everything except do {} while currently */
 #define CF_LOOP 02000  /* loop on the c_expr conditional (loop modifiers) */
@@ -56,11 +55,15 @@ char *cmdname[] = {
 #define CFT_ANCHOR 3   /* c_expr is an anchored search /^.../ */
 #define CFT_STROP 4    /* c_expr is a string comparison */
 #define CFT_SCAN 5     /* c_expr is an unanchored search /.../ */
-#define CFT_GETS 6     /* c_expr is $reg = <filehandle> */
+#define CFT_GETS 6     /* c_expr is <filehandle> */
 #define CFT_EVAL 7     /* c_expr is not optimized, so call eval() */
 #define CFT_UNFLIP 8   /* 2nd half of range not optimized */
 #define CFT_CHOP 9     /* c_expr is a chop on a register */
+#define CFT_ARRAY 10   /* this is a foreach loop */
+#define CFT_INDGETS 11 /* c_expr is <$variable> */
+#define CFT_NUMOP 12   /* c_expr is a numeric comparison */
 
+#ifdef DEBUGGING
 #ifndef DOINIT
 extern char *cmdopt[];
 #else
@@ -75,9 +78,13 @@ char *cmdopt[] = {
     "EVAL",
     "UNFLIP",
     "CHOP",
-    "10"
+    "ARRAY",
+    "INDGETS",
+    "NUMOP",
+    "13"
 };
 #endif
+#endif /* DEBUGGING */
 
 struct acmd {
     STAB       *ac_stab;       /* a symbol table entry */
@@ -93,7 +100,7 @@ struct cmd {
     CMD                *c_next;        /* the next command at this level */
     ARG                *c_expr;        /* conditional expression */
     CMD                *c_head;        /* head of this command list */
-    STR                *c_first;       /* head of string to match as shortcut */
+    STR                *c_short;       /* string to match as shortcut */
     STAB       *c_stab;        /* a symbol table entry, mostly for fp */
     SPAT       *c_spat;        /* pattern used by optimization */
     char       *c_label;       /* label for this construct */
@@ -101,8 +108,10 @@ struct cmd {
        struct acmd acmd;       /* normal command */
        struct ccmd ccmd;       /* compound command */
     } ucmd;
-    short      c_flen;         /* len of c_first, if not null */
+    short      c_slen;         /* len of c_short, if not null */
     short      c_flags;        /* optimization flags--see above */
+    char       *c_file;        /* file the following line # is from */
+    line_t      c_line;         /* line # of this command */
     char       c_type;         /* what this command does */
 };
 
@@ -116,11 +125,6 @@ EXT struct compcmd {
     CMD *comp_alt;
 };
 
-#ifndef DOINIT
-extern struct compcmd Nullccmd;
-#else
-struct compcmd Nullccmd = {Nullcmd, Nullcmd};
-#endif
 void opt_arg();
 void evalstatic();
 STR *cmd_exec();
index a1778a4..d26f842 100644 (file)
@@ -7,7 +7,7 @@ case $CONFIG in
        (echo "Can't find config.sh."; exit 1)
        echo "Using config.sh from above..."
     fi
-    . config.sh
+    . ./config.sh
     ;;
 esac
 echo "Extracting config.h (with variable substitutions)"
@@ -37,7 +37,7 @@ cat <<!GROK!THIS! >config.h
 #$d_eunice     EUNICE          /**/
 #$d_eunice     VMS             /**/
 
-/* CPP:
+/* CPPSTDIN:
  *     This symbol contains the first part of the string which will invoke
  *     the C preprocessor on the standard input and produce to standard
  *     output.  Typical value of "cc -E" or "/lib/cpp".
@@ -45,10 +45,10 @@ cat <<!GROK!THIS! >config.h
 /* CPPMINUS:
  *     This symbol contains the second part of the string which will invoke
  *     the C preprocessor on the standard input and produce to standard
- *     output.  This symbol will have the value "-" if CPP needs a minus
+ *     output.  This symbol will have the value "-" if CPPSTDIN needs a minus
  *     to specify standard input, otherwise the value is "".
  */
-#define CPP "$cpp"
+#define CPPSTDIN "$cppstdin"
 #define CPPMINUS "$cppminus"
 
 /* BCOPY:
@@ -71,6 +71,25 @@ cat <<!GROK!THIS! >config.h
  */
 #$d_crypt      CRYPT           /**/
 
+/* FCHMOD:
+ *     This symbol, if defined, indicates that the fchmod routine is available
+ *     to change mode of opened files.  If unavailable, use chmod().
+ */
+#$d_fchmod     FCHMOD          /**/
+
+/* FCHOWN:
+ *     This symbol, if defined, indicates that the fchown routine is available
+ *     to change ownership of opened files.  If unavailable, use chown().
+ */
+#$d_fchown     FCHOWN          /**/
+
+/* GETGROUPS:
+ *     This symbol, if defined, indicates that the getgroups() routine is
+ *     available to get the list of process groups.  If unavailable, multiple
+ *     groups are probably not supported.
+ */
+#$d_getgrps    GETGROUPS               /**/
+
 /* index:
  *     This preprocessor symbol is defined, along with rindex, if the system
  *     uses the strchr and strrchr routines instead.
@@ -82,6 +101,51 @@ cat <<!GROK!THIS! >config.h
 #$d_index      index strchr    /* cultural */
 #$d_index      rindex strrchr  /*  differences? */
 
+/* KILLPG:
+ *     This symbol, if defined, indicates that the killpg routine is available
+ *     to kill process groups.  If unavailable, you probably should use kill
+ *     with a negative process number.
+ */
+#$d_killpg     KILLPG          /**/
+
+/* MEMCPY:
+ *     This symbol, if defined, indicates that the memcpy routine is available
+ *     to copy blocks of memory.  Otherwise you should probably use bcopy().
+ *     If neither is defined, roll your own.
+ */
+#$d_memcpy     MEMCPY          /**/
+
+/* RENAME:
+ *     This symbol, if defined, indicates that the rename routine is available
+ *     to rename files.  Otherwise you should do the unlink(), link(), unlink()
+ *     trick.
+ */
+#$d_rename     RENAME          /**/
+
+/* SETEGID:
+ *     This symbol, if defined, indicates that the setegid routine is available
+ *     to change the effective gid of the current program.
+ */
+#$d_setegid    SETEGID         /**/
+
+/* SETEUID:
+ *     This symbol, if defined, indicates that the seteuid routine is available
+ *     to change the effective uid of the current program.
+ */
+#$d_seteuid    SETEUID         /**/
+
+/* SETRGID:
+ *     This symbol, if defined, indicates that the setrgid routine is available
+ *     to change the real gid of the current program.
+ */
+#$d_setrgid    SETRGID         /**/
+
+/* SETRUID:
+ *     This symbol, if defined, indicates that the setruid routine is available
+ *     to change the real uid of the current program.
+ */
+#$d_setruid    SETRUID         /**/
+
 /* STATBLOCKS:
  *     This symbol is defined if this system has a stat structure declaring
  *     st_blksize and st_blocks.
@@ -94,6 +158,12 @@ cat <<!GROK!THIS! >config.h
  */
 #$d_stdstdio   STDSTDIO        /**/
 
+/* STRCSPN:
+ *     This symbol, if defined, indicates that the strcspn routine is available
+ *     to scan strings.
+ */
+#$d_strcspn    STRCSPN         /**/
+
 /* STRUCTCOPY:
  *     This symbol, if defined, indicates that this C compiler knows how
  *     to copy structures.  If undefined, you'll need to use a block copy
@@ -129,12 +199,24 @@ cat <<!GROK!THIS! >config.h
  */
 #$d_voidsig    VOIDSIG         /**/
 
+/* GIDTYPE:
+ *     This symbol has a value like gid_t, int, ushort, or whatever type is
+ *     used to declare group ids in the kernel.
+ */
+#define GIDTYPE $gidtype               /**/
+
 /* STDCHAR:
  *     This symbol is defined to be the type of char used in stdio.h.
  *     It has the values "unsigned char" or "char".
  */
 #define STDCHAR $stdchar       /**/
 
+/* UIDTYPE:
+ *     This symbol has a value like uid_t, int, ushort, or whatever type is
+ *     used to declare user ids in the kernel.
+ */
+#define UIDTYPE $uidtype               /**/
+
 /* VOIDFLAGS:
  *     This symbol indicates how much support of the void type is given by this
  *     compiler.  What various bits mean:
@@ -158,4 +240,11 @@ cat <<!GROK!THIS! >config.h
 #$define M_VOID                /* Xenix strikes again */
 #endif
 
+/* PRIVLIB:
+ *     This symbol contains the name of the private library for this package.
+ *     The library is private in the sense that it needn't be in anyone's
+ *     execution path, but it should be accessible by the world.
+ */
+#define PRIVLIB "$privlib"             /**/
+
 !GROK!THIS!
diff --git a/dump.c b/dump.c
index 4f93fd1..1567017 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1,15 +1,12 @@
-/* $Header: dump.c,v 1.0 87/12/18 13:05:03 root Exp $
+/* $Header: dump.c,v 2.0 88/06/05 00:08:44 root Exp $
  *
  * $Log:       dump.c,v $
- * Revision 1.0  87/12/18  13:05:03  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:08:44  root
+ * Baseline version 2.0.
  * 
  */
 
-#include "handy.h"
 #include "EXTERN.h"
-#include "search.h"
-#include "util.h"
 #include "perl.h"
 
 #ifdef DEBUGGING
@@ -23,6 +20,8 @@ register CMD *alt;
     while (cmd) {
        dumplvl++;
        dump("C_TYPE = %s\n",cmdname[cmd->c_type]);
+       if (cmd->c_line)
+           dump("C_LINE = %d\n",cmd->c_line);
        if (cmd->c_label)
            dump("C_LABEL = \"%s\"\n",cmd->c_label);
        dump("C_OPT = CFT_%s\n",cmdopt[cmd->c_flags & CF_OPTIMIZE]);
@@ -46,9 +45,9 @@ register CMD *alt;
        if (*buf)
            buf[strlen(buf)-1] = '\0';
        dump("C_FLAGS = (%s)\n",buf);
-       if (cmd->c_first) {
-           dump("C_FIRST = \"%s\"\n",str_peek(cmd->c_first));
-           dump("C_FLEN = \"%d\"\n",cmd->c_flen);
+       if (cmd->c_short) {
+           dump("C_SHORT = \"%s\"\n",str_peek(cmd->c_short));
+           dump("C_SLEN = \"%d\"\n",cmd->c_slen);
        }
        if (cmd->c_stab) {
            dump("C_STAB = ");
@@ -81,7 +80,7 @@ register CMD *alt;
        case C_EXPR:
            if (cmd->ucmd.acmd.ac_stab) {
                dump("AC_STAB = ");
-               dump_arg(cmd->ucmd.acmd.ac_stab);
+               dump_stab(cmd->ucmd.acmd.ac_stab);
            } else
                dump("AC_STAB = NULL\n");
            if (cmd->ucmd.acmd.ac_expr) {
@@ -117,26 +116,18 @@ register ARG *arg;
     dumplvl++;
     dump("OP_TYPE = %s\n",opname[arg->arg_type]);
     dump("OP_LEN = %d\n",arg->arg_len);
+    if (arg->arg_flags) {
+       dump_flags(buf,arg->arg_flags);
+       dump("OP_FLAGS = (%s)\n",buf);
+    }
     for (i = 1; i <= arg->arg_len; i++) {
        dump("[%d]ARG_TYPE = %s\n",i,argname[arg[i].arg_type]);
        if (arg[i].arg_len)
            dump("[%d]ARG_LEN = %d\n",i,arg[i].arg_len);
-       *buf = '\0';
-       if (arg[i].arg_flags & AF_SPECIAL)
-           strcat(buf,"SPECIAL,");
-       if (arg[i].arg_flags & AF_POST)
-           strcat(buf,"POST,");
-       if (arg[i].arg_flags & AF_PRE)
-           strcat(buf,"PRE,");
-       if (arg[i].arg_flags & AF_UP)
-           strcat(buf,"UP,");
-       if (arg[i].arg_flags & AF_COMMON)
-           strcat(buf,"COMMON,");
-       if (arg[i].arg_flags & AF_NUMERIC)
-           strcat(buf,"NUMERIC,");
-       if (*buf)
-           buf[strlen(buf)-1] = '\0';
-       dump("[%d]ARG_FLAGS = (%s)\n",i,buf);
+       if (arg[i].arg_flags) {
+           dump_flags(buf,arg[i].arg_flags);
+           dump("[%d]ARG_FLAGS = (%s)\n",i,buf);
+       }
        switch (arg[i].arg_type) {
        case A_NULL:
            break;
@@ -149,9 +140,11 @@ register ARG *arg;
            dump("[%d]ARG_CMD = ",i);
            dump_cmd(arg[i].arg_ptr.arg_cmd,Nullcmd);
            break;
+       case A_WORD:
        case A_STAB:
        case A_LVAL:
        case A_READ:
+       case A_GLOB:
        case A_ARYLEN:
            dump("[%d]ARG_STAB = ",i);
            dump_stab(arg[i].arg_ptr.arg_stab);
@@ -174,9 +167,38 @@ register ARG *arg;
     dump("}\n");
 }
 
+dump_flags(b,flags)
+char *b;
+unsigned flags;
+{
+    *b = '\0';
+    if (flags & AF_SPECIAL)
+       strcat(b,"SPECIAL,");
+    if (flags & AF_POST)
+       strcat(b,"POST,");
+    if (flags & AF_PRE)
+       strcat(b,"PRE,");
+    if (flags & AF_UP)
+       strcat(b,"UP,");
+    if (flags & AF_COMMON)
+       strcat(b,"COMMON,");
+    if (flags & AF_NUMERIC)
+       strcat(b,"NUMERIC,");
+    if (flags & AF_LISTISH)
+       strcat(b,"LISTISH,");
+    if (flags & AF_LOCAL)
+       strcat(b,"LOCAL,");
+    if (*b)
+       b[strlen(b)-1] = '\0';
+}
+
 dump_stab(stab)
 register STAB *stab;
 {
+    if (!stab) {
+       fprintf(stderr,"{}\n");
+       return;
+    }
     dumplvl++;
     fprintf(stderr,"{\n");
     dump("STAB_NAME = %s\n",stab->stab_name);
@@ -189,28 +211,37 @@ register SPAT *spat;
 {
     char ch;
 
+    if (!spat) {
+       fprintf(stderr,"{}\n");
+       return;
+    }
     fprintf(stderr,"{\n");
     dumplvl++;
     if (spat->spat_runtime) {
        dump("SPAT_RUNTIME = ");
        dump_arg(spat->spat_runtime);
     } else {
-       if (spat->spat_flags & SPAT_USE_ONCE)
+       if (spat->spat_flags & SPAT_ONCE)
            ch = '?';
        else
            ch = '/';
-       dump("SPAT_PRE %c%s%c\n",ch,spat->spat_compex.precomp,ch);
+       dump("SPAT_PRE %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
     }
     if (spat->spat_repl) {
        dump("SPAT_REPL = ");
        dump_arg(spat->spat_repl);
     }
+    if (spat->spat_short) {
+       dump("SPAT_SHORT = \"%s\"\n",str_peek(spat->spat_short));
+    }
     dumplvl--;
     dump("}\n");
 }
 
+/* VARARGS1 */
 dump(arg1,arg2,arg3,arg4,arg5)
-char *arg1, *arg2, *arg3, *arg4, *arg5;
+char *arg1;
+long arg2, arg3, arg4, arg5;
 {
     int i;
 
diff --git a/eg/ADB b/eg/ADB
new file mode 100644 (file)
index 0000000..1a43b90
--- /dev/null
+++ b/eg/ADB
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+# $Header: ADB,v 2.0 88/06/05 00:16:39 root Exp $
+
+# This script is only useful when used in your crash directory.
+
+$num = shift;
+exec 'adb', '-k', "vmunix.$num", "vmcore.$num";
diff --git a/eg/README b/eg/README
new file mode 100644 (file)
index 0000000..bec7538
--- /dev/null
+++ b/eg/README
@@ -0,0 +1,18 @@
+This stuff is supplied on an as-is basis--little attempt has been made to make
+any of it portable.  It's mostly here to give you an idea of what perl code
+looks like, and what tricks and idioms are used.
+
+System administrators responsible for many computers will enjoy the items
+down in the g directory very much.  The scan directory contains the beginnings
+of a system to check on and report various kinds of anomalies.
+
+If you machine doesn't support #!, the first thing you'll want to do is
+replace the #! with a couple of lines that look like this:
+
+       eval "exec /usr/bin/perl -S $0 $*"
+               if $running_under_some_shell;
+
+being sure to include any flags that were on the #! line.  A supplied script
+called "nih" will translate perl scripts in place for you:
+
+       nih g/g??
diff --git a/eg/changes b/eg/changes
new file mode 100644 (file)
index 0000000..db9b7b1
--- /dev/null
@@ -0,0 +1,34 @@
+#!/usr/bin/perl -P
+
+# $Header: changes,v 2.0 88/06/05 00:16:41 root Exp $
+
+($dir, $days) = @ARGV;
+$dir = '/' if $dir eq '';
+$days = '14' if $days eq '';
+
+# Masscomps do things differently from Suns
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+open(Find, "find $dir -mtime -$days -print |") ||
+       die "changes: can't run find";
+#else
+open(Find, "find $dir \\( -fstype nfs -prune \\) -o -mtime -$days -ls |") ||
+       die "changes: can't run find";
+#endif
+
+while (<Find>) {
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+    $x = `/bin/ls -ild $_`;
+    $_ = $x;
+    ($inode,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
+      = split(' ');
+#else
+    ($inode,$blocks,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
+      = split(' ');
+#endif
+
+    printf("%10s%3s %-8s %-8s%9s %3s %2s %s\n",
+           $perm,$links,$owner,$group,$size,$month,$day,$name);
+}
+
diff --git a/eg/dus b/eg/dus
new file mode 100644 (file)
index 0000000..8c7ff94
--- /dev/null
+++ b/eg/dus
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+# $Header: dus,v 2.0 88/06/05 00:16:44 root Exp $
+
+# This script does a du -s on any directories in the current directory that
+# are not mount points for another filesystem.
+
+($mydev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat('.');
+
+open(ls,'ls -F1|');
+
+while (<ls>) {
+    chop;
+    next unless s|/$||;
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+       $blksize,$blocks) = stat($_);
+    next unless $dev == $mydev;
+    push(@ary,$_);
+}
+
+exec 'du', '-s', @ary;
diff --git a/eg/findcp b/eg/findcp
new file mode 100644 (file)
index 0000000..57cac2e
--- /dev/null
+++ b/eg/findcp
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+# $Header: findcp,v 2.0 88/06/05 00:16:47 root Exp $
+
+# This is a wrapper around the find command that pretends find has a switch
+# of the form -cp host:destination.  It presumes your find implements -ls.
+# It uses tar to do the actual copy.  If your tar knows about the I switch
+# you may prefer to use findtar, since this one has to do the tar in batches.
+
+sub copy {
+    `tar cf - $list | rsh $desthost cd $destdir '&&' tar xBpf -`;
+}
+
+$sourcedir = $ARGV[0];
+if ($sourcedir =~ /^\//) {
+    $ARGV[0] = '.';
+    unless (chdir($sourcedir)) { die "Can't find directory: $sourcedir"; }
+}
+
+$args = join(' ',@ARGV);
+if ($args =~ s/-cp *([^ ]+)/-ls/) {
+    $dest = $1;
+    if ($dest =~ /(.*):(.*)/) {
+       $desthost = $1;
+       $destdir = $2;
+    }
+    else {
+       die "Malformed destination--should be host:directory";
+    }
+}
+else {
+    die("No destination specified");
+}
+
+open(find,"find $args |") || die "Can't run find for you.";
+
+while (<find>) {
+    @x = split(' ');
+    if ($x[2] =~ /^d/) { next;}
+    chop($filename = $x[10]);
+    if (length($list) > 5000) {
+       do copy();
+       $list = '';
+    }
+    else {
+       $list .= ' ';
+    }
+    $list .= $filename;
+}
+
+if ($list) {
+    do copy();
+}
diff --git a/eg/findtar b/eg/findtar
new file mode 100644 (file)
index 0000000..8b604b3
--- /dev/null
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+# $Header: findtar,v 2.0 88/06/05 00:16:49 root Exp $
+
+# findtar takes find-style arguments and spits out a tarfile on stdout.
+# It won't work unless your find supports -ls and your tar the I flag.
+
+$args = join(' ',@ARGV);
+open(find,"/usr/bin/find $args -ls |") || die "Can't run find for you.";
+
+open(tar,"| /bin/tar cIf - -") || die "Can't run tar for you.";
+
+while (<find>) {
+    @x = split(' ');
+    if ($x[2] =~ /^d/) { print tar '-d ';}
+    print tar $x[10],"\n";
+}
diff --git a/eg/g/gcp b/eg/g/gcp
new file mode 100644 (file)
index 0000000..6b4a9a7
--- /dev/null
+++ b/eg/g/gcp
@@ -0,0 +1,114 @@
+#!/usr/bin/perl
+
+# $Header: gcp,v 2.0 88/06/05 00:17:02 root Exp $
+
+# Here is a script to do global rcps.  See man page.
+
+$#ARGV >= 1 || die "Not enough arguments.\n";
+
+if ($ARGV[0] eq '-r') {
+    $rcp = 'rcp -r';
+    shift;
+} else {
+    $rcp = 'rcp';
+}
+$args = $rcp;
+$dest = $ARGV[$#ARGV];
+
+$SIG{'QUIT'} = 'CLEANUP';
+$SIG{'INT'} = 'CONT';
+
+while ($arg = shift) {
+    if ($arg =~ /^([-a-zA-Z0-9_+]+):/) {
+       if ($systype && $systype ne $1) {
+           die "Can't mix system type specifers ($systype vs $1).\n";
+       }
+       $#ARGV < 0 || $arg !~ /:$/ || die "No source file specified.\n";
+       $systype = $1;
+       $args .= " $arg";
+    } else {
+       if ($#ARGV >= 0) {
+           if ($arg =~ /^[\/~]/) {
+               $arg =~ /^(.*)\// && ($dir = $1);
+           } else {
+               if (!$pwd) {
+                   chop($pwd = `pwd`);
+               }
+               $dir = $pwd;
+           }
+       }
+       if ($olddir && $dir ne $olddir && $dest =~ /:$/) {
+           $args .= " $dest$olddir; $rcp";
+       }
+       $olddir = $dir;
+       $args .= " $arg";
+    }
+}
+
+die "No system type specified.\n" unless $systype;
+
+$args =~ s/:$/:$olddir/;
+
+chop($thishost = `hostname`);
+
+$one_of_these = ":$systype:";
+if ($systype =~ s/\+/[+]/g) {
+    $one_of_these =~ s/\+/:/g;
+}
+$one_of_these =~ s/-/:-/g;
+
+@ARGV = ();
+push(@ARGV,'.grem') if -f '.grem';
+push(@ARGV,'.ghosts') if -f '.ghosts';
+push(@ARGV,'/etc/ghosts');
+
+$remainder = '';
+
+line: while (<>) {
+    s/[ \t]*\n//;
+    if (!$_ || /^#/) {
+       next line;
+    }
+    if (/^([a-zA-Z_0-9]+)=(.+)/) {
+       $name = $1; $repl = $2;
+       $repl =~ s/\+/:/g;
+       $repl =~ s/-/:-/g;
+       $one_of_these =~ s/:$name:/:$repl:/;
+       $repl =~ s/:/:-/g;
+       $one_of_these =~ s/:-$name:/:-$repl:/g;
+       next line;
+    }
+    @gh = split(' ');
+    $host = $gh[0];
+  next line if $host eq $thishost;     # should handle aliases too
+    $wanted = 0;
+    foreach $class (@gh) {
+       $wanted++ if index($one_of_these,":$class:") >= 0;
+       $wanted = -9999 if index($one_of_these,":-$class:") >= 0;
+    }
+    if ($wanted > 0) {
+       ($cmd = $args) =~ s/[ \t]$systype:/ $host:/g;
+       print "$cmd\n";
+       $result = `$cmd 2>&1`;
+       $remainder .= "$host+" if
+           $result =~ /Connection timed out|Permission denied/;
+       print $result;
+    }
+}
+
+if ($remainder) {
+    chop($remainder);
+    open(grem,">.grem") || (printf stderr "Can't create .grem\n");
+    print grem 'rem=', $remainder, "\n";
+    close(grem);
+    print 'rem=', $remainder, "\n";
+}
+
+sub CLEANUP {
+    exit;
+}
+
+sub CONT {
+    print "Continuing...\n";   # Just ignore the signal that kills rcp
+    $remainder .= "$host+";
+}
diff --git a/eg/g/gcp.man b/eg/g/gcp.man
new file mode 100644 (file)
index 0000000..83c5d85
--- /dev/null
@@ -0,0 +1,77 @@
+.\" $Header: gcp.man,v 2.0 88/06/05 00:17:05 root Exp $
+.TH GCP 1C "13 May 1988"
+.SH NAME
+gcp \- global file copy
+.SH SYNOPSIS
+.B gcp
+file1 file2
+.br
+.B gcp
+[
+.B \-r
+] file ... directory
+.SH DESCRIPTION
+.I gcp
+works just like rcp(1C) except that you may specify a set of hosts to copy files
+from or to.
+The host sets are defined in the file /etc/ghosts.
+(An individual host name can be used as a set containing one member.)
+You can give a command like
+
+       gcp /etc/motd sun:
+
+to copy your /etc/motd file to /etc/motd on all the Suns.
+If, on the other hand, you say
+
+       gcp /a/foo /b/bar sun:/tmp
+
+then your files will be copied to /tmp on all the Suns.
+The general rule is that if you don't specify the destination directory,
+files go to the same directory they are in currently.
+.P
+You may specify the union of two or more sets by using + as follows:
+
+       gcp /a/foo /b/bar 750+mc:
+
+which will copy /a/foo to /a/foo on all 750's and Masscomps, and then copy
+/b/bar to /b/bar on all 750's and Masscomps.
+.P
+Commonly used sets should be defined in /etc/ghosts.
+For example, you could add a line that says
+
+       pep=manny+moe+jack
+
+Another way to do that would be to add the word "pep" after each of the host
+entries:
+
+       manny   sun3 pep
+.br
+       moe             sun3 pep
+.br
+       jack            sun3 pep
+
+Hosts and sets of host can also be excluded:
+
+       foo=sun-sun2
+
+Any host so excluded will never be included, even if a subsequent set on the
+line includes it:
+
+       foo=abc+def
+.br
+       bar=xyz-abc+foo
+
+comes out to xyz+def.
+
+You can define private host sets by creating .ghosts in your current directory
+with entries just like /etc/ghosts.
+Also, if there is a file .grem, it defines "rem" to be the remaining hosts
+from the last gsh or gcp that didn't succeed everywhere.
+.PP
+Interrupting with a SIGINT will cause the rcp to the current host to be skipped
+and execution resumed with the next host.
+To stop completely, send a SIGQUIT.
+.SH SEE ALSO
+rcp(1C)
+.SH BUGS
+All the bugs of rcp, since it calls rcp.
diff --git a/eg/g/ged b/eg/g/ged
new file mode 100644 (file)
index 0000000..bb7c222
--- /dev/null
+++ b/eg/g/ged
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+# $Header: ged,v 2.0 88/06/05 00:17:08 root Exp $
+
+# Does inplace edits on a set of files on a set of machines.
+#
+# Typical invokation:
+#
+#      ged vax+sun /etc/passwd
+#      s/Freddy/Freddie/;
+#      ^D
+#
+
+$class = shift;
+$files = join(' ',@ARGV);
+
+die "Usage: ged class files <perlcmds\n" unless $files;
+
+exec "gsh", $class, "-d", "perl -pi.bak - $files";
+
+die "Couldn't execute gsh for some reason, stopped";
diff --git a/eg/g/ghosts b/eg/g/ghosts
new file mode 100644 (file)
index 0000000..96ec771
--- /dev/null
@@ -0,0 +1,33 @@
+# This first section gives alternate sets defined in terms of the sets given
+# by the second section.  The order is important--all references must be
+# forward references.
+
+Nnd=sun-nd
+all=sun+mc+vax
+baseline=sun+mc
+sun=sun2+sun3
+vax=750+8600
+pep=manny+moe+jack
+
+# This second section defines the basic sets.  Each host should have a line
+# that specifies which sets it is a member of.  Extra sets should be separated
+# by white space.  (The first section isn't strictly necessary, since all sets
+# could be defined in the second section, but then it wouldn't be so readable.)
+
+basvax 8600    src
+cdb0   sun3            sys
+cdb1   sun3            sys
+cdb2   sun3            sys
+chief  sun3    src
+tis0   sun3
+manny  sun3            sys
+moe    sun3            sys
+jack   sun3            sys
+disney sun3            sys
+huey   sun3            nd
+dewey  sun3            nd
+louie  sun3            nd
+bizet  sun2    src     sys
+gif0   mc      src
+mc0    mc
+dtv0   mc
diff --git a/eg/g/gsh b/eg/g/gsh
new file mode 100644 (file)
index 0000000..50ce1f7
--- /dev/null
+++ b/eg/g/gsh
@@ -0,0 +1,116 @@
+#!/bin/perl
+
+# $Header: gsh,v 2.0 88/06/05 00:17:20 root Exp $
+
+# Do rsh globally--see man page
+
+$SIG{'QUIT'} = 'quit';                 # install signal handler for SIGQUIT
+
+sub getswitches {
+    while ($ARGV[0] =~ /^-/) {         # parse switches
+       $ARGV[0] =~ /^-h/ && ($showhost++,$silent++,shift,next);
+       $ARGV[0] =~ /^-s/ && ($silent++,shift,next);
+       $ARGV[0] =~ /^-d/ && ($dodist++,shift,next);
+       $ARGV[0] =~ /^-n/ && ($n=' -n',shift,next);
+       $ARGV[0] =~ /^-l/ && ($l=' -l ' . $ARGV[1],shift,shift,next);
+       last;
+    }
+}
+
+do getswitches();                      # get any switches before class
+$systype = shift;                      # get name representing set of hosts
+do getswitches();                      # same switches allowed after class
+
+if ($dodist) {                         # distribute input over all rshes?
+    `cat >/tmp/gsh$$`;                 #  get input into a handy place
+    $dist = " </tmp/gsh$$";            #  each rsh takes input from there
+}
+
+$cmd = join(' ',@ARGV);                        # remaining args constitute the command
+$cmd =~ s/'/'"'"'/g;                   # quote any embedded single quotes
+
+$one_of_these = ":$systype:";          # prepare to expand "macros"
+$one_of_these =~ s/\+/:/g;             # we hope to end up with list of
+$one_of_these =~ s/-/:-/g;             #  colon separated attributes
+
+@ARGV = ();
+push(@ARGV,'.grem') if -f '.grem';
+push(@ARGV,'.ghosts') if -f '.ghosts';
+push(@ARGV,'/etc/ghosts');
+
+$remainder = '';
+
+line: while (<>) {             # for each line of ghosts
+
+    s/[ \t]*\n//;                      # trim trailing whitespace
+    if (!$_ || /^#/) {                 # skip blank line or comment
+       next line;
+    }
+
+    if (/^(\w+)=(.+)/) {               # a macro line?
+       $name = $1; $repl = $2;
+       $repl =~ s/\+/:/g;
+       $repl =~ s/-/:-/g;
+       $one_of_these =~ s/:$name:/:$repl:/;    # do expansion in "wanted" list
+       $repl =~ s/:/:-/g;
+       $one_of_these =~ s/:-$name:/:-$repl:/;
+       next line;
+    }
+
+    # we have a normal line
+
+    @attr = split(' ');                        # a list of attributes to match against
+                                       #   which we put into an array
+    $host = $attr[0];                  # the first attribute is the host name
+    if ($showhost) {
+       $showhost = "$host:\t";
+    }
+
+    $wanted = 0;
+    foreach $attr (@attr) {            # iterate over attribute array
+       $wanted++ if index($one_of_these,":$attr:") >= 0;
+       $wanted = -9999 if index($one_of_these,":-$attr:") >= 0;
+    }
+    if ($wanted > 0) {
+       print "rsh $host$l$n '$cmd'\n" unless $silent;
+       $SIG{'INT'} = 'DEFAULT';
+       if (open(pipe,"rsh $host$l$n '$cmd'$dist 2>&1|")) {     # start an rsh
+           $SIG{'INT'} = 'cont';
+           for ($iter=0; <pipe>; $iter++) {
+               unless ($iter) {
+                   $remainder .= "$host+"
+                       if /Connection timed out|Permission denied/;
+               }
+               print $showhost,$_;
+           }
+           close(pipe);
+       } else {
+           $SIG{'INT'} = 'cont';
+           print "(Can't execute rsh.)\n";
+       }
+    }
+}
+
+unlink "/tmp/gsh$$" if $dodist;
+
+if ($remainder) {
+    chop($remainder);
+    open(grem,">.grem") || (printf stderr "Can't make a .grem file\n");
+    print grem 'rem=', $remainder, "\n";
+    close(grem);
+    print 'rem=', $remainder, "\n";
+}
+
+# here are a couple of subroutines that serve as signal handlers
+
+sub cont {
+    print "\rContinuing...\n";
+    $remainder .= "$host+";
+}
+
+sub quit {
+    $| = 1;
+    print "\r";
+    $SIG{'INT'} = '';
+    kill 2, $$;
+}
diff --git a/eg/g/gsh.man b/eg/g/gsh.man
new file mode 100644 (file)
index 0000000..4522129
--- /dev/null
@@ -0,0 +1,80 @@
+.\" $Header: gsh.man,v 2.0 88/06/05 00:17:23 root Exp $
+.TH GSH 8 "13 May 1988"
+.SH NAME
+gsh \- global shell
+.SH SYNOPSIS
+.B gsh
+[options]
+.I host
+[options] 
+.I command
+.SH DESCRIPTION
+.I gsh
+works just like rsh(1C) except that you may specify a set of hosts to execute
+the command on.
+The host sets are defined in the file /etc/ghosts.
+(An individual host name can be used as a set containing one member.)
+You can give a command like
+
+       gsh sun /etc/mungmotd
+
+to run /etc/mungmotd on all your Suns.
+.P
+You may specify the union of two or more sets by using + as follows:
+
+       gsh 750+mc /etc/mungmotd
+
+which will run mungmotd on all 750's and Masscomps.
+.P
+Commonly used sets should be defined in /etc/ghosts.
+For example, you could add a line that says
+
+       pep=manny+moe+jack
+
+Another way to do that would be to add the word "pep" after each of the host
+entries:
+
+       manny   sun3 pep
+.br
+       moe             sun3 pep
+.br
+       jack            sun3 pep
+
+Hosts and sets of host can also be excluded:
+
+       foo=sun-sun2
+
+Any host so excluded will never be included, even if a subsequent set on the
+line includes it:
+
+       foo=abc+def
+       bar=xyz-abc+foo
+
+comes out to xyz+def.
+
+You can define private host sets by creating .ghosts in your current directory
+with entries just like /etc/ghosts.
+Also, if there is a file .grem, it defines "rem" to be the remaining hosts
+from the last gsh or gcp that didn't succeed everywhere.
+
+Options include all those defined by rsh, as well as
+
+.IP "\-d" 8
+Causes gsh to collect input till end of file, and then distribute that input
+to each invokation of rsh.
+.IP "\-h" 8
+Rather than print out the command followed by the output, merely prepends the
+host name to each line of output.
+.IP "\-s" 8
+Do work silently.
+.PP
+Interrupting with a SIGINT will cause the rsh to the current host to be skipped
+and execution resumed with the next host.
+To stop completely, send a SIGQUIT.
+.SH SEE ALSO
+rsh(1C)
+.SH BUGS
+All the bugs of rsh, since it calls rsh.
+
+Also, will not properly return data from the remote execution that contains
+null characters.
diff --git a/eg/myrup b/eg/myrup
new file mode 100644 (file)
index 0000000..c32c99c
--- /dev/null
+++ b/eg/myrup
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+# $Header: myrup,v 2.0 88/06/05 00:16:51 root Exp $
+
+# This was a customization of ruptime requested by someone here who wanted
+# to be able to find the least loaded machine easily.  It uses the
+# /etc/ghosts file that's defined for gsh and gcp to prune down the
+# number of entries to those hosts we have administrative control over.
+
+print "node    load (u)\n------- --------\n";
+
+open(ghosts,'/etc/ghosts') || die "Can't open /etc/ghosts";
+line: while (<ghosts>) {
+    next line if /^#/;
+    next line if /^$/;
+    next line if /=/;
+    ($host) = split;
+    $wanted{$host} = 1;
+}
+
+open(ruptime,'ruptime|') || die "Can't run ruptime";
+open(sort,'|sort +1n');
+
+while (<ruptime>) {
+    ($host,$upness,$foo,$users,$foo,$foo,$load) = split(/[\s,]+/);
+    if ($wanted{$host} && $upness eq 'up') {
+       printf sort "%s\t%s (%d)\n", $host, $load, $users;
+    }
+}
diff --git a/eg/nih b/eg/nih
new file mode 100644 (file)
index 0000000..15cb60f
--- /dev/null
+++ b/eg/nih
@@ -0,0 +1,10 @@
+eval "exec /usr/bin/perl -Spi.bak $0 $*"
+       if $running_under_some_shell;
+
+# $Header: nih,v 2.0 88/06/05 00:16:54 root Exp $
+
+# This script makes #! scripts directly executable on machines that don't
+# support #!.  It edits in place any scripts mentioned on the command line.
+
+s|^#!(.*)|#!$1\neval "exec $1 -S \$0 \$*"\n\tif \$running_under_some_shell;|
+       if $. == 1;
diff --git a/eg/rmfrom b/eg/rmfrom
new file mode 100644 (file)
index 0000000..0fca304
--- /dev/null
+++ b/eg/rmfrom
@@ -0,0 +1,7 @@
+#!/usr/bin/perl -n
+
+# $Header: rmfrom,v 2.0 88/06/05 00:16:57 root Exp $
+
+# A handy (but dangerous) script to put after a find ... -print.
+
+chop; unlink;
diff --git a/eg/scan/scan_df b/eg/scan/scan_df
new file mode 100644 (file)
index 0000000..ca31642
--- /dev/null
@@ -0,0 +1,51 @@
+#!/usr/bin/perl -P
+
+# $Header: scan_df,v 2.0 88/06/05 00:17:56 root Exp $
+
+# This report points out filesystems that are in danger of overflowing.
+
+(chdir '/usr/adm/private/memories') || die "Can't cd.";
+`df >newdf`;
+open(Df, 'olddf');
+
+while (<Df>) {
+    ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split;
+    next if $fs =~ /:/;
+    next if $fs eq '';
+    $oldused{$fs} = $used;
+}
+
+open(Df, 'newdf') || die "scan_df: can't open newdf";
+
+while (<Df>) {
+    ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split;
+    next if $fs =~ /:/;
+    next if $fs eq '';
+    $oldused = $oldused{$fs};
+    next if ($oldused == $used && $capacity < 99);     # inactive filesystem
+    if ($capacity >= 90) {
+#if defined(mc300) || defined(mc500) || defined(mc700)
+       $_ = substr($_,0,13) . '        ' . substr($_,13,1000);
+       $kbytes /= 2;           # translate blocks to K
+       $used /= 2;
+       $oldused /= 2;
+       $avail /= 2;
+#endif
+       $diff = int($used - $oldused);
+       if ($avail < $diff * 2) {       # mark specially if in danger
+           $mounted_on .= ' *';
+       }
+       next if $diff < 50 && $mounted_on eq '/';
+       $fs =~ s|/dev/||;
+       if ($diff >= 0) {
+           $diff = '(+' . $diff . ')';
+       }
+       else {
+           $diff = '(' . $diff . ')';
+       }
+       printf "%-8s%8d%8d %-8s%8d%7s    %s\n",
+           $fs,$kbytes,$used,$diff,$avail,$capacity,$mounted_on;
+    }
+}
+
+rename('newdf','olddf');
diff --git a/eg/scan/scan_last b/eg/scan/scan_last
new file mode 100644 (file)
index 0000000..25d7843
--- /dev/null
@@ -0,0 +1,57 @@
+#!/usr/bin/perl -P
+
+# $Header: scan_last,v 2.0 88/06/05 00:17:58 root Exp $
+
+# This reports who was logged on at weird hours
+
+($dy, $mo, $lastdt) = split(/ +/,`date`);
+
+open(Last, 'exec last 2>&1 |') || die "scan_last: can't run last";
+
+while (<Last>) {
+#if defined(mc300) || defined(mc500) || defined(mc700)
+    $_ = substr($_,0,19) . substr($_,23,100);
+#endif
+    next if /^$/;
+    (print),next if m|^/|;
+    $login  = substr($_,0,8);
+    $tty    = substr($_,10,7);
+    $from   = substr($_,19,15);
+    $day    = substr($_,36,3);
+    $mo     = substr($_,40,3);
+    $dt     = substr($_,44,2);
+    $hr     = substr($_,47,2);
+    $min    = substr($_,50,2);
+    $dash   = substr($_,53,1);
+    $tohr   = substr($_,55,2);
+    $tomin  = substr($_,58,2);
+    $durhr  = substr($_,63,2);
+    $durmin = substr($_,66,2);
+    
+    next unless $hr;
+    next if $login eq 'reboot  ';
+    next if $login eq 'shutdown';
+
+    if ($dt != $lastdt) {
+       if ($lastdt < $dt) {
+           $seen += $dt - $lastdt;
+       }
+       else {
+           $seen++;
+       }
+       $lastdt = $dt;
+    }
+
+    $inat = $hr + $min / 60;
+    if ($tohr =~ /^[a-z]/) {
+       $outat = 12;            # something innocuous
+    } else {
+       $outat = $tohr + $tomin / 60;
+    }
+
+  last if $seen + ($inat < 8) > 1;
+
+    if ($inat < 5 || $inat > 21 || $outat < 6 || $outat > 23) {
+       print;
+    }
+}
diff --git a/eg/scan/scan_messages b/eg/scan/scan_messages
new file mode 100644 (file)
index 0000000..6f8ab2b
--- /dev/null
@@ -0,0 +1,222 @@
+#!/usr/bin/perl -P
+
+# $Header: scan_messages,v 2.0 88/06/05 00:17:46 root Exp $
+
+# This prints out extraordinary console messages.  You'll need to customize.
+
+chdir('/usr/adm/private/memories') || die "Can't cd.";
+
+$maxpos = `cat oldmsgs 2>&1`;
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+open(Msgs, '/dev/null') || die "scan_messages: can't open messages";
+#else
+open(Msgs, '/usr/adm/messages') || die "scan_messages: can't open messages";
+#endif
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat(Msgs);
+
+if ($size < $maxpos) {         # Did somebody truncate messages file?
+    $maxpos = 0;
+}
+
+seek(Msgs,$maxpos,0);          # Start where we left off last time.
+
+while (<Msgs>) {
+    s/\[(\d+)\]/#/ && s/$1/#/g;
+#ifdef vax
+    $_ =~ s/[A-Z][a-z][a-z] +\w+ +[0-9:]+ +\w+ +//;
+    next if /root@.*:/;
+    next if /^vmunix: 4.3 BSD UNIX/;
+    next if /^vmunix: Copyright/;
+    next if /^vmunix: avail mem =/;
+    next if /^vmunix: SBIA0 at /;
+    next if /^vmunix: disk ra81 is/;
+    next if /^vmunix: dmf. at uba/;
+    next if /^vmunix: dmf.:.*asynch/;
+    next if /^vmunix: ex. at uba/;
+    next if /^vmunix: ex.: HW/;
+    next if /^vmunix: il. at uba/;
+    next if /^vmunix: il.: hardware/;
+    next if /^vmunix: ra. at uba/;
+    next if /^vmunix: ra.: media/;
+    next if /^vmunix: real mem/;
+    next if /^vmunix: syncing disks/;
+    next if /^vmunix: tms/;
+    next if /^vmunix: tmscp. at uba/;
+    next if /^vmunix: uba. at /;
+    next if /^vmunix: uda. at /;
+    next if /^vmunix: uda.: unit . ONLIN/;
+    next if /^vmunix: .*buffers containing/;
+    next if /^syslogd: .*newslog/;
+#endif
+    next if /unknown service/;
+    next if /^\.\.\.$/;
+    if (/^[A-Z][a-z][a-z] [ 0-9][0-9] [ 0-9][0-9]:[0-9][0-9]/) {
+       $pfx = '';
+       next;
+    }
+    next if /^[ \t]*$/;
+    next if /^[ 0-9]*done$/;
+    if (/^A/) {
+       next if /^Accounting [sr]/;
+    }
+    elsif (/^C/) {
+       next if /^Called from/;
+       next if /^Copyright/;
+    }
+    elsif (/^E/) {
+       next if /^End traceback/;
+       next if /^Ethernet address =/;
+    }
+    elsif (/^K/) {
+       next if /^KERNEL MODE/;
+    }
+    elsif (/^R/) {
+       next if /^Rebooting Unix/;
+    }
+    elsif (/^S/) {
+       next if /^Sun UNIX 4\.2 Release/;
+    }
+    elsif (/^W/) {
+       next if /^WARNING: clock gained/;
+    }
+    elsif (/^a/) {
+       next if /^arg /;
+       next if /^avail mem =/;
+    }
+    elsif (/^b/) {
+       next if /^bwtwo[0-9] at /;
+    }
+    elsif (/^c/) {
+       next if /^cgone[0-9] at /;
+       next if /^cdp[0-9] at /;
+       next if /^csr /;
+    }
+    elsif (/^d/) {
+       next if /^dcpa: init/;
+       next if /^done$/;
+       next if /^dts/;
+       next if /^dump i\/o error/;
+       next if /^dumping to dev/;
+       next if /^dump succeeded/;
+       $pfx = '*' if /^dev = /;
+    }
+    elsif (/^e/) {
+       next if /^end \*\*/;
+       next if /^error in copy/;
+    }
+    elsif (/^f/) {
+       next if /^found /;
+    }
+    elsif (/^i/) {
+       next if /^ib[0-9] at /;
+       next if /^ie[0-9] at /;
+    }
+    elsif (/^l/) {
+       next if /^le[0-9] at /;
+    }
+    elsif (/^m/) {
+       next if /^mem = /;
+       next if /^mt[0-9] at /;
+       next if /^mti[0-9] at /;
+       $pfx = '*' if /^mode = /;
+    }
+    elsif (/^n/) {
+       next if /^not found /;
+    }
+    elsif (/^p/) {
+       next if /^page map /;
+       next if /^pi[0-9] at /;
+       $pfx = '*' if /^panic/;
+    }
+    elsif (/^q/) {
+       next if /^qqq /;
+    }
+    elsif (/^r/) {
+       next if /^read  /;
+       next if /^revarp: Requesting/;
+       next if /^root [od]/;
+    }
+    elsif (/^s/) {
+       next if /^sc[0-9] at /;
+       next if /^sd[0-9] at /;
+       next if /^sd[0-9]: </;
+       next if /^si[0-9] at /;
+       next if /^si_getstatus/;
+       next if /^sk[0-9] at /;
+       next if /^skioctl/;
+       next if /^skopen/;
+       next if /^skprobe/;
+       next if /^skread/;
+       next if /^skwrite/;
+       next if /^sky[0-9] at /;
+       next if /^st[0-9] at /;
+       next if /^st0:.*load/;
+       next if /^stat1 = /;
+       next if /^syncing disks/;
+       next if /^syslogd: going down on signal 15/;
+    }
+    elsif (/^t/) {
+       next if /^timeout [0-9]/;
+       next if /^tm[0-9] at /;
+       next if /^tod[0-9] at /;
+       next if /^tv [0-9]/;
+       $pfx = '*' if /^trap address/;
+    }
+    elsif (/^u/) {
+       next if /^unit nsk/;
+       next if /^use one of/;
+       $pfx = '' if /^using/;
+       next if /^using [0-9]+ buffers/;
+    }
+    elsif (/^x/) {
+       next if /^xy[0-9] at /;
+       next if /^write [0-9]/;
+       next if /^xy[0-9]: </;
+       next if /^xyc[0-9] at /;
+    }
+    elsif (/^y/) {
+       next if /^yyy [0-9]/;
+    }
+    elsif (/^z/) {
+       next if /^zs[0-9] at /;
+    }
+    $pfx = '*' if /^[a-z]+:$/;
+    s/pid [0-9]+: //;
+    if (/last message repeated ([0-9]+) time/) {
+       $seen{$last} += $1;
+       next;
+    }
+    s/^/$pfx/ if $pfx;
+    unless ($seen{$_}++) {
+       push(@seen,$_);
+    }
+    $last = $_;
+}
+$max = tell(Msgs);
+
+open(tmp,'|sort >oldmsgs.tmp') || die "Can't create tmp file.";
+while ($_ = pop(@seen)) {
+    print tmp $_;
+}
+close(tmp);
+open(tmp,'oldmsgs.tmp') || die "Can't reopen tmp file.";
+while (<tmp>) {
+    if (/^nd:/) {
+       next if $seen{$_} < 20;
+    }
+    if (/NFS/) {
+       next if $seen{$_} < 20;
+    }
+    if (/no carrier/) {
+       next if $seen{$_} < 20;
+    }
+    if (/silo overflow/) {
+       next if $seen{$_} < 20;
+    }
+    print $seen{$_},":\t",$_;
+}
+
+print `rm -f oldmsgs.tmp 2>&1; echo $max > oldmsgs 2>&1`;
diff --git a/eg/scan/scan_passwd b/eg/scan/scan_passwd
new file mode 100644 (file)
index 0000000..62ef1e7
--- /dev/null
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+# $Header: scan_passwd,v 2.0 88/06/05 00:17:49 root Exp $
+
+# This scans passwd file for security holes.
+
+open(Pass,'/etc/passwd') || die "Can't open passwd file";
+# $dotriv = (`date` =~ /^Mon/);
+$dotriv = 1;
+
+while (<Pass>) {
+    ($login,$pass,$uid,$gid,$gcos,$home,$shell) = split(/:/);
+    if ($shell eq '') {
+       print "Short: $_";
+    }
+    next if /^[+]/;
+    if ($pass eq '') {
+       if (index(":sync:lpq:+:", ":$login:") < 0) {
+           print "No pass: $login\t$gcos\n";
+       }
+    }
+    elsif ($dotriv && crypt($login,substr($pass,0,2)) eq $pass) {
+       print "Trivial: $login\t$gcos\n";
+    }
+    if ($uid == 0) {
+       if ($login !~ /^.?root$/ && $pass ne '*') {
+           print "Extra root: $_";
+       }
+    }
+}
diff --git a/eg/scan/scan_ps b/eg/scan/scan_ps
new file mode 100644 (file)
index 0000000..bb33b87
--- /dev/null
@@ -0,0 +1,32 @@
+#!/usr/bin/perl -P
+
+# $Header: scan_ps,v 2.0 88/06/05 00:17:51 root Exp $
+
+# This looks for looping processes.
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+open(Ps, '/bin/ps -el|') || die "scan_ps: can't run ps";
+
+while (<Ps>) {
+    next if /rwhod/;
+    print if index(' T', substr($_,62,1)) < 0;
+}
+#else
+open(Ps, '/bin/ps auxww|') || die "scan_ps: can't run ps";
+
+while (<Ps>) {
+    next if /dataserver/;
+    next if /nfsd/;
+    next if /update/;
+    next if /ypserv/;
+    next if /rwhod/;
+    next if /routed/;
+    next if /pagedaemon/;
+#ifdef vax
+    ($user,$pid,$cpu,$mem,$sz,$rss,$tt,$stat,$start,$time) = split;
+#else
+    ($user,$pid,$cpu,$mem,$sz,$rss,$tt,$stat,$time) = split;
+#endif
+    print if length($time) > 4;
+}
+#endif
diff --git a/eg/scan/scan_sudo b/eg/scan/scan_sudo
new file mode 100644 (file)
index 0000000..e0a99ee
--- /dev/null
@@ -0,0 +1,54 @@
+#!/usr/bin/perl -P
+
+# $Header: scan_sudo,v 2.0 88/06/05 00:18:01 root Exp $
+
+# Analyze the sudo log.
+
+chdir('/usr/adm/private/memories') || die "Can't cd.";
+
+if (open(Oldsudo,'oldsudo')) {
+    $maxpos = <Oldsudo>;
+    close Oldsudo;
+}
+else {
+    $maxpos = 0;
+    `echo 0 >oldsudo`;
+}
+
+unless (open(Sudo, '/usr/adm/sudo.log')) {
+    print "Somebody removed sudo.log!!!\n" if $maxpos;
+    exit 0;
+}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat(Sudo);
+
+if ($size < $maxpos) {
+    $maxpos = 0;
+    print "Somebody reset sudo.log!!!\n";
+}
+
+seek(Sudo,$maxpos,0);
+
+while (<Sudo>) {
+    s/^.* :[ \t]+//;
+    s/ipcrm.*/ipcrm/;
+    s/kill.*/kill/;
+    unless ($seen{$_}++) {
+       push(@seen,$_);
+    }
+    $last = $_;
+}
+$max = tell(Sudo);
+
+open(tmp,'|sort >oldsudo.tmp') || die "Can't create tmp file.";
+while ($_ = pop(@seen)) {
+    print tmp $_;
+}
+close(tmp);
+open(tmp,'oldsudo.tmp') || die "Can't reopen tmp file.";
+while (<tmp>) {
+    print $seen{$_},":\t",$_;
+}
+
+print `(rm -f oldsudo.tmp; echo $max > oldsudo) 2>&1`;
diff --git a/eg/scan/scan_suid b/eg/scan/scan_suid
new file mode 100644 (file)
index 0000000..4f62705
--- /dev/null
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -P
+
+# $Header: scan_suid,v 2.0 88/06/05 00:17:54 root Exp $
+
+# Look for new setuid root files.
+
+chdir '/usr/adm/private/memories' || die "Can't cd.";
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat('oldsuid');
+if ($nlink) {
+    $lasttime = $mtime;
+    $tmp = $ctime - $atime;
+    if ($tmp <= 0 || $tmp >= 10) {
+       print "WARNING: somebody has read oldsuid!\n";
+    }
+    $tmp = $ctime - $mtime;
+    if ($tmp <= 0 || $tmp >= 10) {
+       print "WARNING: somebody has modified oldsuid!!!\n";
+    }
+} else {
+    $lasttime = time - 60 * 60 * 24;   # one day ago
+}
+$thistime = time;
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+open(Find, 'find / -perm -04000 -print |') ||
+       die "scan_find: can't run find";
+#else
+open(Find, 'find / \( -fstype nfs -prune \) -o -perm -04000 -ls |') ||
+       die "scan_find: can't run find";
+#endif
+
+open(suid, '>newsuid.tmp');
+
+while (<Find>) {
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+    $x = `/bin/ls -il $_`;
+    $_ = $x;
+    s/^ *//;
+    ($inode,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
+      = split;
+#else
+    s/^ *//;
+    ($inode,$blocks,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
+      = split;
+#endif
+
+    if ($perm =~ /[sS]/ && $owner eq 'root') {
+       ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+          $blksize,$blocks) = stat($name);
+       $foo = sprintf("%10s%3s %-8s %-8s%9s %3s %2s %s %s\n",
+               $perm,$links,$owner,$group,$size,$month,$day,$name,$inode);
+       print suid $foo;
+       if ($ctime > $lasttime) {
+           if ($ctime > $thistime) {
+               print "Future file: $foo";
+           }
+           else {
+               $ct .= $foo;
+           }
+       }
+    }
+}
+close(suid);
+
+print `sort +7 -8 newsuid.tmp >newsuid 2>&1`;
+$foo = `/bin/diff oldsuid newsuid 2>&1`;
+print "Differences in suid info:\n",$foo if $foo;
+print `mv oldsuid oldoldsuid 2>&1; mv newsuid oldsuid 2>&1`;
+print `touch oldsuid 2>&1;sleep 2 2>&1;chmod o+w oldsuid 2>&1`;
+print `rm -f newsuid.tmp 2>&1`;
+
+@ct = split(/\n/,$ct);
+$ct = '';
+$* = 1;
+while ($#ct >= 0) {
+    $tmp = shift(@ct);
+    unless ($foo =~ "^>.*$tmp\n") { $ct .= "$tmp\n"; }
+}
+
+print "Inode changed since last time:\n",$ct if $ct;
+
diff --git a/eg/scan/scanner b/eg/scan/scanner
new file mode 100644 (file)
index 0000000..25e953d
--- /dev/null
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+
+# $Header: scanner,v 2.0 88/06/05 00:17:42 root Exp $
+
+# This runs all the scan_* routines on all the machines in /etc/ghosts.
+# We run this every morning at about 6 am:
+
+#      !/bin/sh
+#      cd /usr/adm/private
+#      decrypt scanner | perl >scan.out 2>&1
+#      mail admin <scan.out
+
+# Note that the scan_* files should be encrypted with the key "-inquire", and
+# scanner should be encrypted somehow so that people can't find that key.
+# I leave it up to you to figure out how to unencrypt it before executing.
+
+$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/ucb:.';
+
+$| = 1;                # command buffering on stdout
+
+print "Subject: bizarre happenings\n\n";
+
+(chdir '/usr/adm/private') || die "Can't cd.";
+
+if ($#ARGV >= 0) {
+    @scanlist = @ARGV;
+} else {
+    @scanlist = split(/[ \t\n]+/,`echo scan_*`);
+}
+
+scan: while ($scan = shift(@scanlist)) {
+    print "\n********** $scan **********\n";
+    $showhost++;
+
+    $systype = 'all';
+
+    open(ghosts, '/etc/ghosts') || die 'No /etc/ghosts file';
+
+    $one_of_these = ":$systype:";
+    if ($systype =~ s/\+/[+]/g) {
+       $one_of_these =~ s/\+/:/g;
+    }
+
+    line: while (<ghosts>) {
+       s/[ \t]*\n//;
+       if (!$_ || /^#/) {
+           next line;
+       }
+       if (/^([a-zA-Z_0-9]+)=(.+)/) {
+           $name = $1; $repl = $2;
+           $repl =~ s/\+/:/g;
+           $one_of_these =~ s/:$name:/:$repl:/;
+           next line;
+       }
+       @gh = split;
+       $host = $gh[0];
+       if ($showhost) { $showhost = "$host:\t"; }
+       class: while ($class = pop(gh)) {
+           if (index($one_of_these,":$class:") >=0) {
+               $iter = 0;
+               `exec crypt -inquire <$scan >.x 2>/dev/null`;
+               unless (open(scan,'.x')) {
+                   print "Can't run $scan.";
+                   next scan;
+               }
+               $cmd = <scan>;
+               unless ($cmd =~ s/#!(.*)\n/$1/) {
+                   $cmd = '/usr/bin/perl';
+               }
+               close(scan);
+               if (open(pipe,"exec rsh $host '$cmd' <.x|")) {
+                   sleep(5);
+                   unlink '.x';
+                   while (<pipe>) {
+                       last if $iter++ > 1000;         # must be looping
+                       next if /^[0-9.]+u [0-9.]+s/;
+                       print $showhost,$_;
+                   }
+                   close(pipe);
+               } else {
+                   print "(Can't execute rsh.)\n";
+               }
+               last class;
+           }
+       }
+    }
+}
diff --git a/eg/shmkill b/eg/shmkill
new file mode 100644 (file)
index 0000000..ba288d8
--- /dev/null
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+# $Header: shmkill,v 2.0 88/06/05 00:16:59 root Exp $
+
+# A script to call from crontab periodically when people are leaving shared
+# memory sitting around unattached.
+
+open(ipcs,'ipcs -m -o|') || die "Can't run ipcs";
+
+while (<ipcs>) {
+    $tmp = index($_,'NATTCH');
+    $pos = $tmp if $tmp >= 0;
+    if (/^m/) {
+       ($m,$id,$key,$mode,$owner,$group,$attach) = split;
+       if ($attach != substr($_,$pos,6)) {
+           die "Different ipcs format--can't parse!";
+       }
+       if ($attach == 0) {
+           push(@goners,'-m',$id);
+       }
+    }
+}
+
+exec 'ipcrm', @goners if $#goners >= 0;
diff --git a/eg/van/empty b/eg/van/empty
new file mode 100644 (file)
index 0000000..11a5558
--- /dev/null
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+# $Header: empty,v 2.0 88/06/05 00:17:39 root Exp $
+
+# This script empties a trashcan.
+
+$recursive = shift if $ARGV[0] eq '-r';
+
+@ARGV = '.' if $#ARGV < 0;
+
+chop($pwd = `pwd`);
+
+dir: foreach $dir (@ARGV) {
+    unless (chdir $dir) {
+       print stderr "Can't find directory $dir\n";
+       next dir;
+    }
+    if ($recursive) {
+       do cmd('find . -name .deleted -exec /bin/rm -rf {} ;');
+    }
+    else {
+       if (-d '.deleted') {
+           do cmd('rm -rf .deleted');
+       }
+       else {
+           if ($dir eq '.' && $pwd =~ m|/\.deleted$|) {
+               chdir '..';
+               do cmd('rm -rf .deleted');
+           }
+           else {
+               print stderr "No trashcan found in directory $dir\n";
+           }
+       }
+    }
+}
+continue {
+    chdir $pwd;
+}
+
+# force direct execution with no shell
+
+sub cmd {
+    system split(' ',join(' ',@_));
+}
+
diff --git a/eg/van/unvanish b/eg/van/unvanish
new file mode 100644 (file)
index 0000000..4a83c81
--- /dev/null
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+# $Header: unvanish,v 2.0 88/06/05 00:17:30 root Exp $
+
+sub it {
+    if ($olddir ne '.') {
+       chop($pwd = `pwd`) if $pwd eq '';
+       (chdir $olddir) || die "Directory $olddir is not accesible";
+    }
+    unless ($olddir eq '.deleted') {
+       if (-d '.deleted') {
+           chdir '.deleted' || die "Directory .deleted is not accesible";
+       }
+       else {
+           chop($pwd = `pwd`) if $pwd eq '';
+           die "Directory .deleted does not exist" unless $pwd =~ /\.deleted$/;
+       }
+    }
+    print `mv $startfiles$filelist..$force`;
+    if ($olddir ne '.') {
+       (chdir $pwd) || die "Can't get back to original directory: $pwd";
+    }
+}
+
+if ($#ARGV < 0) {
+    open(lastcmd,'.deleted/.lastcmd') || 
+       open(lastcmd,'.lastcmd') || 
+           die "No previous vanish in this dir";
+    $ARGV = <lastcmd>;
+    close(lastcmd);
+    @ARGV = split(/[\n ]+/,$ARGV);
+}
+
+while ($ARGV[0] =~ /^-/) {
+    $_ = shift;
+    /^-f/ && ($force = ' >/dev/null 2>&1');
+    /^-i/ && ($interactive = 1);
+    if (/^-+$/) {
+       $startfiles = '- ';
+       last;
+    }
+}
+
+while ($file = shift) {
+    if ($file =~ s|^(.*)/||) {
+       $dir = $1;
+    }
+    else {
+       $dir = '.';
+    }
+
+    if ($dir ne $olddir) {
+       do it() if $olddir;
+       $olddir = $dir;
+    }
+
+    if ($interactive) {
+       print "unvanish: restore $dir/$file? ";
+       next unless <stdin> =~ /^y/i;
+    }
+
+    $filelist .= $file; $filelist .= ' ';
+
+}
+
+do it() if $olddir;
diff --git a/eg/van/vanexp b/eg/van/vanexp
new file mode 100644 (file)
index 0000000..29b42e8
--- /dev/null
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+# $Header: vanexp,v 2.0 88/06/05 00:17:34 root Exp $
+
+# This is for running from a find at night to expire old .deleteds
+
+$can = $ARGV[0];
+
+exit 1 unless $can =~ /.deleted$/;
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($can);
+
+exit 0 unless $size;
+
+if (time - $mtime > 2 * 24 * 60 * 60) {
+    `/bin/rm -rf $can`;
+}
+else {
+    `find $can -ctime +2 -exec rm -f {} \;`;
+}
diff --git a/eg/van/vanish b/eg/van/vanish
new file mode 100644 (file)
index 0000000..b665e7c
--- /dev/null
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+# $Header: vanish,v 2.0 88/06/05 00:17:36 root Exp $
+
+sub it {
+    if ($olddir ne '.') {
+       chop($pwd = `pwd`) if $pwd eq '';
+       (chdir $olddir) || die "Directory $olddir is not accesible";
+    }
+    if (!-d .deleted) {
+       print `mkdir .deleted; chmod 775 .deleted`;
+       die "You can't remove files from $olddir" if $?;
+    }
+    $filelist =~ s/ $//;
+    $filelist =~ s/#/\\#/g;
+    if ($filelist !~ /^[ \t]*$/) {
+       open(lastcmd,'>.deleted/.lastcmd');
+       print lastcmd $filelist,"\n";
+       close(lastcmd);
+       print `/bin/mv $startfiles$filelist .deleted$force`;
+    }
+    if ($olddir ne '.') {
+       (chdir $pwd) || die "Can't get back to original directory: $pwd";
+    }
+}
+
+while ($ARGV[0] =~ /^-/) {
+    $_ = shift;
+    /^-f/ && ($force = ' >/dev/null 2>&1');
+    /^-i/ && ($interactive = 1);
+    if (/^-+$/) {
+       $startfiles = '- ';
+       last;
+    }
+}
+
+chop($pwd = `pwd`);
+
+while ($file = shift) {
+    if ($file =~ s|^(.*)/||) {
+       $dir = $1;
+    }
+    else {
+       $dir = '.';
+    }
+
+    if ($interactive) {
+       print "vanish: remove $dir/$file? ";
+       next unless <stdin> =~ /^y/i;
+    }
+
+    if ($file eq '.deleted') {
+       print stderr "To delete .deleted (the trashcan) use the 'empty' command.\n";
+       next;
+    }
+
+    if ($dir ne $olddir) {
+       do it() if $olddir;
+       $olddir = $dir;
+    }
+
+    $filelist .= $file; $filelist .= ' ';
+}
+
+do it() if $olddir;
diff --git a/eval.c b/eval.c
new file mode 100644 (file)
index 0000000..78a06cb
--- /dev/null
+++ b/eval.c
@@ -0,0 +1,1435 @@
+/* $Header: eval.c,v 2.0 88/06/05 00:08:48 root Exp $
+ *
+ * $Log:       eval.c,v $
+ * Revision 2.0  88/06/05  00:08:48  root
+ * Baseline version 2.0.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#include <signal.h>
+#include <errno.h>
+
+extern int errno;
+
+#ifdef VOIDSIG
+static void (*ihand)();
+static void (*qhand)();
+#else
+static int (*ihand)();
+static int (*qhand)();
+#endif
+
+ARG *debarg;
+STR str_args;
+
+STR *
+eval(arg,retary,sargoff)
+register ARG *arg;
+STR ***retary;         /* where to return an array to, null if nowhere */
+int sargoff;           /* how many elements in sarg are already assigned */
+{
+    register STR *str;
+    register int anum;
+    register int optype;
+    int maxarg;
+    int maxsarg;
+    double value;
+    STR *quicksarg[5];
+    register STR **sarg = quicksarg;
+    register char *tmps;
+    char *tmps2;
+    int argflags;
+    int argtype;
+    union argptr argptr;
+    int cushion;
+    unsigned long tmplong;
+    long when;
+    FILE *fp;
+    STR *tmpstr;
+    FCMD *form;
+    STAB *stab;
+    ARRAY *ary;
+    bool assigning = FALSE;
+    double exp(), log(), sqrt(), modf();
+    char *crypt(), *getenv();
+
+    if (!arg)
+       return &str_no;
+    str = arg->arg_ptr.arg_str;
+    optype = arg->arg_type;
+    maxsarg = maxarg = arg->arg_len;
+    if (maxsarg > 3 || retary) {
+       if (sargoff >= 0) {     /* array already exists, just append to it */
+           cushion = 10;
+           sarg = (STR **)saferealloc((char*)*retary,
+             (maxsarg+sargoff+2+cushion) * sizeof(STR*)) + sargoff;
+             /* Note that sarg points into the middle of the array */
+       }
+       else {
+           sargoff = cushion = 0;
+           sarg = (STR **)safemalloc((maxsarg+2) * sizeof(STR*));
+       }
+    }
+    else
+       sargoff = 0;
+#ifdef DEBUGGING
+    if (debug) {
+       if (debug & 8) {
+           deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
+       }
+       debname[dlevel] = opname[optype][0];
+       debdelim[dlevel++] = ':';
+    }
+#endif
+    for (anum = 1; anum <= maxarg; anum++) {
+       argflags = arg[anum].arg_flags;
+       if (argflags & AF_SPECIAL)
+           continue;
+       argtype = arg[anum].arg_type;
+       argptr = arg[anum].arg_ptr;
+      re_eval:
+       switch (argtype) {
+       default:
+           sarg[anum] = &str_no;
+#ifdef DEBUGGING
+           tmps = "NULL";
+#endif
+           break;
+       case A_EXPR:
+#ifdef DEBUGGING
+           if (debug & 8) {
+               tmps = "EXPR";
+               deb("%d.EXPR =>\n",anum);
+           }
+#endif
+           if (retary &&
+             (optype == O_LIST || optype == O_ITEM2 || optype == O_ITEM3)) {
+               *retary = sarg - sargoff;
+               eval(argptr.arg_arg, retary, anum - 1 + sargoff);
+               sarg = *retary;         /* they do realloc it... */
+               argtype = maxarg - anum;        /* how many left? */
+               maxsarg = (int)(str_gnum(sarg[0])) + argtype;
+               sargoff = maxsarg - maxarg;
+               if (argtype > 9 - cushion) {    /* we don't have room left */
+                   sarg = (STR **)saferealloc((char*)sarg,
+                     (maxsarg+2+cushion) * sizeof(STR*));
+               }
+               sarg += sargoff;
+           }
+           else
+               sarg[anum] = eval(argptr.arg_arg, Null(STR***),-1);
+           break;
+       case A_CMD:
+#ifdef DEBUGGING
+           if (debug & 8) {
+               tmps = "CMD";
+               deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
+           }
+#endif
+           sarg[anum] = cmd_exec(argptr.arg_cmd);
+           break;
+       case A_STAB:
+           sarg[anum] = STAB_STR(argptr.arg_stab);
+#ifdef DEBUGGING
+           if (debug & 8) {
+               sprintf(buf,"STAB $%s",argptr.arg_stab->stab_name);
+               tmps = buf;
+           }
+#endif
+           break;
+       case A_LEXPR:
+#ifdef DEBUGGING
+           if (debug & 8) {
+               tmps = "LEXPR";
+               deb("%d.LEXPR =>\n",anum);
+           }
+#endif
+           str = eval(argptr.arg_arg,Null(STR***),-1);
+           if (!str)
+               fatal("panic: A_LEXPR");
+           goto do_crement;
+       case A_LVAL:
+#ifdef DEBUGGING
+           if (debug & 8) {
+               sprintf(buf,"LVAL $%s",argptr.arg_stab->stab_name);
+               tmps = buf;
+           }
+#endif
+           str = STAB_STR(argptr.arg_stab);
+           if (!str)
+               fatal("panic: A_LVAL");
+         do_crement:
+           assigning = TRUE;
+           if (argflags & AF_PRE) {
+               if (argflags & AF_UP)
+                   str_inc(str);
+               else
+                   str_dec(str);
+               STABSET(str);
+               sarg[anum] = str;
+               str = arg->arg_ptr.arg_str;
+           }
+           else if (argflags & AF_POST) {
+               sarg[anum] = str_static(str);
+               if (argflags & AF_UP)
+                   str_inc(str);
+               else
+                   str_dec(str);
+               STABSET(str);
+               str = arg->arg_ptr.arg_str;
+           }
+           else {
+               sarg[anum] = str;
+           }
+           break;
+       case A_LARYLEN:
+           str = sarg[anum] =
+             argptr.arg_stab->stab_array->ary_magic;
+#ifdef DEBUGGING
+           tmps = "LARYLEN";
+#endif
+           if (!str)
+               fatal("panic: A_LEXPR");
+           goto do_crement;
+       case A_ARYLEN:
+           stab = argptr.arg_stab;
+           sarg[anum] = stab->stab_array->ary_magic;
+           str_numset(sarg[anum],(double)(stab->stab_array->ary_fill+arybase));
+#ifdef DEBUGGING
+           tmps = "ARYLEN";
+#endif
+           break;
+       case A_SINGLE:
+           sarg[anum] = argptr.arg_str;
+#ifdef DEBUGGING
+           tmps = "SINGLE";
+#endif
+           break;
+       case A_DOUBLE:
+           (void) interp(str,str_get(argptr.arg_str));
+           sarg[anum] = str;
+#ifdef DEBUGGING
+           tmps = "DOUBLE";
+#endif
+           break;
+       case A_BACKTICK:
+           tmps = str_get(argptr.arg_str);
+           fp = popen(str_get(interp(str,tmps)),"r");
+           tmpstr = str_new(80);
+           str_set(str,"");
+           if (fp) {
+               while (str_gets(tmpstr,fp) != Nullch) {
+                   str_scat(str,tmpstr);
+               }
+               statusvalue = pclose(fp);
+           }
+           else
+               statusvalue = -1;
+           str_free(tmpstr);
+
+           sarg[anum] = str;
+#ifdef DEBUGGING
+           tmps = "BACK";
+#endif
+           break;
+       case A_INDREAD:
+           last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
+           goto do_read;
+       case A_GLOB:
+           argflags |= AF_POST;        /* enable newline chopping */
+       case A_READ:
+           last_in_stab = argptr.arg_stab;
+         do_read:
+           fp = Nullfp;
+           if (last_in_stab->stab_io) {
+               fp = last_in_stab->stab_io->fp;
+               if (!fp) {
+                   if (last_in_stab->stab_io->flags & IOF_ARGV) {
+                       if (last_in_stab->stab_io->flags & IOF_START) {
+                           last_in_stab->stab_io->flags &= ~IOF_START;
+                           last_in_stab->stab_io->lines = 0;
+                           if (alen(last_in_stab->stab_array) < 0) {
+                               tmpstr = str_make("-"); /* assume stdin */
+                               apush(last_in_stab->stab_array, tmpstr);
+                           }
+                       }
+                       fp = nextargv(last_in_stab);
+                       if (!fp)  /* Note: fp != last_in_stab->stab_io->fp */
+                           do_close(last_in_stab,FALSE);  /* now it does */
+                   }
+                   else if (argtype == A_GLOB) {
+                       (void) interp(str,str_get(last_in_stab->stab_val));
+                       tmps = str->str_ptr;
+                       if (*tmps == '!')
+                           sprintf(tokenbuf,"%s|",tmps+1);
+                       else {
+                           if (*tmps == ';')
+                               sprintf(tokenbuf, "%s", tmps+1);
+                           else
+                               sprintf(tokenbuf, "echo %s", tmps);
+                           strcat(tokenbuf,
+                             "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
+                       }
+                       do_open(last_in_stab,tokenbuf);
+                       fp = last_in_stab->stab_io->fp;
+                   }
+               }
+           }
+           if (!fp && dowarn)
+               warn("Read on closed filehandle <%s>",last_in_stab->stab_name);
+         keepgoing:
+           if (!fp)
+               sarg[anum] = &str_no;
+           else if (!str_gets(str,fp)) {
+               if (last_in_stab->stab_io->flags & IOF_ARGV) {
+                   fp = nextargv(last_in_stab);
+                   if (fp)
+                       goto keepgoing;
+                   do_close(last_in_stab,FALSE);
+                   last_in_stab->stab_io->flags |= IOF_START;
+               }
+               else if (argflags & AF_POST) {
+                   do_close(last_in_stab,FALSE);
+               }
+               if (fp == stdin) {
+                   clearerr(fp);
+               }
+               sarg[anum] = &str_no;
+               if (retary) {
+                   maxarg = anum - 1;
+                   maxsarg = maxarg + sargoff;
+               }
+               break;
+           }
+           else {
+               last_in_stab->stab_io->lines++;
+               sarg[anum] = str;
+               if (argflags & AF_POST) {
+                   if (str->str_cur > 0)
+                       str->str_cur--;
+                   str->str_ptr[str->str_cur] = '\0';
+               }
+               if (retary) {
+                   sarg[anum] = str_static(sarg[anum]);
+                   anum++;
+                   if (anum > maxarg) {
+                       maxarg = anum + anum;
+                       maxsarg = maxarg + sargoff;
+                       sarg = (STR **)saferealloc((char*)(sarg-sargoff),
+                         (maxsarg+2+cushion) * sizeof(STR*)) + sargoff;
+                   }
+                   goto keepgoing;
+               }
+           }
+           if (retary) {
+               maxarg = anum - 1;
+               maxsarg = maxarg + sargoff;
+           }
+#ifdef DEBUGGING
+           tmps = "READ";
+#endif
+           break;
+       }
+#ifdef DEBUGGING
+       if (debug & 8)
+           deb("%d.%s = '%s'\n",anum,tmps,str_peek(sarg[anum]));
+#endif
+    }
+    switch (optype) {
+    case O_ITEM:
+       if (maxarg > arg->arg_len)
+           goto array_return;
+       if (str != sarg[1])
+           str_sset(str,sarg[1]);
+       STABSET(str);
+       break;
+    case O_ITEM2:
+       if (str != sarg[--anum])
+           str_sset(str,sarg[anum]);
+       STABSET(str);
+       break;
+    case O_ITEM3:
+       if (str != sarg[--anum])
+           str_sset(str,sarg[anum]);
+       STABSET(str);
+       break;
+    case O_CONCAT:
+       if (str != sarg[1])
+           str_sset(str,sarg[1]);
+       str_scat(str,sarg[2]);
+       STABSET(str);
+       break;
+    case O_REPEAT:
+       if (str != sarg[1])
+           str_sset(str,sarg[1]);
+       anum = (int)str_gnum(sarg[2]);
+       if (anum >= 1) {
+           tmpstr = str_new(0);
+           str_sset(tmpstr,str);
+           while (--anum > 0)
+               str_scat(str,tmpstr);
+       }
+       else
+           str_sset(str,&str_no);
+       STABSET(str);
+       break;
+    case O_MATCH:
+       str_sset(str, do_match(arg,
+         retary,sarg,&maxsarg,sargoff,cushion));
+       if (retary) {
+           sarg = *retary;     /* they realloc it */
+           goto array_return;
+       }
+       STABSET(str);
+       break;
+    case O_NMATCH:
+       str_sset(str, do_match(arg,
+         retary,sarg,&maxsarg,sargoff,cushion));
+       if (retary) {
+           sarg = *retary;     /* they realloc it */
+           goto array_return;  /* ignore negation */
+       }
+       str_set(str, str_true(str) ? No : Yes);
+       STABSET(str);
+       break;
+    case O_SUBST:
+       value = (double) do_subst(str, arg);
+       str = arg->arg_ptr.arg_str;
+       goto donumset;
+    case O_NSUBST:
+       str_set(arg->arg_ptr.arg_str, do_subst(str, arg) ? No : Yes);
+       str = arg->arg_ptr.arg_str;
+       break;
+    case O_ASSIGN:
+       if (arg[1].arg_flags & AF_SPECIAL)
+           do_assign(str,arg,sarg);
+       else {
+           if (str != sarg[2])
+               str_sset(str, sarg[2]);
+           STABSET(str);
+       }
+       break;
+    case O_CHOP:
+       tmps = str_get(str);
+       tmps += str->str_cur - (str->str_cur != 0);
+       str_set(arg->arg_ptr.arg_str,tmps);     /* remember last char */
+       *tmps = '\0';                           /* wipe it out */
+       str->str_cur = tmps - str->str_ptr;
+       str->str_nok = 0;
+       str = arg->arg_ptr.arg_str;
+       break;
+    case O_STUDY:
+       value = (double)do_study(str);
+       str = arg->arg_ptr.arg_str;
+       goto donumset;
+    case O_MULTIPLY:
+       value = str_gnum(sarg[1]);
+       value *= str_gnum(sarg[2]);
+       goto donumset;
+    case O_DIVIDE:
+       if ((value = str_gnum(sarg[2])) == 0.0)
+           fatal("Illegal division by zero");
+       value = str_gnum(sarg[1]) / value;
+       goto donumset;
+    case O_MODULO:
+       if ((tmplong = (unsigned long) str_gnum(sarg[2])) == 0L)
+           fatal("Illegal modulus zero");
+       value = str_gnum(sarg[1]);
+       value = (double)(((unsigned long)value) % tmplong);
+       goto donumset;
+    case O_ADD:
+       value = str_gnum(sarg[1]);
+       value += str_gnum(sarg[2]);
+       goto donumset;
+    case O_SUBTRACT:
+       value = str_gnum(sarg[1]);
+       value -= str_gnum(sarg[2]);
+       goto donumset;
+    case O_LEFT_SHIFT:
+       value = str_gnum(sarg[1]);
+       anum = (int)str_gnum(sarg[2]);
+       value = (double)(((unsigned long)value) << anum);
+       goto donumset;
+    case O_RIGHT_SHIFT:
+       value = str_gnum(sarg[1]);
+       anum = (int)str_gnum(sarg[2]);
+       value = (double)(((unsigned long)value) >> anum);
+       goto donumset;
+    case O_LT:
+       value = str_gnum(sarg[1]);
+       value = (double)(value < str_gnum(sarg[2]));
+       goto donumset;
+    case O_GT:
+       value = str_gnum(sarg[1]);
+       value = (double)(value > str_gnum(sarg[2]));
+       goto donumset;
+    case O_LE:
+       value = str_gnum(sarg[1]);
+       value = (double)(value <= str_gnum(sarg[2]));
+       goto donumset;
+    case O_GE:
+       value = str_gnum(sarg[1]);
+       value = (double)(value >= str_gnum(sarg[2]));
+       goto donumset;
+    case O_EQ:
+       value = str_gnum(sarg[1]);
+       value = (double)(value == str_gnum(sarg[2]));
+       goto donumset;
+    case O_NE:
+       value = str_gnum(sarg[1]);
+       value = (double)(value != str_gnum(sarg[2]));
+       goto donumset;
+    case O_BIT_AND:
+       value = str_gnum(sarg[1]);
+       value = (double)(((unsigned long)value) &
+           (unsigned long)str_gnum(sarg[2]));
+       goto donumset;
+    case O_XOR:
+       value = str_gnum(sarg[1]);
+       value = (double)(((unsigned long)value) ^
+           (unsigned long)str_gnum(sarg[2]));
+       goto donumset;
+    case O_BIT_OR:
+       value = str_gnum(sarg[1]);
+       value = (double)(((unsigned long)value) |
+           (unsigned long)str_gnum(sarg[2]));
+       goto donumset;
+    case O_AND:
+       if (str_true(sarg[1])) {
+           anum = 2;
+           optype = O_ITEM2;
+           argflags = arg[anum].arg_flags;
+           argtype = arg[anum].arg_type;
+           argptr = arg[anum].arg_ptr;
+           maxarg = anum = 1;
+           goto re_eval;
+       }
+       else {
+           if (assigning) {
+               str_sset(str, sarg[1]);
+               STABSET(str);
+           }
+           else
+               str = sarg[1];
+           break;
+       }
+    case O_OR:
+       if (str_true(sarg[1])) {
+           if (assigning) {
+               str_sset(str, sarg[1]);
+               STABSET(str);
+           }
+           else
+               str = sarg[1];
+           break;
+       }
+       else {
+           anum = 2;
+           optype = O_ITEM2;
+           argflags = arg[anum].arg_flags;
+           argtype = arg[anum].arg_type;
+           argptr = arg[anum].arg_ptr;
+           maxarg = anum = 1;
+           goto re_eval;
+       }
+    case O_COND_EXPR:
+       anum = (str_true(sarg[1]) ? 2 : 3);
+       optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
+       argflags = arg[anum].arg_flags;
+       argtype = arg[anum].arg_type;
+       argptr = arg[anum].arg_ptr;
+       maxarg = anum = 1;
+       goto re_eval;
+    case O_COMMA:
+       str = sarg[2];
+       break;
+    case O_NEGATE:
+       value = -str_gnum(sarg[1]);
+       goto donumset;
+    case O_NOT:
+       value = (double) !str_true(sarg[1]);
+       goto donumset;
+    case O_COMPLEMENT:
+       value = (double) ~(long)str_gnum(sarg[1]);
+       goto donumset;
+    case O_SELECT:
+       if (arg[1].arg_type == A_LVAL)
+           defoutstab = arg[1].arg_ptr.arg_stab;
+       else
+           defoutstab = stabent(str_get(sarg[1]),TRUE);
+       if (!defoutstab->stab_io)
+           defoutstab->stab_io = stio_new();
+       curoutstab = defoutstab;
+       str_set(str,curoutstab->stab_io->fp ? Yes : No);
+       STABSET(str);
+       break;
+    case O_WRITE:
+       if (maxarg == 0)
+           stab = defoutstab;
+       else if (arg[1].arg_type == A_LVAL)
+           stab = arg[1].arg_ptr.arg_stab;
+       else
+           stab = stabent(str_get(sarg[1]),TRUE);
+       if (!stab->stab_io) {
+           str_set(str, No);
+           STABSET(str);
+           break;
+       }
+       curoutstab = stab;
+       fp = stab->stab_io->fp;
+       debarg = arg;
+       if (stab->stab_io->fmt_stab)
+           form = stab->stab_io->fmt_stab->stab_form;
+       else
+           form = stab->stab_form;
+       if (!form || !fp) {
+           str_set(str, No);
+           STABSET(str);
+           break;
+       }
+       format(&outrec,form);
+       do_write(&outrec,stab->stab_io);
+       if (stab->stab_io->flags & IOF_FLUSH)
+           fflush(fp);
+       str_set(str, Yes);
+       STABSET(str);
+       break;
+    case O_OPEN:
+       if (arg[1].arg_type == A_WORD)
+           stab = arg[1].arg_ptr.arg_stab;
+       else
+           stab = stabent(str_get(sarg[1]),TRUE);
+       if (do_open(stab,str_get(sarg[2]))) {
+           value = (double)forkprocess;
+           stab->stab_io->lines = 0;
+           goto donumset;
+       }
+       else
+           str_set(str, No);
+       STABSET(str);
+       break;
+    case O_TRANS:
+       value = (double) do_trans(str,arg);
+       str = arg->arg_ptr.arg_str;
+       goto donumset;
+    case O_NTRANS:
+       str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
+       str = arg->arg_ptr.arg_str;
+       break;
+    case O_CLOSE:
+       if (arg[1].arg_type == A_WORD)
+           stab = arg[1].arg_ptr.arg_stab;
+       else
+           stab = stabent(str_get(sarg[1]),TRUE);
+       str_set(str, do_close(stab,TRUE) ? Yes : No );
+       STABSET(str);
+       break;
+    case O_EACH:
+       str_sset(str,do_each(arg[1].arg_ptr.arg_stab->stab_hash,
+         retary,sarg,&maxsarg,sargoff,cushion));
+       if (retary) {
+           sarg = *retary;     /* they realloc it */
+           goto array_return;
+       }
+       STABSET(str);
+       break;
+    case O_VALUES:
+    case O_KEYS:
+       value = (double) do_kv(arg[1].arg_ptr.arg_stab->stab_hash, optype,
+         retary,sarg,&maxsarg,sargoff,cushion);
+       if (retary) {
+           sarg = *retary;     /* they realloc it */
+           goto array_return;
+       }
+       goto donumset;
+    case O_ARRAY:
+       if (maxarg == 1) {
+           ary = arg[1].arg_ptr.arg_stab->stab_array;
+           maxarg = ary->ary_fill;
+           maxsarg = maxarg + sargoff;
+           if (retary) { /* array wanted */
+               sarg = (STR **)saferealloc((char*)(sarg-sargoff),
+                 (maxsarg+3+cushion)*sizeof(STR*)) + sargoff;
+               for (anum = 0; anum <= maxarg; anum++) {
+                   sarg[anum+1] = str = afetch(ary,anum);
+               }
+               maxarg++;
+               maxsarg++;
+               goto array_return;
+           }
+           else
+               str = afetch(ary,maxarg);
+       }
+       else
+           str = afetch(arg[2].arg_ptr.arg_stab->stab_array,
+               ((int)str_gnum(sarg[1])) - arybase);
+       if (!str)
+           str = &str_no;
+       break;
+    case O_DELETE:
+       tmpstab = arg[2].arg_ptr.arg_stab;              /* XXX */
+       str = hdelete(tmpstab->stab_hash,str_get(sarg[1]));
+       if (!str)
+           str = &str_no;
+       break;
+    case O_HASH:
+       tmpstab = arg[2].arg_ptr.arg_stab;              /* XXX */
+       str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
+       if (!str)
+           str = &str_no;
+       break;
+    case O_LARRAY:
+       anum = ((int)str_gnum(sarg[1])) - arybase;
+       str = afetch(arg[2].arg_ptr.arg_stab->stab_array,anum);
+       if (!str || str == &str_no) {
+           str = str_new(0);
+           astore(arg[2].arg_ptr.arg_stab->stab_array,anum,str);
+       }
+       break;
+    case O_LHASH:
+       tmpstab = arg[2].arg_ptr.arg_stab;
+       str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
+       if (!str) {
+           str = str_new(0);
+           hstore(tmpstab->stab_hash,str_get(sarg[1]),str);
+       }
+       if (tmpstab == envstab) {       /* heavy wizardry going on here */
+           str->str_link.str_magic = tmpstab;/* str is now magic */
+           envname = savestr(str_get(sarg[1]));
+                                       /* he threw the brick up into the air */
+       }
+       else if (tmpstab == sigstab) {  /* same thing, only different */
+           str->str_link.str_magic = tmpstab;
+           signame = savestr(str_get(sarg[1]));
+       }
+       break;
+    case O_PUSH:
+       if (arg[1].arg_flags & AF_SPECIAL)
+           str = do_push(arg,arg[2].arg_ptr.arg_stab->stab_array);
+       else {
+           str = str_new(0);           /* must copy the STR */
+           str_sset(str,sarg[1]);
+           apush(arg[2].arg_ptr.arg_stab->stab_array,str);
+       }
+       break;
+    case O_POP:
+       str = apop(arg[1].arg_ptr.arg_stab->stab_array);
+       if (!str) {
+           str = &str_no;
+           break;
+       }
+#ifdef STRUCTCOPY
+       *(arg->arg_ptr.arg_str) = *str;
+#else
+       bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
+#endif
+       safefree((char*)str);
+       str = arg->arg_ptr.arg_str;
+       break;
+    case O_SHIFT:
+       str = ashift(arg[1].arg_ptr.arg_stab->stab_array);
+       if (!str) {
+           str = &str_no;
+           break;
+       }
+#ifdef STRUCTCOPY
+       *(arg->arg_ptr.arg_str) = *str;
+#else
+       bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
+#endif
+       safefree((char*)str);
+       str = arg->arg_ptr.arg_str;
+       break;
+    case O_SPLIT:
+       value = (double) do_split(arg[2].arg_ptr.arg_spat,
+         retary,sarg,&maxsarg,sargoff,cushion);
+       if (retary) {
+           sarg = *retary;     /* they realloc it */
+           goto array_return;
+       }
+       goto donumset;
+    case O_LENGTH:
+       value = (double) str_len(sarg[1]);
+       goto donumset;
+    case O_SPRINTF:
+       sarg[maxsarg+1] = Nullstr;
+       do_sprintf(str,arg->arg_len,sarg);
+       break;
+    case O_SUBSTR:
+       anum = ((int)str_gnum(sarg[2])) - arybase;
+       for (tmps = str_get(sarg[1]); *tmps && anum > 0; tmps++,anum--) ;
+       anum = (int)str_gnum(sarg[3]);
+       if (anum >= 0 && strlen(tmps) > anum)
+           str_nset(str, tmps, anum);
+       else
+           str_set(str, tmps);
+       break;
+    case O_JOIN:
+       if (arg[2].arg_flags & AF_SPECIAL && arg[2].arg_type == A_EXPR)
+           do_join(arg,str_get(sarg[1]),str);
+       else
+           ajoin(arg[2].arg_ptr.arg_stab->stab_array,str_get(sarg[1]),str);
+       break;
+    case O_SLT:
+       tmps = str_get(sarg[1]);
+       value = (double) strLT(tmps,str_get(sarg[2]));
+       goto donumset;
+    case O_SGT:
+       tmps = str_get(sarg[1]);
+       value = (double) strGT(tmps,str_get(sarg[2]));
+       goto donumset;
+    case O_SLE:
+       tmps = str_get(sarg[1]);
+       value = (double) strLE(tmps,str_get(sarg[2]));
+       goto donumset;
+    case O_SGE:
+       tmps = str_get(sarg[1]);
+       value = (double) strGE(tmps,str_get(sarg[2]));
+       goto donumset;
+    case O_SEQ:
+       tmps = str_get(sarg[1]);
+       value = (double) strEQ(tmps,str_get(sarg[2]));
+       goto donumset;
+    case O_SNE:
+       tmps = str_get(sarg[1]);
+       value = (double) strNE(tmps,str_get(sarg[2]));
+       goto donumset;
+    case O_SUBR:
+       str_sset(str,do_subr(arg,sarg));
+       STABSET(str);
+       break;
+    case O_SORT:
+       if (maxarg <= 1)
+           stab = defoutstab;
+       else {
+           if (arg[2].arg_type == A_WORD)
+               stab = arg[2].arg_ptr.arg_stab;
+           else
+               stab = stabent(str_get(sarg[2]),TRUE);
+           if (!stab)
+               stab = defoutstab;
+       }
+       value = (double)do_sort(arg,stab,
+         retary,sarg,&maxsarg,sargoff,cushion);
+       if (retary) {
+           sarg = *retary;     /* they realloc it */
+           goto array_return;
+       }
+       goto donumset;
+    case O_PRTF:
+    case O_PRINT:
+       if (maxarg <= 1)
+           stab = defoutstab;
+       else {
+           if (arg[2].arg_type == A_WORD)
+               stab = arg[2].arg_ptr.arg_stab;
+           else
+               stab = stabent(str_get(sarg[2]),TRUE);
+           if (!stab)
+               stab = defoutstab;
+       }
+       if (!stab->stab_io || !(fp = stab->stab_io->fp))
+           value = 0.0;
+       else {
+           if (arg[1].arg_flags & AF_SPECIAL)
+               value = (double)do_aprint(arg,fp);
+           else {
+               value = (double)do_print(sarg[1],fp);
+               if (ors && optype == O_PRINT)
+                   fputs(ors, fp);
+           }
+           if (stab->stab_io->flags & IOF_FLUSH)
+               fflush(fp);
+       }
+       goto donumset;
+    case O_CHDIR:
+       tmps = str_get(sarg[1]);
+       if (!tmps || !*tmps)
+           tmps = getenv("HOME");
+       if (!tmps || !*tmps)
+           tmps = getenv("LOGDIR");
+       value = (double)(chdir(tmps) >= 0);
+       goto donumset;
+    case O_DIE:
+       tmps = str_get(sarg[1]);
+       if (!tmps || !*tmps)
+           exit(1);
+       fatal("%s",str_get(sarg[1]));
+       value = 0.0;
+       goto donumset;
+    case O_EXIT:
+       exit((int)str_gnum(sarg[1]));
+       value = 0.0;
+       goto donumset;
+    case O_RESET:
+       str_reset(str_get(sarg[1]));
+       value = 1.0;
+       goto donumset;
+    case O_LIST:
+       if (arg->arg_flags & AF_LOCAL)
+           savelist(sarg,maxsarg);
+       if (maxarg > 0)
+           str = sarg[maxsarg];        /* unwanted list, return last item */
+       else
+           str = &str_no;
+       if (retary)
+           goto array_return;
+       break;
+    case O_EOF:
+       if (maxarg <= 0)
+           stab = last_in_stab;
+       else if (arg[1].arg_type == A_WORD)
+           stab = arg[1].arg_ptr.arg_stab;
+       else
+           stab = stabent(str_get(sarg[1]),TRUE);
+       str_set(str, do_eof(stab) ? Yes : No);
+       STABSET(str);
+       break;
+    case O_TELL:
+       if (maxarg <= 0)
+           stab = last_in_stab;
+       else if (arg[1].arg_type == A_WORD)
+           stab = arg[1].arg_ptr.arg_stab;
+       else
+           stab = stabent(str_get(sarg[1]),TRUE);
+       value = (double)do_tell(stab);
+       goto donumset;
+    case O_SEEK:
+       if (arg[1].arg_type == A_WORD)
+           stab = arg[1].arg_ptr.arg_stab;
+       else
+           stab = stabent(str_get(sarg[1]),TRUE);
+       value = str_gnum(sarg[2]);
+       str_set(str, do_seek(stab,
+         (long)value, (int)str_gnum(sarg[3]) ) ? Yes : No);
+       STABSET(str);
+       break;
+    case O_REDO:
+    case O_NEXT:
+    case O_LAST:
+       if (maxarg > 0) {
+           tmps = str_get(sarg[1]);
+           while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
+             strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
+#ifdef DEBUGGING
+               if (debug & 4) {
+                   deb("(Skipping label #%d %s)\n",loop_ptr,
+                       loop_stack[loop_ptr].loop_label);
+               }
+#endif
+               loop_ptr--;
+           }
+#ifdef DEBUGGING
+           if (debug & 4) {
+               deb("(Found label #%d %s)\n",loop_ptr,
+                   loop_stack[loop_ptr].loop_label);
+           }
+#endif
+       }
+       if (loop_ptr < 0)
+           fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
+       longjmp(loop_stack[loop_ptr].loop_env, optype);
+    case O_GOTO:/* shudder */
+       goto_targ = str_get(sarg[1]);
+       longjmp(top_env, 1);
+    case O_INDEX:
+       tmps = str_get(sarg[1]);
+       if (!(tmps2 = fbminstr(tmps, tmps + sarg[1]->str_cur, sarg[2])))
+           value = (double)(-1 + arybase);
+       else
+           value = (double)(tmps2 - tmps + arybase);
+       goto donumset;
+    case O_TIME:
+       value = (double) time(Null(long*));
+       goto donumset;
+    case O_TMS:
+       value = (double) do_tms(retary,sarg,&maxsarg,sargoff,cushion);
+       if (retary) {
+           sarg = *retary;     /* they realloc it */
+           goto array_return;
+       }
+       goto donumset;
+    case O_LOCALTIME:
+       when = (long)str_gnum(sarg[1]);
+       value = (double)do_time(localtime(&when),
+         retary,sarg,&maxsarg,sargoff,cushion);
+       if (retary) {
+           sarg = *retary;     /* they realloc it */
+           goto array_return;
+       }
+       goto donumset;
+    case O_GMTIME:
+       when = (long)str_gnum(sarg[1]);
+       value = (double)do_time(gmtime(&when),
+         retary,sarg,&maxsarg,sargoff,cushion);
+       if (retary) {
+           sarg = *retary;     /* they realloc it */
+           goto array_return;
+       }
+       goto donumset;
+    case O_STAT:
+       value = (double) do_stat(arg,
+         retary,sarg,&maxsarg,sargoff,cushion);
+       if (retary) {
+           sarg = *retary;     /* they realloc it */
+           goto array_return;
+       }
+       goto donumset;
+    case O_CRYPT:
+#ifdef CRYPT
+       tmps = str_get(sarg[1]);
+       str_set(str,crypt(tmps,str_get(sarg[2])));
+#else
+       fatal(
+         "The crypt() function is unimplemented due to excessive paranoia.");
+#endif
+       break;
+    case O_EXP:
+       value = exp(str_gnum(sarg[1]));
+       goto donumset;
+    case O_LOG:
+       value = log(str_gnum(sarg[1]));
+       goto donumset;
+    case O_SQRT:
+       value = sqrt(str_gnum(sarg[1]));
+       goto donumset;
+    case O_INT:
+       value = str_gnum(sarg[1]);
+       if (value >= 0.0)
+           modf(value,&value);
+       else {
+           modf(-value,&value);
+           value = -value;
+       }
+       goto donumset;
+    case O_ORD:
+       value = (double) *str_get(sarg[1]);
+       goto donumset;
+    case O_SLEEP:
+       tmps = str_get(sarg[1]);
+       time(&when);
+       if (!tmps || !*tmps)
+           sleep((32767<<16)+32767);
+       else
+           sleep((unsigned)atoi(tmps));
+       value = (double)when;
+       time(&when);
+       value = ((double)when) - value;
+       goto donumset;
+    case O_FLIP:
+       if (str_true(sarg[1])) {
+           str_numset(str,0.0);
+           anum = 2;
+           arg->arg_type = optype = O_FLOP;
+           arg[2].arg_flags &= ~AF_SPECIAL;
+           arg[1].arg_flags |= AF_SPECIAL;
+           argflags = arg[2].arg_flags;
+           argtype = arg[2].arg_type;
+           argptr = arg[2].arg_ptr;
+           goto re_eval;
+       }
+       str_set(str,"");
+       break;
+    case O_FLOP:
+       str_inc(str);
+       if (str_true(sarg[2])) {
+           arg->arg_type = O_FLIP;
+           arg[1].arg_flags &= ~AF_SPECIAL;
+           arg[2].arg_flags |= AF_SPECIAL;
+           str_cat(str,"E0");
+       }
+       break;
+    case O_FORK:
+       value = (double)fork();
+       goto donumset;
+    case O_WAIT:
+       ihand = signal(SIGINT, SIG_IGN);
+       qhand = signal(SIGQUIT, SIG_IGN);
+       value = (double)wait(&argflags);
+       signal(SIGINT, ihand);
+       signal(SIGQUIT, qhand);
+       statusvalue = (unsigned short)argflags;
+       goto donumset;
+    case O_SYSTEM:
+       while ((anum = vfork()) == -1) {
+           if (errno != EAGAIN) {
+               value = -1.0;
+               goto donumset;
+           }
+           sleep(5);
+       }
+       if (anum > 0) {
+           ihand = signal(SIGINT, SIG_IGN);
+           qhand = signal(SIGQUIT, SIG_IGN);
+           while ((argtype = wait(&argflags)) != anum && argtype != -1)
+               ;
+           signal(SIGINT, ihand);
+           signal(SIGQUIT, qhand);
+           statusvalue = (unsigned short)argflags;
+           if (argtype == -1)
+               value = -1.0;
+           else {
+               value = (double)((unsigned int)argflags & 0xffff);
+           }
+           goto donumset;
+       }
+       if (arg[1].arg_flags & AF_SPECIAL)
+           value = (double)do_aexec(arg);
+       else {
+           value = (double)do_exec(str_static(sarg[1]));
+       }
+       _exit(-1);
+    case O_EXEC:
+       if (arg[1].arg_flags & AF_SPECIAL)
+           value = (double)do_aexec(arg);
+       else {
+           value = (double)do_exec(str_static(sarg[1]));
+       }
+       goto donumset;
+    case O_HEX:
+       argtype = 4;
+       goto snarfnum;
+
+    case O_OCT:
+       argtype = 3;
+
+      snarfnum:
+       anum = 0;
+       tmps = str_get(sarg[1]);
+       for (;;) {
+           switch (*tmps) {
+           default:
+               goto out;
+           case '8': case '9':
+               if (argtype != 4)
+                   goto out;
+               /* FALL THROUGH */
+           case '0': case '1': case '2': case '3': case '4':
+           case '5': case '6': case '7':
+               anum <<= argtype;
+               anum += *tmps++ & 15;
+               break;
+           case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+           case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+               if (argtype != 4)
+                   goto out;
+               anum <<= 4;
+               anum += (*tmps++ & 7) + 9;
+               break;
+           case 'x':
+               argtype = 4;
+               tmps++;
+               break;
+           }
+       }
+      out:
+       value = (double)anum;
+       goto donumset;
+    case O_CHMOD:
+    case O_CHOWN:
+    case O_KILL:
+    case O_UNLINK:
+    case O_UTIME:
+       if (arg[1].arg_flags & AF_SPECIAL)
+           value = (double)apply(optype,arg,Null(STR**));
+       else {
+           sarg[2] = Nullstr;
+           value = (double)apply(optype,arg,sarg);
+       }
+       goto donumset;
+    case O_UMASK:
+       value = (double)umask((int)str_gnum(sarg[1]));
+       goto donumset;
+    case O_RENAME:
+       tmps = str_get(sarg[1]);
+#ifdef RENAME
+       value = (double)(rename(tmps,str_get(sarg[2])) >= 0);
+#else
+       tmps2 = str_get(sarg[2]);
+       if (euid || stat(tmps2,&statbuf) < 0 ||
+         (statbuf.st_mode & S_IFMT) != S_IFDIR )
+           UNLINK(tmps2);      /* avoid unlinking a directory */
+       if (!(anum = link(tmps,tmps2)))
+           anum = UNLINK(tmps);
+       value = (double)(anum >= 0);
+#endif
+       goto donumset;
+    case O_LINK:
+       tmps = str_get(sarg[1]);
+       value = (double)(link(tmps,str_get(sarg[2])) >= 0);
+       goto donumset;
+    case O_UNSHIFT:
+       ary = arg[2].arg_ptr.arg_stab->stab_array;
+       if (arg[1].arg_flags & AF_SPECIAL)
+           do_unshift(arg,ary);
+       else {
+           str = str_new(0);           /* must copy the STR */
+           str_sset(str,sarg[1]);
+           aunshift(ary,1);
+           astore(ary,0,str);
+       }
+       value = (double)(ary->ary_fill + 1);
+       break;
+    case O_DOFILE:
+    case O_EVAL:
+       str_sset(str,
+           do_eval(arg[1].arg_type != A_NULL ? sarg[1] : defstab->stab_val,
+             optype) );
+       STABSET(str);
+       break;
+
+    case O_FTRREAD:
+       argtype = 0;
+       anum = S_IREAD;
+       goto check_perm;
+    case O_FTRWRITE:
+       argtype = 0;
+       anum = S_IWRITE;
+       goto check_perm;
+    case O_FTREXEC:
+       argtype = 0;
+       anum = S_IEXEC;
+       goto check_perm;
+    case O_FTEREAD:
+       argtype = 1;
+       anum = S_IREAD;
+       goto check_perm;
+    case O_FTEWRITE:
+       argtype = 1;
+       anum = S_IWRITE;
+       goto check_perm;
+    case O_FTEEXEC:
+       argtype = 1;
+       anum = S_IEXEC;
+      check_perm:
+       str = &str_no;
+       if (mystat(arg,sarg[1]) < 0)
+           break;
+       if (cando(anum,argtype))
+           str = &str_yes;
+       break;
+
+    case O_FTIS:
+       if (mystat(arg,sarg[1]) >= 0)
+           str = &str_yes;
+       else
+           str = &str_no;
+       break;
+    case O_FTEOWNED:
+    case O_FTROWNED:
+       if (mystat(arg,sarg[1]) >= 0 &&
+         statbuf.st_uid == (optype == O_FTEOWNED ? euid : uid) )
+           str = &str_yes;
+       else
+           str = &str_no;
+       break;
+    case O_FTZERO:
+       if (mystat(arg,sarg[1]) >= 0 && !statbuf.st_size)
+           str = &str_yes;
+       else
+           str = &str_no;
+       break;
+    case O_FTSIZE:
+       if (mystat(arg,sarg[1]) >= 0 && statbuf.st_size)
+           str = &str_yes;
+       else
+           str = &str_no;
+       break;
+
+    case O_FTSOCK:
+#ifdef S_IFSOCK
+       anum = S_IFSOCK;
+       goto check_file_type;
+#else
+       str = &str_no;
+       break;
+#endif
+    case O_FTCHR:
+       anum = S_IFCHR;
+       goto check_file_type;
+    case O_FTBLK:
+       anum = S_IFBLK;
+       goto check_file_type;
+    case O_FTFILE:
+       anum = S_IFREG;
+       goto check_file_type;
+    case O_FTDIR:
+       anum = S_IFDIR;
+      check_file_type:
+       if (mystat(arg,sarg[1]) >= 0 &&
+         (statbuf.st_mode & S_IFMT) == anum )
+           str = &str_yes;
+       else
+           str = &str_no;
+       break;
+    case O_FTPIPE:
+#ifdef S_IFIFO
+       anum = S_IFIFO;
+       goto check_file_type;
+#else
+       str = &str_no;
+       break;
+#endif
+    case O_FTLINK:
+#ifdef S_IFLNK
+       if (lstat(str_get(sarg[1]),&statbuf) >= 0 &&
+         (statbuf.st_mode & S_IFMT) == S_IFLNK )
+           str = &str_yes;
+       else
+#endif
+           str = &str_no;
+       break;
+    case O_SYMLINK:
+#ifdef SYMLINK
+       tmps = str_get(sarg[1]);
+       value = (double)(symlink(tmps,str_get(sarg[2])) >= 0);
+       goto donumset;
+#else
+       fatal("Unsupported function symlink()");
+#endif
+    case O_FTSUID:
+       anum = S_ISUID;
+       goto check_xid;
+    case O_FTSGID:
+       anum = S_ISGID;
+       goto check_xid;
+    case O_FTSVTX:
+       anum = S_ISVTX;
+      check_xid:
+       if (mystat(arg,sarg[1]) >= 0 && statbuf.st_mode & anum)
+           str = &str_yes;
+       else
+           str = &str_no;
+       break;
+    case O_FTTTY:
+       if (arg[1].arg_flags & AF_SPECIAL) {
+           stab = arg[1].arg_ptr.arg_stab;
+           tmps = "";
+       }
+       else
+           stab = stabent(tmps = str_get(sarg[1]),FALSE);
+       if (stab && stab->stab_io && stab->stab_io->fp)
+           anum = fileno(stab->stab_io->fp);
+       else if (isdigit(*tmps))
+           anum = atoi(tmps);
+       else
+           anum = -1;
+       if (isatty(anum))
+           str = &str_yes;
+       else
+           str = &str_no;
+       break;
+    case O_FTTEXT:
+    case O_FTBINARY:
+       str = do_fttext(arg,sarg[1]);
+       break;
+    }
+    if (retary) {
+       sarg[1] = str;
+       maxsarg = sargoff + 1;
+    }
+#ifdef DEBUGGING
+    if (debug) {
+       dlevel--;
+       if (debug & 8)
+           deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
+    }
+#endif
+    goto freeargs;
+
+array_return:
+#ifdef DEBUGGING
+    if (debug) {
+       dlevel--;
+       if (debug & 8)
+           deb("%s RETURNS ARRAY OF %d ARGS\n",opname[optype],maxsarg-sargoff);
+    }
+#endif
+    goto freeargs;
+
+donumset:
+    str_numset(str,value);
+    STABSET(str);
+    if (retary) {
+       sarg[1] = str;
+       maxsarg = sargoff + 1;
+    }
+#ifdef DEBUGGING
+    if (debug) {
+       dlevel--;
+       if (debug & 8)
+           deb("%s RETURNS \"%f\"\n",opname[optype],value);
+    }
+#endif
+
+freeargs:
+    sarg -= sargoff;
+    if (sarg != quicksarg) {
+       if (retary) {
+           sarg[0] = &str_args;
+           str_numset(sarg[0], (double)(maxsarg));
+           sarg[maxsarg+1] = Nullstr;
+           *retary = sarg;     /* up to them to free it */
+       }
+       else
+           safefree((char*)sarg);
+    }
+    return str;
+}
+
+int
+ingroup(gid,effective)
+int gid;
+int effective;
+{
+    if (gid == (effective ? getegid() : getgid()))
+       return TRUE;
+#ifdef GETGROUPS
+#ifndef NGROUPS
+#define NGROUPS 32
+#endif
+    {
+       GIDTYPE gary[NGROUPS];
+       int anum;
+
+       anum = getgroups(NGROUPS,gary);
+       while (--anum >= 0)
+           if (gary[anum] == gid)
+               return TRUE;
+    }
+#endif
+    return FALSE;
+}
+
+/* Do the permissions allow some operation?  Assumes statbuf already set. */
+
+int
+cando(bit, effective)
+int bit;
+int effective;
+{
+    if ((effective ? euid : uid) == 0) {       /* root is special */
+       if (bit == S_IEXEC) {
+           if (statbuf.st_mode & 0111 ||
+             (statbuf.st_mode & S_IFMT) == S_IFDIR )
+               return TRUE;
+       }
+       else
+           return TRUE;                /* root reads and writes anything */
+       return FALSE;
+    }
+    if (statbuf.st_uid == (effective ? euid : uid) ) {
+       if (statbuf.st_mode & bit)
+           return TRUE;        /* ok as "user" */
+    }
+    else if (ingroup((int)statbuf.st_gid,effective)) {
+       if (statbuf.st_mode & bit >> 3)
+           return TRUE;        /* ok as "group" */
+    }
+    else if (statbuf.st_mode & bit >> 6)
+       return TRUE;    /* ok as "other" */
+    return FALSE;
+}
diff --git a/form.c b/form.c
index 8894621..422d4a7 100644 (file)
--- a/form.c
+++ b/form.c
@@ -1,15 +1,12 @@
-/* $Header: form.c,v 1.0 87/12/18 13:05:07 root Exp $
+/* $Header: form.c,v 2.0 88/06/05 00:08:57 root Exp $
  *
  * $Log:       form.c,v $
- * Revision 1.0  87/12/18  13:05:07  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:08:57  root
+ * Baseline version 2.0.
  * 
  */
 
-#include "handy.h"
 #include "EXTERN.h"
-#include "search.h"
-#include "util.h"
 #include "perl.h"
 
 /* Forms stuff */
@@ -57,7 +54,7 @@ register FCMD *fcmd;
            orec->o_lines++;
            break;
        case F_LEFT:
-           str = eval(fcmd->f_expr,Null(char***),(double*)0);
+           str = eval(fcmd->f_expr,Null(STR***),-1);
            s = str_get(str);
            size = fcmd->f_size;
            CHKLEN(size);
@@ -101,7 +98,7 @@ register FCMD *fcmd;
            }
            break;
        case F_RIGHT:
-           t = s = str_get(eval(fcmd->f_expr,Null(char***),(double*)0));
+           t = s = str_get(eval(fcmd->f_expr,Null(STR***),-1));
            size = fcmd->f_size;
            CHKLEN(size);
            chophere = Nullch;
@@ -150,7 +147,7 @@ register FCMD *fcmd;
        case F_CENTER: {
            int halfsize;
 
-           t = s = str_get(eval(fcmd->f_expr,Null(char***),(double*)0));
+           t = s = str_get(eval(fcmd->f_expr,Null(STR***),-1));
            size = fcmd->f_size;
            CHKLEN(size);
            chophere = Nullch;
@@ -207,7 +204,7 @@ register FCMD *fcmd;
            break;
        }
        case F_LINES:
-           str = eval(fcmd->f_expr,Null(char***),(double*)0);
+           str = eval(fcmd->f_expr,Null(STR***),-1);
            s = str_get(str);
            size = str_len(str);
            CHKLEN(size);
@@ -240,7 +237,8 @@ register STIO *stio;
 
 #ifdef DEBUGGING
     if (debug & 256)
-       fprintf(stderr,"left=%d, todo=%d\n",stio->lines_left, orec->o_lines);
+       fprintf(stderr,"left=%ld, todo=%ld\n",
+         (long)stio->lines_left, (long)orec->o_lines);
 #endif
     if (stio->lines_left < orec->o_lines) {
        if (!stio->top_stab) {
diff --git a/form.h b/form.h
index fc2257b..3b7aa95 100644 (file)
--- a/form.h
+++ b/form.h
@@ -1,8 +1,8 @@
-/* $Header: form.h,v 1.0 87/12/18 13:05:10 root Exp $
+/* $Header: form.h,v 2.0 88/06/05 00:09:01 root Exp $
  *
  * $Log:       form.h,v $
- * Revision 1.0  87/12/18  13:05:10  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:09:01  root
+ * Baseline version 2.0.
  * 
  */
 
diff --git a/handy.h b/handy.h
index 3eb2477..6a7c2c7 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -1,12 +1,16 @@
-/* $Header: handy.h,v 1.0 87/12/18 13:05:14 root Exp $
+/* $Header: handy.h,v 2.0 88/06/05 00:09:03 root Exp $
  *
  * $Log:       handy.h,v $
- * Revision 1.0  87/12/18  13:05:14  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:09:03  root
+ * Baseline version 2.0.
  * 
  */
 
-#define Null(type) ((type)0)
+#ifdef NULL
+#undef NULL
+#endif
+#define NULL 0
+#define Null(type) ((type)NULL)
 #define Nullch Null(char*)
 #define Nullfp Null(FILE*)
 
 #define strGE(s1,s2) (strcmp(s1,s2) >= 0)
 #define strnNE(s1,s2,l) (strncmp(s1,s2,l))
 #define strnEQ(s1,s2,l) (!strncmp(s1,s2,l))
+
+#define MEM_SIZE unsigned int
+
+/* Line numbers are unsigned, 16 bits. */
+typedef unsigned short line_t;
+#ifdef lint
+#define NOLINE ((line_t)0)
+#else
+#define NOLINE ((line_t) 65535)
+#endif
+
diff --git a/hash.c b/hash.c
index 61e7f87..e0bc5f6 100644 (file)
--- a/hash.c
+++ b/hash.c
@@ -1,16 +1,12 @@
-/* $Header: hash.c,v 1.0 87/12/18 13:05:17 root Exp $
+/* $Header: hash.c,v 2.0 88/06/05 00:09:06 root Exp $
  *
  * $Log:       hash.c,v $
- * Revision 1.0  87/12/18  13:05:17  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:09:06  root
+ * Baseline version 2.0.
  * 
  */
 
-#include <stdio.h>
 #include "EXTERN.h"
-#include "handy.h"
-#include "util.h"
-#include "search.h"
 #include "perl.h"
 
 STR *
@@ -26,7 +22,7 @@ char *key;
     if (!tb)
        return Nullstr;
     for (s=key,                i=0,    hash = 0;
-      /* while */ *s;
+      /* while */ *s && i < COEFFSIZE;
         s++,           i++,    hash *= 5) {
        hash += *s * coeff[i];
     }
@@ -56,7 +52,7 @@ STR *val;
     if (!tb)
        return FALSE;
     for (s=key,                i=0,    hash = 0;
-      /* while */ *s;
+      /* while */ *s && i < COEFFSIZE;
         s++,           i++,    hash *= 5) {
        hash += *s * coeff[i];
     }
@@ -90,8 +86,7 @@ STR *val;
     return FALSE;
 }
 
-#ifdef NOTUSED
-bool
+STR *
 hdelete(tb,key)
 register HASH *tb;
 char *key;
@@ -101,11 +96,12 @@ char *key;
     register int hash;
     register HENT *entry;
     register HENT **oentry;
+    STR *str;
 
     if (!tb)
-       return FALSE;
+       return Nullstr;
     for (s=key,                i=0,    hash = 0;
-      /* while */ *s;
+      /* while */ *s && i < COEFFSIZE;
         s++,           i++,    hash *= 5) {
        hash += *s * coeff[i];
     }
@@ -113,22 +109,20 @@ char *key;
     oentry = &(tb->tbl_array[hash & tb->tbl_max]);
     entry = *oentry;
     i = 1;
-    for (; entry; i=0, oentry = &entry->hent_next, entry = entry->hent_next) {
+    for (; entry; i=0, oentry = &entry->hent_next, entry = *oentry) {
        if (entry->hent_hash != hash)           /* strings can't be equal */
            continue;
        if (strNE(entry->hent_key,key)) /* is this it? */
            continue;
-       safefree((char*)entry->hent_val);
-       safefree(entry->hent_key);
        *oentry = entry->hent_next;
-       safefree((char*)entry);
+       str = str_static(entry->hent_val);
+       hentfree(entry);
        if (i)
            tb->tbl_fill--;
-       return TRUE;
+       return str;
     }
-    return FALSE;
+    return Nullstr;
 }
-#endif
 
 hsplit(tb)
 HASH *tb;
@@ -180,6 +174,54 @@ hnew()
     return tb;
 }
 
+void
+hentfree(hent)
+register HENT *hent;
+{
+    if (!hent)
+       return;
+    str_free(hent->hent_val);
+    safefree(hent->hent_key);
+    safefree((char*)hent);
+}
+
+void
+hclear(tb)
+register HASH *tb;
+{
+    register HENT *hent;
+    register HENT *ohent = Null(HENT*);
+
+    if (!tb)
+       return;
+    hiterinit(tb);
+    while (hent = hiternext(tb)) {     /* concise but not very efficient */
+       hentfree(ohent);
+       ohent = hent;
+    }
+    hentfree(ohent);
+    tb->tbl_fill = 0;