#include "config.h"
#include "sl-feat.h"

#include <stdio.h>
#include <string.h>

#ifdef HAVE_STDLIB_H
# include <stdlib.h>
#endif

#include "slang.h"
#include "_slang.h"

#define MAX_TOKEN_LEN 254
#define MAX_FILE_LINE_LEN 256

static char Empty_Line[1] = {0};

static char *Input_Line = Empty_Line;
static char *Input_Line_Pointer;

static SLPreprocess_Type *This_SLpp;

static SLang_Load_Type *LLT;

static char *map_token_to_string (_SLang_Token_Type *tok)
{
   char *s;
   static char numbuf [32];
   unsigned char type;
   s = NULL;

   if (tok != NULL) type = tok->type;
   else type = 0;

   switch (type)
     {
      case 0:
	s = "??";
	break;

      case INT_TOKEN:
	s = numbuf;
	sprintf (s, "%d", tok->v.i_val);
	break;

      case OBRACKET_TOKEN: s = "["; break;
      case CBRACKET_TOKEN: s = "]"; break;
      case OPAREN_TOKEN: s = "("; break;
      case CPAREN_TOKEN: s = ")"; break;
      case OBRACE_TOKEN: s = "{"; break;
      case CBRACE_TOKEN: s = "}"; break;
      case DEREF_TOKEN: s = "@"; break;
      case POUND_TOKEN: s = "#"; break;
      case COMMA_TOKEN: s = ","; break;
      case SEMICOLON_TOKEN: s = ";"; break;
      case COLON_TOKEN: s = ":"; break;

#if SLANG_HAS_FLOAT
      case SLANG_DOUBLE_TYPE:
      case COMPLEX_TOKEN:
#endif
      case IDENT_TOKEN:
	if ((tok->free_sval_flag == 0) || (tok->num_refs == 0))
	  break;
	/* drop */
      default:
	s = tok->v.s_val;
	break;
     }

   if (s == NULL)
     {
	s = numbuf;
	sprintf (s, "(0x%02X)", type);
     }

   return s;
}

static char *make_line_file_error (_SLang_Token_Type *tok, char *dsc, char *buf, int line, char *file)
{
#if _SLANG_HAS_DEBUG_CODE
   if (tok != NULL) line = tok->line_number;
#endif
   if (file == NULL) file = "??";   
   sprintf (buf, "%s: found '%s', line %d, file: %s",
	      dsc, map_token_to_string (tok), line, file);
   return buf;
}

void _SLparse_error(char *str, _SLang_Token_Type *tok, int flag)
{
   char buf [1024];

   if (str == NULL)
     str = "Parse Error";

   make_line_file_error (tok, str, buf, LLT->line_num, (char *) LLT->name);

   if ((flag == 0) && SLang_Error)
     return;

   SLang_verror (SL_SYNTAX_ERROR, "%s", buf);
}

static void do_line_file_error (int line, char *file)
{
   SLang_verror (SL_SYNTAX_ERROR,
		 "called from line %d, file: %s", line, file);
}

#define ALPHA_CHAR 	1
#define DIGIT_CHAR	2
#define EXCL_CHAR 	3
#define SEP_CHAR	4
#define OP_CHAR		5
#define DOT_CHAR	6
#define BOLDOT_CHAR	7
#define DQUOTE_CHAR	8
#define QUOTE_CHAR	9
#define COMMENT_CHAR	10
#define NL_CHAR		11
#define BAD_CHAR	12
#define WHITE_CHAR	13

#define CHAR_EOF	255

#define CHAR_CLASS(c)	(Char_Type_Table[(c)][0])
#define CHAR_DATA(c)	(Char_Type_Table[(c)][1])

static unsigned char Char_Type_Table[256][2] =
{
 { NL_CHAR, 0 },	/* 0x0 */   { BAD_CHAR, 0 },	/* 0x1 */
 { BAD_CHAR, 0 },	/* 0x2 */   { BAD_CHAR, 0 },	/* 0x3 */
 { BAD_CHAR, 0 },	/* 0x4 */   { BAD_CHAR, 0 },	/* 0x5 */
 { BAD_CHAR, 0 },	/* 0x6 */   { BAD_CHAR, 0 },	/* 0x7 */
 { WHITE_CHAR, 0 },	/* 0x8 */   { WHITE_CHAR, 0 },	/* 0x9 */
 { NL_CHAR, 0 },	/* \n */   { WHITE_CHAR, 0 },	/* 0xb */
 { WHITE_CHAR, 0 },	/* 0xc */   { WHITE_CHAR, 0 },	/* \r */
 { BAD_CHAR, 0 },	/* 0xe */   { BAD_CHAR, 0 },	/* 0xf */
 { BAD_CHAR, 0 },	/* 0x10 */  { BAD_CHAR, 0 },	/* 0x11 */
 { BAD_CHAR, 0 },	/* 0x12 */  { BAD_CHAR, 0 },	/* 0x13 */
 { BAD_CHAR, 0 },	/* 0x14 */  { BAD_CHAR, 0 },	/* 0x15 */
 { BAD_CHAR, 0 },	/* 0x16 */  { BAD_CHAR, 0 },	/* 0x17 */
 { BAD_CHAR, 0 },	/* 0x18 */  { BAD_CHAR, 0 },	/* 0x19 */
 { BAD_CHAR, 0 },	/* 0x1a */  { BAD_CHAR, 0 },	/* 0x1b */
 { BAD_CHAR, 0 },	/* 0x1c */  { BAD_CHAR, 0 },	/* 0x1d */
 { BAD_CHAR, 0 },	/* 0x1e */  { BAD_CHAR, 0 },	/* 0x1f */
 { WHITE_CHAR, 0 },	/* 0x20 */  { EXCL_CHAR, 9 },	/* ! */
 { DQUOTE_CHAR, 0 },	/* " */	    { SEP_CHAR, POUND_TOKEN },	/* # */
 { ALPHA_CHAR, 0 },	/* $ */	    { NL_CHAR, 0 },/* % */
 { OP_CHAR, 3 },	/* & */	    { QUOTE_CHAR, 0 },	/* ' */
 { SEP_CHAR, OPAREN_TOKEN },	/* ( */	    { SEP_CHAR, CPAREN_TOKEN },	/* ) */
 { OP_CHAR, 5 },	/* * */	    { OP_CHAR, 15 },	/* + */
 { SEP_CHAR, COMMA_TOKEN },	/* , */	    { OP_CHAR, 14 },	/* - */
 { DOT_CHAR, 0 },	/* . */	    { OP_CHAR, 7 },	/* / */
 { DIGIT_CHAR, 0 },	/* 0 */	    { DIGIT_CHAR, 0 },	/* 1 */
 { DIGIT_CHAR, 0 },	/* 2 */	    { DIGIT_CHAR, 0 },	/* 3 */
 { DIGIT_CHAR, 0 },	/* 4 */	    { DIGIT_CHAR, 0 },	/* 5 */
 { DIGIT_CHAR, 0 },	/* 6 */	    { DIGIT_CHAR, 0 },	/* 7 */
 { DIGIT_CHAR, 0 },	/* 8 */	    { DIGIT_CHAR, 0 },	/* 9 */
 { SEP_CHAR, COLON_TOKEN },	/* : */	    { SEP_CHAR, SEMICOLON_TOKEN },	/* ; */
 { OP_CHAR, 11 },	/* < */	    { OP_CHAR, 12 },	/* = */
 { OP_CHAR, 10 },	/* > */	    { BAD_CHAR, 0 },	/* ? */
 { SEP_CHAR, DEREF_TOKEN },	/* @ */	    { ALPHA_CHAR, 0 },	/* A */
 { ALPHA_CHAR, 0 },	/* B */	    { ALPHA_CHAR, 0 },	/* C */
 { ALPHA_CHAR, 0 },	/* D */	    { ALPHA_CHAR, 0 },	/* E */
 { ALPHA_CHAR, 0 },	/* F */	    { ALPHA_CHAR, 0 },	/* G */
 { ALPHA_CHAR, 0 },	/* H */	    { ALPHA_CHAR, 0 },	/* I */
 { ALPHA_CHAR, 0 },	/* J */	    { ALPHA_CHAR, 0 },	/* K */
 { ALPHA_CHAR, 0 },	/* L */	    { ALPHA_CHAR, 0 },	/* M */
 { ALPHA_CHAR, 0 },	/* N */	    { ALPHA_CHAR, 0 },	/* O */
 { ALPHA_CHAR, 0 },	/* P */	    { ALPHA_CHAR, 0 },	/* Q */
 { ALPHA_CHAR, 0 },	/* R */	    { ALPHA_CHAR, 0 },	/* S */
 { ALPHA_CHAR, 0 },	/* T */	    { ALPHA_CHAR, 0 },	/* U */
 { ALPHA_CHAR, 0 },	/* V */	    { ALPHA_CHAR, 0 },	/* W */
 { ALPHA_CHAR, 0 },	/* X */	    { ALPHA_CHAR, 0 },	/* Y */
 { ALPHA_CHAR, 0 },	/* Z */	    { SEP_CHAR, OBRACKET_TOKEN },	/* [ */
 { BAD_CHAR, 0 },	/* \ */	    { SEP_CHAR, CBRACKET_TOKEN },	/* ] */
 { OP_CHAR, 4 },	/* ^ */	    { ALPHA_CHAR, 0 },	/* _ */
 { BAD_CHAR, 0 },	/* ` */	    { ALPHA_CHAR, 0 },	/* a */
 { ALPHA_CHAR, 0 },	/* b */	    { ALPHA_CHAR, 0 },	/* c */
 { ALPHA_CHAR, 0 },	/* d */	    { ALPHA_CHAR, 0 },	/* e */
 { ALPHA_CHAR, 0 },	/* f */	    { ALPHA_CHAR, 0 },	/* g */
 { ALPHA_CHAR, 0 },	/* h */	    { ALPHA_CHAR, 0 },	/* i */
 { ALPHA_CHAR, 0 },	/* j */	    { ALPHA_CHAR, 0 },	/* k */
 { ALPHA_CHAR, 0 },	/* l */	    { ALPHA_CHAR, 0 },	/* m */
 { ALPHA_CHAR, 0 },	/* n */	    { ALPHA_CHAR, 0 },	/* o */
 { ALPHA_CHAR, 0 },	/* p */	    { ALPHA_CHAR, 0 },	/* q */
 { ALPHA_CHAR, 0 },	/* r */	    { ALPHA_CHAR, 0 },	/* s */
 { ALPHA_CHAR, 0 },	/* t */	    { ALPHA_CHAR, 0 },	/* u */
 { ALPHA_CHAR, 0 },	/* v */	    { ALPHA_CHAR, 0 },	/* w */
 { ALPHA_CHAR, 0 },	/* x */	    { ALPHA_CHAR, 0 },	/* y */
 { ALPHA_CHAR, 0 },	/* z */	    { SEP_CHAR, OBRACE_TOKEN },	/* { */
 { OP_CHAR, 1 },	/* | */	    { SEP_CHAR, CBRACE_TOKEN },	/* } */
 { OP_CHAR, 8 },	/* ~ */	    { BAD_CHAR, 0 },	/* 0x7f */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
 { BAD_CHAR, 0 },	/* � */	    { BAD_CHAR, 0 },	/* � */
};

static unsigned char prep_get_char (void)
{
   register unsigned char ch;

   if (0 != (ch = *Input_Line_Pointer++))
     return ch;

   Input_Line_Pointer--;
   return 0;
}

static void unget_prep_char (unsigned char ch)
{
   if ((Input_Line_Pointer != Input_Line)
       && (ch != 0))
     Input_Line_Pointer--;
   /* *Input_Line_Pointer = ch; -- Do not modify the Input_Line */
}

#include "keywhash.c"

static int get_ident_token (_SLang_Token_Type *tok, unsigned char *s, unsigned int len)
{
   unsigned char ch;
   unsigned char type;
   Keyword_Table_Type *table;

   while (1)
     {
	ch = prep_get_char ();
	type = CHAR_CLASS (ch);
	if ((type != ALPHA_CHAR) && (type != DIGIT_CHAR))
	  {
	     unget_prep_char (ch);
	     break;
	  }
	s [len++] = ch;
     }

   s[len] = 0;

   /* check if keyword */
   table = is_keyword ((char *) s, len);
   if (table != NULL)
     {
	tok->v.s_val = table->name;
	return (tok->type = table->type);
     }

   tok->v.s_val = _SLstring_make_hashed_string ((char *)s, len, &tok->hash);
   tok->free_sval_flag = 1;
   return (tok->type = IDENT_TOKEN);
}

static int get_number_token (_SLang_Token_Type *tok, unsigned char *s, unsigned int len)
{
   unsigned char ch;
   unsigned char type;

   /* Look for pattern  [0-9.xX]*([eE][-+]?[digits])?[ijf]? */
   while (1)
     {
	ch = prep_get_char ();

	type = CHAR_CLASS (ch);
	if ((type != DIGIT_CHAR) && (type != DOT_CHAR))
	  {
	     if ((ch != 'x') && (ch != 'X'))
	       break;
	     /* It must be hex */
	     do
	       {
		  s[len++] = ch;
		  ch = prep_get_char ();
		  type = CHAR_CLASS (ch);
	       }
	     while ((type == DIGIT_CHAR) || (type == ALPHA_CHAR));
	     break;
	  }
	s [len++] = ch;
     }

   /* At this point, type and ch are synchronized */

   if ((ch == 'e') || (ch == 'E'))
     {
	s[len++] = ch;
	ch = prep_get_char ();
	if ((ch == '+') || (ch == '-'))
	  {
	     s[len++] = ch;
	     ch = prep_get_char ();
	  }

	while (DIGIT_CHAR == (type = CHAR_CLASS(ch)))
	  {
	     s[len++] = ch;
	     ch = prep_get_char ();
	  }
     }

   while (ALPHA_CHAR == type)
     {
	s[len++] = ch;
	ch = prep_get_char ();
	type = CHAR_CLASS(ch);
     }

   unget_prep_char (ch);
   s[len] = 0;

   switch (SLang_guess_type ((char *) s))
     {
#if SLANG_HAS_FLOAT
      case SLANG_DOUBLE_TYPE:
	tok->v.s_val = _SLstring_make_hashed_string ((char *)s, len, &tok->hash);
	tok->free_sval_flag = 1;
	return (tok->type = DOUBLE_TOKEN);
#endif
#if SLANG_HAS_COMPLEX
      case SLANG_COMPLEX_TYPE:
	tok->v.s_val = _SLstring_make_hashed_string ((char *)s, len, &tok->hash);
	tok->free_sval_flag = 1;
	return (tok->type = COMPLEX_TOKEN);
#endif
      case SLANG_INT_TYPE:
	tok->v.i_val = SLatoi (s);
	return (tok->type = INT_TOKEN);
     }

   tok->v.s_val = (char *) s;
   _SLparse_error ("Not a number", tok, 0);
   return (tok->type = EOF_TOKEN);
}

/* The order here must match the order in _slang.h */
typedef struct
{
   char name[4];
}
Binary_Token_Name_Type;

static Binary_Token_Name_Type Binary_Token_Names [] =
{
   {"^"}, {"+"}, {"-"}, {"*"}, {"/"}, {"<"}, {"<="}, {">"}, {">="}, {"=="},
   {"!="}, {"and"}, {"or"}, {"mod"}, {"&"}, {"shl"}, {"shr"}, {"xor"},{"|"}
};

static char Ops [32][3] =
{
     {0,	0,	0},
     {'|',	0,	BOR_TOKEN},
     {'|',	'|',	EOF_TOKEN},
     {'&',	0,	BAND_TOKEN},
     {'^',	0,	POW_TOKEN},
     {'*',	0,	MUL_TOKEN},
     {'&',	'&',	EOF_TOKEN},
     {'/',	0,	DIV_TOKEN},
     {'~',	0,	BNOT_TOKEN},
     {0,	0,	0},
     {'>',	0,	GT_TOKEN},
     {'<',	0,	LT_TOKEN},
     {'=',	0,	ASSIGN_TOKEN},
     {0,	0,	0},
     {'-',	0,	SUB_TOKEN},
     {'+',	0,	ADD_TOKEN},
     {0,	0,	0},
     {0,	0,	0},
     {0,	0,	0},
     {0,	0,	0},
     {0,	0,	0},
     {'!',	'=',	NE_TOKEN},
     {'>',	'=',	GE_TOKEN},
     {'<',	'=',	LE_TOKEN},
     {'=',	'=',	EQ_TOKEN},
     {0,	0,	0},
     {'-',	'=',	MINUSEQS_TOKEN},
     {'+',	'=',	PLUSEQS_TOKEN},
     {'-',	'-',	MINUSMINUS_TOKEN},
     {0,	0,	0},
     {'+',	'+',	PLUSPLUS_TOKEN},
     {0,	0,	0}
};

static int get_op_token (_SLang_Token_Type *tok, char ch)
{
   char second_char;
   unsigned char type;
   unsigned char h;
   char *op;
   /* operators are: + - / * ++ -- += -= = == != > < >= <= | etc..
    * These lex to the longest valid operator token.
    */

   type = EOF_TOKEN;
   second_char = prep_get_char ();

   h = CHAR_DATA((unsigned char) ch);
   op = &(Ops[h + CHAR_DATA((unsigned char)second_char)][0]);

   if ((h >= 32)
       || (op [2] == 0) || (op[0] != ch) || (op[1] != second_char))
     {
	tok->v.s_val = op = &(Ops[h][0]);
	unget_prep_char (second_char);
     }

   type = (unsigned char) op[2];

   if (type != EOF_TOKEN)
     {
	if (IS_BINARY_OP(type))
	  tok->v.s_val = Binary_Token_Names [type - FIRST_BINARY_OP].name;
     }
   else
     _SLparse_error ("Operator not supported", NULL, 0);

   return tok->type = type;
#if 0

   switch (ch)
     {
      case '+':
	if (second_char == '+')
	  type = PLUSPLUS_TOKEN;
	else if (second_char == '=')
	  type = PLUSEQS_TOKEN;
	else
	  {
	     type = ADD_TOKEN;
	     do_unget = 1;
	  }
	break;

      case '-':
	if (second_char == '-')
	  type = MINUSMINUS_TOKEN;
	else if (second_char == '=')
	  type = MINUSEQS_TOKEN;
	else
	  {
	     type = SUB_TOKEN;
	     do_unget = 1;
	  }
	break;

      case '*':
	type = MUL_TOKEN;
	do_unget = 1;
	break;

      case '/':
	type = DIV_TOKEN;
	do_unget = 1;
	break;

      case '^':
	type = POW_TOKEN;
	do_unget = 1;
	break;

      case '=':
	if (second_char == '=')
	  type = EQ_TOKEN;
	else
	  {
	     do_unget = 1;
	     type = ASSIGN_TOKEN;
	  }
	break;

      case '>':
	if (second_char == '=')
	  type = GE_TOKEN;
	else
	  {
	     do_unget = 1;
	     type = GT_TOKEN;
	  }
	break;

      case '<':
	if (second_char == '=')
	  type = LE_TOKEN;
	else
	  {
	     do_unget = 1;
	     type = LT_TOKEN;
	  }
	break;

      case '!':
	if (second_char == '=')
	  type = NE_TOKEN;
	else
	  {
	     do_unget = 1;
	     tok->v.s_val = "!";
	  }
	break;

      case '&':
	if (second_char == '&')
	  _SLparse_error ("&& not supported", NULL, 0);
	else
	  {
	     type = BAND_TOKEN;
	     do_unget = 1;
	  }
	break;

      case '|':
	if (second_char == '|')
	  _SLparse_error ("|| not supported", NULL, 0);
	else
	  {
	     type = BOR_TOKEN;
	     do_unget = 1;
	  }
	break;

      case '~':
	do_unget = 1;
	type = BNOT_TOKEN;
	tok->v.s_val = "~";
	break;
     }

   if (do_unget) unget_prep_char (second_char);

   if (type == EOF_TOKEN)
     _SLparse_error ("Operator not supported", NULL, 0);
   else if (IS_BINARY_OP(type))
     tok->v.s_val = Binary_Token_Names [type - FIRST_BINARY_OP].name;

   return tok->type = type;
#endif
}

static int get_string_token (_SLang_Token_Type *tok, unsigned char quote_char,
			     unsigned char *s)
{
   unsigned char ch;
   unsigned int len = 0;
   int has_quote = 0;

   while (1)
     {
	ch = prep_get_char ();
	if (ch == 0)
	  {
	     _SLparse_error("Expecting quote-character", NULL, 0);
	     return (tok->type = EOF_TOKEN);
	  }
	if (ch == quote_char) break;

	s[len++] = ch;

	if (len == (MAX_TOKEN_LEN - 1))
	  {
	     _SLparse_error ("String too long for buffer", NULL, 0);
	     return (tok->type == EOF_TOKEN);
	  }

	if (ch == '\\')
	  {
	     has_quote = 1;
	     ch = prep_get_char ();
	     s[len++] = ch;
	  }
     }

   s[len] = 0;

   if (has_quote)
     SLexpand_escaped_string ((char *) s, (char *)s, (char *)s + len);

   if ('"' == quote_char)
     {
	tok->v.s_val = _SLstring_make_hashed_string ((char *)s,
						     strlen ((char *)s),
						     &tok->hash);
	tok->free_sval_flag = 1;
	return (tok->type = STRING_TOKEN);
     }

   /* else single character */
   if (s[1] != 0)
     {
	_SLparse_error("Single char expected", NULL, 0);
	return (tok->type = EOF_TOKEN);
     }

   tok->v.i_val = s[0];
   return (tok->type = CHAR_TOKEN);
}

static int extract_token (_SLang_Token_Type *tok, unsigned char ch, unsigned char t)
{
   unsigned char s [MAX_TOKEN_LEN];
   unsigned int slen;

   s[0] = (char) ch;
   slen = 1;

   switch (t)
     {
      case ALPHA_CHAR:
	return get_ident_token (tok, s, slen);

      case OP_CHAR:
	return get_op_token (tok, ch);

      case DIGIT_CHAR:
	return get_number_token (tok, s, slen);

      case EXCL_CHAR:
	ch = prep_get_char ();
	s [slen++] = ch;
	t = CHAR_CLASS(ch);
	if (t == ALPHA_CHAR) return get_ident_token (tok, s, slen);
	if (t == OP_CHAR)
	  {
	     unget_prep_char (ch);
	     return get_op_token (tok, '!');
	  }
	_SLparse_error("Misplaced !", NULL, 0);
	return -1;

      case DOT_CHAR:
	ch = prep_get_char ();
	if (DIGIT_CHAR == CHAR_CLASS(ch))
	  {
	     s [slen++] = ch;
	     return get_number_token (tok, s, slen);
	  }
	unget_prep_char (ch);
	return (tok->type = DOT_TOKEN);

      case SEP_CHAR:
	return (tok->type = CHAR_DATA(ch));

      case DQUOTE_CHAR:
      case QUOTE_CHAR:
	return get_string_token (tok, ch, s);

      default:
	_SLparse_error("Invalid character", NULL, 0);
	return (tok->type = EOF_TOKEN);
     }
}

int _SLget_rpn_token (_SLang_Token_Type *tok)
{
   unsigned char ch;

   tok->v.s_val = "??";
   while ((ch = *Input_Line_Pointer) != 0)
     {
	unsigned char t;

	Input_Line_Pointer++;
	if (WHITE_CHAR == (t = CHAR_CLASS(ch)))
	  continue;

	if (NL_CHAR == t)
	  break;

	return extract_token (tok, ch, t);
     }
   Input_Line_Pointer = Empty_Line;
   return EOF_TOKEN;
}

int _SLget_token (_SLang_Token_Type *tok)
{
   unsigned char ch;
   unsigned char t;

   tok->num_refs = 1;
   tok->free_sval_flag = 0;
   tok->v.s_val = "??";
#if _SLANG_HAS_DEBUG_CODE
   tok->line_number = LLT->line_num;
#endif
   if (SLang_Error || (Input_Line == NULL))
     return (tok->type = EOF_TOKEN);

   while (1)
     {
	ch = *Input_Line_Pointer++;
	if (WHITE_CHAR == (t = CHAR_CLASS (ch)))
	  continue;

	if (t != NL_CHAR)
	  return extract_token (tok, ch, t);

	do
	  {
	     LLT->line_num++;
#if _SLANG_HAS_DEBUG_CODE
	     tok->line_number++;
#endif
	     Input_Line = LLT->read(LLT);
	     if ((NULL == Input_Line) || SLang_Error)
	       {
		  Input_Line_Pointer = Input_Line = NULL;
		  return (tok->type = EOF_TOKEN);
	       }
	  }
	while (0 == SLprep_line_ok(Input_Line, This_SLpp));

	Input_Line_Pointer = Input_Line;
	if (*Input_Line_Pointer == '.')
	  {
	     Input_Line_Pointer++;
	     return tok->type = RPN_TOKEN;
	  }
     }
}

static int prep_exists_function (char *line, char comment)
{
   char buf[MAX_FILE_LINE_LEN], *b, *bmax;
   unsigned char ch;

   bmax = buf + (sizeof (buf) - 1);

   while (1)
     {
	/* skip whitespace */
	while ((ch = (unsigned char) *line),
	       ch && (ch != '\n') && (ch <= ' '))
	  line++;

	if ((ch <= '\n')
	    || (ch == (unsigned char) comment)) break;

	b = buf;
	while ((ch = (unsigned char) *line) > ' ')
	  {
	     if (b < bmax) *b++ = (char) ch;
	     line++;
	  }
	*b = 0;

	if (SLang_is_defined (buf))
	  return 1;
     }

   return 0;
}

int SLang_load_object (SLang_Load_Type *x)
{
   SLPreprocess_Type this_pp;
   SLPreprocess_Type *save_this_pp;
   SLang_Load_Type *save_llt;
   char *save_input_line, *save_input_line_ptr;
#if _SLANG_HAS_DEBUG_CODE
   int save_compile_line_num_info;
#endif
   
   if (SLprep_exists_hook == NULL)
     SLprep_exists_hook = prep_exists_function;

   if (-1 == SLprep_open_prep (&this_pp)) return -1;

   if (-1 == _SLcompile_push_context ())
     return -1;

#if _SLANG_HAS_DEBUG_CODE
   save_compile_line_num_info = _SLang_Compile_Line_Num_Info;
#endif
   save_this_pp = This_SLpp;
   save_input_line = Input_Line;
   save_input_line_ptr = Input_Line_Pointer;
   save_llt = LLT;

   This_SLpp = &this_pp;
   Input_Line_Pointer = Input_Line = Empty_Line;
   LLT = x;

   x->line_num = 0;
   x->parse_level = 0;
   _SLang_Auto_Declare_Globals = x->auto_declare_globals;

#if _SLANG_HAS_DEBUG_CODE
   _SLang_Compile_Line_Num_Info = 0;
#endif

   _SLparse_start (x);
   if (SLang_Error)
     do_line_file_error (x->line_num, x->name);

   if (save_llt != NULL)
     _SLang_Auto_Declare_Globals = save_llt->auto_declare_globals;
   else
     _SLang_Auto_Declare_Globals = 0;

   if (SLang_Error) SLang_restart (0);

   (void) _SLcompile_pop_context ();


   Input_Line = save_input_line;
   Input_Line_Pointer = save_input_line_ptr;
   LLT = save_llt;
   This_SLpp = save_this_pp;

#if _SLANG_HAS_DEBUG_CODE
   _SLang_Compile_Line_Num_Info = save_compile_line_num_info;
#endif

   if (SLang_Error) return -1;
   return 0;
}

SLang_Load_Type *SLallocate_load_type (char *name)
{
   SLang_Load_Type *x;

   if (NULL == (x = (SLang_Load_Type *)SLmalloc (sizeof (SLang_Load_Type))))
     return NULL;
   memset ((char *) x, 0, sizeof (SLang_Load_Type));

   if (name == NULL) name = "";

   x->name = SLang_create_slstring (name);
   if (x->name == NULL)
     {
	SLfree ((char *) x);
	return NULL;
     }
   return x;
}

void SLdeallocate_load_type (SLang_Load_Type *x)
{
   if (x != NULL)
     {
	SLang_free_slstring (x->name);
	SLfree ((char *) x);
     }
}

typedef struct
{
   char *string;
   char *ptr;
}
String_Client_Data_Type;

static char *read_from_string (SLang_Load_Type *x)
{
   String_Client_Data_Type *data;
   char *s, *s1, ch;

   data = (String_Client_Data_Type *)x->client_data;
   s1 = s = data->ptr;

   if (*s == 0)
     return NULL;

   while ((ch = *s) != 0)
     {
	s++;
	if (ch == '\n')
	  break;
     }

   data->ptr = s;
   return s1;
}

int SLang_load_string (char *string)
{
   SLang_Load_Type *x;
   String_Client_Data_Type data;
   int ret;

   if (string == NULL)
     return -1;

   /* Grab a private copy in case loading modifies string */
   if (NULL == (string = SLang_create_slstring (string)))
     return -1;

   if (NULL == (x = SLallocate_load_type (string)))
     {
	SLang_free_slstring (string);
	return -1;
     }

   x->client_data = (VOID_STAR) &data;
   x->read = read_from_string;

   data.ptr = data.string = string;
   if (-1 == (ret = SLang_load_object (x)))
     SLang_verror (SLang_Error, "called from eval: %s", string);

   SLang_free_slstring (string);
   SLdeallocate_load_type (x);
   return ret;
}

typedef struct
{
   char *buf;
   FILE *fp;
}
File_Client_Data_Type;

char *SLang_User_Prompt;
static char *read_from_file (SLang_Load_Type *x)
{
   FILE *fp;
   File_Client_Data_Type *c;

   c = (File_Client_Data_Type *)x->client_data;
   fp = c->fp;

   if ((fp == stdin) && (SLang_User_Prompt != NULL))
     {
	fputs (SLang_User_Prompt, stdout);
	fflush (stdout);
     }

   return fgets (c->buf, MAX_FILE_LINE_LEN, c->fp);
}

/* Note that file could be freed from Slang during run of this routine
 * so get it and store it !! (e.g., autoloading)
 */
int (*SLang_Load_File_Hook) (char *);
int SLang_load_file (char *f)
{
   File_Client_Data_Type client_data;
   SLang_Load_Type *x;
   char *name, *buf;
   FILE *fp;

   if (SLang_Load_File_Hook != NULL)
     return (*SLang_Load_File_Hook) (f);

   if (f == NULL) name = "<stdin>"; else name = f;

   name = SLang_create_slstring (name);
   if (name == NULL)
     return -1;

   if (NULL == (x = SLallocate_load_type (name)))
     {
	SLang_free_slstring (name);
	return -1;
     }

   buf = NULL;

   if (f != NULL)
     fp = fopen (f, "r");
   else
     fp = stdin;

   if (fp == NULL)
     SLang_verror (SL_OBJ_NOPEN, "Unable to open %s", name);
   else if (NULL != (buf = SLmalloc (MAX_FILE_LINE_LEN + 1)))
     {
	client_data.fp = fp;
	client_data.buf = buf;
	x->client_data = (VOID_STAR) &client_data;
	x->read = read_from_file;

	(void) SLang_load_object (x);
     }

   if ((fp != NULL) && (fp != stdin))
     fclose (fp);

   SLfree (buf);
   SLang_free_slstring (name);
   SLdeallocate_load_type (x);

   if (SLang_Error)
     return -1;

   return 0;
}

int SLang_guess_type (char *t)
{
   char *p;
   register char ch;

   if (*t == '-') t++;
   p = t;
#if SLANG_HAS_FLOAT
   if (*p != '.')
     {
#endif
	while ((*p >= '0') && (*p <= '9')) p++;
	if (t == p) return (SLANG_STRING_TYPE);
	if ((*p == 'x') && (p == t + 1))   /* 0x?? */
	  {
	     p++;
	     while (ch = *p,
		    ((ch >= '0') && (ch <= '9'))
		    || (((ch | 0x20) >= 'a') && ((ch | 0x20) <= 'f'))) p++;
	     if (*p != 0)
	       return(SLANG_STRING_TYPE);
	  }
	if (*p == 0) return(SLANG_INT_TYPE);
#if SLANG_HAS_FLOAT
     }

   /* now down to double case */
   if (*p == '.')
     {
	p++;
	while ((*p >= '0') && (*p <= '9')) p++;
     }
   if (*p == 0) return(SLANG_DOUBLE_TYPE);
   if ((*p != 'e') && (*p != 'E'))
     {
# if SLANG_HAS_COMPLEX
	if (((*p == 'i') || (*p == 'j'))
	    && (p[1] == 0))
	  return SLANG_COMPLEX_TYPE;
# endif
	/* FIXME!!  I need to check whether or not single precision numbers
	 * have been defined.  If so, SLANG_FLOAT_TYPE should be returned.
	 */
	if ((*p == 'f') && (p[1] == 0))
	  return SLANG_DOUBLE_TYPE;

	return SLANG_STRING_TYPE;
     }

   p++;
   if ((*p == '-') || (*p == '+')) p++;
   while ((*p >= '0') && (*p <= '9')) p++;
   if (*p != 0)
     {
# if SLANG_HAS_COMPLEX
	if (((*p == 'i') || (*p == 'j'))
	    && (p[1] == 0))
	  return SLANG_COMPLEX_TYPE;
# endif
	/* FIXME!!  I need to check whether or not single precision numbers
	 * have been defined.  If so, SLANG_FLOAT_TYPE should be returned.
	 */
	if ((*p == 'f') && (p[1] == 0))
	  return SLANG_DOUBLE_TYPE;

	return SLANG_STRING_TYPE;
     }
   return SLANG_DOUBLE_TYPE;
#else
   return SLANG_STRING_TYPE;
#endif				       /* SLANG_HAS_FLOAT */
}

int SLatoi (unsigned char *s)
{
   register unsigned char ch;
   register unsigned int value;
   register int base;

   if (*s != '0') return atoi((char *) s);

   /* look for 'x' which indicates hex */
   s++;
   if ((*s | 0x20) == 'x')
     {
	base = 16;
	s++;
	if (*s == 0)
	  {
	     SLang_Error = SL_SYNTAX_ERROR;
	     return -1;
	  }
     }
   else base = 8;

   value = 0;
   while ((ch = *s++) != 0)
     {
	char ch1 = ch | 0x20;
	switch (ch1)
	  {
	   default:
	     SLang_Error = SL_SYNTAX_ERROR;
	     break;
	   case '8':
	   case '9':
	     if (base != 16) SLang_Error = SL_SYNTAX_ERROR;
	     /* drop */
	   case '0':
	   case '1':
	   case '2':
	   case '3':
	   case '4':
	   case '5':
	   case '6':
	   case '7':
	     ch1 -= '0';
	     break;

	   case 'a':
	   case 'b':
	   case 'c':
	   case 'd':
	   case 'e':
	   case 'f':
	     if (base != 16) SLang_Error = SL_SYNTAX_ERROR;
	     ch1 = (ch1 - 'a') + 10;
	     break;
	  }
	value = value * base + ch1;
     }
   return (int) value;
}

static char *check_byte_compiled_token (char *buf)
{
   unsigned int len_lo, len_hi, len;

   len_lo = (unsigned char) *Input_Line_Pointer++;
   if ((len_lo < 32)
       || ((len_hi = (unsigned char)*Input_Line_Pointer++) < 32)
       || ((len = (len_lo - 32) | ((len_hi - 32) << 7)) >= MAX_TOKEN_LEN))
     {
	SLang_doerror ("Byte compiled file appears corrupt");
	return NULL;
     }

   SLMEMCPY (buf, Input_Line_Pointer, len);
   buf += len;
   Input_Line_Pointer += len;
   *buf = 0;
   return buf;
}

void _SLcompile_byte_compiled (void)
{
   unsigned char type;
   _SLang_Token_Type tok;
   char buf[MAX_TOKEN_LEN];
   char *ebuf;

   memset ((char *) &tok, 0, sizeof (_SLang_Token_Type));

   while (SLang_Error == 0)
     {
	top_of_switch:
	type = (unsigned char) *Input_Line_Pointer++;
	switch (type)
	  {
	   case '\n':
	   case 0:
	     if (NULL == (Input_Line = LLT->read(LLT)))
	       {
		  Input_Line_Pointer = Input_Line = NULL;
		  return;
	       }
	     Input_Line_Pointer = Input_Line;
	     goto top_of_switch;
	     
	   case LINE_NUM_TOKEN:
	   case CHAR_TOKEN:
	   case INT_TOKEN:
	     if (NULL == check_byte_compiled_token (buf))
	       return;
	     tok.v.i_val = atoi (buf);
	     break;

	   case COMPLEX_TOKEN:
	   case DOUBLE_TOKEN:
	     if (NULL == check_byte_compiled_token (buf))
	       return;
	     tok.v.s_val = buf;
	     break;

	   case ESC_STRING_TOKEN:
	     if (NULL == (ebuf = check_byte_compiled_token (buf)))
	       return;
	     SLexpand_escaped_string (buf, buf, ebuf);
	     tok.v.s_val = buf;
	     tok.hash = _SLcompute_string_hash (buf);
	     type = STRING_TOKEN;
	     break;
	     
	   case DOT_TOKEN:
	   case STRING_TOKEN:
	   case IDENT_TOKEN:
	   case _REF_TOKEN:
	   case _DEREF_ASSIGN_TOKEN:
	   case _SCALAR_ASSIGN_TOKEN:
	   case _SCALAR_PLUSEQS_TOKEN:
	   case _SCALAR_MINUSEQS_TOKEN:
	   case _SCALAR_PLUSPLUS_TOKEN:
	   case _SCALAR_POST_PLUSPLUS_TOKEN:
	   case _SCALAR_MINUSMINUS_TOKEN:
	   case _SCALAR_POST_MINUSMINUS_TOKEN:
	   case _STRUCT_ASSIGN_TOKEN:
	   case _STRUCT_PLUSEQS_TOKEN:
	   case _STRUCT_MINUSEQS_TOKEN:
	   case _STRUCT_POST_MINUSMINUS_TOKEN:
	   case _STRUCT_MINUSMINUS_TOKEN:
	   case _STRUCT_POST_PLUSPLUS_TOKEN:
	   case _STRUCT_PLUSPLUS_TOKEN:
	     if (NULL == (ebuf = check_byte_compiled_token (buf)))
	       return;
	     tok.v.s_val = buf;
	     tok.hash = _SLstring_hash ((unsigned char *)buf, (unsigned char *)ebuf);
	     break;

	   default:
	     break;
	  }
	tok.type = type;

	(*_SLcompile_ptr) (&tok);
     }
}

static int escape_string (unsigned char *s, unsigned char *buf, unsigned char *buf_max,
			  int *is_escaped)
{
   unsigned char ch;

   *is_escaped = 0;
   while (buf < buf_max)
     {
	ch = *s++;
	switch (ch)
	  {
	   default:
	     *buf++ = ch;
	     break;

	   case 0:
	     *buf = 0;
	     return 0;

	   case '\n':
	     *buf++ = '\\';
	     if (buf < buf_max) *buf++ = 'n';
	     *is_escaped = 1;
	     break;

	   case '\r':
	     *buf++ = '\\';
	     if (buf < buf_max) *buf++ = 'r';
	     *is_escaped = 1;
	     break;

	   case 0x1A:		       /* ^Z */
	     *buf++ = '\\';
	     if (buf < buf_max) *buf++ = 'x';
	     if (buf < buf_max) *buf++ = '1';
	     if (buf < buf_max) *buf++ = 'A';
	     *is_escaped = 1;
	     break;

	   case '\\':
	     *buf++ = ch;
	     if (buf < buf_max) *buf++ = ch;
	     *is_escaped = 1;
	     break;
	  }
     }
   _SLparse_error ("String too long to byte-compile", NULL, 0);
   return -1;
}

static FILE *Byte_Compile_Fp;
static unsigned int Byte_Compile_Line_Len;

static int bytecomp_write_data (char *buf, unsigned int len)
{
   char *err = "Write Error";

   if ((Byte_Compile_Line_Len + len + 1) >= MAX_FILE_LINE_LEN)
     {
	if (EOF == fputs ("\n", Byte_Compile_Fp))
	  {
	     SLang_doerror (err);
	     return -1;
	  }
	Byte_Compile_Line_Len = 0;
     }

   if (EOF == fputs (buf, Byte_Compile_Fp))
     {
	SLang_doerror (err);
	return -1;
     }
   Byte_Compile_Line_Len += len;
   return 0;
}

static void byte_compile_token (_SLang_Token_Type *tok)
{
   unsigned char buf [MAX_TOKEN_LEN + 4], *buf_max;
   unsigned int len;
   char *b3;
   int is_escaped;

   if (SLang_Error) return;

   buf [0] = (unsigned char) tok->type;
   buf [1] = 0;

   buf_max = buf + sizeof(buf);
   b3 = (char *) buf + 3;

   switch (tok->type)
     {
      case LINE_NUM_TOKEN:
      case CHAR_TOKEN:
      case INT_TOKEN:
	sprintf (b3, "%d", tok->v.i_val);
	len = strlen (b3);
	break;

      case STRING_TOKEN:
	if (-1 == escape_string ((unsigned char *) tok->v.s_val, (unsigned char *)b3, buf_max, &is_escaped))
	  return;
	if (is_escaped)
	  buf[0] = ESC_STRING_TOKEN;
	break;

	/* a _SCALAR_* token is attached to an identifier. */
      case _DEREF_ASSIGN_TOKEN:
      case _SCALAR_ASSIGN_TOKEN:
      case _SCALAR_PLUSEQS_TOKEN:
      case _SCALAR_MINUSEQS_TOKEN:
      case _SCALAR_PLUSPLUS_TOKEN:
      case _SCALAR_POST_PLUSPLUS_TOKEN:
      case _SCALAR_MINUSMINUS_TOKEN:
      case _SCALAR_POST_MINUSMINUS_TOKEN:
      case DOT_TOKEN:
      case DOUBLE_TOKEN:
      case COMPLEX_TOKEN:
      case IDENT_TOKEN:
      case _REF_TOKEN:
      case _STRUCT_ASSIGN_TOKEN:
      case _STRUCT_PLUSEQS_TOKEN:
      case _STRUCT_MINUSEQS_TOKEN:
      case _STRUCT_POST_MINUSMINUS_TOKEN:
      case _STRUCT_MINUSMINUS_TOKEN:
      case _STRUCT_POST_PLUSPLUS_TOKEN:
      case _STRUCT_PLUSPLUS_TOKEN:
	strcpy (b3, tok->v.s_val);
	break;

      default:
	b3 = NULL;
     }

   if (b3 != NULL)
     {
	len = strlen (b3);
	buf[1] = (unsigned char) ((len & 0x7F) + 32);
	buf[2] = (unsigned char) (((len >> 7) & 0x7F) + 32);
	len += 3;
     }
   else len = 1;

   (void) bytecomp_write_data ((char *)buf, len);
}

int SLang_byte_compile_file (char *name, int method)
{
   char file [1024];

   (void) method;
   if (strlen (name) + 2 >= sizeof (file))
     {
	SLang_verror (SL_INVALID_PARM, "Filename too long");
	return -1;
     }
   sprintf (file, "%sc", name);
   if (NULL == (Byte_Compile_Fp = fopen (file, "w")))
     {
	SLang_verror(SL_OBJ_NOPEN, "%s: unable to open", file);
	return -1;
     }

   Byte_Compile_Line_Len = 0;
   if (-1 != bytecomp_write_data (".#", 2))
     {
	_SLcompile_ptr = byte_compile_token;
	(void) SLang_load_file (name);
	_SLcompile_ptr = _SLcompile;

	(void) bytecomp_write_data ("\n", 1);
     }

   if (EOF == fclose (Byte_Compile_Fp))
     SLang_doerror ("Write Error");

   if (SLang_Error)
     {
	SLang_verror (0, "Error processing %s", name);
	return -1;
     }
   return 0;
}