[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.

4 files changed, 70 insertions, 29 deletions

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 77792bfbd5..17922ee4bd 100644
--- 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 bf0b939d23..f5e02cb854 100644
--- 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 3e8bde036f..a46ad7ebf8 100644
--- 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 ea39abe177..5eb0362ddc 100644
--- 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 )