perl 4.0 patch 8: patch #4, continued
authorLarry Wall <lwall@netlabs.com>
Thu, 6 Jun 1991 23:28:14 +0000 (23:28 +0000)
committerLarry Wall <lwall@netlabs.com>
Thu, 6 Jun 1991 23:28:14 +0000 (23:28 +0000)
See patch #4.

20 files changed:
hints/sco_2_3_0.sh
hints/sco_2_3_1.sh
hints/sco_2_3_2.sh
hints/sco_2_3_3.sh
hints/sco_3.sh
hints/sgi.sh
lib/perldb.pl
lib/shellwords.pl [new file with mode: 0644]
msdos/popen.c
patchlevel.h
perly.fixer
perly.y
regcomp.c
regcomp.h
regexec.c
regexp.h
spat.h
stab.c
x2p/s2p.SH
x2p/s2p.man

index bf593b0..146363a 100644 (file)
@@ -1,2 +1,2 @@
-yacc='/usr/bin/yacc -m25000'
+yacc='/usr/bin/yacc -Sm25000'
 i_dirent=undef
index bf593b0..146363a 100644 (file)
@@ -1,2 +1,2 @@
-yacc='/usr/bin/yacc -m25000'
+yacc='/usr/bin/yacc -Sm25000'
 i_dirent=undef
index acd8e34..54540e4 100644 (file)
@@ -1,2 +1,2 @@
-yacc='/usr/bin/yacc -m25000'
+yacc='/usr/bin/yacc -Sm25000'
 libswanted=`echo $libswanted | sed 's/ x / /'`
index acd8e34..d1db39f 100644 (file)
@@ -1,2 +1,4 @@
-yacc='/usr/bin/yacc -m25000'
+yacc='/usr/bin/yacc -Sm25000'
 libswanted=`echo $libswanted | sed 's/ x / /'`
+echo "NOTE: you may have problems due to a spurious semicolon on the strerror()"
+echo "macro definition in /usr/include/string.h.  If so, delete the semicolon."
index 015de91..a151fe0 100644 (file)
@@ -1,3 +1,4 @@
 yacc='/usr/bin/yacc -Sm11000'
 libswanted=`echo $libswanted | sed 's/ x / /'`
 i_varargs=undef
+ccflags="$ccflags -U M_XENIX"
index da5ff63..b7db156 100644 (file)
@@ -1,7 +1,6 @@
-optimize='-O0'
+optimize='-O1'
 usemymalloc='y'
 mallocsrc='malloc.c'
 mallocobj='malloc.o'
-ccflags="$ccflags -Uf_next"
 d_voidsig=define
 d_vfork=undef
index d7f05bf..8d16054 100644 (file)
@@ -1,6 +1,6 @@
 package DB;
 
-$header = '$Header: perldb.pl,v 4.0 91/03/20 01:25:50 lwall Locked $';
+$header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:17:44 $';
 #
 # This file is automatically included if you do perl -d.
 # It's probably not useful to include this yourself.
@@ -10,6 +10,10 @@ $header = '$Header: perldb.pl,v 4.0 91/03/20 01:25:50 lwall Locked $';
 # have a breakpoint.  It also inserts a do 'perldb.pl' before the first line.
 #
 # $Log:        perldb.pl,v $
+# Revision 4.0.1.1  91/06/07  11:17:44  lwall
+# patch4: added $^P variable to control calling of perldb routines
+# patch4: debugger sometimes listed wrong number of lines for a statement
+# 
 # Revision 4.0  91/03/20  01:25:50  lwall
 # 4.0 baseline.
 # 
@@ -61,6 +65,7 @@ sub DB {
     ($package, $filename, $line) = caller;
     $usercontext = '($@, $!, $[, $,, $/, $\) = @saved;' .
        "package $package;";            # this won't let them modify, alas
+    local($^P) = 0;                    # don't debug our own evals
     local(*dbline) = "_<$filename";
     $max = $#dbline;
     if (($stop,$action) = split(/\0/,$dbline{$line})) {
@@ -76,7 +81,7 @@ sub DB {
        print OUT "$package'" unless $sub =~ /'/;
        print OUT "$sub($filename:$line):\t",$dbline[$line];
        for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) {
-           last if $dbline[$i] =~ /^\s*(}|#|\n)/;
+           last if $dbline[$i] =~ /^\s*(;|}|#|\n)/;
            print OUT "$sub($filename:$i):\t",$dbline[$i];
        }
     }
diff --git a/lib/shellwords.pl b/lib/shellwords.pl
new file mode 100644 (file)
index 0000000..168991f
--- /dev/null
@@ -0,0 +1,42 @@
+#; shellwords.pl
+#;
+#; Usage:
+#;     require 'shellwords.pl';
+#;     @words = &shellwords($line);
+#;     or
+#;     @words = &shellwords(@lines);
+#;     or
+#;     @words = &shellwords;           # defaults to $_ (and clobbers it)
+
+sub shellwords {
+    package shellwords;
+    local($_) = join('', @_) if @_;
+    local(@words,$snippet,$field);
+
+    s/^\s+//;
+    while ($_ ne '') {
+       $field = '';
+       for (;;) {
+           if (s/^"(([^"\\]+|\\[\\"])*)"//) {
+               ($snippet = $1) =~ s#\\(.)#$1#g;
+           }
+           elsif (s/^'(([^'\\]+|\\[\\'])*)'//) {
+               ($snippet = $1) =~ s#\\(.)#$1#g;
+           }
+           elsif (s/^\\(.)//) {
+               $snippet = $1;
+           }
+           elsif (s/^([^\s\\'"]+)//) {
+               $snippet = $1;
+           }
+           else {
+               s/^\s+//;
+               last;
+           }
+           $field .= $snippet;
+       }
+       push(@words, $field);
+    }
+    @words;
+}
+1;
index 96e6855..c55c136 100644 (file)
@@ -1,11 +1,14 @@
-/* $Header: popen.c,v 4.0 91/03/20 01:34:50 lwall Locked $
+/* $RCSfile: popen.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:22:52 $
  *
  *    (C) Copyright 1988, 1990 Diomidis Spinellis.
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       popen.c,v $
+ * Revision 4.0.1.1  91/06/07  11:22:52  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0  91/03/20  01:34:50  lwall
  * 4.0 baseline.
  * 
index e19cd94..a6997a9 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 7
+#define PATCHLEVEL 8
index 33d1c5c..f3b0e6a 100644 (file)
@@ -2,6 +2,9 @@
 
 #  Hacks to make it work with Interactive's SysVr3 Version 2.2
 #   doughera@lafvax.lafayette.edu (Andy Dougherty)   3/23/91
+#
+# Additional information to make the BSD section work with SunOS 4.0.2
+#   tdinger@East.Sun.COM (Tom Dinger)  4/15/1991
 
 input=$1
 output=$2
@@ -10,11 +13,12 @@ tmp=/tmp/f$$
 plan="unknown"
 
 #  Test for BSD 4.3 version.
+#  Also tests for the SunOS 4.0.2 version
 egrep 'YYSTYPE[        ]*yyv\[ *YYMAXDEPTH *\];
 short[  ]*yys\[ *YYMAXDEPTH *\] *;
 yyps *= *&yys\[ *-1 *\];
 yypv *= *&yyv\[ *-1 *\];
-if *\( *\+\+yyps *> *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp
+if *\( *\+\+yyps *>=* *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp
 
 set `wc -l $tmp`
 if test "$1" = "5"; then
@@ -36,7 +40,10 @@ if *\( *\+\+yy_ps *>= *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp
 fi
 
 case "$plan" in
-    #######################################################
+    ##################################################################
+    # The SunOS 4.0.2 version has the comparison fixed already.
+    # Also added are out of memory checks (makes porting the generated
+    # code easier) For most systems, it can't hurt. -- TD
     "bsd43")
        echo "Patching perly.c to allow dynamic yacc stack allocation"
        echo "Assuming bsd4.3 yaccpar"
@@ -55,13 +62,17 @@ short *maxyyps;
 \      if (!yyv) {\
 \          yyv = (YYSTYPE*) malloc(yymaxdepth * sizeof(YYSTYPE));\
 \          yys = (short*) malloc(yymaxdepth * sizeof(short));\
+\          if ( !yyv || !yys ) {\
+\              yyerror( "out of memory" );\
+\              return(1);\
+\          }\
 \          maxyyps = &yys[yymaxdepth];\
 \      }\
 \      yyps = &yys[-1];\
 \      yypv = &yyv[-1];
 
 
-/if *( *\+\+yyps *> *&yys\[ *YYMAXDEPTH *\] *)/c\
+/if *( *\+\+yyps *>=* *&yys\[ *YYMAXDEPTH *\] *)/c\
 \              if( ++yyps >= maxyyps ) {\
 \                  int tv = yypv - yyv;\
 \                  int ts = yyps - yys;\
@@ -71,6 +82,10 @@ short *maxyyps;
 \                    yymaxdepth*sizeof(YYSTYPE));\
 \                  yys = (short*)realloc((char*)yys,\
 \                    yymaxdepth*sizeof(short));\
+\                  if ( !yyv || !yys ) {\
+\                      yyerror( "yacc stack overflow" );\
+\                      return(1);\
+\                  }\
 \                  yyps = yys + ts;\
 \                  yypv = yyv + tv;\
 \                  maxyyps = &yys[yymaxdepth];\
diff --git a/perly.y b/perly.y
index affb41b..4032e10 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -1,11 +1,14 @@
-/* $Header: perly.y,v 4.0 91/03/20 01:38:40 lwall Locked $
+/* $RCSfile: perly.y,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:42:34 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       perly.y,v $
+ * Revision 4.0.1.1  91/06/07  11:42:34  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0  91/03/20  01:38:40  lwall
  * 4.0 baseline.
  * 
@@ -788,5 +791,5 @@ bareword:   WORD
                                  "\"%s\" may clash with future reserved word",
                                  $1 );
                        }
-
+               ;
 %% /* PROGRAM */
index f11c602..92e43a3 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -7,9 +7,14 @@
  * blame Henry for some of the lack of readability.
  */
 
-/* $RCSfile: regcomp.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:04:45 $
+/* $RCSfile: regcomp.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:48:24 $
  *
  * $Log:       regcomp.c,v $
+ * Revision 4.0.1.2  91/06/07  11:48:24  lwall
+ * patch4: new copyright notice
+ * patch4: /(x+) \1/ incorrectly optimized to not match "xxx xx"
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * 
  * Revision 4.0.1.1  91/04/12  09:04:45  lwall
  * patch1: random cleanup in cpp namespace
  * 
  *
  ****    Alterations to Henry's code are...
  ****
- ****    Copyright (c) 1989, Larry Wall
+ ****    Copyright (c) 1991, Larry Wall
  ****
- ****    You may distribute under the terms of the GNU General Public License
- ****    as specified in the README file that comes with the perl 3.0 kit.
+ ****    You may distribute under the terms of either the GNU General Public
+ ****    License or the Artistic License, as specified in the README file.
+
  *
  * Beware that some of this code is subtly aware of the way operator
  * precedence is structured in regular expressions.  Serious changes in
@@ -95,6 +101,7 @@ static char *regcode;                /* Code-emit pointer; &regdummy = don't. */
 static long regsize;           /* Code size. */
 static int regfold;
 static int regsawbracket;      /* Did we do {d,d} trick? */
+static int regsawback;         /* Did we see \1, ...? */
 
 /*
  * Forward declarations for regcomp()'s friends.
@@ -146,6 +153,7 @@ int fold;
        extern char *safemalloc();
        extern char *savestr();
        int sawplus = 0;
+       int sawopen = 0;
 
        if (exp == NULL)
                fatal("NULL regexp argument");
@@ -156,6 +164,7 @@ int fold;
        regxend = xend;
        regprecomp = nsavestr(exp,xend-exp);
        regsawbracket = 0;
+       regsawback = 0;
        regnpar = 1;
        regsize = 0L;
        regcode = &regdummy;
@@ -178,8 +187,9 @@ int fold;
        /* Second pass: emit code. */
        if (regsawbracket)
            bcopy(regprecomp,exp,xend-exp);
+       r->prelen = xend-exp;
        r->precomp = regprecomp;
-       r->subbase = NULL;
+       r->subbeg = r->subbase = NULL;
        regparse = exp;
        regnpar = 1;
        regcode = r->program;
@@ -198,18 +208,19 @@ int fold;
                scan = NEXTOPER(scan);
 
                first = scan;
-               while (OP(first) == OPEN ||
+               while ((OP(first) == OPEN && (sawopen = 1)) ||
                    (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
                    (OP(first) == PLUS) ||
                    (OP(first) == CURLY && ARG1(first) > 0) ) {
                        if (OP(first) == PLUS)
-                           sawplus = 2;
+                           sawplus = 1;
                        else
                            first += regarglen[OP(first)];
                        first = NEXTOPER(first);
                }
 
                /* Starting-point info. */
+           again:
                if (OP(first) == EXACTLY) {
                        r->regstart =
                            str_make(OPERAND(first)+1,*OPERAND(first));
@@ -221,9 +232,13 @@ int fold;
                else if (OP(first) == BOUND || OP(first) == NBOUND)
                        r->regstclass = first;
                else if (OP(first) == BOL ||
-                   (OP(first) == STAR && OP(NEXTOPER(first)) == ANY) )
-                       r->reganch = 1;         /* kinda turn .* into ^.* */
-               r->reganch |= sawplus;
+                   (OP(first) == STAR && OP(NEXTOPER(first)) == ANY) ) {
+                       r->reganch = ROPT_ANCH; /* kinda turn .* into ^.* */
+                       first = NEXTOPER(first);
+                       goto again;
+               }
+               if (sawplus && (!sawopen || !regsawback))
+                   r->reganch |= ROPT_SKIP;    /* x+ must match 1st of run */
 
 #ifdef DEBUGGING
                if (debug & 512)
@@ -741,6 +756,7 @@ int *flagp;
                            if (num > 9 && num >= regnpar)
                                goto defchar;
                            else {
+                               regsawback = 1;
                                ret = reganode(REF, num);
                                while (isascii(*regparse) && isdigit(*regparse))
                                    regparse++;
@@ -1272,9 +1288,9 @@ regexp *r;
                fprintf(stderr,"start `%s' ", r->regstart->str_ptr);
        if (r->regstclass)
                fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
-       if (r->reganch & 1)
+       if (r->reganch & ROPT_ANCH)
                fprintf(stderr,"anchored ");
-       if (r->reganch & 2)
+       if (r->reganch & ROPT_SKIP)
                fprintf(stderr,"plus ");
        if (r->regmust != NULL)
                fprintf(stderr,"must have \"%s\" back %d ", r->regmust->str_ptr,
index 21ad4f9..8d0d1fa 100644 (file)
--- a/regcomp.h
+++ b/regcomp.h
@@ -1,6 +1,9 @@
-/* $Header: regcomp.h,v 4.0 91/03/20 01:39:09 lwall Locked $
+/* $RCSfile: regcomp.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:49:40 $
  *
  * $Log:       regcomp.h,v $
+ * Revision 4.0.1.1  91/06/07  11:49:40  lwall
+ * patch4: no change
+ * 
  * Revision 4.0  91/03/20  01:39:09  lwall
  * 4.0 baseline.
  * 
index 7db8e3d..bb63eda 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -7,9 +7,13 @@
  * blame Henry for some of the lack of readability.
  */
 
-/* $RCSfile: regexec.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:07:39 $
+/* $RCSfile: regexec.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:50:33 $
  *
  * $Log:       regexec.c,v $
+ * Revision 4.0.1.2  91/06/07  11:50:33  lwall
+ * patch4: new copyright notice
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * 
  * Revision 4.0.1.1  91/04/12  09:07:39  lwall
  * patch1: regexec only allocated space for 9 subexpresssions
  * 
  *
  ****    Alterations to Henry's code are...
  ****
- ****    Copyright (c) 1989, Larry Wall
+ ****    Copyright (c) 1991, Larry Wall
  ****
- ****    You may distribute under the terms of the GNU General Public License
- ****    as specified in the README file that comes with the perl 3.0 kit.
+ ****    You may distribute under the terms of either the GNU General Public
+ ****    License or the Artistic License, as specified in the README file.
  *
  * Beware that some of this code is subtly aware of the way operator
  * precedence is structured in regular expressions.  Serious changes in
@@ -151,7 +155,8 @@ int safebase;       /* no need to remember string in subbase */
        /* If there is a "must appear" string, look for it. */
        s = string;
        if (prog->regmust != Nullstr &&
-           (!(prog->reganch & 1) || (multiline && prog->regback >= 0)) ) {
+           (!(prog->reganch & ROPT_ANCH)
+            || (multiline && prog->regback >= 0)) ) {
                if (stringarg == strbeg && screamer) {
                        if (screamfirst[prog->regmust->str_rare] >= 0)
                                s = screaminstr(screamer,prog->regmust);
@@ -213,7 +218,7 @@ int safebase;       /* no need to remember string in subbase */
 
        /* Simplest case:  anchored match need be tried only once. */
        /*  [unless multiline is set] */
-       if (prog->reganch & 1) {
+       if (prog->reganch & ROPT_ANCH) {
                if (regtry(prog, string))
                        goto got_it;
                else if (multiline) {
@@ -235,7 +240,7 @@ int safebase;       /* no need to remember string in subbase */
 
        /* Messy cases:  unanchored match. */
        if (prog->regstart) {
-               if (prog->reganch & 2) {        /* we have /x+whatever/ */
+               if (prog->reganch & ROPT_SKIP) {  /* we have /x+whatever/ */
                    /* it must be a one character string */
                    i = prog->regstart->str_ptr[0];
                    while (s < strend) {
@@ -275,7 +280,7 @@ int safebase;       /* no need to remember string in subbase */
                goto phooey;
        }
        if (c = prog->regstclass) {
-               int doevery = (prog->reganch & 2) == 0;
+               int doevery = (prog->reganch & ROPT_SKIP) == 0;
 
                if (minlen)
                    dontbother = minlen - 1;
@@ -445,7 +450,7 @@ int safebase;       /* no need to remember string in subbase */
                    s = nsavestr(strbeg,i);     /* so $digit will work later */
                    if (prog->subbase)
                            Safefree(prog->subbase);
-                   prog->subbase = s;
+                   prog->subbeg = prog->subbase = s;
                    prog->subend = s+i;
                }
                else
index 600e630..5731874 100644 (file)
--- a/regexp.h
+++ b/regexp.h
@@ -5,9 +5,14 @@
  * not the System V one.
  */
 
-/* $Header: regexp.h,v 4.0 91/03/20 01:39:23 lwall Locked $
+/* $RCSfile: regexp.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:51:18 $
  *
  * $Log:       regexp.h,v $
+ * Revision 4.0.1.1  91/06/07  11:51:18  lwall
+ * patch4: new copyright notice
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * patch4: $` was busted inside s///
+ * 
  * Revision 4.0  91/03/20  01:39:23  lwall
  * 4.0 baseline.
  * 
@@ -20,8 +25,10 @@ typedef struct regexp {
        char *regstclass;
        STR *regmust;           /* Internal use only. */
        int regback;            /* Can regmust locate first try? */
+       int prelen;             /* length of precomp */
        char *precomp;          /* pre-compilation regular expression */
        char *subbase;          /* saved string so \digit works forever */
+       char *subbeg;           /* same, but not responsible for allocation */
        char *subend;           /* end of subbase */
        char reganch;           /* Internal use only. */
        char do_folding;        /* do case-insensitive match? */
@@ -30,5 +37,8 @@ typedef struct regexp {
        char program[1];        /* Unwarranted chumminess with compiler. */
 } regexp;
 
+#define ROPT_ANCH 1
+#define ROPT_SKIP 2
+
 regexp *regcomp();
 int regexec();
diff --git a/spat.h b/spat.h
index 4c03c6e..6c1551e 100644 (file)
--- a/spat.h
+++ b/spat.h
@@ -1,11 +1,15 @@
-/* $Header: spat.h,v 4.0 91/03/20 01:39:36 lwall Locked $
+/* $RCSfile: spat.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:51:59 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       spat.h,v $
+ * Revision 4.0.1.1  91/06/07  11:51:59  lwall
+ * patch4: new copyright notice
+ * patch4: added global modifier for pattern matches
+ * 
  * Revision 4.0  91/03/20  01:39:36  lwall
  * 4.0 baseline.
  * 
@@ -17,7 +21,7 @@ struct scanpat {
     ARG                *spat_repl;             /* replacement string for subst */
     ARG                *spat_runtime;          /* compile pattern at runtime */
     STR                *spat_short;            /* for a fast bypass of execute() */
-    bool       spat_flags;
+    short      spat_flags;
     char       spat_slen;
 };
 
@@ -29,6 +33,7 @@ struct scanpat {
 #define SPAT_FOLD 32                   /* case insensitivity */
 #define SPAT_CONST 64                  /* subst replacement is constant */
 #define SPAT_KEEP 128                  /* keep 1st runtime pattern forever */
+#define SPAT_GLOBAL 256                        /* pattern had a g modifier */
 
 EXT SPAT *curspat;             /* what to do \ interps from */
 EXT SPAT *lastspat;            /* what to use in place of null pattern */
diff --git a/stab.c b/stab.c
index 7819793..b8e76d4 100644 (file)
--- a/stab.c
+++ b/stab.c
@@ -1,11 +1,20 @@
-/* $RCSfile: stab.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:10:24 $
+/* $RCSfile: stab.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:55:53 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       stab.c,v $
+ * Revision 4.0.1.2  91/06/07  11:55:53  lwall
+ * patch4: new copyright notice
+ * patch4: added $^P variable to control calling of perldb routines
+ * patch4: added $^F variable to specify maximum system fd, default 2
+ * patch4: $` was busted inside s///
+ * patch4: default top-of-form format is now FILEHANDLE_TOP
+ * patch4: length($`), length($&), length($') now optimized to avoid string copy
+ * patch4: $^D |= 1024 now does syntax tree dump at run-time
+ * 
  * Revision 4.0.1.1  91/04/12  09:10:24  lwall
  * patch1: Configure now differentiates getgroups() type from getgid() type
  * patch1: you may now use "die" and "caller" in a signal handler
@@ -54,12 +63,18 @@ STR *str;
        str_numset(stab_val(stab),(double)(debug & 32767));
 #endif
        break;
+    case '\006':               /* ^F */
+       str_numset(stab_val(stab),(double)maxsysfd);
+       break;
     case '\t':                 /* ^I */
        if (inplace)
            str_set(stab_val(stab), inplace);
        else
            str_sset(stab_val(stab),&str_undef);
        break;
+    case '\020':               /* ^P */
+       str_numset(stab_val(stab),(double)perldb);
+       break;
     case '\024':               /* ^T */
        str_numset(stab_val(stab),(double)basetime);
        break;
@@ -93,7 +108,7 @@ STR *str;
     case '`':
        if (curspat) {
            if (curspat->spat_regexp &&
-             (s = curspat->spat_regexp->subbase) ) {
+             (s = curspat->spat_regexp->subbeg) ) {
                i = curspat->spat_regexp->startp[0] - s;
                if (i >= 0)
                    str_nset(stab_val(stab),s,i);
@@ -126,10 +141,17 @@ STR *str;
        break;
     case '^':
        s = stab_io(curoutstab)->top_name;
-       str_set(stab_val(stab),s);
+       if (s)
+           str_set(stab_val(stab),s);
+       else {
+           str_set(stab_val(stab),stab_name(curoutstab));
+           str_cat(stab_val(stab),"_TOP");
+       }
        break;
     case '~':
        s = stab_io(curoutstab)->fmt_name;
+       if (!s)
+           s = stab_name(curoutstab);
        str_set(stab_val(stab),s);
        break;
 #ifndef lint
@@ -215,6 +237,76 @@ STR *str;
     return stab_val(stab);
 }
 
+STRLEN
+stab_len(str)
+STR *str;
+{
+    STAB *stab = str->str_u.str_stab;
+    int paren;
+    int i;
+    char *s;
+
+    if (str->str_rare)
+       return stab_val(stab)->str_cur;
+
+    switch (*stab->str_magic->str_ptr) {
+    case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9': case '&':
+       if (curspat) {
+           paren = atoi(stab_name(stab));
+         getparen:
+           if (curspat->spat_regexp &&
+             paren <= curspat->spat_regexp->nparens &&
+             (s = curspat->spat_regexp->startp[paren]) ) {
+               i = curspat->spat_regexp->endp[paren] - s;
+               if (i >= 0)
+                   return i;
+               else
+                   return 0;
+           }
+           else
+               return 0;
+       }
+       break;
+    case '+':
+       if (curspat) {
+           paren = curspat->spat_regexp->lastparen;
+           goto getparen;
+       }
+       break;
+    case '`':
+       if (curspat) {
+           if (curspat->spat_regexp &&
+             (s = curspat->spat_regexp->subbeg) ) {
+               i = curspat->spat_regexp->startp[0] - s;
+               if (i >= 0)
+                   return i;
+               else
+                   return 0;
+           }
+           else
+               return 0;
+       }
+       break;
+    case '\'':
+       if (curspat) {
+           if (curspat->spat_regexp &&
+             (s = curspat->spat_regexp->endp[0]) ) {
+               return (STRLEN) (curspat->spat_regexp->subend - s);
+           }
+           else
+               return 0;
+       }
+       break;
+    case ',':
+       return (STRLEN)ofslen;
+    case '\\':
+       return (STRLEN)orslen;
+    default:
+       return stab_str(str)->str_cur;
+    }
+}
+
 stabset(mstr,str)
 register STR *mstr;
 STR *str;
@@ -334,8 +426,13 @@ STR *str;
        case '\004':    /* ^D */
 #ifdef DEBUGGING
            debug = (int)(str_gnum(str)) | 32768;
+           if (debug & 1024)
+               dump_all();
 #endif
            break;
+       case '\006':    /* ^F */
+           maxsysfd = (int)str_gnum(str);
+           break;
        case '\t':      /* ^I */
            if (inplace)
                Safefree(inplace);
@@ -344,6 +441,9 @@ STR *str;
            else
                inplace = Nullch;
            break;
+       case '\020':    /* ^P */
+           perldb = (int)str_gnum(str);
+           break;
        case '\024':    /* ^T */
            basetime = (long)str_gnum(str);
            break;
@@ -430,12 +530,12 @@ STR *str;
            break;
        case '<':
            uid = (int)str_gnum(str);
-#ifdef HAS_SETREUID
+#if defined(HAS_SETREUID) || !defined(HAS_SETRUID)
            if (delaymagic) {
                delaymagic |= DM_REUID;
                break;                          /* don't do magic till later */
            }
-#endif /* HAS_SETREUID */
+#endif /* HAS_SETREUID or not HASSETRUID */
 #ifdef HAS_SETRUID
            if (setruid((UIDTYPE)uid) < 0)
                uid = (int)getuid();
@@ -453,12 +553,12 @@ STR *str;
            break;
        case '>':
            euid = (int)str_gnum(str);
-#ifdef HAS_SETREUID
+#if defined(HAS_SETREUID) || !defined(HAS_SETEUID)
            if (delaymagic) {
                delaymagic |= DM_REUID;
                break;                          /* don't do magic till later */
            }
-#endif /* HAS_SETREUID */
+#endif /* HAS_SETREUID or not HAS_SETEUID */
 #ifdef HAS_SETEUID
            if (seteuid((UIDTYPE)euid) < 0)
                euid = (int)geteuid();
@@ -476,12 +576,12 @@ STR *str;
            break;
        case '(':
            gid = (int)str_gnum(str);
-#ifdef HAS_SETREGID
+#if defined(HAS_SETREGID) || !defined(HAS_SETRGID)
            if (delaymagic) {
                delaymagic |= DM_REGID;
                break;                          /* don't do magic till later */
            }
-#endif /* HAS_SETREGID */
+#endif /* HAS_SETREGID or not HAS_SETRGID */
 #ifdef HAS_SETRGID
            (void)setrgid((GIDTYPE)gid);
 #else
@@ -494,12 +594,12 @@ STR *str;
            break;
        case ')':
            egid = (int)str_gnum(str);
-#ifdef HAS_SETREGID
+#if defined(HAS_SETREGID) || !defined(HAS_SETEGID)
            if (delaymagic) {
                delaymagic |= DM_REGID;
                break;                          /* don't do magic till later */
            }
-#endif /* HAS_SETREGID */
+#endif /* HAS_SETREGID or not HAS_SETEGID */
 #ifdef HAS_SETEGID
            (void)setegid((GIDTYPE)egid);
 #else
index c059481..818d362 100644 (file)
@@ -29,9 +29,12 @@ $spitshell >s2p <<!GROK!THIS!
 : In the following dollars and backticks do not need the extra backslash.
 $spitshell >>s2p <<'!NO!SUBS!'
 
-# $Header: s2p.SH,v 4.0 91/03/20 01:57:59 lwall Locked $
+# $RCSfile: s2p.SH,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:19:18 $
 #
 # $Log:        s2p.SH,v $
+# Revision 4.0.1.1  91/06/07  12:19:18  lwall
+# patch4: s2p now handles embedded newlines better and optimizes common idioms
+# 
 # Revision 4.0  91/03/20  01:57:59  lwall
 # 4.0 baseline.
 # 
@@ -66,33 +69,43 @@ unless ($debug) {
 }
 
 if (!$assumen && !$assumep) {
-    print BODY <<'EOT';
-while ($ARGV[0] =~ /^-/) {
-    $_ = shift;
-  last if /^--/;
-    if (/^-n/) {
-       $nflag++;
-       next;
-    }
-    die "I don't recognize this switch: $_\\n";
-}
-
+    print BODY &q(<<'EOT');
+:      while ($ARGV[0] =~ /^-/) {
+:          $_ = shift;
+:        last if /^--/;
+:          if (/^-n/) {
+:              $nflag++;
+:              next;
+:          }
+:          die "I don't recognize this switch: $_\\n";
+:      }
+:      
 EOT
 }
 
-print BODY <<'EOT';
-
-#ifdef PRINTIT
-#ifdef ASSUMEP
-$printit++;
-#else
-$printit++ unless $nflag;
-#endif
-#endif
-LINE: while (<>) {
+print BODY &q(<<'EOT');
+:      #ifdef PRINTIT
+:      #ifdef ASSUMEP
+:      $printit++;
+:      #else
+:      $printit++ unless $nflag;
+:      #endif
+:      #endif
+:      <><>
+:      $\ = "\n";              # automatically add newline on print
+:      <><>
+:      #ifdef TOPLABEL
+:      LINE:
+:      while (chop($_ = <>)) {
+:      #else
+:      LINE:
+:      while (<>) {
+:          chop;
+:      #endif
 EOT
 
-LINE: while (<>) {
+LINE:
+while (<>) {
 
     # Wipe out surrounding whitespace.
 
@@ -105,6 +118,10 @@ LINE: while (<>) {
        $label = &make_label($_);
        if ($. == 1) {
            $toplabel = $label;
+           if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
+               $_ = <>;
+               redo LINE; # Never referenced, so delete it if not a comment.
+           }
        }
        $_ = "$label:";
        if ($lastlinewaslabel++) {
@@ -127,6 +144,7 @@ LINE: while (<>) {
     $addr2 = '';
     if (s/^([0-9]+)//) {
        $addr1 = "$1";
+       $addr1 = "\$. == $addr1" unless /^,/;
     }
     elsif (s/^\$//) {
        $addr1 = 'eof()';
@@ -213,35 +231,39 @@ if ($lastlinewaslabel++) {
     $indent -= 4;
 }
 
-print BODY "}\n";
 if ($appendseen || $tseen || !$assumen) {
     $printit++ if $dseen || (!$assumen && !$assumep);
-    print BODY <<'EOT';
-
-continue {
-#ifdef PRINTIT
-#ifdef DSEEN
-#ifdef ASSUMEP
-    print if $printit++;
-#else
-    if ($printit)
-       { print; }
-    else
-       { $printit++ unless $nflag; }
-#endif
-#else
-    print if $printit;
-#endif
-#else
-    print;
-#endif
-#ifdef TSEEN
-    $tflag = '';
-#endif
-#ifdef APPENDSEEN
-    if ($atext) { print $atext; $atext = ''; }
-#endif
-}
+    print BODY &q(<<'EOT');
+:      #ifdef SAWNEXT
+:      }
+:      continue {
+:      #endif
+:      #ifdef PRINTIT
+:      #ifdef DSEEN
+:      #ifdef ASSUMEP
+:          print if $printit++;
+:      #else
+:          if ($printit)
+:              { print; }
+:          else
+:              { $printit++ unless $nflag; }
+:      #endif
+:      #else
+:          print if $printit;
+:      #endif
+:      #else
+:          print;
+:      #endif
+:      #ifdef TSEEN
+:          $tflag = 0;
+:      #endif
+:      #ifdef APPENDSEEN
+:          if ($atext) { chop $atext; print $atext; $atext = ''; }
+:      #endif
+EOT
+
+print BODY &q(<<'EOT');
+:      }
 EOT
 }
 
@@ -250,12 +272,14 @@ close BODY;
 unless ($debug) {
     open(HEAD,">/tmp/sperl2$$.c")
       || &Die("Can't open temp file 2: $!\n");
-    print HEAD "#define PRINTIT\n" if ($printit);
-    print HEAD "#define APPENDSEEN\n" if ($appendseen);
-    print HEAD "#define TSEEN\n" if ($tseen);
-    print HEAD "#define DSEEN\n" if ($dseen);
-    print HEAD "#define ASSUMEN\n" if ($assumen);
-    print HEAD "#define ASSUMEP\n" if ($assumep);
+    print HEAD "#define PRINTIT\n"     if $printit;
+    print HEAD "#define APPENDSEEN\n"  if $appendseen;
+    print HEAD "#define TSEEN\n"       if $tseen;
+    print HEAD "#define DSEEN\n"       if $dseen;
+    print HEAD "#define ASSUMEN\n"     if $assumen;
+    print HEAD "#define ASSUMEP\n"     if $assumep;
+    print HEAD "#define TOPLABEL\n"    if $toplabel;
+    print HEAD "#define SAWNEXT\n"     if $sawnext;
     if ($opens) {print HEAD "$opens\n";}
     open(BODY,"/tmp/sperl$$")
       || &Die("Can't reopen temp file: $!\n");
@@ -264,11 +288,11 @@ unless ($debug) {
     }
     close HEAD;
 
-    print <<"EOT";
-#!$bin/perl
-eval 'exec $bin/perl -S \$0 \$*'
-       if \$running_under_some_shell;
-
+    print &q(<<"EOT");
+:      #!$bin/perl
+:      eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
+:              if \$running_under_some_shell;
+:      
 EOT
     open(BODY,"cc -E /tmp/sperl2$$.c |") ||
        &Die("Can't reopen temp file: $!\n");
@@ -297,15 +321,22 @@ sub tab {
 sub make_filehandle {
     local($_) = $_[0];
     local($fname) = $_;
-    s/[^a-zA-Z]/_/g;
-    s/^_*//;
-    substr($_,0,1) =~ y/a-z/A-Z/ if /^[a-z]/;
-    if (!$seen{$_}) {
-       $opens .= <<"EOT";
-open($_,'>$fname') || die "Can't create $fname";
+    if (!$seen{$fname}) {
+       $_ = "FH_" . $_ if /^\d/;
+       s/[^a-zA-Z0-9]/_/g;
+       s/^_*//;
+       $_ = "\U$_";
+       if ($fhseen{$_}) {
+           for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
+           $_ .= $tmp;
+       }
+       $fhseen{$_} = 1;
+       $opens .= &q(<<"EOT");
+:      open($_, '>$fname') || die "Can't create $fname: \$!";
 EOT
+       $seen{$fname} = $_;
     }
-    $seen{$_} = $_;
+    $seen{$fname};
 }
 
 sub make_label {
@@ -325,67 +356,69 @@ sub transmogrify {
     {  # case
        if (/^d/) {
            $dseen++;
-           chop($_ = <<'EOT');
-<<--#ifdef PRINTIT
-$printit = '';
-<<--#endif
-next LINE;
+           chop($_ = &q(<<'EOT'));
+:      <<--#ifdef PRINTIT
+:      $printit = 0;
+:      <<--#endif
+:      next LINE;
 EOT
+           $sawnext++;
            next;
        }
 
        if (/^n/) {
-           chop($_ = <<'EOT');
-<<--#ifdef PRINTIT
-<<--#ifdef DSEEN
-<<--#ifdef ASSUMEP
-print if $printit++;
-<<--#else
-if ($printit)
-    { print; }
-else
-    { $printit++ unless $nflag; }
-<<--#endif
-<<--#else
-print if $printit;
-<<--#endif
-<<--#else
-print;
-<<--#endif
-<<--#ifdef APPENDSEEN
-if ($atext) {print $atext; $atext = '';}
-<<--#endif
-$_ = <>;
-<<--#ifdef TSEEN
-$tflag = '';
-<<--#endif
+           chop($_ = &q(<<'EOT'));
+:      <<--#ifdef PRINTIT
+:      <<--#ifdef DSEEN
+:      <<--#ifdef ASSUMEP
+:      print if $printit++;
+:      <<--#else
+:      if ($printit)
+:          { print; }
+:      else
+:          { $printit++ unless $nflag; }
+:      <<--#endif
+:      <<--#else
+:      print if $printit;
+:      <<--#endif
+:      <<--#else
+:      print;
+:      <<--#endif
+:      <<--#ifdef APPENDSEEN
+:      if ($atext) {chop $atext; print $atext; $atext = '';}
+:      <<--#endif
+:      $_ = <>;
+:      chop;
+:      <<--#ifdef TSEEN
+:      $tflag = 0;
+:      <<--#endif
 EOT
            next;
        }
 
        if (/^a/) {
            $appendseen++;
-           $command = $space . '$atext .=' . "\n<<--'";
+           $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
            $lastline = 0;
            while (<>) {
                s/^[ \t]*//;
                s/^[\\]//;
                unless (s|\\$||) { $lastline = 1;}
-               s/'/\\'/g;
                s/^([ \t]*\n)/<><>$1/;
                $command .= $_;
                $command .= '<<--';
                last if $lastline;
            }
-           $_ = $command . "';";
+           $_ = $command . "End_Of_Text";
            last;
        }
 
        if (/^[ic]/) {
            if (/^c/) { $change = 1; }
+           $addr1 = 1 if $addr1 eq '';
            $addr1 = '$iter = (' . $addr1 . ')';
-           $command = $space . 'if ($iter == 1) { print'
-             . "\n<<--'";
+           $command = $space .
+             "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
            $lastline = 0;
            while (<>) {
                s/^[ \t]*//;
@@ -397,16 +430,17 @@ EOT
                $command .= '<<--';
                last if $lastline;
            }
-           $_ = $command . "';}";
+           $_ = $command . "End_Of_Text";
            if ($change) {
                $dseen++;
                $change = "$_\n";
-               chop($_ = <<"EOT");
-<<--#ifdef PRINTIT
-$space\$printit = '';
-<<--#endif
-${space}next LINE;
+               chop($_ = &q(<<"EOT"));
+:      <<--#ifdef PRINTIT
+:      $space\$printit = 0;
+:      <<--#endif
+:      ${space}next LINE;
 EOT
+               $sawnext++;
            }
            last;
        }
@@ -463,6 +497,11 @@ EOT
                elsif ($c eq ']') {
                    $inbracket = 0;
                }
+               elsif ($c eq "\t") {
+                   substr($_, $i, 1) = '\\t';
+                   $i++;
+                   $len++;
+               }
                elsif (!$repl && index("()+",$c) >= 0) {
                    substr($_, $i, 0) = '\\';
                    $i++;
@@ -474,6 +513,7 @@ EOT
            $pat = substr($_, 0, $repl + 1);
            $repl = substr($_, $repl+1, $end-$repl-1);
            $end = substr($_, $end + 1, 1000);
+           &simplify($pat);
            $dol = '$';
            $repl =~ s/\$/\\$/;
            $repl =~ s'&'$&'g;
@@ -498,12 +538,12 @@ EOT
                &Die("Unrecognized substitution command".
                  "($end) at line $.\n");
            }
-           chop ($_ = <<"EOT");
-<<--#ifdef TSEEN
-$subst && \$tflag++$cmd;
-<<--#else
-$subst$cmd;
-<<--#endif
+           chop ($_ = &q(<<"EOT"));
+:      <<--#ifdef TSEEN
+:      $subst && \$tflag++$cmd;
+:      <<--#else
+:      $subst$cmd;
+:      <<--#endif
 EOT
            next;
        }
@@ -529,25 +569,29 @@ EOT
        }
 
        if (/^P/) {
-           $_ = 'print $1 if /(^.*\n)/;';
+           $_ = 'print $1 if /^(.*)/;';
            next;
        }
 
        if (/^D/) {
-           chop($_ = <<'EOT');
-s/^.*\n//;
-redo LINE if $_;
-next LINE;
+           chop($_ = &q(<<'EOT'));
+:      s/^.*\n?//;
+:      redo LINE if $_;
+:      next LINE;
 EOT
+           $sawnext++;
            next;
        }
 
        if (/^N/) {
-           chop($_ = <<'EOT');
-$_ .= <>;
-<<--#ifdef TSEEN
-$tflag = '';
-<<--#endif
+           chop($_ = &q(<<'EOT'));
+:      $_ .= "\n";
+:      $len1 = length;
+:      $_ .= <>;
+:      chop if $len1 < length;
+:      <<--#ifdef TSEEN
+:      $tflag = 0;
+:      <<--#endif
 EOT
            next;
        }
@@ -558,7 +602,7 @@ EOT
        }
 
        if (/^H/) {
-           $_ = '$hold .= $_ ? $_ : "\n";';
+           $_ = '$hold .= "\n"; $hold .= $_;';
            next;
        }
 
@@ -568,7 +612,7 @@ EOT
        }
 
        if (/^G/) {
-           $_ = '$_ .= $hold ? $hold : "\n";';
+           $_ = '$_ .= "\n"; $_ .= $hold;';
            next;
        }
 
@@ -579,6 +623,7 @@ EOT
 
        if (/^b$/) {
            $_ = 'next LINE;';
+           $sawnext++;
            next;
        }
 
@@ -595,6 +640,7 @@ EOT
 
        if (/^t$/) {
            $_ = 'next LINE if $tflag;';
+           $sawnext++;
            $tseen++;
            next;
        }
@@ -602,7 +648,7 @@ EOT
        if (/^t/) {
            s/^t[ \t]*//;
            $lab = &make_label($_);
-           $_ = q/if ($tflag) {$tflag = ''; /;
+           $_ = q/if ($tflag) {$tflag = 0; /;
            if ($lab eq $toplabel) {
                $_ .= 'redo LINE;}';
            } else {
@@ -612,17 +658,28 @@ EOT
            next;
        }
 
+       if (/^y/) {
+           s/abcdefghijklmnopqrstuvwxyz/a-z/g;
+           s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
+           s/abcdef/a-f/g;
+           s/ABCDEF/A-F/g;
+           s/0123456789/0-9/g;
+           s/01234567/0-7/g;
+           $_ .= ';';
+       }
+
        if (/^=/) {
-           $_ = 'print "$.\n";';
+           $_ = 'print $.;';
            next;
        }
 
        if (/^q/) {
-           chop($_ = <<'EOT');
-close(ARGV);
-@ARGV = ();
-next LINE;
+           chop($_ = &q(<<'EOT'));
+:      close(ARGV);
+:      @ARGV = ();
+:      next LINE;
 EOT
+           $sawnext++;
            next;
        }
     } continue {
@@ -670,9 +727,39 @@ sub fetchpat {
            last DELIM;
        }
     }
+    $addr =~ s/\t/\\t/g;
+    &simplify($addr);
     $addr;
 }
 
+sub q {
+    local($string) = @_;
+    local($*) = 1;
+    $string =~ s/^:\t?//g;
+    $string;
+}
+
+sub simplify {
+    $_[0] =~ s/_a-za-z0-9/\\w/ig;
+    $_[0] =~ s/a-z_a-z0-9/\\w/ig;
+    $_[0] =~ s/a-za-z_0-9/\\w/ig;
+    $_[0] =~ s/a-za-z0-9_/\\w/ig;
+    $_[0] =~ s/_0-9a-za-z/\\w/ig;
+    $_[0] =~ s/0-9_a-za-z/\\w/ig;
+    $_[0] =~ s/0-9a-z_a-z/\\w/ig;
+    $_[0] =~ s/0-9a-za-z_/\\w/ig;
+    $_[0] =~ s/\[\\w\]/\\w/g;
+    $_[0] =~ s/\[^\\w\]/\\W/g;
+    $_[0] =~ s/\[0-9\]/\\d/g;
+    $_[0] =~ s/\[^0-9\]/\\D/g;
+    $_[0] =~ s/\\d\\d\*/\\d+/g;
+    $_[0] =~ s/\\D\\D\*/\\D+/g;
+    $_[0] =~ s/\\w\\w\*/\\w+/g;
+    $_[0] =~ s/\\t\\t\*/\\t+/g;
+    $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
+    $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
+}
+
 !NO!SUBS!
 chmod 755 s2p
 $eunicefix s2p
index 1017d37..6ece802 100644 (file)
@@ -1,7 +1,10 @@
 .rn '' }`
-''' $Header: s2p.man,v 4.0 91/03/20 01:58:07 lwall Locked $
+''' $RCSfile: s2p.man,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:19:57 $
 ''' 
 ''' $Log:      s2p.man,v $
+''' Revision 4.0.1.1  91/06/07  12:19:57  lwall
+''' patch4: s2p now handles embedded newlines better and optimizes common idioms
+''' 
 ''' Revision 4.0  91/03/20  01:58:07  lwall
 ''' 4.0 baseline.
 ''' 
@@ -86,6 +89,8 @@ The perl script you end up with may be either faster or slower than the original
 sed script.
 If you're only interested in speed you'll just have to try it both ways.
 Of course, if you want to do something sed doesn't do, you have no choice.
+It's often possible to speed up the perl script by various methods, such
+as deleting all references to $\e and chop.
 .SH ENVIRONMENT
 S2p uses no environment variables.
 .SH AUTHOR