function.c

Linux下VB解释器

/*  

    YABASIC ---  a simple Basic Interpreter
    written by Marc-Oliver Ihm 1995-2005
    homepage: www.yabasic.de
    
    function.c --- code for functions
    
    This file is part of yabasic and may be copied only 
    under the terms of either the Artistic License or 
    the GNU General Public License (GPL), both of which 
    can be found at www.yabasic.de

*/


/* ------------- includes ---------------- */

#ifndef YABASIC_INCLUDED
#include "yabasic.h"		/* all prototypes and structures */
#endif


/* ------------- external references ---------------- */

extern int yylineno;		/* current line number */
extern int yyparse ();		/* call bison parser */


/* ------------- local functions ---------------- */

static char *fromto (char *, int, int);	/* get portion of string (mid$ et al) */
static void clear_buff ();	/* clear system-input buffers */
static void store_buff (char *, int);	/* store system-input buffer */
static int do_glob (char *, char *);	/* actually do the globbing */
static double other2dec (char *, int);	/* convert hex to decimal */
static char *dec2other (double, int);	/* convert decimal to hex */
static double peek (char *);	/* peek into internals */
static char *peek2 (char *, struct command *);	/* peek into internals */
static char *peek3 (char *, char *);	/* peek into internals */
static int peekfile (int);	/* read a byte from stream */
static char *do_system (char *);	/* executes command via command.com */
static int do_system2 (char *);	/* execute command as system */


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

struct command *lastdata = NULL;	/* used to associate all data-commands with each others */
static struct buff_chain *buffroot;	/* start of sys-input buffer */
static struct buff_chain **buffcurr;	/* current entry in buff_chain */
static int buffcount;		/* number of filled buffers */


/* ------------- subroutines ---------------- */


void
token (struct command *cmd)	/* extract token from variable */
{
  int split;
  struct stackentry *s;
  struct symbol *sym;
  struct array *ar;
  int num = 0, i;
  char *p, *q;
  char **pp;
  char *del, *line;
  int wasdel, isdel;


  if (cmd->type == cSPLIT2 || cmd->type == cTOKEN2)
    del = pop (stSTRING)->pointer;
  else
    del = " \t";
  split = (cmd->type == cSPLIT || cmd->type == cSPLIT2);
  s = pop (stSTRINGARRAYREF);
  line = pop (stSTRING)->pointer;
  sym = get_sym (s->pointer, syARRAY, amSEARCH);
  if (!sym || !sym->pointer)
    {
      sprintf (string, "array '%s()' is not defined", strip (s->pointer));
      error (ERROR, string);
      goto token_done;
    }
  ar = sym->pointer;
  if (ar->dimension > 1)
    {
      error (ERROR, "only one dimensional arrays allowed");
      goto token_done;
    }

  /* count number of tokens */
  isdel = TRUE;
  if (split && *line)
    num = 1;
  else
    num = 0;
  for (p = line; *p; ++p)
    {
      wasdel = isdel;
      isdel = (strchr (del, *p) != NULL);
      if (split)
	{
	  if (isdel)
	    num++;
	}
      else
	{
	  if (isdel && isdel != wasdel)
	    num++;
	}
    }
  if (!split && !isdel)
    num++;

  /* free previous array content */
  for (i = 0; i < ar->bounds[0]; i++)
    free (((char **) ar->pointer)[i]);
  free (ar->pointer);
  ar->pointer = my_malloc ((num + 1) * sizeof (char *));
  pp = ar->pointer;
  pp[0] = my_strdup ("");

  /* extract tokens */
  i = 1;
  isdel = TRUE;
  if (*line)
    {
      for (p = q = line;; p++)
	{
	  wasdel = isdel;
	  isdel = (strchr (del, *p) != NULL) || !*p;
	  if ((split && isdel) || (!split && (isdel && isdel != wasdel)))
	    {
	      while (strchr (del, *q) && q < p)
		q++;
	      pp[i] = my_strndup (q, p - q + 1);
	      pp[i][p - q] = '\0';
	      q = p + 1;
	      i++;
	    }
	  if (!*p)
	    break;
	}
    }

  ar->bounds[0] = num + 1;
token_done:
  s = push ();
  s->type = stNUMBER;
  s->value = num;
}


void
tokenalt (struct command *cmd)	/* extract token from variable with alternate semantics */
{
  char *del;			/* delimiter for strings */
  struct stackentry *t;
  char *old, *new, *tok;
  int split;

  if (cmd->type == cSPLITALT2 || cmd->type == cTOKENALT2)
    del = pop (stSTRING)->pointer;
  else
    del = " \t";
  split = (cmd->type == cSPLITALT || cmd->type == cSPLITALT2);

  t = pop (stSTRING);
  old = t->pointer;
  t->pointer = NULL;		/* prevent push from freeing the memory */
  t = push ();
  t->type = stSTRING;
  new = old;
  tok = NULL;
  while (*new)
    {
      if (!tok && (!strchr (del, *new) || split))
	tok = new;		/* found start of token */
      if (tok && strchr (del, *new))
	break;			/* found end of token */
      new++;
    }
  if (*new)
    {
      *new = '\0';		/* terminate token */
      new++;
      if (!split)
	{
	  while (*new)
	    {
	      if (!strchr (del, *new))
		break;		/* found start of next token */
	      new++;
	    }
	}
    }
  t->pointer = my_strdup (tok ? tok : "");	/* copy token */
  /* move rest of string */
  while (*new)
    {
      *old = *new;
      old++;
      new++;
    };
  *old = '\0';
}


void
glob (void)			/* check, if pattern globs string */
{
  char *str, *pat;
  struct stackentry *stack;
  int res;

  pat = (char *) pop (stSTRING)->pointer;
  str = (char *) pop (stSTRING)->pointer;

  res = do_glob (str, pat);
  stack = push ();
  stack->value = res;
  stack->type = stNUMBER;
}


static int
do_glob (char *str, char *pat)	/* actually do the globbing */
{
  int res;

  if (infolevel >= DEBUG)
    {
      sprintf (string, "globbing '%s' on '%s'", str, pat);
      error (DEBUG, string);
    }
  if (*pat == '\0' && *str == '\0')
    return TRUE;
  else if (*pat == '\0')
    return FALSE;
  else if (*pat == '?' && *str == '\0')
    return FALSE;
  else if (*pat == '?')
    {
      if (*str == '\0')
	return FALSE;
      pat++;
      str++;
    }
  else if (*pat == '*')
    {
      pat++;
      res = FALSE;
      while (*str && !(res = do_glob (str, pat)))
	str++;
      if (res)
	return TRUE;
    }
  else if (*str == '\0')
    return FALSE;
  else
    {
      while (*pat && *pat != '?' && *pat != '*')
	{
	  if (*pat != *str)
	    return FALSE;
	  str++;
	  pat++;
	}
    }
  return do_glob (str, pat);
}


void
concat ()			/* concatenates two strings from stack */
{
  struct stackentry *c;
  char *aa, *bb, *cc;

  aa = pop (stSTRING)->pointer;
  bb = pop (stSTRING)->pointer;
  cc = (char *) my_malloc (sizeof (char) *
			   (strlen (aa) + strlen (bb) + 1));
  strcpy (cc, bb);
  strcat (cc, aa);
  c = push ();
  c->type = stSTRING;
  c->pointer = cc;
}


void
create_changestring (int type)	/* create command 'changestring' */
{
  struct command *cmd;

  cmd = add_command (cCHANGESTRING, FALSE);
  cmd->args = type;
}


void
changestring (struct command *current)	/* changes a string */
{
  int type, a2, a3;
  char *newpart;
  char *oldstring;
  int i, len;
  struct stackentry *a1;

  type = current->args;
  newpart = pop (stSTRING)->pointer;
  if (type > fTWOARGS)
    a3 = (int) pop (stNUMBER)->value;
  if (type > fONEARGS)
    a2 = (int) pop (stNUMBER)->value;
  a1 = pop (stSTRING);
  oldstring = a1->pointer;
  a1->pointer = NULL;		/* this prevents push from freeing the memory */

  if (!oldstring || !*oldstring)
    return;
  switch (type)
    {
    case fMID:
      for (i = 1; i < a2 + a3; i++)
	{
	  if (!oldstring[i - 1])
	    break;
	  if (i >= a2)
	    {
	      if (!newpart[i - a2])
		break;
	      oldstring[i - 1] = newpart[i - a2];
	    }
	}
      break;
    case fMID2:
      len = strlen (oldstring);
      for (i = 1; i <= len; i++)
	{
	  if (!oldstring[i - 1])
	    break;
	  if (i >= a2)
	    {
	      if (!newpart[i - a2])
		break;
	      oldstring[i - 1] = newpart[i - a2];
	    }
	}
      break;
    case fLEFT:
      for (i = 1; i <= a2; i++)
	{
	  if (!oldstring[i - 1] || !newpart[i - 1])
	    break;
	  oldstring[i - 1] = newpart[i - 1];
	}
      break;
    case fRIGHT:
      len = strlen (oldstring);
      for (i = 1; i <= len; i++)
	{
	  if (i > len - a2)
	    {
	      if (!newpart[i - 1 - len + a2])
		break;
	      oldstring[i - 1] = newpart[i - 1 - len + a2];
	    }
	}
      break;
    }
}


void
create_function (int type)	/* create command 'function' */
/* type can be sin,cos,mid$ ... */
{
  struct command *cmd;

  cmd = add_command (cFUNCTION, FALSE);
  cmd->args = type;
}


void
function (struct command *current)	/* performs a function */
{
  struct stackentry *stack, *a1, *a2, *a3, *a4;
  char *pointer;
  double value;
  time_t datetime;
  int type, result, len, start, i, max;
  char *str, *str2;

  a3 = NULL;
  type = current->args;
  if (type > fTHREEARGS)
    a4 = pop (stSTRING_OR_NUMBER);
  if (type > fTWOARGS)
    a3 = pop (stSTRING_OR_NUMBER);
  if (type > fONEARGS)
    a2 = pop (stSTRING_OR_NUMBER);
  if (type > fZEROARGS)
    a1 = pop (stSTRING_OR_NUMBER);

  switch (type)
    {
    case fSIN:
      value = sin (a1->value);
      result = stNUMBER;
      break;
    case fASIN:
      value = asin (a1->value);
      result = stNUMBER;
      break;
    case fCOS:
      value = cos (a1->value);
      result = stNUMBER;
      break;
    case fACOS:
      value = acos (a1->value);
      result = stNUMBER;
      break;
    case fTAN:
      value = tan (a1->value);
      result = stNUMBER;
      break;
    case fATAN:
      value = atan (a1->value);
      result = stNUMBER;
      break;
    case fEXP:
      value = exp (a1->value);
      result = stNUMBER;
      break;
    case fLOG:
      value = log (a1->value);
      result = stNUMBER;
      break;
    case fLOG2:
      value = log (a1->value) / log (a2->value);
      result = stNUMBER;
      break;
    case fLEN:
      value = (double) strlen (a1->pointer);
      result = stNUMBER;
      break;
    case fSTR:
      sprintf (string, "%g", a1->value);
      pointer = my_strdup (string);
      result = stSTRING;
      break;
    case fSTR2:
    case fSTR3:
      result = stSTRING;
      if (!myformat
	  (string, a1->value, a2->pointer, a3 ? a3->pointer : NULL))
	{
	  pointer = my_strdup ("");
	  sprintf (string, "'%s' is not a valid format",
		   (char *) a2->pointer);
	  error (ERROR, string);
	  break;
	}
      pointer = my_strdup (string);
      break;
    case fSQRT:
      value = sqrt (a1->value);
      result = stNUMBER;
      break;
    case fSQR:
      value = a1->value * a1->value;
      result = stNUMBER;
      break;
    case fINT:
      if (a1->value < 0)
	value = -floor (-a1->value);
      else
	value = floor (a1->value);
      result = stNUMBER;
      break;
    case fFRAC:
      if (a1->value < 0)
	value = a1->value + floor (-a1->value);
      else
	value = a1->value - floor (a1->value);
      result = stNUMBER;
      break;
    case fABS:
      value = fabs (a1->value);
      result = stNUMBER;
      break;
    case fSIG:
      if (a1->value < 0)
	value = -1.;
      else if (a1->value > 0)
	value = 1.;
      else
	value = 0.;
      result = stNUMBER;
      break;
    case fMOD:
      value = a1->value - a2->value * (int) (a1->value / a2->value);
      result = stNUMBER;
      break;
    case fRAN:
      value = a1->value * (((double) rand ()) / (((double) RAND_MAX) + 1));
      result = stNUMBER;
      break;
    case fRAN2:
      value = (double) rand () / RAND_MAX;
      result = stNUMBER;
      break;
    case fMIN:
      if (a1->value > a2->value)
	value = a2->value;
      else
	value = a1->value;
      result = stNUMBER;
      break;
    case fMAX:
      if (a1->value > a2->value)
	value = a1->value;
      else
	value = a2->value;
      result = stNUMBER;
      break;
    case fVAL:
      i = sscanf ((char *) a1->pointer, "%lf", &value);
      if (i != 1)
	value = 0;
      result = stNUMBER;
      break;
    case fATAN2:
      value = atan2 (a1->value, a2->value);
      result = stNUMBER;
      break;
    case fLEFT:
      str = a1->pointer;
      len = (int) a2->value;
      pointer = fromto (str, 0, len - 1);
      result = stSTRING;
      break;
    case fRIGHT:
      str = a1->pointer;
      max = strlen (str);
      len = (int) a2->value;
      pointer = fromto (str, max - len, max - 1);
      result = stSTRING;
      break;
    case fMID:
      str = a1->pointer;
      start = (int) a2->value;
      len = (int) a3->value;
      pointer = fromto (str, start - 1, start + len - 2);
      result = stSTRING;
      break;
    case fMID2:
      str = a1->pointer;
      start = (int) a2->value;
      pointer = fromto (str, start - 1, strlen (str));
      result = stSTRING;
      break;
    case fINKEY:
      pointer = inkey (a1->value);
      result = stSTRING;
      break;
    case fAND:
      value = (int) a1->value & (int) a2->value;
      result = stNUMBER;
      break;
    case fOR:
      value = (int) a1->value | (int) a2->value;
      result = stNUMBER;
      break;
    case fEOR:
      value = (int) a1->value ^ (int) a2->value;
      result = stNUMBER;
      break;
    case fMOUSEX:
      getmousexybm (a1->pointer, &i, NULL, NULL, NULL);
      value = i;
      result = stNUMBER;
      break;
    case fMOUSEY:
      getmousexybm (a1->pointer, NULL, &i, NULL, NULL);
      value = i;
      result = stNUMBER;
      break;
    case fMOUSEB:
      getmousexybm (a1->pointer, NULL, NULL, &i, NULL);
      value = i;
      result = stNUMBER;
      break;
    case fMOUSEMOD:
      getmousexybm (a1->pointer, NULL, NULL, NULL, &i);
      value = i;
      result = stNUMBER;
      break;
    case fCHR:
      pointer = my_malloc (2);
      i = (int) floor (a1->value);
      if (i > 255 || i < 0)
	{
	  sprintf (string, "can磘 convert %g to character", a1->value);
	  error (ERROR, string);
	  return;
	}
      pointer[1] = '\0';
      pointer[0] = (unsigned char) i;
      result = stSTRING;
      break;
    case fASC:
      value = ((unsigned char *) a1->pointer)[0];
      result = stNUMBER;
      break;
    case fBIN:
      pointer = dec2other (a1->value, 2);
      result = stSTRING;
      break;
    case fHEX:
      pointer = dec2other (a1->value, 16);
      result = stSTRING;
      break;
    case fDEC:
      value = other2dec (a1->pointer, 16);
      result = stNUMBER;
      break;
    case fDEC2:
      value = other2dec (a1->pointer, (int) (a2->value));
      result = stNUMBER;
      break;
    case fUPPER:
      str = a1->pointer;
      pointer = my_malloc (strlen (str) + 1);
      i = -1;
      do
	{
	  i++;
	  pointer[i] = toupper ((int) str[i]);
	}
      while (pointer[i]);
      result = stSTRING;
      break;
    case fLOWER:
      str = a1->pointer;
      pointer = my_malloc (strlen (str) + 1);
      i = -1;
      do
	{
	  i++;
	  pointer[i] = tolower ((int) str[i]);
	}
      while (pointer[i]);
      result = stSTRING;
      break;
    case fLTRIM:
      str = a1->pointer;
      while (isspace (*str))
	str++;
      pointer = my_strdup (str);
      result = stSTRING;
      break;
    case fRTRIM:
      str = a1->pointer;
      i = strlen (str) - 1;
      while (isspace (str[i]) && i >= 0)
	i--;
      str[i + 1] = '\0';
      pointer = my_strdup (str);
      result = stSTRING;
      break;
    case fTRIM:
      str = a1->pointer;
      i = strlen (str) - 1;
      while (isspace (str[i]) && i >= 0)
	i--;
      str[i + 1] = '\0';
      while (isspace (*str))
	str++;
      pointer = my_strdup (str);
      result = stSTRING;
      break;
    case fINSTR:
      str = a1->pointer;
      str2 = a2->pointer;
      if (*str2)