sys/boot/ficl/prefix.c

   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.6 2001/12/05 07:21:34 jsadler 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 /*
  45  * $FreeBSD: src/sys/boot/ficl/prefix.c,v 1.3 2002/08/31 01:04:53 scottl Exp $
  46  * $DragonFly: src/sys/boot/ficl/prefix.c,v 1.1 2003/11/10 06:08:33 dillon Exp $
  47  */
  48
  49 #include <string.h>
  50 #include <ctype.h>
  51 #include "ficl.h"
  52 #include "math64.h"
  53
  54 /*
  55 ** (jws) revisions:
  56 ** A prefix is a word in a dedicated wordlist (name stored in list_name below)
  57 ** that is searched in a special way by the prefix parse step. When a prefix
  58 ** matches the beginning of an incoming token, push the non-prefix part of the
  59 ** token back onto the input stream and execute the prefix code.
  60 **
  61 ** The parse step is called ficlParsePrefix.
  62 ** Storing prefix entries in the dictionary greatly simplifies
  63 ** the process of matching and dispatching prefixes, avoids the
  64 ** need to clean up a dynamically allocated prefix list when the system
  65 ** goes away, but still allows prefixes to be allocated at runtime.
  66 */
  67
  68 static char list_name[] = "<prefixes>";
  69
  70 /**************************************************************************
  71                         f i c l P a r s e P r e f i x
  72 ** This is the parse step for prefixes - it checks an incoming word
  73 ** to see if it starts with a prefix, and if so runs the corrseponding
  74 ** code against the remainder of the word and returns true.
  75 **************************************************************************/
  76 int ficlParsePrefix(FICL_VM *pVM, STRINGINFO si)
  77 {
  78     int i;
  79     FICL_HASH *pHash;
  80     FICL_WORD *pFW = ficlLookup(pVM->pSys, list_name);
  81
  82     /*
  83     ** Make sure we found the prefix dictionary - otherwise silently fail
  84     ** If forth-wordlist is not in the search order, we won't find the prefixes.
  85     */
  86     if (!pFW)
  87         return FICL_FALSE;
  88
  89     pHash = (FICL_HASH *)(pFW->param[0].p);
  90     /*
  91     ** Walk the list looking for a match with the beginning of the incoming token
  92     */
  93     for (i = 0; i < (int)pHash->size; i++)
  94     {
  95         pFW = pHash->table[i];
  96         while (pFW != NULL)
  97         {
  98             int n;
  99             n = pFW->nName;
 100             /*
 101             ** If we find a match, adjust the TIB to give back the non-prefix characters
 102             ** and execute the prefix word.
 103             */
 104             if (!strincmp(SI_PTR(si), pFW->name, (FICL_UNS)n))
 105             {
 106                 /* (sadler) fixed off-by-one error when the token has no trailing space in the TIB */
 107                                 vmSetTibIndex(pVM, si.cp + n - pVM->tib.cp );
 108                 vmExecute(pVM, pFW);
 109
 110                 return (int)FICL_TRUE;
 111             }
 112             pFW = pFW->link;
 113         }
 114     }
 115
 116     return FICL_FALSE;
 117 }
 118
 119
 120 static void tempBase(FICL_VM *pVM, int base)
 121 {
 122     int oldbase = pVM->base;
 123     STRINGINFO si = vmGetWord0(pVM);
 124
 125     pVM->base = base;
 126     if (!ficlParseNumber(pVM, si))
 127     {
 128         int i = SI_COUNT(si);
 129         vmThrowErr(pVM, "%.*s not recognized", i, SI_PTR(si));
 130     }
 131
 132     pVM->base = oldbase;
 133     return;
 134 }
 135
 136 static void fTempBase(FICL_VM *pVM)
 137 {
 138     int base = stackPopINT(pVM->pStack);
 139     tempBase(pVM, base);
 140     return;
 141 }
 142
 143 static void prefixHex(FICL_VM *pVM)
 144 {
 145     tempBase(pVM, 16);
 146 }
 147
 148 static void prefixTen(FICL_VM *pVM)
 149 {
 150     tempBase(pVM, 10);
 151 }
 152
 153
 154 /**************************************************************************
 155                         f i c l C o m p i l e P r e f i x
 156 ** Build prefix support into the dictionary and the parser
 157 ** Note: since prefixes always execute, they are effectively IMMEDIATE.
 158 ** If they need to generate code in compile state you must add
 159 ** this code explicitly.
 160 **************************************************************************/
 161 void ficlCompilePrefix(FICL_SYSTEM *pSys)
 162 {
 163     FICL_DICT *dp = pSys->dp;
 164     FICL_HASH *pHash;
 165     FICL_HASH *pPrevCompile = dp->pCompile;
 166 #if (FICL_EXTENDED_PREFIX)
 167     FICL_WORD *pFW;
 168 #endif
 169
 170     /*
 171     ** Create a named wordlist for prefixes to reside in...
 172     ** Since we're doing a special kind of search, make it
 173     ** a single bucket hashtable - hashing does not help here.
 174     */
 175     pHash = dictCreateWordlist(dp, 1);
 176     pHash->name = list_name;
 177     dictAppendWord(dp, list_name, constantParen, FW_DEFAULT);
 178     dictAppendCell(dp, LVALUEtoCELL(pHash));
 179
 180         /*
 181         ** Put __tempbase in the forth-wordlist
 182         */
 183     dictAppendWord(dp, "__tempbase", fTempBase, FW_DEFAULT);
 184
 185     /*
 186     ** Temporarily make the prefix list the compile wordlist so that
 187     ** we can create some precompiled prefixes.
 188     */
 189     dp->pCompile = pHash;
 190     dictAppendWord(dp, "0x", prefixHex, FW_DEFAULT);
 191     dictAppendWord(dp, "0d", prefixTen, FW_DEFAULT);
 192 #if (FICL_EXTENDED_PREFIX)
 193     pFW = ficlLookup(pSys, "\\");
 194     if (pFW)
 195     {
 196         dictAppendWord(dp, "//", pFW->code, FW_DEFAULT);
 197     }
 198 #endif
 199     dp->pCompile = pPrevCompile;
 200
 201     return;
 202 }