codegen.c

Calc Software Package for Number Calc

				scanerror(T_SEMICOLON,
					  "CONTINUE not within FOR, "
					  "WHILE, or DO");
				return;
			}
			addoplabel(OP_JUMPNZ, contlabel);
			break;
		case T_BREAK:
			if (breaklabel == NULL_LABEL) {
				scanerror(T_SEMICOLON,
					  "BREAK not within FOR, "
					  "WHILE, or DO");
				return;
			}
			addoplabel(OP_JUMPNZ, breaklabel);
			break;
		case T_GOTO:
			if (gettoken() != T_SYMBOL) {
				scanerror(T_SEMICOLON,
					  "Missing label in goto");
				return;
			}
			addop(OP_JUMPNZ);
			addlabel(tokensymbol());
			break;
		default:
			addoplabel(OP_JUMPZ, &label1);
			rescantoken();
			getstatement(contlabel, breaklabel,
				     NULL_LABEL, NULL_LABEL);
			if (gettoken() != T_ELSE) {
				setlabel(&label1);
				rescantoken();
				return;
			}
			addoplabel(OP_JUMP, &label2);
			setlabel(&label1);
			getstatement(contlabel, breaklabel,
				     NULL_LABEL, NULL_LABEL);
			setlabel(&label2);
			return;
		}
		if (gettoken() != T_SEMICOLON) /* This makes ';' optional */
			rescantoken();
		if (gettoken() != T_ELSE) {
			rescantoken();
			return;
		}
		getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
		return;

	case T_FOR:	/* for (a; b; c) x */
		oldmode = tokenmode(TM_DEFAULT);
		clearlabel(&label1);
		clearlabel(&label2);
		clearlabel(&label3);
		clearlabel(&label4);
		contlabel = NULL_LABEL;
		breaklabel = &label4;
		if (gettoken() != T_LEFTPAREN) {
			(void) tokenmode(oldmode);
			scanerror(T_SEMICOLON, "Left parenthesis expected");
			return;
		}
		if (gettoken() != T_SEMICOLON) {	/* have 'a' part */
			rescantoken();
			(void) getexprlist();
			addop(OP_POP);
			if (gettoken() != T_SEMICOLON) {
				(void) tokenmode(oldmode);
				scanerror(T_SEMICOLON, "Missing semicolon");
				return;
			}
		}
		if (gettoken() != T_SEMICOLON) {	/* have 'b' part */
			setlabel(&label1);
			contlabel = &label1;
			rescantoken();
			(void) getexprlist();
			addoplabel(OP_JUMPNZ, &label3);
			addoplabel(OP_JUMP, breaklabel);
			if (gettoken() != T_SEMICOLON) {
				(void) tokenmode(oldmode);
				scanerror(T_SEMICOLON, "Missing semicolon");
				return;
			}
		}
		if (gettoken() != T_RIGHTPAREN) {	/* have 'c' part */
			if (label1.l_offset < 0)
				addoplabel(OP_JUMP, &label3);
			setlabel(&label2);
			contlabel = &label2;
			rescantoken();
			(void) getexprlist();
			addop(OP_POP);
			if (label1.l_offset >= 0)
				addoplabel(OP_JUMP, &label1);
			if (gettoken() != T_RIGHTPAREN) {
				(void) tokenmode(oldmode);
				scanerror(T_SEMICOLON,
					  "Right parenthesis expected");
				return;
			}
		}
		setlabel(&label3);
		if (contlabel == NULL_LABEL)
			contlabel = &label3;
		(void) tokenmode(oldmode);
		getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
		addoplabel(OP_JUMP, contlabel);
		setlabel(breaklabel);
		return;

	case T_WHILE:
		oldmode = tokenmode(TM_DEFAULT);
		contlabel = &label1;
		clearlabel(contlabel);
		setlabel(contlabel);
		getcondition();
		(void) tokenmode(oldmode);
		if (gettoken() != T_SEMICOLON) {
			breaklabel = &label2;
			clearlabel(breaklabel);
			addoplabel(OP_JUMPZ, breaklabel);
			rescantoken();
			getstatement(contlabel, breaklabel,
				NULL_LABEL, NULL_LABEL);
			addoplabel(OP_JUMP, contlabel);
			setlabel(breaklabel);
		} else {
			addoplabel(OP_JUMPNZ, contlabel);
		}
		return;

	case T_DO:
		oldmode = tokenmode(TM_DEFAULT);
		contlabel = &label1;
		breaklabel = &label2;
		clearlabel(contlabel);
		clearlabel(breaklabel);
		clearlabel(&label3);
		setlabel(&label3);
		getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
		if (gettoken() != T_WHILE) {
			(void) tokenmode(oldmode);
			scanerror(T_SEMICOLON,
				  "WHILE keyword expected for DO statement");
			return;
		}
		setlabel(contlabel);
		getcondition();
		addoplabel(OP_JUMPNZ, &label3);
		setlabel(breaklabel);
		(void) tokenmode(oldmode);
		return;

	case T_SWITCH:
		oldmode = tokenmode(TM_DEFAULT);
		breaklabel = &label1;
		nextcaselabel = &label2;
		defaultlabel = &label3;
		clearlabel(breaklabel);
		clearlabel(nextcaselabel);
		clearlabel(defaultlabel);
		getcondition();
		if (gettoken() != T_LEFTBRACE) {
			(void) tokenmode(oldmode);
			scanerror(T_SEMICOLON,
				  "Missing left brace for switch statement");
			return;
		}
		addoplabel(OP_JUMP, nextcaselabel);
		rescantoken();
		getstatement(contlabel, breaklabel,
			     nextcaselabel, defaultlabel);
		addoplabel(OP_JUMP, breaklabel);
		setlabel(nextcaselabel);
		if (defaultlabel->l_offset > 0)
			addoplabel(OP_JUMP, defaultlabel);
		else
			addop(OP_POP);
		setlabel(breaklabel);
		(void) tokenmode(oldmode);
		return;

	case T_CASE:
		if (nextcaselabel == NULL_LABEL) {
			scanerror(T_SEMICOLON,
				  "CASE not within SWITCH statement");
			return;
		}
		clearlabel(&label1);
		addoplabel(OP_JUMP, &label1);
		setlabel(nextcaselabel);
		clearlabel(nextcaselabel);
		(void) getexprlist();
		if (gettoken() != T_COLON) {
			scanerror(T_SEMICOLON,
				  "Colon expected after CASE expression");
			return;
		}
		addoplabel(OP_CASEJUMP, nextcaselabel);
		setlabel(&label1);
		getstatement(contlabel, breaklabel,
			     nextcaselabel, defaultlabel);
		return;

	case T_DEFAULT:
		if (gettoken() != T_COLON) {
			scanerror(T_SEMICOLON,
				  "Colon expected after DEFAULT keyword");
			return;
		}
		if (defaultlabel == NULL_LABEL) {
			scanerror(T_SEMICOLON,
				  "DEFAULT not within SWITCH statement");
			return;
		}
		if (defaultlabel->l_offset > 0) {
			scanerror(T_SEMICOLON,
				  "Multiple DEFAULT clauses in SWITCH");
			return;
		}
		clearlabel(&label1);
		addoplabel(OP_JUMP, &label1);
		setlabel(defaultlabel);
		addop(OP_POP);
		setlabel(&label1);
		getstatement(contlabel, breaklabel,
			     nextcaselabel, defaultlabel);
		return;

	case T_ELSE:
		scanerror(T_SEMICOLON, "ELSE without preceding IF");
		return;

	case T_SHOW:
		getshowstatement();
		break;

	case T_PRINT:
		printeol = TRUE;
		for (;;) {
			switch (gettoken()) {
			case T_RIGHTPAREN:
			case T_RIGHTBRACKET:
			case T_RIGHTBRACE:
			case T_NEWLINE:
			case T_ELSE:
			case T_EOF:
				rescantoken();
				/*FALLTHRU*/
			case T_SEMICOLON:
				if (printeol)
					addop(OP_PRINTEOL);
				return;
			case T_COMMA:
				addop(OP_PRINTSPACE);
				/*FALLTHRU*/
			case T_COLON:
				printeol = FALSE;
				break;
			case T_STRING:
				printeol = TRUE;
				addopone(OP_PRINTSTRING, tokenstring());
				break;
			default:
				printeol = TRUE;
				rescantoken();
				(void) getopassignment();
				addopone(OP_PRINT, (long) PRINT_NORMAL);
			}
		}

	case T_QUIT:
		switch (gettoken()) {
		case T_STRING:
			addopone(OP_QUIT, tokenstring());
			break;
		default:
			addopone(OP_QUIT, -1);
			rescantoken();
		}
		break;

	case T_ABORT:
		switch (gettoken()) {
		case T_STRING:
			addopone(OP_ABORT, tokenstring());
			break;
		default:
			addopone(OP_ABORT, -1);
			rescantoken();
		}
		break;

	case T_SYMBOL:
		if (nextchar() == ':') {	/****HACK HACK****/
			definelabel(tokensymbol());
			if (gettoken() == T_RIGHTBRACE) {
				rescantoken();
				return;
			}
			rescantoken();
			getstatement(contlabel, breaklabel,
				NULL_LABEL, NULL_LABEL);
			return;
		}
		reread();
		/* fall into default case */

	default:
		rescantoken();
		type = getexprlist();
		if (contlabel || breaklabel || (curfunc->f_name[0] != '*')) {
			addop(OP_POP);
			break;
		}
		addop(OP_SAVE);
		if (isassign(type) || (curfunc->f_name[1] != '\0')) {
			addop(OP_POP);
			break;
		}
		addop(OP_PRINTRESULT);
		break;
	}
	for (;;) {
		switch (gettoken()) {
		case T_RIGHTBRACE:
		case T_NEWLINE:
		case T_EOF:
		case T_ELSE:
			rescantoken();
			return;
		case T_SEMICOLON:
			return;
		case T_NUMBER:
		case T_IMAGINARY:
			addopone(OP_NUMBER, tokennumber());
			scanerror(T_NULL, "Unexpected number");
			continue;
		default:
			scanerror(T_NULL, "Semicolon expected");
			return;
		}
	}
}


/*
 * Read in an object declaration.
 * This is of the following form:
 *	OBJ type [ '{' id [ ',' id ] ... '}' ]	[ objlist ].
 * The OBJ keyword has already been read.  Symtype is SYM_UNDEFINED if this
 * is an OBJ statement, otherwise this is part of a declaration which will
 * define new symbols with the specified type.
 */
static void
getobjdeclaration(int symtype)
{
	char *name;			/* name of object type */
	int count;			/* number of elements */
	int index;			/* current index */
	int i;				/* loop counter */
	int oldmode;

	if (gettoken() != T_SYMBOL) {
		scanerror(T_SEMICOLON, "Object type name missing");
		return;
	}
	name = addliteral(tokensymbol());
	if (gettoken() != T_LEFTBRACE) {
		rescantoken();
		getobjvars(name, symtype);
		return;
	}
	/*
	 * Read in the definition of the elements of the object.
	 */
	count = 0;
	indices = quickindices;
	maxindices = INDICALLOC;

	oldmode = tokenmode(TM_DEFAULT);

	for (;;) {
		switch (gettoken()) {
		case T_SYMBOL:
			if (count == maxindices) {
				if (maxindices == INDICALLOC) {
					maxindices += INDICALLOC;
					newindices = (int *) malloc(maxindices *
						sizeof(int));
					if (newindices == NULL) {
						scanerror(T_SEMICOLON, "Out of memory for indices malloc");
						(void) tokenmode(oldmode);
						return;
					}
					memcpy(newindices, quickindices,
						INDICALLOC * sizeof(int));
					indices = newindices;
				} else {
					maxindices += INDICALLOC;
					newindices = (int *) realloc(indices,
						maxindices * sizeof(int));
					if (newindices == NULL) {
						free(indices);
						scanerror(T_SEMICOLON, "Out of memory for indices realloc");
						(void) tokenmode(oldmode);
						return;
					}
					indices = newindices;
				}
			}
			index = addelement(tokensymbol());
			for (i = 0; i < count; i++) {
				if (indices[i] == index) {
					if (indices != quickindices)
						free(indices);
					scanerror(T_SEMICOLON, "Duplicate element name \"%s\"", tokensymbol());
					(void) tokenmode(oldmode);
					return;
				}
			}
			indices[count++] = index;
			if (gettoken() == T_COMMA)
				continue;
			rescantoken();
			if (gettoken() != T_RIGHTBRACE) {
				if (indices != quickindices)
					free(indices);
				scanerror(T_SEMICOLON, "Bad object type definition");
				(void) tokenmode(oldmode);
				return;
			}
			/*FALLTHRU*/
		case T_RIGHTBRACE:
			(void) tokenmode(oldmode);
			if (defineobject(name, indices, count)) {
				if (indices != quickindices)
					free(indices);
				scanerror(T_NULL,
				"Object type \"%s\" is already defined", name);
				return;
			}
			if (indices != quickindices)
				free(indices);
			getobjvars(name, symtype);
			return;
		case T_NEWLINE:
			continue;
		default:
			if (indices != quickindices)
				free(indices);
			scanerror(T_SEMICOLON, "Bad object type definition");
				(void) tokenmode(oldmode);
			return;

		}
	}
}


static void
getoneobj(long index, int symtype)
{
	char *symname;

	if (gettoken() == T_SYMBOL) {
		if (symtype == SYM_UNDEFINED) {
			rescantoken();
			(void) getidexpr(TRUE, 1);
		} else {
			symname = tokensymbol();
			definesymbol(symname, symtype);
			usesymbol(symname, 0);
		}
		getoneobj(index, symtype);
		addop(OP_ASSIGN);
		return;
	}
	rescantoken();
	addopone(OP_OBJCREATE, index);
	while (gettoken() == T_ASSIGN)
		(void) getinitlist();
	rescantoken();
}

/*
 * Routine to assign a specified object-type value to each of a set of
 * variables in a "global", "local" or "static" declaration, or, if
 * symtype is SYM_UNDEFINED, to create one object value of the specified
 * type.
 *
 * given:
 *	name		object name
 *	symtype		declaration type
 */
static void
getobjvars(char *name, int symtype)
{
	long index;		/* index for object */

	index = checkobject(name);
	if (index < 0) {
		scanerror(T_SEMICOLON,
			  "Object %s has not been defined yet", name);
		return;
	}
	for (;;) {
		getoneobj(index, symtype);
		if (symtype == SYM_UNDEFINED)
			return;
		if (gettoken() != T_COMMA) {
			rescantoken();
			return;
		}
		addop(OP_POP);
	}
}


static void
getmatdeclaration(int symtype)
{
	for (;;) {
		switch (gettoken()) {
		case T_SYMBOL:
			rescantoken();
			getonematrix(symtype);
			addop(OP_POP);
			continue;
		case T_COMMA:
			continue;
		default:
			rescantoken();
			return;
		}
	}
}


static void
getonematrix(int symtype)
{
	long dim;
	long index;
	long count;
	unsigned long patchpc;
	char *name;

	if (gettoken() == T_SYMBOL) {
		if (symtype == SYM_UNDEFINED) {
			rescantoken();
			(void) getidexpr(FALSE, 1);
		} else {
			name = tokensymbol();
			definesymbol(name, symtype);
			usesymbol(name, 0);
		}
		while (gettoken() == T_COMMA);
		rescantoken();
		getonematrix(symtype);
		addop(OP_ASSIGN);
		return;
	}
	rescantoken();

	if (gettoken() == T_LEFTPAREN) {
		if (isrvalue(getexprlist())) {
			scanerror(T_SEMICOLON, "Lvalue expected");
			return;
		}
		if (gettoken() != T_RIGHTPAREN) {
			scanerror(T_SEMICOLON, "Missing right parenthesis");
			return;
		}
		getonematrix(symtype);
		addop(OP_ASSIGN);
		return;
	}
	rescantoken();

	if (gettoken() != T_LEFTBRACKET) {
		rescantoken();
		scanerror(T_SEMICOLON, "Left-bracket expected");
		return;
	}
	dim = 1;

	/*
	 * If there are no bounds given for the matrix, then they must be
	 * implicitly defined by a list of initialization values.  Put in
	 * a dummy number in the opcode stream for the bounds and remember
	 * its location.  After we know how many values are in the list, we
	 * will patch the correct value back into the opcode.
	 */
	if (gettoken() == T_RIGHTBRACKET) {
		if (gettoken() == T_ASSIGN) {
			clearopt();
			patchpc = curfunc->f_opcodecount + 1;
			addopone(OP_NUMBER, (long) -1);
			clearopt();
			addop(OP_ZERO);
			addopone(OP_MATCREATE, dim);
			addop(OP_ZERO);
			addop(OP_INITFILL);
			count = 0;
			count = getinitlist();
			index = addqconstant(itoq(count));
			if (index < 0)
				math_error("Cannot allocate constant");
			curfunc->f_opcodes[patchpc] = index;
			return;
		}
		rescantoken();
		addopone(OP_MATCREATE, 0);
		if (gettoken() == T_LEFTBRACKET) {
			creatematrix();
		} else {
			rescantoken();
			addop(OP_ZERO);
		}
		addop(OP_INITFILL);
		return;
	}

	/*
	 * This isn't implicit, so we expect expressions for the bounds.
	 */
	rescantoken();
	creatematrix();
	while (gettoken() == T_ASSIGN)
		(void) getinitlist();
	rescantoken();
}


static void
creatematrix(void)
{
	long dim;

	dim = 0;

	for (;;) {
		if (gettoken() == T_RIGHTBRACKET) {
			addopone(OP_MATCREATE, dim);
			if (gettoken() == T_LEFTBRACKET) {
				creatematrix();
			} else {
				rescantoken();
				addop(OP_ZERO);
			}
			addop(OP_INITFILL);
			return;
		}
		rescantoken();
		if (++dim > MAXDIM) {
			scanerror(T_SEMICOLON,
				  "Only %ld dimensions allowed", MAXDIM);
			return;
		}
		(void) getopassignment();
		switch (gettoken()) {
		case T_RIGHTBRACKET:
			rescantoken();
		case T_COMMA:
			addop(OP_ONE);
			addop(OP_SUB);
			addop(OP_ZERO);
			break;
		case T_COLON:
			(void) getopassignment();
			switch(gettoken()) {
			case T_RIGHTBRACKET:
				rescantoken();
			case T_COMMA:
				continue;
			}
			/*FALLTHRU*/
		default:
			rescantoken();
			scanerror(T_SEMICOLON,
				  "Illegal matrix definition");
			return;
		}
	}
}


/*
 * Get an optional initialization list for a matrix or object definition.
 * Returns the number of elements that are in the list, or -1 on parse error.
 *	initlist = { assignment [ , assignment ] ... }.
 */
static long
getinitlist(void)
{
	long index;
	int oldmode;

	oldmode = tokenmode(TM_DEFAULT);