From 659f147413af7f4f2d2b500659e7c03f31f16d35 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Sat, 30 Apr 2011 13:04:54 +0100 Subject: [PATCH] Remove dead Alpha native backend. Signed-off-by: Edward Z. Yang --- compiler/ghc.cabal.in | 4 - compiler/nativeGen/Alpha/CodeGen.hs | 789 ----------------------------------- compiler/nativeGen/Alpha/Instr.hs | 142 ------- compiler/nativeGen/Alpha/Ppr.hs-old | 562 ------------------------- compiler/nativeGen/Alpha/RegInfo.hs | 218 ---------- compiler/nativeGen/Alpha/Regs.hs | 323 -------------- compiler/nativeGen/AsmCodeGen.lhs | 8 +- compiler/nativeGen/PPC/Regs.hs | 1 - compiler/nativeGen/Platform.hs | 7 +- compiler/nativeGen/X86/Regs.hs | 1 - 10 files changed, 3 insertions(+), 2052 deletions(-) delete mode 100644 compiler/nativeGen/Alpha/CodeGen.hs delete mode 100644 compiler/nativeGen/Alpha/Instr.hs delete mode 100644 compiler/nativeGen/Alpha/Ppr.hs-old delete mode 100644 compiler/nativeGen/Alpha/RegInfo.hs delete mode 100644 compiler/nativeGen/Alpha/Regs.hs diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index c509eb6..029dafe 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -503,10 +503,6 @@ Library RegClass PIC Platform - Alpha.Regs - Alpha.RegInfo - Alpha.Instr - Alpha.CodeGen X86.Regs X86.RegInfo X86.Instr diff --git a/compiler/nativeGen/Alpha/CodeGen.hs b/compiler/nativeGen/Alpha/CodeGen.hs deleted file mode 100644 index 4ce774f..0000000 --- a/compiler/nativeGen/Alpha/CodeGen.hs +++ /dev/null @@ -1,789 +0,0 @@ -module Alpha.CodeGen () - -where - -{- - -getRegister :: CmmExpr -> NatM Register - -#if !x86_64_TARGET_ARCH - -- on x86_64, we have %rip for PicBaseReg, but it's not a full-featured - -- register, it can only be used for rip-relative addressing. -getRegister (CmmReg (CmmGlobal PicBaseReg)) - = do - reg <- getPicBaseNat wordSize - return (Fixed wordSize reg nilOL) -#endif - -getRegister (CmmReg reg) - = return (Fixed (cmmTypeSize (cmmRegType reg)) - (getRegisterReg reg) nilOL) - -getRegister tree@(CmmRegOff _ _) - = getRegister (mangleIndexTree tree) - - -#if WORD_SIZE_IN_BITS==32 - -- for 32-bit architectuers, support some 64 -> 32 bit conversions: - -- TO_W_(x), TO_W_(x >> 32) - -getRegister (CmmMachOp (MO_UU_Conv W64 W32) - [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do - ChildCode64 code rlo <- iselExpr64 x - return $ Fixed II32 (getHiVRegFromLo rlo) code - -getRegister (CmmMachOp (MO_SS_Conv W64 W32) - [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do - ChildCode64 code rlo <- iselExpr64 x - return $ Fixed II32 (getHiVRegFromLo rlo) code - -getRegister (CmmMachOp (MO_UU_Conv W64 W32) [x]) = do - ChildCode64 code rlo <- iselExpr64 x - return $ Fixed II32 rlo code - -getRegister (CmmMachOp (MO_SS_Conv W64 W32) [x]) = do - ChildCode64 code rlo <- iselExpr64 x - return $ Fixed II32 rlo code - -#endif - --- end of machine-"independent" bit; here we go on the rest... - - -getRegister (StDouble d) - = getBlockIdNat `thenNat` \ lbl -> - getNewRegNat PtrRep `thenNat` \ tmp -> - let code dst = mkSeqInstrs [ - LDATA RoDataSegment lbl [ - DATA TF [ImmLab (rational d)] - ], - LDA tmp (AddrImm (ImmCLbl lbl)), - LD TF dst (AddrReg tmp)] - in - return (Any FF64 code) - -getRegister (StPrim primop [x]) -- unary PrimOps - = case primop of - IntNegOp -> trivialUCode (NEG Q False) x - - NotOp -> trivialUCode NOT x - - FloatNegOp -> trivialUFCode FloatRep (FNEG TF) x - DoubleNegOp -> trivialUFCode FF64 (FNEG TF) x - - OrdOp -> coerceIntCode IntRep x - ChrOp -> chrCode x - - Float2IntOp -> coerceFP2Int x - Int2FloatOp -> coerceInt2FP pr x - Double2IntOp -> coerceFP2Int x - Int2DoubleOp -> coerceInt2FP pr x - - Double2FloatOp -> coerceFltCode x - Float2DoubleOp -> coerceFltCode x - - other_op -> getRegister (StCall fn CCallConv FF64 [x]) - where - fn = case other_op of - FloatExpOp -> fsLit "exp" - FloatLogOp -> fsLit "log" - FloatSqrtOp -> fsLit "sqrt" - FloatSinOp -> fsLit "sin" - FloatCosOp -> fsLit "cos" - FloatTanOp -> fsLit "tan" - FloatAsinOp -> fsLit "asin" - FloatAcosOp -> fsLit "acos" - FloatAtanOp -> fsLit "atan" - FloatSinhOp -> fsLit "sinh" - FloatCoshOp -> fsLit "cosh" - FloatTanhOp -> fsLit "tanh" - DoubleExpOp -> fsLit "exp" - DoubleLogOp -> fsLit "log" - DoubleSqrtOp -> fsLit "sqrt" - DoubleSinOp -> fsLit "sin" - DoubleCosOp -> fsLit "cos" - DoubleTanOp -> fsLit "tan" - DoubleAsinOp -> fsLit "asin" - DoubleAcosOp -> fsLit "acos" - DoubleAtanOp -> fsLit "atan" - DoubleSinhOp -> fsLit "sinh" - DoubleCoshOp -> fsLit "cosh" - DoubleTanhOp -> fsLit "tanh" - where - pr = panic "MachCode.getRegister: no primrep needed for Alpha" - -getRegister (StPrim primop [x, y]) -- dyadic PrimOps - = case primop of - CharGtOp -> trivialCode (CMP LTT) y x - CharGeOp -> trivialCode (CMP LE) y x - CharEqOp -> trivialCode (CMP EQQ) x y - CharNeOp -> int_NE_code x y - CharLtOp -> trivialCode (CMP LTT) x y - CharLeOp -> trivialCode (CMP LE) x y - - IntGtOp -> trivialCode (CMP LTT) y x - IntGeOp -> trivialCode (CMP LE) y x - IntEqOp -> trivialCode (CMP EQQ) x y - IntNeOp -> int_NE_code x y - IntLtOp -> trivialCode (CMP LTT) x y - IntLeOp -> trivialCode (CMP LE) x y - - WordGtOp -> trivialCode (CMP ULT) y x - WordGeOp -> trivialCode (CMP ULE) x y - WordEqOp -> trivialCode (CMP EQQ) x y - WordNeOp -> int_NE_code x y - WordLtOp -> trivialCode (CMP ULT) x y - WordLeOp -> trivialCode (CMP ULE) x y - - AddrGtOp -> trivialCode (CMP ULT) y x - AddrGeOp -> trivialCode (CMP ULE) y x - AddrEqOp -> trivialCode (CMP EQQ) x y - AddrNeOp -> int_NE_code x y - AddrLtOp -> trivialCode (CMP ULT) x y - AddrLeOp -> trivialCode (CMP ULE) x y - - FloatGtOp -> cmpF_code (FCMP TF LE) EQQ x y - FloatGeOp -> cmpF_code (FCMP TF LTT) EQQ x y - FloatEqOp -> cmpF_code (FCMP TF EQQ) NE x y - FloatNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y - FloatLtOp -> cmpF_code (FCMP TF LTT) NE x y - FloatLeOp -> cmpF_code (FCMP TF LE) NE x y - - DoubleGtOp -> cmpF_code (FCMP TF LE) EQQ x y - DoubleGeOp -> cmpF_code (FCMP TF LTT) EQQ x y - DoubleEqOp -> cmpF_code (FCMP TF EQQ) NE x y - DoubleNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y - DoubleLtOp -> cmpF_code (FCMP TF LTT) NE x y - DoubleLeOp -> cmpF_code (FCMP TF LE) NE x y - - IntAddOp -> trivialCode (ADD Q False) x y - IntSubOp -> trivialCode (SUB Q False) x y - IntMulOp -> trivialCode (MUL Q False) x y - 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 - - FloatAddOp -> trivialFCode W32 (FADD TF) x y - FloatSubOp -> trivialFCode W32 (FSUB TF) x y - FloatMulOp -> trivialFCode W32 (FMUL TF) x y - FloatDivOp -> trivialFCode W32 (FDIV TF) x y - - DoubleAddOp -> trivialFCode W64 (FADD TF) x y - DoubleSubOp -> trivialFCode W64 (FSUB TF) x y - DoubleMulOp -> trivialFCode W64 (FMUL TF) x y - DoubleDivOp -> trivialFCode W64 (FDIV TF) x y - - AddrAddOp -> trivialCode (ADD Q False) x y - AddrSubOp -> trivialCode (SUB Q False) x y - AddrRemOp -> trivialCode (REM Q True) x y - - AndOp -> trivialCode AND x y - OrOp -> trivialCode OR x y - XorOp -> trivialCode XOR x y - SllOp -> trivialCode SLL x y - SrlOp -> trivialCode SRL x y - - ISllOp -> trivialCode SLL x y -- was: panic "AlphaGen:isll" - ISraOp -> trivialCode SRA x y -- was: panic "AlphaGen:isra" - ISrlOp -> trivialCode SRL x y -- was: panic "AlphaGen:isrl" - - FloatPowerOp -> getRegister (StCall (fsLit "pow") CCallConv FF64 [x,y]) - DoublePowerOp -> getRegister (StCall (fsLit "pow") CCallConv FF64 [x,y]) - where - {- ------------------------------------------------------------ - Some bizarre special code for getting condition codes into - registers. Integer non-equality is a test for equality - followed by an XOR with 1. (Integer comparisons always set - the result register to 0 or 1.) Floating point comparisons of - any kind leave the result in a floating point register, so we - need to wrangle an integer register out of things. - -} - int_NE_code :: StixTree -> StixTree -> NatM Register - - int_NE_code x y - = trivialCode (CMP EQQ) x y `thenNat` \ register -> - getNewRegNat IntRep `thenNat` \ tmp -> - let - code = registerCode register tmp - src = registerName register tmp - code__2 dst = code . mkSeqInstr (XOR src (RIImm (ImmInt 1)) dst) - in - return (Any IntRep code__2) - - {- ------------------------------------------------------------ - Comments for int_NE_code also apply to cmpF_code - -} - cmpF_code - :: (Reg -> Reg -> Reg -> Instr) - -> Cond - -> StixTree -> StixTree - -> NatM Register - - cmpF_code instr cond x y - = trivialFCode pr instr x y `thenNat` \ register -> - getNewRegNat FF64 `thenNat` \ tmp -> - getBlockIdNat `thenNat` \ lbl -> - let - code = registerCode register tmp - result = registerName register tmp - - code__2 dst = code . mkSeqInstrs [ - OR zeroh (RIImm (ImmInt 1)) dst, - BF cond result (ImmCLbl lbl), - OR zeroh (RIReg zeroh) dst, - NEWBLOCK lbl] - in - return (Any IntRep code__2) - where - pr = panic "trivialU?FCode: does not use PrimRep on Alpha" - ------------------------------------------------------------ - -getRegister (CmmLoad pk mem) - = getAmode mem `thenNat` \ amode -> - let - code = amodeCode amode - src = amodeAddr amode - size = primRepToSize pk - code__2 dst = code . mkSeqInstr (LD size dst src) - in - return (Any pk code__2) - -getRegister (StInt i) - | fits8Bits i - = let - code dst = mkSeqInstr (OR zeroh (RIImm src) dst) - in - return (Any IntRep code) - | otherwise - = let - code dst = mkSeqInstr (LDI Q dst src) - in - return (Any IntRep code) - where - src = ImmInt (fromInteger i) - -getRegister leaf - | isJust imm - = let - code dst = mkSeqInstr (LDA dst (AddrImm imm__2)) - in - return (Any PtrRep code) - where - imm = maybeImm leaf - imm__2 = case imm of Just x -> x - - -getAmode :: CmmExpr -> NatM Amode -getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree) - --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if alpha_TARGET_ARCH - -getAmode (StPrim IntSubOp [x, StInt i]) - = getNewRegNat PtrRep `thenNat` \ tmp -> - getRegister x `thenNat` \ register -> - let - code = registerCode register tmp - reg = registerName register tmp - off = ImmInt (-(fromInteger i)) - in - return (Amode (AddrRegImm reg off) code) - -getAmode (StPrim IntAddOp [x, StInt i]) - = getNewRegNat PtrRep `thenNat` \ tmp -> - getRegister x `thenNat` \ register -> - let - code = registerCode register tmp - reg = registerName register tmp - off = ImmInt (fromInteger i) - in - return (Amode (AddrRegImm reg off) code) - -getAmode leaf - | isJust imm - = return (Amode (AddrImm imm__2) id) - where - imm = maybeImm leaf - imm__2 = case imm of Just x -> x - -getAmode other - = getNewRegNat PtrRep `thenNat` \ tmp -> - getRegister other `thenNat` \ register -> - let - code = registerCode register tmp - reg = registerName register tmp - in - return (Amode (AddrReg reg) code) - -#endif /* alpha_TARGET_ARCH */ - - --- ----------------------------------------------------------------------------- --- Generating assignments - --- Assignments are really at the heart of the whole code generation --- business. Almost all top-level nodes of any real importance are --- assignments, which correspond to loads, stores, or register --- transfers. If we're really lucky, some of the register transfers --- will go away, because we can use the destination register to --- complete the code generation for the right hand side. This only --- fails when the right hand side is forced into a fixed register --- (e.g. the result of a call). - -assignMem_IntCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock -assignReg_IntCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock - -assignMem_FltCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock -assignReg_FltCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock - - -assignIntCode pk (CmmLoad dst _) src - = getNewRegNat IntRep `thenNat` \ tmp -> - getAmode dst `thenNat` \ amode -> - getRegister src `thenNat` \ register -> - let - code1 = amodeCode amode [] - dst__2 = amodeAddr amode - code2 = registerCode register tmp [] - src__2 = registerName register tmp - sz = primRepToSize pk - code__2 = asmSeqThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2) - in - return code__2 - -assignIntCode pk dst src - = getRegister dst `thenNat` \ register1 -> - getRegister src `thenNat` \ register2 -> - let - dst__2 = registerName register1 zeroh - code = registerCode register2 dst__2 - src__2 = registerName register2 dst__2 - code__2 = if isFixed register2 - then code . mkSeqInstr (OR src__2 (RIReg src__2) dst__2) - else code - in - return code__2 - -assignFltCode pk (CmmLoad dst _) src - = getNewRegNat pk `thenNat` \ tmp -> - getAmode dst `thenNat` \ amode -> - getRegister src `thenNat` \ register -> - let - code1 = amodeCode amode [] - dst__2 = amodeAddr amode - code2 = registerCode register tmp [] - src__2 = registerName register tmp - sz = primRepToSize pk - code__2 = asmSeqThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2) - in - return code__2 - -assignFltCode pk dst src - = getRegister dst `thenNat` \ register1 -> - getRegister src `thenNat` \ register2 -> - let - dst__2 = registerName register1 zeroh - code = registerCode register2 dst__2 - src__2 = registerName register2 dst__2 - code__2 = if isFixed register2 - then code . mkSeqInstr (FMOV src__2 dst__2) - else code - in - return code__2 - - --- ----------------------------------------------------------------------------- --- Generating an non-local jump - --- (If applicable) Do not fill the delay slots here; you will confuse the --- register allocator. - -genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock - --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -genJump (CmmLabel lbl) - | isAsmTemp lbl = returnInstr (BR target) - | otherwise = returnInstrs [LDA pv (AddrImm target), JMP zeroh (AddrReg pv) 0] - where - target = ImmCLbl lbl - -genJump tree - = getRegister tree `thenNat` \ register -> - getNewRegNat PtrRep `thenNat` \ tmp -> - let - dst = registerName register pv - code = registerCode register pv - target = registerName register pv - in - if isFixed register then - returnSeq code [OR dst (RIReg dst) pv, JMP zeroh (AddrReg pv) 0] - else - return (code . mkSeqInstr (JMP zeroh (AddrReg pv) 0)) - - --- ----------------------------------------------------------------------------- --- Unconditional branches - -genBranch :: BlockId -> NatM InstrBlock - -genBranch = return . toOL . mkBranchInstr - - --- ----------------------------------------------------------------------------- --- Conditional jumps - -{- -Conditional jumps are always to local labels, so we can use branch -instructions. We peek at the arguments to decide what kind of -comparison to do. - -ALPHA: For comparisons with 0, we're laughing, because we can just do -the desired conditional branch. - --} - - -genCondJump - :: BlockId -- the branch target - -> CmmExpr -- the condition on which to branch - -> NatM InstrBlock - --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -genCondJump id (StPrim op [x, StInt 0]) - = getRegister x `thenNat` \ register -> - getNewRegNat (registerRep register) - `thenNat` \ tmp -> - let - code = registerCode register tmp - value = registerName register tmp - pk = registerRep register - target = ImmCLbl lbl - in - returnSeq code [BI (cmpOp op) value target] - where - cmpOp CharGtOp = GTT - cmpOp CharGeOp = GE - cmpOp CharEqOp = EQQ - cmpOp CharNeOp = NE - cmpOp CharLtOp = LTT - cmpOp CharLeOp = LE - cmpOp IntGtOp = GTT - cmpOp IntGeOp = GE - cmpOp IntEqOp = EQQ - cmpOp IntNeOp = NE - cmpOp IntLtOp = LTT - cmpOp IntLeOp = LE - cmpOp WordGtOp = NE - cmpOp WordGeOp = ALWAYS - cmpOp WordEqOp = EQQ - cmpOp WordNeOp = NE - cmpOp WordLtOp = NEVER - cmpOp WordLeOp = EQQ - cmpOp AddrGtOp = NE - cmpOp AddrGeOp = ALWAYS - cmpOp AddrEqOp = EQQ - cmpOp AddrNeOp = NE - cmpOp AddrLtOp = NEVER - cmpOp AddrLeOp = EQQ - -genCondJump lbl (StPrim op [x, StDouble 0.0]) - = getRegister x `thenNat` \ register -> - getNewRegNat (registerRep register) - `thenNat` \ tmp -> - let - code = registerCode register tmp - value = registerName register tmp - pk = registerRep register - target = ImmCLbl lbl - in - return (code . mkSeqInstr (BF (cmpOp op) value target)) - where - cmpOp FloatGtOp = GTT - cmpOp FloatGeOp = GE - cmpOp FloatEqOp = EQQ - cmpOp FloatNeOp = NE - cmpOp FloatLtOp = LTT - cmpOp FloatLeOp = LE - cmpOp DoubleGtOp = GTT - cmpOp DoubleGeOp = GE - cmpOp DoubleEqOp = EQQ - cmpOp DoubleNeOp = NE - cmpOp DoubleLtOp = LTT - cmpOp DoubleLeOp = LE - -genCondJump lbl (StPrim op [x, y]) - | fltCmpOp op - = trivialFCode pr instr x y `thenNat` \ register -> - getNewRegNat FF64 `thenNat` \ tmp -> - let - code = registerCode register tmp - result = registerName register tmp - target = ImmCLbl lbl - in - return (code . mkSeqInstr (BF cond result target)) - where - pr = panic "trivialU?FCode: does not use PrimRep on Alpha" - - fltCmpOp op = case op of - FloatGtOp -> True - FloatGeOp -> True - FloatEqOp -> True - FloatNeOp -> True - FloatLtOp -> True - FloatLeOp -> True - DoubleGtOp -> True - DoubleGeOp -> True - DoubleEqOp -> True - DoubleNeOp -> True - DoubleLtOp -> True - DoubleLeOp -> True - _ -> False - (instr, cond) = case op of - FloatGtOp -> (FCMP TF LE, EQQ) - FloatGeOp -> (FCMP TF LTT, EQQ) - FloatEqOp -> (FCMP TF EQQ, NE) - FloatNeOp -> (FCMP TF EQQ, EQQ) - FloatLtOp -> (FCMP TF LTT, NE) - FloatLeOp -> (FCMP TF LE, NE) - DoubleGtOp -> (FCMP TF LE, EQQ) - DoubleGeOp -> (FCMP TF LTT, EQQ) - DoubleEqOp -> (FCMP TF EQQ, NE) - DoubleNeOp -> (FCMP TF EQQ, EQQ) - DoubleLtOp -> (FCMP TF LTT, NE) - DoubleLeOp -> (FCMP TF LE, NE) - -genCondJump lbl (StPrim op [x, y]) - = trivialCode instr x y `thenNat` \ register -> - getNewRegNat IntRep `thenNat` \ tmp -> - let - code = registerCode register tmp - result = registerName register tmp - target = ImmCLbl lbl - in - return (code . mkSeqInstr (BI cond result target)) - where - (instr, cond) = case op of - CharGtOp -> (CMP LE, EQQ) - CharGeOp -> (CMP LTT, EQQ) - CharEqOp -> (CMP EQQ, NE) - CharNeOp -> (CMP EQQ, EQQ) - CharLtOp -> (CMP LTT, NE) - CharLeOp -> (CMP LE, NE) - IntGtOp -> (CMP LE, EQQ) - IntGeOp -> (CMP LTT, EQQ) - IntEqOp -> (CMP EQQ, NE) - IntNeOp -> (CMP EQQ, EQQ) - IntLtOp -> (CMP LTT, NE) - IntLeOp -> (CMP LE, NE) - WordGtOp -> (CMP ULE, EQQ) - WordGeOp -> (CMP ULT, EQQ) - WordEqOp -> (CMP EQQ, NE) - WordNeOp -> (CMP EQQ, EQQ) - WordLtOp -> (CMP ULT, NE) - WordLeOp -> (CMP ULE, NE) - AddrGtOp -> (CMP ULE, EQQ) - AddrGeOp -> (CMP ULT, EQQ) - AddrEqOp -> (CMP EQQ, NE) - AddrNeOp -> (CMP EQQ, EQQ) - AddrLtOp -> (CMP ULT, NE) - AddrLeOp -> (CMP ULE, NE) - --- ----------------------------------------------------------------------------- --- Generating C calls - --- Now the biggest nightmare---calls. Most of the nastiness is buried in --- @get_arg@, which moves the arguments to the correct registers/stack --- locations. Apart from that, the code is easy. --- --- (If applicable) Do not fill the delay slots here; you will confuse the --- register allocator. - -genCCall - :: CmmCallTarget -- function to call - -> HintedCmmFormals -- where to put the result - -> HintedCmmActuals -- arguments (of mixed type) - -> NatM InstrBlock - --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -ccallResultRegs = - -genCCall fn cconv result_regs args - = mapAccumLNat get_arg (allArgRegs, eXTRA_STK_ARGS_HERE) args - `thenNat` \ ((unused,_), argCode) -> - let - nRegs = length allArgRegs - length unused - code = asmSeqThen (map ($ []) argCode) - in - returnSeq code [ - LDA pv (AddrImm (ImmLab (ptext fn))), - JSR ra (AddrReg pv) nRegs, - LDGP gp (AddrReg ra)] - where - ------------------------ - {- Try to get a value into a specific register (or registers) for - a call. The first 6 arguments go into the appropriate - argument register (separate registers for integer and floating - point arguments, but used in lock-step), and the remaining - arguments are dumped to the stack, beginning at 0(sp). Our - first argument is a pair of the list of remaining argument - registers to be assigned for this call and the next stack - offset to use for overflowing arguments. This way, - @get_Arg@ can be applied to all of a call's arguments using - @mapAccumLNat@. - -} - get_arg - :: ([(Reg,Reg)], Int) -- Argument registers and stack offset (accumulator) - -> StixTree -- Current argument - -> NatM (([(Reg,Reg)],Int), InstrBlock) -- Updated accumulator and code - - -- We have to use up all of our argument registers first... - - get_arg ((iDst,fDst):dsts, offset) arg - = getRegister arg `thenNat` \ register -> - let - reg = if isFloatType pk then fDst else iDst - code = registerCode register reg - src = registerName register reg - pk = registerRep register - in - return ( - if isFloatType pk then - ((dsts, offset), if isFixed register then - code . mkSeqInstr (FMOV src fDst) - else code) - else - ((dsts, offset), if isFixed register then - code . mkSeqInstr (OR src (RIReg src) iDst) - else code)) - - -- Once we have run out of argument registers, we move to the - -- stack... - - get_arg ([], offset) arg - = getRegister arg `thenNat` \ register -> - getNewRegNat (registerRep register) - `thenNat` \ tmp -> - let - code = registerCode register tmp - src = registerName register tmp - pk = registerRep register - sz = primRepToSize pk - in - return (([], offset + 1), code . mkSeqInstr (ST sz src (spRel offset))) - -trivialCode instr x (StInt y) - | fits8Bits y - = getRegister x `thenNat` \ register -> - getNewRegNat IntRep `thenNat` \ tmp -> - let - code = registerCode register tmp - src1 = registerName register tmp - src2 = ImmInt (fromInteger y) - code__2 dst = code . mkSeqInstr (instr src1 (RIImm src2) dst) - in - return (Any IntRep code__2) - -trivialCode instr x y - = getRegister x `thenNat` \ register1 -> - getRegister y `thenNat` \ register2 -> - getNewRegNat IntRep `thenNat` \ tmp1 -> - getNewRegNat IntRep `thenNat` \ tmp2 -> - let - code1 = registerCode register1 tmp1 [] - src1 = registerName register1 tmp1 - code2 = registerCode register2 tmp2 [] - src2 = registerName register2 tmp2 - code__2 dst = asmSeqThen [code1, code2] . - mkSeqInstr (instr src1 (RIReg src2) dst) - in - return (Any IntRep code__2) - ------------- -trivialUCode instr x - = getRegister x `thenNat` \ register -> - getNewRegNat IntRep `thenNat` \ tmp -> - let - code = registerCode register tmp - src = registerName register tmp - code__2 dst = code . mkSeqInstr (instr (RIReg src) dst) - in - return (Any IntRep code__2) - ------------- -trivialFCode _ instr x y - = getRegister x `thenNat` \ register1 -> - getRegister y `thenNat` \ register2 -> - getNewRegNat FF64 `thenNat` \ tmp1 -> - getNewRegNat FF64 `thenNat` \ tmp2 -> - let - code1 = registerCode register1 tmp1 - src1 = registerName register1 tmp1 - - code2 = registerCode register2 tmp2 - src2 = registerName register2 tmp2 - - code__2 dst = asmSeqThen [code1 [], code2 []] . - mkSeqInstr (instr src1 src2 dst) - in - return (Any FF64 code__2) - -trivialUFCode _ instr x - = getRegister x `thenNat` \ register -> - getNewRegNat FF64 `thenNat` \ tmp -> - let - code = registerCode register tmp - src = registerName register tmp - code__2 dst = code . mkSeqInstr (instr src dst) - in - return (Any FF64 code__2) - -#if alpha_TARGET_ARCH - -coerceInt2FP _ x - = getRegister x `thenNat` \ register -> - getNewRegNat IntRep `thenNat` \ reg -> - let - code = registerCode register reg - src = registerName register reg - - code__2 dst = code . mkSeqInstrs [ - ST Q src (spRel 0), - LD TF dst (spRel 0), - CVTxy Q TF dst dst] - in - return (Any FF64 code__2) - -------------- -coerceFP2Int x - = getRegister x `thenNat` \ register -> - getNewRegNat FF64 `thenNat` \ tmp -> - let - code = registerCode register tmp - src = registerName register tmp - - code__2 dst = code . mkSeqInstrs [ - CVTxy TF Q src tmp, - ST TF tmp (spRel 0), - LD Q dst (spRel 0)] - in - return (Any IntRep code__2) - -#endif /* alpha_TARGET_ARCH */ - - --} - - - - - diff --git a/compiler/nativeGen/Alpha/Instr.hs b/compiler/nativeGen/Alpha/Instr.hs deleted file mode 100644 index 990ea8b..0000000 --- a/compiler/nativeGen/Alpha/Instr.hs +++ /dev/null @@ -1,142 +0,0 @@ ------------------------------------------------------------------------------ --- --- Machine-dependent assembly language --- --- (c) The University of Glasgow 1993-2004 --- ------------------------------------------------------------------------------ - -#include "HsVersions.h" -#include "nativeGen/NCG.h" - -module Alpha.Instr ( --- Cond(..), --- Instr(..), --- RI(..) -) - -where - -{- -import BlockId -import Regs -import Cmm -import FastString -import CLabel - -data Cond - = ALWAYS -- For BI (same as BR) - | EQQ -- For CMP and BI (NB: "EQ" is a 1.3 Prelude name) - | GE -- For BI only - | GTT -- For BI only (NB: "GT" is a 1.3 Prelude name) - | LE -- For CMP and BI - | LTT -- For CMP and BI (NB: "LT" is a 1.3 Prelude name) - | NE -- For BI only - | NEVER -- For BI (null instruction) - | ULE -- For CMP only - | ULT -- For CMP only - deriving Eq - - --- ----------------------------------------------------------------------------- --- Machine's assembly language - --- We have a few common "instructions" (nearly all the pseudo-ops) but --- mostly all of 'Instr' is machine-specific. - --- Register or immediate -data RI - = RIReg Reg - | RIImm Imm - -data Instr - -- comment pseudo-op - = COMMENT FastString - - -- some static data spat out during code - -- generation. Will be extracted before - -- pretty-printing. - | LDATA Section [CmmStatic] - - -- start a new basic block. Useful during - -- codegen, removed later. Preceding - -- instruction should be a jump, as per the - -- invariants for a BasicBlock (see Cmm). - | NEWBLOCK BlockId - - -- specify current stack offset for - -- benefit of subsequent passes - | DELTA Int - - -- | spill this reg to a stack slot - | SPILL Reg Int - - -- | reload this reg from a stack slot - | RELOAD Int Reg - - -- Loads and stores. - | LD Size Reg AddrMode -- size, dst, src - | LDA Reg AddrMode -- dst, src - | LDAH Reg AddrMode -- dst, src - | LDGP Reg AddrMode -- dst, src - | LDI Size Reg Imm -- size, dst, src - | ST Size Reg AddrMode -- size, src, dst - - -- Int Arithmetic. - | CLR Reg -- dst - | ABS Size RI Reg -- size, src, dst - | NEG Size Bool RI Reg -- size, overflow, src, dst - | ADD Size Bool Reg RI Reg -- size, overflow, src, src, dst - | SADD Size Size Reg RI Reg -- size, scale, src, src, dst - | SUB Size Bool Reg RI Reg -- size, overflow, src, src, dst - | SSUB Size Size Reg RI Reg -- size, scale, src, src, dst - | MUL Size Bool Reg RI Reg -- size, overflow, src, src, dst - | DIV Size Bool Reg RI Reg -- size, unsigned, src, src, dst - | REM Size Bool Reg RI Reg -- size, unsigned, src, src, dst - - -- Simple bit-twiddling. - | NOT RI Reg - | AND Reg RI Reg - | ANDNOT Reg RI Reg - | OR Reg RI Reg - | ORNOT Reg RI Reg - | XOR Reg RI Reg - | XORNOT Reg RI Reg - | SLL Reg RI Reg - | SRL Reg RI Reg - | SRA Reg RI Reg - - | ZAP Reg RI Reg - | ZAPNOT Reg RI Reg - - | NOP - - -- Comparison - | CMP Cond Reg RI Reg - - -- Float Arithmetic. - | FCLR Reg - | FABS Reg Reg - | FNEG Size Reg Reg - | FADD Size Reg Reg Reg - | FDIV Size Reg Reg Reg - | FMUL Size Reg Reg Reg - | FSUB Size Reg Reg Reg - | CVTxy Size Size Reg Reg - | FCMP Size Cond Reg Reg Reg - | FMOV Reg Reg - - -- Jumping around. - | BI Cond Reg Imm - | BF Cond Reg Imm - | BR Imm - | JMP Reg AddrMode Int - | BSR Imm Int - | JSR Reg AddrMode Int - - -- Alpha-specific pseudo-ops. - | FUNBEGIN CLabel - | FUNEND CLabel - - --} diff --git a/compiler/nativeGen/Alpha/Ppr.hs-old b/compiler/nativeGen/Alpha/Ppr.hs-old deleted file mode 100644 index c14eef2..0000000 --- a/compiler/nativeGen/Alpha/Ppr.hs-old +++ /dev/null @@ -1,562 +0,0 @@ - -module Alpha.Ppr ( -{- - pprReg, - pprSize, - pprCond, - pprAddr, - pprSectionHeader, - pprTypeAndSizeDecl, - pprRI, - pprRegRIReg, - pprSizeRegRegReg --} -) - -where - -{- -#include "nativeGen/NCG.h" -#include "HsVersions.h" - -import BlockId -import Cmm -import Regs -- may differ per-platform -import Instrs - -import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel, - labelDynamic, mkAsmTempLabel, entryLblToInfoLbl ) - -#if HAVE_SUBSECTIONS_VIA_SYMBOLS -import CLabel ( mkDeadStripPreventer ) -#endif - -import Panic ( panic ) -import Unique ( pprUnique ) -import Pretty -import FastString -import qualified Outputable -import Outputable ( Outputable, pprPanic, ppr, docToSDoc) - -import Data.Array.ST -import Data.Word ( Word8 ) -import Control.Monad.ST -import Data.Char ( chr, ord ) -import Data.Maybe ( isJust ) - - - -pprReg :: Reg -> Doc -pprReg r - = case r of - RealReg i -> ppr_reg_no i - VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u) - VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u) - VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u) - VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u) - where - ppr_reg_no :: Int -> Doc - ppr_reg_no i = ptext - (case i of { - 0 -> sLit "$0"; 1 -> sLit "$1"; - 2 -> sLit "$2"; 3 -> sLit "$3"; - 4 -> sLit "$4"; 5 -> sLit "$5"; - 6 -> sLit "$6"; 7 -> sLit "$7"; - 8 -> sLit "$8"; 9 -> sLit "$9"; - 10 -> sLit "$10"; 11 -> sLit "$11"; - 12 -> sLit "$12"; 13 -> sLit "$13"; - 14 -> sLit "$14"; 15 -> sLit "$15"; - 16 -> sLit "$16"; 17 -> sLit "$17"; - 18 -> sLit "$18"; 19 -> sLit "$19"; - 20 -> sLit "$20"; 21 -> sLit "$21"; - 22 -> sLit "$22"; 23 -> sLit "$23"; - 24 -> sLit "$24"; 25 -> sLit "$25"; - 26 -> sLit "$26"; 27 -> sLit "$27"; - 28 -> sLit "$28"; 29 -> sLit "$29"; - 30 -> sLit "$30"; 31 -> sLit "$31"; - 32 -> sLit "$f0"; 33 -> sLit "$f1"; - 34 -> sLit "$f2"; 35 -> sLit "$f3"; - 36 -> sLit "$f4"; 37 -> sLit "$f5"; - 38 -> sLit "$f6"; 39 -> sLit "$f7"; - 40 -> sLit "$f8"; 41 -> sLit "$f9"; - 42 -> sLit "$f10"; 43 -> sLit "$f11"; - 44 -> sLit "$f12"; 45 -> sLit "$f13"; - 46 -> sLit "$f14"; 47 -> sLit "$f15"; - 48 -> sLit "$f16"; 49 -> sLit "$f17"; - 50 -> sLit "$f18"; 51 -> sLit "$f19"; - 52 -> sLit "$f20"; 53 -> sLit "$f21"; - 54 -> sLit "$f22"; 55 -> sLit "$f23"; - 56 -> sLit "$f24"; 57 -> sLit "$f25"; - 58 -> sLit "$f26"; 59 -> sLit "$f27"; - 60 -> sLit "$f28"; 61 -> sLit "$f29"; - 62 -> sLit "$f30"; 63 -> sLit "$f31"; - _ -> sLit "very naughty alpha register" - }) - - -pprSize :: Size -> Doc -pprSize x = ptext (case x of - B -> sLit "b" - Bu -> sLit "bu" --- W -> sLit "w" UNUSED --- Wu -> sLit "wu" UNUSED - L -> sLit "l" - Q -> sLit "q" --- FF -> sLit "f" UNUSED --- DF -> sLit "d" UNUSED --- GF -> sLit "g" UNUSED --- SF -> sLit "s" UNUSED - TF -> sLit "t" - - -pprCond :: Cond -> Doc -pprCond c - = ptext (case c of - EQQ -> sLit "eq" - LTT -> sLit "lt" - LE -> sLit "le" - ULT -> sLit "ult" - ULE -> sLit "ule" - NE -> sLit "ne" - GTT -> sLit "gt" - GE -> sLit "ge") - - -pprAddr :: AddrMode -> Doc -pprAddr (AddrReg r) = parens (pprReg r) -pprAddr (AddrImm i) = pprImm i -pprAddr (AddrRegImm r1 i) - = (<>) (pprImm i) (parens (pprReg r1)) - - -pprSectionHeader Text - = ptext (sLit "\t.text\n\t.align 3") - -pprSectionHeader Data - = ptext (sLit "\t.data\n\t.align 3") - -pprSectionHeader ReadOnlyData - = ptext (sLit "\t.data\n\t.align 3") - -pprSectionHeader RelocatableReadOnlyData - = ptext (sLit "\t.data\n\t.align 3") - -pprSectionHeader UninitialisedData - = ptext (sLit "\t.bss\n\t.align 3") - -pprSectionHeader ReadOnlyData16 - = ptext (sLit "\t.data\n\t.align 4") - -pprSectionHeader (OtherSection sec) - = panic "PprMach.pprSectionHeader: unknown section" - - -pprTypeAndSizeDecl :: CLabel -> Doc -pprTypeAndSizeDecl lbl - = empty - - - -pprInstr :: Instr -> Doc - -pprInstr (DELTA d) - = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d))) - -pprInstr (NEWBLOCK _) - = panic "PprMach.pprInstr: NEWBLOCK" - -pprInstr (LDATA _ _) - = panic "PprMach.pprInstr: LDATA" - -pprInstr (SPILL reg slot) - = hcat [ - ptext (sLit "\tSPILL"), - char '\t', - pprReg reg, - comma, - ptext (sLit "SLOT") <> parens (int slot)] - -pprInstr (RELOAD slot reg) - = hcat [ - ptext (sLit "\tRELOAD"), - char '\t', - ptext (sLit "SLOT") <> parens (int slot), - comma, - pprReg reg] - -pprInstr (LD size reg addr) - = hcat [ - ptext (sLit "\tld"), - pprSize size, - char '\t', - pprReg reg, - comma, - pprAddr addr - ] - -pprInstr (LDA reg addr) - = hcat [ - ptext (sLit "\tlda\t"), - pprReg reg, - comma, - pprAddr addr - ] - -pprInstr (LDAH reg addr) - = hcat [ - ptext (sLit "\tldah\t"), - pprReg reg, - comma, - pprAddr addr - ] - -pprInstr (LDGP reg addr) - = hcat [ - ptext (sLit "\tldgp\t"), - pprReg reg, - comma, - pprAddr addr - ] - -pprInstr (LDI size reg imm) - = hcat [ - ptext (sLit "\tldi"), - pprSize size, - char '\t', - pprReg reg, - comma, - pprImm imm - ] - -pprInstr (ST size reg addr) - = hcat [ - ptext (sLit "\tst"), - pprSize size, - char '\t', - pprReg reg, - comma, - pprAddr addr - ] - -pprInstr (CLR reg) - = hcat [ - ptext (sLit "\tclr\t"), - pprReg reg - ] - -pprInstr (ABS size ri reg) - = hcat [ - ptext (sLit "\tabs"), - pprSize size, - char '\t', - pprRI ri, - comma, - pprReg reg - ] - -pprInstr (NEG size ov ri reg) - = hcat [ - ptext (sLit "\tneg"), - pprSize size, - if ov then ptext (sLit "v\t") else char '\t', - pprRI ri, - comma, - pprReg reg - ] - -pprInstr (ADD size ov reg1 ri reg2) - = hcat [ - ptext (sLit "\tadd"), - pprSize size, - if ov then ptext (sLit "v\t") else char '\t', - pprReg reg1, - comma, - pprRI ri, - comma, - pprReg reg2 - ] - -pprInstr (SADD size scale reg1 ri reg2) - = hcat [ - ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}), - ptext (sLit "add"), - pprSize size, - char '\t', - pprReg reg1, - comma, - pprRI ri, - comma, - pprReg reg2 - ] - -pprInstr (SUB size ov reg1 ri reg2) - = hcat [ - ptext (sLit "\tsub"), - pprSize size, - if ov then ptext (sLit "v\t") else char '\t', - pprReg reg1, - comma, - pprRI ri, - comma, - pprReg reg2 - ] - -pprInstr (SSUB size scale reg1 ri reg2) - = hcat [ - ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}), - ptext (sLit "sub"), - pprSize size, - char '\t', - pprReg reg1, - comma, - pprRI ri, - comma, - pprReg reg2 - ] - -pprInstr (MUL size ov reg1 ri reg2) - = hcat [ - ptext (sLit "\tmul"), - pprSize size, - if ov then ptext (sLit "v\t") else char '\t', - pprReg reg1, - comma, - pprRI ri, - comma, - pprReg reg2 - ] - -pprInstr (DIV size uns reg1 ri reg2) - = hcat [ - ptext (sLit "\tdiv"), - pprSize size, - if uns then ptext (sLit "u\t") else char '\t', - pprReg reg1, - comma, - pprRI ri, - comma, - pprReg reg2 - ] - -pprInstr (REM size uns reg1 ri reg2) - = hcat [ - ptext (sLit "\trem"), - pprSize size, - if uns then ptext (sLit "u\t") else char '\t', - pprReg reg1, - comma, - pprRI ri, - comma, - pprReg reg2 - ] - -pprInstr (NOT ri reg) - = hcat [ - ptext (sLit "\tnot"), - char '\t', - pprRI ri, - comma, - pprReg reg - ] - -pprInstr (AND reg1 ri reg2) = pprRegRIReg (sLit "and") reg1 ri reg2 -pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg (sLit "andnot") reg1 ri reg2 -pprInstr (OR reg1 ri reg2) = pprRegRIReg (sLit "or") reg1 ri reg2 -pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg (sLit "ornot") reg1 ri reg2 -pprInstr (XOR reg1 ri reg2) = pprRegRIReg (sLit "xor") reg1 ri reg2 -pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg (sLit "xornot") reg1 ri reg2 - -pprInstr (SLL reg1 ri reg2) = pprRegRIReg (sLit "sll") reg1 ri reg2 -pprInstr (SRL reg1 ri reg2) = pprRegRIReg (sLit "srl") reg1 ri reg2 -pprInstr (SRA reg1 ri reg2) = pprRegRIReg (sLit "sra") reg1 ri reg2 - -pprInstr (ZAP reg1 ri reg2) = pprRegRIReg (sLit "zap") reg1 ri reg2 -pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg (sLit "zapnot") reg1 ri reg2 - -pprInstr (NOP) = ptext (sLit "\tnop") - -pprInstr (CMP cond reg1 ri reg2) - = hcat [ - ptext (sLit "\tcmp"), - pprCond cond, - char '\t', - pprReg reg1, - comma, - pprRI ri, - comma, - pprReg reg2 - ] - -pprInstr (FCLR reg) - = hcat [ - ptext (sLit "\tfclr\t"), - pprReg reg - ] - -pprInstr (FABS reg1 reg2) - = hcat [ - ptext (sLit "\tfabs\t"), - pprReg reg1, - comma, - pprReg reg2 - ] - -pprInstr (FNEG size reg1 reg2) - = hcat [ - ptext (sLit "\tneg"), - pprSize size, - char '\t', - pprReg reg1, - comma, - pprReg reg2 - ] - -pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "add") size reg1 reg2 reg3 -pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "div") size reg1 reg2 reg3 -pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "mul") size reg1 reg2 reg3 -pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "sub") size reg1 reg2 reg3 - -pprInstr (CVTxy size1 size2 reg1 reg2) - = hcat [ - ptext (sLit "\tcvt"), - pprSize size1, - case size2 of {Q -> ptext (sLit "qc"); _ -> pprSize size2}, - char '\t', - pprReg reg1, - comma, - pprReg reg2 - ] - -pprInstr (FCMP size cond reg1 reg2 reg3) - = hcat [ - ptext (sLit "\tcmp"), - pprSize size, - pprCond cond, - char '\t', - pprReg reg1, - comma, - pprReg reg2, - comma, - pprReg reg3 - ] - -pprInstr (FMOV reg1 reg2) - = hcat [ - ptext (sLit "\tfmov\t"), - pprReg reg1, - comma, - pprReg reg2 - ] - -pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab) - -pprInstr (BI NEVER reg lab) = empty - -pprInstr (BI cond reg lab) - = hcat [ - ptext (sLit "\tb"), - pprCond cond, - char '\t', - pprReg reg, - comma, - pprImm lab - ] - -pprInstr (BF cond reg lab) - = hcat [ - ptext (sLit "\tfb"), - pprCond cond, - char '\t', - pprReg reg, - comma, - pprImm lab - ] - -pprInstr (BR lab) - = (<>) (ptext (sLit "\tbr\t")) (pprImm lab) - -pprInstr (JMP reg addr hint) - = hcat [ - ptext (sLit "\tjmp\t"), - pprReg reg, - comma, - pprAddr addr, - comma, - int hint - ] - -pprInstr (BSR imm n) - = (<>) (ptext (sLit "\tbsr\t")) (pprImm imm) - -pprInstr (JSR reg addr n) - = hcat [ - ptext (sLit "\tjsr\t"), - pprReg reg, - comma, - pprAddr addr - ] - -pprInstr (FUNBEGIN clab) - = hcat [ - if (externallyVisibleCLabel clab) then - hcat [ptext (sLit "\t.globl\t"), pp_lab, char '\n'] - else - empty, - ptext (sLit "\t.ent "), - pp_lab, - char '\n', - pp_lab, - pp_ldgp, - pp_lab, - pp_frame - ] - where - pp_lab = pprCLabel_asm clab - - -- NEVER use commas within those string literals, cpp will ruin your day - pp_ldgp = hcat [ ptext (sLit ":\n\tldgp $29"), char ',', ptext (sLit "0($27)\n") ] - pp_frame = hcat [ ptext (sLit "..ng:\n\t.frame $30"), char ',', - ptext (sLit "4240"), char ',', - ptext (sLit "$26"), char ',', - ptext (sLit "0\n\t.prologue 1") ] - -pprInstr (FUNEND clab) - = (<>) (ptext (sLit "\t.align 4\n\t.end ")) (pprCLabel_asm clab) - - -pprRI :: RI -> Doc - -pprRI (RIReg r) = pprReg r -pprRI (RIImm r) = pprImm r - -pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc -pprRegRIReg name reg1 ri reg2 - = hcat [ - char '\t', - ptext name, - char '\t', - pprReg reg1, - comma, - pprRI ri, - comma, - pprReg reg2 - ] - -pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc -pprSizeRegRegReg name size reg1 reg2 reg3 - = hcat [ - char '\t', - ptext name, - pprSize size, - char '\t', - pprReg reg1, - comma, - pprReg reg2, - comma, - pprReg reg3 - ] - --} - - - diff --git a/compiler/nativeGen/Alpha/RegInfo.hs b/compiler/nativeGen/Alpha/RegInfo.hs deleted file mode 100644 index 7fdde4d..0000000 --- a/compiler/nativeGen/Alpha/RegInfo.hs +++ /dev/null @@ -1,218 +0,0 @@ - ------------------------------------------------------------------------------ --- --- (c) The University of Glasgow 1996-2004 --- ------------------------------------------------------------------------------ - -module Alpha.RegInfo ( -{- - RegUsage(..), - noUsage, - regUsage, - patchRegs, - jumpDests, - isJumpish, - patchJump, - isRegRegMove, - - JumpDest, canShortcut, shortcutJump, shortcutStatic, - - maxSpillSlots, - mkSpillInstr, - mkLoadInstr, - mkRegRegMoveInstr, - mkBranchInstr --} -) - -where - -{- -#include "nativeGen/NCG.h" -#include "HsVersions.h" - - -import BlockId -import Cmm -import CLabel -import Instrs -import Regs -import Outputable -import Constants ( rESERVED_C_STACK_BYTES ) -import FastBool - -data RegUsage = RU [Reg] [Reg] - -noUsage :: RegUsage -noUsage = RU [] [] - -regUsage :: Instr -> RegUsage - -regUsage instr = case instr of - SPILL reg slot -> usage ([reg], []) - RELOAD slot reg -> usage ([], [reg]) - LD B 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 sz reg addr -> usage (regAddr addr, [reg]) - LDA reg addr -> usage (regAddr addr, [reg]) - LDAH reg addr -> usage (regAddr addr, [reg]) - LDGP reg addr -> usage (regAddr addr, [reg]) - LDI sz reg imm -> usage ([], [reg]) - ST B reg addr -> usage (reg : regAddr addr, [t9, t10]) --- ST W reg addr -> usage (reg : regAddr addr, [t9, t10]) : UNUSED - ST sz reg addr -> usage (reg : regAddr addr, []) - CLR reg -> usage ([], [reg]) - ABS sz ri reg -> usage (regRI ri, [reg]) - NEG sz ov ri reg -> usage (regRI ri, [reg]) - ADD sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SUB sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2]) - MUL sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2]) - DIV sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12]) - REM sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12]) - NOT ri reg -> usage (regRI ri, [reg]) - AND r1 ar r2 -> usage (r1 : regRI ar, [r2]) - ANDNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) - OR r1 ar r2 -> usage (r1 : regRI ar, [r2]) - ORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) - XOR r1 ar r2 -> usage (r1 : regRI ar, [r2]) - XORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SLL r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SRL r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SRA r1 ar r2 -> usage (r1 : regRI ar, [r2]) - ZAP r1 ar r2 -> usage (r1 : regRI ar, [r2]) - ZAPNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) - CMP co r1 ar r2 -> usage (r1 : regRI ar, [r2]) - FCLR reg -> usage ([], [reg]) - FABS r1 r2 -> usage ([r1], [r2]) - FNEG sz r1 r2 -> usage ([r1], [r2]) - FADD sz r1 r2 r3 -> usage ([r1, r2], [r3]) - FDIV sz r1 r2 r3 -> usage ([r1, r2], [r3]) - FMUL sz r1 r2 r3 -> usage ([r1, r2], [r3]) - FSUB sz r1 r2 r3 -> usage ([r1, r2], [r3]) - CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2]) - FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3]) - FMOV r1 r2 -> usage ([r1], [r2]) - - - -- We assume that all local jumps will be BI/BF/BR. JMP must be out-of-line. - BI cond reg lbl -> usage ([reg], []) - BF cond reg lbl -> usage ([reg], []) - JMP reg addr hint -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet - - BSR _ n -> RU (argRegSet n) callClobberedRegSet - JSR reg addr n -> RU (argRegSet n) callClobberedRegSet - - _ -> noUsage - - where - usage (src, dst) = RU (mkRegSet (filter interesting src)) - (mkRegSet (filter interesting dst)) - - interesting (FixedReg _) = False - interesting _ = True - - regAddr (AddrReg r1) = [r1] - regAddr (AddrRegImm r1 _) = [r1] - regAddr (AddrImm _) = [] - - regRI (RIReg r) = [r] - regRI _ = [] - - -patchRegs :: Instr -> (Reg -> Reg) -> Instr -patchRegs instr env = case instr of - SPILL reg slot -> SPILL (env reg) slot - RELOAD slot reg -> RELOAD slot (env reg) - LD sz reg addr -> LD sz (env reg) (fixAddr addr) - LDA reg addr -> LDA (env reg) (fixAddr addr) - LDAH reg addr -> LDAH (env reg) (fixAddr addr) - LDGP reg addr -> LDGP (env reg) (fixAddr addr) - LDI sz reg imm -> LDI sz (env reg) imm - ST sz reg addr -> ST sz (env reg) (fixAddr addr) - CLR reg -> CLR (env reg) - ABS sz ar reg -> ABS sz (fixRI ar) (env reg) - NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg) - ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2) - SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2) - SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2) - SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2) - MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2) - DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2) - REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2) - NOT ar reg -> NOT (fixRI ar) (env reg) - AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2) - ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2) - OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2) - ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2) - XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2) - XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2) - SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2) - SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2) - SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2) - ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2) - ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2) - CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2) - FCLR reg -> FCLR (env reg) - FABS r1 r2 -> FABS (env r1) (env r2) - FNEG s r1 r2 -> FNEG s (env r1) (env r2) - FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3) - FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3) - FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3) - FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3) - CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2) - FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3) - FMOV r1 r2 -> FMOV (env r1) (env r2) - BI cond reg lbl -> BI cond (env reg) lbl - BF cond reg lbl -> BF cond (env reg) lbl - JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint - JSR reg addr i -> JSR (env reg) (fixAddr addr) i - _ -> instr - where - fixAddr (AddrReg r1) = AddrReg (env r1) - fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i - fixAddr other = other - - fixRI (RIReg r) = RIReg (env r) - fixRI other = other - - -mkSpillInstr - :: Reg -- register to spill - -> Int -- current stack delta - -> Int -- spill slot to use - -> Instr - -mkSpillInstr reg delta slot - = let off = spillSlotToOffset slot - in - -- Alpha: spill below the stack pointer (?) - ST sz dyn (spRel (- (off `div` 8))) - - -mkLoadInstr - :: Reg -- register to load - -> Int -- current stack delta - -> Int -- spill slot to use - -> Instr -mkLoadInstr reg delta slot - = let off = spillSlotToOffset slot - in - LD sz dyn (spRel (- (off `div` 8))) - - -mkBranchInstr - :: BlockId - -> [Instr] - -mkBranchInstr id = [BR id] - --} - - - - diff --git a/compiler/nativeGen/Alpha/Regs.hs b/compiler/nativeGen/Alpha/Regs.hs deleted file mode 100644 index ee49050..0000000 --- a/compiler/nativeGen/Alpha/Regs.hs +++ /dev/null @@ -1,323 +0,0 @@ --- ----------------------------------------------------------------------------- --- --- (c) The University of Glasgow 1994-2004 --- --- Alpha support is rotted and incomplete. --- ----------------------------------------------------------------------------- - - -module Alpha.Regs ( -{- - Size(..), - AddrMode(..), - fits8Bits, - fReg, - gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zeroh --} -) - -where - -{- -#include "nativeGen/NCG.h" -#include "HsVersions.h" -#include "../includes/stg/MachRegs.h" - -import RegsBase - -import BlockId -import Cmm -import CLabel ( CLabel, mkMainCapabilityLabel ) -import Pretty -import Outputable ( Outputable(..), pprPanic, panic ) -import qualified Outputable -import Unique -import UniqSet -import Constants -import FastTypes -import FastBool -import UniqFM - - -data Size - = B -- byte - | Bu --- | W -- word (2 bytes): UNUSED --- | Wu -- : UNUSED - | L -- longword (4 bytes) - | Q -- quadword (8 bytes) --- | FF -- VAX F-style floating pt: UNUSED --- | GF -- VAX G-style floating pt: UNUSED --- | DF -- VAX D-style floating pt: UNUSED --- | SF -- IEEE single-precision floating pt: UNUSED - | TF -- IEEE double-precision floating pt - deriving Eq - - -data AddrMode - = AddrImm Imm - | AddrReg Reg - | AddrRegImm Reg Imm - - -addrOffset :: AddrMode -> Int -> Maybe AddrMode -addrOffset addr off - = case addr of - _ -> panic "MachMisc.addrOffset not defined for Alpha" - -fits8Bits :: Integer -> Bool -fits8Bits i = i >= -256 && i < 256 - - --- The Alpha has 64 registers of interest; 32 integer registers and 32 floating --- point registers. The mapping of STG registers to alpha machine registers --- is defined in StgRegs.h. We are, of course, prepared for any eventuality. - -fReg :: Int -> RegNo -fReg x = (32 + x) - -v0, f0, ra, pv, gp, sp, zeroh :: Reg -v0 = realReg 0 -f0 = realReg (fReg 0) -ra = FixedReg ILIT(26) -pv = t12 -gp = FixedReg ILIT(29) -sp = FixedReg ILIT(30) -zeroh = FixedReg ILIT(31) -- "zero" is used in 1.3 (MonadZero method) - -t9, t10, t11, t12 :: Reg -t9 = realReg 23 -t10 = realReg 24 -t11 = realReg 25 -t12 = realReg 27 - - -#define f0 32 -#define f1 33 -#define f2 34 -#define f3 35 -#define f4 36 -#define f5 37 -#define f6 38 -#define f7 39 -#define f8 40 -#define f9 41 -#define f10 42 -#define f11 43 -#define f12 44 -#define f13 45 -#define f14 46 -#define f15 47 -#define f16 48 -#define f17 49 -#define f18 50 -#define f19 51 -#define f20 52 -#define f21 53 -#define f22 54 -#define f23 55 -#define f24 56 -#define f25 57 -#define f26 58 -#define f27 59 -#define f28 60 -#define f29 61 -#define f30 62 -#define f31 63 - - --- allMachRegs is the complete set of machine regs. -allMachRegNos :: [RegNo] -allMachRegNos = [0..63] - - --- these are the regs which we cannot assume stay alive over a --- C call. -callClobberedRegs :: [Reg] -callClobberedRegs - = [0, 1, 2, 3, 4, 5, 6, 7, 8, - 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, - fReg 0, fReg 1, fReg 10, fReg 11, fReg 12, fReg 13, fReg 14, fReg 15, - fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21, fReg 22, fReg 23, - fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30] - - --- argRegs is the set of regs which are read for an n-argument call to C. --- For archs which pass all args on the stack (x86), is empty. --- Sparc passes up to the first 6 args in regs. --- Dunno about Alpha. -argRegs :: RegNo -> [Reg] - -argRegs 0 = [] -argRegs 1 = freeMappedRegs [16, fReg 16] -argRegs 2 = freeMappedRegs [16, 17, fReg 16, fReg 17] -argRegs 3 = freeMappedRegs [16, 17, 18, fReg 16, fReg 17, fReg 18] -argRegs 4 = freeMappedRegs [16, 17, 18, 19, fReg 16, fReg 17, fReg 18, fReg 19] -argRegs 5 = freeMappedRegs [16, 17, 18, 19, 20, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20] -argRegs 6 = freeMappedRegs [16, 17, 18, 19, 20, 21, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21] -argRegs _ = panic "MachRegs.argRegs(alpha): don't know about >6 arguments!" - - --- all of the arg regs ?? -allArgRegs :: [(Reg, Reg)] -allArgRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]] - - --- horror show ----------------------------------------------------------------- - -freeReg :: RegNo -> FastBool - -freeReg 26 = fastBool False -- return address (ra) -freeReg 28 = fastBool False -- reserved for the assembler (at) -freeReg 29 = fastBool False -- global pointer (gp) -freeReg 30 = fastBool False -- stack pointer (sp) -freeReg 31 = fastBool False -- always zero (zeroh) -freeReg 63 = fastBool False -- always zero (f31) - -#ifdef REG_Base -freeReg REG_Base = fastBool False -#endif -#ifdef REG_R1 -freeReg REG_R1 = fastBool False -#endif -#ifdef REG_R2 -freeReg REG_R2 = fastBool False -#endif -#ifdef REG_R3 -freeReg REG_R3 = fastBool False -#endif -#ifdef REG_R4 -freeReg REG_R4 = fastBool False -#endif -#ifdef REG_R5 -freeReg REG_R5 = fastBool False -#endif -#ifdef REG_R6 -freeReg REG_R6 = fastBool False -#endif -#ifdef REG_R7 -freeReg REG_R7 = fastBool False -#endif -#ifdef REG_R8 -freeReg REG_R8 = fastBool False -#endif -#ifdef REG_F1 -freeReg REG_F1 = fastBool False -#endif -#ifdef REG_F2 -freeReg REG_F2 = fastBool False -#endif -#ifdef REG_F3 -freeReg REG_F3 = fastBool False -#endif -#ifdef REG_F4 -freeReg REG_F4 = fastBool False -#endif -#ifdef REG_D1 -freeReg REG_D1 = fastBool False -#endif -#ifdef REG_D2 -freeReg REG_D2 = fastBool False -#endif -#ifdef REG_Sp -freeReg REG_Sp = fastBool False -#endif -#ifdef REG_Su -freeReg REG_Su = fastBool False -#endif -#ifdef REG_SpLim -freeReg REG_SpLim = fastBool False -#endif -#ifdef REG_Hp -freeReg REG_Hp = fastBool False -#endif -#ifdef REG_HpLim -freeReg REG_HpLim = fastBool False -#endif -freeReg n = fastBool True - - --- | Returns 'Nothing' if this global register is not stored --- in a real machine register, otherwise returns @'Just' reg@, where --- reg is the machine register it is stored in. - -globalRegMaybe :: GlobalReg -> Maybe Reg - -#ifdef REG_Base -globalRegMaybe BaseReg = Just (RealReg REG_Base) -#endif -#ifdef REG_R1 -globalRegMaybe (VanillaReg 1 _) = Just (RealReg REG_R1) -#endif -#ifdef REG_R2 -globalRegMaybe (VanillaReg 2 _) = Just (RealReg REG_R2) -#endif -#ifdef REG_R3 -globalRegMaybe (VanillaReg 3 _) = Just (RealReg REG_R3) -#endif -#ifdef REG_R4 -globalRegMaybe (VanillaReg 4 _) = Just (RealReg REG_R4) -#endif -#ifdef REG_R5 -globalRegMaybe (VanillaReg 5 _) = Just (RealReg REG_R5) -#endif -#ifdef REG_R6 -globalRegMaybe (VanillaReg 6 _) = Just (RealReg REG_R6) -#endif -#ifdef REG_R7 -globalRegMaybe (VanillaReg 7 _) = Just (RealReg REG_R7) -#endif -#ifdef REG_R8 -globalRegMaybe (VanillaReg 8 _) = Just (RealReg REG_R8) -#endif -#ifdef REG_R9 -globalRegMaybe (VanillaReg 9 _) = Just (RealReg REG_R9) -#endif -#ifdef REG_R10 -globalRegMaybe (VanillaReg 10 _) = Just (RealReg REG_R10) -#endif -#ifdef REG_F1 -globalRegMaybe (FloatReg 1) = Just (RealReg REG_F1) -#endif -#ifdef REG_F2 -globalRegMaybe (FloatReg 2) = Just (RealReg REG_F2) -#endif -#ifdef REG_F3 -globalRegMaybe (FloatReg 3) = Just (RealReg REG_F3) -#endif -#ifdef REG_F4 -globalRegMaybe (FloatReg 4) = Just (RealReg REG_F4) -#endif -#ifdef REG_D1 -globalRegMaybe (DoubleReg 1) = Just (RealReg REG_D1) -#endif -#ifdef REG_D2 -globalRegMaybe (DoubleReg 2) = Just (RealReg REG_D2) -#endif -#ifdef REG_Sp -globalRegMaybe Sp = Just (RealReg REG_Sp) -#endif -#ifdef REG_Lng1 -globalRegMaybe (LongReg 1) = Just (RealReg REG_Lng1) -#endif -#ifdef REG_Lng2 -globalRegMaybe (LongReg 2) = Just (RealReg REG_Lng2) -#endif -#ifdef REG_SpLim -globalRegMaybe SpLim = Just (RealReg REG_SpLim) -#endif -#ifdef REG_Hp -globalRegMaybe Hp = Just (RealReg REG_Hp) -#endif -#ifdef REG_HpLim -globalRegMaybe HpLim = Just (RealReg REG_HpLim) -#endif -#ifdef REG_CurrentTSO -globalRegMaybe CurrentTSO = Just (RealReg REG_CurrentTSO) -#endif -#ifdef REG_CurrentNursery -globalRegMaybe CurrentNursery = Just (RealReg REG_CurrentNursery) -#endif -globalRegMaybe _ = Nothing - --} diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 767dc99..eeb5f2e 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -13,13 +13,7 @@ module AsmCodeGen ( nativeCodeGen ) where #include "nativeGen/NCG.h" -#if alpha_TARGET_ARCH -import Alpha.CodeGen -import Alpha.Regs -import Alpha.RegInfo -import Alpha.Instr - -#elif i386_TARGET_ARCH || x86_64_TARGET_ARCH +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH import X86.CodeGen import X86.Regs import X86.Instr diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs index 73e0c20..7a2a84b 100644 --- a/compiler/nativeGen/PPC/Regs.hs +++ b/compiler/nativeGen/PPC/Regs.hs @@ -209,7 +209,6 @@ spRel n = AddrRegImm sp (ImmInt (n * wORD_SIZE)) -- argRegs is the set of regs which are read for an n-argument call to C. -- For archs which pass all args on the stack (x86), is empty. -- Sparc passes up to the first 6 args in regs. --- Dunno about Alpha. argRegs :: RegNo -> [Reg] argRegs 0 = [] argRegs 1 = map regSingle [3] diff --git a/compiler/nativeGen/Platform.hs b/compiler/nativeGen/Platform.hs index 20cb5f5..7b2502d 100644 --- a/compiler/nativeGen/Platform.hs +++ b/compiler/nativeGen/Platform.hs @@ -31,8 +31,7 @@ data Platform -- about what instruction set extensions an architecture might support. -- data Arch - = ArchAlpha - | ArchX86 + = ArchX86 | ArchX86_64 | ArchPPC | ArchPPC_64 @@ -70,9 +69,7 @@ defaultTargetPlatform -- | Move the evil TARGET_ARCH #ifdefs into Haskell land. defaultTargetArch :: Arch -#if alpha_TARGET_ARCH -defaultTargetArch = ArchAlpha -#elif i386_TARGET_ARCH +#if i386_TARGET_ARCH defaultTargetArch = ArchX86 #elif x86_64_TARGET_ARCH defaultTargetArch = ArchX86_64 diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs index 094b74d..dc0df49 100644 --- a/compiler/nativeGen/X86/Regs.hs +++ b/compiler/nativeGen/X86/Regs.hs @@ -249,7 +249,6 @@ floatregnos = fakeregnos ++ xmmregnos; -- argRegs is the set of regs which are read for an n-argument call to C. -- For archs which pass all args on the stack (x86), is empty. -- Sparc passes up to the first 6 args in regs. --- Dunno about Alpha. argRegs :: RegNo -> [Reg] argRegs _ = panic "MachRegs.argRegs(x86): should not be used!" -- 1.7.10.4