source/interpret.c

   1 static const char CVSID[] = "$Id: interpret.c,v 1.27 2002/08/10 23:48:55 tringali Exp $";
   2 /*******************************************************************************
   3 *                                                                              *
   4 * interpret.c -- Nirvana Editor macro interpreter                              *
   5 *                                                                              *
   6 * Copyright (C) 1999 Mark Edel                                                 *
   7 *                                                                              *
   8 * This is free software; you can redistribute it and/or modify it under the    *
   9 * terms of the GNU General Public License as published by the Free Software    *
  10 * Foundation; either version 2 of the License, or (at your option) any later   *
  11 * version.                                                                     *
  12 *                                                                              *
  13 * This software is distributed in the hope that it will be useful, but WITHOUT *
  14 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or        *
  15 * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License        *
  16 * for more details.                                                            *
  17 *                                                                              *
  18 * You should have received a copy of the GNU General Public License along with *
  19 * software; if not, write to the Free Software Foundation, Inc., 59 Temple     *
  20 * Place, Suite 330, Boston, MA  02111-1307 USA                                 *
  21 *                                                                              *
  22 * Nirvana Text Editor                                                          *
  23 * April, 1997                                                                  *
  24 *                                                                              *
  25 * Written by Mark Edel                                                         *
  26 *                                                                              *
  27 *******************************************************************************/
  28
  29 #ifdef HAVE_CONFIG_H
  30 #include "../config.h"
  31 #endif
  32
  33 #include "interpret.h"
  34 #include "textBuf.h"
  35 #include "nedit.h"
  36 #include "menu.h"
  37 #include "text.h"
  38 #include "rbTree.h"
  39
  40 #include <stdio.h>
  41 #include <stdlib.h>
  42 #include <string.h>
  43 #include <math.h>
  44 #include <limits.h>
  45 #include <ctype.h>
  46 #include <errno.h>
  47 #ifdef VMS
  48 #include "../util/VMSparam.h"
  49 #else
  50 #ifndef __MVS__
  51 #include <sys/param.h>
  52 #endif
  53 #endif /*VMS*/
  54
  55 #include <X11/Intrinsic.h>
  56 #include <Xm/Xm.h>
  57
  58 #ifdef HAVE_DEBUG_H
  59 #include "../debug.h"
  60 #endif
  61
  62 #define PROGRAM_SIZE  4096      /* Maximum program size */
  63 #define MAX_ERR_MSG_LEN 256     /* Max. length for error messages */
  64 #define LOOP_STACK_SIZE 200     /* (Approx.) Number of break/continue stmts
  65                                    allowed per program */
  66 #define INSTRUCTION_LIMIT 100   /* Number of instructions the interpreter is
  67                                    allowed to execute before preempting and
  68                                    returning to allow other things to run */
  69
  70 /* Temporary markers placed in a branch address location to designate
  71    which loop address (break or continue) the location needs */
  72 #define NEEDS_BREAK (Inst)1
  73 #define NEEDS_CONTINUE (Inst)2
  74
  75 #define N_ARGS_ARG_SYM -1       /* special arg number meaning $n_args value */
  76
  77 enum opStatusCodes {STAT_OK=2, STAT_DONE, STAT_ERROR, STAT_PREEMPT};
  78
  79 static void addLoopAddr(Inst *addr);
  80 static void saveContext(RestartData *context);
  81 static void restoreContext(RestartData *context);
  82 static int returnNoVal(void);
  83 static int returnVal(void);
  84 static int returnValOrNone(int valOnStack);
  85 static int pushSymVal(void);
  86 static int dupStack(void);
  87 static int add(void);
  88 static int subtract(void);
  89 static int multiply(void);
  90 static int divide(void);
  91 static int modulo(void);
  92 static int negate(void);
  93 static int increment(void);
  94 static int decrement(void);
  95 static int gt(void);
  96 static int lt(void);
  97 static int ge(void);
  98 static int le(void);
  99 static int eq(void);
 100 static int ne(void);
 101 static int bitAnd(void);
 102 static int bitOr(void);
 103 static int and(void);
 104 static int or(void);
 105 static int not(void);
 106 static int power(void);
 107 static int concat(void);
 108 static int assign(void);
 109 static int callSubroutine(void);
 110 static int fetchRetVal(void);
 111 static int branch(void);
 112 static int branchTrue(void);
 113 static int branchFalse(void);
 114 static int branchNever(void);
 115 static int arrayRef(void);
 116 static int arrayAssign(void);
 117 static int beginArrayIter(void);
 118 static int arrayIter(void);
 119 static int inArray(void);
 120 static int deleteArrayElement(void);
 121 static void freeSymbolTable(Symbol *symTab);
 122 static int errCheck(const char *s);
 123 static int execError(const char *s1, const char *s2);
 124 static int stringToNum(const char *string, int *number);
 125 static rbTreeNode *arrayEmptyAllocator(void);
 126 static rbTreeNode *arrayAllocateNode(rbTreeNode *src);
 127 static int arrayEntryCopyToNode(rbTreeNode *dst, rbTreeNode *src);
 128 static int arrayEntryCompare(rbTreeNode *left, rbTreeNode *right);
 129 static void arrayDisposeNode(rbTreeNode *src);
 130 static SparseArrayEntry *allocateSparseArrayEntry(void);
 131 /* #define DEBUG_ASSEMBLY */
 132 #ifdef DEBUG_ASSEMBLY
 133 static void disasm(Program *prog, int nInstr);
 134 #endif
 135
 136 /* Global symbols and function definitions */
 137 static Symbol *GlobalSymList = NULL;
 138
 139 /* List of all memory allocated for strings */
 140 static char *AllocatedStrings = NULL;
 141
 142 typedef struct {
 143     SparseArrayEntry    data; /* LEAVE this as top entry */
 144     int inUse;              /* we use pointers to the data to refer to the entire struct */
 145     struct SparseArrayEntryWrapper *next;
 146 } SparseArrayEntryWrapper;
 147
 148 static SparseArrayEntryWrapper *AllocatedSparseArrayEntries = NULL;
 149
 150 /* Message strings used in macros (so they don't get repeated every time
 151    the macros are used */
 152 static const char *StackOverflowMsg = "macro stack overflow";
 153 static const char *StackUnderflowMsg = "macro stack underflow";
 154 static const char *StringToNumberMsg = "string could not be converted to number";
 155
 156 /* Temporary global data for use while accumulating programs */
 157 static Symbol *LocalSymList = NULL;              /* symbols local to the program */
 158 static Inst Prog[PROGRAM_SIZE];          /* the program */
 159 static Inst *ProgP;                      /* next free spot for code gen. */
 160 static Inst *LoopStack[LOOP_STACK_SIZE]; /* addresses of break, cont stmts */
 161 static Inst **LoopStackPtr = LoopStack;  /*  to fill at the end of a loop */
 162
 163 /* Global data for the interpreter */
 164 static DataValue *Stack;            /* the stack */
 165 static DataValue *StackP;           /* next free spot on stack */
 166 static DataValue *FrameP;           /* frame pointer (start of local variables
 167                                        for the current subroutine invocation) */
 168 static Inst *PC;                    /* program counter during execution */
 169 static char *ErrMsg;                /* global for returning error messages
 170                                        from executing functions */
 171 static WindowInfo
 172         *InitiatingWindow = NULL;   /* window from which macro was run */
 173 static WindowInfo *FocusWindow;     /* window on which macro commands operate */
 174 static int PreemptRequest;          /* passes preemption requests from called
 175                                        routines back up to the interpreter */
 176
 177 /* Array for mapping operations to functions for performing the operations
 178    Must correspond to the enum called "operations" in interpret.h */
 179 static int (*OpFns[N_OPS])() = {returnNoVal, returnVal, pushSymVal, dupStack,
 180         add, subtract, multiply, divide, modulo, negate, increment, decrement,
 181         gt, lt, ge, le, eq, ne, bitAnd, bitOr, and, or, not, power, concat,
 182         assign, callSubroutine, fetchRetVal, branch, branchTrue, branchFalse,
 183         branchNever, arrayRef, arrayAssign, beginArrayIter, arrayIter, inArray,
 184     deleteArrayElement};
 185
 186 /*
 187 ** Initialize macro language global variables.  Must be called before
 188 ** any macros are even parsed, because the parser uses action routine
 189 ** symbols to comprehend hyphenated names.
 190 */
 191 void InitMacroGlobals(void)
 192 {
 193     XtActionsRec *actions;
 194     int i, nActions;
 195     static char argName[3] = "$x";
 196     static DataValue dv = {NO_TAG, {0}};
 197
 198     /* Add action routines from NEdit menus and text widget */
 199     actions = GetMenuActions(&nActions);
 200     for (i=0; i<nActions; i++) {
 201         dv.val.xtproc = actions[i].proc;
 202         InstallSymbol(actions[i].string, ACTION_ROUTINE_SYM, dv);
 203     }
 204     actions = TextGetActions(&nActions);
 205     for (i=0; i<nActions; i++) {
 206         dv.val.xtproc = actions[i].proc;
 207         InstallSymbol(actions[i].string, ACTION_ROUTINE_SYM, dv);
 208     }
 209
 210     /* Add subroutine argument symbols ($1, $2, ..., $9) */
 211     for (i=0; i<9; i++) {
 212         argName[1] = '1' + i;
 213         dv.val.n = i;
 214         InstallSymbol(argName, ARG_SYM, dv);
 215     }
 216
 217     /* Add special symbol $n_args */
 218     dv.val.n = N_ARGS_ARG_SYM;
 219     InstallSymbol("$n_args", ARG_SYM, dv);
 220 }
 221
 222 /*
 223 ** To build a program for the interpreter, call BeginCreatingProgram, to
 224 ** begin accumulating the program, followed by calls to AddOp, AddSym,
 225 ** and InstallSymbol to add symbols and operations.  When the new program
 226 ** is finished, collect the results with FinishCreatingProgram.  This returns
 227 ** a self contained program that can be run with ExecuteMacro.
 228 */
 229
 230 /*
 231 ** Start collecting instructions for a program. Clears the program
 232 ** and the symbol table.
 233 */
 234 void BeginCreatingProgram(void)
 235 {
 236     LocalSymList = NULL;
 237     ProgP = Prog;
 238     LoopStackPtr = LoopStack;
 239 }
 240
 241 /*
 242 ** Finish up the program under construction, and return it (code and
 243 ** symbol table) as a package that ExecuteMacro can execute.  This
 244 ** program must be freed with FreeProgram.
 245 */
 246 Program *FinishCreatingProgram(void)
 247 {
 248     Program *newProg;
 249     int progLen, fpOffset = 0;
 250     Symbol *s;
 251
 252     newProg = (Program *)XtMalloc(sizeof(Program));
 253     progLen = ((char *)ProgP) - ((char *)Prog);
 254     newProg->code = (Inst *)XtMalloc(progLen);
 255     memcpy(newProg->code, Prog, progLen);
 256     newProg->localSymList = LocalSymList;
 257     LocalSymList = NULL;
 258
 259     /* Local variables' values are stored on the stack.  Here we assign
 260        frame pointer offsets to them. */
 261     for (s = newProg->localSymList; s != NULL; s = s->next)
 262         s->value.val.n = fpOffset++;
 263
 264 #ifdef DEBUG_ASSEMBLY
 265     disasm(newProg, ProgP - Prog);
 266 #endif
 267
 268     return newProg;
 269 }
 270
 271 void FreeProgram(Program *prog)
 272 {
 273     freeSymbolTable(prog->localSymList);
 274     XtFree((char *)prog->code);
 275     XtFree((char *)prog);
 276 }
 277
 278 /*
 279 ** Add an operator (instruction) to the end of the current program
 280 */
 281 int AddOp(int op, char **msg)
 282 {
 283     if (ProgP >= &Prog[PROGRAM_SIZE]) {
 284         *msg = "macro too large";
 285         return 0;
 286     }
 287     *ProgP++ = OpFns[op];
 288     return 1;
 289 }
 290
 291 /*
 292 ** Add a symbol operand to the current program
 293 */
 294 int AddSym(Symbol *sym, char **msg)
 295 {
 296     if (ProgP >= &Prog[PROGRAM_SIZE]) {
 297         *msg = "macro too large";
 298         return 0;
 299     }
 300     *ProgP++ = (Inst)sym;
 301     return 1;
 302 }
 303
 304 /*
 305 ** Add an immediate value operand to the current program
 306 */
 307 int AddImmediate(void *value, char **msg)
 308 {
 309     if (ProgP >= &Prog[PROGRAM_SIZE]) {
 310         *msg = "macro too large";
 311         return 0;
 312     }
 313     *ProgP++ = (Inst)value;
 314     return 1;
 315 }
 316
 317 /*
 318 ** Add a branch offset operand to the current program
 319 */
 320 int AddBranchOffset(Inst *to, char **msg)
 321 {
 322     if (ProgP >= &Prog[PROGRAM_SIZE]) {
 323         *msg = "macro too large";
 324         return 0;
 325     }
 326     *ProgP = (Inst)(to - ProgP);
 327     ProgP++;
 328
 329     return 1;
 330 }
 331
 332 /*
 333 ** Return the address at which the next instruction will be stored
 334 */
 335 Inst *GetPC(void)
 336 {
 337     return ProgP;
 338 }
 339
 340 /*
 341 ** Swap the positions of two contiguous blocks of code.  The first block
 342 ** running between locations start and boundary, and the second between
 343 ** boundary and end.
 344 */
 345 void SwapCode(Inst *start, Inst *boundary, Inst *end)
 346 {
 347     char *temp;
 348
 349     temp = XtMalloc((boundary - start) * sizeof(Inst*));
 350     memcpy(temp, start, (boundary-start) * sizeof(Inst*));
 351     memmove(start, boundary, (end-boundary) * sizeof(Inst*));
 352     memcpy(start+(end-boundary), temp, (boundary-start) * sizeof(Inst*));
 353     XtFree(temp);
 354 }
 355
 356 /*
 357 ** Maintain a stack to save addresses of branch operations for break and
 358 ** continue statements, so they can be filled in once the information
 359 ** on where to branch is known.
 360 **
 361 ** Call StartLoopAddrList at the beginning of a loop, AddBreakAddr or
 362 ** AddContinueAddr to register the address at which to store the branch
 363 ** address for a break or continue statement, and FillLoopAddrs to fill
 364 ** in all the addresses and return to the level of the enclosing loop.
 365 */
 366 void StartLoopAddrList(void)
 367 {
 368     addLoopAddr(NULL);
 369 }
 370
 371 int AddBreakAddr(Inst *addr)
 372 {
 373     if (LoopStackPtr == LoopStack) return 1;
 374     addLoopAddr(addr);
 375     *addr = NEEDS_BREAK;
 376     return 0;
 377 }
 378
 379 int AddContinueAddr(Inst *addr)
 380 {
 381     if (LoopStackPtr == LoopStack) return 1;
 382     addLoopAddr(addr);
 383     *addr = NEEDS_CONTINUE;
 384     return 0;
 385 }
 386
 387 static void addLoopAddr(Inst *addr)
 388 {
 389     if (LoopStackPtr > &LoopStack[LOOP_STACK_SIZE-1]) {
 390         fprintf(stderr, "NEdit: loop stack overflow in macro parser");
 391         return;
 392     }
 393     *LoopStackPtr++ = addr;
 394 }
 395
 396 void FillLoopAddrs(Inst *breakAddr, Inst *continueAddr)
 397 {
 398     while (True) {
 399         LoopStackPtr--;
 400         if (LoopStackPtr < LoopStack) {
 401             fprintf(stderr, "NEdit: internal error (lsu) in macro parser\n");
 402             return;
 403         }
 404         if (*LoopStackPtr == NULL)
 405             break;
 406         if (**LoopStackPtr == NEEDS_BREAK)
 407             **(Inst ***)LoopStackPtr = (Inst *)(breakAddr - *LoopStackPtr);
 408         else if (**LoopStackPtr == NEEDS_CONTINUE)
 409             **(Inst ***)LoopStackPtr = (Inst *)(continueAddr - *LoopStackPtr);
 410         else
 411             fprintf(stderr, "NEdit: internal error (uat) in macro parser\n");
 412     }
 413 }
 414
 415 /*
 416 ** Execute a compiled macro, "prog", using the arguments in the array
 417 ** "args".  Returns one of MACRO_DONE, MACRO_PREEMPT, or MACRO_ERROR.
 418 ** if MACRO_DONE is returned, the macro completed, and the returned value
 419 ** (if any) can be read from "result".  If MACRO_PREEMPT is returned, the
 420 ** macro exceeded its alotted time-slice and scheduled...
 421 */
 422 int ExecuteMacro(WindowInfo *window, Program *prog, int nArgs, DataValue *args,
 423         DataValue *result, RestartData **continuation, char **msg)
 424 {
 425     RestartData *context;
 426     static DataValue noValue = {NO_TAG, {0}};
 427     Symbol *s;
 428     int i;
 429
 430     /* Create an execution context (a stack, a stack pointer, a frame pointer,
 431        and a program counter) which will retain the program state across
 432        preemption and resumption of execution */
 433     context = (RestartData *)XtMalloc(sizeof(RestartData));
 434     context->stack = (DataValue *)XtMalloc(sizeof(DataValue) * STACK_SIZE);
 435     *continuation = context;
 436     context->stackP = context->stack;
 437     context->pc = prog->code;
 438     context->runWindow = window;
 439     context->focusWindow = window;
 440
 441     /* Push arguments and call information onto the stack */
 442     for (i=0; i<nArgs; i++)
 443         *(context->stackP++) = args[i];
 444     context->stackP->val.subr = NULL;
 445     context->stackP->tag = NO_TAG;
 446     context->stackP++;
 447     *(context->stackP++) = noValue;
 448     context->stackP->tag = NO_TAG;
 449     context->stackP->val.n = nArgs;
 450     context->stackP++;
 451     context->frameP = context->stackP;
 452
 453     /* Initialize and make room on the stack for local variables */
 454     for (s = prog->localSymList; s != NULL; s = s->next) {
 455         *(context->frameP + s->value.val.n) = noValue;
 456         context->stackP++;
 457     }
 458
 459     /* Begin execution, return on error or preemption */
 460     return ContinueMacro(context, result, msg);
 461 }
 462
 463 /*
 464 ** Continue the execution of a suspended macro whose state is described in
 465 ** "continuation"
 466 */
 467 int ContinueMacro(RestartData *continuation, DataValue *result, char **msg)
 468 {
 469     register int status, instCount = 0;
 470     register Inst *inst;
 471     RestartData oldContext;
 472
 473     /* To allow macros to be invoked arbitrarily (such as those automatically
 474        triggered within smart-indent) within executing macros, this call is
 475        reentrant. */
 476     saveContext(&oldContext);
 477
 478     /*
 479     ** Execution Loop:  Call the succesive routine addresses in the program
 480     ** until one returns something other than STAT_OK, then take action
 481     */
 482     restoreContext(continuation);
 483     ErrMsg = NULL;
 484     for (;;) {
 485
 486         /* Execute an instruction */
 487         inst = PC++;
 488         status = (*inst)();
 489
 490         /* If error return was not STAT_OK, return to caller */
 491         if (status != STAT_OK) {
 492             if (status == STAT_PREEMPT) {
 493                 saveContext(continuation);
 494                 restoreContext(&oldContext);
 495                 return MACRO_PREEMPT;
 496             } else if (status == STAT_ERROR) {
 497                 *msg = ErrMsg;
 498                 FreeRestartData(continuation);
 499                 restoreContext(&oldContext);
 500                 return MACRO_ERROR;
 501             } else if (status == STAT_DONE) {
 502                 *msg = "";
 503                 *result = *--StackP;
 504                 FreeRestartData(continuation);
 505                 restoreContext(&oldContext);
 506                 return MACRO_DONE;
 507             }
 508         }
 509
 510         /* Count instructions executed.  If the instruction limit is hit,
 511            preempt, store re-start information in continuation and give
 512            X, other macros, and other shell scripts a chance to execute */
 513         instCount++;
 514         if (instCount >= INSTRUCTION_LIMIT) {
 515             saveContext(continuation);
 516             restoreContext(&oldContext);
 517             return MACRO_TIME_LIMIT;
 518         }
 519     }
 520 }
 521
 522 /*
 523 ** If a macro is already executing, and requests that another macro be run,
 524 ** this can be called instead of ExecuteMacro to run it in the same context
 525 ** as if it were a subroutine.  This saves the caller from maintaining
 526 ** separate contexts, and serializes processing of the two macros without
 527 ** additional work.
 528 */
 529 void RunMacroAsSubrCall(Program *prog)
 530 {
 531     Symbol *s;
 532     static DataValue noValue = {NO_TAG, {0}};
 533
 534     /* See subroutine "call" for a description of the stack frame for a
 535        subroutine call */
 536     StackP->tag = NO_TAG;
 537     StackP->val.inst = PC;
 538     StackP++;
 539     StackP->tag = NO_TAG;
 540     StackP->val.dataval = FrameP;
 541     StackP++;
 542     StackP->tag = NO_TAG;
 543     StackP->val.n = 0;
 544     StackP++;
 545     FrameP = StackP;
 546     PC = prog->code;
 547     for (s = prog->localSymList; s != NULL; s = s->next) {
 548         *(FrameP + s->value.val.n) = noValue;
 549         StackP++;
 550     }
 551 }
 552
 553 void FreeRestartData(RestartData *context)
 554 {
 555     XtFree((char *)context->stack);
 556     XtFree((char *)context);
 557 }
 558
 559 /*
 560 ** Cause a macro in progress to be preempted (called by commands which take
 561 ** a long time, or want to return to the event loop.  Call ResumeMacroExecution
 562 ** to resume.
 563 */
 564 void PreemptMacro(void)
 565 {
 566     PreemptRequest = True;
 567 }
 568
 569 /*
 570 ** Reset the return value for a subroutine which caused preemption (this is
 571 ** how to return a value from a routine which preempts instead of returning
 572 ** a value directly).
 573 */
 574 void ModifyReturnedValue(RestartData *context, DataValue dv)
 575 {
 576     if (*(context->pc-1) == fetchRetVal)
 577         *(context->stackP-1) = dv;
 578 }
 579
 580 /*
 581 ** Called within a routine invoked from a macro, returns the window in
 582 ** which the macro is executing (where the banner is, not where it is focused)
 583 */
 584 WindowInfo *MacroRunWindow(void)
 585 {
 586     return InitiatingWindow;
 587 }
 588
 589 /*
 590 ** Called within a routine invoked from a macro, returns the window to which
 591 ** the currently executing macro is focused (the window which macro commands
 592 ** modify, not the window from which the macro is being run)
 593 */
 594 WindowInfo *MacroFocusWindow(void)
 595 {
 596     return FocusWindow;
 597 }
 598
 599 /*
 600 ** Set the window to which macro subroutines and actions which operate on an
 601 ** implied window are directed.
 602 */
 603 void SetMacroFocusWindow(WindowInfo *window)
 604 {
 605     FocusWindow = window;
 606 }
 607
 608 /*
 609 ** install an array iteration symbol
 610 ** it is tagged as an integer but holds an array node pointer
 611 */
 612 Symbol *InstallIteratorSymbol()
 613 {
 614     char symbolName[10 + (sizeof(int) * 3) + 2];
 615     DataValue value;
 616     static int interatorNameIndex = 0;
 617
 618     sprintf(symbolName, "aryiter #%d", interatorNameIndex);
 619     ++interatorNameIndex;
 620     value.tag = INT_TAG;
 621     value.val.arrayPtr = NULL;
 622     return(InstallSymbol(symbolName, LOCAL_SYM, value));
 623 }
 624
 625 /*
 626 ** Lookup a constant string by it's value. This allows reuse of string
 627 ** constants and fixing a leak in the interpreter.
 628 */
 629 Symbol *LookupStringConstSymbol(const char *value)
 630 {
 631     Symbol *s;
 632
 633     for (s = GlobalSymList; s != NULL; s = s->next) {
 634         if (s->type == CONST_SYM &&
 635             s->value.tag == STRING_TAG &&
 636             !strcmp(s->value.val.str, value)) {
 637             return(s);
 638         }
 639     }
 640     return(NULL);
 641 }
 642
 643 /*
 644 ** find a symbol in the symbol table
 645 */
 646 Symbol *LookupSymbol(const char *name)
 647 {
 648     Symbol *s;
 649
 650     for (s = LocalSymList; s != NULL; s = s->next)
 651         if (strcmp(s->name, name) == 0)
 652             return s;
 653     for (s = GlobalSymList; s != NULL; s = s->next)
 654         if (strcmp(s->name, name) == 0)
 655             return s;
 656     return NULL;
 657 }
 658
 659 /*
 660 ** install s in symbol table
 661 */
 662 Symbol *InstallSymbol(const char *name, int type, DataValue value)
 663 {
 664     Symbol *s;
 665
 666     s = (Symbol *)malloc(sizeof(Symbol));
 667     s->name = (char *)malloc(strlen(name)+1); /* +1 for '\0' */
 668     strcpy(s->name, name);
 669     s->type = type;
 670     s->value = value;
 671     if (type == LOCAL_SYM) {
 672         s->next = LocalSymList;
 673         LocalSymList = s;
 674     } else {
 675         s->next = GlobalSymList;
 676         GlobalSymList = s;
 677     }
 678     return s;
 679 }
 680
 681 /*
 682 ** Promote a symbol from local to global, removing it from the local symbol
 683 ** list.
 684 */
 685 Symbol *PromoteToGlobal(Symbol *sym)
 686 {
 687     Symbol *s;
 688     static DataValue noValue = {NO_TAG, {0}};
 689
 690     if (sym->type != LOCAL_SYM)
 691         return sym;
 692
 693     /* Remove sym from the local symbol list */
 694     if (sym == LocalSymList)
 695         LocalSymList = sym->next;
 696     else {
 697         for (s = LocalSymList; s != NULL; s = s->next) {
 698             if (s->next == sym) {
 699                 s->next = sym->next;
 700                 break;
 701             }
 702         }
 703     }
 704
 705     s = LookupSymbol(sym->name);
 706     if (s != NULL)
 707         return s;
 708     return InstallSymbol(sym->name, GLOBAL_SYM, noValue);
 709 }
 710
 711 /*
 712 ** Allocate memory for a string, and keep track of it, such that it
 713 ** can be recovered later using GarbageCollectStrings.  (A linked list
 714 ** of pointers is maintained by threading through the memory behind
 715 ** the returned pointers).  Length does not include the terminating null
 716 ** character, so to allocate space for a string of strlen == n, you must
 717 ** use AllocString(n+1).
 718 */
 719
 720 /*#define TRACK_GARBAGE_LEAKS*/
 721 #ifdef TRACK_GARBAGE_LEAKS
 722 static int numAllocatedStrings = 0;
 723 static int numAllocatedSparseArrayElements = 0;
 724 #endif
 725
 726 char *AllocString(int length)
 727 {
 728     char *mem;
 729
 730     mem = XtMalloc(length + sizeof(char *) + 1);
 731     *((char **)mem) = AllocatedStrings;
 732     AllocatedStrings = mem;
 733 #ifdef TRACK_GARBAGE_LEAKS
 734     ++numAllocatedStrings;
 735 #endif
 736     return mem + sizeof(char *) + 1;
 737 }
 738
 739 static SparseArrayEntry *allocateSparseArrayEntry(void)
 740 {
 741     SparseArrayEntryWrapper *mem;
 742
 743     mem = (SparseArrayEntryWrapper *)XtMalloc(sizeof(SparseArrayEntryWrapper));
 744     mem->next = (struct SparseArrayEntryWrapper *)AllocatedSparseArrayEntries;
 745     AllocatedSparseArrayEntries = mem;
 746 #ifdef TRACK_GARBAGE_LEAKS
 747     ++numAllocatedSparseArrayElements;
 748 #endif
 749     return(&(mem->data));
 750 }
 751
 752 static void MarkArrayContentsAsUsed(SparseArrayEntry *arrayPtr)
 753 {
 754     SparseArrayEntry *globalSEUse;
 755
 756     if (arrayPtr) {
 757         ((SparseArrayEntryWrapper *)arrayPtr)->inUse = 1;
 758         for (globalSEUse = (SparseArrayEntry *)rbTreeBegin((rbTreeNode *)arrayPtr);
 759             globalSEUse != NULL;
 760             globalSEUse = (SparseArrayEntry *)rbTreeNext((rbTreeNode *)globalSEUse)) {
 761
 762             ((SparseArrayEntryWrapper *)globalSEUse)->inUse = 1;
 763             *(globalSEUse->key - 1) = 1;
 764             if (globalSEUse->value.tag == STRING_TAG) {
 765                 *(globalSEUse->value.val.str - 1) = 1;
 766             }
 767             else if (globalSEUse->value.tag == ARRAY_TAG) {
 768                 MarkArrayContentsAsUsed((SparseArrayEntry *)globalSEUse->value.val.arrayPtr);
 769             }
 770         }
 771     }
 772 }
 773
 774 /*
 775 ** Collect strings that are no longer referenced from the global symbol
 776 ** list.  THIS CAN NOT BE RUN WHILE ANY MACROS ARE EXECUTING.  It must
 777 ** only be run after all macro activity has ceased.
 778 */
 779
 780 void GarbageCollectStrings(void)
 781 {
 782     SparseArrayEntryWrapper *nextAP, *thisAP;
 783     char *p, *next;
 784     Symbol *s;
 785
 786     /* mark all strings as unreferenced */
 787     for (p = AllocatedStrings; p != NULL; p = *((char **)p))
 788         *(p + sizeof(char *)) = 0;
 789
 790     for (thisAP = AllocatedSparseArrayEntries;
 791         thisAP != NULL; thisAP = (SparseArrayEntryWrapper *)thisAP->next) {
 792         thisAP->inUse = 0;
 793     }
 794
 795     /* Sweep the global symbol list, marking which strings are still
 796        referenced */
 797     for (s = GlobalSymList; s != NULL; s = s->next)
 798         if (s->value.tag == STRING_TAG)
 799             *(s->value.val.str - 1) = 1;
 800         else if (s->value.tag == ARRAY_TAG) {
 801             MarkArrayContentsAsUsed((SparseArrayEntry *)s->value.val.arrayPtr);
 802         }
 803
 804     /* Collect all of the strings which remain unreferenced */
 805     next = AllocatedStrings;
 806     AllocatedStrings = NULL;
 807     while (next != NULL) {
 808         p = next;
 809         next = *((char **)p);
 810         if (*(p + sizeof(char *)) != 0) {
 811             *((char **)p) = AllocatedStrings;
 812             AllocatedStrings = p;
 813         } else {
 814 #ifdef TRACK_GARBAGE_LEAKS
 815             --numAllocatedStrings;
 816 #endif
 817             XtFree(p);
 818         }
 819     }
 820
 821     nextAP = AllocatedSparseArrayEntries;
 822     AllocatedSparseArrayEntries = NULL;
 823     while (nextAP != NULL) {
 824         thisAP = nextAP;
 825         nextAP = (SparseArrayEntryWrapper *)nextAP->next;
 826         if (thisAP->inUse != 0) {
 827             thisAP->next = (struct SparseArrayEntryWrapper *)AllocatedSparseArrayEntries;
 828             AllocatedSparseArrayEntries = thisAP;
 829        }
 830         else {
 831 #ifdef TRACK_GARBAGE_LEAKS
 832             --numAllocatedSparseArrayElements;
 833 #endif
 834             XtFree((void *)thisAP);
 835         }
 836     }
 837
 838 #ifdef TRACK_GARBAGE_LEAKS
 839     printf("str count = %d\nary count %d\n", numAllocatedStrings, numAllocatedSparseArrayElements);
 840 #endif
 841 }
 842
 843 /*
 844 ** Save and restore execution context to data structure "context"
 845 */
 846 static void saveContext(RestartData *context)
 847 {
 848     context->stack = Stack;
 849     context->stackP = StackP;
 850     context->frameP = FrameP;
 851     context->pc = PC;
 852     context->runWindow = InitiatingWindow;
 853     context->focusWindow = FocusWindow;
 854 }
 855 static void restoreContext(RestartData *context)
 856 {
 857     Stack = context->stack;
 858     StackP = context->stackP;
 859     FrameP = context->frameP;
 860     PC = context->pc;
 861     InitiatingWindow = context->runWindow;
 862     FocusWindow = context->focusWindow;
 863 }
 864
 865 static void freeSymbolTable(Symbol *symTab)
 866 {
 867     Symbol *s;
 868
 869     while(symTab != NULL) {
 870         s = symTab;
 871         free(s->name);
 872         symTab = s->next;
 873         free((char *)s);
 874     }
 875 }
 876
 877 #define POP(dataVal) \
 878     if (StackP == Stack) \
 879         return execError(StackUnderflowMsg, ""); \
 880     dataVal = *--StackP;
 881
 882 #define PUSH(dataVal) \
 883     if (StackP >= &Stack[STACK_SIZE]) \
 884         return execError(StackOverflowMsg, ""); \
 885     *StackP++ = dataVal;
 886
 887 #define PEEK(dataVal, peekIndex) \
 888     dataVal = *(StackP - peekIndex - 1);
 889
 890 #define POP_INT(number) \
 891     if (StackP == Stack) \
 892         return execError(StackUnderflowMsg, ""); \
 893     --StackP; \
 894     if (StackP->tag == STRING_TAG) { \
 895         if (!stringToNum(StackP->val.str, &number)) \
 896             return execError(StringToNumberMsg, ""); \
 897     } else if (StackP->tag == INT_TAG) \
 898         number = StackP->val.n; \
 899     else \
 900         return(execError("can't convert array to integer", NULL));
 901
 902 #define POP_STRING(string) \
 903     if (StackP == Stack) \
 904         return execError(StackUnderflowMsg, ""); \
 905     --StackP; \
 906     if (StackP->tag == INT_TAG) { \
 907         string = AllocString(21); \
 908         sprintf(string, "%d", StackP->val.n); \
 909     } else if (StackP->tag == STRING_TAG) \
 910         string = StackP->val.str; \
 911     else \
 912         return(execError("can't convert array to string", NULL));
 913
 914 #define PEEK_STRING(string, peekIndex) \
 915     if ((StackP - peekIndex - 1)->tag == INT_TAG) { \
 916         string = AllocString(21); \
 917         sprintf(string, "%d", (StackP - peekIndex - 1)->val.n); \
 918     } \
 919     else if ((StackP - peekIndex - 1)->tag == STRING_TAG) { \
 920         string = (StackP - peekIndex - 1)->val.str; \
 921     } \
 922     else { \
 923         return(execError("can't convert array to string", NULL)); \
 924     }
 925
 926 #define PEEK_INT(number, peekIndex) \
 927     if ((StackP - peekIndex - 1)->tag == STRING_TAG) { \
 928         if (!stringToNum((StackP - peekIndex - 1)->val.str, &number)) { \
 929             return execError(StringToNumberMsg, ""); \
 930         } \
 931     } else if ((StackP - peekIndex - 1)->tag == INT_TAG) { \
 932         number = (StackP - peekIndex - 1)->val.n; \
 933     } \
 934     else { \
 935         return(execError("can't convert array to string", NULL)); \
 936     }
 937
 938 #define PUSH_INT(number) \
 939     if (StackP >= &Stack[STACK_SIZE]) \
 940         return execError(StackOverflowMsg, ""); \
 941     StackP->tag = INT_TAG; \
 942     StackP->val.n = number; \
 943     StackP++;
 944
 945 #define PUSH_STRING(string) \
 946     if (StackP >= &Stack[STACK_SIZE]) \
 947         return execError(StackOverflowMsg, ""); \
 948     StackP->tag = STRING_TAG; \
 949     StackP->val.str = string; \
 950     StackP++;
 951
 952 #define BINARY_NUMERIC_OPERATION(operator) \
 953     int n1, n2; \
 954     POP_INT(n2) \
 955     POP_INT(n1) \
 956     PUSH_INT(n1 operator n2) \
 957     return STAT_OK;
 958
 959 #define UNARY_NUMERIC_OPERATION(operator) \
 960     int n; \
 961     POP_INT(n) \
 962     PUSH_INT(operator n) \
 963     return STAT_OK;
 964
 965 static int pushSymVal(void)
 966 {
 967     Symbol *s;
 968     int nArgs, argNum;
 969
 970     s = (Symbol *)*PC++;
 971     if (s->type == LOCAL_SYM) {
 972         *StackP = *(FrameP + s->value.val.n);
 973     } else if (s->type == GLOBAL_SYM || s->type == CONST_SYM) {
 974         *StackP = s->value;
 975     } else if (s->type == ARG_SYM) {
 976         nArgs = (FrameP-1)->val.n;
 977         argNum = s->value.val.n;
 978         if (argNum >= nArgs)
 979             return execError("referenced undefined argument: %s",  s->name);
 980         if (argNum == N_ARGS_ARG_SYM) {
 981             StackP->tag = INT_TAG;
 982             StackP->val.n = nArgs;
 983         } else
 984             *StackP = *(FrameP + argNum - nArgs - 3);
 985     } else if (s->type == PROC_VALUE_SYM) {
 986         DataValue result;
 987         char *errMsg;
 988         if (!(s->value.val.subr)(FocusWindow, NULL, 0,
 989                 &result, &errMsg))
 990             return execError(errMsg, s->name);
 991         *StackP = result;
 992     } else
 993         return execError("reading non-variable: %s", s->name);
 994     if (StackP->tag == NO_TAG)
 995         return execError("variable not set: %s", s->name);
 996     StackP++;
 997     if (StackP >= &Stack[STACK_SIZE])
 998         return execError(StackOverflowMsg, "");
 999     return STAT_OK;
1000 }
1001
1002 static int assign(void)      /* assign top value to next symbol */
1003 {
1004     Symbol *sym;
1005     DataValue *dataPtr;
1006
1007     sym = (Symbol *)(*PC++);
1008     if (sym->type != GLOBAL_SYM && sym->type != LOCAL_SYM) {
1009         if (sym->type == ARG_SYM)
1010             return execError("assignment to function argument: %s",  sym->name);
1011         else if (sym->type == PROC_VALUE_SYM)
1012             return execError("assignment to read-only variable: %s", sym->name);
1013         else
1014             return execError("assignment to non-variable: %s", sym->name);
1015     }
1016     if (StackP == Stack)
1017         return execError(StackUnderflowMsg, "");
1018     --StackP;
1019     if (sym->type == LOCAL_SYM)
1020         dataPtr = (FrameP + sym->value.val.n);
1021     else
1022         dataPtr = &sym->value;
1023     if (StackP->tag == ARRAY_TAG) {
1024         ArrayCopy(dataPtr, StackP);
1025     }
1026     else {
1027         *dataPtr = *StackP;
1028     }
1029     return STAT_OK;
1030 }
1031
1032 static int dupStack(void)
1033 {
1034     if (StackP >= &Stack[STACK_SIZE])
1035         return execError(StackOverflowMsg, "");
1036     *StackP = *(StackP - 1);
1037     StackP++;
1038     return STAT_OK;
1039 }
1040
1041 /*
1042 ** if left and right arguments are arrays, then the result is a new array
1043 ** in which all the keys from both the right and left are copied
1044 ** the values from the right array are used in the result array when the
1045 ** keys are the same
1046 */
1047 static int add(void)
1048 {
1049     DataValue leftVal, rightVal, resultArray;
1050     int n1, n2;
1051
1052     PEEK(rightVal, 0)
1053     if (rightVal.tag == ARRAY_TAG) {
1054         PEEK(leftVal, 1)
1055         if (leftVal.tag == ARRAY_TAG) {
1056             SparseArrayEntry *leftIter, *rightIter;
1057             resultArray.tag = ARRAY_TAG;
1058             resultArray.val.arrayPtr = ArrayNew();
1059
1060             POP(rightVal)
1061             POP(leftVal)
1062             leftIter = arrayIterateFirst(&leftVal);
1063             rightIter = arrayIterateFirst(&rightVal);
1064             while (leftIter || rightIter) {
1065                 int insertResult = 1;
1066
1067                 if (leftIter && rightIter) {
1068                     int compareResult = arrayEntryCompare((rbTreeNode *)leftIter, (rbTreeNode *)rightIter);
1069                     if (compareResult < 0) {
1070                         insertResult = ArrayInsert(&resultArray, leftIter->key, &leftIter->value);
1071                         leftIter = arrayIterateNext(leftIter);
1072                     }
1073                     else if (compareResult > 0) {
1074                         insertResult = ArrayInsert(&resultArray, rightIter->key, &rightIter->value);
1075                         rightIter = arrayIterateNext(rightIter);
1076                     }
1077                     else {
1078                         insertResult = ArrayInsert(&resultArray, rightIter->key, &rightIter->value);
1079                         leftIter = arrayIterateNext(leftIter);
1080                         rightIter = arrayIterateNext(rightIter);
1081                     }
1082                 }
1083                 else if (leftIter) {
1084                     insertResult = ArrayInsert(&resultArray, leftIter->key, &leftIter->value);
1085                     leftIter = arrayIterateNext(leftIter);
1086                 }
1087                 else {
1088                     insertResult = ArrayInsert(&resultArray, rightIter->key, &rightIter->value);
1089                     rightIter = arrayIterateNext(rightIter);
1090                 }
1091                 if (!insertResult) {
1092                     return(execError("array insertion failure", NULL));
1093                 }
1094             }
1095             PUSH(resultArray)
1096         }
1097         else {
1098             return(execError("can't mix math with arrays and non-arrays", NULL));
1099         }
1100     }
1101     else {
1102         POP_INT(n2)
1103         POP_INT(n1)
1104         PUSH_INT(n1 + n2)
1105     }
1106     return(STAT_OK);
1107 }
1108
1109 /*
1110 ** if left and right arguments are arrays, then the result is a new array
1111 ** in which only the keys which exist in the left array but not in the right
1112 ** are copied
1113 */
1114 static int subtract(void)
1115 {
1116     DataValue leftVal, rightVal, resultArray;
1117     int n1, n2;
1118
1119     PEEK(rightVal, 0)
1120     if (rightVal.tag == ARRAY_TAG) {
1121         PEEK(leftVal, 1)
1122         if (leftVal.tag == ARRAY_TAG) {
1123             SparseArrayEntry *leftIter, *rightIter;
1124             resultArray.tag = ARRAY_TAG;
1125             resultArray.val.arrayPtr = ArrayNew();
1126
1127             POP(rightVal)
1128             POP(leftVal)
1129             leftIter = arrayIterateFirst(&leftVal);
1130             rightIter = arrayIterateFirst(&rightVal);
1131             while (leftIter) {
1132                 int insertResult = 1;
1133
1134                 if (leftIter && rightIter) {
1135                     int compareResult = arrayEntryCompare((rbTreeNode *)leftIter, (rbTreeNode *)rightIter);
1136                     if (compareResult < 0) {
1137                         insertResult = ArrayInsert(&resultArray, leftIter->key, &leftIter->value);
1138                         leftIter = arrayIterateNext(leftIter);
1139                     }
1140                     else if (compareResult > 0) {
1141                         rightIter = arrayIterateNext(rightIter);
1142                     }
1143                     else {
1144                         leftIter = arrayIterateNext(leftIter);
1145                         rightIter = arrayIterateNext(rightIter);
1146                     }
1147                 }
1148                 else if (leftIter) {
1149                     insertResult = ArrayInsert(&resultArray, leftIter->key, &leftIter->value);
1150                     leftIter = arrayIterateNext(leftIter);
1151                 }
1152                 if (!insertResult) {
1153                     return(execError("array insertion failure", NULL));
1154                 }
1155             }
1156             PUSH(resultArray)
1157         }
1158         else {
1159             return(execError("can't mix math with arrays and non-arrays", NULL));
1160         }
1161     }
1162     else {
1163         POP_INT(n2)
1164         POP_INT(n1)
1165         PUSH_INT(n1 - n2)
1166     }
1167     return(STAT_OK);
1168 }
1169
1170 static int multiply(void)
1171 {
1172     BINARY_NUMERIC_OPERATION(*)
1173 }
1174
1175 static int divide(void)
1176 {
1177     int n1, n2;
1178     POP_INT(n2)
1179     POP_INT(n1)
1180     if (n2 == 0)
1181         return execError("division by zero", "");
1182     PUSH_INT(n1 / n2)
1183     return STAT_OK;
1184 }
1185
1186 static int modulo(void)
1187 {
1188     BINARY_NUMERIC_OPERATION(%)
1189 }
1190
1191 static int negate(void)
1192 {
1193     UNARY_NUMERIC_OPERATION(-)
1194 }
1195
1196 static int increment(void)
1197 {
1198     UNARY_NUMERIC_OPERATION(++)
1199 }
1200
1201 static int decrement(void)
1202 {
1203     UNARY_NUMERIC_OPERATION(--)
1204 }
1205
1206 static int gt(void)
1207 {
1208     BINARY_NUMERIC_OPERATION(>)
1209 }
1210
1211 static int lt(void)
1212 {
1213     BINARY_NUMERIC_OPERATION(<)
1214 }
1215
1216 static int ge(void)
1217 {
1218     BINARY_NUMERIC_OPERATION(>=)
1219 }
1220
1221 static int le(void)
1222 {
1223     BINARY_NUMERIC_OPERATION(<=)
1224 }
1225
1226 /*
1227 ** verify that compares are between integers and/or strings only
1228 */
1229 static int eq(void)
1230 {
1231     DataValue v1, v2;
1232
1233     POP(v1)
1234     POP(v2)
1235     if (v1.tag == INT_TAG && v2.tag == INT_TAG) {
1236         v1.val.n = v1.val.n == v2.val.n;
1237     }
1238     else if (v1.tag == STRING_TAG && v2.tag == STRING_TAG) {
1239         v1.val.n = !strcmp(v1.val.str, v2.val.str);
1240     }
1241     else if (v1.tag == STRING_TAG && v2.tag == INT_TAG) {
1242         int number;
1243         if (!stringToNum(v1.val.str, &number)) {
1244             v1.val.n = 0;
1245         }
1246         else {
1247             v1.val.n = number == v2.val.n;
1248         }
1249     }
1250     else if (v2.tag == STRING_TAG && v1.tag == INT_TAG) {
1251         int number;
1252         if (!stringToNum(v2.val.str, &number)) {
1253             v1.val.n = 0;
1254         }
1255         else {
1256             v1.val.n = number == v1.val.n;
1257         }
1258     }
1259     else {
1260         return(execError("incompatible types to compare", NULL));
1261     }
1262     v1.tag = INT_TAG;
1263     PUSH(v1)
1264     return(STAT_OK);
1265 }
1266
1267 static int ne(void)
1268 {
1269     eq();
1270     return not();
1271 }
1272
1273 /*
1274 ** if left and right arguments are arrays, then the result is a new array
1275 ** in which only the keys which exist in both the right or left are copied
1276 ** the values from the right array are used in the result array
1277 */
1278 static int bitAnd(void)
1279 {
1280     DataValue leftVal, rightVal, resultArray;
1281     int n1, n2;
1282
1283     PEEK(rightVal, 0)
1284     if (rightVal.tag == ARRAY_TAG) {
1285         PEEK(leftVal, 1)
1286         if (leftVal.tag == ARRAY_TAG) {
1287             SparseArrayEntry *leftIter, *rightIter;
1288             resultArray.tag = ARRAY_TAG;
1289             resultArray.val.arrayPtr = ArrayNew();
1290
1291             POP(rightVal)
1292             POP(leftVal)
1293             leftIter = arrayIterateFirst(&leftVal);
1294             rightIter = arrayIterateFirst(&rightVal);
1295             while (leftIter && rightIter) {
1296                 int insertResult = 1;
1297                 int compareResult = arrayEntryCompare((rbTreeNode *)leftIter, (rbTreeNode *)rightIter);
1298
1299                 if (compareResult < 0) {
1300                     leftIter = arrayIterateNext(leftIter);
1301                 }
1302                 else if (compareResult > 0) {
1303                     rightIter = arrayIterateNext(rightIter);
1304                 }
1305                 else {
1306                     insertResult = ArrayInsert(&resultArray, rightIter->key, &rightIter->value);
1307                     leftIter = arrayIterateNext(leftIter);
1308                     rightIter = arrayIterateNext(rightIter);
1309                 }
1310                 if (!insertResult) {
1311                     return(execError("array insertion failure", NULL));
1312                 }
1313             }
1314             PUSH(resultArray)
1315         }
1316         else {
1317             return(execError("can't mix math with arrays and non-arrays", NULL));
1318         }
1319     }
1320     else {
1321         POP_INT(n2)
1322         POP_INT(n1)
1323         PUSH_INT(n1 & n2)
1324     }
1325     return(STAT_OK);
1326 }
1327
1328 /*
1329 ** if left and right arguments are arrays, then the result is a new array
1330 ** in which only the keys which exist in either the right or left but not both
1331 ** are copied
1332 */
1333 static int bitOr(void)
1334 {
1335     DataValue leftVal, rightVal, resultArray;
1336     int n1, n2;
1337
1338     PEEK(rightVal, 0)
1339     if (rightVal.tag == ARRAY_TAG) {
1340         PEEK(leftVal, 1)
1341         if (leftVal.tag == ARRAY_TAG) {
1342             SparseArrayEntry *leftIter, *rightIter;
1343             resultArray.tag = ARRAY_TAG;
1344             resultArray.val.arrayPtr = ArrayNew();
1345
1346             POP(rightVal)
1347             POP(leftVal)
1348             leftIter = arrayIterateFirst(&leftVal);
1349             rightIter = arrayIterateFirst(&rightVal);
1350             while (leftIter || rightIter) {
1351                 int insertResult = 1;
1352
1353                 if (leftIter && rightIter) {
1354                     int compareResult = arrayEntryCompare((rbTreeNode *)leftIter, (rbTreeNode *)rightIter);
1355                     if (compareResult < 0) {
1356                         insertResult = ArrayInsert(&resultArray, leftIter->key, &leftIter->value);
1357                         leftIter = arrayIterateNext(leftIter);
1358                     }
1359                     else if (compareResult > 0) {
1360                         insertResult = ArrayInsert(&resultArray, rightIter->key, &rightIter->value);
1361                         rightIter = arrayIterateNext(rightIter);
1362                     }
1363                     else {
1364                         leftIter = arrayIterateNext(leftIter);
1365                         rightIter = arrayIterateNext(rightIter);
1366                     }
1367                 }
1368                 else if (leftIter) {
1369                     insertResult = ArrayInsert(&resultArray, leftIter->key, &leftIter->value);
1370                     leftIter = arrayIterateNext(leftIter);
1371                 }
1372                 else {
1373                     insertResult = ArrayInsert(&resultArray, rightIter->key, &rightIter->value);
1374                     rightIter = arrayIterateNext(rightIter);
1375                 }
1376                 if (!insertResult) {
1377                     return(execError("array insertion failure", NULL));
1378                 }
1379             }
1380             PUSH(resultArray)
1381         }
1382         else {
1383             return(execError("can't mix math with arrays and non-arrays", NULL));
1384         }
1385     }
1386     else {
1387         POP_INT(n2)
1388         POP_INT(n1)
1389         PUSH_INT(n1 | n2)
1390     }
1391     return(STAT_OK);
1392 }
1393
1394 static int and(void)
1395 {
1396     BINARY_NUMERIC_OPERATION(&&)
1397 }
1398
1399 static int or(void)
1400 {
1401     BINARY_NUMERIC_OPERATION(||)
1402 }
1403
1404 static int not(void)
1405 {
1406     UNARY_NUMERIC_OPERATION(!)
1407 }
1408
1409 static int power(void)
1410 {
1411     int n1, n2, n3;
1412     POP_INT(n2)
1413     POP_INT(n1)
1414     /*  We need to round to deal with pow() giving results slightly above
1415         or below the real result since it deals with floating point numbers.
1416         Note: We're not really wanting rounded results, we merely
1417         want to deal with this simple issue. So, 2^-2 = .5, but we
1418         don't want to round this to 1. This is mainly intended to deal with
1419         4^2 = 15.999996 and 16.000001.
1420     */
1421     if (n2 < 0 && n1 != 1 && n1 != -1) {
1422         if (n1 != 0) {
1423             /* since we're integer only, nearly all negative exponents result in 0 */
1424             n3 = 0;
1425         }
1426         else {
1427             /* allow error to occur */
1428             n3 = (int)pow((double)n1, (double)n2);
1429         }
1430     }
1431     else {
1432         if ((n1 < 0) && (n2 & 1)) {
1433             /* round to nearest integer for negative values*/
1434             n3 = (int)(pow((double)n1, (double)n2) - (double)0.5);
1435         }
1436         else {
1437             /* round to nearest integer for positive values*/
1438             n3 = (int)(pow((double)n1, (double)n2) + (double)0.5);
1439         }
1440     }
1441     PUSH_INT(n3)
1442     return errCheck("exponentiation");
1443 }
1444
1445 static int concat(void)
1446 {
1447     char *s1, *s2, *out;
1448     int len1, len2;
1449     POP_STRING(s2)
1450     POP_STRING(s1)
1451     len1 = strlen(s1);
1452     len2 = strlen(s2);
1453     out = AllocString(len1 + len2 + 1);
1454     strncpy(out, s1, len1);
1455     strcpy(&out[len1], s2);
1456     PUSH_STRING(out)
1457     return STAT_OK;
1458 }
1459
1460 /*
1461 ** Call a subroutine or function (user defined or built-in).  Args are the
1462 ** subroutine's symbol, and the number of arguments which have been pushed
1463 ** on the stack.
1464 **
1465 ** For a macro subroutine, the return address, frame pointer, number of
1466 ** arguments and space for local variables are added to the stack, and the
1467 ** PC is set to point to the new function. For a built-in routine, the
1468 ** arguments are popped off the stack, and the routine is just called.
1469 **
1470 **
1471 **   The call stack for a subroutine call looks like
1472 **
1473 **   SP after return -> arg1
1474 **                      arg2
1475 **                      arg3
1476 **                      .
1477 **                      .
1478 **                      .
1479 **    SP before call -> ReturnAddress
1480 **                      Saved FP
1481 **                      nArgs
1482 **                FP -> local1
1483 **                      local2
1484 **                      local3
1485 **                      .
1486 **                      .
1487 **                      .
1488 **     SP after call ->
1489 */
1490 static int callSubroutine(void)
1491 {
1492     Symbol *sym, *s;
1493     int i, nArgs;
1494     static DataValue noValue = {NO_TAG, {0}};
1495     Program *prog;
1496     char *errMsg;
1497
1498     sym = (Symbol *)*PC++;
1499     nArgs = (int)*PC++;
1500
1501     if (nArgs > MAX_ARGS)
1502         return execError("too many arguments to subroutine %s (max 9)",
1503                 sym->name);
1504
1505     /*
1506     ** If the subroutine is built-in, call the built-in routine
1507     */
1508     if (sym->type == C_FUNCTION_SYM) {
1509         DataValue result, argList[MAX_ARGS];
1510
1511         /* pop arguments off the stack and put them in the argument list */
1512         for (i=nArgs-1; i>=0; i--) {
1513             POP(argList[i])
1514         }
1515
1516         /* Call the function and check for preemption */
1517         PreemptRequest = False;
1518         if (!(sym->value.val.subr)(FocusWindow, argList,
1519                 nArgs, &result, &errMsg))
1520             return execError(errMsg, sym->name);
1521         if (*PC == fetchRetVal) {
1522             if (result.tag == NO_TAG)
1523                 return execError("%s does not return a value", sym->name);
1524             PUSH(result);
1525             PC++;
1526         }
1527         return PreemptRequest ? STAT_PREEMPT : STAT_OK;
1528     }
1529
1530     /*
1531     ** Call a macro subroutine:
1532     **
1533     ** Push all of the required information to resume, and make space on the
1534     ** stack for local variables (and initialize them), on top of the argument
1535     ** values which are already there.
1536     */
1537     if (sym->type == MACRO_FUNCTION_SYM) {
1538         StackP->tag = NO_TAG;
1539         StackP->val.inst = PC;
1540         StackP++;
1541         StackP->tag = NO_TAG;
1542         StackP->val.dataval = FrameP;
1543         StackP++;
1544         StackP->tag = NO_TAG;
1545         StackP->val.n = nArgs;
1546         StackP++;
1547         FrameP = StackP;
1548         prog = (Program *)sym->value.val.str;
1549         PC = prog->code;
1550         for (s = prog->localSymList; s != NULL; s = s->next) {
1551             *(FrameP + s->value.val.n) = noValue;
1552             StackP++;
1553         }
1554         return STAT_OK;
1555     }
1556
1557     /*
1558     ** Call an action routine
1559     */
1560     if (sym->type == ACTION_ROUTINE_SYM) {
1561         String argList[MAX_ARGS];
1562         Cardinal numArgs = nArgs;
1563         XKeyEvent key_event;
1564         Display *disp;
1565         Window win;
1566
1567         /* Create a fake event with a timestamp suitable for actions which need
1568            timestamps, a marker to indicate that the call was from a macro
1569            (to stop shell commands from putting up their own separate banner) */
1570         disp=XtDisplay(InitiatingWindow->shell);
1571         win=XtWindow(InitiatingWindow->shell);
1572
1573         key_event.type = KeyPress;
1574         key_event.send_event = MACRO_EVENT_MARKER;
1575         key_event.time=XtLastTimestampProcessed(XtDisplay(InitiatingWindow->shell));
1576
1577         /* The following entries are just filled in to avoid problems
1578            in strange cases, like calling "self_insert()" directly from the
1579            macro menu. In fact the display was sufficient to cure this crash. */
1580         key_event.display=disp;
1581         key_event.window=key_event.root=key_event.subwindow=win;
1582
1583         /* pop arguments off the stack and put them in the argument list */
1584         for (i=nArgs-1; i>=0; i--) {
1585             POP_STRING(argList[i])
1586         }
1587
1588         /* Call the action routine and check for preemption */
1589         PreemptRequest = False;
1590         (sym->value.val.xtproc)(FocusWindow->lastFocus,
1591                 (XEvent *)&key_event, argList, &numArgs);
1592         if (*PC == fetchRetVal)
1593             return execError("%s does not return a value", sym->name);
1594         return PreemptRequest ? STAT_PREEMPT : STAT_OK;
1595     }
1596
1597     /* Calling a non subroutine symbol */
1598     return execError("%s is not a function or subroutine", sym->name);
1599 }
1600
1601 /*
1602 ** This should never be executed, returnVal checks for the presence of this
1603 ** instruction at the PC to decide whether to push the function's return
1604 ** value, then skips over it without executing.
1605 */
1606 static int fetchRetVal(void)
1607 {
1608     return execError("internal error: frv", NULL);
1609 }
1610
1611 static int returnNoVal(void)
1612 {
1613     return returnValOrNone(False);
1614 }
1615 static int returnVal(void)
1616 {
1617     return returnValOrNone(True);
1618 }
1619
1620 /*
1621 ** Return from a subroutine call
1622 */
1623 static int returnValOrNone(int valOnStack)
1624 {
1625     DataValue retVal;
1626     static DataValue noValue = {NO_TAG, {0}};
1627     int nArgs;
1628
1629     /* return value is on the stack */
1630     if (valOnStack) {
1631         POP(retVal);
1632     }
1633
1634     /* pop past local variables */
1635     StackP = FrameP;
1636
1637     /* get stored return information */
1638     nArgs = (--StackP)->val.n;
1639     FrameP = (--StackP)->val.dataval;
1640     PC = (--StackP)->val.inst;
1641
1642     /* pop past function arguments */
1643     StackP -= nArgs;
1644
1645     /* push returned value, if requsted */
1646     if (PC == NULL) {
1647         if (valOnStack) {
1648             PUSH(retVal);
1649         } else {
1650             PUSH(noValue);
1651         }
1652     } else if (*PC == fetchRetVal) {
1653         if (valOnStack) {
1654             PUSH(retVal);
1655             PC++;
1656         } else {
1657             return execError(
1658                 "using return value of %s which does not return a value",
1659                 ((Symbol *)*(PC - 2))->name);
1660         }
1661     }
1662
1663     /* NULL return PC indicates end of program */
1664     return PC == NULL ? STAT_DONE : STAT_OK;
1665 }
1666
1667 /*
1668 ** Unconditional branch offset by immediate operand
1669 */
1670 static int branch(void)
1671 {
1672     PC += (int)*PC;
1673     return STAT_OK;
1674 }
1675
1676 /*
1677 ** Conditional branches if stack value is True/False (non-zero/0) to address
1678 ** of immediate operand (pops stack)
1679 */
1680 static int branchTrue(void)
1681 {
1682     int value;
1683     Inst *addr;
1684
1685     POP_INT(value)
1686     addr = PC + (int)*PC;
1687     PC++;
1688
1689     if (value)
1690         PC = addr;
1691     return STAT_OK;
1692 }
1693 static int branchFalse(void)
1694 {
1695     int value;
1696     Inst *addr;
1697
1698     POP_INT(value)
1699     addr = PC + (int)*PC;
1700     PC++;
1701
1702     if (!value)
1703         PC = addr;
1704     return STAT_OK;
1705 }
1706
1707 /*
1708 ** Ignore the address following the instruction and continue.  Why? So
1709 ** some code that uses conditional branching doesn't have to figure out
1710 ** whether to store a branch address.
1711 */
1712 static int branchNever(void)
1713 {
1714     PC++;
1715     return STAT_OK;
1716 }
1717
1718 /*
1719 ** recursively copy(duplicate) the sparse array nodes of an array
1720 ** this does not duplicate the key/node data since they are never
1721 ** modified, only replaced
1722 */
1723 int ArrayCopy(DataValue *dstArray, DataValue *srcArray)
1724 {
1725     SparseArrayEntry *srcIter;
1726
1727     dstArray->tag = ARRAY_TAG;
1728     dstArray->val.arrayPtr = ArrayNew();
1729
1730     srcIter = arrayIterateFirst(srcArray);
1731     while (srcIter) {
1732         if (srcIter->value.tag == ARRAY_TAG) {
1733             int errNum;
1734             DataValue tmpArray;
1735
1736             errNum = ArrayCopy(&tmpArray, &srcIter->value);
1737             if (errNum != STAT_OK) {
1738                 return(errNum);
1739             }
1740             if (!ArrayInsert(dstArray, srcIter->key, &tmpArray)) {
1741                 return(execError("array copy failed", NULL));
1742             }
1743         }
1744         else {
1745             if (!ArrayInsert(dstArray, srcIter->key, &srcIter->value)) {
1746                 return(execError("array copy failed", NULL));
1747             }
1748         }
1749         srcIter = arrayIterateNext(srcIter);
1750     }
1751     return(STAT_OK);
1752 }
1753
1754 /*
1755 ** creates an allocated string of a single key for all the sub-scripts
1756 ** using ARRAY_DIM_SEP as a separator
1757 ** this function uses the PEEK macros in order to remove most limits on
1758 ** the number of arguments to an array
1759 ** I really need to optimize the size approximation rather than assuming
1760 ** a worst case size for every integer argument
1761 */
1762 static int makeArrayKeyFromArgs(int nArgs, char **keyString)
1763 {
1764     DataValue tmpVal;
1765     int maxIntDigits = (sizeof(tmpVal.val.n) * 3) + 1;
1766     int sepLen = strlen(ARRAY_DIM_SEP);
1767     int keyLength = 0;
1768     int i;
1769
1770     keyLength = sepLen * (nArgs - 1);
1771     for (i = nArgs - 1; i >= 0; --i) {
1772         PEEK(tmpVal, i)
1773         if (tmpVal.tag == INT_TAG) {
1774             keyLength += maxIntDigits;
1775         }
1776         else if (tmpVal.tag == STRING_TAG) {
1777             keyLength += strlen(tmpVal.val.str);
1778         }
1779         else {
1780             return(execError("can only index array with string or int.", NULL));
1781         }
1782     }
1783     *keyString = AllocString(keyLength + 1);
1784     (*keyString)[0] = 0;
1785     for (i = nArgs - 1; i >= 0; --i) {
1786         if (i != nArgs - 1) {
1787             strcat(*keyString, ARRAY_DIM_SEP);
1788         }
1789         PEEK(tmpVal, i)
1790         if (tmpVal.tag == INT_TAG) {
1791             sprintf(&((*keyString)[strlen(*keyString)]), "%d", tmpVal.val.n);
1792         }
1793         else if (tmpVal.tag == STRING_TAG) {
1794             strcat(*keyString, tmpVal.val.str);
1795         }
1796         else {
1797             return(execError("can only index array with string or int.", NULL));
1798         }
1799     }
1800     for (i = nArgs - 1; i >= 0; --i) {
1801         POP(tmpVal)
1802     }
1803     return(STAT_OK);
1804 }
1805
1806 /*
1807 ** allocate an empty array node, this is used as the root node and never
1808 ** contains any data, only refernces to other nodes
1809 */
1810 static rbTreeNode *arrayEmptyAllocator(void)
1811 {
1812     SparseArrayEntry *newNode = allocateSparseArrayEntry();
1813     if (newNode) {
1814         newNode->key = NULL;
1815         newNode->value.tag = NO_TAG;
1816     }
1817     return((rbTreeNode *)newNode);
1818 }
1819
1820 /*
1821 ** create and copy array node and copy contents, we merely copy pointers
1822 ** since they are never modified, only replaced
1823 */
1824 static rbTreeNode *arrayAllocateNode(rbTreeNode *src)
1825 {
1826     SparseArrayEntry *newNode = allocateSparseArrayEntry();
1827     if (newNode) {
1828         newNode->key = ((SparseArrayEntry *)src)->key;
1829         newNode->value = ((SparseArrayEntry *)src)->value;
1830     }
1831     return((rbTreeNode *)newNode);
1832 }
1833
1834 /*
1835 ** copy array node data, we merely copy pointers since they are never
1836 ** modified, only replaced
1837 */
1838 static int arrayEntryCopyToNode(rbTreeNode *dst, rbTreeNode *src)
1839 {
1840     ((SparseArrayEntry *)dst)->key = ((SparseArrayEntry *)src)->key;
1841     ((SparseArrayEntry *)dst)->value = ((SparseArrayEntry *)src)->value;
1842     return(1);
1843 }
1844
1845 /*
1846 ** compare two array nodes returning an integer value similar to strcmp()
1847 */
1848 static int arrayEntryCompare(rbTreeNode *left, rbTreeNode *right)
1849 {
1850     return(strcmp(((SparseArrayEntry *)left)->key, ((SparseArrayEntry *)right)->key));
1851 }
1852
1853 /*
1854 ** dispose an array node, garbage collection handles this, so we mark it
1855 ** to allow iterators in macro language to determine they have been unlinked
1856 */
1857 static void arrayDisposeNode(rbTreeNode *src)
1858 {
1859     /* Let garbage collection handle this but mark it so iterators can tell */
1860     src->left = NULL;
1861     src->right = NULL;
1862     src->parent = NULL;
1863     src->color = -1;
1864 }
1865
1866 struct SparseArrayEntry *ArrayNew(void)
1867 {
1868         return((struct SparseArrayEntry *)rbTreeNew(arrayEmptyAllocator));
1869 }
1870
1871 /*
1872 ** insert a DataValue into an array, allocate the array if needed
1873 ** keyStr must be a string that was allocated with AllocString()
1874 */
1875 int ArrayInsert(DataValue *theArray, char *keyStr, DataValue *theValue)
1876 {
1877     SparseArrayEntry tmpEntry;
1878     rbTreeNode *insertedNode;
1879
1880     tmpEntry.key = keyStr;
1881     tmpEntry.value = *theValue;
1882
1883     if (theArray->val.arrayPtr == NULL) {
1884         theArray->val.arrayPtr = ArrayNew();
1885     }
1886     if (theArray->val.arrayPtr != NULL) {
1887         insertedNode = rbTreeInsert((rbTreeNode *)(theArray->val.arrayPtr),
1888             (rbTreeNode *)&tmpEntry,
1889             arrayEntryCompare, arrayAllocateNode, arrayEntryCopyToNode);
1890         if (insertedNode) {
1891             return(1);
1892         }
1893         else {
1894             return(0);
1895         }
1896     }
1897     return(0);
1898 }
1899
1900 /*
1901 ** remove a node from an array whose key matches keyStr
1902 */
1903 void ArrayDelete(DataValue *theArray, char *keyStr)
1904 {
1905     SparseArrayEntry searchEntry;
1906
1907     if (theArray->val.arrayPtr) {
1908         searchEntry.key = keyStr;
1909         rbTreeDelete((rbTreeNode *)theArray->val.arrayPtr, (rbTreeNode *)&searchEntry,
1910                     arrayEntryCompare, arrayDisposeNode);
1911     }
1912 }
1913
1914 /*
1915 ** remove all nodes from an array
1916 */
1917 void ArrayDeleteAll(DataValue *theArray)
1918 {
1919
1920     if (theArray->val.arrayPtr) {
1921         rbTreeNode *iter = rbTreeBegin((rbTreeNode *)theArray->val.arrayPtr);
1922         while (iter) {
1923             rbTreeNode *nextIter = rbTreeNext(iter);
1924             rbTreeDeleteNode((rbTreeNode *)theArray->val.arrayPtr,
1925                         iter, arrayDisposeNode);
1926
1927             iter = nextIter;
1928         }
1929     }
1930 }
1931
1932 /*
1933 ** returns the number of elements (nodes containing values) of an array
1934 */
1935 int ArraySize(DataValue *theArray)
1936 {
1937     if (theArray->val.arrayPtr) {
1938         return(rbTreeSize((rbTreeNode *)theArray->val.arrayPtr));
1939     }
1940     else {
1941         return(0);
1942     }
1943 }
1944
1945 /*
1946 ** retrieves an array node whose key matches
1947 ** returns 1 for success 0 for not found
1948 */
1949 int ArrayGet(DataValue *theArray, char *keyStr, DataValue *theValue)
1950 {
1951     SparseArrayEntry searchEntry;
1952     rbTreeNode *foundNode;
1953
1954     if (theArray->val.arrayPtr) {
1955         searchEntry.key = keyStr;
1956         foundNode = rbTreeFind((rbTreeNode *)theArray->val.arrayPtr,
1957                 (rbTreeNode *)&searchEntry, arrayEntryCompare);
1958         if (foundNode) {
1959             *theValue = ((SparseArrayEntry *)foundNode)->value;
1960             return(1);
1961         }
1962     }
1963     return(0);
1964 }
1965
1966 /*
1967 ** get pointer to start iterating an array
1968 */
1969 SparseArrayEntry *arrayIterateFirst(DataValue *theArray)
1970 {
1971     SparseArrayEntry *startPos;
1972     if (theArray->val.arrayPtr) {
1973         startPos = (SparseArrayEntry *)rbTreeBegin((rbTreeNode *)theArray->val.arrayPtr);
1974     }
1975     else {
1976         startPos = NULL;
1977     }
1978     return(startPos);
1979 }
1980
1981 /*
1982 ** move iterator to next entry in array
1983 */
1984 SparseArrayEntry *arrayIterateNext(SparseArrayEntry *iterator)
1985 {
1986     SparseArrayEntry *nextPos;
1987     if (iterator) {
1988         nextPos = (SparseArrayEntry *)rbTreeNext((rbTreeNode *)iterator);
1989     }
1990     else {
1991         nextPos = NULL;
1992     }
1993     return(nextPos);
1994 }
1995
1996 /*
1997 ** evaluate an array element and push the result onto the stack
1998 */
1999 static int arrayRef(void)
2000 {
2001     int errNum;
2002     DataValue srcArray, valueItem;
2003     char *keyString = NULL;
2004     int nDim;
2005
2006     nDim = (int)*PC;
2007     PC++;
2008
2009     if (nDim > 0) {
2010         errNum = makeArrayKeyFromArgs(nDim, &keyString);
2011         if (errNum != STAT_OK) {
2012             return(errNum);
2013         }
2014
2015         POP(srcArray)
2016         if (srcArray.tag == ARRAY_TAG) {
2017             if (!ArrayGet(&srcArray, keyString, &valueItem)) {
2018                 return(execError("referenced array value not in array", NULL));
2019             }
2020             PUSH(valueItem)
2021             return(STAT_OK);
2022         }
2023         else {
2024             return(execError("operator [] on non-array", NULL));
2025         }
2026     }
2027     else {
2028         POP(srcArray)
2029         if (srcArray.tag == ARRAY_TAG) {
2030             PUSH_INT(ArraySize(&srcArray))
2031             return(STAT_OK);
2032         }
2033         else {
2034             return(execError("operator [] on non-array", NULL));
2035         }
2036     }
2037 }
2038
2039 /*
2040 ** assign to an array element, make the symbol an array if it isn't already
2041 */
2042 static int arrayAssign(void)
2043 {
2044     Symbol *sym;
2045     char *keyString = NULL;
2046     DataValue *dstPtr, srcValue;
2047     int errNum;
2048     int nDim;
2049
2050     sym = (Symbol *)*PC;
2051     PC++;
2052     nDim = (int)*PC;
2053     PC++;
2054
2055     if (sym->type == LOCAL_SYM) {
2056             dstPtr = (FrameP + sym->value.val.n);
2057     }
2058     else if (sym->type == GLOBAL_SYM) {
2059         dstPtr = &(sym->value);
2060     }
2061     else if (sym->type == ARG_SYM) {
2062         return(execError("assignment to function argument: %s",  sym->name));
2063     }
2064     else {
2065         return(execError("assignment to non-variable: %s", sym->name));
2066     }
2067
2068     if (nDim > 0) {
2069         POP(srcValue)
2070
2071         errNum = makeArrayKeyFromArgs(nDim, &keyString);
2072         if (errNum != STAT_OK) {
2073             return(errNum);
2074         }
2075
2076         if (dstPtr->tag != ARRAY_TAG) {
2077             dstPtr->tag = ARRAY_TAG;
2078             dstPtr->val.arrayPtr = ArrayNew();
2079         }
2080         if (ArrayInsert(dstPtr, keyString, &srcValue)) {
2081             return(STAT_OK);
2082         }
2083         else {
2084             return(execError("array member allocation failure", NULL));
2085         }
2086     }
2087     return(execError("empty operator []", NULL));
2088 }
2089
2090 /*
2091 ** setup symbol values for array iteration in interpreter
2092 */
2093 static int beginArrayIter(void)
2094 {
2095     Symbol *iterator;
2096     Symbol *array;
2097     DataValue *iteratorValPtr;
2098     DataValue *arrayValPtr;
2099
2100     array = (Symbol *)*PC;
2101     PC++;
2102     iterator = (Symbol *)*PC;
2103     PC++;
2104
2105     if (array->type == LOCAL_SYM) {
2106         arrayValPtr = (FrameP + array->value.val.n);
2107     }
2108     else if (array->type == GLOBAL_SYM) {
2109         arrayValPtr = &(array->value);
2110     }
2111     else if (array->type == ARG_SYM) {
2112         int nArgs = (FrameP-1)->val.n;
2113         int argNum = array->value.val.n;
2114         if (argNum >= nArgs) {
2115             return(execError("referenced undefined argument: %s",  array->name));
2116         }
2117         if (argNum != N_ARGS_ARG_SYM) {
2118             arrayValPtr = (FrameP + argNum - nArgs - 3);
2119         }
2120         else {
2121             return(execError("can't iterate non-array",  array->name));
2122         }
2123     }
2124     else {
2125         return(execError("can't iterate variable: %s",  array->name));
2126     }
2127
2128     if (iterator->type == LOCAL_SYM) {
2129         iteratorValPtr = (FrameP + iterator->value.val.n);
2130     }
2131     else {
2132         return(execError("bad temporary iterator: %s",  iterator->name));
2133     }
2134     iteratorValPtr->tag = INT_TAG;
2135
2136     if (arrayValPtr->tag != ARRAY_TAG) {
2137         return(execError("can't iterate non-array: %s", array->name));
2138     }
2139
2140     iteratorValPtr->val.arrayPtr = (struct SparseArrayEntry *)arrayIterateFirst(arrayValPtr);
2141     return(STAT_OK);
2142 }
2143
2144 /*
2145 ** copy key to symbol if node is still valid, marked bad by a color of -1
2146 ** then move iterator to next node
2147 ** this allows iterators to progress even if you delete any node in the array
2148 ** except the item just after the current key
2149 */
2150 static int arrayIter(void)
2151 {
2152     Symbol *iterator;
2153     Symbol *item;
2154     DataValue *iteratorValPtr;
2155     DataValue *itemValPtr;
2156     SparseArrayEntry *thisEntry;
2157     Inst *branchAddr;
2158
2159     item = (Symbol *)*PC;
2160     PC++;
2161     iterator = (Symbol *)*PC;
2162     PC++;
2163     branchAddr = PC + (int)*PC;
2164     PC++;
2165
2166     if (item->type == LOCAL_SYM) {
2167         itemValPtr = (FrameP + item->value.val.n);
2168     }
2169     else if (item->type == GLOBAL_SYM) {
2170         itemValPtr = &(item->value);
2171     }
2172     else {
2173         return(execError("can't assign to: %s",  item->name));
2174     }
2175     itemValPtr->tag = NO_TAG;
2176
2177     if (iterator->type == LOCAL_SYM) {
2178         iteratorValPtr = (FrameP + iterator->value.val.n);
2179     }
2180     else {
2181         return(execError("bad temporary iterator: %s",  iterator->name));
2182     }
2183
2184     thisEntry = (SparseArrayEntry *)iteratorValPtr->val.arrayPtr;
2185     if (thisEntry && thisEntry->nodePtrs.color != -1) {
2186         itemValPtr->tag = STRING_TAG;
2187         itemValPtr->val.str = thisEntry->key;
2188
2189         iteratorValPtr->val.arrayPtr = (struct SparseArrayEntry *)arrayIterateNext(thisEntry);
2190     }
2191     else {
2192         PC = branchAddr;
2193     }
2194     return(STAT_OK);
2195 }
2196
2197 /*
2198 ** deletermine if a key or keys exists in an array
2199 ** if the left argument is a string or integer a single check is performed
2200 ** if the key exists, 1 is pushed onto the stack, otherwise 0
2201 ** if the left argument is an array 1 is pushed onto the stack if every key
2202 ** in the left array exists in the right array, otherwise 0
2203 */
2204 static int inArray(void)
2205 {
2206     DataValue theArray, leftArray, theValue;
2207     char *keyStr;
2208     int inResult = 0;
2209
2210     POP(theArray)
2211     if (theArray.tag != ARRAY_TAG) {
2212         return(execError("operator in on non-array", NULL));
2213     }
2214     PEEK(leftArray, 0)
2215     if (leftArray.tag == ARRAY_TAG) {
2216         SparseArrayEntry *iter;
2217
2218         POP(leftArray)
2219         inResult = 1;
2220         iter = arrayIterateFirst(&leftArray);
2221         while (inResult && iter) {
2222             inResult = inResult && ArrayGet(&theArray, iter->key, &theValue);
2223             iter = arrayIterateNext(iter);
2224         }
2225     }
2226     else {
2227         POP_STRING(keyStr)
2228         if (ArrayGet(&theArray, keyStr, &theValue)) {
2229             inResult = 1;
2230         }
2231     }
2232     PUSH_INT(inResult)
2233     return(STAT_OK);
2234 }
2235
2236 /*
2237 ** remove a given key from an array unless nDim is 0, then all keys are removed
2238 */
2239 static int deleteArrayElement(void)
2240 {
2241     Symbol *sym;
2242     char *keyString = NULL;
2243     DataValue *dstPtr;
2244     int errNum;
2245     int nDim;
2246
2247     sym = (Symbol *)*PC;
2248     PC++;
2249     nDim = (int)*PC;
2250     PC++;
2251
2252     if (sym->type == LOCAL_SYM) {
2253             dstPtr = (FrameP + sym->value.val.n);
2254     }
2255     else if (sym->type == GLOBAL_SYM) {
2256         dstPtr = &(sym->value);
2257     }
2258     else if (sym->type == ARG_SYM) {
2259         return(execError("can't delete from function argument: %s",  sym->name));
2260     }
2261     else {
2262         return(execError("can't delete non-array element: %s", sym->name));
2263     }
2264
2265     if (dstPtr->tag != ARRAY_TAG) {
2266         return(execError("attempt to delete from non-array: %s", sym->name));
2267     }
2268     if (nDim > 0) {
2269         errNum = makeArrayKeyFromArgs(nDim, &keyString);
2270         if (errNum != STAT_OK) {
2271             return(errNum);
2272         }
2273
2274         ArrayDelete(dstPtr, keyString);
2275         return(STAT_OK);
2276     }
2277     else {
2278         ArrayDeleteAll(dstPtr);
2279         return(STAT_OK);
2280     }
2281 }
2282
2283 /*
2284 ** checks errno after operations which can set it.  If an error occured,
2285 ** creates appropriate error messages and returns false
2286 */
2287 static int errCheck(const char *s)
2288 {
2289     if (errno == EDOM)
2290         return execError("%s argument out of domain", s);
2291     else if (errno == ERANGE)
2292         return execError("%s result out of range", s);
2293     else
2294         return STAT_OK;
2295 }
2296
2297 /*
2298 ** combine two strings in a static area and set ErrMsg to point to the
2299 ** result.  Returns false so a single return execError() statement can
2300 ** be used to both process the message and return.
2301 */
2302 static int execError(const char *s1, const char *s2)
2303 {
2304     static char msg[MAX_ERR_MSG_LEN];
2305
2306     sprintf(msg, s1, s2);
2307     ErrMsg = msg;
2308     return STAT_ERROR;
2309 }
2310
2311 static int stringToNum(const char *string, int *number)
2312 {
2313     int i;
2314     const char *c;
2315
2316     /*... this is still not finished */
2317     for (c=string, i=0; *c != '\0'; i++, c++)
2318         if (!(isdigit((unsigned char)*c) || *c != ' ' || *c != '\t'))
2319             return False;
2320     if (sscanf(string, "%d", number) != 1) {
2321         *number = 0;
2322     }
2323     return True;
2324 }
2325
2326 #ifdef DEBUG_ASSEMBLY /* For debugging code generation */
2327 static void disasm(Program *prog, int nInstr)
2328 {
2329     static const char *opNames[N_OPS] = {"returnNoVal", "returnVal", "pushSymVal",
2330         "dupStack", "add", "subtract", "multiply", "divide", "modulo",
2331         "negate", "increment", "decrement", "gt", "lt", "ge", "le", "eq",
2332         "ne", "bitAnd", "bitOr", "and", "or", "not", "power", "concat",
2333         "assign", "callSubroutine", "fetchRetVal", "branch", "branchTrue",
2334         "branchFalse", "branchNever", "arrayRef", "arrayAssign",
2335         "beginArrayIter", "arrayIter", "inArray", "deleteArrayElement"};
2336     int i, j;
2337
2338     for (i=0; i<nInstr; i++) {
2339         printf("%x ", &prog->code[i]);
2340         for (j=0; j<N_OPS; j++) {
2341             if (prog->code[i] == OpFns[j]) {
2342                 printf("%s", opNames[j]);
2343                 if (j == OP_PUSH_SYM || j == OP_ASSIGN) {
2344                     printf(" %s", ((Symbol *)prog->code[i+1])->name);
2345                     i++;
2346                 } else if (j == OP_BRANCH || j == OP_BRANCH_FALSE ||
2347                         j == OP_BRANCH_NEVER) {
2348                     printf(" (%d) %x", (int)prog->code[i+1],
2349                             &prog->code[i+1] + (int)prog->code[i+1]);
2350                     i++;
2351                 } else if (j == OP_SUBR_CALL || j == OP_ARRAY_ASSIGN) {
2352                     printf(" %s (%d arg)", ((Symbol *)prog->code[i+1])->name,
2353                             prog->code[i+2]);
2354                     i += 2;
2355                 } else if (j == OP_BEGIN_ARRAY_ITER) {
2356                                         printf(" %s in %s",
2357                                                 ((Symbol *)prog->code[i+1])->name,
2358                                                 ((Symbol *)prog->code[i+2])->name);
2359                                         i += 2;
2360                 } else if (j == OP_ARRAY_ITER) {
2361                                         printf(" %s in %s (%d) %x",
2362                                                 ((Symbol *)prog->code[i+1])->name,
2363                                                 ((Symbol *)prog->code[i+2])->name,
2364                                                 (int)prog->code[i+3],
2365                                                 &prog->code[i+3] + (int)prog->code[i+3]);
2366                                         i += 3;
2367                                 }
2368
2369                 printf("\n");
2370                 break;
2371             }
2372         }
2373         if (j == N_OPS)
2374             printf("%x\n", prog->code[i]);
2375     }
2376 }
2377 #endif /* ifdef DEBUG_ASSEMBLY */