/**************************************************************************
d i c t C o p y N a m e
** Copy up to nFICLNAME characters of the name specified by si 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"
**************************************************************************/
static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si)
{
char *oldCP = (char *)pDict->here;
char *cp = oldCP;
char *name = SI_PTR(si);
int i = SI_COUNT(si);
if (i == 0)
{
dictAlign(pDict);
return (char *)pDict->here;
}
if (i > nFICLNAME)
i = nFICLNAME;
for (; i > 0; --i)
{
*cp++ = *name++;
}
*cp++ = '\0';
pDict->here = PTRtoCELL cp;
dictAlign(pDict);
return oldCP;
}
static void tempBase(FICL_VM *pVM, int base)
{
int oldbase = pVM->base;
STRINGINFO si = vmGetWord0(pVM);
pVM->base = base;
if (!ficlParseNumber(pVM, si))
{
int i = SI_COUNT(si);
vmThrowErr(pVM, "%.*s not recognized", i, SI_PTR(si));
}
pVM->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 corrseponding
** code against the remainder of the word and returns true.
**************************************************************************/
int ficlParsePrefix(FICL_VM *pVM, STRINGINFO si)
{
int i;
FICL_HASH *pHash;
FICL_WORD *pFW = ficlLookup(pVM->pSys, 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 (!pFW)
return FICL_FALSE;
pHash = (FICL_HASH *)(pFW->param[0].p);
/*
** Walk the list looking for a match with the beginning of the incoming token
*/
for (i = 0; i < (int)pHash->size; i++)
{
pFW = pHash->table[i];
while (pFW != NULL)
{
int n;
n = pFW->nName;
/*
** If we find a match, adjust the TIB to give back the non-prefix characters
** and execute the prefix word.
*/
if (!strincmp(SI_PTR(si), pFW->name, (FICL_UNS)n))
{
/* (sadler) fixed off-by-one error when the token has no trailing space in the TIB */
vmSetTibIndex(pVM, si.cp + n - pVM->tib.cp );
vmExecute(pVM, pFW);
return (int)FICL_TRUE;
}
pFW = pFW->link;
}
}
return FICL_FALSE;
}
/**************************************************************************
f i c l P a r s e F l o a t N u m b e r
** pVM -- Virtual Machine pointer.
** si -- String to parse.
** Returns 1 if successful, 0 if not.
**************************************************************************/
int ficlParseFloatNumber( FICL_VM *pVM, STRINGINFO si )
{
unsigned char ch, digit;
char *cp;
FICL_COUNT count;
float power;
float accum = 0.0f;
float mant = 0.1f;
FICL_INT exponent = 0;
char flag = 0;
FloatParseState estate = FPS_START;
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 0, 1);
#endif
/*
** floating point numbers only allowed in base 10
*/
if (pVM->base != 10)
return(0);
cp = SI_PTR(si);
count = (FICL_COUNT)SI_COUNT(si);
/* Loop through the string's characters. */
while ((count--) && ((ch = *cp++) != 0))
{
switch (estate)
{
/* At start of the number so look for a sign. */
case FPS_START:
{
estate = FPS_ININT;
if (ch == '-')
{
flag |= NUMISNEG;
break;
}
if (ch == '+')
{
break;
}
} /* Note! Drop through to FPS_ININT */
/*
**Converting integer part of number.
** Only allow digits, decimal and 'E'.
*/
case FPS_ININT:
{
if (ch == '.')
{
estate = FPS_INMANT;
}
else if ((ch == 'e') || (ch == 'E'))
{
estate = FPS_STARTEXP;
}
else
{
digit = (unsigned char)(ch - '0');
if (digit > 9)
return(0);
accum = accum * 10 + digit;
}
break;
}
/*
** Processing the fraction part of number.
** Only allow digits and 'E'
*/
case FPS_INMANT:
{
if ((ch == 'e') || (ch == 'E'))
{
estate = FPS_STARTEXP;
}
else
{
digit = (unsigned char)(ch - '0');
if (digit > 9)
return(0);
accum += digit * mant;
mant *= 0.1f;
}
break;
}
/* Start processing the exponent part of number. */
/* Look for sign. */
case FPS_STARTEXP:
{
estate = FPS_INEXP;
if (ch == '-')
{
flag |= EXPISNEG;
break;
}
else if (ch == '+')
{
break;
}
} /* Note! Drop through to FPS_INEXP */
/*
** Processing the exponent part of number.
** Only allow digits.
*/
case FPS_INEXP:
{
digit = (unsigned char)(ch - '0');
if (digit > 9)
return(0);
exponent = exponent * 10 + digit;
break;
}
}
}
/* If parser never made it to the exponent this is not a float. */
if (estate < FPS_STARTEXP)
return(0);
/* Set the sign of the number. */
if (flag & NUMISNEG)
accum = -accum;
/* If exponent is not 0 then adjust number by it. */
if (exponent != 0)
{
/* Determine if exponent is negative. */
if (flag & EXPISNEG)
{
exponent = -exponent;
}
/* power = 10^x */
power = (float)pow(10.0, exponent);
accum *= power;
}
PUSHFLOAT(accum);
if (pVM->state == COMPILE)
fliteralIm(pVM);
return(1);
}
