X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FMachCode.lhs;h=41f8410ea1681e9c3342334fc16705a282256908;hb=85ef3b326950dc22db60a78ed8ea7702562c298e;hp=7ba0869e08bf76a13184ae4bfaab93052575588d;hpb=e2a7f07969b47fef0cdf284e1bf98a0ad7b01d76;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index 7ba0869..41f8410 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/ghc/compiler/nativeGen/MachCode.lhs @@ -27,7 +27,8 @@ import PrimRep ( isFloatingRep, PrimRep(..) ) import PrimOp ( PrimOp(..) ) import CallConv ( cCallConv ) import Stix ( getUniqLabelNCG, StixTree(..), - StixReg(..), CodeSegment(..) + StixReg(..), CodeSegment(..), + pprStixTrees, ppStixReg ) import UniqSupply ( returnUs, thenUs, mapUs, mapAndUnzipUs, mapAccumLUs, UniqSM @@ -44,30 +45,7 @@ stmt2Instrs stmt = case stmt of 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) @@ -152,29 +130,17 @@ mangleIndexTree (StIndex pk base (StInt i)) 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,), --- 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} @@ -235,7 +201,7 @@ getRegister :: StixTree -> UniqSM Register 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) @@ -517,6 +483,11 @@ getRegister (StDouble d) 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 @@ -529,6 +500,15 @@ getRegister (StPrim primop [x]) -- unary PrimOps 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 @@ -553,9 +533,9 @@ getRegister (StPrim primop [x]) -- unary PrimOps 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")) @@ -568,9 +548,9 @@ getRegister (StPrim primop [x]) -- unary PrimOps 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")) @@ -580,6 +560,10 @@ getRegister (StPrim primop [x]) -- unary PrimOps 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 @@ -624,15 +608,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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-} @@ -657,9 +633,8 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps => 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-} @@ -669,10 +644,13 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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 @@ -682,21 +660,16 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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 @@ -704,32 +677,65 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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 @@ -743,7 +749,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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) @@ -889,6 +895,8 @@ getRegister leaf 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 @@ -1179,7 +1187,8 @@ getAmode (StPrim IntAddOp [x, StInt i]) 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 -> @@ -1190,8 +1199,10 @@ getAmode (StPrim IntAddOp [x, y]) 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 @@ -1606,24 +1617,24 @@ assignIntCode pk dst src -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #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 @@ -1635,12 +1646,10 @@ assignIntCode pk (StInd _ dst) src 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 -> @@ -1649,9 +1658,11 @@ assignIntCode pk dst (StInd _ src) 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 @@ -2262,17 +2273,15 @@ genCCall fn cconv kind [StInt i] 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 @@ -2283,42 +2292,52 @@ genCCall fn cconv kind args '.' -> 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) @@ -2329,7 +2348,7 @@ genCCall fn cconv kind args pk = registerRep register sz = primRepToSize pk in - returnUs (code, {-OpReg-} reg, sz) + returnUs (code, reg, sz) #endif {- i386_TARGET_ARCH -} -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -2712,11 +2731,10 @@ trivialCode instr x y 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 @@ -2724,39 +2742,19 @@ trivialCode instr x y 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) @@ -2764,68 +2762,17 @@ trivialCode instr x y 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 -> @@ -2855,27 +2802,6 @@ trivialUFCode pk instr x 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 @@ -3135,7 +3061,6 @@ chrCode x chrCode x = getRegister x `thenUs` \ register -> - --getNewRegNCG IntRep `thenUs` \ reg -> let code__2 dst = let code = registerCode register dst