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