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

   1 module Trans where
   2
   3 import List
   4 import Words
   5 import Word
   6 import Arithmetic
   7 import Cell
   8 import Memory
   9 import Register
  10 import Instruction
  11
  12 -- Begin Signature ----------------------------------------------------------
  13 {-
  14
  15   We have used Transactions to represent instructions w/ their data.
  16   These have been particularly useful in pipelined and out-of-order
  17   superscalar machines.
  18
  19 -}
  20
  21 data Trans i c = Trans [c] i [c] [c]
  22                    deriving (Eq,Show,Read)
  23
  24 -- Convention: if Trans d op s i
  25 -- we say that d is the destination, op is the instruction
  26 -- s is the source, and i is the information
  27
  28 -- return a nop-like transaction
  29 nop             :: (Instruction i,Register r) => Trans i (c r w)
  30
  31 -- return a PC transaction
  32 pcTrans         :: (Cell c,Instruction i,Register r, Word w) =>
  33                        w -> Trans i (c r w)
  34
  35 isNop           :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  36 isAdd           :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  37 isAlu           :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  38 isCmp           :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  39 isBool          :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  40 isSub           :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  41 isMul           :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  42 isDiv           :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  43 isJump          :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  44 isMove          :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  45 isMem           :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  46 isLoad          :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  47 isStore         :: (Instruction i,Register r) => Trans i (c r w) -> Bool
  48 isBranch        :: (Cell c,Register r,Word w) => Trans i (c r w) -> Bool
  49 isComputable    :: (Cell c,Register r,Word w) => Trans i (c r w) -> Bool
  50
  51 -- update destination fields
  52 updDst          :: (Cell c,Register r,Word w) =>
  53                    Trans i (c r w) -> [c r w] -> Trans i (c r w)
  54
  55 -- apply a function to the destination fields
  56 repDst          :: Register r => (c r w -> c r w -> Bool) ->
  57                                  Trans i (c r w) -> [c r w] -> Trans i (c r w)
  58
  59 -- add to the destination
  60 addDst          :: Register r => c r w -> Trans i (c r w) -> Trans i (c r w)
  61
  62 -- get the destination
  63 getDst          :: Register r => Trans i (c r w) -> [c r w]
  64
  65 -- replace the dest fields
  66 putDst          :: Register r => Trans i (c r w) -> [c r w] -> Trans i (c r w)
  67
  68
  69 updSrc          :: (Cell c,Register r,Word w) =>
  70                    Trans i (c r w) -> [c r w] -> Trans i (c r w)
  71 addSrc          :: Register r => c r w -> Trans i (c r w) -> Trans i (c r w)
  72 getSrc          :: Register r => Trans i (c r w) -> [c r w]
  73 putSrc          :: Register r => Trans i (c r w) -> [c r w] -> Trans i (c r w)
  74
  75 addInfo         :: Register r => c r w -> Trans i (c r w) -> Trans i (c r w)
  76 getInfo         :: Register r => Trans i (c r w) -> [c r w]
  77 putInfo         :: Register r => Trans i (c r w) -> [c r w] -> Trans i (c r w)
  78
  79 getOp           :: Trans i (c r w) -> i
  80 putOp           :: Trans i (c r w) -> i -> Trans i (c r w)
  81
  82
  83 -- return the speculative PC from the info area
  84 getSpecPC       :: (Cell c,Register r,Word w) =>
  85                    Trans i (c r w) -> Maybe (c r w)
  86
  87 -- return the PC from the destination area
  88 getDstPC        :: (Cell c,Register r,Word w) =>
  89                    Trans i (c r w) -> Maybe (c r w)
  90 getSrcPC        :: (Cell c,Register r,Word w) =>
  91                    Trans i (c r w) -> Maybe (c r w)
  92
  93 -- return the instructions location from memory from the destination
  94 -- area
  95 getLoc          :: (Cell c,Register r,Word w) =>
  96                    Trans i (c r w) -> Maybe (c r w)
  97
  98 -- get register references
  99 getSrcRegs      :: (Cell c,Register r,Word w) => Trans i (c r w) -> [r]
 100 getDstRegs      :: (Cell c,Register r,Word w) => Trans i (c r w) -> [r]
 101
 102 -- get register reference values
 103 getSrcRegVals   :: (Cell c,Register r,Word w) => Trans i (c r w) -> [w]
 104 putDstRegVal    :: (Cell c,Register r,Word w) =>
 105                    Trans i (c r w) -> w -> Trans i (c r w)
 106
 107 -- evalTrans t (c,w) update the destination fields in t with w if they match
 108 -- c
 109 evalTrans       :: (Cell c,Register r,Word w) =>
 110                    Trans i (c r w) -> (c r w,Maybe w) -> Trans i (c r w)
 111
 112 -- is there a Read-After-Write hazard between two transactions?
 113 rawHazard       :: (Cell c,Register r,Word w) =>
 114                    (Trans i (c r w),Trans i (c r w)) -> Bool
 115
 116 -- bypass t t2 source operands of t with the dest operands of t2
 117 -- if the references match.
 118
 119 bypass          :: (Cell c,Register r,Word w) =>
 120                    Trans i (c r w) -> Trans i (c r w) -> Trans i (c r w)
 121
 122 -- bypass the dest. operands instead of the source operands.
 123 bypassDst       :: (Cell c,Register r,Word w) =>
 124                    Trans i (c r w) -> Trans i (c r w) -> Trans i (c r w)
 125
 126 -- bypass with multiple transactions
 127 bypassMany      :: (Cell c,Register r,Word w) =>
 128                    Trans i (c r w) -> [Trans i (c r w)] -> Trans i (c r w)
 129 bypassDstMany   :: (Cell c,Register r,Word w) =>
 130                    Trans i (c r w) -> [Trans i (c r w)] -> Trans i (c r w)
 131
 132 -- bypass to multiple transaction with multiple transactions
 133 broadcast       :: (Cell a, Register b, Word c) =>
 134                    [Trans e (a b c)] -> [Trans e (a b c)] -> [Trans e (a b c)]
 135
 136 --source operands and dest operands all filled in?
 137 complete        :: (Cell c,Register r,Word w) =>
 138                    Trans i (c r w) -> Bool
 139
 140 -- if (x,y) = readyToRetire z, then
 141 -- x is the lift of transactions that are "complete"
 142 readyToRetire   :: (Cell c,Register r,Word w) =>
 143                    [Trans i (c r w)] -> ([Trans i (c r w)],[Trans i (c r w)])
 144
 145
 146 -- if (x,y) = readyToCompute z, then
 147 -- x is the lift of transactions with all of their source operands filled in
 148 readyToCompute  :: (Cell c,Register r,Word w) =>
 149                    [Trans i (c r w)] -> ([Trans i (c r w)],[Trans i (c r w)])
 150
 151
 152 updatePC        :: Register r => c r w -> Trans i (c r w) -> Trans i (c r w)
 153
 154
 155 getPredicate   :: (Cell c,Register r,Word w) => Trans i (c r w) -> c r w
 156 isPredicated   :: (Cell c,Register r,Word w) => Trans i (c r w) -> Bool
 157
 158 evalPredicate  :: (Cell c,Register r,Word w) => Trans i (c r w) -> w
 159
 160 -- End Signature ----------------------------------------------------------
 161
 162
 163 updCells        :: (Cell c,Register r,Word w) => [c r w] -> [c r w] -> [c r w]
 164 repCells        :: Register r => (c r w -> c r w -> Bool) ->
 165                                   [c r w] -> [c r w] -> [c r w]
 166
 167 -- perhaps these functions can go?
 168 filterDst       :: Register r => (c r w -> Bool) -> Trans i (c r w) -> [c r w]
 169
 170 fillInCells     :: (Cell c,Register r,Word w) => [c r w] -> [c r w] -> [c r w]
 171
 172 fillInSrcCells  :: (Cell c,Register r,Word w) =>
 173                    Trans i (c r w) -> [c r w] -> Trans i (c r w)
 174
 175 filterOut       :: (Register r,Functor m) =>
 176                    (Trans i (c r w) -> Bool) -> m [Trans i (c r w)] ->
 177                    m [Trans i (c r w)]
 178
 179
 180
 181 nop = Trans [] noOp [] []
 182
 183 pcTrans addr = Trans [putVal pcNothing (Just addr)] noOp [] []
 184 isNop t = isNoOp (getOp t)
 185 isAdd t = isAddOp (getOp t)
 186 isAlu t = isAluOp (getOp t)
 187 isCmp t = isCmpOp (getOp t)
 188 isBool t = isBoolOp (getOp t)
 189 isSub t = isSubOp (getOp t)
 190 isMul t = isMultOp (getOp t)
 191 isDiv t = isDivOp (getOp t)
 192 isJump t = isJumpOp (getOp t)
 193 isMem t = isMemOp (getOp t)
 194 isMove t = isMoveOp (getOp t)
 195 isLoad t = isLoadOp (getOp t)
 196 isStore t = isStoreOp (getOp t)
 197
 198 isBranch (Trans d _ _ _) = any search d where
 199         search r = if isReg r then ispc (getReg r)
 200                    else False
 201
 202 isComputable = and . map isComputed . getSrc
 203
 204
 205
 206
 207 repCells replFunc cells replacements
 208   = map (\cell -> foldr bypassCell cell replacements) cells
 209     where
 210       bypassCell bypassed argCell
 211         = if replFunc bypassed argCell
 212             then bypassed
 213             else argCell
 214
 215
 216 updCells cells bypassCells = repCells cellHazard cells bypassCells
 217
 218
 219 repDst repFunc (Trans d o s i) cells = Trans (repCells repFunc d cells) o s i
 220 updDst = repDst cellHazard
 221 addDst c t = putDst t (c:getDst t)
 222 getDst (Trans d o s i) = d
 223 putDst (Trans _ o s i) d = Trans d o s i
 224
 225 updSrc (Trans d o s i) cells = Trans d o (updCells s cells) i
 226 addSrc c t = putSrc t (c:getSrc t)
 227 getSrc (Trans d o s i) = s
 228 putSrc (Trans d o _ i) s = Trans d o s i
 229
 230 addInfo c t = putInfo t (c:getInfo t)
 231 getInfo (Trans d o s i) = i
 232 putInfo (Trans d o s _) i = Trans d o s i
 233
 234 getOp (Trans d o s i) = o
 235 putOp (Trans d _ s i) o = Trans d o s i
 236
 237 getSpecPC       = find isSpecPC . getInfo
 238 getDstPC        = find isPC . getDst
 239 getSrcPC        = find isPC . getSrc
 240 getLoc          = find isLoc . getInfo
 241
 242 getSrcRegs t = map getReg $ filter isReg $ getSrc t
 243 getDstRegs t = map getReg $ filter isReg $ getDst t
 244
 245 getSrcRegVals t = map getVal $
 246                         filter isReg $ getSrc t
 247
 248 {-
 249 putDstRegVal (Trans [Reg r _] o s i) n
 250                         = Trans [Reg r (Val n)] o s i
 251 -}
 252 putDstRegVal (Trans [r] o s i) n
 253                         = Trans [putVal r (Just n)] o s i
 254
 255 getPredicate (Trans _ _ l _) = last (filter isPred l)
 256
 257 getPredicate' t = if isPredicated t then Just (getPredicate t)
 258                   else Nothing
 259
 260 isPredicated (Trans _ _ x _)
 261     = case filter isPred  x of
 262                 [] -> False
 263                 _ -> True
 264
 265
 266 evalPredicate t =
 267    case getPredicate' t of
 268               Just c -> if isAss c then getVal c
 269                    --     else error $ "evalPredicate" ++ show t
 270                         else error "evalPredicate"
 271               Nothing -> 1
 272
 273 bypass tran bypassT = --updSrc tran $ getDst bypassT
 274                       if evalPredicate bypassT /= 0
 275                           then updSrc tran $ getDst bypassT
 276                           else tran
 277
 278 bypassDst tran bypassT = if evalPredicate bypassT /= 0
 279                             then updDst tran $ getDst bypassT
 280                             else tran
 281
 282 bypassMany tran bypassT = foldr (\a b -> b `bypass` a) tran bypassT
 283
 284 bypassDstMany tran bypassT = foldr (\a b -> b `bypassDst` a) tran bypassT
 285
 286 broadcast xs ys = map (`bypassMany` ys) xs
 287
 288 {- PRE-predication
 289 bypass tran bypassT = updSrc tran $ getDst bypassT
 290
 291 bypassDst tran bypassT = updDst tran $ getDst bypassT
 292
 293 bypassTrans tran bypassT = foldr (\a b -> b `bypass` a) tran bypassT
 294
 295 broadcast xs ys = map (`bypassTrans` ys) xs
 296 -}
 297
 298
 299 readyToRetire  = partition $ and . map isComputed . getDst
 300
 301 complete = and . map isComputed . getDst
 302
 303 readyToCompute =  partition $ and . map isComputed . getSrc
 304
 305 tran `evalTrans` (dest,val) = repDst sameLoc tran [putVal dest val]
 306
 307 rawHazard (preceeding,following)
 308   = or [ cellHazard precCell followCell |
 309            precCell <- getDst preceeding,
 310            followCell <- getSrc following]
 311
 312 filterDst f (Trans d _ _ _) = filter f d
 313
 314 --added 19 Nov
 315 filterOut f = fmap (filter $ not . f)
 316
 317 fillInCells cells bypassCells
 318   = repCells (\x y -> (not $ isAss y) && cellHazard x y) cells bypassCells
 319
 320 fillInSrcCells (Trans d o s i) cells = Trans d o (fillInCells s cells) i
 321
 322 fillInCells' cells bypassCells
 323   = repCells cellHazard cells bypassCells
 324
 325 fillInSrcCells' (Trans d o s i) cells = Trans d o (fillInCells' s cells) i
 326
 327 -- TEMPORARY --- NOT ROBUST!
 328 updatePC c (Trans _ o s i) = Trans [c] o s i
 329
 330
 331
 332
 333
 334
 335
 336
 337
 338