source/interpret.c

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