X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=x2p%2Fa2py.c;h=454e2dc86015b3802d994558ec998fb20a2de081;hb=06b43eb76ef057fab08c35057263548c3f57cf74;hp=e17c542a4a53d3a542d69462bb3f129862d8b5eb;hpb=a687059cbaf2c6fdccb5e0fae2aee80ec15625a8;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/x2p/a2py.c b/x2p/a2py.c
index e17c542..454e2dc 100644
--- a/x2p/a2py.c
+++ b/x2p/a2py.c
@@ -1,34 +1,56 @@
-/* $Header: a2py.c,v 3.0 89/10/18 15:34:35 lwall Locked $
+/* $RCSfile: a2py.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:14 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, 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  89/10/18  15:34:35  lwall
- * 3.0 baseline
- * 
  */
 
+#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<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
 main(argc,argv,env)
 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++) {
@@ -62,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] = "";
@@ -121,16 +153,13 @@ register char **env;
     /* second pass to produce new program */
 
     tmpstr = walk(0,0,root,&i,P_MIN);
-    str = str_make("#!");
-    str_cat(str, BIN);
-    str_cat(str, "/perl\neval \"exec ");
-    str_cat(str, BIN);
-    str_cat(str, "/perl -S $0 $*\"\n\
+    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) {
@@ -162,6 +191,7 @@ register char **env;
 
 int idtype;
 
+int
 yylex()
 {
     register char *s = bufptr;
@@ -171,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);
@@ -183,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';
@@ -578,7 +614,7 @@ yylex()
     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);
@@ -769,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++;
@@ -793,6 +831,7 @@ register char *s;
     return s;
 }
 
+void
 yyerror(s)
 char *s;
 {
@@ -813,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++;
@@ -833,8 +876,10 @@ register char *s;
     return s;
 }
 
+int
 string(ptr,len)
 char *ptr;
+int len;
 {
     int retval = mop;
 
@@ -849,6 +894,7 @@ char *ptr;
     return retval;
 }
 
+int
 oper0(type)
 int type;
 {
@@ -862,6 +908,7 @@ int type;
     return retval;
 }
 
+int
 oper1(type,arg1)
 int type;
 int arg1;
@@ -877,6 +924,7 @@ int arg1;
     return retval;
 }
 
+int
 oper2(type,arg1,arg2)
 int type;
 int arg1;
@@ -894,6 +942,7 @@ int arg2;
     return retval;
 }
 
+int
 oper3(type,arg1,arg2,arg3)
 int type;
 int arg1;
@@ -913,6 +962,7 @@ int arg3;
     return retval;
 }
 
+int
 oper4(type,arg1,arg2,arg3,arg4)
 int type;
 int arg1;
@@ -934,6 +984,7 @@ int arg4;
     return retval;
 }
 
+int
 oper5(type,arg1,arg2,arg3,arg4,arg5)
 int type;
 int arg1;
@@ -959,6 +1010,7 @@ int arg5;
 
 int depth = 0;
 
+void
 dump(branch)
 int branch;
 {
@@ -986,6 +1038,7 @@ int branch;
     }
 }
 
+int
 bl(arg,maybe)
 int arg;
 int maybe;
@@ -1000,6 +1053,7 @@ int maybe;
 	return arg;
 }
 
+void
 fixup(str)
 STR *str;
 {
@@ -1025,6 +1079,7 @@ STR *str;
     }
 }
 
+void
 putlines(str)
 STR *str;
 {
@@ -1079,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)) {
@@ -1087,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;
@@ -1098,6 +1156,7 @@ STR *str;
     }
 }
 
+void
 putone()
 {
     register char *t;
@@ -1120,6 +1179,7 @@ putone()
     fputs(tokenbuf,stdout);
 }
 
+int
 numary(arg)
 int arg;
 {
@@ -1134,6 +1194,7 @@ int arg;
     return arg;
 }
 
+int
 rememberargs(arg)
 int arg;
 {
@@ -1156,6 +1217,7 @@ int arg;
     return arg;
 }
 
+int
 aryrefarg(arg)
 int arg;
 {
@@ -1170,6 +1232,7 @@ int arg;
     return arg;
 }
 
+int
 fixfargs(name,arg,prevargs)
 int name;
 int arg;
@@ -1204,10 +1267,11 @@ int prevargs;
     }
     else
 	fatal("panic: unknown argument type %d, arg %d, line %d\n",
-	  type,numargs+1,line);
+	  type,prevargs+1,line);
     return numargs;
 }
 
+int
 fixrargs(name,arg,prevargs)
 char *name;
 int arg;
@@ -1229,7 +1293,6 @@ int prevargs;
 
 	sprintf(tmpbuf,"%s:%d",name,prevargs);
 	str = hfetch(curarghash,tmpbuf);
-	fprintf(stderr,"Looking for %s\n",tmpbuf);
 	if (str && strEQ(str->str_ptr,"*")) {
 	    if (type == OVAR || type == OSTAR) {
 		ops[arg].ival &= ~255;
@@ -1243,4 +1306,3 @@ int prevargs;
     }
     return numargs;
 }
-