1 /* 2 * p r e f i x . c 3 * Forth Inspired Command Language 4 * Parser extensions for Ficl 5 * Authors: Larry Hastings & John Sadler (john_sadler@alum.mit.edu) 6 * Created: April 2001 7 * $Id: prefix.c,v 1.8 2010/09/13 18:43:04 asau Exp $ 8 */ 9 /* 10 * Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) 11 * All rights reserved. 12 * 13 * Get the latest Ficl release at http://ficl.sourceforge.net 14 * 15 * I am interested in hearing from anyone who uses Ficl. If you have 16 * a problem, a success story, a defect, an enhancement request, or 17 * if you would like to contribute to the Ficl release, please 18 * contact me by email at the address above. 19 * 20 * L I C E N S E and D I S C L A I M E R 21 * 22 * Redistribution and use in source and binary forms, with or without 23 * modification, are permitted provided that the following conditions 24 * are met: 25 * 1. Redistributions of source code must retain the above copyright 26 * notice, this list of conditions and the following disclaimer. 27 * 2. Redistributions in binary form must reproduce the above copyright 28 * notice, this list of conditions and the following disclaimer in the 29 * documentation and/or other materials provided with the distribution. 30 * 31 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 32 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 33 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 34 * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 35 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 36 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 37 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 38 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 39 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 40 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 41 * SUCH DAMAGE. 42 */ 43 44 #include "ficl.h" 45 46 /* 47 * (jws) revisions: 48 * A prefix is a word in a dedicated wordlist (name stored in list_name below) 49 * that is searched in a special way by the prefix parse step. When a prefix 50 * matches the beginning of an incoming token, push the non-prefix part of the 51 * token back onto the input stream and execute the prefix code. 52 * 53 * The parse step is called ficlParsePrefix. 54 * Storing prefix entries in the dictionary greatly simplifies 55 * the process of matching and dispatching prefixes, avoids the 56 * need to clean up a dynamically allocated prefix list when the system 57 * goes away, but still allows prefixes to be allocated at runtime. 58 */ 59 60 static char list_name[] = "<prefixes>"; 61 62 /* 63 * f i c l P a r s e P r e f i x 64 * This is the parse step for prefixes - it checks an incoming word 65 * to see if it starts with a prefix, and if so runs the corresponding 66 * code against the remainder of the word and returns true. 67 */ 68 int 69 ficlVmParsePrefix(ficlVm *vm, ficlString s) 70 { 71 int i; 72 ficlHash *hash; 73 ficlWord *word = ficlSystemLookup(vm->callback.system, list_name); 74 75 /* 76 * Make sure we found the prefix dictionary - otherwise silently fail 77 * If forth-wordlist is not in the search order, we won't find the 78 * prefixes. 79 */ 80 if (!word) 81 return (0); /* false */ 82 83 hash = (ficlHash *)(word->param[0].p); 84 /* 85 * Walk the list looking for a match with the beginning of the 86 * incoming token 87 */ 88 for (i = 0; i < (int)hash->size; i++) { 89 word = hash->table[i]; 90 while (word != NULL) { 91 int n; 92 n = word->length; 93 /* 94 * If we find a match, adjust the TIB to give back 95 * the non-prefix characters and execute the prefix 96 * word. 97 */ 98 if (!ficlStrincmp(FICL_STRING_GET_POINTER(s), 99 word->name, (ficlUnsigned)n)) { 100 /* 101 * (sadler) fixed off-by-one error when the 102 * token has no trailing space in the TIB 103 */ 104 ficlVmSetTibIndex(vm, 105 s.text + n - vm->tib.text); 106 ficlVmExecuteWord(vm, word); 107 108 return (1); /* true */ 109 } 110 word = word->link; 111 } 112 } 113 114 return (0); /* false */ 115 } 116 117 static void 118 ficlPrimitiveTempBase(ficlVm *vm) 119 { 120 int oldbase = vm->base; 121 ficlString number = ficlVmGetWord0(vm); 122 int base = ficlStackPopInteger(vm->dataStack); 123 124 vm->base = base; 125 if (!ficlVmParseNumber(vm, number)) 126 ficlVmThrowError(vm, "%.*s not recognized", 127 FICL_STRING_GET_LENGTH(number), 128 FICL_STRING_GET_POINTER(number)); 129 130 vm->base = oldbase; 131 } 132 133 /* 134 * f i c l C o m p i l e P r e f i x 135 * Build prefix support into the dictionary and the parser 136 * Note: since prefixes always execute, they are effectively IMMEDIATE. 137 * If they need to generate code in compile state you must add 138 * this code explicitly. 139 */ 140 void 141 ficlSystemCompilePrefix(ficlSystem *system) 142 { 143 ficlDictionary *dictionary = system->dictionary; 144 ficlHash *hash; 145 146 /* 147 * Create a named wordlist for prefixes to reside in... 148 * Since we're doing a special kind of search, make it 149 * a single bucket hashtable - hashing does not help here. 150 */ 151 hash = ficlDictionaryCreateWordlist(dictionary, 1); 152 hash->name = list_name; 153 ficlDictionaryAppendConstantPointer(dictionary, list_name, hash); 154 155 /* 156 * Put __tempbase in the forth-wordlist 157 */ 158 (void) ficlDictionarySetPrimitive(dictionary, "__tempbase", 159 ficlPrimitiveTempBase, FICL_WORD_DEFAULT); 160 161 /* 162 * If you want to add some prefixes at compilation-time, copy this 163 * line to the top of this function: 164 * 165 * ficlHash *oldCompilationWordlist; 166 * 167 * then copy this code to the bottom, just above the return: 168 * 169 * 170 * oldCompilationWordlist = dictionary->compilationWordlist; 171 * dictionary->compilationWordlist = hash; 172 * ficlDictionarySetPrimitive(dictionary, YOUR WORD HERE, 173 * FICL_WORD_DEFAULT); 174 * dictionary->compilationWordlist = oldCompilationWordlist; 175 * 176 * and substitute in your own actual calls to 177 * ficlDictionarySetPrimitive() as needed. 178 * 179 * Or--better yet--do it in your own code, so you don't have 180 * to re-modify the Ficl source code every time we cut a new release! 181 */ 182 } 183