xref: /illumos-gate/usr/src/common/ficl/float.c (revision c0bb4f73)
1afc2ba1dSToomas Soome /*
2afc2ba1dSToomas Soome  * f l o a t . c
3afc2ba1dSToomas Soome  * Forth Inspired Command Language
4afc2ba1dSToomas Soome  * ANS Forth FLOAT word-set written in C
5afc2ba1dSToomas Soome  * Author: Guy Carver & John Sadler (john_sadler@alum.mit.edu)
6afc2ba1dSToomas Soome  * Created: Apr 2001
7afc2ba1dSToomas Soome  * $Id: float.c,v 1.10 2010/09/13 18:43:04 asau Exp $
8afc2ba1dSToomas Soome  */
9afc2ba1dSToomas Soome /*
10afc2ba1dSToomas Soome  * Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
11afc2ba1dSToomas Soome  * All rights reserved.
12afc2ba1dSToomas Soome  *
13afc2ba1dSToomas Soome  * Get the latest Ficl release at http://ficl.sourceforge.net
14afc2ba1dSToomas Soome  *
15afc2ba1dSToomas Soome  * I am interested in hearing from anyone who uses Ficl. If you have
16afc2ba1dSToomas Soome  * a problem, a success story, a defect, an enhancement request, or
17afc2ba1dSToomas Soome  * if you would like to contribute to the Ficl release, please
18afc2ba1dSToomas Soome  * contact me by email at the address above.
19afc2ba1dSToomas Soome  *
20afc2ba1dSToomas Soome  * L I C E N S E  and  D I S C L A I M E R
21afc2ba1dSToomas Soome  *
22afc2ba1dSToomas Soome  * Redistribution and use in source and binary forms, with or without
23afc2ba1dSToomas Soome  * modification, are permitted provided that the following conditions
24afc2ba1dSToomas Soome  * are met:
25afc2ba1dSToomas Soome  * 1. Redistributions of source code must retain the above copyright
26afc2ba1dSToomas Soome  *    notice, this list of conditions and the following disclaimer.
27afc2ba1dSToomas Soome  * 2. Redistributions in binary form must reproduce the above copyright
28afc2ba1dSToomas Soome  *    notice, this list of conditions and the following disclaimer in the
29afc2ba1dSToomas Soome  *    documentation and/or other materials provided with the distribution.
30afc2ba1dSToomas Soome  *
31afc2ba1dSToomas Soome  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
32afc2ba1dSToomas Soome  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
33afc2ba1dSToomas Soome  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
34afc2ba1dSToomas Soome  * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
35afc2ba1dSToomas Soome  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
36afc2ba1dSToomas Soome  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
37afc2ba1dSToomas Soome  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
38afc2ba1dSToomas Soome  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
39afc2ba1dSToomas Soome  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
40afc2ba1dSToomas Soome  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
41afc2ba1dSToomas Soome  * SUCH DAMAGE.
42afc2ba1dSToomas Soome  */
43afc2ba1dSToomas Soome 
44afc2ba1dSToomas Soome #include "ficl.h"
45afc2ba1dSToomas Soome 
46afc2ba1dSToomas Soome #if FICL_WANT_FLOAT
47afc2ba1dSToomas Soome #include <math.h>
48afc2ba1dSToomas Soome #include <values.h>
49afc2ba1dSToomas Soome 
50afc2ba1dSToomas Soome 
51afc2ba1dSToomas Soome /*
52afc2ba1dSToomas Soome  * Create a floating point constant.
53afc2ba1dSToomas Soome  * fconstant ( r -"name"- )
54afc2ba1dSToomas Soome  */
55afc2ba1dSToomas Soome static void
ficlPrimitiveFConstant(ficlVm * vm)56afc2ba1dSToomas Soome ficlPrimitiveFConstant(ficlVm *vm)
57afc2ba1dSToomas Soome {
58afc2ba1dSToomas Soome 	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
59afc2ba1dSToomas Soome 	ficlString name = ficlVmGetWord(vm);
60afc2ba1dSToomas Soome 
61afc2ba1dSToomas Soome 	FICL_STACK_CHECK(vm->floatStack, 1, 0);
62afc2ba1dSToomas Soome 
63*c0bb4f73SToomas Soome 	(void) ficlDictionaryAppendWord(dictionary, name,
64afc2ba1dSToomas Soome 	    (ficlPrimitive)ficlInstructionFConstantParen, FICL_WORD_DEFAULT);
65afc2ba1dSToomas Soome 	ficlDictionaryAppendCell(dictionary, ficlStackPop(vm->floatStack));
66afc2ba1dSToomas Soome }
67afc2ba1dSToomas Soome 
68afc2ba1dSToomas Soome 
69afc2ba1dSToomas Soome ficlWord *
ficlDictionaryAppendFConstant(ficlDictionary * dictionary,char * name,ficlFloat value)70afc2ba1dSToomas Soome ficlDictionaryAppendFConstant(ficlDictionary *dictionary, char *name,
71afc2ba1dSToomas Soome     ficlFloat value)
72afc2ba1dSToomas Soome {
73afc2ba1dSToomas Soome 	ficlString s;
74afc2ba1dSToomas Soome 	FICL_STRING_SET_FROM_CSTRING(s, name);
75afc2ba1dSToomas Soome 	return (ficlDictionaryAppendConstantInstruction(dictionary, s,
76afc2ba1dSToomas Soome 	    ficlInstructionFConstantParen, *(ficlInteger *)(&value)));
77afc2ba1dSToomas Soome }
78afc2ba1dSToomas Soome 
79afc2ba1dSToomas Soome 
80afc2ba1dSToomas Soome ficlWord *
ficlDictionarySetFConstant(ficlDictionary * dictionary,char * name,ficlFloat value)81afc2ba1dSToomas Soome ficlDictionarySetFConstant(ficlDictionary *dictionary, char *name,
82afc2ba1dSToomas Soome     ficlFloat value)
83afc2ba1dSToomas Soome {
84afc2ba1dSToomas Soome 	ficlString s;
85afc2ba1dSToomas Soome 	FICL_STRING_SET_FROM_CSTRING(s, name);
86afc2ba1dSToomas Soome 	return (ficlDictionarySetConstantInstruction(dictionary, s,
87afc2ba1dSToomas Soome 	    ficlInstructionFConstantParen, *(ficlInteger *)(&value)));
88afc2ba1dSToomas Soome }
89afc2ba1dSToomas Soome 
90afc2ba1dSToomas Soome 
91afc2ba1dSToomas Soome 
92afc2ba1dSToomas Soome 
93afc2ba1dSToomas Soome static void
ficlPrimitiveF2Constant(ficlVm * vm)94afc2ba1dSToomas Soome ficlPrimitiveF2Constant(ficlVm *vm)
95afc2ba1dSToomas Soome {
96afc2ba1dSToomas Soome 	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
97afc2ba1dSToomas Soome 	ficlString name = ficlVmGetWord(vm);
98afc2ba1dSToomas Soome 
99afc2ba1dSToomas Soome 	FICL_STACK_CHECK(vm->floatStack, 2, 0);
100afc2ba1dSToomas Soome 
101*c0bb4f73SToomas Soome 	(void) ficlDictionaryAppendWord(dictionary, name,
102afc2ba1dSToomas Soome 	    (ficlPrimitive)ficlInstructionF2ConstantParen, FICL_WORD_DEFAULT);
103afc2ba1dSToomas Soome 	ficlDictionaryAppendCell(dictionary, ficlStackPop(vm->floatStack));
104afc2ba1dSToomas Soome 	ficlDictionaryAppendCell(dictionary, ficlStackPop(vm->floatStack));
105afc2ba1dSToomas Soome }
106afc2ba1dSToomas Soome 
107afc2ba1dSToomas Soome ficlWord *
ficlDictionaryAppendF2Constant(ficlDictionary * dictionary,char * name,ficlFloat value)108afc2ba1dSToomas Soome ficlDictionaryAppendF2Constant(ficlDictionary *dictionary, char *name,
109afc2ba1dSToomas Soome     ficlFloat value)
110afc2ba1dSToomas Soome {
111afc2ba1dSToomas Soome 	ficlString s;
112afc2ba1dSToomas Soome 	FICL_STRING_SET_FROM_CSTRING(s, name);
113afc2ba1dSToomas Soome 	return (ficlDictionaryAppend2ConstantInstruction(dictionary, s,
114afc2ba1dSToomas Soome 	    ficlInstructionF2ConstantParen, *(ficl2Integer *)(&value)));
115afc2ba1dSToomas Soome }
116afc2ba1dSToomas Soome 
117afc2ba1dSToomas Soome ficlWord *
ficlDictionarySetF2Constant(ficlDictionary * dictionary,char * name,ficlFloat value)118afc2ba1dSToomas Soome ficlDictionarySetF2Constant(ficlDictionary *dictionary, char *name,
119afc2ba1dSToomas Soome     ficlFloat value)
120afc2ba1dSToomas Soome {
121afc2ba1dSToomas Soome 	ficlString s;
122afc2ba1dSToomas Soome 	FICL_STRING_SET_FROM_CSTRING(s, name);
123afc2ba1dSToomas Soome 	return (ficlDictionarySet2ConstantInstruction(dictionary, s,
124afc2ba1dSToomas Soome 	    ficlInstructionF2ConstantParen, *(ficl2Integer *)(&value)));
125afc2ba1dSToomas Soome }
126afc2ba1dSToomas Soome 
127afc2ba1dSToomas Soome /*
128afc2ba1dSToomas Soome  * Display a float in decimal format.
129afc2ba1dSToomas Soome  * f. ( r -- )
130afc2ba1dSToomas Soome  */
131afc2ba1dSToomas Soome static void
ficlPrimitiveFDot(ficlVm * vm)132afc2ba1dSToomas Soome ficlPrimitiveFDot(ficlVm *vm)
133afc2ba1dSToomas Soome {
134afc2ba1dSToomas Soome 	ficlFloat f;
135afc2ba1dSToomas Soome 
136afc2ba1dSToomas Soome 	FICL_STACK_CHECK(vm->floatStack, 1, 0);
137afc2ba1dSToomas Soome 
138afc2ba1dSToomas Soome 	f = ficlStackPopFloat(vm->floatStack);
139*c0bb4f73SToomas Soome 	(void) sprintf(vm->pad, "%#f ", f);
140afc2ba1dSToomas Soome 	ficlVmTextOut(vm, vm->pad);
141afc2ba1dSToomas Soome }
142afc2ba1dSToomas Soome 
143afc2ba1dSToomas Soome /*
144afc2ba1dSToomas Soome  * Display a float in engineering format.
145afc2ba1dSToomas Soome  * fe. ( r -- )
146afc2ba1dSToomas Soome  */
147afc2ba1dSToomas Soome static void
ficlPrimitiveEDot(ficlVm * vm)148afc2ba1dSToomas Soome ficlPrimitiveEDot(ficlVm *vm)
149afc2ba1dSToomas Soome {
150afc2ba1dSToomas Soome 	ficlFloat f;
151afc2ba1dSToomas Soome 
152afc2ba1dSToomas Soome 	FICL_STACK_CHECK(vm->floatStack, 1, 0);
153afc2ba1dSToomas Soome 
154afc2ba1dSToomas Soome 	f = ficlStackPopFloat(vm->floatStack);
155*c0bb4f73SToomas Soome 	(void) sprintf(vm->pad, "%#e ", f);
156afc2ba1dSToomas Soome 	ficlVmTextOut(vm, vm->pad);
157afc2ba1dSToomas Soome }
158afc2ba1dSToomas Soome 
159afc2ba1dSToomas Soome /*
160afc2ba1dSToomas Soome  * d i s p l a y FS t a c k
161afc2ba1dSToomas Soome  * Display the parameter stack (code for "f.s")
162afc2ba1dSToomas Soome  * f.s ( -- )
163afc2ba1dSToomas Soome  */
164afc2ba1dSToomas Soome struct stackContext
165afc2ba1dSToomas Soome {
166afc2ba1dSToomas Soome 	ficlVm *vm;
167afc2ba1dSToomas Soome 	int count;
168afc2ba1dSToomas Soome };
169afc2ba1dSToomas Soome 
170afc2ba1dSToomas Soome static ficlInteger
ficlFloatStackDisplayCallback(void * c,ficlCell * cell)171afc2ba1dSToomas Soome ficlFloatStackDisplayCallback(void *c, ficlCell *cell)
172afc2ba1dSToomas Soome {
173afc2ba1dSToomas Soome 	struct stackContext *context = (struct stackContext *)c;
174afc2ba1dSToomas Soome 	char buffer[80];
175afc2ba1dSToomas Soome #ifdef	_LP64
176*c0bb4f73SToomas Soome 	(void) snprintf(buffer, sizeof (buffer),
177*c0bb4f73SToomas Soome 	    "[0x%016lx %3d] %20e (0x%016lx)\n",
178afc2ba1dSToomas Soome 	    (unsigned long) cell, context->count++, cell->f, cell->u);
179afc2ba1dSToomas Soome #else
180*c0bb4f73SToomas Soome 	(void) snprintf(buffer, sizeof (buffer), "[0x%08x %3d] %12e (0x%08x)\n",
181afc2ba1dSToomas Soome 	    (unsigned)cell, context->count++, cell->f, cell->u);
182afc2ba1dSToomas Soome #endif
183afc2ba1dSToomas Soome 	ficlVmTextOut(context->vm, buffer);
184afc2ba1dSToomas Soome 	return (FICL_TRUE);
185afc2ba1dSToomas Soome }
186afc2ba1dSToomas Soome 
187afc2ba1dSToomas Soome void
ficlVmDisplayFloatStack(ficlVm * vm)188afc2ba1dSToomas Soome ficlVmDisplayFloatStack(ficlVm *vm)
189afc2ba1dSToomas Soome {
190afc2ba1dSToomas Soome 	struct stackContext context;
191afc2ba1dSToomas Soome 	context.vm = vm;
192afc2ba1dSToomas Soome 	context.count = 0;
193afc2ba1dSToomas Soome 	ficlStackDisplay(vm->floatStack, ficlFloatStackDisplayCallback,
194afc2ba1dSToomas Soome 	    &context);
195afc2ba1dSToomas Soome }
196afc2ba1dSToomas Soome 
197afc2ba1dSToomas Soome /*
198afc2ba1dSToomas Soome  * Do float stack depth.
199afc2ba1dSToomas Soome  * fdepth ( -- n )
200afc2ba1dSToomas Soome  */
201afc2ba1dSToomas Soome static void
ficlPrimitiveFDepth(ficlVm * vm)202afc2ba1dSToomas Soome ficlPrimitiveFDepth(ficlVm *vm)
203afc2ba1dSToomas Soome {
204afc2ba1dSToomas Soome 	int i;
205afc2ba1dSToomas Soome 
206afc2ba1dSToomas Soome 	FICL_STACK_CHECK(vm->dataStack, 0, 1);
207afc2ba1dSToomas Soome 
208afc2ba1dSToomas Soome 	i = ficlStackDepth(vm->floatStack);
209afc2ba1dSToomas Soome 	ficlStackPushInteger(vm->dataStack, i);
210afc2ba1dSToomas Soome }
211afc2ba1dSToomas Soome 
212afc2ba1dSToomas Soome /*
213afc2ba1dSToomas Soome  * Compile a floating point literal.
214afc2ba1dSToomas Soome  */
215afc2ba1dSToomas Soome static void
ficlPrimitiveFLiteralImmediate(ficlVm * vm)216afc2ba1dSToomas Soome ficlPrimitiveFLiteralImmediate(ficlVm *vm)
217afc2ba1dSToomas Soome {
218afc2ba1dSToomas Soome 	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
219afc2ba1dSToomas Soome 	ficlCell cell;
220afc2ba1dSToomas Soome 
221afc2ba1dSToomas Soome 	FICL_STACK_CHECK(vm->floatStack, 1, 0);
222afc2ba1dSToomas Soome 
223afc2ba1dSToomas Soome 	cell = ficlStackPop(vm->floatStack);
224afc2ba1dSToomas Soome 	if (cell.f == 1.0f) {
225afc2ba1dSToomas Soome 		ficlDictionaryAppendUnsigned(dictionary, ficlInstructionF1);
226afc2ba1dSToomas Soome 	} else if (cell.f == 0.0f) {
227afc2ba1dSToomas Soome 		ficlDictionaryAppendUnsigned(dictionary, ficlInstructionF0);
228afc2ba1dSToomas Soome 	} else if (cell.f == -1.0f) {
229afc2ba1dSToomas Soome 		ficlDictionaryAppendUnsigned(dictionary, ficlInstructionFNeg1);
230afc2ba1dSToomas Soome 	} else {
231afc2ba1dSToomas Soome 		ficlDictionaryAppendUnsigned(dictionary,
232afc2ba1dSToomas Soome 		    ficlInstructionFLiteralParen);
233afc2ba1dSToomas Soome 		ficlDictionaryAppendCell(dictionary, cell);
234afc2ba1dSToomas Soome 	}
235afc2ba1dSToomas Soome }
236afc2ba1dSToomas Soome 
237afc2ba1dSToomas Soome /*
238afc2ba1dSToomas Soome  * F l o a t P a r s e S t a t e
239afc2ba1dSToomas Soome  * Enum to determine the current segement of a floating point number
240afc2ba1dSToomas Soome  * being parsed.
241afc2ba1dSToomas Soome  */
242afc2ba1dSToomas Soome #define	NUMISNEG	1
243afc2ba1dSToomas Soome #define	EXPISNEG	2
244afc2ba1dSToomas Soome 
245afc2ba1dSToomas Soome typedef enum _floatParseState
246afc2ba1dSToomas Soome {
247afc2ba1dSToomas Soome 	FPS_START,
248afc2ba1dSToomas Soome 	FPS_ININT,
249afc2ba1dSToomas Soome 	FPS_INMANT,
250afc2ba1dSToomas Soome 	FPS_STARTEXP,
251afc2ba1dSToomas Soome 	FPS_INEXP
252afc2ba1dSToomas Soome } FloatParseState;
253afc2ba1dSToomas Soome 
254afc2ba1dSToomas Soome /*
255afc2ba1dSToomas Soome  * f i c l P a r s e F l o a t N u m b e r
256afc2ba1dSToomas Soome  * vm -- Virtual Machine pointer.
257afc2ba1dSToomas Soome  * s -- String to parse.
258afc2ba1dSToomas Soome  * Returns 1 if successful, 0 if not.
259afc2ba1dSToomas Soome  */
260afc2ba1dSToomas Soome int
ficlVmParseFloatNumber(ficlVm * vm,ficlString s)261afc2ba1dSToomas Soome ficlVmParseFloatNumber(ficlVm *vm, ficlString s)
262afc2ba1dSToomas Soome {
263afc2ba1dSToomas Soome 	unsigned char c;
264afc2ba1dSToomas Soome 	unsigned char digit;
265afc2ba1dSToomas Soome 	char *trace;
266afc2ba1dSToomas Soome 	ficlUnsigned length;
267afc2ba1dSToomas Soome 	ficlFloat power;
268afc2ba1dSToomas Soome 	ficlFloat accum = 0.0f;
269afc2ba1dSToomas Soome 	ficlFloat mant = 0.1f;
270afc2ba1dSToomas Soome 	ficlInteger exponent = 0;
271afc2ba1dSToomas Soome 	char flag = 0;
272afc2ba1dSToomas Soome 	FloatParseState estate = FPS_START;
273afc2ba1dSToomas Soome 
274afc2ba1dSToomas Soome 	FICL_STACK_CHECK(vm->floatStack, 0, 1);
275afc2ba1dSToomas Soome 
276afc2ba1dSToomas Soome 	/*
277afc2ba1dSToomas Soome 	 * floating point numbers only allowed in base 10
278afc2ba1dSToomas Soome 	 */
279afc2ba1dSToomas Soome 	if (vm->base != 10)
280afc2ba1dSToomas Soome 		return (0);
281afc2ba1dSToomas Soome 
282afc2ba1dSToomas Soome 	trace = FICL_STRING_GET_POINTER(s);
283afc2ba1dSToomas Soome 	length = FICL_STRING_GET_LENGTH(s);
284afc2ba1dSToomas Soome 
285afc2ba1dSToomas Soome 	/* Loop through the string's characters. */
286afc2ba1dSToomas Soome 	while ((length--) && ((c = *trace++) != 0)) {
287afc2ba1dSToomas Soome 		switch (estate) {
288afc2ba1dSToomas Soome 			/* At start of the number so look for a sign. */
289afc2ba1dSToomas Soome 		case FPS_START:
290afc2ba1dSToomas Soome 			estate = FPS_ININT;
291afc2ba1dSToomas Soome 			if (c == '-') {
292afc2ba1dSToomas Soome 				flag |= NUMISNEG;
293afc2ba1dSToomas Soome 				break;
294afc2ba1dSToomas Soome 			}
295afc2ba1dSToomas Soome 			if (c == '+') {
296afc2ba1dSToomas Soome 				break;
297afc2ba1dSToomas Soome 			}
298d65dfb0aSToomas Soome 			/* FALLTHROUGH */
299afc2ba1dSToomas Soome 		/*
300afc2ba1dSToomas Soome 		 * Converting integer part of number.
301afc2ba1dSToomas Soome 		 * Only allow digits, decimal and 'E'.
302afc2ba1dSToomas Soome 		 */
303afc2ba1dSToomas Soome 		case FPS_ININT:
304afc2ba1dSToomas Soome 			if (c == '.') {
305afc2ba1dSToomas Soome 				estate = FPS_INMANT;
306afc2ba1dSToomas Soome 			} else if ((c == 'e') || (c == 'E')) {
307afc2ba1dSToomas Soome 				estate = FPS_STARTEXP;
308afc2ba1dSToomas Soome 			} else {
309afc2ba1dSToomas Soome 				digit = (unsigned char)(c - '0');
310afc2ba1dSToomas Soome 				if (digit > 9)
311afc2ba1dSToomas Soome 					return (0);
312afc2ba1dSToomas Soome 
313afc2ba1dSToomas Soome 				accum = accum * 10 + digit;
314afc2ba1dSToomas Soome 			}
315afc2ba1dSToomas Soome 		break;
316afc2ba1dSToomas Soome 		/*
317afc2ba1dSToomas Soome 		 * Processing the fraction part of number.
318afc2ba1dSToomas Soome 		 * Only allow digits and 'E'
319afc2ba1dSToomas Soome 		 */
320afc2ba1dSToomas Soome 		case FPS_INMANT:
321afc2ba1dSToomas Soome 			if ((c == 'e') || (c == 'E')) {
322afc2ba1dSToomas Soome 				estate = FPS_STARTEXP;
323afc2ba1dSToomas Soome 			} else {
324afc2ba1dSToomas Soome 				digit = (unsigned char)(c - '0');
325afc2ba1dSToomas Soome 				if (digit > 9)
326afc2ba1dSToomas Soome 					return (0);
327afc2ba1dSToomas Soome 
328afc2ba1dSToomas Soome 				accum += digit * mant;
329afc2ba1dSToomas Soome 				mant *= 0.1f;
330afc2ba1dSToomas Soome 			}
331afc2ba1dSToomas Soome 		break;
332afc2ba1dSToomas Soome 		/* Start processing the exponent part of number. */
333afc2ba1dSToomas Soome 		/* Look for sign. */
334afc2ba1dSToomas Soome 		case FPS_STARTEXP:
335afc2ba1dSToomas Soome 			estate = FPS_INEXP;
336afc2ba1dSToomas Soome 
337afc2ba1dSToomas Soome 			if (c == '-') {
338afc2ba1dSToomas Soome 				flag |= EXPISNEG;
339afc2ba1dSToomas Soome 				break;
340afc2ba1dSToomas Soome 			} else if (c == '+') {
341afc2ba1dSToomas Soome 				break;
342afc2ba1dSToomas Soome 			}
343d65dfb0aSToomas Soome 			/* FALLTHROUGH */
344afc2ba1dSToomas Soome 		/*
345afc2ba1dSToomas Soome 		 * Processing the exponent part of number.
346afc2ba1dSToomas Soome 		 * Only allow digits.
347afc2ba1dSToomas Soome 		 */
348afc2ba1dSToomas Soome 		case FPS_INEXP:
349afc2ba1dSToomas Soome 			digit = (unsigned char)(c - '0');
350afc2ba1dSToomas Soome 			if (digit > 9)
351afc2ba1dSToomas Soome 				return (0);
352afc2ba1dSToomas Soome 
353afc2ba1dSToomas Soome 			exponent = exponent * 10 + digit;
354afc2ba1dSToomas Soome 
355afc2ba1dSToomas Soome 		break;
356afc2ba1dSToomas Soome 		}
357afc2ba1dSToomas Soome 	}
358afc2ba1dSToomas Soome 
359afc2ba1dSToomas Soome 	/* If parser never made it to the exponent this is not a float. */
360afc2ba1dSToomas Soome 	if (estate < FPS_STARTEXP)
361afc2ba1dSToomas Soome 		return (0);
362afc2ba1dSToomas Soome 
363afc2ba1dSToomas Soome 	/* Set the sign of the number. */
364afc2ba1dSToomas Soome 	if (flag & NUMISNEG)
365afc2ba1dSToomas Soome 		accum = -accum;
366afc2ba1dSToomas Soome 
367afc2ba1dSToomas Soome 	/* If exponent is not 0 then adjust number by it. */
368afc2ba1dSToomas Soome 	if (exponent != 0) {
369afc2ba1dSToomas Soome 		/* Determine if exponent is negative. */
370afc2ba1dSToomas Soome 		if (flag & EXPISNEG) {
371afc2ba1dSToomas Soome 			exponent = -exponent;
372afc2ba1dSToomas Soome 		}
373afc2ba1dSToomas Soome 		/* power = 10^x */
374afc2ba1dSToomas Soome #if defined(_LP64)
375afc2ba1dSToomas Soome 		power = (ficlFloat)pow(10.0, exponent);
376afc2ba1dSToomas Soome #else
377afc2ba1dSToomas Soome 		power = (ficlFloat)powf(10.0, exponent);
378afc2ba1dSToomas Soome #endif
379afc2ba1dSToomas Soome 		accum *= power;
380afc2ba1dSToomas Soome 	}
381afc2ba1dSToomas Soome 
382afc2ba1dSToomas Soome 	ficlStackPushFloat(vm->floatStack, accum);
383afc2ba1dSToomas Soome 	if (vm->state == FICL_VM_STATE_COMPILE)
384afc2ba1dSToomas Soome 		ficlPrimitiveFLiteralImmediate(vm);
385afc2ba1dSToomas Soome 
386afc2ba1dSToomas Soome 	return (1);
387afc2ba1dSToomas Soome }
388afc2ba1dSToomas Soome #endif  /* FICL_WANT_FLOAT */
389afc2ba1dSToomas Soome 
390afc2ba1dSToomas Soome #if FICL_WANT_LOCALS
391afc2ba1dSToomas Soome static void
ficlPrimitiveFLocalParen(ficlVm * vm)392afc2ba1dSToomas Soome ficlPrimitiveFLocalParen(ficlVm *vm)
393afc2ba1dSToomas Soome {
394afc2ba1dSToomas Soome 	ficlLocalParen(vm, 0, 1);
395afc2ba1dSToomas Soome }
396afc2ba1dSToomas Soome 
397afc2ba1dSToomas Soome static void
ficlPrimitiveF2LocalParen(ficlVm * vm)398afc2ba1dSToomas Soome ficlPrimitiveF2LocalParen(ficlVm *vm)
399afc2ba1dSToomas Soome {
400afc2ba1dSToomas Soome 	ficlLocalParen(vm, 1, 1);
401afc2ba1dSToomas Soome }
402afc2ba1dSToomas Soome #endif /* FICL_WANT_LOCALS */
403afc2ba1dSToomas Soome 
404afc2ba1dSToomas Soome /*
405afc2ba1dSToomas Soome  * Add float words to a system's dictionary.
406d0b12b66SToomas Soome  * system -- Pointer to the Ficl system to add float words to.
407afc2ba1dSToomas Soome  */
408afc2ba1dSToomas Soome void
ficlSystemCompileFloat(ficlSystem * system)409afc2ba1dSToomas Soome ficlSystemCompileFloat(ficlSystem *system)
410afc2ba1dSToomas Soome {
411afc2ba1dSToomas Soome 	ficlDictionary *dictionary = ficlSystemGetDictionary(system);
412afc2ba1dSToomas Soome 	ficlDictionary *environment = ficlSystemGetEnvironment(system);
413afc2ba1dSToomas Soome #if FICL_WANT_FLOAT
414afc2ba1dSToomas Soome 	ficlCell data;
415afc2ba1dSToomas Soome #endif
416afc2ba1dSToomas Soome 
417afc2ba1dSToomas Soome 	FICL_SYSTEM_ASSERT(system, dictionary);
418afc2ba1dSToomas Soome 	FICL_SYSTEM_ASSERT(system, environment);
419afc2ba1dSToomas Soome 
420afc2ba1dSToomas Soome #if FICL_WANT_LOCALS
421*c0bb4f73SToomas Soome 	(void) ficlDictionarySetPrimitive(dictionary, "(flocal)",
422afc2ba1dSToomas Soome 	    ficlPrimitiveFLocalParen, FICL_WORD_COMPILE_ONLY);
423*c0bb4f73SToomas Soome 	(void) ficlDictionarySetPrimitive(dictionary, "(f2local)",
424afc2ba1dSToomas Soome 	    ficlPrimitiveF2LocalParen, FICL_WORD_COMPILE_ONLY);
425afc2ba1dSToomas Soome #endif /* FICL_WANT_LOCALS */
426afc2ba1dSToomas Soome 
427afc2ba1dSToomas Soome #if FICL_WANT_FLOAT
428*c0bb4f73SToomas Soome 	(void) ficlDictionarySetPrimitive(dictionary, "fconstant",
429afc2ba1dSToomas Soome 	    ficlPrimitiveFConstant, FICL_WORD_DEFAULT);
430*c0bb4f73SToomas Soome 	(void) ficlDictionarySetPrimitive(dictionary, "fvalue",
431afc2ba1dSToomas Soome 	    ficlPrimitiveFConstant, FICL_WORD_DEFAULT);
432*c0bb4f73SToomas Soome 	(void) ficlDictionarySetPrimitive(dictionary, "f2constant",
433afc2ba1dSToomas Soome 	    ficlPrimitiveF2Constant, FICL_WORD_DEFAULT);
434*c0bb4f73SToomas Soome 	(void) ficlDictionarySetPrimitive(dictionary, "f2value",
435afc2ba1dSToomas Soome 	    ficlPrimitiveF2Constant, FICL_WORD_DEFAULT);
436*c0bb4f73SToomas Soome 	(void) ficlDictionarySetPrimitive(dictionary, "fdepth",
437*c0bb4f73SToomas Soome 	    ficlPrimitiveFDepth, FICL_WORD_DEFAULT);
438*c0bb4f73SToomas Soome 	(void) ficlDictionarySetPrimitive(dictionary, "fliteral",
439afc2ba1dSToomas Soome 	    ficlPrimitiveFLiteralImmediate, FICL_WORD_IMMEDIATE);
440*c0bb4f73SToomas Soome 	(void) ficlDictionarySetPrimitive(dictionary, "f.",
441*c0bb4f73SToomas Soome 	    ficlPrimitiveFDot, FICL_WORD_DEFAULT);
442*c0bb4f73SToomas Soome 	(void) ficlDictionarySetPrimitive(dictionary, "f.s",
443*c0bb4f73SToomas Soome 	    ficlVmDisplayFloatStack, FICL_WORD_DEFAULT);
444*c0bb4f73SToomas Soome 	(void) ficlDictionarySetPrimitive(dictionary, "fe.",
445*c0bb4f73SToomas Soome 	    ficlPrimitiveEDot, FICL_WORD_DEFAULT);
446afc2ba1dSToomas Soome 
447afc2ba1dSToomas Soome 	/*
448afc2ba1dSToomas Soome 	 * Missing words:
449afc2ba1dSToomas Soome 	 *
450afc2ba1dSToomas Soome 	 * d>f
451afc2ba1dSToomas Soome 	 * f>d
452afc2ba1dSToomas Soome 	 * falign
453afc2ba1dSToomas Soome 	 * faligned
454afc2ba1dSToomas Soome 	 * float+
455afc2ba1dSToomas Soome 	 * floats
456afc2ba1dSToomas Soome 	 * floor
457afc2ba1dSToomas Soome 	 * fmax
458afc2ba1dSToomas Soome 	 * fmin
459afc2ba1dSToomas Soome 	 */
460afc2ba1dSToomas Soome 
461afc2ba1dSToomas Soome #if defined(_LP64)
462afc2ba1dSToomas Soome 	data.f = MAXDOUBLE;
463afc2ba1dSToomas Soome #else
464afc2ba1dSToomas Soome 	data.f = MAXFLOAT;
465afc2ba1dSToomas Soome #endif
466*c0bb4f73SToomas Soome 	(void) ficlDictionarySetConstant(environment, "max-float", data.i);
467afc2ba1dSToomas Soome 	/* not all required words are present */
468*c0bb4f73SToomas Soome 	(void) ficlDictionarySetConstant(environment, "floating", FICL_FALSE);
469*c0bb4f73SToomas Soome 	(void) ficlDictionarySetConstant(environment, "floating-ext",
470*c0bb4f73SToomas Soome 	    FICL_FALSE);
471*c0bb4f73SToomas Soome 	(void) ficlDictionarySetConstant(environment, "floating-stack",
472afc2ba1dSToomas Soome 	    system->stackSize);
473afc2ba1dSToomas Soome #else
474*c0bb4f73SToomas Soome 	(void) ficlDictionarySetConstant(environment, "floating", FICL_FALSE);
475afc2ba1dSToomas Soome #endif
476afc2ba1dSToomas Soome }
477