Commit 871db587 authored by qrczak's avatar qrczak
Browse files

[project @ 2001-02-28 00:01:01 by qrczak]

* Add {intToInt,wordToWord}{8,16,32}# primops. WARNING: Not implemented
  in ncg for Alpha and Sparc. But -O -fasm is not going to go far anyway
  because of other omissions.

* Have full repertoire of 8,16,32-bit signed and unsigned MachMisc.Size
  values. Again only x86 is fully supported. They are used for
  {index,read,write}{Int,Word}{8,16,32}{OffAddr,Array}# and
  {intToInt,wordToWord}{8,16,32}# primops.

* Have full repertoire of
  {index,read,write}\
  {Char,WideChar,Int,Word,Addr,Float,Double,StablePtr,\
   {Int,Word}{8,16,32,64}}\
  {OffAddr,Array} primops and appropriate instances.
  There were various omissions in various places.

* Add {plus,minus,times}Word# primops to avoid so many Word# <-> Int#
  coercions.

* Rewrite modules PrelWord and PrelInt almost from scratch.

* Simplify fromInteger and realToFrac rules. For each of
  {Int,Word}{8,16,32} there is just a pair of fromInteger rules
  replacing the source or target type with Int or Word. For
  {Int,Word,Int64,Word64} there are rules from any to any.
  Don't include rules which are derivable from inlining anyway,
  e.g. those mentioning Integer. Old explicit coercions are simply
  defined as appropriately typed fromInteger.

* Various old coercion functions marked as deprecated.

* Add instance Bits Int, and
  instance {Show,Num,Real,Enum,Integral,Bounded,Ix,Read,Bits} Word.

* Coercions to sized integer types consistently behave as cutting the
  right amount of bits from the infinite two-complement representation.
  For example (fromIntegral (-1 :: Int8) :: Word64) == maxBound.

* ghc/tests/numeric/should_run/arith011 tests {Int,Word}64 and instance
  Bits Int, and does not try to use overflowing toEnum. arith011.stdout
  is not updated yet because of a problem I will tell about soon.

* Move fromInteger and realToFrac from Prelude to PrelReal.
  Move fromInt from PrelNum to PrelReal and define as fromInteger.
  Define toInt as fromInteger. fromInteger is the place to write
  integer conversion rules for.

* Remove ArrayBase.newInitialisedArray, use default definition of
  newArray instead.

* Bugs fixed:
  - {quot,rem}Word# primop attributes.
  - integerToInt64# for small negative values.
  - {min,max}Bound::Int on 64-bit platforms.
  - iShiftRL64#.
  - Various Bits instances.

* Polishing:
  - Use 'ppr' instead of 'pprPrimOp' and 'text . showPrimRep'.
  - PrimRep.{primRepString,showPrimRepToUser} removed.
  - MachMisc.sizeOf returns Int instead of Integer.
  - Some eta reduction, parens, spacing, and reordering cleanups -
    sorry, couldn't resist.

* Questions:
  - Should iShiftRL and iShiftRL64 be removed? IMHO they should,
    s/iShiftRA/iShiftR/, s/shiftRL/shiftR/. The behaviour on shifting
    is a property of the signedness of the type, not the operation!
    I haven't done this change.
parent 60ac8eb4
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CLabel.lhs,v 1.44 2000/12/04 12:31:19 simonmar Exp $
% $Id: CLabel.lhs,v 1.45 2001/02/28 00:01:01 qrczak Exp $
%
\section[CLabel]{@CLabel@: Information to make C Labels}
......@@ -89,7 +89,7 @@ import Module ( moduleName, moduleNameFS,
import Name ( Name, getName, isDllName, isExternallyVisibleName )
import TyCon ( TyCon )
import Unique ( pprUnique, Unique )
import PrimOp ( PrimOp, pprPrimOp )
import PrimOp ( PrimOp )
import CostCentre ( CostCentre, CostCentreStack )
import Outputable
\end{code}
......@@ -508,7 +508,7 @@ pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
]
pprCLbl (RtsLabel (RtsPrimOp primop))
= pprPrimOp primop <> ptext SLIT("_fast")
= ppr primop <> ptext SLIT("_fast")
pprCLbl (RtsLabel RtsModuleRegd)
= ptext SLIT("module_registered")
......
......@@ -45,9 +45,9 @@ import TyCon ( tyConDataCons )
import Name ( NamedThing(..) )
import DataCon ( dataConWrapId )
import Maybes ( maybeToBool, catMaybes )
import PrimOp ( primOpNeedsWrapper, pprPrimOp, pprCCallOp,
import PrimOp ( primOpNeedsWrapper, pprCCallOp,
PrimOp(..), CCall(..), CCallTarget(..), isDynamicTarget )
import PrimRep ( isFloatingRep, PrimRep(..), getPrimRepSize, showPrimRep )
import PrimRep ( isFloatingRep, PrimRep(..), getPrimRepSize )
import SMRep ( pprSMRep )
import Unique ( pprUnique, Unique{-instance NamedThing-} )
import UniqSet ( emptyUniqSet, elementOfUniqSet,
......@@ -239,7 +239,7 @@ pprAbsC stmt@(COpStmt results op args vol_regs) _
the_op
where
ppr_op_call results args
= hcat [ pprPrimOp op, lparen,
= hcat [ ppr op, lparen,
hcat (punctuate comma (map ppr_op_result results)),
if null results || null args then empty else comma,
hcat (punctuate comma (map pprAmode args)),
......@@ -333,14 +333,14 @@ pprAbsC stmt@(CCallTypedef is_tdef (CCall op_str is_asm may_gc cconv) results ar
ccall_res_ty =
case non_void_results of
[] -> ptext SLIT("void")
[amode] -> text (showPrimRep (getAmodeRep amode))
[amode] -> ppr (getAmodeRep amode)
_ -> panic "pprAbsC{CCallTypedef}: ccall_res_ty"
ccall_decl_ty_args
| is_tdef = tail ccall_arg_tys
| otherwise = ccall_arg_tys
ccall_arg_tys = map (text.showPrimRep.getAmodeRep) non_void_args
ccall_arg_tys = map (ppr . getAmodeRep) non_void_args
-- the first argument will be the "I/O world" token (a VoidRep)
-- all others should be non-void
......
......@@ -175,8 +175,8 @@ stmtToInstrs stmt = case stmt of
getData (StString s) = panic "MachCode.stmtToInstrs: unlifted StString"
-- the linker can handle simple arithmetic...
getData (StIndex rep (StCLbl lbl) (StInt off)) =
returnNat (nilOL,
ImmIndex lbl (fromInteger (off * sizeOf rep)))
returnNat (nilOL,
ImmIndex lbl (fromInteger off * sizeOf rep))
-- Top-level lifted-out string. The segment will already have been set
-- (see liftStrings above).
......@@ -227,7 +227,7 @@ mangleIndexTree :: StixTree -> StixTree
mangleIndexTree (StIndex pk base (StInt i))
= StPrim IntAddOp [base, off]
where
off = StInt (i * sizeOf pk)
off = StInt (i * toInteger (sizeOf pk))
mangleIndexTree (StIndex pk base off)
= StPrim IntAddOp [
......@@ -237,7 +237,7 @@ mangleIndexTree (StIndex pk base off)
]
where
shift :: PrimRep -> Int
shift rep = case (fromInteger (sizeOf rep) :: Int) of
shift rep = case sizeOf rep of
1 -> 0
2 -> 1
4 -> 2
......@@ -252,7 +252,7 @@ maybeImm :: StixTree -> Maybe Imm
maybeImm (StCLbl l)
= Just (ImmCLbl l)
maybeImm (StIndex rep (StCLbl l) (StInt off))
= Just (ImmIndex l (fromInteger (off * sizeOf rep)))
= Just (ImmIndex l (fromInteger off * sizeOf rep))
maybeImm (StInt i)
| i >= toInteger minInt && i <= toInteger maxInt
= Just (ImmInt (fromInteger i))
......@@ -479,6 +479,9 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
IntQuotOp -> trivialCode (DIV Q False) x y
IntRemOp -> trivialCode (REM Q False) x y
WordAddOp -> trivialCode (ADD Q False) x y
WordSubOp -> trivialCode (SUB Q False) x y
WordMulOp -> trivialCode (MUL Q False) x y
WordQuotOp -> trivialCode (DIV Q True) x y
WordRemOp -> trivialCode (REM Q True) x y
......@@ -668,6 +671,13 @@ getRegister (StPrim primop [x]) -- unary PrimOps
Double2IntOp -> coerceFP2Int x
Int2DoubleOp -> coerceInt2FP DoubleRep x
IntToInt8Op -> extendIntCode Int8Rep IntRep x
IntToInt16Op -> extendIntCode Int16Rep IntRep x
IntToInt32Op -> getRegister x
WordToWord8Op -> extendIntCode Word8Rep WordRep x
WordToWord16Op -> extendIntCode Word16Rep WordRep x
WordToWord32Op -> getRegister x
other_op ->
getRegister (StCall fn cCallConv DoubleRep [x])
where
......@@ -743,12 +753,16 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
DoubleLtOp -> condFltReg LTT x y
DoubleLeOp -> condFltReg LE x y
IntAddOp -> add_code L x y
IntSubOp -> sub_code L x y
IntAddOp -> add_code L x y
IntSubOp -> sub_code L x y
IntQuotOp -> trivialCode (IQUOT L) Nothing x y
IntRemOp -> trivialCode (IREM L) Nothing x y
IntMulOp -> let op = IMUL L in trivialCode op (Just op) x y
WordAddOp -> add_code L x y
WordSubOp -> sub_code L x y
WordMulOp -> let op = IMUL L in trivialCode op (Just op) x y
FloatAddOp -> trivialFCode FloatRep GADD x y
FloatSubOp -> trivialFCode FloatRep GSUB x y
FloatMulOp -> trivialFCode FloatRep GMUL x y
......@@ -922,9 +936,14 @@ getRegister (StInd pk mem)
code__2 dst = code `snocOL`
if pk == DoubleRep || pk == FloatRep
then GLD size src dst
else case size of
L -> MOV L (OpAddr src) (OpReg dst)
BU -> MOVZxL BU (OpAddr src) (OpReg dst)
else (case size of
B -> MOVSxL B
Bu -> MOVZxL Bu
W -> MOVSxL W
Wu -> MOVZxL Wu
L -> MOV L
Lu -> MOV L)
(OpAddr src) (OpReg dst)
in
returnNat (Any pk code__2)
......@@ -1103,9 +1122,13 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
IntSubOp -> trivialCode (SUB False False) x y
-- ToDo: teach about V8+ SPARC mul/div instructions
IntMulOp -> imul_div SLIT(".umul") x y
IntQuotOp -> imul_div SLIT(".div") x y
IntRemOp -> imul_div SLIT(".rem") x y
IntMulOp -> imul_div SLIT(".umul") x y
IntQuotOp -> imul_div SLIT(".div") x y
IntRemOp -> imul_div SLIT(".rem") x y
WordAddOp -> trivialCode (ADD False False) x y
WordSubOp -> trivialCode (SUB False False) x y
WordMulOp -> imul_div SLIT(".umul") x y
FloatAddOp -> trivialFCode FloatRep FADD x y
FloatSubOp -> trivialFCode FloatRep FSUB x y
......@@ -1123,9 +1146,9 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
SllOp -> trivialCode SLL x y
SrlOp -> trivialCode SRL x y
ISllOp -> trivialCode SLL x y --was: panic "SparcGen:isll"
ISraOp -> trivialCode SRA x y --was: panic "SparcGen:isra"
ISrlOp -> trivialCode SRL x y --was: panic "SparcGen:isrl"
ISllOp -> trivialCode SLL x y
ISraOp -> trivialCode SRA x y
ISrlOp -> trivialCode SRL x y
FloatPowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep
[promote x, promote y])
......@@ -1805,7 +1828,13 @@ assignIntCode pk dst (StInd pks src)
c_dst = registerCode reg_dst tmp -- should be empty
r_dst = registerName reg_dst tmp
szs = primRepToSize pks
opc = case szs of L -> MOV L ; BU -> MOVZxL BU
opc = case szs of
B -> MOVSxL B
Bu -> MOVZxL Bu
W -> MOVSxL W
Wu -> MOVZxL Wu
L -> MOV L
Lu -> MOV L
code | isNilOL c_dst
= c_addr `snocOL`
......@@ -3235,6 +3264,20 @@ coerceFP2Int x
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#if i386_TARGET_ARCH
extendIntCode :: PrimRep -> PrimRep -> StixTree -> NatM Register
extendIntCode pks pkd x
= coerceIntCode pks x `thenNat` \ register ->
getNewRegNCG pks `thenNat` \ reg ->
let
code = registerCode register reg
src = registerName register reg
opc = case pkd of IntRep -> MOVSxL ; WordRep -> MOVZxL
sz = primRepToSize pks
code__2 dst = code `snocOL` opc sz (OpReg src) (OpReg dst)
in
returnNat (Any pkd code__2)
------------
coerceInt2FP pk x
= getRegister x `thenNat` \ register ->
getNewRegNCG IntRep `thenNat` \ reg ->
......
......@@ -97,13 +97,11 @@ 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; W -> 4; F -> 4; DF -> 8},)
IF_ARCH_i386( {B -> 1; BU -> 1; L -> 4; F -> 4; DF -> 8 },)
sizeOf :: PrimRep -> Int{-in bytes-}
sizeOf pr = case primRepToSize pr of
IF_ARCH_alpha({B->1; Bu->1; {-W->2; Wu->2;-} L->4; {-SF->4;-} Q->8; TF->8},)
IF_ARCH_i386 ({B->1; Bu->1; W->2; Wu->2; L->4; Lu->4; F->4; DF->8; F80->10},)
IF_ARCH_sparc({B->1; Bu->1; W->4; F->4; DF->8},)
\end{code}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
......@@ -237,9 +235,9 @@ data Cond
data Size
#if alpha_TARGET_ARCH
= B -- byte
| BU
| Bu
-- | W -- word (2 bytes): UNUSED
-- | WU -- : UNUSED
-- | Wu -- : UNUSED
| L -- longword (4 bytes)
| Q -- quadword (8 bytes)
-- | FF -- VAX F-style floating pt: UNUSED
......@@ -249,46 +247,55 @@ data Size
| TF -- IEEE double-precision floating pt
#endif
#if i386_TARGET_ARCH
= B -- byte (signed, JRS:??lower??)
| BU -- byte, unsigned
| L -- word32
= 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)
| BU -- byte (unsigned)
| W -- word, 4 bytes
| Bu -- byte (unsigned)
| W -- word (4 bytes)
| 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 Word8Rep = IF_ARCH_alpha( BU, IF_ARCH_i386( BU, IF_ARCH_sparc( BU,)))
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 ,)))
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(err,)))
where err = panic "primRepToSize 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(err,)))
where err = panic "primRepToSize 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 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
......
......@@ -36,7 +36,7 @@ import Maybe ( isJust )
For x86, the way we print a register name depends
on which bit of it we care about. Yurgh.
\begin{code}
pprUserReg:: Reg -> SDoc
pprUserReg :: Reg -> SDoc
pprUserReg = pprReg IF_ARCH_i386(L,)
......@@ -89,22 +89,37 @@ pprReg IF_ARCH_i386(s,) r
#endif
#if i386_TARGET_ARCH
ppr_reg_no :: Size -> Int -> SDoc
ppr_reg_no B i= ptext
ppr_reg_no B = ppr_reg_byte
ppr_reg_no Bu = ppr_reg_byte
ppr_reg_no W = ppr_reg_word
ppr_reg_no Wu = ppr_reg_word
ppr_reg_no _ = ppr_reg_long
ppr_reg_byte i = ptext
(case i of {
0 -> SLIT("%al"); 1 -> SLIT("%bl");
2 -> SLIT("%cl"); 3 -> SLIT("%dl");
0 -> SLIT("%al"); 1 -> SLIT("%bl");
2 -> SLIT("%cl"); 3 -> SLIT("%dl");
_ -> SLIT("very naughty I386 byte register")
})
ppr_reg_no _ i = ptext
ppr_reg_word i = ptext
(case i of {
0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
4 -> SLIT("%esi"); 5 -> SLIT("%edi");
6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
0 -> SLIT("%ax"); 1 -> SLIT("%bx");
2 -> SLIT("%cx"); 3 -> SLIT("%dx");
4 -> SLIT("%si"); 5 -> SLIT("%di");
6 -> SLIT("%bp"); 7 -> SLIT("%sp");
_ -> SLIT("very naughty I386 word register")
})
ppr_reg_long i = ptext
(case i of {
0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
4 -> SLIT("%esi"); 5 -> SLIT("%edi");
6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
_ -> SLIT("very naughty I386 register")
})
#endif
......@@ -161,9 +176,9 @@ pprSize :: Size -> SDoc
pprSize x = ptext (case x of
#if alpha_TARGET_ARCH
B -> SLIT("b")
BU -> SLIT("bu")
Bu -> SLIT("bu")
-- W -> SLIT("w") UNUSED
-- WU -> SLIT("wu") UNUSED
-- Wu -> SLIT("wu") UNUSED
L -> SLIT("l")
Q -> SLIT("q")
-- FF -> SLIT("f") UNUSED
......@@ -173,15 +188,19 @@ pprSize x = ptext (case x of
TF -> SLIT("t")
#endif
#if i386_TARGET_ARCH
BU -> SLIT("b")
B -> SLIT("b")
Bu -> SLIT("b")
W -> SLIT("w")
Wu -> SLIT("w")
L -> SLIT("l")
Lu -> SLIT("l")
F -> SLIT("s")
DF -> SLIT("l")
F80 -> SLIT("t")
#endif
#if sparc_TARGET_ARCH
B -> SLIT("sb")
BU -> SLIT("ub")
Bu -> SLIT("ub")
W -> SLIT("")
F -> SLIT("")
DF -> SLIT("d")
......@@ -189,7 +208,7 @@ pprSize x = ptext (case x of
pprStSize :: Size -> SDoc
pprStSize x = ptext (case x of
B -> SLIT("b")
BU -> SLIT("b")
Bu -> SLIT("b")
W -> SLIT("")
F -> SLIT("")
DF -> SLIT("d")
......
......@@ -154,9 +154,9 @@ interesting (RealReg i) = isFastTrue (freeReg i)
regUsage instr = case instr of
LD B reg addr -> usage (regAddr addr, [reg, t9])
LD BU reg addr -> usage (regAddr addr, [reg, t9])
LD Bu reg addr -> usage (regAddr addr, [reg, t9])
-- LD W reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
-- LD WU reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
-- LD Wu reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
LD sz reg addr -> usage (regAddr addr, [reg])
LDA reg addr -> usage (regAddr addr, [reg])
LDAH reg addr -> usage (regAddr addr, [reg])
......
......@@ -31,8 +31,8 @@ import Ratio ( Rational )
import AbsCSyn ( node, tagreg, MagicId(..) )
import CallConv ( CallConv, pprCallConv )
import CLabel ( mkAsmTempLabel, CLabel, pprCLabel )
import PrimRep ( PrimRep(..), showPrimRep )
import PrimOp ( PrimOp, pprPrimOp )
import PrimRep ( PrimRep(..) )
import PrimOp ( PrimOp )
import Unique ( Unique )
import SMRep ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize )
import UniqSupply ( UniqSupply, splitUniqSupply, uniqFromSupply,
......@@ -163,9 +163,9 @@ pprStixTree t
StCLbl lbl -> pprCLabel lbl
StReg reg -> ppStixReg reg
StIndex k b o -> paren (pprStixTree b <+> char '+' <>
pprPrimRep k <+> pprStixTree o)
StInd k t -> pprPrimRep k <> char '[' <> pprStixTree t <> char ']'
StAssign k d s -> pprStixTree d <> text " :=" <> pprPrimRep k
ppr k <+> pprStixTree o)
StInd k t -> ppr k <> char '[' <> pprStixTree t <> char ']'
StAssign k d s -> pprStixTree d <> text " :=" <> ppr k
<> text " " <> pprStixTree s
StLabel ll -> pprCLabel ll <+> char ':'
StFunBegin ll -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll)
......@@ -174,17 +174,15 @@ pprStixTree t
StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll)
StCondJump l t -> paren (text "JumpC" <+> pprCLabel l
<+> pprStixTree t)
StData k ds -> paren (text "Data" <+> pprPrimRep k <+>
StData k ds -> paren (text "Data" <+> ppr k <+>
hsep (map pprStixTree ds))
StPrim op ts -> paren (text "Prim" <+> pprPrimOp op <+>
StPrim op ts -> paren (text "Prim" <+> ppr op <+>
hsep (map pprStixTree ts))
StCall nm cc k args
-> paren (text "Call" <+> ptext nm <+>
pprCallConv cc <+> pprPrimRep k <+>
pprCallConv cc <+> ppr k <+>
hsep (map pprStixTree args))
StScratchWord i -> text "ScratchWord" <> paren (int i)
pprPrimRep = text . showPrimRep
\end{code}
Stix registers can have two forms. They {\em may} or {\em may not}
......@@ -204,11 +202,11 @@ ppStixReg (StixTemp u pr)
ppMId BaseReg = text "BaseReg"
ppMId (VanillaReg kind n) = hcat [pprPrimRep kind, text "IntReg(",
ppMId (VanillaReg kind n) = hcat [ppr kind, text "IntReg(",
int (iBox n), char ')']
ppMId (FloatReg n) = hcat [text "FltReg(", int (iBox n), char ')']
ppMId (DoubleReg n) = hcat [text "DblReg(", int (iBox n), char ')']
ppMId (LongReg kind n) = hcat [pprPrimRep kind, text "LongReg(",
ppMId (LongReg kind n) = hcat [ppr kind, text "LongReg(",
int (iBox n), char ')']
ppMId Sp = text "Sp"
ppMId Su = text "Su"
......
......@@ -183,76 +183,124 @@ primCode [] WriteForeignObjOp [obj, v]
-- NB: indexing in "pk" units, *not* in bytes (WDP 95/09)
primCode ls IndexByteArrayOp_Char rs = primCode_ReadByteArrayOp Word8Rep ls rs
primCode ls IndexByteArrayOp_WideChar rs = primCode_ReadByteArrayOp CharRep ls rs
primCode ls IndexByteArrayOp_Int rs = primCode_ReadByteArrayOp IntRep ls rs
primCode ls IndexByteArrayOp_Word rs = primCode_ReadByteArrayOp WordRep ls rs
primCode ls IndexByteArrayOp_Addr rs = primCode_ReadByteArrayOp AddrRep ls rs
primCode ls IndexByteArrayOp_Float rs = primCode_ReadByteArrayOp FloatRep ls rs
primCode ls IndexByteArrayOp_Double rs = primCode_ReadByteArrayOp DoubleRep ls rs
primCode ls IndexByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep ls rs
primCode ls IndexByteArrayOp_Int8 rs = primCode_ReadByteArrayOp Int8Rep ls rs
primCode ls IndexByteArrayOp_Int16 rs = primCode_ReadByteArrayOp Int16Rep ls rs
primCode ls IndexByteArrayOp_Int32 rs = primCode_ReadByteArrayOp Int32Rep ls rs
primCode ls IndexByteArrayOp_Int64 rs = primCode_ReadByteArrayOp Int64Rep ls rs
primCode ls IndexByteArrayOp_Word8 rs = primCode_ReadByteArrayOp Word8Rep ls rs
primCode ls IndexByteArrayOp_Word16 rs = primCode_ReadByteArrayOp Word16Rep ls rs
primCode ls IndexByteArrayOp_Word32 rs = primCode_ReadByteArrayOp Word32Rep ls rs
primCode ls IndexByteArrayOp_Word64 rs = primCode_ReadByteArrayOp Word64Rep ls rs
primCode ls ReadByteArrayOp_Char rs = primCode_ReadByteArrayOp Word8Rep ls rs
primCode ls ReadByteArrayOp_WideChar rs = primCode_ReadByteArrayOp CharRep ls rs
primCode ls ReadByteArrayOp_Int rs = primCode_ReadByteArrayOp IntRep ls rs
primCode ls ReadByteArrayOp_Word rs = primCode_ReadByteArrayOp WordRep ls rs
primCode ls ReadByteArrayOp_Addr rs = primCode_ReadByteArrayOp AddrRep ls rs
primCode ls ReadByteArrayOp_Float rs = primCode_ReadByteArrayOp FloatRep ls rs
primCode ls ReadByteArrayOp_Double rs = primCode_ReadByteArrayOp DoubleRep ls rs
primCode ls ReadByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep ls rs
primCode ls ReadByteArrayOp_Int8 rs = primCode_ReadByteArrayOp Int8Rep ls rs
primCode ls ReadByteArrayOp_Int16 rs = primCode_ReadByteArrayOp Int16Rep ls rs
primCode ls ReadByteArrayOp_Int32 rs = primCode_ReadByteArrayOp Int32Rep ls rs
primCode ls ReadByteArrayOp_Int64 rs = primCode_ReadByteArrayOp Int64Rep ls rs
primCode ls ReadByteArrayOp_Word8 rs = primCode_ReadByteArrayOp Word8Rep ls rs
primCode ls ReadByteArrayOp_Word16 rs = primCode_ReadByteArrayOp Word16Rep ls rs
primCode ls ReadByteArrayOp_Word32 rs = primCode_ReadByteArrayOp Word32Rep ls rs
primCode ls ReadByteArrayOp_Word64 rs = primCode_ReadByteArrayOp Word64Rep ls rs
primCode ls ReadOffAddrOp_Char rs = primCode_IndexOffAddrOp Word8Rep ls rs
primCode ls ReadOffAddrOp_Int rs = primCode_IndexOffAddrOp IntRep ls rs
primCode ls ReadOffAddrOp_Word rs = primCode_IndexOffAddrOp WordRep ls rs
primCode ls ReadOffAddrOp_Addr rs = primCode_IndexOffAddrOp AddrRep ls rs
primCode ls ReadOffAddrOp_Float rs = primCode_IndexOffAddrOp FloatRep ls rs
primCode ls ReadOffAddrOp_Double rs = primCode_IndexOffAddrOp DoubleRep ls rs
primCode ls ReadOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs
primCode ls ReadOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs
primCode ls ReadOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs
primCode ls WriteByteArrayOp_Char rs = primCode_WriteByteArrayOp Word8Rep ls rs
primCode ls WriteByteArrayOp_WideChar rs = primCode_WriteByteArrayOp CharRep ls rs
primCode ls WriteByteArrayOp_Int rs = primCode_WriteByteArrayOp IntRep ls rs
primCode ls WriteByteArrayOp_Word rs = primCode_WriteByteArrayOp WordRep ls rs
primCode ls WriteByteArrayOp_Addr rs = primCode_WriteByteArrayOp AddrRep ls rs
primCode ls WriteByteArrayOp_Float rs = primCode_WriteByteArrayOp FloatRep ls rs
primCode ls WriteByteArrayOp_Double rs = primCode_WriteByteArrayOp DoubleRep ls rs
primCode ls WriteByteArrayOp_StablePtr rs = primCode_WriteByteArrayOp StablePtrRep ls rs
primCode ls WriteByteArrayOp_Int8 rs = primCode_WriteByteArrayOp Int8Rep ls rs
primCode ls WriteByteArrayOp_Int16 rs = primCode_WriteByteArrayOp Int16Rep ls rs
primCode ls WriteByteArrayOp_Int32 rs = primCode_WriteByteArrayOp Int32Rep ls rs
primCode ls WriteByteArrayOp_Int64 rs = primCode_WriteByteArrayOp Int64Rep ls rs
primCode ls WriteByteArrayOp_Word8 rs = primCode_WriteByteArrayOp Word8Rep ls rs
primCode ls WriteByteArrayOp_Word16 rs = primCode_WriteByteArrayOp Word16Rep ls rs
primCode ls WriteByteArrayOp_Word32 rs = primCode_WriteByteArrayOp Word32Rep ls rs
primCode ls WriteByteArrayOp_Word64 rs = primCode_WriteByteArrayOp Word64Rep ls rs
primCode ls IndexOffAddrOp_Char rs = primCode_IndexOffAddrOp Word8Rep ls rs
primCode ls IndexOffAddrOp_WideChar rs = primCode_IndexOffAddrOp CharRep ls rs
primCode ls IndexOffAddrOp_Int rs = primCode_IndexOffAddrOp IntRep ls rs
primCode ls IndexOffAddrOp_Word rs = primCode_IndexOffAddrOp WordRep ls rs
primCode ls IndexOffAddrOp_Addr rs = primCode_IndexOffAddrOp AddrRep ls rs
primCode ls IndexOffAddrOp_Float rs = primCode_IndexOffAddrOp FloatRep ls rs
primCode ls IndexOffAddrOp_Double rs = primCode_IndexOffAddrOp DoubleRep ls rs
primCode ls IndexOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs
primCode ls IndexOffAddrOp_Int8 rs = primCode_IndexOffAddrOp Int8Rep ls rs
primCode ls IndexOffAddrOp_Int16 rs = primCode_IndexOffAddrOp Int16Rep ls rs
primCode ls IndexOffAddrOp_Int32 rs = primCode_IndexOffAddrOp Int32Rep ls rs
primCode ls IndexOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs
primCode ls IndexOffAddrOp_Word8 rs = primCode_IndexOffAddrOp Word8Rep ls rs
primCode ls IndexOffAddrOp_Word16 rs = primCode_IndexOffAddrOp Word16Rep ls rs
primCode ls IndexOffAddrOp_Word32 rs = primCode_IndexOffAddrOp Word32Rep ls rs
primCode ls IndexOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs
primCode ls IndexOffForeignObjOp_Char rs = primCode_IndexOffForeignObjOp Word8Rep ls rs
primCode ls IndexOffForeignObjOp_WideChar rs = primCode_IndexOffForeignObjOp CharRep ls rs
primCode ls IndexOffForeignObjOp_Int rs = primCode_IndexOffForeignObjOp IntRep ls rs
primCode ls IndexOffForeignObjOp_Word rs = primCode_IndexOffForeignObjOp WordRep ls rs
primCode ls IndexOffForeignObjOp_Addr rs = primCode_IndexOffForeignObjOp AddrRep ls rs
primCode ls IndexOffForeignObjOp_Float rs = primCode_IndexOffForeignObjOp FloatRep ls rs
primCode ls IndexOffForeignObjOp_Double rs = primCode_IndexOffForeignObjOp DoubleRep ls rs
primCode ls IndexOffForeignObjOp_StablePtr rs = primCode_IndexOffForeignObjOp StablePtrRep ls rs
primCode ls IndexOffForeignObjOp_Int8 rs = primCode_IndexOffForeignObjOp Int8Rep ls rs
primCode ls IndexOffForeignObjOp_Int16 rs = primCode_IndexOffForeignObjOp Int16Rep ls rs
primCode ls IndexOffForeignObjOp_Int32 rs = primCode_IndexOffForeignObjOp Int32Rep ls rs
primCode ls IndexOffForeignObjOp_Int64 rs = primCode_IndexOffForeignObjOp Int64Rep ls rs
primCode ls IndexOffForeignObjOp_Word8 rs = primCode_IndexOffForeignObjOp Word8Rep ls rs
primCode ls IndexOffForeignObjOp_Word16 rs = primCode_IndexOffForeignObjOp Word16Rep ls rs
primCode ls IndexOffForeignObjOp_Word32 rs = primCode_IndexOffForeignObjOp Word32Rep ls rs
primCode ls IndexOffForeignObjOp_Word64 rs = primCode_IndexOffForeignObjOp Word64Rep ls rs
primCode ls WriteOffAddrOp_Word8 rs = primCode_WriteOffAddrOp Word8Rep ls rs
primCode ls ReadOffAddrOp_Char rs = primCode_IndexOffAddrOp Word8Rep ls rs
primCode ls ReadOffAddrOp_WideChar rs = primCode_IndexOffAddrOp CharRep ls rs
primCode ls ReadOffAddrOp_Int rs = primCode_IndexOffAddrOp IntRep ls rs
primCode ls ReadOffAddrOp_Word rs = primCode_IndexOffAddrOp WordRep ls rs
primCode ls ReadOffAddrOp_Addr rs = primCode_IndexOffAddrOp AddrRep ls rs
primCode ls ReadOffAddrOp_Float rs = primCode_IndexOffAddrOp FloatRep ls rs
primCode ls ReadOffAddrOp_Double rs = primCode_IndexOffAddrOp DoubleRep ls rs
primCode ls ReadOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs
primCode ls ReadOffAddrOp_Int8 rs = primCode_IndexOffAddrOp Int8Rep ls rs
primCode ls ReadOffAddrOp_Int16 rs = primCode_IndexOffAddrOp Int16Rep ls rs
primCode ls ReadOffAddrOp_Int32 rs = primCode_IndexOffAddrOp Int32Rep ls rs
primCode ls ReadOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs
primCode ls ReadOffAddrOp_Word8 rs = primCode_IndexOffAddrOp Word8Rep ls rs
primCode ls ReadOffAddrOp_Word16 rs = primCode_IndexOffAddrOp Word16Rep ls rs
primCode ls ReadOffAddrOp_Word32 rs = primCode_IndexOffAddrOp Word32Rep ls rs
primCode ls ReadOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs
primCode ls WriteOffAddrOp_Char rs = primCode_WriteOffAddrOp Word8Rep ls rs
primCode ls WriteOffAddrOp_WideChar rs = primCode_WriteOffAddrOp CharRep ls rs
primCode ls WriteOffAddrOp_Int rs = primCode_WriteOffAddrOp IntRep ls rs
primCode ls WriteOffAddrOp_Word rs = primCode_WriteOffAddrOp WordRep ls rs
primCode ls WriteOffAddrOp_Addr rs = primCode_WriteOffAddrOp AddrRep ls rs
primCode ls WriteOffAddrOp_Float rs = primCode_WriteOffAddrOp FloatRep ls rs
primCode ls WriteOffAddrOp_Double rs = primCode_WriteOffAddrOp DoubleRep ls rs
primCode ls WriteOffAddrOp_StablePtr rs = primCode_WriteOffAddrOp StablePtrRep ls rs