[project @ 2001-11-19 16:34:12 by simonpj]

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

diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index 0d39e9c..b72706e 100644 (file)
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -36,7 +36,7 @@ module MachMisc (
     ) where
 
 #include "HsVersions.h"
     ) where
 
 #include "HsVersions.h"

--- #include "config.h"
+#include "../includes/config.h"

 
 import AbsCSyn         ( MagicId(..) ) 
 import AbsCUtils       ( magicIdPrimRep )
 
 import AbsCSyn         ( MagicId(..) ) 
 import AbsCUtils       ( magicIdPrimRep )

@@ -50,23 +50,18 @@ import MachRegs             ( stgReg, callerSaves, RegLoc(..),
 #                         endif
                        )
 import PrimRep         ( PrimRep(..) )
 #                         endif
                        )
 import PrimRep         ( PrimRep(..) )

-import SMRep           ( SMRep(..) )
-import Stix            ( StixTree(..), StixReg(..), CodeSegment )
+import Stix            ( StixTree(..), StixReg(..), CodeSegment, DestInfo(..) )

 import Panic           ( panic )
 import Panic           ( panic )

-import Char            ( isDigit )

 import GlaExts         ( word2Int#, int2Word#, shiftRL#, and#, (/=#) )
 import GlaExts         ( word2Int#, int2Word#, shiftRL#, and#, (/=#) )

-import Outputable      ( text, pprPanic, ppr )
+import Outputable      ( pprPanic, ppr, showSDoc )

 import IOExts          ( trace )
 import IOExts          ( trace )

+import Config           ( cLeadingUnderscore )
+import FastTypes

 \end{code}
 
 \begin{code}
 underscorePrefix :: Bool   -- leading underscore on assembler labels?
 \end{code}
 
 \begin{code}
 underscorePrefix :: Bool   -- leading underscore on assembler labels?

-
-#ifdef LEADING_UNDERSCORE
-underscorePrefix = True
-#else
-underscorePrefix = False
-#endif
+underscorePrefix = (cLeadingUnderscore == "YES")

 
 ---------------------------
 fmtAsmLbl :: String -> String  -- for formatting labels
 
 ---------------------------
 fmtAsmLbl :: String -> String  -- for formatting labels

@@ -98,13 +93,11 @@ eXTRA_STK_ARGS_HERE
 Size of a @PrimRep@, in bytes.
 
 \begin{code}
 Size of a @PrimRep@, in bytes.
 
 \begin{code}

-sizeOf :: PrimRep -> Integer{-in bytes-}
-    -- the result is an Integer only because it's more convenient
-
-sizeOf pr = case (primRepToSize pr) of
-  IF_ARCH_alpha({B -> 1; BU -> 1; {-W -> 2; WU -> 2; L -> 4; SF -> 4;-} _ -> 8},)
-  IF_ARCH_sparc({B -> 1; BU -> 1; {-HW -> 2; HWU -> 2;-} W -> 4; {-D -> 8;-} F -> 4; DF -> 8},)
-  IF_ARCH_i386( {B -> 1; {-S -> 2;-} L -> 4; F -> 4; DF -> 8 },)
+sizeOf :: PrimRep -> Int{-in bytes-}
+sizeOf pr = case primRepToSize pr of
+  IF_ARCH_alpha({B->1; Bu->1; {-W->2; Wu->2;-} L->4; {-SF->4;-} Q->8; TF->8},)
+  IF_ARCH_i386 ({B->1; Bu->1; W->2; Wu->2; L->4; Lu->4; F->4; DF->8; F80->10},)
+  IF_ARCH_sparc({B->1; Bu->1; W->4; F->4; DF->8},)

 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

@@ -170,11 +163,11 @@ exactLog2 x
   = if (x <= 0 || x >= 2147483648) then
        Nothing
     else
   = if (x <= 0 || x >= 2147483648) then
        Nothing
     else

-       case (fromInteger x) of { I# x# ->
+       case iUnbox (fromInteger x) of { x# ->

        if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
          Nothing
        else
        if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
          Nothing
        else

-         Just (toInteger (I# (pow2 x#)))
+         Just (toInteger (iBox (pow2 x#)))

        }
   where
     shiftr x y = shiftRL# x y
        }
   where
     shiftr x y = shiftRL# x y

@@ -238,10 +231,10 @@ data Cond
 data Size
 #if alpha_TARGET_ARCH
     = B            -- byte
 data Size
 #if alpha_TARGET_ARCH
     = B            -- byte

-    | BU
+    | Bu

 --  | W            -- word (2 bytes): UNUSED
 --  | W            -- word (2 bytes): UNUSED

---  | WU    -- : UNUSED
---  | L            -- longword (4 bytes): UNUSED
+--  | Wu    -- : UNUSED
+    | L            -- longword (4 bytes)

     | Q            -- quadword (8 bytes)
 --  | FF    -- VAX F-style floating pt: UNUSED
 --  | GF    -- VAX G-style floating pt: UNUSED
     | Q            -- quadword (8 bytes)
 --  | FF    -- VAX F-style floating pt: UNUSED
 --  | GF    -- VAX G-style floating pt: UNUSED

@@ -250,47 +243,66 @@ data Size
     | TF    -- IEEE double-precision floating pt
 #endif
 #if i386_TARGET_ARCH
     | TF    -- IEEE double-precision floating pt
 #endif
 #if i386_TARGET_ARCH

-    = B            -- byte (lower)
---  | HB    -- higher byte **UNUSED**
---  | S            -- : UNUSED
-    | L
+    = B            -- byte (signed)
+    | Bu    -- byte (unsigned)
+    | W     -- word (signed)
+    | Wu    -- word (unsigned)
+    | L     -- longword (signed)
+    | Lu    -- longword (unsigned)

     | F            -- IEEE single-precision floating pt
     | DF    -- IEEE single-precision floating pt
     | F80   -- Intel 80-bit internal FP format; only used for spilling
 #endif
 #if sparc_TARGET_ARCH
     = B     -- byte (signed)
     | F            -- IEEE single-precision floating pt
     | DF    -- IEEE single-precision floating pt
     | F80   -- Intel 80-bit internal FP format; only used for spilling
 #endif
 #if sparc_TARGET_ARCH
     = B     -- byte (signed)

-    | BU    -- byte (unsigned)
---  | HW    -- halfword, 2 bytes (signed): UNUSED
---  | HWU   -- halfword, 2 bytes (unsigned): UNUSED
-    | W            -- word, 4 bytes
---  | D            -- doubleword, 8 bytes: UNUSED
+    | Bu    -- byte (unsigned)
+    | W            -- word (4 bytes)

     | F            -- IEEE single-precision floating pt
     | DF    -- IEEE single-precision floating pt
 #endif
 
 primRepToSize :: PrimRep -> Size
 
     | F            -- IEEE single-precision floating pt
     | DF    -- IEEE single-precision floating pt
 #endif
 
 primRepToSize :: PrimRep -> Size
 

-primRepToSize PtrRep       = IF_ARCH_alpha( Q,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize CodePtrRep    = IF_ARCH_alpha( Q,         IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize DataPtrRep    = IF_ARCH_alpha( Q,         IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize RetRep       = IF_ARCH_alpha( Q,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize CostCentreRep = IF_ARCH_alpha( Q,         IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize CharRep      = IF_ARCH_alpha( BU, IF_ARCH_i386( B, IF_ARCH_sparc( BU,)))
-primRepToSize IntRep       = IF_ARCH_alpha( Q,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize WordRep      = IF_ARCH_alpha( Q,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize AddrRep      = IF_ARCH_alpha( Q,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize FloatRep     = IF_ARCH_alpha( TF, IF_ARCH_i386( F, IF_ARCH_sparc( F ,)))
-primRepToSize DoubleRep            = IF_ARCH_alpha( TF, IF_ARCH_i386( DF,IF_ARCH_sparc( DF,)))
-primRepToSize ArrayRep     = IF_ARCH_alpha( Q,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize ByteArrayRep  = IF_ARCH_alpha( Q,         IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize WeakPtrRep    = IF_ARCH_alpha( Q,         IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize ForeignObjRep = IF_ARCH_alpha( Q,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize StablePtrRep  = IF_ARCH_alpha( Q,         IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize ThreadIdRep   = IF_ARCH_alpha( Q,         IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
--- SUP: Wrong!!! Only for testing the rest of the NCG
-primRepToSize Word64Rep     = trace "primRepToSize: Word64Rep not handled" B
-primRepToSize Int64Rep      = trace "primRepToSize: Int64Rep not handled"  B
+primRepToSize PtrRep       = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize CodePtrRep    = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize DataPtrRep    = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize RetRep       = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize CostCentreRep = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize CharRep      = IF_ARCH_alpha(L,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+
+primRepToSize Int8Rep      = IF_ARCH_alpha(B,  IF_ARCH_i386(B,  IF_ARCH_sparc(B,  )))
+primRepToSize Int16Rep     = IF_ARCH_alpha(err,IF_ARCH_i386(W,  IF_ARCH_sparc(err,)))
+    where err = primRepToSize_fail "Int16Rep"
+primRepToSize Int32Rep     = IF_ARCH_alpha(L,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize Word8Rep     = IF_ARCH_alpha(Bu, IF_ARCH_i386(Bu, IF_ARCH_sparc(Bu, )))
+primRepToSize Word16Rep            = IF_ARCH_alpha(err,IF_ARCH_i386(Wu, IF_ARCH_sparc(err,)))
+    where err = primRepToSize_fail "Word16Rep"
+primRepToSize Word32Rep            = IF_ARCH_alpha(L,  IF_ARCH_i386(Lu, IF_ARCH_sparc(W,  )))
+
+primRepToSize IntRep       = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize WordRep      = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize AddrRep      = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize FloatRep     = IF_ARCH_alpha(TF, IF_ARCH_i386(F,  IF_ARCH_sparc(F,  )))
+primRepToSize DoubleRep            = IF_ARCH_alpha(TF, IF_ARCH_i386(DF, IF_ARCH_sparc(DF, )))
+primRepToSize ArrayRep     = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize ByteArrayRep  = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize PrimPtrRep    = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize WeakPtrRep    = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize ForeignObjRep = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize BCORep        = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize StablePtrRep  = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+primRepToSize ThreadIdRep   = IF_ARCH_alpha(Q,  IF_ARCH_i386(L,  IF_ARCH_sparc(W,  )))
+
+primRepToSize Word64Rep     = primRepToSize_fail "Word64Rep"
+primRepToSize Int64Rep      = primRepToSize_fail "Int64Rep"
+primRepToSize other         = primRepToSize_fail (showSDoc (ppr other))
+
+primRepToSize_fail str
+   = error ("ERROR: MachMisc.primRepToSize: cannot handle `" ++ str ++ "'.\n\t" 
+            ++ "Workaround: use -fvia-C.\n\t" 
+            ++ "Perhaps you should report it as a GHC bug,\n\t" 
+            ++ "to glasgow-haskell-bugs@haskell.org.")
+

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -436,6 +448,15 @@ We might as well make use of whatever unique FP facilities Intel have
 chosen to bless us with (let's not be churlish, after all).
 Hence GLDZ and GLD1.  Bwahahahahahahaha!
 
 chosen to bless us with (let's not be churlish, after all).
 Hence GLDZ and GLD1.  Bwahahahahahahaha!
 

+LATER (10 Nov 2000): idiv gives problems with the register spiller,
+because the spiller is simpleminded and because idiv has fixed uses of
+%eax and %edx.  Rather than make the spiller cleverer, we do away with
+idiv, and instead have iquot and irem fake (integer) insns, which have
+no operand register constraints -- ie, they behave like add, sub, mul.
+The printer-outer transforms them to a sequence of real insns which does
+the Right Thing (tm).  As with the FP stuff, this gives ropey code, 
+but we don't care, since it doesn't get used much.  We hope.
+

 \begin{code}
 #if i386_TARGET_ARCH
 
 \begin{code}
 #if i386_TARGET_ARCH
 

@@ -455,12 +476,14 @@ Hence GLDZ and GLD1.  Bwahahahahahahaha!
 
              | ADD           Size Operand Operand
              | SUB           Size Operand Operand
 
              | ADD           Size Operand Operand
              | SUB           Size Operand Operand

+             | IMUL          Size Operand Operand

 
 

--- Multiplication (signed and unsigned), Division (signed and unsigned),
--- result in %eax, %edx.
+-- Quotient and remainder.  SEE comment above -- these are not
+-- real x86 insns; instead they are expanded when printed
+-- into a sequence of real insns.

 
 

-             | IMUL          Size Operand Operand
-             | IDIV          Size Operand
+              | IQUOT         Size Operand Operand
+              | IREM          Size Operand Operand

 
 -- Simple bit-twiddling.
 
 
 -- Simple bit-twiddling.
 

@@ -529,7 +552,7 @@ Hence GLDZ and GLD1.  Bwahahahahahahaha!
 
 -- Jumping around.
 
 
 -- Jumping around.
 

-             | JMP           Operand -- target
+             | JMP           DestInfo Operand -- possible dests, target

              | JXX           Cond CLabel -- target
              | CALL          Imm
 
              | JXX           Cond CLabel -- target
              | CALL          Imm
 

@@ -552,10 +575,14 @@ i386_insert_ffrees insns
 
 ffree_before_nonlocal_transfers insn
    = case insn of
 
 ffree_before_nonlocal_transfers insn
    = case insn of

-        CALL _                                      -> [GFREE, insn]
-        JMP (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> [insn]
-        JMP _                                       -> [GFREE, insn]
-        other                                       -> [insn]
+        CALL _                                        -> [GFREE, insn]
+        -- Jumps to immediate labels are local
+        JMP _ (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> [insn]
+        -- If a jump mentions dests, it is a local jump thru
+        -- a case table.
+        JMP (DestInfo _) _                            -> [insn]
+        JMP _ _                                       -> [GFREE, insn]
+        other                                         -> [insn]

 
 
 -- if you ever add a new FP insn to the fake x86 FP insn set,
 
 
 -- if you ever add a new FP insn to the fake x86 FP insn set,

@@ -629,7 +656,7 @@ is_G_instr instr
              | BI            Cond Bool Imm -- cond, annul?, target
              | BF            Cond Bool Imm -- cond, annul?, target
 
              | BI            Cond Bool Imm -- cond, annul?, target
              | BF            Cond Bool Imm -- cond, annul?, target
 

-             | JMP           MachRegsAddr      -- target
+             | JMP           DestInfo MachRegsAddr      -- target

              | CALL          Imm Int Bool -- target, args, terminal
 
 data RI = RIReg Reg
              | CALL          Imm Int Bool -- target, args, terminal
 
 data RI = RIReg Reg