function.c

Linux下VB解释器

      fontheight = (int) darg;
#ifdef UNIX
      calc_psscale ();
#endif
    }
  else if (!strcmp (dest, "font") && sarg)
    {
      font = my_strdup (sarg);
    }
  else if (!strcmp (dest, "dump") && sarg && !strcmp (sarg, "symbols"))
    {
      dump_sym ();
    }
  else if (!strcmp (dest, "dump") && sarg &&
	   (!strcmp (sarg, "sub") || !strcmp (sarg, "subs")
	    || !strcmp (sarg, "subroutine")
	    || !strcmp (sarg, "subroutines")))
    {
      dump_sub (0);
    }
  else if (!strcmp (dest, "winwidth") && !sarg)
    {
      winwidth = (int) darg;
      if (winwidth < 1)
	{
	  error (ERROR, "winwidth less than 1 pixel");
	  return;
	}
#ifdef UNIX
      calc_psscale ();
#endif
    }
  else if (!strcmp (dest, "winheight") && !sarg)
    {
      winheight = (int) darg;
      if (winheight < 1)
	{
	  error (ERROR, "winheight less than 1 pixel");
	  return;
	}
#ifdef UNIX
      calc_psscale ();
#endif
    }
  else if (!strcmp (dest, "textalign") && sarg)
    {
      if (!check_alignment (sarg))
	return;
      strncpy (text_align, sarg, 2);
    }
  else if (!strcmp (dest, "windoworigin") && sarg)
    {
      moveorigin (sarg);
    }
  else if (!strcmp (dest, "infolevel") && sarg)
    {
      c = tolower ((int) *sarg);
      switch (c)
	{
	case 'd':
	  infolevel = DEBUG;
	  break;
	case 'n':
	  infolevel = NOTE;
	  break;
	case 'w':
	  infolevel = WARNING;
	  break;
	case 'e':
	  infolevel = ERROR;
	  break;
	case 'f':
	  infolevel = FATAL;
	  break;
	default:
	  error (ERROR, "invalid infolevel");
	  return;
	}
      if (infolevel >= DEBUG)
	{
	  sprintf (string, "switching infolevel to '%c'", c);
	  error (DEBUG, string);
	}
    }
  else if (!strcmp (dest, "stdout") && sarg)
    {
      fputs (sarg, stdout);
    }
  else if (!strcmp (dest, "read_controls") && !sarg)
    {
      read_controls = darg ? 1 : 0;
    }
  else if (dest[0] == '#')
    {
      error (ERROR, "don't use quotes when poking into file");
    }
  else
    {
      error (ERROR, "invalid poke");
    }
  return;
}


void
pokefile (struct command *cmd)	/* poke into file */
{
  char *sarg = NULL;
  double darg;
  int stream;

  if (cmd->tag == 'S')
    sarg = pop (stSTRING)->pointer;
  else
    darg = pop (stNUMBER)->value;
  stream = (int) (pop (stNUMBER)->value);

  if (badstream (stream, 0))
    return;

  if (!(stream_modes[stream] & smWRITE))
    {
      sprintf (string, "Stream %d not open for writing", stream);
      error (ERROR, string);
      return;
    }
  if (sarg)
    {
      fputs (sarg, streams[stream]);
    }
  else
    {
      if (darg < 0 || darg > 255)
	{
	  error (ERROR, "stream poke out of byte range (0..255)");
	  return;
	}
      fputc ((int) darg, streams[stream]);
    }
}


static double
peek (char *dest)		/* peek into internals */
{
  char *s;

  for (s = dest; *s; s++)
    *s = tolower ((int) *s);
  if (!strcmp (dest, "winwidth"))
    return winwidth;
  else if (!strcmp (dest, "winheight"))
    return winheight;
  else if (!strcmp (dest, "fontheight"))
    return fontheight;
  else if (!strcmp (dest, "screenheight"))
    return LINES;
  else if (!strcmp (dest, "screenwidth"))
    return COLS;
  else if (!strcmp (dest, "argument") || !strcmp (dest, "arguments"))
    return yabargc;
  else if (!strcmp (dest, "version"))
    return strtod (VERSION, NULL);
  else if (!strcmp (dest, "error"))
    return errorcode;
  else if (!strcmp (dest, "read_controls"))
    return read_controls;
  else if (!strcmp (dest, "isbound"))
    return is_bound;
  else if (dest[0] == '#')
    {
      error (ERROR, "don't use quotes when peeking into a file");
      return 0;
    }

  error (ERROR, "invalid peek");
  return 0;
}


static int
peekfile (int stream)		/* read a byte from stream */
{
  if (stream && badstream (stream, 0))
    return 0;
  if (stream && !(stream_modes[stream] & smREAD))
    {
      sprintf (string, "stream %d not open for reading", stream);
      error (ERROR, string);
      return 0;
    }
  return fgetc (stream ? streams[stream] : stdin);
}


static char *
peek2 (char *dest, struct command *curr)	/* peek into internals */
{
  char *s;

  for (s = dest; *s; s++)
    *s = tolower ((int) *s);
  if (!strcmp (dest, "infolevel"))
    {
      if (infolevel == DEBUG)
	return my_strdup ("debug");
      else if (infolevel == NOTE)
	return my_strdup ("note");
      else if (infolevel == WARNING)
	return my_strdup ("warning");
      else if (infolevel == ERROR)
	return my_strdup ("error");
      else if (infolevel == FATAL)
	return my_strdup ("fatal");
      else
	return my_strdup ("unkown");
    }
  else if (!strcmp (dest, "textalign"))
    return my_strdup (text_align);
  else if (!strcmp (dest, "windoworigin"))
    return my_strdup (winorigin);
  else if (!strcmp (dest, "error"))
    return my_strdup (errorstring);
  else if (!strcmp (dest, "library"))
    return my_strdup (curr->lib->s);
  else if (!strcmp (dest, "os"))
    {
#ifdef UNIX
      return my_strdup ("unix");
#else
      return my_strdup ("windows");
#endif
    }
  else if (!strcmp (dest, "font"))
    return my_strdup (font);
  else if (!strcmp (dest, "argument") || !strcmp (dest, "arguments"))
    {
      if (yabargc > 0)
	{
	  s = yabargv[0];
	  yabargc--;
	  yabargv++;
	}
      else
	{
	  s = "";
	}
      return my_strdup (s);
    }
  else
    {
      error (ERROR, "invalid peek");
    }
  return my_strdup ("");
}


static char *
peek3 (char *dest, char *cont)	/* peek into internals */
{
  char *s;

  for (s = dest; *s; s++)
    *s = tolower ((int) *s);
  if (!strcmp (dest, "env") || !strcmp (dest, "environment"))
    {
      return my_strdup (getenv (cont));
    }
  else
    {
      error (ERROR, "invalid peek");
    }
  return my_strdup ("");
}


void
create_exception (int flag)	/* create command 'exception' */
{
  struct command *cmd;

  cmd = add_command (cEXCEPTION, FALSE);
  cmd->args = flag;
}


void
exception (struct command *cmd)	/* change handling of exceptions */
{
  if (cmd->args)
    {
      signal (SIGINT, signal_handler);	/* enable keyboard interrupt */
#ifdef SIGHUP
      signal (SIGHUP, signal_handler);
#endif
#ifdef SIGQUIT
      signal (SIGQUIT, signal_handler);
#endif
#ifdef SIGABRT
      signal (SIGABRT, signal_handler);
#endif
#ifdef SIGTERM
      signal (SIGTERM, signal_handler);
#endif
    }
  else
    {
      signal (SIGINT, SIG_IGN);	/* ignore keyboard interrupt */
#ifdef SIGHUP
      signal (SIGHUP, SIG_IGN);
#endif
#ifdef SIGQUIT
      signal (SIGQUIT, SIG_IGN);
#endif
#ifdef SIGABRT
      signal (SIGABRT, SIG_IGN);
#endif
#ifdef SIGTERM
      signal (SIGTERM, SIG_IGN);
#endif
    }
  return;
}


void
create_restore (char *label)	/* create command 'restore' */
{
  struct command *c;

  c = add_command (cRESTORE, FALSE);
  c->pointer = my_strdup (label);
}


void
restore (struct command *cmd)	/* reset data pointer to given label */
{
  struct command *label;
  struct command **datapointer;

  datapointer = &(cmd->lib->datapointer);
  if (cmd->type == cRESTORE)
    {				/* first time; got to search the label */
      if (*((char *) cmd->pointer) == '\0')
	{
	  /* no label, restore to first command */
	  label = cmd->lib->firstdata;
	}
      else
	{
	  label = search_label (cmd->pointer, smLABEL | smGLOBAL);
	  if (!label)
	    {
	      /* did not find label */
	      sprintf (string, "can't find label '%s'",
		       (char *) cmd->pointer);
	      error (ERROR, string);
	      return;
	    }
	}
      *datapointer = label;
      if (lastdata)
	{
	  while ((*datapointer)->type != cDATA
		 && (*datapointer) != cmdhead)
	    {
	      *datapointer = (*datapointer)->next;
	    }
	}
      cmd->pointer = *datapointer;
      cmd->type = cQRESTORE;
    }
  else
    {
      *datapointer = cmd->pointer;
    }
  return;
}


void
create_dbldata (double value)	/* create command dbldata */
{
  struct command *c;

  c = add_command (cDATA, FALSE);
  c->pointer = my_malloc (sizeof (double));
  if (lastdata)
    lastdata->nextassoc = c;
  lastdata = c;
  *((double *) c->pointer) = value;
  c->tag = 'd';			/* double value */
}


void
create_strdata (char *value)	/* create command strdata */
{
  struct command *c;

  c = add_command (cDATA, FALSE);
  if (lastdata)
    lastdata->nextassoc = c;
  lastdata = c;
  c->pointer = my_strdup (value);
  c->tag = 's';			/* string value */
}


void
create_readdata (char type)	/* create command readdata */
{
  struct command *cmd;

  cmd = add_command (cREADDATA, FALSE);
  cmd->tag = type;
}


void
readdata (struct command *cmd)	/* read data items */
{
  struct stackentry *read;
  char type;
  struct command **datapointer;

  datapointer = &(cmd->lib->datapointer);
  type = cmd->tag;
  while (*datapointer
	 && ((*datapointer)->type != cDATA
	     || cmd->lib != (*datapointer)->lib))
    {
      *datapointer = (*datapointer)->nextassoc;
    }
  if (!*datapointer)
    {
      error (ERROR, "run out of data items");
      return;
    }
  if (type != (*datapointer)->tag)
    {
      error (ERROR, "type of READ and DATA don't match");
      return;
    }
  read = push ();
  if (type == 'd')
    {				/* read a double value */
      read->type = stNUMBER;
      read->value = *((double *) (*datapointer)->pointer);
    }
  else
    {
      read->type = stSTRING;
      read->pointer = my_strdup ((*datapointer)->pointer);
    }
  *datapointer = (*datapointer)->nextassoc;	/* next item */
}


void
create_dblrelop (char c)	/* create command dblrelop */
{
  int type;

  switch (c)
    {
    case '=':
      type = cEQ;
      break;
    case '!':
      type = cNE;
      break;
    case '<':
      type = cLT;
      break;
    case '{':
      type = cLE;
      break;
    case '>':
      type = cGT;
      break;
    case '}':
      type = cGE;
      break;
    }
  add_command (type, FALSE);
}


void
dblrelop (struct command *type)	/* compare topmost double-values */
{
  double a, b, c;
  struct stackentry *result;

  b = pop (stNUMBER)->value;
  a = pop (stNUMBER)->value;
  switch (current->type)
    {
    case cEQ:
      c = (a == b);
      break;
    case cNE:
      c = (a != b);
      break;
    case cLE:
      c = (a <= b);
      break;
    case cLT:
      c = (a < b);
      break;
    case cGE:
      c = (a >= b);
      break;
    case cGT:
      c = (a > b);
      break;
    }
  result = push ();
  result->value = c;
  result->type = stNUMBER;
}


void
create_strrelop (char c)	/* create command strrelop */
{
  int type;

  switch (c)
    {
    case '=':
      type = cSTREQ;
      break;
    case '!':
      type = cSTRNE;
      break;
    case '<':
      type = cSTRLT;
      break;
    case '{':
      type = cSTRLE;
      break;
    case '>':
      type = cSTRGT;
      break;
    case '}':
      type = cSTRGE;
      break;
    }
  add_command (type, FALSE);
}


void
strrelop (struct command *type)	/* compare topmost string-values */
{
  char *a, *b;
  double c;
  struct stackentry *result;

  b = pop (stSTRING)->pointer;
  a = pop (stSTRING)->pointer;
  switch (current->type)
    {
    case cSTREQ:
      c = (strcmp (a, b) == 0);
      break;
    case cSTRNE:
      c = (strcmp (a, b) != 0);
      break;
    case cSTRLT:
      c = (strcmp (a, b) < 0);
      break;
    case cSTRLE:
      c = (strcmp (a, b) <= 0);
      break;
    case cSTRGT:
      c = (strcmp (a, b) > 0);
      break;
    case cSTRGE:
      c = (strcmp (a, b) >= 0);
      break;
    }
  result = push ();
  result->value = c;
  result->type = stNUMBER;
}

void
switch_compare (void)		/* compare topmost values for switch statement */
{
  struct stackentry *result, *first, *second;
  double r = 0.;

  first = pop (stANY);
  second = stackhead->prev;
  if ((second->type == stSWITCH_STRING || second->type == stSTRING)
      && first->type == stSTRING)
    {
      if (second->type == stSWITCH_STRING)
	r = 1.;
      else
	r = (strcmp (first->pointer, second->pointer) == 0) ? 1. : 0.;
    }
  else if ((second->type == stSWITCH_NUMBER || second->type == stNUMBER)
	   && first->type == stNUMBER)
    {
      if (second->type == stSWITCH_NUMBER)
	r = 1.;
      else
	r = (first->value == second->value);
    }
  else
    {
      error (ERROR,
	     "Cannot mix strings and numbers in a single switch statement");
    }
  result = push ();
  result->type = stNUMBER;
  result->value = r;
}


void
logical_shortcut (struct command *type)	/* shortcut and/or if possible */
{
  struct stackentry *result;
  double is;

  is = stackhead->prev->value;
  if ((type->type == cORSHORT && is != 0)
      || (type->type == cANDSHORT && is == 0))
    {
      result = push ();
      error (DEBUG, "logical shortcut taken");
      result->type = stNUMBER;
      result->value = is;
    }
  else
    {
      current = current->next;
    }
}


void
create_boole (char c)		/* create command boole */
{
  int type;

  switch (c)
    {
    case '|':
      type = cOR;
      break;
    case '&':
      type = cAND;
      break;
    case '!':
      type = cNOT;
      break;
    }
  add_command (type, FALSE);
}


void
boole (struct command *type)	/* perform and/or/not */
{
  int a, b, c;
  struct stackentry *result;

  a = (int) pop (stNUMBER)->value;
  if (current->type == cNOT)
    c = !a;
  else
    {
      b = (int) pop (stNUMBER)->value;
      if (current->type == cAND)
	c = a && b;
      else
	c = a || b;
    }
  result = push ();
  result->value = c;
  result->type = stNUMBER;
}