[project @ 2005-01-16 05:31:39 by wolfgang]

[ghc-hetmet.git] / ghc / compiler / cmm / CmmParse.y

diff --git a/ghc/compiler/cmm/CmmParse.y b/ghc/compiler/cmm/CmmParse.y
index e409f25..4b25d45 100644 (file)
--- a/ghc/compiler/cmm/CmmParse.y
+++ b/ghc/compiler/cmm/CmmParse.y
@@ -25,11 +25,11 @@ import CostCentre   ( dontCareCCS )
 
 import Cmm
 import PprCmm
-import CmmUtils                ( mkIntCLit, mkLblExpr )
+import CmmUtils                ( mkIntCLit )
 import CmmLex
 import CLabel
 import MachOp
-import SMRep           ( tablesNextToCode, fixedHdrSize, CgRep(..) )
+import SMRep           ( fixedHdrSize, CgRep(..) )
 import Lexer
 
 import ForeignCall     ( CCallConv(..) )
@@ -229,9 +229,9 @@ info        :: { ExtFCode (CLabel, [CmmLit],[CmmLit]) }
        | 'INFO_TABLE_RET' '(' NAME ',' INT ',' INT ',' INT maybe_vec ')'
                { retInfo $3 $5 $7 $9 $10 }
 
-maybe_vec :: { [CLabel] }
+maybe_vec :: { [CmmLit] }
        : {- empty -}                   { [] }
-       | ',' NAME maybe_vec            { mkRtsCodeLabelFS $2 : $3 }
+       | ',' NAME maybe_vec            { CmmLabel (mkRtsCodeLabelFS $2) : $3 }
 
 body   :: { ExtCode }
        : {- empty -}                   { return () }
@@ -464,7 +464,7 @@ exprMacros = listToUFM [
   ( FSLIT("INFO_TYPE"),    \ [x] -> infoTableClosureType x ),
   ( FSLIT("INFO_PTRS"),    \ [x] -> infoTablePtrs x ),
   ( FSLIT("INFO_NPTRS"),   \ [x] -> infoTableNonPtrs x ),
-  ( FSLIT("RET_VEC"),      \ [info, conZ] -> CmmLoad (vectorSlot info conZ) wordRep )
+  ( FSLIT("RET_VEC"),      \ [info, conZ] -> retVec info conZ )
   ]
 
 -- we understand a subset of C-- primitives:
@@ -677,9 +677,10 @@ forkLabelledCodeEC ec = do
 
 retInfo name size live_bits cl_type vector = do
   let liveness = smallLiveness (fromIntegral size) (fromIntegral live_bits)
-      (info1,info2) = mkRetInfoTable liveness NoC_SRT 
+      info_lbl = mkRtsRetInfoLabelFS name
+      (info1,info2) = mkRetInfoTable info_lbl liveness NoC_SRT 
                                (fromIntegral cl_type) vector
-  return (mkRtsRetInfoLabelFS name, info1, info2)
+  return (info_lbl, info1, info2)
 
 stdInfo name ptrs nptrs srt_bitmap cl_type desc_str ty_str =
   basicInfo name (packHalfWordsCLit ptrs nptrs) 
@@ -854,7 +855,9 @@ doSwitch mb_range scrut arms deflt
 initEnv :: Env
 initEnv = listToUFM [
   ( FSLIT("SIZEOF_StgHeader"), 
-       CmmLit (CmmInt (fromIntegral (fixedHdrSize * wORD_SIZE)) wordRep) )
+       CmmLit (CmmInt (fromIntegral (fixedHdrSize * wORD_SIZE)) wordRep) ),
+  ( FSLIT("SIZEOF_StgInfoTable"),
+        CmmLit (CmmInt (fromIntegral stdInfoTableSizeB) wordRep) )
   ]
 
 parseCmmFile :: DynFlags -> FilePath -> IO (Maybe Cmm)
@@ -869,7 +872,7 @@ parseCmmFile dflags filename = do
   case unP cmmParse init_state of
     PFailed span err -> do printError span err; return Nothing
     POk _ code -> do
-       cmm <- initC no_module (getCmm (unEC code initEnv [] >> return ()))
+       cmm <- initC dflags no_module (getCmm (unEC code initEnv [] >> return ()))
        dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms [cmm])
        return (Just cmm)
   where