-/* $Header: a2py.c,v 3.0.1.1 90/08/09 05:48:53 lwall Locked $
+/* $RCSfile: a2py.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:14 $
*
- * Copyright (c) 1989, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
- * You may distribute under the terms of the GNU General Public License
- * as specified in the README file that comes with the perl 3.0 kit.
+ * 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 3.0.1.1 90/08/09 05:48:53 lwall
- * patch19: a2p didn't emit a chop when NF was referenced though split needs it
- *
- * Revision 3.0 89/10/18 15:34:35 lwall
- * 3.0 baseline
- *
*/
+#if defined(OS2) || defined(WIN32)
+#if defined(WIN32)
+#include <io.h>
+#endif
+#include "../patchlevel.h"
+#endif
#include "util.h"
-char *index();
char *filename;
+char *myname;
int checkers = 0;
-STR *walk();
-main(argc,argv,env)
-register int argc;
-register char **argv;
-register char **env;
+int oper0(int type);
+int oper1(int type, int arg1);
+int oper2(int type, int arg1, int arg2);
+int oper3(int type, int arg1, int arg2, int arg3);
+int oper4(int type, int arg1, int arg2, int arg3, int arg4);
+int oper5(int type, int arg1, int arg2, int arg3, int arg4, int arg5);
+STR *walk(int useval, int level, register int node, int *numericptr, int minprec);
+
+#if defined(OS2) || defined(WIN32)
+static void usage(void);
+
+static void
+usage()
+{
+ printf("\nThis is the AWK to PERL translator, revision %d.0, version %d\n", PERL_REVISION, PERL_VERSION);
+ printf("\nUsage: %s [-D<number>] [-F<char>] [-n<fieldlist>] [-<number>] filename\n", myname);
+ printf("\n -D<number> sets debugging flags."
+ "\n -F<character> the awk script to translate is always invoked with"
+ "\n this -F switch."
+ "\n -n<fieldlist> specifies the names of the input fields if input does"
+ "\n not have to be split into an array."
+ "\n -<number> causes a2p to assume that input will always have that"
+ "\n many fields.\n");
+ exit(1);
+}
+#endif
+
+int
+main(register int argc, register char **argv, register char **env)
{
register STR *str;
- register char *s;
int i;
STR *tmpstr;
+ myname = argv[0];
linestr = str_new(80);
str = str_new(0); /* first used for -I flags */
for (argc--,argv++; argc; argc--,argv++) {
#ifdef DEBUGGING
case 'D':
debug = atoi(argv[0]+2);
-#ifdef YYDEBUG
+#if YYDEBUG
yydebug = (debug & 1);
#endif
break;
case 'n':
namelist = savestr(argv[0]+2);
break;
+ case 'o':
+ old_awk = TRUE;
+ break;
case '-':
argc--,argv++;
goto switch_end;
case 0:
break;
default:
+#if defined(OS2) || defined(WIN32)
+ fprintf(stderr, "Unrecognized switch: %s\n",argv[0]);
+ usage();
+#else
fatal("Unrecognized switch: %s\n",argv[0]);
+#endif
}
}
switch_end:
/* open script */
- if (argv[0] == Nullch)
- argv[0] = "-";
+ if (argv[0] == Nullch) {
+#if defined(OS2) || defined(WIN32)
+ if ( isatty(fileno(stdin)) )
+ usage();
+#endif
+ argv[0] = "-";
+ }
+ filename = savestr(argv[0]);
+
filename = savestr(argv[0]);
if (strEQ(filename,"-"))
argv[0] = "";
/* second pass to produce new program */
tmpstr = walk(0,0,root,&i,P_MIN);
- str = str_make("#!");
+ str = str_make(STARTPERL);
+ str_cat(str, "\neval 'exec ");
str_cat(str, BIN);
- str_cat(str, "/perl\neval \"exec ");
- str_cat(str, BIN);
- str_cat(str, "/perl -S $0 $*\"\n\
+ str_cat(str, "/perl -S $0 ${1+\"$@\"}'\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) {
int idtype;
-yylex()
+int
+yylex(void)
{
register char *s = bufptr;
register char *d;
register int tmp;
retry:
-#ifdef YYDEBUG
+#if 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);
*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';
case ':':
tmp = *s++;
XOP(tmp);
+#ifdef EBCDIC
+ case 7:
+#else
case 127:
+#endif
s++;
XTERM('}');
case '}':
}
if (strEQ(d,"sub"))
XTERM(SUB);
- if (strEQ(d,"sprintf"))
- XTERM(SPRINTF);
+ if (strEQ(d,"sprintf")) {
+ /* In old awk, { print sprintf("str%sg"),"in" } prints
+ * "string"; in new awk, "in" is not considered an argument to
+ * sprintf, so the statement breaks. To support both, the
+ * grammar treats arguments to SPRINTF_OLD like old awk,
+ * SPRINTF_NEW like new. Here we return the appropriate one.
+ */
+ XTERM(old_awk ? SPRINTF_OLD : SPRINTF_NEW);
+ }
if (strEQ(d,"sqrt")) {
yylval = OSQRT;
XTERM(FUN1);
}
char *
-scanpat(s)
-register char *s;
+scanpat(register char *s)
{
register char *d;
*d++ = *s++;
else if (s[1] == '\\')
*d++ = *s++;
+ else if (s[1] == '[')
+ *d++ = *s++;
}
else if (*s == '[') {
*d++ = *s++;
return s;
}
-yyerror(s)
-char *s;
+void
+yyerror(char *s)
{
fprintf(stderr,"%s in file %s at line %d\n",
s,filename,line);
}
char *
-scannum(s)
-register char *s;
+scannum(register char *s)
{
register char *d;
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++;
return s;
}
-string(ptr,len)
-char *ptr;
+int
+string(char *ptr, int len)
{
int retval = mop;
ops[mop++].ival = OSTRING + (1<<8);
if (!len)
len = strlen(ptr);
- ops[mop].cval = safemalloc(len+1);
+ ops[mop].cval = (char *) safemalloc(len+1);
strncpy(ops[mop].cval,ptr,len);
ops[mop++].cval[len] = '\0';
if (mop >= OPSMAX)
return retval;
}
-oper0(type)
-int type;
+int
+oper0(int type)
{
int retval = mop;
return retval;
}
-oper1(type,arg1)
-int type;
-int arg1;
+int
+oper1(int type, int arg1)
{
int retval = mop;
return retval;
}
-oper2(type,arg1,arg2)
-int type;
-int arg1;
-int arg2;
+int
+oper2(int type, int arg1, int arg2)
{
int retval = mop;
return retval;
}
-oper3(type,arg1,arg2,arg3)
-int type;
-int arg1;
-int arg2;
-int arg3;
+int
+oper3(int type, int arg1, int arg2, int arg3)
{
int retval = mop;
return retval;
}
-oper4(type,arg1,arg2,arg3,arg4)
-int type;
-int arg1;
-int arg2;
-int arg3;
-int arg4;
+int
+oper4(int type, int arg1, int arg2, int arg3, int arg4)
{
int retval = mop;
return retval;
}
-oper5(type,arg1,arg2,arg3,arg4,arg5)
-int type;
-int arg1;
-int arg2;
-int arg3;
-int arg4;
-int arg5;
+int
+oper5(int type, int arg1, int arg2, int arg3, int arg4, int arg5)
{
int retval = mop;
int depth = 0;
-dump(branch)
-int branch;
+void
+dump(int branch)
{
register int type;
register int len;
}
}
-bl(arg,maybe)
-int arg;
-int maybe;
+int
+bl(int arg, int maybe)
{
if (!arg)
return 0;
return arg;
}
-fixup(str)
-STR *str;
+void
+fixup(STR *str)
{
register char *s;
register char *t;
}
}
-putlines(str)
-STR *str;
+void
+putlines(STR *str)
{
register char *d, *s, *t, *e;
register int pos, newpos;
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)) {
*t++ = ' ';
newpos += 2;
}
- strcpy(t,d+1);
+ strcpy(t,save+1);
newpos += strlen(t);
d = t + strlen(t);
pos = newpos;
}
}
-putone()
+void
+putone(void)
{
register char *t;
fputs(tokenbuf,stdout);
}
-numary(arg)
-int arg;
+int
+numary(int arg)
{
STR *key;
int dummy;
return arg;
}
-rememberargs(arg)
-int arg;
+int
+rememberargs(int arg)
{
int type;
STR *str;
return arg;
}
-aryrefarg(arg)
-int arg;
+int
+aryrefarg(int arg)
{
int type = ops[arg].ival & 255;
STR *str;
return arg;
}
-fixfargs(name,arg,prevargs)
-int name;
-int arg;
-int prevargs;
+int
+fixfargs(int name, int arg, int prevargs)
{
int type;
STR *str;
}
else
fatal("panic: unknown argument type %d, arg %d, line %d\n",
- type,numargs+1,line);
+ type,prevargs+1,line);
return numargs;
}
-fixrargs(name,arg,prevargs)
-char *name;
-int arg;
-int prevargs;
+int
+fixrargs(char *name, int arg, int prevargs)
{
int type;
STR *str;
numargs = fixrargs(name,ops[arg+3].ival,numargs);
}
else {
- char tmpbuf[128];
-
+ char *tmpbuf = (char *) safemalloc(strlen(name) + (sizeof(prevargs) * 3) + 5);
sprintf(tmpbuf,"%s:%d",name,prevargs);
str = hfetch(curarghash,tmpbuf);
- fprintf(stderr,"Looking for %s\n",tmpbuf);
+ safefree(tmpbuf);
if (str && strEQ(str->str_ptr,"*")) {
if (type == OVAR || type == OSTAR) {
ops[arg].ival &= ~255;
}
return numargs;
}
-
projects / p5sagit/p5-mst-13.2.git / blobdiff