usr/src/common/ficl/system.c

   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