source/interpret.c

   1 static const char CVSID[] = "$Id: interpret.c,v 1.43 2004/11/23 14:37:37 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. In addition, you may distribute version of this program linked to   *
  12 * Motif or Open Motif. See README for details.                                 *
  13 *                                                                              *
  14 * This software is distributed in the hope that it will be useful, but WITHOUT *
  15 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or        *
  16 * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License        *
  17 * for more details.                                                            *
  18 *                                                                              *
  19 * You should have received a copy of the GNU General Public License along with *
  20 * software; if not, write to the Free Software Foundation, Inc., 59 Temple     *
  21 * Place, Suite 330, Boston, MA  02111-1307 USA                                 *
  22 *                                                                              *
  23 * Nirvana Text Editor                                                          *
  24 * April, 1997                                                                  *
  25 *                                                                              *
  26 * Written by Mark Edel                                                         *
  27 *                                                                              *
  28 *******************************************************************************/
  29
  30 #ifdef HAVE_CONFIG_H
  31 #include "../config.h"
  32 #endif
  33
  34 #include "interpret.h"
  35 #include "textBuf.h"
  36 #include "nedit.h"
  37 #include "menu.h"
  38 #include "text.h"
  39 #include "rbTree.h"
  40
  41 #include <stdio.h>
  42 #include <stdlib.h>
  43 #include <string.h>
  44 #include <math.h>
  45 #include <limits.h>
  46 #include <ctype.h>
  47 #include <errno.h>
  48 #ifdef VMS
  49 #include "../util/VMSparam.h"
  50 #else
  51 #ifndef __MVS__
  52 #include <sys/param.h>
  53 #endif
  54 #endif /*VMS*/
  55
  56 #include <X11/Intrinsic.h>
  57 #include <Xm/Xm.h>
  58
  59 #include "window.h"
  60
  61 #ifdef HAVE_DEBUG_H
  62 #include "../debug.h"
  63 #endif
  64
  65 #define PROGRAM_SIZE  4096      /* Maximum program size */
  66 #define MAX_ERR_MSG_LEN 256     /* Max. length for error messages */
  67 #define LOOP_STACK_SIZE 200     /* (Approx.) Number of break/continue stmts
  68                                    allowed per program */
  69 #define INSTRUCTION_LIMIT 100   /* Number of instructions the interpreter is
  70                                    allowed to execute before preempting and
  71                                    returning to allow other things to run */
  72
  73 /* Temporary markers placed in a branch address location to designate
  74    which loop address (break or continue) the location needs */
  75 #define NEEDS_BREAK (Inst)1
  76 #define NEEDS_CONTINUE (Inst)2
  77
  78 #define N_ARGS_ARG_SYM -1       /* special arg number meaning $n_args value */
  79
  80 enum opStatusCodes {STAT_OK=2, STAT_DONE, STAT_ERROR, STAT_PREEMPT};
  81
  82 static void addLoopAddr(Inst *addr);
  83 static void saveContext(RestartData *context);
  84 static void restoreContext(RestartData *context);
  85 static int returnNoVal(void);
  86 static int returnVal(void);
  87 static int returnValOrNone(int valOnStack);
  88 static int pushSymVal(void);
  89 static int pushArgVal(void);
  90 static int pushArgCount(void);
  91 static int pushArgArray(void);
  92 static int pushArraySymVal(void);
  93 static int dupStack(void);
  94 static int add(void);
  95 static int subtract(void);
  96 static int multiply(void);
  97 static int divide(void);
  98 static int modulo(void);
  99 static int negate(void);
 100 static int increment(void);
 101 static int decrement(void);
 102 static int gt(void);
 103 static int lt(void);
 104 static int ge(void);
 105 static int le(void);
 106 static int eq(void);
 107 static int ne(void);
 108 static int bitAnd(void);
 109 static int bitOr(void);
 110 static int and(void);
 111 static int or(void);
 112 static int not(void);
 113 static int power(void);
 114 static int concat(void);
 115 static int assign(void);
 116 static int callSubroutine(void);
 117 static int fetchRetVal(void);
 118 static int branch(void);
 119 static int branchTrue(void);
 120 static int branchFalse(void);
 121 static int branchNever(void);
 122 static int arrayRef(void);
 123 static int arrayAssign(void);
 124 static int arrayRefAndAssignSetup(void);
 125 static int beginArrayIter(void);
 126 static int arrayIter(void);
 127 static int inArray(void);
 128 static int deleteArrayElement(void);
 129 static void freeSymbolTable(Symbol *symTab);
 130 static int errCheck(const char *s);
 131 static int execError(const char *s1, const char *s2);
 132 static rbTreeNode *arrayEmptyAllocator(void);
 133 static rbTreeNode *arrayAllocateNode(rbTreeNode *src);
 134 static int arrayEntryCopyToNode(rbTreeNode *dst, rbTreeNode *src);
 135 static int arrayEntryCompare(rbTreeNode *left, rbTreeNode *right);
 136 static void arrayDisposeNode(rbTreeNode *src);
 137 static SparseArrayEntry *allocateSparseArrayEntry(void);
 138
 139 /*#define DEBUG_ASSEMBLY*/
 140 /*#define DEBUG_STACK*/
 141
 142 #if defined(DEBUG_ASSEMBLY) || defined(DEBUG_STACK)
 143 #define DEBUG_DISASSEMBLER
 144 static void disasm(Inst *inst, int nInstr);
 145 #endif /* #if defined(DEBUG_ASSEMBLY) || defined(DEBUG_STACK) */
 146
 147 #ifdef DEBUG_ASSEMBLY   /* for disassembly */
 148 #define DISASM(i, n)    disasm(i, n)
 149 #else /* #ifndef DEBUG_ASSEMBLY */
 150 #define DISASM(i, n)
 151 #endif /* #ifndef DEBUG_ASSEMBLY */
 152
 153 #ifdef DEBUG_STACK      /* for run-time instruction and stack trace */
 154 static void stackdump(int n, int extra);
 155 #define STACKDUMP(n, x) stackdump(n, x)
 156 #define DISASM_RT(i, n) disasm(i, n)
 157 #else /* #ifndef DEBUG_STACK */
 158 #define STACKDUMP(n, x)
 159 #define DISASM_RT(i, n)
 160 #endif /* #ifndef DEBUG_STACK */
 161
 162 /* Global symbols and function definitions */
 163 static Symbol *GlobalSymList = NULL;
 164
 165 /* List of all memory allocated for strings */
 166 static char *AllocatedStrings = NULL;
 167
 168 typedef struct {
 169     SparseArrayEntry    data; /* LEAVE this as top entry */
 170     int inUse;              /* we use pointers to the data to refer to the entire struct */
 171     struct SparseArrayEntryWrapper *next;
 172 } SparseArrayEntryWrapper;
 173
 174 static SparseArrayEntryWrapper *AllocatedSparseArrayEntries = NULL;
 175
 176 /* Message strings used in macros (so they don't get repeated every time
 177    the macros are used */
 178 static const char *StackOverflowMsg = "macro stack overflow";
 179 static const char *StackUnderflowMsg = "macro stack underflow";
 180 static const char *StringToNumberMsg = "string could not be converted to number";
 181
 182 /* Temporary global data for use while accumulating programs */
 183 static Symbol *LocalSymList = NULL;      /* symbols local to the program */
 184 static Inst Prog[PROGRAM_SIZE];          /* the program */
 185 static Inst *ProgP;                      /* next free spot for code gen. */
 186 static Inst *LoopStack[LOOP_STACK_SIZE]; /* addresses of break, cont stmts */
 187 static Inst **LoopStackPtr = LoopStack;  /*  to fill at the end of a loop */
 188
 189 /* Global data for the interpreter */
 190 static DataValue *Stack;            /* the stack */
 191 static DataValue *StackP;           /* next free spot on stack */
 192 static DataValue *FrameP;           /* frame pointer (start of local variables
 193                                        for the current subroutine invocation) */
 194 static Inst *PC;                    /* program counter during execution */
 195 static char *ErrMsg;                /* global for returning error messages
 196                                        from executing functions */
 197 static WindowInfo
 198         *InitiatingWindow = NULL;   /* window from which macro was run */
 199 static WindowInfo *FocusWindow;     /* window on which macro commands operate */
 200 static int PreemptRequest;          /* passes preemption requests from called
 201                                        routines back up to the interpreter */
 202
 203 /* Array for mapping operations to functions for performing the operations
 204    Must correspond to the enum called "operations" in interpret.h */
 205 static int (*OpFns[N_OPS])() = {returnNoVal, returnVal, pushSymVal, dupStack,
 206     add, subtract, multiply, divide, modulo, negate, increment, decrement,
 207     gt, lt, ge, le, eq, ne, bitAnd, bitOr, and, or, not, power, concat,
 208     assign, callSubroutine, fetchRetVal, branch, branchTrue, branchFalse,
 209     branchNever, arrayRef, arrayAssign, beginArrayIter, arrayIter, inArray,
 210     deleteArrayElement, pushArraySymVal,
 211     arrayRefAndAssignSetup, pushArgVal, pushArgCount, pushArgArray};
 212
 213 /* Stack-> symN-sym0(FP), argArray, nArgs, oldFP, retPC, argN-arg1, next, ... */
 214 #define FP_ARG_ARRAY_CACHE_INDEX (-1)
 215 #define FP_ARG_COUNT_INDEX (-2)
 216 #define FP_OLD_FP_INDEX (-3)
 217 #define FP_RET_PC_INDEX (-4)
 218 #define FP_TO_ARGS_DIST (4) /* should be 0 - (above index) */
 219 #define FP_GET_ITEM(xFrameP,xIndex) (*(xFrameP + xIndex))
 220 #define FP_GET_ARG_ARRAY_CACHE(xFrameP) (FP_GET_ITEM(xFrameP, FP_ARG_ARRAY_CACHE_INDEX))
 221 #define FP_GET_ARG_COUNT(xFrameP) (FP_GET_ITEM(xFrameP, FP_ARG_COUNT_INDEX).val.n)
 222 #define FP_GET_OLD_FP(xFrameP) ((FP_GET_ITEM(xFrameP, FP_OLD_FP_INDEX)).val.dataval)
 223 #define FP_GET_RET_PC(xFrameP) ((FP_GET_ITEM(xFrameP, FP_RET_PC_INDEX)).val.inst)
 224 #define FP_ARG_START_INDEX(xFrameP) (-(FP_GET_ARG_COUNT(xFrameP) + FP_TO_ARGS_DIST))
 225 #define FP_GET_ARG_N(xFrameP,xN) (FP_GET_ITEM(xFrameP, xN + FP_ARG_START_INDEX(xFrameP)))
 226 #define FP_GET_SYM_N(xFrameP,xN) (FP_GET_ITEM(xFrameP, xN))
 227 #define FP_GET_SYM_VAL(xFrameP,xSym) (FP_GET_SYM_N(xFrameP, xSym->value.val.n))
 228
 229 /*
 230 ** Initialize macro language global variables.  Must be called before
 231 ** any macros are even parsed, because the parser uses action routine
 232 ** symbols to comprehend hyphenated names.
 233 */
 234 void InitMacroGlobals(void)
 235 {
 236     XtActionsRec *actions;
 237     int i, nActions;
 238     static char argName[3] = "$x";
 239     static DataValue dv = {NO_TAG, {0}};
 240
 241     /* Add action routines from NEdit menus and text widget */
 242     actions = GetMenuActions(&nActions);
 243     for (i=0; i<nActions; i++) {
 244         dv.val.xtproc = actions[i].proc;
 245         InstallSymbol(actions[i].string, ACTION_ROUTINE_SYM, dv);
 246     }
 247     actions = TextGetActions(&nActions);
 248     for (i=0; i<nActions; i++) {
 249         dv.val.xtproc = actions[i].proc;
 250         InstallSymbol(actions[i].string, ACTION_ROUTINE_SYM, dv);
 251     }
 252
 253     /* Add subroutine argument symbols ($1, $2, ..., $9) */
 254     for (i=0; i<9; i++) {
 255         argName[1] = '1' + i;
 256         dv.val.n = i;
 257         InstallSymbol(argName, ARG_SYM, dv);
 258     }
 259
 260     /* Add special symbol $n_args */
 261     dv.val.n = N_ARGS_ARG_SYM;
 262     InstallSymbol("$n_args", ARG_SYM, dv);
 263 }
 264
 265 /*
 266 ** To build a program for the interpreter, call BeginCreatingProgram, to
 267 ** begin accumulating the program, followed by calls to AddOp, AddSym,
 268 ** and InstallSymbol to add symbols and operations.  When the new program
 269 ** is finished, collect the results with FinishCreatingProgram.  This returns
 270 ** a self contained program that can be run with ExecuteMacro.
 271 */
 272
 273 /*
 274 ** Start collecting instructions for a program. Clears the program
 275 ** and the symbol table.
 276 */
 277 void BeginCreatingProgram(void)
 278 {
 279     LocalSymList = NULL;
 280     ProgP = Prog;
 281     LoopStackPtr = LoopStack;
 282 }
 283
 284 /*
 285 ** Finish up the program under construction, and return it (code and
 286 ** symbol table) as a package that ExecuteMacro can execute.  This
 287 ** program must be freed with FreeProgram.
 288 */
 289 Program *FinishCreatingProgram(void)
 290 {
 291     Program *newProg;
 292     int progLen, fpOffset = 0;
 293     Symbol *s;
 294
 295     newProg = (Program *)XtMalloc(sizeof(Program));
 296     progLen = ((char *)ProgP) - ((char *)Prog);
 297     newProg->code = (Inst *)XtMalloc(progLen);
 298     memcpy(newProg->code, Prog, progLen);
 299     newProg->localSymList = LocalSymList;
 300     LocalSymList = NULL;
 301
 302     /* Local variables' values are stored on the stack.  Here we assign
 303        frame pointer offsets to them. */
 304     for (s = newProg->localSymList; s != NULL; s = s->next)
 305         s->value.val.n = fpOffset++;
 306
 307     DISASM(newProg->code, ProgP - Prog);
 308
 309     return newProg;
 310 }
 311
 312 void FreeProgram(Program *prog)
 313 {
 314     freeSymbolTable(prog->localSymList);
 315     XtFree((char *)prog->code);
 316     XtFree((char *)prog);
 317 }
 318
 319 /*
 320 ** Add an operator (instruction) to the end of the current program
 321 */
 322 int AddOp(int op, char **msg)
 323 {
 324     if (ProgP >= &Prog[PROGRAM_SIZE]) {
 325         *msg = "macro too large";
 326         return 0;
 327     }
 328     *ProgP++ = OpFns[op];
 329     return 1;
 330 }
 331
 332 /*
 333 ** Add a symbol operand to the current program
 334 */
 335 int AddSym(Symbol *sym, char **msg)
 336 {
 337     if (ProgP >= &Prog[PROGRAM_SIZE]) {
 338         *msg = "macro too large";
 339         return 0;
 340     }
 341     *ProgP++ = (Inst)sym;
 342     return 1;
 343 }
 344
 345 /*
 346 ** Add an immediate value operand to the current program
 347 */
 348 int AddImmediate(void *value, char **msg)
 349 {
 350     if (ProgP >= &Prog[PROGRAM_SIZE]) {
 351         *msg = "macro too large";
 352         return 0;
 353     }
 354     *ProgP++ = (Inst)value;
 355     return 1;
 356 }
 357
 358 /*
 359 ** Add a branch offset operand to the current program
 360 */
 361 int AddBranchOffset(Inst *to, char **msg)
 362 {
 363     if (ProgP >= &Prog[PROGRAM_SIZE]) {
 364         *msg = "macro too large";
 365         return 0;
 366     }
 367     *ProgP = (Inst)(to - ProgP);
 368     ProgP++;
 369
 370     return 1;
 371 }
 372
 373 /*
 374 ** Return the address at which the next instruction will be stored
 375 */
 376 Inst *GetPC(void)
 377 {
 378     return ProgP;
 379 }
 380
 381 /*
 382 ** Swap the positions of two contiguous blocks of code.  The first block
 383 ** running between locations start and boundary, and the second between
 384 ** boundary and end.
 385 */
 386 void SwapCode(Inst *start, Inst *boundary, Inst *end)
 387 {
 388 #define reverseCode(L, H) \
 389     do { register Inst t, *l = L, *h = H - 1; \
 390          while (l < h) { t = *h; *h-- = *l; *l++ = t; } } while (0)
 391     /* double-reverse method: reverse elements of both parts then whole lot */
 392     /* eg abcdefABCD -1-> edcbaABCD -2-> edcbaDCBA -3-> DCBAedcba */
 393     reverseCode(start, boundary);   /* 1 */
 394     reverseCode(boundary, end);     /* 2 */
 395     reverseCode(start, end);        /* 3 */
 396 }
 397
 398 /*
 399 ** Maintain a stack to save addresses of branch operations for break and
 400 ** continue statements, so they can be filled in once the information
 401 ** on where to branch is known.
 402 **
 403 ** Call StartLoopAddrList at the beginning of a loop, AddBreakAddr or
 404 ** AddContinueAddr to register the address at which to store the branch
 405 ** address for a break or continue statement, and FillLoopAddrs to fill
 406 ** in all the addresses and return to the level of the enclosing loop.
 407 */
 408 void StartLoopAddrList(void)
 409 {
 410     addLoopAddr(NULL);
 411 }
 412
 413 int AddBreakAddr(Inst *addr)
 414 {
 415     if (LoopStackPtr == LoopStack) return 1;
 416     addLoopAddr(addr);
 417     *addr = NEEDS_BREAK;
 418     return 0;
 419 }
 420
 421 int AddContinueAddr(Inst *addr)
 422 {
 423     if (LoopStackPtr == LoopStack) return 1;
 424     addLoopAddr(addr);
 425     *addr = NEEDS_CONTINUE;
 426     return 0;
 427 }
 428
 429 static void addLoopAddr(Inst *addr)
 430 {
 431     if (LoopStackPtr > &LoopStack[LOOP_STACK_SIZE-1]) {
 432         fprintf(stderr, "NEdit: loop stack overflow in macro parser");
 433         return;
 434     }
 435     *LoopStackPtr++ = addr;
 436 }
 437
 438 void FillLoopAddrs(Inst *breakAddr, Inst *continueAddr)
 439 {
 440     while (True) {
 441         LoopStackPtr--;
 442         if (LoopStackPtr < LoopStack) {
 443             fprintf(stderr, "NEdit: internal error (lsu) in macro parser\n");
 444             return;
 445         }
 446         if (*LoopStackPtr == NULL)
 447             break;
 448         if (**LoopStackPtr == NEEDS_BREAK)
 449             **(Inst ***)LoopStackPtr = (Inst *)(breakAddr - *LoopStackPtr);
 450         else if (**LoopStackPtr == NEEDS_CONTINUE)
 451             **(Inst ***)LoopStackPtr = (Inst *)(continueAddr - *LoopStackPtr);
 452         else
 453             fprintf(stderr, "NEdit: internal error (uat) in macro parser\n");
 454     }
 455 }
 456
 457 /*
 458 ** Execute a compiled macro, "prog", using the arguments in the array
 459 ** "args".  Returns one of MACRO_DONE, MACRO_PREEMPT, or MACRO_ERROR.
 460 ** if MACRO_DONE is returned, the macro completed, and the returned value
 461 ** (if any) can be read from "result".  If MACRO_PREEMPT is returned, the
 462 ** macro exceeded its alotted time-slice and scheduled...
 463 */
 464 int ExecuteMacro(WindowInfo *window, Program *prog, int nArgs, DataValue *args,
 465         DataValue *result, RestartData **continuation, char **msg)
 466 {
 467     RestartData *context;
 468     static DataValue noValue = {NO_TAG, {0}};
 469     Symbol *s;
 470     int i;
 471
 472     /* Create an execution context (a stack, a stack pointer, a frame pointer,
 473        and a program counter) which will retain the program state across
 474        preemption and resumption of execution */
 475     context = (RestartData *)XtMalloc(sizeof(RestartData));
 476     context->stack = (DataValue *)XtMalloc(sizeof(DataValue) * STACK_SIZE);
 477     *continuation = context;
 478     context->stackP = context->stack;
 479     context->pc = prog->code;
 480     context->runWindow = window;
 481     context->focusWindow = window;
 482
 483     /* Push arguments and call information onto the stack */
 484     for (i=0; i<nArgs; i++)
 485         *(context->stackP++) = args[i];
 486
 487     context->stackP->val.subr = NULL; /* return PC */
 488     context->stackP->tag = NO_TAG;
 489     context->stackP++;
 490
 491     *(context->stackP++) = noValue; /* old FrameP */
 492
 493     context->stackP->tag = NO_TAG; /* nArgs */
 494     context->stackP->val.n = nArgs;
 495     context->stackP++;
 496
 497     *(context->stackP++) = noValue; /* cached arg array */
 498
 499     context->frameP = context->stackP;
 500
 501     /* Initialize and make room on the stack for local variables */
 502     for (s = prog->localSymList; s != NULL; s = s->next) {
 503         FP_GET_SYM_VAL(context->frameP, s) = noValue;
 504         context->stackP++;
 505     }
 506
 507     /* Begin execution, return on error or preemption */
 508     return ContinueMacro(context, result, msg);
 509 }
 510
 511 /*
 512 ** Continue the execution of a suspended macro whose state is described in
 513 ** "continuation"
 514 */
 515 int ContinueMacro(RestartData *continuation, DataValue *result, char **msg)
 516 {
 517     register int status, instCount = 0;
 518     register Inst *inst;
 519     RestartData oldContext;
 520
 521     /* To allow macros to be invoked arbitrarily (such as those automatically
 522        triggered within smart-indent) within executing macros, this call is
 523        reentrant. */
 524     saveContext(&oldContext);
 525
 526     /*
 527     ** Execution Loop:  Call the succesive routine addresses in the program
 528     ** until one returns something other than STAT_OK, then take action
 529     */
 530     restoreContext(continuation);
 531     ErrMsg = NULL;
 532     for (;;) {
 533
 534         /* Execute an instruction */
 535         inst = PC++;
 536         status = (*inst)();
 537
 538         /* If error return was not STAT_OK, return to caller */
 539         if (status != STAT_OK) {
 540             if (status == STAT_PREEMPT) {
 541                 saveContext(continuation);
 542                 restoreContext(&oldContext);
 543                 return MACRO_PREEMPT;
 544             } else if (status == STAT_ERROR) {
 545                 *msg = ErrMsg;
 546                 FreeRestartData(continuation);
 547                 restoreContext(&oldContext);
 548                 return MACRO_ERROR;
 549             } else if (status == STAT_DONE) {
 550                 *msg = "";
 551                 *result = *--StackP;
 552                 FreeRestartData(continuation);
 553                 restoreContext(&oldContext);
 554                 return MACRO_DONE;
 555             }
 556         }
 557
 558         /* Count instructions executed.  If the instruction limit is hit,
 559            preempt, store re-start information in continuation and give
 560            X, other macros, and other shell scripts a chance to execute */
 561         instCount++;
 562         if (instCount >= INSTRUCTION_LIMIT) {
 563             saveContext(continuation);
 564             restoreContext(&oldContext);
 565             return MACRO_TIME_LIMIT;
 566         }
 567     }
 568 }
 569
 570 /*
 571 ** If a macro is already executing, and requests that another macro be run,
 572 ** this can be called instead of ExecuteMacro to run it in the same context
 573 ** as if it were a subroutine.  This saves the caller from maintaining
 574 ** separate contexts, and serializes processing of the two macros without
 575 ** additional work.
 576 */
 577 void RunMacroAsSubrCall(Program *prog)
 578 {
 579     Symbol *s;
 580     static DataValue noValue = {NO_TAG, {0}};
 581
 582     /* See subroutine "callSubroutine" for a description of the stack frame
 583        for a subroutine call */
 584     StackP->tag = NO_TAG;
 585     StackP->val.inst = PC; /* return PC */
 586     StackP++;
 587
 588     StackP->tag = NO_TAG;
 589     StackP->val.dataval = FrameP; /* old FrameP */
 590     StackP++;
 591
 592     StackP->tag = NO_TAG; /* nArgs */
 593     StackP->val.n = 0;
 594     StackP++;
 595
 596     *(StackP++) = noValue; /* cached arg array */
 597
 598     FrameP = StackP;
 599     PC = prog->code;
 600     for (s = prog->localSymList; s != NULL; s = s->next) {
 601         FP_GET_SYM_VAL(FrameP, s) = noValue;
 602         StackP++;
 603     }
 604 }
 605
 606 void FreeRestartData(RestartData *context)
 607 {
 608     XtFree((char *)context->stack);
 609     XtFree((char *)context);
 610 }
 611
 612 /*
 613 ** Cause a macro in progress to be preempted (called by commands which take
 614 ** a long time, or want to return to the event loop.  Call ResumeMacroExecution
 615 ** to resume.
 616 */
 617 void PreemptMacro(void)
 618 {
 619     PreemptRequest = True;
 620 }
 621
 622 /*
 623 ** Reset the return value for a subroutine which caused preemption (this is
 624 ** how to return a value from a routine which preempts instead of returning
 625 ** a value directly).
 626 */
 627 void ModifyReturnedValue(RestartData *context, DataValue dv)
 628 {
 629     if (*(context->pc-1) == fetchRetVal)
 630         *(context->stackP-1) = dv;
 631 }
 632
 633 /*
 634 ** Called within a routine invoked from a macro, returns the window in
 635 ** which the macro is executing (where the banner is, not where it is focused)
 636 */
 637 WindowInfo *MacroRunWindow(void)
 638 {
 639     return InitiatingWindow;
 640 }
 641
 642 /*
 643 ** Called within a routine invoked from a macro, returns the window to which
 644 ** the currently executing macro is focused (the window which macro commands
 645 ** modify, not the window from which the macro is being run)
 646 */
 647 WindowInfo *MacroFocusWindow(void)
 648 {
 649     return FocusWindow;
 650 }
 651
 652 /*
 653 ** Set the window to which macro subroutines and actions which operate on an
 654 ** implied window are directed.
 655 */
 656 void SetMacroFocusWindow(WindowInfo *window)
 657 {
 658     FocusWindow = window;
 659 }
 660
 661 /*
 662 ** install an array iteration symbol
 663 ** it is tagged as an integer but holds an array node pointer
 664 */
 665 #define ARRAY_ITER_SYM_PREFIX "aryiter "
 666 Symbol *InstallIteratorSymbol(void)
 667 {
 668     char symbolName[sizeof(ARRAY_ITER_SYM_PREFIX) + TYPE_INT_STR_SIZE(int)];
 669     DataValue value;
 670     static int interatorNameIndex = 0;
 671
 672     sprintf(symbolName, ARRAY_ITER_SYM_PREFIX "#%d", interatorNameIndex);
 673     ++interatorNameIndex;
 674     value.tag = INT_TAG;
 675     value.val.arrayPtr = NULL;
 676     return(InstallSymbol(symbolName, LOCAL_SYM, value));
 677 }
 678
 679 /*
 680 ** Lookup a constant string by its value. This allows reuse of string
 681 ** constants and fixing a leak in the interpreter.
 682 */
 683 Symbol *LookupStringConstSymbol(const char *value)
 684 {
 685     Symbol *s;
 686
 687     for (s = GlobalSymList; s != NULL; s = s->next) {
 688         if (s->type == CONST_SYM &&
 689             s->value.tag == STRING_TAG &&
 690             !strcmp(s->value.val.str.rep, value)) {
 691             return(s);
 692         }
 693     }
 694     return(NULL);
 695 }
 696
 697 /*
 698 ** install string str in the global symbol table with a string name
 699 */
 700 Symbol *InstallStringConstSymbol(const char *str)
 701 {
 702     static int stringConstIndex = 0;
 703     char stringName[35];
 704     DataValue value;
 705     Symbol *sym = LookupStringConstSymbol(str);
 706     if (sym) {
 707         return sym;
 708     }
 709
 710     sprintf(stringName, "string #%d", stringConstIndex++);
 711     value.tag = STRING_TAG;
 712     AllocNStringCpy(&value.val.str, str);
 713     return(InstallSymbol(stringName, CONST_SYM, value));
 714 }
 715
 716 /*
 717 ** find a symbol in the symbol table
 718 */
 719 Symbol *LookupSymbol(const char *name)
 720 {
 721     Symbol *s;
 722
 723     for (s = LocalSymList; s != NULL; s = s->next)
 724         if (strcmp(s->name, name) == 0)
 725             return s;
 726     for (s = GlobalSymList; s != NULL; s = s->next)
 727         if (strcmp(s->name, name) == 0)
 728             return s;
 729     return NULL;
 730 }
 731
 732 /*
 733 ** install symbol name in symbol table
 734 */
 735 Symbol *InstallSymbol(const char *name, enum symTypes type, DataValue value)
 736 {
 737     Symbol *s;
 738
 739     s = (Symbol *)malloc(sizeof(Symbol));
 740     s->name = (char *)malloc(strlen(name)+1); /* +1 for '\0' */
 741     strcpy(s->name, name);
 742     s->type = type;
 743     s->value = value;
 744     if (type == LOCAL_SYM) {
 745         s->next = LocalSymList;
 746         LocalSymList = s;
 747     } else {
 748         s->next = GlobalSymList;
 749         GlobalSymList = s;
 750     }
 751     return s;
 752 }
 753
 754 /*
 755 ** Promote a symbol from local to global, removing it from the local symbol
 756 ** list.
 757 */
 758 Symbol *PromoteToGlobal(Symbol *sym)
 759 {
 760     Symbol *s;
 761     static DataValue noValue = {NO_TAG, {0}};
 762
 763     if (sym->type != LOCAL_SYM)
 764         return sym;
 765
 766     /* Remove sym from the local symbol list */
 767     if (sym == LocalSymList)
 768         LocalSymList = sym->next;
 769     else {
 770         for (s = LocalSymList; s != NULL; s = s->next) {
 771             if (s->next == sym) {
 772                 s->next = sym->next;
 773                 break;
 774             }
 775         }
 776     }
 777
 778     s = LookupSymbol(sym->name);
 779     if (s != NULL)
 780         return s;
 781     return InstallSymbol(sym->name, GLOBAL_SYM, noValue);
 782 }
 783
 784 /*
 785 ** Allocate memory for a string, and keep track of it, such that it
 786 ** can be recovered later using GarbageCollectStrings.  (A linked list
 787 ** of pointers is maintained by threading through the memory behind
 788 ** the returned pointers).  Length does not include the terminating null
 789 ** character, so to allocate space for a string of strlen == n, you must
 790 ** use AllocString(n+1).
 791 */
 792
 793 /*#define TRACK_GARBAGE_LEAKS*/
 794 #ifdef TRACK_GARBAGE_LEAKS
 795 static int numAllocatedStrings = 0;
 796 static int numAllocatedSparseArrayElements = 0;
 797 #endif
 798
 799 /* Allocate a new string buffer of length chars */
 800 char *AllocString(int length)
 801 {
 802     char *mem;
 803
 804     mem = XtMalloc(length + sizeof(char *) + 1);
 805     *((char **)mem) = AllocatedStrings;
 806     AllocatedStrings = mem;
 807 #ifdef TRACK_GARBAGE_LEAKS
 808     ++numAllocatedStrings;
 809 #endif
 810     return mem + sizeof(char *) + 1;
 811 }
 812
 813 /*
 814  * Allocate a new NString buffer of length chars (terminating \0 included),
 815  * The buffer length is initialized to length-1 and the terminating \0 is
 816  * filled in.
 817  */
 818 int AllocNString(NString *string, int length)
 819 {
 820     char *mem;
 821
 822     mem = XtMalloc(length + sizeof(char *) + 1);
 823     if (!mem) {
 824         string->rep = 0;
 825         string->len = 0;
 826         return False;
 827     }
 828
 829     *((char **)mem) = AllocatedStrings;
 830     AllocatedStrings = mem;
 831 #ifdef TRACK_GARBAGE_LEAKS
 832     ++numAllocatedStrings;
 833 #endif
 834     string->rep = mem + sizeof(char *) + 1;
 835     string->rep[length-1] = '\0';                /* forced \0 */
 836     string->len = length-1;
 837     return True;
 838 }
 839
 840 /* Allocate a new string buffer of length chars, and copy in the string s */
 841 char *AllocStringNCpy(const char *s, int length)
 842 {
 843     char *p = AllocString(length + 1);  /* add extra char for forced \0 */
 844     if (!p)
 845         return p;
 846     if (!s)
 847         s = "";
 848     p[length] = '\0';                   /* forced \0 */
 849     return strncpy(p, s, length);
 850 }
 851
 852 /*
 853  * Allocate a new NString buffer of length chars (terminating \0 NOT included),
 854  * and copy at most length characters of the given string.
 855  * The buffer length is properly set and the buffer is guaranteed to be
 856  * \0-terminated.
 857  */
 858 int AllocNStringNCpy(NString *string, const char *s, int length)
 859 {
 860     if (!AllocNString(string, length + 1)) /* add extra char for forced \0 */
 861       return False;
 862     if (!s)
 863         s = "";
 864     strncpy(string->rep, s, length);
 865     string->len = strlen(string->rep); /* re-calculate! */
 866     return True;
 867 }
 868
 869 /* Allocate a new copy of string s */
 870 char *AllocStringCpy(const char *s)
 871 {
 872     return AllocStringNCpy(s, s ? strlen(s) : 0);
 873 }
 874
 875 /*
 876  * Allocate a new NString buffer, containing a copy of the given string.
 877  * The length is set to the length of the string and resulting string is
 878  * guaranteed to be \0-terminated.
 879  */
 880 int AllocNStringCpy(NString *string, const char *s)
 881 {
 882     size_t length = s ? strlen(s) : 0;
 883     if (!AllocNString(string, length + 1))
 884         return False;
 885     if (s)
 886         strncpy(string->rep, s, length);
 887     return True;
 888 }
 889
 890 static SparseArrayEntry *allocateSparseArrayEntry(void)
 891 {
 892     SparseArrayEntryWrapper *mem;
 893
 894     mem = (SparseArrayEntryWrapper *)XtMalloc(sizeof(SparseArrayEntryWrapper));
 895     mem->next = (struct SparseArrayEntryWrapper *)AllocatedSparseArrayEntries;
 896     AllocatedSparseArrayEntries = mem;
 897 #ifdef TRACK_GARBAGE_LEAKS
 898     ++numAllocatedSparseArrayElements;
 899 #endif
 900     return(&(mem->data));
 901 }
 902
 903 static void MarkArrayContentsAsUsed(SparseArrayEntry *arrayPtr)
 904 {
 905     SparseArrayEntry *globalSEUse;
 906
 907     if (arrayPtr) {
 908         ((SparseArrayEntryWrapper *)arrayPtr)->inUse = 1;
 909         for (globalSEUse = (SparseArrayEntry *)rbTreeBegin((rbTreeNode *)arrayPtr);
 910             globalSEUse != NULL;
 911             globalSEUse = (SparseArrayEntry *)rbTreeNext((rbTreeNode *)globalSEUse)) {
 912
 913             ((SparseArrayEntryWrapper *)globalSEUse)->inUse = 1;
 914             /* test first because it may be read-only static string */
 915             if (!(*(globalSEUse->key - 1))) {
 916                 *(globalSEUse->key - 1) = 1;
 917             }
 918             if (globalSEUse->value.tag == STRING_TAG) {
 919                 /* test first because it may be read-only static string */
 920                 if (!(*(globalSEUse->value.val.str.rep - 1))) {
 921                     *(globalSEUse->value.val.str.rep - 1) = 1;
 922                 }
 923             }
 924             else if (globalSEUse->value.tag == ARRAY_TAG) {
 925                 MarkArrayContentsAsUsed((SparseArrayEntry *)globalSEUse->value.val.arrayPtr);
 926             }
 927         }
 928     }
 929 }
 930
 931 /*
 932 ** Collect strings that are no longer referenced from the global symbol
 933 ** list.  THIS CAN NOT BE RUN WHILE ANY MACROS ARE EXECUTING.  It must
 934 ** only be run after all macro activity has ceased.
 935 */
 936
 937 void GarbageCollectStrings(void)
 938 {
 939     SparseArrayEntryWrapper *nextAP, *thisAP;
 940     char *p, *next;
 941     Symbol *s;
 942
 943     /* mark all strings as unreferenced */
 944     for (p = AllocatedStrings; p != NULL; p = *((char **)p)) {
 945         *(p + sizeof(char *)) = 0;
 946     }
 947
 948     for (thisAP = AllocatedSparseArrayEntries;
 949         thisAP != NULL; thisAP = (SparseArrayEntryWrapper *)thisAP->next) {
 950         thisAP->inUse = 0;
 951     }
 952
 953     /* Sweep the global symbol list, marking which strings are still
 954        referenced */
 955     for (s = GlobalSymList; s != NULL; s = s->next) {
 956         if (s->value.tag == STRING_TAG) {
 957             /* test first because it may be read-only static string */
 958             if (!(*(s->value.val.str.rep - 1))) {
 959                 *(s->value.val.str.rep - 1) = 1;
 960             }
 961         }
 962         else if (s->value.tag == ARRAY_TAG) {
 963             MarkArrayContentsAsUsed((SparseArrayEntry *)s->value.val.arrayPtr);
 964         }
 965     }
 966
 967     /* Collect all of the strings which remain unreferenced */
 968     next = AllocatedStrings;
 969     AllocatedStrings = NULL;
 970     while (next != NULL) {
 971         p = next;
 972         next = *((char **)p);
 973         if (*(p + sizeof(char *)) != 0) {
 974             *((char **)p) = AllocatedStrings;
 975             AllocatedStrings = p;
 976         }
 977         else {
 978 #ifdef TRACK_GARBAGE_LEAKS
 979             --numAllocatedStrings;
 980 #endif
 981             XtFree(p);
 982         }
 983     }
 984
 985     nextAP = AllocatedSparseArrayEntries;
 986     AllocatedSparseArrayEntries = NULL;
 987     while (nextAP != NULL) {
 988         thisAP = nextAP;
 989         nextAP = (SparseArrayEntryWrapper *)nextAP->next;
 990         if (thisAP->inUse != 0) {
 991             thisAP->next = (struct SparseArrayEntryWrapper *)AllocatedSparseArrayEntries;
 992             AllocatedSparseArrayEntries = thisAP;
 993         }
 994         else {
 995 #ifdef TRACK_GARBAGE_LEAKS
 996             --numAllocatedSparseArrayElements;
 997 #endif
 998             XtFree((void *)thisAP);
 999         }
1000     }
1001
1002 #ifdef TRACK_GARBAGE_LEAKS
1003     printf("str count = %d\nary count = %d\n", numAllocatedStrings, numAllocatedSparseArrayElements);
1004 #endif
1005 }
1006
1007 /*
1008 ** Save and restore execution context to data structure "context"
1009 */
1010 static void saveContext(RestartData *context)
1011 {
1012     context->stack = Stack;
1013     context->stackP = StackP;
1014     context->frameP = FrameP;
1015     context->pc = PC;
1016     context->runWindow = InitiatingWindow;
1017     context->focusWindow = FocusWindow;
1018 }
1019
1020 static void restoreContext(RestartData *context)
1021 {
1022     Stack = context->stack;
1023     StackP = context->stackP;
1024     FrameP = context->frameP;
1025     PC = context->pc;
1026     InitiatingWindow = context->runWindow;
1027     FocusWindow = context->focusWindow;
1028 }
1029
1030 static void freeSymbolTable(Symbol *symTab)
1031 {
1032     Symbol *s;
1033
1034     while(symTab != NULL) {
1035         s = symTab;
1036         free(s->name);
1037         symTab = s->next;
1038         free((char *)s);
1039     }
1040 }
1041
1042 #define POP(dataVal) \
1043     if (StackP == Stack) \
1044         return execError(StackUnderflowMsg, ""); \
1045     dataVal = *--StackP;
1046
1047 #define PUSH(dataVal) \
1048     if (StackP >= &Stack[STACK_SIZE]) \
1049         return execError(StackOverflowMsg, ""); \
1050     *StackP++ = dataVal;
1051
1052 #define PEEK(dataVal, peekIndex) \
1053     dataVal = *(StackP - peekIndex - 1);
1054
1055 #define POP_INT(number) \
1056     if (StackP == Stack) \
1057         return execError(StackUnderflowMsg, ""); \
1058     --StackP; \
1059     if (StackP->tag == STRING_TAG) { \
1060         if (!StringToNum(StackP->val.str.rep, &number)) \
1061             return execError(StringToNumberMsg, ""); \
1062     } else if (StackP->tag == INT_TAG) \
1063         number = StackP->val.n; \
1064     else \
1065         return(execError("can't convert array to integer", NULL));
1066
1067 #define POP_STRING(string) \
1068     if (StackP == Stack) \
1069         return execError(StackUnderflowMsg, ""); \
1070     --StackP; \
1071     if (StackP->tag == INT_TAG) { \
1072         string = AllocString(TYPE_INT_STR_SIZE(int)); \
1073         sprintf(string, "%d", StackP->val.n); \
1074     } else if (StackP->tag == STRING_TAG) \
1075         string = StackP->val.str.rep; \
1076     else \
1077         return(execError("can't convert array to string", NULL));
1078
1079 #define PEEK_STRING(string, peekIndex) \
1080     if ((StackP - peekIndex - 1)->tag == INT_TAG) { \
1081         string = AllocString(TYPE_INT_STR_SIZE(int)); \
1082         sprintf(string, "%d", (StackP - peekIndex - 1)->val.n); \
1083     } \
1084     else if ((StackP - peekIndex - 1)->tag == STRING_TAG) { \
1085         string = (StackP - peekIndex - 1)->val.str; \
1086     } \
1087     else { \
1088         return(execError("can't convert array to string", NULL)); \
1089     }
1090
1091 #define PEEK_INT(number, peekIndex) \
1092     if ((StackP - peekIndex - 1)->tag == STRING_TAG) { \
1093         if (!StringToNum((StackP - peekIndex - 1)->val.str, &number)) { \
1094             return execError(StringToNumberMsg, ""); \
1095         } \
1096     } else if ((StackP - peekIndex - 1)->tag == INT_TAG) { \
1097         number = (StackP - peekIndex - 1)->val.n; \
1098     } \
1099     else { \
1100         return(execError("can't convert array to string", NULL)); \
1101     }
1102
1103 #define PUSH_INT(number) \
1104     if (StackP >= &Stack[STACK_SIZE]) \
1105         return execError(StackOverflowMsg, ""); \
1106     StackP->tag = INT_TAG; \
1107     StackP->val.n = number; \
1108     StackP++;
1109
1110 #define PUSH_STRING(string, length) \
1111     if (StackP >= &Stack[STACK_SIZE]) \
1112         return execError(StackOverflowMsg, ""); \
1113     StackP->tag = STRING_TAG; \
1114     StackP->val.str.rep = string; \
1115     StackP->val.str.len = length; \
1116     StackP++;
1117
1118 #define BINARY_NUMERIC_OPERATION(operator) \
1119     int n1, n2; \
1120     DISASM_RT(PC-1, 1); \
1121     STACKDUMP(2, 3); \
1122     POP_INT(n2) \
1123     POP_INT(n1) \
1124     PUSH_INT(n1 operator n2) \
1125     return STAT_OK;
1126
1127 #define UNARY_NUMERIC_OPERATION(operator) \
1128     int n; \
1129     DISASM_RT(PC-1, 1); \
1130     STACKDUMP(1, 3); \
1131     POP_INT(n) \
1132     PUSH_INT(operator n) \
1133     return STAT_OK;
1134
1135 /*
1136 ** copy a symbol's value onto the stack
1137 ** Before: Prog->  [Sym], next, ...
1138 **         Stack-> next, ...
1139 ** After:  Prog->  Sym, [next], ...
1140 **         Stack-> [SymValue], next, ...
1141 */
1142 static int pushSymVal(void)
1143 {
1144     Symbol *s;
1145     int nArgs, argNum;
1146
1147     DISASM_RT(PC-1, 2);
1148     STACKDUMP(0, 3);
1149
1150     s = (Symbol *)*PC++;
1151     if (s->type == LOCAL_SYM) {
1152         *StackP = FP_GET_SYM_VAL(FrameP, s);
1153     } else if (s->type == GLOBAL_SYM || s->type == CONST_SYM) {
1154         *StackP = s->value;
1155     } else if (s->type == ARG_SYM) {
1156         nArgs = FP_GET_ARG_COUNT(FrameP);
1157         argNum = s->value.val.n;
1158         if (argNum >= nArgs) {
1159             return execError("referenced undefined argument: %s",  s->name);
1160         }
1161         if (argNum == N_ARGS_ARG_SYM) {
1162             StackP->tag = INT_TAG;
1163             StackP->val.n = nArgs;
1164         }
1165         else {
1166             *StackP = FP_GET_ARG_N(FrameP, argNum);
1167         }
1168     } else if (s->type == PROC_VALUE_SYM) {
1169         DataValue result;
1170         char *errMsg;
1171         if (!(s->value.val.subr)(FocusWindow, NULL, 0,
1172                 &result, &errMsg)) {
1173             return execError(errMsg, s->name);
1174         }
1175         *StackP = result;
1176     } else
1177         return execError("reading non-variable: %s", s->name);
1178     if (StackP->tag == NO_TAG) {
1179         return execError("variable not set: %s", s->name);
1180     }
1181     StackP++;
1182     if (StackP >= &Stack[STACK_SIZE]) {
1183         return execError(StackOverflowMsg, "");
1184     }
1185     return STAT_OK;
1186 }
1187
1188 static int pushArgVal(void)
1189 {
1190     int nArgs, argNum;
1191
1192     DISASM_RT(PC-1, 1);
1193     STACKDUMP(1, 3);
1194
1195     POP_INT(argNum)
1196     --argNum;
1197     nArgs = FP_GET_ARG_COUNT(FrameP);
1198     if (argNum >= nArgs || argNum < 0) {
1199         char argStr[TYPE_INT_STR_SIZE(argNum)];
1200         sprintf(argStr, "%d", argNum + 1);
1201         return execError("referenced undefined argument: $args[%s]", argStr);
1202     }
1203     PUSH(FP_GET_ARG_N(FrameP, argNum));
1204     return STAT_OK;
1205 }
1206
1207 static int pushArgCount(void)
1208 {
1209     DISASM_RT(PC-1, 1);
1210     STACKDUMP(0, 3);
1211
1212     PUSH_INT(FP_GET_ARG_COUNT(FrameP));
1213     return STAT_OK;
1214 }
1215
1216 static int pushArgArray(void)
1217 {
1218     int nArgs, argNum;
1219     DataValue argVal, *resultArray;
1220
1221     DISASM_RT(PC-1, 1);
1222     STACKDUMP(0, 3);
1223
1224     nArgs = FP_GET_ARG_COUNT(FrameP);
1225     resultArray = &FP_GET_ARG_ARRAY_CACHE(FrameP);
1226     if (resultArray->tag != ARRAY_TAG) {
1227         resultArray->tag = ARRAY_TAG;
1228         resultArray->val.arrayPtr = ArrayNew();
1229
1230         for (argNum = 0; argNum < nArgs; ++argNum) {
1231             char intStr[TYPE_INT_STR_SIZE(argNum)];
1232
1233             sprintf(intStr, "%d", argNum + 1);
1234             argVal = FP_GET_ARG_N(FrameP, argNum);
1235             if (!ArrayInsert(resultArray, AllocStringCpy(intStr), &argVal)) {
1236                 return(execError("array insertion failure", NULL));
1237             }
1238         }
1239     }
1240     PUSH(*resultArray);
1241     return STAT_OK;
1242 }
1243
1244 /*
1245 ** Push an array (by reference) onto the stack
1246 ** Before: Prog->  [ArraySym], makeEmpty, next, ...
1247 **         Stack-> next, ...
1248 ** After:  Prog->  ArraySym, makeEmpty, [next], ...
1249 **         Stack-> [elemValue], next, ...
1250 ** makeEmpty is either true (1) or false (0): if true, and the element is not
1251 ** present in the array, create it.
1252 */
1253 static int pushArraySymVal(void)
1254 {
1255     Symbol *sym;
1256     DataValue *dataPtr;
1257     int initEmpty;
1258
1259     DISASM_RT(PC-1, 3);
1260     STACKDUMP(0, 3);
1261
1262     sym = (Symbol *)*PC;
1263     PC++;
1264     initEmpty = (int)*PC;
1265     PC++;
1266
1267     if (sym->type == LOCAL_SYM) {
1268         dataPtr = &FP_GET_SYM_VAL(FrameP, sym);
1269     }
1270     else if (sym->type == GLOBAL_SYM) {
1271         dataPtr = &sym->value;
1272     }
1273     else {
1274         return execError("assigning to non-lvalue array or non-array: %s", sym->name);
1275     }
1276
1277     if (initEmpty && dataPtr->tag == NO_TAG) {
1278         dataPtr->tag = ARRAY_TAG;
1279         dataPtr->val.arrayPtr = ArrayNew();
1280     }
1281
1282     if (dataPtr->tag == NO_TAG) {
1283         return execError("variable not set: %s", sym->name);
1284     }
1285
1286     *StackP = *dataPtr;
1287     StackP++;
1288
1289     if (StackP >= &Stack[STACK_SIZE]) {
1290         return execError(StackOverflowMsg, "");
1291     }
1292     return STAT_OK;
1293 }
1294
1295 /*
1296 ** assign top value to next symbol
1297 **
1298 ** Before: Prog->  [symbol], next, ...
1299 **         Stack-> [value], next, ...
1300 ** After:  Prog->  symbol, [next], ...
1301 **         Stack-> next, ...
1302 */
1303 static int assign(void)
1304 {
1305     Symbol *sym;
1306     DataValue *dataPtr;
1307
1308     DISASM_RT(PC-1, 2);
1309     STACKDUMP(1, 3);
1310
1311     sym = (Symbol *)(*PC++);
1312     if (sym->type != GLOBAL_SYM && sym->type != LOCAL_SYM) {
1313         if (sym->type == ARG_SYM) {
1314             return execError("assignment to function argument: %s",  sym->name);
1315         }
1316         else if (sym->type == PROC_VALUE_SYM) {
1317             return execError("assignment to read-only variable: %s", sym->name);
1318         }
1319         else {
1320             return execError("assignment to non-variable: %s", sym->name);
1321         }
1322     }
1323     if (StackP == Stack) {
1324         return execError(StackUnderflowMsg, "");
1325     }
1326     --StackP;
1327     if (sym->type == LOCAL_SYM) {
1328         dataPtr = &FP_GET_SYM_VAL(FrameP, sym);
1329     }
1330     else {
1331         dataPtr = &sym->value;
1332     }
1333     if (StackP->tag == ARRAY_TAG) {
1334         ArrayCopy(dataPtr, StackP);
1335     }
1336     else {
1337         *dataPtr = *StackP;
1338     }
1339     return STAT_OK;
1340 }
1341
1342 /*
1343 ** copy the top value of the stack
1344 ** Before: Stack-> value, next, ...
1345 ** After:  Stack-> value, value, next, ...
1346 */
1347 static int dupStack(void)
1348 {
1349     DISASM_RT(PC-1, 1);
1350     STACKDUMP(1, 3);
1351
1352     if (StackP >= &Stack[STACK_SIZE]) {
1353         return execError(StackOverflowMsg, "");
1354     }
1355     *StackP = *(StackP - 1);
1356     StackP++;
1357     return STAT_OK;
1358 }
1359
1360 /*
1361 ** if left and right arguments are arrays, then the result is a new array
1362 ** in which all the keys from both the right and left are copied
1363 ** the values from the right array are used in the result array when the
1364 ** keys are the same
1365 ** Before: Stack-> value2, value1, next, ...
1366 ** After:  Stack-> resValue, next, ...
1367 */
1368 static int add(void)
1369 {
1370     DataValue leftVal, rightVal, resultArray;
1371     int n1, n2;
1372
1373     DISASM_RT(PC-1, 1);
1374     STACKDUMP(2, 3);
1375
1376     PEEK(rightVal, 0)
1377     if (rightVal.tag == ARRAY_TAG) {
1378         PEEK(leftVal, 1)
1379         if (leftVal.tag == ARRAY_TAG) {
1380             SparseArrayEntry *leftIter, *rightIter;
1381             resultArray.tag = ARRAY_TAG;
1382             resultArray.val.arrayPtr = ArrayNew();
1383
1384             POP(rightVal)
1385             POP(leftVal)
1386             leftIter = arrayIterateFirst(&leftVal);
1387             rightIter = arrayIterateFirst(&rightVal);
1388             while (leftIter || rightIter) {
1389                 int insertResult = 1;
1390
1391                 if (leftIter && rightIter) {
1392                     int compareResult = arrayEntryCompare((rbTreeNode *)leftIter, (rbTreeNode *)rightIter);
1393                     if (compareResult < 0) {
1394                         insertResult = ArrayInsert(&resultArray, leftIter->key, &leftIter->value);
1395                         leftIter = arrayIterateNext(leftIter);
1396                     }
1397                     else if (compareResult > 0) {
1398                         insertResult = ArrayInsert(&resultArray, rightIter->key, &rightIter->value);
1399                         rightIter = arrayIterateNext(rightIter);
1400                     }
1401                     else {
1402                         insertResult = ArrayInsert(&resultArray, rightIter->key, &rightIter->value);
1403                         leftIter = arrayIterateNext(leftIter);
1404                         rightIter = arrayIterateNext(rightIter);
1405                     }
1406                 }
1407                 else if (leftIter) {
1408                     insertResult = ArrayInsert(&resultArray, leftIter->key, &leftIter->value);
1409                     leftIter = arrayIterateNext(leftIter);
1410                 }
1411                 else {
1412                     insertResult = ArrayInsert(&resultArray, rightIter->key, &rightIter->value);
1413                     rightIter = arrayIterateNext(rightIter);
1414                 }
1415                 if (!insertResult) {
1416                     return(execError("array insertion failure", NULL));
1417                 }
1418             }
1419             PUSH(resultArray)
1420         }
1421         else {
1422             return(execError("can't mix math with arrays and non-arrays", NULL));
1423         }
1424     }
1425     else {
1426         POP_INT(n2)
1427         POP_INT(n1)
1428         PUSH_INT(n1 + n2)
1429     }
1430     return(STAT_OK);
1431 }
1432
1433 /*
1434 ** if left and right arguments are arrays, then the result is a new array
1435 ** in which only the keys which exist in the left array but not in the right
1436 ** are copied
1437 ** Before: Stack-> value2, value1, next, ...
1438 ** After:  Stack-> resValue, next, ...
1439 */
1440 static int subtract(void)
1441 {
1442     DataValue leftVal, rightVal, resultArray;
1443     int n1, n2;
1444
1445     DISASM_RT(PC-1, 1);
1446     STACKDUMP(2, 3);
1447
1448     PEEK(rightVal, 0)
1449     if (rightVal.tag == ARRAY_TAG) {
1450         PEEK(leftVal, 1)
1451         if (leftVal.tag == ARRAY_TAG) {
1452             SparseArrayEntry *leftIter, *rightIter;
1453             resultArray.tag = ARRAY_TAG;
1454             resultArray.val.arrayPtr = ArrayNew();
1455
1456             POP(rightVal)
1457             POP(leftVal)
1458             leftIter = arrayIterateFirst(&leftVal);
1459             rightIter = arrayIterateFirst(&rightVal);
1460             while (leftIter) {
1461                 int insertResult = 1;
1462
1463                 if (leftIter && rightIter) {
1464                     int compareResult = arrayEntryCompare((rbTreeNode *)leftIter, (rbTreeNode *)rightIter);
1465                     if (compareResult < 0) {
1466                         insertResult = ArrayInsert(&resultArray, leftIter->key, &leftIter->value);
1467                         leftIter = arrayIterateNext(leftIter);
1468                     }
1469                     else if (compareResult > 0) {
1470                         rightIter = arrayIterateNext(rightIter);
1471                     }
1472                     else {
1473                         leftIter = arrayIterateNext(leftIter);
1474                         rightIter = arrayIterateNext(rightIter);
1475                     }
1476                 }
1477                 else if (leftIter) {
1478                     insertResult = ArrayInsert(&resultArray, leftIter->key, &leftIter->value);
1479                     leftIter = arrayIterateNext(leftIter);
1480                 }
1481                 if (!insertResult) {
1482                     return(execError("array insertion failure", NULL));
1483                 }
1484             }
1485             PUSH(resultArray)
1486         }
1487         else {
1488             return(execError("can't mix math with arrays and non-arrays", NULL));
1489         }
1490     }
1491     else {
1492         POP_INT(n2)
1493         POP_INT(n1)
1494         PUSH_INT(n1 - n2)
1495     }
1496     return(STAT_OK);
1497 }
1498
1499 /*
1500 ** Other binary operators
1501 ** Before: Stack-> value2, value1, next, ...
1502 ** After:  Stack-> resValue, next, ...
1503 **
1504 ** Other unary operators
1505 ** Before: Stack-> value, next, ...
1506 ** After:  Stack-> resValue, next, ...
1507 */
1508 static int multiply(void)
1509 {
1510     BINARY_NUMERIC_OPERATION(*)
1511 }
1512
1513 static int divide(void)
1514 {
1515     int n1, n2;
1516
1517     DISASM_RT(PC-1, 1);
1518     STACKDUMP(2, 3);
1519
1520     POP_INT(n2)
1521     POP_INT(n1)
1522     if (n2 == 0) {
1523         return execError("division by zero", "");
1524     }
1525     PUSH_INT(n1 / n2)
1526     return STAT_OK;
1527 }
1528
1529 static int modulo(void)
1530 {
1531     int n1, n2;
1532
1533     DISASM_RT(PC-1, 1);
1534     STACKDUMP(2, 3);
1535
1536     POP_INT(n2)
1537     POP_INT(n1)
1538     if (n2 == 0) {
1539         return execError("modulo by zero", "");
1540     }
1541     PUSH_INT(n1 % n2)
1542     return STAT_OK;
1543 }
1544
1545 static int negate(void)
1546 {
1547     UNARY_NUMERIC_OPERATION(-)
1548 }
1549
1550 static int increment(void)
1551 {
1552     UNARY_NUMERIC_OPERATION(++)
1553 }
1554
1555 static int decrement(void)
1556 {
1557     UNARY_NUMERIC_OPERATION(--)
1558 }
1559
1560 static int gt(void)
1561 {
1562     BINARY_NUMERIC_OPERATION(>)
1563 }
1564
1565 static int lt(void)
1566 {
1567     BINARY_NUMERIC_OPERATION(<)
1568 }
1569
1570 static int ge(void)
1571 {
1572     BINARY_NUMERIC_OPERATION(>=)
1573 }
1574
1575 static int le(void)
1576 {
1577     BINARY_NUMERIC_OPERATION(<=)
1578 }
1579
1580 /*
1581 ** verify that compares are between integers and/or strings only
1582 ** Before: Stack-> value1, value2, next, ...
1583 ** After:  Stack-> resValue, next, ...
1584 ** where resValue is 1 for true, 0 for false
1585 */
1586 static int eq(void)
1587 {
1588     DataValue v1, v2;
1589
1590     DISASM_RT(PC-1, 1);
1591     STACKDUMP(2, 3);
1592
1593     POP(v1)
1594     POP(v2)
1595     if (v1.tag == INT_TAG && v2.tag == INT_TAG) {
1596         v1.val.n = v1.val.n == v2.val.n;
1597     }
1598     else if (v1.tag == STRING_TAG && v2.tag == STRING_TAG) {
1599         v1.val.n = !strcmp(v1.val.str.rep, v2.val.str.rep);
1600     }
1601     else if (v1.tag == STRING_TAG && v2.tag == INT_TAG) {
1602         int number;
1603         if (!StringToNum(v1.val.str.rep, &number)) {
1604             v1.val.n = 0;
1605         }
1606         else {
1607             v1.val.n = number == v2.val.n;
1608         }
1609     }
1610     else if (v2.tag == STRING_TAG && v1.tag == INT_TAG) {
1611         int number;
1612         if (!StringToNum(v2.val.str.rep, &number)) {
1613             v1.val.n = 0;
1614         }
1615         else {
1616             v1.val.n = number == v1.val.n;
1617         }
1618     }
1619     else {
1620         return(execError("incompatible types to compare", NULL));
1621     }
1622     v1.tag = INT_TAG;
1623     PUSH(v1)
1624     return(STAT_OK);
1625 }
1626
1627 /* negated eq() call */
1628 static int ne(void)
1629 {
1630     eq();
1631     return not();
1632 }
1633
1634 /*
1635 ** if left and right arguments are arrays, then the result is a new array
1636 ** in which only the keys which exist in both the right or left are copied
1637 ** the values from the right array are used in the result array
1638 ** Before: Stack-> value2, value1, next, ...
1639 ** After:  Stack-> resValue, next, ...
1640 */
1641 static int bitAnd(void)
1642 {
1643     DataValue leftVal, rightVal, resultArray;
1644     int n1, n2;
1645
1646     DISASM_RT(PC-1, 1);
1647     STACKDUMP(2, 3);
1648
1649     PEEK(rightVal, 0)
1650     if (rightVal.tag == ARRAY_TAG) {
1651         PEEK(leftVal, 1)
1652         if (leftVal.tag == ARRAY_TAG) {
1653             SparseArrayEntry *leftIter, *rightIter;
1654             resultArray.tag = ARRAY_TAG;
1655             resultArray.val.arrayPtr = ArrayNew();
1656
1657             POP(rightVal)
1658             POP(leftVal)
1659             leftIter = arrayIterateFirst(&leftVal);
1660             rightIter = arrayIterateFirst(&rightVal);
1661             while (leftIter && rightIter) {
1662                 int insertResult = 1;
1663                 int compareResult = arrayEntryCompare((rbTreeNode *)leftIter, (rbTreeNode *)rightIter);
1664
1665                 if (compareResult < 0) {
1666                     leftIter = arrayIterateNext(leftIter);
1667                 }
1668                 else if (compareResult > 0) {
1669                     rightIter = arrayIterateNext(rightIter);
1670                 }
1671                 else {
1672                     insertResult = ArrayInsert(&resultArray, rightIter->key, &rightIter->value);
1673                     leftIter = arrayIterateNext(leftIter);
1674                     rightIter = arrayIterateNext(rightIter);
1675                 }
1676                 if (!insertResult) {
1677                     return(execError("array insertion failure", NULL));
1678                 }
1679             }
1680             PUSH(resultArray)
1681         }
1682         else {
1683             return(execError("can't mix math with arrays and non-arrays", NULL));
1684         }
1685     }
1686     else {
1687         POP_INT(n2)
1688         POP_INT(n1)
1689         PUSH_INT(n1 & n2)
1690     }
1691     return(STAT_OK);
1692 }
1693
1694 /*
1695 ** if left and right arguments are arrays, then the result is a new array
1696 ** in which only the keys which exist in either the right or left but not both
1697 ** are copied
1698 ** Before: Stack-> value2, value1, next, ...
1699 ** After:  Stack-> resValue, next, ...
1700 */
1701 static int bitOr(void)
1702 {
1703     DataValue leftVal, rightVal, resultArray;
1704     int n1, n2;
1705
1706     DISASM_RT(PC-1, 1);
1707     STACKDUMP(2, 3);
1708
1709     PEEK(rightVal, 0)
1710     if (rightVal.tag == ARRAY_TAG) {
1711         PEEK(leftVal, 1)
1712         if (leftVal.tag == ARRAY_TAG) {
1713             SparseArrayEntry *leftIter, *rightIter;
1714             resultArray.tag = ARRAY_TAG;
1715             resultArray.val.arrayPtr = ArrayNew();
1716
1717             POP(rightVal)
1718             POP(leftVal)
1719             leftIter = arrayIterateFirst(&leftVal);
1720             rightIter = arrayIterateFirst(&rightVal);
1721             while (leftIter || rightIter) {
1722                 int insertResult = 1;
1723
1724                 if (leftIter && rightIter) {
1725                     int compareResult = arrayEntryCompare((rbTreeNode *)leftIter, (rbTreeNode *)rightIter);
1726                     if (compareResult < 0) {
1727                         insertResult = ArrayInsert(&resultArray, leftIter->key, &leftIter->value);
1728                         leftIter = arrayIterateNext(leftIter);
1729                     }
1730                     else if (compareResult > 0) {
1731                         insertResult = ArrayInsert(&resultArray, rightIter->key, &rightIter->value);
1732                         rightIter = arrayIterateNext(rightIter);
1733                     }
1734                     else {
1735                         leftIter = arrayIterateNext(leftIter);
1736                         rightIter = arrayIterateNext(rightIter);
1737                     }
1738                 }
1739                 else if (leftIter) {
1740                     insertResult = ArrayInsert(&resultArray, leftIter->key, &leftIter->value);
1741                     leftIter = arrayIterateNext(leftIter);
1742                 }
1743                 else {
1744                     insertResult = ArrayInsert(&resultArray, rightIter->key, &rightIter->value);
1745                     rightIter = arrayIterateNext(rightIter);
1746                 }
1747                 if (!insertResult) {
1748                     return(execError("array insertion failure", NULL));
1749                 }
1750             }
1751             PUSH(resultArray)
1752         }
1753         else {
1754             return(execError("can't mix math with arrays and non-arrays", NULL));
1755         }
1756     }
1757     else {
1758         POP_INT(n2)
1759         POP_INT(n1)
1760         PUSH_INT(n1 | n2)
1761     }
1762     return(STAT_OK);
1763 }
1764
1765 static int and(void)
1766 {
1767     BINARY_NUMERIC_OPERATION(&&)
1768 }
1769
1770 static int or(void)
1771 {
1772     BINARY_NUMERIC_OPERATION(||)
1773 }
1774
1775 static int not(void)
1776 {
1777     UNARY_NUMERIC_OPERATION(!)
1778 }
1779
1780 /*
1781 ** raise one number to the power of another
1782 ** Before: Stack-> raisedBy, number, next, ...
1783 ** After:  Stack-> result, next, ...
1784 */
1785 static int power(void)
1786 {
1787     int n1, n2, n3;
1788
1789     DISASM_RT(PC-1, 1);
1790     STACKDUMP(2, 3);
1791
1792     POP_INT(n2)
1793     POP_INT(n1)
1794     /*  We need to round to deal with pow() giving results slightly above
1795         or below the real result since it deals with floating point numbers.
1796         Note: We're not really wanting rounded results, we merely
1797         want to deal with this simple issue. So, 2^-2 = .5, but we
1798         don't want to round this to 1. This is mainly intended to deal with
1799         4^2 = 15.999996 and 16.000001.
1800     */
1801     if (n2 < 0 && n1 != 1 && n1 != -1) {
1802         if (n1 != 0) {
1803             /* since we're integer only, nearly all negative exponents result in 0 */
1804             n3 = 0;
1805         }
1806         else {
1807             /* allow error to occur */
1808             n3 = (int)pow((double)n1, (double)n2);
1809         }
1810     }
1811     else {
1812         if ((n1 < 0) && (n2 & 1)) {
1813             /* round to nearest integer for negative values*/
1814             n3 = (int)(pow((double)n1, (double)n2) - (double)0.5);
1815         }
1816         else {
1817             /* round to nearest integer for positive values*/
1818             n3 = (int)(pow((double)n1, (double)n2) + (double)0.5);
1819         }
1820     }
1821     PUSH_INT(n3)
1822     return errCheck("exponentiation");
1823 }
1824
1825 /*
1826 ** concatenate two top items on the stack
1827 ** Before: Stack-> str2, str1, next, ...
1828 ** After:  Stack-> result, next, ...
1829 */
1830 static int concat(void)
1831 {
1832     char *s1, *s2, *out;
1833     int len1, len2;
1834
1835     DISASM_RT(PC-1, 1);
1836     STACKDUMP(2, 3);
1837
1838     POP_STRING(s2)
1839     POP_STRING(s1)
1840     len1 = strlen(s1);
1841     len2 = strlen(s2);
1842     out = AllocString(len1 + len2 + 1);
1843     strncpy(out, s1, len1);
1844     strcpy(&out[len1], s2);
1845     PUSH_STRING(out, len1 + len2)
1846     return STAT_OK;
1847 }
1848
1849 /*
1850 ** Call a subroutine or function (user defined or built-in).  Args are the
1851 ** subroutine's symbol, and the number of arguments which have been pushed
1852 ** on the stack.
1853 **
1854 ** For a macro subroutine, the return address, frame pointer, number of
1855 ** arguments and space for local variables are added to the stack, and the
1856 ** PC is set to point to the new function. For a built-in routine, the
1857 ** arguments are popped off the stack, and the routine is just called.
1858 **
1859 ** Before: Prog->  [subrSym], nArgs, next, ...
1860 **         Stack-> argN-arg1, next, ...
1861 ** After:  Prog->  next, ...            -- (built-in called subr)
1862 **         Stack-> retVal?, next, ...
1863 **    or:  Prog->  (in called)next, ... -- (macro code called subr)
1864 **         Stack-> symN-sym1(FP), argArray, nArgs, oldFP, retPC, argN-arg1, next, ...
1865 */
1866 static int callSubroutine(void)
1867 {
1868     Symbol *sym, *s;
1869     int i, nArgs;
1870     static DataValue noValue = {NO_TAG, {0}};
1871     Program *prog;
1872     char *errMsg;
1873
1874     sym = (Symbol *)*PC++;
1875     nArgs = (int)*PC++;
1876
1877     DISASM_RT(PC-3, 3);
1878     STACKDUMP(nArgs, 3);
1879
1880     /*
1881     ** If the subroutine is built-in, call the built-in routine
1882     */
1883     if (sym->type == C_FUNCTION_SYM) {
1884         DataValue result;
1885
1886         /* "pop" stack back to the first argument in the call stack */
1887         StackP -= nArgs;
1888
1889         /* Call the function and check for preemption */
1890         PreemptRequest = False;
1891         if (!sym->value.val.subr(FocusWindow, StackP,
1892                 nArgs, &result, &errMsg))
1893             return execError(errMsg, sym->name);
1894         if (*PC == fetchRetVal) {
1895             if (result.tag == NO_TAG) {
1896                 return execError("%s does not return a value", sym->name);
1897             }
1898             PUSH(result);
1899             PC++;
1900         }
1901         return PreemptRequest ? STAT_PREEMPT : STAT_OK;
1902     }
1903
1904     /*
1905     ** Call a macro subroutine:
1906     **
1907     ** Push all of the required information to resume, and make space on the
1908     ** stack for local variables (and initialize them), on top of the argument
1909     ** values which are already there.
1910     */
1911     if (sym->type == MACRO_FUNCTION_SYM) {
1912         StackP->tag = NO_TAG; /* return PC */
1913         StackP->val.inst = PC;
1914         StackP++;
1915
1916         StackP->tag = NO_TAG; /* old FrameP */
1917         StackP->val.dataval = FrameP;
1918         StackP++;
1919
1920         StackP->tag = NO_TAG; /* nArgs */
1921         StackP->val.n = nArgs;
1922         StackP++;
1923
1924         *(StackP++) = noValue; /* cached arg array */
1925
1926         FrameP = StackP;
1927         prog = (Program *)sym->value.val.str.rep;
1928         PC = prog->code;
1929         for (s = prog->localSymList; s != NULL; s = s->next) {
1930             FP_GET_SYM_VAL(FrameP, s) = noValue;
1931             StackP++;
1932         }
1933         return STAT_OK;
1934     }
1935
1936     /*
1937     ** Call an action routine
1938     */
1939     if (sym->type == ACTION_ROUTINE_SYM) {
1940         String argList[MAX_ARGS];
1941         Cardinal numArgs = nArgs;
1942         XKeyEvent key_event;
1943         Display *disp;
1944         Window win;
1945
1946         /* Create a fake event with a timestamp suitable for actions which need
1947            timestamps, a marker to indicate that the call was from a macro
1948            (to stop shell commands from putting up their own separate banner) */
1949         disp=XtDisplay(InitiatingWindow->shell);
1950         win=XtWindow(InitiatingWindow->shell);
1951
1952         key_event.type = KeyPress;
1953         key_event.send_event = MACRO_EVENT_MARKER;
1954         key_event.time=XtLastTimestampProcessed(XtDisplay(InitiatingWindow->shell));
1955
1956         /* The following entries are just filled in to avoid problems
1957            in strange cases, like calling "self_insert()" directly from the
1958            macro menu. In fact the display was sufficient to cure this crash. */
1959         key_event.display=disp;
1960         key_event.window=key_event.root=key_event.subwindow=win;
1961
1962         /* pop arguments off the stack and put them in the argument list */
1963         for (i=nArgs-1; i>=0; i--) {
1964             POP_STRING(argList[i])
1965         }
1966
1967         /* Call the action routine and check for preemption */
1968         PreemptRequest = False;
1969         sym->value.val.xtproc(FocusWindow->lastFocus,
1970                 (XEvent *)&key_event, argList, &numArgs);
1971         if (*PC == fetchRetVal) {
1972             return execError("%s does not return a value", sym->name);
1973         }
1974         return PreemptRequest ? STAT_PREEMPT : STAT_OK;
1975     }
1976
1977     /* Calling a non subroutine symbol */
1978     return execError("%s is not a function or subroutine", sym->name);
1979 }
1980
1981 /*
1982 ** This should never be executed, returnVal checks for the presence of this
1983 ** instruction at the PC to decide whether to push the function's return
1984 ** value, then skips over it without executing.
1985 */
1986 static int fetchRetVal(void)
1987 {
1988     return execError("internal error: frv", NULL);
1989 }
1990
1991 /* see comments for returnValOrNone() */
1992 static int returnNoVal(void)
1993 {
1994     return returnValOrNone(False);
1995 }
1996 static int returnVal(void)
1997 {
1998     return returnValOrNone(True);
1999 }
2000
2001 /*
2002 ** Return from a subroutine call
2003 ** Before: Prog->  [next], ...
2004 **         Stack-> retVal?, ...(FP), argArray, nArgs, oldFP, retPC, argN-arg1, next, ...
2005 ** After:  Prog->  next, ..., (in caller)[FETCH_RET_VAL?], ...
2006 **         Stack-> retVal?, next, ...
2007 */
2008 static int returnValOrNone(int valOnStack)
2009 {
2010     DataValue retVal;
2011     static DataValue noValue = {NO_TAG, {0}};
2012     DataValue *newFrameP;
2013     int nArgs;
2014
2015     DISASM_RT(PC-1, 1);
2016     STACKDUMP(StackP - FrameP + FP_GET_ARG_COUNT(FrameP) + FP_TO_ARGS_DIST, 3);
2017
2018     /* return value is on the stack */
2019     if (valOnStack) {
2020         POP(retVal);
2021     }
2022
2023     /* get stored return information */
2024     nArgs = FP_GET_ARG_COUNT(FrameP);
2025     newFrameP = FP_GET_OLD_FP(FrameP);
2026     PC = FP_GET_RET_PC(FrameP);
2027
2028     /* pop past local variables */
2029     StackP = FrameP;
2030     /* pop past function arguments */
2031     StackP -= (FP_TO_ARGS_DIST + nArgs);
2032     FrameP = newFrameP;
2033
2034     /* push returned value, if requsted */
2035     if (PC == NULL) {
2036         if (valOnStack) {
2037             PUSH(retVal);
2038         } else {
2039             PUSH(noValue);
2040         }
2041     } else if (*PC == fetchRetVal) {
2042         if (valOnStack) {
2043             PUSH(retVal);
2044             PC++;
2045         } else {
2046             return execError(
2047                 "using return value of %s which does not return a value",
2048                 ((Symbol *)*(PC - 2))->name);
2049         }
2050     }
2051
2052     /* NULL return PC indicates end of program */
2053     return PC == NULL ? STAT_DONE : STAT_OK;
2054 }
2055
2056 /*
2057 ** Unconditional branch offset by immediate operand
2058 **
2059 ** Before: Prog->  [branchDest], next, ..., (branchdest)next
2060 ** After:  Prog->  branchDest, next, ..., (branchdest)[next]
2061 */
2062 static int branch(void)
2063 {
2064     DISASM_RT(PC-1, 2);
2065     STACKDUMP(0, 3);
2066
2067     PC += (int)*PC;
2068     return STAT_OK;
2069 }
2070
2071 /*
2072 ** Conditional branches if stack value is True/False (non-zero/0) to address
2073 ** of immediate operand (pops stack)
2074 **
2075 ** Before: Prog->  [branchDest], next, ..., (branchdest)next
2076 ** After:  either: Prog->  branchDest, [next], ...
2077 ** After:  or:     Prog->  branchDest, next, ..., (branchdest)[next]
2078 */
2079 static int branchTrue(void)
2080 {
2081     int value;
2082     Inst *addr;
2083
2084     DISASM_RT(PC-1, 2);
2085     STACKDUMP(1, 3);
2086
2087     POP_INT(value)
2088     addr = PC + (int)*PC;
2089     PC++;
2090
2091     if (value)
2092         PC = addr;
2093     return STAT_OK;
2094 }
2095 static int branchFalse(void)
2096 {
2097     int value;
2098     Inst *addr;
2099
2100     DISASM_RT(PC-1, 2);
2101     STACKDUMP(1, 3);
2102
2103     POP_INT(value)
2104     addr = PC + (int)*PC;
2105     PC++;
2106
2107     if (!value)
2108         PC = addr;
2109     return STAT_OK;
2110 }
2111
2112 /*
2113 ** Ignore the address following the instruction and continue.  Why? So
2114 ** some code that uses conditional branching doesn't have to figure out
2115 ** whether to store a branch address.
2116 **
2117 ** Before: Prog->  [branchDest], next, ...
2118 ** After:  Prog->  branchDest, [next], ...
2119 */
2120 static int branchNever(void)
2121 {
2122     DISASM_RT(PC-1, 2);
2123     STACKDUMP(0, 3);
2124
2125     PC++;
2126     return STAT_OK;
2127 }
2128
2129 /*
2130 ** recursively copy(duplicate) the sparse array nodes of an array
2131 ** this does not duplicate the key/node data since they are never
2132 ** modified, only replaced
2133 */
2134 int ArrayCopy(DataValue *dstArray, DataValue *srcArray)
2135 {
2136     SparseArrayEntry *srcIter;
2137
2138     dstArray->tag = ARRAY_TAG;
2139     dstArray->val.arrayPtr = ArrayNew();
2140
2141     srcIter = arrayIterateFirst(srcArray);
2142     while (srcIter) {
2143         if (srcIter->value.tag == ARRAY_TAG) {
2144             int errNum;
2145             DataValue tmpArray;
2146
2147             errNum = ArrayCopy(&tmpArray, &srcIter->value);
2148             if (errNum != STAT_OK) {
2149                 return(errNum);
2150             }
2151             if (!ArrayInsert(dstArray, srcIter->key, &tmpArray)) {
2152                 return(execError("array copy failed", NULL));
2153             }
2154         }
2155         else {
2156             if (!ArrayInsert(dstArray, srcIter->key, &srcIter->value)) {
2157                 return(execError("array copy failed", NULL));
2158             }
2159         }
2160         srcIter = arrayIterateNext(srcIter);
2161     }
2162     return(STAT_OK);
2163 }
2164
2165 /*
2166 ** creates an allocated string of a single key for all the sub-scripts
2167 ** using ARRAY_DIM_SEP as a separator
2168 ** this function uses the PEEK macros in order to remove most limits on
2169 ** the number of arguments to an array
2170 ** I really need to optimize the size approximation rather than assuming
2171 ** a worst case size for every integer argument
2172 */
2173 static int makeArrayKeyFromArgs(int nArgs, char **keyString, int leaveParams)
2174 {
2175     DataValue tmpVal;
2176     int sepLen = strlen(ARRAY_DIM_SEP);
2177     int keyLength = 0;
2178     int i;
2179
2180     keyLength = sepLen * (nArgs - 1);
2181     for (i = nArgs - 1; i >= 0; --i) {
2182         PEEK(tmpVal, i)
2183         if (tmpVal.tag == INT_TAG) {
2184             keyLength += TYPE_INT_STR_SIZE(tmpVal.val.n);
2185         }
2186         else if (tmpVal.tag == STRING_TAG) {
2187             keyLength += tmpVal.val.str.len;
2188         }
2189         else {
2190             return(execError("can only index array with string or int.", NULL));
2191         }
2192     }
2193     *keyString = AllocString(keyLength + 1);
2194     (*keyString)[0] = 0;
2195     for (i = nArgs - 1; i >= 0; --i) {
2196         if (i != nArgs - 1) {
2197             strcat(*keyString, ARRAY_DIM_SEP);
2198         }
2199         PEEK(tmpVal, i)
2200         if (tmpVal.tag == INT_TAG) {
2201             sprintf(&((*keyString)[strlen(*keyString)]), "%d", tmpVal.val.n);
2202         }
2203         else if (tmpVal.tag == STRING_TAG) {
2204             strcat(*keyString, tmpVal.val.str.rep);
2205         }
2206         else {
2207             return(execError("can only index array with string or int.", NULL));
2208         }
2209     }
2210     if (!leaveParams) {
2211         for (i = nArgs - 1; i >= 0; --i) {
2212             POP(tmpVal)
2213         }
2214     }
2215     return(STAT_OK);
2216 }
2217
2218 /*
2219 ** allocate an empty array node, this is used as the root node and never
2220 ** contains any data, only refernces to other nodes
2221 */
2222 static rbTreeNode *arrayEmptyAllocator(void)
2223 {
2224     SparseArrayEntry *newNode = allocateSparseArrayEntry();
2225     if (newNode) {
2226         newNode->key = NULL;
2227         newNode->value.tag = NO_TAG;
2228     }
2229     return((rbTreeNode *)newNode);
2230 }
2231
2232 /*
2233 ** create and copy array node and copy contents, we merely copy pointers
2234 ** since they are never modified, only replaced
2235 */
2236 static rbTreeNode *arrayAllocateNode(rbTreeNode *src)
2237 {
2238     SparseArrayEntry *newNode = allocateSparseArrayEntry();
2239     if (newNode) {
2240         newNode->key = ((SparseArrayEntry *)src)->key;
2241         newNode->value = ((SparseArrayEntry *)src)->value;
2242     }
2243     return((rbTreeNode *)newNode);
2244 }
2245
2246 /*
2247 ** copy array node data, we merely copy pointers since they are never
2248 ** modified, only replaced
2249 */
2250 static int arrayEntryCopyToNode(rbTreeNode *dst, rbTreeNode *src)
2251 {
2252     ((SparseArrayEntry *)dst)->key = ((SparseArrayEntry *)src)->key;
2253     ((SparseArrayEntry *)dst)->value = ((SparseArrayEntry *)src)->value;
2254     return(1);
2255 }
2256
2257 /*
2258 ** compare two array nodes returning an integer value similar to strcmp()
2259 */
2260 static int arrayEntryCompare(rbTreeNode *left, rbTreeNode *right)
2261 {
2262     return(strcmp(((SparseArrayEntry *)left)->key, ((SparseArrayEntry *)right)->key));
2263 }
2264
2265 /*
2266 ** dispose an array node, garbage collection handles this, so we mark it
2267 ** to allow iterators in macro language to determine they have been unlinked
2268 */
2269 static void arrayDisposeNode(rbTreeNode *src)
2270 {
2271     /* Let garbage collection handle this but mark it so iterators can tell */
2272     src->left = NULL;
2273     src->right = NULL;
2274     src->parent = NULL;
2275     src->color = -1;
2276 }
2277
2278 struct SparseArrayEntry *ArrayNew(void)
2279 {
2280         return((struct SparseArrayEntry *)rbTreeNew(arrayEmptyAllocator));
2281 }
2282
2283 /*
2284 ** insert a DataValue into an array, allocate the array if needed
2285 ** keyStr must be a string that was allocated with AllocString()
2286 */
2287 int ArrayInsert(DataValue *theArray, char *keyStr, DataValue *theValue)
2288 {
2289     SparseArrayEntry tmpEntry;
2290     rbTreeNode *insertedNode;
2291
2292     tmpEntry.key = keyStr;
2293     tmpEntry.value = *theValue;
2294
2295     if (theArray->val.arrayPtr == NULL) {
2296         theArray->val.arrayPtr = ArrayNew();
2297     }
2298     if (theArray->val.arrayPtr != NULL) {
2299         insertedNode = rbTreeInsert((rbTreeNode *)(theArray->val.arrayPtr),
2300             (rbTreeNode *)&tmpEntry,
2301             arrayEntryCompare, arrayAllocateNode, arrayEntryCopyToNode);
2302         if (insertedNode) {
2303             return(1);
2304         }
2305         else {
2306             return(0);
2307         }
2308     }
2309     return(0);
2310 }
2311
2312 /*
2313 ** remove a node from an array whose key matches keyStr
2314 */
2315 void ArrayDelete(DataValue *theArray, char *keyStr)
2316 {
2317     SparseArrayEntry searchEntry;
2318
2319     if (theArray->val.arrayPtr) {
2320         searchEntry.key = keyStr;
2321         rbTreeDelete((rbTreeNode *)theArray->val.arrayPtr, (rbTreeNode *)&searchEntry,
2322                     arrayEntryCompare, arrayDisposeNode);
2323     }
2324 }
2325
2326 /*
2327 ** remove all nodes from an array
2328 */
2329 void ArrayDeleteAll(DataValue *theArray)
2330 {
2331
2332     if (theArray->val.arrayPtr) {
2333         rbTreeNode *iter = rbTreeBegin((rbTreeNode *)theArray->val.arrayPtr);
2334         while (iter) {
2335             rbTreeNode *nextIter = rbTreeNext(iter);
2336             rbTreeDeleteNode((rbTreeNode *)theArray->val.arrayPtr,
2337                         iter, arrayDisposeNode);
2338
2339             iter = nextIter;
2340         }
2341     }
2342 }
2343
2344 /*
2345 ** returns the number of elements (nodes containing values) of an array
2346 */
2347 int ArraySize(DataValue *theArray)
2348 {
2349     if (theArray->val.arrayPtr) {
2350         return(rbTreeSize((rbTreeNode *)theArray->val.arrayPtr));
2351     }
2352     else {
2353         return(0);
2354     }
2355 }
2356
2357 /*
2358 ** retrieves an array node whose key matches
2359 ** returns 1 for success 0 for not found
2360 */
2361 int ArrayGet(DataValue *theArray, char *keyStr, DataValue *theValue)
2362 {
2363     SparseArrayEntry searchEntry;
2364     rbTreeNode *foundNode;
2365
2366     if (theArray->val.arrayPtr) {
2367         searchEntry.key = keyStr;
2368         foundNode = rbTreeFind((rbTreeNode *)theArray->val.arrayPtr,
2369                 (rbTreeNode *)&searchEntry, arrayEntryCompare);
2370         if (foundNode) {
2371             *theValue = ((SparseArrayEntry *)foundNode)->value;
2372             return(1);
2373         }
2374     }
2375     return(0);
2376 }
2377
2378 /*
2379 ** get pointer to start iterating an array
2380 */
2381 SparseArrayEntry *arrayIterateFirst(DataValue *theArray)
2382 {
2383     SparseArrayEntry *startPos;
2384     if (theArray->val.arrayPtr) {
2385         startPos = (SparseArrayEntry *)rbTreeBegin((rbTreeNode *)theArray->val.arrayPtr);
2386     }
2387     else {
2388         startPos = NULL;
2389     }
2390     return(startPos);
2391 }
2392
2393 /*
2394 ** move iterator to next entry in array
2395 */
2396 SparseArrayEntry *arrayIterateNext(SparseArrayEntry *iterator)
2397 {
2398     SparseArrayEntry *nextPos;
2399     if (iterator) {
2400         nextPos = (SparseArrayEntry *)rbTreeNext((rbTreeNode *)iterator);
2401     }
2402     else {
2403         nextPos = NULL;
2404     }
2405     return(nextPos);
2406 }
2407
2408 /*
2409 ** evaluate an array element and push the result onto the stack
2410 **
2411 ** Before: Prog->  [nDim], next, ...
2412 **         Stack-> indnDim, ... ind1, ArraySym, next, ...
2413 ** After:  Prog->  nDim, [next], ...
2414 **         Stack-> indexedArrayVal, next, ...
2415 */
2416 static int arrayRef(void)
2417 {
2418     int errNum;
2419     DataValue srcArray, valueItem;
2420     char *keyString = NULL;
2421     int nDim;
2422
2423     nDim = (int)*PC;
2424     PC++;
2425
2426     DISASM_RT(PC-2, 2);
2427     STACKDUMP(nDim, 3);
2428
2429     if (nDim > 0) {
2430         errNum = makeArrayKeyFromArgs(nDim, &keyString, 0);
2431         if (errNum != STAT_OK) {
2432             return(errNum);
2433         }
2434
2435         POP(srcArray)
2436         if (srcArray.tag == ARRAY_TAG) {
2437             if (!ArrayGet(&srcArray, keyString, &valueItem)) {
2438                 return(execError("referenced array value not in array: %s", keyString));
2439             }
2440             PUSH(valueItem)
2441             return(STAT_OK);
2442         }
2443         else {
2444             return(execError("operator [] on non-array", NULL));
2445         }
2446     }
2447     else {
2448         POP(srcArray)
2449         if (srcArray.tag == ARRAY_TAG) {
2450             PUSH_INT(ArraySize(&srcArray))
2451             return(STAT_OK);
2452         }
2453         else {
2454             return(execError("operator [] on non-array", NULL));
2455         }
2456     }
2457 }
2458
2459 /*
2460 ** assign to an array element of a referenced array on the stack
2461 **
2462 ** Before: Prog->  [nDim], next, ...
2463 **         Stack-> rhs, indnDim, ... ind1, ArraySym, next, ...
2464 ** After:  Prog->  nDim, [next], ...
2465 **         Stack-> next, ...
2466 */
2467 static int arrayAssign(void)
2468 {
2469     char *keyString = NULL;
2470     DataValue srcValue, dstArray;
2471     int errNum;
2472     int nDim;
2473
2474     nDim = (int)*PC;
2475     PC++;
2476
2477     DISASM_RT(PC-2, 1);
2478     STACKDUMP(nDim, 3);
2479
2480     if (nDim > 0) {
2481         POP(srcValue)
2482
2483         errNum = makeArrayKeyFromArgs(nDim, &keyString, 0);
2484         if (errNum != STAT_OK) {
2485             return(errNum);
2486         }
2487
2488         POP(dstArray)
2489
2490         if (dstArray.tag != ARRAY_TAG && dstArray.tag != NO_TAG) {
2491             return(execError("cannot assign array element of non-array", NULL));
2492         }
2493         if (srcValue.tag == ARRAY_TAG) {
2494             DataValue arrayCopyValue;
2495
2496             errNum = ArrayCopy(&arrayCopyValue, &srcValue);
2497             srcValue = arrayCopyValue;
2498             if (errNum != STAT_OK) {
2499                 return(errNum);
2500             }
2501         }
2502         if (ArrayInsert(&dstArray, keyString, &srcValue)) {
2503             return(STAT_OK);
2504         }
2505         else {
2506             return(execError("array member allocation failure", NULL));
2507         }
2508     }
2509     return(execError("empty operator []", NULL));
2510 }
2511
2512 /*
2513 ** for use with assign-op operators (eg a[i,j] += k
2514 **
2515 ** Before: Prog->  [binOp], nDim, next, ...
2516 **         Stack-> [rhs], indnDim, ... ind1, next, ...
2517 ** After:  Prog->  binOp, nDim, [next], ...
2518 **         Stack-> [rhs], arrayValue, next, ...
2519 */
2520 static int arrayRefAndAssignSetup(void)
2521 {
2522     int errNum;
2523     DataValue srcArray, valueItem, moveExpr;
2524     char *keyString = NULL;
2525     int binaryOp, nDim;
2526
2527     binaryOp = (int)*PC;
2528     PC++;
2529     nDim = (int)*PC;
2530     PC++;
2531
2532     DISASM_RT(PC-3, 3);
2533     STACKDUMP(nDim + 1, 3);
2534
2535     if (binaryOp) {
2536         POP(moveExpr)
2537     }
2538
2539     if (nDim > 0) {
2540         errNum = makeArrayKeyFromArgs(nDim, &keyString, 1);
2541         if (errNum != STAT_OK) {
2542             return(errNum);
2543         }
2544
2545         PEEK(srcArray, nDim)
2546         if (srcArray.tag == ARRAY_TAG) {
2547             if (!ArrayGet(&srcArray, keyString, &valueItem)) {
2548                 return(execError("referenced array value not in array: %s", keyString));
2549             }
2550             PUSH(valueItem)
2551             if (binaryOp) {
2552                 PUSH(moveExpr)
2553             }
2554             return(STAT_OK);
2555         }
2556         else {
2557             return(execError("operator [] on non-array", NULL));
2558         }
2559     }
2560     else {
2561         return(execError("array[] not an lvalue", NULL));
2562     }
2563 }
2564
2565 /*
2566 ** setup symbol values for array iteration in interpreter
2567 **
2568 ** Before: Prog->  [iter], ARRAY_ITER, iterVar, iter, endLoopBranch, next, ...
2569 **         Stack-> [arrayVal], next, ...
2570 ** After:  Prog->  iter, [ARRAY_ITER], iterVar, iter, endLoopBranch, next, ...
2571 **         Stack-> [next], ...
2572 ** Where:
2573 **      iter is a symbol which gives the position of the iterator value in
2574 **              the stack frame
2575 **      arrayVal is the data value holding the array in question
2576 */
2577 static int beginArrayIter(void)
2578 {
2579     Symbol *iterator;
2580     DataValue *iteratorValPtr;
2581     DataValue arrayVal;
2582
2583     DISASM_RT(PC-1, 2);
2584     STACKDUMP(1, 3);
2585
2586     iterator = (Symbol *)*PC;
2587     PC++;
2588
2589     POP(arrayVal)
2590
2591     if (iterator->type == LOCAL_SYM) {
2592         iteratorValPtr = &FP_GET_SYM_VAL(FrameP, iterator);
2593     }
2594     else {
2595         return(execError("bad temporary iterator: %s",  iterator->name));
2596     }
2597
2598     iteratorValPtr->tag = INT_TAG;
2599     if (arrayVal.tag != ARRAY_TAG) {
2600         return(execError("can't iterate non-array", NULL));
2601     }
2602
2603     iteratorValPtr->val.arrayPtr = (struct SparseArrayEntry *)arrayIterateFirst(&arrayVal);
2604     return(STAT_OK);
2605 }
2606
2607 /*
2608 ** copy key to symbol if node is still valid, marked bad by a color of -1
2609 ** then move iterator to next node
2610 ** this allows iterators to progress even if you delete any node in the array
2611 ** except the item just after the current key
2612 **
2613 ** Before: Prog->  iter, ARRAY_ITER, [iterVar], iter, endLoopBranch, next, ...
2614 **         Stack-> [next], ...
2615 ** After:  Prog->  iter, ARRAY_ITER, iterVar, iter, endLoopBranch, [next], ...
2616 **         Stack-> [next], ...      (unchanged)
2617 ** Where:
2618 **      iter is a symbol which gives the position of the iterator value in
2619 **              the stack frame (set up by BEGIN_ARRAY_ITER); that value refers
2620 **              to the array and a position within it
2621 **      iterVal is the programmer-visible symbol which will take the current
2622 **              key value
2623 **      endLoopBranch is the instruction offset to the instruction following the
2624 **              loop (measured from itself)
2625 **      arrayVal is the data value holding the array in question
2626 ** The return-to-start-of-loop branch (at the end of the loop) should address
2627 ** the ARRAY_ITER instruction
2628 */
2629 static int arrayIter(void)
2630 {
2631     Symbol *iterator;
2632     Symbol *item;
2633     DataValue *iteratorValPtr;
2634     DataValue *itemValPtr;
2635     SparseArrayEntry *thisEntry;
2636     Inst *branchAddr;
2637
2638     DISASM_RT(PC-1, 4);
2639     STACKDUMP(0, 3);
2640
2641     item = (Symbol *)*PC;
2642     PC++;
2643     iterator = (Symbol *)*PC;
2644     PC++;
2645     branchAddr = PC + (int)*PC;
2646     PC++;
2647
2648     if (item->type == LOCAL_SYM) {
2649         itemValPtr = &FP_GET_SYM_VAL(FrameP, item);
2650     }
2651     else if (item->type == GLOBAL_SYM) {
2652         itemValPtr = &(item->value);
2653     }
2654     else {
2655         return(execError("can't assign to: %s",  item->name));
2656     }
2657     itemValPtr->tag = NO_TAG;
2658
2659     if (iterator->type == LOCAL_SYM) {
2660         iteratorValPtr = &FP_GET_SYM_VAL(FrameP, iterator);
2661     }
2662     else {
2663         return(execError("bad temporary iterator: %s",  iterator->name));
2664     }
2665
2666     thisEntry = (SparseArrayEntry *)iteratorValPtr->val.arrayPtr;
2667     if (thisEntry && thisEntry->nodePtrs.color != -1) {
2668         itemValPtr->tag = STRING_TAG;
2669         itemValPtr->val.str.rep = thisEntry->key;
2670         itemValPtr->val.str.len = strlen(thisEntry->key);
2671
2672         iteratorValPtr->val.arrayPtr = (struct SparseArrayEntry *)arrayIterateNext(thisEntry);
2673     }
2674     else {
2675         PC = branchAddr;
2676     }
2677     return(STAT_OK);
2678 }
2679
2680 /*
2681 ** determine if a key or keys exists in an array
2682 ** if the left argument is a string or integer a single check is performed
2683 ** if the key exists, 1 is pushed onto the stack, otherwise 0
2684 ** if the left argument is an array 1 is pushed onto the stack if every key
2685 ** in the left array exists in the right array, otherwise 0
2686 **
2687 ** Before: Prog->  [next], ...
2688 **         Stack-> [ArraySym], inSymbol, next, ...
2689 ** After:  Prog->  [next], ...      -- (unchanged)
2690 **         Stack-> next, ...
2691 */
2692 static int inArray(void)
2693 {
2694     DataValue theArray, leftArray, theValue;
2695     char *keyStr;
2696     int inResult = 0;
2697
2698     DISASM_RT(PC-1, 1);
2699     STACKDUMP(2, 3);
2700
2701     POP(theArray)
2702     if (theArray.tag != ARRAY_TAG) {
2703         return(execError("operator in on non-array", NULL));
2704     }
2705     PEEK(leftArray, 0)
2706     if (leftArray.tag == ARRAY_TAG) {
2707         SparseArrayEntry *iter;
2708
2709         POP(leftArray)
2710         inResult = 1;
2711         iter = arrayIterateFirst(&leftArray);
2712         while (inResult && iter) {
2713             inResult = inResult && ArrayGet(&theArray, iter->key, &theValue);
2714             iter = arrayIterateNext(iter);
2715         }
2716     }
2717     else {
2718         POP_STRING(keyStr)
2719         if (ArrayGet(&theArray, keyStr, &theValue)) {
2720             inResult = 1;
2721         }
2722     }
2723     PUSH_INT(inResult)
2724     return(STAT_OK);
2725 }
2726
2727 /*
2728 ** remove a given key from an array unless nDim is 0, then all keys are removed
2729 **
2730 ** for use with assign-op operators (eg a[i,j] += k
2731 ** Before: Prog->  [nDim], next, ...
2732 **         Stack-> [indnDim], ... ind1, arrayValue, next, ...
2733 ** After:  Prog->  nDim, [next], ...
2734 **         Stack-> next, ...
2735 */
2736 static int deleteArrayElement(void)
2737 {
2738     DataValue theArray;
2739     char *keyString = NULL;
2740     int nDim;
2741
2742     nDim = (int)*PC;
2743     PC++;
2744
2745     DISASM_RT(PC-2, 2);
2746     STACKDUMP(nDim + 1, 3);
2747
2748     if (nDim > 0) {
2749         int errNum;
2750
2751         errNum = makeArrayKeyFromArgs(nDim, &keyString, 0);
2752         if (errNum != STAT_OK) {
2753             return(errNum);
2754         }
2755     }
2756
2757     POP(theArray)
2758     if (theArray.tag == ARRAY_TAG) {
2759         if (nDim > 0) {
2760             ArrayDelete(&theArray, keyString);
2761         }
2762         else {
2763             ArrayDeleteAll(&theArray);
2764         }
2765     }
2766     else {
2767         return(execError("attempt to delete from non-array", NULL));
2768     }
2769     return(STAT_OK);
2770 }
2771
2772 /*
2773 ** checks errno after operations which can set it.  If an error occured,
2774 ** creates appropriate error messages and returns false
2775 */
2776 static int errCheck(const char *s)
2777 {
2778     if (errno == EDOM)
2779         return execError("%s argument out of domain", s);
2780     else if (errno == ERANGE)
2781         return execError("%s result out of range", s);
2782     else
2783         return STAT_OK;
2784 }
2785
2786 /*
2787 ** combine two strings in a static area and set ErrMsg to point to the
2788 ** result.  Returns false so a single return execError() statement can
2789 ** be used to both process the message and return.
2790 */
2791 static int execError(const char *s1, const char *s2)
2792 {
2793     static char msg[MAX_ERR_MSG_LEN];
2794
2795     sprintf(msg, s1, s2);
2796     ErrMsg = msg;
2797     return STAT_ERROR;
2798 }
2799
2800 int StringToNum(const char *string, int *number)
2801 {
2802     const char *c = string;
2803
2804     while (*c == ' ' || *c == '\t') {
2805         ++c;
2806     }
2807     if (*c == '+' || *c == '-') {
2808         ++c;
2809     }
2810     while (isdigit((unsigned char)*c)) {
2811         ++c;
2812     }
2813     while (*c == ' ' || *c == '\t') {
2814         ++c;
2815     }
2816     if (*c) {
2817         /* if everything went as expected, we should be at end, but we're not */
2818         return False;
2819     }
2820     if (number) {
2821         if (sscanf(string, "%d", number) != 1) {
2822             /* This case is here to support old behavior */
2823             *number = 0;
2824         }
2825     }
2826     return True;
2827 }
2828
2829 #ifdef DEBUG_DISASSEMBLER   /* dumping values in disassembly or stack dump */
2830 static void dumpVal(DataValue dv)
2831 {
2832     switch (dv.tag) {
2833         case INT_TAG:
2834             printf("i=%d", dv.val.n);
2835             break;
2836         case STRING_TAG:
2837             {
2838                 int k;
2839                 char s[21];
2840                 char *src = dv.val.str.rep;
2841                 if (!src) {
2842                     printf("s=<NULL>");
2843                 }
2844                 else {
2845                     for (k = 0; src[k] && k < sizeof s - 1; k++) {
2846                         s[k] = isprint(src[k]) ? src[k] : '?';
2847                     }
2848                     s[k] = 0;
2849                     printf("s=\"%s\"%s[%d]", s,
2850                            src[k] ? "..." : "", strlen(src));
2851                 }
2852             }
2853             break;
2854         case ARRAY_TAG:
2855             printf("<array>");
2856             break;
2857         case NO_TAG:
2858             if (!dv.val.inst) {
2859                 printf("<no value>");
2860             }
2861             else {
2862                 printf("?%8p", dv.val.inst);
2863             }
2864             break;
2865         default:
2866             printf("UNKNOWN DATA TAG %d ?%8p", dv.tag, dv.val.inst);
2867             break;
2868     }
2869 }
2870 #endif /* #ifdef DEBUG_DISASSEMBLER */
2871
2872 #ifdef DEBUG_DISASSEMBLER /* For debugging code generation */
2873 static void disasm(Inst *inst, int nInstr)
2874 {
2875     static const char *opNames[N_OPS] = {
2876         "RETURN_NO_VAL",                /* returnNoVal */
2877         "RETURN",                       /* returnVal */
2878         "PUSH_SYM",                     /* pushSymVal */
2879         "DUP",                          /* dupStack */
2880         "ADD",                          /* add */
2881         "SUB",                          /* subtract */
2882         "MUL",                          /* multiply */
2883         "DIV",                          /* divide */
2884         "MOD",                          /* modulo */
2885         "NEGATE",                       /* negate */
2886         "INCR",                         /* increment */
2887         "DECR",                         /* decrement */
2888         "GT",                           /* gt */
2889         "LT",                           /* lt */
2890         "GE",                           /* ge */
2891         "LE",                           /* le */
2892         "EQ",                           /* eq */
2893         "NE",                           /* ne */
2894         "BIT_AND",                      /* bitAnd */
2895         "BIT_OR",                       /* bitOr */
2896         "AND",                          /* and */
2897         "OR",                           /* or */
2898         "NOT",                          /* not */
2899         "POWER",                        /* power */
2900         "CONCAT",                       /* concat */
2901         "ASSIGN",                       /* assign */
2902         "SUBR_CALL",                    /* callSubroutine */
2903         "FETCH_RET_VAL",                /* fetchRetVal */
2904         "BRANCH",                       /* branch */
2905         "BRANCH_TRUE",                  /* branchTrue */
2906         "BRANCH_FALSE",                 /* branchFalse */
2907         "BRANCH_NEVER",                 /* branchNever */
2908         "ARRAY_REF",                    /* arrayRef */
2909         "ARRAY_ASSIGN",                 /* arrayAssign */
2910         "BEGIN_ARRAY_ITER",             /* beginArrayIter */
2911         "ARRAY_ITER",                   /* arrayIter */
2912         "IN_ARRAY",                     /* inArray */
2913         "ARRAY_DELETE",                 /* deleteArrayElement */
2914         "PUSH_ARRAY_SYM",               /* pushArraySymVal */
2915         "ARRAY_REF_ASSIGN_SETUP",       /* arrayRefAndAssignSetup */
2916         "PUSH_ARG",                     /* $arg[expr] */
2917         "PUSH_ARG_COUNT",               /* $arg[] */
2918         "PUSH_ARG_ARRAY"                /* $arg */
2919     };
2920     int i, j;
2921
2922     printf("\n");
2923     for (i = 0; i < nInstr; ++i) {
2924         printf("Prog %8p ", &inst[i]);
2925         for (j = 0; j < N_OPS; ++j) {
2926             if (inst[i] == OpFns[j]) {
2927                 printf("%22s ", opNames[j]);
2928                 if (j == OP_PUSH_SYM || j == OP_ASSIGN) {
2929                     Symbol *sym = (Symbol *)inst[i+1];
2930                     printf("%s", sym->name);
2931                     if (sym->value.tag == STRING_TAG &&
2932                         strncmp(sym->name, "string #", 8) == 0) {
2933                         dumpVal(sym->value);
2934                     }
2935                     ++i;
2936                 }
2937                 else if (j == OP_BRANCH || j == OP_BRANCH_FALSE ||
2938                         j == OP_BRANCH_NEVER || j == OP_BRANCH_TRUE) {
2939                     printf("to=(%d) %x", (int)inst[i+1],
2940                             (int)(&inst[i+1] + (int)inst[i+1]));
2941                     ++i;
2942                 }
2943                 else if (j == OP_SUBR_CALL) {
2944                     printf("%s (%d arg)", ((Symbol *)inst[i+1])->name,
2945                             (int)inst[i+2]);
2946                     i += 2;
2947                 }
2948                 else if (j == OP_BEGIN_ARRAY_ITER) {
2949                     printf("%s in",
2950                             ((Symbol *)inst[i+1])->name);
2951                     ++i;
2952                 }
2953                 else if (j == OP_ARRAY_ITER) {
2954                     printf("%s = %s++ end-loop=(%d) %x",
2955                             ((Symbol *)inst[i+1])->name,
2956                             ((Symbol *)inst[i+2])->name,
2957                             (int)inst[i+3],
2958                             (int)(&inst[i+3] + (int)inst[i+3]));
2959                     i += 3;
2960                 }
2961                 else if (j == OP_ARRAY_REF || j == OP_ARRAY_DELETE ||
2962                             j == OP_ARRAY_ASSIGN) {
2963                     printf("nDim=%d",
2964                             ((int)inst[i+1]));
2965                     ++i;
2966                 }
2967                 else if (j == OP_ARRAY_REF_ASSIGN_SETUP) {
2968                     printf("binOp=%s ",
2969                             ((int)inst[i+1]) ? "true" : "false");
2970                     printf("nDim=%d",
2971                             ((int)inst[i+2]));
2972                     i += 2;
2973                 }
2974                 else if (j == OP_PUSH_ARRAY_SYM) {
2975                     printf("%s", ((Symbol *)inst[++i])->name);
2976                     printf(" %s",
2977                             (int)inst[i+1] ? "createAndRef" : "refOnly");
2978                     ++i;
2979                 }
2980
2981                 printf("\n");
2982                 break;
2983             }
2984         }
2985         if (j == N_OPS) {
2986             printf("%x\n", (int)inst[i]);
2987         }
2988     }
2989 }
2990 #endif /* #ifdef DEBUG_DISASSEMBLER */
2991
2992 #ifdef DEBUG_STACK  /* for run-time stack dumping */
2993 #define STACK_DUMP_ARG_PREFIX "Arg"
2994 static void stackdump(int n, int extra)
2995 {
2996     /* Stack-> symN-sym1(FP), argArray, nArgs, oldFP, retPC, argN-arg1, next, ... */
2997     int nArgs = FP_GET_ARG_COUNT(FrameP);
2998     int i, offset;
2999     char buffer[sizeof(STACK_DUMP_ARG_PREFIX) + TYPE_INT_STR_SIZE(int)];
3000     printf("Stack ----->\n");
3001     for (i = 0; i < n + extra; i++) {
3002         char *pos = "";
3003         DataValue *dv = &StackP[-i - 1];
3004         if (dv < Stack) {
3005             printf("--------------Stack base--------------\n");
3006             break;
3007         }
3008         offset = dv - FrameP;
3009
3010         printf("%4.4s", i < n ? ">>>>" : "");
3011         printf("%8p ", dv);
3012         switch (offset) {
3013             case 0:                         pos = "FrameP"; break;  /* first local symbol value */
3014             case FP_ARG_ARRAY_CACHE_INDEX:  pos = "args";  break;  /* number of arguments */
3015             case FP_ARG_COUNT_INDEX:        pos = "NArgs";  break;  /* number of arguments */
3016             case FP_OLD_FP_INDEX:           pos = "OldFP";  break;
3017             case FP_RET_PC_INDEX:           pos = "RetPC";  break;
3018             default:
3019                 if (offset < -FP_TO_ARGS_DIST && offset >= -FP_TO_ARGS_DIST - nArgs) {
3020                     sprintf(pos = buffer, STACK_DUMP_ARG_PREFIX "%d", offset + FP_TO_ARGS_DIST + nArgs + 1);
3021                 }
3022                 break;
3023         }
3024         printf("%-6s ", pos);
3025         dumpVal(*dv);
3026         printf("\n");
3027     }
3028 }
3029 #endif /* ifdef DEBUG_STACK */