projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1999-03-01 17:41:50 by simonm]
[ghc-hetmet.git]
/
ghc
/
compiler
/
nativeGen
/
MachCode.lhs
diff --git
a/ghc/compiler/nativeGen/MachCode.lhs
b/ghc/compiler/nativeGen/MachCode.lhs
index
1495416
..
cbfe9dc
100644
(file)
--- a/
ghc/compiler/nativeGen/MachCode.lhs
+++ b/
ghc/compiler/nativeGen/MachCode.lhs
@@
-1,5
+1,5
@@
%
%
-% (c) The AQUA Project, Glasgow University, 1996
+% (c) The AQUA Project, Glasgow University, 1996-1998
%
\section[MachCode]{Generating machine code}
%
\section[MachCode]{Generating machine code}
@@
-24,7
+24,7
@@
import CLabel ( isAsmTemp, CLabel )
import Maybes ( maybeToBool, expectJust )
import OrdList -- quite a bit of it
import PrimRep ( isFloatingRep, PrimRep(..) )
import Maybes ( maybeToBool, expectJust )
import OrdList -- quite a bit of it
import PrimRep ( isFloatingRep, PrimRep(..) )
-import PrimOp ( PrimOp(..), showPrimOp )
+import PrimOp ( PrimOp(..) )
import CallConv ( cCallConv )
import Stix ( getUniqLabelNCG, StixTree(..),
StixReg(..), CodeSegment(..)
import CallConv ( cCallConv )
import Stix ( getUniqLabelNCG, StixTree(..),
StixReg(..), CodeSegment(..)
@@
-78,6
+78,9
@@
stmt2Instrs stmt = case stmt of
returnUs (mkSeqInstrs [LABEL lbl,
ASCII True (_UNPK_ s)],
ImmCLbl lbl)
returnUs (mkSeqInstrs [LABEL lbl,
ASCII True (_UNPK_ s)],
ImmCLbl lbl)
+ -- the linker can handle simple arithmetic...
+ getData (StIndex rep (StCLbl lbl) (StInt off)) =
+ returnUs (id, ImmIndex lbl (fromInteger (off * sizeOf rep)))
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-158,6
+161,9
@@
maybeImm (StLitLbl s) = Just (ImmLab s)
maybeImm (StLitLit s) = Just (strImmLit (cvtLitLit (_UNPK_ s)))
maybeImm (StCLbl l) = Just (ImmCLbl l)
maybeImm (StLitLit s) = Just (strImmLit (cvtLitLit (_UNPK_ s)))
maybeImm (StCLbl l) = Just (ImmCLbl l)
+maybeImm (StIndex rep (StCLbl l) (StInt off)) =
+ Just (ImmIndex l (fromInteger (off * sizeOf rep)))
+
maybeImm (StInt i)
| i >= toInteger minInt && i <= toInteger maxInt
= Just (ImmInt (fromInteger i))
maybeImm (StInt i)
| i >= toInteger minInt && i <= toInteger maxInt
= Just (ImmInt (fromInteger i))
@@
-310,7
+316,7
@@
getRegister (StPrim primop [x]) -- unary PrimOps
Double2FloatOp -> coerceFltCode x
Float2DoubleOp -> coerceFltCode x
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")
where
fn = case other_op of
FloatExpOp -> SLIT("exp")
@@
-751,7
+757,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)
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)
add_code sz x (StInd _ mem)
= getRegister x `thenUs` \ register1 ->
--getNewRegNCG (registerRep register1)
@@
-761,7
+767,6
@@
getRegister (StPrim primop [x, y]) -- dyadic PrimOps
code2 = amodeCode amode
src2 = amodeAddr amode
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] .
code__2 dst = let code1 = registerCode register1 dst
src1 = registerName register1 dst
in asmParThen [code2 asmVoid,code1 asmVoid] .
@@
-782,7
+787,6
@@
getRegister (StPrim primop [x, y]) -- dyadic PrimOps
code1 = amodeCode amode
src1 = amodeAddr amode
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] .
code__2 dst = let code2 = registerCode register2 dst
src2 = registerName register2 dst
in asmParThen [code1 asmVoid,code2 asmVoid] .
@@
-793,7
+797,7
@@
getRegister (StPrim primop [x, y]) -- dyadic PrimOps
mkSeqInstrs [ADD sz (OpAddr src1) (OpReg src2)]
in
returnUs (Any IntRep code__2)
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 ->
add_code sz x y
= getRegister x `thenUs` \ register1 ->
getRegister y `thenUs` \ register2 ->
@@
-1004,7
+1008,7
@@
getRegister (StPrim primop [x]) -- unary PrimOps
DoubleSinhOp -> (False, SLIT("sinh"))
DoubleCoshOp -> (False, SLIT("cosh"))
DoubleTanhOp -> (False, SLIT("tanh"))
DoubleSinhOp -> (False, SLIT("sinh"))
DoubleCoshOp -> (False, SLIT("cosh"))
DoubleTanhOp -> (False, SLIT("tanh"))
- _ -> panic ("Monadic PrimOp not handled: " ++ showPrimOp primop)
+ _ -> panic ("Monadic PrimOp not handled: " ++ show primop)
getRegister (StPrim primop [x, y]) -- dyadic PrimOps
= case primop of
getRegister (StPrim primop [x, y]) -- dyadic PrimOps
= case primop of
@@
-2780,7
+2784,6
@@
trivialCode instr x y
= getRegister x `thenUs` \ register1 ->
--getNewRegNCG IntRep `thenUs` \ tmp1 ->
let
= 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 .
code__2 dst = let code1 = registerCode register1 dst
src1 = registerName register1 dst
in code1 .
@@
-2800,7
+2803,6
@@
trivialCode instr x y
= getRegister y `thenUs` \ register1 ->
--getNewRegNCG IntRep `thenUs` \ tmp1 ->
let
= 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 .
code__2 dst = let code1 = registerCode register1 dst
src1 = registerName register1 dst
in code1 .
@@
-2814,13
+2816,12
@@
trivialCode instr x y
where
imm = maybeImm x
imm__2 = case imm of Just x -> x
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
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
code2 = amodeCode amode asmVoid
src2 = amodeAddr amode
code__2 dst = let code1 = registerCode register dst asmVoid
@@
-2839,7
+2840,6
@@
trivialCode instr (StInd pk mem) y
--getNewRegNCG IntRep `thenUs` \ tmp ->
getAmode mem `thenUs` \ amode ->
let
--getNewRegNCG IntRep `thenUs` \ tmp ->
getAmode mem `thenUs` \ amode ->
let
--- fixedname = registerName register eax
code2 = amodeCode amode asmVoid
src2 = amodeAddr amode
code__2 dst = let
code2 = amodeCode amode asmVoid
src2 = amodeAddr amode
code__2 dst = let
@@
-2853,14
+2853,13
@@
trivialCode instr (StInd pk mem) y
mkSeqInstr (instr (OpAddr src2) (OpReg src1))
in
returnUs (Any pk code__2)
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
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
code2 = registerCode register2 tmp2 asmVoid
src2 = registerName register2 tmp2
code__2 dst = let
@@
-2880,7
+2879,6
@@
trivialUCode instr x
= getRegister x `thenUs` \ register ->
-- getNewRegNCG IntRep `thenUs` \ tmp ->
let
= 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
code__2 dst = let
code = registerCode register dst
src = registerName register dst
@@
-3235,7
+3233,6
@@
chrCode x
= getRegister x `thenUs` \ register ->
--getNewRegNCG IntRep `thenUs` \ reg ->
let
= 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
code__2 dst = let
code = registerCode register dst
src = registerName register dst