From: christiaanb Date: Thu, 17 Jun 2010 21:14:07 +0000 (+0200) Subject: Add shiftL and shiftR operators for signed and unsigned. Update name of shiftl and... X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;ds=sidebyside;h=30969fa41ee30295f00cf089f4ee4385bb709871;hp=a37aac300ad93f0fd5edbed645655c2af2915002;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Add shiftL and shiftR operators for signed and unsigned. Update name of shiftl and shiftr in Vector type to shiftIntoL and shiftIntoR --- diff --git a/HigherOrderCPU.hs b/HigherOrderCPU.hs index 8e3f0da..9b151d1 100644 --- a/HigherOrderCPU.hs +++ b/HigherOrderCPU.hs @@ -18,9 +18,9 @@ fu1 = fu (+) fu2 = fu (-) fu3 = fu (*) -data Opcode = Shift | Xor | Equal +data Opcode = ShiftL | Xor | Equal -multiop Shift = shift +multiop ShiftL = shiftL multiop Xor = xor multiop Equal = \a b -> if a == b then 1 else 0 @@ -40,16 +40,5 @@ cpu (State s) (x,opc,addrs) = (State s', out) (fu3 inputs (addrs!3)) +> empty))) out = last s - - - - - - --- Some minor details cpuState :: Vector D4 (Signed D16) cpuState = copy 0 - -const a b = a -xor = const -shift = const diff --git a/clash/CLasH/HardwareTypes.hs b/clash/CLasH/HardwareTypes.hs index dbb0eca..572a64e 100644 --- a/clash/CLasH/HardwareTypes.hs +++ b/clash/CLasH/HardwareTypes.hs @@ -2,11 +2,13 @@ module CLasH.HardwareTypes ( module Types + , module Data.Param.Integer , module Data.Param.Vector , module Data.Param.Index , module Data.Param.Signed , module Data.Param.Unsigned , module Prelude + , module Data.Bits , Bit(..) , State(..) , hwand @@ -21,10 +23,12 @@ module CLasH.HardwareTypes import qualified Prelude as P import Prelude (Bool(..),Num(..),Eq(..),Ord(..),snd,fst,otherwise,(&&),(||),not) import Types +import Data.Param.Integer (HWBits(..)) import Data.Param.Vector import Data.Param.Index import Data.Param.Signed import Data.Param.Unsigned +import Data.Bits hiding (shiftL,shiftR) import Language.Haskell.TH.Lift import Data.Typeable diff --git a/clash/CLasH/VHDL/Constants.hs b/clash/CLasH/VHDL/Constants.hs index 23ac95d..4267e2e 100644 --- a/clash/CLasH/VHDL/Constants.hs +++ b/clash/CLasH/VHDL/Constants.hs @@ -8,14 +8,14 @@ import qualified Language.VHDL.AST as AST -- circular dependencie. builtinIds = [ exId, replaceId, headId, lastId, tailId, initId, takeId, dropId , selId, plusgtId, ltplusId, plusplusId, mapId, zipWithId, foldlId - , foldrId, zipId, unzipId, shiftlId, shiftrId, rotlId, rotrId + , foldrId, zipId, unzipId, shiftIntoLId, shiftIntoRId, rotlId, rotrId , concatId, reverseId, iteratenId, iterateId, generatenId, generateId , emptyId, singletonId, copynId, copyId, lengthTId, nullId , hwxorId, hwandId, hworId, hwnotId, equalityId, inEqualityId, ltId , lteqId, gtId, gteqId, boolOrId, boolAndId, plusId, timesId , negateId, minusId, fromSizedWordId, fromIntegerId, resizeWordId , resizeIntId, sizedIntId, smallIntegerId, fstId, sndId, blockRAMId - , splitId, minimumId, fromRangedWordId + , splitId, minimumId, fromRangedWordId, xorId, shiftLId , shiftRId ] -------------- -- Identifiers @@ -154,12 +154,12 @@ dropId :: String dropId = "drop" -- | shiftl function identifier -shiftlId :: String -shiftlId = "shiftIntoL" +shiftIntoLId :: String +shiftIntoLId = "shiftIntoL" -- | shiftr function identifier -shiftrId :: String -shiftrId = "shiftIntoR" +shiftIntoRId :: String +shiftIntoRId = "shiftIntoR" -- | rotl function identifier rotlId :: String @@ -241,6 +241,15 @@ hwnotId = "hwnot" hwandId :: String hwandId = "hwand" +xorId :: String +xorId = "xor" + +shiftLId :: String +shiftLId = "shiftL" + +shiftRId :: String +shiftRId = "shiftR" + lengthTId :: String lengthTId = "lengthT" diff --git a/clash/CLasH/VHDL/Generate.hs b/clash/CLasH/VHDL/Generate.hs index 543e918..8c59334 100644 --- a/clash/CLasH/VHDL/Generate.hs +++ b/clash/CLasH/VHDL/Generate.hs @@ -1064,6 +1064,21 @@ genSplit' (Left res) f args@[(vecIn,vecInType)] = do { where vecSlice init last = AST.NSlice (AST.SliceName (varToVHDLName res) (AST.ToRange init last)) + +genSll :: BuiltinBuilder +genSll = genNoInsts $ genExprArgs $ genExprRes genSll' +genSll' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [(AST.Expr, Type.Type)] -> TranslatorSession AST.Expr +genSll' res f [(arg1,_),(arg2,_)] = do { + ; return $ (AST.Sll arg1 (genExprFCall (mkVHDLBasicId toIntegerId) arg2)) + } + +genSra :: BuiltinBuilder +genSra = genNoInsts $ genExprArgs $ genExprRes genSra' +genSra' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [(AST.Expr, Type.Type)] -> TranslatorSession AST.Expr +genSra' res f [(arg1,_),(arg2,_)] = do { + ; return $ (AST.Sra arg1 (genExprFCall (mkVHDLBasicId toIntegerId) arg2)) + } + ----------------------------------------------------------------------------- -- Function to generate VHDL for applications ----------------------------------------------------------------------------- @@ -1275,8 +1290,8 @@ genUnconsVectorFuns elemTM vectorTM = , (ltplusId, (AST.SubProgBody ltplusSpec [AST.SPVD ltplusVar] [ltplusExpr, ltplusRet],[])) , (plusplusId, (AST.SubProgBody plusplusSpec [AST.SPVD plusplusVar] [plusplusExpr, plusplusRet],[])) , (lengthTId, (AST.SubProgBody lengthTSpec [] [lengthTExpr],[])) - , (shiftlId, (AST.SubProgBody shiftlSpec [AST.SPVD shiftlVar] [shiftlExpr, shiftlRet], [initId])) - , (shiftrId, (AST.SubProgBody shiftrSpec [AST.SPVD shiftrVar] [shiftrExpr, shiftrRet], [tailId])) + , (shiftIntoLId, (AST.SubProgBody shiftlSpec [AST.SPVD shiftlVar] [shiftlExpr, shiftlRet], [initId])) + , (shiftIntoRId, (AST.SubProgBody shiftrSpec [AST.SPVD shiftrVar] [shiftrExpr, shiftrRet], [tailId])) , (nullId, (AST.SubProgBody nullSpec [] [nullExpr], [])) , (rotlId, (AST.SubProgBody rotlSpec [AST.SPVD rotlVar] [rotlExpr, rotlRet], [nullId, lastId, initId])) , (rotrId, (AST.SubProgBody rotrSpec [AST.SPVD rotrVar] [rotrExpr, rotrRet], [nullId, tailId, headId])) @@ -1504,7 +1519,7 @@ genUnconsVectorFuns elemTM vectorTM = lengthTSpec = AST.Function (mkVHDLExtId lengthTId) [AST.IfaceVarDec vecPar vectorTM] naturalTM lengthTExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)) - shiftlSpec = AST.Function (mkVHDLExtId shiftlId) [AST.IfaceVarDec vecPar vectorTM, + shiftlSpec = AST.Function (mkVHDLExtId shiftIntoLId) [AST.IfaceVarDec vecPar vectorTM, AST.IfaceVarDec aPar elemTM ] vectorTM -- variable res : fsvec_x (0 to vec'length-1); shiftlVar = @@ -1522,7 +1537,7 @@ genUnconsVectorFuns elemTM vectorTM = (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId)) [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)])) shiftlRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId) - shiftrSpec = AST.Function (mkVHDLExtId shiftrId) [AST.IfaceVarDec vecPar vectorTM, + shiftrSpec = AST.Function (mkVHDLExtId shiftIntoRId) [AST.IfaceVarDec vecPar vectorTM, AST.IfaceVarDec aPar elemTM ] vectorTM -- variable res : fsvec_x (0 to vec'length-1); shiftrVar = @@ -1662,8 +1677,8 @@ globalNameTable = Map.fromList , (foldrId , (3, genFoldr ) ) , (zipId , (2, genZip ) ) , (unzipId , (1, genUnzip ) ) - , (shiftlId , (2, genFCall False ) ) - , (shiftrId , (2, genFCall False ) ) + , (shiftIntoLId , (2, genFCall False ) ) + , (shiftIntoRId , (2, genFCall False ) ) , (rotlId , (1, genFCall False ) ) , (rotrId , (1, genFCall False ) ) , (concatId , (1, genConcat ) ) @@ -1706,6 +1721,9 @@ globalNameTable = Map.fromList , (sndId , (1, genSnd ) ) , (blockRAMId , (5, genBlockRAM ) ) , (splitId , (1, genSplit ) ) + , (xorId , (2, genOperator2 AST.Xor ) ) + , (shiftLId , (2, genSll ) ) + , (shiftRId , (2, genSra ) ) --, (tfvecId , (1, genTFVec ) ) , (minimumId , (2, error "\nFunction name: \"minimum\" is used internally, use another name")) ] diff --git a/clash/Data/Param/Index.hs b/clash/Data/Param/Index.hs index 2c4e88e..79d551d 100644 --- a/clash/Data/Param/Index.hs +++ b/clash/Data/Param/Index.hs @@ -8,7 +8,7 @@ module Data.Param.Index import Language.Haskell.TH import Language.Haskell.TH.Syntax (Lift(..)) -import Data.Bits +import qualified Data.Bits as B import Types import Types.Data.Num.Decimal.Literals.TH diff --git a/clash/Data/Param/Integer.hs b/clash/Data/Param/Integer.hs index 4e48d14..a57c0aa 100644 --- a/clash/Data/Param/Integer.hs +++ b/clash/Data/Param/Integer.hs @@ -2,12 +2,18 @@ module Data.Param.Integer ( Signed(..) , Unsigned(..) , Index (..) + , HWBits(..) ) where import Types +import qualified Data.Bits as B newtype (NaturalT nT) => Signed nT = Signed Integer newtype (NaturalT nT) => Unsigned nT = Unsigned Integer -newtype (PositiveT upper) => Index upper = Index Integer \ No newline at end of file +newtype (PositiveT upper) => Index upper = Index Integer + +class (B.Bits a) => HWBits a where + shiftL :: a -> a -> a + shiftR :: a -> a -> a diff --git a/clash/Data/Param/Signed.hs b/clash/Data/Param/Signed.hs index e85fe60..dc9ee21 100644 --- a/clash/Data/Param/Signed.hs +++ b/clash/Data/Param/Signed.hs @@ -6,7 +6,7 @@ module Data.Param.Signed import Language.Haskell.TH import Language.Haskell.TH.Syntax (Lift(..)) -import Data.Bits +import qualified Data.Bits as B import Types import Types.Data.Num.Decimal.Literals.TH @@ -28,7 +28,7 @@ sizeT _ = undefined mask :: forall nT . NaturalT nT => nT -> Integer -mask _ = bit (fromIntegerT (undefined :: nT)) - 1 +mask _ = B.bit (fromIntegerT (undefined :: nT)) - 1 signBit :: forall nT . NaturalT nT => nT @@ -39,7 +39,7 @@ isNegative :: forall nT . NaturalT nT => Signed nT -> Bool isNegative (Signed x) = - testBit x $ signBit (undefined :: nT) + B.testBit x $ signBit (undefined :: nT) instance NaturalT nT => Eq (Signed nT) where (Signed x) == (Signed y) = x == y @@ -58,8 +58,8 @@ instance NaturalT nT => Ord (Signed nT) where a `compare` b = toInteger a `compare` toInteger b instance NaturalT nT => Bounded (Signed nT) where - minBound = Signed $ negate $ 1 `shiftL` (fromIntegerT (undefined :: nT) - 1) - maxBound = Signed $ (1 `shiftL` (fromIntegerT (undefined :: nT) - 1)) - 1 + minBound = Signed $ negate $ 1 `B.shiftL` (fromIntegerT (undefined :: nT) - 1) + maxBound = Signed $ (1 `B.shiftL` (fromIntegerT (undefined :: nT) - 1)) - 1 instance NaturalT nT => Enum (Signed nT) where succ x @@ -91,13 +91,13 @@ instance NaturalT nT => Num (Signed nT) where (Signed a) * (Signed b) = fromInteger $ a * b negate (Signed n) = - fromInteger $ (n `xor` mask (undefined :: nT)) + 1 + fromInteger $ (n `B.xor` mask (undefined :: nT)) + 1 a - b = a + (negate b) fromInteger n | n > 0 = - Signed $ n .&. mask (undefined :: nT) + Signed $ n B..&. mask (undefined :: nT) fromInteger n | n < 0 = negate $ fromInteger $ negate n @@ -140,33 +140,37 @@ instance NaturalT nT => Integral (Signed nT) where then let Signed x' = negate s in negate x' else x -instance NaturalT nT => Bits (Signed nT) where - (Signed a) .&. (Signed b) = Signed $ a .&. b - (Signed a) .|. (Signed b) = Signed $ a .|. b - (Signed a) `xor` Signed b = Signed $ a `xor` b - complement (Signed x) = Signed $ x `xor` mask (undefined :: nT) +instance NaturalT nT => B.Bits (Signed nT) where + (Signed a) .&. (Signed b) = Signed $ a B..&. b + (Signed a) .|. (Signed b) = Signed $ a B..|. b + (Signed a) `xor` Signed b = Signed $ a `B.xor` b + complement (Signed x) = Signed $ x `B.xor` mask (undefined :: nT) (Signed x) `shiftL` b | b < 0 = error $ "Bits.shiftL{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to shift by negative amount" | otherwise = - Signed $ mask (undefined :: nT) .&. (x `shiftL` b) + Signed $ mask (undefined :: nT) B..&. (x `B.shiftL` b) s@(Signed x) `shiftR` b | b < 0 = error $ "Bits.shiftR{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to shift by negative amount" | isNegative s = - Signed $ mask (undefined :: nT) .&. - ((x `shiftR` b) .|. (mask (undefined :: nT) `shiftL` (fromIntegerT (undefined :: nT) - b))) + Signed $ mask (undefined :: nT) B..&. + ((x `B.shiftR` b) B..|. (mask (undefined :: nT) `B.shiftL` (fromIntegerT (undefined :: nT) - b))) | otherwise = - Signed $ (mask (undefined :: nT)) .&. (x `shiftR` b) + Signed $ (mask (undefined :: nT)) B..&. (x `B.shiftR` b) (Signed a) `rotateL` b | b < 0 = error $ "Bits.rotateL{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to rotate by negative amount" | otherwise = - Signed $ mask (undefined :: nT) .&. - ((a `shiftL` b) .|. (a `shiftR` (fromIntegerT (undefined :: nT) - b))) + Signed $ mask (undefined :: nT) B..&. + ((a `B.shiftL` b) B..|. (a `B.shiftR` (fromIntegerT (undefined :: nT) - b))) (Signed a) `rotateR` b | b < 0 = error $ "Bits.rotateR{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to rotate by negative amount" | otherwise = - Signed $ mask (undefined :: nT) .&. - ((a `shiftR` b) .|. (a `shiftL` (fromIntegerT (undefined :: nT) - b))) + Signed $ mask (undefined :: nT) B..&. + ((a `B.shiftR` b) B..|. (a `B.shiftL` (fromIntegerT (undefined :: nT) - b))) bitSize _ = fromIntegerT (undefined :: nT) isSigned _ = True + +instance NaturalT nT => HWBits (Signed nT) where + a `shiftL` b = a `B.shiftL` (fromInteger (toInteger b)) + a `shiftR` b = a `B.shiftR` (fromInteger (toInteger b)) diff --git a/clash/Data/Param/Unsigned.hs b/clash/Data/Param/Unsigned.hs index 6f06dbd..92dc24d 100644 --- a/clash/Data/Param/Unsigned.hs +++ b/clash/Data/Param/Unsigned.hs @@ -7,7 +7,7 @@ module Data.Param.Unsigned import Language.Haskell.TH import Language.Haskell.TH.Syntax (Lift(..)) -import Data.Bits +import qualified Data.Bits as B import Types import Types.Data.Num.Decimal.Literals.TH @@ -37,7 +37,7 @@ sizeT _ = undefined mask :: forall nT . NaturalT nT => nT -> Integer -mask _ = bit (fromIntegerT (undefined :: nT)) - 1 +mask _ = B.bit (fromIntegerT (undefined :: nT)) - 1 instance NaturalT nT => Eq (Unsigned nT) where (Unsigned x) == (Unsigned y) = x == y @@ -57,7 +57,7 @@ instance NaturalT nT => Ord (Unsigned nT) where instance NaturalT nT => Bounded (Unsigned nT) where minBound = 0 - maxBound = Unsigned $ (1 `shiftL` (fromIntegerT (undefined :: nT))) - 1 + maxBound = Unsigned $ (1 `B.shiftL` (fromIntegerT (undefined :: nT))) - 1 instance NaturalT nT => Enum (Unsigned nT) where succ x @@ -88,13 +88,13 @@ instance NaturalT nT => Num (Unsigned nT) where (Unsigned a) * (Unsigned b) = fromInteger $ a * b negate s@(Unsigned n) = - fromInteger $ (n `xor` mask (sizeT s)) + 1 + fromInteger $ (n `B.xor` mask (sizeT s)) + 1 a - b = a + (negate b) fromInteger n | n > 0 = - Unsigned $ n .&. mask (undefined :: nT) + Unsigned $ n B..&. mask (undefined :: nT) fromInteger n | n < 0 = negate $ fromInteger $ negate n @@ -128,30 +128,34 @@ instance NaturalT nT => Integral (Unsigned nT) where in (fromInteger div, fromInteger mod) toInteger s@(Unsigned x) = x -instance NaturalT nT => Bits (Unsigned nT) where - (Unsigned a) .&. (Unsigned b) = Unsigned $ a .&. b - (Unsigned a) .|. (Unsigned b) = Unsigned $ a .|. b - (Unsigned a) `xor` Unsigned b = Unsigned $ a `xor` b - complement (Unsigned x) = Unsigned $ x `xor` mask (undefined :: nT) +instance NaturalT nT => B.Bits (Unsigned nT) where + (Unsigned a) .&. (Unsigned b) = Unsigned $ a B..&. b + (Unsigned a) .|. (Unsigned b) = Unsigned $ a B..|. b + (Unsigned a) `xor` Unsigned b = Unsigned $ a `B.xor` b + complement (Unsigned x) = Unsigned $ x `B.xor` mask (undefined :: nT) s@(Unsigned x) `shiftL` b - | b < 0 = error $ "Bits.shiftL{Unsigned " ++ show (bitSize s) ++ "}: tried to shift by negative amount" + | b < 0 = error $ "Bits.shiftL{Unsigned " ++ show (B.bitSize s) ++ "}: tried to shift by negative amount" | otherwise = - Unsigned $ mask (undefined :: nT) .&. (x `shiftL` b) + Unsigned $ mask (undefined :: nT) B..&. (x `B.shiftL` b) s@(Unsigned x) `shiftR` b - | b < 0 = error $ "Bits.shiftR{Unsigned " ++ show (bitSize s) ++ "}: tried to shift by negative amount" + | b < 0 = error $ "Bits.shiftR{Unsigned " ++ show (B.bitSize s) ++ "}: tried to shift by negative amount" | otherwise = - Unsigned $ (x `shiftR` b) + Unsigned $ (x `B.shiftR` b) s@(Unsigned x) `rotateL` b | b < 0 = - error $ "Bits.rotateL{Unsigned " ++ show (bitSize s) ++ "}: tried to rotate by negative amount" + error $ "Bits.rotateL{Unsigned " ++ show (B.bitSize s) ++ "}: tried to rotate by negative amount" | otherwise = - Unsigned $ mask (undefined :: nT) .&. - ((x `shiftL` b) .|. (x `shiftR` (bitSize s - b))) + Unsigned $ mask (undefined :: nT) B..&. + ((x `B.shiftL` b) B..|. (x `B.shiftR` (B.bitSize s - b))) s@(Unsigned x) `rotateR` b | b < 0 = - error $ "Bits.rotateR{Unsigned " ++ show (bitSize s) ++ "}: tried to rotate by negative amount" + error $ "Bits.rotateR{Unsigned " ++ show (B.bitSize s) ++ "}: tried to rotate by negative amount" | otherwise = - Unsigned $ mask (undefined :: nT) .&. - ((x `shiftR` b) .|. (x `shiftL` (bitSize s - b))) + Unsigned $ mask (undefined :: nT) B..&. + ((x `B.shiftR` b) B..|. (x `B.shiftL` (B.bitSize s - b))) bitSize _ = fromIntegerT (undefined :: nT) isSigned _ = False + +instance NaturalT nT => HWBits (Unsigned nT) where + a `shiftL` b = a `B.shiftL` (fromInteger (toInteger b)) + a `shiftR` b = a `B.shiftR` (fromInteger (toInteger b))