source/interpret.c

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