perl 4.0 patch 36: (combined patch)perl-4.0.36

Since Ed Barton sent me a patch for the malignent form of "Malformed
cmd links", I finally broke down and made a patch for the various
other little things that have been accumulating on version 4.

38 files changed, 12974 insertions, 26 deletions

diff --git a/cons.c b/cons.c
index 54fa14d880..8b1210d464 100644
--- a/cons.c
+++ b/cons.c
@@ -85,6 +85,7 @@ CMD *cmd;
 	    Nullarg,mycompblock));
 	saw_return = FALSE;
 	cmd->c_flags |= CF_TERM;
+	cmd->c_head = cmd;
     }
     sub->cmd = cmd;
     if (perldb) {
@@ -1353,7 +1354,8 @@ int willsave;				/* willsave passes down the tree */
 
 		    /* in any event, save the iterator */
 
-		    (void)apush(tosave,cmd->c_short);
+		    if (cmd->c_short)  /* Better safe than sorry */
+			(void)apush(tosave,cmd->c_short);
 		}
 		shouldsave |= tmpsave;
 	    }
@@ -1420,7 +1422,7 @@ int willsave;
 	shouldsave = TRUE;
 	break;
     }
-    if (willsave)
+    if (willsave && arg->arg_ptr.arg_str)
 	(void)apush(tosave,arg->arg_ptr.arg_str);
     return shouldsave;
 }
diff --git a/cons.c.orig b/cons.c.orig
new file mode 100644
index 0000000000..54fa14d880
--- /dev/null
+++ b/cons.c.orig
@@ -0,0 +1,1442 @@
+/* $RCSfile: cons.c,v $$Revision: 4.0.1.3 $$Date: 92/06/08 12:18:35 $
+ *
+ *    Copyright (c) 1991, 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:	cons.c,v $
+ * Revision 4.0.1.3  92/06/08  12:18:35  lwall
+ * patch20: removed implicit int declarations on funcions
+ * patch20: deleted some minor memory leaks
+ * patch20: fixed double debug break in foreach with implicit array assignment
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: debugger sometimes displayed wrong source line
+ * patch20: various error messages have been clarified
+ * patch20: an eval block containing a null block or statement could dump core
+ * 
+ * Revision 4.0.1.2  91/11/05  16:15:13  lwall
+ * patch11: debugger got confused over nested subroutine definitions
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * 
+ * Revision 4.0.1.1  91/06/07  10:31:15  lwall
+ * patch4: new copyright notice
+ * patch4: added global modifier for pattern matches
+ * 
+ * Revision 4.0  91/03/20  01:05:51  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "perly.h"
+
+extern char *tokename[];
+extern int yychar;
+
+static int cmd_tosave();
+static int arg_tosave();
+static int spat_tosave();
+static void make_cswitch();
+static void make_nswitch();
+
+static bool saw_return;
+
+SUBR *
+make_sub(name,cmd)
+char *name;
+CMD *cmd;
+{
+    register SUBR *sub;
+    STAB *stab = stabent(name,TRUE);
+
+    if (sub = stab_sub(stab)) {
+	if (dowarn) {
+	    CMD *oldcurcmd = curcmd;
+
+	    if (cmd)
+		curcmd = cmd;
+	    warn("Subroutine %s redefined",name);
+	    curcmd = oldcurcmd;
+	}
+	if (!sub->usersub && sub->cmd) {
+	    cmd_free(sub->cmd);
+	    sub->cmd = Nullcmd;
+	    afree(sub->tosave);
+	}
+	Safefree(sub);
+    }
+    Newz(101,sub,1,SUBR);
+    stab_sub(stab) = sub;
+    sub->filestab = curcmd->c_filestab;
+    saw_return = FALSE;
+    tosave = anew(Nullstab);
+    tosave->ary_fill = 0;	/* make 1 based */
+    (void)cmd_tosave(cmd,FALSE);	/* this builds the tosave array */
+    sub->tosave = tosave;
+    if (saw_return) {
+	struct compcmd mycompblock;
+
+	mycompblock.comp_true = cmd;
+	mycompblock.comp_alt = Nullcmd;
+	cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,0,
+	    Nullarg,mycompblock));
+	saw_return = FALSE;
+	cmd->c_flags |= CF_TERM;
+    }
+    sub->cmd = cmd;
+    if (perldb) {
+	STR *str;
+	STR *tmpstr = str_mortal(&str_undef);
+
+	sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr, subline);
+	str = str_make(buf,0);
+	str_cat(str,"-");
+	sprintf(buf,"%ld",(long)curcmd->c_line);
+	str_cat(str,buf);
+	stab_efullname(tmpstr,stab);
+	hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
+    }
+    Safefree(name);
+    return sub;
+}
+
+SUBR *
+make_usub(name, ix, subaddr, filename)
+char *name;
+int ix;
+int (*subaddr)();
+char *filename;
+{
+    register SUBR *sub;
+    STAB *stab = stabent(name,allstabs);
+
+    if (!stab)				/* unused function */
+	return Null(SUBR*);
+    if (sub = stab_sub(stab)) {
+	if (dowarn)
+	    warn("Subroutine %s redefined",name);
+	if (!sub->usersub && sub->cmd) {
+	    cmd_free(sub->cmd);
+	    sub->cmd = Nullcmd;
+	    afree(sub->tosave);
+	}
+	Safefree(sub);
+    }
+    Newz(101,sub,1,SUBR);
+    stab_sub(stab) = sub;
+    sub->filestab = fstab(filename);
+    sub->usersub = subaddr;
+    sub->userindex = ix;
+    return sub;
+}
+
+void
+make_form(stab,fcmd)
+STAB *stab;
+FCMD *fcmd;
+{
+    if (stab_form(stab)) {
+	FCMD *tmpfcmd;
+	FCMD *nextfcmd;
+
+	for (tmpfcmd = stab_form(stab); tmpfcmd; tmpfcmd = nextfcmd) {
+	    nextfcmd = tmpfcmd->f_next;
+	    if (tmpfcmd->f_expr)
+		arg_free(tmpfcmd->f_expr);
+	    if (tmpfcmd->f_unparsed)
+		str_free(tmpfcmd->f_unparsed);
+	    if (tmpfcmd->f_pre)
+		Safefree(tmpfcmd->f_pre);
+	    Safefree(tmpfcmd);
+	}
+    }
+    stab_form(stab) = fcmd;
+}
+
+CMD *
+block_head(tail)
+register CMD *tail;
+{
+    CMD *head;
+    register int opt;
+    register int last_opt = 0;
+    register STAB *last_stab = Nullstab;
+    register int count = 0;
+    register CMD *switchbeg = Nullcmd;
+
+    if (tail == Nullcmd) {
+	return tail;
+    }
+    head = tail->c_head;
+
+    for (tail = head; tail; tail = tail->c_next) {
+
+	/* save one measly dereference at runtime */
+	if (tail->c_type == C_IF) {
+	    if (!(tail->ucmd.ccmd.cc_alt = tail->ucmd.ccmd.cc_alt->c_next))
+		tail->c_flags |= CF_TERM;
+	}
+	else if (tail->c_type == C_EXPR) {
+	    ARG *arg;
+
+	    if (tail->ucmd.acmd.ac_expr)
+		arg = tail->ucmd.acmd.ac_expr;
+	    else
+		arg = tail->c_expr;
+	    if (arg) {
+		if (arg->arg_type == O_RETURN)
+		    tail->c_flags |= CF_TERM;
+		else if (arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
+		    tail->c_flags |= CF_TERM;
+	    }
+	}
+	if (!tail->c_next)
+	    tail->c_flags |= CF_TERM;
+
+	if (tail->c_expr && (tail->c_flags & CF_OPTIMIZE) == CFT_FALSE)
+	    opt_arg(tail,1, tail->c_type == C_EXPR);
+
+	/* now do a little optimization on case-ish structures */
+	switch(tail->c_flags & (CF_OPTIMIZE|CF_FIRSTNEG|CF_INVERT)) {
+	case CFT_ANCHOR:
+	case CFT_STROP:
+	    opt = (tail->c_flags & CF_NESURE) ? CFT_STROP : 0;
+	    break;
+	case CFT_CCLASS:
+	    opt = CFT_STROP;
+	    break;
+	case CFT_NUMOP:
+	    opt = (tail->c_slen == O_NE ? 0 : CFT_NUMOP);
+	    if ((tail->c_flags&(CF_NESURE|CF_EQSURE)) != (CF_NESURE|CF_EQSURE))
+		opt = 0;
+	    break;
+	default:
+	    opt = 0;
+	}
+	if (opt && opt == last_opt && tail->c_stab == last_stab)
+	    count++;
+	else {
+	    if (count >= 3) {		/* is this the breakeven point? */
+		if (last_opt == CFT_NUMOP)
+		    make_nswitch(switchbeg,count);
+		else
+		    make_cswitch(switchbeg,count);
+	    }
+	    if (opt) {
+		count = 1;
+		switchbeg = tail;
+	    }
+	    else
+		count = 0;
+	}
+	last_opt = opt;
+	last_stab = tail->c_stab;
+    }
+    if (count >= 3) {		/* is this the breakeven point? */
+	if (last_opt == CFT_NUMOP)
+	    make_nswitch(switchbeg,count);
+	else
+	    make_cswitch(switchbeg,count);
+    }
+    return head;
+}
+
+/* We've spotted a sequence of CMDs that all test the value of the same
+ * spat.  Thus we can insert a SWITCH in front and jump directly
+ * to the correct one.
+ */
+static void
+make_cswitch(head,count)
+register CMD *head;
+int count;
+{
+    register CMD *cur;
+    register CMD **loc;
+    register int i;
+    register int min = 255;
+    register int max = 0;
+
+    /* make a new head in the exact same spot */
+    New(102,cur, 1, CMD);
+    StructCopy(head,cur,CMD);
+    Zero(head,1,CMD);
+    head->c_head = cur->c_head;
+    head->c_type = C_CSWITCH;
+    head->c_next = cur;		/* insert new cmd at front of list */
+    head->c_stab = cur->c_stab;
+
+    Newz(103,loc,258,CMD*);
+    loc++;				/* lie a little */
+    while (count--) {
+	if ((cur->c_flags & CF_OPTIMIZE) == CFT_CCLASS) {
+	    for (i = 0; i <= 255; i++) {
+		if (!loc[i] && cur->c_short->str_ptr[i>>3] & (1 << (i&7))) {
+		    loc[i] = cur;
+		    if (i < min)
+			min = i;
+		    if (i > max)
+			max = i;
+		}
+	    }
+	}
+	else {
+	    i = *cur->c_short->str_ptr & 255;
+	    if (!loc[i]) {
+		loc[i] = cur;
+		if (i < min)
+		    min = i;
+		if (i > max)
+		    max = i;
+	    }
+	}
+	cur = cur->c_next;
+    }
+    max++;
+    if (min > 0)
+	Move(&loc[min],&loc[0], max - min, CMD*);
+    loc--;
+    min--;
+    max -= min;
+    for (i = 0; i <= max; i++)
+	if (!loc[i])
+	    loc[i] = cur;
+    Renew(loc,max+1,CMD*);	/* chop it down to size */
+    head->ucmd.scmd.sc_offset = min;
+    head->ucmd.scmd.sc_max = max;
+    head->ucmd.scmd.sc_next = loc;
+}
+
+static void
+make_nswitch(head,count)
+register CMD *head;
+int count;
+{
+    register CMD *cur = head;
+    register CMD **loc;
+    register int i;
+    register int min = 32767;
+    register int max = -32768;
+    int origcount = count;
+    double value;		/* or your money back! */
+    short changed;		/* so triple your money back! */
+
+    while (count--) {
+	i = (int)str_gnum(cur->c_short);
+	value = (double)i;
+	if (value != cur->c_short->str_u.str_nval)
+	    return;		/* fractional values--just forget it */
+	changed = i;
+	if (changed != i)
+	    return;		/* too big for a short */
+	if (cur->c_slen == O_LE)
+	    i++;
+	else if (cur->c_slen == O_GE)	/* we only do < or > here */
+	    i--;
+	if (i < min)
+	    min = i;
+	if (i > max)
+	    max = i;
+	cur = cur->c_next;
+    }
+    count = origcount;
+    if (max - min > count * 2 + 10)		/* too sparse? */
+	return;
+
+    /* now make a new head in the exact same spot */
+    New(104,cur, 1, CMD);
+    StructCopy(head,cur,CMD);
+    Zero(head,1,CMD);
+    head->c_head = cur->c_head;
+    head->c_type = C_NSWITCH;
+    head->c_next = cur;		/* insert new cmd at front of list */
+    head->c_stab = cur->c_stab;
+
+    Newz(105,loc, max - min + 3, CMD*);
+    loc++;
+    max -= min;
+    max++;
+    while (count--) {
+	i = (int)str_gnum(cur->c_short);
+	i -= min;
+	switch(cur->c_slen) {
+	case O_LE:
+	    i++;
+	case O_LT:
+	    for (i--; i >= -1; i--)
+		if (!loc[i])
+		    loc[i] = cur;
+	    break;
+	case O_GE:
+	    i--;
+	case O_GT:
+	    for (i++; i <= max; i++)
+		if (!loc[i])
+		    loc[i] = cur;
+	    break;
+	case O_EQ:
+	    if (!loc[i])
+		loc[i] = cur;
+	    break;
+	}
+	cur = cur->c_next;
+    }
+    loc--;
+    min--;
+    max++;
+    for (i = 0; i <= max; i++)
+	if (!loc[i])
+	    loc[i] = cur;
+    head->ucmd.scmd.sc_offset = min;
+    head->ucmd.scmd.sc_max = max;
+    head->ucmd.scmd.sc_next = loc;
+}
+
+CMD *
+append_line(head,tail)
+register CMD *head;
+register CMD *tail;
+{
+    if (tail == Nullcmd)
+	return head;
+    if (!tail->c_head)			/* make sure tail is well formed */
+	tail->c_head = tail;
+    if (head != Nullcmd) {
+	tail = tail->c_head;		/* get to start of tail list */
+	if (!head->c_head)
+	    head->c_head = head;	/* start a new head list */
+	while (head->c_next) {
+	    head->c_next->c_head = head->c_head;
+	    head = head->c_next;	/* get to end of head list */
+	}
+	head->c_next = tail;		/* link to end of old list */
+	tail->c_head = head->c_head;	/* propagate head pointer */
+    }
+    while (tail->c_next) {
+	tail->c_next->c_head = tail->c_head;
+	tail = tail->c_next;
+    }
+    return tail;
+}
+
+CMD *
+dodb(cur)
+CMD *cur;
+{
+    register CMD *cmd;
+    register CMD *head = cur->c_head;
+    STR *str;
+
+    if (!head)
+	head = cur;
+    if (!head->c_line)
+	return cur;
+    str = afetch(stab_xarray(curcmd->c_filestab),(int)head->c_line,FALSE);
+    if (str == &str_undef || str->str_nok)
+	return cur;
+    str->str_u.str_nval = (double)head->c_line;
+    str->str_nok = 1;
+    Newz(106,cmd,1,CMD);
+    str_magic(str, curcmd->c_filestab, 0, Nullch, 0);
+    str->str_magic->str_u.str_cmd = cmd;
+    cmd->c_type = C_EXPR;
+    cmd->ucmd.acmd.ac_stab = Nullstab;
+    cmd->ucmd.acmd.ac_expr = Nullarg;
+    cmd->c_expr = make_op(O_SUBR, 2,
+	stab2arg(A_WORD,DBstab),
+	Nullarg,
+	Nullarg);
+    /*SUPPRESS 53*/
+    cmd->c_flags |= CF_COND|CF_DBSUB|CFT_D0;
+    cmd->c_line = head->c_line;
+    cmd->c_label = head->c_label;
+    cmd->c_filestab = curcmd->c_filestab;
+    cmd->c_stash = curstash;
+    return append_line(cmd, cur);
+}
+
+CMD *
+make_acmd(type,stab,cond,arg)
+int type;
+STAB *stab;
+ARG *cond;
+ARG *arg;
+{
+    register CMD *cmd;
+
+    Newz(107,cmd,1,CMD);
+    cmd->c_type = type;
+    cmd->ucmd.acmd.ac_stab = stab;
+    cmd->ucmd.acmd.ac_expr = arg;
+    cmd->c_expr = cond;
+    if (cond)
+	cmd->c_flags |= CF_COND;
+    if (cmdline == NOLINE)
+	cmd->c_line = curcmd->c_line;
+    else {
+	cmd->c_line = cmdline;
+	cmdline = NOLINE;
+    }
+    cmd->c_filestab = curcmd->c_filestab;
+    cmd->c_stash = curstash;
+    if (perldb)
+	cmd = dodb(cmd);
+    return cmd;
+}
+
+CMD *
+make_ccmd(type,debuggable,arg,cblock)
+int type;
+int debuggable;
+ARG *arg;
+struct compcmd cblock;
+{
+    register CMD *cmd;
+
+    Newz(108,cmd, 1, CMD);
+    cmd->c_type = type;
+    cmd->c_expr = arg;
+    cmd->ucmd.ccmd.cc_true = cblock.comp_true;
+    cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
+    if (arg)
+	cmd->c_flags |= CF_COND;
+    if (cmdline == NOLINE)
+	cmd->c_line = curcmd->c_line;
+    else {
+	cmd->c_line = cmdline;
+	cmdline = NOLINE;
+    }
+    cmd->c_filestab = curcmd->c_filestab;
+    cmd->c_stash = curstash;
+    if (perldb && debuggable)
+	cmd = dodb(cmd);
+    return cmd;
+}
+
+CMD *
+make_icmd(type,arg,cblock)
+int type;
+ARG *arg;
+struct compcmd cblock;
+{
+    register CMD *cmd;
+    register CMD *alt;
+    register CMD *cur;
+    register CMD *head;
+    struct compcmd ncblock;
+
+    Newz(109,cmd, 1, CMD);
+    head = cmd;
+    cmd->c_type = type;
+    cmd->c_expr = arg;
+    cmd->ucmd.ccmd.cc_true = cblock.comp_true;
+    cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
+    if (arg)
+	cmd->c_flags |= CF_COND;
+    if (cmdline == NOLINE)
+	cmd->c_line = curcmd->c_line;
+    else {
+	cmd->c_line = cmdline;
+	cmdline = NOLINE;
+    }
+    cmd->c_filestab = curcmd->c_filestab;
+    cmd->c_stash = curstash;
+    cur = cmd;
+    alt = cblock.comp_alt;
+    while (alt && alt->c_type == C_ELSIF) {
+	cur = alt;
+	alt = alt->ucmd.ccmd.cc_alt;
+    }
+    if (alt) {			/* a real life ELSE at the end? */
+	ncblock.comp_true = alt;
+	ncblock.comp_alt = Nullcmd;
+	alt = append_line(cur,make_ccmd(C_ELSE,1,Nullarg,ncblock));
+	cur->ucmd.ccmd.cc_alt = alt;
+    }
+    else
+	alt = cur;		/* no ELSE, so cur is proxy ELSE */
+
+    cur = cmd;
+    while (cmd) {		/* now point everyone at the ELSE */
+	cur = cmd;
+	cmd = cur->ucmd.ccmd.cc_alt;
+	cur->c_head = head;
+	if (cur->c_type == C_ELSIF)
+	    cur->c_type = C_IF;
+	if (cur->c_type == C_IF)
+	    cur->ucmd.ccmd.cc_alt = alt;
+	if (cur == alt)
+	    break;
+	cur->c_next = cmd;
+    }
+    if (perldb)
+	cur = dodb(cur);
+    return cur;
+}
+
+void
+opt_arg(cmd,fliporflop,acmd)
+register CMD *cmd;
+int fliporflop;
+int acmd;
+{
+    register ARG *arg;
+    int opt = CFT_EVAL;
+    int sure = 0;
+    ARG *arg2;
+    int context = 0;	/* 0 = normal, 1 = before &&, 2 = before || */
+    int flp = fliporflop;
+
+    if (!cmd)
+	return;
+    if (!(arg = cmd->c_expr)) {
+	cmd->c_flags &= ~CF_COND;
+	return;
+    }
+
+    /* Can we turn && and || into if and unless? */
+
+    if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM) &&
+      (arg->arg_type == O_AND || arg->arg_type == O_OR) ) {
+	dehoist(arg,1);
+	arg[2].arg_type &= A_MASK;	/* don't suppress eval */
+	dehoist(arg,2);
+	cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg;
+	cmd->c_expr = arg[1].arg_ptr.arg_arg;
+	if (arg->arg_type == O_OR)
+	    cmd->c_flags ^= CF_INVERT;		/* || is like unless */
+	arg->arg_len = 0;
+	free_arg(arg);
+	arg = cmd->c_expr;
+    }
+
+    /* Turn "if (!expr)" into "unless (expr)" */
+
+    if (!(cmd->c_flags & CF_TERM)) {		/* unless return value wanted */
+	while (arg->arg_type == O_NOT) {
+	    dehoist(arg,1);
+	    cmd->c_flags ^= CF_INVERT;		/* flip sense of cmd */
+	    cmd->c_expr = arg[1].arg_ptr.arg_arg; /* hoist the rest of expr */
+	    free_arg(arg);
+	    arg = cmd->c_expr;			/* here we go again */
+	}
+    }
+
+    if (!arg->arg_len) {		/* sanity check */
+	cmd->c_flags |= opt;
+	return;
+    }
+
+    /* for "cond .. cond" we set up for the initial check */
+
+    if (arg->arg_type == O_FLIP)
+	context |= 4;
+
+    /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
+
+  morecontext:
+    if (arg->arg_type == O_AND)
+	context |= 1;
+    else if (arg->arg_type == O_OR)
+	context |= 2;
+    if (context && (arg[flp].arg_type & A_MASK) == A_EXPR) {
+	arg = arg[flp].arg_ptr.arg_arg;
+	flp = 1;
+	if (arg->arg_type == O_AND || arg->arg_type == O_OR)
+	    goto morecontext;
+    }
+    if ((context & 3) == 3)
+	return;
+
+    if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
+	cmd->c_flags |= opt;
+	if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)
+	  && cmd->c_expr->arg_type == O_ITEM) {
+	    arg[flp].arg_flags &= ~AF_POST;	/* prefer ++$foo to $foo++ */
+	    arg[flp].arg_flags |= AF_PRE;	/*  if value not wanted */
+	}
+	return;				/* side effect, can't optimize */
+    }
+
+    if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
+      arg->arg_type == O_AND || arg->arg_type == O_OR) {
+	if ((arg[flp].arg_type & A_MASK) == A_SINGLE) {
+	    opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
+	    cmd->c_short = str_smake(arg[flp].arg_ptr.arg_str);
+	    goto literal;
+	}
+	else if ((arg[flp].arg_type & A_MASK) == A_STAB ||
+	  (arg[flp].arg_type & A_MASK) == A_LVAL) {
+	    cmd->c_stab  = arg[flp].arg_ptr.arg_stab;
+	    if (!context)
+		arg[flp].arg_ptr.arg_stab = Nullstab;
+	    opt = CFT_REG;
+	  literal:
+	    if (!context) {	/* no && or ||? */
+		arg_free(arg);
+		cmd->c_expr = Nullarg;
+	    }
+	    if (!(context & 1))
+		cmd->c_flags |= CF_EQSURE;
+	    if (!(context & 2))
+		cmd->c_flags |= CF_NESURE;
+	}
+    }
+    else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
+	     arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
+	if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
+		(arg[2].arg_type & A_MASK) == A_SPAT &&
+		arg[2].arg_ptr.arg_spat->spat_short &&
+		(arg->arg_type == O_SUBST || arg->arg_type == O_NSUBST ||
+		 (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_GLOBAL) == 0 )) {
+	    cmd->c_stab  = arg[1].arg_ptr.arg_stab;
+	    cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
+	    cmd->c_slen  = arg[2].arg_ptr.arg_spat->spat_slen;
+	    if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL &&
+		!(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) &&
+		(arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
+		sure |= CF_EQSURE;		/* (SUBST must be forced even */
+						/* if we know it will work.) */
+	    if (arg->arg_type != O_SUBST) {
+		str_free(arg[2].arg_ptr.arg_spat->spat_short);
+		arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
+		arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
+	    }
+	    sure |= CF_NESURE;		/* normally only sure if it fails */
+	    if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
+		cmd->c_flags |= CF_FIRSTNEG;
+	    if (context & 1) {		/* only sure if thing is false */
+		if (cmd->c_flags & CF_FIRSTNEG)
+		    sure &= ~CF_NESURE;
+		else
+		    sure &= ~CF_EQSURE;
+	    }
+	    else if (context & 2) {	/* only sure if thing is true */
+		if (cmd->c_flags & CF_FIRSTNEG)
+		    sure &= ~CF_EQSURE;
+		else
+		    sure &= ~CF_NESURE;
+	    }
+	    if (sure & (CF_EQSURE|CF_NESURE)) {	/* if we know anything*/
+		if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
+		    opt = CFT_SCAN;
+		else
+		    opt = CFT_ANCHOR;
+		if (sure == (CF_EQSURE|CF_NESURE)	/* really sure? */
+		    && arg->arg_type == O_MATCH
+		    && context & 4
+		    && fliporflop == 1) {
+		    spat_free(arg[2].arg_ptr.arg_spat);
+		    arg[2].arg_ptr.arg_spat = Nullspat;	/* don't do twice */
+		}
+		else
+		    cmd->c_spat = arg[2].arg_ptr.arg_spat;
+		cmd->c_flags |= sure;
+	    }
+	}
+    }
+    else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
+	     arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
+	if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
+	    if (arg[2].arg_type == A_SINGLE) {
+		/*SUPPRESS 594*/
+		char *junk = str_get(arg[2].arg_ptr.arg_str);
+
+		cmd->c_stab  = arg[1].arg_ptr.arg_stab;
+		cmd->c_short = str_smake(arg[2].arg_ptr.arg_str);
+		cmd->c_slen  = cmd->c_short->str_cur+1;
+		switch (arg->arg_type) {
+		case O_SLT: case O_SGT:
+		    sure |= CF_EQSURE;
+		    cmd->c_flags |= CF_FIRSTNEG;
+		    break;
+		case O_SNE:
+		    cmd->c_flags |= CF_FIRSTNEG;
+		    /* FALL THROUGH */
+		case O_SEQ:
+		    sure |= CF_NESURE|CF_EQSURE;
+		    break;
+		}
+		if (context & 1) {	/* only sure if thing is false */
+		    if (cmd->c_flags & CF_FIRSTNEG)
+			sure &= ~CF_NESURE;
+		    else
+			sure &= ~CF_EQSURE;
+		}
+		else if (context & 2) { /* only sure if thing is true */
+		    if (cmd->c_flags & CF_FIRSTNEG)
+			sure &= ~CF_EQSURE;
+		    else
+			sure &= ~CF_NESURE;
+		}
+		if (sure & (CF_EQSURE|CF_NESURE)) {
+		    opt = CFT_STROP;
+		    cmd->c_flags |= sure;
+		}
+	    }
+	}
+    }
+    else if (arg->arg_type == O_EQ || arg->arg_type == O_NE ||
+	     arg->arg_type == O_LE || arg->arg_type == O_GE ||
+	     arg->arg_type == O_LT || arg->arg_type == O_GT) {
+	if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
+	    if (arg[2].arg_type == A_SINGLE) {
+		cmd->c_stab  = arg[1].arg_ptr.arg_stab;
+		if (dowarn) {
+		    STR *str = arg[2].arg_ptr.arg_str;
+
+		    if ((!str->str_nok && !looks_like_number(str)))
+			warn("Possible use of == on string value");
+		}
+		cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str));
+		cmd->c_slen = arg->arg_type;
+		sure |= CF_NESURE|CF_EQSURE;
+		if (context & 1) {	/* only sure if thing is false */
+		    sure &= ~CF_EQSURE;
+		}
+		else if (context & 2) { /* only sure if thing is true */
+		    sure &= ~CF_NESURE;
+		}
+		if (sure & (CF_EQSURE|CF_NESURE)) {
+		    opt = CFT_NUMOP;
+		    cmd->c_flags |= sure;
+		}
+	    }
+	}
+    }
+    else if (arg->arg_type == O_ASSIGN &&
+	     (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
+	     arg[1].arg_ptr.arg_stab == defstab &&
+	     arg[2].arg_type == A_EXPR ) {
+	arg2 = arg[2].arg_ptr.arg_arg;
+	if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
+	    opt = CFT_GETS;
+	    cmd->c_stab = arg2[1].arg_ptr.arg_stab;
+	    if (!(stab_io(arg2[1].arg_ptr.arg_stab)->flags & IOF_ARGV)) {
+		free_arg(arg2);
+		arg[2].arg_ptr.arg_arg = Nullarg;
+		free_arg(arg);
+		cmd->c_expr = Nullarg;
+	    }
+	}
+    }
+    else if (arg->arg_type == O_CHOP &&
+	     (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
+	opt = CFT_CHOP;
+	cmd->c_stab = arg[1].arg_ptr.arg_stab;
+	free_arg(arg);
+	cmd->c_expr = Nullarg;
+    }
+    if (context & 4)
+	opt |= CF_FLIP;
+    cmd->c_flags |= opt;
+
+    if (cmd->c_flags & CF_FLIP) {
+	if (fliporflop == 1) {
+	    arg = cmd->c_expr;	/* get back to O_FLIP arg */
+	    New(110,arg[3].arg_ptr.arg_cmd, 1, CMD);
+	    Copy(cmd, arg[3].arg_ptr.arg_cmd, 1, CMD);
+	    New(111,arg[4].arg_ptr.arg_cmd,1,CMD);
+	    Copy(cmd, arg[4].arg_ptr.arg_cmd, 1, CMD);
+	    opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd);
+	    arg->arg_len = 2;		/* this is a lie */
+	}
+	else {
+	    if ((opt & CF_OPTIMIZE) == CFT_EVAL)
+		cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
+	}
+    }
+}
+
+CMD *
+add_label(lbl,cmd)
+char *lbl;
+register CMD *cmd;
+{
+    if (cmd)
+	cmd->c_label = lbl;
+    return cmd;
+}
+
+CMD *
+addcond(cmd, arg)
+register CMD *cmd;
+register ARG *arg;
+{
+    cmd->c_expr = arg;
+    cmd->c_flags |= CF_COND;
+    return cmd;
+}
+
+CMD *
+addloop(cmd, arg)
+register CMD *cmd;
+register ARG *arg;
+{
+    void while_io();
+
+    cmd->c_expr = arg;
+    cmd->c_flags |= CF_COND|CF_LOOP;
+
+    if (!(cmd->c_flags & CF_INVERT))
+	while_io(cmd);		/* add $_ =, if necessary */
+
+    if (cmd->c_type == C_BLOCK)
+	cmd->c_flags &= ~CF_COND;
+    else {
+	arg = cmd->ucmd.acmd.ac_expr;
+	if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
+	    cmd->c_flags &= ~CF_COND;  /* "do {} while" happens at least once */
+	if (arg && (arg->arg_flags & AF_DEPR) &&
+	  (arg->arg_type == O_SUBR || arg->arg_type == O_DBSUBR) )
+	    cmd->c_flags &= ~CF_COND;  /* likewise for "do subr() while" */
+    }
+    return cmd;
+}
+
+CMD *
+invert(cmd)
+CMD *cmd;
+{
+    register CMD *targ = cmd;
+    if (targ->c_head)
+	targ = targ->c_head;
+    if (targ->c_flags & CF_DBSUB)
+	targ = targ->c_next;
+    targ->c_flags ^= CF_INVERT;
+    return cmd;
+}
+
+void
+cpy7bit(d,s,l)
+register char *d;
+register char *s;
+register int l;
+{
+    while (l--)
+	*d++ = *s++ & 127;
+    *d = '\0';
+}
+
+int
+yyerror(s)
+char *s;
+{
+    char tmpbuf[258];
+    char tmp2buf[258];
+    char *tname = tmpbuf;
+
+    if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
+      oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
+	while (isSPACE(*oldoldbufptr))
+	    oldoldbufptr++;
+	cpy7bit(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
+	sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
+    }
+    else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
+      oldbufptr != bufptr) {
+	while (isSPACE(*oldbufptr))
+	    oldbufptr++;
+	cpy7bit(tmp2buf, oldbufptr, bufptr - oldbufptr);
+	sprintf(tname,"next token \"%s\"",tmp2buf);
+    }
+    else if (yychar > 256)
+	tname = "next token ???";
+    else if (!yychar)
+	(void)strcpy(tname,"at EOF");
+    else if (yychar < 32)
+	(void)sprintf(tname,"next char ^%c",yychar+64);
+    else if (yychar == 127)
+	(void)strcpy(tname,"at EOF");
+    else
+	(void)sprintf(tname,"next char %c",yychar);
+    (void)sprintf(buf, "%s in file %s at line %d, %s\n",
+      s,stab_val(curcmd->c_filestab)->str_ptr,curcmd->c_line,tname);
+    if (curcmd->c_line == multi_end && multi_start < multi_end)
+	sprintf(buf+strlen(buf),
+	  "  (Might be a runaway multi-line %c%c string starting on line %d)\n",
+	  multi_open,multi_close,multi_start);
+    if (in_eval)
+	str_cat(stab_val(stabent("@",TRUE)),buf);
+    else
+	fputs(buf,stderr);
+    if (++error_count >= 10)
+	fatal("%s has too many errors.\n",
+	stab_val(curcmd->c_filestab)->str_ptr);
+}
+
+void
+while_io(cmd)
+register CMD *cmd;
+{
+    register ARG *arg = cmd->c_expr;
+    STAB *asgnstab;
+
+    /* hoist "while (<channel>)" up into command block */
+
+    if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
+	cmd->c_flags &= ~CF_OPTIMIZE;	/* clear optimization type */
+	cmd->c_flags |= CFT_GETS;	/* and set it to do the input */
+	cmd->c_stab = arg[1].arg_ptr.arg_stab;
+	if (stab_io(arg[1].arg_ptr.arg_stab)->flags & IOF_ARGV) {
+	    cmd->c_expr = l(make_op(O_ASSIGN, 2,	/* fake up "$_ =" */
+	       stab2arg(A_LVAL,defstab), arg, Nullarg));
+	}
+	else {
+	    free_arg(arg);
+	    cmd->c_expr = Nullarg;
+	}
+    }
+    else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) {
+	cmd->c_flags &= ~CF_OPTIMIZE;	/* clear optimization type */
+	cmd->c_flags |= CFT_INDGETS;	/* and set it to do the input */
+	cmd->c_stab = arg[1].arg_ptr.arg_stab;
+	free_arg(arg);
+	cmd->c_expr = Nullarg;
+    }
+    else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) {
+	if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY)
+	    asgnstab = cmd->c_stab;
+	else
+	    asgnstab = defstab;
+	cmd->c_expr = l(make_op(O_ASSIGN, 2,	/* fake up "$foo =" */
+	   stab2arg(A_LVAL,asgnstab), arg, Nullarg));
+	cmd->c_flags &= ~CF_OPTIMIZE;	/* clear optimization type */
+    }
+}
+
+CMD *
+wopt(cmd)
+register CMD *cmd;
+{
+    register CMD *tail;
+    CMD *newtail;
+    register int i;
+
+    if (cmd->c_expr && (cmd->c_flags & CF_OPTIMIZE) == CFT_FALSE)
+	opt_arg(cmd,1, cmd->c_type == C_EXPR);
+
+    while_io(cmd);		/* add $_ =, if necessary */
+
+    /* First find the end of the true list */
+
+    tail = cmd->ucmd.ccmd.cc_true;
+    if (tail == Nullcmd)
+	return cmd;
+    New(112,newtail, 1, CMD);	/* guaranteed continue */
+    for (;;) {
+	/* optimize "next" to point directly to continue block */
+	if (tail->c_type == C_EXPR &&
+	    tail->ucmd.acmd.ac_expr &&
+	    tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
+	    (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
+	     (cmd->c_label &&
+	      strEQ(cmd->c_label,
+		    tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
+	{
+	    arg_free(tail->ucmd.acmd.ac_expr);
+	    tail->ucmd.acmd.ac_expr = Nullarg;
+	    tail->c_type = C_NEXT;
+	    if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
+		tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
+	    else
+		tail->ucmd.ccmd.cc_alt = newtail;
+	    tail->ucmd.ccmd.cc_true = Nullcmd;
+	}
+	else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
+	    if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
+		tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
+	    else
+		tail->ucmd.ccmd.cc_alt = newtail;
+	}
+	else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
+	    if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
+		for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
+		    if (!tail->ucmd.scmd.sc_next[i])
+			tail->ucmd.scmd.sc_next[i] = cmd->ucmd.ccmd.cc_alt;
+	    }
+	    else {
+		for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
+		    if (!tail->ucmd.scmd.sc_next[i])
+			tail->ucmd.scmd.sc_next[i] = newtail;
+	    }
+	}
+
+	if (!tail->c_next)
+	    break;
+	tail = tail->c_next;
+    }
+
+    /* if there's a continue block, link it to true block and find end */
+
+    if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
+	tail->c_next = cmd->ucmd.ccmd.cc_alt;
+	tail = tail->c_next;
+	for (;;) {
+	    /* optimize "next" to point directly to continue block */
+	    if (tail->c_type == C_EXPR &&
+		tail->ucmd.acmd.ac_expr &&
+		tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
+		(tail->ucmd.acmd.ac_expr->arg_len == 0 ||
+		 (cmd->c_label &&
+		  strEQ(cmd->c_label,
+			tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
+	    {
+		arg_free(tail->ucmd.acmd.ac_expr);
+		tail->ucmd.acmd.ac_expr = Nullarg;
+		tail->c_type = C_NEXT;
+		tail->ucmd.ccmd.cc_alt = newtail;
+		tail->ucmd.ccmd.cc_true = Nullcmd;
+	    }
+	    else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
+		tail->ucmd.ccmd.cc_alt = newtail;
+	    }
+	    else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
+		for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
+		    if (!tail->ucmd.scmd.sc_next[i])
+			tail->ucmd.scmd.sc_next[i] = newtail;
+	    }
+
+	    if (!tail->c_next)
+		break;
+	    tail = tail->c_next;
+	}
+	/*SUPPRESS 530*/
+	for ( ; tail->c_next; tail = tail->c_next) ;
+    }
+
+    /* Here's the real trick: link the end of the list back to the beginning,
+     * inserting a "last" block to break out of the loop.  This saves one or
+     * two procedure calls every time through the loop, because of how cmd_exec
+     * does tail recursion.
+     */
+
+    tail->c_next = newtail;
+    tail = newtail;
+    if (!cmd->ucmd.ccmd.cc_alt)
+	cmd->ucmd.ccmd.cc_alt = tail;	/* every loop has a continue now */
+
+#ifndef lint
+    Copy((char *)cmd, (char *)tail, 1, CMD);
+#endif
+    tail->c_type = C_EXPR;
+    tail->c_flags ^= CF_INVERT;		/* turn into "last unless" */
+    tail->c_next = tail->ucmd.ccmd.cc_true;	/* loop directly back to top */
+    tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg);
+    tail->ucmd.acmd.ac_stab = Nullstab;
+    return cmd;
+}
+
+CMD *
+over(eachstab,cmd)
+STAB *eachstab;
+register CMD *cmd;
+{
+    /* hoist "for $foo (@bar)" up into command block */
+
+    cmd->c_flags &= ~CF_OPTIMIZE;	/* clear optimization type */
+    cmd->c_flags |= CFT_ARRAY;		/* and set it to do the iteration */
+    cmd->c_stab = eachstab;
+    cmd->c_short = Str_new(23,0);	/* just to save a field in struct cmd */
+    cmd->c_short->str_u.str_useful = -1;
+
+    return cmd;
+}
+
+void
+cmd_free(cmd)
+register CMD *cmd;
+{
+    register CMD *tofree;
+    register CMD *head = cmd;
+
+    if (!cmd)
+	return;
+    if (cmd->c_head != cmd)
+	warn("Malformed cmd links\n");
+    while (cmd) {
+	if (cmd->c_type != C_WHILE) {	/* WHILE block is duplicated */
+	    if (cmd->c_label) {
+		Safefree(cmd->c_label);
+		cmd->c_label = Nullch;
+	    }
+	    if (cmd->c_short) {
+		str_free(cmd->c_short);
+		cmd->c_short = Nullstr;
+	    }
+	    if (cmd->c_expr) {
+		arg_free(cmd->c_expr);
+		cmd->c_expr = Nullarg;
+	    }
+	}
+	switch (cmd->c_type) {
+	case C_WHILE:
+	case C_BLOCK:
+	case C_ELSE:
+	case C_IF:
+	    if (cmd->ucmd.ccmd.cc_true) {
+		cmd_free(cmd->ucmd.ccmd.cc_true);
+		cmd->ucmd.ccmd.cc_true = Nullcmd;
+	    }
+	    break;
+	case C_EXPR:
+	    if (cmd->ucmd.acmd.ac_expr) {
+		arg_free(cmd->ucmd.acmd.ac_expr);
+		cmd->ucmd.acmd.ac_expr = Nullarg;
+	    }
+	    break;
+	}
+	tofree = cmd;
+	cmd = cmd->c_next;
+	if (tofree != head)		/* to get Saber to shut up */
+	    Safefree(tofree);
+	if (cmd && cmd == head)		/* reached end of while loop */
+	    break;
+    }
+    Safefree(head);
+}
+
+void
+arg_free(arg)
+register ARG *arg;
+{
+    register int i;
+
+    if (!arg)
+	return;
+    for (i = 1; i <= arg->arg_len; i++) {
+	switch (arg[i].arg_type & A_MASK) {
+	case A_NULL:
+	    if (arg->arg_type == O_TRANS) {
+		Safefree(arg[i].arg_ptr.arg_cval);
+		arg[i].arg_ptr.arg_cval = Nullch;
+	    }
+	    break;
+	case A_LEXPR:
+	    if (arg->arg_type == O_AASSIGN &&
+	      arg[i].arg_ptr.arg_arg->arg_type == O_LARRAY) {
+		char *name = 
+		  stab_name(arg[i].arg_ptr.arg_arg[1].arg_ptr.arg_stab);
+
+		if (strnEQ("_GEN_",name, 5))	/* array for foreach */
+		    hdelete(defstash,name,strlen(name));
+	    }
+	    /* FALL THROUGH */
+	case A_EXPR:
+	    arg_free(arg[i].arg_ptr.arg_arg);
+	    arg[i].arg_ptr.arg_arg = Nullarg;
+	    break;
+	case A_CMD:
+	    cmd_free(arg[i].arg_ptr.arg_cmd);
+	    arg[i].arg_ptr.arg_cmd = Nullcmd;
+	    break;
+	case A_WORD:
+	case A_STAB:
+	case A_LVAL:
+	case A_READ:
+	case A_GLOB:
+	case A_ARYLEN:
+	case A_LARYLEN:
+	case A_ARYSTAB:
+	case A_LARYSTAB:
+	    break;
+	case A_SINGLE:
+	case A_DOUBLE:
+	case A_BACKTICK:
+	    str_free(arg[i].arg_ptr.arg_str);
+	    arg[i].arg_ptr.arg_str = Nullstr;
+	    break;
+	case A_SPAT:
+	    spat_free(arg[i].arg_ptr.arg_spat);
+	    arg[i].arg_ptr.arg_spat = Nullspat;
+	    break;
+	}
+    }
+    free_arg(arg);
+}
+
+void
+spat_free(spat)
+register SPAT *spat;
+{
+    register SPAT *sp;
+    HENT *entry;
+
+    if (!spat)
+	return;
+    if (spat->spat_runtime) {
+	arg_free(spat->spat_runtime);
+	spat->spat_runtime = Nullarg;
+    }
+    if (spat->spat_repl) {
+	arg_free(spat->spat_repl);
+	spat->spat_repl = Nullarg;
+    }
+    if (spat->spat_short) {
+	str_free(spat->spat_short);
+	spat->spat_short = Nullstr;
+    }
+    if (spat->spat_regexp) {
+	regfree(spat->spat_regexp);
+	spat->spat_regexp = Null(REGEXP*);
+    }
+
+    /* now unlink from spat list */
+
+    for (entry = defstash->tbl_array['_']; entry; entry = entry->hent_next) {
+	register HASH *stash;
+	STAB *stab = (STAB*)entry->hent_val;
+
+	if (!stab)
+	    continue;
+	stash = stab_hash(stab);
+	if (!stash || stash->tbl_spatroot == Null(SPAT*))
+	    continue;
+	if (stash->tbl_spatroot == spat)
+	    stash->tbl_spatroot = spat->spat_next;
+	else {
+	    for (sp = stash->tbl_spatroot;
+	      sp && sp->spat_next != spat;
+	      sp = sp->spat_next)
+		/*SUPPRESS 530*/
+		;
+	    if (sp)
+		sp->spat_next = spat->spat_next;
+	}
+    }
+    Safefree(spat);
+}
+
+/* Recursively descend a command sequence and push the address of any string
+ * that needs saving on recursion onto the tosave array.
+ */
+
+static int
+cmd_tosave(cmd,willsave)
+register CMD *cmd;
+int willsave;				/* willsave passes down the tree */
+{
+    register CMD *head = cmd;
+    int shouldsave = FALSE;		/* shouldsave passes up the tree */
+    int tmpsave;
+    register CMD *lastcmd = Nullcmd;
+
+    while (cmd) {
+	if (cmd->c_expr)
+	    shouldsave |= arg_tosave(cmd->c_expr,willsave);
+	switch (cmd->c_type) {
+	case C_WHILE:
+	    if (cmd->ucmd.ccmd.cc_true) {
+		tmpsave = cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
+
+		/* Here we check to see if the temporary array generated for
+		 * a foreach needs to be localized because of recursion.
+		 */
+		if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
+		    if (lastcmd &&
+		      lastcmd->c_type == C_EXPR &&
+		      lastcmd->c_expr) {
+			ARG *arg = lastcmd->c_expr;
+
+			if (arg->arg_type == O_ASSIGN &&
+			    arg[1].arg_type == A_LEXPR &&
+			    arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY &&
+			    strnEQ("_GEN_",
+			      stab_name(
+				arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
+			      5)) {	/* array generated for foreach */
+			    (void)localize(arg);
+			}
+		    }
+
+		    /* in any event, save the iterator */
+
+		    (void)apush(tosave,cmd->c_short);
+		}
+		shouldsave |= tmpsave;
+	    }
+	    break;
+	case C_BLOCK:
+	case C_ELSE:
+	case C_IF:
+	    if (cmd->ucmd.ccmd.cc_true)
+		shouldsave |= cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
+	    break;
+	case C_EXPR:
+	    if (cmd->ucmd.acmd.ac_expr)
+		shouldsave |= arg_tosave(cmd->ucmd.acmd.ac_expr,willsave);
+	    break;
+	}
+	lastcmd = cmd;
+	cmd = cmd->c_next;
+	if (cmd && cmd == head)		/* reached end of while loop */
+	    break;
+    }
+    return shouldsave;
+}
+
+static int
+arg_tosave(arg,willsave)
+register ARG *arg;
+int willsave;
+{
+    register int i;
+    int shouldsave = FALSE;
+
+    for (i = arg->arg_len; i >= 1; i--) {
+	switch (arg[i].arg_type & A_MASK) {
+	case A_NULL:
+	    break;
+	case A_LEXPR:
+	case A_EXPR:
+	    shouldsave |= arg_tosave(arg[i].arg_ptr.arg_arg,shouldsave);
+	    break;
+	case A_CMD:
+	    shouldsave |= cmd_tosave(arg[i].arg_ptr.arg_cmd,shouldsave);
+	    break;
+	case A_WORD:
+	case A_STAB:
+	case A_LVAL:
+	case A_READ:
+	case A_GLOB:
+	case A_ARYLEN:
+	case A_SINGLE:
+	case A_DOUBLE:
+	case A_BACKTICK:
+	    break;
+	case A_SPAT:
+	    shouldsave |= spat_tosave(arg[i].arg_ptr.arg_spat);
+	    break;
+	}
+    }
+    switch (arg->arg_type) {
+    case O_RETURN:
+	saw_return = TRUE;
+	break;
+    case O_EVAL:
+    case O_SUBR:
+	shouldsave = TRUE;
+	break;
+    }
+    if (willsave)
+	(void)apush(tosave,arg->arg_ptr.arg_str);
+    return shouldsave;
+}
+
+static int
+spat_tosave(spat)
+register SPAT *spat;
+{
+    int shouldsave = FALSE;
+
+    if (spat->spat_runtime)
+	shouldsave |= arg_tosave(spat->spat_runtime,FALSE);
+    if (spat->spat_repl) {
+	shouldsave |= arg_tosave(spat->spat_repl,FALSE);
+    }
+
+    return shouldsave;
+}
+
diff --git a/cons.c.rej b/cons.c.rej
new file mode 100644
index 0000000000..6617f73a34
--- /dev/null
+++ b/cons.c.rej
@@ -0,0 +1,48 @@
+***************
+*** 1,4 ****
+! /* $RCSfile: cons.c,v $$Revision: 4.0.1.3 $$Date: 1992/06/08 12:18:35 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+--- 1,4 ----
+! /* $RCSfile: cons.c,v $$Revision: 4.0.1.4 $$Date: 1993/02/05 19:30:15 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+***************
+*** 6,12 ****
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: cons.c,v $
+!  * Revision 4.0.1.3  1992/06/08  12:18:35  lwall
+   * patch20: removed implicit int declarations on funcions
+   * patch20: deleted some minor memory leaks
+   * patch20: fixed double debug break in foreach with implicit array assignment
+--- 6,15 ----
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: cons.c,v $
+!  * Revision 4.0.1.4  1993/02/05  19:30:15  lwall
+!  * patch36: fixed various little coredump bugs
+!  *
+!  * Revision 4.0.1.3  92/06/08  12:18:35  lwall
+   * patch20: removed implicit int declarations on funcions
+   * patch20: deleted some minor memory leaks
+   * patch20: fixed double debug break in foreach with implicit array assignment
+***************
+*** 15,21 ****
+   * patch20: debugger sometimes displayed wrong source line
+   * patch20: various error messages have been clarified
+   * patch20: an eval block containing a null block or statement could dump core
+!  *
+   * Revision 4.0.1.2  91/11/05  16:15:13  lwall
+   * patch11: debugger got confused over nested subroutine definitions
+   * patch11: prepared for ctype implementations that don't define isascii()
+--- 18,24 ----
+   * patch20: debugger sometimes displayed wrong source line
+   * patch20: various error messages have been clarified
+   * patch20: an eval block containing a null block or statement could dump core
+!  * 
+   * Revision 4.0.1.2  91/11/05  16:15:13  lwall
+   * patch11: debugger got confused over nested subroutine definitions
+   * patch11: prepared for ctype implementations that don't define isascii()
diff --git a/doarg.c b/doarg.c
index ca1014c3bb..483157f589 100644
--- a/doarg.c
+++ b/doarg.c
@@ -208,6 +208,7 @@ int sp;
 			STABSET(str);
 			str_numset(arg->arg_ptr.arg_str, 1.0);
 			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+			str->str_nok = 0;
 			return sp;
 		    }
 		    /*SUPPRESS 560*/
@@ -223,6 +224,7 @@ int sp;
 			STABSET(str);
 			str_numset(arg->arg_ptr.arg_str, 1.0);
 			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+			str->str_nok = 0;
 			return sp;
 		    }
 		    else if (clen) {
@@ -232,6 +234,7 @@ int sp;
 			STABSET(str);
 			str_numset(arg->arg_ptr.arg_str, 1.0);
 			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+			str->str_nok = 0;
 			return sp;
 		    }
 		    else {
@@ -239,6 +242,7 @@ int sp;
 			STABSET(str);
 			str_numset(arg->arg_ptr.arg_str, 1.0);
 			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+			str->str_nok = 0;
 			return sp;
 		    }
 		    /* NOTREACHED */
@@ -268,6 +272,7 @@ int sp;
 		STABSET(str);
 		str_numset(arg->arg_ptr.arg_str, (double)iters);
 		stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+		str->str_nok = 0;
 		return sp;
 	    }
 	    str_numset(arg->arg_ptr.arg_str, 0.0);
@@ -322,6 +327,7 @@ int sp;
 	STABSET(str);
 	str_numset(arg->arg_ptr.arg_str, (double)iters);
 	stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+	str->str_nok = 0;
 	return sp;
     }
     str_numset(arg->arg_ptr.arg_str, 0.0);
diff --git a/doarg.c.orig b/doarg.c.orig
new file mode 100644
index 0000000000..ca1014c3bb
--- /dev/null
+++ b/doarg.c.orig
@@ -0,0 +1,1837 @@
+/* $RCSfile: doarg.c,v $$Revision: 4.0.1.7 $$Date: 92/06/11 21:07:11 $
+ *
+ *    Copyright (c) 1991, 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:	doarg.c,v $
+ * Revision 4.0.1.7  92/06/11  21:07:11  lwall
+ * patch34: join with null list attempted negative allocation
+ * patch34: sprintf("%6.4s", "abcdefg") didn't print "abcd  "
+ * 
+ * Revision 4.0.1.6  92/06/08  12:34:30  lwall
+ * patch20: removed implicit int declarations on funcions
+ * patch20: pattern modifiers i and o didn't interact right
+ * patch20: join() now pre-extends target string to avoid excessive copying
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: subroutines didn't localize $`, $&, $', $1 et al correctly
+ * patch20: usersub routines didn't reclaim temp values soon enough
+ * patch20: ($<,$>) = ... didn't work on some architectures
+ * patch20: added Atari ST portability
+ * 
+ * Revision 4.0.1.5  91/11/11  16:31:58  lwall
+ * patch19: added little-endian pack/unpack options
+ * 
+ * Revision 4.0.1.4  91/11/05  16:35:06  lwall
+ * patch11: /$foo/o optimizer could access deallocated data
+ * patch11: minimum match length calculation in regexp is now cumulative
+ * patch11: added some support for 64-bit integers
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: sprintf() now supports any length of s field
+ * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work
+ * patch11: defined(&$foo) and undef(&$foo) didn't work
+ * 
+ * Revision 4.0.1.3  91/06/10  01:18:41  lwall
+ * patch10: pack(hh,1) dumped core
+ * 
+ * Revision 4.0.1.2  91/06/07  10:42:17  lwall
+ * patch4: new copyright notice
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * patch4: //o and s///o now optimize themselves fully at runtime
+ * patch4: added global modifier for pattern matches
+ * patch4: undef @array disabled "@array" interpolation
+ * patch4: chop("") was returning "\0" rather than ""
+ * patch4: vector logical operations &, | and ^ sometimes returned null string
+ * patch4: syscall couldn't pass numbers with most significant bit set on sparcs
+ * 
+ * Revision 4.0.1.1  91/04/11  17:40:14  lwall
+ * patch1: fixed undefined environ problem
+ * patch1: fixed debugger coredump on subroutines
+ * 
+ * Revision 4.0  91/03/20  01:06:42  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#include <signal.h>
+#endif
+
+extern unsigned char fold[];
+
+#ifdef BUGGY_MSC
+ #pragma function(memcmp)
+#endif /* BUGGY_MSC */
+
+static void doencodes();
+
+int
+do_subst(str,arg,sp)
+STR *str;
+ARG *arg;
+int sp;
+{
+    register SPAT *spat;
+    SPAT *rspat;
+    register STR *dstr;
+    register char *s = str_get(str);
+    char *strend = s + str->str_cur;
+    register char *m;
+    char *c;
+    register char *d;
+    int clen;
+    int iters = 0;
+    int maxiters = (strend - s) + 10;
+    register int i;
+    bool once;
+    char *orig;
+    int safebase;
+
+    rspat = spat = arg[2].arg_ptr.arg_spat;
+    if (!spat || !s)
+	fatal("panic: do_subst");
+    else if (spat->spat_runtime) {
+	nointrp = "|)";
+	(void)eval(spat->spat_runtime,G_SCALAR,sp);
+	m = str_get(dstr = stack->ary_array[sp+1]);
+	nointrp = "";
+	if (spat->spat_regexp) {
+	    regfree(spat->spat_regexp);
+	    spat->spat_regexp = Null(REGEXP*);	/* required if regcomp pukes */
+	}
+	spat->spat_regexp = regcomp(m,m+dstr->str_cur,
+	    spat->spat_flags & SPAT_FOLD);
+	if (spat->spat_flags & SPAT_KEEP) {
+	    if (!(spat->spat_flags & SPAT_FOLD))
+		scanconst(spat, m, dstr->str_cur);
+	    arg_free(spat->spat_runtime);	/* it won't change, so */
+	    spat->spat_runtime = Nullarg;	/* no point compiling again */
+	    hoistmust(spat);
+            if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
+                curcmd->c_flags &= ~CF_OPTIMIZE;
+                opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
+            }
+	}
+    }
+#ifdef DEBUGGING
+    if (debug & 8) {
+	deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
+    }
+#endif
+    safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
+      !sawampersand);
+    if (!spat->spat_regexp->prelen && lastspat)
+	spat = lastspat;
+    orig = m = s;
+    if (hint) {
+	if (hint < s || hint > strend)
+	    fatal("panic: hint in do_match");
+	s = hint;
+	hint = Nullch;
+	if (spat->spat_regexp->regback >= 0) {
+	    s -= spat->spat_regexp->regback;
+	    if (s < m)
+		s = m;
+	}
+	else
+	    s = m;
+    }
+    else if (spat->spat_short) {
+	if (spat->spat_flags & SPAT_SCANFIRST) {
+	    if (str->str_pok & SP_STUDIED) {
+		if (screamfirst[spat->spat_short->str_rare] < 0)
+		    goto nope;
+		else if (!(s = screaminstr(str,spat->spat_short)))
+		    goto nope;
+	    }
+#ifndef lint
+	    else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
+	      spat->spat_short)))
+		goto nope;
+#endif
+	    if (s && spat->spat_regexp->regback >= 0) {
+		++spat->spat_short->str_u.str_useful;
+		s -= spat->spat_regexp->regback;
+		if (s < m)
+		    s = m;
+	    }
+	    else
+		s = m;
+	}
+	else if (!multiline && (*spat->spat_short->str_ptr != *s ||
+	  bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
+	    goto nope;
+	if (--spat->spat_short->str_u.str_useful < 0) {
+	    str_free(spat->spat_short);
+	    spat->spat_short = Nullstr;	/* opt is being useless */
+	}
+    }
+    once = !(rspat->spat_flags & SPAT_GLOBAL);
+    if (rspat->spat_flags & SPAT_CONST) {	/* known replacement string? */
+	if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
+	    dstr = rspat->spat_repl[1].arg_ptr.arg_str;
+	else {					/* constant over loop, anyway */
+	    (void)eval(rspat->spat_repl,G_SCALAR,sp);
+	    dstr = stack->ary_array[sp+1];
+	}
+	c = str_get(dstr);
+	clen = dstr->str_cur;
+	if (clen <= spat->spat_regexp->minlen) {
+					/* can do inplace substitution */
+	    if (regexec(spat->spat_regexp, s, strend, orig, 0,
+	      str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
+		if (spat->spat_regexp->subbase) /* oops, no we can't */
+		    goto long_way;
+		d = s;
+		lastspat = spat;
+		str->str_pok = SP_VALID;	/* disable possible screamer */
+		if (once) {
+		    m = spat->spat_regexp->startp[0];
+		    d = spat->spat_regexp->endp[0];
+		    s = orig;
+		    if (m - s > strend - d) {	/* faster to shorten from end */
+			if (clen) {
+			    Copy(c, m, clen, char);
+			    m += clen;
+			}
+			i = strend - d;
+			if (i > 0) {
+			    Move(d, m, i, char);
+			    m += i;
+			}
+			*m = '\0';
+			str->str_cur = m - s;
+			STABSET(str);
+			str_numset(arg->arg_ptr.arg_str, 1.0);
+			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+			return sp;
+		    }
+		    /*SUPPRESS 560*/
+		    else if (i = m - s) {	/* faster from front */
+			d -= clen;
+			m = d;
+			str_chop(str,d-i);
+			s += i;
+			while (i--)
+			    *--d = *--s;
+			if (clen)
+			    Copy(c, m, clen, char);
+			STABSET(str);
+			str_numset(arg->arg_ptr.arg_str, 1.0);
+			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+			return sp;
+		    }
+		    else if (clen) {
+			d -= clen;
+			str_chop(str,d);
+			Copy(c,d,clen,char);
+			STABSET(str);
+			str_numset(arg->arg_ptr.arg_str, 1.0);
+			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+			return sp;
+		    }
+		    else {
+			str_chop(str,d);
+			STABSET(str);
+			str_numset(arg->arg_ptr.arg_str, 1.0);
+			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+			return sp;
+		    }
+		    /* NOTREACHED */
+		}
+		do {
+		    if (iters++ > maxiters)
+			fatal("Substitution loop");
+		    m = spat->spat_regexp->startp[0];
+		    /*SUPPRESS 560*/
+		    if (i = m - s) {
+			if (s != d)
+			    Move(s,d,i,char);
+			d += i;
+		    }
+		    if (clen) {
+			Copy(c,d,clen,char);
+			d += clen;
+		    }
+		    s = spat->spat_regexp->endp[0];
+		} while (regexec(spat->spat_regexp, s, strend, orig, s == m,
+		    Nullstr, TRUE));	/* (don't match same null twice) */
+		if (s != d) {
+		    i = strend - s;
+		    str->str_cur = d - str->str_ptr + i;
+		    Move(s,d,i+1,char);		/* include the Null */
+		}
+		STABSET(str);
+		str_numset(arg->arg_ptr.arg_str, (double)iters);
+		stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+		return sp;
+	    }
+	    str_numset(arg->arg_ptr.arg_str, 0.0);
+	    stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+	    return sp;
+	}
+    }
+    else
+	c = Nullch;
+    if (regexec(spat->spat_regexp, s, strend, orig, 0,
+      str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
+    long_way:
+	dstr = Str_new(25,str_len(str));
+	str_nset(dstr,m,s-m);
+	if (spat->spat_regexp->subbase)
+	    curspat = spat;
+	lastspat = spat;
+	do {
+	    if (iters++ > maxiters)
+		fatal("Substitution loop");
+	    if (spat->spat_regexp->subbase
+	      && spat->spat_regexp->subbase != orig) {
+		m = s;
+		s = orig;
+		orig = spat->spat_regexp->subbase;
+		s = orig + (m - s);
+		strend = s + (strend - m);
+	    }
+	    m = spat->spat_regexp->startp[0];
+	    str_ncat(dstr,s,m-s);
+	    s = spat->spat_regexp->endp[0];
+	    if (c) {
+		if (clen)
+		    str_ncat(dstr,c,clen);
+	    }
+	    else {
+		char *mysubbase = spat->spat_regexp->subbase;
+
+		spat->spat_regexp->subbase = Nullch;	/* so recursion works */
+		(void)eval(rspat->spat_repl,G_SCALAR,sp);
+		str_scat(dstr,stack->ary_array[sp+1]);
+		if (spat->spat_regexp->subbase)
+		    Safefree(spat->spat_regexp->subbase);
+		spat->spat_regexp->subbase = mysubbase;
+	    }
+	    if (once)
+		break;
+	} while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
+	    safebase));
+	str_ncat(dstr,s,strend - s);
+	str_replace(str,dstr);
+	STABSET(str);
+	str_numset(arg->arg_ptr.arg_str, (double)iters);
+	stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+	return sp;
+    }
+    str_numset(arg->arg_ptr.arg_str, 0.0);
+    stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+    return sp;
+
+nope:
+    ++spat->spat_short->str_u.str_useful;
+    str_numset(arg->arg_ptr.arg_str, 0.0);
+    stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+    return sp;
+}
+#ifdef BUGGY_MSC
+ #pragma intrinsic(memcmp)
+#endif /* BUGGY_MSC */
+
+int
+do_trans(str,arg)
+STR *str;
+ARG *arg;
+{
+    register short *tbl;
+    register char *s;
+    register int matches = 0;
+    register int ch;
+    register char *send;
+    register char *d;
+    register int squash = arg[2].arg_len & 1;
+
+    tbl = (short*) arg[2].arg_ptr.arg_cval;
+    s = str_get(str);
+    send = s + str->str_cur;
+    if (!tbl || !s)
+	fatal("panic: do_trans");
+#ifdef DEBUGGING
+    if (debug & 8) {
+	deb("2.TBL\n");
+    }
+#endif
+    if (!arg[2].arg_len) {
+	while (s < send) {
+	    if ((ch = tbl[*s & 0377]) >= 0) {
+		matches++;
+		*s = ch;
+	    }
+	    s++;
+	}
+    }
+    else {
+	d = s;
+	while (s < send) {
+	    if ((ch = tbl[*s & 0377]) >= 0) {
+		*d = ch;
+		if (matches++ && squash) {
+		    if (d[-1] == *d)
+			matches--;
+		    else
+			d++;
+		}
+		else
+		    d++;
+	    }
+	    else if (ch == -1)		/* -1 is unmapped character */
+		*d++ = *s;		/* -2 is delete character */
+	    s++;
+	}
+	matches += send - d;	/* account for disappeared chars */
+	*d = '\0';
+	str->str_cur = d - str->str_ptr;
+    }
+    STABSET(str);
+    return matches;
+}
+
+void
+do_join(str,arglast)
+register STR *str;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register char *delim = str_get(st[sp]);
+    register STRLEN len;
+    int delimlen = st[sp]->str_cur;
+
+    st += sp + 1;
+
+    len = (items > 0 ? (delimlen * (items - 1) ) : 0);
+    if (str->str_len < len + items) {	/* current length is way too short */
+	while (items-- > 0) {
+	    if (*st)
+		len += (*st)->str_cur;
+	    st++;
+	}
+	STR_GROW(str, len + 1);		/* so try to pre-extend */
+
+	items = arglast[2] - sp;
+	st -= items;
+    }
+
+    if (items-- > 0)
+	str_sset(str, *st++);
+    else
+	str_set(str,"");
+    len = delimlen;
+    if (len) {
+	for (; items > 0; items--,st++) {
+	    str_ncat(str,delim,len);
+	    str_scat(str,*st);
+	}
+    }
+    else {
+	for (; items > 0; items--,st++)
+	    str_scat(str,*st);
+    }
+    STABSET(str);
+}
+
+void
+do_pack(str,arglast)
+register STR *str;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items;
+    register char *pat = str_get(st[sp]);
+    register char *patend = pat + st[sp]->str_cur;
+    register int len;
+    int datumtype;
+    STR *fromstr;
+    /*SUPPRESS 442*/
+    static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
+    static char *space10 = "          ";
+
+    /* These must not be in registers: */
+    char achar;
+    short ashort;
+    int aint;
+    unsigned int auint;
+    long along;
+    unsigned long aulong;
+#ifdef QUAD
+    quad aquad;
+    unsigned quad auquad;
+#endif
+    char *aptr;
+    float afloat;
+    double adouble;
+
+    items = arglast[2] - sp;
+    st += ++sp;
+    str_nset(str,"",0);
+    while (pat < patend) {
+#define NEXTFROM (items-- > 0 ? *st++ : &str_no)
+	datumtype = *pat++;
+	if (*pat == '*') {
+	    len = index("@Xxu",datumtype) ? 0 : items;
+	    pat++;
+	}
+	else if (isDIGIT(*pat)) {
+	    len = *pat++ - '0';
+	    while (isDIGIT(*pat))
+		len = (len * 10) + (*pat++ - '0');
+	}
+	else
+	    len = 1;
+	switch(datumtype) {
+	default:
+	    break;
+	case '%':
+	    fatal("% may only be used in unpack");
+	case '@':
+	    len -= str->str_cur;
+	    if (len > 0)
+		goto grow;
+	    len = -len;
+	    if (len > 0)
+		goto shrink;
+	    break;
+	case 'X':
+	  shrink:
+	    if (str->str_cur < len)
+		fatal("X outside of string");
+	    str->str_cur -= len;
+	    str->str_ptr[str->str_cur] = '\0';
+	    break;
+	case 'x':
+	  grow:
+	    while (len >= 10) {
+		str_ncat(str,null10,10);
+		len -= 10;
+	    }
+	    str_ncat(str,null10,len);
+	    break;
+	case 'A':
+	case 'a':
+	    fromstr = NEXTFROM;
+	    aptr = str_get(fromstr);
+	    if (pat[-1] == '*')
+		len = fromstr->str_cur;
+	    if (fromstr->str_cur > len)
+		str_ncat(str,aptr,len);
+	    else {
+		str_ncat(str,aptr,fromstr->str_cur);
+		len -= fromstr->str_cur;
+		if (datumtype == 'A') {
+		    while (len >= 10) {
+			str_ncat(str,space10,10);
+			len -= 10;
+		    }
+		    str_ncat(str,space10,len);
+		}
+		else {
+		    while (len >= 10) {
+			str_ncat(str,null10,10);
+			len -= 10;
+		    }
+		    str_ncat(str,null10,len);
+		}
+	    }
+	    break;
+	case 'B':
+	case 'b':
+	    {
+		char *savepat = pat;
+		int saveitems;
+
+		fromstr = NEXTFROM;
+		saveitems = items;
+		aptr = str_get(fromstr);
+		if (pat[-1] == '*')
+		    len = fromstr->str_cur;
+		pat = aptr;
+		aint = str->str_cur;
+		str->str_cur += (len+7)/8;
+		STR_GROW(str, str->str_cur + 1);
+		aptr = str->str_ptr + aint;
+		if (len > fromstr->str_cur)
+		    len = fromstr->str_cur;
+		aint = len;
+		items = 0;
+		if (datumtype == 'B') {
+		    for (len = 0; len++ < aint;) {
+			items |= *pat++ & 1;
+			if (len & 7)
+			    items <<= 1;
+			else {
+			    *aptr++ = items & 0xff;
+			    items = 0;
+			}
+		    }
+		}
+		else {
+		    for (len = 0; len++ < aint;) {
+			if (*pat++ & 1)
+			    items |= 128;
+			if (len & 7)
+			    items >>= 1;
+			else {
+			    *aptr++ = items & 0xff;
+			    items = 0;
+			}
+		    }
+		}
+		if (aint & 7) {
+		    if (datumtype == 'B')
+			items <<= 7 - (aint & 7);
+		    else
+			items >>= 7 - (aint & 7);
+		    *aptr++ = items & 0xff;
+		}
+		pat = str->str_ptr + str->str_cur;
+		while (aptr <= pat)
+		    *aptr++ = '\0';
+
+		pat = savepat;
+		items = saveitems;
+	    }
+	    break;
+	case 'H':
+	case 'h':
+	    {
+		char *savepat = pat;
+		int saveitems;
+
+		fromstr = NEXTFROM;
+		saveitems = items;
+		aptr = str_get(fromstr);
+		if (pat[-1] == '*')
+		    len = fromstr->str_cur;
+		pat = aptr;
+		aint = str->str_cur;
+		str->str_cur += (len+1)/2;
+		STR_GROW(str, str->str_cur + 1);
+		aptr = str->str_ptr + aint;
+		if (len > fromstr->str_cur)
+		    len = fromstr->str_cur;
+		aint = len;
+		items = 0;
+		if (datumtype == 'H') {
+		    for (len = 0; len++ < aint;) {
+			if (isALPHA(*pat))
+			    items |= ((*pat++ & 15) + 9) & 15;
+			else
+			    items |= *pat++ & 15;
+			if (len & 1)
+			    items <<= 4;
+			else {
+			    *aptr++ = items & 0xff;
+			    items = 0;
+			}
+		    }
+		}
+		else {
+		    for (len = 0; len++ < aint;) {
+			if (isALPHA(*pat))
+			    items |= (((*pat++ & 15) + 9) & 15) << 4;
+			else
+			    items |= (*pat++ & 15) << 4;
+			if (len & 1)
+			    items >>= 4;
+			else {
+			    *aptr++ = items & 0xff;
+			    items = 0;
+			}
+		    }
+		}
+		if (aint & 1)
+		    *aptr++ = items & 0xff;
+		pat = str->str_ptr + str->str_cur;
+		while (aptr <= pat)
+		    *aptr++ = '\0';
+
+		pat = savepat;
+		items = saveitems;
+	    }
+	    break;
+	case 'C':
+	case 'c':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aint = (int)str_gnum(fromstr);
+		achar = aint;
+		str_ncat(str,&achar,sizeof(char));
+	    }
+	    break;
+	/* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
+	case 'f':
+	case 'F':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		afloat = (float)str_gnum(fromstr);
+		str_ncat(str, (char *)&afloat, sizeof (float));
+	    }
+	    break;
+	case 'd':
+	case 'D':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		adouble = (double)str_gnum(fromstr);
+		str_ncat(str, (char *)&adouble, sizeof (double));
+	    }
+	    break;
+	case 'n':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		ashort = (short)str_gnum(fromstr);
+#ifdef HAS_HTONS
+		ashort = htons(ashort);
+#endif
+		str_ncat(str,(char*)&ashort,sizeof(short));
+	    }
+	    break;
+	case 'v':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		ashort = (short)str_gnum(fromstr);
+#ifdef HAS_HTOVS
+		ashort = htovs(ashort);
+#endif
+		str_ncat(str,(char*)&ashort,sizeof(short));
+	    }
+	    break;
+	case 'S':
+	case 's':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		ashort = (short)str_gnum(fromstr);
+		str_ncat(str,(char*)&ashort,sizeof(short));
+	    }
+	    break;
+	case 'I':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		auint = U_I(str_gnum(fromstr));
+		str_ncat(str,(char*)&auint,sizeof(unsigned int));
+	    }
+	    break;
+	case 'i':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aint = (int)str_gnum(fromstr);
+		str_ncat(str,(char*)&aint,sizeof(int));
+	    }
+	    break;
+	case 'N':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aulong = U_L(str_gnum(fromstr));
+#ifdef HAS_HTONL
+		aulong = htonl(aulong);
+#endif
+		str_ncat(str,(char*)&aulong,sizeof(unsigned long));
+	    }
+	    break;
+	case 'V':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aulong = U_L(str_gnum(fromstr));
+#ifdef HAS_HTOVL
+		aulong = htovl(aulong);
+#endif
+		str_ncat(str,(char*)&aulong,sizeof(unsigned long));
+	    }
+	    break;
+	case 'L':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aulong = U_L(str_gnum(fromstr));
+		str_ncat(str,(char*)&aulong,sizeof(unsigned long));
+	    }
+	    break;
+	case 'l':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		along = (long)str_gnum(fromstr);
+		str_ncat(str,(char*)&along,sizeof(long));
+	    }
+	    break;
+#ifdef QUAD
+	case 'Q':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		auquad = (unsigned quad)str_gnum(fromstr);
+		str_ncat(str,(char*)&auquad,sizeof(unsigned quad));
+	    }
+	    break;
+	case 'q':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aquad = (quad)str_gnum(fromstr);
+		str_ncat(str,(char*)&aquad,sizeof(quad));
+	    }
+	    break;
+#endif /* QUAD */
+	case 'p':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aptr = str_get(fromstr);
+		str_ncat(str,(char*)&aptr,sizeof(char*));
+	    }
+	    break;
+	case 'u':
+	    fromstr = NEXTFROM;
+	    aptr = str_get(fromstr);
+	    aint = fromstr->str_cur;
+	    STR_GROW(str,aint * 4 / 3);
+	    if (len <= 1)
+		len = 45;
+	    else
+		len = len / 3 * 3;
+	    while (aint > 0) {
+		int todo;
+
+		if (aint > len)
+		    todo = len;
+		else
+		    todo = aint;
+		doencodes(str, aptr, todo);
+		aint -= todo;
+		aptr += todo;
+	    }
+	    break;
+	}
+    }
+    STABSET(str);
+}
+#undef NEXTFROM
+
+static void
+doencodes(str, s, len)
+register STR *str;
+register char *s;
+register int len;
+{
+    char hunk[5];
+
+    *hunk = len + ' ';
+    str_ncat(str, hunk, 1);
+    hunk[4] = '\0';
+    while (len > 0) {
+	hunk[0] = ' ' + (077 & (*s >> 2));
+	hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
+	hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
+	hunk[3] = ' ' + (077 & (s[2] & 077));
+	str_ncat(str, hunk, 4);
+	s += 3;
+	len -= 3;
+    }
+    for (s = str->str_ptr; *s; s++) {
+	if (*s == ' ')
+	    *s = '`';
+    }
+    str_ncat(str, "\n", 1);
+}
+
+void
+do_sprintf(str,len,sarg)
+register STR *str;
+register int len;
+register STR **sarg;
+{
+    register char *s;
+    register char *t;
+    register char *f;
+    bool dolong;
+#ifdef QUAD
+    bool doquad;
+#endif /* QUAD */
+    char ch;
+    static STR *sargnull = &str_no;
+    register char *send;
+    register STR *arg;
+    char *xs;
+    int xlen;
+    int pre;
+    int post;
+    double value;
+
+    str_set(str,"");
+    len--;			/* don't count pattern string */
+    t = s = str_get(*sarg);
+    send = s + (*sarg)->str_cur;
+    sarg++;
+    for ( ; ; len--) {
+
+	/*SUPPRESS 560*/
+	if (len <= 0 || !(arg = *sarg++))
+	    arg = sargnull;
+
+	/*SUPPRESS 530*/
+	for ( ; t < send && *t != '%'; t++) ;
+	if (t >= send)
+	    break;		/* end of format string, ignore extra args */
+	f = t;
+	*buf = '\0';
+	xs = buf;
+#ifdef QUAD
+	doquad =
+#endif /* QUAD */
+	dolong = FALSE;
+	pre = post = 0;
+	for (t++; t < send; t++) {
+	    switch (*t) {
+	    default:
+		ch = *(++t);
+		*t = '\0';
+		(void)sprintf(xs,f);
+		len++, sarg--;
+		xlen = strlen(xs);
+		break;
+	    case '0': case '1': case '2': case '3': case '4':
+	    case '5': case '6': case '7': case '8': case '9': 
+	    case '.': case '#': case '-': case '+': case ' ':
+		continue;
+	    case 'l':
+#ifdef QUAD
+		if (dolong) {
+		    dolong = FALSE;
+		    doquad = TRUE;
+		} else
+#endif
+		dolong = TRUE;
+		continue;
+	    case 'c':
+		ch = *(++t);
+		*t = '\0';
+		xlen = (int)str_gnum(arg);
+		if (strEQ(f,"%c")) { /* some printfs fail on null chars */
+		    *xs = xlen;
+		    xs[1] = '\0';
+		    xlen = 1;
+		}
+		else {
+		    (void)sprintf(xs,f,xlen);
+		    xlen = strlen(xs);
+		}
+		break;
+	    case 'D':
+		dolong = TRUE;
+		/* FALL THROUGH */
+	    case 'd':
+		ch = *(++t);
+		*t = '\0';
+#ifdef QUAD
+		if (doquad)
+		    (void)sprintf(buf,s,(quad)str_gnum(arg));
+		else
+#endif
+		if (dolong)
+		    (void)sprintf(xs,f,(long)str_gnum(arg));
+		else
+		    (void)sprintf(xs,f,(int)str_gnum(arg));
+		xlen = strlen(xs);
+		break;
+	    case 'X': case 'O':
+		dolong = TRUE;
+		/* FALL THROUGH */
+	    case 'x': case 'o': case 'u':
+		ch = *(++t);
+		*t = '\0';
+		value = str_gnum(arg);
+#ifdef QUAD
+		if (doquad)
+		    (void)sprintf(buf,s,(unsigned quad)value);
+		else
+#endif
+		if (dolong)
+		    (void)sprintf(xs,f,U_L(value));
+		else
+		    (void)sprintf(xs,f,U_I(value));
+		xlen = strlen(xs);
+		break;
+	    case 'E': case 'e': case 'f': case 'G': case 'g':
+		ch = *(++t);
+		*t = '\0';
+		(void)sprintf(xs,f,str_gnum(arg));
+		xlen = strlen(xs);
+		break;
+	    case 's':
+		ch = *(++t);
+		*t = '\0';
+		xs = str_get(arg);
+		xlen = arg->str_cur;
+		if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0'
+		  && xlen == sizeof(STBP)) {
+		    STR *tmpstr = Str_new(24,0);
+
+		    stab_efullname(tmpstr, ((STAB*)arg)); /* a stab value! */
+		    sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
+					/* reformat to non-binary */
+		    xs = tokenbuf;
+		    xlen = strlen(tokenbuf);
+		    str_free(tmpstr);
+		}
+		if (strEQ(f,"%s")) {	/* some printfs fail on >128 chars */
+		    break;		/* so handle simple cases */
+		}
+		else if (f[1] == '-') {
+		    char *mp = index(f, '.');
+		    int min = atoi(f+2);
+
+		    if (mp) {
+			int max = atoi(mp+1);
+
+			if (xlen > max)
+			    xlen = max;
+		    }
+		    if (xlen < min)
+			post = min - xlen;
+		    break;
+		}
+		else if (isDIGIT(f[1])) {
+		    char *mp = index(f, '.');
+		    int min = atoi(f+1);
+
+		    if (mp) {
+			int max = atoi(mp+1);
+
+			if (xlen > max)
+			    xlen = max;
+		    }
+		    if (xlen < min)
+			pre = min - xlen;
+		    break;
+		}
+		strcpy(tokenbuf+64,f);	/* sprintf($s,...$s...) */
+		*t = ch;
+		(void)sprintf(buf,tokenbuf+64,xs);
+		xs = buf;
+		xlen = strlen(xs);
+		break;
+	    }
+	    /* end of switch, copy results */
+	    *t = ch;
+	    STR_GROW(str, str->str_cur + (f - s) + xlen + 1 + pre + post);
+	    str_ncat(str, s, f - s);
+	    if (pre) {
+		repeatcpy(str->str_ptr + str->str_cur, " ", 1, pre);
+		str->str_cur += pre;
+	    }
+	    str_ncat(str, xs, xlen);
+	    if (post) {
+		repeatcpy(str->str_ptr + str->str_cur, " ", 1, post);
+		str->str_cur += post;
+	    }
+	    s = t;
+	    break;		/* break from for loop */
+	}
+    }
+    str_ncat(str, s, t - s);
+    STABSET(str);
+}
+
+STR *
+do_push(ary,arglast)
+register ARRAY *ary;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register STR *str = &str_undef;
+
+    for (st += ++sp; items > 0; items--,st++) {
+	str = Str_new(26,0);
+	if (*st)
+	    str_sset(str,*st);
+	(void)apush(ary,str);
+    }
+    return str;
+}
+
+void
+do_unshift(ary,arglast)
+register ARRAY *ary;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register STR *str;
+    register int i;
+
+    aunshift(ary,items);
+    i = 0;
+    for (st += ++sp; i < items; i++,st++) {
+	str = Str_new(27,0);
+	str_sset(str,*st);
+	(void)astore(ary,i,str);
+    }
+}
+
+int
+do_subr(arg,gimme,arglast)
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register SUBR *sub;
+    SPAT * VOLATILE oldspat = curspat;
+    STR *str;
+    STAB *stab;
+    int oldsave = savestack->ary_fill;
+    int oldtmps_base = tmps_base;
+    int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
+    register CSV *csv;
+
+    if ((arg[1].arg_type & A_MASK) == A_WORD)
+	stab = arg[1].arg_ptr.arg_stab;
+    else {
+	STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
+
+	if (tmpstr)
+	    stab = stabent(str_get(tmpstr),TRUE);
+	else
+	    stab = Nullstab;
+    }
+    if (!stab)
+	fatal("Undefined subroutine called");
+    if (!(sub = stab_sub(stab))) {
+	STR *tmpstr = arg[0].arg_ptr.arg_str;
+
+	stab_efullname(tmpstr, stab);
+	fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
+    }
+    if (arg->arg_type == O_DBSUBR && !sub->usersub) {
+	str = stab_val(DBsub);
+	saveitem(str);
+	stab_efullname(str,stab);
+	sub = stab_sub(DBsub);
+	if (!sub)
+	    fatal("No DBsub routine");
+    }
+    str = Str_new(15, sizeof(CSV));
+    str->str_state = SS_SCSV;
+    (void)apush(savestack,str);
+    csv = (CSV*)str->str_ptr;
+    csv->sub = sub;
+    csv->stab = stab;
+    csv->curcsv = curcsv;
+    csv->curcmd = curcmd;
+    csv->depth = sub->depth;
+    csv->wantarray = gimme;
+    csv->hasargs = hasargs;
+    curcsv = csv;
+    tmps_base = tmps_max;
+    if (sub->usersub) {
+	csv->hasargs = 0;
+	csv->savearray = Null(ARRAY*);;
+	csv->argarray = Null(ARRAY*);
+	st[sp] = arg->arg_ptr.arg_str;
+	if (!hasargs)
+	    items = 0;
+	sp = (*sub->usersub)(sub->userindex,sp,items);
+    }
+    else {
+	if (hasargs) {
+	    csv->savearray = stab_xarray(defstab);
+	    csv->argarray = afake(defstab, items, &st[sp+1]);
+	    stab_xarray(defstab) = csv->argarray;
+	}
+	sub->depth++;
+	if (sub->depth >= 2) {	/* save temporaries on recursion? */
+	    if (sub->depth == 100 && dowarn)
+		warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
+	    savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
+	}
+	sp = cmd_exec(sub->cmd,gimme, --sp);	/* so do it already */
+    }
+
+    st = stack->ary_array;
+    tmps_base = oldtmps_base;
+    for (items = arglast[0] + 1; items <= sp; items++)
+	st[items] = str_mortal(st[items]);
+	    /* in case restore wipes old str */
+    restorelist(oldsave);
+    curspat = oldspat;
+    return sp;
+}
+
+int
+do_assign(arg,gimme,arglast)
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+
+    register STR **st = stack->ary_array;
+    STR **firstrelem = st + arglast[1] + 1;
+    STR **firstlelem = st + arglast[0] + 1;
+    STR **lastrelem = st + arglast[2];
+    STR **lastlelem = st + arglast[1];
+    register STR **relem;
+    register STR **lelem;
+
+    register STR *str;
+    register ARRAY *ary;
+    register int makelocal;
+    HASH *hash;
+    int i;
+
+    makelocal = (arg->arg_flags & AF_LOCAL) != 0;
+    localizing = makelocal;
+    delaymagic = DM_DELAY;		/* catch simultaneous items */
+
+    /* If there's a common identifier on both sides we have to take
+     * special care that assigning the identifier on the left doesn't
+     * clobber a value on the right that's used later in the list.
+     */
+    if (arg->arg_flags & AF_COMMON) {
+	for (relem = firstrelem; relem <= lastrelem; relem++) {
+	    /*SUPPRESS 560*/
+	    if (str = *relem)
+		*relem = str_mortal(str);
+	}
+    }
+    relem = firstrelem;
+    lelem = firstlelem;
+    ary = Null(ARRAY*);
+    hash = Null(HASH*);
+    while (lelem <= lastlelem) {
+	str = *lelem++;
+	if (str->str_state >= SS_HASH) {
+	    if (str->str_state == SS_ARY) {
+		if (makelocal)
+		    ary = saveary(str->str_u.str_stab);
+		else {
+		    ary = stab_array(str->str_u.str_stab);
+		    ary->ary_fill = -1;
+		}
+		i = 0;
+		while (relem <= lastrelem) {	/* gobble up all the rest */
+		    str = Str_new(28,0);
+		    if (*relem)
+			str_sset(str,*relem);
+		    *(relem++) = str;
+		    (void)astore(ary,i++,str);
+		}
+	    }
+	    else if (str->str_state == SS_HASH) {
+		char *tmps;
+		STR *tmpstr;
+		int magic = 0;
+		STAB *tmpstab = str->str_u.str_stab;
+
+		if (makelocal)
+		    hash = savehash(str->str_u.str_stab);
+		else {
+		    hash = stab_hash(str->str_u.str_stab);
+		    if (tmpstab == envstab) {
+			magic = 'E';
+			environ[0] = Nullch;
+		    }
+		    else if (tmpstab == sigstab) {
+			magic = 'S';
+#ifndef NSIG
+#define NSIG 32
+#endif
+			for (i = 1; i < NSIG; i++)
+			    signal(i, SIG_DFL);	/* crunch, crunch, crunch */
+		    }
+#ifdef SOME_DBM
+		    else if (hash->tbl_dbm)
+			magic = 'D';
+#endif
+		    hclear(hash, magic == 'D');	/* wipe any dbm file too */
+
+		}
+		while (relem < lastrelem) {	/* gobble up all the rest */
+		    if (*relem)
+			str = *(relem++);
+		    else
+			str = &str_no, relem++;
+		    tmps = str_get(str);
+		    tmpstr = Str_new(29,0);
+		    if (*relem)
+			str_sset(tmpstr,*relem);	/* value */
+		    *(relem++) = tmpstr;
+		    (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
+		    if (magic) {
+			str_magic(tmpstr, tmpstab, magic, tmps, str->str_cur);
+			stabset(tmpstr->str_magic, tmpstr);
+		    }
+		}
+	    }
+	    else
+		fatal("panic: do_assign");
+	}
+	else {
+	    if (makelocal)
+		saveitem(str);
+	    if (relem <= lastrelem) {
+		str_sset(str, *relem);
+		*(relem++) = str;
+	    }
+	    else {
+		str_sset(str, &str_undef);
+		if (gimme == G_ARRAY) {
+		    i = ++lastrelem - firstrelem;
+		    relem++;		/* tacky, I suppose */
+		    astore(stack,i,str);
+		    if (st != stack->ary_array) {
+			st = stack->ary_array;
+			firstrelem = st + arglast[1] + 1;
+			firstlelem = st + arglast[0] + 1;
+			lastlelem = st + arglast[1];
+			lastrelem = st + i;
+			relem = lastrelem + 1;
+		    }
+		}
+	    }
+	    STABSET(str);
+	}
+    }
+    if (delaymagic & ~DM_DELAY) {
+	if (delaymagic & DM_UID) {
+#ifdef HAS_SETREUID
+	    (void)setreuid(uid,euid);
+#else /* not HAS_SETREUID */
+#ifdef HAS_SETRUID
+	    if ((delaymagic & DM_UID) == DM_RUID) {
+		(void)setruid(uid);
+		delaymagic =~ DM_RUID;
+	    }
+#endif /* HAS_SETRUID */
+#ifdef HAS_SETEUID
+	    if ((delaymagic & DM_UID) == DM_EUID) {
+		(void)seteuid(uid);
+		delaymagic =~ DM_EUID;
+	    }
+#endif /* HAS_SETEUID */
+	    if (delaymagic & DM_UID) {
+		if (uid != euid)
+		    fatal("No setreuid available");
+		(void)setuid(uid);
+	    }
+#endif /* not HAS_SETREUID */
+	    uid = (int)getuid();
+	    euid = (int)geteuid();
+	}
+	if (delaymagic & DM_GID) {
+#ifdef HAS_SETREGID
+	    (void)setregid(gid,egid);
+#else /* not HAS_SETREGID */
+#ifdef HAS_SETRGID
+	    if ((delaymagic & DM_GID) == DM_RGID) {
+		(void)setrgid(gid);
+		delaymagic =~ DM_RGID;
+	    }
+#endif /* HAS_SETRGID */
+#ifdef HAS_SETEGID
+	    if ((delaymagic & DM_GID) == DM_EGID) {
+		(void)setegid(gid);
+		delaymagic =~ DM_EGID;
+	    }
+#endif /* HAS_SETEGID */
+	    if (delaymagic & DM_GID) {
+		if (gid != egid)
+		    fatal("No setregid available");
+		(void)setgid(gid);
+	    }
+#endif /* not HAS_SETREGID */
+	    gid = (int)getgid();
+	    egid = (int)getegid();
+	}
+    }
+    delaymagic = 0;
+    localizing = FALSE;
+    if (gimme == G_ARRAY) {
+	i = lastrelem - firstrelem + 1;
+	if (ary || hash)
+	    Copy(firstrelem, firstlelem, i, STR*);
+	return arglast[0] + i;
+    }
+    else {
+	str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
+	*firstlelem = arg->arg_ptr.arg_str;
+	return arglast[0] + 1;
+    }
+}
+
+int					/*SUPPRESS 590*/
+do_study(str,arg,gimme,arglast)
+STR *str;
+ARG *arg;
+int gimme;
+int *arglast;
+{
+    register unsigned char *s;
+    register int pos = str->str_cur;
+    register int ch;
+    register int *sfirst;
+    register int *snext;
+    static int maxscream = -1;
+    static STR *lastscream = Nullstr;
+    int retval;
+    int retarg = arglast[0] + 1;
+
+#ifndef lint
+    s = (unsigned char*)(str_get(str));
+#else
+    s = Null(unsigned char*);
+#endif
+    if (lastscream)
+	lastscream->str_pok &= ~SP_STUDIED;
+    lastscream = str;
+    if (pos <= 0) {
+	retval = 0;
+	goto ret;
+    }
+    if (pos > maxscream) {
+	if (maxscream < 0) {
+	    maxscream = pos + 80;
+	    New(301,screamfirst, 256, int);
+	    New(302,screamnext, maxscream, int);
+	}
+	else {
+	    maxscream = pos + pos / 4;
+	    Renew(screamnext, maxscream, int);
+	}
+    }
+
+    sfirst = screamfirst;
+    snext = screamnext;
+
+    if (!sfirst || !snext)
+	fatal("do_study: out of memory");
+
+    for (ch = 256; ch; --ch)
+	*sfirst++ = -1;
+    sfirst -= 256;
+
+    while (--pos >= 0) {
+	ch = s[pos];
+	if (sfirst[ch] >= 0)
+	    snext[pos] = sfirst[ch] - pos;
+	else
+	    snext[pos] = -pos;
+	sfirst[ch] = pos;
+
+	/* If there were any case insensitive searches, we must assume they
+	 * all are.  This speeds up insensitive searches much more than
+	 * it slows down sensitive ones.
+	 */
+	if (sawi)
+	    sfirst[fold[ch]] = pos;
+    }
+
+    str->str_pok |= SP_STUDIED;
+    retval = 1;
+  ret:
+    str_numset(arg->arg_ptr.arg_str,(double)retval);
+    stack->ary_array[retarg] = arg->arg_ptr.arg_str;
+    return retarg;
+}
+
+int					/*SUPPRESS 590*/
+do_defined(str,arg,gimme,arglast)
+STR *str;
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register int type;
+    register int retarg = arglast[0] + 1;
+    int retval;
+    ARRAY *ary;
+    HASH *hash;
+
+    if ((arg[1].arg_type & A_MASK) != A_LEXPR)
+	fatal("Illegal argument to defined()");
+    arg = arg[1].arg_ptr.arg_arg;
+    type = arg->arg_type;
+
+    if (type == O_SUBR || type == O_DBSUBR) {
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
+	else {
+	    STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
+
+	    retval = tmpstr && stab_sub(stabent(str_get(tmpstr),TRUE)) != 0;
+	}
+    }
+    else if (type == O_ARRAY || type == O_LARRAY ||
+	     type == O_ASLICE || type == O_LASLICE )
+	retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0
+	    && ary->ary_max >= 0 );
+    else if (type == O_HASH || type == O_LHASH ||
+	     type == O_HSLICE || type == O_LHSLICE )
+	retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0
+	    && hash->tbl_array);
+    else
+	retval = FALSE;
+    str_numset(str,(double)retval);
+    stack->ary_array[retarg] = str;
+    return retarg;
+}
+
+int						/*SUPPRESS 590*/
+do_undef(str,arg,gimme,arglast)
+STR *str;
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register int type;
+    register STAB *stab;
+    int retarg = arglast[0] + 1;
+
+    if ((arg[1].arg_type & A_MASK) != A_LEXPR)
+	fatal("Illegal argument to undef()");
+    arg = arg[1].arg_ptr.arg_arg;
+    type = arg->arg_type;
+
+    if (type == O_ARRAY || type == O_LARRAY) {
+	stab = arg[1].arg_ptr.arg_stab;
+	afree(stab_xarray(stab));
+	stab_xarray(stab) = anew(stab);		/* so "@array" still works */
+    }
+    else if (type == O_HASH || type == O_LHASH) {
+	stab = arg[1].arg_ptr.arg_stab;
+	if (stab == envstab)
+	    environ[0] = Nullch;
+	else if (stab == sigstab) {
+	    int i;
+
+	    for (i = 1; i < NSIG; i++)
+		signal(i, SIG_DFL);	/* munch, munch, munch */
+	}
+	(void)hfree(stab_xhash(stab), TRUE);
+	stab_xhash(stab) = Null(HASH*);
+    }
+    else if (type == O_SUBR || type == O_DBSUBR) {
+	stab = arg[1].arg_ptr.arg_stab;
+	if ((arg[1].arg_type & A_MASK) != A_WORD) {
+	    STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
+
+	    if (tmpstr)
+		stab = stabent(str_get(tmpstr),TRUE);
+	    else
+		stab = Nullstab;
+	}
+	if (stab && stab_sub(stab)) {
+	    cmd_free(stab_sub(stab)->cmd);
+	    stab_sub(stab)->cmd = Nullcmd;
+	    afree(stab_sub(stab)->tosave);
+	    Safefree(stab_sub(stab));
+	    stab_sub(stab) = Null(SUBR*);
+	}
+    }
+    else
+	fatal("Can't undefine that kind of object");
+    str_numset(str,0.0);
+    stack->ary_array[retarg] = str;
+    return retarg;
+}
+
+int
+do_vec(lvalue,astr,arglast)
+int lvalue;
+STR *astr;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    int sp = arglast[0];
+    register STR *str = st[++sp];
+    register int offset = (int)str_gnum(st[++sp]);
+    register int size = (int)str_gnum(st[++sp]);
+    unsigned char *s = (unsigned char*)str_get(str);
+    unsigned long retnum;
+    int len;
+
+    sp = arglast[1];
+    offset *= size;		/* turn into bit offset */
+    len = (offset + size + 7) / 8;
+    if (offset < 0 || size < 1)
+	retnum = 0;
+    else if (!lvalue && len > str->str_cur)
+	retnum = 0;
+    else {
+	if (len > str->str_cur) {
+	    STR_GROW(str,len);
+	    (void)memzero(str->str_ptr + str->str_cur, len - str->str_cur);
+	    str->str_cur = len;
+	}
+	s = (unsigned char*)str_get(str);
+	if (size < 8)
+	    retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
+	else {
+	    offset >>= 3;
+	    if (size == 8)
+		retnum = s[offset];
+	    else if (size == 16)
+		retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
+	    else if (size == 32)
+		retnum = ((unsigned long) s[offset] << 24) +
+			((unsigned long) s[offset + 1] << 16) +
+			(s[offset + 2] << 8) + s[offset+3];
+	}
+
+	if (lvalue) {                      /* it's an lvalue! */
+	    struct lstring *lstr = (struct lstring*)astr;
+
+	    astr->str_magic = str;
+	    st[sp]->str_rare = 'v';
+	    lstr->lstr_offset = offset;
+	    lstr->lstr_len = size;
+	}
+    }
+
+    str_numset(astr,(double)retnum);
+    st[sp] = astr;
+    return sp;
+}
+
+void
+do_vecset(mstr,str)
+STR *mstr;
+STR *str;
+{
+    struct lstring *lstr = (struct lstring*)str;
+    register int offset;
+    register int size;
+    register unsigned char *s = (unsigned char*)mstr->str_ptr;
+    register unsigned long lval = U_L(str_gnum(str));
+    int mask;
+
+    mstr->str_rare = 0;
+    str->str_magic = Nullstr;
+    offset = lstr->lstr_offset;
+    size = lstr->lstr_len;
+    if (size < 8) {
+	mask = (1 << size) - 1;
+	size = offset & 7;
+	lval &= mask;
+	offset >>= 3;
+	s[offset] &= ~(mask << size);
+	s[offset] |= lval << size;
+    }
+    else {
+	if (size == 8)
+	    s[offset] = lval & 255;
+	else if (size == 16) {
+	    s[offset] = (lval >> 8) & 255;
+	    s[offset+1] = lval & 255;
+	}
+	else if (size == 32) {
+	    s[offset] = (lval >> 24) & 255;
+	    s[offset+1] = (lval >> 16) & 255;
+	    s[offset+2] = (lval >> 8) & 255;
+	    s[offset+3] = lval & 255;
+	}
+    }
+}
+
+void
+do_chop(astr,str)
+register STR *astr;
+register STR *str;
+{
+    register char *tmps;
+    register int i;
+    ARRAY *ary;
+    HASH *hash;
+    HENT *entry;
+
+    if (!str)
+	return;
+    if (str->str_state == SS_ARY) {
+	ary = stab_array(str->str_u.str_stab);
+	for (i = 0; i <= ary->ary_fill; i++)
+	    do_chop(astr,ary->ary_array[i]);
+	return;
+    }
+    if (str->str_state == SS_HASH) {
+	hash = stab_hash(str->str_u.str_stab);
+	(void)hiterinit(hash);
+	/*SUPPRESS 560*/
+	while (entry = hiternext(hash))
+	    do_chop(astr,hiterval(hash,entry));
+	return;
+    }
+    tmps = str_get(str);
+    if (tmps && str->str_cur) {
+	tmps += str->str_cur - 1;
+	str_nset(astr,tmps,1);	/* remember last char */
+	*tmps = '\0';				/* wipe it out */
+	str->str_cur = tmps - str->str_ptr;
+	str->str_nok = 0;
+	STABSET(str);
+    }
+    else
+	str_nset(astr,"",0);
+}
+
+void
+do_vop(optype,str,left,right)
+STR *str;
+STR *left;
+STR *right;
+{
+    register char *s;
+    register char *l = str_get(left);
+    register char *r = str_get(right);
+    register int len;
+
+    len = left->str_cur;
+    if (len > right->str_cur)
+	len = right->str_cur;
+    if (str->str_cur > len)
+	str->str_cur = len;
+    else if (str->str_cur < len) {
+	STR_GROW(str,len);
+	(void)memzero(str->str_ptr + str->str_cur, len - str->str_cur);
+	str->str_cur = len;
+    }
+    str->str_pok = 1;
+    str->str_nok = 0;
+    s = str->str_ptr;
+    if (!s) {
+	str_nset(str,"",0);
+	s = str->str_ptr;
+    }
+    switch (optype) {
+    case O_BIT_AND:
+	while (len--)
+	    *s++ = *l++ & *r++;
+	break;
+    case O_XOR:
+	while (len--)
+	    *s++ = *l++ ^ *r++;
+	goto mop_up;
+    case O_BIT_OR:
+	while (len--)
+	    *s++ = *l++ | *r++;
+      mop_up:
+	len = str->str_cur;
+	if (right->str_cur > len)
+	    str_ncat(str,right->str_ptr+len,right->str_cur - len);
+	else if (left->str_cur > len)
+	    str_ncat(str,left->str_ptr+len,left->str_cur - len);
+	break;
+    }
+}
+
+int
+do_syscall(arglast)
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+#ifdef atarist
+    unsigned long arg[14]; /* yes, we really need that many ! */
+#else
+    unsigned long arg[8];
+#endif
+    register int i = 0;
+    int retval = -1;
+
+#ifdef HAS_SYSCALL
+#ifdef TAINT
+    for (st += ++sp; items--; st++)
+	tainted |= (*st)->str_tainted;
+    st = stack->ary_array;
+    sp = arglast[1];
+    items = arglast[2] - sp;
+#endif
+#ifdef TAINT
+    taintproper("Insecure dependency in syscall");
+#endif
+    /* This probably won't work on machines where sizeof(long) != sizeof(int)
+     * or where sizeof(long) != sizeof(char*).  But such machines will
+     * not likely have syscall implemented either, so who cares?
+     */
+    while (items--) {
+	if (st[++sp]->str_nok || !i)
+	    arg[i++] = (unsigned long)str_gnum(st[sp]);
+#ifndef lint
+	else
+	    arg[i++] = (unsigned long)st[sp]->str_ptr;
+#endif /* lint */
+    }
+    sp = arglast[1];
+    items = arglast[2] - sp;
+    switch (items) {
+    case 0:
+	fatal("Too few args to syscall");
+    case 1:
+	retval = syscall(arg[0]);
+	break;
+    case 2:
+	retval = syscall(arg[0],arg[1]);
+	break;
+    case 3:
+	retval = syscall(arg[0],arg[1],arg[2]);
+	break;
+    case 4:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3]);
+	break;
+    case 5:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
+	break;
+    case 6:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
+	break;
+    case 7:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
+	break;
+    case 8:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7]);
+	break;
+#ifdef atarist
+    case 9:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7], arg[8]);
+	break;
+    case 10:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7], arg[8], arg[9]);
+	break;
+    case 11:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7], arg[8], arg[9], arg[10]);
+	break;
+    case 12:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7], arg[8], arg[9], arg[10], arg[11]);
+	break;
+    case 13:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7], arg[8], arg[9], arg[10], arg[11], arg[12]);
+	break;
+    case 14:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7], arg[8], arg[9], arg[10], arg[11], arg[12], arg[13]);
+	break;
+#endif /* atarist */
+    }
+    return retval;
+#else
+    fatal("syscall() unimplemented");
+#endif
+}
+
+
diff --git a/doarg.c.rej b/doarg.c.rej
new file mode 100644
index 0000000000..2862a88a64
--- /dev/null
+++ b/doarg.c.rej
@@ -0,0 +1,37 @@
+***************
+*** 1,4 ****
+! /* $RCSfile: doarg.c,v $$Revision: 4.0.1.7 $$Date: 1992/06/11 21:07:11 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+--- 1,4 ----
+! /* $RCSfile: doarg.c,v $$Revision: 4.0.1.8 $$Date: 1993/02/05 19:32:27 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+***************
+*** 6,15 ****
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: doarg.c,v $
+!  * Revision 4.0.1.7  1992/06/11  21:07:11  lwall
+   * patch34: join with null list attempted negative allocation
+   * patch34: sprintf("%6.4s", "abcdefg") didn't print "abcd  "
+!  *
+   * Revision 4.0.1.6  92/06/08  12:34:30  lwall
+   * patch20: removed implicit int declarations on funcions
+   * patch20: pattern modifiers i and o didn't interact right
+--- 6,18 ----
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: doarg.c,v $
+!  * Revision 4.0.1.8  1993/02/05  19:32:27  lwall
+!  * patch36: substitution didn't always invalidate numericity
+!  *
+!  * Revision 4.0.1.7  92/06/11  21:07:11  lwall
+   * patch34: join with null list attempted negative allocation
+   * patch34: sprintf("%6.4s", "abcdefg") didn't print "abcd  "
+!  * 
+   * Revision 4.0.1.6  92/06/08  12:34:30  lwall
+   * patch20: removed implicit int declarations on funcions
+   * patch20: pattern modifiers i and o didn't interact right
diff --git a/form.c b/form.c
index 0eb0976a6a..5ae139d4af 100644
--- a/form.c
+++ b/form.c
@@ -104,6 +104,7 @@ int sp;
     CMD mycmd;
     STR *str;
     char *chophere;
+    int blank = TRUE;
 
     mycmd.c_type = C_NULL;
     orec->o_lines = 0;
@@ -114,10 +115,17 @@ int sp;
 	if (s = fcmd->f_pre) {
 	    while (*s) {
 		if (*s == '\n') {
-		    while (d > orec->o_str && (d[-1] == ' ' || d[-1] == '\t'))
-			d--;
+		    t = orec->o_str;
+		    if (blank && (fcmd->f_flags & FC_REPEAT)) {
+			while (d > t && (d[-1] != '\n'))
+			    d--;
+		    }
+		    else {
+			while (d > t && (d[-1] == ' ' || d[-1] == '\t'))
+			    d--;
+		    }
 		    if (fcmd->f_flags & FC_NOBLANK) {
-			if (d == orec->o_str || d[-1] == '\n') {
+			if (blank || d == orec->o_str || d[-1] == '\n') {
 			    orec->o_lines--;	/* don't print blank line */
 			    linebeg = fcmd->f_next;
 			    break;
@@ -129,6 +137,7 @@ int sp;
 		    }
 		    else
 			linebeg = fcmd->f_next;
+		    blank = TRUE;
 		}
 		*d++ = *s++;
 	    }
@@ -149,6 +158,8 @@ int sp;
 	    while (size && *s && *s != '\n') {
 		if (*s == '\t')
 		    *s = ' ';
+		else if (*s != ' ')
+		    blank = FALSE;
 		size--;
 		if (*s && index(chopset,(*d++ = *s++)))
 		    chophere = s;
@@ -201,6 +212,8 @@ int sp;
 	    while (size && *s && *s != '\n') {
 		if (*s == '\t')
 		    *s = ' ';
+		else if (*s != ' ')
+		    blank = FALSE;
 		size--;
 		if (*s && index(chopset,*s++))
 		    chophere = s;
@@ -245,6 +258,8 @@ int sp;
 	    while (size && *s && *s != '\n') {
 		if (*s == '\t')
 		    *s = ' ';
+		else if (*s != ' ')
+		    blank = FALSE;
 		size--;
 		if (*s && index(chopset,*s++))
 		    chophere = s;
@@ -318,6 +333,7 @@ int sp;
 		}
 		break;
 	    }
+	    blank = FALSE;
 	    value = str_gnum(str);
 	    if (fcmd->f_flags & FC_DP) {
 		sprintf(d, "%#*.*f", size, fcmd->f_decimals, value);
diff --git a/form.c.orig b/form.c.orig
new file mode 100644
index 0000000000..0eb0976a6a
--- /dev/null
+++ b/form.c.orig
@@ -0,0 +1,397 @@
+/* $RCSfile: form.c,v $$Revision: 4.0.1.3 $$Date: 92/06/08 13:21:42 $
+ *
+ *    Copyright (c) 1991, 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:	form.c,v $
+ * Revision 4.0.1.3  92/06/08  13:21:42  lwall
+ * patch20: removed implicit int declarations on funcions
+ * patch20: form feed for formats is now specifiable via $^L
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * 
+ * Revision 4.0.1.2  91/11/05  17:18:43  lwall
+ * patch11: formats didn't fill their fields as well as they could
+ * patch11: ^ fields chopped hyphens on line break
+ * patch11: # fields could write outside allocated memory
+ * 
+ * Revision 4.0.1.1  91/06/07  11:07:59  lwall
+ * patch4: new copyright notice
+ * patch4: default top-of-form format is now FILEHANDLE_TOP
+ * 
+ * Revision 4.0  91/03/20  01:19:23  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+/* Forms stuff */
+
+static int countlines();
+
+void
+form_parseargs(fcmd)
+register FCMD *fcmd;
+{
+    register int i;
+    register ARG *arg;
+    register int items;
+    STR *str;
+    ARG *parselist();
+    line_t oldline = curcmd->c_line;
+    int oldsave = savestack->ary_fill;
+
+    str = fcmd->f_unparsed;
+    curcmd->c_line = fcmd->f_line;
+    fcmd->f_unparsed = Nullstr;
+    (void)savehptr(&curstash);
+    curstash = str->str_u.str_hash;
+    arg = parselist(str);
+    restorelist(oldsave);
+
+    items = arg->arg_len - 1;	/* ignore $$ on end */
+    for (i = 1; i <= items; i++) {
+	if (!fcmd || fcmd->f_type == F_NULL)
+	    fatal("Too many field values");
+	dehoist(arg,i);
+	fcmd->f_expr = make_op(O_ITEM,1,
+	  arg[i].arg_ptr.arg_arg,Nullarg,Nullarg);
+	if (fcmd->f_flags & FC_CHOP) {
+	    if ((fcmd->f_expr[1].arg_type & A_MASK) == A_STAB)
+		fcmd->f_expr[1].arg_type = A_LVAL;
+	    else if ((fcmd->f_expr[1].arg_type & A_MASK) == A_EXPR)
+		fcmd->f_expr[1].arg_type = A_LEXPR;
+	    else
+		fatal("^ field requires scalar lvalue");
+	}
+	fcmd = fcmd->f_next;
+    }
+    if (fcmd && fcmd->f_type)
+	fatal("Not enough field values");
+    curcmd->c_line = oldline;
+    Safefree(arg);
+    str_free(str);
+}
+
+int newsize;
+
+#define CHKLEN(allow) \
+newsize = (d - orec->o_str) + (allow); \
+if (newsize >= curlen) { \
+    curlen = d - orec->o_str; \
+    GROWSTR(&orec->o_str,&orec->o_len,orec->o_len + (allow)); \
+    d = orec->o_str + curlen;	/* in case it moves */ \
+    curlen = orec->o_len - 2; \
+}
+
+void
+format(orec,fcmd,sp)
+register struct outrec *orec;
+register FCMD *fcmd;
+int sp;
+{
+    register char *d = orec->o_str;
+    register char *s;
+    register int curlen = orec->o_len - 2;
+    register int size;
+    FCMD *nextfcmd;
+    FCMD *linebeg = fcmd;
+    char tmpchar;
+    char *t;
+    CMD mycmd;
+    STR *str;
+    char *chophere;
+
+    mycmd.c_type = C_NULL;
+    orec->o_lines = 0;
+    for (; fcmd; fcmd = nextfcmd) {
+	nextfcmd = fcmd->f_next;
+	CHKLEN(fcmd->f_presize);
+	/*SUPPRESS 560*/
+	if (s = fcmd->f_pre) {
+	    while (*s) {
+		if (*s == '\n') {
+		    while (d > orec->o_str && (d[-1] == ' ' || d[-1] == '\t'))
+			d--;
+		    if (fcmd->f_flags & FC_NOBLANK) {
+			if (d == orec->o_str || d[-1] == '\n') {
+			    orec->o_lines--;	/* don't print blank line */
+			    linebeg = fcmd->f_next;
+			    break;
+			}
+			else if (fcmd->f_flags & FC_REPEAT)
+			    nextfcmd = linebeg;
+			else
+			    linebeg = fcmd->f_next;
+		    }
+		    else
+			linebeg = fcmd->f_next;
+		}
+		*d++ = *s++;
+	    }
+	}
+	if (fcmd->f_unparsed)
+	    form_parseargs(fcmd);
+	switch (fcmd->f_type) {
+	case F_NULL:
+	    orec->o_lines++;
+	    break;
+	case F_LEFT:
+	    (void)eval(fcmd->f_expr,G_SCALAR,sp);
+	    str = stack->ary_array[sp+1];
+	    s = str_get(str);
+	    size = fcmd->f_size;
+	    CHKLEN(size);
+	    chophere = Nullch;
+	    while (size && *s && *s != '\n') {
+		if (*s == '\t')
+		    *s = ' ';
+		size--;
+		if (*s && index(chopset,(*d++ = *s++)))
+		    chophere = s;
+		if (*s == '\n' && (fcmd->f_flags & FC_CHOP))
+		    *s = ' ';
+	    }
+	    if (size || !*s)
+		chophere = s;
+	    else if (chophere && chophere < s && *s && index(chopset,*s))
+		chophere = s;
+	    if (fcmd->f_flags & FC_CHOP) {
+		if (!chophere)
+		    chophere = s;
+		size += (s - chophere);
+		d -= (s - chophere);
+		if (fcmd->f_flags & FC_MORE &&
+		  *chophere && strNE(chophere,"\n")) {
+		    while (size < 3) {
+			d--;
+			size++;
+		    }
+		    while (d[-1] == ' ' && size < fcmd->f_size) {
+			d--;
+			size++;
+		    }
+		    *d++ = '.';
+		    *d++ = '.';
+		    *d++ = '.';
+		    size -= 3;
+		}
+		while (*chophere && index(chopset,*chophere)
+		  && isSPACE(*chophere))
+		    chophere++;
+		str_chop(str,chophere);
+	    }
+	    if (fcmd->f_next && fcmd->f_next->f_pre[0] == '\n')
+		size = 0;			/* no spaces before newline */
+	    while (size) {
+		size--;
+		*d++ = ' ';
+	    }
+	    break;
+	case F_RIGHT:
+	    (void)eval(fcmd->f_expr,G_SCALAR,sp);
+	    str = stack->ary_array[sp+1];
+	    t = s = str_get(str);
+	    size = fcmd->f_size;
+	    CHKLEN(size);
+	    chophere = Nullch;
+	    while (size && *s && *s != '\n') {
+		if (*s == '\t')
+		    *s = ' ';
+		size--;
+		if (*s && index(chopset,*s++))
+		    chophere = s;
+		if (*s == '\n' && (fcmd->f_flags & FC_CHOP))
+		    *s = ' ';
+	    }
+	    if (size || !*s)
+		chophere = s;
+	    else if (chophere && chophere < s && *s && index(chopset,*s))
+		chophere = s;
+	    if (fcmd->f_flags & FC_CHOP) {
+		if (!chophere)
+		    chophere = s;
+		size += (s - chophere);
+		s = chophere;
+		while (*chophere && index(chopset,*chophere)
+		  && isSPACE(*chophere))
+		    chophere++;
+	    }
+	    tmpchar = *s;
+	    *s = '\0';
+	    while (size) {
+		size--;
+		*d++ = ' ';
+	    }
+	    size = s - t;
+	    Copy(t,d,size,char);
+	    d += size;
+	    *s = tmpchar;
+	    if (fcmd->f_flags & FC_CHOP)
+		str_chop(str,chophere);
+	    break;
+	case F_CENTER: {
+	    int halfsize;
+
+	    (void)eval(fcmd->f_expr,G_SCALAR,sp);
+	    str = stack->ary_array[sp+1];
+	    t = s = str_get(str);
+	    size = fcmd->f_size;
+	    CHKLEN(size);
+	    chophere = Nullch;
+	    while (size && *s && *s != '\n') {
+		if (*s == '\t')
+		    *s = ' ';
+		size--;
+		if (*s && index(chopset,*s++))
+		    chophere = s;
+		if (*s == '\n' && (fcmd->f_flags & FC_CHOP))
+		    *s = ' ';
+	    }
+	    if (size || !*s)
+		chophere = s;
+	    else if (chophere && chophere < s && *s && index(chopset,*s))
+		chophere = s;
+	    if (fcmd->f_flags & FC_CHOP) {
+		if (!chophere)
+		    chophere = s;
+		size += (s - chophere);
+		s = chophere;
+		while (*chophere && index(chopset,*chophere)
+		  && isSPACE(*chophere))
+		    chophere++;
+	    }
+	    tmpchar = *s;
+	    *s = '\0';
+	    halfsize = size / 2;
+	    while (size > halfsize) {
+		size--;
+		*d++ = ' ';
+	    }
+	    size = s - t;
+	    Copy(t,d,size,char);
+	    d += size;
+	    *s = tmpchar;
+	    if (fcmd->f_next && fcmd->f_next->f_pre[0] == '\n')
+		size = 0;			/* no spaces before newline */
+	    else
+		size = halfsize;
+	    while (size) {
+		size--;
+		*d++ = ' ';
+	    }
+	    if (fcmd->f_flags & FC_CHOP)
+		str_chop(str,chophere);
+	    break;
+	}
+	case F_LINES:
+	    (void)eval(fcmd->f_expr,G_SCALAR,sp);
+	    str = stack->ary_array[sp+1];
+	    s = str_get(str);
+	    size = str_len(str);
+	    CHKLEN(size+1);
+	    orec->o_lines += countlines(s,size) - 1;
+	    Copy(s,d,size,char);
+	    d += size;
+	    if (size && s[size-1] != '\n') {
+		*d++ = '\n';
+		orec->o_lines++;
+	    }
+	    linebeg = fcmd->f_next;
+	    break;
+	case F_DECIMAL: {
+	    double value;
+
+	    (void)eval(fcmd->f_expr,G_SCALAR,sp);
+	    str = stack->ary_array[sp+1];
+	    size = fcmd->f_size;
+	    CHKLEN(size+1);
+	    /* If the field is marked with ^ and the value is undefined,
+	       blank it out. */
+	    if ((fcmd->f_flags & FC_CHOP) && !str->str_pok && !str->str_nok) {
+		while (size) {
+		    size--;
+		    *d++ = ' ';
+		}
+		break;
+	    }
+	    value = str_gnum(str);
+	    if (fcmd->f_flags & FC_DP) {
+		sprintf(d, "%#*.*f", size, fcmd->f_decimals, value);
+	    } else {
+		sprintf(d, "%*.0f", size, value);
+	    }
+	    d += size;
+	    break;
+	}
+	}
+    }
+    CHKLEN(1);
+    *d++ = '\0';
+}
+
+static int
+countlines(s,size)
+register char *s;
+register int size;
+{
+    register int count = 0;
+
+    while (size--) {
+	if (*s++ == '\n')
+	    count++;
+    }
+    return count;
+}
+
+void
+do_write(orec,stab,sp)
+struct outrec *orec;
+STAB *stab;
+int sp;
+{
+    register STIO *stio = stab_io(stab);
+    FILE *ofp = stio->ofp;
+
+#ifdef DEBUGGING
+    if (debug & 256)
+	fprintf(stderr,"left=%ld, todo=%ld\n",
+	  (long)stio->lines_left, (long)orec->o_lines);
+#endif
+    if (stio->lines_left < orec->o_lines) {
+	if (!stio->top_stab) {
+	    STAB *topstab;
+	    char tmpbuf[256];
+
+	    if (!stio->top_name) {
+		if (!stio->fmt_name)
+		    stio->fmt_name = savestr(stab_name(stab));
+		sprintf(tmpbuf, "%s_TOP", stio->fmt_name);
+		topstab = stabent(tmpbuf,FALSE);
+		if (topstab && stab_form(topstab))
+		    stio->top_name = savestr(tmpbuf);
+		else
+		    stio->top_name = savestr("top");
+	    }
+	    topstab = stabent(stio->top_name,FALSE);
+	    if (!topstab || !stab_form(topstab)) {
+		stio->lines_left = 100000000;
+		goto forget_top;
+	    }
+	    stio->top_stab = topstab;
+	}
+	if (stio->lines_left >= 0 && stio->page > 0)
+	    fwrite(formfeed->str_ptr, formfeed->str_cur, 1, ofp);
+	stio->lines_left = stio->page_len;
+	stio->page++;
+	format(&toprec,stab_form(stio->top_stab),sp);
+	fputs(toprec.o_str,ofp);
+	stio->lines_left -= toprec.o_lines;
+    }
+  forget_top:
+    fputs(orec->o_str,ofp);
+    stio->lines_left -= orec->o_lines;
+}
diff --git a/form.c.rej b/form.c.rej
new file mode 100644
index 0000000000..86f5bed042
--- /dev/null
+++ b/form.c.rej
@@ -0,0 +1,39 @@
+***************
+*** 1,4 ****
+! /* $RCSfile: form.c,v $$Revision: 4.0.1.3 $$Date: 1992/06/08 13:21:42 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+--- 1,4 ----
+! /* $RCSfile: form.c,v $$Revision: 4.0.1.4 $$Date: 1993/02/05 19:34:32 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+***************
+*** 6,16 ****
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: form.c,v $
+!  * Revision 4.0.1.3  1992/06/08  13:21:42  lwall
+   * patch20: removed implicit int declarations on funcions
+   * patch20: form feed for formats is now specifiable via $^L
+   * patch20: Perl now distinguishes overlapped copies from non-overlapped
+!  *
+   * Revision 4.0.1.2  91/11/05  17:18:43  lwall
+   * patch11: formats didn't fill their fields as well as they could
+   * patch11: ^ fields chopped hyphens on line break
+--- 6,19 ----
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: form.c,v $
+!  * Revision 4.0.1.4  1993/02/05  19:34:32  lwall
+!  * patch36: formats now ignore literal text for ~~ loop determination
+!  *
+!  * Revision 4.0.1.3  92/06/08  13:21:42  lwall
+   * patch20: removed implicit int declarations on funcions
+   * patch20: form feed for formats is now specifiable via $^L
+   * patch20: Perl now distinguishes overlapped copies from non-overlapped
+!  * 
+   * Revision 4.0.1.2  91/11/05  17:18:43  lwall
+   * patch11: formats didn't fill their fields as well as they could
+   * patch11: ^ fields chopped hyphens on line break
diff --git a/hints/dec_osf1.sh b/hints/dec_osf1.sh
new file mode 100644
index 0000000000..07f594e3cf
--- /dev/null
+++ b/hints/dec_osf1.sh
@@ -0,0 +1,11 @@
+d_crypt='undef'             # The function is there, but it is empty
+d_odbm='undef'              # We don't need both odbm and ndbm
+gidtype='gid_t'
+groupstype='int'
+libpth="$libpth /usr/shlib" # Use the shared libraries if possible
+libc='/usr/shlib/libc.so'   # The archive version is /lib/libc.a
+case `uname -m` in
+    mips|alpha)   optimize="$optimize -O2 -Olimit 2900"
+                  ccflags="$ccflags -std1 -D_BSD" ;;
+    *)            ccflags="$ccflags -D_BSD" ;;
+esac
diff --git a/hints/solaris_2_1.sh b/hints/solaris_2_1.sh
new file mode 100644
index 0000000000..de405bc24d
--- /dev/null
+++ b/hints/solaris_2_1.sh
@@ -0,0 +1,4 @@
+d_vfork='undef'
+d_wait4='undef'
+i_dirent='undef'
+i_sys_dir='define'
diff --git a/lib/bigfloat.pl b/lib/bigfloat.pl
index 52fb7e3880..278f11d815 100644
--- a/lib/bigfloat.pl
+++ b/lib/bigfloat.pl
@@ -67,7 +67,7 @@ sub norm { #(mantissa, exponent) return fnum_str
 # negation
 sub main'fneg { #(fnum_str) return fnum_str
     local($_) = &'fnorm($_[0]);
-    vec($_,0,8) =^ ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign
+    vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign
     s/^H/N/;
     $_;
 }
diff --git a/lib/bigint.pl b/lib/bigint.pl
index 9a52fb76fd..5c79da9898 100644
--- a/lib/bigint.pl
+++ b/lib/bigint.pl
@@ -154,7 +154,7 @@ sub add { #(int_num_array, int_num_array) return int_num_array
     $car = 0;
     for $x (@x) {
 	last unless @y || $car;
-	$x -= 1e5 if $car = (($x += shift @y + $car) >= 1e5);
+	$x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5);
     }
     for $y (@y) {
 	last unless $car;
@@ -169,7 +169,7 @@ sub sub { #(int_num_array, int_num_array) return int_num_array
     $bar = 0;
     for $sx (@sx) {
 	last unless @y || $bar;
-	$sx += 1e5 if $bar = (($sx -= shift @sy + $bar) < 0);
+	$sx += 1e5 if $bar = (($sx -= shift(@sy) + $bar) < 0);
     }
     @sx;
 }
diff --git a/lib/getcwd.pl b/lib/getcwd.pl
index 114e8905c6..a3214ba715 100644
--- a/lib/getcwd.pl
+++ b/lib/getcwd.pl
@@ -42,9 +42,9 @@ sub getcwd
 		    closedir(getcwd'PARENT);				#');
 		    return '';
 		}
-		unless (@tst = stat("$dotdots/$dir"))
+		unless (@tst = lstat("$dotdots/$dir"))
 		{
-		    warn "stat($dotdots/$dir): $!";
+		    warn "lstat($dotdots/$dir): $!";
 		    closedir(getcwd'PARENT);				#');
 		    return '';
 		}
diff --git a/lib/timelocal.pl b/lib/timelocal.pl
index 5be3840035..95b47e1ef9 100644
--- a/lib/timelocal.pl
+++ b/lib/timelocal.pl
@@ -36,6 +36,7 @@ CONFIG: {
     $MIN = 60 * $SEC;
     $HR = 60 * $MIN;
     $DAYS = 24 * $HR;
+    $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
 }
 
 sub timegm {
@@ -65,6 +66,7 @@ sub cheat {
     die "Month out of range 0..11 in ctime.pl\n" if $month > 11;
     $guess = $^T;
     @g = gmtime($guess);
+    $year += $YearFix if $year < $epoch[5];
     while ($diff = $year - $g[5]) {
 	$guess += $diff * (363 * $DAYS);
 	@g = gmtime($guess);
diff --git a/patchlevel.h b/patchlevel.h
index 68fcfefec9..d248b3566e 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 35
+#define PATCHLEVEL 36
diff --git a/perl.c b/perl.c
index 7a41d2bf7d..046bb60c57 100644
--- a/perl.c
+++ b/perl.c
@@ -128,7 +128,7 @@ setuid perl scripts securely.\n");
 #ifdef TAINT
 #ifndef DOSUID
     if (uid == euid && gid == egid)
-	taintanyway == TRUE;		/* running taintperl explicitly */
+	taintanyway = TRUE;		/* running taintperl explicitly */
 #endif
 #endif
     (void)sprintf(index(rcsid,'#'), "%d\n", PATCHLEVEL);
@@ -1168,6 +1168,8 @@ int *arglast;
 	    eval_root = myroot;
 	else if (in_eval != 1 && myroot != last_root)
 	    cmd_free(myroot);
+	    if (eval_root == myroot)
+		eval_root = Nullcmd;
     }
 
     perldb = oldperldb;
diff --git a/perl.c.orig b/perl.c.orig
new file mode 100644
index 0000000000..7a41d2bf7d
--- /dev/null
+++ b/perl.c.orig
@@ -0,0 +1,1440 @@
+char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.7 $$Date: 92/06/08 14:50:39 $\nPatch level: ###\n";
+/*
+ *    Copyright (c) 1991, 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:	perl.c,v $
+ * Revision 4.0.1.7  92/06/08  14:50:39  lwall
+ * patch20: PERLLIB now supports multiple directories
+ * patch20: running taintperl explicitly now does checks even if $< == $>
+ * patch20: -e 'cmd' no longer fails silently if /tmp runs out of space
+ * patch20: perl -P now uses location of sed determined by Configure
+ * patch20: form feed for formats is now specifiable via $^L
+ * patch20: paragraph mode now skips extra newlines automatically
+ * patch20: eval "1 #comment" didn't work
+ * patch20: couldn't require . files
+ * patch20: semantic compilation errors didn't abort execution
+ * 
+ * Revision 4.0.1.6  91/11/11  16:38:45  lwall
+ * patch19: default arg for shift was wrong after first subroutine definition
+ * patch19: op/regexp.t failed from missing arg to bcmp()
+ * 
+ * Revision 4.0.1.5  91/11/05  18:03:32  lwall
+ * patch11: random cleanup
+ * patch11: $0 was being truncated at times
+ * patch11: cppstdin now installed outside of source directory
+ * patch11: -P didn't allow use of #elif or #undef
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: added eval {}
+ * patch11: eval confused by string containing null
+ * 
+ * Revision 4.0.1.4  91/06/10  01:23:07  lwall
+ * patch10: perl -v printed incorrect copyright notice
+ * 
+ * Revision 4.0.1.3  91/06/07  11:40:18  lwall
+ * patch4: changed old $^P to $^X
+ * 
+ * Revision 4.0.1.2  91/06/07  11:26:16  lwall
+ * patch4: new copyright notice
+ * patch4: added $^P variable to control calling of perldb routines
+ * patch4: added $^F variable to specify maximum system fd, default 2
+ * patch4: debugger lost track of lines in eval
+ * 
+ * Revision 4.0.1.1  91/04/11  17:49:05  lwall
+ * patch1: fixed undefined environ problem
+ * 
+ * Revision 4.0  91/03/20  01:37:44  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+/*SUPPRESS 560*/
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "perly.h"
+#include "patchlevel.h"
+
+char *getenv();
+
+#ifdef IAMSUID
+#ifndef DOSUID
+#define DOSUID
+#endif
+#endif
+
+#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+#ifdef DOSUID
+#undef DOSUID
+#endif
+#endif
+
+static char* moreswitches();
+static void incpush();
+static char* cddir;
+static bool minus_c;
+static char patchlevel[6];
+static char *nrs = "\n";
+static int nrschar = '\n';      /* final char of rs, or 0777 if none */
+static int nrslen = 1;
+
+main(argc,argv,env)
+register int argc;
+register char **argv;
+register char **env;
+{
+    register STR *str;
+    register char *s;
+    char *scriptname;
+    char *getenv();
+    bool dosearch = FALSE;
+#ifdef DOSUID
+    char *validarg = "";
+#endif
+
+#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+#ifdef IAMSUID
+#undef IAMSUID
+    fatal("suidperl is no longer needed since the kernel can now execute\n\
+setuid perl scripts securely.\n");
+#endif
+#endif
+
+    origargv = argv;
+    origargc = argc;
+    origenviron = environ;
+    uid = (int)getuid();
+    euid = (int)geteuid();
+    gid = (int)getgid();
+    egid = (int)getegid();
+    sprintf(patchlevel,"%3.3s%2.2d", index(rcsid,'4'), PATCHLEVEL);
+#ifdef MSDOS
+    /*
+     * There is no way we can refer to them from Perl so close them to save
+     * space.  The other alternative would be to provide STDAUX and STDPRN
+     * filehandles.
+     */
+    (void)fclose(stdaux);
+    (void)fclose(stdprn);
+#endif
+    if (do_undump) {
+	origfilename = savestr(argv[0]);
+	do_undump = 0;
+	loop_ptr = -1;		/* start label stack again */
+	goto just_doit;
+    }
+#ifdef TAINT
+#ifndef DOSUID
+    if (uid == euid && gid == egid)
+	taintanyway == TRUE;		/* running taintperl explicitly */
+#endif
+#endif
+    (void)sprintf(index(rcsid,'#'), "%d\n", PATCHLEVEL);
+    linestr = Str_new(65,80);
+    str_nset(linestr,"",0);
+    str = str_make("",0);		/* first used for -I flags */
+    curstash = defstash = hnew(0);
+    curstname = str_make("main",4);
+    stab_xhash(stabent("_main",TRUE)) = defstash;
+    defstash->tbl_name = "main";
+    incstab = hadd(aadd(stabent("INC",TRUE)));
+    incstab->str_pok |= SP_MULTI;
+    for (argc--,argv++; argc > 0; argc--,argv++) {
+	if (argv[0][0] != '-' || !argv[0][1])
+	    break;
+#ifdef DOSUID
+    if (*validarg)
+	validarg = " PHOOEY ";
+    else
+	validarg = argv[0];
+#endif
+	s = argv[0]+1;
+      reswitch:
+	switch (*s) {
+	case '0':
+	case 'a':
+	case 'c':
+	case 'd':
+	case 'D':
+	case 'i':
+	case 'l':
+	case 'n':
+	case 'p':
+	case 'u':
+	case 'U':
+	case 'v':
+	case 'w':
+	    if (s = moreswitches(s))
+		goto reswitch;
+	    break;
+
+	case 'e':
+#ifdef TAINT
+	    if (euid != uid || egid != gid)
+		fatal("No -e allowed in setuid scripts");
+#endif
+	    if (!e_fp) {
+	        e_tmpname = savestr(TMPPATH);
+		(void)mktemp(e_tmpname);
+		if (!*e_tmpname)
+		    fatal("Can't mktemp()");
+		e_fp = fopen(e_tmpname,"w");
+		if (!e_fp)
+		    fatal("Cannot open temporary file");
+	    }
+	    if (argv[1]) {
+		fputs(argv[1],e_fp);
+		argc--,argv++;
+	    }
+	    (void)putc('\n', e_fp);
+	    break;
+	case 'I':
+#ifdef TAINT
+	    if (euid != uid || egid != gid)
+		fatal("No -I allowed in setuid scripts");
+#endif
+	    str_cat(str,"-");
+	    str_cat(str,s);
+	    str_cat(str," ");
+	    if (*++s) {
+		(void)apush(stab_array(incstab),str_make(s,0));
+	    }
+	    else if (argv[1]) {
+		(void)apush(stab_array(incstab),str_make(argv[1],0));
+		str_cat(str,argv[1]);
+		argc--,argv++;
+		str_cat(str," ");
+	    }
+	    break;
+	case 'P':
+#ifdef TAINT
+	    if (euid != uid || egid != gid)
+		fatal("No -P allowed in setuid scripts");
+#endif
+	    preprocess = TRUE;
+	    s++;
+	    goto reswitch;
+	case 's':
+#ifdef TAINT
+	    if (euid != uid || egid != gid)
+		fatal("No -s allowed in setuid scripts");
+#endif
+	    doswitches = TRUE;
+	    s++;
+	    goto reswitch;
+	case 'S':
+#ifdef TAINT
+	    if (euid != uid || egid != gid)
+		fatal("No -S allowed in setuid scripts");
+#endif
+	    dosearch = TRUE;
+	    s++;
+	    goto reswitch;
+	case 'x':
+	    doextract = TRUE;
+	    s++;
+	    if (*s)
+		cddir = savestr(s);
+	    break;
+	case '-':
+	    argc--,argv++;
+	    goto switch_end;
+	case 0:
+	    break;
+	default:
+	    fatal("Unrecognized switch: -%s",s);
+	}
+    }
+  switch_end:
+    scriptname = argv[0];
+    if (e_fp) {
+	if (fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
+	    fatal("Can't write to temp file for -e: %s", strerror(errno));
+	argc++,argv--;
+	scriptname = e_tmpname;
+    }
+
+#ifdef DOSISH
+#define PERLLIB_SEP ';'
+#else
+#define PERLLIB_SEP ':'
+#endif
+#ifndef TAINT		/* Can't allow arbitrary PERLLIB in setuid script */
+    incpush(getenv("PERLLIB"));
+#endif /* TAINT */
+
+#ifndef PRIVLIB
+#define PRIVLIB "/usr/local/lib/perl"
+#endif
+    incpush(PRIVLIB);
+    (void)apush(stab_array(incstab),str_make(".",1));
+
+    str_set(&str_no,No);
+    str_set(&str_yes,Yes);
+
+    /* open script */
+
+    if (scriptname == Nullch)
+#ifdef MSDOS
+    {
+	if ( isatty(fileno(stdin)) )
+	  moreswitches("v");
+	scriptname = "-";
+    }
+#else
+	scriptname = "-";
+#endif
+    if (dosearch && !index(scriptname, '/') && (s = getenv("PATH"))) {
+	char *xfound = Nullch, *xfailed = Nullch;
+	int len;
+
+	bufend = s + strlen(s);
+	while (*s) {
+#ifndef DOSISH
+	    s = cpytill(tokenbuf,s,bufend,':',&len);
+#else
+#ifdef atarist
+	    for (len = 0; *s && *s != ',' && *s != ';'; tokenbuf[len++] = *s++);
+	    tokenbuf[len] = '\0';
+#else
+	    for (len = 0; *s && *s != ';'; tokenbuf[len++] = *s++);
+	    tokenbuf[len] = '\0';
+#endif
+#endif
+	    if (*s)
+		s++;
+#ifndef DOSISH
+	    if (len && tokenbuf[len-1] != '/')
+#else
+#ifdef atarist
+	    if (len && ((tokenbuf[len-1] != '\\') && (tokenbuf[len-1] != '/')))
+#else
+	    if (len && tokenbuf[len-1] != '\\')
+#endif
+#endif
+		(void)strcat(tokenbuf+len,"/");
+	    (void)strcat(tokenbuf+len,scriptname);
+#ifdef DEBUGGING
+	    if (debug & 1)
+		fprintf(stderr,"Looking for %s\n",tokenbuf);
+#endif
+	    if (stat(tokenbuf,&statbuf) < 0)		/* not there? */
+		continue;
+	    if (S_ISREG(statbuf.st_mode)
+	     && cando(S_IRUSR,TRUE,&statbuf) && cando(S_IXUSR,TRUE,&statbuf)) {
+		xfound = tokenbuf;              /* bingo! */
+		break;
+	    }
+	    if (!xfailed)
+		xfailed = savestr(tokenbuf);
+	}
+	if (!xfound)
+	    fatal("Can't execute %s", xfailed ? xfailed : scriptname );
+	if (xfailed)
+	    Safefree(xfailed);
+	scriptname = savestr(xfound);
+    }
+
+    fdpid = anew(Nullstab);	/* for remembering popen pids by fd */
+    pidstatus = hnew(COEFFSIZE);/* for remembering status of dead pids */
+
+    origfilename = savestr(scriptname);
+    curcmd->c_filestab = fstab(origfilename);
+    if (strEQ(origfilename,"-"))
+	scriptname = "";
+    if (preprocess) {
+	char *cpp = CPPSTDIN;
+
+	if (strEQ(cpp,"cppstdin"))
+	    sprintf(tokenbuf, "%s/%s", SCRIPTDIR, cpp);
+	else
+	    sprintf(tokenbuf, "%s", cpp);
+	str_cat(str,"-I");
+	str_cat(str,PRIVLIB);
+#ifdef MSDOS
+	(void)sprintf(buf, "\
+sed %s -e \"/^[^#]/b\" \
+ -e \"/^#[ 	]*include[ 	]/b\" \
+ -e \"/^#[ 	]*define[ 	]/b\" \
+ -e \"/^#[ 	]*if[ 	]/b\" \
+ -e \"/^#[ 	]*ifdef[ 	]/b\" \
+ -e \"/^#[ 	]*ifndef[ 	]/b\" \
+ -e \"/^#[ 	]*else/b\" \
+ -e \"/^#[ 	]*elif[ 	]/b\" \
+ -e \"/^#[ 	]*undef[ 	]/b\" \
+ -e \"/^#[ 	]*endif/b\" \
+ -e \"s/^#.*//\" \
+ %s | %s -C %s %s",
+	  (doextract ? "-e \"1,/^#/d\n\"" : ""),
+#else
+	(void)sprintf(buf, "\
+%s %s -e '/^[^#]/b' \
+ -e '/^#[ 	]*include[ 	]/b' \
+ -e '/^#[ 	]*define[ 	]/b' \
+ -e '/^#[ 	]*if[ 	]/b' \
+ -e '/^#[ 	]*ifdef[ 	]/b' \
+ -e '/^#[ 	]*ifndef[ 	]/b' \
+ -e '/^#[ 	]*else/b' \
+ -e '/^#[ 	]*elif[ 	]/b' \
+ -e '/^#[ 	]*undef[ 	]/b' \
+ -e '/^#[ 	]*endif/b' \
+ -e 's/^[ 	]*#.*//' \
+ %s | %s -C %s %s",
+#ifdef LOC_SED
+	  LOC_SED,
+#else
+	  "sed",
+#endif
+	  (doextract ? "-e '1,/^#/d\n'" : ""),
+#endif
+	  scriptname, tokenbuf, str_get(str), CPPMINUS);
+#ifdef DEBUGGING
+	if (debug & 64) {
+	    fputs(buf,stderr);
+	    fputs("\n",stderr);
+	}
+#endif
+	doextract = FALSE;
+#ifdef IAMSUID				/* actually, this is caught earlier */
+	if (euid != uid && !euid) {	/* if running suidperl */
+#ifdef HAS_SETEUID
+	    (void)seteuid(uid);		/* musn't stay setuid root */
+#else
+#ifdef HAS_SETREUID
+	    (void)setreuid(-1, uid);
+#else
+	    setuid(uid);
+#endif
+#endif
+	    if (geteuid() != uid)
+		fatal("Can't do seteuid!\n");
+	}
+#endif /* IAMSUID */
+	rsfp = mypopen(buf,"r");
+    }
+    else if (!*scriptname) {
+#ifdef TAINT
+	if (euid != uid || egid != gid)
+	    fatal("Can't take set-id script from stdin");
+#endif
+	rsfp = stdin;
+    }
+    else
+	rsfp = fopen(scriptname,"r");
+    if ((FILE*)rsfp == Nullfp) {
+#ifdef DOSUID
+#ifndef IAMSUID		/* in case script is not readable before setuid */
+	if (euid && stat(stab_val(curcmd->c_filestab)->str_ptr,&statbuf) >= 0 &&
+	  statbuf.st_mode & (S_ISUID|S_ISGID)) {
+	    (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel);
+	    execv(buf, origargv);	/* try again */
+	    fatal("Can't do setuid\n");
+	}
+#endif
+#endif
+	fatal("Can't open perl script \"%s\": %s\n",
+	  stab_val(curcmd->c_filestab)->str_ptr, strerror(errno));
+    }
+    str_free(str);		/* free -I directories */
+    str = Nullstr;
+
+    /* do we need to emulate setuid on scripts? */
+
+    /* This code is for those BSD systems that have setuid #! scripts disabled
+     * in the kernel because of a security problem.  Merely defining DOSUID
+     * in perl will not fix that problem, but if you have disabled setuid
+     * scripts in the kernel, this will attempt to emulate setuid and setgid
+     * on scripts that have those now-otherwise-useless bits set.  The setuid
+     * root version must be called suidperl or sperlN.NNN.  If regular perl
+     * discovers that it has opened a setuid script, it calls suidperl with
+     * the same argv that it had.  If suidperl finds that the script it has
+     * just opened is NOT setuid root, it sets the effective uid back to the
+     * uid.  We don't just make perl setuid root because that loses the
+     * effective uid we had before invoking perl, if it was different from the
+     * uid.
+     *
+     * DOSUID must be defined in both perl and suidperl, and IAMSUID must
+     * be defined in suidperl only.  suidperl must be setuid root.  The
+     * Configure script will set this up for you if you want it.
+     *
+     * There is also the possibility of have a script which is running
+     * set-id due to a C wrapper.  We want to do the TAINT checks
+     * on these set-id scripts, but don't want to have the overhead of
+     * them in normal perl, and can't use suidperl because it will lose
+     * the effective uid info, so we have an additional non-setuid root
+     * version called taintperl or tperlN.NNN that just does the TAINT checks.
+     */
+
+#ifdef DOSUID
+    if (fstat(fileno(rsfp),&statbuf) < 0)	/* normal stat is insecure */
+	fatal("Can't stat script \"%s\"",origfilename);
+    if (statbuf.st_mode & (S_ISUID|S_ISGID)) {
+	int len;
+
+#ifdef IAMSUID
+#ifndef HAS_SETREUID
+	/* On this access check to make sure the directories are readable,
+	 * there is actually a small window that the user could use to make
+	 * filename point to an accessible directory.  So there is a faint
+	 * chance that someone could execute a setuid script down in a
+	 * non-accessible directory.  I don't know what to do about that.
+	 * But I don't think it's too important.  The manual lies when
+	 * it says access() is useful in setuid programs.
+	 */
+	if (access(stab_val(curcmd->c_filestab)->str_ptr,1))	/*double check*/
+	    fatal("Permission denied");
+#else
+	/* If we can swap euid and uid, then we can determine access rights
+	 * with a simple stat of the file, and then compare device and
+	 * inode to make sure we did stat() on the same file we opened.
+	 * Then we just have to make sure he or she can execute it.
+	 */
+	{
+	    struct stat tmpstatbuf;
+
+	    if (setreuid(euid,uid) < 0 || getuid() != euid || geteuid() != uid)
+		fatal("Can't swap uid and euid");	/* really paranoid */
+	    if (stat(stab_val(curcmd->c_filestab)->str_ptr,&tmpstatbuf) < 0)
+		fatal("Permission denied");	/* testing full pathname here */
+	    if (tmpstatbuf.st_dev != statbuf.st_dev ||
+		tmpstatbuf.st_ino != statbuf.st_ino) {
+		(void)fclose(rsfp);
+		if (rsfp = mypopen("/bin/mail root","w")) {	/* heh, heh */
+		    fprintf(rsfp,
+"User %d tried to run dev %d ino %d in place of dev %d ino %d!\n\
+(Filename of set-id script was %s, uid %d gid %d.)\n\nSincerely,\nperl\n",
+			uid,tmpstatbuf.st_dev, tmpstatbuf.st_ino,
+			statbuf.st_dev, statbuf.st_ino,
+			stab_val(curcmd->c_filestab)->str_ptr,
+			statbuf.st_uid, statbuf.st_gid);
+		    (void)mypclose(rsfp);
+		}
+		fatal("Permission denied\n");
+	    }
+	    if (setreuid(uid,euid) < 0 || getuid() != uid || geteuid() != euid)
+		fatal("Can't reswap uid and euid");
+	    if (!cando(S_IXUSR,FALSE,&statbuf))		/* can real uid exec? */
+		fatal("Permission denied\n");
+	}
+#endif /* HAS_SETREUID */
+#endif /* IAMSUID */
+
+	if (!S_ISREG(statbuf.st_mode))
+	    fatal("Permission denied");
+	if (statbuf.st_mode & S_IWOTH)
+	    fatal("Setuid/gid script is writable by world");
+	doswitches = FALSE;		/* -s is insecure in suid */
+	curcmd->c_line++;
+	if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch ||
+	  strnNE(tokenbuf,"#!",2) )	/* required even on Sys V */
+	    fatal("No #! line");
+	s = tokenbuf+2;
+	if (*s == ' ') s++;
+	while (!isSPACE(*s)) s++;
+	if (strnNE(s-4,"perl",4) && strnNE(s-9,"perl",4))  /* sanity check */
+	    fatal("Not a perl script");
+	while (*s == ' ' || *s == '\t') s++;
+	/*
+	 * #! arg must be what we saw above.  They can invoke it by
+	 * mentioning suidperl explicitly, but they may not add any strange
+	 * arguments beyond what #! says if they do invoke suidperl that way.
+	 */
+	len = strlen(validarg);
+	if (strEQ(validarg," PHOOEY ") ||
+	    strnNE(s,validarg,len) || !isSPACE(s[len]))
+	    fatal("Args must match #! line");
+
+#ifndef IAMSUID
+	if (euid != uid && (statbuf.st_mode & S_ISUID) &&
+	    euid == statbuf.st_uid)
+	    if (!do_undump)
+		fatal("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
+FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
+#endif /* IAMSUID */
+
+	if (euid) {	/* oops, we're not the setuid root perl */
+	    (void)fclose(rsfp);
+#ifndef IAMSUID
+	    (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel);
+	    execv(buf, origargv);	/* try again */
+#endif
+	    fatal("Can't do setuid\n");
+	}
+
+	if (statbuf.st_mode & S_ISGID && statbuf.st_gid != egid) {
+#ifdef HAS_SETEGID
+	    (void)setegid(statbuf.st_gid);
+#else
+#ifdef HAS_SETREGID
+	    (void)setregid((GIDTYPE)-1,statbuf.st_gid);
+#else
+	    setgid(statbuf.st_gid);
+#endif
+#endif
+	    if (getegid() != statbuf.st_gid)
+		fatal("Can't do setegid!\n");
+	}
+	if (statbuf.st_mode & S_ISUID) {
+	    if (statbuf.st_uid != euid)
+#ifdef HAS_SETEUID
+		(void)seteuid(statbuf.st_uid);	/* all that for this */
+#else
+#ifdef HAS_SETREUID
+		(void)setreuid((UIDTYPE)-1,statbuf.st_uid);
+#else
+		setuid(statbuf.st_uid);
+#endif
+#endif
+	    if (geteuid() != statbuf.st_uid)
+		fatal("Can't do seteuid!\n");
+	}
+	else if (uid) {			/* oops, mustn't run as root */
+#ifdef HAS_SETEUID
+	    (void)seteuid((UIDTYPE)uid);
+#else
+#ifdef HAS_SETREUID
+	    (void)setreuid((UIDTYPE)-1,(UIDTYPE)uid);
+#else
+	    setuid((UIDTYPE)uid);
+#endif
+#endif
+	    if (geteuid() != uid)
+		fatal("Can't do seteuid!\n");
+	}
+	uid = (int)getuid();
+	euid = (int)geteuid();
+	gid = (int)getgid();
+	egid = (int)getegid();
+	if (!cando(S_IXUSR,TRUE,&statbuf))
+	    fatal("Permission denied\n");	/* they can't do this */
+    }
+#ifdef IAMSUID
+    else if (preprocess)
+	fatal("-P not allowed for setuid/setgid script\n");
+    else
+	fatal("Script is not setuid/setgid in suidperl\n");
+#else
+#ifndef TAINT		/* we aren't taintperl or suidperl */
+    /* script has a wrapper--can't run suidperl or we lose euid */
+    else if (euid != uid || egid != gid) {
+	(void)fclose(rsfp);
+	(void)sprintf(buf, "%s/tperl%s", BIN, patchlevel);
+	execv(buf, origargv);	/* try again */
+	fatal("Can't run setuid script with taint checks");
+    }
+#endif /* TAINT */
+#endif /* IAMSUID */
+#else /* !DOSUID */
+#ifndef TAINT		/* we aren't taintperl or suidperl */
+    if (euid != uid || egid != gid) {	/* (suidperl doesn't exist, in fact) */
+#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
+	fstat(fileno(rsfp),&statbuf);	/* may be either wrapped or real suid */
+	if ((euid != uid && euid == statbuf.st_uid && statbuf.st_mode & S_ISUID)
+	    ||
+	    (egid != gid && egid == statbuf.st_gid && statbuf.st_mode & S_ISGID)
+	   )
+	    if (!do_undump)
+		fatal("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
+FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
+#endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
+	/* not set-id, must be wrapped */
+	(void)fclose(rsfp);
+	(void)sprintf(buf, "%s/tperl%s", BIN, patchlevel);
+	execv(buf, origargv);	/* try again */
+	fatal("Can't run setuid script with taint checks");
+    }
+#endif /* TAINT */
+#endif /* DOSUID */
+
+#if !defined(IAMSUID) && !defined(TAINT)
+
+    /* skip forward in input to the real script? */
+
+    while (doextract) {
+	if ((s = str_gets(linestr, rsfp, 0)) == Nullch)
+	    fatal("No Perl script found in input\n");
+	if (*s == '#' && s[1] == '!' && instr(s,"perl")) {
+	    ungetc('\n',rsfp);		/* to keep line count right */
+	    doextract = FALSE;
+	    if (s = instr(s,"perl -")) {
+		s += 6;
+		/*SUPPRESS 530*/
+		while (s = moreswitches(s)) ;
+	    }
+	    if (cddir && chdir(cddir) < 0)
+		fatal("Can't chdir to %s",cddir);
+	}
+    }
+#endif /* !defined(IAMSUID) && !defined(TAINT) */
+
+    defstab = stabent("_",TRUE);
+
+    subname = str_make("main",4);
+    if (perldb) {
+	debstash = hnew(0);
+	stab_xhash(stabent("_DB",TRUE)) = debstash;
+	curstash = debstash;
+	dbargs = stab_xarray(aadd((tmpstab = stabent("args",TRUE))));
+	tmpstab->str_pok |= SP_MULTI;
+	dbargs->ary_flags = 0;
+	DBstab = stabent("DB",TRUE);
+	DBstab->str_pok |= SP_MULTI;
+	DBline = stabent("dbline",TRUE);
+	DBline->str_pok |= SP_MULTI;
+	DBsub = hadd(tmpstab = stabent("sub",TRUE));
+	tmpstab->str_pok |= SP_MULTI;
+	DBsingle = stab_val((tmpstab = stabent("single",TRUE)));
+	tmpstab->str_pok |= SP_MULTI;
+	DBtrace = stab_val((tmpstab = stabent("trace",TRUE)));
+	tmpstab->str_pok |= SP_MULTI;
+	DBsignal = stab_val((tmpstab = stabent("signal",TRUE)));
+	tmpstab->str_pok |= SP_MULTI;
+	curstash = defstash;
+    }
+
+    /* init tokener */
+
+    bufend = bufptr = str_get(linestr);
+
+    savestack = anew(Nullstab);		/* for saving non-local values */
+    stack = anew(Nullstab);		/* for saving non-local values */
+    stack->ary_flags = 0;		/* not a real array */
+    afill(stack,63); afill(stack,-1);	/* preextend stack */
+    afill(savestack,63); afill(savestack,-1);
+
+    /* now parse the script */
+
+    error_count = 0;
+    if (yyparse() || error_count) {
+	if (minus_c)
+	    fatal("%s had compilation errors.\n", origfilename);
+	else {
+	    fatal("Execution of %s aborted due to compilation errors.\n",
+		origfilename);
+	}
+    }
+
+    New(50,loop_stack,128,struct loop);
+#ifdef DEBUGGING
+    if (debug) {
+	New(51,debname,128,char);
+	New(52,debdelim,128,char);
+    }
+#endif
+    curstash = defstash;
+
+    preprocess = FALSE;
+    if (e_fp) {
+	e_fp = Nullfp;
+	(void)UNLINK(e_tmpname);
+    }
+
+    /* initialize everything that won't change if we undump */
+
+    if (sigstab = stabent("SIG",allstabs)) {
+	sigstab->str_pok |= SP_MULTI;
+	(void)hadd(sigstab);
+    }
+
+    magicalize("!#?^~=-%.+&*()<>,\\/[|`':\004\t\020\024\027\006");
+    userinit();		/* in case linked C routines want magical variables */
+
+    amperstab = stabent("&",allstabs);
+    leftstab = stabent("`",allstabs);
+    rightstab = stabent("'",allstabs);
+    sawampersand = (amperstab || leftstab || rightstab);
+    if (tmpstab = stabent(":",allstabs))
+	str_set(stab_val(tmpstab),chopset);
+    if (tmpstab = stabent("\024",allstabs))
+	time(&basetime);
+
+    /* these aren't necessarily magical */
+    if (tmpstab = stabent("\014",allstabs)) {
+	str_set(stab_val(tmpstab),"\f");
+	formfeed = stab_val(tmpstab);
+    }
+    if (tmpstab = stabent(";",allstabs))
+	str_set(STAB_STR(tmpstab),"\034");
+    if (tmpstab = stabent("]",allstabs)) {
+	str = STAB_STR(tmpstab);
+	str_set(str,rcsid);
+	str->str_u.str_nval = atof(patchlevel);
+	str->str_nok = 1;
+    }
+    str_nset(stab_val(stabent("\"", TRUE)), " ", 1);
+
+    stdinstab = stabent("STDIN",TRUE);
+    stdinstab->str_pok |= SP_MULTI;
+    if (!stab_io(stdinstab))
+	stab_io(stdinstab) = stio_new();
+    stab_io(stdinstab)->ifp = stdin;
+    tmpstab = stabent("stdin",TRUE);
+    stab_io(tmpstab) = stab_io(stdinstab);
+    tmpstab->str_pok |= SP_MULTI;
+
+    tmpstab = stabent("STDOUT",TRUE);
+    tmpstab->str_pok |= SP_MULTI;
+    if (!stab_io(tmpstab))
+	stab_io(tmpstab) = stio_new();
+    stab_io(tmpstab)->ofp = stab_io(tmpstab)->ifp = stdout;
+    defoutstab = tmpstab;
+    tmpstab = stabent("stdout",TRUE);
+    stab_io(tmpstab) = stab_io(defoutstab);
+    tmpstab->str_pok |= SP_MULTI;
+
+    curoutstab = stabent("STDERR",TRUE);
+    curoutstab->str_pok |= SP_MULTI;
+    if (!stab_io(curoutstab))
+	stab_io(curoutstab) = stio_new();
+    stab_io(curoutstab)->ofp = stab_io(curoutstab)->ifp = stderr;
+    tmpstab = stabent("stderr",TRUE);
+    stab_io(tmpstab) = stab_io(curoutstab);
+    tmpstab->str_pok |= SP_MULTI;
+    curoutstab = defoutstab;		/* switch back to STDOUT */
+
+    statname = Str_new(66,0);		/* last filename we did stat on */
+
+    /* now that script is parsed, we can modify record separator */
+
+    rs = nrs;
+    rslen = nrslen;
+    rschar = nrschar;
+    rspara = (nrslen == 2);
+    str_nset(stab_val(stabent("/", TRUE)), rs, rslen);
+
+    if (do_undump)
+	my_unexec();
+
+  just_doit:		/* come here if running an undumped a.out */
+    argc--,argv++;	/* skip name of script */
+    if (doswitches) {
+	for (; argc > 0 && **argv == '-'; argc--,argv++) {
+	    if (argv[0][1] == '-') {
+		argc--,argv++;
+		break;
+	    }
+	    if (s = index(argv[0], '=')) {
+		*s++ = '\0';
+		str_set(stab_val(stabent(argv[0]+1,TRUE)),s);
+	    }
+	    else
+		str_numset(stab_val(stabent(argv[0]+1,TRUE)),(double)1.0);
+	}
+    }
+#ifdef TAINT
+    tainted = 1;
+#endif
+    if (tmpstab = stabent("0",allstabs)) {
+	str_set(stab_val(tmpstab),origfilename);
+	magicname("0", Nullch, 0);
+    }
+    if (tmpstab = stabent("\030",allstabs))
+	str_set(stab_val(tmpstab),origargv[0]);
+    if (argvstab = stabent("ARGV",allstabs)) {
+	argvstab->str_pok |= SP_MULTI;
+	(void)aadd(argvstab);
+	aclear(stab_array(argvstab));
+	for (; argc > 0; argc--,argv++) {
+	    (void)apush(stab_array(argvstab),str_make(argv[0],0));
+	}
+    }
+#ifdef TAINT
+    (void) stabent("ENV",TRUE);		/* must test PATH and IFS */
+#endif
+    if (envstab = stabent("ENV",allstabs)) {
+	envstab->str_pok |= SP_MULTI;
+	(void)hadd(envstab);
+	hclear(stab_hash(envstab), FALSE);
+	if (env != environ)
+	    environ[0] = Nullch;
+	for (; *env; env++) {
+	    if (!(s = index(*env,'=')))
+		continue;
+	    *s++ = '\0';
+	    str = str_make(s--,0);
+	    str_magic(str, envstab, 'E', *env, s - *env);
+	    (void)hstore(stab_hash(envstab), *env, s - *env, str, 0);
+	    *s = '=';
+	}
+    }
+#ifdef TAINT
+    tainted = 0;
+#endif
+    if (tmpstab = stabent("$",allstabs))
+	str_numset(STAB_STR(tmpstab),(double)getpid());
+
+    if (dowarn) {
+	stab_check('A','Z');
+	stab_check('a','z');
+    }
+
+    if (setjmp(top_env))	/* sets goto_targ on longjump */
+	loop_ptr = -1;		/* start label stack again */
+
+#ifdef DEBUGGING
+    if (debug & 1024)
+	dump_all();
+    if (debug)
+	fprintf(stderr,"\nEXECUTING...\n\n");
+#endif
+
+    if (minus_c) {
+	fprintf(stderr,"%s syntax OK\n", origfilename);
+	exit(0);
+    }
+
+    /* do it */
+
+    (void) cmd_exec(main_root,G_SCALAR,-1);
+
+    if (goto_targ)
+	fatal("Can't find label \"%s\"--aborting",goto_targ);
+    exit(0);
+    /* NOTREACHED */
+}
+
+void
+magicalize(list)
+register char *list;
+{
+    char sym[2];
+
+    sym[1] = '\0';
+    while (*sym = *list++)
+	magicname(sym, Nullch, 0);
+}
+
+void
+magicname(sym,name,namlen)
+char *sym;
+char *name;
+int namlen;
+{
+    register STAB *stab;
+
+    if (stab = stabent(sym,allstabs)) {
+	stab_flags(stab) = SF_VMAGIC;
+	str_magic(stab_val(stab), stab, 0, name, namlen);
+    }
+}
+
+static void
+incpush(p)
+char *p;
+{
+    char *s;
+
+    if (!p)
+	return;
+
+    /* Break at all separators */
+    while (*p) {
+	/* First, skip any consecutive separators */
+	while ( *p == PERLLIB_SEP ) {
+	    /* Uncomment the next line for PATH semantics */
+	    /* (void)apush(stab_array(incstab), str_make(".", 1)); */
+	    p++;
+	}
+	if ( (s = index(p, PERLLIB_SEP)) != Nullch ) {
+	    (void)apush(stab_array(incstab), str_make(p, (int)(s - p)));
+	    p = s + 1;
+	} else {
+	    (void)apush(stab_array(incstab), str_make(p, 0));
+	    break;
+	}
+    }
+}
+
+void
+savelines(array, str)
+ARRAY *array;
+STR *str;
+{
+    register char *s = str->str_ptr;
+    register char *send = str->str_ptr + str->str_cur;
+    register char *t;
+    register int line = 1;
+
+    while (s && s < send) {
+	STR *tmpstr = Str_new(85,0);
+
+	t = index(s, '\n');
+	if (t)
+	    t++;
+	else
+	    t = send;
+
+	str_nset(tmpstr, s, t - s);
+	astore(array, line++, tmpstr);
+	s = t;
+    }
+}
+
+/* this routine is in perl.c by virtue of being sort of an alternate main() */
+
+int
+do_eval(str,optype,stash,savecmd,gimme,arglast)
+STR *str;
+int optype;
+HASH *stash;
+int savecmd;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    int retval;
+    CMD *myroot = Nullcmd;
+    ARRAY *ar;
+    int i;
+    CMD * VOLATILE oldcurcmd = curcmd;
+    VOLATILE int oldtmps_base = tmps_base;
+    VOLATILE int oldsave = savestack->ary_fill;
+    VOLATILE int oldperldb = perldb;
+    SPAT * VOLATILE oldspat = curspat;
+    SPAT * VOLATILE oldlspat = lastspat;
+    static char *last_eval = Nullch;
+    static long last_elen = 0;
+    static CMD *last_root = Nullcmd;
+    VOLATILE int sp = arglast[0];
+    char *specfilename;
+    char *tmpfilename;
+    int parsing = 1;
+
+    tmps_base = tmps_max;
+    if (curstash != stash) {
+	(void)savehptr(&curstash);
+	curstash = stash;
+    }
+    str_set(stab_val(stabent("@",TRUE)),"");
+    if (curcmd->c_line == 0)		/* don't debug debugger... */
+	perldb = FALSE;
+    curcmd = &compiling;
+    if (optype == O_EVAL) {		/* normal eval */
+	curcmd->c_filestab = fstab("(eval)");
+	curcmd->c_line = 1;
+	str_sset(linestr,str);
+	str_cat(linestr,";\n;\n");	/* be kind to them */
+	if (perldb)
+	    savelines(stab_xarray(curcmd->c_filestab), linestr);
+    }
+    else {
+	if (last_root && !in_eval) {
+	    Safefree(last_eval);
+	    last_eval = Nullch;
+	    cmd_free(last_root);
+	    last_root = Nullcmd;
+	}
+	specfilename = str_get(str);
+	str_set(linestr,"");
+	if (optype == O_REQUIRE && &str_undef !=
+	  hfetch(stab_hash(incstab), specfilename, strlen(specfilename), 0)) {
+	    curcmd = oldcurcmd;
+	    tmps_base = oldtmps_base;
+	    st[++sp] = &str_yes;
+	    perldb = oldperldb;
+	    return sp;
+	}
+	tmpfilename = savestr(specfilename);
+	if (*tmpfilename == '/' ||
+	    (*tmpfilename == '.' && 
+		(tmpfilename[1] == '/' ||
+		 (tmpfilename[1] == '.' && tmpfilename[2] == '/'))))
+	{
+	    rsfp = fopen(tmpfilename,"r");
+	}
+	else {
+	    ar = stab_array(incstab);
+	    for (i = 0; i <= ar->ary_fill; i++) {
+		(void)sprintf(buf, "%s/%s",
+		  str_get(afetch(ar,i,TRUE)), specfilename);
+		rsfp = fopen(buf,"r");
+		if (rsfp) {
+		    char *s = buf;
+
+		    if (*s == '.' && s[1] == '/')
+			s += 2;
+		    Safefree(tmpfilename);
+		    tmpfilename = savestr(s);
+		    break;
+		}
+	    }
+	}
+	curcmd->c_filestab = fstab(tmpfilename);
+	Safefree(tmpfilename);
+	tmpfilename = Nullch;
+	if (!rsfp) {
+	    curcmd = oldcurcmd;
+	    tmps_base = oldtmps_base;
+	    if (optype == O_REQUIRE) {
+		sprintf(tokenbuf,"Can't locate %s in @INC", specfilename);
+		if (instr(tokenbuf,".h "))
+		    strcat(tokenbuf," (change .h to .ph maybe?)");
+		if (instr(tokenbuf,".ph "))
+		    strcat(tokenbuf," (did you run h2ph?)");
+		fatal("%s",tokenbuf);
+	    }
+	    if (gimme != G_ARRAY)
+		st[++sp] = &str_undef;
+	    perldb = oldperldb;
+	    return sp;
+	}
+	curcmd->c_line = 0;
+    }
+    in_eval++;
+    oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
+    bufend = bufptr + linestr->str_cur;
+    if (++loop_ptr >= loop_max) {
+	loop_max += 128;
+	Renew(loop_stack, loop_max, struct loop);
+    }
+    loop_stack[loop_ptr].loop_label = "_EVAL_";
+    loop_stack[loop_ptr].loop_sp = sp;
+#ifdef DEBUGGING
+    if (debug & 4) {
+	deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
+    }
+#endif
+    eval_root = Nullcmd;
+    if (setjmp(loop_stack[loop_ptr].loop_env)) {
+	retval = 1;
+    }
+    else {
+	error_count = 0;
+	if (rsfp) {
+	    retval = yyparse();
+	    retval |= error_count;
+	}
+	else if (last_root && last_elen == bufend - bufptr
+	  && *bufptr == *last_eval && !bcmp(bufptr,last_eval,last_elen)){
+	    retval = 0;
+	    eval_root = last_root;	/* no point in reparsing */
+	}
+	else if (in_eval == 1 && !savecmd) {
+	    if (last_root) {
+		Safefree(last_eval);
+		last_eval = Nullch;
+		cmd_free(last_root);
+	    }
+	    last_root = Nullcmd;
+	    last_elen = bufend - bufptr;
+	    last_eval = nsavestr(bufptr, last_elen);
+	    retval = yyparse();
+	    retval |= error_count;
+	    if (!retval)
+		last_root = eval_root;
+	    if (!last_root) {
+		Safefree(last_eval);
+		last_eval = Nullch;
+	    }
+	}
+	else
+	    retval = yyparse();
+    }
+    myroot = eval_root;		/* in case cmd_exec does another eval! */
+
+    if (retval || error_count) {
+	st = stack->ary_array;
+	sp = arglast[0];
+	if (gimme != G_ARRAY)
+	    st[++sp] = &str_undef;
+	if (parsing) {
+#ifndef MANGLEDPARSE
+#ifdef DEBUGGING
+	    if (debug & 128)
+		fprintf(stderr,"Freeing eval_root %lx\n",(long)eval_root);
+#endif
+	    cmd_free(eval_root);
+#endif
+	    /*SUPPRESS 29*/ /*SUPPRESS 30*/
+	    if ((CMD*)eval_root == last_root)
+		last_root = Nullcmd;
+	    eval_root = myroot = Nullcmd;
+	}
+	if (rsfp) {
+	    fclose(rsfp);
+	    rsfp = 0;
+	}
+    }
+    else {
+	parsing = 0;
+	sp = cmd_exec(eval_root,gimme,sp);
+	st = stack->ary_array;
+	for (i = arglast[0] + 1; i <= sp; i++)
+	    st[i] = str_mortal(st[i]);
+				/* if we don't save result, free zaps it */
+	if (savecmd)
+	    eval_root = myroot;
+	else if (in_eval != 1 && myroot != last_root)
+	    cmd_free(myroot);
+    }
+
+    perldb = oldperldb;
+    in_eval--;
+#ifdef DEBUGGING
+    if (debug & 4) {
+	char *tmps = loop_stack[loop_ptr].loop_label;
+	deb("(Popping label #%d %s)\n",loop_ptr,
+	    tmps ? tmps : "" );
+    }
+#endif
+    loop_ptr--;
+    tmps_base = oldtmps_base;
+    curspat = oldspat;
+    lastspat = oldlspat;
+    if (savestack->ary_fill > oldsave)	/* let them use local() */
+	restorelist(oldsave);
+
+    if (optype != O_EVAL) {
+	if (retval) {
+	    if (optype == O_REQUIRE)
+		fatal("%s", str_get(stab_val(stabent("@",TRUE))));
+	}
+	else {
+	    curcmd = oldcurcmd;
+	    if (gimme == G_SCALAR ? str_true(st[sp]) : sp > arglast[0]) {
+		(void)hstore(stab_hash(incstab), specfilename,
+		  strlen(specfilename), str_smake(stab_val(curcmd->c_filestab)),
+		      0 );
+	    }
+	    else if (optype == O_REQUIRE)
+		fatal("%s did not return a true value", specfilename);
+	}
+    }
+    curcmd = oldcurcmd;
+    return sp;
+}
+
+int
+do_try(cmd,gimme,arglast)
+CMD *cmd;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+
+    CMD * VOLATILE oldcurcmd = curcmd;
+    VOLATILE int oldtmps_base = tmps_base;
+    VOLATILE int oldsave = savestack->ary_fill;
+    SPAT * VOLATILE oldspat = curspat;
+    SPAT * VOLATILE oldlspat = lastspat;
+    VOLATILE int sp = arglast[0];
+
+    tmps_base = tmps_max;
+    str_set(stab_val(stabent("@",TRUE)),"");
+    in_eval++;
+    if (++loop_ptr >= loop_max) {
+	loop_max += 128;
+	Renew(loop_stack, loop_max, struct loop);
+    }
+    loop_stack[loop_ptr].loop_label = "_EVAL_";
+    loop_stack[loop_ptr].loop_sp = sp;
+#ifdef DEBUGGING
+    if (debug & 4) {
+	deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
+    }
+#endif
+    if (setjmp(loop_stack[loop_ptr].loop_env)) {
+	st = stack->ary_array;
+	sp = arglast[0];
+	if (gimme != G_ARRAY)
+	    st[++sp] = &str_undef;
+    }
+    else {
+	sp = cmd_exec(cmd,gimme,sp);
+	st = stack->ary_array;
+/*	for (i = arglast[0] + 1; i <= sp; i++)
+	    st[i] = str_mortal(st[i]);  not needed, I think */
+				/* if we don't save result, free zaps it */
+    }
+
+    in_eval--;
+#ifdef DEBUGGING
+    if (debug & 4) {
+	char *tmps = loop_stack[loop_ptr].loop_label;
+	deb("(Popping label #%d %s)\n",loop_ptr,
+	    tmps ? tmps : "" );
+    }
+#endif
+    loop_ptr--;
+    tmps_base = oldtmps_base;
+    curspat = oldspat;
+    lastspat = oldlspat;
+    curcmd = oldcurcmd;
+    if (savestack->ary_fill > oldsave)	/* let them use local() */
+	restorelist(oldsave);
+
+    return sp;
+}
+
+/* This routine handles any switches that can be given during run */
+
+static char *
+moreswitches(s)
+char *s;
+{
+    int numlen;
+
+    switch (*s) {
+    case '0':
+	nrschar = scanoct(s, 4, &numlen);
+	nrs = nsavestr("\n",1);
+	*nrs = nrschar;
+	if (nrschar > 0377) {
+	    nrslen = 0;
+	    nrs = "";
+	}
+	else if (!nrschar && numlen >= 2) {
+	    nrslen = 2;
+	    nrs = "\n\n";
+	    nrschar = '\n';
+	}
+	return s + numlen;
+    case 'a':
+	minus_a = TRUE;
+	s++;
+	return s;
+    case 'c':
+	minus_c = TRUE;
+	s++;
+	return s;
+    case 'd':
+#ifdef TAINT
+	if (euid != uid || egid != gid)
+	    fatal("No -d allowed in setuid scripts");
+#endif
+	perldb = TRUE;
+	s++;
+	return s;
+    case 'D':
+#ifdef DEBUGGING
+#ifdef TAINT
+	if (euid != uid || egid != gid)
+	    fatal("No -D allowed in setuid scripts");
+#endif
+	debug = atoi(s+1) | 32768;
+#else
+	warn("Recompile perl with -DDEBUGGING to use -D switch\n");
+#endif
+	/*SUPPRESS 530*/
+	for (s++; isDIGIT(*s); s++) ;
+	return s;
+    case 'i':
+	inplace = savestr(s+1);
+	/*SUPPRESS 530*/
+	for (s = inplace; *s && !isSPACE(*s); s++) ;
+	*s = '\0';
+	break;
+    case 'I':
+#ifdef TAINT
+	if (euid != uid || egid != gid)
+	    fatal("No -I allowed in setuid scripts");
+#endif
+	if (*++s) {
+	    (void)apush(stab_array(incstab),str_make(s,0));
+	}
+	else
+	    fatal("No space allowed after -I");
+	break;
+    case 'l':
+	minus_l = TRUE;
+	s++;
+	if (isDIGIT(*s)) {
+	    ors = savestr("\n");
+	    orslen = 1;
+	    *ors = scanoct(s, 3 + (*s == '0'), &numlen);
+	    s += numlen;
+	}
+	else {
+	    ors = nsavestr(nrs,nrslen);
+	    orslen = nrslen;
+	}
+	return s;
+    case 'n':
+	minus_n = TRUE;
+	s++;
+	return s;
+    case 'p':
+	minus_p = TRUE;
+	s++;
+	return s;
+    case 'u':
+	do_undump = TRUE;
+	s++;
+	return s;
+    case 'U':
+	unsafe = TRUE;
+	s++;
+	return s;
+    case 'v':
+	fputs("\nThis is perl, version 4.0\n\n",stdout);
+	fputs(rcsid,stdout);
+	fputs("\nCopyright (c) 1989, 1990, 1991, Larry Wall\n",stdout);
+#ifdef MSDOS
+	fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
+	stdout);
+#ifdef OS2
+        fputs("OS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n",
+        stdout);
+#endif
+#endif
+#ifdef atarist
+        fputs("atariST series port, ++jrb  bammi@cadence.com\n", stdout);
+#endif
+	fputs("\n\
+Perl may be copied only under the terms of either the Artistic License or the\n\
+GNU General Public License, which may be found in the Perl 4.0 source kit.\n",stdout);
+#ifdef MSDOS
+        usage(origargv[0]);
+#endif
+	exit(0);
+    case 'w':
+	dowarn = TRUE;
+	s++;
+	return s;
+    case ' ':
+    case '\n':
+    case '\t':
+	break;
+    default:
+	fatal("Switch meaningless after -x: -%s",s);
+    }
+    return Nullch;
+}
+
+/* compliments of Tom Christiansen */
+
+/* unexec() can be found in the Gnu emacs distribution */
+
+void
+my_unexec()
+{
+#ifdef UNEXEC
+    int    status;
+    extern int etext;
+    static char dumpname[BUFSIZ];
+    static char perlpath[256];
+
+    sprintf (dumpname, "%s.perldump", origfilename);
+    sprintf (perlpath, "%s/perl", BIN);
+
+    status = unexec(dumpname, perlpath, &etext, sbrk(0), 0);
+    if (status)
+	fprintf(stderr, "unexec of %s into %s failed!\n", perlpath, dumpname);
+    exit(status);
+#else
+#ifdef DOSISH
+    abort();	/* nothing else to do */
+#else /* ! MSDOS */
+#   ifndef SIGABRT
+#	define SIGABRT SIGILL
+#   endif
+#   ifndef SIGILL
+#	define SIGILL 6		/* blech */
+#   endif
+    kill(getpid(),SIGABRT);	/* for use with undump */
+#endif /* ! MSDOS */
+#endif
+}
+
diff --git a/perl.c.rej b/perl.c.rej
new file mode 100644
index 0000000000..f9653c926b
--- /dev/null
+++ b/perl.c.rej
@@ -0,0 +1,49 @@
+***************
+*** 1,4 ****
+! char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.7 $$Date: 1992/06/08 14:50:39 $\nPatch level: ###\n";
+  /*
+   *    Copyright (c) 1991, Larry Wall
+   *
+--- 1,4 ----
+! char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.8 $$Date: 1993/02/05 19:39:30 $\nPatch level: ###\n";
+  /*
+   *    Copyright (c) 1991, Larry Wall
+   *
+***************
+*** 6,12 ****
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: perl.c,v $
+!  * Revision 4.0.1.7  1992/06/08  14:50:39  lwall
+   * patch20: PERLLIB now supports multiple directories
+   * patch20: running taintperl explicitly now does checks even if $< == $>
+   * patch20: -e 'cmd' no longer fails silently if /tmp runs out of space
+--- 6,16 ----
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: perl.c,v $
+!  * Revision 4.0.1.8  1993/02/05  19:39:30  lwall
+!  * patch36: the taintanyway code wasn't tainting anyway
+!  * patch36: Malformed cmd links core dump apparently fixed
+!  *
+!  * Revision 4.0.1.7  92/06/08  14:50:39  lwall
+   * patch20: PERLLIB now supports multiple directories
+   * patch20: running taintperl explicitly now does checks even if $< == $>
+   * patch20: -e 'cmd' no longer fails silently if /tmp runs out of space
+***************
+*** 16,22 ****
+   * patch20: eval "1 #comment" didn't work
+   * patch20: couldn't require . files
+   * patch20: semantic compilation errors didn't abort execution
+!  *
+   * Revision 4.0.1.6  91/11/11  16:38:45  lwall
+   * patch19: default arg for shift was wrong after first subroutine definition
+   * patch19: op/regexp.t failed from missing arg to bcmp()
+--- 20,26 ----
+   * patch20: eval "1 #comment" didn't work
+   * patch20: couldn't require . files
+   * patch20: semantic compilation errors didn't abort execution
+!  * 
+   * Revision 4.0.1.6  91/11/11  16:38:45  lwall
+   * patch19: default arg for shift was wrong after first subroutine definition
+   * patch19: op/regexp.t failed from missing arg to bcmp()
diff --git a/perl.h b/perl.h
index 5d9f002052..9d485122c0 100644
--- a/perl.h
+++ b/perl.h
@@ -868,7 +868,7 @@ EXT int lastsize;
 
 EXT char *hexdigit INIT("0123456789abcdef0123456789ABCDEFx");
 EXT char *origfilename;
-EXT FILE * VOLATILE rsfp;
+EXT FILE * VOLATILE rsfp INIT(Nullfp);
 EXT char buf[1024];
 EXT char *bufptr;
 EXT char *oldbufptr;
@@ -952,7 +952,7 @@ void scanconst();
 EXT struct stat statbuf;
 EXT struct stat statcache;
 EXT STAB *statstab INIT(Nullstab);
-EXT STR *statname;
+EXT STR *statname INIT(Nullstr);
 #ifndef MSDOS
 EXT struct tms timesbuf;
 #endif
diff --git a/perl.h.orig b/perl.h.orig
new file mode 100644
index 0000000000..5d9f002052
--- /dev/null
+++ b/perl.h.orig
@@ -0,0 +1,1057 @@
+/* $RCSfile: perl.h,v $$Revision: 4.0.1.6 $$Date: 92/06/08 14:55:10 $
+ *
+ *    Copyright (c) 1991, 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:	perl.h,v $
+ * Revision 4.0.1.6  92/06/08  14:55:10  lwall
+ * patch20: added Atari ST portability
+ * patch20: bcopy() and memcpy() now tested for overlap safety
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: removed implicit int declarations on functions
+ * 
+ * Revision 4.0.1.5  91/11/11  16:41:07  lwall
+ * patch19: uts wrongly defines S_ISDIR() et al
+ * patch19: too many preprocessors can't expand a macro right in #if
+ * patch19: added little-endian pack/unpack options
+ * 
+ * Revision 4.0.1.4  91/11/05  18:06:10  lwall
+ * patch11: various portability fixes
+ * patch11: added support for dbz
+ * patch11: added some support for 64-bit integers
+ * patch11: hex() didn't understand leading 0x
+ * 
+ * Revision 4.0.1.3  91/06/10  01:25:10  lwall
+ * patch10: certain pattern optimizations were botched
+ * 
+ * Revision 4.0.1.2  91/06/07  11:28:33  lwall
+ * patch4: new copyright notice
+ * patch4: made some allowances for "semi-standard" C
+ * patch4: many, many itty-bitty portability fixes
+ * 
+ * Revision 4.0.1.1  91/04/11  17:49:51  lwall
+ * patch1: hopefully straightened out some of the Xenix mess
+ * 
+ * Revision 4.0  91/03/20  01:37:56  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#define VOIDWANT 1
+#include "config.h"
+
+#ifdef MYMALLOC
+#   ifdef HIDEMYMALLOC
+#	define malloc Mymalloc
+#	define realloc Myremalloc
+#	define free Myfree
+#   endif
+#   define safemalloc malloc
+#   define saferealloc realloc
+#   define safefree free
+#endif
+
+/* work around some libPW problems */
+#define fatal Myfatal
+#ifdef DOINIT
+char Error[1];
+#endif
+
+/* define this once if either system, instead of cluttering up the src */
+#if defined(MSDOS) || defined(atarist)
+#define DOSISH 1
+#endif
+
+#ifdef DOSISH
+/* This stuff now in the MS-DOS config.h file. */
+#else /* !MSDOS */
+
+/*
+ * The following symbols are defined if your operating system supports
+ * functions by that name.  All Unixes I know of support them, thus they
+ * are not checked by the configuration script, but are directly defined
+ * here.
+ */
+#define HAS_ALARM
+#define HAS_CHOWN
+#define HAS_CHROOT
+#define HAS_FORK
+#define HAS_GETLOGIN
+#define HAS_GETPPID
+#define HAS_KILL
+#define HAS_LINK
+#define HAS_PIPE
+#define HAS_WAIT
+#define HAS_UMASK
+/*
+ * The following symbols are defined if your operating system supports
+ * password and group functions in general.  All Unix systems do.
+ */
+#define HAS_GROUP
+#define HAS_PASSWD
+
+#endif /* !MSDOS */
+
+#if defined(__STDC__) || defined(_AIX) || defined(__stdc__)
+# define STANDARD_C 1
+#endif
+
+#if defined(HASVOLATILE) || defined(STANDARD_C)
+#define VOLATILE volatile
+#else
+#define VOLATILE
+#endif
+
+#ifdef IAMSUID
+#   ifndef TAINT
+#	define TAINT
+#   endif
+#endif
+
+#ifndef HAS_VFORK
+#   define vfork fork
+#endif
+
+#ifdef HAS_GETPGRP2
+#   ifndef HAS_GETPGRP
+#	define HAS_GETPGRP
+#   endif
+#   define getpgrp getpgrp2
+#endif
+
+#ifdef HAS_SETPGRP2
+#   ifndef HAS_SETPGRP
+#	define HAS_SETPGRP
+#   endif
+#   define setpgrp setpgrp2
+#endif
+
+#include <stdio.h>
+#include <ctype.h>
+#include <setjmp.h>
+#ifndef MSDOS
+#ifdef PARAM_NEEDS_TYPES
+#include <sys/types.h>
+#endif
+#include <sys/param.h>
+#endif
+#ifdef STANDARD_C
+/* Use all the "standard" definitions */
+#include <stdlib.h>
+#include <string.h>
+#define MEM_SIZE size_t
+#else
+typedef unsigned int MEM_SIZE;
+#endif /* STANDARD_C */
+
+#if defined(HAS_MEMCMP) && defined(mips) && defined(ultrix)
+#undef HAS_MEMCMP
+#endif
+
+#ifdef HAS_MEMCPY
+#  ifndef STANDARD_C
+#    ifndef memcpy
+	extern char * memcpy();
+#    endif
+#  endif
+#else
+#   ifndef memcpy
+#	ifdef HAS_BCOPY
+#	    define memcpy(d,s,l) bcopy(s,d,l)
+#	else
+#	    define memcpy(d,s,l) my_bcopy(s,d,l)
+#	endif
+#   endif
+#endif /* HAS_MEMCPY */
+
+#ifdef HAS_MEMSET
+#  ifndef STANDARD_C
+#    ifndef memset
+	extern char *memset();
+#    endif
+#  endif
+#  define memzero(d,l) memset(d,0,l)
+#else
+#   ifndef memzero
+#	ifdef HAS_BZERO
+#	    define memzero(d,l) bzero(d,l)
+#	else
+#	    define memzero(d,l) my_bzero(d,l)
+#	endif
+#   endif
+#endif /* HAS_MEMSET */
+
+#ifdef HAS_MEMCMP
+#  ifndef STANDARD_C
+#    ifndef memcmp
+	extern int memcmp();
+#    endif
+#  endif
+#else
+#   ifndef memcmp
+#	define memcmp(s1,s2,l) my_memcmp(s1,s2,l)
+#   endif
+#endif /* HAS_MEMCMP */
+
+/* we prefer bcmp slightly for comparisons that don't care about ordering */
+#ifndef HAS_BCMP
+#   ifndef bcmp
+#	define bcmp(s1,s2,l) memcmp(s1,s2,l)
+#   endif
+#endif /* HAS_BCMP */
+
+#ifndef HAS_MEMMOVE
+#if defined(HAS_BCOPY) && defined(SAFE_BCOPY)
+#define memmove(d,s,l) bcopy(s,d,l)
+#else
+#if defined(HAS_MEMCPY) && defined(SAFE_MEMCPY)
+#define memmove(d,s,l) memcpy(d,s,l)
+#else
+#define memmove(d,s,l) my_bcopy(s,d,l)
+#endif
+#endif
+#endif
+
+#ifndef _TYPES_		/* If types.h defines this it's easy. */
+#ifndef major		/* Does everyone's types.h define this? */
+#include <sys/types.h>
+#endif
+#endif
+
+#ifdef I_NETINET_IN
+#include <netinet/in.h>
+#endif
+
+#include <sys/stat.h>
+#if defined(uts) || defined(UTekV)
+#undef S_ISDIR
+#undef S_ISCHR
+#undef S_ISBLK
+#undef S_ISREG
+#undef S_ISFIFO
+#undef S_ISLNK
+#define S_ISDIR(P) (((P)&S_IFMT)==S_IFDIR)
+#define S_ISCHR(P) (((P)&S_IFMT)==S_IFCHR)
+#define S_ISBLK(P) (((P)&S_IFMT)==S_IFBLK)
+#define S_ISREG(P) (((P)&S_IFMT)==S_IFREG)
+#define S_ISFIFO(P) (((P)&S_IFMT)==S_IFIFO)
+#ifdef S_IFLNK
+#define S_ISLNK(P) (((P)&S_IFMT)==S_IFLNK)
+#endif
+#endif
+
+#ifdef I_TIME
+#   include <time.h>
+#endif
+
+#ifdef I_SYS_TIME
+#   ifdef SYSTIMEKERNEL
+#	define KERNEL
+#   endif
+#   include <sys/time.h>
+#   ifdef SYSTIMEKERNEL
+#	undef KERNEL
+#   endif
+#endif
+
+#ifndef MSDOS
+#include <sys/times.h>
+#endif
+
+#if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
+#undef HAS_STRERROR
+#endif
+
+#include <errno.h>
+#ifndef MSDOS
+#ifndef errno
+extern int errno;     /* ANSI allows errno to be an lvalue expr */
+#endif
+#endif
+
+#ifndef strerror
+#ifdef HAS_STRERROR
+char *strerror();
+#else
+extern int sys_nerr;
+extern char *sys_errlist[];
+#define strerror(e) ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
+#endif
+#endif
+
+#ifdef I_SYSIOCTL
+#ifndef _IOCTL_
+#include <sys/ioctl.h>
+#endif
+#endif
+
+#if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
+#ifdef HAS_SOCKETPAIR
+#undef HAS_SOCKETPAIR
+#endif
+#ifdef HAS_NDBM
+#undef HAS_NDBM
+#endif
+#endif
+
+#ifdef WANT_DBZ
+#include <dbz.h>
+#define SOME_DBM
+#define dbm_fetch(db,dkey) fetch(dkey)
+#define dbm_delete(db,dkey) fatal("dbz doesn't implement delete")
+#define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent)
+#define dbm_close(db) dbmclose()
+#define dbm_firstkey(db) (fatal("dbz doesn't implement traversal"),fetch())
+#define nextkey() (fatal("dbz doesn't implement traversal"),fetch())
+#define dbm_nextkey(db) (fatal("dbz doesn't implement traversal"),fetch())
+#ifdef HAS_NDBM
+#undef HAS_NDBM
+#endif
+#ifndef HAS_ODBM
+#define HAS_ODBM
+#endif
+#else
+#ifdef HAS_GDBM
+#ifdef I_GDBM
+#include <gdbm.h>
+#endif
+#define SOME_DBM
+#ifdef HAS_NDBM
+#undef HAS_NDBM
+#endif
+#ifdef HAS_ODBM
+#undef HAS_ODBM
+#endif
+#else
+#ifdef HAS_NDBM
+#include <ndbm.h>
+#define SOME_DBM
+#ifdef HAS_ODBM
+#undef HAS_ODBM
+#endif
+#else
+#ifdef HAS_ODBM
+#ifdef NULL
+#undef NULL		/* suppress redefinition message */
+#endif
+#include <dbm.h>
+#ifdef NULL
+#undef NULL
+#endif
+#define NULL 0		/* silly thing is, we don't even use this */
+#define SOME_DBM
+#define dbm_fetch(db,dkey) fetch(dkey)
+#define dbm_delete(db,dkey) delete(dkey)
+#define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent)
+#define dbm_close(db) dbmclose()
+#define dbm_firstkey(db) firstkey()
+#endif /* HAS_ODBM */
+#endif /* HAS_NDBM */
+#endif /* HAS_GDBM */
+#endif /* WANT_DBZ */
+#ifdef SOME_DBM
+EXT char *dbmkey;
+EXT int dbmlen;
+#endif
+
+#if INTSIZE == 2
+#define htoni htons
+#define ntohi ntohs
+#else
+#define htoni htonl
+#define ntohi ntohl
+#endif
+
+#if defined(I_DIRENT)
+#   include <dirent.h>
+#   define DIRENT dirent
+#else
+#   ifdef I_SYS_NDIR
+#	include <sys/ndir.h>
+#	define DIRENT direct
+#   else
+#	ifdef I_SYS_DIR
+#	    ifdef hp9000s500
+#		include <ndir.h>	/* may be wrong in the future */
+#	    else
+#		include <sys/dir.h>
+#	    endif
+#	    define DIRENT direct
+#	endif
+#   endif
+#endif
+
+#ifdef FPUTS_BOTCH
+/* work around botch in SunOS 4.0.1 and 4.0.2 */
+#   ifndef fputs
+#	define fputs(str,fp) fprintf(fp,"%s",str)
+#   endif
+#endif
+
+/*
+ * The following gobbledygook brought to you on behalf of __STDC__.
+ * (I could just use #ifndef __STDC__, but this is more bulletproof
+ * in the face of half-implementations.)
+ */
+
+#ifndef S_IFMT
+#   ifdef _S_IFMT
+#	define S_IFMT _S_IFMT
+#   else
+#	define S_IFMT 0170000
+#   endif
+#endif
+
+#ifndef S_ISDIR
+#   define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
+#endif
+
+#ifndef S_ISCHR
+#   define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
+#endif
+
+#ifndef S_ISBLK
+#   ifdef S_IFBLK
+#	define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
+#   else
+#	define S_ISBLK(m) (0)
+#   endif
+#endif
+
+#ifndef S_ISREG
+#   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
+#endif
+
+#ifndef S_ISFIFO
+#   ifdef S_IFIFO
+#	define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
+#   else
+#	define S_ISFIFO(m) (0)
+#   endif
+#endif
+
+#ifndef S_ISLNK
+#   ifdef _S_ISLNK
+#	define S_ISLNK(m) _S_ISLNK(m)
+#   else
+#	ifdef _S_IFLNK
+#	    define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
+#	else
+#	    ifdef S_IFLNK
+#		define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
+#	    else
+#		define S_ISLNK(m) (0)
+#	    endif
+#	endif
+#   endif
+#endif
+
+#ifndef S_ISSOCK
+#   ifdef _S_ISSOCK
+#	define S_ISSOCK(m) _S_ISSOCK(m)
+#   else
+#	ifdef _S_IFSOCK
+#	    define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
+#	else
+#	    ifdef S_IFSOCK
+#		define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
+#	    else
+#		define S_ISSOCK(m) (0)
+#	    endif
+#	endif
+#   endif
+#endif
+
+#ifndef S_IRUSR
+#   ifdef S_IREAD
+#	define S_IRUSR S_IREAD
+#	define S_IWUSR S_IWRITE
+#	define S_IXUSR S_IEXEC
+#   else
+#	define S_IRUSR 0400
+#	define S_IWUSR 0200
+#	define S_IXUSR 0100
+#   endif
+#   define S_IRGRP (S_IRUSR>>3)
+#   define S_IWGRP (S_IWUSR>>3)
+#   define S_IXGRP (S_IXUSR>>3)
+#   define S_IROTH (S_IRUSR>>6)
+#   define S_IWOTH (S_IWUSR>>6)
+#   define S_IXOTH (S_IXUSR>>6)
+#endif
+
+#ifndef S_ISUID
+#   define S_ISUID 04000
+#endif
+
+#ifndef S_ISGID
+#   define S_ISGID 02000
+#endif
+
+#ifdef f_next
+#undef f_next
+#endif
+
+#if defined(cray) || defined(gould) || defined(i860)
+#   define SLOPPYDIVIDE
+#endif
+
+#if defined(cray) || defined(convex) || defined (uts) || BYTEORDER > 0xffff
+#   define QUAD
+#endif
+
+#ifdef QUAD
+#   ifdef cray
+#	define quad int
+#   else
+#	if defined(convex) || defined (uts)
+#	    define quad long long
+#	else
+#	    define quad long
+#	endif
+#   endif
+#endif
+
+typedef MEM_SIZE STRLEN;
+
+typedef struct arg ARG;
+typedef struct cmd CMD;
+typedef struct formcmd FCMD;
+typedef struct scanpat SPAT;
+typedef struct stio STIO;
+typedef struct sub SUBR;
+typedef struct string STR;
+typedef struct atbl ARRAY;
+typedef struct htbl HASH;
+typedef struct regexp REGEXP;
+typedef struct stabptrs STBP;
+typedef struct stab STAB;
+typedef struct callsave CSV;
+
+#include "handy.h"
+#include "regexp.h"
+#include "str.h"
+#include "util.h"
+#include "form.h"
+#include "stab.h"
+#include "spat.h"
+#include "arg.h"
+#include "cmd.h"
+#include "array.h"
+#include "hash.h"
+
+#if defined(iAPX286) || defined(M_I286) || defined(I80286)
+#   define I286
+#endif
+
+#ifndef	STANDARD_C
+#ifdef CHARSPRINTF
+    char *sprintf();
+#else
+    int sprintf();
+#endif
+#endif
+
+EXT char *Yes INIT("1");
+EXT char *No INIT("");
+
+/* "gimme" values */
+
+/* Note: cmd.c assumes that it can use && to produce one of these values! */
+#define G_SCALAR 0
+#define G_ARRAY 1
+
+#ifdef CRIPPLED_CC
+int str_true();
+#else /* !CRIPPLED_CC */
+#define str_true(str) (Str = (str), \
+	(Str->str_pok ? \
+	    ((*Str->str_ptr > '0' || \
+	      Str->str_cur > 1 || \
+	      (Str->str_cur && *Str->str_ptr != '0')) ? 1 : 0) \
+	: \
+	    (Str->str_nok ? (Str->str_u.str_nval != 0.0) : 0 ) ))
+#endif /* CRIPPLED_CC */
+
+#ifdef DEBUGGING
+#define str_peek(str) (Str = (str), \
+	(Str->str_pok ? \
+	    Str->str_ptr : \
+	    (Str->str_nok ? \
+		(sprintf(tokenbuf,"num(%g)",Str->str_u.str_nval), \
+		    (char*)tokenbuf) : \
+		"" )))
+#endif
+
+#ifdef CRIPPLED_CC
+char *str_get();
+#else
+#ifdef TAINT
+#define str_get(str) (Str = (str), tainted |= Str->str_tainted, \
+	(Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
+#else
+#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
+#endif /* TAINT */
+#endif /* CRIPPLED_CC */
+
+#ifdef CRIPPLED_CC
+double str_gnum();
+#else /* !CRIPPLED_CC */
+#ifdef TAINT
+#define str_gnum(str) (Str = (str), tainted |= Str->str_tainted, \
+	(Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
+#else /* !TAINT */
+#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
+#endif /* TAINT*/
+#endif /* CRIPPLED_CC */
+EXT STR *Str;
+
+#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
+
+#ifndef DOSISH
+#define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len)
+#define Str_Grow str_grow
+#else
+/* extra parentheses intentionally NOT placed around "len"! */
+#define STR_GROW(str,len) if ((str)->str_len < (unsigned long)len) \
+		str_grow(str,(unsigned long)len)
+#define Str_Grow(str,len) str_grow(str,(unsigned long)(len))
+#endif /* DOSISH */
+
+#ifndef BYTEORDER
+#define BYTEORDER 0x1234
+#endif
+
+#if defined(htonl) && !defined(HAS_HTONL)
+#define HAS_HTONL
+#endif
+#if defined(htons) && !defined(HAS_HTONS)
+#define HAS_HTONS
+#endif
+#if defined(ntohl) && !defined(HAS_NTOHL)
+#define HAS_NTOHL
+#endif
+#if defined(ntohs) && !defined(HAS_NTOHS)
+#define HAS_NTOHS
+#endif
+#ifndef HAS_HTONL
+#if (BYTEORDER & 0xffff) != 0x4321
+#define HAS_HTONS
+#define HAS_HTONL
+#define HAS_NTOHS
+#define HAS_NTOHL
+#define MYSWAP
+#define htons my_swap
+#define htonl my_htonl
+#define ntohs my_swap
+#define ntohl my_ntohl
+#endif
+#else
+#if (BYTEORDER & 0xffff) == 0x4321
+#undef HAS_HTONS
+#undef HAS_HTONL
+#undef HAS_NTOHS
+#undef HAS_NTOHL
+#endif
+#endif
+
+/*
+ * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
+ * -DWS
+ */
+#if BYTEORDER != 0x1234
+# define HAS_VTOHL
+# define HAS_VTOHS
+# define HAS_HTOVL
+# define HAS_HTOVS
+# if BYTEORDER == 0x4321
+#  define vtohl(x)	((((x)&0xFF)<<24)	\
+			+(((x)>>24)&0xFF)	\
+			+(((x)&0x0000FF00)<<8)	\
+			+(((x)&0x00FF0000)>>8)	)
+#  define vtohs(x)	((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
+#  define htovl(x)	vtohl(x)
+#  define htovs(x)	vtohs(x)
+# endif
+	/* otherwise default to functions in util.c */
+#endif
+
+#ifdef CASTNEGFLOAT
+#define U_S(what) ((unsigned short)(what))
+#define U_I(what) ((unsigned int)(what))
+#define U_L(what) ((unsigned long)(what))
+#else
+unsigned long castulong();
+#define U_S(what) ((unsigned int)castulong(what))
+#define U_I(what) ((unsigned int)castulong(what))
+#define U_L(what) (castulong(what))
+#endif
+
+CMD *add_label();
+CMD *block_head();
+CMD *append_line();
+CMD *make_acmd();
+CMD *make_ccmd();
+CMD *make_icmd();
+CMD *invert();
+CMD *addcond();
+CMD *addloop();
+CMD *wopt();
+CMD *over();
+
+STAB *stabent();
+STAB *genstab();
+
+ARG *stab2arg();
+ARG *op_new();
+ARG *make_op();
+ARG *make_match();
+ARG *make_split();
+ARG *rcatmaybe();
+ARG *listish();
+ARG *maybelistish();
+ARG *localize();
+ARG *fixeval();
+ARG *jmaybe();
+ARG *l();
+ARG *fixl();
+ARG *mod_match();
+ARG *make_list();
+ARG *cmd_to_arg();
+ARG *addflags();
+ARG *hide_ary();
+ARG *cval_to_arg();
+
+STR *str_new();
+STR *stab_str();
+
+int apply();
+int do_each();
+int do_subr();
+int do_match();
+int do_unpack();
+int eval();		/* this evaluates expressions */
+int do_eval();		/* this evaluates eval operator */
+int do_assign();
+
+SUBR *make_sub();
+
+FCMD *load_format();
+
+char *scanpat();
+char *scansubst();
+char *scantrans();
+char *scanstr();
+char *scanident();
+char *str_append_till();
+char *str_gets();
+char *str_grow();
+
+bool do_open();
+bool do_close();
+bool do_print();
+bool do_aprint();
+bool do_exec();
+bool do_aexec();
+
+int do_subst();
+int cando();
+int ingroup();
+int whichsig();
+int userinit();
+#ifdef CRYPTSCRIPT
+void cryptswitch();
+#endif
+
+void str_replace();
+void str_inc();
+void str_dec();
+void str_free();
+void cmd_free();
+void arg_free();
+void spat_free();
+void regfree();
+void stab_clear();
+void do_chop();
+void do_vop();
+void do_write();
+void do_join();
+void do_sprintf();
+void do_accept();
+void do_pipe();
+void do_vecset();
+void do_unshift();
+void do_execfree();
+void magicalize();
+void magicname();
+void savelist();
+void saveitem();
+void saveint();
+void savelong();
+void savesptr();
+void savehptr();
+void restorelist();
+void repeatcpy();
+void make_form();
+void dehoist();
+void format();
+void my_unexec();
+void fatal();
+void warn();
+#ifdef DEBUGGING
+void dump_all();
+void dump_cmd();
+void dump_arg();
+void dump_flags();
+void dump_stab();
+void dump_spat();
+#endif
+#ifdef MSTATS
+void mstats();
+#endif
+
+HASH *savehash();
+ARRAY *saveary();
+
+EXT char **origargv;
+EXT int origargc;
+EXT char **origenviron;
+extern char **environ;
+
+EXT long subline INIT(0);
+EXT STR *subname INIT(Nullstr);
+EXT int arybase INIT(0);
+
+struct outrec {
+    long	o_lines;
+    char	*o_str;
+    int		o_len;
+};
+
+EXT struct outrec outrec;
+EXT struct outrec toprec;
+
+EXT STAB *stdinstab INIT(Nullstab);
+EXT STAB *last_in_stab INIT(Nullstab);
+EXT STAB *defstab INIT(Nullstab);
+EXT STAB *argvstab INIT(Nullstab);
+EXT STAB *envstab INIT(Nullstab);
+EXT STAB *sigstab INIT(Nullstab);
+EXT STAB *defoutstab INIT(Nullstab);
+EXT STAB *curoutstab INIT(Nullstab);
+EXT STAB *argvoutstab INIT(Nullstab);
+EXT STAB *incstab INIT(Nullstab);
+EXT STAB *leftstab INIT(Nullstab);
+EXT STAB *amperstab INIT(Nullstab);
+EXT STAB *rightstab INIT(Nullstab);
+EXT STAB *DBstab INIT(Nullstab);
+EXT STAB *DBline INIT(Nullstab);
+EXT STAB *DBsub INIT(Nullstab);
+
+EXT HASH *defstash;		/* main symbol table */
+EXT HASH *curstash;		/* symbol table for current package */
+EXT HASH *debstash;		/* symbol table for perldb package */
+
+EXT STR *curstname;		/* name of current package */
+
+EXT STR *freestrroot INIT(Nullstr);
+EXT STR *lastretstr INIT(Nullstr);
+EXT STR *DBsingle INIT(Nullstr);
+EXT STR *DBtrace INIT(Nullstr);
+EXT STR *DBsignal INIT(Nullstr);
+EXT STR *formfeed INIT(Nullstr);
+
+EXT int lastspbase;
+EXT int lastsize;
+
+EXT char *hexdigit INIT("0123456789abcdef0123456789ABCDEFx");
+EXT char *origfilename;
+EXT FILE * VOLATILE rsfp;
+EXT char buf[1024];
+EXT char *bufptr;
+EXT char *oldbufptr;
+EXT char *oldoldbufptr;
+EXT char *bufend;
+
+EXT STR *linestr INIT(Nullstr);
+
+EXT char *rs INIT("\n");
+EXT int rschar INIT('\n');	/* final char of rs, or 0777 if none */
+EXT int rslen INIT(1);
+EXT bool rspara INIT(FALSE);
+EXT char *ofs INIT(Nullch);
+EXT int ofslen INIT(0);
+EXT char *ors INIT(Nullch);
+EXT int orslen INIT(0);
+EXT char *ofmt INIT(Nullch);
+EXT char *inplace INIT(Nullch);
+EXT char *nointrp INIT("");
+
+EXT bool preprocess INIT(FALSE);
+EXT bool minus_n INIT(FALSE);
+EXT bool minus_p INIT(FALSE);
+EXT bool minus_l INIT(FALSE);
+EXT bool minus_a INIT(FALSE);
+EXT bool doswitches INIT(FALSE);
+EXT bool dowarn INIT(FALSE);
+EXT bool doextract INIT(FALSE);
+EXT bool allstabs INIT(FALSE);	/* init all customary symbols in symbol table?*/
+EXT bool sawampersand INIT(FALSE);	/* must save all match strings */
+EXT bool sawstudy INIT(FALSE);		/* do fbminstr on all strings */
+EXT bool sawi INIT(FALSE);		/* study must assume case insensitive */
+EXT bool sawvec INIT(FALSE);
+EXT bool localizing INIT(FALSE);	/* are we processing a local() list? */
+
+#ifndef MAXSYSFD
+#   define MAXSYSFD 2
+#endif
+EXT int maxsysfd INIT(MAXSYSFD);	/* top fd to pass to subprocesses */
+
+#ifdef CSH
+EXT char *cshname INIT(CSH);
+EXT int cshlen INIT(0);
+#endif /* CSH */
+
+#ifdef TAINT
+EXT bool tainted INIT(FALSE);		/* using variables controlled by $< */
+EXT bool taintanyway INIT(FALSE);	/* force taint checks when !set?id */
+#endif
+
+EXT bool nomemok INIT(FALSE);		/* let malloc context handle nomem */
+
+#ifndef DOSISH
+#define TMPPATH "/tmp/perl-eXXXXXX"
+#else
+#define TMPPATH "plXXXXXX"
+#endif /* MSDOS */
+EXT char *e_tmpname;
+EXT FILE *e_fp INIT(Nullfp);
+
+EXT char tokenbuf[256];
+EXT int expectterm INIT(TRUE);		/* how to interpret ambiguous tokens */
+EXT VOLATILE int in_eval INIT(FALSE);	/* trap fatal errors? */
+EXT int multiline INIT(0);		/* $*--do strings hold >1 line? */
+EXT int forkprocess;			/* so do_open |- can return proc# */
+EXT int do_undump INIT(0);		/* -u or dump seen? */
+EXT int error_count INIT(0);		/* how many errors so far, max 10 */
+EXT int multi_start INIT(0);		/* 1st line of multi-line string */
+EXT int multi_end INIT(0);		/* last line of multi-line string */
+EXT int multi_open INIT(0);		/* delimiter of said string */
+EXT int multi_close INIT(0);		/* delimiter of said string */
+
+FILE *popen();
+/* char *str_get(); */
+STR *interp();
+void free_arg();
+STIO *stio_new();
+void hoistmust();
+void scanconst();
+
+EXT struct stat statbuf;
+EXT struct stat statcache;
+EXT STAB *statstab INIT(Nullstab);
+EXT STR *statname;
+#ifndef MSDOS
+EXT struct tms timesbuf;
+#endif
+EXT int uid;
+EXT int euid;
+EXT int gid;
+EXT int egid;
+UIDTYPE getuid();
+UIDTYPE geteuid();
+GIDTYPE getgid();
+GIDTYPE getegid();
+EXT int unsafe;
+
+#ifdef DEBUGGING
+EXT VOLATILE int debug INIT(0);
+EXT int dlevel INIT(0);
+EXT int dlmax INIT(128);
+EXT char *debname;
+EXT char *debdelim;
+#define YYDEBUG 1
+#endif
+EXT int perldb INIT(0);
+#define YYMAXDEPTH 300
+
+EXT line_t cmdline INIT(NOLINE);
+
+EXT STR str_undef;
+EXT STR str_no;
+EXT STR str_yes;
+
+/* runtime control stuff */
+
+EXT struct loop {
+    char *loop_label;		/* what the loop was called, if anything */
+    int loop_sp;		/* stack pointer to copy stuff down to */
+    jmp_buf loop_env;
+} *loop_stack;
+
+EXT int loop_ptr INIT(-1);
+EXT int loop_max INIT(128);
+
+EXT jmp_buf top_env;
+
+EXT char * VOLATILE goto_targ INIT(Nullch); /* cmd_exec gets strange when set */
+
+struct ufuncs {
+    int (*uf_val)();
+    int (*uf_set)();
+    int uf_index;
+};
+
+EXT ARRAY *stack;		/* THE STACK */
+
+EXT ARRAY * VOLATILE savestack;		/* to save non-local values on */
+
+EXT ARRAY *tosave;		/* strings to save on recursive subroutine */
+
+EXT ARRAY *lineary;		/* lines of script for debugger */
+EXT ARRAY *dbargs;		/* args to call listed by caller function */
+
+EXT ARRAY *fdpid;		/* keep fd-to-pid mappings for mypopen */
+EXT HASH *pidstatus;		/* keep pid-to-status mappings for waitpid */
+
+EXT int *di;			/* for tmp use in debuggers */
+EXT char *dc;
+EXT short *ds;
+
+/* Fix these up for __STDC__ */
+EXT time_t basetime INIT(0);
+char *mktemp();
+#ifndef STANDARD_C
+/* All of these are in stdlib.h or time.h for ANSI C */
+double atof();
+long time();
+struct tm *gmtime(), *localtime();
+char *index(), *rindex();
+char *strcpy(), *strcat();
+#endif /* ! STANDARD_C */
+
+#ifdef EUNICE
+#define UNLINK unlnk
+int unlnk();
+#else
+#define UNLINK unlink
+#endif
+
+#ifndef HAS_SETREUID
+#ifdef HAS_SETRESUID
+#define setreuid(r,e) setresuid(r,e,-1)
+#define HAS_SETREUID
+#endif
+#endif
+#ifndef HAS_SETREGID
+#ifdef HAS_SETRESGID
+#define setregid(r,e) setresgid(r,e,-1)
+#define HAS_SETREGID
+#endif
+#endif
+
+#define SCAN_DEF 0
+#define SCAN_TR 1
+#define SCAN_REPL 2
diff --git a/perl.h.rej b/perl.h.rej
new file mode 100644
index 0000000000..0ecf644d64
--- /dev/null
+++ b/perl.h.rej
@@ -0,0 +1,41 @@
+***************
+*** 1,4 ****
+! /* $RCSfile: perl.h,v $$Revision: 4.0.1.6 $$Date: 1992/06/08 14:55:10 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+--- 1,4 ----
+! /* $RCSfile: perl.h,v $$Revision: 4.0.1.7 $$Date: 1993/02/05 19:40:30 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+***************
+*** 6,17 ****
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: perl.h,v $
+!  * Revision 4.0.1.6  1992/06/08  14:55:10  lwall
+   * patch20: added Atari ST portability
+   * patch20: bcopy() and memcpy() now tested for overlap safety
+   * patch20: Perl now distinguishes overlapped copies from non-overlapped
+   * patch20: removed implicit int declarations on functions
+!  *
+   * Revision 4.0.1.5  91/11/11  16:41:07  lwall
+   * patch19: uts wrongly defines S_ISDIR() et al
+   * patch19: too many preprocessors can't expand a macro right in #if
+--- 6,20 ----
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: perl.h,v $
+!  * Revision 4.0.1.7  1993/02/05  19:40:30  lwall
+!  * patch36: worked around certain busted compilers that don't init statics right
+!  *
+!  * Revision 4.0.1.6  92/06/08  14:55:10  lwall
+   * patch20: added Atari ST portability
+   * patch20: bcopy() and memcpy() now tested for overlap safety
+   * patch20: Perl now distinguishes overlapped copies from non-overlapped
+   * patch20: removed implicit int declarations on functions
+!  * 
+   * Revision 4.0.1.5  91/11/11  16:41:07  lwall
+   * patch19: uts wrongly defines S_ISDIR() et al
+   * patch19: too many preprocessors can't expand a macro right in #if
diff --git a/perly.y b/perly.y
index a52f18aff0..0a1c2c9684 100644
--- a/perly.y
+++ b/perly.y
@@ -544,7 +544,7 @@ term	:	'-' term %prec UMINUS
 	|	DELETE '(' REG '{' expr ';' '}' ')'	%prec '('
 			{ $$ = make_op(O_DELETE, 2,
 				stab2arg(A_STAB,hadd($3)),
-				jmaybe($4),
+				jmaybe($5),
 				Nullarg);
 			    expectterm = FALSE; }
 	|	ARYLEN	%prec '('
diff --git a/perly.y.orig b/perly.y.orig
new file mode 100644
index 0000000000..a52f18aff0
--- /dev/null
+++ b/perly.y.orig
@@ -0,0 +1,870 @@
+/* $RCSfile: perly.y,v $$Revision: 4.0.1.5 $$Date: 92/06/11 21:12:50 $
+ *
+ *    Copyright (c) 1991, 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:	perly.y,v $
+ * Revision 4.0.1.5  92/06/11  21:12:50  lwall
+ * patch34: expectterm incorrectly set to indicate start of program or block
+ * 
+ * Revision 4.0.1.4  92/06/08  17:33:25  lwall
+ * patch20: one of the backdoors to expectterm was on the wrong reduction
+ * 
+ * Revision 4.0.1.3  92/06/08  15:18:16  lwall
+ * patch20: an expression may now start with a bareword
+ * patch20: relaxed requirement for semicolon at the end of a block
+ * patch20: added ... as variant on ..
+ * patch20: fixed double debug break in foreach with implicit array assignment
+ * patch20: if {block} {block} didn't work any more
+ * patch20: deleted some minor memory leaks
+ * 
+ * Revision 4.0.1.2  91/11/05  18:17:38  lwall
+ * patch11: extra comma at end of list is now allowed in more places (Hi, Felix!)
+ * patch11: once-thru blocks didn't display right in the debugger
+ * patch11: debugger got confused over nested subroutine definitions
+ * 
+ * Revision 4.0.1.1  91/06/07  11:42:34  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:38:40  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+%{
+#include "INTERN.h"
+#include "perl.h"
+
+/*SUPPRESS 530*/
+/*SUPPRESS 593*/
+/*SUPPRESS 595*/
+
+STAB *scrstab;
+ARG *arg4;	/* rarely used arguments to make_op() */
+ARG *arg5;
+
+%}
+
+%start prog
+
+%union {
+    int	ival;
+    char *cval;
+    ARG *arg;
+    CMD *cmdval;
+    struct compcmd compval;
+    STAB *stabval;
+    FCMD *formval;
+}
+
+%token <ival> '{' ')'
+
+%token <cval> WORD LABEL
+%token <ival> APPEND OPEN SSELECT LOOPEX DOTDOT
+%token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
+%token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
+%token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
+%token <ival> FUNC0 FUNC1 FUNC2 FUNC2x FUNC3 FUNC4 FUNC5 HSHFUN HSHFUN3
+%token <ival> FLIST2 SUB FILETEST LOCAL DELETE
+%token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER
+%token <formval> FORMLIST
+%token <stabval> REG ARYLEN ARY HSH STAR
+%token <arg> SUBST PATTERN
+%token <arg> RSTRING TRANS
+
+%type <ival> prog decl format remember crp
+%type <cmdval> block lineseq line loop cond sideff nexpr else
+%type <arg> expr sexpr cexpr csexpr term handle aryword hshword
+%type <arg> texpr listop bareword
+%type <cval> label
+%type <compval> compblock
+
+%nonassoc <ival> LISTOP
+%left ','
+%right '='
+%right '?' ':'
+%nonassoc DOTDOT
+%left OROR
+%left ANDAND
+%left '|' '^'
+%left '&'
+%nonassoc EQOP
+%nonassoc RELOP
+%nonassoc <ival> UNIOP
+%nonassoc FILETEST
+%left LS RS
+%left ADDOP
+%left MULOP
+%left MATCH NMATCH 
+%right '!' '~' UMINUS
+%right POW
+%nonassoc INC DEC
+%left '('
+
+%% /* RULES */
+
+prog	:	/* NULL */
+		{
+#if defined(YYDEBUG) && defined(DEBUGGING)
+		    yydebug = (debug & 1);
+#endif
+		    expectterm = 2;
+		}
+	/*CONTINUED*/	lineseq
+			{ if (in_eval)
+				eval_root = block_head($2);
+			    else
+				main_root = block_head($2); }
+	;
+
+compblock:	block CONTINUE block
+			{ $$.comp_true = $1; $$.comp_alt = $3; }
+	|	block else
+			{ $$.comp_true = $1; $$.comp_alt = $2; }
+	;
+
+else	:	/* NULL */
+			{ $$ = Nullcmd; }
+	|	ELSE block
+			{ $$ = $2; }
+	|	ELSIF '(' expr ')' compblock
+			{ cmdline = $1;
+			    $$ = make_ccmd(C_ELSIF,1,$3,$5); }
+	;
+
+block	:	'{' remember lineseq '}'
+			{ $$ = block_head($3);
+			  if (cmdline > (line_t)$1)
+			      cmdline = $1;
+			  if (savestack->ary_fill > $2)
+			    restorelist($2);
+			  expectterm = 2; }
+	;
+
+remember:	/* NULL */	/* in case they push a package name */
+			{ $$ = savestack->ary_fill; }
+	;
+
+lineseq	:	/* NULL */
+			{ $$ = Nullcmd; }
+	|	lineseq line
+			{ $$ = append_line($1,$2); }
+	;
+
+line	:	decl
+			{ $$ = Nullcmd; }
+	|	label cond
+			{ $$ = add_label($1,$2); }
+	|	loop	/* loops add their own labels */
+	|	label ';'
+			{ if ($1 != Nullch) {
+			      $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
+				  Nullarg, Nullarg) );
+			    }
+			    else {
+			      $$ = Nullcmd;
+			      cmdline = NOLINE;
+			    }
+			    expectterm = 2; }
+	|	label sideff ';'
+			{ $$ = add_label($1,$2);
+			  expectterm = 2; }
+	;
+
+sideff	:	error
+			{ $$ = Nullcmd; }
+	|	expr
+			{ $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
+	|	expr IF expr
+			{ $$ = addcond(
+			       make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
+	|	expr UNLESS expr
+			{ $$ = addcond(invert(
+			       make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
+	|	expr WHILE expr
+			{ $$ = addloop(
+			       make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
+	|	expr UNTIL expr
+			{ $$ = addloop(invert(
+			       make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
+	;
+
+cond	:	IF '(' expr ')' compblock
+			{ cmdline = $1;
+			    $$ = make_icmd(C_IF,$3,$5); }
+	|	UNLESS '(' expr ')' compblock
+			{ cmdline = $1;
+			    $$ = invert(make_icmd(C_IF,$3,$5)); }
+	|	IF block compblock
+			{ cmdline = $1;
+			    $$ = make_icmd(C_IF,cmd_to_arg($2),$3); }
+	|	UNLESS block compblock
+			{ cmdline = $1;
+			    $$ = invert(make_icmd(C_IF,cmd_to_arg($2),$3)); }
+	;
+
+loop	:	label WHILE '(' texpr ')' compblock
+			{ cmdline = $2;
+			    $$ = wopt(add_label($1,
+			    make_ccmd(C_WHILE,1,$4,$6) )); }
+	|	label UNTIL '(' expr ')' compblock
+			{ cmdline = $2;
+			    $$ = wopt(add_label($1,
+			    invert(make_ccmd(C_WHILE,1,$4,$6)) )); }
+	|	label WHILE block compblock
+			{ cmdline = $2;
+			    $$ = wopt(add_label($1,
+			    make_ccmd(C_WHILE, 1, cmd_to_arg($3),$4) )); }
+	|	label UNTIL block compblock
+			{ cmdline = $2;
+			    $$ = wopt(add_label($1,
+			    invert(make_ccmd(C_WHILE,1,cmd_to_arg($3),$4)) )); }
+	|	label FOR REG '(' expr crp compblock
+			{ cmdline = $2;
+			    /*
+			     * The following gobbledygook catches EXPRs that
+			     * aren't explicit array refs and translates
+			     *		foreach VAR (EXPR) {
+			     * into
+			     *		@ary = EXPR;
+			     *		foreach VAR (@ary) {
+			     * where @ary is a hidden array made by genstab().
+			     * (Note that @ary may become a local array if
+			     * it is determined that it might be called
+			     * recursively.  See cmd_tosave().)
+			     */
+			    if ($5->arg_type != O_ARRAY) {
+				scrstab = aadd(genstab());
+				$$ = append_line(
+				    make_acmd(C_EXPR, Nullstab,
+				      l(make_op(O_ASSIGN,2,
+					listish(make_op(O_ARRAY, 1,
+					  stab2arg(A_STAB,scrstab),
+					  Nullarg,Nullarg )),
+					listish(make_list($5)),
+					Nullarg)),
+				      Nullarg),
+				    wopt(over($3,add_label($1,
+				      make_ccmd(C_WHILE, 0,
+					make_op(O_ARRAY, 1,
+					  stab2arg(A_STAB,scrstab),
+					  Nullarg,Nullarg ),
+					$7)))));
+				$$->c_line = $2;
+				$$->c_head->c_line = $2;
+			    }
+			    else {
+				$$ = wopt(over($3,add_label($1,
+				make_ccmd(C_WHILE,1,$5,$7) )));
+			    }
+			}
+	|	label FOR '(' expr crp compblock
+			{ cmdline = $2;
+			    if ($4->arg_type != O_ARRAY) {
+				scrstab = aadd(genstab());
+				$$ = append_line(
+				    make_acmd(C_EXPR, Nullstab,
+				      l(make_op(O_ASSIGN,2,
+					listish(make_op(O_ARRAY, 1,
+					  stab2arg(A_STAB,scrstab),
+					  Nullarg,Nullarg )),
+					listish(make_list($4)),
+					Nullarg)),
+				      Nullarg),
+				    wopt(over(defstab,add_label($1,
+				      make_ccmd(C_WHILE, 0,
+					make_op(O_ARRAY, 1,
+					  stab2arg(A_STAB,scrstab),
+					  Nullarg,Nullarg ),
+					$6)))));
+				$$->c_line = $2;
+				$$->c_head->c_line = $2;
+			    }
+			    else {	/* lisp, anyone? */
+				$$ = wopt(over(defstab,add_label($1,
+				make_ccmd(C_WHILE,1,$4,$6) )));
+			    }
+			}
+	|	label FOR '(' nexpr ';' texpr ';' nexpr ')' block
+			/* basically fake up an initialize-while lineseq */
+			{   yyval.compval.comp_true = $10;
+			    yyval.compval.comp_alt = $8;
+			    cmdline = $2;
+			    $$ = append_line($4,wopt(add_label($1,
+				make_ccmd(C_WHILE,1,$6,yyval.compval) ))); }
+	|	label compblock	/* a block is a loop that happens once */
+			{ $$ = add_label($1,make_ccmd(C_BLOCK,1,Nullarg,$2)); }
+	;
+
+nexpr	:	/* NULL */
+			{ $$ = Nullcmd; }
+	|	sideff
+	;
+
+texpr	:	/* NULL means true */
+			{ (void)scanstr("1",SCAN_DEF); $$ = yylval.arg; }
+	|	expr
+	;
+
+label	:	/* empty */
+			{ $$ = Nullch; }
+	|	LABEL
+	;
+
+decl	:	format
+			{ $$ = 0; }
+	|	subrout
+			{ $$ = 0; }
+	|	package
+			{ $$ = 0; }
+	;
+
+format	:	FORMAT WORD '=' FORMLIST
+			{ if (strEQ($2,"stdout"))
+			    make_form(stabent("STDOUT",TRUE),$4);
+			  else if (strEQ($2,"stderr"))
+			    make_form(stabent("STDERR",TRUE),$4);
+			  else
+			    make_form(stabent($2,TRUE),$4);
+			  Safefree($2); $2 = Nullch; }
+	|	FORMAT '=' FORMLIST
+			{ make_form(stabent("STDOUT",TRUE),$3); }
+	;
+
+subrout	:	SUB WORD block
+			{ make_sub($2,$3);
+			  cmdline = NOLINE;
+			  if (savestack->ary_fill > $1)
+			    restorelist($1); }
+	;
+
+package :	PACKAGE WORD ';'
+			{ char tmpbuf[256];
+			  STAB *tmpstab;
+
+			  savehptr(&curstash);
+			  saveitem(curstname);
+			  str_set(curstname,$2);
+			  sprintf(tmpbuf,"'_%s",$2);
+			  tmpstab = stabent(tmpbuf,TRUE);
+			  if (!stab_xhash(tmpstab))
+			      stab_xhash(tmpstab) = hnew(0);
+			  curstash = stab_xhash(tmpstab);
+			  if (!curstash->tbl_name)
+			      curstash->tbl_name = savestr($2);
+			  curstash->tbl_coeffsize = 0;
+			  Safefree($2); $2 = Nullch;
+			  cmdline = NOLINE;
+			  expectterm = 2;
+			}
+	;
+
+cexpr	:	',' expr
+			{ $$ = $2; }
+	;
+
+expr	:	expr ',' sexpr
+			{ $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
+	|	sexpr
+	;
+
+csexpr	:	',' sexpr
+			{ $$ = $2; }
+	;
+
+sexpr	:	sexpr '=' sexpr
+			{   $1 = listish($1);
+			    if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
+				$1->arg_type = O_ITEM;	/* a local() */
+			    if ($1->arg_type == O_LIST)
+				$3 = listish($3);
+			    $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
+	|	sexpr POW '=' sexpr
+			{ $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
+	|	sexpr MULOP '=' sexpr
+			{ $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
+	|	sexpr ADDOP '=' sexpr
+			{ $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
+	|	sexpr LS '=' sexpr
+			{ $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
+	|	sexpr RS '=' sexpr
+			{ $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
+	|	sexpr '&' '=' sexpr
+			{ $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
+	|	sexpr '^' '=' sexpr
+			{ $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
+	|	sexpr '|' '=' sexpr
+			{ $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
+
+
+	|	sexpr POW sexpr
+			{ $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
+	|	sexpr MULOP sexpr
+			{ if ($2 == O_REPEAT)
+			      $1 = listish($1);
+			    $$ = make_op($2, 2, $1, $3, Nullarg);
+			    if ($2 == O_REPEAT) {
+				if ($$[1].arg_type != A_EXPR ||
+				  $$[1].arg_ptr.arg_arg->arg_type != O_LIST)
+				    $$[1].arg_flags &= ~AF_ARYOK;
+			    } }
+	|	sexpr ADDOP sexpr
+			{ $$ = make_op($2, 2, $1, $3, Nullarg); }
+	|	sexpr LS sexpr
+			{ $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
+	|	sexpr RS sexpr
+			{ $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
+	|	sexpr RELOP sexpr
+			{ $$ = make_op($2, 2, $1, $3, Nullarg); }
+	|	sexpr EQOP sexpr
+			{ $$ = make_op($2, 2, $1, $3, Nullarg); }
+	|	sexpr '&' sexpr
+			{ $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
+	|	sexpr '^' sexpr
+			{ $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
+	|	sexpr '|' sexpr
+			{ $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
+	|	sexpr DOTDOT sexpr
+			{ arg4 = Nullarg;
+			  $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg);
+			  $$[0].arg_flags |= $2; }
+	|	sexpr ANDAND sexpr
+			{ $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
+	|	sexpr OROR sexpr
+			{ $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
+	|	sexpr '?' sexpr ':' sexpr
+			{ $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
+	|	sexpr MATCH sexpr
+			{ $$ = mod_match(O_MATCH, $1, $3); }
+	|	sexpr NMATCH sexpr
+			{ $$ = mod_match(O_NMATCH, $1, $3); }
+	|	term
+			{ $$ = $1; }
+	;
+
+term	:	'-' term %prec UMINUS
+			{ $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
+	|	'+' term %prec UMINUS
+			{ $$ = $2; }
+	|	'!' term
+			{ $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
+	|	'~' term
+			{ $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
+	|	term INC
+			{ $$ = addflags(1, AF_POST|AF_UP,
+			    l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
+	|	term DEC
+			{ $$ = addflags(1, AF_POST,
+			    l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
+	|	INC term
+			{ $$ = addflags(1, AF_PRE|AF_UP,
+			    l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
+	|	DEC term
+			{ $$ = addflags(1, AF_PRE,
+			    l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
+	|	FILETEST WORD
+			{ opargs[$1] = 0;	/* force it special */
+			    $$ = make_op($1, 1,
+				stab2arg(A_STAB,stabent($2,TRUE)),
+				Nullarg, Nullarg);
+			    Safefree($2); $2 = Nullch;
+			}
+	|	FILETEST sexpr
+			{ opargs[$1] = 1;
+			    $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
+	|	FILETEST
+			{ opargs[$1] = ($1 != O_FTTTY);
+			    $$ = make_op($1, 1,
+				stab2arg(A_STAB,
+				  $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
+				Nullarg, Nullarg); }
+	|	LOCAL '(' expr crp
+			{ $$ = l(localize(make_op(O_ASSIGN, 1,
+				localize(listish(make_list($3))),
+				Nullarg,Nullarg))); }
+	|	'(' expr crp
+			{ $$ = make_list($2); }
+	|	'(' ')'
+			{ $$ = make_list(Nullarg); }
+	|	DO sexpr	%prec FILETEST
+			{ $$ = make_op(O_DOFILE,2,$2,Nullarg,Nullarg);
+			  allstabs = TRUE;}
+	|	DO block	%prec '('
+			{ $$ = cmd_to_arg($2); }
+	|	REG	%prec '('
+			{ $$ = stab2arg(A_STAB,$1); }
+	|	STAR	%prec '('
+			{ $$ = stab2arg(A_STAR,$1); }
+	|	REG '[' expr ']'	%prec '('
+			{ $$ = make_op(O_AELEM, 2,
+				stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
+	|	HSH 	%prec '('
+			{ $$ = make_op(O_HASH, 1,
+				stab2arg(A_STAB,$1),
+				Nullarg, Nullarg); }
+	|	ARY 	%prec '('
+			{ $$ = make_op(O_ARRAY, 1,
+				stab2arg(A_STAB,$1),
+				Nullarg, Nullarg); }
+	|	REG '{' expr ';' '}'	%prec '('
+			{ $$ = make_op(O_HELEM, 2,
+				stab2arg(A_STAB,hadd($1)),
+				jmaybe($3),
+				Nullarg);
+			    expectterm = FALSE; }
+	|	'(' expr crp '[' expr ']'	%prec '('
+			{ $$ = make_op(O_LSLICE, 3,
+				Nullarg,
+				listish(make_list($5)),
+				listish(make_list($2))); }
+	|	'(' ')' '[' expr ']'	%prec '('
+			{ $$ = make_op(O_LSLICE, 3,
+				Nullarg,
+				listish(make_list($4)),
+				Nullarg); }
+	|	ARY '[' expr ']'	%prec '('
+			{ $$ = make_op(O_ASLICE, 2,
+				stab2arg(A_STAB,aadd($1)),
+				listish(make_list($3)),
+				Nullarg); }
+	|	ARY '{' expr ';' '}'	%prec '('
+			{ $$ = make_op(O_HSLICE, 2,
+				stab2arg(A_STAB,hadd($1)),
+				listish(make_list($3)),
+				Nullarg);
+			    expectterm = FALSE; }
+	|	DELETE REG '{' expr ';' '}'	%prec '('
+			{ $$ = make_op(O_DELETE, 2,
+				stab2arg(A_STAB,hadd($2)),
+				jmaybe($4),
+				Nullarg);
+			    expectterm = FALSE; }
+	|	DELETE '(' REG '{' expr ';' '}' ')'	%prec '('
+			{ $$ = make_op(O_DELETE, 2,
+				stab2arg(A_STAB,hadd($3)),
+				jmaybe($4),
+				Nullarg);
+			    expectterm = FALSE; }
+	|	ARYLEN	%prec '('
+			{ $$ = stab2arg(A_ARYLEN,$1); }
+	|	RSTRING	%prec '('
+			{ $$ = $1; }
+	|	PATTERN	%prec '('
+			{ $$ = $1; }
+	|	SUBST	%prec '('
+			{ $$ = $1; }
+	|	TRANS	%prec '('
+			{ $$ = $1; }
+	|	DO WORD '(' expr crp
+			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_WORD,stabent($2,MULTI)),
+				make_list($4),
+				Nullarg); Safefree($2); $2 = Nullch;
+			    $$->arg_flags |= AF_DEPR; }
+	|	AMPER WORD '(' expr crp
+			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_WORD,stabent($2,MULTI)),
+				make_list($4),
+				Nullarg); Safefree($2); $2 = Nullch; }
+	|	DO WORD '(' ')'
+			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_WORD,stabent($2,MULTI)),
+				make_list(Nullarg),
+				Nullarg);
+			    Safefree($2); $2 = Nullch;
+			    $$->arg_flags |= AF_DEPR; }
+	|	AMPER WORD '(' ')'
+			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_WORD,stabent($2,MULTI)),
+				make_list(Nullarg),
+				Nullarg);
+			    Safefree($2); $2 = Nullch;
+			}
+	|	AMPER WORD
+			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_WORD,stabent($2,MULTI)),
+				Nullarg,
+				Nullarg);
+			    Safefree($2); $2 = Nullch;
+			}
+	|	DO REG '(' expr crp
+			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_STAB,$2),
+				make_list($4),
+				Nullarg);
+			    $$->arg_flags |= AF_DEPR; }
+	|	AMPER REG '(' expr crp
+			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_STAB,$2),
+				make_list($4),
+				Nullarg); }
+	|	DO REG '(' ')'
+			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_STAB,$2),
+				make_list(Nullarg),
+				Nullarg);
+			    $$->arg_flags |= AF_DEPR; }
+	|	AMPER REG '(' ')'
+			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_STAB,$2),
+				make_list(Nullarg),
+				Nullarg); }
+	|	AMPER REG
+			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_STAB,$2),
+				Nullarg,
+				Nullarg); }
+	|	LOOPEX
+			{ $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
+	|	LOOPEX WORD
+			{ $$ = make_op($1,1,cval_to_arg($2),
+			    Nullarg,Nullarg); }
+	|	UNIOP
+			{ $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
+	|	UNIOP block
+			{ $$ = make_op($1,1,cmd_to_arg($2),Nullarg,Nullarg); }
+	|	UNIOP sexpr
+			{ $$ = make_op($1,1,$2,Nullarg,Nullarg); }
+	|	SSELECT
+			{ $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
+	|	SSELECT  WORD
+			{ $$ = make_op(O_SELECT, 1,
+			    stab2arg(A_WORD,stabent($2,TRUE)),
+			    Nullarg,
+			    Nullarg);
+			    Safefree($2); $2 = Nullch; }
+	|	SSELECT '(' handle ')'
+			{ $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
+	|	SSELECT '(' sexpr csexpr csexpr csexpr ')'
+			{ arg4 = $6;
+			  $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
+	|	OPEN WORD	%prec '('
+			{ $$ = make_op(O_OPEN, 2,
+			    stab2arg(A_WORD,stabent($2,TRUE)),
+			    stab2arg(A_STAB,stabent($2,TRUE)),
+			    Nullarg);
+			    Safefree($2); $2 = Nullch;
+			}
+	|	OPEN '(' WORD ')'
+			{ $$ = make_op(O_OPEN, 2,
+			    stab2arg(A_WORD,stabent($3,TRUE)),
+			    stab2arg(A_STAB,stabent($3,TRUE)),
+			    Nullarg);
+			    Safefree($3); $3 = Nullch;
+			}
+	|	OPEN '(' handle cexpr ')'
+			{ $$ = make_op(O_OPEN, 2,
+			    $3,
+			    $4, Nullarg); }
+	|	FILOP '(' handle ')'
+			{ $$ = make_op($1, 1,
+			    $3,
+			    Nullarg, Nullarg); }
+	|	FILOP WORD
+			{ $$ = make_op($1, 1,
+			    stab2arg(A_WORD,stabent($2,TRUE)),
+			    Nullarg, Nullarg);
+			  Safefree($2); $2 = Nullch; }
+	|	FILOP REG
+			{ $$ = make_op($1, 1,
+			    stab2arg(A_STAB,$2),
+			    Nullarg, Nullarg); }
+	|	FILOP '(' ')'
+			{ $$ = make_op($1, 1,
+			    stab2arg(A_WORD,Nullstab),
+			    Nullarg, Nullarg); }
+	|	FILOP	%prec '('
+			{ $$ = make_op($1, 0,
+			    Nullarg, Nullarg, Nullarg); }
+	|	FILOP2 '(' handle cexpr ')'
+			{ $$ = make_op($1, 2, $3, $4, Nullarg); }
+	|	FILOP3 '(' handle csexpr cexpr ')'
+			{ $$ = make_op($1, 3, $3, $4, make_list($5)); }
+	|	FILOP22 '(' handle ',' handle ')'
+			{ $$ = make_op($1, 2, $3, $5, Nullarg); }
+	|	FILOP4 '(' handle csexpr csexpr cexpr ')'
+			{ arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
+	|	FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
+			{ arg4 = $7; arg5 = $8;
+			  $$ = make_op($1, 5, $3, $5, $6); }
+	|	PUSH '(' aryword ',' expr crp
+			{ $$ = make_op($1, 2,
+			    $3,
+			    make_list($5),
+			    Nullarg); }
+	|	POP aryword	%prec '('
+			{ $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
+	|	POP '(' aryword ')'
+			{ $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
+	|	SHIFT aryword	%prec '('
+			{ $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
+	|	SHIFT '(' aryword ')'
+			{ $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
+	|	SHIFT	%prec '('
+			{ $$ = make_op(O_SHIFT, 1,
+			    stab2arg(A_STAB,
+			      aadd(stabent(subline ? "_" : "ARGV", TRUE))),
+			    Nullarg, Nullarg); }
+	|	SPLIT	%prec '('
+			{   static char p[]="/\\s+/";
+			    char *oldend = bufend;
+			    ARG *oldarg = yylval.arg;
+			    
+			    bufend=p+5;
+			    (void)scanpat(p);
+			    bufend=oldend;
+			    $$ = make_split(defstab,yylval.arg,Nullarg);
+			    yylval.arg = oldarg; }
+	|	SPLIT '(' sexpr csexpr csexpr ')'
+			{ $$ = mod_match(O_MATCH, $4,
+			  make_split(defstab,$3,$5));}
+	|	SPLIT '(' sexpr csexpr ')'
+			{ $$ = mod_match(O_MATCH, $4,
+			  make_split(defstab,$3,Nullarg) ); }
+	|	SPLIT '(' sexpr ')'
+			{ $$ = mod_match(O_MATCH,
+			    stab2arg(A_STAB,defstab),
+			    make_split(defstab,$3,Nullarg) ); }
+	|	FLIST2 '(' sexpr cexpr ')'
+			{ $$ = make_op($1, 2,
+			    $3,
+			    listish(make_list($4)),
+			    Nullarg); }
+	|	FLIST '(' expr crp
+			{ $$ = make_op($1, 1,
+			    make_list($3),
+			    Nullarg,
+			    Nullarg); }
+	|	LVALFUN sexpr	%prec '('
+			{ $$ = l(make_op($1, 1, fixl($1,$2),
+			    Nullarg, Nullarg)); }
+	|	LVALFUN
+			{ $$ = l(make_op($1, 1,
+			    stab2arg(A_STAB,defstab),
+			    Nullarg, Nullarg)); }
+	|	FUNC0
+			{ $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
+	|	FUNC0 '(' ')'
+			{ $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
+	|	FUNC1 '(' ')'
+			{ $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
+	|	FUNC1 '(' expr ')'
+			{ $$ = make_op($1, 1, $3, Nullarg, Nullarg); }
+	|	FUNC2 '(' sexpr cexpr ')'
+			{ $$ = make_op($1, 2, $3, $4, Nullarg);
+			    if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
+				fbmcompile($$[2].arg_ptr.arg_str,0); }
+	|	FUNC2x '(' sexpr csexpr ')'
+			{ $$ = make_op($1, 2, $3, $4, Nullarg);
+			    if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
+				fbmcompile($$[2].arg_ptr.arg_str,0); }
+	|	FUNC2x '(' sexpr csexpr cexpr ')'
+			{ $$ = make_op($1, 3, $3, $4, $5);
+			    if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
+				fbmcompile($$[2].arg_ptr.arg_str,0); }
+	|	FUNC3 '(' sexpr csexpr cexpr ')'
+			{ $$ = make_op($1, 3, $3, $4, $5); }
+	|	FUNC4 '(' sexpr csexpr csexpr cexpr ')'
+			{ arg4 = $6;
+			  $$ = make_op($1, 4, $3, $4, $5); }
+	|	FUNC5 '(' sexpr csexpr csexpr csexpr cexpr ')'
+			{ arg4 = $6; arg5 = $7;
+			  $$ = make_op($1, 5, $3, $4, $5); }
+	|	HSHFUN '(' hshword ')'
+			{ $$ = make_op($1, 1,
+				$3,
+				Nullarg,
+				Nullarg); }
+	|	HSHFUN hshword
+			{ $$ = make_op($1, 1,
+				$2,
+				Nullarg,
+				Nullarg); }
+	|	HSHFUN3 '(' hshword csexpr cexpr ')'
+			{ $$ = make_op($1, 3, $3, $4, $5); }
+	|	bareword
+	|	listop
+	;
+
+listop	:	LISTOP
+			{ $$ = make_op($1,2,
+				stab2arg(A_WORD,Nullstab),
+				stab2arg(A_STAB,defstab),
+				Nullarg); }
+	|	LISTOP expr
+			{ $$ = make_op($1,2,
+				stab2arg(A_WORD,Nullstab),
+				maybelistish($1,make_list($2)),
+				Nullarg); }
+	|	LISTOP WORD
+			{ $$ = make_op($1,2,
+				stab2arg(A_WORD,stabent($2,TRUE)),
+				stab2arg(A_STAB,defstab),
+				Nullarg);
+			    Safefree($2); $2 = Nullch;
+			}
+	|	LISTOP WORD expr
+			{ $$ = make_op($1,2,
+				stab2arg(A_WORD,stabent($2,TRUE)),
+				maybelistish($1,make_list($3)),
+				Nullarg); Safefree($2); $2 = Nullch; }
+	|	LISTOP REG expr
+			{ $$ = make_op($1,2,
+				stab2arg(A_STAB,$2),
+				maybelistish($1,make_list($3)),
+				Nullarg); }
+	|	LISTOP block expr
+			{ $$ = make_op($1,2,
+				cmd_to_arg($2),
+				maybelistish($1,make_list($3)),
+				Nullarg); }
+	;
+
+handle	:	WORD
+			{ $$ = stab2arg(A_WORD,stabent($1,TRUE));
+			  Safefree($1); $1 = Nullch;}
+	|	sexpr
+	;
+
+aryword	:	WORD
+			{ $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
+			    Safefree($1); $1 = Nullch; }
+	|	ARY
+			{ $$ = stab2arg(A_STAB,$1); }
+	;
+
+hshword	:	WORD
+			{ $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
+			    Safefree($1); $1 = Nullch; }
+	|	HSH
+			{ $$ = stab2arg(A_STAB,$1); }
+	;
+
+crp	:	',' ')'
+			{ $$ = 1; }
+	|	')'
+			{ $$ = 0; }
+	;
+
+/*
+ * NOTE:  The following entry must stay at the end of the file so that
+ * reduce/reduce conflicts resolve to it only if it's the only option.
+ */
+
+bareword:	WORD
+			{ char *s;
+			    $$ = op_new(1);
+			    $$->arg_type = O_ITEM;
+			    $$[1].arg_type = A_SINGLE;
+			    $$[1].arg_ptr.arg_str = str_make($1,0);
+			    for (s = $1; *s && isLOWER(*s); s++) ;
+			    if (dowarn && !*s)
+				warn(
+				  "\"%s\" may clash with future reserved word",
+				  $1 );
+			    Safefree($1); $1 = Nullch;
+			}
+		;
+%% /* PROGRAM */
diff --git a/perly.y.rej b/perly.y.rej
new file mode 100644
index 0000000000..4f91fdde25
--- /dev/null
+++ b/perly.y.rej
@@ -0,0 +1,35 @@
+***************
+*** 1,4 ****
+! /* $RCSfile: perly.y,v $$Revision: 4.0.1.5 $$Date: 1992/06/11 21:12:50 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+--- 1,4 ----
+! /* $RCSfile: perly.y,v $$Revision: 4.0.1.6 $$Date: 1993/02/05 19:41:15 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+***************
+*** 6,14 ****
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: perly.y,v $
+!  * Revision 4.0.1.5  1992/06/11  21:12:50  lwall
+!  * patch34: expectterm incorrectly set to indicate start of program or block
+   *
+   * Revision 4.0.1.4  92/06/08  17:33:25  lwall
+   * patch20: one of the backdoors to expectterm was on the wrong reduction
+   * 
+--- 6,17 ----
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: perly.y,v $
+!  * Revision 4.0.1.6  1993/02/05  19:41:15  lwall
+!  * patch36: delete with parens dumped core
+   *
++  * Revision 4.0.1.5  92/06/11  21:12:50  lwall
++  * patch34: expectterm incorrectly set to indicate start of program or block
++  * 
+   * Revision 4.0.1.4  92/06/08  17:33:25  lwall
+   * patch20: one of the backdoors to expectterm was on the wrong reduction
+   * 
diff --git a/stab.c b/stab.c
index f8e6f07d12..c7358374f9 100644
--- a/stab.c
+++ b/stab.c
@@ -318,9 +318,8 @@ STR *str;
 	return (STRLEN)ofslen;
     case '\\':
 	return (STRLEN)orslen;
-    default:
-	return str_len(stab_str(str));
     }
+    return str_len(stab_str(str));
 }
 
 void
diff --git a/stab.c.orig b/stab.c.orig
new file mode 100644
index 0000000000..f8e6f07d12
--- /dev/null
+++ b/stab.c.orig
@@ -0,0 +1,1050 @@
+/* $RCSfile: stab.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 15:32:19 $
+ *
+ *    Copyright (c) 1991, 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:	stab.c,v $
+ * Revision 4.0.1.4  92/06/08  15:32:19  lwall
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: the debugger now warns you on lines that can't set a breakpoint
+ * patch20: the debugger made perl forget the last pattern used by //
+ * patch20: paragraph mode now skips extra newlines automatically
+ * patch20: ($<,$>) = ... didn't work on some architectures
+ * 
+ * Revision 4.0.1.3  91/11/05  18:35:33  lwall
+ * patch11: length($x) was sometimes wrong for numeric $x
+ * patch11: perl now issues warning if $SIG{'ALARM'} is referenced
+ * patch11: *foo = undef coredumped
+ * patch11: solitary subroutine references no longer trigger typo warnings
+ * patch11: local(*FILEHANDLE) had a memory leak
+ * 
+ * Revision 4.0.1.2  91/06/07  11:55:53  lwall
+ * patch4: new copyright notice
+ * patch4: added $^P variable to control calling of perldb routines
+ * patch4: added $^F variable to specify maximum system fd, default 2
+ * patch4: $` was busted inside s///
+ * patch4: default top-of-form format is now FILEHANDLE_TOP
+ * patch4: length($`), length($&), length($') now optimized to avoid string copy
+ * patch4: $^D |= 1024 now does syntax tree dump at run-time
+ * 
+ * Revision 4.0.1.1  91/04/12  09:10:24  lwall
+ * patch1: Configure now differentiates getgroups() type from getgid() type
+ * patch1: you may now use "die" and "caller" in a signal handler
+ * 
+ * Revision 4.0  91/03/20  01:39:41  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#include <signal.h>
+#endif
+
+static char *sig_name[] = {
+    SIG_NAME,0
+};
+
+#ifdef VOIDSIG
+#define handlertype void
+#else
+#define handlertype int
+#endif
+
+static handlertype sighandler();
+
+static int origalen = 0;
+
+STR *
+stab_str(str)
+STR *str;
+{
+    STAB *stab = str->str_u.str_stab;
+    register int paren;
+    register char *s;
+    register int i;
+
+    if (str->str_rare)
+	return stab_val(stab);
+
+    switch (*stab->str_magic->str_ptr) {
+    case '\004':		/* ^D */
+#ifdef DEBUGGING
+	str_numset(stab_val(stab),(double)(debug & 32767));
+#endif
+	break;
+    case '\006':		/* ^F */
+	str_numset(stab_val(stab),(double)maxsysfd);
+	break;
+    case '\t':			/* ^I */
+	if (inplace)
+	    str_set(stab_val(stab), inplace);
+	else
+	    str_sset(stab_val(stab),&str_undef);
+	break;
+    case '\020':		/* ^P */
+	str_numset(stab_val(stab),(double)perldb);
+	break;
+    case '\024':		/* ^T */
+	str_numset(stab_val(stab),(double)basetime);
+	break;
+    case '\027':		/* ^W */
+	str_numset(stab_val(stab),(double)dowarn);
+	break;
+    case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9': case '&':
+	if (curspat) {
+	    paren = atoi(stab_ename(stab));
+	  getparen:
+	    if (curspat->spat_regexp &&
+	      paren <= curspat->spat_regexp->nparens &&
+	      (s = curspat->spat_regexp->startp[paren]) ) {
+		i = curspat->spat_regexp->endp[paren] - s;
+		if (i >= 0)
+		    str_nset(stab_val(stab),s,i);
+		else
+		    str_sset(stab_val(stab),&str_undef);
+	    }
+	    else
+		str_sset(stab_val(stab),&str_undef);
+	}
+	break;
+    case '+':
+	if (curspat) {
+	    paren = curspat->spat_regexp->lastparen;
+	    goto getparen;
+	}
+	break;
+    case '`':
+	if (curspat) {
+	    if (curspat->spat_regexp &&
+	      (s = curspat->spat_regexp->subbeg) ) {
+		i = curspat->spat_regexp->startp[0] - s;
+		if (i >= 0)
+		    str_nset(stab_val(stab),s,i);
+		else
+		    str_nset(stab_val(stab),"",0);
+	    }
+	    else
+		str_nset(stab_val(stab),"",0);
+	}
+	break;
+    case '\'':
+	if (curspat) {
+	    if (curspat->spat_regexp &&
+	      (s = curspat->spat_regexp->endp[0]) ) {
+		str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
+	    }
+	    else
+		str_nset(stab_val(stab),"",0);
+	}
+	break;
+    case '.':
+#ifndef lint
+	if (last_in_stab && stab_io(last_in_stab)) {
+	    str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
+	}
+#endif
+	break;
+    case '?':
+	str_numset(stab_val(stab),(double)statusvalue);
+	break;
+    case '^':
+	s = stab_io(curoutstab)->top_name;
+	if (s)
+	    str_set(stab_val(stab),s);
+	else {
+	    str_set(stab_val(stab),stab_ename(curoutstab));
+	    str_cat(stab_val(stab),"_TOP");
+	}
+	break;
+    case '~':
+	s = stab_io(curoutstab)->fmt_name;
+	if (!s)
+	    s = stab_ename(curoutstab);
+	str_set(stab_val(stab),s);
+	break;
+#ifndef lint
+    case '=':
+	str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
+	break;
+    case '-':
+	str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
+	break;
+    case '%':
+	str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
+	break;
+#endif
+    case ':':
+	break;
+    case '/':
+	break;
+    case '[':
+	str_numset(stab_val(stab),(double)arybase);
+	break;
+    case '|':
+	if (!stab_io(curoutstab))
+	    stab_io(curoutstab) = stio_new();
+	str_numset(stab_val(stab),
+	   (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
+	break;
+    case ',':
+	str_nset(stab_val(stab),ofs,ofslen);
+	break;
+    case '\\':
+	str_nset(stab_val(stab),ors,orslen);
+	break;
+    case '#':
+	str_set(stab_val(stab),ofmt);
+	break;
+    case '!':
+	str_numset(stab_val(stab), (double)errno);
+	str_set(stab_val(stab), errno ? strerror(errno) : "");
+	stab_val(stab)->str_nok = 1;	/* what a wonderful hack! */
+	break;
+    case '<':
+	str_numset(stab_val(stab),(double)uid);
+	break;
+    case '>':
+	str_numset(stab_val(stab),(double)euid);
+	break;
+    case '(':
+	s = buf;
+	(void)sprintf(s,"%d",(int)gid);
+	goto add_groups;
+    case ')':
+	s = buf;
+	(void)sprintf(s,"%d",(int)egid);
+      add_groups:
+	while (*s) s++;
+#ifdef HAS_GETGROUPS
+#ifndef NGROUPS
+#define NGROUPS 32
+#endif
+	{
+	    GROUPSTYPE gary[NGROUPS];
+
+	    i = getgroups(NGROUPS,gary);
+	    while (--i >= 0) {
+		(void)sprintf(s," %ld", (long)gary[i]);
+		while (*s) s++;
+	    }
+	}
+#endif
+	str_set(stab_val(stab),buf);
+	break;
+    case '*':
+	break;
+    case '0':
+	break;
+    default:
+	{
+	    struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
+
+	    if (uf && uf->uf_val)
+		(*uf->uf_val)(uf->uf_index, stab_val(stab));
+	}
+	break;
+    }
+    return stab_val(stab);
+}
+
+STRLEN
+stab_len(str)
+STR *str;
+{
+    STAB *stab = str->str_u.str_stab;
+    int paren;
+    int i;
+    char *s;
+
+    if (str->str_rare)
+	return str_len(stab_val(stab));
+
+    switch (*stab->str_magic->str_ptr) {
+    case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9': case '&':
+	if (curspat) {
+	    paren = atoi(stab_ename(stab));
+	  getparen:
+	    if (curspat->spat_regexp &&
+	      paren <= curspat->spat_regexp->nparens &&
+	      (s = curspat->spat_regexp->startp[paren]) ) {
+		i = curspat->spat_regexp->endp[paren] - s;
+		if (i >= 0)
+		    return i;
+		else
+		    return 0;
+	    }
+	    else
+		return 0;
+	}
+	break;
+    case '+':
+	if (curspat) {
+	    paren = curspat->spat_regexp->lastparen;
+	    goto getparen;
+	}
+	break;
+    case '`':
+	if (curspat) {
+	    if (curspat->spat_regexp &&
+	      (s = curspat->spat_regexp->subbeg) ) {
+		i = curspat->spat_regexp->startp[0] - s;
+		if (i >= 0)
+		    return i;
+		else
+		    return 0;
+	    }
+	    else
+		return 0;
+	}
+	break;
+    case '\'':
+	if (curspat) {
+	    if (curspat->spat_regexp &&
+	      (s = curspat->spat_regexp->endp[0]) ) {
+		return (STRLEN) (curspat->spat_regexp->subend - s);
+	    }
+	    else
+		return 0;
+	}
+	break;
+    case ',':
+	return (STRLEN)ofslen;
+    case '\\':
+	return (STRLEN)orslen;
+    default:
+	return str_len(stab_str(str));
+    }
+}
+
+void
+stabset(mstr,str)
+register STR *mstr;
+STR *str;
+{
+    STAB *stab;
+    register char *s;
+    int i;
+
+    switch (mstr->str_rare) {
+    case 'E':
+	my_setenv(mstr->str_ptr,str_get(str));
+				/* And you'll never guess what the dog had */
+				/*   in its mouth... */
+#ifdef TAINT
+	if (strEQ(mstr->str_ptr,"PATH")) {
+	    char *strend = str->str_ptr + str->str_cur;
+
+	    s = str->str_ptr;
+	    while (s < strend) {
+		s = cpytill(tokenbuf,s,strend,':',&i);
+		s++;
+		if (*tokenbuf != '/'
+		  || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
+		    str->str_tainted = 2;
+	    }
+	}
+#endif
+	break;
+    case 'S':
+	s = str_get(str);
+	i = whichsig(mstr->str_ptr);	/* ...no, a brick */
+	if (!i && (dowarn || strEQ(mstr->str_ptr,"ALARM")))
+	    warn("No such signal: SIG%s", mstr->str_ptr);
+	if (strEQ(s,"IGNORE"))
+#ifndef lint
+	    (void)signal(i,SIG_IGN);
+#else
+	    ;
+#endif
+	else if (strEQ(s,"DEFAULT") || !*s)
+	    (void)signal(i,SIG_DFL);
+	else {
+	    (void)signal(i,sighandler);
+	    if (!index(s,'\'')) {
+		sprintf(tokenbuf, "main'%s",s);
+		str_set(str,tokenbuf);
+	    }
+	}
+	break;
+#ifdef SOME_DBM
+    case 'D':
+	stab = mstr->str_u.str_stab;
+	hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
+	break;
+#endif
+    case 'L':
+	{
+	    CMD *cmd;
+
+	    stab = mstr->str_u.str_stab;
+	    i = str_true(str);
+	    str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
+	    if (str->str_magic && (cmd = str->str_magic->str_u.str_cmd)) {
+		cmd->c_flags &= ~CF_OPTIMIZE;
+		cmd->c_flags |= i? CFT_D1 : CFT_D0;
+	    }
+	    else
+		warn("Can't break at that line\n");
+	}
+	break;
+    case '#':
+	stab = mstr->str_u.str_stab;
+	afill(stab_array(stab), (int)str_gnum(str) - arybase);
+	break;
+    case 'X':	/* merely a copy of a * string */
+	break;
+    case '*':
+	s = str->str_pok ? str_get(str) : "";
+	if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
+	    stab = mstr->str_u.str_stab;
+	    if (!*s) {
+		STBP *stbp;
+
+		/*SUPPRESS 701*/
+		(void)savenostab(stab);	/* schedule a free of this stab */
+		if (stab->str_len)
+		    Safefree(stab->str_ptr);
+		Newz(601,stbp, 1, STBP);
+		stab->str_ptr = stbp;
+		stab->str_len = stab->str_cur = sizeof(STBP);
+		stab->str_pok = 1;
+		strcpy(stab_magic(stab),"StB");
+		stab_val(stab) = Str_new(70,0);
+		stab_line(stab) = curcmd->c_line;
+		stab_estab(stab) = stab;
+	    }
+	    else {
+		stab = stabent(s,TRUE);
+		if (!stab_xarray(stab))
+		    aadd(stab);
+		if (!stab_xhash(stab))
+		    hadd(stab);
+		if (!stab_io(stab))
+		    stab_io(stab) = stio_new();
+	    }
+	    str_sset(str, (STR*) stab);
+	}
+	break;
+    case 's': {
+	    struct lstring *lstr = (struct lstring*)str;
+	    char *tmps;
+
+	    mstr->str_rare = 0;
+	    str->str_magic = Nullstr;
+	    tmps = str_get(str);
+	    str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
+	      tmps,str->str_cur);
+	}
+	break;
+
+    case 'v':
+	do_vecset(mstr,str);
+	break;
+
+    case 0:
+	/*SUPPRESS 560*/
+	if (!(stab = mstr->str_u.str_stab))
+	    break;
+	switch (*stab->str_magic->str_ptr) {
+	case '\004':	/* ^D */
+#ifdef DEBUGGING
+	    debug = (int)(str_gnum(str)) | 32768;
+	    if (debug & 1024)
+		dump_all();
+#endif
+	    break;
+	case '\006':	/* ^F */
+	    maxsysfd = (int)str_gnum(str);
+	    break;
+	case '\t':	/* ^I */
+	    if (inplace)
+		Safefree(inplace);
+	    if (str->str_pok || str->str_nok)
+		inplace = savestr(str_get(str));
+	    else
+		inplace = Nullch;
+	    break;
+	case '\020':	/* ^P */
+	    i = (int)str_gnum(str);
+	    if (i != perldb) {
+		static SPAT *oldlastspat;
+
+		if (perldb)
+		    oldlastspat = lastspat;
+		else
+		    lastspat = oldlastspat;
+	    }
+	    perldb = i;
+	    break;
+	case '\024':	/* ^T */
+	    basetime = (time_t)str_gnum(str);
+	    break;
+	case '\027':	/* ^W */
+	    dowarn = (bool)str_gnum(str);
+	    break;
+	case '.':
+	    if (localizing)
+		savesptr((STR**)&last_in_stab);
+	    break;
+	case '^':
+	    Safefree(stab_io(curoutstab)->top_name);
+	    stab_io(curoutstab)->top_name = s = savestr(str_get(str));
+	    stab_io(curoutstab)->top_stab = stabent(s,TRUE);
+	    break;
+	case '~':
+	    Safefree(stab_io(curoutstab)->fmt_name);
+	    stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
+	    stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
+	    break;
+	case '=':
+	    stab_io(curoutstab)->page_len = (long)str_gnum(str);
+	    break;
+	case '-':
+	    stab_io(curoutstab)->lines_left = (long)str_gnum(str);
+	    if (stab_io(curoutstab)->lines_left < 0L)
+		stab_io(curoutstab)->lines_left = 0L;
+	    break;
+	case '%':
+	    stab_io(curoutstab)->page = (long)str_gnum(str);
+	    break;
+	case '|':
+	    if (!stab_io(curoutstab))
+		stab_io(curoutstab) = stio_new();
+	    stab_io(curoutstab)->flags &= ~IOF_FLUSH;
+	    if (str_gnum(str) != 0.0) {
+		stab_io(curoutstab)->flags |= IOF_FLUSH;
+	    }
+	    break;
+	case '*':
+	    i = (int)str_gnum(str);
+	    multiline = (i != 0);
+	    break;
+	case '/':
+	    if (str->str_pok) {
+		rs = str_get(str);
+		rslen = str->str_cur;
+		if (rspara = !rslen) {
+		    rs = "\n\n";
+		    rslen = 2;
+		}
+		rschar = rs[rslen - 1];
+	    }
+	    else {
+		rschar = 0777;	/* fake a non-existent char */
+		rslen = 1;
+	    }
+	    break;
+	case '\\':
+	    if (ors)
+		Safefree(ors);
+	    ors = savestr(str_get(str));
+	    orslen = str->str_cur;
+	    break;
+	case ',':
+	    if (ofs)
+		Safefree(ofs);
+	    ofs = savestr(str_get(str));
+	    ofslen = str->str_cur;
+	    break;
+	case '#':
+	    if (ofmt)
+		Safefree(ofmt);
+	    ofmt = savestr(str_get(str));
+	    break;
+	case '[':
+	    arybase = (int)str_gnum(str);
+	    break;
+	case '?':
+	    statusvalue = U_S(str_gnum(str));
+	    break;
+	case '!':
+	    errno = (int)str_gnum(str);		/* will anyone ever use this? */
+	    break;
+	case '<':
+	    uid = (int)str_gnum(str);
+	    if (delaymagic) {
+		delaymagic |= DM_RUID;
+		break;				/* don't do magic till later */
+	    }
+#ifdef HAS_SETRUID
+	    (void)setruid((UIDTYPE)uid);
+#else
+#ifdef HAS_SETREUID
+	    (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1);
+#else
+	    if (uid == euid)		/* special case $< = $> */
+		(void)setuid(uid);
+	    else
+		fatal("setruid() not implemented");
+#endif
+#endif
+	    uid = (int)getuid();
+	    break;
+	case '>':
+	    euid = (int)str_gnum(str);
+	    if (delaymagic) {
+		delaymagic |= DM_EUID;
+		break;				/* don't do magic till later */
+	    }
+#ifdef HAS_SETEUID
+	    (void)seteuid((UIDTYPE)euid);
+#else
+#ifdef HAS_SETREUID
+	    (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid);
+#else
+	    if (euid == uid)		/* special case $> = $< */
+		setuid(euid);
+	    else
+		fatal("seteuid() not implemented");
+#endif
+#endif
+	    euid = (int)geteuid();
+	    break;
+	case '(':
+	    gid = (int)str_gnum(str);
+	    if (delaymagic) {
+		delaymagic |= DM_RGID;
+		break;				/* don't do magic till later */
+	    }
+#ifdef HAS_SETRGID
+	    (void)setrgid((GIDTYPE)gid);
+#else
+#ifdef HAS_SETREGID
+	    (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
+#else
+	    if (gid == egid)			/* special case $( = $) */
+		(void)setgid(gid);
+	    else
+		fatal("setrgid() not implemented");
+#endif
+#endif
+	    gid = (int)getgid();
+	    break;
+	case ')':
+	    egid = (int)str_gnum(str);
+	    if (delaymagic) {
+		delaymagic |= DM_EGID;
+		break;				/* don't do magic till later */
+	    }
+#ifdef HAS_SETEGID
+	    (void)setegid((GIDTYPE)egid);
+#else
+#ifdef HAS_SETREGID
+	    (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
+#else
+	    if (egid == gid)			/* special case $) = $( */
+		(void)setgid(egid);
+	    else
+		fatal("setegid() not implemented");
+#endif
+#endif
+	    egid = (int)getegid();
+	    break;
+	case ':':
+	    chopset = str_get(str);
+	    break;
+	case '0':
+	    if (!origalen) {
+		s = origargv[0];
+		s += strlen(s);
+		/* See if all the arguments are contiguous in memory */
+		for (i = 1; i < origargc; i++) {
+		    if (origargv[i] == s + 1)
+			s += strlen(++s);	/* this one is ok too */
+		}
+		if (origenviron[0] == s + 1) {	/* can grab env area too? */
+		    my_setenv("NoNeSuCh", Nullch);
+						/* force copy of environment */
+		    for (i = 0; origenviron[i]; i++)
+			if (origenviron[i] == s + 1)
+			    s += strlen(++s);
+		}
+		origalen = s - origargv[0];
+	    }
+	    s = str_get(str);
+	    i = str->str_cur;
+	    if (i >= origalen) {
+		i = origalen;
+		str->str_cur = i;
+		str->str_ptr[i] = '\0';
+		Copy(s, origargv[0], i, char);
+	    }
+	    else {
+		Copy(s, origargv[0], i, char);
+		s = origargv[0]+i;
+		*s++ = '\0';
+		while (++i < origalen)
+		    *s++ = ' ';
+	    }
+	    break;
+	default:
+	    {
+		struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
+
+		if (uf && uf->uf_set)
+		    (*uf->uf_set)(uf->uf_index, str);
+	    }
+	    break;
+	}
+	break;
+    }
+}
+
+int
+whichsig(sig)
+char *sig;
+{
+    register char **sigv;
+
+    for (sigv = sig_name+1; *sigv; sigv++)
+	if (strEQ(sig,*sigv))
+	    return sigv - sig_name;
+#ifdef SIGCLD
+    if (strEQ(sig,"CHLD"))
+	return SIGCLD;
+#endif
+#ifdef SIGCHLD
+    if (strEQ(sig,"CLD"))
+	return SIGCHLD;
+#endif
+    return 0;
+}
+
+static handlertype
+sighandler(sig)
+int sig;
+{
+    STAB *stab;
+    STR *str;
+    int oldsave = savestack->ary_fill;
+    int oldtmps_base = tmps_base;
+    register CSV *csv;
+    SUBR *sub;
+
+#ifdef OS2		/* or anybody else who requires SIG_ACK */
+    signal(sig, SIG_ACK);
+#endif
+    stab = stabent(
+	str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
+	  TRUE)), TRUE);
+    sub = stab_sub(stab);
+    if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
+	if (sig_name[sig][1] == 'H')
+	    stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
+	      TRUE);
+	else
+	    stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
+	      TRUE);
+	sub = stab_sub(stab);	/* gag */
+    }
+    if (!sub) {
+	if (dowarn)
+	    warn("SIG%s handler \"%s\" not defined.\n",
+		sig_name[sig], stab_ename(stab) );
+	return;
+    }
+    /*SUPPRESS 701*/
+    saveaptr(&stack);
+    str = Str_new(15, sizeof(CSV));
+    str->str_state = SS_SCSV;
+    (void)apush(savestack,str);
+    csv = (CSV*)str->str_ptr;
+    csv->sub = sub;
+    csv->stab = stab;
+    csv->curcsv = curcsv;
+    csv->curcmd = curcmd;
+    csv->depth = sub->depth;
+    csv->wantarray = G_SCALAR;
+    csv->hasargs = TRUE;
+    csv->savearray = stab_xarray(defstab);
+    csv->argarray = stab_xarray(defstab) = stack = anew(defstab);
+    stack->ary_flags = 0;
+    curcsv = csv;
+    str = str_mortal(&str_undef);
+    str_set(str,sig_name[sig]);
+    (void)apush(stab_xarray(defstab),str);
+    sub->depth++;
+    if (sub->depth >= 2) {	/* save temporaries on recursion? */
+	if (sub->depth == 100 && dowarn)
+	    warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
+	savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
+    }
+
+    tmps_base = tmps_max;		/* protect our mortal string */
+    (void)cmd_exec(sub->cmd,G_SCALAR,0);		/* so do it already */
+    tmps_base = oldtmps_base;
+
+    restorelist(oldsave);		/* put everything back */
+}
+
+STAB *
+aadd(stab)
+register STAB *stab;
+{
+    if (!stab_xarray(stab))
+	stab_xarray(stab) = anew(stab);
+    return stab;
+}
+
+STAB *
+hadd(stab)
+register STAB *stab;
+{
+    if (!stab_xhash(stab))
+	stab_xhash(stab) = hnew(COEFFSIZE);
+    return stab;
+}
+
+STAB *
+fstab(name)
+char *name;
+{
+    char tmpbuf[1200];
+    STAB *stab;
+
+    sprintf(tmpbuf,"'_<%s", name);
+    stab = stabent(tmpbuf, TRUE);
+    str_set(stab_val(stab), name);
+    if (perldb)
+	(void)hadd(aadd(stab));
+    return stab;
+}
+
+STAB *
+stabent(name,add)
+register char *name;
+int add;
+{
+    register STAB *stab;
+    register STBP *stbp;
+    int len;
+    register char *namend;
+    HASH *stash;
+    char *sawquote = Nullch;
+    char *prevquote = Nullch;
+    bool global = FALSE;
+
+    if (isUPPER(*name)) {
+	if (*name > 'I') {
+	    if (*name == 'S' && (
+	      strEQ(name, "SIG") ||
+	      strEQ(name, "STDIN") ||
+	      strEQ(name, "STDOUT") ||
+	      strEQ(name, "STDERR") ))
+		global = TRUE;
+	}
+	else if (*name > 'E') {
+	    if (*name == 'I' && strEQ(name, "INC"))
+		global = TRUE;
+	}
+	else if (*name > 'A') {
+	    if (*name == 'E' && strEQ(name, "ENV"))
+		global = TRUE;
+	}
+	else if (*name == 'A' && (
+	  strEQ(name, "ARGV") ||
+	  strEQ(name, "ARGVOUT") ))
+	    global = TRUE;
+    }
+    for (namend = name; *namend; namend++) {
+	if (*namend == '\'' && namend[1])
+	    prevquote = sawquote, sawquote = namend;
+    }
+    if (sawquote == name && name[1]) {
+	stash = defstash;
+	sawquote = Nullch;
+	name++;
+    }
+    else if (!isALPHA(*name) || global)
+	stash = defstash;
+    else if ((CMD*)curcmd == &compiling)
+	stash = curstash;
+    else
+	stash = curcmd->c_stash;
+    if (sawquote) {
+	char tmpbuf[256];
+	char *s, *d;
+
+	*sawquote = '\0';
+	/*SUPPRESS 560*/
+	if (s = prevquote) {
+	    strncpy(tmpbuf,name,s-name+1);
+	    d = tmpbuf+(s-name+1);
+	    *d++ = '_';
+	    strcpy(d,s+1);
+	}
+	else {
+	    *tmpbuf = '_';
+	    strcpy(tmpbuf+1,name);
+	}
+	stab = stabent(tmpbuf,TRUE);
+	if (!(stash = stab_xhash(stab)))
+	    stash = stab_xhash(stab) = hnew(0);
+	if (!stash->tbl_name)
+	    stash->tbl_name = savestr(name);
+	name = sawquote+1;
+	*sawquote = '\'';
+    }
+    len = namend - name;
+    stab = (STAB*)hfetch(stash,name,len,add);
+    if (stab == (STAB*)&str_undef)
+	return Nullstab;
+    if (stab->str_pok) {
+	stab->str_pok |= SP_MULTI;
+	return stab;
+    }
+    else {
+	if (stab->str_len)
+	    Safefree(stab->str_ptr);
+	Newz(602,stbp, 1, STBP);
+	stab->str_ptr = stbp;
+	stab->str_len = stab->str_cur = sizeof(STBP);
+	stab->str_pok = 1;
+	strcpy(stab_magic(stab),"StB");
+	stab_val(stab) = Str_new(72,0);
+	stab_line(stab) = curcmd->c_line;
+	stab_estab(stab) = stab;
+	str_magic((STR*)stab, stab, '*', name, len);
+	stab_stash(stab) = stash;
+	if (isDIGIT(*name) && *name != '0') {
+	    stab_flags(stab) = SF_VMAGIC;
+	    str_magic(stab_val(stab), stab, 0, Nullch, 0);
+	}
+	if (add & 2)
+	    stab->str_pok |= SP_MULTI;
+	return stab;
+    }
+}
+
+void
+stab_fullname(str,stab)
+STR *str;
+STAB *stab;
+{
+    HASH *tb = stab_stash(stab);
+
+    if (!tb)
+	return;
+    str_set(str,tb->tbl_name);
+    str_ncat(str,"'", 1);
+    str_scat(str,stab->str_magic);
+}
+
+void
+stab_efullname(str,stab)
+STR *str;
+STAB *stab;
+{
+    HASH *tb = stab_estash(stab);
+
+    if (!tb)
+	return;
+    str_set(str,tb->tbl_name);
+    str_ncat(str,"'", 1);
+    str_scat(str,stab_estab(stab)->str_magic);
+}
+
+STIO *
+stio_new()
+{
+    STIO *stio;
+
+    Newz(603,stio,1,STIO);
+    stio->page_len = 60;
+    return stio;
+}
+
+void
+stab_check(min,max)
+int min;
+register int max;
+{
+    register HENT *entry;
+    register int i;
+    register STAB *stab;
+
+    for (i = min; i <= max; i++) {
+	for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
+	    stab = (STAB*)entry->hent_val;
+	    if (stab->str_pok & SP_MULTI)
+		continue;
+	    curcmd->c_line = stab_line(stab);
+	    warn("Possible typo: \"%s\"", stab_name(stab));
+	}
+    }
+}
+
+static int gensym = 0;
+
+STAB *
+genstab()
+{
+    (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
+    return stabent(tokenbuf,TRUE);
+}
+
+/* hopefully this is only called on local symbol table entries */
+
+void
+stab_clear(stab)
+register STAB *stab;
+{
+    STIO *stio;
+    SUBR *sub;
+
+    if (!stab || !stab->str_ptr)
+	return;
+    afree(stab_xarray(stab));
+    stab_xarray(stab) = Null(ARRAY*);
+    (void)hfree(stab_xhash(stab), FALSE);
+    stab_xhash(stab) = Null(HASH*);
+    str_free(stab_val(stab));
+    stab_val(stab) = Nullstr;
+    /*SUPPRESS 560*/
+    if (stio = stab_io(stab)) {
+	do_close(stab,FALSE);
+	Safefree(stio->top_name);
+	Safefree(stio->fmt_name);
+	Safefree(stio);
+    }
+    /*SUPPRESS 560*/
+    if (sub = stab_sub(stab)) {
+	afree(sub->tosave);
+	cmd_free(sub->cmd);
+    }
+    Safefree(stab->str_ptr);
+    stab->str_ptr = Null(STBP*);
+    stab->str_len = 0;
+    stab->str_cur = 0;
+}
+
+#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
+#define MICROPORT
+#endif
+
+#ifdef	MICROPORT	/* Microport 2.4 hack */
+ARRAY *stab_array(stab)
+register STAB *stab;
+{
+    if (((STBP*)(stab->str_ptr))->stbp_array) 
+	return ((STBP*)(stab->str_ptr))->stbp_array;
+    else
+	return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
+}
+
+HASH *stab_hash(stab)
+register STAB *stab;
+{
+    if (((STBP*)(stab->str_ptr))->stbp_hash)
+	return ((STBP*)(stab->str_ptr))->stbp_hash;
+    else
+	return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
+}
+#endif			/* Microport 2.4 hack */
diff --git a/stab.c.rej b/stab.c.rej
new file mode 100644
index 0000000000..af62598bef
--- /dev/null
+++ b/stab.c.rej
@@ -0,0 +1,43 @@
+***************
+*** 1,4 ****
+! /* $RCSfile: stab.c,v $$Revision: 4.0.1.4 $$Date: 1992/06/08 15:32:19 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+--- 1,4 ----
+! /* $RCSfile: stab.c,v $$Revision: 4.0.1.5 $$Date: 1993/02/05 19:42:47 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+***************
+*** 6,18 ****
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: stab.c,v $
+!  * Revision 4.0.1.4  1992/06/08  15:32:19  lwall
+   * patch20: fixed confusion between a *var's real name and its effective name
+   * patch20: the debugger now warns you on lines that can't set a breakpoint
+   * patch20: the debugger made perl forget the last pattern used by //
+   * patch20: paragraph mode now skips extra newlines automatically
+   * patch20: ($<,$>) = ... didn't work on some architectures
+!  *
+   * Revision 4.0.1.3  91/11/05  18:35:33  lwall
+   * patch11: length($x) was sometimes wrong for numeric $x
+   * patch11: perl now issues warning if $SIG{'ALARM'} is referenced
+--- 6,21 ----
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: stab.c,v $
+!  * Revision 4.0.1.5  1993/02/05  19:42:47  lwall
+!  * patch36: length returned wrong value on certain semi-magical variables
+!  *
+!  * Revision 4.0.1.4  92/06/08  15:32:19  lwall
+   * patch20: fixed confusion between a *var's real name and its effective name
+   * patch20: the debugger now warns you on lines that can't set a breakpoint
+   * patch20: the debugger made perl forget the last pattern used by //
+   * patch20: paragraph mode now skips extra newlines automatically
+   * patch20: ($<,$>) = ... didn't work on some architectures
+!  * 
+   * Revision 4.0.1.3  91/11/05  18:35:33  lwall
+   * patch11: length($x) was sometimes wrong for numeric $x
+   * patch11: perl now issues warning if $SIG{'ALARM'} is referenced
diff --git a/str.c b/str.c
index 4b597ccd51..8af06ad1a8 100644
--- a/str.c
+++ b/str.c
@@ -863,11 +863,10 @@ screamer:
 	bp = buf;
 	while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ;
 
-	*bp = '\0';
 	if (append)
-	    str_cat(str, buf);
+	    str_ncat(str, buf, bp - buf);
 	else
-	    str_set(str, buf);
+	    str_nset(str, buf, bp - buf);
 	if (i != EOF			/* joy */
 	    &&
 	    (i != newline
diff --git a/str.c.orig b/str.c.orig
new file mode 100644
index 0000000000..4b597ccd51
--- /dev/null
+++ b/str.c.orig
@@ -0,0 +1,1594 @@
+/* $RCSfile: str.c,v $$Revision: 4.0.1.6 $$Date: 92/06/11 21:14:21 $
+ *
+ *    Copyright (c) 1991, 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:	str.c,v $
+ * Revision 4.0.1.6  92/06/11  21:14:21  lwall
+ * patch34: quotes containing subscripts containing variables didn't parse right
+ * 
+ * Revision 4.0.1.5  92/06/08  15:40:43  lwall
+ * patch20: removed implicit int declarations on functions
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: paragraph mode now skips extra newlines automatically
+ * patch20: fixed memory leak in doube-quote interpretation
+ * patch20: made /\$$foo/ look for literal '$foo'
+ * patch20: "$var{$foo'bar}" didn't scan subscript correctly
+ * patch20: a splice on non-existent array elements could dump core
+ * patch20: running taintperl explicitly now does checks even if $< == $>
+ * 
+ * Revision 4.0.1.4  91/11/05  18:40:51  lwall
+ * patch11: $foo .= <BAR> could overrun malloced memory
+ * patch11: \$ didn't always make it through double-quoter to regexp routines
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * 
+ * Revision 4.0.1.3  91/06/10  01:27:54  lwall
+ * patch10: $) and $| incorrectly handled in run-time patterns
+ * 
+ * Revision 4.0.1.2  91/06/07  11:58:13  lwall
+ * patch4: new copyright notice
+ * patch4: taint check on undefined string could cause core dump
+ * 
+ * Revision 4.0.1.1  91/04/12  09:15:30  lwall
+ * patch1: fixed undefined environ problem
+ * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment
+ * patch1: $foo .= <BAR> could cause core dump for certain lengths of $foo
+ * 
+ * Revision 4.0  91/03/20  01:39:55  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "perly.h"
+
+static void ucase();
+static void lcase();
+
+#ifndef str_get
+char *
+str_get(str)
+STR *str;
+{
+#ifdef TAINT
+    tainted |= str->str_tainted;
+#endif
+    return str->str_pok ? str->str_ptr : str_2ptr(str);
+}
+#endif
+
+/* dlb ... guess we have a "crippled cc".
+ * dlb the following functions are usually macros.
+ */
+#ifndef str_true
+int
+str_true(Str)
+STR *Str;
+{
+	if (Str->str_pok) {
+	    if (*Str->str_ptr > '0' ||
+	      Str->str_cur > 1 ||
+	      (Str->str_cur && *Str->str_ptr != '0'))
+		return 1;
+	    return 0;
+	}
+	if (Str->str_nok)
+		return (Str->str_u.str_nval != 0.0);
+	return 0;
+}
+#endif /* str_true */
+
+#ifndef str_gnum
+double str_gnum(Str)
+STR *Str;
+{
+#ifdef TAINT
+	tainted |= Str->str_tainted;
+#endif /* TAINT*/
+	if (Str->str_nok)
+		return Str->str_u.str_nval;
+	return str_2num(Str);
+}
+#endif /* str_gnum */
+/* dlb ... end of crutch */
+
+char *
+str_grow(str,newlen)
+register STR *str;
+#ifndef DOSISH
+register int newlen;
+#else
+unsigned long newlen;
+#endif
+{
+    register char *s = str->str_ptr;
+
+#ifdef MSDOS
+    if (newlen >= 0x10000) {
+	fprintf(stderr, "Allocation too large: %lx\n", newlen);
+	exit(1);
+    }
+#endif /* MSDOS */
+    if (str->str_state == SS_INCR) {		/* data before str_ptr? */
+	str->str_len += str->str_u.str_useful;
+	str->str_ptr -= str->str_u.str_useful;
+	str->str_u.str_useful = 0L;
+	Move(s, str->str_ptr, str->str_cur+1, char);
+	s = str->str_ptr;
+	str->str_state = SS_NORM;			/* normal again */
+	if (newlen > str->str_len)
+	    newlen += 10 * (newlen - str->str_cur); /* avoid copy each time */
+    }
+    if (newlen > str->str_len) {		/* need more room? */
+        if (str->str_len)
+	    Renew(s,newlen,char);
+        else
+	    New(703,s,newlen,char);
+	str->str_ptr = s;
+        str->str_len = newlen;
+    }
+    return s;
+}
+
+void
+str_numset(str,num)
+register STR *str;
+double num;
+{
+    if (str->str_pok) {
+	str->str_pok = 0;	/* invalidate pointer */
+	if (str->str_state == SS_INCR)
+	    Str_Grow(str,0);
+    }
+    str->str_u.str_nval = num;
+    str->str_state = SS_NORM;
+    str->str_nok = 1;			/* validate number */
+#ifdef TAINT
+    str->str_tainted = tainted;
+#endif
+}
+
+char *
+str_2ptr(str)
+register STR *str;
+{
+    register char *s;
+    int olderrno;
+
+    if (!str)
+	return "";
+    if (str->str_nok) {
+	STR_GROW(str, 30);
+	s = str->str_ptr;
+	olderrno = errno;	/* some Xenix systems wipe out errno here */
+#if defined(scs) && defined(ns32000)
+	gcvt(str->str_u.str_nval,20,s);
+#else
+#ifdef apollo
+	if (str->str_u.str_nval == 0.0)
+	    (void)strcpy(s,"0");
+	else
+#endif /*apollo*/
+	(void)sprintf(s,"%.20g",str->str_u.str_nval);
+#endif /*scs*/
+	errno = olderrno;
+	while (*s) s++;
+#ifdef hcx
+	if (s[-1] == '.')
+	    s--;
+#endif
+    }
+    else {
+	if (str == &str_undef)
+	    return No;
+	if (dowarn)
+	    warn("Use of uninitialized variable");
+	STR_GROW(str, 30);
+	s = str->str_ptr;
+    }
+    *s = '\0';
+    str->str_cur = s - str->str_ptr;
+    str->str_pok = 1;
+#ifdef DEBUGGING
+    if (debug & 32)
+	fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr);
+#endif
+    return str->str_ptr;
+}
+
+double
+str_2num(str)
+register STR *str;
+{
+    if (!str)
+	return 0.0;
+    if (str->str_state == SS_INCR)
+	Str_Grow(str,0);       /* just force copy down */
+    str->str_state = SS_NORM;
+    if (str->str_len && str->str_pok)
+	str->str_u.str_nval = atof(str->str_ptr);
+    else  {
+	if (str == &str_undef)
+	    return 0.0;
+	if (dowarn)
+	    warn("Use of uninitialized variable");
+	str->str_u.str_nval = 0.0;
+    }
+    str->str_nok = 1;
+#ifdef DEBUGGING
+    if (debug & 32)
+	fprintf(stderr,"0x%lx num(%g)\n",str,str->str_u.str_nval);
+#endif
+    return str->str_u.str_nval;
+}
+
+/* Note: str_sset() should not be called with a source string that needs
+ * be reused, since it may destroy the source string if it is marked
+ * as temporary.
+ */
+
+void
+str_sset(dstr,sstr)
+STR *dstr;
+register STR *sstr;
+{
+#ifdef TAINT
+    if (sstr)
+	tainted |= sstr->str_tainted;
+#endif
+    if (sstr == dstr || dstr == &str_undef)
+	return;
+    if (!sstr)
+	dstr->str_pok = dstr->str_nok = 0;
+    else if (sstr->str_pok) {
+
+	/*
+	 * Check to see if we can just swipe the string.  If so, it's a
+	 * possible small lose on short strings, but a big win on long ones.
+	 * It might even be a win on short strings if dstr->str_ptr
+	 * has to be allocated and sstr->str_ptr has to be freed.
+	 */
+
+	if (sstr->str_pok & SP_TEMP) {		/* slated for free anyway? */
+	    if (dstr->str_ptr) {
+		if (dstr->str_state == SS_INCR)
+		    dstr->str_ptr -= dstr->str_u.str_useful;
+		Safefree(dstr->str_ptr);
+	    }
+	    dstr->str_ptr = sstr->str_ptr;
+	    dstr->str_len = sstr->str_len;
+	    dstr->str_cur = sstr->str_cur;
+	    dstr->str_state = sstr->str_state;
+	    dstr->str_pok = sstr->str_pok & ~SP_TEMP;
+#ifdef TAINT
+	    dstr->str_tainted = sstr->str_tainted;
+#endif
+	    sstr->str_ptr = Nullch;
+	    sstr->str_len = 0;
+	    sstr->str_pok = 0;			/* wipe out any weird flags */
+	    sstr->str_state = 0;		/* so sstr frees uneventfully */
+	}
+	else {					/* have to copy actual string */
+	    if (dstr->str_ptr) {
+		if (dstr->str_state == SS_INCR) {
+			Str_Grow(dstr,0);
+		}
+	    }
+	    str_nset(dstr,sstr->str_ptr,sstr->str_cur);
+	}
+	/*SUPPRESS 560*/
+	if (dstr->str_nok = sstr->str_nok)
+	    dstr->str_u.str_nval = sstr->str_u.str_nval;
+	else {
+#ifdef STRUCTCOPY
+	    dstr->str_u = sstr->str_u;
+#else
+	    dstr->str_u.str_nval = sstr->str_u.str_nval;
+#endif
+	    if (dstr->str_cur == sizeof(STBP)) {
+		char *tmps = dstr->str_ptr;
+
+		if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
+		    if (dstr->str_magic && dstr->str_magic->str_rare == 'X') {
+			str_free(dstr->str_magic);
+			dstr->str_magic = Nullstr;
+		    }
+		    if (!dstr->str_magic) {
+			dstr->str_magic = str_smake(sstr->str_magic);
+			dstr->str_magic->str_rare = 'X';
+		    }
+		}
+	    }
+	}
+    }
+    else if (sstr->str_nok)
+	str_numset(dstr,sstr->str_u.str_nval);
+    else {
+	if (dstr->str_state == SS_INCR)
+	    Str_Grow(dstr,0);       /* just force copy down */
+
+#ifdef STRUCTCOPY
+	dstr->str_u = sstr->str_u;
+#else
+	dstr->str_u.str_nval = sstr->str_u.str_nval;
+#endif
+	dstr->str_pok = dstr->str_nok = 0;
+    }
+}
+
+void
+str_nset(str,ptr,len)
+register STR *str;
+register char *ptr;
+register STRLEN len;
+{
+    if (str == &str_undef)
+	return;
+    STR_GROW(str, len + 1);
+    if (ptr)
+	Move(ptr,str->str_ptr,len,char);
+    str->str_cur = len;
+    *(str->str_ptr+str->str_cur) = '\0';
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+#ifdef TAINT
+    str->str_tainted = tainted;
+#endif
+}
+
+void
+str_set(str,ptr)
+register STR *str;
+register char *ptr;
+{
+    register STRLEN len;
+
+    if (str == &str_undef)
+	return;
+    if (!ptr)
+	ptr = "";
+    len = strlen(ptr);
+    STR_GROW(str, len + 1);
+    Move(ptr,str->str_ptr,len+1,char);
+    str->str_cur = len;
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+#ifdef TAINT
+    str->str_tainted = tainted;
+#endif
+}
+
+void
+str_chop(str,ptr)	/* like set but assuming ptr is in str */
+register STR *str;
+register char *ptr;
+{
+    register STRLEN delta;
+
+    if (!ptr || !(str->str_pok))
+	return;
+    delta = ptr - str->str_ptr;
+    str->str_len -= delta;
+    str->str_cur -= delta;
+    str->str_ptr += delta;
+    if (str->str_state == SS_INCR)
+	str->str_u.str_useful += delta;
+    else {
+	str->str_u.str_useful = delta;
+	str->str_state = SS_INCR;
+    }
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer (and unstudy str) */
+}
+
+void
+str_ncat(str,ptr,len)
+register STR *str;
+register char *ptr;
+register STRLEN len;
+{
+    if (str == &str_undef)
+	return;
+    if (!(str->str_pok))
+	(void)str_2ptr(str);
+    STR_GROW(str, str->str_cur + len + 1);
+    Move(ptr,str->str_ptr+str->str_cur,len,char);
+    str->str_cur += len;
+    *(str->str_ptr+str->str_cur) = '\0';
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+#ifdef TAINT
+    str->str_tainted |= tainted;
+#endif
+}
+
+void
+str_scat(dstr,sstr)
+STR *dstr;
+register STR *sstr;
+{
+    if (!sstr)
+	return;
+#ifdef TAINT
+    tainted |= sstr->str_tainted;
+#endif
+    if (!(sstr->str_pok))
+	(void)str_2ptr(sstr);
+    if (sstr)
+	str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
+}
+
+void
+str_cat(str,ptr)
+register STR *str;
+register char *ptr;
+{
+    register STRLEN len;
+
+    if (str == &str_undef)
+	return;
+    if (!ptr)
+	return;
+    if (!(str->str_pok))
+	(void)str_2ptr(str);
+    len = strlen(ptr);
+    STR_GROW(str, str->str_cur + len + 1);
+    Move(ptr,str->str_ptr+str->str_cur,len+1,char);
+    str->str_cur += len;
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+#ifdef TAINT
+    str->str_tainted |= tainted;
+#endif
+}
+
+char *
+str_append_till(str,from,fromend,delim,keeplist)
+register STR *str;
+register char *from;
+register char *fromend;
+register int delim;
+char *keeplist;
+{
+    register char *to;
+    register STRLEN len;
+
+    if (str == &str_undef)
+	return Nullch;
+    if (!from)
+	return Nullch;
+    len = fromend - from;
+    STR_GROW(str, str->str_cur + len + 1);
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+    to = str->str_ptr+str->str_cur;
+    for (; from < fromend; from++,to++) {
+	if (*from == '\\' && from+1 < fromend && delim != '\\') {
+	    if (!keeplist) {
+		if (from[1] == delim || from[1] == '\\')
+		    from++;
+		else
+		    *to++ = *from++;
+	    }
+	    else if (from[1] && index(keeplist,from[1]))
+		*to++ = *from++;
+	    else
+		from++;
+	}
+	else if (*from == delim)
+	    break;
+	*to = *from;
+    }
+    *to = '\0';
+    str->str_cur = to - str->str_ptr;
+    return from;
+}
+
+STR *
+#ifdef LEAKTEST
+str_new(x,len)
+int x;
+#else
+str_new(len)
+#endif
+STRLEN len;
+{
+    register STR *str;
+    
+    if (freestrroot) {
+	str = freestrroot;
+	freestrroot = str->str_magic;
+	str->str_magic = Nullstr;
+	str->str_state = SS_NORM;
+    }
+    else {
+	Newz(700+x,str,1,STR);
+    }
+    if (len)
+	STR_GROW(str, len + 1);
+    return str;
+}
+
+void
+str_magic(str, stab, how, name, namlen)
+register STR *str;
+STAB *stab;
+int how;
+char *name;
+STRLEN namlen;
+{
+    if (str == &str_undef || str->str_magic)
+	return;
+    str->str_magic = Str_new(75,namlen);
+    str = str->str_magic;
+    str->str_u.str_stab = stab;
+    str->str_rare = how;
+    if (name)
+	str_nset(str,name,namlen);
+}
+
+void
+str_insert(bigstr,offset,len,little,littlelen)
+STR *bigstr;
+STRLEN offset;
+STRLEN len;
+char *little;
+STRLEN littlelen;
+{
+    register char *big;
+    register char *mid;
+    register char *midend;
+    register char *bigend;
+    register int i;
+
+    if (bigstr == &str_undef)
+	return;
+    bigstr->str_nok = 0;
+    bigstr->str_pok = SP_VALID;	/* disable possible screamer */
+
+    i = littlelen - len;
+    if (i > 0) {			/* string might grow */
+	STR_GROW(bigstr, bigstr->str_cur + i + 1);
+	big = bigstr->str_ptr;
+	mid = big + offset + len;
+	midend = bigend = big + bigstr->str_cur;
+	bigend += i;
+	*bigend = '\0';
+	while (midend > mid)		/* shove everything down */
+	    *--bigend = *--midend;
+	Move(little,big+offset,littlelen,char);
+	bigstr->str_cur += i;
+	STABSET(bigstr);
+	return;
+    }
+    else if (i == 0) {
+	Move(little,bigstr->str_ptr+offset,len,char);
+	STABSET(bigstr);
+	return;
+    }
+
+    big = bigstr->str_ptr;
+    mid = big + offset;
+    midend = mid + len;
+    bigend = big + bigstr->str_cur;
+
+    if (midend > bigend)
+	fatal("panic: str_insert");
+
+    if (mid - big > bigend - midend) {	/* faster to shorten from end */
+	if (littlelen) {
+	    Move(little, mid, littlelen,char);
+	    mid += littlelen;
+	}
+	i = bigend - midend;
+	if (i > 0) {
+	    Move(midend, mid, i,char);
+	    mid += i;
+	}
+	*mid = '\0';
+	bigstr->str_cur = mid - big;
+    }
+    /*SUPPRESS 560*/
+    else if (i = mid - big) {	/* faster from front */
+	midend -= littlelen;
+	mid = midend;
+	str_chop(bigstr,midend-i);
+	big += i;
+	while (i--)
+	    *--midend = *--big;
+	if (littlelen)
+	    Move(little, mid, littlelen,char);
+    }
+    else if (littlelen) {
+	midend -= littlelen;
+	str_chop(bigstr,midend);
+	Move(little,midend,littlelen,char);
+    }
+    else {
+	str_chop(bigstr,midend);
+    }
+    STABSET(bigstr);
+}
+
+/* make str point to what nstr did */
+
+void
+str_replace(str,nstr)
+register STR *str;
+register STR *nstr;
+{
+    if (str == &str_undef)
+	return;
+    if (str->str_state == SS_INCR)
+	Str_Grow(str,0);	/* just force copy down */
+    if (nstr->str_state == SS_INCR)
+	Str_Grow(nstr,0);
+    if (str->str_ptr)
+	Safefree(str->str_ptr);
+    str->str_ptr = nstr->str_ptr;
+    str->str_len = nstr->str_len;
+    str->str_cur = nstr->str_cur;
+    str->str_pok = nstr->str_pok;
+    str->str_nok = nstr->str_nok;
+#ifdef STRUCTCOPY
+    str->str_u = nstr->str_u;
+#else
+    str->str_u.str_nval = nstr->str_u.str_nval;
+#endif
+#ifdef TAINT
+    str->str_tainted = nstr->str_tainted;
+#endif
+    if (nstr->str_magic)
+	str_free(nstr->str_magic);
+    Safefree(nstr);
+}
+
+void
+str_free(str)
+register STR *str;
+{
+    if (!str || str == &str_undef)
+	return;
+    if (str->str_state) {
+	if (str->str_state == SS_FREE)	/* already freed */
+	    return;
+	if (str->str_state == SS_INCR && !(str->str_pok & 2)) {
+	    str->str_ptr -= str->str_u.str_useful;
+	    str->str_len += str->str_u.str_useful;
+	}
+    }
+    if (str->str_magic)
+	str_free(str->str_magic);
+    str->str_magic = freestrroot;
+#ifdef LEAKTEST
+    if (str->str_len) {
+	Safefree(str->str_ptr);
+	str->str_ptr = Nullch;
+    }
+    if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
+	arg_free(str->str_u.str_args);
+    Safefree(str);
+#else /* LEAKTEST */
+    if (str->str_len) {
+	if (str->str_len > 127) {	/* next user not likely to want more */
+	    Safefree(str->str_ptr);	/* so give it back to malloc */
+	    str->str_ptr = Nullch;
+	    str->str_len = 0;
+	}
+	else
+	    str->str_ptr[0] = '\0';
+    }
+    if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
+	arg_free(str->str_u.str_args);
+    str->str_cur = 0;
+    str->str_nok = 0;
+    str->str_pok = 0;
+    str->str_state = SS_FREE;
+#ifdef TAINT
+    str->str_tainted = 0;
+#endif
+    freestrroot = str;
+#endif /* LEAKTEST */
+}
+
+STRLEN
+str_len(str)
+register STR *str;
+{
+    if (!str)
+	return 0;
+    if (!(str->str_pok))
+	(void)str_2ptr(str);
+    if (str->str_ptr)
+	return str->str_cur;
+    else
+	return 0;
+}
+
+int
+str_eq(str1,str2)
+register STR *str1;
+register STR *str2;
+{
+    if (!str1 || str1 == &str_undef)
+	return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur);
+    if (!str2 || str2 == &str_undef)
+	return !str1->str_cur;
+
+    if (!str1->str_pok)
+	(void)str_2ptr(str1);
+    if (!str2->str_pok)
+	(void)str_2ptr(str2);
+
+    if (str1->str_cur != str2->str_cur)
+	return 0;
+
+    return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur);
+}
+
+int
+str_cmp(str1,str2)
+register STR *str1;
+register STR *str2;
+{
+    int retval;
+
+    if (!str1 || str1 == &str_undef)
+	return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur)?0:-1;
+    if (!str2 || str2 == &str_undef)
+	return str1->str_cur != 0;
+
+    if (!str1->str_pok)
+	(void)str_2ptr(str1);
+    if (!str2->str_pok)
+	(void)str_2ptr(str2);
+
+    if (str1->str_cur < str2->str_cur) {
+	/*SUPPRESS 560*/
+	if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
+	    return retval < 0 ? -1 : 1;
+	else
+	    return -1;
+    }
+    /*SUPPRESS 560*/
+    else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
+	return retval < 0 ? -1 : 1;
+    else if (str1->str_cur == str2->str_cur)
+	return 0;
+    else
+	return 1;
+}
+
+char *
+str_gets(str,fp,append)
+register STR *str;
+register FILE *fp;
+int append;
+{
+    register char *bp;		/* we're going to steal some values */
+    register int cnt;		/*  from the stdio struct and put EVERYTHING */
+    register STDCHAR *ptr;	/*   in the innermost loop into registers */
+    register int newline = rschar;/* (assuming >= 6 registers) */
+    int i;
+    STRLEN bpx;
+    int shortbuffered;
+
+    if (str == &str_undef)
+	return Nullch;
+    if (rspara) {		/* have to do this both before and after */
+	do {			/* to make sure file boundaries work right */
+	    i = getc(fp);
+	    if (i != '\n') {
+		ungetc(i,fp);
+		break;
+	    }
+	} while (i != EOF);
+    }
+#ifdef STDSTDIO		/* Here is some breathtakingly efficient cheating */
+    cnt = fp->_cnt;			/* get count into register */
+    str->str_nok = 0;			/* invalidate number */
+    str->str_pok = 1;			/* validate pointer */
+    if (str->str_len - append <= cnt + 1) { /* make sure we have the room */
+	if (cnt > 80 && str->str_len > append) {
+	    shortbuffered = cnt - str->str_len + append + 1;
+	    cnt -= shortbuffered;
+	}
+	else {
+	    shortbuffered = 0;
+	    STR_GROW(str, append+cnt+2);/* (remembering cnt can be -1) */
+	}
+    }
+    else
+	shortbuffered = 0;
+    bp = str->str_ptr + append;		/* move these two too to registers */
+    ptr = fp->_ptr;
+    for (;;) {
+      screamer:
+	while (--cnt >= 0) {			/* this */	/* eat */
+	    if ((*bp++ = *ptr++) == newline)	/* really */	/* dust */
+		goto thats_all_folks;		/* screams */	/* sed :-) */ 
+	}
+	
+	if (shortbuffered) {			/* oh well, must extend */
+	    cnt = shortbuffered;
+	    shortbuffered = 0;
+	    bpx = bp - str->str_ptr;	/* prepare for possible relocation */
+	    str->str_cur = bpx;
+	    STR_GROW(str, str->str_len + append + cnt + 2);
+	    bp = str->str_ptr + bpx;	/* reconstitute our pointer */
+	    continue;
+	}
+
+	fp->_cnt = cnt;			/* deregisterize cnt and ptr */
+	fp->_ptr = ptr;
+	i = _filbuf(fp);		/* get more characters */
+	cnt = fp->_cnt;
+	ptr = fp->_ptr;			/* reregisterize cnt and ptr */
+
+	bpx = bp - str->str_ptr;	/* prepare for possible relocation */
+	str->str_cur = bpx;
+	STR_GROW(str, bpx + cnt + 2);
+	bp = str->str_ptr + bpx;	/* reconstitute our pointer */
+
+	if (i == newline) {		/* all done for now? */
+	    *bp++ = i;
+	    goto thats_all_folks;
+	}
+	else if (i == EOF)		/* all done for ever? */
+	    goto thats_really_all_folks;
+	*bp++ = i;			/* now go back to screaming loop */
+    }
+
+thats_all_folks:
+    if (rslen > 1 && (bp - str->str_ptr < rslen || bcmp(bp - rslen, rs, rslen)))
+	goto screamer;	/* go back to the fray */
+thats_really_all_folks:
+    if (shortbuffered)
+	cnt += shortbuffered;
+    fp->_cnt = cnt;			/* put these back or we're in trouble */
+    fp->_ptr = ptr;
+    *bp = '\0';
+    str->str_cur = bp - str->str_ptr;	/* set length */
+
+#else /* !STDSTDIO */	/* The big, slow, and stupid way */
+
+    {
+	static char buf[8192];
+	char * bpe = buf + sizeof(buf) - 3;
+
+screamer:
+	bp = buf;
+	while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ;
+
+	*bp = '\0';
+	if (append)
+	    str_cat(str, buf);
+	else
+	    str_set(str, buf);
+	if (i != EOF			/* joy */
+	    &&
+	    (i != newline
+	     ||
+	     (rslen > 1
+	      &&
+	      (str->str_cur < rslen
+	       ||
+	       bcmp(str->str_ptr + str->str_cur - rslen, rs, rslen)
+	      )
+	     )
+	    )
+	   )
+	{
+	    append = -1;
+	    goto screamer;
+	}
+    }
+
+#endif /* STDSTDIO */
+
+    if (rspara) {
+        while (i != EOF) {
+	    i = getc(fp);
+	    if (i != '\n') {
+		ungetc(i,fp);
+		break;
+	    }
+	}
+    }
+    return str->str_cur - append ? str->str_ptr : Nullch;
+}
+
+ARG *
+parselist(str)
+STR *str;
+{
+    register CMD *cmd;
+    register ARG *arg;
+    CMD *oldcurcmd = curcmd;
+    int oldperldb = perldb;
+    int retval;
+
+    perldb = 0;
+    str_sset(linestr,str);
+    in_eval++;
+    oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
+    bufend = bufptr + linestr->str_cur;
+    if (++loop_ptr >= loop_max) {
+        loop_max += 128;
+        Renew(loop_stack, loop_max, struct loop);
+    }
+    loop_stack[loop_ptr].loop_label = "_EVAL_";
+    loop_stack[loop_ptr].loop_sp = 0;
+#ifdef DEBUGGING
+    if (debug & 4) {
+        deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
+    }
+#endif
+    if (setjmp(loop_stack[loop_ptr].loop_env)) {
+	in_eval--;
+	loop_ptr--;
+	perldb = oldperldb;
+	fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
+    }
+#ifdef DEBUGGING
+    if (debug & 4) {
+	char *tmps = loop_stack[loop_ptr].loop_label;
+	deb("(Popping label #%d %s)\n",loop_ptr,
+	    tmps ? tmps : "" );
+    }
+#endif
+    loop_ptr--;
+    error_count = 0;
+    curcmd = &compiling;
+    curcmd->c_line = oldcurcmd->c_line;
+    retval = yyparse();
+    curcmd = oldcurcmd;
+    perldb = oldperldb;
+    in_eval--;
+    if (retval || error_count)
+	fatal("Invalid component in string or format");
+    cmd = eval_root;
+    arg = cmd->c_expr;
+    if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
+	fatal("panic: error in parselist %d %x %d", cmd->c_type,
+	  cmd->c_next, arg ? arg->arg_type : -1);
+    cmd->c_expr = Nullarg;
+    cmd_free(cmd);
+    eval_root = Nullcmd;
+    return arg;
+}
+
+void
+intrpcompile(src)
+STR *src;
+{
+    register char *s = str_get(src);
+    register char *send = s + src->str_cur;
+    register STR *str;
+    register char *t;
+    STR *toparse;
+    STRLEN len;
+    register int brackets;
+    register char *d;
+    STAB *stab;
+    char *checkpoint;
+    int sawcase = 0;
+
+    toparse = Str_new(76,0);
+    str = Str_new(77,0);
+
+    str_nset(str,"",0);
+    str_nset(toparse,"",0);
+    t = s;
+    while (s < send) {
+	if (*s == '\\' && s[1] && index("$@[{\\]}lLuUE",s[1])) {
+	    str_ncat(str, t, s - t);
+	    ++s;
+	    if (isALPHA(*s)) {
+		str_ncat(str, "$c", 2);
+		sawcase = (*s != 'E');
+	    }
+	    else {
+		if (*nointrp) {		/* in a regular expression */
+		    if (*s == '@')	/* always strip \@ */ /*SUPPRESS 530*/
+			;
+		    else		/* don't strip \\, \[, \{ etc. */
+			str_ncat(str,s-1,1);
+		}
+		str_ncat(str, "$b", 2);
+	    }
+	    str_ncat(str, s, 1);
+	    ++s;
+	    t = s;
+	}
+	else if (*s == '$' && s+1 < send && *nointrp && index(nointrp,s[1])) {
+	    str_ncat(str, t, s - t);
+	    str_ncat(str, "$b", 2);
+	    str_ncat(str, s, 2);
+	    s += 2;
+	    t = s;
+	}
+	else if ((*s == '@' || *s == '$') && s+1 < send) {
+	    str_ncat(str,t,s-t);
+	    t = s;
+	    if (*s == '$' && s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
+		s++;
+	    s = scanident(s,send,tokenbuf);
+	    if (*t == '@' &&
+	      (!(stab = stabent(tokenbuf,FALSE)) || 
+		 (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) {
+		str_ncat(str,"@",1);
+		s = ++t;
+		continue;	/* grandfather @ from old scripts */
+	    }
+	    str_ncat(str,"$a",2);
+	    str_ncat(toparse,",",1);
+	    if (t[1] != '{' && (*s == '['  || *s == '{' /* }} */ ) &&
+	      (stab = stabent(tokenbuf,FALSE)) &&
+	      ((*s == '[') ? (stab_xarray(stab) != 0) : (stab_xhash(stab) != 0)) ) {
+		brackets = 0;
+		checkpoint = s;
+		do {
+		    switch (*s) {
+		    case '[':
+			brackets++;
+			break;
+		    case '{':
+			brackets++;
+			break;
+		    case ']':
+			brackets--;
+			break;
+		    case '}':
+			brackets--;
+			break;
+		    case '$':
+		    case '%':
+		    case '@':
+		    case '&':
+		    case '*':
+			s = scanident(s,send,tokenbuf);
+			continue;
+		    case '\'':
+		    case '"':
+			/*SUPPRESS 68*/
+			s = cpytill(tokenbuf,s+1,send,*s,&len);
+			if (s >= send)
+			    fatal("Unterminated string");
+			break;
+		    }
+		    s++;
+		} while (brackets > 0 && s < send);
+		if (s > send)
+		    fatal("Unmatched brackets in string");
+		if (*nointrp) {		/* we're in a regular expression */
+		    d = checkpoint;
+		    if (*d == '{' && s[-1] == '}') {	/* maybe {n,m} */
+			++d;
+			if (isDIGIT(*d)) {	/* matches /^{\d,?\d*}$/ */
+			    if (*++d == ',')
+				++d;
+			    while (isDIGIT(*d))
+				d++;
+			    if (d == s - 1)
+				s = checkpoint;		/* Is {n,m}! Backoff! */
+			}
+		    }
+		    else if (*d == '[' && s[-1] == ']') { /* char class? */
+			int weight = 2;		/* let's weigh the evidence */
+			char seen[256];
+			unsigned char un_char = 0, last_un_char;
+
+			Zero(seen,256,char);
+			*--s = '\0';
+			if (d[1] == '^')
+			    weight += 150;
+			else if (d[1] == '$')
+			    weight -= 3;
+			if (isDIGIT(d[1])) {
+			    if (d[2]) {
+				if (isDIGIT(d[2]) && !d[3])
+				    weight -= 10;
+			    }
+			    else
+				weight -= 100;
+			}
+			for (d++; d < s; d++) {
+			    last_un_char = un_char;
+			    un_char = (unsigned char)*d;
+			    switch (*d) {
+			    case '&':
+			    case '$':
+				weight -= seen[un_char] * 10;
+				if (isALNUM(d[1])) {
+				    d = scanident(d,s,tokenbuf);
+				    if (stabent(tokenbuf,FALSE))
+					weight -= 100;
+				    else
+					weight -= 10;
+				}
+				else if (*d == '$' && d[1] &&
+				  index("[#!%*<>()-=",d[1])) {
+				    if (!d[2] || /*{*/ index("])} =",d[2]))
+					weight -= 10;
+				    else
+					weight -= 1;
+				}
+				break;
+			    case '\\':
+				un_char = 254;
+				if (d[1]) {
+				    if (index("wds",d[1]))
+					weight += 100;
+				    else if (seen['\''] || seen['"'])
+					weight += 1;
+				    else if (index("rnftb",d[1]))
+					weight += 40;
+				    else if (isDIGIT(d[1])) {
+					weight += 40;
+					while (d[1] && isDIGIT(d[1]))
+					    d++;
+				    }
+				}
+				else
+				    weight += 100;
+				break;
+			    case '-':
+				if (last_un_char < (unsigned char) d[1]
+				  || d[1] == '\\') {
+				    if (index("aA01! ",last_un_char))
+					weight += 30;
+				    if (index("zZ79~",d[1]))
+					weight += 30;
+				}
+				else
+				    weight -= 1;
+			    default:
+				if (isALPHA(*d) && d[1] && isALPHA(d[1])) {
+				    bufptr = d;
+				    if (yylex() != WORD)
+					weight -= 150;
+				    d = bufptr;
+				}
+				if (un_char == last_un_char + 1)
+				    weight += 5;
+				weight -= seen[un_char];
+				break;
+			    }
+			    seen[un_char]++;
+			}
+#ifdef DEBUGGING
+			if (debug & 512)
+			    fprintf(stderr,"[%s] weight %d\n",
+			      checkpoint+1,weight);
+#endif
+			*s++ = ']';
+			if (weight >= 0)	/* probably a character class */
+			    s = checkpoint;
+		    }
+		}
+	    }
+	    if (*t == '@')
+		str_ncat(toparse, "join($\",", 8);
+	    if (t[1] == '{' && s[-1] == '}') {
+		str_ncat(toparse, t, 1);
+		str_ncat(toparse, t+2, s - t - 3);
+	    }
+	    else
+		str_ncat(toparse, t, s - t);
+	    if (*t == '@')
+		str_ncat(toparse, ")", 1);
+	    t = s;
+	}
+	else
+	    s++;
+    }
+    str_ncat(str,t,s-t);
+    if (sawcase)
+	str_ncat(str, "$cE", 3);
+    if (toparse->str_ptr && *toparse->str_ptr == ',') {
+	*toparse->str_ptr = '(';
+	str_ncat(toparse,",$$);",5);
+	str->str_u.str_args = parselist(toparse);
+	str->str_u.str_args->arg_len--;		/* ignore $$ reference */
+    }
+    else
+	str->str_u.str_args = Nullarg;
+    str_free(toparse);
+    str->str_pok |= SP_INTRP;
+    str->str_nok = 0;
+    str_replace(src,str);
+}
+
+STR *
+interp(str,src,sp)
+register STR *str;
+STR *src;
+int sp;
+{
+    register char *s;
+    register char *t;
+    register char *send;
+    register STR **elem;
+    int docase = 0;
+    int l = 0;
+    int u = 0;
+    int L = 0;
+    int U = 0;
+
+    if (str == &str_undef)
+	return Nullstr;
+    if (!(src->str_pok & SP_INTRP)) {
+	int oldsave = savestack->ary_fill;
+
+	(void)savehptr(&curstash);
+	curstash = curcmd->c_stash;	/* so stabent knows right package */
+	intrpcompile(src);
+	restorelist(oldsave);
+    }
+    s = src->str_ptr;		/* assumed valid since str_pok set */
+    t = s;
+    send = s + src->str_cur;
+
+    if (src->str_u.str_args) {
+	(void)eval(src->str_u.str_args,G_ARRAY,sp);
+	/* Assuming we have correct # of args */
+	elem = stack->ary_array + sp;
+    }
+
+    str_nset(str,"",0);
+    while (s < send) {
+	if (*s == '$' && s+1 < send) {
+	    if (s-t > 0)
+		str_ncat(str,t,s-t);
+	    switch(*++s) {
+	    default:
+		fatal("panic: unknown interp cookie\n");
+		break;
+	    case 'a':
+		str_scat(str,*++elem);
+		break;
+	    case 'b':
+		str_ncat(str,++s,1);
+		break;
+	    case 'c':
+		if (docase && str->str_cur >= docase) {
+		    char *b = str->str_ptr + --docase;
+
+		    if (L)
+			lcase(b, str->str_ptr + str->str_cur);
+		    else if (U)
+			ucase(b, str->str_ptr + str->str_cur);
+
+		    if (u)	/* note that l & u are independent of L & U */
+			ucase(b, b+1);
+		    else if (l)
+			lcase(b, b+1);
+		    l = u = 0;
+		}
+		docase = str->str_cur + 1;
+		switch (*++s) {
+		case 'u':
+		    u = 1;
+		    l = 0;
+		    break;
+		case 'U':
+		    U = 1;
+		    L = 0;
+		    break;
+		case 'l':
+		    l = 1;
+		    u = 0;
+		    break;
+		case 'L':
+		    L = 1;
+		    U = 0;
+		    break;
+		case 'E':
+		    docase = L = U = l = u = 0;
+		    break;
+		}
+		break;
+	    }
+	    t = ++s;
+	}
+	else
+	    s++;
+    }
+    if (s-t > 0)
+	str_ncat(str,t,s-t);
+    return str;
+}
+
+static void
+ucase(s,send)
+register char *s;
+register char *send;
+{
+    while (s < send) {
+	if (isLOWER(*s))
+	    *s = toupper(*s);
+	s++;
+    }
+}
+
+static void
+lcase(s,send)
+register char *s;
+register char *send;
+{
+    while (s < send) {
+	if (isUPPER(*s))
+	    *s = tolower(*s);
+	s++;
+    }
+}
+
+void
+str_inc(str)
+register STR *str;
+{
+    register char *d;
+
+    if (!str || str == &str_undef)
+	return;
+    if (str->str_nok) {
+	str->str_u.str_nval += 1.0;
+	str->str_pok = 0;
+	return;
+    }
+    if (!str->str_pok || !*str->str_ptr) {
+	str->str_u.str_nval = 1.0;
+	str->str_nok = 1;
+	str->str_pok = 0;
+	return;
+    }
+    d = str->str_ptr;
+    while (isALPHA(*d)) d++;
+    while (isDIGIT(*d)) d++;
+    if (*d) {
+        str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
+	return;
+    }
+    d--;
+    while (d >= str->str_ptr) {
+	if (isDIGIT(*d)) {
+	    if (++*d <= '9')
+		return;
+	    *(d--) = '0';
+	}
+	else {
+	    ++*d;
+	    if (isALPHA(*d))
+		return;
+	    *(d--) -= 'z' - 'a' + 1;
+	}
+    }
+    /* oh,oh, the number grew */
+    STR_GROW(str, str->str_cur + 2);
+    str->str_cur++;
+    for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
+	*d = d[-1];
+    if (isDIGIT(d[1]))
+	*d = '1';
+    else
+	*d = d[1];
+}
+
+void
+str_dec(str)
+register STR *str;
+{
+    if (!str || str == &str_undef)
+	return;
+    if (str->str_nok) {
+	str->str_u.str_nval -= 1.0;
+	str->str_pok = 0;
+	return;
+    }
+    if (!str->str_pok) {
+	str->str_u.str_nval = -1.0;
+	str->str_nok = 1;
+	return;
+    }
+    str_numset(str,atof(str->str_ptr) - 1.0);
+}
+
+/* Make a string that will exist for the duration of the expression
+ * evaluation.  Actually, it may have to last longer than that, but
+ * hopefully cmd_exec won't free it until it has been assigned to a
+ * permanent location. */
+
+static long tmps_size = -1;
+
+STR *
+str_mortal(oldstr)
+STR *oldstr;
+{
+    register STR *str = Str_new(78,0);
+
+    str_sset(str,oldstr);
+    if (++tmps_max > tmps_size) {
+	tmps_size = tmps_max;
+	if (!(tmps_size & 127)) {
+	    if (tmps_size)
+		Renew(tmps_list, tmps_size + 128, STR*);
+	    else
+		New(702,tmps_list, 128, STR*);
+	}
+    }
+    tmps_list[tmps_max] = str;
+    if (str->str_pok)
+	str->str_pok |= SP_TEMP;
+    return str;
+}
+
+/* same thing without the copying */
+
+STR *
+str_2mortal(str)
+register STR *str;
+{
+    if (!str || str == &str_undef)
+	return str;
+    if (++tmps_max > tmps_size) {
+	tmps_size = tmps_max;
+	if (!(tmps_size & 127)) {
+	    if (tmps_size)
+		Renew(tmps_list, tmps_size + 128, STR*);
+	    else
+		New(704,tmps_list, 128, STR*);
+	}
+    }
+    tmps_list[tmps_max] = str;
+    if (str->str_pok)
+	str->str_pok |= SP_TEMP;
+    return str;
+}
+
+STR *
+str_make(s,len)
+char *s;
+STRLEN len;
+{
+    register STR *str = Str_new(79,0);
+
+    if (!len)
+	len = strlen(s);
+    str_nset(str,s,len);
+    return str;
+}
+
+STR *
+str_nmake(n)
+double n;
+{
+    register STR *str = Str_new(80,0);
+
+    str_numset(str,n);
+    return str;
+}
+
+/* make an exact duplicate of old */
+
+STR *
+str_smake(old)
+register STR *old;
+{
+    register STR *new = Str_new(81,0);
+
+    if (!old)
+	return Nullstr;
+    if (old->str_state == SS_FREE) {
+	warn("semi-panic: attempt to dup freed string");
+	return Nullstr;
+    }
+    if (old->str_state == SS_INCR && !(old->str_pok & 2))
+	Str_Grow(old,0);
+    if (new->str_ptr)
+	Safefree(new->str_ptr);
+    StructCopy(old,new,STR);
+    if (old->str_ptr) {
+	new->str_ptr = nsavestr(old->str_ptr,old->str_len);
+	new->str_pok &= ~SP_TEMP;
+    }
+    return new;
+}
+
+void
+str_reset(s,stash)
+register char *s;
+HASH *stash;
+{
+    register HENT *entry;
+    register STAB *stab;
+    register STR *str;
+    register int i;
+    register SPAT *spat;
+    register int max;
+
+    if (!*s) {		/* reset ?? searches */
+	for (spat = stash->tbl_spatroot;
+	  spat != Nullspat;
+	  spat = spat->spat_next) {
+	    spat->spat_flags &= ~SPAT_USED;
+	}
+	return;
+    }
+
+    /* reset variables */
+
+    if (!stash->tbl_array)
+	return;
+    while (*s) {
+	i = *s;
+	if (s[1] == '-') {
+	    s += 2;
+	}
+	max = *s++;
+	for ( ; i <= max; i++) {
+	    for (entry = stash->tbl_array[i];
+	      entry;
+	      entry = entry->hent_next) {
+		stab = (STAB*)entry->hent_val;
+		str = stab_val(stab);
+		str->str_cur = 0;
+		str->str_nok = 0;
+#ifdef TAINT
+		str->str_tainted = tainted;
+#endif
+		if (str->str_ptr != Nullch)
+		    str->str_ptr[0] = '\0';
+		if (stab_xarray(stab)) {
+		    aclear(stab_xarray(stab));
+		}
+		if (stab_xhash(stab)) {
+		    hclear(stab_xhash(stab), FALSE);
+		    if (stab == envstab)
+			environ[0] = Nullch;
+		}
+	    }
+	}
+    }
+}
+
+#ifdef TAINT
+void
+taintproper(s)
+char *s;
+{
+#ifdef DEBUGGING
+    if (debug & 2048)
+	fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
+#endif
+    if (tainted && (!euid || euid != uid || egid != gid || taintanyway)) {
+	if (!unsafe)
+	    fatal("%s", s);
+	else if (dowarn)
+	    warn("%s", s);
+    }
+}
+
+void
+taintenv()
+{
+    register STR *envstr;
+
+    envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
+    if (envstr == &str_undef || envstr->str_tainted) {
+	tainted = 1;
+	if (envstr->str_tainted == 2)
+	    taintproper("Insecure directory in PATH");
+	else
+	    taintproper("Insecure PATH");
+    }
+    envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
+    if (envstr != &str_undef && envstr->str_tainted) {
+	tainted = 1;
+	taintproper("Insecure IFS");
+    }
+}
+#endif /* TAINT */
diff --git a/str.c.rej b/str.c.rej
new file mode 100644
index 0000000000..e58d31c643
--- /dev/null
+++ b/str.c.rej
@@ -0,0 +1,35 @@
+***************
+*** 1,4 ****
+! /* $RCSfile: str.c,v $$Revision: 4.0.1.6 $$Date: 1992/06/11 21:14:21 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+--- 1,4 ----
+! /* $RCSfile: str.c,v $$Revision: 4.0.1.7 $$Date: 1993/02/05 19:43:47 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+***************
+*** 6,14 ****
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: str.c,v $
+!  * Revision 4.0.1.6  1992/06/11  21:14:21  lwall
+!  * patch34: quotes containing subscripts containing variables didn't parse right
+   *
+   * Revision 4.0.1.5  92/06/08  15:40:43  lwall
+   * patch20: removed implicit int declarations on functions
+   * patch20: Perl now distinguishes overlapped copies from non-overlapped
+--- 6,17 ----
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: str.c,v $
+!  * Revision 4.0.1.7  1993/02/05  19:43:47  lwall
+!  * patch36: the non-std stdio input code wasn't null-proof
+   *
++  * Revision 4.0.1.6  92/06/11  21:14:21  lwall
++  * patch34: quotes containing subscripts containing variables didn't parse right
++  * 
+   * Revision 4.0.1.5  92/06/08  15:40:43  lwall
+   * patch20: removed implicit int declarations on functions
+   * patch20: Perl now distinguishes overlapped copies from non-overlapped
diff --git a/t/io/fs.t b/t/io/fs.t
index 705523cffe..d298b29509 100644
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -13,7 +13,7 @@ chdir './tmp';
 
 umask(022);
 
-if (umask(0) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
+if ((umask(0)&0777) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
 open(fh,'>x') || die "Can't create x";
 close(fh);
 open(fh,'>a') || die "Can't create a";
diff --git a/t/io/fs.t.orig b/t/io/fs.t.orig
new file mode 100644
index 0000000000..705523cffe
--- /dev/null
+++ b/t/io/fs.t.orig
@@ -0,0 +1,85 @@
+#!./perl
+
+# $Header: fs.t,v 4.0 91/03/20 01:50:55 lwall Locked $
+
+print "1..22\n";
+
+$wd = `pwd`;
+chop($wd);
+
+`rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`;
+chdir './tmp';
+`/bin/rm -rf a b c x`;
+
+umask(022);
+
+if (umask(0) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
+open(fh,'>x') || die "Can't create x";
+close(fh);
+open(fh,'>a') || die "Can't create a";
+close(fh);
+
+if (link('a','b')) {print "ok 2\n";} else {print "not ok 2\n";}
+
+if (link('b','c')) {print "ok 3\n";} else {print "not ok 3\n";}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('c');
+
+if ($nlink == 3) {print "ok 4\n";} else {print "not ok 4\n";}
+if (($mode & 0777) == 0666) {print "ok 5\n";} else {print "not ok 5\n";}
+
+if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('c');
+if (($mode & 0777) == 0777) {print "ok 7\n";} else {print "not ok 7\n";}
+
+if ((chmod 0700,'c','x') == 2) {print "ok 8\n";} else {print "not ok 8\n";}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('c');
+if (($mode & 0777) == 0700) {print "ok 9\n";} else {print "not ok 9\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('x');
+if (($mode & 0777) == 0700) {print "ok 10\n";} else {print "not ok 10\n";}
+
+if ((unlink 'b','x') == 2) {print "ok 11\n";} else {print "not ok 11\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('b');
+if ($ino == 0) {print "ok 12\n";} else {print "not ok 12\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('x');
+if ($ino == 0) {print "ok 13\n";} else {print "not ok 13\n";}
+
+if (rename('a','b')) {print "ok 14\n";} else {print "not ok 14\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('a');
+if ($ino == 0) {print "ok 15\n";} else {print "not ok 15\n";}
+$foo = (utime 500000000,500000001,'b');
+if ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('b');
+if ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
+if (($atime == 500000000 && $mtime == 500000001) || $wd =~ m#/afs/#)
+    {print "ok 18\n";}
+else
+    {print "not ok 18 $atime $mtime\n";}
+
+if ((unlink 'b') == 1) {print "ok 19\n";} else {print "not ok 19\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('b');
+if ($ino == 0) {print "ok 20\n";} else {print "not ok 20\n";}
+unlink 'c';
+
+chdir $wd || die "Can't cd back to $wd";
+
+unlink 'c';
+if (`ls -l perl 2>/dev/null` =~ /^l.*->/) {  # we have symbolic links
+    if (symlink("TEST","c")) {print "ok 21\n";} else {print "not ok 21\n";}
+    $foo = `grep perl c`;
+    if ($foo) {print "ok 22\n";} else {print "not ok 22\n";}
+}
+else {
+    print "ok 21\nok 22\n";
+}
diff --git a/t/io/fs.t.rej b/t/io/fs.t.rej
new file mode 100644
index 0000000000..e519af0ed8
--- /dev/null
+++ b/t/io/fs.t.rej
@@ -0,0 +1,15 @@
+***************
+*** 1,6 ****
+  #!./perl
+  
+! # $Header: fs.t,v 4.0 1991/03/20 01:50:55 lwall Locked $
+  
+  print "1..22\n";
+  
+--- 1,6 ----
+  #!./perl
+  
+! # $RCSfile: fs.t,v $$Revision: 4.0.1.1 $$Date: 1993/02/05 19:44:34 $
+  
+  print "1..22\n";
+  
diff --git a/toke.c b/toke.c
index 8019756220..6a406385d9 100644
--- a/toke.c
+++ b/toke.c
@@ -162,7 +162,7 @@ check_uni() {
 	return;
     while (isSPACE(*last_uni))
 	last_uni++;
-    for (s = last_uni; isALNUM(*s); s++) ;
+    for (s = last_uni; isALNUM(*s) || *s == '-'; s++) ;
     ch = *s;
     *s = '\0';
     warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
@@ -442,6 +442,7 @@ yylex()
     case '-':
 	if (s[1] && isALPHA(s[1]) && !isALPHA(s[2])) {
 	    s++;
+	    last_uni = oldbufptr;
 	    switch (*s++) {
 	    case 'r': FTST(O_FTEREAD);
 	    case 'w': FTST(O_FTEWRITE);
@@ -2300,6 +2301,7 @@ int in_what;
 	    STR *tmpstr;
 	    STR *tmpstr2 = Nullstr;
 	    char *tmps;
+	    char *start;
 	    bool dorange = FALSE;
 
 	    CLINE;
@@ -2397,7 +2399,7 @@ int in_what;
 		}
 		s++;
 	    }
-	    s = d = tmpstr->str_ptr;	/* assuming shrinkage only */
+	    s = d = start = tmpstr->str_ptr;	/* assuming shrinkage only */
 	    while (s < send || dorange) {
 		if (in_what & SCAN_TR) {
 		    if (dorange) {
@@ -2415,10 +2417,11 @@ int in_what;
 			max = d[1] & 0377;
 			for (i = (*d & 0377); i <= max; i++)
 			    *d++ = i;
+			start = s;
 			dorange = FALSE;
 			continue;
 		    }
-		    else if (*s == '-' && s+1 < send  && d != tmpstr->str_ptr) {
+		    else if (*s == '-' && s+1 < send  && s != start) {
 			dorange = TRUE;
 			s++;
 		    }
diff --git a/toke.c.orig b/toke.c.orig
new file mode 100644
index 0000000000..8019756220
--- /dev/null
+++ b/toke.c.orig
@@ -0,0 +1,2754 @@
+/* $RCSfile: toke.c,v $$Revision: 4.0.1.8 $$Date: 92/06/23 12:33:45 $
+ *
+ *    Copyright (c) 1991, 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:	toke.c,v $
+ * Revision 4.0.1.8  92/06/23  12:33:45  lwall
+ * patch35: bad interaction between backslash and hyphen in tr///
+ * 
+ * Revision 4.0.1.7  92/06/11  21:16:30  lwall
+ * patch34: expectterm incorrectly set to indicate start of program or block
+ * 
+ * Revision 4.0.1.6  92/06/08  16:03:49  lwall
+ * patch20: an EXPR may now start with a bareword
+ * patch20: print $fh EXPR can now expect term rather than operator in EXPR
+ * patch20: added ... as variant on ..
+ * patch20: new warning on spurious backslash
+ * patch20: new warning on missing $ for foreach variable
+ * patch20: "foo"x1024 now legal without space after x
+ * patch20: new warning on print accidentally used as function
+ * patch20: tr/stuff// wasn't working right
+ * patch20: 2. now eats the dot
+ * patch20: <@ARGV> now notices @ARGV
+ * patch20: tr/// now lets you say \-
+ * 
+ * Revision 4.0.1.5  91/11/11  16:45:51  lwall
+ * patch19: default arg for shift was wrong after first subroutine definition
+ * 
+ * Revision 4.0.1.4  91/11/05  19:02:48  lwall
+ * patch11: \x and \c were subject to double interpretation in regexps
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: nested list operators could miscount parens
+ * patch11: once-thru blocks didn't display right in the debugger
+ * patch11: sort eval "whatever" didn't work
+ * patch11: underscore is now allowed within literal octal and hex numbers
+ * 
+ * Revision 4.0.1.3  91/06/10  01:32:26  lwall
+ * patch10: m'$foo' now treats string as single quoted
+ * patch10: certain pattern optimizations were botched
+ * 
+ * Revision 4.0.1.2  91/06/07  12:05:56  lwall
+ * patch4: new copyright notice
+ * patch4: debugger lost track of lines in eval
+ * patch4: //o and s///o now optimize themselves fully at runtime
+ * patch4: added global modifier for pattern matches
+ * 
+ * Revision 4.0.1.1  91/04/12  09:18:18  lwall
+ * patch1: perl -de "print" wouldn't stop at the first statement
+ * 
+ * Revision 4.0  91/03/20  01:42:14  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "perly.h"
+
+static void set_csh();
+
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
+#ifdef f_next
+#undef f_next
+#endif
+
+/* which backslash sequences to keep in m// or s// */
+
+static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}";
+
+char *reparse;		/* if non-null, scanident found ${foo[$bar]} */
+
+void checkcomma();
+
+#ifdef CLINE
+#undef CLINE
+#endif
+#define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_line : cmdline))
+
+#ifdef atarist
+#define PERL_META(c) ((c) | 128)
+#else
+#define META(c) ((c) | 128)
+#endif
+
+#define RETURN(retval) return (bufptr = s,(int)retval)
+#define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
+#define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
+#define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
+#define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
+#define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
+#define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
+#define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
+#define FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x)
+#define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
+#define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4)
+#define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5)
+#define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
+#define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
+#define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
+#define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
+#define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
+#define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
+#define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
+#define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
+#define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
+#define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
+#define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
+#define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
+#define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
+#define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
+#define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
+
+static char *last_uni;
+
+/* This bit of chicanery makes a unary function followed by
+ * a parenthesis into a function with one argument, highest precedence.
+ */
+#define UNI(f) return(yylval.ival = f, \
+	expectterm = TRUE, \
+	bufptr = s, \
+	last_uni = oldbufptr, \
+	(*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
+
+/* This does similarly for list operators, merely by pretending that the
+ * paren came before the listop rather than after.
+ */
+#ifdef atarist
+#define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
+	(*s = (char) PERL_META('('), bufptr = oldbufptr, '(') : \
+	(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
+#else
+#define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
+	(*s = (char) META('('), bufptr = oldbufptr, '(') : \
+	(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
+#endif
+/* grandfather return to old style */
+#define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
+
+char *
+skipspace(s)
+register char *s;
+{
+    while (s < bufend && isSPACE(*s))
+	s++;
+    return s;
+}
+
+void
+check_uni() {
+    char *s;
+    char ch;
+
+    if (oldoldbufptr != last_uni)
+	return;
+    while (isSPACE(*last_uni))
+	last_uni++;
+    for (s = last_uni; isALNUM(*s); s++) ;
+    ch = *s;
+    *s = '\0';
+    warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
+    *s = ch;
+}
+
+#ifdef CRIPPLED_CC
+
+#undef UNI
+#undef LOP
+#define UNI(f) return uni(f,s)
+#define LOP(f) return lop(f,s)
+
+int
+uni(f,s)
+int f;
+char *s;
+{
+    yylval.ival = f;
+    expectterm = TRUE;
+    bufptr = s;
+    last_uni = oldbufptr;
+    if (*s == '(')
+	return FUNC1;
+    s = skipspace(s);
+    if (*s == '(')
+	return FUNC1;
+    else
+	return UNIOP;
+}
+
+int
+lop(f,s)
+int f;
+char *s;
+{
+    CLINE;
+    if (*s != '(')
+	s = skipspace(s);
+    if (*s == '(') {
+#ifdef atarist
+	*s = PERL_META('(');
+#else
+	*s = META('(');
+#endif
+	bufptr = oldbufptr;
+	return '(';
+    }
+    else {
+	yylval.ival=f;
+	expectterm = TRUE;
+	bufptr = s;
+	return LISTOP;
+    }
+}
+
+#endif /* CRIPPLED_CC */
+
+int
+yylex()
+{
+    register char *s = bufptr;
+    register char *d;
+    register int tmp;
+    static bool in_format = FALSE;
+    static bool firstline = TRUE;
+    extern int yychar;		/* last token */
+
+    oldoldbufptr = oldbufptr;
+    oldbufptr = s;
+
+  retry:
+#ifdef YYDEBUG
+    if (debug & 1)
+	if (index(s,'\n'))
+	    fprintf(stderr,"Tokener at %s",s);
+	else
+	    fprintf(stderr,"Tokener at %s\n",s);
+#endif
+#ifdef BADSWITCH
+    if (*s & 128) {
+	if ((*s & 127) == '(') {
+	    *s++ = '(';
+	    oldbufptr = s;
+	}
+	else if ((*s & 127) == '}') {
+	    *s++ = '}';
+	    RETURN('}');
+	}
+	else
+	    warn("Unrecognized character \\%03o ignored", *s++ & 255);
+	goto retry;
+    }
+#endif
+    switch (*s) {
+    default:
+	if ((*s & 127) == '(') {
+	    *s++ = '(';
+	    oldbufptr = s;
+	}
+	else if ((*s & 127) == '}') {
+	    *s++ = '}';
+	    RETURN('}');
+	}
+	else
+	    warn("Unrecognized character \\%03o ignored", *s++ & 255);
+	goto retry;
+    case 4:
+    case 26:
+	goto fake_eof;			/* emulate EOF on ^D or ^Z */
+    case 0:
+	if (!rsfp)
+	    RETURN(0);
+	if (s++ < bufend)
+	    goto retry;			/* ignore stray nulls */
+	last_uni = 0;
+	if (firstline) {
+	    firstline = FALSE;
+	    if (minus_n || minus_p || perldb) {
+		str_set(linestr,"");
+		if (perldb) {
+		    char *getenv();
+		    char *pdb = getenv("PERLDB");
+
+		    str_cat(linestr, pdb ? pdb : "require 'perldb.pl'");
+		    str_cat(linestr, ";");
+		}
+		if (minus_n || minus_p) {
+		    str_cat(linestr,"line: while (<>) {");
+		    if (minus_l)
+			str_cat(linestr,"chop;");
+		    if (minus_a)
+			str_cat(linestr,"@F=split(' ');");
+		}
+		oldoldbufptr = oldbufptr = s = str_get(linestr);
+		bufend = linestr->str_ptr + linestr->str_cur;
+		goto retry;
+	    }
+	}
+	if (in_format) {
+	    bufptr = bufend;
+	    yylval.formval = load_format();
+	    in_format = FALSE;
+	    oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
+	    bufend = linestr->str_ptr + linestr->str_cur;
+	    OPERATOR(FORMLIST);
+	}
+	curcmd->c_line++;
+#ifdef CRYPTSCRIPT
+	cryptswitch();
+#endif /* CRYPTSCRIPT */
+	do {
+	    if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
+	      fake_eof:
+		if (rsfp) {
+		    if (preprocess)
+			(void)mypclose(rsfp);
+		    else if ((FILE*)rsfp == stdin)
+			clearerr(stdin);
+		    else
+			(void)fclose(rsfp);
+		    rsfp = Nullfp;
+		}
+		if (minus_n || minus_p) {
+		    str_set(linestr,minus_p ? ";}continue{print" : "");
+		    str_cat(linestr,";}");
+		    oldoldbufptr = oldbufptr = s = str_get(linestr);
+		    bufend = linestr->str_ptr + linestr->str_cur;
+		    minus_n = minus_p = 0;
+		    goto retry;
+		}
+		oldoldbufptr = oldbufptr = s = str_get(linestr);
+		str_set(linestr,"");
+		RETURN(';');	/* not infinite loop because rsfp is NULL now */
+	    }
+	    if (doextract && *linestr->str_ptr == '#')
+		doextract = FALSE;
+	} while (doextract);
+	oldoldbufptr = oldbufptr = bufptr = s;
+	if (perldb) {
+	    STR *str = Str_new(85,0);
+
+	    str_sset(str,linestr);
+	    astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
+	}
+#ifdef DEBUG
+	if (firstline) {
+	    char *showinput();
+	    s = showinput();
+	}
+#endif
+	bufend = linestr->str_ptr + linestr->str_cur;
+	if (curcmd->c_line == 1) {
+	    if (*s == '#' && s[1] == '!') {
+		if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
+		    char **newargv;
+		    char *cmd;
+
+		    s += 2;
+		    if (*s == ' ')
+			s++;
+		    cmd = s;
+		    while (s < bufend && !isSPACE(*s))
+			s++;
+		    *s++ = '\0';
+		    while (s < bufend && isSPACE(*s))
+			s++;
+		    if (s < bufend) {
+			Newz(899,newargv,origargc+3,char*);
+			newargv[1] = s;
+			while (s < bufend && !isSPACE(*s))
+			    s++;
+			*s = '\0';
+			Copy(origargv+1, newargv+2, origargc+1, char*);
+		    }
+		    else
+			newargv = origargv;
+		    newargv[0] = cmd;
+		    execv(cmd,newargv);
+		    fatal("Can't exec %s", cmd);
+		}
+	    }
+	    else {
+		while (s < bufend && isSPACE(*s))
+		    s++;
+		if (*s == ':')	/* for csh's that have to exec sh scripts */
+		    s++;
+	    }
+	}
+	goto retry;
+    case ' ': case '\t': case '\f': case '\r': case 013:
+	s++;
+	goto retry;
+    case '#':
+	if (preprocess && s == str_get(linestr) &&
+	       s[1] == ' ' && (isDIGIT(s[2]) || strnEQ(s+2,"line ",5)) ) {
+	    while (*s && !isDIGIT(*s))
+		s++;
+	    curcmd->c_line = atoi(s)-1;
+	    while (isDIGIT(*s))
+		s++;
+	    d = bufend;
+	    while (s < d && isSPACE(*s)) s++;
+	    s[strlen(s)-1] = '\0';	/* wipe out newline */
+	    if (*s == '"') {
+		s++;
+		s[strlen(s)-1] = '\0';	/* wipe out trailing quote */
+	    }
+	    if (*s)
+		curcmd->c_filestab = fstab(s);
+	    else
+		curcmd->c_filestab = fstab(origfilename);
+	    oldoldbufptr = oldbufptr = s = str_get(linestr);
+	}
+	/* FALL THROUGH */
+    case '\n':
+	if (in_eval && !rsfp) {
+	    d = bufend;
+	    while (s < d && *s != '\n')
+		s++;
+	    if (s < d)
+		s++;
+	    if (in_format) {
+		bufptr = s;
+		yylval.formval = load_format();
+		in_format = FALSE;
+		oldoldbufptr = oldbufptr = s = bufptr + 1;
+		TERM(FORMLIST);
+	    }
+	    curcmd->c_line++;
+	}
+	else {
+	    *s = '\0';
+	    bufend = s;
+	}
+	goto retry;
+    case '-':
+	if (s[1] && isALPHA(s[1]) && !isALPHA(s[2])) {
+	    s++;
+	    switch (*s++) {
+	    case 'r': FTST(O_FTEREAD);
+	    case 'w': FTST(O_FTEWRITE);
+	    case 'x': FTST(O_FTEEXEC);
+	    case 'o': FTST(O_FTEOWNED);
+	    case 'R': FTST(O_FTRREAD);
+	    case 'W': FTST(O_FTRWRITE);
+	    case 'X': FTST(O_FTREXEC);
+	    case 'O': FTST(O_FTROWNED);
+	    case 'e': FTST(O_FTIS);
+	    case 'z': FTST(O_FTZERO);
+	    case 's': FTST(O_FTSIZE);
+	    case 'f': FTST(O_FTFILE);
+	    case 'd': FTST(O_FTDIR);
+	    case 'l': FTST(O_FTLINK);
+	    case 'p': FTST(O_FTPIPE);
+	    case 'S': FTST(O_FTSOCK);
+	    case 'u': FTST(O_FTSUID);
+	    case 'g': FTST(O_FTSGID);
+	    case 'k': FTST(O_FTSVTX);
+	    case 'b': FTST(O_FTBLK);
+	    case 'c': FTST(O_FTCHR);
+	    case 't': FTST(O_FTTTY);
+	    case 'T': FTST(O_FTTEXT);
+	    case 'B': FTST(O_FTBINARY);
+	    case 'M': stabent("\024",TRUE); FTST(O_FTMTIME);
+	    case 'A': stabent("\024",TRUE); FTST(O_FTATIME);
+	    case 'C': stabent("\024",TRUE); FTST(O_FTCTIME);
+	    default:
+		s -= 2;
+		break;
+	    }
+	}
+	tmp = *s++;
+	if (*s == tmp) {
+	    s++;
+	    RETURN(DEC);
+	}
+	if (expectterm) {
+	    if (isSPACE(*s) || !isSPACE(*bufptr))
+		check_uni();
+	    OPERATOR('-');
+	}
+	else
+	    AOP(O_SUBTRACT);
+    case '+':
+	tmp = *s++;
+	if (*s == tmp) {
+	    s++;
+	    RETURN(INC);
+	}
+	if (expectterm) {
+	    if (isSPACE(*s) || !isSPACE(*bufptr))
+		check_uni();
+	    OPERATOR('+');
+	}
+	else
+	    AOP(O_ADD);
+
+    case '*':
+	if (expectterm) {
+	    check_uni();
+	    s = scanident(s,bufend,tokenbuf);
+	    yylval.stabval = stabent(tokenbuf,TRUE);
+	    TERM(STAR);
+	}
+	tmp = *s++;
+	if (*s == tmp) {
+	    s++;
+	    OPERATOR(POW);
+	}
+	MOP(O_MULTIPLY);
+    case '%':
+	if (expectterm) {
+	    if (!isALPHA(s[1]))
+		check_uni();
+	    s = scanident(s,bufend,tokenbuf);
+	    yylval.stabval = hadd(stabent(tokenbuf,TRUE));
+	    TERM(HSH);
+	}
+	s++;
+	MOP(O_MODULO);
+
+    case '^':
+    case '~':
+    case '(':
+    case ',':
+    case ':':
+    case '[':
+	tmp = *s++;
+	OPERATOR(tmp);
+    case '{':
+	tmp = *s++;
+	yylval.ival = curcmd->c_line;
+	if (isSPACE(*s) || *s == '#')
+	    cmdline = NOLINE;   /* invalidate current command line number */
+	expectterm = 2;
+	RETURN(tmp);
+    case ';':
+	if (curcmd->c_line < cmdline)
+	    cmdline = curcmd->c_line;
+	tmp = *s++;
+	OPERATOR(tmp);
+    case ')':
+    case ']':
+	tmp = *s++;
+	TERM(tmp);
+    case '}':
+	*s |= 128;
+	RETURN(';');
+    case '&':
+	s++;
+	tmp = *s++;
+	if (tmp == '&')
+	    OPERATOR(ANDAND);
+	s--;
+	if (expectterm) {
+	    d = bufend;
+	    while (s < d && isSPACE(*s))
+		s++;
+	    if (isALPHA(*s) || *s == '_' || *s == '\'')
+		*(--s) = '\\';	/* force next ident to WORD */
+	    else
+		check_uni();
+	    OPERATOR(AMPER);
+	}
+	OPERATOR('&');
+    case '|':
+	s++;
+	tmp = *s++;
+	if (tmp == '|')
+	    OPERATOR(OROR);
+	s--;
+	OPERATOR('|');
+    case '=':
+	s++;
+	tmp = *s++;
+	if (tmp == '=')
+	    EOP(O_EQ);
+	if (tmp == '~')
+	    OPERATOR(MATCH);
+	s--;
+	OPERATOR('=');
+    case '!':
+	s++;
+	tmp = *s++;
+	if (tmp == '=')
+	    EOP(O_NE);
+	if (tmp == '~')
+	    OPERATOR(NMATCH);
+	s--;
+	OPERATOR('!');
+    case '<':
+	if (expectterm) {
+	    if (s[1] != '<' && !index(s,'>'))
+		check_uni();
+	    s = scanstr(s, SCAN_DEF);
+	    TERM(RSTRING);
+	}
+	s++;
+	tmp = *s++;
+	if (tmp == '<')
+	    OPERATOR(LS);
+	if (tmp == '=') {
+	    tmp = *s++;
+	    if (tmp == '>')
+		EOP(O_NCMP);
+	    s--;
+	    ROP(O_LE);
+	}
+	s--;
+	ROP(O_LT);
+    case '>':
+	s++;
+	tmp = *s++;
+	if (tmp == '>')
+	    OPERATOR(RS);
+	if (tmp == '=')
+	    ROP(O_GE);
+	s--;
+	ROP(O_GT);
+
+#define SNARFWORD \
+	d = tokenbuf; \
+	while (isALNUM(*s) || *s == '\'') \
+	    *d++ = *s++; \
+	while (d[-1] == '\'') \
+	    d--,s--; \
+	*d = '\0'; \
+	d = tokenbuf;
+
+    case '$':
+	if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) {
+	    s++;
+	    s = scanident(s,bufend,tokenbuf);
+	    yylval.stabval = aadd(stabent(tokenbuf,TRUE));
+	    TERM(ARYLEN);
+	}
+	d = s;
+	s = scanident(s,bufend,tokenbuf);
+	if (reparse) {		/* turn ${foo[bar]} into ($foo[bar]) */
+	  do_reparse:
+	    s[-1] = ')';
+	    s = d;
+	    s[1] = s[0];
+	    s[0] = '(';
+	    goto retry;
+	}
+	yylval.stabval = stabent(tokenbuf,TRUE);
+	expectterm = FALSE;
+	if (isSPACE(*s) && oldoldbufptr && oldoldbufptr < bufptr) {
+	    s++;
+	    while (isSPACE(*oldoldbufptr))
+		oldoldbufptr++;
+	    if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5)) {
+		if (index("&*<%", *s) && isALPHA(s[1]))
+		    expectterm = TRUE;		/* e.g. print $fh &sub */
+		else if (*s == '.' && isDIGIT(s[1]))
+		    expectterm = TRUE;		/* e.g. print $fh .3 */
+		else if (index("/?-+", *s) && !isSPACE(s[1]))
+		    expectterm = TRUE;		/* e.g. print $fh -1 */
+	    }
+	}
+	RETURN(REG);
+
+    case '@':
+	d = s;
+	s = scanident(s,bufend,tokenbuf);
+	if (reparse)
+	    goto do_reparse;
+	yylval.stabval = aadd(stabent(tokenbuf,TRUE));
+	TERM(ARY);
+
+    case '/':			/* may either be division or pattern */
+    case '?':			/* may either be conditional or pattern */
+	if (expectterm) {
+	    check_uni();
+	    s = scanpat(s);
+	    TERM(PATTERN);
+	}
+	tmp = *s++;
+	if (tmp == '/')
+	    MOP(O_DIVIDE);
+	OPERATOR(tmp);
+
+    case '.':
+	if (!expectterm || !isDIGIT(s[1])) {
+	    tmp = *s++;
+	    if (*s == tmp) {
+		s++;
+		if (*s == tmp) {
+		    s++;
+		    yylval.ival = 0;
+		}
+		else
+		    yylval.ival = AF_COMMON;
+		OPERATOR(DOTDOT);
+	    }
+	    if (expectterm)
+		check_uni();
+	    AOP(O_CONCAT);
+	}
+	/* FALL THROUGH */
+    case '0': case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9':
+    case '\'': case '"': case '`':
+	s = scanstr(s, SCAN_DEF);
+	TERM(RSTRING);
+
+    case '\\':	/* some magic to force next word to be a WORD */
+	s++;	/* used by do and sub to force a separate namespace */
+	if (!isALPHA(*s) && *s != '_' && *s != '\'') {
+	    warn("Spurious backslash ignored");
+	    goto retry;
+	}
+	/* FALL THROUGH */
+    case '_':
+	SNARFWORD;
+	if (d[1] == '_') {
+	    if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) {
+		ARG *arg = op_new(1);
+
+		yylval.arg = arg;
+		arg->arg_type = O_ITEM;
+		if (d[2] == 'L')
+		    (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line);
+		else
+		    strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr);
+		arg[1].arg_type = A_SINGLE;
+		arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
+		TERM(RSTRING);
+	    }
+	    else if (strEQ(d,"__END__")) {
+		STAB *stab;
+		int fd;
+
+		/*SUPPRESS 560*/
+		if (!in_eval && (stab = stabent("DATA",FALSE))) {
+		    stab->str_pok |= SP_MULTI;
+		    if (!stab_io(stab))
+			stab_io(stab) = stio_new();
+		    stab_io(stab)->ifp = rsfp;
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+		    fd = fileno(rsfp);
+		    fcntl(fd,F_SETFD,fd >= 3);
+#endif
+		    if (preprocess)
+			stab_io(stab)->type = '|';
+		    else if ((FILE*)rsfp == stdin)
+			stab_io(stab)->type = '-';
+		    else
+			stab_io(stab)->type = '<';
+		    rsfp = Nullfp;
+		}
+		goto fake_eof;
+	    }
+	}
+	break;
+    case 'a': case 'A':
+	SNARFWORD;
+	if (strEQ(d,"alarm"))
+	    UNI(O_ALARM);
+	if (strEQ(d,"accept"))
+	    FOP22(O_ACCEPT);
+	if (strEQ(d,"atan2"))
+	    FUN2(O_ATAN2);
+	break;
+    case 'b': case 'B':
+	SNARFWORD;
+	if (strEQ(d,"bind"))
+	    FOP2(O_BIND);
+	if (strEQ(d,"binmode"))
+	    FOP(O_BINMODE);
+	break;
+    case 'c': case 'C':
+	SNARFWORD;
+	if (strEQ(d,"chop"))
+	    LFUN(O_CHOP);
+	if (strEQ(d,"continue"))
+	    OPERATOR(CONTINUE);
+	if (strEQ(d,"chdir")) {
+	    (void)stabent("ENV",TRUE);	/* may use HOME */
+	    UNI(O_CHDIR);
+	}
+	if (strEQ(d,"close"))
+	    FOP(O_CLOSE);
+	if (strEQ(d,"closedir"))
+	    FOP(O_CLOSEDIR);
+	if (strEQ(d,"cmp"))
+	    EOP(O_SCMP);
+	if (strEQ(d,"caller"))
+	    UNI(O_CALLER);
+	if (strEQ(d,"crypt")) {
+#ifdef FCRYPT
+	    static int cryptseen = 0;
+
+	    if (!cryptseen++)
+		init_des();
+#endif
+	    FUN2(O_CRYPT);
+	}
+	if (strEQ(d,"chmod"))
+	    LOP(O_CHMOD);
+	if (strEQ(d,"chown"))
+	    LOP(O_CHOWN);
+	if (strEQ(d,"connect"))
+	    FOP2(O_CONNECT);
+	if (strEQ(d,"cos"))
+	    UNI(O_COS);
+	if (strEQ(d,"chroot"))
+	    UNI(O_CHROOT);
+	break;
+    case 'd': case 'D':
+	SNARFWORD;
+	if (strEQ(d,"do")) {
+	    d = bufend;
+	    while (s < d && isSPACE(*s))
+		s++;
+	    if (isALPHA(*s) || *s == '_')
+		*(--s) = '\\';	/* force next ident to WORD */
+	    OPERATOR(DO);
+	}
+	if (strEQ(d,"die"))
+	    LOP(O_DIE);
+	if (strEQ(d,"defined"))
+	    LFUN(O_DEFINED);
+	if (strEQ(d,"delete"))
+	    OPERATOR(DELETE);
+	if (strEQ(d,"dbmopen"))
+	    HFUN3(O_DBMOPEN);
+	if (strEQ(d,"dbmclose"))
+	    HFUN(O_DBMCLOSE);
+	if (strEQ(d,"dump"))
+	    LOOPX(O_DUMP);
+	break;
+    case 'e': case 'E':
+	SNARFWORD;
+	if (strEQ(d,"else"))
+	    OPERATOR(ELSE);
+	if (strEQ(d,"elsif")) {
+	    yylval.ival = curcmd->c_line;
+	    OPERATOR(ELSIF);
+	}
+	if (strEQ(d,"eq") || strEQ(d,"EQ"))
+	    EOP(O_SEQ);
+	if (strEQ(d,"exit"))
+	    UNI(O_EXIT);
+	if (strEQ(d,"eval")) {
+	    allstabs = TRUE;		/* must initialize everything since */
+	    UNI(O_EVAL);		/* we don't know what will be used */
+	}
+	if (strEQ(d,"eof"))
+	    FOP(O_EOF);
+	if (strEQ(d,"exp"))
+	    UNI(O_EXP);
+	if (strEQ(d,"each"))
+	    HFUN(O_EACH);
+	if (strEQ(d,"exec")) {
+	    set_csh();
+	    LOP(O_EXEC_OP);
+	}
+	if (strEQ(d,"endhostent"))
+	    FUN0(O_EHOSTENT);
+	if (strEQ(d,"endnetent"))
+	    FUN0(O_ENETENT);
+	if (strEQ(d,"endservent"))
+	    FUN0(O_ESERVENT);
+	if (strEQ(d,"endprotoent"))
+	    FUN0(O_EPROTOENT);
+	if (strEQ(d,"endpwent"))
+	    FUN0(O_EPWENT);
+	if (strEQ(d,"endgrent"))
+	    FUN0(O_EGRENT);
+	break;
+    case 'f': case 'F':
+	SNARFWORD;
+	if (strEQ(d,"for") || strEQ(d,"foreach")) {
+	    yylval.ival = curcmd->c_line;
+	    while (s < bufend && isSPACE(*s))
+		s++;
+	    if (isALPHA(*s))
+		fatal("Missing $ on loop variable");
+	    OPERATOR(FOR);
+	}
+	if (strEQ(d,"format")) {
+	    d = bufend;
+	    while (s < d && isSPACE(*s))
+		s++;
+	    if (isALPHA(*s) || *s == '_')
+		*(--s) = '\\';	/* force next ident to WORD */
+	    in_format = TRUE;
+	    allstabs = TRUE;		/* must initialize everything since */
+	    OPERATOR(FORMAT);		/* we don't know what will be used */
+	}
+	if (strEQ(d,"fork"))
+	    FUN0(O_FORK);
+	if (strEQ(d,"fcntl"))
+	    FOP3(O_FCNTL);
+	if (strEQ(d,"fileno"))
+	    FOP(O_FILENO);
+	if (strEQ(d,"flock"))
+	    FOP2(O_FLOCK);
+	break;
+    case 'g': case 'G':
+	SNARFWORD;
+	if (strEQ(d,"gt") || strEQ(d,"GT"))
+	    ROP(O_SGT);
+	if (strEQ(d,"ge") || strEQ(d,"GE"))
+	    ROP(O_SGE);
+	if (strEQ(d,"grep"))
+	    FL2(O_GREP);
+	if (strEQ(d,"goto"))
+	    LOOPX(O_GOTO);
+	if (strEQ(d,"gmtime"))
+	    UNI(O_GMTIME);
+	if (strEQ(d,"getc"))
+	    FOP(O_GETC);
+	if (strnEQ(d,"get",3)) {
+	    d += 3;
+	    if (*d == 'p') {
+		if (strEQ(d,"ppid"))
+		    FUN0(O_GETPPID);
+		if (strEQ(d,"pgrp"))
+		    UNI(O_GETPGRP);
+		if (strEQ(d,"priority"))
+		    FUN2(O_GETPRIORITY);
+		if (strEQ(d,"protobyname"))
+		    UNI(O_GPBYNAME);
+		if (strEQ(d,"protobynumber"))
+		    FUN1(O_GPBYNUMBER);
+		if (strEQ(d,"protoent"))
+		    FUN0(O_GPROTOENT);
+		if (strEQ(d,"pwent"))
+		    FUN0(O_GPWENT);
+		if (strEQ(d,"pwnam"))
+		    FUN1(O_GPWNAM);
+		if (strEQ(d,"pwuid"))
+		    FUN1(O_GPWUID);
+		if (strEQ(d,"peername"))
+		    FOP(O_GETPEERNAME);
+	    }
+	    else if (*d == 'h') {
+		if (strEQ(d,"hostbyname"))
+		    UNI(O_GHBYNAME);
+		if (strEQ(d,"hostbyaddr"))
+		    FUN2(O_GHBYADDR);
+		if (strEQ(d,"hostent"))
+		    FUN0(O_GHOSTENT);
+	    }
+	    else if (*d == 'n') {
+		if (strEQ(d,"netbyname"))
+		    UNI(O_GNBYNAME);
+		if (strEQ(d,"netbyaddr"))
+		    FUN2(O_GNBYADDR);
+		if (strEQ(d,"netent"))
+		    FUN0(O_GNETENT);
+	    }
+	    else if (*d == 's') {
+		if (strEQ(d,"servbyname"))
+		    FUN2(O_GSBYNAME);
+		if (strEQ(d,"servbyport"))
+		    FUN2(O_GSBYPORT);
+		if (strEQ(d,"servent"))
+		    FUN0(O_GSERVENT);
+		if (strEQ(d,"sockname"))
+		    FOP(O_GETSOCKNAME);
+		if (strEQ(d,"sockopt"))
+		    FOP3(O_GSOCKOPT);
+	    }
+	    else if (*d == 'g') {
+		if (strEQ(d,"grent"))
+		    FUN0(O_GGRENT);
+		if (strEQ(d,"grnam"))
+		    FUN1(O_GGRNAM);
+		if (strEQ(d,"grgid"))
+		    FUN1(O_GGRGID);
+	    }
+	    else if (*d == 'l') {
+		if (strEQ(d,"login"))
+		    FUN0(O_GETLOGIN);
+	    }
+	    d -= 3;
+	}
+	break;
+    case 'h': case 'H':
+	SNARFWORD;
+	if (strEQ(d,"hex"))
+	    UNI(O_HEX);
+	break;
+    case 'i': case 'I':
+	SNARFWORD;
+	if (strEQ(d,"if")) {
+	    yylval.ival = curcmd->c_line;
+	    OPERATOR(IF);
+	}
+	if (strEQ(d,"index"))
+	    FUN2x(O_INDEX);
+	if (strEQ(d,"int"))
+	    UNI(O_INT);
+	if (strEQ(d,"ioctl"))
+	    FOP3(O_IOCTL);
+	break;
+    case 'j': case 'J':
+	SNARFWORD;
+	if (strEQ(d,"join"))
+	    FL2(O_JOIN);
+	break;
+    case 'k': case 'K':
+	SNARFWORD;
+	if (strEQ(d,"keys"))
+	    HFUN(O_KEYS);
+	if (strEQ(d,"kill"))
+	    LOP(O_KILL);
+	break;
+    case 'l': case 'L':
+	SNARFWORD;
+	if (strEQ(d,"last"))
+	    LOOPX(O_LAST);
+	if (strEQ(d,"local"))
+	    OPERATOR(LOCAL);
+	if (strEQ(d,"length"))
+	    UNI(O_LENGTH);
+	if (strEQ(d,"lt") || strEQ(d,"LT"))
+	    ROP(O_SLT);
+	if (strEQ(d,"le") || strEQ(d,"LE"))
+	    ROP(O_SLE);
+	if (strEQ(d,"localtime"))
+	    UNI(O_LOCALTIME);
+	if (strEQ(d,"log"))
+	    UNI(O_LOG);
+	if (strEQ(d,"link"))
+	    FUN2(O_LINK);
+	if (strEQ(d,"listen"))
+	    FOP2(O_LISTEN);
+	if (strEQ(d,"lstat"))
+	    FOP(O_LSTAT);
+	break;
+    case 'm': case 'M':
+	if (s[1] == '\'') {
+	    d = "m";
+	    s++;
+	}
+	else {
+	    SNARFWORD;
+	}
+	if (strEQ(d,"m")) {
+	    s = scanpat(s-1);
+	    if (yylval.arg)
+		TERM(PATTERN);
+	    else
+		RETURN(1);	/* force error */
+	}
+	switch (d[1]) {
+	case 'k':
+	    if (strEQ(d,"mkdir"))
+		FUN2(O_MKDIR);
+	    break;
+	case 's':
+	    if (strEQ(d,"msgctl"))
+		FUN3(O_MSGCTL);
+	    if (strEQ(d,"msgget"))
+		FUN2(O_MSGGET);
+	    if (strEQ(d,"msgrcv"))
+		FUN5(O_MSGRCV);
+	    if (strEQ(d,"msgsnd"))
+		FUN3(O_MSGSND);
+	    break;
+	}
+	break;
+    case 'n': case 'N':
+	SNARFWORD;
+	if (strEQ(d,"next"))
+	    LOOPX(O_NEXT);
+	if (strEQ(d,"ne") || strEQ(d,"NE"))
+	    EOP(O_SNE);
+	break;
+    case 'o': case 'O':
+	SNARFWORD;
+	if (strEQ(d,"open"))
+	    OPERATOR(OPEN);
+	if (strEQ(d,"ord"))
+	    UNI(O_ORD);
+	if (strEQ(d,"oct"))
+	    UNI(O_OCT);
+	if (strEQ(d,"opendir"))
+	    FOP2(O_OPEN_DIR);
+	break;
+    case 'p': case 'P':
+	SNARFWORD;
+	if (strEQ(d,"print")) {
+	    checkcomma(s,d,"filehandle");
+	    LOP(O_PRINT);
+	}
+	if (strEQ(d,"printf")) {
+	    checkcomma(s,d,"filehandle");
+	    LOP(O_PRTF);
+	}
+	if (strEQ(d,"push")) {
+	    yylval.ival = O_PUSH;
+	    OPERATOR(PUSH);
+	}
+	if (strEQ(d,"pop"))
+	    OPERATOR(POP);
+	if (strEQ(d,"pack"))
+	    FL2(O_PACK);
+	if (strEQ(d,"package"))
+	    OPERATOR(PACKAGE);
+	if (strEQ(d,"pipe"))
+	    FOP22(O_PIPE_OP);
+	break;
+    case 'q': case 'Q':
+	SNARFWORD;
+	if (strEQ(d,"q")) {
+	    s = scanstr(s-1, SCAN_DEF);
+	    TERM(RSTRING);
+	}
+	if (strEQ(d,"qq")) {
+	    s = scanstr(s-2, SCAN_DEF);
+	    TERM(RSTRING);
+	}
+	if (strEQ(d,"qx")) {
+	    s = scanstr(s-2, SCAN_DEF);
+	    TERM(RSTRING);
+	}
+	break;
+    case 'r': case 'R':
+	SNARFWORD;
+	if (strEQ(d,"return"))
+	    OLDLOP(O_RETURN);
+	if (strEQ(d,"require")) {
+	    allstabs = TRUE;		/* must initialize everything since */
+	    UNI(O_REQUIRE);		/* we don't know what will be used */
+	}
+	if (strEQ(d,"reset"))
+	    UNI(O_RESET);
+	if (strEQ(d,"redo"))
+	    LOOPX(O_REDO);
+	if (strEQ(d,"rename"))
+	    FUN2(O_RENAME);
+	if (strEQ(d,"rand"))
+	    UNI(O_RAND);
+	if (strEQ(d,"rmdir"))
+	    UNI(O_RMDIR);
+	if (strEQ(d,"rindex"))
+	    FUN2x(O_RINDEX);
+	if (strEQ(d,"read"))
+	    FOP3(O_READ);
+	if (strEQ(d,"readdir"))
+	    FOP(O_READDIR);
+	if (strEQ(d,"rewinddir"))
+	    FOP(O_REWINDDIR);
+	if (strEQ(d,"recv"))
+	    FOP4(O_RECV);
+	if (strEQ(d,"reverse"))
+	    LOP(O_REVERSE);
+	if (strEQ(d,"readlink"))
+	    UNI(O_READLINK);
+	break;
+    case 's': case 'S':
+	if (s[1] == '\'') {
+	    d = "s";
+	    s++;
+	}
+	else {
+	    SNARFWORD;
+	}
+	if (strEQ(d,"s")) {
+	    s = scansubst(s);
+	    if (yylval.arg)
+		TERM(SUBST);
+	    else
+		RETURN(1);	/* force error */
+	}
+	switch (d[1]) {
+	case 'a':
+	case 'b':
+	    break;
+	case 'c':
+	    if (strEQ(d,"scalar"))
+		UNI(O_SCALAR);
+	    break;
+	case 'd':
+	    break;
+	case 'e':
+	    if (strEQ(d,"select"))
+		OPERATOR(SSELECT);
+	    if (strEQ(d,"seek"))
+		FOP3(O_SEEK);
+	    if (strEQ(d,"semctl"))
+		FUN4(O_SEMCTL);
+	    if (strEQ(d,"semget"))
+		FUN3(O_SEMGET);
+	    if (strEQ(d,"semop"))
+		FUN2(O_SEMOP);
+	    if (strEQ(d,"send"))
+		FOP3(O_SEND);
+	    if (strEQ(d,"setpgrp"))
+		FUN2(O_SETPGRP);
+	    if (strEQ(d,"setpriority"))
+		FUN3(O_SETPRIORITY);
+	    if (strEQ(d,"sethostent"))
+		FUN1(O_SHOSTENT);
+	    if (strEQ(d,"setnetent"))
+		FUN1(O_SNETENT);
+	    if (strEQ(d,"setservent"))
+		FUN1(O_SSERVENT);
+	    if (strEQ(d,"setprotoent"))
+		FUN1(O_SPROTOENT);
+	    if (strEQ(d,"setpwent"))
+		FUN0(O_SPWENT);
+	    if (strEQ(d,"setgrent"))
+		FUN0(O_SGRENT);
+	    if (strEQ(d,"seekdir"))
+		FOP2(O_SEEKDIR);
+	    if (strEQ(d,"setsockopt"))
+		FOP4(O_SSOCKOPT);
+	    break;
+	case 'f':
+	case 'g':
+	    break;
+	case 'h':
+	    if (strEQ(d,"shift"))
+		TERM(SHIFT);
+	    if (strEQ(d,"shmctl"))
+		FUN3(O_SHMCTL);
+	    if (strEQ(d,"shmget"))
+		FUN3(O_SHMGET);
+	    if (strEQ(d,"shmread"))
+		FUN4(O_SHMREAD);
+	    if (strEQ(d,"shmwrite"))
+		FUN4(O_SHMWRITE);
+	    if (strEQ(d,"shutdown"))
+		FOP2(O_SHUTDOWN);
+	    break;
+	case 'i':
+	    if (strEQ(d,"sin"))
+		UNI(O_SIN);
+	    break;
+	case 'j':
+	case 'k':
+	    break;
+	case 'l':
+	    if (strEQ(d,"sleep"))
+		UNI(O_SLEEP);
+	    break;
+	case 'm':
+	case 'n':
+	    break;
+	case 'o':
+	    if (strEQ(d,"socket"))
+		FOP4(O_SOCKET);
+	    if (strEQ(d,"socketpair"))
+		FOP25(O_SOCKPAIR);
+	    if (strEQ(d,"sort")) {
+		checkcomma(s,d,"subroutine name");
+		d = bufend;
+		while (s < d && isSPACE(*s)) s++;
+		if (*s == ';' || *s == ')')		/* probably a close */
+		    fatal("sort is now a reserved word");
+		if (isALPHA(*s) || *s == '_') {
+		    /*SUPPRESS 530*/
+		    for (d = s; isALNUM(*d); d++) ;
+		    strncpy(tokenbuf,s,d-s);
+		    tokenbuf[d-s] = '\0';
+		    if (strNE(tokenbuf,"keys") &&
+			strNE(tokenbuf,"values") &&
+			strNE(tokenbuf,"split") &&
+			strNE(tokenbuf,"grep") &&
+			strNE(tokenbuf,"readdir") &&
+			strNE(tokenbuf,"unpack") &&
+			strNE(tokenbuf,"do") &&
+			strNE(tokenbuf,"eval") &&
+			(d >= bufend || isSPACE(*d)) )
+			*(--s) = '\\';	/* force next ident to WORD */
+		}
+		LOP(O_SORT);
+	    }
+	    break;
+	case 'p':
+	    if (strEQ(d,"split"))
+		TERM(SPLIT);
+	    if (strEQ(d,"sprintf"))
+		FL(O_SPRINTF);
+	    if (strEQ(d,"splice")) {
+		yylval.ival = O_SPLICE;
+		OPERATOR(PUSH);
+	    }
+	    break;
+	case 'q':
+	    if (strEQ(d,"sqrt"))
+		UNI(O_SQRT);
+	    break;
+	case 'r':
+	    if (strEQ(d,"srand"))
+		UNI(O_SRAND);
+	    break;
+	case 's':
+	    break;
+	case 't':
+	    if (strEQ(d,"stat"))
+		FOP(O_STAT);
+	    if (strEQ(d,"study")) {
+		sawstudy++;
+		LFUN(O_STUDY);
+	    }
+	    break;
+	case 'u':
+	    if (strEQ(d,"substr"))
+		FUN2x(O_SUBSTR);
+	    if (strEQ(d,"sub")) {
+		yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
+		savelong(&subline);
+		saveitem(subname);
+
+		subline = curcmd->c_line;
+		d = bufend;
+		while (s < d && isSPACE(*s))
+		    s++;
+		if (isALPHA(*s) || *s == '_' || *s == '\'') {
+		    str_sset(subname,curstname);
+		    str_ncat(subname,"'",1);
+		    for (d = s+1; isALNUM(*d) || *d == '\''; d++)
+			/*SUPPRESS 530*/
+			;
+		    if (d[-1] == '\'')
+			d--;
+		    str_ncat(subname,s,d-s);
+		    *(--s) = '\\';	/* force next ident to WORD */
+		}
+		else
+		    str_set(subname,"?");
+		OPERATOR(SUB);
+	    }
+	    break;
+	case 'v':
+	case 'w':
+	case 'x':
+	    break;
+	case 'y':
+	    if (strEQ(d,"system")) {
+		set_csh();
+		LOP(O_SYSTEM);
+	    }
+	    if (strEQ(d,"symlink"))
+		FUN2(O_SYMLINK);
+	    if (strEQ(d,"syscall"))
+		LOP(O_SYSCALL);
+	    if (strEQ(d,"sysread"))
+		FOP3(O_SYSREAD);
+	    if (strEQ(d,"syswrite"))
+		FOP3(O_SYSWRITE);
+	    break;
+	case 'z':
+	    break;
+	}
+	break;
+    case 't': case 'T':
+	SNARFWORD;
+	if (strEQ(d,"tr")) {
+	    s = scantrans(s);
+	    if (yylval.arg)
+		TERM(TRANS);
+	    else
+		RETURN(1);	/* force error */
+	}
+	if (strEQ(d,"tell"))
+	    FOP(O_TELL);
+	if (strEQ(d,"telldir"))
+	    FOP(O_TELLDIR);
+	if (strEQ(d,"time"))
+	    FUN0(O_TIME);
+	if (strEQ(d,"times"))
+	    FUN0(O_TMS);
+	if (strEQ(d,"truncate"))
+	    FOP2(O_TRUNCATE);
+	break;
+    case 'u': case 'U':
+	SNARFWORD;
+	if (strEQ(d,"using"))
+	    OPERATOR(USING);
+	if (strEQ(d,"until")) {
+	    yylval.ival = curcmd->c_line;
+	    OPERATOR(UNTIL);
+	}
+	if (strEQ(d,"unless")) {
+	    yylval.ival = curcmd->c_line;
+	    OPERATOR(UNLESS);
+	}
+	if (strEQ(d,"unlink"))
+	    LOP(O_UNLINK);
+	if (strEQ(d,"undef"))
+	    LFUN(O_UNDEF);
+	if (strEQ(d,"unpack"))
+	    FUN2(O_UNPACK);
+	if (strEQ(d,"utime"))
+	    LOP(O_UTIME);
+	if (strEQ(d,"umask"))
+	    UNI(O_UMASK);
+	if (strEQ(d,"unshift")) {
+	    yylval.ival = O_UNSHIFT;
+	    OPERATOR(PUSH);
+	}
+	break;
+    case 'v': case 'V':
+	SNARFWORD;
+	if (strEQ(d,"values"))
+	    HFUN(O_VALUES);
+	if (strEQ(d,"vec")) {
+	    sawvec = TRUE;
+	    FUN3(O_VEC);
+	}
+	break;
+    case 'w': case 'W':
+	SNARFWORD;
+	if (strEQ(d,"while")) {
+	    yylval.ival = curcmd->c_line;
+	    OPERATOR(WHILE);
+	}
+	if (strEQ(d,"warn"))
+	    LOP(O_WARN);
+	if (strEQ(d,"wait"))
+	    FUN0(O_WAIT);
+	if (strEQ(d,"waitpid"))
+	    FUN2(O_WAITPID);
+	if (strEQ(d,"wantarray")) {
+	    yylval.arg = op_new(1);
+	    yylval.arg->arg_type = O_ITEM;
+	    yylval.arg[1].arg_type = A_WANTARRAY;
+	    TERM(RSTRING);
+	}
+	if (strEQ(d,"write"))
+	    FOP(O_WRITE);
+	break;
+    case 'x': case 'X':
+	if (*s == 'x' && isDIGIT(s[1]) && !expectterm) {
+	    s++;
+	    MOP(O_REPEAT);
+	}
+	SNARFWORD;
+	if (strEQ(d,"x")) {
+	    if (!expectterm)
+		MOP(O_REPEAT);
+	    check_uni();
+	}
+	break;
+    case 'y': case 'Y':
+	if (s[1] == '\'') {
+	    d = "y";
+	    s++;
+	}
+	else {
+	    SNARFWORD;
+	}
+	if (strEQ(d,"y")) {
+	    s = scantrans(s);
+	    TERM(TRANS);
+	}
+	break;
+    case 'z': case 'Z':
+	SNARFWORD;
+	break;
+    }
+    yylval.cval = savestr(d);
+    if (expectterm == 2) {		/* special case: start of statement */
+	while (isSPACE(*s)) s++;
+	if (*s == ':') {
+	    s++;
+	    CLINE;
+	    OPERATOR(LABEL);
+	}
+	TERM(WORD);
+    }
+    expectterm = FALSE;
+    if (oldoldbufptr && oldoldbufptr < bufptr) {
+	while (isSPACE(*oldoldbufptr))
+	    oldoldbufptr++;
+	if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
+	    expectterm = TRUE;
+	else if (*oldoldbufptr == 's' && strnEQ(oldoldbufptr,"sort",4))
+	    expectterm = TRUE;
+    }
+    return (CLINE, bufptr = s, (int)WORD);
+}
+
+void
+checkcomma(s,name,what)
+register char *s;
+char *name;
+char *what;
+{
+    char *w;
+
+    if (dowarn && *s == ' ' && s[1] == '(') {
+	w = index(s,')');
+	if (w)
+	    for (w++; *w && isSPACE(*w); w++) ;
+	if (!w || !*w || !index(";|}", *w))	/* an advisory hack only... */
+	    warn("%s (...) interpreted as function",name);
+    }
+    while (s < bufend && isSPACE(*s))
+	s++;
+    if (*s == '(')
+	s++;
+    while (s < bufend && isSPACE(*s))
+	s++;
+    if (isALPHA(*s) || *s == '_') {
+	w = s++;
+	while (isALNUM(*s))
+	    s++;
+	while (s < bufend && isSPACE(*s))
+	    s++;
+	if (*s == ',') {
+	    *s = '\0';
+	    w = instr(
+	      "tell eof times getlogin wait length shift umask getppid \
+	      cos exp int log rand sin sqrt ord wantarray",
+	      w);
+	    *s = ',';
+	    if (w)
+		return;
+	    fatal("No comma allowed after %s", what);
+	}
+    }
+}
+
+char *
+scanident(s,send,dest)
+register char *s;
+register char *send;
+char *dest;
+{
+    register char *d;
+    int brackets = 0;
+
+    reparse = Nullch;
+    s++;
+    d = dest;
+    if (isDIGIT(*s)) {
+	while (isDIGIT(*s))
+	    *d++ = *s++;
+    }
+    else {
+	while (isALNUM(*s) || *s == '\'')
+	    *d++ = *s++;
+    }
+    while (d > dest+1 && d[-1] == '\'')
+	d--,s--;
+    *d = '\0';
+    d = dest;
+    if (!*d) {
+	*d = *s++;
+	if (*d == '{' /* } */ ) {
+	    d = dest;
+	    brackets++;
+	    while (s < send && brackets) {
+		if (!reparse && (d == dest || (*s && isALNUM(*s) ))) {
+		    *d++ = *s++;
+		    continue;
+		}
+		else if (!reparse)
+		    reparse = s;
+		switch (*s++) {
+		/* { */
+		case '}':
+		    brackets--;
+		    if (reparse && reparse == s - 1)
+			reparse = Nullch;
+		    break;
+		case '{':   /* } */
+		    brackets++;
+		    break;
+		}
+	    }
+	    *d = '\0';
+	    d = dest;
+	}
+	else
+	    d[1] = '\0';
+    }
+    if (*d == '^' && (isUPPER(*s) || index("[\\]^_?", *s))) {
+#ifdef DEBUGGING
+	if (*s == 'D')
+	    debug |= 32768;
+#endif
+	*d = *s++ ^ 64;
+    }
+    return s;
+}
+
+void
+scanconst(spat,string,len)
+SPAT *spat;
+char *string;
+int len;
+{
+    register STR *tmpstr;
+    register char *t;
+    register char *d;
+    register char *e;
+    char *origstring = string;
+    static char *vert = "|";
+
+    if (ninstr(string, string+len, vert, vert+1))
+	return;
+    if (*string == '^')
+	string++, len--;
+    tmpstr = Str_new(86,len);
+    str_nset(tmpstr,string,len);
+    t = str_get(tmpstr);
+    e = t + len;
+    tmpstr->str_u.str_useful = 100;
+    for (d=t; d < e; ) {
+	switch (*d) {
+	case '{':
+	    if (isDIGIT(d[1]))
+		e = d;
+	    else
+		goto defchar;
+	    break;
+	case '.': case '[': case '$': case '(': case ')': case '|': case '+':
+	case '^':
+	    e = d;
+	    break;
+	case '\\':
+	    if (d[1] && index("wWbB0123456789sSdDlLuUExc",d[1])) {
+		e = d;
+		break;
+	    }
+	    Move(d+1,d,e-d,char);
+	    e--;
+	    switch(*d) {
+	    case 'n':
+		*d = '\n';
+		break;
+	    case 't':
+		*d = '\t';
+		break;
+	    case 'f':
+		*d = '\f';
+		break;
+	    case 'r':
+		*d = '\r';
+		break;
+	    case 'e':
+		*d = '\033';
+		break;
+	    case 'a':
+		*d = '\007';
+		break;
+	    }
+	    /* FALL THROUGH */
+	default:
+	  defchar:
+	    if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
+		e = d;
+		break;
+	    }
+	    d++;
+	}
+    }
+    if (d == t) {
+	str_free(tmpstr);
+	return;
+    }
+    *d = '\0';
+    tmpstr->str_cur = d - t;
+    if (d == t+len)
+	spat->spat_flags |= SPAT_ALL;
+    if (*origstring != '^')
+	spat->spat_flags |= SPAT_SCANFIRST;
+    spat->spat_short = tmpstr;
+    spat->spat_slen = d - t;
+}
+
+char *
+scanpat(s)
+register char *s;
+{
+    register SPAT *spat;
+    register char *d;
+    register char *e;
+    int len;
+    SPAT savespat;
+    STR *str = Str_new(93,0);
+    char delim;
+
+    Newz(801,spat,1,SPAT);
+    spat->spat_next = curstash->tbl_spatroot;	/* link into spat list */
+    curstash->tbl_spatroot = spat;
+
+    switch (*s++) {
+    case 'm':
+	s++;
+	break;
+    case '/':
+	break;
+    case '?':
+	spat->spat_flags |= SPAT_ONCE;
+	break;
+    default:
+	fatal("panic: scanpat");
+    }
+    s = str_append_till(str,s,bufend,s[-1],patleave);
+    if (s >= bufend) {
+	str_free(str);
+	yyerror("Search pattern not terminated");
+	yylval.arg = Nullarg;
+	return s;
+    }
+    delim = *s++;
+    while (*s == 'i' || *s == 'o' || *s == 'g') {
+	if (*s == 'i') {
+	    s++;
+	    sawi = TRUE;
+	    spat->spat_flags |= SPAT_FOLD;
+	}
+	if (*s == 'o') {
+	    s++;
+	    spat->spat_flags |= SPAT_KEEP;
+	}
+	if (*s == 'g') {
+	    s++;
+	    spat->spat_flags |= SPAT_GLOBAL;
+	}
+    }
+    len = str->str_cur;
+    e = str->str_ptr + len;
+    if (delim == '\'')
+	d = e;
+    else
+	d = str->str_ptr;
+    for (; d < e; d++) {
+	if (*d == '\\')
+	    d++;
+	else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
+		 (*d == '@')) {
+	    register ARG *arg;
+
+	    spat->spat_runtime = arg = op_new(1);
+	    arg->arg_type = O_ITEM;
+	    arg[1].arg_type = A_DOUBLE;
+	    arg[1].arg_ptr.arg_str = str_smake(str);
+	    d = scanident(d,bufend,buf);
+	    (void)stabent(buf,TRUE);		/* make sure it's created */
+	    for (; d < e; d++) {
+		if (*d == '\\')
+		    d++;
+		else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') {
+		    d = scanident(d,bufend,buf);
+		    (void)stabent(buf,TRUE);
+		}
+		else if (*d == '@') {
+		    d = scanident(d,bufend,buf);
+		    if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
+		      strEQ(buf,"SIG") || strEQ(buf,"INC"))
+			(void)stabent(buf,TRUE);
+		}
+	    }
+	    goto got_pat;		/* skip compiling for now */
+	}
+    }
+    if (spat->spat_flags & SPAT_FOLD)
+	StructCopy(spat, &savespat, SPAT);
+    scanconst(spat,str->str_ptr,len);
+    if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
+	fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
+	spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
+	    spat->spat_flags & SPAT_FOLD);
+		/* Note that this regexp can still be used if someone says
+		 * something like /a/ && s//b/;  so we can't delete it.
+		 */
+    }
+    else {
+	if (spat->spat_flags & SPAT_FOLD)
+	StructCopy(&savespat, spat, SPAT);
+	if (spat->spat_short)
+	    fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
+	spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
+	    spat->spat_flags & SPAT_FOLD);
+	hoistmust(spat);
+    }
+  got_pat:
+    str_free(str);
+    yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
+    return s;
+}
+
+char *
+scansubst(start)
+char *start;
+{
+    register char *s = start;
+    register SPAT *spat;
+    register char *d;
+    register char *e;
+    int len;
+    STR *str = Str_new(93,0);
+    char term = *s;
+
+    if (term && (d = index("([{< )]}> )]}>",term)))
+	term = d[5];
+
+    Newz(802,spat,1,SPAT);
+    spat->spat_next = curstash->tbl_spatroot;	/* link into spat list */
+    curstash->tbl_spatroot = spat;
+
+    s = str_append_till(str,s+1,bufend,term,patleave);
+    if (s >= bufend) {
+	str_free(str);
+	yyerror("Substitution pattern not terminated");
+	yylval.arg = Nullarg;
+	return s;
+    }
+    len = str->str_cur;
+    e = str->str_ptr + len;
+    for (d = str->str_ptr; d < e; d++) {
+	if (*d == '\\')
+	    d++;
+	else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') ||
+	    *d == '@' ) {
+	    register ARG *arg;
+
+	    spat->spat_runtime = arg = op_new(1);
+	    arg->arg_type = O_ITEM;
+	    arg[1].arg_type = A_DOUBLE;
+	    arg[1].arg_ptr.arg_str = str_smake(str);
+	    d = scanident(d,e,buf);
+	    (void)stabent(buf,TRUE);		/* make sure it's created */
+	    for (; *d; d++) {
+		if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
+		    d = scanident(d,e,buf);
+		    (void)stabent(buf,TRUE);
+		}
+		else if (*d == '@' && d[-1] != '\\') {
+		    d = scanident(d,e,buf);
+		    if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
+		      strEQ(buf,"SIG") || strEQ(buf,"INC"))
+			(void)stabent(buf,TRUE);
+		}
+	    }
+	    goto get_repl;		/* skip compiling for now */
+	}
+    }
+    scanconst(spat,str->str_ptr,len);
+get_repl:
+    if (term != *start)
+	s++;
+    s = scanstr(s, SCAN_REPL);
+    if (s >= bufend) {
+	str_free(str);
+	yyerror("Substitution replacement not terminated");
+	yylval.arg = Nullarg;
+	return s;
+    }
+    spat->spat_repl = yylval.arg;
+    if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
+	spat->spat_flags |= SPAT_CONST;
+    else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
+	STR *tmpstr;
+	register char *t;
+
+	spat->spat_flags |= SPAT_CONST;
+	tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
+	e = tmpstr->str_ptr + tmpstr->str_cur;
+	for (t = tmpstr->str_ptr; t < e; t++) {
+	    if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
+	      (t[1] == '{' /*}*/ && isDIGIT(t[2])) ))
+		spat->spat_flags &= ~SPAT_CONST;
+	}
+    }
+    while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
+	int es = 0;
+
+	if (*s == 'e') {
+	    s++;
+	    es++;
+	    if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
+		spat->spat_repl[1].arg_type = A_SINGLE;
+	    spat->spat_repl = make_op(
+		(!es && spat->spat_repl[1].arg_type == A_SINGLE
+			? O_EVALONCE
+			: O_EVAL),
+		2,
+		spat->spat_repl,
+		Nullarg,
+		Nullarg);
+	    spat->spat_flags &= ~SPAT_CONST;
+	}
+	if (*s == 'g') {
+	    s++;
+	    spat->spat_flags |= SPAT_GLOBAL;
+	}
+	if (*s == 'i') {
+	    s++;
+	    sawi = TRUE;
+	    spat->spat_flags |= SPAT_FOLD;
+	    if (!(spat->spat_flags & SPAT_SCANFIRST)) {
+		str_free(spat->spat_short);	/* anchored opt doesn't do */
+		spat->spat_short = Nullstr;	/* case insensitive match */
+		spat->spat_slen = 0;
+	    }
+	}
+	if (*s == 'o') {
+	    s++;
+	    spat->spat_flags |= SPAT_KEEP;
+	}
+    }
+    if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
+	fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
+    if (!spat->spat_runtime) {
+	spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
+	  spat->spat_flags & SPAT_FOLD);
+	hoistmust(spat);
+    }
+    yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
+    str_free(str);
+    return s;
+}
+
+void
+hoistmust(spat)
+register SPAT *spat;
+{
+    if (!spat->spat_short && spat->spat_regexp->regstart &&
+	(!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH)
+       ) {
+	if (!(spat->spat_regexp->reganch & ROPT_ANCH))
+	    spat->spat_flags |= SPAT_SCANFIRST;
+	else if (spat->spat_flags & SPAT_FOLD)
+	    return;
+	spat->spat_short = str_smake(spat->spat_regexp->regstart);
+    }
+    else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */
+	if (spat->spat_short &&
+	  str_eq(spat->spat_short,spat->spat_regexp->regmust))
+	{
+	    if (spat->spat_flags & SPAT_SCANFIRST) {
+		str_free(spat->spat_short);
+		spat->spat_short = Nullstr;
+	    }
+	    else {
+		str_free(spat->spat_regexp->regmust);
+		spat->spat_regexp->regmust = Nullstr;
+		return;
+	    }
+	}
+	if (!spat->spat_short ||	/* promote the better string */
+	  ((spat->spat_flags & SPAT_SCANFIRST) &&
+	   (spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
+	    str_free(spat->spat_short);		/* ok if null */
+	    spat->spat_short = spat->spat_regexp->regmust;
+	    spat->spat_regexp->regmust = Nullstr;
+	    spat->spat_flags |= SPAT_SCANFIRST;
+	}
+    }
+}
+
+char *
+scantrans(start)
+char *start;
+{
+    register char *s = start;
+    ARG *arg =
+	l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
+    STR *tstr;
+    STR *rstr;
+    register char *t;
+    register char *r;
+    register short *tbl;
+    register int i;
+    register int j;
+    int tlen, rlen;
+    int squash;
+    int delete;
+    int complement;
+
+    New(803,tbl,256,short);
+    arg[2].arg_type = A_NULL;
+    arg[2].arg_ptr.arg_cval = (char*) tbl;
+
+    s = scanstr(s, SCAN_TR);
+    if (s >= bufend) {
+	yyerror("Translation pattern not terminated");
+	yylval.arg = Nullarg;
+	return s;
+    }
+    tstr = yylval.arg[1].arg_ptr.arg_str; 
+    yylval.arg[1].arg_ptr.arg_str = Nullstr; 
+    arg_free(yylval.arg);
+    t = tstr->str_ptr;
+    tlen = tstr->str_cur;
+
+    if (s[-1] == *start)
+	s--;
+
+    s = scanstr(s, SCAN_TR|SCAN_REPL);
+    if (s >= bufend) {
+	yyerror("Translation replacement not terminated");
+	yylval.arg = Nullarg;
+	return s;
+    }
+    rstr = yylval.arg[1].arg_ptr.arg_str; 
+    yylval.arg[1].arg_ptr.arg_str = Nullstr; 
+    arg_free(yylval.arg);
+    r = rstr->str_ptr;
+    rlen = rstr->str_cur;
+
+    complement = delete = squash = 0;
+    while (*s == 'c' || *s == 'd' || *s == 's') {
+	if (*s == 'c')
+	    complement = 1;
+	else if (*s == 'd')
+	    delete = 2;
+	else
+	    squash = 1;
+	s++;
+    }
+    arg[2].arg_len = delete|squash;
+    yylval.arg = arg;
+    if (complement) {
+	Zero(tbl, 256, short);
+	for (i = 0; i < tlen; i++)
+	    tbl[t[i] & 0377] = -1;
+	for (i = 0, j = 0; i < 256; i++) {
+	    if (!tbl[i]) {
+		if (j >= rlen) {
+		    if (delete)
+			tbl[i] = -2;
+		    else if (rlen)
+			tbl[i] = r[j-1] & 0377;
+		    else
+			tbl[i] = i;
+		}
+		else
+		    tbl[i] = r[j++] & 0377;
+	    }
+	}
+    }
+    else {
+	if (!rlen && !delete) {
+	    r = t; rlen = tlen;
+	}
+	for (i = 0; i < 256; i++)
+	    tbl[i] = -1;
+	for (i = 0, j = 0; i < tlen; i++,j++) {
+	    if (j >= rlen) {
+		if (delete) {
+		    if (tbl[t[i] & 0377] == -1)
+			tbl[t[i] & 0377] = -2;
+		    continue;
+		}
+		--j;
+	    }
+	    if (tbl[t[i] & 0377] == -1)
+		tbl[t[i] & 0377] = r[j] & 0377;
+	}
+    }
+    str_free(tstr);
+    str_free(rstr);
+    return s;
+}
+
+char *
+scanstr(start, in_what)
+char *start;
+int in_what;
+{
+    register char *s = start;
+    register char term;
+    register char *d;
+    register ARG *arg;
+    register char *send;
+    register bool makesingle = FALSE;
+    register STAB *stab;
+    bool alwaysdollar = FALSE;
+    bool hereis = FALSE;
+    STR *herewas;
+    STR *str;
+    /* which backslash sequences to keep */
+    char *leave = (in_what & SCAN_TR)
+	? "\\$@nrtfbeacx0123456789-"
+	: "\\$@nrtfbeacx0123456789[{]}lLuUE";
+    int len;
+
+    arg = op_new(1);
+    yylval.arg = arg;
+    arg->arg_type = O_ITEM;
+
+    switch (*s) {
+    default:			/* a substitution replacement */
+	arg[1].arg_type = A_DOUBLE;
+	makesingle = TRUE;	/* maybe disable runtime scanning */
+	term = *s;
+	if (term == '\'')
+	    leave = Nullch;
+	goto snarf_it;
+    case '0':
+	{
+	    unsigned long i;
+	    int shift;
+
+	    arg[1].arg_type = A_SINGLE;
+	    if (s[1] == 'x') {
+		shift = 4;
+		s += 2;
+	    }
+	    else if (s[1] == '.')
+		goto decimal;
+	    else
+		shift = 3;
+	    i = 0;
+	    for (;;) {
+		switch (*s) {
+		default:
+		    goto out;
+		case '_':
+		    s++;
+		    break;
+		case '8': case '9':
+		    if (shift != 4)
+			yyerror("Illegal octal digit");
+		    /* FALL THROUGH */
+		case '0': case '1': case '2': case '3': case '4':
+		case '5': case '6': case '7':
+		    i <<= shift;
+		    i += *s++ & 15;
+		    break;
+		case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+		case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+		    if (shift != 4)
+			goto out;
+		    i <<= 4;
+		    i += (*s++ & 7) + 9;
+		    break;
+		}
+	    }
+	  out:
+	    str = Str_new(92,0);
+	    str_numset(str,(double)i);
+	    if (str->str_ptr) {
+		Safefree(str->str_ptr);
+		str->str_ptr = Nullch;
+		str->str_len = str->str_cur = 0;
+	    }
+	    arg[1].arg_ptr.arg_str = str;
+	}
+	break;
+    case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9': case '.':
+      decimal:
+	arg[1].arg_type = A_SINGLE;
+	d = tokenbuf;
+	while (isDIGIT(*s) || *s == '_') {
+	    if (*s == '_')
+		s++;
+	    else
+		*d++ = *s++;
+	}
+	if (*s == '.' && s[1] != '.') {
+	    *d++ = *s++;
+	    while (isDIGIT(*s) || *s == '_') {
+		if (*s == '_')
+		    s++;
+		else
+		    *d++ = *s++;
+	    }
+	}
+	if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
+	    *d++ = *s++;
+	    if (*s == '+' || *s == '-')
+		*d++ = *s++;
+	    while (isDIGIT(*s))
+		*d++ = *s++;
+	}
+	*d = '\0';
+	str = Str_new(92,0);
+	str_numset(str,atof(tokenbuf));
+	if (str->str_ptr) {
+	    Safefree(str->str_ptr);
+	    str->str_ptr = Nullch;
+	    str->str_len = str->str_cur = 0;
+	}
+	arg[1].arg_ptr.arg_str = str;
+	break;
+    case '<':
+	if (in_what & (SCAN_REPL|SCAN_TR))
+	    goto do_double;
+	if (*++s == '<') {
+	    hereis = TRUE;
+	    d = tokenbuf;
+	    if (!rsfp)
+		*d++ = '\n';
+	    if (*++s && index("`'\"",*s)) {
+		term = *s++;
+		s = cpytill(d,s,bufend,term,&len);
+		if (s < bufend)
+		    s++;
+		d += len;
+	    }
+	    else {
+		if (*s == '\\')
+		    s++, term = '\'';
+		else
+		    term = '"';
+		while (isALNUM(*s))
+		    *d++ = *s++;
+	    }				/* assuming tokenbuf won't clobber */
+	    *d++ = '\n';
+	    *d = '\0';
+	    len = d - tokenbuf;
+	    d = "\n";
+	    if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
+		herewas = str_make(s,bufend-s);
+	    else
+		s--, herewas = str_make(s,d-s);
+	    s += herewas->str_cur;
+	    if (term == '\'')
+		goto do_single;
+	    if (term == '`')
+		goto do_back;
+	    goto do_double;
+	}
+	d = tokenbuf;
+	s = cpytill(d,s,bufend,'>',&len);
+	if (s < bufend)
+	    s++;
+	else
+	    fatal("Unterminated <> operator");
+
+	if (*d == '$') d++;
+	while (*d && (isALNUM(*d) || *d == '\''))
+	    d++;
+	if (d - tokenbuf != len) {
+	    s = start;
+	    term = *s;
+	    arg[1].arg_type = A_GLOB;
+	    set_csh();
+	    alwaysdollar = TRUE;	/* treat $) and $| as variables */
+	    goto snarf_it;
+	}
+	else {
+	    d = tokenbuf;
+	    if (!len)
+		(void)strcpy(d,"ARGV");
+	    if (*d == '$') {
+		arg[1].arg_type = A_INDREAD;
+		arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
+	    }
+	    else {
+		arg[1].arg_type = A_READ;
+		arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
+		if (!stab_io(arg[1].arg_ptr.arg_stab))
+		    stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
+		if (strEQ(d,"ARGV")) {
+		    (void)aadd(arg[1].arg_ptr.arg_stab);
+		    stab_io(arg[1].arg_ptr.arg_stab)->flags |=
+		      IOF_ARGV|IOF_START;
+		}
+	    }
+	}
+	break;
+
+    case 'q':
+	s++;
+	if (*s == 'q') {
+	    s++;
+	    goto do_double;
+	}
+	if (*s == 'x') {
+	    s++;
+	    goto do_back;
+	}
+	/* FALL THROUGH */
+    case '\'':
+      do_single:
+	term = *s;
+	arg[1].arg_type = A_SINGLE;
+	leave = Nullch;
+	goto snarf_it;
+
+    case '"': 
+      do_double:
+	term = *s;
+	arg[1].arg_type = A_DOUBLE;
+	makesingle = TRUE;	/* maybe disable runtime scanning */
+	alwaysdollar = TRUE;	/* treat $) and $| as variables */
+	goto snarf_it;
+    case '`':
+      do_back:
+	term = *s;
+	arg[1].arg_type = A_BACKTICK;
+	set_csh();
+	alwaysdollar = TRUE;	/* treat $) and $| as variables */
+      snarf_it:
+	{
+	    STR *tmpstr;
+	    STR *tmpstr2 = Nullstr;
+	    char *tmps;
+	    bool dorange = FALSE;
+
+	    CLINE;
+	    multi_start = curcmd->c_line;
+	    if (hereis)
+		multi_open = multi_close = '<';
+	    else {
+		multi_open = term;
+		if (term && (tmps = index("([{< )]}> )]}>",term)))
+		    term = tmps[5];
+		multi_close = term;
+	    }
+	    tmpstr = Str_new(87,80);
+	    if (hereis) {
+		term = *tokenbuf;
+		if (!rsfp) {
+		    d = s;
+		    while (s < bufend &&
+		      (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
+			if (*s++ == '\n')
+			    curcmd->c_line++;
+		    }
+		    if (s >= bufend) {
+			curcmd->c_line = multi_start;
+			fatal("EOF in string");
+		    }
+		    str_nset(tmpstr,d+1,s-d);
+		    s += len - 1;
+		    str_ncat(herewas,s,bufend-s);
+		    str_replace(linestr,herewas);
+		    oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
+		    bufend = linestr->str_ptr + linestr->str_cur;
+		    hereis = FALSE;
+		}
+		else
+		    str_nset(tmpstr,"",0);   /* avoid "uninitialized" warning */
+	    }
+	    else
+		s = str_append_till(tmpstr,s+1,bufend,term,leave);
+	    while (s >= bufend) {	/* multiple line string? */
+		if (!rsfp ||
+		 !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
+		    curcmd->c_line = multi_start;
+		    fatal("EOF in string");
+		}
+		curcmd->c_line++;
+		if (perldb) {
+		    STR *str = Str_new(88,0);
+
+		    str_sset(str,linestr);
+		    astore(stab_xarray(curcmd->c_filestab),
+		      (int)curcmd->c_line,str);
+		}
+		bufend = linestr->str_ptr + linestr->str_cur;
+		if (hereis) {
+		    if (*s == term && bcmp(s,tokenbuf,len) == 0) {
+			s = bufend - 1;
+			*s = ' ';
+			str_scat(linestr,herewas);
+			bufend = linestr->str_ptr + linestr->str_cur;
+		    }
+		    else {
+			s = bufend;
+			str_scat(tmpstr,linestr);
+		    }
+		}
+		else
+		    s = str_append_till(tmpstr,s,bufend,term,leave);
+	    }
+	    multi_end = curcmd->c_line;
+	    s++;
+	    if (tmpstr->str_cur + 5 < tmpstr->str_len) {
+		tmpstr->str_len = tmpstr->str_cur + 1;
+		Renew(tmpstr->str_ptr, tmpstr->str_len, char);
+	    }
+	    if (arg[1].arg_type == A_SINGLE) {
+		arg[1].arg_ptr.arg_str = tmpstr;
+		break;
+	    }
+	    tmps = s;
+	    s = tmpstr->str_ptr;
+	    send = s + tmpstr->str_cur;
+	    while (s < send) {		/* see if we can make SINGLE */
+		if (*s == '\\' && s[1] && isDIGIT(s[1]) && !isDIGIT(s[2]) &&
+		  !alwaysdollar && s[1] != '0')
+		    *s = '$';		/* grandfather \digit in subst */
+		if ((*s == '$' || *s == '@') && s+1 < send &&
+		  (alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
+		    makesingle = FALSE;	/* force interpretation */
+		}
+		else if (*s == '\\' && s+1 < send) {
+		    if (index("lLuUE",s[1]))
+			makesingle = FALSE;
+		    s++;
+		}
+		s++;
+	    }
+	    s = d = tmpstr->str_ptr;	/* assuming shrinkage only */
+	    while (s < send || dorange) {
+		if (in_what & SCAN_TR) {
+		    if (dorange) {
+			int i;
+			int max;
+			if (!tmpstr2) {	/* oops, have to grow */
+			    tmpstr2 = str_smake(tmpstr);
+			    s = tmpstr2->str_ptr + (s - tmpstr->str_ptr);
+			    send = tmpstr2->str_ptr + (send - tmpstr->str_ptr);
+			}
+			i = d - tmpstr->str_ptr;
+			STR_GROW(tmpstr, tmpstr->str_len + 256);
+			d = tmpstr->str_ptr + i;
+			d -= 2;
+			max = d[1] & 0377;
+			for (i = (*d & 0377); i <= max; i++)
+			    *d++ = i;
+			dorange = FALSE;
+			continue;
+		    }
+		    else if (*s == '-' && s+1 < send  && d != tmpstr->str_ptr) {
+			dorange = TRUE;
+			s++;
+		    }
+		}
+		else {
+		    if ((*s == '$' && s+1 < send &&
+			(alwaysdollar || /*(*/(s[1] != ')' && s[1] != '|')) ) ||
+			(*s == '@' && s+1 < send) ) {
+			if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
+			    *d++ = *s++;
+			len = scanident(s,send,tokenbuf) - s;
+			if (*s == '$' || strEQ(tokenbuf,"ARGV")
+			  || strEQ(tokenbuf,"ENV")
+			  || strEQ(tokenbuf,"SIG")
+			  || strEQ(tokenbuf,"INC") )
+			    (void)stabent(tokenbuf,TRUE); /* add symbol */
+			while (len--)
+			    *d++ = *s++;
+			continue;
+		    }
+		}
+		if (*s == '\\' && s+1 < send) {
+		    s++;
+		    switch (*s) {
+		    case '-':
+			if (in_what & SCAN_TR) {
+			    *d++ = *s++;
+			    continue;
+			}
+			/* FALL THROUGH */
+		    default:
+			if (!makesingle && (!leave || (*s && index(leave,*s))))
+			    *d++ = '\\';
+			*d++ = *s++;
+			continue;
+		    case '0': case '1': case '2': case '3':
+		    case '4': case '5': case '6': case '7':
+			*d++ = scanoct(s, 3, &len);
+			s += len;
+			continue;
+		    case 'x':
+			*d++ = scanhex(++s, 2, &len);
+			s += len;
+			continue;
+		    case 'c':
+			s++;
+			*d = *s++;
+			if (isLOWER(*d))
+			    *d = toupper(*d);
+			*d++ ^= 64;
+			continue;
+		    case 'b':
+			*d++ = '\b';
+			break;
+		    case 'n':
+			*d++ = '\n';
+			break;
+		    case 'r':
+			*d++ = '\r';
+			break;
+		    case 'f':
+			*d++ = '\f';
+			break;
+		    case 't':
+			*d++ = '\t';
+			break;
+		    case 'e':
+			*d++ = '\033';
+			break;
+		    case 'a':
+			*d++ = '\007';
+			break;
+		    }
+		    s++;
+		    continue;
+		}
+		*d++ = *s++;
+	    }
+	    *d = '\0';
+
+	    if (arg[1].arg_type == A_DOUBLE && makesingle)
+		arg[1].arg_type = A_SINGLE;	/* now we can optimize on it */
+
+	    tmpstr->str_cur = d - tmpstr->str_ptr;
+	    if (arg[1].arg_type == A_GLOB) {
+		arg[1].arg_ptr.arg_stab = stab = genstab();
+		stab_io(stab) = stio_new();
+		str_sset(stab_val(stab), tmpstr);
+	    }
+	    else
+		arg[1].arg_ptr.arg_str = tmpstr;
+	    s = tmps;
+	    if (tmpstr2)
+		str_free(tmpstr2);
+	    break;
+	}
+    }
+    if (hereis)
+	str_free(herewas);
+    return s;
+}
+
+FCMD *
+load_format()
+{
+    FCMD froot;
+    FCMD *flinebeg;
+    char *eol;
+    register FCMD *fprev = &froot;
+    register FCMD *fcmd;
+    register char *s;
+    register char *t;
+    register STR *str;
+    bool noblank;
+    bool repeater;
+
+    Zero(&froot, 1, FCMD);
+    s = bufptr;
+    while (s < bufend || (rsfp && (s = str_gets(linestr,rsfp, 0)) != Nullch)) {
+	curcmd->c_line++;
+	if (in_eval && !rsfp) {
+	    eol = index(s,'\n');
+	    if (!eol++)
+		eol = bufend;
+	}
+	else
+	    eol = bufend = linestr->str_ptr + linestr->str_cur;
+	if (perldb) {
+	    STR *tmpstr = Str_new(89,0);
+
+	    str_nset(tmpstr, s, eol-s);
+	    astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
+	}
+	if (*s == '.') {
+	    /*SUPPRESS 530*/
+	    for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
+	    if (*t == '\n') {
+		bufptr = s;
+		return froot.f_next;
+	    }
+	}
+	if (*s == '#') {
+	    s = eol;
+	    continue;
+	}
+	flinebeg = Nullfcmd;
+	noblank = FALSE;
+	repeater = FALSE;
+	while (s < eol) {
+	    Newz(804,fcmd,1,FCMD);
+	    fprev->f_next = fcmd;
+	    fprev = fcmd;
+	    for (t=s; t < eol && *t != '@' && *t != '^'; t++) {
+		if (*t == '~') {
+		    noblank = TRUE;
+		    *t = ' ';
+		    if (t[1] == '~') {
+			repeater = TRUE;
+			t[1] = ' ';
+		    }
+		}
+	    }
+	    fcmd->f_pre = nsavestr(s, t-s);
+	    fcmd->f_presize = t-s;
+	    s = t;
+	    if (s >= eol) {
+		if (noblank)
+		    fcmd->f_flags |= FC_NOBLANK;
+		if (repeater)
+		    fcmd->f_flags |= FC_REPEAT;
+		break;
+	    }
+	    if (!flinebeg)
+		flinebeg = fcmd;		/* start values here */
+	    if (*s++ == '^')
+		fcmd->f_flags |= FC_CHOP;	/* for doing text filling */
+	    switch (*s) {
+	    case '*':
+		fcmd->f_type = F_LINES;
+		*s = '\0';
+		break;
+	    case '<':
+		fcmd->f_type = F_LEFT;
+		while (*s == '<')
+		    s++;
+		break;
+	    case '>':
+		fcmd->f_type = F_RIGHT;
+		while (*s == '>')
+		    s++;
+		break;
+	    case '|':
+		fcmd->f_type = F_CENTER;
+		while (*s == '|')
+		    s++;
+		break;
+	    case '#':
+	    case '.':
+		/* Catch the special case @... and handle it as a string
+		   field. */
+		if (*s == '.' && s[1] == '.') {
+		    goto default_format;
+		}
+		fcmd->f_type = F_DECIMAL;
+		{
+		    char *p;
+
+		    /* Read a format in the form @####.####, where either group
+		       of ### may be empty, or the final .### may be missing. */
+		    while (*s == '#')
+			s++;
+		    if (*s == '.') {
+			s++;
+			p = s;
+			while (*s == '#')
+			    s++;
+			fcmd->f_decimals = s-p;
+			fcmd->f_flags |= FC_DP;
+		    } else {
+			fcmd->f_decimals = 0;
+		    }
+		}
+		break;
+	    default:
+	    default_format:
+		fcmd->f_type = F_LEFT;
+		break;
+	    }
+	    if (fcmd->f_flags & FC_CHOP && *s == '.') {
+		fcmd->f_flags |= FC_MORE;
+		while (*s == '.')
+		    s++;
+	    }
+	    fcmd->f_size = s-t;
+	}
+	if (flinebeg) {
+	  again:
+	    if (s >= bufend &&
+	      (!rsfp || (s = str_gets(linestr, rsfp, 0)) == Nullch) )
+		goto badform;
+	    curcmd->c_line++;
+	    if (in_eval && !rsfp) {
+		eol = index(s,'\n');
+		if (!eol++)
+		    eol = bufend;
+	    }
+	    else
+		eol = bufend = linestr->str_ptr + linestr->str_cur;
+	    if (perldb) {
+		STR *tmpstr = Str_new(90,0);
+
+		str_nset(tmpstr, s, eol-s);
+		astore(stab_xarray(curcmd->c_filestab),
+		    (int)curcmd->c_line,tmpstr);
+	    }
+	    if (strnEQ(s,".\n",2)) {
+		bufptr = s;
+		yyerror("Missing values line");
+		return froot.f_next;
+	    }
+	    if (*s == '#') {
+		s = eol;
+		goto again;
+	    }
+	    str = flinebeg->f_unparsed = Str_new(91,eol - s);
+	    str->str_u.str_hash = curstash;
+	    str_nset(str,"(",1);
+	    flinebeg->f_line = curcmd->c_line;
+	    eol[-1] = '\0';
+	    if (!flinebeg->f_next->f_type || index(s, ',')) {
+		eol[-1] = '\n';
+		str_ncat(str, s, eol - s - 1);
+		str_ncat(str,",$$);",5);
+		s = eol;
+	    }
+	    else {
+		eol[-1] = '\n';
+		while (s < eol && isSPACE(*s))
+		    s++;
+		t = s;
+		while (s < eol) {
+		    switch (*s) {
+		    case ' ': case '\t': case '\n': case ';':
+			str_ncat(str, t, s - t);
+			str_ncat(str, "," ,1);
+			while (s < eol && (isSPACE(*s) || *s == ';'))
+			    s++;
+			t = s;
+			break;
+		    case '$':
+			str_ncat(str, t, s - t);
+			t = s;
+			s = scanident(s,eol,tokenbuf);
+			str_ncat(str, t, s - t);
+			t = s;
+			if (s < eol && *s && index("$'\"",*s))
+			    str_ncat(str, ",", 1);
+			break;
+		    case '"': case '\'':
+			str_ncat(str, t, s - t);
+			t = s;
+			s++;
+			while (s < eol && (*s != *t || s[-1] == '\\'))
+			    s++;
+			if (s < eol)
+			    s++;
+			str_ncat(str, t, s - t);
+			t = s;
+			if (s < eol && *s && index("$'\"",*s))
+			    str_ncat(str, ",", 1);
+			break;
+		    default:
+			yyerror("Please use commas to separate fields");
+		    }
+		}
+		str_ncat(str,"$$);",4);
+	    }
+	}
+    }
+  badform:
+    bufptr = str_get(linestr);
+    yyerror("Format not terminated");
+    return froot.f_next;
+}
+
+static void
+set_csh()
+{
+#ifdef CSH
+    if (!cshlen)
+	cshlen = strlen(cshname);
+#endif
+}
diff --git a/toke.c.rej b/toke.c.rej
new file mode 100644
index 0000000000..14e76a2d12
--- /dev/null
+++ b/toke.c.rej
@@ -0,0 +1,36 @@
+***************
+*** 1,4 ****
+! /* $RCSfile: toke.c,v $$Revision: 4.0.1.8 $$Date: 1992/06/23 12:33:45 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+--- 1,4 ----
+! /* $RCSfile: toke.c,v $$Revision: 4.0.1.9 $$Date: 1993/02/05 19:48:43 $
+   *
+   *    Copyright (c) 1991, Larry Wall
+   *
+***************
+*** 6,14 ****
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: toke.c,v $
+!  * Revision 4.0.1.8  1992/06/23  12:33:45  lwall
+!  * patch35: bad interaction between backslash and hyphen in tr///
+   *
+   * Revision 4.0.1.7  92/06/11  21:16:30  lwall
+   * patch34: expectterm incorrectly set to indicate start of program or block
+   * 
+--- 6,18 ----
+   *    License or the Artistic License, as specified in the README file.
+   *
+   * $Log: toke.c,v $
+!  * Revision 4.0.1.9  1993/02/05  19:48:43  lwall
+!  * patch36: now detects ambiguous use of filetest operators as well as unary
+!  * patch36: fixed ambiguity on - within tr///
+   *
++  * Revision 4.0.1.8  92/06/23  12:33:45  lwall
++  * patch35: bad interaction between backslash and hyphen in tr///
++  * 
+   * Revision 4.0.1.7  92/06/11  21:16:30  lwall
+   * patch34: expectterm incorrectly set to indicate start of program or block
+   * 
diff --git a/x2p/find2perl.SH b/x2p/find2perl.SH
index 7e49cd003f..4a95de04a1 100644
--- a/x2p/find2perl.SH
+++ b/x2p/find2perl.SH
@@ -68,11 +68,11 @@ while (@ARGV) {
 	die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
 	if ($onum =~ s/^-//) {
 	    $onum = '0' . sprintf("%o", oct($onum) & 017777);	# s/b 07777 ?
-	    $out .= &tab . "(\$mode & $onum) == $onum";
+	    $out .= &tab . "((\$mode & $onum) == $onum)";
 	}
 	else {
 	    $onum = '0' . $onum unless $onum =~ /^0/;
-	    $out .= &tab . "(\$mode & 0777) == $onum";
+	    $out .= &tab . "((\$mode & 0777) == $onum)";
 	}
     }
     elsif ($_ eq 'type') {