summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/cmm/CmmUtils.hs34
-rw-r--r--compiler/codeGen/StgCmmLayout.hs64
-rw-r--r--compiler/ghci/ByteCodeAsm.lhs26
-rw-r--r--compiler/llvmGen/LlvmCodeGen/CodeGen.hs11
-rw-r--r--compiler/types/TyCon.lhs52
5 files changed, 126 insertions, 61 deletions
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index c822da9673..435df58596 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -62,7 +62,7 @@ module CmmUtils(
#include "HsVersions.h"
-import TyCon ( PrimRep(..) )
+import TyCon ( PrimRep(..), PrimElemRep(..) )
import Type ( UnaryType, typePrimRep )
import SMRep
@@ -87,15 +87,28 @@ import Hoopl
---------------------------------------------------
primRepCmmType :: DynFlags -> PrimRep -> CmmType
-primRepCmmType _ VoidRep = panic "primRepCmmType:VoidRep"
-primRepCmmType dflags PtrRep = gcWord dflags
-primRepCmmType dflags IntRep = bWord dflags
-primRepCmmType dflags WordRep = bWord dflags
-primRepCmmType _ Int64Rep = b64
-primRepCmmType _ Word64Rep = b64
-primRepCmmType dflags AddrRep = bWord dflags
-primRepCmmType _ FloatRep = f32
-primRepCmmType _ DoubleRep = f64
+primRepCmmType _ VoidRep = panic "primRepCmmType:VoidRep"
+primRepCmmType dflags PtrRep = gcWord dflags
+primRepCmmType dflags IntRep = bWord dflags
+primRepCmmType dflags WordRep = bWord dflags
+primRepCmmType _ Int64Rep = b64
+primRepCmmType _ Word64Rep = b64
+primRepCmmType dflags AddrRep = bWord dflags
+primRepCmmType _ FloatRep = f32
+primRepCmmType _ DoubleRep = f64
+primRepCmmType _ (VecRep len rep) = vec len (primElemRepCmmType rep)
+
+primElemRepCmmType :: PrimElemRep -> CmmType
+primElemRepCmmType Int8ElemRep = b8
+primElemRepCmmType Int16ElemRep = b16
+primElemRepCmmType Int32ElemRep = b32
+primElemRepCmmType Int64ElemRep = b64
+primElemRepCmmType Word8ElemRep = b8
+primElemRepCmmType Word16ElemRep = b16
+primElemRepCmmType Word32ElemRep = b32
+primElemRepCmmType Word64ElemRep = b64
+primElemRepCmmType FloatElemRep = f32
+primElemRepCmmType DoubleElemRep = f64
typeCmmType :: DynFlags -> UnaryType -> CmmType
typeCmmType dflags ty = primRepCmmType dflags (typePrimRep ty)
@@ -110,6 +123,7 @@ primRepForeignHint Word64Rep = NoHint
primRepForeignHint AddrRep = AddrHint -- NB! AddrHint, but NonPtrArg
primRepForeignHint FloatRep = NoHint
primRepForeignHint DoubleRep = NoHint
+primRepForeignHint (VecRep {}) = NoHint
typeForeignHint :: UnaryType -> ForeignHint
typeForeignHint = primRepForeignHint . typePrimRep
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 8544709bd8..a3bbefeb44 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -46,7 +46,7 @@ import CLabel
import StgSyn
import Id
import Name
-import TyCon ( PrimRep(..) )
+import TyCon ( PrimRep(..), primElemRepSizeB )
import BasicTypes ( RepArity )
import DynFlags
import Module
@@ -317,6 +317,7 @@ slowCallPattern (N: _) = (fsLit "stg_ap_n", 1)
slowCallPattern (F: _) = (fsLit "stg_ap_f", 1)
slowCallPattern (D: _) = (fsLit "stg_ap_d", 1)
slowCallPattern (L: _) = (fsLit "stg_ap_l", 1)
+slowCallPattern (V16: _) = (fsLit "stg_ap_v16", 1)
slowCallPattern [] = (fsLit "stg_ap_0", 0)
@@ -333,36 +334,42 @@ data ArgRep = P -- GC Ptr
| V -- Void
| F -- Float
| D -- Double
+ | V16 -- 16-byte (128-bit) vectors of Float/Double/Int8/Word32/etc.
instance Outputable ArgRep where
- ppr P = text "P"
- ppr N = text "N"
- ppr L = text "L"
- ppr V = text "V"
- ppr F = text "F"
- ppr D = text "D"
+ ppr P = text "P"
+ ppr N = text "N"
+ ppr L = text "L"
+ ppr V = text "V"
+ ppr F = text "F"
+ ppr D = text "D"
+ ppr V16 = text "V16"
toArgRep :: PrimRep -> ArgRep
-toArgRep VoidRep = V
-toArgRep PtrRep = P
-toArgRep IntRep = N
-toArgRep WordRep = N
-toArgRep AddrRep = N
-toArgRep Int64Rep = L
-toArgRep Word64Rep = L
-toArgRep FloatRep = F
-toArgRep DoubleRep = D
+toArgRep VoidRep = V
+toArgRep PtrRep = P
+toArgRep IntRep = N
+toArgRep WordRep = N
+toArgRep AddrRep = N
+toArgRep Int64Rep = L
+toArgRep Word64Rep = L
+toArgRep FloatRep = F
+toArgRep DoubleRep = D
+toArgRep (VecRep len elem)
+ | len*primElemRepSizeB elem == 16 = V16
+ | otherwise = error "toArgRep: bad vector primrep"
isNonV :: ArgRep -> Bool
isNonV V = False
isNonV _ = True
argRepSizeW :: DynFlags -> ArgRep -> WordOff -- Size in words
-argRepSizeW _ N = 1
-argRepSizeW _ P = 1
-argRepSizeW _ F = 1
-argRepSizeW dflags L = wORD64_SIZE `quot` wORD_SIZE dflags
-argRepSizeW dflags D = dOUBLE_SIZE dflags `quot` wORD_SIZE dflags
-argRepSizeW _ V = 0
+argRepSizeW _ N = 1
+argRepSizeW _ P = 1
+argRepSizeW _ F = 1
+argRepSizeW dflags L = wORD64_SIZE `quot` wORD_SIZE dflags
+argRepSizeW dflags D = dOUBLE_SIZE dflags `quot` wORD_SIZE dflags
+argRepSizeW _ V = 0
+argRepSizeW dflags V16 = 16 `quot` wORD_SIZE dflags
idArgRep :: Id -> ArgRep
idArgRep = toArgRep . idPrimRep
@@ -456,12 +463,13 @@ argBits dflags (arg : args) = take (argRepSizeW dflags arg) (repeat True)
stdPattern :: [ArgRep] -> Maybe Int
stdPattern reps
= case reps of
- [] -> Just ARG_NONE -- just void args, probably
- [N] -> Just ARG_N
- [P] -> Just ARG_P
- [F] -> Just ARG_F
- [D] -> Just ARG_D
- [L] -> Just ARG_L
+ [] -> Just ARG_NONE -- just void args, probably
+ [N] -> Just ARG_N
+ [P] -> Just ARG_P
+ [F] -> Just ARG_F
+ [D] -> Just ARG_D
+ [L] -> Just ARG_L
+ [V16] -> Just ARG_V16
[N,N] -> Just ARG_NN
[N,P] -> Just ARG_NP
diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 9631add3a9..b63778c801 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -437,20 +437,22 @@ isLarge :: Word -> Bool
isLarge n = n > 65535
push_alts :: ArgRep -> Word16
-push_alts V = bci_PUSH_ALTS_V
-push_alts P = bci_PUSH_ALTS_P
-push_alts N = bci_PUSH_ALTS_N
-push_alts L = bci_PUSH_ALTS_L
-push_alts F = bci_PUSH_ALTS_F
-push_alts D = bci_PUSH_ALTS_D
+push_alts V = bci_PUSH_ALTS_V
+push_alts P = bci_PUSH_ALTS_P
+push_alts N = bci_PUSH_ALTS_N
+push_alts L = bci_PUSH_ALTS_L
+push_alts F = bci_PUSH_ALTS_F
+push_alts D = bci_PUSH_ALTS_D
+push_alts V16 = error "push_alts: vector"
return_ubx :: ArgRep -> Word16
-return_ubx V = bci_RETURN_V
-return_ubx P = bci_RETURN_P
-return_ubx N = bci_RETURN_N
-return_ubx L = bci_RETURN_L
-return_ubx F = bci_RETURN_F
-return_ubx D = bci_RETURN_D
+return_ubx V = bci_RETURN_V
+return_ubx P = bci_RETURN_P
+return_ubx N = bci_RETURN_N
+return_ubx L = bci_RETURN_L
+return_ubx F = bci_RETURN_F
+return_ubx D = bci_RETURN_D
+return_ubx V16 = error "return_ubx: vector"
-- Make lists of host-sized words for literals, so that when the
-- words are placed in memory at increasing addresses, the
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 28933831f4..b7e085116d 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -1260,6 +1260,17 @@ genLit opt env (CmmInt i w)
genLit _ env (CmmFloat r w)
= return (env, LMLitVar $ LMFloatLit (fromRational r) (widthToLlvmFloat w),
nilOL, [])
+
+genLit opt env (CmmVec ls)
+ = do llvmLits <- mapM toLlvmLit ls
+ return (env, LMLitVar $ LMVectorLit llvmLits, nilOL, [])
+ where
+ toLlvmLit :: CmmLit -> UniqSM LlvmLit
+ toLlvmLit lit = do
+ (_, llvmLitVar, _, _) <- genLit opt env lit
+ case llvmLitVar of
+ LMLitVar llvmLit -> return llvmLit
+ _ -> panic "genLit"
genLit _ env cmm@(CmmLabel l)
= let dflags = getDflags env
diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 1ad8a297ad..2ad8db01b0 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -79,9 +79,9 @@ module TyCon(
pprPromotionQuote,
-- * Primitive representations of Types
- PrimRep(..),
+ PrimRep(..), PrimElemRep(..),
tyConPrimRep,
- primRepSizeW
+ primRepSizeW, primElemRepSizeB
) where
#include "HsVersions.h"
@@ -784,22 +784,52 @@ data PrimRep
| AddrRep -- ^ A pointer, but /not/ to a Haskell value (use 'PtrRep')
| FloatRep
| DoubleRep
+ | VecRep Int PrimElemRep -- ^ A vector
deriving( Eq, Show )
+data PrimElemRep
+ = Int8ElemRep
+ | Int16ElemRep
+ | Int32ElemRep
+ | Int64ElemRep
+ | Word8ElemRep
+ | Word16ElemRep
+ | Word32ElemRep
+ | Word64ElemRep
+ | FloatElemRep
+ | DoubleElemRep
+ deriving( Eq, Show )
+
instance Outputable PrimRep where
ppr r = text (show r)
+instance Outputable PrimElemRep where
+ ppr r = text (show r)
+
-- | Find the size of a 'PrimRep', in words
primRepSizeW :: DynFlags -> PrimRep -> Int
-primRepSizeW _ IntRep = 1
-primRepSizeW _ WordRep = 1
-primRepSizeW dflags Int64Rep = wORD64_SIZE `quot` wORD_SIZE dflags
-primRepSizeW dflags Word64Rep= wORD64_SIZE `quot` wORD_SIZE dflags
-primRepSizeW _ FloatRep = 1 -- NB. might not take a full word
-primRepSizeW dflags DoubleRep= dOUBLE_SIZE dflags `quot` wORD_SIZE dflags
-primRepSizeW _ AddrRep = 1
-primRepSizeW _ PtrRep = 1
-primRepSizeW _ VoidRep = 0
+primRepSizeW _ IntRep = 1
+primRepSizeW _ WordRep = 1
+primRepSizeW dflags Int64Rep = wORD64_SIZE `quot` wORD_SIZE dflags
+primRepSizeW dflags Word64Rep = wORD64_SIZE `quot` wORD_SIZE dflags
+primRepSizeW _ FloatRep = 1 -- NB. might not take a full word
+primRepSizeW dflags DoubleRep = dOUBLE_SIZE dflags `quot` wORD_SIZE dflags
+primRepSizeW _ AddrRep = 1
+primRepSizeW _ PtrRep = 1
+primRepSizeW _ VoidRep = 0
+primRepSizeW dflags (VecRep len rep) = len * primElemRepSizeB rep `quot` wORD_SIZE dflags
+
+primElemRepSizeB :: PrimElemRep -> Int
+primElemRepSizeB Int8ElemRep = 1
+primElemRepSizeB Int16ElemRep = 2
+primElemRepSizeB Int32ElemRep = 4
+primElemRepSizeB Int64ElemRep = 8
+primElemRepSizeB Word8ElemRep = 1
+primElemRepSizeB Word16ElemRep = 2
+primElemRepSizeB Word32ElemRep = 4
+primElemRepSizeB Word64ElemRep = 8
+primElemRepSizeB FloatElemRep = 4
+primElemRepSizeB DoubleElemRep = 8
\end{code}
%************************************************************************
View Lorry Controller Status