X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=x2p%2Fa2py.c;h=286f7cc106a35ff0b16c2662c7eb969b19a420ff;hb=eda4663d0f345e78f0a82529a08f3aa28c98ff2c;hp=202d5921e011d2ce724d9465e795ba642db88f69;hpb=f0f333f45536802923a359d930d1dcfd5b4589ea;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/x2p/a2py.c b/x2p/a2py.c
index 202d592..286f7cc 100644
--- a/x2p/a2py.c
+++ b/x2p/a2py.c
@@ -1,20 +1,25 @@
-/* $RCSfile: a2py.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:14 $
+/*    a2py.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, by Larry Wall and others
  *
  *    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 $
  */
 
-#ifdef OS2
+#if defined(OS2) || defined(WIN32) || defined(NETWARE)
+#if defined(WIN32)
+#include <io.h>
+#endif
+#if defined(NETWARE)
+#include "../netware/clibstuf.h"
+#endif
 #include "../patchlevel.h"
 #endif
 #include "util.h"
 
-char *filename;
-char *myname;
+const char *filename;
+const char *myname;
 
 int checkers = 0;
 
@@ -25,12 +30,18 @@ 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);
+#ifdef NETWARE
+char *savestr(char *str);
+char *cpy2(register char *to, register char *from, register int delim);
+#endif
+
+#if defined(OS2) || defined(WIN32) || defined(NETWARE)
+static void usage(void);
 
-#ifdef OS2
 static void
 usage()
 {
-    printf("\nThis is the AWK to PERL translator, version 5.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"
@@ -43,12 +54,21 @@ usage()
 }
 #endif
 
+#ifdef __osf__
+#pragma message disable (mainparm) /* We have the envp in main(). */
+#endif
+
 int
-main(register int argc, register char **argv, register char **env)
+main(register int argc, register const char **argv, register const char **env)
 {
     register STR *str;
     int i;
     STR *tmpstr;
+    /* char *namelist;    */
+
+	#ifdef NETWARE
+		fnInitGpfGlobals();	/* For importing the CLIB calls in place of Watcom calls */
+	#endif	/* NETWARE */
 
     myname = argv[0];
     linestr = str_new(80);
@@ -56,12 +76,11 @@ main(register int argc, register char **argv, register char **env)
     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
+#if YYDEBUG
 	    yydebug = (debug & 1);
 #endif
 	    break;
@@ -86,9 +105,11 @@ main(register int argc, register char **argv, register char **env)
 	case 0:
 	    break;
 	default:
-	    fatal("Unrecognized switch: %s\n",argv[0]);
-#ifdef OS2
+#if defined(OS2) || defined(WIN32) || defined(NETWARE)
+	    fprintf(stderr, "Unrecognized switch: %s\n",argv[0]);
             usage();
+#else
+	    fatal("Unrecognized switch: %s\n",argv[0]);
 #endif
 	}
     }
@@ -96,8 +117,8 @@ main(register int argc, register char **argv, register char **env)
 
     /* open script */
 
-    if (argv[0] == Nullch) {
-#ifdef OS2
+    if (argv[0] == NULL) {
+#if defined(OS2) || defined(WIN32) || defined(NETWARE)
 	if ( isatty(fileno(stdin)) )
 	    usage();
 #endif
@@ -105,14 +126,13 @@ main(register int argc, register char **argv, register char **env)
     }
     filename = savestr(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)
+    if (rsfp == NULL)
 	fatal("Awk script \"%s\" doesn't seem to exist.\n",filename);
 
     /* init tokener */
@@ -187,6 +207,8 @@ main(register int argc, register char **argv, register char **env)
 	  "The operation I've selected may be wrong for the operand types.\n");
     }
     exit(0);
+    /* by ANSI specs return is needed. This also shuts up VC++ and his warnings */
+    return(0);
 }
 
 #define RETURN(retval) return (bufptr = s,retval)
@@ -204,12 +226,13 @@ yylex(void)
     register int tmp;
 
   retry:
-#ifdef YYDEBUG
-    if (yydebug)
+#if YYDEBUG
+    if (yydebug) {
 	if (strchr(s,'\n'))
 	    fprintf(stderr,"Tokener at %s",s);
 	else
 	    fprintf(stderr,"Tokener at %s\n",s);
+    }
 #endif
     switch (*s) {
     default:
@@ -230,10 +253,10 @@ yylex(void)
 	if (!rsfp)
 	    RETURN(0);
 	line++;
-	if ((s = str_gets(linestr, rsfp)) == Nullch) {
+	if ((s = str_gets(linestr, rsfp)) == NULL) {
 	    if (rsfp != stdin)
 		fclose(rsfp);
-	    rsfp = Nullfp;
+	    rsfp = NULL;
 	    s = str_get(linestr);
 	    RETURN(0);
 	}
@@ -266,11 +289,15 @@ yylex(void)
     case ':':
 	tmp = *s++;
 	XOP(tmp);
+#ifdef EBCDIC
+    case 7:
+#else
     case 127:
+#endif
 	s++;
 	XTERM('}');
     case '}':
-	for (d = s + 1; isspace(*d); d++) ;
+	for (d = s + 1; isSPACE(*d); d++) ;
 	if (!*d)
 	    s = d - 1;
 	*s = 127;
@@ -372,7 +399,7 @@ yylex(void)
 
 #define SNARFWORD \
 	d = tokenbuf; \
-	while (isalpha(*s) || isdigit(*s) || *s == '_') \
+	while (isALPHA(*s) || isDIGIT(*s) || *s == '_') \
 	    *d++ = *s++; \
 	*d = '\0'; \
 	d = tokenbuf; \
@@ -391,15 +418,22 @@ yylex(void)
 	    ID("0");
 	}
 	do_split = TRUE;
-	if (isdigit(*s)) {
-	    for (d = s; isdigit(*s); s++) ;
+	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;
+	for (d = s; isALPHA(*s) || isDIGIT(*s) || *s == '_'; )
+	    s++;
+	split_to_array = TRUE;
+	if (d != s)
+	{
+	    yylval = string(d,s-d);
+	    XTERM(SVFIELD);
+	}
 	XOP(VFIELD);
 
     case '/':			/* may either be division or pattern */
@@ -430,8 +464,6 @@ yylex(void)
 
     case 'a': case 'A':
 	SNARFWORD;
-	if (strEQ(d,"ARGC"))
-	    set_array_base = TRUE;
 	if (strEQ(d,"ARGV")) {
 	    yylval=numary(string("ARGV",0));
 	    XOP(VAR);
@@ -462,15 +494,15 @@ yylex(void)
 	    XTERM(FUN1);
 	}
 	if (strEQ(d,"chdir"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"crypt"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"chop"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"chmod"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"chown"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'd': case 'D':
 	SNARFWORD;
@@ -479,7 +511,7 @@ yylex(void)
 	if (strEQ(d,"delete"))
 	    XTERM(DELETE);
 	if (strEQ(d,"die"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'e': case 'E':
 	SNARFWORD;
@@ -496,26 +528,26 @@ yylex(void)
 	    XTERM(FUN1);
 	}
 	if (strEQ(d,"elsif"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"eq"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"eval"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"eof"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"each"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"exec"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	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++) ;
+		for (d = s; *d && isSPACE(*d); d++) ;
 		if (*d == '=') {
-		    for (d++; *d && isspace(*d); d++) ;
+		    for (d++; *d && isSPACE(*d); d++) ;
 		    if (*d == '"' && d[2] == '"')
 			const_FS = d[1];
 		}
@@ -527,15 +559,15 @@ yylex(void)
 	else if (strEQ(d,"function"))
 	    XTERM(FUNCTION);
 	if (strEQ(d,"FILENAME"))
-	    d = "ARGV";
+	    ID("ARGV");
 	if (strEQ(d,"foreach"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"format"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"fork"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"fh"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'g': case 'G':
 	SNARFWORD;
@@ -544,18 +576,18 @@ yylex(void)
 	if (strEQ(d,"gsub"))
 	    XTERM(GSUB);
 	if (strEQ(d,"ge"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"gt"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"goto"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"gmtime"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'h': case 'H':
 	SNARFWORD;
 	if (strEQ(d,"hex"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'i': case 'I':
 	SNARFWORD;
@@ -564,7 +596,6 @@ yylex(void)
 	if (strEQ(d,"in"))
 	    XTERM(IN);
 	if (strEQ(d,"index")) {
-	    set_array_base = TRUE;
 	    XTERM(INDEX);
 	}
 	if (strEQ(d,"int")) {
@@ -575,14 +606,14 @@ yylex(void)
     case 'j': case 'J':
 	SNARFWORD;
 	if (strEQ(d,"join"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'k': case 'K':
 	SNARFWORD;
 	if (strEQ(d,"keys"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"kill"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'l': case 'L':
 	SNARFWORD;
@@ -595,57 +626,56 @@ yylex(void)
 	    XTERM(FUN1);
 	}
 	if (strEQ(d,"last"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"local"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"lt"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"le"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"locatime"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"link"))
-	    *d = toupper(*d);
+	    *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);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'n': case 'N':
 	SNARFWORD;
 	if (strEQ(d,"NF"))
-	    do_chop = do_split = split_to_array = set_array_base = TRUE;
+	    do_chop = do_split = split_to_array = TRUE;
 	if (strEQ(d,"next")) {
 	    saw_line_op = TRUE;
 	    XTERM(NEXT);
 	}
 	if (strEQ(d,"ne"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'o': case 'O':
 	SNARFWORD;
 	if (strEQ(d,"ORS")) {
 	    saw_ORS = TRUE;
-	    d = "\\";
+	    ID("\\");
 	}
 	if (strEQ(d,"OFS")) {
 	    saw_OFS = TRUE;
-	    d = ",";
+	    ID(",");
 	}
 	if (strEQ(d,"OFMT")) {
-	    d = "#";
+	    ID("#");
 	}
 	if (strEQ(d,"open"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"ord"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"oct"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'p': case 'P':
 	SNARFWORD;
@@ -656,9 +686,9 @@ yylex(void)
 	    XTERM(PRINTF);
 	}
 	if (strEQ(d,"push"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"pop"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'q': case 'Q':
 	SNARFWORD;
@@ -666,8 +696,8 @@ yylex(void)
     case 'r': case 'R':
 	SNARFWORD;
 	if (strEQ(d,"RS")) {
-	    d = "/";
 	    saw_RS = TRUE;
+	    ID("/");
 	}
 	if (strEQ(d,"rand")) {
 	    yylval = ORAND;
@@ -676,32 +706,37 @@ yylex(void)
 	if (strEQ(d,"return"))
 	    XTERM(RET);
 	if (strEQ(d,"reset"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"redo"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"rename"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	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,"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);
 	}
 	if (strEQ(d,"SUBSEP")) {
-	    d = ";";
+	    ID(";");
 	}
 	if (strEQ(d,"sin")) {
 	    yylval = OSIN;
@@ -716,73 +751,73 @@ yylex(void)
 	    XTERM(FUN1);
 	}
 	if (strEQ(d,"s"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"shift"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"select"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"seek"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"stat"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"study"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"sleep"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"symlink"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"sort"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 't': case 'T':
 	SNARFWORD;
 	if (strEQ(d,"tr"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"tell"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"time"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"times"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'u': case 'U':
 	SNARFWORD;
 	if (strEQ(d,"until"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"unless"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"umask"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"unshift"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"unlink"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"utime"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'v': case 'V':
 	SNARFWORD;
 	if (strEQ(d,"values"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'w': case 'W':
 	SNARFWORD;
 	if (strEQ(d,"while"))
 	    XTERM(WHILE);
 	if (strEQ(d,"write"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	else if (strEQ(d,"wait"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'x': case 'X':
 	SNARFWORD;
 	if (strEQ(d,"x"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'y': case 'Y':
 	SNARFWORD;
 	if (strEQ(d,"y"))
-	    *d = toupper(*d);
+	    *d = toUPPER(*d);
 	ID(d);
     case 'z': case 'Z':
 	SNARFWORD;
@@ -836,7 +871,7 @@ scanpat(register char *s)
 }
 
 void
-yyerror(char *s)
+yyerror(const char *s)
 {
     fprintf(stderr,"%s in file %s at line %d\n",
       s,filename,line);
@@ -851,13 +886,13 @@ scannum(register char *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)) {
+	while (isDIGIT(*s)) {
 	    *d++ = *s++;
 	}
 	if (*s == '.') {
-	    if (isdigit(s[1])) {
+	    if (isDIGIT(s[1])) {
 		*d++ = *s++;
-		while (isdigit(*s)) {
+		while (isDIGIT(*s)) {
 		    *d++ = *s++;
 		}
 	    }
@@ -868,7 +903,7 @@ scannum(register char *s)
 	    *d++ = *s++;
 	    if (*s == '+' || *s == '-')
 		*d++ = *s++;
-	    while (isdigit(*s))
+	    while (isDIGIT(*s))
 		*d++ = *s++;
 	}
 	*d = '\0';
@@ -879,7 +914,7 @@ scannum(register char *s)
 }
 
 int
-string(char *ptr, int len)
+string(const char *ptr, int len)
 {
     int retval = mop;
 
@@ -1041,9 +1076,9 @@ fixup(STR *str)
 	    s++;
 	}
 	else if (*s == '\n') {
-	    for (t = s+1; isspace(*t & 127); t++) ;
+	    for (t = s+1; isSPACE(*t & 127); t++) ;
 	    t--;
-	    while (isspace(*t & 127) && *t != '\n') t--;
+	    while (isSPACE(*t & 127) && *t != '\n') t--;
 	    if (*t == '\n' && t-s > 1) {
 		if (s[-1] == '{')
 		    s--;
@@ -1076,7 +1111,7 @@ putlines(STR *str)
 	if (pos > 78) {		/* split a long line? */
 	    *d-- = '\0';
 	    newpos = 0;
-	    for (t = tokenbuf; isspace(*t & 127); t++) {
+	    for (t = tokenbuf; isSPACE(*t & 127); t++) {
 		if (*t == '\t')
 		    newpos += 8;
 		else
@@ -1163,7 +1198,6 @@ numary(int arg)
     str_cat(key,"[]");
     hstore(symtab,key->str_ptr,str_make("1"));
     str_free(key);
-    set_array_base = TRUE;
     return arg;
 }
 
@@ -1208,7 +1242,7 @@ fixfargs(int name, int arg, int prevargs)
 {
     int type;
     STR *str;
-    int numargs;
+    int numargs = 0;
 
     if (!arg)
 	return prevargs;