-- -- Copyright (c) 2009-2010, ERICSSON AB All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are met: -- -- * Redistributions of source code must retain the above copyright notice, -- this list of conditions and the following disclaimer. -- * Redistributions in binary form must reproduce the above copyright -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. -- * Neither the name of the ERICSSON AB nor the names of its contributors -- may be used to endorse or promote products derived from this software -- without specific prior written permission. -- -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS -- BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, -- OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF -- THE POSSIBILITY OF SUCH DAMAGE. -- module Feldspar.Compiler.Platforms ( availablePlatforms , c99 , tic64x ) where import Feldspar.Compiler.Options import Feldspar.Compiler.Imperative.Representation import Feldspar.Compiler.Imperative.Semantics(IsRestrict(..)) import Feldspar.Compiler.Imperative.CodeGeneration (typeof) availablePlatforms :: [Platform] availablePlatforms = [ c99, tic64x ] -- ansiC = Platform "ansiC" undefined [] [] ["\"feldspar.h\""] NoRestrict c99 = Platform { name = "c99", types = [ (Numeric ImpSigned S8, "int8_t", "int8") , (Numeric ImpSigned S16, "int16_t", "int16") , (Numeric ImpSigned S32, "int32_t", "int32") , (Numeric ImpSigned S64, "int64_t", "int64") , (Numeric ImpUnsigned S8, "uint8_t", "uint8") , (Numeric ImpUnsigned S16, "uint16_t", "uint16") , (Numeric ImpUnsigned S32, "uint32_t", "uint32") , (Numeric ImpUnsigned S64, "uint64_t", "uint64") , (BoolType, "int", "int") , (FloatType, "float", "float") ] , values = [] , primitives = [ (FeldPrimDesc "(==)" [AllT, AllT], Left $ Op2 "==") , (FeldPrimDesc "(/=)" [AllT, AllT], Left $ Op2 "!=") , (FeldPrimDesc "(<)" [AllT, AllT], Left $ Op2 "<") , (FeldPrimDesc "(>)" [AllT, AllT], Left $ Op2 ">") , (FeldPrimDesc "(<=)" [AllT, AllT], Left $ Op2 "<=") , (FeldPrimDesc "(>=)" [AllT, AllT], Left $ Op2 ">=") , (FeldPrimDesc "not" [BoolT], Left $ Op1 "!") , (FeldPrimDesc "(&&)" [BoolT, BoolT], Left $ Op2 "&&") , (FeldPrimDesc "(||)" [BoolT, BoolT], Left $ Op2 "||") , (FeldPrimDesc "quot" [AllT, AllT], Right optimizedDivide) , (FeldPrimDesc "rem" [AllT, AllT], Left $ Op2 "%") , (FeldPrimDesc "(^)" [AllT, AllT], Left $ Fun "pow" firstInFP) , (FeldPrimDesc "negate" [AllT], Left $ Op1 "-") , (FeldPrimDesc "abs" [IntTU], Left Assig) , (FeldPrimDesc "abs" [FloatT], Left $ Fun "fabsf" noneFP) , (FeldPrimDesc "abs" [AllT], Left $ Fun "abs" firstInFP) , (FeldPrimDesc "signum" [AllT], Left $ Fun "signum" firstInFP) , (FeldPrimDesc "(+)" [AllT, AllT], Left $ Op2 "+") , (FeldPrimDesc "(-)" [AllT, AllT], Left $ Op2 "-") , (FeldPrimDesc "(*)" [AllT, AllT], Right optimizedMultiply) , (FeldPrimDesc "(/)" [AllT, AllT], Left $ Op2 "/") , (FeldPrimDesc "(.&.)" [IntT, IntT], Left $ Op2 "&") , (FeldPrimDesc "(.|.)" [IntT, IntT], Left $ Op2 "|") , (FeldPrimDesc "xor" [IntT, IntT], Left $ Op2 "^") , (FeldPrimDesc "complement" [IntT], Left $ Op1 "~") , (FeldPrimDesc "bit" [IntT], Right bitFunToShift) , (FeldPrimDesc "setBit" [IntT, IntT], Left $ Fun "setBit" firstInFP) , (FeldPrimDesc "clearBit" [IntT, IntT], Left $ Fun "clearBit" firstInFP) , (FeldPrimDesc "complementBit" [IntT, IntT], Left $ Fun "complementBit" firstInFP) , (FeldPrimDesc "testBit" [IntT, IntT], Left $ Fun "testBit" firstInFP) , (FeldPrimDesc "shiftL" [IntT, IntT], Left $ Op2 "<<") , (FeldPrimDesc "shiftR" [IntT, IntT], Left $ Op2 ">>") , (FeldPrimDesc "rotateL" [IntT, IntT], Left $ Fun "rotateL" firstInFP) , (FeldPrimDesc "rotateR" [IntT, IntT], Left $ Fun "rotateR" firstInFP) , (FeldPrimDesc "reverseBits" [IntT], Left $ Fun "reverseBits" firstInFP) , (FeldPrimDesc "bitScan" [IntT], Left $ Fun "bitScan" firstInFP) , (FeldPrimDesc "bitCount" [IntT], Left $ Fun "bitCount" firstInFP) , (FeldPrimDesc "bitSize" [IntT], Right bitSizeFunToConst) , (FeldPrimDesc "isSigned" [IntT], Right isSignedFunToConst) ] , includes = ["\"feldspar_c99.h\"", "", ""], isRestrict = NoRestrict } tic64x = Platform { name = "tic64x", types = [ (Numeric ImpSigned S8, "char", "char") , (Numeric ImpSigned S16, "short", "short") , (Numeric ImpSigned S32, "int", "int") , (Numeric ImpSigned S40, "long", "long") , (Numeric ImpSigned S64, "long long","llong") , (Numeric ImpUnsigned S8, "unsigned char", "uchar") , (Numeric ImpUnsigned S16, "unsigned short", "ushort") , (Numeric ImpUnsigned S32, "unsigned", "uint") , (Numeric ImpUnsigned S40, "unsigned long", "ulong") , (Numeric ImpUnsigned S64, "unsigned long long", "ullong") , (BoolType, "int", "int") , (FloatType, "float", "float") ] , values = [] , primitives = [ (FeldPrimDesc "abs" [IntTS_ S32], Left $ Fun "_abs" noneFP) , (FeldPrimDesc "abs" [FloatT], Left $ Fun "_fabsf" noneFP) , (FeldPrimDesc "rotateL" [IntTU_ S32, IntT], Left $ Fun "_rotl" noneFP) , (FeldPrimDesc "reverseBits" [IntTU_ S32], Left $ Fun "_bitr" noneFP) , (FeldPrimDesc "bitCount" [IntTU_ S32], Right optimizedBitCount) ] ++ primitives c99, includes = ["\"feldspar_tic64x.h\"", ""], isRestrict = Restrict } optimizedMultiply :: TransformPrim optimizedMultiply _ [x, y] [o] = case (x,y) of (_, (Expression (ConstantExpression (Constant (IntConstant _) _)) _)) -> optimizedMultiply' x y ((Expression (ConstantExpression (Constant (IntConstant _) _)) _), _) -> optimizedMultiply' y x (_, _) -> [(Op2 "*", [x, y], [o])] where optimizedMultiply' int con | (machTypes IntT $ typeof int) && (con' >= 0) && (2 ^ (numberOfTwoPrimeFactors con') == con') = [ (Op2 "<<", [int, (intToCe $ numberOfTwoPrimeFactors con')], [o]) ] | (machTypes IntT $ typeof int) && (con' < 0) && (2 ^ (numberOfTwoPrimeFactors $ con'*(-1)) == con'*(-1)) = [ (Op2 "<<", [int, (intToCe $ numberOfTwoPrimeFactors $ con'*(-1))], [o]) , (Op1 "-", [lToe o], [o]) ] | otherwise = [(Op2 "*", [x, y], [o])] where con' = ceToInt con optimizedDivide :: TransformPrim optimizedDivide _ [x, y] [o] = case (x,y) of (_, (Expression (ConstantExpression (Constant (IntConstant _) _)) _)) -> optimizedDivide' x y (_, _) -> [(Op2 "/", [x, y], [o])] where optimizedDivide' int con | (machTypes IntT $ typeof int) && (con' >= 0) && (2 ^ (numberOfTwoPrimeFactors con') == con') = [ (Op2 ">>", [int, (intToCe $ numberOfTwoPrimeFactors con')], [o]) ] | (machTypes IntT $ typeof int) && (con' < 0) && (2 ^ (numberOfTwoPrimeFactors $ con'*(-1)) == con'*(-1)) = [ (Op2 ">>", [int, (intToCe $ numberOfTwoPrimeFactors $ con'*(-1))], [o]) , (Op1 "-", [lToe o], [o]) ] | otherwise = [(Op2 "/", [x, y], [o])] where con' = ceToInt con bitFunToShift _ [i] [o] = [ (Op2 "<<", [intToCe 1, i], [o]) ] bitSizeFunToConst :: TransformPrim bitSizeFunToConst _ [i] [o] = case (typeof i) of (Numeric _ S8) -> [ (Assig, [intToCe 8], [o]) ] (Numeric _ S16) -> [ (Assig, [intToCe 16], [o]) ] (Numeric _ S32) -> [ (Assig, [intToCe 32], [o]) ] (Numeric _ S40) -> [ (Assig, [intToCe 40], [o]) ] (Numeric _ S64) -> [ (Assig, [intToCe 64], [o]) ] isSignedFunToConst :: TransformPrim isSignedFunToConst _ [i] [o] = case (typeof i) of (Numeric ImpSigned _) -> [ (Assig, [boolToCe True], [o]) ] (Numeric ImpUnsigned _) -> [ (Assig, [boolToCe False], [o]) ] optimizedBitCount :: TransformPrim optimizedBitCount _ [i] [o] = [ (Fun "_bitc4" noneFP, [i], [o]) , (Fun "_dotpu4" noneFP, [lToe o, intToCe 0x01010101], [o]) ] numberOfTwoPrimeFactors 2 = 1 numberOfTwoPrimeFactors x | x `mod` 2 == 0 = (numberOfTwoPrimeFactors $ x `div` 2) + 1 | otherwise = 0 ceToInt (Expression (ConstantExpression (Constant (IntConstant (IntConstantType x _)) _)) _) = x intToCe x = Expression (ConstantExpression $ Constant (IntConstant $ IntConstantType x ()) ()) () boolToCe x = Expression (ConstantExpression $ Constant (BoolConstant $ BoolConstantType x ()) ()) () lToe x = Expression (LeftValueExpression x) ()