v22i096: GNU AWK, version 2.11, Part10/16
Rich Salz
rsalz at uunet.uu.net
Fri Jun 8 06:31:08 AEST 1990
Submitted-by: "Arnold D. Robbins" <arnold at unix.cc.emory.edu>
Posting-number: Volume 22, Issue 96
Archive-name: gawk2.11/part10
#! /bin/sh
# This is a shell archive. Remove anything before this line, then feed it
# into a shell via "sh file" or similar. To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to comp-sources-unix at uunet.uu.net if you want that tool.
# Contents: ./awk.y ./missing.d/memset.c ./missing.d/random.c
# ./pc.d/popen.h
# Wrapped by rsalz at litchi.bbn.com on Wed Jun 6 12:24:55 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
echo If this archive is complete, you will see the following message:
echo ' "shar: End of archive 10 (of 16)."'
if test -f './awk.y' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./awk.y'\"
else
echo shar: Extracting \"'./awk.y'\" \(37017 characters\)
sed "s/^X//" >'./awk.y' <<'END_OF_FILE'
X/*
X * awk.y --- yacc/bison parser
X */
X
X/*
X * Copyright (C) 1986, 1988, 1989 the Free Software Foundation, Inc.
X *
X * This file is part of GAWK, the GNU implementation of the
X * AWK Progamming Language.
X *
X * GAWK is free software; you can redistribute it and/or modify
X * it under the terms of the GNU General Public License as published by
X * the Free Software Foundation; either version 1, or (at your option)
X * any later version.
X *
X * GAWK is distributed in the hope that it will be useful,
X * but WITHOUT ANY WARRANTY; without even the implied warranty of
X * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
X * GNU General Public License for more details.
X *
X * You should have received a copy of the GNU General Public License
X * along with GAWK; see the file COPYING. If not, write to
X * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
X */
X
X%{
X#ifdef DEBUG
X#define YYDEBUG 12
X#endif
X
X#include "awk.h"
X
X/*
X * This line is necessary since the Bison parser skeleton uses bcopy.
X * Systems without memcpy should use -DMEMCPY_MISSING, per the Makefile.
X * It should not hurt anything if Yacc is being used instead of Bison.
X */
X#define bcopy(s,d,n) memcpy((d),(s),(n))
X
Xextern void msg();
Xextern struct re_pattern_buffer *mk_re_parse();
X
XNODE *node();
XNODE *lookup();
XNODE *install();
X
Xstatic NODE *snode();
Xstatic NODE *mkrangenode();
Xstatic FILE *pathopen();
Xstatic NODE *make_for_loop();
Xstatic NODE *append_right();
Xstatic void func_install();
Xstatic NODE *make_param();
Xstatic int hashf();
Xstatic void pop_params();
Xstatic void pop_var();
Xstatic int yylex ();
Xstatic void yyerror();
X
Xstatic int want_regexp; /* lexical scanning kludge */
Xstatic int want_assign; /* lexical scanning kludge */
Xstatic int can_return; /* lexical scanning kludge */
Xstatic int io_allowed = 1; /* lexical scanning kludge */
Xstatic int lineno = 1; /* for error msgs */
Xstatic char *lexptr; /* pointer to next char during parsing */
Xstatic char *lexptr_begin; /* keep track of where we were for error msgs */
Xstatic int curinfile = -1; /* index into sourcefiles[] */
Xstatic int param_counter;
X
XNODE *variables[HASHSIZE];
X
Xextern int errcount;
Xextern NODE *begin_block;
Xextern NODE *end_block;
X%}
X
X%union {
X long lval;
X AWKNUM fval;
X NODE *nodeval;
X NODETYPE nodetypeval;
X char *sval;
X NODE *(*ptrval)();
X}
X
X%type <nodeval> function_prologue function_body
X%type <nodeval> rexp exp start program rule simp_exp
X%type <nodeval> pattern
X%type <nodeval> action variable param_list
X%type <nodeval> rexpression_list opt_rexpression_list
X%type <nodeval> expression_list opt_expression_list
X%type <nodeval> statements statement if_statement opt_param_list
X%type <nodeval> opt_exp opt_variable regexp
X%type <nodeval> input_redir output_redir
X%type <nodetypeval> r_paren comma nls opt_nls print
X
X%type <sval> func_name
X%token <sval> FUNC_CALL NAME REGEXP
X%token <lval> ERROR
X%token <nodeval> NUMBER YSTRING
X%token <nodetypeval> RELOP APPEND_OP
X%token <nodetypeval> ASSIGNOP MATCHOP NEWLINE CONCAT_OP
X%token <nodetypeval> LEX_BEGIN LEX_END LEX_IF LEX_ELSE LEX_RETURN LEX_DELETE
X%token <nodetypeval> LEX_WHILE LEX_DO LEX_FOR LEX_BREAK LEX_CONTINUE
X%token <nodetypeval> LEX_PRINT LEX_PRINTF LEX_NEXT LEX_EXIT LEX_FUNCTION
X%token <nodetypeval> LEX_GETLINE
X%token <nodetypeval> LEX_IN
X%token <lval> LEX_AND LEX_OR INCREMENT DECREMENT
X%token <ptrval> LEX_BUILTIN LEX_LENGTH
X
X/* these are just yylval numbers */
X
X/* Lowest to highest */
X%right ASSIGNOP
X%right '?' ':'
X%left LEX_OR
X%left LEX_AND
X%left LEX_GETLINE
X%nonassoc LEX_IN
X%left FUNC_CALL LEX_BUILTIN LEX_LENGTH
X%nonassoc MATCHOP
X%nonassoc RELOP '<' '>' '|' APPEND_OP
X%left CONCAT_OP
X%left YSTRING NUMBER
X%left '+' '-'
X%left '*' '/' '%'
X%right '!' UNARY
X%right '^'
X%left INCREMENT DECREMENT
X%left '$'
X%left '(' ')'
X
X%%
X
Xstart
X : opt_nls program opt_nls
X { expression_value = $2; }
X ;
X
Xprogram
X : rule
X {
X if ($1 != NULL)
X $$ = $1;
X else
X $$ = NULL;
X yyerrok;
X }
X | program rule
X /* add the rule to the tail of list */
X {
X if ($2 == NULL)
X $$ = $1;
X else if ($1 == NULL)
X $$ = $2;
X else {
X if ($1->type != Node_rule_list)
X $1 = node($1, Node_rule_list,
X (NODE*)NULL);
X $$ = append_right ($1,
X node($2, Node_rule_list,(NODE *) NULL));
X }
X yyerrok;
X }
X | error { $$ = NULL; }
X | program error { $$ = NULL; }
X ;
X
Xrule
X : LEX_BEGIN { io_allowed = 0; }
X action
X {
X if (begin_block) {
X if (begin_block->type != Node_rule_list)
X begin_block = node(begin_block, Node_rule_list,
X (NODE *)NULL);
X append_right (begin_block, node(
X node((NODE *)NULL, Node_rule_node, $3),
X Node_rule_list, (NODE *)NULL) );
X } else
X begin_block = node((NODE *)NULL, Node_rule_node, $3);
X $$ = NULL;
X io_allowed = 1;
X yyerrok;
X }
X | LEX_END { io_allowed = 0; }
X action
X {
X if (end_block) {
X if (end_block->type != Node_rule_list)
X end_block = node(end_block, Node_rule_list,
X (NODE *)NULL);
X append_right (end_block, node(
X node((NODE *)NULL, Node_rule_node, $3),
X Node_rule_list, (NODE *)NULL));
X } else
X end_block = node((NODE *)NULL, Node_rule_node, $3);
X $$ = NULL;
X io_allowed = 1;
X yyerrok;
X }
X | LEX_BEGIN statement_term
X {
X msg ("error near line %d: BEGIN blocks must have an action part", lineno);
X errcount++;
X yyerrok;
X }
X | LEX_END statement_term
X {
X msg ("error near line %d: END blocks must have an action part", lineno);
X errcount++;
X yyerrok;
X }
X | pattern action
X { $$ = node ($1, Node_rule_node, $2); yyerrok; }
X | action
X { $$ = node ((NODE *)NULL, Node_rule_node, $1); yyerrok; }
X | pattern statement_term
X { if($1) $$ = node ($1, Node_rule_node, (NODE *)NULL); yyerrok; }
X | function_prologue function_body
X {
X func_install($1, $2);
X $$ = NULL;
X yyerrok;
X }
X ;
X
Xfunc_name
X : NAME
X { $$ = $1; }
X | FUNC_CALL
X { $$ = $1; }
X ;
X
Xfunction_prologue
X : LEX_FUNCTION
X {
X param_counter = 0;
X }
X func_name '(' opt_param_list r_paren opt_nls
X {
X $$ = append_right(make_param($3), $5);
X can_return = 1;
X }
X ;
X
Xfunction_body
X : l_brace statements r_brace
X {
X $$ = $2;
X can_return = 0;
X }
X ;
X
X
Xpattern
X : exp
X { $$ = $1; }
X | exp comma exp
X { $$ = mkrangenode ( node($1, Node_cond_pair, $3) ); }
X ;
X
Xregexp
X /*
X * In this rule, want_regexp tells yylex that the next thing
X * is a regexp so it should read up to the closing slash.
X */
X : '/'
X { ++want_regexp; }
X REGEXP '/'
X {
X want_regexp = 0;
X $$ = node((NODE *)NULL,Node_regex,(NODE *)mk_re_parse($3, 0));
X $$ -> re_case = 0;
X emalloc ($$ -> re_text, char *, strlen($3)+1, "regexp");
X strcpy ($$ -> re_text, $3);
X }
X ;
X
Xaction
X : l_brace r_brace opt_semi
X {
X /* empty actions are different from missing actions */
X $$ = node ((NODE *) NULL, Node_illegal, (NODE *) NULL);
X }
X | l_brace statements r_brace opt_semi
X { $$ = $2 ; }
X ;
X
Xstatements
X : statement
X { $$ = $1; }
X | statements statement
X {
X if ($1 == NULL || $1->type != Node_statement_list)
X $1 = node($1, Node_statement_list,(NODE *)NULL);
X $$ = append_right($1,
X node( $2, Node_statement_list, (NODE *)NULL));
X yyerrok;
X }
X | error
X { $$ = NULL; }
X | statements error
X { $$ = NULL; }
X ;
X
Xstatement_term
X : nls
X { $<nodetypeval>$ = Node_illegal; }
X | semi opt_nls
X { $<nodetypeval>$ = Node_illegal; }
X ;
X
X
Xstatement
X : semi opt_nls
X { $$ = NULL; }
X | l_brace r_brace
X { $$ = NULL; }
X | l_brace statements r_brace
X { $$ = $2; }
X | if_statement
X { $$ = $1; }
X | LEX_WHILE '(' exp r_paren opt_nls statement
X { $$ = node ($3, Node_K_while, $6); }
X | LEX_DO opt_nls statement LEX_WHILE '(' exp r_paren opt_nls
X { $$ = node ($6, Node_K_do, $3); }
X | LEX_FOR '(' NAME LEX_IN NAME r_paren opt_nls statement
X {
X $$ = node ($8, Node_K_arrayfor, make_for_loop(variable($3),
X (NODE *)NULL, variable($5)));
X }
X | LEX_FOR '(' opt_exp semi exp semi opt_exp r_paren opt_nls statement
X {
X $$ = node($10, Node_K_for, (NODE *)make_for_loop($3, $5, $7));
X }
X | LEX_FOR '(' opt_exp semi semi opt_exp r_paren opt_nls statement
X {
X $$ = node ($9, Node_K_for,
X (NODE *)make_for_loop($3, (NODE *)NULL, $6));
X }
X | LEX_BREAK statement_term
X /* for break, maybe we'll have to remember where to break to */
X { $$ = node ((NODE *)NULL, Node_K_break, (NODE *)NULL); }
X | LEX_CONTINUE statement_term
X /* similarly */
X { $$ = node ((NODE *)NULL, Node_K_continue, (NODE *)NULL); }
X | print '(' expression_list r_paren output_redir statement_term
X { $$ = node ($3, $1, $5); }
X | print opt_rexpression_list output_redir statement_term
X { $$ = node ($2, $1, $3); }
X | LEX_NEXT
X { if (! io_allowed) yyerror("next used in BEGIN or END action"); }
X statement_term
X { $$ = node ((NODE *)NULL, Node_K_next, (NODE *)NULL); }
X | LEX_EXIT opt_exp statement_term
X { $$ = node ($2, Node_K_exit, (NODE *)NULL); }
X | LEX_RETURN
X { if (! can_return) yyerror("return used outside function context"); }
X opt_exp statement_term
X { $$ = node ($3, Node_K_return, (NODE *)NULL); }
X | LEX_DELETE NAME '[' expression_list ']' statement_term
X { $$ = node (variable($2), Node_K_delete, $4); }
X | exp statement_term
X { $$ = $1; }
X ;
X
Xprint
X : LEX_PRINT
X { $$ = $1; }
X | LEX_PRINTF
X { $$ = $1; }
X ;
X
Xif_statement
X : LEX_IF '(' exp r_paren opt_nls statement
X {
X $$ = node($3, Node_K_if,
X node($6, Node_if_branches, (NODE *)NULL));
X }
X | LEX_IF '(' exp r_paren opt_nls statement
X LEX_ELSE opt_nls statement
X { $$ = node ($3, Node_K_if,
X node ($6, Node_if_branches, $9)); }
X ;
X
Xnls
X : NEWLINE
X { $<nodetypeval>$ = NULL; }
X | nls NEWLINE
X { $<nodetypeval>$ = NULL; }
X ;
X
Xopt_nls
X : /* empty */
X { $<nodetypeval>$ = NULL; }
X | nls
X { $<nodetypeval>$ = NULL; }
X ;
X
Xinput_redir
X : /* empty */
X { $$ = NULL; }
X | '<' simp_exp
X { $$ = node ($2, Node_redirect_input, (NODE *)NULL); }
X ;
X
Xoutput_redir
X : /* empty */
X { $$ = NULL; }
X | '>' exp
X { $$ = node ($2, Node_redirect_output, (NODE *)NULL); }
X | APPEND_OP exp
X { $$ = node ($2, Node_redirect_append, (NODE *)NULL); }
X | '|' exp
X { $$ = node ($2, Node_redirect_pipe, (NODE *)NULL); }
X ;
X
Xopt_param_list
X : /* empty */
X { $$ = NULL; }
X | param_list
X { $$ = $1; }
X ;
X
Xparam_list
X : NAME
X { $$ = make_param($1); }
X | param_list comma NAME
X { $$ = append_right($1, make_param($3)); yyerrok; }
X | error
X { $$ = NULL; }
X | param_list error
X { $$ = NULL; }
X | param_list comma error
X { $$ = NULL; }
X ;
X
X/* optional expression, as in for loop */
Xopt_exp
X : /* empty */
X { $$ = NULL; }
X | exp
X { $$ = $1; }
X ;
X
Xopt_rexpression_list
X : /* empty */
X { $$ = NULL; }
X | rexpression_list
X { $$ = $1; }
X ;
X
Xrexpression_list
X : rexp
X { $$ = node ($1, Node_expression_list, (NODE *)NULL); }
X | rexpression_list comma rexp
X {
X $$ = append_right($1,
X node( $3, Node_expression_list, (NODE *)NULL));
X yyerrok;
X }
X | error
X { $$ = NULL; }
X | rexpression_list error
X { $$ = NULL; }
X | rexpression_list error rexp
X { $$ = NULL; }
X | rexpression_list comma error
X { $$ = NULL; }
X ;
X
Xopt_expression_list
X : /* empty */
X { $$ = NULL; }
X | expression_list
X { $$ = $1; }
X ;
X
Xexpression_list
X : exp
X { $$ = node ($1, Node_expression_list, (NODE *)NULL); }
X | expression_list comma exp
X {
X $$ = append_right($1,
X node( $3, Node_expression_list, (NODE *)NULL));
X yyerrok;
X }
X | error
X { $$ = NULL; }
X | expression_list error
X { $$ = NULL; }
X | expression_list error exp
X { $$ = NULL; }
X | expression_list comma error
X { $$ = NULL; }
X ;
X
X/* Expressions, not including the comma operator. */
Xexp : variable ASSIGNOP
X { want_assign = 0; }
X exp
X { $$ = node ($1, $2, $4); }
X | '(' expression_list r_paren LEX_IN NAME
X { $$ = node (variable($5), Node_in_array, $2); }
X | exp '|' LEX_GETLINE opt_variable
X {
X $$ = node ($4, Node_K_getline,
X node ($1, Node_redirect_pipein, (NODE *)NULL));
X }
X | LEX_GETLINE opt_variable input_redir
X {
X /* "too painful to do right" */
X /*
X if (! io_allowed && $3 == NULL)
X yyerror("non-redirected getline illegal inside BEGIN or END action");
X */
X $$ = node ($2, Node_K_getline, $3);
X }
X | exp LEX_AND exp
X { $$ = node ($1, Node_and, $3); }
X | exp LEX_OR exp
X { $$ = node ($1, Node_or, $3); }
X | exp MATCHOP exp
X { $$ = node ($1, $2, $3); }
X | regexp
X { $$ = $1; }
X | '!' regexp %prec UNARY
X { $$ = node((NODE *) NULL, Node_nomatch, $2); }
X | exp LEX_IN NAME
X { $$ = node (variable($3), Node_in_array, $1); }
X | exp RELOP exp
X { $$ = node ($1, $2, $3); }
X | exp '<' exp
X { $$ = node ($1, Node_less, $3); }
X | exp '>' exp
X { $$ = node ($1, Node_greater, $3); }
X | exp '?' exp ':' exp
X { $$ = node($1, Node_cond_exp, node($3, Node_if_branches, $5));}
X | simp_exp
X { $$ = $1; }
X | exp exp %prec CONCAT_OP
X { $$ = node ($1, Node_concat, $2); }
X ;
X
Xrexp
X : variable ASSIGNOP
X { want_assign = 0; }
X rexp
X { $$ = node ($1, $2, $4); }
X | rexp LEX_AND rexp
X { $$ = node ($1, Node_and, $3); }
X | rexp LEX_OR rexp
X { $$ = node ($1, Node_or, $3); }
X | LEX_GETLINE opt_variable input_redir
X {
X /* "too painful to do right" */
X /*
X if (! io_allowed && $3 == NULL)
X yyerror("non-redirected getline illegal inside BEGIN or END action");
X */
X $$ = node ($2, Node_K_getline, $3);
X }
X | regexp
X { $$ = $1; }
X | '!' regexp %prec UNARY
X { $$ = node((NODE *) NULL, Node_nomatch, $2); }
X | rexp MATCHOP rexp
X { $$ = node ($1, $2, $3); }
X | rexp LEX_IN NAME
X { $$ = node (variable($3), Node_in_array, $1); }
X | rexp RELOP rexp
X { $$ = node ($1, $2, $3); }
X | rexp '?' rexp ':' rexp
X { $$ = node($1, Node_cond_exp, node($3, Node_if_branches, $5));}
X | simp_exp
X { $$ = $1; }
X | rexp rexp %prec CONCAT_OP
X { $$ = node ($1, Node_concat, $2); }
X ;
X
Xsimp_exp
X : '!' simp_exp %prec UNARY
X { $$ = node ($2, Node_not,(NODE *) NULL); }
X | '(' exp r_paren
X { $$ = $2; }
X | LEX_BUILTIN '(' opt_expression_list r_paren
X { $$ = snode ($3, Node_builtin, $1); }
X | LEX_LENGTH '(' opt_expression_list r_paren
X { $$ = snode ($3, Node_builtin, $1); }
X | LEX_LENGTH
X { $$ = snode ((NODE *)NULL, Node_builtin, $1); }
X | FUNC_CALL '(' opt_expression_list r_paren
X {
X $$ = node ($3, Node_func_call, make_string($1, strlen($1)));
X }
X | INCREMENT variable
X { $$ = node ($2, Node_preincrement, (NODE *)NULL); }
X | DECREMENT variable
X { $$ = node ($2, Node_predecrement, (NODE *)NULL); }
X | variable INCREMENT
X { $$ = node ($1, Node_postincrement, (NODE *)NULL); }
X | variable DECREMENT
X { $$ = node ($1, Node_postdecrement, (NODE *)NULL); }
X | variable
X { $$ = $1; }
X | NUMBER
X { $$ = $1; }
X | YSTRING
X { $$ = $1; }
X
X /* Binary operators in order of decreasing precedence. */
X | simp_exp '^' simp_exp
X { $$ = node ($1, Node_exp, $3); }
X | simp_exp '*' simp_exp
X { $$ = node ($1, Node_times, $3); }
X | simp_exp '/' simp_exp
X { $$ = node ($1, Node_quotient, $3); }
X | simp_exp '%' simp_exp
X { $$ = node ($1, Node_mod, $3); }
X | simp_exp '+' simp_exp
X { $$ = node ($1, Node_plus, $3); }
X | simp_exp '-' simp_exp
X { $$ = node ($1, Node_minus, $3); }
X | '-' simp_exp %prec UNARY
X { $$ = node ($2, Node_unary_minus, (NODE *)NULL); }
X | '+' simp_exp %prec UNARY
X { $$ = $2; }
X ;
X
Xopt_variable
X : /* empty */
X { $$ = NULL; }
X | variable
X { $$ = $1; }
X ;
X
Xvariable
X : NAME
X { want_assign = 1; $$ = variable ($1); }
X | NAME '[' expression_list ']'
X { want_assign = 1; $$ = node (variable($1), Node_subscript, $3); }
X | '$' simp_exp
X { want_assign = 1; $$ = node ($2, Node_field_spec, (NODE *)NULL); }
X ;
X
Xl_brace
X : '{' opt_nls
X ;
X
Xr_brace
X : '}' opt_nls { yyerrok; }
X ;
X
Xr_paren
X : ')' { $<nodetypeval>$ = Node_illegal; yyerrok; }
X ;
X
Xopt_semi
X : /* empty */
X | semi
X ;
X
Xsemi
X : ';' { yyerrok; }
X ;
X
Xcomma : ',' opt_nls { $<nodetypeval>$ = Node_illegal; yyerrok; }
X ;
X
X%%
X
Xstruct token {
X char *operator; /* text to match */
X NODETYPE value; /* node type */
X int class; /* lexical class */
X short nostrict; /* ignore if in strict compatibility mode */
X NODE *(*ptr) (); /* function that implements this keyword */
X};
X
Xextern NODE
X *do_exp(), *do_getline(), *do_index(), *do_length(),
X *do_sqrt(), *do_log(), *do_sprintf(), *do_substr(),
X *do_split(), *do_system(), *do_int(), *do_close(),
X *do_atan2(), *do_sin(), *do_cos(), *do_rand(),
X *do_srand(), *do_match(), *do_tolower(), *do_toupper(),
X *do_sub(), *do_gsub();
X
X/* Special functions for debugging */
X#ifdef DEBUG
XNODE *do_prvars(), *do_bp();
X#endif
X
X/* Tokentab is sorted ascii ascending order, so it can be binary searched. */
X
Xstatic struct token tokentab[] = {
X { "BEGIN", Node_illegal, LEX_BEGIN, 0, 0 },
X { "END", Node_illegal, LEX_END, 0, 0 },
X { "atan2", Node_builtin, LEX_BUILTIN, 0, do_atan2 },
X#ifdef DEBUG
X { "bp", Node_builtin, LEX_BUILTIN, 0, do_bp },
X#endif
X { "break", Node_K_break, LEX_BREAK, 0, 0 },
X { "close", Node_builtin, LEX_BUILTIN, 0, do_close },
X { "continue", Node_K_continue, LEX_CONTINUE, 0, 0 },
X { "cos", Node_builtin, LEX_BUILTIN, 0, do_cos },
X { "delete", Node_K_delete, LEX_DELETE, 0, 0 },
X { "do", Node_K_do, LEX_DO, 0, 0 },
X { "else", Node_illegal, LEX_ELSE, 0, 0 },
X { "exit", Node_K_exit, LEX_EXIT, 0, 0 },
X { "exp", Node_builtin, LEX_BUILTIN, 0, do_exp },
X { "for", Node_K_for, LEX_FOR, 0, 0 },
X { "func", Node_K_function, LEX_FUNCTION, 0, 0 },
X { "function", Node_K_function, LEX_FUNCTION, 0, 0 },
X { "getline", Node_K_getline, LEX_GETLINE, 0, 0 },
X { "gsub", Node_builtin, LEX_BUILTIN, 0, do_gsub },
X { "if", Node_K_if, LEX_IF, 0, 0 },
X { "in", Node_illegal, LEX_IN, 0, 0 },
X { "index", Node_builtin, LEX_BUILTIN, 0, do_index },
X { "int", Node_builtin, LEX_BUILTIN, 0, do_int },
X { "length", Node_builtin, LEX_LENGTH, 0, do_length },
X { "log", Node_builtin, LEX_BUILTIN, 0, do_log },
X { "match", Node_builtin, LEX_BUILTIN, 0, do_match },
X { "next", Node_K_next, LEX_NEXT, 0, 0 },
X { "print", Node_K_print, LEX_PRINT, 0, 0 },
X { "printf", Node_K_printf, LEX_PRINTF, 0, 0 },
X#ifdef DEBUG
X { "prvars", Node_builtin, LEX_BUILTIN, 0, do_prvars },
X#endif
X { "rand", Node_builtin, LEX_BUILTIN, 0, do_rand },
X { "return", Node_K_return, LEX_RETURN, 0, 0 },
X { "sin", Node_builtin, LEX_BUILTIN, 0, do_sin },
X { "split", Node_builtin, LEX_BUILTIN, 0, do_split },
X { "sprintf", Node_builtin, LEX_BUILTIN, 0, do_sprintf },
X { "sqrt", Node_builtin, LEX_BUILTIN, 0, do_sqrt },
X { "srand", Node_builtin, LEX_BUILTIN, 0, do_srand },
X { "sub", Node_builtin, LEX_BUILTIN, 0, do_sub },
X { "substr", Node_builtin, LEX_BUILTIN, 0, do_substr },
X { "system", Node_builtin, LEX_BUILTIN, 0, do_system },
X { "tolower", Node_builtin, LEX_BUILTIN, 0, do_tolower },
X { "toupper", Node_builtin, LEX_BUILTIN, 0, do_toupper },
X { "while", Node_K_while, LEX_WHILE, 0, 0 },
X};
X
Xstatic char *token_start;
X
X/* VARARGS0 */
Xstatic void
Xyyerror(va_alist)
Xva_dcl
X{
X va_list args;
X char *mesg;
X register char *ptr, *beg;
X char *scan;
X
X errcount++;
X /* Find the current line in the input file */
X if (! lexptr) {
X beg = "(END OF FILE)";
X ptr = beg + 13;
X } else {
X if (*lexptr == '\n' && lexptr != lexptr_begin)
X --lexptr;
X for (beg = lexptr; beg != lexptr_begin && *beg != '\n'; --beg)
X ;
X /* NL isn't guaranteed */
X for (ptr = lexptr; *ptr && *ptr != '\n'; ptr++)
X ;
X if (beg != lexptr_begin)
X beg++;
X }
X msg("syntax error near line %d:\n%.*s", lineno, ptr - beg, beg);
X scan = beg;
X while (scan < token_start)
X if (*scan++ == '\t')
X putc('\t', stderr);
X else
X putc(' ', stderr);
X putc('^', stderr);
X putc(' ', stderr);
X va_start(args);
X mesg = va_arg(args, char *);
X vfprintf(stderr, mesg, args);
X va_end(args);
X putc('\n', stderr);
X exit(1);
X}
X
X/*
X * Parse a C escape sequence. STRING_PTR points to a variable containing a
X * pointer to the string to parse. That pointer is updated past the
X * characters we use. The value of the escape sequence is returned.
X *
X * A negative value means the sequence \ newline was seen, which is supposed to
X * be equivalent to nothing at all.
X *
X * If \ is followed by a null character, we return a negative value and leave
X * the string pointer pointing at the null character.
X *
X * If \ is followed by 000, we return 0 and leave the string pointer after the
X * zeros. A value of 0 does not mean end of string.
X */
X
Xint
Xparse_escape(string_ptr)
Xchar **string_ptr;
X{
X register int c = *(*string_ptr)++;
X register int i;
X register int count;
X
X switch (c) {
X case 'a':
X return BELL;
X case 'b':
X return '\b';
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 -1;
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 i = c - '0';
X count = 0;
X while (++count < 3) {
X if ((c = *(*string_ptr)++) >= '0' && c <= '7') {
X i *= 8;
X i += c - '0';
X } else {
X (*string_ptr)--;
X break;
X }
X }
X return i;
X case 'x':
X i = 0;
X while (1) {
X if (isxdigit((c = *(*string_ptr)++))) {
X if (isdigit(c))
X i += c - '0';
X else if (isupper(c))
X i += c - 'A' + 10;
X else
X i += c - 'a' + 10;
X } else {
X (*string_ptr)--;
X break;
X }
X }
X return i;
X default:
X return c;
X }
X}
X
X/*
X * Read the input and turn it into tokens. Input is now read from a file
X * instead of from malloc'ed memory. The main program takes a program
X * passed as a command line argument and writes it to a temp file. Otherwise
X * the file name is made available in an external variable.
X */
X
Xstatic int
Xyylex()
X{
X register int c;
X register int namelen;
X register char *tokstart;
X char *tokkey;
X static did_newline = 0; /* the grammar insists that actions end
X * with newlines. This was easier than
X * hacking the grammar. */
X int seen_e = 0; /* These are for numbers */
X int seen_point = 0;
X int esc_seen;
X extern char **sourcefile;
X extern int tempsource, numfiles;
X static int file_opened = 0;
X static FILE *fin;
X static char cbuf[BUFSIZ];
X int low, mid, high;
X#ifdef DEBUG
X extern int debugging;
X#endif
X
X if (! file_opened) {
X file_opened = 1;
X#ifdef DEBUG
X if (debugging) {
X int i;
X
X for (i = 0; i <= numfiles; i++)
X fprintf (stderr, "sourcefile[%d] = %s\n", i,
X sourcefile[i]);
X }
X#endif
X nextfile:
X if ((fin = pathopen (sourcefile[++curinfile])) == NULL)
X fatal("cannot open `%s' for reading (%s)",
X sourcefile[curinfile],
X strerror(errno));
X *(lexptr = cbuf) = '\0';
X /*
X * immediately unlink the tempfile so that it will
X * go away cleanly if we bomb.
X */
X if (tempsource && curinfile == 0)
X (void) unlink (sourcefile[curinfile]);
X }
X
Xretry:
X if (! *lexptr)
X if (fgets (cbuf, sizeof cbuf, fin) == NULL) {
X if (fin != NULL)
X fclose (fin); /* be neat and clean */
X if (curinfile < numfiles)
X goto nextfile;
X return 0;
X } else
X lexptr = lexptr_begin = cbuf;
X
X if (want_regexp) {
X int in_brack = 0;
X
X want_regexp = 0;
X token_start = tokstart = lexptr;
X while (c = *lexptr++) {
X switch (c) {
X case '[':
X in_brack = 1;
X break;
X case ']':
X in_brack = 0;
X break;
X case '\\':
X if (*lexptr++ == '\0') {
X yyerror("unterminated regexp ends with \\");
X return ERROR;
X } else if (lexptr[-1] == '\n')
X goto retry;
X break;
X case '/': /* end of the regexp */
X if (in_brack)
X break;
X
X lexptr--;
X yylval.sval = tokstart;
X return REGEXP;
X case '\n':
X lineno++;
X case '\0':
X lexptr--; /* so error messages work */
X yyerror("unterminated regexp");
X return ERROR;
X }
X }
X }
X
X if (*lexptr == '\n') {
X lexptr++;
X lineno++;
X return NEWLINE;
X }
X
X while (*lexptr == ' ' || *lexptr == '\t')
X lexptr++;
X
X token_start = tokstart = lexptr;
X
X switch (c = *lexptr++) {
X case 0:
X return 0;
X
X case '\n':
X lineno++;
X return NEWLINE;
X
X case '#': /* it's a comment */
X while (*lexptr != '\n' && *lexptr != '\0')
X lexptr++;
X goto retry;
X
X case '\\':
X if (*lexptr == '\n') {
X lineno++;
X lexptr++;
X goto retry;
X } else
X break;
X case ')':
X case ']':
X case '(':
X case '[':
X case '$':
X case ';':
X case ':':
X case '?':
X
X /*
X * set node type to ILLEGAL because the action should set it
X * to the right thing
X */
X yylval.nodetypeval = Node_illegal;
X return c;
X
X case '{':
X case ',':
X yylval.nodetypeval = Node_illegal;
X return c;
X
X case '*':
X if (*lexptr == '=') {
X yylval.nodetypeval = Node_assign_times;
X lexptr++;
X return ASSIGNOP;
X } else if (*lexptr == '*') { /* make ** and **= aliases
X * for ^ and ^= */
X if (lexptr[1] == '=') {
X yylval.nodetypeval = Node_assign_exp;
X lexptr += 2;
X return ASSIGNOP;
X } else {
X yylval.nodetypeval = Node_illegal;
X lexptr++;
X return '^';
X }
X }
X yylval.nodetypeval = Node_illegal;
X return c;
X
X case '/':
X if (want_assign && *lexptr == '=') {
X yylval.nodetypeval = Node_assign_quotient;
X lexptr++;
X return ASSIGNOP;
X }
X yylval.nodetypeval = Node_illegal;
X return c;
X
X case '%':
X if (*lexptr == '=') {
X yylval.nodetypeval = Node_assign_mod;
X lexptr++;
X return ASSIGNOP;
X }
X yylval.nodetypeval = Node_illegal;
X return c;
X
X case '^':
X if (*lexptr == '=') {
X yylval.nodetypeval = Node_assign_exp;
X lexptr++;
X return ASSIGNOP;
X }
X yylval.nodetypeval = Node_illegal;
X return c;
X
X case '+':
X if (*lexptr == '=') {
X yylval.nodetypeval = Node_assign_plus;
X lexptr++;
X return ASSIGNOP;
X }
X if (*lexptr == '+') {
X yylval.nodetypeval = Node_illegal;
X lexptr++;
X return INCREMENT;
X }
X yylval.nodetypeval = Node_illegal;
X return c;
X
X case '!':
X if (*lexptr == '=') {
X yylval.nodetypeval = Node_notequal;
X lexptr++;
X return RELOP;
X }
X if (*lexptr == '~') {
X yylval.nodetypeval = Node_nomatch;
X lexptr++;
X return MATCHOP;
X }
X yylval.nodetypeval = Node_illegal;
X return c;
X
X case '<':
X if (*lexptr == '=') {
X yylval.nodetypeval = Node_leq;
X lexptr++;
X return RELOP;
X }
X yylval.nodetypeval = Node_less;
X return c;
X
X case '=':
X if (*lexptr == '=') {
X yylval.nodetypeval = Node_equal;
X lexptr++;
X return RELOP;
X }
X yylval.nodetypeval = Node_assign;
X return ASSIGNOP;
X
X case '>':
X if (*lexptr == '=') {
X yylval.nodetypeval = Node_geq;
X lexptr++;
X return RELOP;
X } else if (*lexptr == '>') {
X yylval.nodetypeval = Node_redirect_append;
X lexptr++;
X return APPEND_OP;
X }
X yylval.nodetypeval = Node_greater;
X return c;
X
X case '~':
X yylval.nodetypeval = Node_match;
X return MATCHOP;
X
X case '}':
X /*
X * Added did newline stuff. Easier than
X * hacking the grammar
X */
X if (did_newline) {
X did_newline = 0;
X return c;
X }
X did_newline++;
X --lexptr;
X return NEWLINE;
X
X case '"':
X esc_seen = 0;
X while (*lexptr != '\0') {
X switch (*lexptr++) {
X case '\\':
X esc_seen = 1;
X if (*lexptr == '\n')
X yyerror("newline in string");
X if (*lexptr++ != '\0')
X break;
X /* fall through */
X case '\n':
X lexptr--;
X yyerror("unterminated string");
X return ERROR;
X case '"':
X yylval.nodeval = make_str_node(tokstart + 1,
X lexptr-tokstart-2, esc_seen);
X yylval.nodeval->flags |= PERM;
X return YSTRING;
X }
X }
X return ERROR;
X
X case '-':
X if (*lexptr == '=') {
X yylval.nodetypeval = Node_assign_minus;
X lexptr++;
X return ASSIGNOP;
X }
X if (*lexptr == '-') {
X yylval.nodetypeval = Node_illegal;
X lexptr++;
X return DECREMENT;
X }
X yylval.nodetypeval = Node_illegal;
X return c;
X
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 for (namelen = 0; (c = tokstart[namelen]) != '\0'; namelen++) {
X switch (c) {
X case '.':
X if (seen_point)
X goto got_number;
X ++seen_point;
X break;
X case 'e':
X case 'E':
X if (seen_e)
X goto got_number;
X ++seen_e;
X if (tokstart[namelen + 1] == '-' ||
X tokstart[namelen + 1] == '+')
X namelen++;
X break;
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 break;
X default:
X goto got_number;
X }
X }
X
Xgot_number:
X lexptr = tokstart + namelen;
X /*
X yylval.nodeval = make_string(tokstart, namelen);
X (void) force_number(yylval.nodeval);
X */
X yylval.nodeval = make_number(atof(tokstart));
X yylval.nodeval->flags |= PERM;
X return NUMBER;
X
X case '&':
X if (*lexptr == '&') {
X yylval.nodetypeval = Node_and;
X while (c = *++lexptr) {
X if (c == '#')
X while ((c = *++lexptr) != '\n'
X && c != '\0')
X ;
X if (c == '\n')
X lineno++;
X else if (! isspace(c))
X break;
X }
X return LEX_AND;
X }
X return ERROR;
X
X case '|':
X if (*lexptr == '|') {
X yylval.nodetypeval = Node_or;
X while (c = *++lexptr) {
X if (c == '#')
X while ((c = *++lexptr) != '\n'
X && c != '\0')
X ;
X if (c == '\n')
X lineno++;
X else if (! isspace(c))
X break;
X }
X return LEX_OR;
X }
X yylval.nodetypeval = Node_illegal;
X return c;
X }
X
X if (c != '_' && ! isalpha(c)) {
X yyerror("Invalid char '%c' in expression\n", c);
X return ERROR;
X }
X
X /* it's some type of name-type-thing. Find its length */
X for (namelen = 0; is_identchar(tokstart[namelen]); namelen++)
X /* null */ ;
X emalloc(tokkey, char *, namelen+1, "yylex");
X memcpy(tokkey, tokstart, namelen);
X tokkey[namelen] = '\0';
X
X /* See if it is a special token. */
X low = 0;
X high = (sizeof (tokentab) / sizeof (tokentab[0])) - 1;
X while (low <= high) {
X int i, c;
X
X mid = (low + high) / 2;
X c = *tokstart - tokentab[mid].operator[0];
X i = c ? c : strcmp (tokkey, tokentab[mid].operator);
X
X if (i < 0) { /* token < mid */
X high = mid - 1;
X } else if (i > 0) { /* token > mid */
X low = mid + 1;
X } else {
X lexptr = tokstart + namelen;
X if (strict && tokentab[mid].nostrict)
X break;
X if (tokentab[mid].class == LEX_BUILTIN
X || tokentab[mid].class == LEX_LENGTH)
X yylval.ptrval = tokentab[mid].ptr;
X else
X yylval.nodetypeval = tokentab[mid].value;
X return tokentab[mid].class;
X }
X }
X
X /* It's a name. See how long it is. */
X yylval.sval = tokkey;
X lexptr = tokstart + namelen;
X if (*lexptr == '(')
X return FUNC_CALL;
X else
X return NAME;
X}
X
X#ifndef DEFPATH
X#ifdef MSDOS
X#define DEFPATH "."
X#define ENVSEP ';'
X#else
X#define DEFPATH ".:/usr/lib/awk:/usr/local/lib/awk"
X#define ENVSEP ':'
X#endif
X#endif
X
Xstatic FILE *
Xpathopen (file)
Xchar *file;
X{
X static char *savepath = DEFPATH;
X static int first = 1;
X char *awkpath, *cp;
X char trypath[BUFSIZ];
X FILE *fp;
X#ifdef DEBUG
X extern int debugging;
X#endif
X int fd;
X
X if (strcmp (file, "-") == 0)
X return (stdin);
X
X if (strict)
X return (fopen (file, "r"));
X
X if (first) {
X first = 0;
X if ((awkpath = getenv ("AWKPATH")) != NULL && *awkpath)
X savepath = awkpath; /* used for restarting */
X }
X awkpath = savepath;
X
X /* some kind of path name, no search */
X#ifndef MSDOS
X if (strchr (file, '/') != NULL)
X#else
X if (strchr (file, '/') != NULL || strchr (file, '\\') != NULL
X || strchr (file, ':') != NULL)
X#endif
X return ( (fd = devopen (file, "r")) >= 0 ?
X fdopen(fd, "r") :
X NULL);
X
X do {
X trypath[0] = '\0';
X /* this should take into account limits on size of trypath */
X for (cp = trypath; *awkpath && *awkpath != ENVSEP; )
X *cp++ = *awkpath++;
X
X if (cp != trypath) { /* nun-null element in path */
X *cp++ = '/';
X strcpy (cp, file);
X } else
X strcpy (trypath, file);
X#ifdef DEBUG
X if (debugging)
X fprintf(stderr, "trying: %s\n", trypath);
X#endif
X if ((fd = devopen (trypath, "r")) >= 0
X && (fp = fdopen(fd, "r")) != NULL)
X return (fp);
X
X /* no luck, keep going */
X if(*awkpath == ENVSEP && awkpath[1] != '\0')
X awkpath++; /* skip colon */
X } while (*awkpath);
X#ifdef MSDOS
X /*
X * Under DOS (and probably elsewhere) you might have one of the awk
X * paths defined, WITHOUT the current working directory in it.
X * Therefore you should try to open the file in the current directory.
X */
X return ( (fd = devopen(file, "r")) >= 0 ? fdopen(fd, "r") : NULL);
X#else
X return (NULL);
X#endif
X}
X
Xstatic NODE *
Xnode_common(op)
XNODETYPE op;
X{
X register NODE *r;
X extern int numfiles;
X extern int tempsource;
X extern char **sourcefile;
X
X r = newnode(op);
X r->source_line = lineno;
X if (numfiles > -1 && ! tempsource)
X r->source_file = sourcefile[curinfile];
X else
X r->source_file = NULL;
X return r;
X}
X
X/*
X * This allocates a node with defined lnode and rnode.
X * This should only be used by yyparse+co while reading in the program
X */
XNODE *
Xnode(left, op, right)
XNODE *left, *right;
XNODETYPE op;
X{
X register NODE *r;
X
X r = node_common(op);
X r->lnode = left;
X r->rnode = right;
X return r;
X}
X
X/*
X * This allocates a node with defined subnode and proc
X * Otherwise like node()
X */
Xstatic NODE *
Xsnode(subn, op, procp)
XNODETYPE op;
XNODE *(*procp) ();
XNODE *subn;
X{
X register NODE *r;
X
X r = node_common(op);
X r->subnode = subn;
X r->proc = procp;
X return r;
X}
X
X/*
X * This allocates a Node_line_range node with defined condpair and
X * zeroes the trigger word to avoid the temptation of assuming that calling
X * 'node( foo, Node_line_range, 0)' will properly initialize 'triggered'.
X */
X/* Otherwise like node() */
Xstatic NODE *
Xmkrangenode(cpair)
XNODE *cpair;
X{
X register NODE *r;
X
X r = newnode(Node_line_range);
X r->condpair = cpair;
X r->triggered = 0;
X return r;
X}
X
X/* Build a for loop */
Xstatic NODE *
Xmake_for_loop(init, cond, incr)
XNODE *init, *cond, *incr;
X{
X register FOR_LOOP_HEADER *r;
X NODE *n;
X
X emalloc(r, FOR_LOOP_HEADER *, sizeof(FOR_LOOP_HEADER), "make_for_loop");
X n = newnode(Node_illegal);
X r->init = init;
X r->cond = cond;
X r->incr = incr;
X n->sub.nodep.r.hd = r;
X return n;
X}
X
X/*
X * Install a name in the hash table specified, even if it is already there.
X * Name stops with first non alphanumeric. Caller must check against
X * redefinition if that is desired.
X */
XNODE *
Xinstall(table, name, value)
XNODE **table;
Xchar *name;
XNODE *value;
X{
X register NODE *hp;
X register int 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 hp = newnode(Node_hashnode);
X bucket = hashf(name, len, HASHSIZE);
X hp->hnext = table[bucket];
X table[bucket] = hp;
X hp->hlength = len;
X hp->hvalue = value;
X emalloc(hp->hname, char *, len + 1, "install");
X memcpy(hp->hname, name, len);
X hp->hname[len] = '\0';
X return hp->hvalue;
X}
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)
XNODE **table;
Xchar *name;
X{
X register char *bp;
X register NODE *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) {
X if (bucket->hlength == len && STREQN(bucket->hname, name, len))
X return bucket->hvalue;
X bucket = bucket->hnext;
X }
X return NULL;
X}
X
X#define HASHSTEP(old, c) ((old << 1) + c)
X#define MAKE_POS(v) (v & ~0x80000000) /* make number positive */
X
X/*
X * return hash function on name.
X */
Xstatic int
Xhashf(name, len, hashsize)
Xregister char *name;
Xregister int len;
Xint hashsize;
X{
X register int r = 0;
X
X while (len--)
X r = HASHSTEP(r, *name++);
X
X r = MAKE_POS(r) % hashsize;
X return r;
X}
X
X/*
X * Add new to the rightmost branch of LIST. This uses n^2 time, so we make
X * a simple attempt at optimizing it.
X */
Xstatic NODE *
Xappend_right(list, new)
XNODE *list, *new;
X
X{
X register NODE *oldlist;
X static NODE *savefront = NULL, *savetail = NULL;
X
X oldlist = list;
X if (savefront == oldlist) {
X savetail = savetail->rnode = new;
X return oldlist;
X } else
X savefront = oldlist;
X while (list->rnode != NULL)
X list = list->rnode;
X savetail = list->rnode = new;
X return oldlist;
X}
X
X/*
X * check if name is already installed; if so, it had better have Null value,
X * in which case def is added as the value. Otherwise, install name with def
X * as value.
X */
Xstatic void
Xfunc_install(params, def)
XNODE *params;
XNODE *def;
X{
X NODE *r;
X
X pop_params(params->rnode);
X pop_var(params, 0);
X r = lookup(variables, params->param);
X if (r != NULL) {
X fatal("function name `%s' previously defined", params->param);
X } else
X (void) install(variables, params->param,
X node(params, Node_func, def));
X}
X
Xstatic void
Xpop_var(np, freeit)
XNODE *np;
Xint freeit;
X{
X register char *bp;
X register NODE *bucket, **save;
X register int len;
X char *name;
X
X name = np->param;
X for (bp = name; is_identchar(*bp); bp++)
X ;
X len = bp - name;
X save = &(variables[hashf(name, len, HASHSIZE)]);
X for (bucket = *save; bucket; bucket = bucket->hnext) {
X if (len == bucket->hlength && STREQN(bucket->hname, name, len)) {
X *save = bucket->hnext;
X freenode(bucket);
X free(bucket->hname);
X if (freeit)
X free(np->param);
X return;
X }
X save = &(bucket->hnext);
X }
X}
X
Xstatic void
Xpop_params(params)
XNODE *params;
X{
X register NODE *np;
X
X for (np = params; np != NULL; np = np->rnode)
X pop_var(np, 1);
X}
X
Xstatic NODE *
Xmake_param(name)
Xchar *name;
X{
X NODE *r;
X
X r = newnode(Node_param_list);
X r->param = name;
X r->rnode = NULL;
X r->param_cnt = param_counter++;
X return (install(variables, name, r));
X}
X
X/* Name points to a variable name. Make sure its in the symbol table */
XNODE *
Xvariable(name)
Xchar *name;
X{
X register NODE *r;
X
X if ((r = lookup(variables, name)) == NULL)
X r = install(variables, name,
X node(Nnull_string, Node_var, (NODE *) NULL));
X return r;
X}
END_OF_FILE
if test 37017 -ne `wc -c <'./awk.y'`; then
echo shar: \"'./awk.y'\" unpacked with wrong size!
fi
# end of './awk.y'
fi
if test -f './missing.d/memset.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./missing.d/memset.c'\"
else
echo shar: Extracting \"'./missing.d/memset.c'\" \(261 characters\)
sed "s/^X//" >'./missing.d/memset.c' <<'END_OF_FILE'
X/*
X * memset --- initialize memory
X *
X * We supply this routine for those systems that aren't standard yet.
X */
X
Xchar *
Xmemset (dest, val, l)
Xregister char *dest, val;
Xregister int l;
X{
X register char *ret = dest;
X
X while (l--)
X *dest++ = val;
X
X return ret;
X}
END_OF_FILE
if test 261 -ne `wc -c <'./missing.d/memset.c'`; then
echo shar: \"'./missing.d/memset.c'\" unpacked with wrong size!
fi
# end of './missing.d/memset.c'
fi
if test -f './missing.d/random.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./missing.d/random.c'\"
else
echo shar: Extracting \"'./missing.d/random.c'\" \(12785 characters\)
sed "s/^X//" >'./missing.d/random.c' <<'END_OF_FILE'
X/*
X * Copyright (c) 1983 Regents of the University of California.
X * All rights reserved.
X *
X * Redistribution and use in source and binary forms are permitted
X * provided that the above copyright notice and this paragraph are
X * duplicated in all such forms and that any documentation,
X * advertising materials, and other materials related to such
X * distribution and use acknowledge that the software was developed
X * by the University of California, Berkeley. The name of the
X * University may not be used to endorse or promote products derived
X * from this software without specific prior written permission.
X * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
X * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
X * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
X */
X
X#if defined(LIBC_SCCS) && !defined(lint)
Xstatic char sccsid[] = "@(#)random.c 5.5 (Berkeley) 7/6/88";
X#endif /* LIBC_SCCS and not lint */
X
X#include <stdio.h>
X
X/*
X * random.c:
X * An improved random number generation package. In addition to the standard
X * rand()/srand() like interface, this package also has a special state info
X * interface. The initstate() routine is called with a seed, an array of
X * bytes, and a count of how many bytes are being passed in; this array is then
X * initialized to contain information for random number generation with that
X * much state information. Good sizes for the amount of state information are
X * 32, 64, 128, and 256 bytes. The state can be switched by calling the
X * setstate() routine with the same array as was initiallized with initstate().
X * By default, the package runs with 128 bytes of state information and
X * generates far better random numbers than a linear congruential generator.
X * If the amount of state information is less than 32 bytes, a simple linear
X * congruential R.N.G. is used.
X * Internally, the state information is treated as an array of longs; the
X * zeroeth element of the array is the type of R.N.G. being used (small
X * integer); the remainder of the array is the state information for the
X * R.N.G. Thus, 32 bytes of state information will give 7 longs worth of
X * state information, which will allow a degree seven polynomial. (Note: the
X * zeroeth word of state information also has some other information stored
X * in it -- see setstate() for details).
X * The random number generation technique is a linear feedback shift register
X * approach, employing trinomials (since there are fewer terms to sum up that
X * way). In this approach, the least significant bit of all the numbers in
X * the state table will act as a linear feedback shift register, and will have
X * period 2^deg - 1 (where deg is the degree of the polynomial being used,
X * assuming that the polynomial is irreducible and primitive). The higher
X * order bits will have longer periods, since their values are also influenced
X * by pseudo-random carries out of the lower bits. The total period of the
X * generator is approximately deg*(2**deg - 1); thus doubling the amount of
X * state information has a vast influence on the period of the generator.
X * Note: the deg*(2**deg - 1) is an approximation only good for large deg,
X * when the period of the shift register is the dominant factor. With deg
X * equal to seven, the period is actually much longer than the 7*(2**7 - 1)
X * predicted by this formula.
X */
X
X
X
X/*
X * For each of the currently supported random number generators, we have a
X * break value on the amount of state information (you need at least this
X * many bytes of state info to support this random number generator), a degree
X * for the polynomial (actually a trinomial) that the R.N.G. is based on, and
X * the separation between the two lower order coefficients of the trinomial.
X */
X
X#define TYPE_0 0 /* linear congruential */
X#define BREAK_0 8
X#define DEG_0 0
X#define SEP_0 0
X
X#define TYPE_1 1 /* x**7 + x**3 + 1 */
X#define BREAK_1 32
X#define DEG_1 7
X#define SEP_1 3
X
X#define TYPE_2 2 /* x**15 + x + 1 */
X#define BREAK_2 64
X#define DEG_2 15
X#define SEP_2 1
X
X#define TYPE_3 3 /* x**31 + x**3 + 1 */
X#define BREAK_3 128
X#define DEG_3 31
X#define SEP_3 3
X
X#define TYPE_4 4 /* x**63 + x + 1 */
X#define BREAK_4 256
X#define DEG_4 63
X#define SEP_4 1
X
X
X/*
X * Array versions of the above information to make code run faster -- relies
X * on fact that TYPE_i == i.
X */
X
X#define MAX_TYPES 5 /* max number of types above */
X
Xstatic int degrees[ MAX_TYPES ] = { DEG_0, DEG_1, DEG_2,
X DEG_3, DEG_4 };
X
Xstatic int seps[ MAX_TYPES ] = { SEP_0, SEP_1, SEP_2,
X SEP_3, SEP_4 };
X
X
X
X/*
X * Initially, everything is set up as if from :
X * initstate( 1, &randtbl, 128 );
X * Note that this initialization takes advantage of the fact that srandom()
X * advances the front and rear pointers 10*rand_deg times, and hence the
X * rear pointer which starts at 0 will also end up at zero; thus the zeroeth
X * element of the state information, which contains info about the current
X * position of the rear pointer is just
X * MAX_TYPES*(rptr - state) + TYPE_3 == TYPE_3.
X */
X
Xstatic long randtbl[ DEG_3 + 1 ] = { TYPE_3,
X 0x9a319039, 0x32d9c024, 0x9b663182, 0x5da1f342,
X 0xde3b81e0, 0xdf0a6fb5, 0xf103bc02, 0x48f340fb,
X 0x7449e56b, 0xbeb1dbb0, 0xab5c5918, 0x946554fd,
X 0x8c2e680f, 0xeb3d799f, 0xb11ee0b7, 0x2d436b86,
X 0xda672e2a, 0x1588ca88, 0xe369735d, 0x904f35f7,
X 0xd7158fd6, 0x6fa6f051, 0x616e6b96, 0xac94efdc,
X 0x36413f93, 0xc622c298, 0xf5a42ab8, 0x8a88d77b,
X 0xf5ad9d0e, 0x8999220b, 0x27fb47b9 };
X
X/*
X * fptr and rptr are two pointers into the state info, a front and a rear
X * pointer. These two pointers are always rand_sep places aparts, as they cycle
X * cyclically through the state information. (Yes, this does mean we could get
X * away with just one pointer, but the code for random() is more efficient this
X * way). The pointers are left positioned as they would be from the call
X * initstate( 1, randtbl, 128 )
X * (The position of the rear pointer, rptr, is really 0 (as explained above
X * in the initialization of randtbl) because the state table pointer is set
X * to point to randtbl[1] (as explained below).
X */
X
Xstatic long *fptr = &randtbl[ SEP_3 + 1 ];
Xstatic long *rptr = &randtbl[ 1 ];
X
X
X
X/*
X * The following things are the pointer to the state information table,
X * the type of the current generator, the degree of the current polynomial
X * being used, and the separation between the two pointers.
X * Note that for efficiency of random(), we remember the first location of
X * the state information, not the zeroeth. Hence it is valid to access
X * state[-1], which is used to store the type of the R.N.G.
X * Also, we remember the last location, since this is more efficient than
X * indexing every time to find the address of the last element to see if
X * the front and rear pointers have wrapped.
X */
X
Xstatic long *state = &randtbl[ 1 ];
X
Xstatic int rand_type = TYPE_3;
Xstatic int rand_deg = DEG_3;
Xstatic int rand_sep = SEP_3;
X
Xstatic long *end_ptr = &randtbl[ DEG_3 + 1 ];
X
X
X
X/*
X * srandom:
X * Initialize the random number generator based on the given seed. If the
X * type is the trivial no-state-information type, just remember the seed.
X * Otherwise, initializes state[] based on the given "seed" via a linear
X * congruential generator. Then, the pointers are set to known locations
X * that are exactly rand_sep places apart. Lastly, it cycles the state
X * information a given number of times to get rid of any initial dependencies
X * introduced by the L.C.R.N.G.
X * Note that the initialization of randtbl[] for default usage relies on
X * values produced by this routine.
X */
X
Xsrandom( x )
X
X unsigned x;
X{
X register int i, j;
X long random();
X
X if( rand_type == TYPE_0 ) {
X state[ 0 ] = x;
X }
X else {
X j = 1;
X state[ 0 ] = x;
X for( i = 1; i < rand_deg; i++ ) {
X state[i] = 1103515245*state[i - 1] + 12345;
X }
X fptr = &state[ rand_sep ];
X rptr = &state[ 0 ];
X for( i = 0; i < 10*rand_deg; i++ ) random();
X }
X}
X
X
X
X/*
X * initstate:
X * Initialize the state information in the given array of n bytes for
X * future random number generation. Based on the number of bytes we
X * are given, and the break values for the different R.N.G.'s, we choose
X * the best (largest) one we can and set things up for it. srandom() is
X * then called to initialize the state information.
X * Note that on return from srandom(), we set state[-1] to be the type
X * multiplexed with the current value of the rear pointer; this is so
X * successive calls to initstate() won't lose this information and will
X * be able to restart with setstate().
X * Note: the first thing we do is save the current state, if any, just like
X * setstate() so that it doesn't matter when initstate is called.
X * Returns a pointer to the old state.
X */
X
Xchar *
Xinitstate( seed, arg_state, n )
X
X unsigned seed; /* seed for R. N. G. */
X char *arg_state; /* pointer to state array */
X int n; /* # bytes of state info */
X{
X register char *ostate = (char *)( &state[ -1 ] );
X
X if( rand_type == TYPE_0 ) state[ -1 ] = rand_type;
X else state[ -1 ] = MAX_TYPES*(rptr - state) + rand_type;
X if( n < BREAK_1 ) {
X if( n < BREAK_0 ) {
X fprintf( stderr, "initstate: not enough state (%d bytes) with which to do jack; ignored.\n", n );
X return 0;
X }
X rand_type = TYPE_0;
X rand_deg = DEG_0;
X rand_sep = SEP_0;
X }
X else {
X if( n < BREAK_2 ) {
X rand_type = TYPE_1;
X rand_deg = DEG_1;
X rand_sep = SEP_1;
X }
X else {
X if( n < BREAK_3 ) {
X rand_type = TYPE_2;
X rand_deg = DEG_2;
X rand_sep = SEP_2;
X }
X else {
X if( n < BREAK_4 ) {
X rand_type = TYPE_3;
X rand_deg = DEG_3;
X rand_sep = SEP_3;
X }
X else {
X rand_type = TYPE_4;
X rand_deg = DEG_4;
X rand_sep = SEP_4;
X }
X }
X }
X }
X state = &( ( (long *)arg_state )[1] ); /* first location */
X end_ptr = &state[ rand_deg ]; /* must set end_ptr before srandom */
X srandom( seed );
X if( rand_type == TYPE_0 ) state[ -1 ] = rand_type;
X else state[ -1 ] = MAX_TYPES*(rptr - state) + rand_type;
X return( ostate );
X}
X
X
X
X/*
X * setstate:
X * Restore the state from the given state array.
X * Note: it is important that we also remember the locations of the pointers
X * in the current state information, and restore the locations of the pointers
X * from the old state information. This is done by multiplexing the pointer
X * location into the zeroeth word of the state information.
X * Note that due to the order in which things are done, it is OK to call
X * setstate() with the same state as the current state.
X * Returns a pointer to the old state information.
X */
X
Xchar *
Xsetstate( arg_state )
X
X char *arg_state;
X{
X register long *new_state = (long *)arg_state;
X register int type = new_state[0]%MAX_TYPES;
X register int rear = new_state[0]/MAX_TYPES;
X char *ostate = (char *)( &state[ -1 ] );
X
X if( rand_type == TYPE_0 ) state[ -1 ] = rand_type;
X else state[ -1 ] = MAX_TYPES*(rptr - state) + rand_type;
X switch( type ) {
X case TYPE_0:
X case TYPE_1:
X case TYPE_2:
X case TYPE_3:
X case TYPE_4:
X rand_type = type;
X rand_deg = degrees[ type ];
X rand_sep = seps[ type ];
X break;
X
X default:
X fprintf( stderr, "setstate: state info has been munged; not changed.\n" );
X }
X state = &new_state[ 1 ];
X if( rand_type != TYPE_0 ) {
X rptr = &state[ rear ];
X fptr = &state[ (rear + rand_sep)%rand_deg ];
X }
X end_ptr = &state[ rand_deg ]; /* set end_ptr too */
X return( ostate );
X}
X
X
X
X/*
X * random:
X * If we are using the trivial TYPE_0 R.N.G., just do the old linear
X * congruential bit. Otherwise, we do our fancy trinomial stuff, which is the
X * same in all ther other cases due to all the global variables that have been
X * set up. The basic operation is to add the number at the rear pointer into
X * the one at the front pointer. Then both pointers are advanced to the next
X * location cyclically in the table. The value returned is the sum generated,
X * reduced to 31 bits by throwing away the "least random" low bit.
X * Note: the code takes advantage of the fact that both the front and
X * rear pointers can't wrap on the same call by not testing the rear
X * pointer if the front one has wrapped.
X * Returns a 31-bit random number.
X */
X
Xlong
Xrandom()
X{
X long i;
X
X if( rand_type == TYPE_0 ) {
X i = state[0] = ( state[0]*1103515245 + 12345 )&0x7fffffff;
X }
X else {
X *fptr += *rptr;
X i = (*fptr >> 1)&0x7fffffff; /* chucking least random bit */
X if( ++fptr >= end_ptr ) {
X fptr = state;
X ++rptr;
X }
X else {
X if( ++rptr >= end_ptr ) rptr = state;
X }
X }
X return( i );
X}
END_OF_FILE
if test 12785 -ne `wc -c <'./missing.d/random.c'`; then
echo shar: \"'./missing.d/random.c'\" unpacked with wrong size!
fi
# end of './missing.d/random.c'
fi
if test -f './pc.d/popen.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./pc.d/popen.h'\"
else
echo shar: Extracting \"'./pc.d/popen.h'\" \(134 characters\)
sed "s/^X//" >'./pc.d/popen.h' <<'END_OF_FILE'
X/*
X** popen.h -- prototypes for pipe functions
X*/
X#if !defined(FILE)
X#include <stdio.h>
X#endif
Xextern FILE *popen( char *, char * );
X
END_OF_FILE
if test 134 -ne `wc -c <'./pc.d/popen.h'`; then
echo shar: \"'./pc.d/popen.h'\" unpacked with wrong size!
fi
# end of './pc.d/popen.h'
fi
echo shar: End of archive 10 \(of 16\).
cp /dev/null ark10isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 16 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still must unpack the following archives:
echo " " ${MISSING}
fi
exit 0
exit 0 # Just in case...
--
Please send comp.sources.unix-related mail to rsalz at uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.
More information about the Comp.sources.unix
mailing list