import PrimOp ( PrimOp(..) )
import CallConv ( cCallConv )
import Stix ( getUniqLabelNCG, StixTree(..),
- StixReg(..), CodeSegment(..)
+ StixReg(..), CodeSegment(..),
+ pprStixTrees, ppStixReg
)
import UniqSupply ( returnUs, thenUs, mapUs, mapAndUnzipUs,
mapAccumLUs, UniqSM
StComment s -> returnInstr (COMMENT s)
StSegment seg -> returnInstr (SEGMENT seg)
-#if 1
- -- StFunBegin, normal non-debugging code for all architectures
StFunBegin lab -> returnInstr (IF_ARCH_alpha(FUNBEGIN lab,LABEL lab))
-#else
- -- StFunBegin, special tracing code for x86-Linux only
- -- requires you to supply
- -- void native_trace ( char* str )
- StFunBegin lab -> getUniqLabelNCG `thenUs` \ str_lbl ->
- returnUs (mkSeqInstrs [
- LABEL lab,
- COMMENT SLIT("begin trace sequence"),
- SEGMENT DataSegment,
- LABEL str_lbl,
- ASCII True (showSDoc (pprCLabel_asm lab)),
- SEGMENT TextSegment,
- PUSHA,
- PUSH L (OpImm (ImmCLbl str_lbl)),
- CALL (ImmLit (text "native_trace")),
- ADD L (OpImm (ImmInt 4)) (OpReg esp),
- POPA,
- COMMENT SLIT("end trace sequence")
- ])
-#endif
-
StFunEnd lab -> IF_ARCH_alpha(returnInstr (FUNEND lab),returnUs id)
StLabel lab -> returnInstr (LABEL lab)
where
off = StInt (i * sizeOf pk)
-#ifndef i386_TARGET_ARCH
mangleIndexTree (StIndex pk base off)
- = StPrim IntAddOp [base,
- case pk of
- CharRep -> off
- _ -> let
- s = shift pk
- in
- ASSERT(toInteger s == expectJust "MachCode" (exactLog2 (sizeOf pk)))
- StPrim SllOp [off, StInt s]
- ]
+ = StPrim IntAddOp [
+ base,
+ let s = shift pk
+ in ASSERT(toInteger s == expectJust "MachCode" (exactLog2 (sizeOf pk)))
+ if s == 0 then off else StPrim SllOp [off, StInt s]
+ ]
where
shift DoubleRep = 3::Integer
+ shift CharRep = 0::Integer
shift _ = IF_ARCH_alpha(3,2)
-#else
--- Hmm..this is an attempt at fixing Adress amodes (i.e., *[disp](base,index,<n>),
--- that do include the size of the primitive kind we're addressing. When StIndex
--- is expanded to actual code, the index (in units) is by the above code approp.
--- shifted to get the no. of bytes. Since Address amodes do contain size info
--- explicitly, we disable the shifting for x86s.
-mangleIndexTree (StIndex pk base off) = StPrim IntAddOp [base, off]
-#endif
-
\end{code}
\begin{code}
getRegister (StReg (StixMagicId stgreg))
= case (magicIdRegMaybe stgreg) of
Just reg -> returnUs (Fixed (magicIdPrimRep stgreg) reg id)
- -- cannae be Nothing
+ -- cannae be Nothing
getRegister (StReg (StixTemp u pk))
= returnUs (Fixed pk (UnmappedReg u pk) id)
in
returnUs (Any DoubleRep code)
+-- incorrectly assumes that %esp doesn't move (as does spilling); ToDo: fix
+getRegister (StScratchWord i)
+ | i >= 0 && i < 6
+ = let code dst = mkSeqInstr (LEA L (OpAddr (spRel (i+1))) (OpReg dst))
+ in returnUs (Any PtrRep code)
getRegister (StPrim primop [x]) -- unary PrimOps
= case primop of
FloatSqrtOp -> trivialUFCode FloatRep (GSQRT F) x
DoubleSqrtOp -> trivialUFCode DoubleRep (GSQRT DF) x
+ FloatSinOp -> trivialUFCode FloatRep (GSIN F) x
+ DoubleSinOp -> trivialUFCode DoubleRep (GSIN DF) x
+
+ FloatCosOp -> trivialUFCode FloatRep (GCOS F) x
+ DoubleCosOp -> trivialUFCode DoubleRep (GCOS DF) x
+
+ FloatTanOp -> trivialUFCode FloatRep (GTAN F) x
+ DoubleTanOp -> trivialUFCode DoubleRep (GTAN DF) x
+
Double2FloatOp -> trivialUFCode FloatRep GDTOF x
Float2DoubleOp -> trivialUFCode DoubleRep GFTOD x
FloatExpOp -> (True, SLIT("exp"))
FloatLogOp -> (True, SLIT("log"))
- FloatSinOp -> (True, SLIT("sin"))
- FloatCosOp -> (True, SLIT("cos"))
- FloatTanOp -> (True, SLIT("tan"))
+ --FloatSinOp -> (True, SLIT("sin"))
+ --FloatCosOp -> (True, SLIT("cos"))
+ --FloatTanOp -> (True, SLIT("tan"))
FloatAsinOp -> (True, SLIT("asin"))
FloatAcosOp -> (True, SLIT("acos"))
DoubleExpOp -> (False, SLIT("exp"))
DoubleLogOp -> (False, SLIT("log"))
- DoubleSinOp -> (False, SLIT("sin"))
- DoubleCosOp -> (False, SLIT("cos"))
- DoubleTanOp -> (False, SLIT("tan"))
+ --DoubleSinOp -> (False, SLIT("sin"))
+ --DoubleCosOp -> (False, SLIT("cos"))
+ --DoubleTanOp -> (False, SLIT("tan"))
DoubleAsinOp -> (False, SLIT("asin"))
DoubleAcosOp -> (False, SLIT("acos"))
DoubleCoshOp -> (False, SLIT("cosh"))
DoubleTanhOp -> (False, SLIT("tanh"))
+ other
+ -> pprPanic "getRegister(x86,unary primop)"
+ (pprStixTrees [StPrim primop [x]])
+
getRegister (StPrim primop [x, y]) -- dyadic PrimOps
= case primop of
CharGtOp -> condIntReg GTT x y
DoubleLtOp -> condFltReg LTT x y
DoubleLeOp -> condFltReg LE x y
- IntAddOp -> {- ToDo: fix this, whatever it is (WDP 96/04)...
- -- this should be optimised by the generic Opts,
- -- I don't know why it is not (sometimes)!
- case args of
- [x, StInt 0] -> getRegister x
- _ -> add_code L x y
- -}
- add_code L x y
-
+ IntAddOp -> add_code L x y
IntSubOp -> sub_code L x y
IntQuotOp -> quot_code L x y True{-division-}
IntRemOp -> quot_code L x y False{-remainder-}
=> trivialCode's is not restrictive enough (sigh.)
-}
- 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-}
ISllOp -> shift_code (SHL L) x y {-False-}
ISraOp -> shift_code (SAR L) x y {-False-}
ISrlOp -> shift_code (SHR L) x y {-False-}
where promote x = StPrim Float2DoubleOp [x]
DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep
[x, y])
+ other
+ -> pprPanic "getRegister(x86,dyadic primop)"
+ (pprStixTrees [StPrim primop [x, y]])
where
--------------------
- shift_code :: (Operand -> Operand -> Instr)
+ shift_code :: (Imm -> Operand -> Instr)
-> StixTree
-> StixTree
-> UniqSM Register
shift_code instr x y{-amount-}
| maybeToBool imm
= getRegister x `thenUs` \ register ->
- let
- op_imm = OpImm imm__2
+ let op_imm = OpImm imm__2
code__2 dst =
- let
- code = registerCode register dst
- src = registerName register dst
+ let code = registerCode register dst
+ src = registerName register dst
in
- mkSeqInstr (COMMENT SLIT("shift_code")) .
code .
if isFixed register && src /= dst
- then
- mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
- instr op_imm (OpReg dst)]
- else
- mkSeqInstr (instr op_imm (OpReg src))
+ then mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
+ instr imm__2 (OpReg dst)]
+ else mkSeqInstr (instr imm__2 (OpReg src))
in
returnUs (Any IntRep code__2)
where
imm__2 = case imm of Just x -> x
{- Case2: shift length is complex (non-immediate) -}
+ -- Since ECX is always used as a spill temporary, we can't
+ -- use it here to do non-immediate shifts. No big deal --
+ -- they are only very rare, and we can use an equivalent
+ -- test-and-jump sequence which doesn't use ECX.
+ -- DO NOT USE REPLACE THIS CODE WITH THE "OBVIOUS" shl/shr/sar CODE,
+ -- SINCE IT WILL CAUSE SERIOUS PROBLEMS WITH THE SPILLER
shift_code instr x y{-amount-}
- = getRegister y `thenUs` \ register1 ->
- getRegister x `thenUs` \ register2 ->
- let
- -- Note: we force the shift length to be loaded
- -- into ECX, so that we can use CL when shifting.
- -- (only register location we are allowed
- -- to put shift amounts.)
- --
- -- The shift instruction is fed ECX as src reg,
- -- but we coerce this into CL when printing out.
- src1 = registerName register1 ecx
- code1 = if src1 /= ecx then -- if it is not in ecx already, force it!
- registerCode register1 ecx .
- mkSeqInstr (MOV L (OpReg src1) (OpReg ecx))
- else
- registerCode register1 ecx
- code__2 =
- let
- code2 = registerCode register2 eax
- src2 = registerName register2 eax
- in
- code1 . code2 .
- mkSeqInstr (instr (OpReg ecx) (OpReg eax))
+ = getRegister x `thenUs` \ register1 ->
+ getRegister y `thenUs` \ register2 ->
+ getUniqLabelNCG `thenUs` \ lbl_test3 ->
+ getUniqLabelNCG `thenUs` \ lbl_test2 ->
+ getUniqLabelNCG `thenUs` \ lbl_test1 ->
+ getUniqLabelNCG `thenUs` \ lbl_test0 ->
+ getUniqLabelNCG `thenUs` \ lbl_after ->
+ getNewRegNCG IntRep `thenUs` \ tmp ->
+ let code__2 dst
+ = let src_val = registerName register1 dst
+ code_val = registerCode register1 dst
+ src_amt = registerName register2 tmp
+ code_amt = registerCode register2 tmp
+ r_dst = OpReg dst
+ r_tmp = OpReg tmp
+ in
+ code_val .
+ code_amt .
+ mkSeqInstrs [
+ COMMENT (_PK_ "begin shift sequence"),
+ MOV L (OpReg src_val) r_dst,
+ MOV L (OpReg src_amt) r_tmp,
+
+ BT L (ImmInt 4) r_tmp,
+ JXX GEU lbl_test3,
+ instr (ImmInt 16) r_dst,
+
+ LABEL lbl_test3,
+ BT L (ImmInt 3) r_tmp,
+ JXX GEU lbl_test2,
+ instr (ImmInt 8) r_dst,
+
+ LABEL lbl_test2,
+ BT L (ImmInt 2) r_tmp,
+ JXX GEU lbl_test1,
+ instr (ImmInt 4) r_dst,
+
+ LABEL lbl_test1,
+ BT L (ImmInt 1) r_tmp,
+ JXX GEU lbl_test0,
+ instr (ImmInt 2) r_dst,
+
+ LABEL lbl_test0,
+ BT L (ImmInt 0) r_tmp,
+ JXX GEU lbl_after,
+ instr (ImmInt 1) r_dst,
+ LABEL lbl_after,
+
+ COMMENT (_PK_ "end shift sequence")
+ ]
in
- returnUs (Fixed IntRep eax code__2)
+ returnUs (Any IntRep code__2)
--------------------
add_code :: Size -> StixTree -> StixTree -> UniqSM Register
src2 = ImmInt (fromInteger y)
code__2 dst
= code .
- mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2))
+ mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2))
(OpReg dst))
in
returnUs (Any IntRep code__2)
code dst = mkSeqInstr (MOV L (OpImm imm__2) (OpReg dst))
in
returnUs (Any PtrRep code)
+ | otherwise
+ = pprPanic "getRegister(x86)" (pprStixTrees [leaf])
where
imm = maybeImm leaf
imm__2 = case imm of Just x -> x
in
returnUs (Amode (AddrBaseIndex (Just reg) Nothing off) code)
-getAmode (StPrim IntAddOp [x, y])
+getAmode (StPrim IntAddOp [x, StPrim SllOp [y, StInt shift]])
+ | shift == 0 || shift == 1 || shift == 2 || shift == 3
= getNewRegNCG PtrRep `thenUs` \ tmp1 ->
getNewRegNCG IntRep `thenUs` \ tmp2 ->
getRegister x `thenUs` \ register1 ->
code2 = registerCode register2 tmp2 asmVoid
reg2 = registerName register2 tmp2
code__2 = asmParThen [code1, code2]
+ base = case shift of 0 -> 1 ; 1 -> 2; 2 -> 4; 3 -> 8
in
- returnUs (Amode (AddrBaseIndex (Just reg1) (Just (reg2,4)) (ImmInt 0)) code__2)
+ returnUs (Amode (AddrBaseIndex (Just reg1) (Just (reg2,base)) (ImmInt 0))
+ code__2)
getAmode leaf
| maybeToBool imm
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#if i386_TARGET_ARCH
-assignIntCode pk (StInd _ dst) src
+assignIntCode pk dd@(StInd _ dst) src
= getAmode dst `thenUs` \ amode ->
- get_op_RI src `thenUs` \ (codesrc, opsrc, sz) ->
+ get_op_RI src `thenUs` \ (codesrc, opsrc) ->
let
code1 = amodeCode amode asmVoid
dst__2 = amodeAddr amode
code__2 = asmParThen [code1, codesrc asmVoid] .
- mkSeqInstr (MOV sz opsrc (OpAddr dst__2))
+ mkSeqInstr (MOV (primRepToSize pk) opsrc (OpAddr dst__2))
in
returnUs code__2
where
get_op_RI
:: StixTree
- -> UniqSM (InstrBlock,Operand, Size) -- code, operator, size
+ -> UniqSM (InstrBlock,Operand) -- code, operator
get_op_RI op
| maybeToBool imm
- = returnUs (asmParThen [], OpImm imm_op, L)
+ = returnUs (asmParThen [], OpImm imm_op)
where
imm = maybeImm op
imm_op = case imm of Just x -> x
let
code = registerCode register tmp
reg = registerName register tmp
- pk = registerRep register
- sz = primRepToSize pk
in
- returnUs (code, OpReg reg, sz)
+ returnUs (code, OpReg reg)
-assignIntCode pk dst (StInd _ src)
+assignIntCode pk dst (StInd pks src)
= getNewRegNCG IntRep `thenUs` \ tmp ->
getAmode src `thenUs` \ amode ->
getRegister dst `thenUs` \ register ->
src__2 = amodeAddr amode
code2 = registerCode register tmp asmVoid
dst__2 = registerName register tmp
- sz = primRepToSize pk
+ szs = primRepToSize pks
code__2 = asmParThen [code1, code2] .
- mkSeqInstr (MOV sz (OpAddr src__2) (OpReg dst__2))
+ case szs of
+ L -> mkSeqInstr (MOV L (OpAddr src__2) (OpReg dst__2))
+ B -> mkSeqInstr (MOVZxL B (OpAddr src__2) (OpReg dst__2))
in
returnUs code__2
genCCall fn cconv kind args
- = mapUs get_call_arg args `thenUs` \ sizes_and_argCodes ->
+ = get_call_args args `thenUs` \ (tot_arg_size, argCode) ->
let
- (sizes, argCode) = unzip sizes_and_argCodes
- tot_arg_size = sum (map (\sz -> case sz of DF -> 8; _ -> 4) sizes)
-
- code2 = asmParThen (map ($ asmVoid) (reverse argCode))
- call = [CALL fn__2 ,
+ code2 = asmParThen (map ($ asmVoid) argCode)
+ call = [SUB L (OpImm (ImmInt tot_arg_size)) (OpReg esp),
+ CALL fn__2 ,
ADD L (OpImm (ImmInt tot_arg_size)) (OpReg esp)
]
in
- returnSeq (code2) call
+ returnSeq code2 call
where
-- function names that begin with '.' are assumed to be special
'.' -> ImmLit (ptext fn)
_ -> ImmLab (ptext fn)
+ arg_size DF = 8
+ arg_size F = 8
+ arg_size _ = 4
+
+ ------------
+ -- do get_call_arg on each arg, threading the total arg size along
+ -- process the args right-to-left
+ get_call_args :: [StixTree] -> UniqSM (Int, [InstrBlock])
+ get_call_args args
+ = f 0 args
+ where
+ f curr_sz []
+ = returnUs (curr_sz, [])
+ f curr_sz (arg:args)
+ = f curr_sz args `thenUs` \ (new_sz, iblocks) ->
+ get_call_arg arg new_sz `thenUs` \ (new_sz2, iblock) ->
+ returnUs (new_sz2, iblock:iblocks)
+
+
------------
- get_call_arg :: StixTree{-current argument-}
- -> UniqSM (Size, InstrBlock) -- arg size, code
-
- get_call_arg arg
- = get_op arg `thenUs` \ (code, op, sz) ->
- case sz of
- DF -> --getNewRegNCG DoubleRep `thenUs` \ tmp ->
- returnUs (sz,
+ get_call_arg :: StixTree{-current argument-}
+ -> Int{-running total of arg sizes seen so far-}
+ -> UniqSM (Int, InstrBlock) -- updated tot argsz, code
+
+ get_call_arg arg old_sz
+ = get_op arg `thenUs` \ (code, reg, sz) ->
+ let new_sz = old_sz + arg_size sz
+ in if (case sz of DF -> True; F -> True; _ -> False)
+ then returnUs (new_sz,
code .
- --mkSeqInstr (GLD DF op tmp) .
- mkSeqInstr (SUB L (OpImm (ImmInt 8)) (OpReg esp)) .
- mkSeqInstr (GST DF {-tmp-}op (AddrBaseIndex
- (Just esp)
- Nothing (ImmInt 0)))
+ mkSeqInstr (GST DF reg
+ (AddrBaseIndex (Just esp)
+ Nothing (ImmInt (- new_sz))))
+ )
+ else returnUs (new_sz,
+ code .
+ mkSeqInstr (MOV L (OpReg reg)
+ (OpAddr
+ (AddrBaseIndex (Just esp)
+ Nothing (ImmInt (- new_sz)))))
)
- _ -> returnUs (sz,
- code . mkSeqInstr (PUSH sz (OpReg op)))
-
------------
get_op
:: StixTree
- -> UniqSM (InstrBlock, {-Operand-}Reg, Size) -- code, operator, size
-{-
- get_op (StInt i)
- = returnUs (asmParThen [], OpImm (ImmInt (fromInteger i)), L)
+ -> UniqSM (InstrBlock, Reg, Size) -- code, reg, size
- get_op (StInd pk mem)
- = getAmode mem `thenUs` \ amode ->
- let
- code = amodeCode amode --asmVoid
- addr = amodeAddr amode
- sz = primRepToSize pk
- in
- returnUs (code, OpAddr addr, sz)
--}
get_op op
= getRegister op `thenUs` \ register ->
getNewRegNCG (registerRep register)
pk = registerRep register
sz = primRepToSize pk
in
- returnUs (code, {-OpReg-} reg, sz)
+ returnUs (code, reg, sz)
#endif {- i386_TARGET_ARCH -}
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
code__2 dst = let code1 = registerCode register1 dst
src1 = registerName register1 dst
in code1 .
- if isFixed register1 && src1 /= dst
+ if isFixed register1 && src1 /= dst
then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
instr (OpImm imm__2) (OpReg dst)]
- else
- mkSeqInstrs [instr (OpImm imm__2) (OpReg src1)]
+ else mkSeqInstrs [instr (OpImm imm__2) (OpReg src1)]
in
returnUs (Any IntRep code__2)
where
imm__2 = case imm of Just x -> x
trivialCode instr x y
- | maybeToBool imm
- = getRegister y `thenUs` \ register1 ->
- let
- code__2 dst = let code1 = registerCode register1 dst
- src1 = registerName register1 dst
- in code1 .
- if isFixed register1 && src1 /= dst
- then mkSeqInstrs [MOV L (OpImm imm__2) (OpReg dst),
- instr (OpReg src1) (OpReg dst)]
- else
- mkSeqInstr (instr (OpImm imm__2) (OpReg src1))
- in
- returnUs (Any IntRep code__2)
- where
- imm = maybeImm x
- imm__2 = case imm of Just x -> x
-
-trivialCode instr x y
= getRegister x `thenUs` \ register1 ->
getRegister y `thenUs` \ register2 ->
getNewRegNCG IntRep `thenUs` \ tmp2 ->
let
- code2 = registerCode register2 tmp2 asmVoid
+ code2 = registerCode register2 tmp2 --asmVoid
src2 = registerName register2 tmp2
- code__2 dst = let
- code1 = registerCode register1 dst asmVoid
+ code__2 dst = let code1 = registerCode register1 dst --asmVoid
src1 = registerName register1 dst
- in asmParThen [code1, code2] .
- if isFixed register1 && src1 /= dst
+ in code2 . code1 . --asmParThen [code1, code2] .
+ if isFixed register1 && src1 /= dst
then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
instr (OpReg src2) (OpReg dst)]
- else
- mkSeqInstr (instr (OpReg src2) (OpReg src1))
+ else mkSeqInstr (instr (OpReg src2) (OpReg src1))
in
returnUs (Any IntRep code__2)
trivialUCode instr x
= getRegister x `thenUs` \ register ->
let
- code__2 dst = let
- code = registerCode register dst
+ 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),
- instr (OpReg dst)]
- else mkSeqInstr (instr (OpReg src))
+ in code .
+ if isFixed register && dst /= src
+ then mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
+ instr (OpReg dst)]
+ else mkSeqInstr (instr (OpReg src))
in
returnUs (Any IntRep code__2)
-----------
-{-
-trivialFCode pk _ instrr _ _ (StInd pk' mem) y
- = getRegister y `thenUs` \ register2 ->
- getAmode mem `thenUs` \ amode ->
- let
- code1 = amodeCode amode
- src1 = amodeAddr amode
-
- code__2 dst = let
- code2 = registerCode register2 dst
- src2 = registerName register2 dst
- in asmParThen [code1 asmVoid,code2 asmVoid] .
- mkSeqInstrs [instrr (primRepToSize pk) (OpAddr src1)]
- in
- returnUs (Any pk code__2)
-
-trivialFCode pk instr _ _ _ x (StInd pk' mem)
- = getRegister x `thenUs` \ register1 ->
- getAmode mem `thenUs` \ amode ->
- let
- code2 = amodeCode amode
- src2 = amodeAddr amode
-
- code__2 dst = let
- code1 = registerCode register1 dst
- src1 = registerName register1 dst
- in asmParThen [code2 asmVoid,code1 asmVoid] .
- mkSeqInstrs [instr (primRepToSize pk) (OpAddr src2)]
- in
- returnUs (Any pk code__2)
-
-trivialFCode pk _ _ _ instrpr x y
- = getRegister x `thenUs` \ register1 ->
- getRegister y `thenUs` \ register2 ->
- getNewRegNCG DoubleRep `thenUs` \ tmp ->
- let
- pk1 = registerRep register1
- code1 = registerCode register1 st0 --tmp1
- src1 = registerName register1 st0 --tmp1
-
- pk2 = registerRep register2
-
- code__2 dst = let
- code2 = registerCode register2 dst
- src2 = registerName register2 dst
- in asmParThen [code1 asmVoid, code2 asmVoid] .
- mkSeqInstr instrpr
- in
- returnUs (Any pk1 code__2)
--}
-
trivialFCode pk instr x y
= getRegister x `thenUs` \ register1 ->
getRegister y `thenUs` \ register2 ->
in
returnUs (Any pk code__2)
-{-
-trivialUFCode pk instr (StInd pk' mem)
- = getAmode mem `thenUs` \ amode ->
- let
- code = amodeCode amode
- src = amodeAddr amode
- code__2 dst = code . mkSeqInstrs [FLD (primRepToSize pk) (OpAddr src),
- instr]
- in
- returnUs (Any pk code__2)
-
-trivialUFCode pk instr x
- = getRegister x `thenUs` \ register ->
- let
- code__2 dst = let
- code = registerCode register dst
- src = registerName register dst
- in code . mkSeqInstrs [instr]
- in
- returnUs (Any pk code__2)
--}
#endif {- i386_TARGET_ARCH -}
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#if sparc_TARGET_ARCH
chrCode x
= getRegister x `thenUs` \ register ->
- --getNewRegNCG IntRep `thenUs` \ reg ->
let
code__2 dst = let
code = registerCode register dst
projects / ghc-hetmet.git / blobdiff