"Fossies" - the Fresh Open Source Software Archive

Member "bas-2.6/statement.c" (2 Jul 2019, 112372 Bytes) of package /linux/privat/bas-2.6.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "statement.c" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.5_vs_2.6.

    1 /* #includes */ /*{{{C}}}*//*{{{*/
    2 #include "config.h"
    3 
    4 #ifdef HAVE_GETTEXT
    5 #include <libintl.h>
    6 #define _(String) gettext(String)
    7 #else
    8 #define _(String) String
    9 #endif
   10 
   11 #include "statement.h"
   12 
   13 #ifdef USE_DMALLOC
   14 #include "dmalloc.h"
   15 #endif
   16 /*}}}*/
   17 
   18 struct Value *stmt_CALL(struct Value *value) /*{{{*/
   19 {
   20   ++pc.token;
   21   if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGPROCIDENT);
   22   if (pass==DECLARE)
   23   {
   24     if (func(value)->type==V_ERROR) return value;
   25     else Value_destroy(value);
   26   }
   27   else
   28   {
   29     if (pass==COMPILE)
   30     {
   31       if
   32       (
   33         Global_find(&globals,pc.token->u.identifier,(pc.token+1)->type==T_OP)==0
   34       ) return Value_new_ERROR(value,UNDECLARED);
   35     }
   36     if (pc.token->u.identifier->sym->type!=USERFUNCTION && pc.token->u.identifier->sym->type!=BUILTINFUNCTION) return Value_new_ERROR(value,TYPEMISMATCH1,"variable","function");
   37     func(value);
   38     if (Value_retype(value,V_VOID)->type==V_ERROR) return value;
   39     Value_destroy(value);
   40   }
   41   return (struct Value*)0;
   42 }
   43 /*}}}*/
   44 struct Value *stmt_CASE(struct Value *value) /*{{{*/
   45 {
   46   struct Pc statementpc=pc;
   47 
   48   if (pass==DECLARE || pass==COMPILE)
   49   {
   50     struct Pc *selectcase,*nextcasevalue;
   51 
   52     if ((selectcase=findLabel(L_SELECTCASE))==(struct Pc*)0) return Value_new_ERROR(value,STRAYCASE);
   53     for (nextcasevalue=&selectcase->token->u.selectcase->nextcasevalue; nextcasevalue->line!=-1; nextcasevalue=&nextcasevalue->token->u.casevalue->nextcasevalue);
   54     *nextcasevalue=pc;
   55     if (pass==COMPILE) pc.token->u.casevalue->endselect=selectcase->token->u.selectcase->endselect;
   56     pc.token->u.casevalue->nextcasevalue.line=-1;
   57     ++pc.token; 
   58     switch (statementpc.token->type)
   59     {
   60       case T_CASEELSE: break;
   61       case T_CASEVALUE:
   62       {
   63         struct Pc exprpc;
   64 
   65         do
   66         {
   67           if (pc.token->type==T_IS) /*{{{*/
   68           {
   69             ++pc.token;
   70             switch (pc.token->type)
   71             {
   72               case T_LT:
   73               case T_LE:
   74               case T_EQ:
   75               case T_GE:
   76               case T_GT:
   77               case T_NE: break;
   78               default: return Value_new_ERROR(value,MISSINGRELOP);
   79             }
   80             ++pc.token;
   81             exprpc=pc;
   82             if (eval(value,"`is'")->type==V_ERROR) return value;
   83             if (Value_retype(value,selectcase->token->u.selectcase->type)->type==V_ERROR)
   84             {
   85               pc=exprpc;
   86               return value;
   87             }
   88             Value_destroy(value);        
   89           }
   90           /*}}}*/
   91           else /* value or range */ /*{{{*/
   92           {
   93             exprpc=pc;
   94             if (eval(value,"`case'")->type==V_ERROR) return value;
   95             if (Value_retype(value,selectcase->token->u.selectcase->type)->type==V_ERROR)
   96             {
   97               pc=exprpc;
   98               return value;
   99             }
  100             Value_destroy(value);
  101             if (pc.token->type==T_TO) /*{{{*/
  102             {
  103               ++pc.token;
  104               exprpc=pc;
  105               if (eval(value,"`case'")->type==V_ERROR) return value;
  106               if (Value_retype(value,selectcase->token->u.selectcase->type)->type==V_ERROR)
  107               {
  108                 pc=exprpc;
  109                 return value;
  110               }
  111               Value_destroy(value);
  112             }
  113             /*}}}*/
  114           }
  115           /*}}}*/
  116           if (pc.token->type==T_COMMA) ++pc.token;
  117           else break;
  118         } while (1);
  119         break;
  120       }
  121       default: assert(0);
  122     }
  123   }
  124   else pc=pc.token->u.casevalue->endselect;
  125   return (struct Value*)0;
  126 }
  127 /*}}}*/
  128 struct Value *stmt_CHDIR_MKDIR(struct Value *value) /*{{{*/
  129 {
  130   int res=-1,err=-1;
  131   struct Pc dirpc;
  132   struct Pc statementpc=pc;
  133 
  134   ++pc.token;
  135   dirpc=pc;
  136   if (eval(value,_("directory"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value;
  137   if (pass==INTERPRET)
  138   {
  139     switch (statementpc.token->type)
  140     {
  141       case T_CHDIR: res=chdir(value->u.string.character); break;
  142       case T_MKDIR: res=mkdir(value->u.string.character,0777); break;
  143       default: assert(0);
  144     }
  145     err=errno;
  146   }
  147   Value_destroy(value);
  148   if (pass==INTERPRET && res==-1)
  149   {
  150     pc=dirpc;
  151     return Value_new_ERROR(value,IOERROR,strerror(err));
  152   }
  153   return (struct Value*)0;
  154 }
  155 /*}}}*/
  156 struct Value *stmt_CLEAR(struct Value *value) /*{{{*/
  157 {
  158   if (pass==INTERPRET)
  159   {
  160     Global_clear(&globals);
  161     FS_closefiles();
  162   }
  163   ++pc.token;
  164   return (struct Value*)0;
  165 }
  166 /*}}}*/
  167 struct Value *stmt_CLOSE(struct Value *value) /*{{{*/
  168 {
  169   int hasargs=0;
  170   struct Pc chnpc;
  171 
  172   ++pc.token;
  173   while (1)
  174   {
  175     chnpc=pc;
  176     if (pc.token->type==T_CHANNEL) { hasargs=1; ++pc.token; }
  177     if (eval(value,(const char*)0)==(struct Value*)0)
  178     {
  179       if (hasargs) return Value_new_ERROR(value,MISSINGEXPR,_("channel"));
  180       else break;
  181     }
  182     hasargs=1;
  183     if (value->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
  184     if (pass==INTERPRET && FS_close(value->u.integer)==-1)
  185     {
  186       Value_destroy(value);
  187       pc=chnpc;
  188       return Value_new_ERROR(value,IOERROR,FS_errmsg);
  189     }
  190     if (pc.token->type==T_COMMA) ++pc.token;
  191     else break;
  192   }
  193   if (!hasargs && pass==INTERPRET) FS_closefiles();
  194   return (struct Value*)0;
  195 }
  196 /*}}}*/
  197 struct Value *stmt_CLS(struct Value *value) /*{{{*/
  198 {
  199   struct Pc statementpc=pc;
  200 
  201   ++pc.token;
  202   if (pass==INTERPRET && FS_cls(STDCHANNEL)==-1)
  203   {
  204     pc=statementpc;
  205     return Value_new_ERROR(value,IOERROR,FS_errmsg);
  206   }
  207   return (struct Value*)0;
  208 }
  209 /*}}}*/
  210 struct Value *stmt_COLOR(struct Value *value) /*{{{*/
  211 {
  212   int foreground=-1,background=-1;
  213   struct Pc statementpc=pc;
  214 
  215   ++pc.token;
  216   if (eval(value,(const char*)0))
  217   {
  218     if (value->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value;
  219     foreground=value->u.integer;
  220     if (foreground<0 || foreground>15)
  221     {
  222       Value_destroy(value);
  223       pc=statementpc;
  224       return Value_new_ERROR(value,OUTOFRANGE,_("foreground colour"));
  225     }
  226   }
  227   Value_destroy(value);
  228   if (pc.token->type==T_COMMA)
  229   {
  230     ++pc.token;
  231     if (eval(value,(const char*)0))
  232     {
  233       if (value->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value;
  234       background=value->u.integer;
  235       if (background<0 || background>15)
  236       {
  237         Value_destroy(value);
  238         pc=statementpc;
  239         return Value_new_ERROR(value,OUTOFRANGE,_("background colour"));
  240       }
  241     }
  242     Value_destroy(value);
  243     if (pc.token->type==T_COMMA)
  244     {
  245       ++pc.token;
  246       if (eval(value,(const char*)0))
  247       {
  248         int bordercolour=-1;
  249 
  250         if (value->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value;
  251         bordercolour=value->u.integer;
  252         if (bordercolour<0 || bordercolour>15)
  253         {
  254           Value_destroy(value);
  255           pc=statementpc;
  256           return Value_new_ERROR(value,OUTOFRANGE,_("border colour"));
  257         }
  258       }
  259       Value_destroy(value);
  260     }
  261   }
  262   if (pass==INTERPRET) FS_colour(STDCHANNEL,foreground,background);
  263   return (struct Value*)0;
  264 }
  265 /*}}}*/
  266 struct Value *stmt_DATA(struct Value *value) /*{{{*/
  267 {
  268   if (DIRECTMODE) return Value_new_ERROR(value,NOTINDIRECTMODE);
  269   if (pass==DECLARE)
  270   {
  271     *lastdata=pc;
  272     (lastdata=&(pc.token->u.nextdata))->line=-1;
  273   }
  274   ++pc.token;
  275   while (1)
  276   {
  277     if (pc.token->type!=T_STRING && pc.token->type!=T_DATAINPUT) return Value_new_ERROR(value,MISSINGDATAINPUT);
  278     ++pc.token;
  279     if (pc.token->type!=T_COMMA) break;
  280     else ++pc.token;
  281   }
  282   return (struct Value*)0;
  283 }
  284 /*}}}*/
  285 struct Value *stmt_DEFFN_DEFPROC_FUNCTION_SUB(struct Value *value) /*{{{*/
  286 {
  287   if (pass==DECLARE || pass==COMPILE)
  288   {
  289     struct Pc statementpc=pc;
  290     struct Identifier *fn;
  291     int proc;
  292     int args=0;
  293 
  294     if (DIRECTMODE) return Value_new_ERROR(value,NOTINDIRECTMODE);
  295     proc=(pc.token->type==T_DEFPROC || pc.token->type==T_SUB);
  296     ++pc.token;
  297     if (pc.token->type!=T_IDENTIFIER)
  298     {
  299       if (proc) return Value_new_ERROR(value,MISSINGPROCIDENT);
  300       else return Value_new_ERROR(value,MISSINGFUNCIDENT);
  301     }
  302     fn=pc.token->u.identifier;
  303     if (proc) fn->defaultType=V_VOID;
  304     ++pc.token;
  305     if (findLabel(L_FUNC))
  306     {
  307       pc=statementpc;
  308       return Value_new_ERROR(value,NESTEDDEFINITION);
  309     }
  310     Auto_variable(&stack,fn);
  311     if (pc.token->type==T_OP) /* arguments */ /*{{{*/
  312     {
  313       ++pc.token;
  314       while (1)
  315       {
  316         if (pc.token->type!=T_IDENTIFIER)
  317         {
  318           Auto_funcEnd(&stack);
  319           return Value_new_ERROR(value,MISSINGFORMIDENT);
  320         }
  321         if (Auto_variable(&stack,pc.token->u.identifier)==0)
  322         {
  323           Auto_funcEnd(&stack);
  324           return Value_new_ERROR(value,ALREADYDECLARED);
  325         }
  326         ++args;
  327         ++pc.token;
  328         if (pc.token->type==T_COMMA) ++pc.token;
  329         else break;
  330       }
  331       if (pc.token->type!=T_CP)
  332       {
  333         Auto_funcEnd(&stack);
  334         return Value_new_ERROR(value,MISSINGCP);
  335       }
  336       ++pc.token;
  337     }
  338     /*}}}*/
  339     if (pass==DECLARE)
  340     {
  341       enum ValueType *t=args ? malloc(args*sizeof(enum ValueType)) : (enum ValueType*)0;
  342       int i;
  343 
  344       for (i=0; i<args; ++i) t[i]=Auto_argType(&stack,i);
  345       if (Global_function(&globals,fn,fn->defaultType,&pc,&statementpc,args,t)==0)
  346       {
  347         free(t);
  348         Auto_funcEnd(&stack);
  349         pc=statementpc;
  350         return Value_new_ERROR(value,REDECLARATION);
  351       }
  352       Program_addScope(&program,&fn->sym->u.sub.u.def.scope);
  353     }
  354     pushLabel(L_FUNC,&statementpc);
  355     if (pc.token->type==T_EQ) return stmt_EQ_FNRETURN_FNEND(value);
  356   }
  357   else pc=(pc.token+1)->u.identifier->sym->u.sub.u.def.scope.end;
  358   return (struct Value*)0;
  359 }
  360 /*}}}*/
  361 struct Value *stmt_DEC_INC(struct Value *value) /*{{{*/
  362 {
  363   int step;
  364 
  365   step=(pc.token->type==T_DEC ? -1 : 1);
  366   ++pc.token;
  367   while (1)
  368   {
  369     struct Value *l,stepValue;
  370     struct Pc lvaluepc;
  371 
  372     lvaluepc=pc;
  373     if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGDECINCIDENT);
  374     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)
  375     {
  376       return Value_new_ERROR(value,REDECLARATION);
  377     }
  378     if ((l=lvalue(value))->type==V_ERROR) return value;
  379     if (l->type==V_INTEGER) VALUE_NEW_INTEGER(&stepValue,step);
  380     else if (l->type==V_REAL) VALUE_NEW_REAL(&stepValue,(double)step);
  381     else
  382     {
  383       pc=lvaluepc;
  384       return Value_new_ERROR(value,TYPEMISMATCH5);
  385     }
  386     if (pass==INTERPRET) Value_add(l,&stepValue,1);
  387     Value_destroy(&stepValue);
  388     if (pc.token->type==T_COMMA) ++pc.token;
  389     else break;
  390   }
  391   return (struct Value*)0;
  392 }
  393 /*}}}*/
  394 struct Value *stmt_DEFINT_DEFDBL_DEFSTR(struct Value *value) /*{{{*/
  395 {
  396   enum ValueType dsttype=V_NIL;
  397 
  398   switch (pc.token->type)
  399   {
  400     case T_DEFINT: dsttype=V_INTEGER; break;
  401     case T_DEFDBL: dsttype=V_REAL; break;
  402     case T_DEFSTR: dsttype=V_STRING; break;
  403     default: assert(0);
  404   }
  405   ++pc.token;
  406   while (1)
  407   {
  408     struct Identifier *ident;
  409 
  410     if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT);
  411     if (pc.token->u.identifier->defaultType!=V_REAL) switch (dsttype)
  412     {
  413       case V_INTEGER: return Value_new_ERROR(value,BADIDENTIFIER,_("integer"));
  414       case V_REAL: return Value_new_ERROR(value,BADIDENTIFIER,_("real"));
  415       case V_STRING: return Value_new_ERROR(value,BADIDENTIFIER,_("string"));
  416       default: assert(0);
  417     }
  418     ident=pc.token->u.identifier;
  419     ++pc.token;
  420     if (pc.token->type==T_MINUS)
  421     {
  422       struct Identifier i;
  423 
  424       if (strlen(ident->name)!=1) return Value_new_ERROR(value,BADRANGE);
  425       ++pc.token;
  426       if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT);
  427       if (strlen(pc.token->u.identifier->name)!=1) return Value_new_ERROR(value,BADRANGE);
  428       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])
  429       {
  430         Global_variable(&globals,&i,dsttype,GLOBALVAR,1);
  431       }
  432       ++pc.token;
  433     }
  434     else Global_variable(&globals,ident,dsttype,GLOBALVAR,1);
  435     if (pc.token->type==T_COMMA) ++pc.token;
  436     else break;
  437   }
  438   return (struct Value*)0;
  439 }
  440 /*}}}*/
  441 struct Value *stmt_DELETE(struct Value *value) /*{{{*/
  442 {
  443   struct Pc from,to;
  444   int f=0,t=0;
  445 
  446   if (pass==INTERPRET && !DIRECTMODE) return Value_new_ERROR(value,NOTINPROGRAMMODE);
  447   ++pc.token;
  448   if (pc.token->type==T_INTEGER)
  449   {
  450     if (pass==INTERPRET && Program_goLine(&program,pc.token->u.integer,&from)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE);
  451     f=1;
  452     ++pc.token;
  453   }
  454   if (pc.token->type==T_MINUS || pc.token->type==T_COMMA)
  455   {
  456     ++pc.token;
  457     if (pc.token->type==T_INTEGER)
  458     {
  459       if (pass==INTERPRET && Program_goLine(&program,pc.token->u.integer,&to)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE);
  460       t=1;
  461       ++pc.token;
  462     }
  463   }
  464   else if (f==1)
  465   {
  466     to=from;
  467     t=1;
  468   }
  469   if (!f && !t) return Value_new_ERROR(value,MISSINGLINENUMBER);
  470   if (pass==INTERPRET)
  471   {
  472     Program_delete(&program,f?&from:(struct Pc*)0,t?&to:(struct Pc*)0);
  473   }
  474   return (struct Value*)0;
  475 }
  476 /*}}}*/
  477 struct Value *stmt_DIM(struct Value *value) /*{{{*/
  478 {
  479   ++pc.token;
  480   while (1)
  481   {
  482     unsigned int capacity=0,*geometry=(unsigned int*)0;
  483     struct Var *var;
  484     struct Pc dimpc;
  485     unsigned int dim;
  486     enum ValueType vartype;
  487 
  488     if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGARRIDENT);
  489     if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0)
  490     {
  491       return Value_new_ERROR(value,REDECLARATION);
  492     }
  493     var=&pc.token->u.identifier->sym->u.var;
  494     if (pass==INTERPRET && var->dim) return Value_new_ERROR(value,REDIM);
  495     vartype=var->type;
  496     ++pc.token;
  497     if (pc.token->type!=T_OP) return Value_new_ERROR(value,MISSINGOP);
  498     ++pc.token;
  499     dim=0;
  500     while (1)
  501     {
  502       dimpc=pc;
  503       if (eval(value,_("dimension"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR))
  504       {
  505         if (capacity) free(geometry);
  506         return value;
  507       }
  508       if (pass==INTERPRET && value->u.integer<optionbase) /* error */ /*{{{*/
  509       {
  510         Value_destroy(value);
  511         Value_new_ERROR(value,OUTOFRANGE,_("dimension"));
  512       }
  513       /*}}}*/
  514       if (value->type==V_ERROR) /* abort */ /*{{{*/
  515       {
  516         if (capacity) free(geometry);
  517         pc=dimpc;
  518         return value;
  519       }
  520       /*}}}*/
  521       if (pass==INTERPRET)
  522       {
  523         if (dim==capacity) /* enlarge geometry */ /*{{{*/
  524         {
  525           unsigned int *more;
  526 
  527           more=realloc(geometry,sizeof(unsigned int)*(capacity?(capacity*=2):(capacity=3)));
  528           geometry=more;
  529         }
  530         /*}}}*/
  531         geometry[dim]=value->u.integer-optionbase+1;
  532         ++dim;
  533       }
  534       Value_destroy(value);
  535       if (pc.token->type==T_COMMA) ++pc.token;
  536       else break;
  537     }
  538     if (pc.token->type!=T_CP) /* abort */ /*{{{*/
  539     {
  540       if (capacity) free(geometry);
  541       return Value_new_ERROR(value,MISSINGCP);
  542     }
  543     /*}}}*/
  544     ++pc.token;
  545     if (pass==INTERPRET)
  546     {
  547       struct Var newarray;
  548 
  549       assert(capacity);
  550       if (Var_new(&newarray,vartype,dim,geometry,optionbase)==(struct Var*)0)
  551       {
  552         free(geometry);
  553         return Value_new_ERROR(value,OUTOFMEMORY);
  554       }
  555       Var_destroy(var);
  556       *var=newarray;
  557       free(geometry);
  558     }
  559     if (pc.token->type==T_COMMA) ++pc.token; /* advance to next var */ 
  560     else break;
  561   }
  562   return (struct Value*)0;
  563 }
  564 /*}}}*/
  565 struct Value *stmt_DISPLAY(struct Value *value) /*{{{*/
  566 {
  567   struct Pc statementpc=pc;
  568 
  569   ++pc.token;
  570   if (eval(value,_("file name"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_STRING)->type==V_ERROR)) return value;
  571   if (pass==INTERPRET && cat(value->u.string.character)==-1)
  572   {
  573     char *msg=strerror(errno);
  574 
  575     Value_destroy(value);
  576     pc=statementpc;
  577     return Value_new_ERROR(value,IOERROR,msg);
  578   }
  579   else Value_destroy(value);
  580   return (struct Value*)0;
  581 }
  582 /*}}}*/
  583 struct Value *stmt_DO(struct Value *value) /*{{{*/
  584 {
  585   if (pass==DECLARE || pass==COMPILE) pushLabel(L_DO,&pc);
  586   ++pc.token;
  587   return (struct Value*)0;
  588 }
  589 /*}}}*/
  590 struct Value *stmt_DOcondition(struct Value *value) /*{{{*/
  591 {
  592   struct Pc dowhilepc=pc;
  593   int negate=(pc.token->type==T_DOUNTIL);
  594 
  595   if (pass==DECLARE || pass==COMPILE) pushLabel(L_DOcondition,&pc);
  596   ++pc.token;
  597   if (eval(value,"condition")->type==V_ERROR) return value;
  598   if (pass==INTERPRET)
  599   {
  600     int condition;
  601 
  602     condition=Value_isNull(value);
  603     if (negate) condition=!condition;
  604     if (condition) pc=dowhilepc.token->u.exitdo;
  605     Value_destroy(value);
  606   }
  607   return (struct Value*)0;
  608 }
  609 /*}}}*/
  610 struct Value *stmt_EDIT(struct Value *value) /*{{{*/
  611 {
  612   long int line;
  613   struct Pc statementpc=pc;
  614 
  615   ++pc.token;
  616   if (pc.token->type==T_INTEGER)
  617   {
  618     struct Pc where;
  619 
  620     if (program.numbered)
  621     {
  622       if (Program_goLine(&program,pc.token->u.integer,&where)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE);
  623       line=where.line+1;
  624     }
  625     else
  626     {
  627       if (!Program_end(&program,&where)) return Value_new_ERROR(value,NOPROGRAM);
  628       line=pc.token->u.integer;
  629       if (line<1 || line>(where.line+1)) return Value_new_ERROR(value,NOSUCHLINE);
  630     }
  631     ++pc.token;
  632   }
  633   else line=1;
  634   if (pass==INTERPRET)
  635   {
  636     /* variables */ /*{{{*/
  637     char *name;
  638     int chn;
  639     struct Program newProgram;
  640     const char *visual,*basename,*shell;
  641     struct String cmd;
  642     static struct
  643     {
  644       const char *editor,*flag;
  645     }
  646     gotoLine[]=
  647     {
  648       { "Xemacs", "+%ld " },
  649       { "cemacs", "+%ld " },
  650       { "emacs", "+%ld " },
  651       { "emori", "-l%ld " },
  652       { "fe", "-l%ld " },
  653       { "jed", "+%ld " },
  654       { "jmacs", "+%ld " },
  655       { "joe", "+%ld " },
  656       { "modeori", "-l%ld " },
  657       { "nano", "+%ld " },
  658       { "origami", "-l%ld " },
  659       { "vi", "-c%ld " }, 
  660       { "vim", "+%ld " },
  661       { "xemacs", "+%ld " }
  662     };
  663     unsigned int i;
  664     pid_t pid;
  665     /*}}}*/
  666 
  667     if (!DIRECTMODE)
  668     {
  669       pc=statementpc;
  670       return Value_new_ERROR(value,NOTINPROGRAMMODE);
  671     }
  672     if ((name=mytmpnam())==(char*)0)
  673     {
  674       pc=statementpc;
  675       return Value_new_ERROR(value,IOERROR,_("generating temporary file name failed"));
  676     }
  677     if ((chn=FS_openout(name))==-1)
  678     {
  679       pc=statementpc;
  680       return Value_new_ERROR(value,IOERRORCREATE,name,FS_errmsg);
  681     }
  682     FS_width(chn,0);
  683     if (Program_list(&program,chn,0,(struct Pc*)0,(struct Pc*)0,value))
  684     {
  685       pc=statementpc;
  686       return value;
  687     }
  688     if (FS_close(chn)==-1)
  689     {
  690       pc=statementpc;
  691       unlink(name);
  692       return Value_new_ERROR(value,IOERRORCLOSE,name,FS_errmsg);
  693     }
  694     if ((visual=getenv("VISUAL"))==(char*)0 && (visual=getenv("EDITOR"))==(char*)0) visual="vi";
  695     basename=strrchr(visual,'/');
  696     if (basename==(char*)0) basename=visual;
  697     if ((shell=getenv("SHELL"))==(char*)0) shell="/bin/sh";
  698     String_new(&cmd);
  699     String_appendChars(&cmd,visual);
  700     String_appendChar(&cmd,' ');
  701     for (i=0; i<sizeof(gotoLine)/sizeof(gotoLine[0]); ++i)
  702     {
  703       if (strcmp(basename,gotoLine[i].editor)==0)
  704       {
  705         String_appendPrintf(&cmd,gotoLine[i].flag,line);
  706         break;
  707       }
  708     }
  709     String_appendChars(&cmd,name);
  710     FS_shellmode(STDCHANNEL);
  711     switch (pid=fork())
  712     {
  713       case -1:
  714       {
  715         unlink(name);
  716         FS_fsmode(STDCHANNEL);
  717         return Value_new_ERROR(value,FORKFAILED,strerror(errno));
  718       }
  719       case 0:
  720       {
  721         execl(shell,shell,"-c",cmd.character,(const char*)0);
  722         exit(127);
  723       }
  724       default:
  725       {
  726         pid_t r;
  727 
  728         while ((r=wait((int*)0))!=-1 && r!=pid);
  729       }
  730     }
  731     FS_fsmode(STDCHANNEL);
  732     String_destroy(&cmd);
  733     if ((chn=FS_openin(name))==-1)
  734     {
  735       pc=statementpc;
  736       return Value_new_ERROR(value,IOERROROPEN,name,FS_errmsg);
  737     }
  738     Program_new(&newProgram);
  739     if (Program_merge(&newProgram,chn,value))
  740     {
  741       FS_close(chn);
  742       unlink(name);
  743       pc=statementpc;
  744       return value;
  745     }
  746     FS_close(chn);
  747     Program_setname(&newProgram,program.name.character);
  748     Program_destroy(&program);
  749     program=newProgram;
  750     unlink(name);
  751   }
  752   return (struct Value*)0;
  753 }
  754 /*}}}*/
  755 struct Value *stmt_ELSE_ELSEIFELSE(struct Value *value) /*{{{*/
  756 {
  757   if (pass==INTERPRET)
  758   {
  759     pc=pc.token->u.endifpc;
  760   }
  761   if (pass==DECLARE || pass==COMPILE)
  762   {
  763     struct Pc elsepc=pc;
  764     struct Pc *ifinstr;
  765     int elseifelse=(pc.token->type==T_ELSEIFELSE);
  766 
  767     if ((ifinstr=popLabel(L_IF))==(struct Pc*)0) return Value_new_ERROR(value,STRAYELSE1);
  768     if (ifinstr->token->type==T_ELSEIFIF) (ifinstr->token-1)->u.elsepc=pc;
  769     ++pc.token;
  770     ifinstr->token->u.elsepc=pc;
  771     assert(ifinstr->token->type==T_ELSEIFIF || ifinstr->token->type==T_IF);
  772     if (elseifelse) return &more_statements;
  773     else pushLabel(L_ELSE,&elsepc);
  774   }
  775   return (struct Value*)0;
  776 }
  777 /*}}}*/
  778 struct Value *stmt_END(struct Value *value) /*{{{*/
  779 {
  780   if (pass==INTERPRET)
  781   {
  782     pc=pc.token->u.endpc;
  783     bas_end=1;
  784   }
  785   if (pass==DECLARE || pass==COMPILE)
  786   {
  787     if (Program_end(&program,&pc.token->u.endpc)) ++pc.token;
  788     else
  789     {
  790       struct Token *eol;
  791 
  792       for (eol=pc.token; eol->type!=T_EOL; ++eol);
  793       
  794       pc.token->u.endpc=pc;
  795       pc.token->u.endpc.token=eol;
  796       ++pc.token;
  797     }
  798 #if 0
  799     else return Value_new_ERROR(value,NOPROGRAM);
  800 #endif
  801   }
  802   return (struct Value*)0;
  803 }
  804 /*}}}*/
  805 struct Value *stmt_ENDIF(struct Value *value) /*{{{*/
  806 {
  807   if (pass==DECLARE || pass==COMPILE)
  808   {
  809     struct Pc endifpc=pc;
  810     struct Pc *ifpc;
  811     struct Pc *elsepc;
  812 
  813     if ((ifpc=popLabel(L_IF)))
  814     {
  815       ifpc->token->u.elsepc=endifpc;
  816       if (ifpc->token->type==T_ELSEIFIF) (ifpc->token-1)->u.elsepc=pc;
  817     }
  818     else if ((elsepc=popLabel(L_ELSE))) elsepc->token->u.endifpc=endifpc;
  819     else return Value_new_ERROR(value,STRAYENDIF);
  820   }
  821   ++pc.token;
  822   return (struct Value*)0;
  823 }
  824 /*}}}*/
  825 struct Value *stmt_ENDFN(struct Value *value) /*{{{*/
  826 {
  827   struct Pc *curfn=(struct Pc*)0;
  828   struct Pc eqpc=pc;
  829 
  830   if (pass==DECLARE || pass==COMPILE)
  831   {
  832     if ((curfn=popLabel(L_FUNC))==(struct Pc*)0) return Value_new_ERROR(value,STRAYENDFN);
  833     if ((eqpc.token->u.type=(curfn->token+1)->u.identifier->defaultType)==V_VOID) return Value_new_ERROR(value,STRAYENDFN);
  834   }
  835   ++pc.token;
  836   if (pass==INTERPRET) return Value_clone(value,Var_value(Auto_local(&stack,0),0,(int*)0,(struct Value*)0));
  837   else
  838   {
  839     if (pass==DECLARE) Global_endfunction(&globals,(curfn->token+1)->u.identifier,&pc);
  840     Auto_funcEnd(&stack);
  841   }
  842   return (struct Value*)0;
  843 }
  844 /*}}}*/
  845 struct Value *stmt_ENDPROC_SUBEND(struct Value *value) /*{{{*/
  846 {
  847   struct Pc *curfn=(struct Pc*)0;
  848 
  849   if (pass==DECLARE || pass==COMPILE)
  850   {
  851     if ((curfn=popLabel(L_FUNC))==(struct Pc*)0 || (curfn->token+1)->u.identifier->defaultType!=V_VOID)
  852     {
  853       if (curfn!=(struct Pc*)0) pushLabel(L_FUNC,curfn);
  854       return Value_new_ERROR(value,STRAYSUBEND,topLabelDescription());
  855     }
  856   }
  857   ++pc.token;
  858   if (pass==INTERPRET) return Value_new_VOID(value);
  859   else
  860   {
  861     if (pass==DECLARE) Global_endfunction(&globals,(curfn->token+1)->u.identifier,&pc);
  862     Auto_funcEnd(&stack);
  863   }
  864   return (struct Value*)0;
  865 }
  866 /*}}}*/
  867 struct Value *stmt_ENDSELECT(struct Value *value) /*{{{*/
  868 {
  869   struct Pc statementpc=pc;
  870 
  871   ++pc.token;
  872   if (pass==DECLARE || pass==COMPILE)
  873   {
  874     struct Pc *selectcasepc;
  875 
  876     if ((selectcasepc=popLabel(L_SELECTCASE))) selectcasepc->token->u.selectcase->endselect=pc;
  877     else
  878     {
  879       pc=statementpc;
  880       return Value_new_ERROR(value,STRAYENDSELECT);
  881     }
  882   }
  883   return (struct Value*)0;
  884 }
  885 /*}}}*/
  886 struct Value *stmt_ENVIRON(struct Value *value) /*{{{*/
  887 {
  888   struct Pc epc=pc;
  889 
  890   ++pc.token;
  891   if (eval(value,_("environment variable"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value;
  892   if (pass==INTERPRET && value->u.string.character)
  893   {
  894     if (putenv(value->u.string.character)==-1)
  895     {
  896       Value_destroy(value);
  897       pc=epc;
  898       return Value_new_ERROR(value,ENVIRONFAILED,strerror(errno));
  899     }
  900   }
  901   Value_destroy(value);
  902   return (struct Value*)0;
  903 }
  904 /*}}}*/
  905 struct Value *stmt_FNEXIT(struct Value *value) /*{{{*/
  906 {
  907   struct Pc *curfn=(struct Pc*)0;
  908 
  909   if (pass==DECLARE || pass==COMPILE)
  910   {
  911     if ((curfn=findLabel(L_FUNC))==(struct Pc*)0 || (curfn->token+1)->u.identifier->defaultType==V_VOID)
  912     {
  913       return Value_new_ERROR(value,STRAYFNEXIT);
  914     }
  915   }
  916   ++pc.token;
  917   if (pass==INTERPRET) return Value_clone(value,Var_value(Auto_local(&stack,0),0,(int*)0,(struct Value*)0));
  918   return (struct Value*)0;
  919 }
  920 /*}}}*/
  921 struct Value *stmt_COLON_EOL(struct Value *value) /*{{{*/
  922 {
  923   return (struct Value*)0;
  924 }
  925 /*}}}*/
  926 struct Value *stmt_QUOTE_REM(struct Value *value) /*{{{*/
  927 {
  928   ++pc.token;
  929   return (struct Value*)0;
  930 }
  931 /*}}}*/
  932 struct Value *stmt_EQ_FNRETURN_FNEND(struct Value *value) /*{{{*/
  933 {
  934   struct Pc *curfn=(struct Pc*)0;
  935   struct Pc eqpc=pc;
  936   enum TokenType t=pc.token->type;
  937 
  938   if (pass==DECLARE || pass==COMPILE)
  939   {
  940     if (t==T_EQ)
  941     {
  942       if ((curfn=popLabel(L_FUNC))==(struct Pc*)0) return Value_new_ERROR(value,STRAYENDEQ);
  943       if ((eqpc.token->u.type=(curfn->token+1)->u.identifier->defaultType)==V_VOID) return Value_new_ERROR(value,STRAYENDEQ);
  944     }
  945     else if (t==T_FNEND)
  946     {
  947       if ((curfn=popLabel(L_FUNC))==(struct Pc*)0) return Value_new_ERROR(value,STRAYENDFN);
  948       if ((eqpc.token->u.type=(curfn->token+1)->u.identifier->defaultType)==V_VOID) return Value_new_ERROR(value,STRAYENDFN);
  949     }
  950     else
  951     {
  952       if ((curfn=findLabel(L_FUNC))==(struct Pc*)0) return Value_new_ERROR(value,STRAYFNRETURN);
  953       if ((eqpc.token->u.type=(curfn->token+1)->u.identifier->defaultType)==V_VOID) return Value_new_ERROR(value,STRAYFNRETURN);
  954     }
  955   }
  956   ++pc.token;
  957   if (eval(value,_("return"))->type==V_ERROR || Value_retype(value,eqpc.token->u.type)->type==V_ERROR)
  958   {
  959     if (pass!=INTERPRET) Auto_funcEnd(&stack);
  960     pc=eqpc;
  961     return value;
  962   }
  963   if (pass==INTERPRET) return value;
  964   else
  965   {
  966     Value_destroy(value);
  967     if (t==T_EQ || t==T_FNEND)
  968     {
  969       if (pass==DECLARE) Global_endfunction(&globals,(curfn->token+1)->u.identifier,&pc);
  970       Auto_funcEnd(&stack);
  971     }
  972   }
  973   return (struct Value*)0;
  974 }
  975 /*}}}*/
  976 struct Value *stmt_ERASE(struct Value *value) /*{{{*/
  977 {
  978   ++pc.token;
  979   while (1)
  980   {
  981     if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGARRIDENT);
  982     if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0)
  983     {
  984       return Value_new_ERROR(value,REDECLARATION);
  985     }
  986     if (pass==INTERPRET)
  987     {
  988       Var_destroy(&pc.token->u.identifier->sym->u.var);
  989     }
  990     ++pc.token;
  991     if (pc.token->type==T_COMMA) ++pc.token;
  992     else break;
  993   }
  994   return (struct Value*)0;
  995 }
  996 /*}}}*/
  997 struct Value *stmt_EXITDO(struct Value *value) /*{{{*/
  998 {
  999   if (pass==INTERPRET) pc=pc.token->u.exitdo;
 1000   else
 1001   {
 1002     if (pass==COMPILE)
 1003     {
 1004       struct Pc *exitdo;
 1005 
 1006       if ((exitdo=findLabel(L_DO))==(struct Pc*)0 && (exitdo=findLabel(L_DOcondition))==(struct Pc*)0) return Value_new_ERROR(value,STRAYEXITDO);
 1007       pc.token->u.exitdo=exitdo->token->u.exitdo;
 1008     }
 1009     ++pc.token;
 1010   }
 1011   return (struct Value*)0;
 1012 }
 1013 /*}}}*/
 1014 struct Value *stmt_EXITFOR(struct Value *value) /*{{{*/
 1015 {
 1016   if (pass==INTERPRET) pc=pc.token->u.exitfor;
 1017   else
 1018   {
 1019     if (pass==COMPILE)
 1020     {
 1021       struct Pc *exitfor;
 1022 
 1023       if ((exitfor=findLabel(L_FOR))==(struct Pc*)0) return Value_new_ERROR(value,STRAYEXITFOR);
 1024       pc.token->u.exitfor=exitfor->token->u.exitfor;
 1025     }
 1026     ++pc.token;
 1027   }
 1028   return (struct Value*)0;
 1029 }
 1030 /*}}}*/
 1031 struct Value *stmt_FIELD(struct Value *value) /*{{{*/
 1032 {
 1033   long int chn,offset,recLength=-1;
 1034 
 1035   ++pc.token;
 1036   if (pc.token->type==T_CHANNEL) ++pc.token;
 1037   if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 1038   chn=value->u.integer;
 1039   Value_destroy(value);
 1040   if (pass==INTERPRET && (recLength=FS_recLength(chn))==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 1041   if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA);
 1042   ++pc.token;
 1043   offset=0;
 1044   while (1)
 1045   {
 1046     struct Pc curpc;
 1047     struct Value *l;
 1048     long int width;
 1049 
 1050     curpc=pc;
 1051     if (eval(value,_("field width"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 1052     width=value->u.integer;
 1053     Value_destroy(value);
 1054     if (pass==INTERPRET && offset+width>recLength)
 1055     {
 1056       pc=curpc;
 1057       return Value_new_ERROR(value,OUTOFRANGE,_("field width"));
 1058     }
 1059     if (pc.token->type!=T_AS) return Value_new_ERROR(value,MISSINGAS);
 1060     ++pc.token;
 1061     curpc=pc;
 1062     if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT);
 1063     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)
 1064     {
 1065       return Value_new_ERROR(value,REDECLARATION);
 1066     }
 1067     if ((l=lvalue(value))->type==V_ERROR) return value;
 1068     if (pass!=DECLARE && l->type!=V_STRING)
 1069     {
 1070       pc=curpc;
 1071       return Value_new_ERROR(value,TYPEMISMATCH4);
 1072     }
 1073     if (pass==INTERPRET) FS_field(chn,&l->u.string,offset,width);
 1074     offset+=width;
 1075     if (pc.token->type==T_COMMA) ++pc.token;
 1076     else break;
 1077   }
 1078   return (struct Value*)0;
 1079 }
 1080 /*}}}*/
 1081 struct Value *stmt_FILES(struct Value *value) /*{{{*/
 1082 {
 1083   struct Pc curpc;
 1084   pid_t pid;
 1085   int status;
 1086 
 1087   ++pc.token;
 1088   curpc=pc;
 1089   if (eval(value,_("file specification"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR)
 1090   {
 1091     Value_destroy(value);
 1092     Value_new_STRING(value);
 1093     pc=curpc;
 1094   }
 1095   if (pass==INTERPRET)
 1096   {
 1097     String_quote(&value->u.string);
 1098     String_insertChar(&value->u.string, 0, 'l');
 1099     String_insertChar(&value->u.string, 1, 's');
 1100     String_insertChar(&value->u.string, 2, ' ');
 1101     String_insertChar(&value->u.string, 3, '-');
 1102     String_insertChar(&value->u.string, 4, 'l');
 1103     String_insertChar(&value->u.string, 5, ' ');
 1104     FS_shellmode(STDCHANNEL);
 1105     switch (pid=fork())
 1106     {
 1107       case -1:
 1108       {
 1109         FS_fsmode(STDCHANNEL);
 1110         Value_destroy(value);
 1111         return Value_new_ERROR(value,FORKFAILED,strerror(errno));
 1112       }
 1113       case 0:
 1114       {
 1115         execl("/bin/sh","sh","-c",value->u.string.character,(const char*)0);
 1116         exit(127);
 1117       }
 1118       default:
 1119       {
 1120         while (waitpid(pid,&status,0)==-1 && errno!=EINTR);
 1121       }
 1122     }
 1123     FS_fsmode(STDCHANNEL);
 1124   }
 1125   Value_destroy(value);
 1126   return (struct Value*)0;
 1127 }
 1128 /*}}}*/
 1129 struct Value *stmt_FOR(struct Value *value) /*{{{*/
 1130 {
 1131   struct Pc forpc=pc;
 1132   struct Pc varpc;
 1133   struct Pc limitpc;
 1134   struct Value limit,stepValue;
 1135 
 1136   ++pc.token;
 1137   varpc=pc;
 1138   if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGLOOPIDENT);
 1139   if (assign(value)->type==V_ERROR) return value;
 1140   if (pass==INTERPRET)
 1141   {
 1142     ++pc.token;
 1143     if (eval(&limit,(const char*)0)->type==V_ERROR)
 1144     {
 1145       *value=limit;
 1146       return value;
 1147     }
 1148     Value_retype(&limit,value->type);
 1149     assert(limit.type!=V_ERROR);
 1150     if (pc.token->type==T_STEP) /* STEP x */ /*{{{*/
 1151     {
 1152       struct Pc stepPc,stepValuePc;
 1153 
 1154       stepPc=pc;
 1155       ++pc.token;
 1156       stepValuePc=pc;
 1157       if (eval(&stepValue,"`step'")->type==V_ERROR)
 1158       {
 1159         Value_destroy(value);
 1160         *value=stepValue;
 1161         pc=stepValuePc;
 1162         return value;
 1163       }
 1164       Value_retype(&stepValue,value->type);
 1165       assert(stepValue.type!=V_ERROR);
 1166       Value_destroy(&stepPc.token->u.step);
 1167       Value_clone(&stepPc.token->u.step,&stepValue);
 1168     }
 1169     /*}}}*/
 1170     else /* implicit numeric STEP */ /*{{{*/
 1171     {
 1172       if (value->type==V_INTEGER) VALUE_NEW_INTEGER(&stepValue,1);
 1173       else VALUE_NEW_REAL(&stepValue,1.0);
 1174     }
 1175     /*}}}*/
 1176     if (Value_exitFor(value,&limit,&stepValue)) pc=forpc.token->u.exitfor;
 1177     Value_destroy(&limit);
 1178     Value_destroy(&stepValue);
 1179     Value_destroy(value);
 1180   }
 1181   else
 1182   {
 1183     pushLabel(L_FOR,&forpc);
 1184     pushLabel(L_FOR_VAR,&varpc);
 1185     if (pc.token->type!=T_TO)
 1186     {
 1187       Value_destroy(value);
 1188       return Value_new_ERROR(value,MISSINGTO);
 1189     }
 1190     ++pc.token;
 1191     pushLabel(L_FOR_LIMIT,&pc);
 1192     limitpc=pc;
 1193     if (eval(&limit,(const char*)0)==(struct Value*)0)
 1194     {
 1195       Value_destroy(value);
 1196       return Value_new_ERROR(value,MISSINGEXPR,"`to'");
 1197     }
 1198     if (limit.type==V_ERROR)
 1199     {
 1200       Value_destroy(value);
 1201       *value=limit;
 1202       return value;
 1203     }
 1204     if (pass!=DECLARE)
 1205     {
 1206       struct Symbol *sym=varpc.token->u.identifier->sym;
 1207 
 1208       if (VALUE_RETYPE(&limit,sym->type==GLOBALVAR || sym->type==GLOBALARRAY ? sym->u.var.type : Auto_varType(&stack,sym))->type==V_ERROR)
 1209       {
 1210         Value_destroy(value);
 1211         *value=limit;
 1212         pc=limitpc;
 1213         return value;
 1214       }
 1215     }
 1216     Value_destroy(&limit);
 1217     if (pc.token->type==T_STEP) /* STEP x */ /*{{{*/
 1218     {
 1219       struct Pc stepPc;
 1220 
 1221       ++pc.token;
 1222       stepPc=pc;
 1223       if (eval(&stepValue,"`step'")->type==V_ERROR || (pass!=DECLARE && Value_retype(&stepValue,value->type)->type==V_ERROR))
 1224       {
 1225         Value_destroy(value);
 1226         *value=stepValue;
 1227         pc=stepPc;
 1228         return value;
 1229       }
 1230     }
 1231     /*}}}*/
 1232     else /* implicit numeric STEP */ /*{{{*/
 1233     {
 1234       VALUE_NEW_INTEGER(&stepValue,1);
 1235       if (pass!=DECLARE && VALUE_RETYPE(&stepValue,value->type)->type==V_ERROR)
 1236       {
 1237         Value_destroy(value);
 1238         *value=stepValue;
 1239         Value_errorPrefix(value,_("implicit STEP 1:"));
 1240         return value;
 1241       }
 1242     }
 1243     /*}}}*/
 1244     pushLabel(L_FOR_BODY,&pc);
 1245     Value_destroy(&stepValue);
 1246     Value_destroy(value);
 1247   }
 1248   return (struct Value*)0;
 1249 }
 1250 /*}}}*/
 1251 struct Value *stmt_GET_PUT(struct Value *value) /*{{{*/
 1252 {
 1253   struct Pc statementpc=pc;
 1254   int put=pc.token->type==T_PUT;
 1255   long int chn;
 1256   struct Pc errpc;
 1257       
 1258   ++pc.token;
 1259   if (pc.token->type==T_CHANNEL) ++pc.token;
 1260   if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 1261   chn=value->u.integer;
 1262   Value_destroy(value);
 1263   if (pc.token->type==T_COMMA)
 1264   {
 1265     ++pc.token;
 1266     errpc=pc;
 1267     if (eval(value,(const char*)0)) /* process record number/position */ /*{{{*/
 1268     {
 1269       int rec;
 1270 
 1271       if (value->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 1272       rec=value->u.integer;
 1273       Value_destroy(value);
 1274       if (pass==INTERPRET)
 1275       {
 1276         if (rec<1)
 1277         {
 1278           pc=errpc;
 1279           return Value_new_ERROR(value,OUTOFRANGE,_("record number"));
 1280         }
 1281         if (FS_seek((int)chn,rec-1)==-1)
 1282         {
 1283           pc=statementpc;
 1284           return Value_new_ERROR(value,IOERROR,FS_errmsg);
 1285         }
 1286       }
 1287     }
 1288     /*}}}*/
 1289   }
 1290   if (pc.token->type==T_COMMA) /* BINARY mode get/put */ /*{{{*/
 1291   {
 1292     int res=-1;
 1293 
 1294     ++pc.token;
 1295     if (put)
 1296     {
 1297       if (eval(value,_("`put'/`get' data"))->type==V_ERROR) return value;
 1298       if (pass==INTERPRET)
 1299       {
 1300         switch (value->type)
 1301         {
 1302           case V_INTEGER: res=FS_putbinaryInteger(chn,value->u.integer); break;
 1303           case V_REAL: res=FS_putbinaryReal(chn,value->u.real); break;
 1304           case V_STRING: res=FS_putbinaryString(chn,&value->u.string); break;
 1305           default: assert(0);
 1306         }
 1307       }
 1308       Value_destroy(value);
 1309     }
 1310     else
 1311     {
 1312       struct Value *l;
 1313 
 1314       if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGPROCIDENT);
 1315       if (pass==DECLARE)
 1316       {
 1317         if
 1318         (
 1319           ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0)
 1320           && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0
 1321         )
 1322         {
 1323           return Value_new_ERROR(value,REDECLARATION);
 1324         }
 1325       }
 1326       if ((l=lvalue(value))->type==V_ERROR) return value;
 1327       if (pass==INTERPRET)
 1328       {
 1329         switch (l->type)
 1330         {
 1331           case V_INTEGER: res=FS_getbinaryInteger(chn,&l->u.integer); break;
 1332           case V_REAL: res=FS_getbinaryReal(chn,&l->u.real); break;
 1333           case V_STRING: res=FS_getbinaryString(chn,&l->u.string); break;
 1334           default: assert(0);
 1335         }
 1336       }
 1337     }
 1338     if (pass==INTERPRET && res==-1)
 1339     {
 1340       pc=statementpc;
 1341       return Value_new_ERROR(value,IOERROR,FS_errmsg);
 1342     }
 1343   }
 1344   /*}}}*/
 1345   else if (pass==INTERPRET && ((put ? FS_put : FS_get)(chn))==-1)
 1346   {
 1347     pc=statementpc;
 1348     return Value_new_ERROR(value,IOERROR,FS_errmsg);
 1349   }
 1350   return (struct Value*)0;
 1351 }
 1352 /*}}}*/
 1353 struct Value *stmt_GOSUB(struct Value *value) /*{{{*/
 1354 {
 1355   if (pass==INTERPRET)
 1356   {
 1357     if (!program.runnable && compileProgram(value,!DIRECTMODE)->type==V_ERROR) return value;
 1358     pc.token+=2;
 1359     Auto_pushGosubRet(&stack,&pc);
 1360     pc=(pc.token-2)->u.gosubpc;
 1361     Program_trace(&program,&pc,0,1);
 1362   }
 1363   if (pass==DECLARE || pass==COMPILE)
 1364   {
 1365     struct Token *gosubpc=pc.token;
 1366 
 1367     ++pc.token;
 1368     if (pc.token->type!=T_INTEGER) return Value_new_ERROR(value,MISSINGLINENUMBER);
 1369     if (Program_goLine(&program,pc.token->u.integer,&gosubpc->u.gosubpc)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE);
 1370     if (pass==COMPILE && Program_scopeCheck(&program,&gosubpc->u.gosubpc,findLabel(L_FUNC))) return Value_new_ERROR(value,OUTOFSCOPE);
 1371     ++pc.token;
 1372   }
 1373   return (struct Value*)0;
 1374 }
 1375 /*}}}*/
 1376 struct Value *stmt_RESUME_GOTO(struct Value *value) /*{{{*/
 1377 {
 1378   if (pass==INTERPRET)
 1379   {
 1380     if (!program.runnable && compileProgram(value,!DIRECTMODE)->type==V_ERROR) return value;
 1381     if (pc.token->type==T_RESUME)
 1382     {
 1383       if (!stack.resumeable) return Value_new_ERROR(value,STRAYRESUME);
 1384       stack.resumeable=0;
 1385     }
 1386     pc=pc.token->u.gotopc;
 1387     Program_trace(&program,&pc,0,1);
 1388   }
 1389   else if (pass==DECLARE || pass==COMPILE)
 1390   {
 1391     struct Token *gotopc=pc.token;
 1392 
 1393     ++pc.token;
 1394     if (pc.token->type!=T_INTEGER) return Value_new_ERROR(value,MISSINGLINENUMBER);
 1395     if (Program_goLine(&program,pc.token->u.integer,&gotopc->u.gotopc)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE);
 1396     if (pass==COMPILE && Program_scopeCheck(&program,&gotopc->u.gotopc,findLabel(L_FUNC))) return Value_new_ERROR(value,OUTOFSCOPE);
 1397     ++pc.token;
 1398   }
 1399   return (struct Value*)0;
 1400 }
 1401 /*}}}*/
 1402 struct Value *stmt_KILL(struct Value *value) /*{{{*/
 1403 {
 1404   struct Pc statementpc=pc;
 1405 
 1406   ++pc.token;
 1407   if (eval(value,_("file name"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_STRING)->type==V_ERROR)) return value;
 1408   if (pass==INTERPRET && unlink(value->u.string.character)==-1)
 1409   {
 1410     char *msg=strerror(errno);
 1411 
 1412     Value_destroy(value);
 1413     pc=statementpc;
 1414     return Value_new_ERROR(value,IOERROR,msg);
 1415   }
 1416   else Value_destroy(value);
 1417   return (struct Value*)0;
 1418 }
 1419 /*}}}*/
 1420 struct Value *stmt_LET(struct Value *value) /*{{{*/
 1421 {
 1422   ++pc.token;
 1423   if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT);
 1424   if (assign(value)->type==V_ERROR) return value;
 1425   if (pass!=INTERPRET) Value_destroy(value);
 1426   return (struct Value*)0;
 1427 }
 1428 /*}}}*/
 1429 struct Value *stmt_LINEINPUT(struct Value *value) /*{{{*/
 1430 {
 1431   int channel=0;
 1432   struct Pc lpc;
 1433   struct Value *l;
 1434 
 1435   ++pc.token;
 1436   if (pc.token->type==T_CHANNEL) /*{{{*/
 1437   {
 1438     ++pc.token;
 1439     if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 1440     channel=value->u.integer;
 1441     Value_destroy(value);
 1442     if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA);
 1443     else ++pc.token;
 1444   }
 1445   /*}}}*/
 1446   /* prompt */ /*{{{*/
 1447   if (pc.token->type==T_STRING)
 1448   {
 1449     if (pass==INTERPRET && channel==0) FS_putString(channel,pc.token->u.string);
 1450     ++pc.token;
 1451     if (pc.token->type!=T_SEMICOLON && pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGSEMICOMMA);
 1452     ++pc.token;
 1453   }
 1454   if (pass==INTERPRET && channel==0) FS_flush(channel);
 1455   /*}}}*/
 1456   if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT);
 1457   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)
 1458   {
 1459     return Value_new_ERROR(value,REDECLARATION);
 1460   }
 1461   lpc=pc;
 1462   if (((l=lvalue(value))->type)==V_ERROR) return value;
 1463   if (pass==COMPILE && l->type!=V_STRING)
 1464   {
 1465     pc=lpc;
 1466     return Value_new_ERROR(value,TYPEMISMATCH4);
 1467   }
 1468   if (pass==INTERPRET)
 1469   {
 1470     String_size(&l->u.string,0);
 1471     if (FS_appendToString(channel,&l->u.string,1)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 1472     if (l->u.string.length==0) return Value_new_ERROR(value,IOERROR,_("end of file"));
 1473     if (l->u.string.character[l->u.string.length-1]=='\n')
 1474     {
 1475       String_size(&l->u.string,l->u.string.length-1);
 1476     }
 1477   }
 1478   return (struct Value*)0;
 1479 }
 1480 /*}}}*/
 1481 struct Value *stmt_LIST_LLIST(struct Value *value) /*{{{*/
 1482 {
 1483   struct Pc from,to;
 1484   int f=0,t=0,channel;
 1485 
 1486   channel=(pc.token->type==T_LLIST?LPCHANNEL:STDCHANNEL);
 1487   ++pc.token;
 1488   if (pc.token->type==T_INTEGER)
 1489   {
 1490     if (pass==INTERPRET && Program_fromLine(&program,pc.token->u.integer,&from)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE);
 1491     f=1;
 1492     ++pc.token;
 1493   }
 1494   else if (pc.token->type!=T_MINUS && pc.token->type!=T_COMMA)
 1495   {
 1496     if (eval(value,(const char*)0))
 1497     {
 1498       if (value->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value;
 1499       if (pass==INTERPRET && Program_fromLine(&program,value->u.integer,&from)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE);
 1500       f=1;
 1501       Value_destroy(value);
 1502     }
 1503   }
 1504   if (pc.token->type==T_MINUS || pc.token->type==T_COMMA)
 1505   {
 1506     ++pc.token;
 1507     if (eval(value,(const char*)0))
 1508     {
 1509       if (value->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value;
 1510       if (pass==INTERPRET && Program_toLine(&program,value->u.integer,&to)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE);
 1511       t=1;
 1512       Value_destroy(value);
 1513     }
 1514   }
 1515   else if (f==1)
 1516   {
 1517     to=from;
 1518     t=1;
 1519   }
 1520   if (pass==INTERPRET)
 1521   {
 1522     /* Some implementations do not require direct mode */
 1523     if (Program_list(&program,channel,channel==STDCHANNEL,f?&from:(struct Pc*)0,t?&to:(struct Pc*)0,value)) return value;
 1524   }
 1525   return (struct Value*)0;
 1526 }
 1527 /*}}}*/
 1528 struct Value *stmt_LOAD(struct Value *value) /*{{{*/
 1529 {
 1530   struct Pc loadpc;
 1531 
 1532   if (pass==INTERPRET && !DIRECTMODE) return Value_new_ERROR(value,NOTINPROGRAMMODE);
 1533   ++pc.token;
 1534   loadpc=pc;
 1535   if (eval(value,_("file name"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR)
 1536   {
 1537     pc=loadpc;
 1538     return value;
 1539   }
 1540   if (pass==INTERPRET)
 1541   {
 1542     int dev;
 1543 
 1544     new();
 1545     Program_setname(&program,value->u.string.character);
 1546     if ((dev=FS_openin(value->u.string.character))==-1)
 1547     {
 1548       pc=loadpc;
 1549       Value_destroy(value);
 1550       return Value_new_ERROR(value,IOERROR,FS_errmsg);
 1551     }
 1552     FS_width(dev,0);
 1553     Value_destroy(value);
 1554     if (Program_merge(&program,dev,value))
 1555     {
 1556       pc=loadpc;
 1557       return value;
 1558     }
 1559     FS_close(dev);
 1560     program.unsaved=0;
 1561   }
 1562   else Value_destroy(value);
 1563   return (struct Value*)0;
 1564 }
 1565 /*}}}*/
 1566 struct Value *stmt_LOCAL(struct Value *value) /*{{{*/
 1567 {
 1568   struct Pc *curfn=(struct Pc*)0;
 1569 
 1570   if (pass==DECLARE || pass==COMPILE)
 1571   {
 1572     if ((curfn=findLabel(L_FUNC))==(struct Pc*)0) return Value_new_ERROR(value,STRAYLOCAL);
 1573   }
 1574   ++pc.token;
 1575   while (1)
 1576   {
 1577     if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT);
 1578     if (pass==DECLARE || pass==COMPILE)
 1579     {
 1580       struct Symbol *fnsym;
 1581 
 1582       if (Auto_variable(&stack,pc.token->u.identifier)==0) return Value_new_ERROR(value,ALREADYLOCAL);
 1583       if (pass==DECLARE)
 1584       {
 1585         assert(curfn->token->type==T_DEFFN || curfn->token->type==T_DEFPROC || curfn->token->type==T_SUB || curfn->token->type==T_FUNCTION);
 1586         fnsym=(curfn->token+1)->u.identifier->sym;
 1587         assert(fnsym);
 1588         fnsym->u.sub.u.def.localTypes=realloc(fnsym->u.sub.u.def.localTypes,sizeof(enum ValueType)*(fnsym->u.sub.u.def.localLength+1));
 1589         fnsym->u.sub.u.def.localTypes[fnsym->u.sub.u.def.localLength]=pc.token->u.identifier->defaultType;
 1590         ++fnsym->u.sub.u.def.localLength;
 1591       }
 1592     }
 1593     ++pc.token;
 1594     if (pc.token->type==T_COMMA) ++pc.token;
 1595     else break;
 1596   }
 1597   return (struct Value*)0;
 1598 }
 1599 /*}}}*/
 1600 struct Value *stmt_LOCATE(struct Value *value) /*{{{*/
 1601 {
 1602   long int line,column;
 1603   struct Pc argpc;
 1604   struct Pc statementpc=pc;
 1605 
 1606   ++pc.token;
 1607   argpc=pc;
 1608   if (eval(value,_("row"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 1609   line=value->u.integer;
 1610   Value_destroy(value);
 1611   if (pass==INTERPRET && line<1) 
 1612   {
 1613     pc=argpc;
 1614     return Value_new_ERROR(value,OUTOFRANGE,_("row"));
 1615   }
 1616   if (pc.token->type==T_COMMA) ++pc.token;
 1617   else return Value_new_ERROR(value,MISSINGCOMMA);
 1618   argpc=pc;
 1619   if (eval(value,_("column"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 1620   column=value->u.integer;
 1621   Value_destroy(value);
 1622   if (pass==INTERPRET && column<1) 
 1623   {
 1624     pc=argpc;
 1625     return Value_new_ERROR(value,OUTOFRANGE,_("column"));
 1626   }
 1627   if (pass==INTERPRET && FS_locate(STDCHANNEL,line,column)==-1)
 1628   {
 1629     pc=statementpc;
 1630     return Value_new_ERROR(value,IOERROR,FS_errmsg);
 1631   }
 1632   return (struct Value*)0;
 1633 }
 1634 /*}}}*/
 1635 struct Value *stmt_LOCK_UNLOCK(struct Value *value) /*{{{*/
 1636 {
 1637   int lock=pc.token->type==T_LOCK;
 1638   int channel;
 1639 
 1640   ++pc.token;
 1641   if (pc.token->type==T_CHANNEL) ++pc.token;
 1642   if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 1643   channel=value->u.integer;
 1644   Value_destroy(value);
 1645   if (pass==INTERPRET)
 1646   {
 1647     if (FS_lock(channel,0,0,lock?FS_LOCK_EXCLUSIVE:FS_LOCK_NONE,1)==-1)
 1648     {
 1649       return Value_new_ERROR(value,IOERROR,FS_errmsg);
 1650     }
 1651   }
 1652   return (struct Value*)0;
 1653 }
 1654 /*}}}*/
 1655 struct Value *stmt_LOOP(struct Value *value) /*{{{*/
 1656 {
 1657   struct Pc looppc=pc;
 1658   struct Pc *dopc;
 1659 
 1660   ++pc.token;
 1661   if (pass==INTERPRET)
 1662   {
 1663     pc=looppc.token->u.dopc;
 1664   }
 1665   if (pass==DECLARE || pass==COMPILE)
 1666   {
 1667     if ((dopc=popLabel(L_DO))==(struct Pc*)0 && (dopc=popLabel(L_DOcondition))==(struct Pc*)0) return Value_new_ERROR(value,STRAYLOOP);
 1668     looppc.token->u.dopc=*dopc;
 1669     dopc->token->u.exitdo=pc;
 1670   }
 1671   return (struct Value*)0;
 1672 }
 1673 /*}}}*/
 1674 struct Value *stmt_LOOPUNTIL(struct Value *value) /*{{{*/
 1675 {
 1676   struct Pc loopuntilpc=pc;
 1677   struct Pc *dopc;
 1678 
 1679   ++pc.token;
 1680   if (eval(value,_("condition"))->type==V_ERROR) return value;
 1681   if (pass==INTERPRET)
 1682   {
 1683     if (Value_isNull(value)) pc=loopuntilpc.token->u.dopc;
 1684     Value_destroy(value);
 1685   }
 1686   if (pass==DECLARE || pass==COMPILE)
 1687   {
 1688     if ((dopc=popLabel(L_DO))==(struct Pc*)0) return Value_new_ERROR(value,STRAYLOOPUNTIL);
 1689     loopuntilpc.token->u.until=*dopc;
 1690     dopc->token->u.exitdo=pc;
 1691   }
 1692   return (struct Value*)0;
 1693 }
 1694 /*}}}*/
 1695 struct Value *stmt_LSET_RSET(struct Value *value) /*{{{*/
 1696 {
 1697   struct Value *l;
 1698   struct Pc tmppc;
 1699   int lset=(pc.token->type==T_LSET);
 1700 
 1701   ++pc.token;
 1702   if (pass==DECLARE)
 1703   {
 1704     if
 1705     (
 1706       ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0)
 1707       && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0
 1708     )
 1709     {
 1710       return Value_new_ERROR(value,REDECLARATION);
 1711     }
 1712   }
 1713   tmppc=pc;
 1714   if ((l=lvalue(value))->type==V_ERROR) return value;
 1715   if (pass==COMPILE && l->type!=V_STRING)
 1716   {
 1717     pc=tmppc;
 1718     return Value_new_ERROR(value,TYPEMISMATCH4);
 1719   }
 1720   if (pc.token->type!=T_EQ) return Value_new_ERROR(value,MISSINGEQ);
 1721   ++pc.token;
 1722   tmppc=pc;
 1723   if (eval(value,_("rhs"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,l->type)->type==V_ERROR))
 1724   {
 1725     pc=tmppc;
 1726     return value;
 1727   }
 1728   if (pass==INTERPRET) (lset ? String_lset : String_rset)(&l->u.string,&value->u.string);
 1729   Value_destroy(value);
 1730   return (struct Value*)0;
 1731 }
 1732 /*}}}*/
 1733 struct Value *stmt_IDENTIFIER(struct Value *value) /*{{{*/
 1734 {
 1735   struct Pc here=pc;
 1736 
 1737   if (pass==DECLARE)
 1738   {
 1739     if (func(value)->type==V_ERROR) return value;
 1740     else Value_destroy(value);
 1741     if (pc.token->type==T_EQ || pc.token->type==T_COMMA)
 1742     {
 1743       pc=here;
 1744       if (assign(value)->type==V_ERROR) return value;
 1745       Value_destroy(value);
 1746     }
 1747   }
 1748   else
 1749   {
 1750     if (pass==COMPILE)
 1751     {
 1752       if
 1753       (
 1754         ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0)
 1755         && Global_find(&globals,pc.token->u.identifier,(pc.token+1)->type==T_OP)==0
 1756       ) return Value_new_ERROR(value,UNDECLARED);
 1757     }
 1758     if (strcasecmp(pc.token->u.identifier->name,"mid$")
 1759         && (pc.token->u.identifier->sym->type==USERFUNCTION || pc.token->u.identifier->sym->type==BUILTINFUNCTION))
 1760     {
 1761       func(value);
 1762       if (Value_retype(value,V_VOID)->type==V_ERROR) return value;
 1763       Value_destroy(value);
 1764     }
 1765     else
 1766     {
 1767       if (assign(value)->type==V_ERROR) return value;
 1768       if (pass!=INTERPRET) Value_destroy(value);
 1769     }
 1770   }
 1771   
 1772   return (struct Value*)0;
 1773 }
 1774 /*}}}*/
 1775 struct Value *stmt_IF_ELSEIFIF(struct Value *value) /*{{{*/
 1776 {
 1777   struct Pc ifpc=pc;
 1778 
 1779   ++pc.token;
 1780   if (eval(value,_("condition"))->type==V_ERROR) return value;
 1781   if (pc.token->type!=T_THEN)
 1782   {
 1783     Value_destroy(value);
 1784     return Value_new_ERROR(value,MISSINGTHEN);
 1785   }
 1786   ++pc.token;
 1787   /* Needed to handle multi line if then with hanging comment right. */
 1788   if (pc.token->type==T_QUOTE || pc.token->type==T_REM) ++pc.token;
 1789   if (pass==INTERPRET)
 1790   {
 1791     if (Value_isNull(value)) pc=ifpc.token->u.elsepc;
 1792     Value_destroy(value);
 1793   }
 1794   else
 1795   {
 1796     Value_destroy(value);
 1797     if (pc.token->type==T_EOL)
 1798     {
 1799       pushLabel(L_IF,&ifpc);
 1800     }
 1801     else /* compile single line IF THEN ELSE recursively */ /*{{{*/
 1802     {
 1803       if (statements(value)->type==V_ERROR) return value;
 1804       Value_destroy(value);
 1805       if (pc.token->type==T_ELSE)
 1806       {
 1807         struct Pc elsepc=pc;
 1808 
 1809         ++pc.token;
 1810         ifpc.token->u.elsepc=pc;
 1811         if (ifpc.token->type==T_ELSEIFIF) (ifpc.token-1)->u.elsepc=pc;
 1812         if (statements(value)->type==V_ERROR) return value;
 1813         Value_destroy(value);
 1814         elsepc.token->u.endifpc=pc;
 1815       }
 1816       else
 1817       {
 1818         ifpc.token->u.elsepc=pc;
 1819         if (ifpc.token->type==T_ELSEIFIF) (ifpc.token-1)->u.elsepc=pc;
 1820       }
 1821     }
 1822     /*}}}*/
 1823   }
 1824   return (struct Value*)0;
 1825 }
 1826 /*}}}*/
 1827 struct Value *stmt_IMAGE(struct Value *value) /*{{{*/
 1828 {
 1829   ++pc.token;
 1830   if (pc.token->type!=T_STRING) return Value_new_ERROR(value,MISSINGFMT);
 1831   ++pc.token;
 1832   return (struct Value*)0;
 1833 }
 1834 /*}}}*/
 1835 struct Value *stmt_INPUT(struct Value *value) /*{{{*/
 1836 {
 1837   int channel=STDCHANNEL;
 1838   int nl=1;
 1839   int extraprompt=1;
 1840   struct Token *inputdata=(struct Token*)0,*t=(struct Token*)0;
 1841   struct Pc lvaluepc;
 1842 
 1843   ++pc.token;
 1844   if (pc.token->type==T_CHANNEL) /*{{{*/
 1845   {
 1846     ++pc.token;
 1847     if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 1848     channel=value->u.integer;
 1849     Value_destroy(value);
 1850     if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA);
 1851     else ++pc.token;
 1852   }
 1853   /*}}}*/
 1854   if (pc.token->type==T_SEMICOLON) /*{{{*/
 1855   {
 1856     nl=0;
 1857     ++pc.token;
 1858   }
 1859   /*}}}*/
 1860   /* prompt */ /*{{{*/
 1861   if (pc.token->type==T_STRING)
 1862   {
 1863     if (pass==INTERPRET && channel==STDCHANNEL) FS_putString(STDCHANNEL,pc.token->u.string);
 1864     ++pc.token;
 1865     if (pc.token->type==T_COMMA || pc.token->type==T_COLON) { ++pc.token; extraprompt=0; }
 1866     else if (pc.token->type==T_SEMICOLON) ++pc.token;
 1867     else extraprompt=0;
 1868   }
 1869   if (pass==INTERPRET && channel==STDCHANNEL && extraprompt)
 1870   {
 1871     FS_putChars(STDCHANNEL,"? ");
 1872   }
 1873   /*}}}*/
 1874   retry:
 1875   if (pass==INTERPRET) /* read input line and tokenise it */ /*{{{*/
 1876   {
 1877     struct String s;
 1878 
 1879     if (channel==STDCHANNEL) FS_flush(STDCHANNEL);
 1880     String_new(&s);
 1881     if (FS_appendToString(channel,&s,nl)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 1882     if (s.length==0) return Value_new_ERROR(value,IOERROR,_("end of file"));
 1883     inputdata=t=Token_newData(s.character);
 1884     String_destroy(&s);
 1885   }
 1886   /*}}}*/
 1887   while (1)
 1888   {
 1889     struct Value *l;
 1890 
 1891     if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT);
 1892     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)
 1893     {
 1894       return Value_new_ERROR(value,REDECLARATION);
 1895     }
 1896     lvaluepc=pc;
 1897     if (((l=lvalue(value))->type)==V_ERROR) return value;
 1898     if (pass==INTERPRET)
 1899     {
 1900       if (t->type==T_COMMA || t->type==T_EOL)
 1901       {
 1902         enum ValueType ltype=l->type;
 1903 
 1904         Value_destroy(l);
 1905         Value_new_null(l,ltype);
 1906       }
 1907       else if (convert(value,l,t))
 1908       {
 1909         pc=lvaluepc;
 1910         if (channel==STDCHANNEL)
 1911         {
 1912           struct String s;
 1913 
 1914           String_new(&s);
 1915           Value_toString(value,&s,' ',-1,0,0,0,0,-1,0,0);
 1916           String_appendChars(&s," ?? ");
 1917           FS_putString(STDCHANNEL,&s);
 1918           String_destroy(&s);
 1919           Value_destroy(value);
 1920           Token_destroy(inputdata);
 1921           goto retry;
 1922         }
 1923         else
 1924         {
 1925           Token_destroy(inputdata);
 1926           return value;
 1927         }
 1928       }
 1929       else ++t;
 1930       if (pc.token->type==T_COMMA)
 1931       {
 1932         if (t->type==T_COMMA) ++t;
 1933         else
 1934         {
 1935           Token_destroy(inputdata);
 1936           if (channel==STDCHANNEL)
 1937           {
 1938             FS_putChars(STDCHANNEL,"?? ");
 1939             ++pc.token;
 1940             goto retry;
 1941           }
 1942           else
 1943           {
 1944             pc=lvaluepc;
 1945             return Value_new_ERROR(value,MISSINGINPUTDATA);
 1946           }
 1947         }
 1948       }
 1949     }
 1950     if (pc.token->type==T_COMMA) ++pc.token;
 1951     else break;
 1952   }
 1953   if (pass==INTERPRET)
 1954   {
 1955     if (t->type!=T_EOL) FS_putChars(STDCHANNEL,_("Too much input data\n"));
 1956     Token_destroy(inputdata);
 1957   }
 1958   return (struct Value*)0;
 1959 }
 1960 /*}}}*/
 1961 struct Value *stmt_MAT(struct Value *value) /*{{{*/
 1962 {
 1963   struct Var *var1,*var2,*var3=(struct Var*)0;
 1964   struct Pc oppc;
 1965   enum TokenType op=T_EOL;
 1966 
 1967   oppc.line=-1;
 1968   oppc.token=(struct Token*)0;
 1969   ++pc.token;
 1970   if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGMATIDENT);
 1971   if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0)
 1972   {
 1973     return Value_new_ERROR(value,REDECLARATION);
 1974   }
 1975   var1=&pc.token->u.identifier->sym->u.var;
 1976   ++pc.token;
 1977   if (pc.token->type!=T_EQ) return Value_new_ERROR(value,MISSINGEQ);
 1978   ++pc.token;
 1979   if (pc.token->type==T_IDENTIFIER) /* a = b [ +|-|* c ] */ /*{{{*/
 1980   {
 1981     if (pass==COMPILE)
 1982     {
 1983       if
 1984       (
 1985         ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0)
 1986         && Global_find(&globals,pc.token->u.identifier,1)==0
 1987       ) return Value_new_ERROR(value,UNDECLARED);
 1988     }
 1989     var2=&pc.token->u.identifier->sym->u.var;
 1990     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);
 1991     if (pass==COMPILE && Value_commonType[var1->type][var2->type]==V_ERROR) return Value_new_typeError(value,var2->type,var1->type);
 1992     ++pc.token;
 1993     if (pc.token->type==T_PLUS || pc.token->type==T_MINUS || pc.token->type==T_MULT)
 1994     {
 1995       oppc=pc;
 1996       op=pc.token->type;
 1997       ++pc.token;
 1998       if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGARRIDENT);
 1999       if (pass==COMPILE)
 2000       {
 2001         if
 2002         (
 2003           ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0)
 2004           && Global_find(&globals,pc.token->u.identifier,1)==0
 2005         ) return Value_new_ERROR(value,UNDECLARED);
 2006       }
 2007       var3=&pc.token->u.identifier->sym->u.var;
 2008       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);
 2009       ++pc.token;
 2010     }
 2011     if (pass!=DECLARE)
 2012     {
 2013       if (var3==(struct Var*)0)
 2014       {
 2015         if (Var_mat_assign(var1,var2,value,pass==INTERPRET))
 2016         {
 2017           assert(oppc.line!=-1);
 2018           pc=oppc;
 2019           return value;
 2020         }
 2021       }
 2022       else if (op==T_MULT)
 2023       {
 2024         if (Var_mat_mult(var1,var2,var3,value,pass==INTERPRET))
 2025         {
 2026           assert(oppc.line!=-1);
 2027           pc=oppc;
 2028           return value;
 2029         }
 2030       }
 2031       else if (Var_mat_addsub(var1,var2,var3,op==T_PLUS,value,pass==INTERPRET))
 2032       {
 2033         assert(oppc.line!=-1);
 2034         pc=oppc;
 2035         return value;
 2036       }
 2037     }
 2038   }
 2039   /*}}}*/
 2040   else if (pc.token->type==T_OP) /*{{{*/
 2041   {
 2042     if (var1->type==V_STRING) return Value_new_ERROR(value,TYPEMISMATCH5);
 2043     ++pc.token;
 2044     if (eval(value,_("factor"))->type==V_ERROR) return value;
 2045     if (pass==COMPILE && Value_commonType[var1->type][value->type]==V_ERROR) return Value_new_typeError(value,var1->type,value->type);
 2046     if (pc.token->type!=T_CP)
 2047     {
 2048       Value_destroy(value);
 2049       return Value_new_ERROR(value,MISSINGCP);
 2050     }
 2051     ++pc.token;
 2052     if (pc.token->type!=T_MULT)
 2053     {
 2054       Value_destroy(value);
 2055       return Value_new_ERROR(value,MISSINGMULT);
 2056     }
 2057     oppc=pc;
 2058     ++pc.token;
 2059     if (pass==COMPILE)
 2060     {
 2061       if
 2062       (
 2063         ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0)
 2064         && Global_find(&globals,pc.token->u.identifier,1)==0
 2065       )
 2066       {
 2067         Value_destroy(value);
 2068         return Value_new_ERROR(value,UNDECLARED);
 2069       }
 2070     }
 2071     var2=&pc.token->u.identifier->sym->u.var;
 2072     if (pass==INTERPRET && ((var2->dim!=1 && var2->dim!=2) || var2->base<0 || var2->base>1))
 2073     {
 2074       Value_destroy(value);
 2075       return Value_new_ERROR(value,NOMATRIX,var2->dim,var2->base);
 2076     }
 2077     if (pass!=DECLARE && Var_mat_scalarMult(var1,value,var2,pass==INTERPRET))
 2078     {
 2079       assert(oppc.line!=-1);
 2080       pc=oppc;
 2081       return value;
 2082     }
 2083     Value_destroy(value);
 2084     ++pc.token;
 2085   }
 2086   /*}}}*/
 2087   else if (pc.token->type==T_CON || pc.token->type==T_ZER || pc.token->type==T_IDN) /*{{{*/
 2088   {
 2089     op=pc.token->type;
 2090     if (pass==COMPILE && Value_commonType[var1->type][V_INTEGER]==V_ERROR) return Value_new_typeError(value,V_INTEGER,var1->type);
 2091     ++pc.token;
 2092     if (pc.token->type==T_OP)
 2093     {
 2094       unsigned int dim,geometry[2];
 2095       enum ValueType vartype=var1->type;
 2096 
 2097       ++pc.token;
 2098       if (evalGeometry(value,&dim,geometry)) return value;
 2099       if (pass==INTERPRET)
 2100       {
 2101         Var_destroy(var1);
 2102         Var_new(var1,vartype,dim,geometry,optionbase);
 2103       }
 2104     }
 2105     if (pass==INTERPRET)
 2106     {
 2107       unsigned int i;
 2108       unsigned int unused=1-var1->base;
 2109 
 2110       if ((var1->dim!=1 && var1->dim!=2) || var1->base<0 || var1->base>1) return Value_new_ERROR(value,NOMATRIX,var1->dim,var1->base);
 2111       if (var1->dim==1)
 2112       {
 2113         for (i=unused; i<var1->geometry[0]; ++i)
 2114         {
 2115           int c=-1;
 2116 
 2117           Value_destroy(&(var1->value[i]));
 2118           switch (op)
 2119           {
 2120             case T_CON: c=1; break;
 2121             case T_ZER: c=0; break;
 2122             case T_IDN: c=(i==unused?1:0); break;
 2123             default: assert(0);
 2124           }
 2125           if (var1->type==V_INTEGER) Value_new_INTEGER(&(var1->value[i]),c);
 2126           else Value_new_REAL(&(var1->value[i]),(double)c);
 2127         }
 2128       }
 2129       else
 2130       {
 2131         unsigned int j;
 2132 
 2133         for (i=unused; i<var1->geometry[0]; ++i) for (j=unused; j<var1->geometry[1]; ++j)
 2134         {
 2135           int c=-1;
 2136 
 2137           Value_destroy(&(var1->value[i*var1->geometry[1]+j]));
 2138           switch (op)
 2139           {
 2140             case T_CON: c=1; break;
 2141             case T_ZER: c=0; break;
 2142             case T_IDN: c=(i==j?1:0); break;
 2143             default: assert(0);
 2144           }
 2145           if (var1->type==V_INTEGER) Value_new_INTEGER(&(var1->value[i*var1->geometry[1]+j]),c);
 2146           else Value_new_REAL(&(var1->value[i*var1->geometry[1]+j]),(double)c);
 2147         }
 2148       }
 2149     }
 2150   }
 2151   /*}}}*/
 2152   else if (pc.token->type==T_TRN || pc.token->type==T_INV) /*{{{*/
 2153   {
 2154     op=pc.token->type;
 2155     ++pc.token;
 2156     if (pc.token->type!=T_OP) return Value_new_ERROR(value,MISSINGOP);
 2157     ++pc.token;
 2158     if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGMATIDENT);
 2159     if (pass==COMPILE)
 2160     {
 2161       if
 2162       (
 2163         ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0)
 2164         && Global_find(&globals,pc.token->u.identifier,1)==0
 2165       ) return Value_new_ERROR(value,UNDECLARED);
 2166     }
 2167     var2=&pc.token->u.identifier->sym->u.var;
 2168     if (pass==COMPILE && Value_commonType[var1->type][var2->type]==V_ERROR) return Value_new_typeError(value,var2->type,var1->type);
 2169     if (pass==INTERPRET)
 2170     {
 2171       if (var2->dim!=2 || var2->base<0 || var2->base>1) return Value_new_ERROR(value,NOMATRIX,var2->dim,var2->base);
 2172       switch (op)
 2173       {
 2174         case T_TRN: Var_mat_transpose(var1,var2); break;
 2175         case T_INV: if (Var_mat_invert(var1,var2,&stack.lastdet,value)) return value; break;
 2176         default: assert(0);
 2177       }
 2178     }
 2179     ++pc.token;
 2180     if (pc.token->type!=T_CP) return Value_new_ERROR(value,MISSINGCP);
 2181     ++pc.token;
 2182   }
 2183   /*}}}*/
 2184   else return Value_new_ERROR(value,MISSINGEXPR,_("matrix"));
 2185   return (struct Value*)0;
 2186 }
 2187 /*}}}*/
 2188 struct Value *stmt_MATINPUT(struct Value *value) /*{{{*/
 2189 {
 2190   int channel=STDCHANNEL;
 2191 
 2192   ++pc.token;
 2193   if (pc.token->type==T_CHANNEL) /*{{{*/
 2194   {
 2195     ++pc.token;
 2196     if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 2197     channel=value->u.integer;
 2198     Value_destroy(value);
 2199     if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA);
 2200     else ++pc.token;
 2201   }
 2202   /*}}}*/
 2203   while (1)
 2204   {
 2205     struct Pc lvaluepc;
 2206     struct Var *var;
 2207 
 2208     lvaluepc=pc;
 2209     if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGMATIDENT);
 2210     if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0)
 2211     {
 2212       return Value_new_ERROR(value,REDECLARATION);
 2213     }
 2214     var=&pc.token->u.identifier->sym->u.var;
 2215     ++pc.token;
 2216     if (pc.token->type==T_OP)
 2217     {
 2218       unsigned int dim,geometry[2];
 2219       enum ValueType vartype=var->type;
 2220 
 2221       ++pc.token;
 2222       if (evalGeometry(value,&dim,geometry)) return value;
 2223       if (pass==INTERPRET)
 2224       {
 2225         Var_destroy(var);
 2226         Var_new(var,vartype,dim,geometry,optionbase);
 2227       }
 2228     }
 2229     if (pass==INTERPRET)
 2230     {
 2231       unsigned int i,j;
 2232       int unused=1-var->base;
 2233       unsigned int columns;
 2234       struct Token *inputdata,*t;
 2235 
 2236       if (var->dim!=1 && var->dim!=2) return Value_new_ERROR(value,NOMATRIX,var->dim);
 2237       columns=var->dim==1 ? 0 : var->geometry[1];
 2238       inputdata=t=(struct Token*)0;
 2239       for (i=unused,j=unused; i<var->geometry[0]; )
 2240       {
 2241         struct String s;
 2242 
 2243         if (!inputdata)
 2244         {
 2245           if (channel==STDCHANNEL)
 2246           {
 2247             FS_putChars(STDCHANNEL,"? ");
 2248             FS_flush(STDCHANNEL);
 2249           }
 2250           String_new(&s);
 2251           if (FS_appendToString(channel,&s,1)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 2252           if (s.length==0) return Value_new_ERROR(value,IOERROR,_("end of file"));
 2253           inputdata=t=Token_newData(s.character);
 2254           String_destroy(&s);
 2255         }
 2256 
 2257         if (t->type==T_COMMA)
 2258         {
 2259           Value_destroy(&(var->value[j*columns+i]));
 2260           Value_new_null(&(var->value[j*columns+i]),var->type);
 2261           ++t;
 2262         }
 2263         else if (t->type==T_EOL)
 2264         {
 2265           while (i<var->geometry[0])
 2266           {
 2267             Value_destroy(&(var->value[j*columns+i]));
 2268             Value_new_null(&(var->value[j*columns+i]),var->type);
 2269             ++i;
 2270           }
 2271         }
 2272         else if (convert(value,&(var->value[j*columns+i]),t))
 2273         {
 2274           Token_destroy(inputdata);
 2275           pc=lvaluepc;
 2276           return value;
 2277         }
 2278         else
 2279         {
 2280           ++t;
 2281           ++i;
 2282           if (t->type==T_COMMA) ++t;
 2283         }
 2284 
 2285         if (i==var->geometry[0] && j<(columns-1))
 2286         {
 2287           i=unused;
 2288           ++j;
 2289           if (t->type==T_EOL)
 2290           {
 2291             Token_destroy(inputdata);
 2292             inputdata=(struct Token*)0;
 2293           }
 2294         }
 2295       }
 2296     }
 2297     if (pc.token->type==T_COMMA) ++pc.token;
 2298     else break;
 2299   }
 2300   return (struct Value*)0;
 2301 }
 2302 /*}}}*/
 2303 struct Value *stmt_MATPRINT(struct Value *value) /*{{{*/
 2304 {
 2305   int chn=STDCHANNEL;
 2306   int printusing=0;
 2307   struct Value usingval;
 2308   struct String *using=(struct String*)0;
 2309   size_t usingpos=0;
 2310   int notfirst=0;
 2311 
 2312   ++pc.token;
 2313   if (chn==STDCHANNEL && pc.token->type==T_CHANNEL) /*{{{*/
 2314   {
 2315     ++pc.token;
 2316     if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 2317     chn=value->u.integer;
 2318     Value_destroy(value);
 2319     if (pc.token->type==T_COMMA) ++pc.token;
 2320   }
 2321   /*}}}*/
 2322   if (pc.token->type==T_USING) /*{{{*/
 2323   {
 2324     struct Pc usingpc;
 2325 
 2326     usingpc=pc;
 2327     printusing=1;
 2328     ++pc.token;
 2329     if (pc.token->type==T_INTEGER)
 2330     {
 2331       if (pass==COMPILE && Program_imageLine(&program,pc.token->u.integer,&usingpc.token->u.image)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHIMAGELINE);
 2332       else if (pass==INTERPRET) using=usingpc.token->u.image.token->u.string;
 2333       Value_new_STRING(&usingval);
 2334       ++pc.token;
 2335     }
 2336     else
 2337     {
 2338       if (eval(&usingval,_("format string"))->type==V_ERROR || Value_retype(&usingval,V_STRING)->type==V_ERROR)
 2339       {
 2340         *value=usingval;
 2341         return value;
 2342       }
 2343       using=&usingval.u.string;
 2344     }
 2345     if (pc.token->type!=T_SEMICOLON)
 2346     {
 2347       Value_destroy(&usingval);
 2348       return Value_new_ERROR(value,MISSINGSEMICOLON);
 2349     }
 2350     ++pc.token;
 2351   }
 2352   /*}}}*/
 2353   else
 2354   {
 2355     Value_new_STRING(&usingval);
 2356     using=&usingval.u.string;
 2357   }
 2358   while (1)
 2359   {
 2360     struct Var *var;
 2361     int zoned=1;
 2362 
 2363     if (pc.token->type!=T_IDENTIFIER)
 2364     {
 2365       if (notfirst) break;
 2366       Value_destroy(&usingval);
 2367       return Value_new_ERROR(value,MISSINGMATIDENT);
 2368     }
 2369     if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0)
 2370     {
 2371       Value_destroy(&usingval);
 2372       return Value_new_ERROR(value,REDECLARATION);
 2373     }
 2374     var=&pc.token->u.identifier->sym->u.var;
 2375     ++pc.token;
 2376     if (pc.token->type==T_SEMICOLON) zoned=0;
 2377     if (pass==INTERPRET)
 2378     {
 2379       unsigned int i,j;
 2380       unsigned int unused=1-var->base;
 2381       unsigned int g0,g1;
 2382 
 2383       if ((var->dim!=1 && var->dim!=2) || var->base<0 || var->base>1) return Value_new_ERROR(value,NOMATRIX,var->dim,var->base);
 2384       if ((notfirst ? FS_putChar(chn,'\n') : FS_nextline(chn))==-1)
 2385       {
 2386         Value_destroy(&usingval);
 2387         return Value_new_ERROR(value,IOERROR,FS_errmsg);
 2388       }
 2389       g0=var->geometry[0];
 2390       g1=var->dim==1 ? unused+1 : var->geometry[1];
 2391       for (i=unused; i<g0; ++i)
 2392       {
 2393         for (j=unused; j<g1; ++j)
 2394         {
 2395           struct String s;
 2396 
 2397           String_new(&s);
 2398           Value_clone(value,&(var->value[var->dim==1 ? i : i*g1+j]));
 2399           if (Value_toStringUsing(value,&s,using,&usingpos)->type==V_ERROR)
 2400           {
 2401             Value_destroy(&usingval);
 2402             String_destroy(&s);
 2403             return value;
 2404           }
 2405           Value_destroy(value);
 2406           if (FS_putString(chn,&s)==-1)
 2407           {
 2408             Value_destroy(&usingval);
 2409             String_destroy(&s);
 2410             return Value_new_ERROR(value,IOERROR,FS_errmsg);
 2411           }
 2412           String_destroy(&s);
 2413           if (!printusing && zoned) FS_nextcol(chn);
 2414         }
 2415         if (FS_putChar(chn,'\n')==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 2416       }
 2417     }
 2418     if (pc.token->type==T_COMMA || pc.token->type==T_SEMICOLON) ++pc.token;
 2419     else break;
 2420     notfirst=1;
 2421   }
 2422   Value_destroy(&usingval);
 2423   if (pass==INTERPRET)
 2424   {
 2425     if (FS_flush(chn)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 2426   }
 2427   return (struct Value*)0;
 2428 }
 2429 /*}}}*/
 2430 struct Value *stmt_MATREAD(struct Value *value) /*{{{*/
 2431 {
 2432   ++pc.token;
 2433   while (1)
 2434   {
 2435     struct Pc lvaluepc;
 2436     struct Var *var;
 2437 
 2438     lvaluepc=pc;
 2439     if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGMATIDENT);
 2440     if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0)
 2441     {
 2442       return Value_new_ERROR(value,REDECLARATION);
 2443     }
 2444     var=&pc.token->u.identifier->sym->u.var;
 2445     ++pc.token;
 2446     if (pc.token->type==T_OP)
 2447     {
 2448       unsigned int dim,geometry[2];
 2449       enum ValueType vartype=var->type;
 2450 
 2451       ++pc.token;
 2452       if (evalGeometry(value,&dim,geometry)) return value;
 2453       if (pass==INTERPRET)
 2454       {
 2455         Var_destroy(var);
 2456         Var_new(var,vartype,dim,geometry,optionbase);
 2457       }
 2458     }
 2459     if (pass==INTERPRET)
 2460     {
 2461       unsigned int i;
 2462       int unused=1-var->base;
 2463 
 2464       if ((var->dim!=1 && var->dim!=2) || var->base<0 || var->base>1) return Value_new_ERROR(value,NOMATRIX,var->dim,var->base);
 2465       if (var->dim==1)
 2466       {
 2467         for (i=unused; i<var->geometry[0]; ++i)
 2468         {
 2469           if (dataread(value,&(var->value[i])))
 2470           {
 2471             pc=lvaluepc;
 2472             return value;
 2473           }
 2474         }
 2475       }
 2476       else
 2477       {
 2478         unsigned int j;
 2479 
 2480         for (i=unused; i<var->geometry[0]; ++i) for (j=unused; j<var->geometry[1]; ++j)
 2481         {
 2482           if (dataread(value,&(var->value[i*var->geometry[1]+j])))
 2483           {
 2484             pc=lvaluepc;
 2485             return value;
 2486           }
 2487         }
 2488       }
 2489     }
 2490     if (pc.token->type==T_COMMA) ++pc.token;
 2491     else break;
 2492   }
 2493   return (struct Value*)0;
 2494 }
 2495 /*}}}*/
 2496 struct Value *stmt_MATREDIM(struct Value *value) /*{{{*/
 2497 {
 2498   ++pc.token;
 2499   while (1)
 2500   {
 2501     struct Var *var;
 2502     unsigned int dim,geometry[2];
 2503 
 2504     if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGMATIDENT);
 2505     if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0)
 2506     {
 2507       return Value_new_ERROR(value,REDECLARATION);
 2508     }
 2509     var=&pc.token->u.identifier->sym->u.var;
 2510     ++pc.token;
 2511     if (pc.token->type!=T_OP) return Value_new_ERROR(value,MISSINGOP);
 2512     ++pc.token;
 2513     if (evalGeometry(value,&dim,geometry)) return value;
 2514     if (pass==INTERPRET && Var_mat_redim(var,dim,geometry,value)!=(struct Value*)0) return value;
 2515     if (pc.token->type==T_COMMA) ++pc.token;
 2516     else break;
 2517   }
 2518   return (struct Value*)0;
 2519 }
 2520 /*}}}*/
 2521 struct Value *stmt_MATWRITE(struct Value *value) /*{{{*/
 2522 {
 2523   int chn=STDCHANNEL;
 2524   int notfirst=0;
 2525   int comma=0;
 2526 
 2527   ++pc.token;
 2528   if (pc.token->type==T_CHANNEL) /*{{{*/
 2529   {
 2530     ++pc.token;
 2531     if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 2532     chn=value->u.integer;
 2533     Value_destroy(value);
 2534     if (pc.token->type==T_COMMA) ++pc.token;
 2535   }
 2536   /*}}}*/
 2537   while (1)
 2538   {
 2539     struct Var *var;
 2540 
 2541     if (pc.token->type!=T_IDENTIFIER)
 2542     {
 2543       if (notfirst) break;
 2544       return Value_new_ERROR(value,MISSINGMATIDENT);
 2545     }
 2546     notfirst=1;
 2547     if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0)
 2548     {
 2549       return Value_new_ERROR(value,REDECLARATION);
 2550     }
 2551     var=&pc.token->u.identifier->sym->u.var;
 2552     ++pc.token;
 2553     if (pass==INTERPRET)
 2554     {
 2555       unsigned int i,j;
 2556       unsigned int unused=1-var->base;
 2557       unsigned int g0,g1;
 2558 
 2559       if ((var->dim!=1 && var->dim!=2) || var->base<0 || var->base>1) return Value_new_ERROR(value,NOMATRIX,var->dim,var->base);
 2560       g0=var->geometry[0];
 2561       g1=var->dim==1 ? unused+1 : var->geometry[1];
 2562       for (i=unused; i<g0; ++i)
 2563       {
 2564         comma=0;
 2565         for (j=unused; j<g1; ++j)
 2566         {
 2567           struct String s;
 2568 
 2569           String_new(&s);
 2570           Value_clone(value,&(var->value[var->dim==1 ? i : i*g1+j]));
 2571           if (comma) String_appendChar(&s,',');
 2572           if (FS_putString(chn,Value_toWrite(value,&s))==-1)
 2573           {
 2574             Value_destroy(value);
 2575             return Value_new_ERROR(value,IOERROR,FS_errmsg);
 2576           }
 2577           if (FS_flush(chn)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 2578           String_destroy(&s);
 2579           comma=1;
 2580         }
 2581         FS_putChar(chn,'\n');
 2582       }
 2583     }
 2584     if (pc.token->type==T_COMMA || pc.token->type==T_SEMICOLON) ++pc.token;
 2585     else break;
 2586   }
 2587   if (pass==INTERPRET)
 2588   {
 2589     if (FS_flush(chn)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 2590   }
 2591   return (struct Value*)0;
 2592 }
 2593 /*}}}*/
 2594 struct Value *stmt_NAME(struct Value *value) /*{{{*/
 2595 {
 2596   struct Pc namepc=pc;
 2597   struct Value old;
 2598   int res=-1,reserrno=-1;
 2599 
 2600   ++pc.token;
 2601   if (eval(value,_("file name"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value;
 2602   if (pc.token->type!=T_AS)
 2603   {
 2604     Value_destroy(value);
 2605     return Value_new_ERROR(value,MISSINGAS);
 2606   }
 2607   old=*value;
 2608   ++pc.token;
 2609   if (eval(value,_("file name"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR)
 2610   {
 2611     Value_destroy(&old);
 2612     return value;
 2613   }
 2614   if (pass==INTERPRET)
 2615   {
 2616     res=rename(old.u.string.character,value->u.string.character);
 2617     reserrno=errno;
 2618   }
 2619   Value_destroy(&old);
 2620   Value_destroy(value);
 2621   if (pass==INTERPRET && res==-1)
 2622   {
 2623     pc=namepc;
 2624     return Value_new_ERROR(value,IOERROR,strerror(reserrno));
 2625   }
 2626   return (struct Value*)0;
 2627 }
 2628 /*}}}*/
 2629 struct Value *stmt_NEW(struct Value *value) /*{{{*/
 2630 {
 2631   if (pass==INTERPRET)
 2632   {
 2633     if (!DIRECTMODE) return Value_new_ERROR(value,NOTINPROGRAMMODE);
 2634     new();
 2635   }
 2636   ++pc.token;
 2637   return (struct Value*)0;
 2638 }
 2639 /*}}}*/
 2640 struct Value *stmt_NEXT(struct Value *value) /*{{{*/
 2641 {
 2642   struct Next **next=&pc.token->u.next;
 2643   int level=0;
 2644 
 2645   if (pass==INTERPRET) /*{{{*/
 2646   {
 2647     struct Value *l,inc;
 2648     struct Pc savepc;
 2649 
 2650     ++pc.token;
 2651     while (1)
 2652     {
 2653       /* get variable lvalue */ /*{{{*/
 2654       savepc=pc;
 2655       pc=(*next)[level].var;
 2656       if ((l=lvalue(value))->type==V_ERROR) return value;
 2657       pc=savepc;
 2658       /*}}}*/
 2659       /* get limit value and increment */ /*{{{*/
 2660       savepc=pc;
 2661       pc=(*next)[level].limit;
 2662       if (eval(value,_("limit"))->type==V_ERROR) return value;
 2663       Value_retype(value,l->type);
 2664       assert(value->type!=V_ERROR);
 2665       if (pc.token->type==T_STEP)
 2666       {
 2667         Value_clone(&inc,&pc.token->u.step);
 2668       }
 2669       else VALUE_NEW_INTEGER(&inc,1);
 2670       VALUE_RETYPE(&inc,l->type);
 2671       assert(inc.type!=V_ERROR);
 2672       pc=savepc;
 2673       /*}}}*/
 2674       Value_add(l,&inc,1);
 2675       if (Value_exitFor(l,value,&inc))
 2676       {
 2677         Value_destroy(value);
 2678         Value_destroy(&inc);
 2679         if (pc.token->type==T_IDENTIFIER)
 2680         {
 2681           if (lvalue(value)->type==V_ERROR) return value;
 2682           if (pc.token->type==T_COMMA) { ++pc.token; ++level; }
 2683           else break;
 2684         }
 2685         else break;
 2686       }
 2687       else
 2688       {
 2689         pc=(*next)[level].body;
 2690         Value_destroy(value);
 2691         Value_destroy(&inc);
 2692         break;
 2693       }
 2694     }
 2695   }
 2696   /*}}}*/
 2697   else /*{{{*/
 2698   {
 2699     struct Pc *body;
 2700 
 2701     ++pc.token;
 2702     while (1)
 2703     {
 2704       if ((body=popLabel(L_FOR_BODY))==(struct Pc*)0) return Value_new_ERROR(value,STRAYNEXT,topLabelDescription());
 2705       if (level)
 2706       {
 2707         struct Next *more;
 2708 
 2709         more=realloc(*next,sizeof(struct Next)*(level+1));
 2710         *next=more;
 2711       }
 2712       (*next)[level].body=*body;
 2713       (*next)[level].limit=*popLabel(L_FOR_LIMIT);
 2714       (*next)[level].var=*popLabel(L_FOR_VAR);
 2715       (*next)[level].fr=*popLabel(L_FOR);
 2716       if (pc.token->type==T_IDENTIFIER)
 2717       {
 2718         if (cistrcmp(pc.token->u.identifier->name,(*next)[level].var.token->u.identifier->name))
 2719         {
 2720           return Value_new_ERROR(value,FORMISMATCH);
 2721         }
 2722         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)
 2723         {
 2724           return Value_new_ERROR(value,REDECLARATION);
 2725         }
 2726         if (lvalue(value)->type==V_ERROR) return value;
 2727         if (pc.token->type==T_COMMA) { ++pc.token; ++level; }
 2728         else break;
 2729       }
 2730       else break;
 2731     }
 2732     while (level>=0) (*next)[level--].fr.token->u.exitfor=pc;
 2733   }
 2734   /*}}}*/
 2735   return (struct Value*)0;
 2736 }
 2737 /*}}}*/
 2738 struct Value *stmt_ON(struct Value *value) /*{{{*/
 2739 {
 2740   struct On *on=&pc.token->u.on;
 2741 
 2742   ++pc.token;
 2743   if (eval(value,_("selector"))->type==V_ERROR) return value;
 2744   if (Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 2745   if (pass==INTERPRET)
 2746   {
 2747     struct Pc newpc;
 2748 
 2749     if (value->u.integer>0 && value->u.integer<on->pcLength)
 2750     {
 2751       newpc=on->pc[value->u.integer];
 2752     }
 2753     else newpc=on->pc[0];
 2754     if (pc.token->type==T_GOTO) pc=newpc;
 2755     else
 2756     {
 2757       pc=on->pc[0];
 2758       Auto_pushGosubRet(&stack,&pc);
 2759       pc=newpc;
 2760     }
 2761     Program_trace(&program,&pc,0,1);
 2762   }
 2763   else if (pass==DECLARE || pass==COMPILE)
 2764   {
 2765     Value_destroy(value);
 2766     if (pc.token->type!=T_GOTO && pc.token->type!=T_GOSUB) return Value_new_ERROR(value,MISSINGGOTOSUB);
 2767     ++pc.token;
 2768     on->pcLength=1;
 2769     while (1)
 2770     {
 2771       on->pc=realloc(on->pc,sizeof(struct Pc)*++on->pcLength);
 2772       if (pc.token->type!=T_INTEGER) return Value_new_ERROR(value,MISSINGLINENUMBER);
 2773       if (Program_goLine(&program,pc.token->u.integer,&on->pc[on->pcLength-1])==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE);
 2774       if (pass==COMPILE && Program_scopeCheck(&program,&on->pc[on->pcLength-1],findLabel(L_FUNC))) return Value_new_ERROR(value,OUTOFSCOPE);
 2775       ++pc.token;
 2776       if (pc.token->type==T_COMMA) ++pc.token;
 2777       else break;
 2778     }
 2779     on->pc[0]=pc;
 2780   }
 2781   return (struct Value*)0;
 2782 }
 2783 /*}}}*/
 2784 struct Value *stmt_ONERROR(struct Value *value) /*{{{*/
 2785 {
 2786   if (DIRECTMODE) return Value_new_ERROR(value,NOTINDIRECTMODE);
 2787   ++pc.token;
 2788   if (pass==INTERPRET)
 2789   {
 2790     stack.onerror=pc;
 2791     Program_nextLine(&program,&pc);
 2792     return (struct Value*)0;
 2793   }
 2794   else return &more_statements;
 2795 }
 2796 /*}}}*/
 2797 struct Value *stmt_ONERRORGOTO0(struct Value *value) /*{{{*/
 2798 {
 2799   if (DIRECTMODE) return Value_new_ERROR(value,NOTINDIRECTMODE);
 2800   if (pass==INTERPRET)
 2801   {
 2802     stack.onerror.line=-1;
 2803     if (stack.resumeable)
 2804     {
 2805       pc=stack.erpc;
 2806       return Value_clone(value,&stack.err);
 2807     }
 2808   }
 2809   ++pc.token;
 2810   return (struct Value*)0;
 2811 }
 2812 /*}}}*/
 2813 struct Value *stmt_ONERROROFF(struct Value *value) /*{{{*/
 2814 {
 2815   if (DIRECTMODE) return Value_new_ERROR(value,NOTINDIRECTMODE);
 2816   if (pass==INTERPRET) stack.onerror.line=-1;
 2817   ++pc.token;
 2818   return (struct Value*)0;
 2819 }
 2820 /*}}}*/
 2821 struct Value *stmt_OPEN(struct Value *value) /*{{{*/
 2822 {
 2823   int inout=-1,append=0;
 2824   int mode=FS_ACCESS_NONE,lock=FS_LOCK_NONE;
 2825   long int channel;
 2826   long int recLength=-1;
 2827   struct Pc errpc;
 2828   struct Value recLengthValue;
 2829   struct Pc statementpc=pc;
 2830 
 2831   ++pc.token;
 2832   errpc=pc;
 2833   if (eval(value,_("mode or file"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value;
 2834   if (pc.token->type==T_COMMA) /* parse MBASIC syntax */ /*{{{*/
 2835   {
 2836     if (value->u.string.length>=1)
 2837     {
 2838       switch (tolower(value->u.string.character[0]))
 2839       {
 2840         case 'i': inout=0; mode=FS_ACCESS_READ; break;
 2841         case 'o': inout=1; mode=FS_ACCESS_WRITE; break;
 2842         case 'a': inout=1; mode=FS_ACCESS_WRITE; append=1; break;
 2843         case 'r': inout=3; mode=FS_ACCESS_READWRITE; break;
 2844       }
 2845     }
 2846     Value_destroy(value);
 2847     if (pass==INTERPRET && inout==-1) 
 2848     {
 2849       pc=errpc;
 2850       return Value_new_ERROR(value,BADMODE);
 2851     }
 2852     if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA);
 2853     ++pc.token;
 2854     if (pc.token->type==T_CHANNEL) ++pc.token;
 2855     errpc=pc;
 2856     if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR)
 2857     {
 2858       pc=errpc;
 2859       return value;
 2860     }
 2861     channel=value->u.integer;
 2862     Value_destroy(value);
 2863     if (pass==INTERPRET && channel<0) return Value_new_ERROR(value,OUTOFRANGE,_("channel"));
 2864     if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA);
 2865     ++pc.token;
 2866     if (eval(value,_("file name"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value;
 2867     if (inout==3)
 2868     {
 2869       if (pc.token->type!=T_COMMA)
 2870       {
 2871         Value_destroy(value);
 2872         return Value_new_ERROR(value,MISSINGCOMMA);
 2873       }
 2874       ++pc.token;
 2875       errpc=pc;
 2876       if (eval(&recLengthValue,_("record length"))->type==V_ERROR || Value_retype(&recLengthValue,V_INTEGER)->type==V_ERROR)
 2877       {
 2878         Value_destroy(value);
 2879         *value=recLengthValue;
 2880         return value;
 2881       }
 2882       recLength=recLengthValue.u.integer;
 2883       Value_destroy(&recLengthValue);
 2884       if (pass==INTERPRET && recLength<=0)
 2885       {
 2886         Value_destroy(value);
 2887         pc=errpc;
 2888         return Value_new_ERROR(value,OUTOFRANGE,_("record length"));
 2889       }
 2890     }
 2891   }
 2892   /*}}}*/
 2893   else /* parse ANSI syntax */ /*{{{*/
 2894   {
 2895     struct Value channelValue;
 2896     int newMode;
 2897 
 2898     switch (pc.token->type)
 2899     {
 2900       case T_FOR_INPUT:  inout=0; mode=FS_ACCESS_READ; ++pc.token; break;
 2901       case T_FOR_OUTPUT: inout=1; mode=FS_ACCESS_WRITE; ++pc.token; break;
 2902       case T_FOR_APPEND: inout=1; mode=FS_ACCESS_WRITE; append=1; ++pc.token; break;
 2903       case T_FOR_RANDOM: inout=3; mode=FS_ACCESS_READWRITE; ++pc.token; break;
 2904       case T_FOR_BINARY: inout=4; mode=FS_ACCESS_READWRITE; ++pc.token; break;
 2905       default: inout=3; mode=FS_ACCESS_READWRITE; break;
 2906     }
 2907     switch (pc.token->type)
 2908     {
 2909       case T_ACCESS_READ:       newMode=FS_ACCESS_READ;      break;
 2910       case T_ACCESS_READ_WRITE: newMode=FS_ACCESS_READWRITE; break;
 2911       case T_ACCESS_WRITE:      newMode=FS_ACCESS_WRITE;     break;
 2912       default:                  newMode=FS_ACCESS_NONE;
 2913     }
 2914     if (newMode!=FS_ACCESS_NONE)
 2915     {
 2916       if ((newMode&mode)==0) return Value_new_ERROR(value,WRONGMODE);
 2917       mode=newMode;
 2918       ++pc.token;
 2919     }
 2920     switch (pc.token->type)
 2921     {
 2922       case T_SHARED:          lock=FS_LOCK_NONE;      ++pc.token; break;
 2923       case T_LOCK_READ:       lock=FS_LOCK_SHARED;    ++pc.token; break;
 2924       case T_LOCK_WRITE:      lock=FS_LOCK_EXCLUSIVE; ++pc.token; break;
 2925       default: ;
 2926     }
 2927     if (pc.token->type!=T_AS)
 2928     {
 2929       Value_destroy(value);
 2930       return Value_new_ERROR(value,MISSINGAS);
 2931     }
 2932     ++pc.token;
 2933     if (pc.token->type==T_CHANNEL) ++pc.token;
 2934     errpc=pc;
 2935     if (eval(&channelValue,_("channel"))->type==V_ERROR || Value_retype(&channelValue,V_INTEGER)->type==V_ERROR)
 2936     {
 2937       pc=errpc;
 2938       Value_destroy(value);
 2939       *value=channelValue;
 2940       return value;
 2941     }
 2942     channel=channelValue.u.integer;
 2943     Value_destroy(&channelValue);
 2944     if (inout==3)
 2945     {
 2946       if (pc.token->type==T_IDENTIFIER)
 2947       {
 2948         if (cistrcmp(pc.token->u.identifier->name,"len"))
 2949         {
 2950           Value_destroy(value);
 2951           return Value_new_ERROR(value,MISSINGLEN);
 2952         }
 2953         ++pc.token;
 2954         if (pc.token->type!=T_EQ)
 2955         {
 2956           Value_destroy(value);
 2957           return Value_new_ERROR(value,MISSINGEQ);
 2958         }
 2959         ++pc.token;
 2960         errpc=pc;
 2961         if (eval(&recLengthValue,_("record length"))->type==V_ERROR || Value_retype(&recLengthValue,V_INTEGER)->type==V_ERROR)
 2962         {
 2963           Value_destroy(value);
 2964           *value=recLengthValue;
 2965           return value;
 2966         }
 2967         recLength=recLengthValue.u.integer;
 2968         Value_destroy(&recLengthValue);
 2969         if (pass==INTERPRET && recLength<=0)
 2970         {
 2971           Value_destroy(value);
 2972           pc=errpc;
 2973           return Value_new_ERROR(value,OUTOFRANGE,_("record length"));
 2974         }
 2975       }
 2976       else recLength=1;
 2977     }
 2978   }
 2979   /*}}}*/
 2980   /* open file with name value */ /*{{{*/
 2981   if (pass==INTERPRET)
 2982   {
 2983     int res=-1;
 2984 
 2985     if (inout==0) res=FS_openinChn(channel,value->u.string.character,mode);
 2986     else if (inout==1) res=FS_openoutChn(channel,value->u.string.character,mode,append);
 2987     else if (inout==3) res=FS_openrandomChn(channel,value->u.string.character,mode,recLength);
 2988     else if (inout==4) res=FS_openbinaryChn(channel,value->u.string.character,mode);
 2989     if (res==-1)
 2990     {
 2991       pc=statementpc;
 2992       Value_destroy(value);
 2993       return Value_new_ERROR(value,IOERROR,FS_errmsg);
 2994     }
 2995     else
 2996     {
 2997       if (lock!=FS_LOCK_NONE && FS_lock(channel,0,0,lock,0)==-1)
 2998       {
 2999         pc=statementpc;
 3000         Value_destroy(value);
 3001         Value_new_ERROR(value,IOERROR,FS_errmsg);
 3002         FS_close(channel);
 3003         return value;
 3004       }
 3005     }
 3006   }
 3007   /*}}}*/
 3008   Value_destroy(value);
 3009   return (struct Value*)0;
 3010 }
 3011 /*}}}*/
 3012 struct Value *stmt_OPTIONBASE(struct Value *value) /*{{{*/
 3013 {
 3014   ++pc.token;
 3015   if (eval(value,_("array subscript base"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value;
 3016   if (pass==INTERPRET) optionbase=value->u.integer;
 3017   Value_destroy(value);
 3018   return (struct Value*)0;
 3019 }
 3020 /*}}}*/
 3021 struct Value *stmt_OPTIONRUN(struct Value *value) /*{{{*/
 3022 {
 3023   ++pc.token;
 3024   if (pass==INTERPRET)
 3025   {
 3026     FS_allowIntr(0);
 3027     FS_xonxoff(STDCHANNEL,0);
 3028   }
 3029   return (struct Value*)0;
 3030 }
 3031 /*}}}*/
 3032 struct Value *stmt_OPTIONSTOP(struct Value *value) /*{{{*/
 3033 {
 3034   ++pc.token;
 3035   if (pass==INTERPRET)
 3036   {
 3037     FS_allowIntr(1);
 3038     FS_xonxoff(STDCHANNEL,1);
 3039   }
 3040   return (struct Value*)0;
 3041 }
 3042 /*}}}*/
 3043 struct Value *stmt_OUT_POKE(struct Value *value) /*{{{*/
 3044 {
 3045   int out,address,val;
 3046   struct Pc lpc;
 3047 
 3048   out=(pc.token->type==T_OUT);
 3049   lpc=pc;
 3050   ++pc.token;
 3051   if (eval(value,_("address"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 3052   address=value->u.integer;
 3053   Value_destroy(value);
 3054   if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA);
 3055   ++pc.token;
 3056   if (eval(value,_("output value"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 3057   val=value->u.integer;
 3058   Value_destroy(value);
 3059   if (pass==INTERPRET)
 3060   {
 3061     if ((out ? FS_portOutput : FS_memOutput)(address,val)==-1)
 3062     {
 3063       pc=lpc;
 3064       return Value_new_ERROR(value,IOERROR,FS_errmsg);
 3065     }
 3066   }
 3067   return (struct Value*)0;
 3068 }
 3069 /*}}}*/
 3070 struct Value *stmt_PRINT_LPRINT(struct Value *value) /*{{{*/
 3071 {
 3072   int nl=1;
 3073   int chn=(pc.token->type==T_PRINT?STDCHANNEL:LPCHANNEL);
 3074   int printusing=0;
 3075   struct Value usingval;
 3076   struct String *using=(struct String*)0;
 3077   size_t usingpos=0;
 3078 
 3079   ++pc.token;
 3080   if (chn==STDCHANNEL && pc.token->type==T_CHANNEL) /*{{{*/
 3081   {
 3082     ++pc.token;
 3083     if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 3084     chn=value->u.integer;
 3085     Value_destroy(value);
 3086     if (pc.token->type==T_COMMA) ++pc.token;
 3087   }
 3088   /*}}}*/
 3089   if (pc.token->type==T_USING) /*{{{*/
 3090   {
 3091     struct Pc usingpc;
 3092 
 3093     usingpc=pc;    
 3094     printusing=1;
 3095     ++pc.token;
 3096     if (pc.token->type==T_INTEGER)
 3097     {
 3098       if (pass==COMPILE && Program_imageLine(&program,pc.token->u.integer,&usingpc.token->u.image)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHIMAGELINE);
 3099       else if (pass==INTERPRET) using=usingpc.token->u.image.token->u.string;
 3100       Value_new_STRING(&usingval);
 3101       ++pc.token;
 3102     }
 3103     else
 3104     {
 3105       if (eval(&usingval,_("format string"))->type==V_ERROR || Value_retype(&usingval,V_STRING)->type==V_ERROR)
 3106       {
 3107         *value=usingval;
 3108         return value;
 3109       }
 3110       using=&usingval.u.string;
 3111     }
 3112     if (pc.token->type!=T_SEMICOLON)
 3113     {
 3114       Value_destroy(&usingval);
 3115       return Value_new_ERROR(value,MISSINGSEMICOLON);
 3116     }
 3117     ++pc.token;
 3118   }
 3119   /*}}}*/
 3120   else
 3121   {
 3122     Value_new_STRING(&usingval);
 3123     using=&usingval.u.string;
 3124   }
 3125   while (1)
 3126   {
 3127     struct Pc valuepc;
 3128 
 3129     valuepc=pc;
 3130     if (eval(value,(const char*)0)) /*{{{*/
 3131     {
 3132       if (value->type==V_ERROR)
 3133       {
 3134         Value_destroy(&usingval);
 3135         return value;
 3136       }
 3137       if (pass==INTERPRET)
 3138       {
 3139         struct String s;
 3140 
 3141         String_new(&s);
 3142         if (Value_toStringUsing(value,&s,using,&usingpos)->type==V_ERROR)
 3143         {
 3144           Value_destroy(&usingval);
 3145           String_destroy(&s);
 3146           pc=valuepc;
 3147           return value;
 3148         }
 3149         if (FS_putItem(chn,&s)==-1)
 3150         {
 3151           Value_destroy(&usingval);
 3152           Value_destroy(value);
 3153           String_destroy(&s);
 3154           return Value_new_ERROR(value,IOERROR,FS_errmsg);
 3155         }
 3156         String_destroy(&s);
 3157       }
 3158       Value_destroy(value);
 3159       nl=1;
 3160     }
 3161     /*}}}*/
 3162     else if (pc.token->type==T_TAB || pc.token->type==T_SPC) /*{{{*/
 3163     {
 3164       int tab=pc.token->type==T_TAB;
 3165 
 3166       ++pc.token;
 3167       if (pc.token->type!=T_OP)
 3168       {
 3169         Value_destroy(&usingval);
 3170         return Value_new_ERROR(value,MISSINGOP);
 3171       }
 3172       ++pc.token;
 3173       if (eval(value,_("count"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR)
 3174       {
 3175         Value_destroy(&usingval);
 3176         return value;
 3177       }
 3178       if (pass==INTERPRET)
 3179       {
 3180         int s=value->u.integer;
 3181         int r=0;
 3182 
 3183         if (tab) r=FS_tab(chn,s);
 3184         else while (s-->0 && (r=FS_putChar(chn,' '))!=-1);
 3185         if (r==-1)
 3186         {
 3187           Value_destroy(&usingval);
 3188           Value_destroy(value);
 3189           return Value_new_ERROR(value,IOERROR,FS_errmsg);
 3190         }
 3191       }
 3192       Value_destroy(value);
 3193       if (pc.token->type!=T_CP)
 3194       {
 3195         Value_destroy(&usingval);
 3196         return Value_new_ERROR(value,MISSINGCP);
 3197       }
 3198       ++pc.token;
 3199       nl=1;
 3200     }
 3201     /*}}}*/
 3202     else if (pc.token->type==T_SEMICOLON) /*{{{*/
 3203     {
 3204       ++pc.token;
 3205       nl=0;
 3206     }
 3207     /*}}}*/
 3208     else if (pc.token->type==T_COMMA) /*{{{*/
 3209     {
 3210       ++pc.token;
 3211       if (pass==INTERPRET && !printusing) FS_nextcol(chn);
 3212       nl=0;
 3213     }
 3214     /*}}}*/
 3215     else break;
 3216     if (pass==INTERPRET && FS_flush(chn)==-1)
 3217     {
 3218       Value_destroy(&usingval);
 3219       return Value_new_ERROR(value,IOERROR,FS_errmsg);
 3220     }
 3221   }
 3222   Value_destroy(&usingval);
 3223   if (pass==INTERPRET)
 3224   {
 3225     if (nl && FS_putChar(chn,'\n')==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 3226     if (FS_flush(chn)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 3227   }
 3228   return (struct Value*)0;
 3229 }
 3230 /*}}}*/
 3231 struct Value *stmt_RANDOMIZE(struct Value *value) /*{{{*/
 3232 {
 3233   struct Pc argpc;
 3234 
 3235   ++pc.token;
 3236   argpc=pc;
 3237   if (eval(value,(const char*)0))
 3238   {
 3239     Value_retype(value,V_INTEGER);
 3240     if (value->type==V_ERROR)
 3241     {
 3242       pc=argpc;
 3243       Value_destroy(value);
 3244       return Value_new_ERROR(value,MISSINGEXPR,_("random number generator seed"));
 3245     }
 3246     if (pass==INTERPRET) srand(pc.token->u.integer);
 3247     Value_destroy(value);
 3248   }
 3249   else srand(getpid()^time((time_t*)0));
 3250   return (struct Value*)0;
 3251 }
 3252 /*}}}*/
 3253 struct Value *stmt_READ(struct Value *value) /*{{{*/
 3254 {
 3255   ++pc.token;
 3256   while (1)
 3257   {
 3258     struct Value *l;
 3259     struct Pc lvaluepc;
 3260 
 3261     lvaluepc=pc;
 3262     if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGREADIDENT);
 3263     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)
 3264     {
 3265       return Value_new_ERROR(value,REDECLARATION);
 3266     }
 3267     if ((l=lvalue(value))->type==V_ERROR) return value;
 3268     if (pass==INTERPRET && dataread(value,l))
 3269     {
 3270       pc=lvaluepc;
 3271       return value;
 3272     }
 3273     if (pc.token->type==T_COMMA) ++pc.token;
 3274     else break;
 3275   }
 3276   return (struct Value*)0;
 3277 }
 3278 /*}}}*/
 3279 struct Value *stmt_COPY_RENAME(struct Value *value) /*{{{*/
 3280 {
 3281   struct Pc argpc;
 3282   struct Value from;
 3283   struct Pc statementpc=pc;
 3284 
 3285   ++pc.token;
 3286   argpc=pc;
 3287   if (eval(&from,_("source file"))->type==V_ERROR || (pass!=DECLARE && Value_retype(&from,V_STRING)->type==V_ERROR))
 3288   {
 3289     pc=argpc;
 3290     *value=from;
 3291     return value;
 3292   }
 3293   if (pc.token->type!=T_TO)
 3294   {
 3295     Value_destroy(&from);
 3296     return Value_new_ERROR(value,MISSINGTO);
 3297   }
 3298   ++pc.token;
 3299   argpc=pc;
 3300   if (eval(value,_("destination file"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_STRING)->type==V_ERROR))
 3301   {
 3302     pc=argpc;
 3303     return value;
 3304   }
 3305   if (pass==INTERPRET)
 3306   {
 3307     const char *msg;
 3308     int res;
 3309 
 3310     if (statementpc.token->type==T_RENAME)
 3311     {
 3312       res=rename(from.u.string.character,value->u.string.character);
 3313       msg=strerror(errno);
 3314     }
 3315     else
 3316     {
 3317       res=FS_copy(from.u.string.character,value->u.string.character);
 3318       msg=FS_errmsg;
 3319     }
 3320     if (res==-1)
 3321     {
 3322       Value_destroy(&from);
 3323       Value_destroy(value);
 3324       pc=statementpc;
 3325       return Value_new_ERROR(value,IOERROR,msg);
 3326     }
 3327   }
 3328   Value_destroy(&from);
 3329   Value_destroy(value);
 3330   return (struct Value*)0;
 3331 }
 3332 /*}}}*/
 3333 struct Value *stmt_RENUM(struct Value *value) /*{{{*/
 3334 {
 3335   int first=10,inc=10;
 3336 
 3337   ++pc.token;
 3338   if (pc.token->type==T_INTEGER)
 3339   {
 3340     first=pc.token->u.integer;
 3341     ++pc.token;
 3342     if (pc.token->type==T_COMMA)
 3343     {
 3344       ++pc.token;
 3345       if (pc.token->type!=T_INTEGER) return Value_new_ERROR(value,MISSINGINCREMENT);
 3346       inc=pc.token->u.integer;
 3347       ++pc.token;
 3348     }
 3349   }
 3350   if (pass==INTERPRET)
 3351   {
 3352     if (!DIRECTMODE) return Value_new_ERROR(value,NOTINPROGRAMMODE);
 3353     Program_renum(&program,first,inc);
 3354   }
 3355   return (struct Value*)0;
 3356 }
 3357 /*}}}*/
 3358 struct Value *stmt_REPEAT(struct Value *value) /*{{{*/
 3359 {
 3360   if (pass==DECLARE || pass==COMPILE) pushLabel(L_REPEAT,&pc);
 3361   ++pc.token;
 3362   return (struct Value*)0;
 3363 }
 3364 /*}}}*/
 3365 struct Value *stmt_RESTORE(struct Value *value) /*{{{*/
 3366 {
 3367   struct Token *restorepc=pc.token;
 3368 
 3369   if (pass==INTERPRET) curdata=pc.token->u.restore;
 3370   ++pc.token;
 3371   if (pc.token->type==T_INTEGER)
 3372   {
 3373     if (pass==COMPILE && Program_dataLine(&program,pc.token->u.integer,&restorepc->u.restore)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHDATALINE);
 3374     ++pc.token;
 3375   }
 3376   else if (pass==COMPILE) restorepc->u.restore=stack.begindata;
 3377   return (struct Value*)0;
 3378 }
 3379 /*}}}*/
 3380 struct Value *stmt_RETURN(struct Value *value) /*{{{*/
 3381 {
 3382   if (pass==DECLARE || pass==COMPILE) ++pc.token;
 3383   if (pass==INTERPRET)
 3384   {
 3385     if (Auto_gosubReturn(&stack,&pc)) Program_trace(&program,&pc,0,1);
 3386     else return Value_new_ERROR(value,STRAYRETURN);
 3387   }
 3388   return (struct Value*)0;
 3389 }
 3390 /*}}}*/
 3391 struct Value *stmt_RUN(struct Value *value) /*{{{*/
 3392 {
 3393   struct Pc argpc,begin;
 3394 
 3395   stack.resumeable=0;
 3396   ++pc.token;
 3397   argpc=pc;
 3398   if (pc.token->type==T_INTEGER)
 3399   {
 3400     if (Program_goLine(&program,pc.token->u.integer,&begin)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE);
 3401     if (pass==COMPILE && Program_scopeCheck(&program,&begin,findLabel(L_FUNC))) return Value_new_ERROR(value,OUTOFSCOPE);
 3402     ++pc.token;
 3403   }
 3404   else if (eval(value,(const char*)0))
 3405   {
 3406     if (value->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR)
 3407     {
 3408       pc=argpc;
 3409       return value;
 3410     }
 3411     else if (pass==INTERPRET)
 3412     {
 3413       int chn;
 3414       struct Program newprogram;
 3415 
 3416       if ((chn=FS_openin(value->u.string.character))==-1)
 3417       {
 3418         pc=argpc;
 3419         Value_destroy(value);
 3420         return Value_new_ERROR(value,IOERROR,FS_errmsg);
 3421       }
 3422       Value_destroy(value);
 3423       Program_new(&newprogram);
 3424       if (Program_merge(&newprogram,chn,value))
 3425       {
 3426         pc=argpc;
 3427         Program_destroy(&newprogram);
 3428         return value;
 3429       }
 3430       FS_close(chn);
 3431       new();
 3432       Program_destroy(&program);
 3433       program=newprogram;
 3434       if (Program_beginning(&program,&begin)==(struct Pc*)0)
 3435       {
 3436         return Value_new_ERROR(value,NOPROGRAM);
 3437       } 
 3438     }
 3439     else Value_destroy(value);
 3440   }
 3441   else
 3442   {
 3443     if (Program_beginning(&program,&begin)==(struct Pc*)0)
 3444     {
 3445       return Value_new_ERROR(value,NOPROGRAM);
 3446     }
 3447   }
 3448   if (pass==INTERPRET)
 3449   {
 3450     if (compileProgram(value,1)->type==V_ERROR) return value;
 3451     pc=begin;
 3452     curdata=stack.begindata;
 3453     Global_clear(&globals);
 3454     FS_closefiles();
 3455     Program_trace(&program,&pc,0,1);
 3456   }
 3457   return (struct Value*)0;
 3458 }
 3459 /*}}}*/
 3460 struct Value *stmt_SAVE(struct Value *value) /*{{{*/
 3461 {
 3462   struct Pc loadpc;
 3463   int name;
 3464 
 3465   if (pass==INTERPRET && !DIRECTMODE) return Value_new_ERROR(value,NOTINPROGRAMMODE);
 3466   ++pc.token;
 3467   loadpc=pc;
 3468   if (pc.token->type==T_EOL && program.name.length)
 3469   {
 3470     name=0;
 3471   }
 3472   else
 3473   {
 3474     name=1;
 3475     if (eval(value,_("file name"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR)
 3476     {
 3477       pc=loadpc;
 3478       return value;
 3479     }
 3480   }
 3481   if (pass==INTERPRET)
 3482   {
 3483     int chn;
 3484 
 3485     if (name) Program_setname(&program,value->u.string.character);
 3486     if ((chn=FS_openout(program.name.character))==-1)
 3487     {
 3488       pc=loadpc;
 3489       if (name) Value_destroy(value);
 3490       return Value_new_ERROR(value,IOERROR,FS_errmsg);
 3491     }
 3492     FS_width(chn,0);
 3493     if (name) Value_destroy(value);
 3494     if (Program_list(&program,chn,0,(struct Pc*)0,(struct Pc*)0,value))
 3495     {
 3496       pc=loadpc;
 3497       return value;
 3498     }
 3499     FS_close(chn);
 3500     program.unsaved=0;
 3501   }
 3502   else if (name) Value_destroy(value);
 3503   return (struct Value*)0;
 3504 }
 3505 /*}}}*/
 3506 struct Value *stmt_SELECTCASE(struct Value *value) /*{{{*/
 3507 {
 3508   struct Pc statementpc=pc;
 3509 
 3510   if (pass==DECLARE || pass==COMPILE) pushLabel(L_SELECTCASE,&pc);
 3511   ++pc.token;
 3512   if (eval(value,_("selector"))->type==V_ERROR) return value;
 3513   if (pass==DECLARE || pass==COMPILE)
 3514   {
 3515     statementpc.token->u.selectcase->type=value->type;
 3516     statementpc.token->u.selectcase->nextcasevalue.line=-1;
 3517   }
 3518   else
 3519   {
 3520     struct Pc casevaluepc;
 3521     int match=0;
 3522 
 3523     pc=casevaluepc=statementpc.token->u.selectcase->nextcasevalue;
 3524     do
 3525     {
 3526       ++pc.token;
 3527       switch (casevaluepc.token->type)
 3528       {
 3529         case T_CASEVALUE: /*{{{*/
 3530         {
 3531           do
 3532           {
 3533             struct Value casevalue1;
 3534 
 3535             if (pc.token->type==T_IS)
 3536             {
 3537               enum TokenType relop;
 3538 
 3539               ++pc.token;
 3540               relop=pc.token->type;
 3541               ++pc.token;
 3542               if (eval(&casevalue1,"`is'")->type==V_ERROR)
 3543               {
 3544                 Value_destroy(value);
 3545                 *value=casevalue1;
 3546                 return value;
 3547               }
 3548               Value_retype(&casevalue1,statementpc.token->u.selectcase->type);
 3549               assert(casevalue1.type!=V_ERROR);
 3550               if (!match) /*{{{*/
 3551               {
 3552                 struct Value cmp;
 3553 
 3554                 Value_clone(&cmp,value);
 3555                 switch (relop)
 3556                 {
 3557                   case T_LT: Value_lt(&cmp,&casevalue1,1); break;
 3558                   case T_LE: Value_le(&cmp,&casevalue1,1); break;
 3559                   case T_EQ: Value_eq(&cmp,&casevalue1,1); break;
 3560                   case T_GE: Value_ge(&cmp,&casevalue1,1); break;
 3561                   case T_GT: Value_gt(&cmp,&casevalue1,1); break;
 3562                   case T_NE: Value_ne(&cmp,&casevalue1,1); break;
 3563                   default: assert(0);
 3564                 }
 3565                 assert(cmp.type==V_INTEGER);
 3566                 match=cmp.u.integer;
 3567                 Value_destroy(&cmp);
 3568               }
 3569               /*}}}*/
 3570               Value_destroy(&casevalue1);
 3571             }
 3572             else
 3573             {
 3574               if (eval(&casevalue1,"`case'")->type==V_ERROR)
 3575               {
 3576                 Value_destroy(value);
 3577                 *value=casevalue1;
 3578                 return value;
 3579               }
 3580               Value_retype(&casevalue1,statementpc.token->u.selectcase->type);
 3581               assert(casevalue1.type!=V_ERROR);
 3582               if (pc.token->type==T_TO) /* match range */ /*{{{*/
 3583               {
 3584                 struct Value casevalue2;
 3585 
 3586                 ++pc.token;
 3587                 if (eval(&casevalue2,"`case'")->type==V_ERROR)
 3588                 {
 3589                   Value_destroy(&casevalue1);
 3590                   Value_destroy(value);
 3591                   *value=casevalue2;
 3592                   return value;
 3593                 }
 3594                 Value_retype(&casevalue2,statementpc.token->u.selectcase->type);
 3595                 assert(casevalue2.type!=V_ERROR);
 3596                 if (!match)
 3597                 {
 3598                   struct Value cmp1,cmp2;
 3599 
 3600                   Value_clone(&cmp1,value);
 3601                   Value_clone(&cmp2,value);
 3602                   Value_ge(&cmp1,&casevalue1,1);
 3603                   assert(cmp1.type==V_INTEGER);
 3604                   Value_le(&cmp2,&casevalue2,1);
 3605                   assert(cmp2.type==V_INTEGER);
 3606                   match=cmp1.u.integer && cmp2.u.integer;
 3607                   Value_destroy(&cmp1);
 3608                   Value_destroy(&cmp2);
 3609                 }
 3610                 Value_destroy(&casevalue2);
 3611               }
 3612               /*}}}*/
 3613               else /* match value */ /*{{{*/
 3614               {
 3615                 if (!match)
 3616                 {
 3617                   struct Value cmp;
 3618 
 3619                   Value_clone(&cmp,value);
 3620                   Value_eq(&cmp,&casevalue1,1);
 3621                   assert(cmp.type==V_INTEGER);
 3622                   match=cmp.u.integer;
 3623                   Value_destroy(&cmp);
 3624                 }
 3625               }
 3626               /*}}}*/
 3627               Value_destroy(&casevalue1);
 3628             }
 3629             if (pc.token->type==T_COMMA) ++pc.token;
 3630             else break;
 3631           } while (1);
 3632           break;
 3633         }
 3634         /*}}}*/
 3635         case T_CASEELSE: /*{{{*/
 3636         {
 3637           match=1;
 3638           break;
 3639         }
 3640         /*}}}*/
 3641         default: assert(0);
 3642       }
 3643       if (!match)
 3644       {
 3645         if (casevaluepc.token->u.casevalue->nextcasevalue.line!=-1)
 3646         {
 3647           pc=casevaluepc=casevaluepc.token->u.casevalue->nextcasevalue;
 3648         }
 3649         else
 3650         {
 3651           pc=statementpc.token->u.selectcase->endselect;
 3652           break;
 3653         }
 3654       }
 3655     } while (!match);
 3656   }
 3657   Value_destroy(value);
 3658   return (struct Value*)0;
 3659 }
 3660 /*}}}*/
 3661 struct Value *stmt_SHELL(struct Value *value) /*{{{*/
 3662 {
 3663   pid_t pid;
 3664   int status;
 3665 
 3666   ++pc.token;
 3667   if (eval(value,(const char*)0))
 3668   {
 3669     if (value->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value;
 3670     if (pass==INTERPRET)
 3671     {
 3672       if (run_restricted)
 3673       {
 3674         Value_destroy(value);
 3675         return Value_new_ERROR(value,RESTRICTED,strerror(errno));
 3676       }
 3677       FS_shellmode(STDCHANNEL);
 3678       switch (pid=fork())
 3679       {
 3680         case -1:
 3681         {
 3682           FS_fsmode(STDCHANNEL);
 3683           Value_destroy(value);
 3684           return Value_new_ERROR(value,FORKFAILED,strerror(errno));
 3685         }
 3686         case 0:
 3687         {
 3688           execl("/bin/sh","sh","-c",value->u.string.character,(const char*)0);
 3689           exit(127);
 3690         }
 3691         default:
 3692         {
 3693           while (waitpid(pid,&status,0)==-1 && errno!=EINTR);
 3694         }
 3695       }
 3696       FS_fsmode(STDCHANNEL);
 3697     }
 3698     Value_destroy(value);
 3699   }
 3700   else
 3701   {
 3702     if (pass==INTERPRET)
 3703     {
 3704       if (run_restricted)
 3705       {
 3706         return Value_new_ERROR(value,RESTRICTED,strerror(errno));
 3707       }
 3708       FS_shellmode(STDCHANNEL);
 3709       switch (pid=fork())
 3710       {
 3711         case -1:
 3712         {
 3713           FS_fsmode(STDCHANNEL);
 3714           return Value_new_ERROR(value,FORKFAILED,strerror(errno));
 3715         }
 3716         case 0:
 3717         {
 3718           const char *shell;
 3719 
 3720           shell=getenv("SHELL");
 3721           if (shell==(const char*)0) shell="/bin/sh";
 3722           execl(shell,(strrchr(shell,'/') ? strrchr(shell,'/')+1 : shell),(const char*)0);
 3723           exit(127);
 3724         }
 3725         default:
 3726         {
 3727           while (waitpid(pid,&status,0)==-1 && errno!=EINTR);
 3728         }
 3729       }
 3730       FS_fsmode(STDCHANNEL);
 3731     }
 3732   }
 3733   return (struct Value*)0;
 3734 }
 3735 /*}}}*/
 3736 struct Value *stmt_SLEEP(struct Value *value) /*{{{*/
 3737 {
 3738   ++pc.token;
 3739   if (eval(value,_("pause"))->type==V_ERROR || Value_retype(value,V_REAL)->type==V_ERROR) return value;
 3740   {
 3741     double s=value->u.real;
 3742 
 3743     Value_destroy(value);
 3744     if (pass==INTERPRET)
 3745     {
 3746       if (s<0.0) return Value_new_ERROR(value,OUTOFRANGE,_("pause"));
 3747       FS_sleep(s);
 3748     }
 3749   }
 3750   return (struct Value*)0;
 3751 }
 3752 /*}}}*/
 3753 struct Value *stmt_STOP(struct Value *value) /*{{{*/
 3754 {
 3755   if (pass==INTERPRET) FS_intr=1;
 3756   else
 3757   {
 3758     ++pc.token;
 3759   }
 3760   return (struct Value*)0;
 3761 }
 3762 /*}}}*/
 3763 struct Value *stmt_SUBEXIT(struct Value *value) /*{{{*/
 3764 {
 3765   struct Pc *curfn=(struct Pc*)0;
 3766 
 3767   if (pass==DECLARE || pass==COMPILE)
 3768   {
 3769     if ((curfn=findLabel(L_FUNC))==(struct Pc*)0 || (curfn->token+1)->u.identifier->defaultType!=V_VOID)
 3770     {
 3771       return Value_new_ERROR(value,STRAYSUBEXIT);
 3772     }
 3773   }
 3774   ++pc.token;
 3775   if (pass==INTERPRET) return Value_new_VOID(value);
 3776   return (struct Value*)0;
 3777 }
 3778 /*}}}*/
 3779 struct Value *stmt_SWAP(struct Value *value) /*{{{*/
 3780 {
 3781   struct Value *l1,*l2;
 3782   struct Pc lvaluepc;
 3783 
 3784   ++pc.token;
 3785   lvaluepc=pc;
 3786   if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGSWAPIDENT);
 3787   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)
 3788   {
 3789     return Value_new_ERROR(value,REDECLARATION);
 3790   }
 3791   if ((l1=lvalue(value))->type==V_ERROR) return value;
 3792   if (pc.token->type==T_COMMA) ++pc.token;
 3793   else return Value_new_ERROR(value,MISSINGCOMMA);
 3794   lvaluepc=pc;
 3795   if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGSWAPIDENT);
 3796   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)
 3797   {
 3798     return Value_new_ERROR(value,REDECLARATION);
 3799   }
 3800   if ((l2=lvalue(value))->type==V_ERROR) return value;
 3801   if (l1->type!=l2->type)
 3802   {
 3803     pc=lvaluepc;
 3804     return Value_new_typeError(value,l2->type,l1->type);
 3805   }
 3806   if (pass==INTERPRET)
 3807   {
 3808     struct Value foo;
 3809 
 3810     foo=*l1;
 3811     *l1=*l2;
 3812     *l2=foo;
 3813   }
 3814   return (struct Value*)0;
 3815 }
 3816 /*}}}*/
 3817 struct Value *stmt_SYSTEM(struct Value *value) /*{{{*/
 3818 {
 3819   ++pc.token;
 3820   if (pass==INTERPRET)
 3821   {
 3822     if (program.unsaved)
 3823     {
 3824       int ch;
 3825 
 3826       FS_putChars(STDCHANNEL,_("Quit without saving? (y/n) "));
 3827       FS_flush(STDCHANNEL);
 3828       if ((ch=FS_getChar(STDCHANNEL))!=-1)
 3829       {
 3830         FS_putChar(STDCHANNEL,ch);
 3831         FS_flush(STDCHANNEL);
 3832         FS_nextline(STDCHANNEL);
 3833         if (tolower(ch)==*_("yes"))
 3834         {
 3835           bas_exit();
 3836           exit(0);
 3837         }
 3838       }
 3839     }
 3840     else
 3841     {
 3842       bas_exit();
 3843       exit(0);
 3844     }
 3845   }
 3846   return (struct Value*)0;
 3847 }
 3848 /*}}}*/
 3849 struct Value *stmt_TROFF(struct Value *value) /*{{{*/
 3850 {
 3851   ++pc.token;
 3852   program.trace=0;
 3853   return (struct Value*)0;
 3854 }
 3855 /*}}}*/
 3856 struct Value *stmt_TRON(struct Value *value) /*{{{*/
 3857 {
 3858   ++pc.token;
 3859   program.trace=1;
 3860   return (struct Value*)0;
 3861 }
 3862 /*}}}*/
 3863 struct Value *stmt_TRUNCATE(struct Value *value) /*{{{*/
 3864 {
 3865   struct Pc chnpc;
 3866   int chn;
 3867 
 3868   chnpc=pc;
 3869   ++pc.token;
 3870   if (pc.token->type==T_CHANNEL) ++pc.token;
 3871   if (eval(value,(const char*)0)==(struct Value*)0)
 3872   {
 3873     return Value_new_ERROR(value,MISSINGEXPR,_("channel"));
 3874   }
 3875   if (value->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 3876   chn=value->u.integer;
 3877   Value_destroy(value);
 3878   if (pass==INTERPRET && FS_truncate(chn)==-1)
 3879   {
 3880     pc=chnpc;
 3881     return Value_new_ERROR(value,IOERROR,FS_errmsg);
 3882   }
 3883   return (struct Value*)0;
 3884 }
 3885 /*}}}*/
 3886 struct Value *stmt_UNNUM(struct Value *value) /*{{{*/
 3887 {
 3888   ++pc.token;
 3889   if (pass==INTERPRET)
 3890   {
 3891     if (!DIRECTMODE) return Value_new_ERROR(value,NOTINPROGRAMMODE);
 3892     Program_unnum(&program);
 3893   }
 3894   return (struct Value*)0;
 3895 }
 3896 /*}}}*/
 3897 struct Value *stmt_UNTIL(struct Value *value) /*{{{*/
 3898 {
 3899   struct Pc untilpc=pc;
 3900   struct Pc *repeatpc;
 3901 
 3902   ++pc.token;
 3903   if (eval(value,_("condition"))->type==V_ERROR) return value;
 3904   if (pass==INTERPRET)
 3905   {
 3906     if (Value_isNull(value)) pc=untilpc.token->u.until;
 3907     Value_destroy(value);
 3908   }
 3909   if (pass==DECLARE || pass==COMPILE)
 3910   {
 3911     if ((repeatpc=popLabel(L_REPEAT))==(struct Pc*)0) return Value_new_ERROR(value,STRAYUNTIL);
 3912     untilpc.token->u.until=*repeatpc;
 3913   }
 3914   return (struct Value*)0;
 3915 }
 3916 /*}}}*/
 3917 struct Value *stmt_WAIT(struct Value *value) /*{{{*/
 3918 {
 3919   int address,mask,sel=-1,usesel;
 3920   struct Pc lpc;
 3921 
 3922   lpc=pc;
 3923   ++pc.token;
 3924   if (eval(value,_("address"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 3925   address=value->u.integer;
 3926   Value_destroy(value);
 3927   if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA);
 3928   ++pc.token;
 3929   if (eval(value,_("mask"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 3930   mask=value->u.integer;
 3931   Value_destroy(value);
 3932   if (pc.token->type==T_COMMA)
 3933   {
 3934     ++pc.token;
 3935     if (eval(value,_("select"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 3936     sel=value->u.integer;
 3937     usesel=1;
 3938     Value_destroy(value);
 3939   }
 3940   else usesel=0;
 3941   if (pass==INTERPRET)
 3942   {
 3943     int v;
 3944 
 3945     do
 3946     {
 3947       if ((v=FS_portInput(address))==-1)
 3948       {
 3949         pc=lpc;
 3950         return Value_new_ERROR(value,IOERROR,FS_errmsg);
 3951       }
 3952     } while ((usesel ? (v^sel)&mask : v^mask)==0);
 3953   }
 3954   return (struct Value*)0;
 3955 }
 3956 /*}}}*/
 3957 struct Value *stmt_WHILE(struct Value *value) /*{{{*/
 3958 {
 3959   struct Pc whilepc=pc;
 3960 
 3961   if (pass==DECLARE || pass==COMPILE) pushLabel(L_WHILE,&pc);
 3962   ++pc.token;
 3963   if (eval(value,_("condition"))->type==V_ERROR) return value;
 3964   if (pass==INTERPRET)
 3965   {
 3966     if (Value_isNull(value)) pc=*whilepc.token->u.afterwend;
 3967     Value_destroy(value);
 3968   }
 3969   return (struct Value*)0;
 3970 }
 3971 /*}}}*/
 3972 struct Value *stmt_WEND(struct Value *value) /*{{{*/
 3973 {
 3974   if (pass==DECLARE || pass==COMPILE)
 3975   {
 3976     struct Pc *whilepc;
 3977 
 3978     if ((whilepc=popLabel(L_WHILE))==(struct Pc*)0) return Value_new_ERROR(value,STRAYWEND,topLabelDescription());
 3979     *pc.token->u.whilepc=*whilepc;
 3980     ++pc.token;
 3981     *(whilepc->token->u.afterwend)=pc;
 3982   }
 3983   else pc=*pc.token->u.whilepc;
 3984   return (struct Value*)0;
 3985 }
 3986 /*}}}*/
 3987 struct Value *stmt_WIDTH(struct Value *value) /*{{{*/
 3988 {
 3989   int chn=STDCHANNEL,width;
 3990 
 3991   ++pc.token;
 3992   if (pc.token->type==T_CHANNEL) /*{{{*/
 3993   {
 3994     ++pc.token;
 3995     if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 3996     chn=value->u.integer;
 3997     Value_destroy(value);
 3998     if (pc.token->type==T_COMMA) ++pc.token;
 3999   }
 4000   /*}}}*/
 4001   if (eval(value,(const char*)0))
 4002   {
 4003     if (value->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 4004     width=value->u.integer;
 4005     Value_destroy(value);
 4006     if (pass==INTERPRET && FS_width(chn,width)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 4007   }
 4008   if (pc.token->type==T_COMMA) /*{{{*/
 4009   {
 4010     ++pc.token;
 4011     if (eval(value,_("zone width"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 4012     width=value->u.integer;
 4013     Value_destroy(value);
 4014     if (pass==INTERPRET && FS_zone(chn,width)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 4015   }
 4016   /*}}}*/
 4017   return (struct Value*)0;
 4018 }
 4019 /*}}}*/
 4020 struct Value *stmt_WRITE(struct Value *value) /*{{{*/
 4021 {
 4022   int chn=STDCHANNEL;
 4023   int comma=0;
 4024 
 4025   ++pc.token;
 4026   if (pc.token->type==T_CHANNEL) /*{{{*/
 4027   {
 4028     ++pc.token;
 4029     if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 4030     chn=value->u.integer;
 4031     Value_destroy(value);
 4032     if (pc.token->type==T_COMMA) ++pc.token;
 4033   }
 4034   /*}}}*/
 4035   while (1)
 4036   {
 4037     if (eval(value,(const char*)0)) 
 4038     {
 4039       if (value->type==V_ERROR) return value;
 4040       if (pass==INTERPRET)
 4041       {
 4042         struct String s;
 4043 
 4044         String_new(&s);
 4045         if (comma) String_appendChar(&s,',');
 4046         if (FS_putString(chn,Value_toWrite(value,&s))==-1)
 4047         {
 4048           Value_destroy(value);
 4049           return Value_new_ERROR(value,IOERROR,FS_errmsg);
 4050         }
 4051         if (FS_flush(chn)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 4052         String_destroy(&s);
 4053       }
 4054       Value_destroy(value);
 4055       comma=1;
 4056     }
 4057     else if (pc.token->type==T_COMMA || pc.token->type==T_SEMICOLON) ++pc.token;
 4058     else break;
 4059   }
 4060   if (pass==INTERPRET)
 4061   {
 4062     FS_putChar(chn,'\n');
 4063     if (FS_flush(chn)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 4064   }
 4065   return (struct Value*)0;
 4066 }
 4067 /*}}}*/
 4068 struct Value *stmt_XREF(struct Value *value) /*{{{*/
 4069 {
 4070   stack.resumeable=0;
 4071   ++pc.token;
 4072   if (pass==INTERPRET)
 4073   {
 4074     if (!program.runnable && compileProgram(value,1)->type==V_ERROR) return value;
 4075     Program_xref(&program,STDCHANNEL);
 4076   }
 4077   return (struct Value*)0;
 4078 }
 4079 /*}}}*/
 4080 struct Value *stmt_ZONE(struct Value *value) /*{{{*/
 4081 {
 4082   int chn=STDCHANNEL,width;
 4083 
 4084   ++pc.token;
 4085   if (pc.token->type==T_CHANNEL) /*{{{*/
 4086   {
 4087     ++pc.token;
 4088     if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 4089     chn=value->u.integer;
 4090     Value_destroy(value);
 4091     if (pc.token->type==T_COMMA) ++pc.token;
 4092   }
 4093   /*}}}*/
 4094   if (eval(value,_("zone width"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
 4095   width=value->u.integer;
 4096   Value_destroy(value);
 4097   if (pass==INTERPRET && FS_zone(chn,width)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
 4098   return (struct Value*)0;
 4099 }
 4100 /*}}}*/