[project @ 2004-09-10 14:53:44 by simonmar]

Fix problem that shows up when building stage2 on Windows: slots of a
vector table that can never happen are normally filled with the
RtsShouldNeverHappen label, which currently prints as "0".  On systems
with leading underscores on labels, such as Windows, this turns into
"_0" which is reported as an undefined symbol.

Having a label print as "0" is a real hack, so the solution is to do
it properly.  This commit does just that.

diff --git a/ghc/compiler/cmm/CmmParse.y b/ghc/compiler/cmm/CmmParse.y
index e409f25..55ee5c2 100644 (file)
--- a/ghc/compiler/cmm/CmmParse.y
+++ b/ghc/compiler/cmm/CmmParse.y
@@ -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 () }

diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
index 3cd67e4..6b3b36a 100644 (file)
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ b/ghc/compiler/codeGen/CgCon.lhs
@@ -296,7 +296,7 @@ cgReturnDataCon con amodes
              ->    -- Ho! We know the constructor so we can
                    -- go straight to the right alternative
                 case assocMaybe alts (dataConTagZ con) of {
-                   Just join_lbl -> build_it_then (jump_to join_lbl) ;
+                   Just join_lbl -> build_it_then (jump_to join_lbl);
                    Nothing
                        -- Special case!  We're returning a constructor to the default case
                        -- of an enclosing case.  For example:
@@ -317,7 +317,7 @@ cgReturnDataCon con amodes
               | otherwise -> build_it_then (emitKnownConReturnCode con)
        }
   where
-    jump_to lbl = stmtC (CmmJump (CmmLit (CmmLabel lbl)) [])
+    jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
     build_it_then return_code
       = do {   -- BUILD THE OBJECT IN THE HEAP
                -- The first "con" says that the name bound to this

diff --git a/ghc/compiler/codeGen/CgInfoTbls.hs b/ghc/compiler/codeGen/CgInfoTbls.hs
index 488c513..5cda823 100644 (file)
--- a/ghc/compiler/codeGen/CgInfoTbls.hs
+++ b/ghc/compiler/codeGen/CgInfoTbls.hs
@@ -212,7 +212,7 @@ emitReturnTarget
    :: Name
    -> CgStmts                  -- The direct-return code (if any)
                                --      (empty for vectored returns)
-   -> [CLabel]                 -- Vector of return points 
+   -> [CmmLit]                 -- Vector of return points 
                                --      (empty for non-vectored returns)
    -> SRT
    -> FCode CLabel
@@ -244,7 +244,7 @@ mkRetInfoTable
   :: Liveness          -- liveness
   -> C_SRT             -- SRT Info
   -> Int               -- type (eg. rET_SMALL)
-  -> [CLabel]          -- vector
+  -> [CmmLit]          -- vector
   -> ([CmmLit],[CmmLit])
 mkRetInfoTable liveness srt_info cl_type vector
   =  (std_info, extra_bits)
@@ -261,7 +261,7 @@ mkRetInfoTable liveness srt_info cl_type vector
  
        liveness_lit = mkLivenessCLit liveness
        std_info = mkStdInfoTable zeroCLit zeroCLit cl_type srt_len liveness_lit
-        extra_bits = srt_slot ++ map CmmLabel vector
+        extra_bits = srt_slot ++ vector
 
 
 emitDirectReturnTarget
@@ -302,24 +302,24 @@ emitAlgReturnTarget name branches mb_deflt srt ret_conv
     uniq = getUnique name 
     tag_expr = getConstrTag (CmmReg nodeReg)
 
-    emit_alt :: (Int, CgStmts) -> FCode (Int, CLabel)
+    emit_alt :: (Int, CgStmts) -> FCode (Int, CmmLit)
        -- Emit the code for the alternative as a top-level
        -- code block returning a label for it
     emit_alt (tag, stmts) = do  { let lbl = mkAltLabel uniq tag
                                 ; blks <- cgStmtsToBlocks stmts
                                 ; emitProc [] lbl [] blks
-                                ; return (tag, lbl) }
+                                ; return (tag, CmmLabel lbl) }
 
     emit_deflt (Just stmts) = do { let lbl = mkDefaultLabel uniq
                                 ; blks <- cgStmtsToBlocks stmts
                                 ; emitProc [] lbl [] blks
-                                ; return lbl }
-    emit_deflt Nothing = return mkErrorStdEntryLabel
+                                ; return (CmmLabel lbl) }
+    emit_deflt Nothing = return (mkIntCLit 0)
                -- Nothing case: the simplifier might have eliminated a case
                --               so we may have e.g. case xs of 
                --                                       [] -> e
                -- In that situation the default should never be taken, 
-               -- so we just use mkErrorStdEntryLabel
+               -- so we just use a NULL pointer
 
 --------------------------------
 emitDirectReturnInstr :: Code

diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs
index 003be97..f6b2096 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.40 2004/08/13 13:06:03 simonmar Exp $
+% $Id: CgMonad.lhs,v 1.41 2004/09/10 14:53:47 simonmar Exp $
 %
 \section[CgMonad]{The code generation monad}
 
@@ -169,8 +169,8 @@ data Sequel
 
 type SemiTaggingStuff
   = Maybe                      -- Maybe[1] we don't have any semi-tagging stuff...
-     ([(ConTagZ, CLabel)],     -- Alternatives
-      CLabel)                  -- Default (will be a can't happen RTS label if can't happen)
+     ([(ConTagZ, CmmLit)],     -- Alternatives
+      CmmLit)                  -- Default (will be a can't happen RTS label if can't happen)
 
 type ConTagZ = Int     -- A *zero-indexed* contructor tag