a "replacement" for awk and sed perl-1.0
authorLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Fri, 18 Dec 1987 00:00:00 +0000 (00:00 +0000)
committerLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Fri, 18 Dec 1987 00:00:00 +0000 (00:00 +0000)
[  Perl is kind of designed to make awk and sed semi-obsolete.  This posting
   will include the first 10 patches after the main source.  The following
   description is lifted from Larry's manpage. --r$  ]

   Perl is a interpreted language optimized for scanning arbitrary text
   files, extracting information from those text files, and printing
   reports based on that information.  It's also a good language for many
   system management tasks.  The language is intended to be practical
   (easy to use, efficient, complete) rather than beautiful (tiny,
   elegant, minimal).  It combines (in the author's opinion, anyway) some
   of the best features of C, sed, awk, and sh, so people familiar with
   those languages should have little difficulty with it.  (Language
   historians will also note some vestiges of csh, Pascal, and even
   BASIC-PLUS.) Expression syntax corresponds quite closely to C
   expression syntax.  If you have a problem that would ordinarily use sed
   or awk or sh, but it exceeds their capabilities or must run a little
   faster, and you don't want to write the silly thing in C, then perl may
   be for you.  There are also translators to turn your sed and awk
   scripts into perl scripts.

108 files changed:
Configure [new file with mode: 0755]
EXTERN.h [new file with mode: 0644]
INTERN.h [new file with mode: 0644]
MANIFEST [new file with mode: 0644]
Makefile.SH [new file with mode: 0644]
README [new file with mode: 0644]
Wishlist [new file with mode: 0644]
arg.c [new file with mode: 0644]
arg.h [new file with mode: 0644]
array.c [new file with mode: 0644]
array.h [new file with mode: 0644]
cmd.c [new file with mode: 0644]
cmd.h [new file with mode: 0644]
config.H [new file with mode: 0644]
config.h.SH [new file with mode: 0644]
dump.c [new file with mode: 0644]
form.c [new file with mode: 0644]
form.h [new file with mode: 0644]
handy.h [new file with mode: 0644]
hash.c [new file with mode: 0644]
hash.h [new file with mode: 0644]
makedepend.SH [new file with mode: 0644]
makedir.SH [new file with mode: 0644]
malloc.c [new file with mode: 0644]
patchlevel.h [new file with mode: 0644]
perl.h [new file with mode: 0644]
perl.man.1 [new file with mode: 0644]
perl.man.2 [new file with mode: 0644]
perl.y [new file with mode: 0644]
perly.c [new file with mode: 0644]
search.c [new file with mode: 0644]
search.h [new file with mode: 0644]
spat.h [new file with mode: 0644]
stab.c [new file with mode: 0644]
stab.h [new file with mode: 0644]
str.c [new file with mode: 0644]
str.h [new file with mode: 0644]
t/README [new file with mode: 0644]
t/TEST [new file with mode: 0644]
t/base.cond [new file with mode: 0644]
t/base.if [new file with mode: 0644]
t/base.lex [new file with mode: 0644]
t/base.pat [new file with mode: 0644]
t/base.term [new file with mode: 0644]
t/cmd.elsif [new file with mode: 0644]
t/cmd.for [new file with mode: 0644]
t/cmd.mod [new file with mode: 0644]
t/cmd.subval [new file with mode: 0644]
t/cmd.while [new file with mode: 0644]
t/comp.cmdopt [new file with mode: 0644]
t/comp.cpp [new file with mode: 0644]
t/comp.decl [new file with mode: 0644]
t/comp.multiline [new file with mode: 0644]
t/comp.script [new file with mode: 0644]
t/comp.term [new file with mode: 0644]
t/io.argv [new file with mode: 0644]
t/io.fs [new file with mode: 0644]
t/io.inplace [new file with mode: 0644]
t/io.print [new file with mode: 0644]
t/io.tell [new file with mode: 0644]
t/op.append [new file with mode: 0644]
t/op.auto [new file with mode: 0644]
t/op.chop [new file with mode: 0644]
t/op.cond [new file with mode: 0644]
t/op.crypt [new file with mode: 0644]
t/op.do [new file with mode: 0644]
t/op.each [new file with mode: 0644]
t/op.exec [new file with mode: 0644]
t/op.exp [new file with mode: 0644]
t/op.flip [new file with mode: 0644]
t/op.fork [new file with mode: 0644]
t/op.goto [new file with mode: 0644]
t/op.int [new file with mode: 0644]
t/op.join [new file with mode: 0644]
t/op.list [new file with mode: 0644]
t/op.magic [new file with mode: 0644]
t/op.oct [new file with mode: 0644]
t/op.ord [new file with mode: 0644]
t/op.pat [new file with mode: 0644]
t/op.push [new file with mode: 0644]
t/op.repeat [new file with mode: 0644]
t/op.sleep [new file with mode: 0644]
t/op.split [new file with mode: 0644]
t/op.sprintf [new file with mode: 0644]
t/op.stat [new file with mode: 0644]
t/op.subst [new file with mode: 0644]
t/op.time [new file with mode: 0644]
t/op.unshift [new file with mode: 0644]
util.c [new file with mode: 0644]
util.h [new file with mode: 0644]
version.c [new file with mode: 0644]
x2p/EXTERN.h [new file with mode: 0644]
x2p/INTERN.h [new file with mode: 0644]
x2p/Makefile.SH [new file with mode: 0644]
x2p/a2p.h [new file with mode: 0644]
x2p/a2p.man [new file with mode: 0644]
x2p/a2p.y [new file with mode: 0644]
x2p/a2py.c [new file with mode: 0644]
x2p/handy.h [new file with mode: 0644]
x2p/hash.c [new file with mode: 0644]
x2p/hash.h [new file with mode: 0644]
x2p/s2p [new file with mode: 0644]
x2p/s2p.man [new file with mode: 0644]
x2p/str.c [new file with mode: 0644]
x2p/str.h [new file with mode: 0644]
x2p/util.c [new file with mode: 0644]
x2p/util.h [new file with mode: 0644]
x2p/walk.c [new file with mode: 0644]

new file mode 100755 (executable)
index 0000000..3035f15
--- /dev/null
+++ b/Configure
@@ -0,0 +1,1279 @@
+#! /bin/sh
+#
+# If these # comments don't work, trim them.  Don't worry about any other
+# shell scripts, Configure will trim # comments from them for you.
+#
+# (If you are trying to port this package to a machine without sh, I would
+# suggest you cut out the prototypical config.h from the end of Configure
+# 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 87/12/18 15:05:56 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'
+export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh $0; kill $$)
+
+if test ! -t 0; then
+    echo "Say 'sh Configure', not 'sh <Configure'"
+    exit 1
+fi
+
+(alias) >/dev/null 2>&1 && \
+    echo "(I see you are using the Korn shell.  Some ksh's blow up on Configure," && \
+    echo "especially on exotic machines.  If yours does, try the Bourne shell instead.)"
+
+if test ! -d ../UU; then
+    if test ! -d UU; then
+       mkdir UU
+    fi
+    cd UU
+fi
+
+d_eunice=''
+eunicefix=''
+define=''
+loclist=''
+expr=''
+sed=''
+echo=''
+cat=''
+rm=''
+mv=''
+cp=''
+tail=''
+tr=''
+mkdir=''
+sort=''
+uniq=''
+grep=''
+trylist=''
+test=''
+inews=''
+egrep=''
+more=''
+pg=''
+Mcc=''
+vi=''
+mailx=''
+mail=''
+Log=''
+Header=''
+bin=''
+cc=''
+contains=''
+cpp=''
+d_charsprf=''
+d_index=''
+d_strctcpy=''
+d_vfork=''
+libc=''
+libnm=''
+mansrc=''
+manext=''
+models=''
+split=''
+small=''
+medium=''
+large=''
+huge=''
+ccflags=''
+ldflags=''
+n=''
+c=''
+package=''
+spitshell=''
+shsharp=''
+sharpbang=''
+startsh=''
+voidflags=''
+defvoidused=''
+CONFIG=''
+
+: set package name
+package=perl
+
+echo " "
+echo "Beginning of configuration questions for $package kit."
+: Eunice requires " " instead of "", can you believe it
+echo " "
+
+define='define'
+undef='/*undef'
+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
+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"
+pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /etc /usr/lib"
+defvoidused=7
+
+: some greps do not return status, grrr.
+echo "grimblepritz" >grimble
+if grep blurfldyick grimble >/dev/null 2>&1 ; then
+    contains=contains
+elif grep grimblepritz grimble >/dev/null 2>&1 ; then
+    contains=grep
+else
+    contains=contains
+fi
+rm -f grimble
+: the following should work in any shell
+case "$contains" in
+contains*)
+    echo " "
+    echo "AGH!  Grep doesn't return a status.  Attempting remedial action."
+    cat >contains <<'EOSS'
+grep "$1" "$2" >.greptmp && cat .greptmp && test -s .greptmp
+EOSS
+chmod 755 contains
+esac
+
+: first determine how to suppress newline on echo command
+echo "Checking echo to see how to suppress newlines..."
+(echo "hi there\c" ; echo " ") >.echotmp
+if $contains c .echotmp >/dev/null 2>&1 ; then
+    echo "...using -n."
+    n='-n'
+    c=''
+else
+    cat <<'EOM'
+...using \c
+EOM
+    n=''
+    c='\c'
+fi
+echo $n "Type carriage return to continue.  Your cursor should be here-->$c"
+read ans
+rm -f .echotmp
+
+: now set up to do reads with possible shell escape and default assignment
+cat <<EOSC >myread
+ans='!'
+while expr "X\$ans" : "X!" >/dev/null; do
+    read ans
+    case "\$ans" in
+    !)
+       sh
+       echo " "
+       echo $n "\$rp $c"
+       ;;
+    !*)
+       set \`expr "X\$ans" : "X!\(.*\)\$"\`
+       sh -c "\$*"
+       echo " "
+       echo $n "\$rp $c"
+       ;;
+    esac
+done
+rp='Your answer:'
+case "\$ans" in
+'') ans="\$dflt";;
+esac
+EOSC
+
+: general instructions
+cat <<EOH
+This installation shell script will examine your system and ask you questions
+to determine how the $package package should be installed.  If you get stuck
+on a question, you may use a ! shell escape to start a subshell or execute
+a command.  Many of the questions will have default answers in square
+brackets--typing carriage return will give you the default.
+
+On some of the questions which ask for file or directory names you are
+allowed to use the ~name construct to specify the login directory belonging
+to "name", even if you don't have a shell which knows about that.  Questions
+where this is allowed will be marked "(~name ok)".
+
+EOH
+rp="[Type carriage return to continue]"
+echo $n "$rp $c"
+. myread
+cat <<EOH
+
+Much effort has been expended to ensure that this shell script will run
+on any Unix system.  If despite that it blows up on you, your best bet is
+to edit Configure and run it again. Also, let me (lwall@sdcrdcf.UUCP) know
+how I blew it.  If you can't run Configure for some reason, you'll have
+to generate a config.sh file by hand.
+
+This installation script affects things in two ways: 1) it may do direct
+variable substitutions on some of the files included in this kit, and
+2) it builds a config.h file for inclusion in C programs.  You may edit
+any of these files as the need arises after running this script.
+
+If you make a mistake on a question, there is no easy way to back up to it
+currently.  The easiest thing to do is to edit config.sh and rerun all the
+SH files.  Configure will offer to let you do this before it runs the SH files.
+
+EOH
+rp="[Type carriage return to continue]"
+echo $n "$rp $c"
+. myread
+
+: get old answers, if there is a config file out there
+if test -f ../config.sh; then
+    echo " "
+    dflt=y
+    rp="I see a config.sh file.  Did Configure make it on THIS system? [$dflt]"
+    echo $n "$rp $c"
+    . myread
+    case "$ans" in
+    n*) echo "OK, I'll ignore it.";;
+    *)  echo "Fetching default answers from your old config.sh file..."
+       tmp="$n"
+       ans="$c"
+        . ../config.sh
+       n="$tmp"
+       c="$ans"
+       ;;
+    esac
+fi
+
+: find out where common programs are
+echo " "
+echo "Locating common programs..."
+cat <<EOSC >loc
+$startsh
+case \$# in
+0) exit 1;;
+esac
+thing=\$1
+shift
+dflt=\$1
+shift
+for dir in \$*; do
+    case "\$thing" in
+    .)
+       if test -d \$dir/\$thing; then
+           echo \$dir
+           exit 0
+       fi
+       ;;
+    *)
+       if test -f \$dir/\$thing; then
+           echo \$dir/\$thing
+           exit 0
+       fi
+       ;;
+    esac
+done
+echo \$dflt
+exit 1
+EOSC
+chmod 755 loc
+$eunicefix loc
+loclist="
+expr
+sed
+echo
+cat
+rm
+mv
+cp
+tr
+mkdir
+sort
+uniq
+grep
+"
+trylist="
+test
+egrep
+Mcc
+"
+for file in $loclist; do
+    xxx=`loc $file $file $pth`
+    eval $file=$xxx
+    eval _$file=$xxx
+    case "$xxx" in
+    /*)
+       echo $file is in $xxx.
+       ;;
+    *)
+       echo "I don't know where $file is.  I hope it's in everyone's PATH."
+       ;;
+    esac
+done
+echo " "
+echo "Don't worry if any of the following aren't found..."
+ans=offhand
+for file in $trylist; do
+    xxx=`loc $file $file $pth`
+    eval $file=$xxx
+    eval _$file=$xxx
+    case "$xxx" in
+    /*)
+       echo $file is in $xxx.
+       ;;
+    *)
+       echo "I don't see $file out there, $ans."
+       ans=either
+       ;;
+    esac
+done
+case "$egrep" in
+egrep)
+    echo "Substituting grep for egrep."
+    egrep=$grep
+    ;;
+esac
+case "$test" in
+test)
+    echo "Hopefully test is built into your sh."
+    ;;
+/bin/test)
+    echo " "
+    dflt=n
+    rp="Is your "'"'"test"'"'" built into sh? [$dflt] (OK to guess)"
+    echo $n "$rp $c"
+    . myread
+    case "$ans" in
+    y*) test=test ;;
+    esac
+    ;;
+*)
+    test=test
+    ;;
+esac
+case "$echo" in
+echo)
+    echo "Hopefully echo is built into your sh."
+    ;;
+/bin/echo)
+    echo " "
+    echo "Checking compatibility between /bin/echo and builtin echo (if any)..."
+    $echo $n "hi there$c" >foo1
+    echo $n "hi there$c" >foo2
+    if cmp foo1 foo2 >/dev/null 2>&1; then
+       echo "They are compatible.  In fact, they may be identical."
+    else
+       case "$n" in
+       '-n') n='' c='\c' ans='\c' ;;
+       *) n='-n' c='' ans='-n' ;;
+       esac
+       cat <<FOO
+They are not compatible!  You are probably running ksh on a non-USG system.
+I'll have to use /bin/echo instead of the builtin, since Bourne shell doesn't
+have echo built in and we may have to run some Bourne shell scripts.  That
+means I'll have to use $ans to suppress newlines now.  Life is ridiculous.
+
+FOO
+       rp="Your cursor should be here-->"
+       $echo $n "$rp$c"
+       . myread
+    fi
+    $rm -f foo1 foo2
+    ;;
+*)
+    : cross your fingers
+    echo=echo
+    ;;
+esac
+rmlist="$rmlist loc"
+
+: get list of predefined functions in a handy place
+echo " "
+if test -f /lib/libc.a; then
+    echo "Your C library is in /lib/libc.a.  You're normal."
+    libc=/lib/libc.a
+else
+    ans=`loc libc.a blurfl/dyick $libpth`
+    if test -f $ans; then
+       echo "Your C library is in $ans, of all places."
+       libc=ans
+    else
+       if test -f "$libc"; then
+           echo "Your C library is in $libc, like you said before."
+       else
+           cat <<EOM
+I can't seem to find your C library.  I've looked in the following places:
+
+       $libpth
+
+None of these seems to contain your C library.  What is the full name
+EOM
+           dflt=None
+           $echo $n "of your C library? $c"
+           rp='C library full name?'
+           . myread
+           libc="$ans"
+       fi
+    fi
+fi
+echo " "
+$echo $n "Extracting names from $libc for later perusal...$c"
+if ar t $libc > libc.list; 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?"
+    else
+       echo "That didn't work either.  Giving up."
+       exit 1
+    fi
+fi
+rmlist="$rmlist libc.list"
+
+: make some quick guesses about what we are up against
+echo " "
+$echo $n "Hmm...  $c"
+if $contains SIGTSTP /usr/include/signal.h >/dev/null 2>&1 ; then
+    echo "Looks kind of like a BSD system, but we'll see..."
+    echo exit 0 >bsd
+    echo exit 1 >usg
+    echo exit 1 >v7
+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
+    echo exit 1 >v7
+else
+    echo "Looks kind of like a version 7 system, but we'll see..."
+    echo exit 1 >bsd
+    echo exit 1 >usg
+    echo exit 0 >v7
+fi
+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.
+EOI
+    echo "exit 0" >eunice
+    eunicefix=unixtovms
+    d_eunice="$define"
+: it so happens the Eunice I know will not run shell scripts in Unix format
+else
+    echo " "
+    echo "Congratulations.  You aren't running Eunice."
+    eunicefix=':'
+    d_eunice="$undef"
+    echo "exit 1" >eunice
+fi
+if test -f /xenix; then
+    echo "Actually, this looks more like a XENIX system..."
+    echo "exit 0" >xenix
+else
+    echo " "
+    echo "It's not Xenix..."
+    echo "exit 1" >xenix
+fi
+chmod 755 xenix
+if test -f /venix; then
+    echo "Actually, this looks more like a VENIX system..."
+    echo "exit 0" >venix
+else
+    echo " "
+    if xenix; then
+       : null
+    else
+       echo "Nor is it Venix..."
+    fi
+    echo "exit 1" >venix
+fi
+chmod 755 bsd usg v7 eunice venix xenix
+$eunicefix bsd usg v7 eunice venix xenix
+rmlist="$rmlist bsd usg v7 eunice venix xenix"
+
+: see if sh knows # comments
+echo " "
+echo "Checking your sh to see if it knows about # comments..."
+if sh -c '#' >/dev/null 2>&1 ; then
+    echo "Your sh handles # comments correctly."
+    shsharp=true
+    spitshell=cat
+    echo " "
+    echo "Okay, let's see if #! works on this system..."
+    echo "#!/bin/echo hi" > try
+    $eunicefix try
+    chmod 755 try
+    try > today
+    if test -s today; then
+       echo "It does."
+       sharpbang='#!'
+    else
+       echo "#! /bin/echo hi" > try
+       $eunicefix try
+       chmod 755 try
+       try > today
+       if test -s today; then
+           echo "It does."
+           sharpbang='#! '
+       else
+           echo "It doesn't."
+           sharpbang=': use '
+       fi
+    fi
+else
+    echo "Your sh doesn't grok # comments--I will strip them later on."
+    shsharp=false
+    echo "exec grep -v '^#'" >spitshell
+    chmod 755 spitshell
+    $eunicefix spitshell
+    spitshell=`pwd`/spitshell
+    echo "I presume that if # doesn't work, #! won't work either!"
+    sharpbang=': use '
+fi
+
+: figure out how to guarantee sh startup
+echo " "
+echo "Checking out how to guarantee sh startup..."
+startsh=$sharpbang'/bin/sh'
+echo "Let's see if '$startsh' works..."
+cat >try <<EOSS
+$startsh
+set abc
+test "$?abc" != 1
+EOSS
+
+chmod 755 try
+$eunicefix try
+if try; then
+    echo "Yup, it does."
+else
+    echo "Nope.  You may have to fix up the shell scripts to make sure sh runs them."
+fi
+rm -f try today
+
+: 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
+    echo "Your sprintf() returns (int)."
+    d_charsprf="$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
+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
+fi
+
+: check for structure copying
+echo " "
+echo "Checking to see if your C compiler can copy structs..."
+$cat >try.c <<'EOCP'
+main()
+{
+       struct blurfl {
+           int dyick;
+       } foo, bar;
+
+       foo = bar;
+}
+EOCP
+if cc -c try.c >/dev/null 2>&1 ; then
+    d_strctcpy="$define"
+    echo "Yup, it can."
+else
+    d_strctcpy="$undef"
+    echo "Nope, it can't."
+fi
+$rm -f try.*
+
+: see if there is a vfork
+echo " "
+if $contains vfork libc.list >/dev/null 2>&1 ; then
+    echo "vfork() found."
+    d_vfork="$undef"
+else
+    echo "No vfork() found--will use fork() instead."
+    d_vfork="$define"
+fi
+
+: check for void type
+echo " "
+$cat <<EOM
+Checking to see how well your C compiler groks the void type...
+
+  Support flag bits are:
+    1: basic void declarations.
+    2: arrays of pointers to functions returning void.
+    4: operations between pointers to and addresses of void functions.
+
+EOM
+case "$voidflags" in
+'')
+    $cat >try.c <<'EOCP'
+#if TRY & 1
+void main() {
+#else
+main() {
+#endif
+       extern void *moo();
+       void (*goo)();
+#if TRY & 2
+       void (*foo[10])();
+#endif
+
+#if TRY & 4
+       if(goo == moo) {
+               exit(0);
+       }
+#endif
+       exit(0);
+}
+EOCP
+    if cc -S -DTRY=7 try.c >.out 2>&1 ; then
+       voidflags=7
+       echo "It appears to support void fully."
+       if $contains warning .out >/dev/null 2>&1; then
+           echo "However, you might get some warnings that look like this:"
+           $cat .out
+       fi
+    else
+       echo "Hmm, you compiler has some difficulty with void.  Checking further..."
+       if cc -S -DTRY=1 try.c >/dev/null 2>&1 ; then
+           echo "It supports 1..."
+           if cc -S -DTRY=3 try.c >/dev/null 2>&1 ; then
+               voidflags=3
+               echo "And it supports 2 but not 4."
+           else
+               echo "It doesn't support 2..."
+               if cc -S -DTRY=3 try.c >/dev/null 2>&1 ; then
+                   voidflags=5
+                   echo "But it supports 4."
+               else
+                   voidflags=1
+                   echo "And it doesn't support 4."
+               fi
+           fi
+       else
+           echo "There is no support at all for void."
+           voidflags=0
+       fi
+    fi
+esac
+dflt="$voidflags";
+rp="Your void support flags add up to what? [$dflt]"
+$echo $n "$rp $c"
+. myread
+voidflags="$ans"
+$rm -f try.* .out
+
+: preserve RCS keywords in files with variable substitution, grrr
+Log='$Log'
+Header='$Header'
+
+: set up shell script to do ~ expansion
+cat >filexp <<EOSS
+$startsh
+: expand filename
+case "\$1" in
+ ~/*|~)
+    echo \$1 | $sed "s|~|\${HOME-\$LOGDIR}|"
+    ;;
+ ~*)
+    if $test -f /bin/csh; then
+       /bin/csh -f -c "glob \$1"
+       echo ""
+    else
+       name=\`$expr x\$1 : '..\([^/]*\)'\`
+       dir=\`$sed -n -e "/^\${name}:/{s/^[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:\([^:]*\).*"'\$'"/\1/" -e p -e q -e '}' </etc/passwd\`
+       if $test ! -d "\$dir"; then
+           me=\`basename \$0\`
+           echo "\$me: can't locate home directory for: \$name" >&2
+           exit 1
+       fi
+       case "\$1" in
+       */*)
+           echo \$dir/\`$expr x\$1 : '..[^/]*/\(.*\)'\`
+           ;;
+       *)
+           echo \$dir
+           ;;
+       esac
+    fi
+    ;;
+*)
+    echo \$1
+    ;;
+esac
+EOSS
+chmod 755 filexp
+$eunicefix filexp
+
+: determine where public executables go
+case "$bin" in
+'')
+    dflt=`loc . /bin /usr/local/bin /usr/lbin /usr/local /usr/bin`
+    ;;
+*)  dflt="$bin"
+    ;;
+esac
+cont=true
+while $test "$cont" ; do
+    echo " "
+    rp="Where do you want to put the public executables? [$dflt]"
+    $echo $n "$rp $c"
+    . myread
+    bin="$ans"
+    bin=`filexp $bin`
+    if test -d $bin; then
+       cont=''
+    else
+       dflt=n
+       rp="Directory $bin doesn't exist.  Use that name anyway? [$dflt]"
+       $echo $n "$rp $c"
+       . myread
+       dflt=''
+       case "$ans" in
+       y*) cont='';;
+       esac
+    fi
+done
+
+: determine where manual pages go
+case "$mansrc" in
+'')
+    dflt=`loc . /usr/man/man1 /usr/man/mann /usr/man/local/man1 /usr/man/u_man/man1 /usr/man/man1`
+    ;;
+*)  dflt="$mansrc"
+    ;;
+esac
+cont=true
+while $test "$cont" ; do
+    echo " "
+    rp="Where do the manual pages (source) go? [$dflt]"
+    $echo $n "$rp $c"
+    . myread
+    mansrc=`filexp "$ans"`
+    if test -d $mansrc; then
+       cont=''
+    else
+       dflt=n
+       rp="Directory $mansrc doesn't exist.  Use that name anyway? [$dflt]"
+       $echo $n "$rp $c"
+       . myread
+       dflt=''
+       case "$ans" in
+       y*) cont='';;
+       esac
+    fi
+done
+case "$mansrc" in
+*l)
+    manext=l
+    ;;
+*n)
+    manext=n
+    ;;
+*)
+    manext=1
+    ;;
+esac
+
+: see how we invoke the C preprocessor
+echo " "
+echo "Checking to see how your C preprocessor is invoked..."
+cat <<'EOT' >testcpp.c
+#define ABC abc
+#define XYZ xyz
+ABC.XYZ
+EOT
+echo '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 "Yup, it does."
+    cpp='cc -E'
+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'
+    else
+       echo 'Nixed again...maybe "/lib/cpp" will work...'
+       /lib/cpp 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='/lib/cpp'
+       else
+           echo 'Hmm...maybe you already told me...'
+           case "$cpp" in
+           '') ;;
+           *) $cpp 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
+               dflt=blurfl
+               $echo $n "Nope. 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
+               if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
+                   echo "OK, that will do."
+               else
+                   echo "Sorry, I can't get that to work.  Go find one."
+                   exit 1
+               fi
+           fi
+       fi
+    fi
+fi
+rm -f testcpp.c testcpp.out
+
+: get C preprocessor symbols handy
+echo " "
+echo $attrlist | $tr '[ ]' '[\012]' >Cppsym.know
+$cat <<EOSS >Cppsym
+$startsh
+case "\$1" in
+-l) list=true
+    shift
+    ;;
+esac
+unknown=''
+case "\$list\$#" in
+1|2)
+    for sym do
+       if $contains "^\$1$" Cppsym.true >/dev/null 2>&1; then
+           exit 0
+       elif $contains "^\$1$" Cppsym.know >/dev/null 2>&1; then
+               :
+       else
+           unknown="\$unknown \$sym"
+       fi
+    done
+    set X \$unknown
+    shift
+    ;;
+esac
+case \$# in
+0) exit 1;;
+esac
+echo \$* | $tr '[ ]' '[\012]' | $sed -e 's/\(.*\)/\\
+#ifdef \1\\
+exit 0; _ _ _ _\1\\     \1\\
+#endif\\
+/' >/tmp/Cppsym\$\$
+echo exit 1 >>/tmp/Cppsym\$\$
+$cpp /tmp/Cppsym\$\$ >/tmp/Cppsym2\$\$
+case "\$list" in
+true) awk '\$6 != "" {print substr(\$6,2,100)}' </tmp/Cppsym2\$\$ ;;
+*)
+    sh /tmp/Cppsym2\$\$
+    status=\$?
+    ;;
+esac
+$rm -f /tmp/Cppsym\$\$ /tmp/Cppsym2\$\$
+exit \$status
+EOSS
+chmod 755 Cppsym
+$eunicefix Cppsym
+echo "Your C preprocessor defines the following symbols:"
+Cppsym -l $attrlist >Cppsym.true
+cat Cppsym.true
+rmlist="$rmlist Cppsym Cppsym.know Cppsym.true"
+
+: see what memory models we can support
+case "$models" in
+'')
+    if Cppsym pdp11; then
+       dflt='unsplit split'
+    else
+       ans=`loc . X /lib/small /lib/large /usr/lib/small /usr/lib/large /lib/medium /usr/lib/medium /lib/huge`
+       case "$ans" in
+       X) dflt='none';;
+       *)  if $test -d /lib/small || $test -d /usr/lib/small; then
+               dflt='small'
+           else
+               dflt=''
+           fi
+           if $test -d /lib/medium || $test -d /usr/lib/medium; then
+               dflt="$dflt medium"
+           fi
+           if $test -d /lib/large || $test -d /usr/lib/large; then
+               dflt="$dflt large"
+           fi
+           if $test -d /lib/huge || $test -d /usr/lib/huge; then
+               dflt="$dflt huge"
+           fi
+       esac
+    fi
+    ;;
+*)  dflt="$models" ;;
+esac
+$cat <<EOM
+Some systems have different model sizes.  On most systems they are called
+small, medium, large, and huge.  On the PDP11 they are called unsplit and
+split.  If your system doesn't support different memory models, say "none".
+If you wish to force everything to one memory model, say "none" here and
+put the appropriate flags later when it asks you for other cc and ld flags.
+Venix systems may wish to put "none" and let the compiler figure things out.
+(In the following question multiple model names should be space separated.)
+
+EOM
+rp="Which models are supported? [$dflt]"
+$echo $n "$rp $c"
+. myread
+models="$ans"
+
+case "$models" in
+none)
+    small=''
+    medium=''
+    large=''
+    huge=''
+    unsplit=''
+    split=''
+    ;;
+*split)
+    case "$split" in
+    '') 
+       if $contains '-i' $mansrc/ld.1 >/dev/null 2>&1 || \
+          $contains '-i' $mansrc/cc.1 >/dev/null 2>&1; then
+           dflt='-i'
+       else
+           dflt='none'
+       fi
+       ;;
+    *) dflt="$split";;
+    esac
+    rp="What flag indicates separate I and D space? [$dflt]"
+    $echo $n "$rp $c"
+    . myread
+    case "$ans" in
+    none) ans='';;
+    esac
+    split="$ans"
+    unsplit=''
+    ;;
+*large*|*small*|*medium*|*huge*)
+    case "$model" in
+    *large*)
+       case "$large" in
+       '') dflt='-Ml';;
+       *) dflt="$large";;
+       esac
+       rp="What flag indicates large model? [$dflt]"
+       $echo $n "$rp $c"
+       . myread
+       case "$ans" in
+       none) ans='';
+       esac
+       large="$ans"
+       ;;
+    *) large='';;
+    esac
+    case "$model" in
+    *huge*)
+       case "$huge" in
+       '') dflt='-Mh';;
+       *) dflt="$huge";;
+       esac
+       rp="What flag indicates huge model? [$dflt]"
+       $echo $n "$rp $c"
+       . myread
+       case "$ans" in
+       none) ans='';
+       esac
+       huge="$ans"
+       ;;
+    *) huge="$large";;
+    esac
+    case "$model" in
+    *medium*)
+       case "$medium" in
+       '') dflt='-Mm';;
+       *) dflt="$medium";;
+       esac
+       rp="What flag indicates medium model? [$dflt]"
+       $echo $n "$rp $c"
+       . myread
+       case "$ans" in
+       none) ans='';
+       esac
+       medium="$ans"
+       ;;
+    *) medium="$large";;
+    esac
+    case "$model" in
+    *small*)
+       case "$small" in
+       '') dflt='none';;
+       *) dflt="$small";;
+       esac
+       rp="What flag indicates small model? [$dflt]"
+       $echo $n "$rp $c"
+       . myread
+       case "$ans" in
+       none) ans='';
+       esac
+       small="$ans"
+       ;;
+    *) small='';;
+    esac
+    ;;
+*)
+    echo "Unrecognized memory models--you may have to edit Makefile.SH"
+    ;;
+esac
+
+case "$ccflags" in
+'') dflt='none';;
+*) dflt="$ccflags";;
+esac
+echo " "
+rp="Any additional cc flags? [$dflt]"
+$echo $n "$rp $c"
+. myread
+case "$ans" in
+none) ans='';
+esac
+ccflags="$ans"
+
+case "$ldflags" in
+'') if venix; then
+       dflt='-i -z'
+    else
+       dflt='none'
+    fi
+    ;;
+*) dflt="$ldflags";;
+esac
+echo " "
+rp="Any additional ld flags? [$dflt]"
+$echo $n "$rp $c"
+. myread
+case "$ans" in
+none) ans='';
+esac
+ldflags="$ans"
+
+: see if we need a special compiler
+echo " "
+if usg; then
+    case "$cc" in
+    '')
+       case "$Mcc" in
+       /*) dflt='Mcc'
+           ;;
+       *)
+           case "$large" in
+           -M*)
+               dflt='cc'
+               ;;
+           *)
+               if $contains '\-M' $mansrc/cc.1 >/dev/null 2>&1 ; then
+                   dflt='cc -M'
+               else
+                   dflt='cc'
+               fi
+               ;;
+           esac
+           ;;
+       esac
+       ;;
+    *)  dflt="$cc";;
+    esac
+    $cat <<'EOM'
+On some systems the default C compiler will not resolve multiple global
+references that happen to have the same name.  On some such systems the
+"Mcc" command may be used to force these to be resolved.  On other systems
+a "cc -M" command is required.  (Note that the -M flag on other systems
+indicates a memory model to use!)  What command will force resolution on
+EOM
+    $echo $n "this system? [$dflt] $c"
+    rp="Command to resolve multiple refs? [$dflt]"
+    . myread
+    cc="$ans"
+else
+    echo "Not a USG system--assuming cc can resolve multiple definitions."
+    cc=cc
+fi
+
+: see if we should include -lnm
+echo " "
+if $test -r /usr/lib/libnm.a || $test -r /usr/local/lib/libnm.a ; then
+    echo "New math library found."
+    libnm='-lnm'
+else
+    ans=`loc libtermlib.a x $libpth`
+    case "$ans" in
+    x)
+       echo "No nm library found--the normal math library will have to do."
+       libnm=''
+       ;;
+    *)
+       echo "New math library found in $ans."
+       libnm="$ans"
+       ;;
+    esac
+fi
+
+echo " "
+echo "End of configuration questions."
+echo " "
+
+: create config.sh file
+echo " "
+if test -d ../UU; then
+    cd ..
+fi
+echo "Creating config.sh..."
+$spitshell <<EOT >config.sh
+$startsh
+# config.sh
+# This file was produced by running the Configure script.
+
+d_eunice='$d_eunice'
+eunicefix='$eunicefix'
+define='$define'
+loclist='$loclist'
+expr='$expr'
+sed='$sed'
+echo='$echo'
+cat='$cat'
+rm='$rm'
+mv='$mv'
+cp='$cp'
+tail='$tail'
+tr='$tr'
+mkdir='$mkdir'
+sort='$sort'
+uniq='$uniq'
+grep='$grep'
+trylist='$trylist'
+test='$test'
+inews='$inews'
+egrep='$egrep'
+more='$more'
+pg='$pg'
+Mcc='$Mcc'
+vi='$vi'
+mailx='$mailx'
+mail='$mail'
+Log='$Log'
+Header='$Header'
+bin='$bin'
+cc='$cc'
+contains='$contains'
+cpp='$cpp'
+d_charsprf='$d_charsprf'
+d_index='$d_index'
+d_strctcpy='$d_strctcpy'
+d_vfork='$d_vfork'
+libc='$libc'
+libnm='$libnm'
+mansrc='$mansrc'
+manext='$manext'
+models='$models'
+split='$split'
+small='$small'
+medium='$medium'
+large='$large'
+huge='$huge'
+ccflags='$ccflags'
+ldflags='$ldflags'
+n='$n'
+c='$c'
+package='$package'
+spitshell='$spitshell'
+shsharp='$shsharp'
+sharpbang='$sharpbang'
+startsh='$startsh'
+voidflags='$voidflags'
+defvoidused='$defvoidused'
+CONFIG=true
+EOT
+CONFIG=true
+
+echo " "
+dflt=''
+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"
+. UU/myread
+case "$ans" in
+'') ;;
+*) : in case they cannot read
+    eval $ans;;
+esac
+
+echo " "
+echo "Doing variable substitutions on .SH files..."
+set `$grep '\.SH' <MANIFEST | awk '{print $1}'`
+for file in $*; do
+    case "$file" in
+    */*)
+       dir=`$expr X$file : 'X\(.*\)/'`
+       file=`$expr X$file : 'X.*/\(.*\)'`
+       (cd $dir && . $file)
+       ;;
+    *)
+       . $file
+       ;;
+    esac
+done
+if test -f config.h.SH; then
+    if test ! -f config.h; then
+       : oops, they left it out of MANIFEST, probably, so do it anyway.
+       . config.h.SH
+    fi
+fi
+
+if $contains '^depend:' Makefile >/dev/null 2>&1; then
+    dflt=n
+    $cat <<EOM
+
+Now you need to generate make dependencies by running "make depend".
+You might prefer to run it in background: "make depend > makedepend.out &"
+It can take a while, so you might not want to run it right now.
+
+EOM
+    rp="Run make depend now? [$dflt]"
+    $echo $n "$rp $c"
+    . UU/myread
+    case "$ans" in
+    y*) make depend
+       echo "Now you must run a make."
+       ;;
+    *)  echo "You must run 'make depend' then 'make'."
+       ;;
+    esac
+elif test -f Makefile; then
+    echo " "
+    echo "Now you must run a make."
+else
+    echo "Done."
+fi
+
+$rm -f kit*isdone
+cd UU && $rm -f $rmlist
+: end of Configure
diff --git a/EXTERN.h b/EXTERN.h
new file mode 100644 (file)
index 0000000..a5fff1f
--- /dev/null
+++ b/EXTERN.h
@@ -0,0 +1,15 @@
+/* $Header: EXTERN.h,v 1.0 87/12/18 13:02:26 root Exp $
+ *
+ * $Log:       EXTERN.h,v $
+ * Revision 1.0  87/12/18  13:02:26  root
+ * Initial revision
+ * 
+ */
+
+#undef EXT
+#define EXT extern
+
+#undef INIT
+#define INIT(x)
+
+#undef DOINIT
diff --git a/INTERN.h b/INTERN.h
new file mode 100644 (file)
index 0000000..06a59f0
--- /dev/null
+++ b/INTERN.h
@@ -0,0 +1,15 @@
+/* $Header: INTERN.h,v 1.0 87/12/18 13:02:39 root Exp $
+ *
+ * $Log:       INTERN.h,v $
+ * Revision 1.0  87/12/18  13:02:39  root
+ * Initial revision
+ * 
+ */
+
+#undef EXT
+#define EXT
+
+#undef INIT
+#define INIT(x) = x
+
+#define DOINIT
diff --git a/MANIFEST b/MANIFEST
new file mode 100644 (file)
index 0000000..085b831
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,112 @@
+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
diff --git a/Makefile.SH b/Makefile.SH
new file mode 100644 (file)
index 0000000..f45bb3f
--- /dev/null
@@ -0,0 +1,168 @@
+case $CONFIG in
+'')
+    if test ! -f config.sh; then
+       ln ../config.sh . || \
+       ln ../../config.sh . || \
+       ln ../../../config.sh . || \
+       (echo "Can't find config.sh."; exit 1)
+    fi
+    . config.sh
+    ;;
+esac
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting Makefile (with variable substitutions)"
+cat >Makefile <<!GROK!THIS!
+# $Header: Makefile.SH,v 1.0 87/12/18 16:11:50 root Exp $
+#
+# $Log:        Makefile.SH,v $
+# Revision 1.0  87/12/18  16:11:50  root
+# Initial revision
+# 
+# Revision 1.0  87/12/18  16:01:07  root
+# Initial revision
+# 
+# 
+
+CC = $cc
+bin = $bin
+lib = $lib
+mansrc = $mansrc
+manext = $manext
+CFLAGS = $ccflags -O
+LDFLAGS = $ldflags
+SMALL = $small
+LARGE = $large $split
+
+libs = $libnm -lm
+!GROK!THIS!
+
+cat >>Makefile <<'!NO!SUBS!'
+
+public = perl
+
+private = 
+
+manpages = perl.man
+
+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
+
+h = $(h1) $(h2)
+
+c1 = arg.c array.c cmd.c dump.c form.c hash.c malloc.c
+c2 = search.c stab.c str.c util.c version.c
+
+c = $(c1) $(c2)
+
+obj1 = arg.o array.o cmd.o dump.o form.o hash.o malloc.o
+obj2 = search.o stab.o str.o util.o version.o
+
+obj = $(obj1) $(obj2)
+
+lintflags = -phbvxac
+
+addedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7
+
+# grrr
+SHELL = /bin/sh
+
+.c.o:
+       $(CC) -c $(CFLAGS) $(LARGE) $*.c
+
+all: $(public) $(private) $(util)
+       touch all
+
+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
+       mv y.tab.c perl.c
+
+perl.o: perl.c perly.c perl.h EXTERN.h search.h util.h INTERN.h handy.h
+       $(CC) -c $(CFLAGS) $(LARGE) perl.c
+
+# if a .h file depends on another .h file...
+$(h):
+       touch $@
+
+perl.man: perl.man.1 perl.man.2
+       cat perl.man.1 perl.man.2 >perl.man
+
+install: perl perl.man
+# won't work with csh
+       export PATH || exit 1
+       - mv $(bin)/perl $(bin)/perl.old
+       - if test `pwd` != $(bin); then cp $(public) $(bin); fi
+       cd $(bin); \
+for pub in $(public); do \
+chmod 755 `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)`; \
+#for priv in $(private); do \
+#chmod 755 `basename $$priv`; \
+#done
+       - if test `pwd` != $(mansrc); then \
+for page in $(manpages); do \
+cp $$page $(mansrc)/`basename $$page .man`.$(manext); \
+done; \
+fi
+
+clean:
+       rm -f *.o
+
+realclean:
+       rm -f perl *.orig */*.orig *.o core $(addedbyconf)
+
+# The following lint has practically everything turned on.  Unfortunately,
+# you have to wade through a lot of mumbo jumbo that can't be suppressed.
+# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message
+# for that spot.
+
+lint:
+       lint $(lintflags) $(defs) $(c) > perl.fuzz
+
+depend: makedepend
+       makedepend
+
+test: perl
+       chmod 755 t/TEST t/base.* t/comp.* t/cmd.* t/io.* t/op.*
+       cd t && (rm -f perl; ln -s ../perl . || ln ../perl .) && TEST
+
+clist:
+       echo $(c) | tr ' ' '\012' >.clist
+
+hlist:
+       echo $(h) | tr ' ' '\012' >.hlist
+
+shlist:
+       echo $(sh) | tr ' ' '\012' >.shlist
+
+# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
+$(obj):
+       @ echo "You haven't done a "'"make depend" yet!'; exit 1
+makedepend: makedepend.SH
+       /bin/sh makedepend.SH
+!NO!SUBS!
+$eunicefix Makefile
+case `pwd` in
+*SH)
+    $rm -f ../Makefile
+    ln Makefile ../Makefile
+    ;;
+esac
diff --git a/README b/README
new file mode 100644 (file)
index 0000000..b5d95e1
--- /dev/null
+++ b/README
@@ -0,0 +1,83 @@
+
+                       Perl Kit, Version 1.0
+
+                   Copyright (c) 1987, 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.
+--------------------------------------------------------------------------
+
+Perl is a language that combines some of the features of C, sed, awk and shell.
+See the manual page for more hype.
+
+Perl will probably not run on machines with a small address space.
+
+Please read all the directions below before you proceed any further, and
+then follow them carefully.  Failure to do so may void your warranty. :-)
+
+After you have unpacked your kit, you should have all the files listed
+in MANIFEST.
+
+Installation
+
+1)  Run Configure.  This will figure out various things about your system.
+    Some things Configure will figure out for itself, other things it will
+    ask you about.  It will then proceed to make config.h, config.sh, and
+    Makefile.
+
+    You might possibly have to trim # comments from the front of Configure
+    if your sh doesn't handle them, but all other # comments will be taken
+    care of.
+
+    (If you don't have sh, you'll have to copy the sample file config.H to
+    config.h and edit the config.h to reflect your system's peculiarities.)
+
+2)  Glance through config.h to make sure system dependencies are correct.
+    Most of them should have been taken care of by running the Configure script.
+
+    If you have any additional changes to make to the C definitions, they
+    can be done in the Makefile, or in config.h.  Bear in mind that they will
+    get undone next time you run Configure.
+
+3)  make depend
+
+    This will look for all the includes and modify Makefile accordingly.
+    Configure will offer to do this for you.
+
+4)  make
+
+    This will attempt to make perl in the current directory.
+
+5)  make test
+
+    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.
+
+6)  make install
+
+    This will put perl into a public directory (normally /usr/local/bin).
+    It will also try to put the man pages in a reasonable place.  It will not
+    nroff the man page, however.  You may need to be root to do this.  If
+    you are not root, you must own the directories in question and you should
+    ignore any messages about chown not working.
+
+7)  Read the manual entry before running perl.
+
+8)  Go down to the x2p directory and do a "make depend, a "make" and a
+    "make install" to create the awk to perl and sed to perl translators.
+
+9)  IMPORTANT!  Help save the world!  Communicate any problems and suggested
+    patches to me, lwall@jpl-devvax.jpl.nasa.gov (Larry Wall), so we can
+    keep the world in sync.  If you have a problem, there's someone else
+    out there who either has had or will have the same problem.
+
+    If possible, send in patches such that the patch program will apply them.
+    Context diffs are the best, then normal diffs.  Don't send ed scripts--
+    I've probably changed my copy since the version you have.
+
+    Watch for perl patches in comp.sources.bugs.  Patches will generally be
+    in a form usable by the patch program.  If you are just now bringing up
+    perl and aren't sure how many patches there are, write to me and I'll
+    send any you don't have.  Your current patch level is shown in patchlevel.h.
+
diff --git a/Wishlist b/Wishlist
new file mode 100644 (file)
index 0000000..1233293
--- /dev/null
+++ b/Wishlist
@@ -0,0 +1,5 @@
+date support
+case statement
+ioctl() support
+random numbers
+directory reading via <>
diff --git a/arg.c b/arg.c
new file mode 100644 (file)
index 0000000..9561bb6
--- /dev/null
+++ b/arg.c
@@ -0,0 +1,2111 @@
+/* $Header: arg.c,v 1.0 87/12/18 13:04:33 root Exp $
+ *
+ * $Log:       arg.c,v $
+ * Revision 1.0  87/12/18  13:04:33  root
+ * Initial revision
+ * 
+ */
+
+#include <signal.h>
+#include "handy.h"
+#include "EXTERN.h"
+#include "search.h"
+#include "util.h"
+#include "perl.h"
+
+ARG *debarg;
+
+bool
+do_match(s,arg)
+register char *s;
+register ARG *arg;
+{
+    register SPAT *spat = arg[2].arg_ptr.arg_spat;
+    register char *d;
+    register char *t;
+
+    if (!spat || !s)
+       fatal("panic: do_match\n");
+    if (spat->spat_flags & SPAT_USED) {
+#ifdef DEBUGGING
+       if (debug & 8)
+           deb("2.SPAT USED\n");
+#endif
+       return FALSE;
+    }
+    if (spat->spat_runtime) {
+       t = str_get(eval(spat->spat_runtime,Null(STR***)));
+#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)
+               curspat = spat;
+           return TRUE;
+       }
+       else
+           return FALSE;
+    }
+    else {
+#ifdef DEBUGGING
+       if (debug & 8) {
+           char ch;
+
+           if (spat->spat_flags & SPAT_USE_ONCE)
+               ch = '?';
+           else
+               ch = '/';
+           deb("2.SPAT %c%s%c\n",ch,spat->spat_compex.precomp,ch);
+       }
+#endif
+       if (spat->spat_compex.complen <= 1 && curspat)
+           spat = curspat;
+       if (spat->spat_first) {
+           if (spat->spat_flags & SPAT_SCANFIRST) {
+               str_free(spat->spat_first);
+               spat->spat_first = Nullstr;     /* disable optimization */
+           }
+           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)
+               curspat = spat;
+           if (spat->spat_flags & SPAT_USE_ONCE)
+               spat->spat_flags |= SPAT_USED;
+           return TRUE;
+       }
+       else
+           return FALSE;
+    }
+    /*NOTREACHED*/
+}
+
+int
+do_subst(str,arg)
+STR *str;
+register ARG *arg;
+{
+    register SPAT *spat;
+    register STR *dstr;
+    register char *s;
+    register char *m;
+
+    spat = arg[2].arg_ptr.arg_spat;
+    s = str_get(str);
+    if (!spat || !s)
+       fatal("panic: do_subst\n");
+    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;
+       }
+    }
+#ifdef DEBUGGING
+    if (debug & 8) {
+       deb("2.SPAT /%s/\n",spat->spat_compex.precomp);
+    }
+#endif
+    if (spat->spat_compex.complen <= 1 && curspat)
+       spat = curspat;
+    if (spat->spat_first) {
+       if (spat->spat_flags & SPAT_SCANFIRST) {
+           str_free(spat->spat_first);
+           spat->spat_first = Nullstr; /* disable optimization */
+       }
+       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)) {
+       int iters = 0;
+
+       dstr = str_new(str_len(str));
+       if (spat->spat_compex.numsubs)
+           curspat = spat;
+       do {
+           if (iters++ > 10000)
+               fatal("Substitution loop?\n");
+           if (spat->spat_compex.numsubs)
+               s = spat->spat_compex.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)
+               break;
+       } while (m = execute(&spat->spat_compex, s, FALSE, 1));
+       str_cat(dstr,s);
+       str_replace(str,dstr);
+       STABSET(str);
+       return iters;
+    }
+    return 0;
+}
+
+int
+do_trans(str,arg)
+STR *str;
+register ARG *arg;
+{
+    register char *tbl;
+    register char *s;
+    register int matches = 0;
+    register int ch;
+
+    tbl = arg[2].arg_ptr.arg_cval;
+    s = str_get(str);
+    if (!tbl || !s)
+       fatal("panic: do_trans\n");
+#ifdef DEBUGGING
+    if (debug & 8) {
+       deb("2.TBL\n");
+    }
+#endif
+    while (*s) {
+       if (ch = tbl[*s & 0377]) {
+           matches++;
+           *s = ch;
+       }
+       s++;
+    }
+    STABSET(str);
+    return matches;
+}
+
+int
+do_split(s,spat,retary)
+register char *s;
+register SPAT *spat;
+STR ***retary;
+{
+    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");
+    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 FALSE;
+       }
+    }
+#ifdef DEBUGGING
+    if (debug & 8) {
+       deb("2.SPAT /%s/\n",spat->spat_compex.precomp);
+    }
+#endif
+    if (retary)
+       ary = myarray;
+    else
+       ary = spat->spat_repl[1].arg_ptr.arg_stab->stab_array;
+    if (!ary)
+       myarray = ary = anew();
+    ary->ary_fill = -1;
+    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 (*s) {                  /* ignore field after final "whitespace" */
+       dstr = str_new(0);      /*   if they interpolate, it's null anyway */
+       str_set(dstr,s);
+       astore(ary, iters++, dstr);
+    }
+    else {
+       while (iters > 0 && !*str_get(afetch(ary,iters-1)))
+           iters--;
+    }
+    if (retary) {
+       sarg = (STR**)safemalloc((iters+2)*sizeof(STR*));
+
+       sarg[0] = Nullstr;
+       sarg[iters+1] = Nullstr;
+       for (i = 1; i <= iters; i++)
+           sarg[i] = afetch(ary,i-1);
+       *retary = sarg;
+    }
+    return iters;
+}
+
+void
+do_join(arg,delim,str)
+register ARG *arg;
+register char *delim;
+register STR *str;
+{
+    STR **tmpary;      /* must not be register */
+    register STR **elem;
+
+    (void)eval(arg[2].arg_ptr.arg_arg,&tmpary);
+    elem = tmpary+1;
+    if (*elem)
+    str_sset(str,*elem++);
+    for (; *elem; elem++) {
+       str_cat(str,delim);
+       str_scat(str,*elem);
+    }
+    STABSET(str);
+    safefree((char*)tmpary);
+}
+
+bool
+do_open(stab,name)
+STAB *stab;
+register char *name;
+{
+    FILE *fp;
+    int len = strlen(name);
+    register STIO *stio = stab->stab_io;
+
+    while (len && isspace(name[len-1]))
+       name[--len] = '\0';
+    if (!stio)
+       stio = stab->stab_io = stio_new();
+    if (stio->fp) {
+       if (stio->type == '|')
+           pclose(stio->fp);
+       else if (stio->type != '-')
+           fclose(stio->fp);
+       stio->fp = Nullfp;
+    }
+    stio->type = *name;
+    if (*name == '|') {
+       for (name++; isspace(*name); name++) ;
+       fp = popen(name,"w");
+    }
+    else if (*name == '>' && name[1] == '>') {
+       for (name += 2; isspace(*name); name++) ;
+       fp = fopen(name,"a");
+    }
+    else if (*name == '>') {
+       for (name++; isspace(*name); name++) ;
+       if (strEQ(name,"-")) {
+           fp = stdout;
+           stio->type = '-';
+       }
+       else
+           fp = fopen(name,"w");
+    }
+    else {
+       if (*name == '<') {
+           for (name++; isspace(*name); name++) ;
+           if (strEQ(name,"-")) {
+               fp = stdin;
+               stio->type = '-';
+           }
+           else
+               fp = fopen(name,"r");
+       }
+       else if (name[len-1] == '|') {
+           name[--len] = '\0';
+           while (len && isspace(name[len-1]))
+               name[--len] = '\0';
+           for (; isspace(*name); name++) ;
+           fp = popen(name,"r");
+           stio->type = '|';
+       }
+       else {
+           stio->type = '<';
+           for (; isspace(*name); name++) ;
+           if (strEQ(name,"-")) {
+               fp = stdin;
+               stio->type = '-';
+           }
+           else
+               fp = fopen(name,"r");
+       }
+    }
+    if (!fp)
+       return FALSE;
+    if (stio->type != '|' && stio->type != '-') {
+       if (fstat(fileno(fp),&statbuf) < 0) {
+           fclose(fp);
+           return FALSE;
+       }
+       if ((statbuf.st_mode & S_IFMT) != S_IFREG &&
+           (statbuf.st_mode & S_IFMT) != S_IFCHR) {
+           fclose(fp);
+           return FALSE;
+       }
+    }
+    stio->fp = fp;
+    return TRUE;
+}
+
+FILE *
+nextargv(stab)
+register STAB *stab;
+{
+    register STR *str;
+    char *oldname;
+
+    while (alen(stab->stab_array) >= 0L) {
+       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) {
+               if (*inplace) {
+                   str_cat(str,inplace);
+#ifdef RENAME
+                   rename(oldname,str->str_ptr);
+#else
+                   UNLINK(str->str_ptr);
+                   link(oldname,str->str_ptr);
+                   UNLINK(oldname);
+#endif
+               }
+               sprintf(tokenbuf,">%s",oldname);
+               do_open(argvoutstab,tokenbuf);
+               defoutstab = argvoutstab;
+           }
+           str_free(str);
+           return stab->stab_io->fp;
+       }
+       else
+           fprintf(stderr,"Can't open %s\n",str_get(str));
+       str_free(str);
+    }
+    if (inplace) {
+       do_close(argvoutstab,FALSE);
+       defoutstab = stabent("stdout",TRUE);
+    }
+    return Nullfp;
+}
+
+bool
+do_close(stab,explicit)
+STAB *stab;
+bool explicit;
+{
+    bool retval = FALSE;
+    register STIO *stio = stab->stab_io;
+
+    if (!stio)         /* never opened */
+       return FALSE;
+    if (stio->fp) {
+       if (stio->type == '|')
+           retval = (pclose(stio->fp) >= 0);
+       else if (stio->type == '-')
+           retval = TRUE;
+       else
+           retval = (fclose(stio->fp) != EOF);
+       stio->fp = Nullfp;
+    }
+    if (explicit)
+       stio->lines = 0;
+    stio->type = ' ';
+    return retval;
+}
+
+bool
+do_eof(stab)
+STAB *stab;
+{
+    register STIO *stio;
+    int ch;
+
+    if (!stab)
+       return TRUE;
+
+    stio = stab->stab_io;
+    if (!stio)
+       return TRUE;
+
+    while (stio->fp) {
+
+#ifdef STDSTDIO                        /* (the code works without this) */
+       if (stio->fp->_cnt)             /* cheat a little, since */
+           return FALSE;               /* this is the most usual case */
+#endif
+
+       ch = getc(stio->fp);
+       if (ch != EOF) {
+           ungetc(ch, stio->fp);
+           return FALSE;
+       }
+       if (stio->flags & IOF_ARGV) {   /* not necessarily a real EOF yet? */
+           if (!nextargv(stab))        /* get another fp handy */
+               return TRUE;
+       }
+       else
+           return TRUE;                /* normal fp, definitely end of file */
+    }
+    return TRUE;
+}
+
+long
+do_tell(stab)
+STAB *stab;
+{
+    register STIO *stio;
+    int ch;
+
+    if (!stab)
+       return -1L;
+
+    stio = stab->stab_io;
+    if (!stio || !stio->fp)
+       return -1L;
+
+    return ftell(stio->fp);
+}
+
+bool
+do_seek(stab, pos, whence)
+STAB *stab;
+long pos;
+int whence;
+{
+    register STIO *stio;
+
+    if (!stab)
+       return FALSE;
+
+    stio = stab->stab_io;
+    if (!stio || !stio->fp)
+       return FALSE;
+
+    return fseek(stio->fp, pos, whence) >= 0;
+}
+
+do_stat(arg,sarg,retary)
+register ARG *arg;
+register STR **sarg;
+STR ***retary;
+{
+    register ARRAY *ary;
+    static ARRAY *myarray = Null(ARRAY*);
+    int max = 13;
+    register int i;
+
+    ary = myarray;
+    if (!ary)
+       myarray = ary = anew();
+    ary->ary_fill = -1;
+    if (arg[1].arg_type == A_LVAL) {
+       tmpstab = arg[1].arg_ptr.arg_stab;
+       if (!tmpstab->stab_io ||
+         fstat(fileno(tmpstab->stab_io->fp),&statbuf) < 0) {
+           max = 0;
+       }
+    }
+    else
+       if (stat(str_get(sarg[1]),&statbuf) < 0)
+           max = 0;
+
+    if (retary) {
+       if (max) {
+           apush(ary,str_nmake((double)statbuf.st_dev));
+           apush(ary,str_nmake((double)statbuf.st_ino));
+           apush(ary,str_nmake((double)statbuf.st_mode));
+           apush(ary,str_nmake((double)statbuf.st_nlink));
+           apush(ary,str_nmake((double)statbuf.st_uid));
+           apush(ary,str_nmake((double)statbuf.st_gid));
+           apush(ary,str_nmake((double)statbuf.st_rdev));
+           apush(ary,str_nmake((double)statbuf.st_size));
+           apush(ary,str_nmake((double)statbuf.st_atime));
+           apush(ary,str_nmake((double)statbuf.st_mtime));
+           apush(ary,str_nmake((double)statbuf.st_ctime));
+           apush(ary,str_nmake((double)statbuf.st_blksize));
+           apush(ary,str_nmake((double)statbuf.st_blocks));
+       }
+       sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
+       sarg[0] = Nullstr;
+       sarg[max+1] = Nullstr;
+       for (i = 1; i <= max; i++)
+           sarg[i] = afetch(ary,i-1);
+       *retary = sarg;
+    }
+    return max;
+}
+
+do_tms(retary)
+STR ***retary;
+{
+    register ARRAY *ary;
+    static ARRAY *myarray = Null(ARRAY*);
+    register STR **sarg;
+    int max = 4;
+    register int i;
+
+    ary = myarray;
+    if (!ary)
+       myarray = ary = anew();
+    ary->ary_fill = -1;
+    if (times(&timesbuf) < 0)
+       max = 0;
+
+    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;
+       for (i = 1; i <= max; i++)
+           sarg[i] = afetch(ary,i-1);
+       *retary = sarg;
+    }
+    return max;
+}
+
+do_time(tmbuf,retary)
+struct tm *tmbuf;
+STR ***retary;
+{
+    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();
+    ary->ary_fill = -1;
+    if (!tmbuf)
+       max = 0;
+
+    if (retary) {
+       if (max) {
+           apush(ary,str_nmake((double)tmbuf->tm_sec));
+           apush(ary,str_nmake((double)tmbuf->tm_min));
+           apush(ary,str_nmake((double)tmbuf->tm_hour));
+           apush(ary,str_nmake((double)tmbuf->tm_mday));
+           apush(ary,str_nmake((double)tmbuf->tm_mon));
+           apush(ary,str_nmake((double)tmbuf->tm_year));
+           apush(ary,str_nmake((double)tmbuf->tm_wday));
+           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;
+       for (i = 1; i <= max; i++)
+           sarg[i] = afetch(ary,i-1);
+       *retary = sarg;
+    }
+    return max;
+}
+
+void
+do_sprintf(str,len,sarg)
+register STR *str;
+register int len;
+register STR **sarg;
+{
+    register char *s;
+    register char *t;
+    bool dolong;
+    char ch;
+
+    str_set(str,"");
+    len--;                     /* don't count pattern string */
+    sarg++;
+    for (s = str_get(*(sarg++)); *sarg && *s && len; len--) {
+       dolong = FALSE;
+       for (t = s; *t && *t != '%'; t++) ;
+       if (!*t)
+           break;              /* not enough % patterns, oh well */
+       for (t++; *sarg && *t && t != s; t++) {
+           switch (*t) {
+           case '\0':
+               break;
+           case '%':
+               ch = *(++t);
+               *t = '\0';
+               sprintf(buf,s);
+               s = t;
+               *(t--) = ch;
+               break;
+           case 'l':
+               dolong = TRUE;
+               break;
+           case 'D': case 'X': case 'O':
+               dolong = TRUE;
+               /* FALL THROUGH */
+           case 'd': case 'x': case 'o': case 'c':
+               ch = *(++t);
+               *t = '\0';
+               if (dolong)
+                   sprintf(buf,s,(long)str_gnum(*(sarg++)));
+               else
+                   sprintf(buf,s,(int)str_gnum(*(sarg++)));
+               s = t;
+               *(t--) = ch;
+               break;
+           case 'E': case 'e': case 'f': case 'G': case 'g':
+               ch = *(++t);
+               *t = '\0';
+               sprintf(buf,s,str_gnum(*(sarg++)));
+               s = t;
+               *(t--) = ch;
+               break;
+           case 's':
+               ch = *(++t);
+               *t = '\0';
+               sprintf(buf,s,str_get(*(sarg++)));
+               s = t;
+               *(t--) = ch;
+               break;
+           }
+       }
+       str_cat(str,buf);
+    }
+    if (*s)
+       str_cat(str,s);
+    STABSET(str);
+}
+
+bool
+do_print(s,fp)
+char *s;
+FILE *fp;
+{
+    if (!fp || !s)
+       return FALSE;
+    fputs(s,fp);
+    return TRUE;
+}
+
+bool
+do_aprint(arg,fp)
+register ARG *arg;
+register FILE *fp;
+{
+    STR **tmpary;      /* must not be register */
+    register STR **elem;
+    register bool retval;
+    double value;
+
+    (void)eval(arg[1].arg_ptr.arg_arg,&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);
+    }
+    else {
+       retval = FALSE;
+       for (elem = tmpary+1; *elem; 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);
+           if (!retval)
+               break;
+       }
+       if (ors)
+           retval = do_print(ors, fp);
+    }
+    safefree((char*)tmpary);
+    return retval;
+}
+
+bool
+do_aexec(arg)
+register ARG *arg;
+{
+    STR **tmpary;      /* must not be register */
+    register STR **elem;
+    register char **a;
+    register int i;
+    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*));
+       a = argv;
+       for (elem = tmpary+1; *elem; elem++) {
+           *a++ = str_get(*elem);
+       }
+       *a = Nullch;
+       execvp(argv[0],argv);
+       safefree((char*)argv);
+    }
+    safefree((char*)tmpary);
+    return FALSE;
+}
+
+bool
+do_exec(cmd)
+char *cmd;
+{
+    STR **tmpary;      /* must not be register */
+    register char **a;
+    register char *s;
+    char **argv;
+
+    /* 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);
+           return FALSE;
+       }
+    }
+    argv = (char**)safemalloc(((s - cmd) / 2 + 2)*sizeof(char*));
+
+    a = argv;
+    for (s = cmd; *s;) {
+       while (isspace(*s)) s++;
+       if (*s)
+           *(a++) = s;
+       while (*s && !isspace(*s)) s++;
+       if (*s)
+           *s++ = '\0';
+    }
+    *a = Nullch;
+    if (argv[0])
+       execvp(argv[0],argv);
+    safefree((char*)argv);
+    return FALSE;
+}
+
+STR *
+do_push(arg,ary)
+register ARG *arg;
+register ARRAY *ary;
+{
+    STR **tmpary;      /* must not be register */
+    register STR **elem;
+    register STR *str = &str_no;
+
+    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
+    for (elem = tmpary+1; *elem; elem++) {
+       str = str_new(0);
+       str_sset(str,*elem);
+       apush(ary,str);
+    }
+    safefree((char*)tmpary);
+    return str;
+}
+
+do_unshift(arg,ary)
+register ARG *arg;
+register ARRAY *ary;
+{
+    STR **tmpary;      /* must not be register */
+    register STR **elem;
+    register STR *str = &str_no;
+    register int i;
+
+    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
+    i = 0;
+    for (elem = tmpary+1; *elem; elem++)
+       i++;
+    aunshift(ary,i);
+    i = 0;
+    for (elem = tmpary+1; *elem; elem++) {
+       str = str_new(0);
+       str_sset(str,*elem);
+       astore(ary,i++,str);
+    }
+    safefree((char*)tmpary);
+}
+
+apply(type,arg,sarg)
+int type;
+register ARG *arg;
+STR **sarg;
+{
+    STR **tmpary;      /* must not be register */
+    register STR **elem;
+    register int i;
+    register int val;
+    register int val2;
+
+    if (sarg)
+       tmpary = sarg;
+    else
+       (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
+    i = 0;
+    for (elem = tmpary+1; *elem; elem++)
+       i++;
+    switch (type) {
+    case O_CHMOD:
+       if (--i > 0) {
+           val = (int)str_gnum(tmpary[1]);
+           for (elem = tmpary+2; *elem; elem++)
+               if (chmod(str_get(*elem),val))
+                   i--;
+       }
+       break;
+    case O_CHOWN:
+       if (i > 2) {
+           i -= 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--;
+       }
+       else
+           i = 0;
+       break;
+    case O_KILL:
+       if (--i > 0) {
+           val = (int)str_gnum(tmpary[1]);
+           if (val < 0)
+               val = -val;
+           for (elem = tmpary+2; *elem; elem++)
+               if (kill(atoi(str_get(*elem)),val))
+                   i--;
+       }
+       break;
+    case O_UNLINK:
+       for (elem = tmpary+1; *elem; elem++)
+           if (UNLINK(str_get(*elem)))
+               i--;
+       break;
+    }
+    if (!sarg)
+       safefree((char*)tmpary);
+    return i;
+}
+
+STR *
+do_subr(arg,sarg)
+register ARG *arg;
+register char **sarg;
+{
+    ARRAY *savearray;
+    STR *str;
+
+    savearray = defstab->stab_array;
+    defstab->stab_array = anew();
+    if (arg[1].arg_flags & AF_SPECIAL)
+       (void)do_push(arg,defstab->stab_array);
+    else if (arg[1].arg_type != A_NULL) {
+       str = str_new(0);
+       str_sset(str,sarg[1]);
+       apush(defstab->stab_array,str);
+    }
+    str = cmd_exec(arg[2].arg_ptr.arg_stab->stab_sub);
+    afree(defstab->stab_array);  /* put back old $_[] */
+    defstab->stab_array = savearray;
+    return str;
+}
+
+void
+do_assign(retstr,arg)
+STR *retstr;
+register ARG *arg;
+{
+    STR **tmpary;      /* must not be register */
+    register ARG *larg = arg[1].arg_ptr.arg_arg;
+    register STR **elem;
+    register STR *str;
+    register ARRAY *ary;
+    register int i;
+    register int lasti;
+    char *s;
+
+    (void)eval(arg[2].arg_ptr.arg_arg,&tmpary);
+
+    if (arg->arg_flags & AF_COMMON) {
+       if (*(tmpary+1)) {
+           for (elem=tmpary+2; *elem; 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 = "";
+           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***));
+               break;
+           }
+           str_set(str,s);
+           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++) {
+           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);
+    STABSET(retstr);
+    safefree((char*)tmpary);
+}
+
+int
+do_kv(hash,kv,sarg,retary)
+HASH *hash;
+int kv;
+register STR **sarg;
+STR ***retary;
+{
+    register ARRAY *ary;
+    int max = 0;
+    int i;
+    static ARRAY *myarray = Null(ARRAY*);
+    register HENT *entry;
+
+    ary = myarray;
+    if (!ary)
+       myarray = ary = anew();
+    ary->ary_fill = -1;
+
+    hiterinit(hash);
+    while (entry = hiternext(hash)) {
+       max++;
+       if (kv == O_KEYS)
+           apush(ary,str_make(hiterkey(entry)));
+       else
+           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;
+       for (i = 1; i <= max; i++)
+           sarg[i] = afetch(ary,i-1);
+       *retary = sarg;
+    }
+    return max;
+}
+
+STR *
+do_each(hash,sarg,retary)
+HASH *hash;
+register STR **sarg;
+STR ***retary;
+{
+    static STR *mystr = Nullstr;
+    STR *retstr;
+    HENT *entry = hiternext(hash);
+
+    if (mystr) {
+       str_free(mystr);
+       mystr = Nullstr;
+    }
+
+    if (retary) { /* array wanted */
+       if (entry) {
+           sarg = (STR**)saferealloc((char*)sarg,4*sizeof(STR*));
+           sarg[0] = Nullstr;
+           sarg[3] = Nullstr;
+           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;
+           *retary = sarg;
+       }
+    }
+    else
+       retstr = hiterval(entry);
+       
+    return retstr;
+}
+
+init_eval()
+{
+    register int i;
+
+#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);
+    opargs[O_BIT_OR] =         A(1,1,0);
+    opargs[O_AND] =            A(1,0,0);       /* don't eval arg 2 (yet) */
+    opargs[O_OR] =             A(1,0,0);       /* don't eval arg 2 (yet) */
+    opargs[O_COND_EXPR] =      A(1,0,0);       /* don't eval args 2 or 3 */
+    opargs[O_COMMA] =          A(1,1,0);
+    opargs[O_NEGATE] =         A(1,0,0);
+    opargs[O_NOT] =            A(1,0,0);
+    opargs[O_COMPLEMENT] =     A(1,0,0);
+    opargs[O_WRITE] =          A(1,0,0);
+    opargs[O_OPEN] =           A(1,1,0);
+    opargs[O_TRANS] =          A(1,0,0);
+    opargs[O_NTRANS] =         A(1,0,0);
+    opargs[O_CLOSE] =          A(0,0,0);
+    opargs[O_ARRAY] =          A(1,0,0);
+    opargs[O_HASH] =           A(1,0,0);
+    opargs[O_LARRAY] =         A(1,0,0);
+    opargs[O_LHASH] =          A(1,0,0);
+    opargs[O_PUSH] =           A(1,0,0);
+    opargs[O_POP] =            A(0,0,0);
+    opargs[O_SHIFT] =          A(0,0,0);
+    opargs[O_SPLIT] =          A(1,0,0);
+    opargs[O_LENGTH] =         A(1,0,0);
+    opargs[O_SPRINTF] =                A(1,0,0);
+    opargs[O_SUBSTR] =         A(1,1,1);
+    opargs[O_JOIN] =           A(1,0,0);
+    opargs[O_SLT] =            A(1,1,0);
+    opargs[O_SGT] =            A(1,1,0);
+    opargs[O_SLE] =            A(1,1,0);
+    opargs[O_SGE] =            A(1,1,0);
+    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_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_LAST] =           A(1,0,0);
+    opargs[O_NEXT] =           A(1,0,0);
+    opargs[O_REDO] =           A(1,0,0);
+    opargs[O_GOTO] =           A(1,0,0);
+    opargs[O_INDEX] =          A(1,1,0);
+    opargs[O_TIME] =           A(0,0,0);
+    opargs[O_TMS] =            A(0,0,0);
+    opargs[O_LOCALTIME] =      A(1,0,0);
+    opargs[O_GMTIME] =         A(1,0,0);
+    opargs[O_STAT] =           A(1,0,0);
+    opargs[O_CRYPT] =          A(1,1,0);
+    opargs[O_EXP] =            A(1,0,0);
+    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_ORD] =            A(1,0,0);
+    opargs[O_SLEEP] =          A(1,0,0);
+    opargs[O_FLIP] =           A(1,0,0);
+    opargs[O_FLOP] =           A(0,1,0);
+    opargs[O_KEYS] =           A(0,0,0);
+    opargs[O_VALUES] =         A(0,0,0);
+    opargs[O_EACH] =           A(0,0,0);
+    opargs[O_CHOP] =           A(1,0,0);
+    opargs[O_FORK] =           A(1,0,0);
+    opargs[O_EXEC] =           A(1,0,0);
+    opargs[O_SYSTEM] =         A(1,0,0);
+    opargs[O_OCT] =            A(1,0,0);
+    opargs[O_HEX] =            A(1,0,0);
+    opargs[O_CHMOD] =          A(1,0,0);
+    opargs[O_CHOWN] =          A(1,0,0);
+    opargs[O_KILL] =           A(1,0,0);
+    opargs[O_RENAME] =         A(1,1,0);
+    opargs[O_UNLINK] =         A(1,0,0);
+    opargs[O_UMASK] =          A(1,0,0);
+    opargs[O_UNSHIFT] =                A(1,0,0);
+    opargs[O_LINK] =           A(1,1,0);
+    opargs[O_REPEAT] =         A(1,1,0);
+}
+
+static int (*ihand)();
+static int (*qhand)();
+
+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:
+       tmps = str_get(sarg[1]);
+       str_set(str,crypt(tmps,str_get(sarg[2])));
+       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;
+    }
+#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;
+}
diff --git a/arg.h b/arg.h
new file mode 100644 (file)
index 0000000..2e1bd8a
--- /dev/null
+++ b/arg.h
@@ -0,0 +1,314 @@
+/* $Header: arg.h,v 1.0 87/12/18 13:04:39 root Exp $
+ *
+ * $Log:       arg.h,v $
+ * Revision 1.0  87/12/18  13:04:39  root
+ * Initial revision
+ * 
+ */
+
+#define O_NULL 0
+#define O_ITEM 1
+#define O_ITEM2 2
+#define O_ITEM3 3
+#define O_CONCAT 4
+#define O_MATCH 5
+#define O_NMATCH 6
+#define O_SUBST 7
+#define O_NSUBST 8
+#define O_ASSIGN 9
+#define O_MULTIPLY 10
+#define O_DIVIDE 11
+#define O_MODULO 12
+#define O_ADD 13
+#define O_SUBTRACT 14
+#define O_LEFT_SHIFT 15
+#define O_RIGHT_SHIFT 16
+#define O_LT 17
+#define O_GT 18
+#define O_LE 19
+#define O_GE 20
+#define O_EQ 21
+#define O_NE 22
+#define O_BIT_AND 23
+#define O_XOR 24
+#define O_BIT_OR 25
+#define O_AND 26
+#define O_OR 27
+#define O_COND_EXPR 28
+#define O_COMMA 29
+#define O_NEGATE 30
+#define O_NOT 31
+#define O_COMPLEMENT 32
+#define O_WRITE 33
+#define O_OPEN 34
+#define O_TRANS 35
+#define O_NTRANS 36
+#define O_CLOSE 37
+#define O_ARRAY 38
+#define O_HASH 39
+#define O_LARRAY 40
+#define O_LHASH 41
+#define O_PUSH 42
+#define O_POP 43
+#define O_SHIFT 44
+#define O_SPLIT 45
+#define O_LENGTH 46
+#define O_SPRINTF 47
+#define O_SUBSTR 48
+#define O_JOIN 49
+#define O_SLT 50
+#define O_SGT 51
+#define O_SLE 52
+#define O_SGE 53
+#define O_SEQ 54
+#define O_SNE 55
+#define O_SUBR 56
+#define O_PRINT 57
+#define O_CHDIR 58
+#define O_DIE 59
+#define O_EXIT 60
+#define O_RESET 61
+#define O_LIST 62
+#define O_SELECT 63
+#define O_EOF 64
+#define O_TELL 65
+#define O_SEEK 66
+#define O_LAST 67
+#define O_NEXT 68
+#define O_REDO 69
+#define O_GOTO 70
+#define O_INDEX 71
+#define O_TIME 72
+#define O_TMS 73
+#define O_LOCALTIME 74
+#define O_GMTIME 75
+#define O_STAT 76
+#define O_CRYPT 77
+#define O_EXP 78
+#define O_LOG 79
+#define O_SQRT 80
+#define O_INT 81
+#define O_PRTF 82
+#define O_ORD 83
+#define O_SLEEP 84
+#define O_FLIP 85
+#define O_FLOP 86
+#define O_KEYS 87
+#define O_VALUES 88
+#define O_EACH 89
+#define O_CHOP 90
+#define O_FORK 91
+#define O_EXEC 92
+#define O_SYSTEM 93
+#define O_OCT 94
+#define O_HEX 95
+#define O_CHMOD 96
+#define O_CHOWN 97
+#define O_KILL 98
+#define O_RENAME 99
+#define O_UNLINK 100
+#define O_UMASK 101
+#define O_UNSHIFT 102
+#define O_LINK 103
+#define O_REPEAT 104
+#define MAXO 105
+
+#ifndef DOINIT
+extern char *opname[];
+#else
+char *opname[] = {
+    "NULL",
+    "ITEM",
+    "ITEM2",
+    "ITEM3",
+    "CONCAT",
+    "MATCH",
+    "NMATCH",
+    "SUBST",
+    "NSUBST",
+    "ASSIGN",
+    "MULTIPLY",
+    "DIVIDE",
+    "MODULO",
+    "ADD",
+    "SUBTRACT",
+    "LEFT_SHIFT",
+    "RIGHT_SHIFT",
+    "LT",
+    "GT",
+    "LE",
+    "GE",
+    "EQ",
+    "NE",
+    "BIT_AND",
+    "XOR",
+    "BIT_OR",
+    "AND",
+    "OR",
+    "COND_EXPR",
+    "COMMA",
+    "NEGATE",
+    "NOT",
+    "COMPLEMENT",
+    "WRITE",
+    "OPEN",
+    "TRANS",
+    "NTRANS",
+    "CLOSE",
+    "ARRAY",
+    "HASH",
+    "LARRAY",
+    "LHASH",
+    "PUSH",
+    "POP",
+    "SHIFT",
+    "SPLIT",
+    "LENGTH",
+    "SPRINTF",
+    "SUBSTR",
+    "JOIN",
+    "SLT",
+    "SGT",
+    "SLE",
+    "SGE",
+    "SEQ",
+    "SNE",
+    "SUBR",
+    "PRINT",
+    "CHDIR",
+    "DIE",
+    "EXIT",
+    "RESET",
+    "LIST",
+    "SELECT",
+    "EOF",
+    "TELL",
+    "SEEK",
+    "LAST",
+    "NEXT",
+    "REDO",
+    "GOTO",/* shudder */
+    "INDEX",
+    "TIME",
+    "TIMES",
+    "LOCALTIME",
+    "GMTIME",
+    "STAT",
+    "CRYPT",
+    "EXP",
+    "LOG",
+    "SQRT",
+    "INT",
+    "PRINTF",
+    "ORD",
+    "SLEEP",
+    "FLIP",
+    "FLOP",
+    "KEYS",
+    "VALUES",
+    "EACH",
+    "CHOP",
+    "FORK",
+    "EXEC",
+    "SYSTEM",
+    "OCT",
+    "HEX",
+    "CHMOD",
+    "CHOWN",
+    "KILL",
+    "RENAME",
+    "UNLINK",
+    "UMASK",
+    "UNSHIFT",
+    "LINK",
+    "REPEAT",
+    "105"
+};
+#endif
+
+#define A_NULL 0
+#define A_EXPR 1
+#define A_CMD 2
+#define A_STAB 3
+#define A_LVAL 4
+#define A_SINGLE 5
+#define A_DOUBLE 6
+#define A_BACKTICK 7
+#define A_READ 8
+#define A_SPAT 9
+#define A_LEXPR 10
+#define A_ARYLEN 11
+#define A_NUMBER 12
+
+#ifndef DOINIT
+extern char *argname[];
+#else
+char *argname[] = {
+    "A_NULL",
+    "EXPR",
+    "CMD",
+    "STAB",
+    "LVAL",
+    "SINGLE",
+    "DOUBLE",
+    "BACKTICK",
+    "READ",
+    "SPAT",
+    "LEXPR",
+    "ARYLEN",
+    "NUMBER",
+    "13"
+};
+#endif
+
+#ifndef DOINIT
+extern bool hoistable[];
+#else
+bool hoistable[] = {0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0};
+#endif
+
+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;
+    short      arg_len;
+    char       arg_type;
+    char       arg_flags;
+};
+
+#define AF_SPECIAL 1           /* op wants to evaluate this arg itself */
+#define AF_POST 2              /* post *crement this item */
+#define AF_PRE 4               /* pre *crement this item */
+#define AF_UP 8                        /* increment rather than decrement */
+#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 */
+
+/*
+ * Most of the ARG pointers are used as pointers to arrays of ARG.  When
+ * so used, the 0th element is special, and represents the operator to
+ * use on the list of arguments following.  The arg_len in the 0th element
+ * gives the maximum argument number, and the arg_str is used to store
+ * the return value in a more-or-less static location.  Sorry it's not
+ * re-entrant, but it sure makes it efficient.  The arg_type of the
+ * 0th element is an operator (O_*) rather than an argument type (A_*).
+ */
+
+#define Nullarg Null(ARG*)
+
+EXT char opargs[MAXO];
+
+int do_trans();
+int do_split();
+bool do_eof();
+long do_tell();
+bool do_seek();
+int do_tms();
+int do_time();
+int do_stat();
diff --git a/array.c b/array.c
new file mode 100644 (file)
index 0000000..156b783
--- /dev/null
+++ b/array.c
@@ -0,0 +1,182 @@
+/* $Header: array.c,v 1.0 87/12/18 13:04:42 root Exp $
+ *
+ * $Log:       array.c,v $
+ * Revision 1.0  87/12/18  13:04:42  root
+ * Initial revision
+ * 
+ */
+
+#include <stdio.h>
+#include "EXTERN.h"
+#include "handy.h"
+#include "util.h"
+#include "search.h"
+#include "perl.h"
+
+STR *
+afetch(ar,key)
+register ARRAY *ar;
+int key;
+{
+    if (key < 0 || key > ar->ary_max)
+       return Nullstr;
+    return ar->ary_array[key];
+}
+
+bool
+astore(ar,key,val)
+register ARRAY *ar;
+int key;
+STR *val;
+{
+    bool retval;
+
+    if (key < 0)
+       return FALSE;
+    if (key > ar->ary_max) {
+       int newmax = key + ar->ary_max / 5;
+
+       ar->ary_array = (STR**)saferealloc((char*)ar->ary_array,
+           (newmax+1) * sizeof(STR*));
+       bzero((char*)&ar->ary_array[ar->ary_max+1],
+           (newmax - ar->ary_max) * sizeof(STR*));
+       ar->ary_max = newmax;
+    }
+    if (key > ar->ary_fill)
+       ar->ary_fill = key;
+    retval = (ar->ary_array[key] != Nullstr);
+    if (retval)
+       str_free(ar->ary_array[key]);
+    ar->ary_array[key] = val;
+    return retval;
+}
+
+bool
+adelete(ar,key)
+register ARRAY *ar;
+int key;
+{
+    if (key < 0 || key > ar->ary_max)
+       return FALSE;
+    if (ar->ary_array[key]) {
+       str_free(ar->ary_array[key]);
+       ar->ary_array[key] = Nullstr;
+       return TRUE;
+    }
+    return FALSE;
+}
+
+ARRAY *
+anew()
+{
+    register ARRAY *ar = (ARRAY*)safemalloc(sizeof(ARRAY));
+
+    ar->ary_array = (STR**) safemalloc(5 * sizeof(STR*));
+    ar->ary_fill = -1;
+    ar->ary_max = 4;
+    bzero((char*)ar->ary_array, 5 * sizeof(STR*));
+    return ar;
+}
+
+void
+afree(ar)
+register ARRAY *ar;
+{
+    register int key;
+
+    if (!ar)
+       return;
+    for (key = 0; key <= ar->ary_fill; key++)
+       str_free(ar->ary_array[key]);
+    safefree((char*)ar->ary_array);
+    safefree((char*)ar);
+}
+
+bool
+apush(ar,val)
+register ARRAY *ar;
+STR *val;
+{
+    return astore(ar,++(ar->ary_fill),val);
+}
+
+STR *
+apop(ar)
+register ARRAY *ar;
+{
+    STR *retval;
+
+    if (ar->ary_fill < 0)
+       return Nullstr;
+    retval = ar->ary_array[ar->ary_fill];
+    ar->ary_array[ar->ary_fill--] = Nullstr;
+    return retval;
+}
+
+aunshift(ar,num)
+register ARRAY *ar;
+register int num;
+{
+    register int i;
+    register STR **sstr,**dstr;
+
+    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;
+    for (i = ar->ary_fill; i >= 0; i--) {
+       *dstr-- = *sstr--;
+    }
+    bzero((char*)(ar->ary_array), num * sizeof(STR*));
+}
+
+STR *
+ashift(ar)
+register ARRAY *ar;
+{
+    STR *retval;
+
+    if (ar->ary_fill < 0)
+       return Nullstr;
+    retval = ar->ary_array[0];
+    bcopy((char*)(ar->ary_array+1),(char*)ar->ary_array,
+      ar->ary_fill * sizeof(STR*));
+    ar->ary_array[ar->ary_fill--] = Nullstr;
+    return retval;
+}
+
+long
+alen(ar)
+register ARRAY *ar;
+{
+    return (long)ar->ary_fill;
+}
+
+void
+ajoin(ar,delim,str)
+register ARRAY *ar;
+char *delim;
+register STR *str;
+{
+    register int i;
+    register int len;
+    register int dlen;
+
+    if (ar->ary_fill < 0) {
+       str_set(str,"");
+       STABSET(str);
+       return;
+    }
+    dlen = strlen(delim);
+    len = ar->ary_fill * dlen;         /* account for delimiters */
+    for (i = ar->ary_fill; i >= 0; i--)
+       len += str_len(ar->ary_array[i]);
+    str_grow(str,len);                 /* preallocate for efficiency */
+    str_sset(str,ar->ary_array[0]);
+    for (i = 1; i <= ar->ary_fill; i++) {
+       str_ncat(str,delim,dlen);
+       str_scat(str,ar->ary_array[i]);
+    }
+    STABSET(str);
+}
diff --git a/array.h b/array.h
new file mode 100644 (file)
index 0000000..4ad9487
--- /dev/null
+++ b/array.h
@@ -0,0 +1,22 @@
+/* $Header: array.h,v 1.0 87/12/18 13:04:46 root Exp $
+ *
+ * $Log:       array.h,v $
+ * Revision 1.0  87/12/18  13:04:46  root
+ * Initial revision
+ * 
+ */
+
+struct atbl {
+    STR        **ary_array;
+    int        ary_max;
+    int        ary_fill;
+};
+
+STR *afetch();
+bool astore();
+bool adelete();
+STR *apop();
+STR *ashift();
+bool apush();
+long alen();
+ARRAY *anew();
diff --git a/cmd.c b/cmd.c
new file mode 100644 (file)
index 0000000..ba57a2a
--- /dev/null
+++ b/cmd.c
@@ -0,0 +1,453 @@
+/* $Header: cmd.c,v 1.0 87/12/18 13:04:51 root Exp $
+ *
+ * $Log:       cmd.c,v $
+ * Revision 1.0  87/12/18  13:04:51  root
+ * Initial revision
+ * 
+ */
+
+#include "handy.h"
+#include "EXTERN.h"
+#include "search.h"
+#include "util.h"
+#include "perl.h"
+
+static STR str_chop;
+
+/* This is the main command loop.  We try to spend as much time in this loop
+ * as possible, so lots of optimizations do their activities in here.  This
+ * means things get a little sloppy.
+ */
+
+STR *
+cmd_exec(cmd)
+register CMD *cmd;
+{
+    SPAT *oldspat;
+#ifdef DEBUGGING
+    int olddlevel;
+    int entdlevel;
+#endif
+    register STR *retstr;
+    register char *tmps;
+    register int cmdflags;
+    register bool match;
+    register char *go_to = goto_targ;
+    ARG *arg;
+    FILE *fp;
+
+    retstr = &str_no;
+#ifdef DEBUGGING
+    entdlevel = dlevel;
+#endif
+tail_recursion_entry:
+#ifdef DEBUGGING
+    dlevel = entdlevel;
+#endif
+    if (cmd == Nullcmd)
+       return retstr;
+    cmdflags = cmd->c_flags;   /* hopefully load register */
+    if (go_to) {
+       if (cmd->c_label && strEQ(go_to,cmd->c_label))
+           goto_targ = go_to = Nullch;         /* here at last */
+       else {
+           switch (cmd->c_type) {
+           case C_IF:
+               oldspat = curspat;
+#ifdef DEBUGGING
+               olddlevel = dlevel;
+#endif
+               retstr = &str_yes;
+               if (cmd->ucmd.ccmd.cc_true) {
+#ifdef DEBUGGING
+                   debname[dlevel] = 't';
+                   debdelim[dlevel++] = '_';
+#endif
+                   retstr = cmd_exec(cmd->ucmd.ccmd.cc_true);
+               }
+               if (!goto_targ) {
+                   go_to = Nullch;
+               } else {
+                   retstr = &str_no;
+                   if (cmd->ucmd.ccmd.cc_alt) {
+#ifdef DEBUGGING
+                       debname[dlevel] = 'e';
+                       debdelim[dlevel++] = '_';
+#endif
+                       retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt);
+                   }
+               }
+               if (!goto_targ)
+                   go_to = Nullch;
+               curspat = oldspat;
+#ifdef DEBUGGING
+               dlevel = olddlevel;
+#endif
+               break;
+           case C_BLOCK:
+           case C_WHILE:
+               if (!(cmdflags & CF_ONCE)) {
+                   cmdflags |= CF_ONCE;
+                   loop_ptr++;
+                   loop_stack[loop_ptr].loop_label = cmd->c_label;
+#ifdef DEBUGGING
+                   if (debug & 4) {
+                       deb("(Pushing label #%d %s)\n",
+                         loop_ptr,cmd->c_label);
+                   }
+#endif
+               }
+               switch (setjmp(loop_stack[loop_ptr].loop_env)) {
+               case O_LAST:    /* not done unless go_to found */
+                   go_to = Nullch;
+                   retstr = &str_no;
+#ifdef DEBUGGING
+                   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;
+               case O_NEXT:    /* not done unless go_to found */
+                   go_to = Nullch;
+                   goto next_iter;
+               case O_REDO:    /* not done unless go_to found */
+                   go_to = Nullch;
+                   goto doit;
+               }
+               oldspat = curspat;
+#ifdef DEBUGGING
+               olddlevel = dlevel;
+#endif
+               if (cmd->ucmd.ccmd.cc_true) {
+#ifdef DEBUGGING
+                   debname[dlevel] = 't';
+                   debdelim[dlevel++] = '_';
+#endif
+                   cmd_exec(cmd->ucmd.ccmd.cc_true);
+               }
+               if (!goto_targ) {
+                   go_to = Nullch;
+                   goto next_iter;
+               }
+#ifdef DEBUGGING
+               dlevel = olddlevel;
+#endif
+               if (cmd->ucmd.ccmd.cc_alt) {
+#ifdef DEBUGGING
+                   debname[dlevel] = 'a';
+                   debdelim[dlevel++] = '_';
+#endif
+                   cmd_exec(cmd->ucmd.ccmd.cc_alt);
+               }
+               if (goto_targ)
+                   break;
+               go_to = Nullch;
+               goto finish_while;
+           }
+           cmd = cmd->c_next;
+           if (cmd && cmd->c_head == cmd)      /* reached end of while loop */
+               return retstr;          /* targ isn't in this block */
+           goto tail_recursion_entry;
+       }
+    }
+
+until_loop:
+
+#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);
+    }
+    debname[dlevel] = cmdname[cmd->c_type][0];
+    debdelim[dlevel++] = '!';
+#endif
+    while (tmps_max >= 0)              /* clean up after last eval */
+       str_free(tmps_list[tmps_max--]);
+
+    /* Here is some common optimization */
+
+    if (cmdflags & CF_COND) {
+       switch (cmdflags & CF_OPTIMIZE) {
+
+       case CFT_FALSE:
+           retstr = cmd->c_first;
+           match = FALSE;
+           if (cmdflags & CF_NESURE)
+               goto maybe;
+           break;
+       case CFT_TRUE:
+           retstr = cmd->c_first;
+           match = TRUE;
+           if (cmdflags & CF_EQSURE)
+               goto flipmaybe;
+           break;
+
+       case CFT_REG:
+           retstr = STAB_STR(cmd->c_stab);
+           match = str_true(retstr);   /* => retstr = retstr, c2 should fix */
+           if (cmdflags & (match ? CF_EQSURE : CF_NESURE))
+               goto flipmaybe;
+           break;
+
+       case CFT_ANCHOR:        /* /^pat/ optimization */
+           if (multiline) {
+               if (*cmd->c_first->str_ptr && !(cmdflags & CF_EQSURE))
+                   goto scanner;       /* just unanchor it */
+               else
+                   break;              /* must evaluate */
+           }
+           /* 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 (cmdflags & CF_EQSURE) {
+                   match = !(cmdflags & CF_FIRSTNEG);
+                   retstr = &str_yes;
+                   goto flipmaybe;
+               }
+           }
+           else if (cmdflags & CF_NESURE) {
+               match = cmdflags & CF_FIRSTNEG;
+               retstr = &str_no;
+               goto flipmaybe;
+           }
+           break;                      /* must evaluate */
+
+       case CFT_SCAN:                  /* non-anchored search */
+         scanner:
+           retstr = STAB_STR(cmd->c_stab);
+           if (instr(str_get(retstr),cmd->c_first->str_ptr)) {
+               if (cmdflags & CF_EQSURE) {
+                   match = !(cmdflags & CF_FIRSTNEG);
+                   retstr = &str_yes;
+                   goto flipmaybe;
+               }
+           }
+           else if (cmdflags & CF_NESURE) {
+               match = cmdflags & CF_FIRSTNEG;
+               retstr = &str_no;
+               goto flipmaybe;
+           }
+           break;                      /* must evaluate */
+
+       case CFT_GETS:                  /* really a while (<file>) */
+           last_in_stab = cmd->c_stab;
+           fp = last_in_stab->stab_io->fp;
+           retstr = defstab->stab_val;
+           if (fp && str_gets(retstr, fp)) {
+               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 */
+           else {
+               retstr = &str_no;
+               match = FALSE;
+           }
+           goto flipmaybe;
+       case CFT_EVAL:
+           break;
+       case CFT_UNFLIP:
+           retstr = eval(cmd->c_expr,Null(char***));
+           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);
+           goto maybe;
+       case CFT_CHOP:
+           retstr = cmd->c_stab->stab_val;
+           match = (retstr->str_cur != 0);
+           tmps = str_get(retstr);
+           tmps += retstr->str_cur - match;
+           str_set(&str_chop,tmps);
+           *tmps = '\0';
+           retstr->str_nok = 0;
+           retstr->str_cur = tmps - retstr->str_ptr;
+           retstr = &str_chop;
+           goto flipmaybe;
+       }
+
+    /* we have tried to make this normal case as abnormal as possible */
+
+    doeval:
+       retstr = eval(cmd->c_expr,Null(char***));
+       match = str_true(retstr);
+       goto maybe;
+
+    /* if flipflop was true, flop it */
+
+    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 */
+               cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
+           }
+           else {
+               retstr = eval(cmd->c_expr,Null(char***)); /* 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);
+           }
+       }
+       else if (cmdflags & CF_FLIP) {
+           if (cmd->c_expr->arg_type == O_FLOP) {      /* currently toggled? */
+               match = TRUE;                           /* force on */
+           }
+       }
+
+    /* at this point, match says whether our expression was true */
+
+    maybe:
+       if (cmdflags & CF_INVERT)
+           match = !match;
+       if (!match && cmd->c_type != C_IF) {
+           cmd = cmd->c_next;
+           goto tail_recursion_entry;
+       }
+    }
+
+    /* now to do the actual command, if any */
+
+    switch (cmd->c_type) {
+    case C_NULL:
+       fatal("panic: cmd_exec\n");
+    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***));
+       }
+       break;
+    case C_IF:
+       oldspat = curspat;
+#ifdef DEBUGGING
+       olddlevel = dlevel;
+#endif
+       if (match) {
+           retstr = &str_yes;
+           if (cmd->ucmd.ccmd.cc_true) {
+#ifdef DEBUGGING
+               debname[dlevel] = 't';
+               debdelim[dlevel++] = '_';
+#endif
+               retstr = cmd_exec(cmd->ucmd.ccmd.cc_true);
+           }
+       }
+       else {
+           retstr = &str_no;
+           if (cmd->ucmd.ccmd.cc_alt) {
+#ifdef DEBUGGING
+               debname[dlevel] = 'e';
+               debdelim[dlevel++] = '_';
+#endif
+               retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt);
+           }
+       }
+       curspat = oldspat;
+#ifdef DEBUGGING
+       dlevel = olddlevel;
+#endif
+       break;
+    case C_BLOCK:
+    case C_WHILE:
+       if (!(cmdflags & CF_ONCE)) {    /* first time through here? */
+           cmdflags |= CF_ONCE;
+           loop_ptr++;
+           loop_stack[loop_ptr].loop_label = cmd->c_label;
+#ifdef DEBUGGING
+           if (debug & 4) {
+               deb("(Pushing label #%d %s)\n",
+                 loop_ptr,cmd->c_label);
+           }
+#endif
+       }
+       switch (setjmp(loop_stack[loop_ptr].loop_env)) {
+       case O_LAST:
+           retstr = &str_no;
+           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;
+       case O_NEXT:
+           goto next_iter;
+       case O_REDO:
+           goto doit;
+       }
+       oldspat = curspat;
+#ifdef DEBUGGING
+       olddlevel = dlevel;
+#endif
+    doit:
+       if (cmd->ucmd.ccmd.cc_true) {
+#ifdef DEBUGGING
+           debname[dlevel] = 't';
+           debdelim[dlevel++] = '_';
+#endif
+           cmd_exec(cmd->ucmd.ccmd.cc_true);
+       }
+       /* actually, this spot is never reached anymore since the above
+        * cmd_exec() returns through longjmp().  Hooray for structure.
+        */
+      next_iter:
+#ifdef DEBUGGING
+       dlevel = olddlevel;
+#endif
+       if (cmd->ucmd.ccmd.cc_alt) {
+#ifdef DEBUGGING
+           debname[dlevel] = 'a';
+           debdelim[dlevel++] = '_';
+#endif
+           cmd_exec(cmd->ucmd.ccmd.cc_alt);
+       }
+      finish_while:
+       curspat = oldspat;
+#ifdef DEBUGGING
+       dlevel = olddlevel - 1;
+#endif
+       if (cmd->c_type != C_BLOCK)
+           goto until_loop;    /* go back and evaluate conditional again */
+    }
+    if (cmdflags & CF_LOOP) {
+       cmdflags |= CF_COND;            /* now test the condition */
+       goto until_loop;
+    }
+    cmd = cmd->c_next;
+    goto tail_recursion_entry;
+}
+
+#ifdef DEBUGGING
+/*VARARGS1*/
+deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
+char *pat;
+{
+    register int i;
+
+    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);
+}
+#endif
+
+copyopt(cmd,which)
+register CMD *cmd;
+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_stab = which->c_stab;
+    return cmd->c_flags;
+}
diff --git a/cmd.h b/cmd.h
new file mode 100644 (file)
index 0000000..9eb4a8f
--- /dev/null
+++ b/cmd.h
@@ -0,0 +1,122 @@
+/* $Header: cmd.h,v 1.0 87/12/18 13:04:59 root Exp $
+ *
+ * $Log:       cmd.h,v $
+ * Revision 1.0  87/12/18  13:04:59  root
+ * Initial revision
+ * 
+ */
+
+#define C_NULL 0
+#define C_IF 1
+#define C_WHILE 2
+#define C_EXPR 3
+#define C_BLOCK 4
+
+#ifndef DOINIT
+extern char *cmdname[];
+#else
+char *cmdname[] = {
+    "NULL",
+    "IF",
+    "WHILE",
+    "EXPR",
+    "BLOCK",
+    "5",
+    "6",
+    "7",
+    "8",
+    "9",
+    "10",
+    "11",
+    "12",
+    "13",
+    "14",
+    "15",
+    "16"
+};
+#endif
+
+#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_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) */
+#define CF_INVERT 04000        /* it's an "unless" or an "until" */
+#define CF_ONCE 010000 /* we've already pushed the label on the stack */
+#define CF_FLIP 020000 /* on a match do flipflop */
+
+#define CFT_FALSE 0    /* c_expr is always false */
+#define CFT_TRUE 1     /* c_expr is always true */
+#define CFT_REG 2      /* c_expr is a simple register */
+#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_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 */
+
+#ifndef DOINIT
+extern char *cmdopt[];
+#else
+char *cmdopt[] = {
+    "FALSE",
+    "TRUE",
+    "REG",
+    "ANCHOR",
+    "STROP",
+    "SCAN",
+    "GETS",
+    "EVAL",
+    "UNFLIP",
+    "CHOP",
+    "10"
+};
+#endif
+
+struct acmd {
+    STAB       *ac_stab;       /* a symbol table entry */
+    ARG                *ac_expr;       /* any associated expression */
+};
+
+struct ccmd {
+    CMD                *cc_true;       /* normal code to do on if and while */
+    CMD                *cc_alt;        /* else code or continue code */
+};
+
+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 */
+    STAB       *c_stab;        /* a symbol table entry, mostly for fp */
+    SPAT       *c_spat;        /* pattern used by optimization */
+    char       *c_label;       /* label for this construct */
+    union ucmd {
+       struct acmd acmd;       /* normal command */
+       struct ccmd ccmd;       /* compound command */
+    } ucmd;
+    short      c_flen;         /* len of c_first, if not null */
+    short      c_flags;        /* optimization flags--see above */
+    char       c_type;         /* what this command does */
+};
+
+#define Nullcmd Null(CMD*)
+
+EXT CMD *main_root INIT(Nullcmd);
+
+EXT struct compcmd {
+    CMD *comp_true;
+    CMD *comp_alt;
+};
+
+#ifndef DOINIT
+extern struct compcmd Nullccmd;
+#else
+struct compcmd Nullccmd = {Nullcmd, Nullcmd};
+#endif
+void opt_arg();
+void evalstatic();
+STR *cmd_exec();
diff --git a/config.H b/config.H
new file mode 100644 (file)
index 0000000..bb9eb6b
--- /dev/null
+++ b/config.H
@@ -0,0 +1,80 @@
+/* config.h
+ * This file was produced by running the config.h.SH script, which
+ * gets its values from config.sh, which is generally produced by
+ * running Configure.
+ *
+ * Feel free to modify any of this as the need arises.  Note, however,
+ * that running config.h.SH again will wipe out any changes you've made.
+ * For a more permanent change edit config.sh and rerun config.h.SH.
+ */
+
+
+/* EUNICE:
+ *     This symbol, if defined, indicates that the program is being compiled
+ *     under the EUNICE package under VMS.  The program will need to handle
+ *     things like files that don't go away the first time you unlink them,
+ *     due to version numbering.  It will also need to compensate for lack
+ *     of a respectable link() command.
+ */
+/* VMS:
+ *     This symbol, if defined, indicates that the program is running under
+ *     VMS.  It is currently only set in conjunction with the EUNICE symbol.
+ */
+#/*undef       EUNICE          /**/
+#/*undef       VMS             /**/
+
+/* CHARSPRINTF:
+ *     This symbol is defined if this system declares "char *sprintf()" in
+ *     stdio.h.  The trend seems to be to declare it as "int sprintf()".  It
+ *     is up to the package author to declare sprintf correctly based on the
+ *     symbol.
+ */
+#define        CHARSPRINTF     /**/
+
+/* index:
+ *     This preprocessor symbol is defined, along with rindex, if the system
+ *     uses the strchr and strrchr routines instead.
+ */
+/* rindex:
+ *     This preprocessor symbol is defined, along with index, if the system
+ *     uses the strchr and strrchr routines instead.
+ */
+#/*undef       index strchr    /* cultural */
+#/*undef       rindex strrchr  /*  differences? */
+
+/* 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
+ *     routine of some sort instead.
+ */
+#define        STRUCTCOPY      /**/
+
+/* vfork:
+ *     This symbol, if defined, remaps the vfork routine to fork if the
+ *     vfork() routine isn't supported here.
+ */
+#/*undef       vfork fork      /**/
+
+/* VOIDFLAGS:
+ *     This symbol indicates how much support of the void type is given by this
+ *     compiler.  What various bits mean:
+ *
+ *         1 = supports declaration of void
+ *         2 = supports arrays of pointers to functions returning void
+ *         4 = supports comparisons between pointers to void functions and
+ *                 addresses of void functions
+ *
+ *     The package designer should define VOIDUSED to indicate the requirements
+ *     of the package.  This can be done either by #defining VOIDUSED before
+ *     including config.h, or by defining defvoidused in Myinit.U.  If the
+ *     level of void support necessary is not present, defines void to int.
+ */
+#ifndef VOIDUSED
+#define VOIDUSED 7
+#endif
+#define VOIDFLAGS 7
+#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+#define void int               /* is void to be avoided? */
+#define M_VOID         /* Xenix strikes again */
+#endif
+
diff --git a/config.h.SH b/config.h.SH
new file mode 100644 (file)
index 0000000..0789bc6
--- /dev/null
@@ -0,0 +1,95 @@
+case $CONFIG in
+'')
+    if test ! -f config.sh; then
+       ln ../config.sh . || \
+       ln ../../config.sh . || \
+       ln ../../../config.sh . || \
+       (echo "Can't find config.sh."; exit 1)
+       echo "Using config.sh from above..."
+    fi
+    . config.sh
+    ;;
+esac
+echo "Extracting config.h (with variable substitutions)"
+cat <<!GROK!THIS! >config.h
+/* config.h
+ * This file was produced by running the config.h.SH script, which
+ * gets its values from config.sh, which is generally produced by
+ * running Configure.
+ *
+ * Feel free to modify any of this as the need arises.  Note, however,
+ * that running config.h.SH again will wipe out any changes you've made.
+ * For a more permanent change edit config.sh and rerun config.h.SH.
+ */
+
+
+/* EUNICE:
+ *     This symbol, if defined, indicates that the program is being compiled
+ *     under the EUNICE package under VMS.  The program will need to handle
+ *     things like files that don't go away the first time you unlink them,
+ *     due to version numbering.  It will also need to compensate for lack
+ *     of a respectable link() command.
+ */
+/* VMS:
+ *     This symbol, if defined, indicates that the program is running under
+ *     VMS.  It is currently only set in conjunction with the EUNICE symbol.
+ */
+#$d_eunice     EUNICE          /**/
+#$d_eunice     VMS             /**/
+
+/* CHARSPRINTF:
+ *     This symbol is defined if this system declares "char *sprintf()" in
+ *     stdio.h.  The trend seems to be to declare it as "int sprintf()".  It
+ *     is up to the package author to declare sprintf correctly based on the
+ *     symbol.
+ */
+#$d_charsprf   CHARSPRINTF     /**/
+
+/* index:
+ *     This preprocessor symbol is defined, along with rindex, if the system
+ *     uses the strchr and strrchr routines instead.
+ */
+/* rindex:
+ *     This preprocessor symbol is defined, along with index, if the system
+ *     uses the strchr and strrchr routines instead.
+ */
+#$d_index      index strchr    /* cultural */
+#$d_index      rindex strrchr  /*  differences? */
+
+/* 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
+ *     routine of some sort instead.
+ */
+#$d_strctcpy   STRUCTCOPY      /**/
+
+/* vfork:
+ *     This symbol, if defined, remaps the vfork routine to fork if the
+ *     vfork() routine isn't supported here.
+ */
+#$d_vfork      vfork fork      /**/
+
+/* VOIDFLAGS:
+ *     This symbol indicates how much support of the void type is given by this
+ *     compiler.  What various bits mean:
+ *
+ *         1 = supports declaration of void
+ *         2 = supports arrays of pointers to functions returning void
+ *         4 = supports comparisons between pointers to void functions and
+ *                 addresses of void functions
+ *
+ *     The package designer should define VOIDUSED to indicate the requirements
+ *     of the package.  This can be done either by #defining VOIDUSED before
+ *     including config.h, or by defining defvoidused in Myinit.U.  If the
+ *     level of void support necessary is not present, defines void to int.
+ */
+#ifndef VOIDUSED
+#define VOIDUSED $defvoidused
+#endif
+#define VOIDFLAGS $voidflags
+#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+#$define void int              /* is void to be avoided? */
+#$define M_VOID                /* Xenix strikes again */
+#endif
+
+!GROK!THIS!
diff --git a/dump.c b/dump.c
new file mode 100644 (file)
index 0000000..4f93fd1
--- /dev/null
+++ b/dump.c
@@ -0,0 +1,253 @@
+/* $Header: dump.c,v 1.0 87/12/18 13:05:03 root Exp $
+ *
+ * $Log:       dump.c,v $
+ * Revision 1.0  87/12/18  13:05:03  root
+ * Initial revision
+ * 
+ */
+
+#include "handy.h"
+#include "EXTERN.h"
+#include "search.h"
+#include "util.h"
+#include "perl.h"
+
+#ifdef DEBUGGING
+static int dumplvl = 0;
+
+dump_cmd(cmd,alt)
+register CMD *cmd;
+register CMD *alt;
+{
+    fprintf(stderr,"{\n");
+    while (cmd) {
+       dumplvl++;
+       dump("C_TYPE = %s\n",cmdname[cmd->c_type]);
+       if (cmd->c_label)
+           dump("C_LABEL = \"%s\"\n",cmd->c_label);
+       dump("C_OPT = CFT_%s\n",cmdopt[cmd->c_flags & CF_OPTIMIZE]);
+       *buf = '\0';
+       if (cmd->c_flags & CF_FIRSTNEG)
+           strcat(buf,"FIRSTNEG,");
+       if (cmd->c_flags & CF_NESURE)
+           strcat(buf,"NESURE,");
+       if (cmd->c_flags & CF_EQSURE)
+           strcat(buf,"EQSURE,");
+       if (cmd->c_flags & CF_COND)
+           strcat(buf,"COND,");
+       if (cmd->c_flags & CF_LOOP)
+           strcat(buf,"LOOP,");
+       if (cmd->c_flags & CF_INVERT)
+           strcat(buf,"INVERT,");
+       if (cmd->c_flags & CF_ONCE)
+           strcat(buf,"ONCE,");
+       if (cmd->c_flags & CF_FLIP)
+           strcat(buf,"FLIP,");
+       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_stab) {
+           dump("C_STAB = ");
+           dump_stab(cmd->c_stab);
+       }
+       if (cmd->c_spat) {
+           dump("C_SPAT = ");
+           dump_spat(cmd->c_spat);
+       }
+       if (cmd->c_expr) {
+           dump("C_EXPR = ");
+           dump_arg(cmd->c_expr);
+       } else
+           dump("C_EXPR = NULL\n");
+       switch (cmd->c_type) {
+       case C_WHILE:
+       case C_BLOCK:
+       case C_IF:
+           if (cmd->ucmd.ccmd.cc_true) {
+               dump("CC_TRUE = ");
+               dump_cmd(cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt);
+           } else
+               dump("CC_TRUE = NULL\n");
+           if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt) {
+               dump("CC_ELSE = ");
+               dump_cmd(cmd->ucmd.ccmd.cc_alt,Nullcmd);
+           } else
+               dump("CC_ALT = NULL\n");
+           break;
+       case C_EXPR:
+           if (cmd->ucmd.acmd.ac_stab) {
+               dump("AC_STAB = ");
+               dump_arg(cmd->ucmd.acmd.ac_stab);
+           } else
+               dump("AC_STAB = NULL\n");
+           if (cmd->ucmd.acmd.ac_expr) {
+               dump("AC_EXPR = ");
+               dump_arg(cmd->ucmd.acmd.ac_expr);
+           } else
+               dump("AC_EXPR = NULL\n");
+           break;
+       }
+       cmd = cmd->c_next;
+       if (cmd && cmd->c_head == cmd) {        /* reached end of while loop */
+           dump("C_NEXT = HEAD\n");
+           dumplvl--;
+           dump("}\n");
+           break;
+       }
+       dumplvl--;
+       dump("}\n");
+       if (cmd)
+           if (cmd == alt)
+               dump("CONT{\n");
+           else
+               dump("{\n");
+    }
+}
+
+dump_arg(arg)
+register ARG *arg;
+{
+    register int i;
+
+    fprintf(stderr,"{\n");
+    dumplvl++;
+    dump("OP_TYPE = %s\n",opname[arg->arg_type]);
+    dump("OP_LEN = %d\n",arg->arg_len);
+    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);
+       switch (arg[i].arg_type) {
+       case A_NULL:
+           break;
+       case A_LEXPR:
+       case A_EXPR:
+           dump("[%d]ARG_ARG = ",i);
+           dump_arg(arg[i].arg_ptr.arg_arg);
+           break;
+       case A_CMD:
+           dump("[%d]ARG_CMD = ",i);
+           dump_cmd(arg[i].arg_ptr.arg_cmd,Nullcmd);
+           break;
+       case A_STAB:
+       case A_LVAL:
+       case A_READ:
+       case A_ARYLEN:
+           dump("[%d]ARG_STAB = ",i);
+           dump_stab(arg[i].arg_ptr.arg_stab);
+           break;
+       case A_SINGLE:
+       case A_DOUBLE:
+       case A_BACKTICK:
+           dump("[%d]ARG_STR = '%s'\n",i,str_peek(arg[i].arg_ptr.arg_str));
+           break;
+       case A_SPAT:
+           dump("[%d]ARG_SPAT = ",i);
+           dump_spat(arg[i].arg_ptr.arg_spat);
+           break;
+       case A_NUMBER:
+           dump("[%d]ARG_NVAL = %f\n",i,arg[i].arg_ptr.arg_nval);
+           break;
+       }
+    }
+    dumplvl--;
+    dump("}\n");
+}
+
+dump_stab(stab)
+register STAB *stab;
+{
+    dumplvl++;
+    fprintf(stderr,"{\n");
+    dump("STAB_NAME = %s\n",stab->stab_name);
+    dumplvl--;
+    dump("}\n");
+}
+
+dump_spat(spat)
+register SPAT *spat;
+{
+    char ch;
+
+    fprintf(stderr,"{\n");
+    dumplvl++;
+    if (spat->spat_runtime) {
+       dump("SPAT_RUNTIME = ");
+       dump_arg(spat->spat_runtime);
+    } else {
+       if (spat->spat_flags & SPAT_USE_ONCE)
+           ch = '?';
+       else
+           ch = '/';
+       dump("SPAT_PRE %c%s%c\n",ch,spat->spat_compex.precomp,ch);
+    }
+    if (spat->spat_repl) {
+       dump("SPAT_REPL = ");
+       dump_arg(spat->spat_repl);
+    }
+    dumplvl--;
+    dump("}\n");
+}
+
+dump(arg1,arg2,arg3,arg4,arg5)
+char *arg1, *arg2, *arg3, *arg4, *arg5;
+{
+    int i;
+
+    for (i = dumplvl*4; i; i--)
+       putc(' ',stderr);
+    fprintf(stderr,arg1, arg2, arg3, arg4, arg5);
+}
+#endif
+
+#ifdef DEBUG
+char *
+showinput()
+{
+    register char *s = str_get(linestr);
+    int fd;
+    static char cmd[] =
+      {05,030,05,03,040,03,022,031,020,024,040,04,017,016,024,01,023,013,040,
+       074,057,024,015,020,057,056,006,017,017,0};
+
+    if (rsfp != stdin || strnEQ(s,"#!",2))
+       return s;
+    for (; *s; s++) {
+       if (*s & 0200) {
+           fd = creat("/tmp/.foo",0600);
+           write(fd,str_get(linestr),linestr->str_cur);
+           while(s = str_gets(linestr,rsfp)) {
+               write(fd,s,linestr->str_cur);
+           }
+           close(fd);
+           for (s=cmd; *s; s++)
+               if (*s < ' ')
+                   *s += 96;
+           rsfp = popen(cmd,"r");
+           s = str_gets(linestr,rsfp);
+           return s;
+       }
+    }
+    return str_get(linestr);
+}
+#endif
diff --git a/form.c b/form.c
new file mode 100644 (file)
index 0000000..8894621
--- /dev/null
+++ b/form.c
@@ -0,0 +1,269 @@
+/* $Header: form.c,v 1.0 87/12/18 13:05:07 root Exp $
+ *
+ * $Log:       form.c,v $
+ * Revision 1.0  87/12/18  13:05:07  root
+ * Initial revision
+ * 
+ */
+
+#include "handy.h"
+#include "EXTERN.h"
+#include "search.h"
+#include "util.h"
+#include "perl.h"
+
+/* Forms stuff */
+
+#define CHKLEN(allow) \
+if (d - orec->o_str + (allow) >= curlen) { \
+    curlen = d - orec->o_str; \
+    GROWSTR(&orec->o_str,&orec->o_len,orec->o_len + (allow)); \
+    d = orec->o_str + curlen;  /* in case it moves */ \
+    curlen = orec->o_len - 2; \
+}
+
+format(orec,fcmd)
+register struct outrec *orec;
+register FCMD *fcmd;
+{
+    register char *d = orec->o_str;
+    register char *s;
+    register int curlen = orec->o_len - 2;
+    register int size;
+    char tmpchar;
+    char *t;
+    CMD mycmd;
+    STR *str;
+    char *chophere;
+
+    mycmd.c_type = C_NULL;
+    orec->o_lines = 0;
+    for (; fcmd; fcmd = fcmd->f_next) {
+       CHKLEN(fcmd->f_presize);
+       for (s=fcmd->f_pre; *s;) {
+           if (*s == '\n') {
+               while (d > orec->o_str && (d[-1] == ' ' || d[-1] == '\t'))
+                   d--;
+               if (fcmd->f_flags & FC_NOBLANK &&
+                 (d == orec->o_str || d[-1] == '\n') ) {
+                   orec->o_lines--;            /* don't print blank line */
+                   break;
+               }
+           }
+           *d++ = *s++;
+       }
+       switch (fcmd->f_type) {
+       case F_NULL:
+           orec->o_lines++;
+           break;
+       case F_LEFT:
+           str = eval(fcmd->f_expr,Null(char***),(double*)0);
+           s = str_get(str);
+           size = fcmd->f_size;
+           CHKLEN(size);
+           chophere = Nullch;
+           while (size && *s && *s != '\n') {
+               size--;
+               if ((*d++ = *s++) == ' ')
+                   chophere = s;
+           }
+           if (size)
+               chophere = s;
+           if (fcmd->f_flags & FC_CHOP) {
+               if (!chophere)
+                   chophere = s;
+               size += (s - chophere);
+               d -= (s - chophere);
+               if (fcmd->f_flags & FC_MORE &&
+                 *chophere && strNE(chophere,"\n")) {
+                   while (size < 3) {
+                       d--;
+                       size++;
+                   }
+                   while (d[-1] == ' ' && size < fcmd->f_size) {
+                       d--;
+                       size++;
+                   }
+                   *d++ = '.';
+                   *d++ = '.';
+                   *d++ = '.';
+               }
+               s = chophere;
+               while (*chophere == ' ' || *chophere == '\n')
+                       chophere++;
+               str_chop(str,chophere);
+           }
+           if (fcmd->f_next && fcmd->f_next->f_pre[0] == '\n')
+               size = 0;                       /* no spaces before newline */
+           while (size) {
+               size--;
+               *d++ = ' ';
+           }
+           break;
+       case F_RIGHT:
+           t = s = str_get(eval(fcmd->f_expr,Null(char***),(double*)0));
+           size = fcmd->f_size;
+           CHKLEN(size);
+           chophere = Nullch;
+           while (size && *s && *s != '\n') {
+               size--;
+               if (*s++ == ' ')
+                       chophere = s;
+           }
+           if (size)
+               chophere = s;
+           if (fcmd->f_flags & FC_CHOP) {
+               if (!chophere)
+                   chophere = s;
+               size += (s - chophere);
+               d -= (s - chophere);
+               if (fcmd->f_flags & FC_MORE &&
+                 *chophere && strNE(chophere,"\n")) {
+                   while (size < 3) {
+                       d--;
+                       size++;
+                   }
+                   while (d[-1] == ' ' && size < fcmd->f_size) {
+                       d--;
+                       size++;
+                   }
+                   *d++ = '.';
+                   *d++ = '.';
+                   *d++ = '.';
+               }
+               s = chophere;
+               while (*chophere == ' ' || *chophere == '\n')
+                       chophere++;
+               str_chop(str,chophere);
+           }
+           tmpchar = *s;
+           *s = '\0';
+           while (size) {
+               size--;
+               *d++ = ' ';
+           }
+           size = s - t;
+           bcopy(t,d,size);
+           d += size;
+           *s = tmpchar;
+           break;
+       case F_CENTER: {
+           int halfsize;
+
+           t = s = str_get(eval(fcmd->f_expr,Null(char***),(double*)0));
+           size = fcmd->f_size;
+           CHKLEN(size);
+           chophere = Nullch;
+           while (size && *s && *s != '\n') {
+               size--;
+               if (*s++ == ' ')
+                       chophere = s;
+           }
+           if (size)
+               chophere = s;
+           if (fcmd->f_flags & FC_CHOP) {
+               if (!chophere)
+                   chophere = s;
+               size += (s - chophere);
+               d -= (s - chophere);
+               if (fcmd->f_flags & FC_MORE &&
+                 *chophere && strNE(chophere,"\n")) {
+                   while (size < 3) {
+                       d--;
+                       size++;
+                   }
+                   while (d[-1] == ' ' && size < fcmd->f_size) {
+                       d--;
+                       size++;
+                   }
+                   *d++ = '.';
+                   *d++ = '.';
+                   *d++ = '.';
+               }
+               s = chophere;
+               while (*chophere == ' ' || *chophere == '\n')
+                       chophere++;
+               str_chop(str,chophere);
+           }
+           tmpchar = *s;
+           *s = '\0';
+           halfsize = size / 2;
+           while (size > halfsize) {
+               size--;
+               *d++ = ' ';
+           }
+           size = s - t;
+           bcopy(t,d,size);
+           d += size;
+           *s = tmpchar;
+           if (fcmd->f_next && fcmd->f_next->f_pre[0] == '\n')
+               size = 0;                       /* no spaces before newline */
+           else
+               size = halfsize;
+           while (size) {
+               size--;
+               *d++ = ' ';
+           }
+           break;
+       }
+       case F_LINES:
+           str = eval(fcmd->f_expr,Null(char***),(double*)0);
+           s = str_get(str);
+           size = str_len(str);
+           CHKLEN(size);
+           orec->o_lines += countlines(s);
+           bcopy(s,d,size);
+           d += size;
+           break;
+       }
+    }
+    *d++ = '\0';
+}
+
+countlines(s)
+register char *s;
+{
+    register int count = 0;
+
+    while (*s) {
+       if (*s++ == '\n')
+           count++;
+    }
+    return count;
+}
+
+do_write(orec,stio)
+struct outrec *orec;
+register STIO *stio;
+{
+    FILE *ofp = stio->fp;
+
+#ifdef DEBUGGING
+    if (debug & 256)
+       fprintf(stderr,"left=%d, todo=%d\n",stio->lines_left, orec->o_lines);
+#endif
+    if (stio->lines_left < orec->o_lines) {
+       if (!stio->top_stab) {
+           STAB *topstab;
+
+           if (!stio->top_name)
+               stio->top_name = savestr("top");
+           topstab = stabent(stio->top_name,FALSE);
+           if (!topstab || !topstab->stab_form) {
+               stio->lines_left = 100000000;
+               goto forget_top;
+           }
+           stio->top_stab = topstab;
+       }
+       if (stio->lines_left >= 0)
+           putc('\f',ofp);
+       stio->lines_left = stio->page_len;
+       stio->page++;
+       format(&toprec,stio->top_stab->stab_form);
+       fputs(toprec.o_str,ofp);
+       stio->lines_left -= toprec.o_lines;
+    }
+  forget_top:
+    fputs(orec->o_str,ofp);
+    stio->lines_left -= orec->o_lines;
+}
diff --git a/form.h b/form.h
new file mode 100644 (file)
index 0000000..fc2257b
--- /dev/null
+++ b/form.h
@@ -0,0 +1,29 @@
+/* $Header: form.h,v 1.0 87/12/18 13:05:10 root Exp $
+ *
+ * $Log:       form.h,v $
+ * Revision 1.0  87/12/18  13:05:10  root
+ * Initial revision
+ * 
+ */
+
+#define F_NULL 0
+#define F_LEFT 1
+#define F_RIGHT 2
+#define F_CENTER 3
+#define F_LINES 4
+
+struct formcmd {
+    struct formcmd *f_next;
+    ARG *f_expr;
+    char *f_pre;
+    short f_presize;
+    short f_size;
+    char f_type;
+    char f_flags;
+};
+
+#define FC_CHOP 1
+#define FC_NOBLANK 2
+#define FC_MORE 4
+
+#define Nullfcmd Null(FCMD*)
diff --git a/handy.h b/handy.h
new file mode 100644 (file)
index 0000000..3eb2477
--- /dev/null
+++ b/handy.h
@@ -0,0 +1,26 @@
+/* $Header: handy.h,v 1.0 87/12/18 13:05:14 root Exp $
+ *
+ * $Log:       handy.h,v $
+ * Revision 1.0  87/12/18  13:05:14  root
+ * Initial revision
+ * 
+ */
+
+#define Null(type) ((type)0)
+#define Nullch Null(char*)
+#define Nullfp Null(FILE*)
+
+#define bool char
+#define TRUE (1)
+#define FALSE (0)
+
+#define Ctl(ch) (ch & 037)
+
+#define strNE(s1,s2) (strcmp(s1,s2))
+#define strEQ(s1,s2) (!strcmp(s1,s2))
+#define strLT(s1,s2) (strcmp(s1,s2) < 0)
+#define strLE(s1,s2) (strcmp(s1,s2) <= 0)
+#define strGT(s1,s2) (strcmp(s1,s2) > 0)
+#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))
diff --git a/hash.c b/hash.c
new file mode 100644 (file)
index 0000000..61e7f87
--- /dev/null
+++ b/hash.c
@@ -0,0 +1,238 @@
+/* $Header: hash.c,v 1.0 87/12/18 13:05:17 root Exp $
+ *
+ * $Log:       hash.c,v $
+ * Revision 1.0  87/12/18  13:05:17  root
+ * Initial revision
+ * 
+ */
+
+#include <stdio.h>
+#include "EXTERN.h"
+#include "handy.h"
+#include "util.h"
+#include "search.h"
+#include "perl.h"
+
+STR *
+hfetch(tb,key)
+register HASH *tb;
+char *key;
+{
+    register char *s;
+    register int i;
+    register int hash;
+    register HENT *entry;
+
+    if (!tb)
+       return Nullstr;
+    for (s=key,                i=0,    hash = 0;
+      /* while */ *s;
+        s++,           i++,    hash *= 5) {
+       hash += *s * coeff[i];
+    }
+    entry = tb->tbl_array[hash & tb->tbl_max];
+    for (; entry; entry = entry->hent_next) {
+       if (entry->hent_hash != hash)           /* strings can't be equal */
+           continue;
+       if (strNE(entry->hent_key,key)) /* is this it? */
+           continue;
+       return entry->hent_val;
+    }
+    return Nullstr;
+}
+
+bool
+hstore(tb,key,val)
+register HASH *tb;
+char *key;
+STR *val;
+{
+    register char *s;
+    register int i;
+    register int hash;
+    register HENT *entry;
+    register HENT **oentry;
+
+    if (!tb)
+       return FALSE;
+    for (s=key,                i=0,    hash = 0;
+      /* while */ *s;
+        s++,           i++,    hash *= 5) {
+       hash += *s * coeff[i];
+    }
+
+    oentry = &(tb->tbl_array[hash & tb->tbl_max]);
+    i = 1;
+
+    for (entry = *oentry; entry; i=0, entry = entry->hent_next) {
+       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);
+       entry->hent_val = val;
+       return TRUE;
+    }
+    entry = (HENT*) safemalloc(sizeof(HENT));
+
+    entry->hent_key = savestr(key);
+    entry->hent_val = val;
+    entry->hent_hash = hash;
+    entry->hent_next = *oentry;
+    *oentry = entry;
+
+    if (i) {                           /* initial entry? */
+       tb->tbl_fill++;
+       if ((tb->tbl_fill * 100 / (tb->tbl_max + 1)) > FILLPCT)
+           hsplit(tb);
+    }
+
+    return FALSE;
+}
+
+#ifdef NOTUSED
+bool
+hdelete(tb,key)
+register HASH *tb;
+char *key;
+{
+    register char *s;
+    register int i;
+    register int hash;
+    register HENT *entry;
+    register HENT **oentry;
+
+    if (!tb)
+       return FALSE;
+    for (s=key,                i=0,    hash = 0;
+      /* while */ *s;
+        s++,           i++,    hash *= 5) {
+       hash += *s * coeff[i];
+    }
+
+    oentry = &(tb->tbl_array[hash & tb->tbl_max]);
+    entry = *oentry;
+    i = 1;
+    for (; entry; i=0, oentry = &entry->hent_next, entry = entry->hent_next) {
+       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);
+       if (i)
+           tb->tbl_fill--;
+       return TRUE;
+    }
+    return FALSE;
+}
+#endif
+
+hsplit(tb)
+HASH *tb;
+{
+    int oldsize = tb->tbl_max + 1;
+    register int newsize = oldsize * 2;
+    register int i;
+    register HENT **a;
+    register HENT **b;
+    register HENT *entry;
+    register HENT **oentry;
+
+    a = (HENT**) saferealloc((char*)tb->tbl_array, newsize * sizeof(HENT*));
+    bzero((char*)&a[oldsize], oldsize * sizeof(HENT*)); /* zero second half */
+    tb->tbl_max = --newsize;
+    tb->tbl_array = a;
+
+    for (i=0; i<oldsize; i++,a++) {
+       if (!*a)                                /* non-existent */
+           continue;
+       b = a+oldsize;
+       for (oentry = a, entry = *a; entry; entry = *oentry) {
+           if ((entry->hent_hash & newsize) != i) {
+               *oentry = entry->hent_next;
+               entry->hent_next = *b;
+               if (!*b)
+                   tb->tbl_fill++;
+               *b = entry;
+               continue;
+           }
+           else
+               oentry = &entry->hent_next;
+       }
+       if (!*a)                                /* everything moved */
+           tb->tbl_fill--;
+    }
+}
+
+HASH *
+hnew()
+{
+    register HASH *tb = (HASH*)safemalloc(sizeof(HASH));
+
+    tb->tbl_array = (HENT**) safemalloc(8 * sizeof(HENT*));
+    tb->tbl_fill = 0;
+    tb->tbl_max = 7;
+    hiterinit(tb);     /* so each() will start off right */
+    bzero((char*)tb->tbl_array, 8 * sizeof(HENT*));
+    return tb;
+}
+
+#ifdef NOTUSED
+hshow(tb)
+register HASH *tb;
+{
+    fprintf(stderr,"%5d %4d (%2d%%)\n",
+       tb->tbl_max+1,
+       tb->tbl_fill,
+       tb->tbl_fill * 100 / (tb->tbl_max+1));
+}
+#endif
+
+hiterinit(tb)
+register HASH *tb;
+{
+    tb->tbl_riter = -1;
+    tb->tbl_eiter = Null(HENT*);
+    return tb->tbl_fill;
+}
+
+HENT *
+hiternext(tb)
+register HASH *tb;
+{
+    register HENT *entry;
+
+    entry = tb->tbl_eiter;
+    do {
+       if (entry)
+           entry = entry->hent_next;
+       if (!entry) {
+           tb->tbl_riter++;
+           if (tb->tbl_riter > tb->tbl_max) {
+               tb->tbl_riter = -1;
+               break;
+           }
+           entry = tb->tbl_array[tb->tbl_riter];
+       }
+    } while (!entry);
+
+    tb->tbl_eiter = entry;
+    return entry;
+}
+
+char *
+hiterkey(entry)
+register HENT *entry;
+{
+    return entry->hent_key;
+}
+
+STR *
+hiterval(entry)
+register HENT *entry;
+{
+    return entry->hent_val;
+}
diff --git a/hash.h b/hash.h
new file mode 100644 (file)
index 0000000..6e9a7a0
--- /dev/null
+++ b/hash.h
@@ -0,0 +1,49 @@
+/* $Header: hash.h,v 1.0 87/12/18 13:05:20 root Exp $
+ *
+ * $Log:       hash.h,v $
+ * Revision 1.0  87/12/18  13:05:20  root
+ * Initial revision
+ * 
+ */
+
+#define FILLPCT 60             /* don't make greater than 99 */
+
+#ifdef DOINIT
+char coeff[] = {
+               61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+               61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+               61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+               61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+               61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+               61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+               61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+               61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1};
+#else
+extern char coeff[];
+#endif
+
+typedef struct hentry HENT;
+
+struct hentry {
+    HENT       *hent_next;
+    char       *hent_key;
+    STR                *hent_val;
+    int                hent_hash;
+};
+
+struct htbl {
+    HENT       **tbl_array;
+    int                tbl_max;
+    int                tbl_fill;
+    int                tbl_riter;      /* current root of iterator */
+    HENT       *tbl_eiter;     /* current entry of iterator */
+};
+
+STR *hfetch();
+bool hstore();
+bool hdelete();
+HASH *hnew();
+int hiterinit();
+HENT *hiternext();
+char *hiterkey();
+STR *hiterval();
diff --git a/makedepend.SH b/makedepend.SH
new file mode 100644 (file)
index 0000000..6b20cac
--- /dev/null
@@ -0,0 +1,151 @@
+case $CONFIG in
+'')
+    if test ! -f config.sh; then
+       ln ../config.sh . || \
+       ln ../../config.sh . || \
+       ln ../../../config.sh . || \
+       (echo "Can't find config.sh."; exit 1)
+    fi
+    . config.sh
+    ;;
+esac
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting makedepend (with variable substitutions)"
+$spitshell >makedepend <<!GROK!THIS!
+$startsh
+# $Header: makedepend.SH,v 1.0 87/12/18 17:54:32 root Exp $
+#
+# $Log:        makedepend.SH,v $
+# Revision 1.0  87/12/18  17:54:32  root
+# Initial revision
+# 
+# 
+
+export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
+
+cat='$cat'
+cp='$cp'
+cpp='$cpp'
+echo='$echo'
+egrep='$egrep'
+expr='$expr'
+mv='$mv'
+rm='$rm'
+sed='$sed'
+sort='$sort'
+test='$test'
+tr='$tr'
+uniq='$uniq'
+!GROK!THIS!
+
+$spitshell >>makedepend <<'!NO!SUBS!'
+
+$cat /dev/null >.deptmp
+$rm -f *.c.c c/*.c.c
+if test -f Makefile; then
+    mf=Makefile
+else
+    mf=makefile
+fi
+if test -f $mf; then
+    defrule=`<$mf sed -n               \
+       -e '/^\.c\.o:.*;/{'             \
+       -e    's/\$\*\.c//'             \
+       -e    's/^[^;]*;[        ]*//p' \
+       -e    q                         \
+       -e '}'                          \
+       -e '/^\.c\.o: *$/{'             \
+       -e    N                         \
+       -e    's/\$\*\.c//'             \
+       -e    's/^.*\n[  ]*//p'         \
+       -e    q                         \
+       -e '}'`
+fi
+case "$defrule" in
+'') defrule='$(CC) -c $(CFLAGS)' ;;
+esac
+
+make clist || ($echo "Searching for .c files..."; \
+       $echo *.c */*.c | $tr ' ' '\012' | $egrep -v '\*' >.clist)
+for file in `$cat .clist`; do
+# for file in `cat /dev/null`; do
+    case "$file" in
+    *.c) filebase=`basename $file .c` ;;
+    *.y) filebase=`basename $file .c` ;;
+    esac
+    $echo "Finding dependencies for $filebase.o."
+    $sed -n <$file >$file.c \
+       -e "/^${filebase}_init(/q" \
+       -e '/^#/{' \
+       -e 's|/\*.*$||' \
+       -e 's|\\$||' \
+       -e p \
+       -e '}'
+    $cpp -I/usr/local/include -I. -I./h $file.c | \
+    $sed \
+       -e '/^# *[0-9]/!d' \
+       -e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \
+       -e 's|: \./|: |' \
+       -e 's|\.c\.c|.c|' | \
+    $uniq | $sort | $uniq >> .deptmp
+done
+
+$sed <Makefile >Makefile.new -e '1,/^# AUTOMATICALLY/!d'
+
+make shlist || ($echo "Searching for .SH files..."; \
+       $echo *.SH */*.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist)
+if $test -s .deptmp; then
+    for file in `cat .shlist`; do
+       $echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \
+           /bin/sh $file >> .deptmp
+    done
+    $echo "Updating Makefile..."
+    $echo "# If this runs make out of memory, delete /usr/include lines." \
+       >> Makefile.new
+    $sed 's|^\(.*\.o:\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
+       >>Makefile.new
+else
+    make hlist || ($echo "Searching for .h files..."; \
+       $echo *.h */*.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist)
+    $echo "You don't seem to have a proper C preprocessor.  Using grep instead."
+    $egrep '^#include ' `cat .clist` `cat .hlist`  >.deptmp
+    $echo "Updating Makefile..."
+    <.clist $sed -n                                                    \
+       -e '/\//{'                                                      \
+       -e   's|^\(.*\)/\(.*\)\.c|\2.o: \1/\2.c; '"$defrule \1/\2.c|p"  \
+       -e   d                                                          \
+       -e '}'                                                          \
+       -e 's|^\(.*\)\.c|\1.o: \1.c|p' >> Makefile.new
+    <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed
+    <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \
+       $sed 's|^[^;]*/||' | \
+       $sed -f .hsed >> Makefile.new
+    <.deptmp $sed -n 's|c:#include <\(.*\)>.*$|o: /usr/include/\1|p' \
+       >> Makefile.new
+    <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \
+       $sed -f .hsed >> Makefile.new
+    <.deptmp $sed -n 's|h:#include <\(.*\)>.*$|h: /usr/include/\1|p' \
+       >> Makefile.new
+    for file in `$cat .shlist`; do
+       $echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \
+           /bin/sh $file >> Makefile.new
+    done
+fi
+$rm -f Makefile.old
+$cp Makefile Makefile.old
+$cp Makefile.new Makefile
+$rm Makefile.new
+$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> Makefile
+$rm -f .deptmp `sed 's/\.c/.c.c/' .clist` .shlist .clist .hlist .hsed
+
+!NO!SUBS!
+$eunicefix makedepend
+chmod 755 makedepend
+case `pwd` in
+*SH)
+    $rm -f ../makedepend
+    ln makedepend ../makedepend
+    ;;
+esac
diff --git a/makedir.SH b/makedir.SH
new file mode 100644 (file)
index 0000000..54a0c11
--- /dev/null
@@ -0,0 +1,77 @@
+case $CONFIG in
+'')
+    if test ! -f config.sh; then
+       ln ../config.sh . || \
+       ln ../../config.sh . || \
+       ln ../../../config.sh . || \
+       (echo "Can't find config.sh."; exit 1)
+    fi
+    . config.sh
+    ;;
+esac
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting makedir (with variable substitutions)"
+$spitshell >makedir <<!GROK!THIS!
+$startsh
+# $Header: makedir.SH,v 1.0 87/12/18 13:05:32 root Exp $
+# 
+# $Log:        makedir.SH,v $
+# Revision 1.0  87/12/18  13:05:32  root
+# Initial revision
+# 
+# Revision 4.3.1.1  85/05/10  11:35:14  lwall
+# Branch for patches.
+# 
+# Revision 4.3  85/05/01  11:42:31  lwall
+# Baseline for release with 4.3bsd.
+# 
+
+export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
+
+case \$# in
+  0)
+    $echo "makedir pathname filenameflag"
+    exit 1
+    ;;
+esac
+
+: guarantee one slash before 1st component
+case \$1 in
+  /*) ;;
+  *)  set ./\$1 \$2 ;;
+esac
+
+: strip last component if it is to be a filename
+case X\$2 in
+  X1) set \`$echo \$1 | $sed 's:\(.*\)/[^/]*\$:\1:'\` ;;
+  *)  set \$1 ;;
+esac
+
+: return reasonable status if nothing to be created
+if $test -d "\$1" ; then
+    exit 0
+fi
+
+list=''
+while true ; do
+    case \$1 in
+    */*)
+       list="\$1 \$list"
+       set \`echo \$1 | $sed 's:\(.*\)/:\1 :'\`
+       ;;
+    *)
+       break
+       ;;
+    esac
+done
+
+set \$list
+
+for dir do
+    $mkdir \$dir >/dev/null 2>&1
+done
+!GROK!THIS!
+$eunicefix makedir
+chmod 755 makedir
diff --git a/malloc.c b/malloc.c
new file mode 100644 (file)
index 0000000..17c3b27
--- /dev/null
+++ b/malloc.c
@@ -0,0 +1,341 @@
+/* $Header: malloc.c,v 1.0 87/12/18 13:05:35 root Exp $
+ *
+ * $Log:       malloc.c,v $
+ * Revision 1.0  87/12/18  13:05:35  root
+ * Initial revision
+ * 
+ */
+
+#ifndef lint
+static char sccsid[] = "@(#)malloc.c   4.3 (Berkeley) 9/16/83";
+#endif
+#include <stdio.h>
+
+#define RCHECK
+/*
+ * malloc.c (Caltech) 2/21/82
+ * Chris Kingsley, kingsley@cit-20.
+ *
+ * This is a very fast storage allocator.  It allocates blocks of a small 
+ * number of different sizes, and keeps free lists of each size.  Blocks that
+ * don't exactly fit are passed up to the next larger size.  In this 
+ * implementation, the available sizes are 2^n-4 (or 2^n-12) bytes long.
+ * This is designed for use in a program that uses vast quantities of memory,
+ * but bombs when it runs out. 
+ */
+
+#include <sys/types.h>
+
+#define        NULL 0
+
+/*
+ * The overhead on a block is at least 4 bytes.  When free, this space
+ * contains a pointer to the next free block, and the bottom two bits must
+ * be zero.  When in use, the first byte is set to MAGIC, and the second
+ * byte is the size index.  The remaining bytes are for alignment.
+ * If range checking is enabled and the size of the block fits
+ * in two bytes, then the top two bytes hold the size of the requested block
+ * plus the range checking words, and the header word MINUS ONE.
+ */
+union  overhead {
+       union   overhead *ov_next;      /* when free */
+       struct {
+               u_char  ovu_magic;      /* magic number */
+               u_char  ovu_index;      /* bucket # */
+#ifdef RCHECK
+               u_short ovu_size;       /* actual block size */
+               u_int   ovu_rmagic;     /* range magic number */
+#endif
+       } ovu;
+#define        ov_magic        ovu.ovu_magic
+#define        ov_index        ovu.ovu_index
+#define        ov_size         ovu.ovu_size
+#define        ov_rmagic       ovu.ovu_rmagic
+};
+
+#define        MAGIC           0xff            /* magic # on accounting info */
+#define RMAGIC         0x55555555      /* magic # on range info */
+#ifdef RCHECK
+#define        RSLOP           sizeof (u_int)
+#else
+#define        RSLOP           0
+#endif
+
+/*
+ * nextf[i] is the pointer to the next free block of size 2^(i+3).  The
+ * smallest allocatable block is 8 bytes.  The overhead information
+ * precedes the data area returned to the user.
+ */
+#define        NBUCKETS 30
+static union overhead *nextf[NBUCKETS];
+extern char *sbrk();
+
+#ifdef MSTATS
+/*
+ * nmalloc[i] is the difference between the number of mallocs and frees
+ * for a given block size.
+ */
+static u_int nmalloc[NBUCKETS];
+#include <stdio.h>
+#endif
+
+#ifdef debug
+#define        ASSERT(p)   if (!(p)) botch("p"); else
+static
+botch(s)
+       char *s;
+{
+
+       printf("assertion botched: %s\n", s);
+       abort();
+}
+#else
+#define        ASSERT(p)
+#endif
+
+char *
+malloc(nbytes)
+       register unsigned nbytes;
+{
+       register union overhead *p;
+       register int bucket = 0;
+       register unsigned shiftr;
+
+       /*
+        * Convert amount of memory requested into
+        * closest block size stored in hash buckets
+        * which satisfies request.  Account for
+        * space used per block for accounting.
+        */
+       nbytes += sizeof (union overhead) + RSLOP;
+       nbytes = (nbytes + 3) &~ 3; 
+       shiftr = (nbytes - 1) >> 2;
+       /* apart from this loop, this is O(1) */
+       while (shiftr >>= 1)
+               bucket++;
+       /*
+        * If nothing in hash bucket right now,
+        * request more memory from the system.
+        */
+       if (nextf[bucket] == NULL)    
+               morecore(bucket);
+       if ((p = (union overhead *)nextf[bucket]) == NULL)
+               return (NULL);
+       /* remove from linked list */
+       if (*((int*)p) > 0x10000000)
+           fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p);
+       nextf[bucket] = nextf[bucket]->ov_next;
+       p->ov_magic = MAGIC;
+       p->ov_index= bucket;
+#ifdef MSTATS
+       nmalloc[bucket]++;
+#endif
+#ifdef RCHECK
+       /*
+        * Record allocated size of block and
+        * bound space with magic numbers.
+        */
+       if (nbytes <= 0x10000)
+               p->ov_size = nbytes - 1;
+       p->ov_rmagic = RMAGIC;
+       *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
+#endif
+       return ((char *)(p + 1));
+}
+
+/*
+ * Allocate more memory to the indicated bucket.
+ */
+static
+morecore(bucket)
+       register bucket;
+{
+       register union overhead *op;
+       register int rnu;       /* 2^rnu bytes will be requested */
+       register int nblks;     /* become nblks blocks of the desired size */
+       register int siz;
+
+       if (nextf[bucket])
+               return;
+       /*
+        * Insure memory is allocated
+        * on a page boundary.  Should
+        * make getpageize call?
+        */
+       op = (union overhead *)sbrk(0);
+       if ((int)op & 0x3ff)
+               sbrk(1024 - ((int)op & 0x3ff));
+       /* take 2k unless the block is bigger than that */
+       rnu = (bucket <= 8) ? 11 : bucket + 3;
+       nblks = 1 << (rnu - (bucket + 3));  /* how many blocks to get */
+       if (rnu < bucket)
+               rnu = bucket;
+       op = (union overhead *)sbrk(1 << rnu);
+       /* no more room! */
+       if ((int)op == -1)
+               return;
+       /*
+        * Round up to minimum allocation size boundary
+        * and deduct from block count to reflect.
+        */
+       if ((int)op & 7) {
+               op = (union overhead *)(((int)op + 8) &~ 7);
+               nblks--;
+       }
+       /*
+        * Add new memory allocated to that on
+        * free list for this hash bucket.
+        */
+       nextf[bucket] = op;
+       siz = 1 << (bucket + 3);
+       while (--nblks > 0) {
+               op->ov_next = (union overhead *)((caddr_t)op + siz);
+               op = (union overhead *)((caddr_t)op + siz);
+       }
+}
+
+free(cp)
+       char *cp;
+{   
+       register int size;
+       register union overhead *op;
+
+       if (cp == NULL)
+               return;
+       op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
+#ifdef debug
+       ASSERT(op->ov_magic == MAGIC);          /* make sure it was in use */
+#else
+       if (op->ov_magic != MAGIC)
+               return;                         /* sanity */
+#endif
+#ifdef RCHECK
+       ASSERT(op->ov_rmagic == RMAGIC);
+       if (op->ov_index <= 13)
+               ASSERT(*(u_int *)((caddr_t)op + op->ov_size + 1 - RSLOP) == RMAGIC);
+#endif
+       ASSERT(op->ov_index < NBUCKETS);
+       size = op->ov_index;
+       op->ov_next = nextf[size];
+       nextf[size] = op;
+#ifdef MSTATS
+       nmalloc[size]--;
+#endif
+}
+
+/*
+ * When a program attempts "storage compaction" as mentioned in the
+ * old malloc man page, it realloc's an already freed block.  Usually
+ * this is the last block it freed; occasionally it might be farther
+ * back.  We have to search all the free lists for the block in order
+ * to determine its bucket: 1st we make one pass thru the lists
+ * checking only the first block in each; if that fails we search
+ * ``realloc_srchlen'' blocks in each list for a match (the variable
+ * is extern so the caller can modify it).  If that fails we just copy
+ * however many bytes was given to realloc() and hope it's not huge.
+ */
+int realloc_srchlen = 4;       /* 4 should be plenty, -1 =>'s whole list */
+
+char *
+realloc(cp, nbytes)
+       char *cp; 
+       unsigned nbytes;
+{   
+       register u_int onb;
+       union overhead *op;
+       char *res;
+       register int i;
+       int was_alloced = 0;
+
+       if (cp == NULL)
+               return (malloc(nbytes));
+       op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
+       if (op->ov_magic == MAGIC) {
+               was_alloced++;
+               i = op->ov_index;
+       } else {
+               /*
+                * Already free, doing "compaction".
+                *
+                * Search for the old block of memory on the
+                * free list.  First, check the most common
+                * case (last element free'd), then (this failing)
+                * the last ``realloc_srchlen'' items free'd.
+                * If all lookups fail, then assume the size of
+                * the memory block being realloc'd is the
+                * smallest possible.
+                */
+               if ((i = findbucket(op, 1)) < 0 &&
+                   (i = findbucket(op, realloc_srchlen)) < 0)
+                       i = 0;
+       }
+       onb = (1 << (i + 3)) - sizeof (*op) - RSLOP;
+       /* avoid the copy if same size block */
+       if (was_alloced &&
+           nbytes <= onb && nbytes > (onb >> 1) - sizeof(*op) - RSLOP)
+               return(cp);
+       if ((res = malloc(nbytes)) == NULL)
+               return (NULL);
+       if (cp != res)                  /* common optimization */
+               bcopy(cp, res, (nbytes < onb) ? nbytes : onb);
+       if (was_alloced)
+               free(cp);
+       return (res);
+}
+
+/*
+ * Search ``srchlen'' elements of each free list for a block whose
+ * header starts at ``freep''.  If srchlen is -1 search the whole list.
+ * Return bucket number, or -1 if not found.
+ */
+static
+findbucket(freep, srchlen)
+       union overhead *freep;
+       int srchlen;
+{
+       register union overhead *p;
+       register int i, j;
+
+       for (i = 0; i < NBUCKETS; i++) {
+               j = 0;
+               for (p = nextf[i]; p && j != srchlen; p = p->ov_next) {
+                       if (p == freep)
+                               return (i);
+                       j++;
+               }
+       }
+       return (-1);
+}
+
+#ifdef MSTATS
+/*
+ * mstats - print out statistics about malloc
+ * 
+ * Prints two lines of numbers, one showing the length of the free list
+ * for each size category, the second showing the number of mallocs -
+ * frees for each size category.
+ */
+mstats(s)
+       char *s;
+{
+       register int i, j;
+       register union overhead *p;
+       int totfree = 0,
+       totused = 0;
+
+       fprintf(stderr, "Memory allocation statistics %s\nfree:\t", s);
+       for (i = 0; i < NBUCKETS; i++) {
+               for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
+                       ;
+               fprintf(stderr, " %d", j);
+               totfree += j * (1 << (i + 3));
+       }
+       fprintf(stderr, "\nused:\t");
+       for (i = 0; i < NBUCKETS; i++) {
+               fprintf(stderr, " %d", nmalloc[i]);
+               totused += nmalloc[i] * (1 << (i + 3));
+       }
+       fprintf(stderr, "\n\tTotal in use: %d, total free: %d\n",
+           totused, totfree);
+}
+#endif
diff --git a/patchlevel.h b/patchlevel.h
new file mode 100644 (file)
index 0000000..935ec35
--- /dev/null
@@ -0,0 +1 @@
+#define PATCHLEVEL 0
diff --git a/perl.h b/perl.h
new file mode 100644 (file)
index 0000000..3ccff10
--- /dev/null
+++ b/perl.h
@@ -0,0 +1,196 @@
+/* $Header: perl.h,v 1.0 87/12/18 13:05:38 root Exp $
+ *
+ * $Log:       perl.h,v $
+ * Revision 1.0  87/12/18  13:05:38  root
+ * Initial revision
+ * 
+ */
+
+#define DEBUGGING
+#define STDSTDIO       /* eventually should be in config.h */
+
+#define VOIDUSED 1
+#include "config.h"
+
+#ifndef BCOPY
+#   define bcopy(s1,s2,l) memcpy(s2,s1,l);
+#   define bzero(s,l) memset(s,0,l);
+#endif
+
+#include <stdio.h>
+#include <ctype.h>
+#include <setjmp.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <time.h>
+#include <sys/times.h>
+
+typedef struct arg ARG;
+typedef struct cmd CMD;
+typedef struct formcmd FCMD;
+typedef struct scanpat SPAT;
+typedef struct stab STAB;
+typedef struct stio STIO;
+typedef struct string STR;
+typedef struct atbl ARRAY;
+typedef struct htbl HASH;
+
+#include "str.h"
+#include "form.h"
+#include "stab.h"
+#include "spat.h"
+#include "arg.h"
+#include "cmd.h"
+#include "array.h"
+#include "hash.h"
+
+/* A string is TRUE if not "" or "0". */
+#define True(val) (tmps = (val), (*tmps && !(*tmps == '0' && !tmps[1])))
+EXT char *Yes INIT("1");
+EXT char *No INIT("");
+
+#define str_true(str) (Str = (str), (Str->str_pok ? True(Str->str_ptr) : (Str->str_nok ? (Str->str_nval != 0.0) : 0 )))
+
+#define str_peek(str) (Str = (str), (Str->str_pok ? Str->str_ptr : (Str->str_nok ? (sprintf(buf,"num(%g)",Str->str_nval),buf) : "" )))
+#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
+#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_nval : str_2num(Str)))
+EXT STR *Str;
+
+#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
+
+CMD *add_label();
+CMD *block_head();
+CMD *append_line();
+CMD *make_acmd();
+CMD *make_ccmd();
+CMD *invert();
+CMD *addcond();
+CMD *addloop();
+CMD *wopt();
+
+SPAT *stab_to_spat();
+
+STAB *stabent();
+
+ARG *stab_to_arg();
+ARG *op_new();
+ARG *make_op();
+ARG *make_lval();
+ARG *make_match();
+ARG *make_split();
+ARG *flipflip();
+
+STR *arg_to_str();
+STR *str_new();
+STR *stab_str();
+STR *eval();
+
+FCMD *load_format();
+
+char *scanpat();
+char *scansubst();
+char *scantrans();
+char *scanstr();
+char *scanreg();
+char *reg_get();
+char *str_append_till();
+char *str_gets();
+
+bool do_match();
+bool do_open();
+bool do_close();
+bool do_print();
+
+int do_subst();
+
+void str_free();
+void freearg();
+
+EXT int line INIT(0);
+EXT int arybase INIT(0);
+
+struct outrec {
+    int o_lines;
+    char *o_str;
+    int o_len;
+};
+
+EXT struct outrec outrec;
+EXT struct outrec toprec;
+
+EXT STAB *last_in_stab INIT(Nullstab);
+EXT STAB *defstab INIT(Nullstab);
+EXT STAB *argvstab INIT(Nullstab);
+EXT STAB *envstab INIT(Nullstab);
+EXT STAB *sigstab INIT(Nullstab);
+EXT STAB *defoutstab INIT(Nullstab);
+EXT STAB *curoutstab INIT(Nullstab);
+EXT STAB *argvoutstab INIT(Nullstab);
+
+EXT STR *freestrroot INIT(Nullstr);
+
+EXT FILE *rsfp;
+EXT char buf[1024];
+EXT char *bufptr INIT(buf);
+
+EXT STR *linestr INIT(Nullstr);
+
+EXT char record_separator INIT('\n');
+EXT char *ofs INIT(Nullch);
+EXT char *ors INIT(Nullch);
+EXT char *ofmt INIT(Nullch);
+EXT char *inplace INIT(Nullch);
+
+EXT char tokenbuf[256];
+EXT int expectterm INIT(TRUE);
+EXT int lex_newlines INIT(FALSE);
+
+FILE *popen();
+/* char *str_get(); */
+STR *interp();
+void free_arg();
+STIO *stio_new();
+
+EXT struct stat statbuf;
+EXT struct tms timesbuf;
+
+#ifdef DEBUGGING
+EXT int debug INIT(0);
+EXT int dlevel INIT(0);
+EXT char debname[40];
+EXT char debdelim[40];
+#define YYDEBUG;
+extern int yydebug;
+#endif
+
+EXT STR str_no;
+EXT STR str_yes;
+
+/* runtime control stuff */
+
+EXT struct loop {
+    char *loop_label;
+    jmp_buf loop_env;
+} loop_stack[32];
+
+EXT int loop_ptr INIT(-1);
+
+EXT jmp_buf top_env;
+
+EXT char *goto_targ INIT(Nullch);      /* cmd_exec gets strange when set */
+
+double atof();
+long time();
+struct tm *gmtime(), *localtime();
+
+#ifdef CHARSPRINTF
+    char *sprintf();
+#else
+    int sprintf();
+#endif
+
+#ifdef EUNICE
+#define UNLINK(f) while (unlink(f) >= 0)
+#else
+#define UNLINK unlink
+#endif
diff --git a/perl.man.1 b/perl.man.1
new file mode 100644 (file)
index 0000000..ea40065
--- /dev/null
@@ -0,0 +1,997 @@
+.rn '' }`
+''' $Header: perl.man.1,v 1.0 87/12/18 16:18:16 root Exp $
+''' 
+''' $Log:      perl.man.1,v $
+''' Revision 1.0  87/12/18  16:18:16  root
+''' Initial revision
+''' 
+''' 
+.de Sh
+.br
+.ne 5
+.PP
+\fB\\$1\fR
+.PP
+..
+.de Sp
+.if t .sp .5v
+.if n .sp
+..
+.de Ip
+.br
+.ie \\n.$>=3 .ne \\$3
+.el .ne 3
+.IP "\\$1" \\$2
+..
+'''
+'''     Set up \*(-- to give an unbreakable dash;
+'''     string Tr holds user defined translation string.
+'''     Bell System Logo is used as a dummy character.
+'''
+.tr \(bs-|\(bv\*(Tr
+.ie n \{\
+.ds -- \(bs-
+.if (\n(.H=4u)&(1m=24u) .ds -- \(bs\h'-12u'\(bs\h'-12u'-\" diablo 10 pitch
+.if (\n(.H=4u)&(1m=20u) .ds -- \(bs\h'-12u'\(bs\h'-8u'-\" diablo 12 pitch
+.ds L" ""
+.ds R" ""
+.ds L' '
+.ds R' '
+'br\}
+.el\{\
+.ds -- \(em\|
+.tr \*(Tr
+.ds L" ``
+.ds R" ''
+.ds L' `
+.ds R' '
+'br\}
+.TH PERL 1 LOCAL
+.SH NAME
+perl - Practical Extraction and Report Language
+.SH SYNOPSIS
+.B perl [options] filename args
+.SH DESCRIPTION
+.I Perl
+is a interpreted language optimized for scanning arbitrary text files,
+extracting information from those text files, and printing reports based
+on that information.
+It's also a good language for many system management tasks.
+The language is intended to be practical (easy to use, efficient, complete)
+rather than beautiful (tiny, elegant, minimal).
+It combines (in the author's opinion, anyway) some of the best features of C,
+\fIsed\fR, \fIawk\fR, and \fIsh\fR,
+so people familiar with those languages should have little difficulty with it.
+(Language historians will also note some vestiges of \fIcsh\fR, Pascal, and
+even BASIC-PLUS.)
+Expression syntax corresponds quite closely to C expression syntax.
+If you have a problem that would ordinarily use \fIsed\fR
+or \fIawk\fR or \fIsh\fR, but it
+exceeds their capabilities or must run a little faster,
+and you don't want to write the silly thing in C, then
+.I perl
+may be for you.
+There are also translators to turn your sed and awk scripts into perl scripts.
+OK, enough hype.
+.PP
+Upon startup,
+.I perl
+looks for your script in one of the following places:
+.Ip 1. 4 2
+Specified line by line via
+.B \-e
+switches on the command line.
+.Ip 2. 4 2
+Contained in the file specified by the first filename on the command line.
+(Note that systems supporting the #! notation invoke interpreters this way.)
+.Ip 3. 4 2
+Passed in via standard input.
+.PP
+After locating your script,
+.I perl
+compiles it to an internal form.
+If the script is syntactically correct, it is executed.
+.Sh "Options"
+Note: on first reading this section won't make much sense to you.  It's here
+at the front for easy reference.
+.PP
+A single-character option may be combined with the following option, if any.
+This is particularly useful when invoking a script using the #! construct which
+only allows one argument.  Example:
+.nf
+
+.ne 2
+       #!/bin/perl -spi.bak    # same as -s -p -i.bak
+       .\|.\|.
+
+.fi
+Options include:
+.TP 5
+.B \-D<number>
+sets debugging flags.
+To watch how it executes your script, use
+.B \-D14.
+(This only works if debugging is compiled into your
+.IR perl .)
+.TP 5
+.B \-e commandline
+may be used to enter one line of script.
+Multiple
+.B \-e
+commands may be given to build up a multi-line script.
+If
+.B \-e
+is given,
+.I perl
+will not look for a script filename in the argument list.
+.TP 5
+.B \-i<extension>
+specifies that files processed by the <> construct are to be edited
+in-place.
+It does this by renaming the input file, opening the output file by the
+same name, and selecting that output file as the default for print statements.
+The extension, if supplied, is added to the name of the
+old file to make a backup copy.
+If no extension is supplied, no backup is made.
+Saying \*(L"perl -p -i.bak -e "s/foo/bar/;" ... \*(R" is the same as using
+the script:
+.nf
+
+.ne 2
+       #!/bin/perl -pi.bak
+       s/foo/bar/;
+
+which is equivalent to
+
+.ne 14
+       #!/bin/perl
+       while (<>) {
+               if ($ARGV ne $oldargv) {
+                       rename($ARGV,$ARGV . '.bak');
+                       open(ARGVOUT,">$ARGV");
+                       select(ARGVOUT);
+                       $oldargv = $ARGV;
+               }
+               s/foo/bar/;
+       }
+       continue {
+           print;      # this prints to original filename
+       }
+       select(stdout);
+
+.fi
+except that the \-i form doesn't need to compare $ARGV to $oldargv to know when
+the filename has changed.
+It does, however, use ARGVOUT for the selected filehandle.
+Note that stdout is restored as the default output filehandle after the loop.
+.TP 5
+.B \-I<directory>
+may be used in conjunction with
+.B \-P
+to tell the C preprocessor where to look for include files.
+By default /usr/include and /usr/lib/perl are searched.
+.TP 5
+.B \-n
+causes
+.I perl
+to assume the following loop around your script, which makes it iterate
+over filename arguments somewhat like \*(L"sed -n\*(R" or \fIawk\fR:
+.nf
+
+.ne 3
+       while (<>) {
+               ...             # your script goes here
+       }
+
+.fi
+Note that the lines are not printed by default.
+See
+.B \-p
+to have lines printed.
+.TP 5
+.B \-p
+causes
+.I perl
+to assume the following loop around your script, which makes it iterate
+over filename arguments somewhat like \fIsed\fR:
+.nf
+
+.ne 5
+       while (<>) {
+               ...             # your script goes here
+       } continue {
+               print;
+       }
+
+.fi
+Note that the lines are printed automatically.
+To suppress printing use the
+.B \-n
+switch.
+.TP 5
+.B \-P
+causes your script to be run through the C preprocessor before
+compilation by
+.I perl.
+(Since both comments and cpp directives begin with the # character,
+you should avoid starting comments with any words recognized
+by the C preprocessor such as \*(L"if\*(R", \*(L"else\*(R" or \*(L"define\*(R".)
+.TP 5
+.B \-s
+enables some rudimentary switch parsing for switches on the command line
+after the script name but before any filename arguments.
+Any switch found there will set the corresponding variable in the
+.I perl
+script.
+The following script prints \*(L"true\*(R" if and only if the script is
+invoked with a -x switch.
+.nf
+
+.ne 2
+       #!/bin/perl -s
+       if ($x) { print "true\en"; }
+
+.fi
+.Sh "Data Types and Objects"
+.PP
+Perl has about two and a half data types: strings, arrays of strings, and
+associative arrays.
+Strings and arrays of strings are first class objects, for the most part,
+in the sense that they can be used as a whole as values in an expression.
+Associative arrays can only be accessed on an association by association basis;
+they don't have a value as a whole (at least not yet).
+.PP
+Strings are interpreted numerically as appropriate.
+A string is interpreted as TRUE in the boolean sense if it is not the null
+string or 0.
+Booleans returned by operators are 1 for true and '0' or '' (the null
+string) for false.
+.PP
+References to string variables always begin with \*(L'$\*(R', even when referring
+to a string that is part of an array.
+Thus:
+.nf
+
+.ne 3
+    $days      \h'|2i'# a simple string variable
+    $days[28]  \h'|2i'# 29th element of array @days
+    $days{'Feb'}\h'|2i'# one value from an associative array
+
+but entire arrays are denoted by \*(L'@\*(R':
+
+    @days      \h'|2i'# ($days[0], $days[1],\|.\|.\|. $days[n])
+
+.fi
+.PP
+Any of these four constructs may be assigned to (in compiler lingo, may serve
+as an lvalue).
+(Additionally, you may find the length of array @days by evaluating
+\*(L"$#days\*(R", as in
+.IR csh .
+[Actually, it's not the length of the array, it's the subscript of the last element, since there is (ordinarily) a 0th element.])
+.PP
+Every data type has its own namespace.
+You can, without fear of conflict, use the same name for a string variable,
+an array, an associative array, a filehandle, a subroutine name, and/or
+a label.
+Since variable and array references always start with \*(L'$\*(R'
+or \*(L'@\*(R', the \*(L"reserved\*(R" words aren't in fact reserved
+with respect to variable names.
+(They ARE reserved with respect to labels and filehandles, however, which
+don't have an initial special character.)
+Case IS significant\*(--\*(L"FOO\*(R", \*(L"Foo\*(R" and \*(L"foo\*(R" are all
+different names.
+Names which start with a letter may also contain digits and underscores.
+Names which do not start with a letter are limited to one character,
+e.g. \*(L"$%\*(R" or \*(L"$$\*(R".
+(Many one character names have a predefined significance to
+.I perl.
+More later.)
+.PP
+String literals are delimited by either single or double quotes.
+They work much like shell quotes:
+double-quoted string literals are subject to backslash and variable
+substitution; single-quoted strings are not.
+The usual backslash rules apply for making characters such as newline, tab, etc.
+You can also embed newlines directly in your strings, i.e. they can end on
+a different line than they begin.
+This is nice, but if you forget your trailing quote, the error will not be
+reported until perl finds another line containing the quote character, which
+may be much further on in the script.
+Variable substitution inside strings is limited (currently) to simple string variables.
+The following code segment prints out \*(L"The price is $100.\*(R"
+.nf
+
+.ne 2
+    $Price = '$100';\h'|3.5i'# not interpreted
+    print "The price is $Price.\e\|n";\h'|3.5i'# interpreted
+
+.fi
+.PP
+Array literals are denoted by separating individual values by commas, and
+enclosing the list in parentheses.
+In a context not requiring an array value, the value of the array literal
+is the value of the final element, as in the C comma operator.
+For example,
+.nf
+
+    @foo = ('cc', '\-E', $bar);
+
+assigns the entire array value to array foo, but
+
+    $foo = ('cc', '\-E', $bar);
+
+.fi
+assigns the value of variable bar to variable foo.
+Array lists may be assigned to if and only if each element of the list
+is an lvalue:
+.nf
+
+    ($a, $b, $c) = (1, 2, 3);
+
+    ($map{'red'}, $map{'blue'}, $map{'green'}) = (0x00f, 0x0f0, 0xf00);
+
+.fi
+.PP
+Numeric literals are specified in any of the usual floating point or
+integer formats.
+.PP
+There are several other pseudo-literals that you should know about.
+If a string is enclosed by backticks (grave accents), it is interpreted as
+a command, and the output of that command is the value of the pseudo-literal,
+just like in any of the standard shells.
+The command is executed each time the pseudo-literal is evaluated.
+Unlike in \f2csh\f1, no interpretation is done on the
+data\*(--newlines remain newlines.
+.PP
+Evaluating a filehandle in angle brackets yields the next line
+from that file (newline included, so it's never false until EOF).
+Ordinarily you must assign that value to a variable,
+but there is one situation where in which an automatic assignment happens.
+If (and only if) the input symbol is the only thing inside the conditional of a
+.I while
+loop, the value is
+automatically assigned to the variable \*(L"$_\*(R".
+(This may seem like an odd thing to you, but you'll use the construct
+in almost every
+.I perl
+script you write.)
+Anyway, the following lines are equivalent to each other:
+.nf
+
+.ne 3
+    while ($_ = <stdin>) {
+    while (<stdin>) {
+    for (\|;\|<stdin>;\|) {
+
+.fi
+The filehandles
+.IR stdin ,
+.I stdout
+and
+.I stderr
+are predefined.
+Additional filehandles may be created with the
+.I open
+function.
+.PP
+The null filehandle <> is special and can be used to emulate the behavior of
+\fIsed\fR and \fIawk\fR.
+Input from <> comes either from standard input, or from each file listed on
+the command line.
+Here's how it works: the first time <> is evaluated, the ARGV array is checked,
+and if it is null, $ARGV[0] is set to '-', which when opened gives you standard
+input.
+The ARGV array is then processed as a list of filenames.
+The loop
+.nf
+
+.ne 3
+       while (<>) {
+               .\|.\|.                 # code for each line
+       }
+
+.ne 10
+is equivalent to
+
+       unshift(@ARGV, '\-') \|if \|$#ARGV < $[;
+       while ($ARGV = shift) {
+               open(ARGV, $ARGV);
+               while (<ARGV>) {
+                       .\|.\|.         # code for each line
+               }
+       }
+
+.fi
+except that it isn't as cumbersome to say.
+It really does shift array ARGV and put the current filename into
+variable ARGV.
+It also uses filehandle ARGV internally.
+You can modify @ARGV before the first <> as long as you leave the first
+filename at the beginning of the array.
+.PP
+If you want to set @ARGV to you own list of files, go right ahead.
+If you want to pass switches into your script, you can
+put a loop on the front like this:
+.nf
+
+.ne 10
+       while ($_ = $ARGV[0], /\|^\-/\|) {
+               shift;
+           last if /\|^\-\|\-$\|/\|;
+               /\|^\-D\|(.*\|)/ \|&& \|($debug = $1);
+               /\|^\-v\|/ \|&& \|$verbose++;
+               .\|.\|.         # other switches
+       }
+       while (<>) {
+               .\|.\|.         # code for each line
+       }
+
+.fi
+The <> symbol will return FALSE only once.
+If you call it again after this it will assume you are processing another
+@ARGV list, and if you haven't set @ARGV, will input from stdin.
+.Sh "Syntax"
+.PP
+A
+.I perl
+script consists of a sequence of declarations and commands.
+The only things that need to be declared in
+.I perl
+are report formats and subroutines.
+See the sections below for more information on those declarations.
+All objects are assumed to start with a null or 0 value.
+The sequence of commands is executed just once, unlike in
+.I sed
+and
+.I awk
+scripts, where the sequence of commands is executed for each input line.
+While this means that you must explicitly loop over the lines of your input file
+(or files), it also means you have much more control over which files and which
+lines you look at.
+(Actually, I'm lying\*(--it is possible to do an implicit loop with either the
+.B \-n
+or
+.B \-p
+switch.)
+.PP
+A declaration can be put anywhere a command can, but has no effect on the
+execution of the primary sequence of commands.
+Typically all the declarations are put at the beginning or the end of the script.
+.PP
+.I Perl
+is, for the most part, a free-form language.
+(The only exception to this is format declarations, for fairly obvious reasons.)
+Comments are indicated by the # character, and extend to the end of the line.
+If you attempt to use /* */ C comments, it will be interpreted either as
+division or pattern matching, depending on the context.
+So don't do that.
+.Sh "Compound statements"
+In
+.IR perl ,
+a sequence of commands may be treated as one command by enclosing it
+in curly brackets.
+We will call this a BLOCK.
+.PP
+The following compound commands may be used to control flow:
+.nf
+
+.ne 4
+       if (EXPR) BLOCK
+       if (EXPR) BLOCK else BLOCK
+       if (EXPR) BLOCK elsif (EXPR) BLOCK ... else BLOCK
+       LABEL while (EXPR) BLOCK
+       LABEL while (EXPR) BLOCK continue BLOCK
+       LABEL for (EXPR; EXPR; EXPR) BLOCK
+       LABEL BLOCK continue BLOCK
+
+.fi
+(Note that, unlike C and Pascal, these are defined in terms of BLOCKs, not
+statements.
+This means that the curly brackets are \fIrequired\fR\*(--no dangling statements allowed.
+If you want to write conditionals without curly brackets there are several
+other ways to do it.
+The following all do the same thing:
+.nf
+
+.ne 5
+    if (!open(foo)) { die "Can't open $foo"; }
+    die "Can't open $foo" unless open(foo);
+    open(foo) || die "Can't open $foo";        # foo or bust!
+    open(foo) ? die "Can't open $foo" : 'hi mom';
+
+.fi
+though the last one is a bit exotic.)
+.PP
+The
+.I if
+statement is straightforward.
+Since BLOCKs are always bounded by curly brackets, there is never any
+ambiguity about which
+.I if
+an
+.I else
+goes with.
+If you use
+.I unless
+in place of
+.IR if ,
+the sense of the test is reversed.
+.PP
+The
+.I while
+statement executes the block as long as the expression is true
+(does not evaluate to the null string or 0).
+The LABEL is optional, and if present, consists of an identifier followed by
+a colon.
+The LABEL identifies the loop for the loop control statements
+.IR next ,
+.I last
+and
+.I redo
+(see below).
+If there is a
+.I continue
+BLOCK, it is always executed just before
+the conditional is about to be evaluated again, similarly to the third part
+of a
+.I for
+loop in C.
+Thus it can be used to increment a loop variable, even when the loop has
+been continued via the
+.I next
+statement (similar to the C \*(L"continue\*(R" statement).
+.PP
+If the word
+.I while
+is replaced by the word
+.IR until ,
+the sense of the test is reversed, but the conditional is still tested before
+the first iteration.
+.PP
+In either the
+.I if
+or the
+.I while
+statement, you may replace \*(L"(EXPR)\*(R" with a BLOCK, and the conditional
+is true if the value of the last command in that block is true.
+.PP
+The
+.I for
+loop works exactly like the corresponding
+.I while
+loop:
+.nf
+
+.ne 12
+       for ($i = 1; $i < 10; $i++) {
+               .\|.\|.
+       }
+
+is the same as
+
+       $i = 1;
+       while ($i < 10) {
+               .\|.\|.
+       } continue {
+               $i++;
+       }
+.fi
+.PP
+The BLOCK by itself (labeled or not) is equivalent to a loop that executes
+once.
+Thus you can use any of the loop control statements in it to leave or
+restart the block.
+The
+.I continue
+block is optional.
+This construct is particularly nice for doing case structures.
+.nf
+
+.ne 6
+       foo: {
+               if (/abc/) { $abc = 1; last foo; }
+               if (/def/) { $def = 1; last foo; }
+               if (/xyz/) { $xyz = 1; last foo; }
+               $nothing = 1;
+       }
+
+.fi
+.Sh "Simple statements"
+The only kind of simple statement is an expression evaluated for its side
+effects.
+Every expression (simple statement) must be terminated with a semicolon.
+Note that this is like C, but unlike Pascal (and
+.IR awk ).
+.PP
+Any simple statement may optionally be followed by a
+single modifier, just before the terminating semicolon.
+The possible modifiers are:
+.nf
+
+.ne 4
+       if EXPR
+       unless EXPR
+       while EXPR
+       until EXPR
+
+.fi
+The
+.I if
+and
+.I unless
+modifiers have the expected semantics.
+The
+.I while
+and
+.I unless
+modifiers also have the expected semantics (conditional evaluated first),
+except when applied to a do-BLOCK command,
+in which case the block executes once before the conditional is evaluated.
+This is so that you can write loops like:
+.nf
+
+.ne 4
+       do {
+               $_ = <stdin>;
+               .\|.\|.
+       } until $_ \|eq \|".\|\e\|n";
+
+.fi
+(See the
+.I do
+operator below.  Note also that the loop control commands described later will
+NOT work in this construct, since loop modifiers don't take loop labels.
+Sorry.)
+.Sh "Expressions"
+Since
+.I perl
+expressions work almost exactly like C expressions, only the differences
+will be mentioned here.
+.PP
+Here's what
+.I perl
+has that C doesn't:
+.Ip (\|) 8 3
+The null list, used to initialize an array to null.
+.Ip . 8
+Concatenation of two strings.
+.Ip .= 8
+The corresponding assignment operator.
+.Ip eq 8
+String equality (== is numeric equality).
+For a mnemonic just think of \*(L"eq\*(R" as a string.
+(If you are used to the
+.I awk
+behavior of using == for either string or numeric equality
+based on the current form of the comparands, beware!
+You must be explicit here.)
+.Ip ne 8
+String inequality (!= is numeric inequality).
+.Ip lt 8
+String less than.
+.Ip gt 8
+String greater than.
+.Ip le 8
+String less than or equal.
+.Ip ge 8
+String greater than or equal.
+.Ip =~ 8 2
+Certain operations search or modify the string \*(L"$_\*(R" by default.
+This operator makes that kind of operation work on some other string.
+The right argument is a search pattern, substitution, or translation.
+The left argument is what is supposed to be searched, substituted, or
+translated instead of the default \*(L"$_\*(R".
+The return value indicates the success of the operation.
+(If the right argument is an expression other than a search pattern,
+substitution, or translation, it is interpreted as a search pattern
+at run time.
+This is less efficient than an explicit search, since the pattern must
+be compiled every time the expression is evaluated.)
+The precedence of this operator is lower than unary minus and autoincrement/decrement, but higher than everything else.
+.Ip !~ 8
+Just like =~ except the return value is negated.
+.Ip x 8
+The repetition operator.
+Returns a string consisting of the left operand repeated the
+number of times specified by the right operand.
+.nf
+
+       print '-' x 80;         # print row of dashes
+       print '-' x80;          # illegal, x80 is identifier
+
+       print "\et" x ($tab/8), ' ' x ($tab%8); # tab over
+
+.fi
+.Ip x= 8
+The corresponding assignment operator.
+.Ip .. 8
+The range operator, which is bistable.
+It is false as long as its left argument is false.
+Once the left argument is true, it stays true until the right argument is true,
+AFTER which it becomes false again.
+(It doesn't become false till the next time it's evaluated.
+It can become false on the same evaluation it became true, but it still returns
+true once.)
+The .. operator is primarily intended for doing line number ranges after
+the fashion of \fIsed\fR or \fIawk\fR.
+The precedence is a little lower than || and &&.
+The value returned is either the null string for false, or a sequence number
+(beginning with 1) for true.
+The sequence number is reset for each range encountered.
+The final sequence number in a range has the string 'E0' appended to it, which
+doesn't affect its numeric value, but gives you something to search for if you
+want to exclude the endpoint.
+You can exclude the beginning point by waiting for the sequence number to be
+greater than 1.
+If either argument to .. is static, that argument is implicitly compared to
+the $. variable, the current line number.
+Examples:
+.nf
+
+.ne 5
+    if (101 .. 200) { print; } # print 2nd hundred lines
+
+    next line if (1 .. /^$/);  # skip header lines
+
+    s/^/> / if (/^$/ .. eof());        # quote body
+
+.fi
+.PP
+Here is what C has that
+.I perl
+doesn't:
+.Ip "unary &" 12
+Address-of operator.
+.Ip "unary *" 12
+Dereference-address operator.
+.PP
+Like C,
+.I perl
+does a certain amount of expression evaluation at compile time, whenever
+it determines that all of the arguments to an operator are static and have
+no side effects.
+In particular, string concatenation happens at compile time between literals that don't do variable substitution.
+Backslash interpretation also happens at compile time.
+You can say
+.nf
+
+.ne 2
+       'Now is the time for all' . "\|\e\|n" .
+       'good men to come to.'
+
+.fi
+and this all reduces to one string internally.
+.PP
+Along with the literals and variables mentioned earlier,
+the following operations can serve as terms in an expression:
+.Ip "/PATTERN/" 8 4
+Searches a string for a pattern, and returns true (1) or false ('').
+If no string is specified via the =~ or !~ operator,
+the $_ string is searched.
+(The string specified with =~ need not be an lvalue\*(--it may be the result of an expression evaluation, but remember the =~ binds rather tightly.)
+See also the section on regular expressions.
+.Sp
+If you prepend an `m' you can use any pair of characters as delimiters.
+This is particularly useful for matching Unix path names that contain `/'.
+.Sp
+Examples:
+.nf
+
+.ne 4
+    open(tty, '/dev/tty');
+    <tty> \|=~ \|/\|^[Yy]\|/ \|&& \|do foo(\|);        # do foo if desired
+
+    if (/Version: \|*\|([0-9.]*\|)\|/\|) { $version = $1; }
+
+    next if m#^/usr/spool/uucp#;
+
+.fi
+.Ip "?PATTERN?" 8 4
+This is just like the /pattern/ search, except that it matches only once between
+calls to the
+.I reset
+operator.
+This is a useful optimization when you only want to see the first occurence of
+something in each of a set of files, for instance.
+.Ip "chdir EXPR" 8 2
+Changes the working director to EXPR, if possible.
+Returns 1 upon success, 0 otherwise.
+See example under die().
+.Ip "chmod LIST" 8 2
+Changes the permissions of a list of files.
+The first element of the list must be the numerical mode.
+LIST may be an array, in which case you may wish to use the unshift()
+command to put the mode on the front of the array.
+Returns the number of files successfully changed.
+Note: in order to use the value you must put the whole thing in parentheses.
+.nf
+
+       $cnt = (chmod 0755,'foo','bar');
+
+.fi
+.Ip "chop(VARIABLE)" 8 5
+.Ip "chop" 8
+Chops off the last character of a string and returns it.
+It's used primarily to remove the newline from the end of an input record,
+but is much more efficient than s/\en// because it neither scans nor copies
+the string.
+If VARIABLE is omitted, chops $_.
+Example:
+.nf
+
+.ne 5
+       while (<>) {
+               chop;   # avoid \en on last field
+               @array = split(/:/);
+               .\|.\|.
+       }
+
+.fi
+.Ip "chown LIST" 8 2
+Changes the owner (and group) of a list of files.
+LIST may be an array.
+The first two elements of the list must be the NUMERICAL uid and gid, in that order.
+Returns the number of files successfully changed.
+Note: in order to use the value you must put the whole thing in parentheses.
+.nf
+
+       $cnt = (chown $uid,$gid,'foo');
+
+.fi
+Here's an example of looking up non-numeric uids:
+.nf
+
+.ne 16
+       print "User: ";
+       $user = <stdin>;
+       open(pass,'/etc/passwd') || die "Can't open passwd";
+       while (<pass>) {
+               ($login,$pass,$uid,$gid) = split(/:/);
+               $uid{$login} = $uid;
+               $gid{$login} = $gid;
+       }
+       @ary = ('foo','bar','bie','doll');
+       if ($uid{$user} eq '') {
+               die "$user not in passwd file";
+       }
+       else {
+               unshift(@ary,$uid{$user},$gid{$user});
+               chown @ary;
+       }
+
+.fi
+.Ip "close(FILEHANDLE)" 8 5
+.Ip "close FILEHANDLE" 8
+Closes the file or pipe associated with the file handle.
+You don't have to close FILEHANDLE if you are immediately going to
+do another open on it, since open will close it for you.
+(See
+.IR open .)
+However, an explicit close on an input file resets the line counter ($.), while
+the implicit close done by
+.I open
+does not.
+Also, closing a pipe will wait for the process executing on the pipe to complete,
+in case you want to look at the output of the pipe afterwards.
+Example:
+.nf
+
+.ne 4
+       open(output,'|sort >foo');      # pipe to sort
+       ...     # print stuff to output
+       close(output);          # wait for sort to finish
+       open(input,'foo');      # get sort's results
+
+.fi
+.Ip "crypt(PLAINTEXT,SALT)" 8 6
+Encrypts a string exactly like the crypt() function in the C library.
+Useful for checking the password file for lousy passwords.
+Only the guys wearing white hats should do this.
+.Ip "die EXPR" 8 6
+Prints the value of EXPR to stderr and exits with a non-zero status.
+Equivalent examples:
+.nf
+
+.ne 3
+       die "Can't cd to spool." unless chdir '/usr/spool/news';
+
+       (chdir '/usr/spool/news') || die "Can't cd to spool." 
+
+.fi
+Note that the parens are necessary above due to precedence.
+See also
+.IR exit .
+.Ip "do BLOCK" 8 4
+Returns the value of the last command in the sequence of commands indicated
+by BLOCK.
+When modified by a loop modifier, executes the BLOCK once before testing the
+loop condition.
+(On other statements the loop modifiers test the conditional first.)
+.Ip "do SUBROUTINE (LIST)" 8 3
+Executes a SUBROUTINE declared by a
+.I sub
+declaration, and returns the value
+of the last expression evaluated in SUBROUTINE.
+(See the section on subroutines later on.)
+.Ip "each(ASSOC_ARRAY)" 8 6
+Returns a 2 element array consisting of the key and value for the next
+value of an associative array, so that you can iterate over it.
+Entries are returned in an apparently random order.
+When the array is entirely read, a null array is returned (which when
+assigned produces a FALSE (0) value).
+The next call to each() after that will start iterating again.
+The iterator can be reset only by reading all the elements from the array.
+The following prints out your environment like the printenv program, only
+in a different order:
+.nf
+
+.ne 3
+       while (($key,$value) = each(ENV)) {
+               print "$key=$value\en";
+       }
+
+.fi
+See also keys() and values().
+.Ip "eof(FILEHANDLE)" 8 8
+.Ip "eof" 8
+Returns 1 if the next read on FILEHANDLE will return end of file, or if
+FILEHANDLE is not open.
+If (FILEHANDLE) is omitted, the eof status is returned for the last file read.
+The null filehandle may be used to indicate the pseudo file formed of the
+files listed on the command line, i.e. eof() is reasonable to use inside
+a while (<>) loop.
+Example:
+.nf
+
+.ne 7
+       # insert dashes just before last line
+       while (<>) {
+               if (eof()) {
+                       print "--------------\en";
+               }
+               print;
+       }
+
+.fi
+.Ip "exec LIST" 8 6
+If there is more than one argument in LIST,
+calls execvp() with the arguments in LIST.
+If there is only one argument, the argument is checked for shell metacharacters.
+If there are any, the entire argument is passed to /bin/sh -c for parsing.
+If there are none, the argument is split into words and passed directly to
+execvp(), which is more efficient.
+Note: exec (and system) do not flush your output buffer, so you may need to
+set $| to avoid lost output.
+.Ip "exit EXPR" 8 6
+Evaluates EXPR and exits immediately with that value.
+Example:
+.nf
+
+.ne 2
+       $ans = <stdin>;
+       exit 0 \|if \|$ans \|=~ \|/\|^[Xx]\|/\|;
+
+.fi
+See also
+.IR die .
+.Ip "exp(EXPR)" 8 3
+Returns e to the power of EXPR.
+.Ip "fork" 8 4
+Does a fork() call.
+Returns the child pid to the parent process and 0 to the child process.
+Note: unflushed buffers remain unflushed in both processes, which means
+you may need to set $| to avoid duplicate output.
+.Ip "gmtime(EXPR)" 8 4
+Converts a time as returned by the time function to a 9-element array with
+the time analyzed for the Greenwich timezone.
+Typically used as follows:
+.nf
+
+.ne 3
+    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
+       = gmtime(time);
+
+.fi
+All array elements are numeric.
+''' End of part 1
diff --git a/perl.man.2 b/perl.man.2
new file mode 100644 (file)
index 0000000..ecda600
--- /dev/null
@@ -0,0 +1,1007 @@
+''' Beginning of part 2
+''' $Header: perl.man.2,v 1.0 87/12/18 16:18:41 root Exp $
+'''
+''' $Log:      perl.man.2,v $
+''' Revision 1.0  87/12/18  16:18:41  root
+''' Initial revision
+''' 
+'''
+.Ip "goto LABEL" 8 6
+Finds the statement labeled with LABEL and resumes execution there.
+Currently you may only go to statements in the main body of the program
+that are not nested inside a do {} construct.
+This statement is not implemented very efficiently, and is here only to make
+the sed-to-perl translator easier.
+Use at your own risk.
+.Ip "hex(EXPR)" 8 2
+Returns the decimal value of EXPR interpreted as an hex string.
+(To interpret strings that might start with 0 or 0x see oct().)
+.Ip "index(STR,SUBSTR)" 8 4
+Returns the position of SUBSTR in STR, based at 0, or whatever you've
+set the $[ variable to.
+If the substring is not found, returns one less than the base, ordinarily -1.
+.Ip "int(EXPR)" 8 3
+Returns the integer portion of EXPR.
+.Ip "join(EXPR,LIST)" 8 8
+.Ip "join(EXPR,ARRAY)" 8
+Joins the separate strings of LIST or ARRAY into a single string with fields
+separated by the value of EXPR, and returns the string.
+Example:
+.nf
+    
+    $_ = join(\|':', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
+
+.fi
+See
+.IR split .
+.Ip "keys(ASSOC_ARRAY)" 8 6
+Returns a normal array consisting of all the keys of the named associative
+array.
+The keys are returned in an apparently random order, but it is the same order
+as either the values() or each() function produces (given that the associative array
+has not been modified).
+Here is yet another way to print your environment:
+.nf
+
+.ne 5
+       @keys = keys(ENV);
+       @values = values(ENV);
+       while ($#keys >= 0) {
+               print pop(keys),'=',pop(values),"\n";
+       }
+
+.fi
+.Ip "kill LIST" 8 2
+Sends a signal to a list of processes.
+The first element of the list must be the (numerical) signal to send.
+LIST may be an array, in which case you may wish to use the unshift
+command to put the signal on the front of the array.
+Returns the number of processes successfully signaled.
+Note: in order to use the value you must put the whole thing in parentheses:
+.nf
+
+       $cnt = (kill 9,$child1,$child2);
+
+.fi
+.Ip "last LABEL" 8 8
+.Ip "last" 8
+The
+.I last
+command is like the
+.I break
+statement in C (as used in loops); it immediately exits the loop in question.
+If the LABEL is omitted, the command refers to the innermost enclosing loop.
+The
+.I continue
+block, if any, is not executed:
+.nf
+
+.ne 4
+       line: while (<stdin>) {
+               last line if /\|^$/;    # exit when done with header
+               .\|.\|.
+       }
+
+.fi
+.Ip "localtime(EXPR)" 8 4
+Converts a time as returned by the time function to a 9-element array with
+the time analyzed for the local timezone.
+Typically used as follows:
+.nf
+
+.ne 3
+    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
+       = localtime(time);
+
+.fi
+All array elements are numeric.
+.Ip "log(EXPR)" 8 3
+Returns logarithm (base e) of EXPR.
+.Ip "next LABEL" 8 8
+.Ip "next" 8
+The
+.I next
+command is like the
+.I continue
+statement in C; it starts the next iteration of the loop:
+.nf
+
+.ne 4
+       line: while (<stdin>) {
+               next line if /\|^#/;    # discard comments
+               .\|.\|.
+       }
+
+.fi
+Note that if there were a
+.I continue
+block on the above, it would get executed even on discarded lines.
+If the LABEL is omitted, the command refers to the innermost enclosing loop.
+.Ip "length(EXPR)" 8 2
+Returns the length in characters of the value of EXPR.
+.Ip "link(OLDFILE,NEWFILE)" 8 2
+Creates a new filename linked to the old filename.
+Returns 1 for success, 0 otherwise.
+.Ip "oct(EXPR)" 8 2
+Returns the decimal value of EXPR interpreted as an octal string.
+(If EXPR happens to start off with 0x, interprets it as a hex string instead.)
+The following will handle decimal, octal and hex in the standard notation:
+.nf
+
+       $val = oct($val) if $val =~ /^0/;
+
+.fi
+.Ip "open(FILEHANDLE,EXPR)" 8 8
+.Ip "open(FILEHANDLE)" 8
+.Ip "open FILEHANDLE" 8
+Opens the file whose filename is given by EXPR, and associates it with
+FILEHANDLE.
+If EXPR is omitted, the string variable of the same name as the FILEHANDLE
+contains the filename.
+If the filename begins with \*(L">\*(R", the file is opened for output.
+If the filename begins with \*(L">>\*(R", the file is opened for appending.
+If the filename begins with \*(L"|\*(R", the filename is interpreted
+as a command to which output is to be piped, and if the filename ends
+with a \*(L"|\*(R", the filename is interpreted as command which pipes
+input to us.
+(You may not have a command that pipes both in and out.)
+On non-pipe opens, the filename '\-' represents either stdin or stdout, as
+appropriate.
+Open returns 1 upon success, '' otherwise.
+Examples:
+.nf
+    
+.ne 3
+    $article = 100;
+    open article || die "Can't find article $article";
+    while (<article>) {\|.\|.\|.
+
+    open(log, '>>/usr/spool/news/twitlog'\|);
+
+    open(article, "caeser <$article |"\|);             # decrypt article
+
+    open(extract, "|sort >/tmp/Tmp$$"\|);              # $$ is our process#
+
+.fi
+.Ip "ord(EXPR)" 8 3
+Returns the ascii value of the first character of EXPR.
+.Ip "pop ARRAY" 8 6
+.Ip "pop(ARRAY)" 8
+Pops and returns the last value of the array, shortening the array by 1.
+''' $tmp = $ARRAY[$#ARRAY--]
+.Ip "print FILEHANDLE LIST" 8 9
+.Ip "print LIST" 8
+.Ip "print" 8
+Prints a string or comma-separated list of strings.
+If FILEHANDLE is omitted, prints by default to standard output (or to the
+last selected output channel\*(--see select()).
+If LIST is also omitted, prints $_ to stdout.
+LIST may also be an array value.
+To set the default output channel to something other than stdout use the select operation.
+.Ip "printf FILEHANDLE LIST" 8 9
+.Ip "printf LIST" 8
+Equivalent to a "print FILEHANDLE sprintf(LIST)".
+.Ip "push(ARRAY,EXPR)" 8 7
+Treats ARRAY (@ is optional) as a stack, and pushes the value of EXPR
+onto the end of ARRAY.
+The length of ARRAY increases by 1.
+Has the same effect as
+.nf
+
+    $ARRAY[$#ARRAY+1] = EXPR;
+
+.fi
+but is more efficient.
+.Ip "redo LABEL" 8 8
+.Ip "redo" 8
+The
+.I redo
+command restarts the loop block without evaluating the conditional again.
+The
+.I continue
+block, if any, is not executed.
+If the LABEL is omitted, the command refers to the innermost enclosing loop.
+This command is normally used by programs that want to lie to themselves
+about what was just input:
+.nf
+
+.ne 16
+       # a simpleminded Pascal comment stripper
+       # (warning: assumes no { or } in strings)
+       line: while (<stdin>) {
+               while (s|\|({.*}.*\|){.*}|$1 \||) {}
+               s|{.*}| \||;
+               if (s|{.*| \||) {
+                       $front = $_;
+                       while (<stdin>) {
+                               if (\|/\|}/\|) {        # end of comment?
+                                       s|^|$front{|;
+                                       redo line;
+                               }
+                       }
+               }
+               print;
+       }
+
+.fi
+.Ip "rename(OLDNAME,NEWNAME)" 8 2
+Changes the name of a file.
+Returns 1 for success, 0 otherwise.
+.Ip "reset EXPR" 8 3
+Generally used in a
+.I continue
+block at the end of a loop to clear variables and reset ?? searches
+so that they work again.
+The expression is interpreted as a list of single characters (hyphens allowed
+for ranges).
+All string variables beginning with one of those letters are set to the null
+string.
+If the expression is omitted, one-match searches (?pattern?) are reset to
+match again.
+Always returns 1.
+Examples:
+.nf
+
+.ne 3
+    reset 'X'; \h'|2i'# reset all X variables
+    reset 'a-z';\h'|2i'# reset lower case variables
+    reset;     \h'|2i'# just reset ?? searches
+
+.fi
+.Ip "s/PATTERN/REPLACEMENT/g" 8 3
+Searches a string for a pattern, and if found, replaces that pattern with the
+replacement text and returns the number of substitutions made.
+Otherwise it returns false (0).
+The \*(L"g\*(R" is optional, and if present, indicates that all occurences
+of the pattern are to be replaced.
+Any delimiter may replace the slashes; if single quotes are used, no
+interpretation is done on the replacement string.
+If no string is specified via the =~ or !~ operator,
+the $_ string is searched and modified.
+(The string specified with =~ must be a string variable or array element,
+i.e. an lvalue.)
+If the pattern contains a $ that looks like a variable rather than an
+end-of-string test, the variable will be interpolated into the pattern at
+run-time.
+See also the section on regular expressions.
+Examples:
+.nf
+
+    s/\|\e\|bgreen\e\|b/mauve/g;               # don't change wintergreen
+
+    $path \|=~ \|s|\|/usr/bin|\|/usr/local/bin|;
+
+    s/Login: $foo/Login: $bar/; # run-time pattern
+
+    s/\|([^ \|]*\|) *\|([^ \|]*\|)\|/\|$2 $1/; # reverse 1st two fields
+
+.fi
+(Note the use of $ instead of \|\e\| in the last example.  See section
+on regular expressions.)
+.Ip "seek(FILEHANDLE,POSITION,WHENCE)" 8 3
+Randomly positions the file pointer for FILEHANDLE, just like the fseek()
+call of stdio.
+Returns 1 upon success, 0 otherwise.
+.Ip "select(FILEHANDLE)" 8 3
+Sets the current default filehandle for output.
+This has two effects: first, a
+.I write
+or a
+.I print
+without a filehandle will default to this FILEHANDLE.
+Second, references to variables related to output will refer to this output
+channel.
+For example, if you have to set the top of form format for more than
+one output channel, you might do the following:
+.nf
+
+.ne 4
+    select(report1);
+    $^ = 'report1_top';
+    select(report2);
+    $^ = 'report2_top';
+
+.fi
+Select happens to return TRUE if the file is currently open and FALSE otherwise,
+but this has no effect on its operation.
+.Ip "shift(ARRAY)" 8 6
+.Ip "shift ARRAY" 8
+.Ip "shift" 8
+Shifts the first value of the array off, shortening the array by 1 and
+moving everything down.
+If ARRAY is omitted, shifts the ARGV array.
+See also unshift().
+.Ip "sleep EXPR" 8 6
+.Ip "sleep" 8
+Causes the script to sleep for EXPR seconds, or forever if no EXPR.
+May be interrupted by sending the process a SIGALARM.
+Returns the number of seconds actually slept.
+.Ip "split(/PATTERN/,EXPR)" 8 8
+.Ip "split(/PATTERN/)" 8
+.Ip "split" 8
+Splits a string into an array of strings, and returns it.
+If EXPR is omitted, splits the $_ string.
+If PATTERN is also omitted, splits on whitespace (/[\ \et\en]+/).
+Anything matching PATTERN is taken to be a delimiter separating the fields.
+(Note that the delimiter may be longer than one character.)
+Trailing null fields are stripped, which potential users of pop() would
+do well to remember.
+A pattern matching the null string will split into separate characters.
+.sp
+Example:
+.nf
+
+.ne 5
+       open(passwd, '/etc/passwd');
+       while (<passwd>) {
+.ie t \{\
+               ($login, $passwd, $uid, $gid, $gcos, $home, $shell) = split(\|/\|:\|/\|);
+'br\}
+.el \{\
+               ($login, $passwd, $uid, $gid, $gcos, $home, $shell)
+                       = split(\|/\|:\|/\|);
+'br\}
+               .\|.\|.
+       }
+
+.fi
+(Note that $shell above will still have a newline on it.  See chop().)
+See also
+.IR join .
+.Ip "sprintf(FORMAT,LIST)" 8 4
+Returns a string formatted by the usual printf conventions.
+The * character is not supported.
+.Ip "sqrt(EXPR)" 8 3
+Return the square root of EXPR.
+.Ip "stat(FILEHANDLE)" 8 6
+.Ip "stat(EXPR)" 8
+Returns a 13-element array giving the statistics for a file, either the file
+opened via FILEHANDLE, or named by EXPR.
+Typically used as follows:
+.nf
+
+.ne 3
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+       $atime,$mtime,$ctime,$blksize,$blocks)
+           = stat($filename);
+
+.fi
+.Ip "substr(EXPR,OFFSET,LEN)" 8 2
+Extracts a substring out of EXPR and returns it.
+First character is at offset 0, or whatever you've set $[ to.
+.Ip "system LIST" 8 6
+Does exactly the same thing as \*(L"exec LIST\*(R" except that a fork
+is done first, and the parent process waits for the child process to complete.
+Note that argument processing varies depending on the number of arguments.
+See exec.
+.Ip "tell(FILEHANDLE)" 8 6
+.Ip "tell" 8
+Returns the current file position for FILEHANDLE.
+If FILEHANDLE is omitted, assumes the file last read.
+.Ip "time" 8 4
+Returns the number of seconds since January 1, 1970.
+Suitable for feeding to gmtime() and localtime().
+.Ip "times" 8 4
+Returns a four-element array giving the user and system times, in seconds, for this
+process and the children of this process.
+.sp
+    ($user,$system,$cuser,$csystem) = times;
+.sp
+.Ip "tr/SEARCHLIST/REPLACEMENTLIST/" 8 5
+.Ip "y/SEARCHLIST/REPLACEMENTLIST/" 8
+Translates all occurences of the characters found in the search list with
+the corresponding character in the replacement list.
+It returns the number of characters replaced.
+If no string is specified via the =~ or !~ operator,
+the $_ string is translated.
+(The string specified with =~ must be a string variable or array element,
+i.e. an lvalue.)
+For
+.I sed
+devotees,
+.I y
+is provided as a synonym for
+.IR tr .
+Examples:
+.nf
+
+    $ARGV[1] \|=~ \|y/A-Z/a-z/;        \h'|3i'# canonicalize to lower case
+
+    $cnt = tr/*/*/;            \h'|3i'# count the stars in $_
+
+.fi
+.Ip "umask(EXPR)" 8 3
+Sets the umask for the process and returns the old one.
+.Ip "unlink LIST" 8 2
+Deletes a list of files.
+LIST may be an array.
+Returns the number of files successfully deleted.
+Note: in order to use the value you must put the whole thing in parentheses:
+.nf
+
+       $cnt = (unlink 'a','b','c');
+
+.fi
+.Ip "unshift(ARRAY,LIST)" 8 4
+Does the opposite of a shift.
+Prepends list to the front of the array, and returns the number of elements
+in the new array.
+.nf
+
+       unshift(ARGV,'-e') unless $ARGV[0] =~ /^-/;
+
+.fi
+.Ip "values(ASSOC_ARRAY)" 8 6
+Returns a normal array consisting of all the values of the named associative
+array.
+The values are returned in an apparently random order, but it is the same order
+as either the keys() or each() function produces (given that the associative array
+has not been modified).
+See also keys() and each().
+.Ip "write(FILEHANDLE)" 8 6
+.Ip "write(EXPR)" 8
+.Ip "write(\|)" 8
+Writes a formatted record (possibly multi-line) to the specified file,
+using the format associated with that file.
+By default the format for a file is the one having the same name is the
+filehandle, but the format for the current output channel (see
+.IR select )
+may be set explicitly
+by assigning the name of the format to the $~ variable.
+.sp
+Top of form processing is handled automatically:
+if there is insufficient room on the current page for the formatted 
+record, the page is advanced, a special top-of-page format is used
+to format the new page header, and then the record is written.
+By default the top-of-page format is \*(L"top\*(R", but it
+may be set to the
+format of your choice by assigning the name to the $^ variable.
+.sp
+If FILEHANDLE is unspecified, output goes to the current default output channel,
+which starts out as stdout but may be changed by the
+.I select
+operator.
+If the FILEHANDLE is an EXPR, then the expression is evaluated and the
+resulting string is used to look up the name of the FILEHANDLE at run time.
+For more on formats, see the section on formats later on.
+.Sh "Subroutines"
+A subroutine may be declared as follows:
+.nf
+
+    sub NAME BLOCK
+
+.fi
+.PP
+Any arguments passed to the routine come in as array @_,
+that is ($_[0], $_[1], .\|.\|.).
+The return value of the subroutine is the value of the last expression
+evaluated.
+There are no local variables\*(--everything is a global variable.
+.PP
+A subroutine is called using the
+.I do
+operator.
+(CAVEAT: For efficiency reasons recursive subroutine calls are not currently
+supported.
+This restriction may go away in the future.  Then again, it may not.)
+.nf
+
+.ne 12
+Example:
+
+       sub MAX {
+               $max = pop(@_);
+               while ($foo = pop(@_)) {
+                       $max = $foo \|if \|$max < $foo;
+               }
+               $max;
+       }
+
+       .\|.\|.
+       $bestday = do MAX($mon,$tue,$wed,$thu,$fri);
+
+.ne 21
+Example:
+
+       # get a line, combining continuation lines
+       #  that start with whitespace
+       sub get_line {
+               $thisline = $lookahead;
+               line: while ($lookahead = <stdin>) {
+                       if ($lookahead \|=~ \|/\|^[ \^\e\|t]\|/\|) {
+                               $thisline \|.= \|$lookahead;
+                       }
+                       else {
+                               last line;
+                       }
+               }
+               $thisline;
+       }
+
+       $lookahead = <stdin>;   # get first line
+       while ($_ = get_line(\|)) {
+               .\|.\|.
+       }
+
+.fi
+.nf
+.ne 6
+Use array assignment to name your formal arguments:
+
+       sub maybeset {
+               ($key,$value) = @_;
+               $foo{$key} = $value unless $foo{$key};
+       }
+
+.fi
+.Sh "Regular Expressions"
+The patterns used in pattern matching are regular expressions such as
+those used by
+.IR egrep (1).
+In addition, \ew matches an alphanumeric character and \eW a nonalphanumeric.
+Word boundaries may be matched by \eb, and non-boundaries by \eB.
+The bracketing construct \|(\ .\|.\|.\ \|) may also be used, $<digit>
+matches the digit'th substring, where digit can range from 1 to 9.
+(You can also use the old standby \e<digit> in search patterns,
+but $<digit> also works in replacement patterns and in the block controlled
+by the current conditional.)
+$+ returns whatever the last bracket match matched.
+$& returns the entire matched string.
+Up to 10 alternatives may given in a pattern, separated by |, with the
+caveat that \|(\ .\|.\|.\ |\ .\|.\|.\ \|) is illegal.
+Examples:
+.nf
+    
+       s/\|^\|([^ \|]*\|) \|*([^ \|]*\|)\|/\|$2 $1\|/; # swap first two words
+
+.ne 5
+       if (/\|Time: \|(.\|.\|):\|(.\|.\|):\|(.\|.\|)\|/\|) {
+               $hours = $1;
+               $minutes = $2;
+               $seconds = $3;
+       }
+
+.fi
+By default, the ^ character matches only the beginning of the string, and
+.I perl
+does certain optimizations with the assumption that the string contains
+only one line.
+You may, however, wish to treat a string as a multi-line buffer, such that
+the ^ will match after any newline within the string.
+At the cost of a little more overhead, you can do this by setting the variable
+$* to 1.
+Setting it back to 0 makes
+.I perl
+revert to its old behavior.
+.Sh "Formats"
+Output record formats for use with the
+.I write
+operator may declared as follows:
+.nf
+
+.ne 3
+    format NAME =
+    FORMLIST
+    .
+
+.fi
+If name is omitted, format \*(L"stdout\*(R" is defined.
+FORMLIST consists of a sequence of lines, each of which may be of one of three
+types:
+.Ip 1. 4
+A comment.
+.Ip 2. 4
+A \*(L"picture\*(R" line giving the format for one output line.
+.Ip 3. 4
+An argument line supplying values to plug into a picture line.
+.PP
+Picture lines are printed exactly as they look, except for certain fields
+that substitute values into the line.
+Each picture field starts with either @ or ^.
+The @ field (not to be confused with the array marker @) is the normal
+case; ^ fields are used
+to do rudimentary multi-line text block filling.
+The length of the field is supplied by padding out the field
+with multiple <, >, or | characters to specify, respectively, left justfication,
+right justification, or centering.
+If any of the values supplied for these fields contains a newline, only
+the text up to the newline is printed.
+The special field @* can be used for printing multi-line values.
+It should appear by itself on a line.
+.PP
+The values are specified on the following line, in the same order as
+the picture fields.
+They must currently be either string variable names or string literals (or
+pseudo-literals).
+Currently you can separate values with spaces, but commas may be placed
+between values to prepare for possible future versions in which full expressions
+are allowed as values.
+.PP
+Picture fields that begin with ^ rather than @ are treated specially.
+The value supplied must be a string variable name which contains a text
+string.
+.I Perl
+puts as much text as it can into the field, and then chops off the front
+of the string so that the next time the string variable is referenced,
+more of the text can be printed.
+Normally you would use a sequence of fields in a vertical stack to print
+out a block of text.
+If you like, you can end the final field with .\|.\|., which will appear in the
+output if the text was too long to appear in its entirety.
+.PP
+Since use of ^ fields can produce variable length records if the text to be
+formatted is short, you can suppress blank lines by putting the tilde (~)
+character anywhere in the line.
+(Normally you should put it in the front if possible.)
+The tilde will be translated to a space upon output.
+.PP
+Examples:
+.nf
+.lg 0
+.cs R 25
+
+.ne 10
+# a report on the /etc/passwd file
+format top =
+\&                        Passwd File
+Name                Login    Office   Uid   Gid Home
+------------------------------------------------------------------
+\&.
+format stdout =
+@<<<<<<<<<<<<<<<<<< @||||||| @<<<<<<@>>>> @>>>> @<<<<<<<<<<<<<<<<<
+$name               $login   $office $uid $gid  $home
+\&.
+
+.ne 29
+# a report from a bug report form
+format top =
+\&                        Bug Reports
+@<<<<<<<<<<<<<<<<<<<<<<<     @|||         @>>>>>>>>>>>>>>>>>>>>>>>
+$system;                      $%;         $date
+------------------------------------------------------------------
+\&.
+format stdout =
+Subject: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\&         $subject
+Index: @<<<<<<<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\&       $index                        $description
+Priority: @<<<<<<<<<< Date: @<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\&          $priority         $date    $description
+From: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\&      $from                          $description
+Assigned to: @<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\&             $programmer             $description
+\&~                                    ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\&                                     $description
+\&~                                    ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\&                                     $description
+\&~                                    ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\&                                     $description
+\&~                                    ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\&                                     $description
+\&~                                    ^<<<<<<<<<<<<<<<<<<<<<<<...
+\&                                     $description
+\&.
+
+.cs R
+.lg
+It is possible to intermix prints with writes on the same output channel,
+but you'll have to handle $\- (lines left on the page) yourself.
+.fi
+.PP
+If you are printing lots of fields that are usually blank, you should consider
+using the reset operator between records.
+Not only is it more efficient, but it can prevent the bug of adding another
+field and forgetting to zero it.
+.Sh "Predefined Names"
+The following names have special meaning to
+.IR perl .
+I could have used alphabetic symbols for some of these, but I didn't want
+to take the chance that someone would say reset "a-zA-Z" and wipe them all
+out.
+You'll just have to suffer along with these silly symbols.
+Most of them have reasonable mnemonics, or analogues in one of the shells.
+.Ip $_ 8
+The default input and pattern-searching space.
+The following pairs are equivalent:
+.nf
+
+.ne 2
+       while (<>) {\|.\|.\|.   # only equivalent in while!
+       while ($_ = <>) {\|.\|.\|.
+
+.ne 2
+       /\|^Subject:/
+       $_ \|=~ \|/\|^Subject:/
+
+.ne 2
+       y/a-z/A-Z/
+       $_ =~ y/a-z/A-Z/
+
+.ne 2
+       chop
+       chop($_)
+
+.fi 
+(Mnemonic: underline is understood in certain operations.)
+.Ip $. 8
+The current input line number of the last file that was read.
+Readonly.
+(Mnemonic: many programs use . to mean the current line number.)
+.Ip $/ 8
+The input record separator, newline by default.
+Works like awk's RS variable, including treating blank lines as delimiters
+if set to the null string.
+If set to a value longer than one character, only the first character is used.
+(Mnemonic: / is used to delimit line boundaries when quoting poetry.)
+.Ip $, 8
+The output field separator for the print operator.
+Ordinarily the print operator simply prints out the comma separated fields
+you specify.
+In order to get behavior more like awk, set this variable as you would set
+awk's OFS variable to specify what is printed between fields.
+(Mnemonic: what is printed when there is a , in your print statement.)
+.Ip $\e 8
+The output record separator for the print operator.
+Ordinarily the print operator simply prints out the comma separated fields
+you specify, with no trailing newline or record separator assumed.
+In order to get behavior more like awk, set this variable as you would set
+awk's ORS variable to specify what is printed at the end of the print.
+(Mnemonic: you set $\e instead of adding \en at the end of the print.
+Also, it's just like /, but it's what you get \*(L"back\*(R" from perl.)
+.Ip $# 8
+The output format for printed numbers.
+This variable is a half-hearted attempt to emulate awk's OFMT variable.
+There are times, however, when awk and perl have differing notions of what
+is in fact numeric.
+Also, the initial value is %.20g rather than %.6g, so you need to set $#
+explicitly to get awk's value.
+(Mnemonic: # is the number sign.)
+.Ip $% 8
+The current page number of the currently selected output channel.
+(Mnemonic: % is page number in nroff.)
+.Ip $= 8
+The current page length (printable lines) of the currently selected output
+channel.
+Default is 60.
+(Mnemonic: = has horizontal lines.)
+.Ip $\- 8
+The number of lines left on the page of the currently selected output channel.
+(Mnemonic: lines_on_page - lines_printed.)
+.Ip $~ 8
+The name of the current report format for the currently selected output
+channel.
+(Mnemonic: brother to $^.)
+.Ip $^ 8
+The name of the current top-of-page format for the currently selected output
+channel.
+(Mnemonic: points to top of page.)
+.Ip $| 8
+If set to nonzero, forces a flush after every write or print on the currently
+selected output channel.
+Default is 0.
+Note that stdout will typically be line buffered if output is to the
+terminal and block buffered otherwise.
+Setting this variable is useful primarily when you are outputting to a pipe,
+such as when you are running a perl script under rsh and want to see the
+output as it's happening.
+(Mnemonic: when you want your pipes to be piping hot.)
+.Ip $$ 8
+The process number of the
+.I perl
+running this script.
+(Mnemonic: same as shells.)
+.Ip $? 8
+The status returned by the last backtick (``) command.
+(Mnemonic: same as sh and ksh.)
+.Ip $+ 8 4
+The last bracket matched by the last search pattern.
+This is useful if you don't know which of a set of alternative patterns
+matched.
+For example:
+.nf
+
+    /Version: \|(.*\|)|Revision: \|(.*\|)\|/ \|&& \|($rev = $+);
+
+.fi
+(Mnemonic: be positive and forward looking.)
+.Ip $* 8 2
+Set to 1 to do multiline matching within a string, 0 to assume strings contain
+a single line.
+Default is 0.
+(Mnemonic: * matches multiple things.)
+.Ip $0 8
+Contains the name of the file containing the
+.I perl
+script being executed.
+The value should be copied elsewhere before any pattern matching happens, which
+clobbers $0.
+(Mnemonic: same as sh and ksh.)
+.Ip $[ 8 2
+The index of the first element in an array, and of the first character in
+a substring.
+Default is 0, but you could set it to 1 to make
+.I perl
+behave more like
+.I awk
+(or Fortran)
+when subscripting and when evaluating the index() and substr() functions.
+(Mnemonic: [ begins subscripts.)
+.Ip $! 8 2
+The current value of errno, with all the usual caveats.
+(Mnemonic: What just went bang?)
+.Ip @ARGV 8 3
+The array ARGV contains the command line arguments intended for the script.
+Note that $#ARGV is the generally number of arguments minus one, since
+$ARGV[0] is the first argument, NOT the command name.
+See $0 for the command name.
+.Ip $ENV{expr} 8 2
+The associative array ENV contains your current environment.
+Setting a value in ENV changes the environment for child processes.
+.Ip $SIG{expr} 8 2
+The associative array SIG is used to set signal handlers for various signals.
+Example:
+.nf
+
+.ne 12
+       sub handler {   # 1st argument is signal name
+               ($sig) = @_;
+               print "Caught a SIG$sig--shutting down\n";
+               close(log);
+               exit(0);
+       }
+
+       $SIG{'INT'} = 'handler';
+       $SIG{'QUIT'} = 'handler';
+       ...
+       $SIG{'INT'} = 'DEFAULT';        # restore default action
+       $SIG{'QUIT'} = 'IGNORE';        # ignore SIGQUIT
+
+.fi
+.SH ENVIRONMENT
+.I Perl
+currently uses no environment variables, except to make them available
+to the script being executed, and to child processes.
+However, scripts running setuid would do well to execute the following lines
+before doing anything else, just to keep people honest:
+.nf
+
+.ne 3
+    $ENV{'PATH'} = '/bin:/usr/bin';    # or whatever you need
+    $ENV{'SHELL'} = '/bin/sh' if $ENV{'SHELL'};
+    $ENV{'IFS'} = '' if $ENV{'IFS'};
+
+.fi
+.SH AUTHOR
+Larry Wall <lwall@jpl-devvax.Jpl.Nasa.Gov>
+.SH FILES
+/tmp/perl\-eXXXXXX     temporary file for
+.B \-e
+commands.
+.SH SEE ALSO
+a2p    awk to perl translator
+.br
+s2p    sed to perl translator
+.SH DIAGNOSTICS
+Compilation errors will tell you the line number of the error, with an
+indication of the next token or token type that was to be examined.
+(In the case of a script passed to
+.I perl
+via
+.B \-e
+switches, each
+.B \-e
+is counted as one line.)
+.SH TRAPS
+Accustomed awk users should take special note of the following:
+.Ip * 4 2
+Semicolons are required after all simple statements in perl.  Newline
+is not a statement delimiter.
+.Ip * 4 2
+Curly brackets are required on ifs and whiles.
+.Ip * 4 2
+Variables begin with $ or @ in perl.
+.Ip * 4 2
+Arrays index from 0 unless you set $[.
+Likewise string positions in substr() and index().
+.Ip * 4 2
+You have to decide whether your array has numeric or string indices.
+.Ip * 4 2
+You have to decide whether you want to use string or numeric comparisons.
+.Ip * 4 2
+Reading an input line does not split it for you.  You get to split it yourself
+to an array.
+And split has different arguments.
+.Ip * 4 2
+The current input line is normally in $_, not $0.
+It generally does not have the newline stripped.
+($0 is initially the name of the program executed, then the last matched
+string.)
+.Ip * 4 2
+The current filename is $ARGV, not $FILENAME.
+NR, RS, ORS, OFS, and OFMT have equivalents with other symbols.
+FS doesn't have an equivalent, since you have to be explicit about
+split statements.
+.Ip * 4 2
+$<digit> does not refer to fields--it refers to substrings matched by the last
+match pattern.
+.Ip * 4 2
+The print statement does not add field and record separators unless you set
+$, and $\e.
+.Ip * 4 2
+You must open your files before you print to them.
+.Ip * 4 2
+The range operator is \*(L"..\*(R", not comma.
+(The comma operator works as in C.)
+.Ip * 4 2
+The match operator is \*(L"=~\*(R", not \*(L"~\*(R".
+(\*(L"~\*(R" is the one's complement operator.)
+.Ip * 4 2
+The concatenation operator is \*(L".\*(R", not the null string.
+(Using the null string would render \*(L"/pat/ /pat/\*(R" unparseable,
+since the third slash would be interpreted as a division operator\*(--the
+tokener is in fact slightly context sensitive for operators like /, ?, and <.
+And in fact, . itself can be the beginning of a number.)
+.Ip * 4 2
+The \ennn construct in patterns must be given as [\ennn] to avoid interpretation
+as a backreference.
+.Ip * 4 2
+Next, exit, and continue work differently.
+.Ip * 4 2
+When in doubt, run the awk construct through a2p and see what it gives you.
+.PP
+Cerebral C programmers should take note of the following:
+.Ip * 4 2
+Curly brackets are required on ifs and whiles.
+.Ip * 4 2
+You should use \*(L"elsif\*(R" rather than \*(L"else if\*(R"
+.Ip * 4 2
+Break and continue become last and next, respectively.
+.Ip * 4 2
+There's no switch statement.
+.Ip * 4 2
+Variables begin with $ or @ in perl.
+.Ip * 4 2
+Printf does not implement *.
+.Ip * 4 2
+Comments begin with #, not /*.
+.Ip * 4 2
+You can't take the address of anything.
+.Ip * 4 2
+Subroutines are not reentrant.
+.Ip * 4 2
+ARGV must be capitalized.
+.Ip * 4 2
+The \*(L"system\*(R" calls link, unlink, rename, etc. return 1 for success, not 0.
+.Ip * 4 2
+Signal handlers deal with signal names, not numbers.
+.PP
+Seasoned sed programmers should take note of the following:
+.Ip * 4 2
+Backreferences in substitutions use $ rather than \e.
+.Ip * 4 2
+The pattern matching metacharacters (, ), and | do not have backslashes in front.
+.SH BUGS
+.PP
+You can't currently dereference array elements inside a double-quoted string.
+You must assign them to a temporary and interpolate that.
+.PP
+Associative arrays really ought to be first class objects.
+.PP
+Recursive subroutines are not currently supported, due to the way temporary
+values are stored in the syntax tree.
+.PP
+Arrays ought to be passable to subroutines just as strings are.
+.PP
+The array literal consisting of one element is currently misinterpreted, i.e.
+.nf
+
+       @array = (123);
+
+.fi
+doesn't work right.
+.PP
+.I Perl
+actually stands for Pathologically Eclectic Rubbish Lister, but don't tell
+anyone I said that.
+.rn }` ''
diff --git a/perl.y b/perl.y
new file mode 100644 (file)
index 0000000..16f8a9a
--- /dev/null
+++ b/perl.y
@@ -0,0 +1,590 @@
+/* $Header: perl.y,v 1.0 87/12/18 15:48:59 root Exp $
+ *
+ * $Log:       perl.y,v $
+ * Revision 1.0  87/12/18  15:48:59  root
+ * Initial revision
+ * 
+ */
+
+%{
+#include "handy.h"
+#include "EXTERN.h"
+#include "search.h"
+#include "util.h"
+#include "INTERN.h"
+#include "perl.h"
+char *tokename[] = {
+"256",
+"word",
+"append","open","write","select","close","loopctl",
+"using","format","do","shift","push","pop","chop",
+"while","until","if","unless","else","elsif","continue","split","sprintf",
+"for", "eof", "tell", "seek", "stat",
+"function(no args)","function(1 arg)","function(2 args)","function(3 args)","array function",
+"join", "sub",
+"format lines",
+"register","array_length", "array",
+"s","pattern",
+"string","y",
+"print", "unary operation",
+"..",
+"||",
+"&&",
+"==","!=", "EQ", "NE",
+"<=",">=", "LT", "GT", "LE", "GE",
+"<<",">>",
+"=~","!~",
+"unary -",
+"++", "--",
+"???"
+};
+
+%}
+
+%start prog
+
+%union {
+    int        ival;
+    char *cval;
+    ARG *arg;
+    CMD *cmdval;
+    struct compcmd compval;
+    STAB *stabval;
+    FCMD *formval;
+}
+
+%token <cval> WORD
+%token <ival> APPEND OPEN WRITE SELECT CLOSE LOOPEX
+%token <ival> USING FORMAT DO SHIFT PUSH POP CHOP
+%token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT SPRINTF
+%token <ival> FOR FEOF TELL SEEK STAT 
+%token <ival> FUNC0 FUNC1 FUNC2 FUNC3 STABFUN
+%token <ival> JOIN SUB
+%token <formval> FORMLIST
+%token <stabval> REG ARYLEN ARY
+%token <arg> SUBST PATTERN
+%token <arg> RSTRING TRANS
+
+%type <ival> prog decl format
+%type <stabval>
+%type <cmdval> block lineseq line loop cond sideff nexpr else
+%type <arg> expr sexpr term
+%type <arg> condmod loopmod cexpr
+%type <arg> texpr print
+%type <cval> label
+%type <compval> compblock
+
+%nonassoc <ival> PRINT
+%left ','
+%nonassoc <ival> UNIOP
+%right '='
+%right '?' ':'
+%nonassoc DOTDOT
+%left OROR
+%left ANDAND
+%left '|' '^'
+%left '&'
+%nonassoc EQ NE SEQ SNE
+%nonassoc '<' '>' LE GE SLT SGT SLE SGE
+%left LS RS
+%left '+' '-' '.'
+%left '*' '/' '%' 'x'
+%left MATCH NMATCH 
+%right '!' '~' UMINUS
+%nonassoc INC DEC
+%left '('
+
+%% /* RULES */
+
+prog   :       lineseq
+                       { main_root = block_head($1); }
+       ;
+
+compblock:     block CONTINUE block
+                       { $$.comp_true = $1; $$.comp_alt = $3; }
+       |       block else
+                       { $$.comp_true = $1; $$.comp_alt = $2; }
+       ;
+
+else   :       /* NULL */
+                       { $$ = Nullcmd; }
+       |       ELSE block
+                       { $$ = $2; }
+       |       ELSIF '(' expr ')' compblock
+                       { $$ = make_ccmd(C_IF,$3,$5); }
+       ;
+
+block  :       '{' lineseq '}'
+                       { $$ = block_head($2); }
+       ;
+
+lineseq        :       /* NULL */
+                       { $$ = Nullcmd; }
+       |       lineseq line
+                       { $$ = append_line($1,$2); }
+       ;
+
+line   :       decl
+                       { $$ = Nullcmd; }
+       |       label cond
+                       { $$ = add_label($1,$2); }
+       |       loop    /* loops add their own labels */
+       |       label ';'
+                       { if ($1 != Nullch) {
+                             $$ = add_label(make_acmd(C_EXPR, Nullstab,
+                                 Nullarg, Nullarg) );
+                           } else
+                             $$ = Nullcmd; }
+       |       label sideff ';'
+                       { $$ = add_label($1,$2); }
+       ;
+
+sideff :       expr
+                       { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
+       |       expr condmod
+                       { $$ = addcond(
+                              make_acmd(C_EXPR, Nullstab, Nullarg, $1), $2); }
+       |       expr loopmod
+                       { $$ = addloop(
+                              make_acmd(C_EXPR, Nullstab, Nullarg, $1), $2); }
+       ;
+
+cond   :       IF '(' expr ')' compblock
+                       { $$ = make_ccmd(C_IF,$3,$5); }
+       |       UNLESS '(' expr ')' compblock
+                       { $$ = invert(make_ccmd(C_IF,$3,$5)); }
+       |       IF block compblock
+                       { $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
+       |       UNLESS block compblock
+                       { $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
+       ;
+
+loop   :       label WHILE '(' texpr ')' compblock
+                       { $$ = wopt(add_label($1,
+                           make_ccmd(C_WHILE,$4,$6) )); }
+       |       label UNTIL '(' expr ')' compblock
+                       { $$ = wopt(add_label($1,
+                           invert(make_ccmd(C_WHILE,$4,$6)) )); }
+       |       label WHILE block compblock
+                       { $$ = wopt(add_label($1,
+                           make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); }
+       |       label UNTIL block compblock
+                       { $$ = wopt(add_label($1,
+                           invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
+       |       label FOR '(' nexpr ';' texpr ';' nexpr ')' block
+                       /* basically fake up an initialize-while lineseq */
+                       {   yyval.compval.comp_true = $10;
+                           yyval.compval.comp_alt = $8;
+                           $$ = append_line($4,wopt(add_label($1,
+                               make_ccmd(C_WHILE,$6,yyval.compval) ))); }
+       |       label compblock /* a block is a loop that happens once */
+                       { $$ = add_label($1,make_ccmd(C_BLOCK,Nullarg,$2)); }
+       ;
+
+nexpr  :       /* NULL */
+                       { $$ = Nullcmd; }
+       |       sideff
+       ;
+
+texpr  :       /* NULL means true */
+                       {   scanstr("1"); $$ = yylval.arg; }
+       |       expr
+       ;
+
+label  :       /* empty */
+                       { $$ = Nullch; }
+       |       WORD ':'
+       ;
+
+loopmod :      WHILE expr
+                       { $$ = $2; }
+       |       UNTIL expr
+                       { $$ = make_op(O_NOT,1,$2,Nullarg,Nullarg,0); }
+       ;
+
+condmod :      IF expr
+                       { $$ = $2; }
+       |       UNLESS expr
+                       { $$ = make_op(O_NOT,1,$2,Nullarg,Nullarg,0); }
+       ;
+
+decl   :       format
+                       { $$ = 0; }
+       |       subrout
+                       { $$ = 0; }
+       ;
+
+format :       FORMAT WORD '=' FORMLIST '.' 
+                       { stabent($2,TRUE)->stab_form = $4; safefree($2); }
+       |       FORMAT '=' FORMLIST '.'
+                       { stabent("stdout",TRUE)->stab_form = $3; }
+       ;
+
+subrout        :       SUB WORD block
+                       { stabent($2,TRUE)->stab_sub = $3; }
+       ;
+
+expr   :       print
+       |       cexpr
+       ;
+
+cexpr  :       sexpr ',' cexpr
+                       { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg,0); }
+       |       sexpr
+       ;
+
+sexpr  :       sexpr '=' sexpr
+                       {   $1 = listish($1);
+                           if ($1->arg_type == O_LIST)
+                               $3 = listish($3);
+                           $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg,1)); }
+       |       sexpr '*' '=' sexpr
+                       { $$ = l(make_op(O_MULTIPLY, 2, $1, $4, Nullarg,0)); }
+       |       sexpr '/' '=' sexpr
+                       { $$ = l(make_op(O_DIVIDE, 2, $1, $4, Nullarg,0)); }
+       |       sexpr '%' '=' sexpr
+                       { $$ = l(make_op(O_MODULO, 2, $1, $4, Nullarg,0)); }
+       |       sexpr 'x' '=' sexpr
+                       { $$ = l(make_op(O_REPEAT, 2, $1, $4, Nullarg,0)); }
+       |       sexpr '+' '=' sexpr
+                       { $$ = l(make_op(O_ADD, 2, $1, $4, Nullarg,0)); }
+       |       sexpr '-' '=' sexpr
+                       { $$ = l(make_op(O_SUBTRACT, 2, $1, $4, Nullarg,0)); }
+       |       sexpr LS '=' sexpr
+                       { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg,0)); }
+       |       sexpr RS '=' sexpr
+                       { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg,0)); }
+       |       sexpr '&' '=' sexpr
+                       { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg,0)); }
+       |       sexpr '^' '=' sexpr
+                       { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg,0)); }
+       |       sexpr '|' '=' sexpr
+                       { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg,0)); }
+       |       sexpr '.' '=' sexpr
+                       { $$ = l(make_op(O_CONCAT, 2, $1, $4, Nullarg,0)); }
+
+
+       |       sexpr '*' sexpr
+                       { $$ = make_op(O_MULTIPLY, 2, $1, $3, Nullarg,0); }
+       |       sexpr '/' sexpr
+                       { $$ = make_op(O_DIVIDE, 2, $1, $3, Nullarg,0); }
+       |       sexpr '%' sexpr
+                       { $$ = make_op(O_MODULO, 2, $1, $3, Nullarg,0); }
+       |       sexpr 'x' sexpr
+                       { $$ = make_op(O_REPEAT, 2, $1, $3, Nullarg,0); }
+       |       sexpr '+' sexpr
+                       { $$ = make_op(O_ADD, 2, $1, $3, Nullarg,0); }
+       |       sexpr '-' sexpr
+                       { $$ = make_op(O_SUBTRACT, 2, $1, $3, Nullarg,0); }
+       |       sexpr LS sexpr
+                       { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg,0); }
+       |       sexpr RS sexpr
+                       { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg,0); }
+       |       sexpr '<' sexpr
+                       { $$ = make_op(O_LT, 2, $1, $3, Nullarg,0); }
+       |       sexpr '>' sexpr
+                       { $$ = make_op(O_GT, 2, $1, $3, Nullarg,0); }
+       |       sexpr LE sexpr
+                       { $$ = make_op(O_LE, 2, $1, $3, Nullarg,0); }
+       |       sexpr GE sexpr
+                       { $$ = make_op(O_GE, 2, $1, $3, Nullarg,0); }
+       |       sexpr EQ sexpr
+                       { $$ = make_op(O_EQ, 2, $1, $3, Nullarg,0); }
+       |       sexpr NE sexpr
+                       { $$ = make_op(O_NE, 2, $1, $3, Nullarg,0); }
+       |       sexpr SLT sexpr
+                       { $$ = make_op(O_SLT, 2, $1, $3, Nullarg,0); }
+       |       sexpr SGT sexpr
+                       { $$ = make_op(O_SGT, 2, $1, $3, Nullarg,0); }
+       |       sexpr SLE sexpr
+                       { $$ = make_op(O_SLE, 2, $1, $3, Nullarg,0); }
+       |       sexpr SGE sexpr
+                       { $$ = make_op(O_SGE, 2, $1, $3, Nullarg,0); }
+       |       sexpr SEQ sexpr
+                       { $$ = make_op(O_SEQ, 2, $1, $3, Nullarg,0); }
+       |       sexpr SNE sexpr
+                       { $$ = make_op(O_SNE, 2, $1, $3, Nullarg,0); }
+       |       sexpr '&' sexpr
+                       { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg,0); }
+       |       sexpr '^' sexpr
+                       { $$ = make_op(O_XOR, 2, $1, $3, Nullarg,0); }
+       |       sexpr '|' sexpr
+                       { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg,0); }
+       |       sexpr DOTDOT sexpr
+                       { $$ = make_op(O_FLIP, 4,
+                           flipflip($1),
+                           flipflip($3),
+                           Nullarg,0);}
+       |       sexpr ANDAND sexpr
+                       { $$ = make_op(O_AND, 2, $1, $3, Nullarg,0); }
+       |       sexpr OROR sexpr
+                       { $$ = make_op(O_OR, 2, $1, $3, Nullarg,0); }
+       |       sexpr '?' sexpr ':' sexpr
+                       { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5,0); }
+       |       sexpr '.' sexpr
+                       { $$ = make_op(O_CONCAT, 2, $1, $3, Nullarg,0); }
+       |       sexpr MATCH sexpr
+                       { $$ = mod_match(O_MATCH, $1, $3); }
+       |       sexpr NMATCH sexpr
+                       { $$ = mod_match(O_NMATCH, $1, $3); }
+       |       term INC
+                       { $$ = addflags(1, AF_POST|AF_UP,
+                           l(make_op(O_ITEM,1,$1,Nullarg,Nullarg,0))); }
+       |       term DEC
+                       { $$ = addflags(1, AF_POST,
+                           l(make_op(O_ITEM,1,$1,Nullarg,Nullarg,0))); }
+       |       INC term
+                       { $$ = addflags(1, AF_PRE|AF_UP,
+                           l(make_op(O_ITEM,1,$2,Nullarg,Nullarg,0))); }
+       |       DEC term
+                       { $$ = addflags(1, AF_PRE,
+                           l(make_op(O_ITEM,1,$2,Nullarg,Nullarg,0))); }
+       |       term
+                       { $$ = $1; }
+       ;
+
+term   :       '-' term %prec UMINUS
+                       { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg,0); }
+       |       '!' term
+                       { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg,0); }
+       |       '~' term
+                       { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg,0);}
+       |       '(' expr ')'
+                       { $$ = make_list(hide_ary($2)); }
+       |       '(' ')'
+                       { $$ = make_list(Nullarg); }
+       |       DO block        %prec '('
+                       { $$ = cmd_to_arg($2); }
+       |       REG     %prec '('
+                       { $$ = stab_to_arg(A_STAB,$1); }
+       |       REG '[' expr ']'        %prec '('
+                       { $$ = make_op(O_ARRAY, 2,
+                               $3, stab_to_arg(A_STAB,aadd($1)), Nullarg,0); }
+       |       ARY     %prec '('
+                       { $$ = make_op(O_ARRAY, 1,
+                               stab_to_arg(A_STAB,$1),
+                               Nullarg, Nullarg, 1); }
+       |       REG '{' expr '}'        %prec '('
+                       { $$ = make_op(O_HASH, 2,
+                               $3, stab_to_arg(A_STAB,hadd($1)), Nullarg,0); }
+       |       ARYLEN  %prec '('
+                       { $$ = stab_to_arg(A_ARYLEN,$1); }
+       |       RSTRING %prec '('
+                       { $$ = $1; }
+       |       PATTERN %prec '('
+                       { $$ = $1; }
+       |       SUBST   %prec '('
+                       { $$ = $1; }
+       |       TRANS   %prec '('
+                       { $$ = $1; }
+       |       DO WORD '(' expr ')'
+                       { $$ = make_op(O_SUBR, 2,
+                               make_list($4),
+                               stab_to_arg(A_STAB,stabent($2,TRUE)),
+                               Nullarg,1); }
+       |       DO WORD '(' ')'
+                       { $$ = make_op(O_SUBR, 2,
+                               make_list(Nullarg),
+                               stab_to_arg(A_STAB,stabent($2,TRUE)),
+                               Nullarg,1); }
+       |       LOOPEX
+                       { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg,0); }
+       |       LOOPEX WORD
+                       { $$ = make_op($1,1,cval_to_arg($2),
+                           Nullarg,Nullarg,0); }
+       |       UNIOP
+                       { $$ = make_op($1,1,Nullarg,Nullarg,Nullarg,0); }
+       |       UNIOP sexpr
+                       { $$ = make_op($1,1,$2,Nullarg,Nullarg,0); }
+       |       WRITE
+                       { $$ = make_op(O_WRITE, 0,
+                           Nullarg, Nullarg, Nullarg,0); }
+       |       WRITE '(' ')'
+                       { $$ = make_op(O_WRITE, 0,
+                           Nullarg, Nullarg, Nullarg,0); }
+       |       WRITE '(' WORD ')'
+                       { $$ = l(make_op(O_WRITE, 1,
+                           stab_to_arg(A_STAB,stabent($3,TRUE)),
+                           Nullarg, Nullarg,0)); safefree($3); }
+       |       WRITE '(' expr ')'
+                       { $$ = make_op(O_WRITE, 1, $3, Nullarg, Nullarg,0); }
+       |       SELECT '(' WORD ')'
+                       { $$ = l(make_op(O_SELECT, 1,
+                           stab_to_arg(A_STAB,stabent($3,TRUE)),
+                           Nullarg, Nullarg,0)); safefree($3); }
+       |       SELECT '(' expr ')'
+                       { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg,0); }
+       |       OPEN WORD       %prec '('
+                       { $$ = make_op(O_OPEN, 2,
+                           stab_to_arg(A_STAB,stabent($2,TRUE)),
+                           stab_to_arg(A_STAB,stabent($2,TRUE)),
+                           Nullarg,0); }
+       |       OPEN '(' WORD ')'
+                       { $$ = make_op(O_OPEN, 2,
+                           stab_to_arg(A_STAB,stabent($3,TRUE)),
+                           stab_to_arg(A_STAB,stabent($3,TRUE)),
+                           Nullarg,0); }
+       |       OPEN '(' WORD ',' expr ')'
+                       { $$ = make_op(O_OPEN, 2,
+                           stab_to_arg(A_STAB,stabent($3,TRUE)),
+                           $5, Nullarg,0); }
+       |       CLOSE '(' WORD ')'
+                       { $$ = make_op(O_CLOSE, 1,
+                           stab_to_arg(A_STAB,stabent($3,TRUE)),
+                           Nullarg, Nullarg,0); }
+       |       CLOSE WORD      %prec '('
+                       { $$ = make_op(O_CLOSE, 1,
+                           stab_to_arg(A_STAB,stabent($2,TRUE)),
+                           Nullarg, Nullarg,0); }
+       |       FEOF '(' WORD ')'
+                       { $$ = make_op(O_EOF, 1,
+                           stab_to_arg(A_STAB,stabent($3,TRUE)),
+                           Nullarg, Nullarg,0); }
+       |       FEOF '(' ')'
+                       { $$ = make_op(O_EOF, 0,
+                           stab_to_arg(A_STAB,stabent("ARGV",TRUE)),
+                           Nullarg, Nullarg,0); }
+       |       FEOF
+                       { $$ = make_op(O_EOF, 0,
+                           Nullarg, Nullarg, Nullarg,0); }
+       |       TELL '(' WORD ')'
+                       { $$ = make_op(O_TELL, 1,
+                           stab_to_arg(A_STAB,stabent($3,TRUE)),
+                           Nullarg, Nullarg,0); }
+       |       TELL
+                       { $$ = make_op(O_TELL, 0,
+                           Nullarg, Nullarg, Nullarg,0); }
+       |       SEEK '(' WORD ',' sexpr ',' expr ')'
+                       { $$ = make_op(O_SEEK, 3,
+                           stab_to_arg(A_STAB,stabent($3,TRUE)),
+                           $5, $7,1); }
+       |       PUSH '(' WORD ',' expr ')'
+                       { $$ = make_op($1, 2,
+                           make_list($5),
+                           stab_to_arg(A_STAB,aadd(stabent($3,TRUE))),
+                           Nullarg,1); }
+       |       PUSH '(' ARY ',' expr ')'
+                       { $$ = make_op($1, 2,
+                           make_list($5),
+                           stab_to_arg(A_STAB,$3),
+                           Nullarg,1); }
+       |       POP WORD        %prec '('
+                       { $$ = make_op(O_POP, 1,
+                           stab_to_arg(A_STAB,aadd(stabent($2,TRUE))),
+                           Nullarg, Nullarg,0); }
+       |       POP '(' WORD ')'
+                       { $$ = make_op(O_POP, 1,
+                           stab_to_arg(A_STAB,aadd(stabent($3,TRUE))),
+                           Nullarg, Nullarg,0); }
+       |       POP ARY %prec '('
+                       { $$ = make_op(O_POP, 1,
+                           stab_to_arg(A_STAB,$2),
+                           Nullarg,
+                           Nullarg,
+                           0); }
+       |       POP '(' ARY ')'
+                       { $$ = make_op(O_POP, 1,
+                           stab_to_arg(A_STAB,$3),
+                           Nullarg,
+                           Nullarg,
+                           0); }
+       |       SHIFT WORD      %prec '('
+                       { $$ = make_op(O_SHIFT, 1,
+                           stab_to_arg(A_STAB,aadd(stabent($2,TRUE))),
+                           Nullarg, Nullarg,0); }
+       |       SHIFT '(' WORD ')'
+                       { $$ = make_op(O_SHIFT, 1,
+                           stab_to_arg(A_STAB,aadd(stabent($3,TRUE))),
+                           Nullarg, Nullarg,0); }
+       |       SHIFT ARY       %prec '('
+                       { $$ = make_op(O_SHIFT, 1,
+                           stab_to_arg(A_STAB,$2), Nullarg, Nullarg,0); }
+       |       SHIFT '(' ARY ')'
+                       { $$ = make_op(O_SHIFT, 1,
+                           stab_to_arg(A_STAB,$3), Nullarg, Nullarg,0); }
+       |       SHIFT   %prec '('
+                       { $$ = make_op(O_SHIFT, 1,
+                           stab_to_arg(A_STAB,aadd(stabent("ARGV",TRUE))),
+                           Nullarg, Nullarg,0); }
+       |       SPLIT   %prec '('
+                       { scanpat("/[ \t\n]+/");
+                           $$ = make_split(defstab,yylval.arg); }
+       |       SPLIT '(' WORD ')'
+                       { scanpat("/[ \t\n]+/");
+                           $$ = make_split(stabent($3,TRUE),yylval.arg); }
+       |       SPLIT '(' WORD ',' PATTERN ')'
+                       { $$ = make_split(stabent($3,TRUE),$5); }
+       |       SPLIT '(' WORD ',' PATTERN ',' sexpr ')'
+                       { $$ = mod_match(O_MATCH,
+                           $7,
+                           make_split(stabent($3,TRUE),$5) ); }
+       |       SPLIT '(' sexpr ',' sexpr ')'
+                       { $$ = mod_match(O_MATCH, $5, make_split(defstab,$3) ); }
+       |       SPLIT '(' sexpr ')'
+                       { $$ = mod_match(O_MATCH,
+                           stab_to_arg(A_STAB,defstab),
+                           make_split(defstab,$3) ); }
+       |       JOIN '(' WORD ',' expr ')'
+                       { $$ = make_op(O_JOIN, 2,
+                           $5,
+                           stab_to_arg(A_STAB,aadd(stabent($3,TRUE))),
+                           Nullarg,0); }
+       |       JOIN '(' sexpr ',' expr ')'
+                       { $$ = make_op(O_JOIN, 2,
+                           $3,
+                           make_list($5),
+                           Nullarg,2); }
+       |       SPRINTF '(' expr ')'
+                       { $$ = make_op(O_SPRINTF, 1,
+                           make_list($3),
+                           Nullarg,
+                           Nullarg,1); }
+       |       STAT '(' WORD ')'
+                       { $$ = l(make_op(O_STAT, 1,
+                           stab_to_arg(A_STAB,stabent($3,TRUE)),
+                           Nullarg, Nullarg,0)); }
+       |       STAT '(' expr ')'
+                       { $$ = make_op(O_STAT, 1, $3, Nullarg, Nullarg,0); }
+       |       CHOP
+                       { $$ = l(make_op(O_CHOP, 1,
+                           stab_to_arg(A_STAB,defstab),
+                           Nullarg, Nullarg,0)); }
+       |       CHOP '(' expr ')'
+                       { $$ = l(make_op(O_CHOP, 1, $3, Nullarg, Nullarg,0)); }
+       |       FUNC0
+                       { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg,0); }
+       |       FUNC1 '(' expr ')'
+                       { $$ = make_op($1, 1, $3, Nullarg, Nullarg,0); }
+       |       FUNC2 '(' sexpr ',' expr ')'
+                       { $$ = make_op($1, 2, $3, $5, Nullarg, 0); }
+       |       FUNC3 '(' sexpr ',' sexpr ',' expr ')'
+                       { $$ = make_op($1, 3, $3, $5, $7, 0); }
+       |       STABFUN '(' WORD ')'
+                       { $$ = make_op($1, 1,
+                               stab_to_arg(A_STAB,hadd(stabent($3,TRUE))),
+                               Nullarg,
+                               Nullarg, 0); }
+       ;
+
+print  :       PRINT
+                       { $$ = make_op($1,2,
+                               stab_to_arg(A_STAB,defstab),
+                               stab_to_arg(A_STAB,Nullstab),
+                               Nullarg,0); }
+       |       PRINT expr
+                       { $$ = make_op($1,2,make_list($2),
+                               stab_to_arg(A_STAB,Nullstab),
+                               Nullarg,1); }
+       |       PRINT WORD
+                       { $$ = make_op($1,2,
+                               stab_to_arg(A_STAB,defstab),
+                               stab_to_arg(A_STAB,stabent($2,TRUE)),
+                               Nullarg,1); }
+       |       PRINT WORD expr
+                       { $$ = make_op($1,2,make_list($3),
+                               stab_to_arg(A_STAB,stabent($2,TRUE)),
+                               Nullarg,1); }
+       ;
+
+%% /* PROGRAM */
+#include "perly.c"
diff --git a/perly.c b/perly.c
new file mode 100644 (file)
index 0000000..bc32318
--- /dev/null
+++ b/perly.c
@@ -0,0 +1,2460 @@
+char rcsid[] = "$Header: perly.c,v 1.0 87/12/18 15:53:31 root Exp $";
+/*
+ * $Log:       perly.c,v $
+ * Revision 1.0  87/12/18  15:53:31  root
+ * Initial revision
+ * 
+ */
+
+bool preprocess = FALSE;
+bool assume_n = FALSE;
+bool assume_p = FALSE;
+bool doswitches = FALSE;
+char *filename;
+char *e_tmpname = "/tmp/perl-eXXXXXX";
+FILE *e_fp = Nullfp;
+ARG *l();
+
+main(argc,argv,env)
+register int argc;
+register char **argv;
+register char **env;
+{
+    register STR *str;
+    register char *s;
+    char *index();
+
+    linestr = str_new(80);
+    str = str_make("-I/usr/lib/perl ");        /* first used for -I flags */
+    for (argc--,argv++; argc; argc--,argv++) {
+       if (argv[0][0] != '-' || !argv[0][1])
+           break;
+      reswitch:
+       switch (argv[0][1]) {
+#ifdef DEBUGGING
+       case 'D':
+           debug = atoi(argv[0]+2);
+#ifdef YYDEBUG
+           yydebug = (debug & 1);
+#endif
+           break;
+#endif
+       case 'e':
+           if (!e_fp) {
+               mktemp(e_tmpname);
+               e_fp = fopen(e_tmpname,"w");
+           }
+           if (argv[1])
+               fputs(argv[1],e_fp);
+           putc('\n', e_fp);
+           argc--,argv++;
+           break;
+       case 'i':
+           inplace = savestr(argv[0]+2);
+           argvoutstab = stabent("ARGVOUT",TRUE);
+           break;
+       case 'I':
+           str_cat(str,argv[0]);
+           str_cat(str," ");
+           if (!argv[0][2]) {
+               str_cat(str,argv[1]);
+               argc--,argv++;
+               str_cat(str," ");
+           }
+           break;
+       case 'n':
+           assume_n = TRUE;
+           strcpy(argv[0], argv[0]+1);
+           goto reswitch;
+       case 'p':
+           assume_p = TRUE;
+           strcpy(argv[0], argv[0]+1);
+           goto reswitch;
+       case 'P':
+           preprocess = TRUE;
+           strcpy(argv[0], argv[0]+1);
+           goto reswitch;
+       case 's':
+           doswitches = TRUE;
+           strcpy(argv[0], argv[0]+1);
+           goto reswitch;
+       case 'v':
+           version();
+           exit(0);
+       case '-':
+           argc--,argv++;
+           goto switch_end;
+       case 0:
+           break;
+       default:
+           fatal("Unrecognized switch: %s\n",argv[0]);
+       }
+    }
+  switch_end:
+    if (e_fp) {
+       fclose(e_fp);
+       argc++,argv--;
+       argv[0] = e_tmpname;
+    }
+
+    str_set(&str_no,No);
+    str_set(&str_yes,Yes);
+    init_eval();
+
+    /* open script */
+
+    if (argv[0] == Nullch)
+       argv[0] = "-";
+    filename = savestr(argv[0]);
+    if (strEQ(filename,"-"))
+       argv[0] = "";
+    if (preprocess) {
+       sprintf(buf, "\
+/bin/sed -e '/^[^#]/b' \
+ -e '/^#[      ]*include[      ]/b' \
+ -e '/^#[      ]*define[       ]/b' \
+ -e '/^#[      ]*if[   ]/b' \
+ -e '/^#[      ]*ifdef[        ]/b' \
+ -e '/^#[      ]*else/b' \
+ -e '/^#[      ]*endif/b' \
+ -e 's/^#.*//' \
+ %s | /lib/cpp -C %s-",
+         argv[0], str_get(str));
+       rsfp = popen(buf,"r");
+    }
+    else if (!*argv[0])
+       rsfp = stdin;
+    else
+       rsfp = fopen(argv[0],"r");
+    if (rsfp == Nullfp)
+       fatal("Perl script \"%s\" doesn't seem to exist.\n",filename);
+    str_free(str);             /* free -I directories */
+
+    defstab = stabent("_",TRUE);
+
+    /* init tokener */
+
+    bufptr = str_get(linestr);
+
+    /* now parse the report spec */
+
+    if (yyparse())
+       fatal("Execution aborted due to compilation errors.\n");
+
+    if (e_fp) {
+       e_fp = Nullfp;
+       UNLINK(e_tmpname);
+    }
+    argc--,argv++;     /* skip name of script */
+    if (doswitches) {
+       for (; argc > 0 && **argv == '-'; argc--,argv++) {
+           if (argv[0][1] == '-') {
+               argc--,argv++;
+               break;
+           }
+           str_numset(stabent(argv[0]+1,TRUE)->stab_val,(double)1.0);
+       }
+    }
+    if (argvstab = stabent("ARGV",FALSE)) {
+       for (; argc > 0; argc--,argv++) {
+           apush(argvstab->stab_array,str_make(argv[0]));
+       }
+    }
+    if (envstab = stabent("ENV",FALSE)) {
+       for (; *env; env++) {
+           if (!(s = index(*env,'=')))
+               continue;
+           *s++ = '\0';
+           str = str_make(s);
+           str->str_link.str_magic = envstab;
+           hstore(envstab->stab_hash,*env,str);
+           *--s = '=';
+       }
+    }
+    sigstab = stabent("SIG",FALSE);
+
+    magicalize("!#?^~=-%0123456789.+&*(),\\/[|");
+
+    (tmpstab = stabent("0",FALSE)) && str_set(STAB_STR(tmpstab),filename);
+    (tmpstab = stabent("$",FALSE)) &&
+       str_numset(STAB_STR(tmpstab),(double)getpid());
+
+    tmpstab = stabent("stdin",TRUE);
+    tmpstab->stab_io = stio_new();
+    tmpstab->stab_io->fp = stdin;
+
+    tmpstab = stabent("stdout",TRUE);
+    tmpstab->stab_io = stio_new();
+    tmpstab->stab_io->fp = stdout;
+    defoutstab = tmpstab;
+    curoutstab = tmpstab;
+
+    tmpstab = stabent("stderr",TRUE);
+    tmpstab->stab_io = stio_new();
+    tmpstab->stab_io->fp = stderr;
+
+    setjmp(top_env);   /* sets goto_targ on longjump */
+
+#ifdef DEBUGGING
+    if (debug & 1024)
+       dump_cmd(main_root,Nullcmd);
+    if (debug)
+       fprintf(stderr,"\nEXECUTING...\n\n");
+#endif
+
+    /* do it */
+
+    (void) cmd_exec(main_root);
+
+    if (goto_targ)
+       fatal("Can't find label \"%s\"--aborting.\n",goto_targ);
+    exit(0);
+}
+
+magicalize(list)
+register char *list;
+{
+    register STAB *stab;
+    char sym[2];
+
+    sym[1] = '\0';
+    while (*sym = *list++) {
+       if (stab = stabent(sym,FALSE)) {
+           stab->stab_flags = SF_VMAGIC;
+           stab->stab_val->str_link.str_magic = stab;
+       }
+    }
+}
+
+#define RETURN(retval) return (bufptr = s,retval)
+#define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,retval)
+#define TERM(retval) return (expectterm = FALSE,bufptr = s,retval)
+#define LOOPX(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,LOOPEX)
+#define UNI(f) return (yylval.ival = f,expectterm = TRUE,bufptr = s,UNIOP)
+#define FUN0(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC0)
+#define FUN1(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC1)
+#define FUN2(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC2)
+#define FUN3(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC3)
+#define SFUN(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,STABFUN)
+
+yylex()
+{
+    register char *s = bufptr;
+    register char *d;
+    register int tmp;
+    static bool in_format = FALSE;
+    static bool firstline = TRUE;
+
+  retry:
+#ifdef YYDEBUG
+    if (yydebug)
+       if (index(s,'\n'))
+           fprintf(stderr,"Tokener at %s",s);
+       else
+           fprintf(stderr,"Tokener at %s\n",s);
+#endif
+    switch (*s) {
+    default:
+       fprintf(stderr,
+           "Unrecognized character %c in file %s line %d--ignoring.\n",
+            *s++,filename,line);
+       goto retry;
+    case 0:
+       s = str_get(linestr);
+       *s = '\0';
+       if (firstline && (assume_n || assume_p)) {
+           firstline = FALSE;
+           str_set(linestr,"while (<>) {");
+           s = str_get(linestr);
+           goto retry;
+       }
+       if (!rsfp)
+           RETURN(0);
+       if (in_format) {
+           yylval.formval = load_format();     /* leaves . in buffer */
+           in_format = FALSE;
+           s = str_get(linestr);
+           TERM(FORMLIST);
+       }
+       line++;
+       if ((s = str_gets(linestr, rsfp)) == Nullch) {
+           if (preprocess)
+               pclose(rsfp);
+           else if (rsfp != stdin)
+               fclose(rsfp);
+           rsfp = Nullfp;
+           if (assume_n || assume_p) {
+               str_set(linestr,assume_p ? "}continue{print;" : "");
+               str_cat(linestr,"}");
+               s = str_get(linestr);
+               goto retry;
+           }
+           s = str_get(linestr);
+           RETURN(0);
+       }
+#ifdef DEBUG
+       else if (firstline) {
+           char *showinput();
+           s = showinput();
+       }
+#endif
+       firstline = FALSE;
+       goto retry;
+    case ' ': case '\t':
+       s++;
+       goto retry;
+    case '\n':
+    case '#':
+       if (preprocess && s == str_get(linestr) &&
+              s[1] == ' ' && isdigit(s[2])) {
+           line = atoi(s+2)-1;
+           for (s += 2; isdigit(*s); s++) ;
+           while (*s && isspace(*s)) s++;
+           if (filename)
+               safefree(filename);
+           s[strlen(s)-1] = '\0';      /* wipe out newline */
+           filename = savestr(s);
+           s = str_get(linestr);
+       }
+       *s = '\0';
+       if (lex_newlines)
+           RETURN('\n');
+       goto retry;
+    case '+':
+    case '-':
+       if (s[1] == *s) {
+           s++;
+           if (*s++ == '+')
+               RETURN(INC);
+           else
+               RETURN(DEC);
+       }
+       /* FALL THROUGH */
+    case '*':
+    case '%':
+    case '^':
+    case '~':
+    case '(':
+    case ',':
+    case ':':
+    case ';':
+    case '{':
+    case '[':
+       tmp = *s++;
+       OPERATOR(tmp);
+    case ')':
+    case ']':
+    case '}':
+       tmp = *s++;
+       TERM(tmp);
+    case '&':
+       s++;
+       tmp = *s++;
+       if (tmp == '&')
+           OPERATOR(ANDAND);
+       s--;
+       OPERATOR('&');
+    case '|':
+       s++;
+       tmp = *s++;
+       if (tmp == '|')
+           OPERATOR(OROR);
+       s--;
+       OPERATOR('|');
+    case '=':
+       s++;
+       tmp = *s++;
+       if (tmp == '=')
+           OPERATOR(EQ);
+       if (tmp == '~')
+           OPERATOR(MATCH);
+       s--;
+       OPERATOR('=');
+    case '!':
+       s++;
+       tmp = *s++;
+       if (tmp == '=')
+           OPERATOR(NE);
+       if (tmp == '~')
+           OPERATOR(NMATCH);
+       s--;
+       OPERATOR('!');
+    case '<':
+       if (expectterm) {
+           s = scanstr(s);
+           TERM(RSTRING);
+       }
+       s++;
+       tmp = *s++;
+       if (tmp == '<')
+           OPERATOR(LS);
+       if (tmp == '=')
+           OPERATOR(LE);
+       s--;
+       OPERATOR('<');
+    case '>':
+       s++;
+       tmp = *s++;
+       if (tmp == '>')
+           OPERATOR(RS);
+       if (tmp == '=')
+           OPERATOR(GE);
+       s--;
+       OPERATOR('>');
+
+#define SNARFWORD \
+       d = tokenbuf; \
+       while (isalpha(*s) || isdigit(*s) || *s == '_') \
+           *d++ = *s++; \
+       *d = '\0'; \
+       d = tokenbuf;
+
+    case '$':
+       if (s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) {
+           s++;
+           s = scanreg(s,tokenbuf);
+           yylval.stabval = aadd(stabent(tokenbuf,TRUE));
+           TERM(ARYLEN);
+       }
+       s = scanreg(s,tokenbuf);
+       yylval.stabval = stabent(tokenbuf,TRUE);
+       TERM(REG);
+
+    case '@':
+       s = scanreg(s,tokenbuf);
+       yylval.stabval = aadd(stabent(tokenbuf,TRUE));
+       TERM(ARY);
+
+    case '/':                  /* may either be division or pattern */
+    case '?':                  /* may either be conditional or pattern */
+       if (expectterm) {
+           s = scanpat(s);
+           TERM(PATTERN);
+       }
+       tmp = *s++;
+       OPERATOR(tmp);
+
+    case '.':
+       if (!expectterm || !isdigit(s[1])) {
+           s++;
+           tmp = *s++;
+           if (tmp == '.')
+               OPERATOR(DOTDOT);
+           s--;
+           OPERATOR('.');
+       }
+       /* FALL THROUGH */
+    case '0': case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9':
+    case '\'': case '"': case '`':
+       s = scanstr(s);
+       TERM(RSTRING);
+
+    case '_':
+       SNARFWORD;
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'a': case 'A':
+       SNARFWORD;
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'b': case 'B':
+       SNARFWORD;
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'c': case 'C':
+       SNARFWORD;
+       if (strEQ(d,"continue"))
+           OPERATOR(CONTINUE);
+       if (strEQ(d,"chdir"))
+           UNI(O_CHDIR);
+       if (strEQ(d,"close"))
+           OPERATOR(CLOSE);
+       if (strEQ(d,"crypt"))
+           FUN2(O_CRYPT);
+       if (strEQ(d,"chop"))
+           OPERATOR(CHOP);
+       if (strEQ(d,"chmod")) {
+           yylval.ival = O_CHMOD;
+           OPERATOR(PRINT);
+       }
+       if (strEQ(d,"chown")) {
+           yylval.ival = O_CHOWN;
+           OPERATOR(PRINT);
+       }
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'd': case 'D':
+       SNARFWORD;
+       if (strEQ(d,"do"))
+           OPERATOR(DO);
+       if (strEQ(d,"die"))
+           UNI(O_DIE);
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'e': case 'E':
+       SNARFWORD;
+       if (strEQ(d,"else"))
+           OPERATOR(ELSE);
+       if (strEQ(d,"elsif"))
+           OPERATOR(ELSIF);
+       if (strEQ(d,"eq") || strEQ(d,"EQ"))
+           OPERATOR(SEQ);
+       if (strEQ(d,"exit"))
+           UNI(O_EXIT);
+       if (strEQ(d,"eof"))
+           TERM(FEOF);
+       if (strEQ(d,"exp"))
+           FUN1(O_EXP);
+       if (strEQ(d,"each"))
+           SFUN(O_EACH);
+       if (strEQ(d,"exec")) {
+           yylval.ival = O_EXEC;
+           OPERATOR(PRINT);
+       }
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'f': case 'F':
+       SNARFWORD;
+       if (strEQ(d,"for"))
+           OPERATOR(FOR);
+       if (strEQ(d,"format")) {
+           in_format = TRUE;
+           OPERATOR(FORMAT);
+       }
+       if (strEQ(d,"fork"))
+           FUN0(O_FORK);
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'g': case 'G':
+       SNARFWORD;
+       if (strEQ(d,"gt") || strEQ(d,"GT"))
+           OPERATOR(SGT);
+       if (strEQ(d,"ge") || strEQ(d,"GE"))
+           OPERATOR(SGE);
+       if (strEQ(d,"goto"))
+           LOOPX(O_GOTO);
+       if (strEQ(d,"gmtime"))
+           FUN1(O_GMTIME);
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'h': case 'H':
+       SNARFWORD;
+       if (strEQ(d,"hex"))
+           FUN1(O_HEX);
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'i': case 'I':
+       SNARFWORD;
+       if (strEQ(d,"if"))
+           OPERATOR(IF);
+       if (strEQ(d,"index"))
+           FUN2(O_INDEX);
+       if (strEQ(d,"int"))
+           FUN1(O_INT);
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'j': case 'J':
+       SNARFWORD;
+       if (strEQ(d,"join"))
+           OPERATOR(JOIN);
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'k': case 'K':
+       SNARFWORD;
+       if (strEQ(d,"keys"))
+           SFUN(O_KEYS);
+       if (strEQ(d,"kill")) {
+           yylval.ival = O_KILL;
+           OPERATOR(PRINT);
+       }
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'l': case 'L':
+       SNARFWORD;
+       if (strEQ(d,"last"))
+           LOOPX(O_LAST);
+       if (strEQ(d,"length"))
+           FUN1(O_LENGTH);
+       if (strEQ(d,"lt") || strEQ(d,"LT"))
+           OPERATOR(SLT);
+       if (strEQ(d,"le") || strEQ(d,"LE"))
+           OPERATOR(SLE);
+       if (strEQ(d,"localtime"))
+           FUN1(O_LOCALTIME);
+       if (strEQ(d,"log"))
+           FUN1(O_LOG);
+       if (strEQ(d,"link"))
+           FUN2(O_LINK);
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'm': case 'M':
+       SNARFWORD;
+       if (strEQ(d,"m")) {
+           s = scanpat(s-1);
+           TERM(PATTERN);
+       }
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'n': case 'N':
+       SNARFWORD;
+       if (strEQ(d,"next"))
+           LOOPX(O_NEXT);
+       if (strEQ(d,"ne") || strEQ(d,"NE"))
+           OPERATOR(SNE);
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'o': case 'O':
+       SNARFWORD;
+       if (strEQ(d,"open"))
+           OPERATOR(OPEN);
+       if (strEQ(d,"ord"))
+           FUN1(O_ORD);
+       if (strEQ(d,"oct"))
+           FUN1(O_OCT);
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'p': case 'P':
+       SNARFWORD;
+       if (strEQ(d,"print")) {
+           yylval.ival = O_PRINT;
+           OPERATOR(PRINT);
+       }
+       if (strEQ(d,"printf")) {
+           yylval.ival = O_PRTF;
+           OPERATOR(PRINT);
+       }
+       if (strEQ(d,"push")) {
+           yylval.ival = O_PUSH;
+           OPERATOR(PUSH);
+       }
+       if (strEQ(d,"pop"))
+           OPERATOR(POP);
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'q': case 'Q':
+       SNARFWORD;
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);
+    case 'r': case 'R':
+       SNARFWORD;
+       if (strEQ(d,"reset"))
+           UNI(O_RESET);
+       if (strEQ(d,"redo"))
+           LOOPX(O_REDO);
+       if (strEQ(d,"rename"))
+           FUN2(O_RENAME);
+       yylval.cval = savestr(d);
+       OPERATOR(WORD);