[comp.sources.misc] v20i057: perl - The perl programming language, Patch05

lwall@netlabs.com (Larry Wall) (06/20/91)

Submitted-by: Larry Wall <lwall@netlabs.com>
Posting-number: Volume 20, Issue 57
Archive-name: perl/patch05
Patch-To: perl: Volume 18, Issue 19-54

System: perl version 4.0
Patch #: 5
Priority: High
Subject: patch #4, continued

Description:
	See patch #4.

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 #09 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@netlabs.com

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

	Subject: Command
	@SH mailpatch PATH perl 4.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.


Index: patchlevel.h
Prereq: 4
1c1
< #define PATCHLEVEL 4
---
> #define PATCHLEVEL 5

Index: t/TEST
Prereq: 4.0
*** t/TEST.old	Fri Jun  7 12:27:03 1991
--- t/TEST	Fri Jun  7 12:27:03 1991
***************
*** 1,6 ****
  #!./perl
  
! # $Header: TEST,v 4.0 91/03/20 01:40:22 lwall Locked $
  
  # This is written in a peculiar style, since we're trying to avoid
  # most of the constructs we'll be testing for.
--- 1,6 ----
  #!./perl
  
! # $RCSfile: TEST,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:59:30 $
  
  # This is written in a peculiar style, since we're trying to avoid
  # most of the constructs we'll be testing for.
***************
*** 56,61 ****
--- 56,63 ----
  	unless (/^#/) {
  	    if (/^1\.\.([0-9]+)/) {
  		$max = $1;
+ 		$totmax += $max;
+ 		$files += 1;
  		$next = 1;
  		$ok = 1;
  	    } else {
***************
*** 96,99 ****
      }
  }
  ($user,$sys,$cuser,$csys) = times;
! print sprintf("u=%g  s=%g  cu=%g  cs=%g\n",$user,$sys,$cuser,$csys);
--- 98,102 ----
      }
  }
  ($user,$sys,$cuser,$csys) = times;
! print sprintf("u=%g  s=%g  cu=%g  cs=%g  files=%d  tests=%d\n",
!     $user,$sys,$cuser,$csys,$files,$totmax);

Index: x2p/a2p.h
Prereq: 4.0
*** x2p/a2p.h.old	Fri Jun  7 12:27:43 1991
--- x2p/a2p.h	Fri Jun  7 12:27:44 1991
***************
*** 1,11 ****
! /* $Header: a2p.h,v 4.0 91/03/20 01:57:07 lwall Locked $
   *
!  *    Copyright (c) 1989, Larry Wall
   *
!  *    You may distribute under the terms of the GNU General Public License
!  *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	a2p.h,v $
   * Revision 4.0  91/03/20  01:57:07  lwall
   * 4.0 baseline.
   * 
--- 1,14 ----
! /* $RCSfile: a2p.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:27 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    You may distribute under the terms of either the GNU General Public
!  *    License or the Artistic License, as specified in the README file.
   *
   * $Log:	a2p.h,v $
+  * Revision 4.0.1.1  91/06/07  12:12:27  lwall
+  * patch4: new copyright notice
+  * 
   * Revision 4.0  91/03/20  01:57:07  lwall
   * 4.0 baseline.
   * 

Index: x2p/a2p.y
Prereq: 4.0
*** x2p/a2p.y.old	Fri Jun  7 12:27:47 1991
--- x2p/a2p.y	Fri Jun  7 12:27:47 1991
***************
*** 1,12 ****
  %{
! /* $Header: a2p.y,v 4.0 91/03/20 01:57:21 lwall Locked $
   *
!  *    Copyright (c) 1989, Larry Wall
   *
!  *    You may distribute under the terms of the GNU General Public License
!  *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	a2p.y,v $
   * Revision 4.0  91/03/20  01:57:21  lwall
   * 4.0 baseline.
   * 
--- 1,15 ----
  %{
! /* $RCSfile: a2p.y,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:41 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    You may distribute under the terms of either the GNU General Public
!  *    License or the Artistic License, as specified in the README file.
   *
   * $Log:	a2p.y,v $
+  * Revision 4.0.1.1  91/06/07  12:12:41  lwall
+  * patch4: new copyright notice
+  * 
   * Revision 4.0  91/03/20  01:57:21  lwall
   * 4.0 baseline.
   * 

Index: x2p/a2py.c
Prereq: 4.0
*** x2p/a2py.c.old	Fri Jun  7 12:27:50 1991
--- x2p/a2py.c	Fri Jun  7 12:27:51 1991
***************
*** 1,11 ****
! /* $Header: a2py.c,v 4.0 91/03/20 01:57:26 lwall Locked $
   *
!  *    Copyright (c) 1989, Larry Wall
   *
!  *    You may distribute under the terms of the GNU General Public License
!  *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	a2py.c,v $
   * Revision 4.0  91/03/20  01:57:26  lwall
   * 4.0 baseline.
   * 
--- 1,14 ----
! /* $RCSfile: a2py.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:59 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    You may distribute under the terms of either the GNU General Public
!  *    License or the Artistic License, as specified in the README file.
   *
   * $Log:	a2py.c,v $
+  * Revision 4.0.1.1  91/06/07  12:12:59  lwall
+  * patch4: new copyright notice
+  * 
   * Revision 4.0  91/03/20  01:57:26  lwall
   * 4.0 baseline.
   * 

Index: hints/aix_rs.sh
*** hints/aix_rs.sh.old	Fri Jun  7 12:24:20 1991
--- hints/aix_rs.sh	Fri Jun  7 12:24:20 1991
***************
*** 1 ****
! optimize='-g'
--- 1,4 ----
! eval_cflags='optimize="-g"'
! toke_cflags='optimize="-g"'
! teval_cflags='optimize="-g"'
! ttoke_cflags='optimize="-g"'; cflags="$cflags -D_NO_PROTO"

Index: hints/apollo_C6_7.sh
*** hints/apollo_C6_7.sh.old	Fri Jun  7 12:24:22 1991
--- hints/apollo_C6_7.sh	Fri Jun  7 12:24:23 1991
***************
*** 1 ****
--- 1,4 ----
  optimize='-opt 2'
+ cflags='-A nansi cpu,mathchip -O -U__STDC__'
+ echo "Some tests may fail unless you use 'chacl -B'.  Also, op/stat"
+ echo "test 2 may fail because Apollo doesn't support mtime or ctime."

Index: arg.h
Prereq: 4.0
*** arg.h.old	Fri Jun  7 12:22:41 1991
--- arg.h	Fri Jun  7 12:22:42 1991
***************
*** 1,11 ****
! /* $Header: arg.h,v 4.0 91/03/20 01:03:09 lwall Locked $
   *
!  *    Copyright (c) 1989, Larry Wall
   *
!  *    You may distribute under the terms of the GNU General Public License
!  *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	arg.h,v $
   * Revision 4.0  91/03/20  01:03:09  lwall
   * 4.0 baseline.
   * 
--- 1,16 ----
! /* $RCSfile: arg.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:18:30 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    You may distribute under the terms of either the GNU General Public
!  *    License or the Artistic License, as specified in the README file.
   *
   * $Log:	arg.h,v $
+  * Revision 4.0.1.1  91/06/07  10:18:30  lwall
+  * patch4: length($`), length($&), length($') now optimized to avoid string copy
+  * patch4: new copyright notice
+  * patch4: many, many itty-bitty portability fixes
+  * 
   * Revision 4.0  91/03/20  01:03:09  lwall
   * 4.0 baseline.
   * 
***************
*** 270,276 ****
  #define O_SGRENT 256
  #define O_EGRENT 257
  #define O_GETLOGIN 258
! #define O_OPENDIR 259
  #define O_READDIR 260
  #define O_TELLDIR 261
  #define O_SEEKDIR 262
--- 275,281 ----
  #define O_SGRENT 256
  #define O_EGRENT 257
  #define O_GETLOGIN 258
! #define O_OPEN_DIR 259
  #define O_READDIR 260
  #define O_TELLDIR 261
  #define O_SEEKDIR 262
***************
*** 576,581 ****
--- 581,587 ----
  #define A_STAR 18
  #define A_LSTAR 19
  #define A_WANTARRAY 20
+ #define A_LENSTAB 21
  
  #define A_MASK 31
  #define A_DONT 32		/* or this into type to suppress evaluation */
***************
*** 605,611 ****
      "STAR",
      "LSTAR",
      "WANTARRAY",
!     "21"
  };
  #endif
  
--- 611,618 ----
      "STAR",
      "LSTAR",
      "WANTARRAY",
!     "LENSTAB",
!     "22"
  };
  #endif
  
***************
*** 634,639 ****
--- 641,647 ----
     1,	/* STAR */
     1,	/* LSTAR */
     1,	/* WANTARRAY */
+    0,	/* LENSTAB */
     0,	/* 21 */
  };
  #endif

Index: array.c
Prereq: 4.0
*** array.c.old	Fri Jun  7 12:22:44 1991
--- array.c	Fri Jun  7 12:22:45 1991
***************
*** 1,11 ****
! /* $Header: array.c,v 4.0 91/03/20 01:03:32 lwall Locked $
   *
!  *    Copyright (c) 1989, Larry Wall
   *
!  *    You may distribute under the terms of the GNU General Public License
!  *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	array.c,v $
   * Revision 4.0  91/03/20  01:03:32  lwall
   * 4.0 baseline.
   * 
--- 1,14 ----
! /* $RCSfile: array.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:19:08 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    You may distribute under the terms of either the GNU General Public
!  *    License or the Artistic License, as specified in the README file.
   *
   * $Log:	array.c,v $
+  * Revision 4.0.1.1  91/06/07  10:19:08  lwall
+  * patch4: new copyright notice
+  * 
   * Revision 4.0  91/03/20  01:03:32  lwall
   * 4.0 baseline.
   * 

Index: array.h
Prereq: 4.0
*** array.h.old	Fri Jun  7 12:22:47 1991
--- array.h	Fri Jun  7 12:22:48 1991
***************
*** 1,11 ****
! /* $Header: array.h,v 4.0 91/03/20 01:03:44 lwall Locked $
   *
!  *    Copyright (c) 1989, Larry Wall
   *
!  *    You may distribute under the terms of the GNU General Public License
!  *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	array.h,v $
   * Revision 4.0  91/03/20  01:03:44  lwall
   * 4.0 baseline.
   * 
--- 1,14 ----
! /* $RCSfile: array.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:19:20 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    You may distribute under the terms of either the GNU General Public
!  *    License or the Artistic License, as specified in the README file.
   *
   * $Log:	array.h,v $
+  * Revision 4.0.1.1  91/06/07  10:19:20  lwall
+  * patch4: new copyright notice
+  * 
   * Revision 4.0  91/03/20  01:03:44  lwall
   * 4.0 baseline.
   * 

Index: hints/aux.sh
*** hints/aux.sh.old	Fri Jun  7 12:24:25 1991
--- hints/aux.sh	Fri Jun  7 12:24:26 1991
***************
*** 1,2 ****
  optimize='-O'
! ccflags="$ccflags -B/usr/lib/bin/'
--- 1,2 ----
  optimize='-O'
! ccflags="$ccflags -B/usr/lib/big/ -DPARAM_NEEDS_TYPES"

Index: cflags.SH
*** cflags.SH.old	Fri Jun  7 12:22:50 1991
--- cflags.SH	Fri Jun  7 12:22:50 1991
***************
*** 5,80 ****
  	ln ../../config.sh . || \
  	ln ../../../config.sh . || \
  	(echo "Can't find config.sh."; exit 1)
!     fi 2>/dev/null
!     . ./config.sh
      ;;
  esac
  case "$0" in
  */*) cd `expr X$0 : 'X\(.*\)/'` ;;
  esac
  
  also=': '
  case $# in
! 1) also='echo 1>&2 "	  CFLAGS = "'
  esac
  
  case $# in
  0) set *.c; echo "The current C flags are:" ;;
- *) set `echo "$* " | sed 's/\.o /.c /g'`
  esac
  for file do
  
      case "$#" in
      1) ;;
!     *) echo $n "    $file	$c" ;;
      esac
  
      case "$file" in
!     array.c) ;;
!     cmd.c) ;;
!     cons.c) ;;
!     consarg.c) ;;
!     doarg.c) ;;
!     doio.c) ;;
!     dolist.c) ;;
!     dump.c) ;;
!     eval.c) ;;
!     form.c) ;;
!     hash.c) ;;
!     malloc.c) ;;
!     perl.c) ;;
!     perly.c) ;;
!     regcomp.c) ;;
!     regexec.c) ;;
!     stab.c) ;;
!     str.c) ;;
!     toke.c) ;;
!     usersub.c) ;;
!     util.c) ;;
!     tarray.c) ;;
!     tcmd.c) ;;
!     tcons.c) ;;
!     tconsarg.c) ;;
!     tdoarg.c) ;;
!     tdoio.c) ;;
!     tdolist.c) ;;
!     tdump.c) ;;
!     teval.c) ;;
!     tform.c) ;;
!     thash.c) ;;
!     tmalloc.c) ;;
!     tperl.c) ;;
!     tperly.c) ;;
!     tregcomp.c) ;;
!     tregexec.c) ;;
!     tstab.c) ;;
!     tstr.c) ;;
!     ttoke.c) ;;
!     tusersub.c) ;;
!     tutil.c) ;;
      *) ;;
      esac
  
!     echo "$ccflags $optimize $large $split"
!     eval "$also $ccflags $optimize $large $split"
  done
--- 5,120 ----
  	ln ../../config.sh . || \
  	ln ../../../config.sh . || \
  	(echo "Can't find config.sh."; exit 1)
!     fi
!     . config.sh
      ;;
  esac
+ : This forces SH files to create target in same directory as SH file.
+ : This is so that make depend always knows where to find SH derivatives.
  case "$0" in
  */*) cd `expr X$0 : 'X\(.*\)/'` ;;
  esac
+ echo "Extracting cflags (with variable substitutions)"
+ : This section of the file will have variable substitutions done on it.
+ : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
+ : Protect any dollar signs and backticks that you do not want interpreted
+ : by putting a backslash in front.  You may delete these comments.
+ $spitshell >cflags <<!GROK!THIS!
+ !GROK!THIS!
  
+ : In the following dollars and backticks do not need the extra backslash.
+ $spitshell >>cflags <<'!NO!SUBS!'
+ case "$0" in
+ */*) cd `expr X$0 : 'X\(.*\)/'` ;;
+ esac
+ case $CONFIG in
+ '')
+     if test ! -f config.sh; then
+ 	ln ../config.sh . || \
+ 	ln ../../config.sh . || \
+ 	ln ../../../config.sh . || \
+ 	(echo "Can't find config.sh."; exit 1)
+     fi 2>/dev/null
+     . ./config.sh
+     ;;
+ esac
+ 
  also=': '
  case $# in
! 1) also='echo 1>&2 "	  CCCMD = "'
  esac
  
  case $# in
  0) set *.c; echo "The current C flags are:" ;;
  esac
+ 
+ set `echo "$* " | sed 's/\.[oc] / /g'`
+ 
  for file do
  
      case "$#" in
      1) ;;
!     *) echo $n "    $file.c	$c" ;;
      esac
  
+     : allow variables like toke_cflags to be evaluated
+ 
+     eval 'eval ${'"${file}_cflags"'-""}'
+ 
+     : or customize here
+ 
      case "$file" in
!     array) ;;
!     cmd) ;;
!     cons) ;;
!     consarg) ;;
!     doarg) ;;
!     doio) ;;
!     dolist) ;;
!     dump) ;;
!     eval) ;;
!     form) ;;
!     hash) ;;
!     malloc) ;;
!     perl) ;;
!     perly) ;;
!     regcomp) ;;
!     regexec) ;;
!     stab) ;;
!     str) ;;
!     toke) ;;
!     usersub) ;;
!     util) ;;
!     tarray) ;;
!     tcmd) ;;
!     tcons) ;;
!     tconsarg) ;;
!     tdoarg) ;;
!     tdoio) ;;
!     tdolist) ;;
!     tdump) ;;
!     teval) ;;
!     tform) ;;
!     thash) ;;
!     tmalloc) ;;
!     tperl) ;;
!     tperly) ;;
!     tregcomp) ;;
!     tregexec) ;;
!     tstab) ;;
!     tstr) ;;
!     ttoke) ;;
!     tusersub) ;;
!     tutil) ;;
      *) ;;
      esac
  
!     echo "$cc -c $ccflags $optimize $large $split"
!     eval "$also "'"$cc -c $ccflags $optimize $large $split"'
! 
!     . ./config.sh
! 
  done
+ !NO!SUBS!
+ chmod +x cflags
+ $eunicefix cflags

Index: x2p/cflags.SH
*** x2p/cflags.SH.old	Fri Jun  7 12:27:53 1991
--- x2p/cflags.SH	Fri Jun  7 12:27:54 1991
***************
*** 0 ****
--- 1,84 ----
+ case $CONFIG in
+ '')
+     if test ! -f config.sh; then
+ 	ln ../config.sh . || \
+ 	ln ../../config.sh . || \
+ 	ln ../../../config.sh . || \
+ 	(echo "Can't find config.sh."; exit 1)
+     fi
+     . config.sh
+     ;;
+ esac
+ : This forces SH files to create target in same directory as SH file.
+ : This is so that make depend always knows where to find SH derivatives.
+ case "$0" in
+ */*) cd `expr X$0 : 'X\(.*\)/'` ;;
+ esac
+ echo "Extracting cflags (with variable substitutions)"
+ : This section of the file will have variable substitutions done on it.
+ : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
+ : Protect any dollar signs and backticks that you do not want interpreted
+ : by putting a backslash in front.  You may delete these comments.
+ $spitshell >cflags <<!GROK!THIS!
+ !GROK!THIS!
+ 
+ : In the following dollars and backticks do not need the extra backslash.
+ $spitshell >>cflags <<'!NO!SUBS!'
+ case "$0" in
+ */*) cd `expr X$0 : 'X\(.*\)/'` ;;
+ esac
+ case $CONFIG in
+ '')
+     if test ! -f config.sh; then
+ 	ln ../config.sh . || \
+ 	ln ../../config.sh . || \
+ 	ln ../../../config.sh . || \
+ 	(echo "Can't find config.sh."; exit 1)
+     fi 2>/dev/null
+     . ./config.sh
+     ;;
+ esac
+ 
+ also=': '
+ case $# in
+ 1) also='echo 1>&2 "	  CCCMD = "'
+ esac
+ 
+ case $# in
+ 0) set *.c; echo "The current C flags are:" ;;
+ esac
+ 
+ set `echo "$* " | sed 's/\.[oc] / /g'`
+ 
+ for file do
+ 
+     case "$#" in
+     1) ;;
+     *) echo $n "    $file.c	$c" ;;
+     esac
+ 
+     : allow variables like str_cflags to be evaluated
+ 
+     eval 'eval ${'"${file}_cflags"'-""}'
+ 
+     : or customize here
+ 
+     case "$file" in
+     a2p) ;;
+     a2py) ;;
+     hash) ;;
+     str) ;;
+     util) ;;
+     walk) ;;
+     *) ;;
+     esac
+ 
+     echo "$cc -c $ccflags $optimize $large $split"
+     eval "$also "'"$cc -c $ccflags $optimize $large $split"'
+ 
+     . ./config.sh
+ 
+ done
+ !NO!SUBS!
+ chmod +x cflags
+ $eunicefix cflags

Index: msdos/chdir.c
*** msdos/chdir.c.old	Fri Jun  7 12:25:32 1991
--- msdos/chdir.c	Fri Jun  7 12:25:33 1991
***************
*** 1,8 ****
  /*
   *    (C) Copyright 1990, 1991 Tom Dinger
   *
!  *    You may distribute under the terms of the GNU General Public License
!  *    as specified in the README file that comes with the perl 4.0 kit.
   *
   */
  
--- 1,8 ----
  /*
   *    (C) Copyright 1990, 1991 Tom Dinger
   *
!  *    You may distribute under the terms of either the GNU General Public
!  *    License or the Artistic License, as specified in the README file.
   *
   */
  

Index: cmd.c
*** cmd.c.old	Fri Jun  7 12:22:53 1991
--- cmd.c	Fri Jun  7 12:22:55 1991
***************
*** 1,11 ****
! /* $RCSfile: cmd.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:36:16 $
   *
!  *    Copyright (c) 1989, Larry Wall
   *
!  *    You may distribute under the terms of the GNU General Public License
!  *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	cmd.c,v $
   * Revision 4.0.1.1  91/04/11  17:36:16  lwall
   * patch1: you may now use "die" and "caller" in a signal handler
   * 
--- 1,15 ----
! /* $RCSfile: cmd.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:26:45 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    You may distribute under the terms of either the GNU General Public
!  *    License or the Artistic License, as specified in the README file.
   *
   * $Log:	cmd.c,v $
+  * Revision 4.0.1.2  91/06/07  10:26:45  lwall
+  * patch4: new copyright notice
+  * patch4: made some allowances for "semi-standard" C
+  * 
   * Revision 4.0.1.1  91/04/11  17:36:16  lwall
   * patch1: you may now use "die" and "caller" in a signal handler
   * 
***************
*** 27,33 ****
  
  /* do longjmps() clobber register variables? */
  
! #if defined(cray) || defined(__STDC__)
  #define JMPCLOBBER
  #endif
  
--- 31,37 ----
  
  /* do longjmps() clobber register variables? */
  
! #if defined(cray) || defined(STANDARD_C)
  #define JMPCLOBBER
  #endif
  

Index: cmd.h
Prereq: 4.0
*** cmd.h.old	Fri Jun  7 12:22:58 1991
--- cmd.h	Fri Jun  7 12:22:59 1991
***************
*** 1,11 ****
! /* $Header: cmd.h,v 4.0 91/03/20 01:04:34 lwall Locked $
   *
!  *    Copyright (c) 1989, Larry Wall
   *
!  *    You may distribute under the terms of the GNU General Public License
!  *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	cmd.h,v $
   * Revision 4.0  91/03/20  01:04:34  lwall
   * 4.0 baseline.
   * 
--- 1,15 ----
! /* $RCSfile: cmd.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:28:50 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    You may distribute under the terms of either the GNU General Public
!  *    License or the Artistic License, as specified in the README file.
   *
   * $Log:	cmd.h,v $
+  * Revision 4.0.1.1  91/06/07  10:28:50  lwall
+  * patch4: new copyright notice
+  * patch4: length($`), length($&), length($') now optimized to avoid string copy
+  * 
   * Revision 4.0  91/03/20  01:04:34  lwall
   * 4.0 baseline.
   * 
***************
*** 161,165 ****
  };
  
  void opt_arg();
! void evalstatic();
  int cmd_exec();
--- 165,169 ----
  };
  
  void opt_arg();
! ARG* evalstatic();
  int cmd_exec();

Index: config.H
*** config.H.old	Fri Jun  7 12:23:01 1991
--- config.H	Fri Jun  7 12:23:02 1991
***************
*** 29,35 ****
   *	This symbol contains the number of bytes required to align a double.
   *	Usual values are 2, 4, and 8.
   */
! #define ALIGNBYTES 4		/**/
  
  /* BIN
   *	This symbol holds the name of the directory in which the user wants
--- 29,35 ----
   *	This symbol contains the number of bytes required to align a double.
   *	Usual values are 2, 4, and 8.
   */
! #define ALIGNBYTES 2		/**/
  
  /* BIN
   *	This symbol holds the name of the directory in which the user wants
***************
*** 42,48 ****
   *	This symbol contains an encoding of the order of bytes in a long.
   *	Usual values (in octal) are 01234, 04321, 02143, 03412...
   */
! #define BYTEORDER 0x1234		/**/
  
  /* CPPSTDIN
   *	This symbol contains the first part of the string which will invoke
--- 42,48 ----
   *	This symbol contains an encoding of the order of bytes in a long.
   *	Usual values (in octal) are 01234, 04321, 02143, 03412...
   */
! #define BYTEORDER 0x4321		/**/
  
  /* CPPSTDIN
   *	This symbol contains the first part of the string which will invoke
***************
*** 55,62 ****
   *	output.  This symbol will have the value "-" if CPPSTDIN needs a minus
   *	to specify standard input, otherwise the value is "".
   */
! #define CPPSTDIN "cc -E"
! #define CPPMINUS "-"
  
  /* HAS_BCMP
   *	This symbol, if defined, indicates that the bcmp routine is available
--- 55,62 ----
   *	output.  This symbol will have the value "-" if CPPSTDIN needs a minus
   *	to specify standard input, otherwise the value is "".
   */
! #define CPPSTDIN "/usr/lib/cpp"
! #define CPPMINUS ""
  
  /* HAS_BCMP
   *	This symbol, if defined, indicates that the bcmp routine is available
***************
*** 89,96 ****
   *		1 = couldn't cast < 0
   *		2 = couldn't cast >= 0x80000000
   */
! #define	CASTNEGFLOAT	/**/
! #define	CASTFLAGS 0	/**/
  
  /* CHARSPRINTF
   *	This symbol is defined if this system declares "char *sprintf()" in
--- 89,96 ----
   *		1 = couldn't cast < 0
   *		2 = couldn't cast >= 0x80000000
   */
! /*#undef	CASTNEGFLOAT	/**/
! #define	CASTFLAGS 1	/**/
  
  /* CHARSPRINTF
   *	This symbol is defined if this system declares "char *sprintf()" in
***************
*** 180,186 ****
   *	This symbol, if defined, indicates that the gethostent() routine is
   *	available to lookup host names in some data base or other.
   */
! #define	HAS_GETHOSTENT		/**/
  
  /* HAS_GETPGRP
   *	This symbol, if defined, indicates that the getpgrp() routine is
--- 180,186 ----
   *	This symbol, if defined, indicates that the gethostent() routine is
   *	available to lookup host names in some data base or other.
   */
! /*#undef	HAS_GETHOSTENT		/**/
  
  /* HAS_GETPGRP
   *	This symbol, if defined, indicates that the getpgrp() routine is
***************
*** 439,446 ****
--- 439,452 ----
   *	This symbol, if defined, indicates that the shmat() routine is
   *	available to stat symbolic links.
   */
+ /* VOID_SHMAT
+  *	This symbol, if defined, indicates that the shmat() routine
+  *	returns a pointer of type void*.
+  */
  #define	HAS_SHMAT		/**/
  
+ /*#undef	VOIDSHMAT		/**/
+ 
  /* HAS_SHMCTL
   *	This symbol, if defined, indicates that the shmctl() routine is
   *	available to stat symbolic links.
***************
*** 537,544 ****
   *	a signal handler using "TO_SIGNAL (*handler())()", and define the
   *	handler using "TO_SIGNAL handler(sig)".
   */
! /*#undef	VOIDSIG 	/**/
! #define	TO_SIGNAL	 	/**/
  
  /* HASVOLATILE
   *	This symbol, if defined, indicates that this C compiler knows about
--- 543,550 ----
   *	a signal handler using "TO_SIGNAL (*handler())()", and define the
   *	handler using "TO_SIGNAL handler(sig)".
   */
! #define	VOIDSIG 	/**/
! #define	TO_SIGNAL	int 	/**/
  
  /* HASVOLATILE
   *	This symbol, if defined, indicates that this C compiler knows about
***************
*** 557,564 ****
   *	is up to the package author to declare vsprintf correctly based on the
   *	symbol.
   */
! /*#undef	HAS_VPRINTF	/**/
! /*#undef	CHARVSPRINTF 	/**/
  
  /* HAS_WAIT4
   *	This symbol, if defined, indicates that wait4() exists.
--- 563,570 ----
   *	is up to the package author to declare vsprintf correctly based on the
   *	symbol.
   */
! #define	HAS_VPRINTF	/**/
! #define	CHARVSPRINTF 	/**/
  
  /* HAS_WAIT4
   *	This symbol, if defined, indicates that wait4() exists.
***************
*** 568,581 ****
  /* HAS_WAITPID
   *	This symbol, if defined, indicates that waitpid() exists.
   */
! /*#undef	HAS_WAITPID	/**/
  
  /* GIDTYPE
   *	This symbol has a value like gid_t, int, ushort, or whatever type is
   *	used to declare group ids in the kernel.
   */
! #define GIDTYPE int		/**/
  
  /* I_FCNTL
   *	This manifest constant tells the C program to include <fcntl.h>.
   */
--- 574,593 ----
  /* HAS_WAITPID
   *	This symbol, if defined, indicates that waitpid() exists.
   */
! #define	HAS_WAITPID	/**/
  
  /* GIDTYPE
   *	This symbol has a value like gid_t, int, ushort, or whatever type is
   *	used to declare group ids in the kernel.
   */
! #define GIDTYPE gid_t		/**/
  
+ /* GROUPSTYPE
+  *	This symbol has a value like gid_t, int, ushort, or whatever type is
+  *	used in the return value of getgroups().
+  */
+ #define GROUPSTYPE int		/**/
+ 
  /* I_FCNTL
   *	This manifest constant tells the C program to include <fcntl.h>.
   */
***************
*** 634,644 ****
   */
  #define	I_PWD		/**/
  /*#undef	PWQUOTA		/**/
! /*#undef	PWAGE		/**/
  /*#undef	PWCHANGE	/**/
  /*#undef	PWCLASS		/**/
  /*#undef	PWEXPIRE	/**/
! /*#undef	PWCOMMENT	/**/
  
  /* I_SYS_FILE
   *	This manifest constant tells the C program to include <sys/file.h>.
--- 646,656 ----
   */
  #define	I_PWD		/**/
  /*#undef	PWQUOTA		/**/
! #define	PWAGE		/**/
  /*#undef	PWCHANGE	/**/
  /*#undef	PWCLASS		/**/
  /*#undef	PWEXPIRE	/**/
! #define	PWCOMMENT	/**/
  
  /* I_SYS_FILE
   *	This manifest constant tells the C program to include <sys/file.h>.
***************
*** 673,679 ****
   *	This symbol, if defined, indicates to the C program that it should
   *	include utime.h.
   */
! /*#undef	I_UTIME		/**/
  
  /* I_VARARGS
   *	This symbol, if defined, indicates to the C program that it should
--- 685,691 ----
   *	This symbol, if defined, indicates to the C program that it should
   *	include utime.h.
   */
! #define	I_UTIME		/**/
  
  /* I_VARARGS
   *	This symbol, if defined, indicates to the C program that it should
***************
*** 685,691 ****
   *	This symbol, if defined, indicates to the C program that it should
   *	include vfork.h.
   */
! /*#undef	I_VFORK		/**/
  
  /* INTSIZE
   *	This symbol contains the size of an int, so that the C preprocessor
--- 697,703 ----
   *	This symbol, if defined, indicates to the C program that it should
   *	include vfork.h.
   */
! #define	I_VFORK		/**/
  
  /* INTSIZE
   *	This symbol contains the size of an int, so that the C preprocessor
***************
*** 725,731 ****
--- 737,748 ----
  /*#undef	I_MY_DIR	/**/
  /*#undef	DIRNAMLEN	/**/
  
+ /* MALLOCPTRTYPE
+  *	This symbol defines the kind of ptr returned by malloc and realloc.
+  */
+ #define MALLOCPTRTYPE char         /**/
  
+ 
  /* RANDBITS
   *	This symbol contains the number of bits of random number the rand()
   *	function produces.  Usual values are 15, 16, and 31.
***************
*** 734,740 ****
  
  /* SCRIPTDIR
   *	This symbol holds the name of the directory in which the user wants
!  *	to put publicly executable scripts for the package in question.  It
   *	is often a directory that is mounted across diverse architectures.
   */
  #define SCRIPTDIR "/usr/local/bin"             /**/
--- 751,757 ----
  
  /* SCRIPTDIR
   *	This symbol holds the name of the directory in which the user wants
!  *	to keep publicly executable scripts for the package in question.  It
   *	is often a directory that is mounted across diverse architectures.
   */
  #define SCRIPTDIR "/usr/local/bin"             /**/
***************
*** 742,754 ****
  /* SIG_NAME
   *	This symbol contains an list of signal names in order.
   */
! #define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","IOT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","URG","STOP","TSTP","CONT","CHLD","TTIN","TTOU","IO","XCPU","XFSZ","VTALRM","PROF","WINCH","LOST","USR1","USR2"		/**/
  
  /* STDCHAR
   *	This symbol is defined to be the type of char used in stdio.h.
   *	It has the values "unsigned char" or "char".
   */
! #define STDCHAR char	/**/
  
  /* UIDTYPE
   *	This symbol has a value like uid_t, int, ushort, or whatever type is
--- 759,771 ----
  /* SIG_NAME
   *	This symbol contains an list of signal names in order.
   */
! #define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","URG","STOP","TSTP","CONT","CLD","TTIN","TTOU","IO","XCPU","XFSZ","VTALRM","PROF","WINCH","LOST","USR1","USR2"		/**/
  
  /* STDCHAR
   *	This symbol is defined to be the type of char used in stdio.h.
   *	It has the values "unsigned char" or "char".
   */
! #define STDCHAR unsigned char	/**/
  
  /* UIDTYPE
   *	This symbol has a value like uid_t, int, ushort, or whatever type is
***************
*** 788,796 ****
   *	its value is "char *".
   */
  #ifndef VOIDWANT
! #define VOIDWANT 1
  #endif
! #define VOIDHAVE 1
  #if (VOIDHAVE & VOIDWANT) != VOIDWANT
  #define void int		/* is void to be avoided? */
  #define VOID
--- 805,813 ----
   *	its value is "char *".
   */
  #ifndef VOIDWANT
! #define VOIDWANT 7
  #endif
! #define VOIDHAVE 7
  #if (VOIDHAVE & VOIDWANT) != VOIDWANT
  #define void int		/* is void to be avoided? */
  #define VOID

Index: msdos/config.h
*** msdos/config.h.old	Fri Jun  7 12:25:35 1991
--- msdos/config.h	Fri Jun  7 12:25:36 1991
***************
*** 43,49 ****
  
  /* BIN
   *	This symbol holds the name of the directory in which the user wants
!  *	to put publicly executable images for the package in question.  It
   *	is most often a local directory such as /usr/local/bin.
   */
  #define BIN "/usr/local/bin"             /**/
--- 43,49 ----
  
  /* BIN
   *	This symbol holds the name of the directory in which the user wants
!  *	to keep publicly executable images for the package in question.  It
   *	is most often a local directory such as /usr/local/bin.
   */
  #define BIN "/usr/local/bin"             /**/
***************
*** 590,600 ****
--- 590,612 ----
   */
  #define GIDTYPE int		/**/
  
+ /* GROUPSTYPE
+  *	This symbol has a value like gid_t, int, ushort, or whatever type is
+  *	used in the return value of getgroups().
+  */
+ #define GROUPSTYPE int		/**/
+ 
  /* I_FCNTL
   *	This manifest constant tells the C program to include <fcntl.h>.
   */
  #define	I_FCNTL	/**/
  
+ /* I_GDBM
+  *	This symbol, if defined, indicates that gdbm.h exists and should
+  *	be included.
+  */
+ /*#undef	I_GDBM		/**/
+ 
  /* I_GRP
   *	This symbol, if defined, indicates to the C program that it should
   *	include grp.h.
***************
*** 733,738 ****
--- 745,754 ----
  /*#undef	I_MY_DIR	/**/
  /*#undef	DIRNAMLEN	/**/
  
+ /* MALLOCPTRTYPE
+  *	This symbol defines the kind of ptr returned by malloc and realloc.
+  */
+ #define MALLOCPTRTYPE void         /**/
  
  /* RANDBITS
   *	This symbol contains the number of bits of random number the rand()

Index: config_h.SH
*** config_h.SH.old	Fri Jun  7 12:23:06 1991
--- config_h.SH	Fri Jun  7 12:23:07 1991
***************
*** 454,461 ****
--- 454,467 ----
   *	This symbol, if defined, indicates that the shmat() routine is
   *	available to stat symbolic links.
   */
+ /* VOID_SHMAT
+  *	This symbol, if defined, indicates that the shmat() routine
+  *	returns a pointer of type void*.
+  */
  #$d_shmat	HAS_SHMAT		/**/
  
+ #$d_voidshmat	VOIDSHMAT		/**/
+ 
  /* HAS_SHMCTL
   *	This symbol, if defined, indicates that the shmctl() routine is
   *	available to stat symbolic links.
***************
*** 760,766 ****
  
  /* SCRIPTDIR
   *	This symbol holds the name of the directory in which the user wants
!  *	to put publicly executable scripts for the package in question.  It
   *	is often a directory that is mounted across diverse architectures.
   */
  #define SCRIPTDIR "$scriptdir"             /**/
--- 766,772 ----
  
  /* SCRIPTDIR
   *	This symbol holds the name of the directory in which the user wants
!  *	to keep publicly executable scripts for the package in question.  It
   *	is often a directory that is mounted across diverse architectures.
   */
  #define SCRIPTDIR "$scriptdir"             /**/

Index: cons.c
Prereq: 4.0
*** cons.c.old	Fri Jun  7 12:23:11 1991
--- cons.c	Fri Jun  7 12:23:12 1991
***************
*** 1,11 ****
! /* $Header: cons.c,v 4.0 91/03/20 01:05:51 lwall Locked $
   *
!  *    Copyright (c) 1989, Larry Wall
   *
!  *    You may distribute under the terms of the GNU General Public License
!  *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	cons.c,v $
   * Revision 4.0  91/03/20  01:05:51  lwall
   * 4.0 baseline.
   * 
--- 1,15 ----
! /* $RCSfile: cons.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:31:15 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    You may distribute under the terms of either the GNU General Public
!  *    License or the Artistic License, as specified in the README file.
   *
   * $Log:	cons.c,v $
+  * Revision 4.0.1.1  91/06/07  10:31:15  lwall
+  * patch4: new copyright notice
+  * patch4: added global modifier for pattern matches
+  * 
   * Revision 4.0  91/03/20  01:05:51  lwall
   * 4.0 baseline.
   * 
***************
*** 676,682 ****
  	     arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
  	if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
  		(arg[2].arg_type & A_MASK) == A_SPAT &&
! 		arg[2].arg_ptr.arg_spat->spat_short ) {
  	    cmd->c_stab  = arg[1].arg_ptr.arg_stab;
  	    cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
  	    cmd->c_slen  = arg[2].arg_ptr.arg_spat->spat_slen;
--- 680,688 ----
  	     arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
  	if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
  		(arg[2].arg_type & A_MASK) == A_SPAT &&
! 		arg[2].arg_ptr.arg_spat->spat_short &&
! 		(arg->arg_type == O_SUBST || arg->arg_type == O_NSUBST ||
! 		 (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_GLOBAL) == 0 )) {
  	    cmd->c_stab  = arg[1].arg_ptr.arg_stab;
  	    cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
  	    cmd->c_slen  = arg[2].arg_ptr.arg_spat->spat_slen;

Index: consarg.c
*** consarg.c.old	Fri Jun  7 12:23:16 1991
--- consarg.c	Fri Jun  7 12:23:17 1991
***************
*** 1,11 ****
! /* $RCSfile: consarg.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:38:34 $
   *
!  *    Copyright (c) 1989, Larry Wall
   *
!  *    You may distribute under the terms of the GNU General Public License
!  *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	consarg.c,v $
   * Revision 4.0.1.1  91/04/11  17:38:34  lwall
   * patch1: fixed "Bad free" error
   * 
--- 1,15 ----
! /* $RCSfile: consarg.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:33:12 $
   *
!  *    Copyright (c) 1991, Larry Wall
   *
!  *    You may distribute under the terms of either the GNU General Public
!  *    License or the Artistic License, as specified in the README file.
   *
   * $Log:	consarg.c,v $
+  * Revision 4.0.1.2  91/06/07  10:33:12  lwall
+  * patch4: new copyright notice
+  * patch4: length($`), length($&), length($') now optimized to avoid string copy
+  * 
   * Revision 4.0.1.1  91/04/11  17:38:34  lwall
   * patch1: fixed "Bad free" error
   * 
***************
*** 254,268 ****
  	fprintf(stderr,")\n");
      }
  #endif
!     evalstatic(arg);		/* see if we can consolidate anything */
      return arg;
  }
  
! void
  evalstatic(arg)
  register ARG *arg;
  {
!     register STR *str;
      register STR *s1;
      register STR *s2;
      double value;		/* must not be register */
--- 258,272 ----
  	fprintf(stderr,")\n");
      }
  #endif
!     arg = evalstatic(arg);	/* see if we can consolidate anything */
      return arg;
  }
  
! ARG *
  evalstatic(arg)
  register ARG *arg;
  {
!     static STR *str = Nullstr;
      register STR *s1;
      register STR *s2;
      double value;		/* must not be register */
***************
*** 275,571 ****
      double sin(), cos(), atan2(), pow();
  
      if (!arg || !arg->arg_len)
! 	return;
  
!     if ((arg[1].arg_type == A_SINGLE || arg->arg_type == O_AELEM) &&
! 	(arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) {
  	str = Str_new(20,0);
  	s1 = arg[1].arg_ptr.arg_str;
! 	if (arg->arg_len > 1)
! 	    s2 = arg[2].arg_ptr.arg_str;
  	else
- 	    s2 = Nullstr;
- 	switch (arg->arg_type) {
- 	case O_AELEM:
- 	    i = (int)str_gnum(s2);
- 	    if (i < 32767 && i >= 0) {
- 		arg->arg_type = O_ITEM;
- 		arg->arg_len = 1;
- 		arg[1].arg_type = A_ARYSTAB;	/* $abc[123] is hoistable now */
- 		arg[1].arg_len = i;
- 		str_free(s2);
- 		arg[2].arg_type = A_NULL;
- 		arg[2].arg_ptr.arg_str = Nullstr;
- 	    }
- 	    /* FALL THROUGH */
- 	default:
- 	    str_free(str);
- 	    str = Nullstr;		/* can't be evaluated yet */
- 	    break;
- 	case O_CONCAT:
- 	    str_sset(str,s1);
- 	    str_scat(str,s2);
- 	    break;
- 	case O_REPEAT:
- 	    i = (int)str_gnum(s2);
- 	    tmps = str_get(s1);
- 	    str_nset(str,"",0);
- 	    STR_GROW(str, i * s1->str_cur + 1);
- 	    repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
- 	    str->str_cur = i * s1->str_cur;
- 	    str->str_ptr[str->str_cur] = '\0';
- 	    break;
- 	case O_MULTIPLY:
- 	    value = str_gnum(s1);
- 	    str_numset(str,value * str_gnum(s2));
- 	    break;
- 	case O_DIVIDE:
- 	    value = str_gnum(s2);
- 	    if (value == 0.0)
- 		yyerror("Illegal division by constant zero");
- 	    else
  #ifdef cray
! 	    /* insure that 20./5. == 4. */
! 	    {
! 		double x;
! 		int    k;
! 		x =  str_gnum(s1);
! 		if ((double)(int)x     == x &&
! 		    (double)(int)value == value &&
! 		    (k = (int)x/(int)value)*(int)value == (int)x) {
! 		    value = k;
! 		} else {
! 		    value = x/value;
! 		}
! 		str_numset(str,value);
  	    }
  #else
! 	    str_numset(str,str_gnum(s1) / value);
  #endif
! 	    break;
! 	case O_MODULO:
! 	    tmplong = (unsigned long)str_gnum(s2);
! 	    if (tmplong == 0L) {
! 		yyerror("Illegal modulus of constant zero");
! 		break;
! 	    }
! 	    tmp2 = (long)str_gnum(s1);
  #ifndef lint
! 	    if (tmp2 >= 0)
! 		str_numset(str,(double)(tmp2 % tmplong));
! 	    else
! 		str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
  #else
! 	    tmp2 = tmp2;
  #endif
! 	    break;
! 	case O_ADD:
! 	    value = str_gnum(s1);
! 	    str_numset(str,value + str_gnum(s2));
! 	    break;
! 	case O_SUBTRACT:
! 	    value = str_gnum(s1);
! 	    str_numset(str,value - str_gnum(s2));
! 	    break;
! 	case O_LEFT_SHIFT:
! 	    value = str_gnum(s1);
! 	    i = (int)str_gnum(s2);
  #ifndef lint
! 	    str_numset(str,(double)(((long)value) << i));
  #endif
! 	    break;
! 	case O_RIGHT_SHIFT:
! 	    value = str_gnum(s1);
! 	    i = (int)str_gnum(s2);
  #ifndef lint
! 	    str_numset(str,(double)(((long)value) >> i));
  #endif
! 	    break;
! 	case O_LT:
! 	    value = str_gnum(s1);
! 	    str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0);
! 	    break;
! 	case O_GT:
! 	    value = str_gnum(s1);
! 	    str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0);
! 	    break;
! 	case O_LE:
! 	    value = str_gnum(s1);
! 	    str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0);
! 	    break;
! 	case O_GE:
! 	    value = str_gnum(s1);
! 	    str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0);
! 	    break;
! 	case O_EQ:
! 	    if (dowarn) {
! 		if ((!s1->str_nok && !looks_like_number(s1)) ||
! 		    (!s2->str_nok && !looks_like_number(s2)) )
! 		    warn("Possible use of == on string value");
! 	    }
! 	    value = str_gnum(s1);
! 	    str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0);
! 	    break;
! 	case O_NE:
! 	    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
! 	    str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
  #endif
! 	    break;
! 	case O_XOR:
! 	    value = str_gnum(s1);
  #ifndef lint
! 	    str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
  #endif
! 	    break;
! 	case O_BIT_OR:
! 	    value = str_gnum(s1);
  #ifndef lint
! 	    str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
  #endif
! 	    break;
! 	case O_AND:
! 	    if (str_true(s1))
! 		str_sset(str,s2);
! 	    else
! 		str_sset(str,s1);
! 	    break;
! 	case O_OR:
! 	    if (str_true(s1))
! 		str_sset(str,s1);
! 	    else
! 		str_sset(str,s2);
! 	    break;
! 	case O_COND_EXPR:
! 	    if ((arg[3].arg_type & A_MASK) != A_SINGLE) {
! 		str_free(str);
! 		str = Nullstr;
! 	    }
! 	    else {
! 		if (str_true(s1))
! 		    str_sset(str,s2);
! 		else
! 		    str_sset(str,arg[3].arg_ptr.arg_str);
! 		str_free(arg[3].arg_ptr.arg_str);
! 		arg[3].arg_ptr.arg_str = Nullstr;
! 	    }
! 	    break;
! 	case O_NEGATE:
! 	    str_numset(str,(double)(-str_gnum(s1)));
! 	    break;
! 	case O_NOT:
! 	    str_numset(str,(double)(!str_true(s1)));
! 	    break;
! 	case O_COMPLEMENT:
  #ifndef lint
! 	    str_numset(str,(double)(~U_L(str_gnum(s1))));
  #endif
! 	    break;
! 	case O_SIN:
! 	    str_numset(str,sin(str_gnum(s1)));
! 	    break;
! 	case O_COS:
! 	    str_numset(str,cos(str_gnum(s1)));
! 	    break;
! 	case O_ATAN2:
! 	    value = str_gnum(s1);
! 	    str_numset(str,atan2(value, str_gnum(s2)));
! 	    break;
! 	case O_POW:
! 	    value = str_gnum(s1);
! 	    str_numset(str,pow(value, str_gnum(s2)));
! 	    break;
! 	case O_LENGTH:
! 	    str_numset(str, (double)str_len(s1));
! 	    break;
! 	case O_SLT:
! 	    str_numset(str,(double)(str_cmp(s1,s2) < 0));
! 	    break;
! 	case O_SGT:
! 	    str_numset(str,(double)(str_cmp(s1,s2) > 0));
! 	    break;
! 	case O_SLE:
! 	    str_numset(str,(double)(str_cmp(s1,s2) <= 0));
! 	    break;
! 	case O_SGE:
! 	    str_numset(str,(double)(str_cmp(s1,s2) >= 0));
! 	    break;
! 	case O_SEQ:
! 	    str_numset(str,(double)(str_eq(s1,s2)));
! 	    break;
! 	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 HAS_CRYPT
! 	    tmps = str_get(s1);
! 	    str_set(str,crypt(tmps,str_get(s2)));
  #else
! 	    yyerror(
! 	    "The crypt() function is unimplemented due to excessive paranoia.");
  #endif
! 	    break;
! 	case O_EXP:
! 	    str_numset(str,exp(str_gnum(s1)));
! 	    break;
! 	case O_LOG:
! 	    str_numset(str,log(str_gnum(s1)));
! 	    break;
! 	case O_SQRT:
! 	    str_numset(str,sqrt(str_gnum(s1)));
! 	    break;
! 	case O_INT:
! 	    value = str_gnum(s1);
! 	    if (value >= 0.0)
! 		(void)modf(value,&value);
! 	    else {
! 		(void)modf(-value,&value);
! 		value = -value;
! 	    }
! 	    str_numset(str,value);
! 	    break;
! 	case O_ORD:
  #ifndef I286
! 	    str_numset(str,(double)(*str_get(s1)));
  #else
! 	    {
! 		int  zapc;
! 		char *zaps;
  
! 		zaps = str_get(s1);
! 		zapc = (int) *zaps;
! 		str_numset(str,(double)(zapc));
! 	    }
! #endif
! 	    break;
  	}
! 	if (str) {
! 	    arg->arg_type = O_ITEM;	/* note arg1 type is already SINGLE */
! 	    str_free(s1);
! 	    arg[1].arg_ptr.arg_str = str;
! 	    if (s2) {
! 		str_free(s2);
! 		arg[2].arg_ptr.arg_str = Nullstr;
! 		arg[2].arg_type = A_NULL;
! 	    }
! 	}
      }
  }
  
  ARG *
--- 279,625 ----
      double sin(), cos(), atan2(), pow();
  
      if (!arg || !arg->arg_len)
! 	return arg;
  
!     if (!str)
  	str = Str_new(20,0);
+ 
+     if (arg[1].arg_type == A_SINGLE)
  	s1 = arg[1].arg_ptr.arg_str;
!     else
! 	s1 = Nullstr;
!     if (arg->arg_len >= 2 && arg[2].arg_type == A_SINGLE)
! 	s2 = arg[2].arg_ptr.arg_str;
!     else
! 	s2 = Nullstr;
! 
! #define CHECK1 if (!s1) return arg
! #define CHECK2 if (!s2) return arg
! #define CHECK12 if (!s1 || !s2) return arg
! 
!     switch (arg->arg_type) {
!     default:
! 	return arg;
!     case O_AELEM:
! 	CHECK2;
! 	i = (int)str_gnum(s2);
! 	if (i < 32767 && i >= 0) {
! 	    arg->arg_type = O_ITEM;
! 	    arg->arg_len = 1;
! 	    arg[1].arg_type = A_ARYSTAB;	/* $abc[123] is hoistable now */
! 	    arg[1].arg_len = i;
! 	    str_free(s2);
! 	    Renew(arg, 2, ARG);
! 	}
! 	return arg;
!     case O_CONCAT:
! 	CHECK12;
! 	str_sset(str,s1);
! 	str_scat(str,s2);
! 	break;
!     case O_REPEAT:
! 	CHECK12;
! 	i = (int)str_gnum(s2);
! 	tmps = str_get(s1);
! 	str_nset(str,"",0);
! 	STR_GROW(str, i * s1->str_cur + 1);
! 	repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
! 	str->str_cur = i * s1->str_cur;
! 	str->str_ptr[str->str_cur] = '\0';
! 	break;
!     case O_MULTIPLY:
! 	CHECK12;
! 	value = str_gnum(s1);
! 	str_numset(str,value * str_gnum(s2));
! 	break;
!     case O_DIVIDE:
! 	CHECK12;
! 	value = str_gnum(s2);
! 	if (value == 0.0)
! 	    yyerror("Illegal division by constant zero");
  	else
  #ifdef cray
! 	/* insure that 20./5. == 4. */
! 	{
! 	    double x;
! 	    int    k;
! 	    x =  str_gnum(s1);
! 	    if ((double)(int)x     == x &&
! 		(double)(int)value == value &&
! 		(k = (int)x/(int)value)*(int)value == (int)x) {
! 		value = k;
! 	    } else {
! 		value = x/value;
  	    }
+ 	    str_numset(str,value);
+ 	}
  #else
! 	str_numset(str,str_gnum(s1) / value);
  #endif
! 	break;
!     case O_MODULO:
! 	CHECK12;
! 	tmplong = (unsigned long)str_gnum(s2);
! 	if (tmplong == 0L) {
! 	    yyerror("Illegal modulus of constant zero");
! 	    return arg;
! 	}
! 	tmp2 = (long)str_gnum(s1);
  #ifndef lint
! 	if (tmp2 >= 0)
! 	    str_numset(str,(double)(tmp2 % tmplong));
! 	else
! 	    str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
  #else
! 	tmp2 = tmp2;
  #endif
! 	break;
!     case O_ADD:
! 	CHECK12;
! 	value = str_gnum(s1);
! 	str_numset(str,value + str_gnum(s2));
! 	break;
!     case O_SUBTRACT:
! 	CHECK12;
! 	value = str_gnum(s1);
! 	str_numset(str,value - str_gnum(s2));
! 	break;
!     case O_LEFT_SHIFT:
! 	CHECK12;
! 	value = str_gnum(s1);
! 	i = (int)str_gnum(s2);
  #ifndef lint
! 	str_numset(str,(double)(((long)value) << i));
  #endif
! 	break;
!     case O_RIGHT_SHIFT:
! 	CHECK12;
! 	value = str_gnum(s1);
! 	i = (int)str_gnum(s2);
  #ifndef lint
! 	str_numset(str,(double)(((long)value) >> i));
  #endif
! 	break;
!     case O_LT:
! 	CHECK12;
! 	value = str_gnum(s1);
! 	str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0);
! 	break;
!     case O_GT:
! 	CHECK12;
! 	value = str_gnum(s1);
! 	str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0);
! 	break;
!     case O_LE:
! 	CHECK12;
! 	value = str_gnum(s1);
! 	str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0);
! 	break;
!     case O_GE:
! 	CHECK12;
! 	value = str_gnum(s1);
! 	str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0);
! 	break;
!     case O_EQ:
! 	CHECK12;
! 	if (dowarn) {
! 	    if ((!s1->str_nok && !looks_like_number(s1)) ||
! 		(!s2->str_nok && !looks_like_number(s2)) )
! 		warn("Possible use of == on string value");
! 	}
! 	value = str_gnum(s1);
! 	str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0);
! 	break;
!     case O_NE:
! 	CHECK12;
! 	value = str_gnum(s1);
! 	str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0);
! 	break;
!     case O_NCMP:
! 	CHECK12;
! 	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:
! 	CHECK12;
! 	value = str_gnum(s1);
  #ifndef lint
! 	str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
  #endif
! 	break;
!     case O_XOR:
! 	CHECK12;
! 	value = str_gnum(s1);
  #ifndef lint
! 	str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
  #endif
! 	break;
!     case O_BIT_OR:
! 	CHECK12;
! 	value = str_gnum(s1);
  #ifndef lint
! 	str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
  #endif
! 	break;
!     case O_AND:
! 	CHECK12;
! 	if (str_true(s1))
! 	    str_sset(str,s2);
! 	else
! 	    str_sset(str,s1);
! 	break;
!     case O_OR:
! 	CHECK12;
! 	if (str_true(s1))
! 	    str_sset(str,s1);
! 	else
! 	    str_sset(str,s2);
! 	break;
!     case O_COND_EXPR:
! 	CHECK12;
! 	if ((arg[3].arg_type & A_MASK) != A_SINGLE)
! 	    return arg;
! 	if (str_true(s1))
! 	    str_sset(str,s2);
! 	else
! 	    str_sset(str,arg[3].arg_ptr.arg_str);
! 	str_free(arg[3].arg_ptr.arg_str);
! 	Renew(arg, 3, ARG);
! 	break;
!     case O_NEGATE:
! 	CHECK1;
! 	str_numset(str,(double)(-str_gnum(s1)));
! 	break;
!     case O_NOT:
! 	CHECK1;
! 	str_numset(str,(double)(!str_true(s1)));
! 	break;
!     case O_COMPLEMENT:
! 	CHECK1;
  #ifndef lint
! 	str_numset(str,(double)(~U_L(str_gnum(s1))));
  #endif
! 	break;
!     case O_SIN:
! 	CHECK1;
! 	str_numset(str,sin(str_gnum(s1)));
! 	break;
!     case O_COS:
! 	CHECK1;
! 	str_numset(str,cos(str_gnum(s1)));
! 	break;
!     case O_ATAN2:
! 	CHECK12;
! 	value = str_gnum(s1);
! 	str_numset(str,atan2(value, str_gnum(s2)));
! 	break;
!     case O_POW:
! 	CHECK12;
! 	value = str_gnum(s1);
! 	str_numset(str,pow(value, str_gnum(s2)));
! 	break;
!     case O_LENGTH:
! 	if (arg[1].arg_type == A_STAB) {
! 	    arg->arg_type = O_ITEM;
! 	    arg[1].arg_type = A_LENSTAB;
! 	    return arg;
! 	}
! 	CHECK1;
! 	str_numset(str, (double)str_len(s1));
! 	break;
!     case O_SLT:
! 	CHECK12;
! 	str_numset(str,(double)(str_cmp(s1,s2) < 0));
! 	break;
!     case O_SGT:
! 	CHECK12;
! 	str_numset(str,(double)(str_cmp(s1,s2) > 0));
! 	break;
!     case O_SLE:
! 	CHECK12;
! 	str_numset(str,(double)(str_cmp(s1,s2) <= 0));
! 	break;
!     case O_SGE:
! 	CHECK12;
! 	str_numset(str,(double)(str_cmp(s1,s2) >= 0));
! 	break;
!     case O_SEQ:
! 	CHECK12;
! 	str_numset(str,(double)(str_eq(s1,s2)));
! 	break;
!     case O_SNE:
! 	CHECK12;
! 	str_numset(str,(double)(!str_eq(s1,s2)));
! 	break;
!     case O_SCMP:
! 	CHECK12;
! 	str_numset(str,(double)(str_cmp(s1,s2)));
! 	break;
!     case O_CRYPT:
! 	CHECK12;
  #ifdef HAS_CRYPT
! 	tmps = str_get(s1);
! 	str_set(str,crypt(tmps,str_get(s2)));
  #else
! 	yyerror(
! 	"The crypt() function is unimplemented due to excessive paranoia.");
  #endif
! 	break;
!     case O_EXP:
! 	CHECK1;
! 	str_numset(str,exp(str_gnum(s1)));
! 	break;
!     case O_LOG:
! 	CHECK1;
! 	str_numset(str,log(str_gnum(s1)));
! 	break;
!     case O_SQRT:
! 	CHECK1;
! 	str_numset(str,sqrt(str_gnum(s1)));
! 	break;
!     case O_INT:
! 	CHECK1;
! 	value = str_gnum(s1);
! 	if (value >= 0.0)
! 	    (void)modf(value,&value);
! 	else {
! 	    (void)modf(-value,&value);
! 	    value = -value;
! 	}
! 	str_numset(str,value);
! 	break;
!     case O_ORD:
! 	CHECK1;
  #ifndef I286
! 	str_numset(str,(double)(*str_get(s1)));
  #else
! 	{
! 	    int  zapc;
! 	    char *zaps;
  
! 	    zaps = str_get(s1);
! 	    zapc = (int) *zaps;
! 	    str_numset(str,(double)(zapc));
  	}
! #endif
! 	break;
      }
+     arg->arg_type = O_ITEM;	/* note arg1 type is already SINGLE */
+     str_free(s1);
+     arg[1].arg_ptr.arg_str = str;
+     if (s2) {
+ 	str_free(s2);
+ 	arg[2].arg_ptr.arg_str = Nullstr;
+ 	arg[2].arg_type = A_NULL;
+     }
+     str = Nullstr;
+ 
+     return arg;
  }
  
  ARG *

*** End of Patch 5 ***
exit 0 # Just in case...
-- 
Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    (402) 291-8300         FAX:      (402) 291-4362
Please send comp.sources.misc-related mail to kent@uunet.uu.net.