ghc/tests/programs/jeff-bug/RS.hs

   1 module RS
   2   (
   3         rs
   4   )  where
   5
   6 import LazyST
   7
   8 import Hawk
   9 import qualified PreludeSig as Sig
  10 import Trans
  11 import qualified TransSig as T
  12 import qualified BoundedSet as Set
  13
  14 import EUs
  15 import DLX
  16
  17
  18 type RS i c r w = (Int,[EU i (c (VReg r) w)]) ->
  19             (Signal Bool,Signal [VTrans r w]) ->
  20             Signal [VTrans r w]
  21
  22
  23 --rs :: (Register r,Word w) => RS StandardOp c r w
  24 rs (n,execUnits) (mispredicted,input)
  25   = computed
  26    where
  27    ready = runST (
  28         do { set <- Set.new n
  29            ; loop wires $
  30                 \(instrs,mispredicted,computed,rejected) ->
  31                            if mispredicted
  32                              then do { Set.clear set
  33                                      ; return []
  34                                      }
  35                              else do { Set.insert set instrs
  36                                      ; Set.insert set rejected
  37                                      ; broadcast' set computed
  38                                      ; ready <- Set.rmSuch set isComputable
  39                                      ; return ready
  40                                      }
  41           }
  42         )
  43    wires = bundle4 (input,mispredicted,computed,rejected)
  44    (computed,rejected) = unbundle2 $ delay ([],[]) $
  45                          execUnit mispredicted ready
  46
  47    execUnit = schedule execUnits
  48
  49 broadcast' set computed
  50   = do { s <- Set.read set
  51        ; let dests = concat $ map getDst computed
  52        ; Set.iterateSet set (flip fillInSrcCells dests)
  53        }
  54