diff options
Diffstat (limited to 'x2p')
-rw-r--r-- | x2p/EXTERN.h | 15 | ||||
-rw-r--r-- | x2p/INTERN.h | 15 | ||||
-rw-r--r-- | x2p/Makefile.SH | 148 | ||||
-rw-r--r-- | x2p/a2p.h | 253 | ||||
-rw-r--r-- | x2p/a2p.man | 191 | ||||
-rw-r--r-- | x2p/a2p.y | 325 | ||||
-rw-r--r-- | x2p/a2py.c | 859 | ||||
-rw-r--r-- | x2p/handy.h | 26 | ||||
-rw-r--r-- | x2p/hash.c | 237 | ||||
-rw-r--r-- | x2p/hash.h | 49 | ||||
-rw-r--r-- | x2p/s2p | 551 | ||||
-rw-r--r-- | x2p/s2p.man | 94 | ||||
-rw-r--r-- | x2p/str.c | 451 | ||||
-rw-r--r-- | x2p/str.h | 35 | ||||
-rw-r--r-- | x2p/util.c | 275 | ||||
-rw-r--r-- | x2p/util.h | 37 | ||||
-rw-r--r-- | x2p/walk.c | 1464 |
17 files changed, 5025 insertions, 0 deletions
diff --git a/x2p/EXTERN.h b/x2p/EXTERN.h new file mode 100644 index 0000000000..d0e248160a --- /dev/null +++ b/x2p/EXTERN.h @@ -0,0 +1,15 @@ +/* $Header: EXTERN.h,v 1.0 87/12/18 13:06:44 root Exp $ + * + * $Log: EXTERN.h,v $ + * Revision 1.0 87/12/18 13:06:44 root + * Initial revision + * + */ + +#undef EXT +#define EXT extern + +#undef INIT +#define INIT(x) + +#undef DOINIT diff --git a/x2p/INTERN.h b/x2p/INTERN.h new file mode 100644 index 0000000000..76c51c5df8 --- /dev/null +++ b/x2p/INTERN.h @@ -0,0 +1,15 @@ +/* $Header: INTERN.h,v 1.0 87/12/18 13:06:48 root Exp $ + * + * $Log: INTERN.h,v $ + * Revision 1.0 87/12/18 13:06:48 root + * Initial revision + * + */ + +#undef EXT +#define EXT + +#undef INIT +#define INIT(x) = x + +#define DOINIT diff --git a/x2p/Makefile.SH b/x2p/Makefile.SH new file mode 100644 index 0000000000..d965160cc3 --- /dev/null +++ b/x2p/Makefile.SH @@ -0,0 +1,148 @@ +case $CONFIG in +'') + if test ! -f config.sh; then + ln ../config.sh . || \ + ln ../../config.sh . || \ + ln ../../../config.sh . || \ + (echo "Can't find config.sh."; exit 1) + fi + . config.sh + ;; +esac +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac +echo "Extracting x2p/Makefile (with variable substitutions)" +cat >Makefile <<!GROK!THIS! +# $Header: Makefile.SH,v 1.0 87/12/18 17:50:17 root Exp $ +# +# $Log: Makefile.SH,v $ +# Revision 1.0 87/12/18 17:50:17 root +# Initial revision +# +# + +CC = $cc +bin = $bin +lib = $lib +mansrc = $mansrc +manext = $manext +CFLAGS = $ccflags -O +LDFLAGS = $ldflags +SMALL = $small +LARGE = $large $split + +libs = $libnm -lm +!GROK!THIS! + +cat >>Makefile <<'!NO!SUBS!' + +public = a2p s2p + +private = + +manpages = a2p.man s2p.man + +util = + +sh = Makefile.SH makedepend.SH + +h = EXTERN.h INTERN.h config.h handy.h hash.h a2p.h str.h util.h + +c = hash.c ../malloc.c str.c util.c walk.c + +obj = hash.o malloc.o str.o util.o walk.o + +lintflags = -phbvxac + +addedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7 + +# grrr +SHELL = /bin/sh + +.c.o: + $(CC) -c $(CFLAGS) $(LARGE) $*.c + +all: $(public) $(private) $(util) + touch all + +a2p: $(obj) a2p.o + $(CC) $(LDFLAGS) $(LARGE) $(obj) a2p.o $(libs) -o a2p + +a2p.c: a2p.y + @ echo Expect 107 shift/reduce errors... + yacc a2p.y + mv y.tab.c a2p.c + +a2p.o: a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h handy.h + $(CC) -c $(CFLAGS) $(LARGE) a2p.c + +# if a .h file depends on another .h file... +$(h): + touch $@ +install: a2p s2p +# won't work with csh + export PATH || exit 1 + - mv $(bin)/a2p $(bin)/a2p.old + - mv $(bin)/s2p $(bin)/s2p.old + - if test `pwd` != $(bin); then cp $(public) $(bin); fi + cd $(bin); \ +for pub in $(public); do \ +chmod 755 `basename $$pub`; \ +done + - test $(bin) = /bin || rm -f /bin/a2p +# chmod 755 makedir +# - makedir `filexp $(lib)` +# - \ +#if test `pwd` != `filexp $(lib)`; then \ +#cp $(private) `filexp $(lib)`; \ +#fi +# cd `filexp $(lib)`; \ +#for priv in $(private); do \ +#chmod 755 `basename $$priv`; \ +#done + - if test `pwd` != $(mansrc); then \ +for page in $(manpages); do \ +cp $$page $(mansrc)/`basename $$page .man`.$(manext); \ +done; \ +fi + +clean: + rm -f *.o + +realclean: + rm -f a2p *.orig */*.orig *.o core $(addedbyconf) + +# The following lint has practically everything turned on. Unfortunately, +# you have to wade through a lot of mumbo jumbo that can't be suppressed. +# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message +# for that spot. + +lint: + lint $(lintflags) $(defs) $(c) > a2p.fuzz + +depend: ../makedepend + ../makedepend + +clist: + echo $(c) | tr ' ' '\012' >.clist + +hlist: + echo $(h) | tr ' ' '\012' >.hlist + +shlist: + echo $(sh) | tr ' ' '\012' >.shlist + +# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE +$(obj): + @ echo "You haven't done a "'"make depend" yet!'; exit 1 +makedepend: makedepend.SH + /bin/sh makedepend.SH +!NO!SUBS! +$eunicefix Makefile +case `pwd` in +*SH) + $rm -f ../Makefile + ln Makefile ../Makefile + ;; +esac diff --git a/x2p/a2p.h b/x2p/a2p.h new file mode 100644 index 0000000000..35f8bbeb1f --- /dev/null +++ b/x2p/a2p.h @@ -0,0 +1,253 @@ +/* $Header: a2p.h,v 1.0 87/12/18 13:06:58 root Exp $ + * + * $Log: a2p.h,v $ + * Revision 1.0 87/12/18 13:06:58 root + * Initial revision + * + */ + +#include "handy.h" +#define Nullop 0 + +#define OPROG 1 +#define OJUNK 2 +#define OHUNKS 3 +#define ORANGE 4 +#define OPAT 5 +#define OHUNK 6 +#define OPPAREN 7 +#define OPANDAND 8 +#define OPOROR 9 +#define OPNOT 10 +#define OCPAREN 11 +#define OCANDAND 12 +#define OCOROR 13 +#define OCNOT 14 +#define ORELOP 15 +#define ORPAREN 16 +#define OMATCHOP 17 +#define OMPAREN 18 +#define OCONCAT 19 +#define OASSIGN 20 +#define OADD 21 +#define OSUB 22 +#define OMULT 23 +#define ODIV 24 +#define OMOD 25 +#define OPOSTINCR 26 +#define OPOSTDECR 27 +#define OPREINCR 28 +#define OPREDECR 29 +#define OUMINUS 30 +#define OUPLUS 31 +#define OPAREN 32 +#define OGETLINE 33 +#define OSPRINTF 34 +#define OSUBSTR 35 +#define OSTRING 36 +#define OSPLIT 37 +#define OSNEWLINE 38 +#define OINDEX 39 +#define ONUM 40 +#define OSTR 41 +#define OVAR 42 +#define OFLD 43 +#define ONEWLINE 44 +#define OCOMMENT 45 +#define OCOMMA 46 +#define OSEMICOLON 47 +#define OSCOMMENT 48 +#define OSTATES 49 +#define OSTATE 50 +#define OPRINT 51 +#define OPRINTF 52 +#define OBREAK 53 +#define ONEXT 54 +#define OEXIT 55 +#define OCONTINUE 56 +#define OREDIR 57 +#define OIF 58 +#define OWHILE 59 +#define OFOR 60 +#define OFORIN 61 +#define OVFLD 62 +#define OBLOCK 63 +#define OREGEX 64 +#define OLENGTH 65 +#define OLOG 66 +#define OEXP 67 +#define OSQRT 68 +#define OINT 69 + +#ifdef DOINIT +char *opname[] = { + "0", + "PROG", + "JUNK", + "HUNKS", + "RANGE", + "PAT", + "HUNK", + "PPAREN", + "PANDAND", + "POROR", + "PNOT", + "CPAREN", + "CANDAND", + "COROR", + "CNOT", + "RELOP", + "RPAREN", + "MATCHOP", + "MPAREN", + "CONCAT", + "ASSIGN", + "ADD", + "SUB", + "MULT", + "DIV", + "MOD", + "POSTINCR", + "POSTDECR", + "PREINCR", + "PREDECR", + "UMINUS", + "UPLUS", + "PAREN", + "GETLINE", + "SPRINTF", + "SUBSTR", + "STRING", + "SPLIT", + "SNEWLINE", + "INDEX", + "NUM", + "STR", + "VAR", + "FLD", + "NEWLINE", + "COMMENT", + "COMMA", + "SEMICOLON", + "SCOMMENT", + "STATES", + "STATE", + "PRINT", + "PRINTF", + "BREAK", + "NEXT", + "EXIT", + "CONTINUE", + "REDIR", + "IF", + "WHILE", + "FOR", + "FORIN", + "VFLD", + "BLOCK", + "REGEX", + "LENGTH", + "LOG", + "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> +#include <ctype.h> +#include <setjmp.h> +#include <sys/types.h> +#include <sys/stat.h> +#include <time.h> +#include <sys/times.h> + +typedef struct string STR; +typedef struct htbl HASH; + +#include "str.h" +#include "hash.h" + +/* A string is TRUE if not "" or "0". */ +#define True(val) (tmps = (val), (*tmps && !(*tmps == '0' && !tmps[1]))) +EXT char *Yes INIT("1"); +EXT char *No INIT(""); + +#define str_true(str) (Str = (str), (Str->str_pok ? True(Str->str_ptr) : (Str->str_nok ? (Str->str_nval != 0.0) : 0 ))) + +#define str_peek(str) (Str = (str), (Str->str_pok ? Str->str_ptr : (Str->str_nok ? (sprintf(buf,"num(%g)",Str->str_nval),buf) : "" ))) +#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str))) +#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_nval : str_2num(Str))) +EXT STR *Str; + +#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len) + +STR *str_new(); + +char *scanpat(); +char *scannum(); + +void str_free(); + +EXT int line INIT(0); + +EXT FILE *rsfp; +EXT char buf[1024]; +EXT char *bufptr INIT(buf); + +EXT STR *linestr INIT(Nullstr); + +EXT char tokenbuf[256]; +EXT int expectterm INIT(TRUE); + +#ifdef DEBUGGING +EXT int debug INIT(0); +EXT int dlevel INIT(0); +#define YYDEBUG; +extern int yydebug; +#endif + +EXT STR *freestrroot INIT(Nullstr); + +EXT STR str_no; +EXT STR str_yes; + +EXT bool do_split INIT(FALSE); +EXT bool split_to_array INIT(FALSE); +EXT bool set_array_base INIT(FALSE); +EXT bool saw_RS INIT(FALSE); +EXT bool saw_OFS INIT(FALSE); +EXT bool saw_ORS INIT(FALSE); +EXT bool saw_line_op INIT(FALSE); +EXT bool in_begin INIT(TRUE); +EXT bool do_opens INIT(FALSE); +EXT bool do_fancy_opens INIT(FALSE); +EXT bool lval_field INIT(FALSE); +EXT bool do_chop INIT(FALSE); +EXT bool need_entire INIT(FALSE); +EXT bool absmaxfld INIT(FALSE); + +EXT char const_FS INIT(0); +EXT char *namelist INIT(Nullch); +EXT char fswitch INIT(0); + +EXT int saw_FS INIT(0); +EXT int maxfld INIT(0); +EXT int arymax INIT(0); +char *nameary[100]; + +EXT STR *opens; + +EXT HASH *symtab; diff --git a/x2p/a2p.man b/x2p/a2p.man new file mode 100644 index 0000000000..d367526893 --- /dev/null +++ b/x2p/a2p.man @@ -0,0 +1,191 @@ +.rn '' }` +''' $Header: a2p.man,v 1.0 87/12/18 17:23:56 root Exp $ +''' +''' $Log: a2p.man,v $ +''' Revision 1.0 87/12/18 17:23:56 root +''' Initial revision +''' +''' +.de Sh +.br +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp +.if t .sp .5v +.if n .sp +.. +.de Ip +.br +.ie \\n.$>=3 .ne \\$3 +.el .ne 3 +.IP "\\$1" \\$2 +.. +''' +''' Set up \*(-- to give an unbreakable dash; +''' string Tr holds user defined translation string. +''' Bell System Logo is used as a dummy character. +''' +.tr \(bs-|\(bv\*(Tr +.ie n \{\ +.ds -- \(bs- +.if (\n(.H=4u)&(1m=24u) .ds -- \(bs\h'-12u'\(bs\h'-12u'-\" diablo 10 pitch +.if (\n(.H=4u)&(1m=20u) .ds -- \(bs\h'-12u'\(bs\h'-8u'-\" diablo 12 pitch +.ds L" "" +.ds R" "" +.ds L' ' +.ds R' ' +'br\} +.el\{\ +.ds -- \(em\| +.tr \*(Tr +.ds L" `` +.ds R" '' +.ds L' ` +.ds R' ' +'br\} +.TH A2P 1 LOCAL +.SH NAME +a2p - Awk to Perl translator +.SH SYNOPSIS +.B a2p [options] filename +.SH DESCRIPTION +.I A2p +takes an awk script specified on the command line (or from standard input) +and produces a comparable +.I perl +script on the standard output. +.Sh "Options" +Options include: +.TP 5 +.B \-D<number> +sets debugging flags. +.TP 5 +.B \-F<character> +tells a2p that this awk script is always invoked with this -F switch. +.TP 5 +.B \-n<fieldlist> +specifies the names of the input fields if input does not have to be split into +an array. +If you were translating an awk script that processes the password file, you +might say: +.sp + a2p -7 -nlogin.password.uid.gid.gcos.shell.home +.sp +Any delimiter will do to separate the field names. +.TP 5 +.B \-<number> +causes a2p to assume that input will always have that many fields. +.Sh "Considerations" +A2p cannot do as good a job translating as a human would, but it usually +does pretty well. +There are some areas where you may want to examine the perl script produced +and tweak it some. +Here are some of them, in no particular order. +.PP +The split operator in perl always strips off all null fields from the end. +Awk does NOT do this, if you've set FS. +If the perl script splits to an array, the field count may not reflect +what you expect. +Ordinarily this isn't a problem, since nonexistent array elements have a null +value, but if you rely on NF in awk, you could be in for trouble. +Either force the number of fields with \-<number>, or count the number of +delimiters another way, e.g. with y/:/:/. +Or add something non-null to the end before you split, and then pop it off +the resulting array. +.PP +There is an awk idiom of putting int() around a string expression to force +numeric interpretation, even though the argument is always integer anyway. +This is generally unneeded in perl, but a2p can't tell if the argument +is always going to be integer, so it leaves it in. +You may wish to remove it. +.PP +Perl differentiates numeric comparison from string comparison. +Awk has one operator for both that decides at run time which comparison +to do. +A2p does not try to do a complete job of awk emulation at this point. +Instead it guesses which one you want. +It's almost always right, but it can be spoofed. +All such guesses are marked with the comment \*(L"#???\*(R". +You should go through and check them. +.PP +Perl does not attempt to emulate the behavior of awk in which nonexistent +array elements spring into existence simply by being referenced. +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 +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. +This will let you name the fields throughout the script. +If it splits to an array instead, the script is probably referring to the number +of fields somewhere. +.PP +The exit statement in awk doesn't necessarily exit; it goes to the END +block if there is one. +Awk scripts that do contortions within the END block to bypass the block under +such circumstances can be simplified by removing the conditional +in the END block and just exiting directly from the perl script. +.PP +Perl has two kinds of array, numerically-indexed and associative. +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. +.PP +Near the top of the line loop will be the split operation that is implicit in +the awk script. +There are times when you can move this down past some conditionals that +test the entire record so that the split is not done as often. +.PP +There may occasionally be extra parentheses that you can remove. +.PP +For aesthetic reasons you may wish to change the array base $[ from 1 back +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. +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 +.br +s2p sed to perl translator +.SH DIAGNOSTICS +.SH BUGS +It would be possible to emulate awk's behavior in selecting string versus +numeric operations at run time by inspection of the operands, but it would +be gross and inefficient. +Besides, a2p almost always guesses right. +.PP +Storage for the awk syntax tree is currently static, and can run out. +.rn }` '' diff --git a/x2p/a2p.y b/x2p/a2p.y new file mode 100644 index 0000000000..15484d2f3b --- /dev/null +++ b/x2p/a2p.y @@ -0,0 +1,325 @@ +%{ +/* $Header: a2p.y,v 1.0 87/12/18 13:07:05 root Exp $ + * + * $Log: a2p.y,v $ + * Revision 1.0 87/12/18 13:07:05 root + * Initial revision + * + */ + +#include "INTERN.h" +#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 '{' states '}' junk + { $$ = oper2(OJUNK,$3,$5); in_begin = FALSE; } + | /* NULL */ + { $$ = Nullop; } + ; + +end : END '{' states '}' + { $$ = $3; } + | end NEWLINE + { $$ = $1; } + | /* NULL */ + { $$ = Nullop; } + ; + +hunks : hunks hunk junk + { $$ = oper3(OHUNKS,$1,$2,$3); } + | /* NULL */ + { $$ = Nullop; } + ; + +hunk : patpat + { $$ = oper1(OHUNK,$1); need_entire = TRUE; } + | patpat '{' states '}' + { $$ = oper2(OHUNK,$1,$3); } + | '{' states '}' + { $$ = oper2(OHUNK,Nullop,$2); } + ; + +patpat : pat + { $$ = oper1(OPAT,$1); } + | pat ',' pat + { $$ = oper2(ORANGE,$1,$3); } + ; + +pat : REGEX + { $$ = oper1(OREGEX,$1); } + | match + | rel + | compound_pat + ; + +compound_pat + : '(' compound_pat ')' + { $$ = oper1(OPPAREN,$2); } + | pat ANDAND pat + { $$ = oper2(OPANDAND,$1,$3); } + | pat OROR pat + { $$ = oper2(OPOROR,$1,$3); } + | NOT pat + { $$ = oper1(OPNOT,$2); } + ; + +cond : expr + | match + | rel + | compound_cond + ; + +compound_cond + : '(' compound_cond ')' + { $$ = oper1(OCPAREN,$2); } + | cond ANDAND cond + { $$ = oper2(OCANDAND,$1,$3); } + | cond OROR cond + { $$ = oper2(OCOROR,$1,$3); } + | NOT cond + { $$ = oper1(OCNOT,$2); } + ; + +rel : expr RELOP expr + { $$ = oper3(ORELOP,$2,$1,$3); } + | '(' rel ')' + { $$ = oper1(ORPAREN,$2); } + ; + +match : expr MATCHOP REGEX + { $$ = oper3(OMATCHOP,$2,$1,$3); } + | '(' match ')' + { $$ = oper1(OMPAREN,$2); } + ; + +expr : term + { $$ = $1; } + | expr term + { $$ = oper2(OCONCAT,$1,$2); } + | variable ASGNOP expr + { $$ = oper3(OASSIGN,$2,$1,$3); + if ((ops[$1].ival & 255) == OFLD) + lval_field = TRUE; + if ((ops[$1].ival & 255) == OVFLD) + lval_field = TRUE; + } + ; + +term : variable + { $$ = $1; } + | term '+' term + { $$ = oper2(OADD,$1,$3); } + | term '-' term + { $$ = oper2(OSUB,$1,$3); } + | term '*' term + { $$ = oper2(OMULT,$1,$3); } + | term '/' term + { $$ = oper2(ODIV,$1,$3); } + | term '%' term + { $$ = oper2(OMOD,$1,$3); } + | variable INCR + { $$ = oper1(OPOSTINCR,$1); } + | variable DECR + { $$ = oper1(OPOSTDECR,$1); } + | INCR variable + { $$ = oper1(OPREINCR,$2); } + | DECR variable + { $$ = oper1(OPREDECR,$2); } + | '-' term %prec UMINUS + { $$ = oper1(OUMINUS,$2); } + | '+' term %prec UMINUS + { $$ = oper1(OUPLUS,$2); } + | '(' expr ')' + { $$ = oper1(OPAREN,$2); } + | GETLINE + { $$ = oper0(OGETLINE); } + | FUN1 + { $$ = oper0($1); need_entire = do_chop = TRUE; } + | FUN1 '(' ')' + { $$ = 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); } + | SUBSTR '(' expr ',' expr ')' + { $$ = oper2(OSUBSTR,$3,$5); } + | SPLIT '(' expr ',' VAR ',' expr ')' + { $$ = oper3(OSPLIT,$3,numary($5),$7); } + | SPLIT '(' expr ',' VAR ')' + { $$ = oper2(OSPLIT,$3,numary($5)); } + | INDEX '(' expr ',' expr ')' + { $$ = oper2(OINDEX,$3,$5); } + ; + +variable: NUMBER + { $$ = oper1(ONUM,$1); } + | STRING + { $$ = oper1(OSTR,$1); } + | VAR + { $$ = oper1(OVAR,$1); } + | VAR '[' expr ']' + { $$ = oper2(OVAR,$1,$3); } + | FIELD + { $$ = oper1(OFLD,$1); } + | VFIELD term + { $$ = oper1(OVFLD,$2); } + ; + +maybe : NEWLINE + { $$ = oper0(ONEWLINE); } + | /* NULL */ + { $$ = Nullop; } + | COMMENT + { $$ = oper1(OCOMMENT,$1); } + ; + +print_list + : expr + | clist + | /* NULL */ + { $$ = Nullop; } + ; + +clist : expr ',' expr + { $$ = oper2(OCOMMA,$1,$3); } + | clist ',' expr + { $$ = oper2(OCOMMA,$1,$3); } + | '(' clist ')' /* these parens are invisible */ + { $$ = $2; } + ; + +junk : junk hunksep + { $$ = oper2(OJUNK,$1,$2); } + | /* NULL */ + { $$ = Nullop; } + ; + +hunksep : ';' + { $$ = oper0(OSEMICOLON); } + | SEMINEW + { $$ = oper0(OSEMICOLON); } + | NEWLINE + { $$ = oper0(ONEWLINE); } + | COMMENT + { $$ = oper1(OCOMMENT,$1); } + ; + +separator + : ';' + { $$ = oper0(OSEMICOLON); } + | SEMINEW + { $$ = oper0(OSNEWLINE); } + | NEWLINE + { $$ = oper0(OSNEWLINE); } + | COMMENT + { $$ = oper1(OSCOMMENT,$1); } + ; + +states : states statement + { $$ = oper2(OSTATES,$1,$2); } + | /* NULL */ + { $$ = Nullop; } + ; + +statement + : simple separator + { $$ = oper2(OSTATE,$1,$2); } + | compound + ; + +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; + } + | BREAK + { $$ = oper0(OBREAK); } + | NEXT + { $$ = oper0(ONEXT); } + | EXIT + { $$ = oper0(OEXIT); } + | EXIT expr + { $$ = oper1(OEXIT,$2); } + | CONTINUE + { $$ = oper0(OCONTINUE); } + | /* NULL */ + { $$ = Nullop; } + ; + +redir : RELOP + { $$ = oper1(OREDIR,string(">",1)); } + | GRGR + { $$ = oper1(OREDIR,string(">>",2)); } + | '|' + { $$ = oper1(OREDIR,string("|",1)); } + ; + +compound + : IF '(' cond ')' maybe statement + { $$ = oper2(OIF,$3,bl($6,$5)); } + | IF '(' cond ')' maybe statement ELSE maybe statement + { $$ = oper3(OIF,$3,bl($6,$5),bl($9,$8)); } + | WHILE '(' cond ')' maybe statement + { $$ = oper2(OWHILE,$3,bl($6,$5)); } + | FOR '(' simple ';' cond ';' simple ')' maybe statement + { $$ = oper4(OFOR,$3,$5,$7,bl($10,$9)); } + | FOR '(' simple ';' ';' simple ')' maybe statement + { $$ = oper4(OFOR,$3,string("",0),$6,bl($9,$8)); } + | FOR '(' VAR IN VAR ')' maybe statement + { $$ = oper3(OFORIN,$3,$5,bl($8,$7)); } + | '{' states '}' + { $$ = oper1(OBLOCK,$2); } + ; + +%% +#include "a2py.c" diff --git a/x2p/a2py.c b/x2p/a2py.c new file mode 100644 index 0000000000..8a1ad78b96 --- /dev/null +++ b/x2p/a2py.c @@ -0,0 +1,859 @@ +/* $Header: a2py.c,v 1.0 87/12/18 17:50:33 root Exp $ + * + * $Log: a2py.c,v $ + * Revision 1.0 87/12/18 17:50:33 root + * Initial revision + * + */ + +#include "util.h" +char *index(); + +char *filename; + +main(argc,argv,env) +register int argc; +register char **argv; +register char **env; +{ + register STR *str; + register char *s; + int i; + STR *walk(); + STR *tmpstr; + + linestr = str_new(80); + str = str_new(0); /* first used for -I flags */ + for (argc--,argv++; argc; argc--,argv++) { + if (argv[0][0] != '-' || !argv[0][1]) + break; + reswitch: + switch (argv[0][1]) { +#ifdef DEBUGGING + case 'D': + debug = atoi(argv[0]+2); +#ifdef YYDEBUG + yydebug = (debug & 1); +#endif + break; +#endif + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + maxfld = atoi(argv[0]+1); + absmaxfld = TRUE; + break; + case 'F': + fswitch = argv[0][2]; + break; + case 'n': + namelist = savestr(argv[0]+2); + break; + case '-': + argc--,argv++; + goto switch_end; + case 0: + break; + default: + fatal("Unrecognized switch: %s\n",argv[0]); + } + } + switch_end: + + /* open script */ + + if (argv[0] == Nullch) + argv[0] = "-"; + filename = savestr(argv[0]); + if (strEQ(filename,"-")) + argv[0] = ""; + if (!*argv[0]) + rsfp = stdin; + else + rsfp = fopen(argv[0],"r"); + if (rsfp == Nullfp) + fatal("Awk script \"%s\" doesn't seem to exist.\n",filename); + + /* init tokener */ + + bufptr = str_get(linestr); + symtab = hnew(); + + /* now parse the report spec */ + + if (yyparse()) + fatal("Translation aborted due to syntax errors.\n"); + +#ifdef DEBUGGING + if (debug & 2) { + int type, len; + + for (i=1; i<mop;) { + type = ops[i].ival; + len = type >> 8; + type &= 255; + printf("%d\t%d\t%d\t%-10s",i++,type,len,opname[type]); + if (type == OSTRING) + printf("\t\"%s\"\n",ops[i].cval),i++; + else { + while (len--) { + printf("\t%d",ops[i].ival),i++; + } + putchar('\n'); + } + } + } + if (debug & 8) + dump(root); +#endif + + /* first pass to look for numeric variables */ + + prewalk(0,0,root,&i); + + /* second pass to produce new program */ + + tmpstr = walk(0,0,root,&i); + str = str_make("#!/bin/perl\n\n"); + if (do_opens && opens) { + str_scat(str,opens); + str_free(opens); + str_cat(str,"\n"); + } + str_scat(str,tmpstr); + str_free(tmpstr); +#ifdef DEBUGGING + if (!(debug & 16)) +#endif + fixup(str); + putlines(str); + exit(0); +} + +#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; + register char *d; + register int tmp; + + retry: +#ifdef YYDEBUG + if (yydebug) + if (index(s,'\n')) + fprintf(stderr,"Tokener at %s",s); + else + fprintf(stderr,"Tokener at %s\n",s); +#endif + switch (*s) { + default: + fprintf(stderr, + "Unrecognized character %c in file %s line %d--ignoring.\n", + *s++,filename,line); + goto retry; + case '\\': + case 0: + s = str_get(linestr); + *s = '\0'; + if (!rsfp) + RETURN(0); + line++; + if ((s = str_gets(linestr, rsfp)) == Nullch) { + if (rsfp != stdin) + fclose(rsfp); + rsfp = Nullfp; + s = str_get(linestr); + RETURN(0); + } + goto retry; + case ' ': case '\t': + s++; + goto retry; + case '\n': + *s = '\0'; + XTERM(NEWLINE); + case '#': + yylval = string(s,0); + *s = '\0'; + XTERM(COMMENT); + case ';': + tmp = *s++; + if (*s == '\n') { + s++; + XTERM(SEMINEW); + } + XTERM(tmp); + case '(': + case '{': + case '[': + case ')': + case ']': + tmp = *s++; + XOP(tmp); + case 127: + s++; + XTERM('}'); + case '}': + for (d = s + 1; isspace(*d); d++) ; + if (!*d) + s = d - 1; + *s = 127; + XTERM(';'); + case ',': + tmp = *s++; + XTERM(tmp); + case '~': + s++; + XTERM(MATCHOP); + case '+': + case '-': + if (s[1] == *s) { + s++; + if (*s++ == '+') + XTERM(INCR); + else + XTERM(DECR); + } + /* FALL THROUGH */ + case '*': + case '%': + tmp = *s++; + if (*s == '=') { + yylval = string(s-1,2); + s++; + XTERM(ASGNOP); + } + XTERM(tmp); + case '&': + s++; + tmp = *s++; + if (tmp == '&') + XTERM(ANDAND); + s--; + XTERM('&'); + case '|': + s++; + tmp = *s++; + if (tmp == '|') + XTERM(OROR); + s--; + XTERM('|'); + case '=': + s++; + tmp = *s++; + if (tmp == '=') { + yylval = string("==",2); + XTERM(RELOP); + } + s--; + yylval = string("=",1); + XTERM(ASGNOP); + case '!': + s++; + tmp = *s++; + if (tmp == '=') { + yylval = string("!=",2); + XTERM(RELOP); + } + if (tmp == '~') { + yylval = string("!~",2); + XTERM(MATCHOP); + } + s--; + XTERM(NOT); + case '<': + s++; + tmp = *s++; + if (tmp == '=') { + yylval = string("<=",2); + XTERM(RELOP); + } + s--; + yylval = string("<",1); + XTERM(RELOP); + case '>': + s++; + tmp = *s++; + if (tmp == '=') { + yylval = string(">=",2); + XTERM(RELOP); + } + s--; + yylval = string(">",1); + XTERM(RELOP); + +#define SNARFWORD \ + d = tokenbuf; \ + while (isalpha(*s) || isdigit(*s) || *s == '_') \ + *d++ = *s++; \ + *d = '\0'; \ + d = tokenbuf; + + case '$': + s++; + if (*s == '0') { + s++; + do_chop = TRUE; + need_entire = TRUE; + ID("0"); + } + do_split = TRUE; + if (isdigit(*s)) { + for (d = s; isdigit(*s); s++) ; + yylval = string(d,s-d); + tmp = atoi(d); + if (tmp > maxfld) + maxfld = tmp; + XOP(FIELD); + } + split_to_array = set_array_base = TRUE; + XOP(VFIELD); + + case '/': /* may either be division or pattern */ + if (expectterm) { + s = scanpat(s); + XTERM(REGEX); + } + tmp = *s++; + if (*s == '=') { + yylval = string("/=",2); + s++; + XTERM(ASGNOP); + } + XTERM(tmp); + + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + s = scannum(s); + XOP(NUMBER); + case '"': + s++; + s = cpy2(tokenbuf,s,s[-1]); + if (!*s) + fatal("String not terminated:\n%s",str_get(linestr)); + s++; + yylval = string(tokenbuf,0); + XOP(STRING); + + case 'a': case 'A': + SNARFWORD; + ID(d); + case 'b': case 'B': + SNARFWORD; + if (strEQ(d,"break")) + XTERM(BREAK); + if (strEQ(d,"BEGIN")) + XTERM(BEGIN); + ID(d); + case 'c': case 'C': + SNARFWORD; + if (strEQ(d,"continue")) + XTERM(CONTINUE); + ID(d); + case 'd': case 'D': + SNARFWORD; + ID(d); + case 'e': case 'E': + SNARFWORD; + if (strEQ(d,"END")) + XTERM(END); + if (strEQ(d,"else")) + XTERM(ELSE); + if (strEQ(d,"exit")) { + saw_line_op = TRUE; + XTERM(EXIT); + } + if (strEQ(d,"exp")) { + yylval = OEXP; + XTERM(FUN1); + } + ID(d); + case 'f': case 'F': + SNARFWORD; + if (strEQ(d,"FS")) { + saw_FS++; + if (saw_FS == 1 && in_begin) { + for (d = s; *d && isspace(*d); d++) ; + if (*d == '=') { + for (d++; *d && isspace(*d); d++) ; + if (*d == '"' && d[2] == '"') + const_FS = d[1]; + } + } + 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; + if (strEQ(d,"if")) + XTERM(IF); + if (strEQ(d,"in")) + XTERM(IN); + if (strEQ(d,"index")) { + set_array_base = TRUE; + XTERM(INDEX); + } + if (strEQ(d,"int")) { + yylval = OINT; + XTERM(FUN1); + } + ID(d); + case 'j': case 'J': + SNARFWORD; + ID(d); + case 'k': case 'K': + SNARFWORD; + ID(d); + case 'l': case 'L': + SNARFWORD; + if (strEQ(d,"length")) { + yylval = OLENGTH; + XTERM(FUN1); + } + if (strEQ(d,"log")) { + yylval = OLOG; + XTERM(FUN1); + } + ID(d); + case 'm': case 'M': + SNARFWORD; + ID(d); + case 'n': case 'N': + SNARFWORD; + if (strEQ(d,"NF")) + do_split = split_to_array = set_array_base = TRUE; + if (strEQ(d,"next")) { + saw_line_op = TRUE; + XTERM(NEXT); + } + ID(d); + case 'o': case 'O': + SNARFWORD; + if (strEQ(d,"ORS")) { + saw_ORS = TRUE; + d = "$\\"; + } + if (strEQ(d,"OFS")) { + saw_OFS = TRUE; + d = "$,"; + } + if (strEQ(d,"OFMT")) { + d = "$#"; + } + ID(d); + case 'p': case 'P': + SNARFWORD; + if (strEQ(d,"print")) { + XTERM(PRINT); + } + if (strEQ(d,"printf")) { + XTERM(PRINTF); + } + ID(d); + case 'q': case 'Q': + SNARFWORD; + ID(d); + case 'r': case 'R': + SNARFWORD; + if (strEQ(d,"RS")) { + d = "$/"; + saw_RS = TRUE; + } + ID(d); + case 's': case 'S': + SNARFWORD; + if (strEQ(d,"split")) { + set_array_base = TRUE; + XOP(SPLIT); + } + if (strEQ(d,"substr")) { + set_array_base = TRUE; + XTERM(SUBSTR); + } + if (strEQ(d,"sprintf")) + XTERM(SPRINTF); + if (strEQ(d,"sqrt")) { + yylval = OSQRT; + XTERM(FUN1); + } + ID(d); + case 't': case 'T': + SNARFWORD; + ID(d); + case 'u': case 'U': + SNARFWORD; + ID(d); + case 'v': case 'V': + SNARFWORD; + ID(d); + case 'w': case 'W': + SNARFWORD; + if (strEQ(d,"while")) + XTERM(WHILE); + ID(d); + case 'x': case 'X': + SNARFWORD; + ID(d); + case 'y': case 'Y': + SNARFWORD; + ID(d); + case 'z': case 'Z': + SNARFWORD; + ID(d); + } +} + +char * +scanpat(s) +register char *s; +{ + register char *d; + + switch (*s++) { + case '/': + break; + default: + fatal("Search pattern not found:\n%s",str_get(linestr)); + } + s = cpytill(tokenbuf,s,s[-1]); + if (!*s) + fatal("Search pattern not terminated:\n%s",str_get(linestr)); + s++; + yylval = string(tokenbuf,0); + return s; +} + +yyerror(s) +char *s; +{ + fprintf(stderr,"%s in file %s at line %d\n", + s,filename,line); +} + +char * +scannum(s) +register char *s; +{ + register char *d; + + switch (*s) { + case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': case '0' : case '.': + d = tokenbuf; + while (isdigit(*s) || *s == '_') + *d++ = *s++; + if (*s == '.' && index("0123456789eE",s[1])) + *d++ = *s++; + while (isdigit(*s) || *s == '_') + *d++ = *s++; + if (index("eE",*s) && index("+-0123456789",s[1])) + *d++ = *s++; + if (*s == '+' || *s == '-') + *d++ = *s++; + while (isdigit(*s)) + *d++ = *s++; + *d = '\0'; + yylval = string(tokenbuf,0); + break; + } + return s; +} + +string(ptr,len) +char *ptr; +{ + int retval = mop; + + ops[mop++].ival = OSTRING + (1<<8); + if (!len) + len = strlen(ptr); + ops[mop].cval = safemalloc(len+1); + strncpy(ops[mop].cval,ptr,len); + ops[mop++].cval[len] = '\0'; + return retval; +} + +oper0(type) +int type; +{ + int retval = mop; + + if (type > 255) + fatal("type > 255 (%d)\n",type); + ops[mop++].ival = type; + return retval; +} + +oper1(type,arg1) +int type; +int arg1; +{ + int retval = mop; + + if (type > 255) + fatal("type > 255 (%d)\n",type); + ops[mop++].ival = type + (1<<8); + ops[mop++].ival = arg1; + return retval; +} + +oper2(type,arg1,arg2) +int type; +int arg1; +int arg2; +{ + int retval = mop; + + if (type > 255) + fatal("type > 255 (%d)\n",type); + ops[mop++].ival = type + (2<<8); + ops[mop++].ival = arg1; + ops[mop++].ival = arg2; + return retval; +} + +oper3(type,arg1,arg2,arg3) +int type; +int arg1; +int arg2; +int arg3; +{ + int retval = mop; + + if (type > 255) + fatal("type > 255 (%d)\n",type); + ops[mop++].ival = type + (3<<8); + ops[mop++].ival = arg1; + ops[mop++].ival = arg2; + ops[mop++].ival = arg3; + return retval; +} + +oper4(type,arg1,arg2,arg3,arg4) +int type; +int arg1; +int arg2; +int arg3; +int arg4; +{ + int retval = mop; + + if (type > 255) + fatal("type > 255 (%d)\n",type); + ops[mop++].ival = type + (4<<8); + ops[mop++].ival = arg1; + ops[mop++].ival = arg2; + ops[mop++].ival = arg3; + ops[mop++].ival = arg4; + return retval; +} + +oper5(type,arg1,arg2,arg3,arg4,arg5) +int type; +int arg1; +int arg2; +int arg3; +int arg4; +int arg5; +{ + int retval = mop; + + if (type > 255) + fatal("type > 255 (%d)\n",type); + ops[mop++].ival = type + (5<<8); + ops[mop++].ival = arg1; + ops[mop++].ival = arg2; + ops[mop++].ival = arg3; + ops[mop++].ival = arg4; + ops[mop++].ival = arg5; + return retval; +} + +int depth = 0; + +dump(branch) +int branch; +{ + register int type; + register int len; + register int i; + + type = ops[branch].ival; + len = type >> 8; + type &= 255; + for (i=depth; i; i--) + printf(" "); + if (type == OSTRING) { + printf("%-5d\"%s\"\n",branch,ops[branch+1].cval); + } + else { + printf("(%-5d%s %d\n",branch,opname[type],len); + depth++; + for (i=1; i<=len; i++) + dump(ops[branch+i].ival); + depth--; + for (i=depth; i; i--) + printf(" "); + printf(")\n"); + } +} + +bl(arg,maybe) +int arg; +int maybe; +{ + if (!arg) + return 0; + else if ((ops[arg].ival & 255) != OBLOCK) + return oper2(OBLOCK,arg,maybe); + else if ((ops[arg].ival >> 8) != 2) + return oper2(OBLOCK,ops[arg+1].ival,maybe); + else + return arg; +} + +fixup(str) +STR *str; +{ + register char *s; + register char *t; + + for (s = str->str_ptr; *s; s++) { + if (*s == ';' && s[1] == ' ' && s[2] == '\n') { + strcpy(s+1,s+2); + s++; + } + else if (*s == '\n') { + for (t = s+1; isspace(*t & 127); t++) ; + t--; + while (isspace(*t & 127) && *t != '\n') t--; + if (*t == '\n' && t-s > 1) { + if (s[-1] == '{') + s--; + strcpy(s+1,t); + } + s++; + } + } +} + +putlines(str) +STR *str; +{ + register char *d, *s, *t, *e; + register int pos, newpos; + + d = tokenbuf; + pos = 0; + for (s = str->str_ptr; *s; s++) { + *d++ = *s; + pos++; + if (*s == '\n') { + *d = '\0'; + d = tokenbuf; + pos = 0; + putone(); + } + else if (*s == '\t') + pos += 7; + if (pos > 78) { /* split a long line? */ + *d-- = '\0'; + newpos = 0; + for (t = tokenbuf; isspace(*t & 127); t++) { + if (*t == '\t') + newpos += 8; + else + newpos += 1; + } + e = d; + while (d > tokenbuf && (*d != ' ' || d[-1] != ';')) + d--; + if (d < t+10) { + d = e; + while (d > tokenbuf && + (*d != ' ' || d[-1] != '|' || d[-2] != '|') ) + d--; + } + if (d < t+10) { + d = e; + while (d > tokenbuf && + (*d != ' ' || d[-1] != '&' || d[-2] != '&') ) + d--; + } + if (d < t+10) { + d = e; + while (d > tokenbuf && (*d != ' ' || d[-1] != ',')) + d--; + } + if (d < t+10) { + d = e; + while (d > tokenbuf && *d != ' ') + d--; + } + if (d > t+3) { + *d = '\0'; + putone(); + putchar('\n'); + if (d[-1] != ';' && !(newpos % 4)) { + *t++ = ' '; + *t++ = ' '; + newpos += 2; + } + strcpy(t,d+1); + newpos += strlen(t); + d = t + strlen(t); + pos = newpos; + } + else + d = e + 1; + } + } +} + +putone() +{ + register char *t; + + for (t = tokenbuf; *t; t++) { + *t &= 127; + if (*t == 127) { + *t = ' '; + strcpy(t+strlen(t)-1, "\t#???\n"); + } + } + t = tokenbuf; + if (*t == '#') { + if (strnEQ(t,"#!/bin/awk",10) || strnEQ(t,"#! /bin/awk",11)) + return; + } + fputs(tokenbuf,stdout); +} + +numary(arg) +int arg; +{ + STR *key; + int dummy; + + key = walk(0,0,arg,&dummy); + str_cat(key,"[]"); + hstore(symtab,key->str_ptr,str_make("1")); + str_free(key); + set_array_base = TRUE; + return arg; +} diff --git a/x2p/handy.h b/x2p/handy.h new file mode 100644 index 0000000000..441bb4350c --- /dev/null +++ b/x2p/handy.h @@ -0,0 +1,26 @@ +/* $Header: handy.h,v 1.0 87/12/18 13:07:15 root Exp $ + * + * $Log: handy.h,v $ + * Revision 1.0 87/12/18 13:07:15 root + * Initial revision + * + */ + +#define Null(type) ((type)0) +#define Nullch Null(char*) +#define Nullfp Null(FILE*) + +#define bool char +#define TRUE (1) +#define FALSE (0) + +#define Ctl(ch) (ch & 037) + +#define strNE(s1,s2) (strcmp(s1,s2)) +#define strEQ(s1,s2) (!strcmp(s1,s2)) +#define strLT(s1,s2) (strcmp(s1,s2) < 0) +#define strLE(s1,s2) (strcmp(s1,s2) <= 0) +#define strGT(s1,s2) (strcmp(s1,s2) > 0) +#define strGE(s1,s2) (strcmp(s1,s2) >= 0) +#define strnNE(s1,s2,l) (strncmp(s1,s2,l)) +#define strnEQ(s1,s2,l) (!strncmp(s1,s2,l)) diff --git a/x2p/hash.c b/x2p/hash.c new file mode 100644 index 0000000000..db32c4c5fe --- /dev/null +++ b/x2p/hash.c @@ -0,0 +1,237 @@ +/* $Header: hash.c,v 1.0 87/12/18 13:07:18 root Exp $ + * + * $Log: hash.c,v $ + * Revision 1.0 87/12/18 13:07:18 root + * Initial revision + * + */ + +#include <stdio.h> +#include "EXTERN.h" +#include "handy.h" +#include "util.h" +#include "a2p.h" + +STR * +hfetch(tb,key) +register HASH *tb; +char *key; +{ + register char *s; + register int i; + register int hash; + register HENT *entry; + + if (!tb) + return Nullstr; + for (s=key, i=0, hash = 0; + /* while */ *s; + s++, i++, hash *= 5) { + hash += *s * coeff[i]; + } + entry = tb->tbl_array[hash & tb->tbl_max]; + for (; entry; entry = entry->hent_next) { + if (entry->hent_hash != hash) /* strings can't be equal */ + continue; + if (strNE(entry->hent_key,key)) /* is this it? */ + continue; + return entry->hent_val; + } + return Nullstr; +} + +bool +hstore(tb,key,val) +register HASH *tb; +char *key; +STR *val; +{ + register char *s; + register int i; + register int hash; + register HENT *entry; + register HENT **oentry; + + if (!tb) + return FALSE; + for (s=key, i=0, hash = 0; + /* while */ *s; + s++, i++, hash *= 5) { + hash += *s * coeff[i]; + } + + oentry = &(tb->tbl_array[hash & tb->tbl_max]); + i = 1; + + for (entry = *oentry; entry; i=0, entry = entry->hent_next) { + if (entry->hent_hash != hash) /* strings can't be equal */ + continue; + if (strNE(entry->hent_key,key)) /* is this it? */ + continue; + safefree((char*)entry->hent_val); + entry->hent_val = val; + return TRUE; + } + entry = (HENT*) safemalloc(sizeof(HENT)); + + entry->hent_key = savestr(key); + entry->hent_val = val; + entry->hent_hash = hash; + entry->hent_next = *oentry; + *oentry = entry; + + if (i) { /* initial entry? */ + tb->tbl_fill++; + if ((tb->tbl_fill * 100 / (tb->tbl_max + 1)) > FILLPCT) + hsplit(tb); + } + + return FALSE; +} + +#ifdef NOTUSED +bool +hdelete(tb,key) +register HASH *tb; +char *key; +{ + register char *s; + register int i; + register int hash; + register HENT *entry; + register HENT **oentry; + + if (!tb) + return FALSE; + for (s=key, i=0, hash = 0; + /* while */ *s; + s++, i++, hash *= 5) { + hash += *s * coeff[i]; + } + + oentry = &(tb->tbl_array[hash & tb->tbl_max]); + entry = *oentry; + i = 1; + for (; entry; i=0, oentry = &entry->hent_next, entry = entry->hent_next) { + if (entry->hent_hash != hash) /* strings can't be equal */ + continue; + if (strNE(entry->hent_key,key)) /* is this it? */ + continue; + safefree((char*)entry->hent_val); + safefree(entry->hent_key); + *oentry = entry->hent_next; + safefree((char*)entry); + if (i) + tb->tbl_fill--; + return TRUE; + } + return FALSE; +} +#endif + +hsplit(tb) +HASH *tb; +{ + int oldsize = tb->tbl_max + 1; + register int newsize = oldsize * 2; + register int i; + register HENT **a; + register HENT **b; + register HENT *entry; + register HENT **oentry; + + a = (HENT**) saferealloc((char*)tb->tbl_array, newsize * sizeof(HENT*)); + bzero((char*)&a[oldsize], oldsize * sizeof(HENT*)); /* zero second half */ + tb->tbl_max = --newsize; + tb->tbl_array = a; + + for (i=0; i<oldsize; i++,a++) { + if (!*a) /* non-existent */ + continue; + b = a+oldsize; + for (oentry = a, entry = *a; entry; entry = *oentry) { + if ((entry->hent_hash & newsize) != i) { + *oentry = entry->hent_next; + entry->hent_next = *b; + if (!*b) + tb->tbl_fill++; + *b = entry; + continue; + } + else + oentry = &entry->hent_next; + } + if (!*a) /* everything moved */ + tb->tbl_fill--; + } +} + +HASH * +hnew() +{ + register HASH *tb = (HASH*)safemalloc(sizeof(HASH)); + + tb->tbl_array = (HENT**) safemalloc(8 * sizeof(HENT*)); + tb->tbl_fill = 0; + tb->tbl_max = 7; + hiterinit(tb); /* so each() will start off right */ + bzero((char*)tb->tbl_array, 8 * sizeof(HENT*)); + return tb; +} + +#ifdef NOTUSED +hshow(tb) +register HASH *tb; +{ + fprintf(stderr,"%5d %4d (%2d%%)\n", + tb->tbl_max+1, + tb->tbl_fill, + tb->tbl_fill * 100 / (tb->tbl_max+1)); +} +#endif + +hiterinit(tb) +register HASH *tb; +{ + tb->tbl_riter = -1; + tb->tbl_eiter = Null(HENT*); + return tb->tbl_fill; +} + +HENT * +hiternext(tb) +register HASH *tb; +{ + register HENT *entry; + + entry = tb->tbl_eiter; + do { + if (entry) + entry = entry->hent_next; + if (!entry) { + tb->tbl_riter++; + if (tb->tbl_riter > tb->tbl_max) { + tb->tbl_riter = -1; + break; + } + entry = tb->tbl_array[tb->tbl_riter]; + } + } while (!entry); + + tb->tbl_eiter = entry; + return entry; +} + +char * +hiterkey(entry) +register HENT *entry; +{ + return entry->hent_key; +} + +STR * +hiterval(entry) +register HENT *entry; +{ + return entry->hent_val; +} diff --git a/x2p/hash.h b/x2p/hash.h new file mode 100644 index 0000000000..06d803a12d --- /dev/null +++ b/x2p/hash.h @@ -0,0 +1,49 @@ +/* $Header: hash.h,v 1.0 87/12/18 13:07:23 root Exp $ + * + * $Log: hash.h,v $ + * Revision 1.0 87/12/18 13:07:23 root + * Initial revision + * + */ + +#define FILLPCT 60 /* don't make greater than 99 */ + +#ifdef DOINIT +char coeff[] = { + 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, + 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, + 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, + 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, + 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, + 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, + 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, + 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1}; +#else +extern char coeff[]; +#endif + +typedef struct hentry HENT; + +struct hentry { + HENT *hent_next; + char *hent_key; + STR *hent_val; + int hent_hash; +}; + +struct htbl { + HENT **tbl_array; + int tbl_max; + int tbl_fill; + int tbl_riter; /* current root of iterator */ + HENT *tbl_eiter; /* current entry of iterator */ +}; + +STR *hfetch(); +bool hstore(); +bool hdelete(); +HASH *hnew(); +int hiterinit(); +HENT *hiternext(); +char *hiterkey(); +STR *hiterval(); diff --git a/x2p/s2p b/x2p/s2p new file mode 100644 index 0000000000..6c50cd2a11 --- /dev/null +++ b/x2p/s2p @@ -0,0 +1,551 @@ +#!/bin/perl + +$indent = 4; +$shiftwidth = 4; +$l = '{'; $r = '}'; +$tempvar = '1'; + +while ($ARGV[0] =~ '^-') { + $_ = shift; + last if /^--/; + if (/^-D/) { + $debug++; + open(body,'>-'); + next; + } + if (/^-n/) { + $assumen++; + next; + } + if (/^-p/) { + $assumep++; + next; + } + die "I don't recognize this switch: $_"; +} + +unless ($debug) { + open(body,">/tmp/sperl$$") || do Die("Can't open temp file."); +} + +if (!$assumen && !$assumep) { + print body +'while ($ARGV[0] =~ /^-/) { + $_ = shift; + last if /^--/; + if (/^-n/) { + $nflag++; + next; + } + die "I don\'t recognize this switch: $_"; +} + +'; +} + +print body ' +#ifdef PRINTIT +#ifdef ASSUMEP +$printit++; +#else +$printit++ unless $nflag; +#endif +#endif +line: while (<>) { +'; + +line: while (<>) { + s/[ \t]*(.*)\n$/$1/; + if (/^:/) { + s/^:[ \t]*//; + $label = do make_label($_); + if ($. == 1) { + $toplabel = $label; + } + $_ = "$label:"; + if ($lastlinewaslabel++) {$_ .= "\t;";} + if ($indent >= 2) { + $indent -= 2; + $indmod = 2; + } + next; + } else { + $lastlinewaslabel = ''; + } + $addr1 = ''; + $addr2 = ''; + if (s/^([0-9]+)//) { + $addr1 = "$1"; + } + elsif (s/^\$//) { + $addr1 = 'eof()'; + } + elsif (s|^/||) { + $addr1 = '/'; + delim: while (s:^([^(|)\\/]*)([(|)\\/])::) { + $prefix = $1; + $delim = $2; + if ($delim eq '\\') { + s/(.)(.*)/$2/; + $ch = $1; + $delim = '' if index("(|)",$ch) >= 0; + $delim .= $1; + } + elsif ($delim ne '/') { + $delim = '\\' . $delim; + } + $addr1 .= $prefix; + $addr1 .= $delim; + if ($delim eq '/') { + last delim; + } + } + } + if (s/^,//) { + if (s/^([0-9]+)//) { + $addr2 = "$1"; + } elsif (s/^\$//) { + $addr2 = "eof()"; + } elsif (s|^/||) { + $addr2 = '/'; + delim: while (s:^([^(|)\\/]*)([(|)\\/])::) { + $prefix = $1; + $delim = $2; + if ($delim eq '\\') { + s/(.)(.*)/$2/; + $ch = $1; + $delim = '' if index("(|)",$ch) >= 0; + $delim .= $1; + } + elsif ($delim ne '/') { + $delim = '\\' . $delim; + } + $addr2 .= $prefix; + $addr2 .= $delim; + if ($delim eq '/') { + last delim; + } + } + } else { + do Die("Invalid second address at line $.: $_"); + } + $addr1 .= " .. $addr2"; + } + # a { to keep vi happy + if ($_ eq '}') { + $indent -= 4; + next; + } + if (s/^!//) { + $if = 'unless'; + $else = "$r else $l\n"; + } else { + $if = 'if'; + $else = ''; + } + if (s/^{//) { # a } to keep vi happy + $indmod = 4; + $redo = $_; + $_ = ''; + $rmaybe = ''; + } else { + $rmaybe = "\n$r"; + if ($addr2 || $addr1) { + $space = substr(' ',0,$shiftwidth); + } else { + $space = ''; + } + $_ = do transmogrify(); + } + + if ($addr1) { + if ($_ !~ /[\n{}]/ && $rmaybe && !$change && + $_ !~ / if / && $_ !~ / unless /) { + s/;$/ $if $addr1;/; + $_ = substr($_,$shiftwidth,1000); + } else { + $command = $_; + $_ = "$if ($addr1) $l\n$change$command$rmaybe"; + } + $change = ''; + next line; + } +} continue { + @lines = split(/\n/,$_); + while ($#lines >= 0) { + $_ = shift(lines); + unless (s/^ *<<--//) { + print body substr("\t\t\t\t\t\t\t\t\t\t\t\t",0,$indent / 8), + substr(' ',0,$indent % 8); + } + print body $_, "\n"; + } + $indent += $indmod; + $indmod = 0; + if ($redo) { + $_ = $redo; + $redo = ''; + redo line; + } +} + +print body "}\n"; +if ($appendseen || $tseen || !$assumen) { + $printit++ if $dseen || (!$assumen && !$assumep); + print body ' +continue { +#ifdef PRINTIT +#ifdef DSEEN +#ifdef ASSUMEP + print if $printit++; +#else + if ($printit) { print;} else { $printit++ unless $nflag; } +#endif +#else + print if $printit; +#endif +#else + print; +#endif +#ifdef TSEEN + $tflag = \'\'; +#endif +#ifdef APPENDSEEN + if ($atext) { print $atext; $atext = \'\'; } +#endif +} +'; +} + +close body; + +unless ($debug) { + open(head,">/tmp/sperl2$$") || do Die("Can't open temp file 2.\n"); + print head "#define PRINTIT\n" if ($printit); + print head "#define APPENDSEEN\n" if ($appendseen); + print head "#define TSEEN\n" if ($tseen); + print head "#define DSEEN\n" if ($dseen); + print head "#define ASSUMEN\n" if ($assumen); + print head "#define ASSUMEP\n" if ($assumep); + if ($opens) {print head "$opens\n";} + open(body,"/tmp/sperl$$") || do Die("Can't reopen temp file."); + while (<body>) { + print head $_; + } + close head; + + print "#!/bin/perl\n\n"; + open(body,"cc -E /tmp/sperl2$$ |") || + do Die("Can't reopen temp file."); + while (<body>) { + /^# [0-9]/ && next; + /^[ \t]*$/ && next; + s/^<><>//; + print; + } +} + +`/bin/rm -f /tmp/sperl$$ /tmp/sperl2$$`; + +sub Die { + `/bin/rm -f /tmp/sperl$$ /tmp/sperl2$$`; + die $_[0]; +} +sub make_filehandle { + $fname = $_ = $_[0]; + s/[^a-zA-Z]/_/g; + s/^_*//; + if (/^([a-z])([a-z]*)$/) { + $first = $1; + $rest = $2; + $first =~ y/a-z/A-Z/; + $_ = $first . $rest; + } + if (!$seen{$_}) { + $opens .= "open($_,'>$fname') || die \"Can't create $fname.\";\n"; + } + $seen{$_} = $_; +} + +sub make_label { + $label = $_[0]; + $label =~ s/[^a-zA-Z0-9]/_/g; + if ($label =~ /^[0-9_]/) { $label = 'L' . $label; } + $label = substr($label,0,8); + if ($label =~ /^([a-z])([a-z]*)$/) { + $first = $1; + $rest = $2; + $first =~ y/a-z/A-Z/; + $label = $first . $rest; + } + $label; +} + +sub transmogrify { + { # case + if (/^d/) { + $dseen++; + $_ = ' +<<--#ifdef PRINTIT +$printit = \'\'; +<<--#endif +next line;'; + next; + } + + if (/^n/) { + $_ = +'<<--#ifdef PRINTIT +<<--#ifdef DSEEN +<<--#ifdef ASSUMEP +print if $printit++; +<<--#else +if ($printit) { print;} else { $printit++ unless $nflag; } +<<--#endif +<<--#else +print if $printit; +<<--#endif +<<--#else +print; +<<--#endif +<<--#ifdef APPENDSEEN +if ($atext) {print $atext; $atext = \'\';} +<<--#endif +$_ = <>; +<<--#ifdef TSEEN +$tflag = \'\'; +<<--#endif'; + next; + } + + if (/^a/) { + $appendseen++; + $command = $space . '$atext .=' . "\n<<--'"; + $lastline = 0; + while (<>) { + s/^[ \t]*//; + s/^[\\]//; + unless (s|\\$||) { $lastline = 1;} + s/'/\\'/g; + s/^([ \t]*\n)/<><>$1/; + $command .= $_; + $command .= '<<--'; + last if $lastline; + } + $_ = $command . "';"; + last; + } + + if (/^[ic]/) { + if (/^c/) { $change = 1; } + $addr1 = '$iter = (' . $addr1 . ')'; + $command = $space . 'if ($iter == 1) { print' . "\n<<--'"; + $lastline = 0; + while (<>) { + s/^[ \t]*//; + s/^[\\]//; + unless (s/\\$//) { $lastline = 1;} + s/'/\\'/g; + s/^([ \t]*\n)/<><>$1/; + $command .= $_; + $command .= '<<--'; + last if $lastline; + } + $_ = $command . "';}"; + if ($change) { + $dseen++; + $change = "$_\n"; + $_ = " +<<--#ifdef PRINTIT +$space\$printit = ''; +<<--#endif +${space}next line;"; + } + last; + } + + if (/^s/) { + $delim = substr($_,1,1); + $len = length($_); + $repl = $end = 0; + for ($i = 2; $i < $len; $i++) { + $c = substr($_,$i,1); + if ($c eq '\\') { + $i++; + if ($i >= $len) { + $_ .= 'n'; + $_ .= <>; + $len = length($_); + $_ = substr($_,0,--$len); + } + elsif (!$repl && index("(|)",substr($_,$i,1)) >= 0) { + $i--; + $len--; + $_ = substr($_,0,$i) . substr($_,$i+1,10000); + } + } + elsif ($c eq $delim) { + if ($repl) { + $end = $i; + last; + } else { + $repl = $i; + } + } + elsif (!$repl && index("(|)",$c) >= 0) { + $_ = substr($_,0,$i) . '\\' . substr($_,$i,10000); + $i++; + $len++; + } + } + print "repl $repl end $end $_\n"; + do Die("Malformed substitution at line $.") unless $end; + $pat = substr($_, 0, $repl + 1); + $repl = substr($_, $repl + 1, $end - $repl - 1); + $end = substr($_, $end + 1, 1000); + $dol = '$'; + $repl =~ s'&'$&'g; + $repl =~ s/[\\]([0-9])/$dol$1/g; + $subst = "$pat$repl$delim"; + $cmd = ''; + while ($end) { + if ($end =~ s/^g//) { $subst .= 'g'; next; } + if ($end =~ s/^p//) { $cmd .= ' && (print)'; next; } + if ($end =~ s/^w[ \t]*//) { + $fh = do make_filehandle($end); + $cmd .= " && (print $fh \$_)"; + $end = ''; + next; + } + do Die("Unrecognized substitution command ($end) at line $."); + } + $_ = $subst . $cmd . ';'; + next; + } + + if (/^p/) { + $_ = 'print;'; + next; + } + + if (/^w/) { + s/^w[ \t]*//; + $fh = do make_filehandle($_); + $_ = "print $fh \$_;"; + next; + } + + if (/^r/) { + $appendseen++; + s/^r[ \t]*//; + $file = $_; + $_ = "\$atext .= `cat $file 2>/dev/null`;"; + next; + } + + if (/^P/) { + $_ = +'if (/(^[^\n]*\n)/) { + print $1; +}'; + next; + } + + if (/^D/) { + $_ = +'s/^[^\n]*\n//; +if ($_) {redo line;} +next line;'; + next; + } + + if (/^N/) { + $_ = ' +$_ .= <>; +<<--#ifdef TSEEN +$tflag = \'\'; +<<--#endif'; + next; + } + + if (/^h/) { + $_ = '$hold = $_;'; + next; + } + + if (/^H/) { + $_ = '$hold .= $_ ? $_ : "\n";'; + next; + } + + if (/^g/) { + $_ = '$_ = $hold;'; + next; + } + + if (/^G/) { + $_ = '$_ .= $hold ? $hold : "\n";'; + next; + } + + if (/^x/) { + $_ = '($_, $hold) = ($hold, $_);'; + next; + } + + if (/^b$/) { + $_ = 'next line;'; + next; + } + + if (/^b/) { + s/^b[ \t]*//; + $lab = do make_label($_); + if ($lab eq $toplabel) { + $_ = 'redo line;'; + } else { + $_ = "goto $lab;"; + } + next; + } + + if (/^t$/) { + $_ = 'next line if $tflag;'; + $tseen++; + next; + } + + if (/^t/) { + s/^t[ \t]*//; + $lab = do make_label($_); + if ($lab eq $toplabel) { + $_ = 'if ($tflag) {$tflag = \'\'; redo line;}'; + } else { + $_ = "if (\$tflag) {\$tflag = ''; goto $lab;}"; + } + $tseen++; + next; + } + + if (/^=/) { + $_ = 'print "$.\n";'; + next; + } + + if (/^q/) { + $_ = +'close(ARGV); +@ARGV = (); +next line;'; + next; + } + } continue { + if ($space) { + s/^/$space/; + s/(\n)(.)/$1$space$2/g; + } + last; + } + $_; +} + diff --git a/x2p/s2p.man b/x2p/s2p.man new file mode 100644 index 0000000000..6db8a8e7aa --- /dev/null +++ b/x2p/s2p.man @@ -0,0 +1,94 @@ +.rn '' }` +''' $Header: s2p.man,v 1.0 87/12/18 17:37:16 root Exp $ +''' +''' $Log: s2p.man,v $ +''' Revision 1.0 87/12/18 17:37:16 root +''' Initial revision +''' +''' +.de Sh +.br +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp +.if t .sp .5v +.if n .sp +.. +.de Ip +.br +.ie \\n.$>=3 .ne \\$3 +.el .ne 3 +.IP "\\$1" \\$2 +.. +''' +''' Set up \*(-- to give an unbreakable dash; +''' string Tr holds user defined translation string. +''' Bell System Logo is used as a dummy character. +''' +.tr \(bs-|\(bv\*(Tr +.ie n \{\ +.ds -- \(bs- +.if (\n(.H=4u)&(1m=24u) .ds -- \(bs\h'-12u'\(bs\h'-12u'-\" diablo 10 pitch +.if (\n(.H=4u)&(1m=20u) .ds -- \(bs\h'-12u'\(bs\h'-8u'-\" diablo 12 pitch +.ds L" "" +.ds R" "" +.ds L' ' +.ds R' ' +'br\} +.el\{\ +.ds -- \(em\| +.tr \*(Tr +.ds L" `` +.ds R" '' +.ds L' ` +.ds R' ' +'br\} +.TH S2P 1 NEW +.SH NAME +s2p - Sed to Perl translator +.SH SYNOPSIS +.B s2p [options] filename +.SH DESCRIPTION +.I S2p +takes a sed script specified on the command line (or from standard input) +and produces a comparable +.I perl +script on the standard output. +.Sh "Options" +Options include: +.TP 5 +.B \-D<number> +sets debugging flags. +.TP 5 +.B \-n +specifies that this sed script was always invoked with a sed -n. +Otherwise a switch parser is prepended to the front of the script. +.TP 5 +.B \-p +specifies that this sed script was never invoked with a sed -n. +Otherwise a switch parser is prepended to the front of the script. +.Sh "Considerations" +The perl script produced looks very sed-ish, and there may very well be +better ways to express what you want to do in perl. +For instance, s2p does not make any use of the split operator, but you might +want to. +.PP +The perl script you end up with may be either faster or slower than the original +sed script. +If you're only interested in speed you'll just have to try it both ways. +Of course, if you want to do something sed doesn't do, you have no choice. +.SH ENVIRONMENT +S2p uses no environment variables. +.SH AUTHOR +Larry Wall <lwall@jpl-devvax.Jpl.Nasa.Gov> +.SH FILES +.SH SEE ALSO +perl The perl compiler/interpreter +.br +a2p awk to perl translator +.SH DIAGNOSTICS +.SH BUGS +.rn }` '' diff --git a/x2p/str.c b/x2p/str.c new file mode 100644 index 0000000000..5de045a3be --- /dev/null +++ b/x2p/str.c @@ -0,0 +1,451 @@ +/* $Header: str.c,v 1.0 87/12/18 13:07:26 root Exp $ + * + * $Log: str.c,v $ + * Revision 1.0 87/12/18 13:07:26 root + * Initial revision + * + */ + +#include "handy.h" +#include "EXTERN.h" +#include "util.h" +#include "a2p.h" + +str_numset(str,num) +register STR *str; +double num; +{ + str->str_nval = num; + str->str_pok = 0; /* invalidate pointer */ + str->str_nok = 1; /* validate number */ +} + +char * +str_2ptr(str) +register STR *str; +{ + register char *s; + + if (!str) + return ""; + GROWSTR(&(str->str_ptr), &(str->str_len), 24); + s = str->str_ptr; + if (str->str_nok) { + sprintf(s,"%.20g",str->str_nval); + while (*s) s++; + } + *s = '\0'; + str->str_cur = s - str->str_ptr; + str->str_pok = 1; +#ifdef DEBUGGING + if (debug & 32) + fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr); +#endif + return str->str_ptr; +} + +double +str_2num(str) +register STR *str; +{ + if (!str) + return 0.0; + if (str->str_len && str->str_pok) + str->str_nval = atof(str->str_ptr); + else + str->str_nval = 0.0; + str->str_nok = 1; +#ifdef DEBUGGING + if (debug & 32) + fprintf(stderr,"0x%lx num(%g)\n",str,str->str_nval); +#endif + return str->str_nval; +} + +str_sset(dstr,sstr) +STR *dstr; +register STR *sstr; +{ + if (!sstr) + str_nset(dstr,No,0); + else if (sstr->str_nok) + str_numset(dstr,sstr->str_nval); + else if (sstr->str_pok) + str_nset(dstr,sstr->str_ptr,sstr->str_cur); + else + str_nset(dstr,"",0); +} + +str_nset(str,ptr,len) +register STR *str; +register char *ptr; +register int len; +{ + GROWSTR(&(str->str_ptr), &(str->str_len), len + 1); + bcopy(ptr,str->str_ptr,len); + str->str_cur = len; + *(str->str_ptr+str->str_cur) = '\0'; + str->str_nok = 0; /* invalidate number */ + str->str_pok = 1; /* validate pointer */ +} + +str_set(str,ptr) +register STR *str; +register char *ptr; +{ + register int len; + + if (!ptr) + ptr = ""; + len = strlen(ptr); + GROWSTR(&(str->str_ptr), &(str->str_len), len + 1); + bcopy(ptr,str->str_ptr,len+1); + str->str_cur = len; + str->str_nok = 0; /* invalidate number */ + str->str_pok = 1; /* validate pointer */ +} + +str_chop(str,ptr) /* like set but assuming ptr is in str */ +register STR *str; +register char *ptr; +{ + if (!(str->str_pok)) + str_2ptr(str); + str->str_cur -= (ptr - str->str_ptr); + bcopy(ptr,str->str_ptr, str->str_cur + 1); + str->str_nok = 0; /* invalidate number */ + str->str_pok = 1; /* validate pointer */ +} + +str_ncat(str,ptr,len) +register STR *str; +register char *ptr; +register int len; +{ + if (!(str->str_pok)) + str_2ptr(str); + GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1); + bcopy(ptr,str->str_ptr+str->str_cur,len); + str->str_cur += len; + *(str->str_ptr+str->str_cur) = '\0'; + str->str_nok = 0; /* invalidate number */ + str->str_pok = 1; /* validate pointer */ +} + +str_scat(dstr,sstr) +STR *dstr; +register STR *sstr; +{ + if (!(sstr->str_pok)) + str_2ptr(sstr); + if (sstr) + str_ncat(dstr,sstr->str_ptr,sstr->str_cur); +} + +str_cat(str,ptr) +register STR *str; +register char *ptr; +{ + register int len; + + if (!ptr) + return; + if (!(str->str_pok)) + str_2ptr(str); + len = strlen(ptr); + GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1); + bcopy(ptr,str->str_ptr+str->str_cur,len+1); + str->str_cur += len; + str->str_nok = 0; /* invalidate number */ + str->str_pok = 1; /* validate pointer */ +} + +char * +str_append_till(str,from,delim,keeplist) +register STR *str; +register char *from; +register int delim; +char *keeplist; +{ + register char *to; + register int len; + + if (!from) + return Nullch; + len = strlen(from); + GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1); + str->str_nok = 0; /* invalidate number */ + str->str_pok = 1; /* validate pointer */ + to = str->str_ptr+str->str_cur; + for (; *from; from++,to++) { + if (*from == '\\' && from[1] && delim != '\\') { + if (!keeplist) { + if (from[1] == delim || from[1] == '\\') + from++; + else + *to++ = *from++; + } + else if (index(keeplist,from[1])) + *to++ = *from++; + else + from++; + } + else if (*from == delim) + break; + *to = *from; + } + *to = '\0'; + str->str_cur = to - str->str_ptr; + return from; +} + +STR * +str_new(len) +int len; +{ + register STR *str; + + if (freestrroot) { + str = freestrroot; + freestrroot = str->str_link.str_next; + } + else { + str = (STR *) safemalloc(sizeof(STR)); + bzero((char*)str,sizeof(STR)); + } + if (len) + GROWSTR(&(str->str_ptr), &(str->str_len), len + 1); + return str; +} + +void +str_grow(str,len) +register STR *str; +int len; +{ + if (len && str) + GROWSTR(&(str->str_ptr), &(str->str_len), len + 1); +} + +/* make str point to what nstr did */ + +void +str_replace(str,nstr) +register STR *str; +register STR *nstr; +{ + safefree(str->str_ptr); + str->str_ptr = nstr->str_ptr; + str->str_len = nstr->str_len; + str->str_cur = nstr->str_cur; + str->str_pok = nstr->str_pok; + if (str->str_nok = nstr->str_nok) + str->str_nval = nstr->str_nval; + safefree((char*)nstr); +} + +void +str_free(str) +register STR *str; +{ + if (!str) + return; + if (str->str_len) + str->str_ptr[0] = '\0'; + str->str_cur = 0; + str->str_nok = 0; + str->str_pok = 0; + str->str_link.str_next = freestrroot; + freestrroot = str; +} + +str_len(str) +register STR *str; +{ + if (!str) + return 0; + if (!(str->str_pok)) + str_2ptr(str); + if (str->str_len) + return str->str_cur; + else + return 0; +} + +char * +str_gets(str,fp) +register STR *str; +register FILE *fp; +{ +#ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */ + + register char *bp; /* we're going to steal some values */ + register int cnt; /* from the stdio struct and put EVERYTHING */ + register char *ptr; /* in the innermost loop into registers */ + register char newline = '\n'; /* (assuming at least 6 registers) */ + int i; + int bpx; + + cnt = fp->_cnt; /* get count into register */ + str->str_nok = 0; /* invalidate number */ + str->str_pok = 1; /* validate pointer */ + if (str->str_len <= cnt) /* make sure we have the room */ + GROWSTR(&(str->str_ptr), &(str->str_len), cnt+1); + bp = str->str_ptr; /* move these two too to registers */ + ptr = fp->_ptr; + for (;;) { + while (--cnt >= 0) { /* this */ /* eat */ + if ((*bp++ = *ptr++) == newline) /* really */ /* dust */ + goto thats_all_folks; /* screams */ /* sed :-) */ + } + + fp->_cnt = cnt; /* deregisterize cnt and ptr */ + fp->_ptr = ptr; + i = _filbuf(fp); /* get more characters */ + cnt = fp->_cnt; + ptr = fp->_ptr; /* reregisterize cnt and ptr */ + + bpx = bp - str->str_ptr; /* prepare for possible relocation */ + GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + cnt + 1); + bp = str->str_ptr + bpx; /* reconstitute our pointer */ + + if (i == newline) { /* all done for now? */ + *bp++ = i; + goto thats_all_folks; + } + else if (i == EOF) /* all done for ever? */ + goto thats_all_folks; + *bp++ = i; /* now go back to screaming loop */ + } + +thats_all_folks: + fp->_cnt = cnt; /* put these back or we're in trouble */ + fp->_ptr = ptr; + *bp = '\0'; + str->str_cur = bp - str->str_ptr; /* set length */ + +#else /* !STDSTDIO */ /* The big, slow, and stupid way */ + + static char buf[4192]; + + if (fgets(buf, sizeof buf, fp) != Nullch) + str_set(str, buf); + else + str_set(str, No); + +#endif /* STDSTDIO */ + + return str->str_cur ? str->str_ptr : Nullch; +} + +void +str_inc(str) +register STR *str; +{ + register char *d; + + if (!str) + return; + if (str->str_nok) { + str->str_nval += 1.0; + str->str_pok = 0; + return; + } + if (!str->str_pok) { + str->str_nval = 1.0; + str->str_nok = 1; + return; + } + for (d = str->str_ptr; *d && *d != '.'; d++) ; + d--; + if (!isdigit(*str->str_ptr) || !isdigit(*d) ) { + str_numset(str,atof(str->str_ptr) + 1.0); /* punt */ + return; + } + while (d >= str->str_ptr) { + if (++*d <= '9') + return; + *(d--) = '0'; + } + /* oh,oh, the number grew */ + GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + 2); + str->str_cur++; + for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--) + *d = d[-1]; + *d = '1'; +} + +void +str_dec(str) +register STR *str; +{ + register char *d; + + if (!str) + return; + if (str->str_nok) { + str->str_nval -= 1.0; + str->str_pok = 0; + return; + } + if (!str->str_pok) { + str->str_nval = -1.0; + str->str_nok = 1; + return; + } + for (d = str->str_ptr; *d && *d != '.'; d++) ; + d--; + if (!isdigit(*str->str_ptr) || !isdigit(*d) || (*d == '0' && d == str->str_ptr)) { + str_numset(str,atof(str->str_ptr) - 1.0); /* punt */ + return; + } + while (d >= str->str_ptr) { + if (--*d >= '0') + return; + *(d--) = '9'; + } +} + +/* make a string that will exist for the duration of the expression eval */ + +STR * +str_static(oldstr) +STR *oldstr; +{ + register STR *str = str_new(0); + static long tmps_size = -1; + + str_sset(str,oldstr); + if (++tmps_max > tmps_size) { + tmps_size = tmps_max; + if (!(tmps_size & 127)) { + if (tmps_size) + tmps_list = (STR**)saferealloc((char*)tmps_list, + (tmps_size + 128) * sizeof(STR*) ); + else + tmps_list = (STR**)safemalloc(128 * sizeof(char*)); + } + } + tmps_list[tmps_max] = str; + return str; +} + +STR * +str_make(s) +char *s; +{ + register STR *str = str_new(0); + + str_set(str,s); + return str; +} + +STR * +str_nmake(n) +double n; +{ + register STR *str = str_new(0); + + str_numset(str,n); + return str; +} diff --git a/x2p/str.h b/x2p/str.h new file mode 100644 index 0000000000..cbb0c77759 --- /dev/null +++ b/x2p/str.h @@ -0,0 +1,35 @@ +/* $Header: str.h,v 1.0 87/12/18 13:07:30 root Exp $ + * + * $Log: str.h,v $ + * Revision 1.0 87/12/18 13:07:30 root + * Initial revision + * + */ + +struct string { + char * str_ptr; /* pointer to malloced string */ + double str_nval; /* numeric value, if any */ + int str_len; /* allocated size */ + int str_cur; /* length of str_ptr as a C string */ + union { + STR *str_next; /* while free, link to next free str */ + } str_link; + char str_pok; /* state of str_ptr */ + char str_nok; /* state of str_nval */ +}; + +#define Nullstr Null(STR*) + +/* the following macro updates any magic values this str is associated with */ + +#define STABSET(x) (x->str_link.str_magic && stabset(x->str_link.str_magic,x)) + +EXT STR **tmps_list; +EXT long tmps_max INIT(-1); + +char *str_2ptr(); +double str_2num(); +STR *str_static(); +STR *str_make(); +STR *str_nmake(); +char *str_gets(); diff --git a/x2p/util.c b/x2p/util.c new file mode 100644 index 0000000000..83adfc276b --- /dev/null +++ b/x2p/util.c @@ -0,0 +1,275 @@ +/* $Header: util.c,v 1.0 87/12/18 13:07:34 root Exp $ + * + * $Log: util.c,v $ + * Revision 1.0 87/12/18 13:07:34 root + * Initial revision + * + */ + +#include <stdio.h> + +#include "handy.h" +#include "EXTERN.h" +#include "a2p.h" +#include "INTERN.h" +#include "util.h" + +#define FLUSH +#define MEM_SIZE unsigned int + +static char nomem[] = "Out of memory!\n"; + +/* paranoid version of malloc */ + +static int an = 0; + +char * +safemalloc(size) +MEM_SIZE size; +{ + char *ptr; + char *malloc(); + + ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */ +#ifdef DEBUGGING + if (debug & 128) + fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size); +#endif + if (ptr != Nullch) + return ptr; + else { + fputs(nomem,stdout) FLUSH; + exit(1); + } + /*NOTREACHED*/ +} + +/* paranoid version of realloc */ + +char * +saferealloc(where,size) +char *where; +MEM_SIZE size; +{ + char *ptr; + char *realloc(); + + ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */ +#ifdef DEBUGGING + if (debug & 128) { + fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++); + fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size); + } +#endif + if (ptr != Nullch) + return ptr; + else { + fputs(nomem,stdout) FLUSH; + exit(1); + } + /*NOTREACHED*/ +} + +/* safe version of free */ + +safefree(where) +char *where; +{ +#ifdef DEBUGGING + if (debug & 128) + fprintf(stderr,"0x%x: (%05d) free\n",where,an++); +#endif + free(where); +} + +/* safe version of string copy */ + +char * +safecpy(to,from,len) +char *to; +register char *from; +register int len; +{ + register char *dest = to; + + if (from != Nullch) + for (len--; len && (*dest++ = *from++); len--) ; + *dest = '\0'; + return to; +} + +#ifdef undef +/* safe version of string concatenate, with \n deletion and space padding */ + +char * +safecat(to,from,len) +char *to; +register char *from; +register int len; +{ + register char *dest = to; + + len--; /* leave room for null */ + if (*dest) { + while (len && *dest++) len--; + if (len) { + len--; + *(dest-1) = ' '; + } + } + if (from != Nullch) + while (len && (*dest++ = *from++)) len--; + if (len) + dest--; + if (*(dest-1) == '\n') + dest--; + *dest = '\0'; + return to; +} +#endif + +/* copy a string up to some (non-backslashed) delimiter, if any */ + +char * +cpytill(to,from,delim) +register char *to, *from; +register int delim; +{ + for (; *from; from++,to++) { + if (*from == '\\' && from[1] == delim) + *to++ = *from++; + else if (*from == delim) + break; + *to = *from; + } + *to = '\0'; + return from; +} + +char * +cpy2(to,from,delim) +register char *to, *from; +register int delim; +{ + for (; *from; from++,to++) { + if (*from == '\\' && from[1] == delim) + *to++ = *from++; + else if (*from == '$') + *to++ = '\\'; + else if (*from == delim) + break; + *to = *from; + } + *to = '\0'; + return from; +} + +/* return ptr to little string in big string, NULL if not found */ + +char * +instr(big, little) +char *big, *little; + +{ + register char *t, *s, *x; + + for (t = big; *t; t++) { + for (x=t,s=little; *s; x++,s++) { + if (!*x) + return Nullch; + if (*s != *x) + break; + } + if (!*s) + return t; + } + return Nullch; +} + +/* copy a string to a safe spot */ + +char * +savestr(str) +char *str; +{ + register char *newaddr = safemalloc((MEM_SIZE)(strlen(str)+1)); + + (void)strcpy(newaddr,str); + return newaddr; +} + +/* grow a static string to at least a certain length */ + +void +growstr(strptr,curlen,newlen) +char **strptr; +int *curlen; +int newlen; +{ + if (newlen > *curlen) { /* need more room? */ + if (*curlen) + *strptr = saferealloc(*strptr,(MEM_SIZE)newlen); + else + *strptr = safemalloc((MEM_SIZE)newlen); + *curlen = newlen; + } +} + +/*VARARGS1*/ +fatal(pat,a1,a2,a3,a4) +char *pat; +{ + fprintf(stderr,pat,a1,a2,a3,a4); + exit(1); +} + +static bool firstsetenv = TRUE; +extern char **environ; + +void +setenv(nam,val) +char *nam, *val; +{ + register int i=envix(nam); /* where does it go? */ + + if (!environ[i]) { /* does not exist yet */ + if (firstsetenv) { /* need we copy environment? */ + int j; +#ifndef lint + char **tmpenv = (char**) /* point our wand at memory */ + safemalloc((i+2) * sizeof(char*)); +#else + char **tmpenv = Null(char **); +#endif /* lint */ + + firstsetenv = FALSE; + for (j=0; j<i; j++) /* copy environment */ + tmpenv[j] = environ[j]; + environ = tmpenv; /* tell exec where it is now */ + } +#ifndef lint + else + environ = (char**) saferealloc((char*) environ, + (i+2) * sizeof(char*)); + /* just expand it a bit */ +#endif /* lint */ + environ[i+1] = Nullch; /* make sure it's null terminated */ + } + environ[i] = safemalloc(strlen(nam) + strlen(val) + 2); + /* this may or may not be in */ + /* the old environ structure */ + sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */ +} + +int +envix(nam) +char *nam; +{ + register int i, len = strlen(nam); + + for (i = 0; environ[i]; i++) { + if (strnEQ(environ[i],nam,len) && environ[i][len] == '=') + break; /* strnEQ must come first to avoid */ + } /* potential SEGV's */ + return i; +} diff --git a/x2p/util.h b/x2p/util.h new file mode 100644 index 0000000000..6249549221 --- /dev/null +++ b/x2p/util.h @@ -0,0 +1,37 @@ +/* $Header: util.h,v 1.0 87/12/18 13:07:37 root Exp $ + * + * $Log: util.h,v $ + * Revision 1.0 87/12/18 13:07:37 root + * Initial revision + * + */ + +/* is the string for makedir a directory name or a filename? */ + +#define MD_DIR 0 +#define MD_FILE 1 + +void util_init(); +int doshell(); +char *safemalloc(); +char *saferealloc(); +char *safecpy(); +char *safecat(); +char *cpytill(); +char *cpy2(); +char *instr(); +#ifdef SETUIDGID + int eaccess(); +#endif +char *getwd(); +void cat(); +void prexit(); +char *get_a_line(); +char *savestr(); +int makedir(); +void setenv(); +int envix(); +void notincl(); +char *getval(); +void growstr(); +void setdef(); diff --git a/x2p/walk.c b/x2p/walk.c new file mode 100644 index 0000000000..04d133b9c4 --- /dev/null +++ b/x2p/walk.c @@ -0,0 +1,1464 @@ +/* $Header: walk.c,v 1.0 87/12/18 13:07:40 root Exp $ + * + * $Log: walk.c,v $ + * Revision 1.0 87/12/18 13:07:40 root + * Initial revision + * + */ + +#include "handy.h" +#include "EXTERN.h" +#include "util.h" +#include "a2p.h" + +bool exitval = FALSE; +bool realexit = FALSE; +int maxtmp = 0; + +STR * +walk(useval,level,node,numericptr) +int useval; +int level; +register int node; +int *numericptr; +{ + register int len; + register STR *str; + register int type; + register int i; + register STR *tmpstr; + STR *tmp2str; + char *t; + char *d, *s; + int numarg; + int numeric = FALSE; + STR *fstr; + char *index(); + + if (!node) { + *numericptr = 0; + return str_make(""); + } + type = ops[node].ival; + len = type >> 8; + type &= 255; + switch (type) { + case OPROG: + str = walk(0,level,ops[node+1].ival,&numarg); + opens = str_new(0); + if (do_split && need_entire && !absmaxfld) + split_to_array = TRUE; + if (do_split && split_to_array) + set_array_base = TRUE; + if (set_array_base) { + str_cat(str,"$[ = 1;\t\t\t# set array base to 1\n"); + } + if (fswitch && !const_FS) + const_FS = fswitch; + if (saw_FS > 1 || saw_RS) + const_FS = 0; + if (saw_ORS && need_entire) + do_chop = TRUE; + if (fswitch) { + str_cat(str,"$FS = '"); + if (index("*+?.[]()|^$\\",fswitch)) + str_cat(str,"\\"); + sprintf(tokenbuf,"%c",fswitch); + str_cat(str,tokenbuf); + str_cat(str,"';\t\t# field separator from -F switch\n"); + } + else if (saw_FS && !const_FS) { + str_cat(str,"$FS = '[ \\t\\n]+';\t\t# default field separator\n"); + } + if (saw_OFS) { + str_cat(str,"$, = ' ';\t\t# default output field separator\n"); + } + if (saw_ORS) { + str_cat(str,"$\\ = \"\\n\";\t\t# default output record separator\n"); + } + if (str->str_cur > 20) + str_cat(str,"\n"); + if (ops[node+2].ival) { + str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg)); + str_free(fstr); + str_cat(str,"\n\n"); + } + if (saw_line_op) + str_cat(str,"line: "); + str_cat(str,"while (<>) {\n"); + tab(str,++level); + if (saw_FS && !const_FS) + do_chop = TRUE; + if (do_chop) { + str_cat(str,"chop;\t# strip record separator\n"); + tab(str,level); + } + arymax = 0; + if (namelist) { + while (isalpha(*namelist)) { + for (d = tokenbuf,s=namelist; + isalpha(*s) || isdigit(*s) || *s == '_'; + *d++ = *s++) ; + *d = '\0'; + while (*s && !isalpha(*s)) s++; + namelist = s; + nameary[++arymax] = savestr(tokenbuf); + } + } + if (maxfld < arymax) + maxfld = arymax; + if (do_split) + emit_split(str,level); + str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg)); + str_free(fstr); + fixtab(str,--level); + str_cat(str,"}\n"); + if (ops[node+4].ival) { + realexit = TRUE; + str_cat(str,"\n"); + tab(str,level); + str_scat(str,fstr=walk(0,level,ops[node+4].ival,&numarg)); + str_free(fstr); + str_cat(str,"\n"); + } + if (exitval) + str_cat(str,"exit ExitValue;\n"); + if (do_fancy_opens) { + str_cat(str,"\n\ +sub Pick {\n\ + ($name) = @_;\n\ + $fh = $opened{$name};\n\ + if (!$fh) {\n\ + $nextfh == 0 && open(fh_0,$name);\n\ + $nextfh == 1 && open(fh_1,$name);\n\ + $nextfh == 2 && open(fh_2,$name);\n\ + $nextfh == 3 && open(fh_3,$name);\n\ + $nextfh == 4 && open(fh_4,$name);\n\ + $nextfh == 5 && open(fh_5,$name);\n\ + $nextfh == 6 && open(fh_6,$name);\n\ + $nextfh == 7 && open(fh_7,$name);\n\ + $nextfh == 8 && open(fh_8,$name);\n\ + $nextfh == 9 && open(fh_9,$name);\n\ + $fh = $opened{$name} = 'fh_' . $nextfh++;\n\ + }\n\ + select($fh);\n\ +}\n\ +"); + } + break; + case OHUNKS: + str = walk(0,level,ops[node+1].ival,&numarg); + str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg)); + str_free(fstr); + if (len == 3) { + str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg)); + str_free(fstr); + } + else { + } + break; + case ORANGE: + str = walk(1,level,ops[node+1].ival,&numarg); + str_cat(str," .. "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + break; + case OPAT: + goto def; + case OREGEX: + str = str_new(0); + str_set(str,"/"); + tmpstr=walk(0,level,ops[node+1].ival,&numarg); + /* translate \nnn to [\nnn] */ + for (s = tmpstr->str_ptr, d = tokenbuf; *s; s++, d++) { + if (*s == '\\' && isdigit(s[1]) && isdigit(s[2]) && isdigit(s[3])) { + *d++ = '['; + *d++ = *s++; + *d++ = *s++; + *d++ = *s++; + *d++ = *s; + *d = ']'; + } + else + *d = *s; + } + *d = '\0'; + str_cat(str,tokenbuf); + str_free(tmpstr); + str_cat(str,"/"); + break; + case OHUNK: + if (len == 1) { + str = str_new(0); + str = walk(0,level,oper1(OPRINT,0),&numarg); + str_cat(str," if "); + str_scat(str,fstr=walk(0,level,ops[node+1].ival,&numarg)); + str_free(fstr); + str_cat(str,";"); + } + else { + tmpstr = walk(0,level,ops[node+1].ival,&numarg); + if (*tmpstr->str_ptr) { + str = str_new(0); + str_set(str,"if ("); + str_scat(str,tmpstr); + str_cat(str,") {\n"); + tab(str,++level); + str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg)); + str_free(fstr); + fixtab(str,--level); + str_cat(str,"}\n"); + tab(str,level); + } + else { + str = walk(0,level,ops[node+2].ival,&numarg); + } + } + break; + case OPPAREN: + str = str_new(0); + str_set(str,"("); + str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg)); + str_free(fstr); + str_cat(str,")"); + break; + case OPANDAND: + str = walk(1,level,ops[node+1].ival,&numarg); + str_cat(str," && "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + break; + case OPOROR: + str = walk(1,level,ops[node+1].ival,&numarg); + str_cat(str," || "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + break; + case OPNOT: + str = str_new(0); + str_set(str,"!"); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + break; + case OCPAREN: + str = str_new(0); + str_set(str,"("); + str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg)); + str_free(fstr); + numeric |= numarg; + str_cat(str,")"); + break; + case OCANDAND: + str = walk(1,level,ops[node+1].ival,&numarg); + numeric = 1; + str_cat(str," && "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + break; + case OCOROR: + str = walk(1,level,ops[node+1].ival,&numarg); + numeric = 1; + str_cat(str," || "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + break; + case OCNOT: + str = str_new(0); + str_set(str,"!"); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + numeric = 1; + break; + case ORELOP: + str = walk(1,level,ops[node+2].ival,&numarg); + numeric |= numarg; + tmpstr = walk(0,level,ops[node+1].ival,&numarg); + tmp2str = walk(1,level,ops[node+3].ival,&numarg); + numeric |= numarg; + if (!numeric) { + t = tmpstr->str_ptr; + if (strEQ(t,"==")) + str_set(tmpstr,"eq"); + else if (strEQ(t,"!=")) + str_set(tmpstr,"ne"); + else if (strEQ(t,"<")) + str_set(tmpstr,"lt"); + else if (strEQ(t,"<=")) + str_set(tmpstr,"le"); + else if (strEQ(t,">")) + str_set(tmpstr,"gt"); + else if (strEQ(t,">=")) + str_set(tmpstr,"ge"); + if (!index(tmpstr->str_ptr,'\'') && !index(tmpstr->str_ptr,'"') && + !index(tmp2str->str_ptr,'\'') && !index(tmp2str->str_ptr,'"') ) + numeric |= 2; + } + if (numeric & 2) { + if (numeric & 1) /* numeric is very good guess */ + str_cat(str," "); + else + str_cat(str,"\377"); + numeric = 1; + } + else + str_cat(str," "); + str_scat(str,tmpstr); + str_free(tmpstr); + str_cat(str," "); + str_scat(str,tmp2str); + str_free(tmp2str); + numeric = 1; + break; + case ORPAREN: + str = str_new(0); + str_set(str,"("); + str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg)); + str_free(fstr); + numeric |= numarg; + str_cat(str,")"); + break; + case OMATCHOP: + str = walk(1,level,ops[node+2].ival,&numarg); + str_cat(str," "); + tmpstr = walk(0,level,ops[node+1].ival,&numarg); + if (strEQ(tmpstr->str_ptr,"~")) + str_cat(str,"=~"); + else { + str_scat(str,tmpstr); + str_free(tmpstr); + } + str_cat(str," "); + str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg)); + str_free(fstr); + numeric = 1; + break; + case OMPAREN: + str = str_new(0); + str_set(str,"("); + str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg)); + str_free(fstr); + numeric |= numarg; + str_cat(str,")"); + break; + case OCONCAT: + str = walk(1,level,ops[node+1].ival,&numarg); + str_cat(str," . "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + break; + case OASSIGN: + str = walk(0,level,ops[node+2].ival,&numarg); + str_cat(str," "); + tmpstr = walk(0,level,ops[node+1].ival,&numarg); + str_scat(str,tmpstr); + if (str_len(tmpstr) > 1) + numeric = 1; + str_free(tmpstr); + str_cat(str," "); + str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg)); + str_free(fstr); + numeric |= numarg; + if (strEQ(str->str_ptr,"$FS = '\240'")) + str_set(str,"$FS = '[\240\\n\\t]+'"); + break; + case OADD: + str = walk(1,level,ops[node+1].ival,&numarg); + str_cat(str," + "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + numeric = 1; + break; + case OSUB: + str = walk(1,level,ops[node+1].ival,&numarg); + str_cat(str," - "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + numeric = 1; + break; + case OMULT: + str = walk(1,level,ops[node+1].ival,&numarg); + str_cat(str," * "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + numeric = 1; + break; + case ODIV: + str = walk(1,level,ops[node+1].ival,&numarg); + str_cat(str," / "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + numeric = 1; + break; + case OMOD: + str = walk(1,level,ops[node+1].ival,&numarg); + str_cat(str," % "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + numeric = 1; + break; + case OPOSTINCR: + str = walk(1,level,ops[node+1].ival,&numarg); + str_cat(str,"++"); + numeric = 1; + break; + case OPOSTDECR: + str = walk(1,level,ops[node+1].ival,&numarg); + str_cat(str,"--"); + numeric = 1; + break; + case OPREINCR: + str = str_new(0); + str_set(str,"++"); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + numeric = 1; + break; + case OPREDECR: + str = str_new(0); + str_set(str,"--"); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + numeric = 1; + break; + case OUMINUS: + str = str_new(0); + str_set(str,"-"); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + numeric = 1; + break; + case OUPLUS: + numeric = 1; + goto def; + case OPAREN: + str = str_new(0); + str_set(str,"("); + str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg)); + str_free(fstr); + str_cat(str,")"); + numeric |= numarg; + break; + case OGETLINE: + str = str_new(0); + str_set(str,"$_ = <>;\n"); + tab(str,level); + if (do_chop) { + str_cat(str,"chop;\t# strip record separator\n"); + tab(str,level); + } + if (do_split) + emit_split(str,level); + break; + case OSPRINTF: + str = str_new(0); + str_set(str,"sprintf("); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + str_cat(str,")"); + break; + case OSUBSTR: + str = str_new(0); + str_set(str,"substr("); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + str_cat(str,", "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + str_cat(str,", "); + if (len == 3) { + str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg)); + str_free(fstr); + } + else + str_cat(str,"999999"); + str_cat(str,")"); + break; + case OSTRING: + str = str_new(0); + str_set(str,ops[node+1].cval); + break; + case OSPLIT: + str = str_new(0); + numeric = 1; + tmpstr = walk(1,level,ops[node+2].ival,&numarg); + if (useval) + str_set(str,"(@"); + else + str_set(str,"@"); + str_scat(str,tmpstr); + str_cat(str," = split("); + if (len == 3) { + fstr = walk(1,level,ops[node+3].ival,&numarg); + if (str_len(fstr) == 3 && *fstr->str_ptr == '\'') { + i = fstr->str_ptr[1] & 127; + if (index("*+?.[]()|^$\\",i)) + sprintf(tokenbuf,"/\\%c/",i); + else + sprintf(tokenbuf,"/%c/",i); + str_cat(str,tokenbuf); + } + else + str_scat(str,fstr); + str_free(fstr); + } + else if (const_FS) { + sprintf(tokenbuf,"/[%c\\n]/",const_FS); + str_cat(str,tokenbuf); + } + else if (saw_FS) + str_cat(str,"$FS"); + else + str_cat(str,"/[ \\t\\n]+/"); + str_cat(str,", "); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + str_cat(str,")"); + if (useval) { + str_cat(str,")"); + } + str_free(tmpstr); + break; + case OINDEX: + str = str_new(0); + str_set(str,"index("); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + str_cat(str,", "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + str_cat(str,")"); + numeric = 1; + break; + case ONUM: + str = walk(1,level,ops[node+1].ival,&numarg); + numeric = 1; + break; + case OSTR: + tmpstr = walk(1,level,ops[node+1].ival,&numarg); + s = "'"; + for (t = tmpstr->str_ptr; *t; t++) { + if (*t == '\\' || *t == '\'') + s = "\""; + *t += 128; + } + str = str_new(0); + str_set(str,s); + str_scat(str,tmpstr); + str_free(tmpstr); + str_cat(str,s); + break; + case OVAR: + str = str_new(0); + str_set(str,"$"); + str_scat(str,tmpstr=walk(1,level,ops[node+1].ival,&numarg)); + if (len == 1) { + tmp2str = hfetch(symtab,tmpstr->str_ptr); + if (tmp2str && atoi(tmp2str->str_ptr)) + numeric = 2; + if (strEQ(str->str_ptr,"$NR")) { + numeric = 1; + str_set(str,"$."); + } + else if (strEQ(str->str_ptr,"$NF")) { + numeric = 1; + str_set(str,"$#Fld"); + } + else if (strEQ(str->str_ptr,"$0")) + str_set(str,"$_"); + } + else { + str_cat(tmpstr,"[]"); + tmp2str = hfetch(symtab,tmpstr->str_ptr); + if (tmp2str && atoi(tmp2str->str_ptr)) + str_cat(str,"["); + else + str_cat(str,"{"); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + if (tmp2str && atoi(tmp2str->str_ptr)) + strcpy(tokenbuf,"]"); + else + strcpy(tokenbuf,"}"); + *tokenbuf += 128; + str_cat(str,tokenbuf); + } + str_free(tmpstr); + break; + case OFLD: + str = str_new(0); + if (split_to_array) { + str_set(str,"$Fld"); + str_cat(str,"["); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + str_cat(str,"]"); + } + else { + i = atoi(walk(1,level,ops[node+1].ival,&numarg)->str_ptr); + if (i <= arymax) + sprintf(tokenbuf,"$%s",nameary[i]); + else + sprintf(tokenbuf,"$Fld%d",i); + str_set(str,tokenbuf); + } + break; + case OVFLD: + str = str_new(0); + str_set(str,"$Fld["); + i = ops[node+1].ival; + if ((ops[i].ival & 255) == OPAREN) + i = ops[i+1].ival; + tmpstr=walk(1,level,i,&numarg); + str_scat(str,tmpstr); + str_free(tmpstr); + str_cat(str,"]"); + break; + case OJUNK: + goto def; + case OSNEWLINE: + str = str_new(2); + str_set(str,";\n"); + tab(str,level); + break; + case ONEWLINE: + str = str_new(1); + str_set(str,"\n"); + tab(str,level); + break; + case OSCOMMENT: + str = str_new(0); + str_set(str,";"); + tmpstr = walk(0,level,ops[node+1].ival,&numarg); + for (s = tmpstr->str_ptr; *s && *s != '\n'; s++) + *s += 128; + str_scat(str,tmpstr); + str_free(tmpstr); + tab(str,level); + break; + case OCOMMENT: + str = str_new(0); + tmpstr = walk(0,level,ops[node+1].ival,&numarg); + for (s = tmpstr->str_ptr; *s && *s != '\n'; s++) + *s += 128; + str_scat(str,tmpstr); + str_free(tmpstr); + tab(str,level); + break; + case OCOMMA: + str = walk(1,level,ops[node+1].ival,&numarg); + str_cat(str,", "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); + str_free(fstr); + break; + case OSEMICOLON: + str = str_new(1); + str_set(str,"; "); + break; + case OSTATES: + str = walk(0,level,ops[node+1].ival,&numarg); + str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg)); + str_free(fstr); + break; + case OSTATE: + str = str_new(0); + if (len >= 1) { + str_scat(str,fstr=walk(0,level,ops[node+1].ival,&numarg)); + str_free(fstr); + if (len >= 2) { + tmpstr = walk(0,level,ops[node+2].ival,&numarg); + if (*tmpstr->str_ptr == ';') { + addsemi(str); + str_cat(str,tmpstr->str_ptr+1); + } + str_free(tmpstr); + } + } + break; + case OPRINTF: + case OPRINT: + str = str_new(0); + if (len == 3) { /* output redirection */ + tmpstr = walk(1,level,ops[node+3].ival,&numarg); + tmp2str = walk(1,level,ops[node+2].ival,&numarg); + if (!do_fancy_opens) { + t = tmpstr->str_ptr; + if (*t == '"' || *t == '\'') + t = cpytill(tokenbuf,t+1,*t); + else + fatal("Internal error: OPRINT"); + d = savestr(t); + s = savestr(tokenbuf); + for (t = tokenbuf; *t; t++) { + *t &= 127; + if (!isalpha(*t) && !isdigit(*t)) + *t = '_'; + } + if (!index(tokenbuf,'_')) + strcpy(t,"_fh"); + str_cat(opens,"open("); + str_cat(opens,tokenbuf); + str_cat(opens,", "); + d[1] = '\0'; + str_cat(opens,d); + str_scat(opens,tmp2str); + str_cat(opens,tmpstr->str_ptr+1); + if (*tmp2str->str_ptr == '|') + str_cat(opens,") || die 'Cannot pipe to \""); + else + str_cat(opens,") || die 'Cannot create file \""); + if (*d == '"') + str_cat(opens,"'.\""); + str_cat(opens,s); + if (*d == '"') + str_cat(opens,"\".'"); + str_cat(opens,"\".';\n"); + str_free(tmpstr); + str_free(tmp2str); + safefree(s); + safefree(d); + } + else { + sprintf(tokenbuf,"do Pick('%s' . (%s)) &&\n", + tmp2str->str_ptr, tmpstr->str_ptr); + str_cat(str,tokenbuf); + tab(str,level+1); + *tokenbuf = '\0'; + str_free(tmpstr); + str_free(tmp2str); + } + } + else + strcpy(tokenbuf,"stdout"); + if (type == OPRINTF) + str_cat(str,"printf"); + else + str_cat(str,"print"); + if (len == 3 || do_fancy_opens) { + if (*tokenbuf) + str_cat(str," "); + str_cat(str,tokenbuf); + } + tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg); + if (!*tmpstr->str_ptr && lval_field) { + t = saw_OFS ? "$," : "' '"; + if (split_to_array) { + sprintf(tokenbuf,"join(%s,@Fld)",t); + str_cat(tmpstr,tokenbuf); + } + else { + for (i = 1; i < maxfld; i++) { + if (i <= arymax) + sprintf(tokenbuf,"$%s, ",nameary[i]); + else + sprintf(tokenbuf,"$Fld%d, ",i); + str_cat(tmpstr,tokenbuf); + } + if (maxfld <= arymax) + sprintf(tokenbuf,"$%s",nameary[maxfld]); + else + sprintf(tokenbuf,"$Fld%d",maxfld); + str_cat(tmpstr,tokenbuf); + } + } + if (*tmpstr->str_ptr) { + str_cat(str," "); + str_scat(str,tmpstr); + } + else { + str_cat(str," $_"); + } + str_free(tmpstr); + break; + case OLENGTH: + str = str_make("length("); + goto maybe0; + case OLOG: + str = str_make("log("); + goto maybe0; + case OEXP: + str = str_make("exp("); + goto maybe0; + case OSQRT: + str = str_make("sqrt("); + goto maybe0; + case OINT: + str = str_make("int("); + maybe0: + numeric = 1; + if (len > 0) + tmpstr = walk(1,level,ops[node+1].ival,&numarg); + else + tmpstr = str_new(0);; + if (!*tmpstr->str_ptr) { + if (lval_field) { + t = saw_OFS ? "$," : "' '"; + if (split_to_array) { + sprintf(tokenbuf,"join(%s,@Fld)",t); + str_cat(tmpstr,tokenbuf); + } + else { + sprintf(tokenbuf,"join(%s, ",t); + str_cat(tmpstr,tokenbuf); + for (i = 1; i < maxfld; i++) { + if (i <= arymax) + sprintf(tokenbuf,"$%s,",nameary[i]); + else + sprintf(tokenbuf,"$Fld%d,",i); + str_cat(tmpstr,tokenbuf); + } + if (maxfld <= arymax) + sprintf(tokenbuf,"$%s)",nameary[maxfld]); + else + sprintf(tokenbuf,"$Fld%d)",maxfld); + str_cat(tmpstr,tokenbuf); + } + } + else + str_cat(tmpstr,"$_"); + } + if (strEQ(tmpstr->str_ptr,"$_")) { + if (type == OLENGTH && !do_chop) { + str = str_make("(length("); + str_cat(tmpstr,") - 1"); + } + } + str_scat(str,tmpstr); + str_free(tmpstr); + str_cat(str,")"); + break; + case OBREAK: + str = str_new(0); + str_set(str,"last"); + break; + case ONEXT: + str = str_new(0); + str_set(str,"next line"); + break; + case OEXIT: + str = str_new(0); + if (realexit) { + str_set(str,"exit"); + if (len == 1) { + str_cat(str," "); + exitval = TRUE; + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + } + } + else { + if (len == 1) { + str_set(str,"ExitValue = "); + exitval = TRUE; + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + str_cat(str,"; "); + } + str_cat(str,"last line"); + } + break; + case OCONTINUE: + str = str_new(0); + str_set(str,"next"); + break; + case OREDIR: + goto def; + case OIF: + str = str_new(0); + str_set(str,"if ("); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + str_cat(str,") "); + str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg)); + str_free(fstr); + if (len == 3) { + i = ops[node+3].ival; + if (i) { + if ((ops[i].ival & 255) == OBLOCK) { + i = ops[i+1].ival; + if (i) { + if ((ops[i].ival & 255) != OIF) + i = 0; + } + } + else + i = 0; + } + if (i) { + str_cat(str,"els"); + str_scat(str,fstr=walk(0,level,i,&numarg)); + str_free(fstr); + } + else { + str_cat(str,"else "); + str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg)); + str_free(fstr); + } + } + break; + case OWHILE: + str = str_new(0); + str_set(str,"while ("); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + str_cat(str,") "); + str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg)); + str_free(fstr); + break; + case OFOR: + str = str_new(0); + str_set(str,"for ("); + str_scat(str,tmpstr=walk(1,level,ops[node+1].ival,&numarg)); + i = numarg; + if (i) { + t = s = tmpstr->str_ptr; + while (isalpha(*t) || isdigit(*t) || *t == '$' || *t == '_') + t++; + i = t - s; + if (i < 2) + i = 0; + } + str_cat(str,"; "); + fstr=walk(1,level,ops[node+2].ival,&numarg); + if (i && (t = index(fstr->str_ptr,0377))) { + if (strnEQ(fstr->str_ptr,s,i)) + *t = ' '; + } + str_scat(str,fstr); + str_free(fstr); + str_free(tmpstr); + str_cat(str,"; "); + str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg)); + str_free(fstr); + str_cat(str,") "); + str_scat(str,fstr=walk(0,level,ops[node+4].ival,&numarg)); + str_free(fstr); + break; + case OFORIN: + tmpstr=walk(0,level,ops[node+2].ival,&numarg); + str = str_new(0); + str_sset(str,tmpstr); + str_cat(str,"[]"); + tmp2str = hfetch(symtab,str->str_ptr); + if (tmp2str && atoi(tmp2str->str_ptr)) { + maxtmp++; + fstr=walk(1,level,ops[node+1].ival,&numarg); + sprintf(tokenbuf, + "for ($T_%d = 1; ($%s = $%s[$T_%d]) || $T_%d <= $#%s; $T_%d++)%c", + maxtmp, + fstr->str_ptr, + tmpstr->str_ptr, + maxtmp, + maxtmp, + tmpstr->str_ptr, + maxtmp, + 0377); + str_set(str,tokenbuf); + str_free(fstr); + str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg)); + str_free(fstr); + } + else { + str_set(str,"while (($junkkey,$"); + str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg)); + str_free(fstr); + str_cat(str,") = each("); + str_scat(str,tmpstr); + str_cat(str,")) "); + str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg)); + str_free(fstr); + } + str_free(tmpstr); + break; + case OBLOCK: + str = str_new(0); + str_set(str,"{"); + if (len == 2) { + str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg)); + str_free(fstr); + } + fixtab(str,++level); + str_scat(str,fstr=walk(0,level,ops[node+1].ival,&numarg)); + str_free(fstr); + addsemi(str); + fixtab(str,--level); + str_cat(str,"}\n"); + tab(str,level); + break; + default: + def: + if (len) { + if (len > 5) + fatal("Garbage length in walk"); + str = walk(0,level,ops[node+1].ival,&numarg); + for (i = 2; i<= len; i++) { + str_scat(str,fstr=walk(0,level,ops[node+i].ival,&numarg)); + str_free(fstr); + } + } + else { + str = Nullstr; + } + break; + } + if (!str) + str = str_new(0); + *numericptr = numeric; +#ifdef DEBUGGING + if (debug & 4) { + printf("%3d %5d %15s %d %4d ",level,node,opname[type],len,str->str_cur); + for (t = str->str_ptr; *t && t - str->str_ptr < 40; t++) + if (*t == '\n') + printf("\\n"); + else if (*t == '\t') + printf("\\t"); + else + putchar(*t); + putchar('\n'); + } +#endif + return str; +} + +tab(str,lvl) +register STR *str; +register int lvl; +{ + while (lvl > 1) { + str_cat(str,"\t"); + lvl -= 2; + } + if (lvl) + str_cat(str," "); +} + +fixtab(str,lvl) +register STR *str; +register int lvl; +{ + register char *s; + + /* strip trailing white space */ + + s = str->str_ptr+str->str_cur - 1; + while (s >= str->str_ptr && (*s == ' ' || *s == '\t')) + s--; + s[1] = '\0'; + str->str_cur = s + 1 - str->str_ptr; + if (s >= str->str_ptr && *s != '\n') + str_cat(str,"\n"); + + tab(str,lvl); +} + +addsemi(str) +register STR *str; +{ + register char *s; + + s = str->str_ptr+str->str_cur - 1; + while (s >= str->str_ptr && (*s == ' ' || *s == '\t' || *s == '\n')) + s--; + if (s >= str->str_ptr && *s != ';' && *s != '}') + str_cat(str,";"); +} + +emit_split(str,level) +register STR *str; +int level; +{ + register int i; + + if (split_to_array) + str_cat(str,"@Fld"); + else { + str_cat(str,"("); + for (i = 1; i < maxfld; i++) { + if (i <= arymax) + sprintf(tokenbuf,"$%s,",nameary[i]); + else + sprintf(tokenbuf,"$Fld%d,",i); + str_cat(str,tokenbuf); + } + if (maxfld <= arymax) + sprintf(tokenbuf,"$%s)",nameary[maxfld]); + else + sprintf(tokenbuf,"$Fld%d)",maxfld); + str_cat(str,tokenbuf); + } + if (const_FS) { + sprintf(tokenbuf," = split(/[%c\\n]/);\n",const_FS); + str_cat(str,tokenbuf); + } + else if (saw_FS) + str_cat(str," = split($FS);\n"); + else + str_cat(str," = split;\n"); + tab(str,level); +} + +prewalk(numit,level,node,numericptr) +int numit; +int level; +register int node; +int *numericptr; +{ + register int len; + register int type; + register int i; + char *t; + char *d, *s; + int numarg; + int numeric = FALSE; + + if (!node) { + *numericptr = 0; + return 0; + } + type = ops[node].ival; + len = type >> 8; + type &= 255; + switch (type) { + case OPROG: + prewalk(0,level,ops[node+1].ival,&numarg); + if (ops[node+2].ival) { + prewalk(0,level,ops[node+2].ival,&numarg); + } + ++level; + prewalk(0,level,ops[node+3].ival,&numarg); + --level; + if (ops[node+3].ival) { + prewalk(0,level,ops[node+4].ival,&numarg); + } + break; + case OHUNKS: + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+2].ival,&numarg); + if (len == 3) { + prewalk(0,level,ops[node+3].ival,&numarg); + } + break; + case ORANGE: + prewalk(1,level,ops[node+1].ival,&numarg); + prewalk(1,level,ops[node+2].ival,&numarg); + break; + case OPAT: + goto def; + case OREGEX: + prewalk(0,level,ops[node+1].ival,&numarg); + break; + case OHUNK: + if (len == 1) { + prewalk(0,level,ops[node+1].ival,&numarg); + } + else { + i = prewalk(0,level,ops[node+1].ival,&numarg); + if (i) { + ++level; + prewalk(0,level,ops[node+2].ival,&numarg); + --level; + } + else { + prewalk(0,level,ops[node+2].ival,&numarg); + } + } + break; + case OPPAREN: + prewalk(0,level,ops[node+1].ival,&numarg); + break; + case OPANDAND: + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+2].ival,&numarg); + break; + case OPOROR: + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+2].ival,&numarg); + break; + case OPNOT: + prewalk(0,level,ops[node+1].ival,&numarg); + break; + case OCPAREN: + prewalk(0,level,ops[node+1].ival,&numarg); + numeric |= numarg; + break; + case OCANDAND: + prewalk(0,level,ops[node+1].ival,&numarg); + numeric = 1; + prewalk(0,level,ops[node+2].ival,&numarg); + break; + case OCOROR: + prewalk(0,level,ops[node+1].ival,&numarg); + numeric = 1; + prewalk(0,level,ops[node+2].ival,&numarg); + break; + case OCNOT: + prewalk(0,level,ops[node+1].ival,&numarg); + numeric = 1; + break; + case ORELOP: + prewalk(0,level,ops[node+2].ival,&numarg); + numeric |= numarg; + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+3].ival,&numarg); + numeric |= numarg; + numeric = 1; + break; + case ORPAREN: + prewalk(0,level,ops[node+1].ival,&numarg); + numeric |= numarg; + break; + case OMATCHOP: + prewalk(0,level,ops[node+2].ival,&numarg); + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+3].ival,&numarg); + numeric = 1; + break; + case OMPAREN: + prewalk(0,level,ops[node+1].ival,&numarg); + numeric |= numarg; + break; + case OCONCAT: + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+2].ival,&numarg); + break; + case OASSIGN: + prewalk(0,level,ops[node+2].ival,&numarg); + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+3].ival,&numarg); + if (numarg || strlen(ops[ops[node+1].ival+1].cval) > 1) { + numericize(ops[node+2].ival); + if (!numarg) + numericize(ops[node+3].ival); + } + numeric |= numarg; + break; + case OADD: + prewalk(1,level,ops[node+1].ival,&numarg); + prewalk(1,level,ops[node+2].ival,&numarg); + numeric = 1; + break; + case OSUB: + prewalk(1,level,ops[node+1].ival,&numarg); + prewalk(1,level,ops[node+2].ival,&numarg); + numeric = 1; + break; + case OMULT: + prewalk(1,level,ops[node+1].ival,&numarg); + prewalk(1,level,ops[node+2].ival,&numarg); + numeric = 1; + break; + case ODIV: + prewalk(1,level,ops[node+1].ival,&numarg); + prewalk(1,level,ops[node+2].ival,&numarg); + numeric = 1; + break; + case OMOD: + prewalk(1,level,ops[node+1].ival,&numarg); + prewalk(1,level,ops[node+2].ival,&numarg); + numeric = 1; + break; + case OPOSTINCR: + prewalk(1,level,ops[node+1].ival,&numarg); + numeric = 1; + break; + case OPOSTDECR: + prewalk(1,level,ops[node+1].ival,&numarg); + numeric = 1; + break; + case OPREINCR: + prewalk(1,level,ops[node+1].ival,&numarg); + numeric = 1; + break; + case OPREDECR: + prewalk(1,level,ops[node+1].ival,&numarg); + numeric = 1; + break; + case OUMINUS: + prewalk(1,level,ops[node+1].ival,&numarg); + numeric = 1; + break; + case OUPLUS: + prewalk(1,level,ops[node+1].ival,&numarg); + numeric = 1; + break; + case OPAREN: + prewalk(0,level,ops[node+1].ival,&numarg); + numeric |= numarg; + break; + case OGETLINE: + break; + case OSPRINTF: + prewalk(0,level,ops[node+1].ival,&numarg); + break; + case OSUBSTR: + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(1,level,ops[node+2].ival,&numarg); + if (len == 3) { + prewalk(1,level,ops[node+3].ival,&numarg); + } + break; + case OSTRING: + break; + case OSPLIT: + numeric = 1; + prewalk(0,level,ops[node+2].ival,&numarg); + if (len == 3) + prewalk(0,level,ops[node+3].ival,&numarg); + prewalk(0,level,ops[node+1].ival,&numarg); + break; + case OINDEX: + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+2].ival,&numarg); + numeric = 1; + break; + case ONUM: + prewalk(0,level,ops[node+1].ival,&numarg); + numeric = 1; + break; + case OSTR: + prewalk(0,level,ops[node+1].ival,&numarg); + break; + case OVAR: + prewalk(0,level,ops[node+1].ival,&numarg); + if (len == 1) { + if (numit) + numericize(node); + } + else { + prewalk(0,level,ops[node+2].ival,&numarg); + } + break; + case OFLD: + prewalk(0,level,ops[node+1].ival,&numarg); + break; + case OVFLD: + i = ops[node+1].ival; + prewalk(0,level,i,&numarg); + break; + case OJUNK: + goto def; + case OSNEWLINE: + break; + case ONEWLINE: + break; + case OSCOMMENT: + break; + case OCOMMENT: + break; + case OCOMMA: + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+2].ival,&numarg); + break; + case OSEMICOLON: + break; + case OSTATES: + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+2].ival,&numarg); + break; + case OSTATE: + if (len >= 1) { + prewalk(0,level,ops[node+1].ival,&numarg); + if (len >= 2) { + prewalk(0,level,ops[node+2].ival,&numarg); + } + } + break; + case OPRINTF: + case OPRINT: + if (len == 3) { /* output redirection */ + prewalk(0,level,ops[node+3].ival,&numarg); + prewalk(0,level,ops[node+2].ival,&numarg); + } + prewalk(0+(type==OPRINT),level,ops[node+1].ival,&numarg); + break; + case OLENGTH: + goto maybe0; + case OLOG: + goto maybe0; + case OEXP: + goto maybe0; + case OSQRT: + goto maybe0; + case OINT: + maybe0: + numeric = 1; + if (len > 0) + prewalk(type != OLENGTH,level,ops[node+1].ival,&numarg); + break; + case OBREAK: + break; + case ONEXT: + break; + case OEXIT: + if (len == 1) { + prewalk(1,level,ops[node+1].ival,&numarg); + } + break; + case OCONTINUE: + break; + case OREDIR: + goto def; + case OIF: + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+2].ival,&numarg); + if (len == 3) { + prewalk(0,level,ops[node+3].ival,&numarg); + } + break; + case OWHILE: + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+2].ival,&numarg); + break; + case OFOR: + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+2].ival,&numarg); + prewalk(0,level,ops[node+3].ival,&numarg); + prewalk(0,level,ops[node+4].ival,&numarg); + break; + case OFORIN: + prewalk(0,level,ops[node+2].ival,&numarg); + prewalk(0,level,ops[node+1].ival,&numarg); + prewalk(0,level,ops[node+3].ival,&numarg); + break; + case OBLOCK: + if (len == 2) { + prewalk(0,level,ops[node+2].ival,&numarg); + } + ++level; + prewalk(0,level,ops[node+1].ival,&numarg); + --level; + break; + default: + def: + if (len) { + if (len > 5) + fatal("Garbage length in prewalk"); + prewalk(0,level,ops[node+1].ival,&numarg); + for (i = 2; i<= len; i++) { + prewalk(0,level,ops[node+i].ival,&numarg); + } + } + break; + } + *numericptr = numeric; + return 1; +} + +numericize(node) +register int node; +{ + register int len; + register int type; + register int i; + STR *tmpstr; + STR *tmp2str; + int numarg; + + type = ops[node].ival; + len = type >> 8; + type &= 255; + if (type == OVAR && len == 1) { + tmpstr=walk(0,0,ops[node+1].ival,&numarg); + tmp2str = str_make("1"); + hstore(symtab,tmpstr->str_ptr,tmp2str); + } +} |