[project @ 2000-01-13 17:01:16 by sewardj]

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

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index fde05dd..d59a3f5 100644 (file)
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -64,7 +64,7 @@ stmt2Instrs stmt = case stmt of
     StData kind args
       -> mapAndUnzipUs getData args    `thenUs` \ (codes, imms) ->
         returnUs (\xs -> mkSeqList (asmInstr (DATA (primRepToSize kind) imms))
-                                   (foldr1 (.) codes xs))
+                                   (foldr (.) id codes xs))
       where
        getData :: StixTree -> UniqSM (InstrBlock, Imm)
 
@@ -298,7 +298,6 @@ getRegister (StDouble d)
 getRegister (StPrim primop [x]) -- unary PrimOps
   = case primop of
       IntNegOp -> trivialUCode (NEG Q False) x
-      IntAbsOp -> trivialUCode (ABS Q) x
 
       NotOp    -> trivialUCode NOT x
 
@@ -316,7 +315,7 @@ getRegister (StPrim primop [x]) -- unary PrimOps
       Double2FloatOp -> coerceFltCode x
       Float2DoubleOp -> coerceFltCode x
 
-      other_op -> getRegister (StCall fn cconv DoubleRep [x])
+      other_op -> getRegister (StCall fn cCallConv DoubleRep [x])
        where
          fn = case other_op of
                 FloatExpOp    -> SLIT("exp")
@@ -536,7 +535,6 @@ getRegister (StDouble d)
 getRegister (StPrim primop [x]) -- unary PrimOps
   = case primop of
       IntNegOp  -> trivialUCode (NEGI L) x
-      IntAbsOp  -> absIntCode x
 
       NotOp    -> trivialUCode (NOT L) x
 
@@ -757,7 +755,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
                          mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2)) (OpReg dst))
        in
        returnUs (Any IntRep code__2)
-
+{-
     add_code sz x (StInd _ mem)
       = getRegister x          `thenUs` \ register1 ->
        --getNewRegNCG (registerRep register1)
@@ -767,7 +765,6 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
            code2 = amodeCode amode
            src2  = amodeAddr amode
 
---         fixedname  = registerName register1 eax
            code__2 dst = let code1 = registerCode register1 dst
                              src1  = registerName register1 dst
                          in asmParThen [code2 asmVoid,code1 asmVoid] .
@@ -788,7 +785,6 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
            code1 = amodeCode amode
            src1  = amodeAddr amode
 
---         fixedname  = registerName register2 eax
            code__2 dst = let code2 = registerCode register2 dst
                              src2  = registerName register2 dst
                          in asmParThen [code1 asmVoid,code2 asmVoid] .
@@ -799,7 +795,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
                                    mkSeqInstrs [ADD sz (OpAddr src1) (OpReg src2)]
        in
        returnUs (Any IntRep code__2)
-
+-}
     add_code sz x y
       = getRegister x          `thenUs` \ register1 ->
        getRegister y           `thenUs` \ register2 ->
@@ -951,7 +947,6 @@ getRegister (StDouble d)
 getRegister (StPrim primop [x]) -- unary PrimOps
   = case primop of
       IntNegOp -> trivialUCode (SUB False False g0) x
-      IntAbsOp -> absIntCode x
       NotOp    -> trivialUCode (XNOR False g0) x
 
       FloatNegOp  -> trivialUFCode FloatRep (FNEG F) x
@@ -2786,7 +2781,6 @@ trivialCode instr x y
   = getRegister x              `thenUs` \ register1 ->
     --getNewRegNCG IntRep      `thenUs` \ tmp1 ->
     let
---     fixedname  = registerName register1 eax
        code__2 dst = let code1 = registerCode register1 dst
                          src1  = registerName register1 dst
                      in code1 .
@@ -2806,7 +2800,6 @@ trivialCode instr x y
   = getRegister y              `thenUs` \ register1 ->
     --getNewRegNCG IntRep      `thenUs` \ tmp1 ->
     let
---     fixedname  = registerName register1 eax
        code__2 dst = let code1 = registerCode register1 dst
                          src1  = registerName register1 dst
                      in code1 .
@@ -2820,13 +2813,12 @@ trivialCode instr x y
   where
     imm = maybeImm x
     imm__2 = case imm of Just x -> x
-
+{-
 trivialCode instr x (StInd pk mem)
   = getRegister x              `thenUs` \ register ->
     --getNewRegNCG IntRep      `thenUs` \ tmp ->
     getAmode mem               `thenUs` \ amode ->
     let
---     fixedname  = registerName register eax
        code2 = amodeCode amode asmVoid
        src2  = amodeAddr amode
        code__2 dst = let code1 = registerCode register dst asmVoid
@@ -2845,7 +2837,6 @@ trivialCode instr (StInd pk mem) y
     --getNewRegNCG IntRep      `thenUs` \ tmp ->
     getAmode mem               `thenUs` \ amode ->
     let
---     fixedname  = registerName register eax
        code2 = amodeCode amode asmVoid
        src2  = amodeAddr amode
        code__2 dst = let
@@ -2859,14 +2850,13 @@ trivialCode instr (StInd pk mem) y
                                mkSeqInstr (instr (OpAddr src2) (OpReg src1))
     in
     returnUs (Any pk code__2)
-
+-}
 trivialCode instr x y
   = getRegister x              `thenUs` \ register1 ->
     getRegister y              `thenUs` \ register2 ->
     --getNewRegNCG IntRep      `thenUs` \ tmp1 ->
     getNewRegNCG IntRep                `thenUs` \ tmp2 ->
     let
---     fixedname  = registerName register1 eax
        code2 = registerCode register2 tmp2 asmVoid
        src2  = registerName register2 tmp2
        code__2 dst = let
@@ -2886,7 +2876,6 @@ trivialUCode instr x
   = getRegister x              `thenUs` \ register ->
 --    getNewRegNCG IntRep      `thenUs` \ tmp ->
     let
---     fixedname = registerName register eax
        code__2 dst = let
                          code = registerCode register dst
                          src  = registerName register dst
@@ -3241,7 +3230,6 @@ chrCode x
   = getRegister x              `thenUs` \ register ->
     --getNewRegNCG IntRep      `thenUs` \ reg ->
     let
---     fixedname = registerName register eax
        code__2 dst = let
                          code = registerCode register dst
                          src  = registerName register dst
@@ -3285,69 +3273,3 @@ chrCode x
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
-
-%************************************************************************
-%*                                                                     *
-\subsubsection{Absolute value on integers}
-%*                                                                     *
-%************************************************************************
-
-Absolute value on integers, mostly for gmp size check macros.  Again,
-the argument cannot be an StInt, because genericOpt already folded
-constants.
-
-If applicable, do not fill the delay slots here; you will confuse the
-register allocator.
-
-\begin{code}
-absIntCode :: StixTree -> UniqSM Register
-
-#if alpha_TARGET_ARCH
-absIntCode = panic "MachCode.absIntCode: not on Alphas"
-#endif {- alpha_TARGET_ARCH -}
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if i386_TARGET_ARCH
-
-absIntCode x
-  = getRegister x              `thenUs` \ register ->
-    --getNewRegNCG IntRep      `thenUs` \ reg ->
-    getUniqLabelNCG            `thenUs` \ lbl ->
-    let
-       code__2 dst = let code = registerCode register dst
-                         src  = registerName register dst
-                     in code . if isFixed register && dst /= src
-                               then mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
-                                                 TEST L (OpReg dst) (OpReg dst),
-                                                 JXX GE lbl,
-                                                 NEGI L (OpReg dst),
-                                                 LABEL lbl]
-                               else mkSeqInstrs [TEST L (OpReg src) (OpReg src),
-                                                 JXX GE lbl,
-                                                 NEGI L (OpReg src),
-                                                 LABEL lbl]
-    in
-    returnUs (Any IntRep code__2)
-
-#endif {- i386_TARGET_ARCH -}
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if sparc_TARGET_ARCH
-
-absIntCode x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ reg ->
-    getUniqLabelNCG            `thenUs` \ lbl ->
-    let
-       code = registerCode register reg
-       src  = registerName register reg
-       code__2 dst = code . mkSeqInstrs [
-           SUB False True g0 (RIReg src) dst,
-           BI GE False (ImmCLbl lbl), NOP,
-           OR False g0 (RIReg src) dst,
-           LABEL lbl]
-    in
-    returnUs (Any IntRep code__2)
-
-#endif {- sparc_TARGET_ARCH -}
-\end{code}
-