Xref: utzoo comp.sources.bugs:2601 comp.lang.perl:2592
Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!sdd.hp.com!elroy.jpl.nasa.gov!jpl-devvax!lwall
From: lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall)
Newsgroups: comp.sources.bugs,comp.lang.perl
Subject: perl 3.0 patch #30
Summary: This is an official patch for perl 3.0.  Please apply it.
Message-ID: <10001@jpl-devvax.JPL.NASA.GOV>
Date: 17 Oct 90 16:55:13 GMT
Organization: Jet Propulsion Laboratory, Pasadena, CA
Lines: 1878

System: perl version 3.0
Patch #: 30
Priority: HIGH
Subject: patch #29, continued

Description:
	See patch #29.


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 #36 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: 29
1c1
< #define PATCHLEVEL 29
---
> #define PATCHLEVEL 30

Index: os2/a2p.cs
*** os2/a2p.cs.old	Tue Oct 16 11:54:09 1990
--- os2/a2p.cs	Tue Oct 16 11:54:11 1990
***************
*** 0 ****
--- 1,8 ----
+ (-W1 -Od -Ocgelt a2p.y{a2py.c})
+ (-W1 -Od -Ocgelt hash.c str.c util.c walk.c)
+ 
+ setargv.obj
+ a2p.def
+ a2p.exe
+ 
+ -AL -LB -S0xA000

Index: os2/a2p.def
*** os2/a2p.def.old	Tue Oct 16 11:54:18 1990
--- os2/a2p.def	Tue Oct 16 11:54:25 1990
***************
*** 0 ****
--- 1,2 ----
+ NAME AWK2PERL WINDOWCOMPAT NEWFILES
+ DESCRIPTION 'AWK to PERL translator - for MS-DOS and OS/2'

Index: x2p/a2py.c
Prereq: 3.0.1.1
*** x2p/a2py.c.old	Tue Oct 16 12:06:17 1990
--- x2p/a2py.c	Tue Oct 16 12:06:25 1990
***************
*** 1,4 ****
! /* $Header: a2py.c,v 3.0.1.1 90/08/09 05:48:53 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: a2py.c,v 3.0.1.2 90/10/16 11:30:34 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:	a2py.c,v $
+  * Revision 3.0.1.2  90/10/16  11:30:34  lwall
+  * patch29: various portability fixes
+  * 
   * Revision 3.0.1.1  90/08/09  05:48:53  lwall
   * patch19: a2p didn't emit a chop when NF was referenced though split needs it
   * 
***************
*** 14,27 ****
--- 17,49 ----
   * 
   */
  
+ #ifdef MSDOS
+ #include "../patchlev.h"
+ #endif
  #include "util.h"
  char *index();
  
  char *filename;
+ char *myname;
  
  int checkers = 0;
  STR *walk();
  
+ #ifdef MSDOS
+ usage()
+ {
+     printf("\nThis is the AWK to PERL translator, version 3.0, patchlevel %d\n", PATCHLEVEL);
+     printf("\nUsage: %s [-D<number>] [-F<char>] [-n<fieldlist>] [-<number>] filename\n", myname);
+     printf("\n  -D<number>      sets debugging flags."
+            "\n  -F<character>   the awk script to translate is always invoked with"
+            "\n                  this -F switch."
+            "\n  -n<fieldlist>   specifies the names of the input fields if input does"
+            "\n                  not have to be split into an array."
+            "\n  -<number>       causes a2p to assume that input will always have that"
+            "\n                  many fields.\n");
+     exit(1);
+ }
+ #endif
  main(argc,argv,env)
  register int argc;
  register char **argv;
***************
*** 32,37 ****
--- 54,60 ----
      int i;
      STR *tmpstr;
  
+     myname = argv[0];
      linestr = str_new(80);
      str = str_new(0);		/* first used for -I flags */
      for (argc--,argv++; argc; argc--,argv++) {
***************
*** 65,70 ****
--- 88,96 ----
  	    break;
  	default:
  	    fatal("Unrecognized switch: %s\n",argv[0]);
+ #ifdef MSDOS
+             usage();
+ #endif
  	}
      }
    switch_end:
***************
*** 71,79 ****
  
      /* open script */
  
!     if (argv[0] == Nullch)
! 	argv[0] = "-";
      filename = savestr(argv[0]);
      if (strEQ(filename,"-"))
  	argv[0] = "";
      if (!*argv[0])
--- 97,112 ----
  
      /* open script */
  
!     if (argv[0] == Nullch) {
! #ifdef MSDOS
! 	if ( isatty(fileno(stdin)) )
! 	    usage();
! #endif
!         argv[0] = "-";
!     }
      filename = savestr(argv[0]);
+ 
+     filename = savestr(argv[0]);
      if (strEQ(filename,"-"))
  	argv[0] = "";
      if (!*argv[0])
***************
*** 1207,1213 ****
      }
      else
  	fatal("panic: unknown argument type %d, arg %d, line %d\n",
! 	  type,numargs+1,line);
      return numargs;
  }
  
--- 1240,1246 ----
      }
      else
  	fatal("panic: unknown argument type %d, arg %d, line %d\n",
! 	  type,prevargs+1,line);
      return numargs;
  }
  

Index: arg.h
Prereq: 3.0.1.6
*** arg.h.old	Tue Oct 16 11:45:17 1990
--- arg.h	Tue Oct 16 11:45:20 1990
***************
*** 1,4 ****
! /* $Header: arg.h,v 3.0.1.6 90/08/09 02:25:14 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: arg.h,v 3.0.1.7 90/10/15 14:53:59 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,23 ----
   *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	arg.h,v $
+  * Revision 3.0.1.7  90/10/15  14:53:59  lwall
+  * patch29: added SysV IPC
+  * patch29: added waitpid
+  * patch29: added cmp and <=>
+  * patch29: added caller
+  * patch29: added scalar
+  * patch29: added sysread and syswrite
+  * patch29: added -M, -A and -C
+  * patch29: index and substr now have optional 3rd args
+  * patch29: you can now read into the middle string
+  * patch29: various portability fixes
+  * 
   * Revision 3.0.1.6  90/08/09  02:25:14  lwall
   * patch19: added require operator
   * patch19: added truncate operator
***************
*** 123,129 ****
  #define O_EACH 89
  #define O_CHOP 90
  #define O_FORK 91
! #define O_EXEC 92
  #define O_SYSTEM 93
  #define O_OCT 94
  #define O_HEX 95
--- 135,141 ----
  #define O_EACH 89
  #define O_CHOP 90
  #define O_FORK 91
! #define O_EXEC_OP 92
  #define O_SYSTEM 93
  #define O_OCT 94
  #define O_HEX 95
***************
*** 277,283 ****
  #define O_BINMODE 243
  #define O_REQUIRE 244
  #define O_TRUNCATE 245
! #define MAXO 246
  
  #ifndef DOINIT
  extern char *opname[];
--- 289,316 ----
  #define O_BINMODE 243
  #define O_REQUIRE 244
  #define O_TRUNCATE 245
! #define O_MSGGET 246
! #define O_MSGCTL 247
! #define O_MSGSND 248
! #define O_MSGRCV 249
! #define O_SEMGET 250
! #define O_SEMCTL 251
! #define O_SEMOP 252
! #define O_SHMGET 253
! #define O_SHMCTL 254
! #define O_SHMREAD 255
! #define O_SHMWRITE 256
! #define O_NCMP 257
! #define O_SCMP 258
! #define O_CALLER 259
! #define O_SCALAR 260
! #define O_SYSREAD 261
! #define O_SYSWRITE 262
! #define O_FTMTIME 263
! #define O_FTATIME 264
! #define O_FTCTIME 265
! #define O_WAITPID 266
! #define MAXO 267
  
  #ifndef DOINIT
  extern char *opname[];
***************
*** 529,535 ****
      "BINMODE",
      "REQUIRE",
      "TRUNCATE",
!     "245"
  };
  #endif
  
--- 562,589 ----
      "BINMODE",
      "REQUIRE",
      "TRUNCATE",
!     "MSGGET",
!     "MSGCTL",
!     "MSGSND",
!     "MSGRCV",
!     "SEMGET",
!     "SEMCTL",
!     "SEMOP",
!     "SHMGET",
!     "SHMCTL",
!     "SHMREAD",
!     "SHMWRITE",
!     "NCMP",
!     "SCMP",
!     "CALLER",
!     "SCALAR",
!     "SYSREAD",
!     "SYSWRITE",
!     "FTMTIME",
!     "FTATIME",
!     "FTCTIME",
!     "WAITPID",
!     "264"
  };
  #endif
  
***************
*** 629,639 ****
  struct arg {
      union argptr arg_ptr;
      short	arg_len;
! #ifdef mips
!     short	pad;
! #endif
!     unsigned char arg_type;
!     unsigned char arg_flags;
  };
  
  #define AF_ARYOK 1		/* op can handle multiple values here */
--- 683,690 ----
  struct arg {
      union argptr arg_ptr;
      short	arg_len;
!     unsigned short arg_type;
!     unsigned short arg_flags;
  };
  
  #define AF_ARYOK 1		/* op can handle multiple values here */
***************
*** 658,667 ****
  #define Nullarg Null(ARG*)
  
  #ifndef DOINIT
! EXT char opargs[MAXO+1];
  #else
! #define A(e1,e2,e3) (e1+(e2<<2)+(e3<<4))
! char opargs[MAXO+1] = {
  	A(0,0,0),	/* NULL */
  	A(1,0,0),	/* ITEM */
  	A(0,0,0),	/* ITEM2 */
--- 709,719 ----
  #define Nullarg Null(ARG*)
  
  #ifndef DOINIT
! EXT unsigned short opargs[MAXO+1];
  #else
! #define A(e1,e2,e3)        (e1+(e2<<2)+(e3<<4))
! #define A5(e1,e2,e3,e4,e5) (e1+(e2<<2)+(e3<<4)+(e4<<6)+(e5<<8))
! unsigned short opargs[MAXO+1] = {
  	A(0,0,0),	/* NULL */
  	A(1,0,0),	/* ITEM */
  	A(0,0,0),	/* ITEM2 */
***************
*** 733,739 ****
  	A(0,0,0),	/* NEXT */
  	A(0,0,0),	/* REDO */
  	A(0,0,0),	/* GOTO */
! 	A(1,1,0),	/* INDEX */
  	A(0,0,0),	/* TIME */
  	A(0,0,0),	/* TIMES */
  	A(1,0,0),	/* LOCALTIME */
--- 785,791 ----
  	A(0,0,0),	/* NEXT */
  	A(0,0,0),	/* REDO */
  	A(0,0,0),	/* GOTO */
! 	A(1,1,1),	/* INDEX */
  	A(0,0,0),	/* TIME */
  	A(0,0,0),	/* TIMES */
  	A(1,0,0),	/* LOCALTIME */
***************
*** 818,827 ****
  	A(1,1,1),	/* IOCTL */
  	A(1,1,1),	/* FCNTL */
  	A(1,1,0),	/* FLOCK */
! 	A(1,1,0),	/* RINDEX */
  	A(1,3,0),	/* PACK */
  	A(1,1,0),	/* UNPACK */
! 	A(1,1,1),	/* READ */
  	A(0,3,0),	/* WARN */
  	A(1,1,1),	/* DBMOPEN */
  	A(1,0,0),	/* DBMCLOSE */
--- 870,879 ----
  	A(1,1,1),	/* IOCTL */
  	A(1,1,1),	/* FCNTL */
  	A(1,1,0),	/* FLOCK */
! 	A(1,1,1),	/* RINDEX */
  	A(1,3,0),	/* PACK */
  	A(1,1,0),	/* UNPACK */
! 	A(1,1,3),	/* READ */
  	A(0,3,0),	/* WARN */
  	A(1,1,1),	/* DBMOPEN */
  	A(1,0,0),	/* DBMCLOSE */
***************
*** 843,849 ****
  	A(1,1,0),	/* LISTEN */
  	A(1,1,0),	/* ACCEPT */
  	A(1,1,3),	/* SEND */
! 	A(1,1,1),	/* RECV */
  	A(1,1,1),	/* SSELECT */
  	A(1,1,1),	/* SOCKPAIR */
  	A(0,3,0),	/* DBSUBR */
--- 895,901 ----
  	A(1,1,0),	/* LISTEN */
  	A(1,1,0),	/* ACCEPT */
  	A(1,1,3),	/* SEND */
! 	A(1,1,3),	/* RECV */
  	A(1,1,1),	/* SSELECT */
  	A(1,1,1),	/* SOCKPAIR */
  	A(0,3,0),	/* DBSUBR */
***************
*** 908,916 ****
--- 960,990 ----
  	A(1,0,0),	/* BINMODE */
  	A(1,0,0),	/* REQUIRE */
  	A(1,1,0),	/* TRUNCATE */
+ 	A(1,1,0),	/* MSGGET */
+ 	A(1,1,1),	/* MSGCTL */
+ 	A(1,1,1),	/* MSGSND */
+ 	A5(1,1,1,1,1),	/* MSGRCV */
+ 	A(1,1,1),	/* SEMGET */
+ 	A5(1,1,1,1,0),	/* SEMCTL */
+ 	A(1,1,1),	/* SEMOP */
+ 	A(1,1,1),	/* SHMGET */
+ 	A(1,1,1),	/* SHMCTL */
+ 	A5(1,1,1,1,0),	/* SHMREAD */
+ 	A5(1,1,1,1,0),	/* SHMWRITE */
+ 	A(1,1,0),	/* NCMP */
+ 	A(1,1,0),	/* SCMP */
+ 	A(1,0,0),	/* CALLER */
+ 	A(1,0,0),	/* SCALAR */
+ 	A(1,1,3),	/* SYSREAD */
+ 	A(1,1,3),	/* SYSWRITE */
+ 	A(1,0,0),	/* FTMTIME */
+ 	A(1,0,0),	/* FTATIME */
+ 	A(1,0,0),	/* FTCTIME */
+ 	A(1,1,0),	/* WAITPID */
  	0
  };
  #undef A
+ #undef A5
  #endif
  
  int do_trans();

Index: array.c
Prereq: 3.0.1.2
*** array.c.old	Tue Oct 16 11:45:29 1990
--- array.c	Tue Oct 16 11:45:31 1990
***************
*** 1,4 ****
! /* $Header: array.c,v 3.0.1.2 90/08/13 21:52:20 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: array.c,v 3.0.1.3 90/10/15 14:56:17 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:	array.c,v $
+  * Revision 3.0.1.3  90/10/15  14:56:17  lwall
+  * patch29: non-existent array values no longer cause core dumps
+  * 
   * Revision 3.0.1.2  90/08/13  21:52:20  lwall
   * patch28: defined(@array) and defined(%array) didn't work right
   * 
***************
*** 38,49 ****
  	    return str;
  	}
  	else
! 	    return Nullstr;
      }
!     if (lval && !ar->ary_array[key]) {
! 	str = Str_new(6,0);
! 	(void)astore(ar,key,str);
! 	return str;
      }
      return ar->ary_array[key];
  }
--- 41,55 ----
  	    return str;
  	}
  	else
! 	    return &str_undef;
      }
!     if (!ar->ary_array[key]) {
! 	if (lval) {
! 	    str = Str_new(6,0);
! 	    (void)astore(ar,key,str);
! 	    return str;
! 	}
! 	return &str_undef;
      }
      return ar->ary_array[key];
  }

Index: lib/cacheout.pl
*** lib/cacheout.pl.old	Tue Oct 16 11:53:23 1990
--- lib/cacheout.pl	Tue Oct 16 11:53:26 1990
***************
*** 0 ****
--- 1,44 ----
+ #!/usr/bin/perl
+ 
+ # Open in their package.
+ 
+ sub cacheout'open {
+     open($_[0], $_[1]);
+ }
+ 
+ # But only this sub name is visible to them.
+ 
+ sub cacheout {
+     package cacheout;
+ 
+     ($file) = @_;
+     ($package) = caller;
+     if (!$isopen{$file}) {
+ 	if (++$numopen > $maxopen) {
+ 	    sub byseq {$isopen{$a} != $isopen{$b};}
+ 	    local(@lru) = sort byseq keys(%isopen);
+ 	    splice(@lru, $maxopen / 3);
+ 	    $numopen -= @lru;
+ 	    for (@lru) { close $_; delete $isopen{$_}; }
+ 	}
+ 	&open($file, ($saw{$file}++ ? '>>' : '>') . $file)
+ 	    || die "Can't create $file: $!\n";
+     }
+     $isopen{$file} = ++$seq;
+ }
+ 
+ package cacheout;
+ 
+ $seq = 0;
+ $numopen = 0;
+ 
+ if (open(PARAM,'/usr/include/sys/param.h')) {
+     local($.);
+     while (<PARAM>) {
+ 	$maxopen = $1 - 4 if /^#define NOFILE\s+(\d+)/;
+     }
+     close PARAM;
+ }
+ $maxopen = 16 unless $maxopen;
+ 
+ 1;

Index: cmd.c
Prereq: 3.0.1.8
*** cmd.c.old	Tue Oct 16 11:45:50 1990
--- cmd.c	Tue Oct 16 11:45:59 1990
***************
*** 1,4 ****
! /* $Header: cmd.c,v 3.0.1.8 90/08/09 02:28:49 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: cmd.c,v 3.0.1.9 90/10/15 15:32:39 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:	cmd.c,v $
+  * Revision 3.0.1.9  90/10/15  15:32:39  lwall
+  * patch29: non-existent array values no longer cause core dumps
+  * patch29: scripts now run at almost full speed under the debugger
+  * patch29: @ENV = () now works
+  * patch29: added caller
+  * 
   * Revision 3.0.1.8  90/08/09  02:28:49  lwall
   * patch19: did preliminary work toward debugging packages and evals
   * patch19: conditionals now always supply a scalar context to expression
***************
*** 600,611 ****
  	    }
  	    else {
  		match++;
! 		retstr = stab_val(cmd->c_stab) = ar->ary_array[match];
  		cmd->c_short->str_u.str_useful = match;
  		match = TRUE;
  	    }
  	    newsp = -2;
  	    goto maybe;
  	}
  
      /* we have tried to make this normal case as abnormal as possible */
--- 606,629 ----
  	    }
  	    else {
  		match++;
! 		if (!(retstr = ar->ary_array[match]))
! 		    retstr = afetch(ar,match,TRUE);
! 		stab_val(cmd->c_stab) = retstr;
  		cmd->c_short->str_u.str_useful = match;
  		match = TRUE;
  	    }
  	    newsp = -2;
  	    goto maybe;
+ 	case CFT_D1:
+ 	    break;
+ 	case CFT_D0:
+ 	    if (DBsingle->str_u.str_nval != 0)
+ 		break;
+ 	    if (DBsignal->str_u.str_nval != 0)
+ 		break;
+ 	    if (DBtrace->str_u.str_nval != 0)
+ 		break;
+ 	    goto next_cmd;
  	}
  
      /* we have tried to make this normal case as abnormal as possible */
***************
*** 1130,1136 ****
  	    break;
  	case SS_SHASH:				/* hash reference */
  	    stab = value->str_u.str_stab;
! 	    (void)hfree(stab_xhash(stab));
  	    stab_xhash(stab) = (HASH*)value->str_ptr;
  	    value->str_ptr = Nullch;
  	    str_free(value);
--- 1148,1154 ----
  	    break;
  	case SS_SHASH:				/* hash reference */
  	    stab = value->str_u.str_stab;
! 	    (void)hfree(stab_xhash(stab), FALSE);
  	    stab_xhash(stab) = (HASH*)value->str_ptr;
  	    value->str_ptr = Nullch;
  	    str_free(value);
***************
*** 1161,1166 ****
--- 1179,1198 ----
  	    value->str_magic = Nullstr;
  	    (void)stab_clear(stab);
  	    str_free(value);
+ 	    break;
+ 	case SS_SCSV:				/* callsave structure */
+ 	    {
+ 		CSV *csv = (CSV*) value->str_ptr;
+ 
+ 		curcmd = csv->curcmd;
+ 		curcsv = csv->curcsv;
+ 		csv->sub->depth = csv->depth;
+ 		if (csv->hasargs) {		/* put back old @_ */
+ 		    afree(csv->argarray);
+ 		    stab_xarray(defstab) = csv->savearray;
+ 		}
+ 		str_free(value);
+ 	    }
  	    break;
  	default:
  	    fatal("panic: restorelist inconsistency");

Index: cmd.h
Prereq: 3.0.1.3
*** cmd.h.old	Tue Oct 16 11:46:11 1990
--- cmd.h	Tue Oct 16 11:46:14 1990
***************
*** 1,4 ****
! /* $Header: cmd.h,v 3.0.1.3 90/08/09 02:29:58 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: cmd.h,v 3.0.1.4 90/10/15 15:34:50 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:	cmd.h,v $
+  * Revision 3.0.1.4  90/10/15  15:34:50  lwall
+  * patch29: scripts now run at almost full speed under the debugger
+  * patch29: added caller
+  * 
   * Revision 3.0.1.3  90/08/09  02:29:58  lwall
   * patch19: did preliminary work toward debugging packages and evals
   * 
***************
*** 78,83 ****
--- 82,89 ----
  #define CFT_INDGETS 11	/* c_expr is <$variable> */
  #define CFT_NUMOP 12	/* c_expr is a numeric comparison */
  #define CFT_CCLASS 13	/* c_expr must start with one of these characters */
+ #define CFT_D0 14	/* no special breakpoint at this line */
+ #define CFT_D1 15	/* possible special breakpoint at this line */
  
  #ifdef DEBUGGING
  #ifndef DOINIT
***************
*** 134,146 ****
      } ucmd;
      short	c_slen;		/* len of c_short, if not null */
      VOLATILE short c_flags;	/* optimization flags--see above */
!     char	*c_pack;	/* package line was compiled in */
!     char	*c_file;	/* file the following line # is from */
      line_t      c_line;         /* line # of this command */
      char	c_type;		/* what this command does */
  };
  
  #define Nullcmd Null(CMD*)
  
  EXT CMD * VOLATILE main_root INIT(Nullcmd);
  EXT CMD * VOLATILE eval_root INIT(Nullcmd);
--- 140,153 ----
      } ucmd;
      short	c_slen;		/* len of c_short, if not null */
      VOLATILE short c_flags;	/* optimization flags--see above */
!     HASH	*c_stash;	/* package line was compiled in */
!     STAB	*c_filestab;	/* file the following line # is from */
      line_t      c_line;         /* line # of this command */
      char	c_type;		/* what this command does */
  };
  
  #define Nullcmd Null(CMD*)
+ #define Nullcsv Null(CSV*)
  
  EXT CMD * VOLATILE main_root INIT(Nullcmd);
  EXT CMD * VOLATILE eval_root INIT(Nullcmd);
***************
*** 147,152 ****
--- 154,172 ----
  
  EXT CMD compiling;
  EXT CMD * VOLATILE curcmd INIT(&compiling);
+ EXT CSV * VOLATILE curcsv INIT(Nullcsv);
+ 
+ struct callsave {
+     SUBR *sub;
+     STAB *stab;
+     CSV *curcsv;
+     CMD *curcmd;
+     ARRAY *savearray;
+     ARRAY *argarray;
+     long depth;
+     int wantarray;
+     char hasargs;
+ };
  
  struct compcmd {
      CMD *comp_true;

Index: t/cmd.subval
Prereq: 3.0
*** t/cmd.subval.old	Tue Oct 16 12:03:56 1990
--- t/cmd.subval	Tue Oct 16 12:03:58 1990
***************
*** 1,6 ****
  #!./perl
  
! # $Header: cmd.subval,v 3.0 89/10/18 15:24:52 lwall Locked $
  
  sub foo1 {
      'true1';
--- 1,6 ----
  #!./perl
  
! # $Header: cmd.subval,v 3.0.1.1 90/10/16 10:46:53 lwall Locked $
  
  sub foo1 {
      'true1';
***************
*** 33,39 ****
      'true2' unless $_[0];
  }
  
! print "1..26\n";
  
  if (do foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
  if (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
--- 33,39 ----
      'true2' unless $_[0];
  }
  
! print "1..34\n";
  
  if (do foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
  if (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
***************
*** 99,101 ****
--- 99,179 ----
  $x = join(':',&ary2);
  print $x eq '1:2:3' ? "ok 26\n" : "not ok 26 $x\n";
  
+ sub somesub {
+     local($num,$P,$F,$L) = @_;
+     ($p,$f,$l) = caller;
+     print "$p:$f:$l" eq "$P:$F:$L" ? "ok $num\n" : "not ok $num\n";
+ }
+ 
+ &somesub(27, 'main', __FILE__, __LINE__);
+ 
+ package foo;
+ &main'somesub(28, 'foo', __FILE__, __LINE__);
+ 
+ package main;
+ $i = 28;
+ open(FOO,">Cmd_subval.tmp");
+ print FOO "blah blah\n";
+ close FOO;
+ 
+ &file_main(*F);
+ close F;
+ &info_main;
+ 
+ &file_package(*F);
+ close F;
+ &info_package;
+ 
+ unlink 'Cmd_subval.tmp';
+ 
+ sub file_main {
+         local(*F) = @_;
+ 
+         open(F, 'Cmd_subval.tmp') || die "can't open\n";
+ 	$i++;
+         eof F ? print "not ok $i\n" : print "ok $i\n";
+ }
+ 
+ sub info_main {
+         local(*F);
+ 
+         open(F, 'Cmd_subval.tmp') || die "test: can't open\n";
+ 	$i++;
+         eof F ? print "not ok $i\n" : print "ok $i\n";
+         &iseof(*F);
+ 	close F;
+ }
+ 
+ sub iseof {
+         local(*UNIQ) = @_;
+ 
+ 	$i++;
+         eof UNIQ ? print "(not ok $i)\n" : print "ok $i\n";
+ }
+ 
+ {package foo;
+ 
+  sub main'file_package {
+         local(*F) = @_;
+ 
+         open(F, 'Cmd_subval.tmp') || die "can't open\n";
+ 	$main'i++;
+         eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
+  }
+ 
+  sub main'info_package {
+         local(*F);
+ 
+         open(F, 'Cmd_subval.tmp') || die "can't open\n";
+ 	$main'i++;
+         eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
+         &iseof(*F);
+  }
+ 
+  sub iseof {
+         local(*UNIQ) = @_;
+ 
+ 	$main'i++;
+         eof UNIQ ? print "not ok $main'i\n" : print "ok $main'i\n";
+  }
+ }

Index: os2/config.h
*** os2/config.h.old	Tue Oct 16 11:54:34 1990
--- os2/config.h	Tue Oct 16 11:54:37 1990
***************
*** 14,20 ****
  #define GETPPID
  #define GETPRIORITY
  #define SETPRIORITY
- #define SYSCALL
  #define KILL
  #endif /* OS2 */
  
--- 14,19 ----
***************
*** 435,441 ****
   *	This symbol, if defined, indicates to the C program that it should
   *	include fcntl.h.
   */
! #define	I_FCNTL		/**/
  
  /* I_GRP:
   *	This symbol, if defined, indicates to the C program that it should
--- 434,440 ----
   *	This symbol, if defined, indicates to the C program that it should
   *	include fcntl.h.
   */
! /*#define	I_FCNTL		/**/
  
  /* I_GRP:
   *	This symbol, if defined, indicates to the C program that it should
***************
*** 545,551 ****
   *	execution path, but it should be accessible by the world.  The program
   *	should be prepared to do ^ expansion.
   */
! #define PRIVLIB "/usr/local/lib/perl"		/**/
  
  /*
   * BUGGY_MSC:
--- 544,550 ----
   *	execution path, but it should be accessible by the world.  The program
   *	should be prepared to do ^ expansion.
   */
! #define PRIVLIB "c:/bin/perl"		/**/
  
  /*
   * BUGGY_MSC:

Index: config_h.SH
*** config_h.SH.old	Tue Oct 16 11:46:30 1990
--- config_h.SH	Tue Oct 16 11:46:36 1990
***************
*** 421,426 ****
--- 421,431 ----
   */
  #$d_syscall	SYSCALL		/**/
  
+ /* SYSVIPC:
+  *	This symbol, if defined, indicates that System V IPC exists.
+  */
+ #$d_sysvipc	SYSVIPC	/**/
+ 
  /* TRUNCATE:
   *	This symbol, if defined, indicates that the truncate routine is
   *	available to truncate files.
***************
*** 471,476 ****
--- 476,486 ----
   */
  #$d_wait4	WAIT4	/**/
  
+ /* WAITPID:
+  *	This symbol, if defined, indicates that waitpid() exists.
+  */
+ #$d_waitpid	WAITPID	/**/
+ 
  /* GIDTYPE:
   *	This symbol has a value like gid_t, int, ushort, or whatever type is
   *	used to declare group ids in the kernel.
***************
*** 511,516 ****
--- 521,530 ----
   *	This symbol, if defined, indicates to the C program that it should
   *	include pwd.h.
   */
+ /* PWCOMMENT:
+  *	This symbol, if defined, indicates to the C program that struct passwd
+  *	contains pw_comment.
+  */
  /* PWQUOTA:
   *	This symbol, if defined, indicates to the C program that struct passwd
   *	contains pw_quota.
***************
*** 532,537 ****
--- 546,552 ----
   *	contains pw_expire.
   */
  #$i_pwd	I_PWD		/**/
+ #$d_pwcomment	PWCOMMENT	/**/
  #$d_pwquota	PWQUOTA		/**/
  #$d_pwage	PWAGE		/**/
  #$d_pwchange	PWCHANGE	/**/

Index: cons.c
Prereq: 3.0.1.7
*** cons.c.old	Tue Oct 16 11:47:07 1990
--- cons.c	Tue Oct 16 11:47:17 1990
***************
*** 1,4 ****
! /* $Header: cons.c,v 3.0.1.7 90/08/09 02:35:52 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: cons.c,v 3.0.1.8 90/10/15 15:41:09 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:	cons.c,v $
+  * Revision 3.0.1.8  90/10/15  15:41:09  lwall
+  * patch29: added caller
+  * patch29: scripts now run at almost full speed under the debugger
+  * patch29: the debugger now understands packages and evals
+  * patch29: package behavior is now more consistent
+  * 
   * Revision 3.0.1.7  90/08/09  02:35:52  lwall
   * patch19: did preliminary work toward debugging packages and evals
   * patch19: Added support for linked-in C subroutines
***************
*** 76,82 ****
  	}
  	Safefree(stab_sub(stab));
      }
!     sub->filename = filename;
      saw_return = FALSE;
      tosave = anew(Nullstab);
      tosave->ary_fill = 0;	/* make 1 based */
--- 82,88 ----
  	}
  	Safefree(stab_sub(stab));
      }
!     sub->filestab = curcmd->c_filestab;
      saw_return = FALSE;
      tosave = anew(Nullstab);
      tosave->ary_fill = 0;	/* make 1 based */
***************
*** 94,106 ****
      sub->cmd = cmd;
      stab_sub(stab) = sub;
      if (perldb) {
! 	STR *str = str_nmake((double)subline);
  
  	str_cat(str,"-");
  	sprintf(buf,"%ld",(long)curcmd->c_line);
  	str_cat(str,buf);
  	name = str_get(subname);
! 	hstore(stab_xhash(DBsub),name,strlen(name),str,0);
  	str_set(subname,"main");
      }
      subline = 0;
--- 100,117 ----
      sub->cmd = cmd;
      stab_sub(stab) = sub;
      if (perldb) {
! 	STR *str;
! 	STR *tmpstr = str_static(&str_undef);
  
+ 	sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr,
+ 	  (long)subline);
+ 	str = str_make(buf,0);
  	str_cat(str,"-");
  	sprintf(buf,"%ld",(long)curcmd->c_line);
  	str_cat(str,buf);
  	name = str_get(subname);
! 	stab_fullname(tmpstr,stab);
! 	hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
  	str_set(subname,"main");
      }
      subline = 0;
***************
*** 129,135 ****
  	}
  	Safefree(stab_sub(stab));
      }
!     sub->filename = filename;
      sub->usersub = subaddr;
      sub->userindex = ix;
      stab_sub(stab) = sub;
--- 140,146 ----
  	}
  	Safefree(stab_sub(stab));
      }
!     sub->filestab = fstab(filename);
      sub->usersub = subaddr;
      sub->userindex = ix;
      stab_sub(stab) = sub;
***************
*** 445,471 ****
  	head = cur;
      if (!head->c_line)
  	return cur;
!     str = afetch(lineary,(int)head->c_line,FALSE);
!     if (!str || str->str_nok)
  	return cur;
      str->str_u.str_nval = (double)head->c_line;
      str->str_nok = 1;
      Newz(106,cmd,1,CMD);
      cmd->c_type = C_EXPR;
      cmd->ucmd.acmd.ac_stab = Nullstab;
      cmd->ucmd.acmd.ac_expr = Nullarg;
!     arg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg);
!     arg[1].arg_type = A_SINGLE;
!     arg[1].arg_ptr.arg_str = str_nmake((double)head->c_line);
!     cmd->c_expr = make_op(O_SUBR, 2,
  	stab2arg(A_WORD,DBstab),
! 	make_list(arg),
  	Nullarg);
!     cmd->c_flags |= CF_COND|CF_DBSUB;
      cmd->c_line = head->c_line;
      cmd->c_label = head->c_label;
!     cmd->c_file = filename;
!     cmd->c_pack = curpack;
      return append_line(cmd, cur);
  }
  
--- 456,481 ----
  	head = cur;
      if (!head->c_line)
  	return cur;
!     str = afetch(stab_xarray(curcmd->c_filestab),(int)head->c_line,FALSE);
!     if (str == &str_undef || str->str_nok)
  	return cur;
      str->str_u.str_nval = (double)head->c_line;
      str->str_nok = 1;
      Newz(106,cmd,1,CMD);
+     str_magic(str, curcmd->c_filestab, 0, Nullch, 0);
+     str->str_magic->str_u.str_cmd = cmd;
      cmd->c_type = C_EXPR;
      cmd->ucmd.acmd.ac_stab = Nullstab;
      cmd->ucmd.acmd.ac_expr = Nullarg;
!     cmd->c_expr = make_op(O_SUBR, 1,
  	stab2arg(A_WORD,DBstab),
! 	Nullarg,
  	Nullarg);
!     cmd->c_flags |= CF_COND|CF_DBSUB|CFT_D0;
      cmd->c_line = head->c_line;
      cmd->c_label = head->c_label;
!     cmd->c_filestab = curcmd->c_filestab;
!     cmd->c_stash = curstash;
      return append_line(cmd, cur);
  }
  
***************
*** 491,498 ****
  	cmd->c_line = cmdline;
  	cmdline = NOLINE;
      }
!     cmd->c_file = filename;
!     cmd->c_pack = curpack;
      if (perldb)
  	cmd = dodb(cmd);
      return cmd;
--- 501,508 ----
  	cmd->c_line = cmdline;
  	cmdline = NOLINE;
      }
!     cmd->c_filestab = curcmd->c_filestab;
!     cmd->c_stash = curstash;
      if (perldb)
  	cmd = dodb(cmd);
      return cmd;
***************
*** 519,524 ****
--- 529,536 ----
  	cmd->c_line = cmdline;
  	cmdline = NOLINE;
      }
+     cmd->c_filestab = curcmd->c_filestab;
+     cmd->c_stash = curstash;
      if (perldb)
  	cmd = dodb(cmd);
      return cmd;
***************
*** 550,555 ****
--- 562,569 ----
  	cmd->c_line = cmdline;
  	cmdline = NOLINE;
      }
+     cmd->c_filestab = curcmd->c_filestab;
+     cmd->c_stash = curstash;
      cur = cmd;
      alt = cblock.comp_alt;
      while (alt && alt->c_type == C_ELSIF) {
***************
*** 939,945 ****
      else
  	(void)sprintf(tname,"next char %c",yychar);
      (void)sprintf(buf, "%s in file %s at line %d, %s\n",
!       s,filename,curcmd->c_line,tname);
      if (curcmd->c_line == multi_end && multi_start < multi_end)
  	sprintf(buf+strlen(buf),
  	  "  (Might be a runaway multi-line %c%c string starting on line %d)\n",
--- 953,959 ----
      else
  	(void)sprintf(tname,"next char %c",yychar);
      (void)sprintf(buf, "%s in file %s at line %d, %s\n",
!       s,stab_val(curcmd->c_filestab)->str_ptr,curcmd->c_line,tname);
      if (curcmd->c_line == multi_end && multi_start < multi_end)
  	sprintf(buf+strlen(buf),
  	  "  (Might be a runaway multi-line %c%c string starting on line %d)\n",
***************
*** 949,955 ****
      else
  	fputs(buf,stderr);
      if (++error_count >= 10)
! 	fatal("%s has too many errors.\n", filename);
  }
  
  void
--- 963,970 ----
      else
  	fputs(buf,stderr);
      if (++error_count >= 10)
! 	fatal("%s has too many errors.\n",
! 	stab_val(curcmd->c_filestab)->str_ptr);
  }
  
  void

Index: consarg.c
Prereq: 3.0.1.6
*** consarg.c.old	Tue Oct 16 11:47:40 1990
--- consarg.c	Tue Oct 16 11:47:53 1990
***************
*** 1,4 ****
! /* $Header: consarg.c,v 3.0.1.6 90/08/09 02:38:51 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: consarg.c,v 3.0.1.7 90/10/15 15:55:28 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:	consarg.c,v $
+  * Revision 3.0.1.7  90/10/15  15:55:28  lwall
+  * patch29: defined @foo was behaving inconsistently
+  * patch29: -5 % 5 was wrong
+  * patch29: package behavior is now more consistent
+  * 
   * Revision 3.0.1.6  90/08/09  02:38:51  lwall
   * patch19: fixed problem with % of negative number
   * 
***************
*** 92,97 ****
--- 97,105 ----
      register SPAT *spat;
      register ARG *newarg;
  
+     if (!pat)
+ 	return Nullarg;
+ 
      if ((pat->arg_type == O_MATCH ||
  	 pat->arg_type == O_SUBST ||
  	 pat->arg_type == O_TRANS ||
***************
*** 156,172 ****
  {
      register ARG *arg;
      register ARG *chld;
!     register int doarg;
      extern ARG *arg4;	/* should be normal arguments, really */
      extern ARG *arg5;
  
      arg = op_new(newlen);
      arg->arg_type = type;
-     doarg = opargs[type];
      if (chld = arg1) {
  	if (chld->arg_type == O_ITEM &&
! 	    (hoistable[chld[1].arg_type] || chld[1].arg_type == A_LVAL ||
! 	     (chld[1].arg_type == A_LEXPR &&
  	      (chld[1].arg_ptr.arg_arg->arg_type == O_LIST ||
  	       chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY ||
  	       chld[1].arg_ptr.arg_arg->arg_type == O_HASH ))))
--- 164,180 ----
  {
      register ARG *arg;
      register ARG *chld;
!     register unsigned doarg;
!     register int i;
      extern ARG *arg4;	/* should be normal arguments, really */
      extern ARG *arg5;
  
      arg = op_new(newlen);
      arg->arg_type = type;
      if (chld = arg1) {
  	if (chld->arg_type == O_ITEM &&
! 	    (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
! 	     (i == A_LEXPR &&
  	      (chld[1].arg_ptr.arg_arg->arg_type == O_LIST ||
  	       chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY ||
  	       chld[1].arg_ptr.arg_arg->arg_type == O_HASH ))))
***************
*** 181,195 ****
  	    arg[1].arg_type = A_EXPR;
  	    arg[1].arg_ptr.arg_arg = chld;
  	}
- 	if (!(doarg & 1))
- 	    arg[1].arg_type |= A_DONT;
- 	if (doarg & 2)
- 	    arg[1].arg_flags |= AF_ARYOK;
      }
-     doarg >>= 2;
      if (chld = arg2) {
  	if (chld->arg_type == O_ITEM && 
! 	    (hoistable[chld[1].arg_type] || 
  	     (type == O_ASSIGN && 
  	      ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT))
  		||
--- 189,198 ----
  	    arg[1].arg_type = A_EXPR;
  	    arg[1].arg_ptr.arg_arg = chld;
  	}
      }
      if (chld = arg2) {
  	if (chld->arg_type == O_ITEM && 
! 	    (hoistable[chld[1].arg_type&A_MASK] || 
  	     (type == O_ASSIGN && 
  	      ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT))
  		||
***************
*** 206,219 ****
  	    arg[2].arg_type = A_EXPR;
  	    arg[2].arg_ptr.arg_arg = chld;
  	}
- 	if (!(doarg & 1))
- 	    arg[2].arg_type |= A_DONT;
- 	if (doarg & 2)
- 	    arg[2].arg_flags |= AF_ARYOK;
      }
-     doarg >>= 2;
      if (chld = arg3) {
! 	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
  	    arg[3].arg_type = chld[1].arg_type;
  	    arg[3].arg_ptr = chld[1].arg_ptr;
  	    arg[3].arg_len = chld[1].arg_len;
--- 209,217 ----
  	    arg[2].arg_type = A_EXPR;
  	    arg[2].arg_ptr.arg_arg = chld;
  	}
      }
      if (chld = arg3) {
! 	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  	    arg[3].arg_type = chld[1].arg_type;
  	    arg[3].arg_ptr = chld[1].arg_ptr;
  	    arg[3].arg_len = chld[1].arg_len;
***************
*** 223,235 ****
  	    arg[3].arg_type = A_EXPR;
  	    arg[3].arg_ptr.arg_arg = chld;
  	}
- 	if (!(doarg & 1))
- 	    arg[3].arg_type |= A_DONT;
- 	if (doarg & 2)
- 	    arg[3].arg_flags |= AF_ARYOK;
      }
      if (newlen >= 4 && (chld = arg4)) {
! 	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
  	    arg[4].arg_type = chld[1].arg_type;
  	    arg[4].arg_ptr = chld[1].arg_ptr;
  	    arg[4].arg_len = chld[1].arg_len;
--- 221,229 ----
  	    arg[3].arg_type = A_EXPR;
  	    arg[3].arg_ptr.arg_arg = chld;
  	}
      }
      if (newlen >= 4 && (chld = arg4)) {
! 	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  	    arg[4].arg_type = chld[1].arg_type;
  	    arg[4].arg_ptr = chld[1].arg_ptr;
  	    arg[4].arg_len = chld[1].arg_len;
***************
*** 241,247 ****
  	}
      }
      if (newlen >= 5 && (chld = arg5)) {
! 	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
  	    arg[5].arg_type = chld[1].arg_type;
  	    arg[5].arg_ptr = chld[1].arg_ptr;
  	    arg[5].arg_len = chld[1].arg_len;
--- 235,241 ----
  	}
      }
      if (newlen >= 5 && (chld = arg5)) {
! 	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  	    arg[5].arg_type = chld[1].arg_type;
  	    arg[5].arg_ptr = chld[1].arg_ptr;
  	    arg[5].arg_len = chld[1].arg_len;
***************
*** 252,257 ****
--- 246,259 ----
  	    arg[5].arg_ptr.arg_arg = chld;
  	}
      }
+     doarg = opargs[type];
+     for (i = 1; i <= newlen; ++i) {
+ 	if (!(doarg & 1))
+ 	    arg[i].arg_type |= A_DONT;
+ 	if (doarg & 2)
+ 	    arg[i].arg_flags |= AF_ARYOK;
+ 	doarg >>= 2;
+     }
  #ifdef DEBUGGING
      if (debug & 16) {
  	fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
***************
*** 354,360 ****
  	    if (tmp2 >= 0)
  		str_numset(str,(double)(tmp2 % tmplong));
  	    else
! 		str_numset(str,(double)(tmplong - ((-tmp2 - 1) % tmplong))) - 1;
  #else
  	    tmp2 = tmp2;
  #endif
--- 356,362 ----
  	    if (tmp2 >= 0)
  		str_numset(str,(double)(tmp2 % tmplong));
  	    else
! 		str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
  #else
  	    tmp2 = tmp2;
  #endif
***************
*** 410,415 ****
--- 412,426 ----
  	    value = str_gnum(s1);
  	    str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0);
  	    break;
+ 	case O_NCMP:
+ 	    value = str_gnum(s1);
+ 	    value -= str_gnum(s2);
+ 	    if (value > 0.0)
+ 		value = 1.0;
+ 	    else if (value < 0.0)
+ 		value = -1.0;
+ 	    str_numset(str,value);
+ 	    break;
  	case O_BIT_AND:
  	    value = str_gnum(s1);
  #ifndef lint
***************
*** 499,504 ****
--- 510,518 ----
  	case O_SNE:
  	    str_numset(str,(double)(!str_eq(s1,s2)));
  	    break;
+ 	case O_SCMP:
+ 	    str_numset(str,(double)(str_cmp(s1,s2)));
+ 	    break;
  	case O_CRYPT:
  #ifdef CRYPT
  	    tmps = str_get(s1);
***************
*** 937,956 ****
  ARG *arg;
  {
      arg->arg_flags |= AF_LOCAL;
-     return arg;
- }
- 
- ARG *
- fixeval(arg)
- ARG *arg;
- {
-     Renew(arg, 3, ARG);
-     if (arg->arg_len == 0)
- 	arg[1].arg_type = A_NULL;
-     arg->arg_len = 2;
-     arg[2].arg_flags = 0;
-     arg[2].arg_ptr.arg_hash = curstash;
-     arg[2].arg_type = A_NULL;
      return arg;
  }
  
--- 951,956 ----

Index: os2/dir.h
*** os2/dir.h.old	Tue Oct 16 11:54:45 1990
--- os2/dir.h	Tue Oct 16 11:54:48 1990
***************
*** 0 ****
--- 1,163 ----
+ /*
+  * @(#) dir.h 1.4 87/11/06   Public Domain.
+  *
+  *  A public domain implementation of BSD directory routines for
+  *  MS-DOS.  Written by Michael Rendell ({uunet,utai}michael@garfield),
+  *  August 1987
+  *
+  *  Enhanced and ported to OS/2 by Kai Uwe Rommel; added scandir() prototype
+  *  December 1989, February 1990
+  */
+ 
+ 
+ #define MAXNAMLEN  12
+ #define MAXPATHLEN 128
+ 
+ #define A_RONLY    0x01
+ #define A_HIDDEN   0x02
+ #define A_SYSTEM   0x04
+ #define A_LABEL    0x08
+ #define A_DIR      0x10
+ #define A_ARCHIVE  0x20
+ 
+ 
+ struct direct
+ {
+   ino_t d_ino;                   /* a bit of a farce */
+   int   d_reclen;                /* more farce */
+   int   d_namlen;                /* length of d_name */
+   char  d_name[MAXNAMLEN + 1];   /* null terminated */
+   long  d_size;                  /* size in bytes */
+   int   d_mode;                  /* DOS or OS/2 file attributes */
+ };
+ 
+ /* The fields d_size and d_mode are extensions by me (Kai Uwe Rommel).
+  * The find_first and find_next calls deliver this data without any extra cost.
+  * If this data is needed, these fields save a lot of extra calls to stat()
+  * (each stat() again performs a find_first call !).
+  */
+ 
+ struct _dircontents
+ {
+   char *_d_entry;
+   long _d_size;
+   int _d_mode;
+   struct _dircontents *_d_next;
+ };
+ 
+ typedef struct _dirdesc
+ {
+   int  dd_id;                   /* uniquely identify each open directory */
+   long dd_loc;                  /* where we are in directory entry is this */
+   struct _dircontents *dd_contents;   /* pointer to contents of dir */
+   struct _dircontents *dd_cp;         /* pointer to current position */
+ }
+ DIR;
+ 
+ 
+ extern DIR *opendir(char *);
+ extern struct direct *readdir(DIR *);
+ extern void seekdir(DIR *, long);
+ extern long telldir(DIR *);
+ extern void closedir(DIR *);
+ #define rewinddir(dirp) seekdir(dirp, 0L)
+ 
+ extern int scandir(char *, struct direct ***,
+                    int (*)(struct direct *),
+                    int (*)(struct direct *, struct direct *));
+ 
+ extern int getfmode(char *);
+ extern int setfmode(char *, unsigned);
+ 
+ /*
+ NAME
+      opendir, readdir, telldir, seekdir, rewinddir, closedir -
+      directory operations
+ 
+ SYNTAX
+      #include <sys/types.h>
+      #include <sys/dir.h>
+ 
+      DIR *opendir(filename)
+      char *filename;
+ 
+      struct direct *readdir(dirp)
+      DIR *dirp;
+ 
+      long telldir(dirp)
+      DIR *dirp;
+ 
+      seekdir(dirp, loc)
+      DIR *dirp;
+      long loc;
+ 
+      rewinddir(dirp)
+      DIR *dirp;
+ 
+      int closedir(dirp)
+      DIR *dirp;
+ 
+ DESCRIPTION
+      The opendir library routine opens the directory named by
+      filename and associates a directory stream with it.  A
+      pointer is returned to identify the directory stream in sub-
+      sequent operations.  The pointer NULL is returned if the
+      specified filename can not be accessed, or if insufficient
+      memory is available to open the directory file.
+ 
+      The readdir routine returns a pointer to the next directory
+      entry.  It returns NULL upon reaching the end of the direc-
+      tory or on detecting an invalid seekdir operation.  The
+      readdir routine uses the getdirentries system call to read
+      directories. Since the readdir routine returns NULL upon
+      reaching the end of the directory or on detecting an error,
+      an application which wishes to detect the difference must
+      set errno to 0 prior to calling readdir.
+ 
+      The telldir routine returns the current location associated
+      with the named directory stream. Values returned by telldir
+      are good only for the lifetime of the DIR pointer from which
+      they are derived.  If the directory is closed and then reo-
+      pened, the telldir value may be invalidated due to
+      undetected directory compaction.
+ 
+      The seekdir routine sets the position of the next readdir
+      operation on the directory stream. Only values returned by
+      telldir should be used with seekdir.
+ 
+      The rewinddir routine resets the position of the named
+      directory stream to the beginning of the directory.
+ 
+      The closedir routine closes the named directory stream and
+      returns a value of 0 if successful. Otherwise, a value of -1
+      is returned and errno is set to indicate the error.  All
+      resources associated with this directory stream are
+      released.
+ 
+ EXAMPLE
+      The following sample code searches a directory for the entry
+      name.
+ 
+      len = strlen(name);
+ 
+      dirp = opendir(".");
+ 
+      for (dp = readdir(dirp); dp != NULL; dp = readdir(dirp))
+ 
+      if (dp->d_namlen == len && !strcmp(dp->d_name, name)) {
+ 
+                closedir(dirp);
+ 
+                return FOUND;
+ 
+           }
+ 
+      closedir(dirp);
+ 
+      return NOT_FOUND;
+ 
+ 
+ SEE ALSO
+      close(2), getdirentries(2), lseek(2), open(2), read(2),
+      dir(5)
+ */

Index: os2/director.c
*** os2/director.c.old	Tue Oct 16 11:54:54 1990
--- os2/director.c	Tue Oct 16 11:54:58 1990
***************
*** 0 ****
--- 1,200 ----
+ /*
+  * @(#)dir.c 1.4 87/11/06 Public Domain.
+  *
+  *  A public domain implementation of BSD directory routines for
+  *  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>
+ #include <sys/stat.h>
+ #include <sys/dir.h>
+ 
+ #include <stdio.h>
+ #include <malloc.h>
+ #include <string.h>
+ 
+ #define INCL_NOPM
+ #include <os2.h>
+ 
+ 
+ int attributes = A_DIR | A_HIDDEN;
+ 
+ 
+ static char *getdirent(char *);
+ static void free_dircontents(struct _dircontents *);
+ 
+ static HDIR hdir;
+ static USHORT count;
+ static FILEFINDBUF find;
+ 
+ 
+ DIR *opendir(char *name)
+ {
+   struct stat statb;
+   DIR *dirp;
+   char c;
+   char *s;
+   struct _dircontents *dp;
+   char nbuf[MAXPATHLEN + 1];
+ 
+   strcpy(nbuf, name);
+ 
+   if ( ((c = nbuf[strlen(nbuf) - 1]) == '\\' || c == '/') &&
+        (strlen(nbuf) > 1) )
+   {
+     nbuf[strlen(nbuf) - 1] = 0;
+ 
+     if ( nbuf[strlen(nbuf) - 1] == ':' )
+       strcat(nbuf, "\\.");
+   }
+   else
+     if ( nbuf[strlen(nbuf) - 1] == ':' )
+       strcat(nbuf, ".");
+ 
+   if (stat(nbuf, &statb) < 0 || (statb.st_mode & S_IFMT) != S_IFDIR)
+     return NULL;
+ 
+   if ( (dirp = malloc(sizeof(DIR))) == NULL )
+     return NULL;
+ 
+   if ( nbuf[strlen(nbuf) - 1] == '.' )
+     strcpy(nbuf + strlen(nbuf) - 1, "*.*");
+   else
+     if ( ((c = nbuf[strlen(nbuf) - 1]) == '\\' || c == '/') &&
+          (strlen(nbuf) == 1) )
+       strcat(nbuf, "*.*");
+     else
+       strcat(nbuf, "\\*.*");
+ 
+   dirp -> dd_loc = 0;
+   dirp -> dd_contents = dirp -> dd_cp = NULL;
+ 
+   if ((s = getdirent(nbuf)) == NULL)
+     return dirp;
+ 
+   do
+   {
+     if (((dp = malloc(sizeof(struct _dircontents))) == NULL) ||
+         ((dp -> _d_entry = malloc(strlen(s) + 1)) == NULL)      )
+     {
+       if (dp)
+         free(dp);
+       free_dircontents(dirp -> dd_contents);
+ 
+       return NULL;
+     }
+ 
+     if (dirp -> dd_contents)
+       dirp -> dd_cp = dirp -> dd_cp -> _d_next = dp;
+     else
+       dirp -> dd_contents = dirp -> dd_cp = dp;
+ 
+     strcpy(dp -> _d_entry, s);
+     dp -> _d_next = NULL;
+ 
+     dp -> _d_size = find.cbFile;
+     dp -> _d_mode = find.attrFile;
+     dp -> _d_time = *(unsigned *) &(find.ftimeLastWrite);
+     dp -> _d_date = *(unsigned *) &(find.fdateLastWrite);
+   }
+   while ((s = getdirent(NULL)) != NULL);
+ 
+   dirp -> dd_cp = dirp -> dd_contents;
+ 
+   return dirp;
+ }
+ 
+ 
+ void closedir(DIR * dirp)
+ {
+   free_dircontents(dirp -> dd_contents);
+   free(dirp);
+ }
+ 
+ 
+ struct direct *readdir(DIR * dirp)
+ {
+   static struct direct dp;
+ 
+   if (dirp -> dd_cp == NULL)
+     return NULL;
+ 
+   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;
+   dp.d_mode = dirp -> dd_cp -> _d_mode;
+   dp.d_time = dirp -> dd_cp -> _d_time;
+   dp.d_date = dirp -> dd_cp -> _d_date;
+ 
+   dirp -> dd_cp = dirp -> dd_cp -> _d_next;
+   dirp -> dd_loc++;
+ 
+   return &dp;
+ }
+ 
+ 
+ void seekdir(DIR * dirp, long off)
+ {
+   long i = off;
+   struct _dircontents *dp;
+ 
+   if (off >= 0)
+   {
+     for (dp = dirp -> dd_contents; --i >= 0 && dp; dp = dp -> _d_next);
+ 
+     dirp -> dd_loc = off - (i + 1);
+     dirp -> dd_cp = dp;
+   }
+ }
+ 
+ 
+ long telldir(DIR * dirp)
+ {
+   return dirp -> dd_loc;
+ }
+ 
+ 
+ static void free_dircontents(struct _dircontents * dp)
+ {
+   struct _dircontents *odp;
+ 
+   while (dp)
+   {
+     if (dp -> _d_entry)
+       free(dp -> _d_entry);
+ 
+     dp = (odp = dp) -> _d_next;
+     free(odp);
+   }
+ }
+ 
+ 
+ static char *getdirent(char *dir)
+ {
+   int done;
+ 
+   if (dir != NULL)
+   {				       /* get first entry */
+     hdir = HDIR_CREATE;
+     count = 1;
+     done = DosFindFirst(dir, &hdir, attributes,
+ 			&find, sizeof(find), &count, 0L);
+   }
+   else				       /* get next entry */
+     done = DosFindNext(hdir, &find, sizeof(find), &count);
+ 
+   if (done == 0)
+     return find.achName;
+   else
+   {
+     DosFindClose(hdir);
+     return NULL;
+   }
+ }

*** End of Patch 30 ***