new function "luaO_str2d" to convert strings to numbers, because

old "lex" algorithm had aproximation errors, but strtod (and atof
and scanf) are too slow.

llex.c

@@ -1,5 +1,5 @@
 /*
-** $Id: llex.c,v 1.24 1998/07/24 18:02:38 roberto Exp roberto $
+** $Id: llex.c,v 1.25 1998/12/03 15:45:15 roberto Exp $
 ** Lexical Analizer
 ** See Copyright Notice in lua.h
 */
@@ -46,7 +46,7 @@ void luaX_init (void)
 
 
 void luaX_syntaxerror (LexState *ls, char *s, char *token) {
-  if (token[0] == 0)
+  if (token[0] == '\0')
     token = "<eof>";
   luaL_verror("%.100s;\n  last token read: `%.50s' at line %d in chunk `%.50s'",
               s, token, ls->linenumber, zname(ls->lex_z));
@@ -54,7 +54,7 @@ void luaX_syntaxerror (LexState *ls, char *s, char *token) {
 
 
 void luaX_error (LexState *ls, char *s) {
-  save(0);
+  save('\0');
   luaX_syntaxerror(ls, s, luaL_buffer());
 }
 
@@ -62,7 +62,7 @@ void luaX_error (LexState *ls, char *s) {
 void luaX_token2str (int token, char *s) {
   if (token < 255) {
     s[0] = token;
-    s[1] = 0;
+    s[1] = '\0';
   }
   else
     strcpy(s, reserved[token-FIRST_RESERVED]);
@@ -221,6 +221,7 @@ static void inclinenumber (LexState *LS)
 }
 
 
+
 /*
 ** =======================================================
 ** LEXICAL ANALIZER
@@ -229,10 +230,7 @@ static void inclinenumber (LexState *LS)
 
 
 
-
-
-static int read_long_string (LexState *LS)
-{
+static int read_long_string (LexState *LS) {
   int cont = 0;
   for (;;) {
     switch (LS->current) {
@@ -262,7 +260,7 @@ static int read_long_string (LexState *LS)
         save_and_next(LS);
     }
   } endloop:
-  save_and_next(LS);  /* pass the second ']' */
+  save_and_next(LS);  /* skip the second ']' */
   LS->seminfo.ts = luaS_newlstr(L->Mbuffbase+2,
                           L->Mbuffnext-(L->Mbuffbase-L->Mbuffer)-4);
   return STRING;
@@ -270,7 +268,6 @@ static int read_long_string (LexState *LS)
 
 
 int luaX_lex (LexState *LS) {
-  double a;
   luaL_resetbuffer();
   for (;;) {
     switch (LS->current) {
@@ -347,7 +344,7 @@ int luaX_lex (LexState *LS) {
                       c = 10*c + (LS->current-'0');
                       next(LS);
                     } while (++i<3 && isdigit(LS->current));
-                    if (c >= 256)
+                    if (c > (unsigned char)c)
                       luaX_error(LS, "escape sequence too large");
                     save(c);
                   }
@@ -382,15 +379,11 @@ int luaX_lex (LexState *LS) {
           else return CONC;   /* .. */
         }
         else if (!isdigit(LS->current)) return '.';
-        /* LS->current is a digit: goes through to number */
-	a=0.0;
-        goto fraction;
+        goto fraction;  /* LS->current is a digit: goes through to number */
 
       case '0': case '1': case '2': case '3': case '4':
       case '5': case '6': case '7': case '8': case '9':
-	a=0.0;
         do {
-          a = 10.0*a + (LS->current-'0');
           save_and_next(LS);
         } while (isdigit(LS->current));
         if (LS->current == '.') {
@@ -402,35 +395,19 @@ int luaX_lex (LexState *LS) {
           }
         }
       fraction:
-	{ double da=0.1;
-	  while (isdigit(LS->current))
-	  {
-            a += (LS->current-'0')*da;
-            da /= 10.0;
-            save_and_next(LS);
-          }
-          if (toupper(LS->current) == 'E') {
-	    int e = 0;
-	    int neg;
-	    double ea;
+        while (isdigit(LS->current))
+          save_and_next(LS);
+        if (toupper(LS->current) == 'E') {
+          save_and_next(LS);  /* read 'E' */
+          save_and_next(LS);  /* read '+', '-' or first digit */
+          while (isdigit(LS->current))
             save_and_next(LS);
-	    neg = (LS->current=='-');
-            if (LS->current == '+' || LS->current == '-') save_and_next(LS);
-            if (!isdigit(LS->current))
-              luaX_error(LS, "invalid numeral format");
-            do {
-              e = 10*e + (LS->current-'0');
-              save_and_next(LS);
-            } while (isdigit(LS->current));
-	    for (ea=neg?0.1:10.0; e>0; e>>=1)
-	    {
-	      if (e & 1) a *= ea;
-	      ea *= ea;
-	    }
-          }
-          LS->seminfo.r = a;
-          return NUMBER;
         }
+        save('\0');
+        LS->seminfo.r = luaO_str2d(L->Mbuffbase);
+        if (LS->seminfo.r < 0)
+          luaX_error(LS, "invalid numeric format");
+        return NUMBER;
 
       case EOZ:
         if (LS->iflevel > 0)
@@ -450,9 +427,9 @@ int luaX_lex (LexState *LS) {
           do {
             save_and_next(LS);
           } while (isalnum(LS->current) || LS->current == '_');
-          save(0);
+          save('\0');
           ts = luaS_new(L->Mbuffbase);
-          if (ts->head.marked >= 'A')
+          if (ts->head.marked >= FIRST_RESERVED)
             return ts->head.marked;  /* reserved word */
           LS->seminfo.ts = ts;
           return NAME;

lobject.c

@@ -1,9 +1,10 @@
 /*
-** $Id: lobject.c,v 1.12 1998/06/18 16:57:03 roberto Exp roberto $
+** $Id: lobject.c,v 1.13 1998/06/19 16:14:09 roberto Exp $
 ** Some generic functions over Lua objects
 ** See Copyright Notice in lua.h
 */
 
+#include <ctype.h>
 #include <stdlib.h>
 
 #include "lobject.h"
@@ -64,20 +65,67 @@ void luaO_insertlist (GCnode *root, GCnode *node)
   node->marked = 0;
 }
 
+
 #ifdef OLD_ANSI
-void luaO_memup (void *dest, void *src, int size)
-{
-  char *d = dest;
-  char *s = src;
-  while (size--) d[size]=s[size];
+void luaO_memup (void *dest, void *src, int size) {
+  while (size--)
+    ((char *)dest)[size]=((char *)src)[size];
 }
 
-void luaO_memdown (void *dest, void *src, int size)
-{
-  char *d = dest;
-  char *s = src;
+void luaO_memdown (void *dest, void *src, int size) {
   int i;
-  for (i=0; i<size; i++) d[i]=s[i];
+  for (i=0; i<size; i++)
+    ((char *)dest)[i]=((char *)src)[i];
 }
 #endif
 
+
+
+static double expten (unsigned int e) {
+  double exp = 10.0;
+  double res = 1.0;
+  for (; e; e>>=1) {
+    if (e & 1) res *= exp;
+    exp *= exp;
+  }
+  return res;
+}
+
+
+double luaO_str2d (char *s) {
+  double a = 0.0;
+  int point = 0;
+  if (!isdigit((unsigned char)*s) && !isdigit((unsigned char)*(s+1)))
+    return -1;  /* no digit before or after decimal point */
+  while (isdigit((unsigned char)*s)) {
+    a = 10.0*a + (*(s++)-'0');
+  }
+  if (*s == '.') s++;
+  while (isdigit((unsigned char)*s)) {
+    a = 10.0*a + (*(s++)-'0');
+    point++;
+  }
+  if (toupper((unsigned char)*s) == 'E') {
+    int e = 0;
+    int sig = 1;
+    s++;
+    if (*s == '+') s++;
+    else if (*s == '-') {
+      s++;
+      sig = -1;
+    }
+    if (!isdigit((unsigned char)*s)) return -1;  /* no digit in expoent part? */
+    do {
+      e = 10*e + (*(s++)-'0');
+    } while (isdigit((unsigned char)*s));
+    point -= sig*e;
+  }
+  while (isspace((unsigned char)*s)) s++;
+  if (*s != '\0') return -1;  /* invalid trailing characters? */
+  if (point > 0)
+    a /= expten(point);
+  else if (point < 0)
+    a *= expten(-point);
+  return a;
+}
+

lobject.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.h,v 1.22 1998/07/12 16:11:55 roberto Exp roberto $
+** $Id: lobject.h,v 1.23 1998/12/01 19:09:47 roberto Exp $
 ** Type definitions for Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -30,7 +30,6 @@
 */
 #ifndef LUA_NUM_TYPE
 #define LUA_NUM_TYPE double
-#define NUMBER_FMT  "%g"
 #endif
 
 
@@ -197,6 +196,7 @@ extern TObject luaO_nilobject;
 int luaO_equalObj (TObject *t1, TObject *t2);
 int luaO_redimension (int oldsize);
 void luaO_insertlist (GCnode *root, GCnode *node);
+double luaO_str2d (char *s);
 
 #ifdef OLD_ANSI
 void luaO_memup (void *dest, void *src, int size);

lvm.c

@@ -1,11 +1,12 @@
 /*
-** $Id: lvm.c,v 1.32 1998/12/03 15:45:15 roberto Exp roberto $
+** $Id: lvm.c,v 1.33 1998/12/24 14:57:23 roberto Exp $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
 
 
 #include <ctype.h>
+#include <limits.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
@@ -15,6 +16,7 @@
 #include "lfunc.h"
 #include "lgc.h"
 #include "lmem.h"
+#include "lobject.h"
 #include "lopcodes.h"
 #include "lstate.h"
 #include "lstring.h"
@@ -26,7 +28,6 @@
 
 #ifdef OLD_ANSI
 #define strcoll(a,b)	strcmp(a,b)
-double strtod();
 #endif
 
 
@@ -40,11 +41,10 @@ double strtod();
 
 
 
-static TaggedString *strconc (TaggedString *l, TaggedString *r)
-{
-  size_t nl = l->u.s.len;
-  size_t nr = r->u.s.len;
-  char *buffer = luaL_openspace(nl+nr+1);
+static TaggedString *strconc (TaggedString *l, TaggedString *r) {
+  long nl = l->u.s.len;
+  long nr = r->u.s.len;
+  char *buffer = luaL_openspace(nl+nr);
   memcpy(buffer, l->str, nl);
   memcpy(buffer+nl, r->str, nr);
   return luaS_newlstr(buffer, nl+nr);
@@ -56,29 +56,36 @@ int luaV_tonumber (TObject *obj) {
   if (ttype(obj) != LUA_T_STRING)
     return 1;
   else {
-    char *e;
-    double t = strtod(svalue(obj), &e);
-    while (isspace(*e)) e++;
-    if (*e != '\0') return 2;
-    nvalue(obj) = (real)t;
+    double t;
+    char *e = svalue(obj);
+    int sig = 1;
+    while (isspace((unsigned char)*e)) e++;
+    if (*e == '+') e++;
+    else if (*e == '-') {
+      e++;
+      sig = -1;
+    }
+    t = luaO_str2d(e);
+    if (t<0) return 2;
+    nvalue(obj) = (real)t*sig;
     ttype(obj) = LUA_T_NUMBER;
     return 0;
   }
 }
 
 
-int luaV_tostring (TObject *obj)
-{ /* LUA_NUMBER */
+int luaV_tostring (TObject *obj) {
+  /* LUA_NUMBER */
   if (ttype(obj) != LUA_T_NUMBER)
     return 1;
   else {
     char s[60];
     real f = nvalue(obj);
-    int i;
-    if ((real)(-MAX_INT) <= f && f <= (real)MAX_INT && (real)(i=(int)f) == f)
-      sprintf (s, "%d", i);
+    long i;
+    if ((real)LONG_MIN <= f && f <= (real)LONG_MAX && (real)(i=(long)f) == f)
+      sprintf(s, "%ld", i);
     else
-      sprintf (s, NUMBER_FMT, nvalue(obj));
+      sprintf(s, "%g", (double)nvalue(obj));
     tsvalue(obj) = luaS_new(s);
     ttype(obj) = LUA_T_STRING;
     return 0;