summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLarry Wall <lwall@netlabs.com>1991-04-11 20:32:32 +0000
committerLarry Wall <lwall@netlabs.com>1991-04-11 20:32:32 +0000
commit35c8bce761056f470189967ccc824e04467151df (patch)
tree9ee76bba81900f86af5a1070bdd69d3987201c52
parent1c3d792e8fc9c2a36edfbd6c01156ef7e635040f (diff)
downloadperl-35c8bce761056f470189967ccc824e04467151df.tar.gz
perl 4.0 patch 2: Patch 1 continued
-rw-r--r--hints/mips.sh6
-rw-r--r--hints/ncr_tower.sh2
-rw-r--r--hints/next.sh2
-rw-r--r--hints/osf_1.sh1
-rw-r--r--hints/sco_2_3_0.sh2
-rw-r--r--hints/sco_2_3_1.sh2
-rw-r--r--hints/sco_2_3_2.sh2
-rw-r--r--hints/sco_2_3_3.sh2
-rw-r--r--hints/sco_3.sh3
-rw-r--r--hints/sgi.sh7
-rw-r--r--hints/sunos_3_4.sh3
-rw-r--r--hints/sunos_3_5.sh3
-rw-r--r--hints/sunos_4_0_1.sh4
-rw-r--r--hints/sunos_4_0_2.sh4
-rw-r--r--hints/ultrix_3.sh2
-rw-r--r--hints/ultrix_4.sh1
-rw-r--r--hints/uts.sh2
-rw-r--r--malloc.c9
-rw-r--r--patchlevel.h2
-rw-r--r--perl.c8
-rw-r--r--perl.h13
-rw-r--r--perl.man23
-rw-r--r--perly.fixer93
-rw-r--r--regcomp.c8
-rw-r--r--regexec.c28
-rw-r--r--stab.c51
-rw-r--r--str.c20
-rw-r--r--str.h6
-rw-r--r--toke.c8
-rw-r--r--util.c18
30 files changed, 266 insertions, 69 deletions
diff --git a/hints/mips.sh b/hints/mips.sh
new file mode 100644
index 0000000000..623b6f080b
--- /dev/null
+++ b/hints/mips.sh
@@ -0,0 +1,6 @@
+optimize='-g'
+d_volatile=undef
+d_castneg=undef
+cc=cc
+libpth="/usr/lib/cmplrs/cc $libpth"
+groupstype=int
diff --git a/hints/ncr_tower.sh b/hints/ncr_tower.sh
new file mode 100644
index 0000000000..8b99201ae7
--- /dev/null
+++ b/hints/ncr_tower.sh
@@ -0,0 +1,2 @@
+ccflags="$ccflags -W2,-Sl,2000"
+d_mkdir=$undef
diff --git a/hints/next.sh b/hints/next.sh
new file mode 100644
index 0000000000..6e919cd504
--- /dev/null
+++ b/hints/next.sh
@@ -0,0 +1,2 @@
+: Just disable defaulting to -fpcc-struct-return, since gcc is native compiler.
+ccflags="$ccflags "
diff --git a/hints/osf_1.sh b/hints/osf_1.sh
new file mode 100644
index 0000000000..4929b4a22e
--- /dev/null
+++ b/hints/osf_1.sh
@@ -0,0 +1 @@
+ccflags="$ccflags -D_BSD"
diff --git a/hints/sco_2_3_0.sh b/hints/sco_2_3_0.sh
new file mode 100644
index 0000000000..bf593b0f3e
--- /dev/null
+++ b/hints/sco_2_3_0.sh
@@ -0,0 +1,2 @@
+yacc='/usr/bin/yacc -m25000'
+i_dirent=undef
diff --git a/hints/sco_2_3_1.sh b/hints/sco_2_3_1.sh
new file mode 100644
index 0000000000..bf593b0f3e
--- /dev/null
+++ b/hints/sco_2_3_1.sh
@@ -0,0 +1,2 @@
+yacc='/usr/bin/yacc -m25000'
+i_dirent=undef
diff --git a/hints/sco_2_3_2.sh b/hints/sco_2_3_2.sh
new file mode 100644
index 0000000000..acd8e34a05
--- /dev/null
+++ b/hints/sco_2_3_2.sh
@@ -0,0 +1,2 @@
+yacc='/usr/bin/yacc -m25000'
+libswanted=`echo $libswanted | sed 's/ x / /'`
diff --git a/hints/sco_2_3_3.sh b/hints/sco_2_3_3.sh
new file mode 100644
index 0000000000..acd8e34a05
--- /dev/null
+++ b/hints/sco_2_3_3.sh
@@ -0,0 +1,2 @@
+yacc='/usr/bin/yacc -m25000'
+libswanted=`echo $libswanted | sed 's/ x / /'`
diff --git a/hints/sco_3.sh b/hints/sco_3.sh
new file mode 100644
index 0000000000..015de91dd2
--- /dev/null
+++ b/hints/sco_3.sh
@@ -0,0 +1,3 @@
+yacc='/usr/bin/yacc -Sm11000'
+libswanted=`echo $libswanted | sed 's/ x / /'`
+i_varargs=undef
diff --git a/hints/sgi.sh b/hints/sgi.sh
new file mode 100644
index 0000000000..da5ff639d3
--- /dev/null
+++ b/hints/sgi.sh
@@ -0,0 +1,7 @@
+optimize='-O0'
+usemymalloc='y'
+mallocsrc='malloc.c'
+mallocobj='malloc.o'
+ccflags="$ccflags -Uf_next"
+d_voidsig=define
+d_vfork=undef
diff --git a/hints/sunos_3_4.sh b/hints/sunos_3_4.sh
new file mode 100644
index 0000000000..49b14af1bc
--- /dev/null
+++ b/hints/sunos_3_4.sh
@@ -0,0 +1,3 @@
+usemymalloc=n
+mallocsrc=''
+mallocobj=''
diff --git a/hints/sunos_3_5.sh b/hints/sunos_3_5.sh
new file mode 100644
index 0000000000..49b14af1bc
--- /dev/null
+++ b/hints/sunos_3_5.sh
@@ -0,0 +1,3 @@
+usemymalloc=n
+mallocsrc=''
+mallocobj=''
diff --git a/hints/sunos_4_0_1.sh b/hints/sunos_4_0_1.sh
new file mode 100644
index 0000000000..0cdff54578
--- /dev/null
+++ b/hints/sunos_4_0_1.sh
@@ -0,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
diff --git a/hints/sunos_4_0_2.sh b/hints/sunos_4_0_2.sh
new file mode 100644
index 0000000000..0cdff54578
--- /dev/null
+++ b/hints/sunos_4_0_2.sh
@@ -0,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
diff --git a/hints/ultrix_3.sh b/hints/ultrix_3.sh
new file mode 100644
index 0000000000..2057bc683c
--- /dev/null
+++ b/hints/ultrix_3.sh
@@ -0,0 +1,2 @@
+ccflags="$ccflags -DLANGUAGE_C"
+d_waitpid=$undef
diff --git a/hints/ultrix_4.sh b/hints/ultrix_4.sh
new file mode 100644
index 0000000000..008e1ef82a
--- /dev/null
+++ b/hints/ultrix_4.sh
@@ -0,0 +1 @@
+ccflags="$ccflags -DLANGUAGE_C -Olimit 2900"
diff --git a/hints/uts.sh b/hints/uts.sh
new file mode 100644
index 0000000000..c31733cb8d
--- /dev/null
+++ b/hints/uts.sh
@@ -0,0 +1,2 @@
+ccflags="$ccflags -DCRIPPLED_CC -g"
+d_lstat=$undef
diff --git a/malloc.c b/malloc.c
index 3acc579cd0..fece175e00 100644
--- a/malloc.c
+++ b/malloc.c
@@ -1,6 +1,9 @@
-/* $Header: malloc.c,v 4.0 91/03/20 01:28:52 lwall Locked $
+/* $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,7 +107,7 @@ botch(s)
#define ASSERT(p)
#endif
-char *
+MALLOCPTRTYPE *
malloc(nbytes)
register unsigned nbytes;
{
@@ -273,7 +276,7 @@ free(cp)
*/
int reall_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */
-char *
+MALLOCPTRTYPE *
realloc(cp, nbytes)
char *cp;
unsigned nbytes;
diff --git a/patchlevel.h b/patchlevel.h
index 110c86f392..e3d7670bc6 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 1
+#define PATCHLEVEL 2
diff --git a/perl.c b/perl.c
index 6ea64ecdea..11ba0f66e8 100644
--- a/perl.c
+++ b/perl.c
@@ -1,4 +1,4 @@
-char rcsid[] = "$Header: perl.c,v 4.0 91/03/20 01:37:44 lwall Locked $\nPatch level: ###\n";
+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,6 +6,9 @@ char rcsid[] = "$Header: perl.c,v 4.0 91/03/20 01:37:44 lwall Locked $\nPatch le
* 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,9 +37,6 @@ char rcsid[] = "$Header: perl.c,v 4.0 91/03/20 01:37:44 lwall Locked $\nPatch le
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";
diff --git a/perl.h b/perl.h
index 52d9e16c9d..96d5d554e7 100644
--- a/perl.h
+++ b/perl.h
@@ -1,4 +1,4 @@
-/* $Header: perl.h,v 4.0 91/03/20 01:37:56 lwall Locked $
+/* $RCSfile: perl.h,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:51 $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,12 +6,15 @@
* 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 VOIDUSED 1
+#define VOIDWANT 1
#include "config.h"
#ifdef MSDOS
@@ -148,6 +151,7 @@ extern int errno; /* ANSI allows errno to be an lvalue expr */
#endif
#endif
+#ifndef strerror
#ifdef HAS_STRERROR
char *strerror();
#else
@@ -155,6 +159,7 @@ extern int sys_nerr;
extern char *sys_errlist[];
#define strerror(e) ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
#endif
+#endif
#ifdef I_SYSIOCTL
#ifndef _IOCTL_
@@ -221,7 +226,7 @@ EXT int dbmlen;
#define ntohi ntohl
#endif
-#if defined(I_DIRENT) && !defined(M_XENIX)
+#if defined(I_DIRENT)
# include <dirent.h>
# define DIRENT dirent
#else
@@ -592,6 +597,8 @@ ARRAY *saveary();
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);
diff --git a/perl.man b/perl.man
index 111dca0579..7dc7714050 100644
--- a/perl.man
+++ b/perl.man
@@ -1,7 +1,10 @@
.rn '' }`
-''' $Header: perl.man,v 4.0 91/03/20 01:38:08 lwall Locked $
+''' $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,7 +1375,7 @@ the list.
print "\et" x ($tab/8), \' \' x ($tab%8); # tab over
- @ones = (1) x ; # an array of 80 1's
+ @ones = (1) x 80; # an array of 80 1's
@ones = (5) x @ones; # set all elements to 5
.fi
@@ -1604,9 +1607,12 @@ Thus, a portable way to find out the home directory might be:
.fi
''' Beginning of part 2
-''' $Header: perl.man,v 4.0 91/03/20 01:38:08 lwall Locked $
+''' $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,9 +2803,12 @@ the first thing in VAR, and the maximum length of VAR is SIZE plus the
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 $
+''' $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,9 +4267,12 @@ For more on formats, see the section on formats later on.
.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 $
+''' $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,6 +5936,7 @@ such as type casting, atof() and sprintf().
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:
diff --git a/perly.fixer b/perly.fixer
index b91c0e099b..33d1c5cd1a 100644
--- a/perly.fixer
+++ b/perly.fixer
@@ -1,22 +1,46 @@
#!/bin/sh
+# Hacks to make it work with Interactive's SysVr3 Version 2.2
+# doughera@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 *\] *;
+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
-case "$1" in
-5) echo "Patching perly.c to allow dynamic yacc stack allocation";;
-*) mv $input $output; rm -f $tmp; exit;;
-esac
+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
-cat >$tmp <<'END'
+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,6 +79,61 @@ short *maxyyps;
/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
-sed -f $tmp <$input >$output
rm -rf $tmp $input
diff --git a/regcomp.c b/regcomp.c
index ee6e4dde60..f11c602b55 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -7,9 +7,12 @@
* blame Henry for some of the lack of readability.
*/
-/* $Header: regcomp.c,v 4.0 91/03/20 01:39:01 lwall Locked $
+/* $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,6 +73,9 @@
((*s) == '{' && regcurly(s)))
#define META "^$.[()|?+*\\"
+#ifdef SPSTART
+#undef SPSTART /* dratted cpp namespace... */
+#endif
/*
* Flags to be passed up and down.
*/
diff --git a/regexec.c b/regexec.c
index 45076d36eb..7db8e3d3ba 100644
--- a/regexec.c
+++ b/regexec.c
@@ -7,9 +7,12 @@
* blame Henry for some of the lack of readability.
*/
-/* $Header: regexec.c,v 4.0 91/03/20 01:39:16 lwall Locked $
+/* $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,8 +83,9 @@ static char **regendp; /* Ditto for endp. */
static char *reglastparen; /* Similarly for lastparen. */
static char *regtill;
-static char *regmystartp[10]; /* For remembering backreferences. */
-static char *regmyendp[10];
+static int regmyp_size = 0;
+static char **regmystartp = Null(char**);
+static char **regmyendp = Null(char**);
/*
* Forwards.
@@ -189,6 +193,24 @@ int safebase; /* no need to remember string in subbase */
/* 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] */
if (prog->reganch & 1) {
diff --git a/stab.c b/stab.c
index 90a496be45..7819793b80 100644
--- a/stab.c
+++ b/stab.c
@@ -1,4 +1,4 @@
-/* $Header: stab.c,v 4.0 91/03/20 01:39:41 lwall Locked $
+/* $RCSfile: stab.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:10:24 $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,10 @@
* 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,7 +188,7 @@ STR *str;
#define NGROUPS 32
#endif
{
- GIDTYPE gary[NGROUPS];
+ GROUPSTYPE gary[NGROUPS];
i = getgroups(NGROUPS,gary);
while (--i >= 0) {
@@ -579,18 +583,15 @@ sighandler(sig)
int sig;
{
STAB *stab;
- ARRAY *savearray;
STR *str;
- CMD *oldcurcmd = curcmd;
int oldsave = savestack->ary_fill;
- ARRAY *oldstack = stack;
- CSV *oldcurcsv = curcsv;
+ int oldtmps_base = tmps_base;
+ register CSV *csv;
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);
@@ -610,10 +611,23 @@ int sig;
sig_name[sig], stab_name(stab) );
return;
}
- savearray = stab_xarray(defstab);
- stab_xarray(defstab) = stack = anew(defstab);
+ 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;
- str = Str_new(71,0);
+ curcsv = csv;
+ str = str_mortal(&str_undef);
str_set(str,sig_name[sig]);
(void)apush(stab_xarray(defstab),str);
sub->depth++;
@@ -623,18 +637,11 @@ int sig;
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;
+ 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 *
diff --git a/str.c b/str.c
index 7f7efc3462..8ffc553ab5 100644
--- a/str.c
+++ b/str.c
@@ -1,5 +1,4 @@
-#undef STDSTDIO
-/* $Header: str.c,v 4.0 91/03/20 01:39:55 lwall Locked $
+/* $RCSfile: str.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:15:30 $
*
* Copyright (c) 1989, Larry Wall
*
@@ -7,6 +6,11 @@
* 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,10 +20,6 @@
#include "perl.h"
#include "perly.h"
-#ifndef __STDC__
-extern char **environ;
-#endif /* ! __STDC__ */
-
#ifndef str_get
char *
str_get(str)
@@ -519,10 +519,12 @@ STRLEN littlelen;
*--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,9 +736,9 @@ int append;
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;
+ if (cnt > 80 && str->str_len > append) {
+ shortbuffered = cnt - str->str_len + append + 1;
+ cnt -= shortbuffered;
}
else {
shortbuffered = 0;
diff --git a/str.h b/str.h
index f77aef0309..be04450b8c 100644
--- a/str.h
+++ b/str.h
@@ -1,4 +1,4 @@
-/* $Header: str.h,v 4.0 91/03/20 01:40:04 lwall Locked $
+/* $RCSfile: str.h,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:16:12 $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,9 @@
* 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,6 +95,7 @@ struct lstring {
#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 */
diff --git a/toke.c b/toke.c
index 77c9dee691..29ee126519 100644
--- a/toke.c
+++ b/toke.c
@@ -1,4 +1,4 @@
-/* $Header: toke.c,v 4.0 91/03/20 01:42:14 lwall Locked $
+/* $RCSfile: toke.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:18:18 $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,9 @@
* 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,7 +77,7 @@ void checkcomma();
/* 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 == '(') ? \
+#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,6 +121,7 @@ lop(f,s)
int f;
char *s;
{
+ CLINE;
if (*s != '(')
s = skipspace(s);
if (*s == '(') {
diff --git a/util.c b/util.c
index ca9362c936..69473710f3 100644
--- a/util.c
+++ b/util.c
@@ -1,4 +1,4 @@
-/* $Header: util.c,v 4.0 91/03/20 01:56:39 lwall Locked $
+/* $RCSfile: util.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:19:25 $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,9 @@
* 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,7 +757,7 @@ int newlen;
}
}
-#ifndef VARARGS
+#ifndef I_VARARGS
/*VARARGS1*/
mess(pat,a1,a2,a3,a4)
char *pat;
@@ -955,10 +958,6 @@ va_dcl
}
#endif
-#ifndef __STDC__
-extern char **environ;
-#endif
-
void
setenv(nam,val)
char *nam, *val;
@@ -1059,7 +1058,7 @@ register int len;
#endif
#endif
-#ifdef VARARGS
+#ifdef I_VARARGS
#ifndef HAS_VPRINTF
#ifdef CHARVSPRINTF
@@ -1074,6 +1073,9 @@ char *dest, *pat, *args;
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,7 +1097,7 @@ char *pat, *args;
}
#endif
#endif /* HAS_VPRINTF */
-#endif /* VARARGS */
+#endif /* I_VARARGS */
#ifdef MYSWAP
#if BYTEORDER != 0x4321