compiler.c

basic.c */ /**//* Project:NeuroBasic, basic package*//**/ /* Survey:This is a simple Basic b-code

/****************************************************************/
/*								*/
/* Name:	compiler.c					*/
/*								*/
/* Project:	NeuroBasic, basic package			*/
/*								*/
/* Survey:	This is the Basic source code compiler. It	*/
/*		compiles Basic code into b-code (a low-level	*/
/*		code) which will be down-loaded and executed by	*/
/*		a simple and efficient interpreter on the MUSIC	*/
/*		parallel computer.				*/
/*								*/
/* Author:	Urs Muller					*/
/*		Electronics Laboratory, ETH Zurich		*/
/*		Switzerland					*/
/*								*/
/* Created:	October 21, 1994				*/
/* Modified:	July 28, 1995 (um)				*/
/*								*/
/****************************************************************/


/* system header files */
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <string.h>
#include <stdarg.h>
#include <m_host.h>

/* NeuroBasic header files */
#include "basic.h"
#include "compiler.h"




/* global variables */
/********************/

/*===== compiler state =====*/
static const char	*src_line;	/* a line of source code */
static const char	*src_pos;	/* end of current token */
static MINT		src_line_nr;	/* current line number */
static int		error_flag;
static size_t		b_pos;		/* position in b-code */
static size_t		reloc_pos;	/* pos. in relocation table */
static MINT		nstrconsts;	/* #string constants */
static int		del_strstack;	/* a flage */


/*===== tokens =====*/
static token_value_t	curr_token;	/* current token */
static MFLOAT		curr_value;	/* corresponding value */
static char	       *curr_name=NULL;	/* corresponding name */
static const char      *curr_src_pos;	/* begin. of current token */

/*===== tables =====*/
static symbol_table_t	tab_globvars = {NULL, 0, 0};
static symbol_table_t	tab_locvars = {NULL, 0, 0};
static symbol_table_t	tab_arrays = {NULL, 0, 0};
static symbol_table_t	tab_functions = {NULL, 0, 0};
static symbol_table_t	tab_labels = {NULL, 0, 0};
static symbol_table_t	tab_strconsts = {NULL, 0, 0};
static symbol_table_t	tab_strvars = {NULL, 0, 0};
static symbol_table_t	tab_strnames = {NULL, 0, 0};

static MINT		jmp_ref[PRG_MAX];
static MINT		label_ref[LABEL_MAX];
static ufct_ref_t	fct_ref[FCT_MAX];
static reloc_tab_t	reloc_tab[RELOC_MAX];




/* built-in Basic functions */
/****************************/

static ifct_ref_t ifct_tab[] =
{
  {"abs",		1},	/* absolute value */
  {"ip",		1},	/* integer part */
  {"int",		1},	/* next smaller integer */
  {"floor",		1},	/* equivalent to int() */
  {"fp",		1},	/* fractional part */
  {"ceil",		1},	/* next greater interger */
  
  {"sqrt",		1},	/* square root */
  {"sgn",		1},	/* sign function */
  {"max",		2},	/* maximum of the two arguments */
  {"min",		2},	/* minimum of the two arguments */

  {"log",		1},	/* natural (base e) logarithm */
  {"exp",		1},	/* power to e */
  {"lgt",		1},	/* common (base 10) logarithm */

  {"sin",		1},	/* sine */
  {"asn",		1},	/* arcsine */
  {"cos",		1},	/* cosine */
  {"acs",		1},	/* arccosine */
  {"tan",		1},	/* tangent */
  {"atn",		1},	/* arctangent */
  {"atn2",		2},	/* arctangent of y/x */
  {"sinh",		1},	/* hyperbolic sine */
  {"cosh",		1},	/* hyperbolic cosine */
  {"tanh",		1},	/* hyperbolic tangent */

  {"clock",		0},	/* returns CPU time in seconds */
  {"system",		1},	/* execute shell command */
  {"exist",		1},	/* does variable x exist? */

  {"str$",		1},	/* converts number to string */
  
  {NULL,		0}	/* termination */
}; /* end of ifct_tab */




/* error messages */
/******************/
const char em_rp[]	= "')' expected";
const char em_rbra[]	= "']' expected";
const char em_pr[]	= "Identifier or number expected";
const char em_strpr[]	= "String expected";
const char em_array[]	= "Array name[] expected";
const char em_arr[]	= "Unknown array";
const char em_arrind[]	= "Array index out of range";
const char em_mem[]	= "Host computer out of memory";
const char em_mumem[]	= "Out of memory";
const char em_strterm[] = "Unmatched '\"'";
const char em_nothen[]	= "'then' expected";
const char em_noend[]	= "Command is expected to end here";
const char em_notoken[]	= "Unknown symbol";
const char em_nocom[]	= "Unknown or wrong use of command";
const char em_assign[]	= "Illegal command or '=' expected";
const char em_ass[]	= "Assignments are only allowed to variables";
const char em_nojmp[]	= "Reference to an unknown label or "
			  "program line";
const char em_var[]	= "No value is assigned to variable";
const char em_strvar[]	= "No value is assigned to string variable";
const char em_nofct[]	= "Call to unknown function";
const char em_args[]	= "Wrong number of arguments in function";
const char em_print[]	= "',' or ';' expected";
const char em_comma[]	= "',' expected";
const char em_label[]	= "Name expected";
const char em_name[]	= "Variable name expected";
const char em_dupl[]	= "Label defined twice";
const char em_dupn[]	= "Name defined twice";
const char em_dupf[]	= "Function defined twice";
const char em_goto[]	= "Label or line number expected";
const char em_to[]	= "'to' expected";
const char em_const[]	= "No manipulation of predefined constants "
			  "allowed";
const char em_fct[]	= "Function name expected";
const char em_fnarg[]	= "',' or ')' expected";
const char em_endfn[]	= "Function definition within a function not "
			  "allowed";




/* keyword-table */
/*****************/
/* Contains the keywords as strings (must be lower case) and
   corresponding token values. More than one string can have the
   same token value but not vice versa. Even strings from the
   keyword- and punctuation table can have the same token (e.g.
   "mod" and "%").
*/
token_table_t keyword_table[] =
{
  {"if",	IF},
  {"then",	THEN},
  {"goto",	GOTO},
  {"gosub",	GOSUB},
  {"return",	RETURN},
  {"label",	LABEL},
  {"for",	FOR},
  {"to",	TO},
  {"next",	NEXT},
  {"input",	INPUT},
  {"mod",	MOD},
  {"div",	IDIV},
  {"and",	AND},
  {"or",	OR},
  {"exor",	EXOR},
  {"not",	NOT},
  {"let",	LET},
  {"deffn",	DEFFN},
  {"endfn",	ENDFN},
  {"dim",	DIM},
  {"print",	PRINT},
  {"fprint",	FPRINT},
  {"rem",	END_LINE},
  {"end",	END},
  {NULL,	NO_TOKEN}		/* termination of table */
}; /* end of keyword_table[] */




/* punctuation-table */
/*********************/
/* Contains punctuation tokens (mostly operators) as strings and
   corresponding token values. More than one string can have the
   same token value (e.g. "<>" and "#") but not vice versa.
   Strings with more than one character (e.g. ">=") must be first
   in the list!
*/
token_table_t punctuation_table[] =
{
  {"<>",	NEQ},
  {">=",	GEQ},
  {"<=",	LEQ},
  {"**",	POW},
  {"=",		EQU},
  {"#",		NEQ},
  {">",		GTH},
  {"<",		LTH},
  {"+",		PLUS},
  {"-",		MINUS},
  {"*",		MUL},
  {"/",		DIV},
  {"\\",	IDIV},
  {"%",		MOD},
  {"^",		POW},
  {"(",		LPAR},
  {")",		RPAR},
  {"]",		RBRA},
  {":",		COLON},
  {";",		SEMICOLON},
  {",",		COMMA},
  {"!",		END_LINE},
  {"?",		PRINT},
  {NULL,	NO_TOKEN}		/* termination of table */
}; /* end of punctuation_table[] */




/* forward references */
/**********************/

static void eval_expr(void);
static void eval_string_expr(void);
static void eval_commands(void);




static void handle_em(const char *error_message, const char *str2,
		      const char *str3, MINT line_nr)
/*==============================================================*/
{
  if (error_flag) return;		/* print only first error */
  printf("%sERROR", INDENT);
  if (line_nr >= 0) printf(" on line %ld", line_nr);
  printf(": %s", error_message);
  if (str2 != NULL) printf(" \"%s", str2);
  if (str3 != NULL) printf("%s", str3);
  if (str2 != NULL) printf("\"");
  printf(".\n");
  error_flag = TRUE;
} /* end of handle_em() */




static void handle_error(const char error_message[],
			 MINT line_nr, const char *src_line, long pos)
/*==================================================================*/
/* Print out the error message and where it occurred and set
   error_flag to TRUE.
   If "src_line != NULL" then print the source code line after the
   error message.
   If "pos >= 0" then mark the error position in the source line.
*/
{
  size_t	i;
  
  if (error_flag) return;		/* print only first error */
  if (line_nr < 0 && src_line != NULL && pos >= 0)
  {
    printf("%s", INDENT);
    for (i = 0; i < pos; i++) printf(" ");
    printf("^\n");
  }
  handle_em(error_message, NULL, NULL, line_nr);
  if (src_line != NULL && line_nr >= 0)
  {
    printf("%s%s\n", INDENT, src_line);
    if (pos >= 0)
    {
      printf("%s", INDENT);
      for (i = 0; i < pos; i++) printf(" ");
      printf("^\n");
    }
  }
  error_flag = TRUE;
} /* end of handle_error() */




static void handle_e(const char error_message[])
/*============================================*/
/* Short form for handle_error().
*/
{
  handle_error(error_message, src_line_nr, src_line,
	       curr_src_pos - src_line);
} /* end of handle_e() */




static char *str_dup(const char *src)
/*=================================*/
/* Returns a pointer to a new string which is a duplicate of the
   string pointed to by "src". The space for the new string is
   obtained using malloc(). If the new string can- not be created, a
   NULL pointer is returned.
*/
{
  char		*d;

  if (src == NULL) return NULL;
  d = malloc(strlen(src) + 1);
  if (d != NULL)
    strcpy(d, src);
  else
    handle_e(em_mem);
  return d;
} /* end of str_dup() */




static b_code_t *code_gen(size_t pos, code_t type, ...)
/*===================================================*/
/* Generate code at offset "pos" according to "type" (CODE, OFFSET or
   VALUE). If type == RESET then free the old buffer. Return pointer
   to generated code word. If the code buffer is full, it is enlaged.
*/
{
  static size_t		b_size = 0;
  static b_code_t	*b_code = NULL;

  va_list		ap;
  b_code_t		*pc;

  if (error_flag) return b_code;
  while (pos >= b_size && type != RESET && type != IDLE)
  {					  /* enlarge code buffer */
    if (b_size == 0)
      pc = (b_code_t*)malloc(BLOCKING_SIZE * sizeof(b_code_t));
    else
      pc = (b_code_t*)realloc(b_code, (b_size + BLOCKING_SIZE)
			      * sizeof(b_code_t));
    if (pc == NULL)
    {
      if (b_size > 0) free(b_code);
      b_size = 0;
      b_code = NULL;
      handle_e(em_mem);
      return NULL;
    }
    b_code = pc;
    b_size += BLOCKING_SIZE;
  }

  va_start(ap, type);
  switch (type)
  {
    case CODE:
    case OFFSET: b_code[pos].i = va_arg(ap, MINT);
    		 break;
    case VALUE:	 b_code[pos].f = (MFLOAT)va_arg(ap, double);
    		 break;
    case RESET:	 free(b_code);
    		 b_code = NULL;
    		 b_size = 0;
    		 break;
    case IDLE:		/* do nothing, just return b-code address */
  } /* end switch */
   va_end(ap);
  return b_code;
} /* end of code_gen() */




static void symbol_reset(symbol_table_t *table)
/*===========================================*/
/* Reset symbol table "table". Free all allocated strings and
   the array of string pointers and reset all parameters.
*/
{
  size_t	i;

  for (i = 0; i < table->pos; i++) free(table->names[i]);
  free(table->names);
  table->names = NULL;
  table->max = table->pos = 0;
} /* end of symbol_reset() */




static MINT symbol_probe(symbol_table_t *table, const char *name)
/*=============================================================*/
/* Find out if the symbol "name" exists in the symbol table
   "table". Return its id, if yes, return a negative value
   otherwise.
*/
{
  size_t	i;

  for (i = 0; i < table->pos; i++)
    if (strcmp(name, table->names[i]) == 0)
      return i;
  return -1;				/* symbol not found */
} /* end of symbol_probe() */




static MINT symbol_insert(symbol_table_t *table, char *name)
/*========================================================*/
/* Insert the symbol "name" into the symbol table "table" (the string
   "name" is duplicated).
   No checking is done if the symbol already exists. Return value
   is the id of the new symbol.
*/
{
  char		**p;
  
  if (table->pos >= table->max)
  {				/* symbol table needs enlargement */
    if (table->max == 0)
      p = (char**)malloc(BLOCKING_SIZE * sizeof(char*));
    else
      p = (char**)realloc(table->names,
			  (table->max+BLOCKING_SIZE) * sizeof(char*));
    if (p == NULL)
    {
      handle_e(em_mem);
      return -1;
    }
    table->names = p;
    table->max += BLOCKING_SIZE;
  }
  table->names[table->pos] = str_dup(name);
  return table->pos++;
} /* end of symbol_insert() */




static MINT symbol_id(symbol_table_t *table, char *name)
/*====================================================*/
/* Returns the id of symbol "name" in the symbol table "table".
   If the symbol does not exist in the table, it will be created.
*/
{
  MINT		id;

  id = symbol_probe(table, name);
  if (id >= 0)
    return id;
  else
    return symbol_insert(table, name);