usr/src/common/ficl/prefix.c

/*
 * p r e f i x . c
 * Forth Inspired Command Language
 * Parser extensions for Ficl
 * Authors: Larry Hastings & John Sadler (john_sadler@alum.mit.edu)
 * Created: April 2001
 * $Id: prefix.c,v 1.8 2010/09/13 18:43:04 asau Exp $
 */
/*
 * Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
 * All rights reserved.
 *
 * Get the latest Ficl release at http://ficl.sourceforge.net
 *
 * I am interested in hearing from anyone who uses Ficl. If you have
 * a problem, a success story, a defect, an enhancement request, or
 * if you would like to contribute to the Ficl release, please
 * contact me by email at the address above.
 *
 * L I C E N S E  and  D I S C L A I M E R
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 */

#include "ficl.h"

/*
 * (jws) revisions:
 * A prefix is a word in a dedicated wordlist (name stored in list_name below)
 * that is searched in a special way by the prefix parse step. When a prefix
 * matches the beginning of an incoming token, push the non-prefix part of the
 * token back onto the input stream and execute the prefix code.
 *
 * The parse step is called ficlParsePrefix.
 * Storing prefix entries in the dictionary greatly simplifies
 * the process of matching and dispatching prefixes, avoids the
 * need to clean up a dynamically allocated prefix list when the system
 * goes away, but still allows prefixes to be allocated at runtime.
 */

static char list_name[] = "<prefixes>";

/*
 * f i c l P a r s e P r e f i x
 * This is the parse step for prefixes - it checks an incoming word
 * to see if it starts with a prefix, and if so runs the corresponding
 * code against the remainder of the word and returns true.
 */
int
ficlVmParsePrefix(ficlVm *vm, ficlString s)
{
	int i;
	ficlHash *hash;
	ficlWord *word = ficlSystemLookup(vm->callback.system, list_name);

	/*
	 * Make sure we found the prefix dictionary - otherwise silently fail
	 * If forth-wordlist is not in the search order, we won't find the
	 * prefixes.
	 */
	if (!word)
		return (0); /* false */

	hash = (ficlHash *)(word->param[0].p);
	/*
	 * Walk the list looking for a match with the beginning of the
	 * incoming token
	 */
	for (i = 0; i < (int)hash->size; i++) {
		word = hash->table[i];
		while (word != NULL) {
			int n;
			n = word->length;
			/*
			 * If we find a match, adjust the TIB to give back
			 * the non-prefix characters and execute the prefix
			 * word.
			 */
			if (!ficlStrincmp(FICL_STRING_GET_POINTER(s),
			    word->name, (ficlUnsigned)n)) {
				/*
				 * (sadler) fixed off-by-one error when the
				 * token has no trailing space in the TIB
				 */
				ficlVmSetTibIndex(vm,
				    s.text + n - vm->tib.text);
				ficlVmExecuteWord(vm, word);

				return (1); /* true */
			}
			word = word->link;
		}
	}

	return (0); /* false */
}

static void
ficlPrimitiveTempBase(ficlVm *vm)
{
	int oldbase = vm->base;
	ficlString number = ficlVmGetWord0(vm);
	int base = ficlStackPopInteger(vm->dataStack);

	vm->base = base;
	if (!ficlVmParseNumber(vm, number))
		ficlVmThrowError(vm, "%.*s not recognized",
		    FICL_STRING_GET_LENGTH(number),
		    FICL_STRING_GET_POINTER(number));

	vm->base = oldbase;
}

/*
 * f i c l C o m p i l e P r e f i x
 * Build prefix support into the dictionary and the parser
 * Note: since prefixes always execute, they are effectively IMMEDIATE.
 * If they need to generate code in compile state you must add
 * this code explicitly.
 */
void
ficlSystemCompilePrefix(ficlSystem *system)
{
	ficlDictionary *dictionary = system->dictionary;
	ficlHash *hash;

	/*
	 * Create a named wordlist for prefixes to reside in...
	 * Since we're doing a special kind of search, make it
	 * a single bucket hashtable - hashing does not help here.
	 */
	hash = ficlDictionaryCreateWordlist(dictionary, 1);
	hash->name = list_name;
	ficlDictionaryAppendConstantPointer(dictionary, list_name, hash);

	/*
	 * Put __tempbase in the forth-wordlist
	 */
	ficlDictionarySetPrimitive(dictionary, "__tempbase",
	    ficlPrimitiveTempBase, FICL_WORD_DEFAULT);

	/*
	 * If you want to add some prefixes at compilation-time, copy this
	 * line to the top of this function:
	 *
	 * ficlHash *oldCompilationWordlist;
	 *
	 * then copy this code to the bottom, just above the return:
	 *
	 *
	 * oldCompilationWordlist = dictionary->compilationWordlist;
	 * dictionary->compilationWordlist = hash;
	 * ficlDictionarySetPrimitive(dictionary, YOUR WORD HERE,
	 * FICL_WORD_DEFAULT);
	 * dictionary->compilationWordlist = oldCompilationWordlist;
	 *
	 * and substitute in your own actual calls to
	 * ficlDictionarySetPrimitive() as needed.
	 *
	 * Or--better yet--do it in your own code, so you don't have
	 * to re-modify the Ficl source code every time we cut a new release!
	 */
}