[project @ 2001-01-09 17:43:57 by rrt]

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

diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index f647768..613b413 100644 (file)
--- a/ghc/compiler/nativeGen/PprMach.lhs
+++ b/ghc/compiler/nativeGen/PprMach.lhs
@@ -386,6 +386,13 @@ pprInstr (SEGMENT DataSegment)
        ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
        ,)))
 
+pprInstr (SEGMENT RoDataSegment)
+    = ptext
+        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(SLIT(".section .rodata\n\t.align 4")
+       ,)))
+
 pprInstr (LABEL clab)
   = let
        pp_lab = pprCLabel_asm clab
@@ -408,31 +415,14 @@ pprInstr (ASCII False{-no backslash conversion-} str)
   = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
 
 pprInstr (ASCII True str)
-#if 0
-  -- The Solaris assembler doesn't understand \x escapes in
-  -- strings.
-  = asciify str
-  where
-    asciify :: String -> SDoc
-    asciify "" = text "\t.ascii \"\\0\""
-    asciify str
-       = let fst  = take 16 str
-             rest = drop 16 str
-             this = text ("\t.ascii \"" 
-                          ++ concat (map asciify_char fst)
-                          ++ "\"")
-         in  this $$ asciify rest
-    asciify_char :: Char -> String
-    asciify_char c = '\\' : 'x' : hshow (ord c)
-#endif
   = vcat (map do1 (str ++ [chr 0]))
     where
        do1 :: Char -> SDoc
-       do1 c = text "\t.byte\t0x" <> text (hshow (ord c))
+       do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
 
-       hshow :: Int -> String
+       hshow :: Int -> SDoc
        hshow n | n >= 0 && n <= 255
-               = [ tab !! (n `div` 16), tab !! (n `mod` 16)]
+               = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16))
        tab = "0123456789ABCDEF"
 
 
@@ -445,24 +435,24 @@ pprInstr (DATA s xs)
 #endif
 #if sparc_TARGET_ARCH
         -- copy n paste of x86 version
-       ppr_item B  x = [text "\t.byte\t" <> pprImm x]
-       ppr_item W  x = [text "\t.long\t" <> pprImm x]
+       ppr_item B  x = [ptext SLIT("\t.byte\t") <> pprImm x]
+       ppr_item W  x = [ptext SLIT("\t.long\t") <> pprImm x]
        ppr_item F  (ImmFloat r)
            = let bs = floatToBytes (fromRational r)
-             in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
+             in  map (\b -> ptext SLIT("\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
+             in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 #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 B  x = [ptext SLIT("\t.byte\t") <> pprImm x]
+       ppr_item L  x = [ptext SLIT("\t.long\t") <> pprImm x]
        ppr_item F  (ImmFloat r)
            = let bs = floatToBytes (fromRational r)
-             in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
+             in  map (\b -> ptext SLIT("\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
+             in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 #endif
 
         -- floatToBytes and doubleToBytes convert to the host's byte
@@ -931,7 +921,6 @@ pprInstr (ADD size src dst)
   = pprSizeOpOp SLIT("add") size src dst
 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
-pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
 
 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
 pprInstr (OR  size src dst) = pprSizeOpOp SLIT("or")  size src dst
@@ -962,6 +951,8 @@ pprInstr (JMP dsts (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
 pprInstr (JMP dsts op)          = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
 pprInstr (CALL imm)             = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
 
+pprInstr (IQUOT sz src dst) = pprInstr_quotRem True sz src dst
+pprInstr (IREM  sz src dst) = pprInstr_quotRem False sz src dst
 
 -- Simulating a flat register set on the x86 FP stack is tricky.
 -- you have to free %st(7) before pushing anything on the FP reg stack
@@ -1099,6 +1090,24 @@ pprInstr GFREE
             ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)") 
           ]
 
+
+pprInstr_quotRem isQuot sz src dst
+   | case sz of L -> False; _ -> True
+   = panic "pprInstr_quotRem: dunno how to do non-32bit operands"
+   | otherwise
+   = vcat [
+     (text "\t# BEGIN " <> fakeInsn),
+     (text "\tpushl $0;  pushl %eax;  pushl %edx;  pushl " <> pprOperand sz src),
+     (text "\tmovl " <> pprOperand sz dst <> text ",%eax;  xorl %edx,%edx;  cltd"),
+     (text "\tdivl 0(%esp);  movl " <> text resReg <> text ",12(%esp)"),
+     (text "\tpopl %edx;  popl %edx;  popl %eax;  popl " <> pprOperand sz dst),
+     (text "\t# END   " <> fakeInsn)
+     ]
+     where
+        resReg = if isQuot then "%eax" else "%edx"
+        opStr  = if isQuot then "IQUOT" else "IREM"
+        fakeInsn = text opStr <+> pprOperand sz src <> char ',' <+> pprOperand sz dst
+
 --------------------------
 
 -- coerce %st(0) to the specified size