diff options
Diffstat (limited to 'includes/mkDerivedConstants.c')
| -rw-r--r-- | includes/mkDerivedConstants.c | 392 |
1 files changed, 215 insertions, 177 deletions
diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c index 62c5ae8f1f..199e2edeb6 100644 --- a/includes/mkDerivedConstants.c +++ b/includes/mkDerivedConstants.c @@ -79,10 +79,18 @@ enum Mode { Gen_Haskell_Type, Gen_Haskell_Value, Gen_Haskell_Wrappers, Gen_Haske and the names of the CmmTypes in the compiler b32 :: CmmType */ -#define field_type_(str, s_type, field) \ +#define field_type_(want_haskell, str, s_type, field) \ switch (mode) { \ case Gen_Haskell_Type: \ + if (want_haskell) { \ + printf(" , pc_REP_" str " :: Int\n"); \ + break; \ + } \ case Gen_Haskell_Value: \ + if (want_haskell) { \ + printf(" , pc_REP_" str " = %" PRIdPTR "\n", (intptr_t)(FIELD_SIZE(s_type, field))); \ + break; \ + } \ case Gen_Haskell_Wrappers: \ case Gen_Haskell_Exports: \ break; \ @@ -104,8 +112,8 @@ enum Mode { Gen_Haskell_Type, Gen_Haskell_Value, Gen_Haskell_Wrappers, Gen_Haske break; \ } -#define field_type(s_type, field) \ - field_type_(str(s_type,field),s_type,field); +#define field_type(want_haskell, s_type, field) \ + field_type_(want_haskell,str(s_type,field),s_type,field); #define field_offset_(str, s_type, field) \ def_offset(str, OFFSET(s_type,field)); @@ -127,14 +135,20 @@ enum Mode { Gen_Haskell_Type, Gen_Haskell_Value, Gen_Haskell_Wrappers, Gen_Haske } /* Outputs the byte offset and MachRep for a field */ -#define struct_field(s_type, field) \ - field_offset(s_type, field); \ - field_type(s_type, field); \ +#define struct_field_helper(want_haskell, s_type, field) \ + field_offset(s_type, field); \ + field_type(want_haskell, s_type, field); \ struct_field_macro(str(s_type,field)) +#define struct_field(s_type, field) \ + struct_field_helper(0, s_type, field) + +#define struct_field_h(s_type, field) \ + struct_field_helper(1, s_type, field) + #define struct_field_(str, s_type, field) \ field_offset_(str, s_type, field); \ - field_type_(str, s_type, field); \ + field_type_(0,str, s_type, field); \ struct_field_macro(str) #define def_size(str, size) \ @@ -222,7 +236,7 @@ enum Mode { Gen_Haskell_Type, Gen_Haskell_Value, Gen_Haskell_Wrappers, Gen_Haske /* Byte offset and MachRep for a closure field, minus the header */ #define closure_field_(str, s_type, field) \ closure_field_offset_(str,s_type,field) \ - field_type_(str, s_type, field); \ + field_type_(0, str, s_type, field); \ closure_field_macro(str) #define closure_field(s_type, field) \ @@ -270,9 +284,9 @@ enum Mode { Gen_Haskell_Type, Gen_Haskell_Value, Gen_Haskell_Wrappers, Gen_Haske break; \ } -#define tso_field(s_type, field) \ - field_type(s_type, field); \ - tso_field_offset(s_type,field); \ +#define tso_field(s_type, field) \ + field_type(0, s_type, field); \ + tso_field_offset(s_type,field); \ tso_field_macro(str(s_type,field)) #define opt_struct_size(s_type, option) \ @@ -422,7 +436,9 @@ main(int argc, char *argv[]) // Size of a storage manager block (in bytes). constantIntC("BLOCK_SIZE", "bLOCK_SIZE", BLOCK_SIZE); - constantIntC("MBLOCK_SIZE", "mBLOCK_SIZE", MBLOCK_SIZE); + if (mode == Gen_Header) { + constantIntC("MBLOCK_SIZE", "mBLOCK_SIZE", MBLOCK_SIZE); + } // blocks that fit in an MBlock, leaving space for the block descriptors constantIntC("BLOCKS_PER_MBLOCK", "bLOCKS_PER_MBLOCK", BLOCKS_PER_MBLOCK); // could be derived, but better to save doing the calculation twice @@ -453,217 +469,239 @@ main(int argc, char *argv[]) field_offset(StgRegTable, rCurrentTSO); field_offset(StgRegTable, rCurrentNursery); field_offset(StgRegTable, rHpAlloc); - struct_field(StgRegTable, rRet); - struct_field(StgRegTable, rNursery); + if (mode == Gen_Header) { + struct_field(StgRegTable, rRet); + struct_field(StgRegTable, rNursery); + } def_offset("stgEagerBlackholeInfo", FUN_OFFSET(stgEagerBlackholeInfo)); def_offset("stgGCEnter1", FUN_OFFSET(stgGCEnter1)); def_offset("stgGCFun", FUN_OFFSET(stgGCFun)); field_offset(Capability, r); - field_offset(Capability, lock); - struct_field(Capability, no); - struct_field(Capability, mut_lists); - struct_field(Capability, context_switch); - struct_field(Capability, interrupt); - struct_field(Capability, sparks); + if (mode == Gen_Header) { + field_offset(Capability, lock); + struct_field(Capability, no); + struct_field(Capability, mut_lists); + struct_field(Capability, context_switch); + struct_field(Capability, interrupt); + struct_field(Capability, sparks); + } struct_field(bdescr, start); struct_field(bdescr, free); struct_field(bdescr, blocks); - struct_field(bdescr, gen_no); - struct_field(bdescr, link); + if (mode == Gen_Header) { + struct_field(bdescr, gen_no); + struct_field(bdescr, link); - struct_size(generation); - struct_field(generation, n_new_large_words); + struct_size(generation); + struct_field(generation, n_new_large_words); + } struct_size(CostCentreStack); - struct_field(CostCentreStack, ccsID); - struct_field(CostCentreStack, mem_alloc); - struct_field(CostCentreStack, scc_count); - struct_field(CostCentreStack, prevStack); + if (mode == Gen_Header) { + struct_field(CostCentreStack, ccsID); + } + struct_field_h(CostCentreStack, mem_alloc); + struct_field_h(CostCentreStack, scc_count); + if (mode == Gen_Header) { + struct_field(CostCentreStack, prevStack); - struct_field(CostCentre, ccID); - struct_field(CostCentre, link); + struct_field(CostCentre, ccID); + struct_field(CostCentre, link); - struct_field(StgHeader, info); + struct_field(StgHeader, info); + } struct_field_("StgHeader_ccs", StgHeader, prof.ccs); struct_field_("StgHeader_ldvw", StgHeader, prof.hp.ldvw); struct_size(StgSMPThunkHeader); - closure_payload(StgClosure,payload); + if (mode == Gen_Header) { + closure_payload(StgClosure,payload); + } - struct_field(StgEntCounter, allocs); + struct_field_h(StgEntCounter, allocs); struct_field(StgEntCounter, registeredp); struct_field(StgEntCounter, link); struct_field(StgEntCounter, entry_count); closure_size(StgUpdateFrame); - closure_size(StgCatchFrame); - closure_size(StgStopFrame); + if (mode == Gen_Header) { + closure_size(StgCatchFrame); + closure_size(StgStopFrame); + } closure_size(StgMutArrPtrs); closure_field(StgMutArrPtrs, ptrs); closure_field(StgMutArrPtrs, size); closure_size(StgArrWords); - closure_field(StgArrWords, bytes); - closure_payload(StgArrWords, payload); - - closure_field(StgTSO, _link); - closure_field(StgTSO, global_link); - closure_field(StgTSO, what_next); - closure_field(StgTSO, why_blocked); - closure_field(StgTSO, block_info); - closure_field(StgTSO, blocked_exceptions); - closure_field(StgTSO, id); - closure_field(StgTSO, cap); - closure_field(StgTSO, saved_errno); - closure_field(StgTSO, trec); - closure_field(StgTSO, flags); - closure_field(StgTSO, dirty); - closure_field(StgTSO, bq); + if (mode == Gen_Header) { + closure_field(StgArrWords, bytes); + closure_payload(StgArrWords, payload); + + closure_field(StgTSO, _link); + closure_field(StgTSO, global_link); + closure_field(StgTSO, what_next); + closure_field(StgTSO, why_blocked); + closure_field(StgTSO, block_info); + closure_field(StgTSO, blocked_exceptions); + closure_field(StgTSO, id); + closure_field(StgTSO, cap); + closure_field(StgTSO, saved_errno); + closure_field(StgTSO, trec); + closure_field(StgTSO, flags); + closure_field(StgTSO, dirty); + closure_field(StgTSO, bq); + } closure_field_("StgTSO_cccs", StgTSO, prof.cccs); closure_field(StgTSO, stackobj); closure_field(StgStack, sp); closure_field_offset(StgStack, stack); + if (mode == Gen_Header) { closure_field(StgStack, stack_size); - closure_field(StgStack, dirty); + closure_field(StgStack, dirty); - struct_size(StgTSOProfInfo); + struct_size(StgTSOProfInfo); - opt_struct_size(StgTSOProfInfo,PROFILING); + opt_struct_size(StgTSOProfInfo,PROFILING); + } closure_field(StgUpdateFrame, updatee); - closure_field(StgCatchFrame, handler); - closure_field(StgCatchFrame, exceptions_blocked); - - closure_size(StgPAP); - closure_field(StgPAP, n_args); - closure_field_gcptr(StgPAP, fun); - closure_field(StgPAP, arity); - closure_payload(StgPAP, payload); - - thunk_size(StgAP); - closure_field(StgAP, n_args); - closure_field_gcptr(StgAP, fun); - closure_payload(StgAP, payload); - - thunk_size(StgAP_STACK); - closure_field(StgAP_STACK, size); - closure_field_gcptr(StgAP_STACK, fun); - closure_payload(StgAP_STACK, payload); - - thunk_size(StgSelector); - - closure_field_gcptr(StgInd, indirectee); - - closure_size(StgMutVar); - closure_field(StgMutVar, var); - - closure_size(StgAtomicallyFrame); - closure_field(StgAtomicallyFrame, code); - closure_field(StgAtomicallyFrame, next_invariant_to_check); - closure_field(StgAtomicallyFrame, result); - - closure_field(StgInvariantCheckQueue, invariant); - closure_field(StgInvariantCheckQueue, my_execution); - closure_field(StgInvariantCheckQueue, next_queue_entry); - - closure_field(StgAtomicInvariant, code); - - closure_field(StgTRecHeader, enclosing_trec); - - closure_size(StgCatchSTMFrame); - closure_field(StgCatchSTMFrame, handler); - closure_field(StgCatchSTMFrame, code); - - closure_size(StgCatchRetryFrame); - closure_field(StgCatchRetryFrame, running_alt_code); - closure_field(StgCatchRetryFrame, first_code); - closure_field(StgCatchRetryFrame, alt_code); - - closure_field(StgTVarWatchQueue, closure); - closure_field(StgTVarWatchQueue, next_queue_entry); - closure_field(StgTVarWatchQueue, prev_queue_entry); - - closure_field(StgTVar, current_value); - - closure_size(StgWeak); - closure_field(StgWeak,link); - closure_field(StgWeak,key); - closure_field(StgWeak,value); - closure_field(StgWeak,finalizer); - closure_field(StgWeak,cfinalizer); - - closure_size(StgDeadWeak); - closure_field(StgDeadWeak,link); - - closure_size(StgMVar); - closure_field(StgMVar,head); - closure_field(StgMVar,tail); - closure_field(StgMVar,value); - - closure_size(StgMVarTSOQueue); - closure_field(StgMVarTSOQueue, link); - closure_field(StgMVarTSOQueue, tso); - - closure_size(StgBCO); - closure_field(StgBCO, instrs); - closure_field(StgBCO, literals); - closure_field(StgBCO, ptrs); - closure_field(StgBCO, arity); - closure_field(StgBCO, size); - closure_payload(StgBCO, bitmap); - - closure_size(StgStableName); - closure_field(StgStableName,sn); - - closure_size(StgBlockingQueue); - closure_field(StgBlockingQueue, bh); - closure_field(StgBlockingQueue, owner); - closure_field(StgBlockingQueue, queue); - closure_field(StgBlockingQueue, link); - - closure_size(MessageBlackHole); - closure_field(MessageBlackHole, link); - closure_field(MessageBlackHole, tso); - closure_field(MessageBlackHole, bh); - - struct_field_("RtsFlags_ProfFlags_showCCSOnException", - RTS_FLAGS, ProfFlags.showCCSOnException); - struct_field_("RtsFlags_DebugFlags_apply", - RTS_FLAGS, DebugFlags.apply); - struct_field_("RtsFlags_DebugFlags_sanity", - RTS_FLAGS, DebugFlags.sanity); - struct_field_("RtsFlags_DebugFlags_weak", - RTS_FLAGS, DebugFlags.weak); - struct_field_("RtsFlags_GcFlags_initialStkSize", - RTS_FLAGS, GcFlags.initialStkSize); - struct_field_("RtsFlags_MiscFlags_tickInterval", - RTS_FLAGS, MiscFlags.tickInterval); - - struct_size(StgFunInfoExtraFwd); - struct_field(StgFunInfoExtraFwd, slow_apply); - struct_field(StgFunInfoExtraFwd, fun_type); - struct_field(StgFunInfoExtraFwd, arity); - struct_field_("StgFunInfoExtraFwd_bitmap", StgFunInfoExtraFwd, b.bitmap); + if (mode == Gen_Header) { + closure_field(StgCatchFrame, handler); + closure_field(StgCatchFrame, exceptions_blocked); + + closure_size(StgPAP); + closure_field(StgPAP, n_args); + closure_field_gcptr(StgPAP, fun); + closure_field(StgPAP, arity); + closure_payload(StgPAP, payload); + + thunk_size(StgAP); + closure_field(StgAP, n_args); + closure_field_gcptr(StgAP, fun); + closure_payload(StgAP, payload); + + thunk_size(StgAP_STACK); + closure_field(StgAP_STACK, size); + closure_field_gcptr(StgAP_STACK, fun); + closure_payload(StgAP_STACK, payload); + + thunk_size(StgSelector); + + closure_field_gcptr(StgInd, indirectee); + + closure_size(StgMutVar); + closure_field(StgMutVar, var); + + closure_size(StgAtomicallyFrame); + closure_field(StgAtomicallyFrame, code); + closure_field(StgAtomicallyFrame, next_invariant_to_check); + closure_field(StgAtomicallyFrame, result); + + closure_field(StgInvariantCheckQueue, invariant); + closure_field(StgInvariantCheckQueue, my_execution); + closure_field(StgInvariantCheckQueue, next_queue_entry); + + closure_field(StgAtomicInvariant, code); + + closure_field(StgTRecHeader, enclosing_trec); + + closure_size(StgCatchSTMFrame); + closure_field(StgCatchSTMFrame, handler); + closure_field(StgCatchSTMFrame, code); + + closure_size(StgCatchRetryFrame); + closure_field(StgCatchRetryFrame, running_alt_code); + closure_field(StgCatchRetryFrame, first_code); + closure_field(StgCatchRetryFrame, alt_code); + + closure_field(StgTVarWatchQueue, closure); + closure_field(StgTVarWatchQueue, next_queue_entry); + closure_field(StgTVarWatchQueue, prev_queue_entry); + + closure_field(StgTVar, current_value); + + closure_size(StgWeak); + closure_field(StgWeak,link); + closure_field(StgWeak,key); + closure_field(StgWeak,value); + closure_field(StgWeak,finalizer); + closure_field(StgWeak,cfinalizer); + + closure_size(StgDeadWeak); + closure_field(StgDeadWeak,link); + + closure_size(StgMVar); + closure_field(StgMVar,head); + closure_field(StgMVar,tail); + closure_field(StgMVar,value); + + closure_size(StgMVarTSOQueue); + closure_field(StgMVarTSOQueue, link); + closure_field(StgMVarTSOQueue, tso); + + closure_size(StgBCO); + closure_field(StgBCO, instrs); + closure_field(StgBCO, literals); + closure_field(StgBCO, ptrs); + closure_field(StgBCO, arity); + closure_field(StgBCO, size); + closure_payload(StgBCO, bitmap); + + closure_size(StgStableName); + closure_field(StgStableName,sn); + + closure_size(StgBlockingQueue); + closure_field(StgBlockingQueue, bh); + closure_field(StgBlockingQueue, owner); + closure_field(StgBlockingQueue, queue); + closure_field(StgBlockingQueue, link); + + closure_size(MessageBlackHole); + closure_field(MessageBlackHole, link); + closure_field(MessageBlackHole, tso); + closure_field(MessageBlackHole, bh); + + struct_field_("RtsFlags_ProfFlags_showCCSOnException", + RTS_FLAGS, ProfFlags.showCCSOnException); + struct_field_("RtsFlags_DebugFlags_apply", + RTS_FLAGS, DebugFlags.apply); + struct_field_("RtsFlags_DebugFlags_sanity", + RTS_FLAGS, DebugFlags.sanity); + struct_field_("RtsFlags_DebugFlags_weak", + RTS_FLAGS, DebugFlags.weak); + struct_field_("RtsFlags_GcFlags_initialStkSize", + RTS_FLAGS, GcFlags.initialStkSize); + struct_field_("RtsFlags_MiscFlags_tickInterval", + RTS_FLAGS, MiscFlags.tickInterval); + + struct_size(StgFunInfoExtraFwd); + struct_field(StgFunInfoExtraFwd, slow_apply); + struct_field(StgFunInfoExtraFwd, fun_type); + struct_field(StgFunInfoExtraFwd, arity); + struct_field_("StgFunInfoExtraFwd_bitmap", StgFunInfoExtraFwd, b.bitmap); + } struct_size(StgFunInfoExtraRev); - struct_field(StgFunInfoExtraRev, slow_apply_offset); - struct_field(StgFunInfoExtraRev, fun_type); - struct_field(StgFunInfoExtraRev, arity); - struct_field_("StgFunInfoExtraRev_bitmap", StgFunInfoExtraRev, b.bitmap); + if (mode == Gen_Header) { + struct_field(StgFunInfoExtraRev, slow_apply_offset); + struct_field(StgFunInfoExtraRev, fun_type); + struct_field(StgFunInfoExtraRev, arity); + struct_field_("StgFunInfoExtraRev_bitmap", StgFunInfoExtraRev, b.bitmap); - struct_field(StgLargeBitmap, size); - field_offset(StgLargeBitmap, bitmap); + struct_field(StgLargeBitmap, size); + field_offset(StgLargeBitmap, bitmap); - struct_size(snEntry); - struct_field(snEntry,sn_obj); - struct_field(snEntry,addr); + struct_size(snEntry); + struct_field(snEntry,sn_obj); + struct_field(snEntry,addr); + } #ifdef mingw32_HOST_OS /* Note that this conditional part only affects the C headers. @@ -745,7 +783,7 @@ main(int argc, char *argv[]) switch (mode) { case Gen_Haskell_Type: - printf(" } deriving (Read, Show)\n"); + printf(" } deriving Read\n"); break; case Gen_Haskell_Value: printf(" }\n"); |