codegen.c

Calc Software Package for Number Calc

		getobjdeclaration(SYM_UNDEFINED);
		type = EXPR_ASSIGN;
		break;

	case T_SYMBOL:
		rescantoken();
		type = getidexpr(TRUE, 0);
		break;

	case T_MULT:
		(void) getterm();
		addop(OP_DEREF);
		type = 0;
		break;

	case T_POWER:			/* '**' or '^' */
		(void) getterm();
		addop(OP_DEREF);
		addop(OP_DEREF);
		type = 0;
		break;

	case T_GLOBAL:
		if (gettoken() != T_SYMBOL) {
			scanerror(T_NULL,
				 "No identifier after global specifier");
			break;
		}
		rescantoken();
		type = getidexpr(TRUE, T_GLOBAL);
		break;

	case T_LOCAL:
		if (gettoken() != T_SYMBOL) {
			scanerror(T_NULL,
				 "No identifier after local specifier");
			break;
		}
		rescantoken();
		type = getidexpr(TRUE, T_LOCAL);
		break;

	case T_STATIC:
		if (gettoken() != T_SYMBOL) {
			scanerror(T_NULL,
				 "No identifier after static specifier");
			break;
		}
		rescantoken();
		type = getidexpr(TRUE, T_STATIC);
		break;

	case T_LEFTBRACKET:
		scanerror(T_NULL, "Left bracket with no preceding lvalue");
		break;

	case T_PERIOD:
		scanerror(T_NULL, "Period with no preceding lvalue");
		break;

	default:
		if (iskeyword(type)) {
			scanerror(T_NULL,
			    "Expression contains reserved keyword");
			break;
		}
		rescantoken();
		scanerror(T_COMMA, "Missing expression");
	}
	if (type == 0) {
		for (;;) {
			switch (gettoken()) {
			case T_LEFTBRACKET:
				rescantoken();
				getmatargs();
				type = 0;
				break;
			case T_PERIOD:
				getelement();
				type = 0;
				break;
			case T_LEFTPAREN:
				scanerror(T_NULL,
					  "Function calls not allowed "
					  "as expressions");
			default:
				rescantoken();
			return type;
			}
		}
	}
	return type;
}


/*
 * Read in an identifier expressions.
 * This is a symbol name followed by parenthesis, or by square brackets or
 * element references.  The symbol can be a global or a local variable name.
 * Returns the type of expression found.
 */
static int
getidexpr(BOOL okmat, int autodef)
{
	int type;
	char name[SYMBOLSIZE+1];	/* symbol name */
	int oldmode;

	type = 0;
	if (!getid(name))
		return type;
	switch (gettoken()) {
	case T_LEFTPAREN:
		oldmode = tokenmode(TM_DEFAULT);
		getcallargs(name);
		(void) tokenmode(oldmode);
		type = 0;
		break;
	case T_ASSIGN:
		if (autodef != T_GLOBAL && autodef != T_LOCAL &&
				autodef != T_STATIC)
			autodef = 1;
		/* fall into default case */
	default:
		rescantoken();
		usesymbol(name, autodef);
	}
	/*
	 * Now collect as many element references and matrix index operations
	 * as there are following the id.
	 */
	for (;;) {
		switch (gettoken()) {
		case T_LEFTBRACKET:
			rescantoken();
			if (!okmat)
				return type;
			getmatargs();
			type = 0;
			break;
		case T_ARROW:
			addop(OP_DEREF);
			/*FALLTHRU*/
		case T_PERIOD:
			getelement();
			type = 0;
			break;
		case T_LEFTPAREN:
			scanerror(T_NULL,
				  "Function calls not allowed "
				  "as expressions");
		default:
			rescantoken();
			return type;
		}
	}
}


/*
 * getsymvalue - return the VALUE of a symbol
 *
 * given:
 *	name	symbol name
 *	v_p	pointer to value return
 *
 * returns:
 *	symbol type found:
 *
 *		SYM_UNDEFINED	no such symbol
 *		SYM_GLOBAL	global symbol found
 *
 * NOTE: This is a special hack to allow some special code in getfilename()
 *	 to get the value of a symbol.  It should NOT be used in the
 *	 general op code generation / calc code parsing case.
 */
static int
getsymvalue(char *name, VALUE *v_p)
{
	GLOBAL *g_ret;		/* global return from findglobal() */

	/* firewall */
	if (name == NULL || v_p == NULL) {
		return SYM_UNDEFINED;
	}

	/* look for a global */
	g_ret = findglobal(name);
	if (g_ret != NULL) {
		*v_p = g_ret->g_value;
		return SYM_GLOBAL;
	}

	/* no such symbol */
	return SYM_UNDEFINED;
}


/*
 * Read in a filename for a read or write command.
 * Both quoted and unquoted filenames are handled here.
 * The name must be terminated by an end of line or semicolon.
 * Returns TRUE if the filename was successfully parsed.
 *
 * given:
 *	name		filename to read
 *	namelen		length of filename buffer including NUL byte
 *	once		non-NULL => set to TRUE of -once read
 */
static int
getfilename(char *name, size_t namelen, BOOL *once)
{
	STRING *s;
	char *symstr;	/* symbol string */
	VALUE val;	/* value of the symbol */
	int i;

	(void) tokenmode(TM_NEWLINES | TM_ALLSYMS);
	for (i = 2; i > 0; i--) {
		switch (gettoken()) {
		case T_STRING:

			/* use the value of the literal string */
			s = findstring(tokenstring());
			strncpy(name, s->s_str, namelen-1);
			name[namelen-1] = '\0';
			sfree(s);
			break;

		case T_SYMBOL:

			/* get the symbol name */
			symstr = tokensymbol();

			/*
			 * special hack - symbols starting with $ are
			 *		  treated as a global variable
			 *		  instead of a literal string.
			 */
			if (symstr[0] == '$') {
				++symstr;
				if (getsymvalue(symstr, &val)) {
					if (val.v_type == V_STR) {
						/* use symbol VALUE string */
						symstr = val.v_str->s_str;
						if (symstr == NULL) {
							math_error("string value pointer is NULL!!");
							/*NOTREACHED*/
						}
					} else {
						math_error("a filename variable must be a string");
						/*NOTREACHED*/
					}
				} else {
					math_error("no such global variable");
					/*NOTREACHED*/
				}
			}

			/* return symbol name or value of global var string */
			strncpy(name, symstr, namelen-1);
			name[namelen-1] = '\0';
			break;

		case T_NEWLINE:

			/* found newline */
			rescantoken();
			return 1;

		default:

			/* found something unexpected */
			rescantoken();
			return -1;
		}

		/* deal with -once */
		if (i == 2 && once != NULL) {
			if ((*once = !strcmp(name, "-once")))
				continue;
		}
		break;
	}
	return 0;
}


/*
 * Read the show command to display useful information
 */
static void
getshowstatement(void)
{
	char name[5];
	long arg, index;

	switch (gettoken()) {
	case T_SYMBOL:
		strncpy(name, tokensymbol(), 4);
		name[4] = '\0';
		/* Yuck! */
		arg = stringindex("buil\000"
				  "real\000"
				  "func\000"
				  "objf\000"
				  "conf\000"
				  "objt\000"
				  "file\000"
				  "size\000"
				  "erro\000"
				  "cust\000"
				  "bloc\000"
				  "cons\000"
				  "glob\000"
				  "stat\000"
				  "numb\000"
				  "redc\000"
				  "stri\000"
				  "lite\000"
				  "opco\000", name);
		break;
	case T_GLOBAL:
		arg = 13; break;
	case T_STATIC:
		arg = 14; break;
	default:
		printf("SHOW command to be followed by at least ");
		printf("four letters of one of:\n");
		printf("\tblocks, builtin, config, constants, ");
		printf("custom, errors, files, functions,\n");
		printf("\tglobaltypes, objfunctions, objtypes, "
		       "opcodes, sizes, ");
		printf("realglobals,\n");
		printf("\tstatics, numbers, redcdata, "
		       "strings, literals\n");
		rescantoken();
		return;

	}
	if (arg == 19) {
		if (gettoken() != T_SYMBOL) {
			rescantoken();
			scanerror(T_SEMICOLON,
				  "Function name expected for show statement");
			return;
		}
		index = adduserfunc(tokensymbol());
		addopone(OP_SHOW, index + 19);
		return;
	}
	if (arg > 0)
		addopone(OP_SHOW, arg);
	else
		warning("Unknown parameter for show statement");
}


/*
 * Read in a set of matrix index arguments, surrounded with square brackets.
 * This also handles double square brackets for 'fast indexing'.
 */
static void
getmatargs(void)
{
	int dim;

	if (gettoken() != T_LEFTBRACKET) {
		scanerror(T_NULL, "Matrix indexing expected");
		return;
	}
	/*
	 * Parse all levels of the array reference
	 * Look for the 'fast index' first.
	 */
	if (gettoken() == T_LEFTBRACKET) {
		(void) getopassignment();
		if ((gettoken() != T_RIGHTBRACKET) ||
			(gettoken() != T_RIGHTBRACKET)) {
				scanerror(T_NULL, "Bad fast index usage");
				return;
		}
		addop(OP_FIADDR);
		return;
	}
	rescantoken();
	/*
	 * Normal indexing with the indexes separated by commas.
	 * Initialize the flag in the opcode to assume that the array
	 * element will only be referenced for reading.	 If the parser
	 * finds that the element will be referenced for writing, then
	 * it will call writeindexop to change the flag in the opcode.
	 */
	dim = 0;
	if (gettoken() == T_RIGHTBRACKET) {
		addoptwo(OP_INDEXADDR, (long) dim, (long) FALSE);
		return;
	}
	rescantoken();
	for (;;) {
		++dim;
		(void) getopassignment();
		switch (gettoken()) {
		case T_RIGHTBRACKET:
			addoptwo(OP_INDEXADDR, (long) dim,
					(long) FALSE);
			return;
		case T_COMMA:
			break;
		default:
			rescantoken();
			scanerror(T_NULL,
				  "Missing right bracket in "
				  "array reference");
			return;
		}
	}
}


/*
 * Get an element of an object reference.
 * The leading period which introduces the element has already been read.
 */
static void
getelement(void)
{
	long index;
	char name[SYMBOLSIZE+1];

	if (!getid(name))
		return;
	index = findelement(name);
	if (index < 0) {
		scanerror(T_NULL, "Element \"%s\" is undefined", name);
		return;
	}
	addopone(OP_ELEMADDR, index);
}


/*
 * Read in a single symbol name and copy its value into the given buffer.
 * Returns TRUE if a valid symbol id was found.
 */
static BOOL
getid(char *buf)
{
	int type;

	type = gettoken();
	if (iskeyword(type)) {
		scanerror(T_NULL, "Reserved keyword used as symbol name");
		type = T_SYMBOL;
		*buf = '\0';
		return FALSE;
	}
	if (type != T_SYMBOL) {
		rescantoken();
		scanerror(T_NULL, "Symbol name expected");
		*buf = '\0';
		return FALSE;
	}
	strncpy(buf, tokensymbol(), SYMBOLSIZE);
	buf[SYMBOLSIZE] = '\0';
	return TRUE;
}


/*
 * Define a symbol name to be of the specified symbol type.  The scope
 * of a static variable with the same name is terminated if symtype is
 * global or if symtype is static and the old variable is at the same
 * level.  Warnings are issued when a global or local variable is
 * redeclared and when in the same body the variable will be accessible only
 ^ with the appropriate specfier.
 */
static void
definesymbol(char *name, int symtype)
{
	switch (symboltype(name)) {
	case SYM_STATIC:
		if (symtype == SYM_GLOBAL || symtype == SYM_STATIC)
			endscope(name, symtype == SYM_GLOBAL);
		break;
	case SYM_GLOBAL:
		if (symtype == SYM_GLOBAL && conf->redecl_warn) {
			warning("redeclaraion of global \"%s\"",
				name);
			return;
		}
		break;

	case SYM_LOCAL:
		if (symtype == SYM_LOCAL && conf->redecl_warn) {
			warning("redeclaraion of local \"%s\"",
				name);
			return;
		}
		if (symtype == SYM_GLOBAL && conf->dupvar_warn) {
			warning("both local and global \"%s\" defined", name);
			break;
		}
		if (conf->dupvar_warn) {
			warning("both local and static \"%s\" defined", name);
		}
		break;
	case SYM_PARAM:
		if (symtype == SYM_LOCAL && conf->dupvar_warn) {
			warning("both local and parameter \"%s\" defined",
				name);
			break;
		}
		if (symtype == SYM_GLOBAL && conf->dupvar_warn) {
			warning("both global and parameter \"%s\" defined",
				name);
			break;
		}
		if (conf->dupvar_warn) {
			warning("both static and parameter \"%s\" defined", name);
		}
	}
	if (symtype == SYM_LOCAL)
		(void) addlocal(name);
	else
		(void) addglobal(name, (symtype == SYM_STATIC));
}


/*
 * Check a symbol name to see if it is known and generate code to reference it.
 * The symbol can be either a parameter name, a local name, or a global name.
 * If autodef is true, we automatically define the name as a global symbol
 * if it is not yet known.
 *
 * given:
 *	name		symbol name to be checked
 *	autodef		1 => define if symbol is not known
 *			T_GLOBAL => get global, define if necessary
 */
static void
usesymbol(char *name, int autodef)
{
	int type;

	type = symboltype(name);
	if (autodef == T_GLOBAL) {
		if (type == SYM_GLOBAL) {
			warning("Unnecessary global specifier");
		}
		addopptr(OP_GLOBALADDR, (char *) addglobal(name, FALSE));
		return;
	}
	if (autodef == T_STATIC) {
		addopptr(OP_GLOBALADDR, (char *) addglobal(name, TRUE));
		return;
	}
	if (autodef == T_LOCAL) {
		if (type == SYM_LOCAL) {
			warning("Unnecessary local specifier");
		}
		addopone(OP_LOCALADDR, addlocal(name));
		return;
	}
	switch (type) {
	case SYM_LOCAL:
		addopone(OP_LOCALADDR, (long) findlocal(name));
		return;
	case SYM_PARAM:
		addopone(OP_PARAMADDR, (long) findparam(name));
		return;
	case SYM_GLOBAL:
	case SYM_STATIC:
		addopptr(OP_GLOBALADDR, (char *) findglobal(name));
		return;
	}
	/*
	 * The symbol is not yet defined.
	 * If we are at the top level and we are allowed to, then define it.
	 */
	if ((curfunc->f_name[0] != '*') || !autodef) {
		scanerror(T_NULL, "\"%s\" is undefined", name);
		return;
	}
	(void) addglobal(name, FALSE);
	addopptr(OP_GLOBALADDR, (char *) findglobal(name));
}


/*
 * Get arguments for a function call.
 * The name and beginning parenthesis has already been seen.
 * callargs = [ [ '&' ] assignment  [',' [ '&' ] assignment] ] ')'.
 *
 * given:
 *	name		name of function
 */
static void
getcallargs(char *name)
{
	long index;		/* function index */
	long op;		/* opcode to add */
	int argcount;		/* number of arguments */
	BOOL addrflag;

	op = OP_CALL;
	index = getbuiltinfunc(name);
	if (index < 0) {
		op = OP_USERCALL;
		index = adduserfunc(name);
	}
	if (gettoken() == T_RIGHTPAREN) {
		if (op == OP_CALL)
			builtincheck(index, 0);
		addopfunction(op, index, 0);
		return;
	}
	rescantoken();
	argcount = 0;
	for (;;) {
		argcount++;
		if (gettoken() == T_RIGHTPAREN) {
			addop(OP_UNDEF);
			if (op == OP_CALL)
				builtincheck(index, argcount);
			addopfunction(op, index, argcount);
			return;
		}
		rescantoken();
		if (gettoken() == T_COMMA) {
			addop(OP_UNDEF);
			continue;
		}
		rescantoken();
		addrflag = (gettoken() == T_BACKQUOTE);
		if (!addrflag)
			rescantoken();
		(void) getopassignment();
		if (addrflag) {
			writeindexop();
		}
		if (!addrflag && (op != OP_CALL))
			addop(OP_GETVALUE);
		if (!strcmp(name, "quomod") && argcount > 2)
			writeindexop();
		switch (gettoken()) {
		case T_RIGHTPAREN:
			if (op == OP_CALL)
				builtincheck(index, argcount);
			addopfunction(op, index, argcount);
			return;
		case T_COMMA:
			break;
		default:
			scanerror(T_SEMICOLON,
				  "Missing right parenthesis "
				  "in function call");
			return;
		}
	}
}


/*
 * Change the current directory.  If no directory is given, assume home.
 */
static void
do_changedir(void)
{
	char *p;
	STRING *s;

	/* look at the next token */
	(void) tokenmode(TM_NEWLINES | TM_ALLSYMS);

	/* determine the new directory */
	s = NULL;
	switch (gettoken()) {
	case T_STRING:
		s = findstring(tokenstring());
		p = s->s_str;
		break;
	case T_SYMBOL:
		p = tokensymbol();
		break;
	default:
		p = home;
	}

	if (p == NULL) {
		fprintf(stderr, "Cannot determine HOME directory\n");
	}

	/* change to that directory */
	if (chdir(p)) {
		perror(p);
	}
	if (s != NULL)
		sfree(s);
}