From: Christiaan Baaij Date: Fri, 14 Aug 2009 14:32:54 +0000 (+0200) Subject: Add builtin blockRAM primitive X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=65215495d0faf2aac6f53f06e539f62deb31185f;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Add builtin blockRAM primitive --- diff --git "a/c\316\273ash/CLasH/HardwareTypes.hs" "b/c\316\273ash/CLasH/HardwareTypes.hs" index 682cd05..c3eaf43 100644 --- "a/c\316\273ash/CLasH/HardwareTypes.hs" +++ "b/c\316\273ash/CLasH/HardwareTypes.hs" @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-} +{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, FlexibleContexts, TypeFamilies, TypeOperators #-} module CLasH.HardwareTypes ( module Types @@ -14,6 +14,9 @@ module CLasH.HardwareTypes , hwor , hwxor , hwnot + , RAM + , MemState + , blockRAM ) where import qualified Prelude as P @@ -57,4 +60,27 @@ Low `hwxor` High = High _ `hwxor` _ = Low hwnot High = Low -hwnot Low = High \ No newline at end of file +hwnot Low = High + +type RAM s a = Vector (s :+: D1) a + +type MemState s a = State (RAM s a) + +blockRAM :: + (NaturalT s + ,PositiveT (s :+: D1) + ,((s :+: D1) :>: s) ~ True ) => + (MemState s a) -> + a -> + RangedWord s -> + RangedWord s -> + Bit -> + ((MemState s a), a ) +blockRAM (State mem) data_in rdaddr wraddr wrenable = + ((State mem'), data_out) + where + data_out = mem!rdaddr + -- Only write data_in to memory if write is enabled + mem' = case wrenable of + Low -> mem + High -> replace mem wraddr data_in diff --git "a/c\316\273ash/CLasH/VHDL/Constants.hs" "b/c\316\273ash/CLasH/VHDL/Constants.hs" index 9c372ec..71c1c21 100644 --- "a/c\316\273ash/CLasH/VHDL/Constants.hs" +++ "b/c\316\273ash/CLasH/VHDL/Constants.hs" @@ -294,6 +294,9 @@ sizedIntId = "SizedInt" tfvecId :: String tfvecId = "TFVec" +blockRAMId :: String +blockRAMId = "blockRAM" + -- | output file identifier (from std.textio) showIdString :: String showIdString = "show" diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs" index 48b5616..7faeb01 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -839,6 +839,40 @@ genIterateOrGenerate'' len iter (Left res) f [app_f, start] = do -- Return the conditional generate part return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used) +genBlockRAM :: BuiltinBuilder +genBlockRAM = genNoInsts $ genExprArgs genBlockRAM' + +genBlockRAM' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession [AST.ConcSm] +genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do + -- Get the ram type + let (tup,data_out) = Type.splitAppTy (Var.varType res) + let (tup',ramvec) = Type.splitAppTy tup + let Just realram = Type.coreView ramvec + let Just (tycon, types) = Type.splitTyConApp_maybe realram + Just ram_vhdl_ty <- MonadState.lift tsType $ vhdl_ty "wtf" (head types) + -- Make the intermediate vector + let ram_dec = AST.BDISD $ AST.SigDec ram_id ram_vhdl_ty Nothing + -- Get the data_out name + reslabels <- MonadState.lift tsType $ getFieldLabels (Var.varType res) + let resname' = varToVHDLName res + let resname = mkSelectedName resname' (reslabels!!0) + let argexpr = vhdlNameToVHDLExpr $ mkIndexedName (AST.NSimple ram_id) rdaddr + let assign = mkUncondAssign (Right resname) argexpr + let block_label = mkVHDLExtId ("blockRAM" ++ (varToString res)) + let block = AST.BlockSm block_label [] (AST.PMapAspect []) [ram_dec] [assign, mkUpdateProcSm] + return [AST.CSBSm block] + where + ram_id = mkVHDLBasicId "ram" + mkUpdateProcSm :: AST.ConcSm + mkUpdateProcSm = AST.CSPSm $ AST.ProcSm proclabel [clockId] [statement] + where + proclabel = mkVHDLBasicId "updateRAM" + rising_edge = mkVHDLBasicId "rising_edge" + ramloc = mkIndexedName (AST.NSimple ram_id) wraddr + wform = AST.Wform [AST.WformElem data_in Nothing] + ramassign = AST.SigAssign ramloc wform + rising_edge_clk = genExprFCall rising_edge (AST.PrimName $ AST.NSimple clockId) + statement = AST.IfSm (AST.And rising_edge_clk (wrenable AST.:=: AST.PrimLit "'1'")) [ramassign] [] Nothing ----------------------------------------------------------------------------- -- Function to generate VHDL for applications @@ -1422,6 +1456,7 @@ globalNameTable = Map.fromList , (smallIntegerId , (1, genFromInteger ) ) , (fstId , (1, genFst ) ) , (sndId , (1, genSnd ) ) + , (blockRAMId , (5, genBlockRAM ) ) --, (tfvecId , (1, genTFVec ) ) , (minimumId , (2, error $ "\nFunction name: \"minimum\" is used internally, use another name")) ] diff --git a/reducer.hs b/reducer.hs index 65730f4..2dba485 100644 --- a/reducer.hs +++ b/reducer.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators, TemplateHaskell #-} +{-# LANGUAGE TypeOperators, TemplateHaskell, FlexibleContexts, TypeFamilies #-} module Reducer where import System.Random @@ -18,8 +18,6 @@ type DataInt = SizedWord DataSize type ArrayIndex = SizedWord IndexSize type Discr = RangedWord DiscrRange -type RAM a = Vector (DiscrRange :+: D1) a - type ReducerState = State ( DiscrState , InputState , FpAdderState @@ -30,8 +28,6 @@ type ReducerSignal = ( ( DataInt ) , Bit ) - -type MemState a = State (RAM a) type OutputSignal = ( (DataInt , ArrayIndex @@ -49,10 +45,10 @@ type InputState = State ( Vector (AdderDepth :+: D1) ReducerSignal type FpAdderState = State (Vector AdderDepth ReducerSignal) -type OutputState = State ( MemState DataInt - , MemState DataInt - , RAM ArrayIndex - , RAM Bit +type OutputState = State ( MemState DiscrRange DataInt + , MemState DiscrRange DataInt + , RAM DiscrRange ArrayIndex + , RAM DiscrRange Bit ) {- Discriminator adds a discriminator to each input value @@ -177,39 +173,6 @@ fpAdder (State state) (input1, input2, grant, mem_out) = (State state', output) | otherwise = High -- Shift addition of the two operants into the pipeline state' = (((operant1 + operant2),discr),valid) +> (init state) - - -{- -first attempt at BlockRAM - -State: -mem: content of the RAM - -Input: -data_in: input value to be written to 'mem' at location 'wraddr' -rdaddr: read address -wraddr: write address -wrenable: write enable flag - -Output: -data_out: value of 'mem' at location 'rdaddr' --} -{-# NOINLINE blockRAM #-} -blockRAM :: (MemState a) -> - ( a - , Discr - , Discr - , Bit - ) -> - ((MemState a), a ) -blockRAM (State mem) (data_in, rdaddr, wraddr, wrenable) = - ((State mem'), data_out) - where - data_out = mem!rdaddr - -- Only write data_in to memory if write is enabled - mem' = case wrenable of - Low -> mem - High -> replace mem wraddr data_in {- Output logic - Determines when values are released from blockram to the output @@ -256,16 +219,8 @@ outputter (State (mem1, mem2, lut, valid)) -- Location becomes invalid when it is fed back into the pipeline valid' | wrenable == Low = replace valid'' rdaddr Low | otherwise = replace valid'' wraddr High - (mem1', mem_out1) = blockRAM mem1 ( data_in - , rdaddr - , wraddr - , wrenable - ) - (mem2', mem_out2) = blockRAM mem2 ( data_in - , discr - , wraddr - , wrenable - ) + (mem1', mem_out1) = blockRAM mem1 data_in rdaddr wraddr wrenable + (mem2', mem_out2) = blockRAM mem2 data_in discr wraddr wrenable data_out = ( ( (mem_out1) , rdaddr )