From 57b80ee588047a212a21d7a583d44e369c671ed8 Mon Sep 17 00:00:00 2001 From: sewardj Date: Mon, 2 Oct 2000 13:58:51 +0000 Subject: [PATCH] [project @ 2000-10-02 13:58:51 by sewardj] Implement initial-state (emptyTy :: Ty) functions. --- ghc/compiler/ghci/CmCompile.lhs | 26 ++++++++++++++++-------- ghc/compiler/ghci/CmLink.lhs | 5 +++-- ghc/compiler/ghci/CompManager.lhs | 35 ++++++++++++++++++++++++++++---- ghc/compiler/main/Main.lhs | 3 +++ ghc/compiler/nativeGen/AsmRegAlloc.lhs | 20 ++++++++++++++++-- 5 files changed, 73 insertions(+), 16 deletions(-) diff --git a/ghc/compiler/ghci/CmCompile.lhs b/ghc/compiler/ghci/CmCompile.lhs index 2b32e05..e1d238b 100644 --- a/ghc/compiler/ghci/CmCompile.lhs +++ b/ghc/compiler/ghci/CmCompile.lhs @@ -5,11 +5,11 @@ \begin{code} module CmCompile ( cmCompile, - ModDetails, -- abstract - ModIFace, -- abstract - PCS, -- abstract - HST, -- not abstract (CM needs to see it) - HIT, -- ditto + ModDetails, -- abstract + ModIFace, -- abstract + PCS, emptyPCS, -- abstract + HST, -- not abstract (CM needs to see it) + HIT, -- ditto CompResult(..) ) where @@ -21,7 +21,7 @@ import Outputable ( SDoc ) import CmFind ( Finder ) import CmSummarise ( ModSummary ) import CmStaticInfo ( SI ) -import FiniteMap ( FiniteMap ) +import FiniteMap ( FiniteMap, emptyFM ) import Module ( Module ) import RnMonad ( Avails, GlobalRdrEnv, DeclsMap, @@ -61,8 +61,9 @@ data CompResult | CompErrs PCS -- updated PCS [SDoc] -- warnings and errors -newPCS :: IO PCS -newPCS = return (error "newPCS:unimp") +emptyPCS :: IO PCS +emptyPCS = return (MkPCS emptyPIT emptyPST emptyHoldingPen) + -- These two are only here to avoid recursion between CmCompile and -- CompManager. They really ought to be in the latter. @@ -77,6 +78,12 @@ data PCS = MkPCS PIT -- Package interface table type PIT = FiniteMap Module ModIFace type PST = FiniteMap Module ModDetails +emptyPIT :: PIT +emptyPIT = emptyFM + +emptyPST :: PST +emptyPST = emptyFM + -- ModIFace is nearly the same as RnMonad.ParsedIface. -- Right now it's identical :) data ModIFace @@ -118,4 +125,7 @@ data HoldingPen iRules :: IfaceRules -- Similar to instance decls, only for rules } + +emptyHoldingPen :: HoldingPen +emptyHoldingPen = error "emptyHoldingPen:unimp" \end{code} diff --git a/ghc/compiler/ghci/CmLink.lhs b/ghc/compiler/ghci/CmLink.lhs index 311af33..4bd231e 100644 --- a/ghc/compiler/ghci/CmLink.lhs +++ b/ghc/compiler/ghci/CmLink.lhs @@ -15,7 +15,7 @@ import CmStaticInfo ( PCI ) import CmFind ( Path, PkgName ) import Module ( Module ) import Outputable ( SDoc ) -import FiniteMap ( FiniteMap ) +import FiniteMap ( FiniteMap, emptyFM ) import RdrName ( RdrName ) import Addr ( Addr ) @@ -52,5 +52,6 @@ data Linkable | LP PkgName emptyPLS :: IO PLS -emptyPLS = return (error "emptyPLS:unimp") +emptyPLS = return (MkPLS { source_symtab = emptyFM, + object_symtab = emptyFM }) \end{code} diff --git a/ghc/compiler/ghci/CompManager.lhs b/ghc/compiler/ghci/CompManager.lhs index de988cc..02f33ca 100644 --- a/ghc/compiler/ghci/CompManager.lhs +++ b/ghc/compiler/ghci/CompManager.lhs @@ -13,12 +13,13 @@ where #include "HsVersions.h" import Outputable ( SDoc ) +import FiniteMap ( emptyFM ) import CmStaticInfo ( FLAGS, PCI, SI, mkSI ) -import CmFind ( Finder, ModName ) +import CmFind ( Finder, newFinder, ModName ) import CmSummarise ( ) -import CmCompile ( PCS, HST, HIT ) -import CmLink ( PLS, HValue, Linkable ) +import CmCompile ( PCS, emptyPCS, HST, HIT ) +import CmLink ( PLS, emptyPLS, HValue, Linkable ) @@ -26,7 +27,7 @@ cmInit :: FLAGS -> PCI -> IO CmState cmInit flags pkginfo - = return (error "cmInit:unimp") + = emptyCmState flags pkginfo cmLoadModule :: CmState -> ModName @@ -55,6 +56,17 @@ data PCMS UI -- the unlinked images MG -- the module graph +emptyPCMS :: PCMS +emptyPCMS = PCMS emptyHST emptyHIT emptyUI emptyMG + +emptyHIT :: HIT +emptyHIT = emptyFM + +emptyHST :: HST +emptyHST = emptyFM + + + -- Persistent state for the entire system data CmState = CmState PCMS -- CM's persistent state @@ -63,9 +75,24 @@ data CmState SI -- static info, never changes Finder -- the module finder +emptyCmState :: FLAGS -> PCI -> IO CmState +emptyCmState flags pci + = do let pcms = emptyPCMS + pcs <- emptyPCS + pls <- emptyPLS + let si = mkSI flags pci + finder <- newFinder pci + return (CmState pcms pcs pls si finder) + -- CM internal types type UI = [Linkable] -- the unlinked images (should be a set, really) +emptyUI :: UI +emptyUI = [] + + data MG = MG -- the module graph +emptyMG :: MG +emptyMG = MG diff --git a/ghc/compiler/main/Main.lhs b/ghc/compiler/main/Main.lhs index 78d1227..cf0ee0e 100644 --- a/ghc/compiler/main/Main.lhs +++ b/ghc/compiler/main/Main.lhs @@ -46,7 +46,10 @@ import BSD import IOExts ( unsafePerformIO ) import NativeInfo ( os, arch ) #endif +#ifdef GHCI import StgInterp ( runStgI ) +import CompManager +#endif \end{code} diff --git a/ghc/compiler/nativeGen/AsmRegAlloc.lhs b/ghc/compiler/nativeGen/AsmRegAlloc.lhs index 02c5649..6349b44 100644 --- a/ghc/compiler/nativeGen/AsmRegAlloc.lhs +++ b/ghc/compiler/nativeGen/AsmRegAlloc.lhs @@ -10,6 +10,7 @@ module AsmRegAlloc ( runRegAllocate ) where import MachCode ( InstrBlock ) import MachMisc ( Instr(..) ) +import PprMach ( pprInstr ) -- Just for debugging import MachRegs import RegAllocInfo @@ -65,7 +66,13 @@ runRegAllocate regs find_reserve_regs instrs --) where tryGeneral [] - = error "nativeGen: spilling failed. Workaround: compile with -fvia-C.\n" + = pprPanic "nativeGen: spilling failed. Workaround: compile with -fvia-C.\n" + ( (text "reserves = " <> ppr reserves) + $$ + (text "code = ") + $$ + (vcat (map pprInstr flatInstrs)) + ) tryGeneral (resv:resvs) = case generalAlloc resv of Just success -> success @@ -199,7 +206,16 @@ doGeneralAlloc doGeneralAlloc all_regs reserve_regs instrs -- succeeded without spilling - | prespill_ok = Just prespill_insns + | --trace (showSDoc ( + -- text "allocating with these regs" <+> ppr prespill_regs + -- $$ + -- text "giving code" + -- $$ + -- vcat (map pprInstr prespill_insns) + --)) + prespill_ok + = Just prespill_insns + -- failed, and no spill regs avail, so pointless to attempt spilling | null reserve_regs = Nothing -- success after spilling -- 1.7.10.4