nuttx-apps/interpreters/bas/statement.c

/****************************************************************************
 * apps/interpreters/bas/var.c
 *
 *   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 <stdlib.h>

#include "statement.h"

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

#define _(String) String

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

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

struct Value *stmt_CALL(struct Value *value)
{
  ++pc.token;
  if (pc.token->type != T_IDENTIFIER)
    {
      return Value_new_ERROR(value, MISSINGPROCIDENT);
    }

  if (pass == DECLARE)
    {
      if (func(value)->type == V_ERROR)
        {
          return value;
        }
      else
        {
          Value_destroy(value);
        }
    }
  else
    {
      if (pass == COMPILE)
        {
          if (Global_find
              (&globals, pc.token->u.identifier,
               (pc.token + 1)->type == T_OP) == 0)
            {
              return Value_new_ERROR(value, UNDECLARED);
            }
        }

      if (pc.token->u.identifier->sym->type != USERFUNCTION &&
          pc.token->u.identifier->sym->type != BUILTINFUNCTION)
        {
          return Value_new_ERROR(value, TYPEMISMATCH1, "variable", "function");
        }

      func(value);
      if (Value_retype(value, V_VOID)->type == V_ERROR)
        {
          return value;
        }

      Value_destroy(value);
    }

  return (struct Value *)0;
}

struct Value *stmt_CASE(struct Value *value)
{
  struct Pc statementpc = pc;

  if (pass == DECLARE || pass == COMPILE)
    {
      struct Pc *selectcase, *nextcasevalue;

      if ((selectcase = findLabel(L_SELECTCASE)) == (struct Pc *)0)
        {
          return Value_new_ERROR(value, STRAYCASE);
        }

      for (nextcasevalue = &selectcase->token->u.selectcase->nextcasevalue;
           nextcasevalue->line != -1;
           nextcasevalue = &nextcasevalue->token->u.casevalue->nextcasevalue);

      *nextcasevalue = pc;
      if (pass == COMPILE)
        {
          pc.token->u.casevalue->endselect =
            selectcase->token->u.selectcase->endselect;
        }

      pc.token->u.casevalue->nextcasevalue.line = -1;
      ++pc.token;
      switch (statementpc.token->type)
        {
        case T_CASEELSE:
          break;

        case T_CASEVALUE:
          {
            struct Pc exprpc;

            do
              {
                if (pc.token->type == T_IS)
                  {
                    ++pc.token;
                    switch (pc.token->type)
                      {
                      case T_LT:
                      case T_LE:
                      case T_EQ:
                      case T_GE:
                      case T_GT:
                      case T_NE:
                        break;

                      default:
                        return Value_new_ERROR(value, MISSINGRELOP);
                      }

                    ++pc.token;
                    exprpc = pc;
                    if (eval(value, "`is'")->type == V_ERROR)
                      {
                        return value;
                      }

                    if (Value_retype
                        (value,
                         selectcase->token->u.selectcase->type)->type ==
                        V_ERROR)
                      {
                        pc = exprpc;
                        return value;
                      }

                    Value_destroy(value);
                  }

                else            /* value or range */
                  {
                    exprpc = pc;
                    if (eval(value, "`case'")->type == V_ERROR)
                      {
                        return value;
                      }

                    if (Value_retype
                        (value,
                         selectcase->token->u.selectcase->type)->type ==
                        V_ERROR)
                      {
                        pc = exprpc;
                        return value;
                      }

                    Value_destroy(value);
                    if (pc.token->type == T_TO)
                      {
                        ++pc.token;
                        exprpc = pc;
                        if (eval(value, "`case'")->type == V_ERROR)
                          {
                            return value;
                          }

                        if (Value_retype
                            (value,
                             selectcase->token->u.selectcase->type)->type ==
                            V_ERROR)
                          {
                            pc = exprpc;
                            return value;
                          }

                        Value_destroy(value);
                      }

                  }

                if (pc.token->type == T_COMMA)
                  {
                    ++pc.token;
                  }
                else
                  {
                    break;
                  }
              }
            while (1);

            break;
          }

        default:
          assert(0);
        }
    }
  else
    {
      pc = pc.token->u.casevalue->endselect;
    }

  return (struct Value *)0;
}

struct Value *stmt_CHDIR_MKDIR(struct Value *value)
{
  int res = -1, err = -1;
  struct Pc dirpc;
  struct Pc statementpc = pc;

  ++pc.token;
  dirpc = pc;
  if (eval(value, _("directory"))->type == V_ERROR ||
      Value_retype(value, V_STRING)->type == V_ERROR)
    {
      return value;
    }

  if (pass == INTERPRET)
    {
      switch (statementpc.token->type)
        {
        case T_CHDIR:
          res = chdir(value->u.string.character);
          break;

        case T_MKDIR:
          res = mkdir(value->u.string.character, 0777);
          break;

        default:
          assert(0);
        }

      err = errno;
    }

  Value_destroy(value);
  if (pass == INTERPRET && res == -1)
    {
      pc = dirpc;
      return Value_new_ERROR(value, IOERROR, strerror(err));
    }

  return (struct Value *)0;
}

struct Value *stmt_CLEAR(struct Value *value)
{
  if (pass == INTERPRET)
    {
      Global_clear(&globals);
      FS_closefiles();
    }

  ++pc.token;
  return (struct Value *)0;
}

struct Value *stmt_CLOSE(struct Value *value)
{
  int hasargs = 0;
  struct Pc chnpc;

  ++pc.token;
  while (1)
    {
      chnpc = pc;
      if (pc.token->type == T_CHANNEL)
        {
          hasargs = 1;
          ++pc.token;
        }

      if (eval(value, (const char *)0) == (struct Value *)0)
        {
          if (hasargs)
            {
              return Value_new_ERROR(value, MISSINGEXPR, _("channel"));
            }
          else
            {
              break;
            }
        }

      hasargs = 1;
      if (value->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      if (pass == INTERPRET && FS_close(value->u.integer) == -1)
        {
          Value_destroy(value);
          pc = chnpc;
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }

      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  if (!hasargs && pass == INTERPRET)
    {
      FS_closefiles();
    }

  return (struct Value *)0;
}

struct Value *stmt_CLS(struct Value *value)
{
  struct Pc statementpc = pc;

  ++pc.token;
  if (pass == INTERPRET && FS_cls(STDCHANNEL) == -1)
    {
      pc = statementpc;
      return Value_new_ERROR(value, IOERROR, FS_errmsg);
    }

  return (struct Value *)0;
}

struct Value *stmt_COLOR(struct Value *value)
{
  int foreground = -1, background = -1;
  struct Pc statementpc = pc;

  ++pc.token;
  if (eval(value, (const char *)0))
    {
      if (value->type == V_ERROR ||
          (pass != DECLARE && Value_retype(value, V_INTEGER)->type == V_ERROR))
        {
          return value;
        }

      foreground = value->u.integer;
      if (foreground < 0 || foreground > 15)
        {
          Value_destroy(value);
          pc = statementpc;
          return Value_new_ERROR(value, OUTOFRANGE, _("foreground colour"));
        }
    }

  Value_destroy(value);
  if (pc.token->type == T_COMMA)
    {
      ++pc.token;
      if (eval(value, (const char *)0))
        {
          if (value->type == V_ERROR ||
              (pass != DECLARE &&
               Value_retype(value, V_INTEGER)->type == V_ERROR))
            {
              return value;
            }

          background = value->u.integer;
          if (background < 0 || background > 15)
            {
              Value_destroy(value);
              pc = statementpc;
              return Value_new_ERROR(value, OUTOFRANGE, _("background colour"));
            }
        }

      Value_destroy(value);
      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
          if (eval(value, (const char *)0))
            {
              int bordercolour = -1;

              if (value->type == V_ERROR ||
                  (pass != DECLARE &&
                   Value_retype(value, V_INTEGER)->type == V_ERROR))
                {
                  return value;
                }

              bordercolour = value->u.integer;
              if (bordercolour < 0 || bordercolour > 15)
                {
                  Value_destroy(value);
                  pc = statementpc;
                  return Value_new_ERROR(value, OUTOFRANGE, _("border colour"));
                }
            }

          Value_destroy(value);
        }
    }

  if (pass == INTERPRET)
    {
      FS_colour(STDCHANNEL, foreground, background);
    }

  return (struct Value *)0;
}

struct Value *stmt_DATA(struct Value *value)
{
  if (DIRECTMODE)
    {
      return Value_new_ERROR(value, NOTINDIRECTMODE);
    }

  if (pass == DECLARE)
    {
      *lastdata = pc;
      (lastdata = &(pc.token->u.nextdata))->line = -1;
    }

  ++pc.token;
  while (1)
    {
      if (pc.token->type != T_STRING && pc.token->type != T_DATAINPUT)
        {
          return Value_new_ERROR(value, MISSINGDATAINPUT);
        }

      ++pc.token;
      if (pc.token->type != T_COMMA)
        {
          break;
        }
      else
        {
          ++pc.token;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_DEFFN_DEFPROC_FUNCTION_SUB(struct Value *value)
{
  if (pass == DECLARE || pass == COMPILE)
    {
      struct Pc statementpc = pc;
      struct Identifier *fn;
      int proc;
      int args = 0;

      if (DIRECTMODE)
        {
          return Value_new_ERROR(value, NOTINDIRECTMODE);
        }

      proc = (pc.token->type == T_DEFPROC || pc.token->type == T_SUB);
      ++pc.token;
      if (pc.token->type != T_IDENTIFIER)
        {
          if (proc)
            {
              return Value_new_ERROR(value, MISSINGPROCIDENT);
            }
          else
            {
              return Value_new_ERROR(value, MISSINGFUNCIDENT);
            }
        }

      fn = pc.token->u.identifier;
      if (proc)
        {
          fn->defaultType = V_VOID;
        }

      ++pc.token;
      if (findLabel(L_FUNC))
        {
          pc = statementpc;
          return Value_new_ERROR(value, NESTEDDEFINITION);
        }

      Auto_variable(&stack, fn);
      if (pc.token->type == T_OP)       /* arguments */
        {
          ++pc.token;
          while (1)
            {
              if (pc.token->type != T_IDENTIFIER)
                {
                  Auto_funcEnd(&stack);
                  return Value_new_ERROR(value, MISSINGFORMIDENT);
                }

              if (Auto_variable(&stack, pc.token->u.identifier) == 0)
                {
                  Auto_funcEnd(&stack);
                  return Value_new_ERROR(value, ALREADYDECLARED);
                }

              ++args;
              ++pc.token;
              if (pc.token->type == T_COMMA)
                {
                  ++pc.token;
                }
              else
                {
                  break;
                }
            }

          if (pc.token->type != T_CP)
            {
              Auto_funcEnd(&stack);
              return Value_new_ERROR(value, MISSINGCP);
            }

          ++pc.token;
        }

      if (pass == DECLARE)
        {
          enum ValueType *t =
            args ? malloc(args * sizeof(enum ValueType)) : (enum ValueType *)0;
          int i;

          for (i = 0; i < args; ++i)
            {
              t[i] = Auto_argType(&stack, i);
            }

          if (Global_function
              (&globals, fn, fn->defaultType, &pc, &statementpc, args, t) == 0)
            {
              free(t);
              Auto_funcEnd(&stack);
              pc = statementpc;
              return Value_new_ERROR(value, REDECLARATION);
            }

          Program_addScope(&program, &fn->sym->u.sub.u.def.scope);
        }

      pushLabel(L_FUNC, &statementpc);
      if (pc.token->type == T_EQ)
        {
          return stmt_EQ_FNRETURN_FNEND(value);
        }
    }
  else
    {
      pc = (pc.token + 1)->u.identifier->sym->u.sub.u.def.scope.end;
    }

  return (struct Value *)0;
}

struct Value *stmt_DEC_INC(struct Value *value)
{
  int step;

  step = (pc.token->type == T_DEC ? -1 : 1);
  ++pc.token;
  while (1)
    {
      struct Value *l, stepValue;
      struct Pc lvaluepc;

      lvaluepc = pc;
      if (pc.token->type != T_IDENTIFIER)
        {
          return Value_new_ERROR(value, MISSINGDECINCIDENT);
        }

      if (pass == DECLARE &&
          Global_variable(&globals, pc.token->u.identifier,
                          pc.token->u.identifier->defaultType,
                          (pc.token + 1)->type ==
                          T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0)
        {
          return Value_new_ERROR(value, REDECLARATION);
        }

      if ((l = lvalue(value))->type == V_ERROR)
        {
          return value;
        }

      if (l->type == V_INTEGER)
        {
          VALUE_NEW_INTEGER(&stepValue, step);
        }
      else if (l->type == V_REAL)
        {
          VALUE_NEW_REAL(&stepValue, (double)step);
        }
      else
        {
          pc = lvaluepc;
          return Value_new_ERROR(value, TYPEMISMATCH5);
        }

      if (pass == INTERPRET)
        {
          Value_add(l, &stepValue, 1);
        }

      Value_destroy(&stepValue);
      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_DEFINT_DEFDBL_DEFSTR(struct Value *value)
{
  enum ValueType dsttype = V_NIL;

  switch (pc.token->type)
    {
    case T_DEFINT:
      dsttype = V_INTEGER;
      break;

    case T_DEFDBL:
      dsttype = V_REAL;
      break;

    case T_DEFSTR:
      dsttype = V_STRING;
      break;

    default:
      assert(0);
    }

  ++pc.token;
  while (1)
    {
      struct Identifier *ident;

      if (pc.token->type != T_IDENTIFIER)
        {
          return Value_new_ERROR(value, MISSINGVARIDENT);
        }

      if (pc.token->u.identifier->defaultType != V_REAL)
        {
          switch (dsttype)
            {
            case V_INTEGER:
              return Value_new_ERROR(value, BADIDENTIFIER, _("integer"));

            case V_REAL:
              return Value_new_ERROR(value, BADIDENTIFIER, _("real"));

            case V_STRING:
              return Value_new_ERROR(value, BADIDENTIFIER, _("string"));

            default:
              assert(0);
            }
        }

      ident = pc.token->u.identifier;
      ++pc.token;
      if (pc.token->type == T_MINUS)
        {
          struct Identifier i;

          if (strlen(ident->name) != 1)
            {
              return Value_new_ERROR(value, BADRANGE);
            }

          ++pc.token;
          if (pc.token->type != T_IDENTIFIER)
            {
              return Value_new_ERROR(value, MISSINGVARIDENT);
            }

          if (strlen(pc.token->u.identifier->name) != 1)
            {
              return Value_new_ERROR(value, BADRANGE);
            }

          for (i.name[0] = tolower(ident->name[0]), i.name[1] = '\0';
               i.name[0] <= tolower(pc.token->u.identifier->name[0]);
               ++i.name[0])
            {
              Global_variable(&globals, &i, dsttype, GLOBALVAR, 1);
            }

          ++pc.token;
        }
      else
        {
          Global_variable(&globals, ident, dsttype, GLOBALVAR, 1);
        }

      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_DELETE(struct Value *value)
{
  struct Pc from, to;
  int f = 0, t = 0;

  if (pass == INTERPRET && !DIRECTMODE)
    {
      return Value_new_ERROR(value, NOTINPROGRAMMODE);
    }

  ++pc.token;
  if (pc.token->type == T_INTEGER)
    {
      if (pass == INTERPRET &&
          Program_goLine(&program, pc.token->u.integer,
                         &from) == (struct Pc *)0)
        {
          return Value_new_ERROR(value, NOSUCHLINE);
        }

      f = 1;
      ++pc.token;
    }

  if (pc.token->type == T_MINUS || pc.token->type == T_COMMA)
    {
      ++pc.token;
      if (pc.token->type == T_INTEGER)
        {
          if (pass == INTERPRET &&
              Program_goLine(&program, pc.token->u.integer,
                             &to) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, NOSUCHLINE);
            }

          t = 1;
          ++pc.token;
        }
    }
  else if (f == 1)
    {
      to = from;
      t = 1;
    }

  if (!f && !t)
    {
      return Value_new_ERROR(value, MISSINGLINENUMBER);
    }

  if (pass == INTERPRET)
    {
      Program_delete(&program, f ? &from : (struct Pc *)0,
                     t ? &to : (struct Pc *)0);
    }

  return (struct Value *)0;
}

struct Value *stmt_DIM(struct Value *value)
{
  ++pc.token;
  while (1)
    {
      unsigned int capacity = 0, *geometry = (unsigned int *)0;
      struct Var *var;
      struct Pc dimpc;
      unsigned int dim;
      enum ValueType vartype;

      if (pc.token->type != T_IDENTIFIER)
        {
          return Value_new_ERROR(value, MISSINGARRIDENT);
        }

      if (pass == DECLARE &&
          Global_variable(&globals, pc.token->u.identifier,
                          pc.token->u.identifier->defaultType, GLOBALARRAY,
                          0) == 0)
        {
          return Value_new_ERROR(value, REDECLARATION);
        }

      var = &pc.token->u.identifier->sym->u.var;
      if (pass == INTERPRET && var->dim)
        {
          return Value_new_ERROR(value, REDIM);
        }

      vartype = var->type;
      ++pc.token;
      if (pc.token->type != T_OP)
        {
          return Value_new_ERROR(value, MISSINGOP);
        }

      ++pc.token;
      dim = 0;
      while (1)
        {
          dimpc = pc;
          if (eval(value, _("dimension"))->type == V_ERROR ||
              (pass != DECLARE &&
               Value_retype(value, V_INTEGER)->type == V_ERROR))
            {
              if (capacity)
                {
                  free(geometry);
                }

              return value;
            }

          if (pass == INTERPRET && value->u.integer < optionbase)       /* error 
                                                                         */
            {
              Value_destroy(value);
              Value_new_ERROR(value, OUTOFRANGE, _("dimension"));
            }

          if (value->type == V_ERROR)   /* abort */
            {
              if (capacity)
                {
                  free(geometry);
                }

              pc = dimpc;
              return value;
            }

          if (pass == INTERPRET)
            {
              if (dim == capacity)      /* enlarge geometry */
                {
                  unsigned int *more;

                  more =
                    realloc(geometry,
                            sizeof(unsigned int) *
                            (capacity ? (capacity *= 2) : (capacity = 3)));
                  geometry = more;
                }

              geometry[dim] = value->u.integer - optionbase + 1;
              ++dim;
            }

          Value_destroy(value);
          if (pc.token->type == T_COMMA)
            {
              ++pc.token;
            }
          else
            {
              break;
            }
        }

      if (pc.token->type != T_CP)       /* abort */
        {
          if (capacity)
            {
              free(geometry);
            }

          return Value_new_ERROR(value, MISSINGCP);
        }

      ++pc.token;
      if (pass == INTERPRET)
        {
          struct Var newarray;

          assert(capacity);
          if (Var_new(&newarray, vartype, dim, geometry, optionbase) ==
              (struct Var *)0)
            {
              free(geometry);
              return Value_new_ERROR(value, OUTOFMEMORY);
            }

          Var_destroy(var);
          *var = newarray;
          free(geometry);
        }

      if (pc.token->type == T_COMMA)
        {
          ++pc.token;           /* advance to next var */
        }
      else
        {
          break;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_DISPLAY(struct Value *value)
{
  struct Pc statementpc = pc;

  ++pc.token;
  if (eval(value, _("file name"))->type == V_ERROR ||
      (pass != DECLARE && Value_retype(value, V_STRING)->type == V_ERROR))
    {
      return value;
    }

  if (pass == INTERPRET && cat(value->u.string.character) == -1)
    {
      const char *msg = strerror(errno);

      Value_destroy(value);
      pc = statementpc;
      return Value_new_ERROR(value, IOERROR, msg);
    }
  else
    {
      Value_destroy(value);
    }

  return (struct Value *)0;
}

struct Value *stmt_DO(struct Value *value)
{
  if (pass == DECLARE || pass == COMPILE)
    {
      pushLabel(L_DO, &pc);
    }

  ++pc.token;
  return (struct Value *)0;
}

struct Value *stmt_DOcondition(struct Value *value)
{
  struct Pc dowhilepc = pc;
  int negate = (pc.token->type == T_DOUNTIL);

  if (pass == DECLARE || pass == COMPILE)
    {
      pushLabel(L_DOcondition, &pc);
    }

  ++pc.token;
  if (eval(value, "condition")->type == V_ERROR)
    {
      return value;
    }

  if (pass == INTERPRET)
    {
      int condition;

      condition = Value_isNull(value);
      if (negate)
        {
          condition = !condition;
        }

      if (condition)
        {
          pc = dowhilepc.token->u.exitdo;
        }

      Value_destroy(value);
    }

  return (struct Value *)0;
}

struct Value *stmt_EDIT(struct Value *value)
{
#ifdef CONFIG_ARCH_HAVE_VFORK
  long int line;
  struct Pc statementpc = pc;
  int status;

  ++pc.token;
  if (pc.token->type == T_INTEGER)
    {
      struct Pc where;

      if (program.numbered)
        {
          if (Program_goLine(&program, pc.token->u.integer, &where) ==
              (struct Pc *)0)
            {
              return Value_new_ERROR(value, NOSUCHLINE);
            }

          line = where.line + 1;
        }
      else
        {
          if (!Program_end(&program, &where))
            {
              return Value_new_ERROR(value, NOPROGRAM);
            }

          line = pc.token->u.integer;
          if (line < 1 || line > (where.line + 1))
            {
              return Value_new_ERROR(value, NOSUCHLINE);
            }
        }
      ++pc.token;
    }
  else
    {
      line = 1;
    }

  if (pass == INTERPRET)
    {
      /* variables */

      char *name;
      int chn;
      struct Program newProgram;
      const char *visual, *basename, *shell;
      struct String cmd;
      static struct
        {
          const char *editor, *flag;
        }
      gotoLine[] =
      {
        {
        "Xemacs", "+%ld "},
        {
        "cemacs", "+%ld "},
        {
        "emacs", "+%ld "},
        {
        "emori", "-l%ld "},
        {
        "fe", "-l%ld "},
        {
        "jed", "+%ld "},
        {
        "jmacs", "+%ld "},
        {
        "joe", "+%ld "},
        {
        "modeori", "-l%ld "},
        {
        "origami", "-l%ld "},
        {
        "vi", "-c%ld "},
        {
        "vim", "+%ld "},
        {
        "xemacs", "+%ld "}
      };
      unsigned int i;
      pid_t pid;

      if (!DIRECTMODE)
        {
          pc = statementpc;
          return Value_new_ERROR(value, NOTINPROGRAMMODE);
        }

      if ((name = tmpnam(NULL)) == (char *)0)
        {
          pc = statementpc;
          return Value_new_ERROR(value, IOERROR,
                                 _("generating temporary file name failed"));
        }

      if ((chn = FS_openout(name)) == -1)
        {
          pc = statementpc;
          return Value_new_ERROR(value, IOERRORCREATE, name, FS_errmsg);
        }

      FS_width(chn, 0);
      if (Program_list(&program, chn, 0, (struct Pc *)0, (struct Pc *)0, value))
        {
          pc = statementpc;
          return value;
        }

      if (FS_close(chn) == -1)
        {
          pc = statementpc;
          unlink(name);
          return Value_new_ERROR(value, IOERRORCLOSE, name, FS_errmsg);
        }

      if ((visual = getenv("VISUAL")) == (char *)0 &&
          (visual = getenv("EDITOR")) == (char *)0)
        {
          visual = "vi";
        }

      basename = strrchr(visual, '/');
      if (basename == (char *)0)
        {
          basename = visual;
        }

      if ((shell = getenv("SHELL")) == (char *)0)
        {
          shell = "/bin/sh";
        }

      String_new(&cmd);
      String_appendChars(&cmd, visual);
      String_appendChar(&cmd, ' ');
      for (i = 0; i < sizeof(gotoLine) / sizeof(gotoLine[0]); ++i)
        {
          if (strcmp(basename, gotoLine[i].editor) == 0)
            {
              String_appendPrintf(&cmd, gotoLine[i].flag, line);
              break;
            }
        }

      String_appendChars(&cmd, name);
      FS_shellmode(STDCHANNEL);
      switch (pid = vfork())
        {
        case -1:
          {
            unlink(name);
            FS_fsmode(STDCHANNEL);
            return Value_new_ERROR(value, FORKFAILED, strerror(errno));
          }

        case 0:
          {
            execl(shell, shell, "-c", cmd.character, (const char *)0);
            exit(127);
          }

        default:
          {
            /* Wait for the editor to complete */

            while (waitpid(pid, &status, 0) < 0 && errno != EINTR);
          }
        }

      FS_fsmode(STDCHANNEL);
      String_destroy(&cmd);
      if ((chn = FS_openin(name)) == -1)
        {
          pc = statementpc;
          return Value_new_ERROR(value, IOERROROPEN, name, FS_errmsg);
        }

      Program_new(&newProgram);
      if (Program_merge(&newProgram, chn, value))
        {
          FS_close(chn);
          unlink(name);
          pc = statementpc;
          return value;
        }

      FS_close(chn);
      Program_setname(&newProgram, program.name.character);
      Program_destroy(&program);
      program = newProgram;
      unlink(name);
    }

  return (struct Value *)0;
#else
  return Value_new_ERROR(value, FORKFAILED, strerror(ENOSYS));
#endif
}

struct Value *stmt_ELSE_ELSEIFELSE(struct Value *value)
{
  if (pass == INTERPRET)
    {
      pc = pc.token->u.endifpc;
    }

  if (pass == DECLARE || pass == COMPILE)
    {
      struct Pc elsepc = pc;
      struct Pc *ifinstr;
      int elseifelse = (pc.token->type == T_ELSEIFELSE);

      if ((ifinstr = popLabel(L_IF)) == (struct Pc *)0)
        {
          return Value_new_ERROR(value, STRAYELSE1);
        }

      if (ifinstr->token->type == T_ELSEIFIF)
        {
          (ifinstr->token - 1)->u.elsepc = pc;
        }

      ++pc.token;
      ifinstr->token->u.elsepc = pc;
      assert(ifinstr->token->type == T_ELSEIFIF ||
             ifinstr->token->type == T_IF);
      if (elseifelse)
        {
          return &more_statements;
        }
      else
        {
          pushLabel(L_ELSE, &elsepc);
        }
    }
  return (struct Value *)0;
}

struct Value *stmt_END(struct Value *value)
{
  if (pass == INTERPRET)
    {
      pc = pc.token->u.endpc;
      bas_end = 1;
    }

  if (pass == DECLARE || pass == COMPILE)
    {
      if (Program_end(&program, &pc.token->u.endpc))
        {
          ++pc.token;
        }
      else
        {
          struct Token *eol;

          for (eol = pc.token; eol->type != T_EOL; ++eol);

          pc.token->u.endpc = pc;
          pc.token->u.endpc.token = eol;
          ++pc.token;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_ENDIF(struct Value *value)
{
  if (pass == DECLARE || pass == COMPILE)
    {
      struct Pc endifpc = pc;
      struct Pc *ifpc;
      struct Pc *elsepc;

      if ((ifpc = popLabel(L_IF)))
        {
          ifpc->token->u.elsepc = endifpc;
          if (ifpc->token->type == T_ELSEIFIF)
            {
              (ifpc->token - 1)->u.elsepc = pc;
            }
        }
      else if ((elsepc = popLabel(L_ELSE)))
        {
          elsepc->token->u.endifpc = endifpc;
        }
      else
        {
          return Value_new_ERROR(value, STRAYENDIF);
        }
    }

  ++pc.token;
  return (struct Value *)0;
}

struct Value *stmt_ENDFN(struct Value *value)
{
  struct Pc *curfn = (struct Pc *)0;
  struct Pc eqpc = pc;

  if (pass == DECLARE || pass == COMPILE)
    {
      if ((curfn = popLabel(L_FUNC)) == (struct Pc *)0)
        {
          return Value_new_ERROR(value, STRAYENDFN);
        }

      if ((eqpc.token->u.type =
           (curfn->token + 1)->u.identifier->defaultType) == V_VOID)
        {
          return Value_new_ERROR(value, STRAYENDFN);
        }
    }

  ++pc.token;
  if (pass == INTERPRET)
    {
      return Value_clone(value,
                         Var_value(Auto_local(&stack, 0), 0, (int *)0,
                                   (struct Value *)0));
    }
  else
    {
      if (pass == DECLARE)
        {
          Global_endfunction(&globals, (curfn->token + 1)->u.identifier, &pc);
        }
      Auto_funcEnd(&stack);
    }

  return (struct Value *)0;
}

struct Value *stmt_ENDPROC_SUBEND(struct Value *value)
{
  struct Pc *curfn = (struct Pc *)0;

  if (pass == DECLARE || pass == COMPILE)
    {
      if ((curfn = popLabel(L_FUNC)) == (struct Pc *)0 ||
          (curfn->token + 1)->u.identifier->defaultType != V_VOID)
        {
          if (curfn != (struct Pc *)0)
            {
              pushLabel(L_FUNC, curfn);
            }

          return Value_new_ERROR(value, STRAYSUBEND, topLabelDescription());
        }
    }

  ++pc.token;
  if (pass == INTERPRET)
    {
      return Value_new_VOID(value);
    }
  else
    {
      if (pass == DECLARE)
        {
          Global_endfunction(&globals, (curfn->token + 1)->u.identifier, &pc);
        }

      Auto_funcEnd(&stack);
    }

  return (struct Value *)0;
}

struct Value *stmt_ENDSELECT(struct Value *value)
{
  struct Pc statementpc = pc;

  ++pc.token;
  if (pass == DECLARE || pass == COMPILE)
    {
      struct Pc *selectcasepc;

      if ((selectcasepc = popLabel(L_SELECTCASE)))
        {
          selectcasepc->token->u.selectcase->endselect = pc;
        }
      else
        {
          pc = statementpc;
          return Value_new_ERROR(value, STRAYENDSELECT);
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_ENVIRON(struct Value *value)
{
  struct Pc epc = pc;

  ++pc.token;
  if (eval(value, _("environment variable"))->type == V_ERROR ||
      Value_retype(value, V_STRING)->type == V_ERROR)
    {
      return value;
    }

  if (pass == INTERPRET && value->u.string.character)
    {
      if (putenv(value->u.string.character) == -1)
        {
          Value_destroy(value);
          pc = epc;
          return Value_new_ERROR(value, ENVIRONFAILED, strerror(errno));
        }
    }

  Value_destroy(value);
  return (struct Value *)0;
}

struct Value *stmt_FNEXIT(struct Value *value)
{
  struct Pc *curfn = (struct Pc *)0;

  if (pass == DECLARE || pass == COMPILE)
    {
      if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0 ||
          (curfn->token + 1)->u.identifier->defaultType == V_VOID)
        {
          return Value_new_ERROR(value, STRAYFNEXIT);
        }
    }

  ++pc.token;
  if (pass == INTERPRET)
    {
      return Value_clone(value,
                         Var_value(Auto_local(&stack, 0), 0, (int *)0,
                                   (struct Value *)0));
    }

  return (struct Value *)0;
}

struct Value *stmt_COLON_EOL(struct Value *value)
{
  return (struct Value *)0;
}

struct Value *stmt_QUOTE_REM(struct Value *value)
{
  ++pc.token;
  return (struct Value *)0;
}

struct Value *stmt_EQ_FNRETURN_FNEND(struct Value *value)
{
  struct Pc *curfn = (struct Pc *)0;
  struct Pc eqpc = pc;
  enum TokenType t = pc.token->type;

  if (pass == DECLARE || pass == COMPILE)
    {
      if (t == T_EQ)
        {
          if ((curfn = popLabel(L_FUNC)) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, STRAYENDEQ);
            }

          if ((eqpc.token->u.type =
               (curfn->token + 1)->u.identifier->defaultType) == V_VOID)
            {
              return Value_new_ERROR(value, STRAYENDEQ);
            }
        }
      else if (t == T_FNEND)
        {
          if ((curfn = popLabel(L_FUNC)) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, STRAYENDFN);
            }

          if ((eqpc.token->u.type =
               (curfn->token + 1)->u.identifier->defaultType) == V_VOID)
            {
              return Value_new_ERROR(value, STRAYENDFN);
            }
        }
      else
        {
          if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, STRAYFNRETURN);
            }

          if ((eqpc.token->u.type =
               (curfn->token + 1)->u.identifier->defaultType) == V_VOID)
            {
              return Value_new_ERROR(value, STRAYFNRETURN);
            }
        }
    }

  ++pc.token;
  if (eval(value, _("return"))->type == V_ERROR ||
      Value_retype(value, eqpc.token->u.type)->type == V_ERROR)
    {
      if (pass != INTERPRET)
        {
          Auto_funcEnd(&stack);
        }

      pc = eqpc;
      return value;
    }

  if (pass == INTERPRET)
    {
      return value;
    }
  else
    {
      Value_destroy(value);
      if (t == T_EQ || t == T_FNEND)
        {
          if (pass == DECLARE)
            {
              Global_endfunction(&globals, (curfn->token + 1)->u.identifier,
                                 &pc);
            }

          Auto_funcEnd(&stack);
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_ERASE(struct Value *value)
{
  ++pc.token;
  while (1)
    {
      if (pc.token->type != T_IDENTIFIER)
        {
          return Value_new_ERROR(value, MISSINGARRIDENT);
        }

      if (pass == DECLARE &&
          Global_variable(&globals, pc.token->u.identifier,
                          pc.token->u.identifier->defaultType, GLOBALARRAY,
                          0) == 0)
        {
          return Value_new_ERROR(value, REDECLARATION);
        }

      if (pass == INTERPRET)
        {
          Var_destroy(&pc.token->u.identifier->sym->u.var);
        }

      ++pc.token;
      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_EXITDO(struct Value *value)
{
  if (pass == INTERPRET)
    {
      pc = pc.token->u.exitdo;
    }
  else
    {
      if (pass == COMPILE)
        {
          struct Pc *exitdo;

          if ((exitdo = findLabel(L_DO)) == (struct Pc *)0 &&
              (exitdo = findLabel(L_DOcondition)) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, STRAYEXITDO);
            }

          pc.token->u.exitdo = exitdo->token->u.exitdo;
        }

      ++pc.token;
    }

  return (struct Value *)0;
}

struct Value *stmt_EXITFOR(struct Value *value)
{
  if (pass == INTERPRET)
    {
      pc = pc.token->u.exitfor;
    }
  else
    {
      if (pass == COMPILE)
        {
          struct Pc *exitfor;

          if ((exitfor = findLabel(L_FOR)) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, STRAYEXITFOR);
            }

          pc.token->u.exitfor = exitfor->token->u.exitfor;
        }

      ++pc.token;
    }

  return (struct Value *)0;
}

struct Value *stmt_FIELD(struct Value *value)
{
  long int chn, offset, recLength = -1;

  ++pc.token;
  if (pc.token->type == T_CHANNEL)
    {
      ++pc.token;
    }

  if (eval(value, _("channel"))->type == V_ERROR ||
      Value_retype(value, V_INTEGER)->type == V_ERROR)
    {
      return value;
    }

  chn = value->u.integer;
  Value_destroy(value);
  if (pass == INTERPRET && (recLength = FS_recLength(chn)) == -1)
    {
      return Value_new_ERROR(value, IOERROR, FS_errmsg);
    }

  if (pc.token->type != T_COMMA)
    {
      return Value_new_ERROR(value, MISSINGCOMMA);
    }

  ++pc.token;
  offset = 0;
  while (1)
    {
      struct Pc curpc;
      struct Value *l;
      long int width;

      curpc = pc;
      if (eval(value, _("field width"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      width = value->u.integer;
      Value_destroy(value);
      if (pass == INTERPRET && offset + width > recLength)
        {
          pc = curpc;
          return Value_new_ERROR(value, OUTOFRANGE, _("field width"));
        }

      if (pc.token->type != T_AS)
        {
          return Value_new_ERROR(value, MISSINGAS);
        }

      ++pc.token;
      curpc = pc;
      if (pc.token->type != T_IDENTIFIER)
        {
          return Value_new_ERROR(value, MISSINGVARIDENT);
        }

      if (pass == DECLARE &&
          Global_variable(&globals, pc.token->u.identifier,
                          pc.token->u.identifier->defaultType,
                          (pc.token + 1)->type ==
                          T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0)
        {
          return Value_new_ERROR(value, REDECLARATION);
        }

      if ((l = lvalue(value))->type == V_ERROR)
        {
          return value;
        }

      if (pass != DECLARE && l->type != V_STRING)
        {
          pc = curpc;
          return Value_new_ERROR(value, TYPEMISMATCH4);
        }

      if (pass == INTERPRET)
        {
          FS_field(chn, &l->u.string, offset, width);
        }

      offset += width;
      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_FOR(struct Value *value)
{
  struct Pc forpc = pc;
  struct Pc varpc;
  struct Pc limitpc;
  struct Value limit, stepValue;

  ++pc.token;
  varpc = pc;
  if (pc.token->type != T_IDENTIFIER)
    {
      return Value_new_ERROR(value, MISSINGLOOPIDENT);
    }

  if (assign(value)->type == V_ERROR)
    {
      return value;
    }

  if (pass == INTERPRET)
    {
      ++pc.token;
      if (eval(&limit, (const char *)0)->type == V_ERROR)
        {
          *value = limit;
          return value;
        }

      Value_retype(&limit, value->type);
      assert(limit.type != V_ERROR);
      if (pc.token->type == T_STEP)     /* STEP x */
        {
          struct Pc stepPc;

          ++pc.token;
          stepPc = pc;
          if (eval(&stepValue, "`step'")->type == V_ERROR)
            {
              Value_destroy(value);
              *value = stepValue;
              pc = stepPc;
              return value;
            }

          Value_retype(&stepValue, value->type);
          assert(stepValue.type != V_ERROR);
        }
      else                      /* implicit numeric STEP */
        {
          if (value->type == V_INTEGER)
            {
              VALUE_NEW_INTEGER(&stepValue, 1);
            }
          else
            {
              VALUE_NEW_REAL(&stepValue, 1.0);
            }
        }

      if (Value_exitFor(value, &limit, &stepValue))
        {
          pc = forpc.token->u.exitfor;
        }

      Value_destroy(&limit);
      Value_destroy(&stepValue);
      Value_destroy(value);
    }
  else
    {
      pushLabel(L_FOR, &forpc);
      pushLabel(L_FOR_VAR, &varpc);
      if (pc.token->type != T_TO)
        {
          Value_destroy(value);
          return Value_new_ERROR(value, MISSINGTO);
        }

      ++pc.token;
      pushLabel(L_FOR_LIMIT, &pc);
      limitpc = pc;
      if (eval(&limit, (const char *)0) == (struct Value *)0)
        {
          Value_destroy(value);
          return Value_new_ERROR(value, MISSINGEXPR, "`to'");
        }

      if (limit.type == V_ERROR)
        {
          Value_destroy(value);
          *value = limit;
          return value;
        }

      if (pass != DECLARE)
        {
          struct Symbol *sym = varpc.token->u.identifier->sym;

          if (VALUE_RETYPE
              (&limit, sym->type == GLOBALVAR ||
               sym->type == GLOBALARRAY ? sym->u.var.type : Auto_varType(&stack,
                                                                         sym))->type
              == V_ERROR)
            {
              Value_destroy(value);
              *value = limit;
              pc = limitpc;
              return value;
            }
        }

      Value_destroy(&limit);
      if (pc.token->type == T_STEP)     /* STEP x */
        {
          struct Pc stepPc;

          ++pc.token;
          stepPc = pc;
          if (eval(&stepValue, "`step'")->type == V_ERROR ||
              (pass != DECLARE &&
               Value_retype(&stepValue, value->type)->type == V_ERROR))
            {
              Value_destroy(value);
              *value = stepValue;
              pc = stepPc;
              return value;
            }
        }
      else                      /* implicit numeric STEP */
        {
          VALUE_NEW_INTEGER(&stepValue, 1);
          if (pass != DECLARE &&
              VALUE_RETYPE(&stepValue, value->type)->type == V_ERROR)
            {
              Value_destroy(value);
              *value = stepValue;
              Value_errorPrefix(value, _("implicit STEP 1:"));
              return value;
            }
        }

      pushLabel(L_FOR_BODY, &pc);
      Value_destroy(&stepValue);
      Value_destroy(value);
    }

  return (struct Value *)0;
}

struct Value *stmt_GET_PUT(struct Value *value)
{
  struct Pc statementpc = pc;
  int put = pc.token->type == T_PUT;
  long int chn;
  struct Pc errpc;

  ++pc.token;
  if (pc.token->type == T_CHANNEL)
    {
      ++pc.token;
    }

  if (eval(value, _("channel"))->type == V_ERROR ||
      Value_retype(value, V_INTEGER)->type == V_ERROR)
    {
      return value;
    }

  chn = value->u.integer;
  Value_destroy(value);
  if (pc.token->type == T_COMMA)
    {
      ++pc.token;
      errpc = pc;
      if (eval(value, (const char *)0)) /* process record number/position */
        {
          int rec;

          if (value->type == V_ERROR ||
              Value_retype(value, V_INTEGER)->type == V_ERROR)
            {
              return value;
            }

          rec = value->u.integer;
          Value_destroy(value);
          if (pass == INTERPRET)
            {
              if (rec < 1)
                {
                  pc = errpc;
                  return Value_new_ERROR(value, OUTOFRANGE, _("record number"));
                }

              if (FS_seek((int)chn, rec - 1) == -1)
                {
                  pc = statementpc;
                  return Value_new_ERROR(value, IOERROR, FS_errmsg);
                }
            }
        }

    }

  if (pc.token->type == T_COMMA)        /* BINARY mode get/put */
    {
      int res = -1;

      ++pc.token;
      if (put)
        {
          if (eval(value, _("`put'/`get' data"))->type == V_ERROR)
            {
              return value;
            }

          if (pass == INTERPRET)
            {
              switch (value->type)
                {
                case V_INTEGER:
                  res = FS_putbinaryInteger(chn, value->u.integer);
                  break;

                case V_REAL:
                  res = FS_putbinaryReal(chn, value->u.real);
                  break;

                case V_STRING:
                  res = FS_putbinaryString(chn, &value->u.string);
                  break;

                default:
                  assert(0);
                }
            }

          Value_destroy(value);
        }
      else
        {
          struct Value *l;

          if (pc.token->type != T_IDENTIFIER)
            {
              return Value_new_ERROR(value, MISSINGPROCIDENT);
            }

          if (pass == DECLARE)
            {
              if (((pc.token + 1)->type == T_OP ||
                   Auto_find(&stack, pc.token->u.identifier) == 0) &&
                  Global_variable(&globals, pc.token->u.identifier,
                                  pc.token->u.identifier->defaultType,
                                  (pc.token + 1)->type ==
                                  T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0)
                {
                  return Value_new_ERROR(value, REDECLARATION);
                }
            }

          if ((l = lvalue(value))->type == V_ERROR)
            {
              return value;
            }

          if (pass == INTERPRET)
            {
              switch (l->type)
                {
                case V_INTEGER:
                  res = FS_getbinaryInteger(chn, &l->u.integer);
                  break;

                case V_REAL:
                  res = FS_getbinaryReal(chn, &l->u.real);
                  break;

                case V_STRING:
                  res = FS_getbinaryString(chn, &l->u.string);
                  break;

                default:
                  assert(0);
                }
            }
        }

      if (pass == INTERPRET && res == -1)
        {
          pc = statementpc;
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }
    }
  else if (pass == INTERPRET && ((put ? FS_put : FS_get) (chn)) == -1)
    {
      pc = statementpc;
      return Value_new_ERROR(value, IOERROR, FS_errmsg);
    }

  return (struct Value *)0;
}

struct Value *stmt_GOSUB(struct Value *value)
{
  if (pass == INTERPRET)
    {
      if (!program.runnable &&
          compileProgram(value, !DIRECTMODE)->type == V_ERROR)
        {
          return value;
        }

      pc.token += 2;
      Auto_pushGosubRet(&stack, &pc);
      pc = (pc.token - 2)->u.gosubpc;
      Program_trace(&program, &pc, 0, 1);
    }

  if (pass == DECLARE || pass == COMPILE)
    {
      struct Token *gosubpc = pc.token;

      ++pc.token;
      if (pc.token->type != T_INTEGER)
        {
          return Value_new_ERROR(value, MISSINGLINENUMBER);
        }

      if (Program_goLine(&program, pc.token->u.integer, &gosubpc->u.gosubpc) ==
          (struct Pc *)0)
        {
          return Value_new_ERROR(value, NOSUCHLINE);
        }

      if (pass == COMPILE &&
          Program_scopeCheck(&program, &gosubpc->u.gosubpc, findLabel(L_FUNC)))
        {
          return Value_new_ERROR(value, OUTOFSCOPE);
        }

      ++pc.token;
    }

  return (struct Value *)0;
}

struct Value *stmt_RESUME_GOTO(struct Value *value)
{
  if (pass == INTERPRET)
    {
      if (!program.runnable &&
          compileProgram(value, !DIRECTMODE)->type == V_ERROR)
        {
          return value;
        }

      if (pc.token->type == T_RESUME)
        {
          if (!stack.resumeable)
            {
              return Value_new_ERROR(value, STRAYRESUME);
            }

          stack.resumeable = 0;
        }

      pc = pc.token->u.gotopc;
      Program_trace(&program, &pc, 0, 1);
    }
  else if (pass == DECLARE || pass == COMPILE)
    {
      struct Token *gotopc = pc.token;

      ++pc.token;
      if (pc.token->type != T_INTEGER)
        {
          return Value_new_ERROR(value, MISSINGLINENUMBER);
        }

      if (Program_goLine(&program, pc.token->u.integer, &gotopc->u.gotopc) ==
          (struct Pc *)0)
        {
          return Value_new_ERROR(value, NOSUCHLINE);
        }

      if (pass == COMPILE &&
          Program_scopeCheck(&program, &gotopc->u.gotopc, findLabel(L_FUNC)))
        {
          return Value_new_ERROR(value, OUTOFSCOPE);
        }

      ++pc.token;
    }

  return (struct Value *)0;
}

struct Value *stmt_KILL(struct Value *value)
{
  struct Pc statementpc = pc;

  ++pc.token;
  if (eval(value, _("file name"))->type == V_ERROR ||
      (pass != DECLARE && Value_retype(value, V_STRING)->type == V_ERROR))
    {
      return value;
    }

  if (pass == INTERPRET && unlink(value->u.string.character) == -1)
    {
      const char *msg = strerror(errno);

      Value_destroy(value);
      pc = statementpc;
      return Value_new_ERROR(value, IOERROR, msg);
    }
  else
    {
      Value_destroy(value);
    }

  return (struct Value *)0;
}

struct Value *stmt_LET(struct Value *value)
{
  ++pc.token;
  if (pc.token->type != T_IDENTIFIER)
    {
      return Value_new_ERROR(value, MISSINGVARIDENT);
    }

  if (assign(value)->type == V_ERROR)
    {
      return value;
    }

  if (pass != INTERPRET)
    {
      Value_destroy(value);
    }

  return (struct Value *)0;
}

struct Value *stmt_LINEINPUT(struct Value *value)
{
  int channel = 0;
  struct Pc lpc;
  struct Value *l;

  ++pc.token;
  if (pc.token->type == T_CHANNEL)
    {
      ++pc.token;
      if (eval(value, _("channel"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      channel = value->u.integer;
      Value_destroy(value);
      if (pc.token->type != T_COMMA)
        {
          return Value_new_ERROR(value, MISSINGCOMMA);
        }
      else
        {
          ++pc.token;
        }
    }

  /* prompt */

  if (pc.token->type == T_STRING)
    {
      if (pass == INTERPRET && channel == 0)
        {
          FS_putString(channel, pc.token->u.string);
        }

      ++pc.token;
      if (pc.token->type != T_SEMICOLON && pc.token->type != T_COMMA)
        {
          return Value_new_ERROR(value, MISSINGSEMICOMMA);
        }

      ++pc.token;
    }

  if (pass == INTERPRET && channel == 0)
    {
      FS_flush(channel);
    }

  if (pc.token->type != T_IDENTIFIER)
    {
      return Value_new_ERROR(value, MISSINGVARIDENT);
    }

  if (pass == DECLARE &&
      Global_variable(&globals, pc.token->u.identifier,
                      pc.token->u.identifier->defaultType,
                      (pc.token + 1)->type == T_OP ? GLOBALARRAY : GLOBALVAR,
                      0) == 0)
    {
      return Value_new_ERROR(value, REDECLARATION);
    }

  lpc = pc;
  if (((l = lvalue(value))->type) == V_ERROR)
    {
      return value;
    }

  if (pass == COMPILE && l->type != V_STRING)
    {
      pc = lpc;
      return Value_new_ERROR(value, TYPEMISMATCH4);
    }

  if (pass == INTERPRET)
    {
      String_size(&l->u.string, 0);
      if (FS_appendToString(channel, &l->u.string, 1) == -1)
        {
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }

      if (l->u.string.length == 0)
        {
          return Value_new_ERROR(value, IOERROR, _("end of file"));
        }

      if (l->u.string.character[l->u.string.length - 1] == '\n')
        {
          String_size(&l->u.string, l->u.string.length - 1);
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_LIST_LLIST(struct Value *value)
{
  struct Pc from, to;
  int f = 0, t = 0, channel;

  channel = (pc.token->type == T_LLIST ? LPCHANNEL : STDCHANNEL);
  ++pc.token;
  if (pc.token->type == T_INTEGER)
    {
      if (pass == INTERPRET &&
          Program_fromLine(&program, pc.token->u.integer,
                           &from) == (struct Pc *)0)
        {
          return Value_new_ERROR(value, NOSUCHLINE);
        }

      f = 1;
      ++pc.token;
    }
  else if (pc.token->type != T_MINUS && pc.token->type != T_COMMA)
    {
      if (eval(value, (const char *)0))
        {
          if (value->type == V_ERROR ||
              (pass != DECLARE &&
               Value_retype(value, V_INTEGER)->type == V_ERROR))
            {
              return value;
            }

          if (pass == INTERPRET &&
              Program_fromLine(&program, value->u.integer,
                               &from) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, NOSUCHLINE);
            }

          f = 1;
          Value_destroy(value);
        }
    }

  if (pc.token->type == T_MINUS || pc.token->type == T_COMMA)
    {
      ++pc.token;
      if (eval(value, (const char *)0))
        {
          if (value->type == V_ERROR ||
              (pass != DECLARE &&
               Value_retype(value, V_INTEGER)->type == V_ERROR))
            {
              return value;
            }

          if (pass == INTERPRET &&
              Program_toLine(&program, value->u.integer, &to) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, NOSUCHLINE);
            }

          t = 1;
          Value_destroy(value);
        }
    }
  else if (f == 1)
    {
      to = from;
      t = 1;
    }

  if (pass == INTERPRET)
    {
      /* Some implementations do not require direct mode */

      if (Program_list
          (&program, channel, channel == STDCHANNEL, f ? &from : (struct Pc *)0,
           t ? &to : (struct Pc *)0, value))
        {
          return value;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_LOAD(struct Value *value)
{
  struct Pc loadpc;

  if (pass == INTERPRET && !DIRECTMODE)
    {
      return Value_new_ERROR(value, NOTINPROGRAMMODE);
    }

  ++pc.token;
  loadpc = pc;
  if (eval(value, _("file name"))->type == V_ERROR ||
      Value_retype(value, V_STRING)->type == V_ERROR)
    {
      pc = loadpc;
      return value;
    }

  if (pass == INTERPRET)
    {
      int dev;

      new();
      Program_setname(&program, value->u.string.character);
      if ((dev = FS_openin(value->u.string.character)) == -1)
        {
          pc = loadpc;
          Value_destroy(value);
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }

      FS_width(dev, 0);
      Value_destroy(value);
      if (Program_merge(&program, dev, value))
        {
          pc = loadpc;
          return value;
        }

      FS_close(dev);
      program.unsaved = 0;
    }
  else
    {
      Value_destroy(value);
    }

  return (struct Value *)0;
}

struct Value *stmt_LOCAL(struct Value *value)
{
  struct Pc *curfn = (struct Pc *)0;

  if (pass == DECLARE || pass == COMPILE)
    {
      if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0)
        return Value_new_ERROR(value, STRAYLOCAL);
    }

  ++pc.token;
  while (1)
    {
      if (pc.token->type != T_IDENTIFIER)
        {
          return Value_new_ERROR(value, MISSINGVARIDENT);
        }

      if (pass == DECLARE || pass == COMPILE)
        {
          struct Symbol *fnsym;

          if (Auto_variable(&stack, pc.token->u.identifier) == 0)
            return Value_new_ERROR(value, ALREADYLOCAL);
          if (pass == DECLARE)
            {
              assert(curfn->token->type == T_DEFFN ||
                     curfn->token->type == T_DEFPROC ||
                     curfn->token->type == T_SUB ||
                     curfn->token->type == T_FUNCTION);
              fnsym = (curfn->token + 1)->u.identifier->sym;
              assert(fnsym);
              fnsym->u.sub.u.def.localTypes =
                realloc(fnsym->u.sub.u.def.localTypes,
                        sizeof(enum ValueType) *
                        (fnsym->u.sub.u.def.localLength + 1));
              fnsym->u.sub.u.def.localTypes[fnsym->u.sub.u.def.localLength] =
                pc.token->u.identifier->defaultType;
              ++fnsym->u.sub.u.def.localLength;
            }
        }

      ++pc.token;
      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_LOCATE(struct Value *value)
{
  long int line, column;
  struct Pc argpc;
  struct Pc statementpc = pc;

  ++pc.token;
  argpc = pc;
  if (eval(value, _("row"))->type == V_ERROR ||
      Value_retype(value, V_INTEGER)->type == V_ERROR)
    {
      return value;
    }

  line = value->u.integer;
  Value_destroy(value);
  if (pass == INTERPRET && line < 1)
    {
      pc = argpc;
      return Value_new_ERROR(value, OUTOFRANGE, _("row"));
    }

  if (pc.token->type == T_COMMA)
    {
      ++pc.token;
    }
  else
    {
      return Value_new_ERROR(value, MISSINGCOMMA);
    }

  argpc = pc;
  if (eval(value, _("column"))->type == V_ERROR ||
      Value_retype(value, V_INTEGER)->type == V_ERROR)
    {
      return value;
    }

  column = value->u.integer;
  Value_destroy(value);
  if (pass == INTERPRET && column < 1)
    {
      pc = argpc;
      return Value_new_ERROR(value, OUTOFRANGE, _("column"));
    }

  if (pass == INTERPRET && FS_locate(STDCHANNEL, line, column) == -1)
    {
      pc = statementpc;
      return Value_new_ERROR(value, IOERROR, FS_errmsg);
    }

  return (struct Value *)0;
}

struct Value *stmt_LOCK_UNLOCK(struct Value *value)
{
  int lock = pc.token->type == T_LOCK;
  int channel;

  ++pc.token;
  if (pc.token->type == T_CHANNEL)
    {
      ++pc.token;
    }

  if (eval(value, _("channel"))->type == V_ERROR ||
      Value_retype(value, V_INTEGER)->type == V_ERROR)
    {
      return value;
    }

  channel = value->u.integer;
  Value_destroy(value);
  if (pass == INTERPRET)
    {
      if (FS_lock(channel, 0, 0, lock ? FS_LOCK_EXCLUSIVE : FS_LOCK_NONE, 1) ==
          -1)
        {
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_LOOP(struct Value *value)
{
  struct Pc looppc = pc;
  struct Pc *dopc;

  ++pc.token;
  if (pass == INTERPRET)
    {
      pc = looppc.token->u.dopc;
    }

  if (pass == DECLARE || pass == COMPILE)
    {
      if ((dopc = popLabel(L_DO)) == (struct Pc *)0 &&
          (dopc = popLabel(L_DOcondition)) == (struct Pc *)0)
        {
          return Value_new_ERROR(value, STRAYLOOP);
        }

      looppc.token->u.dopc = *dopc;
      dopc->token->u.exitdo = pc;
    }

  return (struct Value *)0;
}

struct Value *stmt_LOOPUNTIL(struct Value *value)
{
  struct Pc loopuntilpc = pc;
  struct Pc *dopc;

  ++pc.token;
  if (eval(value, _("condition"))->type == V_ERROR)
    {
      return value;
    }

  if (pass == INTERPRET)
    {
      if (Value_isNull(value))
        pc = loopuntilpc.token->u.dopc;
      Value_destroy(value);
    }

  if (pass == DECLARE || pass == COMPILE)
    {
      if ((dopc = popLabel(L_DO)) == (struct Pc *)0)
        {
          return Value_new_ERROR(value, STRAYLOOPUNTIL);
        }

      loopuntilpc.token->u.until = *dopc;
      dopc->token->u.exitdo = pc;
    }

  return (struct Value *)0;
}

struct Value *stmt_LSET_RSET(struct Value *value)
{
  struct Value *l;
  struct Pc tmppc;
  int lset = (pc.token->type == T_LSET);

  ++pc.token;
  if (pass == DECLARE)
    {
      if (((pc.token + 1)->type == T_OP ||
           Auto_find(&stack, pc.token->u.identifier) == 0) &&
          Global_variable(&globals, pc.token->u.identifier,
                          pc.token->u.identifier->defaultType,
                          (pc.token + 1)->type ==
                          T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0)
        {
          return Value_new_ERROR(value, REDECLARATION);
        }
    }

  tmppc = pc;
  if ((l = lvalue(value))->type == V_ERROR)
    {
      return value;
    }

  if (pass == COMPILE && l->type != V_STRING)
    {
      pc = tmppc;
      return Value_new_ERROR(value, TYPEMISMATCH4);
    }

  if (pc.token->type != T_EQ)
    {
      return Value_new_ERROR(value, MISSINGEQ);
    }

  ++pc.token;
  tmppc = pc;
  if (eval(value, _("rhs"))->type == V_ERROR ||
      (pass != DECLARE && Value_retype(value, l->type)->type == V_ERROR))
    {
      pc = tmppc;
      return value;
    }

  if (pass == INTERPRET)
    {
      (lset ? String_lset : String_rset) (&l->u.string, &value->u.string);
    }

  Value_destroy(value);
  return (struct Value *)0;
}

struct Value *stmt_IDENTIFIER(struct Value *value)
{
  struct Pc here = pc;

  if (pass == DECLARE)
    {
      if (func(value)->type == V_ERROR)
        {
          return value;
        }
      else
        {
          Value_destroy(value);
        }

      if (pc.token->type == T_EQ || pc.token->type == T_COMMA)
        {
          pc = here;
          if (assign(value)->type == V_ERROR)
            {
              return value;
            }

          Value_destroy(value);
        }
    }
  else
    {
      if (pass == COMPILE)
        {
          if (((pc.token + 1)->type == T_OP ||
               Auto_find(&stack, pc.token->u.identifier) == 0) &&
              Global_find(&globals, pc.token->u.identifier,
                          (pc.token + 1)->type == T_OP) == 0)
            {
              return Value_new_ERROR(value, UNDECLARED);
            }
        }

      if (strcasecmp(pc.token->u.identifier->name, "mid$")
          && (pc.token->u.identifier->sym->type == USERFUNCTION ||
              pc.token->u.identifier->sym->type == BUILTINFUNCTION))
        {
          func(value);
          if (Value_retype(value, V_VOID)->type == V_ERROR)
            {
              return value;
            }

          Value_destroy(value);
        }
      else
        {
          if (assign(value)->type == V_ERROR)
            {
              return value;
            }

          if (pass != INTERPRET)
            {
              Value_destroy(value);
            }
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_IF_ELSEIFIF(struct Value *value)
{
  struct Pc ifpc = pc;

  ++pc.token;
  if (eval(value, _("condition"))->type == V_ERROR)
    {
      return value;
    }

  if (pc.token->type != T_THEN)
    {
      Value_destroy(value);
      return Value_new_ERROR(value, MISSINGTHEN);
    }

  ++pc.token;
  if (pass == INTERPRET)
    {
      if (Value_isNull(value))
        {
          pc = ifpc.token->u.elsepc;
        }

      Value_destroy(value);
    }
  else
    {
      Value_destroy(value);
      if (pc.token->type == T_EOL)
        {
          pushLabel(L_IF, &ifpc);
        }
      else                      /* compile single line IF THEN ELSE recursively 
                                 */
        {
          if (statements(value)->type == V_ERROR)
            {
              return value;
            }

          Value_destroy(value);
          if (pc.token->type == T_ELSE)
            {
              struct Pc elsepc = pc;

              ++pc.token;
              ifpc.token->u.elsepc = pc;
              if (ifpc.token->type == T_ELSEIFIF)
                {
                  (ifpc.token - 1)->u.elsepc = pc;
                }

              if (statements(value)->type == V_ERROR)
                {
                  return value;
                }

              Value_destroy(value);
              elsepc.token->u.endifpc = pc;
            }
          else
            {
              ifpc.token->u.elsepc = pc;
              if (ifpc.token->type == T_ELSEIFIF)
                {
                  (ifpc.token - 1)->u.elsepc = pc;
                }
            }
        }

    }

  return (struct Value *)0;
}

struct Value *stmt_IMAGE(struct Value *value)
{
  ++pc.token;
  if (pc.token->type != T_STRING)
    {
      return Value_new_ERROR(value, MISSINGFMT);
    }

  ++pc.token;
  return (struct Value *)0;
}

struct Value *stmt_INPUT(struct Value *value)
{
  int channel = STDCHANNEL;
  int nl = 1;
  int extraprompt = 1;
  struct Token *inputdata = (struct Token *)0, *t = (struct Token *)0;
  struct Pc lvaluepc;

  ++pc.token;
  if (pc.token->type == T_CHANNEL)
    {
      ++pc.token;
      if (eval(value, _("channel"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      channel = value->u.integer;
      Value_destroy(value);
      if (pc.token->type != T_COMMA)
        {
          return Value_new_ERROR(value, MISSINGCOMMA);
        }
      else
        {
          ++pc.token;
        }
    }

  if (pc.token->type == T_SEMICOLON)
    {
      nl = 0;
      ++pc.token;
    }

  /* prompt */

  if (pc.token->type == T_STRING)
    {
      if (pass == INTERPRET && channel == STDCHANNEL)
        {
          FS_putString(STDCHANNEL, pc.token->u.string);
        }

      ++pc.token;
      if (pc.token->type == T_COMMA || pc.token->type == T_COLON)
        {
          ++pc.token;
          extraprompt = 0;
        }
      else if (pc.token->type == T_SEMICOLON)
        {
          ++pc.token;
        }
      else
        {
          extraprompt = 0;
        }
    }

  if (pass == INTERPRET && channel == STDCHANNEL && extraprompt)
    {
      FS_putChars(STDCHANNEL, "? ");
    }

retry:
  if (pass == INTERPRET)        /* read input line and tokenise it */
    {
      struct String s;

      if (channel == STDCHANNEL)
        {
          FS_flush(STDCHANNEL);
        }

      String_new(&s);
      if (FS_appendToString(channel, &s, nl) == -1)
        {
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }

      if (s.length == 0)
        {
          return Value_new_ERROR(value, IOERROR, _("end of file"));
        }

      inputdata = t = Token_newData(s.character);
      String_destroy(&s);
    }

  while (1)
    {
      struct Value *l;

      if (pc.token->type != T_IDENTIFIER)
        {
          return Value_new_ERROR(value, MISSINGVARIDENT);
        }

      if (pass == DECLARE &&
          Global_variable(&globals, pc.token->u.identifier,
                          pc.token->u.identifier->defaultType,
                          (pc.token + 1)->type ==
                          T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0)
        {
          return Value_new_ERROR(value, REDECLARATION);
        }

      lvaluepc = pc;
      if (((l = lvalue(value))->type) == V_ERROR)
        {
          return value;
        }

      if (pass == INTERPRET)
        {
          if (t->type == T_COMMA || t->type == T_EOL)
            {
              enum ValueType ltype = l->type;

              Value_destroy(l);
              Value_new_null(l, ltype);
            }
          else if (convert(value, l, t))
            {
              pc = lvaluepc;
              if (channel == STDCHANNEL)
                {
                  struct String s;

                  String_new(&s);
                  Value_toString(value, &s, ' ', -1, 0, 0, 0, 0, -1, 0, 0);
                  String_appendChars(&s, " ?? ");
                  FS_putString(STDCHANNEL, &s);
                  String_destroy(&s);
                  Value_destroy(value);
                  Token_destroy(inputdata);
                  goto retry;
                }
              else
                {
                  Token_destroy(inputdata);
                  return value;
                }
            }
          else
            {
              ++t;
            }

          if (pc.token->type == T_COMMA)
            {
              if (t->type == T_COMMA)
                {
                  ++t;
                }
              else
                {
                  Token_destroy(inputdata);
                  if (channel == STDCHANNEL)
                    {
                      FS_putChars(STDCHANNEL, "?? ");
                      ++pc.token;
                      goto retry;
                    }
                  else
                    {
                      pc = lvaluepc;
                      return Value_new_ERROR(value, MISSINGINPUTDATA);
                    }
                }
            }
        }

      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  if (pass == INTERPRET)
    {
      if (t->type != T_EOL)
        {
          FS_putChars(STDCHANNEL, _("Too much input data\n"));
        }

      Token_destroy(inputdata);
    }

  return (struct Value *)0;
}

struct Value *stmt_MAT(struct Value *value)
{
  struct Var *var1, *var2, *var3 = (struct Var *)0;
  struct Pc oppc;
  enum TokenType op = T_EOL;

  oppc.line = -1;
  oppc.token = (struct Token *)0;
  ++pc.token;
  if (pc.token->type != T_IDENTIFIER)
    {
      return Value_new_ERROR(value, MISSINGMATIDENT);
    }

  if (pass == DECLARE &&
      Global_variable(&globals, pc.token->u.identifier,
                      pc.token->u.identifier->defaultType, GLOBALARRAY, 0) == 0)
    {
      return Value_new_ERROR(value, REDECLARATION);
    }

  var1 = &pc.token->u.identifier->sym->u.var;
  ++pc.token;
  if (pc.token->type != T_EQ)
    {
      return Value_new_ERROR(value, MISSINGEQ);
    }

  ++pc.token;
  if (pc.token->type == T_IDENTIFIER)   /* a = b [ +|-|* c ] */
    {
      if (pass == COMPILE)
        {
          if (((pc.token + 1)->type == T_OP ||
               Auto_find(&stack, pc.token->u.identifier) == 0) &&
              Global_find(&globals, pc.token->u.identifier, 1) == 0)
            return Value_new_ERROR(value, UNDECLARED);
        }

      var2 = &pc.token->u.identifier->sym->u.var;
      if (pass == INTERPRET &&
          ((var2->dim != 1 && var2->dim != 2) || var2->base < 0 ||
           var2->base > 1))
        {
          return Value_new_ERROR(value, NOMATRIX, var2->dim, var2->base);
        }

      if (pass == COMPILE &&
          Value_commonType[var1->type][var2->type] == V_ERROR)
        {
          return Value_new_typeError(value, var2->type, var1->type);
        }

      ++pc.token;
      if (pc.token->type == T_PLUS || pc.token->type == T_MINUS ||
          pc.token->type == T_MULT)
        {
          oppc = pc;
          op = pc.token->type;
          ++pc.token;
          if (pc.token->type != T_IDENTIFIER)
            {
              return Value_new_ERROR(value, MISSINGARRIDENT);
            }

          if (pass == COMPILE)
            {
              if (((pc.token + 1)->type == T_OP ||
                   Auto_find(&stack, pc.token->u.identifier) == 0) &&
                  Global_find(&globals, pc.token->u.identifier, 1) == 0)
                {
                  return Value_new_ERROR(value, UNDECLARED);
                }
            }

          var3 = &pc.token->u.identifier->sym->u.var;
          if (pass == INTERPRET &&
              ((var3->dim != 1 && var3->dim != 2) || var3->base < 0 ||
               var3->base > 1))
            {
              return Value_new_ERROR(value, NOMATRIX, var3->dim, var3->base);
            }

          ++pc.token;
        }

      if (pass != DECLARE)
        {
          if (var3 == (struct Var *)0)
            {
              if (Var_mat_assign(var1, var2, value, pass == INTERPRET))
                {
                  assert(oppc.line != -1);
                  pc = oppc;
                  return value;
                }
            }
          else if (op == T_MULT)
            {
              if (Var_mat_mult(var1, var2, var3, value, pass == INTERPRET))
                {
                  assert(oppc.line != -1);
                  pc = oppc;
                  return value;
                }
            }
          else if (Var_mat_addsub
                   (var1, var2, var3, op == T_PLUS, value, pass == INTERPRET))
            {
              assert(oppc.line != -1);
              pc = oppc;
              return value;
            }
        }
    }
  else if (pc.token->type == T_OP)
    {
      if (var1->type == V_STRING)
        {
          return Value_new_ERROR(value, TYPEMISMATCH5);
        }

      ++pc.token;
      if (eval(value, _("factor"))->type == V_ERROR)
        {
          return value;
        }

      if (pass == COMPILE &&
          Value_commonType[var1->type][value->type] == V_ERROR)
        {
          return Value_new_typeError(value, var1->type, value->type);
        }

      if (pc.token->type != T_CP)
        {
          Value_destroy(value);
          return Value_new_ERROR(value, MISSINGCP);
        }

      ++pc.token;
      if (pc.token->type != T_MULT)
        {
          Value_destroy(value);
          return Value_new_ERROR(value, MISSINGMULT);
        }

      oppc = pc;
      ++pc.token;
      if (pass == COMPILE)
        {
          if (((pc.token + 1)->type == T_OP ||
               Auto_find(&stack, pc.token->u.identifier) == 0) &&
              Global_find(&globals, pc.token->u.identifier, 1) == 0)
            {
              Value_destroy(value);
              return Value_new_ERROR(value, UNDECLARED);
            }
        }

      var2 = &pc.token->u.identifier->sym->u.var;
      if (pass == INTERPRET &&
          ((var2->dim != 1 && var2->dim != 2) || var2->base < 0 ||
           var2->base > 1))
        {
          Value_destroy(value);
          return Value_new_ERROR(value, NOMATRIX, var2->dim, var2->base);
        }

      if (pass != DECLARE &&
          Var_mat_scalarMult(var1, value, var2, pass == INTERPRET))
        {
          assert(oppc.line != -1);
          pc = oppc;
          return value;
        }

      Value_destroy(value);
      ++pc.token;
    }

  else if (pc.token->type == T_CON || pc.token->type == T_ZER ||
           pc.token->type == T_IDN)
    {
      op = pc.token->type;
      if (pass == COMPILE && Value_commonType[var1->type][V_INTEGER] == V_ERROR)
        {
          return Value_new_typeError(value, V_INTEGER, var1->type);
        }

      ++pc.token;
      if (pc.token->type == T_OP)
        {
          unsigned int dim, geometry[2];
          enum ValueType vartype = var1->type;

          ++pc.token;
          if (evalGeometry(value, &dim, geometry))
            {
              return value;
            }

          if (pass == INTERPRET)
            {
              Var_destroy(var1);
              Var_new(var1, vartype, dim, geometry, optionbase);
            }
        }

      if (pass == INTERPRET)
        {
          unsigned int i;
          int unused = 1 - var1->base;

          if ((var1->dim != 1 && var1->dim != 2) || var1->base < 0 ||
              var1->base > 1)
            {
              return Value_new_ERROR(value, NOMATRIX, var1->dim, var1->base);
            }

          if (var1->dim == 1)
            {
              for (i = unused; i < var1->geometry[0]; ++i)
                {
                  int c = -1;

                  Value_destroy(&(var1->value[i]));
                  switch (op)
                    {
                    case T_CON:
                      c = 1;
                      break;

                    case T_ZER:
                      c = 0;
                      break;

                    case T_IDN:
                      c = (i == unused ? 1 : 0);
                      break;

                    default:
                      assert(0);
                    }

                  if (var1->type == V_INTEGER)
                    {
                      Value_new_INTEGER(&(var1->value[i]), c);
                    }
                  else
                    {
                      Value_new_REAL(&(var1->value[i]), (double)c);
                    }
                }
            }
          else
            {
              int j;

              for (i = unused; i < var1->geometry[0]; ++i)
                {
                  for (j = unused; j < var1->geometry[1]; ++j)
                    {
                      int c = -1;

                      Value_destroy(&(var1->value[i * var1->geometry[1] + j]));
                      switch (op)
                        {
                        case T_CON:
                          c = 1;
                          break;

                        case T_ZER:
                          c = 0;
                          break;

                        case T_IDN:
                          c = (i == j ? 1 : 0);
                          break;

                        default:
                          assert(0);
                        }

                      if (var1->type == V_INTEGER)
                        {
                          Value_new_INTEGER(&
                                            (var1->value
                                             [i * var1->geometry[1] + j]), c);
                        }
                      else
                        {
                          Value_new_REAL(&
                                         (var1->
                                          value[i * var1->geometry[1] + j]),
                                         (double)c);
                        }
                    }
                }
            }
        }
    }

  else if (pc.token->type == T_TRN || pc.token->type == T_INV)
    {
      op = pc.token->type;
      ++pc.token;
      if (pc.token->type != T_OP)
        {
          return Value_new_ERROR(value, MISSINGOP);
        }

      ++pc.token;
      if (pc.token->type != T_IDENTIFIER)
        {
          return Value_new_ERROR(value, MISSINGMATIDENT);
        }

      if (pass == COMPILE)
        {
          if (((pc.token + 1)->type == T_OP ||
               Auto_find(&stack, pc.token->u.identifier) == 0) &&
              Global_find(&globals, pc.token->u.identifier, 1) == 0)
            {
              return Value_new_ERROR(value, UNDECLARED);
            }
        }

      var2 = &pc.token->u.identifier->sym->u.var;
      if (pass == COMPILE &&
          Value_commonType[var1->type][var2->type] == V_ERROR)
        {
          return Value_new_typeError(value, var2->type, var1->type);
        }

      if (pass == INTERPRET)
        {
          if (var2->dim != 2 || var2->base < 0 || var2->base > 1)
            {
              return Value_new_ERROR(value, NOMATRIX, var2->dim, var2->base);
            }

          switch (op)
            {
            case T_TRN:
              Var_mat_transpose(var1, var2);
              break;

            case T_INV:
              if (Var_mat_invert(var1, var2, &stack.lastdet, value))
                {
                  return value;
                }

              break;

            default:
              assert(0);
            }
        }

      ++pc.token;
      if (pc.token->type != T_CP)
        {
          return Value_new_ERROR(value, MISSINGCP);
        }

      ++pc.token;
    }
  else
    {
      return Value_new_ERROR(value, MISSINGEXPR, _("matrix"));
    }

  return (struct Value *)0;
}

struct Value *stmt_MATINPUT(struct Value *value)
{
  int channel = STDCHANNEL;

  ++pc.token;
  if (pc.token->type == T_CHANNEL)
    {
      ++pc.token;
      if (eval(value, _("channel"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      channel = value->u.integer;
      Value_destroy(value);
      if (pc.token->type != T_COMMA)
        {
          return Value_new_ERROR(value, MISSINGCOMMA);
        }
      else
        {
          ++pc.token;
        }
    }

  while (1)
    {
      struct Pc lvaluepc;
      struct Var *var;

      lvaluepc = pc;
      if (pc.token->type != T_IDENTIFIER)
        {
          return Value_new_ERROR(value, MISSINGMATIDENT);
        }

      if (pass == DECLARE &&
          Global_variable(&globals, pc.token->u.identifier,
                          pc.token->u.identifier->defaultType, GLOBALARRAY,
                          0) == 0)
        {
          return Value_new_ERROR(value, REDECLARATION);
        }

      var = &pc.token->u.identifier->sym->u.var;
      ++pc.token;
      if (pc.token->type == T_OP)
        {
          unsigned int dim, geometry[2];
          enum ValueType vartype = var->type;

          ++pc.token;
          if (evalGeometry(value, &dim, geometry))
            {
              return value;
            }

          if (pass == INTERPRET)
            {
              Var_destroy(var);
              Var_new(var, vartype, dim, geometry, optionbase);
            }
        }

      if (pass == INTERPRET)
        {
          unsigned int i, j;
          int unused = 1 - var->base;
          int columns;
          struct Token *inputdata, *t;

          if (var->dim != 1 && var->dim != 2)
            {
              return Value_new_ERROR(value, NOMATRIX, var->dim);
            }

          columns = var->dim == 1 ? 0 : var->geometry[1];
          inputdata = t = (struct Token *)0;
          for (i = unused, j = unused; i < var->geometry[0];)
            {
              struct String s;

              if (!inputdata)
                {
                  if (channel == STDCHANNEL)
                    {
                      FS_putChars(STDCHANNEL, "? ");
                      FS_flush(STDCHANNEL);
                    }

                  String_new(&s);
                  if (FS_appendToString(channel, &s, 1) == -1)
                    {
                      return Value_new_ERROR(value, IOERROR, FS_errmsg);
                    }

                  if (s.length == 0)
                    {
                      return Value_new_ERROR(value, IOERROR, _("end of file"));
                    }

                  inputdata = t = Token_newData(s.character);
                  String_destroy(&s);
                }

              if (t->type == T_COMMA)
                {
                  Value_destroy(&(var->value[j * columns + i]));
                  Value_new_null(&(var->value[j * columns + i]), var->type);
                  ++t;
                }
              else if (t->type == T_EOL)
                {
                  while (i < var->geometry[0])
                    {
                      Value_destroy(&(var->value[j * columns + i]));
                      Value_new_null(&(var->value[j * columns + i]), var->type);
                      ++i;
                    }
                }
              else if (convert(value, &(var->value[j * columns + i]), t))
                {
                  Token_destroy(inputdata);
                  pc = lvaluepc;
                  return value;
                }
              else
                {
                  ++t;
                  ++i;
                  if (t->type == T_COMMA)
                    {
                      ++t;
                    }
                }

              if (i == var->geometry[0] && j < (columns - 1))
                {
                  i = unused;
                  ++j;
                  if (t->type == T_EOL)
                    {
                      Token_destroy(inputdata);
                      inputdata = (struct Token *)0;
                    }
                }
            }
        }

      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_MATPRINT(struct Value *value)
{
  int chn = STDCHANNEL;
  int printusing = 0;
  struct Value usingval;
  struct String *using = (struct String *)0;
  size_t usingpos = 0;
  int notfirst = 0;

  ++pc.token;
  if (chn == STDCHANNEL && pc.token->type == T_CHANNEL)
    {
      ++pc.token;
      if (eval(value, _("channel"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      chn = value->u.integer;
      Value_destroy(value);
      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
    }

  if (pc.token->type == T_USING)
    {
      struct Pc usingpc;

      usingpc = pc;
      printusing = 1;
      ++pc.token;
      if (pc.token->type == T_INTEGER)
        {
          if (pass == COMPILE &&
              Program_imageLine(&program, pc.token->u.integer,
                                &usingpc.token->u.image) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, NOSUCHIMAGELINE);
            }
          else if (pass == INTERPRET)
            {
              using = usingpc.token->u.image.token->u.string;
            }

          Value_new_STRING(&usingval);
          ++pc.token;
        }
      else
        {
          if (eval(&usingval, _("format string"))->type == V_ERROR ||
              Value_retype(&usingval, V_STRING)->type == V_ERROR)
            {
              *value = usingval;
              return value;
            }

          using = &usingval.u.string;
        }

      if (pc.token->type != T_SEMICOLON)
        {
          Value_destroy(&usingval);
          return Value_new_ERROR(value, MISSINGSEMICOLON);
        }

      ++pc.token;
    }
  else
    {
      Value_new_STRING(&usingval);
      using = &usingval.u.string;
    }
  while (1)
    {
      struct Var *var;
      int zoned = 1;

      if (pc.token->type != T_IDENTIFIER)
        {
          if (notfirst)
            {
              break;
            }

          Value_destroy(&usingval);
          return Value_new_ERROR(value, MISSINGMATIDENT);
        }

      if (pass == DECLARE &&
          Global_variable(&globals, pc.token->u.identifier,
                          pc.token->u.identifier->defaultType, GLOBALARRAY,
                          0) == 0)
        {
          Value_destroy(&usingval);
          return Value_new_ERROR(value, REDECLARATION);
        }

      var = &pc.token->u.identifier->sym->u.var;
      ++pc.token;
      if (pc.token->type == T_SEMICOLON)
        {
          zoned = 0;
        }

      if (pass == INTERPRET)
        {
          unsigned int i, j;
          int unused = 1 - var->base;
          int g0, g1;

          if ((var->dim != 1 && var->dim != 2) || var->base < 0 ||
              var->base > 1)
            {
              return Value_new_ERROR(value, NOMATRIX, var->dim, var->base);
            }

          if ((notfirst ? FS_putChar(chn, '\n') : FS_nextline(chn)) == -1)
            {
              Value_destroy(&usingval);
              return Value_new_ERROR(value, IOERROR, FS_errmsg);
            }

          g0 = var->geometry[0];
          g1 = var->dim == 1 ? unused + 1 : var->geometry[1];
          for (i = unused; i < g0; ++i)
            {
              for (j = unused; j < g1; ++j)
                {
                  struct String s;

                  String_new(&s);
                  Value_clone(value,
                              &(var->value[var->dim == 1 ? i : i * g1 + j]));
                  if (Value_toStringUsing(value, &s, using, &usingpos)->type ==
                      V_ERROR)
                    {
                      Value_destroy(&usingval);
                      String_destroy(&s);
                      return value;
                    }

                  Value_destroy(value);
                  if (FS_putString(chn, &s) == -1)
                    {
                      Value_destroy(&usingval);
                      String_destroy(&s);
                      return Value_new_ERROR(value, IOERROR, FS_errmsg);
                    }

                  String_destroy(&s);
                  if (!printusing && zoned)
                    {
                      FS_nextcol(chn);
                    }
                }

              if (FS_putChar(chn, '\n') == -1)
                {
                  return Value_new_ERROR(value, IOERROR, FS_errmsg);
                }
            }
        }

      if (pc.token->type == T_COMMA || pc.token->type == T_SEMICOLON)
        {
          ++pc.token;
        }
      else
        {
          break;
        }

      notfirst = 1;
    }

  Value_destroy(&usingval);
  if (pass == INTERPRET)
    {
      if (FS_flush(chn) == -1)
        {
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_MATREAD(struct Value *value)
{
  ++pc.token;
  while (1)
    {
      struct Pc lvaluepc;
      struct Var *var;

      lvaluepc = pc;
      if (pc.token->type != T_IDENTIFIER)
        {
          return Value_new_ERROR(value, MISSINGMATIDENT);
        }

      if (pass == DECLARE &&
          Global_variable(&globals, pc.token->u.identifier,
                          pc.token->u.identifier->defaultType, GLOBALARRAY,
                          0) == 0)
        {
          return Value_new_ERROR(value, REDECLARATION);
        }

      var = &pc.token->u.identifier->sym->u.var;
      ++pc.token;
      if (pc.token->type == T_OP)
        {
          unsigned int dim, geometry[2];
          enum ValueType vartype = var->type;

          ++pc.token;
          if (evalGeometry(value, &dim, geometry))
            {
              return value;
            }

          if (pass == INTERPRET)
            {
              Var_destroy(var);
              Var_new(var, vartype, dim, geometry, optionbase);
            }
        }

      if (pass == INTERPRET)
        {
          unsigned int i;
          int unused = 1 - var->base;

          if ((var->dim != 1 && var->dim != 2) || var->base < 0 ||
              var->base > 1)
            {
              return Value_new_ERROR(value, NOMATRIX, var->dim, var->base);
            }

          if (var->dim == 1)
            {
              for (i = unused; i < var->geometry[0]; ++i)
                {
                  if (dataread(value, &(var->value[i])))
                    {
                      pc = lvaluepc;
                      return value;
                    }
                }
            }
          else
            {
              int j;

              for (i = unused; i < var->geometry[0]; ++i)
                {
                  for (j = unused; j < var->geometry[1]; ++j)
                    {
                      if (dataread
                          (value, &(var->value[i * var->geometry[1] + j])))
                        {
                          pc = lvaluepc;
                          return value;
                        }
                    }
                }
            }
        }

      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_MATREDIM(struct Value *value)
{
  ++pc.token;
  while (1)
    {
      struct Var *var;
      unsigned int dim, geometry[2];

      if (pc.token->type != T_IDENTIFIER)
        {
          return Value_new_ERROR(value, MISSINGMATIDENT);
        }

      if (pass == DECLARE &&
          Global_variable(&globals, pc.token->u.identifier,
                          pc.token->u.identifier->defaultType, GLOBALARRAY,
                          0) == 0)
        {
          return Value_new_ERROR(value, REDECLARATION);
        }

      var = &pc.token->u.identifier->sym->u.var;
      ++pc.token;
      if (pc.token->type != T_OP)
        {
          return Value_new_ERROR(value, MISSINGOP);
        }

      ++pc.token;
      if (evalGeometry(value, &dim, geometry))
        {
          return value;
        }

      if (pass == INTERPRET &&
          Var_mat_redim(var, dim, geometry, value) != (struct Value *)0)
        {
          return value;
        }

      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_MATWRITE(struct Value *value)
{
  int chn = STDCHANNEL;
  int notfirst = 0;
  int comma = 0;

  ++pc.token;
  if (pc.token->type == T_CHANNEL)
    {
      ++pc.token;
      if (eval(value, _("channel"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      chn = value->u.integer;
      Value_destroy(value);
      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
    }

  while (1)
    {
      struct Var *var;

      if (pc.token->type != T_IDENTIFIER)
        {
          if (notfirst)
            {
              break;
            }

          return Value_new_ERROR(value, MISSINGMATIDENT);
        }

      notfirst = 1;
      if (pass == DECLARE &&
          Global_variable(&globals, pc.token->u.identifier,
                          pc.token->u.identifier->defaultType, GLOBALARRAY,
                          0) == 0)
        {
          return Value_new_ERROR(value, REDECLARATION);
        }

      var = &pc.token->u.identifier->sym->u.var;
      ++pc.token;
      if (pass == INTERPRET)
        {
          unsigned int i, j;
          int unused = 1 - var->base;
          int g0, g1;

          if ((var->dim != 1 && var->dim != 2) || var->base < 0 ||
              var->base > 1)
            {
              return Value_new_ERROR(value, NOMATRIX, var->dim, var->base);
            }

          g0 = var->geometry[0];
          g1 = var->dim == 1 ? unused + 1 : var->geometry[1];
          for (i = unused; i < g0; ++i)
            {
              comma = 0;
              for (j = unused; j < g1; ++j)
                {
                  struct String s;

                  String_new(&s);
                  Value_clone(value,
                              &(var->value[var->dim == 1 ? i : i * g1 + j]));
                  if (comma)
                    {
                      String_appendChar(&s, ',');
                    }

                  if (FS_putString(chn, Value_toWrite(value, &s)) == -1)
                    {
                      Value_destroy(value);
                      return Value_new_ERROR(value, IOERROR, FS_errmsg);
                    }

                  if (FS_flush(chn) == -1)
                    {
                      return Value_new_ERROR(value, IOERROR, FS_errmsg);
                    }

                  String_destroy(&s);
                  comma = 1;
                }

              FS_putChar(chn, '\n');
            }
        }

      if (pc.token->type == T_COMMA || pc.token->type == T_SEMICOLON)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  if (pass == INTERPRET)
    {
      if (FS_flush(chn) == -1)
        {
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_NAME(struct Value *value)
{
  struct Pc namepc = pc;
  struct Value old;
  int res = -1, reserrno = -1;

  ++pc.token;
  if (eval(value, _("file name"))->type == V_ERROR ||
      Value_retype(value, V_STRING)->type == V_ERROR)
    {
      return value;
    }

  if (pc.token->type != T_AS)
    {
      Value_destroy(value);
      return Value_new_ERROR(value, MISSINGAS);
    }

  old = *value;
  ++pc.token;
  if (eval(value, _("file name"))->type == V_ERROR ||
      Value_retype(value, V_STRING)->type == V_ERROR)
    {
      Value_destroy(&old);
      return value;
    }

  if (pass == INTERPRET)
    {
      res = rename(old.u.string.character, value->u.string.character);
      reserrno = errno;
    }

  Value_destroy(&old);
  Value_destroy(value);
  if (pass == INTERPRET && res == -1)
    {
      pc = namepc;
      return Value_new_ERROR(value, IOERROR, strerror(reserrno));
    }

  return (struct Value *)0;
}

struct Value *stmt_NEW(struct Value *value)
{
  if (pass == INTERPRET)
    {
      if (!DIRECTMODE)
        {
          return Value_new_ERROR(value, NOTINPROGRAMMODE);
        }

      new();
    }

  ++pc.token;
  return (struct Value *)0;
}

struct Value *stmt_NEXT(struct Value *value)
{
  struct Next **next = &pc.token->u.next;
  int level = 0;

  if (pass == INTERPRET)
    {
      struct Value *l, inc;
      struct Pc savepc;

      ++pc.token;
      while (1)
        {
          /* get variable lvalue */

          savepc = pc;
          pc = (*next)[level].var;
          if ((l = lvalue(value))->type == V_ERROR)
            {
              return value;
            }

          pc = savepc;

          /* get limit value and increment */

          savepc = pc;
          pc = (*next)[level].limit;
          if (eval(value, _("limit"))->type == V_ERROR)
            {
              return value;
            }

          Value_retype(value, l->type);
          assert(value->type != V_ERROR);
          if (pc.token->type == T_STEP)
            {
              ++pc.token;
              if (eval(&inc, _("step"))->type == V_ERROR)
                {
                  Value_destroy(value);
                  *value = inc;
                  return value;
                }
            }
          else
            {
              VALUE_NEW_INTEGER(&inc, 1);
            }

          VALUE_RETYPE(&inc, l->type);
          assert(inc.type != V_ERROR);
          pc = savepc;

          Value_add(l, &inc, 1);
          if (Value_exitFor(l, value, &inc))
            {
              Value_destroy(value);
              Value_destroy(&inc);
              if (pc.token->type == T_IDENTIFIER)
                {
                  if (lvalue(value)->type == V_ERROR)
                    {
                      return value;
                    }

                  if (pc.token->type == T_COMMA)
                    {
                      ++pc.token;
                      ++level;
                    }
                  else
                    {
                      break;
                    }
                }
              else
                {
                  break;
                }
            }
          else
            {
              pc = (*next)[level].body;
              Value_destroy(value);
              Value_destroy(&inc);
              break;
            }
        }
    }
  else
    {
      struct Pc *body;

      ++pc.token;
      while (1)
        {
          if ((body = popLabel(L_FOR_BODY)) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, STRAYNEXT, topLabelDescription());
            }

          if (level)
            {
              struct Next *more;

              more = realloc(*next, sizeof(struct Next) * (level + 1));
              *next = more;
            }

          (*next)[level].body = *body;
          (*next)[level].limit = *popLabel(L_FOR_LIMIT);
          (*next)[level].var = *popLabel(L_FOR_VAR);
          (*next)[level].fr = *popLabel(L_FOR);
          if (pc.token->type == T_IDENTIFIER)
            {
              if (cistrcmp
                  (pc.token->u.identifier->name,
                   (*next)[level].var.token->u.identifier->name))
                {
                  return Value_new_ERROR(value, FORMISMATCH);
                }

              if (pass == DECLARE &&
                  Global_variable(&globals, pc.token->u.identifier,
                                  pc.token->u.identifier->defaultType,
                                  (pc.token + 1)->type ==
                                  T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0)
                {
                  return Value_new_ERROR(value, REDECLARATION);
                }

              if (lvalue(value)->type == V_ERROR)
                {
                  return value;
                }

              if (pc.token->type == T_COMMA)
                {
                  ++pc.token;
                  ++level;
                }
              else
                {
                  break;
                }
            }
          else
            {
              break;
            }
        }

      while (level >= 0)
        {
          (*next)[level--].fr.token->u.exitfor = pc;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_ON(struct Value *value)
{
  struct On *on = &pc.token->u.on;

  ++pc.token;
  if (eval(value, _("selector"))->type == V_ERROR)
    {
      return value;
    }

  if (Value_retype(value, V_INTEGER)->type == V_ERROR)
    {
      return value;
    }

  if (pass == INTERPRET)
    {
      struct Pc newpc;

      if (value->u.integer > 0 && value->u.integer < on->pcLength)
        {
          newpc = on->pc[value->u.integer];
        }
      else
        {
          newpc = on->pc[0];
        }

      if (pc.token->type == T_GOTO)
        {
          pc = newpc;
        }
      else
        {
          pc = on->pc[0];
          Auto_pushGosubRet(&stack, &pc);
          pc = newpc;
        }

      Program_trace(&program, &pc, 0, 1);
    }
  else if (pass == DECLARE || pass == COMPILE)
    {
      Value_destroy(value);
      if (pc.token->type != T_GOTO && pc.token->type != T_GOSUB)
        {
          return Value_new_ERROR(value, MISSINGGOTOSUB);
        }

      ++pc.token;
      on->pcLength = 1;
      while (1)
        {
          on->pc = realloc(on->pc, sizeof(struct Pc) * ++on->pcLength);
          if (pc.token->type != T_INTEGER)
            {
              return Value_new_ERROR(value, MISSINGLINENUMBER);
            }

          if (Program_goLine
              (&program, pc.token->u.integer,
               &on->pc[on->pcLength - 1]) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, NOSUCHLINE);
            }

          if (pass == COMPILE &&
              Program_scopeCheck(&program, &on->pc[on->pcLength - 1],
                                 findLabel(L_FUNC)))
            {
              return Value_new_ERROR(value, OUTOFSCOPE);
            }

          ++pc.token;
          if (pc.token->type == T_COMMA)
            {
              ++pc.token;
            }
          else
            {
              break;
            }
        }

      on->pc[0] = pc;
    }

  return (struct Value *)0;
}

struct Value *stmt_ONERROR(struct Value *value)
{
  if (DIRECTMODE)
    {
      return Value_new_ERROR(value, NOTINDIRECTMODE);
    }

  ++pc.token;
  if (pass == INTERPRET)
    {
      stack.onerror = pc;
      Program_nextLine(&program, &pc);
      return (struct Value *)0;
    }
  else
    {
      return &more_statements;
    }
}

struct Value *stmt_ONERRORGOTO0(struct Value *value)
{
  if (DIRECTMODE)
    {
      return Value_new_ERROR(value, NOTINDIRECTMODE);
    }

  if (pass == INTERPRET)
    {
      stack.onerror.line = -1;
      if (stack.resumeable)
        {
          pc = stack.erpc;
          return Value_clone(value, &stack.err);
        }
    }

  ++pc.token;
  return (struct Value *)0;
}

struct Value *stmt_ONERROROFF(struct Value *value)
{
  if (DIRECTMODE)
    {
      return Value_new_ERROR(value, NOTINDIRECTMODE);
    }

  if (pass == INTERPRET)
    {
      stack.onerror.line = -1;
    }

  ++pc.token;
  return (struct Value *)0;
}

struct Value *stmt_OPEN(struct Value *value)
{
  int inout = -1, append = 0;
  int mode = FS_ACCESS_NONE, lock = FS_LOCK_NONE;
  long int channel;
  long int recLength = -1;
  struct Pc errpc;
  struct Value recLengthValue;
  struct Pc statementpc = pc;

  ++pc.token;
  errpc = pc;
  if (eval(value, _("mode or file"))->type == V_ERROR ||
      Value_retype(value, V_STRING)->type == V_ERROR)
    {
      return value;
    }

  if (pc.token->type == T_COMMA)        /* parse MBASIC syntax */
    {
      if (value->u.string.length >= 1)
        {
          switch (tolower(value->u.string.character[0]))
            {
            case 'i':
              inout = 0;
              mode = FS_ACCESS_READ;
              break;

            case 'o':
              inout = 1;
              mode = FS_ACCESS_WRITE;
              break;

            case 'a':
              inout = 1;
              mode = FS_ACCESS_WRITE;
              append = 1;
              break;

            case 'r':
              inout = 3;
              mode = FS_ACCESS_READWRITE;
              break;
            }
        }

      Value_destroy(value);
      if (pass == INTERPRET && inout == -1)
        {
          pc = errpc;
          return Value_new_ERROR(value, BADMODE);
        }

      if (pc.token->type != T_COMMA)
        {
          return Value_new_ERROR(value, MISSINGCOMMA);
        }

      ++pc.token;
      if (pc.token->type == T_CHANNEL)
        {
          ++pc.token;
        }

      errpc = pc;
      if (eval(value, _("channel"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          pc = errpc;
          return value;
        }

      channel = value->u.integer;
      Value_destroy(value);
      if (pass == INTERPRET && channel < 0)
        {
          return Value_new_ERROR(value, OUTOFRANGE, _("channel"));
        }

      if (pc.token->type != T_COMMA)
        {
          return Value_new_ERROR(value, MISSINGCOMMA);
        }

      ++pc.token;
      if (eval(value, _("file name"))->type == V_ERROR ||
          Value_retype(value, V_STRING)->type == V_ERROR)
        {
          return value;
        }

      if (inout == 3)
        {
          if (pc.token->type != T_COMMA)
            {
              Value_destroy(value);
              return Value_new_ERROR(value, MISSINGCOMMA);
            }

          ++pc.token;
          errpc = pc;
          if (eval(&recLengthValue, _("record length"))->type == V_ERROR ||
              Value_retype(&recLengthValue, V_INTEGER)->type == V_ERROR)
            {
              Value_destroy(value);
              *value = recLengthValue;
              return value;
            }

          recLength = recLengthValue.u.integer;
          Value_destroy(&recLengthValue);
          if (pass == INTERPRET && recLength <= 0)
            {
              Value_destroy(value);
              pc = errpc;
              return Value_new_ERROR(value, OUTOFRANGE, _("record length"));
            }
        }
    }
  else                          /* parse ANSI syntax */
    {
      struct Value channelValue;
      int newMode;

      switch (pc.token->type)
        {
        case T_FOR_INPUT:
          inout = 0;
          mode = FS_ACCESS_READ;
          ++pc.token;
          break;

        case T_FOR_OUTPUT:
          inout = 1;
          mode = FS_ACCESS_WRITE;
          ++pc.token;
          break;

        case T_FOR_APPEND:
          inout = 1;
          mode = FS_ACCESS_WRITE;
          append = 1;
          ++pc.token;
          break;

        case T_FOR_RANDOM:
          inout = 3;
          mode = FS_ACCESS_READWRITE;
          ++pc.token;
          break;

        case T_FOR_BINARY:
          inout = 4;
          mode = FS_ACCESS_READWRITE;
          ++pc.token;
          break;

        default:
          inout = 3;
          mode = FS_ACCESS_READWRITE;
          break;
        }

      switch (pc.token->type)
        {
        case T_ACCESS_READ:
          newMode = FS_ACCESS_READ;
          break;

        case T_ACCESS_READ_WRITE:
          newMode = FS_ACCESS_READWRITE;
          break;

        case T_ACCESS_WRITE:
          newMode = FS_ACCESS_WRITE;
          break;

        default:
          newMode = FS_ACCESS_NONE;
        }

      if (newMode != FS_ACCESS_NONE)
        {
          if ((newMode & mode) == 0)
            {
              return Value_new_ERROR(value, WRONGMODE);
            }

          mode = newMode;
          ++pc.token;
        }

      switch (pc.token->type)
        {
        case T_SHARED:
          lock = FS_LOCK_NONE;
          ++pc.token;
          break;

        case T_LOCK_READ:
          lock = FS_LOCK_SHARED;
          ++pc.token;
          break;

        case T_LOCK_WRITE:
          lock = FS_LOCK_EXCLUSIVE;
          ++pc.token;
          break;

        default:;
        }

      if (pc.token->type != T_AS)
        {
          Value_destroy(value);
          return Value_new_ERROR(value, MISSINGAS);
        }

      ++pc.token;
      if (pc.token->type == T_CHANNEL)
        {
          ++pc.token;
        }

      errpc = pc;
      if (eval(&channelValue, _("channel"))->type == V_ERROR ||
          Value_retype(&channelValue, V_INTEGER)->type == V_ERROR)
        {
          pc = errpc;
          Value_destroy(value);
          *value = channelValue;
          return value;
        }

      channel = channelValue.u.integer;
      Value_destroy(&channelValue);
      if (inout == 3)
        {
          if (pc.token->type == T_IDENTIFIER)
            {
              if (cistrcmp(pc.token->u.identifier->name, "len"))
                {
                  Value_destroy(value);
                  return Value_new_ERROR(value, MISSINGLEN);
                }

              ++pc.token;
              if (pc.token->type != T_EQ)
                {
                  Value_destroy(value);
                  return Value_new_ERROR(value, MISSINGEQ);
                }

              ++pc.token;
              errpc = pc;
              if (eval(&recLengthValue, _("record length"))->type == V_ERROR ||
                  Value_retype(&recLengthValue, V_INTEGER)->type == V_ERROR)
                {
                  Value_destroy(value);
                  *value = recLengthValue;
                  return value;
                }

              recLength = recLengthValue.u.integer;
              Value_destroy(&recLengthValue);
              if (pass == INTERPRET && recLength <= 0)
                {
                  Value_destroy(value);
                  pc = errpc;
                  return Value_new_ERROR(value, OUTOFRANGE, _("record length"));
                }
            }
          else
            {
              recLength = 1;
            }
        }
    }

  /* open file with name value */
  if (pass == INTERPRET)
    {
      int res = -1;

      if (inout == 0)
        {
          res = FS_openinChn(channel, value->u.string.character, mode);
        }
      else if (inout == 1)
        {
          res = FS_openoutChn(channel, value->u.string.character, mode, append);
        }
      else if (inout == 3)
        {
          res =
            FS_openrandomChn(channel, value->u.string.character, mode,
                             recLength);
        }
      else if (inout == 4)
        {
          res = FS_openbinaryChn(channel, value->u.string.character, mode);
        }

      if (res == -1)
        {
          pc = statementpc;
          Value_destroy(value);
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }
      else
        {
          if (lock != FS_LOCK_NONE && FS_lock(channel, 0, 0, lock, 0) == -1)
            {
              pc = statementpc;
              Value_destroy(value);
              Value_new_ERROR(value, IOERROR, FS_errmsg);
              FS_close(channel);
              return value;
            }
        }
    }

  Value_destroy(value);
  return (struct Value *)0;
}

struct Value *stmt_OPTIONBASE(struct Value *value)
{
  ++pc.token;
  if (eval(value, _("array subscript base"))->type == V_ERROR ||
      (pass != DECLARE && Value_retype(value, V_INTEGER)->type == V_ERROR))
    {
      return value;
    }

  if (pass == INTERPRET)
    {
      optionbase = value->u.integer;
    }

  Value_destroy(value);
  return (struct Value *)0;
}

struct Value *stmt_OPTIONRUN(struct Value *value)
{
  ++pc.token;
  if (pass == INTERPRET)
    {
      FS_xonxoff(STDCHANNEL, 0);
    }

  return (struct Value *)0;
}

struct Value *stmt_OPTIONSTOP(struct Value *value)
{
  ++pc.token;
  if (pass == INTERPRET)
    {
      FS_xonxoff(STDCHANNEL, 1);
    }

  return (struct Value *)0;
}

struct Value *stmt_OUT_POKE(struct Value *value)
{
  int out, address, val;
  struct Pc lpc;

  out = (pc.token->type == T_OUT);
  lpc = pc;
  ++pc.token;
  if (eval(value, _("address"))->type == V_ERROR ||
      Value_retype(value, V_INTEGER)->type == V_ERROR)
    {
      return value;
    }

  address = value->u.integer;
  Value_destroy(value);
  if (pc.token->type != T_COMMA)
    {
      return Value_new_ERROR(value, MISSINGCOMMA);
    }

  ++pc.token;
  if (eval(value, _("output value"))->type == V_ERROR ||
      Value_retype(value, V_INTEGER)->type == V_ERROR)
    {
      return value;
    }

  val = value->u.integer;
  Value_destroy(value);
  if (pass == INTERPRET)
    {
      if ((out ? FS_portOutput : FS_memOutput) (address, val) == -1)
        {
          pc = lpc;
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_PRINT_LPRINT(struct Value *value)
{
  int nl = 1;
  int chn = (pc.token->type == T_PRINT ? STDCHANNEL : LPCHANNEL);
  int printusing = 0;
  struct Value usingval;
  struct String *using = (struct String *)0;
  size_t usingpos = 0;

  ++pc.token;
  if (chn == STDCHANNEL && pc.token->type == T_CHANNEL)
    {
      ++pc.token;
      if (eval(value, _("channel"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      chn = value->u.integer;
      Value_destroy(value);
      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
    }

  if (pc.token->type == T_USING)
    {
      struct Pc usingpc;

      usingpc = pc;
      printusing = 1;
      ++pc.token;
      if (pc.token->type == T_INTEGER)
        {
          if (pass == COMPILE &&
              Program_imageLine(&program, pc.token->u.integer,
                                &usingpc.token->u.image) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, NOSUCHIMAGELINE);
            }
          else if (pass == INTERPRET)
            {
              using = usingpc.token->u.image.token->u.string;
            }

          Value_new_STRING(&usingval);
          ++pc.token;
        }
      else
        {
          if (eval(&usingval, _("format string"))->type == V_ERROR ||
              Value_retype(&usingval, V_STRING)->type == V_ERROR)
            {
              *value = usingval;
              return value;
            }

          using = &usingval.u.string;
        }

      if (pc.token->type != T_SEMICOLON)
        {
          Value_destroy(&usingval);
          return Value_new_ERROR(value, MISSINGSEMICOLON);
        }

      ++pc.token;
    }
  else
    {
      Value_new_STRING(&usingval);
      using = &usingval.u.string;
    }

  while (1)
    {
      struct Pc valuepc;

      valuepc = pc;
      if (eval(value, (const char *)0))
        {
          if (value->type == V_ERROR)
            {
              Value_destroy(&usingval);
              return value;
            }

          if (pass == INTERPRET)
            {
              struct String s;

              String_new(&s);
              if (Value_toStringUsing(value, &s, using, &usingpos)->type ==
                  V_ERROR)
                {
                  Value_destroy(&usingval);
                  String_destroy(&s);
                  pc = valuepc;
                  return value;
                }

              if (FS_putItem(chn, &s) == -1)
                {
                  Value_destroy(&usingval);
                  Value_destroy(value);
                  String_destroy(&s);
                  return Value_new_ERROR(value, IOERROR, FS_errmsg);
                }

              String_destroy(&s);
            }

          Value_destroy(value);
          nl = 1;
        }
      else if (pc.token->type == T_TAB || pc.token->type == T_SPC)
        {
          int tab = pc.token->type == T_TAB;

          ++pc.token;
          if (pc.token->type != T_OP)
            {
              Value_destroy(&usingval);
              return Value_new_ERROR(value, MISSINGOP);
            }

          ++pc.token;
          if (eval(value, _("count"))->type == V_ERROR ||
              Value_retype(value, V_INTEGER)->type == V_ERROR)
            {
              Value_destroy(&usingval);
              return value;
            }

          if (pass == INTERPRET)
            {
              int s = value->u.integer;
              int r = 0;

              if (tab)
                {
                  r = FS_tab(chn, s);
                }
              else
                {
                  while (s-- > 0 && (r = FS_putChar(chn, ' ')) != -1);
                }

              if (r == -1)
                {
                  Value_destroy(&usingval);
                  Value_destroy(value);
                  return Value_new_ERROR(value, IOERROR, FS_errmsg);
                }
            }

          Value_destroy(value);
          if (pc.token->type != T_CP)
            {
              Value_destroy(&usingval);
              return Value_new_ERROR(value, MISSINGCP);
            }

          ++pc.token;
          nl = 1;
        }

      else if (pc.token->type == T_SEMICOLON)
        {
          ++pc.token;
          nl = 0;
        }

      else if (pc.token->type == T_COMMA)
        {
          ++pc.token;
          if (pass == INTERPRET && !printusing)
            {
              FS_nextcol(chn);
            }

          nl = 0;
        }

      else
        {
          break;
        }

      if (pass == INTERPRET && FS_flush(chn) == -1)
        {
          Value_destroy(&usingval);
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }
    }

  Value_destroy(&usingval);
  if (pass == INTERPRET)
    {
      if (nl && FS_putChar(chn, '\n') == -1)
        {
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }

      if (FS_flush(chn) == -1)
        {
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_RANDOMIZE(struct Value *value)
{
  struct Pc argpc;

  ++pc.token;
  argpc = pc;
  if (eval(value, (const char *)0))
    {
      Value_retype(value, V_INTEGER);
      if (value->type == V_ERROR)
        {
          pc = argpc;
          Value_destroy(value);
          return Value_new_ERROR(value, MISSINGEXPR,
                                 _("random number generator seed"));
        }

      if (pass == INTERPRET)
        {
          srand(pc.token->u.integer);
        }

      Value_destroy(value);
    }
  else
    {
      srand(getpid() ^ time((time_t *) 0));
    }

  return (struct Value *)0;
}

struct Value *stmt_READ(struct Value *value)
{
  ++pc.token;
  while (1)
    {
      struct Value *l;
      struct Pc lvaluepc;

      lvaluepc = pc;
      if (pc.token->type != T_IDENTIFIER)
        {
          return Value_new_ERROR(value, MISSINGREADIDENT);
        }

      if (pass == DECLARE &&
          Global_variable(&globals, pc.token->u.identifier,
                          pc.token->u.identifier->defaultType,
                          (pc.token + 1)->type ==
                          T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0)
        {
          return Value_new_ERROR(value, REDECLARATION);
        }

      if ((l = lvalue(value))->type == V_ERROR)
        {
          return value;
        }

      if (pass == INTERPRET && dataread(value, l))
        {
          pc = lvaluepc;
          return value;
        }

      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_COPY_RENAME(struct Value *value)
{
  struct Pc argpc;
  struct Value from;
  struct Pc statementpc = pc;

  ++pc.token;
  argpc = pc;
  if (eval(&from, _("source file"))->type == V_ERROR ||
      (pass != DECLARE && Value_retype(&from, V_STRING)->type == V_ERROR))
    {
      pc = argpc;
      *value = from;
      return value;
    }

  if (pc.token->type != T_TO)
    {
      Value_destroy(&from);
      return Value_new_ERROR(value, MISSINGTO);
    }

  ++pc.token;
  argpc = pc;
  if (eval(value, _("destination file"))->type == V_ERROR ||
      (pass != DECLARE && Value_retype(value, V_STRING)->type == V_ERROR))
    {
      pc = argpc;
      return value;
    }

  if (pass == INTERPRET)
    {
      const char *msg;
      int res;

      if (statementpc.token->type == T_RENAME)
        {
          res = rename(from.u.string.character, value->u.string.character);
          msg = strerror(errno);
        }
      else
        {
          res = FS_copy(from.u.string.character, value->u.string.character);
          msg = FS_errmsg;
        }

      if (res == -1)
        {
          Value_destroy(&from);
          Value_destroy(value);
          pc = statementpc;
          return Value_new_ERROR(value, IOERROR, msg);
        }
    }

  Value_destroy(&from);
  Value_destroy(value);
  return (struct Value *)0;
}

struct Value *stmt_RENUM(struct Value *value)
{
  int first = 10, inc = 10;

  ++pc.token;
  if (pc.token->type == T_INTEGER)
    {
      first = pc.token->u.integer;
      ++pc.token;
      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
          if (pc.token->type != T_INTEGER)
            return Value_new_ERROR(value, MISSINGINCREMENT);
          inc = pc.token->u.integer;
          ++pc.token;
        }
    }

  if (pass == INTERPRET)
    {
      if (!DIRECTMODE)
        {
          return Value_new_ERROR(value, NOTINPROGRAMMODE);
        }

      Program_renum(&program, first, inc);
    }

  return (struct Value *)0;
}

struct Value *stmt_REPEAT(struct Value *value)
{
  if (pass == DECLARE || pass == COMPILE)
    {
      pushLabel(L_REPEAT, &pc);
    }

  ++pc.token;
  return (struct Value *)0;
}

struct Value *stmt_RESTORE(struct Value *value)
{
  struct Token *restorepc = pc.token;

  if (pass == INTERPRET)
    {
      curdata = pc.token->u.restore;
    }

  ++pc.token;
  if (pc.token->type == T_INTEGER)
    {
      if (pass == COMPILE &&
          Program_dataLine(&program, pc.token->u.integer,
                           &restorepc->u.restore) == (struct Pc *)0)
        {
          return Value_new_ERROR(value, NOSUCHDATALINE);
        }

      ++pc.token;
    }
  else if (pass == COMPILE)
    {
      restorepc->u.restore = stack.begindata;
    }

  return (struct Value *)0;
}

struct Value *stmt_RETURN(struct Value *value)
{
  if (pass == DECLARE || pass == COMPILE)
    {
      ++pc.token;
    }

  if (pass == INTERPRET)
    {
      if (Auto_gosubReturn(&stack, &pc))
        {
          Program_trace(&program, &pc, 0, 1);
        }
      else
        {
          return Value_new_ERROR(value, STRAYRETURN);
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_RUN(struct Value *value)
{
  struct Pc argpc, begin;

  stack.resumeable = 0;
  ++pc.token;
  argpc = pc;
  if (pc.token->type == T_INTEGER)
    {
      if (Program_goLine(&program, pc.token->u.integer, &begin) ==
          (struct Pc *)0)
        {
          return Value_new_ERROR(value, NOSUCHLINE);
        }

      if (pass == COMPILE &&
          Program_scopeCheck(&program, &begin, findLabel(L_FUNC)))
        {
          return Value_new_ERROR(value, OUTOFSCOPE);
        }

      ++pc.token;
    }
  else if (eval(value, (const char *)0))
    {
      if (value->type == V_ERROR ||
          Value_retype(value, V_STRING)->type == V_ERROR)
        {
          pc = argpc;
          return value;
        }
      else if (pass == INTERPRET)
        {
          int chn;
          struct Program newprogram;

          if ((chn = FS_openin(value->u.string.character)) == -1)
            {
              pc = argpc;
              Value_destroy(value);
              return Value_new_ERROR(value, IOERROR, FS_errmsg);
            }

          Value_destroy(value);
          Program_new(&newprogram);
          if (Program_merge(&newprogram, chn, value))
            {
              pc = argpc;
              Program_destroy(&newprogram);
              return value;
            }

          FS_close(chn);
          new();
          Program_destroy(&program);
          program = newprogram;
          if (Program_beginning(&program, &begin) == (struct Pc *)0)
            {
              return Value_new_ERROR(value, NOPROGRAM);
            }
        }
      else
        {
          Value_destroy(value);
        }
    }
  else
    {
      if (Program_beginning(&program, &begin) == (struct Pc *)0)
        {
          return Value_new_ERROR(value, NOPROGRAM);
        }
    }

  if (pass == INTERPRET)
    {
      if (compileProgram(value, 1)->type == V_ERROR)
        {
          return value;
        }

      pc = begin;
      curdata = stack.begindata;
      Global_clear(&globals);
      FS_closefiles();
      Program_trace(&program, &pc, 0, 1);
    }

  return (struct Value *)0;
}

struct Value *stmt_SAVE(struct Value *value)
{
  struct Pc loadpc;
  int name;

  if (pass == INTERPRET && !DIRECTMODE)
    {
      return Value_new_ERROR(value, NOTINPROGRAMMODE);
    }

  ++pc.token;
  loadpc = pc;
  if (pc.token->type == T_EOL && program.name.length)
    {
      name = 0;
    }
  else
    {
      name = 1;
      if (eval(value, _("file name"))->type == V_ERROR ||
          Value_retype(value, V_STRING)->type == V_ERROR)
        {
          pc = loadpc;
          return value;
        }
    }

  if (pass == INTERPRET)
    {
      int chn;

      if (name)
        {
          Program_setname(&program, value->u.string.character);
        }

      if ((chn = FS_openout(program.name.character)) == -1)
        {
          pc = loadpc;
          if (name)
            {
              Value_destroy(value);
            }

          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }

      FS_width(chn, 0);
      if (name)
        {
          Value_destroy(value);
        }

      if (Program_list(&program, chn, 0, (struct Pc *)0, (struct Pc *)0, value))
        {
          pc = loadpc;
          return value;
        }

      FS_close(chn);
      program.unsaved = 0;
    }
  else if (name)
    {
      Value_destroy(value);
    }

  return (struct Value *)0;
}

struct Value *stmt_SELECTCASE(struct Value *value)
{
  struct Pc statementpc = pc;

  if (pass == DECLARE || pass == COMPILE)
    {
      pushLabel(L_SELECTCASE, &pc);
    }

  ++pc.token;
  if (eval(value, _("selector"))->type == V_ERROR)
    {
      return value;
    }

  if (pass == DECLARE || pass == COMPILE)
    {
      statementpc.token->u.selectcase->type = value->type;
      statementpc.token->u.selectcase->nextcasevalue.line = -1;
    }
  else
    {
      struct Pc casevaluepc;
      int match = 0;

      pc = casevaluepc = statementpc.token->u.selectcase->nextcasevalue;
      do
        {
          ++pc.token;
          switch (casevaluepc.token->type)
            {
            case T_CASEVALUE:
              {
                do
                  {
                    struct Value casevalue1;

                    if (pc.token->type == T_IS)
                      {
                        enum TokenType relop;

                        ++pc.token;
                        relop = pc.token->type;
                        ++pc.token;
                        if (eval(&casevalue1, "`is'")->type == V_ERROR)
                          {
                            Value_destroy(value);
                            *value = casevalue1;
                            return value;
                          }

                        Value_retype(&casevalue1,
                                     statementpc.token->u.selectcase->type);
                        assert(casevalue1.type != V_ERROR);
                        if (!match)
                          {
                            struct Value cmp;

                            Value_clone(&cmp, value);
                            switch (relop)
                              {
                              case T_LT:
                                Value_lt(&cmp, &casevalue1, 1);
                                break;

                              case T_LE:
                                Value_le(&cmp, &casevalue1, 1);
                                break;

                              case T_EQ:
                                Value_eq(&cmp, &casevalue1, 1);
                                break;
                              case T_GE:
                                Value_ge(&cmp, &casevalue1, 1);
                                break;

                              case T_GT:
                                Value_gt(&cmp, &casevalue1, 1);
                                break;
                              case T_NE:
                                Value_ne(&cmp, &casevalue1, 1);
                                break;

                              default:
                                assert(0);
                              }

                            assert(cmp.type == V_INTEGER);
                            match = cmp.u.integer;
                            Value_destroy(&cmp);
                          }

                        Value_destroy(&casevalue1);
                      }
                    else
                      {
                        if (eval(&casevalue1, "`case'")->type == V_ERROR)
                          {
                            Value_destroy(value);
                            *value = casevalue1;
                            return value;
                          }

                        Value_retype(&casevalue1,
                                     statementpc.token->u.selectcase->type);
                        assert(casevalue1.type != V_ERROR);
                        if (pc.token->type == T_TO)     /* match range */
                          {
                            struct Value casevalue2;

                            ++pc.token;
                            if (eval(&casevalue2, "`case'")->type == V_ERROR)
                              {
                                Value_destroy(&casevalue1);
                                Value_destroy(value);
                                *value = casevalue2;
                                return value;
                              }

                            Value_retype(&casevalue2,
                                         statementpc.token->u.selectcase->type);
                            assert(casevalue2.type != V_ERROR);
                            if (!match)
                              {
                                struct Value cmp1, cmp2;

                                Value_clone(&cmp1, value);
                                Value_clone(&cmp2, value);
                                Value_ge(&cmp1, &casevalue1, 1);
                                assert(cmp1.type == V_INTEGER);
                                Value_le(&cmp2, &casevalue2, 1);
                                assert(cmp2.type == V_INTEGER);
                                match = cmp1.u.integer && cmp2.u.integer;
                                Value_destroy(&cmp1);
                                Value_destroy(&cmp2);
                              }

                            Value_destroy(&casevalue2);
                          }
                        else    /* match value */
                          {
                            if (!match)
                              {
                                struct Value cmp;

                                Value_clone(&cmp, value);
                                Value_eq(&cmp, &casevalue1, 1);
                                assert(cmp.type == V_INTEGER);
                                match = cmp.u.integer;
                                Value_destroy(&cmp);
                              }
                          }

                        Value_destroy(&casevalue1);
                      }

                    if (pc.token->type == T_COMMA)
                      {
                        ++pc.token;
                      }
                    else
                      {
                        break;
                      }
                  }
                while (1);

                break;
              }

            case T_CASEELSE:
              {
                match = 1;
                break;
              }

            default:
              assert(0);
            }

          if (!match)
            {
              if (casevaluepc.token->u.casevalue->nextcasevalue.line != -1)
                {
                  pc = casevaluepc =
                    casevaluepc.token->u.casevalue->nextcasevalue;
                }
              else
                {
                  pc = statementpc.token->u.selectcase->endselect;
                  break;
                }
            }
        }
      while (!match);
    }

  Value_destroy(value);
  return (struct Value *)0;
}

struct Value *stmt_SHELL(struct Value *value)
{
#ifdef CONFIG_ARCH_HAVE_VFORK
  pid_t pid;
  int status;

  ++pc.token;
  if (eval(value, (const char *)0))
    {
      if (value->type == V_ERROR ||
          Value_retype(value, V_STRING)->type == V_ERROR)
        {
          return value;
        }

      if (pass == INTERPRET)
        {
          if (run_restricted)
            {
              Value_destroy(value);
              return Value_new_ERROR(value, RESTRICTED, strerror(errno));
            }

          FS_shellmode(STDCHANNEL);
          switch (pid = vfork())
            {
            case -1:
              {
                FS_fsmode(STDCHANNEL);
                Value_destroy(value);
                return Value_new_ERROR(value, FORKFAILED, strerror(errno));
              }

            case 0:
              {
                execl("/bin/sh", "sh", "-c", value->u.string.character,
                      (const char *)0);
                exit(127);
              }

            default:
              {
                /* Wait for the shell to complete */

                while (waitpid(pid, &status, 0) < 0 && errno != EINTR);
              }
            }

          FS_fsmode(STDCHANNEL);
        }

      Value_destroy(value);
    }
  else
    {
      if (pass == INTERPRET)
        {
          if (run_restricted)
            {
              return Value_new_ERROR(value, RESTRICTED, strerror(errno));
            }

          FS_shellmode(STDCHANNEL);
          switch (pid = vfork())
            {
            case -1:
              {
                FS_fsmode(STDCHANNEL);
                return Value_new_ERROR(value, FORKFAILED, strerror(errno));
              }

            case 0:
              {
                const char *shell;

                shell = getenv("SHELL");
                if (shell == (const char *)0)
                  {
                    shell = "/bin/sh";
                  }

                execl(shell,
                      (strrchr(shell, '/') ? strrchr(shell, '/') + 1 : shell),
                      (const char *)0);
                exit(127);
              }

            default:
              {
                /* Wait for the shell to complete */

                while (waitpid(pid, &status, 0) < 0 && errno != EINTR);
              }
            }

          FS_fsmode(STDCHANNEL);
        }
    }

  return (struct Value *)0;
#else
  return Value_new_ERROR(value, FORKFAILED, strerror(ENOSYS));
#endif
}

struct Value *stmt_SLEEP(struct Value *value)
{
  double s;

  ++pc.token;
  if (eval(value, _("pause"))->type == V_ERROR ||
      Value_retype(value, V_REAL)->type == V_ERROR)
    {
      return value;
    }

  s = value->u.real;
  Value_destroy(value);
  if (pass == INTERPRET)
    {
      if (s < 0.0)
        {
          return Value_new_ERROR(value, OUTOFRANGE, _("pause"));
        }

      FS_sleep(s);
    }

  return (struct Value *)0;
}

struct Value *stmt_STOP(struct Value *value)
{
  if (pass != INTERPRET)
    {
      ++pc.token;
    }

  return (struct Value *)0;
}

struct Value *stmt_SUBEXIT(struct Value *value)
{
  struct Pc *curfn = (struct Pc *)0;

  if (pass == DECLARE || pass == COMPILE)
    {
      if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0 ||
          (curfn->token + 1)->u.identifier->defaultType != V_VOID)
        {
          return Value_new_ERROR(value, STRAYSUBEXIT);
        }
    }

  ++pc.token;
  if (pass == INTERPRET)
    {
      return Value_new_VOID(value);
    }

  return (struct Value *)0;
}

struct Value *stmt_SWAP(struct Value *value)
{
  struct Value *l1, *l2;
  struct Pc lvaluepc;

  ++pc.token;
  lvaluepc = pc;
  if (pc.token->type != T_IDENTIFIER)
    {
      return Value_new_ERROR(value, MISSINGSWAPIDENT);
    }

  if (pass == DECLARE &&
      Global_variable(&globals, pc.token->u.identifier,
                      pc.token->u.identifier->defaultType,
                      (pc.token + 1)->type == T_OP ? GLOBALARRAY : GLOBALVAR,
                      0) == 0)
    {
      return Value_new_ERROR(value, REDECLARATION);
    }

  if ((l1 = lvalue(value))->type == V_ERROR)
    {
      return value;
    }

  if (pc.token->type == T_COMMA)
    {
      ++pc.token;
    }
  else
    {
      return Value_new_ERROR(value, MISSINGCOMMA);
    }

  lvaluepc = pc;
  if (pc.token->type != T_IDENTIFIER)
    {
      return Value_new_ERROR(value, MISSINGSWAPIDENT);
    }

  if (pass == DECLARE &&
      Global_variable(&globals, pc.token->u.identifier,
                      pc.token->u.identifier->defaultType,
                      (pc.token + 1)->type == T_OP ? GLOBALARRAY : GLOBALVAR,
                      0) == 0)
    {
      return Value_new_ERROR(value, REDECLARATION);
    }

  if ((l2 = lvalue(value))->type == V_ERROR)
    {
      return value;
    }

  if (l1->type != l2->type)
    {
      pc = lvaluepc;
      return Value_new_typeError(value, l2->type, l1->type);
    }

  if (pass == INTERPRET)
    {
      struct Value foo;

      foo = *l1;
      *l1 = *l2;
      *l2 = foo;
    }

  return (struct Value *)0;
}

struct Value *stmt_SYSTEM(struct Value *value)
{
  ++pc.token;
  if (pass == INTERPRET)
    {
      if (program.unsaved)
        {
          int ch;

          FS_putChars(STDCHANNEL, _("Quit without saving? (y/n) "));
          FS_flush(STDCHANNEL);
          if ((ch = FS_getChar(STDCHANNEL)) != -1)
            {
              FS_putChar(STDCHANNEL, ch);
              FS_flush(STDCHANNEL);
              FS_nextline(STDCHANNEL);
              if (tolower(ch) == *_("yes"))
                {
                  bas_exit();
                  exit(0);
                }
            }
        }
      else
        {
          bas_exit();
          exit(0);
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_TROFF(struct Value *value)
{
  ++pc.token;
  program.trace = 0;
  return (struct Value *)0;
}

struct Value *stmt_TRON(struct Value *value)
{
  ++pc.token;
  program.trace = 1;
  return (struct Value *)0;
}

struct Value *stmt_TRUNCATE(struct Value *value)
{
  struct Pc chnpc;
  int chn;

  chnpc = pc;
  ++pc.token;
  if (pc.token->type == T_CHANNEL)
    {
      ++pc.token;
    }

  if (eval(value, (const char *)0) == (struct Value *)0)
    {
      return Value_new_ERROR(value, MISSINGEXPR, _("channel"));
    }

  if (value->type == V_ERROR || Value_retype(value, V_INTEGER)->type == V_ERROR)
    {
      return value;
    }

  chn = value->u.integer;
  Value_destroy(value);
  if (pass == INTERPRET && FS_truncate(chn) == -1)
    {
      pc = chnpc;
      return Value_new_ERROR(value, IOERROR, FS_errmsg);
    }

  return (struct Value *)0;
}

struct Value *stmt_UNNUM(struct Value *value)
{
  ++pc.token;
  if (pass == INTERPRET)
    {
      if (!DIRECTMODE)
        {
          return Value_new_ERROR(value, NOTINPROGRAMMODE);
        }

      Program_unnum(&program);
    }

  return (struct Value *)0;
}

struct Value *stmt_UNTIL(struct Value *value)
{
  struct Pc untilpc = pc;
  struct Pc *repeatpc;

  ++pc.token;
  if (eval(value, _("condition"))->type == V_ERROR)
    {
      return value;
    }

  if (pass == INTERPRET)
    {
      if (Value_isNull(value))
        {
          pc = untilpc.token->u.until;
        }

      Value_destroy(value);
    }

  if (pass == DECLARE || pass == COMPILE)
    {
      if ((repeatpc = popLabel(L_REPEAT)) == (struct Pc *)0)
        {
          return Value_new_ERROR(value, STRAYUNTIL);
        }

      untilpc.token->u.until = *repeatpc;
    }

  return (struct Value *)0;
}

struct Value *stmt_WAIT(struct Value *value)
{
  int address, mask, sel = -1, usesel;
  struct Pc lpc;

  lpc = pc;
  ++pc.token;
  if (eval(value, _("address"))->type == V_ERROR ||
      Value_retype(value, V_INTEGER)->type == V_ERROR)
    {
      return value;
    }

  address = value->u.integer;
  Value_destroy(value);
  if (pc.token->type != T_COMMA)
    {
      return Value_new_ERROR(value, MISSINGCOMMA);
    }

  ++pc.token;
  if (eval(value, _("mask"))->type == V_ERROR ||
      Value_retype(value, V_INTEGER)->type == V_ERROR)
    {
      return value;
    }

  mask = value->u.integer;
  Value_destroy(value);
  if (pc.token->type == T_COMMA)
    {
      ++pc.token;
      if (eval(value, _("select"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      sel = value->u.integer;
      usesel = 1;
      Value_destroy(value);
    }
  else
    {
      usesel = 0;
    }

  if (pass == INTERPRET)
    {
      int v;

      do
        {
          if ((v = FS_portInput(address)) == -1)
            {
              pc = lpc;
              return Value_new_ERROR(value, IOERROR, FS_errmsg);
            }
        }
      while ((usesel ? (v ^ sel) & mask : v ^ mask) == 0);
    }
  return (struct Value *)0;
}

struct Value *stmt_WHILE(struct Value *value)
{
  struct Pc whilepc = pc;

  if (pass == DECLARE || pass == COMPILE)
    {
      pushLabel(L_WHILE, &pc);
    }

  ++pc.token;
  if (eval(value, _("condition"))->type == V_ERROR)
    {
      return value;
    }

  if (pass == INTERPRET)
    {
      if (Value_isNull(value))
        {
          pc = *whilepc.token->u.afterwend;
        }

      Value_destroy(value);
    }

  return (struct Value *)0;
}

struct Value *stmt_WEND(struct Value *value)
{
  if (pass == DECLARE || pass == COMPILE)
    {
      struct Pc *whilepc;

      if ((whilepc = popLabel(L_WHILE)) == (struct Pc *)0)
        {
          return Value_new_ERROR(value, STRAYWEND, topLabelDescription());
        }

      *pc.token->u.whilepc = *whilepc;
      ++pc.token;
      *(whilepc->token->u.afterwend) = pc;
    }
  else
    {
      pc = *pc.token->u.whilepc;
    }

  return (struct Value *)0;
}

struct Value *stmt_WIDTH(struct Value *value)
{
  int chn = STDCHANNEL, width;

  ++pc.token;
  if (pc.token->type == T_CHANNEL)
    {
      ++pc.token;
      if (eval(value, _("channel"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      chn = value->u.integer;
      Value_destroy(value);
      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
    }

  if (eval(value, (const char *)0))
    {
      if (value->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      width = value->u.integer;
      Value_destroy(value);
      if (pass == INTERPRET && FS_width(chn, width) == -1)
        {
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }
    }

  if (pc.token->type == T_COMMA)
    {
      ++pc.token;
      if (eval(value, _("zone width"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      width = value->u.integer;
      Value_destroy(value);
      if (pass == INTERPRET && FS_zone(chn, width) == -1)
        {
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_WRITE(struct Value *value)
{
  int chn = STDCHANNEL;
  int comma = 0;

  ++pc.token;
  if (pc.token->type == T_CHANNEL)
    {
      ++pc.token;
      if (eval(value, _("channel"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      chn = value->u.integer;
      Value_destroy(value);
      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
    }

  while (1)
    {
      if (eval(value, (const char *)0))
        {
          if (value->type == V_ERROR)
            {
              return value;
            }

          if (pass == INTERPRET)
            {
              struct String s;

              String_new(&s);
              if (comma)
                {
                  String_appendChar(&s, ',');
                }

              if (FS_putString(chn, Value_toWrite(value, &s)) == -1)
                {
                  Value_destroy(value);
                  return Value_new_ERROR(value, IOERROR, FS_errmsg);
                }

              if (FS_flush(chn) == -1)
                {
                  return Value_new_ERROR(value, IOERROR, FS_errmsg);
                }

              String_destroy(&s);
            }

          Value_destroy(value);
          comma = 1;
        }
      else if (pc.token->type == T_COMMA || pc.token->type == T_SEMICOLON)
        {
          ++pc.token;
        }
      else
        {
          break;
        }
    }

  if (pass == INTERPRET)
    {
      FS_putChar(chn, '\n');
      if (FS_flush(chn) == -1)
        {
          return Value_new_ERROR(value, IOERROR, FS_errmsg);
        }
    }

  return (struct Value *)0;
}

struct Value *stmt_XREF(struct Value *value)
{
  stack.resumeable = 0;
  ++pc.token;
  if (pass == INTERPRET)
    {
      if (!program.runnable && compileProgram(value, 1)->type == V_ERROR)
        {
          return value;
        }

      Program_xref(&program, STDCHANNEL);
    }

  return (struct Value *)0;
}

struct Value *stmt_ZONE(struct Value *value)
{
  int chn = STDCHANNEL, width;

  ++pc.token;
  if (pc.token->type == T_CHANNEL)
    {
      ++pc.token;
      if (eval(value, _("channel"))->type == V_ERROR ||
          Value_retype(value, V_INTEGER)->type == V_ERROR)
        {
          return value;
        }

      chn = value->u.integer;
      Value_destroy(value);
      if (pc.token->type == T_COMMA)
        {
          ++pc.token;
        }
    }

  if (eval(value, _("zone width"))->type == V_ERROR ||
      Value_retype(value, V_INTEGER)->type == V_ERROR)
    {
      return value;
    }

  width = value->u.integer;
  Value_destroy(value);
  if (pass == INTERPRET && FS_zone(chn, width) == -1)
    {
      return Value_new_ERROR(value, IOERROR, FS_errmsg);
    }

  return (struct Value *)0;
}