Fix truncate on amd64 NCG; fixes arith005.

[ghc-hetmet.git] / compiler / nativeGen / PprMach.hs

diff --git a/compiler/nativeGen/PprMach.hs b/compiler/nativeGen/PprMach.hs
index 6965bbf..3e2161e 100644 (file)
--- a/compiler/nativeGen/PprMach.hs
+++ b/compiler/nativeGen/PprMach.hs
@@ -1291,6 +1291,8 @@ pprInstr (JXX cond (BlockId id))
   = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
   where lab = mkAsmTempLabel id
 
+pprInstr (JXX_GBL cond imm) = pprCondInstr SLIT("j") cond (pprImm imm)
+
 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
 pprInstr (JMP op)          = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
 pprInstr (JMP_TBL op ids)  = pprInstr (JMP op)
@@ -1306,12 +1308,12 @@ pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
 
 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
 
-pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
-pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
-pprInstr (CVTSS2SI from to) = pprOpReg  SLIT("cvtss2siq") from to
-pprInstr (CVTSD2SI from to) = pprOpReg  SLIT("cvtsd2siq") from to
-pprInstr (CVTSI2SS from to) = pprOpReg  SLIT("cvtsi2ssq") from to
-pprInstr (CVTSI2SD from to) = pprOpReg  SLIT("cvtsi2sdq") from to
+pprInstr (CVTSS2SD from to)   = pprRegReg SLIT("cvtss2sd") from to
+pprInstr (CVTSD2SS from to)   = pprRegReg SLIT("cvtsd2ss") from to
+pprInstr (CVTTSS2SIQ from to) = pprOpReg  SLIT("cvttss2siq") from to
+pprInstr (CVTTSD2SIQ from to) = pprOpReg  SLIT("cvttsd2siq") from to
+pprInstr (CVTSI2SS from to)   = pprOpReg  SLIT("cvtsi2ssq") from to
+pprInstr (CVTSI2SD from to)   = pprOpReg  SLIT("cvtsi2sdq") from to
 #endif
 
     -- FETCHGOT for PIC on ELF platforms
@@ -2162,6 +2164,19 @@ pprInstr (BCC cond (BlockId id)) = hcat [
     ]
     where lbl = mkAsmTempLabel id
 
+pprInstr (BCCFAR cond (BlockId id)) = vcat [
+        hcat [
+            ptext SLIT("\tb"),
+            pprCond (condNegate cond),
+            ptext SLIT("\t$+8")
+        ],
+        hcat [
+            ptext SLIT("\tb\t"),
+            pprCLabel_asm lbl
+        ]
+    ]
+    where lbl = mkAsmTempLabel id
+
 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
        char '\t',
        ptext SLIT("b"),
@@ -2380,41 +2395,11 @@ limitShiftRI x = x
 -- -----------------------------------------------------------------------------
 -- Converting floating-point literals to integrals for printing
 
-#if __GLASGOW_HASKELL__ >= 504
-newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
-newFloatArray = newArray_
-
-newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
-newDoubleArray = newArray_
-
-castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
-castFloatToCharArray = castSTUArray
-
-castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
-castDoubleToCharArray = castSTUArray
-
-writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
-writeFloatArray = writeArray
-
-writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
-writeDoubleArray = writeArray
+castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
+castFloatToWord8Array = castSTUArray
 
-readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
-readCharArray arr i = do 
-  w <- readArray arr i
-  return $! (chr (fromIntegral w))
-
-#else
-
-castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
-castFloatToCharArray = return
-
-castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
-
-
-castDoubleToCharArray = return
-
-#endif
+castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
+castDoubleToWord8Array = castSTUArray
 
 -- floatToBytes and doubleToBytes convert to the host's byte
 -- order.  Providing that we're not cross-compiling for a 
@@ -2427,29 +2412,29 @@ castDoubleToCharArray = return
 floatToBytes :: Float -> [Int]
 floatToBytes f
    = runST (do
-        arr <- newFloatArray ((0::Int),3)
-        writeFloatArray arr 0 f
-       arr <- castFloatToCharArray arr
-        i0 <- readCharArray arr 0
-        i1 <- readCharArray arr 1
-        i2 <- readCharArray arr 2
-        i3 <- readCharArray arr 3
-        return (map ord [i0,i1,i2,i3])
+        arr <- newArray_ ((0::Int),3)
+        writeArray arr 0 f
+        arr <- castFloatToWord8Array arr
+        i0 <- readArray arr 0
+        i1 <- readArray arr 1
+        i2 <- readArray arr 2
+        i3 <- readArray arr 3
+        return (map fromIntegral [i0,i1,i2,i3])
      )
 
 doubleToBytes :: Double -> [Int]
 doubleToBytes d
    = runST (do
-        arr <- newDoubleArray ((0::Int),7)
-        writeDoubleArray arr 0 d
-       arr <- castDoubleToCharArray arr
-        i0 <- readCharArray arr 0
-        i1 <- readCharArray arr 1
-        i2 <- readCharArray arr 2
-        i3 <- readCharArray arr 3
-        i4 <- readCharArray arr 4
-        i5 <- readCharArray arr 5
-        i6 <- readCharArray arr 6
-        i7 <- readCharArray arr 7
-        return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
+        arr <- newArray_ ((0::Int),7)
+        writeArray arr 0 d
+        arr <- castDoubleToWord8Array arr
+        i0 <- readArray arr 0
+        i1 <- readArray arr 1
+        i2 <- readArray arr 2
+        i3 <- readArray arr 3
+        i4 <- readArray arr 4
+        i5 <- readArray arr 5
+        i6 <- readArray arr 6
+        i7 <- readArray arr 7
+        return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])
      )