perl 3.0 patch #21 patch #19, continued

See patch #19.

7 files changed, 993 insertions, 58 deletions

diff --git a/cons.c b/cons.c
index 37186852d8..17e317e252 100644
--- a/cons.c
+++ b/cons.c
@@ -1,4 +1,4 @@
-/* $Header: cons.c,v 3.0.1.6 90/03/27 15:35:21 lwall Locked $
+/* $Header: cons.c,v 3.0.1.7 90/08/09 02:35:52 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,12 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	cons.c,v $
+ * Revision 3.0.1.7  90/08/09  02:35:52  lwall
+ * patch19: did preliminary work toward debugging packages and evals
+ * patch19: Added support for linked-in C subroutines
+ * patch19: Numeric literals are now stored only in floating point
+ * patch19: Added -c switch to do compilation only
+ * 
  * Revision 3.0.1.6  90/03/27  15:35:21  lwall
  * patch16: formats didn't work inside eval
  * patch16: $foo++ now optimized to ++$foo where value not required
@@ -57,15 +63,17 @@ CMD *cmd;
     Newz(101,sub,1,SUBR);
     if (stab_sub(stab)) {
 	if (dowarn) {
-	    line_t oldline = line;
+	    CMD *oldcurcmd = curcmd;
 
 	    if (cmd)
-		line = cmd->c_line;
+		curcmd = cmd;
 	    warn("Subroutine %s redefined",name);
-	    line = oldline;
+	    curcmd = oldcurcmd;
+	}
+	if (stab_sub(stab)->cmd) {
+	    cmd_free(stab_sub(stab)->cmd);
+	    afree(stab_sub(stab)->tosave);
 	}
-	cmd_free(stab_sub(stab)->cmd);
-	afree(stab_sub(stab)->tosave);
 	Safefree(stab_sub(stab));
     }
     sub->filename = filename;
@@ -89,7 +97,7 @@ CMD *cmd;
 	STR *str = str_nmake((double)subline);
 
 	str_cat(str,"-");
-	sprintf(buf,"%ld",(long)line);
+	sprintf(buf,"%ld",(long)curcmd->c_line);
 	str_cat(str,buf);
 	name = str_get(subname);
 	hstore(stab_xhash(DBsub),name,strlen(name),str,0);
@@ -99,6 +107,35 @@ CMD *cmd;
     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;
+    Newz(101,sub,1,SUBR);
+    if (stab_sub(stab)) {
+	if (dowarn)
+	    warn("Subroutine %s redefined",name);
+	if (stab_sub(stab)->cmd) {
+	    cmd_free(stab_sub(stab)->cmd);
+	    afree(stab_sub(stab)->tosave);
+	}
+	Safefree(stab_sub(stab));
+    }
+    sub->filename = filename;
+    sub->usersub = subaddr;
+    sub->userindex = ix;
+    stab_sub(stab) = sub;
+    return sub;
+}
+
 make_form(stab,fcmd)
 STAB *stab;
 FCMD *fcmd;
@@ -428,6 +465,7 @@ CMD *cur;
     cmd->c_line = head->c_line;
     cmd->c_label = head->c_label;
     cmd->c_file = filename;
+    cmd->c_pack = curpack;
     return append_line(cmd, cur);
 }
 
@@ -448,12 +486,13 @@ ARG *arg;
     if (cond)
 	cmd->c_flags |= CF_COND;
     if (cmdline == NOLINE)
-	cmd->c_line = line;
+	cmd->c_line = curcmd->c_line;
     else {
 	cmd->c_line = cmdline;
 	cmdline = NOLINE;
     }
     cmd->c_file = filename;
+    cmd->c_pack = curpack;
     if (perldb)
 	cmd = dodb(cmd);
     return cmd;
@@ -475,7 +514,7 @@ struct compcmd cblock;
     if (arg)
 	cmd->c_flags |= CF_COND;
     if (cmdline == NOLINE)
-	cmd->c_line = line;
+	cmd->c_line = curcmd->c_line;
     else {
 	cmd->c_line = cmdline;
 	cmdline = NOLINE;
@@ -506,7 +545,7 @@ struct compcmd cblock;
     if (arg)
 	cmd->c_flags |= CF_COND;
     if (cmdline == NOLINE)
-	cmd->c_line = line;
+	cmd->c_line = curcmd->c_line;
     else {
 	cmd->c_line = cmdline;
 	cmdline = NOLINE;
@@ -701,6 +740,8 @@ int acmd;
 	     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) {
+		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;
@@ -898,8 +939,8 @@ char *s;
     else
 	(void)sprintf(tname,"next char %c",yychar);
     (void)sprintf(buf, "%s in file %s at line %d, %s\n",
-      s,filename,line,tname);
-    if (line == multi_end && multi_start < multi_end)
+      s,filename,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);
@@ -908,7 +949,7 @@ char *s;
     else
 	fputs(buf,stderr);
     if (++error_count >= 10)
-	fatal("Too many errors\n");
+	fatal("%s has too many errors.\n", filename);
 }
 
 void
@@ -1118,10 +1159,12 @@ register CMD *cmd;
 	}
 	tofree = cmd;
 	cmd = cmd->c_next;
-	Safefree(tofree);
+	if (tofree != head)		/* to get Saber to shut up */
+	    Safefree(tofree);
 	if (cmd && cmd == head)		/* reached end of while loop */
 	    break;
     }
+    Safefree(head);
 }
 
 arg_free(arg)
diff --git a/consarg.c b/consarg.c
index b9184485ea..a7db58b862 100644
--- a/consarg.c
+++ b/consarg.c
@@ -1,4 +1,4 @@
-/* $Header: consarg.c,v 3.0.1.5 90/03/27 15:36:45 lwall Locked $
+/* $Header: consarg.c,v 3.0.1.6 90/08/09 02:38:51 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	consarg.c,v $
+ * Revision 3.0.1.6  90/08/09  02:38:51  lwall
+ * patch19: fixed problem with % of negative number
+ * 
  * Revision 3.0.1.5  90/03/27  15:36:45  lwall
  * patch16: support for machines that can't cast negative floats to unsigned ints
  * 
@@ -60,6 +63,7 @@ ARG *limarg;
 	    arg_free(limarg);
 	}
 	else {
+	    arg[3].arg_flags = 0;
 	    arg[3].arg_type = A_EXPR;
 	    arg[3].arg_ptr.arg_arg = limarg;
 	}
@@ -308,7 +312,6 @@ register ARG *arg;
 		arg->arg_len = 1;
 		arg[1].arg_type = A_ARYSTAB;	/* $abc[123] is hoistable now */
 		arg[1].arg_len = i;
-		arg[1].arg_ptr = arg[1].arg_ptr;	/* get stab pointer */
 		str_free(s2);
 	    }
 	    /* FALL THROUGH */
@@ -351,7 +354,7 @@ register ARG *arg;
 	    if (tmp2 >= 0)
 		str_numset(str,(double)(tmp2 % tmplong));
 	    else
-		str_numset(str,(double)(tmplong - (-tmp2 % tmplong)));
+		str_numset(str,(double)(tmplong - ((-tmp2 - 1) % tmplong))) - 1;
 #else
 	    tmp2 = tmp2;
 #endif
@@ -945,6 +948,7 @@ ARG *arg;
     if (arg->arg_len == 0)
 	arg[1].arg_type = A_NULL;
     arg->arg_len = 2;
+    arg[2].arg_flags = 0;
     arg[2].arg_ptr.arg_hash = curstash;
     arg[2].arg_type = A_NULL;
     return arg;
diff --git a/doarg.c b/doarg.c
index 029ba38080..48b614e3ed 100644
--- a/doarg.c
+++ b/doarg.c
@@ -1,4 +1,4 @@
-/* $Header: doarg.c,v 3.0.1.5 90/03/27 15:39:03 lwall Locked $
+/* $Header: doarg.c,v 3.0.1.6 90/08/09 02:48:38 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,15 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	doarg.c,v $
+ * Revision 3.0.1.6  90/08/09  02:48:38  lwall
+ * patch19: fixed double include of <signal.h>
+ * patch19: pack/unpack can now do native float and double
+ * patch19: pack/unpack can now have absolute and negative positioning
+ * patch19: pack/unpack can now have use * to specify all the rest of input
+ * patch19: unpack can do checksumming
+ * patch19: $< and $> better supported on machines without setreuid
+ * patch19: Added support for linked-in C subroutines
+ * 
  * Revision 3.0.1.5  90/03/27  15:39:03  lwall
  * patch16: MSDOS support
  * patch16: support for machines that can't cast negative floats to unsigned ints
@@ -40,7 +49,9 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+#ifndef NSIG
 #include <signal.h>
+#endif
 
 extern unsigned char fold[];
 
@@ -83,7 +94,7 @@ int sp;
 	if (spat->spat_regexp)
 	    regfree(spat->spat_regexp);
 	spat->spat_regexp = regcomp(m,m+dstr->str_cur,
-	    spat->spat_flags & SPAT_FOLD,1);
+	    spat->spat_flags & SPAT_FOLD);
 	if (spat->spat_flags & SPAT_KEEP) {
 	    arg_free(spat->spat_runtime);	/* it won't change, so */
 	    spat->spat_runtime = Nullarg;	/* no point compiling again */
@@ -381,6 +392,8 @@ int *arglast;
     long along;
     unsigned long aulong;
     char *aptr;
+    float afloat;
+    double adouble;
 
     items = arglast[2] - sp;
     st += ++sp;
@@ -388,7 +401,11 @@ int *arglast;
     while (pat < patend) {
 #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
 	datumtype = *pat++;
-	if (isdigit(*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');
@@ -398,7 +415,25 @@ int *arglast;
 	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:
+	    str->str_cur -= len;
+	    if (str->str_cur < 0)
+		fatal("X outside of string");
+	    str->str_ptr[str->str_cur] = '\0';
+	    break;
 	case 'x':
+	  grow:
 	    while (len >= 10) {
 		str_ncat(str,null10,10);
 		len -= 10;
@@ -409,6 +444,8 @@ int *arglast;
 	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 {
@@ -439,6 +476,23 @@ int *arglast;
 		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;
@@ -502,12 +556,55 @@ int *arglast;
 		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
 
+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;
+    }
+    str_ncat(str, "\n", 1);
+}
+
 void
 do_sprintf(str,len,sarg)
 register STR *str;
@@ -718,17 +815,23 @@ int *arglast;
     }
     if (!stab)
 	fatal("Undefined subroutine called");
+    saveint(&wantarray);
+    wantarray = gimme;
     sub = stab_sub(stab);
     if (!sub)
 	fatal("Undefined subroutine \"%s\" called", stab_name(stab));
+    if (sub->usersub) {
+	st[sp] = arg->arg_ptr.arg_str;
+	if ((arg[2].arg_type & A_MASK) == A_NULL)
+	    items = 0;
+	return sub->usersub(sub->userindex,sp,items);
+    }
     if ((arg[2].arg_type & A_MASK) != A_NULL) {
 	savearray = stab_xarray(defstab);
 	stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
     }
     savelong(&sub->depth);
     sub->depth++;
-    saveint(&wantarray);
-    wantarray = gimme;
     if (sub->depth >= 2) {	/* save temporaries on recursion? */
 	if (sub->depth == 100 && dowarn)
 	    warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
@@ -783,9 +886,8 @@ int *arglast;
     }
     if (!stab)
 	fatal("Undefined subroutine called");
-    sub = stab_sub(stab);
-    if (!sub)
-	fatal("Undefined subroutine \"%s\" called", stab_name(stab));
+    saveint(&wantarray);
+    wantarray = gimme;
 /* begin differences */
     str = stab_val(DBsub);
     saveitem(str);
@@ -800,8 +902,6 @@ int *arglast;
     }
     savelong(&sub->depth);
     sub->depth++;
-    saveint(&wantarray);
-    wantarray = gimme;
     if (sub->depth >= 2) {	/* save temporaries on recursion? */
 	if (sub->depth == 100 && dowarn)
 	    warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
@@ -938,14 +1038,22 @@ int *arglast;
 	}
     }
     if (delaymagic > 1) {
+	if (delaymagic & DM_REUID) {
 #ifdef SETREUID
-	if (delaymagic & DM_REUID)
 	    setreuid(uid,euid);
+#else
+	    if (uid != euid || setuid(uid) < 0)
+		fatal("No setreuid available");
 #endif
+	}
+	if (delaymagic & DM_REGID) {
 #ifdef SETREGID
-	if (delaymagic & DM_REGID)
 	    setregid(gid,egid);
+#else
+	    if (gid != egid || setgid(gid) < 0)
+		fatal("No setregid available");
 #endif
+	}
     }
     delaymagic = 0;
     localizing = FALSE;
@@ -1057,12 +1165,12 @@ int *arglast;
 	retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0;
     else if (type == O_HASH || type == O_LHASH)
 	retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0;
-    else if (type == O_SUBR || type == O_DBSUBR)
-	retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
     else if (type == O_ASLICE || type == O_LASLICE)
 	retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0;
     else if (type == O_HSLICE || type == O_LHSLICE)
 	retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0;
+    else if (type == O_SUBR || type == O_DBSUBR)
+	retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
     else
 	retval = FALSE;
     str_numset(str,(double)retval);
diff --git a/doio.c b/doio.c
index 7667e5c7e9..88c0f4c2bd 100644
--- a/doio.c
+++ b/doio.c
@@ -1,4 +1,4 @@
-/* $Header: doio.c,v 3.0.1.8 90/03/27 15:44:02 lwall Locked $
+/* $Header: doio.c,v 3.0.1.9 90/08/09 02:56:19 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,14 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	doio.c,v $
+ * Revision 3.0.1.9  90/08/09  02:56:19  lwall
+ * patch19: various MSDOS and OS/2 patches folded in
+ * patch19: prints now check error status better
+ * patch19: printing a list with null elements only printed front of list
+ * patch19: on machines with vfork child would allocate memory in parent
+ * patch19: getsockname and getpeername gave bogus warning on error
+ * patch19: MACH doesn't have seekdir or telldir
+ * 
  * Revision 3.0.1.8  90/03/27  15:44:02  lwall
  * patch16: MSDOS support
  * patch16: support for machines that can't cast negative floats to unsigned ints
@@ -68,6 +76,9 @@
 #ifdef I_UTIME
 #include <utime.h>
 #endif
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
 
 bool
 do_open(stab,name,len)
@@ -261,17 +272,32 @@ register STAB *stab;
 		fileuid = statbuf.st_uid;
 		filegid = statbuf.st_gid;
 		if (*inplace) {
+#ifdef SUFFIX
+		    add_suffix(str,inplace);
+#else
 		    str_cat(str,inplace);
+#endif
 #ifdef RENAME
+#ifndef MSDOS
 		    (void)rename(oldname,str->str_ptr);
 #else
+		    do_close(stab,FALSE);
+		    (void)unlink(str->str_ptr);
+		    (void)rename(oldname,str->str_ptr);
+		    do_open(stab,str->str_ptr,stab_val(stab)->str_cur);
+#endif /* MSDOS */
+#else
 		    (void)UNLINK(str->str_ptr);
 		    (void)link(oldname,str->str_ptr);
 		    (void)UNLINK(oldname);
 #endif
 		}
 		else {
+#ifndef MSDOS
 		    (void)UNLINK(oldname);
+#else
+		    fatal("Can't do inplace edit without backup");
+#endif
 		}
 
 		str_nset(str,">",1);
@@ -510,7 +536,7 @@ STR *argstr;
 	retval = 256;			/* otherwise guess at what's safe */
 #endif
 	if (argstr->str_cur < retval) {
-	    str_grow(argstr,retval+1);
+	    Str_Grow(argstr,retval+1);
 	    argstr->str_cur = retval;
 	}
 
@@ -632,6 +658,64 @@ int *arglast;
 }
 
 int
+do_truncate(str,arg,gimme,arglast)
+STR *str;
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0] + 1;
+    off_t len = (off_t)str_gnum(ary->ary_array[sp+1]);
+    int result = 1;
+    STAB *tmpstab;
+
+#if defined(TRUNCATE) || defined(CHSIZE) || defined(F_FREESP)
+#ifdef TRUNCATE
+    if ((arg[1].arg_type & A_MASK) == A_WORD) {
+	tmpstab = arg[1].arg_ptr.arg_stab;
+	if (!stab_io(tmpstab) ||
+	  ftruncate(fileno(stab_io(tmpstab)->ifp), len) < 0)
+	    result = 0;
+    }
+    else if (truncate(str_get(ary->ary_array[sp]), len) < 0)
+	result = 0;
+#else
+#ifndef CHSIZE
+#define chsize(f,l) fcntl(f,F_FREESP,l)
+#endif
+    if ((arg[1].arg_type & A_MASK) == A_WORD) {
+	tmpstab = arg[1].arg_ptr.arg_stab;
+	if (!stab_io(tmpstab) ||
+	  chsize(fileno(stab_io(tmpstab)->ifp), len) < 0)
+	    result = 0;
+    }
+    else {
+	int tmpfd;
+
+	if ((tmpfd = open(str_get(ary->ary_array[sp]), 0)) < 0)
+	    result = 0;
+	else {
+	    if (chsize(tmpfd, len) < 0)
+		result = 0;
+	    close(tmpfd);
+	}
+    }
+#endif
+
+    if (result)
+	str_sset(str,&str_yes);
+    else
+	str_sset(str,&str_undef);
+    STABSET(str);
+    ary->ary_array[sp] = str;
+    return sp;
+#else
+    fatal("truncate not implemented");
+#endif
+}
+
+int
 looks_like_number(str)
 STR *str;
 {
@@ -687,11 +771,13 @@ FILE *fp;
 	return FALSE;
     }
     if (!str)
-	return FALSE;
+	return TRUE;
     if (ofmt &&
       ((str->str_nok && str->str_u.str_nval != 0.0)
-       || (looks_like_number(str) && str_gnum(str) != 0.0) ) )
+       || (looks_like_number(str) && str_gnum(str) != 0.0) ) ) {
 	fprintf(fp, ofmt, str->str_u.str_nval);
+	return !ferror(fp);
+    }
     else {
 	tmps = str_get(str);
 	if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'a' && tmps[3] == 'b'
@@ -700,7 +786,7 @@ FILE *fp;
 	    str = ((STAB*)str)->str_magic;
 	    putc('*',fp);
 	}
-	if (str->str_cur && fwrite(tmps,1,str->str_cur,fp) == 0)
+	if (str->str_cur && (fwrite(tmps,1,str->str_cur,fp) == 0 || ferror(fp)))
 	    return FALSE;
     }
     return TRUE;
@@ -731,7 +817,7 @@ int *arglast;
 	retval = (items <= 0);
 	for (; items > 0; items--,st++) {
 	    if (retval && ofslen) {
-		if (fwrite(ofs, 1, ofslen, fp) == 0) {
+		if (fwrite(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
 		    retval = FALSE;
 		    break;
 		}
@@ -740,7 +826,7 @@ int *arglast;
 		break;
 	}
 	if (retval && orslen)
-	    if (fwrite(ors, 1, orslen, fp) == 0)
+	    if (fwrite(ors, 1, orslen, fp) == 0 || ferror(fp))
 		retval = FALSE;
     }
     return retval;
@@ -898,15 +984,29 @@ int *arglast;
     return FALSE;
 }
 
+static char **Argv = Null(char **);
+static char *Cmd = Nullch;
+
+int
+do_execfree()
+{
+    if (Argv) {
+	Safefree(Argv);
+	Argv = Null(char **);
+    }
+    if (Cmd) {
+	Safefree(Cmd);
+	Cmd = Nullch;
+    }
+}
+
 bool
 do_exec(cmd)
 char *cmd;
 {
     register char **a;
     register char *s;
-    char **argv;
     char flags[10];
-    char *cmd2;
 
 #ifdef TAINT
     taintenv();
@@ -958,10 +1058,10 @@ char *cmd;
 	    return FALSE;
 	}
     }
-    New(402,argv, (s - cmd) / 2 + 2, char*);
-    cmd2 = nsavestr(cmd, s-cmd);
-    a = argv;
-    for (s = cmd2; *s;) {
+    New(402,Argv, (s - cmd) / 2 + 2, char*);
+    Cmd = nsavestr(cmd, s-cmd);
+    a = Argv;
+    for (s = Cmd; *s;) {
 	while (*s && isspace(*s)) s++;
 	if (*s)
 	    *(a++) = s;
@@ -970,16 +1070,14 @@ char *cmd;
 	    *s++ = '\0';
     }
     *a = Nullch;
-    if (argv[0]) {
-	execvp(argv[0],argv);
+    if (Argv[0]) {
+	execvp(Argv[0],Argv);
 	if (errno == ENOEXEC) {		/* for system V NIH syndrome */
-	    Safefree(argv);
-	    Safefree(cmd2);
+	    do_execfree();
 	    goto doshell;
 	}
     }
-    Safefree(cmd2);
-    Safefree(argv);
+    do_execfree();
     return FALSE;
 }
 
@@ -1250,11 +1348,11 @@ int *arglast;
     switch (optype) {
     case O_GETSOCKNAME:
 	if (getsockname(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
-	    goto nuts;
+	    goto nuts2;
 	break;
     case O_GETPEERNAME:
 	if (getpeername(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
-	    goto nuts;
+	    goto nuts2;
 	break;
     }
     
@@ -1263,6 +1361,7 @@ int *arglast;
 nuts:
     if (dowarn)
 	warn("get{sock,peer}name() on closed fd");
+nuts2:
     st[sp] = &str_undef;
     return sp;
 
@@ -1522,6 +1621,9 @@ int *arglast;
     return sp;
 }
 
+#endif /* SOCKET */
+
+#ifdef SELECT
 int
 do_select(gimme,arglast)
 int gimme;
@@ -1581,7 +1683,7 @@ int *arglast;
 	j = str->str_len;
 	if (j < growsize) {
 	    if (str->str_pok) {
-		str_grow(str,growsize);
+		Str_Grow(str,growsize);
 		s = str_get(str) + j;
 		while (++j <= growsize) {
 		    *s++ = '\0';
@@ -1651,7 +1753,9 @@ int *arglast;
     }
     return sp;
 }
+#endif /* SELECT */
 
+#ifdef SOCKET
 int
 do_spair(stab1, stab2, arglast)
 STAB *stab1;
@@ -1711,13 +1815,11 @@ int *arglast;
 #ifdef I_PWD
     register ARRAY *ary = stack;
     register int sp = arglast[0];
-    register char **elem;
     register STR *str;
     struct passwd *getpwnam();
     struct passwd *getpwuid();
     struct passwd *getpwent();
     struct passwd *pwent;
-    unsigned long len;
 
     if (gimme != G_ARRAY) {
 	astore(ary, ++sp, str_static(&str_undef));
@@ -1797,7 +1899,6 @@ int *arglast;
     struct group *getgrgid();
     struct group *getgrent();
     struct group *grent;
-    unsigned long len;
 
     if (gimme != G_ARRAY) {
 	astore(ary, ++sp, str_static(&str_undef));
@@ -1895,6 +1996,11 @@ int *arglast;
 #endif
 	}
 	break;
+#if MACH
+    case O_TELLDIR:
+    case O_SEEKDIR:
+        goto nope;
+#else
     case O_TELLDIR:
 	st[sp] = str_static(&str_undef);
 	str_numset(st[sp], (double)telldir(stio->dirp));
@@ -1904,6 +2010,7 @@ int *arglast;
 	along = (long)str_gnum(st[sp+1]);
 	(void)seekdir(stio->dirp,along);
 	break;
+#endif
     case O_REWINDDIR:
 	st[sp] = str_static(&str_undef);
 	(void)rewinddir(stio->dirp);
diff --git a/lib/ctime.pl b/lib/ctime.pl
index d3b03545ca..f910db757d 100644
--- a/lib/ctime.pl
+++ b/lib/ctime.pl
@@ -10,7 +10,7 @@
 ;# usage:
 ;#
 ;#     #include <ctime.pl>          # see the -P and -I option in perl.man
-;#     $Date = do ctime(time);
+;#     $Date = &ctime(time);
 
 @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
 @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
diff --git a/patchlevel.h b/patchlevel.h
index 37c7e3100a..49ea5df60a 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 20
+#define PATCHLEVEL 21
diff --git a/usub/curses.mus b/usub/curses.mus
new file mode 100644
index 0000000000..9973684d12
--- /dev/null
+++ b/usub/curses.mus
@@ -0,0 +1,673 @@
+/* $Header: curses.mus,v 3.0.1.1 90/08/09 04:05:21 lwall Locked $
+ *
+ * $Log:	curses.mus,v $
+ * Revision 3.0.1.1  90/08/09  04:05:21  lwall
+ * patch19: Initial revision
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+extern int wantarray;
+
+char *savestr();
+
+#include <curses.h>
+
+static enum uservars {
+    UV_curscr,
+    UV_stdscr,
+    UV_Def_term,
+    UV_My_term,
+    UV_ttytype,
+    UV_LINES,
+    UV_COLS,
+    UV_ERR,
+    UV_OK,
+};
+
+static enum usersubs {
+    US_addch,
+    US_waddch,
+    US_addstr,
+    US_waddstr,
+    US_box,
+    US_clear,
+    US_wclear,
+    US_clearok,
+    US_clrtobot,
+    US_wclrtobot,
+    US_clrtoeol,
+    US_wclrtoeol,
+    US_delch,
+    US_wdelch,
+    US_deleteln,
+    US_wdeleteln,
+    US_erase,
+    US_werase,
+    US_flushok,
+    US_idlok,
+    US_insch,
+    US_winsch,
+    US_insertln,
+    US_winsertln,
+    US_move,
+    US_wmove,
+    US_overlay,
+    US_overwrite,
+    US_printw,
+    US_wprintw,
+    US_refresh,
+    US_wrefresh,
+    US_standout,
+    US_wstandout,
+    US_standend,
+    US_wstandend,
+    US_cbreak,
+    US_nocbreak,
+    US_echo,
+    US_noecho,
+    US_getch,
+    US_wgetch,
+    US_getstr,
+    US_wgetstr,
+    US_raw,
+    US_noraw,
+    US_scanw,
+    US_wscanw,
+    US_baudrate,
+    US_delwin,
+    US_endwin,
+    US_erasechar,
+    US_getcap,
+    US_getyx,
+    US_inch,
+    US_winch,
+    US_initscr,
+    US_killchar,
+    US_leaveok,
+    US_longname,
+    US_fullname,
+    US_mvwin,
+    US_newwin,
+    US_nl,
+    US_nonl,
+    US_scrollok,
+    US_subwin,
+    US_touchline,
+    US_touchoverlap,
+    US_touchwin,
+    US_unctrl,
+    US_gettmode,
+    US_mvcur,
+    US_scroll,
+    US_savetty,
+    US_resetty,
+    US_setterm,
+    US_tstp,
+    US__putchar,
+};
+
+static int usersub();
+static int userset();
+static int userval();
+
+int
+init_curses()
+{
+    struct ufuncs uf;
+    char *filename = "curses.c";
+
+    uf.uf_set = userset;
+    uf.uf_val = userval;
+
+#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
+
+    MAGICVAR("curscr",	UV_curscr);
+    MAGICVAR("stdscr",	UV_stdscr);
+    MAGICVAR("Def_term",UV_Def_term);
+    MAGICVAR("My_term",	UV_My_term);
+    MAGICVAR("ttytype",	UV_ttytype);
+    MAGICVAR("LINES",	UV_LINES);
+    MAGICVAR("COLS",	UV_COLS);
+    MAGICVAR("ERR",	UV_ERR);
+    MAGICVAR("OK",	UV_OK);
+
+    make_usub("addch",		US_addch,	usersub, filename);
+    make_usub("waddch",		US_waddch,	usersub, filename);
+    make_usub("addstr",		US_addstr,	usersub, filename);
+    make_usub("waddstr",	US_waddstr,	usersub, filename);
+    make_usub("box",		US_box,		usersub, filename);
+    make_usub("clear",		US_clear,	usersub, filename);
+    make_usub("wclear",		US_wclear,	usersub, filename);
+    make_usub("clearok",	US_clearok,	usersub, filename);
+    make_usub("clrtobot",	US_clrtobot,	usersub, filename);
+    make_usub("wclrtobot",	US_wclrtobot,	usersub, filename);
+    make_usub("clrtoeol",	US_clrtoeol,	usersub, filename);
+    make_usub("wclrtoeol",	US_wclrtoeol,	usersub, filename);
+    make_usub("delch",		US_delch,	usersub, filename);
+    make_usub("wdelch",		US_wdelch,	usersub, filename);
+    make_usub("deleteln",	US_deleteln,	usersub, filename);
+    make_usub("wdeleteln",	US_wdeleteln,	usersub, filename);
+    make_usub("erase",		US_erase,	usersub, filename);
+    make_usub("werase",		US_werase,	usersub, filename);
+    make_usub("flushok",	US_flushok,	usersub, filename);
+    make_usub("idlok",		US_idlok,	usersub, filename);
+    make_usub("insch",		US_insch,	usersub, filename);
+    make_usub("winsch",		US_winsch,	usersub, filename);
+    make_usub("insertln",	US_insertln,	usersub, filename);
+    make_usub("winsertln",	US_winsertln,	usersub, filename);
+    make_usub("move",		US_move,	usersub, filename);
+    make_usub("wmove",		US_wmove,	usersub, filename);
+    make_usub("overlay",	US_overlay,	usersub, filename);
+    make_usub("overwrite",	US_overwrite,	usersub, filename);
+    make_usub("printw",		US_printw,	usersub, filename);
+    make_usub("wprintw",	US_wprintw,	usersub, filename);
+    make_usub("refresh",	US_refresh,	usersub, filename);
+    make_usub("wrefresh",	US_wrefresh,	usersub, filename);
+    make_usub("standout",	US_standout,	usersub, filename);
+    make_usub("wstandout",	US_wstandout,	usersub, filename);
+    make_usub("standend",	US_standend,	usersub, filename);
+    make_usub("wstandend",	US_wstandend,	usersub, filename);
+    make_usub("cbreak",		US_cbreak,	usersub, filename);
+    make_usub("nocbreak",	US_nocbreak,	usersub, filename);
+    make_usub("echo",		US_echo,	usersub, filename);
+    make_usub("noecho",		US_noecho,	usersub, filename);
+    make_usub("getch",		US_getch,	usersub, filename);
+    make_usub("wgetch",		US_wgetch,	usersub, filename);
+    make_usub("getstr",		US_getstr,	usersub, filename);
+    make_usub("wgetstr",	US_wgetstr,	usersub, filename);
+    make_usub("raw",		US_raw,		usersub, filename);
+    make_usub("noraw",		US_noraw,	usersub, filename);
+    make_usub("scanw",		US_scanw,	usersub, filename);
+    make_usub("wscanw",		US_wscanw,	usersub, filename);
+    make_usub("baudrate",	US_baudrate,	usersub, filename);
+    make_usub("delwin",		US_delwin,	usersub, filename);
+    make_usub("endwin",		US_endwin,	usersub, filename);
+    make_usub("erasechar",	US_erasechar,	usersub, filename);
+    make_usub("getcap",		US_getcap,	usersub, filename);
+    make_usub("getyx",		US_getyx,	usersub, filename);
+    make_usub("inch",		US_inch,	usersub, filename);
+    make_usub("winch",		US_winch,	usersub, filename);
+    make_usub("initscr",	US_initscr,	usersub, filename);
+    make_usub("killchar",	US_killchar,	usersub, filename);
+    make_usub("leaveok",	US_leaveok,	usersub, filename);
+    make_usub("longname",	US_longname,	usersub, filename);
+    make_usub("fullname",	US_fullname,	usersub, filename);
+    make_usub("mvwin",		US_mvwin,	usersub, filename);
+    make_usub("newwin",		US_newwin,	usersub, filename);
+    make_usub("nl",		US_nl,		usersub, filename);
+    make_usub("nonl",		US_nonl,	usersub, filename);
+    make_usub("scrollok",	US_scrollok,	usersub, filename);
+    make_usub("subwin",		US_subwin,	usersub, filename);
+    make_usub("touchline",	US_touchline,	usersub, filename);
+    make_usub("touchoverlap",	US_touchoverlap,usersub, filename);
+    make_usub("touchwin",	US_touchwin,	usersub, filename);
+    make_usub("unctrl",		US_unctrl,	usersub, filename);
+    make_usub("gettmode",	US_gettmode,	usersub, filename);
+    make_usub("mvcur",		US_mvcur,	usersub, filename);
+    make_usub("scroll",		US_scroll,	usersub, filename);
+    make_usub("savetty",	US_savetty,	usersub, filename);
+    make_usub("resetty",	US_resetty,	usersub, filename);
+    make_usub("setterm",	US_setterm,	usersub, filename);
+    make_usub("tstp",		US_tstp,	usersub, filename);
+    make_usub("_putchar",	US__putchar,	usersub, filename);
+};
+
+static int
+usersub(ix, sp, items)
+int ix;
+register int sp;
+register int items;
+{
+    STR **st = stack->ary_array + sp;
+    register int i;
+    register char *tmps;
+    register STR *Str;		/* used in str_get and str_gnum macros */
+
+    switch (ix) {
+CASE int addch
+I	char		ch
+END
+
+CASE int waddch
+I	WINDOW*		win
+I	char		ch
+END
+
+CASE int addstr
+I	char*		str
+END
+
+CASE int waddstr
+I	WINDOW*		win
+I	char*		str
+END
+
+CASE int box
+I	WINDOW*		win
+I	char		vert
+I	char		hor
+END
+
+CASE int clear
+END
+
+CASE int wclear
+I	WINDOW*		win
+END
+
+CASE int clearok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE int clrtobot
+END
+
+CASE int wclrtobot
+I	WINDOW*		win
+END
+
+CASE int clrtoeol
+END
+
+CASE int wclrtoeol
+I	WINDOW*		win
+END
+
+CASE int delch
+END
+
+CASE int wdelch
+I	WINDOW*		win
+END
+
+CASE int deleteln
+END
+
+CASE int wdeleteln
+I	WINDOW*		win
+END
+
+CASE int erase
+END
+
+CASE int werase
+I	WINDOW*		win
+END
+
+CASE int flushok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE int idlok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE int insch
+I	char		c
+END
+
+CASE int winsch
+I	WINDOW*		win
+I	char		c
+END
+
+CASE int insertln
+END
+
+CASE int winsertln
+I	WINDOW*		win
+END
+
+CASE int move
+I	int		y
+I	int		x
+END
+
+CASE int wmove
+I	WINDOW*		win
+I	int		y
+I	int		x
+END
+
+CASE int overlay
+I	WINDOW*		win1
+I	WINDOW*		win2
+END
+
+CASE int overwrite
+I	WINDOW*		win1
+I	WINDOW*		win2
+END
+
+    case US_printw:
+	if (items < 1)
+	    fatal("Usage: &printw($fmt, $arg1, $arg2, ... )");
+	else {
+	    int retval;
+	    STR*	str =		str_new(0);
+
+	    do_sprintf(str, items - 1, st + 1);
+	    retval = addstr(str->str_ptr);
+	    str_numset(st[0], (double) retval);
+	    str_free(str);
+	}
+	return sp;
+
+    case US_wprintw:
+	if (items < 2)
+	    fatal("Usage: &wprintw($win, $fmt, $arg1, $arg2, ... )");
+	else {
+	    int retval;
+	    STR*	str =		str_new(0);
+	    WINDOW*	win =		*(WINDOW**)	str_get(st[1]);
+
+	    do_sprintf(str, items - 1, st + 1);
+	    retval = waddstr(win, str->str_ptr);
+	    str_numset(st[0], (double) retval);
+	    str_free(str);
+	}
+	return sp;
+
+CASE int refresh
+END
+
+CASE int wrefresh
+I	WINDOW*		win
+END
+
+CASE int standout
+END
+
+CASE int wstandout
+I	WINDOW*		win
+END
+
+CASE int standend
+END
+
+CASE int wstandend
+I	WINDOW*		win
+END
+
+CASE int cbreak
+END
+
+CASE int nocbreak
+END
+
+CASE int echo
+END
+
+CASE int noecho
+END
+
+    case US_getch:
+        if (items != 0)
+            fatal("Usage: &getch()");
+        else {
+            int retval;
+	    char retch;
+
+            retval = getch();
+	    if (retval == EOF)
+		st[0] = &str_undef;
+	    else {
+		retch = retval;
+		str_nset(st[0], &retch, 1);
+	    }
+        }
+        return sp;
+
+    case US_wgetch:
+        if (items != 1)
+            fatal("Usage: &wgetch($win)");
+        else {
+            int retval;
+	    char retch;
+            WINDOW*     win =           *(WINDOW**)     str_get(st[1]);
+
+            retval = wgetch(win);
+	    if (retval == EOF)
+		st[0] = &str_undef;
+	    else {
+		retch = retval;
+		str_nset(st[0], &retch, 1);
+	    }
+        }
+        return sp;
+
+CASE int getstr
+IO	char*		str
+END
+
+CASE int wgetstr
+I	WINDOW*		win
+IO	char*		str
+END
+
+CASE int raw
+END
+
+CASE int noraw
+END
+
+CASE int baudrate
+END
+
+CASE int delwin
+I	WINDOW*		win
+END
+
+CASE int endwin
+END
+
+CASE int erasechar
+END
+
+CASE char* getcap
+I	char*		str
+END
+
+    case US_getyx:
+	if (items != 3)
+	    fatal("Usage: &getyx($win, $y, $x)");
+	else {
+	    int retval;
+	    STR*	str =		str_new(0);
+	    WINDOW*	win =		*(WINDOW**)	str_get(st[1]);
+	    int		y;
+	    int		x;
+
+	    do_sprintf(str, items - 1, st + 1);
+	    retval = getyx(win, y, x);
+	    str_numset(st[2], (double)y);
+	    str_numset(st[3], (double)x);
+	    str_numset(st[0], (double) retval);
+	    str_free(str);
+	}
+	return sp;
+
+	
+CASE int inch
+END
+
+CASE int winch
+I	WINDOW*		win
+END
+
+CASE WINDOW* initscr
+END
+
+CASE int killchar
+END
+
+CASE int leaveok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE char* longname
+I	char*		termbuf
+IO	char*		name
+END
+
+CASE int fullname
+I	char*		termbuf
+IO	char*		name
+END
+
+CASE int mvwin
+I	WINDOW*		win
+I	int		y
+I	int		x
+END
+
+CASE WINDOW* newwin
+I	int		lines
+I	int		cols
+I	int		begin_y
+I	int		begin_x
+END
+
+CASE int nl
+END
+
+CASE int nonl
+END
+
+CASE int scrollok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE WINDOW* subwin
+I	WINDOW*		win
+I	int		lines
+I	int		cols
+I	int		begin_y
+I	int		begin_x
+END
+
+CASE int touchline
+I	WINDOW*		win
+I	int		y
+I	int		startx
+I	int		endx
+END
+
+CASE int touchoverlap
+I	WINDOW*		win1
+I	WINDOW*		win2
+END
+
+CASE int touchwin
+I	WINDOW*		win
+END
+
+CASE char* unctrl
+I	char		ch
+END
+
+CASE int gettmode
+END
+
+CASE int mvcur
+I	int		lasty
+I	int		lastx
+I	int		newy
+I	int		newx
+END
+
+CASE int scroll
+I	WINDOW*		win
+END
+
+CASE int savetty
+END
+
+CASE void resetty
+END
+
+CASE int setterm
+I	char*		name
+END
+
+CASE int tstp
+END
+
+CASE int _putchar
+I	char		ch
+END
+
+    default:
+	fatal("Unimplemented user-defined subroutine");
+    }
+    return sp;
+}
+
+static int
+userval(ix, str)
+int ix;
+STR *str;
+{
+    switch (ix) {
+    case UV_COLS:
+	str_numset(str, (double)COLS);
+	break;
+    case UV_Def_term:
+	str_set(str, Def_term);
+	break;
+    case UV_ERR:
+	str_numset(str, (double)ERR);
+	break;
+    case UV_LINES:
+	str_numset(str, (double)LINES);
+	break;
+    case UV_My_term:
+	str_numset(str, (double)My_term);
+	break;
+    case UV_OK:
+	str_numset(str, (double)OK);
+	break;
+    case UV_curscr:
+	str_nset(str, &curscr, sizeof(WINDOW*));
+	break;
+    case UV_stdscr:
+	str_nset(str, &stdscr, sizeof(WINDOW*));
+	break;
+    case UV_ttytype:
+	str_set(str, ttytype);
+	break;
+    }
+    return 0;
+}
+
+static int
+userset(ix, str)
+int ix;
+STR *str;
+{
+    switch (ix) {
+    case UV_COLS:
+	COLS = (int)str_gnum(str);
+	break;
+    case UV_Def_term:
+	Def_term = savestr(str_get(str));	/* never freed */
+	break;
+    case UV_LINES:
+	LINES = (int)str_gnum(str);
+	break;
+    case UV_My_term:
+	My_term = (bool)str_gnum(str);
+	break;
+    case UV_ttytype:
+	strcpy(ttytype, str_get(str));		/* hope it fits */
+	break;
+    }
+    return 0;
+}