X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=x2p%2Fa2py.c;h=454e2dc86015b3802d994558ec998fb20a2de081;hb=06b43eb76ef057fab08c35057263548c3f57cf74;hp=3adbd65fd33e997182382461f8cef7ffabc4247b;hpb=378cc40b38293ffc7298c6a7ed3cd740ad79be52;p=p5sagit%2Fp5-mst-13.2.git diff --git a/x2p/a2py.c b/x2p/a2py.c index 3adbd65..454e2dc 100644 --- a/x2p/a2py.c +++ b/x2p/a2py.c @@ -1,29 +1,56 @@ -/* $Header: a2py.c,v 2.0 88/06/05 00:15:41 root Exp $ +/* $RCSfile: a2py.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:14 $ + * + * Copyright (c) 1991, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: a2py.c,v $ - * Revision 2.0 88/06/05 00:15:41 root - * Baseline version 2.0. - * */ +#ifdef OS2 +#include "../patchlevel.h" +#endif #include "util.h" -char *index(); char *filename; +char *myname; int checkers = 0; +int oper0(); +int oper1(); +int oper2(); +int oper3(); +int oper4(); +int oper5(); +STR *walk(); + +#ifdef OS2 +usage() +{ + printf("\nThis is the AWK to PERL translator, version 5.0, patchlevel %d\n", PATCHLEVEL); + printf("\nUsage: %s [-D] [-F] [-n] [-] filename\n", myname); + printf("\n -D sets debugging flags." + "\n -F the awk script to translate is always invoked with" + "\n this -F switch." + "\n -n specifies the names of the input fields if input does" + "\n not have to be split into an array." + "\n - causes a2p to assume that input will always have that" + "\n many fields.\n"); + exit(1); +} +#endif 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; + myname = argv[0]; linestr = str_new(80); str = str_new(0); /* first used for -I flags */ for (argc--,argv++; argc; argc--,argv++) { @@ -57,14 +84,24 @@ register char **env; break; default: fatal("Unrecognized switch: %s\n",argv[0]); +#ifdef OS2 + usage(); +#endif } } switch_end: /* open script */ - if (argv[0] == Nullch) - argv[0] = "-"; + if (argv[0] == Nullch) { +#ifdef OS2 + if ( isatty(fileno(stdin)) ) + usage(); +#endif + argv[0] = "-"; + } + filename = savestr(argv[0]); + filename = savestr(argv[0]); if (strEQ(filename,"-")) argv[0] = ""; @@ -79,6 +116,7 @@ register char **env; bufptr = str_get(linestr); symtab = hnew(); + curarghash = hnew(); /* now parse the report spec */ @@ -114,13 +152,14 @@ register char **env; /* second pass to produce new program */ - tmpstr = walk(0,0,root,&i); - str = str_make("#!/usr/bin/perl\neval \"exec /usr/bin/perl -S $0 $*\"\n\ + tmpstr = walk(0,0,root,&i,P_MIN); + str = str_make(STARTPERL); + str_cat(str, "\neval 'exec perl -S $0 \"$@\"'\n\ if $running_under_some_shell;\n\ # this emulates #! processing on NIH machines.\n\ # (remove #! line above if indigestible)\n\n"); str_cat(str, - "eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;\n"); + "eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;\n"); str_cat(str, " # process any FOO=bar switches\n\n"); if (do_opens && opens) { @@ -148,8 +187,11 @@ register char **env; #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) +#define ID(x) return (yylval=string(x,0),expectterm = FALSE,bufptr = s,idtype) + +int idtype; +int yylex() { register char *s = bufptr; @@ -159,7 +201,7 @@ yylex() retry: #ifdef YYDEBUG if (yydebug) - if (index(s,'\n')) + if (strchr(s,'\n')) fprintf(stderr,"Tokener at %s",s); else fprintf(stderr,"Tokener at %s\n",s); @@ -171,6 +213,12 @@ yylex() *s++,filename,line); goto retry; case '\\': + s++; + if (*s && *s != '\n') { + yyerror("Ignoring spurious backslash"); + goto retry; + } + /*FALLSTHROUGH*/ case 0: s = str_get(linestr); *s = '\0'; @@ -203,10 +251,14 @@ yylex() } XTERM(tmp); case '(': + tmp = *s++; + XTERM(tmp); case '{': case '[': case ')': case ']': + case '?': + case ':': tmp = *s++; XOP(tmp); case 127: @@ -237,9 +289,13 @@ yylex() /* FALL THROUGH */ case '*': case '%': + case '^': tmp = *s++; if (*s == '=') { - yylval = string(s-1,2); + if (tmp == '^') + yylval = string("**=",3); + else + yylval = string(s-1,2); s++; XTERM(ASGNOP); } @@ -257,7 +313,12 @@ yylex() if (tmp == '|') XTERM(OROR); s--; - XTERM('|'); + while (*s == ' ' || *s == '\t') + s++; + if (strnEQ(s,"getline",7)) + XTERM('p'); + else + XTERM('|'); case '=': s++; tmp = *s++; @@ -289,8 +350,7 @@ yylex() XTERM(RELOP); } s--; - yylval = string("<",1); - XTERM(RELOP); + XTERM('<'); case '>': s++; tmp = *s++; @@ -303,15 +363,18 @@ yylex() XTERM(RELOP); } s--; - yylval = string(">",1); - XTERM(RELOP); + XTERM('>'); #define SNARFWORD \ d = tokenbuf; \ while (isalpha(*s) || isdigit(*s) || *s == '_') \ *d++ = *s++; \ *d = '\0'; \ - d = tokenbuf; + d = tokenbuf; \ + if (*s == '(') \ + idtype = USERFUN; \ + else \ + idtype = VAR; case '$': s++; @@ -319,6 +382,7 @@ yylex() s++; do_chop = TRUE; need_entire = TRUE; + idtype = VAR; ID("0"); } do_split = TRUE; @@ -347,7 +411,7 @@ yylex() XTERM(tmp); case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': + case '5': case '6': case '7': case '8': case '9': case '.': s = scannum(s); XOP(NUMBER); case '"': @@ -361,6 +425,16 @@ yylex() case 'a': case 'A': SNARFWORD; + if (strEQ(d,"ARGC")) + set_array_base = TRUE; + if (strEQ(d,"ARGV")) { + yylval=numary(string("ARGV",0)); + XOP(VAR); + } + if (strEQ(d,"atan2")) { + yylval = OATAN2; + XTERM(FUNN); + } ID(d); case 'b': case 'B': SNARFWORD; @@ -373,9 +447,34 @@ yylex() SNARFWORD; if (strEQ(d,"continue")) XTERM(CONTINUE); + if (strEQ(d,"cos")) { + yylval = OCOS; + XTERM(FUN1); + } + if (strEQ(d,"close")) { + do_fancy_opens = 1; + yylval = OCLOSE; + XTERM(FUN1); + } + if (strEQ(d,"chdir")) + *d = toupper(*d); + else if (strEQ(d,"crypt")) + *d = toupper(*d); + else if (strEQ(d,"chop")) + *d = toupper(*d); + else if (strEQ(d,"chmod")) + *d = toupper(*d); + else if (strEQ(d,"chown")) + *d = toupper(*d); ID(d); case 'd': case 'D': SNARFWORD; + if (strEQ(d,"do")) + XTERM(DO); + if (strEQ(d,"delete")) + XTERM(DELETE); + if (strEQ(d,"die")) + *d = toupper(*d); ID(d); case 'e': case 'E': SNARFWORD; @@ -391,6 +490,18 @@ yylex() yylval = OEXP; XTERM(FUN1); } + if (strEQ(d,"elsif")) + *d = toupper(*d); + else if (strEQ(d,"eq")) + *d = toupper(*d); + else if (strEQ(d,"eval")) + *d = toupper(*d); + else if (strEQ(d,"eof")) + *d = toupper(*d); + else if (strEQ(d,"each")) + *d = toupper(*d); + else if (strEQ(d,"exec")) + *d = toupper(*d); ID(d); case 'f': case 'F': SNARFWORD; @@ -406,18 +517,40 @@ yylex() } ID(tokenbuf); } - if (strEQ(d,"FILENAME")) - d = "ARGV"; if (strEQ(d,"for")) XTERM(FOR); + else if (strEQ(d,"function")) + XTERM(FUNCTION); + if (strEQ(d,"FILENAME")) + d = "ARGV"; + if (strEQ(d,"foreach")) + *d = toupper(*d); + else if (strEQ(d,"format")) + *d = toupper(*d); + else if (strEQ(d,"fork")) + *d = toupper(*d); + else if (strEQ(d,"fh")) + *d = toupper(*d); ID(d); case 'g': case 'G': SNARFWORD; if (strEQ(d,"getline")) XTERM(GETLINE); + if (strEQ(d,"gsub")) + XTERM(GSUB); + if (strEQ(d,"ge")) + *d = toupper(*d); + else if (strEQ(d,"gt")) + *d = toupper(*d); + else if (strEQ(d,"goto")) + *d = toupper(*d); + else if (strEQ(d,"gmtime")) + *d = toupper(*d); ID(d); case 'h': case 'H': SNARFWORD; + if (strEQ(d,"hex")) + *d = toupper(*d); ID(d); case 'i': case 'I': SNARFWORD; @@ -436,9 +569,15 @@ yylex() ID(d); case 'j': case 'J': SNARFWORD; + if (strEQ(d,"join")) + *d = toupper(*d); ID(d); case 'k': case 'K': SNARFWORD; + if (strEQ(d,"keys")) + *d = toupper(*d); + else if (strEQ(d,"kill")) + *d = toupper(*d); ID(d); case 'l': case 'L': SNARFWORD; @@ -450,32 +589,58 @@ yylex() yylval = OLOG; XTERM(FUN1); } + if (strEQ(d,"last")) + *d = toupper(*d); + else if (strEQ(d,"local")) + *d = toupper(*d); + else if (strEQ(d,"lt")) + *d = toupper(*d); + else if (strEQ(d,"le")) + *d = toupper(*d); + else if (strEQ(d,"locatime")) + *d = toupper(*d); + else if (strEQ(d,"link")) + *d = toupper(*d); ID(d); case 'm': case 'M': SNARFWORD; + if (strEQ(d,"match")) { + set_array_base = TRUE; + XTERM(MATCH); + } + if (strEQ(d,"m")) + *d = toupper(*d); ID(d); case 'n': case 'N': SNARFWORD; if (strEQ(d,"NF")) - do_split = split_to_array = set_array_base = TRUE; + do_chop = do_split = split_to_array = set_array_base = TRUE; if (strEQ(d,"next")) { saw_line_op = TRUE; XTERM(NEXT); } + if (strEQ(d,"ne")) + *d = toupper(*d); ID(d); case 'o': case 'O': SNARFWORD; if (strEQ(d,"ORS")) { saw_ORS = TRUE; - d = "$\\"; + d = "\\"; } if (strEQ(d,"OFS")) { saw_OFS = TRUE; - d = "$,"; + d = ","; } if (strEQ(d,"OFMT")) { - d = "$#"; + d = "#"; } + if (strEQ(d,"open")) + *d = toupper(*d); + else if (strEQ(d,"ord")) + *d = toupper(*d); + else if (strEQ(d,"oct")) + *d = toupper(*d); ID(d); case 'p': case 'P': SNARFWORD; @@ -485,6 +650,10 @@ yylex() if (strEQ(d,"printf")) { XTERM(PRINTF); } + if (strEQ(d,"push")) + *d = toupper(*d); + else if (strEQ(d,"pop")) + *d = toupper(*d); ID(d); case 'q': case 'Q': SNARFWORD; @@ -492,9 +661,21 @@ yylex() case 'r': case 'R': SNARFWORD; if (strEQ(d,"RS")) { - d = "$/"; + d = "/"; saw_RS = TRUE; } + if (strEQ(d,"rand")) { + yylval = ORAND; + XTERM(FUN1); + } + if (strEQ(d,"return")) + XTERM(RET); + if (strEQ(d,"reset")) + *d = toupper(*d); + else if (strEQ(d,"redo")) + *d = toupper(*d); + else if (strEQ(d,"rename")) + *d = toupper(*d); ID(d); case 's': case 'S': SNARFWORD; @@ -506,32 +687,97 @@ yylex() set_array_base = TRUE; XTERM(SUBSTR); } + if (strEQ(d,"sub")) + XTERM(SUB); if (strEQ(d,"sprintf")) XTERM(SPRINTF); if (strEQ(d,"sqrt")) { yylval = OSQRT; XTERM(FUN1); } + if (strEQ(d,"SUBSEP")) { + d = ";"; + } + if (strEQ(d,"sin")) { + yylval = OSIN; + XTERM(FUN1); + } + if (strEQ(d,"srand")) { + yylval = OSRAND; + XTERM(FUN1); + } + if (strEQ(d,"system")) { + yylval = OSYSTEM; + XTERM(FUN1); + } + if (strEQ(d,"s")) + *d = toupper(*d); + else if (strEQ(d,"shift")) + *d = toupper(*d); + else if (strEQ(d,"select")) + *d = toupper(*d); + else if (strEQ(d,"seek")) + *d = toupper(*d); + else if (strEQ(d,"stat")) + *d = toupper(*d); + else if (strEQ(d,"study")) + *d = toupper(*d); + else if (strEQ(d,"sleep")) + *d = toupper(*d); + else if (strEQ(d,"symlink")) + *d = toupper(*d); + else if (strEQ(d,"sort")) + *d = toupper(*d); ID(d); case 't': case 'T': SNARFWORD; + if (strEQ(d,"tr")) + *d = toupper(*d); + else if (strEQ(d,"tell")) + *d = toupper(*d); + else if (strEQ(d,"time")) + *d = toupper(*d); + else if (strEQ(d,"times")) + *d = toupper(*d); ID(d); case 'u': case 'U': SNARFWORD; + if (strEQ(d,"until")) + *d = toupper(*d); + else if (strEQ(d,"unless")) + *d = toupper(*d); + else if (strEQ(d,"umask")) + *d = toupper(*d); + else if (strEQ(d,"unshift")) + *d = toupper(*d); + else if (strEQ(d,"unlink")) + *d = toupper(*d); + else if (strEQ(d,"utime")) + *d = toupper(*d); ID(d); case 'v': case 'V': SNARFWORD; + if (strEQ(d,"values")) + *d = toupper(*d); ID(d); case 'w': case 'W': SNARFWORD; if (strEQ(d,"while")) XTERM(WHILE); + if (strEQ(d,"write")) + *d = toupper(*d); + else if (strEQ(d,"wait")) + *d = toupper(*d); ID(d); case 'x': case 'X': SNARFWORD; + if (strEQ(d,"x")) + *d = toupper(*d); ID(d); case 'y': case 'Y': SNARFWORD; + if (strEQ(d,"y")) + *d = toupper(*d); ID(d); case 'z': case 'Z': SNARFWORD; @@ -559,6 +805,8 @@ register char *s; *d++ = *s++; else if (s[1] == '\\') *d++ = *s++; + else if (s[1] == '[') + *d++ = *s++; } else if (*s == '[') { *d++ = *s++; @@ -583,6 +831,7 @@ register char *s; return s; } +void yyerror(s) char *s; { @@ -603,13 +852,17 @@ register char *s; while (isdigit(*s)) { *d++ = *s++; } - if (*s == '.' && index("0123456789eE",s[1])) { - *d++ = *s++; - while (isdigit(*s)) { + if (*s == '.') { + if (isdigit(s[1])) { *d++ = *s++; + while (isdigit(*s)) { + *d++ = *s++; + } } + else + s++; } - if (index("eE",*s) && index("+-0123456789",s[1])) { + if (strchr("eE",*s) && strchr("+-0123456789",s[1])) { *d++ = *s++; if (*s == '+' || *s == '-') *d++ = *s++; @@ -623,8 +876,10 @@ register char *s; return s; } +int string(ptr,len) char *ptr; +int len; { int retval = mop; @@ -634,9 +889,12 @@ char *ptr; ops[mop].cval = safemalloc(len+1); strncpy(ops[mop].cval,ptr,len); ops[mop++].cval[len] = '\0'; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } +int oper0(type) int type; { @@ -645,9 +903,12 @@ int type; if (type > 255) fatal("type > 255 (%d)\n",type); ops[mop++].ival = type; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } +int oper1(type,arg1) int type; int arg1; @@ -658,9 +919,12 @@ int arg1; fatal("type > 255 (%d)\n",type); ops[mop++].ival = type + (1<<8); ops[mop++].ival = arg1; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } +int oper2(type,arg1,arg2) int type; int arg1; @@ -673,9 +937,12 @@ int arg2; ops[mop++].ival = type + (2<<8); ops[mop++].ival = arg1; ops[mop++].ival = arg2; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } +int oper3(type,arg1,arg2,arg3) int type; int arg1; @@ -690,9 +957,12 @@ int arg3; ops[mop++].ival = arg1; ops[mop++].ival = arg2; ops[mop++].ival = arg3; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } +int oper4(type,arg1,arg2,arg3,arg4) int type; int arg1; @@ -709,9 +979,12 @@ int arg4; ops[mop++].ival = arg2; ops[mop++].ival = arg3; ops[mop++].ival = arg4; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } +int oper5(type,arg1,arg2,arg3,arg4,arg5) int type; int arg1; @@ -730,11 +1003,14 @@ int arg5; ops[mop++].ival = arg3; ops[mop++].ival = arg4; ops[mop++].ival = arg5; + if (mop >= OPSMAX) + fatal("Recompile a2p with larger OPSMAX\n"); return retval; } int depth = 0; +void dump(branch) int branch; { @@ -762,6 +1038,7 @@ int branch; } } +int bl(arg,maybe) int arg; int maybe; @@ -776,6 +1053,7 @@ int maybe; return arg; } +void fixup(str) STR *str; { @@ -801,6 +1079,7 @@ STR *str; } } +void putlines(str) STR *str; { @@ -855,7 +1134,10 @@ STR *str; d--; } if (d > t+3) { - *d = '\0'; + char save[2048]; + strcpy(save, d); + *d = '\n'; + d[1] = '\0'; putone(); putchar('\n'); if (d[-1] != ';' && !(newpos % 4)) { @@ -863,7 +1145,7 @@ STR *str; *t++ = ' '; newpos += 2; } - strcpy(t,d+1); + strcpy(t,save+1); newpos += strlen(t); d = t + strlen(t); pos = newpos; @@ -874,6 +1156,7 @@ STR *str; } } +void putone() { register char *t; @@ -896,16 +1179,130 @@ putone() fputs(tokenbuf,stdout); } +int numary(arg) int arg; { STR *key; int dummy; - key = walk(0,0,arg,&dummy); + key = walk(0,0,arg,&dummy,P_MIN); str_cat(key,"[]"); hstore(symtab,key->str_ptr,str_make("1")); str_free(key); set_array_base = TRUE; return arg; } + +int +rememberargs(arg) +int arg; +{ + int type; + STR *str; + + if (!arg) + return arg; + type = ops[arg].ival & 255; + if (type == OCOMMA) { + rememberargs(ops[arg+1].ival); + rememberargs(ops[arg+3].ival); + } + else if (type == OVAR) { + str = str_new(0); + hstore(curarghash,ops[ops[arg+1].ival+1].cval,str); + } + else + fatal("panic: unknown argument type %d, line %d\n",type,line); + return arg; +} + +int +aryrefarg(arg) +int arg; +{ + int type = ops[arg].ival & 255; + STR *str; + + if (type != OSTRING) + fatal("panic: aryrefarg %d, line %d\n",type,line); + str = hfetch(curarghash,ops[arg+1].cval); + if (str) + str_set(str,"*"); + return arg; +} + +int +fixfargs(name,arg,prevargs) +int name; +int arg; +int prevargs; +{ + int type; + STR *str; + int numargs; + + if (!arg) + return prevargs; + type = ops[arg].ival & 255; + if (type == OCOMMA) { + numargs = fixfargs(name,ops[arg+1].ival,prevargs); + numargs = fixfargs(name,ops[arg+3].ival,numargs); + } + else if (type == OVAR) { + str = hfetch(curarghash,ops[ops[arg+1].ival+1].cval); + if (strEQ(str_get(str),"*")) { + char tmpbuf[128]; + + str_set(str,""); /* in case another routine has this */ + ops[arg].ival &= ~255; + ops[arg].ival |= OSTAR; + sprintf(tmpbuf,"%s:%d",ops[name+1].cval,prevargs); + fprintf(stderr,"Adding %s\n",tmpbuf); + str = str_new(0); + str_set(str,"*"); + hstore(curarghash,tmpbuf,str); + } + numargs = prevargs + 1; + } + else + fatal("panic: unknown argument type %d, arg %d, line %d\n", + type,prevargs+1,line); + return numargs; +} + +int +fixrargs(name,arg,prevargs) +char *name; +int arg; +int prevargs; +{ + int type; + STR *str; + int numargs; + + if (!arg) + return prevargs; + type = ops[arg].ival & 255; + if (type == OCOMMA) { + numargs = fixrargs(name,ops[arg+1].ival,prevargs); + numargs = fixrargs(name,ops[arg+3].ival,numargs); + } + else { + char tmpbuf[128]; + + sprintf(tmpbuf,"%s:%d",name,prevargs); + str = hfetch(curarghash,tmpbuf); + if (str && strEQ(str->str_ptr,"*")) { + if (type == OVAR || type == OSTAR) { + ops[arg].ival &= ~255; + ops[arg].ival |= OSTAR; + } + else + fatal("Can't pass expression by reference as arg %d of %s\n", + prevargs+1, name); + } + numargs = prevargs + 1; + } + return numargs; +}