5 import qualified PreludeSig as Sig
10 type EU i c = Signal Bool -> Signal [(Trans i c)] ->
11 Signal ([Trans i c],[Trans i c])
13 -- Schedule Combinator ---------------------------------------------------
14 schedule :: Register r => [EU i (c r w)] -> EU i (c r w)
15 schedule l b = foldl combine end (map ($b) l)
17 end = lift1 $ \x -> ([],x)
18 combine f g sig = let (ac,rej) = unbundle2 $ f sig
19 (ac',rej') = unbundle2 $ g rej
20 in bundle2 (ac *++ ac',rej')
22 -- EUs -----------------------------------------------------------
24 addUnit :: (Cell c,Register r,Word w,Instruction i) => EU i (c r w)
25 addUnit = makeUnit isAdd aluDevice
27 subUnit :: (Cell c,Register r,Word w,Instruction i) => EU i (c r w)
28 subUnit = makeUnit isSub aluDevice
30 multUnit :: (Cell c,Register r,Word w,Instruction i) => EU i (c r w)
31 multUnit = makeDelayedUnit 2 isMul aluDevice
33 divUnit :: (Cell c,Register r,Word w,Instruction i) => EU i (c r w)
34 divUnit = makeDelayedUnit 4 isDiv aluDevice
36 cmpUnit :: (Cell c,Register r,Word w,Instruction i) => EU i (c r w)
37 cmpUnit = makeUnit isCmp aluDevice
39 jumpUnit :: (Cell c,Register r,Word w,Instruction i) => EU i (c r w)
40 jumpUnit = makeUnit isJump (map jumpDevice)
42 moveUnit :: (Cell c,Register r,Word w,Instruction i) => EU i (c r w)
43 moveUnit = makeUnit isMove aluDevice
45 -- Devices -------------------------------------------------------------
46 jumpDevice trans@(Trans [dest] op [cond,src1,src2] _) | isJumpOp op =
48 (dest,alu func val1 val2))
49 where func = if (getVal cond) == 0 then z else nz
56 = map (\t@(Trans [dest] op [src1,src2] x) ->
57 let aluFunc = aluOp op
58 in (t `evalTrans` (dest,
59 (alu aluFunc (getVal src1) (getVal src2))))
62 -- Higher-order Constructors ----------------------------------------------
63 makeUnit :: Register r => (Trans i (c r w) -> Bool) ->
64 ([Trans i (c r w)] -> [Trans i (c r w)]) ->
66 makeUnit accept unit kill instrs
67 = lift1 (\(k,x) -> let (acceptable,rejects) = partition accept x
68 (instr,others) = splitAt 1 acceptable
69 in (unit instr,others ++ rejects)) $ bundle2 (kill,instrs)
72 makeDelayedUnit :: Register r => Int -> (Trans i (c r w) -> Bool) ->
73 ([Trans i (c r w)] -> [Trans i (c r w)]) ->
75 makeDelayedUnit n f g kill sig = bundle2 (flush n [] kill $ delayN n [] x,y)
77 (x,y) = unbundle2 $ unit kill sig
80 delayN n x s = xs `before` s
81 where xs = take n (repeat x)