[project @ 2001-02-12 12:25:50 by simonmar]

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

diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index 37dcd39..f7538bb 100644 (file)
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -31,12 +31,12 @@ module MachMisc (
 #if i386_TARGET_ARCH
 #endif
 #if sparc_TARGET_ARCH
 #if i386_TARGET_ARCH
 #endif
 #if sparc_TARGET_ARCH

-       RI(..), riZero
+       RI(..), riZero, fpRelEA, moveSp, fPair

 #endif
     ) where
 
 #include "HsVersions.h"
 #endif
     ) where
 
 #include "HsVersions.h"

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

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

@@ -45,15 +45,17 @@ import Literal              ( mkMachInt, Literal(..) )
 import MachRegs                ( stgReg, callerSaves, RegLoc(..),
                          Imm(..), Reg(..), 
                          MachRegsAddr(..)
 import MachRegs                ( stgReg, callerSaves, RegLoc(..),
                          Imm(..), Reg(..), 
                          MachRegsAddr(..)

+#                         if sparc_TARGET_ARCH
+                          ,fp, sp
+#                         endif

                        )
 import PrimRep         ( PrimRep(..) )
                        )
 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 )
+import Outputable      ( pprPanic, ppr )

 import IOExts          ( trace )
 import IOExts          ( trace )

+import FastTypes

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

@@ -99,9 +101,9 @@ sizeOf :: PrimRep -> Integer{-in bytes-}
     -- the result is an Integer only because it's more convenient
 
 sizeOf pr = case (primRepToSize pr) of
     -- 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 },)
+  IF_ARCH_alpha({B -> 1; BU -> 1; {-W -> 2; WU -> 2;-} L -> 4; {-SF -> 4;-} _ -> 8},)
+  IF_ARCH_sparc({B -> 1; BU -> 1; W -> 4; F -> 4; DF -> 8},)
+  IF_ARCH_i386( {B -> 1; BU -> 1; L -> 4; F -> 4; DF -> 8 },)

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

@@ -167,11 +169,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,7 +240,7 @@ data Size
     | BU
 --  | W            -- word (2 bytes): UNUSED
 --  | WU    -- : UNUSED
     | BU
 --  | W            -- word (2 bytes): UNUSED
 --  | WU    -- : UNUSED

---  | L            -- longword (4 bytes): 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

@@ -247,10 +249,9 @@ 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, JRS:??lower??)
+    | BU    -- byte, unsigned
+    | L     -- word32

     | F            -- IEEE single-precision floating pt
     | DF    -- IEEE single-precision floating pt
     | F80   -- Intel 80-bit internal FP format; only used for spilling
     | F            -- IEEE single-precision floating pt
     | DF    -- IEEE single-precision floating pt
     | F80   -- Intel 80-bit internal FP format; only used for spilling

@@ -258,10 +259,7 @@ data Size
 #if sparc_TARGET_ARCH
     = B     -- byte (signed)
     | BU    -- byte (unsigned)
 #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
     | W            -- word, 4 bytes

---  | D            -- doubleword, 8 bytes: UNUSED

     | F            -- IEEE single-precision floating pt
     | DF    -- IEEE single-precision floating pt
 #endif
     | F            -- IEEE single-precision floating pt
     | DF    -- IEEE single-precision floating pt
 #endif

@@ -273,7 +271,11 @@ primRepToSize CodePtrRep    = IF_ARCH_alpha( Q,     IF_ARCH_i386( L, IF_ARCH_sparc(
 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 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 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 Word8Rep     = IF_ARCH_alpha( BU, IF_ARCH_i386( BU, 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 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 ,)))

@@ -281,8 +283,10 @@ primRepToSize FloatRep         = IF_ARCH_alpha( TF, IF_ARCH_i386( F, IF_ARCH_sparc(
 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 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 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 ,)))
 -- SUP: Wrong!!! Only for testing the rest of the NCG
 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

@@ -433,6 +437,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
 

@@ -452,12 +465,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.
 

@@ -526,7 +541,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
 

@@ -549,10 +564,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,

@@ -626,7 +645,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

@@ -636,8 +655,24 @@ riZero :: RI -> Bool
 
 riZero (RIImm (ImmInt 0))          = True
 riZero (RIImm (ImmInteger 0))      = True
 
 riZero (RIImm (ImmInt 0))          = True
 riZero (RIImm (ImmInteger 0))      = True

-riZero (RIReg (FixedReg ILIT(0)))   = True
+riZero (RIReg (RealReg 0))          = True

 riZero _                           = False
 
 riZero _                           = False
 

+-- Calculate the effective address which would be used by the
+-- corresponding fpRel sequence.  fpRel is in MachRegs.lhs,
+-- alas -- can't have fpRelEA here because of module dependencies.
+fpRelEA :: Int -> Reg -> Instr
+fpRelEA n dst
+   = ADD False False fp (RIImm (ImmInt (n * BYTES_PER_WORD))) dst
+
+-- Code to shift the stack pointer by n words.
+moveSp :: Int -> Instr
+moveSp n
+   = ADD False False sp (RIImm (ImmInt (n * BYTES_PER_WORD))) sp
+
+-- Produce the second-half-of-a-double register given the first half.
+fPair :: Reg -> Reg
+fPair (RealReg n) | n >= 32 && n `mod` 2 == 0  = RealReg (n+1)
+fPair other = pprPanic "fPair(sparc NCG)" (ppr other)

 #endif {- sparc_TARGET_ARCH -}
 \end{code}
 #endif {- sparc_TARGET_ARCH -}
 \end{code}