1*afc2ba1dSToomas Soome /* 2*afc2ba1dSToomas Soome * f i c l . c 3*afc2ba1dSToomas Soome * Forth Inspired Command Language - external interface 4*afc2ba1dSToomas Soome * Author: John Sadler (john_sadler@alum.mit.edu) 5*afc2ba1dSToomas Soome * Created: 19 July 1997 6*afc2ba1dSToomas Soome * $Id: system.c,v 1.2 2010/09/10 10:35:54 asau Exp $ 7*afc2ba1dSToomas Soome */ 8*afc2ba1dSToomas Soome /* 9*afc2ba1dSToomas Soome * This is an ANS Forth interpreter written in C. 10*afc2ba1dSToomas Soome * Ficl uses Forth syntax for its commands, but turns the Forth 11*afc2ba1dSToomas Soome * model on its head in other respects. 12*afc2ba1dSToomas Soome * Ficl provides facilities for interoperating 13*afc2ba1dSToomas Soome * with programs written in C: C functions can be exported to Ficl, 14*afc2ba1dSToomas Soome * and Ficl commands can be executed via a C calling interface. The 15*afc2ba1dSToomas Soome * interpreter is re-entrant, so it can be used in multiple instances 16*afc2ba1dSToomas Soome * in a multitasking system. Unlike Forth, Ficl's outer interpreter 17*afc2ba1dSToomas Soome * expects a text block as input, and returns to the caller after each 18*afc2ba1dSToomas Soome * text block, so the data pump is somewhere in external code in the 19*afc2ba1dSToomas Soome * style of TCL. 20*afc2ba1dSToomas Soome * 21*afc2ba1dSToomas Soome * Code is written in ANSI C for portability. 22*afc2ba1dSToomas Soome */ 23*afc2ba1dSToomas Soome /* 24*afc2ba1dSToomas Soome * Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) 25*afc2ba1dSToomas Soome * All rights reserved. 26*afc2ba1dSToomas Soome * 27*afc2ba1dSToomas Soome * Get the latest Ficl release at http://ficl.sourceforge.net 28*afc2ba1dSToomas Soome * 29*afc2ba1dSToomas Soome * I am interested in hearing from anyone who uses Ficl. If you have 30*afc2ba1dSToomas Soome * a problem, a success story, a defect, an enhancement request, or 31*afc2ba1dSToomas Soome * if you would like to contribute to the Ficl release, please 32*afc2ba1dSToomas Soome * contact me by email at the address above. 33*afc2ba1dSToomas Soome * 34*afc2ba1dSToomas Soome * L I C E N S E and D I S C L A I M E R 35*afc2ba1dSToomas Soome * 36*afc2ba1dSToomas Soome * Redistribution and use in source and binary forms, with or without 37*afc2ba1dSToomas Soome * modification, are permitted provided that the following conditions 38*afc2ba1dSToomas Soome * are met: 39*afc2ba1dSToomas Soome * 1. Redistributions of source code must retain the above copyright 40*afc2ba1dSToomas Soome * notice, this list of conditions and the following disclaimer. 41*afc2ba1dSToomas Soome * 2. Redistributions in binary form must reproduce the above copyright 42*afc2ba1dSToomas Soome * notice, this list of conditions and the following disclaimer in the 43*afc2ba1dSToomas Soome * documentation and/or other materials provided with the distribution. 44*afc2ba1dSToomas Soome * 45*afc2ba1dSToomas Soome * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 46*afc2ba1dSToomas Soome * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 47*afc2ba1dSToomas Soome * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 48*afc2ba1dSToomas Soome * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 49*afc2ba1dSToomas Soome * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 50*afc2ba1dSToomas Soome * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 51*afc2ba1dSToomas Soome * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 52*afc2ba1dSToomas Soome * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 53*afc2ba1dSToomas Soome * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 54*afc2ba1dSToomas Soome * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 55*afc2ba1dSToomas Soome * SUCH DAMAGE. 56*afc2ba1dSToomas Soome */ 57*afc2ba1dSToomas Soome 58*afc2ba1dSToomas Soome #include "ficl.h" 59*afc2ba1dSToomas Soome 60*afc2ba1dSToomas Soome /* 61*afc2ba1dSToomas Soome * System statics 62*afc2ba1dSToomas Soome * Each ficlSystem builds a global dictionary during its start 63*afc2ba1dSToomas Soome * sequence. This is shared by all virtual machines of that system. 64*afc2ba1dSToomas Soome * Therefore only one VM can update the dictionary 65*afc2ba1dSToomas Soome * at a time. The system imports a locking function that 66*afc2ba1dSToomas Soome * you can override in order to control update access to 67*afc2ba1dSToomas Soome * the dictionary. The function is stubbed out by default, 68*afc2ba1dSToomas Soome * but you can insert one: #define FICL_WANT_MULTITHREADED 1 69*afc2ba1dSToomas Soome * and supply your own version of ficlDictionaryLock. 70*afc2ba1dSToomas Soome */ 71*afc2ba1dSToomas Soome 72*afc2ba1dSToomas Soome ficlSystem *ficlSystemGlobal = NULL; 73*afc2ba1dSToomas Soome 74*afc2ba1dSToomas Soome /* 75*afc2ba1dSToomas Soome * f i c l S e t V e r s i o n E n v 76*afc2ba1dSToomas Soome * Create a double ficlCell environment constant for the version ID 77*afc2ba1dSToomas Soome */ 78*afc2ba1dSToomas Soome static void 79*afc2ba1dSToomas Soome ficlSystemSetVersion(ficlSystem *system) 80*afc2ba1dSToomas Soome { 81*afc2ba1dSToomas Soome int major = FICL_VERSION_MAJOR; 82*afc2ba1dSToomas Soome int minor = FICL_VERSION_MINOR; 83*afc2ba1dSToomas Soome ficl2Integer combined; 84*afc2ba1dSToomas Soome ficlDictionary *environment = ficlSystemGetEnvironment(system); 85*afc2ba1dSToomas Soome FICL_2INTEGER_SET(major, minor, combined); 86*afc2ba1dSToomas Soome ficlDictionarySet2Constant(environment, "ficl-version", combined); 87*afc2ba1dSToomas Soome ficlDictionarySetConstant(environment, "ficl-robust", FICL_ROBUST); 88*afc2ba1dSToomas Soome } 89*afc2ba1dSToomas Soome 90*afc2ba1dSToomas Soome /* 91*afc2ba1dSToomas Soome * f i c l I n i t S y s t e m 92*afc2ba1dSToomas Soome * Binds a global dictionary to the interpreter system. 93*afc2ba1dSToomas Soome * You specify the address and size of the allocated area. 94*afc2ba1dSToomas Soome * After that, Ficl manages it. 95*afc2ba1dSToomas Soome * First step is to set up the static pointers to the area. 96*afc2ba1dSToomas Soome * Then write the "precompiled" portion of the dictionary in. 97*afc2ba1dSToomas Soome * The dictionary needs to be at least large enough to hold the 98*afc2ba1dSToomas Soome * precompiled part. Try 1K cells minimum. Use "words" to find 99*afc2ba1dSToomas Soome * out how much of the dictionary is used at any time. 100*afc2ba1dSToomas Soome */ 101*afc2ba1dSToomas Soome ficlSystem * 102*afc2ba1dSToomas Soome ficlSystemCreate(ficlSystemInformation *fsi) 103*afc2ba1dSToomas Soome { 104*afc2ba1dSToomas Soome ficlInteger dictionarySize; 105*afc2ba1dSToomas Soome ficlInteger environmentSize; 106*afc2ba1dSToomas Soome ficlInteger stackSize; 107*afc2ba1dSToomas Soome ficlSystem *system; 108*afc2ba1dSToomas Soome ficlCallback callback; 109*afc2ba1dSToomas Soome ficlSystemInformation fauxInfo; 110*afc2ba1dSToomas Soome ficlDictionary *environment; 111*afc2ba1dSToomas Soome 112*afc2ba1dSToomas Soome if (fsi == NULL) { 113*afc2ba1dSToomas Soome fsi = &fauxInfo; 114*afc2ba1dSToomas Soome ficlSystemInformationInitialize(fsi); 115*afc2ba1dSToomas Soome } 116*afc2ba1dSToomas Soome 117*afc2ba1dSToomas Soome callback.context = fsi->context; 118*afc2ba1dSToomas Soome callback.textOut = fsi->textOut; 119*afc2ba1dSToomas Soome callback.errorOut = fsi->errorOut; 120*afc2ba1dSToomas Soome callback.system = NULL; 121*afc2ba1dSToomas Soome callback.vm = NULL; 122*afc2ba1dSToomas Soome 123*afc2ba1dSToomas Soome FICL_ASSERT(&callback, sizeof (ficlInteger) >= sizeof (void *)); 124*afc2ba1dSToomas Soome FICL_ASSERT(&callback, sizeof (ficlUnsigned) >= sizeof (void *)); 125*afc2ba1dSToomas Soome #if (FICL_WANT_FLOAT) 126*afc2ba1dSToomas Soome FICL_ASSERT(&callback, sizeof (ficlFloat) <= sizeof (ficlInteger)); 127*afc2ba1dSToomas Soome #endif 128*afc2ba1dSToomas Soome 129*afc2ba1dSToomas Soome system = ficlMalloc(sizeof (ficlSystem)); 130*afc2ba1dSToomas Soome 131*afc2ba1dSToomas Soome FICL_ASSERT(&callback, system); 132*afc2ba1dSToomas Soome 133*afc2ba1dSToomas Soome memset(system, 0, sizeof (ficlSystem)); 134*afc2ba1dSToomas Soome 135*afc2ba1dSToomas Soome dictionarySize = fsi->dictionarySize; 136*afc2ba1dSToomas Soome if (dictionarySize <= 0) 137*afc2ba1dSToomas Soome dictionarySize = FICL_DEFAULT_DICTIONARY_SIZE; 138*afc2ba1dSToomas Soome 139*afc2ba1dSToomas Soome environmentSize = fsi->environmentSize; 140*afc2ba1dSToomas Soome if (environmentSize <= 0) 141*afc2ba1dSToomas Soome environmentSize = FICL_DEFAULT_ENVIRONMENT_SIZE; 142*afc2ba1dSToomas Soome 143*afc2ba1dSToomas Soome stackSize = fsi->stackSize; 144*afc2ba1dSToomas Soome if (stackSize < FICL_DEFAULT_STACK_SIZE) 145*afc2ba1dSToomas Soome stackSize = FICL_DEFAULT_STACK_SIZE; 146*afc2ba1dSToomas Soome 147*afc2ba1dSToomas Soome system->dictionary = ficlDictionaryCreateHashed(system, 148*afc2ba1dSToomas Soome (unsigned)dictionarySize, FICL_HASH_SIZE); 149*afc2ba1dSToomas Soome system->dictionary->forthWordlist->name = "forth-wordlist"; 150*afc2ba1dSToomas Soome 151*afc2ba1dSToomas Soome environment = ficlDictionaryCreate(system, (unsigned)environmentSize); 152*afc2ba1dSToomas Soome system->environment = environment; 153*afc2ba1dSToomas Soome system->environment->forthWordlist->name = "environment"; 154*afc2ba1dSToomas Soome 155*afc2ba1dSToomas Soome system->callback.textOut = fsi->textOut; 156*afc2ba1dSToomas Soome system->callback.errorOut = fsi->errorOut; 157*afc2ba1dSToomas Soome system->callback.context = fsi->context; 158*afc2ba1dSToomas Soome system->callback.system = system; 159*afc2ba1dSToomas Soome system->callback.vm = NULL; 160*afc2ba1dSToomas Soome system->stackSize = stackSize; 161*afc2ba1dSToomas Soome 162*afc2ba1dSToomas Soome #if FICL_WANT_LOCALS 163*afc2ba1dSToomas Soome /* 164*afc2ba1dSToomas Soome * The locals dictionary is only searched while compiling, 165*afc2ba1dSToomas Soome * but this is where speed is most important. On the other 166*afc2ba1dSToomas Soome * hand, the dictionary gets emptied after each use of locals 167*afc2ba1dSToomas Soome * The need to balance search speed with the cost of the 'empty' 168*afc2ba1dSToomas Soome * operation led me to select a single-threaded list... 169*afc2ba1dSToomas Soome */ 170*afc2ba1dSToomas Soome system->locals = ficlDictionaryCreate(system, 171*afc2ba1dSToomas Soome (unsigned)FICL_MAX_LOCALS * FICL_CELLS_PER_WORD); 172*afc2ba1dSToomas Soome #endif /* FICL_WANT_LOCALS */ 173*afc2ba1dSToomas Soome 174*afc2ba1dSToomas Soome /* 175*afc2ba1dSToomas Soome * Build the precompiled dictionary and load softwords. We need 176*afc2ba1dSToomas Soome * a temporary VM to do this - ficlNewVM links one to the head of 177*afc2ba1dSToomas Soome * the system VM list. ficlCompilePlatform (defined in win32.c, 178*afc2ba1dSToomas Soome * for example) adds platform specific words. 179*afc2ba1dSToomas Soome */ 180*afc2ba1dSToomas Soome ficlSystemCompileCore(system); 181*afc2ba1dSToomas Soome ficlSystemCompilePrefix(system); 182*afc2ba1dSToomas Soome 183*afc2ba1dSToomas Soome #if FICL_WANT_FLOAT 184*afc2ba1dSToomas Soome ficlSystemCompileFloat(system); 185*afc2ba1dSToomas Soome #endif /* FICL_WANT_FLOAT */ 186*afc2ba1dSToomas Soome 187*afc2ba1dSToomas Soome #if FICL_WANT_PLATFORM 188*afc2ba1dSToomas Soome ficlSystemCompilePlatform(system); 189*afc2ba1dSToomas Soome #endif /* FICL_WANT_PLATFORM */ 190*afc2ba1dSToomas Soome 191*afc2ba1dSToomas Soome ficlSystemSetVersion(system); 192*afc2ba1dSToomas Soome 193*afc2ba1dSToomas Soome /* 194*afc2ba1dSToomas Soome * Establish the parse order. Note that prefixes precede numbers - 195*afc2ba1dSToomas Soome * this allows constructs like "0b101010" which might parse as a 196*afc2ba1dSToomas Soome * hex value otherwise. 197*afc2ba1dSToomas Soome */ 198*afc2ba1dSToomas Soome ficlSystemAddPrimitiveParseStep(system, "?word", ficlVmParseWord); 199*afc2ba1dSToomas Soome ficlSystemAddPrimitiveParseStep(system, "?prefix", ficlVmParsePrefix); 200*afc2ba1dSToomas Soome ficlSystemAddPrimitiveParseStep(system, "?number", ficlVmParseNumber); 201*afc2ba1dSToomas Soome #if FICL_WANT_FLOAT 202*afc2ba1dSToomas Soome ficlSystemAddPrimitiveParseStep(system, "?float", 203*afc2ba1dSToomas Soome ficlVmParseFloatNumber); 204*afc2ba1dSToomas Soome #endif 205*afc2ba1dSToomas Soome 206*afc2ba1dSToomas Soome /* 207*afc2ba1dSToomas Soome * Now create a temporary VM to compile the softwords. Since all VMs 208*afc2ba1dSToomas Soome * are linked into the vmList of ficlSystem, we don't have to pass 209*afc2ba1dSToomas Soome * the VM to ficlCompileSoftCore -- it just hijacks whatever it finds 210*afc2ba1dSToomas Soome * in the VM list. Ficl 2.05: vmCreate no longer depends on the 211*afc2ba1dSToomas Soome * presence of INTERPRET in the dictionary, so a VM can be created 212*afc2ba1dSToomas Soome * before the dictionary is built. It just can't do much... 213*afc2ba1dSToomas Soome */ 214*afc2ba1dSToomas Soome ficlSystemCreateVm(system); 215*afc2ba1dSToomas Soome #define ADD_COMPILE_FLAG(name) \ 216*afc2ba1dSToomas Soome ficlDictionarySetConstant(environment, #name, name) 217*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_WANT_LZ4_SOFTCORE); 218*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_WANT_FILE); 219*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_WANT_FLOAT); 220*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_WANT_DEBUGGER); 221*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_WANT_EXTENDED_PREFIX); 222*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_WANT_USER); 223*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_WANT_LOCALS); 224*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_WANT_OOP); 225*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_WANT_SOFTWORDS); 226*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_WANT_MULTITHREADED); 227*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_WANT_OPTIMIZE); 228*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_WANT_VCALL); 229*afc2ba1dSToomas Soome 230*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_PLATFORM_ALIGNMENT); 231*afc2ba1dSToomas Soome 232*afc2ba1dSToomas Soome ADD_COMPILE_FLAG(FICL_ROBUST); 233*afc2ba1dSToomas Soome 234*afc2ba1dSToomas Soome #define ADD_COMPILE_STRING(name) \ 235*afc2ba1dSToomas Soome ficlDictionarySetConstantString(environment, #name, name) 236*afc2ba1dSToomas Soome ADD_COMPILE_STRING(FICL_PLATFORM_ARCHITECTURE); 237*afc2ba1dSToomas Soome ADD_COMPILE_STRING(FICL_PLATFORM_OS); 238*afc2ba1dSToomas Soome 239*afc2ba1dSToomas Soome ficlSystemCompileSoftCore(system); 240*afc2ba1dSToomas Soome ficlSystemDestroyVm(system->vmList); 241*afc2ba1dSToomas Soome 242*afc2ba1dSToomas Soome if (ficlSystemGlobal == NULL) 243*afc2ba1dSToomas Soome ficlSystemGlobal = system; 244*afc2ba1dSToomas Soome 245*afc2ba1dSToomas Soome return (system); 246*afc2ba1dSToomas Soome } 247*afc2ba1dSToomas Soome 248*afc2ba1dSToomas Soome /* 249*afc2ba1dSToomas Soome * f i c l T e r m S y s t e m 250*afc2ba1dSToomas Soome * Tear the system down by deleting the dictionaries and all VMs. 251*afc2ba1dSToomas Soome * This saves you from having to keep track of all that stuff. 252*afc2ba1dSToomas Soome */ 253*afc2ba1dSToomas Soome void 254*afc2ba1dSToomas Soome ficlSystemDestroy(ficlSystem *system) 255*afc2ba1dSToomas Soome { 256*afc2ba1dSToomas Soome if (system->dictionary) 257*afc2ba1dSToomas Soome ficlDictionaryDestroy(system->dictionary); 258*afc2ba1dSToomas Soome system->dictionary = NULL; 259*afc2ba1dSToomas Soome 260*afc2ba1dSToomas Soome if (system->environment) 261*afc2ba1dSToomas Soome ficlDictionaryDestroy(system->environment); 262*afc2ba1dSToomas Soome system->environment = NULL; 263*afc2ba1dSToomas Soome 264*afc2ba1dSToomas Soome #if FICL_WANT_LOCALS 265*afc2ba1dSToomas Soome if (system->locals) 266*afc2ba1dSToomas Soome ficlDictionaryDestroy(system->locals); 267*afc2ba1dSToomas Soome system->locals = NULL; 268*afc2ba1dSToomas Soome #endif 269*afc2ba1dSToomas Soome 270*afc2ba1dSToomas Soome while (system->vmList != NULL) { 271*afc2ba1dSToomas Soome ficlVm *vm = system->vmList; 272*afc2ba1dSToomas Soome system->vmList = system->vmList->link; 273*afc2ba1dSToomas Soome ficlVmDestroy(vm); 274*afc2ba1dSToomas Soome } 275*afc2ba1dSToomas Soome 276*afc2ba1dSToomas Soome if (ficlSystemGlobal == system) 277*afc2ba1dSToomas Soome ficlSystemGlobal = NULL; 278*afc2ba1dSToomas Soome 279*afc2ba1dSToomas Soome ficlFree(system); 280*afc2ba1dSToomas Soome system = NULL; 281*afc2ba1dSToomas Soome } 282*afc2ba1dSToomas Soome 283*afc2ba1dSToomas Soome /* 284*afc2ba1dSToomas Soome * f i c l A d d P a r s e S t e p 285*afc2ba1dSToomas Soome * Appends a parse step function to the end of the parse list (see 286*afc2ba1dSToomas Soome * ficlParseStep notes in ficl.h for details). Returns 0 if successful, 287*afc2ba1dSToomas Soome * nonzero if there's no more room in the list. 288*afc2ba1dSToomas Soome */ 289*afc2ba1dSToomas Soome int 290*afc2ba1dSToomas Soome ficlSystemAddParseStep(ficlSystem *system, ficlWord *word) 291*afc2ba1dSToomas Soome { 292*afc2ba1dSToomas Soome int i; 293*afc2ba1dSToomas Soome for (i = 0; i < FICL_MAX_PARSE_STEPS; i++) { 294*afc2ba1dSToomas Soome if (system->parseList[i] == NULL) { 295*afc2ba1dSToomas Soome system->parseList[i] = word; 296*afc2ba1dSToomas Soome return (0); 297*afc2ba1dSToomas Soome } 298*afc2ba1dSToomas Soome } 299*afc2ba1dSToomas Soome 300*afc2ba1dSToomas Soome return (1); 301*afc2ba1dSToomas Soome } 302*afc2ba1dSToomas Soome 303*afc2ba1dSToomas Soome /* 304*afc2ba1dSToomas Soome * Compile a word into the dictionary that invokes the specified ficlParseStep 305*afc2ba1dSToomas Soome * function. It is up to the user (as usual in Forth) to make sure the stack 306*afc2ba1dSToomas Soome * preconditions are valid (there needs to be a counted string on top of the 307*afc2ba1dSToomas Soome * stack) before using the resulting word. 308*afc2ba1dSToomas Soome */ 309*afc2ba1dSToomas Soome void 310*afc2ba1dSToomas Soome ficlSystemAddPrimitiveParseStep(ficlSystem *system, char *name, 311*afc2ba1dSToomas Soome ficlParseStep pStep) 312*afc2ba1dSToomas Soome { 313*afc2ba1dSToomas Soome ficlDictionary *dictionary = system->dictionary; 314*afc2ba1dSToomas Soome ficlWord *word; 315*afc2ba1dSToomas Soome ficlCell c; 316*afc2ba1dSToomas Soome 317*afc2ba1dSToomas Soome word = ficlDictionaryAppendPrimitive(dictionary, name, 318*afc2ba1dSToomas Soome ficlPrimitiveParseStepParen, FICL_WORD_DEFAULT); 319*afc2ba1dSToomas Soome 320*afc2ba1dSToomas Soome c.fn = (void (*)(void))pStep; 321*afc2ba1dSToomas Soome ficlDictionaryAppendCell(dictionary, c); 322*afc2ba1dSToomas Soome ficlSystemAddParseStep(system, word); 323*afc2ba1dSToomas Soome } 324*afc2ba1dSToomas Soome 325*afc2ba1dSToomas Soome /* 326*afc2ba1dSToomas Soome * f i c l N e w V M 327*afc2ba1dSToomas Soome * Create a new virtual machine and link it into the system list 328*afc2ba1dSToomas Soome * of VMs for later cleanup by ficlTermSystem. 329*afc2ba1dSToomas Soome */ 330*afc2ba1dSToomas Soome ficlVm * 331*afc2ba1dSToomas Soome ficlSystemCreateVm(ficlSystem *system) 332*afc2ba1dSToomas Soome { 333*afc2ba1dSToomas Soome ficlVm *vm = ficlVmCreate(NULL, system->stackSize, system->stackSize); 334*afc2ba1dSToomas Soome vm->link = system->vmList; 335*afc2ba1dSToomas Soome 336*afc2ba1dSToomas Soome memcpy(&(vm->callback), &(system->callback), sizeof (system->callback)); 337*afc2ba1dSToomas Soome vm->callback.vm = vm; 338*afc2ba1dSToomas Soome vm->callback.system = system; 339*afc2ba1dSToomas Soome 340*afc2ba1dSToomas Soome system->vmList = vm; 341*afc2ba1dSToomas Soome return (vm); 342*afc2ba1dSToomas Soome } 343*afc2ba1dSToomas Soome 344*afc2ba1dSToomas Soome /* 345*afc2ba1dSToomas Soome * f i c l F r e e V M 346*afc2ba1dSToomas Soome * Removes the VM in question from the system VM list and deletes the 347*afc2ba1dSToomas Soome * memory allocated to it. This is an optional call, since ficlTermSystem 348*afc2ba1dSToomas Soome * will do this cleanup for you. This function is handy if you're going to 349*afc2ba1dSToomas Soome * do a lot of dynamic creation of VMs. 350*afc2ba1dSToomas Soome */ 351*afc2ba1dSToomas Soome void 352*afc2ba1dSToomas Soome ficlSystemDestroyVm(ficlVm *vm) 353*afc2ba1dSToomas Soome { 354*afc2ba1dSToomas Soome ficlSystem *system = vm->callback.system; 355*afc2ba1dSToomas Soome ficlVm *pList = system->vmList; 356*afc2ba1dSToomas Soome 357*afc2ba1dSToomas Soome FICL_VM_ASSERT(vm, vm != NULL); 358*afc2ba1dSToomas Soome 359*afc2ba1dSToomas Soome if (system->vmList == vm) { 360*afc2ba1dSToomas Soome system->vmList = system->vmList->link; 361*afc2ba1dSToomas Soome } else 362*afc2ba1dSToomas Soome for (; pList != NULL; pList = pList->link) { 363*afc2ba1dSToomas Soome if (pList->link == vm) { 364*afc2ba1dSToomas Soome pList->link = vm->link; 365*afc2ba1dSToomas Soome break; 366*afc2ba1dSToomas Soome } 367*afc2ba1dSToomas Soome } 368*afc2ba1dSToomas Soome 369*afc2ba1dSToomas Soome if (pList) 370*afc2ba1dSToomas Soome ficlVmDestroy(vm); 371*afc2ba1dSToomas Soome } 372*afc2ba1dSToomas Soome 373*afc2ba1dSToomas Soome /* 374*afc2ba1dSToomas Soome * f i c l L o o k u p 375*afc2ba1dSToomas Soome * Look in the system dictionary for a match to the given name. If 376*afc2ba1dSToomas Soome * found, return the address of the corresponding ficlWord. Otherwise 377*afc2ba1dSToomas Soome * return NULL. 378*afc2ba1dSToomas Soome */ 379*afc2ba1dSToomas Soome ficlWord * 380*afc2ba1dSToomas Soome ficlSystemLookup(ficlSystem *system, char *name) 381*afc2ba1dSToomas Soome { 382*afc2ba1dSToomas Soome ficlString s; 383*afc2ba1dSToomas Soome FICL_STRING_SET_FROM_CSTRING(s, name); 384*afc2ba1dSToomas Soome return (ficlDictionaryLookup(system->dictionary, s)); 385*afc2ba1dSToomas Soome } 386*afc2ba1dSToomas Soome 387*afc2ba1dSToomas Soome /* 388*afc2ba1dSToomas Soome * f i c l G e t D i c t 389*afc2ba1dSToomas Soome * Returns the address of the system dictionary 390*afc2ba1dSToomas Soome */ 391*afc2ba1dSToomas Soome ficlDictionary * 392*afc2ba1dSToomas Soome ficlSystemGetDictionary(ficlSystem *system) 393*afc2ba1dSToomas Soome { 394*afc2ba1dSToomas Soome return (system->dictionary); 395*afc2ba1dSToomas Soome } 396*afc2ba1dSToomas Soome 397*afc2ba1dSToomas Soome /* 398*afc2ba1dSToomas Soome * f i c l G e t E n v 399*afc2ba1dSToomas Soome * Returns the address of the system environment space 400*afc2ba1dSToomas Soome */ 401*afc2ba1dSToomas Soome ficlDictionary * 402*afc2ba1dSToomas Soome ficlSystemGetEnvironment(ficlSystem *system) 403*afc2ba1dSToomas Soome { 404*afc2ba1dSToomas Soome return (system->environment); 405*afc2ba1dSToomas Soome } 406*afc2ba1dSToomas Soome 407*afc2ba1dSToomas Soome /* 408*afc2ba1dSToomas Soome * f i c l G e t L o c 409*afc2ba1dSToomas Soome * Returns the address of the system locals dictionary. This dictionary is 410*afc2ba1dSToomas Soome * only used during compilation, and is shared by all VMs. 411*afc2ba1dSToomas Soome */ 412*afc2ba1dSToomas Soome #if FICL_WANT_LOCALS 413*afc2ba1dSToomas Soome ficlDictionary * 414*afc2ba1dSToomas Soome ficlSystemGetLocals(ficlSystem *system) 415*afc2ba1dSToomas Soome { 416*afc2ba1dSToomas Soome return (system->locals); 417*afc2ba1dSToomas Soome } 418*afc2ba1dSToomas Soome #endif 419*afc2ba1dSToomas Soome 420*afc2ba1dSToomas Soome /* 421*afc2ba1dSToomas Soome * f i c l L o o k u p L o c 422*afc2ba1dSToomas Soome * Same as dictLookup, but looks in system locals dictionary first... 423*afc2ba1dSToomas Soome * Assumes locals dictionary has only one wordlist... 424*afc2ba1dSToomas Soome */ 425*afc2ba1dSToomas Soome #if FICL_WANT_LOCALS 426*afc2ba1dSToomas Soome ficlWord * 427*afc2ba1dSToomas Soome ficlSystemLookupLocal(ficlSystem *system, ficlString name) 428*afc2ba1dSToomas Soome { 429*afc2ba1dSToomas Soome ficlWord *word = NULL; 430*afc2ba1dSToomas Soome ficlDictionary *dictionary = system->dictionary; 431*afc2ba1dSToomas Soome ficlHash *hash = ficlSystemGetLocals(system)->forthWordlist; 432*afc2ba1dSToomas Soome int i; 433*afc2ba1dSToomas Soome ficlUnsigned16 hashCode = ficlHashCode(name); 434*afc2ba1dSToomas Soome 435*afc2ba1dSToomas Soome FICL_SYSTEM_ASSERT(system, hash); 436*afc2ba1dSToomas Soome FICL_SYSTEM_ASSERT(system, dictionary); 437*afc2ba1dSToomas Soome 438*afc2ba1dSToomas Soome ficlDictionaryLock(dictionary, FICL_TRUE); 439*afc2ba1dSToomas Soome /* 440*afc2ba1dSToomas Soome * check the locals dictionary first... 441*afc2ba1dSToomas Soome */ 442*afc2ba1dSToomas Soome word = ficlHashLookup(hash, name, hashCode); 443*afc2ba1dSToomas Soome 444*afc2ba1dSToomas Soome /* 445*afc2ba1dSToomas Soome * If no joy, (!word) ------------------------------v 446*afc2ba1dSToomas Soome * iterate over the search list in the main dictionary 447*afc2ba1dSToomas Soome */ 448*afc2ba1dSToomas Soome for (i = (int)dictionary->wordlistCount - 1; (i >= 0) && (!word); --i) { 449*afc2ba1dSToomas Soome hash = dictionary->wordlists[i]; 450*afc2ba1dSToomas Soome word = ficlHashLookup(hash, name, hashCode); 451*afc2ba1dSToomas Soome } 452*afc2ba1dSToomas Soome 453*afc2ba1dSToomas Soome ficlDictionaryLock(dictionary, FICL_FALSE); 454*afc2ba1dSToomas Soome return (word); 455*afc2ba1dSToomas Soome } 456*afc2ba1dSToomas Soome #endif 457