projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2002-01-29 13:22:28 by sewardj]
[ghc-hetmet.git] / ghc / compiler / nativeGen / MachMisc.lhs
diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index a98eb16..c29aee4 100644 (file)
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -8,7 +8,7 @@
 
 module MachMisc (
 
 
 module MachMisc (
 
-       sizeOf, primRepToSize,
+       primRepToSize,
 
        eXTRA_STK_ARGS_HERE,
 
 
        eXTRA_STK_ARGS_HERE,
 
@@ -36,36 +36,35 @@ module MachMisc (
     ) where
 
 #include "HsVersions.h"
     ) where
 
 #include "HsVersions.h"
--- #include "config.h"
+#include "../includes/config.h"
 
 import AbsCSyn         ( MagicId(..) ) 
 import AbsCUtils       ( magicIdPrimRep )
 import CLabel           ( CLabel, isAsmTemp )
 import Literal         ( mkMachInt, Literal(..) )
 
 import AbsCSyn         ( MagicId(..) ) 
 import AbsCUtils       ( magicIdPrimRep )
 import CLabel           ( CLabel, isAsmTemp )
 import Literal         ( mkMachInt, Literal(..) )
-import MachRegs                ( stgReg, callerSaves, RegLoc(..),
-                         Imm(..), Reg(..), 
-                         MachRegsAddr(..)
+import MachRegs                ( callerSaves,
+                          get_MagicId_addr, get_MagicId_reg_or_addr,
+                         Imm(..), Reg(..), MachRegsAddr(..)
 #                         if sparc_TARGET_ARCH
                           ,fp, sp
 #                         endif
                        )
 import PrimRep         ( PrimRep(..) )
 #                         if sparc_TARGET_ARCH
                           ,fp, sp
 #                         endif
                        )
 import PrimRep         ( PrimRep(..) )
-import Stix            ( StixTree(..), StixReg(..), CodeSegment, DestInfo(..) )
+import Stix            ( StixStmt(..), StixExpr(..), StixReg(..), 
+                          CodeSegment, DestInfo(..) )
 import Panic           ( panic )
 import Panic           ( panic )
-import GlaExts         ( word2Int#, int2Word#, shiftRL#, and#, (/=#) )
-import Outputable      ( pprPanic, ppr )
+import GlaExts
+import Outputable      ( pprPanic, ppr, showSDoc )
 import IOExts          ( trace )
 import IOExts          ( trace )
+import Config           ( cLeadingUnderscore )
 import FastTypes
 import FastTypes
+
+import Maybe           ( catMaybes )
 \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
@@ -94,20 +93,6 @@ eXTRA_STK_ARGS_HERE
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
-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 },)
-\end{code}
-
-% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
 Now the volatile saves and restores.  We add the basic guys to the
 list of ``user'' registers provided.  Note that there are more basic
 registers on the restore list, because some are reloaded from
 Now the volatile saves and restores.  We add the basic guys to the
 list of ``user'' registers provided.  Note that there are more basic
 registers on the restore list, because some are reloaded from
@@ -116,30 +101,47 @@ constants.
 (@volatileRestores@ used only for wrapper-hungry PrimOps.)
 
 \begin{code}
 (@volatileRestores@ used only for wrapper-hungry PrimOps.)
 
 \begin{code}
-volatileSaves, volatileRestores :: [MagicId] -> [StixTree]
+volatileSaves, volatileRestores :: [MagicId] -> [StixStmt]
+
+volatileSaves    = volatileSavesOrRestores True
+volatileRestores = volatileSavesOrRestores False
 
 save_cands    = [BaseReg,Sp,Su,SpLim,Hp,HpLim]
 restore_cands = save_cands
 
 
 save_cands    = [BaseReg,Sp,Su,SpLim,Hp,HpLim]
 restore_cands = save_cands
 
-volatileSaves vols
-  = map save ((filter callerSaves) (save_cands ++ vols))
-  where
-    save x = StAssign (magicIdPrimRep x) loc reg
-      where
-       reg = StReg (StixMagicId x)
-       loc = case stgReg x of
-               Save loc -> loc
-               Always _ -> panic "volatileSaves"
-
-volatileRestores vols
-  = map restore ((filter callerSaves) (restore_cands ++ vols))
-  where
-    restore x = StAssign (magicIdPrimRep x) reg loc
-      where
-       reg = StReg (StixMagicId x)
-       loc = case stgReg x of
-               Save loc -> loc
-               Always _ -> panic "volatileRestores"
+volatileSavesOrRestores do_saves vols
+   = catMaybes (map mkCode vols)
+     where
+        mkCode mid
+           | case mid of { BaseReg -> True; _ -> False } 
+           = panic "volatileSavesOrRestores:BaseReg" 
+           | not (callerSaves mid)
+           = Nothing
+           | otherwise -- must be callee-saves ...
+           = case get_MagicId_reg_or_addr mid of
+                -- If stored in BaseReg, we ain't interested
+                Right baseRegAddr 
+                   -> Nothing
+                Left (RealReg rrno)
+                   -- OK, it's callee-saves, and in a real reg (rrno).
+                   -- We have to cook up some transfer code.
+                   {- Note that the use of (StixMagicId mid) here is a bit subtle.  
+                      Here, we only create those for MagicIds which are stored in 
+                      a real reg on this arch -- the preceding case on the result 
+                      of get_MagicId_reg_or_addr guarantees this.  Later, when 
+                      selecting insns, that means these assignments are sure to turn 
+                      into real reg-to-mem or mem-to-reg moves, rather than being 
+                      pointless moves from some address in the reg-table 
+                      back to itself.-}
+                   |  do_saves
+                   -> Just (StAssignMem rep addr 
+                                            (StReg (StixMagicId mid)))
+                   |  otherwise
+                   -> Just (StAssignReg rep (StixMagicId mid)
+                                            (StInd rep addr))
+                      where
+                         rep  = magicIdPrimRep mid
+                         addr = get_MagicId_addr mid
 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -176,10 +178,8 @@ exactLog2 x
          Just (toInteger (iBox (pow2 x#)))
        }
   where
          Just (toInteger (iBox (pow2 x#)))
        }
   where
-    shiftr x y = shiftRL# x y
-
     pow2 x# | x# ==# 1# = 0#
     pow2 x# | x# ==# 1# = 0#
-            | otherwise = 1# +# pow2 (w2i (i2w x# `shiftr` 1#))
+            | otherwise = 1# +# pow2 (w2i (i2w x# `shiftRL#` 1#))
 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -212,6 +212,8 @@ data Cond
   | NE
   | NEG
   | POS
   | NE
   | NEG
   | POS
+  | CARRY
+  | OFLO
 #endif
 #if sparc_TARGET_ARCH
   = ALWAYS     -- What's really used? ToDo
 #endif
 #if sparc_TARGET_ARCH
   = ALWAYS     -- What's really used? ToDo
@@ -231,15 +233,16 @@ data Cond
   | VC
   | VS
 #endif
   | VC
   | VS
 #endif
+    deriving Eq  -- to make an assertion work
 \end{code}
 
 \begin{code}
 data Size
 #if alpha_TARGET_ARCH
     = B            -- byte
 \end{code}
 
 \begin{code}
 data Size
 #if alpha_TARGET_ARCH
     = B            -- byte
-    | BU
+    | Bu
 --  | W            -- word (2 bytes): UNUSED
 --  | W            -- word (2 bytes): UNUSED
---  | WU    -- : UNUSED
+--  | Wu    -- : UNUSED
     | L            -- longword (4 bytes)
     | Q            -- quadword (8 bytes)
 --  | FF    -- VAX F-style floating pt: UNUSED
     | L            -- longword (4 bytes)
     | Q            -- quadword (8 bytes)
 --  | FF    -- VAX F-style floating pt: UNUSED
@@ -249,50 +252,69 @@ 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)
+    | H     -- halfword (signed, 2 bytes)
+    | Hu    -- halfword (unsigned, 2 bytes)
+    | 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( L,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize Int8Rep      = IF_ARCH_alpha( B,  IF_ARCH_i386( B, IF_ARCH_sparc( B ,)))
-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 ,)))
--- 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(H,  )))
+    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(Hu, )))
+    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 StableNameRep = 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}
 
 %************************************************************************
@@ -438,6 +460,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
 
@@ -457,12 +488,19 @@ 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      -- signed int mul
+             | MUL           Size Operand Operand      -- unsigned int mul
+              | IMUL64       Reg Reg                   -- 32 x 32 -> 64 signed mul
+               -- operand1:operand2 := (operand1[31:0] *signed operand2[31:0])
 
 
--- 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     -- signed quotient
+              | IREM          Size Operand Operand     -- signed remainder
+              | QUOT          Size Operand Operand     -- unsigned quotient
+              | REM           Size Operand Operand     -- unsigned remainder
 
 -- Simple bit-twiddling.
 
 
 -- Simple bit-twiddling.
 
@@ -492,10 +530,7 @@ Hence GLDZ and GLD1.  Bwahahahahahahaha!
               | GLDZ          Reg -- dst(fpreg)
               | GLD1          Reg -- dst(fpreg)
 
               | GLDZ          Reg -- dst(fpreg)
               | GLD1          Reg -- dst(fpreg)
 
-             | GFTOD         Reg Reg -- src(fpreg), dst(fpreg)
               | GFTOI         Reg Reg -- src(fpreg), dst(intreg)
               | GFTOI         Reg Reg -- src(fpreg), dst(intreg)
-
-             | GDTOF         Reg Reg -- src(fpreg), dst(fpreg)
               | GDTOI         Reg Reg -- src(fpreg), dst(intreg)
 
               | GITOF         Reg Reg -- src(intreg), dst(fpreg)
               | GDTOI         Reg Reg -- src(fpreg), dst(intreg)
 
               | GITOF         Reg Reg -- src(intreg), dst(fpreg)
@@ -506,7 +541,11 @@ Hence GLDZ and GLD1.  Bwahahahahahahaha!
              | GSUB          Size Reg Reg Reg -- src1, src2, dst
              | GMUL          Size Reg Reg Reg -- src1, src2, dst
 
              | GSUB          Size Reg Reg Reg -- src1, src2, dst
              | GMUL          Size Reg Reg Reg -- src1, src2, dst
 
-             | GCMP          Size Reg Reg -- src1, src2
+               -- FP compare.  Cond must be `elem` [EQQ, NE, LE, LTT, GE, GTT]
+               -- Compare src1 with src2; set the Zero flag iff the numbers are
+               -- comparable and the comparison is True.  Subsequent code must
+               -- test the %eflags zero flag regardless of the supplied Cond.
+             | GCMP          Cond Reg Reg -- src1, src2
 
              | GABS          Size Reg Reg -- src, dst
              | GNEG          Size Reg Reg -- src, dst
 
              | GABS          Size Reg Reg -- src, dst
              | GNEG          Size Reg Reg -- src, dst
@@ -533,7 +572,7 @@ Hence GLDZ and GLD1.  Bwahahahahahahaha!
 
              | JMP           DestInfo Operand -- possible dests, target
              | JXX           Cond CLabel -- target
 
              | JMP           DestInfo Operand -- possible dests, target
              | JXX           Cond CLabel -- target
-             | CALL          Imm
+             | CALL          (Either Imm Reg)
 
 -- Other things.
 
 
 -- Other things.
 
@@ -571,8 +610,7 @@ is_G_instr instr
    = case instr of
         GMOV _ _ -> True; GLD _ _ _ -> True; GST _ _ _ -> True;
         GLDZ _ -> True; GLD1 _ -> True;
    = case instr of
         GMOV _ _ -> True; GLD _ _ _ -> True; GST _ _ _ -> True;
         GLDZ _ -> True; GLD1 _ -> True;
-        GFTOD _ _ -> True; GFTOI _ _ -> True;
-        GDTOF _ _ -> True; GDTOI _ _ -> True;
+        GFTOI _ _ -> True; GDTOI _ _ -> True;
         GITOF _ _ -> True; GITOD _ _ -> True;
        GADD _ _ _ _ -> True; GDIV _ _ _ _ -> True
        GSUB _ _ _ _ -> True; GMUL _ _ _ _ -> True
         GITOF _ _ -> True; GITOD _ _ -> True;
        GADD _ _ _ _ -> True; GDIV _ _ _ _ -> True
        GSUB _ _ _ _ -> True; GMUL _ _ _ _ -> True
@@ -599,6 +637,9 @@ is_G_instr instr
 
              | ADD           Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
              | SUB           Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
 
              | ADD           Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
              | SUB           Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
+             | UMUL               Bool Reg RI Reg --     cc?, src1, src2, dst
+             | SMUL               Bool Reg RI Reg --     cc?, src1, src2, dst
+              | RDY           Reg      -- move contents of Y register to reg
 
 -- Simple bit-twiddling.
 
 
 -- Simple bit-twiddling.
 
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)