在 GHC 编译的二进制文件中使用过多神秘的系统时间

Excessive mysterious system time use in a GHC-compiled binary

我正在探索基于约束的搜索的自动边界。因此,我的出发点是 SEND MORE MONEY problem, with a solution based on nondeterministic selection without replacement。我修改了计算执行样本数的方法,以便更好地衡量向搜索添加约束的影响。

import Control.Monad.State
import Control.Monad.Trans.List
import Control.Monad.Morph
import Data.List (foldl')

type CS a b = StateT [a] (ListT (State Int)) b

select' :: [a] -> [(a, [a])]
select' [] = []
select' (x:xs) = (x, xs) : [(y, x:ys) | ~(y, ys) <- select' xs]

select :: CS a a
select = do
    i <- lift . lift $ get
    xs <- get
    lift . lift . put $! i + length xs
    hoist (ListT . return) (StateT select')

runCS :: CS a b -> [a] -> ([b], Int)
runCS a xs = flip runState 0 . runListT $ evalStateT a xs

fromDigits :: [Int] -> Int
fromDigits = foldl' (\x y -> 10 * x + y) 0

sendMoreMoney :: ([(Int, Int, Int)], Int)
sendMoreMoney = flip runCS [0..9] $ do
    [s,e,n,d,m,o,r,y] <- replicateM 8 select
    let send  = fromDigits [s,e,n,d]
        more  = fromDigits [m,o,r,e]
        money = fromDigits [m,o,n,e,y]
    guard $ s /= 0 && m /= 0 && send + more == money
    return (send, more, money)

main :: IO ()
main = print sendMoreMoney

它有效,它得到了正确的结果,并且在搜索过程中保持了平坦的堆配置文件。但即便如此,它还是很慢。这比不计算选择要慢 20 倍。即使 that 也不可怕。为了收集这些性能数据,我可以忍受支付巨额罚款。

但我还是不想让性能无谓地糟糕,所以我决定在性能方面寻找容易实现的成果。当我这样做时,我遇到了一些莫名其妙的结果。

$ ghc -O2 -Wall -fforce-recomp -rtsopts statefulbacktrack.hs
[1 of 1] Compiling Main             ( statefulbacktrack.hs, statefulbacktrack.o )
Linking statefulbacktrack ...
$ time ./statefulbacktrack
([(9567,1085,10652)],2606500)

real    0m6.960s
user    0m3.880s
sys     0m2.968s

那个系统时间简直荒唐至极。该程序执行一次输出。这一切都去哪儿了?我的下一步是检查 strace.

$ strace -cf ./statefulbacktrack
([(9567,1085,10652)],2606500)
% time     seconds  usecs/call     calls    errors syscall
------ ----------- ----------- --------- --------- ----------------
 98.38    0.033798        1469        23           munmap
  1.08    0.000370           0     21273           rt_sigprocmask
  0.26    0.000090           0     10638           clock_gettime
  0.21    0.000073           0     10638           getrusage
  0.07    0.000023           4         6           mprotect
  0.00    0.000000           0         8           read
  0.00    0.000000           0         1           write
  0.00    0.000000           0       144       134 open
  0.00    0.000000           0        10           close
  0.00    0.000000           0         1           execve
  0.00    0.000000           0         9         9 access
  0.00    0.000000           0         3           brk
  0.00    0.000000           0         1           ioctl
  0.00    0.000000           0       847           sigreturn
  0.00    0.000000           0         1           uname
  0.00    0.000000           0         1           select
  0.00    0.000000           0        13           rt_sigaction
  0.00    0.000000           0         1           getrlimit
  0.00    0.000000           0       387           mmap2
  0.00    0.000000           0        16        15 stat64
  0.00    0.000000           0        10           fstat64
  0.00    0.000000           0         1         1 futex
  0.00    0.000000           0         1           set_thread_area
  0.00    0.000000           0         1           set_tid_address
  0.00    0.000000           0         1           timer_create
  0.00    0.000000           0         2           timer_settime
  0.00    0.000000           0         1           timer_delete
  0.00    0.000000           0         1           set_robust_list
------ ----------- ----------- --------- --------- ----------------
100.00    0.034354                 44039       159 total

所以.. strace 告诉我系统调用只花费了 0.034354s。

time 报告的剩余 sys 时间去哪儿了?

另一个数据点:GC 时间真的很长。有没有简单的方法可以降低它?

$ ./statefulbacktrack +RTS -s
([(9567,1085,10652)],2606500)
   5,541,572,660 bytes allocated in the heap
   1,465,208,164 bytes copied during GC
      27,317,868 bytes maximum residency (66 sample(s))
         635,056 bytes maximum slop
              65 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0     10568 colls,     0 par    1.924s   2.658s     0.0003s    0.0081s
  Gen  1        66 colls,     0 par    0.696s   2.226s     0.0337s    0.1059s

  INIT    time    0.000s  (  0.001s elapsed)
  MUT     time    1.656s  (  2.279s elapsed)
  GC      time    2.620s  (  4.884s elapsed)
  EXIT    time    0.000s  (  0.009s elapsed)
  Total   time    4.276s  (  7.172s elapsed)

  %GC     time      61.3%  (68.1% elapsed)

  Alloc rate    3,346,131,972 bytes per MUT second

  Productivity  38.7% of total user, 23.1% of total elapsed

系统信息:

$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.10.1
$ uname -a
Linux debian 3.2.0-4-686-pae #1 SMP Debian 3.2.68-1+deb7u1 i686 GNU/Linux

运行 Windows8.1.

上托管的 VMWare Player 7.10 中的 Debian 7 虚拟机

请务必在

之后将 -H128 添加到您的构建命令行

+RTS -s

你的评估看起来不错,所以你可以去那里。

如果您真的想解决此 VM 的迟缓问题,请增加 VM 上的线程优先级(如果需要,还可以稍微增加 VM 控制台)。

另一个意想不到的惩罚是由于 GC 的同步确认(因为这是多核系统上的 SMP Debian)。

GC 将在任何多核系统上执行更多的 VM 操作,这部分解释了 61% 的 GC 统计数据以及您的 strace 和时间差异。无论如何,统计数据在大多数情况下都不可靠

你实际上做得很好 - - 特别是如果这是在 i7 或更高版本上,例如。

如果 -H128 选项不能解决这个问题,我会感到惊讶。

我是新来的,如果我能提供进一步的帮助,或者在发放赏金之前您需要什么,请告诉我。