bas.c

/* #includes */ /*{{{C}}}*//*{{{*/
#include "config.h"

#include <sys/stat.h>
#include <sys/types.h>
#include <sys/wait.h>
#include <assert.h>
#include <ctype.h>
#include <errno.h>
#include <fcntl.h>
#ifdef HAVE_GETTEXT
#include <libintl.h>
#define _(String) gettext(String)
#else
#define _(String) String
#endif
#include <limits.h>
#include <math.h>
#include <string.h>
#include <stdlib.h>
#include <stdio.h>
#include <time.h>
#include <unistd.h>

#include "getopt.h"

#include "auto.h"
#include "bas.h"
#include "error.h"
#include "fs.h"
#include "global.h"
#include "program.h"
#include "value.h"
#include "var.h"

#ifdef USE_DMALLOC
#include "dmalloc.h"
#endif
/*}}}*/
/* #defines */ /*{{{*/
#define DIRECTMODE (pc.line==-1)
#ifndef __GNUC__
#define inline
#endif
/*}}}*/

/* types */ /*{{{*/
enum LabelType
{
  L_IF=1,
  L_ELSE,
  L_DO,
  L_DOcondition,
  L_FOR,
  L_FOR_VAR,
  L_FOR_LIMIT,
  L_FOR_BODY,
  L_REPEAT,
  L_SELECTCASE,
  L_WHILE,
  L_FUNC
};

struct LabelStack
{
  enum LabelType type;
  struct Pc patch;
};
/*}}}*/
/* variables */ /*{{{*/
static unsigned int labelStackPointer,labelStackCapacity;
static struct LabelStack *labelStack;
static struct Pc *lastdata;
static struct Pc curdata;
static struct Pc nextdata;
static enum { DECLARE, COMPILE, INTERPRET } pass;
static int stopped;
static int optionbase;
static struct Pc pc;
static struct Auto stack;
static struct Program program;
static struct Global globals;
static int run_restricted;
static int do_print_end;

int bas_argc;
char *bas_argv0;
char **bas_argv;
int bas_end;
const char *autoBas="./autoexec.bas";
/*}}}*/
/* forward prototypes */ /*{{{*/
static struct Value *statements(struct Value *value);
static struct Value *compileProgram(struct Value *v, int clearGlobals);
static struct Value *eval(struct Value *value, const char *desc);
/*}}}*/

static char *mytmpnam(void) /*{{{*/
{
  static char buf[_POSIX_PATH_MAX];
  const char *tmpdir;  
  unsigned int i;
  int fd=-1;

  if ((tmpdir=getenv("TMPDIR"))==(char*)0) tmpdir="/tmp";
  if ((strlen(tmpdir)+1+8+1)>=_POSIX_PATH_MAX) return (char*)0;
  i=getpid();
  while (i<0xffffffff && (snprintf(buf,sizeof(buf),"%s/%08x",tmpdir,i),(fd=open(buf,O_RDWR|O_CREAT|O_EXCL,0600)))==-1 && errno==EEXIST) ++i;
  if (fd==-1) return (char*)0;
  close(fd);
  return buf;
}
/*}}}*/
static int cat(const char *filename) /*{{{*/
{
  int fd;
  char buf[4096];
  ssize_t l;
  int err;

  if ((fd=open(filename,O_RDONLY))==-1) return -1;
  while ((l=read(fd,buf,sizeof(buf)))>0)
  {
    ssize_t off,w;

    off=0;
    while (off<l)
    {
      if ((w=write(1,buf+off,l-off))==-1)
      {
        err=errno;
        close(fd);
        errno=err;
        return -1;
      }
      off+=w;
    }
  }
  if (l==-1)
  {
    err=errno;
    close(fd);
    errno=err;
    return -1;
  }
  close(fd);
  return 0;
}
/*}}}*/
static struct Value *lvalue(struct Value *value) /*{{{*/
{
  struct Symbol *sym;
  struct Pc lvpc=pc;

  sym=pc.token->u.identifier->sym;
  assert(pass==DECLARE || sym->type==GLOBALVAR || sym->type==GLOBALARRAY || sym->type==LOCALVAR);
  if ((pc.token+1)->type==T_OP)
  {
    struct Pc idxpc;
    unsigned int dim,capacity;
    int *idx;

    pc.token+=2;
    dim=0;
    capacity=0;
    idx=(int*)0;
    while (1)
    {
      if (dim==capacity && pass==INTERPRET) /* enlarge idx */ /*{{{*/
      {
        int *more;

        more=realloc(idx,sizeof(unsigned int)*(capacity?(capacity*=2):(capacity=3)));
        if (!more)
        {
          if (capacity) free(idx);
          return Value_new_ERROR(value,OUTOFMEMORY);
        }
        idx=more;
      }
      /*}}}*/
      idxpc=pc;
      if (eval(value,_("index"))->type==V_ERROR || VALUE_RETYPE(value,V_INTEGER)->type==V_ERROR)
      {
        if (capacity) free(idx);
        pc=idxpc;
        return value;
      }
      if (pass==INTERPRET)
      {
        idx[dim]=value->u.integer;
        ++dim;
      }
      Value_destroy(value);
      if (pc.token->type==T_COMMA) ++pc.token;
      else break;
    }
    if (pc.token->type!=T_CP)
    {
      assert(pass!=INTERPRET);
      return Value_new_ERROR(value,MISSINGCP);
    }
    else ++pc.token;
    switch (pass)
    {
      case INTERPRET:
      {
        if ((value=Var_value(&(sym->u.var),dim,idx,value))->type==V_ERROR) pc=lvpc;
        free(idx);
        return value;
      }
      case DECLARE:
      {
        return Value_nullValue(V_INTEGER);
      }
      case COMPILE:
      {
        return Value_nullValue(sym->type==GLOBALARRAY ? sym->u.var.type : Auto_varType(&stack,sym));
      }
      default: assert(0);
    }
    return (struct Value*)0;
  }
  else
  {
    ++pc.token;
    switch (pass)
    {
      case INTERPRET: return VAR_SCALAR_VALUE(sym->type==GLOBALVAR ? &(sym->u.var) : Auto_local(&stack,sym->u.local.offset));
      case DECLARE: return Value_nullValue(V_INTEGER);
      case COMPILE: return Value_nullValue(sym->type==GLOBALVAR? sym->u.var.type : Auto_varType(&stack,sym));
      default: assert(0);
    }
    return (struct Value*)0;
  }
}
/*}}}*/
static struct Value *func(struct Value *value) /*{{{*/
{
  struct Identifier *ident;
  struct Pc funcpc=pc;
  int firstslot=-99;
  int args=0;
  struct Symbol *sym;

  assert(pc.token->type==T_IDENTIFIER);
  /*
  Evaluating a function in direct mode may start a program, so it needs to
  be compiled.  If in direct mode, programs will be compiled after the
  direct mode pass DECLARE, but errors are ignored at that point, because
  the program may not be needed.  If the program is fine, its symbols will
  be available during the compile phase already.  If not and we need it
  at this point, compile it again to get the error and abort.
  */
  if (DIRECTMODE && !program.runnable && pass!=DECLARE)
  {
    if (compileProgram(value,0)->type==V_ERROR) return value;
    Value_destroy(value);
  }
  ident=pc.token->u.identifier;
  assert(pass==DECLARE || ident->sym->type==BUILTINFUNCTION || ident->sym->type==USERFUNCTION);
  ++pc.token;
  if (pass!=DECLARE)
  {
    firstslot=stack.stackPointer;
    if (ident->sym->type==USERFUNCTION && ident->sym->u.sub.retType!=V_VOID)
    {
      struct Var *v=Auto_pushArg(&stack);
      Var_new(v,ident->sym->u.sub.retType,0,(const unsigned int*)0,0);
    }
  }
  if (pc.token->type==T_OP) /* push arguments to stack */ /*{{{*/
  {
    ++pc.token;
    if (pc.token->type!=T_CP) while (1)
    {
      if (pass==DECLARE)
      {
        if (eval(value,_("actual parameter"))->type==V_ERROR) return value;
        Value_destroy(value);
      }
      else
      {
        struct Var *v=Auto_pushArg(&stack);

        Var_new_scalar(v);
        if (eval(v->value,(const char*)0)->type==V_ERROR)
        {
          Value_clone(value,v->value);
          while (stack.stackPointer>firstslot) Var_destroy(&stack.slot[--stack.stackPointer].var);
          return value;
        }
        v->type=v->value->type;
      }
      ++args;
      if (pc.token->type==T_COMMA) ++pc.token;
      else break;
    }
    if (pc.token->type!=T_CP)
    {
      if (pass!=DECLARE)
      {
        while (stack.stackPointer>firstslot) Var_destroy(&stack.slot[--stack.stackPointer].var);
      }
      return Value_new_ERROR(value,MISSINGCP);
    }
    ++pc.token;
  }
  /*}}}*/
  if (pass==DECLARE) Value_new_null(value,ident->defaultType);
  else
  {
    int i;
    int nomore;
    int argerr;
    int overloaded;

    if (pass==INTERPRET && ident->sym->type==USERFUNCTION)
    {
      for (i=0; i<ident->sym->u.sub.u.def.localLength; ++i)
      {
        struct Var *v=Auto_pushArg(&stack);
        Var_new(v,ident->sym->u.sub.u.def.localTypes[i],0,(const unsigned int*)0,0);
      }
    }
    Auto_pushFuncRet(&stack,firstslot,&pc);

    sym=ident->sym;
    overloaded=(pass==COMPILE && sym->type==BUILTINFUNCTION && sym->u.sub.u.bltin.next);
    do
    {
      nomore=(pass==COMPILE && !(sym->type==BUILTINFUNCTION && sym->u.sub.u.bltin.next));
      argerr=0;
      if (args<sym->u.sub.argLength) /*{{{*/
      {
        if (nomore) Value_new_ERROR(value,TOOFEW);
        argerr=1;
      }
      /*}}}*/
      else if (args>sym->u.sub.argLength) /*{{{*/
      {
        if (nomore) Value_new_ERROR(value,TOOMANY);
        argerr=1;
      }
      /*}}}*/
      else /*{{{*/
      {
        for (i=0; i<args; ++i)
        {
          struct Value *arg=Var_value(Auto_local(&stack,i),0,(int*)0,value);

          assert(arg->type!=V_ERROR);
          if (overloaded)
          {
            if (arg->type!=sym->u.sub.argTypes[i])
            {
              if (nomore) Value_new_ERROR(value,TYPEMISMATCH2,i+1);
              argerr=1;
              break;
            }
          }
          else if (Value_retype(arg,sym->u.sub.argTypes[i])->type==V_ERROR)
          {
            if (nomore) Value_new_ERROR(value,TYPEMISMATCH3,arg->u.error.msg,i+1);
            argerr=1;
            break;
          }
        }
      }
      /*}}}*/
      if (argerr)
      {
        if (nomore)
        {
          Auto_funcReturn(&stack,(struct Pc*)0);
          pc=funcpc;
          return value;
        }
        else sym=sym->u.sub.u.bltin.next;
      }
    } while (argerr);
    ident->sym=sym;
    if (sym->type==BUILTINFUNCTION)
    {
      if (pass==INTERPRET)
      {
        if (sym->u.sub.u.bltin.call(value,&stack)->type==V_ERROR) pc=funcpc;
      }
      else Value_new_null(value,sym->u.sub.retType);
    }
    else if (sym->type==USERFUNCTION)
    {
      if (pass==INTERPRET)
      {
        int r=1;

        pc=sym->u.sub.u.def.scope.start;
        if (pc.token->type==T_COLON) ++pc.token;
        else Program_skipEOL(&program,&pc,STDCHANNEL,1);
        do
        {
          if (statements(value)->type==V_ERROR)
          {
            if (strchr(value->u.error.msg,'\n')==(char*)0)
            {
              Auto_setError(&stack,Program_lineNumber(&program,&pc),&pc,value);
              Program_PCtoError(&program,&pc,value);
            }
            if (stack.onerror.line!=-1)
            {
              stack.resumeable=1;
              pc=stack.onerror;
            }
            else
            {
              Auto_frameToError(&stack,&program,value);
              break;
            }
          }
          else if (value->type!=V_NIL) break;
          Value_destroy(value);
        } while ((r=Program_skipEOL(&program,&pc,STDCHANNEL,1)));
        if (!r) Value_new_VOID(value);
      }
      else Value_new_null(value,sym->u.sub.retType);
    }
    Auto_funcReturn(&stack,pass==INTERPRET && value->type!=V_ERROR ? &pc : (struct Pc*)0);
  }
  return value;
}
/*}}}*/

#ifdef USE_LR0
/* Grammar with LR(0) sets */ /*{{{*/
/*
Grammar:

1 EV -> E
2 E  -> E op E
3 E  -> op E
4 E  -> ( E )
5 E  -> value

i0:
EV -> . E                goto(0,E)=5
E  -> . E op E           goto(0,E)=5
E  -> . op E      +,-    shift 2
E  -> . ( E )     (      shift 3
E  -> . value     value  shift 4

i5:
EV -> E .         else   accept
E  -> E . op E    op     shift 1

i2:
E  -> op . E             goto(2,E)=6
E  -> . E op E           goto(2,E)=6
E  -> . op E      +,-    shift 2
E  -> . ( E )     (      shift 3
E  -> . value     value  shift 4

i3:
E  -> ( . E )            goto(3,E)=7
E  -> . E op E           goto(3,E)=7
E  -> . op E      +,-    shift 2
E  -> . ( E )     (      shift 3
E  -> . value     value  shift 4

i4:
E  -> value .            reduce 5

i1:
E  -> E op . E           goto(1,E)=8
E  -> . E op E           goto(1,E)=8
E  -> . op E      +,-    shift 2
E  -> . ( E )     (      shift 3
E  -> . value     value  shift 4

i6:
E  -> op E .             reduce 3
E  -> E . op E    op*    shift 1 *=if stack[-2] contains op of unary lower priority

i7:
E  -> ( E . )     )      shift 9
E  -> E . op E    op     shift 1

i8:
E  -> E op E .           reduce 2
E  -> E . op E    op*    shift 1 *=if stack[-2] contains op of lower priority or if
                                   if it is of equal priority and right associative

i9:
E  -> ( E ) .            reduce 4

*/
/*}}}*/
static struct Value *eval(struct Value *value, const char *desc) /*{{{*/
{
  /* variables */ /*{{{*/
  static const int gotoState[10]={ 5,8,6,7,-1,-1,-1,-1,-1,-1 };
  int capacity=10;
  struct Pdastack
  {
    union
    {
      enum TokenType token;
      struct Value value;
    } u;
    char state;
  };
  struct Pdastack *pdastack=malloc(capacity*sizeof(struct Pdastack));
  struct Pdastack *sp=pdastack;
  struct Pdastack *stackEnd=pdastack+capacity-1;
  enum TokenType ip;
  /*}}}*/

  sp->state=0;
  while (1)
  {
    if (sp==stackEnd)
    {
      pdastack=realloc(pdastack,(capacity+10)*sizeof(struct Pdastack));
      sp=pdastack+capacity-1;
      capacity+=10;
      stackEnd=pdastack+capacity-1;
    }
    ip=pc.token->type;
    switch (sp->state)
    {
      case 0:
      case 1:
      case 2:
      case 3: /*{{{*/ /* including 4 */
      {
        if (ip==T_IDENTIFIER) /*{{{*/
        {
          /* printf("state %d: shift 4\n",sp->state); */
          /* printf("state 4: reduce E -> value\n"); */
          ++sp;
          sp->state=gotoState[(sp-1)->state];
          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
            )
            {
              Value_new_ERROR(value,UNDECLARED);
              goto error;
            }
          }
          if (pass!=DECLARE && (pc.token->u.identifier->sym->type==GLOBALVAR || pc.token->u.identifier->sym->type==GLOBALARRAY || pc.token->u.identifier->sym->type==LOCALVAR))
          {
            struct Value *l;

            if ((l=lvalue(value))->type==V_ERROR) goto error;
            Value_clone(&sp->u.value,l);
          }
          else
          {
            struct Pc var=pc;

            func(&sp->u.value);
            if (sp->u.value.type==V_VOID)
            {
              pc=var;
              Value_new_ERROR(value,VOIDVALUE);
              goto error;
            }
          }
        }
        /*}}}*/
        else if (ip==T_INTEGER) /*{{{*/
        {
          /* printf("state %d: shift 4\n",sp->state); */
          /* printf("state 4: reduce E -> value\n"); */
          ++sp;
          sp->state=gotoState[(sp-1)->state];
          VALUE_NEW_INTEGER(&sp->u.value,pc.token->u.integer);
          ++pc.token;
        }
        /*}}}*/
        else if (ip==T_REAL) /*{{{*/
        {
          /* printf("state %d: shift 4\n",sp->state); */
          /* printf("state 4: reduce E -> value\n"); */
          ++sp;
          sp->state=gotoState[(sp-1)->state];
          VALUE_NEW_REAL(&sp->u.value,pc.token->u.real);
          ++pc.token;
        }
        /*}}}*/
        else if (TOKEN_ISUNARYOPERATOR(ip)) /*{{{*/
        {
          /* printf("state %d: shift 2\n",sp->state); */
          ++sp;
          sp->state=2;
          sp->u.token=ip;
          ++pc.token;
        }
        /*}}}*/
        else if (ip==T_HEXINTEGER) /*{{{*/
        {
          /* printf("state %d: shift 4\n",sp->state); */
          /* printf("state 4: reduce E -> value\n"); */
          ++sp;
          sp->state=gotoState[(sp-1)->state];
          VALUE_NEW_INTEGER(&sp->u.value,pc.token->u.hexinteger);
          ++pc.token;
        }
        /*}}}*/
        else if (ip==T_OCTINTEGER) /*{{{*/
        {
          /* printf("state %d: shift 4\n",sp->state); */
          /* printf("state 4: reduce E -> value\n"); */
          ++sp;
          sp->state=gotoState[(sp-1)->state];
          VALUE_NEW_INTEGER(&sp->u.value,pc.token->u.octinteger);
          ++pc.token;
        }
        /*}}}*/
        else if (ip==T_OP) /*{{{*/
        {
          /* printf("state %d: shift 3\n",sp->state); */
          ++sp;
          sp->state=3;
          sp->u.token=T_OP;
          ++pc.token;
        }
        /*}}}*/
        else if (ip==T_STRING) /*{{{*/
        {
          /* printf("state %d: shift 4\n",sp->state); */
          /* printf("state 4: reduce E -> value\n"); */
          ++sp;
          sp->state=gotoState[(sp-1)->state];
          Value_new_STRING(&sp->u.value);
          String_destroy(&sp->u.value.u.string);
          String_clone(&sp->u.value.u.string,pc.token->u.string);
          ++pc.token;
        }
        /*}}}*/
        else /*{{{*/
        {
          char state=sp->state;

          if (state==0)
          {
            if (desc) Value_new_ERROR(value,MISSINGEXPR,desc);
            else value=(struct Value*)0;
          }
          else Value_new_ERROR(value,MISSINGEXPR,_("operand"));
          goto error;
        }
        /*}}}*/
        break;
      }
      /*}}}*/
      case 5: /*{{{*/
      {
        if (TOKEN_ISBINARYOPERATOR(ip))
        {
          /* printf("state %d: shift 1\n",sp->state); */
          ++sp;
          sp->state=1;
          sp->u.token=ip;
          ++pc.token;
          break;
        }
        else
        {
          assert(sp==pdastack+1);
          *value=sp->u.value;
          free(pdastack);
          return value;
        }
        break;
      }
      /*}}}*/
      case 6: /*{{{*/
      {
        if (TOKEN_ISBINARYOPERATOR(ip) && TOKEN_UNARYPRIORITY((sp-1)->u.token)<TOKEN_BINARYPRIORITY(ip))
        {
          assert(TOKEN_ISUNARYOPERATOR((sp-1)->u.token));
          /* printf("state %d: shift 1 (not reducing E -> op E)\n",sp->state); */
          ++sp;
          sp->state=1;
          sp->u.token=ip;
          ++pc.token;
        }
        else
        {
          enum TokenType op;

          /* printf("reduce E -> op E\n"); */
          --sp;
          op=sp->u.token;
          sp->u.value=(sp+1)->u.value;
          switch (op)
          {
            case T_PLUS: break;
            case T_MINUS: Value_uneg(&sp->u.value,pass==INTERPRET); break;
            case T_NOT: Value_unot(&sp->u.value,pass==INTERPRET); break;
            default: assert(0);
          }
          sp->state=gotoState[(sp-1)->state];
          if (sp->u.value.type==V_ERROR)
          {
            *value=sp->u.value;
            --sp;
            goto error;
          }
        }
        break;
      }
      /*}}}*/
      case 7: /*{{{*/ /* including 9 */
      {
        if (TOKEN_ISBINARYOPERATOR(ip))
        {
          /* printf("state %d: shift 1\n"sp->state); */
          ++sp;
          sp->state=1;
          sp->u.token=ip;
          ++pc.token;
        }
        else if (ip==T_CP)
        {
          /* printf("state %d: shift 9\n",sp->state); */
          /* printf("state 9: reduce E -> ( E )\n"); */
          --sp;
          sp->state=gotoState[(sp-1)->state];
          sp->u.value=(sp+1)->u.value;
          ++pc.token;
        }
        else
        {
          Value_new_ERROR(value,MISSINGCP);
          goto error;
        }
        break;
      }
      /*}}}*/
      case 8: /*{{{*/
      {
        int p1,p2;

        if
        (
          TOKEN_ISBINARYOPERATOR(ip)
          &&
          (
            ((p1=TOKEN_BINARYPRIORITY((sp-1)->u.token))<(p2=TOKEN_BINARYPRIORITY(ip)))
            || (p1==p2 && TOKEN_ISRIGHTASSOCIATIVE((sp-1)->u.token))
          )
        )
        {
          /* printf("state %d: shift 1\n",sp->state); */
          ++sp;
          sp->state=1;
          sp->u.token=ip;
          ++pc.token;
        }
        else
        {
          /* printf("state %d: reduce E -> E op E\n",sp->state); */
          if (Value_commonType[(sp-2)->u.value.type][sp->u.value.type]==V_ERROR)
          {
            Value_destroy(&sp->u.value);
            sp-=2;
            Value_destroy(&sp->u.value);
            Value_new_ERROR(value,INVALIDOPERAND);
            --sp;
            goto error;
          }
          else switch ((sp-1)->u.token)
          {
            case T_LT:    Value_lt(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_LE:    Value_le(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_EQ:    Value_eq(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_GE:    Value_ge(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_GT:    Value_gt(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_NE:    Value_ne(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_PLUS:  Value_add(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_MINUS: Value_sub(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_MULT:  Value_mult(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_DIV:   Value_div(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_IDIV:  Value_idiv(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_MOD:   Value_mod(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_POW:   Value_pow(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_AND:   Value_and(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_OR:    Value_or(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_XOR:   Value_xor(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_EQV:   Value_eqv(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            case T_IMP:   Value_imp(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
            default:      assert(0);
          }
          Value_destroy(&sp->u.value);
          sp-=2;
          sp->state=gotoState[(sp-1)->state];
          if (sp->u.value.type==V_ERROR)
          {
            *value=sp->u.value;
            --sp;
            goto error;
          }
        }
        break;
      }
      /*}}}*/
    }
  }
  error:
  while (sp>pdastack)
  {
    switch (sp->state)
    {
      case 5:
      case 6:
      case 7:
      case 8: Value_destroy(&sp->u.value);
    }
    --sp;
  }
  free(pdastack);
  return value;
}
/*}}}*/
#else
static inline struct Value *binarydown(struct Value *value, struct Value *(level)(struct Value *value), const int prio) /*{{{*/
{
  enum TokenType op;
  struct Pc oppc;

  if (level(value)==(struct Value*)0) return (struct Value*)0;
  if (value->type==V_ERROR) return value;
  do
  {
    struct Value x;

    op=pc.token->type;
    if (!TOKEN_ISBINARYOPERATOR(op) || TOKEN_BINARYPRIORITY(op)!=prio) return value;
    oppc=pc;
    ++pc.token;
    if (level(&x)==(struct Value*)0)
    {
      Value_destroy(value);
      return Value_new_ERROR(value,MISSINGEXPR,_("binary operand"));
    }
    if (x.type==V_ERROR)
    {
      Value_destroy(value);
      *value=x;
      return value;
    }
    if (Value_commonType[value->type][x.type]==V_ERROR)
    {
      Value_destroy(value);
      Value_destroy(&x);
      return Value_new_ERROR(value,INVALIDOPERAND);
    }
    else switch (op)
    {
      case T_LT:    Value_lt(value,&x,pass==INTERPRET);   break;
      case T_LE:    Value_le(value,&x,pass==INTERPRET);   break;
      case T_EQ:    Value_eq(value,&x,pass==INTERPRET);   break;
      case T_GE:    Value_ge(value,&x,pass==INTERPRET);   break;
      case T_GT:    Value_gt(value,&x,pass==INTERPRET);   break;
      case T_NE:    Value_ne(value,&x,pass==INTERPRET);   break;
      case T_PLUS:  Value_add(value,&x,pass==INTERPRET);  break;
      case T_MINUS: Value_sub(value,&x,pass==INTERPRET);  break;
      case T_MULT:  Value_mult(value,&x,pass==INTERPRET); break;
      case T_DIV:   Value_div(value,&x,pass==INTERPRET);  break;
      case T_IDIV:  Value_idiv(value,&x,pass==INTERPRET); break;
      case T_MOD:   Value_mod(value,&x,pass==INTERPRET);  break;
      case T_POW:   Value_pow(value,&x,pass==INTERPRET);  break;
      case T_AND:   Value_and(value,&x,pass==INTERPRET);  break;
      case T_OR:    Value_or(value,&x,pass==INTERPRET);   break;
      case T_XOR:   Value_xor(value,&x,pass==INTERPRET);  break;
      case T_EQV:   Value_eqv(value,&x,pass==INTERPRET);  break;
      case T_IMP:   Value_imp(value,&x,pass==INTERPRET);  break;
      default:      assert(0);
    }
    Value_destroy(&x);
  } while (value->type!=V_ERROR);
  if (value->type==V_ERROR) pc=oppc;
  return value;
}
/*}}}*/
static inline struct Value *unarydown(struct Value *value, struct Value *(level)(struct Value *value), const int prio) /*{{{*/
{
  enum TokenType op;
  struct Pc oppc;

  op=pc.token->type;
  if (!TOKEN_ISUNARYOPERATOR(op) || TOKEN_UNARYPRIORITY(op)!=prio) return level(value);
  oppc=pc;
  ++pc.token;
  if (unarydown(value,level,prio)==(struct Value*)0) return Value_new_ERROR(value,MISSINGEXPR,_("unary operand"));
  if (value->type==V_ERROR) return value;
  switch (op)
  {
    case T_PLUS:  Value_uplus(value,pass==INTERPRET); break;
    case T_MINUS: Value_uneg(value,pass==INTERPRET);  break;
    case T_NOT:   Value_unot(value,pass==INTERPRET);  break;
    default:      assert(0);
  }
  if (value->type==V_ERROR) pc=oppc;
  return value;
}
/*}}}*/
static struct Value *eval8(struct Value *value) /*{{{*/
{
  switch (pc.token->type)
  {
    case T_IDENTIFIER: /*{{{*/
    {
      struct Pc var;
      struct Value *l;

      var=pc;
      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);
      }
      assert(pass==DECLARE || pc.token->u.identifier->sym);
      if (pass!=DECLARE && (pc.token->u.identifier->sym->type==GLOBALVAR || pc.token->u.identifier->sym->type==GLOBALARRAY || pc.token->u.identifier->sym->type==LOCALVAR))
      {
        if ((l=lvalue(value))->type==V_ERROR) return value;
        Value_clone(value,l);
      }
      else
      {
        func(value);
        if (value->type==V_VOID)
        {
          Value_destroy(value);
          pc=var;
          return Value_new_ERROR(value,VOIDVALUE);
        }
      }
      break;
    }
    /*}}}*/
    case T_INTEGER: /*{{{*/
    {
      VALUE_NEW_INTEGER(value,pc.token->u.integer);
      ++pc.token;
      break;
    }
    /*}}}*/
    case T_REAL: /*{{{*/
    {
      VALUE_NEW_REAL(value,pc.token->u.real);
      ++pc.token;
      break;
    }
    /*}}}*/
    case T_STRING: /*{{{*/
    {
      Value_new_STRING(value);
      String_destroy(&value->u.string);
      String_clone(&value->u.string,pc.token->u.string);
      ++pc.token;
      break;
    }
    /*}}}*/
    case T_HEXINTEGER: /*{{{*/
    {
      VALUE_NEW_INTEGER(value,pc.token->u.hexinteger);
      ++pc.token;
      break;
    }
    /*}}}*/
    case T_OCTINTEGER: /*{{{*/
    {
      VALUE_NEW_INTEGER(value,pc.token->u.octinteger);
      ++pc.token;
      break;
    }
    /*}}}*/
    case T_OP: /*{{{*/
    {
      ++pc.token;
      if (eval(value,_("parenthetic"))->type==V_ERROR) return value;
      if (pc.token->type!=T_CP)
      {
        Value_destroy(value);
        return Value_new_ERROR(value,MISSINGCP);
      }
      ++pc.token;
      break;
    }
    /*}}}*/
    default: /*{{{*/
    {
      return (struct Value *)0;
    }
    /*}}}*/
  }
  return value;
}
/*}}}*/
static struct Value *eval7(struct Value *value) /*{{{*/
{
  return binarydown(value,eval8,7);
}
/*}}}*/
static struct Value *eval6(struct Value *value) /*{{{*/
{
  return unarydown(value,eval7,6);
}
/*}}}*/
static struct Value *eval5(struct Value *value) /*{{{*/
{
  return binarydown(value,eval6,5);
}
/*}}}*/
static struct Value *eval4(struct Value *value) /*{{{*/
{
  return binarydown(value,eval5,4);
}
/*}}}*/
static struct Value *eval3(struct Value *value) /*{{{*/
{
  return binarydown(value,eval4,3);
}
/*}}}*/
static struct Value *eval2(struct Value *value) /*{{{*/
{
  return unarydown(value,eval3,2);
}
/*}}}*/
static struct Value *eval1(struct Value *value) /*{{{*/
{
  return binarydown(value,eval2,1);
}
/*}}}*/
static struct Value *eval(struct Value *value, const char *desc) /*{{{*/
{
  /* avoid function calls for atomic expression */
  switch (pc.token->type)
  {
    case T_STRING:
    case T_REAL:
    case T_INTEGER:
    case T_HEXINTEGER:
    case T_OCTINTEGER:
    case T_IDENTIFIER: if (!TOKEN_ISBINARYOPERATOR((pc.token+1)->type) && (pc.token+1)->type!=T_OP) return eval7(value);
    default: break;
  }
  if (binarydown(value,eval1,0)==(struct Value*)0)
  {
    if (desc) return Value_new_ERROR(value,MISSINGEXPR,desc);
    else return (struct Value*)0; 
  }
  else return value;
}
/*}}}*/
#endif

static void new(void) /*{{{*/
{
  Global_destroy(&globals);
  Global_new(&globals);
  Auto_destroy(&stack);
  Auto_new(&stack);
  Program_destroy(&program);
  Program_new(&program);
  FS_closefiles();
  optionbase=0;
}
/*}}}*/
static void pushLabel(enum LabelType type, struct Pc *patch) /*{{{*/
{
  if (labelStackPointer==labelStackCapacity)
  {
    struct LabelStack *more;

    more=realloc(labelStack,sizeof(struct LabelStack)*(labelStackCapacity?(labelStackCapacity*=2):(32)));
    labelStack=more;
  }
  labelStack[labelStackPointer].type=type;
  labelStack[labelStackPointer].patch=*patch;
  ++labelStackPointer;
}
/*}}}*/
static struct Pc *popLabel(enum LabelType type) /*{{{*/
{
  if (labelStackPointer==0 || labelStack[labelStackPointer-1].type!=type) return (struct Pc*)0;
  else return &labelStack[--labelStackPointer].patch;
}
/*}}}*/
static struct Pc *findLabel(enum LabelType type) /*{{{*/
{
  int i;

  for (i=labelStackPointer-1; i>=0; --i) if (labelStack[i].type==type) return &labelStack[i].patch;
  return (struct Pc*)0;
}
/*}}}*/
static void labelStackError(struct Value *v) /*{{{*/
{
  assert(labelStackPointer);
  pc=labelStack[labelStackPointer-1].patch;
  switch (labelStack[labelStackPointer-1].type)
  {
    case L_IF: Value_new_ERROR(v,STRAYIF); break;
    case L_DO: Value_new_ERROR(v,STRAYDO); break;
    case L_DOcondition: Value_new_ERROR(v,STRAYDOcondition); break;
    case L_ELSE: Value_new_ERROR(v,STRAYELSE2); break;
    case L_FOR_BODY:
    {
      Value_new_ERROR(v,STRAYFOR);
      pc=*findLabel(L_FOR);
      break;
    }
    case L_WHILE: Value_new_ERROR(v,STRAYWHILE); break;
    case L_REPEAT: Value_new_ERROR(v,STRAYREPEAT); break;
    case L_SELECTCASE: Value_new_ERROR(v,STRAYSELECTCASE); break;
    case L_FUNC: Value_new_ERROR(v,STRAYFUNC); break;
    default: assert(0);
  }
}
/*}}}*/
static const char *topLabelDescription(void) /*{{{*/
{
  if (labelStackPointer==0)
  {
    return _("program");
  }
  switch (labelStack[labelStackPointer-1].type)
  {
    case L_IF: return _("`if' branch");
    case L_DO: return _("`do' loop");
    case L_DOcondition: return _("`do while' or `do until' loop");
    case L_ELSE: return _("`else' branch");
    case L_FOR_BODY: return _("`for' loop");
    case L_WHILE: return _("`while' loop");
    case L_REPEAT: return _("`repeat' loop");
    case L_SELECTCASE: return _("`select case' control structure");
    case L_FUNC: return _("function or procedure");
    default: assert(0);
  }
  /* NOTREACHED */
  return (const char*)0;
}
/*}}}*/
static struct Value *assign(struct Value *value) /*{{{*/
{
  struct Pc expr;

  if (strcasecmp(pc.token->u.identifier->name,"mid$")==0) /* mid$(a$,n,m)=b$ */ /*{{{*/
  {
    long int n,m;
    struct Value *l;

    ++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,MISSINGSTRIDENT);
    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==COMPILE && l->type!=V_STRING) return Value_new_ERROR(value,TYPEMISMATCH4);
    if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA);
    ++pc.token;
    if (eval(value,_("position"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
    n=value->u.integer;
    Value_destroy(value);
    if (pass==INTERPRET && n<1) return Value_new_ERROR(value,OUTOFRANGE,"position");
    if (pc.token->type==T_COMMA)
    {
      ++pc.token;
      if (eval(value,_("length"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
      m=value->u.integer;
      if (pass==INTERPRET && m<0) return Value_new_ERROR(value,OUTOFRANGE,_("length"));
      Value_destroy(value);
    }
    else m=-1;
    if (pc.token->type!=T_CP) return Value_new_ERROR(value,MISSINGCP);
    ++pc.token;
    if (pc.token->type!=T_EQ) return Value_new_ERROR(value,MISSINGEQ);
    ++pc.token;
    if (eval(value,_("rhs"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value;
    if (pass==INTERPRET)
    {
      if (m==-1) m=value->u.string.length;
      String_set(&l->u.string,n-1,&value->u.string,m);
    }
  }
  /*}}}*/
  else /*{{{*/
  {
    struct Value **l=(struct Value**)0;
    int i, used=0, capacity=0;
    struct Value retyped_value;

    for (;;)
    {
      if (used==capacity)
      {
        struct Value **more;
      
        capacity=capacity?2*capacity:2;
        more=realloc(l,capacity*sizeof(*l));
        l=more;
      }

      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
        )
        {
          if (capacity) free(l);
          return Value_new_ERROR(value,REDECLARATION);
        }
      }
      if ((l[used]=lvalue(value))->type==V_ERROR) return value;
      ++used;
      if (pc.token->type==T_COMMA) ++pc.token;
      else break;
    }
    if (pc.token->type!=T_EQ) return Value_new_ERROR(value,MISSINGEQ);
    ++pc.token;
    expr=pc;
    if (eval(value,_("rhs"))->type==V_ERROR) return value;
    for (i=0; i<used; ++i)
    {
      Value_clone(&retyped_value,value);
      if (pass!=DECLARE && VALUE_RETYPE(&retyped_value,(l[i])->type)->type==V_ERROR)
      {
        pc=expr;
        free(l);
        Value_destroy(value);
        *value=retyped_value;
        return value;
      }
      if (pass==INTERPRET)
      {
        Value_destroy(l[i]);
        *(l[i])=retyped_value;
      }
    }
    free(l);
    Value_destroy(value);
    *value=retyped_value; /* for status only */
  }
  /*}}}*/
  return value;
}
/*}}}*/
static struct Value *compileProgram(struct Value *v, int clearGlobals) /*{{{*/
{
  struct Pc begin;

  stack.resumeable=0;
  if (clearGlobals)
  {
    Global_destroy(&globals);
    Global_new(&globals);
  }
  else Global_clearFunctions(&globals);
  if (Program_beginning(&program,&begin))
  {
    struct Pc savepc;
    int savepass;

    savepc=pc;
    savepass=pass;
    Program_norun(&program);
    for (pass=DECLARE; pass!=INTERPRET; ++pass)
    {
      if (pass==DECLARE)
      {
        stack.begindata.line=-1;
        lastdata=&stack.begindata;
      }
      optionbase=0;
      FS_intr=0;
      stopped=0;
      program.runnable=1;
      pc=begin;
      while (1)
      {
        statements(v);
        if (v->type==V_ERROR) break;
        Value_destroy(v);
        if (!Program_skipEOL(&program,&pc,0,0)) { Value_new_NIL(v); break; }
      }
      if (v->type!=V_ERROR && labelStackPointer>0)
      {
        Value_destroy(v);
        labelStackError(v);
      }
      if (v->type==V_ERROR)
      {
        labelStackPointer=0;
        Program_norun(&program);
        if (stack.cur) Auto_funcEnd(&stack); /* Always correct? */
        pass=savepass;
        return v;
      }
    }
    pc=begin;
    if (Program_analyse(&program,&pc,v))
    {
      labelStackPointer=0;
      Program_norun(&program);
      if (stack.cur) Auto_funcEnd(&stack); /* Always correct? */
      pass=savepass;
      return v;
    }
    curdata=stack.begindata;
    pc=savepc;
    pass=savepass;
  }
  return Value_new_NIL(v);
}
/*}}}*/
static void runline(struct Token *line) /*{{{*/
{
  struct Value value;

  FS_flush(STDCHANNEL);
  for (pass=DECLARE; pass!=INTERPRET; ++pass)
  {
    curdata.line=-1;
    pc.line=-1;
    pc.token=line;
    optionbase=0;
    FS_intr=0;
    stopped=0;
    statements(&value);
    if (value.type!=V_ERROR && pc.token->type!=T_EOL)
    {
      Value_destroy(&value);
      Value_new_ERROR(&value,SYNTAX);
    }
    if (value.type!=V_ERROR && labelStackPointer>0)
    {
      Value_destroy(&value);
      labelStackError(&value);
    }
    if (value.type==V_ERROR)
    {
      struct String s;

      Auto_setError(&stack,Program_lineNumber(&program,&pc),&pc,&value);
      Program_PCtoError(&program,&pc,&value);
      labelStackPointer=0;
      FS_putChars(STDCHANNEL,_("Error: "));
      String_new(&s);
      Value_toString(&value,&s,' ',-1,0,0,0,0,-1,0,0);
      Value_destroy(&value);
      FS_putString(STDCHANNEL,&s);
      String_destroy(&s);
      return;
    }
    if (!program.runnable && pass==COMPILE)
    {
      Value_destroy(&value);
      (void)compileProgram(&value,0);
    }
  }

  pc.line=-1;
  pc.token=line;
  optionbase=0;
  curdata=stack.begindata;
  nextdata.line=-1;
  Value_destroy(&value);
  pass=INTERPRET;
  FS_allowIntr(1);
  do
  {
    assert(pass==INTERPRET);
    statements(&value);
    assert(pass==INTERPRET);
    if (value.type==V_ERROR)
    {
      if (strchr(value.u.error.msg,'\n')==(char*)0)
      {
        Auto_setError(&stack,Program_lineNumber(&program,&pc),&pc,&value);
        Program_PCtoError(&program,&pc,&value);
      }
      if (stack.onerror.line!=-1)
      {
        stack.resumeable=1;
        pc=stack.onerror;
      }
      else
      {
        struct String s;

        String_new(&s);
        if (!stopped)
        {
          stopped=0;
          FS_putChars(STDCHANNEL,_("Error: "));
        }
        Auto_frameToError(&stack,&program,&value);
        Value_toString(&value,&s,' ',-1,0,0,0,0,-1,0,0);
        while (Auto_gosubReturn(&stack,(struct Pc*)0));
        FS_putString(STDCHANNEL,&s);
        String_destroy(&s);
        Value_destroy(&value);
        break;
      }
    }
    Value_destroy(&value);
  } while (pc.token->type!=T_EOL || Program_skipEOL(&program,&pc,STDCHANNEL,1));
  FS_allowIntr(0);
}
/*}}}*/
static struct Value *evalGeometry(struct Value *value, unsigned int *dim, unsigned int geometry[]) /*{{{*/
{
  struct Pc exprpc=pc;

  if (eval(value,_("dimension"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value;
  if (pass==INTERPRET && value->u.integer<optionbase)
  {
    Value_destroy(value);
    pc=exprpc;
    return Value_new_ERROR(value,OUTOFRANGE,_("dimension"));
  }
  geometry[0]=value->u.integer-optionbase+1;
  Value_destroy(value);
  if (pc.token->type==T_COMMA)
  {
    ++pc.token;
    exprpc=pc;
    if (eval(value,_("dimension"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value;
    if (pass==INTERPRET && value->u.integer<optionbase)
    {
      Value_destroy(value);
      pc=exprpc;
      return Value_new_ERROR(value,OUTOFRANGE,_("dimension"));
    }
    geometry[1]=value->u.integer-optionbase+1;
    Value_destroy(value);
    *dim=2;
  }
  else *dim=1;
  if (pc.token->type==T_CP) ++pc.token;
  else return Value_new_ERROR(value,MISSINGCP);
  return (struct Value*)0;
}
/*}}}*/
static struct Value *convert(struct Value *value, struct Value *l, struct Token *t) /*{{{*/
{
  switch (l->type)
  {
    case V_INTEGER:
    {
      char *datainput;
      char *end;
      long int v;
      int overflow;

      if (t->type!=T_DATAINPUT) return Value_new_ERROR(value,BADCONVERSION,_("integer"));
      datainput=t->u.datainput;
      v=Value_vali(datainput,&end,&overflow);
      if (end==datainput || (*end!='\0' && *end!=' ' && *end!='\t')) return Value_new_ERROR(value,BADCONVERSION,_("integer"));
      if (overflow) return Value_new_ERROR(value,OUTOFRANGE,_("converted value"));
      Value_destroy(l);
      VALUE_NEW_INTEGER(l,v);
      break;
    }
    case V_REAL:
    {
      char *datainput;
      char *end;
      double v;
      int overflow;

      if (t->type!=T_DATAINPUT) return Value_new_ERROR(value,BADCONVERSION,_("real"));
      datainput=t->u.datainput;
      v=Value_vald(datainput,&end,&overflow);
      if (end==datainput || (*end!='\0' && *end!=' ' && *end!='\t')) return Value_new_ERROR(value,BADCONVERSION,_("real"));
      if (overflow) return Value_new_ERROR(value,OUTOFRANGE,_("converted value"));
      Value_destroy(l);
      VALUE_NEW_REAL(l,v);
      break;
    }
    case V_STRING:
    {
      Value_destroy(l);
      Value_new_STRING(l);
      if (t->type==T_STRING) String_appendString(&l->u.string,t->u.string);
      else String_appendChars(&l->u.string,t->u.datainput);
      break;
    }
    default: assert(0);
  }
  return (struct Value*)0;
}
/*}}}*/
static struct Value *dataread(struct Value *value, struct Value *l) /*{{{*/
{
  if (curdata.line==-1)
  {
    return Value_new_ERROR(value,ENDOFDATA);
  }
  if (curdata.token->type==T_DATA)
  {
    nextdata=curdata.token->u.nextdata;
    ++curdata.token;
  }
  if (convert(value,l,curdata.token))
  {
    return value;
  }
  ++curdata.token;
  if (curdata.token->type==T_COMMA) ++curdata.token;
  else curdata=nextdata;
  return (struct Value*)0;
}
/*}}}*/
static struct Value more_statements;
#include "statement.c"
static struct Value *statements(struct Value *value) /*{{{*/
{
  more:
  if (pc.token->statement)
  {
    struct Value *v;

    if ((v=pc.token->statement(value)))
    {
      if (v==&more_statements) goto more;
      else return value;
    }
  }
  else return Value_new_ERROR(value,MISSINGSTATEMENT);

  if (FS_intr)
  {
    stopped=1;
    return Value_new_ERROR(value,BREAK);
  }
  else if (pc.token->type==T_COLON && (pc.token+1)->type==T_ELSE) ++pc.token;
  else if ((pc.token->type==T_COLON && (pc.token+1)->type!=T_ELSE) || pc.token->type==T_QUOTE)
  {
    ++pc.token;
    goto more;
  }
  else if ((pass==DECLARE || pass==COMPILE) && pc.token->type!=T_EOL && pc.token->type!=T_ELSE)
  {
    return Value_new_ERROR(value,MISSINGCOLON);
  }
  return Value_new_NIL(value);
}
/*}}}*/

void bas_init(int backslash_colon, int restricted, int uppercase, int print_end, int lpfd) /*{{{*/
{
#ifdef HAVE_GETTEXT
  bindtextdomain("bas",LOCALEDIR);
  textdomain("bas");
#endif
  stack.begindata.line=-1;
  Token_init(backslash_colon,uppercase);
  Global_new(&globals);
  Auto_new(&stack);
  Program_new(&program);
  FS_opendev(STDCHANNEL,0,1);
  FS_opendev(LPCHANNEL,-1,lpfd);
  run_restricted=restricted;
  do_print_end=print_end;
}
/*}}}*/
void bas_runFile(const char *runFile) /*{{{*/
{
  struct Value value;
  int dev;

  new();
  if ((dev=FS_openin(runFile))==-1)
  {
    if (strcmp(runFile,autoBas)==0) return;

    const char *errmsg=FS_errmsg;

    FS_putChars(0,_("bas: Executing `"));
    FS_putChars(0,runFile);
    FS_putChars(0,_("' failed ("));
    FS_putChars(0,errmsg);
    FS_putChars(0,_(").\n"));
  }
  else if (Program_merge(&program,dev,&value))
  {
    struct String s;

    FS_putChars(0,"bas: ");
    String_new(&s);
    Value_toString(&value,&s,' ',-1,0,0,0,0,-1,0,0);
    FS_putString(0,&s);
    String_destroy(&s);
    FS_putChar(0,'\n');
    Value_destroy(&value);
  }
  else
  {
    struct Token line[2];

    Program_setname(&program,runFile);
    line[0].type=T_RUN;
    line[0].statement=stmt_RUN;
    line[1].type=T_EOL;
    line[1].statement=stmt_COLON_EOL;

    FS_close(dev);
    runline(line);
  }
}
/*}}}*/
void bas_runLine(const char *runLine) /*{{{*/
{
  struct Token *line;

  line=Token_newCode(runLine);
  runline(line+1);
  Token_destroy(line);
}
/*}}}*/
void bas_interpreter(void) /*{{{*/
{
  if (FS_istty(STDCHANNEL))
  {
    FS_putChars(STDCHANNEL,"bas " VERSION "\n");
    FS_putChars(STDCHANNEL,"Copyright 1999-2014 Michael Haardt.\n");
    FS_putChars(STDCHANNEL,_("This is free software with ABSOLUTELY NO WARRANTY.\n"));
  }
  new();
  while (1)
  {
    struct Token *line;
    struct String s;

    FS_intr=0; stopped=0;
    FS_allowIntr(1);
    FS_nextline(STDCHANNEL);
    if (FS_istty(STDCHANNEL)) FS_putChars(STDCHANNEL,"> ");
    FS_flush(STDCHANNEL);
    String_new(&s);
    if (FS_appendToString(STDCHANNEL,&s,1)==-1)
    {
      if (FS_intr)
      {
        FS_putChars(STDCHANNEL,_("\nBreak\n"));
        FS_flush(STDCHANNEL);
        String_destroy(&s);
        continue;
      }
      else
      {
        FS_putChars(STDCHANNEL,FS_errmsg);
        FS_flush(STDCHANNEL);
        String_destroy(&s);
        break;
      }
    }
    if (s.length==0)
    {
      String_destroy(&s);
      break;
    }
    line=Token_newCode(s.character);
    String_destroy(&s);
    if (line->type!=T_EOL)
    {
      if (line->type==T_INTEGER && line->u.integer>0)
      {
        if (program.numbered)
        {
          if ((line+1)->type==T_EOL)
          {
            struct Pc where;

            if (Program_goLine(&program,line->u.integer,&where)==(struct Pc*)0) FS_putChars(STDCHANNEL,(NOSUCHLINE));
            else Program_delete(&program,&where,&where);
            Token_destroy(line);
          }
          else Program_store(&program,line,line->u.integer);
        }
        else
        {
          FS_putChars(STDCHANNEL,_("Use `renum' to number program first"));
          Token_destroy(line);
        }
      }
      else if (line->type==T_UNNUMBERED)
      {
        runline(line+1);
        Token_destroy(line);
        if (FS_istty(STDCHANNEL) && bas_end>0)
        {
          if (do_print_end) FS_putChars(STDCHANNEL,_("END program\n"));
          bas_end=0;
        }
      }
      else
      {
        FS_putChars(STDCHANNEL,_("Invalid line\n"));
        Token_destroy(line);
      }
    }
    else Token_destroy(line);
  }
  FS_allowIntr(0);
}
/*}}}*/
void bas_exit(void) /*{{{*/
{
  Auto_destroy(&stack);
  Global_destroy(&globals);
  Program_destroy(&program);
  if (labelStack) free(labelStack);
  FS_closefiles();
  FS_close(LPCHANNEL);
  FS_close(STDCHANNEL);
}
/*}}}*/