path: root/apps/interpreters/bas/bas_global.c

/****************************************************************************
 * apps/interpreters/bas/bas_global.c
 * Global variables and functions.
 *
 *   Copyright (c) 1999-2014 Michael Haardt
 *
 * Permission is hereby granted, free of charge, to any person obtaining a
 * copy of this software and associated documentation files (the "Software"),
 * to deal in the Software without restriction, including without limitation
 * the rights to use, copy, modify, merge, publish, distribute, sublicense,
 * and/or sell copies of the Software, and to permit persons to whom the
 * Software is furnished to do so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be included in
 * all copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 * DEALINGS IN THE SOFTWARE.
 *
 * Adapted to NuttX and re-released under a 3-clause BSD license:
 *
 *   Copyright (C) 2014 Gregory Nutt. All rights reserved.
 *   Authors: Alan Carvalho de Assis <Alan Carvalho de Assis>
 *            Gregory Nutt <gnutt@nuttx.org>
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 *
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in
 *    the documentation and/or other materials provided with the
 *    distribution.
 * 3. Neither the name NuttX nor the names of its contributors may be
 *    used to endorse or promote products derived from this software
 *    without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
 * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
 * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
 * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
 * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
 * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
 * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 * POSSIBILITY OF SUCH DAMAGE.
 *
 ****************************************************************************/

/****************************************************************************
 * Included Files
 ****************************************************************************/

#include <nuttx/config.h>

#include <assert.h>
#include <ctype.h>
#include <dirent.h>
#include <errno.h>
#include <math.h>
#include <stdarg.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <time.h>
#include <unistd.h>

#include "bas_auto.h"
#include "bas.h"
#include "bas_error.h"
#include "bas_fs.h"
#include "bas_global.h"
#include "bas_var.h"

#include <nuttx/clock.h>

/****************************************************************************
 * Pre-processor Definitions
 ****************************************************************************/

#ifndef M_PI
#  define M_PI 3.14159265358979323846
#endif

#ifndef RAND_MAX
#  define RAND_MAX 32767
#endif

#define _(String) String

/****************************************************************************
 * Private Functions
 ****************************************************************************/

static int wildcardmatch(const char *a, const char *pattern)
{
  while (*pattern)
    {
      switch (*pattern)
        {
        case '*':
          {
            ++pattern;
            while (*a)
              if (wildcardmatch(a, pattern))
                {
                  return 1;
                }
              else
                {
                  ++a;
                }

            break;
          }

        case '?':
          {
            if (*a)
              {
                ++a;
                ++pattern;
              }
            else
              {
                return 0;
              }

            break;
          }

        default:
          if (*a == *pattern)
            {
              ++a;
              ++pattern;
            }
          else
            {
              return 0;
            }
        }
    }

  return (*pattern == '\0' && *a == '\0');
}

static long int intValue(struct Auto *stack, int l)
{
  struct Value value;
  struct Value *arg = Var_value(Auto_local(stack, l), 0, (int *)0, &value);
  assert(arg->type == V_INTEGER);
  return arg->u.integer;
}

static double realValue(struct Auto *stack, int l)
{
  struct Value value;
  struct Value *arg = Var_value(Auto_local(stack, l), 0, (int *)0, &value);
  assert(arg->type == V_REAL);
  return arg->u.real;
}

static struct String *stringValue(struct Auto *stack, int l)
{
  struct Value value;
  struct Value *arg = Var_value(Auto_local(stack, l), 0, (int *)0, &value);
  assert(arg->type == V_STRING);
  return &(arg->u.string);
}

static struct Value *bin(struct Value *v, unsigned long int value,
                         long int digits)
{
  char buf[sizeof(long int) * 8 + 1];
  char *s;

  Value_new_STRING(v);
  s = buf + sizeof(buf);
  *--s = '\0';
  if (digits == 0)
    {
      digits = 1;
    }

  while (digits || value)
    {
      *--s = value & 1 ? '1' : '0';
      if (digits)
        {
          --digits;
        }

      value >>= 1;
    }

  String_appendChars(&v->u.string, s);
  return v;
}

static struct Value *hex(struct Value *v, long int value, long int digits)
{
  char buf[sizeof(long int) * 2 + 1];

  sprintf(buf, "%0*lx", (int)digits, value);
  Value_new_STRING(v);
  String_appendChars(&v->u.string, buf);
  return v;
}

static struct Value *find(struct Value *v, struct String *pattern,
                          long int occurence)
{
  struct String dirname, basename;
  char *slash;
  DIR *dir;
  struct dirent *ent;
  int currentdir;
  int found = 0;

  Value_new_STRING(v);
  String_new(&dirname);
  String_new(&basename);
  String_appendString(&dirname, pattern);
  while (dirname.length > 0 && dirname.character[dirname.length - 1] == '/')
    {
      String_delete(&dirname, dirname.length - 1, 1);
    }

  if ((slash = strrchr(dirname.character, '/')) == (char *)0)
    {
      String_appendString(&basename, &dirname);
      String_delete(&dirname, 0, dirname.length);
      String_appendChar(&dirname, '.');
      currentdir = 1;
    }
  else
    {
      String_appendChars(&basename, slash + 1);
      String_delete(&dirname, slash - dirname.character,
                    dirname.length - (slash - dirname.character));
      currentdir = 0;
    }

  if ((dir = opendir(dirname.character)) != (DIR *) 0)
    {
      while ((ent = readdir(dir)) != (struct dirent *)0)
        {
          if (wildcardmatch(ent->d_name, basename.character))
            {
              if (found == occurence)
                {
                  if (currentdir)
                    {
                      String_appendChars(&v->u.string, ent->d_name);
                    }
                  else
                    {
                      String_appendPrintf(&v->u.string, "%s/%s",
                                          dirname.character, ent->d_name);
                    }

                  break;
                }

              ++found;
            }
        }

      closedir(dir);
    }

  String_destroy(&dirname);
  String_destroy(&basename);
  return v;
}

static struct Value *instr(struct Value *v, long int start, long int len,
                           struct String *haystack, struct String *needle)
{
  const char *haystackChars = haystack->character;
  size_t haystackLength = haystack->length;
  const char *needleChars = needle->character;
  size_t needleLength = needle->length;
  int found;

  --start;
  if (start < 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("position"));
    }

  if (len < 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  if (((size_t) start) >= haystackLength)
    {
      return Value_new_INTEGER(v, 0);
    }

  haystackChars += start;
  haystackLength -= start;
  if (haystackLength > len)
    {
      haystackLength = len;
    }

  found = 1 + start;
  while (needleLength <= haystackLength)
    {
      if (memcmp(haystackChars, needleChars, needleLength) == 0)
        {
          return Value_new_INTEGER(v, found);
        }

      ++haystackChars;
      --haystackLength;
      ++found;
    }

  return Value_new_INTEGER(v, 0);
}

static struct Value *string(struct Value *v, long int len, int c)
{
  if (len < 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  if (c < 0 || c > 255)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("code"));
    }

  Value_new_STRING(v);
  String_size(&v->u.string, len);
  if (len)
    {
      memset(v->u.string.character, c, len);
    }

  return v;
}

static struct Value *mid(struct Value *v, struct String *s, long int position,
                         long int length)
{
  --position;
  if (position < 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("position"));
    }

  if (length < 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  if (((size_t) position) + length > s->length)
    {
      length = s->length - position;
      if (length < 0)
        {
          length = 0;
        }
    }

  Value_new_STRING(v);
  String_size(&v->u.string, length);
  if (length > 0)
    {
      memcpy(v->u.string.character, s->character + position, length);
    }

  return v;
}

static struct Value *inkey(struct Value *v, long int timeout, long int chn)
{
  int c;

  if ((c = FS_inkeyChar(chn, timeout * 10)) == -1)
    {
      if (FS_errmsg)
        {
          return Value_new_ERROR(v, IOERROR, FS_errmsg);
        }
      else
        {
          return Value_new_STRING(v);
        }
    }
  else
    {
      Value_new_STRING(v);
      String_appendChar(&v->u.string, c);
      return v;
    }
}

static struct Value *input(struct Value *v, long int len, long int chn)
{
  int ch = -1;

  if (len <= 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  Value_new_STRING(v);
  while (len-- && (ch = FS_getChar(chn)) != -1)
    {
      String_appendChar(&v->u.string, ch);
    }

  if (ch == -1)
    {
      Value_destroy(v);
      return Value_new_ERROR(v, IOERROR, FS_errmsg);
    }

  return v;
}

static struct Value *env(struct Value *v, long int n)
{
  int i;

  --n;
  if (n < 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("variable number"));
    }

  for (i = 0; i < n && environ[i]; ++i);

  Value_new_STRING(v);
  if (i == n && environ[i])
    {
      String_appendChars(&v->u.string, environ[i]);
    }

  return v;
}

static struct Value *rnd(struct Value *v, long int x)
{
  if (x < 0)
    {
      srand(-x);
    }

  if (x == 0 || x == 1)
    {
      Value_new_REAL(v, rand() / (double)RAND_MAX);
    }
  else
    {
      Value_new_REAL(v, rand() % x + 1);
    }

  return v;
}

static struct Value *fn_abs(struct Value *v, struct Auto *stack)
{
  return Value_new_REAL(v, fabs(realValue(stack, 0)));
}

static struct Value *fn_asc(struct Value *v, struct Auto *stack)
{
  struct String *s = stringValue(stack, 0);

  if (s->length == 0)
    {
      return Value_new_ERROR(v, UNDEFINED,
                             _("`asc' or `code' of empty string"));
    }

  return Value_new_INTEGER(v, s->character[0] & 0xff);
}

static struct Value *fn_atn(struct Value *v, struct Auto *stack)
{
  return Value_new_REAL(v, atan(realValue(stack, 0)));
}

static struct Value *fn_bini(struct Value *v, struct Auto *stack)
{
  return bin(v, intValue(stack, 0), 0);
}

static struct Value *fn_bind(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int n;

  n = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("number"));
    }

  return bin(v, n, 0);
}

static struct Value *fn_binii(struct Value *v, struct Auto *stack)
{
  return bin(v, intValue(stack, 0), intValue(stack, 1));
}

static struct Value *fn_bindi(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int n;

  n = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("number"));
    }

  return bin(v, n, intValue(stack, 1));
}

static struct Value *fn_binid(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int digits;

  digits = Value_toi(realValue(stack, 1), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("digits"));
    }

  return bin(v, intValue(stack, 0), digits);
}

static struct Value *fn_bindd(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int n, digits;

  n = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("number"));
    }

  digits = Value_toi(realValue(stack, 1), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("digits"));
    }

  return bin(v, n, digits);
}

static struct Value *fn_chr(struct Value *v, struct Auto *stack)
{
  long int chr = intValue(stack, 0);

  if (chr < 0 || chr > 255)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("character code"));
    }

  Value_new_STRING(v);
  String_size(&v->u.string, 1);
  v->u.string.character[0] = chr;
  return v;
}

static struct Value *fn_cint(struct Value *v, struct Auto *stack)
{
  return Value_new_REAL(v, ceil(realValue(stack, 0)));
}

static struct Value *fn_cos(struct Value *v, struct Auto *stack)
{
  return Value_new_REAL(v, cos(realValue(stack, 0)));
}

static struct Value *fn_command(struct Value *v, struct Auto *stack)
{
  int i;

  Value_new_STRING(v);
  for (i = 0; i < g_bas_argc; ++i)
    {
      if (i)
        {
          String_appendChar(&v->u.string, ' ');
        }

      String_appendChars(&v->u.string, g_bas_argv[i]);
    }

  return v;
}

static struct Value *fn_commandi(struct Value *v, struct Auto *stack)
{
  int a;

  a = intValue(stack, 0);
  if (a < 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("argument number"));
    }

  Value_new_STRING(v);
  if (a == 0)
    {
      if (g_bas_argv0 != (char *)0)
        {
          String_appendChars(&v->u.string, g_bas_argv0);
        }
    }
  else if (a <= g_bas_argc)
    {
      String_appendChars(&v->u.string, g_bas_argv[a - 1]);
    }

  return v;
}

static struct Value *fn_commandd(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int a;

  a = Value_toi(realValue(stack, 0), &overflow);
  if (overflow || a < 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("argument number"));
    }

  Value_new_STRING(v);
  if (a == 0)
    {
      if (g_bas_argv0 != (char *)0)
        {
          String_appendChars(&v->u.string, g_bas_argv0);
        }
    }
  else if (a <= g_bas_argc)
    {
      String_appendChars(&v->u.string, g_bas_argv[a - 1]);
    }

  return v;
}

static struct Value *fn_cvi(struct Value *v, struct Auto *stack)
{
  struct String *s = stringValue(stack, 0);
  long int n = (s->length && s->character[s->length - 1] < 0) ? -1 : 0;
  int i;

  for (i = s->length - 1; i >= 0; --i)
    {
      n = (n << 8) | (s->character[i] & 0xff);
    }

  return Value_new_INTEGER(v, n);
}

static struct Value *fn_cvs(struct Value *v, struct Auto *stack)
{
  struct String *s = stringValue(stack, 0);
  float n;

  if (s->length != sizeof(float))
    {
      return Value_new_ERROR(v, BADCONVERSION, _("number"));
    }

  memcpy(&n, s->character, sizeof(float));
  return Value_new_REAL(v, (double)n);
}

static struct Value *fn_cvd(struct Value *v, struct Auto *stack)
{
  struct String *s = stringValue(stack, 0);
  double n;

  if (s->length != sizeof(double))
    {
      return Value_new_ERROR(v, BADCONVERSION, _("number"));
    }

  memcpy(&n, s->character, sizeof(double));
  return Value_new_REAL(v, n);
}

static struct Value *fn_date(struct Value *v, struct Auto *stack)
{
  time_t t;
  struct tm *now;

  Value_new_STRING(v);
  String_size(&v->u.string, 10);
  time(&t);
  now = localtime(&t);
  sprintf(v->u.string.character, "%02d-%02d-%04d", now->tm_mon + 1,
          now->tm_mday, now->tm_year + 1900);
  return v;
}

static struct Value *fn_dec(struct Value *v, struct Auto *stack)
{
  struct Value value, *arg;
  size_t using;

  Value_new_STRING(v);
  arg = Var_value(Auto_local(stack, 0), 0, (int *)0, &value);
  using = 0;
  Value_toStringUsing(arg, &v->u.string, stringValue(stack, 1), &using);
  return v;
}

static struct Value *fn_deg(struct Value *v, struct Auto *stack)
{
  return Value_new_REAL(v, realValue(stack, 0) * (180.0 / M_PI));
}

static struct Value *fn_det(struct Value *v, struct Auto *stack)
{
  return Value_new_REAL(v,
                        stack->lastdet.type ==
                        V_NIL ? 0.0 : (stack->lastdet.type ==
                                       V_REAL ? stack->lastdet.u.
                                       real : stack->lastdet.u.integer));
}

static struct Value *fn_edit(struct Value *v, struct Auto *stack)
{
  int code;
  char *begin, *end, *rd, *wr;
  char quote;

  code = intValue(stack, 1);
  Value_new_STRING(v);
  String_appendString(&v->u.string, stringValue(stack, 0));
  begin = rd = wr = v->u.string.character;
  end = rd + v->u.string.length;

  /* 8 - Discard Leading Spaces and Tabs */

  if (code & 8)
    {
      while (rd < end && (*rd == ' ' || *rd == '\t'))
        {
          ++rd;
        }
    }

  while (rd < end)
    {
      /* 1 - Discard parity bit */

      if (code & 1)
        {
          *rd = *rd & 0x7f;
        }

      /* 2 - Discard all spaces and tabs */

      if ((code & 2) && (*rd == ' ' || *rd == '\t'))
        {
          ++rd;
          continue;
        }

      /* 4 - Discard all carriage returns, line feeds, form feeds, deletes,
       * escapes, and nulls */

      if ((code & 4) &&
          (*rd == '\r' || *rd == '\n' || *rd == '\f' || *rd == 127 || *rd == 27
           || *rd == '\0'))
        {
          ++rd;
          continue;
        }

      /* 16 - Convert Multiple Spaces and Tabs to one space */

      if ((code & 16) && ((*rd == ' ') || (*rd == '\t')))
        {
          *wr++ = ' ';
          while (rd < end && (*rd == ' ' || *rd == '\t'))
            {
              ++rd;
            }

          continue;
        }

      /* 32 - Convert lower to upper case */

      if ((code & 32) && islower((int)*rd))
        {
          *wr++ = toupper((int)*rd++);
          continue;
        }

      /* 64 - Convert brackets to parentheses */

      if (code & 64)
        {
          if (*rd == '[')
            {
              *wr++ = '(';
              ++rd;
              continue;
            }
          else if (*rd == ']')
            {
              *wr++ = ')';
              ++rd;
              continue;
            }
        }

      /* 256 - Suppress all editing for characters within quotation marks */

      if ((code & 256) && (*rd == '"' || *rd == '\''))
        {
          quote = *rd;
          *wr++ = *rd++;
          while (rd < end && *rd != quote)
            {
              *wr++ = *rd++;
            }

          if (rd < end)
            {
              *wr++ = *rd++;
              quote = '\0';
            }

          continue;
        }

      *wr++ = *rd++;
    }

  /* 128 - Discard Trailing Spaces and Tabs */

  if ((code & 128) && wr > begin)
    {
      while (wr > begin && (*(wr - 1) == '\0' || *(wr - 1) == '\t'))
        {
          --wr;
        }
    }

  String_size(&v->u.string, wr - begin);
  return v;
}

static struct Value *fn_environi(struct Value *v, struct Auto *stack)
{
  return env(v, intValue(stack, 0));
}

static struct Value *fn_environd(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int n;

  n = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("number"));
    }

  return env(v, n);
}

static struct Value *fn_environs(struct Value *v, struct Auto *stack)
{
  char *var;

  Value_new_STRING(v);
  if ((var = stringValue(stack, 0)->character))
    {
      char *val = getenv(var);

      if (val)
        {
          String_appendChars(&v->u.string, val);
        }
    }

  return v;
}

static struct Value *fn_eof(struct Value *v, struct Auto *stack)
{
  int e = FS_eof(intValue(stack, 0));

  if (e == -1)
    {
      return Value_new_ERROR(v, IOERROR, FS_errmsg);
    }

  return Value_new_INTEGER(v, e ? -1 : 0);
}

static struct Value *fn_erl(struct Value *v, struct Auto *stack)
{
  return Value_new_INTEGER(v, stack->erl);
}

static struct Value *fn_err(struct Value *v, struct Auto *stack)
{
  return Value_new_INTEGER(v,
                           stack->err.type ==
                           V_NIL ? 0 : stack->err.u.error.code);
}

static struct Value *fn_exp(struct Value *v, struct Auto *stack)
{
  return Value_new_REAL(v, exp(realValue(stack, 0)));
}

static struct Value *fn_false(struct Value *v, struct Auto *stack)
{
  return Value_new_INTEGER(v, 0);
}

static struct Value *fn_find(struct Value *v, struct Auto *stack)
{
  return find(v, stringValue(stack, 0), 0);
}

static struct Value *fn_findi(struct Value *v, struct Auto *stack)
{
  return find(v, stringValue(stack, 0), intValue(stack, 1));
}

static struct Value *fn_findd(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int n;

  n = Value_toi(realValue(stack, 1), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("number"));
    }

  return find(v, stringValue(stack, 0), n);
}

static struct Value *fn_fix(struct Value *v, struct Auto *stack)
{
  double x = realValue(stack, 0);
  return Value_new_REAL(v, x < 0.0 ? ceil(x) : floor(x));
}

static struct Value *fn_frac(struct Value *v, struct Auto *stack)
{
  double x = realValue(stack, 0);
  return Value_new_REAL(v, x < 0.0 ? x - ceil(x) : x - floor(x));
}

static struct Value *fn_freefile(struct Value *v, struct Auto *stack)
{
  return Value_new_INTEGER(v, FS_freechn());
}

static struct Value *fn_hexi(struct Value *v, struct Auto *stack)
{
  char buf[sizeof(long int) * 2 + 1];

  sprintf(buf, "%lx", intValue(stack, 0));
  Value_new_STRING(v);
  String_appendChars(&v->u.string, buf);
  return v;
}

static struct Value *fn_hexd(struct Value *v, struct Auto *stack)
{
  char buf[sizeof(long int) * 2 + 1];
  int overflow;
  long int n;

  n = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("number"));
    }

  sprintf(buf, "%lx", n);
  Value_new_STRING(v);
  String_appendChars(&v->u.string, buf);
  return v;
}

static struct Value *fn_hexii(struct Value *v, struct Auto *stack)
{
  return hex(v, intValue(stack, 0), intValue(stack, 1));
}

static struct Value *fn_hexdi(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int n;

  n = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("number"));
    }
  return hex(v, n, intValue(stack, 1));
}

static struct Value *fn_hexid(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int digits;

  digits = Value_toi(realValue(stack, 1), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("digits"));
    }

  return hex(v, intValue(stack, 0), digits);
}

static struct Value *fn_hexdd(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int n, digits;

  n = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("number"));
    }

  digits = Value_toi(realValue(stack, 1), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("digits"));
    }

  return hex(v, n, digits);
}

static struct Value *fn_int(struct Value *v, struct Auto *stack)
{
  return Value_new_REAL(v, floor(realValue(stack, 0)));
}

static struct Value *fn_intp(struct Value *v, struct Auto *stack)
{
  long int l;

  errno = 0;
  l = lrint(floor(realValue(stack, 0)));
  if (errno == EDOM)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("number"));
    }

  return Value_new_INTEGER(v, l);
}

static struct Value *fn_inp(struct Value *v, struct Auto *stack)
{
  int r = FS_portInput(intValue(stack, 0));

  if (r == -1)
    {
      return Value_new_ERROR(v, IOERROR, FS_errmsg);
    }
  else
    {
      return Value_new_INTEGER(v, r);
    }
}

static struct Value *fn_input1(struct Value *v, struct Auto *stack)
{
  return input(v, intValue(stack, 0), STDCHANNEL);
}

static struct Value *fn_input2(struct Value *v, struct Auto *stack)
{
  return input(v, intValue(stack, 0), intValue(stack, 1));
}

static struct Value *fn_inkey(struct Value *v, struct Auto *stack)
{
  return inkey(v, 0, STDCHANNEL);
}

static struct Value *fn_inkeyi(struct Value *v, struct Auto *stack)
{
  return inkey(v, intValue(stack, 0), STDCHANNEL);
}

static struct Value *fn_inkeyd(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int t;

  t = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("time"));
    }

  return inkey(v, t, STDCHANNEL);
}

static struct Value *fn_inkeyii(struct Value *v, struct Auto *stack)
{
  return inkey(v, intValue(stack, 0), intValue(stack, 1));
}

static struct Value *fn_inkeyid(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int chn;

  chn = Value_toi(realValue(stack, 1), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("channel"));
    }

  return inkey(v, intValue(stack, 0), chn);
}

static struct Value *fn_inkeydi(struct Value *v, struct Auto *stack)
{
  return inkey(v, realValue(stack, 0), intValue(stack, 1));
}

static struct Value *fn_inkeydd(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int t, chn;

  t = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("time"));
    }

  chn = Value_toi(realValue(stack, 1), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("channel"));
    }

  return inkey(v, t, chn);
}

static struct Value *fn_instr2(struct Value *v, struct Auto *stack)
{
  struct String *haystack = stringValue(stack, 0);

  return instr(v, 1, haystack->length, haystack, stringValue(stack, 1));
}

static struct Value *fn_instr3iss(struct Value *v, struct Auto *stack)
{
  struct String *haystack = stringValue(stack, 1);

  return instr(v, intValue(stack, 0), haystack->length, haystack,
               stringValue(stack, 2));
}

static struct Value *fn_instr3ssi(struct Value *v, struct Auto *stack)
{
  struct String *haystack = stringValue(stack, 0);

  return instr(v, intValue(stack, 2), haystack->length, haystack,
               stringValue(stack, 1));
}

static struct Value *fn_instr3dss(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int start;
  struct String *haystack;

  start = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("start"));
    }

  haystack = stringValue(stack, 1);
  return instr(v, start, haystack->length, haystack, stringValue(stack, 2));
}

static struct Value *fn_instr3ssd(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int start;
  struct String *haystack;

  start = Value_toi(realValue(stack, 2), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("start"));
    }

  haystack = stringValue(stack, 0);
  return instr(v, start, haystack->length, haystack, stringValue(stack, 1));
}

static struct Value *fn_instr4ii(struct Value *v, struct Auto *stack)
{
  return instr(v, intValue(stack, 2), intValue(stack, 3), stringValue(stack, 0),
               stringValue(stack, 1));
}

static struct Value *fn_instr4id(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int len;

  len = Value_toi(realValue(stack, 3), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  return instr(v, intValue(stack, 2), len, stringValue(stack, 0),
               stringValue(stack, 1));
}

static struct Value *fn_instr4di(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int start;

  start = Value_toi(realValue(stack, 2), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("start"));
    }

  return instr(v, start, intValue(stack, 3), stringValue(stack, 0),
               stringValue(stack, 1));
}

static struct Value *fn_instr4dd(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int start, len;

  start = Value_toi(realValue(stack, 2), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("start"));
    }

  len = Value_toi(realValue(stack, 3), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  return instr(v, start, len, stringValue(stack, 0), stringValue(stack, 1));
}

static struct Value *fn_lcase(struct Value *v, struct Auto *stack)
{
  Value_new_STRING(v);
  String_appendString(&v->u.string, stringValue(stack, 0));
  String_lcase(&v->u.string);
  return v;
}

static struct Value *fn_len(struct Value *v, struct Auto *stack)
{
  return Value_new_INTEGER(v, stringValue(stack, 0)->length);
}

static struct Value *fn_left(struct Value *v, struct Auto *stack)
{
  struct String *s = stringValue(stack, 0);
  long int len = intValue(stack, 1);
  int left = ((size_t) len) < s->length ? len : s->length;

  if (left < 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  Value_new_STRING(v);
  String_size(&v->u.string, left);
  if (left)
    {
      memcpy(v->u.string.character, s->character, left);
    }

  return v;
}

static struct Value *fn_loc(struct Value *v, struct Auto *stack)
{
  long int l = FS_loc(intValue(stack, 0));

  if (l == -1)
    {
      return Value_new_ERROR(v, IOERROR, FS_errmsg);
    }

  return Value_new_INTEGER(v, l);
}

static struct Value *fn_lof(struct Value *v, struct Auto *stack)
{
  long int l = FS_lof(intValue(stack, 0));

  if (l == -1)
    {
      return Value_new_ERROR(v, IOERROR, FS_errmsg);
    }

  return Value_new_INTEGER(v, l);
}

static struct Value *fn_log(struct Value *v, struct Auto *stack)
{
  if (realValue(stack, 0) <= 0.0)
    {
      Value_new_ERROR(v, UNDEFINED, _("Logarithm of negative value"));
    }
  else
    {
      Value_new_REAL(v, log(realValue(stack, 0)));
    }

  return v;
}

static struct Value *fn_log10(struct Value *v, struct Auto *stack)
{
  if (realValue(stack, 0) <= 0.0)
    {
      Value_new_ERROR(v, UNDEFINED, _("Logarithm of negative value"));
    }
  else
    {
      Value_new_REAL(v, log10(realValue(stack, 0)));
    }

  return v;
}

static struct Value *fn_log2(struct Value *v, struct Auto *stack)
{
  if (realValue(stack, 0) <= 0.0)
    {
      Value_new_ERROR(v, UNDEFINED, _("Logarithm of negative value"));
    }
  else
    {
      Value_new_REAL(v, log2(realValue(stack, 0)));
    }

  return v;
}

static struct Value *fn_ltrim(struct Value *v, struct Auto *stack)
{
  struct String *s = stringValue(stack, 0);
  int len = s->length;
  int spaces;

  for (spaces = 0; spaces < len && s->character[spaces] == ' '; ++spaces);
  Value_new_STRING(v);
  String_size(&v->u.string, len - spaces);
  if (len - spaces)
    {
      memcpy(v->u.string.character, s->character + spaces, len - spaces);
    }

  return v;
}

static struct Value *fn_match(struct Value *v, struct Auto *stack)
{
  struct String *needle = stringValue(stack, 0);
  const char *needleChars = needle->character;
  const char *needleEnd = needle->character + needle->length;
  struct String *haystack = stringValue(stack, 1);
  const char *haystackChars = haystack->character;
  size_t haystackLength = haystack->length;
  long int start = intValue(stack, 2);
  long int found;
  const char *n, *h;

  if (start < 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("position"));
    }

  if (((size_t) start) >= haystackLength)
    {
      return Value_new_INTEGER(v, 0);
    }

  haystackChars += start;
  haystackLength -= start;
  found = 1 + start;
  while (haystackLength)
    {
      for (n = needleChars, h = haystackChars;
           n < needleEnd && h < (haystackChars + haystackLength); ++n, ++h)
        {
          if (*n == '\\')
            {
              if (++n < needleEnd && *n != *h)
                {
                  break;
                }
            }
          else if (*n == '!')
            {
              if (!isalpha((int)*h))
                {
                  break;
                }
            }
          else if (*n == '#')
            {
              if (!isdigit((int)*h))
                {
                  break;
                }
            }
          else if (*n != '?' && *n != *h)
            {
              break;
            }
        }

      if (n == needleEnd)
        {
          return Value_new_INTEGER(v, found);
        }

      ++haystackChars;
      --haystackLength;
      ++found;
    }

  return Value_new_INTEGER(v, 0);
}

static struct Value *fn_maxii(struct Value *v, struct Auto *stack)
{
  long int x, y;

  x = intValue(stack, 0);
  y = intValue(stack, 1);
  return Value_new_INTEGER(v, x > y ? x : y);
}

static struct Value *fn_maxdi(struct Value *v, struct Auto *stack)
{
  double x;
  long int y;

  x = realValue(stack, 0);
  y = intValue(stack, 1);
  return Value_new_REAL(v, x > y ? x : y);
}

static struct Value *fn_maxid(struct Value *v, struct Auto *stack)
{
  long int x;
  double y;

  x = intValue(stack, 0);
  y = realValue(stack, 1);
  return Value_new_REAL(v, x > y ? x : y);
}

static struct Value *fn_maxdd(struct Value *v, struct Auto *stack)
{
  double x, y;

  x = realValue(stack, 0);
  y = realValue(stack, 1);
  return Value_new_REAL(v, x > y ? x : y);
}

static struct Value *fn_mid2i(struct Value *v, struct Auto *stack)
{
  return mid(v, stringValue(stack, 0), intValue(stack, 1),
             stringValue(stack, 0)->length);
}

static struct Value *fn_mid2d(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int start;

  start = Value_toi(realValue(stack, 1), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("start"));
    }

  return mid(v, stringValue(stack, 0), start, stringValue(stack, 0)->length);
}

static struct Value *fn_mid3ii(struct Value *v, struct Auto *stack)
{
  return mid(v, stringValue(stack, 0), intValue(stack, 1), intValue(stack, 2));
}

static struct Value *fn_mid3id(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int len;

  len = Value_toi(realValue(stack, 2), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  return mid(v, stringValue(stack, 0), intValue(stack, 1), len);
}

static struct Value *fn_mid3di(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int start;

  start = Value_toi(realValue(stack, 1), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("start"));
    }

  return mid(v, stringValue(stack, 0), start, intValue(stack, 2));
}

static struct Value *fn_mid3dd(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int start, len;

  start = Value_toi(realValue(stack, 1), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("start"));
    }

  len = Value_toi(realValue(stack, 2), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  return mid(v, stringValue(stack, 0), start, len);
}

static struct Value *fn_minii(struct Value *v, struct Auto *stack)
{
  long int x, y;

  x = intValue(stack, 0);
  y = intValue(stack, 1);
  return Value_new_INTEGER(v, x < y ? x : y);
}

static struct Value *fn_mindi(struct Value *v, struct Auto *stack)
{
  double x;
  long int y;

  x = realValue(stack, 0);
  y = intValue(stack, 1);
  return Value_new_REAL(v, x < y ? x : y);
}

static struct Value *fn_minid(struct Value *v, struct Auto *stack)
{
  long int x;
  double y;

  x = intValue(stack, 0);
  y = realValue(stack, 1);
  return Value_new_REAL(v, x < y ? x : y);
}

static struct Value *fn_mindd(struct Value *v, struct Auto *stack)
{
  double x, y;

  x = realValue(stack, 0);
  y = realValue(stack, 1);
  return Value_new_REAL(v, x < y ? x : y);
}

static struct Value *fn_mki(struct Value *v, struct Auto *stack)
{
  long int x = intValue(stack, 0);
  size_t i;

  Value_new_STRING(v);
  String_size(&v->u.string, sizeof(long int));
  for (i = 0; i < sizeof(long int); ++i, x >>= 8)
    {
      v->u.string.character[i] = (x & 0xff);
    }

  return v;
}

static struct Value *fn_mks(struct Value *v, struct Auto *stack)
{
  float x = realValue(stack, 0);

  Value_new_STRING(v);
  String_size(&v->u.string, sizeof(float));
  memcpy(v->u.string.character, &x, sizeof(float));
  return v;
}

static struct Value *fn_mkd(struct Value *v, struct Auto *stack)
{
  double x = realValue(stack, 0);

  Value_new_STRING(v);
  String_size(&v->u.string, sizeof(double));
  memcpy(v->u.string.character, &x, sizeof(double));
  return v;
}

static struct Value *fn_oct(struct Value *v, struct Auto *stack)
{
  char buf[sizeof(long int) * 3 + 1];

  sprintf(buf, "%lo", intValue(stack, 0));
  Value_new_STRING(v);
  String_appendChars(&v->u.string, buf);
  return v;
}

static struct Value *fn_pi(struct Value *v, struct Auto *stack)
{
  return Value_new_REAL(v, M_PI);
}

static struct Value *fn_peek(struct Value *v, struct Auto *stack)
{
  int r = FS_memInput(intValue(stack, 0));

  if (r == -1)
    {
      return Value_new_ERROR(v, IOERROR, FS_errmsg);
    }
  else
    {
      return Value_new_INTEGER(v, r);
    }
}

static struct Value *fn_pos(struct Value *v, struct Auto *stack)
{
  return Value_new_INTEGER(v, FS_charpos(STDCHANNEL) + 1);
}

static struct Value *fn_rad(struct Value *v, struct Auto *stack)
{
  return Value_new_REAL(v, (realValue(stack, 0) * M_PI) / 180.0);
}

static struct Value *fn_right(struct Value *v, struct Auto *stack)
{
  struct String *s = stringValue(stack, 0);
  int len = s->length;
  int right = intValue(stack, 1) < len ? intValue(stack, 1) : len;
  if (right < 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  Value_new_STRING(v);
  String_size(&v->u.string, right);
  if (right)
    {
      memcpy(v->u.string.character, s->character + len - right, right);
    }

  return v;
}

static struct Value *fn_rnd(struct Value *v, struct Auto *stack)
{
  return rnd(v, 0);
}

static struct Value *fn_rndi(struct Value *v, struct Auto *stack)
{
  return rnd(v, intValue(stack, 0));
}

static struct Value *fn_rndd(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int limit;

  limit = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("limit"));
    }

  return rnd(v, limit);
}

static struct Value *fn_rtrim(struct Value *v, struct Auto *stack)
{
  struct String *s = stringValue(stack, 0);
  int len = s->length;
  int lastSpace;

  for (lastSpace = len; lastSpace > 0 && s->character[lastSpace - 1] == ' ';
       --lastSpace);

  Value_new_STRING(v);
  String_size(&v->u.string, lastSpace);
  if (lastSpace)
    {
      memcpy(v->u.string.character, s->character, lastSpace);
    }

  return v;
}

static struct Value *fn_sgn(struct Value *v, struct Auto *stack)
{
  double x = realValue(stack, 0);
  return Value_new_INTEGER(v, x < 0.0 ? -1 : (x == 0.0 ? 0 : 1));
}

static struct Value *fn_sin(struct Value *v, struct Auto *stack)
{
  return Value_new_REAL(v, sin(realValue(stack, 0)));
}

static struct Value *fn_space(struct Value *v, struct Auto *stack)
{
  long int len = intValue(stack, 0);

  if (len < 0)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  Value_new_STRING(v);
  String_size(&v->u.string, len);
  if (len)
    {
      memset(v->u.string.character, ' ', len);
    }

  return v;
}

static struct Value *fn_sqr(struct Value *v, struct Auto *stack)
{
  if (realValue(stack, 0) < 0.0)
    {
      Value_new_ERROR(v, OUTOFRANGE, _("Square root argument"));
    }
  else
    {
      Value_new_REAL(v, sqrt(realValue(stack, 0)));
    }

  return v;
}

static struct Value *fn_str(struct Value *v, struct Auto *stack)
{
  struct Value value, *arg;
  struct String s;

  arg = Var_value(Auto_local(stack, 0), 0, (int *)0, &value);
  assert(arg->type != V_ERROR);
  String_new(&s);
  Value_toString(arg, &s, ' ', -1, 0, 0, 0, 0, -1, 0, 0);
  v->type = V_STRING;
  v->u.string = s;
  return v;
}

static struct Value *fn_stringii(struct Value *v, struct Auto *stack)
{
  return string(v, intValue(stack, 0), intValue(stack, 1));
}

static struct Value *fn_stringid(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int chr;

  chr = Value_toi(realValue(stack, 1), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("character code"));
    }

  return string(v, intValue(stack, 0), chr);
}

static struct Value *fn_stringdi(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int len;

  len = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  return string(v, len, intValue(stack, 1));
}

static struct Value *fn_stringdd(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int len, chr;

  len = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  chr = Value_toi(realValue(stack, 1), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("character code"));
    }

  return string(v, len, chr);
}

static struct Value *fn_stringis(struct Value *v, struct Auto *stack)
{
  if (stringValue(stack, 1)->length == 0)
    {
      return Value_new_ERROR(v, UNDEFINED, _("`string$' of empty string"));
    }

  return string(v, intValue(stack, 0), stringValue(stack, 1)->character[0]);
}

static struct Value *fn_stringds(struct Value *v, struct Auto *stack)
{
  int overflow;
  long int len;

  len = Value_toi(realValue(stack, 0), &overflow);
  if (overflow)
    {
      return Value_new_ERROR(v, OUTOFRANGE, _("length"));
    }

  if (stringValue(stack, 1)->length == 0)
    {
      return Value_new_ERROR(v, UNDEFINED, _("`string$' of empty string"));
    }

  return string(v, len, stringValue(stack, 1)->character[0]);
}

static struct Value *fn_strip(struct Value *v, struct Auto *stack)
{
  size_t i;

  Value_new_STRING(v);
  String_appendString(&v->u.string, stringValue(stack, 0));
  for (i = 0; i < v->u.string.length; ++i)
    {
      v->u.string.character[i] &= 0x7f;
    }

  return v;
}

static struct Value *fn_tan(struct Value *v, struct Auto *stack)
{
  return Value_new_REAL(v, tan(realValue(stack, 0)));
}

static struct Value *fn_timei(struct Value *v, struct Auto *stack)
{
  return Value_new_INTEGER(v,
                           (unsigned long)(clock_systimer() /
                                           (CLK_TCK / 100.0)));
}

static struct Value *fn_times(struct Value *v, struct Auto *stack)
{
  time_t t;
  struct tm *now;

  Value_new_STRING(v);
  String_size(&v->u.string, 8);
  time(&t);
  now = localtime(&t);
  sprintf(v->u.string.character, "%02d:%02d:%02d", now->tm_hour, now->tm_min,
          now->tm_sec);
  return v;
}

static struct Value *fn_timer(struct Value *v, struct Auto *stack)
{
  time_t t;
  struct tm *l;

  time(&t);
  l = localtime(&t);
  return Value_new_REAL(v, l->tm_hour * 3600 + l->tm_min * 60 + l->tm_sec);
}

static struct Value *fn_tl(struct Value *v, struct Auto *stack)
{
  struct String *s = stringValue(stack, 0);

  Value_new_STRING(v);
  if (s->length)
    {
      int tail = s->length - 1;

      String_size(&v->u.string, tail);
      if (s->length)
        {
          memcpy(v->u.string.character, s->character + 1, tail);
        }
    }
  return v;
}

static struct Value *fn_true(struct Value *v, struct Auto *stack)
{
  return Value_new_INTEGER(v, -1);
}

static struct Value *fn_ucase(struct Value *v, struct Auto *stack)
{
  Value_new_STRING(v);
  String_appendString(&v->u.string, stringValue(stack, 0));
  String_ucase(&v->u.string);
  return v;
}

static struct Value *fn_val(struct Value *v, struct Auto *stack)
{
  struct String *s = stringValue(stack, 0);
  char *end;
  long int i;
  int overflow;

  if (s->character == (char *)0)
    {
      return Value_new_REAL(v, 0.0);
    }

  i = Value_vali(s->character, &end, &overflow);
  if (*end == '\0')
    {
      return Value_new_INTEGER(v, i);
    }
  else
    {
      return Value_new_REAL(v, Value_vald(s->character, (char **)0, &overflow));
    }
}

static unsigned int hash(const char *s)
{
  unsigned int h = 0;

  while (*s)
    {
      h = h * 256 + tolower(*s);
      ++s;
    }

  return h % GLOBAL_HASHSIZE;
}

static void builtin(struct Global *this, const char *ident, enum ValueType type,
                    struct Value *(*func) (struct Value * value,
                                           struct Auto * stack), int argLength,
                    ...)
{
  struct Symbol **r;
  struct Symbol *s, **sptr;
  int i;
  va_list ap;

  for (r = &this->table[hash(ident)];
       *r != (struct Symbol *)0 && cistrcmp((*r)->name, ident);
       r = &((*r)->next));

  if (*r == (struct Symbol *)0)
    {
      *r = malloc(sizeof(struct Symbol));
      (*r)->name = strcpy(malloc(strlen(ident) + 1), ident);
      (*r)->next = (struct Symbol *)0;
      s = (*r);
    }
  else
    {
      for (sptr = &((*r)->u.sub.u.bltin.next); *sptr;
           sptr = &((*sptr)->u.sub.u.bltin.next));

      *sptr = s = malloc(sizeof(struct Symbol));
    }

  s->u.sub.u.bltin.next = (struct Symbol *)0;
  s->type = BUILTINFUNCTION;
  s->u.sub.argLength = argLength;
  s->u.sub.argTypes =
    argLength ? malloc(sizeof(enum ValueType) *
                       argLength) : (enum ValueType *)0;
  s->u.sub.retType = type;
  va_start(ap, argLength);
  for (i = 0; i < argLength; ++i)
    {
      s->u.sub.argTypes[i] = (enum ValueType)va_arg(ap, int);
    }

  va_end(ap);
  s->u.sub.u.bltin.call = func;
}

/****************************************************************************
 * Public Functions
 ****************************************************************************/

struct Global *Global_new(struct Global *this)
{
  builtin(this, "abs", V_REAL, fn_abs, 1, (int)V_REAL);
  builtin(this, "asc", V_INTEGER, fn_asc, 1, (int)V_STRING);
  builtin(this, "atn", V_REAL, fn_atn, 1, (int)V_REAL);
  builtin(this, "bin$", V_STRING, fn_bini, 1, (int)V_INTEGER);
  builtin(this, "bin$", V_STRING, fn_bind, 1, (int)V_REAL);
  builtin(this, "bin$", V_STRING, fn_binii, 2, (int)V_INTEGER, (int)V_INTEGER);
  builtin(this, "bin$", V_STRING, fn_bindi, 2, (int)V_REAL, (int)V_INTEGER);
  builtin(this, "bin$", V_STRING, fn_binid, 2, (int)V_INTEGER, (int)V_REAL);
  builtin(this, "bin$", V_STRING, fn_bindd, 2, (int)V_REAL, (int)V_REAL);
  builtin(this, "chr$", V_STRING, fn_chr, 1, (int)V_INTEGER);
  builtin(this, "cint", V_REAL, fn_cint, 1, (int)V_REAL);
  builtin(this, "code", V_INTEGER, fn_asc, 1, (int)V_STRING);
  builtin(this, "command$", V_STRING, fn_command, 0);
  builtin(this, "command$", V_STRING, fn_commandi, 1, (int)V_INTEGER);
  builtin(this, "command$", V_STRING, fn_commandd, 1, (int)V_REAL);
  builtin(this, "cos", V_REAL, fn_cos, 1, (int)V_REAL);
  builtin(this, "cvi", V_INTEGER, fn_cvi, 1, (int)V_STRING);
  builtin(this, "cvs", V_REAL, fn_cvs, 1, (int)V_STRING);
  builtin(this, "cvd", V_REAL, fn_cvd, 1, (int)V_STRING);
  builtin(this, "date$", V_STRING, fn_date, 0);
  builtin(this, "dec$", V_STRING, fn_dec, 2, (int)V_REAL, (int)V_STRING);
  builtin(this, "dec$", V_STRING, fn_dec, 2, (int)V_INTEGER, (int)V_STRING);
  builtin(this, "dec$", V_STRING, fn_dec, 2, (int)V_STRING, (int)V_STRING);
  builtin(this, "deg", V_REAL, fn_deg, 1, (int)V_REAL);
  builtin(this, "det", V_REAL, fn_det, 0);
  builtin(this, "edit$", V_STRING, fn_edit, 2, (int)V_STRING, (int)V_INTEGER);
  builtin(this, "environ$", V_STRING, fn_environi, 1, (int)V_INTEGER);
  builtin(this, "environ$", V_STRING, fn_environd, 1, (int)V_REAL);
  builtin(this, "environ$", V_STRING, fn_environs, 1, (int)V_STRING);
  builtin(this, "eof", V_INTEGER, fn_eof, 1, (int)V_INTEGER);
  builtin(this, "erl", V_INTEGER, fn_erl, 0);
  builtin(this, "err", V_INTEGER, fn_err, 0);
  builtin(this, "exp", V_REAL, fn_exp, 1, (int)V_REAL);
  builtin(this, "false", V_INTEGER, fn_false, 0);
  builtin(this, "find$", V_STRING, fn_find, 1, (int)V_STRING);
  builtin(this, "find$", V_STRING, fn_findi, 2, (int)V_STRING, (int)V_INTEGER);
  builtin(this, "find$", V_STRING, fn_findd, 2, (int)V_STRING, (int)V_REAL);
  builtin(this, "fix", V_REAL, fn_fix, 1, (int)V_REAL);
  builtin(this, "frac", V_REAL, fn_frac, 1, (int)V_REAL);
  builtin(this, "freefile", V_INTEGER, fn_freefile, 0);
  builtin(this, "fp", V_REAL, fn_frac, 1, (int)V_REAL);
  builtin(this, "hex$", V_STRING, fn_hexi, 1, (int)V_INTEGER);
  builtin(this, "hex$", V_STRING, fn_hexd, 1, (int)V_REAL);
  builtin(this, "hex$", V_STRING, fn_hexii, 2, (int)V_INTEGER, (int)V_INTEGER);
  builtin(this, "hex$", V_STRING, fn_hexdi, 2, (int)V_REAL, (int)V_INTEGER);
  builtin(this, "hex$", V_STRING, fn_hexid, 2, (int)V_INTEGER, (int)V_REAL);
  builtin(this, "hex$", V_STRING, fn_hexdd, 2, (int)V_REAL, (int)V_REAL);
  builtin(this, "inkey$", V_STRING, fn_inkey, 0);
  builtin(this, "inkey$", V_STRING, fn_inkeyi, 1, (int)V_INTEGER);
  builtin(this, "inkey$", V_STRING, fn_inkeyd, 1, (int)V_REAL);
  builtin(this, "inkey$", V_STRING, fn_inkeyii, 2, (int)V_INTEGER, (int)V_INTEGER);
  builtin(this, "inkey$", V_STRING, fn_inkeyid, 2, (int)V_INTEGER, (int)V_REAL);
  builtin(this, "inkey$", V_STRING, fn_inkeydi, 2, (int)V_REAL, (int)V_INTEGER);
  builtin(this, "inkey$", V_STRING, fn_inkeydd, 2, (int)V_REAL, (int)V_REAL);
  builtin(this, "inp", V_INTEGER, fn_inp, 1, (int)V_INTEGER);
  builtin(this, "input$", V_STRING, fn_input1, 1, (int)V_INTEGER);
  builtin(this, "input$", V_STRING, fn_input2, 2, (int)V_INTEGER, (int)V_INTEGER);
  builtin(this, "instr", V_INTEGER, fn_instr2, 2, (int)V_STRING, (int)V_STRING);
  builtin(this, "instr", V_INTEGER, fn_instr3iss, 3, (int)V_INTEGER, (int)V_STRING,
          V_STRING);
  builtin(this, "instr", V_INTEGER, fn_instr3ssi, 3, (int)V_STRING, (int)V_STRING,
          V_INTEGER);
  builtin(this, "instr", V_INTEGER, fn_instr3dss, 3, (int)V_REAL, (int)V_STRING,
          V_STRING);
  builtin(this, "instr", V_INTEGER, fn_instr3ssd, 3, (int)V_STRING, (int)V_STRING,
          V_REAL);
  builtin(this, "instr", V_INTEGER, fn_instr4ii, 4, (int)V_STRING, (int)V_STRING,
          (int)V_INTEGER, (int)V_INTEGER);
  builtin(this, "instr", V_INTEGER, fn_instr4id, 4, (int)V_STRING, (int)V_STRING,
          (int)V_INTEGER, (int)V_REAL);
  builtin(this, "instr", V_INTEGER, fn_instr4di, 4, (int)V_STRING, (int)V_STRING,
          (int)V_REAL, (int)V_INTEGER);
  builtin(this, "instr", V_INTEGER, fn_instr4dd, 4, (int)V_STRING, (int)V_STRING,
          (int)V_REAL, (int)V_REAL);
  builtin(this, "int", V_REAL, fn_int, 1, (int)V_REAL);
  builtin(this, "int%", V_INTEGER, fn_intp, 1, (int)V_REAL);
  builtin(this, "ip", V_REAL, fn_fix, 1, (int)V_REAL);
  builtin(this, "lcase$", V_STRING, fn_lcase, 1, (int)V_STRING);
  builtin(this, "lower$", V_STRING, fn_lcase, 1, (int)V_STRING);
  builtin(this, "left$", V_STRING, fn_left, 2, (int)V_STRING, (int)V_INTEGER);
  builtin(this, "len", V_INTEGER, fn_len, 1, (int)V_STRING);
  builtin(this, "loc", V_INTEGER, fn_loc, 1, (int)V_INTEGER);
  builtin(this, "lof", V_INTEGER, fn_lof, 1, (int)V_INTEGER);
  builtin(this, "log", V_REAL, fn_log, 1, (int)V_REAL);
  builtin(this, "log10", V_REAL, fn_log10, 1, (int)V_REAL);
  builtin(this, "log2", V_REAL, fn_log2, 1, (int)V_REAL);
  builtin(this, "ltrim$", V_STRING, fn_ltrim, 1, (int)V_STRING);
  builtin(this, "match", V_INTEGER, fn_match, 3, (int)V_STRING, (int)V_STRING,
          (int)V_INTEGER);
  builtin(this, "max", V_INTEGER, fn_maxii, 2, (int)V_INTEGER, (int)V_INTEGER);
  builtin(this, "max", V_REAL, fn_maxdi, 2, (int)V_REAL, (int)V_INTEGER);
  builtin(this, "max", V_REAL, fn_maxid, 2, (int)V_INTEGER, (int)V_REAL);
  builtin(this, "max", V_REAL, fn_maxdd, 2, (int)V_REAL, (int)V_REAL);
  builtin(this, "mid$", V_STRING, fn_mid2i, 2, (int)V_STRING, (int)V_INTEGER);
  builtin(this, "mid$", V_STRING, fn_mid2d, 2, (int)V_STRING, (int)V_REAL);
  builtin(this, "mid$", V_STRING, fn_mid3ii, 3, (int)V_STRING, (int)V_INTEGER,
          V_INTEGER);
  builtin(this, "mid$", V_STRING, fn_mid3id, 3, (int)V_STRING, (int)V_INTEGER, (int)V_REAL);
  builtin(this, "mid$", V_STRING, fn_mid3di, 3, (int)V_STRING, (int)V_REAL, (int)V_INTEGER);
  builtin(this, "mid$", V_STRING, fn_mid3dd, 3, (int)V_STRING, (int)V_REAL, (int)V_REAL);
  builtin(this, "min", V_INTEGER, fn_minii, 2, (int)V_INTEGER, (int)V_INTEGER);
  builtin(this, "min", V_REAL, fn_mindi, 2, (int)V_REAL, (int)V_INTEGER);
  builtin(this, "min", V_REAL, fn_minid, 2, (int)V_INTEGER, (int)V_REAL);
  builtin(this, "min", V_REAL, fn_mindd, 2, (int)V_REAL, (int)V_REAL);
  builtin(this, "mki$", V_STRING, fn_mki, 1, (int)V_INTEGER);
  builtin(this, "mks$", V_STRING, fn_mks, 1, (int)V_REAL);
  builtin(this, "mkd$", V_STRING, fn_mkd, 1, (int)V_REAL);
  builtin(this, "oct$", V_STRING, fn_oct, 1, (int)V_INTEGER);
  builtin(this, "peek", V_INTEGER, fn_peek, 1, (int)V_INTEGER);
  builtin(this, "pi", V_REAL, fn_pi, 0);
  builtin(this, "pos", V_INTEGER, fn_pos, 1, (int)V_INTEGER);
  builtin(this, "pos", V_INTEGER, fn_pos, 1, (int)V_REAL);
  builtin(this, "pos", V_INTEGER, fn_instr3ssi, 3, (int)V_STRING, (int)V_STRING,
          (int)V_INTEGER);
  builtin(this, "pos", V_INTEGER, fn_instr3ssd, 3, (int)V_STRING, (int)V_STRING,
          (int)V_REAL);
  builtin(this, "rad", V_REAL, fn_rad, 1, (int)V_REAL);
  builtin(this, "right$", V_STRING, fn_right, 2, (int)V_STRING, (int)V_INTEGER);
  builtin(this, "rnd", V_INTEGER, fn_rnd, 0);
  builtin(this, "rnd", V_INTEGER, fn_rndd, 1, (int)V_REAL);
  builtin(this, "rnd", V_INTEGER, fn_rndi, 1, (int)V_INTEGER);
  builtin(this, "rtrim$", V_STRING, fn_rtrim, 1, (int)V_STRING);
  builtin(this, "seg$", V_STRING, fn_mid3ii, 3, (int)V_STRING, (int)V_INTEGER,
          (int)V_INTEGER);
  builtin(this, "seg$", V_STRING, fn_mid3id, 3, (int)V_STRING, (int)V_INTEGER,
          (int)V_REAL);
  builtin(this, "seg$", V_STRING, fn_mid3di, 3, (int)V_STRING, (int)V_REAL,
          (int)V_INTEGER);
  builtin(this, "seg$", V_STRING, fn_mid3dd, 3, (int)V_STRING, (int)V_REAL,
          (int)V_REAL);
  builtin(this, "sgn", V_INTEGER, fn_sgn, 1, (int)V_REAL);
  builtin(this, "sin", V_REAL, fn_sin, 1, (int)V_REAL);
  builtin(this, "space$", V_STRING, fn_space, 1, (int)V_INTEGER);
  builtin(this, "sqr", V_REAL, fn_sqr, 1, (int)V_REAL);
  builtin(this, "str$", V_STRING, fn_str, 1, (int)V_REAL);
  builtin(this, "str$", V_STRING, fn_str, 1, (int)V_INTEGER);
  builtin(this, "string$", V_STRING, fn_stringii, 2, (int)V_INTEGER, (int)V_INTEGER);
  builtin(this, "string$", V_STRING, fn_stringid, 2, (int)V_INTEGER, (int)V_REAL);
  builtin(this, "string$", V_STRING, fn_stringdi, 2, (int)V_REAL, (int)V_INTEGER);
  builtin(this, "string$", V_STRING, fn_stringdd, 2, (int)V_REAL, (int)V_REAL);
  builtin(this, "string$", V_STRING, fn_stringis, 2, (int)V_INTEGER, (int)V_STRING);
  builtin(this, "string$", V_STRING, fn_stringds, 2, (int)V_REAL, (int)V_STRING);
  builtin(this, "strip$", V_STRING, fn_strip, 1, (int)V_STRING);
  builtin(this, "tan", V_REAL, fn_tan, 1, (int)V_REAL);
  builtin(this, "time", V_INTEGER, fn_timei, 0);
  builtin(this, "time$", V_STRING, fn_times, 0);
  builtin(this, "timer", V_REAL, fn_timer, 0);
  builtin(this, "tl$", V_STRING, fn_tl, 1, (int)V_STRING);
  builtin(this, "true", V_INTEGER, fn_true, 0);
  builtin(this, "ucase$", V_STRING, fn_ucase, 1, (int)V_STRING);
  builtin(this, "upper$", V_STRING, fn_ucase, 1, (int)V_STRING);
  builtin(this, "val", V_REAL, fn_val, 1, (int)V_STRING);
  return this;
}

int Global_find(struct Global *this, struct Identifier *ident, int oparen)
{
  struct Symbol **r;

  for (r = &this->table[hash(ident->name)];
       *r != (struct Symbol *)0 &&
       ((((*r)->type == GLOBALVAR && oparen) ||
         ((*r)->type == GLOBALARRAY && !oparen)) ||
        cistrcmp((*r)->name, ident->name)); r = &((*r)->next));

  if (*r == (struct Symbol *)0)
    {
      return 0;
    }

  ident->sym = (*r);
  return 1;
}

int Global_variable(struct Global *this, struct Identifier *ident,
                    enum ValueType type, enum SymbolType symbolType,
                    int redeclare)
{
  struct Symbol **r;

  for (r = &this->table[hash(ident->name)];
       *r != (struct Symbol *)0 && ((*r)->type != symbolType ||
                                    cistrcmp((*r)->name, ident->name));
       r = &((*r)->next));

  if (*r == (struct Symbol *)0)
    {
      *r = malloc(sizeof(struct Symbol));
      (*r)->name = strcpy(malloc(strlen(ident->name) + 1), ident->name);
      (*r)->next = (struct Symbol *)0;
      (*r)->type = symbolType;
      Var_new(&((*r)->u.var), type, 0, (unsigned int *)0, 0);
    }
  else if (redeclare)
    {
      Var_retype(&((*r)->u.var), type);
    }

  switch ((*r)->type)
    {
    case GLOBALVAR:
    case GLOBALARRAY:
      {
        ident->sym = (*r);
        break;
      }

    case BUILTINFUNCTION:
      {
        return 0;
      }

    case USERFUNCTION:
      {
        return 0;
      }

    default:
      assert(0);
    }

  return 1;
}

int Global_function(struct Global *this, struct Identifier *ident,
                    enum ValueType type, struct Pc *deffn, struct Pc *begin,
                    int argLength, enum ValueType *argTypes)
{
  struct Symbol **r;

  for (r = &this->table[hash(ident->name)];
       *r != (struct Symbol *)0 && cistrcmp((*r)->name, ident->name);
       r = &((*r)->next));

  if (*r != (struct Symbol *)0)
    {
      return 0;
    }

  *r = malloc(sizeof(struct Symbol));
  (*r)->name = strcpy(malloc(strlen(ident->name) + 1), ident->name);
  (*r)->next = (struct Symbol *)0;
  (*r)->type = USERFUNCTION;
  (*r)->u.sub.u.def.scope.start = *deffn;
  (*r)->u.sub.u.def.scope.begin = *begin;
  (*r)->u.sub.argLength = argLength;
  (*r)->u.sub.argTypes = argTypes;
  (*r)->u.sub.retType = type;
  (*r)->u.sub.u.def.localLength = 0;
  (*r)->u.sub.u.def.localTypes = (enum ValueType *)0;
  ident->sym = (*r);
  return 1;
}

void Global_endfunction(struct Global *this, struct Identifier *ident,
                        struct Pc *end)
{
  struct Symbol **r;

  for (r = &this->table[hash(ident->name)];
       *r != (struct Symbol *)0 && cistrcmp((*r)->name, ident->name);
       r = &((*r)->next));

  assert(*r != (struct Symbol *)0);
  (*r)->u.sub.u.def.scope.end = *end;
}

void Global_clear(struct Global *this)
{
  int i;

  for (i = 0; i < GLOBAL_HASHSIZE; ++i)
    {
      struct Symbol *v;

      for (v = this->table[i]; v; v = v->next)
        {
          if (v->type == GLOBALVAR || v->type == GLOBALARRAY)
            {
              Var_clear(&(v->u.var));
            }
        }
    }
}

void Global_clearFunctions(struct Global *this)
{
  int i;

  for (i = 0; i < GLOBAL_HASHSIZE; ++i)
    {
      struct Symbol **v = &this->table[i], *w;
      struct Symbol *sym;

      while (*v)
        {
          sym = *v;
          w = sym->next;
          if (sym->type == USERFUNCTION)
            {
              if (sym->u.sub.u.def.localTypes)
                {
                  free(sym->u.sub.u.def.localTypes);
                }

              if (sym->u.sub.argTypes)
                {
                  free(sym->u.sub.argTypes);
                }

              free(sym->name);
              free(sym);
              *v = w;
            }
          else
            {
              v = &sym->next;
            }
        }
    }
}

void Global_destroy(struct Global *this)
{
  int i;

  for (i = 0; i < GLOBAL_HASHSIZE; ++i)
    {
      struct Symbol *v = this->table[i], *w;
      struct Symbol *sym;

      while (v)
        {
          sym = v;
          w = v->next;
          switch (sym->type)
            {
            case GLOBALVAR:
            case GLOBALARRAY:
              Var_destroy(&(sym->u.var));
              break;

            case USERFUNCTION:
              {
                if (sym->u.sub.u.def.localTypes)
                  {
                    free(sym->u.sub.u.def.localTypes);
                  }

                if (sym->u.sub.argTypes)
                  {
                    free(sym->u.sub.argTypes);
                  }

                break;
              }

            case BUILTINFUNCTION:
              {
                if (sym->u.sub.argTypes)
                  {
                    free(sym->u.sub.argTypes);
                  }

                if (sym->u.sub.u.bltin.next)
                  {
                    sym = sym->u.sub.u.bltin.next;
                    while (sym)
                      {
                        struct Symbol *n;

                        if (sym->u.sub.argTypes)
                          {
                            free(sym->u.sub.argTypes);
                          }

                        n = sym->u.sub.u.bltin.next;
                        free(sym);
                        sym = n;
                      }
                  }

                break;
              }

            default:
              assert(0);
            }

          free(v->name);
          free(v);
          v = w;
        }

      this->table[i] = (struct Symbol *)0;
    }
}