Subject: v22i098: GNU AWK, version 2.11, Part12/16 Newsgroups: comp.sources.unix Approved: rsalz@uunet.UU.NET X-Checksum-Snefru: 1c391d97 561291f7 b72d5e58 3217729b Submitted-by: "Arnold D. Robbins" Posting-number: Volume 22, Issue 98 Archive-name: gawk2.11/part12 #! /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: ./builtin.c ./eval.c ./missing.d/gcvt.c # Wrapped by rsalz@litchi.bbn.com on Wed Jun 6 12:24:57 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 12 (of 16)."' if test -f './builtin.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'./builtin.c'\" else echo shar: Extracting \"'./builtin.c'\" \(20659 characters\) sed "s/^X//" >'./builtin.c' <<'END_OF_FILE' X/* X * builtin.c - Builtin functions and various utility procedures 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#include "awk.h" X Xextern void srandom(); Xextern char *initstate(); Xextern char *setstate(); Xextern long random(); X Xextern NODE **fields_arr; X Xstatic void get_one(); Xstatic void get_two(); Xstatic int get_three(); X X/* Builtin functions */ XNODE * Xdo_exp(tree) XNODE *tree; X{ X NODE *tmp; X double d, res; X double exp(); X X get_one(tree, &tmp); X d = force_number(tmp); X free_temp(tmp); X errno = 0; X res = exp(d); X if (errno == ERANGE) X warning("exp argument %g is out of range", d); X return tmp_number((AWKNUM) res); X} X XNODE * Xdo_index(tree) XNODE *tree; X{ X NODE *s1, *s2; X register char *p1, *p2; X register int l1, l2; X long ret; X X X get_two(tree, &s1, &s2); X force_string(s1); X force_string(s2); X p1 = s1->stptr; X p2 = s2->stptr; X l1 = s1->stlen; X l2 = s2->stlen; X ret = 0; X if (! strict && IGNORECASE_node->var_value->numbr != 0.0) { X while (l1) { X if (casetable[*p1] == casetable[*p2] X && strncasecmp(p1, p2, l2) == 0) { X ret = 1 + s1->stlen - l1; X break; X } X l1--; X p1++; X } X } else { X while (l1) { X if (STREQN(p1, p2, l2)) { X ret = 1 + s1->stlen - l1; X break; X } X l1--; X p1++; X } X } X free_temp(s1); X free_temp(s2); X return tmp_number((AWKNUM) ret); X} X XNODE * Xdo_int(tree) XNODE *tree; X{ X NODE *tmp; X double floor(); X double d; X X get_one(tree, &tmp); X d = floor((double)force_number(tmp)); X free_temp(tmp); X return tmp_number((AWKNUM) d); X} X XNODE * Xdo_length(tree) XNODE *tree; X{ X NODE *tmp; X int len; X X get_one(tree, &tmp); X len = force_string(tmp)->stlen; X free_temp(tmp); X return tmp_number((AWKNUM) len); X} X XNODE * Xdo_log(tree) XNODE *tree; X{ X NODE *tmp; X double log(); X double d, arg; X X get_one(tree, &tmp); X arg = (double) force_number(tmp); X if (arg < 0.0) X warning("log called with negative argument %g", arg); X d = log(arg); X free_temp(tmp); X return tmp_number((AWKNUM) d); X} X X/* X * Note that the output buffer cannot be static because sprintf may get X * called recursively by force_string. Hence the wasteful alloca calls X */ X X/* %e and %f formats are not properly implemented. Someone should fix them */ XNODE * Xdo_sprintf(tree) XNODE *tree; X{ X#define bchunk(s,l) if(l) {\ X while((l)>ofre) {\ X char *tmp;\ X tmp=(char *)alloca(osiz*2);\ X memcpy(tmp,obuf,olen);\ X obuf=tmp;\ X ofre+=osiz;\ X osiz*=2;\ X }\ X memcpy(obuf+olen,s,(l));\ X olen+=(l);\ X ofre-=(l);\ X } X X /* Is there space for something L big in the buffer? */ X#define chksize(l) if((l)>ofre) {\ X char *tmp;\ X tmp=(char *)alloca(osiz*2);\ X memcpy(tmp,obuf,olen);\ X obuf=tmp;\ X ofre+=osiz;\ X osiz*=2;\ X } X X /* X * Get the next arg to be formatted. If we've run out of args, X * return "" (Null string) X */ X#define parse_next_arg() {\ X if(!carg) arg= Nnull_string;\ X else {\ X get_one(carg,&arg);\ X carg=carg->rnode;\ X }\ X } X X char *obuf; X int osiz, ofre, olen; X static char chbuf[] = "0123456789abcdef"; X static char sp[] = " "; X char *s0, *s1; X int n0; X NODE *sfmt, *arg; X register NODE *carg; X long fw, prec, lj, alt, big; X long *cur; X long val; X#ifdef sun386 /* Can't cast unsigned (int/long) from ptr->value */ X long tmp_uval; /* on 386i 4.0.1 C compiler -- it just hangs */ X#endif X unsigned long uval; X int sgn; X int base; X char cpbuf[30]; /* if we have numbers bigger than 30 */ X char *cend = &cpbuf[30];/* chars, we lose, but seems unlikely */ X char *cp; X char *fill; X double tmpval; X char *pr_str; X int ucasehex = 0; X extern char *gcvt(); X X X obuf = (char *) alloca(120); X osiz = 120; X ofre = osiz; X olen = 0; X get_one(tree, &sfmt); X sfmt = force_string(sfmt); X carg = tree->rnode; X for (s0 = s1 = sfmt->stptr, n0 = sfmt->stlen; n0-- > 0;) { X if (*s1 != '%') { X s1++; X continue; X } X bchunk(s0, s1 - s0); X s0 = s1; X cur = &fw; X fw = 0; X prec = 0; X lj = alt = big = 0; X fill = sp; X cp = cend; X s1++; X Xretry: X --n0; X switch (*s1++) { X case '%': X bchunk("%", 1); X s0 = s1; X break; X X case '0': X if (fill != sp || lj) X goto lose; X if (cur == &fw) X fill = "0"; /* FALL through */ 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 if (cur == 0) X goto lose; X *cur = s1[-1] - '0'; X while (n0 > 0 && *s1 >= '0' && *s1 <= '9') { X --n0; X *cur = *cur * 10 + *s1++ - '0'; X } X goto retry; X#ifdef not_yet X case ' ': /* print ' ' or '-' */ X case '+': /* print '+' or '-' */ X#endif X case '-': X if (lj || fill != sp) X goto lose; X lj++; X goto retry; X case '.': X if (cur != &fw) X goto lose; X cur = ≺ X goto retry; X case '#': X if (alt) X goto lose; X alt++; X goto retry; X case 'l': X if (big) X goto lose; X big++; X goto retry; X case 'c': X parse_next_arg(); X if (arg->flags & NUMERIC) { X#ifdef sun386 X tmp_uval = arg->numbr; X uval= (unsigned long) tmp_uval; X#else X uval = (unsigned long) arg->numbr; X#endif X cpbuf[0] = uval; X prec = 1; X pr_str = cpbuf; X goto dopr_string; X } X if (! prec) X prec = 1; X else if (prec > arg->stlen) X prec = arg->stlen; X pr_str = arg->stptr; X goto dopr_string; X case 's': X parse_next_arg(); X arg = force_string(arg); X if (!prec || prec > arg->stlen) X prec = arg->stlen; X pr_str = arg->stptr; X X dopr_string: X if (fw > prec && !lj) { X while (fw > prec) { X bchunk(sp, 1); X fw--; X } X } X bchunk(pr_str, (int) prec); X if (fw > prec) { X while (fw > prec) { X bchunk(sp, 1); X fw--; X } X } X s0 = s1; X free_temp(arg); X break; X case 'd': X case 'i': X parse_next_arg(); X val = (long) force_number(arg); X free_temp(arg); X if (val < 0) { X sgn = 1; X val = -val; X } else X sgn = 0; X do { X *--cp = '0' + val % 10; X val /= 10; X } while (val); X if (sgn) X *--cp = '-'; X if (prec > fw) X fw = prec; X prec = cend - cp; X if (fw > prec && !lj) { X if (fill != sp && *cp == '-') { X bchunk(cp, 1); X cp++; X prec--; X fw--; X } X while (fw > prec) { X bchunk(fill, 1); X fw--; X } X } X bchunk(cp, (int) prec); X if (fw > prec) { X while (fw > prec) { X bchunk(fill, 1); X fw--; X } X } X s0 = s1; X break; X case 'u': X base = 10; X goto pr_unsigned; X case 'o': X base = 8; X goto pr_unsigned; X case 'X': X ucasehex = 1; X case 'x': X base = 16; X goto pr_unsigned; X pr_unsigned: X parse_next_arg(); X uval = (unsigned long) force_number(arg); X free_temp(arg); X do { X *--cp = chbuf[uval % base]; X if (ucasehex && isalpha(*cp)) X *cp = toupper(*cp); X uval /= base; X } while (uval); X if (alt && (base == 8 || base == 16)) { X if (base == 16) { X if (ucasehex) X *--cp = 'X'; X else X *--cp = 'x'; X } X *--cp = '0'; X } X prec = cend - cp; X if (fw > prec && !lj) { X while (fw > prec) { X bchunk(fill, 1); X fw--; X } X } X bchunk(cp, (int) prec); X if (fw > prec) { X while (fw > prec) { X bchunk(fill, 1); X fw--; X } X } X s0 = s1; X break; X case 'g': X parse_next_arg(); X tmpval = force_number(arg); X free_temp(arg); X if (prec == 0) X prec = 13; X (void) gcvt(tmpval, (int) prec, cpbuf); X prec = strlen(cpbuf); X cp = cpbuf; X if (fw > prec && !lj) { X if (fill != sp && *cp == '-') { X bchunk(cp, 1); X cp++; X prec--; X } /* Deal with .5 as 0.5 */ X if (fill == sp && *cp == '.') { X --fw; X while (--fw >= prec) { X bchunk(fill, 1); X } X bchunk("0", 1); X } else X while (fw-- > prec) X bchunk(fill, 1); X } else {/* Turn .5 into 0.5 */ X /* FOO */ X if (*cp == '.' && fill == sp) { X bchunk("0", 1); X --fw; X } X } X bchunk(cp, (int) prec); X if (fw > prec) X while (fw-- > prec) X bchunk(fill, 1); X s0 = s1; X break; X case 'f': X parse_next_arg(); X tmpval = force_number(arg); X free_temp(arg); X chksize(fw + prec + 5); /* 5==slop */ X X cp = cpbuf; X *cp++ = '%'; X if (lj) X *cp++ = '-'; X if (fill != sp) X *cp++ = '0'; X if (cur != &fw) { X (void) strcpy(cp, "*.*f"); X (void) sprintf(obuf + olen, cpbuf, (int) fw, (int) prec, (double) tmpval); X } else { X (void) strcpy(cp, "*f"); X (void) sprintf(obuf + olen, cpbuf, (int) fw, (double) tmpval); X } X ofre -= strlen(obuf + olen); X olen += strlen(obuf + olen); /* There may be nulls */ X s0 = s1; X break; X case 'e': X parse_next_arg(); X tmpval = force_number(arg); X free_temp(arg); X chksize(fw + prec + 5); /* 5==slop */ X cp = cpbuf; X *cp++ = '%'; X if (lj) X *cp++ = '-'; X if (fill != sp) X *cp++ = '0'; X if (cur != &fw) { X (void) strcpy(cp, "*.*e"); X (void) sprintf(obuf + olen, cpbuf, (int) fw, (int) prec, (double) tmpval); X } else { X (void) strcpy(cp, "*e"); X (void) sprintf(obuf + olen, cpbuf, (int) fw, (double) tmpval); X } X ofre -= strlen(obuf + olen); X olen += strlen(obuf + olen); /* There may be nulls */ X s0 = s1; X break; X X default: X lose: X break; X } X } X bchunk(s0, s1 - s0); X free_temp(sfmt); X return tmp_string(obuf, olen); X} X Xvoid Xdo_printf(tree) XNODE *tree; X{ X struct redirect *rp = NULL; X register FILE *fp = stdout; X int errflg = 0; /* not used, sigh */ X X if (tree->rnode) { X rp = redirect(tree->rnode, &errflg); X if (rp) X fp = rp->fp; X } X if (fp) X print_simple(do_sprintf(tree->lnode), fp); X if (rp && (rp->flag & RED_NOBUF)) X fflush(fp); X} X XNODE * Xdo_sqrt(tree) XNODE *tree; X{ X NODE *tmp; X double sqrt(); X double d, arg; X X get_one(tree, &tmp); X arg = (double) force_number(tmp); X if (arg < 0.0) X warning("sqrt called with negative argument %g", arg); X d = sqrt(arg); X free_temp(tmp); X return tmp_number((AWKNUM) d); X} X XNODE * Xdo_substr(tree) XNODE *tree; X{ X NODE *t1, *t2, *t3; X NODE *r; X register int indx, length; X X t1 = t2 = t3 = NULL; X length = -1; X if (get_three(tree, &t1, &t2, &t3) == 3) X length = (int) force_number(t3); X indx = (int) force_number(t2) - 1; X t1 = force_string(t1); X if (length == -1) X length = t1->stlen; X if (indx < 0) X indx = 0; X if (indx >= t1->stlen || length <= 0) { X if (t3) X free_temp(t3); X free_temp(t2); X free_temp(t1); X return Nnull_string; X } X if (indx + length > t1->stlen) X length = t1->stlen - indx; X if (t3) X free_temp(t3); X free_temp(t2); X r = tmp_string(t1->stptr + indx, length); X free_temp(t1); X return r; X} X XNODE * Xdo_system(tree) XNODE *tree; X{ X#if defined(unix) || defined(MSDOS) /* || defined(gnu) */ X NODE *tmp; X int ret; X X (void) flush_io (); /* so output is synchronous with gawk's */ X get_one(tree, &tmp); X ret = system(force_string(tmp)->stptr); X ret = (ret >> 8) & 0xff; X free_temp(tmp); X return tmp_number((AWKNUM) ret); X#else X fatal("the \"system\" function is not supported."); X /* NOTREACHED */ X#endif X} X Xvoid Xdo_print(tree) Xregister NODE *tree; X{ X struct redirect *rp = NULL; X register FILE *fp = stdout; X int errflg = 0; /* not used, sigh */ X X if (tree->rnode) { X rp = redirect(tree->rnode, &errflg); X if (rp) X fp = rp->fp; X } X if (!fp) X return; X tree = tree->lnode; X if (!tree) X tree = WHOLELINE; X if (tree->type != Node_expression_list) { X if (!(tree->flags & STR)) X cant_happen(); X print_simple(tree, fp); X } else { X while (tree) { X print_simple(force_string(tree_eval(tree->lnode)), fp); X tree = tree->rnode; X if (tree) X print_simple(OFS_node->var_value, fp); X } X } X print_simple(ORS_node->var_value, fp); X if (rp && (rp->flag & RED_NOBUF)) X fflush(fp); X} X XNODE * Xdo_tolower(tree) XNODE *tree; X{ X NODE *t1, *t2; X register char *cp, *cp2; X X get_one(tree, &t1); X t1 = force_string(t1); X t2 = tmp_string(t1->stptr, t1->stlen); X for (cp = t2->stptr, cp2 = t2->stptr + t2->stlen; cp < cp2; cp++) X if (isupper(*cp)) X *cp = tolower(*cp); X free_temp(t1); X return t2; X} X XNODE * Xdo_toupper(tree) XNODE *tree; X{ X NODE *t1, *t2; X register char *cp; X X get_one(tree, &t1); X t1 = force_string(t1); X t2 = tmp_string(t1->stptr, t1->stlen); X for (cp = t2->stptr; cp < t2->stptr + t2->stlen; cp++) X if (islower(*cp)) X *cp = toupper(*cp); X free_temp(t1); X return t2; X} X X/* X * Get the arguments to functions. No function cares if you give it too many X * args (they're ignored). Only a few fuctions complain about being given X * too few args. The rest have defaults. X */ X Xstatic void Xget_one(tree, res) XNODE *tree, **res; X{ X if (!tree) { X *res = WHOLELINE; X return; X } X *res = tree_eval(tree->lnode); X} X Xstatic void Xget_two(tree, res1, res2) XNODE *tree, **res1, **res2; X{ X if (!tree) { X *res1 = WHOLELINE; X return; X } X *res1 = tree_eval(tree->lnode); X if (!tree->rnode) X return; X tree = tree->rnode; X *res2 = tree_eval(tree->lnode); X} X Xstatic int Xget_three(tree, res1, res2, res3) XNODE *tree, **res1, **res2, **res3; X{ X if (!tree) { X *res1 = WHOLELINE; X return 0; X } X *res1 = tree_eval(tree->lnode); X if (!tree->rnode) X return 1; X tree = tree->rnode; X *res2 = tree_eval(tree->lnode); X if (!tree->rnode) X return 2; X tree = tree->rnode; X *res3 = tree_eval(tree->lnode); X return 3; X} X Xint Xa_get_three(tree, res1, res2, res3) XNODE *tree, **res1, **res2, **res3; X{ X if (!tree) { X *res1 = WHOLELINE; X return 0; X } X *res1 = tree_eval(tree->lnode); X if (!tree->rnode) X return 1; X tree = tree->rnode; X *res2 = tree->lnode; X if (!tree->rnode) X return 2; X tree = tree->rnode; X *res3 = tree_eval(tree->lnode); X return 3; X} X Xvoid Xprint_simple(tree, fp) XNODE *tree; XFILE *fp; X{ X if (fwrite(tree->stptr, sizeof(char), tree->stlen, fp) != tree->stlen) X warning("fwrite: %s", strerror(errno)); X free_temp(tree); X} X XNODE * Xdo_atan2(tree) XNODE *tree; X{ X NODE *t1, *t2; X extern double atan2(); X double d1, d2; X X get_two(tree, &t1, &t2); X d1 = force_number(t1); X d2 = force_number(t2); X free_temp(t1); X free_temp(t2); X return tmp_number((AWKNUM) atan2(d1, d2)); X} X XNODE * Xdo_sin(tree) XNODE *tree; X{ X NODE *tmp; X extern double sin(); X double d; X X get_one(tree, &tmp); X d = sin((double)force_number(tmp)); X free_temp(tmp); X return tmp_number((AWKNUM) d); X} X XNODE * Xdo_cos(tree) XNODE *tree; X{ X NODE *tmp; X extern double cos(); X double d; X X get_one(tree, &tmp); X d = cos((double)force_number(tmp)); X free_temp(tmp); X return tmp_number((AWKNUM) d); X} X Xstatic int firstrand = 1; Xstatic char state[256]; X X#define MAXLONG 2147483647 /* maximum value for long int */ X X/* ARGSUSED */ XNODE * Xdo_rand(tree) XNODE *tree; X{ X if (firstrand) { X (void) initstate((unsigned) 1, state, sizeof state); X srandom(1); X firstrand = 0; X } X return tmp_number((AWKNUM) random() / MAXLONG); X} X XNODE * Xdo_srand(tree) XNODE *tree; X{ X NODE *tmp; X static long save_seed = 1; X long ret = save_seed; /* SVR4 awk srand returns previous seed */ X extern long time(); X X if (firstrand) X (void) initstate((unsigned) 1, state, sizeof state); X else X (void) setstate(state); X X if (!tree) X srandom((int) (save_seed = time((long *) 0))); X else { X get_one(tree, &tmp); X srandom((int) (save_seed = (long) force_number(tmp))); X free_temp(tmp); X } X firstrand = 0; X return tmp_number((AWKNUM) ret); X} X XNODE * Xdo_match(tree) XNODE *tree; X{ X NODE *t1; X int rstart; X struct re_registers reregs; X struct re_pattern_buffer *rp; X int need_to_free = 0; X X t1 = force_string(tree_eval(tree->lnode)); X tree = tree->rnode; X if (tree == NULL || tree->lnode == NULL) X fatal("match called with only one argument"); X tree = tree->lnode; X if (tree->type == Node_regex) { X rp = tree->rereg; X if (!strict && ((IGNORECASE_node->var_value->numbr != 0) X ^ (tree->re_case != 0))) { X /* recompile since case sensitivity differs */ X rp = tree->rereg = X mk_re_parse(tree->re_text, X (IGNORECASE_node->var_value->numbr != 0)); X tree->re_case = X (IGNORECASE_node->var_value->numbr != 0); X } X } else { X need_to_free = 1; X rp = make_regexp(force_string(tree_eval(tree)), X (IGNORECASE_node->var_value->numbr != 0)); X if (rp == NULL) X cant_happen(); X } X rstart = re_search(rp, t1->stptr, t1->stlen, 0, t1->stlen, &reregs); X free_temp(t1); X if (rstart >= 0) { X rstart++; /* 1-based indexing */ X /* RSTART set to rstart below */ X RLENGTH_node->var_value->numbr = X (AWKNUM) (reregs.end[0] - reregs.start[0]); X } else { X /* X * Match failed. Set RSTART to 0, RLENGTH to -1. X * Return the value of RSTART. X */ X rstart = 0; /* used as return value */ X RLENGTH_node->var_value->numbr = -1.0; X } X RSTART_node->var_value->numbr = (AWKNUM) rstart; X if (need_to_free) { X free(rp->buffer); X free(rp->fastmap); X free((char *) rp); X } X return tmp_number((AWKNUM) rstart); X} X Xstatic NODE * Xsub_common(tree, global) XNODE *tree; Xint global; X{ X register int len; X register char *scan; X register char *bp, *cp; X int search_start = 0; X int match_length; X int matches = 0; X char *buf; X struct re_pattern_buffer *rp; X NODE *s; /* subst. pattern */ X NODE *t; /* string to make sub. in; $0 if none given */ X struct re_registers reregs; X unsigned int saveflags; X NODE *tmp; X NODE **lhs; X char *lastbuf; X int need_to_free = 0; X X if (tree == NULL) X fatal("sub or gsub called with 0 arguments"); X tmp = tree->lnode; X if (tmp->type == Node_regex) { X rp = tmp->rereg; X if (! strict && ((IGNORECASE_node->var_value->numbr != 0) X ^ (tmp->re_case != 0))) { X /* recompile since case sensitivity differs */ X rp = tmp->rereg = X mk_re_parse(tmp->re_text, X (IGNORECASE_node->var_value->numbr != 0)); X tmp->re_case = (IGNORECASE_node->var_value->numbr != 0); X } X } else { X need_to_free = 1; X rp = make_regexp(force_string(tree_eval(tmp)), X (IGNORECASE_node->var_value->numbr != 0)); X if (rp == NULL) X cant_happen(); X } X tree = tree->rnode; X if (tree == NULL) X fatal("sub or gsub called with only 1 argument"); X s = force_string(tree_eval(tree->lnode)); X tree = tree->rnode; X deref = 0; X field_num = -1; X if (tree == NULL) { X t = node0_valid ? fields_arr[0] : *get_field(0, 0); X lhs = &fields_arr[0]; X field_num = 0; X deref = t; X } else { X t = tree->lnode; X lhs = get_lhs(t, 1); X t = force_string(tree_eval(t)); X } X /* X * create a private copy of the string X */ X if (t->stref > 1 || (t->flags & PERM)) { X saveflags = t->flags; X t->flags &= ~MALLOC; X tmp = dupnode(t); X t->flags = saveflags; X do_deref(); X t = tmp; X if (lhs) X *lhs = tmp; X } X lastbuf = t->stptr; X do { X if (re_search(rp, t->stptr, t->stlen, search_start, X t->stlen-search_start, &reregs) == -1 X || reregs.start[0] == reregs.end[0]) X break; X matches++; X X /* X * first, make a pass through the sub. pattern, to calculate X * the length of the string after substitution X */ X match_length = reregs.end[0] - reregs.start[0]; X len = t->stlen - match_length; X for (scan = s->stptr; scan < s->stptr + s->stlen; scan++) X if (*scan == '&') X len += match_length; X else if (*scan == '\\' && *(scan+1) == '&') { X scan++; X len++; X } else X len++; X emalloc(buf, char *, len + 1, "do_sub"); X bp = buf; X X /* X * now, create the result, copying in parts of the original X * string X */ X for (scan = t->stptr; scan < t->stptr + reregs.start[0]; scan++) X *bp++ = *scan; X for (scan = s->stptr; scan < s->stptr + s->stlen; scan++) X if (*scan == '&') X for (cp = t->stptr + reregs.start[0]; X cp < t->stptr + reregs.end[0]; cp++) X *bp++ = *cp; X else if (*scan == '\\' && *(scan+1) == '&') { X scan++; X *bp++ = *scan; X } else X *bp++ = *scan; X search_start = bp - buf; X for (scan = t->stptr + reregs.end[0]; X scan < t->stptr + t->stlen; scan++) X *bp++ = *scan; X *bp = '\0'; X free(lastbuf); X t->stptr = buf; X lastbuf = buf; X t->stlen = len; X } while (global && search_start < t->stlen); X X free_temp(s); X if (need_to_free) { X free(rp->buffer); X free(rp->fastmap); X free((char *) rp); X } X if (matches > 0) { X if (field_num == 0) X set_record(fields_arr[0]->stptr, fields_arr[0]->stlen); X t->flags &= ~(NUM|NUMERIC); X } X field_num = -1; X return tmp_number((AWKNUM) matches); X} X XNODE * Xdo_gsub(tree) XNODE *tree; X{ X return sub_common(tree, 1); X} X XNODE * Xdo_sub(tree) XNODE *tree; X{ X return sub_common(tree, 0); X} X END_OF_FILE if test 20659 -ne `wc -c <'./builtin.c'`; then echo shar: \"'./builtin.c'\" unpacked with wrong size! fi # end of './builtin.c' fi if test -f './eval.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'./eval.c'\" else echo shar: Extracting \"'./eval.c'\" \(29550 characters\) sed "s/^X//" >'./eval.c' <<'END_OF_FILE' X/* X * eval.c - gawk parse tree interpreter 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#include "awk.h" X Xextern void do_print(); Xextern void do_printf(); Xextern NODE *do_match(); Xextern NODE *do_sub(); Xextern NODE *do_getline(); Xextern NODE *concat_exp(); Xextern int in_array(); Xextern void do_delete(); Xextern double pow(); X Xstatic int eval_condition(); Xstatic NODE *op_assign(); Xstatic NODE *func_call(); Xstatic NODE *match_op(); X XNODE *_t; /* used as a temporary in macros */ X#ifdef MSDOS Xdouble _msc51bug; /* to get around a bug in MSC 5.1 */ X#endif XNODE *ret_node; X X/* More of that debugging stuff */ X#ifdef DEBUG X#define DBG_P(X) print_debug X X#else X#define DBG_P(X) X#endif X X/* Macros and variables to save and restore function and loop bindings */ X/* X * the val variable allows return/continue/break-out-of-context to be X * caught and diagnosed X */ X#define PUSH_BINDING(stack, x, val) (memcpy ((char *)(stack), (char *)(x), sizeof (jmp_buf)), val++) X#define RESTORE_BINDING(stack, x, val) (memcpy ((char *)(x), (char *)(stack), sizeof (jmp_buf)), val--) X Xstatic jmp_buf loop_tag; /* always the current binding */ Xstatic int loop_tag_valid = 0; /* nonzero when loop_tag valid */ Xstatic int func_tag_valid = 0; Xstatic jmp_buf func_tag; Xextern int exiting, exit_val; X X/* X * This table is used by the regexp routines to do case independant X * matching. Basically, every ascii character maps to itself, except X * uppercase letters map to lower case ones. This table has 256 X * entries, which may be overkill. Note also that if the system this X * is compiled on doesn't use 7-bit ascii, casetable[] should not be X * defined to the linker, so gawk should not load. X * X * Do NOT make this array static, it is used in several spots, not X * just in this file. X */ X#if 'a' == 97 /* it's ascii */ Xchar casetable[] = { X '\000', '\001', '\002', '\003', '\004', '\005', '\006', '\007', X '\010', '\011', '\012', '\013', '\014', '\015', '\016', '\017', X '\020', '\021', '\022', '\023', '\024', '\025', '\026', '\027', X '\030', '\031', '\032', '\033', '\034', '\035', '\036', '\037', X /* ' ' '!' '"' '#' '$' '%' '&' ''' */ X '\040', '\041', '\042', '\043', '\044', '\045', '\046', '\047', X /* '(' ')' '*' '+' ',' '-' '.' '/' */ X '\050', '\051', '\052', '\053', '\054', '\055', '\056', '\057', X /* '0' '1' '2' '3' '4' '5' '6' '7' */ X '\060', '\061', '\062', '\063', '\064', '\065', '\066', '\067', X /* '8' '9' ':' ';' '<' '=' '>' '?' */ X '\070', '\071', '\072', '\073', '\074', '\075', '\076', '\077', X /* '@' 'A' 'B' 'C' 'D' 'E' 'F' 'G' */ X '\100', '\141', '\142', '\143', '\144', '\145', '\146', '\147', X /* 'H' 'I' 'J' 'K' 'L' 'M' 'N' 'O' */ X '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157', X /* 'P' 'Q' 'R' 'S' 'T' 'U' 'V' 'W' */ X '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167', X /* 'X' 'Y' 'Z' '[' '\' ']' '^' '_' */ X '\170', '\171', '\172', '\133', '\134', '\135', '\136', '\137', X /* '`' 'a' 'b' 'c' 'd' 'e' 'f' 'g' */ X '\140', '\141', '\142', '\143', '\144', '\145', '\146', '\147', X /* 'h' 'i' 'j' 'k' 'l' 'm' 'n' 'o' */ X '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157', X /* 'p' 'q' 'r' 's' 't' 'u' 'v' 'w' */ X '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167', X /* 'x' 'y' 'z' '{' '|' '}' '~' */ X '\170', '\171', '\172', '\173', '\174', '\175', '\176', '\177', X '\200', '\201', '\202', '\203', '\204', '\205', '\206', '\207', X '\210', '\211', '\212', '\213', '\214', '\215', '\216', '\217', X '\220', '\221', '\222', '\223', '\224', '\225', '\226', '\227', X '\230', '\231', '\232', '\233', '\234', '\235', '\236', '\237', X '\240', '\241', '\242', '\243', '\244', '\245', '\246', '\247', X '\250', '\251', '\252', '\253', '\254', '\255', '\256', '\257', X '\260', '\261', '\262', '\263', '\264', '\265', '\266', '\267', X '\270', '\271', '\272', '\273', '\274', '\275', '\276', '\277', X '\300', '\301', '\302', '\303', '\304', '\305', '\306', '\307', X '\310', '\311', '\312', '\313', '\314', '\315', '\316', '\317', X '\320', '\321', '\322', '\323', '\324', '\325', '\326', '\327', X '\330', '\331', '\332', '\333', '\334', '\335', '\336', '\337', X '\340', '\341', '\342', '\343', '\344', '\345', '\346', '\347', X '\350', '\351', '\352', '\353', '\354', '\355', '\356', '\357', X '\360', '\361', '\362', '\363', '\364', '\365', '\366', '\367', X '\370', '\371', '\372', '\373', '\374', '\375', '\376', '\377', X}; X#else X#include "You lose. You will need a translation table for your character set." X#endif X X/* X * Tree is a bunch of rules to run. Returns zero if it hit an exit() X * statement X */ Xint Xinterpret(tree) XNODE *tree; X{ X volatile jmp_buf loop_tag_stack; /* shallow binding stack for loop_tag */ X static jmp_buf rule_tag;/* tag the rule currently being run, for NEXT X * and EXIT statements. It is static because X * there are no nested rules */ X register NODE *t = NULL;/* temporary */ X volatile NODE **lhs; /* lhs == Left Hand Side for assigns, etc */ X volatile struct search *l; /* For array_for */ X volatile NODE *stable_tree; X X if (tree == NULL) X return 1; X sourceline = tree->source_line; X source = tree->source_file; X switch (tree->type) { X case Node_rule_list: X for (t = tree; t != NULL; t = t->rnode) { X tree = t->lnode; X /* FALL THROUGH */ X case Node_rule_node: X sourceline = tree->source_line; X source = tree->source_file; X switch (setjmp(rule_tag)) { X case 0: /* normal non-jump */ X /* test pattern, if any */ X if (tree->lnode == NULL X || eval_condition(tree->lnode)) { X DBG_P(("Found a rule", tree->rnode)); X if (tree->rnode == NULL) { X /* X * special case: pattern with X * no action is equivalent to X * an action of {print} X */ X NODE printnode; X X printnode.type = Node_K_print; X printnode.lnode = NULL; X printnode.rnode = NULL; X do_print(&printnode); X } else if (tree->rnode->type == Node_illegal) { X /* X * An empty statement X * (``{ }'') is different X * from a missing statement. X * A missing statement is X * equal to ``{ print }'' as X * above, but an empty X * statement is as in C, do X * nothing. X */ X } else X (void) interpret(tree->rnode); X } X break; X case TAG_CONTINUE: /* NEXT statement */ X return 1; X case TAG_BREAK: X return 0; X default: X cant_happen(); X } X if (t == NULL) X break; X } X break; X X case Node_statement_list: X for (t = tree; t != NULL; t = t->rnode) { X DBG_P(("Statements", t->lnode)); X (void) interpret(t->lnode); X } X break; X X case Node_K_if: X DBG_P(("IF", tree->lnode)); X if (eval_condition(tree->lnode)) { X DBG_P(("True", tree->rnode->lnode)); X (void) interpret(tree->rnode->lnode); X } else { X DBG_P(("False", tree->rnode->rnode)); X (void) interpret(tree->rnode->rnode); X } X break; X X case Node_K_while: X PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); X X DBG_P(("WHILE", tree->lnode)); X stable_tree = tree; X while (eval_condition(stable_tree->lnode)) { X switch (setjmp(loop_tag)) { X case 0: /* normal non-jump */ X DBG_P(("DO", stable_tree->rnode)); X (void) interpret(stable_tree->rnode); X break; X case TAG_CONTINUE: /* continue statement */ X break; X case TAG_BREAK: /* break statement */ X RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); X return 1; X default: X cant_happen(); X } X } X RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); X break; X X case Node_K_do: X PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); X stable_tree = tree; X do { X switch (setjmp(loop_tag)) { X case 0: /* normal non-jump */ X DBG_P(("DO", stable_tree->rnode)); X (void) interpret(stable_tree->rnode); X break; X case TAG_CONTINUE: /* continue statement */ X break; X case TAG_BREAK: /* break statement */ X RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); X return 1; X default: X cant_happen(); X } X DBG_P(("WHILE", stable_tree->lnode)); X } while (eval_condition(stable_tree->lnode)); X RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); X break; X X case Node_K_for: X PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); X DBG_P(("FOR", tree->forloop->init)); X (void) interpret(tree->forloop->init); X DBG_P(("FOR.WHILE", tree->forloop->cond)); X stable_tree = tree; X while (eval_condition(stable_tree->forloop->cond)) { X switch (setjmp(loop_tag)) { X case 0: /* normal non-jump */ X DBG_P(("FOR.DO", stable_tree->lnode)); X (void) interpret(stable_tree->lnode); X /* fall through */ X case TAG_CONTINUE: /* continue statement */ X DBG_P(("FOR.INCR", stable_tree->forloop->incr)); X (void) interpret(stable_tree->forloop->incr); X break; X case TAG_BREAK: /* break statement */ X RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); X return 1; X default: X cant_happen(); X } X } X RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); X break; X X case Node_K_arrayfor: X#define hakvar forloop->init X#define arrvar forloop->incr X PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); X DBG_P(("AFOR.VAR", tree->hakvar)); X lhs = (volatile NODE **) get_lhs(tree->hakvar, 1); X t = tree->arrvar; X if (t->type == Node_param_list) X t = stack_ptr[t->param_cnt]; X stable_tree = tree; X for (l = assoc_scan(t); l; l = assoc_next((struct search *)l)) { X deref = *((NODE **) lhs); X do_deref(); X *lhs = dupnode(l->retval); X if (field_num == 0) X set_record(fields_arr[0]->stptr, X fields_arr[0]->stlen); X DBG_P(("AFOR.NEXTIS", *lhs)); X switch (setjmp(loop_tag)) { X case 0: X DBG_P(("AFOR.DO", stable_tree->lnode)); X (void) interpret(stable_tree->lnode); X case TAG_CONTINUE: X break; X X case TAG_BREAK: X RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); X field_num = -1; X return 1; X default: X cant_happen(); X } X } X field_num = -1; X RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); X break; X X case Node_K_break: X DBG_P(("BREAK", NULL)); X if (loop_tag_valid == 0) X fatal("unexpected break"); X longjmp(loop_tag, TAG_BREAK); X break; X X case Node_K_continue: X DBG_P(("CONTINUE", NULL)); X if (loop_tag_valid == 0) X fatal("unexpected continue"); X longjmp(loop_tag, TAG_CONTINUE); X break; X X case Node_K_print: X DBG_P(("PRINT", tree)); X do_print(tree); X break; X X case Node_K_printf: X DBG_P(("PRINTF", tree)); X do_printf(tree); X break; X X case Node_K_next: X DBG_P(("NEXT", NULL)); X longjmp(rule_tag, TAG_CONTINUE); X break; X X case Node_K_exit: X /* X * In A,K,&W, p. 49, it says that an exit statement "... X * causes the program to behave as if the end of input had X * occurred; no more input is read, and the END actions, if X * any are executed." This implies that the rest of the rules X * are not done. So we immediately break out of the main loop. X */ X DBG_P(("EXIT", NULL)); X exiting = 1; X if (tree) { X t = tree_eval(tree->lnode); X exit_val = (int) force_number(t); X } X free_temp(t); X longjmp(rule_tag, TAG_BREAK); X break; X X case Node_K_return: X DBG_P(("RETURN", NULL)); X t = tree_eval(tree->lnode); X ret_node = dupnode(t); X free_temp(t); X longjmp(func_tag, TAG_RETURN); X break; X X default: X /* X * Appears to be an expression statement. Throw away the X * value. X */ X DBG_P(("E", NULL)); X t = tree_eval(tree); X free_temp(t); X break; X } X return 1; X} X X/* evaluate a subtree, allocating strings on a temporary stack. */ X XNODE * Xr_tree_eval(tree) XNODE *tree; X{ X register NODE *r, *t1, *t2; /* return value & temporary subtrees */ X int i; X register NODE **lhs; X int di; X AWKNUM x, x2; X long lx; X extern NODE **fields_arr; X X source = tree->source_file; X sourceline = tree->source_line; X switch (tree->type) { X case Node_and: X DBG_P(("AND", tree)); X return tmp_number((AWKNUM) (eval_condition(tree->lnode) X && eval_condition(tree->rnode))); X X case Node_or: X DBG_P(("OR", tree)); X return tmp_number((AWKNUM) (eval_condition(tree->lnode) X || eval_condition(tree->rnode))); X X case Node_not: X DBG_P(("NOT", tree)); X return tmp_number((AWKNUM) ! eval_condition(tree->lnode)); X X /* Builtins */ X case Node_builtin: X DBG_P(("builtin", tree)); X return ((*tree->proc) (tree->subnode)); X X case Node_K_getline: X DBG_P(("GETLINE", tree)); X return (do_getline(tree)); X X case Node_in_array: X DBG_P(("IN_ARRAY", tree)); X return tmp_number((AWKNUM) in_array(tree->lnode, tree->rnode)); X X case Node_func_call: X DBG_P(("func_call", tree)); X return func_call(tree->rnode, tree->lnode); X X case Node_K_delete: X DBG_P(("DELETE", tree)); X do_delete(tree->lnode, tree->rnode); X return Nnull_string; X X /* unary operations */ X X case Node_var: X case Node_var_array: X case Node_param_list: X case Node_subscript: X case Node_field_spec: X DBG_P(("var_type ref", tree)); X lhs = get_lhs(tree, 0); X field_num = -1; X deref = 0; X return *lhs; X X case Node_unary_minus: X DBG_P(("UMINUS", tree)); X t1 = tree_eval(tree->subnode); X x = -force_number(t1); X free_temp(t1); X return tmp_number(x); X X case Node_cond_exp: X DBG_P(("?:", tree)); X if (eval_condition(tree->lnode)) { X DBG_P(("True", tree->rnode->lnode)); X return tree_eval(tree->rnode->lnode); X } X DBG_P(("False", tree->rnode->rnode)); X return tree_eval(tree->rnode->rnode); X X case Node_match: X case Node_nomatch: X case Node_regex: X DBG_P(("[no]match_op", tree)); X return match_op(tree); X X case Node_func: X fatal("function `%s' called with space between name and (,\n%s", X tree->lnode->param, X "or used in other expression context"); X X /* assignments */ X case Node_assign: X DBG_P(("ASSIGN", tree)); X r = tree_eval(tree->rnode); X lhs = get_lhs(tree->lnode, 1); X *lhs = dupnode(r); X free_temp(r); X do_deref(); X if (field_num == 0) X set_record(fields_arr[0]->stptr, fields_arr[0]->stlen); X field_num = -1; X return *lhs; X X /* other assignment types are easier because they are numeric */ X case Node_preincrement: X case Node_predecrement: X case Node_postincrement: X case Node_postdecrement: X case Node_assign_exp: X case Node_assign_times: X case Node_assign_quotient: X case Node_assign_mod: X case Node_assign_plus: X case Node_assign_minus: X return op_assign(tree); X default: X break; /* handled below */ X } X X /* evaluate subtrees in order to do binary operation, then keep going */ X t1 = tree_eval(tree->lnode); X t2 = tree_eval(tree->rnode); X X switch (tree->type) { X case Node_concat: X DBG_P(("CONCAT", tree)); X t1 = force_string(t1); X t2 = force_string(t2); X X r = newnode(Node_val); X r->flags |= (STR|TEMP); X r->stlen = t1->stlen + t2->stlen; X r->stref = 1; X emalloc(r->stptr, char *, r->stlen + 1, "tree_eval"); X memcpy(r->stptr, t1->stptr, t1->stlen); X memcpy(r->stptr + t1->stlen, t2->stptr, t2->stlen + 1); X free_temp(t1); X free_temp(t2); X return r; X X case Node_geq: X case Node_leq: X case Node_greater: X case Node_less: X case Node_notequal: X case Node_equal: X di = cmp_nodes(t1, t2); X free_temp(t1); X free_temp(t2); X switch (tree->type) { X case Node_equal: X DBG_P(("EQUAL", tree)); X return tmp_number((AWKNUM) (di == 0)); X case Node_notequal: X DBG_P(("NOT_EQUAL", tree)); X return tmp_number((AWKNUM) (di != 0)); X case Node_less: X DBG_P(("LESS_THAN", tree)); X return tmp_number((AWKNUM) (di < 0)); X case Node_greater: X DBG_P(("GREATER_THAN", tree)); X return tmp_number((AWKNUM) (di > 0)); X case Node_leq: X DBG_P(("LESS_THAN_EQUAL", tree)); X return tmp_number((AWKNUM) (di <= 0)); X case Node_geq: X DBG_P(("GREATER_THAN_EQUAL", tree)); X return tmp_number((AWKNUM) (di >= 0)); X default: X cant_happen(); X } X break; X default: X break; /* handled below */ X } X X (void) force_number(t1); X (void) force_number(t2); X X switch (tree->type) { X case Node_exp: X DBG_P(("EXPONENT", tree)); X if ((lx = t2->numbr) == t2->numbr) { /* integer exponent */ X if (lx == 0) X x = 1; X else if (lx == 1) X x = t1->numbr; X else { X /* doing it this way should be more precise */ X for (x = x2 = t1->numbr; --lx; ) X x *= x2; X } X } else X x = pow((double) t1->numbr, (double) t2->numbr); X free_temp(t1); X free_temp(t2); X return tmp_number(x); X X case Node_times: X DBG_P(("MULT", tree)); X x = t1->numbr * t2->numbr; X free_temp(t1); X free_temp(t2); X return tmp_number(x); X X case Node_quotient: X DBG_P(("DIVIDE", tree)); X x = t2->numbr; X free_temp(t2); X if (x == (AWKNUM) 0) X fatal("division by zero attempted"); X /* NOTREACHED */ X else { X x = t1->numbr / x; X free_temp(t1); X return tmp_number(x); X } X X case Node_mod: X DBG_P(("MODULUS", tree)); X x = t2->numbr; X free_temp(t2); X if (x == (AWKNUM) 0) X fatal("division by zero attempted in mod"); X /* NOTREACHED */ X lx = t1->numbr / x; /* assignment to long truncates */ X x2 = lx * x; X x = t1->numbr - x2; X free_temp(t1); X return tmp_number(x); X X case Node_plus: X DBG_P(("PLUS", tree)); X x = t1->numbr + t2->numbr; X free_temp(t1); X free_temp(t2); X return tmp_number(x); X X case Node_minus: X DBG_P(("MINUS", tree)); X x = t1->numbr - t2->numbr; X free_temp(t1); X free_temp(t2); X return tmp_number(x); X X default: X fatal("illegal type (%d) in tree_eval", tree->type); X } X return 0; X} X X/* X * This makes numeric operations slightly more efficient. Just change the X * value of a numeric node, if possible X */ Xvoid Xassign_number(ptr, value) XNODE **ptr; XAWKNUM value; X{ X extern NODE *deref; X register NODE *n = *ptr; X X#ifdef DEBUG X if (n->type != Node_val) X cant_happen(); X#endif X if (n == Nnull_string) { X *ptr = make_number(value); X deref = 0; X return; X } X if (n->stref > 1) { X *ptr = make_number(value); X return; X } X if ((n->flags & STR) && (n->flags & (MALLOC|TEMP))) X free(n->stptr); X n->numbr = value; X n->flags |= (NUM|NUMERIC); X n->flags &= ~STR; X n->stref = 0; X deref = 0; X} X X X/* Is TREE true or false? Returns 0==false, non-zero==true */ Xstatic int Xeval_condition(tree) XNODE *tree; X{ X register NODE *t1; X int ret; X X if (tree == NULL) /* Null trees are the easiest kinds */ X return 1; X if (tree->type == Node_line_range) { X /* X * Node_line_range is kind of like Node_match, EXCEPT: the X * lnode field (more properly, the condpair field) is a node X * of a Node_cond_pair; whether we evaluate the lnode of that X * node or the rnode depends on the triggered word. More X * precisely: if we are not yet triggered, we tree_eval the X * lnode; if that returns true, we set the triggered word. X * If we are triggered (not ELSE IF, note), we tree_eval the X * rnode, clear triggered if it succeeds, and perform our X * action (regardless of success or failure). We want to be X * able to begin and end on a single input record, so this X * isn't an ELSE IF, as noted above. X */ X if (!tree->triggered) X if (!eval_condition(tree->condpair->lnode)) X return 0; X else X tree->triggered = 1; X /* Else we are triggered */ X if (eval_condition(tree->condpair->rnode)) X tree->triggered = 0; X return 1; X } X X /* X * Could just be J.random expression. in which case, null and 0 are X * false, anything else is true X */ X X t1 = tree_eval(tree); X if (t1->flags & NUMERIC) X ret = t1->numbr != 0.0; X else X ret = t1->stlen != 0; X free_temp(t1); X return ret; X} X Xint Xcmp_nodes(t1, t2) XNODE *t1, *t2; X{ X AWKNUM d; X AWKNUM d1; X AWKNUM d2; X int ret; X int len1, len2; X X if (t1 == t2) X return 0; X d1 = force_number(t1); X d2 = force_number(t2); X if ((t1->flags & NUMERIC) && (t2->flags & NUMERIC)) { X d = d1 - d2; X if (d == 0.0) /* from profiling, this is most common */ X return 0; X if (d > 0.0) X return 1; X return -1; X } X t1 = force_string(t1); X t2 = force_string(t2); X len1 = t1->stlen; X len2 = t2->stlen; X if (len1 == 0) { X if (len2 == 0) X return 0; X else X return -1; X } else if (len2 == 0) X return 1; X ret = memcmp(t1->stptr, t2->stptr, len1 <= len2 ? len1 : len2); X if (ret == 0 && len1 != len2) X return len1 < len2 ? -1: 1; X return ret; X} X Xstatic NODE * Xop_assign(tree) XNODE *tree; X{ X AWKNUM rval, lval; X NODE **lhs; X AWKNUM t1, t2; X long ltemp; X NODE *tmp; X X lhs = get_lhs(tree->lnode, 1); X lval = force_number(*lhs); X X switch(tree->type) { X case Node_preincrement: X case Node_predecrement: X DBG_P(("+-X", tree)); X assign_number(lhs, X lval + (tree->type == Node_preincrement ? 1.0 : -1.0)); X do_deref(); X if (field_num == 0) X set_record(fields_arr[0]->stptr, fields_arr[0]->stlen); X field_num = -1; X return *lhs; X X case Node_postincrement: X case Node_postdecrement: X DBG_P(("X+-", tree)); X assign_number(lhs, X lval + (tree->type == Node_postincrement ? 1.0 : -1.0)); X do_deref(); X if (field_num == 0) X set_record(fields_arr[0]->stptr, fields_arr[0]->stlen); X field_num = -1; X return tmp_number(lval); X default: X break; /* handled below */ X } X X tmp = tree_eval(tree->rnode); X rval = force_number(tmp); X free_temp(tmp); X switch(tree->type) { X case Node_assign_exp: X DBG_P(("ASSIGN_exp", tree)); X if ((ltemp = rval) == rval) { /* integer exponent */ X if (ltemp == 0) X assign_number(lhs, (AWKNUM) 1); X else if (ltemp == 1) X assign_number(lhs, lval); X else { X /* doing it this way should be more precise */ X for (t1 = t2 = lval; --ltemp; ) X t1 *= t2; X assign_number(lhs, t1); X } X } else X assign_number(lhs, (AWKNUM) pow((double) lval, (double) rval)); X break; X X case Node_assign_times: X DBG_P(("ASSIGN_times", tree)); X assign_number(lhs, lval * rval); X break; X X case Node_assign_quotient: X DBG_P(("ASSIGN_quotient", tree)); X if (rval == (AWKNUM) 0) X fatal("division by zero attempted in /="); X assign_number(lhs, lval / rval); X break; X X case Node_assign_mod: X DBG_P(("ASSIGN_mod", tree)); X if (rval == (AWKNUM) 0) X fatal("division by zero attempted in %="); X ltemp = lval / rval; /* assignment to long truncates */ X t1 = ltemp * rval; X t2 = lval - t1; X assign_number(lhs, t2); X break; X X case Node_assign_plus: X DBG_P(("ASSIGN_plus", tree)); X assign_number(lhs, lval + rval); X break; X X case Node_assign_minus: X DBG_P(("ASSIGN_minus", tree)); X assign_number(lhs, lval - rval); X break; X default: X cant_happen(); X } X do_deref(); X if (field_num == 0) X set_record(fields_arr[0]->stptr, fields_arr[0]->stlen); X field_num = -1; X return *lhs; X} X XNODE **stack_ptr; X Xstatic NODE * Xfunc_call(name, arg_list) XNODE *name; /* name is a Node_val giving function name */ XNODE *arg_list; /* Node_expression_list of calling args. */ X{ X register NODE *arg, *argp, *r; X NODE *n, *f; X volatile jmp_buf func_tag_stack; X volatile jmp_buf loop_tag_stack; X volatile int save_loop_tag_valid = 0; X volatile NODE **save_stack, *save_ret_node; X NODE **local_stack, **sp; X int count; X extern NODE *ret_node; X X /* X * retrieve function definition node X */ X f = lookup(variables, name->stptr); X if (!f || f->type != Node_func) X fatal("function `%s' not defined", name->stptr); X#ifdef FUNC_TRACE X fprintf(stderr, "function %s called\n", name->stptr); X#endif X count = f->lnode->param_cnt; X emalloc(local_stack, NODE **, count * sizeof(NODE *), "func_call"); X sp = local_stack; X X /* X * for each calling arg. add NODE * on stack X */ X for (argp = arg_list; count && argp != NULL; argp = argp->rnode) { X arg = argp->lnode; X r = newnode(Node_var); X /* X * call by reference for arrays; see below also X */ X if (arg->type == Node_param_list) X arg = stack_ptr[arg->param_cnt]; X if (arg->type == Node_var_array) X *r = *arg; X else { X n = tree_eval(arg); X r->lnode = dupnode(n); X r->rnode = (NODE *) NULL; X free_temp(n); X } X *sp++ = r; X count--; X } X if (argp != NULL) /* left over calling args. */ X warning( X "function `%s' called with more arguments than declared", X name->stptr); X /* X * add remaining params. on stack with null value X */ X while (count-- > 0) { X r = newnode(Node_var); X r->lnode = Nnull_string; X r->rnode = (NODE *) NULL; X *sp++ = r; X } X X /* X * Execute function body, saving context, as a return statement X * will longjmp back here. X * X * Have to save and restore the loop_tag stuff so that a return X * inside a loop in a function body doesn't scrog any loops going X * on in the main program. We save the necessary info in variables X * local to this function so that function nesting works OK. X * We also only bother to save the loop stuff if we're in a loop X * when the function is called. X */ X if (loop_tag_valid) { X int junk = 0; X X save_loop_tag_valid = (volatile int) loop_tag_valid; X PUSH_BINDING(loop_tag_stack, loop_tag, junk); X loop_tag_valid = 0; X } X save_stack = (volatile NODE **) stack_ptr; X stack_ptr = local_stack; X PUSH_BINDING(func_tag_stack, func_tag, func_tag_valid); X save_ret_node = (volatile NODE *) ret_node; X ret_node = Nnull_string; /* default return value */ X if (setjmp(func_tag) == 0) X (void) interpret(f->rnode); X X r = ret_node; X ret_node = (NODE *) save_ret_node; X RESTORE_BINDING(func_tag_stack, func_tag, func_tag_valid); X stack_ptr = (NODE **) save_stack; X X /* X * here, we pop each parameter and check whether X * it was an array. If so, and if the arg. passed in was X * a simple variable, then the value should be copied back. X * This achieves "call-by-reference" for arrays. X */ X sp = local_stack; X count = f->lnode->param_cnt; X for (argp = arg_list; count > 0 && argp != NULL; argp = argp->rnode) { X arg = argp->lnode; X n = *sp++; X if (arg->type == Node_var && n->type == Node_var_array) { X arg->var_array = n->var_array; X arg->type = Node_var_array; X } X deref = n->lnode; X do_deref(); X freenode(n); X count--; X } X while (count-- > 0) { X n = *sp++; X deref = n->lnode; X do_deref(); X freenode(n); X } X free((char *) local_stack); X X /* Restore the loop_tag stuff if necessary. */ X if (save_loop_tag_valid) { X int junk = 0; X X loop_tag_valid = (int) save_loop_tag_valid; X RESTORE_BINDING(loop_tag_stack, loop_tag, junk); X } X X if (!(r->flags & PERM)) X r->flags |= TEMP; X return r; X} X X/* X * This returns a POINTER to a node pointer. get_lhs(ptr) is the current X * value of the var, or where to store the var's new value X */ X XNODE ** Xget_lhs(ptr, assign) XNODE *ptr; Xint assign; /* this is being called for the LHS of an assign. */ X{ X register NODE **aptr; X NODE *n; X X#ifdef DEBUG X if (ptr == NULL) X cant_happen(); X#endif X deref = NULL; X field_num = -1; X switch (ptr->type) { X case Node_var: X case Node_var_array: X if (ptr == NF_node && (int) NF_node->var_value->numbr == -1) X (void) get_field(HUGE-1, assign); /* parse record */ X deref = ptr->var_value; X#ifdef DEBUG X if (deref->type != Node_val) X cant_happen(); X if (deref->flags == 0) X cant_happen(); X#endif X return &(ptr->var_value); X X case Node_param_list: X n = stack_ptr[ptr->param_cnt]; X deref = n->var_value; X#ifdef DEBUG X if (deref->type != Node_val) X cant_happen(); X if (deref->flags == 0) X cant_happen(); X#endif X return &(n->var_value); X X case Node_field_spec: X n = tree_eval(ptr->lnode); X field_num = (int) force_number(n); X free_temp(n); X if (field_num < 0) X fatal("attempt to access field %d", field_num); X aptr = get_field(field_num, assign); X deref = *aptr; X return aptr; X X case Node_subscript: X n = ptr->lnode; X if (n->type == Node_param_list) X n = stack_ptr[n->param_cnt]; X aptr = assoc_lookup(n, concat_exp(ptr->rnode)); X deref = *aptr; X#ifdef DEBUG X if (deref->type != Node_val) X cant_happen(); X if (deref->flags == 0) X cant_happen(); X#endif X return aptr; X case Node_func: X fatal ("`%s' is a function, assignment is not allowed", X ptr->lnode->param); X default: X cant_happen(); X } X return 0; X} X Xstatic NODE * Xmatch_op(tree) XNODE *tree; X{ X NODE *t1; X struct re_pattern_buffer *rp; X int i; X int match = 1; X X if (tree->type == Node_nomatch) X match = 0; X if (tree->type == Node_regex) X t1 = WHOLELINE; X else { X if (tree->lnode) X t1 = force_string(tree_eval(tree->lnode)); X else X t1 = WHOLELINE; X tree = tree->rnode; X } X if (tree->type == Node_regex) { X rp = tree->rereg; X if (!strict && ((IGNORECASE_node->var_value->numbr != 0) X ^ (tree->re_case != 0))) { X /* recompile since case sensitivity differs */ X rp = tree->rereg = X mk_re_parse(tree->re_text, X (IGNORECASE_node->var_value->numbr != 0)); X tree->re_case = X (IGNORECASE_node->var_value->numbr != 0); X } X } else { X rp = make_regexp(force_string(tree_eval(tree)), X (IGNORECASE_node->var_value->numbr != 0)); X if (rp == NULL) X cant_happen(); X } X i = re_search(rp, t1->stptr, t1->stlen, 0, t1->stlen, X (struct re_registers *) NULL); X i = (i == -1) ^ (match == 1); X free_temp(t1); X if (tree->type != Node_regex) { X free(rp->buffer); X free(rp->fastmap); X free((char *) rp); X } X return tmp_number((AWKNUM) i); X} END_OF_FILE if test 29550 -ne `wc -c <'./eval.c'`; then echo shar: \"'./eval.c'\" unpacked with wrong size! fi # end of './eval.c' fi if test -f './missing.d/gcvt.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'./missing.d/gcvt.c'\" else echo shar: Extracting \"'./missing.d/gcvt.c'\" \(129 characters\) sed "s/^X//" >'./missing.d/gcvt.c' <<'END_OF_FILE' Xchar * Xgcvt(value, digits, buff) Xdouble value; Xint digits; Xchar *buff; X{ X sprintf(buff, "%*g", digits, value); X return (buff); X} END_OF_FILE if test 129 -ne `wc -c <'./missing.d/gcvt.c'`; then echo shar: \"'./missing.d/gcvt.c'\" unpacked with wrong size! fi # end of './missing.d/gcvt.c' fi echo shar: End of archive 12 \(of 16\). cp /dev/null ark12isdone 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...