Return to expr.c CVS log

Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / bin / cdb

Power 6/32 Unix version 1.2b

static char sccsid[] = "@(#)expr.c	2.12";

#include "cdb.h"
#include "macdefs.h"

extern long atol();
extern double atof();
extern int vrgOffset[];	/* defined in access.c */

/* the following define the stack mechanism used by the expression parser */

export int    viopMac;        /* operator stack pointer */
export int    vivarMac;       /* variable stack pointer */

#define istkMax 15
TYR     vrgTy[cTyMax*istkMax];  /* variable stack */
ADRT	vrgAdr[cTyMax*istkMax];	/* addresses of the variables in vrgTy */
TKE     vrgTk[istkMax];         /* operator stack */

#define TOPOP (vrgTk[viopMac-1])
#define TOPVAR (vrgTy[vivarMac-1])
#define EmptyStack (vivarMac==0)
#define precParen 99

/* parser state */
#define psFail  0               /* parser tripped */
#define psOp    1               /* expression parser last saw an OPERATOR */
#define psVar   2               /* expression parser last saw an VARIABLE */
typedef int  PSE, *pPSE;     /* parser state */

ADRT	vadrSb, vadrSbMax;	/* where we can stick strings in child */

/* P U S H    O P */

local void PushOp(tk)
TKE     tk;
{
	if (viopMac >= istkMax)
		UError("Expression stack overflow");
	vrgTk[viopMac++] = tk;
} /* PushOp */


/* P O P    O P */

local TKE PopOp()
{
	if (viopMac <= 0)
		UError("Operator stack underflow");
	return(vrgTk[--viopMac]);
} /* PopOp */


/* P U S H    V A R */

local void PushVar(adrLong, ty)
long    adrLong;
pTYR    ty;
{
	if (vivarMac >= istkMax)
		UError("Expression stack overflow");
	CopyTy(vrgTy+vivarMac, ty);
	vrgAdr[vivarMac] = adrLong;
	vivarMac += 2;
} /* PushVar */


/* F   P O P   V A R */

local FLAGT FPopVar(pret, ty)
long    *pret;
pTYR    ty;
{
	if (vivarMac <= 0)
		return(false);
	vivarMac -= 2;	/* point to first one */
	CopyTy(ty, vrgTy+vivarMac);
	*pret = vrgAdr[vivarMac];
	return(true);
} /* FPopVar */


/* A D R   F   S T O R E */

export ADRT AdrFStore(sb, cb)
char	*sb;
int	cb;
{
	ADRT	adr;
	TYR		ty[cTyMax];

	/* this routine stores data in the CHILD's address space.
		     * this is mostly useful for passing strings as arguements to
		     * procedure calls from the command line.
		     */
	if (FOdd(cb))
		cb++;	/* force to word boundary */
	/* will it fit? */
	if ((vadrSb == 0) OR (vadrSb+cb >= vadrSbMax)) {
		/* no, we will go back and use the buffer over again */
		vadrSb = AdrFGlobal("__buffer", ty);
		vadrSbMax = AdrFGlobal("_bufMax", ty);
		if (vadrSb+cb >= vadrSbMax)
			UError("I can't put something that big in the child. See 'end.c'");
	}
	adr = vadrSb;
	vadrSb += cb;	/* advance to next free byte */
	PutBlock(adr, spaceData, sb, cb);
	return(adr);
} /* AdrFStore */


/* P R E C   F   T K */

export int PrecFTk(tk)
TKE     tk;
{
	/* determine precedence */
	/* these values are meaningful only in their relationship to one another */
	switch (tk) {
	default:        
		return(0);
	case tkBOE:
	case tkLP:      
		return(precParen);
	case tkInside:
	case tkSizeof:
	case tkLSB:
	case tkPtr:
	case tkDot:     
		return(96);
	case tkRef:
	case tkUMinus:
	case tkBang:
	case tkTilda:
	case tkDeref:   
		return(95);     /* unary operator */
	case tkDiv:
	case tkMul:     
		return(80);
	case tkPlus:
	case tkMinus:   
		return(70);
	case tkLShift:
	case tkRShift:  
		return(60);
	case tkLT:
	case tkLE:
	case tkGT:
	case tkGE:      
		return(50);
	case tkEqual:
	case tkNotEqual: 
		return(40);
	case tkBitAnd:  
		return(32);
	case tkXOR:     
		return(31);
	case tkBitOr:   
		return(30);
	case tkLAND:    
		return(21);
	case tkLOR:     
		return(20);
	case tkAssPlus:
	case tkAssMinus:
	case tkAssMult:
	case tkAssDiv:
	case tkAssXOR:
	case tkAssBAND:
	case tkAssBOR:
	case tkAssLeft:
	case tkAssRight:
	case tkAssMod:
	case tkAssign:  
		return(3);
	case tkComma:
	case tkEOE:
	case tkRP:
	case tkIndex:
	case tkRSB:     
		return(1);
	} /* switch */
} /* PrecFTk */


/* V A L   F   A D R */

export long ValFAdr(adrLong, ty)
long    adrLong;
pTYR    ty;
{
	int		cb, bt;
	ADRT        adrSrc, adrDest;
	STUFFU      stuff;

	if (ty->td.fConstant)
		return(adrLong); /* it was a constant - ergo, it has no address */

	stuff.lng = 0;
	adrSrc = adrLong;
	cb = CbFTy(ty);
	if (cb > 4)
		cb = 4;	/* this routine is not designed for more than a long */

	if (ty->td.st == stReg) {
#ifndef REGULUS
		if (cb == CBCHAR) {
			stuff.chars.chLoLo = GetReg(adrSrc);
		} 
		else if (cb == CBSHORT) {
			stuff.shorts.shortLo = GetReg(adrSrc);
		} 
		else {
#if (CBINT == CBSHORT)
			stuff.shorts.shortHi = GetReg(adrSrc);
			stuff.shorts.shortLo = GetReg(adrSrc+1);
#else
			stuff.lng = GetReg(adrSrc);
#endif
		} /* if */
#else
		if (trace(ptReadUser, vpid, cb,
		&stuff, v_ar0+vrgOffset[adrSrc]) < 0)
			UError("Bad Access");
#endif
		goto extendSign;
	} /* if */

	/* figure address we want this read into */
	adrDest = (cb == 1) ? (ADRT) &(stuff.chars.chLoLo) :
	(cb == 2) ? (ADRT) &(stuff.shorts.shortLo) :
	(ADRT) &(stuff.lng);

	if (ty->td.st == stSpc) {
		/* a `special' variable (lives in debuggers universe) */
		MoveBytes(adrDest, adrSrc, cb);
		goto extendSign;
	} /* if */

	/* unfortunately, there are some special addresses which look like adrNil! */
	if (adrSrc == adrNil)
		return(0);

	if (cb > 0) {
		GetBlock(adrSrc, spaceData, adrDest, cb);
		return(stuff.lng);
	} 
	else {
		/* it must be a bit field spec */
		/* This is dependent on the order the compiler allocates bits */
#ifdef BSD41
		cb = (ty->valTy + ty->td.width + (SZCHAR-1)) / SZCHAR;
		GetBlock(adrSrc, spaceData, &stuff.lng, cb);
		stuff.lng = Extract(stuff.lng, ty->valTy, ty->td.width);
		return(stuff.lng);
#else
		Panic("Don't know how to handle bit fields for this machine");
#endif
	} /* if */

extendSign:
	/* following forces sign extension */
	bt = ty->td.bt;
	if (TqFTy(ty, 1) == tqNil) { /* then it is a base type, not a pointer */
		if (bt == btChar)
			stuff.lng = stuff.chars.chLoLo;
		else if (bt == btShort)
			stuff.lng = stuff.shorts.shortLo;
#if (CBINT == CBSHORT)
		else if (bt == btInt)
			stuff.lng = stuff.shorts.shortLo;
#endif
	}
	return(stuff.lng);
} /* ValFAdr */


/* P U T   V A L */

export void PutVal(adrLong, ty, val)
long    adrLong;
pTYR    ty;
long    val;
{
	int		cb;
	ADRT        adrDest, adrSrc;
	STUFFU      stuff;

	if (ty->td.fConstant)
		return; /* it was a constant - ergo, it lives no where */

	stuff.lng = val;
	adrDest = adrLong;
	cb = CbFTy(ty);
	if (cb > 4)
		cb = 4;	/* this routine is not designed for more than a long */

	/* figure address we want this read from */
	adrSrc = (cb == 1) ? (ADRT) &(stuff.chars.chLoLo) :
	(cb == 2) ? (ADRT) &(stuff.shorts.shortLo) :
	(ADRT) &(stuff.lng);

	if (ty->td.st == stReg) {
#ifndef REGULUS
		if (cb == CBCHAR) {
			PutReg(adrDest, stuff.chars.chLoLo);
		} 
		else if (cb == CBSHORT) {
			PutReg(adrDest, stuff.shorts.shortLo);
		} 
		else {
#if (CBIBT == CBSHORT)
			PutReg(adrDest, stuff.shorts.shortHi);
			PutReg(adrDest+1, stuff.shorts.shortLo);
#else
			PutReg(adrDest, stuff.lng);
#endif
		} /* if */
#else
		if (trace(ptWriteUser, vpid, cb,
		&stuff, v_ar0+vrgOffset[adrDest]) < 0)
			UError("Bad Access");
#endif
		return;
	} /* if */

	if (ty->td.st == stSpc) {
		/* a `local' variable */
		MoveBytes(adrDest, adrSrc, cb);
		return;
	} /* if */

	if (cb > 0) {
		PutBlock(adrDest, spaceData, adrSrc, cb);
	} 
	else {
		/* it must be a bit field */
#ifdef BSD41
		cb = (ty->valTy + ty->td.width + (SZCHAR-1)) / SZCHAR;
		GetBlock(adrDest, spaceData, &stuff.lng, cb);
		SetBits(stuff.lng, ty->td.width, ty->valTy, val);
		PutBlock(adrDest, spaceData, &stuff.lng, cb);
#else
		Panic("Don't know how to handle bit fields for this machine");
#endif
	} /* if */
} /* PutVal */


/* P S   F   D O   O P */

local PSE PsFDoOp()
{
	/* this is the rotuine that actually does the TOP operator */
	int		cb1, cb2, tq, ipd;
	ushort      *rgDim;
	ADRT	adr, adrShort;
	FLAGT       fDidIt, fDoIntOp;
	TKE         tk;
	TYR         aty1[cTyMax], aty2[cTyMax], atyMax[cTyMax];
	pTYR        ty, ty1, ty2, tyMax;
	long        adr1, adr2, val1, val2;
	STUFFU	stuff;
#define cbAssMax        200
	char        buf[cbAssMax];

	ty1 = aty1;
	ty2 = aty2;
	tyMax = atyMax;

	if (viopMac < 0)
		return(psFail);

	if (TOPOP == tkLP
	    OR TOPOP == tkBOE)
		return(psFail); /* they should be waiting for one of these */
	tk = PopOp();

	if (!FPopVar(&adr2, ty2)) /* every op needs at least one */
		return(psFail);
	val2 = ValFAdr(adr2, ty2);

	fDidIt = true;
	switch (tk) {
		/* unary operators */
	default:        
		fDidIt = false; 
		break;
	case tkUMinus:  
		ty2->td.fConstant = true;
		ty2->td.st = stValue;
		PushVar(-val2, ty2);
		break;
	case tkBang:    
		PushVar(lengthen(val2==0), vtyCnInt);
		break;
	case tkTilda:   
		ty2->td.fConstant = true;
		ty2->td.st = stValue;
		PushVar(~val2, ty2);
		break;
	case tkRef:     
		if (ty2->td.fConstant)
			UError("You can't take the address of a constant");
		if (ty2->td.st == stReg)
			UError("You can't take the address of a register");
		if (!FAdjTd(ty2, tqPtr)) /* add a pointer level */
			UError("Type information overflow");
		ty2->td.fConstant = true;
		ty2->td.st = stValue;
		PushVar(adr2, ty2);
		break;
	case tkDeref:   
		tq = TqFTy(ty2, 1);
		if ((tq == tqPtr) OR (tq == tqArray))
			FAdjTd(ty2, tqNil);  /* remove tq */
		ty2->td.st = stValue;
		if (ty2->td.fConstant) {
			ty2->td.fConstant = false;
			PushVar(adr2, ty2);
		} 
		else if (tq == tqArray) {
			PushVar(adr2, ty2);	/* array is pointer to itself */
		} 
		else {
			PushVar(val2, ty2);
		} /* if */
		break;
	case tkInside:	
		adrShort = adr2;
		ipd = IpdFAdr(adrShort);
		val2 = (vpc >= vrgPd[ipd].adrStart)
			AND (vpc < vrgPd[ipd+1].adrStart);
		PushVar(val2, vtyCnInt);
		break;
	case tkSizeof:	
		val2 = CbFTy(ty2);
		PushVar(val2, vtyCnInt);
		break;
	} /* switch */
	if (fDidIt)    /* we must have done one of them - go back */
		return(psVar);

	/* not unary, so we pop another and try the binaries */
	if (!FPopVar(&adr1, ty1))
		return(psFail);
	val1 = ValFAdr(adr1, ty1);

	fDidIt = true;
	switch (tk) {
	default:        
		fDidIt = false; 
		break;
	case tkDot:     
		val1 = adr1;    /* direct address, then do ptr */
	case tkPtr:     
		val1 = AdrFField(val1, ty1, ty2);
		/* ty1 is struct, ty2 is field */
		PushVar(val1, ty2);
		break;
	case tkIndex:	/* foo[x] */
		tq = TqFTy(ty1, 1);
		if (tq == tqArray)
			val1 = adr1;   /* array value IS the address */
		FAdjTd(ty1, tqNil);/* remove ptr or array level */
		adr1 = val1 + (val2 * CbFTy(ty1));
		PushVar(adr1, ty1);
		break;

	} /* switch */
	if (fDidIt)
		return(psVar);

	/* MaxFTyTy may try to do too much.  It first determines if the types
		     * are such that integer operators may be applied to them (and returns
		     * a true/false on this)  If so, it copies into tyMax the ty of the
		     * larger of the two operands.
		     */
	fDoIntOp = MaxFTyTy(tyMax, ty1, ty2);
	if ( (!fDoIntOp) 
	    AND (tk != tkPtr)
	    AND (tk != tkDot)
	    AND (tk != tkAssign) ) {
		/* they are trying something stupid, like adding structures together */
		UError("Cannot allow that combination of operand(s) and operator");
	} /* if */

	tyMax->td.fConstant = true; /* any op that DOESN'T want this turns it off */
	tyMax->td.st = stValue;
	/* binary operators */
	fDidIt = true;
	switch (tk) {
	default:        
		fDidIt = false;         
		break;
	case tkDiv:     
		val1 = val1 / val2;     
		break;
	case tkMul:     
		val1 = val1 * val2;     
		break;
	case tkPlus:    
		val1 = val1 + val2;     
		break;
	case tkMinus:   
		val1 = val1 - val2;     
		break;
	case tkBitAnd:  
		val1 = val1 & val2;     
		break;
	case tkXOR:     
		val1 = val1 ^ val2;     
		break;
	case tkBitOr:   
		val1 = val1 | val2;     
		break;
	} /* switch */
	if (fDidIt) {
		PushVar(val1, tyMax);
		return(psVar);
	} /* if */

	fDidIt = true;
	ty = vtyCnInt;
	switch (tk) {
	default:        
		fDidIt = false;         
		break;
	case tkLT:      
		val1 = val1 < val2;     
		break;
	case tkLE:      
		val1 = val1 <= val2;    
		break;
	case tkGT:      
		val1 = val1 > val2;     
		break;
	case tkGE:      
		val1 = val1 >= val2;    
		break;
	case tkEqual:   
		val1 = val1 == val2;    
		break;
	case tkNotEqual: 
		val1 = val1 != val2;   
		break;
	case tkLAND:    
		val1 = val1 && val2;    
		break;
	case tkLOR:     
		val1 = val1 || val2;    
		break;
	case tkLShift:  
		if (ty1->td.bt == btShort) {
			/* we do this to crop it to 16 bits */
			stuff.lng = val1;
			val1 = stuff.shorts.shortLo << val2;
		} 
		else {
			val1 = val1 << val2;
			ty = vtyCnLong;
		} /* if */
		break;
	case tkRShift:  
		if (ty1->td.bt == btShort) {
			/* we do this to crop it to 16 bits */
			stuff.lng = val1;
			val1 = stuff.shorts.shortLo >> val2;
		} 
		else {
			val1 = val1 >> val2;
			ty = vtyCnLong;
		} /* if */
		break;
	} /* switch */
	if (fDidIt) {
		PushVar(val1, ty);
		return(psVar);
	} /* if */

	if (tk != tkAssign)
		UError("Unknown operator");

	cb1 = CbFTy(ty1);
	if (cb1 <= CBLONG) {
		PutVal(adr1, ty1, val2);
	} 
	else {
		cb2 = CbFTy(ty2);
		if (cb1 >= cbAssMax)
			Panic("Too many bytes (> %d) moved in assignment", cbAssMax);
		/* we transfer cb1 bytes, just to be safe */
		adrShort = adr2;
		GetBlock(adrShort, spaceData, (ADRT)buf, cb1);
		adrShort = adr1;
		PutBlock(adrShort, spaceData, (ADRT)buf, cb1);
		if (cb1 != cb2) {
			printf("WARNING: X=Y: X is %d bytes and Y is %d bytes\n",
			cb1, cb2);
			printf("  Moving %d bytes\n", cb1);
		} /* if */
	} /* if */
	PushVar(adr1, ty1); /* leave dest on stack, too */
	return(psVar);
} /* PsFDoOp */


/* P S   F   O P E R A T O R */

local PSE PsFOperator(tk, ps)
TKE     tk;
PSE     ps;
{
	/* this routine implements the precedence rules */
	int		prec;
	TKE         tkStop, tkNew;
	long	adr;
	TYR		rgTy[cTyMax];

	prec = PrecFTk(tk);
	if (prec == 0)
		Panic("Bad token in PsFOperator - [%d]", tk);

	if (ps == psOp) {
		/* this had better be a unary operator */
		switch (tk) {
		case tkSizeof:
		case tkInside:
		case tkBang:
		case tkTilda:
		case tkBOE:
		case tkLP:          
			PushOp(tk);             
			break;
			/* these next ones map to something else */
		case tkAmper:       
			PushOp(tkRef);          
			break;
		case tkStar:        
			PushOp(tkDeref);        
			break;
		case tkMinus:       
			PushOp(tkUMinus);       
			break;
		case tkPlus:        /* ignore it */
			break;
		default:    
			UError("Two operators in a row??");
		} /* switch */
		return(psOp);
	} /* if */

	tkStop = tkNil;
	switch (tk) {   /* set our stop token for [], (), and (x,y,z) */
	case tkEOE:     
		tkStop = tkBOE;         
		break;
	case tkRSB:     
		tkStop = tkLSB;       
		break;
	case tkComma:
	case tkRP:      
		tkStop = tkLP;          
		break;
	} /* switch */

	/* first process all higher precedence operators */
	while (prec <= PrecFTk(TOPOP)) {
		if (TOPOP == tkStop) {
			PopOp();    /* eat top op */
			return(psVar);      /* by definition, "(x+y)" is a var */
		} 
		else if (PrecFTk(TOPOP) == precParen) {
			break;  /* we pretend it is higher precedence than the paren */
		} /* if */
		if (PsFDoOp() == psFail) {
			switch (tk) {
			case tkRSB:
				UError("Missing '['");
			case tkRP:
				UError("Missing '('");
			case tkComma:
				UError("Bad procedure call");
			default:
				UError("Badly formed expression");
			} /* switch */
		} /* if */
	} /* while */

	tkNew = tkNil;
	switch (tk) {
	case tkAssPlus:		
		tkNew = tkPlus;		
		break;
	case tkAssMinus:	
		tkNew = tkMinus;	
		break;
	case tkAssMult:		
		tkNew = tkMul;		
		break;
	case tkAssDiv:		
		tkNew = tkDiv;		
		break;
	case tkAssXOR:		
		tkNew = tkXOR;		
		break;
	case tkAssBAND:		
		tkNew = tkBitAnd;	
		break;
	case tkAssBOR:		
		tkNew = tkBitOr;	
		break;
	case tkAssLeft:		
		tkNew = tkLShift;	
		break;
	case tkAssRight:	
		tkNew = tkRShift;	
		break;
	case tkAssMod:		
		tkNew = tkModulo;	
		break;
	} /* switch */
	if (tkNew != tkNil) {
		/* this is an 'assign with function' op e.g. *= or += */
		/* replicate the top of the variable stack */
		if (!FPopVar(&adr, rgTy))
			UError("Bad Syntax");
		PushVar(adr, rgTy);
		PushVar(adr, rgTy);
		PushOp(tkAssign);
		tk = tkNew;
	} /* if */

	PushOp(tk);
	if (tk == tkLSB)
		PushOp(tkIndex);	/* we push the tkLSB and then the tkIndex */
	return(psOp);
} /* PsFOperator */


/* T K   F   O P E R A N D */

export TKE TkFOperand()
{
	int		iln, ifd, ipd, cnt;
	short	valShort;
	char        sbFloat[30];
	long        val;
	TKE         tk;
	ADRT        adr, fp, ap;
	TYR         ty[cTyMax];
	STUFFU      stuff;

	/* look at the current token and figure out what the hell it is */
	/* successful cases fall out bottom and return tkAdr */
	switch (vtk) {
	default:
		return(tkNil);  /* nothing of interest */
	case tkDot:
		PushVar(vdot, vtyDot);
		break;
	case tkColon:	/* they want us to search ONLY global space */
		tk = TkNext();
		if (tk != tkStr)
			UError("Misformed global name");
		if ((adr = AdrFGlobal(vsbTok, ty)) == adrNil)
			UError("Unknown global - %s", vsbTok);
		PushVar(lengthen(adr), ty);
		break;
	case tkCharConstant:
		CopyTy(ty, vtyCnChar);
		val = vsbTok[0];
		PushVar(val, ty);
		break;
	case tkStrConstant:
		adr = AdrFStore(vsbTok, vcbTok+1);
		CopyTy(ty, vtyCnChar);	/* it is a constant */
		FAdjTd(ty, tqPtr);	/* this makes it a 'char *' */
		PushVar(lengthen(adr), ty);
		break;
	case tkNumber:
		if (vsbTok[0] == '0') {
			if (vsbTok[1] == 'x')
				sscanf((vsbTok+2), "%X", &val);
			else sscanf(vsbTok, "%O", &val);
		} 
		else {
			tk = TkPeek();
			if (tk == tkDot) {
				/* looks like a float constant */
				strcpy(sbFloat, vsbTok);
				TkNext();       /* eat the dot */
				strcat(sbFloat, ".");
				/* we allow them to say "10." instead of "10.0" */
				if (tkNumber == TkPeek()) {
					TkNext();   /* actually get the number */
					strcat(sbFloat, vsbTok); /* get fractional part */
				} /* if */
				stuff.fl = atof(sbFloat);
				PushVar(stuff.lng, vtyCnFloat); /* sorta kludgey */
				return(tkNumber);
			} 
			else {
				val = atol(vsbTok);
			} /* if */
		} /* if */

		TkPeek();
		/* did they specify long? */
		if ((vcbPeek == 1)
		    AND (vsbTokPeek[0] == 'L' OR vsbTokPeek[0] == 'l')) {
			TkNext();	/* actually eat the L or l */
			PushVar(val, vtyCnLong);
		} 
		else {
			valShort = val & 0x0000ffff;
			PushVar(val, (val==valShort) ? vtyCnInt : vtyCnLong);
		}
		return(tkNumber);
		/* NOTREACHED */
		break;
	case tkStr:
		if ((TOPOP == tkDot) OR (TOPOP == tkPtr)) {
			/* we don't do anything until we PROCESS the field.
								     * so we jam the name in a record.
								     */
			ty[0] = *vtyZeros;
			ty[1] = *vtyZeros;
#ifdef BSD41
			ty[0].sbVar = SbSafe(vsbTok);
#else
			strncpy(ty[0].sbVar, vsbTok, cbVarMax);
#endif
			ty[0].td.fConstant = true;
			ty[0].td.st = stStruct;
			PushVar(0L, ty);
			return(psVar);
		} /* if */

		/* is it a register or Special variable? */
		if (vsbTok[0] == '$') {
			if (FAdrFSpecial(vsbTok, ty, &adr)) {
				PushVar(lengthen(adr), ty);
				break;
			} /* if */
			UError("Unknown special variable `%s'", vsbTok);
		} /* if */

		/* is it a local? */
		if ((vipd != ipdNil)
		    AND ((adr=AdrFLocal(vipd, -1, vsbTok, ty)) != adrNil)) {
			PushVar(lengthen(adr), ty);
			break;
		} /* if */

		/* is it a global? */
		if ((adr = AdrFGlobal(vsbTok, ty)) != adrNil) {
			PushVar(lengthen(adr), ty);
			break;
		} /* if */

		/* is it a procedure name? */
		if ((ipd = IpdFName(vsbTok)) != ipdNil) {
			/* it is a procedure name! is there anymore to the name? */
			tk = TkPeek();
			if (tk == tkDot) {
				/* so far we know `procname.' */
				TkNext();	/* eat dot */
				/* we want full name of a local */
				FpApFIpd(&fp, &ap, ipd, -1);
				if (fp == 0)
					UError("procedure %s not active",vrgPd[ipd].sbProc);
				tk = TkNext();
				cnt = -1;       /* default - take first instance */
				if (tk == tkNumber) {
					/* we have `proc.3' (or something like that).
										                             * they want a SPECIFIC instance of this proc
										                             * at backtrace location #.
										                             * This is useful for recursive procedures...
										                             */
					cnt = atoi(vsbTok);
					if (TkNext() != tkDot)
						UError("Need a `.' after the number");
					;
					tk = TkNext();
				} /* if */
				if (tk != tkStr) {
					/* procname.???? */
					UError("Syntax error - bad local name '%s'",vsbTok);
				} /* if */
				if ((adr = AdrFLocal(ipd,cnt,vsbTok,ty))
				    != adrNil) {
					PushVar(lengthen(adr), ty);
					return(tkAdr);
				} 
				else {
					UError("No such local - %s.%s",
					vrgPd[ipd].sbProc, vsbTok);
				} /* if */
			} 
			else if (tk == tkLP) {
				/* we have `procname(' - must be a procedure call */
				TkNext();	/* eat ( */
				val = DoProc(ipd, ty, adrNil);
				PushVar(val, ty);
				break;
			} 
			else if (tk == tkHash) {
				TkNext();	/* eat the # */
				tk = TkNext();
				if (tk != tkNumber)
					UError("'#' should be followed by a decimal line number.");
				iln = atoi(vsbTok);
				ifd = IfdFIpd(ipd);
				adr = AdrFIfdLn(ifd, iln); /* get adr of this line */
				PushVar(lengthen(adr), vtyCnInt);
			} 
			else {
				/* proc name followed by ???, give proc adr and type */
				TyFLocal(ty, vrgPd[ipd].sbProc, vrgPd[ipd].isym);
				PushVar(lengthen(vrgPd[ipd].adrStart), ty);
			} /* if */
		} 
		else if ((adr=AdrFLabel(vsbTok)) != adrNil) {
			/* it is a label */
			TkPeek();
			if (vtkPeek == tkLP) {
				/* we have `label(' - must be a procedure call */
				TkNext();	/* eat ( */
				val = DoProc(ipdNil, ty, adr);
				PushVar(val, ty);
			} 
			else {
				PushVar(lengthen(adr), vtyCnInt);
			}
		} 
		else {
			/* don't what it is, it is NOT something we can handle! */
			return(tkNil);
		} /* if */
		break;
	} /* switch */
	return(tkAdr);
} /* TkFOperand */


/* T K   F   E X P R */

export TKE TkFExpr(pret, ty)
long    *pret;
pTYR    ty;
{
	int		cbTemp;
	PSE         ps;
	TKE         tk, tkRet, tkTemp;
	char        *sbCmdTemp, sbTokTemp[50];

	if (vtk == tkNil) {
		*pret = 0;
		return(tkNil);
	} /* if */

	/* save the token state in case we think it is garbage */
	cbTemp = vcbTok;
	sbCmdTemp = vsbCmd;
	tk = tkTemp = vtk;
	ps = psOp;
	strcpy(sbTokTemp, vsbTok);

	PushOp(tkBOE);	/* push a {ning-of-expression onto the stack */

	/* we do a little dance here to see if we have a pure number */
	tkRet = TkFOperand();
	if (tkRet != tkNil) {
		ps = psVar;
		tk = TkNext();
		if ((tkRet == tkNumber) AND (PrecFTk(tk)==0)) {
			tk = PopOp();	/* eat the BOE */
			FPopVar(pret, ty);
			return(tkNumber);
		} /* if */
	} 
	else if (PrecFTk(tk) == 0) {
		/* it is neither an operator nor an operand */
		goto bombout;
	} /* if */

	if (tk == tkComma) {
		PushOp(tkLP);   /* makes procedure call code easier */
		tk = TkNext();
	} /* if */

	while (tk != tkNil) {
		if ( (PrecFTk(tk) != 0)
		    AND ((tk != tkDot) OR (ps == psVar)) ) {
			/* it is an operator */
			ps = PsFOperator(tk, ps);
			if (ps == psFail)
				goto bombout;
			if (tk == tkComma)
				break;
		} 
		else {
			/* it's not an operator, is it an OPERAND?? */
			tk = TkFOperand();
			if (tk == tkNil) {
				ps = psFail;
				break; /* not operand - fall out of loop and see what happens */
			} /* if */
			ps = psVar; /* yup, it was an operand - and it's on the stack */
		} /* if */
		tk = TkNext();
	} /* while */

	/* one way or the other, someone thinks we might be done, try it and see */
	if (psFail != PsFOperator(tkEOE, ps)) {
		FPopVar(pret, ty);      /* put final stuff in return variables */
		return(tkAdr);
	} /* if */

bombout:
	/* something ain't right - reset the universe */
	vcbTok = cbTemp;
	vsbCmd = sbCmdTemp;
	vtk = tkTemp;
	strcpy(vsbTok, sbTokTemp);
	vivarMac = 0; /* stack pointer cleanup */
	viopMac = 0;
	return(tkNil);
} /* TkFExpr */


/* G E T   E X P R */

export long GetExpr(pty, tk)
pTYR    *pty;
TKE     tk;
{
	long        adrLong, i;
	static TYR  ty[cTyMax];
	/* ty is used for callers to GetExp who don't want to be bothered
		     * with allocating an ty.
		     * NOTE(!): if they want this info for more than a statement or two,
		     * they MUST copy it someplace else!!!
		     */

	if (tk == tkNil)
		TkNext();
	if (TkFExpr(&adrLong, ty) != tkNil) {
		i = ValFAdr(adrLong, ty);
		*pty = ty;
	} 
	else {
		*pty = tyNil;
	} /* if */
	return(i);
} /* GetExpr */

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