rsalz@uunet.uu.net (Rich Salz) (06/08/90)
Submitted-by: "Arnold D. Robbins" <arnold@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@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@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@uunet.uu.net. Use a domain-based address or give alternate paths, or you may lose out.