Path: utzoo!attcan!uunet!lll-winken!lll-lcc!ames!elroy!devvax!lroot From: lroot@devvax.JPL.NASA.GOV (The Superuser) Newsgroups: comp.sources.bugs Subject: perl 2.0 patch #4 Summary: This is an official patch for perl 2.0. Please apply it. Message-ID: <2439@devvax.JPL.NASA.GOV> Date: 13 Jul 88 00:54:20 GMT Organization: Jet Propulsion Laboratory, Pasadena, CA Lines: 1406 System: perl version 2.0 Patch #: 4 Priority: MEDIUM Subject: patch2 continued Description: See patch 2. 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#define PATCHLEVEL 4 Index: x2p/Makefile.SH Prereq: 2.0 *** x2p/Makefile.SH.old Mon Jul 11 23:39:28 1988 --- x2p/Makefile.SH Mon Jul 11 23:39:29 1988 *************** *** 18,26 **** esac echo "Extracting x2p/Makefile (with variable substitutions)" cat >Makefile <Makefile < --- 179,215 ---- "EXP", "SQRT", "INT", ! "DO", ! "POW", ! "SUB", ! "GSUB", ! "MATCH", ! "USERFUN", ! "USERDEF", ! "CLOSE", ! "ATAN2", ! "SIN", ! "COS", ! "RAND", ! "SRAND", ! "DELETE", ! "SYSTEM", ! "COND", ! "RETURN", ! "87" }; #else extern char *opname[]; #endif + EXT int mop INIT(1); + + #define OPSMAX 50000 union { int ival; char *cval; ! } ops[OPSMAX]; /* hope they have 200k to spare */ #define DEBUGGING #include *************** *** 241,246 **** --- 279,285 ---- EXT bool do_chop INIT(FALSE); EXT bool need_entire INIT(FALSE); EXT bool absmaxfld INIT(FALSE); + EXT bool saw_altinput INIT(FALSE); EXT char const_FS INIT(0); EXT char *namelist INIT(Nullch); Index: x2p/a2p.man Prereq: 2.0 *** x2p/a2p.man.old Mon Jul 11 23:39:41 1988 --- x2p/a2p.man Mon Jul 11 23:39:42 1988 *************** *** 1,7 **** .rn '' }` ! ''' $Header: a2p.man,v 2.0 88/06/05 00:15:36 root Exp $ ''' ''' $Log: a2p.man,v $ ''' Revision 2.0 88/06/05 00:15:36 root ''' Baseline version 2.0. ''' --- 1,10 ---- .rn '' }` ! ''' $Header: a2p.man,v 2.0.1.1 88/07/11 23:16:25 root Exp $ ''' ''' $Log: a2p.man,v $ + ''' Revision 2.0.1.1 88/07/11 23:16:25 root + ''' patch2: changes related to 1985 awk + ''' ''' Revision 2.0 88/06/05 00:15:36 root ''' Baseline version 2.0. ''' *************** *** 116,121 **** --- 119,129 ---- If somehow you are relying on this mechanism to create null entries for a subsequent for...in, they won't be there in perl. .PP + The construct \*(L"a in b\*(R" is translated to a simple evaluation of + the variable, on the assumption that the value will be non-null. + All such spots are marked with the comment \*(L"#???\*(R". + You may need to modify the algorithm to ensure that the value isn't null. + .PP If a2p makes a split line that assigns to a list of variables that looks like (Fld1, Fld2, Fld3...) you may want to rerun a2p using the \-n option mentioned above. *************** *** 133,153 **** Awk arrays are usually translated to associative arrays, but if you happen to know that the index is always going to be numeric you could change the {...} to [...]. ! Iteration over an associative array is done with each(), but iteration over a numeric array is NOT. ! You need a for loop, or while loop with a pop() or shift(), so you might ! need to modify any loop that is iterating over the array in question. .PP - Arrays which have been split into are assumed to be numerically indexed. - The usual perl idiom for iterating over such arrays is to use pop() or shift() - and assign the resulting value to a variable inside the conditional of the - while loop. - This is destructive to the array, however, so a2p can't assume this is - reasonable. - A2p will write a standard for loop with a scratch variable. - You may wish to change it to a pop() loop for more efficiency, presuming - you don't want to keep the array around. - .PP Awk starts by assuming OFMT has the value %.6g. Perl starts by assuming its equivalent, $#, to have the value %.20g. You'll want to set $# explicitly if you use the default value of OFMT. --- 141,150 ---- Awk arrays are usually translated to associative arrays, but if you happen to know that the index is always going to be numeric you could change the {...} to [...]. ! Iteration over an associative array is done using the keys() function, but iteration over a numeric array is NOT. ! You might need to modify any loop that is iterating over the array in question. .PP Awk starts by assuming OFMT has the value %.6g. Perl starts by assuming its equivalent, $#, to have the value %.20g. You'll want to set $# explicitly if you use the default value of OFMT. *************** *** 163,170 **** to the default of 0, but remember to change all array subscripts AND all substr() and index() operations to match. .PP ! Cute comments that say "# Here is a workaround because awk is dumb" are not ! translated. .PP Awk scripts are often embedded in a shell script that pipes stuff into and out of awk. --- 160,167 ---- to the default of 0, but remember to change all array subscripts AND all substr() and index() operations to match. .PP ! Cute comments that say "# Here is a workaround because awk is dumb" are passed ! through unmodified. .PP Awk scripts are often embedded in a shell script that pipes stuff into and out of awk. *************** *** 171,180 **** Often the shell script wrapper can be incorporated into the perl script, since perl can start up pipes into and out of itself, and can do other things that awk can't do by itself. .SH ENVIRONMENT A2p uses no environment variables. .SH AUTHOR ! Larry Wall .SH FILES .SH SEE ALSO perl The perl compiler/interpreter --- 168,200 ---- Often the shell script wrapper can be incorporated into the perl script, since perl can start up pipes into and out of itself, and can do other things that awk can't do by itself. + .PP + Scripts that refer to the special variables RSTART and RLENGTH can often + be simplified by referring to the variables $`, $& and $', as long as they + are within the scope of the pattern match that sets them. + .PP + There is no translation currently for arrays passed by reference to functions. + Such array references are marked with the comment \*(L"#???\*(R". + You'll have to translate it to something fancy using eval, or just + refer to the global array name. + .PP + The produced perl script may have subroutines defined to deal with awk's + semantics regarding getline and print. + Since I usually pick correctness over efficiency. + it is almost always possible to rewrite such code to be more efficient by + discarding the semantic sugar. + .PP + For efficiency, you may wish to remove the keyword from any return statement + that is the last statement executed in a subroutine. + A2p catches the most common case, but doesn't analyze embedded blocks for + subtler cases. + .PP + ARGV[0] translates to $ARGV0, but ARGV[n] translates to $ARGV[$n]. + A loop that tries to iterate over ARGV[0] won't find it. .SH ENVIRONMENT A2p uses no environment variables. .SH AUTHOR ! Larry Wall .SH FILES .SH SEE ALSO perl The perl compiler/interpreter Index: x2p/a2p.y Prereq: 2.0 *** x2p/a2p.y.old Mon Jul 11 23:39:47 1988 --- x2p/a2p.y Mon Jul 11 23:39:48 1988 *************** *** 1,7 **** %{ ! /* $Header: a2p.y,v 2.0 88/06/05 00:15:38 root Exp $ * * $Log: a2p.y,v $ * Revision 2.0 88/06/05 00:15:38 root * Baseline version 2.0. * --- 1,10 ---- %{ ! /* $Header: a2p.y,v 2.0.1.1 88/07/11 23:20:14 root Exp $ * * $Log: a2p.y,v $ + * Revision 2.0.1.1 88/07/11 23:20:14 root + * patch2: changes to support translation of 1985 awk + * * Revision 2.0 88/06/05 00:15:38 root * Baseline version 2.0. * *************** *** 11,59 **** #include "a2p.h" int root; %} %token BEGIN END %token REGEX %token SEMINEW NEWLINE COMMENT ! %token FUN1 GRGR %token PRINT PRINTF SPRINTF SPLIT %token IF ELSE WHILE FOR IN ! %token EXIT NEXT BREAK CONTINUE %right ASGNOP %left OROR %left ANDAND ! %left NOT %left NUMBER VAR SUBSTR INDEX ! %left GETLINE ! %nonassoc RELOP MATCHOP %left OR %left STRING %left '+' '-' %left '*' '/' '%' %right UMINUS %left INCR DECR %left FIELD VFIELD %% ! program : junk begin hunks end ! { root = oper4(OPROG,$1,$2,$3,$4); } ; begin : BEGIN '{' maybe states '}' junk ! { $$ = oper3(OJUNK,$3,$4,$6); in_begin = FALSE; } ! | /* NULL */ ! { $$ = Nullop; } ; end : END '{' maybe states '}' ! { $$ = oper2(OJUNK,$3,$4); } | end NEWLINE { $$ = $1; } - | /* NULL */ - { $$ = Nullop; } ; hunks : hunks hunk junk --- 14,66 ---- #include "a2p.h" int root; + int begins = Nullop; + int ends = Nullop; %} %token BEGIN END %token REGEX %token SEMINEW NEWLINE COMMENT ! %token FUN1 FUNN GRGR %token PRINT PRINTF SPRINTF SPLIT %token IF ELSE WHILE FOR IN ! %token EXIT NEXT BREAK CONTINUE RET ! %token GETLINE DO SUB GSUB MATCH ! %token FUNCTION USERFUN DELETE %right ASGNOP + %right '?' ':' %left OROR %left ANDAND ! %left IN %left NUMBER VAR SUBSTR INDEX ! %left MATCHOP ! %left RELOP '<' '>' %left OR %left STRING %left '+' '-' %left '*' '/' '%' %right UMINUS + %left NOT + %right '^' %left INCR DECR %left FIELD VFIELD %% ! program : junk hunks ! { root = oper4(OPROG,$1,begins,$2,ends); } ; begin : BEGIN '{' maybe states '}' junk ! { begins = oper4(OJUNK,begins,$3,$4,$6); in_begin = FALSE; ! $$ = Nullop; } ; end : END '{' maybe states '}' ! { ends = oper3(OJUNK,ends,$3,$4); $$ = Nullop; } | end NEWLINE { $$ = $1; } ; hunks : hunks hunk junk *************** *** 66,73 **** --- 73,84 ---- { $$ = oper1(OHUNK,$1); need_entire = TRUE; } | patpat '{' maybe states '}' { $$ = oper2(OHUNK,$1,oper2(OJUNK,$3,$4)); } + | FUNCTION USERFUN '(' expr_list ')' maybe '{' maybe states '}' + { $$ = oper5(OUSERDEF,$2,$4,$6,$8,$9); } | '{' maybe states '}' { $$ = oper2(OHUNK,Nullop,oper2(OJUNK,$2,$3)); } + | begin + | end ; patpat : pat *************** *** 113,123 **** rel : expr RELOP expr { $$ = oper3(ORELOP,$2,$1,$3); } | '(' rel ')' { $$ = oper1(ORPAREN,$2); } ; ! match : expr MATCHOP REGEX { $$ = oper3(OMATCHOP,$2,$1,oper1(OREGEX,$3)); } | '(' match ')' { $$ = oper1(OMPAREN,$2); } --- 124,140 ---- rel : expr RELOP expr { $$ = oper3(ORELOP,$2,$1,$3); } + | expr '>' expr + { $$ = oper3(ORELOP,string(">",1),$1,$3); } + | expr '<' expr + { $$ = oper3(ORELOP,string("<",1),$1,$3); } | '(' rel ')' { $$ = oper1(ORPAREN,$2); } ; ! match : expr MATCHOP expr ! { $$ = oper3(OMATCHOP,$2,$1,$3); } ! | expr MATCHOP REGEX { $$ = oper3(OMATCHOP,$2,$1,oper1(OREGEX,$3)); } | '(' match ')' { $$ = oper1(OMPAREN,$2); } *************** *** 141,147 **** | term '+' term { $$ = oper2(OADD,$1,$3); } | term '-' term ! { $$ = oper2(OSUB,$1,$3); } | term '*' term { $$ = oper2(OMULT,$1,$3); } | term '/' term --- 158,164 ---- | term '+' term { $$ = oper2(OADD,$1,$3); } | term '-' term ! { $$ = oper2(OSUBTRACT,$1,$3); } | term '*' term { $$ = oper2(OMULT,$1,$3); } | term '/' term *************** *** 148,153 **** --- 165,176 ---- { $$ = oper2(ODIV,$1,$3); } | term '%' term { $$ = oper2(OMOD,$1,$3); } + | term '^' term + { $$ = oper2(OPOW,$1,$3); } + | term IN VAR /* not strictly correct */ + { $$ = oper2(OJUNK,oper2(OVAR,$3,$1),string("\177ne ''",0)); } + | term '?' term ':' term + { $$ = oper2(OCOND,$1,$3,$5); } | variable INCR { $$ = oper1(OPOSTINCR,$1); } | variable DECR *************** *** 164,169 **** --- 187,206 ---- { $$ = oper1(OPAREN,$2); } | GETLINE { $$ = oper0(OGETLINE); } + | GETLINE VAR + { $$ = oper1(OGETLINE,$2); } + | GETLINE '<' expr + { $$ = oper3(OGETLINE,Nullop,string("<",1),$3); + if (ops[$3].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } + | GETLINE VAR '<' expr + { $$ = oper3(OGETLINE,$2,string("<",1),$4); + if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } + | term 'p' GETLINE + { $$ = oper3(OGETLINE,Nullop,string("|",1),$1); + if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } + | term 'p' GETLINE VAR + { $$ = oper3(OGETLINE,$4,string("|",1),$1); + if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } | FUN1 { $$ = oper0($1); need_entire = do_chop = TRUE; } | FUN1 '(' ')' *************** *** 170,176 **** { $$ = oper1($1,Nullop); need_entire = do_chop = TRUE; } | FUN1 '(' expr ')' { $$ = oper1($1,$3); } ! | SPRINTF print_list { $$ = oper1(OSPRINTF,$2); } | SUBSTR '(' expr ',' expr ',' expr ')' { $$ = oper3(OSUBSTR,$3,$5,$7); } --- 207,217 ---- { $$ = oper1($1,Nullop); need_entire = do_chop = TRUE; } | FUN1 '(' expr ')' { $$ = oper1($1,$3); } ! | FUNN '(' expr_list ')' ! { $$ = oper1($1,$3); } ! | USERFUN '(' expr_list ')' ! { $$ = oper2(OUSERFUN,$1,$3); } ! | SPRINTF expr_list { $$ = oper1(OSPRINTF,$2); } | SUBSTR '(' expr ',' expr ',' expr ')' { $$ = oper3(OSUBSTR,$3,$5,$7); } *************** *** 182,187 **** --- 223,248 ---- { $$ = oper2(OSPLIT,$3,numary($5)); } | INDEX '(' expr ',' expr ')' { $$ = oper2(OINDEX,$3,$5); } + | MATCH '(' expr ',' REGEX ')' + { $$ = oper2(OMATCH,$3,oper1(OREGEX,$5)); } + | MATCH '(' expr ',' expr ')' + { $$ = oper2(OMATCH,$3,$5); } + | SUB '(' expr ',' expr ')' + { $$ = oper2(OSUB,$3,$5); } + | SUB '(' REGEX ',' expr ')' + { $$ = oper2(OSUB,oper1(OREGEX,$3),$5); } + | GSUB '(' expr ',' expr ')' + { $$ = oper2(OGSUB,$3,$5); } + | GSUB '(' REGEX ',' expr ')' + { $$ = oper2(OGSUB,oper1(OREGEX,$3),$5); } + | SUB '(' expr ',' expr ',' expr ')' + { $$ = oper3(OSUB,$3,$5,$7); } + | SUB '(' REGEX ',' expr ',' expr ')' + { $$ = oper3(OSUB,oper1(OREGEX,$3),$5,$7); } + | GSUB '(' expr ',' expr ',' expr ')' + { $$ = oper3(OGSUB,$3,$5,$7); } + | GSUB '(' REGEX ',' expr ',' expr ')' + { $$ = oper3(OGSUB,oper1(OREGEX,$3),$5,$7); } ; variable: NUMBER *************** *** 190,196 **** { $$ = oper1(OSTR,$1); } | VAR { $$ = oper1(OVAR,$1); } ! | VAR '[' expr ']' { $$ = oper2(OVAR,$1,$3); } | FIELD { $$ = oper1(OFLD,$1); } --- 251,257 ---- { $$ = oper1(OSTR,$1); } | VAR { $$ = oper1(OVAR,$1); } ! | VAR '[' expr_list ']' { $$ = oper2(OVAR,$1,$3); } | FIELD { $$ = oper1(OFLD,$1); } *************** *** 198,204 **** { $$ = oper1(OVFLD,$2); } ; ! print_list : expr | clist | /* NULL */ --- 259,265 ---- { $$ = oper1(OVFLD,$2); } ; ! expr_list : expr | clist | /* NULL */ *************** *** 275,297 **** simple : expr ! | PRINT print_list redir expr { $$ = oper3(OPRINT,$2,$3,$4); do_opens = TRUE; saw_ORS = saw_OFS = TRUE; if (!$2) need_entire = TRUE; if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } ! | PRINT print_list { $$ = oper1(OPRINT,$2); if (!$2) need_entire = TRUE; saw_ORS = saw_OFS = TRUE; } ! | PRINTF print_list redir expr { $$ = oper3(OPRINTF,$2,$3,$4); do_opens = TRUE; if (!$2) need_entire = TRUE; if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } ! | PRINTF print_list { $$ = oper1(OPRINTF,$2); if (!$2) need_entire = TRUE; } --- 336,358 ---- simple : expr ! | PRINT expr_list redir expr { $$ = oper3(OPRINT,$2,$3,$4); do_opens = TRUE; saw_ORS = saw_OFS = TRUE; if (!$2) need_entire = TRUE; if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } ! | PRINT expr_list { $$ = oper1(OPRINT,$2); if (!$2) need_entire = TRUE; saw_ORS = saw_OFS = TRUE; } ! | PRINTF expr_list redir expr { $$ = oper3(OPRINTF,$2,$3,$4); do_opens = TRUE; if (!$2) need_entire = TRUE; if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } ! | PRINTF expr_list { $$ = oper1(OPRINTF,$2); if (!$2) need_entire = TRUE; } *************** *** 305,314 **** { $$ = oper1(OEXIT,$2); } | CONTINUE { $$ = oper0(OCONTINUE); } ; ! redir : RELOP ! { $$ = oper1(OREDIR,string(">",1)); } | GRGR { $$ = oper1(OREDIR,string(">>",2)); } | '|' --- 366,381 ---- { $$ = oper1(OEXIT,$2); } | CONTINUE { $$ = oper0(OCONTINUE); } + | RET + { $$ = oper0(ORETURN); } + | RET expr + { $$ = oper1(ORETURN,$2); } + | DELETE VAR '[' expr ']' + { $$ = oper3(ODELETE,$2,$4); } ; ! redir : '>' %prec FIELD ! { $$ = oper1(OREDIR,$1); } | GRGR { $$ = oper1(OREDIR,string(">>",2)); } | '|' *************** *** 322,333 **** { $$ = oper3(OIF,$3,bl($6,$5),bl($9,$8)); } | WHILE '(' cond ')' maybe statement { $$ = oper2(OWHILE,$3,bl($6,$5)); } | FOR '(' simpnull ';' cond ';' simpnull ')' maybe statement { $$ = oper4(OFOR,$3,$5,$7,bl($10,$9)); } | FOR '(' simpnull ';' ';' simpnull ')' maybe statement { $$ = oper4(OFOR,$3,string("",0),$6,bl($9,$8)); } ! | FOR '(' VAR IN VAR ')' maybe statement ! { $$ = oper3(OFORIN,$3,$5,bl($8,$7)); } | '{' maybe states '}' maybe { $$ = oper3(OBLOCK,oper2(OJUNK,$2,$3),Nullop,$5); } ; --- 389,402 ---- { $$ = oper3(OIF,$3,bl($6,$5),bl($9,$8)); } | WHILE '(' cond ')' maybe statement { $$ = oper2(OWHILE,$3,bl($6,$5)); } + | DO maybe statement WHILE '(' cond ')' + { $$ = oper2(ODO,bl($3,$2),$6); } | FOR '(' simpnull ';' cond ';' simpnull ')' maybe statement { $$ = oper4(OFOR,$3,$5,$7,bl($10,$9)); } | FOR '(' simpnull ';' ';' simpnull ')' maybe statement { $$ = oper4(OFOR,$3,string("",0),$6,bl($9,$8)); } ! | FOR '(' expr ')' maybe statement ! { $$ = oper2(OFORIN,$3,bl($6,$5)); } | '{' maybe states '}' maybe { $$ = oper3(OBLOCK,oper2(OJUNK,$2,$3),Nullop,$5); } ; Index: x2p/a2py.c Prereq: 2.0 *** x2p/a2py.c.old Mon Jul 11 23:39:53 1988 --- x2p/a2py.c Mon Jul 11 23:39:55 1988 *************** *** 1,6 **** ! /* $Header: a2py.c,v 2.0 88/06/05 00:15:41 root Exp $ * * $Log: a2py.c,v $ * Revision 2.0 88/06/05 00:15:41 root * Baseline version 2.0. * --- 1,11 ---- ! /* $Header: a2py.c,v 2.0.1.1 88/07/11 23:25:33 root Exp $ * * $Log: a2py.c,v $ + * Revision 2.0.1.1 88/07/11 23:25:33 root + * patch2: changes to support translation of 1985 awk + * patch2: now fixes any perl reserved words it finds + * patch2: now checks for overflow of ops storage area + * * Revision 2.0 88/06/05 00:15:41 root * Baseline version 2.0. * *************** *** 148,155 **** #define RETURN(retval) return (bufptr = s,retval) #define XTERM(retval) return (expectterm = TRUE,bufptr = s,retval) #define XOP(retval) return (expectterm = FALSE,bufptr = s,retval) ! #define ID(x) return (yylval=string(x,0),expectterm = FALSE,bufptr = s,VAR) yylex() { register char *s = bufptr; --- 153,162 ---- #define RETURN(retval) return (bufptr = s,retval) #define XTERM(retval) return (expectterm = TRUE,bufptr = s,retval) #define XOP(retval) return (expectterm = FALSE,bufptr = s,retval) ! #define ID(x) return (yylval=string(x,0),expectterm = FALSE,bufptr = s,idtype) + int idtype; + yylex() { register char *s = bufptr; *************** *** 203,212 **** --- 210,223 ---- } XTERM(tmp); case '(': + tmp = *s++; + XTERM(tmp); case '{': case '[': case ')': case ']': + case '?': + case ':': tmp = *s++; XOP(tmp); case 127: *************** *** 237,245 **** /* FALL THROUGH */ case '*': case '%': tmp = *s++; if (*s == '=') { ! yylval = string(s-1,2); s++; XTERM(ASGNOP); } --- 248,260 ---- /* FALL THROUGH */ case '*': case '%': + case '^': tmp = *s++; if (*s == '=') { ! if (tmp == '^') ! yylval = string("**=",3); ! else ! yylval = string(s-1,2); s++; XTERM(ASGNOP); } *************** *** 257,263 **** if (tmp == '|') XTERM(OROR); s--; ! XTERM('|'); case '=': s++; tmp = *s++; --- 272,283 ---- if (tmp == '|') XTERM(OROR); s--; ! while (*s == ' ' || *s == '\t') ! s++; ! if (strnEQ(s,"getline",7)) ! XTERM('p'); ! else ! XTERM('|'); case '=': s++; tmp = *s++; *************** *** 289,296 **** XTERM(RELOP); } s--; ! yylval = string("<",1); ! XTERM(RELOP); case '>': s++; tmp = *s++; --- 309,315 ---- XTERM(RELOP); } s--; ! XTERM('<'); case '>': s++; tmp = *s++; *************** *** 303,310 **** XTERM(RELOP); } s--; ! yylval = string(">",1); ! XTERM(RELOP); #define SNARFWORD \ d = tokenbuf; \ --- 322,328 ---- XTERM(RELOP); } s--; ! XTERM('>'); #define SNARFWORD \ d = tokenbuf; \ *************** *** 311,317 **** while (isalpha(*s) || isdigit(*s) || *s == '_') \ *d++ = *s++; \ *d = '\0'; \ ! d = tokenbuf; case '$': s++; --- 329,339 ---- while (isalpha(*s) || isdigit(*s) || *s == '_') \ *d++ = *s++; \ *d = '\0'; \ ! d = tokenbuf; \ ! if (*s == '(') \ ! idtype = USERFUN; \ ! else \ ! idtype = VAR; case '$': s++; *************** *** 319,324 **** --- 341,347 ---- s++; do_chop = TRUE; need_entire = TRUE; + idtype = VAR; ID("0"); } do_split = TRUE; *************** *** 361,366 **** --- 384,399 ---- case 'a': case 'A': SNARFWORD; + if (strEQ(d,"ARGC")) + set_array_base = TRUE; + if (strEQ(d,"ARGV")) { + yylval=numary(string("ARGV",0)); + XOP(VAR); + } + if (strEQ(d,"atan2")) { + yylval = OATAN2; + XTERM(FUNN); + } ID(d); case 'b': case 'B': SNARFWORD; *************** *** 373,381 **** --- 406,439 ---- SNARFWORD; if (strEQ(d,"continue")) XTERM(CONTINUE); + if (strEQ(d,"cos")) { + yylval = OCOS; + XTERM(FUN1); + } + if (strEQ(d,"close")) { + do_fancy_opens = 1; + yylval = OCLOSE; + XTERM(FUN1); + } + if (strEQ(d,"chdir")) + *d = toupper(*d); + else if (strEQ(d,"crypt")) + *d = toupper(*d); + else if (strEQ(d,"chop")) + *d = toupper(*d); + else if (strEQ(d,"chmod")) + *d = toupper(*d); + else if (strEQ(d,"chown")) + *d = toupper(*d); ID(d); case 'd': case 'D': SNARFWORD; + if (strEQ(d,"do")) + XTERM(DO); + if (strEQ(d,"delete")) + XTERM(DELETE); + if (strEQ(d,"die")) + *d = toupper(*d); ID(d); case 'e': case 'E': SNARFWORD; *************** *** 391,396 **** --- 449,466 ---- yylval = OEXP; XTERM(FUN1); } + if (strEQ(d,"elsif")) + *d = toupper(*d); + else if (strEQ(d,"eq")) + *d = toupper(*d); + else if (strEQ(d,"eval")) + *d = toupper(*d); + else if (strEQ(d,"eof")) + *d = toupper(*d); + else if (strEQ(d,"each")) + *d = toupper(*d); + else if (strEQ(d,"exec")) + *d = toupper(*d); ID(d); case 'f': case 'F': SNARFWORD; *************** *** 406,423 **** } ID(tokenbuf); } - if (strEQ(d,"FILENAME")) - d = "ARGV"; if (strEQ(d,"for")) XTERM(FOR); ID(d); case 'g': case 'G': SNARFWORD; if (strEQ(d,"getline")) XTERM(GETLINE); ID(d); case 'h': case 'H': SNARFWORD; ID(d); case 'i': case 'I': SNARFWORD; --- 476,513 ---- } ID(tokenbuf); } if (strEQ(d,"for")) XTERM(FOR); + else if (strEQ(d,"function")) + XTERM(FUNCTION); + if (strEQ(d,"FILENAME")) + d = "ARGV"; + if (strEQ(d,"foreach")) + *d = toupper(*d); + else if (strEQ(d,"format")) + *d = toupper(*d); + else if (strEQ(d,"fork")) + *d = toupper(*d); ID(d); case 'g': case 'G': SNARFWORD; if (strEQ(d,"getline")) XTERM(GETLINE); + if (strEQ(d,"gsub")) + XTERM(GSUB); + if (strEQ(d,"ge")) + *d = toupper(*d); + else if (strEQ(d,"gt")) + *d = toupper(*d); + else if (strEQ(d,"goto")) + *d = toupper(*d); + else if (strEQ(d,"gmtime")) + *d = toupper(*d); ID(d); case 'h': case 'H': SNARFWORD; + if (strEQ(d,"hex")) + *d = toupper(*d); ID(d); case 'i': case 'I': SNARFWORD; *************** *** 436,444 **** --- 526,540 ---- ID(d); case 'j': case 'J': SNARFWORD; + if (strEQ(d,"join")) + *d = toupper(*d); ID(d); case 'k': case 'K': SNARFWORD; + if (strEQ(d,"keys")) + *d = toupper(*d); + else if (strEQ(d,"kill")) + *d = toupper(*d); ID(d); case 'l': case 'L': SNARFWORD; *************** *** 450,458 **** --- 546,572 ---- yylval = OLOG; XTERM(FUN1); } + if (strEQ(d,"last")) + *d = toupper(*d); + else if (strEQ(d,"local")) + *d = toupper(*d); + else if (strEQ(d,"lt")) + *d = toupper(*d); + else if (strEQ(d,"le")) + *d = toupper(*d); + else if (strEQ(d,"locatime")) + *d = toupper(*d); + else if (strEQ(d,"link")) + *d = toupper(*d); ID(d); case 'm': case 'M': SNARFWORD; + if (strEQ(d,"match")) { + set_array_base = TRUE; + XTERM(MATCH); + } + if (strEQ(d,"m")) + *d = toupper(*d); ID(d); case 'n': case 'N': SNARFWORD; *************** *** 462,467 **** --- 576,583 ---- saw_line_op = TRUE; XTERM(NEXT); } + if (strEQ(d,"ne")) + *d = toupper(*d); ID(d); case 'o': case 'O': SNARFWORD; *************** *** 476,481 **** --- 592,603 ---- if (strEQ(d,"OFMT")) { d = "$#"; } + if (strEQ(d,"open")) + *d = toupper(*d); + else if (strEQ(d,"ord")) + *d = toupper(*d); + else if (strEQ(d,"oct")) + *d = toupper(*d); ID(d); case 'p': case 'P': SNARFWORD; *************** *** 485,490 **** --- 607,616 ---- if (strEQ(d,"printf")) { XTERM(PRINTF); } + if (strEQ(d,"push")) + *d = toupper(*d); + else if (strEQ(d,"pop")) + *d = toupper(*d); ID(d); case 'q': case 'Q': SNARFWORD; *************** *** 495,500 **** --- 621,638 ---- d = "$/"; saw_RS = TRUE; } + if (strEQ(d,"rand")) { + yylval = ORAND; + XTERM(FUN1); + } + if (strEQ(d,"return")) + XTERM(RET); + if (strEQ(d,"reset")) + *d = toupper(*d); + else if (strEQ(d,"redo")) + *d = toupper(*d); + else if (strEQ(d,"rename")) + *d = toupper(*d); ID(d); case 's': case 'S': SNARFWORD; *************** *** 506,511 **** --- 644,651 ---- set_array_base = TRUE; XTERM(SUBSTR); } + if (strEQ(d,"sub")) + XTERM(SUB); if (strEQ(d,"sprintf")) XTERM(SPRINTF); if (strEQ(d,"sqrt")) { *************** *** 512,537 **** --- 652,740 ---- yylval = OSQRT; XTERM(FUN1); } + if (strEQ(d,"SUBSEP")) { + d = "$;"; + } + if (strEQ(d,"sin")) { + yylval = OSIN; + XTERM(FUN1); + } + if (strEQ(d,"srand")) { + yylval = OSRAND; + XTERM(FUN1); + } + if (strEQ(d,"system")) { + yylval = OSYSTEM; + XTERM(FUN1); + } + if (strEQ(d,"s")) + *d = toupper(*d); + else if (strEQ(d,"shift")) + *d = toupper(*d); + else if (strEQ(d,"select")) + *d = toupper(*d); + else if (strEQ(d,"seek")) + *d = toupper(*d); + else if (strEQ(d,"stat")) + *d = toupper(*d); + else if (strEQ(d,"study")) + *d = toupper(*d); + else if (strEQ(d,"sleep")) + *d = toupper(*d); + else if (strEQ(d,"symlink")) + *d = toupper(*d); + else if (strEQ(d,"sort")) + *d = toupper(*d); ID(d); case 't': case 'T': SNARFWORD; + if (strEQ(d,"tr")) + *d = toupper(*d); + else if (strEQ(d,"tell")) + *d = toupper(*d); + else if (strEQ(d,"time")) + *d = toupper(*d); + else if (strEQ(d,"times")) + *d = toupper(*d); ID(d); case 'u': case 'U': SNARFWORD; + if (strEQ(d,"until")) + *d = toupper(*d); + else if (strEQ(d,"unless")) + *d = toupper(*d); + else if (strEQ(d,"umask")) + *d = toupper(*d); + else if (strEQ(d,"unshift")) + *d = toupper(*d); + else if (strEQ(d,"unlink")) + *d = toupper(*d); + else if (strEQ(d,"utime")) + *d = toupper(*d); ID(d); case 'v': case 'V': SNARFWORD; + if (strEQ(d,"values")) + *d = toupper(*d); ID(d); case 'w': case 'W': SNARFWORD; if (strEQ(d,"while")) XTERM(WHILE); + if (strEQ(d,"write")) + *d = toupper(*d); + else if (strEQ(d,"wait")) + *d = toupper(*d); ID(d); case 'x': case 'X': SNARFWORD; + if (strEQ(d,"x")) + *d = toupper(*d); ID(d); case 'y': case 'Y': SNARFWORD; + if (strEQ(d,"y")) + *d = toupper(*d); ID(d); case 'z': case 'Z': SNARFWORD; *************** *** 634,639 **** --- 837,844 ---- ops[mop].cval = safemalloc(len+1); strncpy(ops[mop].cval,ptr,len); ops[mop++].cval[len] = '\0'; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } *************** *** 645,650 **** --- 850,857 ---- if (type > 255) fatal("type > 255 (%d)\n",type); ops[mop++].ival = type; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } *************** *** 658,663 **** --- 865,872 ---- fatal("type > 255 (%d)\n",type); ops[mop++].ival = type + (1<<8); ops[mop++].ival = arg1; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } *************** *** 673,678 **** --- 882,889 ---- ops[mop++].ival = type + (2<<8); ops[mop++].ival = arg1; ops[mop++].ival = arg2; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } *************** *** 690,695 **** --- 901,908 ---- ops[mop++].ival = arg1; ops[mop++].ival = arg2; ops[mop++].ival = arg3; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } *************** *** 709,714 **** --- 922,929 ---- ops[mop++].ival = arg2; ops[mop++].ival = arg3; ops[mop++].ival = arg4; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } *************** *** 730,735 **** --- 945,952 ---- ops[mop++].ival = arg3; ops[mop++].ival = arg4; ops[mop++].ival = arg5; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; }