[project @ 1999-07-27 12:07:36 by sof]

[ghc-hetmet.git] / ghc / compiler / codeGen / CgMonad.lhs

diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs
index a9b6e41..d649bc2 100644 (file)
--- a/ghc/compiler/codeGen/CgMonad.lhs
+++ b/ghc/compiler/codeGen/CgMonad.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgMonad.lhs,v 1.17 1999/01/06 11:35:27 simonm Exp $
+% $Id: CgMonad.lhs,v 1.22 1999/06/09 14:28:38 simonmar Exp $
 %
 \section[CgMonad]{The code generation monad}
 
@@ -20,14 +20,12 @@ module CgMonad (
        forkEvalHelp, forkAbsC,
        SemiTaggingStuff,
 
-       addBindC, addBindsC, modifyBindC, lookupBindC,
-
        EndOfBlockInfo(..),
        setEndOfBlockInfo, getEndOfBlockInfo,
 
        setSRTLabel, getSRTLabel,
 
-       StackUsage, HeapUsage,
+       StackUsage, Slot(..), HeapUsage,
 
        profCtrC,
 
@@ -43,14 +41,14 @@ module CgMonad (
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} CgBindery ( CgIdInfo(..), CgBindings, maybeStkLoc, nukeVolatileBinds )
+import {-# SOURCE #-} CgBindery ( CgIdInfo, CgBindings, nukeVolatileBinds )
 import {-# SOURCE #-} CgUsages  ( getSpRelOffset )
 
 import AbsCSyn
 import AbsCUtils       ( mkAbsCStmts )
 import CmdLineOpts     ( opt_SccProfilingOn, opt_DoTickyProfiling )
-import CLabel           ( CLabel, mkUpdEntryLabel )
-import OccName         ( Module )
+import CLabel           ( CLabel, mkUpdInfoLabel )
+import Module          ( Module )
 import DataCon         ( ConTag )
 import Id              ( Id )
 import VarEnv
@@ -163,22 +161,36 @@ type JoinDetails
 -- that Sp is pointing to the top word of the return address.  This
 -- seems unclean but there you go.
 
+-- sequelToAmode returns an amode which refers to an info table.  The info
+-- table will always be of the RET(_VEC)?_(BIG|SMALL) kind.  We're careful
+-- not to handle real code pointers, just in case we're compiling for 
+-- an unregisterised/untailcallish architecture, where info pointers and
+-- code pointers aren't the same.
+
 sequelToAmode :: Sequel -> FCode CAddrMode
 
 sequelToAmode (OnStack virt_sp_offset)
   = getSpRelOffset virt_sp_offset `thenFC` \ sp_rel ->
     returnFC (CVal sp_rel RetRep)
 
-sequelToAmode UpdateCode = returnFC (CLbl mkUpdEntryLabel CodePtrRep)
+sequelToAmode UpdateCode = returnFC (CLbl mkUpdInfoLabel RetRep)
 sequelToAmode (CaseAlts amode _) = returnFC amode
 sequelToAmode (SeqFrame _ _) = panic "sequelToAmode: SeqFrame"
 
 type CgStksAndHeapUsage                -- stacks and heap usage information
   = (StackUsage, HeapUsage)
 
+data Slot = Free | NonPointer 
+  deriving
+#ifdef DEBUG
+       (Eq,Show)
+#else
+       Eq
+#endif
+
 type StackUsage =
        (Int,              -- virtSp: Virtual offset of topmost allocated slot
-        [Int],            -- free:   List of free slots, in increasing order
+        [(Int,Slot)],     -- free:   List of free slots, in increasing order
         Int,              -- realSp: Virtual offset of real stack pointer
         Int)              -- hwSp:   Highest value ever taken by virtSp
 
@@ -197,9 +209,7 @@ Initialisation.
 initialStateC = MkCgState AbsCNop emptyVarEnv initUsage
 
 initUsage :: CgStksAndHeapUsage
-initUsage  = ((0,[],0,0), (initVirtHp, initRealHp))
-initVirtHp = panic "Uninitialised virtual Hp"
-initRealHp = panic "Uninitialised real Hp"
+initUsage  = ((0,[],0,0), (0,0))
 \end{code}
 
 "envInitForAlternatives" initialises the environment for a case alternative,
@@ -456,8 +466,7 @@ forkEvalHelp body_eob_info env_code body_code
 
     state_for_body = MkCgState AbsCNop
                             (nukeVolatileBinds binds)
-                            ((v,f,v,v),
-                             (initVirtHp, initRealHp))
+                            ((v,f,v,v), (0,0))
 
 
 stateIncUsageEval :: CgState -> CgState -> CgState
@@ -559,56 +568,3 @@ setSRTLabel :: CLabel -> Code -> Code
 setSRTLabel srt code (MkCgInfoDown c_info statics _ eob_info) state
   = code (MkCgInfoDown c_info statics srt eob_info) state
 \end{code}
-
-%************************************************************************
-%*                                                                     *
-\subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
-%*                                                                     *
-%************************************************************************
-
-There are three basic routines, for adding (@addBindC@), modifying
-(@modifyBindC@) and looking up (@lookupBindC@) bindings.
-
-A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
-The name should not already be bound. (nice ASSERT, eh?)
-
-\begin{code}
-addBindC :: Id -> CgIdInfo -> Code
-addBindC name stuff_to_bind info_down (MkCgState absC binds usage)
-  = MkCgState absC (extendVarEnv binds name stuff_to_bind) usage
-
-addBindsC :: [(Id, CgIdInfo)] -> Code
-addBindsC new_bindings info_down (MkCgState absC binds usage)
-  = MkCgState absC new_binds usage
-  where
-    new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
-                     binds
-                     new_bindings
-
-modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
-modifyBindC name mangle_fn info_down (MkCgState absC binds usage)
-  = MkCgState absC (modifyVarEnv mangle_fn binds name) usage
-
-lookupBindC :: Id -> FCode CgIdInfo
-lookupBindC name info_down@(MkCgInfoDown _ static_binds srt _)
-                state@(MkCgState absC local_binds usage)
-  = (val, state)
-  where
-    val = case (lookupVarEnv local_binds name) of
-           Nothing     -> try_static
-           Just this   -> this
-
-    try_static = 
-      case (lookupVarEnv static_binds name) of
-       Just this -> this
-       Nothing
-         -> pprPanic "lookupBindC:no info!\n"
-            (vcat [
-               hsep [ptext SLIT("for:"), ppr name],
-               ptext SLIT("(probably: data dependencies broken by an optimisation pass)"),
-               ptext SLIT("static binds for:"),
-               vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv static_binds ],
-               ptext SLIT("local binds for:"),
-               vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv local_binds ]
-             ])
-\end{code}