Index: head/stand/ficl/float.c
===================================================================
--- head/stand/ficl/float.c	(revision 326584)
+++ head/stand/ficl/float.c	(revision 326585)
@@ -1,1067 +1,1067 @@
 /*******************************************************************
 ** f l o a t . c
 ** Forth Inspired Command Language
 ** ANS Forth FLOAT word-set written in C
 ** Author: Guy Carver & John Sadler (john_sadler@alum.mit.edu)
 ** Created: Apr 2001
 ** $Id: float.c,v 1.8 2001/12/05 07:21:34 jsadler 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.
 */
 
 /* $FreeBSD$ */
 
+#include "ficl.h"
+
+#if FICL_WANT_FLOAT
 #include <stdlib.h>
 #include <stdio.h>
 #include <string.h>
 #include <ctype.h>
 #include <math.h>
-#include "ficl.h"
-
-#if FICL_WANT_FLOAT
 
 /*******************************************************************
 ** Do float addition r1 + r2.
 ** f+ ( r1 r2 -- r )
 *******************************************************************/
 static void Fadd(FICL_VM *pVM)
 {
     FICL_FLOAT f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 2, 1);
 #endif
 
     f = POPFLOAT();
     f += GETTOPF().f;
     SETTOPF(f);
 }
 
 /*******************************************************************
 ** Do float subtraction r1 - r2.
 ** f- ( r1 r2 -- r )
 *******************************************************************/
 static void Fsub(FICL_VM *pVM)
 {
     FICL_FLOAT f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 2, 1);
 #endif
 
     f = POPFLOAT();
     f = GETTOPF().f - f;
     SETTOPF(f);
 }
 
 /*******************************************************************
 ** Do float multiplication r1 * r2.
 ** f* ( r1 r2 -- r )
 *******************************************************************/
 static void Fmul(FICL_VM *pVM)
 {
     FICL_FLOAT f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 2, 1);
 #endif
 
     f = POPFLOAT();
     f *= GETTOPF().f;
     SETTOPF(f);
 }
 
 /*******************************************************************
 ** Do float negation.
 ** fnegate ( r -- r )
 *******************************************************************/
 static void Fnegate(FICL_VM *pVM)
 {
     FICL_FLOAT f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 1);
 #endif
 
     f = -GETTOPF().f;
     SETTOPF(f);
 }
 
 /*******************************************************************
 ** Do float division r1 / r2.
 ** f/ ( r1 r2 -- r )
 *******************************************************************/
 static void Fdiv(FICL_VM *pVM)
 {
     FICL_FLOAT f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 2, 1);
 #endif
 
     f = POPFLOAT();
     f = GETTOPF().f / f;
     SETTOPF(f);
 }
 
 /*******************************************************************
 ** Do float + integer r + n.
 ** f+i ( r n -- r )
 *******************************************************************/
 static void Faddi(FICL_VM *pVM)
 {
     FICL_FLOAT f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 1);
     vmCheckStack(pVM, 1, 0);
 #endif
 
     f = (FICL_FLOAT)POPINT();
     f += GETTOPF().f;
     SETTOPF(f);
 }
 
 /*******************************************************************
 ** Do float - integer r - n.
 ** f-i ( r n -- r )
 *******************************************************************/
 static void Fsubi(FICL_VM *pVM)
 {
     FICL_FLOAT f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 1);
     vmCheckStack(pVM, 1, 0);
 #endif
 
     f = GETTOPF().f;
     f -= (FICL_FLOAT)POPINT();
     SETTOPF(f);
 }
 
 /*******************************************************************
 ** Do float * integer r * n.
 ** f*i ( r n -- r )
 *******************************************************************/
 static void Fmuli(FICL_VM *pVM)
 {
     FICL_FLOAT f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 1);
     vmCheckStack(pVM, 1, 0);
 #endif
 
     f = (FICL_FLOAT)POPINT();
     f *= GETTOPF().f;
     SETTOPF(f);
 }
 
 /*******************************************************************
 ** Do float / integer r / n.
 ** f/i ( r n -- r )
 *******************************************************************/
 static void Fdivi(FICL_VM *pVM)
 {
     FICL_FLOAT f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 1);
     vmCheckStack(pVM, 1, 0);
 #endif
 
     f = GETTOPF().f;
     f /= (FICL_FLOAT)POPINT();
     SETTOPF(f);
 }
 
 /*******************************************************************
 ** Do integer - float n - r.
 ** i-f ( n r -- r )
 *******************************************************************/
 static void isubf(FICL_VM *pVM)
 {
     FICL_FLOAT f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 1);
     vmCheckStack(pVM, 1, 0);
 #endif
 
     f = (FICL_FLOAT)POPINT();
     f -= GETTOPF().f;
     SETTOPF(f);
 }
 
 /*******************************************************************
 ** Do integer / float n / r.
 ** i/f ( n r -- r )
 *******************************************************************/
 static void idivf(FICL_VM *pVM)
 {
     FICL_FLOAT f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1,1);
     vmCheckStack(pVM, 1, 0);
 #endif
 
     f = (FICL_FLOAT)POPINT();
     f /= GETTOPF().f;
     SETTOPF(f);
 }
 
 /*******************************************************************
 ** Do integer to float conversion.
 ** int>float ( n -- r )
 *******************************************************************/
 static void itof(FICL_VM *pVM)
 {
     float f;
 
 #if FICL_ROBUST > 1
     vmCheckStack(pVM, 1, 0);
     vmCheckFStack(pVM, 0, 1);
 #endif
 
     f = (float)POPINT();
     PUSHFLOAT(f);
 }
 
 /*******************************************************************
 ** Do float to integer conversion.
 ** float>int ( r -- n )
 *******************************************************************/
 static void Ftoi(FICL_VM *pVM)
 {
     FICL_INT i;
 
 #if FICL_ROBUST > 1
     vmCheckStack(pVM, 0, 1);
     vmCheckFStack(pVM, 1, 0);
 #endif
 
     i = (FICL_INT)POPFLOAT();
     PUSHINT(i);
 }
 
 /*******************************************************************
 ** Floating point constant execution word.
 *******************************************************************/
 void FconstantParen(FICL_VM *pVM)
 {
     FICL_WORD *pFW = pVM->runningWord;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 0, 1);
 #endif
 
     PUSHFLOAT(pFW->param[0].f);
 }
 
 /*******************************************************************
 ** Create a floating point constant.
 ** fconstant ( r -"name"- )
 *******************************************************************/
 static void Fconstant(FICL_VM *pVM)
 {
     FICL_DICT *dp = vmGetDict(pVM);
     STRINGINFO si = vmGetWord(pVM);
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 0);
 #endif
 
     dictAppendWord2(dp, si, FconstantParen, FW_DEFAULT);
     dictAppendCell(dp, stackPop(pVM->fStack));
 }
 
 /*******************************************************************
 ** Display a float in decimal format.
 ** f. ( r -- )
 *******************************************************************/
 static void FDot(FICL_VM *pVM)
 {
     float f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 0);
 #endif
 
     f = POPFLOAT();
     sprintf(pVM->pad,"%#f ",f);
     vmTextOut(pVM, pVM->pad, 0);
 }
 
 /*******************************************************************
 ** Display a float in engineering format.
 ** fe. ( r -- )
 *******************************************************************/
 static void EDot(FICL_VM *pVM)
 {
     float f;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 0);
 #endif
 
     f = POPFLOAT();
     sprintf(pVM->pad,"%#e ",f);
     vmTextOut(pVM, pVM->pad, 0);
 }
 
 /**************************************************************************
                         d i s p l a y FS t a c k
 ** Display the parameter stack (code for "f.s")
 ** f.s ( -- )
 **************************************************************************/
 static void displayFStack(FICL_VM *pVM)
 {
     int d = stackDepth(pVM->fStack);
     int i;
     CELL *pCell;
 
     vmCheckFStack(pVM, 0, 0);
 
     vmTextOut(pVM, "F:", 0);
 
     if (d == 0)
         vmTextOut(pVM, "[0]", 0);
     else
     {
         ltoa(d, &pVM->pad[1], pVM->base);
         pVM->pad[0] = '[';
         strcat(pVM->pad,"] ");
         vmTextOut(pVM,pVM->pad,0);
 
         pCell = pVM->fStack->sp - d;
         for (i = 0; i < d; i++)
         {
             sprintf(pVM->pad,"%#f ",(*pCell++).f);
             vmTextOut(pVM,pVM->pad,0);
         }
     }
 }
 
 /*******************************************************************
 ** Do float stack depth.
 ** fdepth ( -- n )
 *******************************************************************/
 static void Fdepth(FICL_VM *pVM)
 {
     int i;
 
 #if FICL_ROBUST > 1
     vmCheckStack(pVM, 0, 1);
 #endif
 
     i = stackDepth(pVM->fStack);
     PUSHINT(i);
 }
 
 /*******************************************************************
 ** Do float stack drop.
 ** fdrop ( r -- )
 *******************************************************************/
 static void Fdrop(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 0);
 #endif
 
     DROPF(1);
 }
 
 /*******************************************************************
 ** Do float stack 2drop.
 ** f2drop ( r r -- )
 *******************************************************************/
 static void FtwoDrop(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 2, 0);
 #endif
 
     DROPF(2);
 }
 
 /*******************************************************************
 ** Do float stack dup.
 ** fdup ( r -- r r )
 *******************************************************************/
 static void Fdup(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 2);
 #endif
 
     PICKF(0);
 }
 
 /*******************************************************************
 ** Do float stack 2dup.
 ** f2dup ( r1 r2 -- r1 r2 r1 r2 )
 *******************************************************************/
 static void FtwoDup(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 2, 4);
 #endif
 
     PICKF(1);
     PICKF(1);
 }
 
 /*******************************************************************
 ** Do float stack over.
 ** fover ( r1 r2 -- r1 r2 r1 )
 *******************************************************************/
 static void Fover(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 2, 3);
 #endif
 
     PICKF(1);
 }
 
 /*******************************************************************
 ** Do float stack 2over.
 ** f2over ( r1 r2 r3 -- r1 r2 r3 r1 r2 )
 *******************************************************************/
 static void FtwoOver(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 4, 6);
 #endif
 
     PICKF(3);
     PICKF(3);
 }
 
 /*******************************************************************
 ** Do float stack pick.
 ** fpick ( n -- r )
 *******************************************************************/
 static void Fpick(FICL_VM *pVM)
 {
     CELL c = POP();
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, c.i+1, c.i+2);
 #endif
 
     PICKF(c.i);
 }
 
 /*******************************************************************
 ** Do float stack ?dup.
 ** f?dup ( r -- r )
 *******************************************************************/
 static void FquestionDup(FICL_VM *pVM)
 {
     CELL c;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 2);
 #endif
 
     c = GETTOPF();
     if (c.f != 0)
         PICKF(0);
 }
 
 /*******************************************************************
 ** Do float stack roll.
 ** froll ( n -- )
 *******************************************************************/
 static void Froll(FICL_VM *pVM)
 {
     int i = POP().i;
     i = (i > 0) ? i : 0;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, i+1, i+1);
 #endif
 
     ROLLF(i);
 }
 
 /*******************************************************************
 ** Do float stack -roll.
 ** f-roll ( n -- )
 *******************************************************************/
 static void FminusRoll(FICL_VM *pVM)
 {
     int i = POP().i;
     i = (i > 0) ? i : 0;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, i+1, i+1);
 #endif
 
     ROLLF(-i);
 }
 
 /*******************************************************************
 ** Do float stack rot.
 ** frot ( r1 r2 r3  -- r2 r3 r1 )
 *******************************************************************/
 static void Frot(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 3, 3);
 #endif
 
     ROLLF(2);
 }
 
 /*******************************************************************
 ** Do float stack -rot.
 ** f-rot ( r1 r2 r3  -- r3 r1 r2 )
 *******************************************************************/
 static void Fminusrot(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 3, 3);
 #endif
 
     ROLLF(-2);
 }
 
 /*******************************************************************
 ** Do float stack swap.
 ** fswap ( r1 r2 -- r2 r1 )
 *******************************************************************/
 static void Fswap(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 2, 2);
 #endif
 
     ROLLF(1);
 }
 
 /*******************************************************************
 ** Do float stack 2swap
 ** f2swap ( r1 r2 r3 r4  -- r3 r4 r1 r2 )
 *******************************************************************/
 static void FtwoSwap(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 4, 4);
 #endif
 
     ROLLF(3);
     ROLLF(3);
 }
 
 /*******************************************************************
 ** Get a floating point number from a variable.
 ** f@ ( n -- r )
 *******************************************************************/
 static void Ffetch(FICL_VM *pVM)
 {
     CELL *pCell;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 0, 1);
     vmCheckStack(pVM, 1, 0);
 #endif
 
     pCell = (CELL *)POPPTR();
     PUSHFLOAT(pCell->f);
 }
 
 /*******************************************************************
 ** Store a floating point number into a variable.
 ** f! ( r n -- )
 *******************************************************************/
 static void Fstore(FICL_VM *pVM)
 {
     CELL *pCell;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 0);
     vmCheckStack(pVM, 1, 0);
 #endif
 
     pCell = (CELL *)POPPTR();
     pCell->f = POPFLOAT();
 }
 
 /*******************************************************************
 ** Add a floating point number to contents of a variable.
 ** f+! ( r n -- )
 *******************************************************************/
 static void FplusStore(FICL_VM *pVM)
 {
     CELL *pCell;
 
 #if FICL_ROBUST > 1
     vmCheckStack(pVM, 1, 0);
     vmCheckFStack(pVM, 1, 0);
 #endif
 
     pCell = (CELL *)POPPTR();
     pCell->f += POPFLOAT();
 }
 
 /*******************************************************************
 ** Floating point literal execution word.
 *******************************************************************/
 static void fliteralParen(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
     vmCheckStack(pVM, 0, 1);
 #endif
 
     PUSHFLOAT(*(float*)(pVM->ip));
     vmBranchRelative(pVM, 1);
 }
 
 /*******************************************************************
 ** Compile a floating point literal.
 *******************************************************************/
 static void fliteralIm(FICL_VM *pVM)
 {
     FICL_DICT *dp = vmGetDict(pVM);
     FICL_WORD *pfLitParen = ficlLookup(pVM->pSys, "(fliteral)");
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 0);
 #endif
 
     dictAppendCell(dp, LVALUEtoCELL(pfLitParen));
     dictAppendCell(dp, stackPop(pVM->fStack));
 }
 
 /*******************************************************************
 ** Do float 0= comparison r = 0.0.
 ** f0= ( r -- T/F )
 *******************************************************************/
 static void FzeroEquals(FICL_VM *pVM)
 {
     CELL c;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 0);                   /* Make sure something on float stack. */
     vmCheckStack(pVM, 0, 1);                    /* Make sure room for result. */
 #endif
 
     c.i = FICL_BOOL(POPFLOAT() == 0);
     PUSH(c);
 }
 
 /*******************************************************************
 ** Do float 0< comparison r < 0.0.
 ** f0< ( r -- T/F )
 *******************************************************************/
 static void FzeroLess(FICL_VM *pVM)
 {
     CELL c;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 0);                   /* Make sure something on float stack. */
     vmCheckStack(pVM, 0, 1);                    /* Make sure room for result. */
 #endif
 
     c.i = FICL_BOOL(POPFLOAT() < 0);
     PUSH(c);
 }
 
 /*******************************************************************
 ** Do float 0> comparison r > 0.0.
 ** f0> ( r -- T/F )
 *******************************************************************/
 static void FzeroGreater(FICL_VM *pVM)
 {
     CELL c;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 0);
     vmCheckStack(pVM, 0, 1);
 #endif
 
     c.i = FICL_BOOL(POPFLOAT() > 0);
     PUSH(c);
 }
 
 /*******************************************************************
 ** Do float = comparison r1 = r2.
 ** f= ( r1 r2 -- T/F )
 *******************************************************************/
 static void FisEqual(FICL_VM *pVM)
 {
     float x, y;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 2, 0);
     vmCheckStack(pVM, 0, 1);
 #endif
 
     x = POPFLOAT();
     y = POPFLOAT();
     PUSHINT(FICL_BOOL(x == y));
 }
 
 /*******************************************************************
 ** Do float < comparison r1 < r2.
 ** f< ( r1 r2 -- T/F )
 *******************************************************************/
 static void FisLess(FICL_VM *pVM)
 {
     float x, y;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 2, 0);
     vmCheckStack(pVM, 0, 1);
 #endif
 
     y = POPFLOAT();
     x = POPFLOAT();
     PUSHINT(FICL_BOOL(x < y));
 }
 
 /*******************************************************************
 ** Do float > comparison r1 > r2.
 ** f> ( r1 r2 -- T/F )
 *******************************************************************/
 static void FisGreater(FICL_VM *pVM)
 {
     float x, y;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 2, 0);
     vmCheckStack(pVM, 0, 1);
 #endif
 
     y = POPFLOAT();
     x = POPFLOAT();
     PUSHINT(FICL_BOOL(x > y));
 }
 
 
 /*******************************************************************
 ** Move float to param stack (assumes they both fit in a single CELL)
 ** f>s 
 *******************************************************************/
 static void FFrom(FICL_VM *pVM)
 {
     CELL c;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 1, 0);
     vmCheckStack(pVM, 0, 1);
 #endif
 
     c = stackPop(pVM->fStack);
     stackPush(pVM->pStack, c);
     return;
 }
 
 static void ToF(FICL_VM *pVM)
 {
     CELL c;
 
 #if FICL_ROBUST > 1
     vmCheckFStack(pVM, 0, 1);
     vmCheckStack(pVM, 1, 0);
 #endif
 
     c = stackPop(pVM->pStack);
     stackPush(pVM->fStack, c);
     return;
 }
 
 
 /**************************************************************************
                      F l o a t P a r s e S t a t e
 ** Enum to determine the current segement of a floating point number
 ** being parsed.
 **************************************************************************/
 #define NUMISNEG 1
 #define EXPISNEG 2
 
 typedef enum _floatParseState
 {
     FPS_START,
     FPS_ININT,
     FPS_INMANT,
     FPS_STARTEXP,
     FPS_INEXP
 } FloatParseState;
 
 /**************************************************************************
                      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);
 }
 
 #endif  /* FICL_WANT_FLOAT */
 
 /**************************************************************************
 ** Add float words to a system's dictionary.
 ** pSys -- Pointer to the FICL sytem to add float words to.
 **************************************************************************/
 void ficlCompileFloat(FICL_SYSTEM *pSys)
 {
     FICL_DICT *dp = pSys->dp;
     assert(dp);
 
 #if FICL_WANT_FLOAT
     dictAppendWord(dp, ">float",    ToF,            FW_DEFAULT);
     /* d>f */
     dictAppendWord(dp, "f!",        Fstore,         FW_DEFAULT);
     dictAppendWord(dp, "f*",        Fmul,           FW_DEFAULT);
     dictAppendWord(dp, "f+",        Fadd,           FW_DEFAULT);
     dictAppendWord(dp, "f-",        Fsub,           FW_DEFAULT);
     dictAppendWord(dp, "f/",        Fdiv,           FW_DEFAULT);
     dictAppendWord(dp, "f0<",       FzeroLess,      FW_DEFAULT);
     dictAppendWord(dp, "f0=",       FzeroEquals,    FW_DEFAULT);
     dictAppendWord(dp, "f<",        FisLess,        FW_DEFAULT);
  /* 
     f>d 
  */
     dictAppendWord(dp, "f@",        Ffetch,         FW_DEFAULT);
  /* 
     falign 
     faligned 
  */
     dictAppendWord(dp, "fconstant", Fconstant,      FW_DEFAULT);
     dictAppendWord(dp, "fdepth",    Fdepth,         FW_DEFAULT);
     dictAppendWord(dp, "fdrop",     Fdrop,          FW_DEFAULT);
     dictAppendWord(dp, "fdup",      Fdup,           FW_DEFAULT);
     dictAppendWord(dp, "fliteral",  fliteralIm,     FW_IMMEDIATE);
 /*
     float+
     floats
     floor
     fmax
     fmin
 */
     dictAppendWord(dp, "f?dup",     FquestionDup,   FW_DEFAULT);
     dictAppendWord(dp, "f=",        FisEqual,       FW_DEFAULT);
     dictAppendWord(dp, "f>",        FisGreater,     FW_DEFAULT);
     dictAppendWord(dp, "f0>",       FzeroGreater,   FW_DEFAULT);
     dictAppendWord(dp, "f2drop",    FtwoDrop,       FW_DEFAULT);
     dictAppendWord(dp, "f2dup",     FtwoDup,        FW_DEFAULT);
     dictAppendWord(dp, "f2over",    FtwoOver,       FW_DEFAULT);
     dictAppendWord(dp, "f2swap",    FtwoSwap,       FW_DEFAULT);
     dictAppendWord(dp, "f+!",       FplusStore,     FW_DEFAULT);
     dictAppendWord(dp, "f+i",       Faddi,          FW_DEFAULT);
     dictAppendWord(dp, "f-i",       Fsubi,          FW_DEFAULT);
     dictAppendWord(dp, "f*i",       Fmuli,          FW_DEFAULT);
     dictAppendWord(dp, "f/i",       Fdivi,          FW_DEFAULT);
     dictAppendWord(dp, "int>float", itof,           FW_DEFAULT);
     dictAppendWord(dp, "float>int", Ftoi,           FW_DEFAULT);
     dictAppendWord(dp, "f.",        FDot,           FW_DEFAULT);
     dictAppendWord(dp, "f.s",       displayFStack,  FW_DEFAULT);
     dictAppendWord(dp, "fe.",       EDot,           FW_DEFAULT);
     dictAppendWord(dp, "fover",     Fover,          FW_DEFAULT);
     dictAppendWord(dp, "fnegate",   Fnegate,        FW_DEFAULT);
     dictAppendWord(dp, "fpick",     Fpick,          FW_DEFAULT);
     dictAppendWord(dp, "froll",     Froll,          FW_DEFAULT);
     dictAppendWord(dp, "frot",      Frot,           FW_DEFAULT);
     dictAppendWord(dp, "fswap",     Fswap,          FW_DEFAULT);
     dictAppendWord(dp, "i-f",       isubf,          FW_DEFAULT);
     dictAppendWord(dp, "i/f",       idivf,          FW_DEFAULT);
 
     dictAppendWord(dp, "float>",    FFrom,          FW_DEFAULT);
 
     dictAppendWord(dp, "f-roll",    FminusRoll,     FW_DEFAULT);
     dictAppendWord(dp, "f-rot",     Fminusrot,      FW_DEFAULT);
     dictAppendWord(dp, "(fliteral)", fliteralParen, FW_COMPILE);
 
     ficlSetEnv(pSys, "floating",       FICL_FALSE);  /* not all required words are present */
     ficlSetEnv(pSys, "floating-ext",   FICL_FALSE);
     ficlSetEnv(pSys, "floating-stack", FICL_DEFAULT_STACK);
 #endif
     return;
 }