From 8480018a7f5f1cd961f3bd8ae758cc01910d5e6a Mon Sep 17 00:00:00 2001 From: "Ben.Lippmeier@anu.edu.au" Date: Mon, 12 Jan 2009 06:33:10 +0000 Subject: [PATCH] Fix some holes in the SPARC native code generator. This makes about half the tests in codeGen/should_run work. --- compiler/nativeGen/MachCodeGen.hs | 24 +++++++++++++++++++----- compiler/nativeGen/MachRegs.lhs | 25 ++++++++++++++++++++----- compiler/nativeGen/PprMach.hs | 21 ++++++++++++++------- 3 files changed, 53 insertions(+), 17 deletions(-) diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs index af8408a..e62a477 100644 --- a/compiler/nativeGen/MachCodeGen.hs +++ b/compiler/nativeGen/MachCodeGen.hs @@ -1393,24 +1393,38 @@ reg2reg size src dst #if sparc_TARGET_ARCH +-- getRegister :: CmmExpr -> NatM Register + +-- Load a literal float into a float register. +-- The actual literal is stored in a new data area, and we load it +-- at runtime. getRegister (CmmLit (CmmFloat f W32)) = do + + -- a label for the new data area lbl <- getNewLabelNat + tmp <- getNewRegNat II32 + let code dst = toOL [ + -- the data area LDATA ReadOnlyData [CmmDataLabel lbl, CmmStaticLit (CmmFloat f W32)], - SETHI (HI (ImmCLbl lbl)) dst, - LD FF32 (AddrRegImm dst (LO (ImmCLbl lbl))) dst] + + -- load the literal + SETHI (HI (ImmCLbl lbl)) tmp, + LD II32 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst] + return (Any FF32 code) getRegister (CmmLit (CmmFloat d W64)) = do lbl <- getNewLabelNat + tmp <- getNewRegNat II32 let code dst = toOL [ LDATA ReadOnlyData [CmmDataLabel lbl, CmmStaticLit (CmmFloat d W64)], - SETHI (HI (ImmCLbl lbl)) dst, - LD FF64 (AddrRegImm dst (LO (ImmCLbl lbl))) dst] + SETHI (HI (ImmCLbl lbl)) tmp, + LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst] return (Any FF64 code) getRegister (CmmMachOp mop [x]) -- unary MachOps @@ -2475,7 +2489,7 @@ assignReg_IntCode pk reg src = do r <- getRegister src return $ case r of Any _ code -> code dst - Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg dst) freg + Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg freg) dst where dst = getRegisterReg reg diff --git a/compiler/nativeGen/MachRegs.lhs b/compiler/nativeGen/MachRegs.lhs index b4af046..9c80423 100644 --- a/compiler/nativeGen/MachRegs.lhs +++ b/compiler/nativeGen/MachRegs.lhs @@ -195,9 +195,9 @@ data Size #if sparc_TARGET_ARCH /* || powerpc_TARGET_ARCH */ data Size = II8 -- byte (signed) - | II8u -- byte (unsigned) +-- | II8u -- byte (unsigned) | II16 -- halfword (signed, 2 bytes) - | II16u -- halfword (unsigned, 2 bytes) +-- | II16u -- halfword (unsigned, 2 bytes) | II32 -- word (4 bytes) | II64 -- word (8 bytes) | FF32 -- IEEE single-precision floating pt @@ -207,7 +207,8 @@ data Size intSize, floatSize :: Width -> Size intSize W8 = II8 -intSize W16 = II16u +--intSize W16 = II16u +intSize W16 = II16 intSize W32 = II32 intSize W64 = II64 intSize other = pprPanic "MachInstrs.intSize" (ppr other) @@ -232,9 +233,9 @@ sizeToWidth :: Size -> Width sizeToWidth size = case size of II8 -> W8 - II8u -> W8 +-- II8u -> W8 II16 -> W16 - II16u -> W16 +-- II16u -> W16 II32 -> W32 II64 -> W64 FF32 -> W32 @@ -1405,6 +1406,7 @@ freeReg rsp = fastBool False -- %rsp is the C stack pointer #if sparc_TARGET_ARCH freeReg g0 = fastBool False -- %g0 is always 0. + freeReg g5 = fastBool False -- %g5 is reserved (ABI). freeReg g6 = fastBool False -- %g6 is reserved (ABI). freeReg g7 = fastBool False -- %g7 is reserved (ABI). @@ -1414,6 +1416,19 @@ freeReg o6 = fastBool False -- %o6 is our stack pointer. freeReg o7 = fastBool False -- %o7 holds ret addrs (???) freeReg f0 = fastBool False -- %f0/%f1 are the C fp return registers. freeReg f1 = fastBool False + +-- TODO: Not sure about these BL 2009/01/10 +-- Used for NCG spill tmps? what is this? + +{- +freeReg g1 = fastBool False -- %g1 is used for NCG spill tmp +freeReg g2 = fastBool False +freeReg f6 = fastBool False +freeReg f8 = fastBool False +freeReg f26 = fastBool False +freeReg f27 = fastBool False +-} + #endif #if powerpc_TARGET_ARCH diff --git a/compiler/nativeGen/PprMach.hs b/compiler/nativeGen/PprMach.hs index 2d59cf4..24ba78f 100644 --- a/compiler/nativeGen/PprMach.hs +++ b/compiler/nativeGen/PprMach.hs @@ -354,7 +354,10 @@ pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r -- ----------------------------------------------------------------------------- --- pprSize: print a 'Size' +-- | print a 'Size' +-- Used for instruction suffixes. +-- eg LD is 32bit on sparc, but LDD is 64 bit. +-- #if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH pprSize :: Size -> Doc @@ -395,6 +398,7 @@ pprSize x = ptext (case x of II8 -> sLit "sb" II16 -> sLit "sh" II32 -> sLit "" + II64 -> sLit "d" FF32 -> sLit "" FF64 -> sLit "d" ) @@ -806,17 +810,18 @@ instance Outputable Instr where pprInstr :: Instr -> Doc ---pprInstr (COMMENT s) = empty -- nuke 'em +pprInstr (COMMENT s) = empty -- nuke 'em +{- pprInstr (COMMENT s) = IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s)) - ,IF_ARCH_sparc( ((<>) (ptext (sLit "! ")) (ftext s)) + ,IF_ARCH_sparc( ((<>) (ptext (sLit "# ")) (ftext s)) ,IF_ARCH_i386( ((<>) (ptext (sLit "# ")) (ftext s)) ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# ")) (ftext s)) ,IF_ARCH_powerpc( IF_OS_linux( ((<>) (ptext (sLit "# ")) (ftext s)), ((<>) (ptext (sLit "; ")) (ftext s))) ,))))) - +-} pprInstr (DELTA d) = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d))) @@ -1959,8 +1964,9 @@ pprInstr (ST size reg addr) ] pprInstr (ADD x cc reg1 ri reg2) - | not x && not cc && riZero ri - = hcat [ ptext (sLit "\tmov\t"), pprReg reg1, comma, pprReg reg2 ] +-- | not x && not cc && riZero ri +-- = hcat [ ptext (sLit "\tmov\t"), pprReg reg1, comma, pprReg reg2 ] + | otherwise = pprRegRIReg (if x then sLit "addx" else sLit "add") cc reg1 ri reg2 @@ -1976,11 +1982,12 @@ pprInstr (AND b reg1 ri reg2) = pprRegRIReg (sLit "and") b reg1 ri reg2 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg (sLit "andn") b reg1 ri reg2 pprInstr (OR b reg1 ri reg2) - | not b && reg1 == g0 +{- | not b && reg1 == g0 = let doit = hcat [ ptext (sLit "\tmov\t"), pprRI ri, comma, pprReg reg2 ] in case ri of RIReg rrr | rrr == reg2 -> empty other -> doit +-} | otherwise = pprRegRIReg (sLit "or") b reg1 ri reg2 -- 1.7.10.4