[MLton-commit] r4049

[Stephen Weeks]

Fixed bug in implementation of MLton_touch.  It wasn't quite correct
to drop it during SsaToRssa even when it is applied to unit, because
it is also used to ensure that code stays around for exn history
info.  The previous bugfix tickled the exnHistory.sml regression.
This commit fixes that, by keeping MLton_touch to the end of the RSSA
pipeline in all cases.


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

U   mlton/trunk/mlton/backend/ssa-to-rssa.fun

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

Modified: mlton/trunk/mlton/backend/ssa-to-rssa.fun
===================================================================
--- mlton/trunk/mlton/backend/ssa-to-rssa.fun	2005-08-27 20:40:49 UTC (rev 4048)
+++ mlton/trunk/mlton/backend/ssa-to-rssa.fun	2005-08-28 00:33:33 UTC (rev 4049)
@@ -1190,9 +1190,17 @@
                                     simpleCCall
                                     (CFunction.size (Operand.ty (a 0)))
                                | MLton_touch =>
-                                    if isSome (toRtype (varType (arg 0))) then
-                                       primApp prim
-                                    else none ()
+                                    let
+                                       val a = arg 0
+                                       val args = 
+                                          if isSome (toRtype (varType a))
+                                             then Vector.new1 (varOp a)
+                                          else Vector.new0 ()
+                                    in
+                                       add (PrimApp {args = args,
+                                                     dst = NONE,
+                                                     prim = prim})
+                                    end
                                | Pointer_getPointer => pointerGet ()
                                | Pointer_getReal _ => pointerGet ()
                                | Pointer_getWord _ => pointerGet ()