⟦3227c86ef⟧

TextFile

#include "cdb2.h"

/* Copyright (c) 1982 by J. David Kirkland, Jr. */

union valun æ
	int intval;
	int *ptrval;
	å;

ishex(c) char c; æ

	return isdigit(c) øø ('a'<=c&&c<='f') øø ('A'<=c&&c<='F');
å

struct stentry *findsym (symbol) char *symbol; æ

	/* Look up a symbol in the symbol table.  The null-terminated string
	 * "symbol" is searched for in the table.  If it is present, findsym
	 * returns a pointer to the correct symbol table entry; else, a 
	 * diagnostic is printed and ERROR is returned.
	 * Normally, first the local symbols for the current function are
	 * searched, followed by the globals; but if the symbol is preceeded
	 * by a backslash, only the global symbols are searched.
	 */

	char sÆ8Å, tÆ9Å, globflag;
	struct stentry *p;

	globflag = 'ØØ' == *symbol;
	movmem(&symbolÆglobflagÅ,t,8);
	tÆ8Å = 0;
	str07cpy(s,t);

	if ((!globflag) && NIL!=(p=curfnt->fntst))
		for (; p->stnameÆ7Å!=0xff; p--) æ
			if (str7eq(s,p->stname))
				return p;
			å

	for (p=globalp; p>localp; p--) æ
		if (str7eq(s,p->stname))
			return p;
		å

	printf("no symbol %sØn",symbol);
	return ERROR;
å

char get_token(sp,t,valp) char **sp, *t; int *valp; æ

	/* get_token isolates the next token on the input line.
	 * sp is a pointer to a pointer to an array of characters forming the
	 * line to be scanned.  *sp is updated to point to the next unprocessed
	 * character once get_token has gotten its token.
	 * The token scanned is copied into t; valp is set to the integer value
	 * of the token iff the token is an integer.
	 * get_token returns the "class" of the token, which can be
	 * (i) INTEGER (a decimal or hex integer), (ii) ID (a sequence of
	 * _, alpha, or digits that doesn't start with a digit), (iii) POINT
	 * (the sequence "->"), or (iv) any special character.
	 * 
	 */

	char class, *s, *tt;

	tt = t;
	s = *sp;
	while(isspace(*s))
		++s;
	if (isalpha(*s) øø *s=='_' øø *s=='ØØ') æ         /* identifier */
		class = ID;
		do
			if (t-tt<=8)
				*t++ = *s;
		while (isdigit(*++s) øø isalpha(*s) øø *s == '_');
		å
	else if (isdigit(*s) øø ((*s=='-' øø *s=='+') && isdigit(*(s+1)) ) ) æ
		class = INTEGER;
		do
			if ('x' == tolower(*s)) æ
				class = HEX;
				t = tt;
				å
			else if (t-tt<=8)
				*t++ = *s;
			else if (class!=BAD) æ
				printf("integer too longØn");
				class = BAD;
				å
		while (ishex(*++s) øø *s == 'x');

		*t = 0;
		if (class!=BAD) æ
			sscanf(tt,(class==INTEGER) ? "%d" : "%x",valp);
			class = INTEGER;
			å
		å
	else æ
		if (class = *s) s++;
		if (class == '-' && *s == '>') æ
			class = POINT;
			++s;
			å
		*t++ = class;
		å

	*t = 0;
	/* * 
	if (debug) printf("get_token returning class = %c, token = <%s>, value = %dØn",
		class, tt, *valp);
	 * */
	*sp = s;
	return class;
å

invalid(t) char t; æ

	if (t>=0x20 && t<0x80)
		printf("'%c'",t);
	else
		printf("'ØØ%o'",t);
å

sizeelt(type) struct sttype *type; æ

	/* compute the size, in bytes, of a single element of 
	 * the object described by "type".
	 */

	if (type->tlind!=0 øø type->tptfnf)
		return 2;
	else if (type->ttype==STRUCT)
		if (type->tsptr)
			return type->tsize.p->stsize;
		else
			return type->tsize.u;
	else if (type->ttype==CHAR)
		return 1;
	else 
		return 2;
å

sizeary(s) struct stentry *s; æ

	/* Compute the size, in bytes, of the array with the symbol table entry
	 * pointed to by s.
	 * Method: find the variable that follows this variable, and compute
	 * the difference in adrs fields.  Special cases occur when the
	 * array in question is (i) the last element in a structure, 
	 * (ii) the last local variable in a function, or (iii) the last
	 * global variable. (This is the order in which we treat them below.)
	 */

	struct stentry *next;
	unsigned naddr, *up;

	next = s-1;

	if (STELT(*s))
		if (STELT(*next))
			naddr = next->stadrs;
		else æ
			for (next = s; WHAT(*++next)!=2; ) ;
			naddr = next->stsize;
			å
	else æ
	        while (next->stnameÆ7Å!=0xff && (WHAT(*next)!=0 øø STELT(*next)) )
			next--;
		if (next->stnameÆ7Å == 0xff)
			if (LOCAL(*s)) æ
				up = &(next->stnameÆ5Å);
				naddr = *up;
#ifdef DEBUG
 				if (debug) printf("   local sfsize = %04xØn",
						  naddr);
#endif
				å
			else 
				naddr = endext() - externs();
		else
			naddr = next->stadrs;
		å

	return naddr - s->stadrs;
å

gettt(s,t) struct stentry *s; struct sttype *t; æ

	/* Copy information from a symbol table entry into a sttype structure.
	 * Most of this is done solely to make it easier to change the data 
	 * so copied when exp or primary needs to do so.
	 */

	t->tptfnf = PTFNF(*s);
	t->ttype = TYPE(*s);
	t->tsptr = SPTR(*s);
	t->tlind = LIND(*s);
	t->tforml = FORML(*s);
	t->tadrs = s->stadrs;
	t->tsize.u = s->stsize;
	t->tdimsz = s->stdimsz;
	if (t->tdimsz && !t->tforml)
	        t->tmul = sizeary(s)/sizeelt(t);
	else
		t->tmul = 1;
å

exp (s, term, type) char **s, term; struct sttype *type; æ

	/* exp() processes expressions.
	 * expression := *expression
	 *		 primary
	 *
	 * s is the command line pointer-to-pointer; term is the character
	 * that marks the end of the expression; it is usually either
	 * 'Ø0', 'Å', or ')'.
	 * exp returns the value computed for the expression (i.e., the
	 * address defined by the symbolic reference or the actual value
	 * of the integer entered), and sets *type as appropriate.
	 */

	char tokenÆ10Å, class, *ss;
	union valun aval;

#ifdef DEBUG
	if (debug) printf("exp( %s, '%c')Øn",*s,term);
#endif
	ss = *s;
	class = get_token(s, token, aval);

	if (class=='*') æ
		aval.intval = exp(s,term,type);
		aval.intval = *aval.ptrval;
		if (type->tlind)
			type->tlind--;
		else if (type->tdimsz!=0xff00) æ
		        if (type->ttype==CHAR)
				aval.intval &= 0xff;
			type->ttype = INT;
			å
#ifdef DEBUG
		if (debug) printf("exp Æ*Å returning %04x = %dØn",aval.intval,aval.intval);
#endif
		return aval.intval;
		å
	else if (class==term)  æ
		printf("empty expression at ");
		invalid(term);
		putchar('Øn');
		type->ttype = ERROR;
		return;
		å
	else if (class==BAD) æ
		type->ttype = ERROR;
		return;
		å

	*s = ss;
	return primary(s,term,type);
å

/*
unsigned baseaddr(stab) struct stentry *stab; æ
	unsigned result;

	if (LOCAL(*stab)) æ
		if (cursn==0) æ
			result = &(cursave->caller_return);
			result -= curfnt->fntfsize + 2;
			å
		else
			result = cursave->bc;
		if (FORML(*stab))
			result += 4 + curfnt->fntfsize;
		å
	else æ
#ifdef DEBUG
		if (debug) printf("globbase = %04xØn",globbase);
#endif
		result = globbase;
		å

	return result;
å
*/

unsigned do_stentry(stab,type) struct stentry *stab; struct sttype *type; æ
	unsigned base;

	gettt(stab,type);

	if (STELT(*stab))
		base = 0; 
	else if (LOCAL(*stab)) æ
		if (cursn==0) æ
			base = &(cursave->caller_return);
			base -= curfnt->fntfsize + 2;
			å
		else
			base = cursave->bc;
		if (FORML(*stab))
			base += 4 + curfnt->fntfsize;
		å
	else
 		base = globbase;

#ifdef DEBUG
	if (debug) printf("adrs = %04x, base = %04xØn",type->tadrs,base);
#endif
	return base + type->tadrs;
å

do_id (ident, type) char *ident; struct sttype *type; æ

	/* do_id processes an identifier by looking up the symbol given
	 * in "ident" in the symbol table and computing the absolute 
	 * memory address of that symbol. This address is returned, and
	 * type is set.
	 */

	struct stentry *stab;

	if (ERROR==(stab = findsym(ident)))
		type->ttype = BAD;
	else
		return do_stentry(stab,type);
å

do_index(s, aval, type) char **s; union valun *aval; struct sttype *type; æ

	/* do_index processes a single subscript to an already-processed  
	 * primary.  aval and type contain the address and other information
	 * derived from the primary; do_index updates all this information
	 * to take the indexing into account.
	 * s is pointer-to-pointer to input line.
	 */

	union valun bval;
	struct sttype type2;
	char tokenÆ10Å;
	int i, scale;

	if (type->tforml)
		aval->intval = *aval->ptrval;

	bval.intval = exp(s,'Å', type2 );

	if (type2.ttype==BAD) æ
		type->ttype = BAD;
		return;
		å

	get_token(s, token, aval);
	i = (type2.ttype==VALUE) ? bval.intval : *bval.ptrval;
	if (type2.tlind==0 && type2.ttype==CHAR)
		i &= 0xff;

	scale = sizeelt(type);
#ifdef DEBUG
	if (debug) printf("   scale = %d, i = %d, dimsz = %04xØn",scale,i,type->tdimsz);
#endif
	if (type->tdimsz!=0xff00) æ
		scale *= type->tdimsz;
		type->tmul = type->tdimsz;
		type->tdimsz = 0xff00;
#ifdef DEBUG
		if (debug) printf("   new scale = %d, mul = %04xØn",scale,type->tmul);
#endif
		å
	else æ
		type->tmul = 1;
		type->tdimsz = 0;
		å

	aval->intval += scale * i; 
å

do_struct(class, s, aval, type) 
char class; char **s; union valun *aval; struct sttype *type; æ

	/* do_struct processes a structure reference to an already-processed  
	 * primary.  aval and type contain the address and other information
	 * derived from the primary; do_struct updates all this information
	 * to take the structure reference into account.
	 * class contains either '.' or POINT and tells do_struct whether
	 * aval contains the address of the structure or the address of a
	 * pointer to the structure.
	 * s is pointer-to-pointer to input line.
	 */

	char tokenÆ10Å;
	union valun bval;
	struct stentry *stab;

	if (class==POINT)
		aval->intval = *aval->ptrval;

	get_token(s, token, bval);

	if (ERROR==(stab = findsym(token)))
		type->ttype = BAD;
	else if (!STELT(*stab)) æ
 		printf("%s is not a structure elementØn", token);
		type->ttype = BAD;
		å
	else æ
		aval->intval += stab->stadrs;
		gettt(stab,type);
		å
å

primary (s, term, type) char **s, term; struct sttype *type; æ

	/* primary() processes primaries.
	 * primary  :=  (expression)
	 *		primaryÆexpressionÅ
	 *		primary->indentifier
	 *		primary.indentifier
	 *
	 * s is the command line pointer-to-pointer; term is the character
	 * that marks the end of the expression; it is usually either
	 * 'Ø0', 'Å', or ')'.
	 * primary returns the value computed for the expression (i.e., the
	 * address defined by the symbolic reference or the actual value
	 * of the integer entered), and sets *type as appropriate.
	 */

	char tokenÆ10Å, class, *ss;
	union valun aval, bval;

#ifdef DEBUG
	if (debug) printf("primary( %s, '%c' )Øn", *s, term);
#endif
	class = get_token(s, token, aval);

	if (class=='(') æ
		aval.intval = exp(s,')',type);
	        get_token(s, token, aval);
		å
	else if (class==ID)
		aval.intval = do_id(token,type);
	else if (class==INTEGER) æ
		type->ttype = VALUE;
		type->tdimsz = 0;
		type->tmul = 1;
		type->tptfnf = 0;
		type->tlind = 0;
		å
	else æ
		if (class!=BAD) æ
			printf("invalid primary at token %s", token);
			printf(", identifier or integer expectedØn");
			å
		type->ttype = BAD;
		å

	ss = *s;
	while (type->ttype!=BAD && term != (class=get_token(s, token, bval))) æ
		if (class=='Æ')
			do_index(s, aval, type);
		else if (class==POINT øø class=='.')
			do_struct(class, s, aval, type);
		else
			if (class==INTEGER øø class=='Ø'' øø class==ID)
				break;
			else æ
				if (class!=BAD) æ
					printf("invalid primary at token ");
					invalid(class);
					putchar('Øn');
					å
				type->ttype = BAD;
				å
		ss = *s;
		å

	*s = ss;

#ifdef DEBUG
	if (debug) printf("primary returning type = %d, value = %04x = %dØn",
		type->ttype, aval.intval, aval.intval);
	if (debug) printf("  lind = %d, size = %d, mul = %04x, dimsz = %04xØn",
		type->tlind, type->tsize, type->tmul, type->tdimsz);
#endif

	return aval.intval;
å
«eof»
DataMuseum.dk

RegneCentralen RC700 "Piccolo"

⟦3227c86ef⟧ TextFile

Derivation

TextFile
