[uim-commit] r3085 - in branches/r5rs/sigscheme: . src

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-02-02 09:36:30 -0800 (Thu, 02 Feb 2006)
New Revision: 3085

Modified:
   branches/r5rs/sigscheme/configure.in
   branches/r5rs/sigscheme/src/number.c
   branches/r5rs/sigscheme/src/read.c
   branches/r5rs/sigscheme/src/sigschemeinternal.h
Log:
* sigscheme/configure.in
  - Add strtoll and strtoimax to AC_CHECK_FUNCS
* sigscheme/src/sigschemeinternal.h
  - (scm_string2number): New function decl
* sigscheme/src/number.c
  - (scm_string2number): New function
  - (scm_p_string2number): Fix overflow on LL64
* sigscheme/src/read.c
  - (parse_number): Ditto


Modified: branches/r5rs/sigscheme/configure.in
===================================================================
--- branches/r5rs/sigscheme/configure.in	2006-02-02 16:30:11 UTC (rev 3084)
+++ branches/r5rs/sigscheme/configure.in	2006-02-02 17:36:30 UTC (rev 3085)
@@ -66,6 +66,7 @@
 # AC_REPLACE_FUNCS([snprintf asprintf vasprintf])
 AC_CHECK_FUNCS([strdup strcasecmp \
                 snprintf asprintf vasprintf \
+                strtoll strtoimax \
                 fileno posix_memalign getpagesize])
 
 AX_CHECK_PAGE_ALIGNED_MALLOC

Modified: branches/r5rs/sigscheme/src/number.c
===================================================================
--- branches/r5rs/sigscheme/src/number.c	2006-02-02 16:30:11 UTC (rev 3084)
+++ branches/r5rs/sigscheme/src/number.c	2006-02-02 17:36:30 UTC (rev 3085)
@@ -468,18 +468,14 @@
   return MAKE_STRING_COPYING(p, end - p);
 }
 
-ScmObj
-scm_p_string2number(ScmObj str, ScmObj args)
+scm_int_t
+scm_string2number(const char *str, int radix, scm_bool *err)
 {
     scm_int_t n;
-    int r;
     char *end;
-    const char *c_str;
     scm_bool empty_strp;
-    DECLARE_FUNCTION("string->number", procedure_variadic_1);
+    DECLARE_INTERNAL_FUNCTION("string->number");
 
-    ENSURE_STRING(str);
-
     /* R5RS:
      *
      * - If string is not a syntactically valid notation for a number, then
@@ -503,10 +499,35 @@
      *   #f whenever a decimal point is used.
      */
 
+#if (SIZEOF_SCM_INT_T <= SIZEOF_LONG)
+    n = (scm_int_t)strtol(str, &end, radix);
+#elif (HAVE_STRTOLL && SIZEOF_SCM_INT_T <= SIZEOF_LONG_LONG)
+    n = (scm_int_t)strtoll(str, &end, radix);
+#elif (HAVE_STRTOIMAX && Sizeof_SCM_INT_T <= SIZEOF_INTMAX_T)
+    n = (scm_int_t)strtoimax(str, &end, radix);
+#else
+#error "This platform is not supported"
+#endif
+
+    empty_strp = (end == str);  /* apply the first rule above */
+    *err = (empty_strp || *end);
+    return n;
+}
+
+ScmObj
+scm_p_string2number(ScmObj str, ScmObj args)
+{
+    scm_int_t ret;
+    int r;
+    const char *c_str;
+    scm_bool err;
+    DECLARE_FUNCTION("string->number", procedure_variadic_1);
+
+    ENSURE_STRING(str);
+
     c_str = SCM_STRING_STR(str);
     r = prepare_radix(SCM_MANGLE(name), args);
-    n = (scm_int_t)strtol(c_str, &end, r);
 
-    empty_strp = (end == c_str);  /* apply the first rule above */
-    return (empty_strp || *end) ? SCM_FALSE : MAKE_INT(n);
+    ret = scm_string2number(c_str, r, &err);
+    return (err) ? SCM_FALSE : MAKE_INT(ret);
 }

Modified: branches/r5rs/sigscheme/src/read.c
===================================================================
--- branches/r5rs/sigscheme/src/read.c	2006-02-02 16:30:11 UTC (rev 3084)
+++ branches/r5rs/sigscheme/src/read.c	2006-02-02 17:36:30 UTC (rev 3085)
@@ -946,7 +946,7 @@
 {
     scm_int_t number;
     int radix;
-    char *end;
+    scm_bool err;
     DECLARE_INTERNAL_FUNCTION("read");
 
     switch (prefix) {
@@ -958,12 +958,10 @@
         goto err;
     }
 
-    number = strtol(buf, &end, radix);
-    if (*end)
-        goto err;
+    number = scm_string2number(buf, radix, &err);
+    if (!err)
+        return MAKE_INT(number);
 
-    return MAKE_INT(number);
-
  err:
     ERR("ill-formatted number: #%c%s", (int)prefix, buf);
 }

Modified: branches/r5rs/sigscheme/src/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/src/sigschemeinternal.h	2006-02-02 16:30:11 UTC (rev 3084)
+++ branches/r5rs/sigscheme/src/sigschemeinternal.h	2006-02-02 17:36:30 UTC (rev 3085)
@@ -601,6 +601,9 @@
 scm_int_t scm_finite_length(ScmObj lst);
 scm_int_t scm_length(ScmObj lst);
 
+/* number.c */
+scm_int_t scm_string2number(const char *str, int radix, scm_bool *err);
+
 /* port.c */
 void scm_init_port(void);
 ScmObj scm_prepare_port(ScmObj args, ScmObj default_port);