## Floating point error, what's your will?

-----BEGIN PGP SIGNED MESSAGE-----

Hi.

Because I was a bit bored about looking for my calculator all the time
and I'm not willing to use a real calculator program, I wrote a little
tool called line calculator. It takes the given parameter as a formula
and splits it until constant numeric values are reached, putting those
splitted parts into a binary tree-like structure. When all the parsing
is done, it calculates the result. It works fine with lots of formulas
I fed it, e.g. "((800-354)*12+(1200:60))*3" and the like.

Amazingly enough, simple tasks like "1+1+1+1+1+1+1+1+1+1" result in an
error (floating point error). Another ex.: "1*2*3*4*5" works, too, but
"1*2*3*4*5*6*7" results in the same error. 1+1+1+1+...+1 doesn't sound
like a value that exceeds the range of a double, right? :-) So where's
the problem?

- ---LC.PAS(TP7.0 source)---
PROGRAM LINECALCULATOR;

{\$N+}

TYPE SUBFORMULA_LEAF = RECORD
OPERATOR: BYTE;     { 0= Zahlenwert; 1= +; 2= -; 3= *; 4= : }
NUMVALUE: DOUBLE;   { Zahlenwert }
ELEMENTL: WORD;     { Linker Verweis (0=keiner) }
ELEMENTR: WORD;     { Rechter Verweis (0=keiner) }
END;

VAR SUBS: ARRAY [1..128] OF SUBFORMULA_LEAF;
NEXT: WORD;

PROCEDURE GETDEPTH(MINE: STRING; LEAF: WORD);

VAR POSITION: BYTE;
OPERATOR: BYTE;
CURDEPTH: WORD;
PARSEVAL: BYTE;
LINE: STRING;
CODE: INTEGER;

BEGIN
LINE:=MINE;
INC(NEXT);
{ Eventuell ueberfluessige Klammern streichen }
IF LENGTH(LINE)>1 THEN REPEAT
POSITION:=1;
CURDEPTH:=0;
PARSEVAL:=255;
WHILE (POSITION<=LENGTH(LINE)) DO
BEGIN
CASE LINE[POSITION] OF
'(': INC(CURDEPTH);
')': IF CURDEPTH=0 THEN
BEGIN
WRITELN('BRACKET ERROR!');
HALT(1);
END ELSE DEC(CURDEPTH);
ELSE IF CURDEPTH<PARSEVAL THEN PARSEVAL:=CURDEPTH;
END;
INC(POSITION);
END;
IF PARSEVAL>0 THEN LINE:=COPY(LINE,2,LENGTH(LINE)-2);
UNTIL PARSEVAL=0;
{ Nach + oder - suchen }
POSITION:=1;
CURDEPTH:=0;
PARSEVAL:=0;
WHILE (PARSEVAL=0) DO
BEGIN
IF POSITION=LENGTH(LINE) THEN PARSEVAL:=10;
CASE LINE[POSITION] OF
'+': IF CURDEPTH=0 THEN PARSEVAL:=1;
'-': IF CURDEPTH=0 THEN PARSEVAL:=2;
'(': INC(CURDEPTH);
')': IF CURDEPTH=0 THEN
BEGIN
WRITELN('BRACKET ERROR!');
HALT(1);
END ELSE DEC(CURDEPTH);
END;
INC(POSITION);
END;
{ Falls weder + noch -, dann nach * oder : suchen }
IF PARSEVAL>2 THEN
BEGIN
POSITION:=1;
CURDEPTH:=0;
PARSEVAL:=0;
WHILE (PARSEVAL=0) DO
BEGIN
IF POSITION=LENGTH(LINE) THEN PARSEVAL:=10;
CASE LINE[POSITION] OF
'*': IF CURDEPTH=0 THEN PARSEVAL:=3;
':': IF CURDEPTH=0 THEN PARSEVAL:=4;
'(': INC(CURDEPTH);
')': IF CURDEPTH=0 THEN
BEGIN
WRITELN('BRACKET ERROR!');
HALT(1);
END ELSE DEC(CURDEPTH);
END;
INC(POSITION);
END;
END;
{ Konstante eintragen oder Rekursionsfortfuehrung }
IF PARSEVAL=10 THEN
BEGIN
SUBS[LEAF].OPERATOR:=0;
VAL(LINE,SUBS[LEAF].NUMVALUE,CODE);
IF CODE<>0 THEN
BEGIN
WRITELN('FORMULA ERROR!');
HALT(2);
END;
END ELSE BEGIN
SUBS[LEAF].OPERATOR:=PARSEVAL;
SUBS[LEAF].ELEMENTL:=NEXT;
GETDEPTH(COPY(LINE,1,POSITION-2),NEXT);
SUBS[LEAF].ELEMENTR:=NEXT;
GETDEPTH(COPY(LINE,POSITION,LENGTH(LINE)-POSITION+1),NEXT);
END;
END;

FUNCTION CALCULUS(LEAF: WORD): DOUBLE;

BEGIN
IF SUBS[LEAF].OPERATOR=0 THEN
BEGIN
CALCULUS:=SUBS[LEAF].NUMVALUE;
END ELSE BEGIN
CASE SUBS[LEAF].OPERATOR OF
1: CALCULUS:=CALCULUS(SUBS[LEAF].ELEMENTL)+
CALCULUS(SUBS[LEAF].ELEMENTR);
2: CALCULUS:=CALCULUS(SUBS[LEAF].ELEMENTL)-
CALCULUS(SUBS[LEAF].ELEMENTR);
3: CALCULUS:=CALCULUS(SUBS[LEAF].ELEMENTL)*
CALCULUS(SUBS[LEAF].ELEMENTR);
4: CALCULUS:=CALCULUS(SUBS[LEAF].ELEMENTL)/
CALCULUS(SUBS[LEAF].ELEMENTR);
END;
END;
END;

BEGIN
IF PARAMCOUNT=0 THEN WRITELN('USAGE: LC <formula>') ELSE
BEGIN
NEXT:=1;
WRITELN('Ergebnis: ',CALCULUS(1));
END;
END.
- ---

-----BEGIN PGP SIGNATURE-----
Version: 2.6.3i
Charset: latin1
Comment: Requires PGP version 2.6 or later.

iQCVAwUBN00jeVkQ3GlY5HwdAQFgAQQAgbQHfEzF8tf0rRlrzyJobuHm8cXZTuCz
D0pUbUVWai5OH+DHti1dHUS3yzu4dCpYbMHmUhcOocpyjHt/vD5A6V0yTlyn6Zaj
hsVTKg2QsBsbabmVgsORbpfHf7H2hlRaVVQ67Ft7NKeJC/DeowX995mjwXAKbqXb
jRyJUTYtsi0=
=Fe+o
-----END PGP SIGNATURE-----
--
Take care,
Daniel [ http://www.prima.de/home/evocator/ ].