Resolve conflicts, remove old files, merge local changes

19 files changed, 2164 insertions, 924 deletions

diff --git a/gnu/usr.bin/perl/x2p/EXTERN.h b/gnu/usr.bin/perl/x2p/EXTERN.h
index 80fffb46e44..792dc2679f3 100644
--- a/gnu/usr.bin/perl/x2p/EXTERN.h
+++ b/gnu/usr.bin/perl/x2p/EXTERN.h
@@ -1,6 +1,6 @@
 /* $RCSfile: EXTERN.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:05 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
diff --git a/gnu/usr.bin/perl/x2p/INTERN.h b/gnu/usr.bin/perl/x2p/INTERN.h
index 2303ea3ac11..424b14b83df 100644
--- a/gnu/usr.bin/perl/x2p/INTERN.h
+++ b/gnu/usr.bin/perl/x2p/INTERN.h
@@ -1,6 +1,6 @@
 /* $RCSfile: INTERN.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:06 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
diff --git a/gnu/usr.bin/perl/x2p/Makefile.SH b/gnu/usr.bin/perl/x2p/Makefile.SH
index a0ba96a360c..003c6e2655b 100644
--- a/gnu/usr.bin/perl/x2p/Makefile.SH
+++ b/gnu/usr.bin/perl/x2p/Makefile.SH
@@ -1,4 +1,4 @@
-case $CONFIGDOTSH in
+case $PERL_CONFIG_SH in
 '')
 	if test -f config.sh; then TOP=.;
 	elif test -f ../config.sh; then TOP=..;
@@ -58,6 +58,8 @@ FIRSTMAKEFILE = $firstmakefile
 
 TRNL = '$trnl'
 
+OPTIMIZE = $optimize
+
 .SUFFIXES: .c \$(OBJ_EXT)
 
 !GROK!THIS!
@@ -65,9 +67,9 @@ TRNL = '$trnl'
 cat >>Makefile <<'!NO!SUBS!'
 
 REALPERL = ../perl
-CCCMD = `sh $(shellflags) cflags $@`
+CCCMD = `sh $(shellflags) cflags "optimize='$(OPTIMIZE)'" $@`
 
-public = a2p s2p find2perl
+public = a2p$(EXE_EXT) s2p find2perl
 
 private = 
 
@@ -102,20 +104,30 @@ all: $(public) $(private) $(util)
 	@echo " "
 
 compile: all
-	$(REALPERL) -I../lib ../utils/perlcc -regex 's/$$/.exe/' $(plextract) -prog -verbose dcf -log ../compilelog;  
+	$(REALPERL) -I../lib ../utils/perlcc -I .. -L .. $(plextract) -v -log ../compilelog;  
 
-a2p: $(obj) a2p$(OBJ_EXT)
+a2p$(EXE_EXT): $(obj) a2p$(OBJ_EXT)
 	$(CC) -o a2p $(LDFLAGS) $(obj) a2p$(OBJ_EXT) $(libs)
 
 # I now supply a2p.c with the kits, so the following section is
 # used only if you force byacc to run by saying
 # make  run_byacc
 
-run_byacc:	FORCE
+check_byacc:
+	@$(BYACC) -V 2>&1 | grep 'version 1\.8\.2'
+
+run_byacc:	FORCE check_byacc
 	@ echo Expect many shift/reduce and reduce/reduce conflicts
 	$(BYACC) a2p.y
 	rm -f a2p.c
-	mv y.tab.c a2p.c
+	sed -e 's/(yyn = yydefred\[yystate\])/((yyn = yydefred[yystate]))/' \
+	    -e 's/(yys = getenv("YYDEBUG"))/((yys = getenv("YYDEBUG")))/' \
+	    -e 's/^yyerrlab://' \
+	    -e 's/^    goto yyerrlab;//' \
+	    -e 's/^yynewerror://' \
+	    -e 's/^    goto yynewerror;//' \
+	    -e 's|^static char yysccsid\(.*\)|/* static char yysccsid\1 */|' \
+	    < y.tab.c > a2p.c
 
 FORCE:
 
@@ -129,7 +141,7 @@ a2p$(OBJ_EXT): a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h \
 	$(CCCMD) a2p.c
 
 clean:
-	rm -f a2p *$(OBJ_EXT) $(plexe) $(plc) $(plm)
+	rm -f a2p$(EXE_EXT) psed *$(OBJ_EXT) $(plexe) $(plc) $(plm)
 
 realclean: clean
 	rm -f core $(addedbyconf) all malloc.c
diff --git a/gnu/usr.bin/perl/x2p/a2p.c b/gnu/usr.bin/perl/x2p/a2p.c
index cd667a3f29b..a118b3ad8cc 100644
--- a/gnu/usr.bin/perl/x2p/a2p.c
+++ b/gnu/usr.bin/perl/x2p/a2p.c
@@ -1,11 +1,11 @@
 #ifndef lint
-static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91";
+/* static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91"; */
 #endif
 #define YYBYACC 1
 #line 2 "a2p.y"
 /* $RCSfile: a2p.y,v $$Revision: 4.1 $$Date: 92/08/07 18:29:12 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -2087,10 +2087,9 @@ yyparse()
     register int yym, yyn, yystate;
 #if YYDEBUG
     register char *yys;
-#ifndef __cplusplus
     extern char *getenv();
-#endif
-    if (yys = getenv("YYDEBUG"))
+
+    if ((yys = getenv("YYDEBUG")))
     {
         yyn = *yys;
         if (yyn >= '0' && yyn <= '9')
@@ -2107,7 +2106,7 @@ yyparse()
     *yyssp = yystate = 0;
 
 yyloop:
-    if (yyn = yydefred[yystate]) goto yyreduce;
+    if ((yyn = yydefred[yystate])) goto yyreduce;
     if (yychar < 0)
     {
         if ((yychar = yylex()) < 0) yychar = 0;
@@ -2148,14 +2147,14 @@ yyloop:
     }
     if (yyerrflag) goto yyinrecovery;
 #ifdef lint
-    goto yynewerror;
+
 #endif
-yynewerror:
+
     yyerror("syntax error");
 #ifdef lint
-    goto yyerrlab;
+
 #endif
-yyerrlab:
+
     ++yynerrs;
 yyinrecovery:
     if (yyerrflag < 3)
diff --git a/gnu/usr.bin/perl/x2p/a2p.h b/gnu/usr.bin/perl/x2p/a2p.h
index cbcb80c0a6d..3457c43328b 100644
--- a/gnu/usr.bin/perl/x2p/a2p.h
+++ b/gnu/usr.bin/perl/x2p/a2p.h
@@ -1,6 +1,6 @@
 /* $RCSfile: a2p.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:09 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -16,6 +16,8 @@
 
 #ifdef VMS
 #  include "config.h"
+#elif defined(NETWARE)
+#  include "../NetWare/config.h"
 #else
 #  include "../config.h"
 #endif
@@ -86,19 +88,11 @@
 #   include <strings.h>
 #endif
 
-#if !defined(HAS_BCOPY) || defined(__cplusplus)
-#   define bcopy(s1,s2,l) memcpy(s2,s1,l)
-#endif
-#if !defined(HAS_BZERO) || defined(__cplusplus)
-#   define bzero(s,l) memset(s,0,l)
-#endif
-
 #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
 #define strchr index
 #define strrchr rindex
 #endif
 
-
 #ifdef I_TIME
 #   include <time.h>
 #endif
@@ -370,7 +364,7 @@ EXT char *No INIT("");
 
 #define str_true(str) (Str = (str), (Str->str_pok ? True(Str->str_ptr) : (Str->str_nok ? (Str->str_nval != 0.0) : 0 )))
 
-#define str_peek(str) (Str = (str), (Str->str_pok ? Str->str_ptr : (Str->str_nok ? (sprintf(buf,"num(%g)",Str->str_nval),buf) : "" )))
+#define str_peek(str) (Str = (str), (Str->str_pok ? Str->str_ptr : (Str->str_nok ? (sprintf(buf,"num(%"NVgf")",Str->str_nval),buf) : "" )))
 #define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
 #define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_nval : str_2num(Str)))
 EXT STR *Str;
diff --git a/gnu/usr.bin/perl/x2p/a2p.pod b/gnu/usr.bin/perl/x2p/a2p.pod
index f6395a4625a..0506e2d827c 100644
--- a/gnu/usr.bin/perl/x2p/a2p.pod
+++ b/gnu/usr.bin/perl/x2p/a2p.pod
@@ -47,12 +47,12 @@ tells a2p to use old awk behavior.  The only current differences are:
 
 =over 5
 
-=item
+=item *
 
 Old awk always has a line loop, even if there are no line
 actions, whereas new awk does not.
 
-=item
+=item *
 
 In old awk, sprintf is extremely greedy about its arguments.
 For example, given the statement
@@ -64,6 +64,8 @@ considers them arguments to C<print>.
 
 =back
 
+=back
+
 =head2 "Considerations"
 
 A2p cannot do as good a job translating as a human would, but it
diff --git a/gnu/usr.bin/perl/x2p/a2p.y b/gnu/usr.bin/perl/x2p/a2p.y
index beec3a6eaa2..b0da9df400e 100644
--- a/gnu/usr.bin/perl/x2p/a2p.y
+++ b/gnu/usr.bin/perl/x2p/a2p.y
@@ -1,7 +1,7 @@
 %{
 /* $RCSfile: a2p.y,v $$Revision: 4.1 $$Date: 92/08/07 18:29:12 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
diff --git a/gnu/usr.bin/perl/x2p/a2py.c b/gnu/usr.bin/perl/x2p/a2py.c
index 6884f95a6c4..dbbc7bb8e2f 100644
--- a/gnu/usr.bin/perl/x2p/a2py.c
+++ b/gnu/usr.bin/perl/x2p/a2py.c
@@ -1,6 +1,6 @@
 /* $RCSfile: a2py.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:14 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-1997, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -8,10 +8,13 @@
  * $Log:	a2py.c,v $
  */
 
-#if defined(OS2) || defined(WIN32)
+#if defined(OS2) || defined(WIN32) || defined(NETWARE)
 #if defined(WIN32)
 #include <io.h>
 #endif
+#if defined(NETWARE)
+#include "../netware/clibstuf.h"
+#endif
 #include "../patchlevel.h"
 #endif
 #include "util.h"
@@ -28,8 +31,12 @@ int oper3(int type, int arg1, int arg2, int arg3);
 int oper4(int type, int arg1, int arg2, int arg3, int arg4);
 int oper5(int type, int arg1, int arg2, int arg3, int arg4, int arg5);
 STR *walk(int useval, int level, register int node, int *numericptr, int minprec);
+#ifdef NETWARE
+char *savestr(char *str);
+char *cpy2(register char *to, register char *from, register int delim);
+#endif
 
-#if defined(OS2) || defined(WIN32)
+#if defined(OS2) || defined(WIN32) || defined(NETWARE)
 static void usage(void);
 
 static void
@@ -54,6 +61,11 @@ main(register int argc, register char **argv, register char **env)
     register STR *str;
     int i;
     STR *tmpstr;
+    /* char *namelist;    */
+
+	#ifdef NETWARE
+		fnInitGpfGlobals();	/* For importing the CLIB calls in place of Watcom calls */
+	#endif	/* NETWARE */
 
     myname = argv[0];
     linestr = str_new(80);
@@ -61,7 +73,6 @@ main(register int argc, register char **argv, register char **env)
     for (argc--,argv++; argc; argc--,argv++) {
 	if (argv[0][0] != '-' || !argv[0][1])
 	    break;
-      reswitch:
 	switch (argv[0][1]) {
 #ifdef DEBUGGING
 	case 'D':
@@ -91,7 +102,7 @@ main(register int argc, register char **argv, register char **env)
 	case 0:
 	    break;
 	default:
-#if defined(OS2) || defined(WIN32)
+#if defined(OS2) || defined(WIN32) || defined(NETWARE)
 	    fprintf(stderr, "Unrecognized switch: %s\n",argv[0]);
             usage();
 #else
@@ -104,7 +115,7 @@ main(register int argc, register char **argv, register char **env)
     /* open script */
 
     if (argv[0] == Nullch) {
-#if defined(OS2) || defined(WIN32)
+#if defined(OS2) || defined(WIN32) || defined(NETWARE)
 	if ( isatty(fileno(stdin)) )
 	    usage();
 #endif
@@ -194,6 +205,8 @@ main(register int argc, register char **argv, register char **env)
 	  "The operation I've selected may be wrong for the operand types.\n");
     }
     exit(0);
+    /* by ANSI specs return is needed. This also shuts up VC++ and his warnings */
+    return(0);
 }
 
 #define RETURN(retval) return (bufptr = s,retval)
@@ -212,11 +225,12 @@ yylex(void)
 
   retry:
 #if YYDEBUG
-    if (yydebug)
+    if (yydebug) {
 	if (strchr(s,'\n'))
 	    fprintf(stderr,"Tokener at %s",s);
 	else
 	    fprintf(stderr,"Tokener at %s\n",s);
+    }
 #endif
     switch (*s) {
     default:
@@ -281,7 +295,7 @@ yylex(void)
 	s++;
 	XTERM('}');
     case '}':
-	for (d = s + 1; isspace(*d); d++) ;
+	for (d = s + 1; isSPACE(*d); d++) ;
 	if (!*d)
 	    s = d - 1;
 	*s = 127;
@@ -383,7 +397,7 @@ yylex(void)
 
 #define SNARFWORD \
 	d = tokenbuf; \
-	while (isalpha(*s) || isdigit(*s) || *s == '_') \
+	while (isALPHA(*s) || isDIGIT(*s) || *s == '_') \
 	    *d++ = *s++; \
 	*d = '\0'; \
 	d = tokenbuf; \
@@ -402,8 +416,8 @@ yylex(void)
 	    ID("0");
 	}
 	do_split = TRUE;
-	if (isdigit(*s)) {
-	    for (d = s; isdigit(*s); s++) ;
+	if (isDIGIT(*s)) {
+	    for (d = s; isDIGIT(*s); s++) ;
 	    yylval = string(d,s-d);
 	    tmp = atoi(d);
 	    if (tmp > maxfld)
@@ -473,15 +487,15 @@ yylex(void)
 	    XTERM(FUN1);
 	}
 	if (strEQ(d,"chdir"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"crypt"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"chop"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"chmod"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"chown"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'd': case 'D':
 	SNARFWORD;
@@ -490,7 +504,7 @@ yylex(void)
 	if (strEQ(d,"delete"))
 	    XTERM(DELETE);
 	if (strEQ(d,"die"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'e': case 'E':
 	SNARFWORD;
@@ -507,26 +521,26 @@ yylex(void)
 	    XTERM(FUN1);
 	}
 	if (strEQ(d,"elsif"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"eq"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"eval"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"eof"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"each"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"exec"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'f': case 'F':
 	SNARFWORD;
 	if (strEQ(d,"FS")) {
 	    saw_FS++;
 	    if (saw_FS == 1 && in_begin) {
-		for (d = s; *d && isspace(*d); d++) ;
+		for (d = s; *d && isSPACE(*d); d++) ;
 		if (*d == '=') {
-		    for (d++; *d && isspace(*d); d++) ;
+		    for (d++; *d && isSPACE(*d); d++) ;
 		    if (*d == '"' && d[2] == '"')
 			const_FS = d[1];
 		}
@@ -540,13 +554,13 @@ yylex(void)
 	if (strEQ(d,"FILENAME"))
 	    d = "ARGV";
 	if (strEQ(d,"foreach"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"format"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"fork"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"fh"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'g': case 'G':
 	SNARFWORD;
@@ -555,18 +569,18 @@ yylex(void)
 	if (strEQ(d,"gsub"))
 	    XTERM(GSUB);
 	if (strEQ(d,"ge"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"gt"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"goto"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"gmtime"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'h': case 'H':
 	SNARFWORD;
 	if (strEQ(d,"hex"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'i': case 'I':
 	SNARFWORD;
@@ -586,14 +600,14 @@ yylex(void)
     case 'j': case 'J':
 	SNARFWORD;
 	if (strEQ(d,"join"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'k': case 'K':
 	SNARFWORD;
 	if (strEQ(d,"keys"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"kill"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'l': case 'L':
 	SNARFWORD;
@@ -606,17 +620,17 @@ yylex(void)
 	    XTERM(FUN1);
 	}
 	if (strEQ(d,"last"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"local"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"lt"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"le"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"locatime"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"link"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'm': case 'M':
 	SNARFWORD;
@@ -625,7 +639,7 @@ yylex(void)
 	    XTERM(MATCH);
 	}
 	if (strEQ(d,"m"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'n': case 'N':
 	SNARFWORD;
@@ -636,7 +650,7 @@ yylex(void)
 	    XTERM(NEXT);
 	}
 	if (strEQ(d,"ne"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'o': case 'O':
 	SNARFWORD;
@@ -652,11 +666,11 @@ yylex(void)
 	    d = "#";
 	}
 	if (strEQ(d,"open"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"ord"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"oct"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'p': case 'P':
 	SNARFWORD;
@@ -667,9 +681,9 @@ yylex(void)
 	    XTERM(PRINTF);
 	}
 	if (strEQ(d,"push"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"pop"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'q': case 'Q':
 	SNARFWORD;
@@ -687,11 +701,11 @@ yylex(void)
 	if (strEQ(d,"return"))
 	    XTERM(RET);
 	if (strEQ(d,"reset"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"redo"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"rename"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 's': case 'S':
 	SNARFWORD;
@@ -734,73 +748,73 @@ yylex(void)
 	    XTERM(FUN1);
 	}
 	if (strEQ(d,"s"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"shift"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"select"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"seek"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"stat"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"study"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"sleep"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"symlink"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"sort"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 't': case 'T':
 	SNARFWORD;
 	if (strEQ(d,"tr"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"tell"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"time"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"times"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'u': case 'U':
 	SNARFWORD;
 	if (strEQ(d,"until"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"unless"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"umask"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"unshift"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"unlink"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"utime"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'v': case 'V':
 	SNARFWORD;
 	if (strEQ(d,"values"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'w': case 'W':
 	SNARFWORD;
 	if (strEQ(d,"while"))
 	    XTERM(WHILE);
 	if (strEQ(d,"write"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"wait"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'x': case 'X':
 	SNARFWORD;
 	if (strEQ(d,"x"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'y': case 'Y':
 	SNARFWORD;
 	if (strEQ(d,"y"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'z': case 'Z':
 	SNARFWORD;
@@ -869,13 +883,13 @@ scannum(register char *s)
     case '1': case '2': case '3': case '4': case '5':
     case '6': case '7': case '8': case '9': case '0' : case '.':
 	d = tokenbuf;
-	while (isdigit(*s)) {
+	while (isDIGIT(*s)) {
 	    *d++ = *s++;
 	}
 	if (*s == '.') {
-	    if (isdigit(s[1])) {
+	    if (isDIGIT(s[1])) {
 		*d++ = *s++;
-		while (isdigit(*s)) {
+		while (isDIGIT(*s)) {
 		    *d++ = *s++;
 		}
 	    }
@@ -886,7 +900,7 @@ scannum(register char *s)
 	    *d++ = *s++;
 	    if (*s == '+' || *s == '-')
 		*d++ = *s++;
-	    while (isdigit(*s))
+	    while (isDIGIT(*s))
 		*d++ = *s++;
 	}
 	*d = '\0';
@@ -1059,9 +1073,9 @@ fixup(STR *str)
 	    s++;
 	}
 	else if (*s == '\n') {
-	    for (t = s+1; isspace(*t & 127); t++) ;
+	    for (t = s+1; isSPACE(*t & 127); t++) ;
 	    t--;
-	    while (isspace(*t & 127) && *t != '\n') t--;
+	    while (isSPACE(*t & 127) && *t != '\n') t--;
 	    if (*t == '\n' && t-s > 1) {
 		if (s[-1] == '{')
 		    s--;
@@ -1094,7 +1108,7 @@ putlines(STR *str)
 	if (pos > 78) {		/* split a long line? */
 	    *d-- = '\0';
 	    newpos = 0;
-	    for (t = tokenbuf; isspace(*t & 127); t++) {
+	    for (t = tokenbuf; isSPACE(*t & 127); t++) {
 		if (*t == '\t')
 		    newpos += 8;
 		else
@@ -1226,7 +1240,7 @@ fixfargs(int name, int arg, int prevargs)
 {
     int type;
     STR *str;
-    int numargs;
+    int numargs = 0;
 
     if (!arg)
 	return prevargs;
diff --git a/gnu/usr.bin/perl/x2p/cflags.SH b/gnu/usr.bin/perl/x2p/cflags.SH
index dcd97a1e79f..255f586f248 100644
--- a/gnu/usr.bin/perl/x2p/cflags.SH
+++ b/gnu/usr.bin/perl/x2p/cflags.SH
@@ -1,4 +1,4 @@
-case $CONFIGDOTSH in
+case $PERL_CONFIG_SH in
 '')
 	if test -f config.sh; then TOP=.;
 	elif test -f ../config.sh; then TOP=..;
@@ -34,7 +34,7 @@ $spitshell >cflags <<!GROK!THIS!
 
 : In the following dollars and backticks do not need the extra backslash.
 $spitshell >>cflags <<'!NO!SUBS!'
-case $CONFIG in
+case $PERL_CONFIG_SH in
 '')
 	if test -f config.sh; then TOP=.;
 	elif test -f ../config.sh; then TOP=..;
@@ -48,6 +48,13 @@ case $CONFIG in
 	;;
 esac
 
+case "X$1" in
+Xoptimize=*|X"optimize=*")
+        eval "$1"
+        shift
+        ;;
+esac
+
 also=': '
 case $# in
 1) also='echo 1>&2 "	  CCCMD = "'
diff --git a/gnu/usr.bin/perl/x2p/find2perl.PL b/gnu/usr.bin/perl/x2p/find2perl.PL
index adcf42ace47..4c5df7da94b 100644
--- a/gnu/usr.bin/perl/x2p/find2perl.PL
+++ b/gnu/usr.bin/perl/x2p/find2perl.PL
@@ -56,12 +56,17 @@ my $startperl = "#! $perlpath -w";
 #
 # Modified 2000-01-28 to use the 'follow' option of File::Find
 
+sub tab ();
+sub n ($$);
+sub fileglob_to_re ($);
+sub quote ($);
+
 my @roots = ();
 while ($ARGV[0] =~ /^[^-!(]/) {
     push(@roots, shift);
 }
 @roots = (curdir()) unless @roots;
-for (@roots) { $_ = &quote($_) }
+for (@roots) { $_ = quote($_) }
 my $roots = join(', ', @roots);
 
 my $find = "find";
@@ -72,6 +77,7 @@ my $flushall = '';
 my $initfile = '';
 my $initnewer = '';
 my $out = '';
+my $declaresubs = "sub wanted;\n";
 my %init = ();
 my ($follow_in_effect,$Skip_And) = (0,0);
 
@@ -79,26 +85,26 @@ while (@ARGV) {
     $_ = shift;
     s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
     if ($_ eq '(') {
-        $out .= &tab . "(\n";
+        $out .= tab . "(\n";
         $indent_depth++;
         next;
     } elsif ($_ eq ')') {
         --$indent_depth;
-        $out .= &tab . ")";
+        $out .= tab . ")";
     } elsif ($_ eq 'follow') {
         $follow_in_effect= 1;
         $stat = 'stat';
         $Skip_And= 1;
     } elsif ($_ eq '!') {
-        $out .= &tab . "!";
+        $out .= tab . "!";
         next;
     } elsif ($_ eq 'name') {
-        $out .= &tab . '/' . &fileglob_to_re(shift) . "/s";
+        $out .= tab . '/' . fileglob_to_re(shift) . "/s";
     } elsif ($_ eq 'perm') {
         my $onum = shift;
         $onum =~ /^-?[0-7]+$/
             || die "Malformed -perm argument: $onum\n";
-        $out .= &tab;
+        $out .= tab;
         if ($onum =~ s/^-//) {
             $onum = sprintf("0%o", oct($onum) & 07777);
             $out .= "((\$mode & $onum) == $onum)";
@@ -108,14 +114,14 @@ while (@ARGV) {
         }
     } elsif ($_ eq 'type') {
         (my $filetest = shift) =~ tr/s/S/;
-        $out .= &tab . "-$filetest _";
+        $out .= tab . "-$filetest _";
     } elsif ($_ eq 'print') {
-        $out .= &tab . 'print("$name\n")';
+        $out .= tab . 'print("$name\n")';
     } elsif ($_ eq 'print0') {
-        $out .= &tab . 'print("$name\0")';
+        $out .= tab . 'print("$name\0")';
     } elsif ($_ eq 'fstype') {
         my $type = shift;
-        $out .= &tab;
+        $out .= tab;
         if ($type eq 'nfs') {
             $out .= '($dev < 0)';
         } else {
@@ -123,22 +129,22 @@ while (@ARGV) {
         }
     } elsif ($_ eq 'user') {
         my $uname = shift;
-        $out .= &tab . "(\$uid == \$uid{'$uname'})";
+        $out .= tab . "(\$uid == \$uid{'$uname'})";
         $init{user} = 1;
     } elsif ($_ eq 'group') {
         my $gname = shift;
-        $out .= &tab . "(\$gid == \$gid{'$gname'})";
+        $out .= tab . "(\$gid == \$gid{'$gname'})";
         $init{group} = 1;
     } elsif ($_ eq 'nouser') {
-        $out .= &tab . '!exists $uid{$uid}';
+        $out .= tab . '!exists $uid{$uid}';
         $init{user} = 1;
     } elsif ($_ eq 'nogroup') {
-        $out .= &tab . '!exists $gid{$gid}';
+        $out .= tab . '!exists $gid{$gid}';
         $init{group} = 1;
     } elsif ($_ eq 'links') {
-        $out .= &tab . &n('$nlink', shift);
+        $out .= tab . n('$nlink', shift);
     } elsif ($_ eq 'inum') {
-        $out .= &tab . &n('$ino', shift);
+        $out .= tab . n('$ino', shift);
     } elsif ($_ eq 'size') {
         $_ = shift;
         my $n = 'int(((-s _) + 511) / 512)';
@@ -147,19 +153,19 @@ while (@ARGV) {
         } elsif (s/k\z//) {
             $n = 'int(((-s _) + 1023) / 1024)';
         }
-        $out .= &tab . &n($n, $_);
+        $out .= tab . n($n, $_);
     } elsif ($_ eq 'atime') {
-        $out .= &tab . &n('int(-A _)', shift);
+        $out .= tab . n('int(-A _)', shift);
     } elsif ($_ eq 'mtime') {
-        $out .= &tab . &n('int(-M _)', shift);
+        $out .= tab . n('int(-M _)', shift);
     } elsif ($_ eq 'ctime') {
-        $out .= &tab . &n('int(-C _)', shift);
+        $out .= tab . n('int(-C _)', shift);
     } elsif ($_ eq 'exec') {
         my @cmd = ();
         while (@ARGV && $ARGV[0] ne ';')
             { push(@cmd, shift) }
         shift;
-        $out .= &tab;
+        $out .= tab;
         if ($cmd[0] =~m#^(?:(?:/usr)?/bin/)?rm$#
                 && $cmd[$#cmd] eq '{}'
                 && (@cmd == 2 || (@cmd == 3 && $cmd[1] eq '-f'))) {
@@ -173,7 +179,8 @@ while (@ARGV) {
         } else {
             for (@cmd)
                 { s/'/\\'/g }
-            { local $" = "','"; $out .= "&doexec(0, '@cmd')"; }
+            { local $" = "','"; $out .= "doexec(0, '@cmd')"; }
+            $declaresubs .= "sub doexec (\$\@);\n";
             $init{doexec} = 1;
         }
     } elsif ($_ eq 'ok') {
@@ -181,41 +188,44 @@ while (@ARGV) {
         while (@ARGV && $ARGV[0] ne ';')
             { push(@cmd, shift) }
         shift;
-        $out .= &tab;
+        $out .= tab;
         for (@cmd)
             { s/'/\\'/g }
-        { local $" = "','"; $out .= "&doexec(0, '@cmd')"; }
+        { local $" = "','"; $out .= "doexec(0, '@cmd')"; }
+        $declaresubs .= "sub doexec (\$\@);\n";
         $init{doexec} = 1;
     } elsif ($_ eq 'prune') {
-        $out .= &tab . '($File::Find::prune = 1)';
+        $out .= tab . '($File::Find::prune = 1)';
     } elsif ($_ eq 'xdev') {
-        $out .= &tab . '!($File::Find::prune |= ($dev != $File::Find::topdev))'
+        $out .= tab . '!($File::Find::prune |= ($dev != $File::Find::topdev))'
 ;
     } elsif ($_ eq 'newer') {
         my $file = shift;
         my $newername = 'AGE_OF' . $file;
         $newername =~ s/\W/_/g;
         $newername = '$' . $newername;
-        $out .= &tab . "(-M _ < $newername)";
-        $initnewer .= "my $newername = -M " . &quote($file) . ";\n";
+        $out .= tab . "(-M _ < $newername)";
+        $initnewer .= "my $newername = -M " . quote($file) . ";\n";
     } elsif ($_ eq 'eval') {
         my $prog = shift;
         $prog =~ s/'/\\'/g;
-        $out .= &tab . "eval {$prog}";
+        $out .= tab . "eval {$prog}";
     } elsif ($_ eq 'depth') {
         $find = 'finddepth';
         next;
     } elsif ($_ eq 'ls') {
-        $out .= &tab . "&ls";
+        $out .= tab . "ls";
+        $declaresubs .= "sub ls ();\n";
         $init{ls} = 1;
     } elsif ($_ eq 'tar') {
         die "-tar must have a filename argument\n" unless @ARGV;
         my $file = shift;
         my $fh = 'FH' . $file;
         $fh =~ s/\W/_/g;
-        $out .= &tab . "&tar(*$fh, \$name)";
-        $flushall .= "&tflushall;\n";
-        $initfile .= "open($fh, " . &quote('> ' . $file) .
+        $out .= tab . "tar(*$fh, \$name)";
+        $flushall .= "tflushall;\n";
+        $declaresubs .= "sub tar;\nsub tflushall ();\n";
+        $initfile .= "open($fh, " . quote('> ' . $file) .
                      qq{) || die "Can't open $fh: \$!\\n";\n};
         $init{tar} = 1;
     } elsif (/^(n?)cpio\z/) {
@@ -223,10 +233,11 @@ while (@ARGV) {
         my $file = shift;
         my $fh = 'FH' . $file;
         $fh =~ s/\W/_/g;
-        $out .= &tab . "&cpio(*$fh, \$name, '$1')";
+        $out .= tab . "cpio(*$fh, \$name, '$1')";
         $find = 'finddepth';
-        $flushall .= "&cflushall;\n";
-        $initfile .= "open($fh, " . &quote('> ' . $file) .
+        $flushall .= "cflushall;\n";
+        $declaresubs .= "sub cpio;\nsub cflushall ();\n";
+        $initfile .= "open($fh, " . quote('> ' . $file) .
                      qq{) || die "Can't open $fh: \$!\\n";\n};
         $init{cpio} = 1;
     } else {
@@ -235,7 +246,7 @@ while (@ARGV) {
 
     if (@ARGV) {
         if ($ARGV[0] eq '-o') {
-            { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
+            { local($statdone) = 1; $out .= "\n" . tab . "||\n"; }
             $statdone = 0 if $indent_depth == 1 && exists $init{delayedstat};
             $init{saw_or} = 1;
             shift;
@@ -265,8 +276,9 @@ use vars qw/*name *dir *prune/;
 *dir    = *File::Find::dir;
 *prune  = *File::Find::prune;
 
-END
+$declaresubs
 
+END
 
 if (exists $init{ls}) {
     print <<'END';
@@ -339,19 +351,20 @@ if (exists $init{doexec}) {
 use Cwd ();
 my $cwd = Cwd::cwd();
 
-sub doexec {
+sub doexec ($@) {
     my $ok = shift;
-    for my $word (@_)
+    my @command = @_; # copy so we don't try to s/// aliases to constants
+    for my $word (@command)
         { $word =~ s#{}#$name#g }
     if ($ok) {
         my $old = select(STDOUT);
         $| = 1;
-        print "@_";
+        print "@command";
         select($old);
         return 0 unless <STDIN> =~ /^y/;
     }
     chdir $cwd; #sigh
-    system @_;
+    system @command;
     chdir $File::Find::dir;
     return !$?;
 }
@@ -367,7 +380,7 @@ sub sizemm {
     sprintf("%3d, %3d", ($rdev >> 8) & 0xff, $rdev & 0xff);
 }
 
-sub ls {
+sub ls () {
     my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 INTRO
         \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
@@ -515,9 +528,9 @@ SUB
     }
 }
 
-sub cflushall {
+sub cflushall () {
     for my $fh (keys %cpout) {
-        &cpio($fh, undef, $nc{$fh});
+        cpio($fh, undef, $nc{$fh});
         $cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
         flush($fh, \$cpout{$fh}, 5120);
         print $blocks{$fh} * 10, " blocks\n";
@@ -619,7 +632,7 @@ SUB
     }
 }
 
-sub tflushall {
+sub tflushall () {
     my $len;
     for my $fh (keys %tarout) {
         $len = 10240 - length($tarout{$fh});
@@ -636,7 +649,7 @@ exit;
 
 ############################################################################
 
-sub tab {
+sub tab () {
     my $tabstring;
 
     $tabstring = "\t" x ($indent_depth/2) . ' ' x ($indent_depth%2 * 4);
@@ -659,21 +672,21 @@ sub tab {
     $tabstring;
 }
 
-sub fileglob_to_re {
+sub fileglob_to_re ($) {
     my $x = shift;
-    $x =~ s#([./^\$()])#\\$1#g;
+    $x =~ s#([./^\$()+])#\\$1#g;
     $x =~ s#([?*])#.$1#g;
     "^$x\\z";
 }
 
-sub n {
+sub n ($$) {
     my ($pre, $n) = @_;
     $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
     $n =~ s/ 0*(\d)/ $1/;
     "($pre $n)";
 }
 
-sub quote {
+sub quote ($) {
     my $string = shift;
     $string =~ s/\\/\\\\/g;
     $string =~ s/'/\\'/g;
@@ -828,7 +841,7 @@ Like -print, but terminates with \0 instead of \n.
 
 =item C<-exec OPTIONS ;>
 
-exec() the arguments in OPTIONS in a subprocess; any occurence of {} in
+exec() the arguments in OPTIONS in a subprocess; any occurrence of {} in
 OPTIONS will first be substituted with the path of the current
 file.  Note that the command "rm" has been special-cased to use perl's
 unlink() function instead (as an optimization).  The C<;> must be passed as
diff --git a/gnu/usr.bin/perl/x2p/hash.c b/gnu/usr.bin/perl/x2p/hash.c
index a266403efe9..dbdc9284241 100644
--- a/gnu/usr.bin/perl/x2p/hash.c
+++ b/gnu/usr.bin/perl/x2p/hash.c
@@ -1,6 +1,6 @@
 /* $RCSfile: hash.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:20 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -13,6 +13,10 @@
 #include "a2p.h"
 #include "util.h"
 
+#ifdef NETWARE
+char *savestr(char *str);
+#endif
+
 STR *
 hfetch(register HASH *tb, char *key)
 {
@@ -137,7 +141,7 @@ hsplit(HASH *tb)
     register HENT **oentry;
 
     a = (HENT**) saferealloc((char*)tb->tbl_array, newsize * sizeof(HENT*));
-    bzero((char*)&a[oldsize], oldsize * sizeof(HENT*)); /* zero second half */
+    memset(&a[oldsize], 0, oldsize * sizeof(HENT*)); /* zero second half */
     tb->tbl_max = --newsize;
     tb->tbl_array = a;
 
@@ -171,7 +175,7 @@ hnew(void)
     tb->tbl_fill = 0;
     tb->tbl_max = 7;
     hiterinit(tb);	/* so each() will start off right */
-    bzero((char*)tb->tbl_array, 8 * sizeof(HENT*));
+    memset(tb->tbl_array, 0, 8 * sizeof(HENT*));
     return tb;
 }
 
diff --git a/gnu/usr.bin/perl/x2p/hash.h b/gnu/usr.bin/perl/x2p/hash.h
index 7b2b6684921..85ce07c2f76 100644
--- a/gnu/usr.bin/perl/x2p/hash.h
+++ b/gnu/usr.bin/perl/x2p/hash.h
@@ -1,6 +1,6 @@
 /* $RCSfile: hash.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:21 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
diff --git a/gnu/usr.bin/perl/x2p/proto.h b/gnu/usr.bin/perl/x2p/proto.h
index e57b4fc30e3..5deeb3441af 100644
--- a/gnu/usr.bin/perl/x2p/proto.h
+++ b/gnu/usr.bin/perl/x2p/proto.h
@@ -1,6 +1,6 @@
 /*    proto.h
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
diff --git a/gnu/usr.bin/perl/x2p/s2p.PL b/gnu/usr.bin/perl/x2p/s2p.PL
index 2d44dd2d4eb..1e2ee1a6acf 100644
--- a/gnu/usr.bin/perl/x2p/s2p.PL
+++ b/gnu/usr.bin/perl/x2p/s2p.PL
@@ -1,8 +1,29 @@
-#!/usr/local/bin/perl
+#!/usr/bin/perl
 
 use Config;
 use File::Basename qw(&basename &dirname);
 use Cwd;
+use subs qw(link);
+
+sub link { # This is a cut-down version of installperl:link().
+    my($from,$to) = @_;
+    my($success) = 0;
+
+    eval {
+	CORE::link($from, $to)
+	    ? $success++
+	    : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
+	      ? die "AFS"  # okay inside eval {}
+	      : die "Couldn't link $from to $to: $!\n";
+    };
+    if ($@) {
+	require File::Copy;
+	File::Copy::copy($from, $to)
+	    ? $success++
+	    : warn "Couldn't copy $from to $to: $!\n";
+    }
+    $success;
+}
 
 # List explicitly here the variables you want Configure to
 # generate.  Metaconfig only looks for shell variables, so you
@@ -29,6 +50,8 @@ print OUT <<"!GROK!THIS!";
 $Config{startperl}
     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
 	if \$running_under_some_shell;
+my \$startperl;
+my \$perlpath;
 (\$startperl = <<'/../') =~ s/\\s*\\z//;
 $Config{startperl}
 /../
@@ -41,818 +64,1995 @@ $Config{perlpath}
 
 print OUT <<'!NO!SUBS!';
 
-# $RCSfile: s2p.SH,v $$Revision: 4.1 $$Date: 92/08/07 18:29:23 $
-#
-# $Log:	s2p.SH,v $
+$0 =~ s/^.*?(\w+)[\.\w]*$/$1/;
+
+# (p)sed - a stream editor
+# History:  Aug 12 2000: Original version.
+#           Mar 25 2002: Rearrange generated Perl program.
+
+use strict;
+use integer;
+use Symbol;
 
 =head1 NAME
 
-s2p - Sed to Perl translator
+psed - a stream editor
 
 =head1 SYNOPSIS
 
-B<s2p [options] filename>
+   psed [-an] script [file ...]
+   psed [-an] [-e script] [-f script-file] [file ...]
+
+   s2p  [-an] [-e script] [-f script-file]
 
 =head1 DESCRIPTION
 
-I<s2p> takes a sed script specified on the command line (or from
-standard input) and produces a comparable I<perl> script on the
-standard output.
+A stream editor reads the input stream consisting of the specified files
+(or standard input, if none are given), processes is line by line by
+applying a script consisting of edit commands, and writes resulting lines
+to standard output. The filename `C<->' may be used to read standard input.
+
+The edit script is composed from arguments of B<-e> options and
+script-files, in the given order. A single script argument may be specified
+as the first parameter.
+
+If this program is invoked with the name F<s2p>, it will act as a
+sed-to-Perl translator. See L<"sed Script Translation">.
+
+B<sed> returns an exit code of 0 on success or >0 if an error occurred.
 
-=head2 Options
+=head1 OPTIONS
 
-Options include:
+=over 4
 
-=over 5
+=item B<-a>
 
-=item B<-DE<lt>numberE<gt>>
+A file specified as argument to the B<w> edit command is by default
+opened before input processing starts. Using B<-a>, opening of such
+files is delayed until the first line is actually written to the file.
 
-sets debugging flags.
+=item B<-e> I<script>
+
+The editing commands defined by I<script> are appended to the script.
+Multiple commands must be separated by newlines.
+
+=item B<-f> I<script-file>
+
+Editing commands from the specified I<script-file> are read and appended
+to the script.
 
 =item B<-n>
 
-specifies that this sed script was always invoked with a B<sed -n>.
-Otherwise a switch parser is prepended to the front of the script.
+By default, a line is written to standard output after the editing script
+has been applied to it. The B<-n> option suppresses automatic printing.
+
+=back
+
+=head1 COMMANDS
+
+B<sed> command syntax is defined as
+
+Z<> Z<> Z<> Z<>[I<address>[B<,>I<address>]][B<!>]I<function>[I<argument>]
+
+with whitespace being permitted before or after addresses, and between
+the function character and the argument. The I<address>es and the
+address inverter (C<!>) are used to restrict the application of a
+command to the selected line(s) of input.
 
-=item B<-p>
+Each command must be on a line of its own, except where noted in
+the synopses below.
 
-specifies that this sed script was never invoked with a B<sed -n>.
-Otherwise a switch parser is prepended to the front of the script.
+The edit cycle performed on each input line consist of reading the line
+(without its trailing newline character) into the I<pattern space>,
+applying the applicable commands of the edit script, writing the final
+contents of the pattern space and a newline to the standard output.
+A I<hold space> is provided for saving the contents of the
+pattern space for later use.
+
+=head2 Addresses
+
+A sed address is either a line number or a pattern, which may be combined
+arbitrarily to construct ranges. Lines are numbered across all input files.
+
+Any address may be followed by an exclamation mark (`C<!>'), selecting
+all lines not matching that address.
+
+=over 4
+
+=item I<number>
+
+The line with the given number is selected.
+
+=item B<$>
+
+A dollar sign (C<$>) is the line number of the last line of the input stream.
+
+=item B</>I<regular expression>B</>
+
+A pattern address is a basic regular expression (see 
+L<"Basic Regular Expressions">), between the delimiting character C</>.
+Any other character except C<\> or newline may be used to delimit a
+pattern address when the initial delimiter is prefixed with a
+backslash (`C<\>').
 
 =back
 
-=head2 Considerations
+If no address is given, the command selects every line.
 
-The perl script produced looks very sed-ish, and there may very well
-be better ways to express what you want to do in perl.  For instance,
-s2p does not make any use of the split operator, but you might want
-to.
+If one address is given, it selects the line (or lines) matching the
+address.
 
-The perl script you end up with may be either faster or slower than
-the original sed script.  If you're only interested in speed you'll
-just have to try it both ways.  Of course, if you want to do something
-sed doesn't do, you have no choice.  It's often possible to speed up
-the perl script by various methods, such as deleting all references to
-$\ and chop.
+Two addresses select a range that begins whenever the first address
+matches, and ends (including that line) when the second address matches.
+If the first (second) address is a matching pattern, the second 
+address is not applied to the very same line to determine the end of
+the range. Likewise, if the second address is a matching pattern, the
+first address is not applied to the very same line to determine the
+begin of another range. If both addresses are line numbers,
+and the second line number is less than the first line number, then
+only the first line is selected.
 
-=head1 ENVIRONMENT
 
-s2p uses no environment variables.
+=head2 Functions
 
-=head1 AUTHOR
+The maximum permitted number of addresses is indicated with each
+function synopsis below.
 
-Larry Wall E<lt>F<larry@wall.org>E<gt>
+The argument I<text> consists of one or more lines following the command.
+Embedded newlines in I<text> must be preceded with a backslash.  Other
+backslashes in I<text> are deleted and the following character is taken
+literally.
 
-=head1 FILES
+=over 4
 
-=head1 SEE ALSO
+=cut
 
- perl	The perl compiler/interpreter
+my %ComTab;
+my %GenKey;
+#--------------------------------------------------------------------------
+$ComTab{'a'}=[ 1, 'txt', \&Emit,       '{ push( @Q, <<'."'TheEnd' ) }\n" ]; #ok
 
- a2p	awk to perl translator
+=item [1addr]B<a\> I<text>
 
-=head1 DIAGNOSTICS
+Write I<text> (which must start on the line following the command)
+to standard output immediately before reading the next line
+of input, either by executing the B<N> function or by beginning a new cycle.
 
-=head1 BUGS
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'b'}=[ 2, 'str', \&Branch,     '{ goto XXX; }'                   ]; #ok
+
+=item [2addr]B<b> [I<label>]
+
+Branch to the B<:> function with the specified I<label>. If no label
+is given, branch to the end of the script.
 
 =cut
 
-$indent = 4;
-$shiftwidth = 4;
-$l = '{'; $r = '}';
+#--------------------------------------------------------------------------
+$ComTab{'c'}=[ 2, 'txt', \&Change,     <<'-X-'                           ]; #ok
+{ print <<'TheEnd'; } $doPrint = 0; goto EOS;
+-X-
+### continue OK => next CYCLE;
 
-while ($ARGV[0] =~ /^-/) {
-    $_ = shift;
-  last if /^--/;
-    if (/^-D/) {
-	$debug++;
-	open(BODY,'>-');
-	next;
+=item [2addr]B<c\> I<text>
+
+The line, or range of lines, selected by the address is deleted. 
+The I<text> (which must start on the line following the command)
+is written to standard output. With an address range, this occurs at
+the end of the range.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'d'}=[ 2, '',    \&Emit,       <<'-X-'                           ]; #ok
+{ $doPrint = 0;
+  goto EOS;
+}
+-X-
+### continue OK => next CYCLE;
+
+=item [2addr]B<d>
+
+Deletes the pattern space and starts the next cycle.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'D'}=[ 2, '',    \&Emit,       <<'-X-'                           ]; #ok
+{ s/^.*\n?//;
+  if(length($_)){ goto BOS } else { goto EOS }
+}
+-X-
+### continue OK => next CYCLE;
+
+=item [2addr]B<D>
+
+Deletes the pattern space through the first embedded newline or to the end.
+If the pattern space becomes empty, a new cycle is started, otherwise
+execution of the script is restarted.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'g'}=[ 2, '',    \&Emit,       '{ $_ = $Hold };'                 ]; #ok
+
+=item [2addr]B<g>
+
+Replace the contents of the pattern space with the hold space.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'G'}=[ 2, '',    \&Emit,       '{ $_ .= "\n"; $_ .= $Hold };'    ]; #ok
+
+=item [2addr]B<G>
+
+Append a newline and the contents of the hold space to the pattern space.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'h'}=[ 2, '',    \&Emit,       '{ $Hold = $_ }'                  ]; #ok
+
+=item [2addr]B<h>
+
+Replace the contents of the hold space with the pattern space.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'H'}=[ 2, '',    \&Emit,       '{ $Hold .= "\n"; $Hold .= $_; }' ]; #ok
+
+=item [2addr]B<H>
+
+Append a newline and the contents of the pattern space to the hold space.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'i'}=[ 1, 'txt', \&Emit,       '{ print <<'."'TheEnd' }\n"       ]; #ok
+
+=item [1addr]B<i\> I<text>
+
+Write the I<text> (which must start on the line following the command)
+to standard output.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'l'}=[ 2, '',    \&Emit,       '{ _l() }'                        ]; #okUTF8
+
+=item [2addr]B<l>
+
+Print the contents of the pattern space: non-printable characters are
+shown in C-style escaped form; long lines are split and have a trailing
+`C<\>' at the point of the split; the true end of a line is marked with
+a `C<$>'. Escapes are: `\a', `\t', `\n', `\f', `\r', `\e' for
+BEL, HT, LF, FF, CR, ESC, respectively, and `\' followed by a three-digit
+octal number for all other non-printable characters.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'n'}=[ 2, '',    \&Emit,       <<'-X-'                           ]; #ok
+{ print $_, "\n" if $doPrint;
+  printQ() if @Q;
+  $CondReg = 0;
+  last CYCLE unless getsARGV();
+  chomp();
+}
+-X-
+
+=item [2addr]B<n>
+
+If automatic printing is enabled, write the pattern space to the standard
+output. Replace the pattern space with the next line of input. If
+there is no more input, processing is terminated.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'N'}=[ 2, '',    \&Emit,       <<'-X-'                           ]; #ok
+{ printQ() if @Q;
+  $CondReg = 0;
+  last CYCLE unless getsARGV( $h );
+  chomp( $h );
+  $_ .= "\n$h";
+}
+-X-
+
+=item [2addr]B<N>
+
+Append a newline and the next line of input to the pattern space. If
+there is no more input, processing is terminated.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'p'}=[ 2, '',    \&Emit,       '{ print $_, "\n"; }'             ]; #ok
+
+=item [2addr]B<p>
+
+Print the pattern space to the standard output. (Use the B<-n> option
+to suppress automatic printing at the end of a cycle if you want to
+avoid double printing of lines.)
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'P'}=[ 2, '',    \&Emit,       <<'-X-'                           ]; #ok
+{ if( /^(.*)/ ){ print $1, "\n"; } }
+-X-
+
+=item [2addr]B<P>
+
+Prints the pattern space through the first embedded newline or to the end.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'q'}=[ 1, '',    \&Emit,       <<'-X-'                           ]; #ok
+{ print $_, "\n" if $doPrint;
+  last CYCLE;
+}
+-X-
+
+=item [1addr]B<q>
+
+Branch to the end of the script and quit without starting a new cycle.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'r'}=[ 1, 'str', \&Emit,       "{ _r( '-X-' ) }"                 ]; #ok
+
+=item [1addr]B<r> I<file>
+
+Copy the contents of the I<file> to standard output immediately before
+the next attempt to read a line of input. Any error encountered while
+reading I<file> is silently ignored.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'s'}=[ 2, 'sub', \&Emit,       ''                                ]; #ok
+
+=item [2addr]B<s/>I<regular expression>B</>I<replacement>B</>I<flags>
+
+Substitute the I<replacement> string for the first substring in
+the pattern space that matches the I<regular expression>.
+Any character other than backslash or newline can be used instead of a 
+slash to delimit the regular expression and the replacement.
+To use the delimiter as a literal character within the regular expression
+and the replacement, precede the character by a backslash (`C<\>').
+
+Literal newlines may be embedded in the replacement string by
+preceding a newline with a backslash.
+
+Within the replacement, an ampersand (`C<&>') is replaced by the string
+matching the regular expression. The strings `C<\1>' through `C<\9>' are
+replaced by the corresponding subpattern (see L<"Basic Regular Expressions">).
+To get a literal `C<&>' or `C<\>' in the replacement text, precede it
+by a backslash.
+
+The following I<flags> modify the behaviour of the B<s> command:
+
+=over 8
+
+=item B<g>
+
+The replacement is performed for all matching, non-overlapping substrings
+of the pattern space.
+
+=item B<1>..B<9>
+
+Replace only the n-th matching substring of the pattern space.
+
+=item B<p>
+
+If the substitution was made, print the new value of the pattern space.
+
+=item B<w> I<file>
+
+If the substitution was made, write the new value of the pattern space
+to the specified file.
+
+=back
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'t'}=[ 2, 'str', \&Branch,     '{ goto XXX if _t() }'            ]; #ok
+
+=item [2addr]B<t> [I<label>]
+
+Branch to the B<:> function with the specified I<label> if any B<s>
+substitutions have been made since the most recent reading of an input line
+or execution of a B<t> function. If no label is given, branch to the end of
+the script. 
+
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'w'}=[ 2, 'str', \&Write,      "{ _w( '-X-' ) }"                 ]; #ok
+
+=item [2addr]B<w> I<file>
+
+The contents of the pattern space are written to the I<file>.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'x'}=[ 2, '',    \&Emit,       '{ ($Hold, $_) = ($_, $Hold) }'   ]; #ok
+
+=item [2addr]B<x>
+
+Swap the contents of the pattern space and the hold space.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'y'}=[ 2, 'tra', \&Emit,       ''                                ]; #ok
+=item [2addr]B<y>B</>I<string1>B</>I<string2>B</>
+
+In the pattern space, replace all characters occuring in I<string1> by the
+character at the corresponding position in I<string2>. It is possible
+to use any character (other than a backslash or newline) instead of a
+slash to delimit the strings.  Within I<string1> and I<string2>, a
+backslash followed by any character other than a newline is that literal
+character, and a backslash followed by an `n' is replaced by a newline
+character.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'='}=[ 1, '',    \&Emit,       '{ print "$.\n" }'                ]; #ok
+
+=item [1addr]B<=>
+
+Prints the current line number on the standard output.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{':'}=[ 0, 'str', \&Label,      ''                                ]; #ok
+ 
+=item [0addr]B<:> [I<label>]
+
+The command specifies the position of the I<label>. It has no other effect.
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'{'}=[ 2, '',    \&BeginBlock, '{'                               ]; #ok
+$ComTab{'}'}=[ 0, '',    \&EndBlock,   ';}'                              ]; #ok
+# ';' to avoid warning on empty {}-block
+
+=item [2addr]B<{> [I<command>]
+
+=item [0addr]B<}>
+
+These two commands begin and end a command list. The first command may
+be given on the same line as the opening B<{> command. The commands
+within the list are jointly selected by the address(es) given on the
+B<{> command (but may still have individual addresses).
+
+=cut
+
+#--------------------------------------------------------------------------
+$ComTab{'#'}=[ 0, 'str', \&Comment,    ''                                ]; #ok
+
+=item [0addr]B<#> [I<comment>]
+
+The entire line is ignored (treated as a comment). If, however, the first
+two characters in the script are `C<#n>', automatic printing of output is
+suppressed, as if the B<-n> option were given on the command line.
+
+=back
+
+=cut
+
+use vars qw{ $isEOF $Hold %wFiles @Q $CondReg $doPrint };
+
+my $useDEBUG    = exists( $ENV{PSEDDEBUG} );
+my $useEXTBRE   = $ENV{PSEDEXTBRE} || '';
+$useEXTBRE =~ s/[^<>wWyB]//g; # gawk RE's handle these
+
+my $doAutoPrint = 1;          # automatic printing of pattern space (-n => 0)
+my $doOpenWrite = 1;          # open w command output files at start (-a => 0)
+my $svOpenWrite = 0;          # save $doOpenWrite
+my $doGenerate  = $0 eq 's2p';
+
+# Collected and compiled script
+#
+my( @Commands, %Defined, @BlockStack, %Label, $labNum, $Code, $Func );
+$Code = '';
+
+##################
+#  Compile Time
+#
+# Labels
+# 
+# Error handling
+#
+sub Warn($;$){
+    my( $msg, $loc ) = @_;
+    $loc ||= '';
+    $loc .= ': ' if length( $loc );
+    warn( "$0: $loc$msg\n" );
+}
+
+$labNum = 0;
+sub newLabel(){
+    return 'L_'.++$labNum;
+}
+
+# safeHere: create safe here delimiter and  modify opcode and argument
+#
+sub safeHere($$){
+    my( $codref, $argref ) = @_;
+    my $eod = 'EOD000';
+    while( $$argref =~ /^$eod$/m ){
+        $eod++;
     }
-    if (/^-n/) {
-	$assumen++;
-	next;
+    $$codref =~ s/TheEnd/$eod/e;
+    $$argref .= "$eod\n"; 
+}
+
+# Emit: create address logic and emit command
+#
+sub Emit($$$$$$){
+    my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
+    my $cond = '';
+    if( defined( $addr1 ) ){
+        if( defined( $addr2 ) ){
+	    $addr1 .= $addr2 =~ /^\d+$/ ? "..$addr2" : "...$addr2";
+        } else {
+	    $addr1 .= ' == $.' if $addr1 =~ /^\d+$/;
+	}
+	$cond = $negated ? "unless( $addr1 )\n" : "if( $addr1 )\n";
     }
-    if (/^-p/) {
-	$assumep++;
-	next;
+
+    if( $opcode eq '' ){
+	$Code .= "$cond$arg\n";
+
+    } elsif( $opcode =~ s/-X-/$arg/e ){
+	$Code .= "$cond$opcode\n";
+
+    } elsif( $opcode =~ /TheEnd/ ){
+	safeHere( \$opcode, \$arg );
+	$Code .= "$cond$opcode$arg";
+
+    } else {
+	$Code .= "$cond$opcode\n";
     }
-    die "I don't recognize this switch: $_\n";
-}
-
-unless ($debug) {
-    open(BODY,"+>/tmp/sperl$$") ||
-      &Die("Can't open temp file: $!\n");
-}
-
-if (!$assumen && !$assumep) {
-    print BODY &q(<<'EOT');
-:	while ($ARGV[0] =~ /^-/) {
-:	    $_ = shift;
-:	  last if /^--/;
-:	    if (/^-n/) {
-:		$nflag++;
-:		next;
-:	    }
-:	    die "I don't recognize this switch: $_\\n";
-:	}
-:	
-EOT
-}
-
-print BODY &q(<<'EOT');
-:	#ifdef PRINTIT
-:	#ifdef ASSUMEP
-:	$printit++;
-:	#else
-:	$printit++ unless $nflag;
-:	#endif
-:	#endif
-:	<><>
-:	$\ = "\n";		# automatically add newline on print
-:	<><>
-:	#ifdef TOPLABEL
-:	LINE:
-:	while (chop($_ = <>)) {
-:	#else
-:	LINE:
-:	while (<>) {
-:	    chop;
-:	#endif
-EOT
-
-LINE:
-while (<>) {
-
-    # Wipe out surrounding whitespace.
-
-    s/[ \t]*(.*)\n$/$1/;
-
-    # Perhaps it's a label/comment.
-
-    if (/^:/) {
-	s/^:[ \t]*//;
-	$label = &make_label($_);
-	if ($. == 1) {
-	    $toplabel = $label;
-	    if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
-		$_ = <>;
-		redo LINE; # Never referenced, so delete it if not a comment.
+    0;
+}
+
+# Write (w command, w flag): store pathname
+#
+sub Write($$$$$$){
+    my( $addr1, $addr2, $negated, $opcode, $path, $fl ) = @_;
+    $wFiles{$path} = '';
+    Emit( $addr1, $addr2, $negated, $opcode, $path, $fl );
+}
+
+
+# Label (: command): label definition
+#
+sub Label($$$$$$){
+    my( $addr1, $addr2, $negated, $opcode, $lab, $fl ) = @_;
+    my $rc = 0;
+    $lab =~ s/\s+//;
+    if( length( $lab ) ){
+	my $h;
+	if( ! exists( $Label{$lab} ) ){
+	    $h = $Label{$lab}{name} = newLabel();
+        } else {
+	    $h = $Label{$lab}{name};
+	    if( exists( $Label{$lab}{defined} ) ){
+		my $dl = $Label{$lab}{defined};
+		Warn( "duplicate label $lab (first defined at $dl)", $fl );
+		$rc = 1;
 	    }
 	}
-	$_ = "$label:";
-	if ($lastlinewaslabel++) {
-	    $indent += 4;
-	    print BODY &tab, ";\n";
-	    $indent -= 4;
-	}
-	if ($indent >= 2) {
-	    $indent -= 2;
-	    $indmod = 2;
-	}
-	next;
-    } else {
-	$lastlinewaslabel = '';
+        $Label{$lab}{defined} = $fl;
+	$Code .= "$h:;\n";
     }
+    $rc;
+}
 
-    # Look for one or two address clauses
+# BeginBlock ({ command): push block start
+#
+sub BeginBlock($$$$$$){
+    my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
+    push( @BlockStack, [ $fl, $addr1, $addr2, $negated ] );
+    Emit( $addr1, $addr2, $negated, $opcode, $arg, $fl );
+}
 
-    $addr1 = '';
-    $addr2 = '';
-    if (s/^([0-9]+)//) {
-	$addr1 = "$1";
-	$addr1 = "\$. == $addr1" unless /^,/;
-    }
-    elsif (s/^\$//) {
-	$addr1 = 'eof()';
-    }
-    elsif (s|^/||) {
-	$addr1 = &fetchpat('/');
+# EndBlock (} command): check proper nesting
+#
+sub EndBlock($$$$$$){
+    my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
+    my $rc;
+    my $jcom = pop( @BlockStack );
+    if( defined( $jcom ) ){
+	$rc = Emit( $addr1, $addr2, $negated, $opcode, $arg, $fl );
+    } else {
+	Warn( "unexpected `}'", $fl );
+	$rc = 1;
     }
-    if (s/^,//) {
-	if (s/^([0-9]+)//) {
-	    $addr2 = "$1";
-	} elsif (s/^\$//) {
-	    $addr2 = "eof()";
-	} elsif (s|^/||) {
-	    $addr2 = &fetchpat('/');
-	} else {
-	    &Die("Invalid second address at line $.\n");
+    $rc;
+}
+
+# Branch (t, b commands): check or create label, substitute default
+#
+sub Branch($$$$$$){
+    my( $addr1, $addr2, $negated, $opcode, $lab, $fl ) = @_;
+    $lab =~ s/\s+//; # no spaces at end
+    my $h;
+    if( length( $lab ) ){
+	if( ! exists( $Label{$lab} ) ){
+	    $h = $Label{$lab}{name} = newLabel();
+        } else {
+	    $h = $Label{$lab}{name};
 	}
-	if ($addr2 =~ /^\d+$/) {
-	    $addr1 .= "..$addr2";
+	push( @{$Label{$lab}{used}}, $fl );
+    } else {
+	$h = 'EOS';
+    }
+    $opcode =~ s/XXX/$h/e;
+    Emit( $addr1, $addr2, $negated, $opcode, '', $fl );
+}
+
+# Change (c command): is special due to range end watching
+#
+sub Change($$$$$$){
+    my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
+    my $kwd = $negated ? 'unless' : 'if';
+    if( defined( $addr2 ) ){
+        $addr1 .= $addr2 =~ /^\d+$/ ? "..$addr2" : "...$addr2";
+	if( ! $negated ){
+	    $addr1  = '$icnt = ('.$addr1.')';
+	    $opcode = 'if( $icnt =~ /E0$/ )' . $opcode;
 	}
-	else {
-	    $addr1 .= "...$addr2";
+    } else {
+	$addr1 .= ' == $.' if $addr1 =~ /^\d+$/;
+    }
+    safeHere( \$opcode, \$arg );
+    $Code .= "$kwd( $addr1 ){\n  $opcode$arg}\n";
+    0;
+}
+
+
+# Comment (# command): A no-op. Who would've thought that!
+#
+sub Comment($$$$$$){
+    my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
+### $Code .= "# $arg\n";
+    0;
+}
+
+
+sub stripRegex($$){
+    my( $del, $sref ) = @_;
+    my $regex = $del;
+    print "stripRegex:$del:$$sref:\n" if $useDEBUG;
+    while( $$sref =~ s{^(.*?)(\\*)\Q$del\E(\s*)}{}s ){
+        my $sl = $2;
+	$regex .= $1.$sl.$del;
+	if( length( $sl ) % 2 == 0 ){
+	    return $regex;
 	}
+	$regex .= $3;
     }
+    undef();
+}
 
-    # Now we check for metacommands {, }, and ! and worry
-    # about indentation.
+# stripTrans: take a <del> terminated string from y command
+#   honoring and cleaning up of \-escaped <del>'s
+#
+sub stripTrans($$){
+    my( $del, $sref ) = @_;
+    my $t = '';
+    print "stripTrans:$del:$$sref:\n" if $useDEBUG;
+    while( $$sref =~ s{^(.*?)(\\*)\Q$del\E}{}s ){
+        my $sl = $2;
+	$t .= $1;
+	if( length( $sl ) % 2 == 0 ){
+	    $t .= $sl;
+	    $t =~ s/\\\\/\\/g;
+	    return $t;
+	}
+	chop( $sl );
+	$t .= $sl.$del.$3;
+    }
+    undef();
+}
 
-    s/^[ \t]+//;
-    # a { to keep vi happy
-    if ($_ eq '}') {
-	$indent -= 4;
-	next;
+# makey - construct Perl y/// from sed y///
+#
+sub makey($$$){
+    my( $fr, $to, $fl ) = @_;
+    my $error = 0;
+
+    # Ensure that any '-' is up front.
+    # Diagnose duplicate contradicting mappings
+    my %tr;
+    for( my $i = 0; $i < length($fr); $i++ ){
+	my $fc = substr($fr,$i,1);
+	my $tc = substr($to,$i,1);
+	if( exists( $tr{$fc} ) && $tr{$fc} ne $tc ){
+	    Warn( "ambiguos translation for character `$fc' in `y' command",
+		  $fl );
+	    $error++;
+	}
+	$tr{$fc} = $tc;
     }
-    if (s/^!//) {
-	$if = 'unless';
-	$else = "$r else $l\n";
+    $fr = $to = '';
+    if( exists( $tr{'-'} ) ){
+	( $fr, $to ) = ( '-', $tr{'-'} );
+	delete( $tr{'-'} );
     } else {
-	$if = 'if';
-	$else = '';
-    }
-    if (s/^{//) {	# a } to keep vi happy
-	$indmod = 4;
-	$redo = $_;
-	$_ = '';
-	$rmaybe = '';
+	$fr = $to = '';
+    }
+    # might just as well sort it...
+    for my $fc ( sort keys( %tr ) ){
+	$fr .= $fc;
+	$to .= $tr{$fc};
+    }
+    # make embedded delimiters and newlines safe
+    $fr =~ s/([{}])/\$1/g;
+    $to =~ s/([{}])/\$1/g;
+    $fr =~ s/\n/\\n/g;
+    $to =~ s/\n/\\n/g;
+    return $error ? undef() : "{ y{$fr}{$to}; }";
+}
+
+######
+# makes - construct Perl s/// from sed s///
+#
+sub makes($$$$$$$){
+    my( $regex, $subst, $path, $global, $print, $nmatch, $fl ) = @_;
+
+    # make embedded newlines safe
+    $regex =~ s/\n/\\n/g;
+    $subst =~ s/\n/\\n/g;
+ 
+    my $code;
+    # n-th occurrence
+    #
+    if( length( $nmatch ) ){
+	$code = <<TheEnd;
+{ \$n = $nmatch;
+  while( --\$n && ( \$s = m ${regex}g ) ){}
+  \$s = ( substr( \$_, pos() ) =~ s ${regex}${subst}s ) if \$s;
+  \$CondReg ||= \$s;
+TheEnd
     } else {
-	$rmaybe = "\n$r";
-	if ($addr2 || $addr1) {
-	    $space = ' ' x $shiftwidth;
-	} else {
-	    $space = '';
-	}
-	$_ = &transmogrify();
+        $code = <<TheEnd;
+{ \$s = s ${regex}${subst}s${global};
+  \$CondReg ||= \$s;
+TheEnd
+    }
+    if( $print ){
+        $code .= '  print $_, "\n" if $s;'."\n";
     }
+    if( defined( $path ) ){
+        $wFiles{$path} = '';
+	$code .= " _w( '$path' ) if \$s;\n";
+        $GenKey{'w'} = 1;
+    }
+    $code .= "}";
+}
 
-    # See if we can optimize to modifier form.
+=head1 BASIC REGULAR EXPRESSIONS
 
-    if ($addr1) {
-	if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
-	  $_ !~ / if / && $_ !~ / unless /) {
-	    s/;$/ $if $addr1;/;
-	    $_ = substr($_,$shiftwidth,1000);
-	} else {
-	    $_ = "$if ($addr1) $l\n$change$_$rmaybe";
-	}
-	$change = '';
-	next LINE;
-    }
-} continue {
-    @lines = split(/\n/,$_);
-    for (@lines) {
-	unless (s/^ *<<--//) {
-	    print BODY &tab;
+A I<Basic Regular Expression> (BRE), as defined in POSIX 1003.2, consists
+of I<atoms>, for matching parts of a string, and I<bounds>, specifying
+repetitions of a preceding atom.
+
+=head2 Atoms
+
+The possible atoms of a BRE are: B<.>, matching any single character;
+B<^> and B<$>, matching the null string at the beginning or end
+of a string, respectively; a I<bracket expressions>, enclosed
+in B<[> and B<]> (see below); and any single character with no
+other significance (matching that character). A B<\> before one
+of: B<.>, B<^>, B<$>, B<[>, B<*>, B<\>, matching the character
+after the backslash. A sequence of atoms enclosed in B<\(> and B<\)>
+becomes an atom and establishes the target for a I<backreference>,
+consisting of the substring that actually matches the enclosed atoms.
+Finally, B<\> followed by one of the digits B<0> through B<9> is a
+backreference.
+
+A B<^> that is not first, or a B<$> that is not last does not have
+a special significance and need not be preceded by a backslash to
+become literal. The same is true for a B<]>, that does not terminate
+a bracket expression.
+
+An unescaped backslash cannot be last in a BRE.
+
+=head2 Bounds
+
+The BRE bounds are: B<*>, specifying 0 or more matches of the preceding
+atom; B<\{>I<count>B<\}>, specifying that many repetitions;
+B<\{>I<minimum>B<,\}>, giving a lower limit; and
+B<\{>I<minimum>B<,>I<maximum>B<\}> finally defines a lower and upper
+bound. 
+
+A bound appearing as the first item in a BRE is taken literally.
+
+=head2 Bracket Expressions
+
+A I<bracket expression> is a list of characters, character ranges
+and character classes enclosed in B<[> and B<]> and matches any
+single character from the represented set of characters.
+
+A character range is written as two characters separated by B<-> and
+represents all characters (according to the character collating sequence)
+that are not less than the first and not greater than the second.
+(Ranges are very collating-sequence-dependent, and portable programs
+should avoid relying on them.)
+
+A character class is one of the class names
+
+   alnum     digit     punct
+   alpha     graph     space
+   blank     lower     upper
+   cntrl     print     xdigit
+
+enclosed in B<[:> and B<:]> and represents the set of characters
+as defined in ctype(3).
+
+If the first character after B<[> is B<^>, the sense of matching is
+inverted.
+
+To include a literal `C<^>', place it anywhere else but first. To
+include a literal 'C<]>' place it first or immediately after an
+initial B<^>. To include a literal `C<->' make it the first (or
+second after B<^>) or last character, or the second endpoint of
+a range.
+
+The special bracket expression constructs C<[[:E<lt>:]]> and C<[[:E<gt>:]]> 
+match the null string at the beginning and end of a word respectively.
+(Note that neither is identical to Perl's `\b' atom.)
+
+=head2 Additional Atoms
+
+Since some sed implementations provide additional regular expression
+atoms (not defined in POSIX 1003.2), B<psed> is capable of translating
+the following backslash escapes:
+
+=over 4
+
+=item B<\E<lt>> This is the same as C<[[:E<gt>:]]>.
+
+=item B<\E<gt>> This is the same as C<[[:E<lt>:]]>.
+
+=item B<\w> This is an abbreviation for C<[[:alnum:]_]>.
+
+=item B<\W> This is an abbreviation for C<[^[:alnum:]_]>.
+
+=item B<\y> Match the empty string at a word boundary.
+
+=item B<\B> Match the empty string between any two either word or non-word characters.
+
+=back
+
+To enable this feature, the environment variable PSEDEXTBRE must be set
+to a string containing the requested characters, e.g.:
+C<PSEDEXTBRE='E<lt>E<gt>wW'>.
+
+=cut
+
+#####
+# bre2p - convert BRE to Perl RE
+#
+sub peek(\$$){
+    my( $pref, $ic ) = @_;
+    $ic < length($$pref)-1 ? substr( $$pref, $ic+1, 1 ) : '';
+}
+
+sub bre2p($$$){
+    my( $del, $pat, $fl ) = @_;
+    my $led = $del;
+    $led =~ tr/{([</})]>/;
+    $led = '' if $led eq $del;
+
+    $pat = substr( $pat, 1, length($pat) - 2 );
+    my $res = '';
+    my $bracklev = 0;
+    my $backref  = 0;
+    my $parlev = 0;
+    for( my $ic = 0; $ic < length( $pat ); $ic++ ){
+        my $c = substr( $pat, $ic, 1 );
+        if( $c eq '\\' ){
+	    ### backslash escapes
+            my $nc = peek($pat,$ic);
+            if( $nc eq '' ){
+                Warn( "`\\' cannot be last in pattern", $fl );
+                return undef();
+            }
+	    $ic++;
+            if( $nc eq $del ){ ## \<pattern del> => \<pattern del>
+                $res .= "\\$del";
+
+	    } elsif( $nc =~ /([[.*\\n])/ ){
+		## check for \-escaped magics and \n:
+		## \[ \. \* \\ \n stay as they are
+                $res .= '\\'.$nc;
+
+            } elsif( $nc eq '(' ){ ## \( => (
+                $parlev++;
+                $res .= '(';
+
+            } elsif( $nc eq ')' ){ ## \) => )
+                $parlev--;
+		$backref++;
+                if( $parlev < 0 ){
+                    Warn( "unmatched `\\)'", $fl );
+                    return undef();
+                }
+                $res .= ')';
+
+            } elsif( $nc eq '{' ){ ## repetition factor \{<i>[,[<j>]]\}
+                my $endpos = index( $pat, '\\}', $ic );
+                if( $endpos < 0 ){
+                    Warn( "unmatched `\\{'", $fl );
+                    return undef();
+                }
+                my $rep = substr( $pat, $ic+1, $endpos-($ic+1) );
+                $ic = $endpos + 1;
+
+  	        if( $res =~ /^\^?$/ ){
+		    $res .= "\\{$rep\}";
+                } elsif( $rep =~ /^(\d+)(,?)(\d*)?$/ ){
+                    my $min = $1;
+                    my $com = $2 || '';
+                    my $max = $3;
+                    if( length( $max ) ){
+                        if( $max < $min ){
+                            Warn( "maximum less than minimum in `\\{$rep\\}'",
+				  $fl );
+                            return undef();
+                        }
+                    } else {
+                        $max = '';
+                    }
+		    # simplify some
+		    if( $min == 0 && $max eq '1' ){
+			$res .= '?';
+		    } elsif( $min == 1 && "$com$max" eq ',' ){
+			$res .= '+';
+		    } elsif( $min == 0 && "$com$max" eq ',' ){
+			$res .= '*';
+		    } else {
+			$res .= "{$min$com$max}";
+		    }
+                } else {
+                    Warn( "invalid repeat clause `\\{$rep\\}'", $fl );
+                    return undef();
+                }
+
+            } elsif( $nc =~ /^[1-9]$/ ){
+		## \1 .. \9 => \1 .. \9, but check for a following digit
+		if( $nc > $backref ){
+                    Warn( "invalid backreference ($nc)", $fl );
+                    return undef();
+		}
+                $res .= "\\$nc";
+		if( peek($pat,$ic) =~ /[0-9]/ ){
+		    $res .= '(?:)';
+		}
+
+            } elsif( $useEXTBRE && ( $nc =~ /[$useEXTBRE]/ ) ){
+		## extensions - at most <>wWyB - not in POSIX
+                if(      $nc eq '<' ){ ## \< => \b(?=\w), be precise
+                    $res .= '\\b(?<=\\W)';
+                } elsif( $nc eq '>' ){ ## \> => \b(?=\W), be precise
+                    $res .= '\\b(?=\\W)';
+                } elsif( $nc eq 'y' ){ ## \y => \b
+                    $res .= '\\b';
+                } else {               ## \B, \w, \W remain the same
+                    $res .= "\\$nc";
+                } 
+	    } elsif( $nc eq $led ){
+		## \<closing bracketing-delimiter> - keep '\'
+		$res .= "\\$nc";
+
+            } else { ## \ <char> => <char> ("as if `\' were not present")
+                $res .= $nc;
+            }
+
+        } elsif( $c eq '.' ){ ## . => .
+            $res .= $c;
+
+	} elsif( $c eq '*' ){ ## * => * but \* if there's nothing preceding it
+	    if( $res =~ /^\^?$/ ){
+                $res .= '\\*';
+            } elsif( substr( $res, -1, 1 ) ne '*' ){
+		$res .= $c;
+	    }
+
+        } elsif( $c eq '[' ){
+	    ## parse []: [^...] [^]...] [-...]
+	    my $add = '[';
+	    if( peek($pat,$ic) eq '^' ){
+		$ic++;
+		$add .= '^';
+	    }
+	    my $nc = peek($pat,$ic);
+  	    if( $nc eq ']' || $nc eq '-' ){
+		$add .= $nc;
+                $ic++;
+	    }
+	    # check that [ is not trailing
+	    if( $ic >= length( $pat ) - 1 ){
+		Warn( "unmatched `['", $fl );
+		return undef();
+	    }
+	    # look for [:...:] and x-y
+	    my $rstr = substr( $pat, $ic+1 );
+	    if( $rstr =~ /^((?:\[:\(\w+|[><]\):\]|[^]-](?:-[^]])?)*)/ ){
+ 	        my $cnt = $1;
+		$ic += length( $cnt );
+		$cnt =~ s/([\\\$])/\\$1/g; # `\', `$' are magic in Perl []
+		# try some simplifications
+ 	        my $red = $cnt;
+		if( $red =~ s/0-9// ){
+		    $cnt = $red.'\d';
+		    if( $red =~ s/A-Z// && $red =~ s/a-z// && $red =~ s/_// ){
+			$cnt = $red.'\w';
+                    }
+		}
+		$add .= $cnt;
+
+		# POSIX 1003.2 has this (optional) for begin/end word
+		$add = '\\b(?=\\W)'  if $add eq '[[:<:]]';
+		$add = '\\b(?<=\\W)' if $add eq '[[:>:]]';
+
+	    }
+
+	    ## may have a trailing `-' before `]'
+	    if( $ic < length($pat) - 1 &&
+                substr( $pat, $ic+1 ) =~ /^(-?])/ ){
+		$ic += length( $1 );
+		$add .= $1;
+		# another simplification
+		$add =~ s/^\[(\^?)(\\[dw])]$/ $1 eq '^' ? uc($2) : $2 /e;
+		$res .= $add;
+	    } else {
+		Warn( "unmatched `['", $fl );
+		return undef();
+	    }
+
+        } elsif( $c eq $led ){ ## unescaped <closing bracketing-delimiter>
+            $res .= "\\$c";
+
+        } elsif( $c eq ']' ){ ## unmatched ] is not magic
+            $res .= ']';
+
+        } elsif( $c =~ /[|+?{}()]/ ){ ## not magic in BRE, but in Perl: \-quote
+            $res .= "\\$c";
+
+        } elsif( $c eq '^' ){ ## not magic unless 1st, but in Perl: \-quote
+            $res .= length( $res ) ? '\\^' : '^';
+
+        } elsif( $c eq '$' ){ ## not magic unless last, but in Perl: \-quote
+            $res .= $ic == length( $pat ) - 1 ? '$' : '\\$';
+
+        } else {
+            $res .= $c;
+        }
+    }
+
+    if( $parlev ){
+       Warn( "unmatched `\\('", $fl );
+       return undef();
+    }
+
+    # final cleanup: eliminate raw HTs
+    $res =~ s/\t/\\t/g;
+    return $del . $res . ( $led ? $led : $del );
+}
+
+
+#####
+# sub2p - convert sed substitution to Perl substitution
+#
+sub sub2p($$$){
+    my( $del, $subst, $fl ) = @_;
+    my $led = $del;
+    $led =~ tr/{([</})]>/;
+    $led = '' if $led eq $del;
+
+    $subst = substr( $subst, 1, length($subst) - 2 );
+    my $res = '';
+ 
+    for( my $ic = 0; $ic < length( $subst ); $ic++ ){
+        my $c = substr( $subst, $ic, 1 );
+        if( $c eq '\\' ){
+	    ### backslash escapes
+            my $nc = peek($subst,$ic);
+            if( $nc eq '' ){
+                Warn( "`\\' cannot be last in substitution", $fl );
+                return undef();
+            }
+	    $ic++;
+	    if( $nc =~ /[\\$del$led]/ ){ ## \ and delimiter
+		$res .= '\\' . $nc;
+            } elsif( $nc =~ /[1-9]/ ){ ## \1 - \9 => ${1} - ${9}
+                $res .= '${' . $nc . '}';
+	    } else { ## everything else (includes &): omit \
+		$res .= $nc;
+	    }
+        } elsif( $c eq '&' ){ ## & => $&
+            $res .= '$&';
+	} elsif( $c =~ /[\$\@$led]/ ){ ## magic in Perl's substitution string
+	    $res .= '\\' . $c;
+        } else {
+	    $res .= $c;
 	}
-	print BODY $_, "\n";
-    }
-    $indent += $indmod;
-    $indmod = 0;
-    if ($redo) {
-	$_ = $redo;
-	$redo = '';
-	redo LINE;
-    }
-}
-if ($lastlinewaslabel++) {
-    $indent += 4;
-    print BODY &tab, ";\n";
-    $indent -= 4;
-}
-
-if ($appendseen || $tseen || !$assumen) {
-    $printit++ if $dseen || (!$assumen && !$assumep);
-    print BODY &q(<<'EOT');
-:	#ifdef SAWNEXT
-:	}
-:	continue {
-:	#endif
-:	#ifdef PRINTIT
-:	#ifdef DSEEN
-:	#ifdef ASSUMEP
-:	    print if $printit++;
-:	#else
-:	    if ($printit)
-:		{ print; }
-:	    else
-:		{ $printit++ unless $nflag; }
-:	#endif
-:	#else
-:	    print if $printit;
-:	#endif
-:	#else
-:	    print;
-:	#endif
-:	#ifdef TSEEN
-:	    $tflag = 0;
-:	#endif
-:	#ifdef APPENDSEEN
-:	    if ($atext) { chop $atext; print $atext; $atext = ''; }
-:	#endif
-EOT
-}
-
-print BODY &q(<<'EOT');
-:	}
-EOT
-
-unless ($debug) {
-
-    print &q(<<"EOT");
-:	$startperl
-:	eval 'exec $perlpath -S \$0 \${1+"\$@"}'
-:		if \$running_under_some_shell;
-:	
-EOT
-    print"$opens\n" if $opens;
-    seek(BODY, 0, 0) || die "Can't rewind temp file: $!\n";
-    while (<BODY>) {
-	/^[ \t]*$/ && next;
-	/^#ifdef (\w+)/ && ((${lc $1} || &skip), next);
-	/^#else/ && (&skip, next);
-	/^#endif/ && next;
-	s/^<><>//;
-	print;
-    }
-}
-
-&Cleanup;
-exit;
-
-sub Cleanup {
-    unlink "/tmp/sperl$$";
-}
-sub Die {
-    &Cleanup;
-    die $_[0];
-}
-sub tab {
-    "\t" x ($indent / 8) . ' ' x ($indent % 8);
-}
-sub make_filehandle {
-    local($_) = $_[0];
-    local($fname) = $_;
-    if (!$seen{$fname}) {
-	$_ = "FH_" . $_ if /^\d/;
-	s/[^a-zA-Z0-9]/_/g;
-	s/^_*//;
-	$_ = "\U$_";
-	if ($fhseen{$_}) {
-	    for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
-	    $_ .= $tmp;
+    }
+
+    # final cleanup: eliminate raw HTs
+    $res =~ s/\t/\\t/g;
+    return ( $led ? $del : $led ) . $res . ( $led ? $led : $del );
+}
+
+
+sub Parse(){
+    my $error = 0;
+    my( $pdef, $pfil, $plin );
+    for( my $icom = 0; $icom < @Commands; $icom++ ){
+	my $cmd = $Commands[$icom];
+	print "Parse:$cmd:\n" if $useDEBUG;
+	$cmd =~ s/^\s+//;
+	next unless length( $cmd );
+	my $scom = $icom;
+	if( exists( $Defined{$icom} ) ){
+	    $pdef = $Defined{$icom};
+	    if( $pdef =~ /^ #(\d+)/ ){
+		$pfil = 'expression #';
+		$plin = $1;
+	    } else {
+		$pfil = "$pdef l.";
+		$plin = 1;
+            }
+        } else {
+	    $plin++;
+        }
+        my $fl = "$pfil$plin";
+
+        # insert command as comment in gnerated code
+	#
+	$Code .= "# $cmd\n" if $doGenerate;
+
+	# The Address(es)
+	#
+	my( $negated, $naddr, $addr1, $addr2 );
+	$naddr = 0;
+	if(      $cmd =~ s/^(\d+)\s*// ){
+	    $addr1 = "$1"; $naddr++;
+	} elsif( $cmd =~ s/^\$\s*// ){
+	    $addr1 = 'eofARGV()'; $naddr++;
+	} elsif( $cmd =~ s{^(/)}{} || $cmd =~ s{^\\(.)}{} ){
+	    my $del = $1;
+	    my $regex = stripRegex( $del, \$cmd );
+	    if( defined( $regex ) ){
+		$addr1 = 'm '.bre2p( $del, $regex, $fl ).'s';
+		$naddr++;
+	    } else {
+		Warn( "malformed regex, 1st address", $fl );
+		$error++;
+		next;
+	    }
+        }
+        if( defined( $addr1 ) && $cmd =~ s/,\s*// ){
+ 	    if(      $cmd =~ s/^(\d+)\s*// ){
+	        $addr2 = "$1"; $naddr++;
+	    } elsif( $cmd =~ s/^\$\s*// ){
+	        $addr2 = 'eofARGV()'; $naddr++;
+	    } elsif( $cmd =~ s{^(/)}{} || $cmd =~ s{^\\(.)}{} ){
+		my $del = $1;
+	        my $regex = stripRegex( $del, \$cmd );
+		if( defined( $regex ) ){
+		    $addr2 = 'm '. bre2p( $del, $regex, $fl ).'s';
+		    $naddr++;
+		} else {
+		    Warn( "malformed regex, 2nd address", $fl );
+		    $error++;
+		    next;
+		}
+            } else {
+		Warn( "invalid address after `,'", $fl );
+		$error++;
+		next;
+            }
+        }
+
+        # address modifier `!'
+        #
+        $negated = $cmd =~ s/^!\s*//;
+	if( defined( $addr1 ) ){
+	    print "Parse: addr1=$addr1" if $useDEBUG;
+	    if( defined( $addr2 ) ){
+		print ", addr2=$addr2 " if $useDEBUG;
+		# both numeric and addr1 > addr2 => eliminate addr2
+		undef( $addr2 ) if $addr1 =~ /^\d+$/ &&
+                                   $addr2 =~ /^\d+$/ && $addr1 > $addr2;
+	    }
 	}
-	$fhseen{$_} = 1;
-	$opens .= &q(<<"EOT");
-:	open($_, '>$fname') || die "Can't create $fname: \$!";
-EOT
-	$seen{$fname} = $_;
-    }
-    $seen{$fname};
-}
-
-sub make_label {
-    local($label) = @_;
-    $label =~ s/[^a-zA-Z0-9]/_/g;
-    if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
-    $label = substr($label,0,8);
-
-    # Could be a reserved word, so capitalize it.
-    substr($label,0,1) =~ y/a-z/A-Z/
-      if $label =~ /^[a-z]/;
-
-    $label;
-}
-
-sub transmogrify {
-    {	# case
-	if (/^d/) {
-	    $dseen++;
-	    chop($_ = &q(<<'EOT'));
-:	<<--#ifdef PRINTIT
-:	$printit = 0;
-:	<<--#endif
-:	next LINE;
-EOT
-	    $sawnext++;
+	print 'negated' if $useDEBUG && $negated;
+	print " command:$cmd\n" if $useDEBUG;
+
+	# The Command
+	#
+        if( $cmd !~ s/^([:#={}abcdDgGhHilnNpPqrstwxy])\s*// ){
+	    my $h = substr( $cmd, 0, 1 );
+ 	    Warn( "unknown command `$h'", $fl );
+	    $error++;
 	    next;
 	}
+        my $key = $1;
 
-	if (/^n/) {
-	    chop($_ = &q(<<'EOT'));
-:	<<--#ifdef PRINTIT
-:	<<--#ifdef DSEEN
-:	<<--#ifdef ASSUMEP
-:	print if $printit++;
-:	<<--#else
-:	if ($printit)
-:	    { print; }
-:	else
-:	    { $printit++ unless $nflag; }
-:	<<--#endif
-:	<<--#else
-:	print if $printit;
-:	<<--#endif
-:	<<--#else
-:	print;
-:	<<--#endif
-:	<<--#ifdef APPENDSEEN
-:	if ($atext) {chop $atext; print $atext; $atext = '';}
-:	<<--#endif
-:	$_ = <>;
-:	chop;
-:	<<--#ifdef TSEEN
-:	$tflag = 0;
-:	<<--#endif
-EOT
+	my $tabref = $ComTab{$key};
+	$GenKey{$key} = 1;
+	if( $naddr > $tabref->[0] ){
+	    Warn( "excess address(es)", $fl );
+	    $error++;
 	    next;
 	}
 
-	if (/^a/) {
-	    $appendseen++;
-	    $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
-	    $lastline = 0;
-	    while (<>) {
-		s/^[ \t]*//;
-		s/^[\\]//;
-		unless (s|\\$||) { $lastline = 1;}
-		s/^([ \t]*\n)/<><>$1/;
-		$command .= $_;
-		$command .= '<<--';
-		last if $lastline;
+	my $arg = '';
+	if(      $tabref->[1] eq 'str' ){
+	    # take remainder - don't care if it is empty
+	    $arg = $cmd;
+            $cmd = '';
+
+	} elsif( $tabref->[1] eq 'txt' ){
+	    # multi-line text
+	    my $goon = $cmd =~ /(.*)\\$/;
+	    if( length( $1 ) ){
+		Warn( "extra characters after command ($cmd)", $fl );
+		$error++;
 	    }
-	    $_ = $command . "End_Of_Text";
-	    last;
-	}
-
-	if (/^[ic]/) {
-	    if (/^c/) { $change = 1; }
-	    $addr1 = 1 if $addr1 eq '';
-	    $addr1 = '$iter = (' . $addr1 . ')';
-	    $command = $space .
-	      "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
-	    $lastline = 0;
-	    while (<>) {
-		s/^[ \t]*//;
-		s/^[\\]//;
-		unless (s/\\$//) { $lastline = 1;}
-		s/'/\\'/g;
-		s/^([ \t]*\n)/<><>$1/;
-		$command .= $_;
-		$command .= '<<--';
-		last if $lastline;
-	    }
-	    $_ = $command . "End_Of_Text";
-	    if ($change) {
-		$dseen++;
-		$change = "$_\n";
-		chop($_ = &q(<<"EOT"));
-:	<<--#ifdef PRINTIT
-:	$space\$printit = 0;
-:	<<--#endif
-:	${space}next LINE;
-EOT
-		$sawnext++;
+	    while( $goon ){
+		$icom++;
+		if( $icom > $#Commands ){
+		    Warn( "unexpected end of script", $fl );
+		    $error++;
+		    last;
+		}
+		$cmd = $Commands[$icom];
+		$Code .= "# $cmd\n" if $doGenerate;
+		$goon = $cmd =~ s/\\$//;
+		$cmd =~ s/\\(.)/$1/g;
+		$arg .= "\n" if length( $arg );
+		$arg .= $cmd;
 	    }
-	    last;
-	}
+	    $arg .= "\n" if length( $arg );
+	    $cmd = '';
 
-	if (/^s/) {
-	    $delim = substr($_,1,1);
-	    $len = length($_);
-	    $repl = $end = 0;
-	    $inbracket = 0;
-	    for ($i = 2; $i < $len; $i++) {
-		$c = substr($_,$i,1);
-		if ($c eq $delim) {
-		    if ($inbracket) {
-			substr($_, $i, 0) = '\\';
-			$i++;
-			$len++;
-		    }
-		    else {
-			if ($repl) {
-			    $end = $i;
-			    last;
-			} else {
-			    $repl = $i;
-			}
-		    }
+	} elsif( $tabref->[1] eq 'sub' ){
+	    # s///
+	    if( ! length( $cmd ) ){
+		Warn( "`s' command requires argument", $fl );
+		$error++;
+		next;
+	    }
+	    if( $cmd =~ s{^([^\\\n])}{} ){
+		my $del = $1;
+		my $regex = stripRegex( $del, \$cmd );
+		if( ! defined( $regex ) ){
+		    Warn( "malformed regular expression", $fl );
+		    $error++;
+		    next;
 		}
-		elsif ($c eq '\\') {
-		    $i++;
-		    if ($i >= $len) {
-			$_ .= 'n';
-			$_ .= <>;
-			$len = length($_);
-			$_ = substr($_,0,--$len);
-		    }
-		    elsif (substr($_,$i,1) =~ /^[n]$/) {
-			;
+		$regex = bre2p( $del, $regex, $fl );
+
+		# a trailing \ indicates embedded NL (in replacement string)
+		while( $cmd =~ s/(?<!\\)\\$/\n/ ){
+		    $icom++;
+		    if( $icom > $#Commands ){
+			Warn( "unexpected end of script", $fl );
+			$error++;
+			last;
 		    }
-		    elsif (!$repl &&
-		      substr($_,$i,1) =~ /^[(){}\w]$/) {
-			$i--;
-			$len--;
-			substr($_, $i, 1) = '';
-		    }
-		    elsif (!$repl &&
-		      substr($_,$i,1) =~ /^[<>]$/) {
-			substr($_,$i,1) = 'b';
-		    }
-		    elsif ($repl && substr($_,$i,1) =~ /^\d$/) {
-			substr($_,$i-1,1) = '$';
-		    }
-		}
-		elsif ($c eq '@') {
-		    substr($_, $i, 0) = '\\';
-		    $i++;
-		    $len++;
-		}
-		elsif ($c eq '&' && $repl) {
-		    substr($_, $i, 0) = '$';
-		    $i++;
-		    $len++;
-		}
-		elsif ($c eq '$' && $repl) {
-		    substr($_, $i, 0) = '\\';
-		    $i++;
-		    $len++;
-		}
-		elsif ($c eq '[' && !$repl) {
-		    $i++ if substr($_,$i,1) eq '^';
-		    $i++ if substr($_,$i,1) eq ']';
-		    $inbracket = 1;
-		}
-		elsif ($c eq ']') {
-		    $inbracket = 0;
+		    $cmd .= $Commands[$icom];
+	            $Code .= "# $Commands[$icom]\n" if $doGenerate;
 		}
-		elsif ($c eq "\t") {
-		    substr($_, $i, 1) = '\\t';
-		    $i++;
-		    $len++;
-		}
-		elsif (!$repl && index("()+",$c) >= 0) {
-		    substr($_, $i, 0) = '\\';
-		    $i++;
-		    $len++;
-		}
-	    }
-	    &Die("Malformed substitution at line $.\n")
-	      unless $end;
-	    $pat = substr($_, 0, $repl + 1);
-	    $repl = substr($_, $repl+1, $end-$repl-1);
-	    $end = substr($_, $end + 1, 1000);
-	    &simplify($pat);
-	    $subst = "$pat$repl$delim";
-	    $cmd = '';
-	    while ($end) {
-		if ($end =~ s/^g//) {
-		    $subst .= 'g';
+
+		my $subst = stripRegex( $del, \$cmd );
+		if( ! defined( $regex ) ){
+		    Warn( "malformed substitution expression", $fl );
+		    $error++;
 		    next;
 		}
-		if ($end =~ s/^p//) {
-		    $cmd .= ' && (print)';
+		$subst = sub2p( $del, $subst, $fl );
+
+		# parse s/// modifier: g|p|0-9|w <file>
+		my( $global, $nmatch, $print, $write ) =
+		  ( '',      '',      0,      undef );
+		while( $cmd =~ s/^([gp0-9])// ){
+		    $1 eq 'g' ? ( $global = 'g' ) :
+  		    $1 eq 'p' ? ( $print  = $1  ) : ( $nmatch .= $1 );
+                }
+		$write = $1 if $cmd =~ s/w\s*(.*)$//;
+  	        ### $nmatch =~ s/^(\d)\1*$/$1/; ### may be dangerous?
+		if( $global && length( $nmatch ) || length( $nmatch ) > 1 ){
+		    Warn( "conflicting flags `$global$nmatch'", $fl );
+		    $error++;
 		    next;
 		}
-		if ($end =~ s/^w[ \t]*//) {
-		    $fh = &make_filehandle($end);
-		    $cmd .= " && (print $fh \$_)";
-		    $end = '';
+
+		$arg = makes( $regex, $subst,
+			      $write, $global, $print, $nmatch, $fl );
+		if( ! defined( $arg ) ){
+		    $error++;
 		    next;
 		}
-		&Die("Unrecognized substitution command".
-		  "($end) at line $.\n");
+
+            } else {
+		Warn( "improper delimiter in s command", $fl );
+		$error++;
+		next;
+            }
+
+	} elsif( $tabref->[1] eq 'tra' ){
+	    # y///
+	    # a trailing \ indicates embedded newline
+	    while( $cmd =~ s/(?<!\\)\\$/\n/ ){
+		$icom++;
+		if( $icom > $#Commands ){
+		    Warn( "unexpected end of script", $fl );
+		    $error++;
+		    last;
+		}
+		$cmd .= $Commands[$icom];
+                $Code .= "# $Commands[$icom]\n" if $doGenerate;
+	    }
+	    if( ! length( $cmd ) ){
+		Warn( "`y' command requires argument", $fl );
+		$error++;
+		next;
+	    }
+	    my $d = substr( $cmd, 0, 1 ); $cmd = substr( $cmd, 1 );
+	    if( $d eq '\\' ){
+		Warn( "`\\' not valid as delimiter in `y' command", $fl );
+		$error++;
+		next;
+	    }
+	    my $fr = stripTrans( $d, \$cmd );
+	    if( ! defined( $fr ) || ! length( $cmd ) ){
+		Warn( "malformed `y' command argument", $fl );
+		$error++;
+		next;
+	    }
+	    my $to = stripTrans( $d, \$cmd );
+	    if( ! defined( $to ) ){
+		Warn( "malformed `y' command argument", $fl );
+		$error++;
+		next;
+	    }
+	    if( length($fr) != length($to) ){
+		Warn( "string lengths in `y' command differ", $fl );
+		$error++;
+		next;
+	    }
+	    if( ! defined( $arg = makey( $fr, $to, $fl ) ) ){
+		$error++;
+		next;
 	    }
-	    chop ($_ = &q(<<"EOT"));
-:	<<--#ifdef TSEEN
-:	$subst && \$tflag++$cmd;
-:	<<--#else
-:	$subst$cmd;
-:	<<--#endif
-EOT
-	    next;
-	}
 
-	if (/^p/) {
-	    $_ = 'print;';
-	    next;
 	}
 
-	if (/^w/) {
-	    s/^w[ \t]*//;
-	    $fh = &make_filehandle($_);
-	    $_ = "print $fh \$_;";
-	    next;
+	# $cmd must be now empty - exception is {
+	if( $cmd !~ /^\s*$/ ){
+	    if( $key eq '{' ){
+		# dirty hack to process command on '{' line
+		$Commands[$icom--] = $cmd;
+	    } else {
+		Warn( "extra characters after command ($cmd)", $fl );
+		$error++;
+		next;
+	    }
 	}
 
-	if (/^r/) {
-	    $appendseen++;
-	    s/^r[ \t]*//;
-	    $file = $_;
-	    $_ = "\$atext .= `cat $file 2>/dev/null`;";
-	    next;
+	# Make Code
+        #
+	if( &{$tabref->[2]}( $addr1, $addr2, $negated,
+                             $tabref->[3], $arg, $fl ) ){
+	    $error++;
 	}
+    }
 
-	if (/^P/) {
-	    $_ = 'print $1 if /^(.*)/;';
-	    next;
-	}
+    while( @BlockStack ){
+	my $bl = pop( @BlockStack );
+	Warn( "start of unterminated `{'", $bl );
+        $error++;
+    }
 
-	if (/^D/) {
-	    chop($_ = &q(<<'EOT'));
-:	s/^.*\n?//;
-:	redo LINE if $_;
-:	next LINE;
-EOT
-	    $sawnext++;
-	    next;
+    for my $lab ( keys( %Label ) ){
+	if( ! exists( $Label{$lab}{defined} ) ){
+	    for my $used ( @{$Label{$lab}{used}} ){
+ 	        Warn( "undefined label `$lab'", $used );
+	        $error++;
+	    }
 	}
+    }
 
-	if (/^N/) {
-	    chop($_ = &q(<<'EOT'));
-:	$_ .= "\n";
-:	$len1 = length;
-:	$_ .= <>;
-:	chop if $len1 < length;
-:	<<--#ifdef TSEEN
-:	$tflag = 0;
-:	<<--#endif
-EOT
-	    next;
-	}
+    exit( 1 ) if $error;
+}
 
-	if (/^h/) {
-	    $_ = '$hold = $_;';
-	    next;
-	}
 
-	if (/^H/) {
-	    $_ = '$hold .= "\n", $hold .= $_;';
-	    next;
-	}
+##############
+#### MAIN ####
+##############
 
-	if (/^g/) {
-	    $_ = '$_ = $hold;';
-	    next;
-	}
+sub usage(){
+    print STDERR "Usage: sed [-an] command [file...]\n";
+    print STDERR "           [-an] [-e command] [-f script-file] [file...]\n";
+}
 
-	if (/^G/) {
-	    $_ = '$_ .= "\n", $_ .= $hold;';
-	    next;
+###################
+# Here we go again...
+#
+my $expr = 0;
+while( @ARGV && $ARGV[0] =~ /^-(.)(.*)$/ ){
+    my $opt = $1;
+    my $arg = $2;
+    shift( @ARGV );
+    if(      $opt eq 'e' ){
+        if( length( $arg ) ){
+	    push( @Commands, split( "\n", $arg ) );
+        } elsif( @ARGV ){
+	    push( @Commands, shift( @ARGV ) ); 
+        } else {
+            Warn( "option -e requires an argument" );
+            usage();
+            exit( 1 );
+        }
+	$expr++;
+        $Defined{$#Commands} = " #$expr";
+	next;
+    }
+    if( $opt eq 'f' ){
+        my $path;
+        if( length( $arg ) ){
+	    $path = $arg;
+        } elsif( @ARGV ){
+	    $path = shift( @ARGV ); 
+        } else {
+            Warn( "option -f requires an argument" );
+            usage();
+            exit( 1 );
+        }
+	my $fst = $#Commands + 1;
+        open( SCRIPT, "<$path" ) || die( "$0: $path: could not open ($!)\n" );
+        my $cmd;
+        while( defined( $cmd = <SCRIPT> ) ){
+            chomp( $cmd );
+            push( @Commands, $cmd );
+        }
+        close( SCRIPT );
+	if( $#Commands >= $fst ){
+	    $Defined{$fst} = "$path";
 	}
+	next;
+    }
+    if( $opt eq '-' && $arg eq '' ){
+	last;
+    }
+    if( $opt eq 'h' || $opt eq '?' ){
+        usage();
+        exit( 0 );
+    }
+    if( $opt eq 'n' ){
+	$doAutoPrint = 0;
+    } elsif( $opt eq 'a' ){
+	$doOpenWrite = 0;
+    } else {
+        Warn( "illegal option `$opt'" );
+        usage();
+        exit( 1 );
+    }
+    if( length( $arg ) ){
+	unshift( @ARGV, "-$arg" );
+    }
+}
 
-	if (/^x/) {
-	    $_ = '($_, $hold) = ($hold, $_);';
-	    next;
-	}
+# A singleton command may be the 1st argument when there are no options.
+#
+if( @Commands == 0 ){
+    if( @ARGV == 0 ){
+        Warn( "no script command given" );
+        usage();
+        exit( 1 );
+    }
+    push( @Commands, split( "\n", shift( @ARGV ) ) );
+    $Defined{0} = ' #1';
+}
 
-	if (/^b$/) {
-	    $_ = 'next LINE;';
-	    $sawnext++;
-	    next;
-	}
+print STDERR "Files: @ARGV\n" if $useDEBUG;
 
-	if (/^b/) {
-	    s/^b[ \t]*//;
-	    $lab = &make_label($_);
-	    if ($lab eq $toplabel) {
-		$_ = 'redo LINE;';
-	    } else {
-		$_ = "goto $lab;";
-	    }
-	    next;
-	}
+# generate leading code
+#
+$Func = <<'[TheEnd]';
 
-	if (/^t$/) {
-	    $_ = 'next LINE if $tflag;';
-	    $sawnext++;
-	    $tseen++;
-	    next;
-	}
+# openARGV: open 1st input file
+#
+sub openARGV(){
+    unshift( @ARGV, '-' ) unless @ARGV;
+    my $file = shift( @ARGV );
+    open( ARG, "<$file" )
+    || die( "$0: can't open $file for reading ($!)\n" );
+    $isEOF = 0;
+}
 
-	if (/^t/) {
-	    s/^t[ \t]*//;
-	    $lab = &make_label($_);
-	    $_ = q/if ($tflag) {$tflag = 0; /;
-	    if ($lab eq $toplabel) {
-		$_ .= 'redo LINE;}';
-	    } else {
-		$_ .= "goto $lab;}";
-	    }
-	    $tseen++;
-	    next;
-	}
+# getsARGV: Read another input line into argument (default: $_).
+#           Move on to next input file, and reset EOF flag $isEOF.
+sub getsARGV(;\$){
+    my $argref = @_ ? shift() : \$_; 
+    while( $isEOF || ! defined( $$argref = <ARG> ) ){
+	close( ARG );
+	return 0 unless @ARGV;
+	my $file = shift( @ARGV );
+	open( ARG, "<$file" )
+	|| die( "$0: can't open $file for reading ($!)\n" );
+	$isEOF = 0;
+    }
+    1;
+}
 
-	if (/^y/) {
-	    s/abcdefghijklmnopqrstuvwxyz/a-z/g;
-	    s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
-	    s/abcdef/a-f/g;
-	    s/ABCDEF/A-F/g;
-	    s/0123456789/0-9/g;
-	    s/01234567/0-7/g;
-	    $_ .= ';';
-	}
+# eofARGV: end-of-file test
+#
+sub eofARGV(){
+    return @ARGV == 0 && ( $isEOF = eof( ARG ) );
+}
 
-	if (/^=/) {
-	    $_ = 'print $.;';
-	    next;
+# makeHandle: Generates another file handle for some file (given by its path)
+#             to be written due to a w command or an s command's w flag.
+sub makeHandle($){
+    my( $path ) = @_;
+    my $handle;
+    if( ! exists( $wFiles{$path} ) || $wFiles{$path} eq '' ){
+        $handle = $wFiles{$path} = gensym();
+	if( $doOpenWrite ){
+	    if( ! open( $handle, ">$path" ) ){
+		die( "$0: can't open $path for writing: ($!)\n" );
+	    }
 	}
+    } else {
+        $handle = $wFiles{$path};
+    }
+    return $handle;
+}
 
-	if (/^q/) {
-	    chop($_ = &q(<<'EOT'));
-:	close(ARGV);
-:	@ARGV = ();
-:	next LINE;
-EOT
-	    $sawnext++;
-	    next;
-	}
-    } continue {
-	if ($space) {
-	    s/^/$space/;
-	    s/(\n)(.)/$1$space$2/g;
+# printQ: Print queued output which is either a string or a reference
+#         to a pathname.
+sub printQ(){
+    for my $q ( @Q ){
+	if( ref( $q ) ){
+            # flush open w files so that reading this file gets it all
+	    if( exists( $wFiles{$$q} ) && $wFiles{$$q} ne '' ){
+		open( $wFiles{$$q}, ">>$$q" );
+	    }
+            # copy file to stdout: slow, but safe
+	    if( open( RF, "<$$q" ) ){
+		while( defined( my $line = <RF> ) ){
+		    print $line;
+		}
+		close( RF );
+	    }
+	} else {
+	    print $q;
 	}
-	last;
     }
-    $_;
+    undef( @Q );
 }
 
-sub fetchpat {
-    local($outer) = @_;
-    local($addr) = $outer;
-    local($inbracket);
-    local($prefix,$delim,$ch);
+[TheEnd]
 
-    # Process pattern one potential delimiter at a time.
+# generate the sed loop
+#
+$Code .= <<'[TheEnd]';
+sub openARGV();
+sub getsARGV(;\$);
+sub eofARGV();
+sub printQ();
 
-    DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
-	$prefix = $1;
-	$delim = $2;
-	if ($delim eq '\\') {
-	    s/(.)//;
-	    $ch = $1;
-	    $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
-	    $ch = 'b' if $ch =~ /^[<>]$/;
-	    $delim .= $ch;
-	}
-	elsif ($delim eq '[') {
-	    $inbracket = 1;
-	    s/^\^// && ($delim .= '^');
-	    s/^]// && ($delim .= ']');
-	}
-	elsif ($delim eq ']') {
-	    $inbracket = 0;
-	}
-	elsif ($inbracket || $delim ne $outer) {
-	    $delim = '\\' . $delim;
+# Run: the sed loop reading input and applying the script
+#
+sub Run(){
+    my( $h, $icnt, $s, $n );
+    # hack (not unbreakable :-/) to avoid // matching an empty string
+    my $z = "\000"; $z =~ /$z/;
+    # Initialize.
+    openARGV();
+    $Hold    = '';
+    $CondReg = 0;
+    $doPrint = $doAutoPrint;
+CYCLE:
+    while( getsARGV() ){
+	chomp();
+	$CondReg = 0;   # cleared on t
+BOS:;
+[TheEnd]
+
+    # parse - avoid opening files when doing s2p
+    #
+    ( $svOpenWrite, $doOpenWrite ) = (  $doOpenWrite, $svOpenWrite )
+      if $doGenerate;
+    Parse();
+    ( $svOpenWrite, $doOpenWrite ) = (  $doOpenWrite, $svOpenWrite )
+      if $doGenerate;
+
+    # append trailing code
+    #
+    $Code .= <<'[TheEnd]';
+EOS:    if( $doPrint ){
+            print $_, "\n";
+        } else {
+	    $doPrint = $doAutoPrint;
 	}
-	$addr .= $prefix;
-	$addr .= $delim;
-	if ($delim eq $outer && !$inbracket) {
-	    last DELIM;
+        printQ() if @Q;
+    }
+
+    exit( 0 );
+}
+[TheEnd]
+
+
+# append optional functions, prepend prototypes
+#
+my $Proto = "# prototypes\n";
+if( $GenKey{'l'} ){
+    $Proto .= "sub _l();\n";
+    $Func .= <<'[TheEnd]';
+# _l: l command processing
+#
+sub _l(){        
+    my $h = $_;
+    my $mcpl = 70;
+    # transform non printing chars into escape notation
+    $h =~ s/\\/\\\\/g;
+    if( $h =~ /[^[:print:]]/ ){
+	$h =~ s/\a/\\a/g;
+	$h =~ s/\f/\\f/g;
+	$h =~ s/\n/\\n/g;
+	$h =~ s/\t/\\t/g;
+	$h =~ s/\r/\\r/g;
+	$h =~ s/\e/\\e/g;
+        $h =~ s/([^[:print:]])/sprintf("\\%03o", ord($1))/ge;
+    }
+    # split into lines of length $mcpl
+    while( length( $h ) > $mcpl ){
+	my $l = substr( $h, 0, $mcpl-1 );
+	$h = substr( $h, $mcpl );
+	# remove incomplete \-escape from end of line
+	if( $l =~ s/(?<!\\)(\\[0-7]{0,2})$// ){
+	    $h = $1 . $h;
 	}
+	print $l, "\\\n";
     }
-    $addr =~ s/\t/\\t/g;
-    $addr =~ s/\@/\\@/g;
-    &simplify($addr);
-    $addr;
+    print "$h\$\n";
 }
 
-sub q {
-    local($string) = @_;
-    local($*) = 1;
-    $string =~ s/^:\t?//g;
-    $string;
+[TheEnd]
 }
 
-sub simplify {
-    $_[0] =~ s/_a-za-z0-9/\\w/ig;
-    $_[0] =~ s/a-z_a-z0-9/\\w/ig;
-    $_[0] =~ s/a-za-z_0-9/\\w/ig;
-    $_[0] =~ s/a-za-z0-9_/\\w/ig;
-    $_[0] =~ s/_0-9a-za-z/\\w/ig;
-    $_[0] =~ s/0-9_a-za-z/\\w/ig;
-    $_[0] =~ s/0-9a-z_a-z/\\w/ig;
-    $_[0] =~ s/0-9a-za-z_/\\w/ig;
-    $_[0] =~ s/\[\\w\]/\\w/g;
-    $_[0] =~ s/\[^\\w\]/\\W/g;
-    $_[0] =~ s/\[0-9\]/\\d/g;
-    $_[0] =~ s/\[^0-9\]/\\D/g;
-    $_[0] =~ s/\\d\\d\*/\\d+/g;
-    $_[0] =~ s/\\D\\D\*/\\D+/g;
-    $_[0] =~ s/\\w\\w\*/\\w+/g;
-    $_[0] =~ s/\\t\\t\*/\\t+/g;
-    $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
-    $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
+if( $GenKey{'r'} ){
+    $Proto .= "sub _r(\$);\n";
+    $Func .= <<'[TheEnd]';
+# _r: r command processing: Save a reference to the pathname.
+#
+sub _r($){
+    my $path = shift();
+    push( @Q, \$path );
 }
 
-sub skip {
-    local($level) = 0;
+[TheEnd]
+}
+
+if( $GenKey{'t'} ){
+    $Proto .= "sub _t();\n";
+    $Func .= <<'[TheEnd]';
+# _t: t command - condition register test/reset
+#
+sub _t(){
+    my $res = $CondReg;
+    $CondReg = 0;
+    $res;
+}
 
-    while(<BODY>) {
-	/^#ifdef/ && $level++;
-	/^#else/  && !$level && return;
-	/^#endif/ && !$level-- && return;
+[TheEnd]
+}
+
+if( $GenKey{'w'} ){
+    $Proto .= "sub _w(\$);\n";
+    $Func .= <<'[TheEnd]';
+# _w: w command and s command's w flag - write to file 
+#
+sub _w($){
+    my $path   = shift();
+    my $handle = $wFiles{$path};
+    if( ! $doOpenWrite && ! defined( fileno( $handle ) ) ){
+	open( $handle, ">$path" )
+	|| die( "$0: $path: cannot open ($!)\n" );
     }
+    print $handle $_, "\n";
+}
+
+[TheEnd]
+}
+
+$Code = $Proto . $Code;
+
+# magic "#n" - same as -n option
+#
+$doAutoPrint = 0 if substr( $Commands[0], 0, 2 ) eq '#n';
 
-    die "Unterminated `#ifdef' conditional\n";
+# eval code - check for errors
+#
+print "Code:\n$Code$Func" if $useDEBUG;
+eval $Code . $Func;
+if( $@ ){
+    print "Code:\n$Code$Func";
+    die( "$0: internal error - generated incorrect Perl code: $@\n" );
+}
+
+if( $doGenerate ){
+
+    # write full Perl program
+    #
+ 
+    # bang line, declarations, prototypes
+    print <<TheEnd;
+#!$perlpath -w
+eval 'exec $perlpath -S \$0 \${1+"\$@"}'
+  if 0;
+\$0 =~ s/^.*?(\\w+)\[\\.\\w+\]*\$/\$1/;
+
+use strict;
+use Symbol;
+use vars qw{ \$isEOF \$Hold \%wFiles \@Q \$CondReg
+	     \$doAutoPrint \$doOpenWrite \$doPrint };
+\$doAutoPrint = $doAutoPrint;
+\$doOpenWrite = $doOpenWrite;
+TheEnd
+
+    my $wf = "'" . join( "', '",  keys( %wFiles ) ) . "'";
+    if( $wf ne "''" ){
+	print <<TheEnd;
+sub makeHandle(\$);
+for my \$p ( $wf ){
+   exit( 1 ) unless makeHandle( \$p );
 }
+TheEnd
+   }
+
+   print $Code;
+   print "Run();\n";
+   print $Func;
+   exit( 0 );
+
+} else {
+
+    # execute: make handles (and optionally open) all w files; run!
+    for my $p ( keys( %wFiles ) ){
+        exit( 1 ) unless makeHandle( $p );
+    }
+    Run();
+}
+
+
+=head1 ENVIRONMENT
+
+The environment variable C<PSEDEXTBRE> may be set to extend BREs.
+See L<"Additional Atoms">.
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item ambiguos translation for character `%s' in `y' command
+
+The indicated character appears twice, with different translations.
+
+=item `[' cannot be last in pattern
+
+A `[' in a BRE indicates the beginning of a I<bracket expression>.
+
+=item `\' cannot be last in pattern
+
+A `\' in a BRE is used to make the subsequent character literal.
+
+=item `\' cannot be last in substitution
+
+A `\' in a subsitution string is used to make the subsequent character literal.
+
+=item conflicting flags `%s'
+
+In an B<s> command, either the `g' flag and an n-th occurrence flag, or
+multiple n-th occurrence flags are specified. Note that only the digits
+`1' through `9' are permitted.
+
+=item duplicate label %s (first defined at %s)
+
+=item excess address(es)
+
+The command has more than the permitted number of addresses.
+
+=item extra characters after command (%s)
+
+=item illegal option `%s'
+
+=item improper delimiter in s command
+
+The BRE and substitution may not be delimited with `\' or newline.
+
+=item invalid address after `,'
+
+=item invalid backreference (%s)
+
+The specified backreference number exceeds the number of backreferences
+in the BRE.
+
+=item invalid repeat clause `\{%s\}'
+
+The repeat clause does not contain a valid integer value, or pair of
+values.
+
+=item malformed regex, 1st address
+
+=item malformed regex, 2nd address
+
+=item malformed regular expression
+
+=item malformed substitution expression
+
+=item malformed `y' command argument
+
+The first or second string of a B<y> command  is syntactically incorrect.
+
+=item maximum less than minimum in `\{%s\}'
+
+=item no script command given
+
+There must be at least one B<-e> or one B<-f> option specifying a
+script or script file.
+
+=item `\' not valid as delimiter in `y' command
+
+=item option -e requires an argument
+
+=item option -f requires an argument
+
+=item `s' command requires argument
+
+=item start of unterminated `{'
+
+=item string lengths in `y' command differ
+
+The translation table strings in a B<y> commanf must have equal lengths.
+
+=item undefined label `%s'
+
+=item unexpected `}'
+
+A B<}> command without a preceding B<{> command was encountered.
+
+=item unexpected end of script
+
+The end of the script was reached although a text line after a
+B<a>, B<c> or B<i> command indicated another line.
+
+=item unknown command `%s'
+
+=item unterminated `['
+
+A BRE contains an unterminated bracket expression.
+
+=item unterminated `\('
+
+A BRE contains an unterminated backreference.
+
+=item `\{' without closing `\}'
+
+A BRE contains an unterminated bounds specification.
+
+=item `\)' without preceding `\('
+
+=item `y' command requires argument
+
+=back
+
+=head1 EXAMPLE
+
+The basic material for the preceding section was generated by running
+the sed script
+
+   #no autoprint
+   s/^.*Warn( *"\([^"]*\)".*$/\1/
+   t process
+   b
+   :process
+   s/$!/%s/g
+   s/$[_[:alnum:]]\{1,\}/%s/g
+   s/\\\\/\\/g
+   s/^/=item /
+   p
+
+on the program's own text, and piping the output into C<sort -u>.
+
+
+=head1 SED SCRIPT TRANSLATION
+
+If this program is invoked with the name F<s2p> it will act as a
+sed-to-Perl translator. After option processing (all other
+arguments are ignored), a Perl program is printed on standard
+output, which will process the input stream (as read from all
+arguments) in the way defined by the sed script and the option setting
+used for the translation.
+
+=head1 SEE ALSO
+
+perl(1), re_format(7)
+
+=head1 BUGS
+
+The B<l> command will show escape characters (ESC) as `C<\e>', but
+a vertical tab (VT) in octal.
+
+Trailing spaces are truncated from labels in B<:>, B<t> and B<b> commands.
+
+The meaning of an empty regular expression (`C<//>'), as defined by B<sed>,
+is "the last pattern used, at run time". This deviates from the Perl
+interpretation, which will re-use the "last last successfully executed
+regular expression". Since keeping track of pattern usage would create
+terribly cluttered code, and differences would only appear in obscure
+context (where other B<sed> implementations appear to deviate, too),
+the Perl semantics was adopted. Note that common usage of this feature,
+such as in C</abc/s//xyz/>, will work as expected.
+
+Collating elements (of bracket expressions in BREs) are not implemented.
+
+=head1 STANDARDS
+
+This B<sed> implementation conforms to the IEEE Std1003.2-1992 ("POSIX.2")
+definition of B<sed>, and is compatible with the I<OpenBSD>
+implementation, except where otherwise noted (see L<"BUGS">).
+
+=head1 AUTHOR
+
+This Perl implementation of I<sed> was written by Wolfgang Laun,
+I<Wolfgang.Laun@alcatel.at>.
+
+=head1 COPYRIGHT and LICENSE
+
+This program is free and open software. You may use, modify,
+distribute, and sell this program (and any modified variants) in any
+way you wish, provided you do not restrict others from doing the same.
+
+=cut
+
 !NO!SUBS!
 
 close OUT or die "Can't close $file: $!";
 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+unlink 'psed';
+print "Linking s2p to psed.\n";
+if (defined $Config{d_link}) {
+  link 's2p', 'psed';
+} else {
+  unshift @INC, '../lib';
+  require File::Copy;
+  File::Copy::syscopy('s2p', 'psed');
+}
 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
 chdir $origdir;
diff --git a/gnu/usr.bin/perl/x2p/str.c b/gnu/usr.bin/perl/x2p/str.c
index 310bcd6e3bf..bd9b3e026ca 100644
--- a/gnu/usr.bin/perl/x2p/str.c
+++ b/gnu/usr.bin/perl/x2p/str.c
@@ -1,6 +1,6 @@
 /* $RCSfile: str.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:26 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -77,7 +77,7 @@ void
 str_nset(register STR *str, register char *ptr, register int len)
 {
     GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
-    bcopy(ptr,str->str_ptr,len);
+    memcpy(str->str_ptr,ptr,len);
     str->str_cur = len;
     *(str->str_ptr+str->str_cur) = '\0';
     str->str_nok = 0;		/* invalidate number */
@@ -93,7 +93,7 @@ str_set(register STR *str, register char *ptr)
 	ptr = "";
     len = strlen(ptr);
     GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
-    bcopy(ptr,str->str_ptr,len+1);
+    memcpy(str->str_ptr,ptr,len+1);
     str->str_cur = len;
     str->str_nok = 0;		/* invalidate number */
     str->str_pok = 1;		/* validate pointer */
@@ -107,7 +107,7 @@ str_chop(register STR *str, register char *ptr)	/* like set but assuming ptr is
     if (!(str->str_pok))
 	str_2ptr(str);
     str->str_cur -= (ptr - str->str_ptr);
-    bcopy(ptr,str->str_ptr, str->str_cur + 1);
+    memcpy(str->str_ptr, ptr, str->str_cur + 1);
     str->str_nok = 0;		/* invalidate number */
     str->str_pok = 1;		/* validate pointer */
 }
@@ -118,7 +118,7 @@ str_ncat(register STR *str, register char *ptr, register int len)
     if (!(str->str_pok))
 	str_2ptr(str);
     GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1);
-    bcopy(ptr,str->str_ptr+str->str_cur,len);
+    memcpy(str->str_ptr+str->str_cur, ptr, len);
     str->str_cur += len;
     *(str->str_ptr+str->str_cur) = '\0';
     str->str_nok = 0;		/* invalidate number */
@@ -145,7 +145,7 @@ str_cat(register STR *str, register char *ptr)
 	str_2ptr(str);
     len = strlen(ptr);
     GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1);
-    bcopy(ptr,str->str_ptr+str->str_cur,len+1);
+    memcpy(str->str_ptr+str->str_cur, ptr, len+1);
     str->str_cur += len;
     str->str_nok = 0;		/* invalidate number */
     str->str_pok = 1;		/* validate pointer */
@@ -197,7 +197,7 @@ str_new(int len)
     }
     else {
 	str = (STR *) safemalloc(sizeof(STR));
-	bzero((char*)str,sizeof(STR));
+	memset((char*)str,0,sizeof(STR));
     }
     if (len)
 	GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
@@ -221,7 +221,7 @@ str_replace(register STR *str, register STR *nstr)
     str->str_len = nstr->str_len;
     str->str_cur = nstr->str_cur;
     str->str_pok = nstr->str_pok;
-    if (str->str_nok = nstr->str_nok)
+    if ((str->str_nok = nstr->str_nok))
 	str->str_nval = nstr->str_nval;
     safefree((char*)nstr);
 }
@@ -282,20 +282,21 @@ str_gets(register STR *str, register FILE *fp)
     if (str->str_len <= cnt)		/* make sure we have the room */
 	GROWSTR(&(str->str_ptr), &(str->str_len), cnt+1);
     bp = str->str_ptr;			/* move these two too to registers */
-    ptr = FILE_ptr(fp);
+    ptr = (STDCHAR*)FILE_ptr(fp);
     for (;;) {
 	while (--cnt >= 0) {
-	    if ((*bp++ = *ptr++) == newline)
+	    if ((*bp++ = *ptr++) == newline) {
 		if (bp <= str->str_ptr || bp[-2] != '\\')
 		    goto thats_all_folks;
 		else {
 		    line++;
 		    bp -= 2;
 		}
+	    }
 	}
 	
 	FILE_cnt(fp) = cnt;		/* deregisterize cnt and ptr */
-	FILE_ptr(fp) = ptr;
+	FILE_ptr(fp) = (void*)ptr; /* LHS STDCHAR* cast non-portable */
 	i = getc(fp);		/* get more characters */
 	cnt = FILE_cnt(fp);
 	ptr = FILE_ptr(fp);		/* reregisterize cnt and ptr */
@@ -315,7 +316,7 @@ str_gets(register STR *str, register FILE *fp)
 
 thats_all_folks:
     FILE_cnt(fp) = cnt;			/* put these back or we're in trouble */
-    FILE_ptr(fp) = ptr;
+    FILE_ptr(fp) = (STDCHAR*)ptr;
     *bp = '\0';
     str->str_cur = bp - str->str_ptr;	/* set length */
 
@@ -353,7 +354,7 @@ str_inc(register STR *str)
     }
     for (d = str->str_ptr; *d && *d != '.'; d++) ;
     d--;
-    if (!isdigit(*str->str_ptr) || !isdigit(*d) ) {
+    if (!isDIGIT(*str->str_ptr) || !isDIGIT(*d) ) {
         str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
 	return;
     }
@@ -389,7 +390,7 @@ str_dec(register STR *str)
     }
     for (d = str->str_ptr; *d && *d != '.'; d++) ;
     d--;
-    if (!isdigit(*str->str_ptr) || !isdigit(*d) || (*d == '0' && d == str->str_ptr)) {
+    if (!isDIGIT(*str->str_ptr) || !isDIGIT(*d) || (*d == '0' && d == str->str_ptr)) {
         str_numset(str,atof(str->str_ptr) - 1.0);  /* punt */
 	return;
     }
diff --git a/gnu/usr.bin/perl/x2p/str.h b/gnu/usr.bin/perl/x2p/str.h
index 311c5e67dbe..ed428768475 100644
--- a/gnu/usr.bin/perl/x2p/str.h
+++ b/gnu/usr.bin/perl/x2p/str.h
@@ -1,6 +1,6 @@
 /* $RCSfile: str.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:27 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
diff --git a/gnu/usr.bin/perl/x2p/util.c b/gnu/usr.bin/perl/x2p/util.c
index 0da649a23ec..f0875577fe0 100644
--- a/gnu/usr.bin/perl/x2p/util.c
+++ b/gnu/usr.bin/perl/x2p/util.c
@@ -1,14 +1,11 @@
-/* $RCSfile: util.c,v $$Revision: 1.5 $$Date: 2001/05/24 18:36:41 $
+/* $RCSfile: util.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:29 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  *
- * $Log: util.c,v $
- * Revision 1.5  2001/05/24 18:36:41  millert
- * merge in perl 5.6.1 with our local changes
- *
+ * $Log:	util.c,v $
  */
 
 #include "EXTERN.h"
diff --git a/gnu/usr.bin/perl/x2p/util.h b/gnu/usr.bin/perl/x2p/util.h
index c5ebcec7dfd..146b0899c2d 100644
--- a/gnu/usr.bin/perl/x2p/util.h
+++ b/gnu/usr.bin/perl/x2p/util.h
@@ -1,6 +1,6 @@
 /* $RCSfile: util.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:30 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
diff --git a/gnu/usr.bin/perl/x2p/walk.c b/gnu/usr.bin/perl/x2p/walk.c
index 59ac8a9f3d4..0823289ef8e 100644
--- a/gnu/usr.bin/perl/x2p/walk.c
+++ b/gnu/usr.bin/perl/x2p/walk.c
@@ -1,6 +1,6 @@
 /* $RCSfile: walk.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:31 $
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -34,7 +34,11 @@ static void tab ( STR *str, int lvl );
 
 int prewalk ( int numit, int level, int node, int *numericptr );
 STR * walk ( int useval, int level, int node, int *numericptr, int minprec );
-
+#ifdef NETWARE
+char *savestr(char *str);
+char *cpytill(register char *to, register char *from, register int delim);
+char *instr(char *big, char *little);
+#endif
 
 STR *
 walk(int useval, int level, register int node, int *numericptr, int minprec)
@@ -69,12 +73,12 @@ walk(int useval, int level, register int node, int *numericptr, int minprec)
     case OPROG:
 	arymax = 0;
 	if (namelist) {
-	    while (isalpha(*namelist)) {
+	    while (isALPHA(*namelist)) {
 		for (d = tokenbuf,s=namelist;
-		  isalpha(*s) || isdigit(*s) || *s == '_';
+		  isALPHA(*s) || isDIGIT(*s) || *s == '_';
 		  *d++ = *s++) ;
 		*d = '\0';
-		while (*s && !isalpha(*s)) s++;
+		while (*s && !isALPHA(*s)) s++;
 		namelist = s;
 		nameary[++arymax] = savestr(tokenbuf);
 	    }
@@ -241,7 +245,7 @@ sub Pick {\n\
 	tmpstr=walk(0,level,ops[node+1].ival,&numarg,P_MIN);
 	/* translate \nnn to [\nnn] */
 	for (s = tmpstr->str_ptr, d = tokenbuf; *s; s++, d++) {
-	    if (*s == '\\' && isdigit(s[1]) && isdigit(s[2]) && isdigit(s[3])){
+	    if (*s == '\\' && isDIGIT(s[1]) && isDIGIT(s[2]) && isDIGIT(s[3])){
 		*d++ = '[';
 		*d++ = *s++;
 		*d++ = *s++;
@@ -254,7 +258,7 @@ sub Pick {\n\
 	}
 	*d = '\0';
 	for (d=tokenbuf; *d; d++)
-	    *d += 128;
+           *d += (char)128;
 	str_cat(str,tokenbuf);
 	str_free(tmpstr);
 	str_cat(str,"/");
@@ -589,9 +593,9 @@ sub Pick {\n\
 		s = savestr(tokenbuf);
 		for (t = tokenbuf; *t; t++) {
 		    *t &= 127;
-		    if (islower(*t))
-			*t = toupper(*t);
-		    if (!isalpha(*t) && !isdigit(*t))
+		    if (isLOWER(*t))
+			*t = toUPPER(*t);
+		    if (!isALPHA(*t) && !isDIGIT(*t))
 			*t = '_';
 		}
 		if (!strchr(tokenbuf,'_'))
@@ -750,7 +754,7 @@ sub Pick {\n\
 	subretnum |= numarg;
 	s = Nullch;
 	t = tmp2str->str_ptr;
-	while (t = instr(t,"return "))
+	while ((t = instr(t,"return ")))
 	    s = t++;
 	if (s) {
 	    i = 0;
@@ -822,11 +826,8 @@ sub Pick {\n\
 	str_cat(str,")");
 	break;
     case OGSUB:
-    case OSUB:
-	if (type == OGSUB)
-	    s = "g";
-	else
-	    s = "";
+    case OSUB: {
+	int gsub = type == OGSUB ? 1 : 0;
 	str = str_new(0);
 	tmpstr = str_new(0);
 	i = 0;
@@ -849,13 +850,14 @@ sub Pick {\n\
 	    tmp2str=walk(1,level,ops[ops[node+2].ival+1].ival,&numarg,P_MIN);
 	    for (t = tmp2str->str_ptr, d=tokenbuf; *t; d++,t++) {
 		if (*t == '&')
-		    *d++ = '$' + 128;
+                   *d++ = '$' + (char)128;
 		else if (*t == '$')
-		    *d++ = '\\' + 128;
+                   *d++ = '\\' + (char)128;
 		*d = *t + 128;
 	    }
 	    *d = '\0';
 	    str_set(tmp2str,tokenbuf);
+	    s = gsub ? "/g" : "/";
 	}
 	else {
 	    tmp2str=walk(1,level,ops[node+2].ival,&numarg,P_MIN);
@@ -863,9 +865,10 @@ sub Pick {\n\
 	    str_scat(tmp3str,tmp2str);
 	    str_cat(tmp3str,").'\"') =~ s/&/\\$&/g, ");
 	    str_set(tmp2str,"eval $s_");
-	    s = (char*)(*s == 'g' ? "ge" : "e");
+	    s = gsub ? "/ge" : "/e";
 	    i++;
 	}
+	str_cat(tmp2str,s);
 	type = ops[ops[node+1].ival].ival;
 	len = type >> 8;
 	type &= 255;
@@ -877,8 +880,6 @@ sub Pick {\n\
 	    str_scat(str,tmpstr);
 	    str_scat(str,fstr);
 	    str_scat(str,tmp2str);
-	    str_cat(str,"/");
-	    str_cat(str,s);
 	}
 	else if ((type == OFLD && !split_to_array) || (type == OVAR && len == 1)) {
 	    if (useval && i)
@@ -889,8 +890,6 @@ sub Pick {\n\
 	    str_scat(str,fstr);
 	    str_cat(str,"/");
 	    str_scat(str,tmp2str);
-	    str_cat(str,"/");
-	    str_cat(str,s);
 	}
 	else {
 	    i++;
@@ -903,8 +902,6 @@ sub Pick {\n\
 	    str_scat(str,tmpstr);
 	    str_cat(str,"/$s/");
 	    str_scat(str,tmp2str);
-	    str_cat(str,"/");
-	    str_cat(str,s);
 	}
 	if (useval && i)
 	    str_cat(str,")");
@@ -913,7 +910,7 @@ sub Pick {\n\
 	str_free(tmp2str);
 	str_free(tmp3str);
 	numeric = 1;
-	break;
+	break; }
     case ONUM:
 	str = walk(1,level,ops[node+1].ival,&numarg,P_MIN);
 	numeric = 1;
@@ -931,7 +928,7 @@ sub Pick {\n\
 		case '\\': case '"': case 'n': case 't': case '$':
 		    break;
 		default:	/* hide this from perl */
-		    *d++ = '\\' + 128;
+                   *d++ = '\\' + (char)128;
 		}
 	    }
 	    *d = *t + 128;
@@ -1008,7 +1005,7 @@ sub Pick {\n\
 		    strcpy(tokenbuf,"]");
 		else
 		    strcpy(tokenbuf,"}");
-		*tokenbuf += 128;
+               *tokenbuf += (char)128;
 		str_cat(str,tokenbuf);
 	    }
 	}
@@ -1060,7 +1057,7 @@ sub Pick {\n\
 	str_set(str,";");
 	tmpstr = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
 	for (s = tmpstr->str_ptr; *s && *s != '\n'; s++)
-	    *s += 128;
+           *s += (char)128;
 	str_scat(str,tmpstr);
 	str_free(tmpstr);
 	tab(str,level);
@@ -1069,7 +1066,7 @@ sub Pick {\n\
 	str = str_new(0);
 	tmpstr = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
 	for (s = tmpstr->str_ptr; *s && *s != '\n'; s++)
-	    *s += 128;
+           *s += (char)128;
 	str_scat(str,tmpstr);
 	str_free(tmpstr);
 	tab(str,level);
@@ -1120,9 +1117,9 @@ sub Pick {\n\
 	    s = savestr(tokenbuf);
 	    for (t = tokenbuf; *t; t++) {
 		*t &= 127;
-		if (islower(*t))
-		    *t = toupper(*t);
-		if (!isalpha(*t) && !isdigit(*t))
+		if (isLOWER(*t))
+		    *t = toUPPER(*t);
+		if (!isALPHA(*t) && !isDIGIT(*t))
 		    *t = '_';
 	    }
 	    if (!strchr(tokenbuf,'_'))
@@ -1157,9 +1154,9 @@ sub Pick {\n\
 		s = savestr(tokenbuf);
 		for (t = tokenbuf; *t; t++) {
 		    *t &= 127;
-		    if (islower(*t))
-			*t = toupper(*t);
-		    if (!isalpha(*t) && !isdigit(*t))
+		    if (isLOWER(*t))
+			*t = toUPPER(*t);
+		    if (!isALPHA(*t) && !isDIGIT(*t))
 			*t = '_';
 		}
 		if (!strchr(tokenbuf,'_'))
@@ -1430,7 +1427,7 @@ sub Pick {\n\
 	i = numarg;
 	if (i) {
 	    t = s = tmpstr->str_ptr;
-	    while (isalpha(*t) || isdigit(*t) || *t == '$' || *t == '_')
+	    while (isALPHA(*t) || isDIGIT(*t) || *t == '$' || *t == '_')
 		t++;
 	    i = t - s;
 	    if (i < 2)
@@ -1463,7 +1460,7 @@ sub Pick {\n\
 	if (!s)
 	    fatal("Illegal for loop: %s",d);
 	*s++ = '\0';
-	for (t = s; i = *t; t++) {
+	for (t = s; (i = *t); t++) {
 	    i &= 127;
 	    if (i == '}' || i == ']')
 		break;