firebird-mirror/src/qli/lex.cpp

/*
 *	PROGRAM:	JRD Command Oriented Query Language
 *	MODULE:		lex.c
 *	DESCRIPTION:	Lexical analyser
 *
 * The contents of this file are subject to the Interbase Public
 * License Version 1.0 (the "License"); you may not use this file
 * except in compliance with the License. You may obtain a copy
 * of the License at http://www.Inprise.com/IPL.html
 *
 * Software distributed under the License is distributed on an
 * "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express
 * or implied. See the License for the specific language governing
 * rights and limitations under the License.
 *
 * The Original Code was created by Inprise Corporation
 * and its predecessors. Portions created by Inprise Corporation are
 * Copyright (C) Inprise Corporation.
 *
 * All Rights Reserved.
 * Contributor(s): ______________________________________.
 *
 * 2002.10.30 Sean Leyne - Removed support for obsolete "PC_PLATFORM" define
 *
 */

#include "firebird.h"
#include "../jrd/ib_stdio.h"
#include <errno.h>
#include <string.h>
#include <stdlib.h>
#include "../qli/dtr.h"
#include "../qli/parse.h"
#include "../jrd/gds.h"
#include "../qli/all_proto.h"
#include "../qli/err_proto.h"
#include "../qli/hsh_proto.h"
#include "../qli/lex_proto.h"
#include "../qli/proc_proto.h"
#include "../jrd/gds_proto.h"
#include "../jrd/utl_proto.h"

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

#ifdef HAVE_CTYPES_H
#include <ctypes.h>
#endif

#ifdef VMS
#include <descrip.h>
#define LIB$_INPSTRTRU	0x15821c
#endif

#ifdef UNIX
#define UNIX_LINE	1
#endif

#if (defined WIN_NT)
#include <io.h>
#define UNIX_LINE	1
#define PC_FILE_SEEK
#endif

#ifdef SMALL_FILE_NAMES
#define SCRATCH		"fb_q"
#else
#define SCRATCH		"fb_query_"
#endif

#ifndef FOPEN_INPUT_TYPE
#define FOPEN_INPUT_TYPE	"r"
#endif

extern bool sw_verify;
extern bool sw_trace;

static bool get_line(IB_FILE *, TEXT *, USHORT);
static int nextchar(bool);
static void next_line(bool);
static void retchar(SSHORT);
static bool scan_number(SSHORT, TEXT **);
static int skip_white(void);

static LLS QLI_statements;
static int QLI_position;
static IB_FILE *input_file = NULL, *trace_file = NULL;
static UCHAR trace_file_name[128];
static SLONG trans_limit;

#define TRANS_LIMIT	10

#define CHR_ident	1
#define CHR_letter	2
#define CHR_digit	4
#define CHR_quote	8
#define CHR_white	16
#define CHR_eol		32

#define CHR_IDENT	CHR_ident
#define CHR_LETTER	CHR_letter + CHR_ident
#define CHR_DIGIT	CHR_digit + CHR_ident
#define CHR_QUOTE	CHR_quote
#define CHR_WHITE	CHR_white
#define CHR_EOL		CHR_eol

#ifdef NOT_USED_OR_REPLACED
static SCHAR *eol_string = "*end_of_line*";
#endif
static SCHAR *eof_string = "*end_of_file*";

static SCHAR classes[256] = {
	0, 0, 0, 0, 0, 0, 0, 0,
	0, CHR_WHITE, CHR_EOL, 0, 0, 0, 0, 0,
	0, 0, 0, 0, 0, 0, 0, 0,
	0, 0, 0, 0, 0, 0, 0, 0,
	CHR_WHITE, 0, CHR_QUOTE, CHR_IDENT, CHR_LETTER, 0, 0, CHR_QUOTE,
	0, 0, 0, 0, 0, 0, 0, 0,
	CHR_DIGIT, CHR_DIGIT, CHR_DIGIT, CHR_DIGIT, CHR_DIGIT, CHR_DIGIT,
		CHR_DIGIT, CHR_DIGIT,
	CHR_DIGIT, CHR_DIGIT, 0, 0, 0, 0, 0, 0,
	0, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER,
		CHR_LETTER,
	CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER,
		CHR_LETTER, CHR_LETTER,
	CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER,
		CHR_LETTER, CHR_LETTER,
	CHR_LETTER, CHR_LETTER, CHR_LETTER, 0, 0, 0, 0, CHR_IDENT,
	0, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER,
		CHR_LETTER,
	CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER,
		CHR_LETTER, CHR_LETTER,
	CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER, CHR_LETTER,
		CHR_LETTER, CHR_LETTER,
	CHR_LETTER, CHR_LETTER, CHR_LETTER, 0
};



bool LEX_active_procedure(void)
{
/**************************************
 *
 *	L E X _ a c t i v e _ p r o c e d u r e
 *
 **************************************
 *
 * Functional description
 *	Return true if we're running out of a
 *	procedure and false otherwise.  Somebody
 *	somewhere may care.
 *
 **************************************/

	return (QLI_line->line_type == line_blob);
}


void LEX_edit( SLONG start, SLONG stop)
{
/**************************************
 *
 *	L E X _ e d i t
 *
 **************************************
 *
 * Functional description
 *	Dump the last full statement into a scratch file, then
 *	push the scratch file on the input stack.
 *
 **************************************/
	IB_FILE *scratch;
	TEXT filename[128];
	SSHORT c;

	scratch = (IB_FILE *) gds__temp_file(TRUE, SCRATCH, filename);
	if (scratch == (IB_FILE *) - 1)
		IBERROR(61);			/* Msg 61 couldn't open scratch file */
#ifdef WIN_NT
	stop--;
#endif

	if (ib_fseek(trace_file, start, 0)) {
		ib_fseek(trace_file, (SLONG) 0, 2);
		IBERROR(59);			// Msg 59 ib_fseek failed 
	}

	while (++start <= stop) {
		c = ib_getc(trace_file);
		if (c == EOF)
			break;
		ib_putc(c, scratch);
	}

	ib_fclose(scratch);

	if (gds__edit(filename, TRUE))
		LEX_push_file(filename, true);

	unlink(filename);

	ib_fseek(trace_file, (SLONG) 0, 2);
}


TOK LEX_edit_string(void)
{
/**************************************
 *
 *	L E X _ e d i t _ s t r i n g
 *
 **************************************
 *
 * Functional description
 *	Parse the next token as an edit_string.
 *
 **************************************/
	TOK token;
	SSHORT c, d;
	TEXT *p;

	token = QLI_token;

	do
		c = skip_white();
	while (c == '\n');
	p = token->tok_string;
	*p = c;

	if (!QLI_line) {
		token->tok_symbol = NULL;
		token->tok_keyword = KW_none;
		return NULL;
	}

	while (!(classes[c] & (CHR_white | CHR_eol))) {
		*p++ = c;
		if (classes[c] & CHR_quote)
			for (;;) {
				if ((d = nextchar(false)) == '\n') {
					retchar(d);
					break;
				}
				*p++ = d;
				if (d == c)
					break;
			}
		c = nextchar(true);
	}

	retchar(c);

	if (p[-1] == ',')
		retchar(*--p);

	token->tok_length = p - token->tok_string;
	*p = 0;
	token->tok_symbol = NULL;
	token->tok_keyword = KW_none;

	if (sw_trace)
		ib_puts(token->tok_string);

	return token;
}


TOK LEX_filename(void)
{
/**************************************
 *
 *	L E X _ f i l e n a m e
 *
 **************************************
 *
 * Functional description
 *	Parse the next token as a filename.
 *
 **************************************/
	TOK token;
	SSHORT c, save;
	USHORT class_;
	TEXT *p;

	token = QLI_token;

	do
		c = skip_white();
	while (c == '\n');
	p = token->tok_string;
	*p++ = c;

/* If there isn't a line, we're all done */

	if (!QLI_line) {
		token->tok_symbol = NULL;
		token->tok_keyword = KW_none;
		return NULL;
	}

// notice if this looks like a quoted file name 

	if (classes[c] & CHR_quote) {
		token->tok_type = tok_quoted;
		save = c;
	}
	else
		save = 0;

// Look for white space or end of line, allowing embedded quoted strings. 

	for (;;) {
		c = nextchar(true);
		class_ = classes[c];
		if (c == '"' && c != save) {
			*p++ = c;
			for (;;) {
				c = nextchar(true);
				class_ = classes[c];
				if ((class_ & CHR_eol) || c == '"')
					break;
				*p++ = c;
			}
		}

		if (class_ & (CHR_white | CHR_eol))
			break;
		*p++ = c;
	}

	retchar(c);

// Drop trailing semi-colon to avoid confusion 

	if (p[-1] == ';') {
		retchar(c);
		--p;
	}

// complain on unterminated quoted string 

	if ((token->tok_type == tok_quoted) && (p[-1] != save))
		IBERROR(60);			// Msg 60 unterminated quoted string 

	token->tok_length = p - token->tok_string;
	*p = 0;
	token->tok_symbol = NULL;
	token->tok_keyword = KW_none;

	if (sw_trace)
		ib_puts(token->tok_string);

	return token;
}


void LEX_fini(void)
{
/**************************************
 *
 *	L E X _ f i n i
 *
 **************************************
 *
 * Functional description
 *	Shut down LEX in a more or less clean way.
 *
 **************************************/

	if (trace_file && (trace_file != (IB_FILE *) - 1)) {
		ib_fclose(trace_file);
		unlink((char*) trace_file_name);
	}
}


void LEX_flush(void)
{
/**************************************
 *
 *	L E X _ f l u s h
 *
 **************************************
 *
 * Functional description
 *	Flush the input stream after an error.  
 *
 **************************************/

	trans_limit = 0;

	if (!QLI_line)
		return;

/* Pop off line sources until we're down to the last one. */

	while (QLI_line->line_next)
		LEX_pop_line();

// Look for a semi-colon 

	if (QLI_semi)
		while (QLI_line && QLI_token->tok_keyword != KW_SEMI)
			LEX_token();
	else
		while (QLI_line && QLI_token->tok_type != tok_eol)
			LEX_token();
}


#ifdef UNIX_LINE
bool LEX_get_line(TEXT * prompt,
				  TEXT * buffer,
				  int size)
{
/**************************************
 *
 *	L E X _ g e t _ l i n e  ( U N I X )
 *
 **************************************
 *
 * Functional description
 *	Give a prompt and read a line.  If the line is terminated by
 *	an EOL, return true.  If the buffer is exhausted and non-blanks
 *	would be discarded, return an error.  If EOF is detected,
 *	return false.  Regardless, a null terminated string is returned.
 *
 **************************************/
	TEXT *p;
	bool overflow_flag = false;
	SSHORT c;

// UNIX flavor 

	if (prompt)
		ib_printf(prompt);

	errno = 0;
	p = buffer;

	while (true) {
		c = ib_getc(input_file);
		if (c == EOF) {
			if (SYSCALL_INTERRUPTED(errno) && !QLI_abort) {
				errno = 0;
				continue;
			}

			/* The check for this actually being a terminal that is at
			   end of file is to prevent looping through a redirected
			   ib_stdin (e.g., a script file).  */

			if (prompt && isatty(ib_fileno(ib_stdin))) {
				ib_rewind(ib_stdin);
				ib_putchar('\n');
			}
			if (QLI_abort)
				continue;
			else
				break;
		}
		if (--size > 0)
			*p++ = c;
		else if (c != ' ' && c != '\n')
			overflow_flag = true;
		if (c == '\n')
			break;
	}

	*p = 0;
	if (c == EOF)
		return false;

	if (overflow_flag) {
		buffer[0] = 0;
		IBERROR(476);			// Msg 476 input line too long 
	}

	if (sw_verify)
		ib_fputs(buffer, ib_stdout);

	return true;
}
#endif


#ifdef VMS
bool LEX_get_line(TEXT * prompt,
				  TEXT * buffer,
				  int size)
{
/**************************************
 *
 *	L E X _ g e t _ l i n e  ( V M S )
 *
 **************************************
 *
 * Functional description
 *	Give a prompt and read a line.  If the line is terminated by
 *	an EOL, return true.  If the buffer is exhausted and non-blanks
 *	would be discarded, return an error.  If EOF is detected,
 *	return false.  Regardless, a null terminated string is returned.
 *
 **************************************/
	struct dsc$descriptor_s line_desc, prompt_desc;
	SLONG status;
	SSHORT length;
	SCHAR *p;

/* We're going to add a null to the end, so don't read too much */

	--size;

	line_desc.dsc$b_class = DSC$K_CLASS_S;
	line_desc.dsc$b_dtype = DSC$K_DTYPE_T;
	line_desc.dsc$w_length = size;
	line_desc.dsc$a_pointer = buffer;

	if (prompt) {
		prompt_desc.dsc$b_class = DSC$K_CLASS_S;
		prompt_desc.dsc$b_dtype = DSC$K_DTYPE_T;
		prompt_desc.dsc$w_length = strlen(prompt);
		prompt_desc.dsc$a_pointer = prompt;
		status = lib$get_input(&line_desc, &prompt_desc, &length);
	}
	else
		status = lib$get_input(&line_desc, NULL, &length);

	p = buffer + length;

	if (!(status & 1)) {
		if (status != LIB$_INPSTRTRU)
			return false;
		buffer[0] = 0;
		IBERROR(476);			// Msg 476 input line too long 
	}
	else if (length < size)
		*p++ = '\n';

	*p = 0;

	if (sw_verify) {
		line_desc.dsc$w_length = length;
		lib$put_output(&line_desc);
	}

	return true;
}
#endif


void LEX_init(void)
{
/**************************************
 *
 *	L E X _ i n i t
 *
 **************************************
 *
 * Functional description
 *	Initialize for lexical scanning.  While we're at it, open a
 *	scratch trace file to keep all input.
 *
 **************************************/

	trace_file = (IB_FILE*) gds__temp_file(TRUE, SCRATCH, (TEXT*) trace_file_name);
	if (trace_file == (IB_FILE *) - 1)
		IBERROR(61);			/* Msg 61 couldn't open scratch file */

	QLI_token = (TOK) ALLOCPV(type_tok, MAXSYMLEN);

	QLI_line = (LINE) ALLOCPV(type_line, 0);
	QLI_line->line_size = sizeof(QLI_line->line_data);
	QLI_line->line_ptr = QLI_line->line_data;
	QLI_line->line_type = line_stdin;
	QLI_line->line_source = (FRBRD *) ib_stdin;

	QLI_semi = FALSE;
	input_file = ib_stdin;
	HSH_init();
}


void LEX_mark_statement(void)
{
/**************************************
 *
 *	L E X _ m a r k _ s t a t e m e n t
 *
 **************************************
 *
 * Functional description
 *	Push a position in the trace file onto
 *	the statement stack.
 *
 **************************************/
	LLS statement;
	LINE temp;

	for (temp = QLI_line;
		 temp->line_next && QLI_statements;
		 temp = temp->line_next)
if (temp->line_next->line_position == (SLONG) QLI_statements->lls_object) return;

	statement = (LLS) ALLOCP(type_lls);
	statement->lls_object = (BLK) temp->line_position;
	statement->lls_next = QLI_statements;
	QLI_statements = statement;
}


void LEX_pop_line(void)
{
/**************************************
 *
 *	L E X _ p o p _ l i n e
 *
 **************************************
 *
 * Functional description
 *	We're done with the current line source.  Close it out
 *	and release the line block.
 *
 **************************************/
	LINE temp;

	temp = QLI_line;
	QLI_line = temp->line_next;

	if (temp->line_type == line_blob)
		PRO_close(temp->line_database, temp->line_source);
	else if (temp->line_type == line_file)
		ib_fclose((IB_FILE *) temp->line_source);

	ALL_release((FRB) temp);
}


void LEX_procedure( DBB database, FRBRD *blob)
{
/**************************************
 *
 *	L E X _ p r o c e d u r e
 *
 **************************************
 *
 * Functional description
 *	Push a blob-resident procedure onto the input line source
 *	stack;
 *
 **************************************/
	LINE temp;

	temp = (LINE) ALLOCPV(type_line, QLI_token->tok_length);
	temp->line_source = blob;
	strncpy(temp->line_source_name, QLI_token->tok_string,
			QLI_token->tok_length);
	temp->line_type = line_blob;
	temp->line_database = database;
	temp->line_size = sizeof(temp->line_data);
	temp->line_ptr = temp->line_data;
	temp->line_position = QLI_position;
	temp->line_next = QLI_line;
	QLI_line = temp;
}


bool LEX_push_file(TEXT * filename,
				   bool error_flag)
{
/**************************************
 *
 *	L E X _ p u s h _ f i l e 
 *
 **************************************
 *
 * Functional description
 *	Open a command file.  If the open succeedes, push the input
 *	source onto the source stack.  If the open fails, give an error
 *	if the error flag is set, otherwise return quietly.
 *
 **************************************/
	TEXT buffer[64];
	IB_FILE *file;
	LINE line;

	if (!(file = ib_fopen(filename, FOPEN_INPUT_TYPE))) {
		sprintf(buffer, "%s.com", filename);
		if (!(file = ib_fopen(buffer, FOPEN_INPUT_TYPE))) {
			if (error_flag)
				ERRQ_msg_put(67, filename, NULL, NULL, NULL, NULL);	/* Msg 67 can't open command file \"%s\"\n */
			return false;
		}
	}

	line = (LINE) ALLOCPV(type_line, strlen(filename));
	line->line_type = line_file;
	line->line_source = (FRBRD *) file;
	line->line_size = sizeof(line->line_data);
	line->line_ptr = line->line_data;
	*line->line_ptr = 0;
	strcpy(line->line_source_name, filename);
	line->line_next = QLI_line;
	QLI_line = line;

	return true;
}


bool LEX_push_string( TEXT * string)
{
/**************************************
 *
 *	L E X _ p u s h _ s t r i n g
 *
 **************************************
 *
 * Functional description
 *	Push a simple string on as an input source.
 *
 **************************************/
	LINE line;

	line = (LINE) ALLOCPV(type_line, 0);
	line->line_type = line_string;
	line->line_size = strlen(string);
	line->line_ptr = line->line_data;
	strcpy(line->line_data, string);
	line->line_data[line->line_size] = '\n';
	line->line_next = QLI_line;
	QLI_line = line;

	return true;
}


void LEX_put_procedure( FRBRD *blob, SLONG start, SLONG stop)
{
/**************************************
 *
 *	L E X _ p u t _ p r o c e d u r e
 *
 **************************************
 *
 * Functional description
 *	Write text from the scratch trace file into a blob.
 *
 **************************************/
	ISC_STATUS_ARRAY status_vector;
	int length;
	SSHORT l, c;
	TEXT buffer[1024], *p;

	if (ib_fseek(trace_file, start, 0)) {
		ib_fseek(trace_file, (SLONG) 0, 2);
		IBERROR(62);			// Msg 62 ib_fseek failed 
	}

	length = stop - start;

	while (length) {
		p = buffer;
		while (length) {
			--length;
			*p++ = c = ib_getc(trace_file);
			if (c == '\n') {
#ifdef PC_FILE_SEEK
				// account for the extra line-feed on OS/2 and Windows NT 

				if (length)
					--length;
#endif
				break;
			}
		}
		if (l = p - buffer)
			if (gds__put_segment(status_vector, &blob, l, buffer))
				BUGCHECK(58);	// Msg 58 gds__put_segment failed 
	}

	ib_fseek(trace_file, (SLONG) 0, 2);
}


void LEX_real(void)
{
/**************************************
 *
 *	L E X _ r e a l
 *
 **************************************
 *
 * Functional description
 *	If the token is an end of line, get the next token.
 *
 **************************************/

	while (QLI_token->tok_type == tok_eol)
		LEX_token();
}


LLS LEX_statement_list(void)
{
/**************************************
 *
 *	L E X _ s t a t e m e n t _ l i s t
 *
 **************************************
 *
 * Functional description
 *	Somebody outside needs to know
 *	where the top of the statement list
 *	is.
 *
 **************************************/

	return QLI_statements;
}


TOK LEX_token(void)
{
/**************************************
 *
 *	L E X _ t o k e n
 *
 **************************************
 *
 * Functional description
 *	Parse and return the next token.
 *
 **************************************/
	TOK token;
	SSHORT c, next, peek;
	TEXT class_, *p, *q;
	SYM symbol;
	LINE prior;

	token = QLI_token;
	p = token->tok_string;

/* Get next significant byte.  If it's the last EOL of a blob, throw it
   away */

	for (;;) {
		c = skip_white();
		if (c != '\n' || QLI_line->line_type != line_blob)
			break;
		prior = QLI_line;
		next_line(true);
		if (prior == QLI_line)
			break;
	}

// If we hit end of file, make up a phoney token 

	if (!QLI_line) {
		q = eof_string;
		while (*p++ = *q++);
		token->tok_type = tok_eof;
		token->tok_keyword = KW_none;
		return NULL;
	}

	*p++ = c;
	QLI_token->tok_position = QLI_line->line_position +
		QLI_line->line_ptr - QLI_line->line_data - 1;

// On end of file, generate furious but phone end of line tokens 

	class_ = classes[c];

	if (class_ & CHR_letter) {
		while (classes[c = nextchar(true)] & CHR_ident)
			*p++ = c;
		retchar(c);
		token->tok_type = tok_ident;
	}
	else if (((class_ & CHR_digit) || c == '.') && scan_number(c, &p))
		token->tok_type = tok_number;
	else if (class_ & CHR_quote) {
		token->tok_type = tok_quoted;
		while (true) {
			if (!(next = nextchar(false)) || next == '\n') {
				retchar(next);
				IBERROR(63);	// Msg 63 unterminated quoted string 
				break;
			}
			*p++ = next;
			if ((p - token->tok_string) >= MAXSYMLEN)
				ERRQ_msg_put(470, (TEXT *) MAXSYMLEN, NULL, NULL, NULL, NULL);	// Msg 470 literal too long 

			// If there are 2 quotes in a row, interpret 2nd as a literal 

			if (next == c) {
				peek = nextchar(false);
				retchar(peek);
				if (peek != c)
					break;
				nextchar(false);
			}
		}
	}
	else if (c == '\n') {
		token->tok_type = tok_eol;
		--p;
		q = "end of line";
		while (*q)
			*p++ = *q++;
	}
	else {
		token->tok_type = tok_punct;
		*p++ = nextchar(true);
		if (!HSH_lookup(token->tok_string, 2))
			retchar(*--p);
	}

	token->tok_length = p - token->tok_string;
	*p = '\0';

	if (token->tok_string[0] == '$' &&
		trans_limit < TRANS_LIMIT && (p = getenv(token->tok_string + 1))) {
		LEX_push_string(p);
		++trans_limit;
		token = LEX_token();
		--trans_limit;
		return token;
	}

	token->tok_symbol = symbol =
		HSH_lookup(token->tok_string, token->tok_length);
	if (symbol && symbol->sym_type == SYM_keyword)
		token->tok_keyword = (KWWORDS) symbol->sym_keyword;
	else
		token->tok_keyword = KW_none;

	if (sw_trace)
		ib_puts(token->tok_string);

	return token;
}


static bool get_line(IB_FILE * file,
					 TEXT * buffer,
					 USHORT size)
{
/**************************************
 *
 *	g e t _ l i n e
 *
 **************************************
 *
 * Functional description
 *	Read a line.  If the line is terminated by
 *	an EOL, return true.  If the buffer is exhausted and non-blanks
 *	would be discarded, return an error.  If EOF is detected,
 *	return false.  Regardless, a null terminated string is returned.
 *
 **************************************/
	TEXT *p;
	SLONG length;
	bool overflow_flag = false;
	SSHORT c;

	errno = 0;
	p = buffer;
	length = size;

	while (true) {
		c = ib_getc(file);
		if (c == EOF) {
			if (SYSCALL_INTERRUPTED(errno) && !QLI_abort) {
				errno = 0;
				continue;
			}
			if (QLI_abort)
				continue;
			else
				break;
		}
		if (--length > 0)
			*p++ = c;
		else if (c != ' ' && c != '\n')
			overflow_flag = true;
		if (c == '\n')
			break;
	}

	*p = 0;
	if (c == EOF)
		return false;

	if (overflow_flag)
		IBERROR(477);			// Msg 477 input line too long 

	if (sw_verify)
		ib_fputs(buffer, ib_stdout);

	return true;
}


static int nextchar(bool eof_ok)
{
/**************************************
 *
 *	n e x t c h a r
 *
 **************************************
 *
 * Functional description
 *	Get the next character from the input stream.
 *
 **************************************/
	SSHORT c;

/* Get the next character in the current line.  If we run out,
   get the next line.  If the line source runs out, pop the
   line source.  If we run out of line sources, we are distinctly
   at end of file. */

	while (QLI_line) {
		if (c = *QLI_line->line_ptr++)
			return c;
		next_line(eof_ok);
	}

	return 0;
}


static void next_line(bool eof_ok)
{
/**************************************
 *
 *	n e x t _ l i n e
 *
 **************************************
 *
 * Functional description
 *	Get the next line from the input stream.
 *
 **************************************/
	TEXT *p, *q, filename[256];
	bool flag;

	while (QLI_line) {
		flag = false;

		/* Get next line from where ever.  If it comes from either the terminal
		   or command file, check for another command file. */

		if (QLI_line->line_type == line_blob) {
			// If the current blob segment contains another line, use it 

			if ((p = QLI_line->line_ptr) != QLI_line->line_data
				&& p[-1] == '\n' && *p)
				flag = true;
			else {
				// Initialize line block for retrieval 

				p = QLI_line->line_data;
				QLI_line->line_ptr = QLI_line->line_data;

				flag = PRO_get_line(QLI_line->line_source, p,
								 QLI_line->line_size);
				if (flag && QLI_echo)
					ib_printf("%s", QLI_line->line_data);
			}
		}
		else {
			// Initialize line block for retrieval 

			QLI_line->line_ptr = QLI_line->line_data;
			p = QLI_line->line_data;

			if (QLI_line->line_type == line_stdin)
				flag = LEX_get_line(QLI_prompt, p, (int) QLI_line->line_size);
			else if (QLI_line->line_type == line_file) {
				flag = get_line((FILE*) QLI_line->line_source, p, QLI_line->line_size);
				if (QLI_echo)
					ib_printf("%s", QLI_line->line_data);
			}
			if (flag) {
				for (q = p; classes[*q] & CHR_white; q++);
				if (*q == '@') {
					for (p = q + 1, q = filename; *p && *p != '\n';)
						*q++ = *p++;
					*q = 0;
					QLI_line->line_ptr = (TEXT *) p;
					LEX_push_file(filename, true);
					continue;
				}
			}
		}

		/* If get got a line, we're almost done */

		if (flag)
			break;

		/* We hit end of file.  Either complain about the circumstances
		   or just close out the current input source.  Don't close the
		   input source if it's the terminal and we're at a continuation
		   prompt. */

		if (eof_ok && (QLI_line->line_next || QLI_prompt != QLI_cont_string)) {
			LEX_pop_line();
			return;
		}

		// this is an unexpected end of file 

		if (QLI_line->line_type == line_blob)
			ERRQ_print_error(64, QLI_line->line_source_name, NULL, NULL, NULL,
							 NULL);
		/* Msg 64 unexpected end of procedure in procedure %s */
		else if (QLI_line->line_type == line_file)
			ERRQ_print_error(65, QLI_line->line_source_name, NULL, NULL, NULL,
							 NULL);
		/* Msg 65 unexpected end of file in file %s */
		else {
			if (QLI_line->line_type == line_string)
				LEX_pop_line();
			IBERROR(66);		// Msg 66 unexpected eof 
		}
	}

	if (!QLI_line)
		return;

	QLI_line->line_position = QLI_position;

// Dump output to the trace file 

	if (QLI_line->line_type == line_blob)
		while (*p)
			p++;
	else {
		while (*p)
			ib_putc(*p++, trace_file);
		QLI_position += (TEXT *) p - QLI_line->line_data;
#ifdef PC_FILE_SEEK
		/* account for the extra line-feed on OS/2 and Windows NT
		   to determine file position */

		QLI_position++;
#endif
	}

	QLI_line->line_length = (TEXT *) p - QLI_line->line_data;
}


static void retchar( SSHORT c)
{
/**************************************
 *
 *	r e t c h a r
 *
 **************************************
 *
 * Functional description
 *	Return a character to the input stream.
 *
 **************************************/

	--QLI_line->line_ptr;
}


static bool scan_number(SSHORT c,
						TEXT ** ptr)
{
/**************************************
 *
 *	s c a n _ n u m b e r
 *
 **************************************
 *
 * Functional description
 *	Pass on a possible numeric literal.
 *
 **************************************/
	TEXT *p;
	bool dot = false;

	p = *ptr;

/* If this is a leading decimal point, check that the next
   character is really a digit, otherwise backout */

	if (c == '.') {
		retchar(c = nextchar(true));
		if (!(classes[c] & CHR_digit))
			return false;
		dot = true;
	}

// Gobble up digits up to a single decimal point 

	for (;;) {
		c = nextchar(true);
		if (classes[c] & CHR_digit)
			*p++ = c;
		else if (!dot && c == '.') {
			*p++ = c;
			dot = true;
		}
		else
			break;
	}

// If this is an exponential, eat the exponent sign and digits 

	if (UPPER(c) == 'E') {
		*p++ = c;
		c = nextchar(true);
		if (c == '+' || c == '-') {
			*p++ = c;
			c = nextchar(true);
		}
		while (classes[c] & CHR_digit) {
			*p++ = c;
			c = nextchar(true);
		}
	}

	retchar(c);
	*ptr = p;

	return true;
}


static int skip_white(void)
{
/**************************************
 *
 *	s k i p _ w h i t e
 *
 **************************************
 *
 * Functional description
 *	Skip over while space and comments in input stream
 *
 **************************************/
	SSHORT c, next, class_;

	while (true) {
		c = nextchar(true);
		class_ = classes[c];
		if (class_ & CHR_white)
			continue;
		if (c == '/') {
			if ((next = nextchar(true)) != '*') {
				retchar(next);
				return c;
			}
			c = nextchar(false);
			while ((next = nextchar(false)) && !(c == '*' && next == '/'))
				c = next;
			continue;
		}
		break;
	}

	return c;
}