perl 3.0 patch #34 patch #29, continued

See patch #29.

7 files changed, 505 insertions, 319 deletions

diff --git a/os2/popen.c b/os2/popen.c
index 7c71ccc076..15c11122d0 100644
--- a/os2/popen.c
+++ b/os2/popen.c
@@ -1,210 +1,237 @@
-/*
- * Pipe support for OS/2.
- *
- * WARNING:  I am guilty of chumminess with the runtime library because
- *           I had no choice.  Details to follow.
- *
+/* added real/protect mode branch at runtime and real mode version
+ * names changed for perl
+ * Kai Uwe Rommel
  */
 
-#include "EXTERN.h"
-#include "perl.h"
-#define INCL_DOSPROCESS
-#define INCL_DOSQUEUES
-#define INCL_DOSMISC
-#define INCL_DOSMEMMGR
-#include <os2.h>
+/*
+Several people in the past have asked about having Unix-like pipe
+calls in OS/2.  The following source file, adapted from 4.3 BSD Unix,
+uses a #define to give you a pipe(2) call, and contains function
+definitions for popen(3) and pclose(3).  Anyone with problems should
+send mail to me; they seem to work fine.
 
-extern char **environ;
+Mark Towfigh
+Racal Interlan, Inc.
+----------------------------------cut-here------------------------------------
+*/
 
-/* This mysterious array _osfile is used internally by the runtime
- * library to remember assorted things about open file handles.
- * The problem is that we are creating file handles via DosMakePipe,
- * rather than via the runtime library.  This means that we have
- * to fake the runtime library into thinking that the handles we've
- * created are honest file handles.  So just before doing the fdopen,
- * we poke in a magic value that fools the library functions into
- * thinking that the handle is already open in text mode.
+/*
+ * The following code segment is derived from BSD 4.3 Unix.  See
+ * copyright below.  Any bugs, questions, improvements, or problems
+ * should be sent to Mark Towfigh (towfiq@interlan.interlan.com).
  *
- * This might not work for your compiler, so beware.
+ * Racal InterLan Inc.
  */
-extern char _osfile[];
 
-/* The maximum number of simultaneously open pipes.  We create an
- * array of this size to record information about each open pipe.
+/*
+ * Copyright (c) 1980 Regents of the University of California.
+ * All rights reserved.  The Berkeley software License Agreement
+ * specifies the terms and conditions for redistribution.
  */
-#define MAXPIPES 5
 
-/* Information to remember about each open pipe.
- * The (FILE *) that popen returns is stored because that's the only
- * way we can keep track of the pipes.
+#include <stdio.h>
+#include <stdlib.h>
+#include <io.h>
+#include <string.h>
+#include <process.h>
+#include <errno.h>
+
+#define INCL_NOPM
+#define	INCL_DOS
+#include <os2.h>
+
+static FILE *dos_popen(const char *cmd, const char *flags);
+static int dos_pclose(FILE *pipe);
+
+/*
+ * emulate Unix pipe(2) call
  */
-typedef struct pipeinfo {
-	FILE *pfId;		/* Which FILE we're talking about */
-	HFILE hfMe;		/* handle I should close at pclose */
-	PID pidChild;		/* Child's PID */
-	CHAR fReading;		/* A read or write pipe? */
-} PIPEINFO, *PPIPEINFO;		/* pi and ppi */
 
-static PIPEINFO PipeInfo[MAXPIPES];
+#define	tst(a,b)	(*mode == 'r'? (b) : (a))
+#define READH           0
+#define WRITEH          1
+
+static  int       popen_pid[20];
 
-FILE *mypopen(const char *command, const char *t)
+FILE *mypopen(char *cmd, char *mode)
 {
-	typedef char *PSZZ;
-	PSZZ pszzPipeArgs = 0;
-	PSZZ pszzEnviron = 0;
-	PSZ *ppsz;
-	PSZ psz;
-	FILE *f;
-	HFILE hfMe, hfYou;
-	HFILE hf, hfSave;
-	RESULTCODES rc;
-	USHORT us;
-	PPIPEINFO ppi;
-	UINT i;
-
-	/* Validate pipe type */
-	if (*t != 'w' && *t != 'r') fatal("Unknown pipe type");
-
-	/* Room for another pipe? */
-	for (ppi = &PipeInfo[0]; ppi < &PipeInfo[MAXPIPES]; ppi++)
-		if (ppi->pfId == 0) goto foundone;
-	return NULL;
-
-foundone:
-
-	/* Make the pipe */
-	if (DosMakePipe(&hfMe, &hfYou, 0)) return NULL;
-
-	/* Build the environment.  First compute its length, then copy
-	 * the environment strings into it.
-	 */
-	i = 0;
-	for (ppsz = environ; *ppsz; ppsz++) i += 1 + strlen(*ppsz);
-	New(1204, pszzEnviron, 1+i, CHAR);
-
-	psz = pszzEnviron;
-	for (ppsz = environ; *ppsz; ppsz++) {
-		strcpy(psz, *ppsz);
-		psz += 1 + strlen(*ppsz);
+	int p[2];
+        register myside, hisside, save_stream;
+        char *shell = getenv("COMPSPEC");
+
+        if ( shell == NULL )
+          shell = "C:\\OS2\\CMD.EXE";
+
+        if ( _osmode == DOS_MODE )
+          return dos_popen(cmd, mode);
+
+	if (DosMakePipe((PHFILE) &p[0], (PHFILE) &p[1], 4096) < 0)
+                return NULL;
+
+        myside = tst(p[WRITEH], p[READH]);
+        hisside = tst(p[READH], p[WRITEH]);
+
+	/* set up file descriptors for remote function */
+	save_stream = dup(tst(0, 1));		/* don't lose stdin/out! */
+        if (dup2(hisside, tst(0, 1)) < 0)
+        {
+		perror("dup2");
+		return NULL;
 	}
-	*psz = 0;
+        close(hisside);
 
-	/* Build the command string to execute.
-	 * 6 = length(0 "/c " 0 0)
+	/*
+	 * make sure that we can close our side of the pipe, by
+	 * preventing it from being inherited!
 	 */
-	if (DosScanEnv("COMSPEC", &psz)) psz = "C:\\OS2\\cmd.exe";
-#if 0
-	New(1203, pszzPipeArgs, strlen(psz) + strlen(command) + 6, CHAR);
-#else
-#define pszzPipeArgs buf
-#endif
-	sprintf(pszzPipeArgs, "%s%c/c %s%c", psz, 0, command, 0);
-
-	/* Now some stuff that depends on what kind of pipe we're doing.
-	 * We pull a sneaky trick; namely, that stdin = 0 = false,
-	 * and stdout = 1 = true.  The end result is that if the
-	 * pipe is a read pipe, then hf = 1; if it's a write pipe, then
-	 * hf = 0 and Me and You are reversed.
-	 */
-	if (!(hf = (*t == 'r'))) {
-		/* The meaning of Me and You is reversed for write pipes. */
-		hfSave = hfYou; hfYou = hfMe; hfMe = hfSave;
-	}
 
-	ppi->fReading = hf;
+	/* set no-inheritance flag */
+	DosSetFHandState(myside, OPEN_FLAGS_NOINHERIT);
 
-	/* Trick number 1:  Fooling the runtime library into thinking
- 	 * that the file handle is legit.
-	 *
-	 * Trick number 2:  Don't let my handle go over to the child!
-	 * Since the child never closes it (why should it?), I'd better
-	 * make sure he never sees it in the first place.  Otherwise,
-	 * we are in deadlock city.
-	 */
-	_osfile[hfMe] = 0x81;		/* Danger, Will Robinson! */
-	if (!(ppi->pfId = fdopen(hfMe, t))) goto no_fdopen;
-	DosSetFHandState(hfMe, OPEN_FLAGS_NOINHERIT);
+	/* execute the command:  it will inherit our other file descriptors */
+        popen_pid[myside] = spawnlp(P_NOWAIT, shell, shell, "/C", cmd, NULL);
+
+	/* now restore our previous file descriptors */
+        if (dup2(save_stream, tst(0, 1)) < 0)   /* retrieve stdin/out */
+        {
+		perror("dup2");
+		return NULL;
+	}
+        close(save_stream);
 
-	/* Save the original handle because we're going to diddle it */
-	hfSave = 0xFFFF;
-	if (DosDupHandle(hf, &hfSave)) goto no_dup_init;
+	return fdopen(myside, mode);		/* return a FILE pointer */
+}
 
-	/* Force the child's handle onto the stdio handle */
-	if (DosDupHandle(hfYou, &hf)) goto no_force_dup;
-	DosClose(hfYou);
+int mypclose(FILE *ptr)
+{
+	register f;
+        int status;
 
-	/* Now run the guy servicing the pipe */
-	us = DosExecPgm(NULL, 0, EXEC_ASYNCRESULT, pszzPipeArgs, pszzEnviron,
-			&rc, pszzPipeArgs);
+        if ( _osmode == DOS_MODE )
+          return dos_pclose(ptr);
 
-	/* Restore stdio handle, even if exec failed. */
-	DosDupHandle(hfSave, &hf); close(hfSave);
+	f = fileno(ptr);
+        fclose(ptr);
 
-	/* See if the exec succeeded. */
-	if (us) goto no_exec_pgm;
+	/* wait for process to terminate */
+	cwait(&status, popen_pid[f], WAIT_GRANDCHILD);
 
-	/* Remember the child's PID */
-	ppi->pidChild = rc.codeTerminate;
+	return status;
+}
 
-	Safefree(pszzEnviron);
 
-	/* Phew. */
-	return ppi->pfId;
+int pipe(int *filedes)
+{
+  int res;
+
+  if ( res = DosMakePipe((PHFILE) &filedes[0], (PHFILE) &filedes[1], 4096) )
+    return res;
 
-	/* Here is where we clean up after an error. */
-no_exec_pgm: ;
-no_force_dup: close(hfSave);
-no_dup_init: fclose(f);
-no_fdopen:
-	DosClose(hfMe); DosClose(hfYou);
-	ppi->pfId = 0;
-	Safefree(pszzEnviron);
-	return NULL;
+  DosSetFHandState(filedes[0], OPEN_FLAGS_NOINHERIT);
+  DosSetFHandState(filedes[1], OPEN_FLAGS_NOINHERIT);
+  return 0;
 }
 
 
-/* mypclose:  Closes the pipe associated with the file handle.
- * After waiting for the child process to terminate, its return
- * code is returned.  If the stream was not associated with a pipe,
- * we return -1.
- */
-int
-mypclose(FILE *f)
+/* this is the MS-DOS version */
+
+typedef enum { unopened = 0, reading, writing } pipemode;
+
+static struct
 {
-	PPIPEINFO ppi;
-	RESULTCODES rc;
-	USHORT us;
-
-	/* Find the pipe this (FILE *) refers to */
-	for (ppi = &PipeInfo[0]; ppi < &PipeInfo[MAXPIPES]; ppi++)
-		if (ppi->pfId == f) goto foundit;
-	return -1;
-foundit:
-	if (ppi->fReading && !DosRead(fileno(f), &rc, 1, &us) && us > 0) {
-		DosKillProcess(DKP_PROCESSTREE, ppi->pidChild);
-	}
-	fclose(f);
-	DosCwait(DCWA_PROCESS, DCWW_WAIT, &rc, &ppi->pidChild, ppi->pidChild);
-	ppi->pfId = 0;
-	return rc.codeResult;
+    char *name;
+    char *command;
+    pipemode pmode;
 }
+pipes[_NFILE];
 
-/* pipe:  The only tricky thing is letting the runtime library know about
- * our two new file descriptors.
- */
-int pipe(int filedes[2])
+static FILE *dos_popen(const char *command, const char *mode)
 {
-	HFILE hfRead, hfWrite;
-	USHORT usResult;
-
-	usResult = DosMakePipe(&hfRead, &hfWrite, 0);
-	if (usResult) {
-		/* Error 4 == ERROR_TOO_MANY_OPEN_FILES */
-		errno = (usResult == 4) ? ENFILE : ENOMEM;
-		return -1;
-	}
-	_osfile[hfRead] = _osfile[hfWrite] = 0x81;/* Danger, Will Robinson! */
-	filedes[0] = hfRead;
-	filedes[1] = hfWrite;
-	return 0;
+    FILE *current;
+    char name[128];
+    int cur;
+    pipemode curmode;
+
+    /*
+    ** decide on mode.
+    */
+    if(strchr(mode, 'r') != NULL)
+        curmode = reading;
+    else if(strchr(mode, 'w') != NULL)
+        curmode = writing;
+    else
+        return NULL;
+
+    /*
+    ** get a name to use.
+    */
+    strcpy(name, "piXXXXXX");
+    Mktemp(name);
+
+    /*
+    ** If we're reading, just call system to get a file filled with
+    ** output.
+    */
+    if(curmode == reading)
+    {
+        char cmd[256];
+        sprintf(cmd,"%s > %s", command, name);
+        system(cmd);
+
+        if((current = fopen(name, mode)) == NULL)
+            return NULL;
+    }
+    else
+    {
+        if((current = fopen(name, mode)) == NULL)
+            return NULL;
+    }
+
+    cur = fileno(current);
+    pipes[cur].name = strdup(name);
+    pipes[cur].command = strdup(command);
+    pipes[cur].pmode = curmode;
+
+    return current;
+}
+
+static int dos_pclose(FILE * current)
+{
+    int cur = fileno(current), rval;
+    char command[256];
+
+    /*
+    ** check for an open file.
+    */
+    if(pipes[cur].pmode == unopened)
+        return -1;
+
+    if(pipes[cur].pmode == reading)
+    {
+        /*
+        ** input pipes are just files we're done with.
+        */
+        rval = fclose(current);
+        unlink(pipes[cur].name);
+    }
+    else
+    {
+        /*
+        ** output pipes are temporary files we have
+        ** to cram down the throats of programs.
+        */
+        fclose(current);
+        sprintf(command,"%s < %s", pipes[cur].command, pipes[cur].name);
+        rval = system(command);
+        unlink(pipes[cur].name);
+    }
+
+    /*
+    ** clean up current pipe.
+    */
+    free(pipes[cur].name);
+    free(pipes[cur].command);
+    pipes[cur].pmode = unopened;
+
+    return rval;
 }
diff --git a/os2/selfrun.cmd b/os2/selfrun.cmd
new file mode 100644
index 0000000000..471a959005
--- /dev/null
+++ b/os2/selfrun.cmd
@@ -0,0 +1,7 @@
+extproc perl -x
+#!perl
+
+printf "
+This is a self-running perl script using the
+extproc feature of the OS/2 command processor.
+"
diff --git a/patchlevel.h b/patchlevel.h
index 1d5b76f174..3b47b479b6 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 33
+#define PATCHLEVEL 34
diff --git a/regcomp.c b/regcomp.c
index e3ef1ba43c..04d62c313b 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -7,9 +7,12 @@
  * blame Henry for some of the lack of readability.
  */
 
-/* $Header: regcomp.c,v 3.0.1.5 90/08/13 22:23:29 lwall Locked $
+/* $Header: regcomp.c,v 3.0.1.6 90/10/16 10:17:33 lwall Locked $
  *
  * $Log:	regcomp.c,v $
+ * Revision 3.0.1.6  90/10/16  10:17:33  lwall
+ * patch29: patterns with multiple short literal strings sometimes failed
+ * 
  * Revision 3.0.1.5  90/08/13  22:23:29  lwall
  * patch28: /x{m}/ didn't work right
  * 
@@ -138,7 +141,8 @@ int fold;
 {
 	register regexp *r;
 	register char *scan;
-	register STR *longest;
+	register STR *longish;
+	STR *longest;
 	register int len;
 	register char *first;
 	int flags;
@@ -241,6 +245,7 @@ int fold;
 		 * it happens that curback has been invalidated, since the
 		 * earlier string may buy us something the later one won't.]
 		 */
+		longish = str_make("",0);
 		longest = str_make("",0);
 		len = 0;
 		curback = 0;
@@ -260,7 +265,7 @@ int fold;
 			    while (OP(regnext(scan)) >= CLOSE)
 				scan = regnext(scan);
 			    if (curback - back == len) {
-				str_ncat(longest, OPERAND(first)+1,
+				str_ncat(longish, OPERAND(first)+1,
 				    *OPERAND(first));
 				len += *OPERAND(first);
 				curback += *OPERAND(first);
@@ -268,7 +273,7 @@ int fold;
 			    }
 			    else if (*OPERAND(first) >= len + (curback >= 0)) {
 				len = *OPERAND(first);
-				str_nset(longest, OPERAND(first)+1,len);
+				str_nset(longish, OPERAND(first)+1,len);
 				back = curback;
 				curback += len;
 				first = regnext(scan);
@@ -276,18 +281,27 @@ int fold;
 			    else
 				curback += *OPERAND(first);
 			}
-			else if (index(varies,OP(scan)))
-				curback = -30000;
+			else if (index(varies,OP(scan))) {
+			    curback = -30000;
+			    len = 0;
+			    if (longish->str_cur > longest->str_cur)
+				str_sset(longest,longish);
+			    str_nset(longish,"",0);
+			}
 			else if (index(simple,OP(scan)))
-				curback++;
+			    curback++;
 			scan = regnext(scan);
 		}
-		if (len) {
+		if (longish->str_cur > longest->str_cur)
+		    str_sset(longest,longish);
+		str_free(longish);
+		if (longest->str_cur) {
 			r->regmust = longest;
 			if (back < 0)
 				back = -1;
 			r->regback = back;
-			if (len > !(sawstudy||fold||OP(first)==EOL))
+			if (longest->str_cur
+			  > !(sawstudy || fold || OP(first) == EOL) )
 				fbmcompile(r->regmust,fold);
 			r->regmust->str_u.str_useful = 100;
 			if (OP(first) == EOL) /* is match anchored to EOL? */
@@ -1123,6 +1137,8 @@ regexp *r;
 #endif
 		op = OP(s);
 		fprintf(stderr,"%2d%s", s-r->program, regprop(s));	/* Where, what. */
+		if (op == CURLY)
+		    s += 4;
 		next = regnext(s);
 		if (next == NULL)		/* Next ptr. */
 			fprintf(stderr,"(0)");
diff --git a/regexec.c b/regexec.c
index 61439ea980..b0b8fa1fcd 100644
--- a/regexec.c
+++ b/regexec.c
@@ -7,9 +7,14 @@
  * blame Henry for some of the lack of readability.
  */
 
-/* $Header: regexec.c,v 3.0.1.4 90/08/09 05:12:03 lwall Locked $
+/* $Header: regexec.c,v 3.0.1.5 90/10/16 10:25:36 lwall Locked $
  *
  * $Log:	regexec.c,v $
+ * Revision 3.0.1.5  90/10/16  10:25:36  lwall
+ * patch29: /^pat/ occasionally matched in middle of string when $* = 0
+ * patch29: /.{n,m}$/ could match with fewer than n characters remaining
+ * patch29: /\d{9}/ could match more than 9 characters
+ * 
  * Revision 3.0.1.4  90/08/09  05:12:03  lwall
  * patch19: sped up /x+y/ patterns greatly by not retrying on every x
  * patch19: inhibited backoff on patterns anchored to the end like /\s+$/
@@ -139,8 +144,11 @@ int safebase;	/* no need to remember string in subbase */
 
 	if (string == strbeg)	/* is ^ valid at stringarg? */
 	    regprev = '\n';
-	else
+	else {
 	    regprev = stringarg[-1];
+	    if (!multiline && regprev == '\n')
+		regprev = '\0';		/* force ^ to NOT match */
+	}
 	regprecomp = prog->precomp;
 	/* Check validity of program. */
 	if (UCHARAT(prog->program) != MAGIC) {
@@ -771,7 +779,7 @@ char *prog;
 				nextchar = -1000;
 			reginput = locinput;
 			n = regrepeat(scan, n);
-			if (!multiline && OP(next) == EOL)
+			if (!multiline && OP(next) == EOL && ln < n)
 			    ln = n;			/* why back off? */
 			while (n >= ln) {
 				/* If it could work, try it. */
@@ -845,7 +853,7 @@ int max;
 		}
 		break;
 	case ALNUM:
-		while (isALNUM(*scan))
+		while (scan < loceol && isALNUM(*scan))
 			scan++;
 		break;
 	case NALNUM:
@@ -861,7 +869,7 @@ int max;
 			scan++;
 		break;
 	case DIGIT:
-		while (isDIGIT(*scan))
+		while (scan < loceol && isDIGIT(*scan))
 			scan++;
 		break;
 	case NDIGIT:
diff --git a/stab.c b/stab.c
index 00cee828ad..f968dfc9e8 100644
--- a/stab.c
+++ b/stab.c
@@ -1,4 +1,4 @@
-/* $Header: stab.c,v 3.0.1.8 90/08/13 22:30:17 lwall Locked $
+/* $Header: stab.c,v 3.0.1.9 90/10/16 10:32:05 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,13 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	stab.c,v $
+ * Revision 3.0.1.9  90/10/16  10:32:05  lwall
+ * patch29: added -M, -A and -C
+ * patch29: taintperl now checks for world writable PATH components
+ * patch29: *foo now prints as *package'foo
+ * patch29: scripts now run at almost full speed under the debugger
+ * patch29: package behavior is now more consistent
+ * 
  * Revision 3.0.1.8  90/08/13  22:30:17  lwall
  * patch28: the NSIG hack didn't work right on Xenix
  * 
@@ -77,6 +84,9 @@ STR *str;
 	return stab_val(stab);
 
     switch (*stab->str_magic->str_ptr) {
+    case '\024':		/* ^T */
+	str_numset(stab_val(stab),(double)basetime);
+	break;
     case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9': case '&':
 	if (curspat) {
@@ -220,7 +230,7 @@ STR *str;
 	    struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
 
 	    if (uf && uf->uf_val)
-		uf->uf_val(uf->uf_index, stab_val(stab));
+		(*uf->uf_val)(uf->uf_index, stab_val(stab));
 	}
 	break;
     }
@@ -240,7 +250,22 @@ STR *str;
     case 'E':
 	setenv(mstr->str_ptr,str_get(str));
 				/* And you'll never guess what the dog had */
-	break;			/*   in its mouth... */
+				/*   in its mouth... */
+#ifdef TAINT
+	if (strEQ(mstr->str_ptr,"PATH")) {
+	    char *strend = str->str_ptr + str->str_cur;
+
+	    s = str->str_ptr;
+	    while (s < strend) {
+		s = cpytill(tokenbuf,s,strend,':',&i);
+		s++;
+		if (*tokenbuf != '/'
+		  || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
+		    str->str_tainted = 2;
+	    }
+	}
+#endif
+	break;
     case 'S':
 	s = str_get(str);
 	i = whichsig(mstr->str_ptr);	/* ...no, a brick */
@@ -252,14 +277,30 @@ STR *str;
 #endif
 	else if (strEQ(s,"DEFAULT") || !*s)
 	    (void)signal(i,SIG_DFL);
-	else
+	else {
 	    (void)signal(i,sighandler);
+	    if (!index(s,'\'')) {
+		sprintf(tokenbuf, "main'%s",s);
+		str_set(str,tokenbuf);
+	    }
+	}
 	break;
 #ifdef SOME_DBM
     case 'D':
 	hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
 	break;
 #endif
+    case 'L':
+	{
+	    CMD *cmd;
+
+	    i = str_true(str);
+	    str = afetch(stab_xarray(stab),atoi(mstr->str_ptr));
+	    cmd = str->str_magic->str_u.str_cmd;
+	    cmd->c_flags &= ~CF_OPTIMIZE;
+	    cmd->c_flags |= i? CFT_D1 : CFT_D0;
+	}
+	break;
     case '#':
 	afill(stab_array(stab), (int)str_gnum(str) - arybase);
 	break;
@@ -310,6 +351,9 @@ STR *str;
 
     case 0:
 	switch (*stab->str_magic->str_ptr) {
+	case '\024':	/* ^T */
+	    basetime = (long)str_gnum(str);
+	    break;
 	case '.':
 	    if (localizing)
 		savesptr((STR**)&last_in_stab);
@@ -473,7 +517,7 @@ STR *str;
 		struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
 
 		if (uf && uf->uf_set)
-		    uf->uf_set(uf->uf_index, str);
+		    (*uf->uf_set)(uf->uf_index, str);
 	    }
 	    break;
 	}
@@ -507,14 +551,16 @@ int sig;
     STAB *stab;
     ARRAY *savearray;
     STR *str;
-    char *oldfile = filename;
+    CMD *oldcurcmd = curcmd;
     int oldsave = savestack->ary_fill;
     ARRAY *oldstack = stack;
+    CSV *oldcurcsv = curcsv;
     SUBR *sub;
 
 #ifdef OS2		/* or anybody else who requires SIG_ACK */
     signal(sig, SIG_ACK);
 #endif
+    curcsv = Nullcsv;
     stab = stabent(
 	str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
 	  TRUE)), TRUE);
@@ -546,7 +592,6 @@ int sig;
 	    warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
 	savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
     }
-    filename = sub->filename;
 
     (void)cmd_exec(sub->cmd,G_SCALAR,1);		/* so do it already */
 
@@ -555,9 +600,10 @@ int sig;
     afree(stab_xarray(defstab));  /* put back old $_[] */
     stab_xarray(defstab) = savearray;
     stack = oldstack;
-    filename = oldfile;
     if (savestack->ary_fill > oldsave)
 	restorelist(oldsave);
+    curcmd = oldcurcmd;
+    curcsv = oldcurcsv;
 }
 
 STAB *
@@ -579,6 +625,21 @@ register STAB *stab;
 }
 
 STAB *
+fstab(name)
+char *name;
+{
+    char tmpbuf[1200];
+    STAB *stab;
+
+    sprintf(tmpbuf,"'_<%s", name);
+    stab = stabent(tmpbuf, TRUE);
+    str_set(stab_val(stab), name);
+    if (perldb)
+	(void)hadd(aadd(stab));
+    return stab;
+}
+
+STAB *
 stabent(name,add)
 register char *name;
 int add;
@@ -625,8 +686,10 @@ int add;
     }
     else if (!isalpha(*name) || global)
 	stash = defstash;
-    else
+    else if (curcmd == &compiling)
 	stash = curstash;
+    else
+	stash = curcmd->c_stash;
     if (sawquote) {
 	char tmpbuf[256];
 	char *s, *d;
@@ -645,12 +708,14 @@ int add;
 	stab = stabent(tmpbuf,TRUE);
 	if (!(stash = stab_xhash(stab)))
 	    stash = stab_xhash(stab) = hnew(0);
+	if (!stash->tbl_name)
+	    stash->tbl_name = savestr(name);
 	name = sawquote+1;
 	*sawquote = '\'';
     }
     len = namend - name;
     stab = (STAB*)hfetch(stash,name,len,add);
-    if (!stab)
+    if (stab == (STAB*)&str_undef)
 	return Nullstab;
     if (stab->str_pok) {
 	stab->str_pok |= SP_MULTI;
@@ -667,10 +732,20 @@ int add;
 	stab_val(stab) = Str_new(72,0);
 	stab_line(stab) = curcmd->c_line;
 	str_magic(stab,stab,'*',name,len);
+	stab_stash(stab) = stash;
 	return stab;
     }
 }
 
+stab_fullname(str,stab)
+STR *str;
+STAB *stab;
+{
+    str_set(str,stab_stash(stab)->tbl_name);
+    str_ncat(str,"'", 1);
+    str_scat(str,stab->str_magic);
+}
+
 STIO *
 stio_new()
 {
@@ -719,7 +794,7 @@ register STAB *stab;
     SUBR *sub;
 
     afree(stab_xarray(stab));
-    (void)hfree(stab_xhash(stab));
+    (void)hfree(stab_xhash(stab), FALSE);
     str_free(stab_val(stab));
     if (stio = stab_io(stab)) {
 	do_close(stab,FALSE);
diff --git a/x2p/s2p.SH b/x2p/s2p.SH
index 66d7b72258..553cfd68d9 100644
--- a/x2p/s2p.SH
+++ b/x2p/s2p.SH
@@ -28,9 +28,12 @@ $spitshell >s2p <<!GROK!THIS!
 : In the following dollars and backticks do not need the extra backslash.
 $spitshell >>s2p <<'!NO!SUBS!'
 
-# $Header: s2p.SH,v 3.0.1.4 90/08/09 05:50:43 lwall Locked $
+# $Header: s2p.SH,v 3.0.1.5 90/10/16 11:32:40 lwall Locked $
 #
 # $Log:	s2p.SH,v $
+# Revision 3.0.1.5  90/10/16  11:32:40  lwall
+# patch29: s2p modernized
+# 
 # Revision 3.0.1.4  90/08/09  05:50:43  lwall
 # patch19: s2p didn't translate \n right
 # 
@@ -59,14 +62,13 @@ $spitshell >>s2p <<'!NO!SUBS!'
 $indent = 4;
 $shiftwidth = 4;
 $l = '{'; $r = '}';
-$tempvar = '1';
 
-while ($ARGV[0] =~ '^-') {
+while ($ARGV[0] =~ /^-/) {
     $_ = shift;
   last if /^--/;
     if (/^-D/) {
 	$debug++;
-	open(body,'>-');
+	open(BODY,'>-');
 	next;
     }
     if (/^-n/) {
@@ -81,25 +83,27 @@ while ($ARGV[0] =~ '^-') {
 }
 
 unless ($debug) {
-    open(body,">/tmp/sperl$$") || do Die("Can't open temp file");
+    open(BODY,">/tmp/sperl$$") ||
+      &Die("Can't open temp file: $!\n");
 }
 
 if (!$assumen && !$assumep) {
-    print body
-'while ($ARGV[0] =~ /^-/) {
+    print BODY <<'EOT';
+while ($ARGV[0] =~ /^-/) {
     $_ = shift;
   last if /^--/;
     if (/^-n/) {
 	$nflag++;
 	next;
     }
-    die "I don\'t recognize this switch: $_\\n";
+    die "I don't recognize this switch: $_\\n";
 }
 
-';
+EOT
 }
 
-print body '
+print BODY <<'EOT';
+
 #ifdef PRINTIT
 #ifdef ASSUMEP
 $printit++;
@@ -107,21 +111,27 @@ $printit++;
 $printit++ unless $nflag;
 #endif
 #endif
-line: while (<>) {
-';
+LINE: while (<>) {
+EOT
+
+LINE: while (<>) {
+
+    # Wipe out surrounding whitespace.
 
-line: while (<>) {
     s/[ \t]*(.*)\n$/$1/;
+
+    # Perhaps it's a label/comment.
+
     if (/^:/) {
 	s/^:[ \t]*//;
-	$label = do make_label($_);
+	$label = &make_label($_);
 	if ($. == 1) {
 	    $toplabel = $label;
 	}
 	$_ = "$label:";
 	if ($lastlinewaslabel++) {
 	    $indent += 4;
-	    print body "\t" x ($indent / 8), ' ' x ($indent % 8), ";\n";
+	    print BODY &tab, ";\n";
 	    $indent -= 4;
 	}
 	if ($indent >= 2) {
@@ -132,6 +142,9 @@ line: while (<>) {
     } else {
 	$lastlinewaslabel = '';
     }
+
+    # Look for one or two address clauses
+
     $addr1 = '';
     $addr2 = '';
     if (s/^([0-9]+)//) {
@@ -141,7 +154,7 @@ line: while (<>) {
 	$addr1 = 'eof()';
     }
     elsif (s|^/||) {
-	$addr1 = do fetchpat('/');
+	$addr1 = &fetchpat('/');
     }
     if (s/^,//) {
 	if (s/^([0-9]+)//) {
@@ -149,14 +162,18 @@ line: while (<>) {
 	} elsif (s/^\$//) {
 	    $addr2 = "eof()";
 	} elsif (s|^/||) {
-	    $addr2 = do fetchpat('/');
+	    $addr2 = &fetchpat('/');
 	} else {
-	    do Die("Invalid second address at line $.\n");
+	    &Die("Invalid second address at line $.\n");
 	}
 	$addr1 .= " .. $addr2";
     }
-					# a { to keep vi happy
+
+    # Now we check for metacommands {, }, and ! and worry
+    # about indentation.
+
     s/^[ \t]+//;
+    # a { to keep vi happy
     if ($_ eq '}') {
 	$indent -= 4;
 	next;
@@ -180,55 +197,59 @@ line: while (<>) {
 	} else {
 	    $space = '';
 	}
-	$_ = do transmogrify();
+	$_ = &transmogrify();
     }
 
+    # See if we can optimize to modifier form.
+
     if ($addr1) {
 	if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
 	  $_ !~ / if / && $_ !~ / unless /) {
 	    s/;$/ $if $addr1;/;
 	    $_ = substr($_,$shiftwidth,1000);
 	} else {
-	    $command = $_;
-	    $_ = "$if ($addr1) $l\n$change$command$rmaybe";
+	    $_ = "$if ($addr1) $l\n$change$_$rmaybe";
 	}
 	$change = '';
-	next line;
+	next LINE;
     }
 } continue {
     @lines = split(/\n/,$_);
-    while ($#lines >= 0) {
-	$_ = shift(lines);
+    for (@lines) {
 	unless (s/^ *<<--//) {
-	    print body "\t" x ($indent / 8), ' ' x ($indent % 8);
+	    print BODY &tab;
 	}
-	print body $_, "\n";
+	print BODY $_, "\n";
     }
     $indent += $indmod;
     $indmod = 0;
     if ($redo) {
 	$_ = $redo;
 	$redo = '';
-	redo line;
+	redo LINE;
     }
 }
 if ($lastlinewaslabel++) {
     $indent += 4;
-    print body "\t" x ($indent / 8), ' ' x ($indent % 8), ";\n";
+    print BODY &tab, ";\n";
     $indent -= 4;
 }
 
-print body "}\n";
+print BODY "}\n";
 if ($appendseen || $tseen || !$assumen) {
     $printit++ if $dseen || (!$assumen && !$assumep);
-    print body '
+    print BODY <<'EOT';
+
 continue {
 #ifdef PRINTIT
 #ifdef DSEEN
 #ifdef ASSUMEP
     print if $printit++;
 #else
-    if ($printit) { print;} else { $printit++ unless $nflag; }
+    if ($printit)
+	{ print; }
+    else
+	{ $printit++ unless $nflag; }
 #endif
 #else
     print if $printit;
@@ -237,40 +258,43 @@ continue {
     print;
 #endif
 #ifdef TSEEN
-    $tflag = \'\';
+    $tflag = '';
 #endif
 #ifdef APPENDSEEN
-    if ($atext) { print $atext; $atext = \'\'; }
+    if ($atext) { print $atext; $atext = ''; }
 #endif
 }
-';
+EOT
 }
 
-close body;
+close BODY;
 
 unless ($debug) {
-    open(head,">/tmp/sperl2$$.c") || do Die("Can't open temp file 2");
-    print head "#define PRINTIT\n" if ($printit);
-    print head "#define APPENDSEEN\n" if ($appendseen);
-    print head "#define TSEEN\n" if ($tseen);
-    print head "#define DSEEN\n" if ($dseen);
-    print head "#define ASSUMEN\n" if ($assumen);
-    print head "#define ASSUMEP\n" if ($assumep);
-    if ($opens) {print head "$opens\n";}
-    open(body,"/tmp/sperl$$") || do Die("Can't reopen temp file");
-    while (<body>) {
-	print head $_;
+    open(HEAD,">/tmp/sperl2$$.c")
+      || &Die("Can't open temp file 2: $!\n");
+    print HEAD "#define PRINTIT\n" if ($printit);
+    print HEAD "#define APPENDSEEN\n" if ($appendseen);
+    print HEAD "#define TSEEN\n" if ($tseen);
+    print HEAD "#define DSEEN\n" if ($dseen);
+    print HEAD "#define ASSUMEN\n" if ($assumen);
+    print HEAD "#define ASSUMEP\n" if ($assumep);
+    if ($opens) {print HEAD "$opens\n";}
+    open(BODY,"/tmp/sperl$$")
+      || &Die("Can't reopen temp file: $!\n");
+    while (<BODY>) {
+	print HEAD $_;
     }
-    close head;
+    close HEAD;
 
-    print "#!$bin/perl
-eval \"exec $bin/perl -S \$0 \$*\"
+    print <<"EOT";
+#!$bin/perl
+eval 'exec $bin/perl -S \$0 \$*'
 	if \$running_under_some_shell;
 
-";
-    open(body,"cc -E /tmp/sperl2$$.c |") ||
-	do Die("Can't reopen temp file");
-    while (<body>) {
+EOT
+    open(BODY,"cc -E /tmp/sperl2$$.c |") ||
+	&Die("Can't reopen temp file: $!\n");
+    while (<BODY>) {
 	/^# [0-9]/ && next;
 	/^[ \t]*$/ && next;
 	s/^<><>//;
@@ -278,39 +302,44 @@ eval \"exec $bin/perl -S \$0 \$*\"
     }
 }
 
-unlink "/tmp/sperl$$", "/tmp/sperl2$$", "/tmp/sperl2$$.c";
+&Cleanup;
+exit;
 
+sub Cleanup {
+    chdir "/tmp";
+    unlink "sperl$$", "sperl2$$", "sperl2$$.c";
+}
 sub Die {
-    unlink "/tmp/sperl$$", "/tmp/sperl2$$", "/tmp/sperl2$$.c";
+    &Cleanup;
     die $_[0];
 }
+sub tab {
+    "\t" x ($indent / 8) . ' ' x ($indent % 8);
+}
 sub make_filehandle {
-    $fname = $_ = $_[0];
+    local($_) = $_[0];
+    local($fname) = $_;
     s/[^a-zA-Z]/_/g;
     s/^_*//;
-    if (/^([a-z])([a-z]*)$/) {
-	$first = $1;
-	$rest = $2;
-	$first =~ y/a-z/A-Z/;
-	$_ = $first . $rest;
-    }
+    substr($_,0,1) =~ y/a-z/A-Z/ if /^[a-z]/;
     if (!$seen{$_}) {
-	$opens .= "open($_,'>$fname') || die \"Can't create $fname\";\n";
+	$opens .= <<"EOT";
+open($_,'>$fname') || die "Can't create $fname";
+EOT
     }
     $seen{$_} = $_;
 }
 
 sub make_label {
-    $label = $_[0];
+    local($label) = @_;
     $label =~ s/[^a-zA-Z0-9]/_/g;
     if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
     $label = substr($label,0,8);
-    if ($label =~ /^([a-z])([a-z]*)$/) {	# could be reserved word
-	$first = $1;
-	$rest = $2;
-	$first =~ y/a-z/A-Z/;			# so capitalize it
-	$label = $first . $rest;
-    }
+
+    # Could be a reserved word, so capitalize it.
+    substr($label,0,1) =~ y/a-z/A-Z/
+      if $label =~ /^[a-z]/;
+
     $label;
 }
 
@@ -318,22 +347,26 @@ sub transmogrify {
     {	# case
 	if (/^d/) {
 	    $dseen++;
-	    $_ = '
+	    chop($_ = <<'EOT');
 <<--#ifdef PRINTIT
-$printit = \'\';
+$printit = '';
 <<--#endif
-next line;';
+next LINE;
+EOT
 	    next;
 	}
 
 	if (/^n/) {
-	    $_ =
-'<<--#ifdef PRINTIT
+	    chop($_ = <<'EOT');
+<<--#ifdef PRINTIT
 <<--#ifdef DSEEN
 <<--#ifdef ASSUMEP
 print if $printit++;
 <<--#else
-if ($printit) { print;} else { $printit++ unless $nflag; }
+if ($printit)
+    { print; }
+else
+    { $printit++ unless $nflag; }
 <<--#endif
 <<--#else
 print if $printit;
@@ -342,18 +375,19 @@ print if $printit;
 print;
 <<--#endif
 <<--#ifdef APPENDSEEN
-if ($atext) {print $atext; $atext = \'\';}
+if ($atext) {print $atext; $atext = '';}
 <<--#endif
 $_ = <>;
 <<--#ifdef TSEEN
-$tflag = \'\';
-<<--#endif';
+$tflag = '';
+<<--#endif
+EOT
 	    next;
 	}
 
 	if (/^a/) {
 	    $appendseen++;
-	    $command = $space .  '$atext .=' . "\n<<--'";
+	    $command = $space . '$atext .=' . "\n<<--'";
 	    $lastline = 0;
 	    while (<>) {
 		s/^[ \t]*//;
@@ -372,7 +406,8 @@ $tflag = \'\';
 	if (/^[ic]/) {
 	    if (/^c/) { $change = 1; }
 	    $addr1 = '$iter = (' . $addr1 . ')';
-	    $command = $space .  'if ($iter == 1) { print' . "\n<<--'";
+	    $command = $space . 'if ($iter == 1) { print'
+	      . "\n<<--'";
 	    $lastline = 0;
 	    while (<>) {
 		s/^[ \t]*//;
@@ -388,11 +423,12 @@ $tflag = \'\';
 	    if ($change) {
 		$dseen++;
 		$change = "$_\n";
-		$_ = "
+		chop($_ = <<"EOT");
 <<--#ifdef PRINTIT
 $space\$printit = '';
 <<--#endif
-${space}next line;";
+${space}next LINE;
+EOT
 	    }
 	    last;
 	}
@@ -406,7 +442,7 @@ ${space}next line;";
 		$c = substr($_,$i,1);
 		if ($c eq $delim) {
 		    if ($inbracket) {
-			$_ = substr($_,0,$i) . '\\' . substr($_,$i,10000);
+			substr($_, $i, 0) = '\\';
 			$i++;
 			$len++;
 		    }
@@ -430,12 +466,14 @@ ${space}next line;";
 		    elsif (substr($_,$i,1) =~ /^[n]$/) {
 			;
 		    }
-		    elsif (!$repl && substr($_,$i,1) =~ /^[(){}\w]$/) {
+		    elsif (!$repl &&
+		      substr($_,$i,1) =~ /^[(){}\w]$/) {
 			$i--;
 			$len--;
-			$_ = substr($_,0,$i) . substr($_,$i+1,10000);
+			substr($_, $i, 1) = '';
 		    }
-		    elsif (!$repl && substr($_,$i,1) =~ /^[<>]$/) {
+		    elsif (!$repl &&
+		      substr($_,$i,1) =~ /^[<>]$/) {
 			substr($_,$i,1) = 'b';
 		    }
 		}
@@ -448,14 +486,15 @@ ${space}next line;";
 		    $inbracket = 0;
 		}
 		elsif (!$repl && index("()+",$c) >= 0) {
-		    $_ = substr($_,0,$i) . '\\' . substr($_,$i,10000);
+		    substr($_, $i, 0) = '\\';
 		    $i++;
 		    $len++;
 		}
 	    }
-	    do Die("Malformed substitution at line $.\n") unless $end;
+	    &Die("Malformed substitution at line $.\n")
+	      unless $end;
 	    $pat = substr($_, 0, $repl + 1);
-	    $repl = substr($_, $repl + 1, $end - $repl - 1);
+	    $repl = substr($_, $repl+1, $end-$repl-1);
 	    $end = substr($_, $end + 1, 1000);
 	    $dol = '$';
 	    $repl =~ s/\$/\\$/;
@@ -464,22 +503,30 @@ ${space}next line;";
 	    $subst = "$pat$repl$delim";
 	    $cmd = '';
 	    while ($end) {
-		if ($end =~ s/^g//) { $subst .= 'g'; next; }
-		if ($end =~ s/^p//) { $cmd .= ' && (print)'; next; }
+		if ($end =~ s/^g//) {
+		    $subst .= 'g';
+		    next;
+		}
+		if ($end =~ s/^p//) {
+		    $cmd .= ' && (print)';
+		    next;
+		}
 		if ($end =~ s/^w[ \t]*//) {
-		    $fh = do make_filehandle($end);
+		    $fh = &make_filehandle($end);
 		    $cmd .= " && (print $fh \$_)";
 		    $end = '';
 		    next;
 		}
-		do Die("Unrecognized substitution command ($end) at line $.\n");
+		&Die("Unrecognized substitution command".
+		  "($end) at line $.\n");
 	    }
-	    $_ =
-"<<--#ifdef TSEEN
+	    chop ($_ = <<"EOT");
+<<--#ifdef TSEEN
 $subst && \$tflag++$cmd;
 <<--#else
 $subst$cmd;
-<<--#endif";
+<<--#endif
+EOT
 	    next;
 	}
 
@@ -490,7 +537,7 @@ $subst$cmd;
 
 	if (/^w/) {
 	    s/^w[ \t]*//;
-	    $fh = do make_filehandle($_);
+	    $fh = &make_filehandle($_);
 	    $_ = "print $fh \$_;";
 	    next;
 	}
@@ -509,19 +556,21 @@ $subst$cmd;
 	}
 
 	if (/^D/) {
-	    $_ =
-'s/^.*\n//;
-redo line if $_;
-next line;';
+	    chop($_ = <<'EOT');
+s/^.*\n//;
+redo LINE if $_;
+next LINE;
+EOT
 	    next;
 	}
 
 	if (/^N/) {
-	    $_ = '
+	    chop($_ = <<'EOT');
 $_ .= <>;
 <<--#ifdef TSEEN
-$tflag = \'\';
-<<--#endif';
+$tflag = '';
+<<--#endif
+EOT
 	    next;
 	}
 
@@ -551,15 +600,15 @@ $tflag = \'\';
 	}
 
 	if (/^b$/) {
-	    $_ = 'next line;';
+	    $_ = 'next LINE;';
 	    next;
 	}
 
 	if (/^b/) {
 	    s/^b[ \t]*//;
-	    $lab = do make_label($_);
+	    $lab = &make_label($_);
 	    if ($lab eq $toplabel) {
-		$_ = 'redo line;';
+		$_ = 'redo LINE;';
 	    } else {
 		$_ = "goto $lab;";
 	    }
@@ -567,18 +616,19 @@ $tflag = \'\';
 	}
 
 	if (/^t$/) {
-	    $_ = 'next line if $tflag;';
+	    $_ = 'next LINE if $tflag;';
 	    $tseen++;
 	    next;
 	}
 
 	if (/^t/) {
 	    s/^t[ \t]*//;
-	    $lab = do make_label($_);
+	    $lab = &make_label($_);
+	    $_ = q/if ($tflag) {$tflag = ''; /;
 	    if ($lab eq $toplabel) {
-		$_ = 'if ($tflag) {$tflag = \'\'; redo line;}';
+		$_ .= 'redo LINE;}';
 	    } else {
-		$_ = "if (\$tflag) {\$tflag = ''; goto $lab;}";
+		$_ .= "goto $lab;}";
 	    }
 	    $tseen++;
 	    next;
@@ -590,10 +640,11 @@ $tflag = \'\';
 	}
 
 	if (/^q/) {
-	    $_ =
-'close(ARGV);
+	    chop($_ = <<'EOT');
+close(ARGV);
 @ARGV = ();
-next line;';
+next LINE;
+EOT
 	    next;
 	}
     } continue {
@@ -612,7 +663,9 @@ sub fetchpat {
     local($inbracket);
     local($prefix,$delim,$ch);
 
-    delim: while (s:^([^\]+(|)[\\/]*)([]+(|)[\\/])::) {
+    # Process pattern one potential delimiter at a time.
+
+    DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
 	$prefix = $1;
 	$delim = $2;
 	if ($delim eq '\\') {
@@ -636,7 +689,7 @@ sub fetchpat {
 	$addr .= $prefix;
 	$addr .= $delim;
 	if ($delim eq $outer && !$inbracket) {
-	    last delim;
+	    last DELIM;
 	}
     }
     $addr;