disable .type directives on Windows; they confuse mingw's assembler
[ghc-hetmet.git] / compiler / nativeGen / PprMach.hs
index 5016726..ba8a5d9 100644 (file)
@@ -646,9 +646,9 @@ pprSectionHeader RelocatableReadOnlyData
         IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
        ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
        ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n.align 2"),
-                                   SLIT(".section .rodata\n\t.align 4"))
+                                   SLIT(".section .data\n\t.align 4"))
        ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const_data\n.align 3"),
-                                     SLIT(".section .rodata\n\t.align 8"))
+                                     SLIT(".section .data\n\t.align 8"))
         ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
                                       SLIT(".data\n\t.align 2"))
        ,)))))
@@ -692,8 +692,18 @@ pprGloblDecl lbl
                                    SLIT(".globl ")) <>
                pprCLabel_asm lbl
 
+pprTypeAndSizeDecl :: CLabel -> Doc
+pprTypeAndSizeDecl lbl
+#if mingw32_TARGET_OS
+  = empty
+#else
+  | not (externallyVisibleCLabel lbl) = empty
+  | otherwise = ptext SLIT(".type ") <>
+               pprCLabel_asm lbl <> ptext SLIT(", @object")
+#endif
+
 pprLabel :: CLabel -> Doc
-pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':')
+pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
 
 
 pprASCII str
@@ -760,7 +770,8 @@ pprDataItem lit
        -- Fortunately we're assuming the small memory model, in which
        -- all such offsets will fit into 32 bits, so we have to stick
        -- to 32-bit offset fields and modify the RTS appropriately
-       -- (see InfoTables.h).
+        --
+        -- See Note [x86-64-relative] in includes/InfoTables.h
        -- 
        ppr_item I64  x 
           | isRelativeReloc x =
@@ -769,7 +780,6 @@ pprDataItem lit
           | otherwise =
                [ptext SLIT("\t.quad\t") <> pprImm imm]
           where
-               isRelativeReloc (CmmLabelOff _ _)       = True
                isRelativeReloc (CmmLabelDiffOff _ _ _) = True
                isRelativeReloc _ = False
 #endif
@@ -1291,6 +1301,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 +1318,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
@@ -2393,41 +2405,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
+castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
+castFloatToWord8Array = castSTUArray
 
-writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
-writeDoubleArray = writeArray
-
-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 
@@ -2440,29 +2422,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])
      )