[MLton-commit] r7502

[Matthew Fluet]

Fixed bug in translation from SSA2 to RSSA with weak pointers.

A weak pointer to a non-heap allocated object (e.g., an int) is always
nulled.  For such weak pointers, the translation from SSA2 to RSSA
eliminates the weak pointer operations.  However, this could leave
unbound variables.  For example, the SSA2 fragment

  L_311 ()
    x_701: word32 = Weak_get (x_697)
    x_700: bool = Weak_canGet (x_697)
    case x_700 of
      true => L_313 | false => L_312
  L_313 ()
    L_242 (x_701)

is translated to the RSSA fragment:

 L_311 () Jump =
    x_700: Word32 = 0x0: Word32
    switch {test = x_700, default = None, cases = ((0x0, L_1356), (0x1, L_1357))}
  L_313 () Jump =
    L_242 (x_701)

Although the L_313 block (and, therefore, the reference to x_701) is
dead code, the fragment is nonetheless illegal.

The fix is straighforward: rather than elide the Weak_get operation in
this scenario, replace it with a bogus value.  Thus, the above SSA2
fragment is now translated to the RSSA fragment:

 L_311 () Jump =
    x_701: Word32 = 0x1: Word32
    x_700: Word32 = 0x0: Word32
    switch {test = x_700, default = None, cases = ((0x0, L_1356), (0x1, L_1357))}
  L_313 () Jump =
    L_242 (x_701)

Thanks to Alexandre Hamez for the bug report.
----------------------------------------------------------------------

U   mlton/trunk/doc/changelog
U   mlton/trunk/mlton/backend/ssa-to-rssa.fun
A   mlton/trunk/regression/weak.3.ok
A   mlton/trunk/regression/weak.3.sml

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

Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog	2011-02-06 01:46:28 UTC (rev 7501)
+++ mlton/trunk/doc/changelog	2011-02-18 21:18:47 UTC (rev 7502)
@@ -1,5 +1,8 @@
 Here are the changes from version 2010608 to version YYYYMMDD.
 
+* 2011-02-17
+   - Fixed bug in translation from SSA2 to RSSA with weak pointers.
+
 * 2011-02-05
    - Fixed bug in amd64 codegen calling convention for varargs C calls.
 

Modified: mlton/trunk/mlton/backend/ssa-to-rssa.fun
===================================================================
--- mlton/trunk/mlton/backend/ssa-to-rssa.fun	2011-02-06 01:46:28 UTC (rev 7501)
+++ mlton/trunk/mlton/backend/ssa-to-rssa.fun	2011-02-18 21:18:47 UTC (rev 7502)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009 Matthew Fluet.
+(* Copyright (C) 2009,2011 Matthew Fluet.
  * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
@@ -1375,7 +1375,9 @@
                                      (CFunction.weakGet
                                       {arg = Operand.ty (a 0),
                                        return = t}),
-                                     none)
+                                     fn () => (case toRtype ty of
+                                                  NONE => none ()
+                                                | SOME t => move (bogus t)))
                                | Weak_new =>
                                     ifIsWeakPointer
                                     (ty,

Added: mlton/trunk/regression/weak.3.ok
===================================================================
--- mlton/trunk/regression/weak.3.ok	2011-02-06 01:46:28 UTC (rev 7501)
+++ mlton/trunk/regression/weak.3.ok	2011-02-18 21:18:47 UTC (rev 7502)
@@ -0,0 +1,5 @@
+6
+5
+4
+3
+2

Added: mlton/trunk/regression/weak.3.sml
===================================================================
--- mlton/trunk/regression/weak.3.sml	2011-02-06 01:46:28 UTC (rev 7501)
+++ mlton/trunk/regression/weak.3.sml	2011-02-18 21:18:47 UTC (rev 7502)
@@ -0,0 +1,23 @@
+fun find cache x =
+   case (List.find (fn (y,_) => x = y) (!cache)) of
+      NONE => NONE
+    | SOME (_,r) => SOME r
+fun remove cache x =
+   cache := (List.filter (fn (y,_) => not (x = y)) (!cache))
+fun insert cache (x,r) =
+   cache := (x,r)::(!cache)
+
+val cache = ref []
+
+fun lookup (x : int) =
+   case find cache x of
+      SOME r  => (case MLton.Weak.get r of
+                     SOME r' => r'
+                   | NONE => (remove cache x; lookup x))
+    | NONE    => let val res = x + 1
+                     val wres = MLton.Weak.new res
+                 in insert cache (x, wres);
+                    res
+                 end
+
+val _ = List.app (fn x => print (concat [Int.toString (lookup x), "\n"])) [5,4,3,2,1]