b_run.c

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

/****************************************************************/
/*								*/
/* Name:	b_run.c						*/
/*								*/
/* Project:	b-code interpreter for MUSIC			*/
/*		MUSIC DSP code					*/
/*								*/
/* Survey:	This program interpretes the b-code produced	*/
/*		by BASIC.C and sends a list of the parallel	*/
/*		functions to the host.				*/
/*								*/
/* Author:	Urs Mueller					*/
/*		Electronics Laboratory, ETH Zuerich		*/
/*		Switzerland					*/
/*								*/
/* Created:	September 5, 1992				*/
/* Modified:	August 3, 1995 (um)				*/
/*								*/
/****************************************************************/


/* system header files */
#include <stdio.h>
#include <math.h>
#include <string.h>
#include <time.h>
#include <musiclib.h>

/* NeuroBasic header files */
#include "allnobjs.h"
#include "allnfcts.h"
#include "neurolib.h"
#include "basic.h"




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

extern FUNCTION_PTR_ARR_T function_ptr_arr[];
static b_code_t		b_prog[PRG_MAX];	/* b-code prg mem */
var_t			b_vars[VAR_MAX];	/* b-code variables */
arr_t			b_arrs[ARR_MAX];	/* b-code arrays */
static MFLOAT		*b_locvars;		/* b-code local vars */
static b_stack_t	b_stack[STACK_MAX];	/* b-code arg stack */
static message_t	msg;
static printq_t		prn_msg;		/* print queue */
static int		exist_flag;




MINT clear_mvars(void)
/********************/
/* Remove all Basic variables and arrays and release all
   neuro-objects.
*/
{
  MINT		i;

  for (i = 0; i < VAR_MAX; i++)
    b_vars[i].f = VAR_EMPTY;
  for (i = 0; i < ARR_MAX; i++)
  {
    if (b_arrs[i].arr != NULL) dfree(b_arrs[i].arr);
    b_arrs[i].arr = NULL;
    b_arrs[i].size = 0;
  }
  release(NO_OBJECT);
  return 0;
} /* end of clear_mvars() */




MINT init_musicside(void)
/***********************/
{
  MINT		i;
  MINT		mdiskboards;

  /*===== reset all neuro-objects =====*/
  for (i = 0; i < NEURO_OBJS_MAX; i++)
  {
    memset((char*)(neuro_objs+i), 0, sizeof(neuro_obj_t));
    neuro_objs[i].public.obtype = N_FREE;
  }

  /*===== reserve DSP internal memory =====*/
  piram = dmalloc(IRAM_SIZE * sizeof(MINT), MT_FAST);

  /*===== set dmalloc strategy =====*/
  dstrategy(MS_BEST);
  dpriority(MP_CONS_FIRST);

  /*===== reset all variables and arrays =====*/
  for (i = 0; i < VAR_MAX; i++)
    b_vars[i].f = VAR_EMPTY;
  exist_flag = -1;
  for (i = 0; i < ARR_MAX; i++)
  {
    b_arrs[i].arr = NULL;
    b_arrs[i].size = 0;
  }

  /*===== MDISK init =====*/
  mdiskboards = MDISK_get_numboards();
  if (mdiskboards > 0)
  {
    MDISK_init(MDISK_MODUL); 
    /* at the moment, only one module (number MDISK_MODUL) is run*/
  } 
  return 0;
} /* end of init_musicside() */




static int handle_print(printq_t *pprn_msg, MINT *pprn_pos, int flag,
			MINT b_pos)
/*=================================================================*/
/* tests if the printer queue "prn_msg" is full. If yes or if
   flag == TRUE it sends all print commands to the host and clears
   the list
*/
{
  if (flag || *pprn_pos > PRINTQ_MAX - 3)
  {
    msg[0].i = C_PRINT;
    msg[3].i = b_pos;
    Wr_to_host(msg, sizeof(msg), WR_ONE);
    (*pprn_msg)[0].i = C_PRINT;
    (*pprn_msg)[(*pprn_pos)++].i = C_END;
    Wr_to_host(*pprn_msg, sizeof(*pprn_msg), WR_ONE);
    Rd_from_host(msg, sizeof(msg), RD_ALL);
    *pprn_pos = 1;				/* clear queue */
    return (int)msg[0].i;
  }
  else
    return FALSE;
} /* end of handle_print() */




static void handle_builtin_fct(MINT fn, b_stack_t **pb_sp,
			       MINT b_pos, MINT *pterm_signal)
/*==========================================================*/
{
  message_t	msg;
  
  switch ((int)fn)
  {
    case 0:	/*** abs() ***/
    		(*pb_sp)[-1].f = (MFLOAT)fabs((*pb_sp)[-1].f);
		break;
    case 1:	/*** ip() ***/
		(*pb_sp)[-1].f = (MFLOAT)((MINT)((*pb_sp)[-1].f));
		break;
    case 2:	/*** int() ***/
    case 3:	/*** floor() ***/
		(*pb_sp)[-1].f = (MFLOAT)(floor((*pb_sp)[-1].f));
		break;
    case 4:	/*** fp() ***/
		(*pb_sp)[-1].f -= (MINT)((*pb_sp)[-1].f);
		break;
    case 5:	/*** ceil() ***/
		(*pb_sp)[-1].f = (MFLOAT)(ceil((*pb_sp)[-1].f));
		break;
    case 6:	/*** sqrt() ***/
		(*pb_sp)[-1].f = (MFLOAT)(sqrt((*pb_sp)[-1].f));
		break;
    case 7:	/*** sgn() ***/
		(*pb_sp)[-1].f = ((*pb_sp)[-1].f == 0) ? 0.0 
			     : ((*pb_sp)[-1].f > 0) ? 1.0 : -1.0;
		break;
   case 8:	/*** max() ***/
		(*pb_sp)--;
		(*pb_sp)[-1].f = ((*pb_sp)[-1].f > (*pb_sp)[0].f) ?
		  		(*pb_sp)[-1].f : (*pb_sp)[0].f;
		break;
    case 9:	/*** min() ***/
		(*pb_sp)--;
		(*pb_sp)[-1].f = ((*pb_sp)[-1].f < (*pb_sp)[0].f) ?
		  		(*pb_sp)[-1].f : (*pb_sp)[0].f;
		break;

    case 10:	/*** log() ***/
		(*pb_sp)[-1].f = (MFLOAT)log((*pb_sp)[-1].f);
		break;
    case 11:	/*** exp() ***/
		(*pb_sp)[-1].f = (MFLOAT)exp((*pb_sp)[-1].f);
		break;
    case 12:	/*** lgt() ***/
		(*pb_sp)[-1].f = (MFLOAT)log10((*pb_sp)[-1].f);
		break;

    case 13:	/*** sin() ***/
		(*pb_sp)[-1].f = (MFLOAT)sin((*pb_sp)[-1].f);
		break;
    case 14:	/*** asn() ***/
		(*pb_sp)[-1].f = (MFLOAT)asin((*pb_sp)[-1].f);
		break;
    case 15:	/*** cos() ***/
		(*pb_sp)[-1].f = (MFLOAT)cos((*pb_sp)[-1].f);
		break;
    case 16:	/*** acs() ***/
		(*pb_sp)[-1].f = (MFLOAT)acos((*pb_sp)[-1].f);
		break;
    case 17:	/*** tan() ***/
		(*pb_sp)[-1].f = (MFLOAT)tan((*pb_sp)[-1].f);
		break;
    case 18:	/*** atn() ***/
		(*pb_sp)[-1].f = (MFLOAT)atan((*pb_sp)[-1].f);
		break;
    case 19:	/*** atn2() ***/
		(*pb_sp)--;
		(*pb_sp)[-1].f = (MFLOAT)atan2((*pb_sp)[-1].f,
					       (*pb_sp)[0].f);
		break;
    case 20:	/*** sinh() ***/
		(*pb_sp)[-1].f = (MFLOAT)sinh((*pb_sp)[-1].f);
		break;
    case 21:	/*** cosh() ***/
		(*pb_sp)[-1].f = (MFLOAT)cosh((*pb_sp)[-1].f);
		break;
    case 22:	/*** tanh() ***/
		(*pb_sp)[-1].f = (MFLOAT)tanh((*pb_sp)[-1].f);
		break;
    case 23:	/*** clock() ***/
		(*(*pb_sp)++).f = (MFLOAT)clock() / CLOCKS_PER_SEC;
		break;
    case 24:	/*** system() ***/
		msg[0].i = C_SYSTEM;
		msg[1].i = (MINT)(*pb_sp)[-1].f;	/* string */
		msg[3].i = b_pos;
		Wr_to_host(msg, sizeof(msg), WR_ONE);
		Rd_from_host(msg, sizeof(msg), RD_ALL);
		(*pb_sp)[-1].f = (MFLOAT)msg[0].i;
		break;
    case 25:	/*** exist() ***/
		if (exist_flag > 0)
		  (*pb_sp)[-1].f = 0.0;	/* variable does not exist */
		else
		  (*pb_sp)[-1].f = 1.0;	/* variable exists */
		exist_flag = -1;
		break;
    case 26:	/*** str$() ***/
		msg[0].i = C_STR_STR;
		msg[1].f = (*pb_sp)[-1].f;
		msg[3].i = b_pos;
		Wr_to_host(msg, sizeof(msg), WR_ONE);
		Rd_from_host(msg, sizeof(msg), RD_ALL);
		if (msg[1].i < 0) *pterm_signal = TRUE;
		else (*pb_sp)[-1].f = (MFLOAT)msg[1].i;
		break;
						
  } /* end of switch */
} /* end of handle_builtin_fct() */




static void handle_error(MINT prgline, MINT fct)
/*============================================*/
/* if error then send error message to host */
{
  char		emsg[30];
  
  if (fn_error != ERR_NOERROR)
  {
    msg[0].i = C_FNERROR;
    msg[1].i = fn_error;		/* error code */
    msg[2].i = prgline;			/* program line */
    msg[3].i = fct;			/* function */
    Wr_to_host(msg, sizeof(msg), WR_ONE);
    if (fn_error_msg == NULL)
    {			/* check for predefined error messages */
      switch (fn_error)
      {
	case ERR_OBJTABFULL:
	  fn_error_msg = "Neuro-object table full";
	  break;
	case ERR_NOMEM:
	  fn_error_msg = "Not enough memory";
	  break;
        case ERR_NOOBJ:
	  fn_error_msg = "Not a neuro-object";
	  break;
	case ERR_WRONGOBJ:
	  fn_error_msg = "Wrong object type";
	  break;
        case ERR_PARCONF:
	  fn_error_msg = "Parameter conflict";
	  break;
	case ERR_DISKERROR:
	  fn_error_msg = "Disk I/O error";
	  break;
	case ERR_NOFILE:
	  fn_error_msg = "File not found";
	  break;
	default:
	  sprintf(emsg, "Unknown error: %d", fn_error);
	  fn_error_msg = emsg;
	  break;
      } /* end switch () */
    }
  }
  send_string(fn_error_msg);
  fn_error = ERR_NOERROR;			/* clear error */
  fn_error_msg = NULL;
} /* end of handle_error() */




static MINT handle_var_error(MINT prgline, MINT var)
/*================================================*/
{
  if (exist_flag >= 0)
  {
    exist_flag++;
    return FALSE;
  }
  else
  {
    msg[0].i = C_VARERROR;
    msg[1].i = 0;		/* error code (not used yet) */
    msg[2].i = prgline;		/* program line */
    msg[3].i = var;		/* variable */
    Wr_to_host(msg, sizeof(msg), WR_ONE);
    return TRUE;
  }
} /* end of handle_var_error() */




MINT b_interpreter(MINT prg_length, MINT entry_point)
/***************************************************/
{
  b_code_t	*b_pc;
  b_stack_t	*b_sp = b_stack;
  MINT 		nlocvars, term_signal, i;
  MINT		prn_pos = 1;

  /* read program b-code and strings */
  Rd_from_host(b_prog, prg_length * sizeof(b_code_t), RD_ALL);
  term_signal = FALSE;
  
  b_pc = b_prog + entry_point;
  while (!term_signal && b_pc[0].i != B_END)
  {  
    switch ((int)(*b_pc++).i)
    {
      case B_USER_FCT:	(*b_pc++).p(&b_sp);
      			if (fn_error != ERR_NOERROR)
			{
			  handle_error(b_pc - b_prog - 1,