[comp.sources.bugs] perl 3.0 patch #39

lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (11/10/90)

System: perl version 3.0
Patch #: 39
Priority: 
Subject: patch #38, continued

Description:
	See patch #38.

Fix:	From rn, say "| patch -p -N -d DIR", where DIR is your perl source
	directory.  Outside of rn, say "cd DIR; patch -p -N <thisarticle".
	If you don't have the patch program, apply the following by hand,
	or get patch (version 2.0, latest patchlevel).

	After patching:
		*** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #40 FIRST ***

	If patch indicates that patchlevel is the wrong version, you may need
	to apply one or more previous patches, or the patch may already
	have been applied.  See the patchlevel.h file to find out what has or
	has not been applied.  In any event, don't continue with the patch.

	If you are missing previous patches they can be obtained from me:

	Larry Wall
	lwall@jpl-devvax.jpl.nasa.gov

	If you send a mail message of the following form it will greatly speed
	processing:

	Subject: Command
	@SH mailpatch PATH perl 3.0 LIST
		   ^ note the c

	where PATH is a return path FROM ME TO YOU either in Internet notation,
	or in bang notation from some well-known host, and LIST is the number
	of one or more patches you need, separated by spaces, commas, and/or
	hyphens.  Saying 35- says everything from 35 to the end.


	You can also get the patches via anonymous FTP from
	jpl-devvax.jpl.nasa.gov (128.149.1.143).

Index: patchlevel.h
Prereq: 38
1c1
< #define PATCHLEVEL 38
---
> #define PATCHLEVEL 39

Index: os2/director.c
*** os2/director.c.old	Sat Nov 10 02:29:33 1990
--- os2/director.c	Sat Nov 10 02:29:34 1990
***************
*** 5,11 ****
   *  MS-DOS.  Written by Michael Rendell ({uunet,utai}michael@garfield),
   *  August 1897
   *  Ported to OS/2 by Kai Uwe Rommel
!  *  December 1989
   */
  
  #include <sys/types.h>
--- 5,12 ----
   *  MS-DOS.  Written by Michael Rendell ({uunet,utai}michael@garfield),
   *  August 1897
   *  Ported to OS/2 by Kai Uwe Rommel
!  *  December 1989, February 1990
!  *  Change for HPFS support, October 1990
   */
  
  #include <sys/types.h>
***************
*** 12,20 ****
--- 13,23 ----
  #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,34 ****
--- 32,38 ----
  static HDIR hdir;
  static USHORT count;
  static FILEFINDBUF find;
+ static BOOL lower;
  
  
  DIR *opendir(char *name)
***************
*** 125,131 ****
    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;
--- 129,134 ----
***************
*** 176,181 ****
--- 179,222 ----
  }
  
  
+ 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;
***************
*** 182,187 ****
--- 223,230 ----
  
    if (dir != NULL)
    {				       /* get first entry */
+     lower = IsFileSystemFAT(dir);
+ 
      hdir = HDIR_CREATE;
      count = 1;
      done = DosFindFirst(dir, &hdir, attributes,
***************
*** 189,194 ****
--- 232,240 ----
    }
    else				       /* get next entry */
      done = DosFindNext(hdir, &find, sizeof(find), &count);
+ 
+   if ( lower )
+     strlwr(find.achName);
  
    if (done == 0)
      return find.achName;

Index: doarg.c
Prereq: 3.0.1.8
*** doarg.c.old	Sat Nov 10 02:24:24 1990
--- doarg.c	Sat Nov 10 02:24:33 1990
***************
*** 1,4 ****
! /* $Header: doarg.c,v 3.0.1.8 90/10/15 16:04:04 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: doarg.c,v 3.0.1.9 90/11/10 01:14:31 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,16 ----
   *    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,408 ****
  	str_sset(str,*st++);
      else
  	str_set(str,"");
!     for (; items > 0; items--,st++) {
! 	str_ncat(str,delim,delimlen);
! 	str_scat(str,*st);
      }
      STABSET(str);
  }
  
--- 404,419 ----
  	str_sset(str,*st++);
      else
  	str_set(str,"");
!     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,473 ****
  	    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':
--- 476,484 ----
  	    break;
  	case 'X':
  	  shrink:
! 	    if (str->str_cur < len)
  		fatal("X outside of string");
+ 	    str->str_cur -= len;
  	    str->str_ptr[str->str_cur] = '\0';
  	    break;
  	case 'x':
***************
*** 651,656 ****
--- 662,668 ----
  {
      register char *s;
      register char *t;
+     register char *f;
      bool dolong;
      char ch;
      static STR *sargnull = &str_no;
***************
*** 662,710 ****
  
      str_set(str,"");
      len--;			/* don't count pattern string */
!     origs = s = str_get(*sarg);
      send = s + (*sarg)->str_cur;
      sarg++;
!     for ( ; s < send; len--) {
  	if (len <= 0 || !*sarg) {
  	    sarg = &sargnull;
  	    len = 0;
  	}
! 	dolong = FALSE;
! 	for (t = s; t < send && *t != '%'; t++) ;
  	if (t >= send)
! 	    break;		/* not enough % patterns, oh well */
! 	for (t++; *sarg && t < send && t != s; t++) {
  	    switch (*t) {
  	    default:
  		ch = *(++t);
  		*t = '\0';
! 		(void)sprintf(buf,s);
! 		s = t;
! 		*(t--) = ch;
  		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 'l':
  		dolong = TRUE;
! 		break;
  	    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';
  		}
  		else
! 		    (void)sprintf(buf,s,xlen);
! 		s = t;
! 		*(t--) = ch;
  		break;
  	    case 'D':
  		dolong = TRUE;
--- 674,719 ----
  
      str_set(str,"");
      len--;			/* don't count pattern string */
!     origs = t = s = str_get(*sarg);
      send = s + (*sarg)->str_cur;
      sarg++;
!     for ( ; ; len--) {
  	if (len <= 0 || !*sarg) {
  	    sarg = &sargnull;
  	    len = 0;
  	}
! 	for ( ; t < send && *t != '%'; t++) ;
  	if (t >= send)
! 	    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(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 '+': case ' ':
! 		continue;
  	    case 'l':
  		dolong = TRUE;
! 		continue;
  	    case 'c':
  		ch = *(++t);
  		*t = '\0';
  		xlen = (int)str_gnum(*(sarg++));
! 		if (strEQ(f,"%c")) { /* some printfs fail on null chars */
! 		    *xs = xlen;
! 		    xs[1] = '\0';
  		}
  		else
! 		    (void)sprintf(xs,f,xlen);
  		break;
  	    case 'D':
  		dolong = TRUE;
***************
*** 713,723 ****
  		ch = *(++t);
  		*t = '\0';
  		if (dolong)
! 		    (void)sprintf(buf,s,(long)str_gnum(*(sarg++)));
  		else
! 		    (void)sprintf(buf,s,(int)str_gnum(*(sarg++)));
! 		s = t;
! 		*(t--) = ch;
  		break;
  	    case 'X': case 'O':
  		dolong = TRUE;
--- 722,730 ----
  		ch = *(++t);
  		*t = '\0';
  		if (dolong)
! 		    (void)sprintf(xs,f,(long)str_gnum(*(sarg++)));
  		else
! 		    (void)sprintf(xs,f,(int)str_gnum(*(sarg++)));
  		break;
  	    case 'X': case 'O':
  		dolong = TRUE;
***************
*** 727,744 ****
  		*t = '\0';
  		value = str_gnum(*(sarg++));
  		if (dolong)
! 		    (void)sprintf(buf,s,U_L(value));
  		else
! 		    (void)sprintf(buf,s,U_I(value));
! 		s = t;
! 		*(t--) = ch;
  		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;
  		break;
  	    case 's':
  		ch = *(++t);
--- 734,747 ----
  		*t = '\0';
  		value = str_gnum(*(sarg++));
  		if (dolong)
! 		    (void)sprintf(xs,f,U_L(value));
  		else
! 		    (void)sprintf(xs,f,U_I(value));
  		break;
  	    case 'E': case 'e': case 'f': case 'G': case 'g':
  		ch = *(++t);
  		*t = '\0';
! 		(void)sprintf(xs,f,str_gnum(*(sarg++)));
  		break;
  	    case 's':
  		ch = *(++t);
***************
*** 756,792 ****
  		    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;
  		break;
  	    }
! 	}
! 	if (s < t && t >= send) {
! 	    str_cat(str,s);
  	    s = t;
! 	    break;
  	}
- 	str_cat(str,buf);
      }
!     if (*s) {
! 	(void)sprintf(buf,s,0,0,0,0);
! 	str_cat(str,buf);
!     }
      STABSET(str);
  }
  
--- 759,785 ----
  		    xlen = strlen(tokenbuf);
  		    str_free(tmpstr);
  		}
  		sarg++;
! 		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;
  	    }
! 	    /* 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 from for loop */
  	}
      }
!     str_ncat(str, s, t - s);
      STABSET(str);
  }
  

Index: doio.c
Prereq: 3.0.1.12
*** doio.c.old	Sat Nov 10 02:25:13 1990
--- doio.c	Sat Nov 10 02:25:32 1990
***************
*** 1,4 ****
! /* $Header: doio.c,v 3.0.1.12 90/10/20 02:04:18 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: doio.c,v 3.0.1.13 90/11/10 01:17:37 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,15 ----
   *    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,117 ****
--- 116,123 ----
  #include <fcntl.h>
  #endif
  
+ int laststatval = -1;
+ 
  bool
  do_open(stab,name,len)
  STAB *stab;
***************
*** 598,608 ****
--- 604,618 ----
      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,631 ****
      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,640 ----
***************
*** 635,642 ****
--- 644,654 ----
  	    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]);
***************
*** 643,653 ****
  	statstab = Nullstab;
  #ifdef LSTAT
  	if (arg->arg_type == O_LSTAT)
! 	    i = lstat(str_get(statname),&statcache);
  	else
  #endif
! 	    i = stat(str_get(statname),&statcache);
! 	if (i < 0)
  	    max = 0;
      }
  
--- 655,665 ----
  	statstab = Nullstab;
  #ifdef LSTAT
  	if (arg->arg_type == O_LSTAT)
! 	    laststatval = lstat(str_get(statname),&statcache);
  	else
  #endif
! 	    laststatval = stat(str_get(statname),&statcache);
! 	if (laststatval < 0)
  	    max = 0;
      }
  
***************
*** 941,963 ****
  	if (stio && stio->ifp) {
  	    statstab = arg[1].arg_ptr.arg_stab;
  	    str_set(statname,"");
! 	    return fstat(fileno(stio->ifp), &statcache);
  	}
  	else {
  	    if (arg[1].arg_ptr.arg_stab == defstab)
! 		return 0;
  	    if (dowarn)
  		warn("Stat on unopened file <%s>",
  		  stab_name(arg[1].arg_ptr.arg_stab));
  	    statstab = Nullstab;
  	    str_set(statname,"");
! 	    return -1;
  	}
      }
      else {
  	statstab = Nullstab;
  	str_sset(statname,str);
! 	return stat(str_get(str),&statcache);
      }
  }
  
--- 953,975 ----
  	if (stio && stio->ifp) {
  	    statstab = arg[1].arg_ptr.arg_stab;
  	    str_set(statname,"");
! 	    return (laststatval = fstat(fileno(stio->ifp), &statcache));
  	}
  	else {
  	    if (arg[1].arg_ptr.arg_stab == defstab)
! 		return laststatval;
  	    if (dowarn)
  		warn("Stat on unopened file <%s>",
  		  stab_name(arg[1].arg_ptr.arg_stab));
  	    statstab = Nullstab;
  	    str_set(statname,"");
! 	    return (laststatval = -1);
  	}
      }
      else {
  	statstab = Nullstab;
  	str_sset(statname,str);
! 	return (laststatval = stat(str_get(str),&statcache));
      }
  }
  

Index: dolist.c
Prereq: 3.0.1.10
*** dolist.c.old	Sat Nov 10 02:25:59 1990
--- dolist.c	Sat Nov 10 02:26:08 1990
***************
*** 1,4 ****
! /* $Header: dolist.c,v 3.0.1.10 90/10/15 16:19:48 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: dolist.c,v 3.0.1.11 90/11/10 01:29:49 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,15 ----
   *    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,386 ****
  	    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);
  	    str_nset(dstr,s,m-s);
  	    (void)astore(ary, ++sp, dstr);
  	    for (s = m + 1; s < strend && isspace(*s); s++) ;
  	}
--- 380,389 ----
  	    for (m = s; m < strend && !isspace(*m); m++) ;
  	    if (m >= strend)
  		break;
! 	    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,401 ****
  	    m++;
  	    if (m >= strend)
  		break;
! 	    if (realarray)
! 		dstr = Str_new(30,m-s);
! 	    else
! 		dstr = str_static(&str_undef);
  	    str_nset(dstr,s,m-s);
  	    (void)astore(ary, ++sp, dstr);
  	    s = m;
  	}
--- 394,403 ----
  	    m++;
  	    if (m >= strend)
  		break;
! 	    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,430 ****
  		    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);
  		str_nset(dstr,s,m-s);
  		(void)astore(ary, ++sp, dstr);
  		s = m + 1;
  	    }
--- 422,431 ----
  		    for (m = s; m < strend && *m != i; m++) ;
  		if (m >= strend)
  		    break;
! 		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,446 ****
  		    spat->spat_short)) )
  #endif
  	    {
! 		if (realarray)
! 		    dstr = Str_new(31,m-s);
! 		else
! 		    dstr = str_static(&str_undef);
  		str_nset(dstr,s,m-s);
  		(void)astore(ary, ++sp, dstr);
  		s = m + i;
  	    }
--- 437,446 ----
  		    spat->spat_short)) )
  #endif
  	    {
! 		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,479 ****
  		strend = s + (strend - m);
  	    }
  	    m = spat->spat_regexp->startp[0];
! 	    if (realarray)
! 		dstr = Str_new(32,m-s);
! 	    else
! 		dstr = str_static(&str_undef);
  	    str_nset(dstr,s,m-s);
  	    (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);
  		    str_nset(dstr,s,m-s);
  		    (void)astore(ary, ++sp, dstr);
  		}
  	    }
--- 459,477 ----
  		strend = s + (strend - m);
  	    }
  	    m = spat->spat_regexp->startp[0];
! 	    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];
! 		    dstr = Str_new(33,m-s);
  		    str_nset(dstr,s,m-s);
+ 		    if (!realarray)
+ 			str_2static(dstr);
  		    (void)astore(ary, ++sp, dstr);
  		}
  	    }
***************
*** 487,497 ****
      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);
  	str_nset(dstr,s,strend-s);
  	(void)astore(ary, ++sp, dstr);
  	iters++;
      }
--- 485,494 ----
      if (iters > maxiters)
  	fatal("Split loop");
      if (s < strend || origlimit) {	/* keep field after final delim? */
! 	dstr = Str_new(34,strend-s);
  	str_nset(dstr,s,strend-s);
+ 	if (!realarray)
+ 	    str_2static(dstr);
  	(void)astore(ary, ++sp, dstr);
  	iters++;
      }
***************
*** 554,564 ****
      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;
--- 551,559 ----
***************
*** 1296,1304 ****
  }
  
  int
! do_reverse(str,gimme,arglast)
! STR *str;
! int gimme;
  int *arglast;
  {
      STR **st = stack->ary_array;
--- 1291,1297 ----
  }
  
  int
! do_reverse(arglast)
  int *arglast;
  {
      STR **st = stack->ary_array;
***************
*** 1317,1325 ****
  }
  
  int
! do_sreverse(str,gimme,arglast)
  STR *str;
- int gimme;
  int *arglast;
  {
      STR **st = stack->ary_array;
--- 1310,1317 ----
  }
  
  int
! do_sreverse(str,arglast)
  STR *str;
  int *arglast;
  {
      STR **st = stack->ary_array;
***************
*** 1343,1348 ****
--- 1335,1341 ----
  }
  
  static CMD *sortcmd;
+ static HASH *sortstash = Null(HASH*);
  static STAB *firststab = Nullstab;
  static STAB *secondstab = Nullstab;
  
***************
*** 1391,1404 ****
  		fatal("Undefined subroutine \"%s\" in sort", stab_name(stab));
  	    if (!sortstack) {
  		sortstack = anew(Nullstab);
  		sortstack->ary_flags = 0;
  	    }
  	    oldstack = stack;
  	    stack = sortstack;
  	    tmps_base = tmps_max;
! 	    if (!firststab) {
  		firststab = stabent("a",TRUE);
  		secondstab = stabent("b",TRUE);
  	    }
  	    oldfirst = stab_val(firststab);
  	    oldsecond = stab_val(secondstab);
--- 1384,1400 ----
  		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 (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,1491 ****
  	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_inc(str);
  	}
  	if (strEQ(str->str_ptr,tmps))
--- 1481,1487 ----
  	while (!str->str_nok && str->str_cur <= final->str_cur &&
  	    strNE(str->str_ptr,tmps) ) {
  	    (void)astore(ary, ++sp, str);
! 	    str = str_2static(str_smake(str));
  	    str_inc(str);
  	}
  	if (strEQ(str->str_ptr,tmps))
***************
*** 1537,1545 ****
        str_2static(str_nmake((double)csv->curcmd->c_line)) );
      if (!maxarg)
  	return sp;
!     str = str_static(&str_undef);
      stab_fullname(str, csv->stab);
!     (void)astore(stack,++sp, str);
      (void)astore(stack,++sp,
        str_2static(str_nmake((double)csv->hasargs)) );
      (void)astore(stack,++sp,
--- 1533,1541 ----
        str_2static(str_nmake((double)csv->curcmd->c_line)) );
      if (!maxarg)
  	return sp;
!     str = Str_new(49,0);
      stab_fullname(str, csv->stab);
!     (void)astore(stack,++sp, str_2static(str));
      (void)astore(stack,++sp,
        str_2static(str_nmake((double)csv->hasargs)) );
      (void)astore(stack,++sp,

Index: eval.c
Prereq: 3.0.1.9
*** eval.c.old	Sat Nov 10 02:26:51 1990
--- eval.c	Sat Nov 10 02:27:05 1990
***************
*** 1,4 ****
! /* $Header: eval.c,v 3.0.1.9 90/10/15 16:46:13 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: eval.c,v 3.0.1.10 90/11/10 01:33:22 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,17 ----
   *    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,858 ****
  	goto array_return;
      case O_REVERSE:
  	if (gimme == G_ARRAY)
! 	    sp = do_reverse(str,
! 	      gimme,arglast);
  	else
! 	    sp = do_sreverse(str,
! 	      gimme,arglast);
  	goto array_return;
      case O_WARN:
  	if (arglast[2] - arglast[1] != 1) {
--- 854,862 ----
  	goto array_return;
      case O_REVERSE:
  	if (gimme == G_ARRAY)
! 	    sp = do_reverse(arglast);
  	else
! 	    sp = do_sreverse(str, arglast);
  	goto array_return;
      case O_WARN:
  	if (arglast[2] - arglast[1] != 1) {
***************
*** 1117,1123 ****
      case O_RETURN:
  	tmps = "_SUB_";		/* just fake up a "last _SUB_" */
  	optype = O_LAST;
! 	if (curcsv->wantarray == G_ARRAY) {
  	    lastretstr = Nullstr;
  	    lastspbase = arglast[1];
  	    lastsize = arglast[2] - arglast[1];
--- 1121,1127 ----
      case O_RETURN:
  	tmps = "_SUB_";		/* just fake up a "last _SUB_" */
  	optype = O_LAST;
! 	if (curcsv && curcsv->wantarray == G_ARRAY) {
  	    lastretstr = Nullstr;
  	    lastspbase = arglast[1];
  	    lastsize = arglast[2] - arglast[1];
***************
*** 1171,1177 ****
  	    goto_targ = Nullch;		/* just restart from top */
  	if (optype == O_DUMP) {
  	    do_undump = 1;
! 	    abort();
  	}
  	longjmp(top_env, 1);
      case O_INDEX:
--- 1175,1181 ----
  	    goto_targ = Nullch;		/* just restart from top */
  	if (optype == O_DUMP) {
  	    do_undump = 1;
! 	    my_unexec();
  	}
  	longjmp(top_env, 1);
      case O_INDEX:
***************
*** 1355,1360 ****
--- 1359,1376 ----
  	anum = (int) *tmps;
  	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)

Index: evalargs.xc
Prereq: 3.0.1.7
*** evalargs.xc.old	Sat Nov 10 02:27:25 1990
--- evalargs.xc	Sat Nov 10 02:27:31 1990
***************
*** 2,10 ****
   * kit sizes from getting too big.
   */
  
! /* $Header: evalargs.xc,v 3.0.1.7 90/10/15 16:48:11 lwall Locked $
   *
   * $Log:	evalargs.xc,v $
   * 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
--- 2,13 ----
   * kit sizes from getting too big.
   */
  
! /* $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,255 ****
  			    astore(stack, sp, Nullstr);
  			    st = stack->ary_array;
  			}
! 			st[sp] = str_static(&str_undef);
! 			if (str_gets(st[sp],fp,0) == Nullch) {
  			    sp--;
  			    break;
  			}
  		    }
  		}
  		statusvalue = mypclose(fp);
--- 248,263 ----
  			    astore(stack, sp, Nullstr);
  			    st = stack->ary_array;
  			}
! 			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,305 ****
  	    if (anum > 1)		/* assign to scalar */
  		gimme = G_SCALAR;	/* force context to scalar */
  	    if (gimme == G_ARRAY)
! 		str = str_static(&str_undef);
  	    ++sp;
  	    fp = Nullfp;
  	    if (stab_io(last_in_stab)) {
--- 307,313 ----
  	    if (anum > 1)		/* assign to scalar */
  		gimme = G_SCALAR;	/* force context to scalar */
  	    if (gimme == G_ARRAY)
! 		str = Str_new(57,0);
  	    ++sp;
  	    fp = Nullfp;
  	    if (stab_io(last_in_stab)) {
***************
*** 369,374 ****
--- 377,383 ----
  		record_separator = old_record_separator;
  		if (gimme == G_ARRAY) {
  		    --sp;
+ 		    str_2static(str);
  		    goto array_return;
  		}
  		break;
***************
*** 394,404 ****
  			goto keepgoing;		/* unmatched wildcard? */
  		}
  		if (gimme == G_ARRAY) {
  		    if (++sp > stack->ary_max) {
  			astore(stack, sp, Nullstr);
  			st = stack->ary_array;
  		    }
! 		    str = str_static(&str_undef);
  		    goto keepgoing;
  		}
  	    }
--- 403,418 ----
  			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_new(58,80);
  		    goto keepgoing;
  		}
  	    }

Index: h2ph.SH
*** h2ph.SH.old	Sat Nov 10 02:27:45 1990
--- h2ph.SH	Sat Nov 10 02:27:48 1990
***************
*** 35,41 ****
  %isatype = ('char',1,'short',1,'int',1,'long',1);
  
  foreach $file (@ARGV) {
!     ($outfile = $file) =~ s/\.h$/.ph/;
      print "$file -> $outfile\n";
      if ($file =~ m|^(.*)/|) {
  	$dir = $1;
--- 35,41 ----
  %isatype = ('char',1,'short',1,'int',1,'long',1);
  
  foreach $file (@ARGV) {
!     ($outfile = $file) =~ s/\.h$/.ph/ || next;
      print "$file -> $outfile\n";
      if ($file =~ m|^(.*)/|) {
  	$dir = $1;

Index: t/lib.big
*** t/lib.big.old	Sat Nov 10 02:37:14 1990
--- t/lib.big	Sat Nov 10 02:37:16 1990
***************
*** 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

Index: os2/os2.c
Prereq: 3.0.1.1
*** os2/os2.c.old	Sat Nov 10 02:29:40 1990
--- os2/os2.c	Sat Nov 10 02:29:43 1990
***************
*** 1,4 ****
! /* $Header: os2.c,v 3.0.1.1 90/10/15 17:49:55 lwall Locked $
   *
   *    (C) Copyright 1989, 1990 Diomidis Spinellis.
   *
--- 1,4 ----
! /* $Header: os2.c,v 3.0.1.2 90/11/10 01:42:38 lwall Locked $
   *
   *    (C) Copyright 1989, 1990 Diomidis Spinellis.
   *
***************
*** 6,11 ****
--- 6,14 ----
   *    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,56 ****
  int chdir(char *path)
  {
    if ( path[0] != 0 && path[1] == ':' )
!     DosSelectDisk(tolower(path[0]) - '@');
  
    DosChDir(path, 0L);
  }
--- 53,59 ----
  int chdir(char *path)
  {
    if ( path[0] != 0 && path[1] == ':' )
!     DosSelectDisk(toupper(path[0]) - '@');
  
    DosChDir(path, 0L);
  }

Index: os2/perl.bad
*** os2/perl.bad.old	Sat Nov 10 02:29:50 1990
--- os2/perl.bad	Sat Nov 10 02:29:52 1990
***************
*** 4,6 ****
--- 4,7 ----
  DOSFLAGPROCESS
  DOSSETPRTY
  DOSGETPRTY
+ DOSQFSATTACH

Index: os2/perl.cs
*** os2/perl.cs.old	Sat Nov 10 02:29:58 1990
--- os2/perl.cs	Sat Nov 10 02:30:00 1990
***************
*** 3,13 ****
  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)
  
  setargv.obj
! perl.def
! perl.bad
  perl.exe
  
! -AL -LB -S0x9000
--- 3,15 ----
  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 -I.
! os2\os2.c os2\popen.c os2\mktemp.c os2\director.c os2\suffix.c
! )
  
  setargv.obj
! os2\perl.def
! os2\perl.bad
  perl.exe
  
! -AL -LB -S0x8800

Index: os2/perl.def
*** os2/perl.def.old	Sat Nov 10 02:30:10 1990
--- os2/perl.def	Sat Nov 10 02:30:11 1990
***************
*** 1,2 ****
  NAME PERL WINDOWCOMPAT NEWFILES
! DESCRIPTION 'PERL 3.0, patchlevel 28 - for MS-DOS and OS/2'
--- 1,2 ----
  NAME PERL WINDOWCOMPAT NEWFILES
! DESCRIPTION 'PERL 3.0, patchlevel 37 - for MS-DOS and OS/2'

Index: perl.h
Prereq: 3.0.1.9
*** perl.h.old	Sat Nov 10 02:30:49 1990
--- perl.h	Sat Nov 10 02:30:55 1990
***************
*** 1,4 ****
! /* $Header: perl.h,v 3.0.1.9 90/10/15 17:59:41 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: perl.h,v 3.0.1.10 90/11/10 01:44:13 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,14 ----
   *    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,629 ****
  #ifndef MSDOS
  #define TMPPATH "/tmp/perl-eXXXXXX"
  #else
! #define TMPPATH "/tmp/plXXXXXX"
  #endif /* MSDOS */
  EXT char *e_tmpname;
  EXT FILE *e_fp INIT(Nullfp);
--- 626,632 ----
  #ifndef MSDOS
  #define TMPPATH "/tmp/perl-eXXXXXX"
  #else
! #define TMPPATH "plXXXXXX"
  #endif /* MSDOS */
  EXT char *e_tmpname;
  EXT FILE *e_fp INIT(Nullfp);

Index: perl_man.1
Prereq: 3.0.1.9
*** perl_man.1.old	Sat Nov 10 02:31:23 1990
--- perl_man.1	Sat Nov 10 02:31:35 1990
***************
*** 1,7 ****
  .rn '' }`
! ''' $Header: perl_man.1,v 3.0.1.9 90/10/20 02:14:24 lwall Locked $
  ''' 
  ''' $Log:	perl_man.1,v $
  ''' Revision 3.0.1.9  90/10/20  02:14:24  lwall
  ''' patch37: fixed various typos in man page
  ''' 
--- 1,10 ----
  .rn '' }`
! ''' $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,637 ****
  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__.
  .PP
  A word that doesn't have any other interpretation in the grammar will be
  treated as if it had single quotes around it.
--- 634,640 ----
  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 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,1003 ****
  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
  at compile time.
  Typically all the declarations are put at the beginning or the end of the script.
  .PP
--- 1000,1006 ----
  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
  at compile time.
  Typically all the declarations are put at the beginning or the end of the script.
  .PP

Index: perl_man.2
Prereq: 3.0.1.9
*** perl_man.2.old	Sat Nov 10 02:32:05 1990
--- perl_man.2	Sat Nov 10 02:32:18 1990
***************
*** 1,7 ****
  ''' Beginning of part 2
! ''' $Header: perl_man.2,v 3.0.1.9 90/10/15 18:17:37 lwall Locked $
  '''
  ''' $Log:	perl_man.2,v $
  ''' Revision 3.0.1.9  90/10/15  18:17:37  lwall
  ''' patch29: added caller
  ''' patch29: index and substr now have optional 3rd args
--- 1,11 ----
  ''' Beginning of part 2
! ''' $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,80 ****
--- 79,93 ----
  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,345 ****
  Saying undef %ARRAY is faster yet.)
  .Ip "die(LIST)" 8
  .Ip "die LIST" 8
! 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.
  Equivalent examples:
  .nf
  
--- 347,361 ----
  Saying undef %ARRAY is faster yet.)
  .Ip "die(LIST)" 8
  .Ip "die LIST" 8
! 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,554 ****
  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
  eval, and $@ is set to the error message.
! If there was no error, $@ is null.
  If EXPR is omitted, evaluates $_.
  The final semicolon, if any, may be omitted from the expression.
  .Sp
--- 562,571 ----
  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, 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 guaranteed to be a null string.
  If EXPR is omitted, evaluates $_.
  The final semicolon, if any, may be omitted from the expression.
  .Sp
***************
*** 555,560 ****
--- 572,579 ----
  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,626 ****
  
  .fi
  first to get the correct function definitions.
! If fcntl.h 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
  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
--- 636,645 ----
  
  .fi
  first to get the correct function 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 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,870 ****
  
  .fi
  first to get the correct function definitions.
! If ioctl.h 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
  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
--- 880,889 ----
  
  .fi
  first to get the correct function 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 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

*** End of Patch 39 ***