compiler.c

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

			break;
      case NEXT:	get_token();
			eval_next();
			break;
      case INPUT:	get_token();
			eval_input();
			break;
      case DEFFN:	get_token();
			eval_deffn();
			break;
      case ENDFN:	get_token();
			eval_endfn();
			break;
      case DIM:		get_token();
			eval_dim();
			break;
      case PRINT:	get_token();
			eval_print();
      			break;
      case FPRINT:	get_token();
			eval_string_expr();	/* get file name */
      			code_gen(b_pos++, CODE, B_OPENFILE);
			if (curr_token != COMMA) handle_e(em_comma);
			get_token();
      			eval_print();
      			code_gen(b_pos++, CODE, B_CLOSEFILE);
      			break;
      case END:		get_token();
			code_gen(b_pos++, CODE, B_END);
			break;
      case LET:		get_token();		/* skip "let" */
      case CONST:
      case NAME:
      case ARRAY_NAME:
      case STRING_NAME:	eval_assign();
			break;
      case FCT_NAME:	eval_expr();
			code_gen(b_pos++, CODE, B_PULL);
			break;			/* dischard ret val */
      case STRFCT_NAME:	eval_string_expr();
			code_gen(b_pos++, CODE, B_PULL);
			break;			/* dischard ret val */
      default:		handle_e(em_nocom);
			break;
    } /* end switch */
    if (curr_token != END_LINE && curr_token != COLON)
      handle_e(em_noend);
    if (curr_token == COLON) get_token();
  } /* end while */
} /* end of eval_commands() */




static MINT get_m_fctptr(char *fct_name)
/*====================================*/
{
  char		*ps;
  MINT		k;

  if (mfct_tab.mft_func_ptr == NULL)
    return -1;			/* no function table present */

  ps = (char*)mfct_tab.mft_fct_names;
  for (k = 0; k < mfct_tab.mft_nitems; k++)
  {
    if (strcmp(fct_name, ps) == 0) break;
    else ps += strlen(ps) + 1;	/* next string */
  }
  if (k < mfct_tab.mft_nitems)
    return k;
  else
    return -1;			/* function name not found */
} /* end of get_m_fctptr() */




static void reloc_fct(reloc_tab_t *rt)
/*==================================*/
/* Relocate function calls.
*/
{
  MINT		fn;
  size_t	bp = rt->b_pos;

  /*===== check user-defined Basic functions =====*/
  fn = symbol_probe(&tab_functions, rt->name);
  if (fn >= 0)
  {
    code_gen(bp++, CODE, B_PUSHC);
    code_gen(bp++, OFFSET, rt->b_pos+5);
    code_gen(bp++, CODE, B_PUSHC);
    code_gen(bp++, OFFSET, fct_ref[fn].b_pos);
    code_gen(bp++, CODE, B_JUMPA);
    if (fct_ref[fn].nargs != rt->ref_line_nr) goto eargs;
    return;
  }

  /*===== check neuro-functions =====*/
  fn = get_m_fctptr(rt->name);
  if (fn >= 0)
  {
    code_gen(bp++, CODE, B_PUSHC);
    code_gen(bp++, OFFSET, (MINT)rt->ref_line_nr);
    code_gen(bp++, CODE, B_USER_FCT);
    code_gen(bp++, OFFSET, mfct_tab.mft_func_ptr[fn]);
    if (!(rt->ref_line_nr == mfct_tab.mft_nargs[fn]
	|| (mfct_tab.mft_nargs[fn] < 0 &&
	   rt->ref_line_nr >= -mfct_tab.mft_nargs[fn])))
					/* open parameter list */
      goto eargs;
    return;
  }

  /*===== check built-in Basic functions =====*/
  for (fn = 0; ifct_tab[fn].name != NULL
       && str_case_cmp(ifct_tab[fn].name, rt->name) != 0; fn++);
  if (ifct_tab[fn].name != NULL)
  {
    code_gen(bp++, CODE, B_BUILTIN_FCT);
    code_gen(bp++, OFFSET, fn);
    if (ifct_tab[fn].nargs != rt->ref_line_nr) goto eargs;
    return;
  }

  /*===== function not found =====*/
  handle_em(em_nofct, rt->name, "()", rt->src_line_nr);
  return;

  /*===== uncorrect number of arguments =====*/
eargs:
  handle_em(em_args, rt->name, "()", rt->src_line_nr);
} /* end of reloc_fct() */




static void relocate(void)
/*======================*/
/* Relocate jump addresses and function calls.
*/
{
  MINT		offs;
  size_t	bp;
  
  while (reloc_pos-- > 0)
  {
    bp = reloc_tab[reloc_pos].b_pos;
    if (reloc_tab[reloc_pos].ref_line_nr >= 0
	&& reloc_tab[reloc_pos].name != NULL)
      reloc_fct(&reloc_tab[reloc_pos]);	/* relocate function calls */
    else
    {					/* relocate jump address... */
      if (reloc_tab[reloc_pos].name == NULL)
	offs = jmp_ref[reloc_tab[reloc_pos].ref_line_nr];
      else
      {				/* reference to a label */
	offs = symbol_probe(&tab_labels,reloc_tab[reloc_pos].name);
	if (offs != -1) offs = label_ref[offs];
	reloc_tab[reloc_pos].name = NULL;
      }
      if (offs == -1)
	handle_error(em_nojmp, reloc_tab[reloc_pos].src_line_nr,
		     NULL, 0);
      code_gen(bp, OFFSET, offs);
    }
    if (reloc_tab[reloc_pos].name != NULL)
      free(reloc_tab[reloc_pos].name);
  }
} /* end of relocate() */




static void compile_line(const char *source, MINT line_nr)
/*======================================================*/
/* Compile a single line of source code.
*/
{
  del_strstack = FALSE;
  if (error_flag) return;
  src_pos = src_line = source;		/* start of source string */
  src_line_nr = line_nr;		/* source line number */
  get_token();				/* get first token */
  eval_commands();
  nstrconsts = tab_strconsts.pos;
  if (del_strstack) code_gen(b_pos++, CODE, B_STR_DEL_STACK);
} /* end of compile_line() */




/*==============================================================*/
/*								*/
/* Interface functions to outside of this module		*/
/*								*/
/*==============================================================*/


int bc_compile_line(const char *source)
/*************************************/
/* Compile a single-line command. Return value is TRUE if a
   jump (conditional, unconditional or function call) was detected
   (compilation of the rest of the program is necessary) FALSE
   otherwise.
*/
{
  compile_line(source, -1);
  compile_line("end", -1);
  return reloc_pos > 0;
} /* end of bc_compile_line() */


int bc_compile_program(char *bsource[])
/*************************************/
/* Compile the program in "bsource[]". Return TRUE if a compile
   error occurred, FALSE otherwise.
*/
{
  MINT		line_nr;

  for (line_nr = 0; line_nr < PRG_MAX; line_nr++)
  {
    while (line_nr < PRG_MAX && bsource[line_nr] == NULL) line_nr++;
    if (line_nr >= PRG_MAX) break;
    jmp_ref[line_nr] = b_pos;
    compile_line(bsource[line_nr], line_nr);
  }
  compile_line("end", -1);		/* just to make sure */
  relocate();
  return error_flag;
} /* end of bc_compile_program() */


void bc_reset(void)
/*****************/
/* Reset the state of the compiler. Reset tables and buffers.
*/
{
  size_t	i;

  error_flag = FALSE;		/* error flag */
  for (i = 0; i < PRG_MAX; i++) jmp_ref[i] = -1;
  reloc_pos = 0;
  code_gen(0, RESET);
  if (curr_name != NULL)
  {
    free(curr_name);
    curr_name = NULL;
  }
  b_pos = 0;
  symbol_reset(&tab_locvars);		/* reset symbol tables */
  symbol_reset(&tab_functions);
  symbol_reset(&tab_labels);
  symbol_reset(&tab_strconsts);
  nstrconsts = 0;
} /* end of bc_reset() */


void bc_clrvars(void)
/*******************/
/* Clear symbol tables of global variables, arrays and strings.
*/
{
  symbol_reset(&tab_globvars);
  symbol_reset(&tab_arrays);
  symbol_reset(&tab_strvars);
  symbol_reset(&tab_strnames);
} /* end of bc_clrvar() */


MINT bc_srcline(MINT b_pos)
/*************************/
/* Returns the source line number corresponding to position "b_pos"
   in the b-code.
*/
{
  MINT		i, line_nr;

  if (b_pos < 0) return -1;
  line_nr = -1;
  for (i = 0; i < PRG_MAX; i++)
  {
    if (jmp_ref[i] >= 0)
    {
      if (jmp_ref[i] <= b_pos)
	line_nr = i;
      else
	break;
    }
  }
  return line_nr;
} /* end of bc_srcline() */


int bc_get_error(void)
/********************/
/* Return the flag "error_flag". */
{
  return error_flag;
} /* end of bc_get_error() */


b_code_t *bc_get_codeadr(void)
/****************************/
/* Return start address of produced code. */
{
  return code_gen(0, IDLE);
} /* end of bc_get_codeadr() */


size_t bc_get_codelength(void)
/****************************/
/* Return length of produced code in long. */
{
  return b_pos;
} /* end of bc_get_codelength() */


void bc_print_varerror(MINT b_pos, MINT var_nr)
/*********************************************/
{
  if (error_flag) return;
  handle_em(em_var, tab_globvars.names[var_nr], NULL,
	    bc_srcline(b_pos));
} /* end of bc_print_varerror() */


void bc_print_error(int type, MINT varnr, MINT index, MINT b_pos)
/***************************************************************/
{
  char		msg[20];
  
  if (error_flag) return;
  switch (type)
  {
    case 1:
      handle_em(em_mumem, NULL, NULL, bc_srcline(b_pos));
      break;
    case 2:
      handle_em(em_arr, tab_arrays.names[varnr], "[]",
		bc_srcline(b_pos));
    default:
      sprintf(msg, "[%ld]", index);
      handle_em(em_arrind, tab_arrays.names[varnr], msg,
		bc_srcline(b_pos));
  } /* end of switch */
} /* end of bc_print_error */


char *bc_str_get(MINT i, MINT b_pos, int *eflag)
/**********************************************/
/* Returns the pointer to the string with index "i" (string
   constants have a positive, string variables a negative index).
   "eflag" is set to TRUE if an error occurred.
*/
{
  char		*ret;

  if (i >= 0)
    return tab_strconsts.names[i];	/* string constant */
  else
  {					/* string variable... */
    i = -i - 1;
    ret = tab_strvars.names[i];
    if (ret == NULL)
    {
      handle_em(em_strvar, tab_strnames.names[i], NULL,
		bc_srcline(b_pos));
      if (eflag != NULL) *eflag = TRUE;
    }
    return ret;
  }
} /* end of bc_str_get() */


void bc_str_dup(MINT dest, MINT src, MINT b_pos, int *eflag)
/**********************************************************/
/* Duplicates string with index "src" to string variable "dest".
   Returns TRUE if an error occurred.
   "eflag" is set to TRUE if an error occurred.
*/
{
  const char	*psrc	 = bc_str_get(src, b_pos, eflag);
  char		**ppdest = &tab_strvars.names[-dest-1];

  if (psrc == NULL)
  {
    *eflag = TRUE;
    return;
  }
  if (*ppdest != NULL) free(*ppdest);
  *ppdest = malloc(strlen(psrc)+1);
  if (*ppdest == NULL)
  {
    handle_em(em_mem, NULL, NULL, bc_srcline(b_pos));
    *eflag = TRUE;
    return;
  }

  strcpy(*ppdest, psrc);
  return;
} /* end of bc_str_dup() */


MINT bc_str_add(MINT s1, MINT s2, MINT b_pos, int *eflag)
/*******************************************************/
/* Concatenates two strings.
   "eflag" is set to TRUE if an error occurred.
*/
{
  char		*p1, *p2, *pd;
  size_t	len;

  p1 = bc_str_get(s1, b_pos, eflag);
  p2 = bc_str_get(s2, b_pos, eflag);
  if (*eflag) return NULL;
  len = strlen(p1) + strlen(p2) + 1;
  if (s1 >= nstrconsts)
  {				/* reuse entry of string stack */
    p1 = tab_strconsts.names[s1]
       = realloc(tab_strconsts.names[s1], len);
    if (p1 == NULL) goto str_add_error;
    strcat(p1, p2);
  }
  else
  {				/* create a new entry on str. stack */
    pd = malloc(len);
    if (pd == NULL) goto str_add_error;
    strcpy(pd, p1);
    strcat(pd, p2);
    s1 = symbol_insert(&tab_strconsts, pd);
    *eflag |= error_flag;
    free(pd);
  }
  return s1;

  /*===== an error occurred =====*/
  str_add_error:
  handle_em(em_mem, NULL, NULL, bc_srcline(b_pos));
  *eflag = TRUE;
  return NULL;
} /* end of bc_str_add() */


MINT bc_str_new(char *str, MINT b_pos, int *eflag)
/************************************************/
/* Creates a new entry on the temporary string stack and returns
   its index.
*/
{
  MINT		ret;

  ret = symbol_insert(&tab_strconsts, str);
  *eflag |= error_flag;
  return ret;
} /* end of bc_str_new() */


void bc_str_delstack(void)
/************************/
/* Delete temporary string stack.
*/
{
  size_t	i;

  for (i = nstrconsts; i < tab_strconsts.pos; i++)
    free(tab_strconsts.names[i]);
  tab_strconsts.pos = nstrconsts;
} /* end of bc_str_delstack() */