perl 2.0 patch #6
The Superuser
lroot at devvax.JPL.NASA.GOV
Wed Jul 13 10:54:26 AEST 1988
System: perl version 2.0
Patch #: 6
Priority: LOW (except on systems with a dinky yacc)
Subject: simplified grammar to prevent indigestion in some yaccs
Subject: removed some useless assignments
Subject: added some static evaluation for sin, cos, atan2 and **
Subject: "Can't execute" message could print null arg
Subject: In IAMSUID, did seteuid before setegid
Subject: seteuid was unprotected by SETEUID
Subject: added some SYSV signals
Subject: TEST now ignores ~ files as well as .orig
Description:
I tried compiling perl on a Masscomp and found that the grammar
was running the yacc optimizer out of room. So I simplified
the grammar to reduce its size. (It still parses exactly the
same language (I hope).)
I removed some useless assignments that the Apollo compiler
was griping about.
Patch 2 forced definition of DOSUID if IAMSUID was set, but
did it wrong. Also, in the IAMSUID stuff, it was doing a seteuid
before the setegid, which causes the setegid to fail on a script
that's both setuid and setgid. Some systems also don't have
seteuid, so we substitute setuid instead.
Calling sin, cos, atan2 and ** with static arguments now
evaluates them at compile time.
When you use -S on a non-existent script, the "Can't execute"
message would try to dereference a null pointer.
I've made a first crack at handling some SysV signals like SIGCLD.
The TEST program now ignores ~ files as well as .orig, since patch
now uses that as an alternate backup extension.
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:
make
make test
make install
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 at jpl-devvax.jpl.nasa.gov
If you send a mail message of the following form it will greatly speed
processing:
Subject: Command
@SH mailpatch PATH perl 2.0 LIST
^ note the c
where PATH is a return path FROM ME TO YOU either in Internet notation,
or in bang notation from some well-known host, and LIST is the number
of one or more patches you need, separated by spaces, commas, and/or
hyphens. Saying 35- says everything from 35 to the end.
You can also get the patches via anonymous FTP from
jpl-devvax.jpl.nasa.gov (128.149.8.43).
Index: patchlevel.h
Prereq: 5
1c1
< #define PATCHLEVEL 5
---
> #define PATCHLEVEL 6
Index: Makefile.SH
Prereq: 2.0.1.2
*** Makefile.SH.old Tue Jul 12 17:37:32 1988
--- Makefile.SH Tue Jul 12 17:37:34 1988
***************
*** 25,33 ****
echo "Extracting Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 2.0.1.2 88/07/11 22:19:00 root Exp $
#
# $Log: Makefile.SH,v $
# Revision 2.0.1.2 88/07/11 22:19:00 root
# patch2: forced DOSUID if IAMSUID
# patch2: now we expect 39 shift/reduce errors
--- 25,36 ----
echo "Extracting Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 2.0.1.3 88/07/12 17:11:56 root Exp $
#
# $Log: Makefile.SH,v $
+ # Revision 2.0.1.3 88/07/12 17:11:56 root
+ # patch6: Now it's 23 shift/reduce errors
+ #
# Revision 2.0.1.2 88/07/11 22:19:00 root
# patch2: forced DOSUID if IAMSUID
# patch2: now we expect 39 shift/reduce errors
***************
*** 112,118 ****
sperly.o: perly.c
/bin/rm -f sperly.c
ln perly.c sperly.c
! $(CC) -c -DIAMSUID -DDOSUID $(CFLAGS) $(LARGE) sperly.c
/bin/rm -f sperly.c
!NO!SUBS!
;;
--- 115,121 ----
sperly.o: perly.c
/bin/rm -f sperly.c
ln perly.c sperly.c
! $(CC) -c -DIAMSUID $(CFLAGS) $(LARGE) sperly.c
/bin/rm -f sperly.c
!NO!SUBS!
;;
***************
*** 121,127 ****
cat >>Makefile <<'!NO!SUBS!'
perl.c perly.h: perl.y
! @ echo Expect 39 shift/reduce errors...
yacc -d perl.y
mv y.tab.c perl.c
mv y.tab.h perly.h
--- 124,130 ----
cat >>Makefile <<'!NO!SUBS!'
perl.c perly.h: perl.y
! @ echo Expect 23 shift/reduce errors...
yacc -d perl.y
mv y.tab.c perl.c
mv y.tab.h perly.h
Index: t/TEST
Prereq: 2.0
*** t/TEST.old Tue Jul 12 17:38:59 1988
--- t/TEST Tue Jul 12 17:38:59 1988
***************
*** 1,6 ****
#!./perl
! # $Header: TEST,v 2.0 88/06/05 00:11:47 root Exp $
# 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
! # $Header: TEST,v 2.0.1.1 88/07/12 17:36:43 root Exp $
# This is written in a peculiar style, since we're trying to avoid
# most of the constructs we'll be testing for.
***************
*** 26,31 ****
--- 26,34 ----
$bad = 0;
while ($test = shift) {
if ($test =~ /\.orig$/) {
+ next;
+ }
+ if ($test =~ /~$/) {
next;
}
print "$test...";
Index: arg.c
Prereq: 2.0.1.1
*** arg.c.old Tue Jul 12 17:37:45 1988
--- arg.c Tue Jul 12 17:37:48 1988
***************
*** 1,6 ****
! /* $Header: arg.c,v 2.0.1.1 88/07/11 22:24:19 root Exp $
*
* $Log: arg.c,v $
* Revision 2.0.1.1 88/07/11 22:24:19 root
* patch2: $& not set right due to optimization
* patch2: second search in s/// could malf if $<digit> or $& in use
--- 1,9 ----
! /* $Header: arg.c,v 2.0.1.2 88/07/12 17:13:14 root Exp $
*
* $Log: arg.c,v $
+ * Revision 2.0.1.2 88/07/12 17:13:14 root
+ * patch6: removed useless assignment
+ *
* Revision 2.0.1.1 88/07/11 22:24:19 root
* patch2: $& not set right due to optimization
* patch2: second search in s/// could malf if $<digit> or $& in use
***************
*** 1240,1246 ****
{
STR **tmpary; /* must not be register */
register STR **elem;
! register STR *str = &str_no;
register int i;
register int items;
--- 1243,1249 ----
{
STR **tmpary; /* must not be register */
register STR **elem;
! register STR *str;
register int i;
register int items;
Index: eval.c
Prereq: 2.0.1.1
*** eval.c.old Tue Jul 12 17:38:02 1988
--- eval.c Tue Jul 12 17:38:05 1988
***************
*** 1,6 ****
! /* $Header: eval.c,v 2.0.1.1 88/07/11 22:32:51 root Exp $
*
* $Log: eval.c,v $
* Revision 2.0.1.1 88/07/11 22:32:51 root
* patch2: added ATAN2, SIN, COS, RAND, SRAND and RETURN
* patch2: fixed list-in-list bug
--- 1,9 ----
! /* $Header: eval.c,v 2.0.1.2 88/07/12 17:16:15 root Exp $
*
* $Log: eval.c,v $
+ * Revision 2.0.1.2 88/07/12 17:16:15 root
+ * patch6: removed uselss ++
+ *
* Revision 2.0.1.1 88/07/11 22:32:51 root
* patch2: added ATAN2, SIN, COS, RAND, SRAND and RETURN
* patch2: fixed list-in-list bug
***************
*** 668,674 ****
for (anum = 0; anum <= maxarg; anum++) {
sarg[anum+1] = str = afetch(ary,anum);
}
- maxarg++;
maxsarg++;
goto array_return;
}
--- 671,676 ----
Index: form.c
Prereq: 2.0
*** form.c.old Tue Jul 12 17:38:14 1988
--- form.c Tue Jul 12 17:38:15 1988
***************
*** 1,6 ****
! /* $Header: form.c,v 2.0 88/06/05 00:08:57 root Exp $
*
* $Log: form.c,v $
* Revision 2.0 88/06/05 00:08:57 root
* Baseline version 2.0.
*
--- 1,9 ----
! /* $Header: form.c,v 2.0.1.1 88/07/12 17:16:52 root Exp $
*
* $Log: form.c,v $
+ * Revision 2.0.1.1 88/07/12 17:16:52 root
+ * patch6: removed useless assign
+ *
* Revision 2.0 88/06/05 00:08:57 root
* Baseline version 2.0.
*
***************
*** 85,91 ****
*d++ = '.';
*d++ = '.';
}
- s = chophere;
while (*chophere == ' ' || *chophere == '\n')
chophere++;
str_chop(str,chophere);
--- 88,93 ----
Index: perl.y
Prereq: 2.0.1.1
*** perl.y.old Tue Jul 12 17:38:20 1988
--- perl.y Tue Jul 12 17:38:23 1988
***************
*** 1,6 ****
! /* $Header: perl.y,v 2.0.1.1 88/07/11 22:46:03 root Exp $
*
* $Log: perl.y,v $
* Revision 2.0.1.1 88/07/11 22:46:03 root
* patch2: added **
* patch2: no longer blows yacc stack on long LISTs (made , left associative)
--- 1,9 ----
! /* $Header: perl.y,v 2.0.1.2 88/07/12 17:23:41 root Exp $
*
* $Log: perl.y,v $
+ * Revision 2.0.1.2 88/07/12 17:23:41 root
+ * patch6: simplified grammar to prevent indigestion in some yaccs
+ *
* Revision 2.0.1.1 88/07/11 22:46:03 root
* patch2: added **
* patch2: no longer blows yacc stack on long LISTs (made , left associative)
***************
*** 32,42 ****
"..",
"||",
"&&",
! "==","!=", "EQ", "NE",
! "<=",">=", "LT", "GT", "LE", "GE",
! "unary operation",
"file test",
"<<",">>",
"=~","!~", "unary -",
"**",
"++", "--",
--- 35,47 ----
"..",
"||",
"&&",
! "equality operator",
! "relational operator",
! "unary operator",
"file test",
"<<",">>",
+ "additive operator",
+ "multiplicative operator",
"=~","!~", "unary -",
"**",
"++", "--",
***************
*** 66,71 ****
--- 71,77 ----
%token <ival> FOR FEOF TELL SEEK STAT
%token <ival> FUNC0 FUNC1 FUNC2 FUNC3 STABFUN
%token <ival> JOIN SUB FILETEST LOCAL DELETE
+ %token <ival> RELOP EQOP MULOP ADDOP
%token <formval> FORMLIST
%token <stabval> REG ARYLEN ARY
%token <arg> SUBST PATTERN
***************
*** 89,101 ****
%left ANDAND
%left '|' '^'
%left '&'
! %nonassoc EQ NE SEQ SNE
! %nonassoc '<' '>' LE GE SLT SGT SLE SGE
%nonassoc <ival> UNIOP
%nonassoc FILETEST
%left LS RS
! %left '+' '-' '.'
! %left '*' '/' '%' 'x'
%left MATCH NMATCH
%right '!' '~' UMINUS
%right POW
--- 95,107 ----
%left ANDAND
%left '|' '^'
%left '&'
! %nonassoc EQOP
! %nonassoc RELOP
%nonassoc <ival> UNIOP
%nonassoc FILETEST
%left LS RS
! %left ADDOP
! %left MULOP
%left MATCH NMATCH
%right '!' '~' UMINUS
%right POW
***************
*** 294,302 ****
{ $$ = 0; }
;
! format : FORMAT WORD '=' FORMLIST '.'
{ stabent($2,TRUE)->stab_form = $4; safefree($2); }
! | FORMAT '=' FORMLIST '.'
{ stabent("stdout",TRUE)->stab_form = $3; }
;
--- 300,308 ----
{ $$ = 0; }
;
! format : FORMAT WORD '=' FORMLIST
{ stabent($2,TRUE)->stab_form = $4; safefree($2); }
! | FORMAT '=' FORMLIST
{ stabent("stdout",TRUE)->stab_form = $3; }
;
***************
*** 316,333 ****
$$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg,1)); }
| sexpr POW '=' sexpr
{ $$ = l(make_op(O_POW, 2, $1, $4, Nullarg,0)); }
! | sexpr '*' '=' sexpr
! { $$ = l(make_op(O_MULTIPLY, 2, $1, $4, Nullarg,0)); }
! | sexpr '/' '=' sexpr
! { $$ = l(make_op(O_DIVIDE, 2, $1, $4, Nullarg,0)); }
! | sexpr '%' '=' sexpr
! { $$ = l(make_op(O_MODULO, 2, $1, $4, Nullarg,0)); }
! | sexpr 'x' '=' sexpr
! { $$ = l(make_op(O_REPEAT, 2, $1, $4, Nullarg,0)); }
! | sexpr '+' '=' sexpr
! { $$ = l(make_op(O_ADD, 2, $1, $4, Nullarg,0)); }
! | sexpr '-' '=' sexpr
! { $$ = l(make_op(O_SUBTRACT, 2, $1, $4, Nullarg,0)); }
| sexpr LS '=' sexpr
{ $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg,0)); }
| sexpr RS '=' sexpr
--- 322,331 ----
$$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg,1)); }
| sexpr POW '=' sexpr
{ $$ = l(make_op(O_POW, 2, $1, $4, Nullarg,0)); }
! | sexpr MULOP '=' sexpr
! { $$ = l(make_op($2, 2, $1, $4, Nullarg,0)); }
! | sexpr ADDOP '=' sexpr
! { $$ = l(make_op($2, 2, $1, $4, Nullarg,0)); }
| sexpr LS '=' sexpr
{ $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg,0)); }
| sexpr RS '=' sexpr
***************
*** 338,389 ****
{ $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg,0)); }
| sexpr '|' '=' sexpr
{ $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg,0)); }
- | sexpr '.' '=' sexpr
- { $$ = l(make_op(O_CONCAT, 2, $1, $4, Nullarg,0)); }
| sexpr POW sexpr
{ $$ = make_op(O_POW, 2, $1, $3, Nullarg,0); }
! | sexpr '*' sexpr
! { $$ = make_op(O_MULTIPLY, 2, $1, $3, Nullarg,0); }
! | sexpr '/' sexpr
! { $$ = make_op(O_DIVIDE, 2, $1, $3, Nullarg,0); }
! | sexpr '%' sexpr
! { $$ = make_op(O_MODULO, 2, $1, $3, Nullarg,0); }
! | sexpr 'x' sexpr
! { $$ = make_op(O_REPEAT, 2, $1, $3, Nullarg,0); }
! | sexpr '+' sexpr
! { $$ = make_op(O_ADD, 2, $1, $3, Nullarg,0); }
! | sexpr '-' sexpr
! { $$ = make_op(O_SUBTRACT, 2, $1, $3, Nullarg,0); }
| sexpr LS sexpr
{ $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg,0); }
| sexpr RS sexpr
{ $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg,0); }
! | sexpr '<' sexpr
! { $$ = make_op(O_LT, 2, $1, $3, Nullarg,0); }
! | sexpr '>' sexpr
! { $$ = make_op(O_GT, 2, $1, $3, Nullarg,0); }
! | sexpr LE sexpr
! { $$ = make_op(O_LE, 2, $1, $3, Nullarg,0); }
! | sexpr GE sexpr
! { $$ = make_op(O_GE, 2, $1, $3, Nullarg,0); }
! | sexpr EQ sexpr
! { $$ = make_op(O_EQ, 2, $1, $3, Nullarg,0); }
! | sexpr NE sexpr
! { $$ = make_op(O_NE, 2, $1, $3, Nullarg,0); }
! | sexpr SLT sexpr
! { $$ = make_op(O_SLT, 2, $1, $3, Nullarg,0); }
! | sexpr SGT sexpr
! { $$ = make_op(O_SGT, 2, $1, $3, Nullarg,0); }
! | sexpr SLE sexpr
! { $$ = make_op(O_SLE, 2, $1, $3, Nullarg,0); }
! | sexpr SGE sexpr
! { $$ = make_op(O_SGE, 2, $1, $3, Nullarg,0); }
! | sexpr SEQ sexpr
! { $$ = make_op(O_SEQ, 2, $1, $3, Nullarg,0); }
! | sexpr SNE sexpr
! { $$ = make_op(O_SNE, 2, $1, $3, Nullarg,0); }
| sexpr '&' sexpr
{ $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg,0); }
| sexpr '^' sexpr
--- 336,357 ----
{ $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg,0)); }
| sexpr '|' '=' sexpr
{ $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg,0)); }
| sexpr POW sexpr
{ $$ = make_op(O_POW, 2, $1, $3, Nullarg,0); }
! | sexpr MULOP sexpr
! { $$ = make_op($2, 2, $1, $3, Nullarg,0); }
! | sexpr ADDOP sexpr
! { $$ = make_op($2, 2, $1, $3, Nullarg,0); }
| sexpr LS sexpr
{ $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg,0); }
| sexpr RS sexpr
{ $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg,0); }
! | sexpr RELOP sexpr
! { $$ = make_op($2, 2, $1, $3, Nullarg,0); }
! | sexpr EQOP sexpr
! { $$ = make_op($2, 2, $1, $3, Nullarg,0); }
| sexpr '&' sexpr
{ $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg,0); }
| sexpr '^' sexpr
***************
*** 401,408 ****
{ $$ = make_op(O_OR, 2, $1, $3, Nullarg,0); }
| sexpr '?' sexpr ':' sexpr
{ $$ = make_op(O_COND_EXPR, 3, $1, $3, $5,0); }
- | sexpr '.' sexpr
- { $$ = make_op(O_CONCAT, 2, $1, $3, Nullarg,0); }
| sexpr MATCH sexpr
{ $$ = mod_match(O_MATCH, $1, $3); }
| sexpr NMATCH sexpr
--- 369,374 ----
Index: perly.c
Prereq: 2.0.1.2
*** perly.c.old Tue Jul 12 17:38:34 1988
--- perly.c Tue Jul 12 17:38:38 1988
***************
*** 1,6 ****
! char rcsid[] = "$Header: perly.c,v 2.0.1.2 88/07/11 23:02:05 root Exp $";
/*
* $Log: perly.c,v $
* Revision 2.0.1.2 88/07/11 23:02:05 root
* patch2: added $` and $'
* patch2: kludged in a BLOCK for return to refer to
--- 1,13 ----
! char rcsid[] = "$Header: perly.c,v 2.0.1.3 88/07/12 17:34:12 root Exp $";
/*
* $Log: perly.c,v $
+ * Revision 2.0.1.3 88/07/12 17:34:12 root
+ * patch6: forced DOSUID if IAMSUID
+ * patch6: added some static evaluation for sin, cos, atan2 and **
+ * patch6: "Can't execute" message could print null arg
+ * patch6: In IAMSUID, did seteuid before setegid
+ * patch6: seteuid was unprotected by SETEUID
+ *
* Revision 2.0.1.2 88/07/11 23:02:05 root
* patch2: added $` and $'
* patch2: kludged in a BLOCK for return to refer to
***************
*** 25,30 ****
--- 32,43 ----
#include "perl.h"
#include "perly.h"
+ #ifdef IAMSUID
+ #ifndef DOSUID
+ #define DOSUID
+ #endif
+ #endif
+
extern char *tokename[];
extern int yychar;
***************
*** 191,197 ****
xfailed = savestr(tokenbuf);
}
if (!xfound)
! fatal("Can't execute %s", xfailed);
if (xfailed)
safefree(xfailed);
argv[0] = savestr(xfound);
--- 204,210 ----
xfailed = savestr(tokenbuf);
}
if (!xfound)
! fatal("Can't execute %s", xfailed ? xfailed : argv[0] );
if (xfailed)
safefree(xfailed);
argv[0] = savestr(xfound);
***************
*** 217,224 ****
--- 230,241 ----
argv[0], CPPSTDIN, str_get(str), CPPMINUS);
#ifdef IAMSUID
if (euid != uid && !euid) /* if running suidperl */
+ #ifdef SETEUID
seteuid(uid); /* musn't stay setuid root */
+ #else
+ setuid(uid);
#endif
+ #endif
rsfp = popen(buf,"r");
}
else if (!*argv[0])
***************
*** 294,305 ****
fatal("Can't do setuid\n");
}
if (statbuf.st_mode & S_ISUID && statbuf.st_uid != euid)
seteuid(statbuf.st_uid); /* all that for this */
else if (uid) /* oops, mustn't run as root */
seteuid(uid);
! if (statbuf.st_mode & S_ISGID && statbuf.st_gid != getegid())
! setegid(statbuf.st_gid);
euid = (int)geteuid();
if (!cando(S_IEXEC,TRUE))
fatal("Permission denied\n"); /* they can't do this */
--- 311,334 ----
fatal("Can't do setuid\n");
}
+ if (statbuf.st_mode & S_ISGID && statbuf.st_gid != getegid())
+ #ifdef SETEGID
+ setegid(statbuf.st_gid);
+ #else
+ setgid(statbuf.st_gid);
+ #endif
if (statbuf.st_mode & S_ISUID && statbuf.st_uid != euid)
+ #ifdef SETEUID
seteuid(statbuf.st_uid); /* all that for this */
+ #else
+ setuid(statbuf.st_uid);
+ #endif
else if (uid) /* oops, mustn't run as root */
+ #ifdef SETEUID
seteuid(uid);
! #else
! setuid(uid);
! #endif
euid = (int)geteuid();
if (!cando(S_IEXEC,TRUE))
fatal("Permission denied\n"); /* they can't do this */
***************
*** 1133,1138 ****
--- 1162,1168 ----
unsigned long tmplong;
double exp(), log(), sqrt(), modf();
char *crypt();
+ double sin(), cos(), atan2(), pow();
if (!arg || !arg->arg_len)
return;
***************
*** 1262,1267 ****
--- 1292,1311 ----
break;
case O_COMPLEMENT:
str_numset(str,(double)(~(long)str_gnum(s1)));
+ 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));
Index: stab.c
Prereq: 2.0.1.1
*** stab.c.old Tue Jul 12 17:38:51 1988
--- stab.c Tue Jul 12 17:38:53 1988
***************
*** 1,6 ****
! /* $Header: stab.c,v 2.0.1.1 88/07/11 23:07:44 root Exp $
*
* $Log: stab.c,v $
* Revision 2.0.1.1 88/07/11 23:07:44 root
* patch2: added $` and $'
* patch2: maximum length of groups list can now exceed 256 chars
--- 1,10 ----
! /* $Header: stab.c,v 2.0.1.2 88/07/12 17:36:00 root Exp $
*
* $Log: stab.c,v $
+ * Revision 2.0.1.2 88/07/12 17:36:00 root
+ * patch6: added some SYSV signals
+ * patch6: removed a useless assign
+ *
* Revision 2.0.1.1 88/07/11 23:07:44 root
* patch2: added $` and $'
* patch2: maximum length of groups list can now exceed 256 chars
***************
*** 16,22 ****
#include <signal.h>
static char *sig_name[] = {
! "",
"HUP",
"INT",
"QUIT",
--- 20,26 ----
#include <signal.h>
static char *sig_name[] = {
! "ZERO",
"HUP",
"INT",
"QUIT",
***************
*** 32,66 ****
"PIPE",
"ALRM",
"TERM",
- "???"
#ifdef SIGTSTP
! ,"STOP",
"TSTP",
"CONT",
"CHLD",
"TTIN",
"TTOU",
! "TINT",
"XCPU",
! "XFSZ"
#ifdef SIGPROF
! ,"VTALARM",
! "PROF"
#ifdef SIGWINCH
! ,"WINCH"
#ifdef SIGLOST
! ,"LOST"
#ifdef SIGUSR1
! ,"USR1"
#endif
#ifdef SIGUSR2
! ,"USR2"
#endif /* SIGUSR2 */
#endif /* SIGLOST */
#endif /* SIGWINCH */
#endif /* SIGPROF */
#endif /* SIGTSTP */
! ,0
};
extern int errno;
--- 36,98 ----
"PIPE",
"ALRM",
"TERM",
#ifdef SIGTSTP
! #if SIGTSTP == SIGTERM + 3
! "URG",
! "STOP",
"TSTP",
"CONT",
"CHLD",
"TTIN",
"TTOU",
! "IO",
"XCPU",
! "XFSZ",
#ifdef SIGPROF
! "VTALARM",
! "PROF",
#ifdef SIGWINCH
! "WINCH",
#ifdef SIGLOST
! "LOST",
#ifdef SIGUSR1
! "USR1",
#endif
#ifdef SIGUSR2
! "USR2",
#endif /* SIGUSR2 */
+ #endif /* SIGUSR1 */
#endif /* SIGLOST */
#endif /* SIGWINCH */
#endif /* SIGPROF */
+ #else /* SIGTSTP not in the normal place */
+ #if SIGCLD == SIGTERM + 3
+ "USR1",
+ "USR2",
+ "CLD",
+ "PWR",
+ "STOP", /* Masscomp maybe? */
+ "TSTP",
+ "CONT",
+ "TTIN",
+ "TTOU",
+ "TINT",
+ "XCPU",
+ "XFSZ",
+ "WINCH",
+ "URG",
+ "VTALRM",
+ "PROF",
+ "IO",
+ #endif /* SIGCLD in normal place
+ #endif /* SIGTSTP in the normal place */
+ #else /* no SIGTSTP */
+ "USR1",
+ "USR2",
+ "CLD",
+ "PWR", /* not sure about this */
#endif /* SIGTSTP */
! 0
};
extern int errno;
***************
*** 355,360 ****
--- 387,400 ----
for (sigv = sig_name+1; *sigv; sigv++)
if (strEQ(sig,*sigv))
return sigv - sig_name;
+ #ifdef SIGCLD
+ if (strEQ(sig,"CHLD"))
+ return SIGCLD;
+ #endif
+ #ifdef SIGCHLD
+ if (strEQ(sig,"CLD"))
+ return SIGCHLD;
+ #endif
return 0;
}
***************
*** 370,375 ****
--- 410,422 ----
stab = stabent(str_get(hfetch(sigstab->stab_hash,sig_name[sig])),TRUE);
sub = stab->stab_sub;
+ if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
+ if (sig_name[sig][1] == 'H')
+ stab = stabent(str_get(hfetch(sigstab->stab_hash,"CLD")),TRUE);
+ else
+ stab = stabent(str_get(hfetch(sigstab->stab_hash,"CHLD")),TRUE);
+ sub = stab->stab_sub; /* gag */
+ }
if (!sub) {
if (dowarn)
warn("SIG%s handler \"%s\" not defined.\n",
***************
*** 389,395 ****
}
filename = sub->filename;
! str = cmd_exec(sub->cmd); /* so do it already */
sub->depth--; /* assuming no longjumps out of here */
afree(defstab->stab_array); /* put back old $_[] */
--- 436,442 ----
}
filename = sub->filename;
! (void)cmd_exec(sub->cmd); /* so do it already */
sub->depth--; /* assuming no longjumps out of here */
afree(defstab->stab_array); /* put back old $_[] */
Index: toke.c
Prereq: 2.0.1.2
*** toke.c.old Tue Jul 12 17:39:06 1988
--- toke.c Tue Jul 12 17:39:09 1988
***************
*** 1,6 ****
! /* $Header: toke.c,v 2.0.1.2 88/07/11 23:11:41 root Exp $
*
* $Log: toke.c,v $
* Revision 2.0.1.2 88/07/11 23:11:41 root
* patch2: added tokens for new operators
*
--- 1,9 ----
! /* $Header: toke.c,v 2.0.1.3 88/07/12 17:37:19 root Exp $
*
* $Log: toke.c,v $
+ * Revision 2.0.1.3 88/07/12 17:37:19 root
+ * patch6: support for simplified yacc grammar
+ *
* Revision 2.0.1.2 88/07/11 23:11:41 root
* patch2: added tokens for new operators
*
***************
*** 30,35 ****
--- 33,42 ----
#define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
#define SFUN(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)STABFUN)
#define LFUN(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LVALFUN)
+ #define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
+ #define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
+ #define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
+ #define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
yylex()
{
***************
*** 67,75 ****
if (!rsfp)
RETURN(0);
if (in_format) {
! yylval.formval = load_format(); /* leaves . in buffer */
in_format = FALSE;
! s = str_get(linestr);
TERM(FORMLIST);
}
line++;
--- 74,82 ----
if (!rsfp)
RETURN(0);
if (in_format) {
! yylval.formval = load_format();
in_format = FALSE;
! s = str_get(linestr) + 1;
TERM(FORMLIST);
}
line++;
***************
*** 164,183 ****
break;
}
}
! /*FALL THROUGH*/
! case '*':
case '+':
! if (s[1] == *s) {
! tmp = *s++;
! if (*s++ == '+')
! RETURN(INC);
! else if (tmp == '-')
! RETURN(DEC);
! else
! OPERATOR(POW);
}
! /* FALL THROUGH */
case '%':
case '^':
case '~':
case '(':
--- 171,204 ----
break;
}
}
! tmp = *s++;
! if (*s == tmp) {
! s++;
! RETURN(DEC);
! }
! if (expectterm)
! OPERATOR('-');
! else
! AOP(O_SUBTRACT);
case '+':
! tmp = *s++;
! if (*s == tmp) {
! s++;
! RETURN(INC);
}
! AOP(O_ADD);
!
! case '*':
! tmp = *s++;
! if (*s == tmp) {
! s++;
! OPERATOR(POW);
! }
! MOP(O_MULTIPLY);
case '%':
+ s++;
+ MOP(O_MODULO);
+
case '^':
case '~':
case '(':
***************
*** 225,231 ****
s++;
tmp = *s++;
if (tmp == '=')
! OPERATOR(EQ);
if (tmp == '~')
OPERATOR(MATCH);
s--;
--- 246,252 ----
s++;
tmp = *s++;
if (tmp == '=')
! EOP(O_EQ);
if (tmp == '~')
OPERATOR(MATCH);
s--;
***************
*** 234,240 ****
s++;
tmp = *s++;
if (tmp == '=')
! OPERATOR(NE);
if (tmp == '~')
OPERATOR(NMATCH);
s--;
--- 255,261 ----
s++;
tmp = *s++;
if (tmp == '=')
! EOP(O_NE);
if (tmp == '~')
OPERATOR(NMATCH);
s--;
***************
*** 249,257 ****
if (tmp == '<')
OPERATOR(LS);
if (tmp == '=')
! OPERATOR(LE);
s--;
! OPERATOR('<');
case '>':
s++;
tmp = *s++;
--- 270,278 ----
if (tmp == '<')
OPERATOR(LS);
if (tmp == '=')
! ROP(O_LE);
s--;
! ROP(O_LT);
case '>':
s++;
tmp = *s++;
***************
*** 258,266 ****
if (tmp == '>')
OPERATOR(RS);
if (tmp == '=')
! OPERATOR(GE);
s--;
! OPERATOR('>');
#define SNARFWORD \
d = tokenbuf; \
--- 279,287 ----
if (tmp == '>')
OPERATOR(RS);
if (tmp == '=')
! ROP(O_GE);
s--;
! ROP(O_GT);
#define SNARFWORD \
d = tokenbuf; \
***************
*** 292,307 ****
TERM(PATTERN);
}
tmp = *s++;
OPERATOR(tmp);
case '.':
if (!expectterm || !isdigit(s[1])) {
- s++;
tmp = *s++;
! if (tmp == '.')
OPERATOR(DOTDOT);
! s--;
! OPERATOR('.');
}
/* FALL THROUGH */
case '0': case '1': case '2': case '3': case '4':
--- 313,330 ----
TERM(PATTERN);
}
tmp = *s++;
+ if (tmp == '/')
+ MOP(O_DIVIDE);
OPERATOR(tmp);
case '.':
if (!expectterm || !isdigit(s[1])) {
tmp = *s++;
! if (*s == tmp) {
! s++;
OPERATOR(DOTDOT);
! }
! AOP(O_CONCAT);
}
/* FALL THROUGH */
case '0': case '1': case '2': case '3': case '4':
***************
*** 367,373 ****
OPERATOR(ELSIF);
}
if (strEQ(d,"eq") || strEQ(d,"EQ"))
! OPERATOR(SEQ);
if (strEQ(d,"exit"))
UNI(O_EXIT);
if (strEQ(d,"eval")) {
--- 390,396 ----
OPERATOR(ELSIF);
}
if (strEQ(d,"eq") || strEQ(d,"EQ"))
! EOP(O_SEQ);
if (strEQ(d,"exit"))
UNI(O_EXIT);
if (strEQ(d,"eval")) {
***************
*** 403,411 ****
case 'g': case 'G':
SNARFWORD;
if (strEQ(d,"gt") || strEQ(d,"GT"))
! OPERATOR(SGT);
if (strEQ(d,"ge") || strEQ(d,"GE"))
! OPERATOR(SGE);
if (strEQ(d,"goto"))
LOOPX(O_GOTO);
if (strEQ(d,"gmtime"))
--- 426,434 ----
case 'g': case 'G':
SNARFWORD;
if (strEQ(d,"gt") || strEQ(d,"GT"))
! ROP(O_SGT);
if (strEQ(d,"ge") || strEQ(d,"GE"))
! ROP(O_SGE);
if (strEQ(d,"goto"))
LOOPX(O_GOTO);
if (strEQ(d,"gmtime"))
***************
*** 455,463 ****
if (strEQ(d,"length"))
FUN1(O_LENGTH);
if (strEQ(d,"lt") || strEQ(d,"LT"))
! OPERATOR(SLT);
if (strEQ(d,"le") || strEQ(d,"LE"))
! OPERATOR(SLE);
if (strEQ(d,"localtime"))
FUN1(O_LOCALTIME);
if (strEQ(d,"log"))
--- 478,486 ----
if (strEQ(d,"length"))
FUN1(O_LENGTH);
if (strEQ(d,"lt") || strEQ(d,"LT"))
! ROP(O_SLT);
if (strEQ(d,"le") || strEQ(d,"LE"))
! ROP(O_SLE);
if (strEQ(d,"localtime"))
FUN1(O_LOCALTIME);
if (strEQ(d,"log"))
***************
*** 479,485 ****
if (strEQ(d,"next"))
LOOPX(O_NEXT);
if (strEQ(d,"ne") || strEQ(d,"NE"))
! OPERATOR(SNE);
yylval.cval = savestr(d);
OPERATOR(WORD);
case 'o': case 'O':
--- 502,508 ----
if (strEQ(d,"next"))
LOOPX(O_NEXT);
if (strEQ(d,"ne") || strEQ(d,"NE"))
! EOP(O_SNE);
yylval.cval = savestr(d);
OPERATOR(WORD);
case 'o': case 'O':
***************
*** 637,643 ****
case 'x': case 'X':
SNARFWORD;
if (!expectterm && strEQ(d,"x"))
! OPERATOR('x');
yylval.cval = savestr(d);
OPERATOR(WORD);
case 'y': case 'Y':
--- 660,666 ----
case 'x': case 'X':
SNARFWORD;
if (!expectterm && strEQ(d,"x"))
! MOP(O_REPEAT);
yylval.cval = savestr(d);
OPERATOR(WORD);
case 'y': case 'Y':
More information about the Comp.sources.bugs
mailing list