b_run.c

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

				       b_pc[-1].i);
			  term_signal = TRUE;
			}
      			break;
      case B_BUILTIN_FCT: handle_builtin_fct((*b_pc++).i, &b_sp,
					     b_pc - b_prog - 1,
					     &term_signal);
			break;
      case B_CHS:	b_sp[-1].f = -b_sp[-1].f;
    			break;
      case B_POW:	b_sp--;
      			b_sp[-1].f = pow(b_sp[-1].f, b_sp[0].f);
      			break;
      case B_MPY:	b_sp--;
    			b_sp[-1].f *= b_sp[0].f;
    			break;
      case B_DIV:	b_sp--;
    			b_sp[-1].f /= b_sp[0].f;
    			break;
      case B_MOD:	b_sp--;
      			b_sp[-1].f = (MFLOAT)((MINT)b_sp[-1].f
					      % (MINT)b_sp[0].f);
      			break;
      case B_IDIV:	b_sp--;
      			b_sp[-1].f = (MFLOAT)((MINT)b_sp[-1].f
					      / (MINT)b_sp[0].f);
      			break;
      case B_ADD:	b_sp--;
    			b_sp[-1].f += b_sp[0].f;
    			break;
      case B_SUB:	b_sp--;
    			b_sp[-1].f -= b_sp[0].f;
    			break;
      case B_LEQ:	b_sp--;
    			b_sp[-1].f
    			  = (MFLOAT)(b_sp[-1].f <= b_sp[0].f);
    			break;
      case B_GEQ:	b_sp--;
    			b_sp[-1].f
    			  = (MFLOAT)(b_sp[-1].f >= b_sp[0].f);
    			break;
      case B_LTH:	b_sp--;
    			b_sp[-1].f
    			  = (MFLOAT)(b_sp[-1].f < b_sp[0].f);
    			break;
      case B_GTH:	b_sp--;
    			b_sp[-1].f
    			  = (MFLOAT)(b_sp[-1].f > b_sp[0].f);
    			break;
      case B_EQU:	b_sp--;
    			b_sp[-1].f
    			  = (MFLOAT)(b_sp[-1].f == b_sp[0].f);
    			break;
      case B_NEQ:	b_sp--;
    			b_sp[-1].f
    			  = (MFLOAT)(b_sp[-1].f != b_sp[0].f);
    			break;
      case B_AND:	b_sp--;
			b_sp[-1].f
    			  = (MFLOAT)(b_sp[-1].f && b_sp[0].f);
			break;
      case B_OR:	b_sp--;
			b_sp[-1].f
    			  = (MFLOAT)(b_sp[-1].f || b_sp[0].f);
			break;
      case B_EXOR:	b_sp--;
			b_sp[-1].f
    			  = (MFLOAT)((b_sp[-1].f && !b_sp[0].f)
				     || (!b_sp[-1].f && b_sp[0].f));
			break;
      case B_NOT:	b_sp[-1].f = (MFLOAT)!((MINT)b_sp[-1].f);
      			break;
      case B_EXIST:	exist_flag = 0;
      			break;
      case B_PUSHC:	(*b_sp++).i = (*b_pc++).i;
    			break;
      case B_PUSHV:	if (b_vars[(*b_pc).i].f == VAR_EMPTY)
			{
			  term_signal
			    |= handle_var_error(b_pc - b_prog - 1,
						(*b_pc).i);
			}
      			(*b_sp++).f = b_vars[(*b_pc++).i].v;
    			break;
      case B_PUSHLOCV:	(*b_sp++).f = b_locvars[(*b_pc++).i];
      			break;
      case B_PULL:	b_sp--;
      			break;
      case B_ASSIGN:	b_vars[(*b_pc).i].f = VAR_SET;
      			b_vars[(*b_pc++).i].v = (*--b_sp).f;
    			break;
      case B_LOCASSIGN:	b_locvars[(*b_pc++).i] = (*--b_sp).f;
      			break;
      case B_JUMPA:	b_pc = b_prog + (*--b_sp).i;
    			break;
      case B_JUMPC:	b_sp -= 2;
    			if ((int)b_sp[0].f)
    			  b_pc = b_prog + b_sp[1].i;
    			break;
      case B_NEXT:	if (b_vars[(*b_pc).i].f == VAR_EMPTY)
			{
			  term_signal
			    |= handle_var_error(b_pc - b_prog - 1,
						(*b_pc).i);
			}
      			if ((++b_vars[(*b_pc++).i].v) <= b_sp[-2].f)
    			  b_pc = b_prog + b_sp[-1].i;
    			else
    			  b_sp -= 2;
			break;
      case B_LOCNEXT:	if ((++b_locvars[(*b_pc++).i]) <= b_sp[-2].f)
			  b_pc = b_prog + b_sp[-1].i;
      			else
			  b_sp -= 2;
      			break;
      case B_INPUT:	term_signal
	                  |= handle_print(&prn_msg, &prn_pos, TRUE,
					  b_pc - b_prog - 1);
			if (term_signal) break;
      			msg[0].i = C_INPUT;
                        Wr_to_host(msg, sizeof(msg), WR_ONE);
                        Rd_from_host(msg, sizeof(msg), RD_ALL);
      			b_vars[(*b_pc).i].f = VAR_SET;
                        b_vars[(*b_pc++).i].v = msg[0].f;
    			break;
      case B_LOCINPUT:	term_signal
			  |= handle_print(&prn_msg, &prn_pos, TRUE,
					  b_pc - b_prog - 1);
			if (term_signal) break;
      			msg[0].i = C_INPUT;
                        Wr_to_host(msg, sizeof(msg), WR_ONE);
                        Rd_from_host(msg, sizeof(msg), RD_ALL);
                        b_locvars[(*b_pc++).i] = msg[0].f;
    			break;
      case B_OPENFILE:  prn_msg[prn_pos++].i = C_OPENFILE;
			prn_msg[prn_pos++].i = (MINT)(*--b_sp).f; 
      			term_signal
			  |= handle_print(&prn_msg, &prn_pos, TRUE,
					  b_pc - b_prog - 1);
      			break;
      case B_CLOSEFILE: prn_msg[prn_pos++].i = C_CLOSEFILE;
                        term_signal |=
			  handle_print(&prn_msg, &prn_pos, TRUE,
				       b_pc - b_prog - 1);
      			break;
      case B_PRINTTAB:  prn_msg[prn_pos++].i = C_PRINTTAB;
      			term_signal
			  |= handle_print(&prn_msg, &prn_pos, FALSE,
					  b_pc - b_prog - 1);
      			break;
      case B_PRINTNL:   prn_msg[prn_pos++].i = C_PRINTNL;
      			term_signal
			  |= handle_print(&prn_msg, &prn_pos, TRUE,
					  b_pc - b_prog - 1);
      			break;
      case B_PRINTS:    prn_msg[prn_pos++].i = C_PRINTS;
                        prn_msg[prn_pos++].i = (MINT)(*--b_sp).f;
                        term_signal
			  |= handle_print(&prn_msg, &prn_pos, FALSE,
					  b_pc - b_prog - 1);
    			break;
      case B_PRINTF:    prn_msg[prn_pos++].i = C_PRINTF;
                        prn_msg[prn_pos++].f = (*--b_sp).f;
      			term_signal
			  |= handle_print(&prn_msg, &prn_pos, FALSE,
					  b_pc - b_prog - 1);
    			break;
      case B_DIM:	b_sp--;
			if (b_sp[0].f <= 0) goto err_arr_index;
			i = b_arrs[b_pc[0].i].size;
			if (b_arrs[b_pc[0].i].arr == NULL)
			  b_arrs[b_pc[0].i].arr
			    = dmalloc((MINT)b_sp[0].f*sizeof(MFLOAT),
				      MT_SLOW);
			else
			  b_arrs[b_pc[0].i].arr
			    = drealloc(b_arrs[b_pc[0].i].arr,
				       (MINT)b_sp[0].f*sizeof(MFLOAT),
				       MT_SLOW);
			if (b_arrs[b_pc[0].i].arr == NULL)
			{
			  b_arrs[b_pc[0].i].size = 0;
			  goto err_music_mem;
			}
			b_arrs[b_pc[0].i].size = (MINT)b_sp[0].f;
			while (i < b_arrs[b_pc[0].i].size)
			  b_arrs[b_pc[0].i].arr[i++] = 0.0;
			b_pc++;			/* skip array nr */
			break;
      case B_ARRAY:	b_sp--;
			if (b_arrs[b_pc[0].i].arr == NULL)
			  goto err_array;
			if (b_sp[0].f < 0
			    || b_sp[0].f >= b_arrs[b_pc[0].i].size)
			  goto err_arr_index;
			b_sp[0].f
			  = b_arrs[b_pc[0].i].arr[(MINT)b_sp[0].f];
			b_sp++;
			b_pc++;
      			break;
      case B_ASSIGN_ARR:b_sp -= 2;
			if (b_arrs[b_pc[0].i].arr == NULL)
			  goto err_array;
			if (b_sp[0].f < 0
			    || b_sp[0].f >= b_arrs[b_pc[0].i].size)
			  goto err_arr_index;
			b_arrs[b_pc[0].i].arr[(MINT)b_sp[0].f]
			  = b_sp[1].f;
			b_pc++;
			break;
      case B_MKFRAMEP:	nlocvars = (*b_pc++).i;
			for (i = 0; i >= -nlocvars; i--)
			  b_sp[i] = b_sp[i-1];
			b_sp[i].f = 0.0;	/* def. ret. value */
			b_sp++;
			(*b_sp++).p = (void*)b_locvars;
      			b_locvars = (MFLOAT*)(b_sp-2);
      			break;
      case B_RETURNFN:	nlocvars = (*b_pc++).i;
      			b_locvars = (MFLOAT*)((*--b_sp).p);
      			b_pc = b_prog + (*--b_sp).i;
      			b_sp -= nlocvars;
      			break;
      case B_ASSIGN_STR:msg[0].i = C_ASSIGN_STR;
      			msg[1].i = (MINT)(*--b_sp).f; /* index first */
			msg[2].i = (MINT)(*b_pc++).f; /* str_nr */ 
			msg[3].i = b_pc - b_prog - 1;
      			Wr_to_host(msg, sizeof(msg), WR_ONE);
                        Rd_from_host(msg, sizeof(msg), RD_ALL);
                        term_signal |= msg[1].i;
                        break;
      case B_STR_ADD:	msg[0].i = C_STR_ADD;
      			msg[1].i = (MINT)b_sp[-2].f; /* index second */
      			msg[2].i = (MINT)b_sp[-1].f; /* index first */
  			msg[3].i = b_pc - b_prog - 1;
		        Wr_to_host(msg, sizeof(msg), WR_ONE);
                        Rd_from_host(msg, sizeof(msg), RD_ALL);
			term_signal = msg[3].i;
			b_sp[-2].f = msg[1].f;
			b_sp--;
                        break;
      case B_STR_DEL_STACK:  msg[0].i = C_STR_DEL_STACK;
      			Wr_to_host(msg, sizeof(msg), WR_ONE);
                        break;
      err_array:	msg[0].i = C_ERR_ARRAY;
			msg[1].i = b_pc[0].i;		/* array nr */
			goto err_send;
      err_arr_index:	msg[0].i = C_ERR_ARRAY_INDEX;
			msg[1].i = b_pc[0].i;		/* array nr */
			msg[2].i = (MINT)b_sp[0].f;	/* index */
			goto err_send;
      err_music_mem:	msg[0].i = C_ERR_MUSIC_MEM;
      err_send:		msg[3].i = b_pc - b_prog - 1;
			Wr_to_host(msg, sizeof(msg), WR_ONE);
			term_signal = TRUE;
			break;
    }		
  } /* end of switch (*b_pc++).i */
  msg[0].i = C_END;
  Wr_to_host(msg, sizeof(msg), WR_ONE);
  return 0;				/* actually not used */
} /* end of b_interpreter() */




MINT m_get_fct_ptrs(void)
/***********************/
/* convert strings with 32 bit characters (DSP96002) to strings
   with 8 bit characters (most of the other processors)
*/
{
  FUNCTION_PTR_ARR_T	*fp;
  MINT			len, nitems, i;
  MINT			*pbuf, *pb;
  const char		*pc;

  fp = function_ptr_arr;
  nitems = len = 0;
  while ((*fp).fct_name != NULL)
  {
    len += strlen((*fp++).fct_name) + 1;	/* consider '\0' */
    nitems++;
  }
  len = (len + sizeof(MINT) - 1) / sizeof(MINT) + 1 + nitems * 2;
  if (nitems == 0)
  {
    msg[0].i = 0;
    msg[1].i = 0;
    Wr_to_host(msg, sizeof(msg), WR_ONE);
    return 0;				/* actually not used */
  }

  pbuf = (MINT*)dmalloc(len * sizeof(MINT), MT_SLOW);
  pb = pbuf;
  if (pbuf == NULL)
  {
    msg[0].i = -1;
    msg[1].i = 0;
    Wr_to_host(msg, sizeof(msg), WR_ONE);
    return 0;			/* actually not used */
  }

  fp = function_ptr_arr;
  for (i = 0; i < nitems; i++) *pb++ = (MINT)(*fp++).fct_pointer;

  fp = function_ptr_arr;
  for (i = 0; i < nitems; i++) *pb++ = (*fp++).fct_nargs;

  fp = function_ptr_arr;
  pc = (*fp).fct_name;
  (*(PACKED_CHARS_T*)pb).char3 = 0x12;	/* to let the host find	*/
  (*(PACKED_CHARS_T*)pb).char2 = 0x34;	/* out the byte order	*/
  (*(PACKED_CHARS_T*)pb).char1 = 0x56;	/*	"	"	*/
  (*(PACKED_CHARS_T*)pb).char0 = 0x78;	/*	"	"	*/
  pb++;
  while (TRUE)
  {
    (*(PACKED_CHARS_T*)pb).char3 = *pc;
    if (*pc++ == 0)
    {
      if ((*++fp).fct_name == NULL)
	break;				/* end of table reached */
      pc = (*fp).fct_name;
    }
    (*(PACKED_CHARS_T*)pb).char2 = *pc;
    if (*pc++ == 0)
    {
      if ((*++fp).fct_name == NULL)
	break;				/* end of table reached */
      pc = (*fp).fct_name;
    }
    (*(PACKED_CHARS_T*)pb).char1 = *pc;
    if (*pc++ == 0)
    {
      if ((*++fp).fct_name == NULL)
	break;				/* end of table reached */
      pc = (*fp).fct_name;
    }
    (*(PACKED_CHARS_T*)pb).char0 = *pc;
    if (*pc++ == 0)
    {
      if ((*++fp).fct_name == NULL)
	break;				/* end of table reached */
      pc = (*fp).fct_name;
    }
    pb++;
  }

  msg[0].i = nitems;
  msg[1].i = len;
  Wr_to_host(msg, sizeof(msg), WR_ONE);
  Wr_to_host(pbuf, len * sizeof(MINT), WR_ONE);

  dfree(pbuf);
  return 0;				/* actually not used */
} /* end of m_get_fct_ptrs() */