System: perl version 3.0
Patch #: 12
Priority: HIGH
Subject: patch #9, continued

Description:
	See patch #9.


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:
		rm config.sh		(on Mips cpus running Ultrix)
		Configure -d
		make depend
		make
		make test
		make install

	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@jpl-devvax.jpl.nasa.gov

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

	Subject: Command
	@SH mailpatch PATH perl 3.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.


	You can also get the patches via anonymous FTP from
	jpl-devvax.jpl.nasa.gov (128.149.1.143).

Index: patchlevel.h
Prereq: 11
1c1
< #define PATCHLEVEL 11
---
> #define PATCHLEVEL 12

Index: eg/relink
*** eg/relink.old	Thu Mar  1 10:50:45 1990
--- eg/relink	Thu Mar  1 10:50:47 1990
***************
*** 0 ****
--- 1,24 ----
+ #!/usr/bin/perl
+ 
+ ($op = shift) || die "Usage: relink perlexpr [filenames]\n";
+ if (!@ARGV) {
+     if (-t) {
+ 	@ARGV = <*>;
+     }
+     else {
+ 	@ARGV = <STDIN>;
+ 	chop(@ARGV);
+     }
+ }
+ for (@ARGV) {
+     next unless -l;		# symbolic link?
+     $name = $_;
+     $_ = readlink($_);
+     $was = $_;
+     eval $op;
+     die $@ if $@;
+     if ($was ne $_) {
+ 	unlink($name);
+ 	symlink($_, $name);
+     }
+ }

Index: eg/rename
*** eg/rename.old	Thu Mar  1 10:50:41 1990
--- eg/rename	Thu Mar  1 10:50:42 1990
***************
*** 1,9 ****
  #!/usr/bin/perl
  
  ($op = shift) || die "Usage: rename perlexpr [filenames]\n";
! if ($#ARGV < 0) {
!     @ARGV = <stdin>;
!     chop(@ARGV);
  }
  for (@ARGV) {
      $was = $_;
--- 1,14 ----
  #!/usr/bin/perl
  
  ($op = shift) || die "Usage: rename perlexpr [filenames]\n";
! if (!@ARGV) {
!     if (-t) {
! 	@ARGV = <*>;
!     }
!     else {
! 	@ARGV = <STDIN>;
! 	chop(@ARGV);
!     }
  }
  for (@ARGV) {
      $was = $_;

Index: x2p/s2p.SH
Prereq: 3.0.1.2
*** x2p/s2p.SH.old	Thu Mar  1 10:56:24 1990
--- x2p/s2p.SH	Thu Mar  1 10:56:26 1990
***************
*** 28,36 ****
  : In the following dollars and backticks do not need the extra backslash.
  $spitshell >>s2p <<'!NO!SUBS!'
  
! # $Header: s2p.SH,v 3.0.1.2 89/11/17 15:51:27 lwall Locked $
  #
  # $Log:	s2p.SH,v $
  # Revision 3.0.1.2  89/11/17  15:51:27  lwall
  # patch5: in s2p, line labels without a subsequent statement were done wrong
  # patch5: s2p left residue in /tmp
--- 28,39 ----
  : In the following dollars and backticks do not need the extra backslash.
  $spitshell >>s2p <<'!NO!SUBS!'
  
! # $Header: s2p.SH,v 3.0.1.3 90/03/01 10:31:21 lwall Locked $
  #
  # $Log:	s2p.SH,v $
+ # Revision 3.0.1.3  90/03/01  10:31:21  lwall
+ # patch9: s2p didn't handle \< and \>
+ # 
  # Revision 3.0.1.2  89/11/17  15:51:27  lwall
  # patch5: in s2p, line labels without a subsequent statement were done wrong
  # patch5: s2p left residue in /tmp
***************
*** 426,431 ****
--- 429,437 ----
  			$len--;
  			$_ = substr($_,0,$i) . substr($_,$i+1,10000);
  		    }
+ 		    elsif (!$repl && substr($_,$i,1) =~ /^[<>]$/) {
+ 			substr($_,$i,1) = 'b';
+ 		    }
  		}
  		elsif ($c eq '[' && !$repl) {
  		    $i++ if substr($_,$i,1) eq '^';
***************
*** 607,613 ****
  	    s/(.)//;
  	    $ch = $1;
  	    $delim = '' if $ch =~ /^[(){}\w]$/;
! 	    $delim .= $1;
  	}
  	elsif ($delim eq '[') {
  	    $inbracket = 1;
--- 613,620 ----
  	    s/(.)//;
  	    $ch = $1;
  	    $delim = '' if $ch =~ /^[(){}\w]$/;
! 	    $ch = 'b' if $ch =~ /^[<>]$/;
! 	    $delim .= $ch;
  	}
  	elsif ($delim eq '[') {
  	    $inbracket = 1;

Index: stab.c
Prereq: 3.0.1.3
*** stab.c.old	Thu Mar  1 10:54:18 1990
--- stab.c	Thu Mar  1 10:54:21 1990
***************
*** 1,4 ****
! /* $Header: stab.c,v 3.0.1.3 89/12/21 20:18:40 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: stab.c,v 3.0.1.4 90/02/28 18:19:14 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,18 ----
   *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	stab.c,v $
+  * Revision 3.0.1.4  90/02/28  18:19:14  lwall
+  * patch9: $0 is now always the command name
+  * patch9: you may now undef $/ to have no input record separator
+  * patch9: local($.) didn't work
+  * patch9: sometimes perl thought ordinary data was a symbol table entry
+  * patch9: stab_array() and stab_hash() weren't defined on MICROPORT
+  * 
   * Revision 3.0.1.3  89/12/21  20:18:40  lwall
   * patch7: ANSI strerror() is now supported
   * patch7: errno may now be a macro with an lvalue
***************
*** 50,56 ****
  	return stab_val(stab);
  
      switch (*stab->str_magic->str_ptr) {
!     case '0': 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));
--- 57,63 ----
  	return stab_val(stab);
  
      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));
***************
*** 128,136 ****
  	break;
  #endif
      case '/':
! 	*tokenbuf = record_separator;
! 	tokenbuf[1] = '\0';
! 	str_nset(stab_val(stab),tokenbuf,rslen);
  	break;
      case '[':
  	str_numset(stab_val(stab),(double)arybase);
--- 135,145 ----
  	break;
  #endif
      case '/':
! 	if (record_separator != 12345) {
! 	    *tokenbuf = record_separator;
! 	    tokenbuf[1] = '\0';
! 	    str_nset(stab_val(stab),tokenbuf,rslen);
! 	}
  	break;
      case '[':
  	str_numset(stab_val(stab),(double)arybase);
***************
*** 228,234 ****
  	break;
      case '*':
  	s = str_get(str);
! 	if (strnNE(s,"Stab",4) || str->str_cur != sizeof(STBP)) {
  	    if (!*s) {
  		STBP *stbp;
  
--- 237,243 ----
  	break;
      case '*':
  	s = str_get(str);
! 	if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
  	    if (!*s) {
  		STBP *stbp;
  
***************
*** 239,245 ****
  		stab->str_ptr = stbp;
  		stab->str_len = stab->str_cur = sizeof(STBP);
  		stab->str_pok = 1;
! 		strncpy(stab_magic(stab),"Stab",4);
  		stab_val(stab) = Str_new(70,0);
  		stab_line(stab) = line;
  	    }
--- 248,254 ----
  		stab->str_ptr = stbp;
  		stab->str_len = stab->str_cur = sizeof(STBP);
  		stab->str_pok = 1;
! 		strcpy(stab_magic(stab),"StB");
  		stab_val(stab) = Str_new(70,0);
  		stab_line(stab) = line;
  	    }
***************
*** 264,269 ****
--- 273,282 ----
  
      case 0:
  	switch (*stab->str_magic->str_ptr) {
+ 	case '.':
+ 	    if (localizing)
+ 		savesptr((STR**)&last_in_stab);
+ 	    break;
  	case '^':
  	    Safefree(stab_io(curoutstab)->top_name);
  	    stab_io(curoutstab)->top_name = s = savestr(str_get(str));
***************
*** 296,303 ****
  	    multiline = (i != 0);
  	    break;
  	case '/':
! 	    record_separator = *str_get(str);
! 	    rslen = str->str_cur;
  	    break;
  	case '\\':
  	    if (ors)
--- 309,322 ----
  	    multiline = (i != 0);
  	    break;
  	case '/':
! 	    if (str->str_ptr) {
! 		record_separator = *str_get(str);
! 		rslen = str->str_cur;
! 	    }
! 	    else {
! 		record_separator = 12345;	/* fake a non-existent char */
! 		rslen = 1;
! 	    }
  	    break;
  	case '\\':
  	    if (ors)
***************
*** 588,594 ****
  	stab->str_ptr = stbp;
  	stab->str_len = stab->str_cur = sizeof(STBP);
  	stab->str_pok = 1;
! 	strncpy(stab_magic(stab),"Stab",4);
  	stab_val(stab) = Str_new(72,0);
  	stab_line(stab) = line;
  	str_magic(stab,stab,'*',name,len);
--- 607,613 ----
  	stab->str_ptr = stbp;
  	stab->str_len = stab->str_cur = sizeof(STBP);
  	stab->str_pok = 1;
! 	strcpy(stab_magic(stab),"StB");
  	stab_val(stab) = Str_new(72,0);
  	stab_line(stab) = line;
  	str_magic(stab,stab,'*',name,len);
***************
*** 661,663 ****
--- 680,705 ----
      stab->str_cur = 0;
  }
  
+ #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
+ #define MICROPORT
+ #endif
+ 
+ #ifdef	MICROPORT	/* Microport 2.4 hack */
+ ARRAY *stab_array(stab)
+ register STAB *stab;
+ {
+     if (((STBP*)(stab->str_ptr))->stbp_array) 
+ 	return ((STBP*)(stab->str_ptr))->stbp_array;
+     else
+ 	return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
+ }
+ 
+ HASH *stab_hash(stab)
+ register STAB *stab;
+ {
+     if (((STBP*)(stab->str_ptr))->stbp_hash)
+ 	return ((STBP*)(stab->str_ptr))->stbp_hash;
+     else
+ 	return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
+ }
+ #endif			/* Microport 2.4 hack */

Index: str.c
Prereq: 3.0.1.4
*** str.c.old	Thu Mar  1 10:54:32 1990
--- str.c	Thu Mar  1 10:54:36 1990
***************
*** 1,4 ****
! /* $Header: str.c,v 3.0.1.4 89/12/21 20:21:35 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: str.c,v 3.0.1.5 90/02/28 18:30:38 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,12 ****
   *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	str.c,v $
!  * Revision 3.0.1.4  89/12/21  20:21:35  lwall
   * patch7: errno may now be a macro with an lvalue
   * patch7: made nested or recursive foreach work right
   * 
--- 6,21 ----
   *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	str.c,v $
!  * Revision 3.0.1.5  90/02/28  18:30:38  lwall
!  * patch9: you may now undef $/ to have no input record separator
!  * patch9: nested evals clobbered their longjmp environment
!  * patch9: sometimes perl thought ordinary data was a symbol table entry
!  * patch9: insufficient space allocated for numeric string on sun4
!  * patch9: underscore in an array name in a double-quoted string not recognized
!  * patch9: "@foo{}" not recognized unless %foo defined
!  * patch9: "$foo[$[]" gives error
!  * 
!  * Revision 3.0.1.4  89/12/21  20:21:35  lwall
   * patch7: errno may now be a macro with an lvalue
   * patch7: made nested or recursive foreach work right
   * 
***************
*** 129,135 ****
--- 138,152 ----
      if (!str)
  	return "";
      if (str->str_nok) {
+ /* this is a problem on the sun 4... 24 bytes is not always enough and the
+ 	exponent blows away the malloc stack
+ 	PEJ Wed Jan 31 18:41:34 CST 1990
+ */
+ #ifdef sun4
+ 	STR_GROW(str, 30);
+ #else
  	STR_GROW(str, 24);
+ #endif /* sun 4 */
  	s = str->str_ptr;
  	olderrno = errno;	/* some Xenix systems wipe out errno here */
  #if defined(scs) && defined(ns32000)
***************
*** 144,149 ****
--- 161,170 ----
  #endif /*scs*/
  	errno = olderrno;
  	while (*s) s++;
+ #ifdef hcx
+ 	if (s[-1] == '.')
+ 	    s--;
+ #endif
      }
      else {
  	if (str == &str_undef)
***************
*** 150,156 ****
--- 171,181 ----
  	    return No;
  	if (dowarn)
  	    warn("Use of uninitialized variable");
+ #ifdef sun4
+ 	STR_GROW(str, 30);
+ #else
  	STR_GROW(str, 24);
+ #endif
  	s = str->str_ptr;
      }
      *s = '\0';
***************
*** 194,199 ****
--- 219,226 ----
  #ifdef TAINT
      tainted |= sstr->str_tainted;
  #endif
+     if (sstr == dstr)
+ 	return;
      if (!sstr)
  	dstr->str_pok = dstr->str_nok = 0;
      else if (sstr->str_pok) {
***************
*** 206,212 ****
  	else if (sstr->str_cur == sizeof(STBP)) {
  	    char *tmps = sstr->str_ptr;
  
! 	    if (*tmps == 'S' && bcmp(tmps,"Stab",4) == 0) {
  		dstr->str_magic = str_smake(sstr->str_magic);
  		dstr->str_magic->str_rare = 'X';
  	    }
--- 233,239 ----
  	else if (sstr->str_cur == sizeof(STBP)) {
  	    char *tmps = sstr->str_ptr;
  
! 	    if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
  		dstr->str_magic = str_smake(sstr->str_magic);
  		dstr->str_magic->str_rare = 'X';
  	    }
***************
*** 642,648 ****
      register char *bp;		/* we're going to steal some values */
      register int cnt;		/*  from the stdio struct and put EVERYTHING */
      register STDCHAR *ptr;	/*   in the innermost loop into registers */
!     register char newline = record_separator;/* (assuming >= 6 registers) */
      int i;
      int bpx;
      int obpx;
--- 669,675 ----
      register char *bp;		/* we're going to steal some values */
      register int cnt;		/*  from the stdio struct and put EVERYTHING */
      register STDCHAR *ptr;	/*   in the innermost loop into registers */
!     register int newline = record_separator;/* (assuming >= 6 registers) */
      int i;
      int bpx;
      int obpx;
***************
*** 742,756 ****
      register ARG *arg;
      line_t oldline = line;
      int retval;
  
      str_sset(linestr,str);
      in_eval++;
      oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
      bufend = bufptr + linestr->str_cur;
!     if (setjmp(eval_env)) {
! 	in_eval = 0;
  	fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
      }
      error_count = 0;
      retval = yyparse();
      in_eval--;
--- 769,804 ----
      register ARG *arg;
      line_t oldline = line;
      int retval;
+     char *tmps;
  
      str_sset(linestr,str);
      in_eval++;
      oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
      bufend = bufptr + linestr->str_cur;
!     if (++loop_ptr >= loop_max) {
!         loop_max += 128;
!         Renew(loop_stack, loop_max, struct loop);
!     }
!     loop_stack[loop_ptr].loop_label = "_EVAL_";
!     loop_stack[loop_ptr].loop_sp = 0;
! #ifdef DEBUGGING
!     if (debug & 4) {
!         deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
!     }
! #endif
!     if (setjmp(loop_stack[loop_ptr].loop_env)) {
! 	in_eval--;
! 	loop_ptr--;
  	fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
      }
+ #ifdef DEBUGGING
+     if (debug & 4) {
+ 	tmps = loop_stack[loop_ptr].loop_label;
+ 	deb("(Popping label #%d %s)\n",loop_ptr,
+ 	    tmps ? tmps : "" );
+     }
+ #endif
+     loop_ptr--;
      error_count = 0;
      retval = yyparse();
      in_eval--;
***************
*** 803,813 ****
  	  s+1 < send) {
  	    str_ncat(str,t,s-t);
  	    t = s;
! 	    if (*s == '$' && s[1] == '#' && isalpha(s[2]) || s[2] == '_')
  		s++;
  	    s = scanreg(s,send,tokenbuf);
  	    if (*t == '@' &&
! 	      (!(stab = stabent(tokenbuf,FALSE)) || !stab_xarray(stab)) ) {
  		str_ncat(str,"@",1);
  		s = ++t;
  		continue;	/* grandfather @ from old scripts */
--- 851,862 ----
  	  s+1 < send) {
  	    str_ncat(str,t,s-t);
  	    t = s;
! 	    if (*s == '$' && s[1] == '#' && (isalpha(s[2]) || s[2] == '_'))
  		s++;
  	    s = scanreg(s,send,tokenbuf);
  	    if (*t == '@' &&
! 	      (!(stab = stabent(tokenbuf,FALSE)) || 
! 		 (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) {
  		str_ncat(str,"@",1);
  		s = ++t;
  		continue;	/* grandfather @ from old scripts */
***************
*** 821,830 ****
  		checkpoint = s;
  		do {
  		    switch (*s) {
! 		    case '[': case '{':
  			brackets++;
  			break;
! 		    case ']': case '}':
  			brackets--;
  			break;
  		    case '\'':
--- 870,887 ----
  		checkpoint = s;
  		do {
  		    switch (*s) {
! 		    case '[':
! 			if (s[-1] != '$')
! 			    brackets++;
! 			break;
! 		    case '{':
  			brackets++;
  			break;
! 		    case ']':
! 			if (s[-1] != '$')
! 			    brackets--;
! 			break;
! 		    case '}':
  			brackets--;
  			break;
  		    case '\'':

Index: lib/termcap.pl
Prereq: 3.0
*** lib/termcap.pl.old	Thu Mar  1 10:52:11 1990
--- lib/termcap.pl	Thu Mar  1 10:52:12 1990
***************
*** 1,13 ****
! ;# $Header: termcap.pl,v 3.0 89/10/18 15:19:58 lwall Locked $
  ;#
  ;# Usage:
  ;#	do 'ioctl.pl';
  ;#	ioctl(TTY,$TIOCGETP,$foo);
  ;#	($ispeed,$ospeed) = unpack('cc',$foo);
! ;#	do 'termcap.pl';
! ;#	do Tgetent('vt100');	# sets $TC{'cm'}, etc.
! ;#	do Tgoto($TC{'cm'},$row,$col);
! ;#	do Tputs($TC{'dl'},$affcnt,'FILEHANDLE');
  ;#
  sub Tgetent {
      local($TERM) = @_;
--- 1,13 ----
! ;# $Header: termcap.pl,v 3.0.1.1 90/02/28 17:46:44 lwall Locked $
  ;#
  ;# Usage:
  ;#	do 'ioctl.pl';
  ;#	ioctl(TTY,$TIOCGETP,$foo);
  ;#	($ispeed,$ospeed) = unpack('cc',$foo);
! ;#	do 'termcap.pl' || die "Can't get termcap.pl";
! ;#	&Tgetent('vt100');	# sets $TC{'cm'}, etc.
! ;#	&Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE');
! ;#	&Tputs($TC{'dl'},$affcnt,'FILEHANDLE');
  ;#
  sub Tgetent {
      local($TERM) = @_;
***************
*** 47,53 ****
  	    \$entry .= \$_;
  	    ";
  	    eval $loop;
! 	} while s/:tc=([^:]+):/:/, $TERM = $1;
  	$TERMCAP = $entry;
      }
  
--- 47,53 ----
  	    \$entry .= \$_;
  	    ";
  	    eval $loop;
! 	} while s/:tc=([^:]+):/:/ && ($TERM = $1);
  	$TERMCAP = $entry;
      }
  
***************
*** 70,76 ****
  	    s/\\f/\f/g;
  	    s/\\\^/\377/g;
  	    s/\^\?/\177/g;
! 	    s/\^(.)/pack('c',$1 & 031)/eg;
  	    s/\\(.)/$1/g;
  	    s/\377/^/g;
  	    $TC{$entry} = $_ if $TC{$entry} eq '';
--- 70,76 ----
  	    s/\\f/\f/g;
  	    s/\\\^/\377/g;
  	    s/\^\?/\177/g;
! 	    s/\^(.)/pack('c',$1 & 31)/eg;
  	    s/\\(.)/$1/g;
  	    s/\377/^/g;
  	    $TC{$entry} = $_ if $TC{$entry} eq '';
***************
*** 104,110 ****
      local($result) = '';
      local($after) = '';
      local($code,$tmp) = @_;
!     @_ = ($tmp,$code);
      local($online) = 0;
      while ($string =~ /^([^%]*)%(.)(.*)/) {
  	$result .= $1;
--- 104,111 ----
      local($result) = '';
      local($after) = '';
      local($code,$tmp) = @_;
!     local(@tmp);
!     @tmp = ($tmp,$code);
      local($online) = 0;
      while ($string =~ /^([^%]*)%(.)(.*)/) {
  	$result .= $1;
***************
*** 111,120 ****
  	$code = $2;
  	$string = $3;
  	if ($code eq 'd') {
! 	    $result .= sprintf("%d",shift(@_));
  	}
  	elsif ($code eq '.') {
! 	    $tmp = shift(@_);
  	    if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
  		if ($online) {
  		    ++$tmp, $after .= $TC{'up'} if $TC{'up'};
--- 112,121 ----
  	$code = $2;
  	$string = $3;
  	if ($code eq 'd') {
! 	    $result .= sprintf("%d",shift(@tmp));
  	}
  	elsif ($code eq '.') {
! 	    $tmp = shift(@tmp);
  	    if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
  		if ($online) {
  		    ++$tmp, $after .= $TC{'up'} if $TC{'up'};
***************
*** 127,158 ****
  	    $online = !$online;
  	}
  	elsif ($code eq '+') {
! 	    $result .= sprintf("%c",shift(@_)+ord($string));
  	    $string = substr($string,1,99);
  	    $online = !$online;
  	}
  	elsif ($code eq 'r') {
! 	    ($code,$tmp) = @_;
! 	    @_ = ($tmp,$code);
  	    $online = !$online;
  	}
  	elsif ($code eq '>') {
  	    ($code,$tmp,$string) = unpack("CCa99",$string);
! 	    if ($_[$[] > $code) {
! 		$_[$[] += $tmp;
  	    }
  	}
  	elsif ($code eq '2') {
! 	    $result .= sprintf("%02d",shift(@_));
  	    $online = !$online;
  	}
  	elsif ($code eq '3') {
! 	    $result .= sprintf("%03d",shift(@_));
  	    $online = !$online;
  	}
  	elsif ($code eq 'i') {
! 	    ($code,$tmp) = @_;
! 	    @_ = ($code+1,$tmp+1);
  	}
  	else {
  	    return "OOPS";
--- 128,159 ----
  	    $online = !$online;
  	}
  	elsif ($code eq '+') {
! 	    $result .= sprintf("%c",shift(@tmp)+ord($string));
  	    $string = substr($string,1,99);
  	    $online = !$online;
  	}
  	elsif ($code eq 'r') {
! 	    ($code,$tmp) = @tmp;
! 	    @tmp = ($tmp,$code);
  	    $online = !$online;
  	}
  	elsif ($code eq '>') {
  	    ($code,$tmp,$string) = unpack("CCa99",$string);
! 	    if ($tmp[$[] > $code) {
! 		$tmp[$[] += $tmp;
  	    }
  	}
  	elsif ($code eq '2') {
! 	    $result .= sprintf("%02d",shift(@tmp));
  	    $online = !$online;
  	}
  	elsif ($code eq '3') {
! 	    $result .= sprintf("%03d",shift(@tmp));
  	    $online = !$online;
  	}
  	elsif ($code eq 'i') {
! 	    ($code,$tmp) = @tmp;
! 	    @tmp = ($code+1,$tmp+1);
  	}
  	else {
  	    return "OOPS";

Index: toke.c
Prereq: 3.0.1.4
*** toke.c.old	Thu Mar  1 10:55:22 1990
--- toke.c	Thu Mar  1 10:55:28 1990
***************
*** 1,4 ****
! /* $Header: toke.c,v 3.0.1.4 89/12/21 20:26:56 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: toke.c,v 3.0.1.5 90/02/28 18:47:06 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,18 ----
   *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	toke.c,v $
+  * Revision 3.0.1.5  90/02/28  18:47:06  lwall
+  * patch9: return grandfathered to never be function call
+  * patch9: non-existent perldb.pl now gives reasonable error message
+  * patch9: perl can now start up other interpreters scripts
+  * patch9: line numbers were bogus during certain portions of foreach evaluation
+  * patch9: null hereis core dumped
+  * 
   * Revision 3.0.1.4  89/12/21  20:26:56  lwall
   * patch7: -d switch incompatible with -p or -n
   * patch7: " ''$foo'' " didn't parse right
***************
*** 78,83 ****
--- 85,92 ----
  #define LOP(f) return(*s == '(' || (s = skipspace(s), *s == '(') ? \
  	(*s = META('('), bufptr = oldbufptr, '(') : \
  	(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
+ /* grandfather return to old style */
+ #define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
  
  char *
  skipspace(s)
***************
*** 171,177 ****
  	    if (minus_n || minus_p || perldb) {
  		str_set(linestr,"");
  		if (perldb)
! 		    str_cat(linestr,"do 'perldb.pl'; print $@;");
  		if (minus_n || minus_p) {
  		    str_cat(linestr,"line: while (<>) {");
  		    if (minus_a)
--- 180,187 ----
  	    if (minus_n || minus_p || perldb) {
  		str_set(linestr,"");
  		if (perldb)
! 		    str_cat(linestr,
! "do 'perldb.pl' || die \"Can't find perldb.pl in @INC\"; print $@;");
  		if (minus_n || minus_p) {
  		    str_cat(linestr,"line: while (<>) {");
  		    if (minus_a)
***************
*** 222,233 ****
  	}
  #endif
  	bufend = linestr->str_ptr + linestr->str_cur;
! 	if (firstline) {
! 	    while (s < bufend && isspace(*s))
! 		s++;
! 	    if (*s == ':')	/* for csh's that have to exec sh scripts */
! 		s++;
! 	    firstline = FALSE;
  	}
  	goto retry;
      case ' ': case '\t': case '\f':
--- 232,273 ----
  	}
  #endif
  	bufend = linestr->str_ptr + linestr->str_cur;
! 	if (line == 1) {
! 	    if (*s == '#' && s[1] == '!') {
! 		if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
! 		    char **newargv;
! 		    char *cmd;
! 
! 		    s += 2;
! 		    if (*s == ' ')
! 			s++;
! 		    cmd = s;
! 		    while (s < bufend && !isspace(*s))
! 			s++;
! 		    *s++ = '\0';
! 		    while (s < bufend && isspace(*s))
! 			s++;
! 		    if (s < bufend) {
! 			Newz(899,newargv,origargc+3,char*);
! 			newargv[1] = s;
! 			while (s < bufend && !isspace(*s))
! 			    s++;
! 			*s = '\0';
! 			Copy(origargv+1, newargv+2, origargc+1, char*);
! 		    }
! 		    else
! 			newargv = origargv;
! 		    newargv[0] = cmd;
! 		    execv(cmd,newargv);
! 		    fatal("Can't exec %s", cmd);
! 		}
! 	    }
! 	    else {
! 		while (s < bufend && isspace(*s))
! 		    s++;
! 		if (*s == ':')	/* for csh's that have to exec sh scripts */
! 		    s++;
! 	    }
  	}
  	goto retry;
      case ' ': case '\t': case '\f':
***************
*** 519,526 ****
  	    LFUN(O_CHOP);
  	if (strEQ(d,"continue"))
  	    OPERATOR(CONTINUE);
! 	if (strEQ(d,"chdir"))
  	    UNI(O_CHDIR);
  	if (strEQ(d,"close"))
  	    FOP(O_CLOSE);
  	if (strEQ(d,"closedir"))
--- 559,568 ----
  	    LFUN(O_CHOP);
  	if (strEQ(d,"continue"))
  	    OPERATOR(CONTINUE);
! 	if (strEQ(d,"chdir")) {
! 	    (void)stabent("ENV",TRUE);	/* may use HOME */
  	    UNI(O_CHDIR);
+ 	}
  	if (strEQ(d,"close"))
  	    FOP(O_CLOSE);
  	if (strEQ(d,"closedir"))
***************
*** 606,615 ****
  	break;
      case 'f': case 'F':
  	SNARFWORD;
! 	if (strEQ(d,"for"))
  	    OPERATOR(FOR);
! 	if (strEQ(d,"foreach"))
! 	    OPERATOR(FOR);
  	if (strEQ(d,"format")) {
  	    d = bufend;
  	    while (s < d && isspace(*s))
--- 648,657 ----
  	break;
      case 'f': case 'F':
  	SNARFWORD;
! 	if (strEQ(d,"for") || strEQ(d,"foreach")) {
! 	    yylval.ival = line;
  	    OPERATOR(FOR);
! 	}
  	if (strEQ(d,"format")) {
  	    d = bufend;
  	    while (s < d && isspace(*s))
***************
*** 819,824 ****
--- 861,868 ----
  	    FL2(O_PACK);
  	if (strEQ(d,"package"))
  	    OPERATOR(PACKAGE);
+ 	if (strEQ(d,"pipe"))
+ 	    FOP22(O_PIPE);
  	break;
      case 'q': case 'Q':
  	SNARFWORD;
***************
*** 834,840 ****
      case 'r': case 'R':
  	SNARFWORD;
  	if (strEQ(d,"return"))
! 	    LOP(O_RETURN);
  	if (strEQ(d,"reset"))
  	    UNI(O_RESET);
  	if (strEQ(d,"redo"))
--- 878,884 ----
      case 'r': case 'R':
  	SNARFWORD;
  	if (strEQ(d,"return"))
! 	    OLDLOP(O_RETURN);
  	if (strEQ(d,"reset"))
  	    UNI(O_RESET);
  	if (strEQ(d,"redo"))
***************
*** 1483,1489 ****
  	tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
  	e = tmpstr->str_ptr + tmpstr->str_cur;
  	for (t = tmpstr->str_ptr; t < e; t++) {
! 	    if (*t == '$' && t[1] && index("`'&+0123456789",t[1]))
  		spat->spat_flags &= ~SPAT_CONST;
  	}
      }
--- 1527,1534 ----
  	tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
  	e = tmpstr->str_ptr + tmpstr->str_cur;
  	for (t = tmpstr->str_ptr; t < e; t++) {
! 	    if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
! 	      (t[1] == '{' /*}*/ && isdigit(t[2])) ))
  		spat->spat_flags &= ~SPAT_CONST;
  	}
      }
***************
*** 1861,1867 ****
  		    term = tmps[5];
  		multi_close = term;
  	    }
! 	    tmpstr = Str_new(87,0);
  	    if (hereis) {
  		term = *tokenbuf;
  		if (!rsfp) {
--- 1906,1912 ----
  		    term = tmps[5];
  		multi_close = term;
  	    }
! 	    tmpstr = Str_new(87,80);
  	    if (hereis) {
  		term = *tokenbuf;
  		if (!rsfp) {
***************
*** 1946,1952 ****
  		if ((*s == '$' && s+1 < send &&
  		    (alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) ||
  		    (*s == '@' && s+1 < send) ) {
! 		    len = scanreg(s,bufend,tokenbuf) - s;
  		    if (*s == '$' || strEQ(tokenbuf,"ARGV")
  		      || strEQ(tokenbuf,"ENV")
  		      || strEQ(tokenbuf,"SIG")
--- 1991,1997 ----
  		if ((*s == '$' && s+1 < send &&
  		    (alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) ||
  		    (*s == '@' && s+1 < send) ) {
! 		    len = scanreg(s,send,tokenbuf) - s;
  		    if (*s == '$' || strEQ(tokenbuf,"ARGV")
  		      || strEQ(tokenbuf,"ENV")
  		      || strEQ(tokenbuf,"SIG")

Index: eg/travesty
*** eg/travesty.old	Thu Mar  1 10:50:51 1990
--- eg/travesty	Thu Mar  1 10:50:53 1990
***************
*** 0 ****
--- 1,46 ----
+ #!/usr/bin/perl
+ 
+ while (<>) {
+     next if /^\./;
+     next if /^From / .. /^$/;
+     next if /^Path: / .. /^$/;
+     s/^\W+//;
+     push(@ary,split(' '));
+     while ($#ary > 1) {
+ 	$a = $p;
+ 	$p = $n;
+ 	$w = shift(@ary);
+ 	$n = $num{$w};
+ 	if ($n eq '') {
+ 	    push(@word,$w);
+ 	    $n = pack('S',$#word);
+ 	    $num{$w} = $n;
+ 	}
+ 	$lookup{$a . $p} .= $n;
+     }
+ }
+ 
+ for (;;) {
+     $n = $lookup{$a . $p};
+     ($foo,$n) = each(lookup) if $n eq '';
+     $n = substr($n,int(rand(length($n))) & 0177776,2);
+     $a = $p;
+     $p = $n;
+     ($w) = unpack('S',$n);
+     $w = $word[$w];
+     $col += length($w) + 1;
+     if ($col >= 65) {
+ 	$col = 0;
+ 	print "\n";
+     }
+     else {
+ 	print ' ';
+     }
+     print $w;
+     if ($w =~ /\.$/) {
+ 	if (rand() < .1) {
+ 	    print "\n";
+ 	    $col = 80;
+ 	}
+     }
+ }

Index: util.c
Prereq: 3.0.1.3
*** util.c.old	Thu Mar  1 10:55:42 1990
--- util.c	Thu Mar  1 10:55:47 1990
***************
*** 1,4 ****
! /* $Header: util.c,v 3.0.1.3 89/12/21 20:27:41 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: util.c,v 3.0.1.4 90/03/01 10:26:48 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,17 ----
   *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	util.c,v $
+  * Revision 3.0.1.4  90/03/01  10:26:48  lwall
+  * patch9: fbminstr() called instr() rather than ninstr()
+  * patch9: nested evals clobbered their longjmp environment
+  * patch9: piped opens returned undefined rather than 0 in child
+  * patch9: the x operator is now up to 10 times faster
+  * 
   * Revision 3.0.1.3  89/12/21  20:27:41  lwall
   * patch7: errno may now be a macro with an lvalue
   * 
***************
*** 479,485 ****
  
  #ifndef lint
      if (!(littlestr->str_pok & SP_FBM))
! 	return instr((char*)big,littlestr->str_ptr);
  #endif
  
      littlelen = littlestr->str_cur;
--- 485,492 ----
  
  #ifndef lint
      if (!(littlestr->str_pok & SP_FBM))
! 	return ninstr((char*)big,(char*)bigend,
! 		littlestr->str_ptr, littlestr->str_ptr + littlestr->str_cur);
  #endif
  
      littlelen = littlestr->str_cur;
***************
*** 733,743 ****
  {
      extern FILE *e_fp;
      extern char *e_tmpname;
  
      mess(pat,a1,a2,a3,a4);
      if (in_eval) {
  	str_set(stab_val(stabent("@",TRUE)),buf);
! 	longjmp(eval_env,1);
      }
      fputs(buf,stderr);
      (void)fflush(stderr);
--- 740,772 ----
  {
      extern FILE *e_fp;
      extern char *e_tmpname;
+     char *tmps;
  
      mess(pat,a1,a2,a3,a4);
      if (in_eval) {
  	str_set(stab_val(stabent("@",TRUE)),buf);
! 	tmps = "_EVAL_";
! 	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) {
! 	    in_eval = 0;
! 	    fatal("Bad label: %s", tmps);
! 	}
! 	longjmp(loop_stack[loop_ptr].loop_env, 1);
      }
      fputs(buf,stderr);
      (void)fflush(stderr);
***************
*** 809,814 ****
--- 838,844 ----
      va_list args;
      extern FILE *e_fp;
      extern char *e_tmpname;
+     char *tmps;
  
  #ifndef lint
      va_start(args);
***************
*** 819,825 ****
      va_end(args);
      if (in_eval) {
  	str_set(stab_val(stabent("@",TRUE)),buf);
! 	longjmp(eval_env,1);
      }
      fputs(buf,stderr);
      (void)fflush(stderr);
--- 849,876 ----
      va_end(args);
      if (in_eval) {
  	str_set(stab_val(stabent("@",TRUE)),buf);
! 	tmps = "_EVAL_";
! 	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) {
! 	    in_eval = 0;
! 	    fatal("Bad label: %s", tmps);
! 	}
! 	longjmp(loop_stack[loop_ptr].loop_env, 1);
      }
      fputs(buf,stderr);
      (void)fflush(stderr);
***************
*** 1112,1117 ****
--- 1163,1169 ----
  	}
  	if (tmpstab = stabent("$",allstabs))
  	    str_numset(STAB_STR(tmpstab),(double)getpid());
+ 	forkprocess = 0;
  	return Nullfp;
  #undef THIS
  #undef THAT
***************
*** 1235,1237 ****
--- 1287,1313 ----
      return 0;
  }
  #endif /* MEMCMP */
+ 
+ void
+ repeatcpy(to,from,len,count)
+ register char *to;
+ register char *from;
+ int len;
+ register int count;
+ {
+     register int todo;
+     register char *frombase = from;
+ 
+     if (len == 1) {
+ 	todo = *from;
+ 	while (count-- > 0)
+ 	    *to++ = todo;
+ 	return;
+     }
+     while (count-- > 0) {
+ 	for (todo = len; todo > 0; todo--) {
+ 	    *to++ = *from++;
+ 	}
+ 	from = frombase;
+     }
+ }

Index: x2p/walk.c
Prereq: 3.0.1.3
*** x2p/walk.c.old	Thu Mar  1 10:56:38 1990
--- x2p/walk.c	Thu Mar  1 10:56:43 1990
***************
*** 1,4 ****
! /* $Header: walk.c,v 3.0.1.3 89/12/21 20:32:35 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: walk.c,v 3.0.1.4 90/03/01 10:32:45 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,14 ----
   *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	walk.c,v $
+  * Revision 3.0.1.4  90/03/01  10:32:45  lwall
+  * patch9: a2p didn't put a $ on ExitValue
+  * 
   * Revision 3.0.1.3  89/12/21  20:32:35  lwall
   * patch7: in a2p, user-defined functions didn't work on some machines
   * 
***************
*** 158,164 ****
  	    str_cat(str,"\n");
  	}
  	if (exitval)
! 	    str_cat(str,"exit ExitValue;\n");
  	if (subs->str_ptr) {
  	    str_cat(str,"\n");
  	    str_scat(str,subs);
--- 161,167 ----
  	    str_cat(str,"\n");
  	}
  	if (exitval)
! 	    str_cat(str,"exit $ExitValue;\n");
  	if (subs->str_ptr) {
  	    str_cat(str,"\n");
  	    str_scat(str,subs);
***************
*** 1327,1333 ****
  	}
  	else {
  	    if (len == 1) {
! 		str_set(str,"ExitValue = ");
  		exitval = TRUE;
  		str_scat(str,
  		  fstr=walk(1,level,ops[node+1].ival,&numarg,P_ASSIGN));
--- 1330,1336 ----
  	}
  	else {
  	    if (len == 1) {
! 		str_set(str,"$ExitValue = ");
  		exitval = TRUE;
  		str_scat(str,
  		  fstr=walk(1,level,ops[node+1].ival,&numarg,P_ASSIGN));

*** End of Patch 12 ***