%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: Costs.lhs,v 1.24 2000/07/06 14:08:31 simonmar Exp $
+% $Id: Costs.lhs,v 1.25 2000/07/14 08:15:28 simonpj Exp $
%
% Only needed in a GranSim setup -- HWL
% ---------------------------------------------------------------------------
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)
(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
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgCase.lhs,v 1.43 2000/07/11 16:03:37 simonmar Exp $
+% $Id: CgCase.lhs,v 1.44 2000/07/14 08:14:53 simonpj Exp $
%
%********************************************************
%* *
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...
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgClosure.lhs,v 1.40 2000/07/06 14:08:31 simonmar Exp $
+% $Id: CgClosure.lhs,v 1.41 2000/07/14 08:14:53 simonpj Exp $
%
\section[CgClosure]{Code generation for closures}
-- RETURN
returnFC (binder, heapIdInfo binder heap_offset lf_info)
-
- where
- is_std_thunk = isStandardFormThunk lf_info
\end{code}
Here's the general case.
-- 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
-- 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
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.
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
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
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
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgHeapery.lhs,v 1.21 2000/07/11 16:03:37 simonmar Exp $
+% $Id: CgHeapery.lhs,v 1.22 2000/07/14 08:14:53 simonpj Exp $
%
\section[CgHeapery]{Heap management functions}
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)),
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
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgTailCall.lhs,v 1.25 2000/07/11 16:03:37 simonmar Exp $
+% $Id: CgTailCall.lhs,v 1.26 2000/07/14 08:14:53 simonpj Exp $
%
%********************************************************
%* *
= 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
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
CAssign (CVal (CIndex node_save (mkIntCLit 0) PtrRep)
PtrRep)
(CLbl mkBlackHoleInfoTableLabel DataPtrRep))
+ where
+ node_save = CTemp (mkPseudoUnique1 2) DataPtrRep
#endif
_ -> (AbsCNop, AbsCNop)
in
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: ClosureInfo.lhs,v 1.42 2000/05/25 12:41:15 simonpj Exp $
+% $Id: ClosureInfo.lhs,v 1.43 2000/07/14 08:14:53 simonpj Exp $
%
\section[ClosureInfo]{Data structures which describe closures}
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))
mkConEntryPtr con rep
| isStaticRep rep = mkStaticConEntryLabel (dataConName con)
| otherwise = mkConEntryLabel (dataConName con)
- where
- name = dataConName con
closureLabelFromCI (MkClosureInfo id _ other_rep) = mkClosureLabel id
= 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
projects / ghc-hetmet.git / commitdiff