From: Christiaan Baaij Date: Tue, 18 Aug 2009 11:43:59 +0000 (+0200) Subject: Used unsigned instead of natural as representation of RangedWord X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=400985092d148d05ffcc8259c5b12b0dc137a8e0;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Used unsigned instead of natural as representation of RangedWord --- diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs" index eff5d75..d1bf375 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -348,12 +348,13 @@ genFCall' switch (Left res) f args = do genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name genFromSizedWord :: BuiltinBuilder -genFromSizedWord = genNoInsts $ genExprArgs $ genExprRes genFromSizedWord' -genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr -genFromSizedWord' (Left res) f args = do - let fname = varToString f - return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId)) $ - map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args +genFromSizedWord = genNoInsts $ genExprArgs genFromSizedWord' +genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession [AST.ConcSm] +genFromSizedWord' (Left res) f args@[arg] = do + return $ [mkUncondAssign (Left res) arg] + -- let fname = varToString f + -- return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId)) $ + -- map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name genResize :: BuiltinBuilder @@ -382,17 +383,17 @@ genFromInteger' (Left res) f lits = do { ; (tycon, args) = Type.splitTyConApp ty ; name = Name.getOccString (TyCon.tyConName tycon) } ; - ; case name of - "RangedWord" -> return $ AST.PrimLit (show (last lits)) - otherwise -> do { - ; len <- case name of - "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty) - "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty) - "RangedWord" -> MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty) - ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId - ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname)) - [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))] + ; len <- case name of + "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty) + "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty) + "RangedWord" -> do { + ; bound <- MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty) + ; return $ floor (logBase 2 (fromInteger (toInteger (bound)))) + 1 } + ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId ; "RangedWord" -> toUnsignedId + ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname)) + [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))] + } genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name @@ -860,7 +861,8 @@ genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do 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 rdaddr_int = genExprFCall (mkVHDLBasicId toIntegerId) rdaddr + let argexpr = vhdlNameToVHDLExpr $ mkIndexedName (AST.NSimple ram_id) rdaddr_int 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] @@ -872,7 +874,8 @@ genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do where proclabel = mkVHDLBasicId "updateRAM" rising_edge = mkVHDLBasicId "rising_edge" - ramloc = mkIndexedName (AST.NSimple ram_id) wraddr + wraddr_int = genExprFCall (mkVHDLBasicId toIntegerId) wraddr + ramloc = mkIndexedName (AST.NSimple ram_id) wraddr_int wform = AST.Wform [AST.WformElem data_in Nothing] ramassign = AST.SigAssign ramloc wform rising_edge_clk = genExprFCall rising_edge (AST.PrimName $ AST.NSimple clockId) @@ -1055,12 +1058,11 @@ genUnconsVectorFuns elemTM vectorTM = sPar = AST.unsafeVHDLBasicId "s" resId = AST.unsafeVHDLBasicId "res" exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM, - AST.IfaceVarDec ixPar naturalTM] elemTM + AST.IfaceVarDec ixPar unsignedTM] elemTM exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed - (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $ - AST.NSimple ixPar])) + (AST.IndexedName (AST.NSimple vecPar) [genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ ixPar)])) replaceSpec = AST.Function (mkVHDLExtId replaceId) [ AST.IfaceVarDec vecPar vectorTM - , AST.IfaceVarDec iPar naturalTM + , AST.IfaceVarDec iPar unsignedTM , AST.IfaceVarDec aPar elemTM ] vectorTM -- variable res : fsvec_x (0 to vec'length-1); @@ -1075,7 +1077,7 @@ genUnconsVectorFuns elemTM vectorTM = Nothing -- res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1) replaceExpr1 = AST.NSimple resId AST.:= AST.PrimName (AST.NSimple vecPar) - replaceExpr2 = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [AST.PrimName $ AST.NSimple iPar]) AST.:= AST.PrimName (AST.NSimple aPar) + replaceExpr2 = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ iPar)]) AST.:= AST.PrimName (AST.NSimple aPar) replaceRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId) vecSlice init last = AST.PrimName (AST.NSlice (AST.SliceName diff --git "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs" "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs" index e5445a8..fedd8f5 100644 --- "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs" +++ "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs" @@ -437,9 +437,10 @@ mk_natural_ty :: -> TypeSession (Either String (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))) -- ^ An error message or The typemark created. mk_natural_ty min_bound max_bound = do - let ty_id = mkVHDLExtId $ "nat_" ++ (show min_bound) ++ "_to_" ++ (show max_bound) - let range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit $ (show min_bound)) (AST.PrimLit $ (show max_bound)) - let ty_def = AST.SubtypeIn naturalTM (Just range) + let bitsize = floor (logBase 2 (fromInteger (toInteger max_bound))) + let ty_id = mkVHDLExtId $ "natural_" ++ (show min_bound) ++ "_to_" ++ (show max_bound) + let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit $ show min_bound) (AST.PrimLit $ show bitsize)] + let ty_def = AST.SubtypeIn unsignedTM (Just range) return (Right $ Just (ty_id, Right ty_def)) mk_unsigned_ty :: @@ -682,14 +683,14 @@ mkBuiltInShow = [ AST.SubProgBody showBitSpec [] [showBitExpr] , AST.SubProgBody showBoolSpec [] [showBoolExpr] , AST.SubProgBody showSingedSpec [] [showSignedExpr] , AST.SubProgBody showUnsignedSpec [] [showUnsignedExpr] - , AST.SubProgBody showNaturalSpec [] [showNaturalExpr] + -- , AST.SubProgBody showNaturalSpec [] [showNaturalExpr] ] where bitPar = AST.unsafeVHDLBasicId "s" boolPar = AST.unsafeVHDLBasicId "b" signedPar = AST.unsafeVHDLBasicId "sint" unsignedPar = AST.unsafeVHDLBasicId "uint" - naturalPar = AST.unsafeVHDLBasicId "nat" + -- naturalPar = AST.unsafeVHDLBasicId "nat" showBitSpec = AST.Function showId [AST.IfaceVarDec bitPar std_logicTM] stringTM -- if s = '1' then return "'1'" else return "'0'" showBitExpr = AST.IfSm (AST.PrimName (AST.NSimple bitPar) AST.:=: AST.PrimLit "'1'") @@ -714,10 +715,10 @@ mkBuiltInShow = [ AST.SubProgBody showBitSpec [] [showBitExpr] (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [unsignToInt]) Nothing ) where unsignToInt = genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ unsignedPar) - showNaturalSpec = AST.Function showId [AST.IfaceVarDec naturalPar naturalTM] stringTM - showNaturalExpr = AST.ReturnSm (Just $ - AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId) - (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [AST.PrimName $ AST.NSimple $ naturalPar]) Nothing ) + -- showNaturalSpec = AST.Function showId [AST.IfaceVarDec naturalPar naturalTM] stringTM + -- showNaturalExpr = AST.ReturnSm (Just $ + -- AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId) + -- (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [AST.PrimName $ AST.NSimple $ naturalPar]) Nothing ) genExprFCall :: AST.VHDLId -> AST.Expr -> AST.Expr