source/interpret.c

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