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-02-18 17:13:54 by simonpj]
[ghc-hetmet.git]
/
ghc
/
compiler
/
nativeGen
/
MachCode.lhs
diff --git
a/ghc/compiler/nativeGen/MachCode.lhs
b/ghc/compiler/nativeGen/MachCode.lhs
index
b0aefde
..
0fd076d
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")
@@
-409,9
+415,9
@@
getRegister (StPrim primop [x, y]) -- dyadic PrimOps
SllOp -> trivialCode SLL x y
SrlOp -> trivialCode SRL x y
SllOp -> trivialCode SLL x y
SrlOp -> trivialCode SRL x y
- ISllOp -> panic "AlphaGen:isll"
+ ISllOp -> trivialCode SLL x y -- was: panic "AlphaGen:isll"
ISraOp -> trivialCode SRA x y -- was: panic "AlphaGen:isra"
ISraOp -> trivialCode SRA x y -- was: panic "AlphaGen:isra"
- ISrlOp -> panic "AlphaGen:isrl"
+ ISrlOp -> trivialCode SRL x y -- was: panic "AlphaGen:isrl"
FloatPowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [x,y])
DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [x,y])
FloatPowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [x,y])
DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [x,y])
@@
-671,10
+677,9
@@
getRegister (StPrim primop [x, y]) -- dyadic PrimOps
SllOp -> shift_code (SHL L) x y {-False-}
SrlOp -> shift_code (SHR L) x y {-False-}
SllOp -> shift_code (SHL L) x y {-False-}
SrlOp -> shift_code (SHR L) x y {-False-}
- {- ToDo: nuke? -}
- ISllOp -> panic "I386Gen:isll"
- ISraOp -> shift_code (SAR L) x y {-False-} --panic "I386Gen:isra"
- ISrlOp -> panic "I386Gen:isrl"
+ ISllOp -> shift_code (SHL L) x y {-False-} --was:panic "I386Gen:isll"
+ ISraOp -> shift_code (SAR L) x y {-False-} --was:panic "I386Gen:isra"
+ ISrlOp -> shift_code (SHR L) x y {-False-} --was:panic "I386Gen:isrl"
FloatPowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [promote x, promote y])
where promote x = StPrim Float2DoubleOp [x]
FloatPowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [promote x, promote y])
where promote x = StPrim Float2DoubleOp [x]
@@
-1005,7
+1010,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
@@
-1075,9
+1080,9
@@
getRegister (StPrim primop [x, y]) -- dyadic PrimOps
SllOp -> trivialCode SLL x y
SrlOp -> trivialCode SRL x y
SllOp -> trivialCode SLL x y
SrlOp -> trivialCode SRL x y
- ISllOp -> panic "SparcGen:isll"
+ ISllOp -> trivialCode SLL x y --was: panic "SparcGen:isll"
ISraOp -> trivialCode SRA x y --was: panic "SparcGen:isra"
ISraOp -> trivialCode SRA x y --was: panic "SparcGen:isra"
- ISrlOp -> panic "SparcGen:isrl"
+ ISrlOp -> trivialCode SRL x y --was: panic "SparcGen:isrl"
FloatPowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [promote x, promote y])
where promote x = StPrim Float2DoubleOp [x]
FloatPowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [promote x, promote y])
where promote x = StPrim Float2DoubleOp [x]