Commit 6458c2c5 authored by simonmar's avatar simonmar

[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.
parent 1b984186
......@@ -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 () }
......
......@@ -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
......
......@@ -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
......
%
% (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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment