perl 3.0 patch #35 patch #29, continued

See patch #29.

5 files changed, 408 insertions, 116 deletions

diff --git a/lib/syslog.pl b/lib/syslog.pl
index c98baf32e3..1d7becf66a 100644
--- a/lib/syslog.pl
+++ b/lib/syslog.pl
@@ -1,6 +1,31 @@
 #
 # syslog.pl
 #
+# $Log:	syslog.pl,v $
+Revision 3.0.1.3  90/10/15  17:42:18  lwall
+patch29: various portability fixes
+
+# Revision 3.0.1.1  90/08/09  03:57:17  lwall
+# patch19: Initial revision
+# 
+# Revision 1.2  90/06/11  18:45:30  18:45:30  root ()
+# - Changed 'warn' to 'mail|warning' in test call (to give example of
+#   facility specification, and because 'warn' didn't work on HP-UX).
+# - Fixed typo in &openlog ("ncons" should be "cons").
+# - Added (package-global) $maskpri, and &setlogmask.
+# - In &syslog:
+#   - put argument test ahead of &connect (why waste cycles?),
+#   - allowed facility to be specified in &syslog's first arg (temporarily
+#     overrides any $facility set in &openlog), just as in syslog(3C),
+#   - do a return 0 when bit for $numpri not set in log mask (see syslog(3C)),
+#   - changed $whoami code to use getlogin, getpwuid($<) and 'syslog'
+#     (in that order) when $ident is null,
+#   - made PID logging consistent with syslog(3C) and subject to $lo_pid only,
+#   - fixed typo in "print CONS" statement ($<facility should be <$facility).
+#   - changed \n to \r in print CONS (\r is useful, $message already has a \n).
+# - Changed &xlate to return -1 for an unknown name, instead of croaking.
+# 
+#
 # tom christiansen <tchrist@convex.com>
 # modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
 # NOTE: openlog now takes three arguments, just like openlog(3)
@@ -15,7 +40,7 @@
 #
 #	do openlog($program,'cons,pid','user');
 #	do syslog('info','this is another test');
-#	do syslog('warn','this is a better test: %d', time);
+#	do syslog('mail|warning','this is a better test: %d', time);
 #	do closelog();
 #	
 #	do syslog('debug','this is the last test');
@@ -29,13 +54,15 @@ package syslog;
 
 $host = 'localhost' unless $host;	# set $syslog'host to change
 
-require 'syslog.ph';
+require '/usr/local/lib/perl/syslog.ph';
+
+$maskpri = &LOG_UPTO(&LOG_DEBUG);
 
 sub main'openlog {
     ($ident, $logopt, $facility) = @_;  # package vars
     $lo_pid = $logopt =~ /\bpid\b/;
     $lo_ndelay = $logopt =~ /\bndelay\b/;
-    $lo_cons = $logopt =~ /\bncons\b/;
+    $lo_cons = $logopt =~ /\bcons\b/;
     $lo_nowait = $logopt =~ /\bnowait\b/;
     &connect if $lo_ndelay;
 } 
@@ -44,33 +71,71 @@ sub main'closelog {
     $facility = $ident = '';
     &disconnect;
 } 
+
+sub main'setlogmask {
+    local($oldmask) = $maskpri;
+    $maskpri = shift;
+    $oldmask;
+}
  
 sub main'syslog {
     local($priority) = shift;
     local($mask) = shift;
     local($message, $whoami);
+    local(@words, $num, $numpri, $numfac, $sum);
+    local($facility) = $facility;	# may need to change temporarily.
 
-    &connect unless $connected;
+    die "syslog: expected both priority and mask" unless $mask && $priority;
 
-    $whoami = $ident;
+    @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
+    undef $numpri;
+    undef $numfac;
+    foreach (@words) {
+	$num = &xlate($_);		# Translate word to number.
+	if (/^kern$/ || $num < 0) {
+	    die "syslog: invalid level/facility: $_\n";
+	}
+	elsif ($num <= &LOG_PRIMASK) {
+	    die "syslog: too many levels given: $_\n" if defined($numpri);
+	    $numpri = $num;
+	    return 0 unless &LOG_MASK($numpri) & $maskpri;
+	}
+	else {
+	    die "syslog: too many facilities given: $_\n" if defined($numfac);
+	    $facility = $_;
+	    $numfac = $num;
+	}
+    }
 
-    die "syslog: expected both priority and mask" unless $mask && $priority;
+    die "syslog: level must be given\n" unless defined($numpri);
+
+    if (!defined($numfac)) {	# Facility not specified in this call.
+	$facility = 'user' unless $facility;
+	$numfac = &xlate($facility);
+    }
+
+    &connect unless $connected;
 
-    $facility = "user" unless $facility;
+    $whoami = $ident;
 
     if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
 	$whoami = $1;
 	$mask = $2;
     } 
-    $whoami .= " [$$]" if $lo_pid;
+
+    unless ($whoami) {
+	($whoami = getlogin) ||
+	    ($whoami = getpwuid($<)) ||
+		($whoami = 'syslog');
+    }
+
+    $whoami .= "[$$]" if $lo_pid;
 
     $mask =~ s/%m/$!/g;
     $mask .= "\n" unless $mask =~ /\n$/;
     $message = sprintf ($mask, @_);
 
-    $whoami = sprintf ("%s %d",$ENV{'USER'}||$ENV{'LOGNAME'},$$) unless $whoami;
-
-    $sum = &xlate($priority) + &xlate($facility);
+    $sum = $numpri + $numfac;
     unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
 	if ($lo_cons) {
 	    if ($pid = fork) {
@@ -80,7 +145,7 @@ sub main'syslog {
 	    }
 	    else {
 		open(CONS,">/dev/console");
-		print CONS "$<facility.$priority>$whoami: $message\n";
+		print CONS "<$facility.$priority>$whoami: $message\r";
 		exit if defined $pid;		# if fork failed, we're parent
 		close CONS;
 	    }
@@ -93,7 +158,7 @@ sub xlate {
     $name =~ y/a-z/A-Z/;
     $name = "LOG_$name" unless $name =~ /^LOG_/;
     $name = "syslog'$name";
-    &$name;
+    eval &$name || -1;
 }
 
 sub connect {
diff --git a/patchlevel.h b/patchlevel.h
index 3b47b479b6..68fcfefec9 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 34
+#define PATCHLEVEL 35
diff --git a/str.c b/str.c
index 0b6dfea697..e376ce61d4 100644
--- a/str.c
+++ b/str.c
@@ -1,4 +1,4 @@
-/* $Header: str.c,v 3.0.1.8 90/08/09 05:22:18 lwall Locked $
+/* $Header: str.c,v 3.0.1.9 90/10/16 10:41:21 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	str.c,v $
+ * Revision 3.0.1.9  90/10/16  10:41:21  lwall
+ * patch29: the undefined value could get defined by devious means
+ * patch29: undefined values compared inconsistently 
+ * patch29: taintperl now checks for world writable PATH components
+ * 
  * Revision 3.0.1.8  90/08/09  05:22:18  lwall
  * patch19: the number to string converter wasn't allocating enough space
  * patch19: tainting didn't work on setgid scripts
@@ -235,7 +240,7 @@ register STR *sstr;
     if (sstr)
 	tainted |= sstr->str_tainted;
 #endif
-    if (sstr == dstr)
+    if (sstr == dstr || dstr == &str_undef)
 	return;
     if (!sstr)
 	dstr->str_pok = dstr->str_nok = 0;
@@ -250,8 +255,10 @@ register STR *sstr;
 	    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';
+		if (!dstr->str_magic) {
+		    dstr->str_magic = str_smake(sstr->str_magic);
+		    dstr->str_magic->str_rare = 'X';
+		}
 	    }
 	}
     }
@@ -275,6 +282,8 @@ register STR *str;
 register char *ptr;
 register STRLEN len;
 {
+    if (str == &str_undef)
+	return;
     STR_GROW(str, len + 1);
     if (ptr)
 	(void)bcopy(ptr,str->str_ptr,len);
@@ -293,6 +302,8 @@ register char *ptr;
 {
     register STRLEN len;
 
+    if (str == &str_undef)
+	return;
     if (!ptr)
 	ptr = "";
     len = strlen(ptr);
@@ -333,6 +344,8 @@ register STR *str;
 register char *ptr;
 register STRLEN len;
 {
+    if (str == &str_undef)
+	return;
     if (!(str->str_pok))
 	(void)str_2ptr(str);
     STR_GROW(str, str->str_cur + len + 1);
@@ -367,6 +380,8 @@ register char *ptr;
 {
     register STRLEN len;
 
+    if (str == &str_undef)
+	return;
     if (!ptr)
 	return;
     if (!(str->str_pok))
@@ -393,6 +408,8 @@ char *keeplist;
     register char *to;
     register STRLEN len;
 
+    if (str == &str_undef)
+	return Nullch;
     if (!from)
 	return Nullch;
     len = fromend - from;
@@ -455,7 +472,7 @@ int how;
 char *name;
 STRLEN namlen;
 {
-    if (str->str_magic)
+    if (str == &str_undef || str->str_magic)
 	return;
     str->str_magic = Str_new(75,namlen);
     str = str->str_magic;
@@ -479,6 +496,8 @@ STRLEN littlelen;
     register char *bigend;
     register int i;
 
+    if (bigstr == &str_undef)
+	return;
     bigstr->str_nok = 0;
     bigstr->str_pok = SP_VALID;	/* disable possible screamer */
 
@@ -550,6 +569,8 @@ str_replace(str,nstr)
 register STR *str;
 register STR *nstr;
 {
+    if (str == &str_undef)
+	return;
     if (str->str_state == SS_INCR)
 	Str_Grow(str,0);	/* just force copy down */
     if (nstr->str_state == SS_INCR)
@@ -576,7 +597,7 @@ void
 str_free(str)
 register STR *str;
 {
-    if (!str)
+    if (!str || str == &str_undef)
 	return;
     if (str->str_state) {
 	if (str->str_state == SS_FREE)	/* already freed */
@@ -636,10 +657,10 @@ str_eq(str1,str2)
 register STR *str1;
 register STR *str2;
 {
-    if (!str1)
-	return str2 == Nullstr;
-    if (!str2)
-	return 0;
+    if (!str1 || str1 == &str_undef)
+	return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur);
+    if (!str2 || str2 == &str_undef)
+	return !str1->str_cur;
 
     if (!str1->str_pok)
 	(void)str_2ptr(str1);
@@ -658,10 +679,10 @@ register STR *str2;
 {
     int retval;
 
-    if (!str1)
-	return str2 == Nullstr;
-    if (!str2)
-	return 0;
+    if (!str1 || str1 == &str_undef)
+	return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur)?0:-1;
+    if (!str2 || str2 == &str_undef)
+	return str1->str_cur != 0;
 
     if (!str1->str_pok)
 	(void)str_2ptr(str1);
@@ -698,12 +719,13 @@ int append;
     register int get_paragraph;
     register char *oldbp;
 
+    if (str == &str_undef)
+	return Nullch;
     if (get_paragraph = !rslen) {	/* yes, that's an assignment */
 	newline = '\n';
 	oldbp = Nullch;			/* remember last \n position (none) */
     }
 #ifdef STDSTDIO		/* Here is some breathtakingly efficient cheating */
-
     cnt = fp->_cnt;			/* get count into register */
     str->str_nok = 0;			/* invalidate number */
     str->str_pok = 1;			/* validate pointer */
@@ -790,8 +812,10 @@ STR *str;
     register CMD *cmd;
     register ARG *arg;
     CMD *oldcurcmd = curcmd;
+    int oldperldb = perldb;
     int retval;
 
+    perldb = 0;
     str_sset(linestr,str);
     in_eval++;
     oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
@@ -810,6 +834,7 @@ STR *str;
     if (setjmp(loop_stack[loop_ptr].loop_env)) {
 	in_eval--;
 	loop_ptr--;
+	perldb = oldperldb;
 	fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
     }
 #ifdef DEBUGGING
@@ -825,6 +850,7 @@ STR *str;
     curcmd->c_line = oldcurcmd->c_line;
     retval = yyparse();
     curcmd = oldcurcmd;
+    perldb = oldperldb;
     in_eval--;
     if (retval || error_count)
 	fatal("Invalid component in string or format");
@@ -994,7 +1020,8 @@ STR *src;
 				    weight += 100;
 				break;
 			    case '-':
-				if (last_un_char < d[1] || d[1] == '\\') {
+				if (last_un_char < (unsigned char) d[1]
+				  || d[1] == '\\') {
 				    if (index("aA01! ",last_un_char))
 					weight += 30;
 				    if (index("zZ79~",d[1]))
@@ -1068,11 +1095,13 @@ int sp;
     register char *send;
     register STR **elem;
 
+    if (str == &str_undef)
+	return Nullstr;
     if (!(src->str_pok & SP_INTRP)) {
 	int oldsave = savestack->ary_fill;
 
 	(void)savehptr(&curstash);
-	curstash = src->str_u.str_hash;	/* so stabent knows right package */
+	curstash = curcmd->c_stash;	/* so stabent knows right package */
 	intrpcompile(src);
 	restorelist(oldsave);
     }
@@ -1113,7 +1142,7 @@ register STR *str;
 {
     register char *d;
 
-    if (!str)
+    if (!str || str == &str_undef)
 	return;
     if (str->str_nok) {
 	str->str_u.str_nval += 1.0;
@@ -1162,7 +1191,7 @@ void
 str_dec(str)
 register STR *str;
 {
-    if (!str)
+    if (!str || str == &str_undef)
 	return;
     if (str->str_nok) {
 	str->str_u.str_nval -= 1.0;
@@ -1210,6 +1239,8 @@ STR *
 str_2static(str)
 register STR *str;
 {
+    if (str == &str_undef)
+	return str;
     if (++tmps_max > tmps_size) {
 	tmps_size = tmps_max;
 	if (!(tmps_size & 127)) {
@@ -1292,6 +1323,8 @@ HASH *stash;
 
     /* reset variables */
 
+    if (!stash->tbl_array)
+	return;
     while (*s) {
 	i = *s;
 	if (s[1] == '-') {
@@ -1315,7 +1348,7 @@ HASH *stash;
 		    aclear(stab_xarray(stab));
 		}
 		if (stab_xhash(stab)) {
-		    hclear(stab_xhash(stab));
+		    hclear(stab_xhash(stab), FALSE);
 		    if (stab == envstab)
 			environ[0] = Nullch;
 		}
@@ -1345,12 +1378,15 @@ taintenv()
     register STR *envstr;
 
     envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
-    if (!envstr || envstr->str_tainted) {
+    if (envstr == &str_undef || envstr->str_tainted) {
 	tainted = 1;
-	taintproper("Insecure PATH");
+	if (envstr->str_tainted == 2)
+	    taintproper("Insecure directory in PATH");
+	else
+	    taintproper("Insecure PATH");
     }
     envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
-    if (envstr && envstr->str_tainted) {
+    if (envstr != &str_undef && envstr->str_tainted) {
 	tainted = 1;
 	taintproper("Insecure IFS");
     }
diff --git a/str.h b/str.h
index cdc3d586b5..1592c05b44 100644
--- a/str.h
+++ b/str.h
@@ -1,4 +1,4 @@
-/* $Header: str.h,v 3.0.1.2 90/08/09 05:23:24 lwall Locked $
+/* $Header: str.h,v 3.0.1.3 90/10/16 10:44:04 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	str.h,v $
+ * Revision 3.0.1.3  90/10/16  10:44:04  lwall
+ * patch29: added caller
+ * patch29: scripts now run at almost full speed under the debugger
+ * 
  * Revision 3.0.1.2  90/08/09  05:23:24  lwall
  * patch19: various MSDOS and OS/2 patches folded in
  * 
@@ -27,6 +31,7 @@ struct string {
 	ARG	*str_args;	/* list of args for interpreted string */
 	HASH	*str_hash;	/* string represents an assoc array (stab?) */
 	ARRAY	*str_array;	/* string represents an array */
+	CMD	*str_cmd;	/* command for this source line */
     } str_u;
     STRLEN	str_cur;	/* length of str_ptr as a C string */
     STR		*str_magic;	/* while free, link to next free str */
@@ -51,6 +56,7 @@ struct stab {	/* should be identical, except for str_ptr */
 	ARG	*str_args;	/* list of args for interpreted string */
 	HASH	*str_hash;	/* string represents an assoc array (stab?) */
 	ARRAY	*str_array;	/* string represents an array */
+	CMD	*str_cmd;	/* command for this source line */
     } str_u;
     STRLEN	str_cur;	/* length of str_ptr as a C string */
     STR		*str_magic;	/* while free, link to next free str */
@@ -94,6 +100,7 @@ struct lstring {
 #define SS_SSTRP	6	/* STR* on save stack */
 #define SS_SHPTR	7	/* HASH* on save stack */
 #define SS_SNSTAB	8	/* non-stab on save stack */
+#define SS_SCSV		9	/* callsave structure on save stack */
 #define SS_HASH		253	/* carrying an hash */
 #define SS_ARY		254	/* carrying an array */
 #define SS_FREE		255	/* in free list */
diff --git a/toke.c b/toke.c
index 2b88b1a322..2d13b7c950 100644
--- a/toke.c
+++ b/toke.c
@@ -1,4 +1,4 @@
-/* $Header: toke.c,v 3.0.1.9 90/08/13 22:37:25 lwall Locked $
+/* $Header: toke.c,v 3.0.1.10 90/10/16 11:20:46 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,21 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	toke.c,v $
+ * Revision 3.0.1.10  90/10/16  11:20:46  lwall
+ * patch29: the length of a search pattern was limited
+ * patch29: added DATA filehandle to read stuff after __END__
+ * patch29: added -M, -A and -C
+ * patch29: added cmp and <=>
+ * patch29: added caller
+ * patch29: added scalar
+ * patch29: added sysread and syswrite
+ * patch29: added SysV IPC
+ * patch29: added waitpid
+ * patch29: tr/// now understands c, d and s options, and handles nulls right
+ * patch29: 0x80000000 now makes unsigned value
+ * patch29: Null could not be used as a delimiter
+ * patch29: added @###.## fields to format
+ * 
  * Revision 3.0.1.9  90/08/13  22:37:25  lwall
  * patch28: defined(@array) and defined(%array) didn't work right
  * 
@@ -62,6 +77,14 @@
 #include "perl.h"
 #include "perly.h"
 
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+
+/* which backslash sequences to keep in m// or s// */
+
+static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtf0123456789[{]}";
+
 char *reparse;		/* if non-null, scanreg found ${foo[$bar]} */
 
 #ifdef CLINE
@@ -79,13 +102,15 @@ char *reparse;		/* if non-null, scanreg found ${foo[$bar]} */
 #define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
 #define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
 #define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
+#define FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x)
 #define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
+#define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4)
+#define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5)
 #define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
 #define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
 #define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
 #define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
 #define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
-#define LFUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)LFUNC4)
 #define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
 #define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
 #define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
@@ -215,8 +240,13 @@ yylex()
 	    firstline = FALSE;
 	    if (minus_n || minus_p || perldb) {
 		str_set(linestr,"");
-		if (perldb)
-		    str_cat(linestr, "require 'perldb.pl';");
+		if (perldb) {
+		    char *getenv();
+		    char *pdb = getenv("PERLDB");
+
+		    str_cat(linestr, pdb ? pdb : "require 'perldb.pl'");
+		    str_cat(linestr, ";");
+		}
 		if (minus_n || minus_p) {
 		    str_cat(linestr,"line: while (<>) {");
 		    if (minus_a)
@@ -242,13 +272,15 @@ yylex()
 	do {
 	    if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
 	      fake_eof:
-		if (preprocess)
-		    (void)mypclose(rsfp);
-		else if (rsfp == stdin)
-		    clearerr(stdin);
-		else
-		    (void)fclose(rsfp);
-		rsfp = Nullfp;
+		if (rsfp) {
+		    if (preprocess)
+			(void)mypclose(rsfp);
+		    else if (rsfp == stdin)
+			clearerr(stdin);
+		    else
+			(void)fclose(rsfp);
+		    rsfp = Nullfp;
+		}
 		if (minus_n || minus_p) {
 		    str_set(linestr,minus_p ? ";}continue{print" : "");
 		    str_cat(linestr,";}");
@@ -269,7 +301,7 @@ yylex()
 	    STR *str = Str_new(85,0);
 
 	    str_sset(str,linestr);
-	    astore(lineary,(int)curcmd->c_line,str);
+	    astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
 	}
 #ifdef DEBUG
 	if (firstline) {
@@ -332,9 +364,9 @@ yylex()
 		s[strlen(s)-1] = '\0';	/* wipe out trailing quote */
 	    }
 	    if (*s)
-		filename = savestr(s);
+		curcmd->c_filestab = fstab(s);
 	    else
-		filename = origfilename;
+		curcmd->c_filestab = fstab(origfilename);
 	    oldoldbufptr = oldbufptr = s = str_get(linestr);
 	}
 	/* FALL THROUGH */
@@ -345,6 +377,13 @@ yylex()
 		s++;
 	    if (s < d)
 		s++;
+	    if (perldb) {
+		STR *str = Str_new(85,0);
+
+		str_nset(str,linestr->str_ptr, s - linestr->str_ptr);
+		astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
+		str_chop(linestr, s);
+	    }
 	    if (in_format) {
 		bufptr = s;
 		yylval.formval = load_format();
@@ -387,6 +426,9 @@ yylex()
 	    case 't': FTST(O_FTTTY);
 	    case 'T': FTST(O_FTTEXT);
 	    case 'B': FTST(O_FTBINARY);
+	    case 'M': stabent("\024",TRUE); FTST(O_FTMTIME);
+	    case 'A': stabent("\024",TRUE); FTST(O_FTATIME);
+	    case 'C': stabent("\024",TRUE); FTST(O_FTCTIME);
 	    default:
 		s -= 2;
 		break;
@@ -507,8 +549,13 @@ yylex()
 	tmp = *s++;
 	if (tmp == '<')
 	    OPERATOR(LS);
-	if (tmp == '=')
+	if (tmp == '=') {
+	    tmp = *s++;
+	    if (tmp == '>')
+		EOP(O_NCMP);
+	    s--;
 	    ROP(O_LE);
+	}
 	s--;
 	ROP(O_LT);
     case '>':
@@ -600,13 +647,35 @@ yylex()
 		if (d[2] == 'L')
 		    (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line);
 		else
-		    strcpy(tokenbuf, filename);
+		    strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr);
 		arg[1].arg_type = A_SINGLE;
 		arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
 		TERM(RSTRING);
 	    }
-	    else if (strEQ(d,"__END__"))
+	    else if (strEQ(d,"__END__")) {
+#ifndef TAINT
+		STAB *stab;
+		int fd;
+
+		if (stab = stabent("DATA",FALSE)) {
+		    stab->str_pok |= SP_MULTI;
+		    stab_io(stab) = stio_new();
+		    stab_io(stab)->ifp = rsfp;
+#if defined(FCNTL) && defined(F_SETFD)
+		    fd = fileno(rsfp);
+		    fcntl(fd,F_SETFD,fd >= 3);
+#endif
+		    if (preprocess)
+			stab_io(stab)->type = '|';
+		    else if (rsfp == stdin)
+			stab_io(stab)->type = '-';
+		    else
+			stab_io(stab)->type = '<';
+		    rsfp = Nullfp;
+		}
+#endif
 		goto fake_eof;
+	    }
 	}
 	break;
     case 'a': case 'A':
@@ -637,6 +706,10 @@ yylex()
 	    FOP(O_CLOSE);
 	if (strEQ(d,"closedir"))
 	    FOP(O_CLOSEDIR);
+	if (strEQ(d,"cmp"))
+	    EOP(O_SCMP);
+	if (strEQ(d,"caller"))
+	    UNI(O_CALLER);
 	if (strEQ(d,"crypt")) {
 #ifdef FCRYPT
 	    init_des();
@@ -701,7 +774,7 @@ yylex()
 	    HFUN(O_EACH);
 	if (strEQ(d,"exec")) {
 	    set_csh();
-	    LOP(O_EXEC);
+	    LOP(O_EXEC_OP);
 	}
 	if (strEQ(d,"endhostent"))
 	    FUN0(O_EHOSTENT);
@@ -834,7 +907,7 @@ yylex()
 	    OPERATOR(IF);
 	}
 	if (strEQ(d,"index"))
-	    FUN2(O_INDEX);
+	    FUN2x(O_INDEX);
 	if (strEQ(d,"int"))
 	    UNI(O_INT);
 	if (strEQ(d,"ioctl"))
@@ -890,8 +963,22 @@ yylex()
 	    else
 		RETURN(1);	/* force error */
 	}
-	if (strEQ(d,"mkdir"))
-	    FUN2(O_MKDIR);
+	switch (d[1]) {
+	case 'k':
+	    if (strEQ(d,"mkdir"))
+		FUN2(O_MKDIR);
+	    break;
+	case 's':
+	    if (strEQ(d,"msgctl"))
+		FUN3(O_MSGCTL);
+	    if (strEQ(d,"msgget"))
+		FUN2(O_MSGGET);
+	    if (strEQ(d,"msgrcv"))
+		FUN5(O_MSGRCV);
+	    if (strEQ(d,"msgsnd"))
+		FUN3(O_MSGSND);
+	    break;
+	}
 	break;
     case 'n': case 'N':
 	SNARFWORD;
@@ -964,7 +1051,7 @@ yylex()
 	if (strEQ(d,"rmdir"))
 	    UNI(O_RMDIR);
 	if (strEQ(d,"rindex"))
-	    FUN2(O_RINDEX);
+	    FUN2x(O_RINDEX);
 	if (strEQ(d,"read"))
 	    FOP3(O_READ);
 	if (strEQ(d,"readdir"))
@@ -996,7 +1083,11 @@ yylex()
 	switch (d[1]) {
 	case 'a':
 	case 'b':
+	    break;
 	case 'c':
+	    if (strEQ(d,"scalar"))
+		UNI(O_SCALAR);
+	    break;
 	case 'd':
 	    break;
 	case 'e':
@@ -1004,6 +1095,12 @@ yylex()
 		OPERATOR(SSELECT);
 	    if (strEQ(d,"seek"))
 		FOP3(O_SEEK);
+	    if (strEQ(d,"semctl"))
+		FUN4(O_SEMCTL);
+	    if (strEQ(d,"semget"))
+		FUN3(O_SEMGET);
+	    if (strEQ(d,"semop"))
+		FUN2(O_SEMOP);
 	    if (strEQ(d,"send"))
 		FOP3(O_SEND);
 	    if (strEQ(d,"setpgrp"))
@@ -1033,6 +1130,14 @@ yylex()
 	case 'h':
 	    if (strEQ(d,"shift"))
 		TERM(SHIFT);
+	    if (strEQ(d,"shmctl"))
+		FUN3(O_SHMCTL);
+	    if (strEQ(d,"shmget"))
+		FUN3(O_SHMGET);
+	    if (strEQ(d,"shmread"))
+		FUN4(O_SHMREAD);
+	    if (strEQ(d,"shmwrite"))
+		FUN4(O_SHMWRITE);
 	    if (strEQ(d,"shutdown"))
 		FOP2(O_SHUTDOWN);
 	    break;
@@ -1107,7 +1212,7 @@ yylex()
 	    break;
 	case 'u':
 	    if (strEQ(d,"substr"))
-		FUN3(O_SUBSTR);
+		FUN2x(O_SUBSTR);
 	    if (strEQ(d,"sub")) {
 		subline = curcmd->c_line;
 		d = bufend;
@@ -1144,6 +1249,10 @@ yylex()
 		FUN2(O_SYMLINK);
 	    if (strEQ(d,"syscall"))
 		LOP(O_SYSCALL);
+	    if (strEQ(d,"sysread"))
+		FOP3(O_SYSREAD);
+	    if (strEQ(d,"syswrite"))
+		FOP3(O_SYSWRITE);
 	    break;
 	case 'z':
 	    break;
@@ -1215,6 +1324,8 @@ yylex()
 	    LOP(O_WARN);
 	if (strEQ(d,"wait"))
 	    FUN0(O_WAIT);
+	if (strEQ(d,"waitpid"))
+	    FUN2(O_WAITPID);
 	if (strEQ(d,"wantarray")) {
 	    yylval.arg = op_new(1);
 	    yylval.arg->arg_type = O_ITEM;
@@ -1428,6 +1539,7 @@ register char *s;
     register char *e;
     int len;
     SPAT savespat;
+    STR *str = Str_new(93,0);
 
     Newz(801,spat,1,SPAT);
     spat->spat_next = curstash->tbl_spatroot;	/* link into spat list */
@@ -1445,8 +1557,9 @@ register char *s;
     default:
 	fatal("panic: scanpat");
     }
-    s = cpytill(tokenbuf,s,bufend,s[-1],&len);
+    s = str_append_till(str,s,bufend,s[-1],patleave);
     if (s >= bufend) {
+	str_free(str);
 	yyerror("Search pattern not terminated");
 	yylval.arg = Nullarg;
 	return s;
@@ -1463,8 +1576,9 @@ register char *s;
 	    spat->spat_flags |= SPAT_KEEP;
 	}
     }
-    e = tokenbuf + len;
-    for (d=tokenbuf; d < e; d++) {
+    len = str->str_cur;
+    e = str->str_ptr + len;
+    for (d = str->str_ptr; d < e; d++) {
 	if (*d == '\\')
 	    d++;
 	else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
@@ -1474,8 +1588,7 @@ register char *s;
 	    spat->spat_runtime = arg = op_new(1);
 	    arg->arg_type = O_ITEM;
 	    arg[1].arg_type = A_DOUBLE;
-	    arg[1].arg_ptr.arg_str = str_make(tokenbuf,len);
-	    arg[1].arg_ptr.arg_str->str_u.str_hash = curstash;
+	    arg[1].arg_ptr.arg_str = str_smake(str);
 	    d = scanreg(d,bufend,buf);
 	    (void)stabent(buf,TRUE);		/* make sure it's created */
 	    for (; d < e; d++) {
@@ -1501,8 +1614,8 @@ register char *s;
 #else
 	(void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT));
 #endif
-    if (*tokenbuf == '^') {
-	spat->spat_short = scanconst(tokenbuf+1,len-1);
+    if (*str->str_ptr == '^') {
+	spat->spat_short = scanconst(str->str_ptr+1,len-1);
 	if (spat->spat_short) {
 	    spat->spat_slen = spat->spat_short->str_cur;
 	    if (spat->spat_slen == len - 1)
@@ -1511,7 +1624,7 @@ register char *s;
     }
     else {
 	spat->spat_flags |= SPAT_SCANFIRST;
-	spat->spat_short = scanconst(tokenbuf,len);
+	spat->spat_short = scanconst(str->str_ptr,len);
 	if (spat->spat_short) {
 	    spat->spat_slen = spat->spat_short->str_cur;
 	    if (spat->spat_slen == len)
@@ -1520,7 +1633,7 @@ register char *s;
     }	
     if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
 	fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
-	spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len,
+	spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
 	    spat->spat_flags & SPAT_FOLD);
 		/* Note that this regexp can still be used if someone says
 		 * something like /a/ && s//b/;  so we can't delete it.
@@ -1535,11 +1648,12 @@ register char *s;
 #endif
 	if (spat->spat_short)
 	    fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
-	spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len,
+	spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
 	    spat->spat_flags & SPAT_FOLD,1);
 	hoistmust(spat);
     }
   got_pat:
+    str_free(str);
     yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
     return s;
 }
@@ -1552,28 +1666,32 @@ register char *s;
     register char *d;
     register char *e;
     int len;
+    STR *str = Str_new(93,0);
 
     Newz(802,spat,1,SPAT);
     spat->spat_next = curstash->tbl_spatroot;	/* link into spat list */
     curstash->tbl_spatroot = spat;
 
-    s = cpytill(tokenbuf,s+1,bufend,*s,&len);
+    s = str_append_till(str,s+1,bufend,*s,patleave);
     if (s >= bufend) {
+	str_free(str);
 	yyerror("Substitution pattern not terminated");
 	yylval.arg = Nullarg;
 	return s;
     }
-    e = tokenbuf + len;
-    for (d=tokenbuf; d < e; d++) {
-	if ((*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') ||
-	    (*d == '@' && d[-1] != '\\')) {
+    len = str->str_cur;
+    e = str->str_ptr + len;
+    for (d = str->str_ptr; d < e; d++) {
+	if (*d == '\\')
+	    d++;
+	else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') ||
+	    *d == '@' ) {
 	    register ARG *arg;
 
 	    spat->spat_runtime = arg = op_new(1);
 	    arg->arg_type = O_ITEM;
 	    arg[1].arg_type = A_DOUBLE;
-	    arg[1].arg_ptr.arg_str = str_make(tokenbuf,len);
-	    arg[1].arg_ptr.arg_str->str_u.str_hash = curstash;
+	    arg[1].arg_ptr.arg_str = str_smake(str);
 	    d = scanreg(d,bufend,buf);
 	    (void)stabent(buf,TRUE);		/* make sure it's created */
 	    for (; *d; d++) {
@@ -1591,21 +1709,21 @@ register char *s;
 	    goto get_repl;		/* skip compiling for now */
 	}
     }
-    if (*tokenbuf == '^') {
-	spat->spat_short = scanconst(tokenbuf+1,len-1);
+    if (*str->str_ptr == '^') {
+	spat->spat_short = scanconst(str->str_ptr+1,len-1);
 	if (spat->spat_short)
 	    spat->spat_slen = spat->spat_short->str_cur;
     }
     else {
 	spat->spat_flags |= SPAT_SCANFIRST;
-	spat->spat_short = scanconst(tokenbuf,len);
+	spat->spat_short = scanconst(str->str_ptr,len);
 	if (spat->spat_short)
 	    spat->spat_slen = spat->spat_short->str_cur;
     }
-    d = nsavestr(tokenbuf,len);
 get_repl:
     s = scanstr(s);
     if (s >= bufend) {
+	str_free(str);
 	yyerror("Substitution replacement not terminated");
 	yylval.arg = Nullarg;
 	return s;
@@ -1632,10 +1750,10 @@ get_repl:
 	    s++;
 	    if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
 		spat->spat_repl[1].arg_type = A_SINGLE;
-	    spat->spat_repl = fixeval(make_op(O_EVAL,2,
+	    spat->spat_repl = make_op(O_EVAL,2,
 		spat->spat_repl,
 		Nullarg,
-		Nullarg));
+		Nullarg);
 	    spat->spat_flags &= ~SPAT_CONST;
 	}
 	if (*s == 'g') {
@@ -1660,11 +1778,12 @@ get_repl:
     if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
 	fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
     if (!spat->spat_runtime) {
-	spat->spat_regexp = regcomp(d,d+len,spat->spat_flags & SPAT_FOLD,1);
+	spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
+	  spat->spat_flags & SPAT_FOLD,1);
 	hoistmust(spat);
-	Safefree(d);
     }
     yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
+    str_free(str);
     return s;
 }
 
@@ -1729,14 +1848,17 @@ register char *s;
 	l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
     register char *t;
     register char *r;
-    register char *tbl;
+    register short *tbl;
     register int i;
     register int j;
     int tlen, rlen;
+    int squash;
+    int delete;
+    int complement;
 
-    Newz(803,tbl,256,char);
+    New(803,tbl,256,short);
     arg[2].arg_type = A_NULL;
-    arg[2].arg_ptr.arg_cval = tbl;
+    arg[2].arg_ptr.arg_cval = (char*) tbl;
     s = scanstr(s);
     if (s >= bufend) {
 	yyerror("Translation pattern not terminated");
@@ -1752,18 +1874,57 @@ register char *s;
 	yylval.arg = Nullarg;
 	return s;
     }
+    complement = delete = squash = 0;
+    while (*s == 'c' || *s == 'd' || *s == 's') {
+	if (*s == 'c')
+	    complement = 1;
+	else if (*s == 'd')
+	    delete = 2;
+	else
+	    squash = 1;
+	s++;
+    }
     r = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
 	yylval.arg[1].arg_ptr.arg_str->str_cur,&rlen);
     free_arg(yylval.arg);
+    arg[2].arg_len = delete|squash;
     yylval.arg = arg;
-    if (!*r) {
+    if (!rlen && !delete) {
 	Safefree(r);
 	r = t; rlen = tlen;
     }
-    for (i = 0, j = 0; i < tlen; i++,j++) {
-	if (j >= rlen)
-	    --j;
-	tbl[t[i] & 0377] = r[j];
+    if (complement) {
+	Zero(tbl, 256, short);
+	for (i = 0; i < tlen; i++)
+	    tbl[t[i] & 0377] = -1;
+	for (i = 0, j = 0; i < 256; i++,j++) {
+	    if (!tbl[i]) {
+		if (j >= rlen) {
+		    if (delete) {
+			tbl[i] = -2;
+			continue;
+		    }
+		    --j;
+		}
+		tbl[i] = r[j];
+	    }
+	}
+    }
+    else {
+	for (i = 0; i < 256; i++)
+	    tbl[i] = -1;
+	for (i = 0, j = 0; i < tlen; i++,j++) {
+	    if (j >= rlen) {
+		if (delete) {
+		    if (tbl[t[i] & 0377] == -1)
+			tbl[t[i] & 0377] = -2;
+		    continue;
+		}
+		--j;
+	    }
+	    if (tbl[t[i] & 0377] == -1)
+		tbl[t[i] & 0377] = r[j];
+	}
     }
     if (r != t)
 	Safefree(r);
@@ -1802,7 +1963,7 @@ register char *s;
 	goto snarf_it;
     case '0':
 	{
-	    long i;
+	    unsigned long i;
 	    int shift;
 
 	    arg[1].arg_type = A_SINGLE;
@@ -1936,7 +2097,6 @@ register char *s;
 	    arg[1].arg_ptr.arg_stab = stab = genstab();
 	    stab_io(stab) = stio_new();
 	    stab_val(stab) = str_make(d,len);
-	    stab_val(stab)->str_u.str_hash = curstash;
 	    Safefree(d);
 	    set_csh();
 	}
@@ -1950,10 +2110,6 @@ register char *s;
 	    }
 	    else {
 		arg[1].arg_type = A_READ;
-#ifdef NOTDEF
-		if (rsfp == stdin && (strEQ(d,"stdin") || strEQ(d,"STDIN")))
-		    yyerror("Can't get both program and data from <STDIN>");
-#endif
 		arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
 		if (!stab_io(arg[1].arg_ptr.arg_stab))
 		    stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
@@ -2003,7 +2159,7 @@ register char *s;
 		multi_open = multi_close = '<';
 	    else {
 		multi_open = term;
-		if (tmps = index("([{< )]}> )]}>",term))
+		if (term && (tmps = index("([{< )]}> )]}>",term)))
 		    term = tmps[5];
 		multi_close = term;
 	    }
@@ -2045,7 +2201,8 @@ register char *s;
 		    STR *str = Str_new(88,0);
 
 		    str_sset(str,linestr);
-		    astore(lineary,(int)curcmd->c_line,str);
+		    astore(stab_xarray(curcmd->c_filestab),
+		      (int)curcmd->c_line,str);
 		}
 		bufend = linestr->str_ptr + linestr->str_cur;
 		if (hereis) {
@@ -2151,8 +2308,6 @@ register char *s;
 	    if ((arg[1].arg_type & A_MASK) == A_DOUBLE && makesingle)
 		    arg[1].arg_type = A_SINGLE;	/* now we can optimize on it */
 
-	    tmpstr->str_u.str_hash = curstash;	/* so interp knows package */
-
 	    tmpstr->str_cur = d - tmpstr->str_ptr;
 	    arg[1].arg_ptr.arg_str = tmpstr;
 	    s = tmps;
@@ -2182,12 +2337,6 @@ load_format()
     s = bufptr;
     while (s < bufend || (s = str_gets(linestr,rsfp, 0)) != Nullch) {
 	curcmd->c_line++;
-	if (perldb) {
-	    STR *tmpstr = Str_new(89,0);
-
-	    str_sset(tmpstr,linestr);
-	    astore(lineary,(int)curcmd->c_line,tmpstr);
-	}
 	if (in_eval && !rsfp) {
 	    eol = index(s,'\n');
 	    if (!eol++)
@@ -2195,6 +2344,12 @@ load_format()
 	}
 	else
 	    eol = bufend = linestr->str_ptr + linestr->str_cur;
+	if (perldb) {
+	    STR *tmpstr = Str_new(89,0);
+
+	    str_nset(tmpstr, s, eol-s);
+	    astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
+	}
 	if (strnEQ(s,".\n",2)) {
 	    bufptr = s;
 	    return froot.f_next;
@@ -2254,7 +2409,35 @@ load_format()
 		while (*s == '|')
 		    s++;
 		break;
+	    case '#':
+	    case '.':
+		/* Catch the special case @... and handle it as a string
+		   field. */
+		if (*s == '.' && s[1] == '.') {
+		    goto default_format;
+		}
+		fcmd->f_type = F_DECIMAL;
+		{
+		    char *p;
+
+		    /* Read a format in the form @####.####, where either group
+		       of ### may be empty, or the final .### may be missing. */
+		    while (*s == '#')
+			s++;
+		    if (*s == '.') {
+			s++;
+			p = s;
+			while (*s == '#')
+			    s++;
+			fcmd->f_decimals = s-p;
+			fcmd->f_flags |= FC_DP;
+		    } else {
+			fcmd->f_decimals = 0;
+		    }
+		}
+		break;
 	    default:
+	    default_format:
 		fcmd->f_type = F_LEFT;
 		break;
 	    }
@@ -2270,12 +2453,6 @@ load_format()
 	    if (s >= bufend && (s = str_gets(linestr, rsfp, 0)) == Nullch)
 		goto badform;
 	    curcmd->c_line++;
-	    if (perldb) {
-		STR *tmpstr = Str_new(90,0);
-
-		str_sset(tmpstr,linestr);
-		astore(lineary,(int)curcmd->c_line,tmpstr);
-	    }
 	    if (in_eval && !rsfp) {
 		eol = index(s,'\n');
 		if (!eol++)
@@ -2283,6 +2460,13 @@ load_format()
 	    }
 	    else
 		eol = bufend = linestr->str_ptr + linestr->str_cur;
+	    if (perldb) {
+		STR *tmpstr = Str_new(90,0);
+
+		str_nset(tmpstr, s, eol-s);
+		astore(stab_xarray(curcmd->c_filestab),
+		    (int)curcmd->c_line,tmpstr);
+	    }
 	    if (strnEQ(s,".\n",2)) {
 		bufptr = s;
 		yyerror("Missing values line");