%
-% (c) The AQUA Project, Glasgow University, 1996
+% (c) The AQUA Project, Glasgow University, 1996-1998
%
\section[MachCode]{Generating machine code}
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(..)
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}
%************************************************************************
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))
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")
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"
- 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])
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]
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
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"
- 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]