From: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Date: Fri, 9 Nov 1990 13:37:16 +0000 (+0000)
Subject: perl 3.0 patch #39 patch #38, continued
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=57ebbfd03f7f6ea2523a79a595ecc80ef8e2ab9b;p=p5sagit%2Fp5-mst-13.2.git

perl 3.0 patch #39 patch #38, continued

See patch #38.
---

diff --git a/doarg.c b/doarg.c
index 768c6c3..a35dde1 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 54d01cf..7895213 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 fa970a1..c2822e3 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 2020eb7..a2de82f 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 09e1a50..d6aad79 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 fa33efc..d31c82a 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 a360af7..d5accd7 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 279a88f..a1a464b 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 bec2132..870785a 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 530f093..416e29c 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 2b49370..2c990c2 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 6f96c1e..314cba1 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 38
+#define PATCHLEVEL 39
diff --git a/perl.h b/perl.h
index 1c8655b..c911e2b 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 a085493..9a24089 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 1166c93..b9c37ef 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 0000000..23cd00b
--- /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