$! VAX/VMS archive file created by VMS_SHARE V06.03 20-Oct-1988.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user WARNER
$! on 23-NOV-1988 03:56:35.30.
$!
$! ATTENTION: To keep each article below 31 blocks (15872 bytes), this
$!            program has been transmitted in 20 parts.  You should
$!            concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 26 files:
$!        ALLOCA.MAR
$!        AWK.H
$!        AWK.H-DIFF
$!        AWK.Y
$!        AWK1.C
$!        AWK2.C
$!        AWK2.C-DIFF
$!        AWK3.C
$!        AWK_TAB.C
$!        BCMP.MAR
$!        BCOPY.MAR
$!        BZERO.MAR
$!        CLINK.OPT
$!        COPYING.
$!        DEBUG.C
$!        MAKE-GAWK.COM
$!        MAKEFILE.
$!        OBSTACK.C
$!        OBSTACK.H
$!        README.
$!        README.VMS
$!        REGEX.C
$!        REGEX.H
$!        VERSION.C
$!        VMS-AWK-DIFFS.1_OF_1
$!        VMS-PORT.C
$!
$!==============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.03 20-Oct-1988 requires VMS V4.4 or higher."
$ EXIT 44 
$VERSION_OK:
$ GOTO START
$
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY

b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) );
s_file_spec := GET_INFO( COMMAND_LINE, "output_file" );SET( OUTPUT_FILE
, b_part, s_file_spec ); 
b_errors := CREATE_BUFFER( "{Errors}" );i_errors := 0; 
pat_beg_1 := ANCHOR & "-+-+-+ Beginning";
pat_beg_2 := LINE_BEGIN & "+-+-+-+ Beginning";
pat_end := ANCHOR & "+-+-+-+-+ End";
pat_trail := " " & LINE_END;POSITION( BEGINNING_OF( b_part ) ); LOOP b 
:= SEARCH( pat_trail, FORWARD); EXITIF b=0; POSITION( END_OF( b ) )
; LOOP MOVE_HORIZONTAL( -1 ); EXITIF CURRENT_CHARACTER <> ' '; ERASE_CHARACTER
( 1 ); EXITIF CURRENT_OFFSET=0; ENDLOOP; ENDLOOP; POSITION( BEGINNING_OF
( b_part ) ); i_append_line := 0; LOOP EXITIF MARK( NONE ) = END_OF( b_part )
; s_x := ERASE_CHARACTER( 1 ); 
  IF s_x = "+" THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <
> 0 THEN 
      s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF; ENDIF; 
  IF s_x = "-" THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ); IF r_skip <
> 0 THEN 
      s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE )
; r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION
( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL( 1 )
; MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE
( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF; 
  IF s_x = "V" THEN 
    s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL
( -CURRENT_OFFSET ); ENDIF; i_append_line := 1; MOVE_VERTICAL( 1 ); ENDIF; 
  IF s_x = "X" THEN 
    s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL
( -CURRENT_OFFSET ); ENDIF; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; 
  IF s_x <> "" THEN i_errors := i_errors + 1; s_text := CURRENT_LINE; POSITION
( b_errors ); 
    COPY_TEXT( "The following line could not be unpacked properly:" )
; SPLIT_LINE; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part )
; MOVE_VERTICAL( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP 
  r_x := SEARCH( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x )
; ERASE_CHARACTER( 1 ); 
  IF CURRENT_CHARACTER = "`" THEN MOVE_HORIZONTAL( 1 ); ELSE COPY_TEXT( ASCII
( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDIF; ENDLOOP; IF i_errors = 0 THEN SET
( NO_WRITE, b_errors, ON ); ELSE POSITION( BEGINNING_OF( b_errors ) ); 
  COPY_TEXT( FAO( "The following !UL errors were detected while unpacking !AS"
, i_errors, s_file_spec ) ); SPLIT_LINE; 
  SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" );ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!,passed." )
$ RETURN
$
$START:
$ FILE_IS = "ALLOCA.MAR"
$ CHECKSUM_IS = 7999314
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.TITLE`009ALLOCA`009Allocate dynamic storage on stack/free on return
X`009.IDENT`009/1.00/
X
X`009.PSECT`009$CODE,LONG,PIC,REL,SHR,EXE,RD,NOWRT
X`009.ENTRY`009ALLOCA,`094M<>
X`009SUBL2`0094(AP),SP
X`009MOVL`00916(FP),R1
X`009MOVQ`0098(FP),AP
X`009BICL2`009#3,SP
X`009ADDL2`009#28,SP
X`009MOVL`009SP,R0
X`009JMP `009(R1)
X
X`009.END
$ GOSUB UNPACK_FILE
$ FILE_IS = "AWK.H"
$ CHECKSUM_IS = 1533572486
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X * awk.h -- Definitions for gawk.
X *
X * Copyright (C) 1986 Free Software Foundation
X *   Written by Paul Rubin, August 1986
X *
X */
X
X/*
XGAWK is distributed in the hope that it will be useful, but WITHOUT ANY
XWARRANTY.  No author or distributor accepts responsibility to anyone
Xfor the consequences of using it or for whether it serves any
Xparticular purpose or works at all, unless he says so in writing.
XRefer to the GAWK General Public License for full details.
X
XEveryone is granted permission to copy, modify and redistribute GAWK,
Xbut only under the conditions described in the GAWK General Public
XLicense.  A copy of this license is supposed to have been given to you
Xalong with GAWK so you can know your rights and responsibilities.  It
Xshould be in a file named COPYING.  Among other things, the copyright
Xnotice and this notice must be preserved on all copies.
X
XIn other words, go ahead and share GAWK, but don't try to stop
Xanyone else from sharing it farther.  Help stamp out software hoarding!
X*/
X
X#define AWKNUM`009float
X
X#include <ctype.h>
X#define is_identchar(c) (isalnum(c) `124`124 (c) == '_')
X
X#include "obstack.h"
X#define obstack_chunk_alloc malloc
X#define obstack_chunk_free free
X#ifdef VMS`009`009/* Needed for VAX C 2.2, but not 2.3... */
X#define exit(x) vms_exit(x)
X#endif
X
Xchar *malloc(),*realloc();
Xvoid free();
X
Xtypedef enum `123
X  /* illegal entry == 0 */`032
X  Node_illegal,`009`009/* 0 */
X
X  /* binary operators  lnode and rnode are the expressions to work on */
X  Node_times,`009`009/* 1 */
X  Node_quotient,`009/* 2 */
X  Node_mod,`009`009/* 3 */
X  Node_plus,`009`009/* 4 */
X  Node_minus,`009`009/* 5 */
X  Node_cond_pair,`009/* 6: conditional pair (see Node_line_range) jfw */
X  Node_subscript,`009/* 7 */
X  Node_concat,`009`009/* 8 */
X
X  /* unary operators   subnode is the expression to work on */
X  Node_preincrement,`009/* 9 */
X  Node_predecrement,`009/* 10 */
X  Node_postincrement, `009/* 11 */
X  Node_postdecrement,`009/* 12 */
X  Node_unary_minus,`009/* 13 */
X  Node_field_spec,`009/* 14 */
X
X  /* assignments   lnode is the var to assign to, rnode is the exp */
X  Node_assign,`009`009/* 15 */
X  Node_assign_times,`009/* 16 */
X  Node_assign_quotient,`009/* 17 */
X  Node_assign_mod,`009/* 18 */
X  Node_assign_plus,`009/* 19 */
X  Node_assign_minus,`009/* 20 */
X
X  /* boolean binaries   lnode and rnode are expressions */
X  Node_and,`009`009/* 21 */
X  Node_or,`009`009/* 22 */
X
X  /* binary relationals   compares lnode and rnode */
X  Node_equal,`009`009/* 23 */
X  Node_notequal,`009/* 24 */
X  Node_less,`009`009/* 25 */
X  Node_greater,`009`009/* 26 */
X  Node_leq,`009`009/* 27 */
X  Node_geq,`009`009/* 28 */
X
X  /* unary relationals   works on subnode */
X  Node_not,`009`009/* 29 */
X
X  /* match ops (binary)   work on lnode and rnode ??? */
X  Node_match,`009`009/* 30 */
X  Node_nomatch,`009`009/* 31 */
X
X  /* data items */
X  Node_string,`009`009/* 32 has stlen, stptr, and stref */
X  Node_temp_string,`009/* 33 has stlen, stptr, and stref */
X  Node_number,`009`009/* 34 has numbr */
X
X  /* program structures */`032
X  Node_rule_list,`009/* 35 lnode is a rule, rnode is rest of list */
X  Node_rule_node,`009/* 36 lnode is an conditional, rnode is statement */
X  Node_statement_list,`009/* 37 lnode is a statement, rnode is more list */
X  Node_if_branches,`009/* 38 lnode is to run on true, rnode on false */
X  Node_expression_list,`009/* 39 lnode is an exp, rnode is more list */
X
X  /* keywords */`032
X  Node_K_BEGIN,`009`009/* 40 no stuff */
X  Node_K_END,`009`009/* 41 ditto */
X  Node_K_if,`009`009/* 42 lnode is conditonal, rnode is if_branches */
X  Node_K_while,`009`009/* 43 lnode is condtional, rnode is stuff to run */
X  Node_K_for,`009`009/* 44 lnode is for_struct, rnode is stuff to run */
X  Node_K_arrayfor,`009/* 45 lnode is for_struct, rnode is stuff to run */
X  Node_K_break,`009`009/* 46 no subs */
X  Node_K_continue,`009/* 47 no stuff */
X  Node_K_print,`009`009/* 48 lnode is exp_list, rnode is redirect */
X  Node_K_printf,`009/* 49 lnode is exp_list, rnode is redirect */
X  Node_K_next,`009`009/* 59 no subs */
X  Node_K_exit,`009`009/* 51 subnode is return value, or NULL */
X
X  /* I/O redirection for print statements */
X  Node_redirect_output,`009/* 52 subnode is where to redirect */
X  Node_redirect_append,`009/* 53 subnode is where to redirect */
X  Node_redirect_pipe,`009/* 54 subnode is where to redirect */
X
X  /* Variables */
X  Node_var,`009`009/* 55 rnode is value, lnode is array stuff */
X  Node_var_array,`009/* 56 array is ptr to elements, asize num of eles */
X
X  /* Builtins   subnode is explist to work on, proc is func to call */
X  Node_builtin,`009`009/* 57 */
X
X  /* pattern: conditional ',' conditional ;  lnode of Node_line_range is
X   * the two conditionals (Node_cond_pair), other word (rnode place) is
X   * a flag indicating whether or not this range has been entered.
X   * (jfw@eddie.mit.edu)
X   */
X  Node_line_range,`009/* 58 */
X`125 NODETYPE;
X
Xtypedef struct exp_node `123
X  NODETYPE type;
X  union `123
X  `009struct `123
X`009  `009struct exp_node *lptr;
X`009`009union `123
X`009`009`009struct exp_node *rptr;
X`009`009`009struct exp_node *(* pptr)();
X`009`009`009struct re_pattern_buffer *preg;
X`009`009`009struct for_loop_header *hd;
X`009`009`009struct ahash **av;
X`009`009`009int r_ent;`009/* range entered (jfw) */
X`009`009`125 r;
X`009`125 nodep;
X`009struct `123
X`009`009struct exp_node **ap;
X`009`009int as;
X`009`125 ar;
X`009struct `123
X`009`009char *sp;
X`009`009short slen,sref;
X`009`125 str;
X`009AWKNUM fltnum;
X  `125 sub;
X`125 NODE;
X
X#define lnode`009sub.nodep.lptr
X#define rnode`009sub.nodep.r.rptr
X
X#define subnode`009lnode
X#define proc`009sub.nodep.r.pptr
X
X#define reexp`009lnode
X#define rereg`009sub.nodep.r.preg
X
X#define forsub`009lnode
X#define forloop`009sub.nodep.r.hd
X
X#define array`009sub.ar.ap
X#define arrsiz`009sub.ar.as
X
X#define stptr`009sub.str.sp
X#define stlen`009sub.str.slen
X#define stref`009sub.str.sref
X
X#define numbr`009sub.fltnum
X
X#define var_value lnode
X#define var_array sub.nodep.r.av
X
X#define condpair lnode
X#define triggered sub.nodep.r.r_ent
X
XNODE *newnode(), *dupnode();
XNODE *node(), *snode(), *make_number(), *make_string();
XNODE *mkrangenode();`009/* to remove the temptation to use sub.nodep.r.rptr
X`009`009`009 * as a boolean flag, or to call node() with a 0 and
X`009`009`009 * hope that it will store correctly as an int. (jfw)
X`009`009`009 */
XNODE *tmp_string(),*tmp_number();
XNODE *variable(), *append_right();
X
XNODE *tree_eval();
X
Xstruct re_pattern_buffer *make_regexp();
X
Xextern NODE *Nnull_string;
X
X#ifdef FAST
Xdouble atof();
XNODE *strforce();
V#define force_number(x)`009`009((x)->type==Node_number ? (x)->numbr : atof((x)-
X>stptr))
X#define force_string(x)`009`009((x)->type==Node_number ? (strforce(x)) : (x))
V#define tmp_node(ty)`009`009(global_tmp=(NODE *)obstack_alloc(&temp_strings,siz
Xeof(NODE)),global_tmp->type=ty)
V#define tmp_number(n)`009`009(tmp_node(Node_number),global_tmp->numbr=(n),globa
Xl_tmp)
V/* #define tmp_string(s,len)`009(tmp_node(Node_temp_string),global_tmp->stref=1
V,global_tmp->stlen=len,global_tmp->stptr=(char *)obstack_alloc(&temp_strings,le
Xn+1),bcopy(s,global_tmp->stptr,len),global_tmp->stptr[len]='\0',global_tmp) */
XNODE *global_tmp;
X#else
XAWKNUM`009force_number();
XNODE`009*force_string();
X#endif
X
XNODE *expression_value;
X
X#define HASHSIZE 101
X
Xtypedef struct hashnode HASHNODE;
Xstruct hashnode `123
X  HASHNODE *next;
X  char *name;
X  int length;
X  NODE *value;
X`125 *variables[HASHSIZE];
X
X
Xtypedef struct ahash AHASH;
Xstruct ahash `123
X`009AHASH *next;
X`009NODE`009*name,
X`009`009*symbol,
X`009`009*value;
X`125;
X
X
Xtypedef struct for_loop_header `123
X  NODE *init;
X  NODE *cond;
X  NODE *incr;
X`125 FOR_LOOP_HEADER;
X
XFOR_LOOP_HEADER *make_for_loop();
X
X#define ADD_ONE_REFERENCE(s) ++(s)->stref
X#define FREE_ONE_REFERENCE(s) `123\
X  if(s==Nnull_string) `123\
X    fprintf(stderr,"Free_Nnull_string %d",(s)->stref);\
X  `125\
X  if (--(s)->stref == 0) `123\
X    free((char *)((s)->stptr));\
X    free((char *)s);\
X  `125\
X`125
V/* #define FREE_ONE_REFERENCE(s) `123if (--(s)->stref == 0) `123printf("FREE %x
X\n",s);free((s)->stptr);free(s);`125`125 */
$ GOSUB UNPACK_FILE
$ FILE_IS = "AWK.H-DIFF"
$ CHECKSUM_IS = 1767329072
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X************
XFile USER:[WARNER.SRC.AWK.ORG]AWK.H;1
X   35   char *malloc(),*realloc();
X******
XFile USER:[WARNER.SRC.AWK]AWK.H;2
X   35   #ifdef VMS`009`009/* Needed for VAX C 2.2, but not 2.3... */
X   36   #define exit(x) vms_exit(x)
X   37   #endif
X   38  `032
X   39   char *malloc(),*realloc();
X************
X
XNumber of difference sections found: 1
XNumber of difference records found: 4
X
XDIFFERENCES /IGNORE=()/MERGED=1/OUTPUT=USER:[WARNER.SRC.AWK.ORG]AWK.H-DIFF;1-
X    USER:[WARNER.SRC.AWK.ORG]AWK.H;1-
X    USER:[WARNER.SRC.AWK]AWK.H;2
$ GOSUB UNPACK_FILE
$ FILE_IS = "AWK.Y"
$ CHECKSUM_IS = 2085441272
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X
X/*
X * gawk -- GNU version of awk
X * Copyright (C) 1986 Free Software Foundation
X *   Written by Paul Rubin, August 1986
X *
X */
X
X/*
XGAWK is distributed in the hope that it will be useful, but WITHOUT ANY
XWARRANTY.  No author or distributor accepts responsibility to anyone
Xfor the consequences of using it or for whether it serves any
Xparticular purpose or works at all, unless he says so in writing.
XRefer to the GAWK General Public License for full details.
X
XEveryone is granted permission to copy, modify and redistribute GAWK,
Xbut only under the conditions described in the GAWK General Public
XLicense.  A copy of this license is supposed to have been given to you
Xalong with GAWK so you can know your rights and responsibilities.  It
Xshould be in a file named COPYING.  Among other things, the copyright
Xnotice and this notice must be preserved on all copies.
X
XIn other words, go ahead and share GAWK, but don't try to stop
Xanyone else from sharing it farther.  Help stamp out software hoarding!
X*/
X
X%`123
X#define YYDEBUG 12
X
X#include <stdio.h>
X#include "awk.h"
X
X  static int yylex ();
X
X
X  /*
X   * The following variable is used for a very sickening thing.
X   * The awk language uses white space as the string concatenation
X   * operator, but having a white space token that would have to appear
X   * everywhere in all the grammar rules would be unbearable.
X   * It turns out we can return CONCAT_OP exactly when there really
X   * is one, just from knowing what kinds of other tokens it can appear
X   * between (namely, constants, variables, or close parentheses).
X   * This is because concatenation has the lowest priority of all
X   * operators.  want_concat_token is used to remember that something
X   * that could be the left side of a concat has just been returned.
X   *
X   * If anyone knows a cleaner way to do this (don't look at the Un*x
X   * code to find one, though), please suggest it.
X   */
X  static int want_concat_token;
X
X  /* Two more horrible kludges.  The same comment applies to these two too */
X  static int want_regexp;`009/* lexical scanning kludge */
X  static int want_redirect;`009/* similarly */
X  int lineno = 1;`009/* JF for error msgs */
X
X/* During parsing of a gawk program, the pointer to the next character
X   is in this variable.  */
X  char *lexptr;`009`009/* JF moved it up here */
X  char *lexptr_begin;`009/* JF for error msgs */
X%`125
X
X%union `123
X  long lval;
X  AWKNUM fval;
X  NODE *nodeval;
X  NODETYPE nodetypeval;
X  char *sval;
X  NODE *(*ptrval)();
X`125
X
X%type <nodeval> exp start program rule pattern conditional
X%type <nodeval>`009action variable redirection expression_list
X%type <nodeval>`009statements statement if_statement
X%type <nodeval> opt_exp v_exp
X%type <nodetypeval> whitespace
X
X%token <sval> NAME REGEXP YSTRING
X%token <lval> ERROR INCDEC
X%token <fval> NUMBER
X%token <nodetypeval> ASSIGNOP RELOP MATCHOP NEWLINE REDIRECT_OP CONCAT_OP
X%token <nodetypeval> LEX_BEGIN LEX_END LEX_IF LEX_ELSE
X%token <nodetypeval> LEX_WHILE LEX_FOR LEX_BREAK LEX_CONTINUE
X%token <nodetypeval> LEX_PRINT LEX_PRINTF LEX_NEXT LEX_EXIT
X%token  LEX_IN
X%token <lval> LEX_AND LEX_OR INCREMENT DECREMENT
X%token <ptrval> LEX_BUILTIN
X
X/* these are just yylval numbers */
X/* %token <lval> CHAR JF this isn't used anymore */
X
X/* Lowest to highest */
X%left LEX_OR
X%left LEX_AND
X%right ASSIGNOP
X%left CONCAT_OP
X%left '+' '-'
X%left '*' '/' '%'
X%right UNARY
X%nonassoc MATCHOP RELOP
X`012
X%%
X
Xstart   :  optional_newlines program
X`009`009`123 expression_value = $2; `125
X`009;
X
X
Xprogram`009: rule
X`009`009`123 $$ = node ($1, Node_rule_list,(NODE *) NULL); `125
X`009`124 program rule
X`009`009/* cons the rule onto the tail of list */
V`009`009`123 $$ = append_right ($1, node($2, Node_rule_list,(NODE *) NULL)); `1
X25
X`009;
X
Xrule`009: pattern action NEWLINE optional_newlines
X`009`009`123 $$ = node ($1, Node_rule_node, $2); `125
X`009;
X
X
Xpattern`009: /* empty */
X`009`009`123 $$ = NULL; `125
X`009`124 conditional
X`009`009`123 $$ = $1; `125
X`009`124 conditional ',' conditional
X`009`009`123 $$ = mkrangenode ( node($1, Node_cond_pair, $3) ); `125 /*jfw*/
X`009;
X
X
Xconditional :
X`009  LEX_BEGIN
X`009`009`123 $$ = node ((NODE *)NULL, Node_K_BEGIN,(NODE *) NULL); `125
X`009`124 LEX_END
X`009`009`123 $$ = node ((NODE *)NULL, Node_K_END,(NODE *) NULL); `125
X`009`124 '!' conditional %prec UNARY
X`009`009`123 $$ = node ($2, Node_not,(NODE *) NULL); `125
X`009`124 conditional LEX_AND conditional
X`009`009`123 $$ = node ($1, Node_and, $3); `125
X`009`124 conditional LEX_OR conditional
X`009`009`123 $$ = node ($1, Node_or, $3); `125
X`009`124 '(' conditional ')'
X`009`009`123
X`009`009  $$ = $2;
X`009`009  want_concat_token = 0;
X`009`009`125
X
X`009/* In these rules, want_regexp tells yylex that the next thing
X`009`009is a regexp so it should read up to the closing slash. */
X
X`009`124 '/'
X`009`009`123 ++want_regexp; `125
X`009   REGEXP '/'
X`009`009`123 want_regexp = 0;
V`009`009  $$ = node (node (make_number ((AWKNUM)0), Node_field_spec, (NODE *)NU
XLL),
X`009`009`009     Node_match, (NODE *)make_regexp ($3));
X`009`009`125
X`009`124 exp MATCHOP '/'
X`009`009 `123 ++want_regexp; `125
X`009   REGEXP '/'
X`009`009 `123 want_regexp = 0;
X`009`009   $$ = node ($1, $2, (NODE *)make_regexp($5));
X`009`009 `125
X`009`124 exp RELOP exp
X`009`009`123 $$ = node ($1, $2, $3); `125
X`009`124 exp`009/* JF */
X`009`009`123 $$ = $1; `125
X`009;
X
X
Xaction`009: /* empty */
X`009`009`123 $$ = NULL; `125
X`009`124`009'`123' whitespace statements '`125'
X`009`009`123 $$ = $3; `125
X`009;
X
X
Xstatements :`009`009`009/* EMPTY */
X`009`009`123 $$ = NULL; `125
X`009`124 statement
X`009`009`123 $$ = node ($1, Node_statement_list, (NODE *)NULL); `125
X`009`124 statements statement
V`009`009`123 $$ = append_right($1, node( $2, Node_statement_list, (NODE *)NULL)
X); `125
X`009;
X
Xstatement_term :
X`009NEWLINE optional_newlines
X`009`009`123 $<nodetypeval>$ = Node_illegal; `125
X`009`124 ';' optional_newlines
X`009`009`123 $<nodetypeval>$ = Node_illegal; `125
X`009;
X
Xwhitespace :
X`009`009/* blank */
X`009`009`123 $$ = Node_illegal; `125
X`009`124  CONCAT_OP
X`009`124 NEWLINE
X`009`124 whitespace CONCAT_OP
X`009`124 whitespace NEWLINE
X`009;
Xstatement :
X`009'`123' whitespace statements '`125' whitespace
X`009`009`123 $$ = $3; `125
X`009`124 if_statement
X`009`009`123 $$ = $1; `125
X`009`124 LEX_WHILE '(' conditional ')' whitespace statement
X`009`009`123 $$ = node ($3, Node_K_while, $6); `125
V`009`124 LEX_FOR '(' opt_exp ';' conditional ';' opt_exp ')' whitespace stateme
Xnt
V`009`009`123 $$ = node ($10, Node_K_for, (NODE *)make_for_loop ($3, $5, $7)); `
X125
X`009`124 LEX_FOR '(' opt_exp ';' ';' opt_exp ')' whitespace statement
V`009`009`123 $$ = node ($9, Node_K_for, (NODE *)make_for_loop ($3, (NODE *)NULL
X, $6)); `125
X`009`124 LEX_FOR '(' NAME CONCAT_OP LEX_IN NAME ')' whitespace statement
V`009`009`123 $$ = node ($9, Node_K_arrayfor, (NODE *)make_for_loop(variable($3)
X, (NODE *)NULL, variable($6))); `125
X`009`124 LEX_BREAK statement_term
X`009   /* for break, maybe we'll have to remember where to break to */
X`009`009`123 $$ = node ((NODE *)NULL, Node_K_break, (NODE *)NULL); `125
X`009`124 LEX_CONTINUE statement_term
X`009   /* similarly */
X`009`009`123 $$ = node ((NODE *)NULL, Node_K_continue, (NODE *)NULL); `125
X`009`124 LEX_PRINT
X`009`009`123 ++want_redirect; `125
X`009    expression_list redirection statement_term
X`009`009`123
X`009`009  want_redirect = 0;
X`009`009  /* $4->lnode = NULL; */
X`009`009  $$ = node ($3, Node_K_print, $4);
X`009`009`125
X`009`124 LEX_PRINTF
X`009`009`123 ++want_redirect; `125
X`009    expression_list redirection statement_term
X`009`009`123
X`009`009  want_redirect = 0;
X`009`009  /* $4->lnode = NULL; */
X`009`009  $$ = node ($3, Node_K_printf, $4);
X`009`009`125
X`009`124 LEX_PRINTF '(' expression_list ')'
X`009`009`123 ++want_redirect;
X`009`009  want_concat_token = 0; `125
X`009    redirection statement_term
X`009`009`123
X`009`009  want_redirect = 0;
X`009`009  $$ = node ($3, Node_K_printf, $6);
X`009`009`125
X`009`124 LEX_NEXT statement_term
X`009`009`123 $$ = node ((NODE *)NULL, Node_K_next, (NODE *)NULL); `125
X`009`124 LEX_EXIT statement_term
X`009`009`123 $$ = node ((NODE *)NULL, Node_K_exit, (NODE *)NULL); `125
X`009`124 LEX_EXIT '(' exp ')' statement_term
X`009`009`123 $$ = node ($3, Node_K_exit, (NODE *)NULL); `125
X`009`124 exp statement_term
X`009`009`123 $$ = $1; `125
X`009;
X
X
Xif_statement:
X`009LEX_IF '(' conditional ')' whitespace statement
X`009`009`123 $$ = node ($3, Node_K_if,
X`009`009`009`009node ($6, Node_if_branches, (NODE *)NULL)); `125
X`009`124 LEX_IF '(' conditional ')' whitespace statement
X`009     LEX_ELSE whitespace statement
X`009`009`123 $$ = node ($3, Node_K_if,
X`009`009`009`009node ($6, Node_if_branches, $9)); `125
X`009;
X
Xoptional_newlines :
X`009  /* empty */
X`009`124 optional_newlines NEWLINE
X`009`009`123 $<nodetypeval>$ = Node_illegal; `125
X`009;
X
Xredirection :
X`009  /* empty */
X`009`009`123 $$ = NULL; /* node (NULL, Node_redirect_nil, NULL); */ `125
X`009/* `124 REDIRECT_OP NAME
X`009`009`123 $$ = node ($2, $1, NULL); `125 */
X`009`124 REDIRECT_OP exp
X`009`009`123 $$ = node ($2, $1, (NODE *)NULL); `125
X`009;
X
X
X/* optional expression, as in for loop */
Xopt_exp :
X`009`009`123 $$ = NULL; /* node(NULL, Node_builtin, NULL); */ `125
X`009`124 exp
X`009`009`123 $$ = $1; `125
X`009;
X
Xexpression_list :
X`009  /* empty */
X`009`009`123 $$ = NULL; `125
X`009`124 exp
X`009`009`123 $$ = node ($1, Node_expression_list, (NODE *)NULL); `125
X`009`124 expression_list ',' exp
V`009`009`123 $$ = append_right($1, node( $3, Node_expression_list, (NODE *)NULL
X)); `125
X`009;
X
X
X/* Expressions, not including the comma operator.  */
Xexp`009:`009LEX_BUILTIN '(' expression_list ')'
X`009`009`009`123 $$ = snode ($3, Node_builtin, $1); `125
X`009`124`009LEX_BUILTIN
X`009`009`009`123 $$ = snode ((NODE *)NULL, Node_builtin, $1); `125
X`009`124`009'(' exp ')'
X`009`009`009`123 $$ = $2; `125
X`009`124`009'-' exp    %prec UNARY
X`009`009`009`123 $$ = node ($2, Node_unary_minus, (NODE *)NULL); `125
X`009`124`009INCREMENT variable %prec UNARY
X`009`009`009`123 $$ = node ($2, Node_preincrement, (NODE *)NULL); `125
X`009`124`009DECREMENT variable %prec UNARY
X`009`009`009`123 $$ = node ($2, Node_predecrement, (NODE *)NULL); `125
X`009`124`009variable INCREMENT  %prec UNARY
X`009`009`009`123 $$ = node ($1, Node_postincrement, (NODE *)NULL); `125
X`009`124`009variable DECREMENT  %prec UNARY
X`009`009`009`123 $$ = node ($1, Node_postdecrement, (NODE *)NULL); `125
X`009`124`009variable
X`009`009`009`123 $$ = $1; `125`009/* JF was variable($1) */
X`009`124`009NUMBER
X`009`009`009`123 $$ = make_number ($1); `125
X`009`124`009YSTRING
X`009`009`009`123 $$ = make_string ($1, -1); `125
X
X/* Binary operators in order of decreasing precedence.  */
X`009`124`009exp '*' exp
X`009`009`009`123 $$ = node ($1, Node_times, $3); `125
X`009`124`009exp '/' exp
X`009`009`009`123 $$ = node ($1, Node_quotient, $3); `125
X`009`124`009exp '%' exp
X`009`009`009`123 $$ = node ($1, Node_mod, $3); `125
X`009`124`009exp '+' exp
X`009`009`009`123 $$ = node ($1, Node_plus, $3); `125
X`009`124`009exp '-' exp
X`009`009`009`123 $$ = node ($1, Node_minus, $3); `125
X`009`009/* Empty operator.  See yylex for disgusting details. */
X`009`124`009exp CONCAT_OP exp
X`009`009`009`123 $$ = node ($1, Node_concat, $3); `125
X`009`124`009variable ASSIGNOP exp
X`009`009`009`123 $$ = node ($1, $2, $3); `125
X`009;
X
Xv_exp`009:`009LEX_BUILTIN '(' expression_list ')'
X`009`009`009`123 $$ = snode ($3, Node_builtin, $1); `125
X`009`124`009LEX_BUILTIN
X`009`009`009`123 $$ = snode ((NODE *)NULL, Node_builtin, $1); `125
X`009`124`009'(' exp ')'
X`009`009`009`123 $$ = $2; `125
X`009`124`009'-' exp    %prec UNARY
X`009`009`009`123 $$ = node ($2, Node_unary_minus, (NODE *)NULL); `125
X`009`124`009INCREMENT variable %prec UNARY
X`009`009`009`123 $$ = node ($2, Node_preincrement, (NODE *)NULL); `125
X`009`124`009DECREMENT variable %prec UNARY
X`009`009`009`123 $$ = node ($2, Node_predecrement, (NODE *)NULL); `125
X`009`124`009variable INCREMENT  %prec UNARY
X`009`009`009`123 $$ = node ($1, Node_postincrement, (NODE *)NULL); `125
X`009`124`009variable DECREMENT  %prec UNARY
X`009`009`009`123 $$ = node ($1, Node_postdecrement, (NODE *)NULL); `125
X`009`124`009variable
X`009`009`009`123 $$ = $1; `125`009/* JF was variable($1) */
X`009`124`009NUMBER
X`009`009`009`123 $$ = make_number ($1); `125
X`009`124`009YSTRING
X`009`009`009`123 $$ = make_string ($1, -1); `125
X
X/* Binary operators in order of decreasing precedence.  */
X`009`124`009v_exp '*' exp
X`009`009`009`123 $$ = node ($1, Node_times, $3); `125
X`009`124`009v_exp '/' exp
X`009`009`009`123 $$ = node ($1, Node_quotient, $3); `125
X`009`124`009v_exp '%' exp
X`009`009`009`123 $$ = node ($1, Node_mod, $3); `125
X`009`124`009v_exp '+' exp
X`009`009`009`123 $$ = node ($1, Node_plus, $3); `125
X`009`124`009v_exp '-' exp
X`009`009`009`123 $$ = node ($1, Node_minus, $3); `125
X`009`009/* Empty operator.  See yylex for disgusting details. */
X`009`124`009v_exp CONCAT_OP exp
X`009`009`009`123 $$ = node ($1, Node_concat, $3); `125
X`009;
X
Xvariable :
X`009 `009NAME
X`009`009`009`123 $$ = variable ($1); `125
X`009`124`009NAME '[' exp ']'
X`009`009`009`123 $$ = node (variable($1), Node_subscript, $3); `125
X`009`124`009'$' v_exp`009  %prec UNARY
X`009`009`009`123 $$ = node ($2, Node_field_spec, (NODE *)NULL); `125
X`009;
X
X%%
X`012
X
Xstruct token `123
X  char *operator;
X  NODETYPE value;
X  int class;
X  NODE *(*ptr)();
X`125;
X
X#define NULL 0
X
XNODE`009*do_exp(),`009*do_getline(),`009*do_index(),`009*do_length(),
X`009*do_sqrt(),`009*do_log(),`009*do_sprintf(),`009*do_substr(),
X`009*do_split(),`009*do_int();
X
X`009/* Special functions for debugging */
X#ifndef FAST
XNODE`009*do_prvars(),`009*do_bp();
X#endif
X
X/* Tokentab is sorted ascii ascending order, so it can be binary searched. */
X/* (later.  Right now its just sort of linear search (SLOW!!) */
X
Xstatic struct token tokentab[] = `123
X  `123"BEGIN",`009Node_illegal,`009`009LEX_BEGIN,`0090`125,
X  `123"END",`009Node_illegal,`009`009LEX_END,`0090`125,
X#ifndef FAST
X  `123"bp",`009Node_builtin,`009`009LEX_BUILTIN,`009do_bp`125,
X#endif
X  `123"break",`009Node_K_break,`009`009LEX_BREAK,`0090`125,
X  `123"continue",`009Node_K_continue,`009LEX_CONTINUE,`0090`125,
X  `123"else",`009Node_illegal,`009`009LEX_ELSE,`0090`125,
X  `123"exit",`009Node_K_exit,`009`009LEX_EXIT,`0090`125,
X  `123"exp",`009Node_builtin,`009`009LEX_BUILTIN,`009do_exp`125,
X  `123"for",`009Node_K_for,`009`009LEX_FOR,`0090`125,
X  `123"getline",`009Node_builtin,`009`009LEX_BUILTIN,`009do_getline`125,
X  `123"if",`009Node_K_if,`009`009LEX_IF,`009`0090`125,
X  `123"in",`009Node_illegal,`009`009LEX_IN,`009`0090`125,
X  `123"index",`009Node_builtin,`009`009LEX_BUILTIN,`009do_index`125,
X  `123"int",`009Node_builtin,`009`009LEX_BUILTIN,`009do_int`125,
X  `123"length",`009Node_builtin,`009`009LEX_BUILTIN,`009do_length`125,
X  `123"log",`009Node_builtin,`009`009LEX_BUILTIN,`009do_log`125,
X  `123"next",`009Node_K_next,`009`009LEX_NEXT,`0090`125,
X  `123"print",`009Node_K_print,`009`009LEX_PRINT,`0090`125,
X  `123"printf",`009Node_K_printf,`009`009LEX_PRINTF,`0090`125,
X#ifndef FAST
X  `123"prvars",`009Node_builtin,`009`009LEX_BUILTIN,`009do_prvars`125,
X#endif
X  `123"split",`009Node_builtin,`009`009LEX_BUILTIN,`009do_split`125,
X  `123"sprintf",`009Node_builtin,`009`009LEX_BUILTIN,`009do_sprintf`125,
X  `123"sqrt",`009Node_builtin,`009`009LEX_BUILTIN,`009do_sqrt`125,
X  `123"substr",`009Node_builtin,`009`009LEX_BUILTIN,`009do_substr`125,
X  `123"while",`009Node_K_while,`009`009LEX_WHILE,`0090`125,
X  `123NULL,`009Node_illegal,`009`009ERROR,`009`0090`125
X`125;
X
X/* Read one token, getting characters through lexptr.  */
X
Xstatic int
Xyylex ()
X`123
X  register int c;
X  register int namelen;
X  register char *tokstart;
X  register struct token *toktab;
X  double atof();`009/* JF know what happens if you forget this? */
X
X
X  static did_newline = 0;`009/* JF the grammar insists that actions end
X  `009`009`009`009   with newlines.  This was easier than hacking
X`009`009`009`009   the grammar. */
X  int do_concat;
X
X  int`009seen_e = 0;`009`009/* These are for numbers */
X  int`009seen_point = 0;
X
X  retry:
X
X  if(!lexptr)
X    return 0;
X
X  if (want_regexp) `123
X    want_regexp = 0;
X    /* there is a potential bug if a regexp is followed by an equal sign:
X       "/foo/=bar" would result in assign_quotient being returned as the
X       next token.  Nothing is done about it since it is not valid awk,
X       but maybe something should be done anyway. */
X
X    tokstart = lexptr;
X    while (c = *lexptr++) `123
X      switch (c) `123
X      case '\\':
X`009if (*lexptr++ == '\0') `123
X`009  yyerror ("unterminated regexp ends with \\");
X`009  return ERROR;
X`009`125
X`009break;
X      case '/':`009`009`009/* end of the regexp */
X`009lexptr--;
X`009yylval.sval = tokstart;
X`009return REGEXP;
X      case '\n':
X      case '\0':
X`009yyerror ("unterminated regexp");
X`009return ERROR;
X      `125
X    `125
X  `125
X  do_concat=want_concat_token;
X  want_concat_token=0;
X
X  if(*lexptr=='\0') `123
X    lexptr=0;
X    return NEWLINE;
X  `125
X
X  /* if lexptr is at white space between two terminal tokens or parens,
X     it is a concatenation operator. */
X  if(do_concat && (*lexptr==' ' `124`124 *lexptr=='\t')) `123
X    while (*lexptr == ' ' `124`124 *lexptr == '\t')
X      lexptr++;
X    if (isalnum(*lexptr) `124`124 *lexptr == '\"' `124`124 *lexptr == '('
V        `124`124 *lexptr == '.' `124`124 *lexptr == '$') /* the '.' is for deci
Xmal pt */
X      return CONCAT_OP;
X  `125
X
X  while (*lexptr == ' ' `124`124 *lexptr == '\t')
X    lexptr++;
X
X  tokstart = lexptr;`009/* JF */
X
X  switch (c = *lexptr++) `123
X  case 0:
X    return 0;
X
X  case '\n':
X    lineno++;
X    return NEWLINE;
X
X  case '#':`009`009`009/* it's a comment */
X    while (*lexptr != '\n' && *lexptr != '\0')
X      lexptr++;
X    goto retry;
X
X  case '\\':
X    if(*lexptr=='\n') `123
X      lexptr++;
X      goto retry;
X    `125 else break; `032
X  case ')':
X  case ']':
X    ++want_concat_token;
X    /* fall through */
V  case '(':`009/* JF these were above, but I don't see why they should turn on
X concat. . . &*/
X  case '[':
X
X  case '`123':
X  case ',':`009`009/* JF */
X  case '$':
X  case ';':
X    /* set node type to ILLEGAL because the action should set it to
X       the right thing */
X    yylval.nodetypeval = Node_illegal;
X    return c;
X
X  case '*':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_assign_times;
X      lexptr++;
X      return ASSIGNOP;
X    `125
X    yylval.nodetypeval=Node_illegal;
X    return c;
X
X  case '/':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_assign_quotient;
X      lexptr++;
X      return ASSIGNOP;
X    `125
X    yylval.nodetypeval=Node_illegal;
X    return c;
X
X  case '%':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_assign_mod;
X      lexptr++;
X      return ASSIGNOP;
X    `125
X    yylval.nodetypeval=Node_illegal;
X    return c;
X
X  case '+':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_assign_plus;
X      lexptr++;
X      return ASSIGNOP;
X    `125
X    if(*lexptr=='+') `123
X      yylval.nodetypeval=Node_illegal;
X      lexptr++;
X      return INCREMENT;
X    `125
X    yylval.nodetypeval=Node_illegal;
X    return c;
X
X  case '!':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_notequal;
X      lexptr++;
X      return RELOP;
X    `125
X    if(*lexptr=='`126') `123
X      yylval.nodetypeval=Node_nomatch;
X      lexptr++;
X      return MATCHOP;
X    `125
X    yylval.nodetypeval=Node_illegal;
X    return c;
X
X  case '<':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_leq;
X      lexptr++;
X      return RELOP;
X    `125
X    yylval.nodetypeval=Node_less;
X    return RELOP;
X
X  case '=':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_equal;
X      lexptr++;
X      return RELOP;
X    `125
X    yylval.nodetypeval=Node_assign;
X    return ASSIGNOP;
X
X  case '>':
X    if(want_redirect) `123
X      if (*lexptr == '>') `123
X`009yylval.nodetypeval = Node_redirect_append;
X`009lexptr++;
X      `125 else`032
X        yylval.nodetypeval = Node_redirect_output;
X      return REDIRECT_OP;
X    `125
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_geq;
X      lexptr++;
X      return RELOP;
X    `125
X    yylval.nodetypeval=Node_greater;
X    return RELOP;
X
X  case '`126':
X    yylval.nodetypeval=Node_match;
X    return MATCHOP;
X
V  case '`125':`009`009/* JF added did newline stuff.  Easier than hacking the g
Xrammar */
X    if(did_newline) `123
X      did_newline=0;
X      return c;
X    `125
X    did_newline++;
X    --lexptr;
X    return NEWLINE;
X
X  case '"':
X    while (*lexptr != '\0') `123
X      switch (*lexptr++) `123
X      case '\\':
X`009if (*lexptr++ != '\0')
X`009  break;
X`009/* fall through */
X      case '\n':
X`009yyerror ("unterminated string");
X`009return ERROR;
X      case '\"':
X`009yylval.sval = tokstart + 1;`009/* JF Skip the doublequote */
X`009++want_concat_token;
X`009return YSTRING;
X      `125
X    `125
X    return ERROR;`009/* JF this was one level up, wrong? */
X
X  case '-':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_assign_minus;
X      lexptr++;
X      return ASSIGNOP;
X    `125
X    if(*lexptr=='-') `123
X      yylval.nodetypeval=Node_illegal;
X      lexptr++;
X      return DECREMENT;
X    `125
X    /* JF I think space tab comma and newline are the legal places for
X       a UMINUS.  Have I missed any? */
X    if((!isdigit(*lexptr) && *lexptr!='.') `124`124 (lexptr>lexptr_begin+1 &&
X !index(" \t,\n",lexptr[-2]))) `123
X    /* set node type to ILLEGAL because the action should set it to
X       the right thing */
X      yylval.nodetypeval = Node_illegal;
X      return c;
X    `125
X  `009/* FALL through into number code */
X  case '0':
X  case '1':
X  case '2':
X  case '3':
X  case '4':
X  case '5':
X  case '6':
X  case '7':
X  case '8':
X  case '9':
X  case '.':
X    /* It's a number */
X    if(c=='-') namelen=1;
X    else namelen=0;
X    for (; (c = tokstart[namelen]) != '\0'; namelen++) `123
X      switch (c) `123
X      case '.':
X`009if (seen_point)
X`009  goto got_number;
X`009++seen_point;
X`009break;
X      case 'e':
X      case 'E':
X`009if (seen_e)
X`009  goto got_number;
X`009++seen_e;
X`009if (tokstart[namelen+1] == '-' `124`124 tokstart[namelen+1] == '+')
X`009  namelen++;
X`009break;
X      case '0': case '1': case '2': case '3': case '4':`032
X      case '5': case '6': case '7': case '8': case '9':`032
X`009break;
X      default:
X`009goto got_number;
X      `125
X    `125
X
Xgot_number:
X    lexptr = tokstart + namelen;
X    yylval.fval = atof(tokstart);
X    ++want_concat_token;
X    return NUMBER;
X
X  case '&':
X    if(*lexptr=='&') `123
X      yylval.nodetypeval=Node_and;
X      lexptr++;
X      return LEX_AND;
X    `125
X    return ERROR;
X
X  case '`124':
X    if(want_redirect) `123
X      lexptr++;
X      yylval.nodetypeval = Node_redirect_pipe;
X      return REDIRECT_OP;
X    `125
X    if(*lexptr=='`124') `123
X      yylval.nodetypeval=Node_or;
X      lexptr++;
X      return LEX_OR;
X    `125
X    return ERROR;
X  `125
X `032
X  if (!isalpha(c)) `123
X    yyerror ("Invalid char '%c' in expression\n", c);
X    return ERROR;
X  `125
X
X  /* its some type of name-type-thing.  Find its length */
X  for (namelen = 0; is_identchar(tokstart[namelen]); namelen++)
X    ;
X
X
X  /* See if it is a special token.  */
X  for (toktab = tokentab; toktab->operator != NULL; toktab++) `123
X    if(*tokstart==toktab->operator[0] &&
X       !strncmp(tokstart,toktab->operator,namelen) &&
X       toktab->operator[namelen]=='\0') `123
X      lexptr=tokstart+namelen;
X      if(toktab->class == LEX_BUILTIN)
X        yylval.ptrval = toktab->ptr;
X      else
X        yylval.nodetypeval = toktab->value;
X      return toktab->class;
X    `125
X  `125
X
X  /* It's a name.  See how long it is.  */
X  yylval.sval = tokstart;
X  lexptr = tokstart+namelen;
X  ++want_concat_token;
X  return NAME;
X`125
X
X/*VARARGS1*/
Xyyerror (mesg,a1,a2,a3,a4,a5,a6,a7,a8)
X     char *mesg;
X`123
X  register char *ptr,*beg;
X
X`009/* Find the current line in the input file */
X  if(!lexptr) `123
X    beg="(END OF FILE)";
X    ptr=beg+13;
X  `125 else `123
X    if (*lexptr == '\n' && lexptr!=lexptr_begin)
X      --lexptr;
X    for (beg = lexptr;beg!=lexptr_begin && *beg != '\n';--beg)
X      ;
X    for (ptr = lexptr;*ptr && *ptr != '\n';ptr++) /*jfw: NL isn't guaranteed*/
X      ;
X    if(beg!=lexptr_begin)
X      beg++;
X  `125
X  fprintf (stderr, "Error near line %d,  '%.*s'\n",lineno, ptr-beg, beg);
X  /* figure out line number, etc. later */
X  fprintf (stderr, mesg, a1, a2, a3, a4, a5, a6, a7, a8);
X  fprintf (stderr,"\n");
X  exit (1);
X`125
X
X/* Parse a C escape sequence.  STRING_PTR points to a variable
X   containing a pointer to the string to parse.  That pointer
X   is updated past the characters we use.  The value of the
X   escape sequence is returned.
X
X   A negative value means the sequence \ newline was seen,
X   which is supposed to be equivalent to nothing at all.
X
X   If \ is followed by a null character, we return a negative
X   value and leave the string pointer pointing at the null character.
X
X   If \ is followed by 000, we return 0 and leave the string pointer
X   after the zeros.  A value of 0 does not mean end of string.  */
X
Xstatic int
Xparse_escape (string_ptr)
X     char **string_ptr;
X`123
X  register int c = *(*string_ptr)++;
X  switch (c)
X    `123
X    case 'a':
X      return '\a';
X    case 'b':
X      return '\b';
X    case 'e':
X      return 033;
X    case 'f':
X      return '\f';
X    case 'n':
X      return '\n';
X    case 'r':
X      return '\r';
X    case 't':
X      return '\t';
X    case 'v':
X      return '\v';
X    case '\n':
X      return -2;
X    case 0:
X      (*string_ptr)--;
X      return 0;
X    case '`094':
X      c = *(*string_ptr)++;
X      if (c == '\\')
X`009c = parse_escape (string_ptr);
X      if (c == '?')
X`009return 0177;
X      return (c & 0200) `124 (c & 037);
X     `032
X    case '0':
X    case '1':
X    case '2':
X    case '3':
X    case '4':
X    case '5':
X    case '6':
X    case '7':
X      `123
X`009register int i = c - '0';
X`009register int count = 0;
X`009while (++count < 3)
X`009  `123
X`009    if ((c = *(*string_ptr)++) >= '0' && c <= '7')
X`009      `123
X`009`009i *= 8;
X`009`009i += c - '0';
X`009      `125
X`009    else
X`009      `123
X`009`009(*string_ptr)--;
X`009`009break;
X`009      `125
X`009  `125
X`009return i;
X      `125
X    default:
X      return c;
X    `125
X`125
$ GOSUB UNPACK_FILE
$ FILE_IS = "AWK1.C"
$ CHECKSUM_IS = 560657434
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X * awk1 -- Expression tree constructors and main program for gawk.
X *
X * Copyright (C) 1986 Free Software Foundation
X *   Written by Paul Rubin, August 1986
X *
X */
X
X/*
XGAWK is distributed in the hope that it will be useful, but WITHOUT ANY
XWARRANTY.  No author or distributor accepts responsibility to anyone
Xfor the consequences of using it or for whether it serves any
Xparticular purpose or works at all, unless he says so in writing.
XRefer to the GAWK General Public License for full details.
X
XEveryone is granted permission to copy, modify and redistribute GAWK,
Xbut only under the conditions described in the GAWK General Public
XLicense.  A copy of this license is supposed to have been given to you
Xalong with GAWK so you can know your rights and responsibilities.  It
Xshould be in a file named COPYING.  Among other things, the copyright
Xnotice and this notice must be preserved on all copies.
X
XIn other words, go ahead and share GAWK, but don't try to stop
Xanyone else from sharing it farther.  Help stamp out software hoarding!
X*/
X
X#include <stdio.h>
X#include "regex.h"
X#include "awk.h"
X
X/* Temporary nodes are stored here.  ob_dummy is a dummy object used to
X   keep the obstack library from free()ing up the entire stack.  */
Xstruct obstack temp_strings;
Xchar *ob_dummy;
X
X/* The parse tree and field nodes are stored here.  Parse_end is a dummy
X   item used to free up unneeded fields without freeing the program being run
X */
Xstruct obstack other_stack;
Xchar *parse_end;
X
X/* The global null string */
XNODE *Nnull_string;
X
X/* The special variable that contains the name of the current input file */
Xextern NODE *FILENAME_node;
X
X/* The name the program was invoked under, for error messages */
Xchar *myname;
X
X/* A block of gAWK code to be run before running the program */
XNODE`009*begin_block = 0;
X
X/* A block of gAWK code to be run after the last input file */
XNODE`009*end_block = 0;
X
XFILE *input_file;`009/* Where to read from */
X
X#ifndef FAST
X/* non-zero means in debugging is enabled.  Probably not very useful */
Xint debugging;
X#endif
X
Xchar *index();
X
X
Xmain(argc, argv)
X     int argc;
X     char **argv;
X`123
X  register int i;
X  register NODE *tmp;
X  char`009**do_vars;
X#ifndef FAST
X`009/* Print out the parse tree.   For debugging */
X  register int dotree = 0;
X  extern int yydebug;
X#endif
X  extern char *lexptr;
X  extern char *lexptr_begin;
X  FILE *fp,*fopen();
X
X  --argc;
X  myname= *argv++;
X  if(!argc)
X    usage();
X
X`009/* Tell the regex routines how they should work. . . */
X  re_set_syntax(RE_NO_BK_PARENS`124RE_NO_BK_VBAR);
X
X`009/* Set up the stack for temporary strings */
X  obstack_init (&temp_strings);
X  ob_dummy=obstack_alloc(&temp_strings,0);
X
X    /* Set up the other stack for other things */
X  obstack_init(&other_stack);
X`009/* initialize the null string */
X  Nnull_string = make_string("",0);
X  /* This was to keep Nnull_string from ever being free()d  It didn't work */
X  /* Nnull_string->stref=32000; */
X  `009/* Set up the special variables */
X`009/* Note that this must be done BEFORE arg parsing else -R and -F
X`009   break horribly */
X  init_vars();
X
X
X  for(;*argv && **argv=='-';argc--,argv++) `123
X    switch(argv[0][1]) `123
X#ifndef FAST
X    case 'd':
X      debugging++;
X      dotree++;
X      break;
X
X    case 'D':
X      debugging++;
X      yydebug=2;
X      break;
X#endif
X      /* This feature isn't in un*x awk, but might be useful */
X    case 'R':
X      set_rs(&argv[0][2]);
X      break;
X
X    case 'F':
X      set_fs(&argv[0][2]);
X      break;
X
X
X    `009`009/* It would be better to read the input file in as we parse
X`009`009   it.  Its done this way for hysterical reasons.  Feel
X`009`009   free to fix it. */
X    case 'f':
X      if(lexptr)
X        panic("Can only use one -f option");
X      if((fp=fopen(argv[1],"r"))==NULL)
X`009er_panic(argv[1]);
X      else `123
X        char *curptr;
X`009int siz,nread;
X
X        curptr=lexptr=malloc(2000);
X`009if(curptr==NULL)
X`009`009panic("Memory exhausted");`009/* jfw: instead of abort() */
X`009siz=2000;
X`009i=siz-1;
X`009while((nread=fread(curptr,sizeof(char),i,fp)) > 0) `123
X`009  curptr+=nread;
X`009  i-=nread;
X`009  if(i==0) `123
X`009    lexptr=realloc(lexptr,siz*2);
X`009    if(lexptr==NULL)
X`009    `009panic("Memory exhausted");`009/* jfw: instead of abort() */
X`009    curptr=lexptr+siz-1;
X`009    i=siz;
X`009    siz*=2;
X`009  `125
X`009`125
X`009*curptr='\0';
X`009fclose(fp);
X      `125
X      argc--;
X      argv++;
X      break;
X    case 'v':
X      `123
X        extern char *version_string;
X
X        fprintf(stderr,version_string);
X      `125
X      break;
X
X    case '\0':`009`009/* A file */
X      break;
X
X    default:
X      panic("Unknown option %s",argv[0]);
X    `125
X  `125
X#ifndef FAST
X  if (debugging) setbuf(stdout, 0);`009/* jfw: make debugging easier */
X#endif
X  /* No -f option, use next arg */
X  if(!lexptr) `123
X    if(!argc) usage();
X    lexptr= *argv++;
X    --argc;
X  `125
X
X  /* Read in the program */
X  lexptr_begin=lexptr;
X  (void)yyparse ();
X
X  /* Anything allocated on the other_stack after here will be freed
X     when the next input line is read.
X     */
X  parse_end=obstack_alloc(&other_stack,0);
X
X#ifndef FAST
X  if(dotree)
X    print_parse_tree(expression_value);
X#endif
X  /* Set up the field variables */
X  init_fields();
X
X  /* Look for BEGIN and END blocks.  Only one of each allowed */
X  for(tmp=expression_value;tmp;tmp=tmp->rnode) `123
X    if(!tmp->lnode `124`124 !tmp->lnode->lnode)
X      continue;
X    if(tmp->lnode->lnode->type==Node_K_BEGIN)
X      begin_block=tmp->lnode->rnode;
X    else if(tmp->lnode->lnode->type==Node_K_END)
X      end_block=tmp->lnode->rnode;
X  `125
X  if(begin_block && interpret(begin_block) == 0) exit(0);`009/* jfw */
X  do_vars=argv;
X  while(argc>0 && index(*argv,'=')) `123
X    argv++;
X    --argc;
X  `125
X  if(do_vars==argv) do_vars=0;
X  if(argc==0) `123
X    static char *dumb[2]= `123 "-", 0`125;
X
X    argc=1;
X    argv= &dumb[0];
X  `125
X  while(argc--) `123
X    if(!strcmp(*argv,"-")) `123
X      input_file=stdin;
X      FILENAME_node->var_value=Nnull_string;
X      ADD_ONE_REFERENCE(Nnull_string);
X    `125 else `123
X      extern NODE *deref;
X
X      input_file=fopen(*argv,"r");
X      /* This should print the error message from errno */
X      if(!input_file)
X        er_panic(*argv);
X      /* This is a kludge.  */
X      deref=FILENAME_node->var_value;
X      do_deref();
X      FILENAME_node->var_value=make_string(*argv,strlen(*argv));
X    `125
X    /* This is where it spends all its time.  The infamous MAIN LOOP */
X    if(inrec()==0) `123
X    `009if(do_vars) `123
X`009`009while(do_vars!=argv && *do_vars) `123
X`009`009`009char *cp;
X
X`009`009`009cp=index(*do_vars,'=');
X`009`009`009*cp++='\0';
X`009`009`009variable(*do_vars)->var_value=make_string(cp,strlen(cp));
X`009`009`009do_vars++;
X`009`009`125
X`009`009do_vars=0;
X`009`125
X`009do`032
X          obstack_free(&temp_strings, ob_dummy);
X`009while (interpret(expression_value) && inrec() == 0);
X    `125
X    if(input_file!=stdin) fclose(input_file);
X    argv++;
X  `125
X  if(end_block) (void)interpret(end_block);
X  exit(0);
X`125
X
X/* These exit values are arbitrary */
X/*VARARGS1*/
Xpanic(str,arg)
Xchar *str;
X`123
X`009fprintf(stderr,"%s: ",myname);
X`009fprintf(stderr,str,arg);
X`009fprintf(stderr,"\n");
X`009exit(12);
X`125
X
Xer_panic(str)
Xchar *str;
X`123
X`009fprintf(stderr,"%s: ",myname);
X`009perror(str);
X`009exit(15);
X`125
X
Xusage()
X`123
V`009fprintf(stderr,"%s: usage: %s `123-f progfile `124 program `125 [-F`123c`12
X5 -R`123c`125] file . . .\n",myname,myname);
X`009exit(11);
X`125
X
X`012
X/* This allocates a new node of type ty.  Note that this node will not go
X   away unless freed, so don't use it for tmp storage */
XNODE *
Xnewnode(ty)
XNODETYPE ty;
X`123
X`009register NODE *r;
X
X`009r=(NODE *)malloc(sizeof(NODE));
X`009if(r==NULL)
X`009`009abort();
X`009r->type=ty;
X`009return r;
X`125
X
X
X/* Duplicate a node.  (For global strings, "duplicate" means crank up
X   the reference count.)  This creates global nodes. . .*/
XNODE *
Xdupnode(n)
XNODE *n;
X`123
X`009register NODE *r;
X
X`009if(n->type==Node_string) `123
X`009`009n->stref++;
X`009`009return n;
X`009`125 else if(n->type==Node_temp_string) `123
X`009`009r=newnode(Node_string);
X`009`009r->stlen=n->stlen;
X`009`009r->stref=1;
X`009`009r->stptr=malloc(n->stlen+1);
X`009`009if(r->stptr==NULL)
X`009`009`009abort();
X`009`009bcopy (n->stptr, r->stptr, n->stlen);
X`009`009r->stptr[r->stlen]='\0';`009`009`009/* JF for hackval */
X`009`009return r;
X`009`125 else `123
X`009`009r=newnode(Node_illegal);
X`009`009*r= *n;
X`009`009return r;
X`009`125
X`125
X
X/* This allocates a node with defined lnode and rnode. */
X/* This should only be used by yyparse+co while
X   reading in the program */
XNODE *
Xnode (left, op, right)
X     NODE *left, *right;
X     NODETYPE op;
X`123
X  register NODE *r;
X `032
X  r = (NODE *)obstack_alloc(&other_stack,sizeof(NODE));
X  r->type=op;
X  r->lnode = left;
X  r->rnode = right;
X  return r;
X`125
X
X/* This allocates a node with defined subnode and proc */
X/* Otherwise like node() */
XNODE *
Xsnode(subn, op, procp)
XNODETYPE op;
XNODE *(*procp)();
XNODE *subn;
X`123
X`009register NODE *r;
X
X`009r=(NODE *)obstack_alloc(&other_stack,sizeof(NODE));
X`009r->type=op;
X`009r->subnode=subn;
X`009r->proc=procp;
X`009return r;
X`125
X
X/* (jfw) This allocates a Node_line_range node
X * with defined condpair and zeroes the trigger word
X * to avoid the temptation of assuming that calling
X * 'node( foo, Node_line_range, 0)' will properly initialize 'triggered'.
X */
X/* Otherwise like node() */
XNODE *
Xmkrangenode(cpair)
XNODE *cpair;
X`123
X`009register NODE *r;
X
X`009r=(NODE *)obstack_alloc(&other_stack,sizeof(NODE));
X`009r->type=Node_line_range;
X`009r->condpair=cpair;
X`009r->triggered = 0;
X`009return r;
X`125
X
X/* this allocates a node with defined numbr */
X/* This creates global nodes! */
XNODE *
Xmake_number (x)
X     AWKNUM x;
X`123
X  register NODE *r;
X
X  r=newnode(Node_number);
X  r->numbr = x;
X  return r;
X`125
X
X/* This creates temporary nodes.  They go away quite quicly, so
X   don't use them for anything important */
X#ifndef FAST
XNODE *
Xtmp_number(x)
XAWKNUM`009x;
X`123
X#ifdef DONTDEF
X`009return make_number(x);
X#endif
X`009NODE *r;
X
X`009r=(NODE *)obstack_alloc(&temp_strings,sizeof(NODE));
X`009r->type=Node_number;
X`009r->numbr=x;
X`009return r;
X`125
X#endif
X
X/* Make a string node.  If len==0, the string passed in S is supposed to end
X   with a double quote, but have had the beginning double quote
X   already stripped off by yylex.
X   If LEN!=0, we don't care what s ends with.  This creates a global node */
X
XNODE *
Xmake_string (s,len)
X     char *s;
X`123
X  register NODE *r;
X  register char *pf,*pt;
X  register int`009c;
X
X  /* the aborts are impossible because yylex is supposed to have
X     already checked for unterminated strings */
X  if(len==-1) `123`009`009/* Called from yyparse, find our own len */
X#ifndef FAST
X    if (s[-1] != '\"')`009/* Didn't start with " */
X      abort ();
X#endif
X
X    for(pf = pt = s; *pf != '\0' && *pf!='\"';) `123
X      c= *pf++;
X      switch(c) `123
X#ifndef FAST
X      case '\0':
X`009abort();
X#endif
X
X      case '\\':
X#ifndef FAST
X      `009if(*pf=='\0')
X`009  abort();
X#endif
X
X`009c= *pf++;
X`009switch(c) `123
X`009case '\\':`009/* no massagary needed */
X`009case '\'':
X`009case '\"':
X`009  break;
X`009case '0':
X`009case '1':
X`009case '2':
X`009case '3':
X`009case '4':
X`009case '5':
X`009case '6':
X`009case '7':
X`009case '8':
X`009case '9':
X`009  c-='0';
X`009  while(*pf && *pf>='0' && *pf<='7') `123
X`009    c=c*8+ *pf++ - '0';
X`009  `125
X`009  break;
X`009case 'b':
X`009  c='\b';
X`009  break;
X`009case 'f':
X`009  c='\f';
X`009  break;
X`009case 'n':
X`009  c='\n';
X`009  break;
X`009case 'r':
X`009  c='\r';
X`009  break;
X`009case 't':
X`009  c='\t';
X`009  break;
X`009case 'v':
X`009  c='\v';
X`009  break;
X`009default:
X`009  *pt++='\\';
X`009  break;
X`009`125
X`009/* FALL THROUGH */
X      default:
X`009*pt++=c;
X`009break;
X      `125
X    `125
X#ifndef FAST
X    if(*pf=='\0')
X      abort();`009/* JF hit the end of the buf */
X#endif
X    len = pt - s;`009`009/* JF was p - s - 1 */
X  `125
X
X  r=newnode(Node_string);
X  r->stptr=(char *)malloc(len+1);
X  if(r->stptr==0)
X  `009abort();
X  r->type=Node_string;
X  r->stlen=len;
X  r->stref=1;
X  bcopy (s, r->stptr, len);
X  r->stptr[len]='\0';`009`009/* JF a hack */
X
X  return r;
X`125
X
X/* #ifndef FAST */
X/* This should be a macro for speed, but the C compiler chokes. */
X/* Read the warning under tmp_number */
XNODE *
Xtmp_string(s,len)
Xchar *s;
X`123
X  register NODE *r;
X
X#ifdef DONTDEF
X  return make_string(s,len);
X#endif
X  r=(NODE *)obstack_alloc(&temp_strings,sizeof(NODE));
X  r->stptr=(char *)obstack_alloc(&temp_strings,len+1);
X  r->type=Node_temp_string;
X  r->stlen=len;
X  r->stref=1;
X  bcopy (s, r->stptr, len);
X  r->stptr[len]='\0';`009`009/* JF a hack */
X
X  return r;
X`125
X/* #endif */
X
X/* Generate compiled regular expressions */
Xstruct re_pattern_buffer *
Xmake_regexp (s)
X     char *s;
X`123
X  typedef struct re_pattern_buffer RPAT;
X  RPAT *rp;
X  char *p, *err;
X
X  rp = (RPAT *) obstack_alloc(&other_stack, sizeof (RPAT));
X  bzero((char *)rp,sizeof(RPAT));
X  rp->buffer = (char *)malloc(8);`009/* JF I'd obstack allocate it,
X`009`009`009`009`009   except the regex routines
X`009`009`009`009`009   try to realloc() it, which fails. */
X  /* Note that this means it may never be freed.  Someone fix, please? */
X
X  rp->allocated = 8;
X  rp->fastmap = (char *)obstack_alloc(&other_stack, 256);
X
X  for (p = s; *p != '\0'; p++) `123
X    if (*p == '\\')
X      p++;
X    else if (*p == '/')
X      break;
X  `125
X#ifndef FAST
X  if (*p != '/')
X    abort ();`009`009`009/* impossible */
X#endif
X
X`009/* JF was re_compile_pattern, but that mishandles ( ) and `124,
X`009   so I had to write my own front end.  Sigh. */
X
X  if ((err = re_compile_pattern (s, p - s, rp)) != NULL) `123
X    fprintf (stderr, "illegal regexp: ");
X    yyerror (err);`009`009/* fatal */
X  `125
X
X  return rp;
X`125
X
X/* Build a for loop */
XFOR_LOOP_HEADER *
Xmake_for_loop (init, cond, incr)
X     NODE *init, *cond, *incr;
X`123
X  register FOR_LOOP_HEADER *r;
X `032
X  r = (FOR_LOOP_HEADER *)obstack_alloc(&other_stack,sizeof (FOR_LOOP_HEADER));
X  r->init = init;
X  r->cond = cond;
X  r->incr = incr;
X  return r;
X`125
X
X/* Name points to a variable name.  Make sure its in the symbol table */
XNODE *
Xvariable (name)
X     char *name;
X`123
X  register NODE *r;
X  NODE`009*lookup(), *install();
X
X  if ((r = lookup (variables, name)) == NULL) `123
X    r = install (variables, name, node(Nnull_string, Node_var, (NODE *)NULL));
X    `009`009`009`009`009/* JF  make_number (0.0) is WRONG */
X  `125
X  return r;
X`125
X
X/* Create a special variable */
XNODE *
Xspc_var (name,value)
Xchar *name;
XNODE *value;
X`123
X  register NODE *r;
X  NODE *lookup(), *install();
X
X  if ((r = lookup(variables, name)) == NULL)
X    r = install (variables, name, node(value, Node_var, (NODE *)NULL));
X  return r;
X`125
X
X`012
X/*
X * Install a name in the hash table specified, even if it is already there.
X * Name stops with first non alphanumeric.
X * Caller must check against redefinition if that is desired.
X */
XNODE *
Xinstall (table, name, value)
X     HASHNODE **table;
X     char *name;
X     NODE *value;
X`123
X  register HASHNODE *hp;
X  register int i, len, bucket;
X  register char *p;
X
X  len = 0;
X  p = name;
X  while (is_identchar(*p))
X    p++;
X  len = p - name;
X
X  i = sizeof (HASHNODE) + len + 1;
X  hp = (HASHNODE *)obstack_alloc(&other_stack,i);
X  bucket = hashf(name, len, HASHSIZE);
X  hp->next = table[bucket];
X  table[bucket] = hp;
X  hp->length = len;
X  hp->value = value;
X  hp->name = ((char *) hp) + sizeof (HASHNODE);
X  hp->length = len;
X  bcopy (name, hp->name, len);
X  return hp->value;
X`125
X
X/*
X * find the most recent hash node for name name (ending with first
X * non-identifier char) installed by install
X */
XNODE *
Xlookup (table, name)
X     HASHNODE **table;
X     char *name;
X`123
X  register char *bp;
X  register HASHNODE *bucket;
X  register int len;
X
X  for (bp = name; is_identchar(*bp); bp++)
X    ;
X  len = bp - name;
X  bucket = table[hashf(name, len, HASHSIZE)];
X  while (bucket) `123
X    if (bucket->length == len && strncmp(bucket->name, name, len) == 0)
X      return bucket->value;
X    bucket = bucket->next;
X  `125
X  return NULL;
X`125
X
X#define HASHSTEP(old, c) ((old << 1) + c)
X#define MAKE_POS(v) (v & `1260x80000000) /* make number positive */
X
X/*
X * return hash function on name.  must be compatible with the one
X * computed a step at a time, elsewhere  (JF: Where?  I can't find it!)
X */
Xint
Xhashf(name, len, hashsize)
X     register char *name;
X     register int len;
X     int hashsize;
X`123
X  register int r = 0;
X `032
X  while (len--)
X    r = HASHSTEP(r, *name++);
X `032
X  return MAKE_POS(r) % hashsize;
X`125
X
X/* Add new to the rightmost branch of LIST.  This uses n`0942 time, but
X   doesn't get used enough to make optimizing worth it. . . */
X/* You don't believe me?  Profile it yourself! */
X
XNODE *
Xappend_right(list,new)
XNODE *list,*new;
X`123
X`009register NODE *oldlist;
X
X`009oldlist = list;
X`009while(list->rnode!=NULL)
X`009`009list=list->rnode;
X`009list->rnode = new;
X`009return oldlist;
X`125
$ GOSUB UNPACK_FILE
$ FILE_IS = "AWK2.C"
$ CHECKSUM_IS = 239562495
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X * awk2 --- gawk parse tree interpreter
X *
X * Copyright (C) 1986 Free Software Foundation
X *   Written by Paul Rubin, August 1986
X *
X */
X
X/*
XGAWK is distributed in the hope that it will be useful, but WITHOUT ANY
XWARRANTY.  No author or distributor accepts responsibility to anyone
Xfor the consequences of using it or for whether it serves any
Xparticular purpose or works at all, unless he says so in writing.
XRefer to the GAWK General Public License for full details.
X
XEveryone is granted permission to copy, modify and redistribute GAWK,
Xbut only under the conditions described in the GAWK General Public
XLicense.  A copy of this license is supposed to have been given to you
Xalong with GAWK so you can know your rights and responsibilities.  It
Xshould be in a file named COPYING.  Among other things, the copyright
Xnotice and this notice must be preserved on all copies.
X
XIn other words, go ahead and share GAWK, but don't try to stop
Xanyone else from sharing it farther.  Help stamp out software hoarding!
X*/
X
X#include <setjmp.h>
X#include <stdio.h>
X
X#ifdef SYSV
X/* nasty nasty berkelixm */
X#define _setjmp setjmp
X#define _longjmp longjmp
X#endif
X
X# ifdef VMS
X#define Generic char
X#define _setjmp setjmp
X#define _longjmp longjmp
X# else
X#define Generic void
X# endif
X
X#include "awk.h"
X
XNODE **get_lhs();
X
Xextern NODE dumb[],*OFMT_node;
X/* BEGIN and END blocks need special handling, because we are handed them
X * as raw Node_statement_lists, not as Node_rule_lists (jfw)
X */
Xextern NODE *begin_block, *end_block;
XNODE *do_sprintf();
Xextern struct obstack other_stack;
X
X
X#define min(a,b) ((a) < (b) ? (a) : (b))
X
X/* More of that debugging stuff */
X#ifdef FAST
X#define DEBUG(X)
X#else
X#define DEBUG(X) print_debug X
X#endif
X
X/* longjmp return codes, must be nonzero */
X/* Continue means either for loop/while continue, or next input record */
X#define TAG_CONTINUE 1
X/* Break means either for/while break, or stop reading input */
X#define TAG_BREAK 2
X
X/* the loop_tag_valid variable allows continue/break-out-of-context
X * to be caught and diagnosed (jfw) */
V#define PUSH_BINDING(stack, x) (bcopy ((char *)(x), (char *)(stack), sizeof (jm
Xp_buf)), loop_tag_valid++)
V#define RESTORE_BINDING(stack, x) (bcopy ((char *)(stack), (char *)(x), sizeof
X (jmp_buf)), loop_tag_valid--)
X
X/* for "for(iggy in foo) `123" */
Xstruct search `123
X`009int`009numleft;
X`009AHASH`009**arr_ptr;
X`009AHASH`009*bucket;
X`009NODE`009*symbol;
X`009NODE`009*retval;
X`125;
X
Xstruct search *assoc_scan(),*assoc_next();
X/* Tree is a bunch of rules to run.
X   Returns zero if it hit an exit() statement */
Xinterpret (tree)
X     NODE *tree;
X`123
X  register NODE *t;`009`009`009/* temporary */
X
X  auto jmp_buf loop_tag_stack;`009/* shallow binding stack for loop_tag */
X  static jmp_buf loop_tag;`009/* always the current binding */
X  static int loop_tag_valid = 0;/* nonzero when loop_tag valid (jfw) */
X
X  static jmp_buf rule_tag;`009/* tag the rule currently being run,
X`009`009`009`009   for NEXT and EXIT statements.  It is
X`009`009`009`009   static because there are no nested rules */
X
X  register NODE **lhs;`009/* lhs == Left Hand Side for assigns, etc */
X  register struct search *l;`009/* For array_for */
X
X
X  extern struct obstack temp_strings;
X  extern char *ob_dummy;
X  NODE *do_printf();
X
X  /* clean up temporary strings created by evaluating expressions in
X     previous recursive calls */
X  obstack_free (&temp_strings, ob_dummy);
X
X  if(tree == NULL)
X    return 1;
X  switch (tree->type) `123
X#ifndef FAST
X    /* Can't run these! */
X  case Node_illegal:
X  case Node_rule_node:
X  case Node_if_branches:
X  case Node_expression_list:
X  case Node_K_BEGIN:
X  case Node_K_END:
X  case Node_redirect_output:
X  case Node_redirect_append:
X  case Node_redirect_pipe:
X  case Node_var_array:
X    abort();
X#endif
X
X  case Node_rule_list:
X    for (t = tree; t != NULL; t = t->rnode) `123
X      switch (_setjmp(rule_tag)) `123
X      case 0:`009`009`009/* normal non-jump */
X`009if (eval_condition (t->lnode->lnode)) `123
X`009  DEBUG(("Found a rule",t->lnode->rnode));
X`009  if (t->lnode->rnode == NULL) `123
X`009    /* special case: pattern with no action is equivalent to`032
X`009     * an action of `123print`125 (jfw) */
X`009    NODE printnode;
X`009    printnode.type = Node_K_print;
X`009    printnode.lnode = NULL;
X`009    printnode.rnode = NULL;
X`009    hack_print_node(&printnode);
X`009  `125 else
X`009    (void)interpret (t->lnode->rnode);
X`009`125
X`009break;
X      case TAG_CONTINUE:`009/* NEXT statement */
X`009return 1;
X      case TAG_BREAK:
X        return 0;
X      `125
X    `125
X    break;
X
X  case Node_statement_list:
X    /* print_a_node(tree); */
X    /* because BEGIN and END do not have Node_rule_list nature, yet can
X     * have exits and nexts, we special-case a setjmp of rule_tag here.
X     * (jfw)
X     */
X    if (tree == begin_block `124`124 tree == end_block) `123
X`009switch (_setjmp(rule_tag)) `123
X`009case TAG_CONTINUE:`009/* next */
X`009`009panic("unexpected next");
X`009`009return 1;
X`009case TAG_BREAK:`009`009return 0;
X`009`125
X    `125
X    for (t = tree; t != NULL; t = t->rnode) `123
X      DEBUG(("Statements",t->lnode));
X      (void)interpret (t->lnode);
X    `125
X    break;
X
X  case Node_K_if:
X    DEBUG(("IF",tree->lnode));
X    if (eval_condition(tree->lnode)) `123
X      DEBUG(("True",tree->rnode->lnode));
X      (void)interpret (tree->rnode->lnode);
X    `125 else `123
X      DEBUG(("False",tree->rnode->rnode));
X      (void)interpret (tree->rnode->rnode);
X    `125
X    break;
X
X  case Node_K_while:
X    PUSH_BINDING (loop_tag_stack, loop_tag);
X
X    DEBUG(("WHILE",tree->lnode));
X    while (eval_condition (tree->lnode)) `123
X      switch (_setjmp (loop_tag)) `123
X      case 0:`009`009`009/* normal non-jump */
X        DEBUG(("DO",tree->rnode));
X`009(void)interpret (tree->rnode);
X`009break;
X      case TAG_CONTINUE:`009/* continue statement */
X`009break;
X      case TAG_BREAK:`009`009/* break statement */
X`009RESTORE_BINDING (loop_tag_stack, loop_tag);
X`009return 1;
X#ifndef FAST
X      default:
X`009abort ();`009`009/* never happens */
X#endif
X      `125
X    `125
X    RESTORE_BINDING (loop_tag_stack, loop_tag);
X    break;
X
X  case Node_K_for:
X    PUSH_BINDING (loop_tag_stack, loop_tag);
X
X    DEBUG(("FOR",tree->forloop->init));
X    (void)interpret (tree->forloop->init);
X
X    DEBUG(("FOR.WHILE",tree->forloop->cond));
X    while (eval_condition (tree->forloop->cond)) `123
X      switch (_setjmp (loop_tag)) `123
X      case 0:`009`009`009/* normal non-jump */
X        DEBUG(("FOR.DO",tree->lnode));
X`009(void)interpret (tree->lnode);
X`009/* fall through */
X      case TAG_CONTINUE:`009/* continue statement */
X        DEBUG(("FOR.INCR",tree->forloop->incr));
X`009(void)interpret (tree->forloop->incr);
X`009break;
X      case TAG_BREAK:`009`009/* break statement */
X`009RESTORE_BINDING (loop_tag_stack, loop_tag);
X`009return 1;
X#ifndef FAST
X      default:
X`009abort ();`009`009/* never happens */
X#endif
X      `125
X    `125
X    RESTORE_BINDING (loop_tag_stack, loop_tag);
X    break;
X
X  case Node_K_arrayfor:
X#define hakvar forloop->init
X#define arrvar forloop->incr
X`009PUSH_BINDING(loop_tag_stack, loop_tag);
X`009DEBUG(("AFOR.VAR",tree->hakvar));
X`009lhs=get_lhs(tree->hakvar);
X`009do_deref();
X`009for(l=assoc_scan(tree->arrvar);l;l=assoc_next(l)) `123
X`009`009*lhs=dupnode(l->retval);
X`009`009DEBUG(("AFOR.NEXTIS",*lhs));
X`009`009switch(_setjmp(loop_tag)) `123
X`009`009case 0:
X`009`009`009DEBUG(("AFOR.DO",tree->lnode));
X`009`009`009(void)interpret(tree->lnode);
X`009`009case TAG_CONTINUE:
X`009`009`009break;
X
X`009`009case TAG_BREAK:
X`009`009`009RESTORE_BINDING(loop_tag_stack, loop_tag);
X`009`009`009return 1;
X#ifndef FAST
X`009`009default:
X`009`009`009abort();
X#endif
X`009`009`125
X`009`125
X`009RESTORE_BINDING(loop_tag_stack, loop_tag);
X`009break;
X
X  case Node_K_break:
X    DEBUG(("BREAK",NULL));
X    if (loop_tag_valid == 0)`009/* jfw */
X`009panic("unexpected break or continue");
X    _longjmp (loop_tag, TAG_BREAK);
X    break;
X
X  case Node_K_continue:
X    DEBUG(("CONTINUE",NULL));
X    if (loop_tag_valid == 0)`009/* jfw */
X`009panic("unexpected break or continue");
X    _longjmp (loop_tag, TAG_CONTINUE);
X    break;
X
X  case Node_K_print:
X    DEBUG(("PRINT",tree));
X    (void)hack_print_node (tree);
X    break;
X
X  case Node_K_printf:
X    DEBUG(("PRINTF",tree));
X    (void)do_printf(tree);
X    break;
X
X  case Node_K_next:
X    DEBUG(("NEXT",NULL));
X    _longjmp (rule_tag, TAG_CONTINUE);
X    break;
X
X  case Node_K_exit:
X    /* The unix awk doc says to skip the rest of the input.  Does that
X       mean after performing all the rules on the current line?
X       Unix awk quits immediately, so this does too. */
X    /* The UN*X exit can also take an optional arg return code.  We don't */
X    /* Well, we parse it, but never *DO* it */
X    DEBUG(("EXIT",NULL));
X    _longjmp (rule_tag, TAG_BREAK);
X    break;
X
X  default:
X    /* Appears to be an expression statement.  Throw away the value. */
X    DEBUG(("E",NULL));
X    (void)tree_eval (tree);
X    break;
X  `125
X  return 1;
X`125
X
X/* evaluate a subtree, allocating strings on a temporary stack. */
X/* This used to return a whole NODE, instead of a ptr to one, but that
X   led to lots of obnoxious copying.  I got rid of it (JF) */
XNODE *
Xtree_eval (tree)
X     NODE *tree;
X`123
X  register NODE *r, *t1, *t2;`009`009/* return value and temporary subtrees */
X  register NODE **lhs;
X  static AWKNUM x;`009`009/* Why are these static? */
X  extern struct obstack temp_strings;
X
X  if(tree == NULL) `123
X    DEBUG(("NULL",NULL));
X    return Nnull_string;
X  `125
X  switch (tree->type) `123
X    /* trivial data */
X  case Node_string:
X  case Node_number:
X    DEBUG(("DATA",tree));
X    return tree;
X
X    /* Builtins */
X  case Node_builtin:
X    DEBUG(("builtin",tree));
X    return ((*tree->proc)(tree->subnode));
X
X    /* unary operations */
X
X  case Node_var:
X  case Node_subscript:
X  case Node_field_spec:
X    DEBUG(("var_type ref",tree));
X    lhs=get_lhs(tree);
X    return *lhs;
X
X  case Node_preincrement:
X  case Node_predecrement:
X    DEBUG(("+-X",tree));
X    lhs=get_lhs(tree->subnode);
V    assign_number(lhs,force_number(*lhs) + (tree->type==Node_preincrement ? 1.0
X : -1.0));
X    return *lhs;
X
X  case Node_postincrement:
X  case Node_postdecrement:
X    DEBUG(("X+-",tree));
X    lhs=get_lhs(tree->subnode);
X    x = force_number(*lhs);
X    assign_number (lhs, x + (tree->type==Node_postincrement ? 1.0 : -1.0));
X    return tmp_number(x);
X
X  case Node_unary_minus:
X    DEBUG(("UMINUS",tree));
X    return tmp_number(-force_number(tree_eval(tree->subnode)));
X
X    /* assignments */
X  case Node_assign:
X    DEBUG(("ASSIGN",tree));
X    r = tree_eval (tree->rnode);
X    lhs=get_lhs(tree->lnode);
X    *lhs= dupnode(r);
X    do_deref();
X    /* FOO we have to regenerate $0 here! */
X    if(tree->lnode->type==Node_field_spec)
X      fix_fields();
X    return r;
X    /* other assignment types are easier because they are numeric */
X  case Node_assign_times:
X    r = tree_eval (tree->rnode);
X    lhs=get_lhs(tree->lnode);
X    assign_number(lhs, force_number(*lhs) * force_number(r));
X    do_deref();
X    return *lhs;
X
X  case Node_assign_quotient:
X    r = tree_eval (tree->rnode);
X    lhs=get_lhs(tree->lnode);
X    assign_number(lhs, force_number(*lhs) / force_number(r));
X    do_deref();
X    return *lhs;
X
X  case Node_assign_mod:
X    r = tree_eval (tree->rnode);
X    lhs=get_lhs(tree->lnode);
V    assign_number(lhs, (AWKNUM)(((int) force_number(*lhs)) % ((int) force_numbe
Xr(r))));
X    do_deref();
X    return *lhs;
X
X  case Node_assign_plus:
X    r = tree_eval (tree->rnode);
X    lhs=get_lhs(tree->lnode);
X    assign_number(lhs, force_number(*lhs) + force_number(r));
X    do_deref();
X    return *lhs;
X
X  case Node_assign_minus:
X    r = tree_eval (tree->rnode);
X    lhs=get_lhs(tree->lnode);
X    assign_number(lhs, force_number(*lhs) - force_number(r));
X    do_deref();
X    return *lhs;
X  `125
X  /* Note that if TREE is invalid, gAWK will probably bomb in one of these
X     tree_evals here.  */
X  /* evaluate subtrees in order to do binary operation, then keep going */
X  t1 = tree_eval (tree->lnode);
X  t2 = tree_eval (tree->rnode);
X
X  switch (tree->type) `123
X
X  case Node_concat:
X    t1=force_string(t1);
X    t2=force_string(t2);
X
X    r=(NODE *)obstack_alloc(&temp_strings,sizeof(NODE));
X    r->type=Node_temp_string;
X    r->stlen=t1->stlen+t2->stlen;
X    r->stref=1;
X    r->stptr=(char *)obstack_alloc(&temp_strings,r->stlen+1);
X    bcopy(t1->stptr,r->stptr,t1->stlen);
X    bcopy(t2->stptr,r->stptr+t1->stlen,t2->stlen);
X    r->stptr[r->stlen]='\0';
X    return r;
X
X  case Node_times:
X    return tmp_number(force_number(t1) * force_number(t2));
X
X  case Node_quotient:
X    x=force_number(t2);
X    if(x==(AWKNUM)0) return tmp_number((AWKNUM)0);
X    else return tmp_number(force_number(t1) / x);
X
X  case Node_mod:
X    x=force_number(t2);
X    if(x==(AWKNUM)0) return tmp_number((AWKNUM)0);
X    return tmp_number((AWKNUM)`009/* uggh... */
X      (((int) force_number(t1)) % ((int) x)));
X
X  case Node_plus:
X    return tmp_number(force_number(t1) + force_number(t2));
X
X  case Node_minus:
X    return tmp_number(force_number(t1) - force_number(t2));
X
X#ifndef FAST
X  default:
X    fprintf (stderr, "internal error: illegal numeric operation\n");
X    abort ();
X#endif
X  `125
X  return 0;
X`125
X
X/* We can't dereference a variable until after we've given it its new value.
X   This variable points to the value we have to free up */
XNODE *deref;
X
X/* This returns a POINTER to a node pointer.
X   *get_lhs(ptr) is the current value of the var, or where to store the
X   var's new value */
X
XNODE **
Xget_lhs(ptr)
XNODE *ptr;
X`123
X  register NODE *subexp;
X  register NODE`009**aptr;
X  register int`009num;
X  extern NODE **fields_arr;
X  extern f_arr_siz;
X  NODE **assoc_lookup();
X  extern char f_empty[];`009/* jfw */
X
X#ifndef FAST
X  if(ptr == NULL)
X    abort();
X#endif
X  deref = NULL;
X  switch(ptr->type) `123
X  case Node_var:
X    deref=ptr->var_value;
X    return &(ptr->var_value);
X
X  case Node_field_spec:
X    num=(int)force_number(tree_eval(ptr->lnode));
X    if(num<0) num=0;`009`009/* JF what should I do? */
X    if(num>f_arr_siz)
X      set_field(num,f_empty,0);`009/* jfw: so blank_strings can be simpler */
X    deref = NULL;
X    return &fields_arr[num];
X
X  case Node_subscript:
X    subexp = tree_eval(ptr->rnode);
X    aptr=assoc_lookup(ptr->lnode,subexp);
X    deref= *aptr;
X    return aptr;
X  `125
X#ifndef FAST
X  abort();
X  return 0;
X#endif
X`125
X
Xdo_deref()
X`123
X  if(deref) `123
X    switch(deref->type) `123
X    case Node_string:
X      if(deref!=Nnull_string)
X        FREE_ONE_REFERENCE(deref);
X      break;
X    case Node_number:
X      free((char *)deref);
X      break;
X#ifndef FAST
X    default:
X      abort();
X#endif
X    `125
X    deref = 0;
X  `125
X`125
X
X/* This makes numeric operations slightly more efficient.
X   Just change the value of a numeric node, if possible */
Xassign_number (ptr, value)
XNODE **ptr;
XAWKNUM value;
X`123
X  switch ((*ptr)->type) `123
X  case Node_string:
X    if(*ptr!=Nnull_string)
X      FREE_ONE_REFERENCE (*ptr);
X  case Node_temp_string:`009/* jfw: dont crash if we say $2 += 4 */
X    *ptr=make_number(value);
X    return;
X  case Node_number:
X    (*ptr)->numbr = value;
X    deref=0;
X    break;
X#ifndef FAST
X  default:
X    printf("assign_number nodetype %d\n", (*ptr)->type); /* jfw: add mesg. */
X    abort ();
X#endif
X  `125
X`125
X
X`012
X/* Routines to deal with fields */
X#define ORIG_F`00930
X
XNODE`009**fields_arr;
XNODE`009*fields_nodes;
Xint`009f_arr_siz;
Xchar`009f_empty [] = "";
X
Xinit_fields()
X`123
X`009register NODE **tmp;
X`009register NODE *xtmp;
X
X`009f_arr_siz=ORIG_F;
X`009fields_arr=(NODE **)malloc(ORIG_F * sizeof(NODE *));
X`009fields_nodes=(NODE *)malloc(ORIG_F * sizeof(NODE));
X`009tmp= &fields_arr[f_arr_siz];
X`009xtmp= &fields_nodes[f_arr_siz];
X`009while(--tmp>= &fields_arr[0]) `123
X`009`009--xtmp;
X`009`009*tmp=xtmp;
X`009`009xtmp->type=Node_temp_string;
X`009`009xtmp->stlen=0;
X`009`009xtmp->stref=1;
X`009`009xtmp->stptr=f_empty;
X`009`125
X`125
X
Xblank_fields()
X`123
X`009register NODE **tmp;
X`009extern char *parse_end;
X
X`009tmp= &fields_arr[f_arr_siz];
X`009while(--tmp>= &fields_arr[0]) `123
X`009`009switch(tmp[0]->type) `123
X`009`009case Node_number:
X`009`009`009free((char *)*tmp);
X`009`009`009*tmp= &fields_nodes[tmp-fields_arr];
X`009`009`009break;
X`009`009case Node_string:
X`009`009`009if(*tmp!=Nnull_string)
X`009`009`009`009FREE_ONE_REFERENCE(*tmp);
X`009`009`009*tmp= &fields_nodes[tmp-fields_arr];
X`009`009`009break;
X`009`009case Node_temp_string:
X`009`009`009break;
X#ifndef FAST
X`009`009default:
X`009`009`009abort();
X#endif
X`009`009`125
X`009`009if ((*tmp)->stptr != f_empty) `123`009/* jfw */
X`009`009`009/*Then it was assigned a string with set_field */
X`009`009`009/*out of a private buffer to inrec, so don't free it*/
X`009`009`009(*tmp)->stptr = f_empty;
X`009`009`009(*tmp)->stlen = 0;
X`009`009`009(*tmp)->stref = 1;
X`009`009`125
X`009`009/* *tmp=Nnull_string; */
X`009`125
X`009/* Free the strings */
X`009obstack_free(&other_stack,parse_end);
X`125
X
X/* Danger!  Must only be called for fields we know have just been blanked,
X   or fields we know don't exist yet.  */
Xset_field(n,str,len)
Xchar *str;
X`123
X`009NODE *field_string();
X
X`009if(n>f_arr_siz) `123
X`009`009int t;
X
X`009`009fields_arr=(NODE **)realloc((char *)fields_arr,(n+1)*sizeof(NODE *));
X`009`009fields_nodes=(NODE *)realloc((char *)fields_nodes,(n+1)*sizeof(NODE));
X`009`009for(t=f_arr_siz;t<=n;t++) `123
X`009`009`009fields_arr[t]= &fields_nodes[t];
X`009`009`009fields_nodes[t].type=Node_temp_string;
X`009`009`009fields_nodes[t].stlen=0;
X`009`009`009fields_nodes[t].stref=1;
X`009`009`009fields_nodes[t].stptr=f_empty;
X`009`009`125
X`009`009f_arr_siz=n+1;
X`009`125
X`009fields_nodes[n].stlen=len;
X`009if(n==0) `123
X`009`009fields_nodes[n].stptr=(char*)obstack_alloc(&other_stack,len+1);
X`009`009bcopy(str,fields_nodes[n].stptr,len);
X`009`009fields_nodes[n].stptr[len]='\0';
X`009`125 else `123
X`009`009fields_nodes[n].stptr=str;
X`009`009str[len]='\0';
X`009`125
X`125
X
X#ifdef DONTDEF
X/* Nodes created with this will go away when the next input line is read */
XNODE *
Xfield_string(s,len)
Xchar *s;
X`123
X`009register NODE *r;
X
X`009r=(NODE *)obstack_alloc(&other_stack,sizeof(NODE));
X`009r->type=Node_temp_string;
X`009r->stref=1;
X`009r->stlen=len;
X`009r->stptr=(char*)obstack_alloc(&other_stack,len+1);
X`009bcopy(s,r->stptr,len);
X`009/* r->stptr=s;
X`009r->stptr[len]='\0'; */
X
X`009return r;
X`125
X#endif
X
X/* Someone assigned a value to $(something).  Fix up $0 to be right */
Xfix_fields()
X`123
X`009register int tlen;
X`009register NODE`009*tmp;
X`009NODE`009*ofs;
X`009char`009*ops;
X`009register char`009*cops;
X`009register NODE`009**ptr,**maxp;
X`009extern NODE *OFS_node;
X
X`009maxp=0;
X`009tlen=0;
X`009ofs=force_string(*get_lhs(OFS_node));
X`009ptr= &fields_arr[f_arr_siz];
X`009while(--ptr> &fields_arr[0]) `123
X`009`009tmp=force_string(*ptr);
X`009`009tlen+=tmp->stlen;
X`009`009if(tmp->stlen && !maxp)
X`009`009`009maxp=ptr;
X`009`125
X`009if(!maxp) `123
X`009`009if (fields_arr[0] != fields_nodes)
X`009`009`009FREE_ONE_REFERENCE(fields_arr[0]);
X`009`009fields_arr[0]=Nnull_string;
X`009`009return;
X`009`125
X`009
X`009tlen+=((maxp-fields_arr)-1)*ofs->stlen;
X`009ops=(char *)malloc(tlen+1);
X`009cops=ops;
X`009for(ptr= &fields_arr[1];ptr<=maxp;ptr++) `123
X`009`009tmp=force_string(*ptr);
X`009`009bcopy(tmp->stptr,cops,tmp->stlen);
X`009`009cops+=tmp->stlen;
X`009`009if(ptr!=maxp) `123
X`009`009`009bcopy(ofs->stptr,cops,ofs->stlen);
X`009`009`009cops+=ofs->stlen;
X`009`009`125
X`009`125
X`009tmp=newnode(Node_string);
X`009tmp->stptr=ops;
X`009tmp->stlen=tlen;
X`009tmp->stref=1;
X`009tmp->stptr[tlen]='\0';
X`009/* don't free unless it's new */
X`009if (fields_arr[0] != fields_nodes)
X`009`009FREE_ONE_REFERENCE(fields_arr[0]);
X`009fields_arr[0]=tmp;
X`125
X
X`012
X/* Is TREE true or false?  Returns 0==false, non-zero==true */
Xint
Xeval_condition (tree)
XNODE *tree;
X`123
X  register int`009di;
X  register NODE`009*t1,*t2;
X
X  if(tree==NULL)`009/* Null trees are the easiest kinds */
X    return 1;
X  switch (tree->type) `123
X    /* Maybe it's easy; check and see. */
X    /* BEGIN and END are always false */
X  case Node_K_BEGIN:
X    return 0;
X    break;
X
X  case Node_K_END:
X    return 0;
X    break;
X
X  case Node_and:
X    return eval_condition (tree->lnode)
X      && eval_condition (tree->rnode);
X
X  case Node_or:
X    return eval_condition (tree->lnode)
X      `124`124 eval_condition (tree->rnode);
X   `032
X  case Node_not:
X    return !eval_condition (tree->lnode);
X
X  /* Node_line_range is kind of like Node_match, EXCEPT:
X   * the lnode field (more properly, the condpair field) is a node of
X   * a Node_cond_pair; whether we evaluate the lnode of that node or the
X   * rnode depends on the triggered word.  More precisely:  if we are not
X   * yet triggered, we tree_eval the lnode; if that returns true, we set
X   * the triggered word.  If we are triggered (not ELSE IF, note), we
X   * tree_eval the rnode, clear triggered if it succeeds, and perform our
X   * action (regardless of success or failure).  We want to be able to
X   * begin and end on a single input record, so this isn't an ELSE IF, as
X   * noted above.
X   * This feature was implemented by John Woods, jfw@eddie.mit.edu, during
X   * a rainy weekend.
X   */
X  case Node_line_range:
X`009if (!tree->triggered)
X`009    if (!eval_condition(tree->condpair->lnode))
X`009`009return 0;
X`009    else
X`009`009tree->triggered = 1;
X`009/* Else we are triggered */
X`009if (eval_condition(tree->condpair->rnode))
X`009    tree->triggered = 0;
X`009return 1;
X  `125
X
X  /* Could just be J.random expression.
X     in which case, null and 0 are false,
X     anything else is true */
X
X  switch(tree->type) `123
X  case Node_match:
X  case Node_nomatch:
X  case Node_equal:
X  case Node_notequal:
X  case Node_less:
X  case Node_greater:
X  case Node_leq:
X  case Node_geq:
X  `009break;
X
X  default:`009/* This is so 'if(iggy)', etc, will work */
X    /* Non-zero and non-empty are true */
X    t1=tree_eval(tree);
X    switch(t1->type) `123
X    case Node_number:
X      return t1->numbr!=0.0;
X    case Node_string:
X    case Node_temp_string:
X      return t1->stlen!=0;
X#ifndef FAST
X    default:
X      abort();
X#endif
X    `125
X  `125
X  /* couldn't fob it off recursively, eval left subtree and
X     see if it's a pattern match operation */
X
X  t1 = tree_eval (tree->lnode);
X
X  if (tree->type == Node_match `124`124 tree->type == Node_nomatch) `123
X    t1=force_string(t1);
X    return (re_search (tree->rereg, t1->stptr,
X`009`009      t1->stlen, 0, t1->stlen,
X`009`009      NULL) == -1)
X      `094 (tree->type == Node_match);
X  `125
X
X  /* still no luck--- eval the right subtree and try binary ops */
X
X  t2 = tree_eval (tree->rnode);
X
X  di=cmp_nodes(t1,t2);
X
X  switch (tree->type) `123
X  case Node_equal:
X    return di == 0;
X  case Node_notequal:
X    return di != 0;
X  case Node_less:
X    return di < 0;
X  case Node_greater:
X    return di > 0;
X  case Node_leq:
X    return di <= 0;
X  case Node_geq:
X    return di >= 0;
X#ifndef FAST
X  default:
X    fprintf(stderr,"Panic: unknown conditonal\n");
X    abort ();
X#endif
X  `125
X  return 0;
X`125
X
X/* FOO this doesn't properly compare "12.0" and 12.0 etc */
X/* or "1E1" and 10 etc */
X/* Perhaps someone should fix it.  */
X/* Consider it fixed (jfw) */
X
X/* strtod() would have been better, except (1) real awk is needlessly
X * restrictive in what strings it will consider to be numbers, and
X * (2) I couldn't find the public domain version anywhere handy.
X */
Xis_a_number(str)`009/* does the string str have pure-numeric syntax? */
Xchar *str;`009`009/* don't convert it, assume that atof is better */
X`123
X`009if (*str == 0) return 1; /* null string has numeric value of0 */
X`009`009/* This is still a bug: in real awk, an explicit "" string
X`009`009 * is not treated as a number.  Perhaps it is only variables
X`009`009 * that, when empty, are also 0s.  This bug-lette here at
X`009`009 * least lets uninitialized variables to compare equal to
X`009`009 * zero like they should.
X`009`009 */
X`009if (*str == '-') str++;
X`009if (*str == 0) return 0;
X`009/* must be either . or digits (.4 is legal) */
X`009if (*str != '.' && !isdigit(*str)) return 0;
X`009while (isdigit(*str)) str++;
X`009if (*str == '.') `123
X`009`009str++;
X`009`009while (isdigit(*str)) str++;
X`009`125
X`009/* curiously, real awk DOESN'T consider "1E1" to be equal to 10!
X`009 * Or even equal to 1E1 for that matter!  For a laugh, try:
X`009 * awk 'BEGIN `123if ("1E1" == 1E1) print "eq"; else print "neq";exit`125'
X`009 * Since this behavior is QUITE curious, I include the code for the
X`009 * adventurous.  One might also feel like skipping leading whitespace
X`009 * (awk doesn't) and allowing a leading + (awk doesn't).
X#ifdef Allow_Exponents
X`009if (*str == 'e' `124`124 *str == 'E') `123
X`009`009str++;
X`009`009if (*str == '+' `124`124 *str == '-') str++;
X`009`009if (!isdigit(*str)) return 0;
X`009`009while (isdigit(*str)) str++;
X`009`125
X#endif
X`009/* if we have digested the whole string, we are successful */
X`009return (*str == 0);
X`125
X
Xcmp_nodes(t1,t2)
XNODE *t1,*t2;
X`123
X  register int`009di;
X  register AWKNUM d;
X
X
X  if(t1==t2) `123
X    return 0;
X  `125
X#ifndef FAST
X  if(!t1 `124`124 !t2) `123
X    abort();
X    return t1 ? 1 : -1;
X  `125
X
X#endif
X  if (t1->type == Node_number && t2->type == Node_number) `123
X    d = t1->numbr - t2->numbr;
X    if (d < 0.0)
X      return -1;
X    if (d > 0.0)
X      return 1;
X    return 0;
X  `125
X  t1=force_string(t1);
X  t2=force_string(t2);
X  /* "real" awk treats things as numbers if they both "look" like numbers. */
V  if (*t1->stptr && *t2->stptr`009/* don't allow both to be empty strings(jfw)*
X/
X  &&  is_a_number(t1->stptr) && is_a_number(t2->stptr)) `123
X`009double atof();
X`009d = atof(t1->stptr) - atof(t2->stptr);
X`009if (d < 0.0) return -1;
X`009if (d > 0.0) return 1;
X`009return 0;
X  `125
X  di = strncmp (t1->stptr, t2->stptr, min (t1->stlen, t2->stlen));
X  if (di == 0)
X    di = t1->stlen - t2->stlen;
X  if(di>0) return 1;
X  if(di<0) return -1;
X  return 0;
X`125
X
X
X#ifdef DONTDEF
Xint primes[] = `12331,61,127,257,509,1021,2053,4099,8191,16381`125;
X#endif
X
X/* routines for associative arrays.  SYMBOL is the address of the node
X   (or other pointer) being dereferenced.  SUBS is a number or string
X   used as the subscript. */
X
X/* #define ASSOC_HASHSIZE 1009`009/* prime */
X#define ASSOC_HASHSIZE 29
X#define STIR_BITS(n) ((n) << 5 `124 (((n) >> 27) & 0x1f))
X#define HASHSTEP(old, c) ((old << 1) + c)
X#define MAKE_POS(v) (v & `1260x80000000) /* make number positive */
X
X/* static AHASH *assoc_table[ASSOC_HASHSIZE]; */
X
X
X/* Flush all the values in symbol[] before doing a split() */
Xassoc_clear(symbol)
XNODE`009*symbol;
X`123
X`009int`009i;
X`009AHASH`009*bucket,*next;
X
X`009if(symbol->var_array==0)
X`009`009return;
X`009for(i=0;i<ASSOC_HASHSIZE;i++) `123
X`009`009for(bucket=symbol->var_array[i];bucket;bucket=next) `123
X`009`009`009next=bucket->next;
X`009`009`009deref=bucket->name;
X`009`009`009do_deref();
X`009`009`009deref=bucket->value;
X`009`009`009do_deref();
X`009`009`009free((Generic *)bucket);
X`009`009`125
X`009`009symbol->var_array[i]=0;
X`009`125
X`125
X
X/* Find SYMBOL[SUBS] in the assoc array.  Install it with value "" if it
X   isn't there.  */
X/* Returns a pointer ala get_lhs to where its value is stored */
XNODE **
Xassoc_lookup (symbol, subs)
XNODE`009*symbol,
X`009*subs;
X`123
X  int hash1 = 0, hashf(), i;
X  AHASH *bucket;
X  NODETYPE ty;
X
X  if(subs->type==Node_number) `123
X  `009hash1=(int)subs->numbr;
X`009ty=Node_number;
X  `125 else `123
X    ty=Node_string;
X    subs=force_string(subs);
X    for(i=0;i<subs->stlen;i++)
X      hash1=HASHSTEP(hash1,subs->stptr[i]);
X
X    /* hash1 `094= (int) STIR_BITS((int)symbol); */
X  `125
X  hash1 = MAKE_POS(STIR_BITS((int)hash1)) % ASSOC_HASHSIZE;
X
X`009`009`009`009/* this table really should grow dynamically */
X  if(symbol->var_array==0) `123
X    symbol->var_array=(AHASH **)malloc(sizeof(AHASH *)*ASSOC_HASHSIZE);
X    for(i=0;i<ASSOC_HASHSIZE;i++) `123
X      symbol->var_array[i]=0;
X    `125
X  `125 else `123
X    for (bucket = symbol->var_array[hash1]; bucket; bucket = bucket->next) `123
X      if (bucket->name->type!= ty `124`124 cmp_nodes(bucket->name,subs))
X        continue;
X      return &(bucket->value);
X    `125
X      /* Didn't find it on first pass.  Try again. */
X    for (bucket = symbol->var_array[hash1]; bucket; bucket = bucket->next) `123
X      if (cmp_nodes(bucket->name,subs))
X        continue;
X      return &(bucket->value);
X    `125
X  `125
X  bucket = (AHASH *) malloc(sizeof (AHASH));
X  bucket->symbol = symbol;
X  bucket->name = dupnode(subs);
X  bucket->value = Nnull_string;
X  bucket->next = symbol->var_array[hash1];
X  symbol->var_array[hash1]=bucket;
X  return &(bucket->value);
X`125
X
Xstruct search *
Xassoc_scan(symbol)
XNODE *symbol;
X`123
X`009struct search *lookat;
X
X`009if(!symbol->var_array)
X`009`009return 0;
X`009lookat=(struct search *)obstack_alloc(&other_stack,sizeof(struct search));
X`009/* lookat->symbol=symbol; */
X`009lookat->numleft=ASSOC_HASHSIZE;
X`009lookat->arr_ptr=symbol->var_array;
X`009lookat->bucket=symbol->var_array[0];
X`009return assoc_next(lookat);
X`125
X
Xstruct search *
Xassoc_next(lookat)
Xstruct search *lookat;
X`123
X`009for(;lookat->numleft;lookat->numleft--) `123
X`009`009while(lookat->bucket!=0) `123
X`009`009`009lookat->retval=lookat->bucket->name;
X`009`009`009lookat->bucket=lookat->bucket->next;
X`009`009`009return lookat;
X`009`009`125
X`009`009lookat->bucket= *++(lookat->arr_ptr);
X`009`125
X`009return 0;
X`125
X
X`012
X#ifdef FAST
XNODE *
Xstrforce(n)
XNODE *n;
X`123
X`009extern NODE dumb[],*OFMT_node;
X`009NODE *do_sprintf();
X
X`009dumb[1].lnode=n;
X`009if(OFMT_node->var_value->type!=Node_string)
X`009  panic("Insane value for OFMT detected.");
X`009return do_sprintf(&dumb[0]);
X`125
X
X#else
XAWKNUM
Xforce_number (n)
XNODE *n;
X`123
X  double atof();`009/* Forgetting this is bad */
X
X  if(n==NULL)
X    abort();
X  switch (n->type) `123
X  case Node_number:
X    return n->numbr;
X  case Node_string:
X  case Node_temp_string:
X    return atof(n->stptr);
X  default:
X    abort ();
X  `125
X  return 0.0;
X`125
X
XNODE *
Xforce_string(s)
XNODE *s;
X`123
X  if(s==NULL)
X    abort();
X  switch(s->type) `123
X  case Node_string:
X  case Node_temp_string:
X    return s;
X  case Node_number:
X    if((*get_lhs(OFMT_node))->type!=Node_string)
X      panic("Insane value for OFMT!",0);
X    dumb[1].lnode=s;
X    return do_sprintf(&dumb[0]);
X  default:
X    abort();
X  `125
X  return NULL;
X`125
X#endif
$ GOSUB UNPACK_FILE
$ FILE_IS = "AWK2.C-DIFF"
$ CHECKSUM_IS = 73745698
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X************
XFile USER:[WARNER.SRC.AWK.ORG]AWK2.C;1
X   36   #include "awk.h"
X******
XFile USER:[WARNER.SRC.AWK]AWK2.C;4
X   36   # ifdef VMS
X   37   #define Generic char
X   38   #define _setjmp setjmp
X   39   #define _longjmp longjmp
X   40   # else
X   41   #define Generic void
X   42   # endif
X   43  `032
X   44   #include "awk.h"
X************
X************
XFile USER:[WARNER.SRC.AWK.ORG]AWK2.C;1
X  983   `009`009`009free((void *)bucket);
X  984   `009`009`125
X******
XFile USER:[WARNER.SRC.AWK]AWK2.C;4
X  991   `009`009`009free((Generic *)bucket);
X  992   `009`009`125
X************
X
XNumber of difference sections found: 2
XNumber of difference records found: 9
X
XDIFFERENCES /IGNORE=()/MERGED=1/OUTPUT=USER:[WARNER.SRC.AWK.ORG]AWK2.C-DIFF;1-
X    USER:[WARNER.SRC.AWK.ORG]AWK2.C;1-
X    USER:[WARNER.SRC.AWK]AWK2.C;4
$ GOSUB UNPACK_FILE
$ FILE_IS = "AWK3.C"
$ CHECKSUM_IS = 1164811739
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/* awk3.c -- Builtin functions and various utility procedures
X   Copyright (C) 1986,1987 Free  Software Foundation
X   Written by Jay Fenlason, December 1986
X
X */
X
X/*
XGAWK is distributed in the hope that it will be useful, but WITHOUT ANY
XWARRANTY.  No author or distributor accepts responsibility to anyone
Xfor the consequences of using it or for whether it serves any
Xparticular purpose or works at all, unless he says so in writing.
XRefer to the GAWK General Public License for full details.
X
XEveryone is granted permission to copy, modify and redistribute GAWK,
Xbut only under the conditions described in the GAWK General Public
XLicense.  A copy of this license is supposed to have been given to you
Xalong with GAWK so you can know your rights and responsibilities.  It
Xshould be in a file named COPYING.  Among other things, the copyright
Xnotice and this notice must be preserved on all copies.
X
XIn other words, go ahead and share GAWK, but don't try to stop
Xanyone else from sharing it farther.  Help stamp out software hoarding!
X*/
X#include <stdio.h>
X#include "awk.h"
X
X# include <obstack.h>
X
Xextern struct obstack temp_strings;
X
X/* This node is the cannonical null string, used everywhere */
Xextern NODE *Nnull_string;
X
X/* These nodes store all the special variables gAWK uses */
XNODE`009*FS_node,`009*NF_node,`009*RS_node,`009*NR_node;
XNODE`009*FILENAME_node,`009*OFS_node,`009*ORS_node,`009*OFMT_node;
X
X/* This dumb kludge is used by force_string to turn a floating point
X   number into a string */
XNODE`009dumb[2];
X
XNODE`009**get_lhs();
XFILE`009*deal_redirect();
X
Xstruct redirect `123
X`009int flag;`009`009/* JF was NODETYPE */
X`009NODE`009*value;
X`009FILE`009*fp;
X`125;
Xstruct redirect reds[20];`009/* An arbitrary limit, surely, but there's an
X`009`009`009`009   arbitrary limit on open files, too.  So it
X`009`009`009`009   doesn't make much difference, does it? */
X
X
Xlong NR;
Xint NF;
X
X/* The next #define tells how you find $0.  Its a hack */
Xextern NODE **fields_arr;
X#define WHOLELINE`009fields_arr[0]
X
X/* Set all the special variables to their initial values.  Also sets up
X   the dumb[] array for force_string */
Xinit_vars()
X`123
X`009NODE`009*spc_var();
X`009NODE`009*do_sprintf();
X
X`009FS_node=spc_var("FS",make_string(" ",1));
X`009NF_node=spc_var("NF",make_number(0.0));
X`009RS_node=spc_var("RS",make_string("\n",1));
X`009NR_node=spc_var("NR",make_number(0.0));
V`009FILENAME_node=spc_var("FILENAME",make_string("-",1));`009/* Was Nnull_strin
Xg */
X`009OFS_node=spc_var("OFS",make_string(" ",1));
X`009ORS_node=spc_var("ORS",make_string("\n",1));
X`009OFMT_node=spc_var("OFMT",make_string("%.6g",4));
X
X`009`009/* This ugly hack is used by force_string
X`009`009   to fake a call to sprintf */
X`009dumb[0].type=Node_expression_list;
X`009dumb[0].lnode=OFMT_node;
X`009dumb[0].rnode= &dumb[1];
X`009dumb[1].type=Node_expression_list;
X`009dumb[1].lnode=(NODE *)0;`009`009/* fill in the var here */
X`009dumb[1].rnode=(NODE *)0;
V`009reds[0].flag=0;`009`009`009/* Don't depend on uninit data being zero, altho
Xugh it should be */
X`125
X
X/* OFMT is special because we don't dare use force_string on it for fear of
X   infinite loops.  Thus, if it isn't a string, we return the default "%.6g"
X   This may or may not be the right thing to do, but its the easiest */
X/* This routine isn't used!  It should be.  */
Xchar *get_ofmt()
X`123
X`009register NODE *tmp;
X
X`009tmp= *get_lhs(OFMT_node);
X`009if(tmp->type!=Node_string `124`124 tmp->stlen==0)
X`009`009return "%.6g";
X`009return tmp->stptr;
X`125
X
Xint
Xget_fs()
X`123
X`009register NODE *tmp;
X
X`009tmp=force_string(FS_node->var_value);
X`009if(tmp->stlen==0) return 0;
X`009return *(tmp->stptr);
X`125
X
Xset_fs(str)
Xchar *str;
X`123
X`009register NODE **tmp;
X
X`009tmp= get_lhs(FS_node);
X`009do_deref();
X`009`009/* stupid special case so -F\t works as documented in awk */
X`009`009/* even though the shell hands us -Ft.  Bleah! (jfw) */
X`009if (*str == 't') *str == '\t';
X`009*tmp=make_string(str,1);
X`125
X
Xset_rs(str)
Xchar *str;
X`123
X`009register NODE **tmp;
X
X`009tmp= get_lhs(RS_node);
X`009do_deref();
X`009`009/* stupid special case to be consistent with -F (jfw) */
X`009if (*str == 't') *str == '\t';
X`009*tmp=make_string(str,1);
X`125
X
X
Xint
Xget_rs()
X`123
X`009register NODE *tmp;
X
X`009tmp=force_string(RS_node->var_value);
X`009if(tmp->stlen==0) return 0;
X`009return *(tmp->stptr);
X`125
X
X`012
X/* Builtin functions */
XNODE *
Xdo_exp(tree)
XNODE *tree;
X`123
X`009NODE *tmp;
X`009double exp();
X
X`009get_one(tree,&tmp);
X`009return tmp_number(exp(force_number(tmp)));
X`125
X
X/* JF: I don't know what this should return. */
X/* jfw: 1 if successful or by land, 0 if end of file or by sea */
XNODE *
Xdo_getline(tree)
XNODE *tree;
X`123
X`009if(inrec() == 0)
X`009`009return tmp_number(1.0);
X`009else
X`009`009return tmp_number(0.0);
X`125
X
XNODE *
Xdo_index(tree)
XNODE *tree;
X`123
X`009NODE *s1,*s2;
X`009register char *p1,*p2;
X`009register int l1,l2;
X
X`009get_two(tree,&s1,&s2);
X`009p1=s1->stptr;
X`009p2=s2->stptr;
X`009l1=s1->stlen;
X`009l2=s2->stlen;
X`009while(l1) `123
X`009`009if(!strncmp(p1,p2,l2))
X`009`009`009return tmp_number((AWKNUM)(1+s1->stlen-l1));
X`009`009l1--;
X`009`009p1++;
X`009`125
X`009return tmp_number(0.0);
X`125
X
XNODE *
Xdo_int(tree)
XNODE *tree;
X`123
X`009NODE`009*tmp;
X`009double`009floor();
X
X`009get_one(tree,&tmp);
X`009return tmp_number(floor(force_number(tmp)));
X`125
X
XNODE *
Xdo_length(tree)
XNODE *tree;
X`123
X`009NODE *tmp;
X
X`009get_one(tree,&tmp);
X`009return tmp_number((AWKNUM)(force_string(tmp)->stlen));
X`125
X
XNODE *
Xdo_log(tree)
XNODE *tree;
X`123
X`009NODE`009*tmp;
X`009double log();
X
X`009get_one(tree,&tmp);
X`009return tmp_number(log(force_number(tmp)));
X`125
X
X
XNODE`009*
Xdo_printf(tree)
XNODE *tree;
X`123
X`009register FILE`009*fp;
X`009NODE`009*do_sprintf();
X
X`009fp=deal_redirect(tree->rnode);
X`009print_simple(do_sprintf(tree->lnode),fp);
X`009return Nnull_string;
X`125
X
X
XNODE *
Xdo_split(tree)
XNODE *tree;
X`123
X`009NODE`009*t1,*t2,*t3;
X`009register int`009splitc;
X`009register int`009num,snum,olds;
X`009register char`009*ptr,*oldp;
X`009NODE **assoc_lookup();
X
X`009if(a_get_three(tree,&t1,&t2,&t3)<3)
X`009`009splitc= get_fs();
X`009else
X`009`009splitc= *(force_string(t3)->stptr);
X`009num=0;
X`009tree=force_string(t1);
X`009olds=snum=tree->stlen;
X`009oldp=ptr=tree->stptr;
X`009assoc_clear(t2);
X`009if(splitc==' ') `123
X`009`009while(*ptr==' ' `124`124 *ptr=='\t') `123
X`009`009`009--snum;
X`009`009`009ptr++;
X`009`009`125
X`009`009oldp=ptr;
X`009`009olds=snum;
X`009`125
X`009while(snum--) `123
V`009`009if((splitc==' ' && (*ptr==' ' `124`124 *ptr=='\t')) `124`124 *ptr==spli
Xtc) `123
X`009`009`009ptr++;
V`009`009`009*assoc_lookup(t2,make_number((AWKNUM)(++num)))=make_string(oldp,(ol
Xds-snum)-1);
X`009`009`009if(splitc==' ')
X`009`009`009`009while(*ptr==' ' `124`124 *ptr=='\t') `123
X`009`009`009`009`009ptr++;
X`009`009`009`009`009--snum;
X`009`009`009`009`125
X`009`009`009oldp=ptr;
X`009`009`009olds=snum;
X`009`009`125 else
X`009`009`009ptr++;
X`009`125
V`009*assoc_lookup(t2,make_number((AWKNUM)(++num)))=make_string(oldp,(olds-snum)
X-1);
X`009return tmp_number((AWKNUM)num);
X`125
X
X/* Note that the output buffer cannot be static because sprintf may get called
X   recursively by force_string.  Hence the wasteful alloca calls */
X
X/* %e and %f formats are not properly implemented.  Someone should fix them */
XNODE *
Xdo_sprintf(tree)
XNODE *tree;
X`123
X#define bchunk(s,l) if(l) `123\
X    if((l)>ofre) `123\
X      char *tmp;\
X      tmp=(char *)alloca(osiz*2);\
X      bcopy(obuf,tmp,olen);\
X      obuf=tmp;\
X      ofre+=osiz;\
X      osiz*=2;\
X    `125\
X    bcopy(s,obuf+olen,(l));\
X    olen+=(l);\
X    ofre-=(l);\
X  `125
X
X/* Is there space for something L big in the buffer? */
X#define chksize(l)  if((l)>ofre) `123\
X    char *tmp;\
X    tmp=(char *)alloca(osiz*2);\
X    bcopy(obuf,tmp,olen);\
X    obuf=tmp;\
X    ofre+=osiz;\
X    osiz*=2;\
X  `125
X/* Get the next arg to be formatted.  If we've run out of args, return
X   "" (Null string) */
X#define parse_next_arg() `123\
X  if(!carg) arg= Nnull_string;\
X  else `123\
X  `009get_one(carg,&arg);\
X`009carg=carg->rnode;\
X  `125\
X `125
X
X`009char *obuf;
X`009int osiz,ofre,olen;
X`009static char chbuf[] = "0123456789abcdef";
X`009static char sp[] =" ";
X`009char`009*s0,*s1;
X`009int`009n0;
X`009NODE`009*sfmt,*arg;
X`009register NODE *carg;
X`009long`009fw,prec,lj,alt,big;
X`009long`009*cur;
X`009long`009val;
X`009unsigned long uval;
X`009int`009sgn;
X`009int`009base;
X`009char`009cpbuf[30];`009`009/* if we have numbers bigger than 30 */
X`009char`009*cend= &cpbuf[30];`009/* chars, we lose, but seems unlikely */
X`009char`009*cp;
X`009char`009*fill;
X`009double`009tmpval;
X`009char`009*pr_str;
X`009
X
X`009obuf=(char *)alloca(120);
X`009osiz=120;
X`009ofre=osiz;
X`009olen=0;
X`009get_one(tree,&sfmt);
X`009sfmt=force_string(sfmt);
X`009carg=tree->rnode;
X`009for(s0=s1=sfmt->stptr,n0=sfmt->stlen;n0-->0;) `123
X`009`009if(*s1!='%') `123
X`009`009`009s1++;
X`009`009`009continue;
X`009`009`125
X
X`009`009bchunk(s0,s1-s0);
X`009`009s0=s1;
X`009`009cur= &fw;
X`009`009fw=0;
X`009`009prec=0;
X`009`009lj=alt=big=0;
X`009`009fill= sp;
X`009`009cp=cend;
X`009`009s1++;
X
X`009retry:
X`009`009--n0;
X`009`009switch(*s1++) `123
X`009`009case '%':
X`009`009`009bchunk("%",1);
X`009`009`009s0=s1;
X`009`009`009break;
X
X`009`009case '0':
X`009`009`009if(fill!=sp `124`124 lj) goto lose;
X`009`009`009fill="0";`009`009/* FALL through */
X`009`009case '1':
X`009`009case '2':
X`009`009case '3':
X`009`009case '4':
X`009`009case '5':
X`009`009case '6':
X`009`009case '7':
X`009`009case '8':
X`009`009case '9':
X`009`009`009if(cur==0)
X`009`009`009`009goto lose;
X`009`009`009*cur= s1[-1]-'0';
X`009`009`009while(n0>0 && *s1>='0' && *s1<='9') `123
X`009`009`009`009--n0;
X`009`009`009`009*cur= *cur * 10 + *s1++ - '0';
X`009`009`009`125
X`009`009`009goto retry;
X`009`009case '-':
X`009`009`009if(lj `124`124 fill!=sp) goto lose;
X`009`009`009lj++;
X`009`009`009goto retry;
X`009`009case '.':
X`009`009`009if(cur!=&fw) goto lose;
X`009`009`009cur= &prec;
X`009`009`009goto retry;
X`009`009case '#':
X`009`009`009if(alt) goto lose;
X`009`009`009alt++;
X`009`009`009goto retry;
X`009`009case 'l':
X`009`009`009if(big) goto lose;
X`009`009`009big++;
X`009`009`009goto retry;
X`009`009case '*':
X`009`009`009if(cur==0) goto lose;
X`009`009`009parse_next_arg();
X`009`009`009*cur=(int)arg;
X`009`009`009goto retry;
X`009`009case 'c':
X`009`009`009parse_next_arg();
X`009`009`009if(arg->type==Node_number) `123
X`009`009`009`009uval=(unsigned long)arg->numbr;
X`009`009`009`009cpbuf[0]=uval;
X`009`009`009`009prec=1;
X`009`009`009`009pr_str=cpbuf;
X`009`009`009`009goto dopr_string;
X`009`009`009`125
X`009`009`009if(!prec `124`124 prec>arg->stlen)
X`009`009`009`009prec=arg->stlen;
X`009`009`009pr_str=cpbuf;
X`009`009`009goto dopr_string;
X`009`009case 's':
X`009`009`009parse_next_arg();
X`009`009`009arg=force_string(arg);
X`009`009`009if(!prec `124`124 prec>arg->stlen)
X`009`009`009`009prec=arg->stlen;
X`009`009`009pr_str=arg->stptr;
X
X`009`009dopr_string:
X`009`009`009if(fw>prec && !lj) `123
X`009`009`009`009while(fw>prec) `123
X`009`009`009`009`009bchunk(sp,1);
X`009`009`009`009`009fw--;
X`009`009`009`009`125
X`009`009`009`125
X`009`009`009bchunk(pr_str,(int)prec);
X`009`009`009if(fw>prec) `123
X`009`009`009`009while(fw>prec) `123
X`009`009`009`009`009bchunk(sp,1);
X`009`009`009`009`009fw--;
X`009`009`009`009`125
X`009`009`009`125
X`009`009`009s0=s1;
X`009`009`009break;
X`009`009case 'd':
X`009`009`009parse_next_arg();
X`009`009`009val=(long)force_number(arg);
X`009`009`009if(val<0) `123
X`009`009`009`009sgn=1;
X`009`009`009`009val= -val;
X`009`009`009`125 else sgn=0;
X`009`009`009do `123
X`009`009`009`009*--cp='0'+val%10;
X`009`009`009`009val/=10;
X`009`009`009`125 while (val);
X`009`009`009if(sgn) *--cp='-';
X`009`009`009prec=cend-cp;
X`009`009`009if(fw>prec && !lj) `123
X`009`009`009`009if(fill!=sp && *cp=='-') `123
X`009`009`009`009`009bchunk(cp,1);
X`009`009`009`009`009cp++;
X`009`009`009`009`009prec--;
X`009`009`009`009`009fw--;
X`009`009`009`009`125
X`009`009`009`009while(fw>prec) `123
X`009`009`009`009`009bchunk(fill,1);
X`009`009`009`009`009fw--;
X`009`009`009`009`125
X`009`009`009`125
X`009`009`009bchunk(cp,(int)prec);
X`009`009`009if(fw>prec) `123
X`009`009`009`009while(fw>prec) `123
X`009`009`009`009`009bchunk(fill,1);
X`009`009`009`009`009fw--;
X`009`009`009`009`125
X`009`009`009`125
X`009`009`009s0=s1;
X`009`009`009break;
X`009`009case 'u':
X`009`009`009base=10;
X`009`009`009goto pr_unsigned;
X`009`009case 'o':
X`009`009`009base=8;
X`009`009`009goto pr_unsigned;
X`009`009case 'x':
X`009`009`009base=16;
X`009`009`009goto pr_unsigned;
X`009`009pr_unsigned:
X`009`009`009parse_next_arg();
X`009`009`009uval=(unsigned long)force_number(arg);
X`009`009`009do `123
X`009`009`009`009*--cp=chbuf[uval%base];
X`009`009`009`009uval/=base;
X`009`009`009`125 while(uval);
X`009`009`009prec=cend-cp;
X`009`009`009if(fw>prec && !lj) `123
X`009`009`009`009while(fw>prec) `123
X`009`009`009`009`009bchunk(fill,1);
X`009`009`009`009`009fw--;
X`009`009`009`009`125
X`009`009`009`125
X`009`009`009bchunk(cp,(int)prec);
X`009`009`009if(fw>prec) `123
X`009`009`009`009while(fw>prec) `123
X`009`009`009`009`009bchunk(fill,1);
X`009`009`009`009`009fw--;
X`009`009`009`009`125
X`009`009`009`125
X`009`009`009s0=s1;
X`009`009`009break;
X`009`009case 'g':
X`009`009`009parse_next_arg();
X`009`009`009tmpval=force_number(arg);
X`009`009`009if(prec==0) prec=13;
X`009`009`009else `123
X`009`009`009`009long foo = abs((long)tmpval);
X`009`009`009`009if(prec<9 && foo>99999999)
X`009`009`009`009`009prec=9;
X`009`009`009`009else if(prec<8 && foo>9999999)
X`009`009`009`009`009prec=8;
X`009`009`009`009else if(prec<7 && foo>999999)
X`009`009`009`009`009prec=7;
X`009`009`009`009else if(prec<6 && foo>99999)
X`009`009`009`009`009prec=6;
X`009`009`009`009else if(prec<5 && foo>9999)
X`009`009`009`009`009prec=5;
X`009`009`009`009else if(prec<4 && foo>999)
X`009`009`009`009`009prec=4;
X`009`009`009`009else if(prec<3 && foo>99)
X`009`009`009`009`009prec=3;
X`009`009`009`009else if(prec<2 && foo>9)
X`009`009`009`009`009prec=2;
X`009`009`009`125
X`009`009`009gcvt(tmpval,prec,cpbuf);
X`009`009`009prec=strlen(cpbuf);
X`009`009`009cp=cpbuf;
X`009`009`009if(fw>prec && !lj) `123
X`009`009`009`009if(fill!=sp && *cp=='-') `123
X`009`009`009`009`009bchunk(cp,1);
X`009`009`009`009`009cp++;
X`009`009`009`009`009prec--;
X`009`009`009`009`125`009/* Deal with .5 as 0.5 */
X`009`009`009`009if(fill==sp && *cp=='.') `123
X`009`009`009`009`009--fw;
X`009`009`009`009`009while(--fw>=prec) `123
X`009`009`009`009`009`009bchunk(fill,1);
X`009`009`009`009`009`125
X`009`009`009`009`009bchunk("0",1);
X`009`009`009`009`125 else`032
X`009`009`009`009`009while(fw-->prec) bchunk(fill,1);
X`009`009`009`125 else `123`009`009/* Turn .5 into 0.5 */
X`009`009`009`009`009`009/* FOO */
X`009`009`009`009if(*cp=='.' && fill==sp) `123
X`009`009`009`009`009bchunk("0",1);
X`009`009`009`009`009--fw;
X`009`009`009`009`125
X`009`009`009`125
X`009`009`009bchunk(cp,(int)prec);
X`009`009`009if(fw>prec) while(fw-->prec) bchunk(fill,1);
X`009`009`009s0=s1;
X`009`009`009break;
X`009`009`009/* JF how to handle these!? */
X`009`009case 'f':
X`009`009`009parse_next_arg();
X`009`009`009tmpval=force_number(arg);
X`009`009`009chksize(fw+prec+5);`009/* 5==slop */
X/* cp=fcvt(tmpval,prec,&dec,&sgn);
X   prec=strlen(cp);
X   if(sgn) prec++; */
X`009`009`009cp=cpbuf;
X`009`009`009*cp++='%';
X`009`009`009if(lj) *cp++='-';
X`009`009`009if(fill!=sp) *cp++='0';
X`009`009`009if(prec!=0) `123
X`009`009`009`009strcpy(cp,"*.*f");
X`009`009`009`009sprintf(obuf+olen,cpbuf,fw,prec,(double)tmpval);
X`009`009`009`125 else `123
X`009`009`009`009strcpy(cp,"*f");
X`009`009`009`009sprintf(obuf+olen,cpbuf,fw,(double)tmpval);
X`009`009`009`125
X`009`009`009cp=obuf+olen;
X`009`009`009ofre-=strlen(obuf+olen);
X`009`009`009olen+=strlen(obuf+olen);/* There may be nulls */
X`009`009`009s0=s1;
X`009`009`009break;
X`009`009case 'e':
X`009`009`009parse_next_arg();
X`009`009`009tmpval=force_number(arg);
X`009`009`009chksize(fw+prec+5);`009/* 5==slop */
X`009`009`009cp=cpbuf;
X`009`009`009*cp++='%';
X`009`009`009if(lj) *cp++='-';
X`009`009`009if(fill!=sp) *cp++='0';
X`009`009`009if(prec!=0) `123
X`009`009`009`009strcpy(cp,"*.*e");
X`009`009`009`009sprintf(obuf+olen,cpbuf,fw,prec,(double)tmpval);
X`009`009`009`125 else `123
X`009`009`009`009strcpy(cp,"*e");
X`009`009`009`009sprintf(obuf+olen,cpbuf,fw,(double)tmpval);
X`009`009`009`125
X`009`009`009cp=obuf+olen;
X`009`009`009ofre-=strlen(obuf+olen);
X`009`009`009olen+=strlen(obuf+olen);/* There may be nulls */
X`009`009`009s0=s1;
X`009`009`009break;
X`009`009`009break;
X`009`009/* case 'g':
X`009`009`009parse_next_arg();
X`009`009`009tmpval=force_number(arg);
X`009`009`009if(prec!=0) sprintf(obuf+osiz-ofre,"%*.*g",fw,prec,(double)tmpval);
X`009`009`009else sprintf(obuf+osiz-ofre,"%*g",fw,(double)tmpval);
X`009`009`009ofre-=strlen(obuf+osiz-ofre);
X`009`009`009s0=s1;
X`009`009`009break; */
X`009`009default:
X`009`009lose:
X`009`009`009break;
X`009`009`125
X`009`125
X`009bchunk(s0,s1-s0);
X`009return tmp_string(obuf,olen);
X`125
X
XNODE *
Xdo_sqrt(tree)
XNODE *tree;
X`123
X`009NODE`009*tmp;
X`009double`009sqrt();
X
X`009get_one(tree,&tmp);
X`009return tmp_number(sqrt(force_number(tmp)));
X`125
X
XNODE *
Xdo_substr(tree)
XNODE *tree;
X`123
X`009NODE`009*t1,*t2,*t3;
X`009register int`009n1,n2;
X
X`009if(get_three(tree,&t1,&t2,&t3)<3)
X`009`009n2=32000;
X`009else
X`009`009n2=(int)force_number(t3);
X`009n1=(int)force_number(t2)-1;
X`009tree=force_string(t1);
X`009if(n1<0 `124`124 n1>=tree->stlen `124`124 n2<=0)
X`009`009return Nnull_string;
X`009if(n1+n2>tree->stlen)
X`009`009n2=tree->stlen-n1;
X`009return tmp_string(tree->stptr+n1,n2);
X`125
X
X/* The print command.  Its name is historical */
Xhack_print_node(tree)
XNODE`009*tree;
X`123
X`009register FILE`009*fp;
X
X#ifndef FAST
X`009if(!tree `124`124 tree->type != Node_K_print)
X`009`009abort();
X#endif
X`009fp=deal_redirect(tree->rnode);
X`009tree=tree->lnode;
X`009if(!tree) tree=WHOLELINE;
X`009if(tree->type!=Node_expression_list) `123
X`009`009print_simple(tree,fp);
X`009`125 else `123
X`009`009while(tree) `123
X`009`009`009print_simple(tree_eval(tree->lnode),fp);
X`009`009`009tree=tree->rnode;
X`009`009`009if(tree) print_simple(OFS_node->var_value,fp);
X`009`009`125
X`009`125
X`009print_simple(ORS_node->var_value,fp);
X`125
X
X`012
X/* Get the arguments to functions.  No function cares if you give it
X   too many args (they're ignored).  Only a few fuctions complain
X   about being given too few args.  The rest have defaults */
X
Xget_one(tree,res)
XNODE *tree,**res;
X`123
X`009if(!tree) `123
X`009`009*res= WHOLELINE;
X`009`009return;
X`009`125
X#ifndef FAST
X`009if(tree->type!=Node_expression_list)
X`009`009abort();
X#endif
X`009*res=tree_eval(tree->lnode);
X`125
X
Xget_two(tree,res1,res2)
XNODE *tree,**res1,**res2;
X`123
X`009if(!tree) `123
X`009`009*res1= WHOLELINE;
X`009`009return;
X`009`125
X#ifndef FAST
X`009if(tree->type!=Node_expression_list)
X`009`009abort();
X#endif
X`009*res1=tree_eval(tree->lnode);
X`009if(!tree->rnode)
X`009`009return;
X`009tree=tree->rnode;
X#ifndef FAST
X`009if(tree->type!=Node_expression_list)
X`009`009abort();
X#endif
X`009*res2=tree_eval(tree->lnode);
X`125
X
Xget_three(tree,res1,res2,res3)
XNODE *tree,**res1,**res2,**res3;
X`123
X`009if(!tree) `123
X`009`009*res1= WHOLELINE;
X`009`009return 0;
X`009`125
X#ifndef FAST
X`009if(tree->type!=Node_expression_list)
X`009`009abort();
X#endif
X`009*res1=tree_eval(tree->lnode);
X`009if(!tree->rnode)
X`009`009return 1;
X`009tree=tree->rnode;
X#ifndef FAST
X`009if(tree->type!=Node_expression_list)
X`009`009abort();
X#endif
X`009*res2=tree_eval(tree->lnode);
X`009if(!tree->rnode)
X`009`009return 2;
X`009tree=tree->rnode;
X#ifndef FAST
X`009if(tree->type!=Node_expression_list)
X`009`009abort();
X#endif
X`009*res3=tree_eval(tree->lnode);
X`009return 3;
X`125
X
Xa_get_three(tree,res1,res2,res3)
XNODE *tree,**res1,**res2,**res3;
X`123
X`009if(!tree) `123
X`009`009*res1= WHOLELINE;
X`009`009return 0;
X`009`125
X#ifndef FAST
X`009if(tree->type!=Node_expression_list)
X`009`009abort();
X#endif
X`009*res1=tree_eval(tree->lnode);
X`009if(!tree->rnode)
X`009`009return 1;
X`009tree=tree->rnode;
X#ifndef FAST
X`009if(tree->type!=Node_expression_list)
X`009`009abort();
X#endif
X`009*res2=tree->lnode;
X`009if(!tree->rnode)
X`009`009return 2;
X`009tree=tree->rnode;
X#ifndef FAST
X`009if(tree->type!=Node_expression_list)
X`009`009abort();
X#endif
X`009*res3=tree_eval(tree->lnode);
X`009return 3;
X`125
X
X/* FOO this should re-allocate the buffer if it isn't big enough.
X   Also, it should do RMS style only-parse-enough stuff. */
X/* This reads in a line from the input file */
Xinrec()
X`123
X`009static char *buf,*buf_end;
X`009static bsz;
X`009register char *cur;
X`009register char *tmp;
X`009register char *ttmp;
X`009int cnt;
X`009int tcnt;
X`009register int`009c;
X`009int`009rs;
X`009int`009fs;
X`009extern FILE *input_file;
X`009NODE **get_lhs();
X
X`009rs = get_rs();
X`009fs = get_fs();
X`009blank_fields();
X`009NR++;
X`009NF=0;
X`009if(!buf) `123
X`009`009buf=malloc(128);
X`009`009bsz=128;
X`009`009buf_end=buf+bsz;
X`009`125
X`009cur=buf;
X`009cnt=0;
X`009while ((c=getc(input_file))!=EOF) `123
X`009`009if((!rs && c=='\n' && cur[-1]=='\n' && cur!=buf) `124`124 (c == rs))
X`009`009`009break;
X`009`009*cur++=c;
X`009`009cnt++;
X`009`009if(cur==buf_end) `123
X`009`009`009buf=realloc(buf,bsz*2);
X`009`009`009cur=buf+bsz;
X`009`009`009bsz*=2;
X`009`009`009buf_end=buf+bsz;
X`009`009`125
X`009`125
X`009*cur='\0';
X`009set_field(0,buf,cnt);
X`009assign_number(&(NF_node->var_value),0.0);
X`009if(c==EOF && cnt==0)
X`009`009return 1;
X`009assign_number(&(NR_node->var_value),1.0+force_number(NR_node->var_value));
X`009for(tmp=buf;tmp<cur;tmp++) `123
X`009`009if(fs==' ') `123
X`009`009`009while((*tmp==' ' `124`124 *tmp=='\t') && tmp<cur)
X`009`009`009`009tmp++;
X`009`009`009if(tmp>=cur)
X`009`009`009`009break;
X`009`009`125
X`009`009tcnt=0;
X`009`009ttmp=tmp;
X`009`009if(fs==' ') `123
X`009`009`009while(*tmp!=' ' && *tmp!='\t' && tmp<cur) `123
X`009`009`009`009tmp++;
X`009`009`009`009tcnt++;
X`009`009`009`125
X`009`009`125 else `123
X`009`009`009while(*tmp!=fs && tmp<cur) `123
X`009`009`009`009tmp++;
X`009`009`009`009tcnt++;
X`009`009`009`125
X`009`009`125
X`009`009set_field(++NF,ttmp,tcnt);
X`009`125
X`009assign_number(&(NF_node->var_value),(AWKNUM)NF);
X`009return 0;
X`125
X
X/* Redirection for printf and print commands */
XFILE *
Xdeal_redirect(tree)
XNODE`009*tree;
X`123
X`009register NODE`009*tmp;
X`009register struct redirect *rp;
X`009register char`009*str;
X`009register FILE`009*fp;
X`009FILE`009*popen();
X`009int`009tflag;
X
X
X`009if(!tree) return stdout;
X`009tflag= (tree->type==Node_redirect_pipe) ? 1 : 2;
X`009tmp=tree_eval(tree->subnode);
V`009for(rp=reds;rp->flag!=0 && rp<&reds[20];rp++) `123`009/* That limit again *
X/
X`009`009if(rp->flag==tflag && cmp_nodes(rp->value,tmp)==0)
X`009`009`009break;
X`009`125
X`009if(rp==&reds[20]) `123
X`009`009panic("too many redirections",0);
X`009`009return 0;
X`009`125
X`009if(rp->flag!=0)
X`009`009return rp->fp;
X`009rp->flag=tflag;
X`009rp->value=dupnode(tmp);
X`009str=force_string(tmp)->stptr;
X`009switch(tree->type) `123
X`009case Node_redirect_output:
X`009`009fp=rp->fp=fopen(str,"w");
X`009`009break;
X`009case Node_redirect_append:
X`009`009fp=rp->fp=fopen(str,"a");
X`009`009break;
X`009case Node_redirect_pipe:
X`009`009fp=rp->fp=popen(str,"w");
X`009`009break;
X`009`125
X`009if(fp==0) panic("can't redirect to '%s'\n",str);
X`009rp++;
X`009rp->flag=0;
X`009return fp;
X`125
X
Xprint_simple(tree,fp)
XNODE *tree;
XFILE *fp;
X`123
X#ifndef FAST
X`009/* Deal with some obscure bugs */
X`009if(tree==(NODE *)0x55000000) `123
X`009`009fprintf(fp,"***HUH***");
X`009`009return;
X`009`125
X`009if((int)tree&01) `123
X`009`009fprintf(fp,"$that's odd$");
X`009`009return;
X`009`125
X#endif
X`009tree=force_string(tree);
X`009fwrite(tree->stptr,sizeof(char),tree->stlen,fp);
X`125
X
$ GOSUB UNPACK_FILE
$ FILE_IS = "AWK_TAB.C"
$ CHECKSUM_IS = 478093212
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X
X/*  A Bison parser, made from awk.y  */
X
X#define`009NAME`009258
X#define`009REGEXP`009259
X#define`009YSTRING`009260
X#define`009ERROR`009261
X#define`009INCDEC`009262
X#define`009NUMBER`009263
X#define`009ASSIGNOP`009264
X#define`009RELOP`009265
X#define`009MATCHOP`009266
X#define`009NEWLINE`009267
X#define`009REDIRECT_OP`009268
X#define`009CONCAT_OP`009269
X#define`009LEX_BEGIN`009270
X#define`009LEX_END`009271
X#define`009LEX_IF`009272
X#define`009LEX_ELSE`009273
X#define`009LEX_WHILE`009274
X#define`009LEX_FOR`009275
X#define`009LEX_BREAK`009276
X#define`009LEX_CONTINUE`009277
X#define`009LEX_PRINT`009278
X#define`009LEX_PRINTF`009279
X#define`009LEX_NEXT`009280
X#define`009LEX_EXIT`009281
X#define`009LEX_IN`009282
X#define`009LEX_AND`009283
X#define`009LEX_OR`009284
X#define`009INCREMENT`009285
X#define`009DECREMENT`009286
X#define`009LEX_BUILTIN`009287
X#define`009UNARY`009288
X
X#line 27 "awk.y"
X
X#define YYDEBUG 12
X
X#include <stdio.h>
X#include "awk.h"
X
X  static int yylex ();
X
X
X  /*
X   * The following variable is used for a very sickening thing.
X   * The awk language uses white space as the string concatenation
X   * operator, but having a white space token that would have to appear
X   * everywhere in all the grammar rules would be unbearable.
X   * It turns out we can return CONCAT_OP exactly when there really
X   * is one, just from knowing what kinds of other tokens it can appear
X   * between (namely, constants, variables, or close parentheses).
X   * This is because concatenation has the lowest priority of all
X   * operators.  want_concat_token is used to remember that something
X   * that could be the left side of a concat has just been returned.
X   *
X   * If anyone knows a cleaner way to do this (don't look at the Un*x
X   * code to find one, though), please suggest it.
X   */
X  static int want_concat_token;
X
X  /* Two more horrible kludges.  The same comment applies to these two too */
X  static int want_regexp;`009/* lexical scanning kludge */
X  static int want_redirect;`009/* similarly */
X  int lineno = 1;`009/* JF for error msgs */
X
X/* During parsing of a gawk program, the pointer to the next character
X   is in this variable.  */
X  char *lexptr;`009`009/* JF moved it up here */
X  char *lexptr_begin;`009/* JF for error msgs */
X
X#line 64 "awk.y"
Xtypedef union `123
X  long lval;
X  AWKNUM fval;
X  NODE *nodeval;
X  NODETYPE nodetypeval;
X  char *sval;
X  NODE *(*ptrval)();
X`125 YYSTYPE;
X
X#ifndef YYLTYPE
Xtypedef
X  struct yyltype
X    `123
X      int timestamp;
X      int first_line;
X      int first_column;
X      int last_line;
X      int last_column;
X      char *text;
X   `125
X  yyltype;
X
X#define YYLTYPE yyltype
X#endif
X
X#define`009YYACCEPT`009return(0)
X#define`009YYABORT`009return(1)
X#define`009YYERROR`009return(1)
X#include <stdio.h>
X
X#ifndef __STDC__
X#define const
X#endif
X
X
X
X#define`009YYFINAL`009`009200
X#define`009YYFLAG`009`009-32768
X#define`009YYNTBASE`00949
X
X#define YYTRANSLATE(x) ((unsigned)(x) <= 288 ? yytranslate[x] : 72)
X
Xstatic const char yytranslate[] = `123     0,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,    40,     2,     2,    48,    37,     2,     2,    41,
X    42,    35,    33,    39,    34,     2,    36,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,    45,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X    46,     2,    47,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,    43,     2,    44,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
X     2,     2,     2,     2,     2,     1,     2,     3,     4,     5,
X     6,     7,     8,     9,    10,    11,    12,    13,    14,    15,
X    16,    17,    18,    19,    20,    21,    22,    23,    24,    25,
X    26,    27,    28,    29,    30,    31,    32,    38
X`125;
X
Xstatic const short yyrline[] = `123     0,
X   105,   110,   112,   117,   122,   124,   126,   131,   134,   136,
X   138,   140,   142,   151,   153,   158,   160,   164,   166,   171,
X   173,   178,   180,   182,   186,   189,   193,   196,   197,   198,
X   199,   201,   204,   206,   208,   210,   212,   214,   217,   220,
X   222,   228,   230,   236,   239,   244,   246,   248,   250,   255,
X   259,   265,   267,   271,   276,   282,   284,   288,   291,   293,
X   299,   301,   303,   305,   307,   309,   311,   313,   315,   317,
X   319,   323,   325,   327,   329,   331,   334,   336,   340,   342,
X   344,   346,   348,   350,   352,   354,   356,   358,   360,   364,
X   366,   368,   370,   372,   375,   379,   382,   384
X`125;
X
Xstatic const char * yytname[] = `123     0,
V"error","$illegal.","NAME","REGEXP","YSTRING","ERROR","INCDEC","NUMBER","ASSIGN
XOP","RELOP",
V"MATCHOP","NEWLINE","REDIRECT_OP","CONCAT_OP","LEX_BEGIN","LEX_END","LEX_IF","L
XEX_ELSE","LEX_WHILE","LEX_FOR",
V"LEX_BREAK","LEX_CONTINUE","LEX_PRINT","LEX_PRINTF","LEX_NEXT","LEX_EXIT","LEX_
XIN","LEX_AND","LEX_OR","INCREMENT",
X"DECREMENT","LEX_BUILTIN","'+'","'-'","'*'","'/'","'%'","UNARY","','","'!'",
X"'('","')'","'`123'","'`125'","';'","'['","']'","'$'","start"
X`125;
X
Xstatic const short yyr1[] = `123     0,
X    49,    50,    50,    51,    52,    52,    52,    53,    53,    53,
X    53,    53,    53,    54,    53,    55,    53,    53,    53,    56,
X    56,    57,    57,    57,    58,    58,    59,    59,    59,    59,
X    59,    60,    60,    60,    60,    60,    60,    60,    60,    61,
X    60,    62,    60,    63,    60,    60,    60,    60,    60,    64,
X    64,    65,    65,    66,    66,    67,    67,    68,    68,    68,
X    69,    69,    69,    69,    69,    69,    69,    69,    69,    69,
X    69,    69,    69,    69,    69,    69,    69,    69,    70,    70,
X    70,    70,    70,    70,    70,    70,    70,    70,    70,    70,
X    70,    70,    70,    70,    70,    71,    71,    71
X`125;
X
Xstatic const short yyr2[] = `123     0,
X     2,     1,     2,     4,     0,     1,     3,     1,     1,     2,
X     3,     3,     3,     0,     4,     0,     6,     3,     1,     0,
X     4,     0,     1,     2,     2,     2,     0,     1,     1,     2,
X     2,     5,     1,     6,    10,     9,     9,     2,     2,     0,
X     5,     0,     5,     0,     7,     2,     2,     5,     2,     6,
X     9,     0,     2,     0,     2,     0,     1,     0,     1,     3,
X     4,     1,     3,     2,     2,     2,     2,     2,     1,     1,
X     1,     3,     3,     3,     3,     3,     3,     3,     4,     1,
X     3,     2,     2,     2,     2,     2,     1,     1,     1,     3,
X     3,     3,     3,     3,     3,     1,     4,     2
X`125;
X
Xstatic const short yydefact[] = `123    52,
X     5,    96,    71,    70,    53,     8,     9,     0,     0,    62,
X     0,    14,     0,     0,     0,     5,     2,    20,     6,    19,
X    69,     0,    65,    66,    58,     0,    64,     0,    10,     0,
X    19,    89,    88,     0,     0,    80,     0,     0,    98,    87,
X     3,    27,     0,     0,     0,     0,     0,     0,     0,     0,
X     0,     0,     0,     0,     0,    67,    68,     0,     0,    59,
X     0,     0,    13,    63,    83,    84,    58,    82,     0,     0,
X     0,     0,     0,     0,     0,    85,    86,    29,    28,    22,
X    52,    11,    12,     7,    18,    16,    77,    75,    76,    72,
X    73,    74,    78,    97,     0,    61,    15,     0,    81,    95,
X    93,    94,    90,    91,    92,    31,    30,     0,     0,     0,
X     0,     0,    40,    42,     0,     0,    27,     0,    23,    33,
X     0,     4,     0,    60,    79,     0,     0,    56,    52,    52,
X    38,    39,    58,    58,    58,    46,     0,    47,    22,    21,
X    24,    49,     0,     0,     0,    96,     0,    57,    25,    26,
X    54,     0,    54,     0,     0,    17,    27,    27,     0,     0,
X     0,     0,    44,     0,     0,    27,     0,     0,     0,    56,
X     0,    55,    41,    54,    43,    48,    32,    50,    34,     0,
X     0,    56,     0,    27,    27,    27,     0,    45,     0,     0,
X     0,    27,    51,    37,    36,     0,    35,     0,     0,     0
X`125;
X
Xstatic const short yydefgoto[] = `123   198,
X    16,    17,    18,    19,    28,   123,    43,   118,   131,    80,
X   119,   133,   135,   174,   120,     1,   162,   147,    59,   121,
X    39,    21
X`125;
X
Xstatic const short yypact[] = `123-32768,
X   262,   -29,-32768,-32768,-32768,-32768,-32768,    11,    11,     6,
X   313,-32768,   326,   326,   345,   142,-32768,    17,   243,   399,
X    31,   313,-32768,-32768,   313,   313,-32768,    61,-32768,    35,
X   129,-32768,-32768,    11,    11,    39,   313,   313,-32768,   157,
X-32768,    99,    81,   326,   326,   326,   313,    64,   313,   313,
X   313,   313,   313,   313,   313,-32768,-32768,    72,   -20,   254,
X    87,   105,-32768,-32768,-32768,-32768,   313,-32768,   369,   313,
X   313,   313,   313,   313,   313,-32768,-32768,-32768,-32768,   172,
X-32768,-32768,   107,    89,   254,-32768,   336,   164,   164,-32768,
X-32768,-32768,   254,-32768,   313,-32768,-32768,    46,-32768,   336,
X   164,   164,-32768,-32768,-32768,-32768,-32768,   111,   114,   115,
X    -6,    -6,-32768,   120,    -6,    71,    99,   202,-32768,-32768,
X    -7,   156,   166,   254,-32768,   326,   326,   360,-32768,-32768,
X-32768,-32768,   313,   313,   313,-32768,   313,-32768,   172,-32768,
X-32768,-32768,   143,   109,   125,    -5,   140,   254,   156,   156,
X     3,    53,     3,   381,   232,-32768,    99,    99,   181,   292,
X   313,    -6,-32768,    -6,    -6,    99,   172,   172,   206,   313,
X   -25,   254,-32768,   198,-32768,-32768,   132,   194,-32768,   174,
X   175,   313,    -6,    99,    99,    99,   176,-32768,   172,   172,
X   172,    99,-32768,-32768,-32768,   172,-32768,   214,   229,-32768
X`125;
X
Xstatic const short yypgoto[] = `123-32768,
X-32768,   215,-32768,   -12,-32768,-32768,-32768,    91,   -34,   -82,
X  -100,-32768,-32768,-32768,-32768,   -73,   -95,  -159,   -36,    -1,
X-32768,   304
X`125;
X
X
X#define`009YYLAST`009`009436
X
X
Xstatic const short yytable[] = `123    20,
X    29,    30,    44,    45,   129,   129,    49,   122,   159,    27,
X   181,    20,    31,     2,    20,   161,    22,   141,    95,   182,
X    58,    96,   187,    60,    61,    50,    51,    52,    53,    54,
X    98,    82,    83,    84,   139,    68,    69,   130,   130,    55,
X    22,    95,    20,    20,    20,    85,    25,    87,    88,    89,
X    90,    91,    92,    93,   141,   149,   150,   164,    15,    42,
X    56,    57,    44,    45,    62,    60,   178,   179,   100,   101,
X   102,   103,   104,   105,   167,   168,    63,   132,   183,    67,
X   136,   138,   129,   177,    95,    49,   142,   125,   193,   194,
X   195,    95,    81,   124,   163,   197,   151,   152,   153,    86,
X    49,   189,   190,   191,    50,    51,    52,    53,    54,   196,
X    78,   137,    79,   144,   145,   130,    44,    45,    94,    50,
X    51,    52,    53,    54,    20,    20,   148,   173,    64,   175,
X   176,    60,    60,    60,    44,   154,    44,    45,    47,    48,
X    97,    -1,    49,   106,     2,   107,     3,   171,   188,     4,
X   157,   126,    44,    45,   127,   128,     6,     7,    20,   172,
X   134,    50,    51,    52,    53,    54,   158,     5,   148,   143,
X    64,     8,     9,    10,     2,    11,     3,    12,   156,     4,
X   148,    13,    14,   106,   160,   107,    76,    77,   108,    15,
X   109,   110,   111,   112,   113,   114,   115,   116,    52,    53,
X    54,     8,     9,    10,     2,    11,     3,   169,   180,     4,
X   161,   184,    26,   199,   117,   185,   186,   192,   108,    15,
X   109,   110,   111,   112,   113,   114,   115,   116,   200,   155,
X    41,     8,     9,    10,     2,    11,     3,     0,     0,     4,
X     0,     0,    26,     0,   117,   140,     0,     0,   108,    15,
X   109,   110,   111,   112,   113,   114,   115,   116,     0,     0,
X     0,     8,     9,    10,     2,    11,     3,    49,     0,     4,
X    44,    45,    26,     5,   117,   166,     6,     7,     0,    15,
X     0,    46,     0,     0,     0,     0,    50,    51,    52,    53,
X    54,     8,     9,    10,     2,    11,     3,    12,     0,     4,
X     0,    13,    14,     0,     0,     0,     6,     7,     0,    15,
X     0,    23,    24,     0,     0,     2,     0,     3,    40,     0,
X     4,     8,     9,    10,     0,    11,     0,    12,     2,     0,
X     3,    13,    14,     4,     0,     0,   170,    65,    66,    15,
X     6,     7,     8,     9,    10,     0,    11,     2,     0,    32,
X     0,     0,    33,    26,     0,     8,     9,    10,     0,    11,
X    15,    12,   146,     0,     3,    13,    14,     4,    50,    51,
X    52,    53,    54,    15,    34,    35,    36,     0,    37,     0,
X     0,     0,    49,     0,     0,    38,     0,     0,     0,     8,
X     9,    10,    15,    11,    49,     0,     0,     0,     0,     0,
X    26,    50,    51,    52,    53,    54,     0,    15,    47,    48,
X    99,     0,    49,    50,    51,    52,    53,    54,     0,     0,
X     0,     0,   165,     0,     0,     0,     0,     0,     0,     0,
X     0,    50,    51,    52,    53,    54
X`125;
X
Xstatic const short yycheck[] = `123     1,
X    13,    14,    28,    29,    12,    12,    14,    81,    14,    11,
X   170,    13,    14,     3,    16,    13,    46,   118,    39,    45,
X    22,    42,   182,    25,    26,    33,    34,    35,    36,    37,
X    67,    44,    45,    46,   117,    37,    38,    45,    45,     9,
X    46,    39,    44,    45,    46,    47,    41,    49,    50,    51,
X    52,    53,    54,    55,   155,   129,   130,   153,    48,    43,
X    30,    31,    28,    29,     4,    67,   167,   168,    70,    71,
X    72,    73,    74,    75,   157,   158,    42,   112,   174,    41,
X   115,   116,    12,   166,    39,    14,   121,    42,   189,   190,
X   191,    39,    12,    95,    42,   196,   133,   134,   135,    36,
X    14,   184,   185,   186,    33,    34,    35,    36,    37,   192,
X    12,    41,    14,   126,   127,    45,    28,    29,    47,    33,
X    34,    35,    36,    37,   126,   127,   128,   162,    42,   164,
X   165,   133,   134,   135,    28,   137,    28,    29,    10,    11,
X    36,     0,    14,    12,     3,    14,     5,   160,   183,     8,
X    42,    41,    28,    29,    41,    41,    15,    16,   160,   161,
X    41,    33,    34,    35,    36,    37,    42,    12,   170,     4,
X    42,    30,    31,    32,     3,    34,     5,    36,    36,     8,
X   182,    40,    41,    12,    45,    14,    30,    31,    17,    48,
X    19,    20,    21,    22,    23,    24,    25,    26,    35,    36,
X    37,    30,    31,    32,     3,    34,     5,    27,     3,     8,
X    13,    18,    41,     0,    43,    42,    42,    42,    17,    48,
X    19,    20,    21,    22,    23,    24,    25,    26,     0,   139,
X    16,    30,    31,    32,     3,    34,     5,    -1,    -1,     8,
X    -1,    -1,    41,    -1,    43,    44,    -1,    -1,    17,    48,
X    19,    20,    21,    22,    23,    24,    25,    26,    -1,    -1,
X    -1,    30,    31,    32,     3,    34,     5,    14,    -1,     8,
X    28,    29,    41,    12,    43,    44,    15,    16,    -1,    48,
X    -1,    39,    -1,    -1,    -1,    -1,    33,    34,    35,    36,
X    37,    30,    31,    32,     3,    34,     5,    36,    -1,     8,
X    -1,    40,    41,    -1,    -1,    -1,    15,    16,    -1,    48,
X    -1,     8,     9,    -1,    -1,     3,    -1,     5,    15,    -1,
X     8,    30,    31,    32,    -1,    34,    -1,    36,     3,    -1,
X     5,    40,    41,     8,    -1,    -1,    45,    34,    35,    48,
X    15,    16,    30,    31,    32,    -1,    34,     3,    -1,     5,
X    -1,    -1,     8,    41,    -1,    30,    31,    32,    -1,    34,
X    48,    36,     3,    -1,     5,    40,    41,     8,    33,    34,
X    35,    36,    37,    48,    30,    31,    32,    -1,    34,    -1,
X    -1,    -1,    14,    -1,    -1,    41,    -1,    -1,    -1,    30,
X    31,    32,    48,    34,    14,    -1,    -1,    -1,    -1,    -1,
X    41,    33,    34,    35,    36,    37,    -1,    48,    10,    11,
X    42,    -1,    14,    33,    34,    35,    36,    37,    -1,    -1,
X    -1,    -1,    42,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
X    -1,    33,    34,    35,    36,    37
X`125;
X#define YYPURE 1
X
X#line 2 "bison.simple"
X
X/* Skeleton output parser for bison,
X   copyright (C) 1984 Bob Corbett and Richard Stallman
X
X`009`009       NO WARRANTY
X
X  BECAUSE THIS PROGRAM IS LICENSED FREE OF CHARGE, WE PROVIDE ABSOLUTELY
XNO WARRANTY, TO THE EXTENT PERMITTED BY APPLICABLE STATE LAW.  EXCEPT
XWHEN OTHERWISE STATED IN WRITING, FREE SOFTWARE FOUNDATION, INC,
XRICHARD M. STALLMAN AND/OR OTHER PARTIES PROVIDE THIS PROGRAM "AS IS"
XWITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING,
XBUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
XFITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY
XAND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE PROGRAM PROVE
XDEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
XCORRECTION.
X
X IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW WILL RICHARD M.
XSTALLMAN, THE FREE SOFTWARE FOUNDATION, INC., AND/OR ANY OTHER PARTY
XWHO MAY MODIFY AND REDISTRIBUTE THIS PROGRAM AS PERMITTED BELOW, BE
XLIABLE TO YOU FOR DAMAGES, INCLUDING ANY LOST PROFITS, LOST MONIES, OR
XOTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
XUSE OR INABILITY TO USE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR
XDATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD PARTIES OR
XA FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS) THIS
XPROGRAM, EVEN IF YOU HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH
XDAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY.
X
X`009`009GENERAL PUBLIC LICENSE TO COPY
X
X  1. You may copy and distribute verbatim copies of this source file
Xas you receive it, in any medium, provided that you conspicuously and
Xappropriately publish on each copy a valid copyright notice "Copyright
X(C) 1985 Free Software Foundation, Inc."; and include following the
Xcopyright notice a verbatim copy of the above disclaimer of warranty
Xand of this License.  You may charge a distribution fee for the
Xphysical act of transferring a copy.
X
X  2. You may modify your copy or copies of this source file or
Xany portion of it, and copy and distribute such modifications under
Xthe terms of Paragraph 1 above, provided that you also do the following:
X
X    a) cause the modified files to carry prominent notices stating
X    that you changed the files and the date of any change; and
X
X    b) cause the whole of any work that you distribute or publish,
X    that in whole or in part contains or is a derivative of this
X    program or any part thereof, to be licensed at no charge to all
X    third parties on terms identical to those contained in this
X    License Agreement (except that you may choose to grant more
X    extensive warranty protection to third parties, at your option).
X
X    c) You may charge a distribution fee for the physical act of
X    transferring a copy, and you may at your option offer warranty
X    protection in exchange for a fee.
X
X  3. You may copy and distribute this program or any portion of it in
Xcompiled, executable or object code form under the terms of Paragraphs
X1 and 2 above provided that you do the following:
X
X    a) cause each such copy to be accompanied by the
X    corresponding machine-readable source code, which must
X    be distributed under the terms of Paragraphs 1 and 2 above; or,
X
X    b) cause each such copy to be accompanied by a
X    written offer, with no time limit, to give any third party
X    free (except for a nominal shipping charge) a machine readable
X    copy of the corresponding source code, to be distributed
X    under the terms of Paragraphs 1 and 2 above; or,
X
X    c) in the case of a recipient of this program in compiled, executable
X    or object code form (without the corresponding source code) you
X    shall cause copies you distribute to be accompanied by a copy
X    of the written offer of source code which you received along
X    with the copy you received.
X
X  4. You may not copy, sublicense, distribute or transfer this program
Xexcept as expressly provided under this License Agreement.  Any attempt
Xotherwise to copy, sublicense, distribute or transfer this program is void and
Xyour rights to use the program under this License agreement shall be
Xautomatically terminated.  However, parties who have received computer
Xsoftware programs from you with this License Agreement will not have
Xtheir licenses terminated so long as such parties remain in full compliance.
X
X  5. If you wish to incorporate parts of this program into other free
Xprograms whose distribution conditions are different, write to the Free
XSoftware Foundation at 675 Mass Ave, Cambridge, MA 02139.  We have not yet
Xworked out a simple rule that can be stated here, but we will often permit
Xthis.  We will be guided by the two goals of preserving the free status of
Xall derivatives of our free software and of promoting the sharing and reuse of
Xsoftware.
X
X
XIn other words, you are welcome to use, share and improve this program.
XYou are forbidden to forbid anyone else to use, share and improve
Xwhat you give them.   Help stamp out software-hoarding!  */
X
X/* This is the parser code that is written into each bison parser
X  when the %semantic_parser declaration is not specified in the grammar.
X  It was written by Richard Stallman by simplifying the hairy parser
X  used when %semantic_parser is specified.  */
X
X/* Note: there must be only one dollar sign in this file.
X   It is replaced by the list of actions, each action
X   as one case of the switch.  */
X
X#define yyerrok`009`009(yyerrstatus = 0)
X#define yyclearin`009(yychar = YYEMPTY)
X#define YYEMPTY`009`009-2
X#define YYEOF`009`0090
X#define YYFAIL`009`009goto yyerrlab;
X
X#define YYTERROR`0091
X
X#ifndef YYIMPURE
X#define YYLEX`009`009yylex()
X#endif
X
X#ifndef YYPURE
X#define YYLEX`009`009yylex(&yylval, &yylloc)
X#endif
X
X/* If nonreentrant, generate the variables here */
X
X#ifndef YYIMPURE
X
Xint`009yychar;`009`009`009/*  the lookahead symbol`009`009*/
XYYSTYPE`009yylval;`009`009`009/*  the semantic value of the`009`009*/
X`009`009`009`009/*  lookahead symbol`009`009`009*/
X
XYYLTYPE yylloc;`009`009`009/*  location data for the lookahead`009*/
X`009`009`009`009/*  symbol`009`009`009`009*/
X
Xint yydebug = 0;`009`009/*  nonzero means print parse trace`009*/
X
X#endif  /* YYIMPURE */
X
X
X/*  YYMAXDEPTH indicates the initial size of the parser's stacks`009*/
X
X#ifndef`009YYMAXDEPTH
X#define YYMAXDEPTH 200
X#endif
X
X/*  YYMAXLIMIT is the maximum size the stacks can grow to
X    (effective only if the built-in stack extension method is used).  */
X
X#ifndef YYMAXLIMIT
X#define YYMAXLIMIT 10000
X#endif
X
X
X#line 87 "bison.simple"
Xint
Xyyparse()
X`123
X  register int yystate;
X  register int yyn;
X  register short *yyssp;
X  register YYSTYPE *yyvsp;
X  YYLTYPE *yylsp;
V  int yyerrstatus;`009/*  number of tokens to shift before error messages enabl
Xed */
V  int yychar1;`009`009/*  lookahead token as an internal (translated) token num
Xber */
X
X  short`009yyssa[YYMAXDEPTH];`009/*  the state stack`009`009`009*/
X  YYSTYPE yyvsa[YYMAXDEPTH];`009/*  the semantic value stack`009`009*/
X  YYLTYPE yylsa[YYMAXDEPTH];`009/*  the location stack`009`009`009*/
X
X  short *yyss = yyssa;`009`009/*  refer to the stacks thru separate pointers */
V  YYSTYPE *yyvs = yyvsa;`009/*  to allow yyoverflow to reallocate them elsewher
Xe */
X  YYLTYPE *yyls = yylsa;
X
X  int yymaxdepth = YYMAXDEPTH;
X
X#ifndef YYPURE
X
X  int yychar;
X  YYSTYPE yylval;
X  YYLTYPE yylloc;
X
X  extern int yydebug;
X
X#endif
X
X
X  YYSTYPE yyval;`009`009/*  the variable used to return`009`009*/
X`009`009`009`009/*  semantic values from the action`009*/
X`009`009`009`009/*  routines`009`009`009`009*/
X
X  int yylen;
X
X  if (yydebug)
X    fprintf(stderr, "Starting parse\n");
X
X  yystate = 0;
X  yyerrstatus = 0;
X  yychar = YYEMPTY;`009`009/* Cause a token to be read.  */
X
X  /* Initialize stack pointers.
X     Waste one element of value and location stack
X     so that they stay on the same level as the state stack.  */
X
X  yyssp = yyss - 1;
X  yyvsp = yyvs;
X  yylsp = yyls;
X
X/* Push a new state, which is found in  yystate  .  */
X/* In all cases, when you get here, the value and location stacks
X   have just been pushed. so pushing a state here evens the stacks.  */
Xyynewstate:
X
X  *++yyssp = yystate;
X
X  if (yyssp >= yyss + yymaxdepth - 1)
X    `123
X      /* Give user a chance to reallocate the stack */
V      /* Use copies of these so that the &'s don't force the real ones into mem
Xory. */
X      YYSTYPE *yyvs1 = yyvs;
X      YYLTYPE *yyls1 = yyls;
X      short *yyss1 = yyss;
X
X      /* Get the current used size of the three stacks, in elements.  */
X      int size = yyssp - yyss + 1;
X
X#ifdef yyoverflow
X      /* Each stack pointer address is followed by the size of
X`009 the data in use in that stack, in bytes.  */
X      yyoverflow("parser stack overflow",
X`009`009 &yyss1, size * sizeof (*yyssp),
X`009`009 &yyvs1, size * sizeof (*yyvsp),
X`009`009 &yyls1, size * sizeof (*yylsp),
X`009`009 &yymaxdepth);
X
X      yyss = yyss1; yyvs = yyvs1; yyls = yyls1;
X#else /* no yyoverflow */
X      /* Extend the stack our own way.  */
X      if (yymaxdepth >= YYMAXLIMIT)
X`009yyerror("parser stack overflow");
X      yymaxdepth *= 2;
X      if (yymaxdepth > YYMAXLIMIT)
X`009yymaxdepth = YYMAXLIMIT;
X      yyss = (short *) alloca (yymaxdepth * sizeof (*yyssp));
X      bcopy ((char *)yyss1, (char *)yyss, size * sizeof (*yyssp));
X      yyls = (YYLTYPE *) alloca (yymaxdepth * sizeof (*yylsp));
X      bcopy ((char *)yyls1, (char *)yyls, size * sizeof (*yylsp));
X      yyvs = (YYSTYPE *) alloca (yymaxdepth * sizeof (*yyvsp));
X      bcopy ((char *)yyvs1, (char *)yyvs, size * sizeof (*yyvsp));
X#endif /* no yyoverflow */
X
X      yyssp = yyss + size - 1;
X      yylsp = yyls + size - 1;
X      yyvsp = yyvs + size - 1;
X
X      if (yydebug)
X`009fprintf(stderr, "Stack size increased to %d\n", yymaxdepth);
X
X      if (yyssp >= yyss + yymaxdepth - 1)
X`009YYERROR;
X    `125
X
X  if (yydebug)
X    fprintf(stderr, "Entering state %d\n", yystate);
X
X/* Do appropriate processing given the current state.  */
X/* Read a lookahead token if we need one and don't already have one.  */
Xyyresume:
X
X  /* First try to decide what to do without reference to lookahead token.  */
X
X  yyn = yypact[yystate];
X  if (yyn == YYFLAG)
X    goto yydefault;
X
X  /* Not known => get a lookahead token if don't already have one.  */
X
X  /* yychar is either YYEMPTY or YYEOF
X     or a valid token in external form.  */
X
X  if (yychar == YYEMPTY)
X    `123
X      yychar = YYLEX;
X    `125
X
X  /* Convert token to internal form (in yychar1) for indexing tables with */
X
X  if (yychar <= 0)`009`009/* This means end of input. */
X    `123
X      yychar1 = 0;
X      yychar = YYEOF;`009`009/* Don't call YYLEX any more */
X
X      if (yydebug)
X`009fprintf(stderr, "Now at end of input.\n");
X    `125
X  else
X    `123
X      yychar1 = YYTRANSLATE(yychar);
X
X      if (yydebug)
V`009fprintf(stderr, "Parsing next token; it is %d (%s)\n", yychar, yytname[yych
Xar1]);
X    `125
X
X  yyn += yychar1;
X  if (yyn < 0 `124`124 yyn > YYLAST `124`124 yycheck[yyn] != yychar1)
X    goto yydefault;
X
X  yyn = yytable[yyn];
X
X  /* yyn is what to do for this token type in this state.
X     Negative => reduce, -yyn is rule number.
X     Positive => shift, yyn is new state.
X       New state is final state => don't bother to shift,
X       just return success.
X     0, or most negative number => error.  */
X
X  if (yyn < 0)
X    `123
X      if (yyn == YYFLAG)
X`009goto yyerrlab;
X      yyn = -yyn;
X      goto yyreduce;
X    `125
X  else if (yyn == 0)
X    goto yyerrlab;
X
X  if (yyn == YYFINAL)
X    YYACCEPT;
X
X  /* Shift the lookahead token.  */
X
X  if (yydebug)
X    fprintf(stderr, "Shifting token %d (%s), ", yychar, yytname[yychar1]);
X
X  /* Discard the token being shifted unless it is eof.  */
X  if (yychar != YYEOF)
X    yychar = YYEMPTY;
X
X  *++yyvsp = yylval;
X  *++yylsp = yylloc;
X
X  /* count tokens shifted since error; after three, turn off error status.  */
X  if (yyerrstatus) yyerrstatus--;
X
X  yystate = yyn;
X  goto yynewstate;
X
X/* Do the default action for the current state.  */
Xyydefault:
X
X  yyn = yydefact[yystate];
X  if (yyn == 0)
X    goto yyerrlab;
X
X/* Do a reduction.  yyn is the number of a rule to reduce with.  */
Xyyreduce:
X  yylen = yyr2[yyn];
X  yyval = yyvsp[1-yylen]; /* implement default value of the action */
X
X  if (yydebug)
X    `123
X      if (yylen == 1)
X`009fprintf (stderr, "Reducing 1 value via line %d, ",
X`009`009 yyrline[yyn]);
X      else
X`009fprintf (stderr, "Reducing %d values via line %d, ",
X`009`009 yylen, yyrline[yyn]);
X    `125
X
X
X  switch (yyn) `123
X
Xcase 1:
X#line 106 "awk.y"
X`123 expression_value = yyvsp[0].nodeval; ;
X    break;`125
Xcase 2:
X#line 111 "awk.y"
X`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_rule_list,(NODE *) NULL); ;
X    break;`125
Xcase 3:
X#line 114 "awk.y"
V`123 yyval.nodeval = append_right (yyvsp[-1].nodeval, node(yyvsp[0].nodeval, No
Xde_rule_list,(NODE *) NULL)); ;
X    break;`125
Xcase 4:
X#line 118 "awk.y"
V`123 yyval.nodeval = node (yyvsp[-3].nodeval, Node_rule_node, yyvsp[-2].nodeval
X); ;
X    break;`125
Xcase 5:
X#line 123 "awk.y"
X`123 yyval.nodeval = NULL; ;
X    break;`125
Xcase 6:
X#line 125 "awk.y"
X`123 yyval.nodeval = yyvsp[0].nodeval; ;
X    break;`125
Xcase 7:
X#line 127 "awk.y"
V`123 yyval.nodeval = mkrangenode ( node(yyvsp[-2].nodeval, Node_cond_pair, yyvs
Xp[0].nodeval) ); ;
X    break;`125
Xcase 8:
X#line 133 "awk.y"
X`123 yyval.nodeval = node ((NODE *)NULL, Node_K_BEGIN,(NODE *) NULL); ;
X    break;`125
Xcase 9:
X#line 135 "awk.y"
X`123 yyval.nodeval = node ((NODE *)NULL, Node_K_END,(NODE *) NULL); ;
X    break;`125
Xcase 10:
X#line 137 "awk.y"
X`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_not,(NODE *) NULL); ;
X    break;`125
Xcase 11:
X#line 139 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_and, yyvsp[0].nodeval); ;
X    break;`125
Xcase 12:
X#line 141 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_or, yyvsp[0].nodeval); ;
X    break;`125
Xcase 13:
X#line 143 "awk.y"
X`123
X`009`009  yyval.nodeval = yyvsp[-1].nodeval;
X`009`009  want_concat_token = 0;
X`009`009;
X    break;`125
Xcase 14:
X#line 152 "awk.y"
X`123 ++want_regexp; ;
X    break;`125
Xcase 15:
X#line 154 "awk.y"
X`123 want_regexp = 0;
V`009`009  yyval.nodeval = node (node (make_number ((AWKNUM)0), Node_field_spec,
X (NODE *)NULL),
X`009`009`009     Node_match, (NODE *)make_regexp (yyvsp[-1].sval));
X`009`009;
X    break;`125
Xcase 16:
X#line 159 "awk.y"
X`123 ++want_regexp; ;
X    break;`125
Xcase 17:
X#line 161 "awk.y"
X`123 want_regexp = 0;
V`009`009   yyval.nodeval = node (yyvsp[-5].nodeval, yyvsp[-4].nodetypeval, (NOD
XE *)make_regexp(yyvsp[-1].sval));
X`009`009 ;
X    break;`125
Xcase 18:
X#line 165 "awk.y"
V`123 yyval.nodeval = node (yyvsp[-2].nodeval, yyvsp[-1].nodetypeval, yyvsp[0].n
Xodeval); ;
X    break;`125
Xcase 19:
X#line 167 "awk.y"
X`123 yyval.nodeval = yyvsp[0].nodeval; ;
X    break;`125
Xcase 20:
X#line 172 "awk.y"
X`123 yyval.nodeval = NULL; ;
X    break;`125
Xcase 21:
X#line 174 "awk.y"
X`123 yyval.nodeval = yyvsp[-1].nodeval; ;
X    break;`125
Xcase 22:
X#line 179 "awk.y"
X`123 yyval.nodeval = NULL; ;
X    break;`125
Xcase 23:
X#line 181 "awk.y"
V`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_statement_list, (NODE *)NULL)
X; ;
X    break;`125
Xcase 24:
X#line 183 "awk.y"
V`123 yyval.nodeval = append_right(yyvsp[-1].nodeval, node( yyvsp[0].nodeval, No
Xde_statement_list, (NODE *)NULL)); ;
X    break;`125
Xcase 25:
X#line 188 "awk.y"
X`123 yyval.nodetypeval = Node_illegal; ;
X    break;`125
Xcase 26:
X#line 190 "awk.y"
X`123 yyval.nodetypeval = Node_illegal; ;
X    break;`125
Xcase 27:
X#line 195 "awk.y"
X`123 yyval.nodetypeval = Node_illegal; ;
X    break;`125
Xcase 32:
X#line 203 "awk.y"
X`123 yyval.nodeval = yyvsp[-2].nodeval; ;
X    break;`125
Xcase 33:
X#line 205 "awk.y"
X`123 yyval.nodeval = yyvsp[0].nodeval; ;
X    break;`125
Xcase 34:
X#line 207 "awk.y"
V`123 yyval.nodeval = node (yyvsp[-3].nodeval, Node_K_while, yyvsp[0].nodeval);
X ;
X    break;`125
Xcase 35:
X#line 209 "awk.y"
V`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_K_for, (NODE *)make_for_loop
X (yyvsp[-7].nodeval, yyvsp[-5].nodeval, yyvsp[-3].nodeval)); ;
X    break;`125
Xcase 36:
X#line 211 "awk.y"
V`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_K_for, (NODE *)make_for_loop
X (yyvsp[-6].nodeval, (NODE *)NULL, yyvsp[-3].nodeval)); ;
X    break;`125
Xcase 37:
X#line 213 "awk.y"
V`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_K_arrayfor, (NODE *)make_for_
Xloop(variable(yyvsp[-6].sval), (NODE *)NULL, variable(yyvsp[-3].sval))); ;
X    break;`125
Xcase 38:
X#line 216 "awk.y"
X`123 yyval.nodeval = node ((NODE *)NULL, Node_K_break, (NODE *)NULL); ;
X    break;`125
Xcase 39:
X#line 219 "awk.y"
X`123 yyval.nodeval = node ((NODE *)NULL, Node_K_continue, (NODE *)NULL); ;
X    break;`125
Xcase 40:
X#line 221 "awk.y"
X`123 ++want_redirect; ;
X    break;`125
Xcase 41:
X#line 223 "awk.y"
X`123
X`009`009  want_redirect = 0;
X`009`009  /* $4->lnode = NULL; */
V`009`009  yyval.nodeval = node (yyvsp[-2].nodeval, Node_K_print, yyvsp[-1].node
Xval);
X`009`009;
X    break;`125
Xcase 42:
X#line 229 "awk.y"
X`123 ++want_redirect; ;
X    break;`125
Xcase 43:
X#line 231 "awk.y"
X`123
X`009`009  want_redirect = 0;
X`009`009  /* $4->lnode = NULL; */
V`009`009  yyval.nodeval = node (yyvsp[-2].nodeval, Node_K_printf, yyvsp[-1].nod
Xeval);
X`009`009;
X    break;`125
Xcase 44:
X#line 237 "awk.y"
X`123 ++want_redirect;
X`009`009  want_concat_token = 0; ;
X    break;`125
Xcase 45:
X#line 240 "awk.y"
X`123
X`009`009  want_redirect = 0;
V`009`009  yyval.nodeval = node (yyvsp[-4].nodeval, Node_K_printf, yyvsp[-1].nod
Xeval);
X`009`009;
X    break;`125
Xcase 46:
X#line 245 "awk.y"
X`123 yyval.nodeval = node ((NODE *)NULL, Node_K_next, (NODE *)NULL); ;
X    break;`125
Xcase 47:
X#line 247 "awk.y"
X`123 yyval.nodeval = node ((NODE *)NULL, Node_K_exit, (NODE *)NULL); ;
X    break;`125
Xcase 48:
X#line 249 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_K_exit, (NODE *)NULL); ;
X    break;`125
Xcase 49:
X#line 251 "awk.y"
X`123 yyval.nodeval = yyvsp[-1].nodeval; ;
X    break;`125
Xcase 50:
X#line 257 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-3].nodeval, Node_K_if,
X`009`009`009`009node (yyvsp[0].nodeval, Node_if_branches, (NODE *)NULL)); ;
X    break;`125
Xcase 51:
X#line 261 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-6].nodeval, Node_K_if,
V`009`009`009`009node (yyvsp[-3].nodeval, Node_if_branches, yyvsp[0].nodeval));
X ;
X    break;`125
Xcase 53:
X#line 268 "awk.y"
X`123 yyval.nodetypeval = Node_illegal; ;
X    break;`125
Xcase 54:
X#line 273 "awk.y"
X`123 yyval.nodeval = NULL; /* node (NULL, Node_redirect_nil, NULL); */ ;
X    break;`125
Xcase 55:
X#line 277 "awk.y"
V`123 yyval.nodeval = node (yyvsp[0].nodeval, yyvsp[-1].nodetypeval, (NODE *)NUL
XL); ;
X    break;`125
Xcase 56:
X#line 283 "awk.y"
X`123 yyval.nodeval = NULL; /* node(NULL, Node_builtin, NULL); */ ;
X    break;`125
Xcase 57:
X#line 285 "awk.y"
X`123 yyval.nodeval = yyvsp[0].nodeval; ;
X    break;`125
Xcase 58:
X#line 290 "awk.y"
X`123 yyval.nodeval = NULL; ;
X    break;`125
Xcase 59:
X#line 292 "awk.y"
V`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_expression_list, (NODE *)NULL
X); ;
X    break;`125
Xcase 60:
X#line 294 "awk.y"
V`123 yyval.nodeval = append_right(yyvsp[-2].nodeval, node( yyvsp[0].nodeval, No
Xde_expression_list, (NODE *)NULL)); ;
X    break;`125
Xcase 61:
X#line 300 "awk.y"
V`123 yyval.nodeval = snode (yyvsp[-1].nodeval, Node_builtin, yyvsp[-3].ptrval);
X ;
X    break;`125
Xcase 62:
X#line 302 "awk.y"
X`123 yyval.nodeval = snode ((NODE *)NULL, Node_builtin, yyvsp[0].ptrval); ;
X    break;`125
Xcase 63:
X#line 304 "awk.y"
X`123 yyval.nodeval = yyvsp[-1].nodeval; ;
X    break;`125
Xcase 64:
X#line 306 "awk.y"
X`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_unary_minus, (NODE *)NULL); ;
X    break;`125
Xcase 65:
X#line 308 "awk.y"
V`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_preincrement, (NODE *)NULL);
X ;
X    break;`125
Xcase 66:
X#line 310 "awk.y"
V`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_predecrement, (NODE *)NULL);
X ;
X    break;`125
Xcase 67:
X#line 312 "awk.y"
V`123 yyval.nodeval = node (yyvsp[-1].nodeval, Node_postincrement, (NODE *)NULL)
X; ;
X    break;`125
Xcase 68:
X#line 314 "awk.y"
V`123 yyval.nodeval = node (yyvsp[-1].nodeval, Node_postdecrement, (NODE *)NULL)
X; ;
X    break;`125
Xcase 69:
X#line 316 "awk.y"
X`123 yyval.nodeval = yyvsp[0].nodeval; ;
X    break;`125
Xcase 70:
X#line 318 "awk.y"
X`123 yyval.nodeval = make_number (yyvsp[0].fval); ;
X    break;`125
Xcase 71:
X#line 320 "awk.y"
X`123 yyval.nodeval = make_string (yyvsp[0].sval, -1); ;
X    break;`125
Xcase 72:
X#line 324 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_times, yyvsp[0].nodeval); ;
X    break;`125
Xcase 73:
X#line 326 "awk.y"
V`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_quotient, yyvsp[0].nodeval);
X ;
X    break;`125
Xcase 74:
X#line 328 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_mod, yyvsp[0].nodeval); ;
X    break;`125
Xcase 75:
X#line 330 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_plus, yyvsp[0].nodeval); ;
X    break;`125
Xcase 76:
X#line 332 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_minus, yyvsp[0].nodeval); ;
X    break;`125
Xcase 77:
X#line 335 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_concat, yyvsp[0].nodeval); ;
X    break;`125
Xcase 78:
X#line 337 "awk.y"
V`123 yyval.nodeval = node (yyvsp[-2].nodeval, yyvsp[-1].nodetypeval, yyvsp[0].n
Xodeval); ;
X    break;`125
Xcase 79:
X#line 341 "awk.y"
V`123 yyval.nodeval = snode (yyvsp[-1].nodeval, Node_builtin, yyvsp[-3].ptrval);
X ;
X    break;`125
Xcase 80:
X#line 343 "awk.y"
X`123 yyval.nodeval = snode ((NODE *)NULL, Node_builtin, yyvsp[0].ptrval); ;
X    break;`125
Xcase 81:
X#line 345 "awk.y"
X`123 yyval.nodeval = yyvsp[-1].nodeval; ;
X    break;`125
Xcase 82:
X#line 347 "awk.y"
X`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_unary_minus, (NODE *)NULL); ;
X    break;`125
Xcase 83:
X#line 349 "awk.y"
V`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_preincrement, (NODE *)NULL);
X ;
X    break;`125
Xcase 84:
X#line 351 "awk.y"
V`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_predecrement, (NODE *)NULL);
X ;
X    break;`125
Xcase 85:
X#line 353 "awk.y"
V`123 yyval.nodeval = node (yyvsp[-1].nodeval, Node_postincrement, (NODE *)NULL)
X; ;
X    break;`125
Xcase 86:
X#line 355 "awk.y"
V`123 yyval.nodeval = node (yyvsp[-1].nodeval, Node_postdecrement, (NODE *)NULL)
X; ;
X    break;`125
Xcase 87:
X#line 357 "awk.y"
X`123 yyval.nodeval = yyvsp[0].nodeval; ;
X    break;`125
Xcase 88:
X#line 359 "awk.y"
X`123 yyval.nodeval = make_number (yyvsp[0].fval); ;
X    break;`125
Xcase 89:
X#line 361 "awk.y"
X`123 yyval.nodeval = make_string (yyvsp[0].sval, -1); ;
X    break;`125
Xcase 90:
X#line 365 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_times, yyvsp[0].nodeval); ;
X    break;`125
Xcase 91:
X#line 367 "awk.y"
V`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_quotient, yyvsp[0].nodeval);
X ;
X    break;`125
Xcase 92:
X#line 369 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_mod, yyvsp[0].nodeval); ;
X    break;`125
Xcase 93:
X#line 371 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_plus, yyvsp[0].nodeval); ;
X    break;`125
Xcase 94:
X#line 373 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_minus, yyvsp[0].nodeval); ;
X    break;`125
Xcase 95:
X#line 376 "awk.y"
X`123 yyval.nodeval = node (yyvsp[-2].nodeval, Node_concat, yyvsp[0].nodeval); ;
X    break;`125
Xcase 96:
X#line 381 "awk.y"
X`123 yyval.nodeval = variable (yyvsp[0].sval); ;
X    break;`125
Xcase 97:
X#line 383 "awk.y"
V`123 yyval.nodeval = node (variable(yyvsp[-3].sval), Node_subscript, yyvsp[-1].
Xnodeval); ;
X    break;`125
Xcase 98:
X#line 385 "awk.y"
X`123 yyval.nodeval = node (yyvsp[0].nodeval, Node_field_spec, (NODE *)NULL); ;
X    break;`125
X`125
X   /* the action file gets copied in in place of this dollarsign */
X#line 303 "bison.simple"
X`012
X  yyvsp -= yylen;
X  yylsp -= yylen;
X  yyssp -= yylen;
X
X  if (yydebug)
X    `123
X      short *ssp1 = yyss - 1;
X      fprintf (stderr, "state stack now", yyssp-yyss);
X      while (ssp1 != yyssp)
X`009fprintf (stderr, " %d", *++ssp1);
X      fprintf (stderr, "\n");
X    `125
X
X  *++yyvsp = yyval;
X
X  yylsp++;
X  if (yylen == 0)
X    `123
X      yylsp->first_line = yylloc.first_line;
X      yylsp->first_column = yylloc.first_column;
X      yylsp->last_line = (yylsp-1)->last_line;
X      yylsp->last_column = (yylsp-1)->last_column;
X      yylsp->text = 0;
X    `125
X  else
X    `123
X      yylsp->last_line = (yylsp+yylen-1)->last_line;
X      yylsp->last_column = (yylsp+yylen-1)->last_column;
X    `125
X
X  /* Now "shift" the result of the reduction.
X     Determine what state that goes to,
X     based on the state we popped back to
X     and the rule number reduced by.  */
X
X  yyn = yyr1[yyn];
X
X  yystate = yypgoto[yyn - YYNTBASE] + *yyssp;
X  if (yystate >= 0 && yystate <= YYLAST && yycheck[yystate] == *yyssp)
X    yystate = yytable[yystate];
X  else
X    yystate = yydefgoto[yyn - YYNTBASE];
X
X  goto yynewstate;
X
Xyyerrlab:   /* here on detecting error */
X
X  if (! yyerrstatus)
X    /* If not already recovering from an error, report this error.  */
X    `123
X      yyerror("parse error");
X    `125
X
X  if (yyerrstatus == 3)
X    `123
V      /* if just tried and failed to reuse lookahead token after an error, disc
Xard it.  */
X
X      /* return failure if at end of input */
X      if (yychar == YYEOF)
X`009YYERROR;
X
X      if (yydebug)
X`009fprintf(stderr, "Discarding token %d (%s).\n", yychar, yytname[yychar1]);
X
X      yychar = YYEMPTY;
X    `125
X
X  /* Else will try to reuse lookahead token
X     after shifting the error token.  */
X
X  yyerrstatus = 3;`009`009/* Each real token shifted decrements this */
X
X  goto yyerrhandle;
X
Vyyerrdefault:  /* current state does not do anything special for the error toke
Xn. */
X
X#if 0
X  /* This is wrong; only states that explicitly want error tokens
X     should shift them.  */
V  yyn = yydefact[yystate];  /* If its default is to accept any token, ok.  Othe
Xrwise pop it.*/
X  if (yyn) goto yydefault;
X#endif
X
Vyyerrpop:   /* pop the current state because it cannot handle the error token *
X/
X
X  if (yyssp == yyss) YYERROR;
X  yyvsp--;
X  yylsp--;
X  yystate = *--yyssp;
X
X  if (yydebug)
X    `123
X      short *ssp1 = yyss - 1;
X      fprintf (stderr, "Error: state stack now", yyssp-yyss);
X      while (ssp1 != yyssp)
X`009fprintf (stderr, " %d", *++ssp1);
X      fprintf (stderr, "\n");
X    `125
X
Xyyerrhandle:
X
X  yyn = yypact[yystate];
X  if (yyn == YYFLAG)
X    goto yyerrdefault;
X
X  yyn += YYTERROR;
X  if (yyn < 0 `124`124 yyn > YYLAST `124`124 yycheck[yyn] != YYTERROR)
X    goto yyerrdefault;
X
X  yyn = yytable[yyn];
X  if (yyn < 0)
X    `123
X      if (yyn == YYFLAG)
X`009goto yyerrpop;
X      yyn = -yyn;
X      goto yyreduce;
X    `125
X  else if (yyn == 0)
X    goto yyerrpop;
X
X  if (yyn == YYFINAL)
X    YYACCEPT;
X
X  if (yydebug)
X    fprintf(stderr, "Shifting error token, ");
X
X  *++yyvsp = yylval;
X  *++yylsp = yylloc;
X
X  yystate = yyn;
X  goto yynewstate;
X`125
X#line 388 "awk.y"
X
X`012
X
Xstruct token `123
X  char *operator;
X  NODETYPE value;
X  int class;
X  NODE *(*ptr)();
X`125;
X
X#define NULL 0
X
XNODE`009*do_exp(),`009*do_getline(),`009*do_index(),`009*do_length(),
X`009*do_sqrt(),`009*do_log(),`009*do_sprintf(),`009*do_substr(),
X`009*do_split(),`009*do_int();
X
X`009/* Special functions for debugging */
X#ifndef FAST
XNODE`009*do_prvars(),`009*do_bp();
X#endif
X
X/* Tokentab is sorted ascii ascending order, so it can be binary searched. */
X/* (later.  Right now its just sort of linear search (SLOW!!) */
X
Xstatic struct token tokentab[] = `123
X  `123"BEGIN",`009Node_illegal,`009`009LEX_BEGIN,`0090`125,
X  `123"END",`009Node_illegal,`009`009LEX_END,`0090`125,
X#ifndef FAST
X  `123"bp",`009Node_builtin,`009`009LEX_BUILTIN,`009do_bp`125,
X#endif
X  `123"break",`009Node_K_break,`009`009LEX_BREAK,`0090`125,
X  `123"continue",`009Node_K_continue,`009LEX_CONTINUE,`0090`125,
X  `123"else",`009Node_illegal,`009`009LEX_ELSE,`0090`125,
X  `123"exit",`009Node_K_exit,`009`009LEX_EXIT,`0090`125,
X  `123"exp",`009Node_builtin,`009`009LEX_BUILTIN,`009do_exp`125,
X  `123"for",`009Node_K_for,`009`009LEX_FOR,`0090`125,
X  `123"getline",`009Node_builtin,`009`009LEX_BUILTIN,`009do_getline`125,
X  `123"if",`009Node_K_if,`009`009LEX_IF,`009`0090`125,
X  `123"in",`009Node_illegal,`009`009LEX_IN,`009`0090`125,
X  `123"index",`009Node_builtin,`009`009LEX_BUILTIN,`009do_index`125,
X  `123"int",`009Node_builtin,`009`009LEX_BUILTIN,`009do_int`125,
X  `123"length",`009Node_builtin,`009`009LEX_BUILTIN,`009do_length`125,
X  `123"log",`009Node_builtin,`009`009LEX_BUILTIN,`009do_log`125,
X  `123"next",`009Node_K_next,`009`009LEX_NEXT,`0090`125,
X  `123"print",`009Node_K_print,`009`009LEX_PRINT,`0090`125,
X  `123"printf",`009Node_K_printf,`009`009LEX_PRINTF,`0090`125,
X#ifndef FAST
X  `123"prvars",`009Node_builtin,`009`009LEX_BUILTIN,`009do_prvars`125,
X#endif
X  `123"split",`009Node_builtin,`009`009LEX_BUILTIN,`009do_split`125,
X  `123"sprintf",`009Node_builtin,`009`009LEX_BUILTIN,`009do_sprintf`125,
X  `123"sqrt",`009Node_builtin,`009`009LEX_BUILTIN,`009do_sqrt`125,
X  `123"substr",`009Node_builtin,`009`009LEX_BUILTIN,`009do_substr`125,
X  `123"while",`009Node_K_while,`009`009LEX_WHILE,`0090`125,
X  `123NULL,`009Node_illegal,`009`009ERROR,`009`0090`125
X`125;
X
X/* Read one token, getting characters through lexptr.  */
X
Xstatic int
Xyylex ()
X`123
X  register int c;
X  register int namelen;
X  register char *tokstart;
X  register struct token *toktab;
X  double atof();`009/* JF know what happens if you forget this? */
X
X
X  static did_newline = 0;`009/* JF the grammar insists that actions end
X  `009`009`009`009   with newlines.  This was easier than hacking
X`009`009`009`009   the grammar. */
X  int do_concat;
X
X  int`009seen_e = 0;`009`009/* These are for numbers */
X  int`009seen_point = 0;
X
X  retry:
X
X  if(!lexptr)
X    return 0;
X
X  if (want_regexp) `123
X    want_regexp = 0;
X    /* there is a potential bug if a regexp is followed by an equal sign:
X       "/foo/=bar" would result in assign_quotient being returned as the
X       next token.  Nothing is done about it since it is not valid awk,
X       but maybe something should be done anyway. */
X
X    tokstart = lexptr;
X    while (c = *lexptr++) `123
X      switch (c) `123
X      case '\\':
X`009if (*lexptr++ == '\0') `123
X`009  yyerror ("unterminated regexp ends with \\");
X`009  return ERROR;
X`009`125
X`009break;
X      case '/':`009`009`009/* end of the regexp */
X`009lexptr--;
X`009yylval.sval = tokstart;
X`009return REGEXP;
X      case '\n':
X      case '\0':
X`009yyerror ("unterminated regexp");
X`009return ERROR;
X      `125
X    `125
X  `125
X  do_concat=want_concat_token;
X  want_concat_token=0;
X
X  if(*lexptr=='\0') `123
X    lexptr=0;
X    return NEWLINE;
X  `125
X
X  /* if lexptr is at white space between two terminal tokens or parens,
X     it is a concatenation operator. */
X  if(do_concat && (*lexptr==' ' `124`124 *lexptr=='\t')) `123
X    while (*lexptr == ' ' `124`124 *lexptr == '\t')
X      lexptr++;
X    if (isalnum(*lexptr) `124`124 *lexptr == '\"' `124`124 *lexptr == '('
V        `124`124 *lexptr == '.' `124`124 *lexptr == '$') /* the '.' is for deci
Xmal pt */
X      return CONCAT_OP;
X  `125
X
X  while (*lexptr == ' ' `124`124 *lexptr == '\t')
X    lexptr++;
X
X  tokstart = lexptr;`009/* JF */
X
X  switch (c = *lexptr++) `123
X  case 0:
X    return 0;
X
X  case '\n':
X    lineno++;
X    return NEWLINE;
X
X  case '#':`009`009`009/* it's a comment */
X    while (*lexptr != '\n' && *lexptr != '\0')
X      lexptr++;
X    goto retry;
X
X  case '\\':
X    if(*lexptr=='\n') `123
X      lexptr++;
X      goto retry;
X    `125 else break; `032
X  case ')':
X  case ']':
X    ++want_concat_token;
X    /* fall through */
V  case '(':`009/* JF these were above, but I don't see why they should turn on
X concat. . . &*/
X  case '[':
X
X  case '`123':
X  case ',':`009`009/* JF */
X  case '$':
X  case ';':
X    /* set node type to ILLEGAL because the action should set it to
X       the right thing */
X    yylval.nodetypeval = Node_illegal;
X    return c;
X
X  case '*':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_assign_times;
X      lexptr++;
X      return ASSIGNOP;
X    `125
X    yylval.nodetypeval=Node_illegal;
X    return c;
X
X  case '/':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_assign_quotient;
X      lexptr++;
X      return ASSIGNOP;
X    `125
X    yylval.nodetypeval=Node_illegal;
X    return c;
X
X  case '%':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_assign_mod;
X      lexptr++;
X      return ASSIGNOP;
X    `125
X    yylval.nodetypeval=Node_illegal;
X    return c;
X
X  case '+':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_assign_plus;
X      lexptr++;
X      return ASSIGNOP;
X    `125
X    if(*lexptr=='+') `123
X      yylval.nodetypeval=Node_illegal;
X      lexptr++;
X      return INCREMENT;
X    `125
X    yylval.nodetypeval=Node_illegal;
X    return c;
X
X  case '!':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_notequal;
X      lexptr++;
X      return RELOP;
X    `125
X    if(*lexptr=='`126') `123
X      yylval.nodetypeval=Node_nomatch;
X      lexptr++;
X      return MATCHOP;
X    `125
X    yylval.nodetypeval=Node_illegal;
X    return c;
X
X  case '<':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_leq;
X      lexptr++;
X      return RELOP;
X    `125
X    yylval.nodetypeval=Node_less;
X    return RELOP;
X
X  case '=':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_equal;
X      lexptr++;
X      return RELOP;
X    `125
X    yylval.nodetypeval=Node_assign;
X    return ASSIGNOP;
X
X  case '>':
X    if(want_redirect) `123
X      if (*lexptr == '>') `123
X`009yylval.nodetypeval = Node_redirect_append;
X`009lexptr++;
X      `125 else`032
X        yylval.nodetypeval = Node_redirect_output;
X      return REDIRECT_OP;
X    `125
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_geq;
X      lexptr++;
X      return RELOP;
X    `125
X    yylval.nodetypeval=Node_greater;
X    return RELOP;
X
X  case '`126':
X    yylval.nodetypeval=Node_match;
X    return MATCHOP;
X
V  case '`125':`009`009/* JF added did newline stuff.  Easier than hacking the g
Xrammar */
X    if(did_newline) `123
X      did_newline=0;
X      return c;
X    `125
X    did_newline++;
X    --lexptr;
X    return NEWLINE;
X
X  case '"':
X    while (*lexptr != '\0') `123
X      switch (*lexptr++) `123
X      case '\\':
X`009if (*lexptr++ != '\0')
X`009  break;
X`009/* fall through */
X      case '\n':
X`009yyerror ("unterminated string");
X`009return ERROR;
X      case '\"':
X`009yylval.sval = tokstart + 1;`009/* JF Skip the doublequote */
X`009++want_concat_token;
X`009return YSTRING;
X      `125
X    `125
X    return ERROR;`009/* JF this was one level up, wrong? */
X
X  case '-':
X    if(*lexptr=='=') `123
X      yylval.nodetypeval=Node_assign_minus;
X      lexptr++;
X      return ASSIGNOP;
X    `125
X    if(*lexptr=='-') `123
X      yylval.nodetypeval=Node_illegal;
X      lexptr++;
X      return DECREMENT;
X    `125
X    /* JF I think space tab comma and newline are the legal places for
X       a UMINUS.  Have I missed any? */
X    if((!isdigit(*lexptr) && *lexptr!='.') `124`124 (lexptr>lexptr_begin+1 &&
X !index(" \t,\n",lexptr[-2]))) `123
X    /* set node type to ILLEGAL because the action should set it to
X       the right thing */
X      yylval.nodetypeval = Node_illegal;
X      return c;
X    `125
X  `009/* FALL through into number code */
X  case '0':
X  case '1':
X  case '2':
X  case '3':
X  case '4':
X  case '5':
X  case '6':
X  case '7':
X  case '8':
X  case '9':
X  case '.':
X    /* It's a number */
X    if(c=='-') namelen=1;
X    else namelen=0;
X    for (; (c = tokstart[namelen]) != '\0'; namelen++) `123
X      switch (c) `123
X      case '.':
X`009if (seen_point)
X`009  goto got_number;
X`009++seen_point;
X`009break;
X      case 'e':
X      case 'E':
X`009if (seen_e)
X`009  goto got_number;
X`009++seen_e;
X`009if (tokstart[namelen+1] == '-' `124`124 tokstart[namelen+1] == '+')
X`009  namelen++;
X`009break;
X      case '0': case '1': case '2': case '3': case '4':`032
X      case '5': case '6': case '7': case '8': case '9':`032
X`009break;
X      default:
X`009goto got_number;
X      `125
X    `125
X
Xgot_number:
X    lexptr = tokstart + namelen;
X    yylval.fval = atof(tokstart);
X    ++want_concat_token;
X    return NUMBER;
X
X  case '&':
X    if(*lexptr=='&') `123
X      yylval.nodetypeval=Node_and;
X      lexptr++;
X      return LEX_AND;
X    `125
X    return ERROR;
X
X  case '`124':
X    if(want_redirect) `123
X      lexptr++;
X      yylval.nodetypeval = Node_redirect_pipe;
X      return REDIRECT_OP;
X    `125
X    if(*lexptr=='`124') `123
X      yylval.nodetypeval=Node_or;
X      lexptr++;
X      return LEX_OR;
X    `125
X    return ERROR;
X  `125
X `032
X  if (!isalpha(c)) `123
X    yyerror ("Invalid char '%c' in expression\n", c);
X    return ERROR;
X  `125
X
X  /* its some type of name-type-thing.  Find its length */
X  for (namelen = 0; is_identchar(tokstart[namelen]); namelen++)
X    ;
X
X
X  /* See if it is a special token.  */
X  for (toktab = tokentab; toktab->operator != NULL; toktab++) `123
X    if(*tokstart==toktab->operator[0] &&
X       !strncmp(tokstart,toktab->operator,namelen) &&
X       toktab->operator[namelen]=='\0') `123
X      lexptr=tokstart+namelen;
X      if(toktab->class == LEX_BUILTIN)
X        yylval.ptrval = toktab->ptr;
X      else
X        yylval.nodetypeval = toktab->value;
X      return toktab->class;
X    `125
X  `125
X
X  /* It's a name.  See how long it is.  */
X  yylval.sval = tokstart;
X  lexptr = tokstart+namelen;
X  ++want_concat_token;
X  return NAME;
X`125
X
X/*VARARGS1*/
Xyyerror (mesg,a1,a2,a3,a4,a5,a6,a7,a8)
X     char *mesg;
X`123
X  register char *ptr,*beg;
X
X`009/* Find the current line in the input file */
X  if(!lexptr) `123
X    beg="(END OF FILE)";
X    ptr=beg+13;
X  `125 else `123
X    if (*lexptr == '\n' && lexptr!=lexptr_begin)
X      --lexptr;
X    for (beg = lexptr;beg!=lexptr_begin && *beg != '\n';--beg)
X      ;
X    for (ptr = lexptr;*ptr && *ptr != '\n';ptr++) /*jfw: NL isn't guaranteed*/
X      ;
X    if(beg!=lexptr_begin)
X      beg++;
X  `125
X  fprintf (stderr, "Error near line %d,  '%.*s'\n",lineno, ptr-beg, beg);
X  /* figure out line number, etc. later */
X  fprintf (stderr, mesg, a1, a2, a3, a4, a5, a6, a7, a8);
X  fprintf (stderr,"\n");
X  exit (1);
X`125
X
X/* Parse a C escape sequence.  STRING_PTR points to a variable
X   containing a pointer to the string to parse.  That pointer
X   is updated past the characters we use.  The value of the
X   escape sequence is returned.
X
X   A negative value means the sequence \ newline was seen,
X   which is supposed to be equivalent to nothing at all.
X
X   If \ is followed by a null character, we return a negative
X   value and leave the string pointer pointing at the null character.
X
X   If \ is followed by 000, we return 0 and leave the string pointer
X   after the zeros.  A value of 0 does not mean end of string.  */
X
Xstatic int
Xparse_escape (string_ptr)
X     char **string_ptr;
X`123
X  register int c = *(*string_ptr)++;
X  switch (c)
X    `123
X    case 'a':
X      return '\a';
X    case 'b':
X      return '\b';
X    case 'e':
X      return 033;
X    case 'f':
X      return '\f';
X    case 'n':
X      return '\n';
X    case 'r':
X      return '\r';
X    case 't':
X      return '\t';
X    case 'v':
X      return '\v';
X    case '\n':
X      return -2;
X    case 0:
X      (*string_ptr)--;
X      return 0;
X    case '`094':
X      c = *(*string_ptr)++;
X      if (c == '\\')
X`009c = parse_escape (string_ptr);
X      if (c == '?')
X`009return 0177;
X      return (c & 0200) `124 (c & 037);
X     `032
X    case '0':
X    case '1':
X    case '2':
X    case '3':
X    case '4':
X    case '5':
X    case '6':
X    case '7':
X      `123
X`009register int i = c - '0';
X`009register int count = 0;
X`009while (++count < 3)
X`009  `123
X`009    if ((c = *(*string_ptr)++) >= '0' && c <= '7')
X`009      `123
X`009`009i *= 8;
X`009`009i += c - '0';
X`009      `125
X`009    else
X`009      `123
X`009`009(*string_ptr)--;
X`009`009break;
X`009      `125
X`009  `125
X`009return i;
X      `125
X    default:
X      return c;
X    `125
X`125
$ GOSUB UNPACK_FILE
$ FILE_IS = "BCMP.MAR"
$ CHECKSUM_IS = 24650371
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.TITLE`009BCMP`009Compare 2 strings of bytes
X`009.IDENT`009/1.00/
X
X
X
X`009.PSECT`009$CODE,LONG,PIC,REL,SHR,EXE,RD,NOWRT
X
X; bcmp(s1, s2, n)
X
X`009.ENTRY`009BCMP,`094M<R2,R3,R4,R5>
X`009MOVL`0094(AP),R1
X`009MOVL`0098(AP),R3
X`009MOVL`00912(AP),R4
X1$:
X`009MOVZWL`009#65535,R0
X`009CMPL`009R4,R0
X`009BLEQ`0092$
X`009SUBL2`009R0,R4
X`009CMPC3`009R0,(R1),(R3)
X`009BEQL`0091$
X`009ADDL2`009R4,R0
X`009RET
X2$:
X`009CMPC3`009R4,(R1),(R3)
X`009RET
X
X`009.END
$ GOSUB UNPACK_FILE
$ FILE_IS = "BCOPY.MAR"
$ CHECKSUM_IS = 136364532
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.TITLE`009BCOPY`009Copy bytes from one array to another
X`009.IDENT`009/1.00/
X
X`009.PSECT`009$CODE,LONG,PIC,REL,SHR,EXE,RD,NOWRT
X
X; bcopy(from, to, size)
X
X`009.ENTRY`009BCOPY,`094M<R2,R3,R4,R5,R6>
X`009MOVL`0094(AP),R1
X`009MOVL`0098(AP),R3
X`009MOVL`00912(AP),R6
X`009CMPL`009R1,R3
X`009BGTR`0092$`009`009; NORMAL FORWARD CASE
X`009BLSS`0093$`009`009; OVERLAPPING, MUST DO BACKWARDS
X`009RET`009`009`009; EQUAL, NOTHING TO DO
X1$:
X`009SUBL2`009R0,R6
X`009MOVC3`009R0,(R1),(R3)
X2$:
X`009MOVZWL`009#65535,R0
X`009CMPL`009R6,R0
X`009BGTR`0091$
X`009MOVC3`009R6,(R1),(R3)
X`009RET
X3$:
X`009ADDL2`009R6,R1
X`009ADDL2`009R6,R3
X`009MOVZWL`009#65535,R0
X`009BRW`0095$
X4$:
X`009SUBL2`009R0,R6
X`009SUBL2`009R0,R1
X`009SUBL2`009R0,R3
X`009MOVC3`009R0,(R1),(R3)
X`009MOVZWL`009#65535,R0
X`009SUBL2`009R0,R1
X`009SUBL2`009R0,R3
X5$:
X`009CMPL`009R6,R0
X`009BGTR`0094$
X`009SUBL2`009R6,R1
X`009SUBL2`009R6,R3
X`009MOVC3`009R6,(R1),(R3)
X`009RET
X
X`009.END
$ GOSUB UNPACK_FILE
$ FILE_IS = "BZERO.MAR"
$ CHECKSUM_IS = 137252688
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.TITLE`009BZERO`009Zero out an array of bytes
X`009.IDENT`009/1.00/
X
X`009.PSECT`009$CODE,LONG,PIC,REL,SHR,EXE,RD,NOWRT
X
X; bzero(ptr, size)
X
X`009.ENTRY`009BZERO,`094M<R2,R3,R4,R5>
X`009MOVL`0094(AP),R3
X`009BRB`0092$
X1$:
X`009SUBL2`009R0,8(AP)
X`009MOVC5`009#0,(R3),#0,R0,(R3)
X2$:
X`009MOVZWL`009#65535,R0
X`009CMPL`0098(AP),R0
X`009BGTR`0091$
X`009MOVC5`009#0,(R3),#0,8(AP),(R3)
X`009RET
X
X`009.END
$ GOSUB UNPACK_FILE
$ FILE_IS = "CLINK.OPT"
$ CHECKSUM_IS = 1392527948
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
Xsys$share:vaxcrtl.exe/share
$ GOSUB UNPACK_FILE
$ FILE_IS = "COPYING."
$ CHECKSUM_IS = 1850371236
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X
X`009`009    GAWK GENERAL PUBLIC LICENSE
X`009`009    (Clarified 11 Feb 1988)
X
X Copyright (C) 1988 Richard M. Stallman
X Everyone is permitted to copy and distribute verbatim copies
X of this license, but changing it is not allowed.  You can also
X use this wording to make the terms for other programs.
X
X  The license agreements of most software companies keep you at the
Xmercy of those companies.  By contrast, our general public license is
Xintended to give everyone the right to share GAWK.  To make sure that
Xyou get the rights we want you to have, we need to make restrictions
Xthat forbid anyone to deny you these rights or to ask you to surrender
Xthe rights.  Hence this license agreement.
X
X  Specifically, we want to make sure that you have the right to give
Xaway copies of GAWK, that you receive source code or else can get it
Xif you want it, that you can change GAWK or use pieces of it in new
Xfree programs, and that you know you can do these things.
X
X  To make sure that everyone has such rights, we have to forbid you to
Xdeprive anyone else of these rights.  For example, if you distribute
Xcopies of GAWK, you must give the recipients all the rights that you
Xhave.  You must make sure that they, too, receive or can get the
Xsource code.  And you must tell them their rights.
X
X  Also, for our own protection, we must make certain that everyone
Xfinds out that there is no warranty for GAWK.  If GAWK is modified by
Xsomeone else and passed on, we want its recipients to know that what
Xthey have is not what we distributed, so that any problems introduced
Xby others will not reflect on our reputation.
X
X  Therefore we (Richard Stallman and the Free Software Foundation,
XInc.) make the following terms which say what you must do to be
Xallowed to distribute or change GAWK.
X
X
X`009`009`009COPYING POLICIES
X
X  1. You may copy and distribute verbatim copies of GAWK source code as
Xyou receive it, in any medium, provided that you conspicuously and
Xappropriately publish on each copy a valid copyright notice "Copyright
X(C) 1988 Free Software Foundation, Inc." (or with whatever year is
Xappropriate); keep intact the notices on all files that refer to this
XLicense Agreement and to the absence of any warranty; and give any
Xother recipients of the GAWK program a copy of this License
XAgreement along with the program.  You may charge a distribution
Xfee for the physical act of transferring a copy.
X
X  2. You may modify your copy or copies of GAWK or any portion of it,
Xand copy and distribute such modifications under the terms of
XParagraph 1 above, provided that you also do the following:
X
X    a) cause the modified files to carry prominent notices stating
X    that you changed the files and the date of any change; and
X
X    b) cause the whole of any work that you distribute or publish,
X    that in whole or in part contains or is a derivative of GAWK or
X    any part thereof, to be licensed at no charge to all third
X    parties on terms identical to those contained in this License
X    Agreement (except that you may choose to grant more extensive
X    warranty protection to third parties, at your option).
X
X    c) You may charge a distribution fee for the physical act of
X    transferring a copy, and you may at your option offer warranty
X    protection in exchange for a fee.
X
XMere aggregation of another unrelated program with this program (or its
Xderivative) on a volume of a storage or distribution medium does not bring
Xthe other program under the scope of these terms.
X
X  3. You may copy and distribute GNU CC (or a portion or derivative of it,
Xunder Paragraph 2) in object code or executable form under the terms of
XParagraphs 1 and 2 above provided that you also do one of the following:
X
X    a) accompany it with the complete corresponding machine-readable
X    source code, which must be distributed under the terms of
X    Paragraphs 1 and 2 above; or,
X
X    b) accompany it with a written offer, valid for at least three
X    years, to give any third party free (except for a nominal
X    shipping charge) a complete machine-readable copy of the
X    corresponding source code, to be distributed under the terms of
X    Paragraphs 1 and 2 above; or,
X
X    c) accompany it with the information you received as to where the
X    corresponding source code may be obtained.  (This alternative is
X    allowed only for noncommercial distribution and only if you
X    received the program in object code or executable form alone.)
X
XFor an executable file, complete source code means all the source code for
Xall modules it contains; but, as a special exception, it need not include
Xsource code for modules which are standard libraries that accompany the
Xoperating system on which the executable file runs.
X
X  4. You may not copy, sublicense, distribute or transfer GAWK
Xexcept as expressly provided under this License Agreement.  Any attempt
Xotherwise to copy, sublicense, distribute or transfer GAWK is void and
Xyour rights to use the program under this License agreement shall be
Xautomatically terminated.  However, parties who have received computer
Xsoftware programs from you with this License Agreement will not have
Xtheir licenses terminated so long as such parties remain in full compliance.
X
X  5. If you wish to incorporate parts of GAWK into other free
Xprograms whose distribution conditions are different, write to the Free
XSoftware Foundation at 675 Mass Ave, Cambridge, MA 02139.  We have not yet
Xworked out a simple rule that can be stated here, but we will often permit
Xthis.  We will be guided by the two goals of preserving the free status of
Xall derivatives of our free software and of promoting the sharing and reuse
Xof software.
X
X
XYour comments and suggestions about our licensing policies and our
Xsoftware are welcome!  Please contact the Free Software Foundation, Inc.,
X675 Mass Ave, Cambridge, MA 02139, or call (617) 876-3296.
X
X`009`009       NO WARRANTY
X
X  BECAUSE GAWK IS LICENSED FREE OF CHARGE, WE PROVIDE ABSOLUTELY NO
XWARRANTY, TO THE EXTENT PERMITTED BY APPLICABLE STATE LAW.  EXCEPT
XWHEN OTHERWISE STATED IN WRITING, FREE SOFTWARE FOUNDATION, INC,
XRICHARD M. STALLMAN AND/OR OTHER PARTIES PROVIDE GAWK "AS IS" WITHOUT
XWARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT
XLIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
XA PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND
XPERFORMANCE OF GAWK IS WITH YOU.  SHOULD GAWK PROVE DEFECTIVE, YOU
XASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
X
X IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW WILL RICHARD M.
XSTALLMAN, THE FREE SOFTWARE FOUNDATION, INC., AND/OR ANY OTHER PARTY
XWHO MAY MODIFY AND REDISTRIBUTE GAWK AS PERMITTED ABOVE, BE LIABLE TO
XYOU FOR DAMAGES, INCLUDING ANY LOST PROFITS, LOST MONIES, OR OTHER
XSPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR
XINABILITY TO USE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA
XBEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD PARTIES OR A
XFAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS) GAWK, EVEN
XIF YOU HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES, OR FOR
XANY CLAIM BY ANY OTHER PARTY.
$ GOSUB UNPACK_FILE
$ FILE_IS = "DEBUG.C"
$ CHECKSUM_IS = 203246152
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X   Debug.c -- Various debugging routines
X
X   Copyright (C) 1986 Free Software Foundation
X     Written by Jay Fenlason, December 1986
X
X */
X
X/*
XGAWK is distributed in the hope that it will be useful, but WITHOUT ANY
XWARRANTY.  No author or distributor accepts responsibility to anyone
Xfor the consequences of using it or for whether it serves any
Xparticular purpose or works at all, unless he says so in writing.
XRefer to the GAWK General Public License for full details.
X
XEveryone is granted permission to copy, modify and redistribute GAWK,
Xbut only under the conditions described in the GAWK General Public
XLicense.  A copy of this license is supposed to have been given to you
Xalong with GAWK so you can know your rights and responsibilities.  It
Xshould be in a file named COPYING.  Among other things, the copyright
Xnotice and this notice must be preserved on all copies.
X
XIn other words, go ahead and share GAWK, but don't try to stop
Xanyone else from sharing it farther.  Help stamp out software hoarding!
X*/
X#include "awk.h"
X#include <stdio.h>
X
X#ifndef FAST
X
Xextern NODE **fields_arr;
Xextern f_arr_siz;
X
X
X/* This is all debugging stuff.  Ignore it and maybe it'll go away. */
X
X/* Some of it could be turned into a really cute trace command, if anyone
X   wants to.  */
Xchar *nnames[] = `123
X`009"Illegal Node",
X`009"Times",`009"Divide",`009"Mod",`009`009"Plus",`009`009"Minus",
X`009"Cond-pair" /* jfw */,`009"Subscript",`009"Concat",
X`009"++Pre",`009"--Pre",`009"Post++",
X`009"Post--",`009"Uminus",`009"Field",
X`009"Assign",`009"*=",`009`009"/=",`009`009"%=",
X`009"+=",`009`009"-=",
X`009"And",`009`009"Or",
X`009"Equal",`009"!=",`009`009"Less",`009`009"Greater",`009"<=",`009`009">=",
X`009"Not",
X`009"Match",`009"Nomatch",
X`009"String",`009"TmpString",`009"Number",
V`009"Rule_list",`009"Rule_node",`009"State_list",`009"If_branches",`009"Exp_lis
Xt",
X`009"BEGIN",`009"END",`009`009"IF",`009`009"WHILE",`009"FOR",
X`009"arrayfor",`009"BREAK",`009"CONTINUE",`009"PRINT",`009"PRINTF",
X`009"next",`009`009"exit",`009`009"redirect",`009"Append",
X`009"Pipe",`009`009"variable",`009"Varray",`009"builtin",
X`009"Line-range" /*jfw*/,
X`125;
X
Xptree(n)
X`123
X`009print_parse_tree((NODE *)n);
X`125
X
Xpt()
X`123
X`009int x;
X`009scanf("%x",&x);
X`009printf("0x%x\n",x);
X`009print_parse_tree((NODE *)x);
X`009fflush(stdout);
X`125
X
Xstatic depth = 0;
Xprint_parse_tree(ptr)
XNODE *ptr;
X`123
X`009register int n;
X
X`009if(!ptr) `123
X`009`009printf("NULL\n");
X`009`009return;
X`009`125
V`009if((int)(ptr->type)<0 `124`124 (int)(ptr->type)>sizeof(nnames)/sizeof(nname
Xs[0])) `123
X`009`009printf("(0x%x Type %d??)\n",ptr,ptr->type);
X`009`009return;
X`009`125
X`009printf("(%d)%*s",depth,depth,"");
X`009switch((int)ptr->type) `123
X`009case (int)Node_string:
X`009case (int)Node_temp_string:
X`009`009printf("(0x%x String \"%.*s\")\n",ptr,ptr->stlen,ptr->stptr);
X`009`009return;
X`009case (int)Node_number:
X`009`009printf("(0x%x Number %g)\n",ptr,ptr->numbr);
X`009`009return;
X`009case (int)Node_var_array:
X`009`009printf("(0x%x Array of %d)\n",ptr,ptr->arrsiz);
X`009`009for(n=0;n<ptr->arrsiz;n++) `123
X`009`009`009printf("'");
X`009`009`009print_simple((ptr->array)[n*2],stdout);
X`009`009`009printf("' is '");
X`009`009`009print_simple((ptr->array)[n*2+1],stdout);
X`009`009`009printf("'\n");
X`009`009`125
X`009`009return;
X`009`125
X`009if(ptr->lnode) printf("0x%x = left<--",ptr->lnode);
X`009printf("(0x%x %s.%d)",ptr,nnames[(int)(ptr->type)],ptr->type);
X`009if(ptr->rnode) printf("-->right = 0x%x",ptr->rnode);
X`009printf("\n");
X`009depth++;
X`009if(ptr->lnode)
X`009`009print_parse_tree(ptr->lnode);
X`009switch((int)ptr->type) `123
X`009case (int)Node_line_range:`009/* jfw */
X`009case (int)Node_match:
X`009case (int)Node_nomatch:
X`009`009break;
X`009case (int)Node_builtin:
X`009`009printf("Builtin: %d\n",ptr->proc);`009/* jfw: was \N */
X`009`009break;
X`009case (int)Node_K_for:
X`009case (int)Node_K_arrayfor:
X`009`009printf("(%s:)\n",nnames[(int)(ptr->type)]);
X`009`009print_parse_tree(ptr->forloop->init);
X`009`009printf("looping:\n");
X`009`009print_parse_tree(ptr->forloop->cond);
X`009`009printf("doing:\n");
X`009`009print_parse_tree(ptr->forloop->incr);
X`009`009break;
X`009default:
X`009`009if(ptr->rnode)
X`009`009`009print_parse_tree(ptr->rnode);
X`009`009break;
X`009`125
X`009--depth;
X`125
X#endif
X
X#ifndef FAST
X/*
X * print out all the variables in the world
X */
X
Xdump_vars()
X`123
X  register int n;
X  register HASHNODE *buc;
X
X  printf("Fields:");
X  dump_fields();
X  printf("Vars:\n");
X  for(n=0;n<HASHSIZE;n++) `123
X    for(buc=variables[n];buc;buc=buc->next) `123
X      printf("'%.*s': ",buc->length,buc->name);
X      print_simple(buc->value->var_value,stdout);
X      printf(":");
X      print_parse_tree(buc->value->lnode);
X      /* print_parse_tree(buc->value); */
X    `125
X  `125
X  printf("End\n");
X`125
X#endif
X
X#ifndef FAST
Xdump_fields()
X`123
X`009register NODE`009**p;
X`009register int`009n;
X
X`009printf("%d fields\n",f_arr_siz);
X`009for(n=0,p= &fields_arr[0];n<f_arr_siz;n++,p++) `123
X`009`009printf("$%d is '",n);
X`009`009print_simple(*p,stdout);
X`009`009printf("'\n");
X`009`125
X`125
X#endif
X
X#ifndef FAST
X/*VARARGS1*/
Xprint_debug(str,n)
Xchar *str;
X`123
X`009extern int debugging;
X
X`009if(debugging)
X`009`009printf("%s:%d\n",str,n);
X`125
X
Xint indent = 0;
X
Xprint_a_node(ptr)
XNODE *ptr;
X`123
X`009NODE *p1;
X`009char *str,*str2;
X`009int n;
X`009HASHNODE *buc;
X
X`009if(!ptr) return;`009/* don't print null ptrs */
X`009switch(ptr->type) `123
X`009case Node_number:
X`009`009printf("%g",ptr->numbr);
X`009`009return;
X`009case Node_string:
X`009`009printf("\"%.*s\"",ptr->stlen,ptr->stptr);
X`009`009return;
X`009case Node_times:
X`009`009str="*";
X`009`009goto pr_twoop;
X`009case Node_quotient:
X`009`009str="/";
X`009`009goto pr_twoop;
X`009case Node_mod:
X`009`009str="%";
X`009`009goto pr_twoop;
X`009case Node_plus:
X`009`009str="+";
X`009`009goto pr_twoop;
X`009case Node_minus:
X`009`009str="-";
X`009`009goto pr_twoop;
X`009case Node_concat:
X`009`009str=" ";
X`009`009goto pr_twoop;
X`009case Node_assign:
X`009`009str="=";
X`009`009goto pr_twoop;
X`009case Node_assign_times:
X`009`009str="*=";
X`009`009goto pr_twoop;
X`009case Node_assign_quotient:
X`009`009str="/=";
X`009`009goto pr_twoop;
X`009case Node_assign_mod:
X`009`009str="%=";
X`009`009goto pr_twoop;
X`009case Node_assign_plus:
X`009`009str="+=";
X`009`009goto pr_twoop;
X`009case Node_assign_minus:
X`009`009str="-=";
X`009`009goto pr_twoop;
X`009case Node_and:
X`009`009str="&&";
X`009`009goto pr_twoop;
X`009case Node_or:
X`009`009str="`124`124";
X`009`009goto pr_twoop;
X`009case Node_equal:
X`009`009str="==";
X`009`009goto pr_twoop;
X`009case Node_notequal:
X`009`009str="!=";
X`009`009goto pr_twoop;
X`009case Node_less:
X`009`009str="<";
X`009`009goto pr_twoop;
X`009case Node_greater:
X`009`009str=">";
X`009`009goto pr_twoop;
X`009case Node_leq:
X`009`009str="<=";
X`009`009goto pr_twoop;
X`009case Node_geq:
X`009`009str=">=";
X`009`009goto pr_twoop;
X
X pr_twoop:
X `009`009print_a_node(ptr->lnode);
X`009`009printf("%s",str);
X`009`009print_a_node(ptr->rnode);
X`009`009return;
X
X`009case Node_not:
X`009`009str="!";
X`009`009str2="";
X`009`009goto pr_oneop;
X`009case Node_field_spec:
X`009`009str="$(";
X`009`009str2=")";
X`009`009goto pr_oneop;
X`009case Node_postincrement:
X`009`009str="";
X`009`009str2="++";
X`009`009goto pr_oneop;
X`009case Node_postdecrement:
X`009`009str="";
X`009`009str2="--";
X`009`009goto pr_oneop;
X`009case Node_preincrement:
X`009`009str="++";
X`009`009str2="";
X`009`009goto pr_oneop;
X`009case Node_predecrement:
X`009`009str="--";
X`009`009str2="";
X`009`009goto pr_oneop;
X pr_oneop:
X`009`009printf(str);
X`009`009print_a_node(ptr->subnode);
X`009`009printf(str2);
X`009`009return;
X
X`009case Node_expression_list:
X`009`009print_a_node(ptr->lnode);
X`009`009if(ptr->rnode) `123
X`009`009`009printf(",");
X`009`009`009print_a_node(ptr->rnode);
X`009`009`125
X`009`009return;
X
X`009case Node_var:
X`009`009for(n=0;n<HASHSIZE;n++) `123
X`009`009`009for(buc=variables[n];buc;buc=buc->next) `123
X`009`009`009`009if(buc->value==ptr) `123
X`009`009`009`009`009printf("%.*s",buc->length,buc->name);
X`009`009`009`009`009n=HASHSIZE;
X`009`009`009`009`009break;
X`009`009`009`009`125
X`009`009`009`125
X`009`009`125
X`009`009return;
X`009case Node_subscript:
X`009`009print_a_node(ptr->lnode);
X`009`009printf("[");
X`009`009print_a_node(ptr->rnode);
X`009`009printf("]");
X`009`009return;
X`009case Node_builtin:
X`009`009printf("some_builtin(");
X`009`009print_a_node(ptr->subnode);
X`009`009printf(")");
X`009`009return;
X
X`009case Node_statement_list:
X`009`009printf("`123\n");
X`009`009indent++;
X`009`009for(n=indent;n;--n)
X`009`009`009printf("  ");
X`009`009while(ptr) `123
X`009`009`009print_maybe_semi(ptr->lnode);
X`009`009`009if(ptr->rnode)
X`009`009`009`009for(n=indent;n;--n)
X`009`009`009`009`009printf("  ");
X`009`009`009ptr=ptr->rnode;
X`009`009`125
X`009`009--indent;
X`009`009for(n=indent;n;--n)
X`009`009`009printf("  ");
X`009`009printf("`125\n");
X`009`009for(n=indent;n;--n)
X`009`009`009printf("  ");
X`009`009return;
X
X`009case Node_K_if:
X`009`009printf("if(");
X`009`009print_a_node(ptr->lnode);
X`009`009printf(") ");
X`009`009ptr=ptr->rnode;
X`009`009if(ptr->lnode->type==Node_statement_list) `123
X`009`009`009printf("`123\n");
X`009`009`009indent++;
X`009`009`009for(p1=ptr->lnode;p1;p1=p1->rnode) `123
X`009`009`009`009for(n=indent;n;--n)
X`009`009`009`009`009printf("  ");
X`009`009`009`009print_maybe_semi(p1->lnode);
X`009`009`009`125
X`009`009`009--indent;
X`009`009`009for(n=indent;n;--n)
X`009`009`009`009printf("  ");
X`009`009`009if(ptr->rnode) `123
X`009`009`009`009printf("`125 else ");
X`009`009`009`125 else `123
X`009`009`009`009printf("`125\n");
X`009`009`009`009return;
X`009`009`009`125
X`009`009`125 else `123
X`009`009`009print_maybe_semi(ptr->lnode);
X`009`009`009if(ptr->rnode) `123
X`009`009`009`009for(n=indent;n;--n)
X`009`009`009`009`009printf("  ");
X`009`009`009`009printf("else ");
X`009`009`009`125 else return;
X`009`009`125
X`009`009if(!ptr->rnode) return;
X`009`009deal_with_curls(ptr->rnode);
X`009`009return;
X
X`009case Node_K_for:
X`009`009printf("for(");
X`009`009print_a_node(ptr->forloop->init);
X`009`009printf(";");
X`009`009print_a_node(ptr->forloop->cond);
X`009`009printf(";");
X`009`009print_a_node(ptr->forloop->incr);
X`009`009printf(") ");
X`009`009deal_with_curls(ptr->forsub);
X`009`009return;
X`009case Node_K_arrayfor:
X`009`009printf("for(");
X`009`009print_a_node(ptr->forloop->init);
X`009`009printf(" in ");
X`009`009print_a_node(ptr->forloop->incr);
X`009`009printf(") ");
X`009`009deal_with_curls(ptr->forsub);
X`009`009return;
X
X`009case Node_K_printf:
X`009`009printf("printf(");
X`009`009print_a_node(ptr->lnode);
X`009`009printf(")");
X`009`009return;
X`009case Node_K_print:
X`009`009printf("print(");
X`009`009print_a_node(ptr->lnode);
X`009`009printf(")");
X`009`009return;
X`009case Node_K_next:
X`009`009printf("next");
X`009`009return;
X`009case Node_K_break:
X`009`009printf("break");
X`009`009return;
X`009default:
X`009`009print_parse_tree(ptr);
X`009`009return;
X`009`125
X`125
X
Xprint_maybe_semi(ptr)
XNODE *ptr;
X`123
X`009print_a_node(ptr);
X`009switch(ptr->type) `123
X`009case Node_K_if:
X`009case Node_K_for:
X`009case Node_K_arrayfor:
X`009case Node_statement_list:
X`009`009break;
X`009default:
X`009`009printf(";\n");
X`009`009break;
X`009`125
X`125
Xdeal_with_curls(ptr)
XNODE *ptr;
X`123
X`009int n;
X
X`009if(ptr->type==Node_statement_list) `123
X`009`009printf("`123\n");
X`009`009indent++;
X`009`009while(ptr) `123
X`009`009`009for(n=indent;n;--n)
X`009`009`009`009printf("  ");
X`009`009`009print_maybe_semi(ptr->lnode);
X`009`009`009ptr=ptr->rnode;
X`009`009`125
X`009`009--indent;
X`009`009for(n=indent;n;--n)
X`009`009`009printf("  ");
X`009`009printf("`125\n");
X`009`125 else `123
X`009`009print_maybe_semi(ptr);
X`009`125
X`125
X
XNODE *
Xdo_prvars()
X`123
X`009dump_vars();
X`009return Nnull_string;
X`125
X
XNODE *
Xdo_bp()
X`123
X`009return Nnull_string;
X`125
X
X#endif
$ GOSUB UNPACK_FILE
$ FILE_IS = "MAKE-GAWK.COM"
$ CHECKSUM_IS = 1398514891
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$`009DEFINE VAXC$INCLUDE 'F$ENVIRONMENT("DEFAULT")',SYS$LIBRARY/nolog
X$`009IF`009F$SEARCH (F$PARSE ("GCCLIB", "GCCLIB.OLB")) .NES. "" -
X`009THEN`009GOTO LibOk
X$`009IF`009F$SEARCH ("[]ALLOCA.MAR") .EQS. "" -
X`009THEN`009GOTO NoWay
X$`009MACRO`009ALLOCA.MAR
X$`009MACRO`009BZERO.MAR
X$`009MACRO`009BCMP.MAR
X$`009MACRO`009BCOPY.MAR
X$`009LIBRARY/CREATE []GCCLIB ALLOCA,BZERO,BCMP,BCOPY
X$`009DELETE`009ALLOCA.OBJ;
X$`009DELETE`009BZERO.OBJ;
X$`009DELETE`009BCMP.OBJ;
X$`009DELETE`009BCOPY.OBJ;
X$`009GOTO LibOk
X$ No_Way:
X$`009TYPE SYS$INPUT
X
X`009I can't seem to find GCCLIB.  Please define the logical GCCLIB to point
Xto that library.  It comes from the VMS bootstrap tape.  You need it for
Xsome of the berekely-isms that gawk uses.
X
X$`009EXIT
X$ LibOk:
X$`009IF`009P1 .EQS. "LINK" -
X`009THEN`009GOTO LinkIt
X$`009mycc :== cc`009`009! Change to GCC for gcc.
X$`009mycc awk1
X$`009mycc awk2
X$`009mycc awk3
X$`009mycc awk_tab
X$`009mycc debug
X$`009mycc version
X$`009mycc regex
X$`009mycc obstack
X$`009mycc vms-port
X$ LinkIt:
X$`009LINK/exe=gawk awk1,awk2,awk3,awk_tab,debug,regex,obstack,vms-port,-
X`009`009gcclib/lib,[]clink/opt
X$
$ GOSUB UNPACK_FILE
$ FILE_IS = "MAKEFILE."
$ CHECKSUM_IS = 1781884173
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XLIB=.
X#CFLAGS=-O -pg -I$(LIB) -DFAST
XCFLAGS=-g -I$(LIB)
XLIBOBJS= $(LIB)/obstack.o $(LIB)/regex.o
XOBJS = awk1.o awk2.o awk3.o awk.tab.o debug.o version.o
Xgawk: $(OBJS) $(LIBOBJS)
X`009$(CC) -o gawk $(CFLAGS) $(OBJS) $(LIBOBJS) -lm
X$(OBJS): awk.h
Xawk.tab.c: awk.y
X`009bison -v awk.y
X#`009yacc -v awk.y
X#`009mv y.tab.c awk.tab.c
Xlint:
X`009lint -I$(LIB) awk.tab.c awk1.c awk2.c awk3.c
Xclean:
X`009rm -f gawk *.o core awk.output awk.tab.c
X
X# We don't distribute shar files, but they're useful for mailing.
XSHARS = COPYING Makefile README awk.h awk.tab.c awk.y awk1.c awk2.c awk3.c\
X debug.c obstack.h obstack.c regex.h regex.c version.c
X
Xawk.shar: $(SHARS)
X`009shar -f awk -c $(SHARS)
X
Xawk.tar: $(SHARS)
X`009tar cvf awk.tar $(SHARS)
X
Xawk.tar.Z:`009awk.tar
X`009-@mv awk.tar.Z awk.tar.old.Z
X`009compress < awk.tar > awk.tar.Z
X
X# This command probably won't be useful to the rest of the world, but makes
X# life much easier for me.
Xdist:`009awk.tar awk.tar.Z
$ GOSUB UNPACK_FILE
$ FILE_IS = "OBSTACK.C"
$ CHECKSUM_IS = 1998511744
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/* obstack.c - subroutines used implicitly by object stack macros
X   Copyright (c) 1986 Free Software Foundation, Inc.
X
X`009`009       NO WARRANTY
X
X  BECAUSE THIS PROGRAM IS LICENSED FREE OF CHARGE, WE PROVIDE ABSOLUTELY
XNO WARRANTY, TO THE EXTENT PERMITTED BY APPLICABLE STATE LAW.  EXCEPT
XWHEN OTHERWISE STATED IN WRITING, FREE SOFTWARE FOUNDATION, INC,
XRICHARD M. STALLMAN AND/OR OTHER PARTIES PROVIDE THIS PROGRAM "AS IS"
XWITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING,
XBUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
XFITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY
XAND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE PROGRAM PROVE
XDEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
XCORRECTION.
X
X IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW WILL RICHARD M.
XSTALLMAN, THE FREE SOFTWARE FOUNDATION, INC., AND/OR ANY OTHER PARTY
XWHO MAY MODIFY AND REDISTRIBUTE THIS PROGRAM AS PERMITTED BELOW, BE
XLIABLE TO YOU FOR DAMAGES, INCLUDING ANY LOST PROFITS, LOST MONIES, OR
XOTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
XUSE OR INABILITY TO USE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR
XDATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD PARTIES OR
XA FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS) THIS
XPROGRAM, EVEN IF YOU HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH
XDAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY.
X
X`009`009GENERAL PUBLIC LICENSE TO COPY
X
X  1. You may copy and distribute verbatim copies of this source file
Xas you receive it, in any medium, provided that you conspicuously and
Xappropriately publish on each copy a valid copyright notice "Copyright
X(C) 1986 Free Software Foundation, Inc."; and include following the
Xcopyright notice a verbatim copy of the above disclaimer of warranty
Xand of this License.
X
X  2. You may modify your copy or copies of this source file or
Xany portion of it, and copy and distribute such modifications under
Xthe terms of Paragraph 1 above, provided that you also do the following:
X
X    a) cause the modified files to carry prominent notices stating
X    that you changed the files and the date of any change; and
X
X    b) cause the whole of any work that you distribute or publish,
X    that in whole or in part contains or is a derivative of this
X    program or any part thereof, to be freely distributed
X    and licensed to all third parties on terms identical to those
X    contained in this License Agreement (except that you may choose
X    to grant more extensive warranty protection to third parties,
X    at your option).
X
X  3. You may copy and distribute this program or any portion of it in
Xcompiled, executable or object code form under the terms of Paragraphs
X1 and 2 above provided that you do the following:
X
X    a) cause each such copy to be accompanied by the
X    corresponding machine-readable source code, which must
X    be distributed under the terms of Paragraphs 1 and 2 above; or,
X
X    b) cause each such copy to be accompanied by a
X    written offer, with no time limit, to give any third party
X    free (except for a nominal shipping charge) a machine readable
X    copy of the corresponding source code, to be distributed
X    under the terms of Paragraphs 1 and 2 above; or,
X
X    c) in the case of a recipient of this program in compiled, executable
X    or object code form (without the corresponding source code) you
X    shall cause copies you distribute to be accompanied by a copy
X    of the written offer of source code which you received along
X    with the copy you received.
X
X  4. You may not copy, sublicense, distribute or transfer this program
Xexcept as expressly provided under this License Agreement.  Any attempt
Xotherwise to copy, sublicense, distribute or transfer this program is void and
Xyour rights to use the program under this License agreement shall be
Xautomatically terminated.  However, parties who have received computer
Xsoftware programs from you with this License Agreement will not have
Xtheir licenses terminated so long as such parties remain in full compliance.
X*/
X
X#include <obstack.h>
X
Xvoid
X_obstack_begin (h, chunkfun)
X     struct obstack *h;
X     int (*chunkfun) ();
X`123
X  register _Ll* chunk;`009`009/* points to new chunk */
X  chunk`009= h->chunk =
X    (_Ll*) (*chunkfun) (h->chunk_size);
X  h->next_free = h->object_base = chunk->obstack_l_0;
X  h->chunk_limit = chunk->obstack_l_limit
X   = (char *) chunk + h->chunk_size;
X  chunk->obstack_l_prev = 0;
X`125
X
X/* Allocate a new current chunk for the obstack *H
X   on the assumption that LENGTH bytes need to be added
X   to the current object, or a new object of length LENGTH allocated.
X   Copies any partial object from the end of the old chunk
X   to the beginning of the new one.  */
X
Xvoid
X_obstack_newchunk (h, chunkfun, length)
X     struct obstack *h;
X     int (*chunkfun) ();
X     int length;
X`123
X  register _Ll*`009old_chunk = h->chunk;
X  register _Ll*`009new_chunk;
X  register long`009new_size;
X  register int obj_size = h->next_free - h->object_base;
X
X  /* Compute size for new chunk.  */
X  new_size = (obj_size + length) << 1;
X  if (new_size < h->chunk_size)
X    new_size = h->chunk_size;
X
X  /* Allocate and initialize the new chunk.  */
X  new_chunk = h->chunk = (_Ll*) (*chunkfun) (new_size);
X  new_chunk->obstack_l_prev = old_chunk;
X  new_chunk->obstack_l_limit = h->chunk_limit = (char *) new_chunk + new_size;
X
X  /* Move the existing object to the new chunk.  */
X  bcopy (h->object_base, new_chunk->obstack_l_0, obj_size);
X  h->object_base = new_chunk->obstack_l_0;
X  h->next_free = h->object_base + obj_size;
X `125;
X
Xvoid
X_obstack_free (h, freechunkfun, obj)
X     struct obstack *h;
X     void (*freechunkfun) ();
X     char *obj;
X`123
X  register _Ll*  lp;`009/* below addr of any objects in this chunk */
X  register _Ll*  plp;`009/* point to previous chunk if any */
X
X  lp = (h)->chunk;
X  while (lp != 0 && ((char *)lp > obj `124`124 (h)->chunk_limit < obj))
X    `123
X      plp = lp -> obstack_l_prev;
X      (*freechunkfun) (lp);
X      if(lp==plp)
X      `009plp=0;
X      lp = plp;
X    `125
X  if (lp)
X    `123
X      (h)->object_base = (h)->next_free = (char *)(obj);
X      (h)->chunk_limit = lp->obstack_l_limit;
X      (h)->chunk = lp;
X    `125
X  else if (obj != 0)
X    /* obj is not in any of the chunks! */
X    abort ();
X`125
$ GOSUB UNPACK_FILE
$ FILE_IS = "OBSTACK.H"
$ CHECKSUM_IS = 1583611990
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/* obstack.h - object stack macros
X   Copyright (c) 1986 Free Software Foundation, Inc.
X
XSummary:
X
XAll the apparent functions defined here are macros. The idea
Xis that you would use these pre-tested macros to solve a
Xvery specific set of problems, and they would run fast.
XCaution: no side-effects in arguments please!! They may be
Xevaluated MANY times!!
X
XThese macros operate a stack of objects.  Each object starts life
Xsmall, and may grow to maturity.  (Consider building a word syllable
Xby syllable.)  An object can move while it is growing.  Once it has
Xbeen "finished" it never changes address again.  So the "top of the
Xstack" is typically an immature growing object, while the rest of the
Xstack is of mature, fixed size and fixed address objects.
X
XThese routines grab large chunks of memory, using a function you
Xsupply, called ``obstack_chunk_alloc'.  On occasion, they free chunks,
Xby calling ``obstack_chunk_free'.  You must define them and declare
Xthem before using any obstack macros.
X
XEach independent stack is represented by a ``struct obstack'.
XEach of the obstack macros expects a pointer to such a structure
Xas the first argument.
X
XOne motivation for this package is the problem of growing char strings
Xin symbol tables.  Unless you are "facist pig with a read-only mind"
X[Gosper's immortal quote from HAKMEM item 154, out of context] you
Xwould not like to put any arbitrary upper limit on the length of your
Xsymbols.
X
XIn practice this often means you will build many short symbols and a
Xfew long symbols.  At the time you are reading a symbol you don't know
Xhow long it is.  One traditional method is to read a symbol into a
Xbuffer, realloc()ating the buffer every time you try to read a symbol
Xthat is longer than the buffer.  This is beaut, but you still will
Xwant to copy the symbol from the buffer to a more permanent
Xsymbol-table entry say about half the time.
X
XWith obstacks, you can work differently.  Use one obstack for all symbol
Xnames.  As you read a symbol, grow the name in the obstack gradually.
XWhen the name is complete, finalize it.  Then, if the symbol exists already,
Xfree the newly read name.
X
XThe way we do this is to take a large chunk, allocating memory from
Xlow addresses.  When you want to build a aymbol in the chunk you just
Xadd chars above the current "high water mark" in the chunk.  When you
Xhave finished adding chars, because you got to the end of the symbol,
Xyou know how long the chars are, and you can create a new object.
XMostly the chars will not burst over the highest address of the chunk,
Xbecause you would typically expect a chunk to be (say) 100 times as
Xlong as an average object.
X
XIn case that isn't clear, when we have enough chars to make up
Xthe object, THEY ARE ALREADY CONTIGUOUS IN THE CHUNK (guaranteed)
Xso we just point to it where it lies.  No moving of chars is
Xneeded and this is the second win: potentially long strings need
Xnever be explicitly shuffled. Once an object is formed, it does not
Xchange its address during its lifetime.
X
XWhen the chars burst over a chunk boundary, we allocate a larger
Xchunk, and then copy the partly formed object from the end of the old
Xchunk to the beggining of the new larger chunk.  We then carry on
Xaccreting characters to the end of the object as we normaly would.
X
XA special macro is provided to add a single char at a time to a
Xgrowing object.  This allows the use of register variables, which
Xbreak the ordinary 'growth' macro.
X
XSummary:
X`009We allocate large chunks.
X`009We carve out one object at a time from the current chunk.
X`009Once carved, an object never moves.
X`009We are free to append data of any size to the currently
X`009  growing object.
X`009Exactly one object is growing in an obstack at any one time.
X`009You can run one obstack per control block.
X`009You may have as many control blocks as you dare.
X`009Because of the way we do it, you can ``unwind' a obstack
X`009  back to a previous state. (You may remove objects much
X`009  as you would with a stack.)
X*/
X`012
X#ifndef obstackH
X#define obstackH
X`009`009`009`009/* these #defines keep it brief */
X#define _Ll struct obstack_chunk
X#define _LL (8)`009`009`009/* _L length in chars */
X
Xstruct obstack_chunk`009`009/* Lives at front of each chunk. */
X`123
X  char  *obstack_l_limit;`009/* 1 past end of this chunk */
X  _Ll`009*obstack_l_prev;`009/* address of prior chunk or NULL */
X  char`009obstack_l_0[4];`009`009/* objects begin here */
X`125;
X
X#if 0
XThis function, called like malloc but not returning on failure,
Xmust return a chunk of the size given to it as argument,
Xaligned on a boundary of 2**OBSTACK_LOG_DEFAULT_ALIGNMENT bytes.
X
Xstruct obstack_chunk * obstack_chunk_alloc();
X#endif /* 0 */
X
Xstruct obstack`009`009/* control current object in current chunk */
X`123
X  long`009chunk_size;`009`009/* preferred size to allocate chunks in */
X  _Ll*`009chunk;`009`009`009/* address of current struct obstack_chunk */
X  char`009*object_base;`009`009/* address of object we are building */
X  char`009*next_free;`009`009/* where to add next char to current object */
X  char`009*chunk_limit;`009`009/* address of char after current chunk */
X  int`009temp;`009`009`009/* Temporary for some macros.  */
X  int   alignment_mask;`009`009/* Mask of alignment for each object. */
X`125;
X
X/* Pointer to beginning of object being allocated or to be allocated next.
X   Note that this might not be the final address of the object
X   because a new chunk might be needed to hold the final size.  */
X
X#define obstack_base(h) ((h)->object_base)
X
X/* Pointer to next byte not yet allocated in current chunk.  */
X
X#define obstack_next_free(h)`009((h)->next_free)
X
X/* Size of object currently growing */
X
X#define obstack_object_size(h)  ((h)->next_free - (h)->object_base)
X
X/* Mask specifying low bits that should be clear in address of an object.  */
X
X#define obstack_alignment_mask(h) ((h)->alignment_mask)
X`012
X#define obstack_init(h) obstack_begin (h, 4096 - 4 - _LL)
X
X#define obstack_begin(h,try_length)`009`009`009`009`009\
X((h)->chunk_size = (try_length) + (_LL),`009`009`009`009\
X (h)->alignment_mask = ((1 << 2) - 1),`009`009`009`009`009\
X _obstack_begin ((h), obstack_chunk_alloc))
X
X#define obstack_grow(h,where,length)`009`009`009`009`009\
X( (h)->temp = (length),`009`009`009`009`009`009`009\
X  (((h)->next_free + (h)->temp > (h)->chunk_limit)`009`009`009\
X   ? _obstack_newchunk ((h), obstack_chunk_alloc, (h)->temp) : 0),`009\
X  bcopy (where, (h)->next_free, (h)->temp),`009`009`009`009\
X  (h)->next_free += (h)->temp)
X
X#define obstack_grow0(h,where,length)`009`009`009`009`009\
X( (h)->temp = (length),`009`009`009`009`009`009`009\
X  (((h)->next_free + (h)->temp + 1 > (h)->chunk_limit)`009`009`009\
X   ? _obstack_newchunk ((h), obstack_chunk_alloc, (h)->temp + 1) : 0),`009\
X  bcopy (where, (h)->next_free, (h)->temp),`009`009`009`009\
X  (h)->next_free += (h)->temp,`009`009`009`009`009`009\
X  *((h)->next_free)++ = 0)
X
X#define obstack_1grow(h,datum)`009`009`009`009`009`009\
X( (((h)->next_free + 1 > (h)->chunk_limit)`009`009`009`009\
X   ? _obstack_newchunk ((h), obstack_chunk_alloc, 1) : 0),`009`009\
X  *((h)->next_free)++ = (datum))
X
X#define obstack_blank(h,length)`009`009`009`009`009`009\
X( (h)->temp = (length),`009`009`009`009`009`009`009\
X  (((h)->next_free + (h)->temp > (h)->chunk_limit)`009`009`009\
X   ? _obstack_newchunk ((h), obstack_chunk_alloc, (h)->temp) : 0),`009\
X  (h)->next_free += (h)->temp)
X
X#define obstack_alloc(h,length)`009`009`009`009`009`009\
X (obstack_blank ((h), (length)), obstack_finish (h))
X
X#define obstack_copy(h,where,length)`009`009`009`009`009\
X (obstack_grow ((h), (where), (length)), obstack_finish (h))
X
X#define obstack_copy0(h,where,length)`009`009`009`009`009\
X (obstack_grow0 ((h), (where), (length)), obstack_finish (h))
X
X#define obstack_room(h) ((long unsigned int)`009`009`009`009\
X ((h)->chunk_limit - (h)->next_free))
X
X#define obstack_1grow_fast(h,achar) (*((h)->next_free)++ = achar)
X
X#define obstack_blank_fast(h,n) ((h)->next_free += (n))
X
X#define obstack_finish(h)  `009`009`009`009`009`009\
X ((h)->temp = (int) (h)->object_base,`009`009`009`009`009\
X  (h)->next_free`009`009`009`009`009`009`009\
X    = (char*)((int)((h)->next_free+(h)->alignment_mask)`009`009`009\
X`009      & `126 ((h)->alignment_mask)),`009`009`009`009\
X  (((h)->next_free - (char *)(h)->chunk`009`009`009`009`009\
X    > (h)->chunk_limit - (char *)(h)->chunk)`009`009`009`009\
X   ? (h)->next_free = (h)->chunk_limit : 0),`009`009`009`009\
X  (h)->object_base = (h)->next_free,`009`009`009`009`009\
X  (char *) (h)->temp)
X
X#define obstack_free(h,obj)`009`009`009`009`009`009\
X(((h)->temp = (char *)(obj) - (char *) (h)->chunk),`009`009`009\
X (((h)->temp >= 0 && (h)->temp < (h)->chunk_limit - (char *) (h)->chunk)\
X  ? (int) ((h)->next_free = (h)->object_base`009`009`009`009\
X`009   = (h)->temp + (char *) (h)->chunk)`009`009`009`009\
X  : (int) _obstack_free ((h), obstack_chunk_free,`009`009`009\
X`009`009`009 (h)->temp + (char *) (h)->chunk)))
X
X#endif`009`009`009`009/* #ifndef obstackH */
$ GOSUB UNPACK_FILE
$ FILE_IS = "README."
$ CHECKSUM_IS = 1366819984
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XThis is the Beta-test distribution of gawk.  (Probably around version 1.02
Xor so.)
X
XPlease send all
Xbug-reports, comments, cries for help, etc, to hack@prep.ai.mit.edu
XAKA mit-eddie!prep!hack  During odd hours I can sometimes be reached at
X(617) 253-8975, which is an MIT phone in the middle of the corridor, so don't
Xbe suprised if someone wierd answers, or if the person on the other end has
Xnever heard of me.  (Direct them to the microvax about 10feet to their left.)
X
XGawk requires some berkeleyisms, like alloca(), bcopy(), index(), etc.  I
Xbelieve we have a portable version of alloca() (part of GNUemacs), and
Xprobably the other stuff as well.  Send me mail if you need anything.
X
XFor real speed, you should change the Makefile to compile -O -DFAST and
Xdisable the debugger.  (-DFAST replaces some function calls with macros, and
Xdisables a lot of debugging stuff.)
X
XIf you don't have bison, modify the makefile to call yacc instead
X(The proper commands should be already in the makefile; just un-comment them.)
XIf you have neither bison nor yacc, use the awk.tab.c file here.  It was
Xgenerated with bison, and should have no AT+T code in it.  (Note that
Xmodifying awk.y without bison or yacc will be difficult, at best.  You might
Xwant to get a copy of bison from us too.)
X
$ GOSUB UNPACK_FILE
$ FILE_IS = "README.VMS"
$ CHECKSUM_IS = 86785999
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XThe VMS GAWK port was done by M. Warner Losh at the New Mexico
XInstitute of Mininng and Technology.  Included here are the diff that
Xare needed to make GAWK work on VMS 4.5 using VAX-C 2.2.  If you have
Xa later version of VMS/VAX-C all should be ok, but this has not been
Xtested, so use it at your own risk.  All of the functionality of GAWK
Xappears to work, except for pipes (but including redirects).  Since
XVMS does not support pipes very well, I wasn't sure as to how to
Ximplement this.
X
XI don't have any documentation on GAWK, I don't know if it is awk-like
Xor nawk-like.  If someone does come up with some documentation, I'd
Xlike a copy.
X
XThere are three new files plus a couple of minor changes to the
Xoriginal files.  MAKE-GAWK.COM should make gawk on your system.  It
Xuses a file called CLINK.OPT to link in the sharable version of the
X'C' runtime library.  The final new file is VMS-PORT.C.  It contains
Xall of the functions that are needed to make this run under VMS.  Also
Xneeded, but not included in this distribution is the GCCLIB library
Xfrom the GCC compiler.  GAWK wants some of the berkeleyism that are in
Xthis library.  Specifically: bcmp, bcopy, bzero and alloca.  I have
Xincluded code for these.
X
XAll of the sources for this were obtained from cis.ohio-state.edu via
Xanonymous FTP.  The diffs are for "verison 1.03 (I think)".  Newer
Xversions should require little or no effort to get working.
X
$ GOSUB UNPACK_FILE
$ FILE_IS = "REGEX.C"
$ CHECKSUM_IS = 1381533498
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/* Extended regular expression matching and search.
X   Copyright (C) 1985 Free Software Foundation, Inc.
X
X`009`009       NO WARRANTY
X
X  BECAUSE THIS PROGRAM IS LICENSED FREE OF CHARGE, WE PROVIDE ABSOLUTELY
XNO WARRANTY, TO THE EXTENT PERMITTED BY APPLICABLE STATE LAW.  EXCEPT
XWHEN OTHERWISE STATED IN WRITING, FREE SOFTWARE FOUNDATION, INC,
XRICHARD M. STALLMAN AND/OR OTHER PARTIES PROVIDE THIS PROGRAM "AS IS"
XWITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING,
XBUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
XFITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY
XAND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE PROGRAM PROVE
XDEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
XCORRECTION.
X
X IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW WILL RICHARD M.
XSTALLMAN, THE FREE SOFTWARE FOUNDATION, INC., AND/OR ANY OTHER PARTY
XWHO MAY MODIFY AND REDISTRIBUTE THIS PROGRAM AS PERMITTED BELOW, BE
XLIABLE TO YOU FOR DAMAGES, INCLUDING ANY LOST PROFITS, LOST MONIES, OR
XOTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
XUSE OR INABILITY TO USE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR
XDATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD PARTIES OR
XA FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS) THIS
XPROGRAM, EVEN IF YOU HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH
XDAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY.
X
X`009`009GENERAL PUBLIC LICENSE TO COPY
X
X  1. You may copy and distribute verbatim copies of this source file
Xas you receive it, in any medium, provided that you conspicuously and
Xappropriately publish on each copy a valid copyright notice "Copyright
X(C) 1985 Free Software Foundation, Inc."; and include following the
Xcopyright notice a verbatim copy of the above disclaimer of warranty
Xand of this License.  You may charge a distribution fee for the
Xphysical act of transferring a copy.
X
X  2. You may modify your copy or copies of this source file or
Xany portion of it, and copy and distribute such modifications under
Xthe terms of Paragraph 1 above, provided that you also do the following:
X
X    a) cause the modified files to carry prominent notices stating
X    that you changed the files and the date of any change; and
X
X    b) cause the whole of any work that you distribute or publish,
X    that in whole or in part contains or is a derivative of this
X    program or any part thereof, to be licensed at no charge to all
X    third parties on terms identical to those contained in this
X    License Agreement (except that you may choose to grant more extensive
X    warranty protection to some or all third parties, at your option).
X
X    c) You may charge a distribution fee for the physical act of
X    transferring a copy, and you may at your option offer warranty
X    protection in exchange for a fee.
X
XMere aggregation of another unrelated program with this program (or its
Xderivative) on a volume of a storage or distribution medium does not bring
Xthe other program under the scope of these terms.
X
X  3. You may copy and distribute this program (or a portion or derivative
Xof it, under Paragraph 2) in object code or executable form under the terms
Xof Paragraphs 1 and 2 above provided that you also do one of the following:
X
X    a) accompany it with the complete corresponding machine-readable
X    source code, which must be distributed under the terms of
X    Paragraphs 1 and 2 above; or,
X
X    b) accompany it with a written offer, valid for at least three
X    years, to give any third party free (except for a nominal
X    shipping charge) a complete machine-readable copy of the
X    corresponding source code, to be distributed under the terms of
X    Paragraphs 1 and 2 above; or,
X
X    c) accompany it with the information you received as to where the
X    corresponding source code may be obtained.  (This alternative is
X    allowed only for noncommercial distribution and only if you
X    received the program in object code or executable form alone.)
X
XFor an executable file, complete source code means all the source code for
Xall modules it contains; but, as a special exception, it need not include
Xsource code for modules which are standard libraries that accompany the
Xoperating system on which the executable file runs.
X
X  4. You may not copy, sublicense, distribute or transfer this program
Xexcept as expressly provided under this License Agreement.  Any attempt
Xotherwise to copy, sublicense, distribute or transfer this program is void and
Xyour rights to use the program under this License agreement shall be
Xautomatically terminated.  However, parties who have received computer
Xsoftware programs from you with this License Agreement will not have
Xtheir licenses terminated so long as such parties remain in full compliance.
X
X  5. If you wish to incorporate parts of this program into other free
Xprograms whose distribution conditions are different, write to the Free
XSoftware Foundation at 675 Mass Ave, Cambridge, MA 02139.  We have not yet
Xworked out a simple rule that can be stated here, but we will often permit
Xthis.  We will be guided by the two goals of preserving the free status of
Xall derivatives of our free software and of promoting the sharing and reuse of
Xsoftware.
X
X
XIn other words, you are welcome to use, share and improve this program.
XYou are forbidden to forbid anyone else to use, share and improve
Xwhat you give them.   Help stamp out software-hoarding!  */
X
X
X/* To test, compile with -Dtest.
X This Dtestable feature turns this into a self-contained program
X which reads a pattern, describes how it compiles,
X then reads a string and searches for it.  */
X
X
X#ifdef emacs
X
X/* The ``emacs' switch turns on certain special matching commands
X that make sense only in emacs. */
X
X#include "config.h"
X#include "lisp.h"
X#include "buffer.h"
X#include "syntax.h"
X
X#else  /* not emacs */
X
X/*
X * Define the syntax stuff, so we can do the \<...\> things.
X */
X
X#ifndef Sword /* must be non-zero in some of the tests below... */
X#define Sword 1
X#endif
X
X#define SYNTAX(c) re_syntax_table[c]
X
X#ifdef SYNTAX_TABLE
X
Xchar *re_syntax_table;
X
X#else
X
Xstatic char re_syntax_table[256];
X
Xstatic void
Xinit_syntax_once ()
X`123
X   register int c;
X   static int done = 0;
X
X   if (done)
X     return;
X
X   bzero (re_syntax_table, sizeof re_syntax_table);
X
X   for (c = 'a'; c <= 'z'; c++)
X     re_syntax_table[c] = Sword;
X
X   for (c = 'A'; c <= 'Z'; c++)
X     re_syntax_table[c] = Sword;
X
X   for (c = '0'; c <= '9'; c++)
X     re_syntax_table[c] = Sword;
X
X   done = 1;
X`125
X
X#endif /* SYNTAX_TABLE */
X#endif /* not emacs */
X
X#include "regex.h"
X
X/* Number of failure points to allocate space for initially,
X when matching.  If this number is exceeded, more space is allocated,
X so it is not a hard limit.  */
X
X#ifndef NFAILURES
X#define NFAILURES 80
X#endif NFAILURES
X
X/* width of a byte in bits */
X
X#define BYTEWIDTH 8
X
X#ifndef SIGN_EXTEND_CHAR
X#define SIGN_EXTEND_CHAR(x) (x)
X#endif
X`012
Xstatic int obscure_syntax = 0;
X
X/* Specify the precise syntax of regexp for compilation.
X   This provides for compatibility for various utilities
X   which historically have different, incompatible syntaxes.
X
X   The argument SYNTAX is a bit-mask containing the two bits
X   RE_NO_BK_PARENS and RE_NO_BK_VBAR.  */
X
Xint
Xre_set_syntax (syntax)
X`123
X  int ret;
X
X  ret = obscure_syntax;
X  obscure_syntax = syntax;
X  return ret;
X`125
X`012
X/* re_compile_pattern takes a regular-expression string
X   and converts it into a buffer full of byte commands for matching.
X
X  PATTERN   is the address of the pattern string
X  SIZE      is the length of it.
X  BUFP`009    is a  struct re_pattern_buffer *  which points to the info
X`009    on where to store the byte commands.
X`009    This structure contains a  char *  which points to the
X`009    actual space, which should have been obtained with malloc.
X`009    re_compile_pattern may use  realloc  to grow the buffer space.
X
X  The number of bytes of commands can be found out by looking in
X  the  struct re_pattern_buffer  that bufp pointed to,
X  after re_compile_pattern returns.
X*/
X
X#define PATPUSH(ch) (*b++ = (char) (ch))
X
X#define PATFETCH(c) \
X `123if (p == pend) goto end_of_pattern; \
X  c = * (unsigned char *) p++; \
X  if (translate) c = translate[c]; `125
X
X#define PATFETCH_RAW(c) \
X `123if (p == pend) goto end_of_pattern; \
X  c = * (unsigned char *) p++; `125
X
X#define PATUNFETCH p--
X
X#define EXTEND_BUFFER \
X  `123 char *old_buffer = bufp->buffer; \
X    if (bufp->allocated == (1<<16)) goto too_big; \
X    bufp->allocated *= 2; \
X    if (bufp->allocated > (1<<16)) bufp->allocated = (1<<16); \
X    if (!(bufp->buffer = (char *) realloc (bufp->buffer, bufp->allocated))) \
X      goto memory_exhausted; \
X    c = bufp->buffer - old_buffer; \
X    b += c; \
X    if (fixup_jump) \
X      fixup_jump += c; \
X    if (laststart) \
X      laststart += c; \
X    begalt += c; \
X    if (pending_exact) \
X      pending_exact += c; \
X  `125
X
Xstatic int store_jump (), insert_jump ();
X
Xchar *
Xre_compile_pattern (pattern, size, bufp)
X     char *pattern;
X     int size;
X     struct re_pattern_buffer *bufp;
X`123
X  register char *b = bufp->buffer;
X  register char *p = pattern;
X  char *pend = pattern + size;
X  register unsigned c, c1;
X  char *p1;
X  unsigned char *translate = (unsigned char *) bufp->translate;
X
X  /* address of the count-byte of the most recently inserted "exactn" command.
X    This makes it possible to tell whether a new exact-match character
X    can be added to that command or requires a new "exactn" command. */
X    `032
X  char *pending_exact = 0;
X
X  /* address of the place where a forward-jump should go
X    to the end of the containing expression.
X    Each alternative of an "or", except the last, ends with a forward-jump
X    of this sort. */
X
X  char *fixup_jump = 0;
X
X  /* address of start of the most recently finished expression.
X    This tells postfix * where to find the start of its operand. */
X
X  char *laststart = 0;
X
X  /* In processing a repeat, 1 means zero matches is allowed */
X
X  char zero_times_ok;
X
X  /* In processing a repeat, 1 means many matches is allowed */
X
X  char many_times_ok;
X
X  /* address of beginning of regexp, or inside of last \( */
X
X  char *begalt = b;
X
X  /* Stack of information saved by \( and restored by \).
X     Four stack elements are pushed by each \(:
X       First, the value of b.
X       Second, the value of fixup_jump.
X       Third, the value of regnum.
X       Fourth, the value of begalt.  */
X
X  int stackb[40];
X  int *stackp = stackb;
X  int *stacke = stackb + 40;
X  int *stackt;
X
X  /* Counts \('s as they are encountered.  Remembered for the matching \),
V     where it becomes the "register number" to put in the stop_memory command *
X/
X
X  int regnum = 1;
X
X  bufp->fastmap_accurate = 0;
X
X#ifndef emacs
X#ifndef SYNTAX_TABLE
X  /*
X   * Initialize the syntax table.
X   */
X   init_syntax_once();
X#endif
X#endif
X
X  if (bufp->allocated == 0)
X    `123
X      bufp->allocated = 28;
X      if (bufp->buffer)
X`009/* EXTEND_BUFFER loses when bufp->allocated is 0 */
X`009bufp->buffer = (char *) realloc (bufp->buffer, 28);
X      else
X`009/* Caller did not allocate a buffer.  Do it for him */
X`009bufp->buffer = (char *) malloc (28);
X      if (!bufp->buffer) goto memory_exhausted;
X      begalt = b = bufp->buffer;
X    `125
X
X  while (p != pend)
X    `123
X      if (b - bufp->buffer > bufp->allocated - 10)
X`009/* Note that EXTEND_BUFFER clobbers c */
X`009EXTEND_BUFFER;
X
X      PATFETCH (c);
X
X      switch (c)
X`009`123
X`009case '$':
X`009  if (obscure_syntax & RE_TIGHT_VBAR)
X`009    `123
X`009      if (! (obscure_syntax & RE_CONTEXT_INDEP_OPS) && p != pend)
X`009`009goto normal_char;
X`009      /* Make operand of last vbar end before this ``$'.  */
X`009      if (fixup_jump)
X`009`009store_jump (fixup_jump, jump, b);
X`009      fixup_jump = 0;
X`009      PATPUSH (endline);
X`009      break;
X`009    `125
X
X`009  /* $ means succeed if at end of line, but only in special contexts.
X`009    If randomly in the middle of a pattern, it is a normal character. */
X`009  if (p == pend
X`009      `124`124 (obscure_syntax & RE_CONTEXT_INDEP_OPS)
X`009      `124`124 (obscure_syntax & RE_NO_BK_PARENS
X`009`009  ? *p == ')'
X`009`009  : *p == '\\' && p[1] == ')')
X`009      `124`124 (obscure_syntax & RE_NO_BK_VBAR
X`009`009  ? *p == '`124'
X`009`009  : *p == '\\' && p[1] == '`124'))
X`009    `123
X`009      PATPUSH (endline);
X`009      break;
X`009    `125
X`009  goto normal_char;
X
X`009case '`094':
V`009  /* `094 means succeed if at beg of line, but only if no preceding pattern
X. */
X`009  if (laststart && ! (obscure_syntax & RE_CONTEXT_INDEP_OPS))
X`009    goto normal_char;
X`009  if (obscure_syntax & RE_TIGHT_VBAR)
X`009    `123
X`009      if (p != pattern + 1
X`009`009  && ! (obscure_syntax & RE_CONTEXT_INDEP_OPS))
X`009`009goto normal_char;
X`009      PATPUSH (begline);
X`009      begalt = b;
X`009    `125
X`009  else
X`009    PATPUSH (begline);
X`009  break;
X
X`009case '+':
X`009case '?':
X`009  if (obscure_syntax & RE_BK_PLUS_QM)
X`009    goto normal_char;
X`009handle_plus:
X`009case '*':
X`009  /* If there is no previous pattern, char not special. */
X`009  if (!laststart && ! (obscure_syntax & RE_CONTEXT_INDEP_OPS))
X`009    goto normal_char;
X`009  /* If there is a sequence of repetition chars,
X`009     collapse it down to equivalent to just one.  */
X`009  zero_times_ok = 0;
X`009  many_times_ok = 0;
X`009  while (1)
X`009    `123
X`009      zero_times_ok `124= c != '+';
X`009      many_times_ok `124= c != '?';
X`009      if (p == pend)
X`009`009break;
X`009      PATFETCH (c);
X`009      if (!(c == '*' `124`124 c == '+' `124`124 c == '?'))
X`009`009`123
X`009`009  PATUNFETCH;
X`009`009  break;
X`009`009`125
X`009    `125
X
X`009  /* Now we know whether 0 matches is allowed,
X`009     and whether 2 or more matches is allowed.  */
X`009  if (many_times_ok)
X`009    `123
X`009      /* If more than one repetition is allowed,
X`009`009 put in a backward jump at the end.  */
X`009      store_jump (b, maybe_finalize_jump, laststart - 3);
X`009      b += 3;
X`009    `125
X`009  insert_jump (on_failure_jump, laststart, b + 3, b);
X`009  pending_exact = 0;
X`009  b += 3;
X`009  if (!zero_times_ok)
X`009    `123
X`009      /* At least one repetition required: insert before the loop
X`009`009 a skip over the initial on-failure-jump instruction */
X`009      insert_jump (dummy_failure_jump, laststart, laststart + 6, b);
X`009      b += 3;
X`009    `125
X`009  break;
X
X`009case '.':
X`009  laststart = b;
X`009  PATPUSH (anychar);
X`009  break;
X
X`009case '[':
X`009  while (b - bufp->buffer
X`009`009 > bufp->allocated - 3 - (1 << BYTEWIDTH) / BYTEWIDTH)
X`009    /* Note that EXTEND_BUFFER clobbers c */
X`009    EXTEND_BUFFER;
X
X`009  laststart = b;
X`009  if (*p == '`094')
X`009    PATPUSH (charset_not), p++;
X`009  else
X`009    PATPUSH (charset);
X`009  p1 = p;
X
X`009  PATPUSH ((1 << BYTEWIDTH) / BYTEWIDTH);
X`009  /* Clear the whole map */
X`009  bzero (b, (1 << BYTEWIDTH) / BYTEWIDTH);
X`009  /* Read in characters and ranges, setting map bits */
X`009  while (1)
X`009    `123
X`009      PATFETCH (c);
X`009      if (c == ']' && p != p1 + 1) break;
X`009      if (*p == '-' && p[1] != ']')
X`009`009`123
X`009`009  PATFETCH (c1);
X`009`009  PATFETCH (c1);
X`009`009  while (c <= c1)
X`009`009    b[c / BYTEWIDTH] `124= 1 << (c % BYTEWIDTH), c++;
X`009`009`125
X`009      else
X`009`009`123
X`009`009  b[c / BYTEWIDTH] `124= 1 << (c % BYTEWIDTH);
X`009`009`125
X`009    `125
X`009  /* Discard any bitmap bytes that are all 0 at the end of the map.
X`009     Decrement the map-length byte too. */
X`009  while (b[-1] > 0 && b[b[-1] - 1] == 0)
X`009    b[-1]--;
X`009  b += b[-1];
X`009  break;
X
X`009case '(':
X`009  if (! (obscure_syntax & RE_NO_BK_PARENS))
X`009    goto normal_char;
X`009  else
X`009    goto handle_open;
X
X`009case ')':
X`009  if (! (obscure_syntax & RE_NO_BK_PARENS))
X`009    goto normal_char;
X`009  else
X`009    goto handle_close;
X
X`009case '\n':
X`009  if (! (obscure_syntax & RE_NEWLINE_OR))
X`009    goto normal_char;
X`009  else
X`009    goto handle_bar;
X
X`009case '`124':
X`009  if (! (obscure_syntax & RE_NO_BK_VBAR))
X`009    goto normal_char;
X`009  else
X`009    goto handle_bar;
X
X        case '\\':
X`009  if (p == pend) goto invalid_pattern;
X`009  PATFETCH_RAW (c);
X`009  switch (c)
X`009    `123
X`009    case '(':
X`009      if (obscure_syntax & RE_NO_BK_PARENS)
X`009`009goto normal_backsl;
X`009    handle_open:
X`009      if (stackp == stacke) goto nesting_too_deep;
X`009      if (regnum < RE_NREGS)
X`009        `123
X`009`009  PATPUSH (start_memory);
X`009`009  PATPUSH (regnum);
X`009        `125
X`009      *stackp++ = b - bufp->buffer;
X`009      *stackp++ = fixup_jump ? fixup_jump - bufp->buffer + 1 : 0;
X`009      *stackp++ = regnum++;
X`009      *stackp++ = begalt - bufp->buffer;
X`009      fixup_jump = 0;
X`009      laststart = 0;
X`009      begalt = b;
X`009      break;
X
X`009    case ')':
X`009      if (obscure_syntax & RE_NO_BK_PARENS)
X`009`009goto normal_backsl;
X`009    handle_close:
X`009      if (stackp == stackb) goto unmatched_close;
X`009      begalt = *--stackp + bufp->buffer;
X`009      if (fixup_jump)
X`009`009store_jump (fixup_jump, jump, b);
X`009      if (stackp[-1] < RE_NREGS)
X`009`009`123
X`009`009  PATPUSH (stop_memory);
X`009`009  PATPUSH (stackp[-1]);
X`009`009`125
X`009      stackp -= 2;
X`009      fixup_jump = 0;
X`009      if (*stackp)
X`009`009fixup_jump = *stackp + bufp->buffer - 1;
X`009      laststart = *--stackp + bufp->buffer;
X`009      break;
X
X`009    case '`124':
X`009      if (obscure_syntax & RE_NO_BK_VBAR)
X`009`009goto normal_backsl;
X`009    handle_bar:
X`009      insert_jump (on_failure_jump, begalt, b + 6, b);
X`009      pending_exact = 0;
X`009      b += 3;
X`009      if (fixup_jump)
X`009`009store_jump (fixup_jump, jump, b);
X`009      fixup_jump = b;
X`009      b += 3;
X`009      laststart = 0;
X`009      begalt = b;
X`009      break;
X
X#ifdef emacs
X`009    case '=':
X`009      PATPUSH (at_dot);
X`009      break;
X
X`009    case 's':`009
X`009      laststart = b;
X`009      PATPUSH (syntaxspec);
X`009      PATFETCH (c);
X`009      PATPUSH (syntax_spec_code[c]);
X`009      break;
X
X`009    case 'S':
X`009      laststart = b;
X`009      PATPUSH (notsyntaxspec);
X`009      PATFETCH (c);
X`009      PATPUSH (syntax_spec_code[c]);
X`009      break;
X#endif emacs
X
X`009    case 'w':
X`009      laststart = b;
X`009      PATPUSH (wordchar);
X`009      break;
X
X`009    case 'W':
X`009      laststart = b;
X`009      PATPUSH (notwordchar);
X`009      break;
X
X`009    case '<':
X`009      PATPUSH (wordbeg);
X`009      break;
X
X`009    case '>':
X`009      PATPUSH (wordend);
X`009      break;
X
X`009    case 'b':
X`009      PATPUSH (wordbound);
X`009      break;
X
X`009    case 'B':
X`009      PATPUSH (notwordbound);
X`009      break;
X
X`009    case '``':
X`009      PATPUSH (begbuf);
X`009      break;
X
X`009    case '\'':
X`009      PATPUSH (endbuf);
X`009      break;
X
X`009    case '1':
X`009    case '2':
X`009    case '3':
X`009    case '4':
X`009    case '5':
X`009    case '6':
X`009    case '7':
X`009    case '8':
X`009    case '9':
X`009      c1 = c - '0';
X`009      if (c1 >= regnum)
X`009`009goto normal_char;
X`009      for (stackt = stackp - 2;  stackt > stackb;  stackt -= 4)
X `009`009if (*stackt == c1)
X`009`009  goto normal_char;
X`009      laststart = b;
X`009      PATPUSH (duplicate);
X`009      PATPUSH (c1);
X`009      break;
X
X`009    case '+':
X`009    case '?':
X`009      if (obscure_syntax & RE_BK_PLUS_QM)
X`009`009goto handle_plus;
X
X`009    default:
X`009    normal_backsl:
X`009      /* You might think it would be useful for \ to mean
X`009`009 not to translate; but if we don't translate it
X`009`009 it will never match anything.  */
X`009      if (translate) c = translate[c];
X`009      goto normal_char;
X`009    `125
X`009  break;
X
X`009default:
X`009normal_char:
X`009  if (!pending_exact `124`124 pending_exact + *pending_exact + 1 != b
V`009      `124`124 *pending_exact == 0177 `124`124 *p == '*' `124`124 *p == '`0
X94'
X`009      `124`124 ((obscure_syntax & RE_BK_PLUS_QM)
X`009`009  ? *p == '\\' && (p[1] == '+' `124`124 p[1] == '?')
X`009`009  : (*p == '+' `124`124 *p == '?')))
X`009    `123
X`009      laststart = b;
X`009      PATPUSH (exactn);
X`009      pending_exact = b;
X`009      PATPUSH (0);
X`009    `125
X`009  PATPUSH (c);
X`009  (*pending_exact)++;
X`009`125
X    `125
X
X  if (fixup_jump)
X    store_jump (fixup_jump, jump, b);
X
X  if (stackp != stackb) goto unmatched_open;
X
X  bufp->used = b - bufp->buffer;
X  return 0;
X
X invalid_pattern:
X  return "Invalid regular expression";
X
X unmatched_open:
X  return "Unmatched \\(";
X
X unmatched_close:
X  return "Unmatched \\)";
X
X end_of_pattern:
X  return "Premature end of regular expression";
X
X nesting_too_deep:
X  return "Nesting too deep";
X
X too_big:
X  return "Regular expression too big";
X
X memory_exhausted:
X  return "Memory exhausted";
X`125
X
X/* Store where ``from' points a jump operation to jump to where ``to' points.
X  ``opcode' is the opcode to store. */
X
Xstatic int
Xstore_jump (from, opcode, to)
X     char *from, *to;
X     char opcode;
X`123
X  from[0] = opcode;
X  from[1] = (to - (from + 3)) & 0377;
X  from[2] = (to - (from + 3)) >> 8;
X`125
X
X/* Open up space at char FROM, and insert there a jump to TO.
X   CURRENT_END gives te end of the storage no in use,
X   so we know how much data to copy up.
X   OP is the opcode of the jump to insert.
X
X   If you call this function, you must zero out pending_exact.  */
X
Xstatic int
Xinsert_jump (op, from, to, current_end)
X     char op;
X     char *from, *to, *current_end;
X`123
X  register char *pto = current_end + 3;
X  register char *pfrom = current_end;
X  while (pfrom != from)
X    *--pto = *--pfrom;
X  store_jump (from, op, to);
X`125
X`012
X/* Given a pattern, compute a fastmap from it.
X The fastmap records which of the (1 << BYTEWIDTH) possible characters
X can start a string that matches the pattern.
V This fastmap is used by re_search to skip quickly over totally implausible tex
Xt.
X
X The caller must supply the address of a (1 << BYTEWIDTH)-byte data area
X as bufp->fastmap.
X The other components of bufp describe the pattern to be used.  */
X
Xvoid
Xre_compile_fastmap (bufp)
X     struct re_pattern_buffer *bufp;
X`123
X  unsigned char *pattern = (unsigned char *) bufp->buffer;
X  int size = bufp->used;
X  register char *fastmap = bufp->fastmap;
X  register unsigned char *p = pattern;
X  register unsigned char *pend = pattern + size;
X  register int j, k;
X  unsigned char *translate = (unsigned char *) bufp->translate;
X
X  unsigned char *stackb[NFAILURES];
X  unsigned char **stackp = stackb;
X
X  bzero (fastmap, (1 << BYTEWIDTH));
X  bufp->fastmap_accurate = 1;
X  bufp->can_be_null = 0;
X     `032
X  while (p)
X    `123
X      if (p == pend)
X`009`123
X`009  bufp->can_be_null = 1;
X`009  break;
X`009`125
X#ifdef SWITCH_ENUM_BUG
X      switch ((int) ((enum regexpcode) *p++))
X#else
X      switch ((enum regexpcode) *p++)
X#endif
X`009`123
X`009case exactn:
X`009  if (translate)
X`009    fastmap[translate[p[1]]] = 1;
X`009  else
X`009    fastmap[p[1]] = 1;
X`009  break;
X
X        case begline:
X        case before_dot:
X`009case at_dot:
X`009case after_dot:
X`009case begbuf:
X`009case endbuf:
X`009case wordbound:
X`009case notwordbound:
X`009case wordbeg:
X`009case wordend:
X`009  continue;
X
X`009case endline:
X`009  if (translate)
X`009    fastmap[translate['\n']] = 1;
X`009  else
X`009    fastmap['\n'] = 1;
X`009  if (bufp->can_be_null != 1)
X`009    bufp->can_be_null = 2;
X`009  break;
X
X`009case finalize_jump:
X`009case maybe_finalize_jump:
X`009case jump:
X`009case dummy_failure_jump:
X`009  bufp->can_be_null = 1;
X`009  j = *p++ & 0377;
X`009  j += SIGN_EXTEND_CHAR (*(char *)p) << 8;
X`009  p += j + 1;`009`009/* The 1 compensates for missing ++ above */
X`009  if (j > 0)
X`009    continue;
X`009  /* Jump backward reached implies we just went through
X`009     the body of a loop and matched nothing.
X`009     Opcode jumped to should be an on_failure_jump.
X`009     Just treat it like an ordinary jump.
X`009     For a * loop, it has pushed its failure point already;
X`009     if so, discard that as redundant.  */
X`009  if ((enum regexpcode) *p != on_failure_jump)
X`009    continue;
X`009  p++;
X`009  j = *p++ & 0377;
X`009  j += SIGN_EXTEND_CHAR (*(char *)p) << 8;
X`009  p += j + 1;`009`009/* The 1 compensates for missing ++ above */
X`009  if (stackp != stackb && *stackp == p)
X`009    stackp--;
X`009  continue;
X`009 `032
X`009case on_failure_jump:
X`009  j = *p++ & 0377;
X`009  j += SIGN_EXTEND_CHAR (*(char *)p) << 8;
X`009  p++;
X`009  *++stackp = p + j;
X`009  continue;
X
X`009case start_memory:
X`009case stop_memory:
X`009  p++;
X`009  continue;
X
X`009case duplicate:
X`009  bufp->can_be_null = 1;
X`009  fastmap['\n'] = 1;
X`009case anychar:
X`009  for (j = 0; j < (1 << BYTEWIDTH); j++)
X`009    if (j != '\n')
X`009      fastmap[j] = 1;
X`009  if (bufp->can_be_null)
X`009    return;
X`009  /* Don't return; check the alternative paths
X`009     so we can set can_be_null if appropriate.  */
X`009  break;
X
X`009case wordchar:
X`009  for (j = 0; j < (1 << BYTEWIDTH); j++)
X`009    if (SYNTAX (j) == Sword)
X`009      fastmap[j] = 1;
X`009  break;
X
X`009case notwordchar:
X`009  for (j = 0; j < (1 << BYTEWIDTH); j++)
X`009    if (SYNTAX (j) != Sword)
X`009      fastmap[j] = 1;
X`009  break;
X
X#ifdef emacs
X`009case syntaxspec:
X`009  k = *p++;
X`009  for (j = 0; j < (1 << BYTEWIDTH); j++)
X`009    if (SYNTAX (j) == (enum syntaxcode) k)
X`009      fastmap[j] = 1;
X`009  break;
X
X`009case notsyntaxspec:
X`009  k = *p++;
X`009  for (j = 0; j < (1 << BYTEWIDTH); j++)
X`009    if (SYNTAX (j) != (enum syntaxcode) k)
X`009      fastmap[j] = 1;
X`009  break;
X#endif emacs
X
X`009case charset:
X`009  for (j = *p++ * BYTEWIDTH - 1; j >= 0; j--)
X`009    if (p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH)))
X`009      `123
X`009`009if (translate)
X`009`009  fastmap[translate[j]] = 1;
X`009`009else
X`009`009  fastmap[j] = 1;
X`009      `125
X`009  break;
X
X`009case charset_not:
X`009  /* Chars beyond end of map must be allowed */
X`009  for (j = *p * BYTEWIDTH; j < (1 << BYTEWIDTH); j++)
X`009    if (translate)
X`009      fastmap[translate[j]] = 1;
X`009    else
X`009      fastmap[j] = 1;
X
X`009  for (j = *p++ * BYTEWIDTH - 1; j >= 0; j--)
X`009    if (!(p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH))))
X`009      `123
X`009`009if (translate)
X`009`009  fastmap[translate[j]] = 1;
X`009`009else
X`009`009  fastmap[j] = 1;
X`009      `125
X`009  break;
X`009`125
X
V      /* Get here means we have successfully found the possible starting charac
Xters
X`009 of one path of the pattern.  We need not follow this path any farther.
X`009 Instead, look at the next alternative remembered in the stack. */
X      if (stackp != stackb)
X`009p = *stackp--;
X      else
X`009break;
X    `125
X`125
X`012
X/* Like re_search_2, below, but only one string is specified. */
X
Xint
Xre_search (pbufp, string, size, startpos, range, regs)
X     struct re_pattern_buffer *pbufp;
X     char *string;
X     int size, startpos, range;
X     struct re_registers *regs;
X`123
X  return re_search_2 (pbufp, 0, 0, string, size, startpos, range, regs, size);
X`125
X
X/* Like re_match_2 but tries first a match starting at index STARTPOS,
X   then at STARTPOS + 1, and so on.
X   RANGE is the number of places to try before giving up.
X   If RANGE is negative, the starting positions tried are
X    STARTPOS, STARTPOS - 1, etc.
X   It is up to the caller to make sure that range is not so large
X   as to take the starting position outside of the input strings.
X
XThe value returned is the position at which the match was found,
X or -1 if no match was found,
X or -2 if error (such as failure stack overflow).  */
X
Xint
Vre_search_2 (pbufp, string1, size1, string2, size2, startpos, range, regs, msto
Xp)
X     struct re_pattern_buffer *pbufp;
X     char *string1, *string2;
X     int size1, size2;
X     int startpos;
X     register int range;
X     struct re_registers *regs;
X     int mstop;
X`123
X  register char *fastmap = pbufp->fastmap;
X  register unsigned char *translate = (unsigned char *) pbufp->translate;
X  int total = size1 + size2;
X  int val;
X
X  /* Update the fastmap now if not correct already */
X  if (fastmap && !pbufp->fastmap_accurate)
X    re_compile_fastmap (pbufp);
X `032
X  /* Don't waste time in a long search for a pattern
X     that says it is anchored.  */
X  if (pbufp->used > 0 && (enum regexpcode) pbufp->buffer[0] == begbuf
X      && range > 0)
X    `123
X      if (startpos > 0)
X`009return -1;
X      else
X`009range = 1;
X    `125
X
X  while (1)
X    `123
X      /* If a fastmap is supplied, skip quickly over characters
X`009 that cannot possibly be the start of a match.
X`009 Note, however, that if the pattern can possibly match
X`009 the null string, we must test it at each starting point
X`009 so that we take the first null string we get.  */
X
X      if (fastmap && startpos < total && pbufp->can_be_null != 1)
X`009`123
X`009  if (range > 0)
X`009    `123
X`009      register int lim = 0;
X`009      register unsigned char *p;
X`009      int irange = range;
X`009      if (startpos < size1 && startpos + range >= size1)
X`009`009lim = range - (size1 - startpos);
X
X`009      p = ((unsigned char *)
X`009`009   &(startpos >= size1 ? string2 - size1 : string1)[startpos]);
X
X`009      if (translate)
X`009`009`123
X`009`009  while (range > lim && !fastmap[translate[*p++]])
X`009`009    range--;
X`009`009`125
X`009      else
X`009`009`123
X`009`009  while (range > lim && !fastmap[*p++])
X`009`009    range--;
X`009`009`125
X`009      startpos += irange - range;
X`009    `125
X`009  else
X`009    `123
X`009      register unsigned char c;
X`009      if (startpos >= size1)
X`009`009c = string2[startpos - size1];
X`009      else
X`009`009c = string1[startpos];
X`009      c &= 0xff;
X`009      if (translate ? !fastmap[translate[c]] : !fastmap[c])
X`009`009goto advance;
X`009    `125
X`009`125
X
X      if (range >= 0 && startpos == total
X`009  && fastmap && pbufp->can_be_null == 0)
X`009return -1;
X
V      val = re_match_2 (pbufp, string1, size1, string2, size2, startpos, regs,
X mstop);
X      if (0 <= val)
X`009`123
X`009  if (val == -2)
X`009    return -2;
X`009  return startpos;
X`009`125
X
X#ifdef C_ALLOCA
X      alloca (0);
X#endif /* C_ALLOCA */
X
X    advance:
X      if (!range) break;
X      if (range > 0) range--, startpos++; else range++, startpos--;
X    `125
X  return -1;
X`125
X`012
X#ifndef emacs   /* emacs never uses this */
Xint
Xre_match (pbufp, string, size, pos, regs)
X     struct re_pattern_buffer *pbufp;
X     char *string;
X     int size, pos;
X     struct re_registers *regs;
X`123
X  return re_match_2 (pbufp, 0, 0, string, size, pos, regs, size);
X`125
X#endif /* emacs */
X
X/* Maximum size of failure stack.  Beyond this, overflow is an error.  */
X
Xint re_max_failures = 2000;
X
X/* Match the pattern described by PBUFP
X   against data which is the virtual concatenation of STRING1 and STRING2.
X   SIZE1 and SIZE2 are the sizes of the two data strings.
X   Start the match at position POS.
X   Do not consider matching past the position MSTOP.
X
X   If pbufp->fastmap is nonzero, then it had better be up to date.
X
X   The reason that the data to match are specified as two components
X   which are to be regarded as concatenated
X   is so this function can be used directly on the contents of an Emacs buffer.
X
X   -1 is returned if there is no match.  -2 is returned if there is
X   an error (such as match stack overflow).  Otherwise the value is the length
X   of the substring which was matched.  */
X
Xint
Xre_match_2 (pbufp, string1, size1, string2, size2, pos, regs, mstop)
X     struct re_pattern_buffer *pbufp;
X     unsigned char *string1, *string2;
X     int size1, size2;
X     int pos;
X     struct re_registers *regs;
X     int mstop;
X`123
X  register unsigned char *p = (unsigned char *) pbufp->buffer;
X  register unsigned char *pend = p + pbufp->used;
X  /* End of first string */
X  unsigned char *end1;
X  /* End of second string */
X  unsigned char *end2;
X  /* Pointer just past last char to consider matching */
X  unsigned char *end_match_1, *end_match_2;
X  register unsigned char *d, *dend;
X  register int mcnt;
X  unsigned char *translate = (unsigned char *) pbufp->translate;
X
V /* Failure point stack.  Each place that can handle a failure further down the
X line
X    pushes a failure point on this stack.  It consists of two char *'s.
X    The first one pushed is where to resume scanning the pattern;
X    the second pushed is where to resume scanning the strings.
X    If the latter is zero, the failure point is a "dummy".
X    If a failure happens and the innermost failure point is dormant,
X    it discards that failure point and tries the next one. */
X
X  unsigned char **stackb
X    = (unsigned char **) alloca (2 * NFAILURES * sizeof (char *));
X  unsigned char **stackp = stackb, **stacke = &stackb[2 * NFAILURES];
X
X  /* Information on the "contents" of registers.
X     These are pointers into the input strings; they record
X     just what was matched (on this attempt) by some part of the pattern.
X     The start_memory command stores the start of a register's contents
X     and the stop_memory command stores the end.
X
V     At that point, regstart[regnum] points to the first character in the regis
Xter,
V     regend[regnum] points to the first character beyond the end of the registe
Xr,
X     regstart_seg1[regnum] is true iff regstart[regnum] points into string1,
V     and regend_seg1[regnum] is true iff regend[regnum] points into string1.  *
X/
X
X  unsigned char *regstart[RE_NREGS];
X  unsigned char *regend[RE_NREGS];
X  unsigned char regstart_seg1[RE_NREGS], regend_seg1[RE_NREGS];
X
X  /* Set up pointers to ends of strings.
X     Don't allow the second string to be empty unless both are empty.  */
X  if (!size2)
X    `123
X      string2 = string1;
X      size2 = size1;
X      string1 = 0;
X      size1 = 0;
X    `125
X  end1 = string1 + size1;
X  end2 = string2 + size2;
X
X  /* Compute where to stop matching, within the two strings */
X  if (mstop <= size1)
X    `123
X      end_match_1 = string1 + mstop;
X      end_match_2 = string2;
X    `125
X  else
X    `123
X      end_match_1 = end1;
X      end_match_2 = string2 + mstop - size1;
X    `125
X
X  /* Initialize \) text positions to -1
X     to mark ones that no \( or \) has been seen for.  */
X
X  for (mcnt = 0; mcnt < sizeof (regend) / sizeof (*regend); mcnt++)
X    regend[mcnt] = (unsigned char *) -1;
X
X  /* ``p' scans through the pattern as ``d' scans through the data.
X     ``dend' is the end of the input string that ``d' points within.
X     ``d' is advanced into the following input string whenever necessary,
X     but this happens before fetching;
X     therefore, at the beginning of the loop,
X     ``d' can be pointing at the end of a string,
X     but it cannot equal string2.  */
X
X  if (pos <= size1)
X    d = string1 + pos, dend = end_match_1;
X  else
X    d = string2 + pos - size1, dend = end_match_2;
X
X/* Write PREFETCH; just before fetching a character with *d.  */
X#define PREFETCH \
X while (d == dend)`009`009`009`009`009`009    \
X  `123 if (dend == end_match_2) goto fail;  /* end of string2 => failure */   \
X    d = string2;  /* end of string1 => advance to string2. */       \
X    dend = end_match_2; `125
X
X  /* This loop loops over pattern commands.
X     It exits by returning from the function if match is complete,
V     or it drops through if match fails at this starting point in the input dat
Xa. */
X
X  while (1)
X    `123
X      if (p == pend)
X`009/* End of pattern means we have succeeded! */
X`009`123
X`009  /* If caller wants register contents data back, convert it to indices */
X`009  if (regs)
X`009    `123
X `009      regs->start[0] = pos;
X `009      if (dend == end_match_1)
X `009`009regs->end[0] = d - string1;
X `009      else
X `009`009regs->end[0] = d - string2 + size1;
X `009      for (mcnt = 1; mcnt < RE_NREGS; mcnt++)
X`009`009`123
X`009`009  if (regend[mcnt] == (unsigned char *) -1)
X`009`009    `123
X`009`009      regs->start[mcnt] = -1;
X`009`009      regs->end[mcnt] = -1;
X`009`009      continue;
X`009`009    `125
X `009`009  if (regstart_seg1[mcnt])
X`009`009    regs->start[mcnt] = regstart[mcnt] - string1;
X`009`009  else
X`009`009    regs->start[mcnt] = regstart[mcnt] - string2 + size1;
X `009`009  if (regend_seg1[mcnt])
X`009`009    regs->end[mcnt] = regend[mcnt] - string1;
X`009`009  else
X`009`009    regs->end[mcnt] = regend[mcnt] - string2 + size1;
X`009`009`125
X`009    `125
X `009  if (dend == end_match_1)
X`009    return (d - string1 - pos);
X`009  else
X`009    return d - string2 + size1 - pos;
X`009`125
X
X      /* Otherwise match next pattern command */
X#ifdef SWITCH_ENUM_BUG
X      switch ((int) ((enum regexpcode) *p++))
X#else
X      switch ((enum regexpcode) *p++)
X#endif
X`009`123
X
X`009/* \( is represented by a start_memory, \) by a stop_memory.
X`009    Both of those commands contain a "register number" argument.
X`009    The text matched within the \( and \) is recorded under that number.
X`009    Then, \<digit> turns into a ``duplicate' command which
X`009    is followed by the numeric value of <digit> as the register number. */
X
X`009case start_memory:
X`009  regstart[*p] = d;
X `009  regstart_seg1[*p++] = (dend == end_match_1);
X`009  break;
X
X`009case stop_memory:
X`009  regend[*p] = d;
X `009  regend_seg1[*p++] = (dend == end_match_1);
X`009  break;
X
X`009case duplicate:
X`009  `123
X`009    int regno = *p++;   /* Get which register to match against */
X`009    register unsigned char *d2, *dend2;
X
X`009    d2 = regstart[regno];
X `009    dend2 = ((regstart_seg1[regno] == regend_seg1[regno])
X`009`009     ? regend[regno] : end_match_1);
X`009    while (1)
X`009      `123
X`009`009/* Advance to next segment in register contents, if necessary */
X`009`009while (d2 == dend2)
X`009`009  `123
X`009`009    if (dend2 == end_match_2) break;
X`009`009    if (dend2 == regend[regno]) break;
V`009`009    d2 = string2, dend2 = regend[regno];  /* end of string1 => advance
X to string2. */
X`009`009  `125
X`009`009/* At end of register contents => success */
X`009`009if (d2 == dend2) break;
X
X`009`009/* Advance to next segment in data being matched, if necessary */
X`009`009PREFETCH;
X
X`009`009/* mcnt gets # consecutive chars to compare */
X`009`009mcnt = dend - d;
X`009`009if (mcnt > dend2 - d2)
X`009`009  mcnt = dend2 - d2;
X`009`009/* Compare that many; failure if mismatch, else skip them. */
V`009`009if (translate ? bcmp_translate (d, d2, mcnt, translate) : bcmp (d, d2,
X mcnt))
X`009`009  goto fail;
X`009`009d += mcnt, d2 += mcnt;
X`009      `125
X`009  `125
X`009  break;
X
X`009case anychar:
X`009  /* fetch a data character */
X`009  PREFETCH;
X`009  /* Match anything but a newline.  */
X`009  if ((translate ? translate[*d++] : *d++) == '\n')
X`009    goto fail;
X`009  break;
X
X`009case charset:
X`009case charset_not:
X`009  `123
X`009    /* Nonzero for charset_not */
X`009    int not = 0;
X`009    register int c;
X`009    if (*(p - 1) == (unsigned char) charset_not)
X`009      not = 1;
X
X`009    /* fetch a data character */
X`009    PREFETCH;
X
X`009    if (translate)
X`009      c = translate [*d];
X`009    else
X`009      c = *d;
X
X`009    if (c < *p * BYTEWIDTH
X`009`009&& p[1 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH)))
X`009      not = !not;
X
X`009    p += 1 + *p;
X
X`009    if (!not) goto fail;
X`009    d++;
X`009    break;
X`009  `125
X
X`009case begline:
X`009  if (d == string1 `124`124 d[-1] == '\n')
X`009    break;
X`009  goto fail;
X
X`009case endline:
X`009  if (d == end2
V`009      `124`124 (d == end1 ? (size2 == 0 `124`124 *string2 == '\n') : *d ==
X '\n'))
X`009    break;
X`009  goto fail;
X
X`009/* "or" constructs ("`124") are handled by starting each alternative
V`009    with an on_failure_jump that points to the start of the next alternativ
Xe.
X`009    Each alternative except the last ends with a jump to the joining point.
X`009    (Actually, each jump except for the last one really jumps
X`009     to the following jump, because tensioning the jumps is a hassle.) */
X
X`009/* The start of a stupid repeat has an on_failure_jump that points
X`009   past the end of the repeat text.
X`009   This makes a failure point so that, on failure to match a repetition,
X`009   matching restarts past as many repetitions have been found
X`009   with no way to fail and look for another one.  */
X
X`009/* A smart repeat is similar but loops back to the on_failure_jump
X`009   so that each repetition makes another failure point. */
X
X`009case on_failure_jump:
X`009  if (stackp == stacke)
X`009    `123
X`009      unsigned char **stackx;
X`009      if (stacke - stackb > re_max_failures)
X`009`009return -2;
X`009      stackx = (unsigned char **) alloca (2 * (stacke - stackb)
X`009`009`009`009`009 * sizeof (char *));
X`009      bcopy (stackb, stackx, (stacke - stackb) * sizeof (char *));
X`009      stackp += stackx - stackb;
X`009      stacke = stackx + 2 * (stacke - stackb);
X`009      stackb = stackx;
X`009    `125
X`009  mcnt = *p++ & 0377;
X`009  mcnt += SIGN_EXTEND_CHAR (*(char *)p) << 8;
X`009  p++;
X`009  *stackp++ = mcnt + p;
X`009  *stackp++ = d;
X`009  break;
X
X`009/* The end of a smart repeat has an maybe_finalize_jump back.
X`009   Change it either to a finalize_jump or an ordinary jump. */
X
X`009case maybe_finalize_jump:
X`009  mcnt = *p++ & 0377;
X`009  mcnt += SIGN_EXTEND_CHAR (*(char *)p) << 8;
X`009  p++;
X`009  /* Compare what follows with the begining of the repeat.
X`009     If we can establish that there is nothing that they would
X`009     both match, we can change to finalize_jump */
X`009  if (p == pend)
X`009    p[-3] = (unsigned char) finalize_jump;
X`009  else if (*p == (unsigned char) exactn
X`009`009   `124`124 *p == (unsigned char) endline)
X`009    `123
X`009      register int c = *p == (unsigned char) endline ? '\n' : p[2];
X`009      register unsigned char *p1 = p + mcnt;
X`009      /* p1[0] ... p1[2] are an on_failure_jump.
X`009`009 Examine what follows that */
X`009      if (p1[3] == (unsigned char) exactn && p1[5] != c)
X`009`009p[-3] = (unsigned char) finalize_jump;
X`009      else if (p1[3] == (unsigned char) charset
X`009`009       `124`124 p1[3] == (unsigned char) charset_not)
X`009`009`123
X`009`009  int not = p1[3] == (unsigned char) charset_not;
X`009`009  if (c < p1[4] * BYTEWIDTH
X`009`009      && p1[5 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH)))
X`009`009    not = !not;
X`009`009  /* not is 1 if c would match */
X`009`009  /* That means it is not safe to finalize */
X`009`009  if (!not)
X`009`009    p[-3] = (unsigned char) finalize_jump;
X`009`009`125
X`009    `125
X`009  p -= 2;
X`009  if (p[-1] != (unsigned char) finalize_jump)
X`009    `123
X`009      p[-1] = (unsigned char) jump;
X`009      goto nofinalize;
X`009    `125
X
X`009/* The end of a stupid repeat has a finalize-jump
X`009   back to the start, where another failure point will be made
X`009   which will point after all the repetitions found so far. */
X
X`009case finalize_jump:
X`009  stackp -= 2;
X
X`009case jump:
X`009nofinalize:
X`009  mcnt = *p++ & 0377;
X`009  mcnt += SIGN_EXTEND_CHAR (*(char *)p) << 8;
X`009  p += mcnt + 1;`009/* The 1 compensates for missing ++ above */
X`009  break;
X
X`009case dummy_failure_jump:
X`009  if (stackp == stacke)
X`009    `123
X`009      unsigned char **stackx
X`009`009= (unsigned char **) alloca (2 * (stacke - stackb)
X`009`009`009`009`009     * sizeof (char *));
X`009      bcopy (stackb, stackx, (stacke - stackb) * sizeof (char *));
X`009      stackp += stackx - stackb;
X`009      stacke = stackx + 2 * (stacke - stackb);
X`009      stackb = stackx;
X`009    `125
X`009  *stackp++ = 0;
X`009  *stackp++ = 0;
X`009  goto nofinalize;
X
X`009case wordbound:
X`009  if (d == string1  /* Points to first char */
X`009      `124`124 d == end2  /* Points to end */
X`009      `124`124 (d == end1 && size2 == 0)) /* Points to end */
X`009    break;
X`009  if ((SYNTAX (d[-1]) == Sword)
X`009      != (SYNTAX (d == end1 ? *string2 : *d) == Sword))
X`009    break;
X`009  goto fail;
X
X`009case notwordbound:
X`009  if (d == string1  /* Points to first char */
X`009      `124`124 d == end2  /* Points to end */
X`009      `124`124 (d == end1 && size2 == 0)) /* Points to end */
X`009    goto fail;
X`009  if ((SYNTAX (d[-1]) == Sword)
X`009      != (SYNTAX (d == end1 ? *string2 : *d) == Sword))
X`009    goto fail;
X`009  break;
X
X`009case wordbeg:
X`009  if (d == end2  /* Points to end */
X`009      `124`124 (d == end1 && size2 == 0) /* Points to end */
V`009      `124`124 SYNTAX (* (d == end1 ? string2 : d)) != Sword) /* Next char
X not a letter */
X`009    goto fail;
X`009  if (d == string1  /* Points to first char */
X`009      `124`124 SYNTAX (d[-1]) != Sword)  /* prev char not letter */
X`009    break;
X`009  goto fail;
X
X`009case wordend:
X`009  if (d == string1  /* Points to first char */
X`009      `124`124 SYNTAX (d[-1]) != Sword)  /* prev char not letter */
X`009    goto fail;
X`009  if (d == end2  /* Points to end */
X`009      `124`124 (d == end1 && size2 == 0) /* Points to end */
V`009      `124`124 SYNTAX (d == end1 ? *string2 : *d) != Sword) /* Next char no
Xt a letter */
X`009    break;
X`009  goto fail;
X
X#ifdef emacs
X`009case before_dot:
X`009  if (((d - string2 <= (unsigned) size2)
X`009       ? d - bf_p2 : d - bf_p1)
X`009      <= point)
X`009    goto fail;
X`009  break;
X
X`009case at_dot:
X`009  if (((d - string2 <= (unsigned) size2)
X`009       ? d - bf_p2 : d - bf_p1)
X`009      == point)
X`009    goto fail;
X`009  break;
X
X`009case after_dot:
X`009  if (((d - string2 <= (unsigned) size2)
X`009       ? d - bf_p2 : d - bf_p1)
X`009      >= point)
X`009    goto fail;
X`009  break;
X
X`009case wordchar:
X`009  mcnt = (int) Sword;
X`009  goto matchsyntax;
X
X`009case syntaxspec:
X`009  mcnt = *p++;
X`009matchsyntax:
X`009  PREFETCH;
X`009  if (SYNTAX (*d++) != (enum syntaxcode) mcnt) goto fail;
X`009  break;
X`009 `032
X`009case notwordchar:
X`009  mcnt = (int) Sword;
X`009  goto matchnotsyntax;
X
X`009case notsyntaxspec:
X`009  mcnt = *p++;
X`009matchnotsyntax:
X`009  PREFETCH;
X`009  if (SYNTAX (*d++) == (enum syntaxcode) mcnt) goto fail;
X`009  break;
X#else
X`009case wordchar:
X`009  PREFETCH;
X`009  if (SYNTAX (*d++) == 0) goto fail;
X`009  break;
X`009 `032
X`009case notwordchar:
X`009  PREFETCH;
X`009  if (SYNTAX (*d++) != 0) goto fail;
X`009  break;
X#endif not emacs
X
X`009case begbuf:
X`009  if (d == string1)`009/* Note, d cannot equal string2 */
X`009    break;`009`009/* unless string1 == string2.  */
X`009  goto fail;
X
X`009case endbuf:
X`009  if (d == end2 `124`124 (d == end1 && size2 == 0))
X`009    break;
X`009  goto fail;
X
X`009case exactn:
X`009  /* Match the next few pattern characters exactly.
X`009     mcnt is how many characters to match. */
X`009  mcnt = *p++;
X`009  if (translate)
X`009    `123
X`009      do
X`009`009`123
X`009`009  PREFETCH;
X`009`009  if (translate[*d++] != *p++) goto fail;
X`009`009`125
X`009      while (--mcnt);
X`009    `125
X`009  else
X`009    `123
X`009      do
X`009`009`123
X`009`009  PREFETCH;
X`009`009  if (*d++ != *p++) goto fail;
X`009`009`125
X`009      while (--mcnt);
X`009    `125
X`009  break;
X`009`125
V      continue;    /* Successfully matched one pattern command; keep matching *
X/
X
X      /* Jump here if any matching operation fails. */
X    fail:
X      if (stackp != stackb)
X`009/* A restart point is known.  Restart there and pop it. */
X`009`123
X`009  if (!stackp[-2])
V`009    `123   /* If innermost failure point is dormant, flush it and keep look
Xing */
X`009      stackp -= 2;
X`009      goto fail;
X`009    `125
X`009  d = *--stackp;
X`009  p = *--stackp;
X`009  if (d >= string1 && d <= end1)
X`009    dend = end_match_1;
X`009`125
X      else break;   /* Matching at this starting point really fails! */
X    `125
X  return -1;         /* Failure to match */
X`125
X
Xstatic int
Xbcmp_translate (s1, s2, len, translate)
X     unsigned char *s1, *s2;
X     register int len;
X     unsigned char *translate;
X`123
X  register unsigned char *p1 = s1, *p2 = s2;
X  while (len)
X    `123
X      if (translate [*p1++] != translate [*p2++]) return 1;
X      len--;
X    `125
X  return 0;
X`125
X`012
X/* Entry points compatible with bsd4.2 regex library */
X
X#ifndef emacs
X
Xstatic struct re_pattern_buffer re_comp_buf;
X
Xchar *
Xre_comp (s)
X     char *s;
X`123
X  if (!s)
X    `123
X      if (!re_comp_buf.buffer)
X`009return "No previous regular expression";
X      return 0;
X    `125
X
X  if (!re_comp_buf.buffer)
X    `123
X      if (!(re_comp_buf.buffer = (char *) malloc (200)))
X`009return "Memory exhausted";
X      re_comp_buf.allocated = 200;
X      if (!(re_comp_buf.fastmap = (char *) malloc (1 << BYTEWIDTH)))
X`009return "Memory exhausted";
X    `125
X  return re_compile_pattern (s, strlen (s), &re_comp_buf);
X`125
X
Xint
Xre_exec (s)
X     char *s;
X`123
X  int len = strlen (s);
X  return 0 <= re_search (&re_comp_buf, s, len, 0, len, 0);
X`125
X
X#endif /* emacs */
X`012
X#ifdef test
X
X#include <stdio.h>
X
X/* Indexed by a character, gives the upper case equivalent of the character */
X
Xstatic char upcase[0400] =`032
X  `123 000, 001, 002, 003, 004, 005, 006, 007,
X    010, 011, 012, 013, 014, 015, 016, 017,
X    020, 021, 022, 023, 024, 025, 026, 027,
X    030, 031, 032, 033, 034, 035, 036, 037,
X    040, 041, 042, 043, 044, 045, 046, 047,
X    050, 051, 052, 053, 054, 055, 056, 057,
X    060, 061, 062, 063, 064, 065, 066, 067,
X    070, 071, 072, 073, 074, 075, 076, 077,
X    0100, 0101, 0102, 0103, 0104, 0105, 0106, 0107,
X    0110, 0111, 0112, 0113, 0114, 0115, 0116, 0117,
X    0120, 0121, 0122, 0123, 0124, 0125, 0126, 0127,
X    0130, 0131, 0132, 0133, 0134, 0135, 0136, 0137,
X    0140, 0101, 0102, 0103, 0104, 0105, 0106, 0107,
X    0110, 0111, 0112, 0113, 0114, 0115, 0116, 0117,
X    0120, 0121, 0122, 0123, 0124, 0125, 0126, 0127,
X    0130, 0131, 0132, 0173, 0174, 0175, 0176, 0177,
X    0200, 0201, 0202, 0203, 0204, 0205, 0206, 0207,
X    0210, 0211, 0212, 0213, 0214, 0215, 0216, 0217,
X    0220, 0221, 0222, 0223, 0224, 0225, 0226, 0227,
X    0230, 0231, 0232, 0233, 0234, 0235, 0236, 0237,
X    0240, 0241, 0242, 0243, 0244, 0245, 0246, 0247,
X    0250, 0251, 0252, 0253, 0254, 0255, 0256, 0257,
X    0260, 0261, 0262, 0263, 0264, 0265, 0266, 0267,
X    0270, 0271, 0272, 0273, 0274, 0275, 0276, 0277,
X    0300, 0301, 0302, 0303, 0304, 0305, 0306, 0307,
X    0310, 0311, 0312, 0313, 0314, 0315, 0316, 0317,
X    0320, 0321, 0322, 0323, 0324, 0325, 0326, 0327,
X    0330, 0331, 0332, 0333, 0334, 0335, 0336, 0337,
X    0340, 0341, 0342, 0343, 0344, 0345, 0346, 0347,
X    0350, 0351, 0352, 0353, 0354, 0355, 0356, 0357,
X    0360, 0361, 0362, 0363, 0364, 0365, 0366, 0367,
X    0370, 0371, 0372, 0373, 0374, 0375, 0376, 0377
X  `125;
X
Xmain (argc, argv)
X     int argc;
X     char **argv;
X`123
X  char pat[80];
X  struct re_pattern_buffer buf;
X  int i;
X  char c;
X  char fastmap[(1 << BYTEWIDTH)];
X
X  /* Allow a command argument to specify the style of syntax.  */
X  if (argc > 1)
X    obscure_syntax = atoi (argv[1]);
X
X  buf.allocated = 40;
X  buf.buffer = (char *) malloc (buf.allocated);
X  buf.fastmap = fastmap;
X  buf.translate = upcase;
X
X  while (1)
X    `123
X      gets (pat);
X
X      if (*pat)
X`009`123
X          re_compile_pattern (pat, strlen(pat), &buf);
X
X`009  for (i = 0; i < buf.used; i++)
X`009    printchar (buf.buffer[i]);
X
X`009  putchar ('\n');
X
X`009  printf ("%d allocated, %d used.\n", buf.allocated, buf.used);
X
X`009  re_compile_fastmap (&buf);
X`009  printf ("Allowed by fastmap: ");
X`009  for (i = 0; i < (1 << BYTEWIDTH); i++)
X`009    if (fastmap[i]) printchar (i);
X`009  putchar ('\n');
X`009`125
X
X      gets (pat);`009/* Now read the string to match against */
X
X      i = re_match (&buf, pat, strlen (pat), 0, 0);
X      printf ("Match value %d.\n", i);
X    `125
X`125
X
X#ifdef NOTDEF
Xprint_buf (bufp)
X     struct re_pattern_buffer *bufp;
X`123
X  int i;
X
X  printf ("buf is :\n----------------\n");
X  for (i = 0; i < bufp->used; i++)
X    printchar (bufp->buffer[i]);
X `032
X  printf ("\n%d allocated, %d used.\n", bufp->allocated, bufp->used);
X `032
X  printf ("Allowed by fastmap: ");
X  for (i = 0; i < (1 << BYTEWIDTH); i++)
X    if (bufp->fastmap[i])
X      printchar (i);
X  printf ("\nAllowed by translate: ");
X  if (bufp->translate)
X    for (i = 0; i < (1 << BYTEWIDTH); i++)
X      if (bufp->translate[i])
X`009printchar (i);
X  printf ("\nfastmap is%s accurate\n", bufp->fastmap_accurate ? "" : "n't");
X  printf ("can %s be null\n----------", bufp->can_be_null ? "" : "not");
X`125
X#endif
X
Xprintchar (c)
X     char c;
X`123
X  if (c < 041 `124`124 c >= 0177)
X    `123
X      putchar ('\\');
X      putchar (((c >> 6) & 3) + '0');
X      putchar (((c >> 3) & 7) + '0');
X      putchar ((c & 7) + '0');
X    `125
X  else
X    putchar (c);
X`125
X
Xerror (string)
X     char *string;
X`123
X  puts (string);
X  exit (1);
X`125
X
X#endif test
$ GOSUB UNPACK_FILE
$ FILE_IS = "REGEX.H"
$ CHECKSUM_IS = 1868368550
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/* Definitions for data structures callers pass the regex library.
X   Copyright (C) 1985 Free Software Foundation, Inc.
X
X`009`009       NO WARRANTY
X
X  BECAUSE THIS PROGRAM IS LICENSED FREE OF CHARGE, WE PROVIDE ABSOLUTELY
XNO WARRANTY, TO THE EXTENT PERMITTED BY APPLICABLE STATE LAW.  EXCEPT
XWHEN OTHERWISE STATED IN WRITING, FREE SOFTWARE FOUNDATION, INC,
XRICHARD M. STALLMAN AND/OR OTHER PARTIES PROVIDE THIS PROGRAM "AS IS"
XWITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING,
XBUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
XFITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY
XAND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE PROGRAM PROVE
XDEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
XCORRECTION.
X
X IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW WILL RICHARD M.
XSTALLMAN, THE FREE SOFTWARE FOUNDATION, INC., AND/OR ANY OTHER PARTY
XWHO MAY MODIFY AND REDISTRIBUTE THIS PROGRAM AS PERMITTED BELOW, BE
XLIABLE TO YOU FOR DAMAGES, INCLUDING ANY LOST PROFITS, LOST MONIES, OR
XOTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
XUSE OR INABILITY TO USE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR
XDATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD PARTIES OR
XA FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS) THIS
XPROGRAM, EVEN IF YOU HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH
XDAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY.
X
X`009`009GENERAL PUBLIC LICENSE TO COPY
X
X  1. You may copy and distribute verbatim copies of this source file
Xas you receive it, in any medium, provided that you conspicuously and
Xappropriately publish on each copy a valid copyright notice "Copyright
X(C) 1985 Free Software Foundation, Inc."; and include following the
Xcopyright notice a verbatim copy of the above disclaimer of warranty
Xand of this License.  You may charge a distribution fee for the
Xphysical act of transferring a copy.
X
X  2. You may modify your copy or copies of this source file or
Xany portion of it, and copy and distribute such modifications under
Xthe terms of Paragraph 1 above, provided that you also do the following:
X
X    a) cause the modified files to carry prominent notices stating
X    that you changed the files and the date of any change; and
X
X    b) cause the whole of any work that you distribute or publish,
X    that in whole or in part contains or is a derivative of this
X    program or any part thereof, to be licensed at no charge to all
X    third parties on terms identical to those contained in this
X    License Agreement (except that you may choose to grant more extensive
X    warranty protection to some or all third parties, at your option).
X
X    c) You may charge a distribution fee for the physical act of
X    transferring a copy, and you may at your option offer warranty
X    protection in exchange for a fee.
X
XMere aggregation of another unrelated program with this program (or its
Xderivative) on a volume of a storage or distribution medium does not bring
Xthe other program under the scope of these terms.
X
X  3. You may copy and distribute this program (or a portion or derivative
Xof it, under Paragraph 2) in object code or executable form under the terms
Xof Paragraphs 1 and 2 above provided that you also do one of the following:
X
X    a) accompany it with the complete corresponding machine-readable
X    source code, which must be distributed under the terms of
X    Paragraphs 1 and 2 above; or,
X
X    b) accompany it with a written offer, valid for at least three
X    years, to give any third party free (except for a nominal
X    shipping charge) a complete machine-readable copy of the
X    corresponding source code, to be distributed under the terms of
X    Paragraphs 1 and 2 above; or,
X
X    c) accompany it with the information you received as to where the
X    corresponding source code may be obtained.  (This alternative is
X    allowed only for noncommercial distribution and only if you
X    received the program in object code or executable form alone.)
X
XFor an executable file, complete source code means all the source code for
Xall modules it contains; but, as a special exception, it need not include
Xsource code for modules which are standard libraries that accompany the
Xoperating system on which the executable file runs.
X
X  4. You may not copy, sublicense, distribute or transfer this program
Xexcept as expressly provided under this License Agreement.  Any attempt
Xotherwise to copy, sublicense, distribute or transfer this program is void and
Xyour rights to use the program under this License agreement shall be
Xautomatically terminated.  However, parties who have received computer
Xsoftware programs from you with this License Agreement will not have
Xtheir licenses terminated so long as such parties remain in full compliance.
X
X  5. If you wish to incorporate parts of this program into other free
Xprograms whose distribution conditions are different, write to the Free
XSoftware Foundation at 675 Mass Ave, Cambridge, MA 02139.  We have not yet
Xworked out a simple rule that can be stated here, but we will often permit
Xthis.  We will be guided by the two goals of preserving the free status of
Xall derivatives of our free software and of promoting the sharing and reuse of
Xsoftware.
X
X
XIn other words, you are welcome to use, share and improve this program.
XYou are forbidden to forbid anyone else to use, share and improve
Xwhat you give them.   Help stamp out software-hoarding!  */
X
X
X/* Define number of parens for which we record the beginnings and ends.
X   This affects how much space the ``struct re_registers' type takes up.  */
X#ifndef RE_NREGS
X#define RE_NREGS 10
X#endif
X
X/* These bits are used in the obscure_syntax variable to choose among
X   alternative regexp syntaxes.  */
X
X/* 1 means plain parentheses serve as grouping, and backslash
X     parentheses are needed for literal searching.
X   0 means backslash-parentheses are grouping, and plain parentheses
X     are for literal searching.  */
X#define RE_NO_BK_PARENS`0091
X
X/* 1 means plain `124 serves as the "or"-operator, and \`124 is a literal.
X   0 means \`124 serves as the "or"-operator, and `124 is a literal.  */
X#define RE_NO_BK_VBAR`0092
X
X/* 0 means plain + or ? serves as an operator, and \+, \? are literals.
X   1 means \+, \? are operators and plain +, ? are literals.  */
X#define RE_BK_PLUS_QM   4
X
X/* 1 means `124 binds tighter than `094 or $.
X   0 means the contrary.  */
X#define RE_TIGHT_VBAR   8
X
X/* 1 means treat \n as an _OR operator
X   0 means treat it as a normal character */
X#define RE_NEWLINE_OR 16
X
X/* 0 means that a special characters (such as *, `094, and $) always have
X     their special meaning regardless of the surrounding context.
X   1 means that special characters may act as normal characters in some
X     contexts.  Specifically, this applies to:
X`009`094 - only special at the beginning, or after ( or `124
X`009$ - only special at the end, or before ) or `124
X`009*, +, ? - only special when not after the beginning, (, or `124 */
X#define RE_CONTEXT_INDEP_OPS 32
X
X/* Now define combinations of bits for the standard possibilities.  */
X#define RE_SYNTAX_EGREP \
V (RE_NO_BK_PARENS `124 RE_NO_BK_VBAR `124 RE_NEWLINE_OR `124 RE_CONTEXT_INDEP_O
XPS)
X#define RE_SYNTAX_GREP (RE_BK_PLUS_QM `124 RE_NEWLINE_OR)
X#define RE_SYNTAX_EMACS 0
X
X/* This data structure is used to represent a compiled pattern. */
X
Xstruct re_pattern_buffer
X  `123
X    char *buffer;`009/* Space holding the compiled pattern commands. */
X    int allocated;`009/* Size of space that  buffer  points to */
X    int used;`009`009/* Length of portion of buffer actually occupied */
X    char *fastmap;`009/* Pointer to fastmap, if any, or zero if none. */
X`009`009`009/* re_search uses the fastmap, if there is one,
X`009`009`009   to skip quickly over totally implausible characters */
V    char *translate;`009/* Translate table to apply to all characters before co
Xmparing.
X`009`009`009   Or zero for no translation.
X`009`009`009   The translation is applied to a pattern when it is compiled
X`009`009`009   and to data when it is matched. */
X    char fastmap_accurate;
X`009`009`009/* Set to zero when a new pattern is stored,
X`009`009`009   set to one when the fastmap is updated from it. */
X    char can_be_null;   /* Set to one by compiling fastmap
X`009`009`009   if this pattern might match the null string.
X`009`009`009   It does not necessarily match the null string
X`009`009`009   in that case, but if this is zero, it cannot.
X`009`009`009   2 as value means can match null string
X`009`009`009   but at end of range or before a character
X`009`009`009   listed in the fastmap.  */
X  `125;
X
X/* Structure to store "register" contents data in.
X
X   Pass the address of such a structure as an argument to re_match, etc.,
X   if you want this information back.
X
X   start[i] and end[i] record the string matched by \( ... \) grouping i,
X   for i from 1 to RE_NREGS - 1.
X   start[0] and end[0] record the entire string matched. */
X
Xstruct re_registers
X  `123
X    int start[RE_NREGS];
X    int end[RE_NREGS];
X  `125;
X
V/* These are the command codes that appear in compiled regular expressions, one
X per byte.
X  Some command codes are followed by argument bytes.
X  A command code can specify any interpretation whatever for its arguments.
X  Zero-bytes may appear in the compiled regular expression. */
X
Xenum regexpcode
X  `123
X    unused,
X    exactn,    /* followed by one byte giving n, and then by n literal bytes */
X    begline,   /* fails unless at beginning of line */
X    endline,   /* fails unless at end of line */
X    jump,`009 /* followed by two bytes giving relative address to jump to */
V    on_failure_jump,`009 /* followed by two bytes giving relative address of pl
Xace
X`009`009            to resume at in case of failure. */
V    finalize_jump,`009 /* Throw away latest failure point and then jump to addr
Xess. */
X    maybe_finalize_jump, /* Like jump but finalize if safe to do so.
X`009`009`009    This is used to jump back to the beginning
X`009`009`009    of a repeat.  If the command that follows
X`009`009`009    this jump is clearly incompatible with the
X`009`009`009    one at the beginning of the repeat, such that
X`009`009`009    we can be sure that there is no use backtracking
X`009`009`009    out of repetitions already completed,
X`009`009`009    then we finalize. */
X    dummy_failure_jump,  /* jump, and push a dummy failure point.
X`009`009`009    This failure point will be thrown away
X`009`009`009    if an attempt is made to use it for a failure.
X`009`009`009    A + construct makes this before the first repeat.  */
X    anychar,`009 /* matches any one character */
X    charset,     /* matches any one char belonging to specified set.
X`009`009    First following byte is # bitmap bytes.
X`009`009    Then come bytes for a bit-map saying which chars are in.
X`009`009    Bits in each byte are ordered low-bit-first.
X`009`009    A character is in the set if its bit is 1.
X`009`009    A character too large to have a bit in the map
X`009`009    is automatically not in the set */
V    charset_not, /* similar but match any character that is NOT one of those sp
Xecified */
X    start_memory, /* starts remembering the text that is matched
X`009`009    and stores it in a memory register.
X`009`009    followed by one byte containing the register number.
X`009`009    Register numbers must be in the range 0 through NREGS. */
X    stop_memory, /* stops remembering the text that is matched
X`009`009    and stores it in a memory register.
X`009`009    followed by one byte containing the register number.
X`009`009    Register numbers must be in the range 0 through NREGS. */
X    duplicate,    /* match a duplicate of something remembered.
V`009`009    Followed by one byte containing the index of the memory register. *
X/
X    before_dot,`009 /* Succeeds if before dot */
X    at_dot,`009 /* Succeeds if at dot */
X    after_dot,`009 /* Succeeds if after dot */
X    begbuf,      /* Succeeds if at beginning of buffer */
X    endbuf,      /* Succeeds if at end of buffer */
X    wordchar,    /* Matches any word-constituent character */
X    notwordchar, /* Matches any char that is not a word-constituent */
X    wordbeg,`009 /* Succeeds if at word beginning */
X    wordend,`009 /* Succeeds if at word end */
X    wordbound,   /* Succeeds if at a word boundary */
X    notwordbound, /* Succeeds if not at a word boundary */
X    syntaxspec,  /* Matches any character whose syntax is specified.
V`009`009    followed by a byte which contains a syntax code, Sword or such like
X */
V    notsyntaxspec /* Matches any character whose syntax differs from the specif
Xied. */
X  `125;
X`012
Xextern char *re_compile_pattern ();
X/* Is this really advertised? */
Xextern void re_compile_fastmap ();
Xextern int re_search (), re_search_2 ();
Xextern int re_match (), re_match_2 ();
X
X/* 4.2 bsd compatibility (yuck) */
Xextern char *re_comp ();
Xextern int re_exec ();
X
X#ifdef SYNTAX_TABLE
Xextern char *re_syntax_table;
X#endif
$ GOSUB UNPACK_FILE
$ FILE_IS = "VERSION.C"
$ CHECKSUM_IS = 158282763
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
Xchar *version_string = "Gnu Awk (gawk) version 1.03 (I guess)";
X
X/* 1.02`009`009fixed /= += *= etc to return the new Left Hand Side instead
X`009`009of the Right Hand Side */
X
X/* 1.03`009`009Fixed split() to treat strings of space and tab as FS if
X`009`009the split char is ' '.
X
X`009`009Added -v option to print version number
X `009`009
X`009`009Fixed bug that caused rounding when printing large numbers  */
$ GOSUB UNPACK_FILE
$ FILE_IS = "VMS-AWK-DIFFS.1_OF_1"
$ CHECKSUM_IS = 1936273219
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
V$! ...................... Cut between dotted lines and save. ..................
X...
X$!.............................................................................
X$! VAX/VMS archive file created by VMS_SHARE V06.03 20-Oct-1988.
X$!
X$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
X$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
X$!
X$! To unpack, simply save, concatinate all parts into one file and
X$! execute (@) that file.
X$!
X$! This archive was created by user WARNER
X$! on 11-NOV-1988 15:48:00.90.
X$!
X$! It contains the following 10 files:
X$!        ALLOCA.MAR
X$!        AWK.H-DIFF
X$!        AWK2.C-DIFF
X$!        BCMP.MAR
X$!        BCOPY.MAR
X$!        BZERO.MAR
X$!        CLINK.OPT
X$!        MAKE-GAWK.COM
X$!        README.VMS
X$!        VMS-PORT.C
X$!
V$!=============================================================================
X=
X$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
X$ VERSION = F$GETSYI( "VERSION" )
X$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
X$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
X    "VMS_SHARE V06.03 20-Oct-1988 requires VMS V4.4 or higher."
X$ EXIT 44`032
X$VERSION_OK:
X$ GOTO START
X$
X$UNPACK_FILE:
X$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
X$ DEFINE/USER_MODE SYS$OUTPUT NL:
X$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
X    VMS_SHARE_DUMMY.DUMMY
X
Vb_part := CREATE_BUFFER( "`123Part`125", GET_INFO( COMMAND_LINE, "file_name" )
X );
Xs_file_spec := GET_INFO( COMMAND_LINE, "output_file" );SET( OUTPUT_FILE
X, b_part, s_file_spec );`032
Xb_errors := CREATE_BUFFER( "`123Errors`125" );i_errors := 0;`032
Xpat_beg_1 := ANCHOR & "-+-+-+ Beginning";
Xpat_beg_2 := LINE_BEGIN & "+-+-+-+ Beginning";
Xpat_end := ANCHOR & "+-+-+-+-+ End";
Xpat_trail := " " & LINE_END;POSITION( BEGINNING_OF( b_part ) ); LOOP b`032
X:= SEARCH( pat_trail, FORWARD); EXITIF b=0; POSITION( END_OF( b ) )
X; LOOP MOVE_HORIZONTAL( -1 ); EXITIF CURRENT_CHARACTER <> ' '; ERASE_CHARACTER
X( 1 ); EXITIF CURRENT_OFFSET=0; ENDLOOP; ENDLOOP; POSITION( BEGINNING_OF
X( b_part ) ); i_append_line := 0; LOOP EXITIF MARK( NONE ) = END_OF( b_part )
X; s_x := ERASE_CHARACTER( 1 );`032
X  IF s_x = "+" THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <
X> 0 THEN`032
V      s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF; ENDIF;`
X032
X  IF s_x = "-" THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ); IF r_skip <
X> 0 THEN`032
X      s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE )
X; r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION
X( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL( 1 )
X; MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE
X( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF;`032
X  IF s_x = "V" THEN`032
X    s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL
X( -CURRENT_OFFSET ); ENDIF; i_append_line := 1; MOVE_VERTICAL( 1 ); ENDIF;`032
X  IF s_x = "X" THEN`032
X    s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL
X( -CURRENT_OFFSET ); ENDIF; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF;`032
X  IF s_x <> "" THEN i_errors := i_errors + 1; s_text := CURRENT_LINE; POSITION
X( b_errors );`032
X    COPY_TEXT( "The following line could not be unpacked properly:" )
X; SPLIT_LINE; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part )
V; MOVE_VERTICAL( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP`
X032
X  r_x := SEARCH( "``", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x )
X; ERASE_CHARACTER( 1 );`032
X  IF CURRENT_CHARACTER = "``" THEN MOVE_HORIZONTAL( 1 ); ELSE COPY_TEXT( ASCII
X( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDIF; ENDLOOP; IF i_errors = 0 THEN SET
X( NO_WRITE, b_errors, ON ); ELSE POSITION( BEGINNING_OF( b_errors ) );`032
X  COPY_TEXT( FAO( "The following !UL errors were detected while unpacking !AS"
X, i_errors, s_file_spec ) ); SPLIT_LINE;`032
X  SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" );ENDIF; EXIT;`032
X$ DELETE VMS_SHARE_DUMMY.DUMMY;*
X$ CHECKSUM 'FILE_IS
X$ WRITE SYS$OUTPUT " CHECKSUM ", -
X  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!,passed." )
X$ RETURN
X$
X$START:
X$ FILE_IS = "ALLOCA.MAR"
X$ CHECKSUM_IS = 7999314
X$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XX``009.TITLE``009ALLOCA``009Allocate dynamic storage on stack/free on return
XX``009.IDENT``009/1.00/
XX
XX``009.PSECT``009$CODE,LONG,PIC,REL,SHR,EXE,RD,NOWRT
XX``009.ENTRY``009ALLOCA,``094M<>
XX``009SUBL2``0094(AP),SP
XX``009MOVL``00916(FP),R1
XX``009MOVQ``0098(FP),AP
XX``009BICL2``009#3,SP
XX``009ADDL2``009#28,SP
XX``009MOVL``009SP,R0
XX``009JMP ``009(R1)
XX
XX``009.END
X$ GOSUB UNPACK_FILE
X$ FILE_IS = "AWK.H-DIFF"
X$ CHECKSUM_IS = 1767329072
X$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XX************
XXFile USER:[WARNER.SRC.AWK.ORG]AWK.H;1
XX   35   char *malloc(),*realloc();
XX******
XXFile USER:[WARNER.SRC.AWK]AWK.H;2
XX   35   #ifdef VMS``009``009/* Needed for VAX C 2.2, but not 2.3... */
XX   36   #define exit(x) vms_exit(x)
XX   37   #endif
XX   38  ``032
XX   39   char *malloc(),*realloc();
XX************
XX
XXNumber of difference sections found: 1
XXNumber of difference records found: 4
XX
XXDIFFERENCES /IGNORE=()/MERGED=1/OUTPUT=USER:[WARNER.SRC.AWK.ORG]AWK.H-DIFF;1-
XX    USER:[WARNER.SRC.AWK.ORG]AWK.H;1-
XX    USER:[WARNER.SRC.AWK]AWK.H;2
X$ GOSUB UNPACK_FILE
X$ FILE_IS = "AWK2.C-DIFF"
X$ CHECKSUM_IS = 73745698
X$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XX************
XXFile USER:[WARNER.SRC.AWK.ORG]AWK2.C;1
XX   36   #include "awk.h"
XX******
XXFile USER:[WARNER.SRC.AWK]AWK2.C;4
XX   36   # ifdef VMS
XX   37   #define Generic char
XX   38   #define _setjmp setjmp
XX   39   #define _longjmp longjmp
XX   40   # else
XX   41   #define Generic void
XX   42   # endif
XX   43  ``032
XX   44   #include "awk.h"
XX************
XX************
XXFile USER:[WARNER.SRC.AWK.ORG]AWK2.C;1
XX  983   ``009``009``009free((void *)bucket);
XX  984   ``009``009``125
XX******
XXFile USER:[WARNER.SRC.AWK]AWK2.C;4
XX  991   ``009``009``009free((Generic *)bucket);
XX  992   ``009``009``125
XX************
XX
XXNumber of difference sections found: 2
XXNumber of difference records found: 9
XX
XXDIFFERENCES /IGNORE=()/MERGED=1/OUTPUT=USER:[WARNER.SRC.AWK.ORG]AWK2.C-DIFF;1-
XX    USER:[WARNER.SRC.AWK.ORG]AWK2.C;1-
XX    USER:[WARNER.SRC.AWK]AWK2.C;4
X$ GOSUB UNPACK_FILE
X$ FILE_IS = "BCMP.MAR"
X$ CHECKSUM_IS = 24650371
X$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XX``009.TITLE``009BCMP``009Compare 2 strings of bytes
XX``009.IDENT``009/1.00/
XX
XX
XX
XX``009.PSECT``009$CODE,LONG,PIC,REL,SHR,EXE,RD,NOWRT
XX
XX; bcmp(s1, s2, n)
XX
XX``009.ENTRY``009BCMP,``094M<R2,R3,R4,R5>
XX``009MOVL``0094(AP),R1
XX``009MOVL``0098(AP),R3
XX``009MOVL``00912(AP),R4
XX1$:
XX``009MOVZWL``009#65535,R0
XX``009CMPL``009R4,R0
XX``009BLEQ``0092$
XX``009SUBL2``009R0,R4
XX``009CMPC3``009R0,(R1),(R3)
XX``009BEQL``0091$
XX``009ADDL2``009R4,R0
XX``009RET
XX2$:
XX``009CMPC3``009R4,(R1),(R3)
XX``009RET
XX
XX``009.END
X$ GOSUB UNPACK_FILE
X$ FILE_IS = "BCOPY.MAR"
X$ CHECKSUM_IS = 136364532
X$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XX``009.TITLE``009BCOPY``009Copy bytes from one array to another
XX``009.IDENT``009/1.00/
XX
XX``009.PSECT``009$CODE,LONG,PIC,REL,SHR,EXE,RD,NOWRT
XX
XX; bcopy(from, to, size)
XX
XX``009.ENTRY``009BCOPY,``094M<R2,R3,R4,R5,R6>
XX``009MOVL``0094(AP),R1
XX``009MOVL``0098(AP),R3
XX``009MOVL``00912(AP),R6
XX``009CMPL``009R1,R3
XX``009BGTR``0092$``009``009; NORMAL FORWARD CASE
XX``009BLSS``0093$``009``009; OVERLAPPING, MUST DO BACKWARDS
XX``009RET``009``009``009; EQUAL, NOTHING TO DO
XX1$:
XX``009SUBL2``009R0,R6
XX``009MOVC3``009R0,(R1),(R3)
XX2$:
XX``009MOVZWL``009#65535,R0
XX``009CMPL``009R6,R0
XX``009BGTR``0091$
XX``009MOVC3``009R6,(R1),(R3)
XX``009RET
XX3$:
XX``009ADDL2``009R6,R1
XX``009ADDL2``009R6,R3
XX``009MOVZWL``009#65535,R0
XX``009BRW``0095$
XX4$:
XX``009SUBL2``009R0,R6
XX``009SUBL2``009R0,R1
XX``009SUBL2``009R0,R3
XX``009MOVC3``009R0,(R1),(R3)
XX``009MOVZWL``009#65535,R0
XX``009SUBL2``009R0,R1
XX``009SUBL2``009R0,R3
XX5$:
XX``009CMPL``009R6,R0
XX``009BGTR``0094$
XX``009SUBL2``009R6,R1
XX``009SUBL2``009R6,R3
XX``009MOVC3``009R6,(R1),(R3)
XX``009RET
XX
XX``009.END
X$ GOSUB UNPACK_FILE
X$ FILE_IS = "BZERO.MAR"
X$ CHECKSUM_IS = 137252688
X$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XX``009.TITLE``009BZERO``009Zero out an array of bytes
XX``009.IDENT``009/1.00/
XX
XX``009.PSECT``009$CODE,LONG,PIC,REL,SHR,EXE,RD,NOWRT
XX
XX; bzero(ptr, size)
XX
XX``009.ENTRY``009BZERO,``094M<R2,R3,R4,R5>
XX``009MOVL``0094(AP),R3
XX``009BRB``0092$
XX1$:
XX``009SUBL2``009R0,8(AP)
XX``009MOVC5``009#0,(R3),#0,R0,(R3)
XX2$:
XX``009MOVZWL``009#65535,R0
XX``009CMPL``0098(AP),R0
XX``009BGTR``0091$
XX``009MOVC5``009#0,(R3),#0,8(AP),(R3)
XX``009RET
XX
XX``009.END
X$ GOSUB UNPACK_FILE
X$ FILE_IS = "CLINK.OPT"
X$ CHECKSUM_IS = 1392527948
X$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XXsys$share:vaxcrtl.exe/share
X$ GOSUB UNPACK_FILE
X$ FILE_IS = "MAKE-GAWK.COM"
X$ CHECKSUM_IS = 1398514891
X$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XX$``009DEFINE VAXC$INCLUDE 'F$ENVIRONMENT("DEFAULT")',SYS$LIBRARY/nolog
XX$``009IF``009F$SEARCH (F$PARSE ("GCCLIB", "GCCLIB.OLB")) .NES. "" -
XX``009THEN``009GOTO LibOk
XX$``009IF``009F$SEARCH ("[]ALLOCA.MAR") .EQS. "" -
XX``009THEN``009GOTO NoWay
XX$``009MACRO``009ALLOCA.MAR
XX$``009MACRO``009BZERO.MAR
XX$``009MACRO``009BCMP.MAR
XX$``009MACRO``009BCOPY.MAR
XX$``009LIBRARY/CREATE []GCCLIB ALLOCA,BZERO,BCMP,BCOPY
XX$``009DELETE``009ALLOCA.OBJ;
XX$``009DELETE``009BZERO.OBJ;
XX$``009DELETE``009BCMP.OBJ;
XX$``009DELETE``009BCOPY.OBJ;
XX$``009GOTO LibOk
XX$ No_Way:
XX$``009TYPE SYS$INPUT
XX
XX``009I can't seem to find GCCLIB.  Please define the logical GCCLIB to point
XXto that library.  It comes from the VMS bootstrap tape.  You need it for
XXsome of the berekely-isms that gawk uses.
XX
XX$``009EXIT
XX$ LibOk:
XX$``009IF``009P1 .EQS. "LINK" -
XX``009THEN``009GOTO LinkIt
XX$``009mycc :== cc``009``009! Change to GCC for gcc.
XX$``009mycc awk1
XX$``009mycc awk2
XX$``009mycc awk3
XX$``009mycc awk_tab
XX$``009mycc debug
XX$``009mycc version
XX$``009mycc regex
XX$``009mycc obstack
XX$``009mycc vms-port
XX$ LinkIt:
XX$``009LINK/exe=gawk awk1,awk2,awk3,awk_tab,debug,regex,obstack,vms-port,-
XX``009``009gcclib/lib,[]clink/opt
XX$
X$ GOSUB UNPACK_FILE
X$ FILE_IS = "README.VMS"
X$ CHECKSUM_IS = 86785999
X$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XXThe VMS GAWK port was done by M. Warner Losh at the New Mexico
XXInstitute of Mininng and Technology.  Included here are the diff that
XXare needed to make GAWK work on VMS 4.5 using VAX-C 2.2.  If you have
XXa later version of VMS/VAX-C all should be ok, but this has not been
XXtested, so use it at your own risk.  All of the functionality of GAWK
XXappears to work, except for pipes (but including redirects).  Since
XXVMS does not support pipes very well, I wasn't sure as to how to
XXimplement this.
XX
XXI don't have any documentation on GAWK, I don't know if it is awk-like
XXor nawk-like.  If someone does come up with some documentation, I'd
XXlike a copy.
XX
XXThere are three new files plus a couple of minor changes to the
XXoriginal files.  MAKE-GAWK.COM should make gawk on your system.  It
XXuses a file called CLINK.OPT to link in the sharable version of the
XX'C' runtime library.  The final new file is VMS-PORT.C.  It contains
XXall of the functions that are needed to make this run under VMS.  Also
XXneeded, but not included in this distribution is the GCCLIB library
XXfrom the GCC compiler.  GAWK wants some of the berkeleyism that are in
XXthis library.  Specifically: bcmp, bcopy, bzero and alloca.  I have
XXincluded code for these.
XX
XXAll of the sources for this were obtained from cis.ohio-state.edu via
XXanonymous FTP.  The diffs are for "verison 1.03 (I think)".  Newer
XXversions should require little or no effort to get working.
XX
X$ GOSUB UNPACK_FILE
X$ FILE_IS = "VMS-PORT.C"
X$ CHECKSUM_IS = 739015048
X$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XX# include <stdio.h>
XX# include <ssdef.h>
XX``009
XX/*
XX *    Simulate the popen command on VMS.  For now just always fail.  Maybe
XX * someome can figure out how to do this correctly in the future....
XX */
XX
XXFILE *popen (name, mode)
XXchar *name;
XXchar *mode;
XX``123
XX``009return (FILE *) NULL;
XX``125
XX
XX/*
XX *``009Simulate the UNIX exit command.  If zero then exit SS$_NORMAL,
XX * else exit SS$_ABORT.
XX */
XX
XXvms_exit(x)
XXint x;
XX``123
XX``009if (x == 0)
XX``009``009exit (SS$_NORMAL);
XX``009exit (SS$_ABORT);
XX``125
X$ GOSUB UNPACK_FILE
X$ EXIT
$ GOSUB UNPACK_FILE
$ FILE_IS = "VMS-PORT.C"
$ CHECKSUM_IS = 739015048
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X# include <stdio.h>
X# include <ssdef.h>
X`009
X/*
X *    Simulate the popen command on VMS.  For now just always fail.  Maybe
X * someome can figure out how to do this correctly in the future....
X */
X
XFILE *popen (name, mode)
Xchar *name;
Xchar *mode;
X`123
X`009return (FILE *) NULL;
X`125
X
X/*
X *`009Simulate the UNIX exit command.  If zero then exit SS$_NORMAL,
X * else exit SS$_ABORT.
X */
X
Xvms_exit(x)
Xint x;
X`123
X`009if (x == 0)
X`009`009exit (SS$_NORMAL);
X`009exit (SS$_ABORT);
X`125
$ GOSUB UNPACK_FILE
$ EXIT
