tolerate NULL SITELIB_EXP
[p5sagit/p5-mst-13.2.git] / x2p / a2py.c
index 836d176..3976c86 100644 (file)
@@ -1,38 +1,41 @@
-/* $Header: a2py.c,v 3.0.1.2 90/10/16 11:30:34 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.2  90/10/16  11:30:34  lwall
- * patch29: various portability fixes
- * 
- * 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
- * 
  */
 
-#ifdef MSDOS
-#include "../patchlev.h"
+#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();
 
-#ifdef MSDOS
+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, version 3.0, patchlevel %d\n", PATCHLEVEL);
+    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"
@@ -44,13 +47,11 @@ usage()
     exit(1);
 }
 #endif
-main(argc,argv,env)
-register int argc;
-register char **argv;
-register char **env;
+
+int
+main(register int argc, register char **argv, register char **env)
 {
     register STR *str;
-    register char *s;
     int i;
     STR *tmpstr;
 
@@ -65,7 +66,7 @@ register char **env;
 #ifdef DEBUGGING
        case 'D':
            debug = atoi(argv[0]+2);
-#ifdef YYDEBUG
+#if YYDEBUG
            yydebug = (debug & 1);
 #endif
            break;
@@ -81,15 +82,20 @@ register char **env;
        case 'n':
            namelist = savestr(argv[0]+2);
            break;
+       case 'o':
+           old_awk = TRUE;
+           break;
        case '-':
            argc--,argv++;
            goto switch_end;
        case 0:
            break;
        default:
-           fatal("Unrecognized switch: %s\n",argv[0]);
-#ifdef MSDOS
+#if defined(OS2) || defined(WIN32)
+           fprintf(stderr, "Unrecognized switch: %s\n",argv[0]);
             usage();
+#else
+           fatal("Unrecognized switch: %s\n",argv[0]);
 #endif
        }
     }
@@ -98,7 +104,7 @@ register char **env;
     /* open script */
 
     if (argv[0] == Nullch) {
-#ifdef MSDOS
+#if defined(OS2) || defined(WIN32)
        if ( isatty(fileno(stdin)) )
            usage();
 #endif
@@ -157,16 +163,15 @@ register char **env;
     /* 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) {
@@ -198,16 +203,17 @@ register char **env;
 
 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);
@@ -219,6 +225,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';
@@ -261,7 +273,11 @@ yylex()
     case ':':
        tmp = *s++;
        XOP(tmp);
+#ifdef EBCDIC
+    case 7:
+#else
     case 127:
+#endif
        s++;
        XTERM('}');
     case '}':
@@ -689,8 +705,15 @@ yylex()
        }
        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);
@@ -786,8 +809,7 @@ yylex()
 }
 
 char *
-scanpat(s)
-register char *s;
+scanpat(register char *s)
 {
     register char *d;
 
@@ -805,6 +827,8 @@ register char *s;
                *d++ = *s++;
            else if (s[1] == '\\')
                *d++ = *s++;
+           else if (s[1] == '[')
+               *d++ = *s++;
        }
        else if (*s == '[') {
            *d++ = *s++;
@@ -829,16 +853,15 @@ register char *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;
 
@@ -849,13 +872,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++;
@@ -869,15 +896,15 @@ register char *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)
@@ -885,8 +912,8 @@ char *ptr;
     return retval;
 }
 
-oper0(type)
-int type;
+int
+oper0(int type)
 {
     int retval = mop;
 
@@ -898,9 +925,8 @@ int type;
     return retval;
 }
 
-oper1(type,arg1)
-int type;
-int arg1;
+int
+oper1(int type, int arg1)
 {
     int retval = mop;
 
@@ -913,10 +939,8 @@ int arg1;
     return retval;
 }
 
-oper2(type,arg1,arg2)
-int type;
-int arg1;
-int arg2;
+int
+oper2(int type, int arg1, int arg2)
 {
     int retval = mop;
 
@@ -930,11 +954,8 @@ int arg2;
     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;
 
@@ -949,12 +970,8 @@ int arg3;
     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;
 
@@ -970,13 +987,8 @@ int arg4;
     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;
 
@@ -995,8 +1007,8 @@ int arg5;
 
 int depth = 0;
 
-dump(branch)
-int branch;
+void
+dump(int branch)
 {
     register int type;
     register int len;
@@ -1022,9 +1034,8 @@ int branch;
     }
 }
 
-bl(arg,maybe)
-int arg;
-int maybe;
+int
+bl(int arg, int maybe)
 {
     if (!arg)
        return 0;
@@ -1036,8 +1047,8 @@ int maybe;
        return arg;
 }
 
-fixup(str)
-STR *str;
+void
+fixup(STR *str)
 {
     register char *s;
     register char *t;
@@ -1061,8 +1072,8 @@ STR *str;
     }
 }
 
-putlines(str)
-STR *str;
+void
+putlines(STR *str)
 {
     register char *d, *s, *t, *e;
     register int pos, newpos;
@@ -1115,7 +1126,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)) {
@@ -1123,7 +1137,7 @@ STR *str;
                    *t++ = ' ';
                    newpos += 2;
                }
-               strcpy(t,d+1);
+               strcpy(t,save+1);
                newpos += strlen(t);
                d = t + strlen(t);
                pos = newpos;
@@ -1134,7 +1148,8 @@ STR *str;
     }
 }
 
-putone()
+void
+putone(void)
 {
     register char *t;
 
@@ -1156,8 +1171,8 @@ putone()
     fputs(tokenbuf,stdout);
 }
 
-numary(arg)
-int arg;
+int
+numary(int arg)
 {
     STR *key;
     int dummy;
@@ -1170,8 +1185,8 @@ int arg;
     return arg;
 }
 
-rememberargs(arg)
-int arg;
+int
+rememberargs(int arg)
 {
     int type;
     STR *str;
@@ -1192,8 +1207,8 @@ int arg;
     return arg;
 }
 
-aryrefarg(arg)
-int arg;
+int
+aryrefarg(int arg)
 {
     int type = ops[arg].ival & 255;
     STR *str;
@@ -1206,10 +1221,8 @@ int arg;
     return arg;
 }
 
-fixfargs(name,arg,prevargs)
-int name;
-int arg;
-int prevargs;
+int
+fixfargs(int name, int arg, int prevargs)
 {
     int type;
     STR *str;
@@ -1244,10 +1257,8 @@ int prevargs;
     return numargs;
 }
 
-fixrargs(name,arg,prevargs)
-char *name;
-int arg;
-int prevargs;
+int
+fixrargs(char *name, int arg, int prevargs)
 {
     int type;
     STR *str;
@@ -1261,11 +1272,10 @@ int prevargs;
        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;
@@ -1279,4 +1289,3 @@ int prevargs;
     }
     return numargs;
 }
-