This version should compile but is still incomplete as it introduces
potential bugs at the places marked 'TODO FIXME NOW'.
It is being recorded to help keep track of changes.
20 files changed:
GenCmm(..), Cmm,
GenCmmTop(..), CmmTop,
GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts,
GenCmm(..), Cmm,
GenCmmTop(..), CmmTop,
GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts,
- CmmStmt(..), CmmActuals, CmmFormals,
+ CmmStmt(..), CmmActuals, CmmFormal, CmmFormals, CmmHintFormals,
CmmCallTarget(..),
CmmStatic(..), Section(..),
CmmExpr(..), cmmExprRep,
CmmReg(..), cmmRegRep,
CmmLit(..), cmmLitRep,
CmmCallTarget(..),
CmmStatic(..), Section(..),
CmmExpr(..), cmmExprRep,
CmmReg(..), cmmRegRep,
CmmLit(..), cmmLitRep,
- LocalReg(..), localRegRep,
+ LocalReg(..), localRegRep, Kind(..),
BlockId(..), BlockEnv,
GlobalReg(..), globalRegRep,
BlockId(..), BlockEnv,
GlobalReg(..), globalRegRep,
| CmmCall -- A foreign call, with
CmmCallTarget
| CmmCall -- A foreign call, with
CmmCallTarget
- CmmFormals -- zero or more results
+ CmmHintFormals -- zero or more results
CmmActuals -- zero or more arguments
| CmmBranch BlockId -- branch to another BB in this fn
CmmActuals -- zero or more arguments
| CmmBranch BlockId -- branch to another BB in this fn
| CmmReturn -- Return from a function,
CmmActuals -- with these return values.
| CmmReturn -- Return from a function,
CmmActuals -- with these return values.
-type CmmActuals = [(CmmExpr,MachHint)]
-type CmmFormals = [(CmmReg,MachHint)]
+type CmmActual = CmmExpr
+type CmmActuals = [(CmmActual,MachHint)]
+type CmmFormal = LocalReg
+type CmmHintFormals = [(CmmFormal,MachHint)]
+type CmmFormals = [CmmFormal]
cmmRegRep (CmmLocal reg) = localRegRep reg
cmmRegRep (CmmGlobal reg) = globalRegRep reg
cmmRegRep (CmmLocal reg) = localRegRep reg
cmmRegRep (CmmGlobal reg) = globalRegRep reg
+-- | Whether a 'LocalReg' is a GC followable pointer
+data Kind = KindPtr | KindNonPtr deriving (Eq)
+
- = LocalReg !Unique MachRep
+ = LocalReg
+ !Unique -- ^ Identifier
+ MachRep -- ^ Type
+ Kind -- ^ Should the GC follow as a pointer
instance Eq LocalReg where
instance Eq LocalReg where
- (LocalReg u1 _) == (LocalReg u2 _) = u1 == u2
+ (LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2
instance Uniquable LocalReg where
instance Uniquable LocalReg where
- getUnique (LocalReg uniq _) = uniq
+ getUnique (LocalReg uniq _ _) = uniq
localRegRep :: LocalReg -> MachRep
localRegRep :: LocalReg -> MachRep
-localRegRep (LocalReg _ rep) = rep
+localRegRep (LocalReg _ rep _) = rep
+
+localRegGCFollow (LocalReg _ _ p) = p
data CmmLit
= CmmInt Integer MachRep
data CmmLit
= CmmInt Integer MachRep
BlockId -- ^ Target of the 'CmmGoto'
-- (must be a 'ContinuationEntry')
CmmCallTarget -- ^ The function to call
BlockId -- ^ Target of the 'CmmGoto'
-- (must be a 'ContinuationEntry')
CmmCallTarget -- ^ The function to call
- CmmFormals -- ^ Results from call
+ CmmHintFormals -- ^ Results from call
-- (redundant with ContinuationEntry)
CmmActuals -- ^ Arguments to call
-- (redundant with ContinuationEntry)
CmmActuals -- ^ Arguments to call
block = do_call current_id entry accum_stmts exits next_id
target results arguments
rest = breakBlock' (tail uniques) next_id
block = do_call current_id entry accum_stmts exits next_id
target results arguments
rest = breakBlock' (tail uniques) next_id
- (ContinuationEntry results) [] [] stmts
+ (ContinuationEntry (map fst results)) [] [] stmts
(s:stmts) ->
breakBlock' uniques current_id entry
(cond_branch_target s++exits)
(s:stmts) ->
breakBlock' uniques current_id entry
(cond_branch_target s++exits)
= StackFormat {
stack_label :: Maybe CLabel, -- The label occupying the top slot
stack_frame_size :: WordOff, -- Total frame size in words (not including arguments)
= StackFormat {
stack_label :: Maybe CLabel, -- The label occupying the top slot
stack_frame_size :: WordOff, -- Total frame size in words (not including arguments)
- stack_live :: [(CmmReg, WordOff)] -- local reg offsets from stack top
+ stack_live :: [(LocalReg, WordOff)] -- local reg offsets from stack top
-- TODO: see if the above can be LocalReg
}
-- TODO: see if the above can be LocalReg
}
live_to_format label formals live =
foldl extend_format
(StackFormat (Just label) retAddrSizeW [])
live_to_format label formals live =
foldl extend_format
(StackFormat (Just label) retAddrSizeW [])
- (uniqSetToList (live `minusUniqSet` mkUniqSet (cmmFormalsToLiveLocals formals)))
+ (uniqSetToList (live `minusUniqSet` mkUniqSet formals))
extend_format :: StackFormat -> LocalReg -> StackFormat
extend_format (StackFormat label size offsets) reg =
extend_format :: StackFormat -> LocalReg -> StackFormat
extend_format (StackFormat label size offsets) reg =
- StackFormat label (slot_size reg + size) ((CmmLocal reg, size) : offsets)
+ StackFormat label (slot_size reg + size) ((reg, size) : offsets)
slot_size :: LocalReg -> Int
slot_size reg = ((machRepByteWidth (localRegRep reg) - 1) `div` wORD_SIZE) + 1
slot_size :: LocalReg -> Int
slot_size reg = ((machRepByteWidth (localRegRep reg) - 1) `div` wORD_SIZE) + 1
= store_live_values ++ set_stack_header where
-- TODO: only save variables when actually needed (may be handled by latter pass)
store_live_values =
= store_live_values ++ set_stack_header where
-- TODO: only save variables when actually needed (may be handled by latter pass)
store_live_values =
- [stack_put spRel (CmmReg reg) offset
+ [stack_put spRel (CmmReg (CmmLocal reg)) offset
| (reg, offset) <- cont_offsets]
set_stack_header =
if not needs_header
| (reg, offset) <- cont_offsets]
set_stack_header =
if not needs_header
| (reg, offset) <- curr_offsets]
load_args =
[stack_get 0 reg offset
| (reg, offset) <- curr_offsets]
load_args =
[stack_get 0 reg offset
- | ((reg, _), StackParam offset) <- argument_formats] ++
+ | (reg, StackParam offset) <- argument_formats] ++
- | ((reg, _), RegisterParam global) <- argument_formats]
+ | (reg, RegisterParam global) <- argument_formats]
- argument_formats = assignArguments (cmmRegRep . fst) formals
+ argument_formats = assignArguments (localRegRep) formals
-----------------------------------------------------------------------------
-- Section: Stack and argument register puts and gets
-----------------------------------------------------------------------------
-- Section: Stack and argument register puts and gets
--------------------------------
-- |Construct a
stack_get :: WordOff
--------------------------------
-- |Construct a
stack_get :: WordOff
-> WordOff
-> CmmStmt
stack_get spRel reg offset =
-> WordOff
-> CmmStmt
stack_get spRel reg offset =
- CmmAssign reg (CmmLoad (CmmRegOff spReg (wORD_SIZE*(spRel + offset))) (cmmRegRep reg))
+ CmmAssign (CmmLocal reg) (CmmLoad (CmmRegOff spReg (wORD_SIZE*(spRel + offset))) (localRegRep reg))
global_put :: CmmExpr -> GlobalReg -> CmmStmt
global_put expr global = CmmAssign (CmmGlobal global) expr
global_put :: CmmExpr -> GlobalReg -> CmmStmt
global_put expr global = CmmAssign (CmmGlobal global) expr
-global_get :: CmmReg -> GlobalReg -> CmmStmt
-global_get reg global = CmmAssign reg (CmmReg (CmmGlobal global))
+global_get :: LocalReg -> GlobalReg -> CmmStmt
+global_get reg global = CmmAssign (CmmLocal reg) (CmmReg (CmmGlobal global))
CmmLive,
BlockEntryLiveness,
cmmLiveness,
CmmLive,
BlockEntryLiveness,
cmmLiveness,
- cmmFormalsToLiveLocals,
+ cmmHintFormalsToLiveLocals,
) where
#include "HsVersions.h"
) where
#include "HsVersions.h"
--------------------------------
-- Liveness of a CmmStmt
--------------------------------
--------------------------------
-- Liveness of a CmmStmt
--------------------------------
-cmmFormalsToLiveLocals :: CmmFormals -> [LocalReg]
-cmmFormalsToLiveLocals [] = []
-cmmFormalsToLiveLocals ((CmmGlobal _,_):args) = cmmFormalsToLiveLocals args
-cmmFormalsToLiveLocals ((CmmLocal r,_):args) = r:cmmFormalsToLiveLocals args
+cmmHintFormalsToLiveLocals :: CmmHintFormals -> [LocalReg]
+cmmHintFormalsToLiveLocals formals = map fst formals
cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
cmmStmtLive _ (CmmNop) = id
cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
cmmStmtLive _ (CmmNop) = id
cmmStmtLive _ (CmmCall target results arguments) =
target_liveness .
foldr ((.) . cmmExprLive) id (map fst arguments) .
cmmStmtLive _ (CmmCall target results arguments) =
target_liveness .
foldr ((.) . cmmExprLive) id (map fst arguments) .
- addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
+ addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals results) where
target_liveness =
case target of
(CmmForeignCall target _) -> cmmExprLive target
target_liveness =
case target of
(CmmForeignCall target _) -> cmmExprLive target
cmmMiniInlineStmts :: UniqFM Int -> [CmmStmt] -> [CmmStmt]
cmmMiniInlineStmts uses [] = []
cmmMiniInlineStmts :: UniqFM Int -> [CmmStmt] -> [CmmStmt]
cmmMiniInlineStmts uses [] = []
-cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts)
+cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _ _)) expr) : stmts)
| Just 1 <- lookupUFM uses u,
Just stmts' <- lookForInline u expr stmts
=
| Just 1 <- lookupUFM uses u,
Just stmts' <- lookForInline u expr stmts
=
-- Try to inline a temporary assignment. We can skip over assignments to
-- other tempoararies, because we know that expressions aren't side-effecting
-- and temporaries are single-assignment.
-- Try to inline a temporary assignment. We can skip over assignments to
-- other tempoararies, because we know that expressions aren't side-effecting
-- and temporaries are single-assignment.
-lookForInline u expr (stmt@(CmmAssign (CmmLocal (LocalReg u' _)) rhs) : rest)
+lookForInline u expr (stmt@(CmmAssign (CmmLocal (LocalReg u' _ _)) rhs) : rest)
| u /= u'
= case lookupUFM (getExprUses rhs) u of
Just 1 -> Just (inlineStmt u expr stmt : rest)
| u /= u'
= case lookupUFM (getExprUses rhs) u of
Just 1 -> Just (inlineStmt u expr stmt : rest)
getStmtUses _ = emptyUFM
getExprUses :: CmmExpr -> UniqFM Int
getStmtUses _ = emptyUFM
getExprUses :: CmmExpr -> UniqFM Int
-getExprUses (CmmReg (CmmLocal (LocalReg u _))) = unitUFM u 1
-getExprUses (CmmRegOff (CmmLocal (LocalReg u _)) _) = unitUFM u 1
+getExprUses (CmmReg (CmmLocal (LocalReg u _ _))) = unitUFM u 1
+getExprUses (CmmRegOff (CmmLocal (LocalReg u _ _)) _) = unitUFM u 1
getExprUses (CmmLoad e _) = getExprUses e
getExprUses (CmmMachOp _ es) = getExprsUses es
getExprUses _other = emptyUFM
getExprUses (CmmLoad e _) = getExprUses e
getExprUses (CmmMachOp _ es) = getExprsUses es
getExprUses _other = emptyUFM
inlineStmt u a other_stmt = other_stmt
inlineExpr :: Unique -> CmmExpr -> CmmExpr -> CmmExpr
inlineStmt u a other_stmt = other_stmt
inlineExpr :: Unique -> CmmExpr -> CmmExpr -> CmmExpr
-inlineExpr u a e@(CmmReg (CmmLocal (LocalReg u' _)))
+inlineExpr u a e@(CmmReg (CmmLocal (LocalReg u' _ _)))
| u == u' = a
| otherwise = e
| u == u' = a
| otherwise = e
-inlineExpr u a e@(CmmRegOff (CmmLocal (LocalReg u' rep)) off)
+inlineExpr u a e@(CmmRegOff (CmmLocal (LocalReg u' rep _)) off)
| u == u' = CmmMachOp (MO_Add rep) [a, CmmLit (CmmInt (fromIntegral off) rep)]
| otherwise = e
inlineExpr u a (CmmLoad e rep) = CmmLoad (inlineExpr u a e) rep
| u == u' = CmmMachOp (MO_Add rep) [a, CmmLit (CmmInt (fromIntegral off) rep)]
| otherwise = e
inlineExpr u a (CmmLoad e rep) = CmmLoad (inlineExpr u a e) rep
| stmt body { do $1; $2 }
decl :: { ExtCode }
| stmt body { do $1; $2 }
decl :: { ExtCode }
- : type names ';' { mapM_ (newLocal $1) $2 }
+ : type names ';' { mapM_ (newLocal defaultKind $1) $2 }
+ | STRING type names ';' {% do k <- parseKind $1;
+ return $ mapM_ (newLocal k $2) $3 }
+
| 'import' names ';' { return () } -- ignore imports
| 'export' names ';' { return () } -- ignore exports
| 'import' names ';' { return () } -- ignore imports
| 'export' names ';' { return () } -- ignore exports
: NAME { lookupName $1 }
| GLOBALREG { return (CmmReg (CmmGlobal $1)) }
: NAME { lookupName $1 }
| GLOBALREG { return (CmmReg (CmmGlobal $1)) }
-maybe_results :: { [ExtFCode (CmmReg, MachHint)] }
+maybe_results :: { [ExtFCode (CmmFormal, MachHint)] }
: {- empty -} { [] }
| hint_lregs '=' { $1 }
: {- empty -} { [] }
| hint_lregs '=' { $1 }
-hint_lregs :: { [ExtFCode (CmmReg, MachHint)] }
+hint_lregs0 :: { [ExtFCode (CmmFormal, MachHint)] }
+ : {- empty -} { [] }
+ | hint_lregs { $1 }
+
+hint_lregs :: { [ExtFCode (CmmFormal, MachHint)] }
: hint_lreg ',' { [$1] }
| hint_lreg { [$1] }
| hint_lreg ',' hint_lregs { $1 : $3 }
: hint_lreg ',' { [$1] }
| hint_lreg { [$1] }
| hint_lreg ',' hint_lregs { $1 : $3 }
-hint_lreg :: { ExtFCode (CmmReg, MachHint) }
- : lreg { do e <- $1; return (e, inferHint (CmmReg e)) }
- | STRING lreg {% do h <- parseHint $1;
+hint_lreg :: { ExtFCode (CmmFormal, MachHint) }
+ : local_lreg { do e <- $1; return (e, inferHint (CmmReg (CmmLocal e))) }
+ | STRING local_lreg {% do h <- parseHint $1;
return $ do
e <- $2; return (e,h) }
return $ do
e <- $2; return (e,h) }
+local_lreg :: { ExtFCode LocalReg }
+ : NAME { do e <- lookupName $1;
+ return $
+ case e of
+ CmmReg (CmmLocal r) -> r
+ other -> pprPanic "CmmParse:" (ftext $1 <> text " not a local register") }
+
lreg :: { ExtFCode CmmReg }
: NAME { do e <- lookupName $1;
return $
lreg :: { ExtFCode CmmReg }
: NAME { do e <- lookupName $1;
return $
parseHint "float" = return FloatHint
parseHint str = fail ("unrecognised hint: " ++ str)
parseHint "float" = return FloatHint
parseHint str = fail ("unrecognised hint: " ++ str)
+parseKind :: String -> P Kind
+parseKind "ptr" = return KindPtr
+parseKind str = fail ("unrecognized kin: " ++ str)
+
+defaultKind :: Kind
+defaultKind = KindNonPtr
+
-- labels are always pointers, so we might as well infer the hint
inferHint :: CmmExpr -> MachHint
inferHint (CmmLit (CmmLabel _)) = PtrHint
-- labels are always pointers, so we might as well infer the hint
inferHint :: CmmExpr -> MachHint
inferHint (CmmLit (CmmLabel _)) = PtrHint
addLabel :: FastString -> BlockId -> ExtCode
addLabel name block_id = EC $ \e s -> return ((name, Label block_id):s, ())
addLabel :: FastString -> BlockId -> ExtCode
addLabel name block_id = EC $ \e s -> return ((name, Label block_id):s, ())
-newLocal :: MachRep -> FastString -> ExtCode
-newLocal ty name = do
+newLocal :: Kind -> MachRep -> FastString -> ExtFCode LocalReg
+newLocal kind ty name = do
- addVarDecl name (CmmReg (CmmLocal (LocalReg u ty)))
+ let reg = LocalReg u ty kind
+ addVarDecl name (CmmReg (CmmLocal reg))
+ return reg
newLabel :: FastString -> ExtFCode BlockId
newLabel name = do
newLabel :: FastString -> ExtFCode BlockId
newLabel name = do
- -> [ExtFCode (CmmReg,MachHint)]
+ -> [ExtFCode (CmmFormal,MachHint)]
-> ExtFCode CmmExpr
-> [ExtFCode (CmmExpr,MachHint)]
-> Maybe [GlobalReg] -> P ExtCode
-> ExtFCode CmmExpr
-> [ExtFCode (CmmExpr,MachHint)]
-> Maybe [GlobalReg] -> P ExtCode
(CmmForeignCall expr convention) args vols) where
primCall
(CmmForeignCall expr convention) args vols) where
primCall
- :: [ExtFCode (CmmReg,MachHint)]
+ :: [ExtFCode (CmmFormal,MachHint)]
-> FastString
-> [ExtFCode (CmmExpr,MachHint)]
-> Maybe [GlobalReg] -> P ExtCode
-> FastString
-> [ExtFCode (CmmExpr,MachHint)]
-> Maybe [GlobalReg] -> P ExtCode
where
ppr_fn = case fn of
CmmLit (CmmLabel lbl) -> pprCLabel lbl
where
ppr_fn = case fn of
CmmLit (CmmLabel lbl) -> pprCLabel lbl
- _other -> parens (cCast (pprCFunType cconv results args) fn)
+ _ -> parens (cCast (pprCFunType cconv results args) fn)
-- for a dynamic call, cast the expression to
-- a function of the right type (we hope).
-- for a dynamic call, cast the expression to
-- a function of the right type (we hope).
CmmJump lbl _params -> mkJMP_(pprExpr lbl) <> semi
CmmSwitch arg ids -> pprSwitch arg ids
CmmJump lbl _params -> mkJMP_(pprExpr lbl) <> semi
CmmSwitch arg ids -> pprSwitch arg ids
-pprCFunType :: CCallConv -> [(CmmReg,MachHint)] -> [(CmmExpr,MachHint)] -> SDoc
+pprCFunType :: CCallConv -> CmmHintFormals -> CmmActuals -> SDoc
pprCFunType cconv ress args
= hcat [
res_type ress,
pprCFunType cconv ress args
= hcat [
res_type ress,
]
where
res_type [] = ptext SLIT("void")
]
where
res_type [] = ptext SLIT("void")
- res_type [(one,hint)] = machRepHintCType (cmmRegRep one) hint
+ res_type [(one,hint)] = machRepHintCType (localRegRep one) hint
arg_type (expr,hint) = machRepHintCType (cmmExprRep expr) hint
arg_type (expr,hint) = machRepHintCType (cmmExprRep expr) hint
GCFun -> ptext SLIT("stg_gc_fun")
pprLocalReg :: LocalReg -> SDoc
GCFun -> ptext SLIT("stg_gc_fun")
pprLocalReg :: LocalReg -> SDoc
-pprLocalReg (LocalReg uniq _rep) = char '_' <> ppr uniq
+pprLocalReg (LocalReg uniq _ _) = char '_' <> ppr uniq
-- -----------------------------------------------------------------------------
-- Foreign Calls
-- -----------------------------------------------------------------------------
-- Foreign Calls
-pprCall :: SDoc -> CCallConv -> [(CmmReg,MachHint)] -> [(CmmExpr,MachHint)]
+pprCall :: SDoc -> CCallConv -> CmmHintFormals -> CmmActuals
-> SDoc
pprCall ppr_fn cconv results args
-> SDoc
pprCall ppr_fn cconv results args
ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi
where
ppr_assign [] rhs = rhs
ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi
where
ppr_assign [] rhs = rhs
- ppr_assign [(reg@(CmmGlobal BaseReg), hint)] rhs
- | Just ty <- strangeRegType reg
- = ptext SLIT("ASSIGN_BaseReg") <> parens (parens ty <> rhs)
- -- BaseReg is special, sometimes it isn't an lvalue and we
- -- can't assign to it.
ppr_assign [(one,hint)] rhs
ppr_assign [(one,hint)] rhs
- | Just ty <- strangeRegType one
- = pprReg one <> ptext SLIT(" = ") <> parens ty <> rhs
- | otherwise
- = pprReg one <> ptext SLIT(" = ")
- <> pprUnHint hint (cmmRegRep one) <> rhs
+ = pprLocalReg one <> ptext SLIT(" = ")
+ <> pprUnHint hint (localRegRep one) <> rhs
ppr_assign _other _rhs = panic "pprCall: multiple results"
pprArg (expr, PtrHint)
ppr_assign _other _rhs = panic "pprCall: multiple results"
pprArg (expr, PtrHint)
where (_, lbls) = runTE (mapM_ te_Static statics)
pprTempDecl :: LocalReg -> SDoc
where (_, lbls) = runTE (mapM_ te_Static statics)
pprTempDecl :: LocalReg -> SDoc
-pprTempDecl l@(LocalReg _uniq rep)
+pprTempDecl l@(LocalReg _ rep _)
= hcat [ machRepCType rep, space, pprLocalReg l, semi ]
pprExternDecl :: Bool -> CLabel -> SDoc
= hcat [ machRepCType rep, space, pprLocalReg l, semi ]
pprExternDecl :: Bool -> CLabel -> SDoc
te_Stmt :: CmmStmt -> TE ()
te_Stmt (CmmAssign r e) = te_Reg r >> te_Expr e
te_Stmt (CmmStore l r) = te_Expr l >> te_Expr r
te_Stmt :: CmmStmt -> TE ()
te_Stmt (CmmAssign r e) = te_Reg r >> te_Expr e
te_Stmt (CmmStore l r) = te_Expr l >> te_Expr r
-te_Stmt (CmmCall _ rs es) = mapM_ (te_Reg.fst) rs >>
+te_Stmt (CmmCall _ rs es) = mapM_ (te_temp.fst) rs >>
mapM_ (te_Expr.fst) es
te_Stmt (CmmCondBranch e _) = te_Expr e
te_Stmt (CmmSwitch e _) = te_Expr e
mapM_ (te_Expr.fst) es
te_Stmt (CmmCondBranch e _) = te_Expr e
te_Stmt (CmmSwitch e _) = te_Expr e
-- We only print the type of the local reg if it isn't wordRep
--
pprLocalReg :: LocalReg -> SDoc
-- We only print the type of the local reg if it isn't wordRep
--
pprLocalReg :: LocalReg -> SDoc
-pprLocalReg (LocalReg uniq rep)
- = hcat [ char '_', ppr uniq,
- (if rep == wordRep
- then empty else dcolon <> ppr rep) ]
+pprLocalReg (LocalReg uniq rep follow)
+ = hcat [ char '_', ppr uniq, ty ] where
+ ty = if rep == wordRep && follow == KindNonPtr
+ then empty
+ else dcolon <> ptr <> ppr rep
+ ptr = if follow == KindNonPtr
+ then empty
+ else doubleQuotes (text "ptr")
-- needs to be kept in syn with Cmm.hs.GlobalReg
--
-- needs to be kept in syn with Cmm.hs.GlobalReg
--
bindArgsToStack, rebindToStack,
bindNewToNode, bindNewToReg, bindArgsToRegs,
bindArgsToStack, rebindToStack,
bindNewToNode, bindNewToReg, bindArgsToRegs,
getArgAmode, getArgAmodes,
getCgIdInfo,
getCAddrModeIfVolatile, getVolatileRegs,
getArgAmode, getArgAmodes,
getCgIdInfo,
getCAddrModeIfVolatile, getVolatileRegs,
-- Create a new temporary whose unique is that in the id,
-- bind the id to it, and return the addressing mode for the
-- temporary.
-- Create a new temporary whose unique is that in the id,
-- bind the id to it, and return the addressing mode for the
-- temporary.
-bindNewToTemp :: Id -> FCode CmmReg
+bindNewToTemp :: Id -> FCode LocalReg
- = do addBindC id (regIdInfo id temp_reg lf_info)
+ = do addBindC id (regIdInfo id (CmmLocal temp_reg) lf_info)
return temp_reg
where
uniq = getUnique id
return temp_reg
where
uniq = getUnique id
- temp_reg = CmmLocal (LocalReg uniq (argMachRep (idCgRep id)))
+ temp_reg = LocalReg uniq (argMachRep (idCgRep id)) kind
+ kind = if isFollowableArg (idCgRep id)
+ then KindPtr
+ else KindNonPtr
lf_info = mkLFArgument id -- Always used of things we
-- know nothing about
lf_info = mkLFArgument id -- Always used of things we
-- know nothing about
alt_type@(PrimAlt tycon) alts
= do { tmp_reg <- bindNewToTemp bndr
; cm_lit <- cgLit lit
alt_type@(PrimAlt tycon) alts
= do { tmp_reg <- bindNewToTemp bndr
; cm_lit <- cgLit lit
- ; stmtC (CmmAssign tmp_reg (CmmLit cm_lit))
- ; cgPrimAlts NoGC alt_type tmp_reg alts }
+ ; stmtC (CmmAssign (CmmLocal tmp_reg) (CmmLit cm_lit))
+ ; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
\end{code}
Special case #2: scrutinising a primitive-typed variable. No
\end{code}
Special case #2: scrutinising a primitive-typed variable. No
v_info <- getCgIdInfo v
; amode <- idInfoToAmode v_info
; tmp_reg <- bindNewToTemp bndr
v_info <- getCgIdInfo v
; amode <- idInfoToAmode v_info
; tmp_reg <- bindNewToTemp bndr
- ; stmtC (CmmAssign tmp_reg amode)
- ; cgPrimAlts NoGC alt_type tmp_reg alts }
+ ; stmtC (CmmAssign (CmmLocal tmp_reg) amode)
+ ; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
\end{code}
Special case #3: inline PrimOps and foreign calls.
\end{code}
Special case #3: inline PrimOps and foreign calls.
= do { -- PRIMITIVE ALTS, with non-void result
tmp_reg <- bindNewToTemp bndr
; cgPrimOp [tmp_reg] primop args live_in_alts
= do { -- PRIMITIVE ALTS, with non-void result
tmp_reg <- bindNewToTemp bndr
; cgPrimOp [tmp_reg] primop args live_in_alts
- ; cgPrimAlts NoGC (PrimAlt tycon) tmp_reg alts }
+ ; cgPrimAlts NoGC (PrimAlt tycon) (CmmLocal tmp_reg) alts }
cgInlinePrimOp primop args bndr (UbxTupAlt tycon) live_in_alts alts
= ASSERT( isSingleton alts )
cgInlinePrimOp primop args bndr (UbxTupAlt tycon) live_in_alts alts
= ASSERT( isSingleton alts )
; this_pkg <- getThisPackage
; whenC (not (isDeadBinder bndr))
(do { tmp_reg <- bindNewToTemp bndr
; this_pkg <- getThisPackage
; whenC (not (isDeadBinder bndr))
(do { tmp_reg <- bindNewToTemp bndr
- ; stmtC (CmmAssign tmp_reg (tagToClosure this_pkg tycon tag_amode)) })
+ ; stmtC (CmmAssign
+ (CmmLocal tmp_reg)
+ (tagToClosure this_pkg tycon tag_amode)) })
-- Compile the alts
; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
-- Compile the alts
; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
(_,e) <- getArgAmode arg
return e
do_enum_primop primop
(_,e) <- getArgAmode arg
return e
do_enum_primop primop
- = do tmp <- newTemp wordRep
+ = do tmp <- newNonPtrTemp wordRep
cgPrimOp [tmp] primop args live_in_alts
cgPrimOp [tmp] primop args live_in_alts
+ returnFC (CmmReg (CmmLocal tmp))
cgInlinePrimOp primop arg_amodes bndr PolyAlt live_in_alts alts
= pprPanic "cgCase: case of primop has polymorphic type" (ppr bndr)
cgInlinePrimOp primop arg_amodes bndr PolyAlt live_in_alts alts
= pprPanic "cgCase: case of primop has polymorphic type" (ppr bndr)
reps_n_amodes <- getArgAmodes stg_args
let
-- Get the *non-void* args, and jiggle them with shimForeignCall
reps_n_amodes <- getArgAmodes stg_args
let
-- Get the *non-void* args, and jiggle them with shimForeignCall
- arg_exprs = [ shimForeignCallArg stg_arg expr
+ arg_exprs = [ (shimForeignCallArg stg_arg expr, stg_arg)
| (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
nonVoidArg rep]
| (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
nonVoidArg rep]
- arg_tmps <- mapM assignTemp arg_exprs
+ arg_tmps <- sequence [
+ if isFollowableArg (typeCgRep (stgArgType stg_arg))
+ then assignPtrTemp arg
+ else assignNonPtrTemp arg
+ | (arg, stg_arg) <- arg_exprs]
let arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
{-
Now, allocate some result regs.
-}
(res_reps,res_regs,res_hints) <- newUnboxedTupleRegs res_ty
let arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
{-
Now, allocate some result regs.
-}
(res_reps,res_regs,res_hints) <- newUnboxedTupleRegs res_ty
- ccallReturnUnboxedTuple (zip res_reps (map CmmReg res_regs)) $
+ ccallReturnUnboxedTuple (zip res_reps (map (CmmReg . CmmLocal) res_regs)) $
emitForeignCall (zip res_regs res_hints) fcall
arg_hints emptyVarSet{-no live vars-}
emitForeignCall (zip res_regs res_hints) fcall
arg_hints emptyVarSet{-no live vars-}
cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
= ASSERT(isEnumerationTyCon tycon)
cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
= ASSERT(isEnumerationTyCon tycon)
- do { (_,amode) <- getArgAmode arg
- ; amode' <- assignTemp amode -- We're going to use it twice,
+ do { (rep,amode) <- getArgAmode arg
+ ; amode' <- if isFollowableArg rep
+ then assignPtrTemp amode
+ else assignNonPtrTemp amode
+ -- We're going to use it twice,
-- so save in a temp if non-trivial
; this_pkg <- getThisPackage
; stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon amode'))
-- so save in a temp if non-trivial
; this_pkg <- getThisPackage
; stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon amode'))
performReturn emitReturnInstr
| ReturnsPrim rep <- result_info
performReturn emitReturnInstr
| ReturnsPrim rep <- result_info
- = do cgPrimOp [dataReturnConvPrim (primRepToCgRep rep)]
- primop args emptyVarSet
+ = do res <- if isFollowableArg (typeCgRep res_ty)
+ then newPtrTemp (argMachRep (typeCgRep res_ty))
+ else newNonPtrTemp (argMachRep (typeCgRep res_ty))
+ cgPrimOp [res] primop args emptyVarSet
performPrimReturn (primRepToCgRep rep) (CmmReg (CmmLocal res))
| ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
= do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
cgPrimOp regs primop args emptyVarSet{-no live vars-}
performPrimReturn (primRepToCgRep rep) (CmmReg (CmmLocal res))
| ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
= do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
cgPrimOp regs primop args emptyVarSet{-no live vars-}
- returnUnboxedTuple (zip reps (map CmmReg regs))
+ returnUnboxedTuple (zip reps (map (CmmReg . CmmLocal) regs))
| ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
-- c.f. cgExpr (...TagToEnumOp...)
| ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
-- c.f. cgExpr (...TagToEnumOp...)
- = do tag_reg <- newTemp wordRep
+ = do tag_reg <- if isFollowableArg (typeCgRep res_ty)
+ then newPtrTemp wordRep
+ else newNonPtrTemp wordRep
this_pkg <- getThisPackage
cgPrimOp [tag_reg] primop args emptyVarSet
this_pkg <- getThisPackage
cgPrimOp [tag_reg] primop args emptyVarSet
- stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon (CmmReg tag_reg)))
+ stmtC (CmmAssign nodeReg
+ (tagToClosure this_pkg tycon
+ (CmmReg (CmmLocal tag_reg))))
performReturn emitReturnInstr
where
result_info = getPrimOpResultInfo primop
performReturn emitReturnInstr
where
result_info = getPrimOpResultInfo primop
Little helper for primitives that return unboxed tuples.
\begin{code}
Little helper for primitives that return unboxed tuples.
\begin{code}
-newUnboxedTupleRegs :: Type -> FCode ([CgRep], [CmmReg], [MachHint])
+newUnboxedTupleRegs :: Type -> FCode ([CgRep], [LocalReg], [MachHint])
newUnboxedTupleRegs res_ty =
let
ty_args = tyConAppArgs (repType res_ty)
newUnboxedTupleRegs res_ty =
let
ty_args = tyConAppArgs (repType res_ty)
- (reps,hints) = unzip [ (rep, typeHint ty) | ty <- ty_args,
+ (reps,hints) = unzip [ (rep, typeHint ty) | ty <- ty_args,
let rep = typeCgRep ty,
nonVoidArg rep ]
let rep = typeCgRep ty,
nonVoidArg rep ]
+ make_new_temp rep = if isFollowableArg rep
+ then newPtrTemp (argMachRep rep)
+ else newNonPtrTemp (argMachRep rep)
- regs <- mapM (newTemp . argMachRep) reps
+ regs <- mapM make_new_temp reps
return (reps,regs,hints)
\end{code}
return (reps,regs,hints)
\end{code}
-- Code generation for Foreign Calls
cgForeignCall
-- Code generation for Foreign Calls
cgForeignCall
- :: [(CmmReg,MachHint)] -- where to put the results
+ :: CmmHintFormals -- where to put the results
-> ForeignCall -- the op
-> [StgArg] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
-> ForeignCall -- the op
-> [StgArg] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
- :: [(CmmReg,MachHint)] -- where to put the results
+ :: CmmHintFormals -- where to put the results
-> ForeignCall -- the op
-> [(CmmExpr,MachHint)] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
-> ForeignCall -- the op
-> [(CmmExpr,MachHint)] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
-- alternative entry point, used by CmmParse
emitForeignCall'
:: Safety
-- alternative entry point, used by CmmParse
emitForeignCall'
:: Safety
- -> [(CmmReg,MachHint)] -- where to put the results
+ -> CmmHintFormals -- where to put the results
-> CmmCallTarget -- the op
-> [(CmmExpr,MachHint)] -- arguments
-> Maybe [GlobalReg] -- live vars, in case we need to save them
-> CmmCallTarget -- the op
-> [(CmmExpr,MachHint)] -- arguments
-> Maybe [GlobalReg] -- live vars, in case we need to save them
stmtsC caller_load
| otherwise = do
stmtsC caller_load
| otherwise = do
+ -- Both 'id' and 'new_base' are KindNonPtr because they're
+ -- RTS only objects and are not subject to garbage collection
+ id <- newNonPtrTemp wordRep
+ new_base <- newNonPtrTemp (cmmRegRep (CmmGlobal BaseReg))
temp_args <- load_args_into_temps args
temp_target <- load_target_into_temp target
let (caller_save, caller_load) = callerSaveVolatileRegs vols
emitSaveThreadState
stmtsC caller_save
stmtC (CmmCall (CmmForeignCall suspendThread CCallConv)
temp_args <- load_args_into_temps args
temp_target <- load_target_into_temp target
let (caller_save, caller_load) = callerSaveVolatileRegs vols
emitSaveThreadState
stmtsC caller_save
stmtC (CmmCall (CmmForeignCall suspendThread CCallConv)
[ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
)
stmtC (CmmCall temp_target results temp_args)
stmtC (CmmCall (CmmForeignCall resumeThread CCallConv)
[ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
)
stmtC (CmmCall temp_target results temp_args)
stmtC (CmmCall (CmmForeignCall resumeThread CCallConv)
- [ (CmmGlobal BaseReg, PtrHint) ]
- -- Assign the result to BaseReg: we
- -- might now have a different
- -- Capability!
- [ (CmmReg id, PtrHint) ]
+ [ (new_base, PtrHint) ]
+ [ (CmmReg (CmmLocal id), PtrHint) ]
+ -- Assign the result to BaseReg: we
+ -- might now have a different Capability!
+ stmtC (CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)))
stmtsC caller_load
emitLoadThreadState
stmtsC caller_load
emitLoadThreadState
load_target_into_temp (CmmForeignCall expr conv) = do
tmp <- maybe_assign_temp expr
return (CmmForeignCall tmp conv)
load_target_into_temp (CmmForeignCall expr conv) = do
tmp <- maybe_assign_temp expr
return (CmmForeignCall tmp conv)
-load_target_info_temp other_target =
+load_target_into_temp other_target =
return other_target
maybe_assign_temp e
| hasNoGlobalRegs e = return e
| otherwise = do
-- don't use assignTemp, it uses its own notion of "trivial"
return other_target
maybe_assign_temp e
| hasNoGlobalRegs e = return e
| otherwise = do
-- don't use assignTemp, it uses its own notion of "trivial"
- -- expressions, which are wrong here
- reg <- newTemp (cmmExprRep e)
- stmtC (CmmAssign reg e)
- return (CmmReg reg)
+ -- expressions, which are wrong here.
+ -- this is a NonPtr because it only duplicates an existing
+ reg <- newNonPtrTemp (cmmExprRep e) --TODO FIXME NOW
+ stmtC (CmmAssign (CmmLocal reg) e)
+ return (CmmReg (CmmLocal reg))
-- -----------------------------------------------------------------------------
-- Save/restore the thread state in the TSO
-- -----------------------------------------------------------------------------
-- Save/restore the thread state in the TSO
emitCloseNursery = stmtC $ CmmStore nursery_bdescr_free (cmmOffsetW stgHp 1)
emitLoadThreadState = do
emitCloseNursery = stmtC $ CmmStore nursery_bdescr_free (cmmOffsetW stgHp 1)
emitLoadThreadState = do
+ tso <- newNonPtrTemp wordRep -- TODO FIXME NOW
stmtsC [
-- tso = CurrentTSO;
stmtsC [
-- tso = CurrentTSO;
- CmmAssign tso stgCurrentTSO,
+ CmmAssign (CmmLocal tso) stgCurrentTSO,
- CmmAssign sp (CmmLoad (cmmOffset (CmmReg tso) tso_SP)
+ CmmAssign sp (CmmLoad (cmmOffset (CmmReg (CmmLocal tso)) tso_SP)
wordRep),
-- SpLim = tso->stack + RESERVED_STACK_WORDS;
wordRep),
-- SpLim = tso->stack + RESERVED_STACK_WORDS;
- CmmAssign spLim (cmmOffsetW (cmmOffset (CmmReg tso) tso_STACK)
+ CmmAssign spLim (cmmOffsetW (cmmOffset (CmmReg (CmmLocal tso)) tso_STACK)
rESERVED_STACK_WORDS)
]
emitOpenNursery
-- and load the current cost centre stack from the TSO when profiling:
when opt_SccProfilingOn $
stmtC (CmmStore curCCSAddr
rESERVED_STACK_WORDS)
]
emitOpenNursery
-- and load the current cost centre stack from the TSO when profiling:
when opt_SccProfilingOn $
stmtC (CmmStore curCCSAddr
- (CmmLoad (cmmOffset (CmmReg tso) tso_CCCS) wordRep))
+ (CmmLoad (cmmOffset (CmmReg (CmmLocal tso)) tso_CCCS) wordRep))
emitOpenNursery = stmtsC [
-- Hp = CurrentNursery->free - 1;
emitOpenNursery = stmtsC [
-- Hp = CurrentNursery->free - 1;
initHpc :: Module -> HpcInfo -> Code
initHpc this_mod (HpcInfo tickCount hashNo)
initHpc :: Module -> HpcInfo -> Code
initHpc this_mod (HpcInfo tickCount hashNo)
- = do { id <- newTemp wordRep
+ = do { id <- newNonPtrTemp wordRep -- TODO FIXME NOW
; emitForeignCall'
PlayRisky
[(id,NoHint)]
; emitForeignCall'
PlayRisky
[(id,NoHint)]
-- ---------------------------------------------------------------------------
-- Code generation for PrimOps
-- ---------------------------------------------------------------------------
-- Code generation for PrimOps
-cgPrimOp :: [CmmReg] -- where to put the results
+cgPrimOp :: CmmFormals -- where to put the results
-> PrimOp -- the op
-> [StgArg] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
-> PrimOp -- the op
-> [StgArg] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
emitPrimOp results op non_void_args live
emitPrimOp results op non_void_args live
-emitPrimOp :: [CmmReg] -- where to put the results
+emitPrimOp :: CmmFormals -- where to put the results
-> PrimOp -- the op
-> [CmmExpr] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
-> PrimOp -- the op
-> [CmmExpr] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
- CmmAssign res_r (CmmMachOp mo_wordAdd [aa,bb]),
- CmmAssign res_c $
+ CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
+ CmmAssign (CmmLocal res_c) $
CmmMachOp mo_wordUShr [
CmmMachOp mo_wordAnd [
CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
CmmMachOp mo_wordUShr [
CmmMachOp mo_wordAnd [
CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
- CmmMachOp mo_wordXor [aa, CmmReg res_r]
+ CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
],
CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
]
],
CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
]
c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
-}
= stmtsC [
c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
-}
= stmtsC [
- CmmAssign res_r (CmmMachOp mo_wordSub [aa,bb]),
- CmmAssign res_c $
+ CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
+ CmmAssign (CmmLocal res_c) $
CmmMachOp mo_wordUShr [
CmmMachOp mo_wordAnd [
CmmMachOp mo_wordXor [aa,bb],
CmmMachOp mo_wordUShr [
CmmMachOp mo_wordAnd [
CmmMachOp mo_wordXor [aa,bb],
- CmmMachOp mo_wordXor [aa, CmmReg res_r]
+ CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
],
CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
]
],
CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
]
newspark = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("newSpark")))
emitPrimOp [res] ReadMutVarOp [mutv] live
newspark = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("newSpark")))
emitPrimOp [res] ReadMutVarOp [mutv] live
- = stmtC (CmmAssign res (cmmLoadIndexW mutv fixedHdrSize))
+ = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize))
emitPrimOp [] WriteMutVarOp [mutv,var] live
= do
emitPrimOp [] WriteMutVarOp [mutv,var] live
= do
-- r = (((StgArrWords *)(a))->words * sizeof(W_))
emitPrimOp [res] SizeofByteArrayOp [arg] live
= stmtC $
-- r = (((StgArrWords *)(a))->words * sizeof(W_))
emitPrimOp [res] SizeofByteArrayOp [arg] live
= stmtC $
- CmmAssign res (CmmMachOp mo_wordMul [
+ CmmAssign (CmmLocal res) (CmmMachOp mo_wordMul [
cmmLoadIndexW arg fixedHdrSize,
CmmLit (mkIntCLit wORD_SIZE)
])
cmmLoadIndexW arg fixedHdrSize,
CmmLit (mkIntCLit wORD_SIZE)
])
-- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
emitPrimOp [res] ByteArrayContents_Char [arg] live
-- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
emitPrimOp [res] ByteArrayContents_Char [arg] live
- = stmtC (CmmAssign res (cmmOffsetB arg arrWordsHdrSize))
+ = stmtC (CmmAssign (CmmLocal res) (cmmOffsetB arg arrWordsHdrSize))
-- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
emitPrimOp [res] StableNameToIntOp [arg] live
-- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
emitPrimOp [res] StableNameToIntOp [arg] live
- = stmtC (CmmAssign res (cmmLoadIndexW arg fixedHdrSize))
+ = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize))
-- #define eqStableNamezh(r,sn1,sn2) \
-- (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
emitPrimOp [res] EqStableNameOp [arg1,arg2] live
-- #define eqStableNamezh(r,sn1,sn2) \
-- (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
emitPrimOp [res] EqStableNameOp [arg1,arg2] live
- = stmtC (CmmAssign res (CmmMachOp mo_wordEq [
+ = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [
cmmLoadIndexW arg1 fixedHdrSize,
cmmLoadIndexW arg2 fixedHdrSize
]))
emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] live
cmmLoadIndexW arg1 fixedHdrSize,
cmmLoadIndexW arg2 fixedHdrSize
]))
emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] live
- = stmtC (CmmAssign res (CmmMachOp mo_wordEq [arg1,arg2]))
+ = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [arg1,arg2]))
-- #define addrToHValuezh(r,a) r=(P_)a
emitPrimOp [res] AddrToHValueOp [arg] live
-- #define addrToHValuezh(r,a) r=(P_)a
emitPrimOp [res] AddrToHValueOp [arg] live
- = stmtC (CmmAssign res arg)
+ = stmtC (CmmAssign (CmmLocal res) arg)
-- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
emitPrimOp [res] DataToTagOp [arg] live
-- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
emitPrimOp [res] DataToTagOp [arg] live
- = stmtC (CmmAssign res (getConstrTag arg))
+ = stmtC (CmmAssign (CmmLocal res) (getConstrTag arg))
{- Freezing arrays-of-ptrs requires changing an info table, for the
benefit of the generational collector. It needs to scavenge mutable
{- Freezing arrays-of-ptrs requires changing an info table, for the
benefit of the generational collector. It needs to scavenge mutable
-- }
emitPrimOp [res] UnsafeFreezeArrayOp [arg] live
= stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
-- }
emitPrimOp [res] UnsafeFreezeArrayOp [arg] live
= stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
+ CmmAssign (CmmLocal res) arg ]
-- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] live
-- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] live
- = stmtC (CmmAssign res arg)
+ = stmtC (CmmAssign (CmmLocal res) arg)
-- Reading/writing pointer arrays
-- Reading/writing pointer arrays
-- The rest just translate straightforwardly
emitPrimOp [res] op [arg] live
| nopOp op
-- The rest just translate straightforwardly
emitPrimOp [res] op [arg] live
| nopOp op
- = stmtC (CmmAssign res arg)
+ = stmtC (CmmAssign (CmmLocal res) arg)
| Just (mop,rep) <- narrowOp op
| Just (mop,rep) <- narrowOp op
- = stmtC (CmmAssign res (CmmMachOp (mop rep wordRep) [
+ = stmtC (CmmAssign (CmmLocal res) (CmmMachOp (mop rep wordRep) [
CmmMachOp (mop wordRep rep) [arg]]))
emitPrimOp [res] op args live
CmmMachOp (mop wordRep rep) [arg]]))
emitPrimOp [res] op args live
(Just vols)
| Just mop <- translateOp op
(Just vols)
| Just mop <- translateOp op
- = let stmt = CmmAssign res (CmmMachOp mop args) in
+ = let stmt = CmmAssign (CmmLocal res) (CmmMachOp mop args) in
stmtC stmt
emitPrimOp _ op _ _
stmtC stmt
emitPrimOp _ op _ _
mkBasicIndexedRead off Nothing read_rep res base idx
mkBasicIndexedRead off Nothing read_rep res base idx
- = stmtC (CmmAssign res (cmmLoadIndexOffExpr off read_rep base idx))
+ = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexOffExpr off read_rep base idx))
mkBasicIndexedRead off (Just cast) read_rep res base idx
mkBasicIndexedRead off (Just cast) read_rep res base idx
- = stmtC (CmmAssign res (CmmMachOp cast [
+ = stmtC (CmmAssign (CmmLocal res) (CmmMachOp cast [
cmmLoadIndexOffExpr off read_rep base idx]))
mkBasicIndexedWrite off Nothing write_rep base idx val
cmmLoadIndexOffExpr off read_rep base idx]))
mkBasicIndexedWrite off Nothing write_rep base idx val
push_em ccs [] = return ccs
push_em ccs (cc:rest) = do
push_em ccs [] = return ccs
push_em ccs (cc:rest) = do
+ tmp <- newNonPtrTemp wordRep -- TODO FIXME NOW
pushCostCentre tmp ccs cc
pushCostCentre tmp ccs cc
- push_em (CmmReg tmp) rest
+ push_em (CmmReg (CmmLocal tmp)) rest
ccsExpr :: CostCentreStack -> CmmExpr
ccsExpr ccs
ccsExpr :: CostCentreStack -> CmmExpr
ccsExpr ccs
emitRegisterCC :: CostCentre -> Code
emitRegisterCC cc = do
emitRegisterCC :: CostCentre -> Code
emitRegisterCC cc = do
- { tmp <- newTemp cIntRep
+ { tmp <- newNonPtrTemp cIntRep
; stmtsC [
CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_link)
(CmmLoad cC_LIST wordRep),
CmmStore cC_LIST cc_lit,
; stmtsC [
CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_link)
(CmmLoad cC_LIST wordRep),
CmmStore cC_LIST cc_lit,
- CmmAssign tmp (CmmLoad cC_ID cIntRep),
- CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_ccID) (CmmReg tmp),
- CmmStore cC_ID (cmmRegOffB tmp 1)
+ CmmAssign (CmmLocal tmp) (CmmLoad cC_ID cIntRep),
+ CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_ccID) (CmmReg (CmmLocal tmp)),
+ CmmStore cC_ID (cmmRegOffB (CmmLocal tmp) 1)
emitRegisterCCS :: CostCentreStack -> Code
emitRegisterCCS ccs = do
emitRegisterCCS :: CostCentreStack -> Code
emitRegisterCCS ccs = do
- { tmp <- newTemp cIntRep
+ { tmp <- newNonPtrTemp cIntRep
; stmtsC [
CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_prevStack)
(CmmLoad cCS_LIST wordRep),
CmmStore cCS_LIST ccs_lit,
; stmtsC [
CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_prevStack)
(CmmLoad cCS_LIST wordRep),
CmmStore cCS_LIST ccs_lit,
- CmmAssign tmp (CmmLoad cCS_ID cIntRep),
- CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_ccsID) (CmmReg tmp),
- CmmStore cCS_ID (cmmRegOffB tmp 1)
+ CmmAssign (CmmLocal tmp) (CmmLoad cCS_ID cIntRep),
+ CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_ccsID) (CmmReg (CmmLocal tmp)),
+ CmmStore cCS_ID (cmmRegOffB (CmmLocal tmp) 1)
emitSetCCC cc
| not opt_SccProfilingOn = nopC
| otherwise = do
emitSetCCC cc
| not opt_SccProfilingOn = nopC
| otherwise = do
+ tmp <- newNonPtrTemp wordRep -- TODO FIXME NOW
ASSERT( sccAbleCostCentre cc )
pushCostCentre tmp curCCS cc
ASSERT( sccAbleCostCentre cc )
pushCostCentre tmp curCCS cc
- stmtC (CmmStore curCCSAddr (CmmReg tmp))
+ stmtC (CmmStore curCCSAddr (CmmReg (CmmLocal tmp)))
when (isSccCountCostCentre cc) $
stmtC (bumpSccCount curCCS)
when (isSccCountCostCentre cc) $
stmtC (bumpSccCount curCCS)
-pushCostCentre :: CmmReg -> CmmExpr -> CostCentre -> Code
+pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> Code
pushCostCentre result ccs cc
= emitRtsCallWithResult result PtrHint
SLIT("PushCostCentre") [(ccs,PtrHint),
pushCostCentre result ccs cc
= emitRtsCallWithResult result PtrHint
SLIT("PushCostCentre") [(ccs,PtrHint),
bumpHistogramE :: LitString -> CmmExpr -> Code
bumpHistogramE lbl n
bumpHistogramE :: LitString -> CmmExpr -> Code
bumpHistogramE lbl n
- = do t <- newTemp cLongRep
- stmtC (CmmAssign t n)
- emitIf (CmmMachOp (MO_U_Le cLongRep) [CmmReg t, eight]) $
- stmtC (CmmAssign t eight)
+ = do t <- newNonPtrTemp cLongRep
+ stmtC (CmmAssign (CmmLocal t) n)
+ emitIf (CmmMachOp (MO_U_Le cLongRep) [CmmReg (CmmLocal t), eight]) $
+ stmtC (CmmAssign (CmmLocal t) eight)
stmtC (addToMemLong (cmmIndexExpr cLongRep
(CmmLit (CmmLabel (mkRtsDataLabel lbl)))
stmtC (addToMemLong (cmmIndexExpr cLongRep
(CmmLit (CmmLabel (mkRtsDataLabel lbl)))
1)
where
eight = CmmLit (CmmInt 8 cLongRep)
1)
where
eight = CmmLit (CmmInt 8 cLongRep)
cgLit,
emitDataLits, emitRODataLits, emitIf, emitIfThenElse,
emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult,
cgLit,
emitDataLits, emitRODataLits, emitIf, emitIfThenElse,
emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult,
+ assignNonPtrTemp, newNonPtrTemp,
+ assignPtrTemp, newPtrTemp,
emitSimultaneously,
emitSwitch, emitLitSwitch,
tagToClosure,
emitSimultaneously,
emitSwitch, emitLitSwitch,
tagToClosure,
emitRtsCallWithVols fun args vols
= emitRtsCall' [] fun args (Just vols)
emitRtsCallWithVols fun args vols
= emitRtsCall' [] fun args (Just vols)
-emitRtsCallWithResult :: CmmReg -> MachHint -> LitString
+emitRtsCallWithResult :: LocalReg -> MachHint -> LitString
-> [(CmmExpr,MachHint)] -> Code
emitRtsCallWithResult res hint fun args
= emitRtsCall' [(res,hint)] fun args Nothing
-- Make a call to an RTS C procedure
emitRtsCall'
-> [(CmmExpr,MachHint)] -> Code
emitRtsCallWithResult res hint fun args
= emitRtsCall' [(res,hint)] fun args Nothing
-- Make a call to an RTS C procedure
emitRtsCall'
-> LitString
-> [(CmmExpr,MachHint)]
-> Maybe [GlobalReg]
-> LitString
-> [(CmmExpr,MachHint)]
-> Maybe [GlobalReg]
--
-------------------------------------------------------------------------
--
-------------------------------------------------------------------------
-assignTemp :: CmmExpr -> FCode CmmExpr
+assignNonPtrTemp :: CmmExpr -> FCode CmmExpr
-- For a non-trivial expression, e, create a local
-- variable and assign the expression to it
-- For a non-trivial expression, e, create a local
-- variable and assign the expression to it
| isTrivialCmmExpr e = return e
| isTrivialCmmExpr e = return e
- | otherwise = do { reg <- newTemp (cmmExprRep e)
- ; stmtC (CmmAssign reg e)
- ; return (CmmReg reg) }
+ | otherwise = do { reg <- newNonPtrTemp (cmmExprRep e)
+ ; stmtC (CmmAssign (CmmLocal reg) e)
+ ; return (CmmReg (CmmLocal reg)) }
+assignPtrTemp :: CmmExpr -> FCode CmmExpr
+-- For a non-trivial expression, e, create a local
+-- variable and assign the expression to it
+assignPtrTemp e
+ | isTrivialCmmExpr e = return e
+ | otherwise = do { reg <- newPtrTemp (cmmExprRep e)
+ ; stmtC (CmmAssign (CmmLocal reg) e)
+ ; return (CmmReg (CmmLocal reg)) }
-newTemp :: MachRep -> FCode CmmReg
-newTemp rep = do { uniq <- newUnique; return (CmmLocal (LocalReg uniq rep)) }
+newNonPtrTemp :: MachRep -> FCode LocalReg
+newNonPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep KindNonPtr) }
+
+newPtrTemp :: MachRep -> FCode LocalReg
+newPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep KindPtr) }
-------------------------------------------------------------------------
-------------------------------------------------------------------------
-- if we can knock off a bunch of default cases with one if, then do so
| Just deflt <- mb_deflt, (lowest_branch - lo_tag) >= n_branches
-- if we can knock off a bunch of default cases with one if, then do so
| Just deflt <- mb_deflt, (lowest_branch - lo_tag) >= n_branches
- = do { (assign_tag, tag_expr') <- assignTemp' tag_expr
+ = do { (assign_tag, tag_expr') <- assignNonPtrTemp' tag_expr
; let cond = cmmULtWord tag_expr' (CmmLit (mkIntCLit lowest_branch))
branch = CmmCondBranch cond deflt
; stmts <- mk_switch tag_expr' branches mb_deflt
; let cond = cmmULtWord tag_expr' (CmmLit (mkIntCLit lowest_branch))
branch = CmmCondBranch cond deflt
; stmts <- mk_switch tag_expr' branches mb_deflt
}
| Just deflt <- mb_deflt, (hi_tag - highest_branch) >= n_branches
}
| Just deflt <- mb_deflt, (hi_tag - highest_branch) >= n_branches
- = do { (assign_tag, tag_expr') <- assignTemp' tag_expr
+ = do { (assign_tag, tag_expr') <- assignNonPtrTemp' tag_expr
; let cond = cmmUGtWord tag_expr' (CmmLit (mkIntCLit highest_branch))
branch = CmmCondBranch cond deflt
; stmts <- mk_switch tag_expr' branches mb_deflt
; let cond = cmmUGtWord tag_expr' (CmmLit (mkIntCLit highest_branch))
branch = CmmCondBranch cond deflt
; stmts <- mk_switch tag_expr' branches mb_deflt
}
| otherwise -- Use an if-tree
}
| otherwise -- Use an if-tree
- = do { (assign_tag, tag_expr') <- assignTemp' tag_expr
+ = do { (assign_tag, tag_expr') <- assignNonPtrTemp' tag_expr
-- To avoid duplication
; lo_stmts <- mk_switch tag_expr' lo_branches mb_deflt
lo_tag (mid_tag-1) via_C
-- To avoid duplication
; lo_stmts <- mk_switch tag_expr' lo_branches mb_deflt
lo_tag (mid_tag-1) via_C
is_lo (t,_) = t < mid_tag
is_lo (t,_) = t < mid_tag
| isTrivialCmmExpr e = return (CmmNop, e)
| isTrivialCmmExpr e = return (CmmNop, e)
- | otherwise = do { reg <- newTemp (cmmExprRep e)
- ; return (CmmAssign reg e, CmmReg reg) }
-
+ | otherwise = do { reg <- newNonPtrTemp (cmmExprRep e)
+ ; return (CmmAssign (CmmLocal reg) e, CmmReg (CmmLocal reg)) }
emitLitSwitch :: CmmExpr -- Tag to switch on
-> [(Literal, CgStmts)] -- Tagged branches
emitLitSwitch :: CmmExpr -- Tag to switch on
-> [(Literal, CgStmts)] -- Tagged branches
emitLitSwitch scrut [] deflt
= emitCgStmts deflt
emitLitSwitch scrut branches deflt_blk
emitLitSwitch scrut [] deflt
= emitCgStmts deflt
emitLitSwitch scrut branches deflt_blk
- = do { scrut' <- assignTemp scrut
+ = do { scrut' <- assignNonPtrTemp scrut
; deflt_blk_id <- forkCgStmts deflt_blk
; blk <- mk_lit_switch scrut' deflt_blk_id (sortLe le branches)
; emitCgStmts blk }
; deflt_blk_id <- forkCgStmts deflt_blk
; blk <- mk_lit_switch scrut' deflt_blk_id (sortLe le branches)
; emitCgStmts blk }
; stmtC from_temp }
go_via_temp (CmmAssign dest src)
; stmtC from_temp }
go_via_temp (CmmAssign dest src)
- = do { tmp <- newTemp (cmmRegRep dest)
- ; stmtC (CmmAssign tmp src)
- ; return (CmmAssign dest (CmmReg tmp)) }
+ = do { tmp <- newNonPtrTemp (cmmRegRep dest) -- TODO FIXME NOW if the pair of assignments move across a call this will be wrong
+ ; stmtC (CmmAssign (CmmLocal tmp) src)
+ ; return (CmmAssign dest (CmmReg (CmmLocal tmp))) }
go_via_temp (CmmStore dest src)
go_via_temp (CmmStore dest src)
- = do { tmp <- newTemp (cmmExprRep src)
- ; stmtC (CmmAssign tmp src)
- ; return (CmmStore dest (CmmReg tmp)) }
+ = do { tmp <- newNonPtrTemp (cmmExprRep src) -- TODO FIXME NOW if the pair of assignemnts move across a call this will be wrong
+ ; stmtC (CmmAssign (CmmLocal tmp) src)
+ ; return (CmmStore dest (CmmReg (CmmLocal tmp))) }
in
mapCs do_component components
in
mapCs do_component components
CgRep(..), nonVoidArg,
argMachRep, primRepToCgRep, primRepHint,
isFollowableArg, isVoidArg,
CgRep(..), nonVoidArg,
argMachRep, primRepToCgRep, primRepHint,
isFollowableArg, isVoidArg,
- isFloatingArg, isNonPtrArg, is64BitArg,
+ isFloatingArg, is64BitArg,
separateByPtrFollowness,
cgRepSizeW, cgRepSizeB,
retAddrSizeW,
separateByPtrFollowness,
cgRepSizeW, cgRepSizeB,
retAddrSizeW,
isFloatingArg FloatArg = True
isFloatingArg _ = False
isFloatingArg FloatArg = True
isFloatingArg _ = False
-isNonPtrArg :: CgRep -> Bool
--- Identify anything which is one word large and not a pointer.
-isNonPtrArg NonPtrArg = True
-isNonPtrArg other = False
-
is64BitArg :: CgRep -> Bool
is64BitArg LongArg = True
is64BitArg _ = False
is64BitArg :: CgRep -> Bool
is64BitArg LongArg = True
is64BitArg _ = False
where
reg_or_addr = get_GlobalReg_reg_or_addr reg
where
reg_or_addr = get_GlobalReg_reg_or_addr reg
fixAssign (CmmCall target results args)
= mapAndUnzipUs fixResult results `thenUs` \ (results',stores) ->
returnUs (CmmCall target results' args :
fixAssign (CmmCall target results args)
= mapAndUnzipUs fixResult results `thenUs` \ (results',stores) ->
returnUs (CmmCall target results' args :
[CmmStore baseRegAddr (CmmReg local)])
fixResult other =
returnUs (other,[])
[CmmStore baseRegAddr (CmmReg local)])
fixResult other =
returnUs (other,[])
fixAssign other_stmt = returnUs [other_stmt]
fixAssign other_stmt = returnUs [other_stmt]
return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
-assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
+assignReg_I64Code (CmmLocal (LocalReg u_dst pk _)) valueTree = do
ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
let
r_dst_lo = mkVReg u_dst I32
ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
let
r_dst_lo = mkVReg u_dst I32
-iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
+iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64 _)))
= return (ChildCode64 nilOL (mkVReg vu I32))
-- we handle addition, but rather badly
= return (ChildCode64 nilOL (mkVReg vu I32))
-- we handle addition, but rather badly
return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
rlo
return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
rlo
-iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
+iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64 _)))
= return (ChildCode64 nilOL (mkVReg vu I32))
iselExpr64 (CmmLit (CmmInt i _)) = do
= return (ChildCode64 nilOL (mkVReg vu I32))
iselExpr64 (CmmLit (CmmInt i _)) = do
getRegisterReg :: CmmReg -> Reg
getRegisterReg :: CmmReg -> Reg
-getRegisterReg (CmmLocal (LocalReg u pk))
+getRegisterReg (CmmLocal (LocalReg u pk _))
= mkVReg u pk
getRegisterReg (CmmGlobal mid)
= mkVReg u pk
getRegisterReg (CmmGlobal mid)
genCCall
:: CmmCallTarget -- function to call
genCCall
:: CmmCallTarget -- function to call
- -> [(CmmReg,MachHint)] -- where to put the result
- -> [(CmmExpr,MachHint)] -- arguments (of mixed type)
+ -> CmmHintFormals -- where to put the result
+ -> CmmActuals -- arguments (of mixed type)
-> NatM InstrBlock
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-> NatM InstrBlock
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
actuallyInlineFloatOp rep instr [(x,_)]
= do res <- trivialUFCode rep instr x
any <- anyReg res
actuallyInlineFloatOp rep instr [(x,_)]
= do res <- trivialUFCode rep instr x
any <- anyReg res
- return (any (getRegisterReg r))
+ return (any (getRegisterReg (CmmLocal r)))
genCCall target dest_regs args = do
let
genCCall target dest_regs args = do
let
rep -> unitOL (MOV rep (OpReg eax) (OpReg r_dest))
where
r_dest_hi = getHiVRegFromLo r_dest
rep -> unitOL (MOV rep (OpReg eax) (OpReg r_dest))
where
r_dest_hi = getHiVRegFromLo r_dest
- rep = cmmRegRep dest
- r_dest = getRegisterReg dest
+ rep = localRegRep dest
+ r_dest = getRegisterReg (CmmLocal dest)
assign_code many = panic "genCCall.assign_code many"
return (push_code `appOL`
assign_code many = panic "genCCall.assign_code many"
return (push_code `appOL`
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-outOfLineFloatOp :: CallishMachOp -> CmmReg -> [(CmmExpr,MachHint)]
+outOfLineFloatOp :: CallishMachOp -> CmmFormal -> CmmActuals
-> NatM InstrBlock
outOfLineFloatOp mop res args
= do
targetExpr <- cmmMakeDynamicReference addImportNat CallReference lbl
let target = CmmForeignCall targetExpr CCallConv
-> NatM InstrBlock
outOfLineFloatOp mop res args
= do
targetExpr <- cmmMakeDynamicReference addImportNat CallReference lbl
let target = CmmForeignCall targetExpr CCallConv
- if cmmRegRep res == F64
+ if localRegRep res == F64
then
stmtToInstrs (CmmCall target [(res,FloatHint)] args)
else do
uq <- getUniqueNat
let
then
stmtToInstrs (CmmCall target [(res,FloatHint)] args)
else do
uq <- getUniqueNat
let
- tmp = CmmLocal (LocalReg uq F64)
+ tmp = LocalReg uq F64 KindNonPtr
-- in
code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args)
-- in
code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args)
- code2 <- stmtToInstrs (CmmAssign res (CmmReg tmp))
+ code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
return (code1 `appOL` code2)
where
lbl = mkForeignLabel fn Nothing False
return (code1 `appOL` code2)
where
lbl = mkForeignLabel fn Nothing False