perl 3.0 patch #39 patch #38, continued

See patch #38.

16 files changed, 535 insertions, 147 deletions

diff --git a/doarg.c b/doarg.c
index 768c6c38ee..a35dde12cf 100644
--- a/doarg.c
+++ b/doarg.c
@@ -1,4 +1,4 @@
-/* $Header: doarg.c,v 3.0.1.8 90/10/15 16:04:04 lwall Locked $
+/* $Header: doarg.c,v 3.0.1.9 90/11/10 01:14:31 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	doarg.c,v $
+ * Revision 3.0.1.9  90/11/10  01:14:31  lwall
+ * patch38: random cleanup
+ * patch38: optimized join('',...)
+ * patch38: printf cleaned up
+ * 
  * Revision 3.0.1.8  90/10/15  16:04:04  lwall
  * patch29: @ENV = () now works
  * patch29: added caller
@@ -399,9 +404,15 @@ int *arglast;
 	str_sset(str,*st++);
     else
 	str_set(str,"");
-    for (; items > 0; items--,st++) {
-	str_ncat(str,delim,delimlen);
-	str_scat(str,*st);
+    if (delimlen) {
+	for (; items > 0; items--,st++) {
+	    str_ncat(str,delim,delimlen);
+	    str_scat(str,*st);
+	}
+    }
+    else {
+	for (; items > 0; items--,st++)
+	    str_scat(str,*st);
     }
     STABSET(str);
 }
@@ -465,9 +476,9 @@ int *arglast;
 	    break;
 	case 'X':
 	  shrink:
-	    str->str_cur -= len;
-	    if (str->str_cur < 0)
+	    if (str->str_cur < len)
 		fatal("X outside of string");
+	    str->str_cur -= len;
 	    str->str_ptr[str->str_cur] = '\0';
 	    break;
 	case 'x':
@@ -651,6 +662,7 @@ register STR **sarg;
 {
     register char *s;
     register char *t;
+    register char *f;
     bool dolong;
     char ch;
     static STR *sargnull = &str_no;
@@ -662,49 +674,46 @@ register STR **sarg;
 
     str_set(str,"");
     len--;			/* don't count pattern string */
-    origs = s = str_get(*sarg);
+    origs = t = s = str_get(*sarg);
     send = s + (*sarg)->str_cur;
     sarg++;
-    for ( ; s < send; len--) {
+    for ( ; ; len--) {
 	if (len <= 0 || !*sarg) {
 	    sarg = &sargnull;
 	    len = 0;
 	}
-	dolong = FALSE;
-	for (t = s; t < send && *t != '%'; t++) ;
+	for ( ; t < send && *t != '%'; t++) ;
 	if (t >= send)
-	    break;		/* not enough % patterns, oh well */
-	for (t++; *sarg && t < send && t != s; t++) {
+	    break;		/* end of format string, ignore extra args */
+	f = t;
+	*buf = '\0';
+	xs = buf;
+	dolong = FALSE;
+	for (t++; t < send; t++) {
 	    switch (*t) {
 	    default:
 		ch = *(++t);
 		*t = '\0';
-		(void)sprintf(buf,s);
-		s = t;
-		*(t--) = ch;
+		(void)sprintf(xs,f);
 		len++;
 		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 '+':
-		break;
+	    case '.': case '#': case '-': case '+': case ' ':
+		continue;
 	    case 'l':
 		dolong = TRUE;
-		break;
+		continue;
 	    case 'c':
 		ch = *(++t);
 		*t = '\0';
 		xlen = (int)str_gnum(*(sarg++));
-		if (strEQ(t-2,"%c")) {	/* some printfs fail on null chars */
-		    *buf = xlen;
-		    str_ncat(str,s,t - s - 2);
-		    str_ncat(str,buf,1);  /* so handle simple case */
-		    *buf = '\0';
+		if (strEQ(f,"%c")) { /* some printfs fail on null chars */
+		    *xs = xlen;
+		    xs[1] = '\0';
 		}
 		else
-		    (void)sprintf(buf,s,xlen);
-		s = t;
-		*(t--) = ch;
+		    (void)sprintf(xs,f,xlen);
 		break;
 	    case 'D':
 		dolong = TRUE;
@@ -713,11 +722,9 @@ register STR **sarg;
 		ch = *(++t);
 		*t = '\0';
 		if (dolong)
-		    (void)sprintf(buf,s,(long)str_gnum(*(sarg++)));
+		    (void)sprintf(xs,f,(long)str_gnum(*(sarg++)));
 		else
-		    (void)sprintf(buf,s,(int)str_gnum(*(sarg++)));
-		s = t;
-		*(t--) = ch;
+		    (void)sprintf(xs,f,(int)str_gnum(*(sarg++)));
 		break;
 	    case 'X': case 'O':
 		dolong = TRUE;
@@ -727,18 +734,14 @@ register STR **sarg;
 		*t = '\0';
 		value = str_gnum(*(sarg++));
 		if (dolong)
-		    (void)sprintf(buf,s,U_L(value));
+		    (void)sprintf(xs,f,U_L(value));
 		else
-		    (void)sprintf(buf,s,U_I(value));
-		s = t;
-		*(t--) = ch;
+		    (void)sprintf(xs,f,U_I(value));
 		break;
 	    case 'E': case 'e': case 'f': case 'G': case 'g':
 		ch = *(++t);
 		*t = '\0';
-		(void)sprintf(buf,s,str_gnum(*(sarg++)));
-		s = t;
-		*(t--) = ch;
+		(void)sprintf(xs,f,str_gnum(*(sarg++)));
 		break;
 	    case 's':
 		ch = *(++t);
@@ -756,37 +759,27 @@ register STR **sarg;
 		    xlen = strlen(tokenbuf);
 		    str_free(tmpstr);
 		}
-		if (strEQ(t-2,"%s")) {	/* some printfs fail on >128 chars */
-		    *buf = '\0';
-		    str_ncat(str,s,t - s - 2);
-		    *t = ch;
-		    str_ncat(str,xs,xlen);  /* so handle simple case */
-		}
-		else {
-		    if (origs == xs) {		/* sprintf($s,...$s...) */
-			strcpy(tokenbuf+64,s);
-			s = tokenbuf+64;
-			*t = ch;
-		    }
-		    (void)sprintf(buf,s,xs);
-		}
 		sarg++;
-		s = t;
-		*(t--) = ch;
+		if (strEQ(f,"%s")) {	/* some printfs fail on >128 chars */
+		    break;		/* so handle simple case */
+		}
+		strcpy(tokenbuf+64,f);	/* sprintf($s,...$s...) */
+		*t = ch;
+		(void)sprintf(buf,tokenbuf+64,xs);
+		xs = buf;
 		break;
 	    }
-	}
-	if (s < t && t >= send) {
-	    str_cat(str,s);
+	    /* end of switch, copy results */
+	    *t = ch;
+	    xlen = strlen(xs);
+	    STR_GROW(str, str->str_cur + (f - s) + len + 1);
+	    str_ncat(str, s, f - s);
+	    str_ncat(str, xs, xlen);
 	    s = t;
-	    break;
+	    break;		/* break from for loop */
 	}
-	str_cat(str,buf);
-    }
-    if (*s) {
-	(void)sprintf(buf,s,0,0,0,0);
-	str_cat(str,buf);
     }
+    str_ncat(str, s, t - s);
     STABSET(str);
 }
 
diff --git a/doio.c b/doio.c
index 54d01cfa81..789521353d 100644
--- a/doio.c
+++ b/doio.c
@@ -1,4 +1,4 @@
-/* $Header: doio.c,v 3.0.1.12 90/10/20 02:04:18 lwall Locked $
+/* $Header: doio.c,v 3.0.1.13 90/11/10 01:17:37 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	doio.c,v $
+ * Revision 3.0.1.13  90/11/10  01:17:37  lwall
+ * patch38: -e _ was wrong if last stat failed
+ * patch38: more msdos/os2 upgrades
+ * 
  * Revision 3.0.1.12  90/10/20  02:04:18  lwall
  * patch37: split out separate Sys V IPC features
  * 
@@ -112,6 +116,8 @@
 #include <fcntl.h>
 #endif
 
+int laststatval = -1;
+
 bool
 do_open(stab,name,len)
 STAB *stab;
@@ -598,11 +604,15 @@ STR *argstr;
     if (optype == O_IOCTL)
 	retval = ioctl(fileno(stio->ifp), func, s);
     else
+#ifdef MSDOS
+	fatal("fcntl is not implemented");
+#else
 #ifdef I_FCNTL
 	retval = fcntl(fileno(stio->ifp), func, s);
 #else
 	fatal("fcntl is not implemented");
 #endif
+#endif
 #else /* lint */
     retval = 0;
 #endif /* lint */
@@ -625,7 +635,6 @@ int *arglast;
     register ARRAY *ary = stack;
     register int sp = arglast[0] + 1;
     int max = 13;
-    register int i;
 
     if ((arg[1].arg_type & A_MASK) == A_WORD) {
 	tmpstab = arg[1].arg_ptr.arg_stab;
@@ -635,19 +644,22 @@ int *arglast;
 	    if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
 	      fstat(fileno(stab_io(tmpstab)->ifp),&statcache) < 0) {
 		max = 0;
+		laststatval = -1;
 	    }
 	}
+	else if (laststatval < 0)
+	    max = 0;
     }
     else {
 	str_sset(statname,ary->ary_array[sp]);
 	statstab = Nullstab;
 #ifdef LSTAT
 	if (arg->arg_type == O_LSTAT)
-	    i = lstat(str_get(statname),&statcache);
+	    laststatval = lstat(str_get(statname),&statcache);
 	else
 #endif
-	    i = stat(str_get(statname),&statcache);
-	if (i < 0)
+	    laststatval = stat(str_get(statname),&statcache);
+	if (laststatval < 0)
 	    max = 0;
     }
 
@@ -941,23 +953,23 @@ STR *str;
 	if (stio && stio->ifp) {
 	    statstab = arg[1].arg_ptr.arg_stab;
 	    str_set(statname,"");
-	    return fstat(fileno(stio->ifp), &statcache);
+	    return (laststatval = fstat(fileno(stio->ifp), &statcache));
 	}
 	else {
 	    if (arg[1].arg_ptr.arg_stab == defstab)
-		return 0;
+		return laststatval;
 	    if (dowarn)
 		warn("Stat on unopened file <%s>",
 		  stab_name(arg[1].arg_ptr.arg_stab));
 	    statstab = Nullstab;
 	    str_set(statname,"");
-	    return -1;
+	    return (laststatval = -1);
 	}
     }
     else {
 	statstab = Nullstab;
 	str_sset(statname,str);
-	return stat(str_get(str),&statcache);
+	return (laststatval = stat(str_get(str),&statcache));
     }
 }
 
diff --git a/dolist.c b/dolist.c
index fa970a14b1..c2822e3b10 100644
--- a/dolist.c
+++ b/dolist.c
@@ -1,4 +1,4 @@
-/* $Header: dolist.c,v 3.0.1.10 90/10/15 16:19:48 lwall Locked $
+/* $Header: dolist.c,v 3.0.1.11 90/11/10 01:29:49 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	dolist.c,v $
+ * Revision 3.0.1.11  90/11/10  01:29:49  lwall
+ * patch38: temp string values are now copied less often
+ * patch38: sort parameters are now in the right package
+ * 
  * Revision 3.0.1.10  90/10/15  16:19:48  lwall
  * patch29: added caller
  * patch29: added scalar reverse
@@ -376,11 +380,10 @@ int *arglast;
 	    for (m = s; m < strend && !isspace(*m); m++) ;
 	    if (m >= strend)
 		break;
-	    if (realarray)
-		dstr = Str_new(30,m-s);
-	    else
-		dstr = str_static(&str_undef);
+	    dstr = Str_new(30,m-s);
 	    str_nset(dstr,s,m-s);
+	    if (!realarray)
+		str_2static(dstr);
 	    (void)astore(ary, ++sp, dstr);
 	    for (s = m + 1; s < strend && isspace(*s); s++) ;
 	}
@@ -391,11 +394,10 @@ int *arglast;
 	    m++;
 	    if (m >= strend)
 		break;
-	    if (realarray)
-		dstr = Str_new(30,m-s);
-	    else
-		dstr = str_static(&str_undef);
+	    dstr = Str_new(30,m-s);
 	    str_nset(dstr,s,m-s);
+	    if (!realarray)
+		str_2static(dstr);
 	    (void)astore(ary, ++sp, dstr);
 	    s = m;
 	}
@@ -420,11 +422,10 @@ int *arglast;
 		    for (m = s; m < strend && *m != i; m++) ;
 		if (m >= strend)
 		    break;
-		if (realarray)
-		    dstr = Str_new(30,m-s);
-		else
-		    dstr = str_static(&str_undef);
+		dstr = Str_new(30,m-s);
 		str_nset(dstr,s,m-s);
+		if (!realarray)
+		    str_2static(dstr);
 		(void)astore(ary, ++sp, dstr);
 		s = m + 1;
 	    }
@@ -436,11 +437,10 @@ int *arglast;
 		    spat->spat_short)) )
 #endif
 	    {
-		if (realarray)
-		    dstr = Str_new(31,m-s);
-		else
-		    dstr = str_static(&str_undef);
+		dstr = Str_new(31,m-s);
 		str_nset(dstr,s,m-s);
+		if (!realarray)
+		    str_2static(dstr);
 		(void)astore(ary, ++sp, dstr);
 		s = m + i;
 	    }
@@ -459,21 +459,19 @@ int *arglast;
 		strend = s + (strend - m);
 	    }
 	    m = spat->spat_regexp->startp[0];
-	    if (realarray)
-		dstr = Str_new(32,m-s);
-	    else
-		dstr = str_static(&str_undef);
+	    dstr = Str_new(32,m-s);
 	    str_nset(dstr,s,m-s);
+	    if (!realarray)
+		str_2static(dstr);
 	    (void)astore(ary, ++sp, dstr);
 	    if (spat->spat_regexp->nparens) {
 		for (i = 1; i <= spat->spat_regexp->nparens; i++) {
 		    s = spat->spat_regexp->startp[i];
 		    m = spat->spat_regexp->endp[i];
-		    if (realarray)
-			dstr = Str_new(33,m-s);
-		    else
-			dstr = str_static(&str_undef);
+		    dstr = Str_new(33,m-s);
 		    str_nset(dstr,s,m-s);
+		    if (!realarray)
+			str_2static(dstr);
 		    (void)astore(ary, ++sp, dstr);
 		}
 	    }
@@ -487,11 +485,10 @@ int *arglast;
     if (iters > maxiters)
 	fatal("Split loop");
     if (s < strend || origlimit) {	/* keep field after final delim? */
-	if (realarray)
-	    dstr = Str_new(34,strend-s);
-	else
-	    dstr = str_static(&str_undef);
+	dstr = Str_new(34,strend-s);
 	str_nset(dstr,s,strend-s);
+	if (!realarray)
+	    str_2static(dstr);
 	(void)astore(ary, ++sp, dstr);
 	iters++;
     }
@@ -554,11 +551,9 @@ int *arglast;
     register int len;
 
     /* These must not be in registers: */
-    char achar;
     short ashort;
     int aint;
     long along;
-    unsigned char auchar;
     unsigned short aushort;
     unsigned int auint;
     unsigned long aulong;
@@ -1296,9 +1291,7 @@ int *arglast;
 }
 
 int
-do_reverse(str,gimme,arglast)
-STR *str;
-int gimme;
+do_reverse(arglast)
 int *arglast;
 {
     STR **st = stack->ary_array;
@@ -1317,9 +1310,8 @@ int *arglast;
 }
 
 int
-do_sreverse(str,gimme,arglast)
+do_sreverse(str,arglast)
 STR *str;
-int gimme;
 int *arglast;
 {
     STR **st = stack->ary_array;
@@ -1343,6 +1335,7 @@ int *arglast;
 }
 
 static CMD *sortcmd;
+static HASH *sortstash = Null(HASH*);
 static STAB *firststab = Nullstab;
 static STAB *secondstab = Nullstab;
 
@@ -1391,14 +1384,17 @@ int *arglast;
 		fatal("Undefined subroutine \"%s\" in sort", stab_name(stab));
 	    if (!sortstack) {
 		sortstack = anew(Nullstab);
+		astore(sortstack, 0, Nullstr);
+		aclear(sortstack);
 		sortstack->ary_flags = 0;
 	    }
 	    oldstack = stack;
 	    stack = sortstack;
 	    tmps_base = tmps_max;
-	    if (!firststab) {
+	    if (sortstash != stab_stash(stab)) {
 		firststab = stabent("a",TRUE);
 		secondstab = stabent("b",TRUE);
+		sortstash = stab_stash(stab);
 	    }
 	    oldfirst = stab_val(firststab);
 	    oldsecond = stab_val(secondstab);
@@ -1485,7 +1481,7 @@ int *arglast;
 	while (!str->str_nok && str->str_cur <= final->str_cur &&
 	    strNE(str->str_ptr,tmps) ) {
 	    (void)astore(ary, ++sp, str);
-	    str = str_static(str);
+	    str = str_2static(str_smake(str));
 	    str_inc(str);
 	}
 	if (strEQ(str->str_ptr,tmps))
@@ -1537,9 +1533,9 @@ int *arglast;
       str_2static(str_nmake((double)csv->curcmd->c_line)) );
     if (!maxarg)
 	return sp;
-    str = str_static(&str_undef);
+    str = Str_new(49,0);
     stab_fullname(str, csv->stab);
-    (void)astore(stack,++sp, str);
+    (void)astore(stack,++sp, str_2static(str));
     (void)astore(stack,++sp,
       str_2static(str_nmake((double)csv->hasargs)) );
     (void)astore(stack,++sp,
diff --git a/eval.c b/eval.c
index 2020eb73ef..a2de82f6ee 100644
--- a/eval.c
+++ b/eval.c
@@ -1,4 +1,4 @@
-/* $Header: eval.c,v 3.0.1.9 90/10/15 16:46:13 lwall Locked $
+/* $Header: eval.c,v 3.0.1.10 90/11/10 01:33:22 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:	eval.c,v $
+ * Revision 3.0.1.10  90/11/10  01:33:22  lwall
+ * patch38: random cleanup
+ * patch38: couldn't return from sort routine
+ * patch38: added hooks for unexec()
+ * patch38: added alarm function
+ * 
  * Revision 3.0.1.9  90/10/15  16:46:13  lwall
  * patch29: added caller
  * patch29: added scalar
@@ -848,11 +854,9 @@ register int sp;
 	goto array_return;
     case O_REVERSE:
 	if (gimme == G_ARRAY)
-	    sp = do_reverse(str,
-	      gimme,arglast);
+	    sp = do_reverse(arglast);
 	else
-	    sp = do_sreverse(str,
-	      gimme,arglast);
+	    sp = do_sreverse(str, arglast);
 	goto array_return;
     case O_WARN:
 	if (arglast[2] - arglast[1] != 1) {
@@ -1117,7 +1121,7 @@ register int sp;
     case O_RETURN:
 	tmps = "_SUB_";		/* just fake up a "last _SUB_" */
 	optype = O_LAST;
-	if (curcsv->wantarray == G_ARRAY) {
+	if (curcsv && curcsv->wantarray == G_ARRAY) {
 	    lastretstr = Nullstr;
 	    lastspbase = arglast[1];
 	    lastsize = arglast[2] - arglast[1];
@@ -1171,7 +1175,7 @@ register int sp;
 	    goto_targ = Nullch;		/* just restart from top */
 	if (optype == O_DUMP) {
 	    do_undump = 1;
-	    abort();
+	    my_unexec();
 	}
 	longjmp(top_env, 1);
     case O_INDEX:
@@ -1356,6 +1360,18 @@ register int sp;
 	value = (double) (anum & 255);
 #endif
 	goto donumset;
+    case O_ALARM:
+	if (maxarg < 1)
+	    tmps = str_get(stab_val(defstab));
+	else
+	    tmps = str_get(st[1]);
+	if (!tmps)
+	    tmps = "0";
+	anum = alarm((unsigned int)atoi(tmps));
+	if (anum < 0)
+	    goto say_undef;
+	value = (double)anum;
+	goto donumset;
     case O_SLEEP:
 	if (maxarg < 1)
 	    tmps = Nullch;
diff --git a/evalargs.xc b/evalargs.xc
index 09e1a509c7..d6aad79268 100644
--- a/evalargs.xc
+++ b/evalargs.xc
@@ -2,9 +2,12 @@
  * kit sizes from getting too big.
  */
 
-/* $Header: evalargs.xc,v 3.0.1.7 90/10/15 16:48:11 lwall Locked $
+/* $Header: evalargs.xc,v 3.0.1.8 90/11/10 01:35:49 lwall Locked $
  *
  * $Log:	evalargs.xc,v $
+ * Revision 3.0.1.8  90/11/10  01:35:49  lwall
+ * patch38: array slurps are now faster and take less memory
+ * 
  * Revision 3.0.1.7  90/10/15  16:48:11  lwall
  * patch29: non-existent array values no longer cause core dumps
  * patch29: added caller
@@ -245,11 +248,16 @@
 			    astore(stack, sp, Nullstr);
 			    st = stack->ary_array;
 			}
-			st[sp] = str_static(&str_undef);
-			if (str_gets(st[sp],fp,0) == Nullch) {
+			str = st[sp] = Str_new(56,80);
+			if (str_gets(str,fp,0) == Nullch) {
 			    sp--;
 			    break;
 			}
+			if (str->str_len - str->str_cur > 20) {
+			    str->str_len = str->str_cur+1;
+			    Renew(str->str_ptr, str->str_len, char);
+			}
+			str_2static(str);
 		    }
 		}
 		statusvalue = mypclose(fp);
@@ -299,7 +307,7 @@
 	    if (anum > 1)		/* assign to scalar */
 		gimme = G_SCALAR;	/* force context to scalar */
 	    if (gimme == G_ARRAY)
-		str = str_static(&str_undef);
+		str = Str_new(57,0);
 	    ++sp;
 	    fp = Nullfp;
 	    if (stab_io(last_in_stab)) {
@@ -369,6 +377,7 @@
 		record_separator = old_record_separator;
 		if (gimme == G_ARRAY) {
 		    --sp;
+		    str_2static(str);
 		    goto array_return;
 		}
 		break;
@@ -394,11 +403,16 @@
 			goto keepgoing;		/* unmatched wildcard? */
 		}
 		if (gimme == G_ARRAY) {
+		    if (str->str_len - str->str_cur > 20) {
+			str->str_len = str->str_cur+1;
+			Renew(str->str_ptr, str->str_len, char);
+		    }
+		    str_2static(str);
 		    if (++sp > stack->ary_max) {
 			astore(stack, sp, Nullstr);
 			st = stack->ary_array;
 		    }
-		    str = str_static(&str_undef);
+		    str = Str_new(58,80);
 		    goto keepgoing;
 		}
 	    }
diff --git a/h2ph.SH b/h2ph.SH
index fa33efc15a..d31c82ae5d 100644
--- a/h2ph.SH
+++ b/h2ph.SH
@@ -35,7 +35,7 @@ chdir '/usr/include' || die "Can't cd /usr/include";
 %isatype = ('char',1,'short',1,'int',1,'long',1);
 
 foreach $file (@ARGV) {
-    ($outfile = $file) =~ s/\.h$/.ph/;
+    ($outfile = $file) =~ s/\.h$/.ph/ || next;
     print "$file -> $outfile\n";
     if ($file =~ m|^(.*)/|) {
 	$dir = $1;
diff --git a/os2/director.c b/os2/director.c
index a360af712b..d5accd73e1 100644
--- a/os2/director.c
+++ b/os2/director.c
@@ -5,16 +5,19 @@
  *  MS-DOS.  Written by Michael Rendell ({uunet,utai}michael@garfield),
  *  August 1897
  *  Ported to OS/2 by Kai Uwe Rommel
- *  December 1989
+ *  December 1989, February 1990
+ *  Change for HPFS support, October 1990
  */
 
 #include <sys/types.h>
 #include <sys/stat.h>
 #include <sys/dir.h>
 
+#include <stdlib.h>
 #include <stdio.h>
 #include <malloc.h>
 #include <string.h>
+#include <ctype.h>
 
 #define INCL_NOPM
 #include <os2.h>
@@ -29,6 +32,7 @@ static void free_dircontents(struct _dircontents *);
 static HDIR hdir;
 static USHORT count;
 static FILEFINDBUF find;
+static BOOL lower;
 
 
 DIR *opendir(char *name)
@@ -125,7 +129,6 @@ struct direct *readdir(DIR * dirp)
   dp.d_namlen = dp.d_reclen =
     strlen(strcpy(dp.d_name, dirp -> dd_cp -> _d_entry));
 
-  strlwr(dp.d_name);		       /* JF */
   dp.d_ino = 0;
 
   dp.d_size = dirp -> dd_cp -> _d_size;
@@ -176,12 +179,52 @@ static void free_dircontents(struct _dircontents * dp)
 }
 
 
+static int IsFileSystemFAT(char *dir)
+{
+  USHORT nDrive;
+  ULONG lMap;
+  BYTE bData[64], bName[3];
+  USHORT cbData;
+
+  if ( _osmode == DOS_MODE )
+    return TRUE;
+  else
+  {
+    /* We separate FAT and HPFS file systems here.
+     * Filenames read from a FAT system are converted to lower case
+     * while the case of filenames read from a HPFS (and other future
+     * file systems, like Unix-compatibles) is preserved.
+     */
+
+    if ( isalpha(dir[0]) && (dir[1] == ':') )
+      nDrive = toupper(dir[0]) - '@';
+    else
+      DosQCurDisk(&nDrive, &lMap);
+
+    bName[0] = (char) (nDrive + '@');
+    bName[1] = ':';
+    bName[2] = 0;
+
+    cbData = sizeof(bData);
+
+    if ( !DosQFSAttach(bName, 0U, 1U, bData, &cbData, 0L) )
+      return !strcmp(bData + (*(USHORT *) (bData + 2) + 7), "FAT");
+    else
+      return FALSE;
+
+    /* End of this ugly code */
+  }
+}
+
+
 static char *getdirent(char *dir)
 {
   int done;
 
   if (dir != NULL)
   {				       /* get first entry */
+    lower = IsFileSystemFAT(dir);
+
     hdir = HDIR_CREATE;
     count = 1;
     done = DosFindFirst(dir, &hdir, attributes,
@@ -190,6 +233,9 @@ static char *getdirent(char *dir)
   else				       /* get next entry */
     done = DosFindNext(hdir, &find, sizeof(find), &count);
 
+  if ( lower )
+    strlwr(find.achName);
+
   if (done == 0)
     return find.achName;
   else
diff --git a/os2/os2.c b/os2/os2.c
index 279a88f88b..a1a464bf24 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -1,4 +1,4 @@
-/* $Header: os2.c,v 3.0.1.1 90/10/15 17:49:55 lwall Locked $
+/* $Header: os2.c,v 3.0.1.2 90/11/10 01:42:38 lwall Locked $
  *
  *    (C) Copyright 1989, 1990 Diomidis Spinellis.
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	os2.c,v $
+ * Revision 3.0.1.2  90/11/10  01:42:38  lwall
+ * patch38: more msdos/os2 upgrades
+ * 
  * Revision 3.0.1.1  90/10/15  17:49:55  lwall
  * patch29: Initial revision
  * 
@@ -50,7 +53,7 @@ int syscall()
 int chdir(char *path)
 {
   if ( path[0] != 0 && path[1] == ':' )
-    DosSelectDisk(tolower(path[0]) - '@');
+    DosSelectDisk(toupper(path[0]) - '@');
 
   DosChDir(path, 0L);
 }
diff --git a/os2/perl.bad b/os2/perl.bad
index bec21328fc..870785aa52 100644
--- a/os2/perl.bad
+++ b/os2/perl.bad
@@ -4,3 +4,4 @@ DOSKILLPROCESS
 DOSFLAGPROCESS
 DOSSETPRTY
 DOSGETPRTY
+DOSQFSATTACH
diff --git a/os2/perl.cs b/os2/perl.cs
index 530f0930df..416e29c397 100644
--- a/os2/perl.cs
+++ b/os2/perl.cs
@@ -3,11 +3,13 @@ array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c form.c
 hash.c perl.c perly.c regcomp.c regexec.c stab.c str.c util.c
 )
 (-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c{evalargs.xc} toke.c)
-(-W1 -Od -Olt os2.c popen.c mktemp.c director.c suffix.c)
+(-W1 -Od -Olt -I.
+os2\os2.c os2\popen.c os2\mktemp.c os2\director.c os2\suffix.c
+)
 
 setargv.obj
-perl.def
-perl.bad
+os2\perl.def
+os2\perl.bad
 perl.exe
 
--AL -LB -S0x9000
+-AL -LB -S0x8800
diff --git a/os2/perl.def b/os2/perl.def
index 2b49370937..2c990c26aa 100644
--- a/os2/perl.def
+++ b/os2/perl.def
@@ -1,2 +1,2 @@
 NAME PERL WINDOWCOMPAT NEWFILES
-DESCRIPTION 'PERL 3.0, patchlevel 28 - for MS-DOS and OS/2'
+DESCRIPTION 'PERL 3.0, patchlevel 37 - for MS-DOS and OS/2'
diff --git a/patchlevel.h b/patchlevel.h
index 6f96c1efde..314cba1648 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 38
+#define PATCHLEVEL 39
diff --git a/perl.h b/perl.h
index 1c8655b91d..c911e2ba2d 100644
--- a/perl.h
+++ b/perl.h
@@ -1,4 +1,4 @@
-/* $Header: perl.h,v 3.0.1.9 90/10/15 17:59:41 lwall Locked $
+/* $Header: perl.h,v 3.0.1.10 90/11/10 01:44:13 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:	perl.h,v $
+ * Revision 3.0.1.10  90/11/10  01:44:13  lwall
+ * patch38: more msdos/os2 upgrades
+ * 
  * Revision 3.0.1.9  90/10/15  17:59:41  lwall
  * patch29: some machines didn't like unsigned C preprocessor values
  * 
@@ -623,7 +626,7 @@ EXT bool tainted INIT(FALSE);		/* using variables controlled by $< */
 #ifndef MSDOS
 #define TMPPATH "/tmp/perl-eXXXXXX"
 #else
-#define TMPPATH "/tmp/plXXXXXX"
+#define TMPPATH "plXXXXXX"
 #endif /* MSDOS */
 EXT char *e_tmpname;
 EXT FILE *e_fp INIT(Nullfp);
diff --git a/perl.man.1 b/perl.man.1
index a0854936b3..9a24089704 100644
--- a/perl.man.1
+++ b/perl.man.1
@@ -1,7 +1,10 @@
 .rn '' }`
-''' $Header: perl_man.1,v 3.0.1.9 90/10/20 02:14:24 lwall Locked $
+''' $Header: perl_man.1,v 3.0.1.10 90/11/10 01:45:16 lwall Locked $
 ''' 
 ''' $Log:	perl.man.1,v $
+''' Revision 3.0.1.10  90/11/10  01:45:16  lwall
+''' patch38: random cleanup
+''' 
 ''' Revision 3.0.1.9  90/10/20  02:14:24  lwall
 ''' patch37: fixed various typos in man page
 ''' 
@@ -631,7 +634,7 @@ into strings.
 In addition, the token __END__ may be used to indicate the logical end of the
 script before the actual end of file.
 Any following text is ignored (but may be read via the DATA filehandle).
-The two control characters ^D and ^Z are synomyms for __END__.
+The two control characters ^D and ^Z are synonyms for __END__.
 .PP
 A word that doesn't have any other interpretation in the grammar will be
 treated as if it had single quotes around it.
@@ -997,7 +1000,7 @@ or
 switch.)
 .PP
 A declaration can be put anywhere a command can, but has no effect on the
-execution of the primary sequence of commands--declarations all take effect
+execution of the primary sequence of commands\(*--declarations all take effect
 at compile time.
 Typically all the declarations are put at the beginning or the end of the script.
 .PP
diff --git a/perl.man.2 b/perl.man.2
index 1166c93ecd..b9c37ef313 100644
--- a/perl.man.2
+++ b/perl.man.2
@@ -1,7 +1,11 @@
 ''' Beginning of part 2
-''' $Header: perl_man.2,v 3.0.1.9 90/10/15 18:17:37 lwall Locked $
+''' $Header: perl_man.2,v 3.0.1.10 90/11/10 01:46:29 lwall Locked $
 '''
 ''' $Log:	perl.man.2,v $
+''' Revision 3.0.1.10  90/11/10  01:46:29  lwall
+''' patch38: random cleanup
+''' patch38: added alarm function
+''' 
 ''' Revision 3.0.1.9  90/10/15  18:17:37  lwall
 ''' patch29: added caller
 ''' patch29: index and substr now have optional 3rd args
@@ -75,6 +79,15 @@ Only ?? patterns local to the current package are reset.
 Does the same thing that the accept system call does.
 Returns true if it succeeded, false otherwise.
 See example in section on Interprocess Communication.
+.Ip "alarm(SECONDS)" 8 4
+.Ip "alarm SECONDS" 8
+Arranges to have a SIGALRM delivered to this process after the specified number
+of seconds (minus 1, actually) have elapsed.  Thus, alarm(15) will cause
+a SIGALRM at some point more than 14 seconds in the future.
+Only one timer may be counting at once.  Each call disables the previous
+timer, and an argument of 0 may be supplied to cancel the previous timer
+without starting a new one.
+The returned value is the amount of time remaining on the previous timer.
 .Ip "atan2(X,Y)" 8 2
 Returns the arctangent of X/Y in the range
 .if t \-\(*p to \(*p.
@@ -334,12 +347,15 @@ command.
 Saying undef %ARRAY is faster yet.)
 .Ip "die(LIST)" 8
 .Ip "die LIST" 8
-Prints the value of LIST to
+Outside of an eval, prints the value of LIST to
 .I STDERR
 and exits with the current value of $!
 (errno).
 If $! is 0, exits with the value of ($? >> 8) (\`command\` status).
 If ($? >> 8) is 0, exits with 255.
+Inside an eval, the error message is stuffed into $@ and the eval is terminated
+with the undefined value.
+.Sp
 Equivalent examples:
 .nf
 
@@ -546,15 +562,18 @@ program, so that
 any variable settings, subroutine or format definitions remain afterwards.
 The value returned is the value of the last expression evaluated, just
 as with subroutines.
-If there is a syntax error or runtime error, a null string is returned by
+If there is a syntax error or runtime error, or a die statement is
+executed, an undefined value is returned by
 eval, and $@ is set to the error message.
-If there was no error, $@ is null.
+If there was no error, $@ is guaranteed to be a null string.
 If EXPR is omitted, evaluates $_.
 The final semicolon, if any, may be omitted from the expression.
 .Sp
 Note that, since eval traps otherwise-fatal errors, it is useful for
 determining whether a particular feature
 (such as dbmopen or symlink) is implemented.
+It is also Perl's exception trapping mechanism, where the die operator is
+used to raise exceptions.
 .Ip "exec(LIST)" 8 8
 .Ip "exec LIST" 8 6
 If there is more than one argument in LIST, or if LIST is an array with
@@ -617,10 +636,10 @@ You'll probably have to say
 
 .fi
 first to get the correct function definitions.
-If fcntl.h doesn't exist or doesn't have the correct definitions
+If fcntl.ph doesn't exist or doesn't have the correct definitions
 you'll have to roll
 your own, based on your C header files such as <sys/fcntl.h>.
-(There is a perl script called makelib that comes with the perl kit
+(There is a perl script called h2ph that comes with the perl kit
 which may help you in this.)
 Argument processing and value return works just like ioctl below.
 Note that fcntl will produce a fatal error if used on a machine that doesn't implement
@@ -861,10 +880,10 @@ You'll probably have to say
 
 .fi
 first to get the correct function definitions.
-If ioctl.h doesn't exist or doesn't have the correct definitions
+If ioctl.ph doesn't exist or doesn't have the correct definitions
 you'll have to roll
 your own, based on your C header files such as <sys/ioctl.h>.
-(There is a perl script called makelib that comes with the perl kit
+(There is a perl script called h2ph that comes with the perl kit
 which may help you in this.)
 SCALAR will be read and/or written depending on the FUNCTION\*(--a pointer
 to the string value of SCALAR will be passed as the third argument of
diff --git a/t/lib.big b/t/lib.big
new file mode 100644
index 0000000000..23cd00beb5
--- /dev/null
+++ b/t/lib.big
@@ -0,0 +1,280 @@
+#!./perl
+require "../lib/bigint.pl";
+
+$test = 0;
+$| = 1;
+print "1..246\n";
+while (<DATA>) {
+	chop;
+	if (/^&/) {
+		$f = $_;
+	} else {
+		++$test;
+		@args = split(/:/,$_,99);
+		$ans = pop(@args);
+		$try = "$f('" . join("','", @args) . "');";
+		if (($ans1 = eval($try)) eq $ans) {
+			print "ok $test\n";
+		} else {
+			print "not ok $test\n";
+			print "# '$try' expected: '$ans' got: '$ans1'\n";
+		}
+	}
+} 
+__END__
+&bnorm
+abc:NaN
+   1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:+0
++0:+0
++00:+0
++0 0 0:+0
+000000  0000000   00000:+0
+-0:+0
+-0000:+0
++1:+1
++01:+1
++001:+1
++00000100000:+100000
+123456789:+123456789
+-1:-1
+-01:-1
+-001:-1
+-123456789:-123456789
+-00000100000:-100000
+&bneg
+abd:NaN
++0:+0
++1:-1
+-1:+1
++123456789:-123456789
+-123456789:+123456789
+&babs
+abc:NaN
++0:+0
++1:+1
+-1:+1
++123456789:+123456789
+-123456789:+123456789
+&bcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
+&badd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:+1
++1:+1:+2
+-1:+0:-1
++0:-1:-1
+-1:-1:-2
+-1:+1:+0
++1:-1:+0
++9:+1:+10
++99:+1:+100
++999:+1:+1000
++9999:+1:+10000
++99999:+1:+100000
++999999:+1:+1000000
++9999999:+1:+10000000
++99999999:+1:+100000000
++999999999:+1:+1000000000
++9999999999:+1:+10000000000
++99999999999:+1:+100000000000
++10:-1:+9
++100:-1:+99
++1000:-1:+999
++10000:-1:+9999
++100000:-1:+99999
++1000000:-1:+999999
++10000000:-1:+9999999
++100000000:-1:+99999999
++1000000000:-1:+999999999
++10000000000:-1:+9999999999
++123456789:+987654321:+1111111110
+-123456789:+987654321:+864197532
+-123456789:-987654321:-1111111110
++123456789:-987654321:-864197532
+&bsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:-1
++1:+1:+0
+-1:+0:-1
++0:-1:+1
+-1:-1:+0
+-1:+1:-2
++1:-1:+2
++9:+1:+8
++99:+1:+98
++999:+1:+998
++9999:+1:+9998
++99999:+1:+99998
++999999:+1:+999998
++9999999:+1:+9999998
++99999999:+1:+99999998
++999999999:+1:+999999998
++9999999999:+1:+9999999998
++99999999999:+1:+99999999998
++10:-1:+11
++100:-1:+101
++1000:-1:+1001
++10000:-1:+10001
++100000:-1:+100001
++1000000:-1:+1000001
++10000000:-1:+10000001
++100000000:-1:+100000001
++1000000000:-1:+1000000001
++10000000000:-1:+10000000001
++123456789:+987654321:-864197532
+-123456789:+987654321:-1111111110
+-123456789:-987654321:+864197532
++123456789:-987654321:+1111111110
+&bmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+0
++1:+0:+0
++0:-1:+0
+-1:+0:+0
++123456789123456789:+0:+0
++0:+123456789123456789:+0
+-1:-1:+1
+-1:+1:-1
++1:-1:-1
++1:+1:+1
++2:+3:+6
+-2:+3:-6
++2:-3:-6
+-2:-3:+6
++111:+111:+12321
++10101:+10101:+102030201
++1001001:+1001001:+1002003002001
++100010001:+100010001:+10002000300020001
++10000100001:+10000100001:+100002000030000200001
++11111111111:+9:+99999999999
++22222222222:+9:+199999999998
++33333333333:+9:+299999999997
++44444444444:+9:+399999999996
++55555555555:+9:+499999999995
++66666666666:+9:+599999999994
++77777777777:+9:+699999999993
++88888888888:+9:+799999999992
++99999999999:+9:+899999999991
+&bdiv
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+1
+-1:-1:+1
++1:-1:-1
+-1:+1:-1
++1:+2:+0
++2:+1:+2
++1000000000:+9:+111111111
++2000000000:+9:+222222222
++3000000000:+9:+333333333
++4000000000:+9:+444444444
++5000000000:+9:+555555555
++6000000000:+9:+666666666
++7000000000:+9:+777777777
++8000000000:+9:+888888888
++9000000000:+9:+1000000000
++35500000:+113:+314159
++71000000:+226:+314159
++106500000:+339:+314159
++1000000000:+3:+333333333
++10:+5:+2
++100:+4:+25
++1000:+8:+125
++10000:+16:+625
++999999999999:+9:+111111111111
++999999999999:+99:+10101010101
++999999999999:+999:+1001001001
++999999999999:+9999:+100010001
++999999999999999:+99999:+10000100001
+&bmod
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+0
+-1:-1:+0
++1:-1:+0
+-1:+1:+0
++1:+2:+1
++2:+1:+0
++1000000000:+9:+1
++2000000000:+9:+2
++3000000000:+9:+3
++4000000000:+9:+4
++5000000000:+9:+5
++6000000000:+9:+6
++7000000000:+9:+7
++8000000000:+9:+8
++9000000000:+9:+0
++35500000:+113:+33
++71000000:+226:+66
++106500000:+339:+99
++1000000000:+3:+1
++10:+5:+0
++100:+4:+0
++1000:+8:+0
++10000:+16:+0
++999999999999:+9:+0
++999999999999:+99:+0
++999999999999:+999:+0
++999999999999:+9999:+0
++999999999999999:+99999:+0
+&bgcd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+1
++1:+0:+1
++1:+1:+1
++2:+3:+1
++3:+2:+1
++100:+625:+25
++4096:+81:+1