DataMuseum.dk

Presents historical artifacts from the history of:

Commodore CBM-900

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Commodore CBM-900

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦0c6013829⟧ TextFile

    Length: 4311 (0x10d7)
    Types: TextFile
    Notes: UNIX file
    Names: »awk6.c«

Derivation

└─⟦f27320a65⟧ Bits:30001972 Commodore 900 hard disk image with partial source code
    └─⟦f4b8d8c84⟧ UNIX V7 Filesystem
        └─ ⟦this⟧ »cmd/awk/awk6.c« 

TextFile

/*
 * 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);
}