diff options
Diffstat (limited to 'includes/rts')
34 files changed, 4216 insertions, 0 deletions
diff --git a/includes/rts/Adjustor.h b/includes/rts/Adjustor.h new file mode 100644 index 0000000000..71e15246c1 --- /dev/null +++ b/includes/rts/Adjustor.h @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2009 + * + * Adjustor API + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_ADJUSTOR_H +#define RTS_ADJUSTOR_H + +/* Creating and destroying an adjustor thunk */ +void* createAdjustor (int cconv, + StgStablePtr hptr, + StgFunPtr wptr, + char *typeString); + +void freeHaskellFunctionPtr (void* ptr); + +#endif /* RTS_ADJUSTOR_H */ diff --git a/includes/rts/Bytecodes.h b/includes/rts/Bytecodes.h new file mode 100644 index 0000000000..4aff907cfd --- /dev/null +++ b/includes/rts/Bytecodes.h @@ -0,0 +1,92 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2002 + * + * Bytecode definitions. + * + * ---------------------------------------------------------------------------*/ + +/* -------------------------------------------------------------------------- + * Instructions + * + * Notes: + * o CASEFAIL is generated by the compiler whenever it tests an "irrefutable" + * pattern which fails. If we don't see too many of these, we could + * optimise out the redundant test. + * ------------------------------------------------------------------------*/ + +/* NOTE: + + THIS FILE IS INCLUDED IN HASKELL SOURCES (ghc/compiler/ghci/ByteCodeGen.lhs). + DO NOT PUT C-SPECIFIC STUFF IN HERE! + + I hope that's clear :-) +*/ + +#define bci_STKCHECK 1 +#define bci_PUSH_L 2 +#define bci_PUSH_LL 3 +#define bci_PUSH_LLL 4 +#define bci_PUSH_G 5 +#define bci_PUSH_ALTS 6 +#define bci_PUSH_ALTS_P 7 +#define bci_PUSH_ALTS_N 8 +#define bci_PUSH_ALTS_F 9 +#define bci_PUSH_ALTS_D 10 +#define bci_PUSH_ALTS_L 11 +#define bci_PUSH_ALTS_V 12 +#define bci_PUSH_UBX 13 +#define bci_PUSH_APPLY_N 14 +#define bci_PUSH_APPLY_F 15 +#define bci_PUSH_APPLY_D 16 +#define bci_PUSH_APPLY_L 17 +#define bci_PUSH_APPLY_V 18 +#define bci_PUSH_APPLY_P 19 +#define bci_PUSH_APPLY_PP 20 +#define bci_PUSH_APPLY_PPP 21 +#define bci_PUSH_APPLY_PPPP 22 +#define bci_PUSH_APPLY_PPPPP 23 +#define bci_PUSH_APPLY_PPPPPP 24 +/* #define bci_PUSH_APPLY_PPPPPPP 25 */ +#define bci_SLIDE 26 +#define bci_ALLOC_AP 27 +#define bci_ALLOC_AP_NOUPD 28 +#define bci_ALLOC_PAP 29 +#define bci_MKAP 30 +#define bci_MKPAP 31 +#define bci_UNPACK 32 +#define bci_PACK 33 +#define bci_TESTLT_I 34 +#define bci_TESTEQ_I 35 +#define bci_TESTLT_F 36 +#define bci_TESTEQ_F 37 +#define bci_TESTLT_D 38 +#define bci_TESTEQ_D 39 +#define bci_TESTLT_P 40 +#define bci_TESTEQ_P 41 +#define bci_CASEFAIL 42 +#define bci_JMP 43 +#define bci_CCALL 44 +#define bci_SWIZZLE 45 +#define bci_ENTER 46 +#define bci_RETURN 47 +#define bci_RETURN_P 48 +#define bci_RETURN_N 49 +#define bci_RETURN_F 50 +#define bci_RETURN_D 51 +#define bci_RETURN_L 52 +#define bci_RETURN_V 53 +#define bci_BRK_FUN 54 +/* If you need to go past 255 then you will run into the flags */ + +/* If you need to go below 0x0100 then you will run into the instructions */ +#define bci_FLAG_LARGE_ARGS 0x8000 + +/* If a BCO definitely requires less than this many words of stack, + don't include an explicit STKCHECK insn in it. The interpreter + will check for this many words of stack before running each BCO, + rendering an explicit check unnecessary in the majority of + cases. */ +#define INTERP_STACK_CHECK_THRESH 50 + +/*-------------------------------------------------------------------------*/ diff --git a/includes/rts/Config.h b/includes/rts/Config.h new file mode 100644 index 0000000000..ce332fa2a2 --- /dev/null +++ b/includes/rts/Config.h @@ -0,0 +1,36 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Rts settings. + * + * NOTE: assumes #include "ghcconfig.h" + * + * NB: THIS FILE IS INCLUDED IN NON-C CODE AND DATA! #defines only please. + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_CONFIG_H +#define RTS_CONFIG_H + +#if defined(TICKY_TICKY) && defined(THREADED_RTS) +#error TICKY_TICKY is incompatible with THREADED_RTS +#endif + +/* + * Whether the runtime system will use libbfd for debugging purposes. + */ +#if defined(DEBUG) && defined(HAVE_BFD_H) && defined(HAVE_LIBBFD) && !defined(_WIN32) +#define USING_LIBBFD 1 +#endif + +/* ----------------------------------------------------------------------------- + Signals - supported on non-PAR versions of the runtime. See RtsSignals.h. + -------------------------------------------------------------------------- */ + +#define RTS_USER_SIGNALS 1 + +/* Profile spin locks */ + +#define PROF_SPIN + +#endif /* RTS_CONFIG_H */ diff --git a/includes/rts/Constants.h b/includes/rts/Constants.h new file mode 100644 index 0000000000..bab45a362c --- /dev/null +++ b/includes/rts/Constants.h @@ -0,0 +1,290 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2002 + * + * Constants + * + * NOTE: this information is used by both the compiler and the RTS. + * Some of it is tweakable, and some of it must be kept up to date + * with various other parts of the system. + * + * Constants which are derived automatically from other definitions in + * the system (eg. structure sizes) are generated into the file + * DerivedConstants.h by a C program (mkDerivedConstantsHdr). + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_CONSTANTS_H +#define RTS_CONSTANTS_H + +/* ----------------------------------------------------------------------------- + Minimum closure sizes + + This is the minimum number of words in the payload of a + heap-allocated closure, so that the closure has enough room to be + overwritten with a forwarding pointer during garbage collection. + -------------------------------------------------------------------------- */ + +#define MIN_PAYLOAD_SIZE 1 + +/* ----------------------------------------------------------------------------- + Constants to do with specialised closure types. + -------------------------------------------------------------------------- */ + +/* We have some pre-compiled selector thunks defined in rts/StgStdThunks.hc. + * This constant defines the highest selectee index that we can replace with a + * reference to the pre-compiled code. + */ + +#define MAX_SPEC_SELECTEE_SIZE 15 + +/* Vector-apply thunks. These thunks just push their free variables + * on the stack and enter the first one. They're a bit like PAPs, but + * don't have a dynamic size. We've pre-compiled a few to save + * space. + */ + +#define MAX_SPEC_AP_SIZE 7 + +/* Specialised FUN/THUNK/CONSTR closure types */ + +#define MAX_SPEC_THUNK_SIZE 2 +#define MAX_SPEC_FUN_SIZE 2 +#define MAX_SPEC_CONSTR_SIZE 2 + +/* Range of built-in table of static small int-like and char-like closures. + * + * NB. This corresponds with the number of actual INTLIKE/CHARLIKE + * closures defined in rts/StgMiscClosures.cmm. + */ +#define MAX_INTLIKE 16 +#define MIN_INTLIKE (-16) + +#define MAX_CHARLIKE 255 +#define MIN_CHARLIKE 0 + +/* ----------------------------------------------------------------------------- + STG Registers. + + Note that in MachRegs.h we define how many of these registers are + *real* machine registers, and not just offsets in the Register Table. + -------------------------------------------------------------------------- */ + +#define MAX_VANILLA_REG 8 +#define MAX_FLOAT_REG 4 +#define MAX_DOUBLE_REG 2 +#define MAX_LONG_REG 1 + +/* ----------------------------------------------------------------------------- + Semi-Tagging constants + + Old Comments about this stuff: + + Tags for indirection nodes and ``other'' (probably unevaluated) nodes; + normal-form values of algebraic data types will have tags 0, 1, ... + + @INFO_IND_TAG@ is different from @INFO_OTHER_TAG@ just so we can count + how often we bang into indirection nodes; that's all. (WDP 95/11) + + ToDo: find out if we need any of this. + -------------------------------------------------------------------------- */ + +#define INFO_OTHER_TAG (-1) +#define INFO_IND_TAG (-2) +#define INFO_FIRST_TAG 0 + +/* ----------------------------------------------------------------------------- + How much C stack to reserve for local temporaries when in the STG + world. Used in StgCRun.c. + -------------------------------------------------------------------------- */ + +#define RESERVED_C_STACK_BYTES (2048 * SIZEOF_LONG) + +/* ----------------------------------------------------------------------------- + How much Haskell stack space to reserve for the saving of registers + etc. in the case of a stack/heap overflow. + + This must be large enough to accomodate the largest stack frame + pushed in one of the heap check fragments in HeapStackCheck.hc + (ie. currently the generic heap checks - 3 words for StgRetDyn, + 18 words for the saved registers, see StgMacros.h). + + In the event of an unboxed tuple or let-no-escape stack/heap check + failure, there will be other words on the stack which are covered + by the RET_DYN frame. These will have been accounted for by stack + checks however, so we don't need to allow for them here. + -------------------------------------------------------------------------- */ + +#define RESERVED_STACK_WORDS 21 + +/* ----------------------------------------------------------------------------- + The limit on the size of the stack check performed when we enter an + AP_STACK, in words. See raiseAsync() and bug #1466. + -------------------------------------------------------------------------- */ + +#define AP_STACK_SPLIM 1024 + +/* ----------------------------------------------------------------------------- + Storage manager constants + -------------------------------------------------------------------------- */ + +/* The size of a block (2^BLOCK_SHIFT bytes) */ +#define BLOCK_SHIFT 12 + +/* The size of a megablock (2^MBLOCK_SHIFT bytes) */ +#define MBLOCK_SHIFT 20 + +/* ----------------------------------------------------------------------------- + Bitmap/size fields (used in info tables) + -------------------------------------------------------------------------- */ + +/* In a 32-bit bitmap field, we use 5 bits for the size, and 27 bits + * for the bitmap. If the bitmap requires more than 27 bits, then we + * store it in a separate array, and leave a pointer in the bitmap + * field. On a 64-bit machine, the sizes are extended accordingly. + */ +#if SIZEOF_VOID_P == 4 +#define BITMAP_SIZE_MASK 0x1f +#define BITMAP_BITS_SHIFT 5 +#elif SIZEOF_VOID_P == 8 +#define BITMAP_SIZE_MASK 0x3f +#define BITMAP_BITS_SHIFT 6 +#else +#error unknown SIZEOF_VOID_P +#endif + +/* ----------------------------------------------------------------------------- + Lag/Drag/Void constants + -------------------------------------------------------------------------- */ + +/* + An LDV word is divided into 3 parts: state bits (LDV_STATE_MASK), creation + time bits (LDV_CREATE_MASK), and last use time bits (LDV_LAST_MASK). + */ +#if SIZEOF_VOID_P == 8 +#define LDV_SHIFT 30 +#define LDV_STATE_MASK 0x1000000000000000 +#define LDV_CREATE_MASK 0x0FFFFFFFC0000000 +#define LDV_LAST_MASK 0x000000003FFFFFFF +#define LDV_STATE_CREATE 0x0000000000000000 +#define LDV_STATE_USE 0x1000000000000000 +#else +#define LDV_SHIFT 15 +#define LDV_STATE_MASK 0x40000000 +#define LDV_CREATE_MASK 0x3FFF8000 +#define LDV_LAST_MASK 0x00007FFF +#define LDV_STATE_CREATE 0x00000000 +#define LDV_STATE_USE 0x40000000 +#endif /* SIZEOF_VOID_P */ + +/* ----------------------------------------------------------------------------- + TSO related constants + -------------------------------------------------------------------------- */ + +/* + * Constants for the what_next field of a TSO, which indicates how it + * is to be run. + */ +#define ThreadRunGHC 1 /* return to address on top of stack */ +#define ThreadInterpret 2 /* interpret this thread */ +#define ThreadKilled 3 /* thread has died, don't run it */ +#define ThreadRelocated 4 /* thread has moved, link points to new locn */ +#define ThreadComplete 5 /* thread has finished */ + +/* + * Constants for the why_blocked field of a TSO + * NB. keep these in sync with GHC/Conc.lhs: threadStatus + */ +#define NotBlocked 0 +#define BlockedOnMVar 1 +#define BlockedOnBlackHole 2 +#define BlockedOnException 3 +#define BlockedOnRead 4 +#define BlockedOnWrite 5 +#define BlockedOnDelay 6 +#define BlockedOnSTM 7 + +/* Win32 only: */ +#define BlockedOnDoProc 8 + +/* Only relevant for PAR: */ + /* blocked on a remote closure represented by a Global Address: */ +#define BlockedOnGA 9 + /* same as above but without sending a Fetch message */ +#define BlockedOnGA_NoSend 10 +/* Only relevant for THREADED_RTS: */ +#define BlockedOnCCall 11 +#define BlockedOnCCall_NoUnblockExc 12 + /* same as above but don't unblock async exceptions in resumeThread() */ + +/* + * These constants are returned to the scheduler by a thread that has + * stopped for one reason or another. See typedef StgThreadReturnCode + * in TSO.h. + */ +#define HeapOverflow 1 /* might also be StackOverflow */ +#define StackOverflow 2 +#define ThreadYielding 3 +#define ThreadBlocked 4 +#define ThreadFinished 5 + +/* + * Flags for the tso->flags field. + * + * The TSO_DIRTY flag indicates that this TSO's stack should be + * scanned during garbage collection. The link field of a TSO is + * always scanned, so we don't have to dirty a TSO just for linking + * it on a different list. + * + * TSO_DIRTY is set by + * - schedule(), just before running a thread, + * - raiseAsync(), because it modifies a thread's stack + * - resumeThread(), just before running the thread again + * and unset by the garbage collector (only). + */ +#define TSO_DIRTY 1 + +/* + * TSO_LOCKED is set when a TSO is locked to a particular Capability. + */ +#define TSO_LOCKED 2 + +/* + * TSO_BLOCKEX: the TSO is blocking exceptions + * + * TSO_INTERRUPTIBLE: the TSO can be interrupted if it blocks + * interruptibly (eg. with BlockedOnMVar). + * + * TSO_STOPPED_ON_BREAKPOINT: the thread is currently stopped in a breakpoint + */ +#define TSO_BLOCKEX 4 +#define TSO_INTERRUPTIBLE 8 +#define TSO_STOPPED_ON_BREAKPOINT 16 + +/* + * TSO_LINK_DIRTY is set when a TSO's link field is modified + */ +#define TSO_LINK_DIRTY 32 + +#define TSO_MARKED 64 + +/* ----------------------------------------------------------------------------- + RET_DYN stack frames + -------------------------------------------------------------------------- */ + +/* VERY MAGIC CONSTANTS! + * must agree with code in HeapStackCheck.c, stg_gen_chk, and + * RESERVED_STACK_WORDS in Constants.h. + */ +#define RET_DYN_BITMAP_SIZE 8 +#define RET_DYN_NONPTR_REGS_SIZE 10 + +/* Sanity check that RESERVED_STACK_WORDS is reasonable. We can't + * just derive RESERVED_STACK_WORDS because it's used in Haskell code + * too. + */ +#if RESERVED_STACK_WORDS != (3 + RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE) +#error RESERVED_STACK_WORDS may be wrong! +#endif + +#endif /* RTS_CONSTANTS_H */ diff --git a/includes/rts/EventLogFormat.h b/includes/rts/EventLogFormat.h new file mode 100644 index 0000000000..363c1ca1cf --- /dev/null +++ b/includes/rts/EventLogFormat.h @@ -0,0 +1,143 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2008-2009 + * + * Event log format + * + * The log format is designed to be extensible: old tools should be + * able to parse (but not necessarily understand all of) new versions + * of the format, and new tools will be able to understand old log + * files. + * + * Each event has a specific format. If you add new events, give them + * new numbers: we never re-use old event numbers. + * + * - The format is endian-independent: all values are represented in + * bigendian order. + * + * - The format is extensible: + * + * - The header describes each event type and its length. Tools + * that don't recognise a particular event type can skip those events. + * + * - There is room for extra information in the event type + * specification, which can be ignored by older tools. + * + * - Events can have extra information added, but existing fields + * cannot be changed. Tools should ignore extra fields at the + * end of the event record. + * + * - Old event type ids are never re-used; just take a new identifier. + * + * + * The format + * ---------- + * + * log : EVENT_HEADER_BEGIN + * EventType* + * EVENT_HEADER_END + * EVENT_DATA_BEGIN + * Event* + * EVENT_DATA_END + * + * EventType : + * EVENT_ET_BEGIN + * Word16 -- unique identifier for this event + * Int16 -- >=0 size of the event in bytes (minus the header) + * -- -1 variable size + * Word32 -- length of the next field in bytes + * Word8* -- string describing the event + * Word32 -- length of the next field in bytes + * Word8* -- extra info (for future extensions) + * EVENT_ET_END + * + * Event : + * Word16 -- event_type + * Word64 -- time (nanosecs) + * [Word16] -- length of the rest (for variable-sized events only) + * ... extra event-specific info ... + * + * + * To add a new event + * ------------------ + * + * - In this file: + * - give it a new number, add a new #define EVENT_XXX below + * - In EventLog.c + * - add it to the EventDesc array + * - emit the event type in initEventLogging() + * - emit the new event in postEvent_() + * - generate the event itself by calling postEvent() somewhere + * - In the Haskell code to parse the event log file: + * - add types and code to read the new event + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_EVENTLOGFORMAT_H +#define RTS_EVENTLOGFORMAT_H + +/* + * Markers for begin/end of the Header. + */ +#define EVENT_HEADER_BEGIN 0x68647262 /* 'h' 'd' 'r' 'b' */ +#define EVENT_HEADER_END 0x68647265 /* 'h' 'd' 'r' 'e' */ + +#define EVENT_DATA_BEGIN 0x64617462 /* 'd' 'a' 't' 'b' */ +#define EVENT_DATA_END 0xffff + +/* + * Markers for begin/end of the list of Event Types in the Header. + * Header, Event Type, Begin = hetb + * Header, Event Type, End = hete + */ +#define EVENT_HET_BEGIN 0x68657462 /* 'h' 'e' 't' 'b' */ +#define EVENT_HET_END 0x68657465 /* 'h' 'e' 't' 'e' */ + +#define EVENT_ET_BEGIN 0x65746200 /* 'e' 't' 'b' 0 */ +#define EVENT_ET_END 0x65746500 /* 'e' 't' 'e' 0 */ + +/* + * Types of event + */ +#define EVENT_CREATE_THREAD 0 /* (cap, thread) */ +#define EVENT_RUN_THREAD 1 /* (cap, thread) */ +#define EVENT_STOP_THREAD 2 /* (cap, thread, status) */ +#define EVENT_THREAD_RUNNABLE 3 /* (cap, thread) */ +#define EVENT_MIGRATE_THREAD 4 /* (cap, thread, new_cap) */ +#define EVENT_RUN_SPARK 5 /* (cap, thread) */ +#define EVENT_STEAL_SPARK 6 /* (cap, thread, victim_cap) */ +#define EVENT_SHUTDOWN 7 /* (cap) */ +#define EVENT_THREAD_WAKEUP 8 /* (cap, thread, other_cap) */ +#define EVENT_GC_START 9 /* (cap) */ +#define EVENT_GC_END 10 /* (cap) */ +#define EVENT_REQUEST_SEQ_GC 11 /* (cap) */ +#define EVENT_REQUEST_PAR_GC 12 /* (cap) */ +#define EVENT_CREATE_SPARK 13 /* (cap, thread) */ +#define EVENT_SPARK_TO_THREAD 14 /* DEPRECATED! (cap, thread, spark_thread) */ +#define EVENT_CREATE_SPARK_THREAD 15 /* (cap, thread, spark_thread) */ + +#define NUM_EVENT_TAGS 16 + +/* + * Status values for EVENT_STOP_THREAD + * + * 1-5 are the StgRun return values (from includes/Constants.h): + * + * #define HeapOverflow 1 + * #define StackOverflow 2 + * #define ThreadYielding 3 + * #define ThreadBlocked 4 + * #define ThreadFinished 5 + */ +#define THREAD_SUSPENDED_FOREIGN_CALL 6 + +#ifndef EVENTLOG_CONSTANTS_ONLY + +typedef StgWord16 EventTypeNum; +typedef StgWord64 EventTimestamp; // in nanoseconds +typedef StgWord64 EventThreadID; +typedef StgWord16 EventCapNo; + +#endif + +#endif /* RTS_EVENTLOGFORMAT_H */ diff --git a/includes/rts/FileLock.h b/includes/rts/FileLock.h new file mode 100644 index 0000000000..9a35ecc581 --- /dev/null +++ b/includes/rts/FileLock.h @@ -0,0 +1,15 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2007 + * + * File locking support as required by Haskell 98 + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_FILELOCK_H +#define RTS_FILELOCK_H + +int lockFile(int fd, dev_t dev, ino_t ino, int for_writing); +int unlockFile(int fd); + +#endif /* RTS_FILELOCK_H */ diff --git a/includes/rts/Flags.h b/includes/rts/Flags.h new file mode 100644 index 0000000000..3f3a0a952f --- /dev/null +++ b/includes/rts/Flags.h @@ -0,0 +1,239 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-1999 + * + * Datatypes that holds the command-line flag settings. + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_FLAGS_H +#define RTS_FLAGS_H + +#include <stdio.h> + +/* For defaults, see the @initRtsFlagsDefaults@ routine. */ + +struct GC_FLAGS { + FILE *statsFile; + nat giveStats; +#define NO_GC_STATS 0 +#define COLLECT_GC_STATS 1 +#define ONELINE_GC_STATS 2 +#define SUMMARY_GC_STATS 3 +#define VERBOSE_GC_STATS 4 + + nat maxStkSize; /* in *words* */ + nat initialStkSize; /* in *words* */ + + nat maxHeapSize; /* in *blocks* */ + nat minAllocAreaSize; /* in *blocks* */ + nat minOldGenSize; /* in *blocks* */ + nat heapSizeSuggestion; /* in *blocks* */ + double oldGenFactor; + double pcFreeHeap; + + nat generations; + nat steps; + rtsBool squeezeUpdFrames; + + rtsBool compact; /* True <=> "compact all the time" */ + double compactThreshold; + + rtsBool sweep; /* use "mostly mark-sweep" instead of copying + * for the oldest generation */ + rtsBool ringBell; + rtsBool frontpanel; + + int idleGCDelayTime; /* in milliseconds */ + + StgWord heapBase; /* address to ask the OS for memory */ +}; + +struct DEBUG_FLAGS { + /* flags to control debugging output & extra checking in various subsystems */ + rtsBool scheduler; /* 's' */ + rtsBool interpreter; /* 'i' */ + rtsBool weak; /* 'w' */ + rtsBool gccafs; /* 'G' */ + rtsBool gc; /* 'g' */ + rtsBool block_alloc; /* 'b' */ + rtsBool sanity; /* 'S' warning: might be expensive! */ + rtsBool stable; /* 't' */ + rtsBool prof; /* 'p' */ + rtsBool eventlog; /* 'e' */ + rtsBool linker; /* 'l' the object linker */ + rtsBool apply; /* 'a' */ + rtsBool stm; /* 'm' */ + rtsBool squeeze; /* 'z' stack squeezing & lazy blackholing */ + rtsBool hpc; /* 'c' coverage */ + rtsBool timestamp; /* add timestamps to traces */ +}; + +struct COST_CENTRE_FLAGS { + unsigned int doCostCentres; +# define COST_CENTRES_SUMMARY 1 +# define COST_CENTRES_VERBOSE 2 /* incl. serial time profile */ +# define COST_CENTRES_ALL 3 +# define COST_CENTRES_XML 4 + + int profilerTicks; /* derived */ + int msecsPerTick; /* derived */ +}; + +struct PROFILING_FLAGS { + unsigned int doHeapProfile; +# define NO_HEAP_PROFILING 0 /* N.B. Used as indexes into arrays */ +# define HEAP_BY_CCS 1 +# define HEAP_BY_MOD 2 +# define HEAP_BY_DESCR 4 +# define HEAP_BY_TYPE 5 +# define HEAP_BY_RETAINER 6 +# define HEAP_BY_LDV 7 + +# define HEAP_BY_CLOSURE_TYPE 8 + + nat profileInterval; /* delta between samples (in ms) */ + nat profileIntervalTicks; /* delta between samples (in 'ticks') */ + rtsBool includeTSOs; + + + rtsBool showCCSOnException; + + nat maxRetainerSetSize; + + nat ccsLength; + + char* modSelector; + char* descrSelector; + char* typeSelector; + char* ccSelector; + char* ccsSelector; + char* retainerSelector; + char* bioSelector; + +}; + +#ifdef EVENTLOG +struct EVENTLOG_FLAGS { + rtsBool doEventLogging; +}; +#endif + +struct CONCURRENT_FLAGS { + int ctxtSwitchTime; /* in milliseconds */ + int ctxtSwitchTicks; /* derived */ +}; + +struct MISC_FLAGS { + int tickInterval; /* in milliseconds */ + rtsBool install_signal_handlers; + rtsBool machineReadable; + StgWord linkerMemBase; /* address to ask the OS for memory + * for the linker, NULL ==> off */ +}; + +#ifdef THREADED_RTS +struct PAR_FLAGS { + nat nNodes; /* number of threads to run simultaneously */ + rtsBool migrate; /* migrate threads between capabilities */ + rtsBool wakeupMigrate; /* migrate a thread on wakeup */ + unsigned int maxLocalSparks; + rtsBool parGcEnabled; /* enable parallel GC */ + rtsBool parGcGen; /* do parallel GC in this generation + * and higher only */ + rtsBool parGcLoadBalancing; /* do load-balancing in parallel GC */ + rtsBool setAffinity; /* force thread affinity with CPUs */ +}; +#endif /* THREADED_RTS */ + +struct TICKY_FLAGS { + rtsBool showTickyStats; + FILE *tickyFile; +}; + +#ifdef USE_PAPI +#define MAX_PAPI_USER_EVENTS 8 + +struct PAPI_FLAGS { + nat eventType; /* The type of events to count */ + nat numUserEvents; + char * userEvents[MAX_PAPI_USER_EVENTS]; +}; + +#define PAPI_FLAG_CACHE_L1 1 +#define PAPI_FLAG_CACHE_L2 2 +#define PAPI_FLAG_BRANCH 3 +#define PAPI_FLAG_STALLS 4 +#define PAPI_FLAG_CB_EVENTS 5 +#define PAPI_USER_EVENTS 6 + +#endif + +/* Put them together: */ + +typedef struct _RTS_FLAGS { + /* The first portion of RTS_FLAGS is invariant. */ + struct GC_FLAGS GcFlags; + struct CONCURRENT_FLAGS ConcFlags; + struct MISC_FLAGS MiscFlags; + struct DEBUG_FLAGS DebugFlags; + struct COST_CENTRE_FLAGS CcFlags; + struct PROFILING_FLAGS ProfFlags; +#ifdef EVENTLOG + struct EVENTLOG_FLAGS EventLogFlags; +#endif + struct TICKY_FLAGS TickyFlags; + +#if defined(THREADED_RTS) + struct PAR_FLAGS ParFlags; +#endif +#ifdef USE_PAPI + struct PAPI_FLAGS PapiFlags; +#endif +} RTS_FLAGS; + +#ifdef COMPILING_RTS_MAIN +extern DLLIMPORT RTS_FLAGS RtsFlags; +#elif IN_STG_CODE +/* Hack because the C code generator can't generate '&label'. */ +extern RTS_FLAGS RtsFlags[]; +#else +extern RTS_FLAGS RtsFlags; +#endif + +/* Routines that operate-on/to-do-with RTS flags: */ + +extern void initRtsFlagsDefaults(void); +extern void setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[]); +extern void setProgName(char *argv[]); + + +/* + * The printf formats are here, so we are less likely to make + * overly-long filenames (with disastrous results). No more than 128 + * chars, please! + */ + +#define STATS_FILENAME_MAXLEN 128 + +#define GR_FILENAME_FMT "%0.124s.gr" +#define GR_FILENAME_FMT_GUM "%0.120s.%03d.%s" +#define HP_FILENAME_FMT "%0.124s.hp" +#define LIFE_FILENAME_FMT "%0.122s.life" +#define PROF_FILENAME_FMT "%0.122s.prof" +#define PROF_FILENAME_FMT_GUM "%0.118s.%03d.prof" +#define QP_FILENAME_FMT "%0.124s.qp" +#define STAT_FILENAME_FMT "%0.122s.stat" +#define TICKY_FILENAME_FMT "%0.121s.ticky" +#define TIME_FILENAME_FMT "%0.122s.time" +#define TIME_FILENAME_FMT_GUM "%0.118s.%03d.time" + +/* an "int" so as to match normal "argc" */ +/* Now defined in Stg.h (lib/std/cbits need these too.) +extern int prog_argc; +extern char **prog_argv; +*/ +extern int rts_argc; /* ditto */ +extern char *rts_argv[]; + +#endif /* RTS_FLAGS_H */ diff --git a/includes/rts/Globals.h b/includes/rts/Globals.h new file mode 100644 index 0000000000..71846e75a1 --- /dev/null +++ b/includes/rts/Globals.h @@ -0,0 +1,18 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2006-2009 + * + * The RTS stores some "global" values on behalf of libraries, so that + * some libraries can ensure that certain top-level things are shared + * even when multiple versions of the library are loaded. e.g. see + * Data.Typeable and GHC.Conc. + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_GLOBALS_H +#define RTS_GLOBALS_H + +StgStablePtr getOrSetTypeableStore(StgStablePtr value); +StgStablePtr getOrSetSignalHandlerStore(StgStablePtr value); + +#endif /* RTS_GLOBALS_H */ diff --git a/includes/rts/Hooks.h b/includes/rts/Hooks.h new file mode 100644 index 0000000000..4fe50b4b9f --- /dev/null +++ b/includes/rts/Hooks.h @@ -0,0 +1,21 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-1999 + * + * User-overridable RTS hooks. + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_HOOKS_H +#define RTS_HOOKS_H + +extern char *ghc_rts_opts; + +extern void OnExitHook (void); +extern int NoRunnableThreadsHook (void); +extern void StackOverflowHook (unsigned long stack_size); +extern void OutOfHeapHook (unsigned long request_size, unsigned long heap_size); +extern void MallocFailHook (unsigned long request_size /* in bytes */, char *msg); +extern void defaultsHook (void); + +#endif /* RTS_HOOKS_H */ diff --git a/includes/rts/Hpc.h b/includes/rts/Hpc.h new file mode 100644 index 0000000000..c966e32cd9 --- /dev/null +++ b/includes/rts/Hpc.h @@ -0,0 +1,32 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2008-2009 + * + * Haskell Program Coverage + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_HPC_H +#define RTS_HPC_H + +// Simple linked list of modules +typedef struct _HpcModuleInfo { + char *modName; // name of module + StgWord32 tickCount; // number of ticks + StgWord32 tickOffset; // offset into a single large .tix Array + StgWord32 hashNo; // Hash number for this module's mix info + StgWord64 *tixArr; // tix Array; local for this module + struct _HpcModuleInfo *next; +} HpcModuleInfo; + +int hs_hpc_module (char *modName, + StgWord32 modCount, + StgWord32 modHashNo, + StgWord64 *tixArr); + +HpcModuleInfo * hs_hpc_rootModule (void); + +void startupHpc(void); +void exitHpc(void); + +#endif /* RTS_HPC_H */ diff --git a/includes/rts/IOManager.h b/includes/rts/IOManager.h new file mode 100644 index 0000000000..1c269ada6d --- /dev/null +++ b/includes/rts/IOManager.h @@ -0,0 +1,39 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2009 + * + * IO Manager functionality in the RTS + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_IOMANAGER_H +#define RTS_IOMANAGER_H + +#if defined(mingw32_HOST_OS) + +int rts_InstallConsoleEvent ( int action, StgStablePtr *handler ); +void rts_ConsoleHandlerDone ( int ev ); +extern StgInt console_handler; + +void * getIOManagerEvent (void); +HsWord32 readIOManagerEvent (void); +void sendIOManagerEvent (HsWord32 event); + +#else + +void setIOManagerPipe (int fd); + +#endif + +// +// Communicating with the IO manager thread (see GHC.Conc). +// Posix implementation in posix/Signals.c +// Win32 implementation in win32/ThrIOManager.c +// +#if defined(THREADED_RTS) +void ioManagerWakeup (void); +void ioManagerDie (void); +void ioManagerStart (void); +#endif + +#endif /* RTS_IOMANAGER_H */ diff --git a/includes/rts/Linker.h b/includes/rts/Linker.h new file mode 100644 index 0000000000..df74e7eeb8 --- /dev/null +++ b/includes/rts/Linker.h @@ -0,0 +1,36 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2000 + * + * RTS Object Linker + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_LINKER_H +#define RTS_LINKER_H + +/* initialize the object linker */ +void initLinker( void ); + +/* insert a stable symbol in the hash table */ +void insertStableSymbol(char* obj_name, char* key, StgPtr data); + +/* insert a symbol in the hash table */ +void insertSymbol(char* obj_name, char* key, void* data); + +/* lookup a symbol in the hash table */ +void *lookupSymbol( char *lbl ); + +/* delete an object from the pool */ +HsInt unloadObj( char *path ); + +/* add an obj (populate the global symbol table, but don't resolve yet) */ +HsInt loadObj( char *path ); + +/* resolve all the currently unlinked objects in memory */ +HsInt resolveObjs( void ); + +/* load a dynamic library */ +const char *addDLL( char* dll_name ); + +#endif /* RTS_LINKER_H */ diff --git a/includes/rts/Messages.h b/includes/rts/Messages.h new file mode 100644 index 0000000000..e01eff47cf --- /dev/null +++ b/includes/rts/Messages.h @@ -0,0 +1,92 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Message API for use inside the RTS. All messages generated by the + * RTS should go through one of the functions declared here, and we + * also provide hooks so that messages from the RTS can be redirected + * as appropriate. + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_MESSAGES_H +#define RTS_MESSAGES_H + +#include <stdarg.h> + +/* ----------------------------------------------------------------------------- + * Message generation + * -------------------------------------------------------------------------- */ + +/* + * A fatal internal error: this is for errors that probably indicate + * bugs in the RTS or compiler. We normally output bug reporting + * instructions along with the error message. + * + * barf() invokes (*fatalInternalErrorFn)(). This function is not + * expected to return. + */ +void barf(const char *s, ...) + GNUC3_ATTRIBUTE(__noreturn__); + +void vbarf(const char *s, va_list ap) + GNUC3_ATTRIBUTE(__noreturn__); + +// declared in Rts.h: +// extern void _assertFail(const char *filename, unsigned int linenum) +// GNUC3_ATTRIBUTE(__noreturn__); + +/* + * An error condition which is caused by and/or can be corrected by + * the user. + * + * errorBelch() invokes (*errorMsgFn)(). + */ +void errorBelch(const char *s, ...) + GNUC3_ATTRIBUTE(format (printf, 1, 2)); + +void verrorBelch(const char *s, va_list ap); + +/* + * An error condition which is caused by and/or can be corrected by + * the user, and which has an associated error condition reported + * by the system (in errno on Unix, and GetLastError() on Windows). + * The system error message is appended to the message generated + * from the supplied format string. + * + * sysErrorBelch() invokes (*sysErrorMsgFn)(). + */ +void sysErrorBelch(const char *s, ...) + GNUC3_ATTRIBUTE(format (printf, 1, 2)); + +void vsysErrorBelch(const char *s, va_list ap); + +/* + * A debugging message. Debugging messages are generated either as a + * virtue of having DEBUG turned on, or by being explicitly selected + * via RTS options (eg. +RTS -Ds). + * + * debugBelch() invokes (*debugMsgFn)(). + */ +void debugBelch(const char *s, ...) + GNUC3_ATTRIBUTE(format (printf, 1, 2)); + +void vdebugBelch(const char *s, va_list ap); + + +/* Hooks for redirecting message generation: */ + +typedef void RtsMsgFunction(const char *, va_list); + +extern RtsMsgFunction *fatalInternalErrorFn; +extern RtsMsgFunction *debugMsgFn; +extern RtsMsgFunction *errorMsgFn; + +/* Default stdio implementation of the message hooks: */ + +extern RtsMsgFunction rtsFatalInternalErrorFn; +extern RtsMsgFunction rtsDebugMsgFn; +extern RtsMsgFunction rtsErrorMsgFn; +extern RtsMsgFunction rtsSysErrorMsgFn; + +#endif /* RTS_MESSAGES_H */ diff --git a/includes/rts/OSThreads.h b/includes/rts/OSThreads.h new file mode 100644 index 0000000000..2d32136379 --- /dev/null +++ b/includes/rts/OSThreads.h @@ -0,0 +1,209 @@ +/* --------------------------------------------------------------------------- + * + * (c) The GHC Team, 2001-2005 + * + * Accessing OS threads functionality in a (mostly) OS-independent + * manner. + * + * --------------------------------------------------------------------------*/ + +#ifndef RTS_OSTHREADS_H +#define RTS_OSTHREADS_H + +#if defined(THREADED_RTS) /* to the end */ + +# if defined(HAVE_PTHREAD_H) && !defined(WANT_NATIVE_WIN32_THREADS) + +#if CMINUSMINUS + +#define ACQUIRE_LOCK(mutex) foreign "C" pthread_mutex_lock(mutex) +#define RELEASE_LOCK(mutex) foreign "C" pthread_mutex_unlock(mutex) +#define ASSERT_LOCK_HELD(mutex) /* nothing */ + +#else + +#include <pthread.h> +#include <errno.h> + +typedef pthread_cond_t Condition; +typedef pthread_mutex_t Mutex; +typedef pthread_t OSThreadId; +typedef pthread_key_t ThreadLocalKey; + +#define OSThreadProcAttr /* nothing */ + +#define INIT_COND_VAR PTHREAD_COND_INITIALIZER + +#ifdef LOCK_DEBUG +#define LOCK_DEBUG_BELCH(what, mutex) \ + debugBelch("%s(0x%p) %s %d\n", what, mutex, __FILE__, __LINE__) +#else +#define LOCK_DEBUG_BELCH(what, mutex) /* nothing */ +#endif + +/* Always check the result of lock and unlock. */ +#define ACQUIRE_LOCK(mutex) \ + LOCK_DEBUG_BELCH("ACQUIRE_LOCK", mutex); \ + if (pthread_mutex_lock(mutex) == EDEADLK) { \ + barf("multiple ACQUIRE_LOCK: %s %d", __FILE__,__LINE__); \ + } + +#define RELEASE_LOCK(mutex) \ + LOCK_DEBUG_BELCH("RELEASE_LOCK", mutex); \ + if (pthread_mutex_unlock(mutex) != 0) { \ + barf("RELEASE_LOCK: I do not own this lock: %s %d", __FILE__,__LINE__); \ + } + +// Note: this assertion calls pthread_mutex_lock() on a mutex that +// is already held by the calling thread. The mutex should therefore +// have been created with PTHREAD_MUTEX_ERRORCHECK, otherwise this +// assertion will hang. We always initialise mutexes with +// PTHREAD_MUTEX_ERRORCHECK when DEBUG is on (see rts/posix/OSThreads.h). +#define ASSERT_LOCK_HELD(mutex) ASSERT(pthread_mutex_lock(mutex) == EDEADLK) + +#endif // CMINUSMINUS + +# elif defined(HAVE_WINDOWS_H) + +#if CMINUSMINUS + +/* We jump through a hoop here to get a CCall EnterCriticalSection + and LeaveCriticalSection, as that's what C-- wants. */ + +#define ACQUIRE_LOCK(mutex) foreign "stdcall" EnterCriticalSection(mutex) +#define RELEASE_LOCK(mutex) foreign "stdcall" LeaveCriticalSection(mutex) +#define ASSERT_LOCK_HELD(mutex) /* nothing */ + +#else + +#include <windows.h> + +typedef HANDLE Condition; +typedef DWORD OSThreadId; +// don't be tempted to use HANDLE as the OSThreadId: there can be +// many HANDLES to a given thread, so comparison would not work. +typedef DWORD ThreadLocalKey; + +#define OSThreadProcAttr __stdcall + +#define INIT_COND_VAR 0 + +// We have a choice for implementing Mutexes on Windows. Standard +// Mutexes are kernel objects that require kernel calls to +// acquire/release, whereas CriticalSections are spin-locks that block +// in the kernel after spinning for a configurable number of times. +// CriticalSections are *much* faster, so we use those. The Mutex +// implementation is left here for posterity. +#define USE_CRITICAL_SECTIONS 1 + +#if USE_CRITICAL_SECTIONS + +typedef CRITICAL_SECTION Mutex; + +#ifdef LOCK_DEBUG + +#define ACQUIRE_LOCK(mutex) \ + debugBelch("ACQUIRE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \ + EnterCriticalSection(mutex) +#define RELEASE_LOCK(mutex) \ + debugBelch("RELEASE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \ + LeaveCriticalSection(mutex) +#define ASSERT_LOCK_HELD(mutex) /* nothing */ + +#else + +#define ACQUIRE_LOCK(mutex) EnterCriticalSection(mutex) +#define RELEASE_LOCK(mutex) LeaveCriticalSection(mutex) + +// I don't know how to do this. TryEnterCriticalSection() doesn't do +// the right thing. +#define ASSERT_LOCK_HELD(mutex) /* nothing */ + +#endif + +#else + +typedef HANDLE Mutex; + +// casting to (Mutex *) here required due to use in .cmm files where +// the argument has (void *) type. +#define ACQUIRE_LOCK(mutex) \ + if (WaitForSingleObject(*((Mutex *)mutex),INFINITE) == WAIT_FAILED) { \ + barf("WaitForSingleObject: %d", GetLastError()); \ + } + +#define RELEASE_LOCK(mutex) \ + if (ReleaseMutex(*((Mutex *)mutex)) == 0) { \ + barf("ReleaseMutex: %d", GetLastError()); \ + } + +#define ASSERT_LOCK_HELD(mutex) /* nothing */ +#endif + +#endif // CMINUSMINUS + +# else +# error "Threads not supported" +# endif + + +#ifndef CMINUSMINUS +// +// General thread operations +// +extern OSThreadId osThreadId ( void ); +extern void shutdownThread ( void ) GNUC3_ATTRIBUTE(__noreturn__); +extern void yieldThread ( void ); + +typedef void OSThreadProcAttr OSThreadProc(void *); + +extern int createOSThread ( OSThreadId* tid, + OSThreadProc *startProc, void *param); +extern rtsBool osThreadIsAlive ( OSThreadId id ); + +// +// Condition Variables +// +extern void initCondition ( Condition* pCond ); +extern void closeCondition ( Condition* pCond ); +extern rtsBool broadcastCondition ( Condition* pCond ); +extern rtsBool signalCondition ( Condition* pCond ); +extern rtsBool waitCondition ( Condition* pCond, + Mutex* pMut ); + +// +// Mutexes +// +extern void initMutex ( Mutex* pMut ); +extern void closeMutex ( Mutex* pMut ); + +// +// Thread-local storage +// +void newThreadLocalKey (ThreadLocalKey *key); +void *getThreadLocalVar (ThreadLocalKey *key); +void setThreadLocalVar (ThreadLocalKey *key, void *value); +void freeThreadLocalKey (ThreadLocalKey *key); + +// Processors and affinity +nat getNumberOfProcessors (void); +void setThreadAffinity (nat n, nat m); +#endif // !CMINUSMINUS + +#else + +#define ACQUIRE_LOCK(l) +#define RELEASE_LOCK(l) +#define ASSERT_LOCK_HELD(l) + +#endif /* defined(THREADED_RTS) */ + +// +// Support for forkOS (defined regardless of THREADED_RTS, but does +// nothing when !THREADED_RTS). +// +#ifndef CMINUSMINUS +int forkOS_createThread ( HsStablePtr entry ); +#endif + +#endif /* RTS_OSTHREADS_H */ diff --git a/includes/rts/Parallel.h b/includes/rts/Parallel.h new file mode 100644 index 0000000000..b6759819b1 --- /dev/null +++ b/includes/rts/Parallel.h @@ -0,0 +1,14 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2009 + * + * Parallelism-related functionality + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_PARALLEL_H +#define RTS_PARALLEL_H + +StgInt newSpark (StgRegTable *reg, StgClosure *p); + +#endif /* RTS_PARALLEL_H */ diff --git a/includes/rts/Signals.h b/includes/rts/Signals.h new file mode 100644 index 0000000000..8d9e0fd4b7 --- /dev/null +++ b/includes/rts/Signals.h @@ -0,0 +1,21 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2009 + * + * RTS signal handling + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_SIGNALS_H +#define RTS_SIGNALS_H + +/* NB. #included in Haskell code, no prototypes in here. */ + +/* arguments to stg_sig_install() */ +#define STG_SIG_DFL (-1) +#define STG_SIG_IGN (-2) +#define STG_SIG_ERR (-3) +#define STG_SIG_HAN (-4) +#define STG_SIG_RST (-5) + +#endif /* RTS_SIGNALS_H */ diff --git a/includes/rts/SpinLock.h b/includes/rts/SpinLock.h new file mode 100644 index 0000000000..ea992a3457 --- /dev/null +++ b/includes/rts/SpinLock.h @@ -0,0 +1,105 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 2006-2008 + * + * Spin locks + * + * These are simple spin-only locks as opposed to Mutexes which + * probably spin for a while before blocking in the kernel. We use + * these when we are sure that all our threads are actively running on + * a CPU, eg. in the GC. + * + * TODO: measure whether we really need these, or whether Mutexes + * would do (and be a bit safer if a CPU becomes loaded). + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_SPINLOCK_H +#define RTS_SPINLOCK_H + +#if defined(THREADED_RTS) + +#if defined(PROF_SPIN) +typedef struct SpinLock_ +{ + StgWord lock; + StgWord64 spin; // DEBUG version counts how much it spins +} SpinLock; +#else +typedef StgWord SpinLock; +#endif + +typedef lnat SpinLockCount; + + +#if defined(PROF_SPIN) + +// PROF_SPIN enables counting the number of times we spin on a lock + +// acquire spin lock +INLINE_HEADER void ACQUIRE_SPIN_LOCK(SpinLock * p) +{ + StgWord32 r = 0; +spin: + r = cas((StgVolatilePtr)&(p->lock), 1, 0); + if (r == 0) { + p->spin++; + goto spin; + } +} + +// release spin lock +INLINE_HEADER void RELEASE_SPIN_LOCK(SpinLock * p) +{ + write_barrier(); + p->lock = 1; +} + +// initialise spin lock +INLINE_HEADER void initSpinLock(SpinLock * p) +{ + write_barrier(); + p->lock = 1; + p->spin = 0; +} + +#else + +// acquire spin lock +INLINE_HEADER void ACQUIRE_SPIN_LOCK(SpinLock * p) +{ + StgWord32 r = 0; + do { + r = cas((StgVolatilePtr)p, 1, 0); + } while(r == 0); +} + +// release spin lock +INLINE_HEADER void RELEASE_SPIN_LOCK(SpinLock * p) +{ + write_barrier(); + (*p) = 1; +} + +// init spin lock +INLINE_HEADER void initSpinLock(SpinLock * p) +{ + write_barrier(); + (*p) = 1; +} + +#endif /* PROF_SPIN */ + +#else /* !THREADED_RTS */ + +// Using macros here means we don't have to ensure the argument is in scope +#define ACQUIRE_SPIN_LOCK(p) /* nothing */ +#define RELEASE_SPIN_LOCK(p) /* nothing */ + +INLINE_HEADER void initSpinLock(void * p STG_UNUSED) +{ /* nothing */ } + +#endif /* THREADED_RTS */ + +#endif /* RTS_SPINLOCK_H */ + diff --git a/includes/rts/Stable.h b/includes/rts/Stable.h new file mode 100644 index 0000000000..95a3f96156 --- /dev/null +++ b/includes/rts/Stable.h @@ -0,0 +1,35 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Stable Pointers + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_STABLE_H +#define RTS_STABLE_H + +EXTERN_INLINE StgPtr deRefStablePtr (StgStablePtr stable_ptr); +StgStablePtr getStablePtr (StgPtr p); + +/* ----------------------------------------------------------------------------- + PRIVATE from here. + -------------------------------------------------------------------------- */ + +typedef struct { + StgPtr addr; /* Haskell object, free list, or NULL */ + StgPtr old; /* old Haskell object, used during GC */ + StgWord ref; /* used for reference counting */ + StgClosure *sn_obj; /* the StableName object (or NULL) */ +} snEntry; + +extern DLL_IMPORT_RTS snEntry *stable_ptr_table; + +EXTERN_INLINE +StgPtr deRefStablePtr(StgStablePtr sp) +{ + ASSERT(stable_ptr_table[(StgWord)sp].ref > 0); + return stable_ptr_table[(StgWord)sp].addr; +} + +#endif /* RTS_STABLE_H */ diff --git a/includes/rts/Threads.h b/includes/rts/Threads.h new file mode 100644 index 0000000000..06a0ed11dc --- /dev/null +++ b/includes/rts/Threads.h @@ -0,0 +1,47 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 1998-2009 + * + * External API for the scheduler. For most uses, the functions in + * RtsAPI.h should be enough. + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_THREADS_H +#define RTS_THREADS_H + +// +// Creating threads +// +StgTSO *createThread (Capability *cap, nat stack_size); + +Capability *scheduleWaitThread (StgTSO *tso, /*out*/HaskellObj* ret, + Capability *cap); + +StgTSO *createGenThread (Capability *cap, nat stack_size, + StgClosure *closure); +StgTSO *createIOThread (Capability *cap, nat stack_size, + StgClosure *closure); +StgTSO *createStrictIOThread (Capability *cap, nat stack_size, + StgClosure *closure); + +// Suspending/resuming threads around foreign calls +void * suspendThread (StgRegTable *); +StgRegTable * resumeThread (void *); + +// +// Thread operations from Threads.c +// +int cmp_thread (StgPtr tso1, StgPtr tso2); +int rts_getThreadId (StgPtr tso); +pid_t forkProcess (HsStablePtr *entry); +HsBool rtsSupportsBoundThreads (void); + +// The number of Capabilities +extern unsigned int n_capabilities; + +#if !IN_STG_CODE +extern Capability MainCapability; +#endif + +#endif /* RTS_THREADS_H */ diff --git a/includes/rts/Timer.h b/includes/rts/Timer.h new file mode 100644 index 0000000000..e3a5c2dc69 --- /dev/null +++ b/includes/rts/Timer.h @@ -0,0 +1,15 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2006 + * + * Interface to the RTS timer signal (uses OS-dependent Ticker.h underneath) + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_TIMER_H +#define RTS_TIMER_H + +void startTimer (void); +void stopTimer (void); + +#endif /* RTS_TIMER_H */ diff --git a/includes/rts/Types.h b/includes/rts/Types.h new file mode 100644 index 0000000000..6f399e083d --- /dev/null +++ b/includes/rts/Types.h @@ -0,0 +1,42 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2008 + * + * RTS-specific types. + * + * ---------------------------------------------------------------------------*/ + +/* ------------------------------------------------------------------------- + Generally useful typedefs + ------------------------------------------------------------------------- */ + +#ifndef RTS_TYPES_H +#define RTS_TYPES_H + +typedef unsigned int nat; /* at least 32 bits (like int) */ +typedef unsigned long lnat; /* at least 32 bits */ +#ifndef _MSC_VER +typedef unsigned long long ullong; /* at least 32 bits */ +typedef long long llong; +#else +typedef unsigned __int64 ullong; /* at least 32 bits */ +typedef __int64 llong; +#endif + +/* ullong (64|128-bit) type: only include if needed (not ANSI) */ +#if defined(__GNUC__) +#define LL(x) (x##LL) +#else +#define LL(x) (x##L) +#endif + +typedef enum { + rtsFalse = 0, + rtsTrue +} rtsBool; + +typedef struct StgClosure_ StgClosure; +typedef struct StgInfoTable_ StgInfoTable; +typedef struct StgTSO_ StgTSO; + +#endif /* RTS_TYPES_H */ diff --git a/includes/rts/prof/CCS.h b/includes/rts/prof/CCS.h new file mode 100644 index 0000000000..3512930b7b --- /dev/null +++ b/includes/rts/prof/CCS.h @@ -0,0 +1,238 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2004 + * + * Macros for profiling operations in STG code + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_PROF_CCS_H +#define RTS_PROF_CCS_H + +/* ----------------------------------------------------------------------------- + * Data Structures + * ---------------------------------------------------------------------------*/ +/* + * NB. be careful to avoid unwanted padding between fields, by + * putting the 8-byte fields on an 8-byte boundary. Padding can + * vary between C compilers, and we don't take into account any + * possible padding when generating CCS and CC decls in the code + * generator (compiler/codeGen/CgProf.hs). + */ + +typedef struct _CostCentre { + StgInt ccID; + + char * label; + char * module; + + /* used for accumulating costs at the end of the run... */ + StgWord time_ticks; + StgWord64 mem_alloc; /* align 8 (see above) */ + + StgInt is_caf; + + struct _CostCentre *link; +} CostCentre; + +typedef struct _CostCentreStack { + StgInt ccsID; + + CostCentre *cc; + struct _CostCentreStack *prevStack; + struct _IndexTable *indexTable; + + StgWord64 scc_count; /* align 8 (see above) */ + StgWord selected; + StgWord time_ticks; + StgWord64 mem_alloc; /* align 8 (see above) */ + StgWord64 inherited_alloc; /* align 8 (see above) */ + StgWord inherited_ticks; + + CostCentre *root; +} CostCentreStack; + + +/* ----------------------------------------------------------------------------- + * The rest is PROFILING only... + * ---------------------------------------------------------------------------*/ + +#if defined(PROFILING) + +/* ----------------------------------------------------------------------------- + * Constants + * ---------------------------------------------------------------------------*/ + +#define EMPTY_STACK NULL +#define EMPTY_TABLE NULL + +/* Constants used to set sumbsumed flag on CostCentres */ + +#define CC_IS_CAF 'c' /* 'c' => *is* a CAF cc */ +#define CC_IS_BORING 'B' /* 'B' => *not* a CAF/sub cc */ + + +/* ----------------------------------------------------------------------------- + * Data Structures + * ---------------------------------------------------------------------------*/ + +typedef struct _IndexTable { + CostCentre *cc; + CostCentreStack *ccs; + struct _IndexTable *next; + unsigned int back_edge; +} IndexTable; + + +/* ----------------------------------------------------------------------------- + Pre-defined cost centres and cost centre stacks + -------------------------------------------------------------------------- */ + +extern CostCentreStack * RTS_VAR(CCCS); /* current CCS */ + +#if IN_STG_CODE + +extern StgWord CC_MAIN[]; +extern StgWord CCS_MAIN[]; /* Top CCS */ + +extern StgWord CC_SYSTEM[]; +extern StgWord CCS_SYSTEM[]; /* RTS costs */ + +extern StgWord CC_GC[]; +extern StgWord CCS_GC[]; /* Garbage collector costs */ + +extern StgWord CC_SUBSUMED[]; +extern StgWord CCS_SUBSUMED[]; /* Costs are subsumed by caller */ + +extern StgWord CC_OVERHEAD[]; +extern StgWord CCS_OVERHEAD[]; /* Profiling overhead */ + +extern StgWord CC_DONT_CARE[]; +extern StgWord CCS_DONT_CARE[]; /* shouldn't ever get set */ + +#else + +extern CostCentre CC_MAIN[]; +extern CostCentreStack CCS_MAIN[]; /* Top CCS */ + +extern CostCentre CC_SYSTEM[]; +extern CostCentreStack CCS_SYSTEM[]; /* RTS costs */ + +extern CostCentre CC_GC[]; +extern CostCentreStack CCS_GC[]; /* Garbage collector costs */ + +extern CostCentre CC_SUBSUMED[]; +extern CostCentreStack CCS_SUBSUMED[]; /* Costs are subsumed by caller */ + +extern CostCentre CC_OVERHEAD[]; +extern CostCentreStack CCS_OVERHEAD[]; /* Profiling overhead */ + +extern CostCentre CC_DONT_CARE[]; +extern CostCentreStack CCS_DONT_CARE[]; /* shouldn't ever get set */ + +#endif /* IN_STG_CODE */ + +extern unsigned int RTS_VAR(CC_ID); /* global ids */ +extern unsigned int RTS_VAR(CCS_ID); +extern unsigned int RTS_VAR(HP_ID); + +extern unsigned int RTS_VAR(era); + +/* ----------------------------------------------------------------------------- + * Functions + * ---------------------------------------------------------------------------*/ + +void EnterFunCCS ( CostCentreStack *ccsfn ); +CostCentreStack *PushCostCentre ( CostCentreStack *, CostCentre * ); +CostCentreStack *AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 ); + +extern unsigned int RTS_VAR(entering_PAP); + +/* ----------------------------------------------------------------------------- + * Registering CCs + + Cost centres are registered at startup by calling a registering + routine in each module. Each module registers its cost centres and + calls the registering routine for all imported modules. The RTS calls + the registering routine for the module Main. This registering must be + done before initialisation since the evaluation required for + initialisation may use the cost centres. + + As the code for each module uses tail calls we use an auxiliary stack + (in the heap) to record imported modules still to be registered. At + the bottom of the stack is NULL which indicates that + @miniInterpretEnd@ should be resumed. + + @START_REGISTER@ and @END_REGISTER@ are special macros used to + delimit the function. @END_REGISTER@ pops the next registering + routine off the stack and jumps to it. @REGISTER_CC@ registers a cost + centre. @REGISTER_IMPORT@ pushes a modules registering routine onto + the register stack. + + -------------------------------------------------------------------------- */ + +extern CostCentre * RTS_VAR(CC_LIST); /* registered CC list */ +extern CostCentreStack * RTS_VAR(CCS_LIST); /* registered CCS list */ + +#define REGISTER_CC(cc) \ + do { \ + extern CostCentre cc[]; \ + if ((cc)->link == (CostCentre *)0) { \ + (cc)->link = CC_LIST; \ + CC_LIST = (cc); \ + (cc)->ccID = CC_ID++; \ + }} while(0) + +#define REGISTER_CCS(ccs) \ + do { \ + extern CostCentreStack ccs[]; \ + if ((ccs)->prevStack == (CostCentreStack *)0) { \ + (ccs)->prevStack = CCS_LIST; \ + CCS_LIST = (ccs); \ + (ccs)->ccsID = CCS_ID++; \ + }} while(0) + +/* ----------------------------------------------------------------------------- + * Declaring Cost Centres & Cost Centre Stacks. + * -------------------------------------------------------------------------- */ + +# define CC_DECLARE(cc_ident,name,module,caf,is_local) \ + is_local CostCentre cc_ident[1] \ + = {{ 0, \ + name, \ + module, \ + 0, \ + 0, \ + caf, \ + 0 }}; + +# define CCS_DECLARE(ccs_ident,cc_ident,is_local) \ + is_local CostCentreStack ccs_ident[1] \ + = {{ ccsID : 0, \ + cc : cc_ident, \ + prevStack : NULL, \ + indexTable : NULL, \ + selected : 0, \ + scc_count : 0, \ + time_ticks : 0, \ + mem_alloc : 0, \ + inherited_ticks : 0, \ + inherited_alloc : 0, \ + root : 0, \ + }}; + +/* ----------------------------------------------------------------------------- + * Time / Allocation Macros + * ---------------------------------------------------------------------------*/ + +/* eliminate profiling overhead from allocation costs */ +#define CCS_ALLOC(ccs, size) (ccs)->mem_alloc += ((size)-sizeofW(StgProfHeader)) + +#else /* !PROFILING */ + +#define CCS_ALLOC(ccs, amount) doNothing() + +#endif /* PROFILING */ + +#endif /* RTS_PROF_CCS_H */ + diff --git a/includes/rts/prof/LDV.h b/includes/rts/prof/LDV.h new file mode 100644 index 0000000000..c51b10647e --- /dev/null +++ b/includes/rts/prof/LDV.h @@ -0,0 +1,46 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow, 2004 + * + * Lag/Drag/Void profiling. + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_PROF_LDV_H +#define RTS_PROF_LDV_H + +#ifdef PROFILING + +/* retrieves the LDV word from closure c */ +#define LDVW(c) (((StgClosure *)(c))->header.prof.hp.ldvw) + +/* + * Stores the creation time for closure c. + * This macro is called at the very moment of closure creation. + * + * NOTE: this initializes LDVW(c) to zero, which ensures that there + * is no conflict between retainer profiling and LDV profiling, + * because retainer profiling also expects LDVW(c) to be initialised + * to zero. + */ +#ifndef CMINUSMINUS +#define LDV_RECORD_CREATE(c) \ + LDVW((c)) = ((StgWord)RTS_DEREF(era) << LDV_SHIFT) | LDV_STATE_CREATE +#endif + +#ifdef CMINUSMINUS +#define LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(c) \ + foreign "C" LDV_recordDead_FILL_SLOP_DYNAMIC(c "ptr") +#else +#define LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(c) \ + LDV_recordDead_FILL_SLOP_DYNAMIC(c) +#endif + +#else /* !PROFILING */ + +#define LDV_RECORD_CREATE(c) /* nothing */ +#define LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(c) /* nothing */ + +#endif /* PROFILING */ + +#endif /* STGLDVPROF_H */ diff --git a/includes/rts/storage/Block.h b/includes/rts/storage/Block.h new file mode 100644 index 0000000000..849f99f430 --- /dev/null +++ b/includes/rts/storage/Block.h @@ -0,0 +1,271 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-1999 + * + * Block structure for the storage manager + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_STORAGE_BLOCK_H +#define RTS_STORAGE_BLOCK_H + +/* The actual block and megablock-size constants are defined in + * includes/Constants.h, all constants here are derived from these. + */ + +/* Block related constants (BLOCK_SHIFT is defined in Constants.h) */ + +#define BLOCK_SIZE (1<<BLOCK_SHIFT) +#define BLOCK_SIZE_W (BLOCK_SIZE/sizeof(W_)) +#define BLOCK_MASK (BLOCK_SIZE-1) + +#define BLOCK_ROUND_UP(p) ((void *) (((W_)(p)+BLOCK_SIZE-1) & ~BLOCK_MASK)) +#define BLOCK_ROUND_DOWN(p) ((void *) ((W_)(p) & ~BLOCK_MASK)) + +/* Megablock related constants (MBLOCK_SHIFT is defined in Constants.h) */ + +#define MBLOCK_SIZE (1<<MBLOCK_SHIFT) +#define MBLOCK_SIZE_W (MBLOCK_SIZE/sizeof(W_)) +#define MBLOCK_MASK (MBLOCK_SIZE-1) + +#define MBLOCK_ROUND_UP(p) ((void *)(((W_)(p)+MBLOCK_SIZE-1) & ~MBLOCK_MASK)) +#define MBLOCK_ROUND_DOWN(p) ((void *)((W_)(p) & ~MBLOCK_MASK )) + +/* The largest size an object can be before we give it a block of its + * own and treat it as an immovable object during GC, expressed as a + * fraction of BLOCK_SIZE. + */ +#define LARGE_OBJECT_THRESHOLD ((nat)(BLOCK_SIZE * 8 / 10)) + +/* ----------------------------------------------------------------------------- + * Block descriptor. This structure *must* be the right length, so we + * can do pointer arithmetic on pointers to it. + */ + +/* The block descriptor is 64 bytes on a 64-bit machine, and 32-bytes + * on a 32-bit machine. + */ + +#ifndef CMINUSMINUS +typedef struct bdescr_ { + StgPtr start; /* start addr of memory */ + StgPtr free; /* first free byte of memory */ + struct bdescr_ *link; /* used for chaining blocks together */ + union { + struct bdescr_ *back; /* used (occasionally) for doubly-linked lists*/ + StgWord *bitmap; + StgPtr scan; /* scan pointer for copying GC */ + } u; + unsigned int gen_no; /* generation */ + struct step_ *step; /* step */ + StgWord32 blocks; /* no. of blocks (if grp head, 0 otherwise) */ + StgWord32 flags; /* block is in to-space */ +#if SIZEOF_VOID_P == 8 + StgWord32 _padding[2]; +#else + StgWord32 _padding[0]; +#endif +} bdescr; +#endif + +#if SIZEOF_VOID_P == 8 +#define BDESCR_SIZE 0x40 +#define BDESCR_MASK 0x3f +#define BDESCR_SHIFT 6 +#else +#define BDESCR_SIZE 0x20 +#define BDESCR_MASK 0x1f +#define BDESCR_SHIFT 5 +#endif + +/* Block contains objects evacuated during this GC */ +#define BF_EVACUATED 1 +/* Block is a large object */ +#define BF_LARGE 2 +/* Block is pinned */ +#define BF_PINNED 4 +/* Block is to be marked, not copied */ +#define BF_MARKED 8 +/* Block is free, and on the free list (TODO: is this used?) */ +#define BF_FREE 16 +/* Block is executable */ +#define BF_EXEC 32 +/* Block contains only a small amount of live data */ +#define BF_FRAGMENTED 64 +/* we know about this block (for finding leaks) */ +#define BF_KNOWN 128 + +/* Finding the block descriptor for a given block -------------------------- */ + +#ifdef CMINUSMINUS + +#define Bdescr(p) \ + ((((p) & MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) \ + | ((p) & ~MBLOCK_MASK)) + +#else + +INLINE_HEADER bdescr *Bdescr(StgPtr p) +{ + return (bdescr *) + ((((W_)p & MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) + | ((W_)p & ~MBLOCK_MASK) + ); +} + +#endif + +/* Useful Macros ------------------------------------------------------------ */ + +/* Offset of first real data block in a megablock */ + +#define FIRST_BLOCK_OFF \ + ((W_)BLOCK_ROUND_UP(BDESCR_SIZE * (MBLOCK_SIZE / BLOCK_SIZE))) + +/* First data block in a given megablock */ + +#define FIRST_BLOCK(m) ((void *)(FIRST_BLOCK_OFF + (W_)(m))) + +/* Last data block in a given megablock */ + +#define LAST_BLOCK(m) ((void *)(MBLOCK_SIZE-BLOCK_SIZE + (W_)(m))) + +/* First real block descriptor in a megablock */ + +#define FIRST_BDESCR(m) \ + ((bdescr *)((FIRST_BLOCK_OFF>>(BLOCK_SHIFT-BDESCR_SHIFT)) + (W_)(m))) + +/* Last real block descriptor in a megablock */ + +#define LAST_BDESCR(m) \ + ((bdescr *)(((MBLOCK_SIZE-BLOCK_SIZE)>>(BLOCK_SHIFT-BDESCR_SHIFT)) + (W_)(m))) + +/* Number of usable blocks in a megablock */ + +#define BLOCKS_PER_MBLOCK ((MBLOCK_SIZE - FIRST_BLOCK_OFF) / BLOCK_SIZE) + +/* How many blocks in this megablock group */ + +#define MBLOCK_GROUP_BLOCKS(n) \ + (BLOCKS_PER_MBLOCK + (n-1) * (MBLOCK_SIZE / BLOCK_SIZE)) + +/* Compute the required size of a megablock group */ + +#define BLOCKS_TO_MBLOCKS(n) \ + (1 + (W_)MBLOCK_ROUND_UP((n-BLOCKS_PER_MBLOCK) * BLOCK_SIZE) / MBLOCK_SIZE) + + +#ifndef CMINUSMINUS +/* to the end... */ + +/* Double-linked block lists: --------------------------------------------- */ + +INLINE_HEADER void +dbl_link_onto(bdescr *bd, bdescr **list) +{ + bd->link = *list; + bd->u.back = NULL; + if (*list) { + (*list)->u.back = bd; /* double-link the list */ + } + *list = bd; +} + +INLINE_HEADER void +dbl_link_remove(bdescr *bd, bdescr **list) +{ + if (bd->u.back) { + bd->u.back->link = bd->link; + } else { + *list = bd->link; + } + if (bd->link) { + bd->link->u.back = bd->u.back; + } +} + +INLINE_HEADER void +dbl_link_insert_after(bdescr *bd, bdescr *after) +{ + bd->link = after->link; + bd->u.back = after; + if (after->link) { + after->link->u.back = bd; + } + after->link = bd; +} + +INLINE_HEADER void +dbl_link_replace(bdescr *new, bdescr *old, bdescr **list) +{ + new->link = old->link; + new->u.back = old->u.back; + if (old->link) { + old->link->u.back = new; + } + if (old->u.back) { + old->u.back->link = new; + } else { + *list = new; + } +} + +/* Initialisation ---------------------------------------------------------- */ + +extern void initBlockAllocator(void); + +/* Allocation -------------------------------------------------------------- */ + +bdescr *allocGroup(nat n); +bdescr *allocBlock(void); + +// versions that take the storage manager lock for you: +bdescr *allocGroup_lock(nat n); +bdescr *allocBlock_lock(void); + +/* De-Allocation ----------------------------------------------------------- */ + +void freeGroup(bdescr *p); +void freeChain(bdescr *p); + +// versions that take the storage manager lock for you: +void freeGroup_lock(bdescr *p); +void freeChain_lock(bdescr *p); + +bdescr * splitBlockGroup (bdescr *bd, nat blocks); + +/* Round a value to megablocks --------------------------------------------- */ + +// We want to allocate an object around a given size, round it up or +// down to the nearest size that will fit in an mblock group. +INLINE_HEADER StgWord +round_to_mblocks(StgWord words) +{ + if (words > BLOCKS_PER_MBLOCK * BLOCK_SIZE_W) { + // first, ignore the gap at the beginning of the first mblock by + // adding it to the total words. Then we can pretend we're + // dealing in a uniform unit of megablocks. + words += FIRST_BLOCK_OFF/sizeof(W_); + + if ((words % MBLOCK_SIZE_W) < (MBLOCK_SIZE_W / 2)) { + words = (words / MBLOCK_SIZE_W) * MBLOCK_SIZE_W; + } else { + words = ((words / MBLOCK_SIZE_W) + 1) * MBLOCK_SIZE_W; + } + + words -= FIRST_BLOCK_OFF/sizeof(W_); + } + return words; +} + +INLINE_HEADER StgWord +round_up_to_mblocks(StgWord words) +{ + words += FIRST_BLOCK_OFF/sizeof(W_); + words = ((words / MBLOCK_SIZE_W) + 1) * MBLOCK_SIZE_W; + words -= FIRST_BLOCK_OFF/sizeof(W_); + return words; +} + +#endif /* !CMINUSMINUS */ +#endif /* RTS_STORAGE_BLOCK_H */ diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h new file mode 100644 index 0000000000..458960f3f7 --- /dev/null +++ b/includes/rts/storage/ClosureMacros.h @@ -0,0 +1,395 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Macros for building and manipulating closures + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_STORAGE_CLOSUREMACROS_H +#define RTS_STORAGE_CLOSUREMACROS_H + +/* ----------------------------------------------------------------------------- + Info tables are slammed up against the entry code, and the label + for the info table is at the *end* of the table itself. This + inline function adjusts an info pointer to point to the beginning + of the table, so we can use standard C structure indexing on it. + + Note: this works for SRT info tables as long as you don't want to + access the SRT, since they are laid out the same with the SRT + pointer as the first word in the table. + + NOTES ABOUT MANGLED C VS. MINI-INTERPRETER: + + A couple of definitions: + + "info pointer" The first word of the closure. Might point + to either the end or the beginning of the + info table, depending on whether we're using + the mini interpretter or not. GET_INFO(c) + retrieves the info pointer of a closure. + + "info table" The info table structure associated with a + closure. This is always a pointer to the + beginning of the structure, so we can + use standard C structure indexing to pull out + the fields. get_itbl(c) returns a pointer to + the info table for closure c. + + An address of the form xxxx_info points to the end of the info + table or the beginning of the info table depending on whether we're + mangling or not respectively. So, + + c->header.info = xxx_info + + makes absolute sense, whether mangling or not. + + -------------------------------------------------------------------------- */ + +#define SET_INFO(c,i) ((c)->header.info = (i)) +#define GET_INFO(c) ((c)->header.info) +#define GET_ENTRY(c) (ENTRY_CODE(GET_INFO(c))) + +#define get_itbl(c) (INFO_PTR_TO_STRUCT((c)->header.info)) +#define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info)) +#define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info)) +#define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info)) +#define get_con_itbl(c) (CON_INFO_PTR_TO_STRUCT((c)->header.info)) + +#define GET_TAG(con) (get_itbl(con)->srt_bitmap) + +#ifdef TABLES_NEXT_TO_CODE +#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1) +#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1) +#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1) +#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1) +#define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)(info) - 1) +#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1) +#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1) +#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1) +#define itbl_to_con_itbl(i) ((StgConInfoTable *)(((StgInfoTable *)(i) + 1)) - 1) +#else +#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info) +#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info) +#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info) +#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info) +#define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)info) +#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i)) +#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i)) +#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i)) +#define itbl_to_con_itbl(i) ((StgConInfoTable *)(i)) +#endif + +/* ----------------------------------------------------------------------------- + Macros for building closures + -------------------------------------------------------------------------- */ + +#ifdef PROFILING +#ifdef DEBUG_RETAINER +/* + For the sake of debugging, we take the safest way for the moment. Actually, this + is useful to check the sanity of heap before beginning retainer profiling. + flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h. + Note: change those functions building Haskell objects from C datatypes, i.e., + all rts_mk???() functions in RtsAPI.c, as well. + */ +#define SET_PROF_HDR(c,ccs_) \ + ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip)) +#else +/* + For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to + NULL | flip (flip is defined in RetainerProfile.c) because even when flip + is 1, rs is invalid and will be initialized to NULL | flip later when + the closure *c is visited. + */ +/* +#define SET_PROF_HDR(c,ccs_) \ + ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL) + */ +/* + The following macro works for both retainer profiling and LDV profiling: + for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0. + See the invariants on ldvTime. + */ +#define SET_PROF_HDR(c,ccs_) \ + ((c)->header.prof.ccs = ccs_, \ + LDV_RECORD_CREATE((c))) +#endif /* DEBUG_RETAINER */ +#else +#define SET_PROF_HDR(c,ccs) +#endif + +#define SET_HDR(c,_info,ccs) \ + { \ + (c)->header.info = _info; \ + SET_PROF_HDR((StgClosure *)(c),ccs); \ + } + +#define SET_ARR_HDR(c,info,costCentreStack,n_words) \ + SET_HDR(c,info,costCentreStack); \ + (c)->words = n_words; + +/* ----------------------------------------------------------------------------- + How to get hold of the static link field for a static closure. + -------------------------------------------------------------------------- */ + +/* These are hard-coded. */ +#define FUN_STATIC_LINK(p) (&(p)->payload[0]) +#define THUNK_STATIC_LINK(p) (&(p)->payload[1]) +#define IND_STATIC_LINK(p) (&(p)->payload[1]) + +INLINE_HEADER StgClosure ** +STATIC_LINK(const StgInfoTable *info, StgClosure *p) +{ + switch (info->type) { + case THUNK_STATIC: + return THUNK_STATIC_LINK(p); + case FUN_STATIC: + return FUN_STATIC_LINK(p); + case IND_STATIC: + return IND_STATIC_LINK(p); + default: + return &(p)->payload[info->layout.payload.ptrs + + info->layout.payload.nptrs]; + } +} + +#define STATIC_LINK2(info,p) \ + (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs + \ + info->layout.payload.nptrs + 1]))) + +/* ----------------------------------------------------------------------------- + INTLIKE and CHARLIKE closures. + -------------------------------------------------------------------------- */ + +#define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE]) +#define INTLIKE_CLOSURE(n) ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE]) + +/* ---------------------------------------------------------------------------- + Macros for untagging and retagging closure pointers + For more information look at the comments in Cmm.h + ------------------------------------------------------------------------- */ + +static inline StgWord +GET_CLOSURE_TAG(StgClosure * p) +{ + return (StgWord)p & TAG_MASK; +} + +static inline StgClosure * +UNTAG_CLOSURE(StgClosure * p) +{ + return (StgClosure*)((StgWord)p & ~TAG_MASK); +} + +static inline StgClosure * +TAG_CLOSURE(StgWord tag,StgClosure * p) +{ + return (StgClosure*)((StgWord)p | tag); +} + +/* ----------------------------------------------------------------------------- + Forwarding pointers + -------------------------------------------------------------------------- */ + +#define IS_FORWARDING_PTR(p) ((((StgWord)p) & 1) != 0) +#define MK_FORWARDING_PTR(p) (((StgWord)p) | 1) +#define UN_FORWARDING_PTR(p) (((StgWord)p) - 1) + +/* ----------------------------------------------------------------------------- + DEBUGGING predicates for pointers + + LOOKS_LIKE_INFO_PTR(p) returns False if p is definitely not an info ptr + LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr + + These macros are complete but not sound. That is, they might + return false positives. Do not rely on them to distinguish info + pointers from closure pointers, for example. + + We don't use address-space predicates these days, for portability + reasons, and the fact that code/data can be scattered about the + address space in a dynamically-linked environment. Our best option + is to look at the alleged info table and see whether it seems to + make sense... + -------------------------------------------------------------------------- */ + +INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p) +{ + StgInfoTable *info = INFO_PTR_TO_STRUCT(p); + return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES; +} + +INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR (StgWord p) +{ + return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p)); +} + +INLINE_HEADER rtsBool LOOKS_LIKE_CLOSURE_PTR (void *p) +{ + return LOOKS_LIKE_INFO_PTR((StgWord)(UNTAG_CLOSURE((StgClosure *)(p)))->header.info); +} + +/* ----------------------------------------------------------------------------- + Macros for calculating the size of a closure + -------------------------------------------------------------------------- */ + +INLINE_HEADER StgOffset PAP_sizeW ( nat n_args ) +{ return sizeofW(StgPAP) + n_args; } + +INLINE_HEADER StgOffset AP_sizeW ( nat n_args ) +{ return sizeofW(StgAP) + n_args; } + +INLINE_HEADER StgOffset AP_STACK_sizeW ( nat size ) +{ return sizeofW(StgAP_STACK) + size; } + +INLINE_HEADER StgOffset CONSTR_sizeW( nat p, nat np ) +{ return sizeofW(StgHeader) + p + np; } + +INLINE_HEADER StgOffset THUNK_SELECTOR_sizeW ( void ) +{ return sizeofW(StgSelector); } + +INLINE_HEADER StgOffset BLACKHOLE_sizeW ( void ) +{ return sizeofW(StgHeader)+MIN_PAYLOAD_SIZE; } + +/* -------------------------------------------------------------------------- + Sizes of closures + ------------------------------------------------------------------------*/ + +INLINE_HEADER StgOffset sizeW_fromITBL( const StgInfoTable* itbl ) +{ return sizeofW(StgClosure) + + sizeofW(StgPtr) * itbl->layout.payload.ptrs + + sizeofW(StgWord) * itbl->layout.payload.nptrs; } + +INLINE_HEADER StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl ) +{ return sizeofW(StgThunk) + + sizeofW(StgPtr) * itbl->layout.payload.ptrs + + sizeofW(StgWord) * itbl->layout.payload.nptrs; } + +INLINE_HEADER StgOffset ap_stack_sizeW( StgAP_STACK* x ) +{ return AP_STACK_sizeW(x->size); } + +INLINE_HEADER StgOffset ap_sizeW( StgAP* x ) +{ return AP_sizeW(x->n_args); } + +INLINE_HEADER StgOffset pap_sizeW( StgPAP* x ) +{ return PAP_sizeW(x->n_args); } + +INLINE_HEADER StgOffset arr_words_sizeW( StgArrWords* x ) +{ return sizeofW(StgArrWords) + x->words; } + +INLINE_HEADER StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x ) +{ return sizeofW(StgMutArrPtrs) + x->ptrs; } + +INLINE_HEADER StgWord tso_sizeW ( StgTSO *tso ) +{ return TSO_STRUCT_SIZEW + tso->stack_size; } + +INLINE_HEADER StgWord bco_sizeW ( StgBCO *bco ) +{ return bco->size; } + +INLINE_HEADER nat +closure_sizeW_ (StgClosure *p, StgInfoTable *info) +{ + switch (info->type) { + case THUNK_0_1: + case THUNK_1_0: + return sizeofW(StgThunk) + 1; + case FUN_0_1: + case CONSTR_0_1: + case FUN_1_0: + case CONSTR_1_0: + return sizeofW(StgHeader) + 1; + case THUNK_0_2: + case THUNK_1_1: + case THUNK_2_0: + return sizeofW(StgThunk) + 2; + case FUN_0_2: + case CONSTR_0_2: + case FUN_1_1: + case CONSTR_1_1: + case FUN_2_0: + case CONSTR_2_0: + return sizeofW(StgHeader) + 2; + case THUNK: + return thunk_sizeW_fromITBL(info); + case THUNK_SELECTOR: + return THUNK_SELECTOR_sizeW(); + case AP_STACK: + return ap_stack_sizeW((StgAP_STACK *)p); + case AP: + return ap_sizeW((StgAP *)p); + case PAP: + return pap_sizeW((StgPAP *)p); + case IND: + case IND_PERM: + case IND_OLDGEN: + case IND_OLDGEN_PERM: + return sizeofW(StgInd); + case ARR_WORDS: + return arr_words_sizeW((StgArrWords *)p); + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: + case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: + return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); + case TSO: + return tso_sizeW((StgTSO *)p); + case BCO: + return bco_sizeW((StgBCO *)p); + case TVAR_WATCH_QUEUE: + return sizeofW(StgTVarWatchQueue); + case TVAR: + return sizeofW(StgTVar); + case TREC_CHUNK: + return sizeofW(StgTRecChunk); + case TREC_HEADER: + return sizeofW(StgTRecHeader); + case ATOMIC_INVARIANT: + return sizeofW(StgAtomicInvariant); + case INVARIANT_CHECK_QUEUE: + return sizeofW(StgInvariantCheckQueue); + default: + return sizeW_fromITBL(info); + } +} + +// The definitive way to find the size, in words, of a heap-allocated closure +INLINE_HEADER nat +closure_sizeW (StgClosure *p) +{ + return closure_sizeW_(p, get_itbl(p)); +} + +/* ----------------------------------------------------------------------------- + Sizes of stack frames + -------------------------------------------------------------------------- */ + +INLINE_HEADER StgWord stack_frame_sizeW( StgClosure *frame ) +{ + StgRetInfoTable *info; + + info = get_ret_itbl(frame); + switch (info->i.type) { + + case RET_DYN: + { + StgRetDyn *dyn = (StgRetDyn *)frame; + return sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE + + RET_DYN_NONPTR_REGS_SIZE + + RET_DYN_PTRS(dyn->liveness) + RET_DYN_NONPTRS(dyn->liveness); + } + + case RET_FUN: + return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size; + + case RET_BIG: + return 1 + GET_LARGE_BITMAP(&info->i)->size; + + case RET_BCO: + return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]); + + default: + return 1 + BITMAP_SIZE(info->i.layout.bitmap); + } +} + +#endif /* RTS_STORAGE_CLOSUREMACROS_H */ diff --git a/includes/rts/storage/ClosureTypes.h b/includes/rts/storage/ClosureTypes.h new file mode 100644 index 0000000000..3415d423a3 --- /dev/null +++ b/includes/rts/storage/ClosureTypes.h @@ -0,0 +1,96 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2005 + * + * Closure Type Constants: out here because the native code generator + * needs to get at them. + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_STORAGE_CLOSURETYPES_H +#define RTS_STORAGE_CLOSURETYPES_H + +/* + * WARNING WARNING WARNING + * + * Keep the closure tags contiguous: rts/ClosureFlags.c relies on + * this. + * + * If you add or delete any closure types, don't forget to update + * the closure flags table in rts/ClosureFlags.c. + */ + +/* Object tag 0 raises an internal error */ +#define INVALID_OBJECT 0 +#define CONSTR 1 +#define CONSTR_1_0 2 +#define CONSTR_0_1 3 +#define CONSTR_2_0 4 +#define CONSTR_1_1 5 +#define CONSTR_0_2 6 +#define CONSTR_STATIC 7 +#define CONSTR_NOCAF_STATIC 8 +#define FUN 9 +#define FUN_1_0 10 +#define FUN_0_1 11 +#define FUN_2_0 12 +#define FUN_1_1 13 +#define FUN_0_2 14 +#define FUN_STATIC 15 +#define THUNK 16 +#define THUNK_1_0 17 +#define THUNK_0_1 18 +#define THUNK_2_0 19 +#define THUNK_1_1 20 +#define THUNK_0_2 21 +#define THUNK_STATIC 22 +#define THUNK_SELECTOR 23 +#define BCO 24 +#define AP 25 +#define PAP 26 +#define AP_STACK 27 +#define IND 28 +#define IND_OLDGEN 29 +#define IND_PERM 30 +#define IND_OLDGEN_PERM 31 +#define IND_STATIC 32 +#define RET_BCO 33 +#define RET_SMALL 34 +#define RET_BIG 35 +#define RET_DYN 36 +#define RET_FUN 37 +#define UPDATE_FRAME 38 +#define CATCH_FRAME 39 +#define STOP_FRAME 40 +#define CAF_BLACKHOLE 41 +#define BLACKHOLE 42 +#define MVAR_CLEAN 43 +#define MVAR_DIRTY 44 +#define ARR_WORDS 45 +#define MUT_ARR_PTRS_CLEAN 46 +#define MUT_ARR_PTRS_DIRTY 47 +#define MUT_ARR_PTRS_FROZEN0 48 +#define MUT_ARR_PTRS_FROZEN 49 +#define MUT_VAR_CLEAN 50 +#define MUT_VAR_DIRTY 51 +#define WEAK 52 +#define STABLE_NAME 53 +#define TSO 54 +#define BLOCKED_FETCH 55 +#define FETCH_ME 56 +#define FETCH_ME_BQ 57 +#define RBH 58 +#define REMOTE_REF 59 +#define TVAR_WATCH_QUEUE 60 +#define INVARIANT_CHECK_QUEUE 61 +#define ATOMIC_INVARIANT 62 +#define TVAR 63 +#define TREC_CHUNK 64 +#define TREC_HEADER 65 +#define ATOMICALLY_FRAME 66 +#define CATCH_RETRY_FRAME 67 +#define CATCH_STM_FRAME 68 +#define WHITEHOLE 69 +#define N_CLOSURE_TYPES 70 + +#endif /* RTS_STORAGE_CLOSURETYPES_H */ diff --git a/includes/rts/storage/Closures.h b/includes/rts/storage/Closures.h new file mode 100644 index 0000000000..6e06e57f3c --- /dev/null +++ b/includes/rts/storage/Closures.h @@ -0,0 +1,417 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Closures + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_STORAGE_CLOSURES_H +#define RTS_STORAGE_CLOSURES_H + +/* + * The Layout of a closure header depends on which kind of system we're + * compiling for: profiling, parallel, ticky, etc. + */ + +/* ----------------------------------------------------------------------------- + The profiling header + -------------------------------------------------------------------------- */ + +typedef struct { + CostCentreStack *ccs; + union { + struct _RetainerSet *rs; /* Retainer Set */ + StgWord ldvw; /* Lag/Drag/Void Word */ + } hp; +} StgProfHeader; + +/* ----------------------------------------------------------------------------- + The SMP header + + A thunk has a padding word to take the updated value. This is so + that the update doesn't overwrite the payload, so we can avoid + needing to lock the thunk during entry and update. + + Note: this doesn't apply to THUNK_STATICs, which have no payload. + + Note: we leave this padding word in all ways, rather than just SMP, + so that we don't have to recompile all our libraries for SMP. + -------------------------------------------------------------------------- */ + +typedef struct { + StgWord pad; +} StgSMPThunkHeader; + +/* ----------------------------------------------------------------------------- + The full fixed-size closure header + + The size of the fixed header is the sum of the optional parts plus a single + word for the entry code pointer. + -------------------------------------------------------------------------- */ + +typedef struct { + const StgInfoTable* info; +#ifdef PROFILING + StgProfHeader prof; +#endif +} StgHeader; + +typedef struct { + const StgInfoTable* info; +#ifdef PROFILING + StgProfHeader prof; +#endif + StgSMPThunkHeader smp; +} StgThunkHeader; + +#define THUNK_EXTRA_HEADER_W (sizeofW(StgThunkHeader)-sizeofW(StgHeader)) + +/* ----------------------------------------------------------------------------- + Closure Types + + For any given closure type (defined in InfoTables.h), there is a + corresponding structure defined below. The name of the structure + is obtained by concatenating the closure type with '_closure' + -------------------------------------------------------------------------- */ + +/* All closures follow the generic format */ + +typedef struct StgClosure_ { + StgHeader header; + struct StgClosure_ *payload[FLEXIBLE_ARRAY]; +} *StgClosurePtr; // StgClosure defined in Rts.h + +typedef struct { + StgThunkHeader header; + struct StgClosure_ *payload[FLEXIBLE_ARRAY]; +} StgThunk; + +typedef struct { + StgThunkHeader header; + StgClosure *selectee; +} StgSelector; + +typedef struct { + StgHeader header; + StgHalfWord arity; /* zero if it is an AP */ + StgHalfWord n_args; + StgClosure *fun; /* really points to a fun */ + StgClosure *payload[FLEXIBLE_ARRAY]; +} StgPAP; + +typedef struct { + StgThunkHeader header; + StgHalfWord arity; /* zero if it is an AP */ + StgHalfWord n_args; + StgClosure *fun; /* really points to a fun */ + StgClosure *payload[FLEXIBLE_ARRAY]; +} StgAP; + +typedef struct { + StgThunkHeader header; + StgWord size; /* number of words in payload */ + StgClosure *fun; + StgClosure *payload[FLEXIBLE_ARRAY]; /* contains a chunk of *stack* */ +} StgAP_STACK; + +typedef struct { + StgHeader header; + StgClosure *indirectee; +} StgInd; + +typedef struct { + StgHeader header; + StgClosure *indirectee; + StgClosure *static_link; + StgInfoTable *saved_info; +} StgIndStatic; + +typedef struct { + StgHeader header; + StgWord words; + StgWord payload[FLEXIBLE_ARRAY]; +} StgArrWords; + +typedef struct { + StgHeader header; + StgWord ptrs; + StgClosure *payload[FLEXIBLE_ARRAY]; +} StgMutArrPtrs; + +typedef struct { + StgHeader header; + StgClosure *var; +} StgMutVar; + +typedef struct _StgUpdateFrame { + StgHeader header; + StgClosure *updatee; +} StgUpdateFrame; + +typedef struct { + StgHeader header; + StgInt exceptions_blocked; + StgClosure *handler; +} StgCatchFrame; + +typedef struct { + StgHeader header; +} StgStopFrame; + +typedef struct { + StgHeader header; + StgWord data; +} StgIntCharlikeClosure; + +/* statically allocated */ +typedef struct { + StgHeader header; +} StgRetry; + +typedef struct _StgStableName { + StgHeader header; + StgWord sn; +} StgStableName; + +typedef struct _StgWeak { /* Weak v */ + StgHeader header; + StgClosure *cfinalizer; + StgClosure *key; + StgClosure *value; /* v */ + StgClosure *finalizer; + struct _StgWeak *link; +} StgWeak; + +typedef struct _StgDeadWeak { /* Weak v */ + StgHeader header; + struct _StgWeak *link; +} StgDeadWeak; + +/* Byte code objects. These are fixed size objects with pointers to + * four arrays, designed so that a BCO can be easily "re-linked" to + * other BCOs, to facilitate GHC's intelligent recompilation. The + * array of instructions is static and not re-generated when the BCO + * is re-linked, but the other 3 arrays will be regenerated. + * + * A BCO represents either a function or a stack frame. In each case, + * it needs a bitmap to describe to the garbage collector the + * pointerhood of its arguments/free variables respectively, and in + * the case of a function it also needs an arity. These are stored + * directly in the BCO, rather than in the instrs array, for two + * reasons: + * (a) speed: we need to get at the bitmap info quickly when + * the GC is examining APs and PAPs that point to this BCO + * (b) a subtle interaction with the compacting GC. In compacting + * GC, the info that describes the size/layout of a closure + * cannot be in an object more than one level of indirection + * away from the current object, because of the order in + * which pointers are updated to point to their new locations. + */ + +typedef struct { + StgHeader header; + StgArrWords *instrs; /* a pointer to an ArrWords */ + StgArrWords *literals; /* a pointer to an ArrWords */ + StgMutArrPtrs *ptrs; /* a pointer to a MutArrPtrs */ + StgHalfWord arity; /* arity of this BCO */ + StgHalfWord size; /* size of this BCO (in words) */ + StgWord bitmap[FLEXIBLE_ARRAY]; /* an StgLargeBitmap */ +} StgBCO; + +#define BCO_BITMAP(bco) ((StgLargeBitmap *)((StgBCO *)(bco))->bitmap) +#define BCO_BITMAP_SIZE(bco) (BCO_BITMAP(bco)->size) +#define BCO_BITMAP_BITS(bco) (BCO_BITMAP(bco)->bitmap) +#define BCO_BITMAP_SIZEW(bco) ((BCO_BITMAP_SIZE(bco) + BITS_IN(StgWord) - 1) \ + / BITS_IN(StgWord)) + +/* ----------------------------------------------------------------------------- + Dynamic stack frames for generic heap checks. + + These generic heap checks are slow, but have the advantage of being + usable in a variety of situations. + + The one restriction is that any relevant SRTs must already be pointed + to from the stack. The return address doesn't need to have an info + table attached: hence it can be any old code pointer. + + The liveness mask contains a 1 at bit n, if register Rn contains a + non-pointer. The contents of all 8 vanilla registers are always saved + on the stack; the liveness mask tells the GC which ones contain + pointers. + + Good places to use a generic heap check: + + - case alternatives (the return address with an SRT is already + on the stack). + + - primitives (no SRT required). + + The stack frame layout for a RET_DYN is like this: + + some pointers |-- RET_DYN_PTRS(liveness) words + some nonpointers |-- RET_DYN_NONPTRS(liveness) words + + L1 \ + D1-2 |-- RET_DYN_NONPTR_REGS_SIZE words + F1-4 / + + R1-8 |-- RET_DYN_BITMAP_SIZE words + + return address \ + liveness mask |-- StgRetDyn structure + stg_gen_chk_info / + + we assume that the size of a double is always 2 pointers (wasting a + word when it is only one pointer, but avoiding lots of #ifdefs). + + See Liveness.h for the macros (RET_DYN_PTRS() etc.). + + NOTE: if you change the layout of RET_DYN stack frames, then you + might also need to adjust the value of RESERVED_STACK_WORDS in + Constants.h. + -------------------------------------------------------------------------- */ + +typedef struct { + const StgInfoTable* info; + StgWord liveness; + StgWord ret_addr; + StgClosure * payload[FLEXIBLE_ARRAY]; +} StgRetDyn; + +/* A function return stack frame: used when saving the state for a + * garbage collection at a function entry point. The function + * arguments are on the stack, and we also save the function (its + * info table describes the pointerhood of the arguments). + * + * The stack frame size is also cached in the frame for convenience. + */ +typedef struct { + const StgInfoTable* info; + StgWord size; + StgClosure * fun; + StgClosure * payload[FLEXIBLE_ARRAY]; +} StgRetFun; + +/* Concurrent communication objects */ + +typedef struct { + StgHeader header; + struct StgTSO_ *head; + struct StgTSO_ *tail; + StgClosure* value; +} StgMVar; + + +/* STM data structures + * + * StgTVar defines the only type that can be updated through the STM + * interface. + * + * Note that various optimisations may be possible in order to use less + * space for these data structures at the cost of more complexity in the + * implementation: + * + * - In StgTVar, current_value and first_watch_queue_entry could be held in + * the same field: if any thread is waiting then its expected_value for + * the tvar is the current value. + * + * - In StgTRecHeader, it might be worthwhile having separate chunks + * of read-only and read-write locations. This would save a + * new_value field in the read-only locations. + * + * - In StgAtomicallyFrame, we could combine the waiting bit into + * the header (maybe a different info tbl for a waiting transaction). + * This means we can specialise the code for the atomically frame + * (it immediately switches on frame->waiting anyway). + */ + +typedef struct StgTRecHeader_ StgTRecHeader; + +typedef struct StgTVarWatchQueue_ { + StgHeader header; + StgClosure *closure; // StgTSO or StgAtomicInvariant + struct StgTVarWatchQueue_ *next_queue_entry; + struct StgTVarWatchQueue_ *prev_queue_entry; +} StgTVarWatchQueue; + +typedef struct { + StgHeader header; + StgClosure *volatile current_value; + StgTVarWatchQueue *volatile first_watch_queue_entry; +#if defined(THREADED_RTS) + StgInt volatile num_updates; +#endif +} StgTVar; + +typedef struct { + StgHeader header; + StgClosure *code; + StgTRecHeader *last_execution; + StgWord lock; +} StgAtomicInvariant; + +/* new_value == expected_value for read-only accesses */ +/* new_value is a StgTVarWatchQueue entry when trec in state TREC_WAITING */ +typedef struct { + StgTVar *tvar; + StgClosure *expected_value; + StgClosure *new_value; +#if defined(THREADED_RTS) + StgInt num_updates; +#endif +} TRecEntry; + +#define TREC_CHUNK_NUM_ENTRIES 16 + +typedef struct StgTRecChunk_ { + StgHeader header; + struct StgTRecChunk_ *prev_chunk; + StgWord next_entry_idx; + TRecEntry entries[TREC_CHUNK_NUM_ENTRIES]; +} StgTRecChunk; + +typedef enum { + TREC_ACTIVE, /* Transaction in progress, outcome undecided */ + TREC_CONDEMNED, /* Transaction in progress, inconsistent / out of date reads */ + TREC_COMMITTED, /* Transaction has committed, now updating tvars */ + TREC_ABORTED, /* Transaction has aborted, now reverting tvars */ + TREC_WAITING, /* Transaction currently waiting */ +} TRecState; + +typedef struct StgInvariantCheckQueue_ { + StgHeader header; + StgAtomicInvariant *invariant; + StgTRecHeader *my_execution; + struct StgInvariantCheckQueue_ *next_queue_entry; +} StgInvariantCheckQueue; + +struct StgTRecHeader_ { + StgHeader header; + TRecState state; + struct StgTRecHeader_ *enclosing_trec; + StgTRecChunk *current_chunk; + StgInvariantCheckQueue *invariants_to_check; +}; + +typedef struct { + StgHeader header; + StgClosure *code; + StgTVarWatchQueue *next_invariant_to_check; + StgClosure *result; +} StgAtomicallyFrame; + +typedef struct { + StgHeader header; + StgClosure *code; + StgClosure *handler; +} StgCatchSTMFrame; + +typedef struct { + StgHeader header; + StgBool running_alt_code; + StgClosure *first_code; + StgClosure *alt_code; +} StgCatchRetryFrame; + +#endif /* RTS_STORAGE_CLOSURES_H */ diff --git a/includes/rts/storage/FunTypes.h b/includes/rts/storage/FunTypes.h new file mode 100644 index 0000000000..402c913bcd --- /dev/null +++ b/includes/rts/storage/FunTypes.h @@ -0,0 +1,54 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2002 + * + * Things for functions. + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_STORAGE_FUNTYPES_H +#define RTS_STORAGE_FUNTYPES_ + +/* generic - function comes with a small bitmap */ +#define ARG_GEN 0 + +/* generic - function comes with a large bitmap */ +#define ARG_GEN_BIG 1 + +/* BCO - function is really a BCO */ +#define ARG_BCO 2 + +/* + * Specialised function types: bitmaps and calling sequences + * for these functions are pre-generated: see ghc/utils/genapply and + * generated code in ghc/rts/AutoApply.cmm. + * + * NOTE: other places to change if you change this table: + * - utils/genapply/GenApply.hs: stackApplyTypes + * - compiler/codeGen/CgCallConv.lhs: stdPattern + */ +#define ARG_NONE 3 +#define ARG_N 4 +#define ARG_P 5 +#define ARG_F 6 +#define ARG_D 7 +#define ARG_L 8 +#define ARG_NN 9 +#define ARG_NP 10 +#define ARG_PN 11 +#define ARG_PP 12 +#define ARG_NNN 13 +#define ARG_NNP 14 +#define ARG_NPN 15 +#define ARG_NPP 16 +#define ARG_PNN 17 +#define ARG_PNP 18 +#define ARG_PPN 19 +#define ARG_PPP 20 +#define ARG_PPPP 21 +#define ARG_PPPPP 22 +#define ARG_PPPPPP 23 +#define ARG_PPPPPPP 24 +#define ARG_PPPPPPPP 25 + +#endif /* RTS_STORAGE_FUNTYPES_H */ diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h new file mode 100644 index 0000000000..df4ba9d153 --- /dev/null +++ b/includes/rts/storage/GC.h @@ -0,0 +1,204 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * External Storage Manger Interface + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_STORAGE_GC_H +#define RTS_STORAGE_GC_H + +#include <stddef.h> +#include "rts/OSThreads.h" + +/* ----------------------------------------------------------------------------- + * Generational GC + * + * We support an arbitrary number of generations, with an arbitrary number + * of steps per generation. Notes (in no particular order): + * + * - all generations except the oldest should have the same + * number of steps. Multiple steps gives objects a decent + * chance to age before being promoted, and helps ensure that + * we don't end up with too many thunks being updated in older + * generations. + * + * - the oldest generation has one step. There's no point in aging + * objects in the oldest generation. + * + * - generation 0, step 0 (G0S0) is the allocation area. It is given + * a fixed set of blocks during initialisation, and these blocks + * normally stay in G0S0. In parallel execution, each + * Capability has its own nursery. + * + * - during garbage collection, each step which is an evacuation + * destination (i.e. all steps except G0S0) is allocated a to-space. + * evacuated objects are allocated into the step's to-space until + * GC is finished, when the original step's contents may be freed + * and replaced by the to-space. + * + * - the mutable-list is per-generation (not per-step). G0 doesn't + * have one (since every garbage collection collects at least G0). + * + * - block descriptors contain pointers to both the step and the + * generation that the block belongs to, for convenience. + * + * - static objects are stored in per-generation lists. See GC.c for + * details of how we collect CAFs in the generational scheme. + * + * - large objects are per-step, and are promoted in the same way + * as small objects, except that we may allocate large objects into + * generation 1 initially. + * + * ------------------------------------------------------------------------- */ + +typedef struct step_ { + unsigned int no; // step number in this generation + unsigned int abs_no; // absolute step number + + struct generation_ * gen; // generation this step belongs to + unsigned int gen_no; // generation number (cached) + + bdescr * blocks; // blocks in this step + unsigned int n_blocks; // number of blocks + unsigned int n_words; // number of words + + struct step_ * to; // destination step for live objects + + bdescr * large_objects; // large objects (doubly linked) + unsigned int n_large_blocks; // no. of blocks used by large objs + + StgTSO * threads; // threads in this step + // linked via global_link + + // ------------------------------------ + // Fields below are used during GC only + + // During GC, if we are collecting this step, blocks and n_blocks + // are copied into the following two fields. After GC, these blocks + // are freed. + +#if defined(THREADED_RTS) + char pad[128]; // make sure the following is + // on a separate cache line. + SpinLock sync_large_objects; // lock for large_objects + // and scavenged_large_objects +#endif + + int mark; // mark (not copy)? (old gen only) + int compact; // compact (not sweep)? (old gen only) + + bdescr * old_blocks; // bdescr of first from-space block + unsigned int n_old_blocks; // number of blocks in from-space + unsigned int live_estimate; // for sweeping: estimate of live data + + bdescr * part_blocks; // partially-full scanned blocks + unsigned int n_part_blocks; // count of above + + bdescr * scavenged_large_objects; // live large objs after GC (d-link) + unsigned int n_scavenged_large_blocks; // size (not count) of above + + bdescr * bitmap; // bitmap for compacting collection + + StgTSO * old_threads; + +} step; + + +typedef struct generation_ { + unsigned int no; // generation number + step * steps; // steps + unsigned int n_steps; // number of steps + unsigned int max_blocks; // max blocks in step 0 + bdescr *mut_list; // mut objects in this gen (not G0) + + // stats information + unsigned int collections; + unsigned int par_collections; + unsigned int failed_promotions; + + // temporary use during GC: + bdescr *saved_mut_list; +} generation; + +extern generation * generations; + +extern generation * g0; +extern step * g0s0; +extern generation * oldest_gen; +extern step * all_steps; +extern nat total_steps; + +/* ----------------------------------------------------------------------------- + Generic allocation + + StgPtr allocateInGen(generation *g, nat n) + Allocates a chunk of contiguous store + n words long in generation g, + returning a pointer to the first word. + Always succeeds. + + StgPtr allocate(nat n) Equaivalent to allocateInGen(g0) + + StgPtr allocateLocal(Capability *cap, nat n) + Allocates memory from the nursery in + the current Capability. This can be + done without taking a global lock, + unlike allocate(). + + StgPtr allocatePinned(nat n) Allocates a chunk of contiguous store + n words long, which is at a fixed + address (won't be moved by GC). + Returns a pointer to the first word. + Always succeeds. + + NOTE: the GC can't in general handle + pinned objects, so allocatePinned() + can only be used for ByteArrays at the + moment. + + Don't forget to TICK_ALLOC_XXX(...) + after calling allocate or + allocatePinned, for the + benefit of the ticky-ticky profiler. + + rtsBool doYouWantToGC(void) Returns True if the storage manager is + ready to perform a GC, False otherwise. + + lnat allocatedBytes(void) Returns the number of bytes allocated + via allocate() since the last GC. + Used in the reporting of statistics. + + -------------------------------------------------------------------------- */ + +StgPtr allocate ( lnat n ); +StgPtr allocateInGen ( generation *g, lnat n ); +StgPtr allocateLocal ( Capability *cap, lnat n ); +StgPtr allocatePinned ( lnat n ); +lnat allocatedBytes ( void ); + +/* memory allocator for executable memory */ +void * allocateExec(unsigned int len, void **exec_addr); +void freeExec (void *p); + +/* ----------------------------------------------------------------------------- + Performing Garbage Collection + -------------------------------------------------------------------------- */ + +void performGC(void); +void performMajorGC(void); + +/* ----------------------------------------------------------------------------- + The CAF table - used to let us revert CAFs in GHCi + -------------------------------------------------------------------------- */ + +void newCAF (StgClosure*); +void newDynCAF (StgClosure *); +void revertCAFs (void); + +/* set to disable CAF garbage collection in GHCi. */ +/* (needed when dynamic libraries are used). */ +extern rtsBool keepCAFs; + +#endif /* RTS_STORAGE_GC_H */ diff --git a/includes/rts/storage/InfoTables.h b/includes/rts/storage/InfoTables.h new file mode 100644 index 0000000000..4596ce2d75 --- /dev/null +++ b/includes/rts/storage/InfoTables.h @@ -0,0 +1,410 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2002 + * + * Info Tables + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_STORAGE_INFOTABLES_H +#define RTS_STORAGE_INFOTABLES_H + +/* ---------------------------------------------------------------------------- + Relative pointers + + Several pointer fields in info tables are expressed as offsets + relative to the info pointer, so that we can generate + position-independent code. + + Note [x86-64-relative] + There is a complication on the x86_64 platform, where pointeres are + 64 bits, but the tools don't support 64-bit relative relocations. + However, the default memory model (small) ensures that all symbols + have values in the lower 2Gb of the address space, so offsets all + fit in 32 bits. Hence we can use 32-bit offset fields. + + When going via-C, the mangler arranges that we only generate + relative relocations between symbols in the same segment (the text + segment). The NCG, however, puts things in the right sections and + uses 32-bit relative offsets instead. + + Somewhere between binutils-2.16.1 and binutils-2.16.91.0.6, + support for 64-bit PC-relative relocations was added, so maybe this + hackery can go away sometime. + ------------------------------------------------------------------------- */ + +#if x86_64_TARGET_ARCH +#define OFFSET_FIELD(n) StgHalfInt n; StgHalfWord __pad_##n; +#else +#define OFFSET_FIELD(n) StgInt n; +#endif + +/* ----------------------------------------------------------------------------- + Profiling info + -------------------------------------------------------------------------- */ + +typedef struct { +#ifndef TABLES_NEXT_TO_CODE + char *closure_type; + char *closure_desc; +#else + OFFSET_FIELD(closure_type_off); + OFFSET_FIELD(closure_desc_off); +#endif +} StgProfInfo; + +/* ----------------------------------------------------------------------------- + Ticky info + + There is no ticky-specific stuff in an info table at this time. + -------------------------------------------------------------------------- */ + +/* ----------------------------------------------------------------------------- + Debugging info + -------------------------------------------------------------------------- */ + +#ifdef DEBUG_CLOSURE + +typedef struct { + ... whatever ... +} StgDebugInfo; + +#else /* !DEBUG_CLOSURE */ + +/* There is no DEBUG-specific stuff in an info table at this time. */ + +#endif /* DEBUG_CLOSURE */ + +/* ----------------------------------------------------------------------------- + Closure flags + -------------------------------------------------------------------------- */ + +/* The type flags provide quick access to certain properties of a closure. */ + +#define _HNF (1<<0) /* head normal form? */ +#define _BTM (1<<1) /* bitmap-style layout? */ +#define _NS (1<<2) /* non-sparkable */ +#define _STA (1<<3) /* static? */ +#define _THU (1<<4) /* thunk? */ +#define _MUT (1<<5) /* mutable? */ +#define _UPT (1<<6) /* unpointed? */ +#define _SRT (1<<7) /* has an SRT? */ +#define _IND (1<<8) /* is an indirection? */ + +#define isSTATIC(flags) ((flags) &_STA) +#define isMUTABLE(flags) ((flags) &_MUT) +#define isBITMAP(flags) ((flags) &_BTM) +#define isTHUNK(flags) ((flags) &_THU) +#define isUNPOINTED(flags) ((flags) &_UPT) +#define hasSRT(flags) ((flags) &_SRT) + +extern StgWord16 closure_flags[]; + +#define closureFlags(c) (closure_flags[get_itbl(UNTAG_CLOSURE(c))->type]) + +#define closure_HNF(c) ( closureFlags(c) & _HNF) +#define closure_BITMAP(c) ( closureFlags(c) & _BTM) +#define closure_NON_SPARK(c) ( (closureFlags(c) & _NS)) +#define closure_SHOULD_SPARK(c) (!(closureFlags(c) & _NS)) +#define closure_STATIC(c) ( closureFlags(c) & _STA) +#define closure_THUNK(c) ( closureFlags(c) & _THU) +#define closure_MUTABLE(c) ( closureFlags(c) & _MUT) +#define closure_UNPOINTED(c) ( closureFlags(c) & _UPT) +#define closure_SRT(c) ( closureFlags(c) & _SRT) +#define closure_IND(c) ( closureFlags(c) & _IND) + +/* same as above but for info-ptr rather than closure */ +#define ipFlags(ip) (closure_flags[ip->type]) + +#define ip_HNF(ip) ( ipFlags(ip) & _HNF) +#define ip_BITMAP(ip) ( ipFlags(ip) & _BTM) +#define ip_SHOULD_SPARK(ip) (!(ipFlags(ip) & _NS)) +#define ip_STATIC(ip) ( ipFlags(ip) & _STA) +#define ip_THUNK(ip) ( ipFlags(ip) & _THU) +#define ip_MUTABLE(ip) ( ipFlags(ip) & _MUT) +#define ip_UNPOINTED(ip) ( ipFlags(ip) & _UPT) +#define ip_SRT(ip) ( ipFlags(ip) & _SRT) +#define ip_IND(ip) ( ipFlags(ip) & _IND) + +/* ----------------------------------------------------------------------------- + Bitmaps + + These are used to describe the pointerhood of a sequence of words + (usually on the stack) to the garbage collector. The two primary + uses are for stack frames, and functions (where we need to describe + the layout of a PAP to the GC). + + In these bitmaps: 0 == ptr, 1 == non-ptr. + -------------------------------------------------------------------------- */ + +/* + * Small bitmaps: for a small bitmap, we store the size and bitmap in + * the same word, using the following macros. If the bitmap doesn't + * fit in a single word, we use a pointer to an StgLargeBitmap below. + */ +#define MK_SMALL_BITMAP(size,bits) (((bits)<<BITMAP_BITS_SHIFT) | (size)) + +#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK) +#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT) + +/* + * A large bitmap. + */ +typedef struct { + StgWord size; + StgWord bitmap[FLEXIBLE_ARRAY]; +} StgLargeBitmap; + +/* ----------------------------------------------------------------------------- + SRTs (Static Reference Tables) + + These tables are used to keep track of the static objects referred + to by the code for a closure or stack frame, so that we can follow + static data references from code and thus accurately + garbage-collect CAFs. + -------------------------------------------------------------------------- */ + +/* An SRT is just an array of closure pointers: */ +typedef StgClosure* StgSRT[]; + +/* + * Each info table refers to some subset of the closure pointers in an + * SRT. It does this using a pair of an StgSRT pointer and a + * half-word bitmap. If the half-word bitmap isn't large enough, then + * we fall back to a large SRT, including an unbounded bitmap. If the + * half-word bitmap is set to all ones (0xffff), then the StgSRT + * pointer instead points to an StgLargeSRT: + */ +typedef struct StgLargeSRT_ { + StgSRT *srt; + StgLargeBitmap l; +} StgLargeSRT; + +/* ---------------------------------------------------------------------------- + Info Tables + ------------------------------------------------------------------------- */ + +/* + * Stuff describing the closure layout. Well, actually, it might + * contain the selector index for a THUNK_SELECTOR. This union is one + * word long. + */ +typedef union { + struct { /* Heap closure payload layout: */ + StgHalfWord ptrs; /* number of pointers */ + StgHalfWord nptrs; /* number of non-pointers */ + } payload; + + StgWord bitmap; /* word-sized bit pattern describing */ + /* a stack frame: see below */ + +#ifndef TABLES_NEXT_TO_CODE + StgLargeBitmap* large_bitmap; /* pointer to large bitmap structure */ +#else + OFFSET_FIELD( large_bitmap_offset ); /* offset from info table to large bitmap structure */ +#endif + + StgWord selector_offset; /* used in THUNK_SELECTORs */ + +} StgClosureInfo; + + +/* + * The "standard" part of an info table. Every info table has this bit. + */ +typedef struct StgInfoTable_ { + +#ifdef PROFILING + StgProfInfo prof; +#endif +#ifdef TICKY + /* Ticky-specific stuff would go here. */ +#endif +#ifdef DEBUG_CLOSURE + /* Debug-specific stuff would go here. */ +#endif + + StgClosureInfo layout; /* closure layout info (one word) */ + + StgHalfWord type; /* closure type */ + StgHalfWord srt_bitmap; /* number of entries in SRT (or constructor tag) */ + +#ifdef TABLES_NEXT_TO_CODE + StgCode code[FLEXIBLE_ARRAY]; +#endif +} *StgInfoTablePtr; + + +/* ----------------------------------------------------------------------------- + Function info tables + + This is the general form of function info tables. The compiler + will omit some of the fields in common cases: + + - If fun_type is not ARG_GEN or ARG_GEN_BIG, then the slow_apply + and bitmap fields may be left out (they are at the end, so omitting + them doesn't affect the layout). + + - If srt_bitmap (in the std info table part) is zero, then the srt + field may be omitted. This only applies if the slow_apply and + bitmap fields have also been omitted. + -------------------------------------------------------------------------- */ + +typedef struct StgFunInfoExtraRev_ { + OFFSET_FIELD ( slow_apply_offset ); /* apply to args on the stack */ + union { + StgWord bitmap; + OFFSET_FIELD ( bitmap_offset ); /* arg ptr/nonptr bitmap */ + } b; + OFFSET_FIELD ( srt_offset ); /* pointer to the SRT table */ + StgHalfWord fun_type; /* function type */ + StgHalfWord arity; /* function arity */ +} StgFunInfoExtraRev; + +typedef struct StgFunInfoExtraFwd_ { + StgHalfWord fun_type; /* function type */ + StgHalfWord arity; /* function arity */ + StgSRT *srt; /* pointer to the SRT table */ + union { /* union for compat. with TABLES_NEXT_TO_CODE version */ + StgWord bitmap; /* arg ptr/nonptr bitmap */ + } b; + StgFun *slow_apply; /* apply to args on the stack */ +} StgFunInfoExtraFwd; + +typedef struct { +#if defined(TABLES_NEXT_TO_CODE) + StgFunInfoExtraRev f; + StgInfoTable i; +#else + StgInfoTable i; + StgFunInfoExtraFwd f; +#endif +} StgFunInfoTable; + +/* ----------------------------------------------------------------------------- + Return info tables + -------------------------------------------------------------------------- */ + +/* + * When info tables are laid out backwards, we can omit the SRT + * pointer iff srt_bitmap is zero. + */ + +typedef struct { +#if defined(TABLES_NEXT_TO_CODE) + OFFSET_FIELD( srt_offset ); /* offset to the SRT table */ + StgInfoTable i; +#else + StgInfoTable i; + StgSRT *srt; /* pointer to the SRT table */ +#endif +} StgRetInfoTable; + +/* ----------------------------------------------------------------------------- + Thunk info tables + -------------------------------------------------------------------------- */ + +/* + * When info tables are laid out backwards, we can omit the SRT + * pointer iff srt_bitmap is zero. + */ + +typedef struct StgThunkInfoTable_ { +#if !defined(TABLES_NEXT_TO_CODE) + StgInfoTable i; +#endif +#if defined(TABLES_NEXT_TO_CODE) + OFFSET_FIELD( srt_offset ); /* offset to the SRT table */ +#else + StgSRT *srt; /* pointer to the SRT table */ +#endif +#if defined(TABLES_NEXT_TO_CODE) + StgInfoTable i; +#endif +} StgThunkInfoTable; + +/* ----------------------------------------------------------------------------- + Constructor info tables + -------------------------------------------------------------------------- */ + +typedef struct StgConInfoTable_ { +#if !defined(TABLES_NEXT_TO_CODE) + StgInfoTable i; +#endif + +#ifndef TABLES_NEXT_TO_CODE + char *con_desc; +#else + OFFSET_FIELD(con_desc) // the name of the data constructor + // as: Package:Module.Name +#endif + +#if defined(TABLES_NEXT_TO_CODE) + StgInfoTable i; +#endif +} StgConInfoTable; + + +/* ----------------------------------------------------------------------------- + Accessor macros for fields that might be offsets (C version) + -------------------------------------------------------------------------- */ + +/* + * GET_SRT(info) + * info must be a Stg[Ret|Thunk]InfoTable* (an info table that has a SRT) + */ +#ifdef TABLES_NEXT_TO_CODE +#define GET_SRT(info) ((StgSRT*) (((StgWord) ((info)+1)) + (info)->srt_offset)) +#else +#define GET_SRT(info) ((info)->srt) +#endif + +/* + * GET_CON_DESC(info) + * info must be a StgConInfoTable*. + */ +#ifdef TABLES_NEXT_TO_CODE +#define GET_CON_DESC(info) ((char *)((StgWord)((info)+1) + (info->con_desc))) +#else +#define GET_CON_DESC(info) ((info)->con_desc) +#endif + +/* + * GET_FUN_SRT(info) + * info must be a StgFunInfoTable* + */ +#ifdef TABLES_NEXT_TO_CODE +#define GET_FUN_SRT(info) ((StgSRT*) (((StgWord) ((info)+1)) + (info)->f.srt_offset)) +#else +#define GET_FUN_SRT(info) ((info)->f.srt) +#endif + +#ifdef TABLES_NEXT_TO_CODE +#define GET_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \ + + (info)->layout.large_bitmap_offset)) +#else +#define GET_LARGE_BITMAP(info) ((info)->layout.large_bitmap) +#endif + +#ifdef TABLES_NEXT_TO_CODE +#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \ + + (info)->f.b.bitmap_offset)) +#else +#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) ((info)->f.b.bitmap)) +#endif + +/* + * GET_PROF_TYPE, GET_PROF_DESC + */ +#ifdef TABLES_NEXT_TO_CODE +#define GET_PROF_TYPE(info) ((char *)((StgWord)((info)+1) + (info->prof.closure_type_off))) +#else +#define GET_PROF_TYPE(info) ((info)->prof.closure_type) +#endif +#ifdef TABLES_NEXT_TO_CODE +#define GET_PROF_DESC(info) ((char *)((StgWord)((info)+1) + (info->prof.closure_desc_off))) +#else +#define GET_PROF_DESC(info) ((info)->prof.closure_desc) +#endif + +#endif /* RTS_STORAGE_INFOTABLES_H */ diff --git a/includes/rts/storage/Liveness.h b/includes/rts/storage/Liveness.h new file mode 100644 index 0000000000..66c82f3134 --- /dev/null +++ b/includes/rts/storage/Liveness.h @@ -0,0 +1,34 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow 2004 + * + * Building liveness masks for RET_DYN stack frames. + * A few macros that are used in both .cmm and .c sources. + * + * A liveness mask is constructed like so: + * + * R1_PTR & R2_PTR & R3_PTR + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_STORAGE_LIVENESS_H +#define RTS_STORAGE_LIVENESS_H + +#define NO_PTRS 0xff +#define R1_PTR (NO_PTRS ^ (1<<0)) +#define R2_PTR (NO_PTRS ^ (1<<1)) +#define R3_PTR (NO_PTRS ^ (1<<2)) +#define R4_PTR (NO_PTRS ^ (1<<3)) +#define R5_PTR (NO_PTRS ^ (1<<4)) +#define R6_PTR (NO_PTRS ^ (1<<5)) +#define R7_PTR (NO_PTRS ^ (1<<6)) +#define R8_PTR (NO_PTRS ^ (1<<7)) + +#define N_NONPTRS(n) ((n)<<16) +#define N_PTRS(n) ((n)<<24) + +#define RET_DYN_NONPTRS(l) ((l)>>16 & 0xff) +#define RET_DYN_PTRS(l) ((l)>>24 & 0xff) +#define RET_DYN_LIVENESS(l) ((l) & 0xffff) + +#endif /* RTS_STORAGE_LIVENESS_H */ diff --git a/includes/rts/storage/MBlock.h b/includes/rts/storage/MBlock.h new file mode 100644 index 0000000000..03396c1fd7 --- /dev/null +++ b/includes/rts/storage/MBlock.h @@ -0,0 +1,206 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2008 + * + * MegaBlock Allocator interface. + * + * See wiki commentary at + * http://hackage.haskell.org/trac/ghc/wiki/Commentary/HeapAlloced + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_STORAGE_MBLOCK_H +#define RTS_STORAGE_MBLOCK_H + +extern lnat mblocks_allocated; + +extern void initMBlocks(void); +extern void * getMBlock(void); +extern void * getMBlocks(nat n); +extern void freeAllMBlocks(void); + +#ifdef DEBUG +extern void *getFirstMBlock(void); +extern void *getNextMBlock(void *mblock); +#endif + +/* ----------------------------------------------------------------------------- + The HEAP_ALLOCED() test. + + HEAP_ALLOCED is called FOR EVERY SINGLE CLOSURE during GC. + It needs to be FAST. + + See wiki commentary at + http://hackage.haskell.org/trac/ghc/wiki/Commentary/HeapAlloced + + Implementation of HEAP_ALLOCED + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + Since heap is allocated in chunks of megablocks (MBLOCK_SIZE), we + can just use a table to record which megablocks in the address + space belong to the heap. On a 32-bit machine, with 1Mb + megablocks, using 8 bits for each entry in the table, the table + requires 4k. Lookups during GC will be fast, because the table + will be quickly cached (indeed, performance measurements showed no + measurable difference between doing the table lookup and using a + constant comparison). + + On 64-bit machines, we cache one 12-bit block map that describes + 4096 megablocks or 4GB of memory. If HEAP_ALLOCED is called for + an address that is not in the cache, it calls slowIsHeapAlloced + (see MBlock.c) which will find the block map for the 4GB block in + question. + -------------------------------------------------------------------------- */ + +#if SIZEOF_VOID_P == 4 +extern StgWord8 mblock_map[]; + +/* On a 32-bit machine a 4KB table is always sufficient */ +# define MBLOCK_MAP_SIZE 4096 +# define MBLOCK_MAP_ENTRY(p) ((StgWord)(p) >> MBLOCK_SHIFT) +# define HEAP_ALLOCED(p) mblock_map[MBLOCK_MAP_ENTRY(p)] +# define HEAP_ALLOCED_GC(p) HEAP_ALLOCED(p) + +/* ----------------------------------------------------------------------------- + HEAP_ALLOCED for 64-bit machines. + + Here are some cache layout options: + + [1] + 16KB cache of 16-bit entries, 1MB lines (capacity 8GB) + mblock size = 20 bits + entries = 8192 13 bits + line size = 0 bits (1 bit of value) + tag size = 15 bits + = 48 bits + + [2] + 32KB cache of 16-bit entries, 4MB lines (capacity 32GB) + mblock size = 20 bits + entries = 16384 14 bits + line size = 2 bits (4 bits of value) + tag size = 12 bits + = 48 bits + + [3] + 16KB cache of 16-bit entries, 2MB lines (capacity 16GB) + mblock size = 20 bits + entries = 8192 13 bits + line size = 1 bits (2 bits of value) + tag size = 14 bits + = 48 bits + + [4] + 4KB cache of 32-bit entries, 16MB lines (capacity 16GB) + mblock size = 20 bits + entries = 1024 10 bits + line size = 4 bits (16 bits of value) + tag size = 14 bits + = 48 bits + + [5] + 4KB cache of 64-bit entries, 32MB lines (capacity 16GB) + mblock size = 20 bits + entries = 512 9 bits + line size = 5 bits (32 bits of value) + tag size = 14 bits + = 48 bits + + We actually use none of the above. After much experimentation it was + found that optimising the lookup is the most important factor, + followed by reducing the number of misses. To that end, we use a + variant of [1] in which each cache entry is ((mblock << 1) + value) + where value is 0 for non-heap and 1 for heap. The cache entries can + be 32 bits, since the mblock number is 48-20 = 28 bits, and we need + 1 bit for the value. The cache can be as big as we like, but + currently we use 8k entries, giving us 8GB capacity. + + ---------------------------------------------------------------------------- */ + +#elif SIZEOF_VOID_P == 8 + +#define MBC_LINE_BITS 0 +#define MBC_TAG_BITS 15 +typedef StgWord32 MbcCacheLine; // could use 16, but 32 was faster +typedef StgWord8 MBlockMapLine; + +#define MBLOCK_MAP_LINE(p) (((StgWord)p & 0xffffffff) >> (MBLOCK_SHIFT + MBC_LINE_BITS)) + +#define MBC_LINE_SIZE (1<<MBC_LINE_BITS) +#define MBC_SHIFT (48 - MBLOCK_SHIFT - MBC_LINE_BITS - MBC_TAG_BITS) +#define MBC_ENTRIES (1<<MBC_SHIFT) + +extern MbcCacheLine mblock_cache[]; + +#define MBC_LINE(p) ((StgWord)p >> (MBLOCK_SHIFT + MBC_LINE_BITS)) + +#define MBLOCK_MAP_ENTRIES (1 << (32 - MBLOCK_SHIFT - MBC_LINE_BITS)) + +typedef struct { + StgWord32 addrHigh32; + MBlockMapLine lines[MBLOCK_MAP_ENTRIES]; +} MBlockMap; + +extern lnat mpc_misses; + +StgBool HEAP_ALLOCED_miss(StgWord mblock, void *p); + +INLINE_HEADER +StgBool HEAP_ALLOCED(void *p) +{ + StgWord mblock; + nat entry_no; + MbcCacheLine entry, value; + + mblock = (StgWord)p >> MBLOCK_SHIFT; + entry_no = mblock & (MBC_ENTRIES-1); + entry = mblock_cache[entry_no]; + value = entry ^ (mblock << 1); + // this formulation coaxes gcc into prioritising the value==1 + // case, which we expect to be the most common. + // __builtin_expect() didn't have any useful effect (gcc-4.3.0). + if (value == 1) { + return 1; + } else if (value == 0) { + return 0; + } else { + // putting the rest out of line turned out to be a slight + // performance improvement: + return HEAP_ALLOCED_miss(mblock,p); + } +} + +// In the parallel GC, the cache itself is safe to *read*, and can be +// updated atomically, but we need to place a lock around operations +// that touch the MBlock map. +INLINE_HEADER +StgBool HEAP_ALLOCED_GC(void *p) +{ + StgWord mblock; + nat entry_no; + MbcCacheLine entry, value; + StgBool b; + + mblock = (StgWord)p >> MBLOCK_SHIFT; + entry_no = mblock & (MBC_ENTRIES-1); + entry = mblock_cache[entry_no]; + value = entry ^ (mblock << 1); + if (value == 1) { + return 1; + } else if (value == 0) { + return 0; + } else { + // putting the rest out of line turned out to be a slight + // performance improvement: + ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync); + b = HEAP_ALLOCED_miss(mblock,p); + RELEASE_SPIN_LOCK(&gc_alloc_block_sync); + return b; + } +} + +#else +# error HEAP_ALLOCED not defined +#endif + +#endif /* RTS_STORAGE_MBLOCK_H */ diff --git a/includes/rts/storage/SMPClosureOps.h b/includes/rts/storage/SMPClosureOps.h new file mode 100644 index 0000000000..d5f7c3f295 --- /dev/null +++ b/includes/rts/storage/SMPClosureOps.h @@ -0,0 +1,78 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 2005 + * + * Macros for THREADED_RTS support + * + * -------------------------------------------------------------------------- */ + +#ifndef RTS_STORAGE_SMPCLOSUREOPS_H +#define RTS_STORAGE_SMPCLOSUREOPS_H + +#ifdef CMINUSMINUS + +#define unlockClosure(ptr,info) \ + prim %write_barrier() []; \ + StgHeader_info(ptr) = info; + +#else + +EXTERN_INLINE StgInfoTable *lockClosure(StgClosure *p); +EXTERN_INLINE void unlockClosure(StgClosure *p, const StgInfoTable *info); + +#if defined(THREADED_RTS) + +/* ----------------------------------------------------------------------------- + * Locking/unlocking closures + * + * This is used primarily in the implementation of MVars. + * -------------------------------------------------------------------------- */ + +#define SPIN_COUNT 4000 + +// We want a callable copy of lockClosure() so that we can refer to it +// from .cmm files compiled using the native codegen. +EXTERN_INLINE StgInfoTable *lockClosure(StgClosure *p) +{ + StgWord info; + do { + nat i = 0; + do { + info = xchg((P_)(void *)&p->header.info, (W_)&stg_WHITEHOLE_info); + if (info != (W_)&stg_WHITEHOLE_info) return (StgInfoTable *)info; + } while (++i < SPIN_COUNT); + yieldThread(); + } while (1); +} + +EXTERN_INLINE void unlockClosure(StgClosure *p, const StgInfoTable *info) +{ + // This is a strictly ordered write, so we need a write_barrier(): + write_barrier(); + p->header.info = info; +} + +#else /* !THREADED_RTS */ + +EXTERN_INLINE StgInfoTable * +lockClosure(StgClosure *p) +{ return (StgInfoTable *)p->header.info; } + +EXTERN_INLINE void +unlockClosure(StgClosure *p STG_UNUSED, const StgInfoTable *info STG_UNUSED) +{ /* nothing */ } + +#endif /* THREADED_RTS */ + +// Handy specialised versions of lockClosure()/unlockClosure() +EXTERN_INLINE void lockTSO(StgTSO *tso); +EXTERN_INLINE void lockTSO(StgTSO *tso) +{ lockClosure((StgClosure *)tso); } + +EXTERN_INLINE void unlockTSO(StgTSO *tso); +EXTERN_INLINE void unlockTSO(StgTSO *tso) +{ unlockClosure((StgClosure*)tso, (const StgInfoTable *)&stg_TSO_info); } + +#endif /* CMINUSMINUS */ + +#endif /* RTS_STORAGE_SMPCLOSUREOPS_H */ diff --git a/includes/rts/storage/TSO.h b/includes/rts/storage/TSO.h new file mode 100644 index 0000000000..7cb245909f --- /dev/null +++ b/includes/rts/storage/TSO.h @@ -0,0 +1,206 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2009 + * + * The definitions for Thread State Objects. + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_STORAGE_TSO_H +#define RTS_STORAGE_TSO_H + +/* + * PROFILING info in a TSO + */ +typedef struct { + CostCentreStack *CCCS; /* thread's current CCS */ +} StgTSOProfInfo; + +/* + * There is no TICKY info in a TSO at this time. + */ + +/* + * Thread IDs are 32 bits. + */ +typedef StgWord32 StgThreadID; + +#define tsoDirty(tso) ((tso)->flags & TSO_DIRTY) +#define tsoLocked(tso) ((tso)->flags & TSO_LOCKED) + +/* + * Type returned after running a thread. Values of this type + * include HeapOverflow, StackOverflow etc. See Constants.h for the + * full list. + */ +typedef unsigned int StgThreadReturnCode; + +#if defined(mingw32_HOST_OS) +/* results from an async I/O request + its request ID. */ +typedef struct { + unsigned int reqID; + int len; + int errCode; +} StgAsyncIOResult; +#endif + +/* Reason for thread being blocked. See comment above struct StgTso_. */ +typedef union { + StgClosure *closure; + struct StgTSO_ *tso; + StgInt fd; /* StgInt instead of int, so that it's the same size as the ptrs */ +#if defined(mingw32_HOST_OS) + StgAsyncIOResult *async_result; +#endif + StgWord target; +} StgTSOBlockInfo; + + +/* + * TSOs live on the heap, and therefore look just like heap objects. + * Large TSOs will live in their own "block group" allocated by the + * storage manager, and won't be copied during garbage collection. + */ + +/* + * Threads may be blocked for several reasons. A blocked thread will + * have the reason in the why_blocked field of the TSO, and some + * further info (such as the closure the thread is blocked on, or the + * file descriptor if the thread is waiting on I/O) in the block_info + * field. + */ + +typedef struct StgTSO_ { + StgHeader header; + + /* The link field, for linking threads together in lists (e.g. the + run queue on a Capability. + */ + struct StgTSO_* _link; + /* + NOTE!!! do not modify _link directly, it is subject to + a write barrier for generational GC. Instead use the + setTSOLink() function. Exceptions to this rule are: + + * setting the link field to END_TSO_QUEUE + * putting a TSO on the blackhole_queue + * setting the link field of the currently running TSO, as it + will already be dirty. + */ + + struct StgTSO_* global_link; /* Links all threads together */ + + StgWord16 what_next; /* Values defined in Constants.h */ + StgWord16 why_blocked; /* Values defined in Constants.h */ + StgWord32 flags; + StgTSOBlockInfo block_info; + StgThreadID id; + int saved_errno; + struct Task_* bound; + struct Capability_* cap; + struct StgTRecHeader_ * trec; /* STM transaction record */ + + /* + A list of threads blocked on this TSO waiting to throw + exceptions. In order to access this field, the TSO must be + locked using lockClosure/unlockClosure (see SMP.h). + */ + struct StgTSO_ * blocked_exceptions; + +#ifdef TICKY_TICKY + /* TICKY-specific stuff would go here. */ +#endif +#ifdef PROFILING + StgTSOProfInfo prof; +#endif +#ifdef mingw32_HOST_OS + StgWord32 saved_winerror; +#endif + + /* The thread stack... */ + StgWord32 stack_size; /* stack size in *words* */ + StgWord32 max_stack_size; /* maximum stack size in *words* */ + StgPtr sp; + + StgWord stack[FLEXIBLE_ARRAY]; +} *StgTSOPtr; + +/* ----------------------------------------------------------------------------- + functions + -------------------------------------------------------------------------- */ + +void dirty_TSO (Capability *cap, StgTSO *tso); +void setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target); + +/* ----------------------------------------------------------------------------- + Invariants: + + An active thread has the following properties: + + tso->stack < tso->sp < tso->stack+tso->stack_size + tso->stack_size <= tso->max_stack_size + + RESERVED_STACK_WORDS is large enough for any heap-check or + stack-check failure. + + The size of the TSO struct plus the stack is either + (a) smaller than a block, or + (b) a multiple of BLOCK_SIZE + + tso->why_blocked tso->block_info location + ---------------------------------------------------------------------- + NotBlocked NULL runnable_queue, or running + + BlockedOnBlackHole the BLACKHOLE blackhole_queue + + BlockedOnMVar the MVAR the MVAR's queue + + BlockedOnSTM END_TSO_QUEUE STM wait queue(s) + + BlockedOnException the TSO TSO->blocked_exception + + BlockedOnRead NULL blocked_queue + BlockedOnWrite NULL blocked_queue + BlockedOnDelay NULL blocked_queue + BlockedOnGA closure TSO blocks on BQ of that closure + BlockedOnGA_NoSend closure TSO blocks on BQ of that closure + + tso->link == END_TSO_QUEUE, if the thread is currently running. + + A zombie thread has the following properties: + + tso->what_next == ThreadComplete or ThreadKilled + tso->link == (could be on some queue somewhere) + tso->su == tso->stack + tso->stack_size + tso->sp == tso->stack + tso->stack_size - 1 (i.e. top stack word) + tso->sp[0] == return value of thread, if what_next == ThreadComplete, + exception , if what_next == ThreadKilled + + (tso->sp is left pointing at the top word on the stack so that + the return value or exception will be retained by a GC). + + The 2 cases BlockedOnGA and BlockedOnGA_NoSend are needed in a GUM + setup only. They mark a TSO that has entered a FETCH_ME or + FETCH_ME_BQ closure, respectively; only the first TSO hitting the + closure will send a Fetch message. + Currently we have no separate code for blocking on an RBH; we use the + BlockedOnBlackHole case for that. -- HWL + + ---------------------------------------------------------------------------- */ + +/* Workaround for a bug/quirk in gcc on certain architectures. + * symptom is that (&tso->stack - &tso->header) /= sizeof(StgTSO) + * in other words, gcc pads the structure at the end. + */ + +extern StgTSO dummy_tso; + +#define TSO_STRUCT_SIZE \ + ((char *)&dummy_tso.stack - (char *)&dummy_tso.header) + +#define TSO_STRUCT_SIZEW (TSO_STRUCT_SIZE / sizeof(W_)) + +/* this is the NIL ptr for a TSO queue (e.g. runnable queue) */ +#define END_TSO_QUEUE ((StgTSO *)(void*)&stg_END_TSO_QUEUE_closure) + +#endif /* RTS_STORAGE_TSO_H */ |