lroot@devvax.JPL.NASA.GOV (The Superuser) (07/13/88)
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 <thisarticle". If you don't have the patch program, apply the following by hand, or get patch (version 2.0, latest patchlevel). After patching: DO NOTHING--apply patch 5 next 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@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: 3 1c1 < #define PATCHLEVEL 3 --- > #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 <<!GROK!THIS! ! # $Header: Makefile.SH,v 2.0 88/06/05 00:15:31 root Exp $ # # $Log: Makefile.SH,v $ # Revision 2.0 88/06/05 00:15:31 root # Baseline version 2.0. # --- 18,29 ---- esac echo "Extracting x2p/Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! ! # $Header: Makefile.SH,v 2.0.1.1 88/07/11 23:13:39 root Exp $ # # $Log: Makefile.SH,v $ + # Revision 2.0.1.1 88/07/11 23:13:39 root + # patch2: now expects more shift/reduce errors + # # Revision 2.0 88/06/05 00:15:31 root # Baseline version 2.0. # *************** *** 76,82 **** $(CC) $(LDFLAGS) $(LARGE) $(obj) a2p.o $(libs) -o a2p a2p.c: a2p.y ! @ echo Expect 103 shift/reduce errors... yacc a2p.y mv y.tab.c a2p.c --- 79,85 ---- $(CC) $(LDFLAGS) $(LARGE) $(obj) a2p.o $(libs) -o a2p a2p.c: a2p.y ! @ echo Expect 208 shift/reduce errors... yacc a2p.y mv y.tab.c a2p.c Index: x2p/a2p.h Prereq: 2.0 *** x2p/a2p.h.old Mon Jul 11 23:39:36 1988 --- x2p/a2p.h Mon Jul 11 23:39:37 1988 *************** *** 1,6 **** ! /* $Header: a2p.h,v 2.0 88/06/05 00:15:33 root Exp $ * * $Log: a2p.h,v $ * Revision 2.0 88/06/05 00:15:33 root * Baseline version 2.0. * --- 1,9 ---- ! /* $Header: a2p.h,v 2.0.1.1 88/07/11 23:14:35 root Exp $ * * $Log: a2p.h,v $ + * Revision 2.0.1.1 88/07/11 23:14:35 root + * patch2: added tokens from 1985 awk + * * Revision 2.0 88/06/05 00:15:33 root * Baseline version 2.0. * *************** *** 38,44 **** #define OCONCAT 19 #define OASSIGN 20 #define OADD 21 ! #define OSUB 22 #define OMULT 23 #define ODIV 24 #define OMOD 25 --- 41,47 ---- #define OCONCAT 19 #define OASSIGN 20 #define OADD 21 ! #define OSUBTRACT 22 #define OMULT 23 #define ODIV 24 #define OMOD 25 *************** *** 86,91 **** --- 89,111 ---- #define OEXP 67 #define OSQRT 68 #define OINT 69 + #define ODO 70 + #define OPOW 71 + #define OSUB 72 + #define OGSUB 73 + #define OMATCH 74 + #define OUSERFUN 75 + #define OUSERDEF 76 + #define OCLOSE 77 + #define OATAN2 78 + #define OSIN 79 + #define OCOS 80 + #define ORAND 81 + #define OSRAND 82 + #define ODELETE 83 + #define OSYSTEM 84 + #define OCOND 85 + #define ORETURN 86 #ifdef DOINIT char *opname[] = { *************** *** 111,117 **** "CONCAT", "ASSIGN", "ADD", ! "SUB", "MULT", "DIV", "MOD", --- 131,137 ---- "CONCAT", "ASSIGN", "ADD", ! "SUBTRACT", "MULT", "DIV", "MOD", *************** *** 159,177 **** "EXP", "SQRT", "INT", ! "70" }; #else extern char *opname[]; #endif union { int ival; char *cval; ! } ops[50000]; /* hope they have 200k to spare */ - EXT int mop INIT(1); - #define DEBUGGING #include <stdio.h> --- 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 <stdio.h> *************** *** 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 <lwall@devvax.Jpl.Nasa.Gov> .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 <lwall@jpl-devvax.Jpl.Nasa.Gov> .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; }