diff options
| -rw-r--r-- | hints/mips.sh | 6 | ||||
| -rw-r--r-- | hints/ncr_tower.sh | 2 | ||||
| -rw-r--r-- | hints/next.sh | 2 | ||||
| -rw-r--r-- | hints/osf_1.sh | 1 | ||||
| -rw-r--r-- | hints/sco_2_3_0.sh | 2 | ||||
| -rw-r--r-- | hints/sco_2_3_1.sh | 2 | ||||
| -rw-r--r-- | hints/sco_2_3_2.sh | 2 | ||||
| -rw-r--r-- | hints/sco_2_3_3.sh | 2 | ||||
| -rw-r--r-- | hints/sco_3.sh | 3 | ||||
| -rw-r--r-- | hints/sgi.sh | 7 | ||||
| -rw-r--r-- | hints/sunos_3_4.sh | 3 | ||||
| -rw-r--r-- | hints/sunos_3_5.sh | 3 | ||||
| -rw-r--r-- | hints/sunos_4_0_1.sh | 4 | ||||
| -rw-r--r-- | hints/sunos_4_0_2.sh | 4 | ||||
| -rw-r--r-- | hints/ultrix_3.sh | 2 | ||||
| -rw-r--r-- | hints/ultrix_4.sh | 1 | ||||
| -rw-r--r-- | hints/uts.sh | 2 | ||||
| -rw-r--r-- | malloc.c | 9 | ||||
| -rw-r--r-- | patchlevel.h | 2 | ||||
| -rw-r--r-- | perl.c | 8 | ||||
| -rw-r--r-- | perl.h | 13 | ||||
| -rw-r--r-- | perl.man | 23 | ||||
| -rw-r--r-- | perly.fixer | 93 | ||||
| -rw-r--r-- | regcomp.c | 8 | ||||
| -rw-r--r-- | regexec.c | 28 | ||||
| -rw-r--r-- | stab.c | 51 | ||||
| -rw-r--r-- | str.c | 20 | ||||
| -rw-r--r-- | str.h | 6 | ||||
| -rw-r--r-- | toke.c | 8 | ||||
| -rw-r--r-- | util.c | 18 |
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 @@ -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 @@ -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"; @@ -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); @@ -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 @@ -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. */ @@ -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) { @@ -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 * @@ -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; @@ -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 */ @@ -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 == '(') { @@ -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 |