Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
obsidiansystems
GHC
Commits
8d873902
Commit
8d873902
authored
Jul 14, 2000
by
simonpj
Browse files
[project @ 2000-07-14 08:14:53 by simonpj]
Remove dead code
parent
78d385b3
Changes
10
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/absCSyn/Costs.lhs
View file @
8d873902
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: Costs.lhs,v 1.2
4
2000/07/
06
14
:
08:
3
1 simon
mar
Exp $
% $Id: Costs.lhs,v 1.2
5
2000/07/14
08:1
5:28
simon
pj
Exp $
%
% Only needed in a GranSim setup -- HWL
% ---------------------------------------------------------------------------
...
...
@@ -315,10 +315,6 @@ exprMacroCosts side macro mode_list =
stmtMacroCosts :: CStmtMacro -> [CAddrMode] -> CostRes
stmtMacroCosts macro modes =
let
arg_costs = foldl (+) nullCosts
[addrModeCosts mode Rhs | mode <- modes]
in
case macro of
ARGS_CHK_LOAD_NODE -> Cost (2, 1, 0, 0, 0) {- StgMacros.lh -}
-- p=probability of PAP (instead of AP): + p*(3,1,0,0,0)
...
...
ghc/compiler/absCSyn/PprAbsC.lhs
View file @
8d873902
...
...
@@ -812,14 +812,6 @@ pprCCall call@(CCall op_str is_asm may_gc cconv) args results vol_regs
(local_arg_decls, pp_non_void_args)
= unzip [ ppr_casm_arg a i | (a,i) <- non_void_args `zip` [1..] ]
ccall_arg_tys = map (text.showPrimRep.getAmodeRep) non_void_args
ccall_res_ty =
case non_void_results of
[] -> ptext SLIT("void")
[amode] -> text (showPrimRep (getAmodeRep amode))
_ -> panic "pprCCall: ccall_res_ty"
(declare_local_vars, local_vars, assign_results)
= ppr_casm_results non_void_results
...
...
ghc/compiler/codeGen/CgCase.lhs
View file @
8d873902
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgCase.lhs,v 1.4
3
2000/07/1
1 16:03:37
simon
mar
Exp $
% $Id: CgCase.lhs,v 1.4
4
2000/07/1
4 08:14:53
simon
pj
Exp $
%
%********************************************************
%* *
...
...
@@ -899,8 +899,6 @@ mkReturnVector :: Unique
mkReturnVector uniq tagged_alt_absCs deflt_absC srt liveness ret_conv
= getSRTLabel `thenFC` \srt_label ->
let
srt_info = (srt_label, srt)
(return_vec_amode, vtbl_body) = case ret_conv of {
-- might be a polymorphic case...
...
...
ghc/compiler/codeGen/CgClosure.lhs
View file @
8d873902
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgClosure.lhs,v 1.4
0
2000/07/
06
14
:
08:
3
1 simon
mar
Exp $
% $Id: CgClosure.lhs,v 1.4
1
2000/07/14
08:1
4:53
simon
pj
Exp $
%
\section[CgClosure]{Code generation for closures}
...
...
@@ -158,9 +158,6 @@ cgStdRhsClosure binder cc binder_info fvs args body lf_info payload
-- RETURN
returnFC (binder, heapIdInfo binder heap_offset lf_info)
where
is_std_thunk = isStandardFormThunk lf_info
\end{code}
Here's the general case.
...
...
@@ -311,7 +308,7 @@ closureCodeBody binder_info closure_info cc all_args body
-- Arg mapping for standard (slow) entry point; all args on stack,
-- with tagging.
(sp_all_args, arg_offsets,
arg_tags
)
(sp_all_args, arg_offsets,
_
)
= mkTaggedVirtStkOffsets vSp idPrimRep all_args
-- Arg mapping for the fast entry point; as many args as poss in
...
...
ghc/compiler/codeGen/CgCon.lhs
View file @
8d873902
...
...
@@ -91,7 +91,6 @@ cgTopRhsCon id con args
-- RETURN
returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
where
con_tycon = dataConTyCon con
lf_info = mkConLFInfo con
closure_label = mkClosureLabel name
name = idName id
...
...
@@ -173,8 +172,6 @@ buildDynCon binder cc con [arg_amode]
in_range_int_lit (CLit (MachInt val)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
in_range_int_lit other_amode = False
tycon = dataConTyCon con
\end{code}
Now the general case.
...
...
@@ -364,8 +361,6 @@ cgReturnDataCon con amodes
build_it_then (mkStaticAlgReturnCode con)
where
con_name = dataConName con
move_to_reg :: CAddrMode -> MagicId -> AbstractC
move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
...
...
ghc/compiler/codeGen/CgConTbls.lhs
View file @
8d873902
...
...
@@ -124,7 +124,6 @@ genConInfo comp_info tycon data_con
profCtrC SLIT("TICK_ENT_CON") [CReg node] `thenC`
body_code))
entry_addr = CLbl entry_label CodePtrRep
con_descr = occNameUserString (getOccName data_con)
-- Don't need any dynamic closure code for zero-arity constructors
...
...
@@ -135,10 +134,6 @@ genConInfo comp_info tycon data_con
static_code = CClosureInfoAndCode static_ci body Nothing con_descr
cost_centre = mkCCostCentreStack dontCareCCS -- not worried about static data costs
zero_size arg_ty = getPrimRepSize (typePrimRep arg_ty) == 0
zero_arity_con = isNullaryDataCon data_con
-- We used to check that all the arg-sizes were zero, but we don't
-- really have any constructors with only zero-size args, and it's
...
...
ghc/compiler/codeGen/CgHeapery.lhs
View file @
8d873902
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgHeapery.lhs,v 1.2
1
2000/07/1
1 16:03:37
simon
mar
Exp $
% $Id: CgHeapery.lhs,v 1.2
2
2000/07/1
4 08:14:53
simon
pj
Exp $
%
\section[CgHeapery]{Heap management functions}
...
...
@@ -397,7 +397,6 @@ fetchAndReschedule regs node_reqd =
then fetch_code `thenC` reschedule_code
else absC AbsCNop
where
all_regs = if node_reqd then node:regs else regs
liveness_mask = mkRegLiveness regs
reschedule_code = absC (CMacroStmt GRAN_RESCHEDULE [
mkIntCLit (IBOX(word2Int# liveness_mask)),
...
...
@@ -431,7 +430,6 @@ yield regs node_reqd =
then yield_code
else absC AbsCNop
where
-- all_regs = if node_reqd then node:regs else regs
liveness_mask = mkRegLiveness regs
yield_code =
absC (CMacroStmt GRAN_YIELD
...
...
ghc/compiler/codeGen/CgTailCall.lhs
View file @
8d873902
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgTailCall.lhs,v 1.2
5
2000/07/1
1 16:03:37
simon
mar
Exp $
% $Id: CgTailCall.lhs,v 1.2
6
2000/07/1
4 08:14:53
simon
pj
Exp $
%
%********************************************************
%* *
...
...
@@ -403,8 +403,6 @@ doTailCall arg_amodes arg_regs finish_code arity pending_assts
= getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
let
no_of_args = length arg_amodes
(reg_arg_amodes, stk_arg_amodes) = splitAt (length arg_regs) arg_amodes
-- We get some stk_arg_amodes if (a) no regs, or
-- (b) args beyond arity
...
...
@@ -428,7 +426,6 @@ doTailCall arg_amodes arg_regs finish_code arity pending_assts
splitAt arity stk_arg_amodes
-- eager blackholing, at the end of the basic block.
node_save = CTemp (mkPseudoUnique1 2) DataPtrRep
(r1_tmp_asst, bh_asst)
= case sequel of
#if 0
...
...
@@ -441,6 +438,8 @@ doTailCall arg_amodes arg_regs finish_code arity pending_assts
CAssign (CVal (CIndex node_save (mkIntCLit 0) PtrRep)
PtrRep)
(CLbl mkBlackHoleInfoTableLabel DataPtrRep))
where
node_save = CTemp (mkPseudoUnique1 2) DataPtrRep
#endif
_ -> (AbsCNop, AbsCNop)
in
...
...
ghc/compiler/codeGen/ClosureInfo.lhs
View file @
8d873902
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: ClosureInfo.lhs,v 1.4
2
2000/0
5/25 12:41:15
simonpj Exp $
% $Id: ClosureInfo.lhs,v 1.4
3
2000/0
7/14 08:14:53
simonpj Exp $
%
\section[ClosureInfo]{Data structures which describe closures}
...
...
@@ -421,8 +421,6 @@ layOutStaticClosure name kind_fn things lf_info
closure_type = getClosureType is_static tot_wds ptr_wds lf_info
is_static = True
bot = panic "layoutStaticClosure"
layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> ClosureInfo
layOutStaticNoFVClosure name lf_info
= MkClosureInfo name lf_info (GenericRep is_static 0 0 (getClosureType is_static 0 0 lf_info))
...
...
@@ -973,8 +971,6 @@ mkConEntryPtr :: DataCon -> SMRep -> CLabel
mkConEntryPtr con rep
| isStaticRep rep = mkStaticConEntryLabel (dataConName con)
| otherwise = mkConEntryLabel (dataConName con)
where
name = dataConName con
closureLabelFromCI (MkClosureInfo id _ other_rep) = mkClosureLabel id
...
...
ghc/compiler/coreSyn/CoreUnfold.lhs
View file @
8d873902
...
...
@@ -236,7 +236,6 @@ sizeExpr (I# bOMB_OUT_SIZE) top_args expr
= alts_size (foldr addSize sizeOne alt_sizes) -- The 1 is for the scrutinee
(foldr1 maxSize alt_sizes)
where
v_in_args = v `elem` top_args
alt_sizes = map size_up_alt alts
alts_size (SizeIs tot tot_disc tot_scrut) -- Size of all alternatives
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment