source/interpret.c

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