compiler.c

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

      case AND:		get_token();
      			eval2();
      			code_gen(b_pos++, CODE, B_AND);
      			break;
      default:		return;			/* not my token */
    }
  } 
} /* end of eval1() */




static void eval_expr(void)
/*=======================*/
/* Recursively evaluates Basic expressions.
   Expects curr_token to be set.
*/
{
  eval1();
  while (!error_flag)
  {
    switch (curr_token)
    {
      case OR:		get_token();
      			eval1();
      			code_gen(b_pos++, CODE, B_OR);
      			break;
      case EXOR:	get_token();
      			eval1();
      			code_gen(b_pos++, CODE, B_EXOR);
      			break;
      default:		return;			/* not my token */
    }
  } 
} /* end of eval_expr() */




static void eval_string(void)
/*=========================*/
/* Evaluates string primaries. Expects curr_token to be set.
*/
{
  if (error_flag) return;
  switch (curr_token)
  {
    case LPAR:		get_token();		/* skip "(" */
    			eval_string_expr();
    			if (curr_token != RPAR)
			  handle_e(em_rp);
			else
			  get_token();		/* skip ")" */
    			break;
    case STRING:	code_gen(b_pos++, CODE, B_PUSHC);
			code_gen(b_pos++, VALUE,
			 (MFLOAT)symbol_id(&tab_strconsts, curr_name));
			get_token();		/* skip string */
    			break;
    case STRING_NAME:	code_gen(b_pos++, CODE, B_PUSHC);
			code_gen(b_pos++, VALUE,
				 (MFLOAT)str_id(curr_name));
			get_token();		/* skip name */
    			break;
    case STRFCT_NAME:	eval_fct();
			del_strstack = TRUE;
			break;
    default:		handle_e(em_strpr);
    			break;
  }
} /* end of eval_string() */




static void eval_string_expr(void)
/*==============================*/
/* Evaluates string expressions. Expects curr_token to be set.
*/
{
  eval_string();
  while (!error_flag)
  {
    switch (curr_token)
    {
      case PLUS:	get_token();		/* skip "+" */
      			eval_string();
      			code_gen(b_pos++, CODE, B_STR_ADD);
			del_strstack = TRUE;
      			break;
      default:		return;			/* not my token */
    }
  }
  
} /* end of eval_string_expr() */




static void eval_if(void)
/*=====================*/
/* Evaluates if/then condition. Expects curr_token to be set.
*/
{
  const char	*p;
  size_t	pos;
  
  if (error_flag) return;
  eval_expr();			/* evaluate condition */
  if (curr_token != THEN) handle_e(em_nothen);
  p = src_pos;			/* remember position */
  get_token();

  /* For historical reasons support a direct label or line number
     after the keyword "then". This will be interpreted as "goto"
     the line number or label.
  */
  if ((curr_token == NAME || curr_token == NUMBER)
      && get_token() == END_LINE)
  {				/* direct line number or label */
    src_pos = p;		/* step back.. */
    curr_token = GOTO;		/* ..and insert a "goto" */
  }
  else
  {
    src_pos = p;		/* step back.. */
    get_token();		/* ..and refetch last token */
  }

  code_gen(b_pos++, CODE, B_NOT);     /* negate condition */
  code_gen(b_pos++, CODE, B_PUSHC);
  pos = b_pos++;		      /* fill in jump address later */
  code_gen(b_pos++, CODE, B_JUMPC);
  eval_commands();		      /* compile rest of line */
  code_gen(pos, OFFSET, (MINT)b_pos); /* set jump address now */
} /* end of eval_if() */




static void eval_assign_array(void)
/*===============================*/
{
  MINT		varnr;

  if (error_flag) return;
  varnr = symbol_id(&tab_arrays, curr_name);
  eval_array();
  if (curr_token != EQU) handle_e(em_assign);
  get_token();				/* skip '=' */
  eval_expr();
  code_gen(b_pos++, CODE, B_ASSIGN_ARR);
  code_gen(b_pos++, OFFSET, varnr);
} /* end of eval_assign_array() */




static void eval_assign(void)
/*=========================*/
/* Evaluates an assignment to a variable. Expects curr_token to
   be set to variable name.
*/
{
  MINT			varnr;
  char			*name;
  token_value_t		token;

  if (curr_token == ARRAY_NAME)
  {
    eval_assign_array();
    return;
  }
  name = str_dup(curr_name);
  token = curr_token;
  get_token();					/* skip var name */
  if (curr_token != EQU) handle_e(em_assign);
  get_token();					/* skip '=' */
  if (error_flag) goto end_assign;

  switch (token)
  {
    case NAME:		eval_expr();
			varnr = symbol_probe(&tab_locvars, name);
			if (varnr >= 0)		/* a local variable? */
			{
			  varnr -= tab_locvars.pos;
			  code_gen(b_pos++, CODE, B_LOCASSIGN);
			}
			else
			{			/* a global variable */
			  varnr = symbol_id(&tab_globvars, name);
			  code_gen(b_pos++, CODE, B_ASSIGN);
			}
			code_gen(b_pos++, OFFSET, varnr);
			break;
    case STRING_NAME:	eval_string_expr();
			code_gen(b_pos++, CODE, B_ASSIGN_STR);
			code_gen(b_pos++, VALUE, (MFLOAT)str_id(name));
			break;
    case CONST:		handle_e(em_const);
			break;
    default:		handle_e(em_ass);
			break;
  } /* end switch */

  end_assign:
  if (name != NULL) free(name);
} /* end of eval_assign() */




static void eval_for(void)
/*======================*/
/* Evaluates "for/to" statements. Expects curr_token to be set.
*/
{
  if (curr_token != NAME && curr_token != CONST)
    handle_e(em_name);
  if (error_flag) return;
  eval_assign();
  if (curr_token != TO) handle_e(em_to);
  get_token();					/* skip "to" */
  eval_expr();
  code_gen(b_pos++, CODE, B_PUSHC);
  code_gen(b_pos, OFFSET, b_pos+1);		/* loop addr */
  b_pos++;
} /* end of eval_for() */




static void eval_next(void)
/*=======================*/
/* Evaluates a "next" statement. Expects curr_token to be set.
*/
{
  MINT		varnr;

  if (curr_token == CONST) handle_e(em_const);
  if (curr_token != NAME) handle_e(em_name);
  if (error_flag) return;
  varnr = symbol_probe(&tab_locvars, curr_name);
  if (varnr >= 0)				/* a local variable? */
  {
    varnr -= tab_locvars.pos;
    code_gen(b_pos++, CODE, B_LOCNEXT);
  }
  else
  {						/* a global variable */
    varnr = symbol_id(&tab_globvars, curr_name);
    code_gen(b_pos++, CODE, B_NEXT);
  }
  code_gen(b_pos++, OFFSET, varnr);
  get_token();					/* skip var name */
} /* end of eval next */




static void eval_input(void)
/*========================*/
{
  MINT		varnr;

  if (curr_token == CONST) handle_e(em_const);
  if (curr_token != NAME) handle_e(em_name);
  if (error_flag) return;
  varnr = symbol_probe(&tab_locvars, curr_name);
  if (varnr >= 0)				/* a local variable? */
  {
    varnr -= tab_locvars.pos;
    code_gen(b_pos++, CODE, B_LOCINPUT);
  }
  else
  {						/* a global variable */
    varnr = symbol_id(&tab_globvars, curr_name);
    code_gen(b_pos++, CODE, B_INPUT);
  }
  code_gen(b_pos++, OFFSET, varnr);
  get_token();					/* skip var name */
} /* end of eval_input() */




static void eval_print(void)
/*========================*/
{
  token_value_t		last_token;
  int			sf;

  last_token = SEMICOLON;
  while (!error_flag && curr_token!=END_LINE && curr_token!=COLON)
  {
    sf = (last_token != SEMICOLON && last_token != COMMA);
    last_token = curr_token;		/* remember for later */
    switch (curr_token)
    {
      case COMMA:	get_token();
			code_gen(b_pos++, CODE, B_PRINTTAB);
			break;
      case SEMICOLON:	get_token();
			break;
      case STRING:
      case STRING_NAME:
      case STRFCT_NAME:	if (sf) handle_e(em_print);
			eval_string_expr();
			code_gen(b_pos++, CODE, B_PRINTS);
			break;
      default:		if (sf) handle_e(em_print);
			eval_expr();
			code_gen(b_pos++, CODE, B_PRINTF);
			break;
    } /* end switch */
  }
  if (last_token != SEMICOLON && last_token != COMMA)
    code_gen(b_pos++, CODE, B_PRINTNL);
} /* end of eval_print() */




static void eval_label(void)
/*========================*/
{
  switch (curr_token)
  {
    case NAME:		if (symbol_probe(&tab_labels, curr_name) != -1)
			  handle_e(em_dupl);
			if (tab_labels.pos < LABEL_MAX)
			  {
			    label_ref[tab_labels.pos] = b_pos;
			    symbol_insert(&tab_labels, curr_name);
			  }
			else
			  handle_e(em_mem);
			break;
    default:		handle_e(em_label);
			break;
  } /* end switch */
  get_token();				/* skip label */
} /* end of eval_label() */




static void eval_goto(void)
/*=======================*/
{
  if (reloc_pos >= RELOC_MAX) handle_e(em_mem);
  if (error_flag) return;
  code_gen(b_pos++, CODE, B_PUSHC);
  reloc_tab[reloc_pos].b_pos = b_pos;
  switch (curr_token)
  {
    case NUMBER: reloc_tab[reloc_pos].ref_line_nr = curr_value;
		 reloc_tab[reloc_pos].name = NULL;
		 break;
    case NAME:	 reloc_tab[reloc_pos].ref_line_nr = -1;
		 reloc_tab[reloc_pos].name = str_dup(curr_name);
		 break;
    default:     handle_e(em_goto);
		 break;
  } /* end switch */
  code_gen(b_pos++, OFFSET, 0);	/* insert jmp-addr here later */
  code_gen(b_pos++, CODE, B_JUMPA);
  reloc_tab[reloc_pos++].src_line_nr = src_line_nr;
  get_token();				/* skip label/line number */
} /* end of eval_goto() */




static void eval_deffn(void)
/*========================*/
/* Evaluates user-defined Basic function headers. Expects curr_token
   to be set.
*/
{
  MINT	nargs = 0;
  
  if (curr_token != FCT_NAME) handle_e(em_fct);
  if (symbol_probe(&tab_functions, curr_name) != -1) handle_e(em_dupf);
  symbol_insert(&tab_functions, curr_name);
  if (tab_locvars.pos > 0) handle_e(em_endfn);
  if (error_flag) return;

  symbol_insert(&tab_locvars, curr_name);	/* for return value */
  get_token();					/* skip fct name */
  while (curr_token != RPAR && !error_flag)
  {
    if (curr_token != NAME) handle_e(em_name);
    if (symbol_probe(&tab_locvars, curr_name) != -1) handle_e(em_dupn);
    symbol_insert(&tab_locvars, curr_name);
    nargs++;
    get_token();				/* skip arg */
    if (curr_token != COMMA && curr_token != RPAR)
      handle_e(em_fnarg);
    if (curr_token == COMMA) get_token();	/* skip ',' */
  }
  get_token();					/* skip ')' */
  fct_ref[tab_functions.pos-1].b_pos = b_pos;
  fct_ref[tab_functions.pos-1].nargs = nargs;
  code_gen(b_pos++, CODE, B_MKFRAMEP);
  code_gen(b_pos++, OFFSET, nargs);
} /* end of eval_deffn() */




static void eval_endfn(void)
/*========================*/
{
  if (error_flag) return;
  code_gen(b_pos++, CODE, B_RETURNFN);
  code_gen(b_pos++, OFFSET, tab_locvars.pos-1);
  symbol_reset(&tab_locvars);
} /* end of eval_endfn() */




static void eval_dim(void)
/*======================*/
{
  MINT		varnr;			/* array index */
  
  while (!error_flag)
  {
    if (curr_token != ARRAY_NAME) handle_e(em_array);
    varnr = symbol_id(&tab_arrays, curr_name);
    eval_array();
    code_gen(b_pos++, CODE, B_DIM);
    code_gen(b_pos++, OFFSET, varnr);
    if (curr_token != COMMA) break;
    get_token();			/* skip ',' */
  }
} /* end of eval_dim() */




static void eval_commands(void)
/*===========================*/
/* Evaluate all commands of the remaining source line (commands are
   separated by a ':' in the source code). Expecting the global
   variable "curr_token" to be set.
*/
{
  while (!error_flag && curr_token != END_LINE)
  {
    switch (curr_token)
    {
      case LABEL:	get_token();
			eval_label();
			break;
      case GOSUB:	/* insert return address */
			code_gen(b_pos++, OFFSET, B_PUSHC);
			code_gen(b_pos, OFFSET, b_pos + 4);
			b_pos++;
      case GOTO:	get_token();
			eval_goto();
			break;
      case RETURN:	get_token();
			code_gen(b_pos++, CODE, B_JUMPA);
			break;
      case IF:	 	get_token();
			eval_if();
			break;
      case FOR:		get_token();
			eval_for();