Commit 0d1a15fd authored by sewardj's avatar sewardj
Browse files

[project @ 2001-12-10 18:04:51 by sewardj]

Add just enough infrastructure to the NCG that it can deal with simple 64-bit
code on 32-bit platforms.  Main changes are:

* Addition of a simple 64-bit instruction selection fn iselExpr64 to MachCode.
  This generates code for a 64-bit value and places the results into two
  virtual registers, related thusly:

* Add a new type VRegUnique, which is used to label Stix virtual registers.
  This type used to be a plain Unique, but that forces the assumption that
  each Abstract-C level C temporary corresponds to exactly one Stix virtual
  register, which is untrue when the C temporary is 64-bit sized on a
  32-bit machine.  In the new scheme, the Unique for the C temporary can
  turn into two related VRegUniques, related by having the same embedded
  unique.

* Made a start on 'target metrics' by adding ncg_target_is_32bits to the
  end of Stix.lhs.

* Cleaned up numerous other gruesomenesses in the NCG which never came
  to light before now.   Got rid of MachMisc.sizeOf, which doesn't make
  sense in a 64-bit setting, and replaced it by calls to
  PrimRep.getPrimRepArrayElemSize, which, as far as I'm concerned, is the
  definitive answer to the questio `How Big Is This PrimRep Really?'

Result: on x86-linux, at least, you can now compile the Entire Prelude
with -fasm!  At this stage I cannot claim that the resulting code is
correct, but it's a start.
parent 9428b42b
......@@ -33,7 +33,8 @@ import Literal ( Literal(..), word2IntLit )
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 )
......@@ -237,8 +238,8 @@ Here we handle top-level things, like @CCodeBlock@s and
-- 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
......@@ -346,14 +347,23 @@ of the source? Be careful about floats/doubles.
\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}
......
......@@ -36,6 +36,8 @@ import MachMisc ( IF_ARCH_i386(i386_insert_ffrees,) )
import qualified Pretty
import Outputable
-- DEBUGGING ONLY
--import OrdList
\end{code}
The 96/03 native-code generator has machine-independent and
......@@ -241,12 +243,18 @@ stixStmt_ConFold stmt
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
......
......@@ -271,7 +271,7 @@ spill slot numbers for the uniques.
insertSpillCode :: [Instr] -> [Instr]
insertSpillCode insns
= let uniques_in_insns
= map getUnique
= map getVRegUnique
(regSetToList
(foldl unionRegSets emptyRegSet
(map vregs_in_insn insns)))
......@@ -279,7 +279,7 @@ insertSpillCode 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..])
......@@ -297,7 +297,7 @@ insertSpillCode insns
-- 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
......@@ -330,13 +330,15 @@ patchInstr vreg_to_slot_map (delta,ctr) instr
| 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)
......
......@@ -14,6 +14,7 @@ module MachCode ( stmtsToInstrs, InstrBlock ) where
#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,
......@@ -27,25 +28,27 @@ import CLabel ( CLabel, labelDynamic )
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}
......@@ -92,9 +95,13 @@ stmtToInstrs stmt = case stmt of
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
......@@ -119,7 +126,7 @@ stmtToInstrs stmt = case stmt of
-- 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).
......@@ -172,7 +179,7 @@ mangleIndexTree :: StixExpr -> StixExpr
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 [
......@@ -182,7 +189,7 @@ mangleIndexTree (StIndex pk base off)
]
where
shift :: PrimRep -> Int
shift rep = case sizeOf rep of
shift rep = case getPrimRepArrayElemSize rep of
1 -> 0
2 -> 1
4 -> 2
......@@ -197,7 +204,7 @@ maybeImm :: StixExpr -> Maybe Imm
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))
......@@ -207,6 +214,132 @@ maybeImm (StInt i)
maybeImm _ = Nothing
\end{code}
%************************************************************************
%* *
\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}
......@@ -292,6 +425,7 @@ getRegister tree@(StIndex _ _ _)
= 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
......@@ -895,6 +1029,7 @@ getRegister (StMachOp mop [x, y]) -- dyadic MachOps
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
......@@ -1477,6 +1612,8 @@ getCondCode (StMachOp mop [x, y])
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}
......@@ -2407,7 +2544,7 @@ genCCall fn cconv kind args
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#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),
......@@ -2419,8 +2556,8 @@ genCCall fn cconv kind [StInt i]
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
......@@ -2462,14 +2599,25 @@ genCCall fn cconv kind args
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`
......@@ -2484,6 +2632,9 @@ genCCall fn cconv kind args
PUSH L (OpReg reg) `snocOL`
DELTA (delta-size)
)
where
arg_rep = repOfStixExpr arg
------------
get_op
:: StixExpr
......
......@@ -8,7 +8,7 @@
module MachMisc (
sizeOf, primRepToSize,
primRepToSize,
eXTRA_STK_ARGS_HERE,
......@@ -93,18 +93,6 @@ 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
......
......@@ -15,7 +15,8 @@ modules --- the pleasure has been foregone.)
module MachRegs (
RegClass(..), regClass,
Reg(..), isRealReg, isVirtualReg,
VRegUnique(..), pprVRegUnique, getHiVRegFromLo,
Reg(..), isRealReg, isVirtualReg, getVRegUnique,
allocatableRegs, argRegs, allArgRegs, callClobberedRegs,
Imm(..),
......@@ -248,6 +249,26 @@ Virtual regs can be of either class, so that info is attached.
\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
......@@ -256,22 +277,29 @@ data RegClass
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
......@@ -314,19 +342,13 @@ instance Ord Reg where
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: **
......
......@@ -51,8 +51,8 @@ pprReg :: IF_ARCH_i386(Size ->,) Reg -> Doc
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
......
......@@ -683,7 +683,7 @@ patchRegs instr env = case instr of
JXX _ _ -> instr
CALL _ -> instr
CLTD -> instr
_ -> pprPanic "patchInstr(x86)" empty
_ -> pprPanic "patchRegs(x86)" empty
where
patch1 insn op = insn (patchOp op)
......@@ -753,9 +753,8 @@ patchRegs instr env = case instr of
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
......@@ -775,18 +774,18 @@ spillSlotToOffset slot
= 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 (?)-}
......@@ -811,7 +810,7 @@ spillReg vreg_to_slot_map delta dyn vreg
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)))
......
......@@ -8,7 +8,7 @@ module Stix (
StixStmt(..), mkStAssign, StixStmtList,
pprStixStmts, pprStixStmt, pprStixExpr, pprStixReg,
stixStmt_CountTempUses, stixStmt_Subst,
liftStrings,
liftStrings, repOfStixExpr,
DestInfo(..), hasDestInfo,
stgBaseReg, stgNode, stgSp, stgSu, stgSpLim,
......@@ -24,7 +24,10 @@ module Stix (
uniqOfNatM_State, deltaOfNatM_State,
getUniqLabelNCG, getNatLabelNCG,
ncgPrimopMoan
ncgPrimopMoan,
-- Information about the target arch
ncg_target_is_32bit
) where
#include "HsVersions.h"
......@@ -34,15 +37,17 @@ import IOExts ( unsafePerformIO )
import IO ( hPutStrLn, stderr )
import AbsCSyn ( node, tagreg, MagicId(..) )