From a040ea4a643d8113a023ec7ed880b1e33726b4f4 Mon Sep 17 00:00:00 2001 From: sewardj Date: Wed, 2 Feb 2000 11:40:33 +0000 Subject: [PATCH 1/1] [project @ 2000-02-02 11:40:33 by sewardj] trivialCode on x86 is the heart of instruction selection for expressions. It is definitely a non-trivial in complexity. To generate correct code it needs to observe preserve several delicate invariants, but didn't. -- Recorded in MachCode.lhs the "Rules of the Game"; ie what I think the required invariants are. -- Completely rewrote trivialCode (also shift_code). I think it should handle all cases correctly, and has special treatment for literal operands. -- Updated NOTES file to record issues which need to be resolved before x86 nativeGen can be considered ready for public use. --- ghc/compiler/nativeGen/AsmCodeGen.lhs | 11 +- ghc/compiler/nativeGen/MachCode.lhs | 214 ++++++++++++++++++++++++--------- ghc/compiler/nativeGen/NOTES | 30 ++++- 3 files changed, 191 insertions(+), 64 deletions(-) diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs index 31c3825..fe2fcbf 100644 --- a/ghc/compiler/nativeGen/AsmCodeGen.lhs +++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs @@ -19,7 +19,7 @@ import PprMach import AbsCStixGen ( genCodeAbstractC ) import AbsCSyn ( AbstractC, MagicId ) import AsmRegAlloc ( runRegAllocate ) -import OrdList ( OrdList ) +import OrdList ( OrdList, flattenOrdList ) import PrimOp ( commutableOp, PrimOp(..) ) import RegAllocInfo ( mkMRegsState, MRegsState, findReservedRegs ) import Stix ( StixTree(..), StixReg(..), @@ -104,12 +104,19 @@ codeGen stixFinal static_instrss :: [[Instr]] static_instrss = map fp_kludge (scheduleMachCode dynamic_codes) - docs = map (vcat . map pprInstr) static_instrss + docs = map (vcat . map pprInstr) static_instrss + + -- for debugging only + docs_prealloc = map (vcat . map pprInstr . flattenOrdList) + dynamic_codes + text_prealloc = vcat (intersperse (char ' ' $$ char ' ') docs_prealloc) in + -- trace (showSDoc text_prealloc) ( returnUs (vcat (intersperse (char ' ' $$ text "# ___stg_split_marker" $$ char ' ') docs)) + -- ) \end{code} Top level code generator for a chunk of stix code: diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index 41f8410..fb88fc6 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/ghc/compiler/nativeGen/MachCode.lhs @@ -181,17 +181,25 @@ registerCode :: Register -> Reg -> InstrBlock registerCode (Fixed _ _ code) reg = code registerCode (Any _ code) reg = code reg +registerCodeF (Fixed _ _ code) = code +registerCodeF (Any _ _) = pprPanic "registerCodeF" empty + registerName :: Register -> Reg -> Reg registerName (Fixed _ reg _) _ = reg -registerName (Any _ _) reg = reg +registerName (Any _ _) reg = reg + +registerNameF (Fixed _ reg _) = reg +registerNameF (Any _ _) = pprPanic "registerNameF" empty registerRep :: Register -> PrimRep registerRep (Fixed pk _ _) = pk registerRep (Any pk _) = pk -isFixed :: Register -> Bool +isFixed, isFloat :: Register -> Bool isFixed (Fixed _ _ _) = True isFixed (Any _ _) = False + +isFloat = not . isFixed \end{code} Generate code to get a subtree into a @Register@: @@ -612,7 +620,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps IntSubOp -> sub_code L x y IntQuotOp -> quot_code L x y True{-division-} IntRemOp -> quot_code L x y False{-remainder-} - IntMulOp -> trivialCode (IMUL L) x y {-True-} + IntMulOp -> let op = IMUL L in trivialCode op (Just op) x y FloatAddOp -> trivialFCode FloatRep GADD x y FloatSubOp -> trivialFCode FloatRep GSUB x y @@ -624,9 +632,9 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps DoubleMulOp -> trivialFCode DoubleRep GMUL x y DoubleDivOp -> trivialFCode DoubleRep GDIV x y - AndOp -> trivialCode (AND L) x y {-True-} - OrOp -> trivialCode (OR L) x y {-True-} - XorOp -> trivialCode (XOR L) x y {-True-} + AndOp -> let op = AND L in trivialCode op (Just op) x y + OrOp -> let op = OR L in trivialCode op (Just op) x y + XorOp -> let op = XOR L in trivialCode op (Just op) x y {- Shift ops on x86s have constraints on their source, it either has to be Imm, CL or 1 @@ -659,19 +667,19 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps -- Code is the same as the first eq. for trivialCode -- sigh. shift_code instr x y{-amount-} | maybeToBool imm - = getRegister x `thenUs` \ register -> - let op_imm = OpImm imm__2 - code__2 dst = - let code = registerCode register dst - src = registerName register dst - in - code . - if isFixed register && src /= dst - 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) + = getRegister x `thenUs` \ regx -> + let mkcode dst + = if isFloat regx + then registerCode regx dst `bind` \ code_x -> + code_x . + mkSeqInstr (instr imm__2 (OpReg dst)) + else registerCodeF regx `bind` \ code_x -> + registerNameF regx `bind` \ r_x -> + code_x . + mkSeqInstr (MOV L (OpReg r_x) (OpReg dst)) . + mkSeqInstr (instr imm__2 (OpReg dst)) + in + returnUs (Any IntRep mkcode) where imm = maybeImm y imm__2 = case imm of Just x -> x @@ -700,8 +708,10 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps r_dst = OpReg dst r_tmp = OpReg tmp in - code_val . code_amt . + mkSeqInstr (MOV L (OpReg src_amt) r_tmp) . + code_val . + mkSeqInstr (MOV L (OpReg src_val) r_dst) . mkSeqInstrs [ COMMENT (_PK_ "begin shift sequence"), MOV L (OpReg src_val) r_dst, @@ -789,7 +799,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps in returnUs (Any IntRep code__2) - sub_code sz x y = trivialCode (SUB sz) x y {-False-} + sub_code sz x y = trivialCode (SUB sz) Nothing x y -------------------- quot_code @@ -803,6 +813,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps -- edx:eax / reg -> eax (remainder in edx) Currently we chose to -- put y in memory (if it is not there already) + -- quot_code needs further checking in the Rules-of-the-Game(x86) audit quot_code sz x (StInd pk mem) is_division = getRegister x `thenUs` \ register1 -> getNewRegNCG IntRep `thenUs` \ tmp1 -> @@ -1380,6 +1391,7 @@ condFltCode = panic "MachCode.condFltCode: not on Alphas" -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #if i386_TARGET_ARCH +-- some condIntCode clauses look pretty dodgy to me condIntCode cond (StInd _ x) y | maybeToBool imm = getAmode x `thenUs` \ amode -> @@ -1401,7 +1413,7 @@ condIntCode cond x (StInt 0) code1 = registerCode register1 tmp1 asmVoid src1 = registerName register1 tmp1 code__2 = asmParThen [code1] . - mkSeqInstr (TEST L (OpReg src1) (OpReg src1)) + mkSeqInstr (TEST L (OpReg src1) (OpReg src1)) in returnUs (CondCode False cond code__2) @@ -1413,7 +1425,7 @@ condIntCode cond x y code1 = registerCode register1 tmp1 asmVoid src1 = registerName register1 tmp1 code__2 = asmParThen [code1] . - mkSeqInstr (CMP L (OpImm imm__2) (OpReg src1)) + mkSeqInstr (CMP L (OpImm imm__2) (OpReg src1)) in returnUs (CondCode False cond code__2) where @@ -1617,6 +1629,7 @@ assignIntCode pk dst src -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #if i386_TARGET_ARCH +-- looks dodgy to me assignIntCode pk dd@(StInd _ dst) src = getAmode dst `thenUs` \ amode -> get_op_RI src `thenUs` \ (codesrc, opsrc) -> @@ -2620,7 +2633,8 @@ have handled the constant-folding. \begin{code} trivialCode :: IF_ARCH_alpha((Reg -> RI -> Reg -> Instr) - ,IF_ARCH_i386 ((Operand -> Operand -> Instr) + ,IF_ARCH_i386 ((Operand -> Operand -> Instr) + -> Maybe (Operand -> Operand -> Instr) ,IF_ARCH_sparc((Reg -> RI -> Reg -> Instr) ,))) -> StixTree -> StixTree -- the two arguments @@ -2723,40 +2737,128 @@ trivialUFCode _ instr x #endif {- alpha_TARGET_ARCH -} -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #if i386_TARGET_ARCH +\end{code} +The Rules of the Game are: -trivialCode instr x y - | maybeToBool imm - = getRegister x `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 (OpReg src1) (OpReg dst), - instr (OpImm imm__2) (OpReg dst)] - else mkSeqInstrs [instr (OpImm imm__2) (OpReg src1)] - in - returnUs (Any IntRep code__2) - where - imm = maybeImm y - imm__2 = case imm of Just x -> x +* You cannot assume anything about the destination register dst; + it may be anything, includind a fixed reg. + +* You may compute a value into a fixed reg, but you may not + subsequently change the contents of that fixed reg. If you + want to do so, first copy the value either to a temporary + or into dst. You are free to modify dst even if it happens + to be a fixed reg -- that's not your problem. + +* You cannot assume that a fixed reg will stay live over an + arbitrary computation. The same applies to the dst reg. + +* Temporary regs obtained from getNewRegNCG are distinct from + all other regs, and stay live over arbitrary computations. + +\begin{code} + +infixr 3 `bind` +x `bind` f = f x + +trivialCode instr maybe_revinstr a b + + | is_imm_b + = getRegister a `thenUs` \ rega -> + let mkcode dst + = if isFloat rega + then registerCode rega dst `bind` \ code_a -> + code_a . + mkSeqInstr (instr (OpImm imm_b) (OpReg dst)) + else registerCodeF rega `bind` \ code_a -> + registerNameF rega `bind` \ r_a -> + code_a . + mkSeqInstr (MOV L (OpReg r_a) (OpReg dst)) . + mkSeqInstr (instr (OpImm imm_b) (OpReg dst)) + in + returnUs (Any IntRep mkcode) + + | is_imm_a + = getRegister b `thenUs` \ regb -> + getNewRegNCG IntRep `thenUs` \ tmp -> + let revinstr_avail = maybeToBool maybe_revinstr + revinstr = case maybe_revinstr of Just ri -> ri + mkcode dst + | revinstr_avail + = if isFloat regb + then registerCode regb dst `bind` \ code_b -> + code_b . + mkSeqInstr (revinstr (OpImm imm_a) (OpReg dst)) + else registerCodeF regb `bind` \ code_b -> + registerNameF regb `bind` \ r_b -> + code_b . + mkSeqInstr (MOV L (OpReg r_b) (OpReg dst)) . + mkSeqInstr (revinstr (OpImm imm_a) (OpReg dst)) + + | otherwise + = if isFloat regb + then registerCode regb tmp `bind` \ code_b -> + code_b . + mkSeqInstr (MOV L (OpImm imm_a) (OpReg dst)) . + mkSeqInstr (instr (OpReg tmp) (OpReg dst)) + else registerCodeF regb `bind` \ code_b -> + registerNameF regb `bind` \ r_b -> + code_b . + mkSeqInstr (MOV L (OpReg r_b) (OpReg tmp)) . + mkSeqInstr (MOV L (OpImm imm_a) (OpReg dst)) . + mkSeqInstr (instr (OpReg tmp) (OpReg dst)) + in + returnUs (Any IntRep mkcode) + + | otherwise + = getRegister a `thenUs` \ rega -> + getRegister b `thenUs` \ regb -> + getNewRegNCG IntRep `thenUs` \ tmp -> + let mkcode dst + = case (isFloat rega, isFloat regb) of + (True, True) + -> registerCode regb tmp `bind` \ code_b -> + registerCode rega dst `bind` \ code_a -> + code_b . + code_a . + mkSeqInstr (instr (OpReg tmp) (OpReg dst)) + (True, False) + -> registerCode rega tmp `bind` \ code_a -> + registerCodeF regb `bind` \ code_b -> + registerNameF regb `bind` \ r_b -> + code_a . + code_b . + mkSeqInstr (instr (OpReg r_b) (OpReg tmp)) . + mkSeqInstr (MOV L (OpReg tmp) (OpReg dst)) + (False, True) + -> registerCode regb tmp `bind` \ code_b -> + registerCodeF rega `bind` \ code_a -> + registerNameF rega `bind` \ r_a -> + code_b . + code_a . + mkSeqInstr (MOV L (OpReg r_a) (OpReg dst)) . + mkSeqInstr (instr (OpReg tmp) (OpReg dst)) + (False, False) + -> registerCodeF rega `bind` \ code_a -> + registerNameF rega `bind` \ r_a -> + registerCodeF regb `bind` \ code_b -> + registerNameF regb `bind` \ r_b -> + code_a . + mkSeqInstr (MOV L (OpReg r_a) (OpReg tmp)) . + code_b . + mkSeqInstr (instr (OpReg r_b) (OpReg tmp)) . + mkSeqInstr (MOV L (OpReg tmp) (OpReg dst)) + in + returnUs (Any IntRep mkcode) + + where + maybe_imm_a = maybeImm a + is_imm_a = maybeToBool maybe_imm_a + imm_a = case maybe_imm_a of Just imm -> imm + + maybe_imm_b = maybeImm b + is_imm_b = maybeToBool maybe_imm_b + imm_b = case maybe_imm_b of Just imm -> imm -trivialCode instr x y - = getRegister x `thenUs` \ register1 -> - getRegister y `thenUs` \ register2 -> - getNewRegNCG IntRep `thenUs` \ tmp2 -> - let - code2 = registerCode register2 tmp2 --asmVoid - src2 = registerName register2 tmp2 - code__2 dst = let code1 = registerCode register1 dst --asmVoid - src1 = registerName register1 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)) - in - returnUs (Any IntRep code__2) ----------- trivialUCode instr x diff --git a/ghc/compiler/nativeGen/NOTES b/ghc/compiler/nativeGen/NOTES index 83330ec..9927b6e 100644 --- a/ghc/compiler/nativeGen/NOTES +++ b/ghc/compiler/nativeGen/NOTES @@ -1,6 +1,6 @@ -Known bugs in nativeGen, 000124 (JRS) -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Known bugs/issues in nativeGen, 000202 (JRS) +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ All these bugs are for x86; I don't know about sparc/alpha. @@ -9,8 +9,26 @@ All these bugs are for x86; I don't know about sparc/alpha. pretty dubious. I think I have it fixed for big and little endian 32-bit, but it won't work at all on a 64 bit platform. --- nofib/spectral/cvh_unboxing exposes some kind of spilling bug - (I think), since there are many references to registers %M229 - etc, which I believe are dynamic registers which didn't get assigned - to real ones. +-- Most of the x86 insn selector code in MachCode.lhs needs to + be checked against the Rules of the Game recorded in that file. + I think there are a lot of subtle violations. + +-- When selecting spill regs, don't use %eax if there is a CALL insn + (perhaps excluding calls to newCAF, since it doesn't return a + result). + +-- Keep track of the stack offset so that correct spill code can + be generated even if %esp moves. At the moment %esp doesn't + move, so the problem doesn't exist, but there is a different + problem: ccalls put args in memory below %esp and only move + %esp immediately prior to the call. This is dangerous because + (1) writing below %esp can cause a segmentation fault (as deemed + by the OS), and (2) if a signal should be handled on that stack + during argument construction, the args will get silently trashed. + +-- nofib/real/hidden gets slightly different FP answers from the + via-C route; possibly due to exp/log not being done in-line. + +-- Possibly implement GLDZ and GLD1 as analogues of FLDZ and FLD1 + (x86), to reduce number of constants emitted in f-p code. -- 1.7.10.4