home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perlkt40.zip / A2PY.C < prev    next >
C/C++ Source or Header  |  1996-06-14  |  29KB  |  1,419 lines
  1. /* $RCSfile: a2py.c,v $$Revision: 4.0.1.2 $$Date: 92/06/08 16:15:16 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    a2py.c,v $
  9.  * Revision 4.0.1.2  92/06/08  16:15:16  lwall
  10.  * patch20: in a2p, now warns about spurious backslashes
  11.  * patch20: in a2p, now allows [ to be backslashed in pattern
  12.  * patch20: in a2p, now allows numbers of the form 2.
  13.  * 
  14.  * Revision 4.0.1.1  91/06/07  12:12:59  lwall
  15.  * patch4: new copyright notice
  16.  * 
  17.  * Revision 4.0  91/03/20  01:57:26  lwall
  18.  * 4.0 baseline.
  19.  * 
  20.  */
  21. /* 1992/08/01 kkimura
  22.  *   modify to handle mbchar
  23.  *   add some gawk functions
  24.  */
  25.  
  26. #if defined(OS2) || defined(MSDOS)
  27. #include "patchlevel.h"
  28. #endif
  29. #include "util.h"
  30. char *index();
  31.  
  32. char *filename;
  33. char *myname;
  34.  
  35. int checkers = 0;
  36. STR *walk();
  37. #ifdef __BORLANDC__
  38. extern unsigned _stklen = 0x8000;
  39. #endif
  40.  
  41. #if defined(OS2) || defined(MSDOS)
  42. usage()
  43. {
  44.     printf("\nThis is the AWK to PERL translator, version 4.0, patchlevel %d\n", PATCHLEVEL);
  45. #ifdef  KANJI
  46.     printf("Japanese patch ``Foxtrot''\n");
  47. #endif
  48.     printf("\nUsage: %s [-D<number>] [-F<char>] [-n<fieldlist>] [-<number>] filename\n", myname);
  49. #ifdef DEBUGGING
  50.     printf("\n  -D<number>      sets debugging flags.");
  51. #endif
  52.     printf("\n  -F<character>   the awk script to translate is always invoked with"
  53.            "\n                  this -F switch."
  54.            "\n  -n<fieldlist>   specifies the names of the input fields if input does"
  55.            "\n                  not have to be split into an array."
  56.            "\n  -<number>       causes a2p to assume that input will always have that"
  57.            "\n                  many fields.\n");
  58.     exit(1);
  59. }
  60. #endif
  61. main(argc,argv,env)
  62. register int argc;
  63. register char **argv;
  64. register char **env;
  65. {
  66.     register STR *str;
  67.     register char *s;
  68.     int i;
  69.     STR *tmpstr;
  70.  
  71. #if defined(MSDOS)
  72.     myname = "a2p";
  73. #else
  74.     myname = argv[0];
  75. #endif
  76.     linestr = str_new(80);
  77.     str = str_new(0);        /* first used for -I flags */
  78.     for (argc--,argv++; argc; argc--,argv++) {
  79.     if (argv[0][0] != '-' || !argv[0][1])
  80.         break;
  81.       reswitch:
  82.     switch (argv[0][1]) {
  83. #ifdef DEBUGGING
  84.     case 'D':
  85.         debug = atoi(argv[0]+2);
  86. #ifdef YYDEBUG
  87.         yydebug = (debug & 1);
  88. #endif
  89.         break;
  90. #endif
  91.     case '0': case '1': case '2': case '3': case '4':
  92.     case '5': case '6': case '7': case '8': case '9':
  93.         maxfld = atoi(argv[0]+1);
  94.         absmaxfld = TRUE;
  95.         break;
  96.     case 'F':
  97.         fswitch = argv[0][2];
  98.         break;
  99.     case 'n':
  100.         namelist = savestr(argv[0]+2);
  101.         break;
  102.     case '-':
  103.         argc--,argv++;
  104.         goto switch_end;
  105.     case 0:
  106.         break;
  107.     default:
  108.         fatal("Unrecognized switch: %s\n",argv[0]);
  109. #if defined(OS2) || defined(MSDOS)
  110.             usage();
  111. #endif
  112.     }
  113.     }
  114.   switch_end:
  115.  
  116.     /* open script */
  117.  
  118.     if (argv[0] == Nullch) {
  119. #if defined(OS2) || defined(MSDOS)
  120.     if ( isatty(fileno(stdin)) )
  121.         usage();
  122. #endif
  123.         argv[0] = "-";
  124.     }
  125.     filename = savestr(argv[0]);
  126.  
  127.     filename = savestr(argv[0]);
  128.     if (strEQ(filename,"-"))
  129.     argv[0] = "";
  130.     if (!*argv[0])
  131.     rsfp = stdin;
  132.     else
  133.     rsfp = fopen(argv[0],"r");
  134.     if (rsfp == Nullfp)
  135.     fatal("Awk script \"%s\" doesn't seem to exist.\n",filename);
  136.  
  137.     /* init tokener */
  138.  
  139.     bufptr = str_get(linestr);
  140.     symtab = hnew();
  141.     curarghash = hnew();
  142.  
  143.     /* now parse the report spec */
  144.  
  145.     if (yyparse())
  146.     fatal("Translation aborted due to syntax errors.\n");
  147.  
  148. #ifdef DEBUGGING
  149.     if (debug & 2) {
  150.     int type, len;
  151.  
  152.     for (i=1; i<mop;) {
  153.         type = ops[i].ival;
  154.         len = type >> 8;
  155.         type &= 255;
  156.         printf("%d\t%d\t%d\t%-10s",i++,type,len,opname[type]);
  157.         if (type == OSTRING)
  158.         printf("\t\"%s\"\n",ops[i].cval),i++;
  159.         else {
  160.         while (len--) {
  161.             printf("\t%d",ops[i].ival),i++;
  162.         }
  163.         putchar('\n');
  164.         }
  165.     }
  166.     }
  167.     if (debug & 8)
  168.     dump(root);
  169. #endif
  170.  
  171.     /* first pass to look for numeric variables */
  172.  
  173.     prewalk(0,0,root,&i);
  174.  
  175.     /* second pass to produce new program */
  176.  
  177.     tmpstr = walk(0,0,root,&i,P_MIN);
  178. #if defined(MSDOS)
  179.     str = str_make("#!jperl\n\n");
  180. #else
  181.     str = str_make("#!");
  182.     str_cat(str, BIN);
  183.     str_cat(str, "/perl\neval \"exec ");
  184.     str_cat(str, BIN);
  185.     str_cat(str, "/perl -S $0 $*\"\n\
  186.     if $running_under_some_shell;\n\
  187.             # this emulates #! processing on NIH machines.\n\
  188.             # (remove #! line above if indigestible)\n\n");
  189. #endif
  190.     str_cat(str,
  191.       "eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;\n");
  192.     str_cat(str,
  193.       "            # process any FOO=bar switches\n\n");
  194.     if (do_opens && opens) {
  195.     str_scat(str,opens);
  196.     str_free(opens);
  197.     str_cat(str,"\n");
  198.     }
  199.     str_scat(str,tmpstr);
  200.     str_free(tmpstr);
  201. #ifdef DEBUGGING
  202.     if (!(debug & 16))
  203. #endif
  204.     fixup(str);
  205.     putlines(str);
  206.     if (checkers) {
  207.     fprintf(stderr,
  208.       "Please check my work on the %d line%s I've marked with \"#???\".\n",
  209.         checkers, checkers == 1 ? "" : "s" );
  210.     fprintf(stderr,
  211.       "The operation I've selected may be wrong for the operand types.\n");
  212.     }
  213.     exit(0);
  214. }
  215.  
  216. #define RETURN(retval) return (bufptr = s,retval)
  217. #define XTERM(retval) return (expectterm = TRUE,bufptr = s,retval)
  218. #define XOP(retval) return (expectterm = FALSE,bufptr = s,retval)
  219. #define ID(x) return (yylval=string(x,0),expectterm = FALSE,bufptr = s,idtype)
  220.  
  221. int idtype;
  222.  
  223. yylex()
  224. {
  225.     register char *s = bufptr;
  226.     register char *d;
  227.     register int tmp;
  228.  
  229.   retry:
  230. #ifdef YYDEBUG
  231.     if (yydebug)
  232.     if (index(s,'\n'))
  233.         fprintf(stderr,"Tokener at %s",s);
  234.     else
  235.         fprintf(stderr,"Tokener at %s\n",s);
  236. #endif
  237.     switch (*s) {
  238.     default:
  239.     fprintf(stderr,
  240.         "Unrecognized character %c in file %s line %d--ignoring.\n",
  241.          *s++,filename,line);
  242.     goto retry;
  243.     case '\\':
  244.     s++;
  245.     if (*s && *s != '\n') {
  246.         yyerror("Ignoring spurious backslash");
  247.         goto retry;
  248.     }
  249.     /*FALLSTHROUGH*/
  250.     case 0:
  251.     s = str_get(linestr);
  252.     *s = '\0';
  253.     if (!rsfp)
  254.         RETURN(0);
  255.     line++;
  256.     if ((s = str_gets(linestr, rsfp)) == Nullch) {
  257.         if (rsfp != stdin)
  258.         fclose(rsfp);
  259.         rsfp = Nullfp;
  260.         s = str_get(linestr);
  261.         RETURN(0);
  262.     }
  263.     goto retry;
  264.     case ' ': case '\t':
  265.     s++;
  266.     goto retry;
  267.     case '\n':
  268.     *s = '\0';
  269.     XTERM(NEWLINE);
  270.     case '#':
  271.     yylval = string(s,0);
  272.     *s = '\0';
  273.     XTERM(COMMENT);
  274.     case ';':
  275.     tmp = *s++;
  276.     if (*s == '\n') {
  277.         s++;
  278.         XTERM(SEMINEW);
  279.     }
  280.     XTERM(tmp);
  281.     case '(':
  282.     tmp = *s++;
  283.     XTERM(tmp);
  284.     case '{':
  285.     case '[':
  286.     case ')':
  287.     case ']':
  288.     case '?':
  289.     case ':':
  290.     tmp = *s++;
  291.     XOP(tmp);
  292.     case 127:
  293.     s++;
  294.     XTERM('}');
  295.     case '}':
  296.     for (d = s + 1; isspace(*d); d++) ;
  297.     if (!*d)
  298.         s = d - 1;
  299.     *s = 127;
  300.     XTERM(';');
  301.     case ',':
  302.     tmp = *s++;
  303.     XTERM(tmp);
  304.     case '~':
  305.     s++;
  306.     yylval = string("~",1);
  307.     XTERM(MATCHOP);
  308.     case '+':
  309.     case '-':
  310.     if (s[1] == *s) {
  311.         s++;
  312.         if (*s++ == '+')
  313.         XTERM(INCR);
  314.         else
  315.         XTERM(DECR);
  316.     }
  317.     /* FALL THROUGH */
  318.     case '*':
  319.     case '%':
  320.     case '^':
  321.     tmp = *s++;
  322.     if (*s == '=') {
  323.         if (tmp == '^')
  324.         yylval = string("**=",3);
  325.         else
  326.         yylval = string(s-1,2);
  327.         s++;
  328.         XTERM(ASGNOP);
  329.     }
  330.     XTERM(tmp);
  331.     case '&':
  332.     s++;
  333.     tmp = *s++;
  334.     if (tmp == '&')
  335.         XTERM(ANDAND);
  336.     s--;
  337.     XTERM('&');
  338.     case '|':
  339.     s++;
  340.     tmp = *s++;
  341.     if (tmp == '|')
  342.         XTERM(OROR);
  343.     s--;
  344.     while (*s == ' ' || *s == '\t')
  345.         s++;
  346.     if (strnEQ(s,"getline",7))
  347.         XTERM('p');
  348.     else
  349.         XTERM('|');
  350.     case '=':
  351.     s++;
  352.     tmp = *s++;
  353.     if (tmp == '=') {
  354.         yylval = string("==",2);
  355.         XTERM(RELOP);
  356.     }
  357.     s--;
  358.     yylval = string("=",1);
  359.     XTERM(ASGNOP);
  360.     case '!':
  361.     s++;
  362.     tmp = *s++;
  363.     if (tmp == '=') {
  364.         yylval = string("!=",2);
  365.         XTERM(RELOP);
  366.     }
  367.     if (tmp == '~') {
  368.         yylval = string("!~",2);
  369.         XTERM(MATCHOP);
  370.     }
  371.     s--;
  372.     XTERM(NOT);
  373.     case '<':
  374.     s++;
  375.     tmp = *s++;
  376.     if (tmp == '=') {
  377.         yylval = string("<=",2);
  378.         XTERM(RELOP);
  379.     }
  380.     s--;
  381.     XTERM('<');
  382.     case '>':
  383.     s++;
  384.     tmp = *s++;
  385.     if (tmp == '>') {
  386.         yylval = string(">>",2);
  387.         XTERM(GRGR);
  388.     }
  389.     if (tmp == '=') {
  390.         yylval = string(">=",2);
  391.         XTERM(RELOP);
  392.     }
  393.     s--;
  394.     XTERM('>');
  395.  
  396. #define SNARFWORD \
  397.     d = tokenbuf; \
  398.     while (isalpha(*s) || isdigit(*s) || *s == '_') \
  399.         *d++ = *s++; \
  400.     *d = '\0'; \
  401.     d = tokenbuf; \
  402.     if (*s == '(') \
  403.         idtype = USERFUN; \
  404.     else \
  405.         idtype = VAR;
  406.  
  407.     case '$':
  408.     s++;
  409.     if (*s == '0') {
  410.         s++;
  411.         do_chop = TRUE;
  412.         need_entire = TRUE;
  413.         idtype = VAR;
  414.         ID("0");
  415.     }
  416.     do_split = TRUE;
  417.     if (isdigit(*s)) {
  418.         for (d = s; isdigit(*s); s++) ;
  419.         yylval = string(d,s-d);
  420.         tmp = atoi(d);
  421.         if (tmp > maxfld)
  422.         maxfld = tmp;
  423.         XOP(FIELD);
  424.     }
  425.     split_to_array = set_array_base = TRUE;
  426.     XOP(VFIELD);
  427.  
  428.     case '/':            /* may either be division or pattern */
  429.     if (expectterm) {
  430.         s = scanpat(s);
  431.         XTERM(REGEX);
  432.     }
  433.     tmp = *s++;
  434.     if (*s == '=') {
  435.         yylval = string("/=",2);
  436.         s++;
  437.         XTERM(ASGNOP);
  438.     }
  439.     XTERM(tmp);
  440.  
  441.     case '0': case '1': case '2': case '3': case '4':
  442.     case '5': case '6': case '7': case '8': case '9': case '.':
  443.     s = scannum(s);
  444.     XOP(NUMBER);
  445.     case '"':
  446.     s++;
  447.     s = cpy2(tokenbuf,s,s[-1]);
  448.     if (!*s)
  449.         fatal("String not terminated:\n%s",str_get(linestr));
  450.     s++;
  451.     yylval = string(tokenbuf,0);
  452.     XOP(STRING);
  453.  
  454.     case 'a': case 'A':
  455.     SNARFWORD;
  456.     if (strEQ(d,"ARGC"))
  457.         set_array_base = TRUE;
  458.     if (strEQ(d,"ARGV")) {
  459.         yylval=numary(string("ARGV",0));
  460.         XOP(VAR);
  461.     }
  462.     if (strEQ(d,"atan2")) {
  463.         yylval = OATAN2;
  464.         XTERM(FUNN);
  465.     }
  466.     ID(d);
  467.     case 'b': case 'B':
  468.     SNARFWORD;
  469.     if (strEQ(d,"break"))
  470.         XTERM(BREAK);
  471.     if (strEQ(d,"BEGIN"))
  472.         XTERM(BEGIN);
  473.     ID(d);
  474.     case 'c': case 'C':
  475.     SNARFWORD;
  476.     if (strEQ(d,"continue"))
  477.         XTERM(CONTINUE);
  478.     if (strEQ(d,"cos")) {
  479.         yylval = OCOS;
  480.         XTERM(FUN1);
  481.     }
  482.     if (strEQ(d,"close")) {
  483.         do_fancy_opens = 1;
  484.         yylval = OCLOSE;
  485.         XTERM(FUN1);
  486.     }
  487.     if (strEQ(d,"chdir"))
  488.         *d = toupper(*d);
  489.     else if (strEQ(d,"crypt"))
  490.         *d = toupper(*d);
  491.     else if (strEQ(d,"chop"))
  492.         *d = toupper(*d);
  493.     else if (strEQ(d,"chmod"))
  494.         *d = toupper(*d);
  495.     else if (strEQ(d,"chown"))
  496.         *d = toupper(*d);
  497.     ID(d);
  498.     case 'd': case 'D':
  499.     SNARFWORD;
  500.     if (strEQ(d,"do"))
  501.         XTERM(DO);
  502.     if (strEQ(d,"delete"))
  503.         XTERM(DELETE);
  504.     if (strEQ(d,"die"))
  505.         *d = toupper(*d);
  506.     ID(d);
  507.     case 'e': case 'E':
  508.     SNARFWORD;
  509.     if (strEQ(d,"END"))
  510.         XTERM(END);
  511.     if (strEQ(d,"else"))
  512.         XTERM(ELSE);
  513.     if (strEQ(d,"exit")) {
  514.         saw_line_op = TRUE;
  515.         XTERM(EXIT);
  516.     }
  517.     if (strEQ(d,"exp")) {
  518.         yylval = OEXP;
  519.         XTERM(FUN1);
  520.     }
  521.     if (strEQ(d,"elsif"))
  522.         *d = toupper(*d);
  523.     else if (strEQ(d,"eq"))
  524.         *d = toupper(*d);
  525.     else if (strEQ(d,"eval"))
  526.         *d = toupper(*d);
  527.     else if (strEQ(d,"eof"))
  528.         *d = toupper(*d);
  529.     else if (strEQ(d,"each"))
  530.         *d = toupper(*d);
  531.     else if (strEQ(d,"exec"))
  532.         *d = toupper(*d);
  533.     ID(d);
  534.     case 'f': case 'F':
  535.     SNARFWORD;
  536.     if (strEQ(d,"FS")) {
  537.         saw_FS++;
  538.         if (saw_FS == 1 && in_begin) {
  539.         for (d = s; *d && isspace(*d); d++) ;
  540.         if (*d == '=') {
  541.             for (d++; *d && isspace(*d); d++) ;
  542.             if (*d == '"' && d[2] == '"')
  543.             const_FS = d[1];
  544.         }
  545.         }
  546.         ID(tokenbuf);
  547.     }
  548.     if (strEQ(d,"for"))
  549.         XTERM(FOR);
  550.     else if (strEQ(d,"function"))
  551.         XTERM(FUNCTION);
  552.     if (strEQ(d,"FILENAME"))
  553.         d = "ARGV";
  554.     if (strEQ(d,"foreach"))
  555.         *d = toupper(*d);
  556.     else if (strEQ(d,"format"))
  557.         *d = toupper(*d);
  558.     else if (strEQ(d,"fork"))
  559.         *d = toupper(*d);
  560.     else if (strEQ(d,"fh"))
  561.         *d = toupper(*d);
  562. #ifdef GAWK
  563.     else if (strEQ(d, "FIELDWIDTHS")) {
  564.         saw_FIELDWIDTHS++;
  565.         if (saw_FIELDWIDTHS == 1 && in_begin) {
  566.         for (d = s; *d && isspace(*d); d++) ;
  567.         if (*d == '=') {
  568.             for (d++; *d && isspace(*d); d++) ;
  569.         }
  570.         }
  571.         ID(tokenbuf);
  572.     }
  573. #endif
  574.     ID(d);
  575.     case 'g': case 'G':
  576.     SNARFWORD;
  577.     if (strEQ(d,"getline"))
  578.         XTERM(GETLINE);
  579.     if (strEQ(d,"gsub"))
  580.         XTERM(GSUB);
  581.     if (strEQ(d,"ge"))
  582.         *d = toupper(*d);
  583.     else if (strEQ(d,"gt"))
  584.         *d = toupper(*d);
  585.     else if (strEQ(d,"goto"))
  586.         *d = toupper(*d);
  587.     else if (strEQ(d,"gmtime"))
  588.         *d = toupper(*d);
  589.     ID(d);
  590.     case 'h': case 'H':
  591.     SNARFWORD;
  592.     if (strEQ(d,"hex"))
  593.         *d = toupper(*d);
  594.     ID(d);
  595.     case 'i': case 'I':
  596.     SNARFWORD;
  597.     if (strEQ(d,"if"))
  598.         XTERM(IF);
  599.     if (strEQ(d,"in"))
  600.         XTERM(IN);
  601.     if (strEQ(d,"index")) {
  602.         set_array_base = TRUE;
  603.         XTERM(INDEX);
  604.     }
  605.     if (strEQ(d,"int")) {
  606.         yylval = OINT;
  607.         XTERM(FUN1);
  608.     }
  609.     ID(d);
  610.     case 'j': case 'J':
  611.     SNARFWORD;
  612.     if (strEQ(d,"join"))
  613.         *d = toupper(*d);
  614. #ifdef GAWK
  615.     else if (strEQ(d, "jindex")){
  616.         set_array_base = TRUE;
  617.         saw_jlength = saw_jindex = 1; /* because jindex uses jlength */
  618.         yylval = OJINDEX;
  619.         XTERM(FUNN);
  620.     }
  621.     else if (strEQ(d, "jlength")) {
  622.         set_array_base = TRUE;
  623.         saw_jlength = 1;
  624.         yylval = OJLENGTH;
  625.         XTERM(FUN1);
  626.     }
  627.     else if (strEQ(d, "jsubstr")) {
  628.         set_array_base = TRUE;
  629.         saw_jsubstr = 1;
  630.       /*  yylval = OJSUBSTR;
  631.        * XTERM(FUNN);
  632.        */
  633.     }
  634. #endif
  635.     ID(d);
  636.     case 'k': case 'K':
  637.     SNARFWORD;
  638.     if (strEQ(d,"keys"))
  639.         *d = toupper(*d);
  640.     else if (strEQ(d,"kill"))
  641.         *d = toupper(*d);
  642.     ID(d);
  643.     case 'l': case 'L':
  644.     SNARFWORD;
  645.     if (strEQ(d,"length")) {
  646.         yylval = OLENGTH;
  647.         XTERM(FUN1);
  648.     }
  649.     if (strEQ(d,"log")) {
  650.         yylval = OLOG;
  651.         XTERM(FUN1);
  652.     }
  653.     if (strEQ(d,"last"))
  654.         *d = toupper(*d);
  655.     else if (strEQ(d,"local"))
  656.         *d = toupper(*d);
  657.     else if (strEQ(d,"lt"))
  658.         *d = toupper(*d);
  659.     else if (strEQ(d,"le"))
  660.         *d = toupper(*d);
  661.     else if (strEQ(d,"locatime"))
  662.         *d = toupper(*d);
  663.     else if (strEQ(d,"link"))
  664.         *d = toupper(*d);
  665.     ID(d);
  666.     case 'm': case 'M':
  667.     SNARFWORD;
  668.     if (strEQ(d,"match")) {
  669.         set_array_base = TRUE;
  670.         XTERM(MATCH);
  671.     }
  672.     if (strEQ(d,"m"))
  673.         *d = toupper(*d);
  674.     ID(d);
  675.     case 'n': case 'N':
  676.     SNARFWORD;
  677.     if (strEQ(d,"NF"))
  678.         do_chop = do_split = split_to_array = set_array_base = TRUE;
  679.     if (strEQ(d,"next")) {
  680.         saw_line_op = TRUE;
  681.         XTERM(NEXT);
  682.     }
  683.     if (strEQ(d,"ne"))
  684.         *d = toupper(*d);
  685.     ID(d);
  686.     case 'o': case 'O':
  687.     SNARFWORD;
  688.     if (strEQ(d,"ORS")) {
  689.         saw_ORS = TRUE;
  690.         d = "\\";
  691.     }
  692.     if (strEQ(d,"OFS")) {
  693.         saw_OFS = TRUE;
  694.         d = ",";
  695.     }
  696.     if (strEQ(d,"OFMT")) {
  697.         d = "#";
  698.     }
  699.     if (strEQ(d,"open"))
  700.         *d = toupper(*d);
  701.     else if (strEQ(d,"ord"))
  702.         *d = toupper(*d);
  703.     else if (strEQ(d,"oct"))
  704.         *d = toupper(*d);
  705.     ID(d);
  706.     case 'p': case 'P':
  707.     SNARFWORD;
  708.     if (strEQ(d,"print")) {
  709.         XTERM(PRINT);
  710.     }
  711.     if (strEQ(d,"printf")) {
  712.         XTERM(PRINTF);
  713.     }
  714.     if (strEQ(d,"push"))
  715.         *d = toupper(*d);
  716.     else if (strEQ(d,"pop"))
  717.         *d = toupper(*d);
  718.     ID(d);
  719.     case 'q': case 'Q':
  720.     SNARFWORD;
  721.     ID(d);
  722.     case 'r': case 'R':
  723.     SNARFWORD;
  724.     if (strEQ(d,"RS")) {
  725.         d = "/";
  726.         saw_RS = TRUE;
  727.     }
  728.     if (strEQ(d,"rand")) {
  729.         yylval = ORAND;
  730.         XTERM(FUN1);
  731.     }
  732.     if (strEQ(d,"return"))
  733.         XTERM(RET);
  734.     if (strEQ(d,"reset"))
  735.         *d = toupper(*d);
  736.     else if (strEQ(d,"redo"))
  737.         *d = toupper(*d);
  738.     else if (strEQ(d,"rename"))
  739.         *d = toupper(*d);
  740.     ID(d);
  741.     case 's': case 'S':
  742.     SNARFWORD;
  743.     if (strEQ(d,"split")) {
  744.         set_array_base = TRUE;
  745.         XOP(SPLIT);
  746.     }
  747.     if (strEQ(d,"substr")) {
  748.         set_array_base = TRUE;
  749.         XTERM(SUBSTR);
  750.     }
  751.     if (strEQ(d,"sub"))
  752.         XTERM(SUB);
  753.     if (strEQ(d,"sprintf"))
  754.         XTERM(SPRINTF);
  755.     if (strEQ(d,"sqrt")) {
  756.         yylval = OSQRT;
  757.         XTERM(FUN1);
  758.     }
  759.     if (strEQ(d,"SUBSEP")) {
  760.         d = ";";
  761.     }
  762.     if (strEQ(d,"sin")) {
  763.         yylval = OSIN;
  764.         XTERM(FUN1);
  765.     }
  766.     if (strEQ(d,"srand")) {
  767.         yylval = OSRAND;
  768.         XTERM(FUN1);
  769.     }
  770.     if (strEQ(d,"system")) {
  771.         yylval = OSYSTEM;
  772.         XTERM(FUN1);
  773.     }
  774.     if (strEQ(d,"s"))
  775.         *d = toupper(*d);
  776.     else if (strEQ(d,"shift"))
  777.         *d = toupper(*d);
  778.     else if (strEQ(d,"select"))
  779.         *d = toupper(*d);
  780.     else if (strEQ(d,"seek"))
  781.         *d = toupper(*d);
  782.     else if (strEQ(d,"stat"))
  783.         *d = toupper(*d);
  784.     else if (strEQ(d,"study"))
  785.         *d = toupper(*d);
  786.     else if (strEQ(d,"sleep"))
  787.         *d = toupper(*d);
  788.     else if (strEQ(d,"symlink"))
  789.         *d = toupper(*d);
  790.     else if (strEQ(d,"sort"))
  791.         *d = toupper(*d);
  792. #ifdef GAWK
  793.     else if (strEQ(d, "systime")) {
  794.         yylval = OSYSTIME;
  795.         XTERM(FUN1);
  796.     }
  797. #endif
  798.     ID(d);
  799.     case 't': case 'T':
  800.     SNARFWORD;
  801.     if (strEQ(d,"tr"))
  802.         *d = toupper(*d);
  803.     else if (strEQ(d,"tell"))
  804.         *d = toupper(*d);
  805.     else if (strEQ(d,"time"))
  806.         *d = toupper(*d);
  807.     else if (strEQ(d,"times"))
  808.         *d = toupper(*d);
  809. #ifdef GAWK
  810.     else if (strEQ(d, "toupper")) {
  811.         saw_toupper = 1;
  812.         yylval = OTOUPPER;
  813.         XTERM(FUN1);
  814.     }
  815.     else if (strEQ(d, "tolower")) {
  816.         saw_tolower = 1;
  817.         yylval = OTOLOWER;
  818.         XTERM(FUN1);
  819.     }
  820. #endif
  821.     ID(d);
  822.     case 'u': case 'U':
  823.     SNARFWORD;
  824.     if (strEQ(d,"until"))
  825.         *d = toupper(*d);
  826.     else if (strEQ(d,"unless"))
  827.         *d = toupper(*d);
  828.     else if (strEQ(d,"umask"))
  829.         *d = toupper(*d);
  830.     else if (strEQ(d,"unshift"))
  831.         *d = toupper(*d);
  832.     else if (strEQ(d,"unlink"))
  833.         *d = toupper(*d);
  834.     else if (strEQ(d,"utime"))
  835.         *d = toupper(*d);
  836.     ID(d);
  837.     case 'v': case 'V':
  838.     SNARFWORD;
  839.     if (strEQ(d,"values"))
  840.         *d = toupper(*d);
  841.     ID(d);
  842.     case 'w': case 'W':
  843.     SNARFWORD;
  844.     if (strEQ(d,"while"))
  845.         XTERM(WHILE);
  846.     if (strEQ(d,"write"))
  847.         *d = toupper(*d);
  848.     else if (strEQ(d,"wait"))
  849.         *d = toupper(*d);
  850.     ID(d);
  851.     case 'x': case 'X':
  852.     SNARFWORD;
  853.     if (strEQ(d,"x"))
  854.         *d = toupper(*d);
  855.     ID(d);
  856.     case 'y': case 'Y':
  857.     SNARFWORD;
  858.     if (strEQ(d,"y"))
  859.         *d = toupper(*d);
  860.     ID(d);
  861.     case 'z': case 'Z':
  862.     SNARFWORD;
  863.     ID(d);
  864.     }
  865. }
  866.  
  867. char *
  868. scanpat(s)
  869. register char *s;
  870. {
  871.     register char *d;
  872.  
  873.     switch (*s++) {
  874.     case '/':
  875.     break;
  876.     default:
  877.     fatal("Search pattern not found:\n%s",str_get(linestr));
  878.     }
  879.  
  880.     d = tokenbuf;
  881.     for (; *s; s++,d++) {
  882. /* 1992/08/01 to handle mbchar
  883.  */
  884. #ifdef KANJI
  885.     /* Skip kanji character */
  886.     if (iskanji(*s)) {
  887.         do {
  888.             *d++ = *s++;
  889.             *d++ = *s++;
  890.         } while (iskanji(*s));
  891.     }
  892. #endif
  893.     if (*s == '\\') {
  894.         if (s[1] == '/')
  895.         *d++ = *s++;
  896.         else if (s[1] == '\\')
  897.         *d++ = *s++;
  898.         else if (s[1] == '[')
  899.         *d++ = *s++;
  900.     }
  901.     else if (*s == '[') {
  902.         *d++ = *s++;
  903.         do {
  904. /* 1992/08/01 to handle mbchar
  905.  */
  906. #ifdef KANJI
  907.         /* Skip kanji character */
  908.         if (iskanji(*s)) {
  909.                 do {
  910.                 *d++ = *s++;
  911.                 *d++ = *s++;
  912.             } while (iskanji(*s));
  913.         }
  914. #endif
  915.         if (*s == '\\' && s[1])
  916.             *d++ = *s++;
  917.         if (*s == '/' || (*s == '-' && s[1] == ']'))
  918.             *d++ = '\\';
  919.         *d++ = *s++;
  920.         } while (*s && *s != ']');
  921.     }
  922.     else if (*s == '/')
  923.         break;
  924.     *d = *s;
  925.     }
  926.     *d = '\0';
  927.  
  928.     if (!*s)
  929.     fatal("Search pattern not terminated:\n%s",str_get(linestr));
  930.     s++;
  931.     yylval = string(tokenbuf,0);
  932.     return s;
  933. }
  934.  
  935. yyerror(s)
  936. char *s;
  937. {
  938.     fprintf(stderr,"%s in file %s at line %d\n",
  939.       s,filename,line);
  940. }
  941.  
  942. char *
  943. scannum(s)
  944. register char *s;
  945. {
  946.     register char *d;
  947.  
  948.     switch (*s) {
  949.     case '1': case '2': case '3': case '4': case '5':
  950.     case '6': case '7': case '8': case '9': case '0' : case '.':
  951.     d = tokenbuf;
  952.     while (isdigit(*s)) {
  953.         *d++ = *s++;
  954.     }
  955.     if (*s == '.') {
  956.         if (isdigit(s[1])) {
  957.         *d++ = *s++;
  958.         while (isdigit(*s)) {
  959.             *d++ = *s++;
  960.         }
  961.         }
  962.         else
  963.         s++;
  964.     }
  965.     if (index("eE",*s) && index("+-0123456789",s[1])) {
  966.         *d++ = *s++;
  967.         if (*s == '+' || *s == '-')
  968.         *d++ = *s++;
  969.         while (isdigit(*s))
  970.         *d++ = *s++;
  971.     }
  972.     *d = '\0';
  973.     yylval = string(tokenbuf,0);
  974.     break;
  975.     }
  976.     return s;
  977. }
  978.  
  979. string(ptr,len)
  980. char *ptr;
  981. {
  982.     int retval = mop;
  983.  
  984.     ops[mop++].ival = OSTRING + (1<<8);
  985.     if (!len)
  986.     len = strlen(ptr);
  987.     ops[mop].cval = safemalloc(len+1);
  988.     strncpy(ops[mop].cval,ptr,len);
  989.     ops[mop++].cval[len] = '\0';
  990.     if (mop >= OPSMAX)
  991.     fatal("Recompile a2p with larger OPSMAX\n");
  992.     return retval;
  993. }
  994.  
  995. oper0(type)
  996. int type;
  997. {
  998.     int retval = mop;
  999.  
  1000.     if (type > 255)
  1001.     fatal("type > 255 (%d)\n",type);
  1002.     ops[mop++].ival = type;
  1003.     if (mop >= OPSMAX)
  1004.     fatal("Recompile a2p with larger OPSMAX\n");
  1005.     return retval;
  1006. }
  1007.  
  1008. oper1(type,arg1)
  1009. int type;
  1010. int arg1;
  1011. {
  1012.     int retval = mop;
  1013.  
  1014.     if (type > 255)
  1015.     fatal("type > 255 (%d)\n",type);
  1016.     ops[mop++].ival = type + (1<<8);
  1017.     ops[mop++].ival = arg1;
  1018.     if (mop >= OPSMAX)
  1019.     fatal("Recompile a2p with larger OPSMAX\n");
  1020.     return retval;
  1021. }
  1022.  
  1023. oper2(type,arg1,arg2)
  1024. int type;
  1025. int arg1;
  1026. int arg2;
  1027. {
  1028.     int retval = mop;
  1029.  
  1030.     if (type > 255)
  1031.     fatal("type > 255 (%d)\n",type);
  1032.     ops[mop++].ival = type + (2<<8);
  1033.     ops[mop++].ival = arg1;
  1034.     ops[mop++].ival = arg2;
  1035.     if (mop >= OPSMAX)
  1036.     fatal("Recompile a2p with larger OPSMAX\n");
  1037.     return retval;
  1038. }
  1039.  
  1040. oper3(type,arg1,arg2,arg3)
  1041. int type;
  1042. int arg1;
  1043. int arg2;
  1044. int arg3;
  1045. {
  1046.     int retval = mop;
  1047.  
  1048.     if (type > 255)
  1049.     fatal("type > 255 (%d)\n",type);
  1050.     ops[mop++].ival = type + (3<<8);
  1051.     ops[mop++].ival = arg1;
  1052.     ops[mop++].ival = arg2;
  1053.     ops[mop++].ival = arg3;
  1054.     if (mop >= OPSMAX)
  1055.     fatal("Recompile a2p with larger OPSMAX\n");
  1056.     return retval;
  1057. }
  1058.  
  1059. oper4(type,arg1,arg2,arg3,arg4)
  1060. int type;
  1061. int arg1;
  1062. int arg2;
  1063. int arg3;
  1064. int arg4;
  1065. {
  1066.     int retval = mop;
  1067.  
  1068.     if (type > 255)
  1069.     fatal("type > 255 (%d)\n",type);
  1070.     ops[mop++].ival = type + (4<<8);
  1071.     ops[mop++].ival = arg1;
  1072.     ops[mop++].ival = arg2;
  1073.     ops[mop++].ival = arg3;
  1074.     ops[mop++].ival = arg4;
  1075.     if (mop >= OPSMAX)
  1076.     fatal("Recompile a2p with larger OPSMAX\n");
  1077.     return retval;
  1078. }
  1079.  
  1080. oper5(type,arg1,arg2,arg3,arg4,arg5)
  1081. int type;
  1082. int arg1;
  1083. int arg2;
  1084. int arg3;
  1085. int arg4;
  1086. int arg5;
  1087. {
  1088.     int retval = mop;
  1089.  
  1090.     if (type > 255)
  1091.     fatal("type > 255 (%d)\n",type);
  1092.     ops[mop++].ival = type + (5<<8);
  1093.     ops[mop++].ival = arg1;
  1094.     ops[mop++].ival = arg2;
  1095.     ops[mop++].ival = arg3;
  1096.     ops[mop++].ival = arg4;
  1097.     ops[mop++].ival = arg5;
  1098.     if (mop >= OPSMAX)
  1099.     fatal("Recompile a2p with larger OPSMAX\n");
  1100.     return retval;
  1101. }
  1102.  
  1103. int depth = 0;
  1104.  
  1105. dump(branch)
  1106. int branch;
  1107. {
  1108.     register int type;
  1109.     register int len;
  1110.     register int i;
  1111.  
  1112.     type = ops[branch].ival;
  1113.     len = type >> 8;
  1114.     type &= 255;
  1115.     for (i=depth; i; i--)
  1116.     printf(" ");
  1117.     if (type == OSTRING) {
  1118.     printf("%-5d\"%s\"\n",branch,ops[branch+1].cval);
  1119.     }
  1120.     else {
  1121.     printf("(%-5d%s %d\n",branch,opname[type],len);
  1122.     depth++;
  1123.     for (i=1; i<=len; i++)
  1124.         dump(ops[branch+i].ival);
  1125.     depth--;
  1126.     for (i=depth; i; i--)
  1127.         printf(" ");
  1128.     printf(")\n");
  1129.     }
  1130. }
  1131.  
  1132. bl(arg,maybe)
  1133. int arg;
  1134. int maybe;
  1135. {
  1136.     if (!arg)
  1137.     return 0;
  1138.     else if ((ops[arg].ival & 255) != OBLOCK)
  1139.     return oper2(OBLOCK,arg,maybe);
  1140.     else if ((ops[arg].ival >> 8) < 2)
  1141.     return oper2(OBLOCK,ops[arg+1].ival,maybe);
  1142.     else
  1143.     return arg;
  1144. }
  1145.  
  1146. fixup(str)
  1147. STR *str;
  1148. {
  1149.     register char *s;
  1150.     register char *t;
  1151.  
  1152.     for (s = str->str_ptr; *s; s++) {
  1153.     if (*s == ';' && s[1] == ' ' && s[2] == '\n') {
  1154.         strcpy(s+1,s+2);
  1155.         s++;
  1156.     }
  1157.     else if (*s == '\n') {
  1158.         for (t = s+1; isspace(*t & 127); t++) ;
  1159.         t--;
  1160.         while (isspace(*t & 127) && *t != '\n') t--;
  1161.         if (*t == '\n' && t-s > 1) {
  1162.         if (s[-1] == '{')
  1163.             s--;
  1164.         strcpy(s+1,t);
  1165.         }
  1166.         s++;
  1167.     }
  1168.     }
  1169. }
  1170.  
  1171. putlines(str)
  1172. STR *str;
  1173. {
  1174.     register char *d, *s, *t, *e;
  1175.     register int pos, newpos;
  1176.  
  1177.     d = tokenbuf;
  1178.     pos = 0;
  1179.     for (s = str->str_ptr; *s; s++) {
  1180.     *d++ = *s;
  1181.     pos++;
  1182.     if (*s == '\n') {
  1183.         *d = '\0';
  1184.         d = tokenbuf;
  1185.         pos = 0;
  1186.         putone();
  1187.     }
  1188.     else if (*s == '\t')
  1189.         pos += 7;
  1190.  
  1191. /* is this buggy? */
  1192. #ifdef SPLIT_LINE
  1193.     if (pos > 78) {        /* split a long line? */
  1194.         *d-- = '\0';
  1195.         newpos = 0;
  1196. /* 1992/08/01 to handle mbchar
  1197.  */
  1198. #ifdef KANJI
  1199.         for (t = tokenbuf; isspace(*t); t++) {
  1200. #else
  1201.         for (t = tokenbuf; isspace(*t & 127); t++) {
  1202. #endif
  1203.         if (*t == '\t')
  1204.             newpos += 8;
  1205.         else
  1206.             newpos += 1;
  1207.         }
  1208.         e = d;
  1209.         while (d > tokenbuf && (*d != ' ' || d[-1] != ';'))
  1210.         d--;
  1211.         if (d < t+10) {
  1212.         d = e;
  1213.         while (d > tokenbuf &&
  1214.           (*d != ' ' || d[-1] != '|' || d[-2] != '|') )
  1215.             d--;
  1216.         }
  1217.         if (d < t+10) {
  1218.         d = e;
  1219.         while (d > tokenbuf &&
  1220.           (*d != ' ' || d[-1] != '&' || d[-2] != '&') )
  1221.             d--;
  1222.         }
  1223.         if (d < t+10) {
  1224.         d = e;
  1225.         while (d > tokenbuf && (*d != ' ' || d[-1] != ','))
  1226.             d--;
  1227.         }
  1228.         if (d < t+10) {
  1229.         d = e;
  1230.         while (d > tokenbuf && *d != ' ')
  1231.             d--;
  1232.         }
  1233.         if (d > t+3) {
  1234.                 char save[2048];
  1235.                 strcpy(save, d);
  1236.         *d = '\n';
  1237.                 d[1] = '\0';
  1238.         putone();
  1239.         putchar('\n');
  1240.         if (d[-1] != ';' && !(newpos % 4)) {
  1241.             *t++ = ' ';
  1242.             *t++ = ' ';
  1243.             newpos += 2;
  1244.         }
  1245.         strcpy(t,save+1);
  1246.         newpos += strlen(t);
  1247.         d = t + strlen(t);
  1248.         pos = newpos;
  1249.         }
  1250.         else
  1251.         d = e + 1;
  1252.     }
  1253. #endif /* SPLIT_LONG */
  1254.     }
  1255. }
  1256.  
  1257. putone()
  1258. {
  1259. /* 1992/08/01 to handle mbchar
  1260.  */
  1261. #ifdef KANJI
  1262.     register unsigned char *t;
  1263. #else
  1264.     register char *t;
  1265. #endif
  1266.  
  1267.     for (t = tokenbuf; *t; t++) {
  1268. /* 1992/08/01 to handle mbchar
  1269.  */
  1270. #ifdef KANJI
  1271.     /* *t &= 127; */
  1272.     if (*t == 0xff) {
  1273.         *t = ' ';
  1274.         strcpy(t+strlen(t)-1, "\t#???\n");
  1275.         checkers++;
  1276.     }
  1277. #else
  1278.     *t &= 127;
  1279.     if (*t == 127) {
  1280.         *t = ' ';
  1281.         strcpy(t+strlen(t)-1, "\t#???\n");
  1282.         checkers++;
  1283.     }
  1284. #endif
  1285.     }
  1286.     t = tokenbuf;
  1287.     if (*t == '#') {
  1288.     if (strnEQ(t,"#!/bin/awk",10) || strnEQ(t,"#! /bin/awk",11))
  1289.         return;
  1290.     if (strnEQ(t,"#!/usr/bin/awk",14) || strnEQ(t,"#! /usr/bin/awk",15))
  1291.         return;
  1292.     }
  1293.     fputs(tokenbuf,stdout);
  1294. }
  1295.  
  1296. numary(arg)
  1297. int arg;
  1298. {
  1299.     STR *key;
  1300.     int dummy;
  1301.  
  1302.     key = walk(0,0,arg,&dummy,P_MIN);
  1303.     str_cat(key,"[]");
  1304.     hstore(symtab,key->str_ptr,str_make("1"));
  1305.     str_free(key);
  1306.     set_array_base = TRUE;
  1307.     return arg;
  1308. }
  1309.  
  1310. rememberargs(arg)
  1311. int arg;
  1312. {
  1313.     int type;
  1314.     STR *str;
  1315.  
  1316.     if (!arg)
  1317.     return arg;
  1318.     type = ops[arg].ival & 255;
  1319.     if (type == OCOMMA) {
  1320.     rememberargs(ops[arg+1].ival);
  1321.     rememberargs(ops[arg+3].ival);
  1322.     }
  1323.     else if (type == OVAR) {
  1324.     str = str_new(0);
  1325.     hstore(curarghash,ops[ops[arg+1].ival+1].cval,str);
  1326.     }
  1327.     else
  1328.     fatal("panic: unknown argument type %d, line %d\n",type,line);
  1329.     return arg;
  1330. }
  1331.  
  1332. aryrefarg(arg)
  1333. int arg;
  1334. {
  1335.     int type = ops[arg].ival & 255;
  1336.     STR *str;
  1337.  
  1338.     if (type != OSTRING)
  1339.     fatal("panic: aryrefarg %d, line %d\n",type,line);
  1340.     str = hfetch(curarghash,ops[arg+1].cval);
  1341.     if (str)
  1342.     str_set(str,"*");
  1343.     return arg;
  1344. }
  1345.  
  1346. fixfargs(name,arg,prevargs)
  1347. int name;
  1348. int arg;
  1349. int prevargs;
  1350. {
  1351.     int type;
  1352.     STR *str;
  1353.     int numargs;
  1354.  
  1355.     if (!arg)
  1356.     return prevargs;
  1357.     type = ops[arg].ival & 255;
  1358.     if (type == OCOMMA) {
  1359.     numargs = fixfargs(name,ops[arg+1].ival,prevargs);
  1360.     numargs = fixfargs(name,ops[arg+3].ival,numargs);
  1361.     }
  1362.     else if (type == OVAR) {
  1363.     str = hfetch(curarghash,ops[ops[arg+1].ival+1].cval);
  1364.     if (strEQ(str_get(str),"*")) {
  1365.         char tmpbuf[128];
  1366.  
  1367.         str_set(str,"");        /* in case another routine has this */
  1368.         ops[arg].ival &= ~255;
  1369.         ops[arg].ival |= OSTAR;
  1370.         sprintf(tmpbuf,"%s:%d",ops[name+1].cval,prevargs);
  1371.         fprintf(stderr,"Adding %s\n",tmpbuf);
  1372.         str = str_new(0);
  1373.         str_set(str,"*");
  1374.         hstore(curarghash,tmpbuf,str);
  1375.     }
  1376.     numargs = prevargs + 1;
  1377.     }
  1378.     else
  1379.     fatal("panic: unknown argument type %d, arg %d, line %d\n",
  1380.       type,prevargs+1,line);
  1381.     return numargs;
  1382. }
  1383.  
  1384. fixrargs(name,arg,prevargs)
  1385. char *name;
  1386. int arg;
  1387. int prevargs;
  1388. {
  1389.     int type;
  1390.     STR *str;
  1391.     int numargs;
  1392.  
  1393.     if (!arg)
  1394.     return prevargs;
  1395.     type = ops[arg].ival & 255;
  1396.     if (type == OCOMMA) {
  1397.     numargs = fixrargs(name,ops[arg+1].ival,prevargs);
  1398.     numargs = fixrargs(name,ops[arg+3].ival,numargs);
  1399.     }
  1400.     else {
  1401.     char tmpbuf[128];
  1402.  
  1403.     sprintf(tmpbuf,"%s:%d",name,prevargs);
  1404.     str = hfetch(curarghash,tmpbuf);
  1405.     if (str && strEQ(str->str_ptr,"*")) {
  1406.         if (type == OVAR || type == OSTAR) {
  1407.         ops[arg].ival &= ~255;
  1408.         ops[arg].ival |= OSTAR;
  1409.         }
  1410.         else
  1411.         fatal("Can't pass expression by reference as arg %d of %s\n",
  1412.             prevargs+1, name);
  1413.     }
  1414.     numargs = prevargs + 1;
  1415.     }
  1416.     return numargs;
  1417. }
  1418.  
  1419.