mlton-commit Mailing List for MLton (Page 151)

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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,




2005	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug (56)	Sep (40)	Oct (30)	Nov (144)	Dec (23)
2006	Jan (41)	Feb (29)	Mar (31)	Apr (39)	May (193)	Jun (45)	Jul (19)	Aug (3)	Sep (23)	Oct (83)	Nov (92)	Dec (123)
2007	Jan (90)	Feb (267)	Mar (120)	Apr (51)	May (40)	Jun (121)	Jul (109)	Aug (173)	Sep (77)	Oct (52)	Nov (121)	Dec (62)
2008	Jan (76)	Feb (53)	Mar (98)	Apr (87)	May (26)	Jun (27)	Jul (23)	Aug (136)	Sep (79)	Oct (68)	Nov (29)	Dec (14)
2009	Jan (7)	Feb (2)	Mar (11)	Apr (75)	May (1)	Jun (95)	Jul (19)	Aug (4)	Sep (8)	Oct (93)	Nov (43)	Dec (21)
2010	Jan (20)	Feb (23)	Mar (18)	Apr (6)	May (20)	Jun (23)	Jul (1)	Aug	Sep	Oct	Nov	Dec
2011	Jan (2)	Feb (6)	Mar (15)	Apr (5)	May (9)	Jun (14)	Jul (9)	Aug	Sep	Oct	Nov	Dec
2012	Jan	Feb (3)	Mar	Apr	May (2)	Jun (17)	Jul (37)	Aug	Sep (1)	Oct (6)	Nov	Dec
2013	Jan	Feb	Mar (5)	Apr (2)	May (7)	Jun (11)	Jul (8)	Aug	Sep (1)	Oct (2)	Nov	Dec
2014	Jan	Feb (2)	Mar (1)	Apr	May (1)	Jun (1)	Jul (7)	Aug (2)	Sep	Oct (5)	Nov (2)	Dec (4)
2015	Jan	Feb (2)	Mar (2)	Apr	May	Jun (9)	Jul (1)	Aug	Sep	Oct (4)	Nov (1)	Dec
2016	Jan (2)	Feb (1)	Mar (1)	Apr (1)	May (1)	Jun (2)	Jul (1)	Aug	Sep (5)	Oct	Nov	Dec
2017	Jan (1)	Feb (3)	Mar (3)	Apr (7)	May (2)	Jun (2)	Jul (5)	Aug (1)	Sep (2)	Oct (17)	Nov (4)	Dec (7)
2018	Jan (5)	Feb (14)	Mar (2)	Apr (5)	May (2)	Jun (5)	Jul	Aug (2)	Sep	Oct (3)	Nov (5)	Dec
2019	Jan (4)	Feb (2)	Mar (3)	Apr (1)	May (8)	Jun (14)	Jul (2)	Aug	Sep (2)	Oct (2)	Nov (15)	Dec (2)
2020	Jan (10)	Feb (3)	Mar (1)	Apr	May (9)	Jun (4)	Jul (16)	Aug (10)	Sep (4)	Oct (3)	Nov	Dec
2021	Jan (11)	Feb (2)	Mar (2)	Apr	May	Jun (1)	Jul	Aug (5)	Sep	Oct (6)	Nov (4)	Dec (4)
2022	Jan (4)	Feb (2)	Mar (2)	Apr	May (6)	Jun (3)	Jul	Aug (1)	Sep	Oct	Nov (1)	Dec
2023	Jan	Feb	Mar	Apr (2)	May (5)	Jun (1)	Jul (4)	Aug (1)	Sep	Oct (1)	Nov (13)	Dec
2024	Jan (1)	Feb	Mar (5)	Apr	May (10)	Jun	Jul	Aug (3)	Sep	Oct	Nov (1)	Dec (14)
2025	Jan (3)	Feb	Mar (1)	Apr	May (2)	Jun (3)	Jul	Aug	Sep	Oct	Nov	Dec

mlton-commit Mailing List for MLton (Page 151)

A whole-program optimizing compiler for Standard ML

mlton-commit — [MLton-commit] Code commits