summaryrefslogtreecommitdiff
path: root/compiler/codeGen
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/codeGen')
-rw-r--r--compiler/codeGen/CgUtils.hs14
-rw-r--r--compiler/codeGen/StgCmmExpr.hs2
-rw-r--r--compiler/codeGen/StgCmmForeign.hs10
-rw-r--r--compiler/codeGen/StgCmmHeap.hs2
-rw-r--r--compiler/codeGen/StgCmmLayout.hs4
-rw-r--r--compiler/codeGen/StgCmmMonad.hs20
-rw-r--r--compiler/codeGen/StgCmmPrim.hs188
7 files changed, 120 insertions, 120 deletions
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 1f0b82532b..67d8fd8817 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -36,10 +36,16 @@ baseRegOffset dflags (FloatReg 1) = oFFSET_StgRegTable_rF1 dflags
baseRegOffset dflags (FloatReg 2) = oFFSET_StgRegTable_rF2 dflags
baseRegOffset dflags (FloatReg 3) = oFFSET_StgRegTable_rF3 dflags
baseRegOffset dflags (FloatReg 4) = oFFSET_StgRegTable_rF4 dflags
-baseRegOffset _ (FloatReg n) = panic ("Registers above F4 are not supported (tried to use F" ++ show n ++ ")")
+baseRegOffset dflags (FloatReg 5) = oFFSET_StgRegTable_rF5 dflags
+baseRegOffset dflags (FloatReg 6) = oFFSET_StgRegTable_rF6 dflags
+baseRegOffset _ (FloatReg n) = panic ("Registers above F6 are not supported (tried to use F" ++ show n ++ ")")
baseRegOffset dflags (DoubleReg 1) = oFFSET_StgRegTable_rD1 dflags
baseRegOffset dflags (DoubleReg 2) = oFFSET_StgRegTable_rD2 dflags
-baseRegOffset _ (DoubleReg n) = panic ("Registers above D2 are not supported (tried to use D" ++ show n ++ ")")
+baseRegOffset dflags (DoubleReg 3) = oFFSET_StgRegTable_rD3 dflags
+baseRegOffset dflags (DoubleReg 4) = oFFSET_StgRegTable_rD4 dflags
+baseRegOffset dflags (DoubleReg 5) = oFFSET_StgRegTable_rD5 dflags
+baseRegOffset dflags (DoubleReg 6) = oFFSET_StgRegTable_rD6 dflags
+baseRegOffset _ (DoubleReg n) = panic ("Registers above D6 are not supported (tried to use D" ++ show n ++ ")")
baseRegOffset dflags Sp = oFFSET_StgRegTable_rSp dflags
baseRegOffset dflags SpLim = oFFSET_StgRegTable_rSpLim dflags
baseRegOffset dflags (LongReg 1) = oFFSET_StgRegTable_rL1 dflags
@@ -90,9 +96,9 @@ get_Regtable_addr_from_offset dflags _ offset =
fixStgRegisters :: DynFlags -> RawCmmDecl -> RawCmmDecl
fixStgRegisters _ top@(CmmData _ _) = top
-fixStgRegisters dflags (CmmProc info lbl (ListGraph blocks)) =
+fixStgRegisters dflags (CmmProc info lbl live (ListGraph blocks)) =
let blocks' = map (fixStgRegBlock dflags) blocks
- in CmmProc info lbl $ ListGraph blocks'
+ in CmmProc info lbl live $ ListGraph blocks'
fixStgRegBlock :: DynFlags -> CmmBasicBlock -> CmmBasicBlock
fixStgRegBlock dflags (BasicBlock id stmts) =
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index a0859252ff..9176cb330c 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -717,7 +717,7 @@ emitEnter fun = do
--
AssignTo res_regs _ -> do
{ lret <- newLabelC
- ; let (off, copyin) = copyInOflow dflags NativeReturn (Young lret) res_regs []
+ ; let (off, _, copyin) = copyInOflow dflags NativeReturn (Young lret) res_regs []
; lcall <- newLabelC
; updfr_off <- getUpdFrameOff
; let area = Young lret
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index e7925667a8..aef1e4f792 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -213,7 +213,7 @@ emitForeignCall safety results target args
updfr_off <- getUpdFrameOff
temp_target <- load_target_into_temp target
k <- newLabelC
- let (off, copyout) = copyInOflow dflags NativeReturn (Young k) results []
+ let (off, _, copyout) = copyInOflow dflags NativeReturn (Young k) results []
-- see Note [safe foreign call convention]
emit $
( mkStore (CmmStackSlot (Young k) (widthInBytes (wordWidth dflags)))
@@ -306,6 +306,11 @@ loadThreadState dflags tso stack = do
-- SpLim = stack->stack + RESERVED_STACK_WORDS;
mkAssign spLim (cmmOffsetW dflags (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_STACK dflags))
(rESERVED_STACK_WORDS dflags)),
+ -- HpAlloc = 0;
+ -- HpAlloc is assumed to be set to non-zero only by a failed
+ -- a heap check, see HeapStackCheck.cmm:GC_GENERIC
+ mkAssign hpAlloc (zeroExpr dflags),
+
openNursery dflags,
-- and load the current cost centre stack from the TSO when profiling:
if gopt Opt_SccProfilingOn dflags then
@@ -367,13 +372,14 @@ stgHp = CmmReg hp
stgCurrentTSO = CmmReg currentTSO
stgCurrentNursery = CmmReg currentNursery
-sp, spLim, hp, hpLim, currentTSO, currentNursery :: CmmReg
+sp, spLim, hp, hpLim, currentTSO, currentNursery, hpAlloc :: CmmReg
sp = CmmGlobal Sp
spLim = CmmGlobal SpLim
hp = CmmGlobal Hp
hpLim = CmmGlobal HpLim
currentTSO = CmmGlobal CurrentTSO
currentNursery = CmmGlobal CurrentNursery
+hpAlloc = CmmGlobal HpAlloc
-- -----------------------------------------------------------------------------
-- For certain types passed to foreign calls, we adjust the actual
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index 7393faac9f..7805473915 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -416,7 +416,7 @@ altOrNoEscapeHeapCheck checkYield regs code = do
Nothing -> genericGC checkYield code
Just gc -> do
lret <- newLabelC
- let (off, copyin) = copyInOflow dflags NativeReturn (Young lret) regs []
+ let (off, _, copyin) = copyInOflow dflags NativeReturn (Young lret) regs []
lcont <- newLabelC
emitOutOfLine lret (copyin <*> mkBranch lcont)
emitLabel lcont
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 39676635aa..bb0b8a78d0 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -126,7 +126,7 @@ emitCallWithExtraStack (callConv, retConv) fun args extra_stack
AssignTo res_regs _ -> do
k <- newLabelC
let area = Young k
- (off, copyin) = copyInOflow dflags retConv area res_regs []
+ (off, _, copyin) = copyInOflow dflags retConv area res_regs []
copyout = mkCallReturnsTo dflags fun callConv args k off updfr_off
extra_stack
emit (copyout <*> mkLabel k <*> copyin)
@@ -521,7 +521,7 @@ emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args body
; let args' = if node_points then (node : arg_regs) else arg_regs
conv = if nodeMustPointToIt dflags lf_info then NativeNodeCall
else NativeDirectCall
- (offset, _) = mkCallEntry dflags conv args' []
+ (offset, _, _) = mkCallEntry dflags conv args' []
; emitClosureAndInfoTable info_tbl conv args' $ body (offset, node, arg_regs)
}
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index b7797bdae6..7a0816f041 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -713,12 +713,12 @@ emitProcWithStackFrame
emitProcWithStackFrame _conv mb_info lbl _stk_args [] blocks False
= do { dflags <- getDynFlags
- ; emitProc_ mb_info lbl blocks (widthInBytes (wordWidth dflags)) False
+ ; emitProc_ mb_info lbl [] blocks (widthInBytes (wordWidth dflags)) False
}
emitProcWithStackFrame conv mb_info lbl stk_args args blocks True -- do layout
= do { dflags <- getDynFlags
- ; let (offset, entry) = mkCallEntry dflags conv args stk_args
- ; emitProc_ mb_info lbl (entry <*> blocks) offset True
+ ; let (offset, live, entry) = mkCallEntry dflags conv args stk_args
+ ; emitProc_ mb_info lbl live (entry <*> blocks) offset True
}
emitProcWithStackFrame _ _ _ _ _ _ _ = panic "emitProcWithStackFrame"
@@ -729,13 +729,13 @@ emitProcWithConvention :: Convention -> Maybe CmmInfoTable -> CLabel
emitProcWithConvention conv mb_info lbl args blocks
= emitProcWithStackFrame conv mb_info lbl [] args blocks True
-emitProc :: Maybe CmmInfoTable -> CLabel -> CmmAGraph -> Int -> FCode ()
-emitProc mb_info lbl blocks offset
- = emitProc_ mb_info lbl blocks offset True
+emitProc :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraph -> Int -> FCode ()
+emitProc mb_info lbl live blocks offset
+ = emitProc_ mb_info lbl live blocks offset True
-emitProc_ :: Maybe CmmInfoTable -> CLabel -> CmmAGraph -> Int -> Bool
+emitProc_ :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraph -> Int -> Bool
-> FCode ()
-emitProc_ mb_info lbl blocks offset do_layout
+emitProc_ mb_info lbl live blocks offset do_layout
= do { dflags <- getDynFlags
; l <- newLabelC
; let
@@ -751,7 +751,7 @@ emitProc_ mb_info lbl blocks offset do_layout
tinfo = TopInfo { info_tbls = infos
, stack_info=sinfo}
- proc_block = CmmProc tinfo lbl blks
+ proc_block = CmmProc tinfo lbl live blks
; state <- getState
; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
@@ -795,7 +795,7 @@ mkCall f (callConv, retConv) results actuals updfr_off extra_stack = do
dflags <- getDynFlags
k <- newLabelC
let area = Young k
- (off, copyin) = copyInOflow dflags retConv area results []
+ (off, _, copyin) = copyInOflow dflags retConv area results []
copyout = mkCallReturnsTo dflags f callConv actuals k off updfr_off extra_stack
return (copyout <*> mkLabel k <*> copyin)
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 72dd664698..fe2a0217e0 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -6,13 +6,6 @@
--
-----------------------------------------------------------------------------
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
module StgCmmPrim (
cgOpApp,
cgPrimOp -- internal(ish), used by cgCase to get code for a
@@ -36,7 +29,7 @@ import BasicTypes
import MkGraph
import StgSyn
import Cmm
-import Type ( Type, tyConAppTyCon )
+import Type ( Type, tyConAppTyCon )
import TyCon
import CLabel
import CmmUtils
@@ -51,62 +44,62 @@ import Control.Monad (liftM)
import Data.Bits
------------------------------------------------------------------------
--- Primitive operations and foreign calls
+-- Primitive operations and foreign calls
------------------------------------------------------------------------
{- Note [Foreign call results]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
A foreign call always returns an unboxed tuple of results, one
of which is the state token. This seems to happen even for pure
-calls.
+calls.
Even if we returned a single result for pure calls, it'd still be
right to wrap it in a singleton unboxed tuple, because the result
might be a Haskell closure pointer, we don't want to evaluate it. -}
----------------------------------
-cgOpApp :: StgOp -- The op
- -> [StgArg] -- Arguments
- -> Type -- Result type (always an unboxed tuple)
+cgOpApp :: StgOp -- The op
+ -> [StgArg] -- Arguments
+ -> Type -- Result type (always an unboxed tuple)
-> FCode ReturnKind
--- Foreign calls
-cgOpApp (StgFCallOp fcall _) stg_args res_ty
+-- Foreign calls
+cgOpApp (StgFCallOp fcall _) stg_args res_ty
= cgForeignCall fcall stg_args res_ty
-- Note [Foreign call results]
--- tagToEnum# is special: we need to pull the constructor
+-- tagToEnum# is special: we need to pull the constructor
-- out of the table, and perform an appropriate return.
-cgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty
+cgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty
= ASSERT(isEnumerationTyCon tycon)
- do { dflags <- getDynFlags
+ do { dflags <- getDynFlags
; args' <- getNonVoidArgAmodes [arg]
; let amode = case args' of [amode] -> amode
_ -> panic "TagToEnumOp had void arg"
- ; emitReturn [tagToClosure dflags tycon amode] }
+ ; emitReturn [tagToClosure dflags tycon amode] }
where
- -- If you're reading this code in the attempt to figure
- -- out why the compiler panic'ed here, it is probably because
- -- you used tagToEnum# in a non-monomorphic setting, e.g.,
- -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
- -- That won't work.
- tycon = tyConAppTyCon res_ty
+ -- If you're reading this code in the attempt to figure
+ -- out why the compiler panic'ed here, it is probably because
+ -- you used tagToEnum# in a non-monomorphic setting, e.g.,
+ -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
+ -- That won't work.
+ tycon = tyConAppTyCon res_ty
cgOpApp (StgPrimOp primop) args res_ty
| primOpOutOfLine primop
- = do { cmm_args <- getNonVoidArgAmodes args
+ = do { cmm_args <- getNonVoidArgAmodes args
; let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop))
; emitCall (NativeNodeCall, NativeReturn) fun cmm_args }
| ReturnsPrim VoidRep <- result_info
- = do cgPrimOp [] primop args
+ = do cgPrimOp [] primop args
emitReturn []
| ReturnsPrim rep <- result_info
= do dflags <- getDynFlags
res <- newTemp (primRepCmmType dflags rep)
- cgPrimOp [res] primop args
+ cgPrimOp [res] primop args
emitReturn [CmmReg (CmmLocal res)]
| ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
@@ -116,7 +109,7 @@ cgOpApp (StgPrimOp primop) args res_ty
| ReturnsAlg tycon <- result_info
, isEnumerationTyCon tycon
- -- c.f. cgExpr (...TagToEnumOp...)
+ -- c.f. cgExpr (...TagToEnumOp...)
= do dflags <- getDynFlags
tag_reg <- newTemp (bWord dflags)
cgPrimOp [tag_reg] primop args
@@ -128,15 +121,15 @@ cgOpApp (StgPrimOp primop) args res_ty
result_info = getPrimOpResultInfo primop
cgOpApp (StgPrimCallOp primcall) args _res_ty
- = do { cmm_args <- getNonVoidArgAmodes args
+ = do { cmm_args <- getNonVoidArgAmodes args
; let fun = CmmLit (CmmLabel (mkPrimCallLabel primcall))
; emitCall (NativeNodeCall, NativeReturn) fun cmm_args }
---------------------------------------------------
-cgPrimOp :: [LocalReg] -- where to put the results
- -> PrimOp -- the op
- -> [StgArg] -- arguments
- -> FCode ()
+cgPrimOp :: [LocalReg] -- where to put the results
+ -> PrimOp -- the op
+ -> [StgArg] -- arguments
+ -> FCode ()
cgPrimOp results op args
= do dflags <- getDynFlags
@@ -145,35 +138,35 @@ cgPrimOp results op args
------------------------------------------------------------------------
--- Emitting code for a primop
+-- Emitting code for a primop
------------------------------------------------------------------------
emitPrimOp :: DynFlags
- -> [LocalReg] -- where to put the results
- -> PrimOp -- the op
- -> [CmmExpr] -- arguments
- -> FCode ()
+ -> [LocalReg] -- where to put the results
+ -> PrimOp -- the op
+ -> [CmmExpr] -- arguments
+ -> FCode ()
-- First we handle various awkward cases specially. The remaining
-- easy cases are then handled by translateOp, defined below.
emitPrimOp dflags [res_r,res_c] IntAddCOp [aa,bb]
-{-
+{-
With some bit-twiddling, we can define int{Add,Sub}Czh portably in
C, and without needing any comparisons. This may not be the
fastest way to do it - if you have better code, please send it! --SDM
-
+
Return : r = a + b, c = 0 if no overflow, 1 on overflow.
-
- We currently don't make use of the r value if c is != 0 (i.e.
+
+ We currently don't make use of the r value if c is != 0 (i.e.
overflow), we just convert to big integers and try again. This
could be improved by making r and c the correct values for
- plugging into a new J#.
-
- { r = ((I_)(a)) + ((I_)(b)); \
- c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
- >> (BITS_IN (I_) - 1); \
- }
+ plugging into a new J#.
+
+ { r = ((I_)(a)) + ((I_)(b)); \
+ c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
+ >> (BITS_IN (I_) - 1); \
+ }
Wading through the mass of bracketry, it seems to reduce to:
c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
@@ -181,22 +174,22 @@ emitPrimOp dflags [res_r,res_c] IntAddCOp [aa,bb]
= emit $ catAGraphs [
mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordAdd dflags) [aa,bb]),
mkAssign (CmmLocal res_c) $
- CmmMachOp (mo_wordUShr dflags) [
- CmmMachOp (mo_wordAnd dflags) [
- CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],
- CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
- ],
+ CmmMachOp (mo_wordUShr dflags) [
+ CmmMachOp (mo_wordAnd dflags) [
+ CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],
+ CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
+ ],
mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
- ]
+ ]
]
emitPrimOp dflags [res_r,res_c] IntSubCOp [aa,bb]
{- Similarly:
- #define subIntCzh(r,c,a,b) \
- { r = ((I_)(a)) - ((I_)(b)); \
- c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
- >> (BITS_IN (I_) - 1); \
+ #define subIntCzh(r,c,a,b) \
+ { r = ((I_)(a)) - ((I_)(b)); \
+ c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
+ >> (BITS_IN (I_) - 1); \
}
c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
@@ -204,24 +197,24 @@ emitPrimOp dflags [res_r,res_c] IntSubCOp [aa,bb]
= emit $ catAGraphs [
mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]),
mkAssign (CmmLocal res_c) $
- CmmMachOp (mo_wordUShr dflags) [
- CmmMachOp (mo_wordAnd dflags) [
- CmmMachOp (mo_wordXor dflags) [aa,bb],
- CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
- ],
+ CmmMachOp (mo_wordUShr dflags) [
+ CmmMachOp (mo_wordAnd dflags) [
+ CmmMachOp (mo_wordXor dflags) [aa,bb],
+ CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
+ ],
mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
- ]
+ ]
]
emitPrimOp _ [res] ParOp [arg]
- =
- -- for now, just implement this in a C function
- -- later, we might want to inline it.
+ =
+ -- for now, just implement this in a C function
+ -- later, we might want to inline it.
emitCCall
- [(res,NoHint)]
- (CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))))
- [(CmmReg (CmmGlobal BaseReg), AddrHint), (arg,AddrHint)]
+ [(res,NoHint)]
+ (CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))))
+ [(CmmReg (CmmGlobal BaseReg), AddrHint), (arg,AddrHint)]
emitPrimOp dflags [res] SparkOp [arg]
= do
@@ -251,10 +244,10 @@ emitPrimOp dflags [res] ReadMutVarOp [mutv]
emitPrimOp dflags [] WriteMutVarOp [mutv,var]
= do emitStore (cmmOffsetW dflags mutv (fixedHdrSize dflags)) var
- emitCCall
- [{-no results-}]
- (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
- [(CmmReg (CmmGlobal BaseReg), AddrHint), (mutv,AddrHint)]
+ emitCCall
+ [{-no results-}]
+ (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
+ [(CmmReg (CmmGlobal BaseReg), AddrHint), (mutv,AddrHint)]
-- #define sizzeofByteArrayzh(r,a) \
-- r = ((StgArrWords *)(a))->bytes
@@ -279,7 +272,7 @@ emitPrimOp dflags [res] ByteArrayContents_Char [arg]
emitPrimOp dflags [res] StableNameToIntOp [arg]
= emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSize dflags) (bWord dflags))
--- #define eqStableNamezh(r,sn1,sn2) \
+-- #define eqStableNamezh(r,sn1,sn2) \
-- (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
emitPrimOp dflags [res] EqStableNameOp [arg1,arg2]
= emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [
@@ -303,13 +296,13 @@ emitPrimOp dflags [res] DataToTagOp [arg]
{- Freezing arrays-of-ptrs requires changing an info table, for the
benefit of the generational collector. It needs to scavenge mutable
objects, even if they are in old space. When they become immutable,
- they can be removed from this scavenge list. -}
+ they can be removed from this scavenge list. -}
-- #define unsafeFreezzeArrayzh(r,a)
--- {
+-- {
-- SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
--- r = a;
--- }
+-- r = a;
+-- }
emitPrimOp _ [res] UnsafeFreezeArrayOp [arg]
= emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
@@ -319,7 +312,7 @@ emitPrimOp _ [res] UnsafeFreezeArrayArrayOp [arg]
[ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
mkAssign (CmmLocal res) arg ]
--- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
+-- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
emitPrimOp _ [res] UnsafeFreezeByteArrayOp [arg]
= emitAssign (CmmLocal res) arg
@@ -492,16 +485,11 @@ emitPrimOp _ [] SetByteArrayOp [ba,off,len,c] =
doSetByteArrayOp ba off len c
-- Population count
-emitPrimOp dflags [res] PopCnt8Op [w] =
- emitPopCntCall res (CmmMachOp (mo_WordTo8 dflags) [w]) W8
-emitPrimOp dflags [res] PopCnt16Op [w] =
- emitPopCntCall res (CmmMachOp (mo_WordTo16 dflags) [w]) W16
-emitPrimOp dflags [res] PopCnt32Op [w] =
- emitPopCntCall res (CmmMachOp (mo_WordTo32 dflags) [w]) W32
-emitPrimOp _ [res] PopCnt64Op [w] =
- emitPopCntCall res w W64 -- arg always has type W64, no need to narrow
-emitPrimOp dflags [res] PopCntOp [w] =
- emitPopCntCall res w (wordWidth dflags)
+emitPrimOp _ [res] PopCnt8Op [w] = emitPopCntCall res w W8
+emitPrimOp _ [res] PopCnt16Op [w] = emitPopCntCall res w W16
+emitPrimOp _ [res] PopCnt32Op [w] = emitPopCntCall res w W32
+emitPrimOp _ [res] PopCnt64Op [w] = emitPopCntCall res w W64
+emitPrimOp dflags [res] PopCntOp [w] = emitPopCntCall res w (wordWidth dflags)
-- The rest just translate straightforwardly
emitPrimOp dflags [res] op [arg]
@@ -695,9 +683,9 @@ nopOp Int2WordOp = True
nopOp Word2IntOp = True
nopOp Int2AddrOp = True
nopOp Addr2IntOp = True
-nopOp ChrOp = True -- Int# and Char# are rep'd the same
-nopOp OrdOp = True
-nopOp _ = False
+nopOp ChrOp = True -- Int# and Char# are rep'd the same
+nopOp OrdOp = True
+nopOp _ = False
-- These PrimOps turn into double casts
@@ -708,7 +696,7 @@ narrowOp Narrow32IntOp = Just (MO_SS_Conv, W32)
narrowOp Narrow8WordOp = Just (MO_UU_Conv, W8)
narrowOp Narrow16WordOp = Just (MO_UU_Conv, W16)
narrowOp Narrow32WordOp = Just (MO_UU_Conv, W32)
-narrowOp _ = Nothing
+narrowOp _ = Nothing
-- Native word signless ops
@@ -879,7 +867,7 @@ doIndexByteArrayOp :: Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCod
doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
= do dflags <- getDynFlags
mkBasicIndexedRead (arrWordsHdrSize dflags) maybe_post_read_cast rep res addr idx
-doIndexByteArrayOp _ _ _ _
+doIndexByteArrayOp _ _ _ _
= panic "CgPrimOp: doIndexByteArrayOp"
doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> FCode ()
@@ -898,7 +886,7 @@ doWriteByteArrayOp :: Maybe MachOp -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp maybe_pre_write_cast [] [addr,idx,val]
= do dflags <- getDynFlags
mkBasicIndexedWrite (arrWordsHdrSize dflags) maybe_pre_write_cast addr idx val
-doWriteByteArrayOp _ _ _
+doWriteByteArrayOp _ _ _
= panic "CgPrimOp: doWriteByteArrayOp"
doWritePtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
@@ -915,13 +903,13 @@ doWritePtrArrayOp addr idx val
(CmmMachOp (mo_wordUShr dflags) [idx,
mkIntExpr dflags (mUT_ARR_PTRS_CARD_BITS dflags)])
) (CmmLit (CmmInt 1 W8))
-
+
loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr
loadArrPtrsSize dflags addr = CmmLoad (cmmOffsetB dflags addr off) (bWord dflags)
where off = fixedHdrSize dflags * wORD_SIZE dflags + oFFSET_StgMutArrPtrs_ptrs dflags
mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType
- -> LocalReg -> CmmExpr -> CmmExpr -> FCode ()
+ -> LocalReg -> CmmExpr -> CmmExpr -> FCode ()
mkBasicIndexedRead off Nothing read_rep res base idx
= do dflags <- getDynFlags
emitAssign (CmmLocal res) (cmmLoadIndexOffExpr dflags off read_rep base idx)
@@ -931,7 +919,7 @@ mkBasicIndexedRead off (Just cast) read_rep res base idx
cmmLoadIndexOffExpr dflags off read_rep base idx])
mkBasicIndexedWrite :: ByteOff -> Maybe MachOp
- -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
+ -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
mkBasicIndexedWrite off Nothing base idx val
= do dflags <- getDynFlags
emitStore (cmmIndexOffExpr dflags off (typeWidth (cmmExprType dflags val)) base idx) val
View Lorry Controller Status