Fix some holes in the SPARC native code generator.

This makes about half the tests in codeGen/should_run work.

diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index af8408a..e62a477 100644 (file)
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -1393,24 +1393,38 @@ reg2reg size src dst
 
 #if sparc_TARGET_ARCH
 
 
 #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
 getRegister (CmmLit (CmmFloat f W32)) = do

+
+    -- a label for the new data area

     lbl <- getNewLabelNat
     lbl <- getNewLabelNat

+    tmp <- getNewRegNat II32
+

     let code dst = toOL [
     let code dst = toOL [

+            -- the data area         

            LDATA ReadOnlyData
                        [CmmDataLabel lbl,
                         CmmStaticLit (CmmFloat f W32)],
            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
     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)],
     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
     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
     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
 
     where
       dst = getRegisterReg reg
 

diff --git a/compiler/nativeGen/MachRegs.lhs b/compiler/nativeGen/MachRegs.lhs
index b4af046..9c80423 100644 (file)
--- 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)
 #if sparc_TARGET_ARCH /* || powerpc_TARGET_ARCH */
 data Size
     = II8     -- byte (signed)

-    | II8u    -- byte (unsigned)
+--    | II8u    -- byte (unsigned)

     | II16    -- halfword (signed, 2 bytes)
     | 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
     | 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, 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)
 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
 sizeToWidth size
  = case size of
        II8             -> W8

-       II8u            -> W8
+--     II8u            -> W8

        II16            -> W16
        II16            -> W16

-       II16u           -> W16
+--     II16u           -> W16

        II32            -> W32
        II64            -> W64
        FF32            -> W32
        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.
 
 #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).
 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
 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
 #endif
 
 #if powerpc_TARGET_ARCH

diff --git a/compiler/nativeGen/PprMach.hs b/compiler/nativeGen/PprMach.hs
index 2d59cf4..24ba78f 100644 (file)
--- 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
 
 #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 ""
        II8   -> sLit "sb"
         II16  -> sLit "sh"
        II32  -> sLit ""

+       II64  -> sLit "d"

        FF32  -> sLit ""
        FF64  -> sLit "d"
     )
        FF32  -> sLit ""
        FF64  -> sLit "d"
     )

@@ -806,17 +810,18 @@ instance Outputable Instr where
 
 pprInstr :: Instr -> Doc
 
 
 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))
 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)))
      ,)))))
      ,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)))
 
 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)
     ]
 
 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
 
   | 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)
 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
   = 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
 
   | otherwise
   = pprRegRIReg (sLit "or") b reg1 ri reg2