[MLton-commit] r4308

Matthew Fluet MLton@mlton.org
Thu, 26 Jan 2006 15:35:31 -0800


Simplified IntInf initialization.
 - eliminated hex representation
 - mutate string rep in place for mpn_set_str

Generalized IntInf initialization to 64-bit case and objptr size.


----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h

----------------------------------------------------------------------

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun	2006-01-26 03:06:35 UTC (rev 4307)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun	2006-01-26 23:35:22 UTC (rev 4308)
@@ -384,6 +384,7 @@
        * WORD8_VECTOR_TYPE_INDEX,
        * WORD16_VECTOR_TYPE_INDEX,
        * WORD32_VECTOR_TYPE_INDEX.
+       * WORD64_VECTOR_TYPE_INDEX.
        *)
       val basic =
          let
@@ -402,7 +403,8 @@
              (PointerTycon.weakGone, WeakGone),
              wordVec 8,
              wordVec 32,
-             wordVec 16]
+             wordVec 16,
+             wordVec 64]
          end
 
       local

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c	2006-01-26 03:06:35 UTC (rev 4307)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c	2006-01-26 23:35:22 UTC (rev 4308)
@@ -17,9 +17,10 @@
   
   total = 0;
   for (i = 0; i < s->intInfInitsLength; ++i) {
+    /* A slight overestimate. */
     numBytes = 
-      sizeof(uint32_t) // for the sign
-      + strlen (s->intInfInits[i].mlstr);
+      sizeof(mp_limb_t) // for the sign
+      + (align(strlen (s->intInfInits[i].mlstr), sizeof(mp_limb_t)));
     total += align (GC_ARRAY_HEADER_SIZE 
                     + numBytes, 
                     s->alignment);
@@ -41,12 +42,11 @@
   struct GC_intInfInit *inits;
   pointer frontier;
   char *str;
-  size_t slen, llen;
+  size_t slen;
   mp_size_t alen;
   uint32_t i, j;
-  bool neg, hex;
+  bool neg;
   GC_intInf bp;
-  unsigned char *cp;
 
   assert (isFrontierAligned (s, s->frontier));
   frontier = s->frontier;
@@ -58,30 +58,18 @@
     if (neg)
       str++;
     slen = strlen (str);
-    hex = str[0] == '0' && str[1] == 'x';
-    if (hex) {
-      str += 2;
-      slen -= 2;
-      llen = (slen + 7) / 8;
-    } else
-      llen = (slen + 8) / 9;
     assert (slen > 0);
+
     bp = (GC_intInf)frontier;
-    cp = (unsigned char *)(&(bp->limbs[llen]));
 
-    for (j = 0; j != slen; j++)
-      if ('0' <= str[j] && str[j] <= '9')
-        cp[j] = str[j] - '0' + 0;
-      else if ('a' <= str[j] && str[j] <= 'f')
-        cp[j] = str[j] - 'a' + 0xa;
-      else {
-        assert('A' <= str[j] && str[j] <= 'F');
-        cp[j] = str[j] - 'A' + 0xA;
-      }
-    alen = mpn_set_str ((mp_limb_t*)(bp->limbs), cp, slen, hex ? 0x10 : 10);
-    assert ((size_t)alen <= llen);
+    for (j = 0; j != slen; j++) {
+      assert('0' <= str[j] && str[j] <= '9');
+      unsigned char c = str[j] - '0' + 0;
+      str[j] = c;
+    }
+    alen = mpn_set_str ((mp_limb_t*)(bp->limbs), (unsigned char*)str, slen, 10);
     if (alen <= 1) {
-      uint32_t val, ans;
+      uintmax_t val, ans;
       
       if (alen == 0)
         val = 0;
@@ -89,16 +77,16 @@
         val = bp->limbs[0];
       if (neg) {
         /*
-         * We only fit if val in [1, 2^30].
+         * We only fit if val in [1, 2^(8 * OBJPTR_SIZE - 1)].
          */
         ans = - val;
         val = val - 1;
       } else
         /* 
-         * We only fit if val in [0, 2^30 - 1].
+         * We only fit if val in [0, 2^(8 * OBJPTR_SIZE - 1) - 1].
          */
         ans = val;
-      if (val < (uint32_t)1<<30) {
+      if (val < (uintmax_t)1<<(8 * OBJPTR_SIZE - 1)) {
         s->globals[inits->globalIndex] = (objptr)(ans<<1 | 1);
         continue;
       }
@@ -106,7 +94,7 @@
     s->globals[inits->globalIndex] = pointerToObjptr((pointer)(&bp->isneg), s->heap.start);
     bp->counter = 0;
     bp->length = alen + 1;
-    bp->header = buildHeaderFromTypeIndex (WORD32_VECTOR_TYPE_INDEX);
+    bp->header = GC_INTINF_HEADER;
     bp->isneg = neg;
     frontier = alignFrontier (s, (pointer)&bp->limbs[alen]);
   }
@@ -152,6 +140,9 @@
     case 4:
       typeIndex = WORD32_VECTOR_TYPE_INDEX;
       break;
+    case 8:
+      typeIndex = WORD64_VECTOR_TYPE_INDEX;
+      break;
     default:
       die ("unknown bytes per element in vectorInit: %zu",
            bytesPerElement);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h	2006-01-26 03:06:35 UTC (rev 4307)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h	2006-01-26 23:35:22 UTC (rev 4308)
@@ -15,8 +15,8 @@
  *
  * The strings pointed to by the mlstr fields consist of
  *      an optional ~
- *      either one or more of [0-9] or
- *             0x followed by one or more of [0-9a-fA-F]
+ *      one of [1-9]
+ *      zero or more of [0-9]
  *      a trailing EOS
  */
 struct GC_intInfInit {

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h	2006-01-26 03:06:35 UTC (rev 4307)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h	2006-01-26 23:35:22 UTC (rev 4308)
@@ -15,15 +15,21 @@
   GC_arrayCounter counter;
   GC_arrayLength length;
   GC_header header;
-  uint32_t isneg;
-  uint32_t limbs[1];
+  mp_limb_t isneg;
+  mp_limb_t limbs[1];
 } *GC_intInf;
 
 #endif /* (defined (MLTON_GC_INTERNAL_TYPES)) */
 
 #if (defined (MLTON_GC_INTERNAL_FUNCS))
 
-#define GC_INTINF_HEADER GC_WORD32_VECTOR_HEADER
+COMPILE_TIME_ASSERT(sizeof_mp_limb_t__is_four_or_eight, 
+                    (sizeof(mp_limb_t) == 4 || sizeof(mp_limb_t) == 8));
+#define GC_INTINF_HEADER ( \
+        CHAR_BIT * sizeof(mp_limb_t) == 32 ? \
+        GC_WORD32_VECTOR_HEADER : ( \
+        CHAR_BIT * sizeof(mp_limb_t) == 64 ? \
+        GC_WORD64_VECTOR_HEADER : ( 0 ) ) )
 
 #endif /* (defined (MLTON_GC_INTERNAL_FUNCS)) */
 

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h	2006-01-26 03:06:35 UTC (rev 4307)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h	2006-01-26 23:35:22 UTC (rev 4308)
@@ -132,6 +132,7 @@
   WORD8_VECTOR_TYPE_INDEX =  3,
   WORD32_VECTOR_TYPE_INDEX = 4,
   WORD16_VECTOR_TYPE_INDEX = 5,
+  WORD64_VECTOR_TYPE_INDEX = 6,
 };
 
 #endif /* (defined (MLTON_GC_INTERNAL_TYPES)) */
@@ -144,6 +145,7 @@
 #define GC_WORD8_VECTOR_HEADER buildHeaderFromTypeIndex (WORD8_VECTOR_TYPE_INDEX)
 #define GC_WORD16_VECTOR_HEADER buildHeaderFromTypeIndex (WORD16_VECTOR_TYPE_INDEX)
 #define GC_WORD32_VECTOR_HEADER buildHeaderFromTypeIndex (WORD32_VECTOR_TYPE_INDEX)
+#define GC_WORD64_VECTOR_HEADER buildHeaderFromTypeIndex (WORD64_VECTOR_TYPE_INDEX)
 
 static inline void splitHeader (GC_state s, GC_header header,
                                 GC_objectTypeTag *tagRet, bool *hasIdentityRet,