[project @ 2000-01-18 13:29:35 by sewardj]

Don't spew floating/double literals into assembly output, since this
causes difficulties with FP numbers near the edges of the allowed
ranges.  Instead, convert them to a sequence of bytes and emit those.

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 77792bf..17922ee 100644 (file)
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -69,7 +69,7 @@ stmt2Instrs stmt = case stmt of
        getData :: StixTree -> UniqSM (InstrBlock, Imm)
 
        getData (StInt i)    = returnUs (id, ImmInteger i)
-       getData (StDouble d) = returnUs (id, dblImmLit d)
+       getData (StDouble d) = returnUs (id, ImmDouble d)
        getData (StLitLbl s) = returnUs (id, ImmLab s)
        getData (StCLbl l)   = returnUs (id, ImmCLbl l)
        getData (StString s) =
@@ -499,7 +499,7 @@ getRegister (StDouble d)
     let code dst = mkSeqInstrs [
            SEGMENT DataSegment,
            LABEL lbl,
-           DATA DF [dblImmLit d],
+           DATA DF [ImmDouble d],
            SEGMENT TextSegment,
            FLD DF (OpImm (ImmCLbl lbl))
            ]
@@ -911,7 +911,7 @@ getRegister (StDouble d)
     let code dst = mkSeqInstrs [
            SEGMENT DataSegment,
            LABEL lbl,
-           DATA DF [dblImmLit d],
+           DATA DF [ImmDouble d],
            SEGMENT TextSegment,
            SETHI (HI (ImmCLbl lbl)) tmp,
            LD DF (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]

diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs
index bf0b939..f5e02cb 100644 (file)
--- a/ghc/compiler/nativeGen/MachRegs.lhs
+++ b/ghc/compiler/nativeGen/MachRegs.lhs
@@ -25,7 +25,6 @@ module MachRegs (
        baseRegOffset,
        callClobberedRegs,
        callerSaves,
-       dblImmLit,
        extractMappedRegNos,
        freeMappedRegs,
        freeReg, freeRegs,
@@ -83,17 +82,12 @@ data Imm
   | ImmLab     SDoc    -- Simple string label (underscore-able)
   | ImmLit     SDoc    -- Simple string
   | ImmIndex    CLabel Int
+  | ImmDouble  Rational
   IF_ARCH_sparc(
   | LO Imm                 -- Possible restrictions...
   | HI Imm
   ,)
 strImmLit s = ImmLit (text s)
-dblImmLit r
-  = strImmLit (
-        IF_ARCH_alpha({-prepend nothing-}
-       ,IF_ARCH_i386( '0' : 'd' :
-       ,IF_ARCH_sparc('0' : 'r' :,)))
-       showSDoc (rational r))
 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index 3e8bde0..a46ad7e 100644 (file)
--- a/ghc/compiler/nativeGen/PprMach.lhs
+++ b/ghc/compiler/nativeGen/PprMach.lhs
@@ -20,9 +20,13 @@ import MachMisc
 import CLabel          ( pprCLabel_asm, externallyVisibleCLabel )
 import CStrings                ( charToC )
 import Maybes          ( maybeToBool )
-import Stix            ( CodeSegment(..) )
+import Stix            ( CodeSegment(..), StixTree(..) )
 import Char            ( isPrint, isDigit )
 import Outputable
+
+import ST
+import MutableArray
+import Char            ( ord )
 \end{code}
 
 %************************************************************************
@@ -403,10 +407,6 @@ pprInstr (SEGMENT TextSegment)
        ,IF_ARCH_i386((_PK_ ".text\n\t.align 4") {-needs per-OS variation!-}
        ,)))
 
-#if 0
-       ,IF_ARCH_i386((_PK_ ".text\n\t.align 2\x2c\&0x90") {-needs per-OS variation!-}
-#endif
-
 pprInstr (SEGMENT DataSegment)
     = ptext
         IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
@@ -414,10 +414,6 @@ pprInstr (SEGMENT DataSegment)
        ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
        ,)))
 
-#if 0
-       ,IF_ARCH_i386(SLIT(".data\n\t.align 2")
-#endif
-
 pprInstr (LABEL clab)
   = let
        pp_lab = pprCLabel_asm clab
@@ -454,6 +450,7 @@ pprInstr (ASCII True str)
       | isDigit d = (<>) (text (charToC c)) (asciify cs 0)
       | otherwise = (<>) (text (charToC c)) (asciify cs (n-1))
 
+#if 0
 pprInstr (DATA s xs)
   = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
   where
@@ -461,20 +458,11 @@ pprInstr (DATA s xs)
 #if alpha_TARGET_ARCH
            B  -> SLIT("\t.byte\t")
            BU -> SLIT("\t.byte\t")
---UNUSED:   W  -> SLIT("\t.word\t")
---UNUSED:   WU -> SLIT("\t.word\t")
---UNUSED:   L  -> SLIT("\t.long\t")
            Q  -> SLIT("\t.quad\t")
---UNUSED:   FF -> SLIT("\t.f_floating\t")
---UNUSED:   DF -> SLIT("\t.d_floating\t")
---UNUSED:   GF -> SLIT("\t.g_floating\t")
---UNUSED:   SF -> SLIT("\t.s_floating\t")
            TF -> SLIT("\t.t_floating\t")
 #endif
 #if i386_TARGET_ARCH
            B  -> SLIT("\t.byte\t")
---UNUSED:   HB -> SLIT("\t.byte\t")
---UNUSED:   S  -> SLIT("\t.word\t")
            L  -> SLIT("\t.long\t")
            F  -> SLIT("\t.float\t")
            DF -> SLIT("\t.double\t")
@@ -485,6 +473,65 @@ pprInstr (DATA s xs)
            W  -> SLIT("\t.word\t")
            DF -> SLIT("\t.double\t")
 #endif
+#endif
+
+
+pprInstr (DATA s xs)
+  = vcat (concatMap (ppr_item s) xs)
+    where
+#if alpha_TARGET_ARCH
+            This needs to be fixed.
+           B  -> SLIT("\t.byte\t")
+           BU -> SLIT("\t.byte\t")
+           Q  -> SLIT("\t.quad\t")
+           TF -> SLIT("\t.t_floating\t")
+#endif
+#if i386_TARGET_ARCH
+       ppr_item B  x = [text "\t.byte\t" <> pprImm x]
+       ppr_item L  x = [text "\t.long\t" <> pprImm x]
+       ppr_item F  (ImmDouble r)
+           = let bs = floatToBytes (fromRational r)
+             in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
+       ppr_item DF (ImmDouble r)
+           = let bs = doubleToBytes (fromRational r)
+             in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
+
+        floatToBytes :: Float -> [Int]
+        floatToBytes f
+           = runST (do
+                arr <- newFloatArray ((0::Int),3)
+                writeFloatArray arr 0 f
+                i0 <- readCharArray arr 0
+                i1 <- readCharArray arr 1
+                i2 <- readCharArray arr 2
+                i3 <- readCharArray arr 3
+                return (map ord [i0,i1,i2,i3])
+             )
+
+        doubleToBytes :: Double -> [Int]
+        doubleToBytes d
+           = runST (do
+                arr <- newDoubleArray ((0::Int),7)
+                writeDoubleArray arr 0 d
+                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])
+             )
+
+#endif
+#if sparc_TARGET_ARCH
+            This needs to be fixed.
+           B  -> SLIT("\t.byte\t")
+           BU -> SLIT("\t.byte\t")
+           W  -> SLIT("\t.word\t")
+           DF -> SLIT("\t.double\t")
+#endif
 
 -- fall through to rest of (machine-specific) pprInstr...
 \end{code}

diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs
index ea39abe..5eb0362 100644 (file)
--- a/ghc/compiler/nativeGen/Stix.lhs
+++ b/ghc/compiler/nativeGen/Stix.lhs
@@ -20,7 +20,7 @@ import Ratio          ( Rational )
 import AbsCSyn         ( node, tagreg, MagicId(..) )
 import AbsCUtils       ( magicIdPrimRep )
 import CallConv                ( CallConv, pprCallConv )
-import CLabel          ( mkAsmTempLabel, CLabel, pprCLabel )
+import CLabel          ( mkAsmTempLabel, CLabel, pprCLabel, pprCLabel_asm )
 import PrimRep          ( PrimRep, showPrimRep )
 import PrimOp           ( PrimOp, pprPrimOp )
 import Unique           ( Unique )