/***********************************************************************
 *
 *	Lexer Module.
 *
 *	$Revision: 1.6 $
 *	$Date: 1995/09/12 04:34:44 $
 *	$Author: sbb $
 *
 ***********************************************************************/

/***********************************************************************
 *
 * Copyright (C) 1990, 1991, 1992, 1994, 1995 Free Software Foundation, Inc.
 * Written by Steve Byrne.
 *
 * This file is part of GNU Smalltalk.
 *
 * GNU Smalltalk is free software; you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by the Free
 * Software Foundation; either version 1, or (at your option) any later 
 * version.
 * 
 * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
 * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
 * more details.
 * 
 * You should have received a copy of the GNU General Public License along with
 * GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
 * Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
 *
 ***********************************************************************/

/*
 *    Change Log
 * ============================================================================
 * Author      Date       Change 
 * sbb	      9 Jul 95	  Fixed to include proper headers and have functions
 *			  declared explictly.
 *
 * brd       15 Jun 95    Added isKernelFile() and 
 *                        getMethodSourceFromCurFile(). These routines were 
 *                        provided to solve certain data integrity problem 
 *                        caused by accessing the source code indirectly from 
 *                        saved file information.
 *
 * sbb	      6 Jun 95	  Switched to new file naming scheme.
 *
 * sbb	     30 May 95	  Boolean => mst_Boolean.
 *
 * sbb	     21 Jan 95	  Some changes for architectural independence (64 bit).
 *
 * sbb	     10 Jul 94	  Reinstated the use of changes (it was dyked out) as
 *			  an optional mechanism.
 *
 * sbb	     31 Dec 91	  Began adding support for having a changes file
 *			  and pointing methods to that instead of
 *			  the actual source file (which can get out of sync,
 *			  and cause recompiles to lose).
 *
 * sbb	     29 Dec 91	  Added support for readline's conditional .inputrc
 *			  definitions, keyed off of "Smalltalk".
 *
 * sbb	     29 Nov 91	  Added fileNameOOP to hold full path name for files,
 *			  so that all methods share the same file name string.
 *			  Also, adjusted getCurFileName to return the full path
 *			  name.
 *
 * sbb	      5 Jul 91	  added setStreamInfo so that stuff filed in from Emacs
 *			  can have more accurate information such as the line
 *			  number in the buffer instead of the line number in
 *			  the temporary file.
 *
 * sbb	     25 Mar 91	  Added -> operator.
 *
 * sbb	     24 Mar 91	  Fixed lexing of foo:= to be seen as foo :=.
 *
 * sbyrne    24 Apr 90	  Error checking for integers too large.
 *
 * sbyrne    20 Apr 90	  Added the closeIt argument to popStream so that the
 *			  closing behavior could be separated from the popping
 *			  behavior (in particular, for fileIn).
 *
 * sbyrne     7 Apr 90	  Character lexing routines (such as nextChar) now
 *			  return ints to get around problems on implementations
 *			  that don't sign extend characters by default.
 *
 * sbyrne    15 Feb 90	  Added support for := as alternative assignment
 *			  operator.
 *
 * sbyrne     3 Sep 89	  added getCurFileName
 *
 * sbyrne    30 Aug 89	  Fixed a bug in parseIdent which was parsing foo:2
 *			  (note no space) not as foo: and 2, but as a mixed up
 *			  token.
 *
 * sbyrne     8 Jul 89	  Added prompt when input is a terminal.  This should
 *			  help Emacs's shell mode determine what has been typed
 *			  as input to the system.
 *
 * sbyrne    24 Jan 89	  Added 2 chars of push back, because 3. needs to look
 *			  ahead one more character to see if its 3.DIGIT or 3.
 *			  next statement.
 *
 * sbyrne    27 Dec 88    Created.
 */


#include "gst.h"
#include "lex.h"
#if defined(MSDOS) | defined(_WIN32) | defined (__OS2__)
#include "gst_tab.h"
#else
#include "gst.tab.h"
#endif
#include "str.h"
#include "id.h"
#include "dict.h"
#include "comp.h"
#include "tree.h"
#include "sysdep.h"
#include "gstpaths.h"
#include <stdio.h>
#include <string.h>		/* SBB  4-Jul-95 15:01:47 why is this necessary? */
#include <math.h>
#ifdef USE_READLINE
#include <readline/readline.h>
#endif /* USE_READLINE */
#if STDC_HEADERS
#include <stdlib.h>		/* for malloc */
#endif /* STDC_HEADERS */

#if defined(HAVE_IO_H)
#include <io.h>
#endif

#define WHITE_SPACE		1
#define DIGIT			2
#define ID_CHAR			4
#define SPECIAL_CHAR		8

#define ERROR_ARGS		arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8

#define EMACS_PROCESS_MARKER	'\001' /* ^A as marker -- random choice */

#define CHANGE_FILE_NAME	"st-changes.st"

typedef struct StringStreamStruct {
  char		*strBase;	/* base of asciz string */
  char		*str;		/* pointer into asciz string */
} StringStream;

struct StreamStruct {
  StreamType	type;
  int		pushedBackChars[2]; /* holds the 2 characters of buffering */
  int		pushedBackCount; /* number of chars pushed back */
  int		line;
  int		column;
  char		*fileName;
  int		fileOffset;
  OOP		fileNameOOP;	/* holds full path name for file as an oop */
  mst_Boolean	prompt;
  union {
    FILE	*u_st_file;
    StringStream u_st_str;
  } st;
  Stream	prevStream;
};

#define st_file		st.u_st_file
#define st_str		st.u_st_str

extern char	*strdup();


Stream	inStream = NULL;
int	lexDebug;
char	*processingFile = nil;

mst_Boolean		reportErrors = true;
char		*firstErrorStr = NULL;
char		*firstErrorFile = NULL;
long		firstErrorLine;

/* Controls the use of the changes file, for recording source text */
mst_Boolean		useChanges = false;

static FILE	*changeStr;

static int			byteAddr, methodStartPos = 0;
static mst_Boolean			produceInternalToken;

static mst_Boolean			isDigit(), isBaseDigit(), parsePrimitive(),
				parseDigits(), parseFraction();
static int			illegal(), comment(), charLiteral(),
				parseBinOP(), stringLiteral(), parseNumber(),
				parseIdent(), myGetC(), parseColon(),
  				nextChar(), digitToInt();
static char			*scanStringoid();
static void 			unreadChar(), lineStamp(), /* myUngetC(), */
				myClose();
static Stream			pushNewStream();

typedef struct {
  int		(*lexFunc)();
  int		retToken;
  int		charClass;
} LexTabElt;

static LexTabElt charTab[128] = {
/*   0 */	illegal,	0,	0,
/*   1 */	illegal,	0,	0,
/*   2 */	illegal,	0,	0,
/*   3 */	illegal,	0,	0,
/*   4 */	illegal,	0,	0,
/*   5 */	illegal,	0,	0,
/*   6 */	illegal,	0,	0,
/*   7 */	illegal,	0,	0,
/*   8 */	illegal,	0,	0,
/*   9 */	0,		0,	WHITE_SPACE,
/*  10 */	0,		0,	WHITE_SPACE,
/*  11 */	illegal,	0,	0,
/*  12 */	0,		0,	WHITE_SPACE, 
/*  13 */	0,		0,	WHITE_SPACE,
/*  14 */	illegal,	0,	0,	
/*  15 */	illegal,	0,	0,
/*  16 */	illegal,	0,	0,
/*  17 */	illegal,	0,	0,
/*  18 */	illegal,	0,	0,
/*  19 */	illegal,	0,	0,
/*  20 */	illegal,	0,	0,
/*  21 */	illegal,	0,	0,
/*  22 */	illegal,	0,	0,
/*  23 */	illegal,	0,	0,
/*  24 */	illegal,	0,	0,
/*  25 */	illegal,	0,	0,
/*  26 */	illegal,	0,	0,
/*  27 */	illegal,	0,	0,
/*  28 */	illegal,	0,	0,
/*  29 */	illegal,	0,	0,
/*  30 */	illegal,	0,	0,
/*  31 */	illegal,	0,	0,
/*     */	0,		0,	WHITE_SPACE,
/*   ! */	parseBinOP,	0,	SPECIAL_CHAR, 
/*   " */	comment,	0,	0,
/*   # */	0,		SHARP,	0,
/*   $ */	charLiteral,	0,	0,
/*   % */	parseBinOP,	0,	SPECIAL_CHAR,
/*   & */	parseBinOP,	0,	SPECIAL_CHAR,
/*   ' */	stringLiteral,	0,	0,
/*   ( */	0,		OPEN_PAREN, 0,
/*   ) */	0,		CLOSE_PAREN, 0,
/*   * */	parseBinOP,	0,	SPECIAL_CHAR,
/*   + */	parseBinOP,	0,	SPECIAL_CHAR,
/*   , */	parseBinOP,	0,	SPECIAL_CHAR,
/*   - */	parseBinOP,	0,	SPECIAL_CHAR,
/*   . */	0,		DOT,	0,
/*   / */	parseBinOP,	0,	SPECIAL_CHAR,
/*   0 */	parseNumber,	0,	DIGIT | ID_CHAR,
/*   1 */	parseNumber,	0,	DIGIT | ID_CHAR,
/*   2 */	parseNumber,	0,	DIGIT | ID_CHAR,
/*   3 */	parseNumber,	0,	DIGIT | ID_CHAR,
/*   4 */	parseNumber,	0,	DIGIT | ID_CHAR,
/*   5 */	parseNumber,	0,	DIGIT | ID_CHAR,
/*   6 */	parseNumber,	0,	DIGIT | ID_CHAR,
/*   7 */	parseNumber,	0,	DIGIT | ID_CHAR,
/*   8 */	parseNumber,	0,	DIGIT | ID_CHAR,
/*   9 */	parseNumber,	0,	DIGIT | ID_CHAR,
/*   : */	parseColon,	0,	0,
/*   ; */	0,		SEMICOLON, 0,
/*   < */	parseBinOP,	0,	SPECIAL_CHAR,
/*   = */	parseBinOP,	0,	SPECIAL_CHAR,
/*   > */	parseBinOP,	0,	SPECIAL_CHAR,
/*   ? */	parseBinOP,	0,	SPECIAL_CHAR,
/*   @ */	parseBinOP,	0,	SPECIAL_CHAR,
/*   A */	parseIdent,	0,	ID_CHAR,
/*   B */	parseIdent,	0,	ID_CHAR,
/*   C */	parseIdent,	0,	ID_CHAR,
/*   D */	parseIdent,	0,	ID_CHAR,
/*   E */	parseIdent,	0,	ID_CHAR,
/*   F */	parseIdent,	0,	ID_CHAR,
/*   G */	parseIdent,	0,	ID_CHAR,
/*   H */	parseIdent,	0,	ID_CHAR,
/*   I */	parseIdent,	0,	ID_CHAR,
/*   J */	parseIdent,	0,	ID_CHAR,
/*   K */	parseIdent,	0,	ID_CHAR,
/*   L */	parseIdent,	0,	ID_CHAR,
/*   M */	parseIdent,	0,	ID_CHAR,
/*   N */	parseIdent,	0,	ID_CHAR,
/*   O */	parseIdent,	0,	ID_CHAR,
/*   P */	parseIdent,	0,	ID_CHAR,
/*   Q */	parseIdent,	0,	ID_CHAR,
/*   R */	parseIdent,	0,	ID_CHAR,
/*   S */	parseIdent,	0,	ID_CHAR,
/*   T */	parseIdent,	0,	ID_CHAR,
/*   U */	parseIdent,	0,	ID_CHAR,
/*   V */	parseIdent,	0,	ID_CHAR,
/*   W */	parseIdent,	0,	ID_CHAR,
/*   X */	parseIdent,	0,	ID_CHAR,
/*   Y */	parseIdent,	0,	ID_CHAR,
/*   Z */	parseIdent,	0,	ID_CHAR,
/*   [ */	0,		OPEN_BRACKET, 0,
/*   \ */	parseBinOP,	0,	SPECIAL_CHAR,
/*   ] */	0,		CLOSE_BRACKET, 0,
/*   ^ */	0,		UPARROW, 0,
/*   _ */	0,		ASSIGN,	0,
/*   ` */	illegal,	0,	0,
/*   a */	parseIdent,	0,	ID_CHAR,
/*   b */	parseIdent,	0,	ID_CHAR,
/*   c */	parseIdent,	0,	ID_CHAR,
/*   d */	parseIdent,	0,	ID_CHAR,
/*   e */	parseIdent,	0,	ID_CHAR,
/*   f */	parseIdent,	0,	ID_CHAR,
/*   g */	parseIdent,	0,	ID_CHAR,
/*   h */	parseIdent,	0,	ID_CHAR,
/*   i */	parseIdent,	0,	ID_CHAR,
/*   j */	parseIdent,	0,	ID_CHAR,
/*   k */	parseIdent,	0,	ID_CHAR,
/*   l */	parseIdent,	0,	ID_CHAR,
/*   m */	parseIdent,	0,	ID_CHAR,
/*   n */	parseIdent,	0,	ID_CHAR,
/*   o */	parseIdent,	0,	ID_CHAR,
/*   p */	parseIdent,	0,	ID_CHAR,
/*   q */	parseIdent,	0,	ID_CHAR,
/*   r */	parseIdent,	0,	ID_CHAR,
/*   s */	parseIdent,	0,	ID_CHAR,
/*   t */	parseIdent,	0,	ID_CHAR,
/*   u */	parseIdent,	0,	ID_CHAR,
/*   v */	parseIdent,	0,	ID_CHAR,
/*   w */	parseIdent,	0,	ID_CHAR,
/*   x */	parseIdent,	0,	ID_CHAR,
/*   y */	parseIdent,	0,	ID_CHAR,
/*   z */	parseIdent,	0,	ID_CHAR,
/*   { */	illegal,	0,	0,
/*   | */	parseBinOP,	0,	SPECIAL_CHAR,
/*   } */	illegal,	0,	0,
/*   ~ */	parseBinOP,	0,	SPECIAL_CHAR,
/*  ^? */	illegal,	0,	0
};


int yylex(lvalp, llocp)
YYSTYPE *lvalp;
voidPtr *llocp;		/* Bison is broken, doesn define type YYLTYPE!! */
{
#ifdef USE_MONCONTROL
  int result;

  moncontrol(1);
  result = myyylex(lvalp, llocp);
  moncontrol(0); 

  return (result);
}

int myyylex(lvalp, llocp)
YYSTYPE *lvalp;
voidPtr *llocp;		/* Bison is broken, doesn define type YYLTYPE!! */
{
#endif /* USE_MONCONTROL */
  int		ic, result, tokenStartPos;

  if (produceInternalToken) {
    /* The internal token is a trick to make the grammar be "conditional".
     * Normally, the allowable syntax for internal compilation is that of
     * a single method (without the terminating BANG).  However, would make
     * for an ambiguous grammar since a method declaration could look like
     * an immediate expression.  So, when the compiler is called internally,
     * we force the first token returned by the lexer to be INTERNAL_TOKEN
     * and make the top most production in the grammar use INTERNAL_TOKEN as
     * the first token of an internal method. */
    produceInternalToken = false;
    return (INTERNAL_TOKEN);
  }

  while ((ic = nextChar()) != EOF) {
    if ((charTab[ic].charClass & WHITE_SPACE) == 0) {
      if (methodStartPos < 0) {
	tokenStartPos = getCurFilePos();
      }

      if (charTab[ic].lexFunc) {
	result = (*charTab[ic].lexFunc)(ic, lvalp);
	if (result) {
	  if (methodStartPos < 0) { /* only do this here to ignore comments */
	    methodStartPos = tokenStartPos - 1;
	  }
	  return (result);
	}
      } else if (charTab[ic].retToken) {
	return (charTab[ic].retToken);
      } else {
	errorf("Unknown character %d in input stream, ignoring", ic);
	hadError = true;
      }
    }
  }
  return (0);			/* keep fussy compilers happy */
}

void initLexer(calledInternally)
mst_Boolean calledInternally;
{
  byteAddr = 0;
  
  produceInternalToken = calledInternally;
}

static int illegal(c, lvalp)
char	c;
YYSTYPE *lvalp;
{
  char		charName[3], *cp;

  cp = charName;

  if (c < ' ' || c > '~') {
    *cp++ = '^';
    c &= 127;			/* strip high bit */
    c ^= 64;			/* uncontrolify */
  }

  *cp++ = c;
  *cp++ = '\0';
  
  errorf("Illegal character %s", charName);
  hadError = true;

  return (0);			/* tell the lexer to ignore this */
}


/*
 *	static int comment(c, lvalp)
 *
 * Description
 *
 *	Scan a comment, but return 0 to indicate to the lexer that it's to be
 *	ignored (since it is a comment).
 *
 * Inputs
 *
 *	c     : first character of the comment (the delimiter).  Not terribly
 *		useful, but it's what the lexer calls us with.
 *	lvalp : ignored...passed because we're invoked indirectly and some of
 *		the functions that could be called require this parameter.
 *
 * Outputs
 *
 *	0, which tells the lexer to ignore this token.
 */
static int comment(c, lvalp)
char	c;
YYSTYPE *lvalp;
{
  scanStringoid(c, "comment");

  return (0);
}

/*
 *	static int charLiteral(c, lvalp)
 *
 * Description
 *
 *	parse a character literal.
 *
 * Inputs
 *
 *	c     : input character -- ignored
 *	lvalp : ignored -- passed because we're called indirectly.
 *
 * Outputs
 *
 *	CHAR_LITERAL token normally; 0 on EOF.
 */
static int charLiteral(c, lvalp)
char	c;
YYSTYPE *lvalp;
{
  int		ic;

  ic = nextChar();
  if (ic == EOF) {
    errorf("Unterminated character literal, attempting recovery");
    unreadChar(ic);
    hadError = true;
    return (0);
  } else {
    lvalp->cval = ic;
    return (CHAR_LITERAL);
  }
}

static int parseColon(c, lvalp)
char	c;
YYSTYPE *lvalp;
{
  int		ic;

  ic = nextChar();
  if (ic == '=') {		/* parse :=, compatibility mode assign */
    return (ASSIGN);
  } else {
    unreadChar(ic);
  }

  return (COLON);
}


static int parseBinOP(c, lvalp)
char	c;
YYSTYPE *lvalp;
{
  char		buf[3], *bp;
  int		ic;

  bp = buf;
  *bp++ = c;

  ic = nextChar();
  if (c == '<') {
    if (ic == 'p') {
      if (parsePrimitive(ic, lvalp)) {
	return (PRIMITIVE_START);
      }
    }
  }

  if (ic != EOF && (charTab[ic].charClass & SPECIAL_CHAR)) {
    *bp++ = ic;			/* accumulate next char */
  } else {
    unreadChar(ic);
    if (c == '-' && isDigit(ic)) {
      return (parseNumber('-', lvalp));
    }
  }
#ifdef old_code /* Fri Apr 19 20:37:57 1991 */
/**/  if (c == '-') {
/**/    if (ic == '>') {		/* -> */
/**/      *bp++ = ic;
/**/    } else {
/**/      unreadChar(ic);
/**/      if (isDigit(ic)) {
/**/	return (parseNumber('-', lvalp));
/**/      }
/**/    }
/**/  } else {
/**/    if (ic != EOF && (charTab[ic].charClass & SPECIAL_CHAR)) {
/**/      *bp++ = ic;
/**/    } else {
/**/      unreadChar(ic);
/**/    }
/**/  }
#endif /* old_code Fri Apr 19 20:37:57 1991 */

  *bp = '\0';

  if (strcmp(buf, "!") == 0) {
    /* technically, token BANG has no string value, it's just a simple token,
       so we return from here before we set the token's value */
    return (BANG);
  } else if (strcmp(buf, "!!") == 0) {
    unreadChar('!');
    return (BANG);
  }
  
  lvalp->sval = copyStr(buf);
  
  if (strcmp(buf, "|") == 0) {
    return (VERTICAL_BAR);
  } else {
    return (BINOP);
  }
}

static int stringLiteral(c, lvalp)
char	c;
YYSTYPE *lvalp;
{
  lvalp->sval = copyStr(scanStringoid(c, "string"));
  return (STRING_LITERAL);
}

static mst_Boolean parsePrimitive(c, lvalp)
char	c;
YYSTYPE *lvalp;
{
  mst_Boolean 	result;

  parseIdent(c, lvalp);
  result = (strcmp(lvalp->sval, "primitive:") == 0);
  free(lvalp->sval);
  return (result);
}

static int parseIdent(c, lvalp)
char	c;
YYSTYPE *lvalp;
{
  int		ic, identType;
  
  initIdent(c);
  
  identType = IDENTIFIER;
  
  for (;;) {
    while (((ic = nextChar()) != EOF) && (charTab[ic].charClass & ID_CHAR)) {
      addIdentChar(ic);
    }
    
    if (ic == ':') {		/* we have a keyword if id ends with : */
      ic = nextChar();
      unreadChar(ic);
      if (ic == '=') {		/* except if we have 'foo:=' => 'foo :=' */
	if (identType != IDENTIFIER) {
	  errorf("Malformed symbol literal");
	  break;
	}
	unreadChar(':');
	break;
      }
      addIdentChar(':');
      if (ic == EOF || (charTab[ic].charClass & ID_CHAR) == 0
	  || (charTab[ic].charClass & DIGIT) != 0) {
	if (identType == IDENTIFIER) {
	  /* first time through */
	  identType = KEYWORD;
	}
	break;
      }
      identType = SYMBOL_KEYWORD;
    } else {
      unreadChar(ic);
      break;
    }
  }
  
  lvalp->sval = copyStr(doneIdent());
  
  return (identType);
}

static int parseNumber(c, lvalp)
char	c;
YYSTYPE *lvalp;
{
  int		base, exponent, ic;
  double	num, floatExponent;
  mst_Boolean	mantissaParsed = false, isNegative = false, dotSeen = false;
  double	scale;
  
  base = 10;
  exponent = 0;
  scale = 0.0;
  ic = c;

  if (ic != '-') {
    parseDigits(ic, 10, &num);
    ic = nextChar();
    if (ic == 'r') {
      base = (int)num;
      ic = nextChar();
    } else {
      mantissaParsed = true;
    }
  }

  /*
   * here we've either
   *  a) parsed base, an 'r' and are sitting on the following character
   *  b) parsed the integer part of the mantissa, and are sitting on the char
   *     following it, or
   *  c) parsed nothing and are sitting on a - sign.
   */
  if (!mantissaParsed) {
    if (ic == '-') {
      isNegative = true;
      ic = nextChar();
    }
    
    parseDigits(ic, base, &num);
    ic = nextChar();
  }

  if (ic == '.') {
    ic = nextChar();
    if (!isDigit(ic)) {
      /* OOPS...we gobbled the '.' by mistake...it was a statement boundary
	 delimiter.  We have an integer that we need to return, and need to
	 push back both the . and the character that we just read. */
      unreadChar(ic);
      ic = '.';
    } else {
      dotSeen = true;
      parseFraction(ic, base, &num, &scale);
      ic = nextChar();
    }
  }

  if (ic == 'e') {
    ic = nextChar();
    if (ic == '-') {
      parseDigits(nextChar(), 10, &floatExponent);
      exponent -= (int)floatExponent;
    } else {
      parseDigits(ic, 10, &floatExponent);
      exponent += (int)floatExponent;
    }
  } else {
    unreadChar(ic);
  }

  if (scale != 0.0) {
    num *= scale/*pow((double)base, (double)exponent)*/;
  }

  if (exponent != 0) {
    num *= pow((double)base, (double)exponent);
  }

  if (isNegative) {
    num = -num;
  }
    
  if (dotSeen) {
    lvalp->fval = num;
    return (FLOATING_LITERAL);
  } else {
    lvalp->ival = (long)num;

    /* I don't use 1L because I am not certain all C compilers handle it */
    if (num < -(((long)1) << ((SIZEOF_LONG * 8) - 2))
	|| num >= ( ((long)1) << ((SIZEOF_LONG * 8) - 2))) {
      /* at least warn the guy... */
      errorf("Integer literal %d too large to be represented in Smalltalk",
	     num);
      hadError = true;
    }
      
    return (INTEGER_LITERAL);
  }
}

static mst_Boolean parseDigits(c, base, numPtr)
char	c;
int	base;
double	*numPtr;
{
  double	result;
  mst_Boolean	oneDigit = false;

  for (result = 0.0; isBaseDigit(c, base); c = nextChar()) {
    result *= base;
    oneDigit = true;
    result += digitToInt(c, base);
  }

  if (!oneDigit) {
    errorf("Unexpected EOF while scanning number");
    hadError = true;
  }

  unreadChar(c);

  *numPtr = result;

  return (true);
}

static mst_Boolean parseFraction(c, base, numPtr, scalePtr)
char	c;
int	base;
double	*numPtr, *scalePtr;
{
  double	scale;
  double	num;

  scale = 1.0;

  for (num = *numPtr; isBaseDigit(c, base); c = nextChar()) {
    num *= base;
    num += digitToInt(c, base);
    scale /= base;
  }

  unreadChar(c);

  *numPtr = num;
  *scalePtr = scale;

  return (true);
}


static int digitToInt(c, base)
char	c;
int	base;
{
  if (c < '0' || (c > '9' && c < 'A') || c > 'Z') {
    errorf("Illegal digit %c in number", c);
    hadError = true;
    return (0);
  }

  if (c >= 'A') {
    c = c - 'A' + 10;
  } else {
    c -= '0';
  }

  if (c >= base) {
    errorf("Digit '%c' too large for base %d", c, base);
    hadError = true;
    return (0);
  }

  return (c);
}

static mst_Boolean isBaseDigit(c, base)
char	c;
int	base;
{
  if (c < '0' || (c > '9' && c < 'A') || c > 'Z') {
    return (false);
  }
  
  if (c >= 'A') {
    c = c - 'A' + 10;
  } else {
    c -= '0';
  }

  return (c < base);
}


static mst_Boolean isDigit(c)
char	c;
{
  return ((charTab[c].charClass & DIGIT) != 0);
}

static char *scanStringoid(startChar, typeName)
char	startChar, *typeName;
{
  int		ic;

  initStrBuf();

  for (;;) {
    ic = nextChar();
    if (ic == EOF) {
      errorf("Unterminated %s, attempting recovery", typeName);
      hadError = true;
      return (curStrBuf());
    }
    if (ic == startChar) {
      /* check for doubled delimiters */
      ic = nextChar();
      if (ic != startChar) {
	unreadChar(ic);
	return (curStrBuf());
      }
    }
    addStrBufChar(ic);
  }
  
}

/*
 * Report an error to the user.  ### Will show position in the text of
 * the error at some point.
 */
/*VARARGS1*/
void errorf(str, ERROR_ARGS)
char	*str;
long	ERROR_ARGS;
{
  char		errStr[256];

  if (reportErrors) {
    fflush(stdout);
  }
  lineStamp();
  if (reportErrors) {
    fprintf(stderr, str, ERROR_ARGS);
    fprintf(stderr, "\n");
    fflush(stderr);
  } else {
    if (firstErrorStr == NULL) {
      sprintf(errStr, str, ERROR_ARGS);
      firstErrorStr = strdup(errStr);
    }
  }
}


/* ??? is void the right type */
void yyerror(s)
char	*s;
{
  errorf("%s", s);
#ifdef old_code /* Sat Feb  8 17:14:18 1992 */
/**/  lineStamp();
/**/  fprintf(stderr, "%s\n", s);
#endif /* old_code Sat Feb  8 17:14:18 1992 */
}

static void lineStamp()
{
  if (reportErrors) {
    if (inStream) {
      if (inStream->fileName) {
	fprintf(stderr, "\"%s\", ", inStream->fileName);
      }
      fprintf(stderr, "line %d: ", inStream->line);
    } else {
      fprintf(stderr, "<unknown position> ");
    }
  } else {			/* called internally with error handling */
    if (inStream) {
      if (inStream->fileName) {
	if (firstErrorStr == NULL) {
	  firstErrorFile = strdup(inStream->fileName);
	}
      }
      if (firstErrorStr == NULL) {
	firstErrorLine = inStream->line;
      }
    } else {
      if (firstErrorStr == NULL) {
	firstErrorLine = -1;
      }
    }
  }
}

StreamType getCurStreamType()
{
  if (inStream) {
    return (inStream->type);
  } else {
    return (unknownStreamType);
  }
}

OOP getCurString()
{
  if (inStream && inStream->type == stringStreamType) {
    return (stringNew(inStream->st_str.strBase));
  } else {
    return (nilOOP);
  }
}

OOP getCurFileName()
{
  char		*fullFileName;

  if (inStream && inStream->type == fileStreamType) {
    if (inStream->fileNameOOP == nilOOP) {
      if (strcmp(inStream->fileName, "stdin") == 0) {
	fullFileName = strdup(inStream->fileName);
      } else {
	fullFileName = getFullFileName(inStream->fileName);
      }
      inStream->fileNameOOP = stringNew(fullFileName);
    }
    return (inStream->fileNameOOP);
  } else {
    return (nilOOP);
  }
}

#ifdef USE_READLINE
OOP getCurReadline()
{
  if (inStream && inStream->type == readlineStreamType) {
    return (stringNew(inStream->st_str.strBase));
  } else {
    return (nilOOP);
  }
}
#endif /* USE_READLINE */

int getMethodStartPos()
{
  return (methodStartPos);
}

void clearMethodStartPos()
{
  methodStartPos = -1;
}

int getCurFilePos()
{
  if (useChanges) {		/* not sure about this particular use -- the current file pos may be from the input stream */
    return (ftell(changeStr));
  } else if (inStream && inStream->type == fileStreamType) {
    return (ftell(inStream->st_file) + inStream->fileOffset);
  } else {
    return (-1);
  }
}

void initChangesStream()
{
  if (useChanges) {
    /* ??? Should this be in the user's home directory, or is there some
       better place for this to be?  Maybe in user's home if there is one,
       else in some canonical place (?).  Canonical place approach seems to
       lose in that canonical places are often write-protected, which is ok
       for extant changes (like in a saved system), but which need to live
       in the user's home area for new changes.  Again, the notion of "the"
       user's home area is kind of random if there are multiple snapshots,
       since each snapshot should be associated with a particular changes
       file for which it is relevant.
       */
    changeStr = fopen(CHANGE_FILE_NAME, "a");
  }
}

/*
 *	void resetChangesFile()
 *
 * Description
 *
 *	Resets the changes file to be zero length.
 *
 */
void resetChangesFile()
{
#if defined(HAVE_TRUNCATE)
  if (useChanges) {
    truncate(CHANGE_FILE_NAME, 0);
  }
#endif
}

static int nextChar()
{
  register int		ic;

  if (inStream->pushedBackCount > 0) {
    ic = inStream->pushedBackChars[--inStream->pushedBackCount];
    return (ic);
  } else {
    if (inStream->column == 0 && inStream->prompt) {
      if (emacsProcess) {
	printf("%c", EMACS_PROCESS_MARKER);
      }
      printf("st> ");
    }
    ic = myGetC(inStream);

#ifdef sbbb_debugging
 if (ic == EOF) {
   OOP s;
   printf("##### Endo file read: ");
   s = getCurFileName();
   printString(s);
   printf("\n");
 }
#endif

    if (useChanges) {
      if (ic == EOF) {
	fflush(changeStr);
      } else {
	fputc(ic, changeStr);
      }
    }

    /* byteAddr++; */
    if (ic == '\n') {		/* a new line that was not pushed back */
      inStream->line++;
      inStream->column = 0;
    } else {
      inStream->column++;
    }
    return (ic);
  }
}

/*
 *	static void unreadChar(ic)
 *
 * Description
 *
 *	Push character 'ic' back into the input queue.  Allows for two
 *	character pushback currently.  This solves the problem of lexing 3. and
 *	then finding out that what we should have lexed was 3 followed by . as
 *	a statement terminator.
 *
 * Inputs
 *
 *	ic    : character to push back into the input stream.
 *
 */
static void unreadChar(ic)
int	ic;
{
  inStream->pushedBackChars[inStream->pushedBackCount++] = ic;
}



/***********************************************************************
 *
 *	Generic "stream" interface.  A stream is an abstraction for input and
 *	output.  It is most like common lisp streams.  Basically, these streams
 *	provide transparent reading from either a Smalltalk string, or a UNIX
 *	file.  They stack, and the previous stream can be restored by doing a
 *	"popStream" which optionally "closes" the current stream and goes back 
 *	to using the previous stream.
 *
 * 	The `readline()' interface:
 *
 * 		The behavior is like the Smalltalk-String interface.
 * 		The end-of-string or a NULL strBase-pointer decides
 * 		to read in a new line. The prompt is still shown by
 * 		the readline() call.
 * 		
 ***********************************************************************/

void popStream(closeIt)
mst_Boolean closeIt;
{
  Stream	oldStream;

  oldStream = inStream;
  inStream = inStream->prevStream;

  if (closeIt && oldStream) {
    myClose(oldStream);
    free(oldStream);
  }
}

void pushUNIXFile(file, fileName)
FILE	*file;
char	*fileName;
{
  Stream	newStream;

  newStream = pushNewStream(fileStreamType);

  newStream->st_file = file;
  newStream->fileName = fileName;
  newStream->prompt = isatty(fileno(file));
}

void pushSmalltalkString(stringOOP)
OOP	stringOOP;
{
  Stream	newStream;

  newStream = pushNewStream(stringStreamType);

  newStream->st_str.strBase = (char *)toCString(stringOOP);
  newStream->st_str.str = newStream->st_str.strBase;
  newStream->fileName = "a Smalltalk string";
  newStream->prompt = false;
}

void pushCString(string)
char	*string;
{
  Stream	newStream;

  newStream = pushNewStream(stringStreamType);

  newStream->st_str.strBase = string;
  newStream->st_str.str = newStream->st_str.strBase;
  newStream->fileName = "a C string";
  newStream->prompt = false;
}

#ifdef USE_READLINE
void pushReadlineString()
{
  Stream	newStream;

  newStream = pushNewStream(readlineStreamType);

  newStream->st_str.strBase = 0;	/* force readline() but no free() */
  newStream->st_str.str = 0;
  newStream->fileName = "a Readline string";
  newStream->prompt = false;		/* prompt is shown by readline() */
}
#endif /* USE_READLINE */

static Stream pushNewStream(type)
StreamType type;
{
  Stream	newStream;

  newStream = (Stream)malloc(sizeof(struct StreamStruct));

  newStream->pushedBackCount = 0;
  newStream->line = 1;
  newStream->column = 0;
  newStream->fileOffset = 0;
  newStream->type = type;
  newStream->fileNameOOP = nilOOP;
  newStream->prevStream = inStream;
  inStream = newStream;

  return (newStream);
}


/*
 *	void setStreamInfo(line, fileName, fileOffset)
 *
 * Description
 *
 *	This function overrides the file type information for the current stream.
 *	It is typically used by fileIn type methods when filing in a subsection
 *	of a real file via a temporary file what the real source of the text
 *	is.
 *
 * Inputs
 *
 *	line  : line number that the input starts on
 *	fileName: 
 *		The name of the file, only used for file type streams.
 *	fileOffset: 
 *		The byte offset from the start of the actual file where this
 *		given portion of code starts.
 *
 */
void setStreamInfo(line, fileName, fileOffset)
int	line, fileOffset;
char	*fileName;
{
  inStream->line = line;
  if (inStream->type == fileStreamType) {
    inStream->fileName = fileName;
    inStream->fileOffset = fileOffset;
  }
}

static int myGetC(stream)
Stream	stream;
{
  int		ic;

  if (stream->type == stringStreamType) {
    ic = *stream->st_str.str++;
    return ((ic == '\0') ? EOF : ic);
  } else if (stream->type == fileStreamType) {
    return (getc(stream->st_file));
#ifdef USE_READLINE
  } else if (stream->type == readlineStreamType) {
    char *r_line;
    extern char *realloc();
    int r_len;

    if (stream->st_str.strBase) {
      ic = *stream->st_str.str++;
    } else {
      ic = '\0';
    }

    if (ic == '\0') {
      if(stream->st_str.strBase) {
	free(stream->st_str.strBase);
	stream->st_str.strBase = 0;
      }
      r_line = readline("st> ");
      if (!r_line) {
	/*
	 * return value of NULL indicates EOF:
	 */
	return EOF;
      }
      if (*r_line) {
	/*
	 * add only non-empty lines.
	 */
	add_history(r_line);
      }
      /*
       * tack on the newline, not returned by readline() :
       */
      r_len =  strlen(r_line);
      r_line = realloc(r_line, (unsigned) (r_len + 2));
      if (!r_line) {
	errorf("Out of memory, reallocating linebuffer space");
	stream->st_str.str = stream->st_str.strBase = 0;
	ic = '\n';			/* return a newline ... */
      } else {
	r_line[r_len] = '\n';
	r_line[r_len+1] = '\0';
	stream->st_str.str = stream->st_str.strBase = r_line;
	ic = *stream->st_str.str++;
      }
    }
    return (ic);
#endif /* USE_READLINE */
  } else {
    errorf("Bad stream type passed to myGetC");
    hadError = true;
    return (0);
  }
}

#ifdef old_code /* Sat Mar 23 21:00:38 1991 */
/**/static void myUngetC(ic, stream)
/**/int	ic;
/**/Stream	stream;
/**/{
/**/  if (stream->type == stringStreamType) {
/**/    stream->st_str.str--;
/**/  } else if (stream->type == fileStreamType) {
/**/    ungetc(ic, stream->st_file);
/**/#ifdef USE_READLINE
/**/  } else if (stream->type == readlineStreamType) {
/**/    if (stream->st_str.str > stream->st_str.strBase) {
/**/      *--stream->st_str.str = ic;
/**/    } else {
/**/      errorf("Cannot unget character to readline stream");
/**/    }
/**/#endif /* USE_READLINE */
/**/  } else {
/**/    errorf("Bad stream type passed to myUngetC");
/**/    hadError = true;
/**/  }
/**/}
#endif /* old_code Sat Mar 23 21:00:38 1991 */

static void myClose(stream)
Stream	stream;
{
  if (stream->type == stringStreamType) {
    free(stream->st_str.strBase);
  } else if (stream->type == fileStreamType) {
    fclose(stream->st_file);
#ifdef USE_READLINE
  } else if (stream->type == readlineStreamType) {
    if (stream->st_str.strBase) {
      free(stream->st_str.strBase);
      stream->st_str.strBase = 0;
    }
#endif /* USE_READLINE */
  } else {
    errorf("Bad stream type passed to myClose");
    hadError = true;
  }
}


#ifdef USE_READLINE

void initializeReadline()
{
  /* Allow conditional parsing of the ~/.inputrc file. */
  rl_readline_name = "Smalltalk";
}
     
#endif /* USE_READLINE */

/* Return true if current compilation stream is a FileStream associated
 * with a file in kernel directory. 
 */ 
mst_Boolean isKernelFile()
{
  char		*fullFileName;
  mst_Boolean	result;	

  if ((strcmp(inStream->fileName, "stdin") == 0)
      || (getMethodStartPos() > getCurFilePos())) {
    return (true);
  }

  fullFileName = getFullFileName(inStream->fileName);
#if defined(MSDOS) /* !!! Add others like NT, OS2, etc */
  fullFileName += 2;		/* skip over "<drive>:"  */
#endif
  result = (strstr(fullFileName, KERNEL_PATH)  == fullFileName);
  free(fullFileName);

  return (result);
}

/* Return current method source string from open FileStream */
char *getMethodSourceFromCurFile()
{
  char 		*buf;
  int		endPos, length, startPos;
	
  startPos = getMethodStartPos();
  endPos = getCurFilePos(); 
  /* The second -1 removes the terminating '!' */
  length = endPos  - startPos - 1 - 1;
  buf = (char *)malloc(length + 1);
  fseek(inStream->st_file, startPos, 0);
  fread(buf, length, 1, inStream->st_file);
  buf[length] = '\0';
  /* Restore old file position */
  fseek(inStream->st_file, endPos, 0); 
  return(buf);
}
