/* %Z%%M% %I% %E% */

/*
 * Copyright (c) 1990, 1991, 1992, 1993, 1995 by Wayne C. Gramlich.
 * All rights reserved.
 *
 * Permission to use, copy, modify, distribute, and sell this software
 * for any purpose is hereby granted without fee provided that the above
 * copyright notice and this permission are retained.  The author makes
 * no representations about the suitability of this software for any purpose.
 * It is provided "as is" without express or implied warranty.
 */

/* This file contains code used for parsing: */

#ifndef ERROR_EXPORTS_H
#include "error_exports.h"
#endif

#ifndef FILE_DEFS_H
#include "file_defs.h"
#endif

#ifndef FLAGS_DEFS_H
#include "flags_defs.h"
#endif

#ifndef HEAP_EXPORTS_H
#include "heap_exports.h"
#endif

#ifndef INT_EXPORTS_H
#include "int_exports.h"
#endif

#ifndef KEYWORD_DEFS_H
#include "keyword_defs.h"
#endif

#ifndef LINT_H
#include "lint.h"
#endif

#ifndef MSG_DEFS_H
#include "msg_defs.h"
#endif

#ifndef OUT_EXPORTS_H
#include "out_exports.h"
#endif

#ifndef PORT_H
#include "port.h"
#endif

#ifndef PARSER_DEFS_H
#include "parser_defs.h"
#endif

#ifndef STR_EXPORTS_H
#include "str_exports.h"
#endif

#ifndef STRVEC_EXPORTS_H
#include "strvec_exports.h"
#endif

#ifndef TABLE_EXPORTS_H
#include "table_exports.h"
#endif

#ifndef TOKEN_DEFS_H
#include "token_defs.h"
#endif

#ifndef UNIX_ASSERT_H
#include "unix_assert.h"
#endif

#ifndef UNIX_CTYPE_H
#include "unix_ctype.h"
#endif

#ifndef VECTOR_DEFS_H
#include "vector_defs.h"
#endif

LOCAL int	parser_column_read(Parser);
LOCAL Str	parser_operators();
LOCAL Token	parser_token_create(Heap);

/*
 * parser_column_read(parser)
 * 	This routine will skip over spaces and tabs.  The column position
 *	is returned.
 */
int
parser_column_read(
	Parser		parser)
{
	int		column;
	File		file;
	Msg		msg;

	if (parser->column >= 0) {
		column = parser->column;
		parser->column = -1;
		return column;
	}
	msg = parser->msg;
	file = parser->file;
	column = 0;
	for (;;) {
		switch (file_chr_peek(file)) {
		    case '\t':
			column = (column | 7) + 1;
			(void)file_chr_read(file);
			break;
		    case ' ':
			column++;
			(void)file_chr_read(file);
			break;
		    case '\n':
			column = 0;
			(void)file_chr_read(file);
			msg_line_append(msg, file->position);
			break;
		    case EOF:
			return 0;
		    default:
			return file->line_column;
		}
	}
	/* NOTREACHED */
}

/*
 * parser_comma_list_parse(parser, routine, message)
 *	This routine will parse and return comma separated list of
 *	objects using "routine(parser)" to parse each object.  If
 *	"message" is not (Str)0 and parsed list is empty, an
 *	an error message is generated.
 */
Vec(Pointer)
parser_comma_list_parse(
	Parser		parser,
	Parser_routine	routine,
	Str		message)
{
	Pointer		item;
	Vec(Pointer)	list;
	Token		token;

	list = vec_create(Pointer, parser->heap);
	for (;;) {
		token = parser_token_peek(parser);
		switch (token->type) {
		    case Token_type_eol:
		    case Token_type_comma:
			msg_out(parser->msg, parser->file->position,
				     "Bad list");
			return list;
		}
		item = (*routine)(parser);
		if (item == (Pointer)0) {
			msg_out(parser->msg, token->position, "Bad list");
			break;
		}
		vec_append(Pointer, list, item);
		token = parser_token_peek(parser);
		if (token->type == Token_type_comma) {
			(void)parser_token_read(parser);
		} else {
			break;
		}
	}
	if (vec_empty(Pointer, list)) {
		msg_out(parser->msg, parser->file->position, message);
	}
	return list;
}

/*
 * parser_eol_read(parser)
 *	This routine will read up to and including an end-of-line.  If there
 *	is any end of line comment, it is returned as a Str; otherwise, (Str)0
 *	is returned.
 */
Str
parser_eol_read(
	Parser		parser)
{
	int		chr;
	File		file;
	Msg		msg;
	static Strvec	strvec = (Strvec)0;

	msg = parser->msg;
	parser->peek_token = TOKEN_NONE;
	file = parser->file;
	for (;;) {
		chr = file_chr_read(file);
		switch (chr) {
		    case '\n':
			msg_line_append(msg, file->position);
			return (Str)0;
		    case '\t':
		    case ' ':
			continue;
		    case '#':
		    case ';':
			break;
		    default:
			msg_out(parser->msg, (parser->previous == TOKEN_NONE) ?
					parser->file->position :
					parser->previous->position,
				  "Garbage at end-of-line");
			do {
				chr = file_chr_read(file);
			} while ((chr != '\n') && (chr != EOF));
			if (chr == '\n') {
				msg_line_append(msg, file->position);
			}
			return (Str)0;
		}
		break;
	}
	if (strvec == (Strvec)0) {
		strvec = strvec_create(parser->heap);
	} else {
		strvec_erase(strvec);
	}
	strvec_chr_append(strvec, chr);
	for (;;) {
		chr = file_chr_read(file);
		switch (chr) {
		    case '\n':
			msg_line_append(msg, file->position);
			/* FALLTHROUGH */
		    case EOF:
			return strvec_str_get(strvec, parser->heap);
		}
		strvec_chr_append(strvec, chr);
	}
	/* NOTREACHED */
}

/*
 * parser_file_open(file_name, msg, abort, type_tables, flags, heap)
 *	This routine will open "file_name" for reading of lexical tokens.
 *	If "file_name" could not be opened and "abort" is 1 a fatal error
 *	is generated; otherwise PARSER_NONE is returned;
 */
Parser
parser_file_open(
	Str		file_name,
	Msg		msg,
	int		abort,
	Type_tables	type_tables,
	Flags		flags,
	Heap		heap)
{
	File		file;
	Parser		parser;

	file = file_open(file_name, abort, heap);
	if (file == FILE_NONE) {
		return PARSER_NONE;
	}
	parser = heap_allocate(heap, Parser);
	parser->buffer = vec_create(char, heap);
	parser->column = -1;
	parser->file = file;
	parser->flags = flags;
	parser->gen_file = (Stdio)0;
	parser->heap = heap;
	parser->loop_number = 0;
	parser->keywords = keyword_table_get(heap);
	parser->msg = msg;
	parser->level = 0;
	parser->levels = vec_create(Node, heap);
	parser->operators = parser_operators();
	parser->out_file = (Stdio)0;
	parser->parameter_table = table_create(Str, Type_ref,
					       10, strequal, strhash,
					       (Type_ref)0, heap);
	parser->peek_token = TOKEN_NONE;
	parser->previous = TOKEN_NONE;
	parser->type_tables = type_tables;
	return parser;
}

/*
 * parser_indented_list_parse(parser, routine, message)
 *	This routine will start a new lexical level and repeatedly call
 *	"routine(parser)" to get successive nodes until "end-of-file" is
 *	encountered.  Any indentation errors are detected and skipped over.
 *	A list node of type "type" contining the node list is returned.
 *	If "message" is not equal to (Str)0 and the resultant node list
 *	is empty, "message" is emited as an error message.
 */
Vec(Pointer)
parser_indented_list_parse(
	Parser		parser,
	Parser_routine	routine,
	Str		message)
{
	Heap		heap;
	Pointer		item;
	Vec(Pointer)	list;

	heap = parser->heap;
	list = vec_create(Pointer, heap);
	PARSER_LOOP(parser) {
		item = (*routine)(parser);
		if (item != (Pointer)0) {
			vec_append(Pointer, list, item);
		}
	}
	if (vec_empty(Pointer, list)) {
		msg_out(parser->msg, parser->file->position, message);
	}
	return list;
}

/*
 * parser_keyword_parse(parser, eol_ok, none_ok)
 *	This routine will return the next keyword read from "parser".  If
 *	eol_ok is 1 and the next token is an end-of-line, Key_eol is returned;
 *	otherwise and error is generted.  If "none_ok" is 1 and the next token
 *	is neither a keyword nor an end-of-line, Key_none is returned;
 *	otherwise, an error is generated.
 */
Keyword
parser_keyword_parse(
	Parser		parser,
	int		eol_ok,
	int		none_ok)
{
	Token		token;
	Keyword		keyword;
	
	token = parser_token_peek(parser);
	switch (token->type) {
	    case Token_type_eol:
		if (eol_ok) {
			return Key_eol;
		} else {
			goto error;
		}
	    case Token_type_symbol:
		keyword =  table_lookup(Str, Keyword,
				 	parser->keywords, token->value.symbol);
		if (keyword != Key_none) {
			(void)parser_token_read(parser);
			return keyword;
		} else if (none_ok) {
			return Key_none;
		} else {
			goto error;
		}
	    default:
		if (!none_ok) {
			goto error;
		}
		return Key_none;
	}
    error:
	msg_out(parser->msg, parser->file->position,
		     "Keyword expected but not found");
	return Key_none;
}

/*
 * parser_loop_init(parser)
 *	This routine will start a new level of indentation on "parser".  The
 *	next character in "parser" should be at the beginning of a line.
 */
void
parser_loop_init(
	Parser		parser)
{
	int		column;
	int		level;

	level = parser->level;
	column = parser_column_read(parser);
	parser->level = column;
	if (column <= level) {
		msg_out(parser->msg, parser->file->position,
			     "Missing indentation level");
		parser->level++;
	}
	vec_append(int, parser->levels, level);
	parser->column = column;
}

/*
 * parser_loop_next(parser)
 *	This routine will return 1 if the next statement is at the same
 *	indentation level.  0 is returned if the next statement is at
 *	lesser indentation.  If a greater indentation level is encountered,
 *	an error message is generated and it is skipped over.  The next
 *	character in "parser" should be at the beginning of a line.
 */
int
parser_loop_next(
	Parser		parser)
{
	int		chr;
	int		column;
	int		error_printed;
	File		file;
	int		level;
	Msg		msg;
	int		position;

	error_printed = 0;
	file = parser->file;
	level = parser->level;
	msg = parser->msg;
	for (;;) {
		column = parser_column_read(parser);
		if (column == level) {
			if ((level == 0) && (file_chr_peek(file) == EOF)) {
				if (parser->gen_file != (Stdio)0) {
					(void)fclose(parser->gen_file);
					parser->gen_file = (Stdio)0;
					position = file->position;
					file = file_open(
						parser->flags->gen_file->full,
						1, parser->heap);
					file->position = position;
					parser->file = file;
					parser->msg->position_split = position;
					continue;
				}
				return 0;
			} else {
				return 1;
			}
		}
		if (column < level) {
			parser->column = column;
			parser->level = vec_pop(int, parser->levels);
			return 0;
		}
		if (!error_printed) {
			error_printed = 1;
			msg_out(parser->msg, (parser->previous == TOKEN_NONE) ?
						parser->file->position :
						parser->previous->position,
						"Extraneous indentation level");
		}
		do {
			chr = file_chr_read(file);
		} while ((chr != '\n') && (chr != EOF));
		if (chr == '\n') {
			msg_line_append(msg, file->position);
		}
	}
	/* NOTREACHED */
}

/*
 * parser_operators()
 *	This routine will return a vector flags for each lexical type.
 */
Str
parser_operators(PORT_NO_ARGS)
{
	static char	operators[Token_type_size];

	int		index;

	operators[(int)Token_type_add] = PARSER_PREC_ADD;
	operators[(int)Token_type_add_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_add_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_and] = PARSER_PREC_AND;
	operators[(int)Token_type_and_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_and_if] = PARSER_PREC_AND_IF;
	operators[(int)Token_type_and_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_at] = PARSER_PREC_AT;
	operators[(int)Token_type_at_parenthesis] = PARSER_PREC_DOT;
	operators[(int)Token_type_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_colon] = PARSER_PREC_COLON;
	operators[(int)Token_type_comma] = PARSER_PREC_COMMA;
	operators[(int)Token_type_decrement] = PARSER_PREC_UNARY;
	operators[(int)Token_type_define] = PARSER_PREC_DEFINE;
	operators[(int)Token_type_define_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_define_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_dot] = PARSER_PREC_DOT;
	operators[(int)Token_type_equal] = PARSER_PREC_EQUAL;
	operators[(int)Token_type_divide] = PARSER_PREC_MULTIPLY;
	operators[(int)Token_type_divide_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_divide_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_eol] = PARSER_PREC_END;
	operators[(int)Token_type_greater_than] = PARSER_PREC_COMPARE;
	operators[(int)Token_type_greater_than_or_equal] = PARSER_PREC_COMPARE;
	operators[(int)Token_type_identical] = PARSER_PREC_IDENTICAL;
	operators[(int)Token_type_increment] = PARSER_PREC_UNARY;
	operators[(int)Token_type_integer] = PARSER_PREC_LEAF;
	operators[(int)Token_type_if] = PARSER_PREC_IF;
	operators[(int)Token_type_left_bracket] = PARSER_PREC_CALL;
	operators[(int)Token_type_left_paren] = PARSER_PREC_CALL;
	operators[(int)Token_type_left_shift] = PARSER_PREC_SHIFT;
	operators[(int)Token_type_left_shift_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_left_shift_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_less_than] = PARSER_PREC_COMPARE;
	operators[(int)Token_type_less_than_or_equal] = PARSER_PREC_COMPARE;
	operators[(int)Token_type_not] = PARSER_PREC_UNARY;
	operators[(int)Token_type_not_equal] = PARSER_PREC_EQUAL;
	operators[(int)Token_type_not_identical] = PARSER_PREC_EQUAL;
	operators[(int)Token_type_multiply] = PARSER_PREC_MULTIPLY;
	operators[(int)Token_type_multiply_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_multiply_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_or] = PARSER_PREC_OR;
	operators[(int)Token_type_or_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_or_if] = PARSER_PREC_OR_IF;
	operators[(int)Token_type_or_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_power] = PARSER_PREC_POWER;
	operators[(int)Token_type_power_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_power_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_remainder] = PARSER_PREC_MULTIPLY;
	operators[(int)Token_type_remainder_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_remainder_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_right_bracket] = PARSER_PREC_END;
	operators[(int)Token_type_right_paren] = PARSER_PREC_END;
	operators[(int)Token_type_right_shift] = PARSER_PREC_SHIFT;
	operators[(int)Token_type_right_shift_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_right_shift_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_string] = PARSER_PREC_LEAF;
	operators[(int)Token_type_subtract] = PARSER_PREC_ADD;
	operators[(int)Token_type_subtract_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_subtract_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_symbol] = PARSER_PREC_LEAF;
	operators[(int)Token_type_text] = PARSER_PREC_LEAF;
	operators[(int)Token_type_twiddle] = PARSER_PREC_DOT;
	operators[(int)Token_type_xor] = PARSER_PREC_XOR;
	operators[(int)Token_type_xor_assign] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_xor_result] = PARSER_PREC_ASSIGN;
	operators[(int)Token_type_zilch] = PARSER_PREC_LEAF;

	for (index = 0; index < (int)Token_type_size; index++) {
		if (operators[index] == 0) {
			out(stderr, "Unitinialized token %d\n", index);
		}
	}

	return operators;
}

/*
 * parser_string_parse(parser, token)
 *	This routine will
 */
static void
parser_string_parse(
	Parser		parser,
	Token		token)
{
	Vec(char)	buffer;
	int		chr;
	File		file;
	int		index;
	int		quote_chr;
	int		size;
	Str		string;

	file = parser->file;
	quote_chr = file_chr_read(file);
	token->type = (quote_chr == '"') ? Token_type_string : Token_type_text;
	token->value.string = "";
	buffer = parser->buffer;
	vec_trim(char, buffer, 0);
	for (;;) {
		chr = file_chr_peek(file);
		switch (chr) {
		    case EOF:
		    case '\n':
			msg_out(parser->msg, token->position,
				"Unterminated string");
			return;
		    case '\t':
			msg_out(parser->msg, token->position,
				"Tab character found in string,"
				" use `\\t\\' instead");
			return;
		    case '"':
		    case '\'':
			if (chr == quote_chr) {
				goto done;
			}
			(void)file_chr_read(file);
			vec_append(char, buffer, chr);
			break;
		    case '\\':
			(void)file_chr_read(file);
			chr = file_chr_peek(file);
			if (chr == '\\') {
				(void)file_chr_read(file);
				vec_append(char, buffer, '\\');
				continue;
			}
			for (;;) {
				chr = file_chr_peek(file);
				if (isdigit(chr)) {
					int	digit;
					int	number;
					int	radix;

					radix = 10;
					if (chr == '0') {
						radix = 8;
						(void)file_chr_read(file);
						chr = file_chr_peek(file);
						if ((chr == 'x') ||
						    (chr == 'X')) {
							radix = 16;
							(void)file_chr_read(
									file);
							chr = file_chr_peek(
									file);
						}
					}
					number = 0;
					for (;;) {
						if (('0' <= chr) &&
						    (chr <= '9')) {
							digit = chr - '0';
						} else if (('a' <= chr) &&
							   (chr <= 'f')) {
							digit = 10 + chr - 'a';
						} else if (('A' <= chr) &&
							   (chr <= 'F')) {
							digit = 16 + chr - 'A';
						} else {
							break;
						}
						number = number * radix + digit;
						(void)file_chr_read(file);
						chr = file_chr_peek(file);
					}
					vec_append(char, buffer, number);
				} else if (isalpha(chr)) {
					(void)file_chr_read(file);
					switch (chr) {
					    case 't':
						chr = '\t';
						break;
					    case 'n':
						chr = '\n';
						break;
					    case 'q':
						chr = quote_chr;
						break;
					    default:
						msg_out(parser->msg,
							token->position,
							"Bad escape character");
						return;
					}
					vec_append(char, buffer, chr);
				} else {
					/* Illegal character in escape: */
					msg_out(parser->msg,
					  token->position,
					  "Illegal character in string escape");
					return;
				}

				/* See whether to get another character: */
				chr = file_chr_peek(file);
				if (chr == ',') {
					(void)file_chr_read(file);
				} else if (chr == '\\') {
					(void)file_chr_read(file);
					break;
				} else {
					msg_out(parser->msg, token->position,
						"Bad escape sequence");
					return;
				}
			}
			break;
		    default:
			if (isprint(chr)) {
				chr = file_chr_read(file);
				vec_append(char, buffer, chr);
			} else {
				msg_out(parser->msg, token->position,
					"Non-printing character in string");
				return;
			}
		}
	}

    done:
	(void)file_chr_read(file);

	/* Create the final string: */
	size = vec_size(char, buffer);
	string = (Str)heap_alloc(parser->heap, size + 1);
	for (index = 0; index < size; index++) {
		string[index] = (char)vec_fetch(int, buffer, index);
	}
	string[size] = '\0';
	token->value.string = string;
}

/*
 * parser_symbol_parse(parser)
 *	This routine will read a symbol from "parser" or emit an error.
 */
Token
parser_symbol_parse(
	Parser		parser)
{
	Token		token;

	token = parser_token_peek(parser);
	if (token->type == Token_type_symbol) {
		(void)parser_token_read(parser);
		return token;
	} else {
		msg_out(parser->msg, parser->file->position,
			"Could not find identifier");
		token->type = Token_type_symbol;
		token->value.symbol = "";
		return token;
	}
}

/*
 * parser_token_create(heap)
 *	This routine will create and return a new token.
 */
Token
parser_token_create(
	Heap		heap)
{
	Token		token;

	token = heap_allocate(heap, Token);
	token->type = Token_type_integer;
	token->value.integer = 0;
	return token;
}

/*
 * parser_token_peek(parser)
 *	This routine will return the next lexical token from "parser" without
 *	actually reading it.
 */
Token
parser_token_peek(
	Parser		parser)
{
	if (parser->peek_token == TOKEN_NONE) {
		parser->peek_token = parser_token_read(parser);
	}
	return parser->peek_token;
}

/*
 * parser_token_read(parser)
 *	This routine will read and return the next lexical token from "parser".
 */
Token
parser_token_read(
	Parser		parser)
{
	Token_type	assign;
	int		chr;
	int		column;
	File		file;
	File_integer	file_integer;
	int		is_result;
	Msg		msg;
	Token		previous;
	Token_type	result;
	Token		token;

	if (parser->peek_token != TOKEN_NONE) {
		token = parser->peek_token;
		parser->peek_token = TOKEN_NONE;
		parser->previous = token;
		return token;
	}
	previous = parser->previous;
	token = parser_token_create(parser->heap);
	file = parser->file;
	msg = parser->msg;
	for (;;) {
		chr = file_chr_peek(file);
		token->position = file->position;
		switch (chr) {
		    case '\n':
			/* Only parser_eol_read() can advance over '\n' */
			if ((previous != TOKEN_NONE) &&
			    ((parser->operators[(int)previous->type] &
						PARSER_BINARY) != 0)) {
				(void)file_chr_read(file);
				msg_line_append(msg, file->position);
				column = parser_column_read(parser);
				if (column > parser->level) {
					continue;
				} else {
					parser->column = column;
					msg_out(parser->msg, token->position,
						  "Bad continuation line");
					(void)parser_eol_read(parser);
				}
			}
			token->type = Token_type_eol;
			return token;
		    case EOF:
		    case ';':
		    case '#':
			token->type = Token_type_eol;
			return token;
		    case '\t':
		    case ' ':
			(void)file_chr_read(file);
			break;
		    case '!':
			(void)file_chr_read(file);
			chr = file_chr_peek(file);
			if (chr == '=') {
				token->type = Token_type_not_equal;
				(void)file_chr_read(file);
				chr = file_chr_peek(file);
				if (chr == '=') {
					token->type = Token_type_not_identical;
					(void)file_chr_read(file);
				}
			} else {
				token->type = Token_type_not;
			}
			return token;
		    case '%':
			token->type = Token_type_remainder;
			(void)file_chr_read(file);
			return token;
		    case '&':
			(void)file_chr_read(file);
			chr = file_chr_peek(file);
			if (chr == '&') {
				token->type = Token_type_and_if;
				(void)file_chr_read(file);
			} else {
				token->type = Token_type_and;
			}
			return token;
		    case '(':
			token->type = Token_type_left_paren;
			(void)file_chr_read(file);
			return token;
		    case ')':
			token->type = Token_type_right_paren;
			(void)file_chr_read(file);
			return token;
		    case '*':
			(void)file_chr_read(file);
			chr = file_chr_peek(file);
			if (chr == '*') {
				token->type = Token_type_power;
				(void)file_chr_read(file);
			} else {
				token->type = Token_type_multiply;
			}
			return token;
		    case '+':
			(void)file_chr_read(file);
			chr = file_chr_peek(file);
			if (chr == '+') {
				token->type = Token_type_increment;
				(void)file_chr_read(file);
			} else {
				token->type = Token_type_add;
			}
			return token;
		    case ',':
			token->type = Token_type_comma;
			(void)file_chr_read(file);
			return token;
		    case '-':
			(void)file_chr_read(file);
			chr = file_chr_peek(file);
			if (chr == '-') {
				token->type = Token_type_decrement;
				(void)file_chr_read(file);
			} else {
				token->type = Token_type_subtract;
			}
			return token;
		    case '.':
			token->type = Token_type_dot;
			(void)file_chr_read(file);
			return token;
		    case '/':
			token->type = Token_type_divide;
			(void)file_chr_read(file);
			return token;
		    case ':':
			token->type = Token_type_colon;
			chr = file_chr_read_peek(file);
			if (chr == ':') {
				is_result = 1;
				chr = file_chr_read_peek(file);
			} else {
				is_result = 0;
			}
			switch (chr) {
			    case '=':
				(void)file_chr_read(file);
				token->type = (is_result ? Token_type_result :
							   Token_type_assign);
				return token;
			    case '%':
				assign = Token_type_remainder_assign;
				result = Token_type_remainder_result;
				break;
			    case '&':
				assign = Token_type_and_assign;
				result = Token_type_and_result;
				break;
			    case '*':
				chr = file_chr_read_peek(file);
				if (chr == '*') {
					(void)file_chr_read(file);
					assign = Token_type_power_assign;
					result = Token_type_power_result;
				} else {
					assign = Token_type_multiply_assign;
					result = Token_type_multiply_result;
				}
				break;
			    case '+':
				assign = Token_type_add_assign;
				result = Token_type_add_result;
				break;
			    case '-':
				assign = Token_type_subtract_assign;
				result = Token_type_subtract_result;
				break;
			    case '/':
				assign = Token_type_divide_assign;
				result = Token_type_divide_result;
				break;
			    case '<':
				chr = file_chr_read_peek(file);
				if (chr == '<') {
					assign = Token_type_left_shift_assign;
					result = Token_type_left_shift_result;
					break;
				}
				token->type = Token_type_left_shift_assign;
				msg_out(parser->msg, token->position,
					     "Bad operator");
				return token;
			    case '>':
				chr = file_chr_read_peek(file);
				if (chr == '>') {
					assign = Token_type_right_shift_assign;
					result = Token_type_right_shift_result;
					break;
				}
				token->type = Token_type_right_shift_assign;
				msg_out(parser->msg, token->position,
					     "Bad operator");
				return token;
			    case '@':
				assign = Token_type_define_assign;
				result = Token_type_define_result;
				break;
			    case '^':
				assign = Token_type_xor_assign;
				result = Token_type_xor_result;
				break;
			    case '|':
				assign = Token_type_or_assign;
				result = Token_type_or_result;
				break;
			    default:
				token->type = is_result ? Token_type_define :
							  Token_type_colon;
				return token;
			}
			token->type = (is_result ? result : assign);
			chr = file_chr_read_peek(file);
			if (chr == '=') {
				(void)file_chr_read(file);
			} else {
				msg_out(parser->msg, token->position,
					  "Bad assignment operator");
			}
			return token;
		    case '<':
			(void)file_chr_read(file);
			chr = file_chr_peek(file);
			if (chr == '=') {
				token->type = Token_type_less_than_or_equal;
				(void)file_chr_read(file);
			} else if (chr == '<') {
				token->type = Token_type_left_shift;
				(void)file_chr_read(file);
			} else {
				token->type = Token_type_less_than;
			}
			return token;
		    case '=':
			(void)file_chr_read(file);
			chr = file_chr_peek(file);
			if (chr == '=') {
				token->type = Token_type_identical;
				(void)file_chr_read(file);
			} else {
				token->type = Token_type_equal;
			}
			return token;
		    case '>':
			(void)file_chr_read(file);
			chr = file_chr_peek(file);
			if (chr == '=') {
				token->type = Token_type_greater_than_or_equal;
				(void)file_chr_read(file);
			} else if (chr == '>') {
				token->type = Token_type_right_shift;
				(void)file_chr_read(file);
			} else {
				token->type = Token_type_greater_than;
			}
			return token;
		    case '?':
			(void)file_chr_read(file);
			if (file_chr_peek(file) == '?') {
				(void)file_chr_read(file);
				token->type = Token_type_zilch;
			} else {
				token->type = Token_type_if;
			}
			return token;
		    case '@':
			(void)file_chr_read(file);
			if (file_chr_peek(file) == '(') {
				(void)file_chr_read(file);
				token->type = Token_type_at_parenthesis;
			} else {
				token->type = Token_type_at;
			}
			return token;
		    case '[':
			token->type = Token_type_left_bracket;
			(void)file_chr_read(file);
			return token;
		    case ']':
			token->type = Token_type_right_bracket;
			(void)file_chr_read(file);
			return token;
		    case '^':
			token->type = Token_type_xor;
			(void)file_chr_read(file);
			return token;
		    case '|':
			(void)file_chr_read(file);
			chr = file_chr_peek(file);
			if (chr == '|') {
				token->type = Token_type_or_if;
				(void)file_chr_read(file);
			} else {
				token->type = Token_type_or;
			}
			return token;
		    case '\'':
		    case '"':
			parser_string_parse(parser, token);
			return token;
		    case '0':
		    case '1':
		    case '2':
		    case '3':
		    case '4':
		    case '5':
		    case '6':
		    case '7':
		    case '8':
		    case '9':
			token->type = Token_type_integer;
			token->value.integer =
				file_integer_read(file, &file_integer);
			switch (file_integer) {
			    case File_integer_decimal:
			    case File_integer_hexadecimal:
			    case File_integer_octal:
				break;
			    case File_integer_bad_digit:
				msg_out(parser->msg, token->position,
					  "Bad digit in integer");
				break;
			    default:
				msg_out(parser->msg, token->position,
					     "Bad integer");
			}
			return token;
		    case '~':
			token->type = Token_type_twiddle;
			(void)file_chr_read(file);
			return token;
		    default:
			if (isalpha(chr)) {
				token->type = Token_type_symbol;
				token->value.symbol = file_symbol_read(file,
						FILE_SYMBOL_NONE, parser->heap);
				return token;
			} else {
				msg_out(parser->msg, token->position,
					  "Illegal character");
				(void)file_chr_read(file);
			}
		}
	}
	/* NOTREACHED */
}

/*
 * parser_untranslated_string_read(parser)
 *	This routine will parse a string enclosed in double quotes from
 *	"parser" and return it.  If no such string is encountered, an
 *	error message is output and (Str)0 is returned.
 */
Str
parser_untranslated_string_read(
	Parser		parser)
{
	Token		token;

	token = parser_token_peek(parser);
	switch (token->type) {
	    case Token_type_string:
		(void)parser_token_read(parser);
		return token->value.string;
	    case Token_type_text:
		msg_out(parser->msg, token->position,
			"Only untranslated strings (in double quotes)"
			" are permitted");
		break;
	    default:
		msg_out(parser->msg, token->position,
			"Missing untranslated string");
		break;
	}
	return (Str)0;
}