perl 4.0 patch #8

Larry Wall lwall at jpl-devvax.jpl.nasa.gov
Sat Jun 8 11:09:22 AEST 1991


System: perl version 4.0
Patch #: 8
Priority: High
Subject: patch #4, continued

Description:
	See patch #4.

Fix:	From rn, say "| patch -p -N -d DIR", where DIR is your perl source
	directory.  Outside of rn, say "cd DIR; patch -p -N <thisarticle".
	If you don't have the patch program, apply the following by hand,
	or get patch (version 2.0, latest patchlevel).

	After patching:
		*** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #09 FIRST ***

	If patch indicates that patchlevel is the wrong version, you may need
	to apply one or more previous patches, or the patch may already
	have been applied.  See the patchlevel.h file to find out what has or
	has not been applied.  In any event, don't continue with the patch.

	If you are missing previous patches they can be obtained from me:

	Larry Wall
	lwall at netlabs.com

	If you send a mail message of the following form it will greatly speed
	processing:

	Subject: Command
	@SH mailpatch PATH perl 4.0 LIST
		   ^ note the c

	where PATH is a return path FROM ME TO YOU either in Internet notation,
	or in bang notation from some well-known host, and LIST is the number
	of one or more patches you need, separated by spaces, commas, and/or
	hyphens.  Saying 35- says everything from 35 to the end.


Index: patchlevel.h
Prereq: 7
1c1
< #define PATCHLEVEL 7
---
> #define PATCHLEVEL 8

Index: lib/perldb.pl
Prereq: 4.0
*** lib/perldb.pl.old	Fri Jun  7 12:25:19 1991
--- lib/perldb.pl	Fri Jun  7 12:25:20 1991
***************
*** 1,6 ****
  package DB;
  
! $header = '$Header: perldb.pl,v 4.0 91/03/20 01:25:50 lwall Locked $';
  #
  # This file is automatically included if you do perl -d.
  # It's probably not useful to include this yourself.
--- 1,6 ----
  package DB;
  
! $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,15 ****
--- 10,19 ----
  # 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,66 ****
--- 65,71 ----
      ($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,82 ****
  	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)/;
  	    print OUT "$sub($filename:$i):\t",$dbline[$i];
  	}
      }
--- 81,87 ----
  	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)/;
  	    print OUT "$sub($filename:$i):\t",$dbline[$i];
  	}
      }

Index: perly.fixer
*** perly.fixer.old	Fri Jun  7 12:26:21 1991
--- perly.fixer	Fri Jun  7 12:26:21 1991
***************
*** 2,7 ****
--- 2,10 ----
  
  #  Hacks to make it work with Interactive's SysVr3 Version 2.2
  #   doughera at lafvax.lafayette.edu (Andy Dougherty)   3/23/91
+ #
+ # Additional information to make the BSD section work with SunOS 4.0.2
+ #   tdinger at East.Sun.COM (Tom Dinger)	4/15/1991
  
  input=$1
  output=$2
***************
*** 10,20 ****
  plan="unknown"
  
  #  Test for BSD 4.3 version.
  egrep 'YYSTYPE[ 	]*yyv\[ *YYMAXDEPTH *\];
  short[  ]*yys\[ *YYMAXDEPTH *\] *;
  yyps *= *&yys\[ *-1 *\];
  yypv *= *&yyv\[ *-1 *\];
! if *\( *\+\+yyps *> *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp
  
  set `wc -l $tmp`
  if test "$1" = "5"; then
--- 13,24 ----
  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
  
  set `wc -l $tmp`
  if test "$1" = "5"; then
***************
*** 36,42 ****
  fi
  
  case "$plan" in
!     #######################################################
      "bsd43")
  	echo "Patching perly.c to allow dynamic yacc stack allocation"
  	echo "Assuming bsd4.3 yaccpar"
--- 40,49 ----
  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,60 ****
--- 62,71 ----
  \	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];\
***************
*** 61,67 ****
  \	yypv = &yyv[-1];
  
  
! /if *( *\+\+yyps *> *&yys\[ *YYMAXDEPTH *\] *)/c\
  \		if( ++yyps >= maxyyps ) {\
  \		    int tv = yypv - yyv;\
  \		    int ts = yyps - yys;\
--- 72,78 ----
  \	yypv = &yyv[-1];
  
  
! /if *( *\+\+yyps *>=* *&yys\[ *YYMAXDEPTH *\] *)/c\
  \		if( ++yyps >= maxyyps ) {\
  \		    int tv = yypv - yyv;\
  \		    int ts = yyps - yys;\
***************
*** 71,76 ****
--- 82,91 ----
  \		      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];\

Index: perly.y
Prereq: 4.0
*** perly.y.old	Fri Jun  7 12:26:24 1991
--- perly.y	Fri Jun  7 12:26:25 1991
***************
*** 1,11 ****
! /* $Header: perly.y,v 4.0 91/03/20 01:38:40 lwall Locked $
   *
!  *    Copyright (c) 1989, 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.
   *
   * $Log:	perly.y,v $
   * Revision 4.0  91/03/20  01:38:40  lwall
   * 4.0 baseline.
   * 
--- 1,14 ----
! /* $RCSfile: perly.y,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:42:34 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    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,792 ****
  				  "\"%s\" may clash with future reserved word",
  				  $1 );
  			}
! 
  %% /* PROGRAM */
--- 791,795 ----
  				  "\"%s\" may clash with future reserved word",
  				  $1 );
  			}
! 		;
  %% /* PROGRAM */

Index: msdos/popen.c
Prereq: 4.0
*** msdos/popen.c.old	Fri Jun  7 12:25:48 1991
--- msdos/popen.c	Fri Jun  7 12:25:49 1991
***************
*** 1,11 ****
! /* $Header: popen.c,v 4.0 91/03/20 01:34:50 lwall Locked $
   *
   *    (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.
   *
   * $Log:	popen.c,v $
   * Revision 4.0  91/03/20  01:34:50  lwall
   * 4.0 baseline.
   * 
--- 1,14 ----
! /* $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 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: regcomp.c
*** regcomp.c.old	Fri Jun  7 12:26:29 1991
--- regcomp.c	Fri Jun  7 12:26:30 1991
***************
*** 7,15 ****
   * 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 $
   *
   * $Log:	regcomp.c,v $
   * Revision 4.0.1.1  91/04/12  09:04:45  lwall
   * patch1: random cleanup in cpp namespace
   * 
--- 7,20 ----
   * blame Henry for some of the lack of readability.
   */
  
! /* $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
   * 
***************
*** 41,50 ****
   *
   ****    Alterations to Henry's code are...
   ****
!  ****    Copyright (c) 1989, 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.
   *
   * Beware that some of this code is subtly aware of the way operator
   * precedence is structured in regular expressions.  Serious changes in
--- 46,56 ----
   *
   ****    Alterations to Henry's code are...
   ****
!  ****    Copyright (c) 1991, Larry Wall
   ****
!  ****    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,100 ****
--- 101,107 ----
  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,151 ****
--- 153,159 ----
  	extern char *safemalloc();
  	extern char *savestr();
  	int sawplus = 0;
+ 	int sawopen = 0;
  
  	if (exp == NULL)
  		fatal("NULL regexp argument");
***************
*** 156,161 ****
--- 164,170 ----
  	regxend = xend;
  	regprecomp = nsavestr(exp,xend-exp);
  	regsawbracket = 0;
+ 	regsawback = 0;
  	regnpar = 1;
  	regsize = 0L;
  	regcode = ®dummy;
***************
*** 178,185 ****
  	/* Second pass: emit code. */
  	if (regsawbracket)
  	    bcopy(regprecomp,exp,xend-exp);
  	r->precomp = regprecomp;
! 	r->subbase = NULL;
  	regparse = exp;
  	regnpar = 1;
  	regcode = r->program;
--- 187,195 ----
  	/* Second pass: emit code. */
  	if (regsawbracket)
  	    bcopy(regprecomp,exp,xend-exp);
+ 	r->prelen = xend-exp;
  	r->precomp = regprecomp;
! 	r->subbeg = r->subbase = NULL;
  	regparse = exp;
  	regnpar = 1;
  	regcode = r->program;
***************
*** 198,209 ****
  		scan = NEXTOPER(scan);
  
  		first = scan;
! 		while (OP(first) == OPEN ||
  		    (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
  		    (OP(first) == PLUS) ||
  		    (OP(first) == CURLY && ARG1(first) > 0) ) {
  			if (OP(first) == PLUS)
! 			    sawplus = 2;
  			else
  			    first += regarglen[OP(first)];
  			first = NEXTOPER(first);
--- 208,219 ----
  		scan = NEXTOPER(scan);
  
  		first = scan;
! 		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 = 1;
  			else
  			    first += regarglen[OP(first)];
  			first = NEXTOPER(first);
***************
*** 210,215 ****
--- 220,226 ----
  		}
  
  		/* Starting-point info. */
+ 	    again:
  		if (OP(first) == EXACTLY) {
  			r->regstart =
  			    str_make(OPERAND(first)+1,*OPERAND(first));
***************
*** 221,229 ****
  		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;
  
  #ifdef DEBUGGING
  		if (debug & 512)
--- 232,244 ----
  		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 = 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,746 ****
--- 756,762 ----
  			    if (num > 9 && num >= regnpar)
  				goto defchar;
  			    else {
+ 				regsawback = 1;
  				ret = reganode(REF, num);
  				while (isascii(*regparse) && isdigit(*regparse))
  				    regparse++;
***************
*** 1272,1280 ****
  		fprintf(stderr,"start `%s' ", r->regstart->str_ptr);
  	if (r->regstclass)
  		fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
! 	if (r->reganch & 1)
  		fprintf(stderr,"anchored ");
! 	if (r->reganch & 2)
  		fprintf(stderr,"plus ");
  	if (r->regmust != NULL)
  		fprintf(stderr,"must have \"%s\" back %d ", r->regmust->str_ptr,
--- 1288,1296 ----
  		fprintf(stderr,"start `%s' ", r->regstart->str_ptr);
  	if (r->regstclass)
  		fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
! 	if (r->reganch & ROPT_ANCH)
  		fprintf(stderr,"anchored ");
! 	if (r->reganch & ROPT_SKIP)
  		fprintf(stderr,"plus ");
  	if (r->regmust != NULL)
  		fprintf(stderr,"must have \"%s\" back %d ", r->regmust->str_ptr,

Index: regcomp.h
Prereq: 4.0
*** regcomp.h.old	Fri Jun  7 12:26:33 1991
--- regcomp.h	Fri Jun  7 12:26:34 1991
***************
*** 1,6 ****
! /* $Header: regcomp.h,v 4.0 91/03/20 01:39:09 lwall Locked $
   *
   * $Log:	regcomp.h,v $
   * Revision 4.0  91/03/20  01:39:09  lwall
   * 4.0 baseline.
   * 
--- 1,9 ----
! /* $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: regexec.c
*** regexec.c.old	Fri Jun  7 12:26:37 1991
--- regexec.c	Fri Jun  7 12:26:38 1991
***************
*** 7,15 ****
   * 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 $
   *
   * $Log:	regexec.c,v $
   * Revision 4.0.1.1  91/04/12  09:07:39  lwall
   * patch1: regexec only allocated space for 9 subexpresssions
   * 
--- 7,19 ----
   * blame Henry for some of the lack of readability.
   */
  
! /* $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
   * 
***************
*** 40,49 ****
   *
   ****    Alterations to Henry's code are...
   ****
!  ****    Copyright (c) 1989, 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.
   *
   * Beware that some of this code is subtly aware of the way operator
   * precedence is structured in regular expressions.  Serious changes in
--- 44,53 ----
   *
   ****    Alterations to Henry's code are...
   ****
!  ****    Copyright (c) 1991, Larry Wall
   ****
!  ****    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,157 ****
  	/* If there is a "must appear" string, look for it. */
  	s = string;
  	if (prog->regmust != Nullstr &&
! 	    (!(prog->reganch & 1) || (multiline && prog->regback >= 0)) ) {
  		if (stringarg == strbeg && screamer) {
  			if (screamfirst[prog->regmust->str_rare] >= 0)
  				s = screaminstr(screamer,prog->regmust);
--- 155,162 ----
  	/* If there is a "must appear" string, look for it. */
  	s = string;
  	if (prog->regmust != Nullstr &&
! 	    (!(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,219 ****
  
  	/* Simplest case:  anchored match need be tried only once. */
  	/*  [unless multiline is set] */
! 	if (prog->reganch & 1) {
  		if (regtry(prog, string))
  			goto got_it;
  		else if (multiline) {
--- 218,224 ----
  
  	/* Simplest case:  anchored match need be tried only once. */
  	/*  [unless multiline is set] */
! 	if (prog->reganch & ROPT_ANCH) {
  		if (regtry(prog, string))
  			goto got_it;
  		else if (multiline) {
***************
*** 235,241 ****
  
  	/* Messy cases:  unanchored match. */
  	if (prog->regstart) {
! 		if (prog->reganch & 2) {	/* we have /x+whatever/ */
  		    /* it must be a one character string */
  		    i = prog->regstart->str_ptr[0];
  		    while (s < strend) {
--- 240,246 ----
  
  	/* Messy cases:  unanchored match. */
  	if (prog->regstart) {
! 		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,281 ****
  		goto phooey;
  	}
  	if (c = prog->regstclass) {
! 		int doevery = (prog->reganch & 2) == 0;
  
  		if (minlen)
  		    dontbother = minlen - 1;
--- 280,286 ----
  		goto phooey;
  	}
  	if (c = prog->regstclass) {
! 		int doevery = (prog->reganch & ROPT_SKIP) == 0;
  
  		if (minlen)
  		    dontbother = minlen - 1;
***************
*** 445,451 ****
  		    s = nsavestr(strbeg,i);	/* so $digit will work later */
  		    if (prog->subbase)
  			    Safefree(prog->subbase);
! 		    prog->subbase = s;
  		    prog->subend = s+i;
  		}
  		else
--- 450,456 ----
  		    s = nsavestr(strbeg,i);	/* so $digit will work later */
  		    if (prog->subbase)
  			    Safefree(prog->subbase);
! 		    prog->subbeg = prog->subbase = s;
  		    prog->subend = s+i;
  		}
  		else

Index: regexp.h
Prereq: 4.0
*** regexp.h.old	Fri Jun  7 12:26:40 1991
--- regexp.h	Fri Jun  7 12:26:41 1991
***************
*** 5,13 ****
   * not the System V one.
   */
  
! /* $Header: regexp.h,v 4.0 91/03/20 01:39:23 lwall Locked $
   *
   * $Log:	regexp.h,v $
   * Revision 4.0  91/03/20  01:39:23  lwall
   * 4.0 baseline.
   * 
--- 5,18 ----
   * not the System V one.
   */
  
! /* $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,27 ****
--- 25,34 ----
  	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? */
***************
*** 29,34 ****
--- 36,44 ----
  	char nparens;		/* number of parentheses */
  	char program[1];	/* Unwarranted chumminess with compiler. */
  } regexp;
+ 
+ #define ROPT_ANCH 1
+ #define ROPT_SKIP 2
  
  regexp *regcomp();
  int regexec();

Index: x2p/s2p.SH
Prereq: 4.0
*** x2p/s2p.SH.old	Fri Jun  7 12:28:10 1991
--- x2p/s2p.SH	Fri Jun  7 12:28:11 1991
***************
*** 29,37 ****
  : 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 $
  #
  # $Log:	s2p.SH,v $
  # Revision 4.0  91/03/20  01:57:59  lwall
  # 4.0 baseline.
  # 
--- 29,40 ----
  : In the following dollars and backticks do not need the extra backslash.
  $spitshell >>s2p <<'!NO!SUBS!'
  
! # $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,98 ****
  }
  
  if (!$assumen && !$assumep) {
!     print BODY <<'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 (<>) {
  EOT
  
! LINE: while (<>) {
  
      # Wipe out surrounding whitespace.
  
--- 69,111 ----
  }
  
  if (!$assumen && !$assumep) {
!     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 &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 (<>) {
  
      # Wipe out surrounding whitespace.
  
***************
*** 105,110 ****
--- 118,127 ----
  	$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,132 ****
--- 144,150 ----
      $addr2 = '';
      if (s/^([0-9]+)//) {
  	$addr1 = "$1";
+ 	$addr1 = "\$. == $addr1" unless /^,/;
      }
      elsif (s/^\$//) {
  	$addr1 = 'eof()';
***************
*** 213,247 ****
      $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
! }
  EOT
  }
  
--- 231,269 ----
      $indent -= 4;
  }
  
  if ($appendseen || $tseen || !$assumen) {
      $printit++ if $dseen || (!$assumen && !$assumep);
!     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,261 ****
  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);
      if ($opens) {print HEAD "$opens\n";}
      open(BODY,"/tmp/sperl$$")
        || &Die("Can't reopen temp file: $!\n");
--- 272,285 ----
  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 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,274 ****
      }
      close HEAD;
  
!     print <<"EOT";
! #!$bin/perl
! eval 'exec $bin/perl -S \$0 \$*'
! 	if \$running_under_some_shell;
! 
  EOT
      open(BODY,"cc -E /tmp/sperl2$$.c |") ||
  	&Die("Can't reopen temp file: $!\n");
--- 288,298 ----
      }
      close HEAD;
  
!     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,311 ****
  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";
  EOT
      }
!     $seen{$_} = $_;
  }
  
  sub make_label {
--- 321,342 ----
  sub make_filehandle {
      local($_) = $_[0];
      local($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{$fname};
  }
  
  sub make_label {
***************
*** 325,364 ****
      {	# case
  	if (/^d/) {
  	    $dseen++;
! 	    chop($_ = <<'EOT');
! <<--#ifdef PRINTIT
! $printit = '';
! <<--#endif
! next LINE;
  EOT
  	    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
  EOT
  	    next;
  	}
--- 356,397 ----
      {	# case
  	if (/^d/) {
  	    $dseen++;
! 	    chop($_ = &q(<<'EOT'));
! :	<<--#ifdef PRINTIT
! :	$printit = 0;
! :	<<--#endif
! :	next LINE;
  EOT
+ 	    $sawnext++;
  	    next;
  	}
  
  	if (/^n/) {
! 	    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;
  	}
***************
*** 365,391 ****
  
  	if (/^a/) {
  	    $appendseen++;
! 	    $command = $space . '$atext .=' . "\n<<--'";
  	    $lastline = 0;
  	    while (<>) {
  		s/^[ \t]*//;
  		s/^[\\]//;
  		unless (s|\\$||) { $lastline = 1;}
- 		s/'/\\'/g;
  		s/^([ \t]*\n)/<><>$1/;
  		$command .= $_;
  		$command .= '<<--';
  		last if $lastline;
  	    }
! 	    $_ = $command . "';";
  	    last;
  	}
  
  	if (/^[ic]/) {
  	    if (/^c/) { $change = 1; }
  	    $addr1 = '$iter = (' . $addr1 . ')';
! 	    $command = $space . 'if ($iter == 1) { print'
! 	      . "\n<<--'";
  	    $lastline = 0;
  	    while (<>) {
  		s/^[ \t]*//;
--- 398,424 ----
  
  	if (/^a/) {
  	    $appendseen++;
! 	    $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
  	    $lastline = 0;
  	    while (<>) {
  		s/^[ \t]*//;
  		s/^[\\]//;
  		unless (s|\\$||) { $lastline = 1;}
  		s/^([ \t]*\n)/<><>$1/;
  		$command .= $_;
  		$command .= '<<--';
  		last if $lastline;
  	    }
! 	    $_ = $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 <<'End_Of_Text'; }\n<<--";
  	    $lastline = 0;
  	    while (<>) {
  		s/^[ \t]*//;
***************
*** 397,412 ****
  		$command .= '<<--';
  		last if $lastline;
  	    }
! 	    $_ = $command . "';}";
  	    if ($change) {
  		$dseen++;
  		$change = "$_\n";
! 		chop($_ = <<"EOT");
! <<--#ifdef PRINTIT
! $space\$printit = '';
! <<--#endif
! ${space}next LINE;
  EOT
  	    }
  	    last;
  	}
--- 430,446 ----
  		$command .= '<<--';
  		last if $lastline;
  	    }
! 	    $_ = $command . "End_Of_Text";
  	    if ($change) {
  		$dseen++;
  		$change = "$_\n";
! 		chop($_ = &q(<<"EOT"));
! :	<<--#ifdef PRINTIT
! :	$space\$printit = 0;
! :	<<--#endif
! :	${space}next LINE;
  EOT
+ 		$sawnext++;
  	    }
  	    last;
  	}
***************
*** 463,468 ****
--- 497,507 ----
  		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,479 ****
--- 513,519 ----
  	    $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,509 ****
  		&Die("Unrecognized substitution command".
  		  "($end) at line $.\n");
  	    }
! 	    chop ($_ = <<"EOT");
! <<--#ifdef TSEEN
! $subst && \$tflag++$cmd;
! <<--#else
! $subst$cmd;
! <<--#endif
  EOT
  	    next;
  	}
--- 538,549 ----
  		&Die("Unrecognized substitution command".
  		  "($end) at line $.\n");
  	    }
! 	    chop ($_ = &q(<<"EOT"));
! :	<<--#ifdef TSEEN
! :	$subst && \$tflag++$cmd;
! :	<<--#else
! :	$subst$cmd;
! :	<<--#endif
  EOT
  	    next;
  	}
***************
*** 529,553 ****
  	}
  
  	if (/^P/) {
! 	    $_ = 'print $1 if /(^.*\n)/;';
  	    next;
  	}
  
  	if (/^D/) {
! 	    chop($_ = <<'EOT');
! s/^.*\n//;
! redo LINE if $_;
! next LINE;
  EOT
  	    next;
  	}
  
  	if (/^N/) {
! 	    chop($_ = <<'EOT');
! $_ .= <>;
! <<--#ifdef TSEEN
! $tflag = '';
! <<--#endif
  EOT
  	    next;
  	}
--- 569,597 ----
  	}
  
  	if (/^P/) {
! 	    $_ = 'print $1 if /^(.*)/;';
  	    next;
  	}
  
  	if (/^D/) {
! 	    chop($_ = &q(<<'EOT'));
! :	s/^.*\n?//;
! :	redo LINE if $_;
! :	next LINE;
  EOT
+ 	    $sawnext++;
  	    next;
  	}
  
  	if (/^N/) {
! 	    chop($_ = &q(<<'EOT'));
! :	$_ .= "\n";
! :	$len1 = length;
! :	$_ .= <>;
! :	chop if $len1 < length;
! :	<<--#ifdef TSEEN
! :	$tflag = 0;
! :	<<--#endif
  EOT
  	    next;
  	}
***************
*** 558,564 ****
  	}
  
  	if (/^H/) {
! 	    $_ = '$hold .= $_ ? $_ : "\n";';
  	    next;
  	}
  
--- 602,608 ----
  	}
  
  	if (/^H/) {
! 	    $_ = '$hold .= "\n"; $hold .= $_;';
  	    next;
  	}
  
***************
*** 568,574 ****
  	}
  
  	if (/^G/) {
! 	    $_ = '$_ .= $hold ? $hold : "\n";';
  	    next;
  	}
  
--- 612,618 ----
  	}
  
  	if (/^G/) {
! 	    $_ = '$_ .= "\n"; $_ .= $hold;';
  	    next;
  	}
  
***************
*** 579,584 ****
--- 623,629 ----
  
  	if (/^b$/) {
  	    $_ = 'next LINE;';
+ 	    $sawnext++;
  	    next;
  	}
  
***************
*** 595,600 ****
--- 640,646 ----
  
  	if (/^t$/) {
  	    $_ = 'next LINE if $tflag;';
+ 	    $sawnext++;
  	    $tseen++;
  	    next;
  	}
***************
*** 602,608 ****
  	if (/^t/) {
  	    s/^t[ \t]*//;
  	    $lab = &make_label($_);
! 	    $_ = q/if ($tflag) {$tflag = ''; /;
  	    if ($lab eq $toplabel) {
  		$_ .= 'redo LINE;}';
  	    } else {
--- 648,654 ----
  	if (/^t/) {
  	    s/^t[ \t]*//;
  	    $lab = &make_label($_);
! 	    $_ = q/if ($tflag) {$tflag = 0; /;
  	    if ($lab eq $toplabel) {
  		$_ .= 'redo LINE;}';
  	    } else {
***************
*** 612,628 ****
  	    next;
  	}
  
  	if (/^=/) {
! 	    $_ = 'print "$.\n";';
  	    next;
  	}
  
  	if (/^q/) {
! 	    chop($_ = <<'EOT');
! close(ARGV);
! @ARGV = ();
! next LINE;
  EOT
  	    next;
  	}
      } continue {
--- 658,685 ----
  	    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 $.;';
  	    next;
  	}
  
  	if (/^q/) {
! 	    chop($_ = &q(<<'EOT'));
! :	close(ARGV);
! :	@ARGV = ();
! :	next LINE;
  EOT
+ 	    $sawnext++;
  	    next;
  	}
      } continue {
***************
*** 670,676 ****
--- 727,763 ----
  	    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!

Index: x2p/s2p.man
Prereq: 4.0
*** x2p/s2p.man.old	Fri Jun  7 12:28:14 1991
--- x2p/s2p.man	Fri Jun  7 12:28:14 1991
***************
*** 1,7 ****
  .rn '' }`
! ''' $Header: s2p.man,v 4.0 91/03/20 01:58:07 lwall Locked $
  ''' 
  ''' $Log:	s2p.man,v $
  ''' Revision 4.0  91/03/20  01:58:07  lwall
  ''' 4.0 baseline.
  ''' 
--- 1,10 ----
  .rn '' }`
! ''' $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,91 ****
--- 89,96 ----
  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

Index: hints/sco_2_3_0.sh
*** hints/sco_2_3_0.sh.old	Fri Jun  7 12:24:35 1991
--- hints/sco_2_3_0.sh	Fri Jun  7 12:24:36 1991
***************
*** 1,2 ****
! yacc='/usr/bin/yacc -m25000'
  i_dirent=undef
--- 1,2 ----
! yacc='/usr/bin/yacc -Sm25000'
  i_dirent=undef

Index: hints/sco_2_3_1.sh
*** hints/sco_2_3_1.sh.old	Fri Jun  7 12:24:38 1991
--- hints/sco_2_3_1.sh	Fri Jun  7 12:24:38 1991
***************
*** 1,2 ****
! yacc='/usr/bin/yacc -m25000'
  i_dirent=undef
--- 1,2 ----
! yacc='/usr/bin/yacc -Sm25000'
  i_dirent=undef

Index: hints/sco_2_3_2.sh
*** hints/sco_2_3_2.sh.old	Fri Jun  7 12:24:40 1991
--- hints/sco_2_3_2.sh	Fri Jun  7 12:24:41 1991
***************
*** 1,2 ****
! yacc='/usr/bin/yacc -m25000'
  libswanted=`echo $libswanted | sed 's/ x / /'`
--- 1,2 ----
! yacc='/usr/bin/yacc -Sm25000'
  libswanted=`echo $libswanted | sed 's/ x / /'`

Index: hints/sco_2_3_3.sh
*** hints/sco_2_3_3.sh.old	Fri Jun  7 12:24:43 1991
--- hints/sco_2_3_3.sh	Fri Jun  7 12:24:43 1991
***************
*** 1,2 ****
! yacc='/usr/bin/yacc -m25000'
  libswanted=`echo $libswanted | sed 's/ x / /'`
--- 1,4 ----
! 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: hints/sco_3.sh
*** hints/sco_3.sh.old	Fri Jun  7 12:24:46 1991
--- hints/sco_3.sh	Fri Jun  7 12:24:46 1991
***************
*** 1,3 ****
--- 1,4 ----
  yacc='/usr/bin/yacc -Sm11000'
  libswanted=`echo $libswanted | sed 's/ x / /'`
  i_varargs=undef
+ ccflags="$ccflags -U M_XENIX"

Index: hints/sgi.sh
*** hints/sgi.sh.old	Fri Jun  7 12:24:48 1991
--- hints/sgi.sh	Fri Jun  7 12:24:49 1991
***************
*** 1,7 ****
! optimize='-O0'
  usemymalloc='y'
  mallocsrc='malloc.c'
  mallocobj='malloc.o'
- ccflags="$ccflags -Uf_next"
  d_voidsig=define
  d_vfork=undef
--- 1,6 ----
! optimize='-O1'
  usemymalloc='y'
  mallocsrc='malloc.c'
  mallocobj='malloc.o'
  d_voidsig=define
  d_vfork=undef

Index: lib/shellwords.pl
*** lib/shellwords.pl.old	Fri Jun  7 12:25:22 1991
--- lib/shellwords.pl	Fri Jun  7 12:25:23 1991
***************
*** 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: spat.h
Prereq: 4.0
*** spat.h.old	Fri Jun  7 12:26:43 1991
--- spat.h	Fri Jun  7 12:26:44 1991
***************
*** 1,11 ****
! /* $Header: spat.h,v 4.0 91/03/20 01:39:36 lwall Locked $
   *
!  *    Copyright (c) 1989, 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.
   *
   * $Log:	spat.h,v $
   * Revision 4.0  91/03/20  01:39:36  lwall
   * 4.0 baseline.
   * 
--- 1,15 ----
! /* $RCSfile: spat.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:51:59 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    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,23 ****
      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;
      char	spat_slen;
  };
  
--- 21,27 ----
      ARG		*spat_repl;		/* replacement string for subst */
      ARG		*spat_runtime;		/* compile pattern at runtime */
      STR		*spat_short;		/* for a fast bypass of execute() */
!     short	spat_flags;
      char	spat_slen;
  };
  
***************
*** 29,34 ****
--- 33,39 ----
  #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 */

Index: stab.c
*** stab.c.old	Fri Jun  7 12:26:47 1991
--- stab.c	Fri Jun  7 12:26:47 1991
***************
*** 1,11 ****
! /* $RCSfile: stab.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:10:24 $
   *
!  *    Copyright (c) 1989, 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.
   *
   * $Log:	stab.c,v $
   * 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
--- 1,20 ----
! /* $RCSfile: stab.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:55:53 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    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,59 ****
--- 63,71 ----
  	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);
***************
*** 60,65 ****
--- 72,80 ----
  	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,99 ****
      case '`':
  	if (curspat) {
  	    if (curspat->spat_regexp &&
! 	      (s = curspat->spat_regexp->subbase) ) {
  		i = curspat->spat_regexp->startp[0] - s;
  		if (i >= 0)
  		    str_nset(stab_val(stab),s,i);
--- 108,114 ----
      case '`':
  	if (curspat) {
  	    if (curspat->spat_regexp &&
! 	      (s = curspat->spat_regexp->subbeg) ) {
  		i = curspat->spat_regexp->startp[0] - s;
  		if (i >= 0)
  		    str_nset(stab_val(stab),s,i);
***************
*** 126,135 ****
  	break;
      case '^':
  	s = stab_io(curoutstab)->top_name;
! 	str_set(stab_val(stab),s);
  	break;
      case '~':
  	s = stab_io(curoutstab)->fmt_name;
  	str_set(stab_val(stab),s);
  	break;
  #ifndef lint
--- 141,157 ----
  	break;
      case '^':
  	s = stab_io(curoutstab)->top_name;
! 	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,220 ****
--- 237,312 ----
      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,341 ****
--- 426,438 ----
  	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,349 ****
--- 441,449 ----
  	    else
  		inplace = Nullch;
  	    break;
+ 	case '\020':	/* ^P */
+ 	    perldb = (int)str_gnum(str);
+ 	    break;
  	case '\024':	/* ^T */
  	    basetime = (long)str_gnum(str);
  	    break;
***************
*** 430,441 ****
  	    break;
  	case '<':
  	    uid = (int)str_gnum(str);
! #ifdef HAS_SETREUID
  	    if (delaymagic) {
  		delaymagic |= DM_REUID;
  		break;				/* don't do magic till later */
  	    }
! #endif /* HAS_SETREUID */
  #ifdef HAS_SETRUID
  	    if (setruid((UIDTYPE)uid) < 0)
  		uid = (int)getuid();
--- 530,541 ----
  	    break;
  	case '<':
  	    uid = (int)str_gnum(str);
! #if defined(HAS_SETREUID) || !defined(HAS_SETRUID)
  	    if (delaymagic) {
  		delaymagic |= DM_REUID;
  		break;				/* don't do magic till later */
  	    }
! #endif /* HAS_SETREUID or not HASSETRUID */
  #ifdef HAS_SETRUID
  	    if (setruid((UIDTYPE)uid) < 0)
  		uid = (int)getuid();
***************
*** 453,464 ****
  	    break;
  	case '>':
  	    euid = (int)str_gnum(str);
! #ifdef HAS_SETREUID
  	    if (delaymagic) {
  		delaymagic |= DM_REUID;
  		break;				/* don't do magic till later */
  	    }
! #endif /* HAS_SETREUID */
  #ifdef HAS_SETEUID
  	    if (seteuid((UIDTYPE)euid) < 0)
  		euid = (int)geteuid();
--- 553,564 ----
  	    break;
  	case '>':
  	    euid = (int)str_gnum(str);
! #if defined(HAS_SETREUID) || !defined(HAS_SETEUID)
  	    if (delaymagic) {
  		delaymagic |= DM_REUID;
  		break;				/* don't do magic till later */
  	    }
! #endif /* HAS_SETREUID or not HAS_SETEUID */
  #ifdef HAS_SETEUID
  	    if (seteuid((UIDTYPE)euid) < 0)
  		euid = (int)geteuid();
***************
*** 476,487 ****
  	    break;
  	case '(':
  	    gid = (int)str_gnum(str);
! #ifdef HAS_SETREGID
  	    if (delaymagic) {
  		delaymagic |= DM_REGID;
  		break;				/* don't do magic till later */
  	    }
! #endif /* HAS_SETREGID */
  #ifdef HAS_SETRGID
  	    (void)setrgid((GIDTYPE)gid);
  #else
--- 576,587 ----
  	    break;
  	case '(':
  	    gid = (int)str_gnum(str);
! #if defined(HAS_SETREGID) || !defined(HAS_SETRGID)
  	    if (delaymagic) {
  		delaymagic |= DM_REGID;
  		break;				/* don't do magic till later */
  	    }
! #endif /* HAS_SETREGID or not HAS_SETRGID */
  #ifdef HAS_SETRGID
  	    (void)setrgid((GIDTYPE)gid);
  #else
***************
*** 494,505 ****
  	    break;
  	case ')':
  	    egid = (int)str_gnum(str);
! #ifdef HAS_SETREGID
  	    if (delaymagic) {
  		delaymagic |= DM_REGID;
  		break;				/* don't do magic till later */
  	    }
! #endif /* HAS_SETREGID */
  #ifdef HAS_SETEGID
  	    (void)setegid((GIDTYPE)egid);
  #else
--- 594,605 ----
  	    break;
  	case ')':
  	    egid = (int)str_gnum(str);
! #if defined(HAS_SETREGID) || !defined(HAS_SETEGID)
  	    if (delaymagic) {
  		delaymagic |= DM_REGID;
  		break;				/* don't do magic till later */
  	    }
! #endif /* HAS_SETREGID or not HAS_SETEGID */
  #ifdef HAS_SETEGID
  	    (void)setegid((GIDTYPE)egid);
  #else

*** End of Patch 8 ***



More information about the Comp.sources.bugs mailing list