home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3352 < prev    next >
Encoding:
Internet Message Format  |  1991-05-17  |  60.7 KB
  1. From: brennan@ssc-vax.UUCP (Mike Brennan)
  2. Newsgroups: alt.sources
  3. Subject: mawk0.97.shar 4 of 6
  4. Message-ID: <3966@ssc-bee.ssc-vax.UUCP>
  5. Date: 11 May 91 14:56:27 GMT
  6.  
  7.  
  8. ------------------cut here----------------
  9.   scan_code['&'] = SC_AND ;
  10.   scan_code['?'] = SC_QMARK ;
  11.   scan_code[':'] = SC_COLON ;
  12.   scan_code['['] = SC_LBOX ;
  13.   scan_code[']'] = SC_RBOX ;
  14.   scan_code['\\'] = SC_ESCAPE ;
  15.   scan_code['.'] = SC_DOT ;
  16.   scan_code['~'] = SC_MATCH ;
  17.   scan_code['$'] = SC_DOLLAR ;
  18.  
  19.   for( p = scan_code + 'A' ; p <= scan_code + 'Z' ; p++ )
  20.        *p = *(p + 'a' - 'A') = SC_IDCHAR ;
  21.  
  22. }
  23.  
  24. void scan_print()
  25. { register char *p = scan_code ;
  26.   register int c ; /* column */
  27.   register int r ; /* row */
  28.  
  29.   printf("\n\n/* scancode.c */\n\n\n") ;
  30.   printf( "char scan_code[256] = {\n" ) ;
  31.  
  32.   for( r = 1 ; r <= 16 ; r++)
  33.   {
  34.     for( c = 1 ; c <= 16 ; c++)
  35.     {
  36.       printf("%2d" , *p++) ;
  37.       if ( r != 16 || c != 16 )  putchar(',') ;
  38.     }
  39.     putchar('\n') ;
  40.   }
  41.  
  42.   printf("} ;\n") ;
  43. }
  44.  
  45.  
  46. main()
  47. {
  48.   scan_init() ; scan_print() ;
  49.   return 0 ;
  50. }
  51. @//E*O*F mawk0.97/makescan.c//
  52. chmod u=rw,g=r,o=r mawk0.97/makescan.c
  53.  
  54. echo x - mawk0.97/matherr.c
  55. sed 's/^@//' > "mawk0.97/matherr.c" <<'@//E*O*F mawk0.97/matherr.c//'
  56.  
  57. /********************************************
  58. matherr.c
  59. copyright 1991, Michael D. Brennan
  60.  
  61. This is a source file for mawk, an implementation of
  62. the Awk programming language as defined in
  63. Aho, Kernighan and Weinberger, The AWK Programming Language,
  64. Addison-Wesley, 1988.
  65.  
  66. See the accompaning file, LIMITATIONS, for restrictions
  67. regarding modification and redistribution of this
  68. program in source or binary form.
  69. ********************************************/
  70.  
  71. /*$Log:    matherr.c,v $
  72.  * Revision 2.1  91/04/08  08:23:31  brennan
  73.  * VERSION 0.97
  74.  * 
  75. */
  76.  
  77. #include  "mawk.h"
  78. #include  <math.h>
  79.  
  80. #if   FPE_TRAPS
  81. #include <signal.h>
  82.  
  83. /* machine dependent changes might be needed here */
  84.  
  85. static void  fpe_catch( signal, why)
  86.   int signal, why ;
  87. {
  88.   switch(why)
  89.   {
  90.     case FPE_ZERODIVIDE :
  91.        rt_error("division by zero") ;
  92.  
  93.     case FPE_OVERFLOW  :
  94.        rt_error("floating point overflow") ;
  95.  
  96.     default :
  97.       rt_error("floating point exception") ;
  98.   }
  99. }
  100.  
  101. void   fpe_init()
  102. { (void) signal(SIGFPE, fpe_catch) ; }
  103.  
  104. #else
  105.  
  106. void  fpe_init()
  107. {
  108.   TURNOFF_FPE_TRAPS() ;
  109. }
  110. #endif
  111.  
  112. #if  HAVE_MATHERR
  113.  
  114. #if  ! FPE_TRAPS 
  115.  
  116. /* If we are not trapping math errors, we will shutup the library calls
  117. */
  118.  
  119. int  matherr( e )
  120.   struct exception *e ;
  121. { return 1 ; } 
  122.  
  123. #else   /* print error message and exit */
  124.  
  125. int matherr( e )
  126.   struct exception  *e ;
  127. { char *error ;
  128.  
  129.   switch( e->type )
  130.   {
  131.     case  DOMAIN :
  132.     case  SING :
  133.             error = "domain error" ;
  134.             break ;
  135.  
  136.     case  OVERFLOW :
  137.             error = "overflow" ;
  138.             break ;
  139.  
  140.     case  TLOSS :
  141.     case  PLOSS :
  142.             error = "loss of significance" ;
  143.             break ;
  144.  
  145.     case  UNDERFLOW :
  146.             e->retval = 0.0 ;
  147.             return  1 ;  /* ignore it */
  148.   }
  149.  
  150.   if ( strcmp(e->name, "atan2") == 0 )
  151.       rt_error("atan2(%g,%g) : %s" ,
  152.          e->arg1, e->arg2, error ) ;
  153.   else
  154.       rt_error("%s(%g) : %s" , e->name, e->arg1, error) ;
  155.  
  156.   /* won't get here */
  157.   return 0 ;
  158. }
  159. #endif   /* FPE_TRAPS */
  160.  
  161. #endif   /*  HAVE_MATHERR */
  162. @//E*O*F mawk0.97/matherr.c//
  163. chmod u=rw,g=r,o=r mawk0.97/matherr.c
  164.  
  165. echo x - mawk0.97/mawk.h
  166. sed 's/^@//' > "mawk0.97/mawk.h" <<'@//E*O*F mawk0.97/mawk.h//'
  167.  
  168. /********************************************
  169. mawk.h
  170. copyright 1991, Michael D. Brennan
  171.  
  172. This is a source file for mawk, an implementation of
  173. the Awk programming language as defined in
  174. Aho, Kernighan and Weinberger, The AWK Programming Language,
  175. Addison-Wesley, 1988.
  176.  
  177. See the accompaning file, LIMITATIONS, for restrictions
  178. regarding modification and redistribution of this
  179. program in source or binary form.
  180. ********************************************/
  181.  
  182.  
  183. /*   $Log:    mawk.h,v $
  184.  * Revision 2.1  91/04/08  08:23:33  brennan
  185.  * VERSION 0.97
  186.  * 
  187. */
  188.  
  189.  
  190. /*  mawk.h  */
  191.  
  192. #ifndef  MAWK_H
  193. #define  MAWK_H   
  194.  
  195. #include  "machine.h"
  196.  
  197. #ifdef   DEBUG
  198. #define  YYDEBUG  1
  199. extern  int   yydebug ;  /* print parse if on */
  200. extern  int   dump_RE ;
  201. #endif
  202. extern  int   dump_code ;
  203.  
  204. #ifdef  __STDC__
  205. #define  PROTO(name, args)   name  args
  206. #undef   HAVE_VOID_PTR
  207. #define  HAVE_VOID_PTR          1
  208. #else
  209. #define  PROTO(name, args)   name()
  210. #endif 
  211.  
  212.  
  213. #include <stdio.h>
  214. #include <string.h>
  215. #include "types.h"
  216.  
  217.  
  218. /*----------------
  219.  *  GLOBAL VARIABLES
  220.  *----------------*/
  221.  
  222. /* some well known cells */
  223. extern CELL cell_zero, cell_one ;
  224. extern STRING  null_str ;
  225. /* a useful scratch area */
  226. extern union tbuff temp_buff ;
  227. extern char *main_buff ; /* main file input buffer */
  228.  
  229. /* help with casts */
  230. extern int pow2[] ;
  231.  
  232.  
  233.  /* these are used by the parser, scanner and error messages
  234.     from the compile  */
  235.  
  236. extern  int current_token ;
  237. extern  unsigned  token_lineno ; /* lineno of current token */
  238. extern  unsigned  compile_error_count ;
  239. extern  int  paren_cnt, brace_cnt ;
  240. extern  int  print_flag, getline_flag ;
  241.  
  242.  
  243. /*---------*/
  244.  
  245. extern  int  errno ;     
  246. extern  char *progname ; /* for error messages */
  247.  
  248. /* macro to test the type of two adjacent cells */
  249. #define TEST2(cp)  (pow2[(cp)->type]+pow2[((cp)+1)->type])
  250.  
  251. /* macro to get at the string part of a CELL */
  252. #define string(cp) ((STRING *)(cp)->ptr)
  253.  
  254. #ifdef   DEBUG
  255. #define cell_destroy(cp)  DB_cell_destroy(cp)
  256. #else
  257.  
  258. #define cell_destroy(cp)   if ( (cp)->type >= C_STRING &&\
  259.                                 -- string(cp)->ref_cnt == 0 )\
  260.                                 zfree(string(cp),string(cp)->len+5);else
  261. #endif
  262.  
  263. /*  prototypes  */
  264.  
  265. void  PROTO( cast1_to_s, (CELL *) ) ;
  266. void  PROTO( cast1_to_d, (CELL *) ) ;
  267. void  PROTO( cast2_to_s, (CELL *) ) ;
  268. void  PROTO( cast2_to_d, (CELL *) ) ;
  269. void  PROTO( cast_to_RE, (CELL *) ) ;
  270. void  PROTO( cast_for_split, (CELL *) ) ;
  271. void  PROTO( check_strnum, (CELL *) ) ;
  272. void  PROTO( cast_to_REPL, (CELL *) ) ;
  273.  
  274. int   PROTO( test, (CELL *) ) ; /* test for null non-null */
  275. CELL *PROTO( cellcpy, (CELL *, CELL *) ) ;
  276. CELL *PROTO( repl_cpy, (CELL *, CELL *) ) ;
  277. void  PROTO( DB_cell_destroy, (CELL *) ) ;
  278. void  PROTO( overflow, (char *, unsigned) ) ;
  279. void  PROTO( rt_overflow, (char *, unsigned) ) ;
  280. void  PROTO( rt_error, ( char *, ...) ) ;
  281. void  PROTO( mawk_exit, (int) ) ;
  282. void PROTO( da, (INST *, FILE *)) ;
  283. int  PROTO( space_split, (char *) ) ;
  284. char *PROTO( str_str, (char*, char*, unsigned) ) ;
  285. int   PROTO( re_split, (char *, PTR) ) ;
  286. char *PROTO( re_pos_match, (char *, PTR, unsigned *) ) ;
  287.  
  288. void  PROTO( exit, (int) ) ;
  289. int   PROTO( close, (int) ) ;
  290. int   PROTO( open, (char *,int, int) ) ;
  291. int   PROTO( read, (int , PTR, unsigned) ) ;
  292. char *PROTO( getenv, (const char *) ) ;
  293.  
  294. int  PROTO ( parse, (void) ) ;
  295. int  PROTO ( yylex, (void) ) ;
  296. int  PROTO( yyparse, (void) ) ;
  297. void PROTO( yyerror, (char *) ) ;
  298.  
  299. void PROTO( bozo, (char *) ) ;
  300. void PROTO( errmsg , (int, char*, ...) ) ;
  301. void PROTO( compile_error, ( char *, ...) ) ;
  302.  
  303. INST *PROTO( execute, (INST *, CELL *, CELL *) ) ;
  304. char *PROTO( find_kw_str, (int) ) ;
  305.  
  306. double strtod(), fmod() ;
  307.  
  308. #endif  /* MAWK_H */
  309. @//E*O*F mawk0.97/mawk.h//
  310. chmod u=rw,g=r,o=r mawk0.97/mawk.h
  311.  
  312. echo x - mawk0.97/memory.c
  313. sed 's/^@//' > "mawk0.97/memory.c" <<'@//E*O*F mawk0.97/memory.c//'
  314.  
  315. /********************************************
  316. memory.c
  317. copyright 1991, Michael D. Brennan
  318.  
  319. This is a source file for mawk, an implementation of
  320. the Awk programming language as defined in
  321. Aho, Kernighan and Weinberger, The AWK Programming Language,
  322. Addison-Wesley, 1988.
  323.  
  324. See the accompaning file, LIMITATIONS, for restrictions
  325. regarding modification and redistribution of this
  326. program in source or binary form.
  327. ********************************************/
  328.  
  329.  
  330. /* $Log:    memory.c,v $
  331.  * Revision 2.1  91/04/08  08:23:35  brennan
  332.  * VERSION 0.97
  333.  * 
  334. */
  335.  
  336.  
  337. /* memory.c */
  338.  
  339. #include "mawk.h"
  340.  
  341. #ifdef  __TURBOC__
  342. #define SUPPRESS_NEW_STRING_PROTO  /* get compiler off our back on
  343.          the definition of new_STRING() */
  344. #pragma  warn -pro
  345. #endif
  346.  
  347. #include "memory.h"
  348.  
  349. STRING null_str = {1, 0, "" } ;
  350.  
  351. static STRING *char_string[127] ;
  352. /* slots for strings of one character
  353.    "\01" thru "\177"    */
  354.   
  355. STRING *new_STRING(s, xlen)   
  356.   char *s ;  unsigned xlen ;
  357.   /* WARNING: if s != NULL, don't access xlen
  358.      because it won't be there   */
  359. { register STRING *p ;
  360.   unsigned len ;
  361.  
  362.   if ( s )
  363.         switch( len = strlen(s) )
  364.         {
  365.             case 0 : 
  366.                 p = &null_str  ; p->ref_cnt++ ;
  367.                 break ;
  368.  
  369.             case 1 :
  370.                 if ( *(unsigned char *)s < 128 )
  371.                 {   if ( p = char_string[*s-1] )
  372.                         p->ref_cnt++ ;
  373.                     else
  374.                     { p = (STRING *) zmalloc(6) ;
  375.                       p->ref_cnt = 2 ;  p->len = 1 ; 
  376.                       p->str[0] = s[0] ;
  377.                       p->str[1] = 0 ;
  378.                       char_string[*s-1] = p ;
  379.                     }
  380.  
  381.                     break ; /*case */
  382.                 }
  383.                 /* else FALL THRU */
  384.  
  385.             default :
  386.                 p = (STRING *) zmalloc(len+5) ;
  387.                 p->ref_cnt = 1 ; p->len = len ;
  388.                 (void) memcpy( p->str , s, len+1) ;
  389.                 break ;
  390.         }
  391.   else  
  392.   { p = (STRING *) zmalloc( xlen+5 ) ;
  393.     p->ref_cnt = 1 ; p->len = xlen ;
  394.     /* zero out the end marker */
  395.     p->str[xlen] = 0 ; 
  396.   }
  397.  
  398.   return p ;
  399. }
  400.  
  401.  
  402. #ifdef   DEBUG
  403.  
  404. void  DB_free_STRING(sval)
  405.   register STRING *sval ;
  406. { if ( -- sval->ref_cnt == 0 )  zfree(sval, sval->len+5) ; }
  407.  
  408. #endif
  409. @//E*O*F mawk0.97/memory.c//
  410. chmod u=rw,g=r,o=r mawk0.97/memory.c
  411.  
  412. echo x - mawk0.97/memory.h
  413. sed 's/^@//' > "mawk0.97/memory.h" <<'@//E*O*F mawk0.97/memory.h//'
  414.  
  415. /********************************************
  416. memory.h
  417. copyright 1991, Michael D. Brennan
  418.  
  419. This is a source file for mawk, an implementation of
  420. the Awk programming language as defined in
  421. Aho, Kernighan and Weinberger, The AWK Programming Language,
  422. Addison-Wesley, 1988.
  423.  
  424. See the accompaning file, LIMITATIONS, for restrictions
  425. regarding modification and redistribution of this
  426. program in source or binary form.
  427. ********************************************/
  428.  
  429.  
  430. /* $Log:    memory.h,v $
  431.  * Revision 2.1  91/04/08  08:23:37  brennan
  432.  * VERSION 0.97
  433.  * 
  434. */
  435.  
  436.  
  437. /*  memory.h  */
  438.  
  439. #ifndef  MEMORY_H
  440. #define  MEMORY_H
  441.  
  442. #include "zmalloc.h"
  443.  
  444. #define  new_CELL()  (CELL *) zmalloc(sizeof(CELL))
  445. #define  free_CELL(p)  zfree(p,sizeof(CELL))
  446.  
  447. #ifndef  SUPPRESS_NEW_STRING_PROTO
  448. STRING  *PROTO( new_STRING, (char *, ...) ) ;
  449. #endif
  450.  
  451. #ifdef   DEBUG
  452. void  PROTO( DB_free_STRING , (STRING *) ) ;
  453.  
  454. #define  free_STRING(s)  DB_free_STRING(s)
  455.  
  456. #else
  457.  
  458. #define  free_STRING(sval)   if ( -- (sval)->ref_cnt == 0 )\
  459.                                 zfree(sval, (sval)->len+5) ; else
  460. #endif
  461.  
  462.  
  463. #endif   /* MEMORY_H */
  464. @//E*O*F mawk0.97/memory.h//
  465. chmod u=rw,g=r,o=r mawk0.97/memory.h
  466.  
  467. echo x - mawk0.97/parse.y
  468. sed 's/^@//' > "mawk0.97/parse.y" <<'@//E*O*F mawk0.97/parse.y//'
  469.  
  470. /********************************************
  471. parse.y
  472. copyright 1991, Michael D. Brennan
  473.  
  474. This is a source file for mawk, an implementation of
  475. the Awk programming language as defined in
  476. Aho, Kernighan and Weinberger, The AWK Programming Language,
  477. Addison-Wesley, 1988.
  478.  
  479. See the accompaning file, LIMITATIONS, for restrictions
  480. regarding modification and redistribution of this
  481. program in source or binary form.
  482. ********************************************/
  483.  
  484. /* $Log:    parse.y,v $
  485.  * Revision 2.1  91/04/08  08:23:39  brennan
  486.  * VERSION 0.97
  487.  * 
  488. */
  489.  
  490.  
  491. %{
  492. #include <stdio.h>
  493. #include "mawk.h"
  494. #include "code.h"
  495. #include "symtype.h"
  496. #include "memory.h"
  497. #include "bi_funct.h"
  498. #include "bi_vars.h"
  499. #include "jmp.h"
  500. #include "field.h"
  501. #include "files.h"
  502.  
  503. extern void  PROTO( eat_nl, (void) ) ;
  504. static void  PROTO( resize_fblock, (FBLOCK *, INST *) ) ;
  505. static void  PROTO( code_array, (SYMTAB *) ) ;
  506. static void  PROTO( code_call_id, (CA_REC *, SYMTAB *) ) ;
  507. static int   PROTO( current_offset, (void) ) ;
  508.  
  509. static int scope ;
  510. static FBLOCK *active_funct ;
  511.       /* when scope is SCOPE_FUNCT  */
  512.  
  513. #define  code_address(x)  if( is_local(x) )\
  514.                           { code1(L_PUSHA) ; code1((x)->offset) ; }\
  515.                           else  code2(_PUSHA, (x)->stval.cp) 
  516.  
  517. %}
  518.  
  519. %union{
  520. CELL *cp ;
  521. SYMTAB *stp ;
  522. INST  *start ; /* code starting address */
  523. PF_CP  fp ;  /* ptr to a (print/printf) or (sub/gsub) function */
  524. BI_REC *bip ; /* ptr to info about a builtin */
  525. FBLOCK  *fbp  ; /* ptr to a function block */
  526. ARG2_REC *arg2p ;
  527. CA_REC   *ca_p  ;
  528. int   ival ;
  529. }
  530.  
  531. /*  two tokens to help with errors */
  532. %token   UNEXPECTED   /* unexpected character */
  533. %token   BAD_DECIMAL
  534.  
  535. %token   NL
  536. %token   SEMI_COLON
  537. %token   LBRACE  RBRACE
  538. %token   LBOX     RBOX
  539. %token   COMMA
  540. %token   <ival> IO_OUT    /* > or output pipe */
  541.  
  542. %left   P_OR
  543. %left   P_AND
  544. %right  ASSIGN  ADD_ASG SUB_ASG MUL_ASG DIV_ASG MOD_ASG POW_ASG
  545. %right  QMARK COLON
  546. %left   OR
  547. %left   AND
  548. %left   IN
  549. %left   MATCH  NOT_MATCH
  550. %left   EQ  NEQ  LT LTE  GT  GTE
  551. %left   CAT
  552. %left   GETLINE
  553. %left   PLUS      MINUS  
  554. %left   MUL      DIV    MOD
  555. %left   NOT   UMINUS
  556. %nonassoc   IO_IN PIPE
  557. %right  POW
  558. %left   INC  DEC   /* ++ -- */
  559. %left   DOLLAR    ID  FIELD  /* last two to remove a SR conflict
  560.                                 with getline */
  561. %right  LPAREN   RPAREN     /* removes some SR conflicts */
  562. %token  <cp>  CONSTANT  RE
  563. %token  <stp> ID   
  564. %token  <fbp> FUNCT_ID
  565. %token  <bip> BUILTIN 
  566. %token   <cp>  FIELD 
  567.  
  568. %token  PRINT PRINTF SPLIT MATCH_FUNC SUB GSUB LENGTH
  569. /* keywords */
  570. %token  DO WHILE FOR BREAK CONTINUE IF ELSE  IN
  571. %token  DELETE  BEGIN  END  EXIT NEXT RETURN  FUNCTION
  572.  
  573. %type <start>  block  block_or_newline
  574. %type <start>  statement_list statement mark
  575. %type <start>  pattern  p_pattern
  576. %type <start>  print_statement
  577. %type <ival>   pr_args
  578. %type <arg2p>  arg2  
  579. %type <start>  builtin  
  580. %type <start>  getline_file
  581. %type <start>  lvalue field  fvalue
  582. %type <start>  expr cat_expr p_expr  re_or_expr  sub_back
  583. %type <start>  do_statement  while_statement  for_statement
  584. %type <start>  if_statement if_else_statement
  585. %type <start>  while_front  if_front  for_front
  586. %type <start>  fexpr0 fexpr1
  587. %type <start>  array_loop  array_loop_front
  588. %type <start>  exit_statement  return_statement
  589. %type <ival>   arglist args 
  590. %type <stp>     id  array
  591. %type <fp>     print   sub_or_gsub
  592. %type <fbp>    funct_start funct_head
  593. %type <ca_p>   call_args ca_front ca_back
  594. %type <ival>   f_arglist f_args
  595.  
  596. %%
  597. /*  productions  */
  598.  
  599. program :       program_block
  600.         |       program  program_block 
  601.         ;
  602.  
  603. program_block :  PA_block
  604.               |  function_def
  605.               |  error block
  606.                  { if (scope == SCOPE_FUNCT)
  607.                    { restore_ids() ; scope = SCOPE_MAIN ; }
  608.                    code_ptr = main_code_ptr ;
  609.                  }
  610.               ;
  611.  
  612. PA_block  :  block
  613.  
  614.           |  BEGIN  
  615.                 { main_code_ptr = code_ptr ;
  616.                   code_ptr = begin_code_ptr ; 
  617.                   scope = SCOPE_BEGIN ;
  618.                 }
  619.  
  620.              block
  621.                 { begin_code_ptr = code_ptr ;
  622.                   code_ptr = main_code_ptr ; 
  623.                   scope = SCOPE_MAIN ;
  624.                 }
  625.  
  626.           |  END    
  627.                 { main_code_ptr = code_ptr ;
  628.                   code_ptr = end_code_ptr ; 
  629.                   scope = SCOPE_END ;
  630.                 }
  631.  
  632.              block
  633.                 { end_code_ptr = code_ptr ;
  634.                   code_ptr = main_code_ptr ; 
  635.                   scope = SCOPE_MAIN ;
  636.                 }
  637.  
  638.           |  pattern  /* this works just like an if statement */
  639.              { code_jmp(_JZ, 0) ; }
  640.  
  641.              block_or_newline
  642.              { patch_jmp( code_ptr ) ; }
  643.  
  644.     /* range pattern, see comment in execute.c near _RANGE */
  645.           |  pattern COMMA 
  646.              { code_push($1, code_ptr - $1) ;
  647.                code_ptr = $1 ;
  648.                code1(_RANGE) ; code1(1) ;
  649.                code_ptr += 3 ;
  650.                code_ptr += code_pop(code_ptr) ;
  651.                code1(_STOP0) ;
  652.                $1[2].op = code_ptr - ($1+1) ;
  653.              }
  654.              pattern
  655.              { code1(_STOP0) ; }
  656.  
  657.              block_or_newline
  658.              { $1[3].op = $6 - ($1+1) ;
  659.                $1[4].op = code_ptr - ($1+1) ;
  660.              }
  661.           ;
  662.  
  663. pattern :  expr       %prec  LPAREN
  664.         |  p_pattern
  665.  
  666. /*  these work just like short circuit booleans */
  667.         |  pattern P_OR  
  668.                 { code1(_DUP) ;
  669.                   code_jmp(_JNZ, 0) ;
  670.                   code1(_POP) ;
  671.                 }
  672.                 pattern
  673.                 { patch_jmp(code_ptr) ; }
  674.  
  675.         |  pattern P_AND
  676.                 { code1(_DUP) ;
  677.                   code_jmp(_JZ, 0) ;
  678.                   code1(_POP) ;
  679.                 }
  680.                 pattern
  681.                 { patch_jmp(code_ptr) ; }
  682.         ;
  683.  
  684. /* we want the not (!) operator to apply to expr if possible
  685.    and then to a pattern.  Two types of pattern do it */
  686.  
  687. p_pattern  :  RE
  688.               { $$ = code_ptr ;
  689.                 code2(_PUSHI, &field[0]) ;
  690.                 code2(_PUSHC, $1) ;
  691.                 code1(_MATCH) ;
  692.               }
  693.  
  694.            |  LPAREN  pattern RPAREN
  695.               { $$ = $2 ; }
  696.            |  NOT  p_pattern
  697.               { code1(_NOT) ; $$ = $2 ; }
  698.            ;
  699.  
  700.  
  701. block   :  LBRACE   statement_list  RBRACE
  702.             { $$ = $2 ; }
  703.         |  LBRACE   error  RBRACE 
  704.             { $$ = code_ptr ; /* does nothing won't be executed */
  705.               print_flag = getline_flag = paren_cnt = 0 ;
  706.               yyerrok ; }
  707.         ;
  708.  
  709. block_or_newline  :  block
  710.                   |  NL     /* default print action */
  711.                      { $$ = code_ptr ;
  712.                        code1(_PUSHINT) ; code1(0) ;
  713.                        code2(_PRINT, bi_print) ;
  714.                      }
  715.  
  716. statement_list :  statement
  717.         |  statement_list   statement
  718.         ;
  719.  
  720.  
  721. statement :  block
  722.           |  expr   separator
  723.              { code1(_POP) ; }
  724.           |  /* empty */  separator
  725.              { $$ = code_ptr ; }
  726.           |  error  separator
  727.               { $$ = code_ptr ;
  728.                 print_flag = getline_flag = 0 ;
  729.                 paren_cnt = 0 ;
  730.                 yyerrok ;
  731.               }
  732.           |  print_statement
  733.           |  if_statement
  734.           |  if_else_statement
  735.           |  do_statement
  736.           |  while_statement
  737.           |  for_statement
  738.           |  array_loop
  739.           |  BREAK  separator
  740.              { $$ = code_ptr ; BC_insert('B', code_ptr) ;
  741.                code2(_JMP, 0) /* don't use code_jmp ! */ ; }
  742.           |  CONTINUE  separator
  743.              { $$ = code_ptr ; BC_insert('C', code_ptr) ;
  744.                code2(_JMP, 0) ; }
  745.           |  exit_statement
  746.           |  return_statement
  747.              { if ( scope != SCOPE_FUNCT )
  748.                      compile_error("return outside function body") ;
  749.              }
  750.           |  NEXT  separator
  751.               { if ( scope != SCOPE_MAIN )
  752.                    compile_error( "improper use of next" ) ;
  753.                 $$ = code_ptr ; code1(_NEXT) ;
  754.               }
  755.           ;
  756.  
  757. separator  :  NL | SEMI_COLON
  758.            ;
  759.  
  760. expr  :   cat_expr
  761.       |   lvalue   ASSIGN   expr { code1(_ASSIGN) ; }
  762.       |   lvalue   ADD_ASG  expr { code1(_ADD_ASG) ; }
  763.       |   lvalue   SUB_ASG  expr { code1(_SUB_ASG) ; }
  764.       |   lvalue   MUL_ASG  expr { code1(_MUL_ASG) ; }
  765.       |   lvalue   DIV_ASG  expr { code1(_DIV_ASG) ; }
  766.       |   lvalue   MOD_ASG  expr { code1(_MOD_ASG) ; }
  767.       |   lvalue   POW_ASG  expr { code1(_POW_ASG) ; }
  768.       |   expr EQ expr  { code1(_EQ) ; }
  769.       |   expr NEQ expr { code1(_NEQ) ; }
  770.       |   expr LT expr { code1(_LT) ; }
  771.       |   expr LTE expr { code1(_LTE) ; }
  772.       |   expr GT expr { code1(_GT) ; }
  773.       |   expr GTE expr { code1(_GTE) ; }
  774.       |   expr MATCH re_or_expr
  775.           { code1(_MATCH) ; }
  776.       |   expr NOT_MATCH  re_or_expr
  777.           { code1(_MATCH) ; code1(_NOT) ; }
  778.  
  779. /* short circuit boolean evaluation */
  780.       |   expr  OR
  781.               { code1(_DUP) ;
  782.                 code_jmp(_JNZ, 0) ;
  783.                 code1(_POP) ;
  784.               }
  785.           expr
  786.           { patch_jmp(code_ptr) ; code1(_TEST) ; }
  787.  
  788.       |   expr AND
  789.               { code1(_DUP) ; code_jmp(_JZ, 0) ;
  790.                 code1(_POP) ; }
  791.           expr
  792.               { patch_jmp(code_ptr) ; code1(_TEST) ; }
  793.  
  794.       |  expr QMARK  { code_jmp(_JZ, 0) ; }
  795.          expr COLON  { code_jmp(_JMP, 0) ; }
  796.          expr
  797.          { patch_jmp(code_ptr) ; patch_jmp($7) ; }
  798.       ;
  799.  
  800. cat_expr :  p_expr             %prec CAT
  801.          |  cat_expr  p_expr   %prec CAT 
  802.             { code1(_CAT) ; }
  803.          ;
  804.  
  805. p_expr  :   CONSTANT
  806.           {  $$ = code_ptr ; code2(_PUSHC, $1) ; }
  807.       |   lvalue  %prec CAT /* removes lvalue (++|--) sr conflict */
  808.             { switch( code_ptr[-2].op )
  809.               { case _PUSHA :
  810.                       code_ptr[-2].op = _PUSHI ;
  811.                       break ;
  812.                 case AE_PUSHA :
  813.                       code_ptr[-2].op = AE_PUSHI ;
  814.                       break ;
  815.                 case L_PUSHA :
  816.                       code_ptr[-2].op = L_PUSHI ;
  817.                       break ;
  818.                 case LAE_PUSHA :
  819.                       code_ptr[-2].op = LAE_PUSHI ;
  820.                       break ;
  821. #ifdef  DEBUG
  822.                 default : bozo("p_expr->lvalue") ;
  823. #endif
  824.               }
  825.             }
  826.       |   LPAREN   expr  RPAREN
  827.           { $$ = $2 ; }
  828.       ;
  829. p_expr  :   p_expr  PLUS   p_expr { code1(_ADD) ; } 
  830.       |   p_expr MINUS  p_expr { code1(_SUB) ; }
  831.       |   p_expr  MUL   p_expr { code1(_MUL) ; }
  832.       |   p_expr  DIV  p_expr { code1(_DIV) ; }
  833.       |   p_expr  MOD  p_expr { code1(_MOD) ; }
  834.       |   p_expr  POW  p_expr { code1(_POW) ; }
  835.       |   NOT  p_expr  
  836.                 { $$ = $2 ; code1(_NOT) ; }
  837.       |   PLUS p_expr  %prec  UMINUS
  838.                 { $$ = $2 ; code1(_UPLUS) ; }
  839.       |   MINUS p_expr %prec  UMINUS
  840.                 { $$ = $2 ; code1(_UMINUS) ; }
  841.       |   builtin
  842.       ;
  843.  
  844. p_expr  :  lvalue  INC   
  845.         { code1(_POST_INC ) ; }
  846.         |  lvalue  DEC  
  847.         { code1(_POST_DEC) ; }
  848.         |  INC  lvalue
  849.         { $$ = $2 ; code1(_PRE_INC) ; }
  850.         |  DEC  lvalue
  851.         { $$ = $2 ; code1(_PRE_DEC) ; }
  852.         ;
  853.  
  854. p_expr  :  field  INC   
  855.         { code1(F_POST_INC ) ; }
  856.         |  field  DEC  
  857.         { code1(F_POST_DEC) ; }
  858.         |  INC  field
  859.         { $$ = $2 ; code1(F_PRE_INC) ; }
  860.         |  DEC  field
  861.         { $$ = $2 ; code1(F_PRE_DEC) ; }
  862.         ;
  863.  
  864. lvalue :  id     
  865.         { $$ = code_ptr ; code_address($1) ; }
  866.        |  LPAREN  lvalue RPAREN
  867.           { $$ = $2 ; }
  868.        ;
  869.  
  870. id      :   ID  
  871.             {
  872.               switch($1->type)
  873.               {
  874.                 case ST_NONE : /* new id */
  875.                     $1->type = ST_VAR ;
  876.                     $1->stval.cp = new_CELL() ;
  877.                     $1->stval.cp->type = C_NOINIT ;
  878.                     break ;
  879.  
  880.                 case ST_LOCAL_NONE :
  881.                     $1->type = ST_LOCAL_VAR ;
  882.                     active_funct->typev[$1->offset] = ST_LOCAL_VAR ;
  883.                     break ;
  884.  
  885.                 case ST_VAR :
  886.                 case ST_LOCAL_VAR :  break ;
  887.  
  888.                 default :
  889.                     type_error($1) ;
  890.                     break ;
  891.               }
  892.            }
  893.         ;
  894.  
  895. arglist :  /* empty */
  896.             { $$ = 0 ; }
  897.         |  args
  898.         ;
  899.  
  900. args    :  expr        %prec  LPAREN
  901.             { $$ = 1 ; }
  902.         |  args  COMMA  expr
  903.             { $$ = $1 + 1 ; }
  904.         ;
  905.  
  906. builtin :
  907.         BUILTIN mark  LPAREN  arglist RPAREN
  908.         { BI_REC *p = $1 ;
  909.           $$ = $2 ;
  910.           if ( p-> min_args > $4 || p->max_args < $4 )
  911.             compile_error(
  912.             "wrong number of arguments in call to %s" ,
  913.             p->name ) ;
  914.           if ( p->min_args != p->max_args ) /* variable args */
  915.                code2(_PUSHINT , $4 ) ;
  916.           code2(_BUILTIN , p->fp) ;
  917.         }
  918.         ;
  919.  
  920. /* an empty production to store the code_ptr */
  921. mark : /* empty */
  922.          { $$ = code_ptr ; }
  923.  
  924. print_statement : print mark pr_args pr_direction separator
  925.             { code2(_PRINT, $1) ; $$ = $2 ;
  926.               if ( $1 == bi_printf && $3 == 0 )
  927.                     compile_error("no arguments in call to printf") ;
  928.               print_flag = 0 ;
  929.               $$ = $2 ;
  930.             }
  931.             ;
  932.  
  933. print   :  PRINT  { $$ = bi_print ; print_flag = 1 ;}
  934.         |  PRINTF { $$ = bi_printf ; print_flag = 1 ; }
  935.         ;
  936.  
  937. pr_args :  arglist { code1(_PUSHINT) ; code1($1) ; }
  938.         |  LPAREN  arg2 RPAREN
  939.            { $$ = $2->cnt ; zfree($2,sizeof(ARG2_REC)) ; 
  940.              code1(_PUSHINT) ; code1($$) ; 
  941.            }
  942.         ;
  943.  
  944. arg2   :   expr  COMMA  expr
  945.            { $$ = (ARG2_REC*) zmalloc(sizeof(ARG2_REC)) ;
  946.              $$->start = $1 ;
  947.              $$->cnt = 2 ;
  948.            }
  949.         |   arg2 COMMA  expr
  950.             { $$ = $1 ; $$->cnt++ ; }
  951.         ;
  952.  
  953. pr_direction : /* empty */
  954.              |  IO_OUT  expr
  955.                 { code2(_PUSHINT, $1) ; }
  956.              ;
  957.  
  958.  
  959. /*  IF and IF-ELSE */
  960.  
  961. if_front :  IF LPAREN expr RPAREN
  962.             {  $$ = $3 ; eat_nl() ; code_jmp(_JZ, 0) ; }
  963.          ;
  964.  
  965. if_statement : if_front statement
  966.                 { patch_jmp( code_ptr ) ;  }
  967.               ;
  968.  
  969. else    :  ELSE { eat_nl() ; code_jmp(_JMP, 0) ; }
  970.         ;
  971.  
  972. if_else_statement :  if_front statement else statement
  973.                 { patch_jmp(code_ptr) ; patch_jmp($4) ; }
  974.  
  975.  
  976. /*  LOOPS   */
  977.  
  978. do      :  DO
  979.         { eat_nl() ; BC_new() ; }
  980.         ;
  981.  
  982. do_statement : do statement WHILE LPAREN expr RPAREN separator
  983.         { $$ = $2 ;
  984.           code_jmp(_JNZ, $2) ; 
  985.           BC_clear(code_ptr, $5) ; }
  986.         ;
  987.  
  988. while_front :  WHILE LPAREN expr RPAREN
  989.                 { eat_nl() ; BC_new() ;
  990.                   code_push($3, code_ptr-$3) ;
  991.                   code_ptr = $$ = $3 ;
  992.                   code_jmp(_JMP,0) ;
  993.                 }
  994.             ;
  995.  
  996. while_statement :  while_front  statement
  997.                 { INST *c_addr = code_ptr ; /*continue address*/
  998.  
  999.                   patch_jmp( c_addr) ;
  1000.                   code_ptr += code_pop(c_addr) ;
  1001.                   code_jmp(_JNZ, $2) ;
  1002.                   BC_clear(code_ptr, c_addr) ;
  1003.                 }
  1004.                 ;
  1005.  
  1006. for_front  :  FOR LPAREN fexpr0 SEMI_COLON 
  1007.                          fexpr1 SEMI_COLON  fexpr0 RPAREN
  1008.  
  1009.               { $$ = $3 ; eat_nl() ; BC_new() ;
  1010.                 /* push fexpr2 and 3 */
  1011.                 code_push( $5, $7-$5) ;
  1012.                 code_push( $7, code_ptr - $7) ;
  1013.                 /* reset code_ptr */
  1014.                 code_ptr = $5 ;
  1015.                 code_jmp(_JMP, 0) ;
  1016.               }
  1017.            ;
  1018.  
  1019. for_statement  :  for_front  statement
  1020.               { INST *c_addr = code_ptr ;
  1021.                 unsigned len = code_pop(code_ptr) ;
  1022.  
  1023.                 code_ptr += len ;
  1024.                 patch_jmp(code_ptr) ;
  1025.                 len = code_pop(code_ptr) ;
  1026.                 code_ptr += len ;
  1027.                 code_jmp(_JNZ, $2) ;
  1028.                 BC_clear( code_ptr, c_addr) ;
  1029.               }
  1030.               ;
  1031.  
  1032. fexpr0  :  /* empty */   { $$ = code_ptr; }
  1033.         |  expr   { code1(_POP) ; }
  1034.         ;
  1035.  
  1036. fexpr1  :  /*  empty */
  1037.             { /* this will be wiped out when the jmp is coded */
  1038.               $$ = code_ptr ; code2(_PUSHC, &cell_one) ; }
  1039.         |   expr
  1040.         ;
  1041.  
  1042. /* arrays  */
  1043.  
  1044. array   :   ID
  1045.             { switch($1->type)
  1046.               {
  1047.                 case ST_NONE :  /* a new array */
  1048.                     $1->type = ST_ARRAY ;
  1049.                     $1->stval.array = new_ARRAY() ;
  1050.                     break ;
  1051.  
  1052.                 case  ST_ARRAY :
  1053.                 case  ST_LOCAL_ARRAY :
  1054.                     break ;
  1055.  
  1056.                 case  ST_LOCAL_NONE  :
  1057.                     $1->type = ST_LOCAL_ARRAY ;
  1058.                     active_funct->typev[$1->offset] = ST_LOCAL_ARRAY ;
  1059.                     break ;
  1060.  
  1061.                 default : type_error($1) ; break ;
  1062.               }
  1063.             }
  1064.         ;
  1065.  
  1066. expr    :  expr IN  array 
  1067.            { code_array($3) ; code1(A_TEST) ; }
  1068.         |  LPAREN arg2 RPAREN IN array
  1069.            { $$ = $2->start ;
  1070.              code1(A_CAT) ; code1($2->cnt) ;
  1071.              zfree($2, sizeof(ARG2_REC)) ;
  1072.  
  1073.              code_array($5) ;
  1074.              code1(A_TEST) ;
  1075.            }
  1076.         ;
  1077.  
  1078. lvalue  :  array mark LBOX  args  RBOX
  1079.            { 
  1080.              if ( $4 > 1 )
  1081.              { code1(A_CAT) ; code1($4) ; }
  1082.            
  1083.              if( is_local($1) )
  1084.              { code1(LAE_PUSHA) ; code1($1->offset) ; }
  1085.              else code2(AE_PUSHA, $1->stval.array) ;
  1086.              $$ = $2 ;
  1087.            }
  1088.         ;
  1089.  
  1090.  
  1091. /* delete A[i] */
  1092. statement :  DELETE  array mark LBOX args RBOX separator
  1093.              { 
  1094.                $$ = $3 ;
  1095.                if ( $5 > 1 ) { code1(A_CAT) ; code1($5) ; }
  1096.                code_array($2) ;
  1097.                code1(A_DEL) ;
  1098.              }
  1099.  
  1100.           ;
  1101.  
  1102. /*  for ( i in A )  statement */
  1103.  
  1104. array_loop_front :  FOR LPAREN id IN array RPAREN
  1105.                     { eat_nl() ; BC_new() ;
  1106.                       $$ = code_ptr ;
  1107.  
  1108.                       code_address($3) ;
  1109.                       code_array($5) ;
  1110.                       code1(A_LOOP) ; code1(_STOP) ;
  1111.                       code1(0) ; /* put offset of following code here*/
  1112.                     }
  1113.                  ;
  1114.  
  1115. array_loop :  array_loop_front  statement
  1116.               { code1(_STOP) ;  
  1117.                 BC_clear( $2 - 2, code_ptr-1) ;
  1118.                 $2[-1].op = code_ptr - & $2[-2] ;
  1119.               }
  1120.            ;
  1121.  
  1122. /*  fields   */
  1123.  
  1124. field   :  FIELD
  1125.            { $$ = code_ptr ; code2(F_PUSHA, $1) ; }
  1126.         |  DOLLAR  p_expr
  1127.            { $$ = $2 ; code1( FE_PUSHA ) ; }
  1128.         |  LPAREN  field  RPAREN
  1129.            { $$ = $2 ; }
  1130.         ;
  1131.  
  1132. p_expr   :  field   %prec CAT /* removes field (++|--) sr conflict */
  1133.            { if ( code_ptr[-2].op == F_PUSHA )
  1134.                    code_ptr[-2].op =  
  1135.                        ((CELL *)code_ptr[-1].ptr == field ||
  1136.                         (CELL *)code_ptr[-1].ptr >  field+NF )
  1137.                         ? _PUSHI : F_PUSHI ;
  1138.              else if ( code_ptr[-1].op == FE_PUSHA ) 
  1139.                    code_ptr[-1].op = FE_PUSHI ;
  1140.              else  bozo("missing F(E)_PUSHA") ;
  1141.            }
  1142.         ;
  1143.  
  1144. expr    :  field   ASSIGN   expr { code1(F_ASSIGN) ; }
  1145.         |  field   ADD_ASG  expr { code1(F_ADD_ASG) ; }
  1146.         |  field   SUB_ASG  expr { code1(F_SUB_ASG) ; }
  1147.         |  field   MUL_ASG  expr { code1(F_MUL_ASG) ; }
  1148.         |  field   DIV_ASG  expr { code1(F_DIV_ASG) ; }
  1149.         |  field   MOD_ASG  expr { code1(F_MOD_ASG) ; }
  1150.         |  field   POW_ASG  expr { code1(F_POW_ASG) ; }
  1151.         ;
  1152.  
  1153. /* split is handled different than a builtin because
  1154.    it takes an array and optionally a regular expression as args */
  1155.  
  1156. p_expr :  SPLIT LPAREN expr COMMA  array RPAREN
  1157.              { $$ = $3 ;
  1158.                code_array($5) ;
  1159.                code2(_PUSHI, &fs_shadow) ;
  1160.                code2(_BUILTIN, bi_split) ;
  1161.              }
  1162.           |  SPLIT LPAREN expr COMMA array COMMA
  1163.                { code_array($5) ; }
  1164.              split_back
  1165.              { $$ = $3 ; code2(_BUILTIN, bi_split) ; }
  1166.           ;
  1167.  
  1168. /* split back is not the same as
  1169.    re_or_expr RPAREN
  1170.    because the action is cast_for_split() instead
  1171.    of cast_to_RE()
  1172. */
  1173.  
  1174. split_back :  expr RPAREN
  1175.              { 
  1176.                if ( code_ptr[-2].op == _PUSHC &&
  1177.                    ((CELL *)code_ptr[-1].ptr)->type == C_STRING )
  1178.                    cast_for_split(code_ptr[-1].ptr) ;
  1179.              }
  1180.  
  1181.            |  RE  RPAREN
  1182.              { code2(_PUSHC, $1) ; }
  1183.            ;
  1184.  
  1185.  
  1186.              
  1187.  
  1188. /*  match(expr, RE) */
  1189.  
  1190. p_expr : MATCH_FUNC LPAREN expr COMMA re_or_expr RPAREN
  1191.         { $$ = $3 ; code2(_BUILTIN, bi_match) ; }
  1192.      ;
  1193.  
  1194. re_or_expr  :   RE
  1195.                 { $$ = code_ptr ;
  1196.                   code2(_PUSHC, $1) ;
  1197.                 }
  1198.             |   expr    %prec  MATCH
  1199.                 { if ( code_ptr[-2].op == _PUSHC &&
  1200.                        ((CELL *)code_ptr[-1].ptr)->type == C_STRING )
  1201.                      /* re compile now */
  1202.                      cast_to_RE((CELL *) code_ptr[-1].ptr) ;
  1203.                 }
  1204.             ;
  1205.  
  1206. /* length w/o an argument */
  1207.  
  1208. p_expr :  LENGTH
  1209.           { $$ = code_ptr ;
  1210.             code2(_PUSHI, field) ;
  1211.             code2(_BUILTIN, bi_length) ;
  1212.           }
  1213.        ;
  1214.  
  1215. exit_statement :  EXIT   separator
  1216.                     { $$ = code_ptr ;
  1217.                       code1(_EXIT0) ; }
  1218.                |  EXIT   expr  separator
  1219.                     { $$ = $2 ; code1(_EXIT) ; }
  1220.  
  1221. return_statement :  RETURN   separator
  1222.                     { $$ = code_ptr ;
  1223.                       code1(_RET0) ; }
  1224.                |  RETURN   expr  separator
  1225.                     { $$ = $2 ; code1(_RET) ; }
  1226.  
  1227. /* getline */
  1228.  
  1229. p_expr :  getline      %prec  GETLINE
  1230.           { $$ = code_ptr ;
  1231.             code2(F_PUSHA, &field[0]) ;
  1232.             code1(_PUSHINT) ; code1(0) ; 
  1233.             code2(_BUILTIN, bi_getline) ;
  1234.             getline_flag = 0 ;
  1235.           }
  1236.        |  getline  fvalue     %prec  GETLINE
  1237.           { $$ = $2 ;
  1238.             code1(_PUSHINT) ; code1(0) ;
  1239.             code2(_BUILTIN, bi_getline) ;
  1240.             getline_flag = 0 ;
  1241.           }
  1242.        |  getline_file  p_expr    %prec IO_IN
  1243.           { code1(_PUSHINT) ; code1(F_IN) ;
  1244.             code2(_BUILTIN, bi_getline) ;
  1245.             /* getline_flag already off in yylex() */
  1246.           }
  1247.        |  p_expr PIPE GETLINE  
  1248.           { code2(F_PUSHA, &field[0]) ;
  1249.             code1(_PUSHINT) ; code1(PIPE_IN) ;
  1250.             code2(_BUILTIN, bi_getline) ;
  1251.           }
  1252.        |  p_expr PIPE GETLINE   fvalue
  1253.           { 
  1254.             code1(_PUSHINT) ; code1(PIPE_IN) ;
  1255.             code2(_BUILTIN, bi_getline) ;
  1256.           }
  1257.        ;
  1258.  
  1259. getline :   GETLINE  { getline_flag = 1 ; }
  1260.  
  1261. fvalue  :   lvalue  |  field  ;
  1262.  
  1263. getline_file  :  getline  IO_IN
  1264.                  { $$ = code_ptr ;
  1265.                    code2(F_PUSHA, field+0) ;
  1266.                  }
  1267.               |  getline fvalue IO_IN
  1268.                  { $$ = $2 ; }
  1269.               ;
  1270.  
  1271. /*==========================================
  1272.     sub and gsub  
  1273.   ==========================================*/
  1274.  
  1275. p_expr  :  sub_or_gsub LPAREN re_or_expr COMMA  expr  sub_back
  1276.            {
  1277.              if ( $6 - $5 == 2   &&
  1278.                   $5->op == _PUSHC  &&
  1279.                   ((CELL *) $5[1].ptr)->type == C_STRING )
  1280.              /* cast from STRING to REPL at compile time */
  1281.                  cast_to_REPL( (CELL *) $5[1].ptr ) ;
  1282.  
  1283.              code2(_BUILTIN, $1) ;
  1284.              $$ = $3 ;
  1285.            }
  1286.  
  1287. sub_or_gsub :  SUB  { $$ = bi_sub ; }
  1288.             |  GSUB { $$ = bi_gsub ; }
  1289.             ;
  1290.  
  1291. sub_back    :   RPAREN    /* substitute into $0  */
  1292.                 { $$ = code_ptr ;
  1293.                   code2(F_PUSHA, &field[0]) ; 
  1294.                 }
  1295.  
  1296.             |   COMMA fvalue  RPAREN
  1297.                 { $$ = $2 ; }
  1298.             ;
  1299.  
  1300. /*================================================
  1301.     user defined functions
  1302.  *=================================*/
  1303.  
  1304. function_def  :  funct_start  block
  1305.                  { resize_fblock($1, code_ptr) ;
  1306.                    code_ptr = main_code_ptr ;
  1307.                    scope = SCOPE_MAIN ;
  1308.                    active_funct = (FBLOCK *) 0 ;
  1309.                    restore_ids() ;
  1310.                  }
  1311.               ;
  1312.                    
  1313.  
  1314. funct_start   :  funct_head  LPAREN  f_arglist  RPAREN
  1315.                  { eat_nl() ;
  1316.                    scope = SCOPE_FUNCT ;
  1317.                    active_funct = $1 ;
  1318.                    main_code_ptr = code_ptr ;
  1319.  
  1320.                    if ( $1->nargs = $3 )
  1321.                         $1->typev = (char *) memset(
  1322.                                zmalloc($3), ST_LOCAL_NONE, $3) ;
  1323.                    else $1->typev = (char *) 0 ;
  1324.                    code_ptr = $1->code = 
  1325.                        (INST *) zmalloc(PAGE_SZ*sizeof(INST)) ;
  1326.                  }
  1327.               ;
  1328.                   
  1329. funct_head    :  FUNCTION  ID
  1330.                  { FBLOCK  *fbp ;
  1331.  
  1332.                    if ( $2->type == ST_NONE )
  1333.                    {
  1334.                          $2->type = ST_FUNCT ;
  1335.                          fbp = $2->stval.fbp = 
  1336.                              (FBLOCK *) zmalloc(sizeof(FBLOCK)) ;
  1337.                          fbp->name = $2->name ;
  1338.                    }
  1339.                    else
  1340.                    {
  1341.                          type_error( $2 ) ;
  1342.  
  1343.                          /* this FBLOCK will not be put in
  1344.                             the symbol table */
  1345.                          fbp = (FBLOCK*) zmalloc(sizeof(FBLOCK)) ;
  1346.                          fbp->name = "" ;
  1347.                    }
  1348.                    $$ = fbp ;
  1349.                  }
  1350.  
  1351.               |  FUNCTION  FUNCT_ID
  1352.                  { $$ = $2 ; 
  1353.                    if ( $2->code ) 
  1354.                        compile_error("redefinition of %s" , $2->name) ;
  1355.                  }
  1356.               ;
  1357.                          
  1358. f_arglist  :  /* empty */ { $$ = 0 ; }
  1359.            |  f_args
  1360.            ;
  1361.  
  1362. f_args     :  ID
  1363.               { $1 = save_id($1->name) ;
  1364.                 $1->type = ST_LOCAL_NONE ;
  1365.                 $1->offset = 0 ;
  1366.                 $$ = 1 ;
  1367.               }
  1368.            |  f_args  COMMA  ID
  1369.               { if ( is_local($3) ) 
  1370.                   compile_error("%s is duplicated in argument list",
  1371.                     $3->name) ;
  1372.                 else
  1373.                 { $3 = save_id($3->name) ;
  1374.                   $3->type = ST_LOCAL_NONE ;
  1375.                   $3->offset = $1 ;
  1376.                   $$ = $1 + 1 ;
  1377.                 }
  1378.               }
  1379.            ;
  1380.  
  1381. /* a call to a user defined function */
  1382.              
  1383. p_expr  :  FUNCT_ID mark  call_args
  1384.            { $$ = $2 ;
  1385.              code2(_CALL, $1) ;
  1386.  
  1387.              if ( $3 )  code1($3->arg_num+1) ;
  1388.              else  code1(0) ;
  1389.                
  1390.              check_fcall($1, scope, active_funct, 
  1391.                          $3, token_lineno) ;
  1392.            }
  1393.         ;
  1394.  
  1395. call_args  :   LPAREN   RPAREN
  1396.                { $$ = (CA_REC *) 0 ; }
  1397.            |   ca_front  ca_back
  1398.                { $$ = $2 ;
  1399.                  $$->link = $1 ;
  1400.                  $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
  1401.                }
  1402.            ;
  1403.  
  1404. /* The funny definition of ca_front with the COMMA bound to the ID is to
  1405.    force a shift to avoid a reduce/reduce conflict
  1406.    ID->id or ID->array
  1407.  
  1408.    Or to avoid a decision, if the type of the ID has not yet been
  1409.    determined
  1410. */
  1411.  
  1412. ca_front   :  LPAREN
  1413.               { $$ = (CA_REC *) 0 ; }
  1414.            |  ca_front  expr   COMMA
  1415.               { $$ = (CA_REC *) zmalloc(sizeof(CA_REC)) ;
  1416.                 $$->link = $1 ;
  1417.                 $$->type = CA_EXPR  ;
  1418.                 $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
  1419.               }
  1420.            |  ca_front  ID   COMMA
  1421.               { $$ = (CA_REC *) zmalloc(sizeof(CA_REC)) ;
  1422.                 $$->link = $1 ;
  1423.                 $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
  1424.  
  1425.                 code_call_id($$, $2) ;
  1426.               }
  1427.            ;
  1428.  
  1429. ca_back    :  expr   RPAREN
  1430.               { $$ = (CA_REC *) zmalloc(sizeof(CA_REC)) ;
  1431.                 $$->type = CA_EXPR ;
  1432.               }
  1433.  
  1434.            |  ID    RPAREN
  1435.               { $$ = (CA_REC *) zmalloc(sizeof(CA_REC)) ;
  1436.                 code_call_id($$, $1) ;
  1437.               }
  1438.            ;
  1439.  
  1440.  
  1441.     
  1442.  
  1443. %%
  1444.  
  1445. /* resize the code for a user function */
  1446.  
  1447. static void  resize_fblock( fbp, code_ptr )
  1448.   FBLOCK *fbp ;
  1449.   INST *code_ptr ;
  1450. { int size ;
  1451.  
  1452.   code1(_RET0) ; /* make sure there is always a return statement */
  1453.  
  1454.   if ( dump_code )  
  1455.   { code1(_HALT) ; /*stops da() */
  1456.     add_to_fdump_list(fbp) ;
  1457.   }
  1458.  
  1459.   if ( (size = code_ptr - fbp->code) > PAGE_SZ-1 )
  1460.         overflow("function code size", PAGE_SZ ) ;
  1461.  
  1462.   /* resize the code */
  1463.   fbp->code = (INST*) zrealloc(fbp->code, PAGE_SZ*sizeof(INST),
  1464.                        size * sizeof(INST) ) ;
  1465.  
  1466. }
  1467.  
  1468. static void code_array(p)
  1469.   register SYMTAB *p ;
  1470. { if ( is_local(p) )
  1471.   { code1(LA_PUSHA) ; code1(p->offset) ; }
  1472.   else  code2(A_PUSHA, p->stval.array) ;
  1473. }
  1474.  
  1475. static  int  current_offset()
  1476. {
  1477.   switch( scope )
  1478.   { 
  1479.     case  SCOPE_MAIN :  return code_ptr - main_start ;
  1480.     case  SCOPE_BEGIN :  return code_ptr - begin_start ;
  1481.     case  SCOPE_END   :  return code_ptr - end_start ;
  1482.     case  SCOPE_FUNCT :  return code_ptr - active_funct->code ;
  1483.   }
  1484. }
  1485.  
  1486. static void  code_call_id( p, ip )
  1487.   register CA_REC *p ;
  1488.   register SYMTAB *ip ;
  1489. { static CELL dummy ;
  1490.  
  1491.   switch( ip->type )
  1492.   {
  1493.     case  ST_VAR  :
  1494.             p->type = CA_EXPR ;
  1495.             code2(_PUSHI, ip->stval.cp) ;
  1496.             break ;
  1497.  
  1498.     case  ST_LOCAL_VAR  :
  1499.             p->type = CA_EXPR ;
  1500.             code1(L_PUSHI) ;
  1501.             code1(ip->offset) ;
  1502.             break ;
  1503.  
  1504.     case  ST_ARRAY  :
  1505.             p->type = CA_ARRAY ;
  1506.             code2(A_PUSHA, ip->stval.array) ;
  1507.             break ;
  1508.  
  1509.     case  ST_LOCAL_ARRAY :
  1510.             p->type = CA_ARRAY ;
  1511.             code1(LA_PUSHA) ;
  1512.             code1(ip->offset) ;
  1513.             break ;
  1514.  
  1515.     case  ST_NONE :
  1516.             p->type = ST_NONE ;
  1517.             p->call_offset = current_offset() ;
  1518.             p->sym_p = ip ;
  1519.             code2(_PUSHI, &dummy) ;
  1520.             break ;
  1521.  
  1522.     case  ST_LOCAL_NONE :
  1523.             p->type = ST_LOCAL_NONE ;
  1524.             p->call_offset = current_offset() ;
  1525.             p->type_p = & active_funct->typev[ip->offset] ;
  1526.             code1(L_PUSHI) ; 
  1527.             code1(ip->offset) ;
  1528.             break ;
  1529.  
  1530.   
  1531. #ifdef   DEBUG
  1532.     default :
  1533.             bozo("code_call_id") ;
  1534. #endif
  1535.  
  1536.   }
  1537. }
  1538.  
  1539. int parse()
  1540. { int yy = yyparse() ;
  1541.   if ( resolve_list )  resolve_fcalls() ;
  1542.   return yy ;
  1543. }
  1544.  
  1545. @//E*O*F mawk0.97/parse.y//
  1546. chmod u=rw,g=r,o=r mawk0.97/parse.y
  1547.  
  1548. echo x - mawk0.97/print.c
  1549. sed 's/^@//' > "mawk0.97/print.c" <<'@//E*O*F mawk0.97/print.c//'
  1550.  
  1551. /********************************************
  1552. print.c
  1553. copyright 1991, Michael D. Brennan
  1554.  
  1555. This is a source file for mawk, an implementation of
  1556. the Awk programming language as defined in
  1557. Aho, Kernighan and Weinberger, The AWK Programming Language,
  1558. Addison-Wesley, 1988.
  1559.  
  1560. See the accompaning file, LIMITATIONS, for restrictions
  1561. regarding modification and redistribution of this
  1562. program in source or binary form.
  1563. ********************************************/
  1564.  
  1565. /* $Log:    print.c,v $
  1566.  * Revision 2.2  91/04/09  12:39:23  brennan
  1567.  * added static to funct decls to satisfy STARDENT compiler
  1568.  * 
  1569.  * Revision 2.1  91/04/08  08:23:43  brennan
  1570.  * VERSION 0.97
  1571.  * 
  1572. */
  1573.  
  1574. #include "mawk.h"
  1575. #include "bi_vars.h"
  1576. #include "bi_funct.h"
  1577. #include "memory.h"
  1578. #include "field.h"
  1579. #include "scan.h"
  1580. #include "files.h"
  1581.  
  1582. /*  static  functions */
  1583. static void  PROTO( print_cell, (CELL *, FILE *) ) ;
  1584. static void  PROTO( do_printf, (FILE *, char *, unsigned, CELL *) ) ;
  1585. static void  PROTO( do_sprintf, (char *, unsigned, CELL *) ) ;
  1586.  
  1587.  
  1588. static void print_cell(p, fp)
  1589.   register CELL *p ;
  1590.   register FILE *fp ;
  1591. { register int len ;
  1592.   
  1593.   switch( p->type )
  1594.   {
  1595.     case C_NOINIT : break ;
  1596.     case C_MBSTRN :
  1597.     case C_STRING :
  1598.     case C_STRNUM :
  1599.         switch( len = string(p)->len )
  1600.         {
  1601.           case 0 :  break ;
  1602.           case 1 :
  1603.                     putc(string(p)->str[0],fp) ;
  1604.                     break ;
  1605.  
  1606.           default :
  1607.                     fwrite(string(p)->str, 1, len, fp) ;
  1608.         }
  1609.         break ;
  1610.  
  1611.     case C_DOUBLE :
  1612.         fprintf(fp, string(field + OFMT)->str, p->dval) ;
  1613.         break ;
  1614.  
  1615.     default :
  1616.         bozo("bad cell passed to print_cell") ;
  1617.   }
  1618. }
  1619.  
  1620. /* on entry to bi_print or bi_printf the stack is:
  1621.  
  1622.    sp[0] = an integer k
  1623.        if ( k < 0 )  output is to a file with name in sp[-1]
  1624.        { so open file and sp -= 2 }
  1625.  
  1626.    sp[0] = k >= 0 is the number of print args
  1627.    sp[-k]   holds the first argument 
  1628. */
  1629.  
  1630. CELL *bi_print(sp)
  1631.   CELL *sp ; /* stack ptr passed in */
  1632. { register CELL *p ;
  1633.   register int k ;
  1634.   FILE *fp ;
  1635.  
  1636.   if ( (k = sp->type) < 0 )
  1637.   { if ( (--sp)->type < C_STRING ) cast1_to_s(sp) ;
  1638.     fp = (FILE *) file_find( string(sp), k ) ;
  1639.     free_STRING(string(sp)) ;
  1640.     k = (--sp)->type ;
  1641.   }
  1642.   else  fp = stdout ;
  1643.  
  1644.   if ( k )  
  1645.   { p = sp - k ; /* clear k variables off the stack */
  1646.     sp = p - 1 ;
  1647.     while ( k-- > 1 ) 
  1648.     { print_cell(p,fp) ; print_cell(bi_vars+OFS,fp) ;
  1649.       cell_destroy(p) ; p++ ; }
  1650.     
  1651.     print_cell(p, fp) ;  cell_destroy(p) ;
  1652.   }
  1653.   else  
  1654.   { sp-- ;
  1655.     print_cell( &field[0], fp )  ; }
  1656.  
  1657.   print_cell( bi_vars + ORS , fp) ;
  1658.   return sp ;
  1659. }
  1660.   
  1661. /* the contents of format are preserved */
  1662. static void do_printf( fp, format, argcnt, cp)
  1663.   FILE *fp ;
  1664.   char *format ; unsigned argcnt ;
  1665.   CELL *cp ;  /* ptr to an array of arguments ( on the eval stack) */
  1666. { register char *q ;
  1667.   char  save ;
  1668.   char *p = format ;
  1669.  
  1670.   while ( 1 )
  1671.   { if ( ! (q = strchr(p, '%'))  )
  1672.        if ( argcnt == 0 )
  1673.        { fputs(p, fp) ; return ; }
  1674.        else
  1675.          rt_error("too many arguments in call to printf(%s)", 
  1676.               format ) ; 
  1677.  
  1678.     if ( * ++q == '%' )
  1679.     { fwrite( p, q-p, 1, fp) ; p = q+1 ; continue ; }
  1680.  
  1681.     if ( argcnt == 0 )
  1682.         rt_error("too few arguments in call to printf(%s)", format) ; 
  1683.  
  1684.     if ( *q == '-' ) q++ ;
  1685.     while ( scan_code[*(unsigned char*)q] == SC_DIGIT )  q++ ;
  1686.     if ( *q == '.' )
  1687.     { q++ ;
  1688.       while ( scan_code[*(unsigned char*)q] == SC_DIGIT ) q++ ; }
  1689.     
  1690.     save = * ++q ;  *q = 0 ;
  1691.     switch( q[-1] )
  1692.     {
  1693.       case 'c' :  
  1694.       case 'd' :
  1695.       case 'o' :
  1696.       case 'x' :
  1697.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1698.             (void) fprintf(fp, p, (int) cp->dval) ;
  1699.             break ;
  1700.       case 'e' :
  1701.       case 'g' :
  1702.       case 'f' :
  1703.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1704.             (void) fprintf(fp, p, cp->dval) ;
  1705.             break ;
  1706.       case  's' :
  1707.             if ( cp->type < C_STRING ) cast1_to_s(cp) ;
  1708.             (void) fprintf(fp, p, string(cp)->str) ;
  1709.             break ;
  1710.       default :
  1711.             rt_error("bad format string in call to printf(%s)",
  1712.               format) ;
  1713.     }
  1714.     *q = save ; p = q ; argcnt-- ; cp++ ;
  1715.   }
  1716. }
  1717.  
  1718.  
  1719. CELL *bi_printf(sp)
  1720.   register CELL *sp ;
  1721. { register int k ;
  1722.   register CELL *p ;
  1723.   FILE *fp ;
  1724.  
  1725.   if ( (k = sp->type) < 0 )
  1726.   { if ( (--sp)->type < C_STRING ) cast1_to_s(sp) ;
  1727.     fp = (FILE *) file_find( string(sp), k ) ;
  1728.     free_STRING(string(sp)) ;
  1729.     k = (--sp)->type ;
  1730.   }
  1731.   else  fp = stdout ;
  1732.  
  1733.   sp -= k-- ; /* sp points at the format string */
  1734.   if ( sp->type < C_STRING )  cast1_to_s(sp) ;
  1735.   do_printf(fp, string(sp)->str, k, sp+1) ;
  1736.  
  1737.   free_STRING(string(sp)) ;
  1738.   for ( p = sp+1 ; k-- ; p++ )  cell_destroy(p) ;
  1739.   return --sp ;
  1740. }
  1741.  
  1742. CELL *bi_sprintf(sp)
  1743.   CELL *sp ;
  1744. { CELL *p ;
  1745.   int argcnt = sp->type ;
  1746.   void do_sprintf() ;
  1747.  
  1748.   sp -= argcnt-- ; /* sp points at the format string */
  1749.   if ( sp->type < C_STRING )  cast1_to_s(sp) ;
  1750.   do_sprintf(string(sp)->str, argcnt, sp+1) ;
  1751.  
  1752.   free_STRING(string(sp)) ;
  1753.   for ( p = sp+1 ; argcnt-- ; p++ )  cell_destroy(p) ;
  1754.  
  1755.   sp->ptr = (PTR) new_STRING( temp_buff.string_buff ) ;
  1756.   return sp ;
  1757. }
  1758.  
  1759.  
  1760. /* the contents of format are preserved */
  1761. static void do_sprintf( format, argcnt, cp)
  1762.   char *format ; 
  1763.   unsigned argcnt ;
  1764.   CELL *cp ;
  1765. { register char *q ;
  1766.   char  save ;
  1767.   char *p = format ;
  1768.   register char *target = temp_buff.string_buff ;
  1769.  
  1770.   *target = 0 ;
  1771.   while ( 1 )
  1772.   { if ( ! (q = strchr(p, '%'))  )
  1773.        if ( argcnt == 0 )
  1774.        { strcpy(target, p) ; 
  1775.          /* check the result is not too large */
  1776.          if ( main_buff[-1] != 0 )
  1777.          { /* This may have damaged us -- try to croak out an error
  1778.               message and exit */
  1779.            rt_overflow("sprintf buffer", TEMP_BUFF_SZ) ;
  1780.          }
  1781.          return ; 
  1782.        }
  1783.        else
  1784.          rt_error("too many arguments in call to sprintf(%s)", 
  1785.              format ) ; 
  1786.  
  1787.     if ( * ++q == '%' )
  1788.     { unsigned len ;
  1789.  
  1790.       (void) memcpy(target, p, len = q-p ) ;
  1791.       p = q + 1 ; *(target += len) = 0 ;
  1792.       continue ;
  1793.     }
  1794.  
  1795.     if ( argcnt == 0 )
  1796.       rt_error("too few arguments in call to sprintf(%s)", format) ; 
  1797.  
  1798.     if ( *q == '-' ) q++ ;
  1799.     while ( scan_code[*(unsigned char*)q] == SC_DIGIT )  q++ ;
  1800.     if ( *q == '.' )
  1801.     { q++ ;
  1802.       while ( scan_code[*(unsigned char*)q] == SC_DIGIT ) q++ ; }
  1803.     
  1804.     save = * ++q ;  *q = 0 ;
  1805.     switch( q[-1] )
  1806.     {
  1807.       case 'c' :  
  1808.       case 'd' :
  1809.       case 'o' :
  1810.       case 'x' :
  1811.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1812.             (void) sprintf(target, p, (int) cp->dval ) ;
  1813.             target = strchr(target, 0) ;
  1814.             break ;
  1815.       case 'e' :
  1816.       case 'g' :
  1817.       case 'f' :
  1818.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1819.             (void) sprintf(target, p, cp->dval ) ;
  1820.             target = strchr(target, 0) ;
  1821.             break ;
  1822.       case  's' :
  1823.             if ( cp->type < C_STRING ) cast1_to_s(cp) ;
  1824.             (void) sprintf(target, p, string(cp)->str ) ;
  1825.             target = strchr(target, 0) ;
  1826.             break ;
  1827.       default :
  1828.             rt_error("bad format string in call to sprintf(%s)", 
  1829.                 format) ;
  1830.     }
  1831.     *q = save ; p = q ; argcnt-- ; cp++ ;
  1832.   }
  1833. }
  1834.  
  1835. @//E*O*F mawk0.97/print.c//
  1836. chmod u=rw,g=r,o=r mawk0.97/print.c
  1837.  
  1838. echo x - mawk0.97/re_cmpl.c
  1839. sed 's/^@//' > "mawk0.97/re_cmpl.c" <<'@//E*O*F mawk0.97/re_cmpl.c//'
  1840.  
  1841. /********************************************
  1842. re_cmpl.c
  1843. copyright 1991, Michael D. Brennan
  1844.  
  1845. This is a source file for mawk, an implementation of
  1846. the Awk programming language as defined in
  1847. Aho, Kernighan and Weinberger, The AWK Programming Language,
  1848. Addison-Wesley, 1988.
  1849.  
  1850. See the accompaning file, LIMITATIONS, for restrictions
  1851. regarding modification and redistribution of this
  1852. program in source or binary form.
  1853. ********************************************/
  1854.  
  1855. /* $Log:    re_cmpl.c,v $
  1856.  * Revision 2.1  91/04/08  08:23:45  brennan
  1857.  * VERSION 0.97
  1858.  * 
  1859. */
  1860.  
  1861.  
  1862. /*  re_cmpl.c  */
  1863.  
  1864. #include "mawk.h"
  1865. #include "memory.h"
  1866. #include "scan.h"
  1867. #include "regexp.h"
  1868. #include "repl.h"
  1869. #include  <string.h>
  1870.  
  1871. static  CELL *PROTO( REPL_compile, (STRING *) ) ;
  1872.  
  1873. typedef struct re_node {
  1874. STRING  *sval ;
  1875. PTR     re ;
  1876. struct re_node *link ;
  1877. }  RE_NODE ;
  1878.  
  1879. static RE_NODE *re_list ;  /* a list of compiled regular expressions */
  1880.  
  1881.  
  1882. PTR re_compile( sval )
  1883.   STRING *sval ;
  1884. { register RE_NODE *p ;
  1885.   RE_NODE *q ;
  1886.   char *s ;
  1887.  
  1888.   /* search list */
  1889.   s = sval->str ;
  1890.   p = re_list ;
  1891.   q = (RE_NODE *) 0 ;
  1892.   while ( p )
  1893.     if ( strcmp(s, p->sval->str) == 0 )  /* found */
  1894.         if ( !q ) /* already at front */  goto _return ;
  1895.         else /* delete from list for move to front */
  1896.         { q->link = p->link ; goto found ; }
  1897.     else
  1898.     { q = p ; p = p->link ; }
  1899.  
  1900.   /* not found */
  1901.   p = (RE_NODE *) zmalloc( sizeof(RE_NODE) ) ;
  1902.   p->sval = sval ;
  1903.   sval->ref_cnt++ ;
  1904.   if( !(p->re = REcompile(s)) )
  1905.   { errmsg(0, "regular expression compile failed (%s)\n%s\n" ,
  1906.                REerrlist[REerrno] , s) ;  mawk_exit(1) ; }
  1907.  
  1908. found :
  1909. /* insert p at the front of the list */
  1910.   p->link = re_list ; re_list = p ;
  1911.  
  1912. _return :
  1913.   
  1914. #ifdef  DEBUG
  1915.   if ( dump_RE )  REmprint(p->re, stderr) ;
  1916. #endif
  1917.   return p->re ;
  1918. }
  1919.  
  1920.  
  1921.  
  1922. /* this is only used by da() */
  1923.  
  1924. char *re_uncompile( m )
  1925.   PTR  m ;
  1926. { register RE_NODE *p ;
  1927.  
  1928.   for( p = re_list ; p ; p = p->link )
  1929.         if ( p->re == m )  return  p->sval->str ;
  1930. #ifdef  DEBUG
  1931.   bozo("non compiled machine") ;
  1932. #endif
  1933. }
  1934.   
  1935.  
  1936.  
  1937. /*=================================================*/
  1938. /*  replacement  operations   */
  1939.  
  1940. /* create a replacement CELL from a STRING *  */
  1941.  
  1942. static CELL *REPL_compile( sval )
  1943.   STRING  *sval ;
  1944. { int i = 0 ;
  1945.   register char *p = sval->str ;
  1946.   register char *q ;
  1947.   char *xbuff ;
  1948.   CELL *cp ;
  1949.  
  1950.   q = xbuff = (char *) zmalloc( sval->len + 1 ) ;
  1951.  
  1952.   while ( 1 )
  1953.   {
  1954.       switch( *p )
  1955.       {
  1956.         case  0  :  *q = 0 ;
  1957.                     goto  done  ;
  1958.  
  1959.         case  '\\':
  1960.                 if ( p[1] == '&' )
  1961.                 { *q++ = '&' ; p += 2 ; continue ; }
  1962.                 else  break ;
  1963.  
  1964.         case  '&':
  1965.                 /* if empty we don't need to make a node */
  1966.                 if ( q != xbuff )
  1967.                 { *q = 0 ;
  1968.                   temp_buff.ptr_buff[i++] = (PTR) new_STRING(xbuff) ;
  1969.                 }
  1970.                 /* and a null node for the '&'  */
  1971.                 temp_buff.ptr_buff[i++] = (PTR) 0  ;
  1972.                 /*  reset  */
  1973.                 p++ ;  q = xbuff ;
  1974.                 continue ;
  1975.  
  1976.         default :
  1977.                 break ;
  1978.       }
  1979.  
  1980.       *q++ = *p++ ;
  1981.   }
  1982.  
  1983. done :   
  1984.   /* if we have one empty string it will get made now */
  1985.   if ( q > xbuff || i == 0 )
  1986.           temp_buff.ptr_buff[i++] = (PTR) new_STRING(xbuff) ;
  1987.  
  1988.   if ( i > MAX_FIELD )
  1989.       overflow("replacement pieces", MAX_FIELD) ;
  1990.  
  1991.   cp = new_CELL() ;
  1992.   if ( i == 1 )
  1993.   {
  1994.     cp->type = C_REPL ;
  1995.     cp->ptr = temp_buff.ptr_buff[0] ;
  1996.   }
  1997.   else
  1998.   {
  1999.     STRING **sp = (STRING**)
  2000.                   (cp->ptr = zmalloc(sizeof(STRING *)*i)) ;
  2001.     int j = 0 ;
  2002.  
  2003.     while ( j < i ) *sp++ = (STRING *)temp_buff.ptr_buff[j++] ;
  2004.  
  2005.     cp->type = C_REPLV ;
  2006.     cp->vcnt = i ;
  2007.   }
  2008.   zfree(xbuff, sval->len+1) ;
  2009.   return cp ;
  2010. }
  2011.  
  2012. /* free memory used by a replacement CELL  */
  2013.  
  2014. void  repl_destroy( cp )
  2015.   register CELL *cp ;
  2016. { register STRING **p ;
  2017.   unsigned cnt ;
  2018.  
  2019.   if ( cp->type == C_REPL )  free_STRING(string(cp)) ;
  2020.   else  /* an C_REPLV  */
  2021.   {
  2022.     p = (STRING **) cp->ptr ;
  2023.     for( cnt = cp->vcnt ; cnt ; cnt--) 
  2024.     {
  2025.       if ( *p ) free_STRING( *p ) ;
  2026.       p++ ;
  2027.     }
  2028.     zfree( cp->ptr, cp->vcnt * sizeof(STRING *) ) ;
  2029.   }
  2030. }
  2031.  
  2032. /* copy a C_REPLV cell to another CELL */
  2033.  
  2034. CELL  *replv_cpy( target, source )
  2035.   CELL *target , *source ;
  2036. { STRING **t, **s ;
  2037.   unsigned cnt ;
  2038.  
  2039.   target->type = C_REPLV ;
  2040.   target->vcnt = source->vcnt ;
  2041.  
  2042.   target->ptr = (PTR) zmalloc( target->vcnt * sizeof(STRING *) ) ;
  2043.   cnt = target->vcnt ;
  2044.   t = (STRING **) target->ptr ;
  2045.   s = (STRING **) source->ptr ;
  2046.   while ( cnt-- )
  2047.   { 
  2048.     if ( *t = *s++ )   (*t)->ref_cnt++ ;
  2049.     t++ ;
  2050.   }
  2051.   return target ;
  2052. }
  2053.  
  2054. /* here's our old friend linked linear list with move to the front
  2055.    for compilation of replacement CELLs  */
  2056.  
  2057. typedef  struct repl_node {
  2058.   struct repl_node  *link ;
  2059.   STRING  *sval  ;  /* the input */
  2060.   CELL    *cp ;  /* the output */
  2061. }  REPL_NODE  ;
  2062.  
  2063. static  REPL_NODE  *repl_list ;
  2064.  
  2065. /* search the list (with move to the front) for a compiled
  2066.    separator.
  2067.    return a ptr to a CELL (C_REPL or C_REPLV)
  2068. */
  2069.  
  2070. CELL *repl_compile( sval )
  2071.   STRING *sval ;
  2072. { register REPL_NODE *p ;
  2073.   REPL_NODE *q ;
  2074.   char *s ;
  2075.  
  2076.   /* search the list */
  2077.   s = sval->str ;
  2078.   p = repl_list ;
  2079.   q = (REPL_NODE *) 0 ;
  2080.   while ( p )
  2081.     if ( strcmp(s, p->sval->str) == 0 )  /* found */
  2082.         if ( !q ) /* already at front */  return p->cp ;
  2083.         else /* delete from list for move to front */
  2084.         { q->link = p->link ; goto found ; }
  2085.     else
  2086.     { q = p ; p = p->link ; }
  2087.  
  2088.   /* not found */
  2089.   p = (REPL_NODE *) zmalloc( sizeof(REPL_NODE) ) ;
  2090.   p->sval = sval ;
  2091.   sval->ref_cnt++ ;
  2092.   p->cp = REPL_compile(sval) ;
  2093.  
  2094. found :
  2095. /* insert p at the front of the list */
  2096.   p->link = repl_list ; repl_list = p ;
  2097.   return p->cp ;
  2098. }
  2099.  
  2100. /* return the string for a CELL or type REPL or REPLV,
  2101.    this is only used by da()  */
  2102.  
  2103. char *repl_uncompile( cp )
  2104.   CELL *cp ;
  2105. {
  2106.   register REPL_NODE *p = repl_list ;
  2107.  
  2108.   if ( cp->type == C_REPL )
  2109.     while ( p )
  2110.       if ( p->cp->type == C_REPL &&
  2111.            p->cp->ptr  == cp->ptr )   return p->sval->str ;
  2112.       else  p = p->link ;
  2113.   else
  2114.     while ( p )
  2115.       if ( p->cp->type == C_REPLV &&
  2116.            memcmp( cp->ptr, p->cp->ptr, cp->vcnt * sizeof(STRING*)) 
  2117.            == 0  )   return  p->sval->str ;
  2118.       else  p = p->link ;
  2119.  
  2120.   bozo("unable to uncompile an repl") ;
  2121. }
  2122.  
  2123. /*
  2124.   convert a C_REPLV to  C_REPL
  2125.      replacing the &s with sval
  2126. */
  2127.  
  2128. CELL  *replv_to_repl( cp, sval)
  2129.   CELL *cp ; STRING *sval ;
  2130. { register STRING **p ;
  2131.   STRING **sblock = (STRING **) cp->ptr ;
  2132.   unsigned cnt , vcnt = cp->vcnt ;
  2133.   unsigned len ;
  2134.   char *target ;
  2135.  
  2136. #ifdef  DEBUG
  2137.   if ( cp->type != C_REPLV ) bozo("not replv") ;
  2138. #endif
  2139.  
  2140.   p = sblock ; cnt = vcnt ; len = 0 ;
  2141.   while ( cnt-- )
  2142.       if ( *p )  len += (*p++)->len ;
  2143.       else
  2144.       { *p++ = sval ; sval->ref_cnt++ ; len += sval->len ; }
  2145.  
  2146.   cp->type = C_REPL ;
  2147.   cp->ptr = (PTR) new_STRING((char *) 0, len) ;
  2148.  
  2149.   p = sblock ; cnt = vcnt ; target = string(cp)->str ;
  2150.   while ( cnt-- )
  2151.   { (void) memcpy(target, (*p)->str, (*p)->len) ;
  2152.     target += (*p)->len ;
  2153.     free_STRING(*p) ;
  2154.     p++ ;
  2155.   }
  2156.  
  2157.   zfree( sblock, vcnt * sizeof(STRING *) ) ;
  2158.   return cp ;
  2159. }
  2160.  
  2161. @//E*O*F mawk0.97/re_cmpl.c//
  2162. chmod u=rw,g=r,o=r mawk0.97/re_cmpl.c
  2163.  
  2164. echo x - mawk0.97/regexp.h
  2165. sed 's/^@//' > "mawk0.97/regexp.h" <<'@//E*O*F mawk0.97/regexp.h//'
  2166.  
  2167. /********************************************
  2168. regexp.h
  2169. copyright 1991, Michael D. Brennan
  2170.  
  2171. This is a source file for mawk, an implementation of
  2172. the Awk programming language as defined in
  2173. Aho, Kernighan and Weinberger, The AWK Programming Language,
  2174. Addison-Wesley, 1988.
  2175.  
  2176. See the accompaning file, LIMITATIONS, for restrictions
  2177. regarding modification and redistribution of this
  2178. program in source or binary form.
  2179. ********************************************/
  2180.  
  2181. /*$Log:    regexp.h,v $
  2182.  * Revision 2.1  91/04/08  08:23:47  brennan
  2183.  * VERSION 0.97
  2184.  * 
  2185. */
  2186.  
  2187. #include <stdio.h>
  2188.  
  2189. PTR   PROTO( REcompile , (char *) ) ;
  2190. int   PROTO( REtest, (char *, PTR) ) ;
  2191. char *PROTO( REmatch, (char *, PTR, unsigned *) ) ;
  2192. void  PROTO( REmprint, (PTR , FILE*) ) ;
  2193.  
  2194. extern  int  REerrno ;
  2195. extern  char *REerrlist[] ;
  2196.  
  2197.  
  2198. @//E*O*F mawk0.97/regexp.h//
  2199. chmod u=rw,g=r,o=r mawk0.97/regexp.h
  2200.  
  2201. echo x - mawk0.97/repl.h
  2202. sed 's/^@//' > "mawk0.97/repl.h" <<'@//E*O*F mawk0.97/repl.h//'
  2203.  
  2204. /********************************************
  2205. repl.h
  2206. copyright 1991, Michael D. Brennan
  2207.  
  2208. This is a source file for mawk, an implementation of
  2209. the Awk programming language as defined in
  2210. Aho, Kernighan and Weinberger, The AWK Programming Language,
  2211. Addison-Wesley, 1988.
  2212.  
  2213. See the accompaning file, LIMITATIONS, for restrictions
  2214. regarding modification and redistribution of this
  2215. program in source or binary form.
  2216. ********************************************/
  2217.  
  2218. /*$Log:    repl.h,v $
  2219.  * Revision 2.1  91/04/08  08:23:49  brennan
  2220.  * VERSION 0.97
  2221.  * 
  2222. */
  2223.  
  2224. /* repl.h */
  2225.  
  2226. #ifndef  REPL_H
  2227. #define  REPL_H
  2228.  
  2229. PTR  PROTO( re_compile, (STRING *) ) ;
  2230. char *PROTO( re_uncompile, (PTR) ) ;
  2231.  
  2232.  
  2233. CELL *PROTO( repl_compile, (STRING *) ) ;
  2234. char *PROTO( repl_uncompile, (CELL *) ) ;
  2235. void  PROTO( repl_destroy, (CELL *) ) ;
  2236. CELL *PROTO( replv_cpy, (CELL *, CELL *) ) ;
  2237. CELL *PROTO( replv_to_repl, (CELL *, STRING *) ) ;
  2238.  
  2239. #endif
  2240. @//E*O*F mawk0.97/repl.h//
  2241. chmod u=rw,g=r,o=r mawk0.97/repl.h
  2242.  
  2243. echo x - mawk0.97/scan.c
  2244. sed 's/^@//' > "mawk0.97/scan.c" <<'@//E*O*F mawk0.97/scan.c//'
  2245.  
  2246. /********************************************
  2247. scan.c
  2248. copyright 1991, Michael D. Brennan
  2249.  
  2250. This is a source file for mawk, an implementation of
  2251. the Awk programming language as defined in
  2252. Aho, Kernighan and Weinberger, The AWK Programming Language,
  2253. Addison-Wesley, 1988.
  2254.  
  2255. See the accompaning file, LIMITATIONS, for restrictions
  2256. regarding modification and redistribution of this
  2257. program in source or binary form.
  2258. ********************************************/
  2259.  
  2260.  
  2261. /* $Log:    scan.c,v $
  2262.  * Revision 2.2  91/04/09  12:39:27  brennan
  2263.  * added static to funct decls to satisfy STARDENT compiler
  2264.  * 
  2265.  * Revision 2.1  91/04/08  08:23:51  brennan
  2266.  * VERSION 0.97
  2267.  * 
  2268. */
  2269.  
  2270.  
  2271. #include  "mawk.h"
  2272. #include  "sizes.h"
  2273. #include  "scan.h"
  2274. #include  "memory.h"
  2275. #include  "field.h"
  2276. #include  "init.h"
  2277. #include  "fin.h"
  2278. #include  "repl.h"
  2279. #include  <fcntl.h>
  2280. #include  <string.h>
  2281. #include  "files.h"
  2282.  
  2283.  
  2284. /* static functions */
  2285. static void PROTO(buff_create, (char *) ) ;
  2286. static int PROTO(slow_next, (void) ) ;
  2287. static void PROTO(eat_comment, (void) ) ;
  2288. static double PROTO(collect_decimal, (int, int *) ) ;
  2289. static int PROTO(collect_string, (void) ) ;
  2290. static int  PROTO(collect_RE, (void) ) ;
  2291. static char *PROTO(rm_escape, (char *) ) ;
  2292.  
  2293.  
  2294. /*-----------------------------
  2295.   program file management
  2296.  *----------------------------*/
  2297.  
  2298. static  unsigned char *buffer ;
  2299. static  unsigned char *buffp ;  
  2300.     /* unsigned so it works with 8 bit chars */
  2301. static  int  program_fd = -1  ; 
  2302. static  int  eof_flag ;
  2303.  
  2304.  
  2305. static void buff_create(s)
  2306.   char *s ;
  2307. {
  2308.   /* If program_fd == -1, program came from command line and s
  2309.      is it, else s is a filename */
  2310.  
  2311.   if ( program_fd == -1 )
  2312.   { buffer = buffp = (unsigned char *) s ; eof_flag = 1 ; }
  2313.   else /* s is a filename, open it */
  2314.   {
  2315.     if ( s[0] == '-' && s[1] == 0 ) program_fd = 0 ;
  2316.     else
  2317.     if ( (program_fd = open(s, O_RDONLY, 0)) == -1 )
  2318.     { errmsg( errno, "cannot open %s", s) ; mawk_exit(1) ; }
  2319.  
  2320.     buffp = buffer = (unsigned char *) zmalloc( BUFFSZ+1 ) ;
  2321.  
  2322.     eof_flag = fillbuff(program_fd, buffer, BUFFSZ) < BUFFSZ ;
  2323.   }
  2324. }
  2325.  
  2326. void scan_cleanup()
  2327. { 
  2328.   if ( program_fd >= 0 ) zfree(buffer, BUFFSZ+1) ;
  2329.   if ( program_fd > 0 )  (void) close(program_fd) ;
  2330.   scan_code['\n'] = SC_SPACE ;
  2331. }
  2332.  
  2333.  
  2334. void  scan_init(flag, p)
  2335.   int flag ; /* on if program is from the command line */
  2336.   char *p ;
  2337. { 
  2338.   if ( ! flag ) program_fd = 0 ;
  2339.   buff_create(p) ;
  2340.  
  2341.   eat_nl() ; /* scan to first token */
  2342.   if ( next() == 0 )  
  2343.   { errmsg(0, "no program") ; mawk_exit(1) ; }
  2344.   un_next() ;
  2345. }
  2346.  
  2347. /*--------------------------------
  2348.   global variables shared by yyparse() and yylex()
  2349.  *-------------------------------*/
  2350.  
  2351. int  current_token = -1 ; 
  2352. unsigned  token_lineno ;
  2353. unsigned  compile_error_count ;
  2354. int   paren_cnt ;
  2355. int   brace_cnt ;
  2356. int   print_flag ;  /* changes meaning of '>' */
  2357. int   getline_flag ; /* changes meaning of '<' */
  2358.  
  2359. extern  YYSTYPE  yylval ;
  2360.  
  2361. /*----------------------------------------
  2362.  file reading functions
  2363.  next() and un_next(c) are macros in scan.h
  2364.  
  2365.  *---------------------*/
  2366.  
  2367. static  unsigned lineno = 1 ;
  2368.  
  2369. /* used to help distinguish / as divide or start of RE  */
  2370.  
  2371. static int can_precede_re[] =
  2372. { MATCH, NOT_MATCH, COMMA, RBRACE, 
  2373. LPAREN, NOT, P_OR, P_AND, NL,  -1 } ;
  2374.  
  2375. /* read one character -- slowly */
  2376. static int slow_next()
  2377. { 
  2378.   if ( *buffp == 0  )
  2379.       if ( !eof_flag ) 
  2380.       { buffp = buffer ;
  2381.         eof_flag = fillbuff(program_fd, buffer,BUFFSZ) < BUFFSZ ;
  2382.       }
  2383.  
  2384.   return *buffp++ ; /* note can un_next() , eof which is zero */
  2385. }
  2386.  
  2387. static void eat_comment()
  2388. { register int c ;
  2389.  
  2390.   while ( (c = next()) != '\n' && scan_code[c] ) ;
  2391.   un_next() ;
  2392. }
  2393.  
  2394. void eat_nl() /* eat all space including newlines */
  2395. {
  2396.   while ( 1 )
  2397.     switch( scan_code[next()] )
  2398.     { 
  2399.       case SC_COMMENT : 
  2400.          eat_comment() ;
  2401.          break ;
  2402.          
  2403.       case  SC_NL  :   lineno++ ;
  2404.       /* fall thru  */
  2405.       case  SC_SPACE  :   break ;
  2406.       default :  
  2407.           un_next() ; return ;
  2408.     }
  2409. }
  2410.  
  2411. int yylex()
  2412. { 
  2413.   register int c ;
  2414.  
  2415.   token_lineno = lineno ;
  2416.  
  2417. reswitch:
  2418.  
  2419.     switch( scan_code[c = next()] )
  2420.     {
  2421.       case  0  :  /* if no terminator on the line put one */
  2422.           if ( (c = current_token) == RBRACE ||
  2423.                 c == NL || c == SEMI_COLON ) ct_ret(EOF) ;
  2424.           else
  2425.           { un_next() ;  ct_ret(NL) ; }
  2426.           
  2427.