File:  [Research Unix] / researchv10no / cmd / basic / bas / sym.c
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Tue Apr 24 17:21:35 2018 UTC (8 years, 1 month ago) by root
Branches: belllabs, MAIN
CVS tags: researchv10, HEAD
researchv10 Norman

#include <stdio.h>
#include "ctype.h"
#include "typedef.h"
#include "basic.h"
#include "tokens.h"

static char	*types[] = {
	"",	"%",	"",	"$"
	};

int	typelens[] = {
	0,	  INTSIZE,	  FLOATSIZE,	  STRINGSIZE
	};

double	popfloat();


/*
 * clrsym --- clear symbol table
 */

clrsym()
{

   strptr = strspace;
   symlast = symspace;
   clear(chains, sizeof chains);
}


/*
 * getvar --- parse a variable name and return a pointer to its
 *	      symbol table entry.  if dimflag is non-zero this is
 *	      in the context of a DIM statement and allocation is
 *	      exact; otherwise a default sized array is allocated.
 */

Symptr getvar(type, dimflag)
int	*type;
{
	register char	*p;
	register Symptr v;
	register int	len;
	Symptr		*chain;
	char		name[2];
	int		i, size, offset, _nsubs, _subsc[MAXSUBS];
	
	p = inptr;
	offset = 0;
	if (*p == FN) {
		if (dimflag)
			badsyn();
		++p;
		++offset;
		}
	if (!isalpha(*p))
		err("name required");
	name[0] = *p++;
	name[1] = 0;
	while (isalnum(*p)) {
		if (!name[1])
			name[1] = *p;
		++p;
		}
	if (*p == '%') {
		++p;
		*type = INT;
		}
	else if (*p == '$') {
		++p;
		*type = STRING;
		}
	else
		*type = FLOAT;
	
	_nsubs = 0;	/* assume no subscripts for now */
	inptr = p;
	if (*p == LPAR) {
		if (++offset < 2) {	/* not a function */
			++inptr;
			for (;;) {
				_subsc[_nsubs++] = fexpr();
				if (*inptr == RPAR) {
					++inptr;
					break;
					}
				expectc(COMMA);
				if (_nsubs >= MAXSUBS)
					err("more than %d subscripts",
							MAXSUBS);
				}
			}
		}
	else
		if (dimflag)
			err("expected (");
	/*
	 * scan through the appropriate chain looking for the symbol.
	 */
	chain = &chains[offset][*type];
	for (v = *chain; v; v = v->v_next)
		if (v->v_name[0] == name[0] && v->v_name[1] == name[1]) {
			if (dimflag)
				err("attempt to re-dimension");
			goto done;
			}
	/*
	 * symbol was not found ... enter it.
	 */
	v = (Symptr)symlast;
	len = SYMHDRLEN;
	/*
	 * if subscripted variable then calculate the array size
	 * if dimensioned and in a DIM stmt then use the dimensions
	 * provided; otherwise use the default values.
	 */
	switch (offset) {
	case 0:		/* a scalar variable */
		len += typelens[*type];
		break;
	case 1:		/* a vector variable */
		for (i = 0, size = 1; i < _nsubs; ++i) {
			size *= (dimflag? _subsc[i] : DEFSIZE);
			if (size <= 0)
				err("zero or negative array size");
			}
		len += VECHDRSIZE + size * typelens[*type];
		break;
	case 2:		/* a function variable */
		len += sizeof(Func);
		break;
		}
	if (symlast + len >= symend)
		if (!moresym(symlast + len))
			err("symbol table overflow");
	symlast += len;
	/*
	 * clear and copy information into symbol table entry.
	 */
	clear((char *)v, len);
	v->v_name[0] = name[0];
	v->v_name[1] = name[1];
	if (_nsubs) {
		for (i = 0; i < _nsubs; ++i)
			v->v_un.v_vec.v_subsc[i] = (dimflag? _subsc[i] : DEFSIZE);
		v->v_nsubs = _nsubs;
		}
	v->v_next = *chain;
	*chain = v;
done:
	/*
	 * make global copy of subscript information
	 */
	if ((nsubs = _nsubs))
		for (i = 0; i < _nsubs; ++i)
			subsc[i] = _subsc[i];
	return(v);
}


/*
 * dim --- interpret a DIM statement
 */

dim()
{
	int	type;

	do {
		getvar(&type, YES);
		} while (*inptr == COMMA && ++inptr);
}


/*
 * dumpsym --- dump the symbol table
 */

dumpsym()
{
	register int	i;

	for (i = 1; i < MAXTYPES; ++i) {
		dumpchain(0, i);
		dumpchain(1, i);
		dumpchain(2, i);
		}
}


/*
 * dumpchain --- dump one chain of the symbol table
 */

dumpchain(offset, type)
{
	register Symptr s;
	register int	i, n;

	for (s = chains[offset][type]; s; s = s->v_next) {
		fprintf(stderr, "%8X %.2s%s", s, s->v_name, types[type]);
		switch (offset) {
		case 0:		/* this is a chain of scalars */
			switch (type) {
			case INT:
				fprintf(stderr, "\t= %d", s->v_un.v_int);
				break;
			case FLOAT:
				fprintf(stderr, "\t= %g",
					(SINGLE ? s->v_un.v_float
						: s->v_un.v_double));
				break;
			case STRING:
				fprintf(stderr, "\t(%d chars at %X) = ",
					s->v_un.v_str.s_len,
					s->v_un.v_str.s_ptr);
				fprintf(stderr, "\"%.*s\"",
					s->v_un.v_str.s_len,
					s->v_un.v_str.s_ptr);
				break;
				}
			break;
		case 1:
			fputs(" (", stderr);
			for (i = 0, n = s->v_nsubs; i < n; ) {
				fprintf(stderr, "%d",
						s->v_un.v_vec.v_subsc[i]);
				if (++i != n)
					putc(',', stderr);
				}
			putc(')', stderr);
			break;
		case 2:		/* this is a chain of functions */
			fprintf(stderr, "\tfunction defined at line %u",
				s->v_un.v_fn.fn_curline->l_lnr);
			break;
			}
		putc('\n', stderr);
		}
}

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.