import Maybes ( Maybe012(..), maybeToBool )
import StgSyn ( StgOp(..) )
import MachOp ( MachOp(..), resultRepsOfMachOp )
-import PrimRep ( isFloatingRep, PrimRep(..) )
+import PrimRep ( isFloatingRep, is64BitRep,
+ PrimRep(..), getPrimRepArrayElemSize )
import StixInfo ( genCodeInfoTable, genBitmapInfoTable,
livenessIsSmall, bitmapToIntegers )
import StixMacro ( macroCode, checkCode )
-- We need to promote any item smaller than a word to a word
promote_to_word pk
- | sizeOf pk >= sizeOf IntRep = pk
- | otherwise = IntRep
+ | getPrimRepArrayElemSize pk >= getPrimRepArrayElemSize IntRep = pk
+ | otherwise = IntRep
upd_reqd = closureUpdReqd cl_info
\begin{code}
gencode (CAssign lhs rhs)
- | getAmodeRep lhs == VoidRep = returnUs id
+ | lhs_rep == VoidRep
+ = returnUs id
| otherwise
- = let pk = getAmodeRep lhs
- pk' = if mixedTypeLocn lhs && not (isFloatingRep pk) then IntRep else pk
+ = let -- This is a Hack. Should be cleaned up.
+ -- JRS, 10 Dec 01
+ pk' | ncg_target_is_32bit && is64BitRep lhs_rep
+ = lhs_rep
+ | otherwise
+ = if mixedTypeLocn lhs && not (isFloatingRep lhs_rep)
+ then IntRep
+ else lhs_rep
lhs' = a2stix lhs
rhs' = a2stix' rhs
in
returnUs (\xs -> mkStAssign pk' lhs' rhs' : xs)
+ where
+ lhs_rep = getAmodeRep lhs
\end{code}
import qualified Pretty
import Outputable
+-- DEBUGGING ONLY
+--import OrdList
\end{code}
The 96/03 native-code generator has machine-independent and
StJump dsts addr
-> StJump dsts (stixExpr_ConFold addr)
StCondJump addr test
- -> StCondJump addr (stixExpr_ConFold test)
+ -> let test_opt = stixExpr_ConFold test
+ in
+ if manifestlyZero test_opt
+ then StComment (_PK_ ("deleted: " ++ showSDoc (pprStixStmt stmt)))
+ else StCondJump addr (stixExpr_ConFold test)
StData pk datas
-> StData pk (map stixExpr_ConFold datas)
other
-> other
-
+ where
+ manifestlyZero (StInt 0) = True
+ manifestlyZero other = False
stixExpr_ConFold expr
= case expr of
insertSpillCode :: [Instr] -> [Instr]
insertSpillCode insns
= let uniques_in_insns
- = map getUnique
+ = map getVRegUnique
(regSetToList
(foldl unionRegSets emptyRegSet
(map vregs_in_insn insns)))
= case regUsage i of
RU rds wrs -> filterRegSet isVirtualReg
(rds `unionRegSets` wrs)
- vreg_to_slot_map :: FiniteMap Unique Int
+ vreg_to_slot_map :: FiniteMap VRegUnique Int
vreg_to_slot_map
= listToFM (zip uniques_in_insns [0..])
-- to the stack pointer, as opposed to the frame pointer. The other is a
-- counter, used to manufacture new temporary register names.
-patchInstr :: FiniteMap Unique Int -> (Int,Int) -> Instr -> ((Int,Int), [Instr])
+patchInstr :: FiniteMap VRegUnique Int -> (Int,Int) -> Instr -> ((Int,Int), [Instr])
patchInstr vreg_to_slot_map (delta,ctr) instr
| null memSrcs && null memDsts
| isVirtualReg vreg
= case [vi | (vreg', vi) <- vreg_env, vreg' == vreg] of
[i] -> case regClass vreg of
- RcInteger -> VirtualRegI (mkPseudoUnique3 i)
- RcFloat -> VirtualRegF (mkPseudoUnique3 i)
- RcDouble -> VirtualRegD (mkPseudoUnique3 i)
+ RcInteger -> VirtualRegI (pseudoVReg i)
+ RcFloat -> VirtualRegF (pseudoVReg i)
+ RcDouble -> VirtualRegD (pseudoVReg i)
_ -> pprPanic "patchInstr: unmapped VReg" (ppr vreg)
| otherwise
= vreg
+ pseudoVReg i = VRegUniqueLo (mkPseudoUnique3 i)
+
memSrcs = filter isVirtualReg (regSetToList srcs)
memDsts = filter isVirtualReg (regSetToList dsts)
#include "HsVersions.h"
#include "nativeGen/NCG.h"
+import Unique ( Unique )
import MachMisc -- may differ per-platform
import MachRegs
import OrdList ( OrdList, nilOL, isNilOL, unitOL, appOL, toOL,
import CLabel ( isAsmTemp )
#endif
import Maybes ( maybeToBool, Maybe012(..) )
-import PrimRep ( isFloatingRep, PrimRep(..) )
+import PrimRep ( isFloatingRep, is64BitRep, PrimRep(..),
+ getPrimRepArrayElemSize )
import Stix ( getNatLabelNCG, StixStmt(..), StixExpr(..),
- StixReg(..), StixVReg(..), CodeSegment(..),
+ StixReg(..), pprStixReg, StixVReg(..), CodeSegment(..),
DestInfo, hasDestInfo,
- pprStixExpr,
+ pprStixExpr, repOfStixExpr,
liftStrings,
NatM, thenNat, returnNat, mapNat,
mapAndUnzipNat, mapAccumLNat,
- getDeltaNat, setDeltaNat,
- ncgPrimopMoan
+ getDeltaNat, setDeltaNat, getUniqueNat,
+ ncgPrimopMoan,
+ ncg_target_is_32bit
)
import Pretty
import Outputable ( panic, pprPanic, showSDoc )
import qualified Outputable
import CmdLineOpts ( opt_Static )
+import Stix ( pprStixStmt )
-- DEBUGGING ONLY
import IOExts ( trace )
-import Stix ( pprStixStmt )
infixr 3 `bind`
\end{code}
StAssignMem pk addr src
| isFloatingRep pk -> assignMem_FltCode pk (derefDLL addr) (derefDLL src)
+ | ncg_target_is_32bit
+ && is64BitRep pk -> assignMem_I64Code (derefDLL addr) (derefDLL src)
| otherwise -> assignMem_IntCode pk (derefDLL addr) (derefDLL src)
StAssignReg pk reg src
| isFloatingRep pk -> assignReg_FltCode pk reg (derefDLL src)
+ | ncg_target_is_32bit
+ && is64BitRep pk -> assignReg_I64Code reg (derefDLL src)
| otherwise -> assignReg_IntCode pk reg (derefDLL src)
StAssignMachOp lhss mop rhss
-> assignMachOp lhss mop rhss
-- the linker can handle simple arithmetic...
getData (StIndex rep (StCLbl lbl) (StInt off)) =
returnNat (nilOL,
- ImmIndex lbl (fromInteger off * sizeOf rep))
+ ImmIndex lbl (fromInteger off * getPrimRepArrayElemSize rep))
-- Top-level lifted-out string. The segment will already have been set
-- (see Stix.liftStrings).
mangleIndexTree (StIndex pk base (StInt i))
= StMachOp MO_Nat_Add [base, off]
where
- off = StInt (i * toInteger (sizeOf pk))
+ off = StInt (i * toInteger (getPrimRepArrayElemSize pk))
mangleIndexTree (StIndex pk base off)
= StMachOp MO_Nat_Add [
]
where
shift :: PrimRep -> Int
- shift rep = case sizeOf rep of
+ shift rep = case getPrimRepArrayElemSize rep of
1 -> 0
2 -> 1
4 -> 2
maybeImm (StCLbl l)
= Just (ImmCLbl l)
maybeImm (StIndex rep (StCLbl l) (StInt off))
- = Just (ImmIndex l (fromInteger off * sizeOf rep))
+ = Just (ImmIndex l (fromInteger off * getPrimRepArrayElemSize rep))
maybeImm (StInt i)
| i >= toInteger (minBound::Int) && i <= toInteger (maxBound::Int)
= Just (ImmInt (fromInteger i))
%************************************************************************
%* *
+\subsection{The @Register64@ type}
+%* *
+%************************************************************************
+
+Simple support for generating 64-bit code (ie, 64 bit values and 64
+bit assignments) on 32-bit platforms. Unlike the main code generator
+we merely shoot for generating working code as simply as possible, and
+pay little attention to code quality. Specifically, there is no
+attempt to deal cleverly with the fixed-vs-floating register
+distinction; all values are generated into (pairs of) floating
+registers, even if this would mean some redundant reg-reg moves as a
+result. Only one of the VRegUniques is returned, since it will be
+of the VRegUniqueLo form, and the upper-half VReg can be determined
+by applying getHiVRegFromLo to it.
+
+\begin{code}
+
+data ChildCode64 -- a.k.a "Register64"
+ = ChildCode64
+ InstrBlock -- code
+ VRegUnique -- unique for the lower 32-bit temporary
+ -- which contains the result; use getHiVRegFromLo to find
+ -- the other VRegUnique.
+ -- Rules of this simplified insn selection game are
+ -- therefore that the returned VRegUniques may be modified
+
+assignMem_I64Code :: StixExpr -> StixExpr -> NatM InstrBlock
+assignReg_I64Code :: StixReg -> StixExpr -> NatM InstrBlock
+iselExpr64 :: StixExpr -> NatM ChildCode64
+
+-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+#if i386_TARGET_ARCH
+
+assignMem_I64Code addrTree valueTree
+ = iselExpr64 valueTree `thenNat` \ (ChildCode64 vcode vrlo) ->
+ getRegister addrTree `thenNat` \ register_addr ->
+ getNewRegNCG IntRep `thenNat` \ t_addr ->
+ let rlo = VirtualRegI vrlo
+ rhi = getHiVRegFromLo rlo
+ code_addr = registerCode register_addr t_addr
+ reg_addr = registerName register_addr t_addr
+ -- Little-endian store
+ mov_lo = MOV L (OpReg rlo)
+ (OpAddr (AddrBaseIndex (Just reg_addr) Nothing (ImmInt 0)))
+ mov_hi = MOV L (OpReg rhi)
+ (OpAddr (AddrBaseIndex (Just reg_addr) Nothing (ImmInt 4)))
+ in
+ returnNat (vcode `appOL` code_addr `snocOL` mov_lo `snocOL` mov_hi)
+
+assignReg_I64Code (StixTemp (StixVReg u_dst pk)) valueTree
+ = iselExpr64 valueTree `thenNat` \ (ChildCode64 vcode vr_src_lo) ->
+ let
+ r_dst_lo = mkVReg u_dst IntRep
+ r_src_lo = VirtualRegI vr_src_lo
+ r_dst_hi = getHiVRegFromLo r_dst_lo
+ r_src_hi = getHiVRegFromLo r_src_lo
+ mov_lo = MOV L (OpReg r_src_lo) (OpReg r_dst_lo)
+ mov_hi = MOV L (OpReg r_src_hi) (OpReg r_dst_hi)
+ in
+ returnNat (
+ vcode `snocOL` mov_lo `snocOL` mov_hi
+ )
+
+assignReg_I64Code lvalue valueTree
+ = pprPanic "assignReg_I64Code(i386): invalid lvalue"
+ (pprStixReg lvalue)
+
+
+
+iselExpr64 (StInd pk addrTree)
+ | is64BitRep pk
+ = getRegister addrTree `thenNat` \ register_addr ->
+ getNewRegNCG IntRep `thenNat` \ t_addr ->
+ getNewRegNCG IntRep `thenNat` \ rlo ->
+ let rhi = getHiVRegFromLo rlo
+ code_addr = registerCode register_addr t_addr
+ reg_addr = registerName register_addr t_addr
+ mov_lo = MOV L (OpAddr (AddrBaseIndex (Just reg_addr) Nothing (ImmInt 0)))
+ (OpReg rlo)
+ mov_hi = MOV L (OpAddr (AddrBaseIndex (Just reg_addr) Nothing (ImmInt 4)))
+ (OpReg rhi)
+ in
+ returnNat (
+ ChildCode64 (code_addr `snocOL` mov_lo `snocOL` mov_hi)
+ (getVRegUnique rlo)
+ )
+
+iselExpr64 (StReg (StixTemp (StixVReg vu pk)))
+ | is64BitRep pk
+ = getNewRegNCG IntRep `thenNat` \ r_dst_lo ->
+ let r_dst_hi = getHiVRegFromLo r_dst_lo
+ r_src_lo = mkVReg vu IntRep
+ r_src_hi = getHiVRegFromLo r_src_lo
+ mov_lo = MOV L (OpReg r_src_lo) (OpReg r_dst_lo)
+ mov_hi = MOV L (OpReg r_src_hi) (OpReg r_dst_hi)
+ in
+ returnNat (
+ ChildCode64 (toOL [mov_lo, mov_hi]) (getVRegUnique r_dst_lo)
+ )
+
+iselExpr64 (StCall fn cconv kind args)
+ | is64BitRep kind
+ = genCCall fn cconv kind args `thenNat` \ call ->
+ getNewRegNCG IntRep `thenNat` \ r_dst_lo ->
+ let r_dst_hi = getHiVRegFromLo r_dst_lo
+ mov_lo = MOV L (OpReg eax) (OpReg r_dst_lo)
+ mov_hi = MOV L (OpReg edx) (OpReg r_dst_hi)
+ in
+ returnNat (
+ ChildCode64 (call `snocOL` mov_lo `snocOL` mov_hi)
+ (getVRegUnique r_dst_lo)
+ )
+
+iselExpr64 expr
+ = pprPanic "iselExpr64(i386)" (pprStixExpr expr)
+
+#endif {- i386_TARGET_ARCH -}
+
+-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+
+\end{code}
+
+%************************************************************************
+%* *
\subsection{The @Register@ type}
%* *
%************************************************************************
= getRegister (mangleIndexTree tree)
getRegister (StCall fn cconv kind args)
+ | not (ncg_target_is_32bit && is64BitRep kind)
= genCCall fn cconv kind args `thenNat` \ call ->
returnNat (Fixed kind reg call)
where
sub_code sz x y = trivialCode (SUB sz) Nothing x y
getRegister (StInd pk mem)
+ | not (is64BitRep pk)
= getAmode mem `thenNat` \ amode ->
let
code = amodeCode amode
other -> pprPanic "getCondCode(x86,sparc)" (pprMachOp mop)
+getCondCode other = pprPanic "getCondCode(2)(x86,sparc)" (pprStixExpr other)
+
#endif {- i386_TARGET_ARCH || sparc_TARGET_ARCH -}
\end{code}
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#if i386_TARGET_ARCH
-genCCall fn cconv kind [StInt i]
+genCCall fn cconv ret_rep [StInt i]
| fn == SLIT ("PerformGC_wrapper")
= let call = toOL [
MOV L (OpImm (ImmInt (fromInteger i))) (OpReg eax),
returnNat call
-genCCall fn cconv kind args
- = mapNat get_call_arg
+genCCall fn cconv ret_rep args
+ = mapNat push_arg
(reverse args) `thenNat` \ sizes_n_codes ->
getDeltaNat `thenNat` \ delta ->
let (sizes, codes) = unzip sizes_n_codes
arg_size _ = 4
------------
- get_call_arg :: StixExpr{-current argument-}
+ push_arg :: StixExpr{-current argument-}
-> NatM (Int, InstrBlock) -- argsz, code
- get_call_arg arg
- = get_op arg `thenNat` \ (code, reg, sz) ->
- getDeltaNat `thenNat` \ delta ->
- arg_size sz `bind` \ size ->
- setDeltaNat (delta-size) `thenNat` \ _ ->
+ push_arg arg
+ | is64BitRep arg_rep
+ = iselExpr64 arg `thenNat` \ (ChildCode64 code vr_lo) ->
+ getDeltaNat `thenNat` \ delta ->
+ setDeltaNat (delta - 8) `thenNat` \ _ ->
+ let r_lo = VirtualRegI vr_lo
+ r_hi = getHiVRegFromLo r_lo
+ in returnNat (8,
+ toOL [PUSH L (OpReg r_hi), DELTA (delta - 4),
+ PUSH L (OpReg r_lo), DELTA (delta - 8)]
+ )
+ | otherwise
+ = get_op arg `thenNat` \ (code, reg, sz) ->
+ getDeltaNat `thenNat` \ delta ->
+ arg_size sz `bind` \ size ->
+ setDeltaNat (delta-size) `thenNat` \ _ ->
if (case sz of DF -> True; F -> True; _ -> False)
then returnNat (size,
code `appOL`
PUSH L (OpReg reg) `snocOL`
DELTA (delta-size)
)
+ where
+ arg_rep = repOfStixExpr arg
+
------------
get_op
:: StixExpr
module MachMisc (
- sizeOf, primRepToSize,
+ primRepToSize,
eXTRA_STK_ARGS_HERE,
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-Size of a @PrimRep@, in bytes.
-
-\begin{code}
-sizeOf :: PrimRep -> Int{-in bytes-}
-sizeOf pr = case primRepToSize pr of
- IF_ARCH_alpha({B->1; Bu->1; {-W->2; Wu->2;-} L->4; {-SF->4;-} Q->8; TF->8},)
- IF_ARCH_i386 ({B->1; Bu->1; W->2; Wu->2; L->4; Lu->4; F->4; DF->8; F80->10},)
- IF_ARCH_sparc({B->1; Bu->1; W->4; F->4; DF->8},)
-\end{code}
-
-% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
Now the volatile saves and restores. We add the basic guys to the
list of ``user'' registers provided. Note that there are more basic
registers on the restore list, because some are reloaded from
module MachRegs (
RegClass(..), regClass,
- Reg(..), isRealReg, isVirtualReg,
+ VRegUnique(..), pprVRegUnique, getHiVRegFromLo,
+ Reg(..), isRealReg, isVirtualReg, getVRegUnique,
allocatableRegs, argRegs, allArgRegs, callClobberedRegs,
Imm(..),
\begin{code}
+data VRegUnique
+ = VRegUniqueLo Unique -- lower part of a split quantity
+ | VRegUniqueHi Unique -- upper part thereof
+ deriving (Eq, Ord)
+
+instance Show VRegUnique where
+ show (VRegUniqueLo u) = show u
+ show (VRegUniqueHi u) = "_hi_" ++ show u
+
+pprVRegUnique :: VRegUnique -> Outputable.SDoc
+pprVRegUnique
+ = Outputable.text . show
+
+-- Determine the upper-half vreg for a 64-bit quantity on a 32-bit platform
+-- when supplied with the vreg for the lower-half of the quantity.
+getHiVRegFromLo (VirtualRegI (VRegUniqueLo u))
+ = VirtualRegI (VRegUniqueHi u)
+getHiVRegFromLo other
+ = pprPanic "getHiVRegFromLo" (ppr other)
+
data RegClass
= RcInteger
| RcFloat
data Reg
= RealReg Int
- | VirtualRegI Unique
- | VirtualRegF Unique
- | VirtualRegD Unique
+ | VirtualRegI VRegUnique
+ | VirtualRegF VRegUnique
+ | VirtualRegD VRegUnique
unRealReg (RealReg i) = i
unRealReg vreg = pprPanic "unRealReg on VirtualReg" (ppr vreg)
+getVRegUnique :: Reg -> VRegUnique
+getVRegUnique (VirtualRegI vu) = vu
+getVRegUnique (VirtualRegF vu) = vu
+getVRegUnique (VirtualRegD vu) = vu
+getVRegUnique rreg = pprPanic "getVRegUnique on RealReg" (ppr rreg)
+
mkVReg :: Unique -> PrimRep -> Reg
mkVReg u pk
#if sparc_TARGET_ARCH
= case pk of
- FloatRep -> VirtualRegF u
- DoubleRep -> VirtualRegD u
- other -> VirtualRegI u
+ FloatRep -> VirtualRegF (VRegUniqueLo u)
+ DoubleRep -> VirtualRegD (VRegUniqueLo u)
+ other -> VirtualRegI (VRegUniqueLo u)
#else
- = if isFloatingRep pk then VirtualRegD u else VirtualRegI u
+ = if isFloatingRep pk then VirtualRegD (VRegUniqueLo u)
+ else VirtualRegI (VRegUniqueLo u)
#endif
isVirtualReg (RealReg _) = False
instance Show Reg where
- showsPrec _ (RealReg i) = showString (showReg i)
- showsPrec _ (VirtualRegI u) = showString "%vI_" . shows u
- showsPrec _ (VirtualRegF u) = showString "%vF_" . shows u
- showsPrec _ (VirtualRegD u) = showString "%vD_" . shows u
+ show (RealReg i) = showReg i
+ show (VirtualRegI u) = "%vI_" ++ show u
+ show (VirtualRegF u) = "%vF_" ++ show u
+ show (VirtualRegD u) = "%vD_" ++ show u
instance Outputable Reg where
ppr r = Outputable.text (show r)
-
-instance Uniquable Reg where
- getUnique (RealReg i) = mkPseudoUnique2 i
- getUnique (VirtualRegI u) = u
- getUnique (VirtualRegF u) = u
- getUnique (VirtualRegD u) = u
\end{code}
** Machine-specific Reg stuff: **
pprReg IF_ARCH_i386(s,) r
= case r of
RealReg i -> ppr_reg_no IF_ARCH_i386(s,) i
- VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
- VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
+ VirtualRegI u -> text "%vI_" <> asmSDoc (pprVRegUnique u)
+ VirtualRegF u -> text "%vF_" <> asmSDoc (pprVRegUnique u)
where
#if alpha_TARGET_ARCH
ppr_reg_no :: Int -> Doc
JXX _ _ -> instr
CALL _ -> instr
CLTD -> instr
- _ -> pprPanic "patchInstr(x86)" empty
+ _ -> pprPanic "patchRegs(x86)" empty
where
patch1 insn op = insn (patchOp op)
Spill to memory, and load it back...
JRS, 000122: on x86, don't spill directly above the stack pointer,
-since some insn sequences (int <-> conversions, and eventually
-StixInteger) use this as a temp location. Leave 8 words (ie, 64 bytes
-for a 64-bit arch) of slop.
+since some insn sequences (int <-> conversions) use this as a temp
+location. Leave 8 words (ie, 64 bytes for a 64-bit arch) of slop.
\begin{code}
spillSlotSize :: Int
= pprPanic "spillSlotToOffset:"
(text "invalid spill location: " <> int slot)
-vregToSpillSlot :: FiniteMap Unique Int -> Unique -> Int
+vregToSpillSlot :: FiniteMap VRegUnique Int -> VRegUnique -> Int
vregToSpillSlot vreg_to_slot_map u
= case lookupFM vreg_to_slot_map u of
Just xx -> xx
- Nothing -> pprPanic "vregToSpillSlot: unmapped vreg" (ppr u)
+ Nothing -> pprPanic "vregToSpillSlot: unmapped vreg" (pprVRegUnique u)
-spillReg, loadReg :: FiniteMap Unique Int -> Int -> Reg -> Reg -> Instr
+spillReg, loadReg :: FiniteMap VRegUnique Int -> Int -> Reg -> Reg -> Instr
spillReg vreg_to_slot_map delta dyn vreg
| isVirtualReg vreg
- = let slot_no = vregToSpillSlot vreg_to_slot_map (getUnique vreg)
+ = let slot_no = vregToSpillSlot vreg_to_slot_map (getVRegUnique vreg)
off = spillSlotToOffset slot_no
in
{-Alpha: spill below the stack pointer (?)-}
loadReg vreg_to_slot_map delta vreg dyn
| isVirtualReg vreg
- = let slot_no = vregToSpillSlot vreg_to_slot_map (getUnique vreg)
+ = let slot_no = vregToSpillSlot vreg_to_slot_map (getVRegUnique vreg)
off = spillSlotToOffset slot_no
in
IF_ARCH_alpha( LD sz dyn (spRel (- (off `div` 8)))
StixStmt(..), mkStAssign, StixStmtList,
pprStixStmts, pprStixStmt, pprStixExpr, pprStixReg,
stixStmt_CountTempUses, stixStmt_Subst,
- liftStrings,
+ liftStrings, repOfStixExpr,
DestInfo(..), hasDestInfo,
stgBaseReg, stgNode, stgSp, stgSu, stgSpLim,
uniqOfNatM_State, deltaOfNatM_State,
getUniqLabelNCG, getNatLabelNCG,
- ncgPrimopMoan
+ ncgPrimopMoan,
+
+ -- Information about the target arch
+ ncg_target_is_32bit
) where
#include "HsVersions.h"
import IO ( hPutStrLn, stderr )
import AbsCSyn ( node, tagreg, MagicId(..) )
+import AbsCUtils ( magicIdPrimRep )
import ForeignCall ( CCallConv )
import CLabel ( mkAsmTempLabel, CLabel, pprCLabel )
import PrimRep ( PrimRep(..) )
-import MachOp ( MachOp(..), pprMachOp )
+import MachOp ( MachOp(..), pprMachOp, resultRepsOfMachOp )
import Unique ( Unique )
import SMRep ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize )
import UniqSupply ( UniqSupply, splitUniqSupply, uniqFromSupply,
UniqSM, thenUs, returnUs, getUniqueUs )
import Maybes ( Maybe012(..), maybe012ToList )
+import Constants ( wORD_SIZE )
import Outputable
import FastTypes
\end{code}
| StCall FAST_STRING CCallConv PrimRep [StixExpr]
+-- What's the PrimRep of the value denoted by this StixExpr?
+repOfStixExpr :: StixExpr -> PrimRep
+repOfStixExpr (StInt _) = IntRep
+repOfStixExpr (StFloat _) = FloatRep
+repOfStixExpr (StDouble _) = DoubleRep
+repOfStixExpr (StString _) = PtrRep
+repOfStixExpr (StCLbl _) = PtrRep
+repOfStixExpr (StReg reg) = repOfStixReg reg
+repOfStixExpr (StIndex _ _ _) = PtrRep
+repOfStixExpr (StInd rep _) = rep
+repOfStixExpr (StCall target conv retrep args) = retrep
+repOfStixExpr (StMachOp mop args)
+ = case resultRepsOfMachOp mop of
+ Just1 rep -> rep
+ other -> pprPanic "repOfStixExpr:StMachOp" (pprMachOp mop)
+
+
-- used by insnFuture in RegAllocInfo.lhs
data DestInfo
= NoDestInfo -- no supplied dests; infer from context
pprStixReg (StixMagicId mid) = ppMId mid
pprStixReg (StixTemp temp) = pprStixVReg temp
+repOfStixReg (StixTemp (StixVReg u pr)) = pr
+repOfStixReg (StixMagicId mid) = magicIdPrimRep mid
+
data StixVReg
= StixVReg Unique PrimRep
-pprStixVReg (StixVReg u pr) = hcat [text "VReg(", ppr u, ppr pr, char ')']
+pprStixVReg (StixVReg u pr) = hcat [text "VReg(", ppr u, colon, ppr pr, char ')']
`seq`
pprPanic msg pp_rep
\end{code}
+
+Information about the target.
+
+\begin{code}
+
+ncg_target_is_32bit :: Bool
+ncg_target_is_32bit | wORD_SIZE == 4 = True
+ | wORD_SIZE == 8 = False
+
+\end{code}
\ No newline at end of file
in (\xs -> assign_hp words : cjmp_hp :
assts (hp_alloc words : gc_d1 : join : xs))
+ HP_CHK_L1 ->
+ let [words] = args_stix
+ in (\xs -> assign_hp words : cjmp_hp :
+ assts (hp_alloc words : gc_l1 : join : xs))
+
HP_CHK_UT_ALT ->
let [words,ptrs,nonptrs,r,ret] = args_stix
in (\xs -> assign_hp words : cjmp_hp :
gc_unbx_r1 = mkStJump_to_GCentry_name "stg_gc_unbx_r1"
gc_f1 = mkStJump_to_GCentry_name "stg_gc_f1"
gc_d1 = mkStJump_to_GCentry_name "stg_gc_d1"
+gc_l1 = mkStJump_to_GCentry_name "stg_gc_l1"
gc_gen = mkStJump_to_GCentry_name "stg_gen_chk"
gc_ut (StInt p) (StInt np)
= mkStJump_to_GCentry_name ("stg_gc_ut_" ++ show p ++ "_" ++ show np)
import SMRep ( fixedHdrSize )
import Literal ( Literal(..), word2IntLit )
import MachOp ( MachOp(..) )
-import PrimRep ( PrimRep(..), getPrimRepSizeInBytes )
+import PrimRep ( PrimRep(..), getPrimRepArrayElemSize )
import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM )
import Constants ( wORD_SIZE,
mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE,
pk = case getAmodeRep lhs of
FloatRep -> FloatRep
DoubleRep -> DoubleRep
+ Int64Rep -> Int64Rep
+ Word64Rep -> Word64Rep
other -> IntRep
foreignCallCode lhs call rhs
mutArrPtrsFrozen_info = StCLbl mkMAP_FROZEN_infoLabel
-- these are the sizes of charLike and intLike closures, in _bytes_.
-charLikeSize = (fixedHdrSize + 1) * (sizeOf PtrRep)
-intLikeSize = (fixedHdrSize + 1) * (sizeOf PtrRep)
+charLikeSize = (fixedHdrSize + 1) * (getPrimRepArrayElemSize PtrRep)
+intLikeSize = (fixedHdrSize + 1) * (getPrimRepArrayElemSize PtrRep)
\end{code}
-- getPrimRepSizeInBytes, the rationale behind which is
-- unclear to me.
getPrimRepArrayElemSize :: PrimRep -> Int
+getPrimRepArrayElemSize CharRep = 4
+getPrimRepArrayElemSize DataPtrRep = wORD_SIZE
getPrimRepArrayElemSize PtrRep = wORD_SIZE
getPrimRepArrayElemSize IntRep = wORD_SIZE
getPrimRepArrayElemSize WordRep = wORD_SIZE
projects / ghc-hetmet.git / commitdiff