X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FPprMach.hs;h=dd3d029a9f9842f9ad0d212d8f3737798097db3f;hb=16dc208aaad7aadaea970e47b8055d7d7f8781e5;hp=6a7226588e6633d9d4fe0b6e06e7bd38d68d2913;hpb=0f7d268d00795a58a06ae3c92ebbd14571295b84;p=ghc-hetmet.git diff --git a/compiler/nativeGen/PprMach.hs b/compiler/nativeGen/PprMach.hs index 6a72265..dd3d029 100644 --- a/compiler/nativeGen/PprMach.hs +++ b/compiler/nativeGen/PprMach.hs @@ -10,6 +10,13 @@ -- (e.g., 'pprReg'); we conclude with the no-commonality monster, -- 'pprInstr'. +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + #include "nativeGen/NCG.h" module PprMach ( @@ -61,9 +68,9 @@ pprNatCmmTop (CmmData section dats) = pprSectionHeader section $$ vcat (map pprData dats) -- special case for split markers: -pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl +pprNatCmmTop (CmmProc [] lbl _ (ListGraph [])) = pprLabel lbl -pprNatCmmTop (CmmProc info lbl params blocks) = +pprNatCmmTop (CmmProc info lbl params (ListGraph blocks)) = pprSectionHeader Text $$ (if not (null info) then @@ -829,6 +836,22 @@ pprInstr (LDATA _ _) #if alpha_TARGET_ARCH +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"), @@ -1211,16 +1234,21 @@ pprSizeRegRegReg name size reg1 reg2 reg3 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH -{- -- BUGS: changed for coloring allocator -pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack -- write a pass for this and patch linear allocator with it - | src == dst - = -#if 0 /* #ifdef DEBUG */ - (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d) -#else - empty -#endif --} +pprInstr (SPILL reg slot) + = hcat [ + ptext SLIT("\tSPILL"), + char ' ', + pprUserReg reg, + comma, + ptext SLIT("SLOT") <> parens (int slot)] + +pprInstr (RELOAD slot reg) + = hcat [ + ptext SLIT("\tRELOAD"), + char ' ', + ptext SLIT("SLOT") <> parens (int slot), + comma, + pprUserReg reg] pprInstr (MOV size src dst) = pprSizeOpOp SLIT("mov") size src dst @@ -1783,6 +1811,22 @@ pprCondInstr name cond arg -- reads (bytearrays). -- +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] + -- Translate to the following: -- add g1,g2,g1 -- ld [g1],%fn @@ -2057,6 +2101,23 @@ pp_comma_a = text ",a" -- pprInstr for PowerPC #if powerpc_TARGET_ARCH + +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 sz reg addr) = hcat [ char '\t', ptext SLIT("l"),