Commit 85ef3b32 authored by sewardj's avatar sewardj
Browse files

[project @ 2000-02-01 14:02:02 by sewardj]

-- Cosmetic changes in register allocator.

-- Implement macro HP_GEN_SEQ_NP.

-- MachCode(trivialCode, x86): because one of the operands is also
   the destination (on this 2-address arch), it's invalid to sequence
   the code to compute the operands using asmParThen [code1, code2].
   since the order of assignments matters.  Fixed.
parent 298e7a78
......@@ -10,6 +10,7 @@ module AsmRegAlloc ( runRegAllocate, runHairyRegAllocate ) where
import MachCode ( InstrList )
import MachMisc ( Instr )
import PprMach ( pprUserReg ) -- debugging
import MachRegs
import RegAllocInfo
......@@ -41,16 +42,11 @@ runRegAllocate regs find_reserve_regs instrs
Nothing -> tryHairy reserves
where
tryHairy []
= error "nativeGen: register allocator: too difficult! Try -fvia-C.\n"
= error "nativeGen: spilling failed. Try -fvia-C.\n"
tryHairy (resv:resvs)
= case hairyAlloc resv of
Just success -> success
Nothing -> fooble resvs (tryHairy resvs)
fooble [] x = x
fooble (resvs:_) x = trace ("nativeGen: spilling with "
++ show (length resvs - 2) ++
" int temporaries") x
Nothing -> tryHairy resvs
reserves = find_reserve_regs flatInstrs
flatInstrs = flattenOrdList instrs
......@@ -168,17 +164,25 @@ hairyRegAlloc regs reserve_regs instrs =
noFuture instrs_patched of
((RH _ mloc2 _),_,instrs'')
-- successfully allocated the patched code
| mloc2 == mloc1 -> Just instrs''
| mloc2 == mloc1 -> trace (spillMsg True) (Just instrs'')
-- no; we have to give up
| otherwise -> Nothing
| otherwise -> trace (spillMsg False) Nothing
-- instrs''
-- pprPanic "runRegAllocate" (ppr mloc2 <+> ppr mloc1)
where
regs' = regs `useMRegs` reserve_regs
regs'' = mkMRegsState reserve_regs
noFuture :: RegFuture
noFuture = RF emptyRegSet (FL emptyRegSet emptyFM) emptyFM
spillMsg success
= "nativeGen: spilling "
++ (if success then "succeeded" else "failed ")
++ " using "
++ showSDoc (hsep (map (pprUserReg.toMappedReg)
(reverse reserve_regs)))
where
toMappedReg (I# i) = MappedReg i
\end{code}
Here we patch instructions that reference ``registers'' which are really in
......
......@@ -483,8 +483,10 @@ getRegister (StDouble d)
in
returnUs (Any DoubleRep code)
-- incorrectly assumes that %esp doesn't move (as does spilling); ToDo: fix
getRegister (StScratchWord i)
= let code dst = mkSeqInstr (LEA L (OpAddr (spRel (-1000+i))) (OpReg dst))
| 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
......@@ -2476,10 +2478,10 @@ condIntReg cond x y
code = condCode condition
cond = condName condition
-- ToDo: if dst is eax, ebx, ecx, or edx we would not need the move.
code__2 dst = code . mkSeqInstrs [COMMENT (_PK_ "aaaaa"),
code__2 dst = code . mkSeqInstrs [
SETCC cond (OpReg tmp),
AND L (OpImm (ImmInt 1)) (OpReg tmp),
MOV L (OpReg tmp) (OpReg dst) ,COMMENT (_PK_ "bbbbb")]
MOV L (OpReg tmp) (OpReg dst)]
in
returnUs (Any IntRep code__2)
......@@ -2729,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
......@@ -2745,17 +2746,15 @@ trivialCode instr x y
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)
......@@ -2763,13 +2762,13 @@ 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)
......
......@@ -10,7 +10,7 @@ We start with the @pprXXX@s with some cross-platform commonality
\begin{code}
#include "nativeGen/NCG.h"
module PprMach ( pprInstr, pprSize ) where
module PprMach ( pprInstr, pprSize, pprUserReg ) where
#include "HsVersions.h"
......@@ -38,6 +38,10 @@ import Char ( ord )
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 = pprReg IF_ARCH_i386(L,)
pprReg :: IF_ARCH_i386(Size ->,) Reg -> SDoc
pprReg IF_ARCH_i386(s,) r
......@@ -94,49 +98,16 @@ pprReg IF_ARCH_i386(s,) r
_ -> SLIT("very naughty I386 byte register")
})
{- UNUSED:
ppr_reg_no HB i = ptext
(case i of {
ILIT( 0) -> SLIT("%ah"); ILIT( 1) -> SLIT("%bh");
ILIT( 2) -> SLIT("%ch"); ILIT( 3) -> SLIT("%dh");
_ -> SLIT("very naughty I386 high byte register")
})
-}
{- UNUSED:
ppr_reg_no S i = ptext
(case i of {
ILIT( 0) -> SLIT("%ax"); ILIT( 1) -> SLIT("%bx");
ILIT( 2) -> SLIT("%cx"); ILIT( 3) -> SLIT("%dx");
ILIT( 4) -> SLIT("%si"); ILIT( 5) -> SLIT("%di");
ILIT( 6) -> SLIT("%bp"); ILIT( 7) -> SLIT("%sp");
_ -> SLIT("very naughty I386 word register")
})
-}
ppr_reg_no L i = ptext
ppr_reg_no _ i = ptext
(case i of {
ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx");
ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx");
ILIT( 4) -> SLIT("%esi"); ILIT( 5) -> SLIT("%edi");
ILIT( 6) -> SLIT("%ebp"); ILIT( 7) -> SLIT("%esp");
_ -> SLIT("very naughty I386 double word register")
})
ppr_reg_no F i = ptext
(case i of {
ILIT( 8) -> SLIT("%fake0"); ILIT( 9) -> SLIT("%fake1");
ILIT(10) -> SLIT("%fake2"); ILIT(11) -> SLIT("%fake3");
ILIT(12) -> SLIT("%fake4"); ILIT(13) -> SLIT("%fake5");
_ -> SLIT("very naughty I386 float register")
})
ppr_reg_no DF i = ptext
(case i of {
ILIT( 8) -> SLIT("%fake0"); ILIT( 9) -> SLIT("%fake1");
ILIT(10) -> SLIT("%fake2"); ILIT(11) -> SLIT("%fake3");
ILIT(12) -> SLIT("%fake4"); ILIT(13) -> SLIT("%fake5");
_ -> SLIT("very naughty I386 float register")
_ -> SLIT("very naughty I386 register")
})
#endif
#if sparc_TARGET_ARCH
......
......@@ -252,6 +252,11 @@ checkCode macro args assts
in (\xs -> assign_hp words : cjmp_hp :
assts (gc_enter ptrs : join : xs))
HP_CHK_SEQ_NP ->
let [words,ptrs] = args_stix
in (\xs -> assign_hp words : cjmp_hp :
assts (gc_seq ptrs : join : xs))
STK_CHK_NP ->
let [words,ptrs] = args_stix
in (\xs -> cjmp_sp_pass words :
......@@ -309,7 +314,8 @@ checkCode macro args assts
HP_CHK_UT_ALT ->
let [words,ptrs,nonptrs,r,ret] = args_stix
in (\xs -> assign_hp words : cjmp_hp :
assts (assign_ret r ret : gc_ut ptrs nonptrs : join : xs))
assts (assign_ret r ret : gc_ut ptrs nonptrs
: join : xs))
HP_CHK_GEN ->
let [words,liveness,reentry] = args_stix
......@@ -321,8 +327,12 @@ checkCode macro args assts
-- Various canned heap-check routines
gc_chk (StInt n) = StJump (StLitLbl (ptext SLIT("stg_chk_") <> int (fromInteger n)))
gc_enter (StInt n) = StJump (StLitLbl (ptext SLIT("stg_gc_enter_") <> int (fromInteger n)))
gc_chk (StInt n) = StJump (StLitLbl (ptext SLIT("stg_chk_")
<> int (fromInteger n)))
gc_enter (StInt n) = StJump (StLitLbl (ptext SLIT("stg_gc_enter_")
<> int (fromInteger n)))
gc_seq (StInt n) = StJump (StLitLbl (ptext SLIT("stg_gc_seq_")
<> int (fromInteger n)))
gc_noregs = StJump (StLitLbl (ptext SLIT("stg_gc_noregs")))
gc_unpt_r1 = StJump (StLitLbl (ptext SLIT("stg_gc_unpt_r1")))
gc_unbx_r1 = StJump (StLitLbl (ptext SLIT("stg_gc_unbx_r1")))
......@@ -331,6 +341,7 @@ gc_d1 = StJump (StLitLbl (ptext SLIT("stg_gc_d1")))
gc_gen = StJump (StLitLbl (ptext SLIT("stg_gen_chk")))
gc_ut (StInt p) (StInt np)
= StJump (StLitLbl (ptext SLIT("stg_gc_ut_") <> int (fromInteger p)
= StJump (StLitLbl (ptext SLIT("stg_gc_ut_")
<> int (fromInteger p)
<> char '_' <> int (fromInteger np)))
\end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment