perl 3.0 patch #32 patch #29, continued

See patch #29.

24 files changed, 974 insertions, 71 deletions

diff --git a/eg/sysvipc/ipcmsg b/eg/sysvipc/ipcmsg
new file mode 100644
index 0000000000..317e027ea7
--- /dev/null
+++ b/eg/sysvipc/ipcmsg
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+	if 0;
+
+require 'sys/ipc.ph';
+require 'sys/msg.ph';
+
+$| = 1;
+
+$mode = shift;
+die "usage: ipcmsg {r|s}\n" unless $mode =~ /^[rs]$/;
+$send = ($mode eq "s");
+
+$id = msgget(0x1234, ($send ? 0 : &IPC_CREAT) | 0644);
+die "Can't get message queue: $!\n" unless defined($id);
+print "message queue id: $id\n";
+
+if ($send) {
+	while (<STDIN>) {
+		chop;
+		unless (msgsnd($id, pack("LA*", $., $_), 0)) {
+			die "Can't send message: $!\n";
+		}
+	}
+}
+else {
+	$SIG{'INT'} = $SIG{'QUIT'} = "leave";
+	for (;;) {
+		unless (msgrcv($id, $_, 512, 0, 0)) {
+			die "Can't receive message: $!\n";
+		}
+		($type, $message) = unpack("La*", $_);
+		printf "[%d] %s\n", $type, $message;
+	}
+}
+
+&leave;
+
+sub leave {
+	if (!$send) {
+		$x = msgctl($id, &IPC_RMID, 0);
+		if (!defined($x) || $x < 0) {
+			die "Can't remove message queue: $!\n";
+		}
+	}
+	exit;
+}
diff --git a/eg/sysvipc/ipcsem b/eg/sysvipc/ipcsem
new file mode 100644
index 0000000000..d72a2dd77c
--- /dev/null
+++ b/eg/sysvipc/ipcsem
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+	if 0;
+
+require 'sys/ipc.ph';
+require 'sys/msg.ph';
+
+$| = 1;
+
+$mode = shift;
+die "usage: ipcmsg {r|s}\n" unless $mode =~ /^[rs]$/;
+$signal = ($mode eq "s");
+
+$id = semget(0x1234, 1, ($signal ? 0 : &IPC_CREAT) | 0644);
+die "Can't get semaphore: $!\n" unless defined($id);
+print "semaphore id: $id\n";
+
+if ($signal) {
+	while (<STDIN>) {
+		print "Signalling\n";
+		unless (semop($id, 0, pack("sss", 0, 1, 0))) {
+			die "Can't signal semaphore: $!\n";
+		}
+	}
+}
+else {
+	$SIG{'INT'} = $SIG{'QUIT'} = "leave";
+	for (;;) {
+		unless (semop($id, 0, pack("sss", 0, -1, 0))) {
+			die "Can't wait for semaphore: $!\n";
+		}
+		print "Unblocked\n";
+	}
+}
+
+&leave;
+
+sub leave {
+	if (!$signal) {
+		$x = semctl($id, 0, &IPC_RMID, 0);
+		if (!defined($x) || $x < 0) {
+			die "Can't remove semaphore: $!\n";
+		}
+	}
+	exit;
+}
diff --git a/eg/sysvipc/ipcshm b/eg/sysvipc/ipcshm
new file mode 100644
index 0000000000..70588ff865
--- /dev/null
+++ b/eg/sysvipc/ipcshm
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+	if 0;
+
+require 'sys/ipc.ph';
+require 'sys/shm.ph';
+
+$| = 1;
+
+$mode = shift;
+die "usage: ipcshm {r|s}\n" unless $mode =~ /^[rs]$/;
+$send = ($mode eq "s");
+
+$SIZE = 32;
+$id = shmget(0x1234, $SIZE, ($send ? 0 : &IPC_CREAT) | 0644);
+die "Can't get message queue: $!\n" unless defined($id);
+print "message queue id: $id\n";
+
+if ($send) {
+	while (<STDIN>) {
+		chop;
+		unless (shmwrite($id, pack("La*", length($_), $_), 0, $SIZE)) {
+			die "Can't write to shared memory: $!\n";
+		}
+	}
+}
+else {
+	$SIG{'INT'} = $SIG{'QUIT'} = "leave";
+	for (;;) {
+		$_ = <STDIN>;
+		unless (shmread($id, $_, 0, $SIZE)) {
+			die "Can't read shared memory: $!\n";
+		}
+		$len = unpack("L", $_);
+		$message = substr($_, length(pack("L",0)), $len);
+		printf "[%d] %s\n", $len, $message;
+	}
+}
+
+&leave;
+
+sub leave {
+	if (!$send) {
+		$x = shmctl($id, &IPC_RMID, 0);
+		if (!defined($x) || $x < 0) {
+			die "Can't remove shared memory: $!\n";
+		}
+	}
+	exit;
+}
diff --git a/evalargs.xc b/evalargs.xc
index 5d4458dde4..09e1a509c7 100644
--- a/evalargs.xc
+++ b/evalargs.xc
@@ -2,9 +2,13 @@
  * kit sizes from getting too big.
  */
 
-/* $Header: evalargs.xc,v 3.0.1.6 90/08/09 03:37:15 lwall Locked $
+/* $Header: evalargs.xc,v 3.0.1.7 90/10/15 16:48:11 lwall Locked $
  *
  * $Log:	evalargs.xc,v $
+ * Revision 3.0.1.7  90/10/15  16:48:11  lwall
+ * patch29: non-existent array values no longer cause core dumps
+ * patch29: added caller
+ * 
  * Revision 3.0.1.6  90/08/09  03:37:15  lwall
  * patch19: passing *name to subroutine now forces filehandle and array creation
  * patch19: `command` in array context now returns array of lines
@@ -92,8 +96,6 @@
 	    }
 	    st[++sp] = afetch(stab_array(argptr.arg_stab),
 		arg[argtype].arg_len - arybase, FALSE);
-	    if (!st[sp])
-		st[sp] = &str_undef;
 #ifdef DEBUGGING
 	    if (debug & 8) {
 		(void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
@@ -263,7 +265,7 @@
 	    break;
 	case A_WANTARRAY:
 	    {
-		if (wantarray == G_ARRAY)
+		if (curcsv->wantarray == G_ARRAY)
 		    st[++sp] = &str_yes;
 		else
 		    st[++sp] = &str_no;
@@ -323,7 +325,7 @@
 			st = stack->ary_array;
 			tmpstr = Str_new(55,0);
 #ifdef MSDOS
-			str_set(tmpstr, "glob ");
+			str_set(tmpstr, "perlglob ");
 			str_scat(tmpstr,str);
 			str_cat(tmpstr," |");
 #else
diff --git a/form.c b/form.c
index c4b248a7ca..2b0553fbdb 100644
--- a/form.c
+++ b/form.c
@@ -1,4 +1,4 @@
-/* $Header: form.c,v 3.0.1.2 90/08/09 03:38:40 lwall Locked $
+/* $Header: form.c,v 3.0.1.3 90/10/15 17:26:24 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	form.c,v $
+ * Revision 3.0.1.3  90/10/15  17:26:24  lwall
+ * patch29: added @###.## fields to format
+ * 
  * Revision 3.0.1.2  90/08/09  03:38:40  lwall
  * patch19: did preliminary work toward debugging packages and evals
  * 
@@ -281,6 +284,31 @@ int sp;
 	    d += size;
 	    linebeg = fcmd->f_next;
 	    break;
+	case F_DECIMAL: {
+	    double value;
+
+	    (void)eval(fcmd->f_expr,G_SCALAR,sp);
+	    str = stack->ary_array[sp+1];
+	    /* If the field is marked with ^ and the value is undefined,
+	       blank it out. */
+	    if ((fcmd->f_flags & FC_CHOP) && !str->str_pok && !str->str_nok) {
+		while (size) {
+		    size--;
+		    *d++ = ' ';
+		}
+		break;
+	    }
+	    value = str_gnum(str);
+	    size = fcmd->f_size;
+	    CHKLEN(size);
+	    if (fcmd->f_flags & FC_DP) {
+		sprintf(d, "%#*.*f", size, fcmd->f_decimals, value);
+	    } else {
+		sprintf(d, "%*.0f", size, value);
+	    }
+	    d += size;
+	    break;
+	}
 	}
     }
     CHKLEN(1);
diff --git a/form.h b/form.h
index ee055a5f5b..f8c978836b 100644
--- a/form.h
+++ b/form.h
@@ -1,4 +1,4 @@
-/* $Header: form.h,v 3.0 89/10/18 15:17:39 lwall Locked $
+/* $Header: form.h,v 3.0.1.1 90/10/15 17:26:57 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	form.h,v $
+ * Revision 3.0.1.1  90/10/15  17:26:57  lwall
+ * patch29: added @###.## fields to format
+ * 
  * Revision 3.0  89/10/18  15:17:39  lwall
  * 3.0 baseline
  * 
@@ -16,6 +19,7 @@
 #define F_RIGHT 2
 #define F_CENTER 3
 #define F_LINES 4
+#define F_DECIMAL 5
 
 struct formcmd {
     struct formcmd *f_next;
@@ -25,6 +29,7 @@ struct formcmd {
     char *f_pre;
     short f_presize;
     short f_size;
+    short f_decimals;
     char f_type;
     char f_flags;
 };
@@ -33,6 +38,7 @@ struct formcmd {
 #define FC_NOBLANK 2
 #define FC_MORE 4
 #define FC_REPEAT 8
+#define FC_DP 16
 
 #define Nullfcmd Null(FCMD*)
 
diff --git a/h2ph.SH b/h2ph.SH
index cac5adae95..903cad3a70 100644
--- a/h2ph.SH
+++ b/h2ph.SH
@@ -102,7 +102,8 @@ foreach $file (@ARGV) {
 		}
 	    }
 	    elsif (/^include <(.*)>/) {
-		print OUT $t,"do '$1' || die \"Can't include $1: \$!\";\n";
+		($incl = $1) =~ s/\.h$/.ph/;
+		print OUT $t,"require '$incl';\n";
 	    }
 	    elsif (/^ifdef\s+(\w+)/) {
 		print OUT $t,"if (defined &$1) {\n";
diff --git a/hash.c b/hash.c
index a30b01f57b..8a288df1ff 100644
--- a/hash.c
+++ b/hash.c
@@ -1,4 +1,4 @@
-/* $Header: hash.c,v 3.0.1.5 90/08/13 22:18:27 lwall Locked $
+/* $Header: hash.c,v 3.0.1.6 90/10/15 17:32:52 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,12 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	hash.c,v $
+ * Revision 3.0.1.6  90/10/15  17:32:52  lwall
+ * patch29: non-existent array values no longer cause core dumps
+ * patch29: %foo = () will now clear dbm files
+ * patch29: dbm files couldn't be opened read only
+ * patch29: the cache array for dbm files wasn't correctly created on fetches
+ * 
  * Revision 3.0.1.5  90/08/13  22:18:27  lwall
  * patch28: defined(@array) and defined(%array) didn't work right
  * 
@@ -39,11 +45,13 @@ static char coeff[] = {
 		61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
 		61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1};
 
+static void hfreeentries();
+
 STR *
 hfetch(tb,key,klen,lval)
 register HASH *tb;
 char *key;
-int klen;
+unsigned int klen;
 int lval;
 {
     register char *s;
@@ -57,12 +65,12 @@ int lval;
 #endif
 
     if (!tb)
-	return Nullstr;
+	return &str_undef;
     if (!tb->tbl_array) {
 	if (lval)
 	    Newz(503,tb->tbl_array, tb->tbl_max + 1, HENT*);
 	else
-	    return Nullstr;
+	    return &str_undef;
     }
 
     /* The hash function we use on symbols has to be equal to the first
@@ -114,14 +122,14 @@ int lval;
 	hstore(tb,key,klen,str,hash);
 	return str;
     }
-    return Nullstr;
+    return &str_undef;
 }
 
 bool
 hstore(tb,key,klen,val,hash)
 register HASH *tb;
 char *key;
-int klen;
+unsigned int klen;
 STR *val;
 register int hash;
 {
@@ -209,7 +217,7 @@ STR *
 hdelete(tb,key,klen)
 register HASH *tb;
 char *key;
-int klen;
+unsigned int klen;
 {
     register char *s;
     register int i;
@@ -357,41 +365,70 @@ register HENT *hent;
 }
 
 void
-hclear(tb)
+hclear(tb,dodbm)
+register HASH *tb;
+int dodbm;
+{
+    if (!tb)
+	return;
+    hfreeentries(tb,dodbm);
+    tb->tbl_fill = 0;
+#ifndef lint
+    if (tb->tbl_array)
+	(void)bzero((char*)tb->tbl_array, (tb->tbl_max + 1) * sizeof(HENT*));
+#endif
+}
+
+static void
+hfreeentries(tb,dodbm)
 register HASH *tb;
+int dodbm;
 {
     register HENT *hent;
     register HENT *ohent = Null(HENT*);
+#ifdef SOME_DBM
+    datum dkey;
+    datum nextdkey;
+#ifdef NDBM
+    DBM *old_dbm;
+#else
+    int old_dbm;
+#endif
+#endif
 
     if (!tb || !tb->tbl_array)
 	return;
+#ifdef SOME_DBM
+    if ((old_dbm = tb->tbl_dbm) && dodbm) {
+	while (dkey = dbm_firstkey(tb->tbl_dbm), dkey.dptr) {
+	    do {
+		nextdkey = dbm_nextkey(tb->tbl_dbm, dkey);
+		dbm_delete(tb->tbl_dbm,dkey);
+		dkey = nextdkey;
+	    } while (dkey.dptr);	/* one way or another, this works */
+	}
+    }
+    tb->tbl_dbm = 0;			/* now clear just cache */
+#endif
     (void)hiterinit(tb);
     while (hent = hiternext(tb)) {	/* concise but not very efficient */
 	hentfree(ohent);
 	ohent = hent;
     }
     hentfree(ohent);
-    tb->tbl_fill = 0;
-#ifndef lint
-    (void)bzero((char*)tb->tbl_array, (tb->tbl_max + 1) * sizeof(HENT*));
+#ifdef SOME_DBM
+    tb->tbl_dbm = old_dbm;
 #endif
 }
 
 void
-hfree(tb)
+hfree(tb,dodbm)
 register HASH *tb;
+int dodbm;
 {
-    register HENT *hent;
-    register HENT *ohent = Null(HENT*);
-
     if (!tb)
 	return;
-    (void)hiterinit(tb);
-    while (hent = hiternext(tb)) {
-	hentfree(ohent);
-	ohent = hent;
-    }
-    hentfree(ohent);
+    hfreeentries(tb,dodbm);
     Safefree(tb->tbl_array);
     Safefree(tb);
 }
@@ -532,12 +569,14 @@ int mode;
 	hdbmclose(tb);
 	tb->tbl_dbm = 0;
     }
-    hclear(tb);
+    hclear(tb, FALSE);	/* clear cache */
 #ifdef NDBM
     if (mode >= 0)
 	tb->tbl_dbm = dbm_open(fname, O_RDWR|O_CREAT, mode);
     if (!tb->tbl_dbm)
 	tb->tbl_dbm = dbm_open(fname, O_RDWR, mode);
+    if (!tb->tbl_dbm)
+	tb->tbl_dbm = dbm_open(fname, O_RDONLY, mode);
 #else
     if (dbmrefcnt++)
 	fatal("Old dbm can only open one database");
@@ -551,6 +590,8 @@ int mode;
     }
     tb->tbl_dbm = dbminit(fname) >= 0;
 #endif
+    if (!tb->tbl_array && tb->tbl_dbm != 0)
+	Newz(507,tb->tbl_array, tb->tbl_max + 1, HENT*);
     return tb->tbl_dbm != 0;
 }
 
@@ -574,7 +615,7 @@ bool
 hdbmstore(tb,key,klen,str)
 register HASH *tb;
 char *key;
-int klen;
+unsigned int klen;
 register STR *str;
 {
     datum dkey, dcontent;
diff --git a/hash.h b/hash.h
index 430fcfe79e..0a264c1839 100644
--- a/hash.h
+++ b/hash.h
@@ -1,4 +1,4 @@
-/* $Header: hash.h,v 3.0.1.1 90/08/09 03:51:34 lwall Locked $
+/* $Header: hash.h,v 3.0.1.2 90/10/15 17:33:58 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	hash.h,v $
+ * Revision 3.0.1.2  90/10/15  17:33:58  lwall
+ * patch29: the debugger now understands packages and evals
+ * 
  * Revision 3.0.1.1  90/08/09  03:51:34  lwall
  * patch19: various MSDOS and OS/2 patches folded in
  * 
@@ -38,6 +41,7 @@ struct htbl {
     int		tbl_riter;	/* current root of iterator */
     HENT	*tbl_eiter;	/* current entry of iterator */
     SPAT 	*tbl_spatroot;	/* list of spats for this package */
+    char	*tbl_name;	/* name, if a symbol table */
 #ifdef SOME_DBM
 #ifdef NDBM
     DBM		*tbl_dbm;
diff --git a/malloc.c b/malloc.c
index ee926f65d4..86fdb5cbc5 100644
--- a/malloc.c
+++ b/malloc.c
@@ -1,6 +1,9 @@
-/* $Header: malloc.c,v 3.0.1.2 89/11/11 04:36:37 lwall Locked $
+/* $Header: malloc.c,v 3.0.1.3 90/10/16 15:27:47 lwall Locked $
  *
  * $Log:	malloc.c,v $
+ * Revision 3.0.1.3  90/10/16  15:27:47  lwall
+ * patch29: various portability fixes
+ * 
  * Revision 3.0.1.2  89/11/11  04:36:37  lwall
  * patch2: malloc pointer corruption check made more portable
  * 
@@ -53,7 +56,7 @@ static findbucket(), morecore();
  */
 union	overhead {
 	union	overhead *ov_next;	/* when free */
-#if defined (mips) || defined (sparc)
+#if defined(mips) || defined(sparc) || defined(luna88k)
 	double  strut;			/* alignment problems */
 #endif
 	struct {
diff --git a/os2/makefile b/os2/makefile
new file mode 100644
index 0000000000..9d5fac42b0
--- /dev/null
+++ b/os2/makefile
@@ -0,0 +1,125 @@
+#
+# Makefile for compiling Perl under OS/2
+#
+# Needs a Unix compatible make.
+# This makefile works for an initial compilation.  It does not
+# include all dependencies and thus is unsuitable for serious
+# development work.  Hey, I'm just inheriting what Diomidis gave me.
+#
+# Originally by Diomidis Spinellis, March 1990
+# Adjusted for OS/2 port by Raymond Chen, June 1990
+#
+
+# Source files
+SRC = array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c \
+eval.c form.c hash.c perl.y perly.c regcomp.c regexec.c \
+stab.c str.c toke.c util.c os2.c popen.c director.c suffix.c mktemp.c
+
+# Object files
+OBJ = perl.obj array.obj cmd.obj cons.obj consarg.obj doarg.obj doio.obj \
+dolist.obj dump.obj eval.obj form.obj hash.obj perly.obj regcomp.obj \
+regexec.obj stab.obj str.obj toke.obj util.obj os2.obj popen.obj \
+director.obj suffix.obj mktemp.obj
+
+# Files in the OS/2 distribution
+DOSFILES=config.h director.c dir.h makefile os2.c popen.c suffix.c \
+mktemp.c readme.os2
+
+# Yacc flags
+YFLAGS=-d
+
+# Manual pages
+MAN=perlman.1 perlman.2 perlman.3 perlman.4
+
+CC=cl
+# CBASE = flags everybody gets
+# CPLAIN = flags for modules that give the compiler indigestion
+# CFLAGS = flags for milder modules
+# PERL = which version of perl to build
+#
+# For preliminary building:  No optimization, DEBUGGING set, symbols included.
+#CBASE=-AL -Zi -G2 -Gs -DDEBUGGING
+#CPLAIN=$(CBASE) -Od
+#CFLAGS=$(CBASE) -Od
+#PERL=perlsym.exe
+
+# For the final build:  Optimization on, symbols stripped.
+CBASE=-AL -Zi -G2 -Gs -DDEBUGGING
+CPLAIN=$(CBASE) -Olt
+CFLAGS=$(CBASE) -Oeglt
+PERL=perl.exe
+
+# Destination directory for executables
+DESTDIR=\usr\bin
+
+# Deliverables
+#
+all: $(PERL) glob.exe
+
+perl.exe: $(OBJ) perl.arp
+	link @perl.arp,perl,nul,/stack:32767 /NOE;
+	exehdr /nologo /newfiles /pmtype:windowcompat perl.exe >nul
+
+perlsym.exe: $(OBJ) perl.arp
+	link @perl.arp,perlsym,nul,/stack:32767 /NOE /CODE;
+	exehdr /nologo /newfiles /pmtype:windowcompat perlsym.exe >nul
+
+perl.arp:
+	echo array+cmd+cons+consarg+doarg+doio+dolist+dump+ >perl.arp
+	echo eval+form+hash+perl+perly+regcomp+regexec+stab+suffix+ >>perl.arp
+	echo str+toke+util+os2+popen+director+\c600\lib\setargv >>perl.arp
+
+glob.exe: glob.c
+	$(CC) glob.c setargv.obj -link /NOE
+	exehdr /nologo /newfiles /pmtype:windowcompat glob.exe >nul
+
+array.obj: array.c
+	$(CC) $(CPLAIN) -c array.c
+cmd.obj: cmd.c
+cons.obj: cons.c perly.h
+consarg.obj: consarg.c
+#	$(CC) $(CPLAIN) -c consarg.c
+doarg.obj: doarg.c
+doio.obj: doio.c
+dolist.obj: dolist.c
+dump.obj: dump.c
+eval.obj: eval.c evalargs.xc
+	$(CC) /B2c2l /B3c3l $(CFLAGS) -c eval.c
+form.obj: form.c
+hash.obj: hash.c
+perl.obj: perl.y
+perly.obj: perly.c
+regcomp.obj: regcomp.c
+regexec.obj: regexec.c
+stab.obj: stab.c
+	$(CC) $(CPLAIN) -c stab.c
+str.obj: str.c
+suffix.obj: suffix.c
+toke.obj: toke.c
+	$(CC) /B3c3l $(CFLAGS) -c toke.c
+util.obj: util.c
+#	$(CC) $(CPLAIN) -c util.c
+perly.h: ytab.h
+	cp ytab.h perly.h
+director.obj: director.c
+popen.obj: popen.c
+os2.obj: os2.c
+
+perl.1: $(MAN)
+	nroff -man $(MAN) >perl.1
+
+install: all
+	exepack perl.exe $(DESTDIR)\perl.exe
+	exepack glob.exe $(DESTDIR)\glob.exe
+
+clean:
+	rm -f *.obj *.exe perl.1 perly.h perl.arp
+
+tags:
+	ctags *.c *.h *.xc
+
+dosperl:
+	mv $(DOSFILES) ../perl30.new
+
+doskit:
+	mv $(DOSFILES) ../os2
diff --git a/os2/mktemp.c b/os2/mktemp.c
new file mode 100644
index 0000000000..e70507aaee
--- /dev/null
+++ b/os2/mktemp.c
@@ -0,0 +1,28 @@
+/* MKTEMP.C using TMP environment variable */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <io.h>
+
+void Mktemp(char *file)
+{
+  char fname[32], *tmp;
+
+  tmp = getenv("TMP");
+
+  if ( tmp != NULL )
+  {
+    strcpy(fname, file);
+    strcpy(file, tmp);
+
+    if ( file[strlen(file) - 1] != '\\' )
+      strcat(file, "\\");
+
+    strcat(file, fname);
+  }
+
+  mktemp(file);
+}
+
+/* End of MKTEMP.C */
diff --git a/os2/os2.c b/os2/os2.c
new file mode 100644
index 0000000000..279a88f88b
--- /dev/null
+++ b/os2/os2.c
@@ -0,0 +1,273 @@
+/* $Header: os2.c,v 3.0.1.1 90/10/15 17:49:55 lwall Locked $
+ *
+ *    (C) Copyright 1989, 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:	os2.c,v $
+ * Revision 3.0.1.1  90/10/15  17:49:55  lwall
+ * patch29: Initial revision
+ * 
+ * Revision 3.0.1.1  90/03/27  16:10:41  lwall
+ * patch16: MSDOS support
+ *
+ * Revision 1.1  90/03/18  20:32:01  dds
+ * Initial revision
+ *
+ */
+
+#define INCL_DOS
+#define INCL_NOPM
+#include <os2.h>
+
+/*
+ * Various Unix compatibility functions for OS/2
+ */
+
+#include <stdio.h>
+#include <errno.h>
+#include <process.h>
+
+#include "EXTERN.h"
+#include "perl.h"
+
+
+/* dummies */
+
+int ioctl(int handle, unsigned int function, char *data)
+{ return -1; }
+
+int userinit()
+{ return -1; }
+
+int syscall()
+{ return -1; }
+
+
+/* extendd chdir() */
+
+int chdir(char *path)
+{
+  if ( path[0] != 0 && path[1] == ':' )
+    DosSelectDisk(tolower(path[0]) - '@');
+
+  DosChDir(path, 0L);
+}
+
+
+/* priorities */
+
+int setpriority(int class, int pid, int val)
+{
+  int flag = 0;
+
+  if ( pid < 0 )
+  {
+    flag++;
+    pid = -pid;
+  }
+
+  return DosSetPrty(flag ? PRTYS_PROCESSTREE : PRTYS_PROCESS, class, val, pid);
+}
+
+int getpriority(int which /* ignored */, int pid)
+{
+  USHORT val;
+
+  if ( DosGetPrty(PRTYS_PROCESS, &val, pid) )
+    return -1;
+  else
+    return val;
+}
+
+
+/* get parent process id */
+
+int getppid(void)
+{
+  PIDINFO pi;
+
+  DosGetPID(&pi);
+  return pi.pidParent;
+}
+
+
+/* kill */
+
+int kill(int pid, int sig)
+{
+  int flag = 0;
+
+  if ( pid < 0 )
+  {
+    flag++;
+    pid = -pid;
+  }
+
+  switch ( sig & 3 )
+  {
+
+  case 0:
+    DosKillProcess(flag ? DKP_PROCESSTREE : DKP_PROCESS, pid);
+    break;
+
+  case 1: /* FLAG A */
+    DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_A, 0);
+    break;
+
+  case 2: /* FLAG B */
+    DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_B, 0);
+    break;
+
+  case 3: /* FLAG C */
+    DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_C, 0);
+    break;
+
+  }
+}
+
+
+/* Sleep function. */
+void
+sleep(unsigned len)
+{
+   DosSleep(len * 1000L);
+}
+
+/* Just pretend that everyone is a superuser */
+
+int setuid()
+{ return 0; }
+
+int setgid()
+{ return 0; }
+
+int getuid(void)
+{ return 0; }
+
+int geteuid(void)
+{ return 0; }
+
+int getgid(void)
+{ return 0; }
+
+int getegid(void)
+{ return 0; }
+
+/*
+ * The following code is based on the do_exec and do_aexec functions
+ * in file doio.c
+ */
+int
+do_aspawn(really,arglast)
+STR *really;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register char **a;
+    char **argv;
+    char *tmps;
+    int status;
+
+    if (items) {
+	New(1101,argv, items+1, char*);
+	a = argv;
+	for (st += ++sp; items > 0; items--,st++) {
+	    if (*st)
+		*a++ = str_get(*st);
+	    else
+		*a++ = "";
+	}
+	*a = Nullch;
+	if (really && *(tmps = str_get(really)))
+	    status = spawnvp(P_WAIT,tmps,argv);
+	else
+	    status = spawnvp(P_WAIT,argv[0],argv);
+	Safefree(argv);
+    }
+    return status;
+}
+
+char *getenv(char *name);
+
+int
+do_spawn(cmd)
+char *cmd;
+{
+    register char **a;
+    register char *s;
+    char **argv;
+    char flags[10];
+    int status;
+    char *shell, *cmd2;
+
+    /* save an extra exec if possible */
+    if ((shell = getenv("COMSPEC")) == 0)
+	shell = "C:\\OS2\\CMD.EXE";
+
+    /* see if there are shell metacharacters in it */
+    if (strchr(cmd, '>') || strchr(cmd, '<') || strchr(cmd, '|')
+        || strchr(cmd, '&') || strchr(cmd, '^'))
+	  doshell:
+	    return spawnl(P_WAIT,shell,shell,"/C",cmd,(char*)0);
+
+    New(1102,argv, strlen(cmd) / 2 + 2, char*);
+
+    New(1103,cmd2, strlen(cmd) + 1, char);
+    strcpy(cmd2, cmd);
+    a = argv;
+    for (s = cmd2; *s;) {
+	while (*s && isspace(*s)) s++;
+	if (*s)
+	    *(a++) = s;
+	while (*s && !isspace(*s)) s++;
+	if (*s)
+	    *s++ = '\0';
+    }
+    *a = Nullch;
+    if (argv[0])
+	if ((status = spawnvp(P_WAIT,argv[0],argv)) == -1) {
+	    Safefree(argv);
+	    Safefree(cmd2);
+	    goto doshell;
+	}
+    Safefree(cmd2);
+    Safefree(argv);
+    return status;
+}
+
+usage(char *myname)
+{
+#ifdef MSDOS
+  printf("\nUsage: %s [-acdnpsSvw] [-Dnumber] [-i[extension]] [-Idirectory]"
+#else
+  printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]"
+#endif
+         "\n            [-e \"command\"] [-x[directory]] [filename] [arguments]\n", myname);
+
+  printf("\n  -a  autosplit mode with -n or -p"
+         "\n  -c  syntaxcheck only"
+         "\n  -d  run scripts under debugger"
+         "\n  -n  assume 'while (<>) { ...script... }' loop arround your script"
+         "\n  -p  assume loop like -n but print line also like sed"
+#ifndef MSDOS
+         "\n  -P  run script through C preprocessor befor compilation"
+#endif
+         "\n  -s  enable some switch parsing for switches after script name"
+         "\n  -S  look for the script using PATH environment variable");
+#ifndef MSDOS
+  printf("\n  -u  dump core after compiling the script"
+         "\n  -U  allow unsafe operations");
+#endif
+  printf("\n  -v  print version number and patchlevel of perl"
+         "\n  -w  turn warnings on for compilation of your script\n"
+         "\n  -Dnumber        set debugging flags"
+         "\n  -i[extension]   edit <> files in place (make backup if extension supplied)"
+         "\n  -Idirectory     specify include directory in conjunction with -P"
+         "\n  -e command      one line of script, multiple -e options are allowed"
+         "\n                  [filename] can be ommitted, when -e is used"
+         "\n  -x[directory]   strip off text before #!perl line and perhaps cd to directory\n");
+}
diff --git a/os2/perl.bad b/os2/perl.bad
new file mode 100644
index 0000000000..bec21328fc
--- /dev/null
+++ b/os2/perl.bad
@@ -0,0 +1,6 @@
+DOSMAKEPIPE
+DOSCWAIT
+DOSKILLPROCESS
+DOSFLAGPROCESS
+DOSSETPRTY
+DOSGETPRTY
diff --git a/os2/perl.cs b/os2/perl.cs
new file mode 100644
index 0000000000..530f0930df
--- /dev/null
+++ b/os2/perl.cs
@@ -0,0 +1,13 @@
+(-W1 -Od -Olt -DDEBUGGING -Gt2048
+array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c form.c
+hash.c perl.c perly.c regcomp.c regexec.c stab.c str.c util.c
+)
+(-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c{evalargs.xc} toke.c)
+(-W1 -Od -Olt os2.c popen.c mktemp.c director.c suffix.c)
+
+setargv.obj
+perl.def
+perl.bad
+perl.exe
+
+-AL -LB -S0x9000
diff --git a/os2/perl.def b/os2/perl.def
new file mode 100644
index 0000000000..2b49370937
--- /dev/null
+++ b/os2/perl.def
@@ -0,0 +1,2 @@
+NAME PERL WINDOWCOMPAT NEWFILES
+DESCRIPTION 'PERL 3.0, patchlevel 28 - for MS-DOS and OS/2'
diff --git a/patchlevel.h b/patchlevel.h
index dd91c28f63..1d54f19971 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 31
+#define PATCHLEVEL 32
diff --git a/perl.h b/perl.h
index 82d177b42c..1c8655b91d 100644
--- a/perl.h
+++ b/perl.h
@@ -1,4 +1,4 @@
-/* $Header: perl.h,v 3.0.1.8 90/08/09 04:10:53 lwall Locked $
+/* $Header: perl.h,v 3.0.1.9 90/10/15 17:59:41 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	perl.h,v $
+ * Revision 3.0.1.9  90/10/15  17:59:41  lwall
+ * patch29: some machines didn't like unsigned C preprocessor values
+ * 
  * Revision 3.0.1.8  90/08/09  04:10:53  lwall
  * patch19: various MSDOS and OS/2 patches folded in
  * patch19: did preliminary work toward debugging packages and evals
@@ -76,6 +79,8 @@
  */
 #define BINARY				/**/
 
+#define I_FCNTL
+
 #else /* !MSDOS */
 
 /*
@@ -156,7 +161,9 @@ extern int memcmp();
 #include <stdio.h>
 #include <ctype.h>
 #include <setjmp.h>
+#ifndef MSDOS
 #include <sys/param.h>	/* if this needs types.h we're still wrong */
+#endif
 
 #ifndef _TYPES_		/* If types.h defines this it's easy. */
 #ifndef major		/* Does everyone's types.h define this? */
@@ -184,16 +191,20 @@ extern int memcmp();
 #   endif
 #endif
 
+#ifndef MSDOS
 #include <sys/times.h>
+#endif
 
 #if defined(STRERROR) && (!defined(MKDIR) || !defined(RMDIR))
 #undef STRERROR
 #endif
 
 #include <errno.h>
+#ifndef MSDOS
 #ifndef errno
 extern int errno;     /* ANSI allows errno to be an lvalue expr */
 #endif
+#endif
 
 #ifdef STRERROR
 char *strerror();
@@ -288,6 +299,7 @@ typedef struct htbl HASH;
 typedef struct regexp REGEXP;
 typedef struct stabptrs STBP;
 typedef struct stab STAB;
+typedef struct callsave CSV;
 
 #include "handy.h"
 #include "regexp.h"
@@ -396,7 +408,7 @@ EXT STR *Str;
 #define NTOHS
 #endif
 #ifndef HTONL
-#if (BYTEORDER != 0x4321) && (BYTEORDER != 0x87654321)
+#if (BYTEORDER & 0xffff) != 0x4321
 #define HTONS
 #define HTONL
 #define NTOHS
@@ -408,7 +420,7 @@ EXT STR *Str;
 #define ntohl my_ntohl
 #endif
 #else
-#if (BYTEORDER == 0x4321) || (BYTEORDER == 0x87654321)
+#if (BYTEORDER & 0xffff) == 0x4321
 #undef HTONS
 #undef HTONL
 #undef NTOHS
@@ -525,9 +537,9 @@ EXT STR *subname INIT(Nullstr);
 EXT int arybase INIT(0);
 
 struct outrec {
-    line_t  o_lines;
-    char    *o_str;
-    int     o_len;
+    long	o_lines;
+    char	*o_str;
+    int		o_len;
 };
 
 EXT struct outrec outrec;
@@ -547,6 +559,7 @@ EXT STAB *leftstab INIT(Nullstab);
 EXT STAB *amperstab INIT(Nullstab);
 EXT STAB *rightstab INIT(Nullstab);
 EXT STAB *DBstab INIT(Nullstab);
+EXT STAB *DBline INIT(Nullstab);
 EXT STAB *DBsub INIT(Nullstab);
 
 EXT HASH *defstash;		/* main symbol table */
@@ -558,12 +571,12 @@ EXT STR *curstname;		/* name of current package */
 EXT STR *freestrroot INIT(Nullstr);
 EXT STR *lastretstr INIT(Nullstr);
 EXT STR *DBsingle INIT(Nullstr);
+EXT STR *DBtrace INIT(Nullstr);
+EXT STR *DBsignal INIT(Nullstr);
 
 EXT int lastspbase;
 EXT int lastsize;
 
-EXT char *curpack;
-EXT char *filename;
 EXT char *origfilename;
 EXT FILE * VOLATILE rsfp;
 EXT char buf[1024];
@@ -637,7 +650,9 @@ EXT struct stat statbuf;
 EXT struct stat statcache;
 STAB *statstab INIT(Nullstab);
 STR *statname;
+#ifndef MSDOS
 EXT struct tms timesbuf;
+#endif
 EXT int uid;
 EXT int euid;
 EXT int gid;
@@ -692,8 +707,10 @@ EXT ARRAY * VOLATILE savestack;		/* to save non-local values on */
 EXT ARRAY *tosave;		/* strings to save on recursive subroutine */
 
 EXT ARRAY *lineary;		/* lines of script for debugger */
+EXT ARRAY *dbargs;		/* args to call listed by caller function */
 
-EXT ARRAY *pidstatary;		/* keep pids and statuses by fd for mypopen */
+EXT ARRAY *fdpid;		/* keep fd-to-pid mappings for mypopen */
+EXT HASH *pidstatus;		/* keep pid-to-status mappings for waitpid */
 
 EXT int *di;			/* for tmp use in debuggers */
 EXT char *dc;
@@ -701,6 +718,7 @@ EXT short *ds;
 
 double atof();
 long time();
+EXT long basetime INIT(0);
 struct tm *gmtime(), *localtime();
 char *mktemp();
 char *index(), *rindex();
diff --git a/perl.y b/perl.y
index 4b086cfc71..c8394be768 100644
--- a/perl.y
+++ b/perl.y
@@ -1,4 +1,4 @@
-/* $Header: perl.y,v 3.0.1.8 90/08/13 22:19:55 lwall Locked $
+/* $Header: perl.y,v 3.0.1.9 90/10/15 18:01:45 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:	perl.y,v $
+ * Revision 3.0.1.9  90/10/15  18:01:45  lwall
+ * patch29: added SysV IPC
+ * patch29: package behavior is now more consistent
+ * patch29: index and substr now have optional 3rd args
+ * 
  * Revision 3.0.1.8  90/08/13  22:19:55  lwall
  * patch28: lowercase unquoted strings caused infinite loop
  * 
@@ -71,9 +76,9 @@ ARG *arg5;
 %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
 %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
-%token <ival> FUNC0 FUNC1 FUNC2 FUNC3 HSHFUN HSHFUN3
+%token <ival> FUNC0 FUNC1 FUNC2 FUNC2x FUNC3 FUNC4 FUNC5 HSHFUN HSHFUN3
 %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
-%token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER LFUNC4
+%token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER
 %token <formval> FORMLIST
 %token <stabval> REG ARYLEN ARY HSH STAR
 %token <arg> SUBST PATTERN
@@ -346,9 +351,11 @@ package :	PACKAGE WORD ';'
 			  sprintf(tmpbuf,"'_%s",$2);
 			  tmpstab = hadd(stabent(tmpbuf,TRUE));
 			  curstash = stab_xhash(tmpstab);
-			  curpack = stab_name(tmpstab);
+			  if (!curstash->tbl_name)
+			      curstash->tbl_name = savestr($2);
 			  curstash->tbl_coeffsize = 0;
 			  Safefree($2);
+			  cmdline = NOLINE;
 			}
 	;
 
@@ -473,8 +480,7 @@ term	:	'-' term %prec UMINUS
 	|	'(' ')'
 			{ $$ = make_list(Nullarg); }
 	|	DO sexpr	%prec FILETEST
-			{ $$ = fixeval(
-			    make_op(O_DOFILE,2,$2,Nullarg,Nullarg) );
+			{ $$ = make_op(O_DOFILE,2,$2,Nullarg,Nullarg);
 			  allstabs = TRUE;}
 	|	DO block	%prec '('
 			{ $$ = cmd_to_arg($2); }
@@ -584,13 +590,9 @@ term	:	'-' term %prec UMINUS
 			{ $$ = make_op($1,1,cval_to_arg($2),
 			    Nullarg,Nullarg); }
 	|	UNIOP
-			{ $$ = make_op($1,0,Nullarg,Nullarg,Nullarg);
-			  if ($1 == O_EVAL || $1 == O_RESET || $1 == O_REQUIRE)
-			    $$ = fixeval($$); }
+			{ $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
 	|	UNIOP sexpr
-			{ $$ = make_op($1,1,$2,Nullarg,Nullarg);
-			  if ($1 == O_EVAL || $1 == O_RESET || $1 == O_REQUIRE)
-			    $$ = fixeval($$); }
+			{ $$ = make_op($1,1,$2,Nullarg,Nullarg); }
 	|	SSELECT
 			{ $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
 	|	SSELECT '(' handle ')'
@@ -696,21 +698,29 @@ term	:	'-' term %prec UMINUS
 	|	FUNC0 '(' ')'
 			{ $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
 	|	FUNC1 '(' ')'
-			{ $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg);
-			  if ($1 == O_EVAL || $1 == O_RESET || $1 == O_REQUIRE)
-			    $$ = fixeval($$); }
+			{ $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
 	|	FUNC1 '(' expr ')'
-			{ $$ = make_op($1, 1, $3, Nullarg, Nullarg);
-			  if ($1 == O_EVAL || $1 == O_RESET || $1 == O_REQUIRE)
-			    $$ = fixeval($$); }
+			{ $$ = make_op($1, 1, $3, Nullarg, Nullarg); }
 	|	FUNC2 '(' sexpr cexpr ')'
 			{ $$ = make_op($1, 2, $3, $4, Nullarg);
 			    if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
 				fbmcompile($$[2].arg_ptr.arg_str,0); }
+	|	FUNC2x '(' sexpr csexpr ')'
+			{ $$ = make_op($1, 2, $3, $4, Nullarg);
+			    if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
+				fbmcompile($$[2].arg_ptr.arg_str,0); }
+	|	FUNC2x '(' sexpr csexpr cexpr ')'
+			{ $$ = make_op($1, 3, $3, $4, $5);
+			    if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
+				fbmcompile($$[2].arg_ptr.arg_str,0); }
 	|	FUNC3 '(' sexpr csexpr cexpr ')'
 			{ $$ = make_op($1, 3, $3, $4, $5); }
-	|	LFUNC4 '(' sexpr csexpr csexpr cexpr ')'
-			{ arg4 = $6; $$ = make_op($1, 4, l($3), $4, $5); }
+	|	FUNC4 '(' sexpr csexpr csexpr cexpr ')'
+			{ arg4 = $6;
+			  $$ = make_op($1, 4, $3, $4, $5); }
+	|	FUNC5 '(' sexpr csexpr csexpr csexpr cexpr ')'
+			{ arg4 = $6; arg5 = $7;
+			  $$ = make_op($1, 5, $3, $4, $5); }
 	|	HSHFUN '(' hshword ')'
 			{ $$ = make_op($1, 1,
 				$3,
diff --git a/t/op.index b/t/op.index
index af227457ef..da822065cd 100644
--- a/t/op.index
+++ b/t/op.index
@@ -1,8 +1,8 @@
 #!./perl
 
-# $Header: op.index,v 3.0 89/10/18 15:29:29 lwall Locked $
+# $Header: op.index,v 3.0.1.1 90/10/16 10:50:28 lwall Locked $
 
-print "1..6\n";
+print "1..20\n";
 
 
 $foo = 'Now is the time for all good men to come to the aid of their country.';
@@ -24,3 +24,19 @@ print ($last eq "." ? "ok 5\n" : "not ok 5\n");
 
 $last = substr($foo,rindex($foo,'.'),100);
 print ($last eq "." ? "ok 6\n" : "not ok 6\n");
+
+print index("ababa","a",-1) == 0 ? "ok 7\n" : "not ok 7\n";
+print index("ababa","a",0) == 0 ? "ok 8\n" : "not ok 8\n";
+print index("ababa","a",1) == 2 ? "ok 9\n" : "not ok 9\n";
+print index("ababa","a",2) == 2 ? "ok 10\n" : "not ok 10\n";
+print index("ababa","a",3) == 4 ? "ok 11\n" : "not ok 11\n";
+print index("ababa","a",4) == 4 ? "ok 12\n" : "not ok 12\n";
+print index("ababa","a",5) == -1 ? "ok 13\n" : "not ok 13\n";
+
+print rindex("ababa","a",-1) == -1 ? "ok 14\n" : "not ok 14\n";
+print rindex("ababa","a",0) == 0 ? "ok 15\n" : "not ok 15\n";
+print rindex("ababa","a",1) == 0 ? "ok 16\n" : "not ok 16\n";
+print rindex("ababa","a",2) == 2 ? "ok 17\n" : "not ok 17\n";
+print rindex("ababa","a",3) == 2 ? "ok 18\n" : "not ok 18\n";
+print rindex("ababa","a",4) == 4 ? "ok 19\n" : "not ok 19\n";
+print rindex("ababa","a",5) == 4 ? "ok 20\n" : "not ok 20\n";
diff --git a/t/op.s b/t/op.s
new file mode 100644
index 0000000000..c5d85611fa
--- /dev/null
+++ b/t/op.s
@@ -0,0 +1,179 @@
+#!./perl
+
+# $Header: op.s,v 3.0.1.2 90/10/16 10:51:50 lwall Locked $
+
+print "1..51\n";
+
+$x = 'foo';
+$_ = "x";
+s/x/\$x/;
+print "#1\t:$_: eq :\$x:\n";
+if ($_ eq '$x') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$_ = "x";
+s/x/$x/;
+print "#2\t:$_: eq :foo:\n";
+if ($_ eq 'foo') {print "ok 2\n";} else {print "not ok 2\n";}
+
+$_ = "x";
+s/x/\$x $x/;
+print "#3\t:$_: eq :\$x foo:\n";
+if ($_ eq '$x foo') {print "ok 3\n";} else {print "not ok 3\n";}
+
+$b = 'cd';
+($a = 'abcdef') =~ s'(b${b}e)'\n$1';
+print "#4\t:$1: eq :bcde:\n";
+print "#4\t:$a: eq :a\\n\$1f:\n";
+if ($1 eq 'bcde' && $a eq 'a\n$1f') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$a = 'abacada';
+if (($a =~ s/a/x/g) == 4 && $a eq 'xbxcxdx')
+    {print "ok 5\n";} else {print "not ok 5\n";}
+
+if (($a =~ s/a/y/g) == 0 && $a eq 'xbxcxdx')
+    {print "ok 6\n";} else {print "not ok 6 $a\n";}
+
+if (($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx')
+    {print "ok 7\n";} else {print "not ok 7 $a\n";}
+
+$_ = 'ABACADA';
+if (/a/i && s///gi && $_ eq 'BCD') {print "ok 8\n";} else {print "not ok 8 $_\n";}
+
+$_ = '\\' x 4;
+if (length($_) == 4) {print "ok 9\n";} else {print "not ok 9\n";}
+s/\\/\\\\/g;
+if ($_ eq '\\' x 8) {print "ok 10\n";} else {print "not ok 10 $_\n";}
+
+$_ = '\/' x 4;
+if (length($_) == 8) {print "ok 11\n";} else {print "not ok 11\n";}
+s/\//\/\//g;
+if ($_ eq '\\//' x 4) {print "ok 12\n";} else {print "not ok 12\n";}
+if (length($_) == 12) {print "ok 13\n";} else {print "not ok 13\n";}
+
+$_ = 'aaaXXXXbbb';
+s/^a//;
+print $_ eq 'aaXXXXbbb' ? "ok 14\n" : "not ok 14\n";
+
+$_ = 'aaaXXXXbbb';
+s/a//;
+print $_ eq 'aaXXXXbbb' ? "ok 15\n" : "not ok 15\n";
+
+$_ = 'aaaXXXXbbb';
+s/^a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 16\n" : "not ok 16\n";
+
+$_ = 'aaaXXXXbbb';
+s/a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 17\n" : "not ok 17\n";
+
+$_ = 'aaaXXXXbbb';
+s/aa//;
+print $_ eq 'aXXXXbbb' ? "ok 18\n" : "not ok 18\n";
+
+$_ = 'aaaXXXXbbb';
+s/aa/b/;
+print $_ eq 'baXXXXbbb' ? "ok 19\n" : "not ok 19\n";
+
+$_ = 'aaaXXXXbbb';
+s/b$//;
+print $_ eq 'aaaXXXXbb' ? "ok 20\n" : "not ok 20\n";
+
+$_ = 'aaaXXXXbbb';
+s/b//;
+print $_ eq 'aaaXXXXbb' ? "ok 21\n" : "not ok 21\n";
+
+$_ = 'aaaXXXXbbb';
+s/bb//;
+print $_ eq 'aaaXXXXb' ? "ok 22\n" : "not ok 22\n";
+
+$_ = 'aaaXXXXbbb';
+s/aX/y/;
+print $_ eq 'aayXXXbbb' ? "ok 23\n" : "not ok 23\n";
+
+$_ = 'aaaXXXXbbb';
+s/Xb/z/;
+print $_ eq 'aaaXXXzbb' ? "ok 24\n" : "not ok 24\n";
+
+$_ = 'aaaXXXXbbb';
+s/aaX.*Xbb//;
+print $_ eq 'ab' ? "ok 25\n" : "not ok 25\n";
+
+$_ = 'aaaXXXXbbb';
+s/bb/x/;
+print $_ eq 'aaaXXXXxb' ? "ok 26\n" : "not ok 26\n";
+
+# now for some unoptimized versions of the same.
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/^a//;
+print $_ eq 'aaXXXXbbb' ? "ok 27\n" : "not ok 27\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/a//;
+print $_ eq 'aaXXXXbbb' ? "ok 28\n" : "not ok 28\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/^a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 29\n" : "not ok 29\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 30\n" : "not ok 30\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aa//;
+print $_ eq 'aXXXXbbb' ? "ok 31\n" : "not ok 31\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aa/b/;
+print $_ eq 'baXXXXbbb' ? "ok 32\n" : "not ok 32\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/b$//;
+print $_ eq 'aaaXXXXbb' ? "ok 33\n" : "not ok 33\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/b//;
+print $_ eq 'aaaXXXXbb' ? "ok 34\n" : "not ok 34\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/bb//;
+print $_ eq 'aaaXXXXb' ? "ok 35\n" : "not ok 35\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aX/y/;
+print $_ eq 'aayXXXbbb' ? "ok 36\n" : "not ok 36\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/Xb/z/;
+print $_ eq 'aaaXXXzbb' ? "ok 37\n" : "not ok 37\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aaX.*Xbb//;
+print $_ eq 'ab' ? "ok 38\n" : "not ok 38\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/bb/x/;
+print $_ eq 'aaaXXXXxb' ? "ok 39\n" : "not ok 39\n";
+
+$_ = 'abc123xyz';
+s/\d+/$&*2/e;              # yields 'abc246xyz'
+print $_ eq 'abc246xyz' ? "ok 40\n" : "not ok 40\n";
+s/\d+/sprintf("%5d",$&)/e; # yields 'abc  246xyz'
+print $_ eq 'abc  246xyz' ? "ok 41\n" : "not ok 41\n";
+s/\w/$& x 2/eg;            # yields 'aabbcc  224466xxyyzz'
+print $_ eq 'aabbcc  224466xxyyzz' ? "ok 42\n" : "not ok 42\n";
+
+$_ = "aaaaa";
+print y/a/b/ == 5 ? "ok 43\n" : "not ok 43\n";
+print y/a/b/ == 0 ? "ok 44\n" : "not ok 44\n";
+print y/b// == 5 ? "ok 45\n" : "not ok 45\n";
+print y/b/c/s == 5 ? "ok 46\n" : "not ok 46\n";
+print y/c// == 1 ? "ok 47\n" : "not ok 47\n";
+print y/c//d == 1 ? "ok 48\n" : "not ok 48\n";
+print $_ eq "" ? "ok 49\n" : "not ok 49\n";
+
+$_ = "Now is the %#*! time for all good men...";
+print (($x=(y/a-zA-Z //cd)) == 7 ? "ok 50\n" : "not ok 50\n");
+print y/ / /s == 8 ? "ok 51\n" : "not ok 51\n";
+
diff --git a/t/op.stat b/t/op.stat
index c6fca7893b..5a6f63aefe 100644
--- a/t/op.stat
+++ b/t/op.stat
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: op.stat,v 3.0.1.4 90/08/13 22:31:36 lwall Locked $
+# $Header: op.stat,v 3.0.1.5 90/10/16 10:55:42 lwall Locked $
 
 print "1..56\n";
 
@@ -97,7 +97,7 @@ $cnt = $uid = 0;
 
 die "Can't run op.stat test 35 without pwd working" unless $cwd;
 chdir '/usr/bin' || die "Can't cd to /usr/bin";
-while (<*>) {
+while (defined($_ = <*>)) {
     $cnt++;
     $uid++ if -u;
     last if $uid && $uid < $cnt;
diff --git a/t/op.substr b/t/op.substr
index c91c377330..bbe2c046b0 100644
--- a/t/op.substr
+++ b/t/op.substr
@@ -1,8 +1,8 @@
 #!./perl
 
-# $Header: op.substr,v 3.0 89/10/18 15:31:52 lwall Locked $
+# $Header: op.substr,v 3.0.1.1 90/10/16 10:56:35 lwall Locked $
 
-print "1..19\n";
+print "1..22\n";
 
 $a = 'abcdefxyz';
 
@@ -40,3 +40,8 @@ print $a eq '12345678abcXYZ<' ? "ok 18\n" : "not ok 18\n";
 substr($a,-1,1) = '12345678';
 print $a eq '12345678abcXYZ12345678' ? "ok 19\n" : "not ok 19\n";
 
+$a = 'abcdefxyz';
+
+print (substr($a,6) eq 'xyz' ? "ok 20\n" : "not ok 20\n");
+print (substr($a,-3) eq 'xyz' ? "ok 21\n" : "not ok 21\n");
+print (substr($a,999) eq '' ? "ok 22\n" : "not ok 22\n");
diff --git a/usub/mus b/usub/mus
index 490f0082a7..3f772bd864 100644
--- a/usub/mus
+++ b/usub/mus
@@ -103,7 +103,7 @@ EOF
 	}
 	elsif ($rettype =~ /^[A-Z]+\s*\*$/) {
 	    print <<EOF;
-	    str_set(st[0], (char*) &retval, sizeof retval);
+	    str_nset(st[0], (char*) &retval, sizeof retval);
 EOF
 	}
 	else {