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 ficlDictionarySet2Constant(environment, "ficl-version", combined); 87 ficlDictionarySetConstant(environment, "ficl-robust", FICL_ROBUST); 88 } 89 90 /* 91 * f i c l I n i t S y s t e m 92 * Binds a global dictionary to the interpreter system. 93 * You specify the address and size of the allocated area. 94 * After that, Ficl manages it. 95 * First step is to set up the static pointers to the area. 96 * Then write the "precompiled" portion of the dictionary in. 97 * The dictionary needs to be at least large enough to hold the 98 * precompiled part. Try 1K cells minimum. Use "words" to find 99 * out how much of the dictionary is used at any time. 100 */ 101 ficlSystem * 102 ficlSystemCreate(ficlSystemInformation *fsi) 103 { 104 ficlInteger dictionarySize; 105 ficlInteger environmentSize; 106 ficlInteger stackSize; 107 ficlSystem *system; 108 ficlCallback callback; 109 ficlSystemInformation fauxInfo; 110 ficlDictionary *environment; 111 112 if (fsi == NULL) { 113 fsi = &fauxInfo; 114 ficlSystemInformationInitialize(fsi); 115 } 116 117 callback.context = fsi->context; 118 callback.textOut = fsi->textOut; 119 callback.errorOut = fsi->errorOut; 120 callback.system = NULL; 121 callback.vm = NULL; 122 123 FICL_ASSERT(&callback, sizeof (ficlInteger) >= sizeof (void *)); 124 FICL_ASSERT(&callback, sizeof (ficlUnsigned) >= sizeof (void *)); 125 #if (FICL_WANT_FLOAT) 126 FICL_ASSERT(&callback, sizeof (ficlFloat) <= sizeof (ficlInteger)); 127 #endif 128 129 system = ficlMalloc(sizeof (ficlSystem)); 130 131 FICL_ASSERT(&callback, system); 132 133 memset(system, 0, sizeof (ficlSystem)); 134 135 dictionarySize = fsi->dictionarySize; 136 if (dictionarySize <= 0) 137 dictionarySize = FICL_DEFAULT_DICTIONARY_SIZE; 138 139 environmentSize = fsi->environmentSize; 140 if (environmentSize <= 0) 141 environmentSize = FICL_DEFAULT_ENVIRONMENT_SIZE; 142 143 stackSize = fsi->stackSize; 144 if (stackSize < FICL_DEFAULT_STACK_SIZE) 145 stackSize = FICL_DEFAULT_STACK_SIZE; 146 147 system->dictionary = ficlDictionaryCreateHashed(system, 148 (unsigned)dictionarySize, FICL_HASH_SIZE); 149 system->dictionary->forthWordlist->name = "forth-wordlist"; 150 151 environment = ficlDictionaryCreate(system, (unsigned)environmentSize); 152 system->environment = environment; 153 system->environment->forthWordlist->name = "environment"; 154 155 system->callback.textOut = fsi->textOut; 156 system->callback.errorOut = fsi->errorOut; 157 system->callback.context = fsi->context; 158 system->callback.system = system; 159 system->callback.vm = NULL; 160 system->stackSize = stackSize; 161 162 #if FICL_WANT_LOCALS 163 /* 164 * The locals dictionary is only searched while compiling, 165 * but this is where speed is most important. On the other 166 * hand, the dictionary gets emptied after each use of locals 167 * The need to balance search speed with the cost of the 'empty' 168 * operation led me to select a single-threaded list... 169 */ 170 system->locals = ficlDictionaryCreate(system, 171 (unsigned)FICL_MAX_LOCALS * FICL_CELLS_PER_WORD); 172 #endif /* FICL_WANT_LOCALS */ 173 174 /* 175 * Build the precompiled dictionary and load softwords. We need 176 * a temporary VM to do this - ficlNewVM links one to the head of 177 * the system VM list. ficlCompilePlatform (defined in win32.c, 178 * for example) adds platform specific words. 179 */ 180 ficlSystemCompileCore(system); 181 ficlSystemCompilePrefix(system); 182 183 #if FICL_WANT_FLOAT 184 ficlSystemCompileFloat(system); 185 #endif /* FICL_WANT_FLOAT */ 186 187 #if FICL_WANT_PLATFORM 188 ficlSystemCompilePlatform(system); 189 #endif /* FICL_WANT_PLATFORM */ 190 191 ficlSystemSetVersion(system); 192 193 /* 194 * Establish the parse order. Note that prefixes precede numbers - 195 * this allows constructs like "0b101010" which might parse as a 196 * hex value otherwise. 197 */ 198 ficlSystemAddPrimitiveParseStep(system, "?word", ficlVmParseWord); 199 ficlSystemAddPrimitiveParseStep(system, "?prefix", ficlVmParsePrefix); 200 ficlSystemAddPrimitiveParseStep(system, "?number", ficlVmParseNumber); 201 #if FICL_WANT_FLOAT 202 ficlSystemAddPrimitiveParseStep(system, "?float", 203 ficlVmParseFloatNumber); 204 #endif 205 206 /* 207 * Now create a temporary VM to compile the softwords. Since all VMs 208 * are linked into the vmList of ficlSystem, we don't have to pass 209 * the VM to ficlCompileSoftCore -- it just hijacks whatever it finds 210 * in the VM list. Ficl 2.05: vmCreate no longer depends on the 211 * presence of INTERPRET in the dictionary, so a VM can be created 212 * before the dictionary is built. It just can't do much... 213 */ 214 ficlSystemCreateVm(system); 215 #define ADD_COMPILE_FLAG(name) \ 216 ficlDictionarySetConstant(environment, #name, name) 217 ADD_COMPILE_FLAG(FICL_WANT_LZ4_SOFTCORE); 218 ADD_COMPILE_FLAG(FICL_WANT_FILE); 219 ADD_COMPILE_FLAG(FICL_WANT_FLOAT); 220 ADD_COMPILE_FLAG(FICL_WANT_DEBUGGER); 221 ADD_COMPILE_FLAG(FICL_WANT_EXTENDED_PREFIX); 222 ADD_COMPILE_FLAG(FICL_WANT_USER); 223 ADD_COMPILE_FLAG(FICL_WANT_LOCALS); 224 ADD_COMPILE_FLAG(FICL_WANT_OOP); 225 ADD_COMPILE_FLAG(FICL_WANT_SOFTWORDS); 226 ADD_COMPILE_FLAG(FICL_WANT_MULTITHREADED); 227 ADD_COMPILE_FLAG(FICL_WANT_OPTIMIZE); 228 ADD_COMPILE_FLAG(FICL_WANT_VCALL); 229 230 ADD_COMPILE_FLAG(FICL_PLATFORM_ALIGNMENT); 231 232 ADD_COMPILE_FLAG(FICL_ROBUST); 233 234 #define ADD_COMPILE_STRING(name) \ 235 ficlDictionarySetConstantString(environment, #name, name) 236 ADD_COMPILE_STRING(FICL_PLATFORM_ARCHITECTURE); 237 ADD_COMPILE_STRING(FICL_PLATFORM_OS); 238 239 ficlSystemCompileSoftCore(system); 240 ficlSystemDestroyVm(system->vmList); 241 242 if (ficlSystemGlobal == NULL) 243 ficlSystemGlobal = system; 244 245 return (system); 246 } 247 248 /* 249 * f i c l T e r m S y s t e m 250 * Tear the system down by deleting the dictionaries and all VMs. 251 * This saves you from having to keep track of all that stuff. 252 */ 253 void 254 ficlSystemDestroy(ficlSystem *system) 255 { 256 if (system->dictionary) 257 ficlDictionaryDestroy(system->dictionary); 258 system->dictionary = NULL; 259 260 if (system->environment) 261 ficlDictionaryDestroy(system->environment); 262 system->environment = NULL; 263 264 #if FICL_WANT_LOCALS 265 if (system->locals) 266 ficlDictionaryDestroy(system->locals); 267 system->locals = NULL; 268 #endif 269 270 while (system->vmList != NULL) { 271 ficlVm *vm = system->vmList; 272 system->vmList = system->vmList->link; 273 ficlVmDestroy(vm); 274 } 275 276 if (ficlSystemGlobal == system) 277 ficlSystemGlobal = NULL; 278 279 ficlFree(system); 280 system = NULL; 281 } 282 283 /* 284 * f i c l A d d P a r s e S t e p 285 * Appends a parse step function to the end of the parse list (see 286 * ficlParseStep notes in ficl.h for details). Returns 0 if successful, 287 * nonzero if there's no more room in the list. 288 */ 289 int 290 ficlSystemAddParseStep(ficlSystem *system, ficlWord *word) 291 { 292 int i; 293 for (i = 0; i < FICL_MAX_PARSE_STEPS; i++) { 294 if (system->parseList[i] == NULL) { 295 system->parseList[i] = word; 296 return (0); 297 } 298 } 299 300 return (1); 301 } 302 303 /* 304 * Compile a word into the dictionary that invokes the specified ficlParseStep 305 * function. It is up to the user (as usual in Forth) to make sure the stack 306 * preconditions are valid (there needs to be a counted string on top of the 307 * stack) before using the resulting word. 308 */ 309 void 310 ficlSystemAddPrimitiveParseStep(ficlSystem *system, char *name, 311 ficlParseStep pStep) 312 { 313 ficlDictionary *dictionary = system->dictionary; 314 ficlWord *word; 315 ficlCell c; 316 317 word = ficlDictionaryAppendPrimitive(dictionary, name, 318 ficlPrimitiveParseStepParen, FICL_WORD_DEFAULT); 319 320 c.fn = (void (*)(void))pStep; 321 ficlDictionaryAppendCell(dictionary, c); 322 ficlSystemAddParseStep(system, word); 323 } 324 325 /* 326 * f i c l N e w V M 327 * Create a new virtual machine and link it into the system list 328 * of VMs for later cleanup by ficlTermSystem. 329 */ 330 ficlVm * 331 ficlSystemCreateVm(ficlSystem *system) 332 { 333 ficlVm *vm = ficlVmCreate(NULL, system->stackSize, system->stackSize); 334 vm->link = system->vmList; 335 336 memcpy(&(vm->callback), &(system->callback), sizeof (system->callback)); 337 vm->callback.vm = vm; 338 vm->callback.system = system; 339 340 system->vmList = vm; 341 return (vm); 342 } 343 344 /* 345 * f i c l F r e e V M 346 * Removes the VM in question from the system VM list and deletes the 347 * memory allocated to it. This is an optional call, since ficlTermSystem 348 * will do this cleanup for you. This function is handy if you're going to 349 * do a lot of dynamic creation of VMs. 350 */ 351 void 352 ficlSystemDestroyVm(ficlVm *vm) 353 { 354 ficlSystem *system = vm->callback.system; 355 ficlVm *pList = system->vmList; 356 357 FICL_VM_ASSERT(vm, vm != NULL); 358 359 if (system->vmList == vm) { 360 system->vmList = system->vmList->link; 361 } else 362 for (; pList != NULL; pList = pList->link) { 363 if (pList->link == vm) { 364 pList->link = vm->link; 365 break; 366 } 367 } 368 369 if (pList) 370 ficlVmDestroy(vm); 371 } 372 373 /* 374 * f i c l L o o k u p 375 * Look in the system dictionary for a match to the given name. If 376 * found, return the address of the corresponding ficlWord. Otherwise 377 * return NULL. 378 */ 379 ficlWord * 380 ficlSystemLookup(ficlSystem *system, char *name) 381 { 382 ficlString s; 383 FICL_STRING_SET_FROM_CSTRING(s, name); 384 return (ficlDictionaryLookup(system->dictionary, s)); 385 } 386 387 /* 388 * f i c l G e t D i c t 389 * Returns the address of the system dictionary 390 */ 391 ficlDictionary * 392 ficlSystemGetDictionary(ficlSystem *system) 393 { 394 return (system->dictionary); 395 } 396 397 /* 398 * f i c l G e t E n v 399 * Returns the address of the system environment space 400 */ 401 ficlDictionary * 402 ficlSystemGetEnvironment(ficlSystem *system) 403 { 404 return (system->environment); 405 } 406 407 /* 408 * f i c l G e t L o c 409 * Returns the address of the system locals dictionary. This dictionary is 410 * only used during compilation, and is shared by all VMs. 411 */ 412 #if FICL_WANT_LOCALS 413 ficlDictionary * 414 ficlSystemGetLocals(ficlSystem *system) 415 { 416 return (system->locals); 417 } 418 #endif 419 420 /* 421 * f i c l L o o k u p L o c 422 * Same as dictLookup, but looks in system locals dictionary first... 423 * Assumes locals dictionary has only one wordlist... 424 */ 425 #if FICL_WANT_LOCALS 426 ficlWord * 427 ficlSystemLookupLocal(ficlSystem *system, ficlString name) 428 { 429 ficlWord *word = NULL; 430 ficlDictionary *dictionary = system->dictionary; 431 ficlHash *hash = ficlSystemGetLocals(system)->forthWordlist; 432 int i; 433 ficlUnsigned16 hashCode = ficlHashCode(name); 434 435 FICL_SYSTEM_ASSERT(system, hash); 436 FICL_SYSTEM_ASSERT(system, dictionary); 437 438 ficlDictionaryLock(dictionary, FICL_TRUE); 439 /* 440 * check the locals dictionary first... 441 */ 442 word = ficlHashLookup(hash, name, hashCode); 443 444 /* 445 * If no joy, (!word) ------------------------------v 446 * iterate over the search list in the main dictionary 447 */ 448 for (i = (int)dictionary->wordlistCount - 1; (i >= 0) && (!word); --i) { 449 hash = dictionary->wordlists[i]; 450 word = ficlHashLookup(hash, name, hashCode); 451 } 452 453 ficlDictionaryLock(dictionary, FICL_FALSE); 454 return (word); 455 } 456 #endif 457