home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / vol_300 / 333_01 / awk1.c < prev    next >
C/C++ Source or Header  |  1989-04-22  |  26KB  |  982 lines
  1.  
  2. /***************************************************************************/
  3. /*                                       */
  4. /*     awk1 -- Expression tree constructors and main program for gawk.       */
  5. /*                                       */
  6. /*         Copyright (C) 1986 Free Software Foundation           */
  7. /*             Written by Paul Rubin, August 1986            */
  8. /*                                       */
  9. /***************************************************************************/
  10. /*                                       */
  11. /* GAWK is distributed in the hope that it will be useful, but WITHOUT ANY */
  12. /* WARRANTY.  No author or distributor accepts responsibility to anyone    */
  13. /* for the consequences of using it or for whether it serves any       */
  14. /* particular purpose or works at all, unless he says so in writing.       */
  15. /* Refer to the GAWK General Public License for full details.           */
  16. /*                                       */
  17. /* Everyone is granted permission to copy, modify and redistribute GAWK,   */
  18. /* but only under the conditions described in the GAWK General Public       */
  19. /* License.  A copy of this license is supposed to have been given to you  */
  20. /* along with GAWK so you can know your rights and responsibilities.  It   */
  21. /* should be in a file named COPYING.  Among other things, the copyright   */
  22. /* notice and this notice must be preserved on all copies.           */
  23. /*                                       */
  24. /* In other words, go ahead and share GAWK, but don't try to stop          */
  25. /* anyone else from sharing it farther.  Help stamp out software hoarding! */
  26. /*                                       */
  27. /***************************************************************************/
  28. /*                                       */
  29. /* Extensive code restructuring and port to MSDOS and MS OS/2 by:       */
  30. /*                                       */
  31. /*                  Bob Withers                   */
  32. /*               649 Meadowbrook St.                   */
  33. /*               Allen, Texas 75002                   */
  34. /*                December 8, 1988                   */
  35. /*                                       */
  36. /* The current state of gAWK (at least this version) is a subset of the    */
  37. /* AWK langauge as released on Unix in 1985 and defined in the book "The   */
  38. /* AWK Programming Langauge" by Aho, Kernighan, and Weinberger (1988).     */
  39. /* Following are language elements which are not supported in this       */
  40. /* version:                                   */
  41. /*                                       */
  42. /* -  Actions                                   */
  43. /*                                       */
  44. /*    o  User defined functions are not supported               */
  45. /*                                       */
  46. /*    o  The "return [expression]" statement is not supported           */
  47. /*                                       */
  48. /*    o  The "delete array[i]" statement is not supported           */
  49. /*     + Support added for "delete" by BW 01/02/89               */
  50. /*                                       */
  51. /* -  Input/Output                               */
  52. /*                                       */
  53. /*    o  The "close(expr)" statement is not supported               */
  54. /*     +  Support for close() added by BW 12/21/88               */
  55. /*        -    close(exp)   ==> close file represented by "exp"       */
  56. /*        -    close()      ==> close all redirected files           */
  57. /*        -    returns 1 for success, 0 for file not found           */
  58. /*                                       */
  59. /*    o  The "system(cmd_line)" statement is not supported           */
  60. /*     +  Support for "system" added by BW 12/6/88               */
  61. /*                                       */
  62. /*    o  Use of pipes is not supported                                     */
  63. /*                                                                         */
  64. /*    o  Output redirection to files is supported for print and printf     */
  65. /*       but there is not support for input redirection via getline        */
  66. /*                                       */
  67. /* -  Built-in Variables                           */
  68. /*                                       */
  69. /*    o  The following built-in variables are not supported:           */
  70. /*                                       */
  71. /*       ARGC      -- Support added by BW 12/26/88           */
  72. /*       ARGV      -- Support added by BW 12/26/88           */
  73. /*       FNR         -- Support added by BW 12/01/88           */
  74. /*       RLENGTH     -- Support added by BW 12/21/88           */
  75. /*       RSTART     -- Support added by BW 12/21/88           */
  76. /*       SUBSEP     -- Support added by BW 12/26/88           */
  77. /*                                       */
  78. /* -  Built-in String Functions                        */
  79. /*                                       */
  80. /*    o  The following built-in string functions are not supported:       */
  81. /*                                       */
  82. /*       gsub(r, s, t) -- Support added by BW 12/22/88           */
  83. /*       match(s, r)     -- Support added by BW 12/21/88           */
  84. /*       sub(r, s, t)  -- Support added by BW 12/22/88           */
  85. /*                                       */
  86. /* -  Built-in Arithmetic Functions                       */
  87. /*                                       */
  88. /*    o  The following built-in arithmetic functions are not supported:    */
  89. /*                                       */
  90. /*       atan2(y, x)     -- Support added by BW 12/03/88           */
  91. /*       cos(x)     -- Support added by BW 12/03/88           */
  92. /*       rand()     -- Support added by BW 12/20/88           */
  93. /*       sin(x)     -- Support added by BW 12/03/88           */
  94. /*       srand(x)     -- Support added by BW 12/20/88           */
  95. /*                                       */
  96. /* -  Expression Operators                           */
  97. /*                                       */
  98. /*    o  The match operator (~) and not match operator (!~) only work       */
  99. /*     on hardcoded regular expressions.  They do not work on regular    */
  100. /*     expressions in a variable.                       */
  101. /*     + Support for matching regular expression stored in a variable    */
  102. /*       added by BW 01/06/88.  The variable is forced to a string and   */
  103. /*       compiled as a regular expression.  If it contains an invalid    */
  104. /*       regular expression execution is terminated with error msg.       */
  105. /*                                       */
  106. /*    o  The exponentiation operator (^) is not supported           */
  107. /*     + Support for ^ added by BW 12/12/88.                   */
  108. /*                                                                         */
  109. /*    o  The conditional expression "exp1 ? exp2 : exp3" is not supported  */
  110. /*     + This has been fixed by BW on 12/20/88               */
  111. /*                                       */
  112. /* -  Misc                                   */
  113. /*                                       */
  114. /*    o  Source lines to be continued MUST be terminated by a backslash.   */
  115. /*     Unix AWK allows lines to be continued at a comma without a       */
  116. /*     backslash, gAWK does not.                       */
  117. /*     + This was fixed by BW 12/13/88                   */
  118. /*                                       */
  119. /*    o  Unix AWK allows a simple print statement to either use parens       */
  120. /*     or not.  gAWK does not allow parens on simple print's.            */
  121. /*     + This was fixed by BW 12/13/88                   */
  122. /*                                       */
  123. /*    o  gAWK only allowed a single level of subscripting on array names.  */
  124. /*     This was changed to support multi-level subscripts in the       */
  125. /*     manner described in "The AWK Programming Language" which converts */
  126. /*     multidimension subscripts to a single subscript separated by       */
  127. /*     the value of special variable SUBSEP.                   */
  128. /*                                       */
  129. /*    o  The %f and %e format specifiers for printf() did not work       */
  130. /*     properly.  This was fixed by BW.                   */
  131. /*                                       */
  132. /*    o  Large number of assumptions that sizeof(int) == sizeof(char *)    */
  133. /*     were corrected by BW.                           */
  134. /*                                       */
  135. /*    o  The split() function did not work properly when multiple field    */
  136. /*     separators appeared between fields.  This was fixed by BW.       */
  137. /*                                       */
  138. /*    o  The FS variable was enhanced to support regular expressions       */
  139. /*     rather than the single character field seperator.  While this       */
  140. /*     is not documented in "The AWK Programming Language" it is       */
  141. /*     implemented in the latest AWK version on UNIX (called NAWK).       */
  142. /*     The default value of FS was changed from " " to "[\t ]+".       */
  143. /*                                       */
  144. /* -  gAWK extensions - BW 12/20/88                       */
  145. /*                                       */
  146. /*    o  upper function added to return the string value of its argument   */
  147. /*     converted to all upper case:                       */
  148. /*                                       */
  149. /*          $1 = upper($1)                       */
  150. /*                                       */
  151. /*    o  lower function added to return the string value of its argument   */
  152. /*     converted to all lower case:                       */
  153. /*                                       */
  154. /*          $1 = lower($1)                       */
  155. /*                                       */
  156. /*    o  reverse function added to return the string value of its       */
  157. /*     argument reversed:                           */
  158. /*                                       */
  159. /*          $1 = reverse($1)                       */
  160. /*                                       */
  161. /***************************************************************************/
  162.  
  163.  
  164. #define DRIVER
  165.  
  166. #include <stdio.h>
  167. #include <stdlib.h>
  168. #include <string.h>
  169. #include <stdarg.h>
  170. #include "awk.h"
  171.  
  172. #define VERSION             "3.00"
  173.  
  174. STATIC char *  NEAR PASCAL  extract_module_name(char *argv0);
  175.  
  176.  
  177. static char        *pgm_storage = NULL;
  178.  
  179.  
  180.  
  181. main(int argc, char *argv[])
  182. {
  183.     register int    i;
  184.     register NODE      *tmp;
  185.     auto     NODE     **nptr;
  186.     auto     int    j;
  187.     auto     char     **ptr, *p;
  188.  
  189. #ifndef FAST
  190.     /* Print out the parse tree.   For debugging */
  191.     register int    dotree = 0;
  192.     extern int        yydebug;
  193. #endif
  194.  
  195.     extern char        *lexptr;
  196.     extern char        *lexptr_begin;
  197.     FILE           *fp;
  198.  
  199. #if PROFILER
  200. /** StartProfile("AWK"); **/
  201. #endif
  202.     --argc;
  203.     myname = extract_module_name(*argv++);
  204.     if (!argc)
  205.     usage();
  206.  
  207.     /* Tell the regex routines how they should work. . . */
  208.     re_set_syntax(RE_NO_BK_PARENS | RE_NO_BK_VBAR);
  209.  
  210.     /* Set up the stack for temporary strings */
  211.     obstack_init(&temp_strings);
  212.     ob_dummy = obstack_alloc(&temp_strings, 0);
  213.  
  214.     /* Set up the other stack for other things */
  215.     obstack_init(&other_stack);
  216.     /* initialize the null string */
  217.     Nnull_string = make_string("", 0);
  218.  
  219.     /* initialize the temp regular expression buffer */
  220.     memset(&wrk_repat, 0, sizeof(wrk_repat));
  221.     wrk_repat.fastmap    = wrk_fastmap;
  222.     wrk_repat.allocated = 200;
  223.     if (NULL == (wrk_repat.buffer = malloc(200)))
  224.     panic("Out of memory for repat work buffer");
  225.  
  226.     /* Set up the special variables */
  227.     /* Note that this must be done BEFORE arg parsing else -R and -F break
  228.      * horribly */
  229.  
  230.     init_vars();
  231.  
  232.     for (; *argv && **argv == '-'; argc--, argv++)
  233.     {
  234.     switch (argv[0][1])
  235.     {
  236. #ifndef FAST
  237.         case 'd':
  238.         debugging++;
  239.         dotree++;
  240.         break;
  241.         case 'D':
  242.         debugging++;
  243.         yydebug = 2;
  244.         break;
  245. #endif
  246.         case 'R':     /* This feature isn't in un*x awk, might be useful */
  247.         set_rs(&argv[0][2]);
  248.         break;
  249.         case 'F':
  250.         set_fs(&argv[0][2]);
  251.         break;
  252.  
  253.         /* It would be better to read the input file in as we parse
  254.          * it.  Its done this way for hysterical reasons.  Feel free
  255.          * to fix it.
  256.          */
  257.         case 'f':
  258.         if (lexptr)
  259.             panic("Can only use one -f option");
  260.         if ((fp = fopen(argv[1], "r")) == NULL)
  261.             er_panic(argv[1]);
  262.         else
  263.         {
  264.             auto     char      *curptr;
  265.             auto     int    siz, nread;
  266.  
  267.             curptr = lexptr = malloc(2000);
  268.             if (curptr == NULL)
  269.             panic("Memory exhausted");
  270.  
  271.             siz = 2000;
  272.             i    = siz - 1;
  273.             while ((nread = fread(curptr, sizeof(char), i, fp)) > 0)
  274.             {
  275.             curptr += nread;
  276.             i -= nread;
  277.             if (i == 0)
  278.             {
  279.                 lexptr = realloc(lexptr, siz * 2);
  280.                 if (lexptr == NULL)
  281.                 panic("Memory exhausted");
  282.                 curptr = lexptr + siz - 1;
  283.                 i = siz;
  284.                 siz *= 2;
  285.             }
  286.             }
  287.             *curptr = EOS;
  288.             pgm_storage = lexptr;
  289.             fclose(fp);
  290.         }
  291.         argc--;
  292.         argv++;
  293.         break;
  294.         case EOS:           /* A file */
  295.         break;
  296.         default:
  297.         panic("Unknown option %s", argv[0]);
  298.     }
  299.     }
  300. #ifndef FAST
  301.     if (debugging)
  302.     setbuf(stdout, 0);    /* jfw: make debugging easier */
  303. #endif
  304.     /* No -f option, use next arg */
  305.     if (!lexptr)
  306.     {
  307.     if (!argc)
  308.         usage();
  309.     lexptr = *argv++;
  310.     --argc;
  311.     }
  312.  
  313.     /* Read in the program */
  314.     lexptr_begin = lexptr;
  315.     (void) yyparse();
  316.     free(pgm_storage);     /* BW: I see no reason to leave this allocated     */
  317.  
  318.     /* Anything allocated on the other_stack after here will be freed when  */
  319.     /* the next input line is read.                        */
  320.     parse_end = obstack_alloc(&other_stack, 0);
  321.  
  322. #ifndef FAST
  323.     if (dotree)
  324.     {
  325.     printf("Parse tree before execution:\n");
  326.     print_parse_tree(expression_value);
  327.     }
  328. #endif
  329.     /* Set up the field variables */
  330.     init_fields();
  331.  
  332.     if (argc == 0)
  333.     {
  334.     static char    *dumb[2] = { "-", NULL };
  335.  
  336.     argc = 1;
  337.     argv = &dumb[0];
  338.     }
  339.  
  340.     for (ptr = argv, i = argc, j = 0; i > 0; --i)
  341.     {
  342.     if (NULL != *ptr)
  343.     {
  344.         ++j;
  345.         assign_number(&ARGC_node->var_value, (AWKNUM) (j + 1));
  346.         nptr  = assoc_lookup(ARGV_node, tmp_number((AWKNUM) j),
  347.                  ASSOC_CREATE);
  348.         *nptr = make_string(*ptr, strlen(*ptr));
  349.     }
  350.     ++ptr;
  351.     }
  352.  
  353.     /* Look for BEGIN and END blocks.  Only one of each allowed */
  354.     for (tmp = expression_value; tmp; tmp = tmp->rnode)
  355.     {
  356.     if (!tmp->lnode || !tmp->lnode->lnode)
  357.         continue;
  358.     if (tmp->lnode->lnode->type == NODE_K_BEGIN)
  359.     {
  360.         if (begin_block)
  361.         panic("More than one BEGIN block found");
  362.         else
  363.         begin_block = tmp->lnode->rnode;
  364.     }
  365.     else
  366.     {
  367.         if (tmp->lnode->lnode->type == NODE_K_END)
  368.         {
  369.         if (end_block)
  370.             panic("More than one END block found");
  371.         else
  372.             end_block = tmp->lnode->rnode;
  373.         }
  374.     }
  375.     }
  376.     if (begin_block && interpret(begin_block) == 0)
  377.     exit(0);
  378.  
  379.     j = 0;
  380.     while (TRUE)
  381.     {
  382.     i = (int) force_number(ARGC_node->var_value);
  383.     if (++j >= i)
  384.         break;
  385.  
  386.     nptr = assoc_lookup(ARGV_node, tmp_number((AWKNUM) j), ASSOC_TEST);
  387.     if (NULL == nptr)
  388.         panic("Invalid array element found at ARGV[%d]", j);
  389.  
  390.     tmp = force_string(*nptr);
  391.     if (0 == tmp->stlen)
  392.         continue;
  393.     strcpy(current_filename, tmp->stptr);
  394.  
  395.     p = strchr(current_filename, '=');
  396.     if (p)
  397.     {
  398.         *p++ = EOS;
  399.          variable(current_filename)->var_value = make_string(p, strlen(p));
  400.     }
  401.     else
  402.     {
  403.         assign_number(&FNR_node->var_value, (AWKNUM) 0.0);
  404.         deref = FILENAME_node->var_value;
  405.         do_deref();
  406.         FILENAME_node->var_value =
  407.             make_string(current_filename, strlen(current_filename));
  408.  
  409.         if (0 == strcmp(current_filename, "-"))
  410.         input_file = stdin;
  411.         else
  412.         {
  413.         input_file = fopen(current_filename, "r");
  414.         if (NULL == input_file)
  415.             er_panic(current_filename);
  416.         }
  417.  
  418.         if (inrec(input_file) == 0)
  419.         {
  420.         do
  421.         {
  422.             obstack_free(&temp_strings, ob_dummy);
  423.         } while (interpret(expression_value)
  424.                    && inrec(input_file) == 0);
  425.         }
  426.  
  427.         deref = FILENAME_node->var_value;
  428.         do_deref();
  429.         if (input_file != stdin)
  430.         fclose(input_file);
  431.     }
  432.     }
  433.     if (end_block)
  434.     (void) interpret(end_block);
  435.  
  436. #ifndef FAST
  437.     if (dotree)
  438.     {
  439.     printf("\nParse tree after execution:\n");
  440.     print_parse_tree(expression_value);
  441.     }
  442. #endif
  443.  
  444.     close_redirect_files();
  445. #if PROFILER
  446. /** EndProfile(); **/
  447. #endif
  448.     return(0);
  449. }
  450.  
  451.  
  452. STATIC char * NEAR PASCAL extract_module_name(register char *argv0)
  453. {
  454.     register char    *p;
  455.  
  456.     p = argv0 + strlen(argv0);
  457.     while (--p > argv0)
  458.     {
  459.     if ('.' == *p)
  460.         *p = EOS;
  461.     else
  462.         if ('\\' == *p || '/' == *p)
  463.         return(++p);
  464.     }
  465.     return(p);
  466. }
  467.  
  468.  
  469. void PASCAL clear_wrk_repat()
  470. {
  471.     wrk_repat.used           = 0;
  472.     wrk_repat.fastmap_accurate = FALSE;
  473.     wrk_repat.can_be_null      = 0;
  474.     return;
  475. }
  476.  
  477.  
  478. /* These exit values are arbitrary */
  479.  
  480. VOID panic(char *str, ...)
  481. {
  482.     auto     va_list        va;
  483.  
  484.     fprintf(stderr, "%s: ", myname);
  485.  
  486.     va_start(va, str);
  487.     vfprintf(stderr, str, va);
  488.     va_end(va);
  489.  
  490.     fprintf(stderr, "\n");
  491.     exit(12);
  492. }
  493.  
  494.  
  495.  
  496. VOID PASCAL er_panic(char *str)
  497. {
  498.     fprintf(stderr, "%s: ", myname);
  499.     perror(str);
  500.     exit(15);
  501. }
  502.  
  503.  
  504.  
  505. VOID PASCAL usage(void)
  506. {
  507.     fprintf(stderr, "\nGNU AWK Version %s\n", VERSION);
  508.     fprintf(stderr, "Extensive modification and enhancement by Bob Withers\n");
  509.     fprintf(stderr, "Permission to freely copy as provided by the ");
  510.     fprintf(stderr, "GNU Project charter\n\n");
  511.     fprintf(stderr,
  512.     "%s: usage: %s {-f progfile | program } [-F{c} -R{c}] file . . .\n",
  513.     myname, myname);
  514.     exit(11);
  515. }
  516.  
  517.  
  518.  
  519. /* This allocates a new node of type ty.  Note that this node will not go
  520.    away unless freed, so don't use it for tmp storage */
  521.  
  522. NODE * PASCAL newnode(int ty)
  523. {
  524.     register NODE      *r;
  525.  
  526.     r = (NODE *) malloc(sizeof(NODE));
  527.     if (r == NULL)
  528.     panic("Out of memory in function newnode()");
  529.     r->type = ty;
  530.     return(r);
  531. }
  532.  
  533.  
  534. /* Duplicate a node.  (For global strings, "duplicate" means crank up       */
  535. /* the reference count.)  This creates global nodes. . .           */
  536.  
  537. NODE * PASCAL dupnode(NODE *n)
  538. {
  539.     register NODE      *r;
  540.  
  541.     if (n->type == NODE_STRING)
  542.     {
  543.     n->stref++;
  544.     return(n);
  545.     }
  546.     else
  547.     {
  548.     if (n->type == NODE_TEMP_STRING)
  549.     {
  550.         r         = newnode(NODE_STRING);
  551.         r->stlen = n->stlen;
  552.         r->stref = 1;
  553.         r->stptr = malloc(n->stlen + 1);
  554.         if (r->stptr == NULL)
  555.         panic("Out of memory in function dupnode()");
  556.         memcpy(r->stptr, n->stptr, n->stlen);
  557.         r->stptr[r->stlen] = EOS;       /* JF for hackval */
  558.         return(r);
  559.     }
  560.     else
  561.     {
  562.         r  = newnode(NODE_ILLEGAL);
  563.         *r = *n;
  564.         return(r);
  565.     }
  566.     }
  567. }
  568.  
  569.  
  570. /* This allocates a node with defined lnode and rnode. */
  571. /* This should only be used by yyparse+co while
  572.    reading in the program */
  573.  
  574. NODE * PASCAL node(NODE *left, int op, NODE *right)
  575. {
  576.     register NODE  *r;
  577.  
  578.     r         = (NODE *) obstack_alloc(&other_stack, sizeof(NODE));
  579.     r->type  = op;
  580.     r->lnode = left;
  581.     r->rnode = right;
  582.     return(r);
  583. }
  584.  
  585.  
  586. /* This allocates a node with defined subnode and proc */
  587. /* Otherwise like node() */
  588.  
  589. NODE * PASCAL snode(NODE *subn, int op, NODE *(PASCAL *procp)(NODE *))
  590. {
  591.     register NODE     *r;
  592.  
  593.     r           = (NODE *) obstack_alloc(&other_stack, sizeof(NODE));
  594.     r->type    = op;
  595.     r->subnode = subn;
  596.     r->proc    = procp;
  597.     return(r);
  598. }
  599.  
  600.  
  601. /* (jfw) This allocates a Node_line_range node
  602.  * with defined condpair and zeroes the trigger word
  603.  * to avoid the temptation of assuming that calling
  604.  * 'node( foo, Node_line_range, 0)' will properly initialize 'triggered'.
  605.  */
  606. /* Otherwise like node() */
  607.  
  608. NODE * PASCAL mkrangenode(NODE *cpair)
  609. {
  610.     register NODE    *r;
  611.  
  612.     r         = (NODE *) obstack_alloc(&other_stack, sizeof(NODE));
  613.     r->type     = NODE_LINE_RANGE;
  614.     r->condpair  = cpair;
  615.     r->triggered = 0;
  616.     return(r);
  617. }
  618.  
  619.  
  620. /*  count the number of arguments in an expression list         */
  621.  
  622. int PASCAL count_arguments(register NODE *exp_list)
  623. {
  624.     auto     int     cnt = 0;
  625.  
  626.     while (exp_list)
  627.     {
  628.     ++cnt;
  629.     exp_list = exp_list->rnode;
  630.     }
  631.     return(cnt);
  632. }
  633.  
  634.  
  635. /* this allocates a node with defined numbr */
  636. /* This creates global nodes! */
  637.  
  638. NODE * PASCAL make_number(AWKNUM x)
  639. {
  640.     register NODE    *r;
  641.  
  642.     r         = newnode(NODE_NUMBER);
  643.     r->numbr = x;
  644.     return(r);
  645. }
  646.  
  647.  
  648. /* This creates temporary nodes.  They go away quite quickly, so
  649.    don't use them for anything important */
  650.  
  651. NODE * PASCAL tmp_number(AWKNUM x)
  652. {
  653.     auto     NODE      *r;
  654.  
  655.     r         = (NODE *) obstack_alloc(&temp_strings, sizeof(NODE));
  656.     r->type  = NODE_NUMBER;
  657.     r->numbr = x;
  658.     return(r);
  659. }
  660.  
  661.  
  662. /* Make a string node.  If len==0, the string passed in S is supposed to end
  663.    with a double quote, but have had the beginning double quote
  664.    already stripped off by yylex.
  665.    If LEN!=0, we don't care what s ends with.  This creates a global node */
  666.  
  667. NODE * PASCAL make_string(char *s, int len)
  668. {
  669.     register NODE    *r;
  670.     register char    *pf, *pt;
  671.     register int     c;
  672.  
  673.     /* the aborts are impossible because yylex is supposed to have already
  674.      * checked for unterminated strings */
  675.     if (len == -1)
  676.     {                /* Called from yyparse, find our own len */
  677.     for (pf = pt = s; *pf != EOS && *pf != '\"';)
  678.     {
  679.         c = *pf++;
  680.         switch (c)
  681.         {
  682.         case '\\':
  683. #ifndef FAST
  684.             if (*pf == EOS)
  685.             panic("EOS following \\ in make_string()");
  686. #endif
  687.             c = *pf++;
  688.             switch (c)
  689.             {
  690.             case '\\':    /* no massagary needed */
  691.             case '\'':
  692.             case '\"':
  693.                 break;
  694.             case '0':
  695.             case '1':
  696.             case '2':
  697.             case '3':
  698.             case '4':
  699.             case '5':
  700.             case '6':
  701.             case '7':
  702.                 c -= '0';
  703.                 while (*pf && *pf >= '0' && *pf <= '7')
  704.                 {
  705.                 c = c * 8 + *pf++ - '0';
  706.                 }
  707.                 break;
  708.             case 'b':
  709.                 c = '\b';
  710.                 break;
  711.             case 'f':
  712.                 c = '\f';
  713.                 break;
  714.             case 'n':
  715.                 c = '\n';
  716.                 break;
  717.             case 'r':
  718.                 c = '\r';
  719.                 break;
  720.             case 't':
  721.                 c = '\t';
  722.                 break;
  723.             case 'v':
  724.                 c = '\v';
  725.                 break;
  726.             default:
  727.                 *pt++ = '\\';
  728.                 break;
  729.             }
  730.             /* FALL THROUGH */
  731.         default:
  732.             *pt++ = c;
  733.             break;
  734.         }
  735.     }
  736.     len = pt - s;
  737.     }
  738.  
  739.     r = newnode(NODE_STRING);
  740.     r->stptr = (char *) malloc(len + 1);
  741.     if (r->stptr == NULL)
  742.     panic("Out of memory in make_string()");
  743.     r->type = NODE_STRING;
  744.     r->stlen = len;
  745.     r->stref = 1;
  746.     memcpy(r->stptr, s, len);
  747.     r->stptr[len] = EOS;
  748.  
  749.     return(r);
  750. }
  751.  
  752.  
  753. /* This should be a macro for speed, but the C compiler chokes. */
  754. /* Read the warning under tmp_number */
  755.  
  756. NODE * PASCAL tmp_string(char *s, int len)
  757. {
  758.     register NODE     *r;
  759.  
  760.     r         = (NODE *) obstack_alloc(&temp_strings, sizeof(NODE));
  761.     r->stptr = (char *) obstack_alloc(&temp_strings, len + 1);
  762.     r->type  = NODE_TEMP_STRING;
  763.     r->stlen = len;
  764.     r->stref = 1;
  765.     memcpy(r->stptr, s, len);
  766.     r->stptr[len] = EOS;       /* JF a hack */
  767.  
  768.     return(r);
  769. }
  770.  
  771.  
  772. /* Generate compiled regular expressions */
  773.  
  774. REPAT_BUFFER * PASCAL make_regexp(char *s)
  775. {
  776.     auto     REPAT_BUFFER   *rp;
  777.     auto     char        *p, *pout, *err;
  778.     auto     int         c, len = 0;
  779.  
  780.     rp = (REPAT_BUFFER *) obstack_alloc(&other_stack, sizeof(REPAT_BUFFER));
  781.     memset(rp, 0, sizeof(REPAT_BUFFER));
  782.     rp->buffer = (char *) malloc(100);    /* JF I'd obstack allocate it, except
  783.                      * the regex routines try to
  784.                      * realloc() it, which fails. */
  785.     rp->allocated = 100;
  786.     rp->fastmap   = (char *) obstack_alloc(&other_stack, FASTMAP_SIZE);
  787.  
  788.     for (pout = wrk_fastmap, p = s; *p != EOS; p++)
  789.     {
  790.     if (*p == '\\')
  791.     {
  792.         c = *(++p);
  793.         switch (c)
  794.         {
  795.         case 'b':
  796.             c = '\b';
  797.             break;
  798.         case 't':
  799.             c = '\t';
  800.             break;
  801.         case 'f':
  802.             c = '\f';
  803.             break;
  804.         case '0':
  805.         case '1':
  806.         case '2':
  807.         case '3':
  808.         case '4':
  809.         case '5':
  810.         case '6':
  811.         case '7':
  812.             c -= '0';
  813.             while (*p && *p >= '0' && *p <= '7')
  814.             c = c * 8 + *p++ - '0';
  815.             break;
  816.         case 'n':
  817.             c = '\n';
  818.             break;
  819.         case 'r':
  820.             c = '\r';
  821.             break;
  822.         }
  823.         *pout++ = c;
  824.         ++len;
  825.     }
  826.     else
  827.     {
  828.         if (*p == '/')
  829.         break;
  830.         else
  831.         {
  832.         *pout++ = *p;
  833.         ++len;
  834.         }
  835.     }
  836.     }
  837. #ifndef FAST
  838.     if (*p != '/')
  839.     panic("REGEXP doesn't end with / in make_regexp()");
  840. #endif
  841.  
  842.     if ((err = re_compile_pattern(wrk_fastmap, len, rp)) != NULL)
  843.     {
  844.     fprintf(stderr, "illegal regexp: ");
  845.     yyerror(err);        /* fatal */
  846.     }
  847.  
  848.     return(rp);
  849. }
  850.  
  851.  
  852. /* Build a for loop */
  853.  
  854. FOR_LOOP_HEADER * PASCAL make_for_loop(NODE *init, NODE *cond, NODE *incr)
  855. {
  856.     register FOR_LOOP_HEADER       *r;
  857.  
  858.     r = (FOR_LOOP_HEADER *) obstack_alloc(&other_stack,
  859.                       sizeof(FOR_LOOP_HEADER));
  860.     r->init = init;
  861.     r->cond = cond;
  862.     r->incr = incr;
  863.     return(r);
  864. }
  865.  
  866.  
  867. /* Name points to a variable name.  Make sure its in the symbol table */
  868.  
  869. NODE * PASCAL variable(char *name)
  870. {
  871.     register NODE      *r;
  872.  
  873.     if ((r = lookup(variables, name)) == NULL)
  874.     {
  875.     r = install(variables, name,
  876.             node(Nnull_string, NODE_VAR, (NODE *) NULL));
  877.     }
  878.     return(r);
  879. }
  880.  
  881.  
  882. /* Create a special variable */
  883.  
  884. NODE * PASCAL spc_var(char *name, NODE *value)
  885. {
  886.     register NODE    *r;
  887.  
  888.     if ((r = lookup(variables, name)) == NULL)
  889.     r = install(variables, name, node(value, NODE_VAR, (NODE *) NULL));
  890.     return(r);
  891. }
  892.  
  893.  
  894. /*
  895.  * Install a name in the hash table specified, even if it is already there.
  896.  * Name stops with first non alphanumeric.
  897.  * Caller must check against redefinition if that is desired.
  898.  */
  899.  
  900. NODE * PASCAL install(HASHNODE **table, char *name, NODE *value)
  901. {
  902.     register HASHNODE       *hp;
  903.     register int        i, len, bucket;
  904.     register char       *p;
  905.  
  906.     len = 0;
  907.     p    = name;
  908.     while (is_identchar(*p))
  909.     p++;
  910.     len = p - name;
  911.  
  912.     i          = sizeof(HASHNODE) + len + 1;
  913.     hp          = (HASHNODE *) obstack_alloc(&other_stack, i);
  914.     bucket      = hashf(name, len, HASHSIZE);
  915.     hp->next      = table[bucket];
  916.     table[bucket] = hp;
  917.     hp->length      = len;
  918.     hp->value      = value;
  919.     hp->name      = ((char *) hp) + sizeof(HASHNODE);
  920.     hp->length      = len;
  921.     memcpy(hp->name, name, len);
  922.     return(hp->value);
  923. }
  924.  
  925.  
  926. /*
  927.  * find the most recent hash node for name name (ending with first
  928.  * non-identifier char) installed by install
  929.  */
  930.  
  931. NODE * PASCAL lookup(HASHNODE **table, char *name)
  932. {
  933.     register char     *bp;
  934.     register HASHNODE     *bucket;
  935.     register int      len;
  936.  
  937.     for (bp = name; is_identchar(*bp); bp++)
  938.     ;
  939.     len    = bp - name;
  940.     bucket = table[hashf(name, len, HASHSIZE)];
  941.     while (bucket)
  942.     {
  943.     if (bucket->length == len && strncmp(bucket->name, name, len) == 0)
  944.         return(bucket->value);
  945.     bucket = bucket->next;
  946.     }
  947.     return(NULL);
  948. }
  949.  
  950.  
  951. /*
  952.  * return hash function on name.  must be compatible with the one
  953.  * computed a step at a time, elsewhere  (JF: Where?  I can't find it!)
  954.  *                     (BW: Neither can I!)
  955.  */
  956.  
  957. int PASCAL hashf(register char *name, register int len, int hashsize)
  958. {
  959.     register int    r = 0;
  960.  
  961.     while (len--)
  962.     r = HASHSTEP(r, *name++);
  963.  
  964.     return(MAKE_POS(r) % hashsize);
  965. }
  966.  
  967.  
  968. /* Add new to the rightmost branch of LIST.  This uses n^2 time, but
  969.    doesn't get used enough to make optimizing worth it. . . */
  970. /* You don't believe me?  Profile it yourself! */
  971.  
  972. NODE * PASCAL append_right(NODE *list, NODE *new)
  973. {
  974.     register NODE     *oldlist;
  975.  
  976.     oldlist = list;
  977.     while (list->rnode != NULL)
  978.     list = list->rnode;
  979.     list->rnode = new;
  980.     return(oldlist);
  981. }
  982.