compiler.c

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

} /* end of symbol_id() */




static MINT str_id(char *name)
/*==========================*/
/* Returns the id of string variable named "name". If the symbol does
   not exist in "tab_strnames", then both, "tab_strvars" and
   "tab_strnames" will be updated.
   The result will be < 0 (positive string indices are used by
   string constants).
*/
{
  MINT		id;

  id = symbol_probe(&tab_strnames, name);
  if (id < 0)
  {
    id = symbol_insert(&tab_strnames, name);
    symbol_insert(&tab_strvars, NULL);
  }
  return -id - 1;
} /* end of str_id() */




static void get_name(char **to, const char *from, size_t n)
/*=======================================================*/
/* Copy "n" characters of string "from" into "*to". The necessary
   space is previously allocated.
*/
{
  *to = (char*)malloc(n+1);
  if (*to == NULL)
  {
    handle_e(em_mem);
    return;
  }
  strncpy(*to, from, n);
  (*to)[n] = 0;
} /* end of get_name() */




static int str_case_cmp(const char *s1, const char *s2)
/*===================================================*/
/* Compares two strings case insensitive. Returns 0
   if they are equal, nonzero otherwise.
*/
{
  size_t	i;
  
  for (i = 0; s1[i] != 0 && tolower(s1[i]) == tolower(s2[i]); i++);
  return !(s1[i] == 0 && s2[i] == 0);
} /* end of str_case_cmp() */




static token_value_t find_keyword(const char *p, size_t n)
/*======================================================*/
/* Look for keyword starting at "p" and size "n" in the
   keyword table. If found set curr_token accordingly.
   Return the curr_token. The comparison is case insensitive.
*/
{
  token_table_t	*pkw;
  size_t	i;

  for (pkw = keyword_table; pkw->string != NULL; pkw++)
  {
    for (i = 0; i < n && tolower(p[i]) == pkw->string[i]; i++);
    if (i == n && pkw->string[i] == 0)
    {						/* keyword found */
      curr_token = pkw->token_value;
      return curr_token;
    }
  }
  return curr_token;
} /* end of find_keyword() */




static token_value_t find_const(const char *p, size_t n)
/*====================================================*/
/* Look for symbolic constant (defined by user packages) starting
   at "p" and size "n". If it exists, set curr_value accordingly,
   set curr_token to CONST. Return the value of curr_token. The
   comparison is case sensitive.
*/
{
  size_t	i;
  
  for (i = 0; bconst[i].cname != NULL; i++)
  {
    if (strncmp(bconst[i].cname, p, n) == 0
	&& strlen(bconst[i].cname) == n)
    {					/* symbolic constant found */
      curr_token = CONST;
      curr_value = bconst[i].cvalue;
      return curr_token;
    }
  }
  return curr_token;
} /* end of find_const() */




static token_value_t get_token(void)
/*================================*/
/* Get the next token and write its value into curr_token. Write the
   corresponding value (if the token has one) into curr_value or
   allocate space and copy the corresponding name (variable name or
   immediate string, if the token has one) and let curr_name point to
   it. The current token is also returned.
   Expects "src_pos" to be set and puts it after the end of this token
   in the source code.
*/
{
  size_t	i, len;
  const char	*p;
  char		*q;
  token_table_t	*ppc;
  int		str_flag;

  str_flag = FALSE;
  curr_token = NO_TOKEN;		/* clean up old token */
  curr_value = 0.0;
  if (curr_name != NULL)
  {
    free(curr_name);
    curr_name = NULL;
  }
  while (isspace(*src_pos)) src_pos++;	/* skip white space */
  curr_src_pos = src_pos;

  /*===== is it an immediate number? =====*/
  if (isdigit(*src_pos))
  {
    curr_token = NUMBER;
    curr_value = (MFLOAT)strtod(src_pos, &q);
    src_pos = q;
    return curr_token;
  }

  /*===== is it an identifier? =====*/
  if (ISXALPHA(*src_pos))
  {
    for (p = src_pos+1; ISXALNUM(*p); p++);	/* skip name */
    if ((str_flag = (*p == '$'))) p++;
    len = p - src_pos;
    if (find_keyword(src_pos, len) != NO_TOKEN)
    {						/* a keyword found */
      src_pos = p;
      return curr_token;
    }
    while (isspace(*p)) p++;			/* skip white space */
    switch (*p)
    {
      case '(':	curr_token = str_flag ? STRFCT_NAME : FCT_NAME;
      		get_name(&curr_name, src_pos, len);
      		src_pos = p + 1;
      		break;
      case '[':	if (str_flag) goto token_error;
		curr_token = ARRAY_NAME;
      		get_name(&curr_name, src_pos, len);
      		src_pos = p + 1;
      		break;
      default:	find_const(src_pos, len);		/* constant? */
      		if (curr_token == NO_TOKEN)
		{			/* assume a variable name */
		  curr_token = str_flag ? STRING_NAME : NAME;
		  get_name(&curr_name, src_pos, len);
		}
      		src_pos = p;
      		break;
    } /* end switch */
    return curr_token;
  }

  /*===== is it an immediate string? =====*/
  if (*src_pos == '"')
  {					/* an immediate string token */
    for (p = src_pos+1; *p && *p != '"'; p++);
    if (*p != '"')
    {					/* no terminating '"' found */
      handle_e(em_strterm);
      return curr_token;
    }
    curr_token = STRING;
    src_pos++;

    get_name(&curr_name, src_pos, (size_t)(p-src_pos));
    src_pos = p + 1;
    return curr_token;
  }

  /*===== is it the end of a line =====*/
  if (*src_pos == 0)
    return (curr_token = END_LINE);
  
  /*===== is it a punctuation token (operator)? =====*/
  for (ppc = punctuation_table; ppc->string != NULL; ppc++)
  {
    for (i = 0; src_pos[i] && (src_pos[i] == ppc->string[i]); i++);
    if (ppc->string[i]==0)
    {					/* punctuation token found */
      src_pos += i;
      curr_token = ppc->token_value;
      return curr_token;
    }
  }

  /*===== not a legal token =====*/
  token_error:
  handle_e(em_notoken);
  return NO_TOKEN;
} /* end of get_token() */




static void eval_fct(void)
/*======================*/
/* Evaluates the arguments of a function call. Expects curr_token
   to be set.
*/
{
  int		nargs;
  size_t	rp;

  if (reloc_pos >= RELOC_MAX) handle_e(em_mem);
  if (error_flag) return;
  if (str_case_cmp(curr_name, "exist") == 0)
    code_gen(b_pos++, CODE, B_EXIST);
  rp = reloc_pos++;
  reloc_tab[rp].name = str_dup(curr_name);
  reloc_tab[rp].src_line_nr = src_line_nr;
  nargs = 0;
  get_token();				/* skip function name */
  while (curr_token != RPAR && !error_flag)
  {
    switch(curr_token)
    {
      case STRING:
      case STRING_NAME:
      case STRFCT_NAME:	eval_string_expr();
			break;
      default:		eval_expr();
			break;
    } /* end switch */
    nargs++;
    if (curr_token != COMMA && curr_token != RPAR)
      handle_e(em_fnarg);
    if (curr_token == COMMA) get_token();	/* skip ',' */
  }
  get_token();					/* skip ')' */
  reloc_tab[rp].ref_line_nr = nargs;
  reloc_tab[rp].b_pos = b_pos;
  code_gen(b_pos++, CODE, B_NOP);	/* to be completed by..	*/
  code_gen(b_pos++, CODE, B_NOP);	/* .. relocate()	*/
  code_gen(b_pos++, CODE, B_NOP);
  code_gen(b_pos++, CODE, B_NOP);
  code_gen(b_pos++, CODE, B_NOP);
} /* end of eval_fct() */




static void eval_array(void)
/*========================*/
{
  if (error_flag) return;
  get_token();					/* skip array name */
  eval_expr();					/* get array index */
  if (curr_token != RBRA) handle_e(em_rbra);
  get_token();		/* skip ']' */
} /* end of eval_array() */




static void eval6(void)
/*===================*/
/* Evaluates primaries. Expects curr_token to be set.
*/
{
  MINT		varnr;
  
  if (error_flag) return;
  switch (curr_token)
  {
    case LPAR:		get_token();		/* skip "(" */
    			eval_expr();
    			if (curr_token != RPAR)
			  handle_e(em_rp);
			else
			  get_token();		/* skip ")" */
    			break;
    case MINUS:		get_token();		/* skip "-" */
    			eval6();
    			code_gen(b_pos++, CODE, B_CHS);
    			break;
    case PLUS:		get_token();		/* skip "+" */
    			eval6();
    			break;
    case NOT:		get_token();
      			eval6();
      			code_gen(b_pos++, CODE, B_NOT);
      			break;
    case NUMBER:
    case CONST:		code_gen(b_pos++, CODE, B_PUSHC);
    			code_gen(b_pos++, VALUE, (double)curr_value);
			get_token();		/* skip number */
    			break;
    case NAME:		varnr = symbol_probe(&tab_locvars, curr_name);
    			if (varnr >= 0)	/* a local variable? */
			{
			  varnr -= tab_locvars.pos;
			  code_gen(b_pos++, CODE, B_PUSHLOCV);
			}
    			else
			{		/* a global variable */
			  varnr = symbol_id(&tab_globvars, curr_name);
			  code_gen(b_pos++, CODE, B_PUSHV);
			}
    			code_gen(b_pos++, OFFSET, varnr);
    			get_token();		/* skip varname */
    			break;
    case ARRAY_NAME:	varnr = symbol_id(&tab_arrays, curr_name);
			eval_array();
    			code_gen(b_pos++, CODE, B_ARRAY);
			code_gen(b_pos++, OFFSET, varnr);
    			break;
    case FCT_NAME:	eval_fct();
    			break;
    default:		handle_e(em_pr);
    			break;
  }
} /* end of eval6() */




static void eval5(void)
/*===================*/
{
  eval6();
  while (!error_flag)
  {
    switch (curr_token)
    {
      case POW:		get_token();		/* skip "^" or "**" */
      			eval6();
      			code_gen(b_pos++, CODE, B_POW);
      			break;
      default:		return;			/* not my token */
    }
  }
} /* end of eval5() */




static void eval4(void)
/*===================*/
{
  eval5();
  while (!error_flag)
  {
    switch (curr_token)
    {
      case MUL:		get_token();		/* skip "*" */
      			eval5();
      			code_gen(b_pos++, CODE, B_MPY);
      			break;
      case DIV:		get_token();		/* skip "/" */
      			eval5();
      			code_gen(b_pos++, CODE, B_DIV);
      			break;
      case MOD:		get_token();		/* skip "%" */
      			eval5();
      			code_gen(b_pos++, CODE, B_MOD);
      			break;
      case IDIV:	get_token();		/* skip "div" */
      			eval5();
      			code_gen(b_pos++, CODE, B_IDIV);
      			break;
      default:		return;			/* not my token */
    }
  }
} /* end of eval4() */




static void eval3(void)
/*===================*/
{
  eval4();
  while (!error_flag)
  {
    switch (curr_token)
    {
      case PLUS:	get_token();		/* skip "+" */
      			eval4();
      			code_gen(b_pos++, CODE, B_ADD);
      			break;
      case MINUS:	get_token();		/* skip "-" */
      			eval4();
      			code_gen(b_pos++, CODE, B_SUB);
      			break;
      default:		return;			/* not my token */
    }
  }
} /* end of eval3() */




static void eval2(void)
/*===================*/
{
  eval3();
  while (!error_flag)
  {
    switch (curr_token)
    {
      case GEQ:		get_token();		/* skip ">=" */
			eval3();
      			code_gen(b_pos++, CODE, B_GEQ);
      			break;
      case LEQ:		get_token();		/* skip "<=" */
      			eval3();
      			code_gen(b_pos++, CODE, B_LEQ);
      			break;
      case GTH:		get_token();		/* skip ">" */
      			eval3();
      			code_gen(b_pos++, CODE, B_GTH);
      			break;
      case LTH:		get_token();		/* skip "<" */
      			eval3();
      			code_gen(b_pos++, CODE, B_LTH);
      			break;
      case EQU:		get_token();		/* skip "=" */
			eval3();
      			code_gen(b_pos++, CODE, B_EQU);
      			break;
      case NEQ:		get_token();		/* skip "<>" or "#" */
      			eval3();
      			code_gen(b_pos++, CODE, B_NEQ);
      			break;
      default:		return;			/* not my token */
    }
  } 
} /* end of eval2() */




static void eval1(void)
/*===================*/
{
  eval2();
  while (!error_flag)
  {
    switch (curr_token)
    {