|
|
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: 4311 (0x10d7)
Types: TextFile
Notes: UNIX file
Names: »awk6.c«
└─⟦f27320a65⟧ Bits:30001972 Commodore 900 hard disk image with partial source code
└─⟦f4b8d8c84⟧ UNIX Filesystem
└─⟦this⟧ »cmd/awk/awk6.c«
/*
* AWK -- built-in functions.
* The assumption is that awk will
* not call the functions if there
* is an argument mismatch to
* remove some checking from each of
* the common single level routines.
*/
#include "awk.h"
#include <math.h>
#include <mdata.h>
NODE *
f_length(np, na)
NODE *np;
int na;
{
register char *s;
if (na == 0)
s = inline; else
s = evalstring(np);
return (inode((INT)strlen(s)));
}
/*
* Square root function.
*/
NODE *
f_sqrt(np, na)
register NODE *np;
int na;
{
return (fnode((FLOAT)sqrt((double)evalfloat(np))));
}
/*
* Natural logarithm function.
*/
NODE *
f_log(np, na)
register NODE *np;
int na;
{
return (fnode((FLOAT)log((double)evalfloat(np))));
}
/*
* Exponential function.
*/
NODE *
f_exp(np, na)
register NODE *np;
int na;
{
return (fnode((FLOAT)exp((double)evalfloat(np))));
}
/*
* Convert FLOAT to INT
*/
NODE *
f_int(np, na)
register NODE *np;
int na;
{
return (inode((INT)evalfloat(np)));
}
/*
* Substring function...
* substr(string, n, m)
* If `m' is missing, it is infinity.
* Return the string starting at position
* `n' (origin 1) of `string' for `m'
* (or end of string) characters.
*/
NODE *
f_substr(np, na)
NODE *np;
int na;
{
register char *cp;
register char *ocp;
register unsigned m;
register unsigned n;
register char *acp;
m = MAXUINT;
if (na > 2)
m = evalint(fargn(np, 3));
n = evalint(fargn(np, 2));
cp = evalstring(fargn(np, 1));
while (--n != 0)
if (*cp == '\0')
break;
else
cp++;
n = strlen(cp);
if (n > m)
n = m;
acp = ocp = xalloc(n + sizeof(char));
while (n--)
*ocp++ = *cp++;
*ocp = '\0';
return (snode(acp, T_ALLOC));
}
/*
* String index match function...
* index(s1, s2)
* Return the position (origin 1) where `s2'
* is found in string `s1' or 0.
*/
NODE *
f_index(np, na)
register NODE *np;
int na;
{
register char *s1, *s2;
register char *ss1;
register unsigned n;
ss1 = s1 = evalstring(fargn(np, 1));
s2 = evalstring(fargn(np, 2));
n = strlen(s2);
for ( ; *s1 != '\0'; s1++)
if (strncmp(s1, s2, n) == 0)
return (inode((INT)(s1-ss1+1)));
return (&xzero);
}
/*
* Printf onto a string function.
* Handled by special case in the `printf'
* keyword.
*/
NODE *
f_sprintf(np, na)
register NODE *np;
int na;
{
register char *ap;
xprintf(np, NULL, wordbuf);
ap = xalloc(strlen(wordbuf) + sizeof(char));
strcpy(ap, wordbuf);
fsmapinit(FS);
return (snode(ap, T_ALLOC));
}
/*
* Function to split a string into the standard
* fields.
* n = split(string, array, sep)
* If `sep' is missing, FS is used.
* `string' is split into fields into
* `array[1]', `array[2]', ..., `array[n]'
* and the number of fields (`n') is
* returned.
*/
NODE *
f_split(np, na)
NODE *np;
int na;
{
register unsigned char *cp;
register int c;
register char *scp;
register char *acp;
NODE *array;
NODE *index;
STRING string;
index = inode((INT)0);
string = evalstring(fargn(np, 1));
array = fargn(np, 2);
if (array->t_op!=ATERM || (array->t_flag&T_VAR)==0)
awkerr("Split not given an array");
if (na >= 3)
fsmapinit(evalstring(fargn(np, 3)));
for (cp = string; ;) {
while (FSMAP[*cp])
cp++;
if (*cp == '\0')
break;
scp = cp;
while ((c = *cp++)!='\0' && !FSMAP[c])
;
cp--;
acp = string = xalloc(cp-scp + sizeof(char));
while (scp < cp)
*acp++ = *scp++;
*acp = '\0';
index->t_INT++;
xassign(xarray(array, index), snode(string, T_ALLOC));
if (c == '\0')
break;
}
fsmapinit(FS);
return (index);
}
/*
* Absolute value function.
*/
NODE *
f_abs(np, na)
register NODE *np;
register int na;
{
FLOAT f;
if ((f = evalfloat(fargn(np, 1))) < 0)
f = -f;
return (fnode(f));
}
/*
* Return the number
* of args to a function.
*/
fnargs(np)
register NODE *np;
{
register unsigned nargs;
for (nargs = 0; np != NULL; nargs++)
if (np->n_op == ALIST)
np = np->n_O2;
else
np = NULL;
return (nargs);
}
/*
* Return the n-th argument based on the
* list. If it is out of range, return
* a dummied up node.
*/
NODE *
fargn(np, an)
register NODE *np;
register unsigned an;
{
register NODE *rnp;
rnp = NULL;
while (an--!=0 && np!=NULL)
if (np->n_op == ALIST) {
rnp = np->n_O1;
np = np->n_O2;
} else {
rnp = np;
np = NULL;
}
if (rnp == NULL)
rnp = snode(SNULL, 0);
return (rnp);
}