perl 3.0 patch #36 patch #29, continued

See patch #29.

7 files changed, 330 insertions, 238 deletions

diff --git a/doarg.c b/doarg.c
index 151bcb4880..768c6c38ee 100644
--- a/doarg.c
+++ b/doarg.c
@@ -1,4 +1,4 @@
-/* $Header: doarg.c,v 3.0.1.7 90/08/13 22:14:15 lwall Locked $
+/* $Header: doarg.c,v 3.0.1.8 90/10/15 16:04:04 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,14 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	doarg.c,v $
+ * Revision 3.0.1.8  90/10/15  16:04:04  lwall
+ * patch29: @ENV = () now works
+ * patch29: added caller
+ * patch29: tr/// now understands c, d and s options, and handles nulls right
+ * patch29: *foo now prints as *package'foo
+ * patch29: added caller
+ * patch29: local() without initialization now creates undefined values
+ * 
  * Revision 3.0.1.7  90/08/13  22:14:15  lwall
  * patch28: the NSIG hack didn't work on Xenix
  * patch28: defined(@array) and defined(%array) didn't work right
@@ -59,7 +67,7 @@
 
 extern unsigned char fold[];
 
-int wantarray;
+extern char **environ;
 
 #ifdef BUGGY_MSC
  #pragma function(memcmp)
@@ -320,15 +328,17 @@ nope:
 int
 do_trans(str,arg)
 STR *str;
-register ARG *arg;
+ARG *arg;
 {
-    register char *tbl;
+    register short *tbl;
     register char *s;
     register int matches = 0;
     register int ch;
     register char *send;
+    register char *d;
+    register int squash = arg[2].arg_len & 1;
 
-    tbl = arg[2].arg_ptr.arg_cval;
+    tbl = (short*) arg[2].arg_ptr.arg_cval;
     s = str_get(str);
     send = s + str->str_cur;
     if (!tbl || !s)
@@ -338,12 +348,36 @@ register ARG *arg;
 	deb("2.TBL\n");
     }
 #endif
-    while (s < send) {
-	if (ch = tbl[*s & 0377]) {
-	    matches++;
-	    *s = ch;
+    if (!arg[2].arg_len) {
+	while (s < send) {
+	    if ((ch = tbl[*s & 0377]) >= 0) {
+		matches++;
+		*s = ch;
+	    }
+	    s++;
+	}
+    }
+    else {
+	d = s;
+	while (s < send) {
+	    if ((ch = tbl[*s & 0377]) >= 0) {
+		*d = ch;
+		if (matches++ && squash) {
+		    if (d[-1] == *d)
+			matches--;
+		    else
+			d++;
+		}
+		else
+		    d++;
+	    }
+	    else if (ch == -1)		/* -1 is unmapped character */
+		*d++ = *s;		/* -2 is delete character */
+	    s++;
 	}
-	s++;
+	matches += send - d;	/* account for disappeared chars */
+	*d = '\0';
+	str->str_cur = d - str->str_ptr;
     }
     STABSET(str);
     return matches;
@@ -713,10 +747,14 @@ register STR **sarg;
 		xlen = (*sarg)->str_cur;
 		if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B'
 		  && xlen == sizeof(STBP) && strlen(xs) < xlen) {
-		    xs = stab_name(((STAB*)(*sarg))); /* a stab value! */
-		    sprintf(tokenbuf,"*%s",xs);	/* reformat to non-binary */
+		    STR *tmpstr = Str_new(24,0);
+
+		    stab_fullname(tmpstr, ((STAB*)(*sarg))); /* a stab value! */
+		    sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
+					/* reformat to non-binary */
 		    xs = tokenbuf;
 		    xlen = strlen(tokenbuf);
+		    str_free(tmpstr);
 		}
 		if (strEQ(t-2,"%s")) {	/* some printfs fail on >128 chars */
 		    *buf = '\0';
@@ -801,11 +839,12 @@ int *arglast;
     register int sp = arglast[1];
     register int items = arglast[2] - sp;
     register SUBR *sub;
-    ARRAY *savearray;
+    STR *str;
     STAB *stab;
-    char *oldfile = filename;
     int oldsave = savestack->ary_fill;
     int oldtmps_base = tmps_base;
+    int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
+    register CSV *csv;
 
     if ((arg[1].arg_type & A_MASK) == A_WORD)
 	stab = arg[1].arg_ptr.arg_stab;
@@ -819,115 +858,60 @@ int *arglast;
     }
     if (!stab)
 	fatal("Undefined subroutine called");
-    saveint(&wantarray);
-    wantarray = gimme;
-    sub = stab_sub(stab);
-    if (!sub)
-	fatal("Undefined subroutine \"%s\" called", stab_name(stab));
-    if (sub->usersub) {
-	st[sp] = arg->arg_ptr.arg_str;
-	if ((arg[2].arg_type & A_MASK) == A_NULL)
-	    items = 0;
-	return sub->usersub(sub->userindex,sp,items);
-    }
-    if ((arg[2].arg_type & A_MASK) != A_NULL) {
-	savearray = stab_xarray(defstab);
-	stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
+    if (arg->arg_type == O_DBSUBR) {
+	str = stab_val(DBsub);
+	saveitem(str);
+	stab_fullname(str,stab);
+	sub = stab_sub(DBsub);
+	if (!sub)
+	    fatal("No DBsub routine");
     }
-    savelong(&sub->depth);
-    sub->depth++;
-    if (sub->depth >= 2) {	/* save temporaries on recursion? */
-	if (sub->depth == 100 && dowarn)
-	    warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
-	savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
-    }
-    filename = sub->filename;
-    tmps_base = tmps_max;
-    sp = cmd_exec(sub->cmd,gimme,--sp);		/* so do it already */
-    st = stack->ary_array;
-
-    if ((arg[2].arg_type & A_MASK) != A_NULL) {
-	afree(stab_xarray(defstab));  /* put back old $_[] */
-	stab_xarray(defstab) = savearray;
-    }
-    filename = oldfile;
-    tmps_base = oldtmps_base;
-    if (savestack->ary_fill > oldsave) {
-	for (items = arglast[0] + 1; items <= sp; items++)
-	    st[items] = str_static(st[items]);
-		/* in case restore wipes old str */
-	restorelist(oldsave);
-    }
-    return sp;
-}
-
-int
-do_dbsubr(arg,gimme,arglast)
-register ARG *arg;
-int gimme;
-int *arglast;
-{
-    register STR **st = stack->ary_array;
-    register int sp = arglast[1];
-    register int items = arglast[2] - sp;
-    register SUBR *sub;
-    ARRAY *savearray;
-    STR *str;
-    STAB *stab;
-    char *oldfile = filename;
-    int oldsave = savestack->ary_fill;
-    int oldtmps_base = tmps_base;
-
-    if ((arg[1].arg_type & A_MASK) == A_WORD)
-	stab = arg[1].arg_ptr.arg_stab;
     else {
-	STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
+	if (!(sub = stab_sub(stab))) {
+	    STR *tmpstr = arg[0].arg_ptr.arg_str;
 
-	if (tmpstr)
-	    stab = stabent(str_get(tmpstr),TRUE);
-	else
-	    stab = Nullstab;
+	    stab_fullname(tmpstr, stab);
+	    fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
+	}
     }
-    if (!stab)
-	fatal("Undefined subroutine called");
-    saveint(&wantarray);
-    wantarray = gimme;
-/* begin differences */
-    str = stab_val(DBsub);
-    saveitem(str);
-    str_set(str,stab_name(stab));
-    sub = stab_sub(DBsub);
-    if (!sub)
-	fatal("No DBsub routine");
-/* end differences */
-    if ((arg[2].arg_type & A_MASK) != A_NULL) {
-	savearray = stab_xarray(defstab);
-	stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
+    str = Str_new(15, sizeof(CSV));
+    str->str_state = SS_SCSV;
+    (void)apush(savestack,str);
+    csv = (CSV*)str->str_ptr;
+    csv->sub = sub;
+    csv->stab = stab;
+    csv->curcsv = curcsv;
+    csv->curcmd = curcmd;
+    csv->depth = sub->depth;
+    csv->wantarray = gimme;
+    csv->hasargs = hasargs;
+    curcsv = csv;
+    if (sub->usersub) {
+	st[sp] = arg->arg_ptr.arg_str;
+	if (!hasargs)
+	    items = 0;
+	return (*sub->usersub)(sub->userindex,sp,items);
+    }
+    if (hasargs) {
+	csv->savearray = stab_xarray(defstab);
+	csv->argarray = afake(defstab, items, &st[sp+1]);
+	stab_xarray(defstab) = csv->argarray;
     }
-    savelong(&sub->depth);
     sub->depth++;
     if (sub->depth >= 2) {	/* save temporaries on recursion? */
 	if (sub->depth == 100 && dowarn)
 	    warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
 	savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
     }
-    filename = sub->filename;
     tmps_base = tmps_max;
     sp = cmd_exec(sub->cmd,gimme, --sp);	/* so do it already */
     st = stack->ary_array;
 
-    if ((arg[2].arg_type & A_MASK) != A_NULL) {
-	afree(stab_xarray(defstab));  /* put back old $_[] */
-	stab_xarray(defstab) = savearray;
-    }
-    filename = oldfile;
     tmps_base = oldtmps_base;
-    if (savestack->ary_fill > oldsave) {
-	for (items = arglast[0] + 1; items <= sp; items++)
-	    st[items] = str_static(st[items]);
-		/* in case restore wipes old str */
-	restorelist(oldsave);
-    }
+    for (items = arglast[0] + 1; items <= sp; items++)
+	st[items] = str_static(st[items]);
+	    /* in case restore wipes old str */
+    restorelist(oldsave);
     return sp;
 }
 
@@ -992,12 +976,31 @@ int *arglast;
 	    else if (str->str_state == SS_HASH) {
 		char *tmps;
 		STR *tmpstr;
+		int magic = 0;
+		STAB *tmpstab = str->str_u.str_stab;
 
 		if (makelocal)
 		    hash = savehash(str->str_u.str_stab);
 		else {
 		    hash = stab_hash(str->str_u.str_stab);
-		    hclear(hash);
+		    if (tmpstab == envstab) {
+			magic = 'E';
+			environ[0] = Nullch;
+		    }
+		    else if (tmpstab == sigstab) {
+			magic = 'S';
+#ifndef NSIG
+#define NSIG 32
+#endif
+			for (i = 1; i < NSIG; i++)
+			    signal(i, SIG_DFL);	/* crunch, crunch, crunch */
+		    }
+#ifdef SOME_DBM
+		    else if (hash->tbl_dbm)
+			magic = 'D';
+#endif
+		    hclear(hash, magic == 'D');	/* wipe any dbm file too */
+
 		}
 		while (relem < lastrelem) {	/* gobble up all the rest */
 		    if (*relem)
@@ -1010,6 +1013,10 @@ int *arglast;
 			str_sset(tmpstr,*relem);	/* value */
 		    *(relem++) = tmpstr;
 		    (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
+		    if (magic) {
+			str_magic(tmpstr, tmpstab, magic, tmps, str->str_cur);
+			stabset(tmpstr->str_magic, tmpstr);
+		    }
 		}
 	    }
 	    else
@@ -1023,7 +1030,7 @@ int *arglast;
 		*(relem++) = str;
 	    }
 	    else {
-		str_nset(str, "", 0);
+		str_sset(str, &str_undef);
 		if (gimme == G_ARRAY) {
 		    i = ++lastrelem - firstrelem;
 		    relem++;		/* tacky, I suppose */
@@ -1207,7 +1214,15 @@ int *arglast;
     }
     else if (type == O_HASH || type == O_LHASH) {
 	stab = arg[1].arg_ptr.arg_stab;
-	(void)hfree(stab_xhash(stab));
+	if (stab == envstab)
+	    environ[0] = Nullch;
+	else if (stab == sigstab) {
+	    int i;
+
+	    for (i = 1; i < NSIG; i++)
+		signal(i, SIG_DFL);	/* munch, munch, munch */
+	}
+	(void)hfree(stab_xhash(stab), TRUE);
 	stab_xhash(stab) = Null(HASH*);
     }
     else if (type == O_SUBR || type == O_DBSUBR) {
diff --git a/patchlevel.h b/patchlevel.h
index 68fcfefec9..d248b3566e 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 35
+#define PATCHLEVEL 36
diff --git a/perly.c b/perly.c
index 33b4a32cee..a914a4b24e 100644
--- a/perly.c
+++ b/perly.c
@@ -1,4 +1,4 @@
-char rcsid[] = "$Header: perly.c,v 3.0.1.7 90/08/13 22:22:22 lwall Locked $\nPatch level: ###\n";
+char rcsid[] = "$Header: perly.c,v 3.0.1.8 90/10/16 10:14:20 lwall Locked $\nPatch level: ###\n";
 /*
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,15 @@ char rcsid[] = "$Header: perly.c,v 3.0.1.7 90/08/13 22:22:22 lwall Locked $\nPat
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	perly.c,v $
+ * Revision 3.0.1.8  90/10/16  10:14:20  lwall
+ * patch29: *foo now prints as *package'foo
+ * patch29: added waitpid
+ * patch29: the debugger now understands packages and evals
+ * patch29: added -M, -A and -C
+ * patch29: -w sometimes printed spurious warnings about ARGV and ENV
+ * patch29: require "./foo" didn't work right
+ * patch29: require error messages referred to wrong file
+ * 
  * Revision 3.0.1.7  90/08/13  22:22:22  lwall
  * patch28: defined(@array) and defined(%array) didn't work right
  * 
@@ -45,7 +54,11 @@ char rcsid[] = "$Header: perly.c,v 3.0.1.7 90/08/13 22:22:22 lwall Locked $\nPat
 #include "EXTERN.h"
 #include "perl.h"
 #include "perly.h"
+#ifdef MSDOS
+#include "patchlev.h"
+#else
 #include "patchlevel.h"
+#endif
 
 #ifdef IAMSUID
 #ifndef DOSUID
@@ -113,6 +126,7 @@ setuid perl scripts securely.\n");
     curstash = defstash = hnew(0);
     curstname = str_make("main",4);
     stab_xhash(stabent("_main",TRUE)) = defstash;
+    defstash->tbl_name = "main";
     incstab = hadd(aadd(stabent("INC",TRUE)));
     incstab->str_pok |= SP_MULTI;
     for (argc--,argv++; argc > 0; argc--,argv++) {
@@ -274,17 +288,18 @@ setuid perl scripts securely.\n");
 	argv[0] = savestr(xfound);
     }
 
-    pidstatary = anew(Nullstab);	/* for remembering popen pids, status */
+    fdpid = anew(Nullstab);	/* for remembering popen pids by fd */
+    pidstatus = hnew(Nullstab);	/* for remembering status of dead pids */
 
     origfilename = savestr(argv[0]);
-    filename = origfilename;
-    if (strEQ(filename,"-"))
+    curcmd->c_filestab = fstab(origfilename);
+    if (strEQ(origfilename,"-"))
 	argv[0] = "";
     if (preprocess) {
 	str_cat(str,"-I");
 	str_cat(str,PRIVLIB);
 	(void)sprintf(buf, "\
-/bin/sed %s -e '/^[^#]/b' \
+%ssed %s -e '/^[^#]/b' \
  -e '/^#[ 	]*include[ 	]/b' \
  -e '/^#[ 	]*define[ 	]/b' \
  -e '/^#[ 	]*if[ 	]/b' \
@@ -294,6 +309,11 @@ setuid perl scripts securely.\n");
  -e '/^#[ 	]*endif/b' \
  -e 's/^#.*//' \
  %s | %s -C %s %s",
+#ifdef MSDOS
+	  "",
+#else
+	  "/bin/",
+#endif
 	  (doextract ? "-e '1,/^#/d\n'" : ""),
 	  argv[0], CPPSTDIN, str_get(str), CPPMINUS);
 	  doextract = FALSE;
@@ -318,7 +338,7 @@ setuid perl scripts securely.\n");
     if (rsfp == Nullfp) {
 #ifdef DOSUID
 #ifndef IAMSUID		/* in case script is not readable before setuid */
-	if (euid && stat(filename,&statbuf) >= 0 &&
+	if (euid && stat(stab_val(curcmd->c_filestab)->str_ptr,&statbuf) >= 0 &&
 	  statbuf.st_mode & (S_ISUID|S_ISGID)) {
 	    (void)sprintf(buf, "%s/%s", BIN, "suidperl");
 	    execv(buf, origargv);	/* try again */
@@ -327,7 +347,7 @@ setuid perl scripts securely.\n");
 #endif
 #endif
 	fatal("Can't open perl script \"%s\": %s\n",
-	  filename, strerror(errno));
+	  stab_val(curcmd->c_filestab)->str_ptr, strerror(errno));
     }
     str_free(str);		/* free -I directories */
 
@@ -359,7 +379,7 @@ setuid perl scripts securely.\n");
 
 #ifdef DOSUID
     if (fstat(fileno(rsfp),&statbuf) < 0)	/* normal stat is insecure */
-	fatal("Can't stat script \"%s\"",filename);
+	fatal("Can't stat script \"%s\"",origfilename);
     if (statbuf.st_mode & (S_ISUID|S_ISGID)) {
 	int len;
 
@@ -373,7 +393,7 @@ setuid perl scripts securely.\n");
 	 * But I don't think it's too important.  The manual lies when
 	 * it says access() is useful in setuid programs.
 	 */
-	if (access(filename,1))		/* as a double check */
+	if (access(stab_val(curcmd->c_filestab)->str_ptr,1))	/*double check*/
 	    fatal("Permission denied");
 #else
 	/* If we can swap euid and uid, then we can determine access rights
@@ -386,8 +406,8 @@ setuid perl scripts securely.\n");
 
 	    if (setreuid(euid,uid) < 0 || getuid() != euid || geteuid() != uid)
 		fatal("Can't swap uid and euid");	/* really paranoid */
-	    if (stat(filename,&tmpstatbuf) < 0) /* testing full pathname here */
-		fatal("Permission denied");
+	    if (stat(stab_val(curcmd->c_filestab)->str_ptr,&tmpstatbuf) < 0)
+		fatal("Permission denied");	/* testing full pathname here */
 	    if (tmpstatbuf.st_dev != statbuf.st_dev ||
 		tmpstatbuf.st_ino != statbuf.st_ino) {
 		(void)fclose(rsfp);
@@ -397,7 +417,8 @@ setuid perl scripts securely.\n");
 (Filename of set-id script was %s, uid %d gid %d.)\n\nSincerely,\nperl\n",
 			uid,tmpstatbuf.st_dev, tmpstatbuf.st_ino,
 			statbuf.st_dev, statbuf.st_ino,
-			filename, statbuf.st_uid, statbuf.st_gid);
+			stab_val(curcmd->c_filestab)->str_ptr,
+			statbuf.st_uid, statbuf.st_gid);
 		    (void)mypclose(rsfp);
 		}
 		fatal("Permission denied\n");
@@ -555,15 +576,22 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 	debstash = hnew(0);
 	stab_xhash(stabent("_DB",TRUE)) = debstash;
 	curstash = debstash;
-	lineary = stab_xarray(aadd((tmpstab = stabent("line",TRUE))));
+	dbargs = stab_xarray(aadd((tmpstab = stabent("args",TRUE))));
 	tmpstab->str_pok |= SP_MULTI;
+	dbargs->ary_flags = 0;
 	subname = str_make("main",4);
 	DBstab = stabent("DB",TRUE);
 	DBstab->str_pok |= SP_MULTI;
+	DBline = stabent("dbline",TRUE);
+	DBline->str_pok |= SP_MULTI;
 	DBsub = hadd(tmpstab = stabent("sub",TRUE));
 	tmpstab->str_pok |= SP_MULTI;
 	DBsingle = stab_val((tmpstab = stabent("single",TRUE)));
 	tmpstab->str_pok |= SP_MULTI;
+	DBtrace = stab_val((tmpstab = stabent("trace",TRUE)));
+	tmpstab->str_pok |= SP_MULTI;
+	DBsignal = stab_val((tmpstab = stabent("signal",TRUE)));
+	tmpstab->str_pok |= SP_MULTI;
 	curstash = defstash;
     }
 
@@ -611,7 +639,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 	(void)hadd(sigstab);
     }
 
-    magicalize("!#?^~=-%0123456789.+&*()<>,\\/[|`':");
+    magicalize("!#?^~=-%0123456789.+&*()<>,\\/[|`':\024");
     userinit();		/* in case linked C routines want magical variables */
 
     amperstab = stabent("&",allstabs);
@@ -620,6 +648,8 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
     sawampersand = (amperstab || leftstab || rightstab);
     if (tmpstab = stabent(":",allstabs))
 	str_set(STAB_STR(tmpstab),chopset);
+    if (tmpstab = stabent("\024",allstabs))
+	time(&basetime);
 
     /* these aren't necessarily magical */
     if (tmpstab = stabent(";",allstabs))
@@ -662,13 +692,6 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 
     statname = Str_new(66,0);		/* last filename we did stat on */
 
-    perldb = FALSE;		/* don't try to instrument evals */
-
-    if (dowarn) {
-	stab_check('A','Z');
-	stab_check('a','z');
-    }
-
     if (do_undump)
 	abort();
 
@@ -702,7 +725,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
     if (envstab = stabent("ENV",allstabs)) {
 	envstab->str_pok |= SP_MULTI;
 	(void)hadd(envstab);
-	hclear(stab_hash(envstab));
+	hclear(stab_hash(envstab), FALSE);
 	if (env != environ)
 	    environ[0] = Nullch;
 	for (; *env; env++) {
@@ -721,6 +744,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
     if (tmpstab = stabent("$",allstabs))
 	str_numset(STAB_STR(tmpstab),(double)getpid());
 
+    if (dowarn) {
+	stab_check('A','Z');
+	stab_check('a','z');
+    }
+
     if (setjmp(top_env))	/* sets goto_targ on longjump */
 	loop_ptr = -1;		/* start label stack again */
 
@@ -785,15 +813,16 @@ int *arglast;
     CMD *myroot;
     ARRAY *ar;
     int i;
-    char * VOLATILE oldfile = filename;
     CMD * VOLATILE oldcurcmd = curcmd;
     VOLATILE int oldtmps_base = tmps_base;
     VOLATILE int oldsave = savestack->ary_fill;
+    VOLATILE int oldperldb = perldb;
     SPAT * VOLATILE oldspat = curspat;
     static char *last_eval = Nullch;
     static CMD *last_root = Nullcmd;
     VOLATILE int sp = arglast[0];
     char *specfilename;
+    char *tmpfilename;
 
     tmps_base = tmps_max;
     if (curstash != stash) {
@@ -801,9 +830,11 @@ int *arglast;
 	curstash = stash;
     }
     str_set(stab_val(stabent("@",TRUE)),"");
+    if (curcmd->c_line == 0)		/* don't debug debugger... */
+	perldb = FALSE;
     curcmd = &compiling;
     if (optype == O_EVAL) {		/* normal eval */
-	filename = "(eval)";
+	curcmd->c_filestab = fstab("(eval)");
 	curcmd->c_line = 1;
 	str_sset(linestr,str);
 	str_cat(linestr,";");		/* be kind to them */
@@ -815,35 +846,39 @@ int *arglast;
 	    last_root = Nullcmd;
 	}
 	specfilename = str_get(str);
-	filename = savestr(specfilename);	/* can't free this easily */
 	str_set(linestr,"");
-	if (optype == O_REQUIRE &&
+	if (optype == O_REQUIRE && &str_undef !=
 	  hfetch(stab_hash(incstab), specfilename, strlen(specfilename), 0)) {
-	    filename = oldfile;
+	    curcmd = oldcurcmd;
 	    tmps_base = oldtmps_base;
 	    st[++sp] = &str_yes;
+	    perldb = oldperldb;
 	    return sp;
 	}
-	else if (*filename == '/')
-	    rsfp = fopen(filename,"r");
+	tmpfilename = savestr(specfilename);
+	if (index("/.", *tmpfilename))
+	    rsfp = fopen(tmpfilename,"r");
 	else {
 	    ar = stab_array(incstab);
-	    Safefree(filename);
 	    for (i = 0; i <= ar->ary_fill; i++) {
-		(void)sprintf(buf,"%s/%s",str_get(afetch(ar,i,TRUE)),filename);
+		(void)sprintf(buf, "%s/%s",
+		  str_get(afetch(ar,i,TRUE)), specfilename);
 		rsfp = fopen(buf,"r");
 		if (rsfp) {
 		    char *s = buf;
 
 		    if (*s == '.' && s[1] == '/')
 			s += 2;
-		    filename = savestr(s);
+		    Safefree(tmpfilename);
+		    tmpfilename = savestr(s);
 		    break;
 		}
 	    }
 	}
+	curcmd->c_filestab = fstab(tmpfilename);
+	Safefree(tmpfilename);
 	if (!rsfp) {
-	    filename = oldfile;
+	    curcmd = oldcurcmd;
 	    tmps_base = oldtmps_base;
 	    if (optype == O_REQUIRE) {
 		sprintf(tokenbuf,"Can't locate %s in @INC", specfilename);
@@ -855,6 +890,7 @@ int *arglast;
 	    }
 	    if (gimme != G_ARRAY)
 		st[++sp] = &str_undef;
+	    perldb = oldperldb;
 	    return sp;
 	}
 	curcmd->c_line = 0;
@@ -879,8 +915,10 @@ int *arglast;
     }
     else {
 	error_count = 0;
-	if (rsfp)
+	if (rsfp) {
 	    retval = yyparse();
+	    retval |= error_count;
+	}
 	else if (last_root && *bufptr == *last_eval && strEQ(bufptr,last_eval)){
 	    retval = 0;
 	    eval_root = last_root;	/* no point in reparsing */
@@ -893,6 +931,7 @@ int *arglast;
 	    last_eval = savestr(bufptr);
 	    last_root = Nullcmd;
 	    retval = yyparse();
+	    retval |= error_count;
 	    if (!retval)
 		last_root = eval_root;
 	}
@@ -900,7 +939,8 @@ int *arglast;
 	    retval = yyparse();
     }
     myroot = eval_root;		/* in case cmd_exec does another eval! */
-    if (retval || error_count) {
+
+    if (retval) {
 	st = stack->ary_array;
 	sp = arglast[0];
 	if (gimme != G_ARRAY)
@@ -909,8 +949,6 @@ int *arglast;
 	if (rsfp) {
 	    fclose(rsfp);
 	    rsfp = 0;
-	    if (optype == O_REQUIRE)
-		fatal("%s", str_get(stab_val(stabent("@",TRUE))));
 	}
     }
     else {
@@ -921,30 +959,40 @@ int *arglast;
 				/* if we don't save result, free zaps it */
 	if (in_eval != 1 && myroot != last_root)
 	    cmd_free(myroot);
-	if (optype != O_EVAL) {
-	    if (gimme == G_SCALAR ? str_true(st[sp]) : sp > arglast[0]) {
-		(void)hstore(stab_hash(incstab), specfilename,
-		  strlen(specfilename), str_make(filename,0), 0 );
-	    }
-	    else if (optype == O_REQUIRE)
-		fatal("%s did not return a true value", specfilename);
-	}
     }
+
+    perldb = oldperldb;
     in_eval--;
 #ifdef DEBUGGING
-	if (debug & 4) {
-	    char *tmps = loop_stack[loop_ptr].loop_label;
-	    deb("(Popping label #%d %s)\n",loop_ptr,
-		tmps ? tmps : "" );
-	}
+    if (debug & 4) {
+	char *tmps = loop_stack[loop_ptr].loop_label;
+	deb("(Popping label #%d %s)\n",loop_ptr,
+	    tmps ? tmps : "" );
+    }
 #endif
     loop_ptr--;
-    filename = oldfile;
-    curcmd = oldcurcmd;
     tmps_base = oldtmps_base;
     curspat = oldspat;
     if (savestack->ary_fill > oldsave)	/* let them use local() */
 	restorelist(oldsave);
+
+    if (optype != O_EVAL) {
+	if (retval) {
+	    if (optype == O_REQUIRE)
+		fatal("%s", str_get(stab_val(stabent("@",TRUE))));
+	}
+	else {
+	    curcmd = oldcurcmd;
+	    if (gimme == G_SCALAR ? str_true(st[sp]) : sp > arglast[0]) {
+		(void)hstore(stab_hash(incstab), specfilename,
+		  strlen(specfilename), str_smake(stab_val(curcmd->c_filestab)),
+		      0 );
+	    }
+	    else if (optype == O_REQUIRE)
+		fatal("%s did not return a true value", specfilename);
+	}
+    }
+    curcmd = oldcurcmd;
     return sp;
 }
 
@@ -1017,15 +1065,23 @@ char *s;
 	s++;
 	return s;
     case 'v':
+	fputs("\nThis is perl, version 3.0\n\n",stdout);
 	fputs(rcsid,stdout);
 	fputs("\nCopyright (c) 1989, 1990, Larry Wall\n",stdout);
 #ifdef MSDOS
 	fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
 	stdout);
+#ifdef OS2
+        fputs("OS/2 port Copyright (c) 1990, Raymond Chen, Kai Uwe Rommel\n",
+        stdout);
+#endif
 #endif
 	fputs("\n\
 Perl may be copied only under the terms of the GNU General Public License,\n\
 a copy of which can be found with the Perl 3.0 distribution kit.\n",stdout);
+#ifdef MSDOS
+        usage(origargv[0]);
+#endif
 	exit(0);
     case 'w':
 	dowarn = TRUE;
diff --git a/usersub.c b/usersub.c
index 8eb0b4cb3c..8ded8da133 100644
--- a/usersub.c
+++ b/usersub.c
@@ -1,10 +1,13 @@
-/* $Header: usersub.c,v 3.0.1.1 90/08/09 05:40:45 lwall Locked $
+/* $Header: usersub.c,v 3.0.1.2 90/10/16 11:22:04 lwall Locked $
  *
  *  This file contains stubs for routines that the user may define to
  *  set up glue routines for C libraries or to decrypt encrypted scripts
  *  for execution.
  *
  * $Log:	usersub.c,v $
+ * Revision 3.0.1.2  90/10/16  11:22:04  lwall
+ * patch29: added waitpid
+ * 
  * Revision 3.0.1.1  90/08/09  05:40:45  lwall
  * patch19: Initial revision
  * 
@@ -96,9 +99,8 @@ VOID	(*func)();
     }
     close(p[1]);
     fclose(fil);
-    str = afetch(pidstatary,p[0],TRUE);
-    str_numset(str,(double)pipepid);
-    str->str_cur = 0;
+    str = afetch(fdpid,p[0],TRUE);
+    str->str_u.str_useful = pipepid;
     return fdopen(p[0], "r");
 }
 
diff --git a/util.c b/util.c
index 0487d93de0..74df0fdac4 100644
--- a/util.c
+++ b/util.c
@@ -1,4 +1,4 @@
-/* $Header: util.c,v 3.0.1.7 90/08/13 22:40:26 lwall Locked $
+/* $Header: util.c,v 3.0.1.8 90/10/16 11:26:57 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:	util.c,v $
+ * Revision 3.0.1.8  90/10/16  11:26:57  lwall
+ * patch29: added waitpid
+ * patch29: various portability fixes
+ * patch29: scripts now run at almost full speed under the debugger
+ * 
  * Revision 3.0.1.7  90/08/13  22:40:26  lwall
  * patch28: the NSIG hack didn't work right on Xenix
  * patch28: rename was busted on systems without rename system call
@@ -437,7 +442,7 @@ int iflag;
     register int i;
     register int len = str->str_cur;
     int rarest = 0;
-    int frequency = 256;
+    unsigned int frequency = 256;
 
     Str_Grow(str,len+258);
 #ifndef lint
@@ -479,7 +484,7 @@ int iflag;
     s = Null(unsigned char*);
 #endif
     if (iflag) {
-	register int tmp, foldtmp;
+	register unsigned int tmp, foldtmp;
 	str->str_pok |= SP_CASEFOLD;
 	for (i = 0; i < len; i++) {
 	    tmp=freq[s[i]];
@@ -559,7 +564,7 @@ STR *littlestr;
     s = big + littlelen;
     oldlittle = little = table - 2;
     if (littlestr->str_pok & SP_CASEFOLD) {	/* case insensitive? */
-	while (s < bigend) {
+	if (s < bigend) {
 	  top1:
 	    if (tmp = table[*s]) {
 #ifdef POINTERRIGOR
@@ -592,7 +597,7 @@ STR *littlestr;
 	}
     }
     else {
-	while (s < bigend) {
+	if (s < bigend) {
 	  top2:
 	    if (tmp = table[*s]) {
 #ifdef POINTERRIGOR
@@ -777,7 +782,8 @@ long a1, a2, a3, a4;
     s += strlen(s);
     if (s[-1] != '\n') {
 	if (curcmd->c_line) {
-	    (void)sprintf(s," at %s line %ld", filename, (long)curcmd->c_line);
+	    (void)sprintf(s," at %s line %ld",
+	      stab_val(curcmd->c_filestab)->str_ptr, (long)curcmd->c_line);
 	    s += strlen(s);
 	}
 	if (last_in_stab &&
@@ -874,7 +880,8 @@ va_list args;
     s += strlen(s);
     if (s[-1] != '\n') {
 	if (curcmd->c_line) {
-	    (void)sprintf(s," at %s line %ld", filename, (long)curcmd->c_line);
+	    (void)sprintf(s," at %s line %ld",
+	      stab_val(curcmd->c_filestab)->str_ptr, (long)curcmd->c_line);
 	    s += strlen(s);
 	}
 	if (last_in_stab &&
@@ -1229,6 +1236,7 @@ char	*mode;
 	if (tmpstab = stabent("$",allstabs))
 	    str_numset(STAB_STR(tmpstab),(double)getpid());
 	forkprocess = 0;
+	hclear(pidstatus);	/* we have no children */
 	return Nullfp;
 #undef THIS
 #undef THAT
@@ -1240,9 +1248,8 @@ char	*mode;
 	close(p[this]);
 	p[this] = p[that];
     }
-    str = afetch(pidstatary,p[this],TRUE);
-    str_numset(str,(double)pid);
-    str->str_cur = 0;
+    str = afetch(fdpid,p[this],TRUE);
+    str->str_u.str_useful = pid;
     forkprocess = pid;
     return fdopen(p[this], mode);
 }
@@ -1298,36 +1305,77 @@ FILE *ptr;
 #endif
     int status;
     STR *str;
-    register int pid;
+    int pid;
 
-    str = afetch(pidstatary,fileno(ptr),TRUE);
+    str = afetch(fdpid,fileno(ptr),TRUE);
+    astore(fdpid,fileno(ptr),Nullstr);
     fclose(ptr);
-    pid = (int)str_gnum(str);
-    if (!pid)
-	return -1;
+    pid = (int)str->str_u.str_useful;
     hstat = signal(SIGHUP, SIG_IGN);
     istat = signal(SIGINT, SIG_IGN);
     qstat = signal(SIGQUIT, SIG_IGN);
+    pid = wait4pid(pid, &status, 0);
+    signal(SIGHUP, hstat);
+    signal(SIGINT, istat);
+    signal(SIGQUIT, qstat);
+    return(pid < 0 ? pid : status);
+}
+
+int
+wait4pid(pid,statusp,flags)
+int pid;
+int *statusp;
+int flags;
+{
+    int result;
+    STR *str;
+    char spid[16];
+
+    if (!pid)
+	return -1;
 #ifdef WAIT4
-    if (wait4(pid,&status,0,Null(struct rusage *)) < 0)
-	status = -1;
+    return wait4(pid,statusp,flags,Null(struct rusage *));
 #else
-    if (pid < 0)		/* already exited? */
-	status = str->str_cur;
+#ifdef WAITPID
+    return waitpid(pid,statusp,flags);
+#else
+    if (pid > 0) {
+	sprintf(spid, "%d", pid);
+	str = hfetch(pidstatus,spid,strlen(pid),FALSE);
+	if (str != &str_undef) {
+	    *statusp = (int)str->str_u.str_useful;
+	    hdelete(pidstatus,spid,strlen(pid));
+	    return pid;
+	}
+    }
+    else {
+	HENT *entry;
+
+	hiterinit(pidstatus);
+	if (entry = hiternext(pidstatus)) {
+	    pid = atoi(hiterkey(entry,statusp));
+	    str = hiterval(entry);
+	    *statusp = (int)str->str_u.str_useful;
+	    sprintf(spid, "%d", pid);
+	    hdelete(pidstatus,spid,strlen(pid));
+	    return pid;
+	}
+    }
+    if (flags)
+	fatal("Can't do waitpid with flags");
     else {
 	int result;
+	register int count;
+	register STR *str;
 
-	while ((result = wait(&status)) != pid && result >= 0)
-	    pidgone(result,status);
+	while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
+	    pidgone(result,*statusp);
 	if (result < 0)
-	    status = -1;
+	    *statusp = -1;
     }
 #endif
-    signal(SIGHUP, hstat);
-    signal(SIGINT, istat);
-    signal(SIGQUIT, qstat);
-    str_numset(str,0.0);
-    return(status);
+#endif
+    return result;
 }
 #endif /* !MSDOS */
 
@@ -1335,21 +1383,16 @@ pidgone(pid,status)
 int pid;
 int status;
 {
-#ifdef WAIT4
-    return;
+#if defined(WAIT4) || defined(WAITPID)
 #else
-    register int count;
     register STR *str;
+    char spid[16];
 
-    for (count = pidstatary->ary_fill; count >= 0; --count) {
-	if ((str = afetch(pidstatary,count,FALSE)) &&
-	  ((int)str->str_u.str_nval) == pid) {
-	    str_numset(str, -str->str_u.str_nval);
-	    str->str_cur = status;
-	    return;
-	}
-    }
+    sprintf(spid, "%d", pid);
+    str = hfetch(pidstatus,pid,strlen(pid),TRUE);
+    str->str_u.str_useful = status;
 #endif
+    return;
 }
 
 #ifndef MEMCMP
diff --git a/x2p/util.c b/x2p/util.c
index 27b08b0862..07f19a3715 100644
--- a/x2p/util.c
+++ b/x2p/util.c
@@ -1,4 +1,4 @@
-/* $Header: util.c,v 3.0 89/10/18 15:35:35 lwall Locked $
+/* $Header: util.c,v 3.0.1.1 90/10/16 11:34:06 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:	util.c,v $
+ * Revision 3.0.1.1  90/10/16  11:34:06  lwall
+ * patch29: removed #ifdef undef
+ * 
  * Revision 3.0  89/10/18  15:35:35  lwall
  * 3.0 baseline
  * 
@@ -103,36 +106,6 @@ register int len;
     return to;
 }
 
-#ifdef undef
-/* safe version of string concatenate, with \n deletion and space padding */
-
-char *
-safecat(to,from,len)
-char *to;
-register char *from;
-register int len;
-{
-    register char *dest = to;
-
-    len--;				/* leave room for null */
-    if (*dest) {
-	while (len && *dest++) len--;
-	if (len) {
-	    len--;
-	    *(dest-1) = ' ';
-	}
-    }
-    if (from != Nullch)
-	while (len && (*dest++ = *from++)) len--;
-    if (len)
-	dest--;
-    if (*(dest-1) == '\n')
-	dest--;
-    *dest = '\0';
-    return to;
-}
-#endif
-
 /* copy a string up to some (non-backslashed) delimiter, if any */
 
 char *
diff --git a/x2p/walk.c b/x2p/walk.c
index ce164530b4..555e13c1a3 100644
--- a/x2p/walk.c
+++ b/x2p/walk.c
@@ -1,4 +1,4 @@
-/* $Header: walk.c,v 3.0.1.5 90/08/09 05:55:01 lwall Locked $
+/* $Header: walk.c,v 3.0.1.6 90/10/16 11:35:51 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:	walk.c,v $
+ * Revision 3.0.1.6  90/10/16  11:35:51  lwall
+ * patch29: a2p mistranslated certain weird field separators
+ * 
  * Revision 3.0.1.5  90/08/09  05:55:01  lwall
  * patch19: a2p emited local($_) without a semicolon
  * patch19: a2p didn't make explicit split on whitespace skip leading whitespace
@@ -694,7 +697,7 @@ sub Pick {\n\
 		i = fstr->str_ptr[1] & 127;
 		if (index("*+?.[]()|^$\\",i))
 		    sprintf(tokenbuf,"/\\%c/",i);
-		else if (i = ' ')
+		else if (i == ' ')
 		    sprintf(tokenbuf,"' '");
 		else
 		    sprintf(tokenbuf,"/%c/",i);