From: sewardj Date: Thu, 13 Jan 2000 12:59:59 +0000 (+0000) Subject: [project @ 2000-01-13 12:59:58 by sewardj] X-Git-Tag: Approximately_9120_patches~5301 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=03d7cc2a4da848db9f39ea072310bb862347e929;p=ghc-hetmet.git [project @ 2000-01-13 12:59:58 by sewardj] Added a rudimentary implementation of -ddump-stix. --- diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index 197bee5..da827f5 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -360,6 +360,7 @@ pprAbsC (CCodeBlock lbl abs_C) _ else case (pprTempAndExternDecls abs_C) of { (pp_temps, pp_exts) -> vcat [ + char ' ', hcat [text (if (externallyVisibleCLabel lbl) then "FN_(" -- abbreviations to save on output else "IFN_("), @@ -370,7 +371,8 @@ pprAbsC (CCodeBlock lbl abs_C) _ nest 8 (ptext SLIT("FB_")), nest 8 (pprAbsC abs_C (costs abs_C)), nest 8 (ptext SLIT("FE_")), - char '}' ] + char '}', + char ' ' ] } diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 2d105bd..589b517 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -43,6 +43,7 @@ module CmdLineOpts ( opt_D_show_passes, opt_D_dump_rn_trace, opt_D_dump_rn_stats, + opt_D_dump_stix, opt_D_source_stats, opt_D_verbose_core2core, opt_D_verbose_stg2stg, @@ -330,6 +331,7 @@ opt_D_dump_worker_wrapper = opt_D_dump_most || lookUp SLIT("-ddump-workwrap") opt_D_show_passes = opt_D_dump_most || lookUp SLIT("-dshow-passes") opt_D_dump_rn_trace = opt_D_dump_all || lookUp SLIT("-ddump-rn-trace") opt_D_dump_rn_stats = opt_D_dump_most || lookUp SLIT("-ddump-rn-stats") +opt_D_dump_stix = opt_D_dump_all || lookUp SLIT("-ddump-stix") opt_D_dump_simpl_stats = opt_D_dump_most || lookUp SLIT("-ddump-simpl-stats") opt_D_source_stats = opt_D_dump_most || lookUp SLIT("-dsource-stats") opt_D_verbose_core2core = opt_D_dump_all || lookUp SLIT("-dverbose-simpl") diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs index 81e1760..cf2f0df 100644 --- a/ghc/compiler/main/CodeOutput.lhs +++ b/ghc/compiler/main/CodeOutput.lhs @@ -36,6 +36,8 @@ codeOutput mod_name c_code h_code flat_abstractC ncg_uniqs -- but not both. [Allowing for both gives a space leak on -- flat_abstractC. WDP 94/10] + dumpIfSet opt_D_dump_stix "Final stix code" stix_final >> + dumpIfSet opt_D_dump_asm "Asm code" ncg_output_d >> doOutput opt_ProduceS ncg_output_w >> @@ -73,7 +75,8 @@ codeOutput mod_name c_code h_code flat_abstractC ncg_uniqs ncg_output_d = error "*** GHC not built with a native-code generator ***" ncg_output_w = ncg_output_d #else - ncg_output_d = nativeCodeGen flat_absC_ncg ncg_uniqs + (stix_raw, stix_opt, stix_final, ncg_output_d) + = nativeCodeGen flat_absC_ncg ncg_uniqs ncg_output_w = (\ f -> printForAsm f ncg_output_d) #endif diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs index 1a08d46..7e92c9f 100644 --- a/ghc/compiler/nativeGen/AsmCodeGen.lhs +++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs @@ -20,7 +20,7 @@ import AsmRegAlloc ( runRegAllocate ) import OrdList ( OrdList ) import PrimOp ( commutableOp, PrimOp(..) ) import RegAllocInfo ( mkMRegsState, MRegsState ) -import Stix ( StixTree(..), StixReg(..) ) +import Stix ( StixTree(..), StixReg(..), pprStixTrees ) import PrimRep ( isFloatingRep ) import UniqSupply ( returnUs, thenUs, mapUs, initUs_, UniqSM, UniqSupply ) import UniqFM ( UniqFM, emptyUFM, addToUFM, lookupUFM ) @@ -77,34 +77,39 @@ The machine-dependent bits break down as follows: So, here we go: \begin{code} -nativeCodeGen :: AbstractC -> UniqSupply -> SDoc +nativeCodeGen :: AbstractC -> UniqSupply -> (SDoc, SDoc, SDoc, SDoc) nativeCodeGen absC us = initUs_ us (runNCG absC) +runNCG :: AbstractC -> UniqSM (SDoc, SDoc, SDoc, SDoc) runNCG absC - = genCodeAbstractC absC `thenUs` \ treelists -> + = genCodeAbstractC absC `thenUs` \ stixRaw -> let - stix = map (map genericOpt) treelists - in + stixOpt = map (map genericOpt) stixRaw #if i386_TARGET_ARCH - let - stix' = map floatFix stix - in - codeGen stix' + stixFinal = map floatFix stixOpt #else - codeGen stix + stixFinal = stixOpt #endif + in + codeGen (stixRaw, stixOpt, stixFinal) \end{code} @codeGen@ is the top-level code-generation function: \begin{code} -codeGen :: [[StixTree]] -> UniqSM SDoc +codeGen :: ([[StixTree]],[[StixTree]],[[StixTree]]) + -> UniqSM (SDoc, SDoc, SDoc, SDoc) -codeGen trees - = mapUs genMachCode trees `thenUs` \ dynamic_codes -> +codeGen (stixRaw, stixOpt, stixFinal) + = mapUs genMachCode stixFinal `thenUs` \ dynamic_codes -> let static_instrs = scheduleMachCode dynamic_codes in - returnUs (vcat (map pprInstr static_instrs)) + returnUs ( + text "ppr'd stixRaw", + text "ppr'd stixOpt", + vcat (map pprStixTrees stixFinal), + vcat (map pprInstr static_instrs) + ) \end{code} Top level code generator for a chunk of stix code: diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs index 89bb3cc..92761f2 100644 --- a/ghc/compiler/nativeGen/Stix.lhs +++ b/ghc/compiler/nativeGen/Stix.lhs @@ -5,7 +5,7 @@ \begin{code} module Stix ( CodeSegment(..), StixReg(..), StixTree(..), StixTreeList, - sStLitLbl, + sStLitLbl, pprStixTrees, stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim, stgTagReg, getUniqLabelNCG, @@ -19,10 +19,10 @@ import Ratio ( Rational ) import AbsCSyn ( node, tagreg, MagicId(..) ) import AbsCUtils ( magicIdPrimRep ) -import CallConv ( CallConv ) -import CLabel ( mkAsmTempLabel, CLabel ) -import PrimRep ( PrimRep ) -import PrimOp ( PrimOp ) +import CallConv ( CallConv, pprCallConv ) +import CLabel ( mkAsmTempLabel, CLabel, pprCLabel ) +import PrimRep ( PrimRep, showPrimRep ) +import PrimOp ( PrimOp, pprPrimOp ) import Unique ( Unique ) import SMRep ( fixedHdrSize, arrHdrSize ) import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM ) @@ -105,6 +105,49 @@ data StixTree sStLitLbl :: FAST_STRING -> StixTree sStLitLbl s = StLitLbl (ptext s) + + +pprStixTrees :: [StixTree] -> SDoc +pprStixTrees ts + = vcat [ + vcat (map ppStixTree ts), + char ' ', + char ' ' + ] + +paren t = char '(' <> t <> char ')' + +ppStixTree :: StixTree -> SDoc +ppStixTree t + = case t of + StSegment cseg -> paren (ppCodeSegment cseg) + StInt i -> paren (integer i) + StDouble rat -> paren (text "Double" <+> rational rat) + StString str -> paren (text "Str" <+> ptext str) + StComment str -> paren (text "Comment" <+> ptext str) + StLitLbl sd -> sd + StLitLit ll -> paren (text "LitLit" <+> ptext ll) + StCLbl lbl -> pprCLabel lbl + StReg reg -> ppStixReg reg + StIndex k b o -> paren (ppStixTree b <+> char '+' <> + pprPrimRep k <+> ppStixTree o) + StInd k t -> pprPrimRep k <> char '[' <> ppStixTree t <> char ']' + StAssign k d s -> ppStixTree d <> text " :=" <> pprPrimRep k + <> text " " <> ppStixTree s + StLabel ll -> pprCLabel ll <+> char ':' + StFunBegin ll -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll) + StFunEnd ll -> paren (text "FunEnd" <+> pprCLabel ll) + StJump t -> paren (text "Jump" <+> ppStixTree t) + StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll) + StCondJump l t -> paren (text "JumpC" <+> pprCLabel l <+> ppStixTree t) + StData k ds -> paren (text "Data" <+> pprPrimRep k <+> + hsep (map ppStixTree ds)) + StPrim op ts -> paren (text "Prim" <+> pprPrimOp op <+> hsep (map ppStixTree ts)) + StCall nm cc k args + -> paren (text "Call" <+> ptext nm <+> + pprCallConv cc <+> pprPrimRep k <+> hsep (map ppStixTree args)) + where + pprPrimRep = text . showPrimRep \end{code} Stix registers can have two forms. They {\em may} or {\em may not} @@ -116,6 +159,25 @@ data StixReg | StixTemp Unique PrimRep -- "Regs" which model local variables (CTemps) in -- the abstract C. + +ppStixReg (StixMagicId mid) + = ppMId mid +ppStixReg (StixTemp u pr) + = hcat [text "Temp(", ppr u, ppr pr, char ')'] + + +ppMId BaseReg = text "BaseReg" +ppMId (VanillaReg kind n) = hcat [text "IntReg(", int (I# n), char ')'] +ppMId (FloatReg n) = hcat [text "FltReg(", int (I# n), char ')'] +ppMId (DoubleReg n) = hcat [text "DblReg(", int (I# n), char ')'] +ppMId (LongReg kind n) = hcat [text "LongReg(", int (I# n), char ')'] +ppMId Sp = text "Sp" +ppMId Su = text "Su" +ppMId SpLim = text "SpLim" +ppMId Hp = text "Hp" +ppMId HpLim = text "HpLim" +ppMId CurCostCentre = text "CCC" +ppMId VoidReg = text "VoidReg" \end{code} We hope that every machine supports the idea of data segment and text @@ -123,7 +185,8 @@ segment (or that it has no segments at all, and we can lump these together). \begin{code} -data CodeSegment = DataSegment | TextSegment deriving Eq +data CodeSegment = DataSegment | TextSegment deriving (Eq, Show) +ppCodeSegment = text . show type StixTreeList = [StixTree] -> [StixTree] \end{code}