diff options
Diffstat (limited to 'compiler/codeGen/StgCmm.hs')
| -rw-r--r-- | compiler/codeGen/StgCmm.hs | 52 |
1 files changed, 21 insertions, 31 deletions
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index 28ca97d9a2..aac556d43f 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -226,41 +226,31 @@ cgDataCon data_con nonptr_wds = tot_wds - ptr_wds - sta_info_tbl = mkDataConInfoTable dflags data_con True ptr_wds nonptr_wds - dyn_info_tbl = mkDataConInfoTable dflags data_con False ptr_wds nonptr_wds - - emit_info info_tbl ticky_code - = emitClosureAndInfoTable info_tbl NativeDirectCall [] - $ mk_code ticky_code - - mk_code ticky_code - = -- NB: the closure pointer is assumed *untagged* on - -- entry to a constructor. If the pointer is tagged, - -- then we should not be entering it. This assumption - -- is used in ldvEnter and when tagging the pointer to - -- return it. - -- NB 2: We don't set CC when entering data (WDP 94/06) - do { _ <- ticky_code - ; ldvEnter (CmmReg nodeReg) - ; tickyReturnOldCon (length arg_reps) - ; void $ emitReturn [cmmOffsetB dflags (CmmReg nodeReg) (tagForCon dflags data_con)] - } - -- The case continuation code expects a tagged pointer + dyn_info_tbl = + mkDataConInfoTable dflags data_con False ptr_wds nonptr_wds -- We're generating info tables, so we don't know and care about -- what the actual arguments are. Using () here as the place holder. arg_reps :: [NonVoid PrimRep] - arg_reps = [NonVoid (typePrimRep rep_ty) | ty <- dataConRepArgTys data_con - , rep_ty <- repTypeArgs ty - , not (isVoidTy rep_ty)] - - -- Dynamic closure code for non-nullary constructors only - ; when (not (isNullaryRepDataCon data_con)) - (emit_info dyn_info_tbl tickyEnterDynCon) - - -- Dynamic-Closure first, to reduce forward references - ; emit_info sta_info_tbl tickyEnterStaticCon } - + arg_reps = [ NonVoid (typePrimRep rep_ty) + | ty <- dataConRepArgTys data_con + , rep_ty <- repTypeArgs ty + , not (isVoidTy rep_ty)] + + ; emitClosureAndInfoTable dyn_info_tbl NativeDirectCall [] $ + -- NB: the closure pointer is assumed *untagged* on + -- entry to a constructor. If the pointer is tagged, + -- then we should not be entering it. This assumption + -- is used in ldvEnter and when tagging the pointer to + -- return it. + -- NB 2: We don't set CC when entering data (WDP 94/06) + do { tickyEnterDynCon + ; ldvEnter (CmmReg nodeReg) + ; tickyReturnOldCon (length arg_reps) + ; void $ emitReturn [cmmOffsetB dflags (CmmReg nodeReg) (tagForCon dflags data_con)] + } + -- The case continuation code expects a tagged pointer + } --------------------------------------------------------------- -- Stuff to support splitting |