1

我正在尝试在 MLton 及其并发 ML 实现中实现一个基本的“压力测试”程序，特别是这里描述的 Monte Carlo Pi 测试。虽然我认为我已经知道了我需要的大部分内容，但我有一个问题是我的程序总是在 CML 线程完成它们的工作之前终止。我知道他们正在做某事，因为我有时会看到他们向控制台打印我指示的应该打印的文本，但在他们开始和运行之间似乎存在竞争条件，并且程序作为一个整体退出。

我启动 CML 的代码是：

local
    val iterations : int = 10
    val num_threads : int = 1
    val still_going : bool ref = ref true
in
   val _ = (RunCML.doit ((experiment iterations num_threads still_going), NONE);
            (* while !still_going do (); (* Spin-wait for the CML stuff to finish.  This doesn't work... *) *)
            print "All done!\n")
end

该experiment函数的内容是：

fun experiment (iterations : int) (num_threads : int) (still_going : bool ref) () : unit = let
    val iters_per_thread : int = iterations div num_threads
    val return_ivars = Vector.tabulate (num_threads, (fn _ => SyncVar.iVar()))
    val _ = Vector.map (fn return_ivar => CML.spawn (montecarlopi iters_per_thread return_ivar)) return_ivars
    val return_val = Vector.foldl (fn (elem, acc) => acc + (SyncVar.iGet elem)) 0.0 return_ivars
in
    (TextIO.print ("Result is: " ^ (Real.toString return_val) ^ "\n");
            still_going := false)
end

最后，montecarlopi函数是：

fun montecarlopi (iterations : int) (return_ivar : real SyncVar.ivar) () = let
    val _ = MLton.Random.srand (valOf (MLton.Random.useed ()))
    fun helper accumulator 0 = accumulator
      | helper accumulator iteration = let
          val x : real = wordToBoundedReal (MLton.Random.rand ())
          val y : real = wordToBoundedReal (MLton.Random.rand ())
          val in_target = (x * x) + (y * y)
          val next_iter = iteration - 1
          val _ = TextIO.print ("next_iter is: " ^ (Int.toString next_iter) ^ ", in_target is: " ^ (Real.toString in_target)  ^ ",x is: " ^ (Real.toString x) ^ ",y is: " ^ (Real.toString y) ^ "\n")
      in
          if in_target < 1.0 then
              helper (accumulator + 1) next_iter
          else
              helper accumulator next_iter
      end
in
    SyncVar.iPut (return_ivar, (4.0 * ((real (helper 0 iterations)) / (real iterations))))
end

（完整的（小）程序和随附的 .mlb 文件可以在这里查看）。我有理由确定RunCML.doit函数调用中的位做了它们应该做的事情，这让我认为问题可能与程序的最外层部分有关。

如您所见，我尝试旋转等待，使用布尔值上的 ref 单元格来确定何时停止，但这似乎不起作用。尝试旋转等待也不会使用RunCML.isRunning- 尽管这两个听起来都是可怕的想法，真的，无论如何。当然，我不能使用 CML 通道或同步变量之类的东西，因为它们需要在RunCML.doit要使用的段内。更改线程数对这个问题没有任何影响。我也找不到任何其他可以使主要部分进入非阻塞等待的功能。

如何让程序的外部部分等到RunCML.doit函数调用内部的大部分完成？或者，我在导致问题的那部分内部做错了什么？

4

1 回答 1

3

如果我们查看 function RunCML.doit，它的类型OS.Process.status可以是success或failure，您的调用将doit返回失败。有一个 CML 功能shutdown: OS.Process.status -> 'a。

这可以解释为什么它失败了，除了你不叫关机，你的部分输出结果永远不会打印。

这是一个为 CML 关闭执行各种机制的小示例，其中 CML 似乎在内部执行诸如“优雅”之类的操作。捕获引发的异常并将其转变为失败。

structure Main = struct
  open CML
  structure RunCML = RunCML;
  exception ohno

  fun raises() = raise ohno
  fun succeed() = RunCML.shutdown(OS.Process.success)
  fun fail() = RunCML.shutdown(OS.Process.failure)
  fun graceful f () =
    let val () = f() handle _ => RunCML.shutdown(OS.Process.failure);
     in RunCML.shutdown(OS.Process.success)
    end

  fun print_status status =
      if OS.Process.isSuccess status
         then TextIO.print("success\n")
         else TextIO.print("failure\n")

  fun main() = let
    val _ = TextIO.print(banner ^ "\n");
    val _ = print_status(RunCML.doit(succeed, NONE))
    val _ = print_status(RunCML.doit(fail, NONE))
    val _ = print_status(RunCML.doit(raises, NONE))
    val _ = print_status(RunCML.doit(graceful(raises), NONE))
    val _ = print_status(RunCML.doit(graceful(succeed), NONE))
    in OS.Process.success end
end

因此，如果 CML 异常退出，并且您自己没有调用 shutdown，那么很有可能在某处引发了异常，事实证明确实如此。

将来避免这种静默处理异常的一种方法可能是添加如下内容：

  fun noisy f () =
    let val () = f()
    handle e => 
       let val () = TextIO.print ("Exception: " ^ (exnName e)
         ^ " Message: " ^ (exnMessage e) ^ "\n")
        in RunCML.shutdown(OS.Process.failure) end
     in RunCML.shutdown(OS.Process.success)
    end

然后打电话RunCML.doit(noisy(f), NONE)

PS 感谢您包含指向您的代码的链接，否则将更难理解问题。

于 2020-03-17T09:12:28.580 回答