Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • ghc/ghc
  • bgamari/ghc
  • syd/ghc
  • ggreif/ghc
  • watashi/ghc
  • RolandSenn/ghc
  • mpickering/ghc
  • DavidEichmann/ghc
  • carter/ghc
  • harpocrates/ghc
  • ethercrow/ghc
  • mijicd/ghc
  • adamse/ghc
  • alexbiehl/ghc
  • gridaphobe/ghc
  • trofi/ghc
  • supersven/ghc
  • ppk/ghc
  • ulysses4ever/ghc
  • AndreasK/ghc
  • ghuntley/ghc
  • shayne-fletcher-da/ghc
  • fgaz/ghc
  • yav/ghc
  • osa1/ghc
  • mbbx6spp/ghc
  • JulianLeviston/ghc
  • reactormonk/ghc
  • rae/ghc
  • takenobu-hs/ghc
  • michalt/ghc
  • andrewthad/ghc
  • hsyl20/ghc
  • scottgw/ghc
  • sjakobi/ghc
  • angerman/ghc
  • RyanGlScott/ghc
  • hvr/ghc
  • howtonotwin/ghc
  • chessai/ghc
  • m-renaud/ghc
  • brprice/ghc
  • stevehartdata/ghc
  • sighingnow/ghc
  • kgardas/ghc
  • ckoparkar/ghc
  • alp/ghc
  • smaeul/ghc
  • kakkun61/ghc
  • sykloid/ghc
  • newhoggy/ghc
  • toonn/ghc
  • nineonine/ghc
  • Phyx/ghc
  • ezyang/ghc
  • tweag/ghc
  • langston/ghc
  • ndmitchell/ghc
  • rockbmb/ghc
  • artempyanykh/ghc
  • mniip/ghc
  • mynguyenbmc/ghc
  • alexfmpe/ghc
  • crockeea/ghc
  • nh2/ghc
  • vaibhavsagar/ghc
  • phadej/ghc
  • Haskell-mouse/ghc
  • lolotp/ghc
  • spacekitteh/ghc
  • michaelpj/ghc
  • mgsloan/ghc
  • HPCohen/ghc
  • tmobile/ghc
  • radrow/ghc
  • simonmar/ghc
  • _deepfire/ghc
  • Ericson2314/ghc
  • leitao/ghc
  • fumieval/ghc
  • trac-isovector/ghc
  • cblp/ghc
  • xich/ghc
  • ciil/ghc
  • erthalion/ghc
  • xldenis/ghc
  • autotaker/ghc
  • haskell-wasm/ghc
  • kcsongor/ghc
  • agander/ghc
  • Baranowski/ghc
  • trac-dredozubov/ghc
  • 23Skidoo/ghc
  • iustin/ghc
  • ningning/ghc
  • josefs/ghc
  • kabuhr/ghc
  • gallais/ghc
  • dten/ghc
  • expipiplus1/ghc
  • Pluralia/ghc
  • rohanjr/ghc
  • intricate/ghc
  • kirelagin/ghc
  • Javran/ghc
  • DanielG/ghc
  • trac-mizunashi_mana/ghc
  • pparkkin/ghc
  • bollu/ghc
  • ntc2/ghc
  • jaspervdj/ghc
  • JoshMeredith/ghc
  • wz1000/ghc
  • zkourouma/ghc
  • code5hot/ghc
  • jdprice/ghc
  • tdammers/ghc
  • J-mie6/ghc
  • trac-lantti/ghc
  • ch1bo/ghc
  • cgohla/ghc
  • lucamolteni/ghc
  • acairncross/ghc
  • amerocu/ghc
  • chreekat/ghc
  • txsmith/ghc
  • trupill/ghc
  • typetetris/ghc
  • sergv/ghc
  • fryguybob/ghc
  • erikd/ghc
  • trac-roland/ghc
  • setupminimal/ghc
  • Friede80/ghc
  • SkyWriter/ghc
  • xplorld/ghc
  • abrar/ghc
  • obsidiansystems/ghc
  • Icelandjack/ghc
  • adinapoli/ghc
  • trac-matthewbauer/ghc
  • heatsink/ghc
  • dwijnand/ghc
  • Cmdv/ghc
  • alinab/ghc
  • pepeiborra/ghc
  • fommil/ghc
  • luochen1990/ghc
  • rlupton20/ghc
  • applePrincess/ghc
  • lehins/ghc
  • ronmrdechai/ghc
  • leeadam/ghc
  • harendra/ghc
  • mightymosquito1991/ghc
  • trac-gershomb/ghc
  • lucajulian/ghc
  • Rizary/ghc
  • VictorCMiraldo/ghc
  • jamesbrock/ghc
  • andrewdmeier/ghc
  • luke/ghc
  • pranaysashank/ghc
  • cocreature/ghc
  • hithroc/ghc
  • obreitwi/ghc
  • slrtbtfs/ghc
  • kaol/ghc
  • yairchu/ghc
  • Mathemagician98/ghc
  • trac-taylorfausak/ghc
  • leungbk/ghc
  • MichaWiedenmann/ghc
  • chris-martin/ghc
  • TDecki/ghc
  • adithyaov/ghc
  • trac-gelisam/ghc
  • Lysxia/ghc
  • complyue/ghc
  • bwignall/ghc
  • sternmull/ghc
  • sonika/ghc
  • leif/ghc
  • broadwaylamb/ghc
  • myszon/ghc
  • danbroooks/ghc
  • Mechachleopteryx/ghc
  • zardyh/ghc
  • trac-vdukhovni/ghc
  • OmarKhaledAbdo/ghc
  • arrowd/ghc
  • Bodigrim/ghc
  • matheus23/ghc
  • cardenaso11/ghc
  • trac-Athas/ghc
  • mb720/ghc
  • DylanZA/ghc
  • liff/ghc
  • typedrat/ghc
  • trac-claude/ghc
  • jbm/ghc
  • Gertjan423/ghc
  • PHO/ghc
  • JKTKops/ghc
  • kockahonza/ghc
  • msakai/ghc
  • Sir4ur0n/ghc
  • barambani/ghc
  • vishnu.c/ghc
  • dcoutts/ghc
  • trac-runeks/ghc
  • trac-MaxGabriel/ghc
  • lexi.lambda/ghc
  • strake/ghc
  • spavikevik/ghc
  • JakobBruenker/ghc
  • rmanne/ghc
  • gdziadkiewicz/ghc
  • ani/ghc
  • iliastsi/ghc
  • smunix/ghc
  • judah/ghc
  • blackgnezdo/ghc
  • emilypi/ghc
  • trac-bpfoley/ghc
  • muesli4/ghc
  • trac-gkaracha/ghc
  • Kleidukos/ghc
  • nek0/ghc
  • TristanCacqueray/ghc
  • dwulive/ghc
  • mbakke/ghc
  • arybczak/ghc
  • Yang123321/ghc
  • maksbotan/ghc
  • QuietMisdreavus/ghc
  • trac-olshanskydr/ghc
  • emekoi/ghc
  • samuela/ghc
  • josephcsible/ghc
  • dramforever/ghc
  • lpsmith/ghc
  • DenisFrezzato/ghc
  • michivi/ghc
  • jneira/ghc
  • jeffhappily/ghc
  • Ivan-Yudin/ghc
  • nakaji-dayo/ghc
  • gdevanla/ghc
  • galen/ghc
  • fendor/ghc
  • yaitskov/ghc
  • rcythr/ghc
  • awpr/ghc
  • jeremyschlatter/ghc
  • Aver1y/ghc
  • mitchellvitez/ghc
  • merijn/ghc
  • tomjaguarpaw1/ghc
  • trac-NoidedSuper/ghc
  • erewok/ghc
  • trac-junji.hashimoto/ghc
  • adamwespiser/ghc
  • bjaress/ghc
  • jhrcek/ghc
  • leonschoorl/ghc
  • lukasz-golebiewski/ghc
  • sheaf/ghc
  • last-g/ghc
  • carassius1014/ghc
  • eschwartz/ghc
  • dwincort/ghc
  • felixwiemuth/ghc
  • TimWSpence/ghc
  • marcusmonteirodesouza/ghc
  • WJWH/ghc
  • vtols/ghc
  • theobat/ghc
  • BinderDavid/ghc
  • ckoparkar0/ghc
  • alexander-kjeldaas/ghc
  • dme2/ghc
  • philderbeast/ghc
  • aaronallen8455/ghc
  • rayshih/ghc
  • benkard/ghc
  • mpardalos/ghc
  • saidelman/ghc
  • leiftw/ghc
  • ca333/ghc
  • bwroga/ghc
  • nmichael44/ghc
  • trac-crobbins/ghc
  • felixonmars/ghc
  • adityagupta1089/ghc
  • hgsipiere/ghc
  • treeowl/ghc
  • alexpeits/ghc
  • CraigFe/ghc
  • dnlkrgr/ghc
  • kerckhove_ts/ghc
  • cptwunderlich/ghc
  • eiais/ghc
  • hahohihu/ghc
  • sanchayan/ghc
  • lemmih/ghc
  • sehqlr/ghc
  • trac-dbeacham/ghc
  • luite/ghc
  • trac-f-a/ghc
  • vados/ghc
  • luntain/ghc
  • fatho/ghc
  • alexbiehl-gc/ghc
  • dcbdan/ghc
  • tvh/ghc
  • liam-ly/ghc
  • timbobbarnes/ghc
  • GovanifY/ghc
  • shanth2600/ghc
  • gliboc/ghc
  • duog/ghc
  • moxonsghost/ghc
  • zander/ghc
  • masaeedu/ghc
  • georgefst/ghc
  • guibou/ghc
  • nicuveo/ghc
  • mdebruijne/ghc
  • stjordanis/ghc
  • emiflake/ghc
  • wygulmage/ghc
  • frasertweedale/ghc
  • coot/ghc
  • aratamizuki/ghc
  • tsandstr/ghc
  • mrBliss/ghc
  • Anton-Latukha/ghc
  • tadfisher/ghc
  • vapourismo/ghc
  • Sorokin-Anton/ghc
  • basile-henry/ghc
  • trac-mightybyte/ghc
  • AbsoluteNikola/ghc
  • cobrien99/ghc
  • songzh/ghc
  • blamario/ghc
  • aj4ayushjain/ghc
  • trac-utdemir/ghc
  • tangcl/ghc
  • hdgarrood/ghc
  • maerwald/ghc
  • arjun/ghc
  • ratherforky/ghc
  • haskieLambda/ghc
  • EmilGedda/ghc
  • Bogicevic/ghc
  • eddiejessup/ghc
  • kozross/ghc
  • AlistairB/ghc
  • 3Rafal/ghc
  • christiaanb/ghc
  • trac-bit/ghc
  • matsumonkie/ghc
  • trac-parsonsmatt/ghc
  • chisui/ghc
  • jaro/ghc
  • trac-kmiyazato/ghc
  • davidsd/ghc
  • Tritlo/ghc
  • I-B-3/ghc
  • lykahb/ghc
  • AriFordsham/ghc
  • turion1/ghc
  • berberman/ghc
  • christiantakle/ghc
  • zyklotomic/ghc
  • trac-ocramz/ghc
  • CSEdd/ghc
  • doyougnu/ghc
  • mmhat/ghc
  • why-not-try-calmer/ghc
  • plutotulp/ghc
  • kjekac/ghc
  • Manvi07/ghc
  • teo/ghc
  • cactus/ghc
  • CarrieMY/ghc
  • abel/ghc
  • yihming/ghc
  • tsakki/ghc
  • jessicah/ghc
  • oliverbunting/ghc
  • meld/ghc
  • friedbrice/ghc
  • Joald/ghc
  • abarbu/ghc
  • DigitalBrains1/ghc
  • sterni/ghc
  • alexDarcy/ghc
  • hexchain/ghc
  • minimario/ghc
  • zliu41/ghc
  • tommd/ghc
  • jazcarate/ghc
  • peterbecich/ghc
  • alirezaghey/ghc
  • solomon/ghc
  • mikael.urankar/ghc
  • davjam/ghc
  • int-index/ghc
  • MorrowM/ghc
  • nrnrnr/ghc
  • Sonfamm/ghc-test-only
  • afzt1/ghc
  • nguyenhaibinh-tpc/ghc
  • trac-lierdakil/ghc
  • MichaWiedenmann1/ghc
  • jmorag/ghc
  • Ziharrk/ghc
  • trac-MitchellSalad/ghc
  • juampe/ghc
  • jwaldmann/ghc
  • snowleopard/ghc
  • juhp/ghc
  • normalcoder/ghc
  • ksqsf/ghc
  • trac-jberryman/ghc
  • roberth/ghc
  • 1ntEgr8/ghc
  • epworth/ghc
  • MrAdityaAlok/ghc
  • JunmingZhao42/ghc
  • jappeace/ghc
  • trac-Gabriel439/ghc
  • alt-romes/ghc
  • HugoPeters1024/ghc
  • 10ne1/ghc-fork
  • agentultra/ghc
  • Garfield1002/ghc
  • ChickenProp/ghc
  • clyring/ghc
  • MaxHearnden/ghc
  • jumper149/ghc
  • vem/ghc
  • ketzacoatl/ghc
  • Rosuavio/ghc
  • jackohughes/ghc
  • p4l1ly/ghc
  • konsumlamm/ghc
  • shlevy/ghc
  • torsten.schmits/ghc
  • andremarianiello/ghc
  • amesgen/ghc
  • googleson78/ghc
  • InfiniteVerma/ghc
  • uhbif19/ghc
  • yiyunliu/ghc
  • raehik/ghc
  • mrkun/ghc
  • telser/ghc
  • 1Jajen1/ghc
  • slotThe/ghc
  • WinstonHartnett/ghc
  • mpilgrem/ghc
  • dreamsmasher/ghc
  • schuelermine/ghc
  • trac-Viwor/ghc
  • undergroundquizscene/ghc
  • evertedsphere/ghc
  • coltenwebb/ghc
  • oberblastmeister/ghc
  • agrue/ghc
  • lf-/ghc
  • zacwood9/ghc
  • steshaw/ghc
  • high-cloud/ghc
  • SkamDart/ghc
  • PiDelport/ghc
  • maoif/ghc
  • RossPaterson/ghc
  • CharlesTaylor7/ghc
  • ribosomerocker/ghc
  • trac-ramirez7/ghc
  • daig/ghc
  • NicolasT/ghc
  • FinleyMcIlwaine/ghc
  • lawtonnichols/ghc
  • jmtd/ghc
  • ozkutuk/ghc
  • wildsebastian/ghc
  • nikshalark/ghc
  • lrzlin/ghc
  • tobias/ghc
  • fw/ghc
  • hawkinsw/ghc
  • type-dance/ghc
  • rui314/ghc
  • ocharles/ghc
  • wavewave/ghc
  • TheKK/ghc
  • nomeata/ghc
  • trac-csabahruska/ghc
  • jonathanjameswatson/ghc
  • L-as/ghc
  • Axman6/ghc
  • barracuda156/ghc
  • trac-jship/ghc
  • jake-87/ghc
  • meooow/ghc
  • rebeccat/ghc
  • hamana55/ghc
  • Enigmage/ghc
  • kokobd/ghc
  • agevelt/ghc
  • gshen42/ghc
  • chrismwendt/ghc
  • MangoIV/ghc
  • teto/ghc
  • Sookr1/ghc
  • trac-thomasjm/ghc
  • barci2/ghc-dev
  • trac-m4dc4p/ghc
  • dixonary/ghc
  • breakerzirconia/ghc
  • alexsio27444/ghc
  • glocq/ghc
  • sourabhxyz/ghc
  • ryantrinkle/ghc
  • Jade/ghc
  • scedfaliako/ghc
  • martijnbastiaan/ghc
  • trac-george.colpitts/ghc
  • ammarbinfaisal/ghc
  • mimi.vx/ghc
  • lortabac/ghc
  • trac-zyla/ghc
  • benbellick/ghc
  • aadaa-fgtaa/ghc
  • jvanbruegge/ghc
  • archbung/ghc
  • gilmi/ghc
  • mfonism/ghc
  • alex-mckenna/ghc
  • Ei30metry/ghc
  • DiegoDiverio/ghc
  • jorgecunhamendes/ghc
  • liesnikov/ghc
  • akrmn/ghc
  • trac-simplifierticks/ghc
  • jacco/ghc
  • rhendric/ghc
  • damhiya/ghc
  • ryndubei/ghc
  • DaveBarton/ghc
  • trac-Profpatsch/ghc
  • GZGavinZhao/ghc
  • ncfavier/ghc
  • jameshaydon/ghc
  • ajccosta/ghc
  • dschrempf/ghc
  • cydparser/ghc
  • LinuxUserGD/ghc
  • elodielander/ghc
  • facundominguez/ghc
  • psilospore/ghc
  • lachrimae/ghc
  • dylan-thinnes/ghc-type-errors-plugin
  • hamishmack/ghc
  • Leary/ghc
  • lzszt/ghc
  • lyokha/ghc
  • trac-glaubitz/ghc
  • Rewbert/ghc
  • andreabedini/ghc
  • Jasagredo/ghc
  • sol/ghc
  • OlegAlexander/ghc
  • trac-sthibaul/ghc
  • avdv/ghc
  • Wendaolee/ghc
  • ur4t/ghc
  • daylily/ghc
  • boltzmannrain/ghc
  • mmzk1526/ghc
  • trac-fizzixnerd/ghc
  • soulomoon/ghc
  • rwmjones/ghc
  • j14i/ghc
  • tracsis/ghc
  • gesh/ghc
  • flip101/ghc
  • eldritch-cookie/ghc
  • LemonjamesD/ghc
  • pgujjula/ghc
  • skeuchel/ghc
  • noteed/ghc
  • gulin.serge/ghc
  • Torrekie/ghc
  • jlwoodwa/ghc
  • ayanamists/ghc
  • husong998/ghc
  • trac-edmundnoble/ghc
  • josephf/ghc
  • contrun/ghc
  • baulig/ghc
  • edsko/ghc
  • mzschr/ghc-issue-24732
  • ulidtko/ghc
  • Arsen/ghc
  • trac-sjoerd_visscher/ghc
  • crumbtoo/ghc
  • L0neGamer/ghc
  • DrewFenwick/ghc
  • benz0li/ghc
  • MaciejWas/ghc
  • jordanrule/ghc
  • trac-qqwy/ghc
  • LiamGoodacre/ghc
  • isomorpheme/ghc
  • trac-danidiaz/ghc
  • Kariim/ghc
  • MTaimoorZaeem/ghc
  • hololeap/ghc
  • ticat-fp/ghc
  • meritamen/ghc
  • criskell/ghc
  • trac-kraai/ghc
  • aergus/ghc
  • jdral/ghc
  • SamB/ghc
  • Tristian/ghc
  • ywgrit/ghc
  • KatsuPatrick/ghc
  • OsePedro/ghc
  • mpscholten/ghc
  • fp/ghc
  • zaquest/ghc
638 results
Show changes
Commits on Source (9)
  • Ben Gamari's avatar
    Allow unsaturated runRW# applications · f4cc57fa
    Ben Gamari authored and Marge Bot's avatar Marge Bot committed
    Previously we had a very aggressive Core Lint check which caught
    unsaturated applications of runRW#. However, there is nothing
    wrong with such applications and they may naturally arise in desugared
    Core. For instance, the desugared Core of Data.Primitive.Array.runArray#
    from the `primitive` package contains:
    
        case ($) (runRW# @_ @_) (\s -> ...) of ...
    
    In this case it's almost certain that ($) will be inlined, turning the
    application into a saturated application. However, even if this weren't
    the case there isn't a problem: CorePrep (after deleting an unnecessary
    case) can simply generate code in its usual way, resulting in a call to
    the Haskell definition of runRW#.
    
    Fixes #18291.
    f4cc57fa
  • Ben Gamari's avatar
    testsuite: Add test for #18291 · 3ac6ae7c
    Ben Gamari authored and Marge Bot's avatar Marge Bot committed
    3ac6ae7c
  • Eli Schwartz's avatar
    install: do not install sphinx doctrees · a87a0b49
    Eli Schwartz authored and Marge Bot's avatar Marge Bot committed
    These files are 100% not needed at install time, and they contain
    unreproducible info. See https://reproducible-builds.org/ for why this
    matters.
    a87a0b49
  • Ben Gamari's avatar
    testsuite: Allow baseline commit to be set explicitly · 194b25ee
    Ben Gamari authored and Marge Bot's avatar Marge Bot committed
    194b25ee
  • Ben Gamari's avatar
    gitlab-ci: Use MR base commit as performance baseline · fdcf7645
    Ben Gamari authored and Marge Bot's avatar Marge Bot committed
    fdcf7645
  • Hannes Siebenhandl's avatar
    Expose UnitInfoMap as it is part of the public API · 9ad5cab3
    Hannes Siebenhandl authored and Marge Bot's avatar Marge Bot committed
    9ad5cab3
  • Ben Gamari's avatar
    testsuite: Only run llvm ways if llc is available · aa4b744d
    Ben Gamari authored and Marge Bot's avatar Marge Bot committed
    As noted in #18560, we previously would always run the LLVM ways since
    `configure` would set `SettingsLlcCommand` to something non-null when
    it otherwise couldn't find the `llc` executable. Now we rather probe for
    the existence of the `llc` executable in the testsuite driver.
    
    Fixes #18560.
    aa4b744d
  • Sylvain Henry's avatar
    DynFlags: refactor GHC.CmmToAsm (#17957, #10143) · 0c5ed5c7
    Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
    This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr
    
    To do that I've had to make some refactoring:
    
    * X86' and PPC's `Instr` are no longer `Outputable` as they require a
      `Platform` argument
    
    * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc`
    
    * as a consequence, I've refactored some modules to avoid .hs-boot files
    
    * added (derived) functor instances for some datatypes parametric in the
      instruction type. It's useful for pretty-printing as we just have to
      map `pprInstr` before pretty-printing the container datatype.
    0c5ed5c7
  • Peter Trommler's avatar
    PPC and X86: Portable printing of IEEE floats · 5fe1ecb2
    Peter Trommler authored
    GNU as and the AIX assembler support floating point literals.
    SPARC seems to have support too but I cannot test on SPARC.
    Curiously, `doubleToBytes` is also used in the LLVM backend.
    
    To avoid endianness issues when cross-compiling float and double literals
    are printed as C-style floating point values. The assembler then takes
    care of memory layout and endianness.
    
    This was brought up in #18431 by @hsyl20.
    5fe1ecb2
Showing
with 331 additions and 391 deletions
......@@ -26,12 +26,28 @@ stages:
- testing # head.hackage correctness and compiler performance testing
- deploy # push documentation
# Note [The CI Story]
# ~~~~~~~~~~~~~~~~~~~
#
# There are two different types of pipelines:
#
# - marge-bot merges to `master`. Here we perform an exhaustive validation
# across all of the platforms which we support. In addition, we push
# performance metric notes upstream, providing a persistent record of the
# performance characteristics of the compiler.
#
# - merge requests. Here we perform a slightly less exhaustive battery of
# testing. Namely we omit some configurations (e.g. the unregisterised job).
# These use the merge request's base commit for performance metric
# comparisons.
#
workflow:
# N.B.Don't run on wip/ branches, instead on run on merge requests.
# N.B. Don't run on wip/ branches, instead on run on merge requests.
rules:
- if: $CI_MERGE_REQUEST_ID
- if: $CI_COMMIT_TAG
- if: '$CI_COMMIT_BRANCH == "master"'
- if: '$CI_COMMIT_BRANCH == "wip/marge_bot_batch_merge_job"'
- if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/'
- if: '$CI_PIPELINE_SOURCE == "web"'
......
......@@ -363,6 +363,13 @@ function push_perf_notes() {
"$TOP/.gitlab/test-metrics.sh" push
}
# Figure out which commit should be used by the testsuite driver as a
# performance baseline. See Note [The CI Story].
function determine_metric_baseline() {
export PERF_BASELINE_COMMIT="$(git merge-base $CI_MERGE_REQUEST_TARGET_BRANCH_NAME HEAD)"
info "Using $PERF_BASELINE_COMMIT for performance metric baseline..."
}
function test_make() {
run "$MAKE" test_bindist TEST_PREP=YES
run "$MAKE" V=0 test \
......
......@@ -3,6 +3,7 @@
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE DeriveFunctor #-}
module GHC.Cmm (
-- * Cmm top-level datatypes
......@@ -96,6 +97,8 @@ data GenCmmDecl d h g
Section
d
deriving (Functor)
type CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph
type CmmDeclSRTs = GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
......@@ -246,14 +249,19 @@ type RawCmmStatics = GenCmmStatics 'True
-- These are used by the LLVM and NCG backends, when populating Cmm
-- with lists of instructions.
data GenBasicBlock i = BasicBlock BlockId [i]
data GenBasicBlock i
= BasicBlock BlockId [i]
deriving (Functor)
-- | The branch block id is that of the first block in
-- the branch, which is that branch's entry point
blockId :: GenBasicBlock i -> BlockId
blockId (BasicBlock blk_id _ ) = blk_id
newtype ListGraph i = ListGraph [GenBasicBlock i]
newtype ListGraph i
= ListGraph [GenBasicBlock i]
deriving (Functor)
instance Outputable instr => Outputable (ListGraph instr) where
ppr (ListGraph blocks) = vcat (map ppr blocks)
......
......@@ -2,7 +2,6 @@
--
-- (c) The University of Glasgow 1993-2004
--
-- This is the top-level module in the native code generator.
--
-- -----------------------------------------------------------------------------
......@@ -15,40 +14,74 @@
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.CmmToAsm (
-- * Module entry point
nativeCodeGen
-- * Test-only exports: see trac #12744
-- used by testGraphNoSpills, which needs to access
-- the register allocator intermediate data structures
-- cmmNativeGen emits
, cmmNativeGen
, NcgImpl(..)
, x86NcgImpl
) where
-- | Native code generator
--
-- The native-code generator has machine-independent and
-- machine-dependent modules.
--
-- This module ("GHC.CmmToAsm") is the top-level machine-independent
-- module. Before entering machine-dependent land, we do some
-- machine-independent optimisations (defined below) on the
-- 'CmmStmts's.
--
-- We convert to the machine-specific 'Instr' datatype with
-- 'cmmCodeGen', assuming an infinite supply of registers. We then use
-- a machine-independent register allocator ('regAlloc') to rejoin
-- reality. Obviously, 'regAlloc' has machine-specific helper
-- functions (see about "RegAllocInfo" below).
--
-- Finally, we order the basic blocks of the function so as to minimise
-- the number of jumps between blocks, by utilising fallthrough wherever
-- possible.
--
-- The machine-dependent bits break down as follows:
--
-- * ["MachRegs"] Everything about the target platform's machine
-- registers (and immediate operands, and addresses, which tend to
-- intermingle/interact with registers).
--
-- * ["MachInstrs"] Includes the 'Instr' datatype (possibly should
-- have a module of its own), plus a miscellany of other things
-- (e.g., 'targetDoubleSize', 'smStablePtrTable', ...)
--
-- * ["MachCodeGen"] is where 'Cmm' stuff turns into
-- machine instructions.
--
-- * ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
-- a 'SDoc').
--
-- * ["RegAllocInfo"] In the register allocator, we manipulate
-- 'MRegsState's, which are 'BitSet's, one bit per machine register.
-- When we want to say something about a specific machine register
-- (e.g., ``it gets clobbered by this instruction''), we set/unset
-- its bit. Obviously, we do this 'BitSet' thing for efficiency
-- reasons.
--
-- The 'RegAllocInfo' module collects together the machine-specific
-- info needed to do register allocation.
--
-- * ["RegisterAlloc"] The (machine-independent) register allocator.
-- -}
--
module GHC.CmmToAsm
( nativeCodeGen
-- * Test-only exports: see trac #12744
-- used by testGraphNoSpills, which needs to access
-- the register allocator intermediate data structures
-- cmmNativeGen emits
, cmmNativeGen
, NcgImpl(..)
)
where
#include "HsVersions.h"
import GHC.Prelude
import qualified GHC.CmmToAsm.X86.CodeGen as X86.CodeGen
import qualified GHC.CmmToAsm.X86.Regs as X86.Regs
import qualified GHC.CmmToAsm.X86.Instr as X86.Instr
import qualified GHC.CmmToAsm.X86.Ppr as X86.Ppr
import qualified GHC.CmmToAsm.SPARC.CodeGen as SPARC.CodeGen
import qualified GHC.CmmToAsm.SPARC.Regs as SPARC.Regs
import qualified GHC.CmmToAsm.SPARC.Instr as SPARC.Instr
import qualified GHC.CmmToAsm.SPARC.Ppr as SPARC.Ppr
import qualified GHC.CmmToAsm.SPARC.ShortcutJump as SPARC.ShortcutJump
import qualified GHC.CmmToAsm.SPARC.CodeGen.Expand as SPARC.CodeGen.Expand
import qualified GHC.CmmToAsm.PPC.CodeGen as PPC.CodeGen
import qualified GHC.CmmToAsm.PPC.Regs as PPC.Regs
import qualified GHC.CmmToAsm.PPC.RegInfo as PPC.RegInfo
import qualified GHC.CmmToAsm.PPC.Instr as PPC.Instr
import qualified GHC.CmmToAsm.PPC.Ppr as PPC.Ppr
import qualified GHC.CmmToAsm.X86 as X86
import qualified GHC.CmmToAsm.PPC as PPC
import qualified GHC.CmmToAsm.SPARC as SPARC
import GHC.CmmToAsm.Reg.Liveness
import qualified GHC.CmmToAsm.Reg.Linear as Linear
......@@ -71,6 +104,7 @@ import GHC.CmmToAsm.Monad
import GHC.CmmToAsm.CFG
import GHC.CmmToAsm.Dwarf
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.Cmm.DebugBlock
import GHC.Cmm.BlockId
......@@ -90,7 +124,6 @@ import GHC.Driver.Session
import GHC.Driver.Ppr
import GHC.Utils.Misc
import GHC.Types.Basic ( Alignment )
import qualified GHC.Utils.Ppr as Pretty
import GHC.Utils.BufHandle
import GHC.Utils.Outputable as Outputable
......@@ -102,9 +135,6 @@ import GHC.Unit
import GHC.Data.Stream (Stream)
import qualified GHC.Data.Stream as Stream
-- DEBUGGING ONLY
--import GHC.Data.OrdList
import Data.List
import Data.Maybe
import Data.Ord ( comparing )
......@@ -112,54 +142,6 @@ import Control.Exception
import Control.Monad
import System.IO
{-
The native-code generator has machine-independent and
machine-dependent modules.
This module ("AsmCodeGen") is the top-level machine-independent
module. Before entering machine-dependent land, we do some
machine-independent optimisations (defined below) on the
'CmmStmts's.
We convert to the machine-specific 'Instr' datatype with
'cmmCodeGen', assuming an infinite supply of registers. We then use
a machine-independent register allocator ('regAlloc') to rejoin
reality. Obviously, 'regAlloc' has machine-specific helper
functions (see about "RegAllocInfo" below).
Finally, we order the basic blocks of the function so as to minimise
the number of jumps between blocks, by utilising fallthrough wherever
possible.
The machine-dependent bits break down as follows:
* ["MachRegs"] Everything about the target platform's machine
registers (and immediate operands, and addresses, which tend to
intermingle/interact with registers).
* ["MachInstrs"] Includes the 'Instr' datatype (possibly should
have a module of its own), plus a miscellany of other things
(e.g., 'targetDoubleSize', 'smStablePtrTable', ...)
* ["MachCodeGen"] is where 'Cmm' stuff turns into
machine instructions.
* ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
a 'SDoc').
* ["RegAllocInfo"] In the register allocator, we manipulate
'MRegsState's, which are 'BitSet's, one bit per machine register.
When we want to say something about a specific machine register
(e.g., ``it gets clobbered by this instruction''), we set/unset
its bit. Obviously, we do this 'BitSet' thing for efficiency
reasons.
The 'RegAllocInfo' module collects together the machine-specific
info needed to do register allocation.
* ["RegisterAlloc"] The (machine-independent) register allocator.
-}
--------------------
nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqSupply
-> Stream IO RawCmmGroup a
......@@ -167,114 +149,25 @@ nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqS
nativeCodeGen dflags this_mod modLoc h us cmms
= let config = initConfig dflags
platform = ncgPlatform config
nCG' :: ( Outputable statics, Outputable instr
, Outputable jumpDest, Instruction instr)
nCG' :: ( Outputable statics, Outputable jumpDest, Instruction instr)
=> NcgImpl statics instr jumpDest -> IO a
nCG' ncgImpl = nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
in case platformArch platform of
ArchX86 -> nCG' (x86NcgImpl config)
ArchX86_64 -> nCG' (x86_64NcgImpl config)
ArchPPC -> nCG' (ppcNcgImpl config)
ArchS390X -> panic "nativeCodeGen: No NCG for S390X"
ArchSPARC -> nCG' (sparcNcgImpl config)
ArchX86 -> nCG' (X86.ncgX86 config)
ArchX86_64 -> nCG' (X86.ncgX86_64 config)
ArchPPC -> nCG' (PPC.ncgPPC config)
ArchPPC_64 _ -> nCG' (PPC.ncgPPC config)
ArchSPARC -> nCG' (SPARC.ncgSPARC config)
ArchSPARC64 -> panic "nativeCodeGen: No NCG for SPARC64"
ArchS390X -> panic "nativeCodeGen: No NCG for S390X"
ArchARM {} -> panic "nativeCodeGen: No NCG for ARM"
ArchARM64 -> panic "nativeCodeGen: No NCG for ARM64"
ArchPPC_64 _ -> nCG' (ppcNcgImpl config)
ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha"
ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb"
ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel"
ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch"
ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript"
x86NcgImpl :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics)
X86.Instr.Instr X86.Instr.JumpDest
x86NcgImpl config
= (x86_64NcgImpl config)
x86_64NcgImpl :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics)
X86.Instr.Instr X86.Instr.JumpDest
x86_64NcgImpl config
= NcgImpl {
ncgConfig = config
,cmmTopCodeGen = X86.CodeGen.cmmTopCodeGen
,generateJumpTableForInstr = X86.CodeGen.generateJumpTableForInstr config
,getJumpDestBlockId = X86.Instr.getJumpDestBlockId
,canShortcut = X86.Instr.canShortcut
,shortcutStatics = X86.Instr.shortcutStatics
,shortcutJump = X86.Instr.shortcutJump
,pprNatCmmDecl = X86.Ppr.pprNatCmmDecl config
,maxSpillSlots = X86.Instr.maxSpillSlots config
,allocatableRegs = X86.Regs.allocatableRegs platform
,ncgAllocMoreStack = X86.Instr.allocMoreStack platform
,ncgExpandTop = id
,ncgMakeFarBranches = const id
,extractUnwindPoints = X86.CodeGen.extractUnwindPoints
,invertCondBranches = X86.CodeGen.invertCondBranches
}
where
platform = ncgPlatform config
ppcNcgImpl :: NCGConfig -> NcgImpl RawCmmStatics PPC.Instr.Instr PPC.RegInfo.JumpDest
ppcNcgImpl config
= NcgImpl {
ncgConfig = config
,cmmTopCodeGen = PPC.CodeGen.cmmTopCodeGen
,generateJumpTableForInstr = PPC.CodeGen.generateJumpTableForInstr config
,getJumpDestBlockId = PPC.RegInfo.getJumpDestBlockId
,canShortcut = PPC.RegInfo.canShortcut
,shortcutStatics = PPC.RegInfo.shortcutStatics
,shortcutJump = PPC.RegInfo.shortcutJump
,pprNatCmmDecl = PPC.Ppr.pprNatCmmDecl config
,maxSpillSlots = PPC.Instr.maxSpillSlots config
,allocatableRegs = PPC.Regs.allocatableRegs platform
,ncgAllocMoreStack = PPC.Instr.allocMoreStack platform
,ncgExpandTop = id
,ncgMakeFarBranches = PPC.Instr.makeFarBranches
,extractUnwindPoints = const []
,invertCondBranches = \_ _ -> id
}
where
platform = ncgPlatform config
sparcNcgImpl :: NCGConfig -> NcgImpl RawCmmStatics SPARC.Instr.Instr SPARC.ShortcutJump.JumpDest
sparcNcgImpl config
= NcgImpl {
ncgConfig = config
,cmmTopCodeGen = SPARC.CodeGen.cmmTopCodeGen
,generateJumpTableForInstr = SPARC.CodeGen.generateJumpTableForInstr platform
,getJumpDestBlockId = SPARC.ShortcutJump.getJumpDestBlockId
,canShortcut = SPARC.ShortcutJump.canShortcut
,shortcutStatics = SPARC.ShortcutJump.shortcutStatics
,shortcutJump = SPARC.ShortcutJump.shortcutJump
,pprNatCmmDecl = SPARC.Ppr.pprNatCmmDecl config
,maxSpillSlots = SPARC.Instr.maxSpillSlots config
,allocatableRegs = SPARC.Regs.allocatableRegs
,ncgAllocMoreStack = noAllocMoreStack
,ncgExpandTop = map SPARC.CodeGen.Expand.expandTop
,ncgMakeFarBranches = const id
,extractUnwindPoints = const []
,invertCondBranches = \_ _ -> id
}
where
platform = ncgPlatform config
--
-- Allocating more stack space for spilling is currently only
-- supported for the linear register allocator on x86/x86_64, the rest
-- default to the panic below. To support allocating extra stack on
-- more platforms provide a definition of ncgAllocMoreStack.
--
noAllocMoreStack :: Int -> NatCmmDecl statics instr
-> UniqSM (NatCmmDecl statics instr, [(BlockId,BlockId)])
noAllocMoreStack amount _
= panic $ "Register allocator: out of stack slots (need " ++ show amount ++ ")\n"
++ " If you are trying to compile SHA1.hs from the crypto library then this\n"
++ " is a known limitation in the linear allocator.\n"
++ "\n"
++ " Try enabling the graph colouring allocator with -fregs-graph instead."
++ " You can still file a bug report if you like.\n"
-- | Data accumulated during code generation. Mostly about statistics,
-- but also collects debug data for DWARF generation.
......@@ -320,8 +213,7 @@ unwinding table).
See also Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock".
-}
nativeCodeGen' :: (Outputable statics, Outputable instr,Outputable jumpDest,
Instruction instr)
nativeCodeGen' :: (Outputable statics, Outputable jumpDest, Instruction instr)
=> DynFlags
-> Module -> ModLocation
-> NcgImpl statics instr jumpDest
......@@ -397,8 +289,7 @@ finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs
(dumpOptionsFromFlag Opt_D_dump_asm_stats) "NCG stats"
FormatText
cmmNativeGenStream :: (Outputable statics, Outputable instr
,Outputable jumpDest, Instruction instr)
cmmNativeGenStream :: (Outputable statics, Outputable jumpDest, Instruction instr)
=> DynFlags
-> Module -> ModLocation
-> NcgImpl statics instr jumpDest
......@@ -453,8 +344,7 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
-- | Do native code generation on all these cmms.
--
cmmNativeGens :: forall statics instr jumpDest.
(Outputable statics, Outputable instr
,Outputable jumpDest, Instruction instr)
(Outputable statics, Outputable jumpDest, Instruction instr)
=> DynFlags
-> Module -> ModLocation
-> NcgImpl statics instr jumpDest
......@@ -530,8 +420,7 @@ emitNativeCode dflags h sdoc = do
-- Dumping the output of each stage along the way.
-- Global conflict graph and NGC stats
cmmNativeGen
:: forall statics instr jumpDest. (Instruction instr,
Outputable statics, Outputable instr, Outputable jumpDest)
:: forall statics instr jumpDest. (Instruction instr, Outputable statics, Outputable jumpDest)
=> DynFlags
-> Module -> ModLocation
-> NcgImpl statics instr jumpDest
......@@ -602,7 +491,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
dumpIfSet_dyn dflags
Opt_D_dump_asm_liveness "Liveness annotations added"
FormatCMM
(vcat $ map ppr withLiveness)
(vcat $ map (pprLiveCmmDecl platform) withLiveness)
-- allocate registers
(alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear, raStats, stack_updt_blks) <-
......@@ -650,7 +539,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
(vcat $ map (\(stage, stats)
-> text "# --------------------------"
$$ text "# cmm " <> int count <> text " Stage " <> int stage
$$ ppr stats)
$$ ppr (fmap (pprInstr platform) stats))
$ zip [0..] regAllocStats)
let mPprStats =
......
......@@ -22,6 +22,7 @@ import GHC.Driver.Ppr (pprTrace)
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Monad
import GHC.CmmToAsm.CFG
import GHC.CmmToAsm.Types
import GHC.Cmm.BlockId
import GHC.Cmm
......@@ -668,7 +669,7 @@ buildChains edges blocks
-- | Place basic blocks based on the given CFG.
-- See Note [Chain based CFG serialization]
sequenceChain :: forall a i. (Instruction i, Outputable i)
sequenceChain :: forall a i. Instruction i
=> LabelMap a -- ^ Keys indicate an info table on the block.
-> CFG -- ^ Control flow graph and some meta data.
-> [GenBasicBlock i] -- ^ List of basic blocks to be placed.
......@@ -815,7 +816,7 @@ dropJumps info ((BasicBlock lbl ins):todo)
-- fallthroughs.
sequenceTop
:: (Instruction instr, Outputable instr)
:: Instruction instr
=> DynFlags -- Determine which layout algo to use
-> NcgImpl statics instr jumpDest
-> Maybe CFG -- ^ CFG if we have one.
......
module GHC.CmmToAsm.Instr (
RegUsage(..),
noUsage,
GenBasicBlock(..), blockId,
ListGraph(..),
NatCmm,
NatCmmDecl,
NatBasicBlock,
topInfoTable,
entryBlocks,
Instruction(..)
)
module GHC.CmmToAsm.Instr
( Instruction(..)
, RegUsage(..)
, noUsage
)
where
import GHC.Prelude
import GHC.Platform
import GHC.Platform.Reg
import GHC.Utils.Outputable (SDoc)
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Label
import GHC.Cmm hiding (topInfoTable)
import GHC.CmmToAsm.Config
......@@ -46,51 +36,11 @@ data RegUsage
noUsage :: RegUsage
noUsage = RU [] []
-- Our flavours of the Cmm types
-- Type synonyms for Cmm populated with native code
type NatCmm instr
= GenCmmGroup
RawCmmStatics
(LabelMap RawCmmStatics)
(ListGraph instr)
type NatCmmDecl statics instr
= GenCmmDecl
statics
(LabelMap RawCmmStatics)
(ListGraph instr)
type NatBasicBlock instr
= GenBasicBlock instr
-- | Returns the info table associated with the CmmDecl's entry point,
-- if any.
topInfoTable :: GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
topInfoTable (CmmProc infos _ _ (ListGraph (b:_)))
= mapLookup (blockId b) infos
topInfoTable _
= Nothing
-- | Return the list of BlockIds in a CmmDecl that are entry points
-- for this proc (i.e. they may be jumped to from outside this proc).
entryBlocks :: GenCmmDecl a (LabelMap i) (ListGraph b) -> [BlockId]
entryBlocks (CmmProc info _ _ (ListGraph code)) = entries
where
infos = mapKeys info
entries = case code of
[] -> infos
BasicBlock entry _ : _ -- first block is the entry point
| entry `elem` infos -> infos
| otherwise -> entry : infos
entryBlocks _ = []
-- | Common things that we can do with instructions, on all architectures.
-- These are used by the shared parts of the native code generator,
-- specifically the register allocators.
--
class Instruction instr where
class Instruction instr where
-- | Get the registers that are being used by this instruction.
-- regUsage doesn't need to do any trickery for jumps and such.
......@@ -204,3 +154,6 @@ class Instruction instr where
:: Platform
-> Int
-> [instr]
-- | Pretty-print an instruction
pprInstr :: Platform -> instr -> SDoc
......@@ -53,6 +53,7 @@ import GHC.Platform.Reg
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Reg.Target
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Collections
......@@ -68,10 +69,8 @@ import GHC.Unit.Module
import Control.Monad ( ap )
import GHC.CmmToAsm.Instr
import GHC.Utils.Outputable (SDoc, ppr)
import GHC.Utils.Panic (pprPanic)
import GHC.Cmm (RawCmmDecl, RawCmmStatics)
import GHC.CmmToAsm.CFG
data NcgImpl statics instr jumpDest = NcgImpl {
......
......@@ -54,10 +54,10 @@ import qualified GHC.CmmToAsm.PPC.Regs as PPC
import qualified GHC.CmmToAsm.X86.Instr as X86
import GHC.Platform
import GHC.CmmToAsm.Instr
import GHC.Platform.Reg
import GHC.CmmToAsm.Monad
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.Cmm.Dataflow.Collections
......
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Native code generator for PPC architectures
module GHC.CmmToAsm.PPC
( ncgPPC
)
where
import GHC.Prelude
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Monad
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import qualified GHC.CmmToAsm.PPC.Instr as PPC
import qualified GHC.CmmToAsm.PPC.Ppr as PPC
import qualified GHC.CmmToAsm.PPC.CodeGen as PPC
import qualified GHC.CmmToAsm.PPC.Regs as PPC
import qualified GHC.CmmToAsm.PPC.RegInfo as PPC
ncgPPC :: NCGConfig -> NcgImpl RawCmmStatics PPC.Instr PPC.JumpDest
ncgPPC config = NcgImpl
{ ncgConfig = config
, cmmTopCodeGen = PPC.cmmTopCodeGen
, generateJumpTableForInstr = PPC.generateJumpTableForInstr config
, getJumpDestBlockId = PPC.getJumpDestBlockId
, canShortcut = PPC.canShortcut
, shortcutStatics = PPC.shortcutStatics
, shortcutJump = PPC.shortcutJump
, pprNatCmmDecl = PPC.pprNatCmmDecl config
, maxSpillSlots = PPC.maxSpillSlots config
, allocatableRegs = PPC.allocatableRegs platform
, ncgAllocMoreStack = PPC.allocMoreStack platform
, ncgExpandTop = id
, ncgMakeFarBranches = PPC.makeFarBranches
, extractUnwindPoints = const []
, invertCondBranches = \_ _ -> id
}
where
platform = ncgPlatform config
-- | Instruction instance for powerpc
instance Instruction PPC.Instr where
regUsageOfInstr = PPC.regUsageOfInstr
patchRegsOfInstr = PPC.patchRegsOfInstr
isJumpishInstr = PPC.isJumpishInstr
jumpDestsOfInstr = PPC.jumpDestsOfInstr
patchJumpInstr = PPC.patchJumpInstr
mkSpillInstr = PPC.mkSpillInstr
mkLoadInstr = PPC.mkLoadInstr
takeDeltaInstr = PPC.takeDeltaInstr
isMetaInstr = PPC.isMetaInstr
mkRegRegMoveInstr _ = PPC.mkRegRegMoveInstr
takeRegRegMoveInstr = PPC.takeRegRegMoveInstr
mkJumpInstr = PPC.mkJumpInstr
mkStackAllocInstr = PPC.mkStackAllocInstr
mkStackDeallocInstr = PPC.mkStackDeallocInstr
pprInstr = PPC.pprInstr
......@@ -30,6 +30,7 @@ import GHC.CmmToAsm.PPC.Instr
import GHC.CmmToAsm.PPC.Cond
import GHC.CmmToAsm.PPC.Regs
import GHC.CmmToAsm.CPrim
import GHC.CmmToAsm.Types
import GHC.Cmm.DebugBlock
( DebugBlock(..) )
import GHC.CmmToAsm.Monad
......@@ -38,7 +39,6 @@ import GHC.CmmToAsm.Monad
, getPicBaseMaybeNat, getPlatform, getConfig
, getDebugBlock, getFileId
)
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.PIC
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Config
......
......@@ -12,23 +12,37 @@
#include "HsVersions.h"
module GHC.CmmToAsm.PPC.Instr (
archWordFormat,
RI(..),
Instr(..),
stackFrameHeaderSize,
maxSpillSlots,
allocMoreStack,
makeFarBranches
)
module GHC.CmmToAsm.PPC.Instr
( Instr(..)
, RI(..)
, archWordFormat
, stackFrameHeaderSize
, maxSpillSlots
, allocMoreStack
, makeFarBranches
, mkJumpInstr
, mkLoadInstr
, mkSpillInstr
, patchJumpInstr
, patchRegsOfInstr
, jumpDestsOfInstr
, takeRegRegMoveInstr
, takeDeltaInstr
, mkRegRegMoveInstr
, mkStackAllocInstr
, mkStackDeallocInstr
, regUsageOfInstr
, isJumpishInstr
, isMetaInstr
)
where
import GHC.Prelude
import GHC.CmmToAsm.PPC.Regs
import GHC.CmmToAsm.PPC.Cond
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Instr (RegUsage(..), noUsage)
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Reg.Target
import GHC.CmmToAsm.Config
......@@ -60,34 +74,16 @@ archWordFormat is32Bit
| otherwise = II64
-- | Instruction instance for powerpc
instance Instruction Instr where
regUsageOfInstr = ppc_regUsageOfInstr
patchRegsOfInstr = ppc_patchRegsOfInstr
isJumpishInstr = ppc_isJumpishInstr
jumpDestsOfInstr = ppc_jumpDestsOfInstr
patchJumpInstr = ppc_patchJumpInstr
mkSpillInstr = ppc_mkSpillInstr
mkLoadInstr = ppc_mkLoadInstr
takeDeltaInstr = ppc_takeDeltaInstr
isMetaInstr = ppc_isMetaInstr
mkRegRegMoveInstr _ = ppc_mkRegRegMoveInstr
takeRegRegMoveInstr = ppc_takeRegRegMoveInstr
mkJumpInstr = ppc_mkJumpInstr
mkStackAllocInstr = ppc_mkStackAllocInstr
mkStackDeallocInstr = ppc_mkStackDeallocInstr
ppc_mkStackAllocInstr :: Platform -> Int -> [Instr]
ppc_mkStackAllocInstr platform amount
= ppc_mkStackAllocInstr' platform (-amount)
ppc_mkStackDeallocInstr :: Platform -> Int -> [Instr]
ppc_mkStackDeallocInstr platform amount
= ppc_mkStackAllocInstr' platform amount
ppc_mkStackAllocInstr' :: Platform -> Int -> [Instr]
ppc_mkStackAllocInstr' platform amount
mkStackAllocInstr :: Platform -> Int -> [Instr]
mkStackAllocInstr platform amount
= mkStackAllocInstr' platform (-amount)
mkStackDeallocInstr :: Platform -> Int -> [Instr]
mkStackDeallocInstr platform amount
= mkStackAllocInstr' platform amount
mkStackAllocInstr' :: Platform -> Int -> [Instr]
mkStackAllocInstr' platform amount
| fits16Bits amount
= [ LD fmt r0 (AddrRegImm sp zero)
, STU fmt r0 (AddrRegImm sp immAmount)
......@@ -313,8 +309,8 @@ data Instr
-- The consequences of control flow transfers, as far as register
-- allocation goes, are taken care of by the register allocator.
--
ppc_regUsageOfInstr :: Platform -> Instr -> RegUsage
ppc_regUsageOfInstr platform instr
regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr platform instr
= case instr of
LD _ reg addr -> usage (regAddr addr, [reg])
LDFAR _ reg addr -> usage (regAddr addr, [reg])
......@@ -406,8 +402,8 @@ interesting _ (RegReal (RealRegPair{}))
-- | Apply a given mapping to all the register references in this
-- instruction.
ppc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
ppc_patchRegsOfInstr instr env
patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr instr env
= case instr of
LD fmt reg addr -> LD fmt (env reg) (fixAddr addr)
LDFAR fmt reg addr -> LDFAR fmt (env reg) (fixAddr addr)
......@@ -497,8 +493,8 @@ ppc_patchRegsOfInstr instr env
-- | Checks whether this instruction is a jump/branch instruction.
-- One that can change the flow of control in a way that the
-- register allocator needs to worry about.
ppc_isJumpishInstr :: Instr -> Bool
ppc_isJumpishInstr instr
isJumpishInstr :: Instr -> Bool
isJumpishInstr instr
= case instr of
BCC{} -> True
BCCFAR{} -> True
......@@ -512,8 +508,8 @@ ppc_isJumpishInstr instr
-- | Checks whether this instruction is a jump/branch instruction.
-- One that can change the flow of control in a way that the
-- register allocator needs to worry about.
ppc_jumpDestsOfInstr :: Instr -> [BlockId]
ppc_jumpDestsOfInstr insn
jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr insn
= case insn of
BCC _ id _ -> [id]
BCCFAR _ id _ -> [id]
......@@ -524,8 +520,8 @@ ppc_jumpDestsOfInstr insn
-- | Change the destination of this jump instruction.
-- Used in the linear allocator when adding fixup blocks for join
-- points.
ppc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
ppc_patchJumpInstr insn patchF
patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr insn patchF
= case insn of
BCC cc id p -> BCC cc (patchF id) p
BCCFAR cc id p -> BCCFAR cc (patchF id) p
......@@ -536,14 +532,14 @@ ppc_patchJumpInstr insn patchF
-- -----------------------------------------------------------------------------
-- | An instruction to spill a register into a spill slot.
ppc_mkSpillInstr
mkSpillInstr
:: NCGConfig
-> Reg -- register to spill
-> Int -- current stack delta
-> Int -- spill slot to use
-> Instr
ppc_mkSpillInstr config reg delta slot
mkSpillInstr config reg delta slot
= let platform = ncgPlatform config
off = spillSlotToOffset platform slot
arch = platformArch platform
......@@ -561,14 +557,14 @@ ppc_mkSpillInstr config reg delta slot
in instr fmt reg (AddrRegImm sp (ImmInt (off-delta)))
ppc_mkLoadInstr
mkLoadInstr
:: NCGConfig
-> Reg -- register to load
-> Int -- current stack delta
-> Int -- spill slot to use
-> Instr
ppc_mkLoadInstr config reg delta slot
mkLoadInstr config reg delta slot
= let platform = ncgPlatform config
off = spillSlotToOffset platform slot
arch = platformArch platform
......@@ -629,21 +625,21 @@ spillSlotToOffset platform slot
--------------------------------------------------------------------------------
-- | See if this instruction is telling us the current C stack delta
ppc_takeDeltaInstr
takeDeltaInstr
:: Instr
-> Maybe Int
ppc_takeDeltaInstr instr
takeDeltaInstr instr
= case instr of
DELTA i -> Just i
_ -> Nothing
ppc_isMetaInstr
isMetaInstr
:: Instr
-> Bool
ppc_isMetaInstr instr
isMetaInstr instr
= case instr of
COMMENT{} -> True
LOCATION{} -> True
......@@ -655,29 +651,29 @@ ppc_isMetaInstr instr
-- | Copy the value in a register to another one.
-- Must work for all register classes.
ppc_mkRegRegMoveInstr
mkRegRegMoveInstr
:: Reg
-> Reg
-> Instr
ppc_mkRegRegMoveInstr src dst
mkRegRegMoveInstr src dst
= MR dst src
-- | Make an unconditional jump instruction.
ppc_mkJumpInstr
mkJumpInstr
:: BlockId
-> [Instr]
ppc_mkJumpInstr id
mkJumpInstr id
= [BCC ALWAYS id Nothing]
-- | Take the source and destination from this reg -> reg move instruction
-- or Nothing if it's not one
ppc_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
ppc_takeRegRegMoveInstr (MR dst src) = Just (src,dst)
ppc_takeRegRegMoveInstr _ = Nothing
takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
takeRegRegMoveInstr (MR dst src) = Just (src,dst)
takeRegRegMoveInstr _ = Nothing
-- -----------------------------------------------------------------------------
-- Making far branches
......
......@@ -6,8 +6,11 @@
--
-----------------------------------------------------------------------------
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.CmmToAsm.PPC.Ppr (pprNatCmmDecl) where
module GHC.CmmToAsm.PPC.Ppr
( pprNatCmmDecl
, pprInstr
)
where
import GHC.Prelude
......@@ -15,12 +18,13 @@ import GHC.CmmToAsm.PPC.Regs
import GHC.CmmToAsm.PPC.Instr
import GHC.CmmToAsm.PPC.Cond
import GHC.CmmToAsm.Ppr
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Format
import GHC.Platform.Reg
import GHC.Platform.Reg.Class
import GHC.CmmToAsm.Reg.Target
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils
import GHC.Cmm hiding (topInfoTable)
import GHC.Cmm.Dataflow.Collections
......@@ -35,7 +39,6 @@ import GHC.Platform
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Driver.Session (targetPlatform)
import Data.Word
import Data.Int
......@@ -185,11 +188,6 @@ pprLabel platform lbl =
-- -----------------------------------------------------------------------------
-- pprInstr: print an 'Instr'
instance Outputable Instr where
ppr instr = sdocWithDynFlags $ \dflags ->
pprInstr (targetPlatform dflags) instr
pprReg :: Reg -> SDoc
pprReg r
......@@ -239,9 +237,8 @@ pprImm (ImmInteger i) = integer i
pprImm (ImmCLbl l) = ppr l
pprImm (ImmIndex l i) = ppr l <> char '+' <> int i
pprImm (ImmLit s) = s
pprImm (ImmFloat _) = text "naughty float immediate"
pprImm (ImmDouble _) = text "naughty double immediate"
pprImm (ImmFloat f) = float $ fromRational f
pprImm (ImmDouble d) = double $ fromRational d
pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
......@@ -339,13 +336,8 @@ pprDataItem platform lit
<> int (fromIntegral (fromIntegral x :: Word32))]
ppr_item FF32 (CmmFloat r _)
= let bs = floatToBytes (fromRational r)
in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
ppr_item FF64 (CmmFloat r _)
= let bs = doubleToBytes (fromRational r)
in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
ppr_item FF32 _ = [text "\t.float\t" <> pprImm imm]
ppr_item FF64 _ = [text "\t.double\t" <> pprImm imm]
ppr_item _ _
= panic "PPC.Ppr.pprDataItem: no match"
......
......@@ -9,9 +9,6 @@
-----------------------------------------------------------------------------
module GHC.CmmToAsm.Ppr (
castFloatToWord8Array,
castDoubleToWord8Array,
floatToBytes,
doubleToBytes,
pprASCII,
pprString,
......@@ -44,13 +41,13 @@ import qualified Data.ByteString as BS
import GHC.Exts
import GHC.Word
-- -----------------------------------------------------------------------------
-- Converting floating-point literals to integrals for printing
castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
castFloatToWord8Array = U.castSTUArray
-- ToDo: this code is currently shared between SPARC and LLVM.
-- Similar functions for (single precision) floats are
-- present in the SPARC backend only. We need to fix both
-- LLVM and SPARC.
castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
castDoubleToWord8Array = U.castSTUArray
......@@ -63,19 +60,6 @@ castDoubleToWord8Array = U.castSTUArray
-- ToDo: this stuff is very similar to the shenanigans in PprAbs,
-- could they be merged?
floatToBytes :: Float -> [Int]
floatToBytes f
= runST (do
arr <- newArray_ ((0::Int),3)
writeArray arr 0 f
arr <- castFloatToWord8Array arr
i0 <- readArray arr 0
i1 <- readArray arr 1
i2 <- readArray arr 2
i3 <- readArray arr 3
return (map fromIntegral [i0,i1,i2,i3])
)
doubleToBytes :: Double -> [Int]
doubleToBytes d
= runST (do
......
......@@ -17,6 +17,7 @@ import GHC.CmmToAsm.Reg.Graph.TrivColorable
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Reg.Target
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.Platform.Reg.Class
import GHC.Platform.Reg
......@@ -45,7 +46,7 @@ maxSpinCount = 10
-- | The top level of the graph coloring register allocator.
regAlloc
:: (Outputable statics, Outputable instr, Instruction instr)
:: (Outputable statics, Instruction instr)
=> NCGConfig
-> UniqFM RegClass (UniqSet RealReg) -- ^ registers we can use for allocation
-> UniqSet Int -- ^ set of available spill slots.
......@@ -90,7 +91,6 @@ regAlloc config regsFree slotsFree slotsCount code cfg
regAlloc_spin
:: forall instr statics.
(Instruction instr,
Outputable instr,
Outputable statics)
=> NCGConfig
-> Int -- ^ Number of solver iterations we've already performed.
......@@ -388,7 +388,7 @@ graphAddCoalesce (r1, r2) graph
-- | Patch registers in code using the reg -> reg mapping in this graph.
patchRegsFromGraph
:: (Outputable statics, Outputable instr, Instruction instr)
:: (Outputable statics, Instruction instr)
=> Platform -> Color.Graph VirtualReg RegClass RealReg
-> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
......@@ -413,7 +413,7 @@ patchRegsFromGraph platform graph code
= pprPanic "patchRegsFromGraph: register mapping failed."
( text "There is no node in the graph for register "
<> ppr reg
$$ ppr code
$$ pprLiveCmmDecl platform code
$$ Color.dotGraph
(\_ -> text "white")
(trivColorable platform
......
......@@ -76,7 +76,7 @@ plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)
-- For each vreg, the number of times it was written to, read from,
-- and the number of instructions it was live on entry to (lifetime)
--
slurpSpillCostInfo :: forall instr statics. (Outputable instr, Instruction instr)
slurpSpillCostInfo :: forall instr statics. Instruction instr
=> Platform
-> Maybe CFG
-> LiveCmmDecl statics instr
......@@ -116,7 +116,7 @@ slurpSpillCostInfo platform cfg cmm
| otherwise
= pprPanic "RegSpillCost.slurpSpillCostInfo"
$ text "no liveness information on instruction " <> ppr instr
$ text "no liveness information on instruction " <> pprInstr platform instr
countLIs scale rsLiveEntry (LiveInstr instr (Just live) : lis)
= do
......
{-# LANGUAGE BangPatterns, CPP #-}
{-# LANGUAGE BangPatterns, CPP, DeriveFunctor #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
......@@ -23,15 +23,17 @@ import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Reg.Graph.Spill
import GHC.CmmToAsm.Reg.Graph.SpillCost
import GHC.CmmToAsm.Reg.Graph.TrivColorable
import GHC.CmmToAsm.Instr
import GHC.Platform.Reg.Class
import GHC.Platform.Reg
import GHC.CmmToAsm.Reg.Target
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Types
import GHC.Platform
import GHC.Platform.Reg
import GHC.Platform.Reg.Class
import GHC.Utils.Outputable
import GHC.Types.Unique.FM
import GHC.Types.Unique.Set
import GHC.Utils.Outputable
import GHC.Utils.Monad.State
-- | Holds interesting statistics from the register allocator.
......@@ -108,6 +110,7 @@ data RegAllocStats statics instr
-- | Target platform
, raPlatform :: !Platform
}
deriving (Functor)
instance (Outputable statics, Outputable instr)
......
......@@ -122,6 +122,7 @@ import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Reg.Utils
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.Platform.Reg
import GHC.Cmm.BlockId
......@@ -147,7 +148,7 @@ import Control.Applicative
-- Allocate registers
regAlloc
:: (Outputable instr, Instruction instr)
:: Instruction instr
=> NCGConfig
-> LiveCmmDecl statics instr
-> UniqSM ( NatCmmDecl statics instr
......@@ -204,7 +205,7 @@ regAlloc _ (CmmProc _ _ _ _)
-- an entry in the block map or it is the first block.
--
linearRegAlloc
:: (Outputable instr, Instruction instr)
:: Instruction instr
=> NCGConfig
-> [BlockId] -- ^ entry points
-> BlockMap RegSet
......@@ -236,7 +237,7 @@ linearRegAlloc config entry_ids block_live sccs
-- | Constraints on the instruction instances used by the
-- linear allocator.
type OutputableRegConstraint freeRegs instr =
(FR freeRegs, Outputable freeRegs, Outputable instr, Instruction instr)
(FR freeRegs, Outputable freeRegs, Instruction instr)
linearRegAlloc'
:: OutputableRegConstraint freeRegs instr
......@@ -468,7 +469,10 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
-- See Note [Unique Determinism and code generation]
raInsn _ _ _ instr
= pprPanic "raInsn" (text "no match for:" <> ppr instr)
= do
platform <- getPlatform
let instr' = fmap (pprInstr platform) instr
pprPanic "raInsn" (text "no match for:" <> ppr instr')
-- ToDo: what can we do about
--
......@@ -764,7 +768,7 @@ data SpillLoc = ReadMem StackSlot -- reading from register only in memory
-- the list of free registers and free stack slots.
allocateRegsAndSpill
:: forall freeRegs instr. (FR freeRegs, Outputable instr, Instruction instr)
:: forall freeRegs instr. (FR freeRegs, Instruction instr)
=> Bool -- True <=> reading (load up spilled regs)
-> [VirtualReg] -- don't push these out
-> [instr] -- spill insns
......@@ -830,7 +834,7 @@ findPrefRealReg vreg = do
-- reading is redundant with reason, but we keep it around because it's
-- convenient and it maintains the recursive structure of the allocator. -- EZY
allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr)
allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr)
=> Bool
-> [VirtualReg]
-> [instr]
......
......@@ -18,12 +18,13 @@ import GHC.CmmToAsm.Reg.Linear.FreeRegs
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.Platform.Reg
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Collections
import GHC.Data.Graph.Directed
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.Unique
import GHC.Types.Unique.FM
......@@ -33,7 +34,7 @@ import GHC.Types.Unique.Set
-- vregs are in the correct regs for its destination.
--
joinToTargets
:: (FR freeRegs, Instruction instr, Outputable instr)
:: (FR freeRegs, Instruction instr)
=> BlockMap RegSet -- ^ maps the unique of the blockid to the set of vregs
-- that are known to be live on the entry to each block.
......@@ -57,7 +58,7 @@ joinToTargets block_live id instr
-----
joinToTargets'
:: (FR freeRegs, Instruction instr, Outputable instr)
:: (FR freeRegs, Instruction instr)
=> BlockMap RegSet -- ^ maps the unique of the blockid to the set of vregs
-- that are known to be live on the entry to each block.
......@@ -111,7 +112,7 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests)
-- this is the first time we jumped to this block.
joinToTargets_first :: (FR freeRegs, Instruction instr, Outputable instr)
joinToTargets_first :: (FR freeRegs, Instruction instr)
=> BlockMap RegSet
-> [NatBasicBlock instr]
-> BlockId
......@@ -140,7 +141,7 @@ joinToTargets_first block_live new_blocks block_id instr dest dests
-- we've jumped to this block before
joinToTargets_again :: (Instruction instr, FR freeRegs, Outputable instr)
joinToTargets_again :: (Instruction instr, FR freeRegs)
=> BlockMap RegSet
-> [NatBasicBlock instr]
-> BlockId
......
......@@ -12,10 +12,11 @@ import GHC.CmmToAsm.Reg.Linear.Base
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Instr
import GHC.Types.Unique (Unique)
import GHC.CmmToAsm.Types
import GHC.Types.Unique.FM
import GHC.Utils.Outputable
import GHC.Utils.Outputable
import GHC.Utils.Monad.State
-- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
......
......@@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
......@@ -26,6 +27,7 @@ module GHC.CmmToAsm.Reg.Liveness (
mapBlockTop, mapBlockTopM, mapSCCM,
mapGenBlockTop, mapGenBlockTopM,
mapLiveCmmDecl, pprLiveCmmDecl,
stripLive,
stripLiveBlock,
slurpConflicts,
......@@ -43,6 +45,8 @@ import GHC.Platform.Reg
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.CFG
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Collections
......@@ -106,6 +110,8 @@ data InstrSR instr
-- | reload this reg from a stack slot
| RELOAD Int Reg
deriving (Functor)
instance Instruction instr => Instruction (InstrSR instr) where
regUsageOfInstr platform i
= case i of
......@@ -163,10 +169,13 @@ instance Instruction instr => Instruction (InstrSR instr) where
mkStackDeallocInstr platform amount =
Instr <$> mkStackDeallocInstr platform amount
pprInstr platform i = ppr (fmap (pprInstr platform) i)
-- | An instruction with liveness information.
data LiveInstr instr
= LiveInstr (InstrSR instr) (Maybe Liveness)
deriving (Functor)
-- | Liveness information.
-- The regs which die are ones which are no longer live in the *next* instruction
......@@ -494,7 +503,7 @@ slurpReloadCoalesce live
-- | Strip away liveness information, yielding NatCmmDecl
stripLive
:: (Outputable statics, Outputable instr, Instruction instr)
:: (Outputable statics, Instruction instr)
=> NCGConfig
-> LiveCmmDecl statics instr
-> NatCmmDecl statics instr
......@@ -502,7 +511,7 @@ stripLive
stripLive config live
= stripCmm live
where stripCmm :: (Outputable statics, Outputable instr, Instruction instr)
where stripCmm :: (Outputable statics, Instruction instr)
=> LiveCmmDecl statics instr -> NatCmmDecl statics instr
stripCmm (CmmData sec ds) = CmmData sec ds
stripCmm (CmmProc (LiveInfo info (first_id:_) _ _) label live sccs)
......@@ -519,7 +528,21 @@ stripLive config live
-- If the proc has blocks but we don't know what the first one was, then we're dead.
stripCmm proc
= pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (ppr proc)
= pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (pprLiveCmmDecl (ncgPlatform config) proc)
-- | Pretty-print a `LiveCmmDecl`
pprLiveCmmDecl :: (Outputable statics, Instruction instr) => Platform -> LiveCmmDecl statics instr -> SDoc
pprLiveCmmDecl platform d = ppr (mapLiveCmmDecl (pprInstr platform) d)
-- | Map over instruction type in `LiveCmmDecl`
mapLiveCmmDecl
:: Outputable statics
=> (instr -> b)
-> LiveCmmDecl statics instr
-> LiveCmmDecl statics b
mapLiveCmmDecl f proc = fmap (fmap (fmap (fmap (fmap f)))) proc
-- | Strip away liveness information from a basic block,
-- and make real spill instructions out of SPILL, RELOAD pseudos along the way.
......@@ -653,15 +676,16 @@ patchRegsLiveInstr patchF li
-- | Convert a NatCmmDecl to a LiveCmmDecl, with liveness information
cmmTopLiveness
:: (Outputable instr, Instruction instr)
=> Maybe CFG -> Platform
:: Instruction instr
=> Maybe CFG
-> Platform
-> NatCmmDecl statics instr
-> UniqSM (LiveCmmDecl statics instr)
cmmTopLiveness cfg platform cmm
= regLiveness platform $ natCmmTopToLive cfg cmm
natCmmTopToLive
:: (Instruction instr, Outputable instr)
:: Instruction instr
=> Maybe CFG -> NatCmmDecl statics instr
-> LiveCmmDecl statics instr
......@@ -747,7 +771,7 @@ sccBlocks blocks entries mcfg = map (fmap node_payload) sccs
--
regLiveness
:: (Outputable instr, Instruction instr)
:: Instruction instr
=> Platform
-> LiveCmmDecl statics instr
-> UniqSM (LiveCmmDecl statics instr)
......@@ -830,7 +854,7 @@ reverseBlocksInTops top
-- want for the next pass.
--
computeLiveness
:: (Outputable instr, Instruction instr)
:: Instruction instr
=> Platform
-> [SCC (LiveBasicBlock instr)]
-> ([SCC (LiveBasicBlock instr)], -- instructions annotated with list of registers
......@@ -841,10 +865,11 @@ computeLiveness
computeLiveness platform sccs
= case checkIsReverseDependent sccs of
Nothing -> livenessSCCs platform mapEmpty [] sccs
Just bad -> pprPanic "RegAlloc.Liveness.computeLiveness"
Just bad -> let sccs' = fmap (fmap (fmap (fmap (pprInstr platform)))) sccs
in pprPanic "RegAlloc.Liveness.computeLiveness"
(vcat [ text "SCCs aren't in reverse dependent order"
, text "bad blockId" <+> ppr bad
, ppr sccs])
, ppr sccs'])
livenessSCCs
:: Instruction instr
......