/* * d i c t C o p y N a m e * Copy up to FICL_NAME_LENGTH characters of the name specified by s into * the dictionary starting at "here", then NULL-terminate the name, * point "here" to the next available byte, and return the address of * the beginning of the name. Used by dictAppendWord. * N O T E S : * 1. "here" is guaranteed to be aligned after this operation. * 2. If the string has zero length, align and return "here" */ char * ficlDictionaryAppendString(ficlDictionary *dictionary, ficlString s) { void *data = FICL_STRING_GET_POINTER(s); ficlInteger length = FICL_STRING_GET_LENGTH(s); if (length > FICL_NAME_LENGTH) length = FICL_NAME_LENGTH; return (ficlDictionaryAppendData(dictionary, data, length)); }
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; return; }
/************************************************************************** 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 FICL_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 FICL_TRUE; } word = word->link; } } return FICL_FALSE; }