|
|
DataMuseum.dkPresents historical artifacts from the history of: Commodore CBM-900 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Commodore CBM-900 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 11021 (0x2b0d)
Types: TextFile
Notes: UNIX file
Names: »awk5.c«
└─⟦f27320a65⟧ Bits:30001972 Commodore 900 hard disk image with partial source code
└─⟦f4b8d8c84⟧ UNIX Filesystem
└─⟦this⟧ »cmd/awk/awk5.c«
/*
* Awk - internal execution functions.
*/
#include "awk.h"
#include "y.tab.h"
FILE *xoutput();
/*
* `print' directive.
* First argument is the NODE (or list) to print
* and the second is the output.
* Have to close pipes specially.
* The ALIST stuff should be generalised
* so that functions can get their arguments
* a little more easily.
*/
xprint(np, xp)
register NODE *np;
register NODE *xp;
{
register FILE *ofp;
ofp = xoutput(xp);
while (np != NULL) {
if (np->n_op == ALIST) {
xp = np->n_O1;
np = np->n_O2;
} else {
xp = np;
np = NULL;
}
xp = evalexpr(xp);
if (xp->t_flag & T_NUM) {
if (xp->t_flag & T_INT)
fprintf(ofp, OFMT, xp->t_INT); else
fprintf(ofp, "%.6g", xp->t_FLOAT);
} else
fprintf(ofp, "%s", xp->t_STRING);
if (np != NULL)
fprintf(ofp, "%s", OFS);
}
fprintf(ofp, "%s", ORS);
fflush(ofp);
}
/*
* `printf' directive.
* First argument is list, second
* is output.
* If third argument is non-NULL,
* it is used for sprintf rather than
* printf.
*/
xprintf(np, xp, sp)
NODE *np;
NODE *xp;
STRING sp;
{
NODE *nextarg();
int *pflist;
register char *cp;
register int *pflp;
register int c;
register int i;
register FILE *ofp;
pflp = pflist = (int *)xalloc(fnargs(np) * sizeof(double));
if (sp == NULL)
ofp = xoutput(xp); else
*sp = '\0';
i = 1;
*((char **)pflp) = cp = evalstring(nextarg(np, i++));
bump(pflp, char*);
for (;;) {
while ((c = *cp++)!='%' && c!='\0')
;
if (c == '\0')
break;
if (*cp == '-')
cp++;
if (*cp == '*') {
*pflp++ = evalint(nextarg(np, i++));
cp++;
} else
while (isdigit(*cp))
cp++;
if (*cp == '.') {
cp++;
if (*cp == '*') {
*pflp++ = evalint(nextarg(np, i++));
cp++;
} else
while (isdigit(*cp))
cp++;
}
if ((c = *cp++) == 'l')
c = toupper(*cp++);
switch (c) {
case 'd':
case 'u':
case 'x':
case 'o':
*pflp++ = evalint(nextarg(np, i++));
break;
case 'D':
case 'U':
case 'X':
case 'O':
*((long *)pflp) = (long)evalint(nextarg(np, i++));
bump(pflp, long);
break;
case 'e':
case 'f':
case 'g':
*((double *)pflp) = (double)evalfloat(nextarg(np, i++));
bump(pflp, double);
break;
case 'c':
xp = evalexpr(nextarg(np, i++));
if (xp->n_flag & T_NUM)
*pflp++ = evalint(xp); else
*pflp++ = *evalstring(xp);
break;
case 's':
*((char **)pflp) = evalstring(nextarg(np, i++));
bump(pflp, char*);
break;
case 'r':
awkwarn("%%r not available in sprintf/printf");
break;
}
}
if (sp == NULL) {
fprintf(ofp, "%r", pflist);
fflush(ofp);
} else
sprintf(sp, "%r", pflist);
free(pflist);
}
/*
* Return the next argument for printf.
*/
static NODE *
nextarg(anp, n)
register NODE *anp;
register int n;
{
if ((anp = fargn(anp, n)) == NULL)
awkerr("Missing argument to printf/sprintf");
return (anp);
}
/*
* Calculate the output
* stream for print or printf.
* This saves up names so that they
* don't get re-opened every time.
*/
FILE *
xoutput(np)
register NODE *np;
{
register char *s;
register OFILE *ofp;
register OFILE *ofslot;
if (np == NULL)
return (stdout);
s = evalstring(np->n_O1);
ofslot = NULL;
for (ofp = files; ofp < endof(files); ofp++)
if (ofp->of_fp != NULL) {
if (strcmp(ofp->of_name, s) == 0)
return (ofp->of_fp);
} else
ofslot = ofp;
if ((ofp = ofslot) == NULL)
awkerr("Too many output files or pipes");
ofp->of_flag = 0;
switch (np->n_op) {
case AFOUT:
if ((ofp->of_fp = fopen(s, "w")) == NULL)
awkerr("Cannot open output `%s'", s);
break;
case AFAPP:
if ((ofp->of_fp = fopen(s, "a")) == NULL)
awkerr("Cannot open `%s' for append", s);
break;
case AFPIPE:
if ((ofp->of_fp = popen(s, "w")) == NULL)
awkerr("Cannot create pipe to `%s'", s);
ofp->of_flag = OFPIPE;
break;
default:
awkerr("Bad output tree op %d", np->n_op);
}
ofp->of_name = xalloc(strlen(s) + sizeof(char));
strcpy(ofp->of_name, s);
setbuf(ofp->of_fp, outbuf);
return (ofp->of_fp);
}
/*
* Do the form: for (i in array) stat
* `var' is the index and `stat' the statement.
*/
xforin(var, array, stat)
NODE *var;
register NODE *array;
NODE *stat;
{
register char *cp;
register TERM *tp;
register int i;
register int j;
for (i=0; i<NHASH; i++)
for (tp = symtab[i]; tp != NULL; tp = tp->t_next)
if (tp->t_ahval==array->t_hval && tp->t_flag&T_ARRAY
&& streq(tp->t_name, array->t_name)) {
if ((j = setjmp(fwenv[fwlevel])) == ABREAK)
break;
else if (j == ACONTIN)
continue;
cp = tp->t_name;
while (*cp++ != '\0')
;
xassign(var, snode(cp, 0));
evalact(stat);
}
}
/*
* Return a node associated with
* an array element.
* `array' is the array identifier,
* and `index' is the index expression
* represented as a STRING.
*/
NODE *
xarray(array, index)
NODE *array;
NODE *index;
{
return (alookup(array->t_name, evalstring(index)));
}
/*
* Extract the field given by the expression.
* A negative field number is
* considered to be from the end.
* The `asval' is non-NULL when
* the string is to be assigned to a field.
*/
NODE *
xfield(i, asval)
int i;
STRING asval;
{
char *xfield1();
register unsigned char *as, *s1, *s2;
register int c;
register unsigned nb;
if ((s1 = inline) == NULL) {
awkwarn("field, $%d, illegal in BEGIN or END", i);
return (snode(SNULL, 0));
}
if (i == 0) {
if (asval != NULL) {
inline = xalloc(strlen(asval)+sizeof(char));
strcpy(inline, asval);
}
return (snode(inline, 0));
}
if (i < 0)
if ((i += (int)NF + 1) == 0)
i = -1;
for (;;) {
while (FSMAP[*s1])
s1++;
if (*s1=='\0' || --i==0)
break;
while ((c = *s1++)!='\0' && !FSMAP[c])
;
if (c == '\0') {
s1--;
break;
}
}
s2 = s1;
nb = sizeof(char);
while ((c = *s2++)!='\0' && !FSMAP[c])
nb++;
s2--;
if (asval != NULL) {
inline = as = xfield1(inline, s1, asval, s2, s2+strlen(s2));
return (snode(inline, 0));
} else {
as = xalloc(nb);
while (s1 < s2)
*as++ = *s1++;
*as++ = '\0';
as -= nb;
}
return (snode(as, T_ALLOC));
}
/*
* Assignment of fields support.
* The arguments are:
* `f1', `f2', `middle', `e1', `e2'
* for the front start and stop, the middle
* and the end start and stop, respectively.
*/
char *
xfield1(f1, f2, middle, e1, e2)
char *f1, *f2;
char *middle;
char *e1, *e2;
{
register char *p1, *p2;
register char *as;
as = xalloc(f2-f1 + e2-e1 + strlen(middle) + sizeof(char));
p1 = as;
p2 = f1;
while (p2 < f2)
*p1++ = *p2++;
p2 = middle;
while (*p2 != '\0')
*p1++ = *p2++;
p2 = e1;
while (p2 < e2)
*p1++ = *p2++;
*p1 = '\0';
return (as);
}
/*
* String catenation in two nodes.
*/
NODE *
xconc(n1, n2)
register NODE *n1, *n2;
{
register char *ap;
register char *cp1, *cp2;
register int n;
n = strlen(ap = evalstring(n1)) + sizeof(char);
if ((n1->t_un.t_flag & T_NUM) == 0) {
cp1 = xalloc(n);
strcpy(cp1, ap);
} else
cp1 = ap;
n += strlen(cp2 = evalstring(n2));
ap = xalloc(n);
strcpy(ap, cp1);
strcat(ap, cp2);
if ((n1->t_un.t_flag & T_NUM) == 0)
free(cp1);
return (snode(ap, T_ALLOC));
}
/*
* Arithmetic operations --
*
* Numeric addition
*/
NODE *
xadd(n1, n2)
register NODE *n1, *n2;
{
if (isfloat(n1) || isfloat(n2))
return (fnode(evalfloat(n1) + evalfloat(n2)));
return (inode(evalint(n1) + evalint(n2)));
}
/*
* Subtraction -- actually a numeric operation.
*/
NODE *
xsub(n1, n2)
register NODE *n1, *n2;
{
if (isfloat(n1) || isfloat(n2))
return (fnode(evalfloat(n1) - evalfloat(n2)));
return (inode(evalint(n1) - evalint(n2)));
}
/*
* Multiplication
*/
NODE *
xmul(n1, n2)
register NODE *n1, *n2;
{
if (isfloat(n1) || isfloat(n2))
return (fnode(evalfloat(n1) * evalfloat(n2)));
return (inode(evalint(n1) * evalint(n2)));
}
/*
* Division
* If either numeric is of internal FLOAT type,
* the division will be a float one, otherwise use
* INT division.
*/
NODE *
xdiv(n1, n2)
register NODE *n1, *n2;
{
if (isfloat(n1) || isfloat(n2))
return (fnode(evalfloat(n1) / evalfloat(n2)));
return (inode(evalint(n1) / evalint(n2)));
}
/*
* Modulus
* Same type conversion rule as for division.
*/
NODE *
xmod(n1, n2)
register NODE *n1, *n2;
{
if (isfloat(n1) || isfloat(n2))
awkwarn("Modulus operator not allowed on floating point");
return (inode(evalint(n1) % evalint(n2)));
}
/*
* Comparison operators --
* string or numeric comparison
* for equality or non-equality.
* The tricks come in conversions
* between FLOAT and INT.
* The nodes passed should not be evaluated
* beforehand so that checks for fields can
* be made as here fields are always considered
* as strings.
*/
NODE *
xcmp(n1, n2, op)
register NODE *n1, *n2;
int op;
{
register int result;
register int isnum = 0;
if (n1->n_op != AFIELD)
isnum = isnumeric(n1 = evalexpr(n1));
else
n1 = evalexpr(n1);
if (n2->n_op != AFIELD)
isnum |= isnumeric(n2 = evalexpr(n2));
else
n2 = evalexpr(n2);
if (isnum) {
result = 0;
if (isfloat(n1) || isfloat(n2)) {
register FLOAT f1, f2;
if ((f1 = evalfloat(n1)) > (f2 = evalfloat(n2)))
result++;
else if (f1 < f2)
result--;
} else {
register INT i1, i2;
if ((i1 = evalint(n1)) > (i2 = evalint(n2)))
result++;
else if (i1 < i2)
result--;
}
} else if ((n1->t_flag & T_NUM)==0 && (n2->t_flag & T_NUM)==0)
result = strcmp(n1->t_STRING, n2->t_STRING);
else
result = strcmp(evalstring(n1), evalstring(n2));
switch (op) {
case AEQ:
result = result==0;
break;
case ANE:
result = result!=0;
break;
case AGT:
result = result>0;
break;
case AGE:
result = result>=0;
break;
case ALT:
result = result<0;
break;
case ALE:
result = result<=0;
break;
}
return (inode((INT)result));
}
/*
* Assignment
* The two nodes `l' and `r' are the left
* and right sides of the assignment,
* respectively.
*/
NODE *
xassign(l, r)
register NODE *l, *r;
{
if (l->t_op == AFIELD)
return (xfield((int)evalint(l->n_O1), evalstring(r)));
else if (l->t_op == AARRAY)
l = xarray(l->n_O1, l->n_O2);
if ((l->t_flag & (T_ALLOC|T_NUM)) == T_ALLOC)
free(l->t_STRING);
l->t_flag &= ~(T_INT|T_NUM);
l->t_flag |= T_ALLOC|(r->t_flag & (T_INT|T_NUM));
if (r->t_flag & T_NUM)
if (r->t_flag & T_INT)
l->t_INT = r->t_INT; else
l->t_FLOAT = r->t_FLOAT;
else {
l->t_STRING = xalloc(strlen(r->t_STRING)+sizeof(char));
strcpy(l->t_STRING, r->t_STRING);
}
if (l == FSp)
fsmapinit(evalstring(l));
return (l);
}
/*
* Post increment -- return the old
* value before the increment of the
* node.
*/
NODE *
xinca(np)
register NODE *np;
{
register NODE *rnp;
register NODE *enp;
enp = evalexpr(np);
rnp = inode((INT)0);
xassign(rnp, enp);
xassign(np, xadd(enp, &xone));
return (rnp);
}
/*
* Post decrement -- return the old value
* but increment the variable.
*/
NODE *
xdeca(np)
register NODE *np;
{
register NODE *rnp;
register NODE *enp;
enp = evalexpr(np);
rnp = inode((INT)0);
xassign(rnp, enp);
xassign(np, xsub(enp, &xone));
return (rnp);
}