diff options
Diffstat (limited to 'awk2.c')
| -rw-r--r-- | awk2.c | 1129 |
1 files changed, 1129 insertions, 0 deletions
@@ -0,0 +1,1129 @@ +/* + * awk2 --- gawk parse tree interpreter + * + * Copyright (C) 1986 Free Software Foundation + * Written by Paul Rubin, August 1986 + * + */ + +/* +GAWK is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY. No author or distributor accepts responsibility to anyone +for the consequences of using it or for whether it serves any +particular purpose or works at all, unless he says so in writing. +Refer to the GAWK General Public License for full details. + +Everyone is granted permission to copy, modify and redistribute GAWK, +but only under the conditions described in the GAWK General Public +License. A copy of this license is supposed to have been given to you +along with GAWK so you can know your rights and responsibilities. It +should be in a file named COPYING. Among other things, the copyright +notice and this notice must be preserved on all copies. + +In other words, go ahead and share GAWK, but don't try to stop +anyone else from sharing it farther. Help stamp out software hoarding! +*/ + +#include <setjmp.h> +#include <stdio.h> + +#ifdef SYSV +/* nasty nasty berkelixm */ +#define _setjmp setjmp +#define _longjmp longjmp +#endif + +#include "awk.h" + +NODE **get_lhs(); + +extern NODE dumb[],*OFMT_node; +/* BEGIN and END blocks need special handling, because we are handed them + * as raw Node_statement_lists, not as Node_rule_lists (jfw) + */ +extern NODE *begin_block, *end_block; +NODE *do_sprintf(); +extern struct obstack other_stack; + + +#define min(a,b) ((a) < (b) ? (a) : (b)) + +/* More of that debugging stuff */ +#ifdef FAST +#define DEBUG(X) +#else +#define DEBUG(X) print_debug X +#endif + +/* longjmp return codes, must be nonzero */ +/* Continue means either for loop/while continue, or next input record */ +#define TAG_CONTINUE 1 +/* Break means either for/while break, or stop reading input */ +#define TAG_BREAK 2 + +/* the loop_tag_valid variable allows continue/break-out-of-context + * to be caught and diagnosed (jfw) */ +#define PUSH_BINDING(stack, x) (bcopy ((char *)(x), (char *)(stack), sizeof (jmp_buf)), loop_tag_valid++) +#define RESTORE_BINDING(stack, x) (bcopy ((char *)(stack), (char *)(x), sizeof (jmp_buf)), loop_tag_valid--) + +/* for "for(iggy in foo) {" */ +struct search { + int numleft; + AHASH **arr_ptr; + AHASH *bucket; + NODE *symbol; + NODE *retval; +}; + +struct search *assoc_scan(),*assoc_next(); +/* Tree is a bunch of rules to run. + Returns zero if it hit an exit() statement */ +interpret (tree) + NODE *tree; +{ + register NODE *t; /* temporary */ + + auto jmp_buf loop_tag_stack; /* shallow binding stack for loop_tag */ + static jmp_buf loop_tag; /* always the current binding */ + static int loop_tag_valid = 0;/* nonzero when loop_tag valid (jfw) */ + + static jmp_buf rule_tag; /* tag the rule currently being run, + for NEXT and EXIT statements. It is + static because there are no nested rules */ + + register NODE **lhs; /* lhs == Left Hand Side for assigns, etc */ + register struct search *l; /* For array_for */ + + + extern struct obstack temp_strings; + extern char *ob_dummy; + NODE *do_printf(); + + /* clean up temporary strings created by evaluating expressions in + previous recursive calls */ + obstack_free (&temp_strings, ob_dummy); + + if(tree == NULL) + return 1; + switch (tree->type) { +#ifndef FAST + /* Can't run these! */ + case Node_illegal: + case Node_rule_node: + case Node_if_branches: + case Node_expression_list: + case Node_K_BEGIN: + case Node_K_END: + case Node_redirect_output: + case Node_redirect_append: + case Node_redirect_pipe: + case Node_var_array: + abort(); +#endif + + case Node_rule_list: + for (t = tree; t != NULL; t = t->rnode) { + switch (_setjmp(rule_tag)) { + case 0: /* normal non-jump */ + if (eval_condition (t->lnode->lnode)) { + DEBUG(("Found a rule",t->lnode->rnode)); + if (t->lnode->rnode == NULL) { + /* special case: pattern with no action is equivalent to + * an action of {print} (jfw) */ + NODE printnode; + printnode.type = Node_K_print; + printnode.lnode = NULL; + printnode.rnode = NULL; + hack_print_node(&printnode); + } else + (void)interpret (t->lnode->rnode); + } + break; + case TAG_CONTINUE: /* NEXT statement */ + return 1; + case TAG_BREAK: + return 0; + } + } + break; + + case Node_statement_list: + /* print_a_node(tree); */ + /* because BEGIN and END do not have Node_rule_list nature, yet can + * have exits and nexts, we special-case a setjmp of rule_tag here. + * (jfw) + */ + if (tree == begin_block || tree == end_block) { + switch (_setjmp(rule_tag)) { + case TAG_CONTINUE: /* next */ + panic("unexpected next"); + return 1; + case TAG_BREAK: return 0; + } + } + for (t = tree; t != NULL; t = t->rnode) { + DEBUG(("Statements",t->lnode)); + (void)interpret (t->lnode); + } + break; + + case Node_K_if: + DEBUG(("IF",tree->lnode)); + if (eval_condition(tree->lnode)) { + DEBUG(("True",tree->rnode->lnode)); + (void)interpret (tree->rnode->lnode); + } else { + DEBUG(("False",tree->rnode->rnode)); + (void)interpret (tree->rnode->rnode); + } + break; + + case Node_K_while: + PUSH_BINDING (loop_tag_stack, loop_tag); + + DEBUG(("WHILE",tree->lnode)); + while (eval_condition (tree->lnode)) { + switch (_setjmp (loop_tag)) { + case 0: /* normal non-jump */ + DEBUG(("DO",tree->rnode)); + (void)interpret (tree->rnode); + break; + case TAG_CONTINUE: /* continue statement */ + break; + case TAG_BREAK: /* break statement */ + RESTORE_BINDING (loop_tag_stack, loop_tag); + return 1; +#ifndef FAST + default: + abort (); /* never happens */ +#endif + } + } + RESTORE_BINDING (loop_tag_stack, loop_tag); + break; + + case Node_K_for: + PUSH_BINDING (loop_tag_stack, loop_tag); + + DEBUG(("FOR",tree->forloop->init)); + (void)interpret (tree->forloop->init); + + DEBUG(("FOR.WHILE",tree->forloop->cond)); + while (eval_condition (tree->forloop->cond)) { + switch (_setjmp (loop_tag)) { + case 0: /* normal non-jump */ + DEBUG(("FOR.DO",tree->lnode)); + (void)interpret (tree->lnode); + /* fall through */ + case TAG_CONTINUE: /* continue statement */ + DEBUG(("FOR.INCR",tree->forloop->incr)); + (void)interpret (tree->forloop->incr); + break; + case TAG_BREAK: /* break statement */ + RESTORE_BINDING (loop_tag_stack, loop_tag); + return 1; +#ifndef FAST + default: + abort (); /* never happens */ +#endif + } + } + RESTORE_BINDING (loop_tag_stack, loop_tag); + break; + + case Node_K_arrayfor: +#define hakvar forloop->init +#define arrvar forloop->incr + PUSH_BINDING(loop_tag_stack, loop_tag); + DEBUG(("AFOR.VAR",tree->hakvar)); + lhs=get_lhs(tree->hakvar); + do_deref(); + for(l=assoc_scan(tree->arrvar);l;l=assoc_next(l)) { + *lhs=dupnode(l->retval); + DEBUG(("AFOR.NEXTIS",*lhs)); + switch(_setjmp(loop_tag)) { + case 0: + DEBUG(("AFOR.DO",tree->lnode)); + (void)interpret(tree->lnode); + case TAG_CONTINUE: + break; + + case TAG_BREAK: + RESTORE_BINDING(loop_tag_stack, loop_tag); + return 1; +#ifndef FAST + default: + abort(); +#endif + } + } + RESTORE_BINDING(loop_tag_stack, loop_tag); + break; + + case Node_K_break: + DEBUG(("BREAK",NULL)); + if (loop_tag_valid == 0) /* jfw */ + panic("unexpected break or continue"); + _longjmp (loop_tag, TAG_BREAK); + break; + + case Node_K_continue: + DEBUG(("CONTINUE",NULL)); + if (loop_tag_valid == 0) /* jfw */ + panic("unexpected break or continue"); + _longjmp (loop_tag, TAG_CONTINUE); + break; + + case Node_K_print: + DEBUG(("PRINT",tree)); + (void)hack_print_node (tree); + break; + + case Node_K_printf: + DEBUG(("PRINTF",tree)); + (void)do_printf(tree); + break; + + case Node_K_next: + DEBUG(("NEXT",NULL)); + _longjmp (rule_tag, TAG_CONTINUE); + break; + + case Node_K_exit: + /* The unix awk doc says to skip the rest of the input. Does that + mean after performing all the rules on the current line? + Unix awk quits immediately, so this does too. */ + /* The UN*X exit can also take an optional arg return code. We don't */ + /* Well, we parse it, but never *DO* it */ + DEBUG(("EXIT",NULL)); + _longjmp (rule_tag, TAG_BREAK); + break; + + default: + /* Appears to be an expression statement. Throw away the value. */ + DEBUG(("E",NULL)); + (void)tree_eval (tree); + break; + } + return 1; +} + +/* evaluate a subtree, allocating strings on a temporary stack. */ +/* This used to return a whole NODE, instead of a ptr to one, but that + led to lots of obnoxious copying. I got rid of it (JF) */ +NODE * +tree_eval (tree) + NODE *tree; +{ + register NODE *r, *t1, *t2; /* return value and temporary subtrees */ + register NODE **lhs; + static AWKNUM x; /* Why are these static? */ + extern struct obstack temp_strings; + + if(tree == NULL) { + DEBUG(("NULL",NULL)); + return Nnull_string; + } + switch (tree->type) { + /* trivial data */ + case Node_string: + case Node_number: + DEBUG(("DATA",tree)); + return tree; + + /* Builtins */ + case Node_builtin: + DEBUG(("builtin",tree)); + return ((*tree->proc)(tree->subnode)); + + /* unary operations */ + + case Node_var: + case Node_subscript: + case Node_field_spec: + DEBUG(("var_type ref",tree)); + lhs=get_lhs(tree); + return *lhs; + + case Node_preincrement: + case Node_predecrement: + DEBUG(("+-X",tree)); + lhs=get_lhs(tree->subnode); + assign_number(lhs,force_number(*lhs) + (tree->type==Node_preincrement ? 1.0 : -1.0)); + return *lhs; + + case Node_postincrement: + case Node_postdecrement: + DEBUG(("X+-",tree)); + lhs=get_lhs(tree->subnode); + x = force_number(*lhs); + assign_number (lhs, x + (tree->type==Node_postincrement ? 1.0 : -1.0)); + return tmp_number(x); + + case Node_unary_minus: + DEBUG(("UMINUS",tree)); + return tmp_number(-force_number(tree_eval(tree->subnode))); + + /* assignments */ + case Node_assign: + DEBUG(("ASSIGN",tree)); + r = tree_eval (tree->rnode); + lhs=get_lhs(tree->lnode); + *lhs= dupnode(r); + do_deref(); + /* FOO we have to regenerate $0 here! */ + if(tree->lnode->type==Node_field_spec) + fix_fields(); + return r; + /* other assignment types are easier because they are numeric */ + case Node_assign_times: + r = tree_eval (tree->rnode); + lhs=get_lhs(tree->lnode); + assign_number(lhs, force_number(*lhs) * force_number(r)); + do_deref(); + return r; + + case Node_assign_quotient: + r = tree_eval (tree->rnode); + lhs=get_lhs(tree->lnode); + assign_number(lhs, force_number(*lhs) / force_number(r)); + do_deref(); + return r; + + case Node_assign_mod: + r = tree_eval (tree->rnode); + lhs=get_lhs(tree->lnode); + assign_number(lhs, (AWKNUM)(((int) force_number(*lhs)) % ((int) force_number(r)))); + do_deref(); + return r; + + case Node_assign_plus: + r = tree_eval (tree->rnode); + lhs=get_lhs(tree->lnode); + assign_number(lhs, force_number(*lhs) + force_number(r)); + do_deref(); + return r; + + case Node_assign_minus: + r = tree_eval (tree->rnode); + lhs=get_lhs(tree->lnode); + assign_number(lhs, force_number(*lhs) - force_number(r)); + do_deref(); + return r; + } + /* Note that if TREE is invalid, gAWK will probably bomb in one of these + tree_evals here. */ + /* evaluate subtrees in order to do binary operation, then keep going */ + t1 = tree_eval (tree->lnode); + t2 = tree_eval (tree->rnode); + + switch (tree->type) { + + case Node_concat: + t1=force_string(t1); + t2=force_string(t2); + + r=(NODE *)obstack_alloc(&temp_strings,sizeof(NODE)); + r->type=Node_temp_string; + r->stlen=t1->stlen+t2->stlen; + r->stref=1; + r->stptr=(char *)obstack_alloc(&temp_strings,r->stlen+1); + bcopy(t1->stptr,r->stptr,t1->stlen); + bcopy(t2->stptr,r->stptr+t1->stlen,t2->stlen); + r->stptr[r->stlen]='\0'; + return r; + + case Node_times: + return tmp_number(force_number(t1) * force_number(t2)); + + case Node_quotient: + x=force_number(t2); + if(x==(AWKNUM)0) return tmp_number((AWKNUM)0); + else return tmp_number(force_number(t1) / x); + + case Node_mod: + x=force_number(t2); + if(x==(AWKNUM)0) return tmp_number((AWKNUM)0); + return tmp_number((AWKNUM) /* uggh... */ + (((int) force_number(t1)) % ((int) x))); + + case Node_plus: + return tmp_number(force_number(t1) + force_number(t2)); + + case Node_minus: + return tmp_number(force_number(t1) - force_number(t2)); + +#ifndef FAST + default: + fprintf (stderr, "internal error: illegal numeric operation\n"); + abort (); +#endif + } + return 0; +} + +/* We can't dereference a variable until after we've given it its new value. + This variable points to the value we have to free up */ +NODE *deref; + +/* This returns a POINTER to a node pointer. + *get_lhs(ptr) is the current value of the var, or where to store the + var's new value */ + +NODE ** +get_lhs(ptr) +NODE *ptr; +{ + register NODE *subexp; + register NODE **aptr; + register int num; + extern NODE **fields_arr; + extern f_arr_siz; + NODE **assoc_lookup(); + extern char f_empty[]; /* jfw */ + +#ifndef FAST + if(ptr == NULL) + abort(); +#endif + deref = NULL; + switch(ptr->type) { + case Node_var: + deref=ptr->var_value; + return &(ptr->var_value); + + case Node_field_spec: + num=(int)force_number(tree_eval(ptr->lnode)); + if(num<0) num=0; /* JF what should I do? */ + if(num>f_arr_siz) + set_field(num,f_empty,0); /* jfw: so blank_strings can be simpler */ + deref = NULL; + return &fields_arr[num]; + + case Node_subscript: + subexp = tree_eval(ptr->rnode); + aptr=assoc_lookup(ptr->lnode,subexp); + deref= *aptr; + return aptr; + } +#ifndef FAST + abort(); + return 0; +#endif +} + +do_deref() +{ + if(deref) { + switch(deref->type) { + case Node_string: + if(deref!=Nnull_string) + FREE_ONE_REFERENCE(deref); + break; + case Node_number: + free((char *)deref); + break; +#ifndef FAST + default: + abort(); +#endif + } + deref = 0; + } +} + +/* This makes numeric operations slightly more efficient. + Just change the value of a numeric node, if possible */ +assign_number (ptr, value) +NODE **ptr; +AWKNUM value; +{ + switch ((*ptr)->type) { + case Node_string: + if(*ptr!=Nnull_string) + FREE_ONE_REFERENCE (*ptr); + case Node_temp_string: /* jfw: dont crash if we say $2 += 4 */ + *ptr=make_number(value); + return; + case Node_number: + (*ptr)->numbr = value; + deref=0; + break; +#ifndef FAST + default: + printf("assign_number nodetype %d\n", (*ptr)->type); /* jfw: add mesg. */ + abort (); +#endif + } +} + + +/* Routines to deal with fields */ +#define ORIG_F 30 + +NODE **fields_arr; +NODE *fields_nodes; +int f_arr_siz; +char f_empty [] = ""; + +init_fields() +{ + register NODE **tmp; + register NODE *xtmp; + + f_arr_siz=ORIG_F; + fields_arr=(NODE **)malloc(ORIG_F * sizeof(NODE *)); + fields_nodes=(NODE *)malloc(ORIG_F * sizeof(NODE)); + tmp= &fields_arr[f_arr_siz]; + xtmp= &fields_nodes[f_arr_siz]; + while(--tmp>= &fields_arr[0]) { + --xtmp; + *tmp=xtmp; + xtmp->type=Node_temp_string; + xtmp->stlen=0; + xtmp->stref=1; + xtmp->stptr=f_empty; + } +} + +blank_fields() +{ + register NODE **tmp; + extern char *parse_end; + + tmp= &fields_arr[f_arr_siz]; + while(--tmp>= &fields_arr[0]) { + switch(tmp[0]->type) { + case Node_number: + free((char *)*tmp); + *tmp= &fields_nodes[tmp-fields_arr]; + break; + case Node_string: + if(*tmp!=Nnull_string) + FREE_ONE_REFERENCE(*tmp); + *tmp= &fields_nodes[tmp-fields_arr]; + break; + case Node_temp_string: + break; +#ifndef FAST + default: + abort(); +#endif + } + if ((*tmp)->stptr != f_empty) { /* jfw */ + /*Then it was assigned a string with set_field */ + /*out of a private buffer to inrec, so don't free it*/ + (*tmp)->stptr = f_empty; + (*tmp)->stlen = 0; + (*tmp)->stref = 1; + } + /* *tmp=Nnull_string; */ + } + /* Free the strings */ + obstack_free(&other_stack,parse_end); +} + +/* Danger! Must only be called for fields we know have just been blanked, + or fields we know don't exist yet. */ +set_field(n,str,len) +char *str; +{ + NODE *field_string(); + + if(n>f_arr_siz) { + int t; + + fields_arr=(NODE **)realloc((char *)fields_arr,(n+1)*sizeof(NODE *)); + fields_nodes=(NODE *)realloc((char *)fields_nodes,(n+1)*sizeof(NODE)); + for(t=f_arr_siz;t<=n;t++) { + fields_arr[t]= &fields_nodes[t]; + fields_nodes[t].type=Node_temp_string; + fields_nodes[t].stlen=0; + fields_nodes[t].stref=1; + fields_nodes[t].stptr=f_empty; + } + f_arr_siz=n+1; + } + fields_nodes[n].stlen=len; + if(n==0) { + fields_nodes[n].stptr=(char*)obstack_alloc(&other_stack,len+1); + bcopy(str,fields_nodes[n].stptr,len); + fields_nodes[n].stptr[len]='\0'; + } else { + fields_nodes[n].stptr=str; + str[len]='\0'; + } +} + +#ifdef DONTDEF +/* Nodes created with this will go away when the next input line is read */ +NODE * +field_string(s,len) +char *s; +{ + register NODE *r; + + r=(NODE *)obstack_alloc(&other_stack,sizeof(NODE)); + r->type=Node_temp_string; + r->stref=1; + r->stlen=len; + r->stptr=(char*)obstack_alloc(&other_stack,len+1); + bcopy(s,r->stptr,len); + /* r->stptr=s; + r->stptr[len]='\0'; */ + + return r; +} +#endif + +/* Someone assigned a value to $(something). Fix up $0 to be right */ +fix_fields() +{ + register int tlen; + register NODE *tmp; + NODE *ofs; + char *ops; + register char *cops; + register NODE **ptr,**maxp; + extern NODE *OFS_node; + + maxp=0; + tlen=0; + ofs=force_string(*get_lhs(OFS_node)); + ptr= &fields_arr[f_arr_siz]; + while(--ptr> &fields_arr[0]) { + tmp=force_string(*ptr); + tlen+=tmp->stlen; + if(tmp->stlen && !maxp) + maxp=ptr; + } + if(!maxp) { + if (fields_arr[0] != fields_nodes) + FREE_ONE_REFERENCE(fields_arr[0]); + fields_arr[0]=Nnull_string; + return; + } + + tlen+=((maxp-fields_arr)-1)*ofs->stlen; + ops=(char *)malloc(tlen+1); + cops=ops; + for(ptr= &fields_arr[1];ptr<=maxp;ptr++) { + tmp=force_string(*ptr); + bcopy(tmp->stptr,cops,tmp->stlen); + cops+=tmp->stlen; + if(ptr!=maxp) { + bcopy(ofs->stptr,cops,ofs->stlen); + cops+=ofs->stlen; + } + } + tmp=newnode(Node_string); + tmp->stptr=ops; + tmp->stlen=tlen; + tmp->stref=1; + tmp->stptr[tlen]='\0'; + /* don't free unless it's new */ + if (fields_arr[0] != fields_nodes) + FREE_ONE_REFERENCE(fields_arr[0]); + fields_arr[0]=tmp; +} + + +/* Is TREE true or false? Returns 0==false, non-zero==true */ +int +eval_condition (tree) +NODE *tree; +{ + register int di; + register NODE *t1,*t2; + + if(tree==NULL) /* Null trees are the easiest kinds */ + return 1; + switch (tree->type) { + /* Maybe it's easy; check and see. */ + /* BEGIN and END are always false */ + case Node_K_BEGIN: + return 0; + break; + + case Node_K_END: + return 0; + break; + + case Node_and: + return eval_condition (tree->lnode) + && eval_condition (tree->rnode); + + case Node_or: + return eval_condition (tree->lnode) + || eval_condition (tree->rnode); + + case Node_not: + return !eval_condition (tree->lnode); + + /* Node_line_range is kind of like Node_match, EXCEPT: + * the lnode field (more properly, the condpair field) is a node of + * a Node_cond_pair; whether we evaluate the lnode of that node or the + * rnode depends on the triggered word. More precisely: if we are not + * yet triggered, we tree_eval the lnode; if that returns true, we set + * the triggered word. If we are triggered (not ELSE IF, note), we + * tree_eval the rnode, clear triggered if it succeeds, and perform our + * action (regardless of success or failure). We want to be able to + * begin and end on a single input record, so this isn't an ELSE IF, as + * noted above. + * This feature was implemented by John Woods, jfw@eddie.mit.edu, during + * a rainy weekend. + */ + case Node_line_range: + if (!tree->triggered) + if (!eval_condition(tree->condpair->lnode)) + return 0; + else + tree->triggered = 1; + /* Else we are triggered */ + if (eval_condition(tree->condpair->rnode)) + tree->triggered = 0; + return 1; + } + + /* Could just be J.random expression. + in which case, null and 0 are false, + anything else is true */ + + switch(tree->type) { + case Node_match: + case Node_nomatch: + case Node_equal: + case Node_notequal: + case Node_less: + case Node_greater: + case Node_leq: + case Node_geq: + break; + + default: /* This is so 'if(iggy)', etc, will work */ + /* Non-zero and non-empty are true */ + t1=tree_eval(tree); + switch(t1->type) { + case Node_number: + return t1->numbr!=0.0; + case Node_string: + case Node_temp_string: + return t1->stlen!=0; +#ifndef FAST + default: + abort(); +#endif + } + } + /* couldn't fob it off recursively, eval left subtree and + see if it's a pattern match operation */ + + t1 = tree_eval (tree->lnode); + + if (tree->type == Node_match || tree->type == Node_nomatch) { + t1=force_string(t1); + return (re_search (tree->rereg, t1->stptr, + t1->stlen, 0, t1->stlen, + NULL) == -1) + ^ (tree->type == Node_match); + } + + /* still no luck--- eval the right subtree and try binary ops */ + + t2 = tree_eval (tree->rnode); + + di=cmp_nodes(t1,t2); + + switch (tree->type) { + case Node_equal: + return di == 0; + case Node_notequal: + return di != 0; + case Node_less: + return di < 0; + case Node_greater: + return di > 0; + case Node_leq: + return di <= 0; + case Node_geq: + return di >= 0; +#ifndef FAST + default: + fprintf(stderr,"Panic: unknown conditonal\n"); + abort (); +#endif + } + return 0; +} + +/* FOO this doesn't properly compare "12.0" and 12.0 etc */ +/* or "1E1" and 10 etc */ +/* Perhaps someone should fix it. */ +/* Consider it fixed (jfw) */ + +/* strtod() would have been better, except (1) real awk is needlessly + * restrictive in what strings it will consider to be numbers, and + * (2) I couldn't find the public domain version anywhere handy. + */ +is_a_number(str) /* does the string str have pure-numeric syntax? */ +char *str; /* don't convert it, assume that atof is better */ +{ + if (*str == 0) return 1; /* null string has numeric value of0 */ + /* This is still a bug: in real awk, an explicit "" string + * is not treated as a number. Perhaps it is only variables + * that, when empty, are also 0s. This bug-lette here at + * least lets uninitialized variables to compare equal to + * zero like they should. + */ + if (*str == '-') str++; + if (*str == 0) return 0; + /* must be either . or digits (.4 is legal) */ + if (*str != '.' && !isdigit(*str)) return 0; + while (isdigit(*str)) str++; + if (*str == '.') { + str++; + while (isdigit(*str)) str++; + } + /* curiously, real awk DOESN'T consider "1E1" to be equal to 10! + * Or even equal to 1E1 for that matter! For a laugh, try: + * awk 'BEGIN {if ("1E1" == 1E1) print "eq"; else print "neq";exit}' + * Since this behavior is QUITE curious, I include the code for the + * adventurous. One might also feel like skipping leading whitespace + * (awk doesn't) and allowing a leading + (awk doesn't). +#ifdef Allow_Exponents + if (*str == 'e' || *str == 'E') { + str++; + if (*str == '+' || *str == '-') str++; + if (!isdigit(*str)) return 0; + while (isdigit(*str)) str++; + } +#endif + /* if we have digested the whole string, we are successful */ + return (*str == 0); +} + +cmp_nodes(t1,t2) +NODE *t1,*t2; +{ + register int di; + register AWKNUM d; + + + if(t1==t2) { + return 0; + } +#ifndef FAST + if(!t1 || !t2) { + abort(); + return t1 ? 1 : -1; + } + +#endif + if (t1->type == Node_number && t2->type == Node_number) { + d = t1->numbr - t2->numbr; + if (d < 0.0) + return -1; + if (d > 0.0) + return 1; + return 0; + } + t1=force_string(t1); + t2=force_string(t2); + /* "real" awk treats things as numbers if they both "look" like numbers. */ + if (*t1->stptr && *t2->stptr /* don't allow both to be empty strings(jfw)*/ + && is_a_number(t1->stptr) && is_a_number(t2->stptr)) { + double atof(); + d = atof(t1->stptr) - atof(t2->stptr); + if (d < 0.0) return -1; + if (d > 0.0) return 1; + return 0; + } + di = strncmp (t1->stptr, t2->stptr, min (t1->stlen, t2->stlen)); + if (di == 0) + di = t1->stlen - t2->stlen; + if(di>0) return 1; + if(di<0) return -1; + return 0; +} + + +#ifdef DONTDEF +int primes[] = {31,61,127,257,509,1021,2053,4099,8191,16381}; +#endif + +/* routines for associative arrays. SYMBOL is the address of the node + (or other pointer) being dereferenced. SUBS is a number or string + used as the subscript. */ + +/* #define ASSOC_HASHSIZE 1009 /* prime */ +#define ASSOC_HASHSIZE 29 +#define STIR_BITS(n) ((n) << 5 | (((n) >> 27) & 0x1f)) +#define HASHSTEP(old, c) ((old << 1) + c) +#define MAKE_POS(v) (v & ~0x80000000) /* make number positive */ + +/* static AHASH *assoc_table[ASSOC_HASHSIZE]; */ + + +/* Flush all the values in symbol[] before doing a split() */ +assoc_clear(symbol) +NODE *symbol; +{ + int i; + AHASH *bucket,*next; + + if(symbol->var_array==0) + return; + for(i=0;i<ASSOC_HASHSIZE;i++) { + for(bucket=symbol->var_array[i];bucket;bucket=next) { + next=bucket->next; + deref=bucket->name; + do_deref(); + deref=bucket->value; + do_deref(); + free((void *)bucket); + } + symbol->var_array[i]=0; + } +} + +/* Find SYMBOL[SUBS] in the assoc array. Install it with value "" if it + isn't there. */ +/* Returns a pointer ala get_lhs to where its value is stored */ +NODE ** +assoc_lookup (symbol, subs) +NODE *symbol, + *subs; +{ + int hash1 = 0, hashf(), i; + AHASH *bucket; + NODETYPE ty; + + if(subs->type==Node_number) { + hash1=(int)subs->numbr; + ty=Node_number; + } else { + ty=Node_string; + subs=force_string(subs); + for(i=0;i<subs->stlen;i++) + hash1=HASHSTEP(hash1,subs->stptr[i]); + + /* hash1 ^= (int) STIR_BITS((int)symbol); */ + } + hash1 = MAKE_POS(STIR_BITS((int)hash1)) % ASSOC_HASHSIZE; + + /* this table really should grow dynamically */ + if(symbol->var_array==0) { + symbol->var_array=(AHASH **)malloc(sizeof(AHASH *)*ASSOC_HASHSIZE); + for(i=0;i<ASSOC_HASHSIZE;i++) { + symbol->var_array[i]=0; + } + } else { + for (bucket = symbol->var_array[hash1]; bucket; bucket = bucket->next) { + if (bucket->name->type!= ty || cmp_nodes(bucket->name,subs)) + continue; + return &(bucket->value); + } + /* Didn't find it on first pass. Try again. */ + for (bucket = symbol->var_array[hash1]; bucket; bucket = bucket->next) { + if (cmp_nodes(bucket->name,subs)) + continue; + return &(bucket->value); + } + } + bucket = (AHASH *) malloc(sizeof (AHASH)); + bucket->symbol = symbol; + bucket->name = dupnode(subs); + bucket->value = Nnull_string; + bucket->next = symbol->var_array[hash1]; + symbol->var_array[hash1]=bucket; + return &(bucket->value); +} + +struct search * +assoc_scan(symbol) +NODE *symbol; +{ + struct search *lookat; + + if(!symbol->var_array) + return 0; + lookat=(struct search *)obstack_alloc(&other_stack,sizeof(struct search)); + /* lookat->symbol=symbol; */ + lookat->numleft=ASSOC_HASHSIZE; + lookat->arr_ptr=symbol->var_array; + lookat->bucket=symbol->var_array[0]; + return assoc_next(lookat); +} + +struct search * +assoc_next(lookat) +struct search *lookat; +{ + for(;lookat->numleft;lookat->numleft--) { + while(lookat->bucket!=0) { + lookat->retval=lookat->bucket->name; + lookat->bucket=lookat->bucket->next; + return lookat; + } + lookat->bucket= *++(lookat->arr_ptr); + } + return 0; +} + + +#ifdef FAST +NODE * +strforce(n) +NODE *n; +{ + extern NODE dumb[],*OFMT_node; + NODE *do_sprintf(); + + dumb[1].lnode=n; + if(OFMT_node->var_value->type!=Node_string) + panic("Insane value for OFMT detected."); + return do_sprintf(&dumb[0]); +} + +#else +AWKNUM +force_number (n) +NODE *n; +{ + double atof(); /* Forgetting this is bad */ + + if(n==NULL) + abort(); + switch (n->type) { + case Node_number: + return n->numbr; + case Node_string: + case Node_temp_string: + return atof(n->stptr); + default: + abort (); + } + return 0.0; +} + +NODE * +force_string(s) +NODE *s; +{ + if(s==NULL) + abort(); + switch(s->type) { + case Node_string: + case Node_temp_string: + return s; + case Node_number: + if((*get_lhs(OFMT_node))->type!=Node_string) + panic("Insane value for OFMT!",0); + dumb[1].lnode=s; + return do_sprintf(&dumb[0]); + default: + abort(); + } + return NULL; +} +#endif |