perl 4.0 patch #2
Larry Wall
lwall at jpl-devvax.jpl.nasa.gov
Sun Apr 14 04:36:08 AEST 1991
System: perl version 4.0
Patch #: 2
Priority: HIGH
Subject: Patch 1 continued
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 - APPLY PATCH 3 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 (hah!) they can be obtained from me:
Larry Wall
lwall at 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: 1
1c1
< #define PATCHLEVEL 1
---
> #define PATCHLEVEL 2
Index: malloc.c
Prereq: 4.0
*** malloc.c.old Fri Apr 12 09:31:31 1991
--- malloc.c Fri Apr 12 09:31:31 1991
***************
*** 1,6 ****
! /* $Header: malloc.c,v 4.0 91/03/20 01:28:52 lwall Locked $
*
* $Log: malloc.c,v $
* Revision 4.0 91/03/20 01:28:52 lwall
* 4.0 baseline.
*
--- 1,9 ----
! /* $RCSfile: malloc.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:48:31 $
*
* $Log: malloc.c,v $
+ * Revision 4.0.1.1 91/04/11 17:48:31 lwall
+ * patch1: Configure now figures out malloc ptr type
+ *
* Revision 4.0 91/03/20 01:28:52 lwall
* 4.0 baseline.
*
***************
*** 104,110 ****
#define ASSERT(p)
#endif
! char *
malloc(nbytes)
register unsigned nbytes;
{
--- 107,113 ----
#define ASSERT(p)
#endif
! MALLOCPTRTYPE *
malloc(nbytes)
register unsigned nbytes;
{
***************
*** 273,279 ****
*/
int reall_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */
! char *
realloc(cp, nbytes)
char *cp;
unsigned nbytes;
--- 276,282 ----
*/
int reall_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */
! MALLOCPTRTYPE *
realloc(cp, nbytes)
char *cp;
unsigned nbytes;
Index: hints/mips.sh
*** hints/mips.sh.old Fri Apr 12 09:30:45 1991
--- hints/mips.sh Fri Apr 12 09:30:46 1991
***************
*** 0 ****
--- 1,6 ----
+ optimize='-g'
+ d_volatile=undef
+ d_castneg=undef
+ cc=cc
+ libpth="/usr/lib/cmplrs/cc $libpth"
+ groupstype=int
Index: hints/ncr_tower.sh
*** hints/ncr_tower.sh.old Fri Apr 12 09:30:48 1991
--- hints/ncr_tower.sh Fri Apr 12 09:30:49 1991
***************
*** 0 ****
--- 1,2 ----
+ ccflags="$ccflags -W2,-Sl,2000"
+ d_mkdir=$undef
Index: hints/next.sh
*** hints/next.sh.old Fri Apr 12 09:30:50 1991
--- hints/next.sh Fri Apr 12 09:30:51 1991
***************
*** 0 ****
--- 1,2 ----
+ : Just disable defaulting to -fpcc-struct-return, since gcc is native compiler.
+ ccflags="$ccflags "
Index: hints/osf_1.sh
*** hints/osf_1.sh.old Fri Apr 12 09:30:53 1991
--- hints/osf_1.sh Fri Apr 12 09:30:53 1991
***************
*** 0 ****
--- 1 ----
+ ccflags="$ccflags -D_BSD"
Index: perl.c
Prereq: 4.0
*** perl.c.old Fri Apr 12 09:31:34 1991
--- perl.c Fri Apr 12 09:31:35 1991
***************
*** 1,4 ****
! char rcsid[] = "$Header: perl.c,v 4.0 91/03/20 01:37:44 lwall Locked $\nPatch level: ###\n";
/*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:05 $\nPatch level: ###\n";
/*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.c,v $
+ * Revision 4.0.1.1 91/04/11 17:49:05 lwall
+ * patch1: fixed undefined environ problem
+ *
* Revision 4.0 91/03/20 01:37:44 lwall
* 4.0 baseline.
*
***************
*** 34,42 ****
static char* moreswitches();
static char* cddir;
- #ifndef __STDC__
- extern char **environ;
- #endif /* ! __STDC__ */
static bool minus_c;
static char patchlevel[6];
static char *nrs = "\n";
--- 37,42 ----
Index: perl.h
Prereq: 4.0
*** perl.h.old Fri Apr 12 09:31:39 1991
--- perl.h Fri Apr 12 09:31:39 1991
***************
*** 1,4 ****
! /* $Header: perl.h,v 4.0 91/03/20 01:37:56 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $RCSfile: perl.h,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:51 $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,17 ****
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.h,v $
* Revision 4.0 91/03/20 01:37:56 lwall
* 4.0 baseline.
*
*/
! #define VOIDUSED 1
#include "config.h"
#ifdef MSDOS
--- 6,20 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.h,v $
+ * Revision 4.0.1.1 91/04/11 17:49:51 lwall
+ * patch1: hopefully straightened out some of the Xenix mess
+ *
* Revision 4.0 91/03/20 01:37:56 lwall
* 4.0 baseline.
*
*/
! #define VOIDWANT 1
#include "config.h"
#ifdef MSDOS
***************
*** 148,153 ****
--- 151,157 ----
#endif
#endif
+ #ifndef strerror
#ifdef HAS_STRERROR
char *strerror();
#else
***************
*** 155,160 ****
--- 159,165 ----
extern char *sys_errlist[];
#define strerror(e) ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
#endif
+ #endif
#ifdef I_SYSIOCTL
#ifndef _IOCTL_
***************
*** 221,227 ****
#define ntohi ntohl
#endif
! #if defined(I_DIRENT) && !defined(M_XENIX)
# include <dirent.h>
# define DIRENT dirent
#else
--- 226,232 ----
#define ntohi ntohl
#endif
! #if defined(I_DIRENT)
# include <dirent.h>
# define DIRENT dirent
#else
***************
*** 592,597 ****
--- 597,604 ----
EXT char **origargv;
EXT int origargc;
EXT char **origenviron;
+ extern char **environ;
+
EXT line_t subline INIT(0);
EXT STR *subname INIT(Nullstr);
EXT int arybase INIT(0);
Index: perl.man
Prereq: 4.0
*** perl.man.old Fri Apr 12 09:31:45 1991
--- perl.man Fri Apr 12 09:31:48 1991
***************
*** 1,7 ****
.rn '' }`
! ''' $Header: perl.man,v 4.0 91/03/20 01:38:08 lwall Locked $
'''
''' $Log: perl.man,v $
''' Revision 4.0 91/03/20 01:38:08 lwall
''' 4.0 baseline.
'''
--- 1,10 ----
.rn '' }`
! ''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $
'''
''' $Log: perl.man,v $
+ ''' Revision 4.0.1.1 91/04/11 17:50:44 lwall
+ ''' patch1: fixed some typos
+ '''
''' Revision 4.0 91/03/20 01:38:08 lwall
''' 4.0 baseline.
'''
***************
*** 1372,1378 ****
print "\et" x ($tab/8), \' \' x ($tab%8); # tab over
! @ones = (1) x ; # an array of 80 1's
@ones = (5) x @ones; # set all elements to 5
.fi
--- 1375,1381 ----
print "\et" x ($tab/8), \' \' x ($tab%8); # tab over
! @ones = (1) x 80; # an array of 80 1's
@ones = (5) x @ones; # set all elements to 5
.fi
***************
*** 1604,1612 ****
.fi
''' Beginning of part 2
! ''' $Header: perl.man,v 4.0 91/03/20 01:38:08 lwall Locked $
'''
''' $Log: perl.man,v $
''' Revision 4.0 91/03/20 01:38:08 lwall
''' 4.0 baseline.
'''
--- 1607,1618 ----
.fi
''' Beginning of part 2
! ''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $
'''
''' $Log: perl.man,v $
+ ''' Revision 4.0.1.1 91/04/11 17:50:44 lwall
+ ''' patch1: fixed some typos
+ '''
''' Revision 4.0 91/03/20 01:38:08 lwall
''' 4.0 baseline.
'''
***************
*** 2797,2805 ****
size of the message type. Returns true if successful, or false if
there is an error.
''' Beginning of part 3
! ''' $Header: perl.man,v 4.0 91/03/20 01:38:08 lwall Locked $
'''
''' $Log: perl.man,v $
''' Revision 4.0 91/03/20 01:38:08 lwall
''' 4.0 baseline.
'''
--- 2803,2814 ----
size of the message type. Returns true if successful, or false if
there is an error.
''' Beginning of part 3
! ''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $
'''
''' $Log: perl.man,v $
+ ''' Revision 4.0.1.1 91/04/11 17:50:44 lwall
+ ''' patch1: fixed some typos
+ '''
''' Revision 4.0 91/03/20 01:38:08 lwall
''' 4.0 baseline.
'''
***************
*** 4258,4266 ****
.Sp
Note that write is NOT the opposite of read.
''' Beginning of part 4
! ''' $Header: perl.man,v 4.0 91/03/20 01:38:08 lwall Locked $
'''
''' $Log: perl.man,v $
''' Revision 4.0 91/03/20 01:38:08 lwall
''' 4.0 baseline.
'''
--- 4267,4278 ----
.Sp
Note that write is NOT the opposite of read.
''' Beginning of part 4
! ''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $
'''
''' $Log: perl.man,v $
+ ''' Revision 4.0.1.1 91/04/11 17:50:44 lwall
+ ''' patch1: fixed some typos
+ '''
''' Revision 4.0 91/03/20 01:38:08 lwall
''' 4.0 baseline.
'''
***************
*** 5924,5929 ****
--- 5936,5942 ----
If your stdio requires an seek or eof between reads and writes on a particular
stream, so does
.IR perl .
+ (This doesn't apply to sysread() and syswrite().)
.PP
While none of the built-in data types have any arbitrary size limits (apart
from memory size), there are still a few arbitrary limits:
Index: perly.fixer
*** perly.fixer.old Fri Apr 12 09:32:00 1991
--- perly.fixer Fri Apr 12 09:32:01 1991
***************
*** 1,22 ****
#!/bin/sh
input=$1
output=$2
tmp=/tmp/f$$
egrep 'YYSTYPE[ ]*yyv\[ *YYMAXDEPTH *\];
! short[ ]*yys\[ *YYMAXDEPTH *\] *;
yyps *= *&yys\[ *-1 *\];
yypv *= *&yyv\[ *-1 *\];
if *\( *\+\+yyps *> *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp
set `wc -l $tmp`
! case "$1" in
! 5) echo "Patching perly.c to allow dynamic yacc stack allocation";;
! *) mv $input $output; rm -f $tmp; exit;;
! esac
! cat >$tmp <<'END'
/YYSTYPE[ ]*yyv\[ *YYMAXDEPTH *\];/c\
int yymaxdepth = YYMAXDEPTH;\
YYSTYPE *yyv; /* where the values are stored */\
--- 1,46 ----
#!/bin/sh
+ # Hacks to make it work with Interactive's SysVr3 Version 2.2
+ # doughera at lafvax.lafayette.edu (Andy Dougherty) 3/23/91
+
input=$1
output=$2
tmp=/tmp/f$$
+ plan="unknown"
+
+ # Test for BSD 4.3 version.
egrep 'YYSTYPE[ ]*yyv\[ *YYMAXDEPTH *\];
! short[ ]*yys\[ *YYMAXDEPTH *\] *;
yyps *= *&yys\[ *-1 *\];
yypv *= *&yyv\[ *-1 *\];
if *\( *\+\+yyps *> *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp
+
set `wc -l $tmp`
+ if test "$1" = "5"; then
+ plan="bsd43"
+ fi
! if test "$plan" = "unknown"; then
! # Test for ISC 2.2 version.
! egrep 'YYSTYPE[ ]*yyv\[ *YYMAXDEPTH *\];
! int[ ]*yys\[ *YYMAXDEPTH *\] *;
! yyps *= *&yys\[ *-1 *\];
! yypv *= *&yyv\[ *-1 *\];
! if *\( *\+\+yy_ps *>= *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp
! set `wc -l $tmp`
! if test "$1" = "5"; then
! plan="isc"
! fi
! fi
!
! case "$plan" in
! #######################################################
! "bsd43")
! echo "Patching perly.c to allow dynamic yacc stack allocation"
! echo "Assuming bsd4.3 yaccpar"
! cat >$tmp <<'END'
/YYSTYPE[ ]*yyv\[ *YYMAXDEPTH *\];/c\
int yymaxdepth = YYMAXDEPTH;\
YYSTYPE *yyv; /* where the values are stored */\
***************
*** 55,60 ****
/yacc stack overflow.*}/d
/yacc stack overflow/,/}/d
END
! sed -f $tmp <$input >$output
rm -rf $tmp $input
--- 79,139 ----
/yacc stack overflow.*}/d
/yacc stack overflow/,/}/d
END
+ sed -f $tmp <$input >$output ;;
! #######################################################
! "isc") # Interactive Systems 2.2 version
! echo "Patching perly.c to allow dynamic yacc stack allocation"
! echo "Assuming Interactive SysVr3 2.2 yaccpar"
! # Easier to simply put whole script here than to modify the
! # bsd script with sed.
! # Main changes: yaccpar sometimes uses yy_ps and yy_pv
! # which are local register variables.
! # if(++yyps > YYMAXDEPTH) had opening brace on next line.
! # I've kept that brace in along with a call to yyerror if
! # realloc fails. (Actually, I just don't know how to do
! # multi-line matches in sed.)
! cat > $tmp << 'END'
! /YYSTYPE[ ]*yyv\[ *YYMAXDEPTH *\];/c\
! int yymaxdepth = YYMAXDEPTH;\
! YYSTYPE *yyv; /* where the values are stored */\
! int *yys;\
! int *maxyyps;
!
! /int[ ]*yys\[ *YYMAXDEPTH *\] *;/d
!
! /yyps *= *&yys\[ *-1 *\];/d
!
! /yypv *= *&yyv\[ *-1 *\];/c\
! \ if (!yyv) {\
! \ yyv = (YYSTYPE*) malloc(yymaxdepth * sizeof(YYSTYPE));\
! \ yys = (int*) malloc(yymaxdepth * sizeof(int));\
! \ maxyyps = &yys[yymaxdepth];\
! \ }\
! \ yyps = &yys[-1];\
! \ yypv = &yyv[-1];
!
! /if *( *\+\+yy_ps *>= *&yys\[ *YYMAXDEPTH *\] *)/c\
! \ if( ++yy_ps >= maxyyps ) {\
! \ int tv = yy_pv - yyv;\
! \ int ts = yy_ps - yys;\
! \
! \ yymaxdepth *= 2;\
! \ yyv = (YYSTYPE*)realloc((char*)yyv,\
! \ yymaxdepth*sizeof(YYSTYPE));\
! \ yys = (int*)realloc((char*)yys,\
! \ yymaxdepth*sizeof(int));\
! \ yy_ps = yyps = yys + ts;\
! \ yy_pv = yypv = yyv + tv;\
! \ maxyyps = &yys[yymaxdepth];\
! \ }\
! \ if (yyv == NULL || yys == NULL)
! END
! sed -f $tmp < $input > $output ;;
!
! ######################################################
! # Plan still unknown
! *) mv $input $output;
! esac
!
rm -rf $tmp $input
Index: regcomp.c
Prereq: 4.0
*** regcomp.c.old Fri Apr 12 09:32:03 1991
--- regcomp.c Fri Apr 12 09:32:04 1991
***************
*** 7,15 ****
* blame Henry for some of the lack of readability.
*/
! /* $Header: regcomp.c,v 4.0 91/03/20 01:39:01 lwall Locked $
*
* $Log: regcomp.c,v $
* Revision 4.0 91/03/20 01:39:01 lwall
* 4.0 baseline.
*
--- 7,18 ----
* blame Henry for some of the lack of readability.
*/
! /* $RCSfile: regcomp.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:04:45 $
*
* $Log: regcomp.c,v $
+ * Revision 4.0.1.1 91/04/12 09:04:45 lwall
+ * patch1: random cleanup in cpp namespace
+ *
* Revision 4.0 91/03/20 01:39:01 lwall
* 4.0 baseline.
*
***************
*** 70,75 ****
--- 73,81 ----
((*s) == '{' && regcurly(s)))
#define META "^$.[()|?+*\\"
+ #ifdef SPSTART
+ #undef SPSTART /* dratted cpp namespace... */
+ #endif
/*
* Flags to be passed up and down.
*/
Index: regexec.c
Prereq: 4.0
*** regexec.c.old Fri Apr 12 09:32:08 1991
--- regexec.c Fri Apr 12 09:32:09 1991
***************
*** 7,15 ****
* blame Henry for some of the lack of readability.
*/
! /* $Header: regexec.c,v 4.0 91/03/20 01:39:16 lwall Locked $
*
* $Log: regexec.c,v $
* Revision 4.0 91/03/20 01:39:16 lwall
* 4.0 baseline.
*
--- 7,18 ----
* blame Henry for some of the lack of readability.
*/
! /* $RCSfile: regexec.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:07:39 $
*
* $Log: regexec.c,v $
+ * Revision 4.0.1.1 91/04/12 09:07:39 lwall
+ * patch1: regexec only allocated space for 9 subexpresssions
+ *
* Revision 4.0 91/03/20 01:39:16 lwall
* 4.0 baseline.
*
***************
*** 80,87 ****
static char *reglastparen; /* Similarly for lastparen. */
static char *regtill;
! static char *regmystartp[10]; /* For remembering backreferences. */
! static char *regmyendp[10];
/*
* Forwards.
--- 83,91 ----
static char *reglastparen; /* Similarly for lastparen. */
static char *regtill;
! static int regmyp_size = 0;
! static char **regmystartp = Null(char**);
! static char **regmyendp = Null(char**);
/*
* Forwards.
***************
*** 188,193 ****
--- 192,215 ----
/* see how far we have to get to not match where we matched before */
regtill = string+minend;
+
+ /* Allocate our backreference arrays */
+ if ( regmyp_size < prog->nparens + 1 ) {
+ /* Allocate or enlarge the arrays */
+ regmyp_size = prog->nparens + 1;
+ if ( regmyp_size < 10 ) regmyp_size = 10; /* minimum */
+ if ( regmystartp ) {
+ /* reallocate larger */
+ Renew(regmystartp,regmyp_size,char*);
+ Renew(regmyendp, regmyp_size,char*);
+ }
+ else {
+ /* Initial allocation */
+ New(1102,regmystartp,regmyp_size,char*);
+ New(1102,regmyendp, regmyp_size,char*);
+ }
+
+ }
/* Simplest case: anchored match need be tried only once. */
/* [unless multiline is set] */
Index: hints/sco_2_3_0.sh
*** hints/sco_2_3_0.sh.old Fri Apr 12 09:30:55 1991
--- hints/sco_2_3_0.sh Fri Apr 12 09:30:56 1991
***************
*** 0 ****
--- 1,2 ----
+ yacc='/usr/bin/yacc -m25000'
+ i_dirent=undef
Index: hints/sco_2_3_1.sh
*** hints/sco_2_3_1.sh.old Fri Apr 12 09:30:57 1991
--- hints/sco_2_3_1.sh Fri Apr 12 09:30:58 1991
***************
*** 0 ****
--- 1,2 ----
+ yacc='/usr/bin/yacc -m25000'
+ i_dirent=undef
Index: hints/sco_2_3_2.sh
*** hints/sco_2_3_2.sh.old Fri Apr 12 09:31:00 1991
--- hints/sco_2_3_2.sh Fri Apr 12 09:31:01 1991
***************
*** 0 ****
--- 1,2 ----
+ yacc='/usr/bin/yacc -m25000'
+ libswanted=`echo $libswanted | sed 's/ x / /'`
Index: hints/sco_2_3_3.sh
*** hints/sco_2_3_3.sh.old Fri Apr 12 09:31:03 1991
--- hints/sco_2_3_3.sh Fri Apr 12 09:31:04 1991
***************
*** 0 ****
--- 1,2 ----
+ yacc='/usr/bin/yacc -m25000'
+ libswanted=`echo $libswanted | sed 's/ x / /'`
Index: hints/sco_3.sh
*** hints/sco_3.sh.old Fri Apr 12 09:31:05 1991
--- hints/sco_3.sh Fri Apr 12 09:31:06 1991
***************
*** 0 ****
--- 1,3 ----
+ yacc='/usr/bin/yacc -Sm11000'
+ libswanted=`echo $libswanted | sed 's/ x / /'`
+ i_varargs=undef
Index: hints/sgi.sh
*** hints/sgi.sh.old Fri Apr 12 09:31:08 1991
--- hints/sgi.sh Fri Apr 12 09:31:08 1991
***************
*** 0 ****
--- 1,7 ----
+ optimize='-O0'
+ usemymalloc='y'
+ mallocsrc='malloc.c'
+ mallocobj='malloc.o'
+ ccflags="$ccflags -Uf_next"
+ d_voidsig=define
+ d_vfork=undef
Index: stab.c
Prereq: 4.0
*** stab.c.old Fri Apr 12 09:32:12 1991
--- stab.c Fri Apr 12 09:32:12 1991
***************
*** 1,4 ****
! /* $Header: stab.c,v 4.0 91/03/20 01:39:41 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $RCSfile: stab.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:10:24 $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,15 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: stab.c,v $
+ * Revision 4.0.1.1 91/04/12 09:10:24 lwall
+ * patch1: Configure now differentiates getgroups() type from getgid() type
+ * patch1: you may now use "die" and "caller" in a signal handler
+ *
* Revision 4.0 91/03/20 01:39:41 lwall
* 4.0 baseline.
*
***************
*** 184,190 ****
#define NGROUPS 32
#endif
{
! GIDTYPE gary[NGROUPS];
i = getgroups(NGROUPS,gary);
while (--i >= 0) {
--- 188,194 ----
#define NGROUPS 32
#endif
{
! GROUPSTYPE gary[NGROUPS];
i = getgroups(NGROUPS,gary);
while (--i >= 0) {
***************
*** 579,596 ****
int sig;
{
STAB *stab;
- ARRAY *savearray;
STR *str;
- CMD *oldcurcmd = curcmd;
int oldsave = savestack->ary_fill;
! ARRAY *oldstack = stack;
! CSV *oldcurcsv = curcsv;
SUBR *sub;
#ifdef OS2 /* or anybody else who requires SIG_ACK */
signal(sig, SIG_ACK);
#endif
- curcsv = Nullcsv;
stab = stabent(
str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
TRUE)), TRUE);
--- 583,597 ----
int sig;
{
STAB *stab;
STR *str;
int oldsave = savestack->ary_fill;
! int oldtmps_base = tmps_base;
! register CSV *csv;
SUBR *sub;
#ifdef OS2 /* or anybody else who requires SIG_ACK */
signal(sig, SIG_ACK);
#endif
stab = stabent(
str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
TRUE)), TRUE);
***************
*** 610,619 ****
sig_name[sig], stab_name(stab) );
return;
}
! savearray = stab_xarray(defstab);
! stab_xarray(defstab) = stack = anew(defstab);
stack->ary_flags = 0;
! str = Str_new(71,0);
str_set(str,sig_name[sig]);
(void)apush(stab_xarray(defstab),str);
sub->depth++;
--- 611,633 ----
sig_name[sig], stab_name(stab) );
return;
}
! saveaptr(&stack);
! str = Str_new(15, sizeof(CSV));
! str->str_state = SS_SCSV;
! (void)apush(savestack,str);
! csv = (CSV*)str->str_ptr;
! csv->sub = sub;
! csv->stab = stab;
! csv->curcsv = curcsv;
! csv->curcmd = curcmd;
! csv->depth = sub->depth;
! csv->wantarray = G_SCALAR;
! csv->hasargs = TRUE;
! csv->savearray = stab_xarray(defstab);
! csv->argarray = stab_xarray(defstab) = stack = anew(defstab);
stack->ary_flags = 0;
! curcsv = csv;
! str = str_mortal(&str_undef);
str_set(str,sig_name[sig]);
(void)apush(stab_xarray(defstab),str);
sub->depth++;
***************
*** 623,640 ****
savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
}
! (void)cmd_exec(sub->cmd,G_SCALAR,1); /* so do it already */
! sub->depth--; /* assuming no longjumps out of here */
! str_free(stack->ary_array[0]); /* free the one real string */
! stack->ary_array[0] = Nullstr;
! afree(stab_xarray(defstab)); /* put back old $_[] */
! stab_xarray(defstab) = savearray;
! stack = oldstack;
! if (savestack->ary_fill > oldsave)
! restorelist(oldsave);
! curcmd = oldcurcmd;
! curcsv = oldcurcsv;
}
STAB *
--- 637,647 ----
savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
}
! tmps_base = tmps_max; /* protect our mortal string */
! (void)cmd_exec(sub->cmd,G_SCALAR,0); /* so do it already */
! tmps_base = oldtmps_base;
! restorelist(oldsave); /* put everything back */
}
STAB *
Index: str.c
Prereq: 4.0
*** str.c.old Fri Apr 12 09:32:16 1991
--- str.c Fri Apr 12 09:32:17 1991
***************
*** 1,5 ****
! #undef STDSTDIO
! /* $Header: str.c,v 4.0 91/03/20 01:39:55 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $RCSfile: str.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:15:30 $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 7,12 ****
--- 6,16 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: str.c,v $
+ * Revision 4.0.1.1 91/04/12 09:15:30 lwall
+ * patch1: fixed undefined environ problem
+ * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment
+ * patch1: $foo .= <BAR> could cause core dump for certain lengths of $foo
+ *
* Revision 4.0 91/03/20 01:39:55 lwall
* 4.0 baseline.
*
***************
*** 16,25 ****
#include "perl.h"
#include "perly.h"
- #ifndef __STDC__
- extern char **environ;
- #endif /* ! __STDC__ */
-
#ifndef str_get
char *
str_get(str)
--- 20,25 ----
***************
*** 519,528 ****
--- 519,530 ----
*--bigend = *--midend;
(void)bcopy(little,big+offset,littlelen);
bigstr->str_cur += i;
+ STABSET(bigstr);
return;
}
else if (i == 0) {
(void)bcopy(little,bigstr->str_ptr+offset,len);
+ STABSET(bigstr);
return;
}
***************
*** 734,742 ****
str->str_nok = 0; /* invalidate number */
str->str_pok = 1; /* validate pointer */
if (str->str_len <= cnt + 1) { /* make sure we have the room */
! if (cnt > 80 && str->str_len > 0) {
! shortbuffered = cnt - str->str_len + 1;
! cnt = str->str_len - 1;
}
else {
shortbuffered = 0;
--- 736,744 ----
str->str_nok = 0; /* invalidate number */
str->str_pok = 1; /* validate pointer */
if (str->str_len <= cnt + 1) { /* make sure we have the room */
! if (cnt > 80 && str->str_len > append) {
! shortbuffered = cnt - str->str_len + append + 1;
! cnt -= shortbuffered;
}
else {
shortbuffered = 0;
Index: str.h
Prereq: 4.0
*** str.h.old Fri Apr 12 09:32:20 1991
--- str.h Fri Apr 12 09:32:20 1991
***************
*** 1,4 ****
! /* $Header: str.h,v 4.0 91/03/20 01:40:04 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $RCSfile: str.h,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:16:12 $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: str.h,v $
+ * Revision 4.0.1.1 91/04/12 09:16:12 lwall
+ * patch1: you may now use "die" and "caller" in a signal handler
+ *
* Revision 4.0 91/03/20 01:40:04 lwall
* 4.0 baseline.
*
***************
*** 92,97 ****
--- 95,101 ----
#define SS_SHPTR 7 /* HASH* on save stack */
#define SS_SNSTAB 8 /* non-stab on save stack */
#define SS_SCSV 9 /* callsave structure on save stack */
+ #define SS_SAPTR 10 /* ARRAY* on save stack */
#define SS_HASH 253 /* carrying an hash */
#define SS_ARY 254 /* carrying an array */
#define SS_FREE 255 /* in free list */
Index: hints/sunos_3_4.sh
*** hints/sunos_3_4.sh.old Fri Apr 12 09:31:10 1991
--- hints/sunos_3_4.sh Fri Apr 12 09:31:11 1991
***************
*** 0 ****
--- 1,3 ----
+ usemymalloc=n
+ mallocsrc=''
+ mallocobj=''
Index: hints/sunos_3_5.sh
*** hints/sunos_3_5.sh.old Fri Apr 12 09:31:13 1991
--- hints/sunos_3_5.sh Fri Apr 12 09:31:13 1991
***************
*** 0 ****
--- 1,3 ----
+ usemymalloc=n
+ mallocsrc=''
+ mallocobj=''
Index: hints/sunos_4_0_1.sh
*** hints/sunos_4_0_1.sh.old Fri Apr 12 09:31:15 1991
--- hints/sunos_4_0_1.sh Fri Apr 12 09:31:16 1991
***************
*** 0 ****
--- 1,4 ----
+ echo ': work around botch in SunOS 4.0.1 and 4.0.2' >>../perl.h
+ echo '#ifndef fputs' >>../perl.h
+ echo '#define fputs(str,fp) fprintf(fp,"%s",str)' >>../perl.h
+ echo '#endif' >>../perl.h
Index: hints/sunos_4_0_2.sh
*** hints/sunos_4_0_2.sh.old Fri Apr 12 09:31:17 1991
--- hints/sunos_4_0_2.sh Fri Apr 12 09:31:18 1991
***************
*** 0 ****
--- 1,4 ----
+ echo ': work around botch in SunOS 4.0.1 and 4.0.2' >>../perl.h
+ echo '#ifndef fputs' >>../perl.h
+ echo '#define fputs(str,fp) fprintf(fp,"%s",str)' >>../perl.h
+ echo '#endif' >>../perl.h
Index: toke.c
Prereq: 4.0
*** toke.c.old Fri Apr 12 09:32:26 1991
--- toke.c Fri Apr 12 09:32:27 1991
***************
*** 1,4 ****
! /* $Header: toke.c,v 4.0 91/03/20 01:42:14 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $RCSfile: toke.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:18:18 $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: toke.c,v $
+ * Revision 4.0.1.1 91/04/12 09:18:18 lwall
+ * patch1: perl -de "print" wouldn't stop at the first statement
+ *
* Revision 4.0 91/03/20 01:42:14 lwall
* 4.0 baseline.
*
***************
*** 74,80 ****
/* This does similarly for list operators, merely by pretending that the
* paren came before the listop rather than after.
*/
! #define LOP(f) return(*s == '(' || (s = skipspace(s), *s == '(') ? \
(*s = META('('), bufptr = oldbufptr, '(') : \
(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
/* grandfather return to old style */
--- 77,83 ----
/* This does similarly for list operators, merely by pretending that the
* paren came before the listop rather than after.
*/
! #define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
(*s = META('('), bufptr = oldbufptr, '(') : \
(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
/* grandfather return to old style */
***************
*** 118,123 ****
--- 121,127 ----
int f;
char *s;
{
+ CLINE;
if (*s != '(')
s = skipspace(s);
if (*s == '(') {
Index: hints/ultrix_3.sh
*** hints/ultrix_3.sh.old Fri Apr 12 09:31:20 1991
--- hints/ultrix_3.sh Fri Apr 12 09:31:21 1991
***************
*** 0 ****
--- 1,2 ----
+ ccflags="$ccflags -DLANGUAGE_C"
+ d_waitpid=$undef
Index: hints/ultrix_4.sh
*** hints/ultrix_4.sh.old Fri Apr 12 09:31:22 1991
--- hints/ultrix_4.sh Fri Apr 12 09:31:23 1991
***************
*** 0 ****
--- 1 ----
+ ccflags="$ccflags -DLANGUAGE_C -Olimit 2900"
Index: util.c
Prereq: 4.0
*** util.c.old Fri Apr 12 09:32:31 1991
--- util.c Fri Apr 12 09:32:32 1991
***************
*** 1,4 ****
! /* $Header: util.c,v 4.0 91/03/20 01:56:39 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $RCSfile: util.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:19:25 $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: util.c,v $
+ * Revision 4.0.1.1 91/04/12 09:19:25 lwall
+ * patch1: random cleanup in cpp namespace
+ *
* Revision 4.0 91/03/20 01:56:39 lwall
* 4.0 baseline.
*
***************
*** 754,760 ****
}
}
! #ifndef VARARGS
/*VARARGS1*/
mess(pat,a1,a2,a3,a4)
char *pat;
--- 757,763 ----
}
}
! #ifndef I_VARARGS
/*VARARGS1*/
mess(pat,a1,a2,a3,a4)
char *pat;
***************
*** 955,964 ****
}
#endif
- #ifndef __STDC__
- extern char **environ;
- #endif
-
void
setenv(nam,val)
char *nam, *val;
--- 958,963 ----
***************
*** 1059,1065 ****
#endif
#endif
! #ifdef VARARGS
#ifndef HAS_VPRINTF
#ifdef CHARVSPRINTF
--- 1058,1064 ----
#endif
#endif
! #ifdef I_VARARGS
#ifndef HAS_VPRINTF
#ifdef CHARVSPRINTF
***************
*** 1074,1079 ****
--- 1073,1081 ----
fakebuf._ptr = dest;
fakebuf._cnt = 32767;
+ #ifndef _IOSTRG
+ #define _IOSTRG 0
+ #endif
fakebuf._flag = _IOWRT|_IOSTRG;
_doprnt(pat, args, &fakebuf); /* what a kludge */
(void)putc('\0', &fakebuf);
***************
*** 1095,1101 ****
}
#endif
#endif /* HAS_VPRINTF */
! #endif /* VARARGS */
#ifdef MYSWAP
#if BYTEORDER != 0x4321
--- 1097,1103 ----
}
#endif
#endif /* HAS_VPRINTF */
! #endif /* I_VARARGS */
#ifdef MYSWAP
#if BYTEORDER != 0x4321
Index: hints/uts.sh
*** hints/uts.sh.old Fri Apr 12 09:31:25 1991
--- hints/uts.sh Fri Apr 12 09:31:26 1991
***************
*** 0 ****
--- 1,2 ----
+ ccflags="$ccflags -DCRIPPLED_CC -g"
+ d_lstat=$undef
*** End of patch 2 ***
More information about the Comp.sources.bugs
mailing list