static void decommitBlocks(char *addr, W_ nBytes)
{
alloc_rec *p;
p = allocs;
while ((p != NULL) && (addr >= (p->base + p->size))) {
p = p->next;
}
while (nBytes > 0) {
if ((p == NULL) || (p->base > addr)) {
errorBelch("Memory to be freed isn't allocated\n");
stg_exit(EXIT_FAILURE);
}
if (p->base + p->size >= addr + nBytes) {
if (!VirtualFree(addr, nBytes, MEM_DECOMMIT)) {
sysErrorBelch("osFreeMBlocks: VirtualFree MEM_DECOMMIT failed");
stg_exit(EXIT_FAILURE);
}
nBytes = 0;
}
else {
W_ bytesToFree = p->base + p->size - addr;
if (!VirtualFree(addr, bytesToFree, MEM_DECOMMIT)) {
sysErrorBelch("osFreeMBlocks: VirtualFree MEM_DECOMMIT failed");
stg_exit(EXIT_FAILURE);
}
addr += bytesToFree;
nBytes -= bytesToFree;
p = p->next;
}
}
}
void
stopTicker(void)
{
#if defined(USE_TIMER_CREATE)
struct itimerspec it;
it.it_value.tv_sec = 0;
it.it_value.tv_nsec = 0;
it.it_interval = it.it_value;
if (timer_settime(timer, 0, &it, NULL) != 0) {
sysErrorBelch("timer_settime");
stg_exit(EXIT_FAILURE);
}
#else
struct itimerval it;
it.it_value.tv_sec = 0;
it.it_value.tv_usec = 0;
it.it_interval = it.it_value;
if (setitimer(ITIMER_REAL, &it, NULL) != 0) {
sysErrorBelch("setitimer");
stg_exit(EXIT_FAILURE);
}
#endif
}
void
stopTicker(void)
{
#if defined(USE_PTHREAD_FOR_ITIMER)
if (itimer_enabled == 1) {
itimer_enabled = 2;
/* Wait for the thread to confirm it won't generate another tick. */
while (itimer_enabled != 0)
sched_yield();
}
#elif defined(USE_TIMER_CREATE)
struct itimerspec it;
it.it_value.tv_sec = 0;
it.it_value.tv_nsec = 0;
it.it_interval = it.it_value;
if (timer_settime(timer, 0, &it, NULL) != 0) {
sysErrorBelch("timer_settime");
stg_exit(EXIT_FAILURE);
}
#else
struct itimerval it;
it.it_value.tv_sec = 0;
it.it_value.tv_usec = 0;
it.it_interval = it.it_value;
if (setitimer(ITIMER_REAL, &it, NULL) != 0) {
sysErrorBelch("setitimer");
stg_exit(EXIT_FAILURE);
}
#endif
}
void osDecommitMemory(void *at, W_ size)
{
int r;
// First make the memory unaccessible (so that we get a segfault
// at the next attempt to touch it)
// We only do this in DEBUG because it forces the OS to remove
// all MMU entries for this page range, and there is no reason
// to do so unless there is memory pressure
#ifdef DEBUG
r = mprotect(at, size, PROT_NONE);
if(r < 0)
sysErrorBelch("unable to make released memory unaccessible");
#endif
#ifdef MADV_FREE
// Try MADV_FREE first, FreeBSD has both and MADV_DONTNEED
// just swaps memory out
r = madvise(at, size, MADV_FREE);
#else
r = madvise(at, size, MADV_DONTNEED);
#endif
if(r < 0)
sysErrorBelch("unable to decommit memory");
}
static void *
osTryReserveHeapMemory (W_ len, void *hint)
{
void *base, *top;
void *start, *end;
/* We try to allocate len + MBLOCK_SIZE,
because we need memory which is MBLOCK_SIZE aligned,
and then we discard what we don't need */
base = my_mmap(hint, len + MBLOCK_SIZE, MEM_RESERVE);
top = (void*)((W_)base + len + MBLOCK_SIZE);
if (((W_)base & MBLOCK_MASK) != 0) {
start = MBLOCK_ROUND_UP(base);
end = MBLOCK_ROUND_DOWN(top);
ASSERT(((W_)end - (W_)start) == len);
if (munmap(base, (W_)start-(W_)base) < 0) {
sysErrorBelch("unable to release slop before heap");
}
if (munmap(end, (W_)top-(W_)end) < 0) {
sysErrorBelch("unable to release slop after heap");
}
} else {
start = base;
}
return start;
}
void
startTicker(void)
{
#if defined(USE_TIMER_CREATE)
{
struct itimerspec it;
it.it_value.tv_sec = TimeToSeconds(itimer_interval);
it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000;
it.it_interval = it.it_value;
if (timer_settime(timer, 0, &it, NULL) != 0) {
sysErrorBelch("timer_settime");
stg_exit(EXIT_FAILURE);
}
}
#else
{
struct itimerval it;
it.it_value.tv_sec = TimeToSeconds(itimer_interval);
it.it_value.tv_usec = TimeToUS(itimer_interval) % 1000000;
it.it_interval = it.it_value;
if (setitimer(ITIMER_REAL, &it, NULL) != 0) {
sysErrorBelch("setitimer");
stg_exit(EXIT_FAILURE);
}
}
#endif
}
void
startTicker(void)
{
#if defined(USE_TIMER_CREATE)
{
struct itimerspec it;
it.it_value.tv_sec = itimer_interval / 1000;
it.it_value.tv_nsec = (itimer_interval % 1000) * 1000000;
it.it_interval = it.it_value;
if (timer_settime(timer, 0, &it, NULL) != 0) {
sysErrorBelch("timer_settime");
stg_exit(EXIT_FAILURE);
}
}
#else
{
struct itimerval it;
it.it_value.tv_sec = itimer_interval / 1000;
it.it_value.tv_usec = (itimer_interval % 1000) * 1000;
it.it_interval = it.it_value;
if (setitimer(ITIMER_FLAVOUR, &it, NULL) != 0) {
sysErrorBelch("setitimer");
stg_exit(EXIT_FAILURE);
}
}
#endif
}
static void *itimer_thread_func(void *_handle_tick)
{
TickProc handle_tick = _handle_tick;
uint64_t nticks;
int timerfd = -1;
#if defined(USE_TIMERFD_FOR_ITIMER) && USE_TIMERFD_FOR_ITIMER
struct itimerspec it;
it.it_value.tv_sec = TimeToSeconds(itimer_interval);
it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000;
it.it_interval = it.it_value;
timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC);
if (timerfd == -1) {
sysErrorBelch("timerfd_create");
stg_exit(EXIT_FAILURE);
}
if (!TFD_CLOEXEC) {
fcntl(timerfd, F_SETFD, FD_CLOEXEC);
}
if (timerfd_settime(timerfd, 0, &it, NULL)) {
sysErrorBelch("timerfd_settime");
stg_exit(EXIT_FAILURE);
}
#endif
while (!exited) {
if (USE_TIMERFD_FOR_ITIMER) {
if (read(timerfd, &nticks, sizeof(nticks)) != sizeof(nticks)) {
if (errno != EINTR) {
sysErrorBelch("Itimer: read(timerfd) failed");
}
}
} else {
if (usleep(TimeToUS(itimer_interval)) != 0 && errno != EINTR) {
sysErrorBelch("usleep(TimeToUS(itimer_interval) failed");
}
}
// first try a cheap test
if (stopped) {
ACQUIRE_LOCK(&mutex);
// should we really stop?
if (stopped) {
waitCondition(&start_cond, &mutex);
}
RELEASE_LOCK(&mutex);
} else {
handle_tick(0);
}
}
if (USE_TIMERFD_FOR_ITIMER)
close(timerfd);
closeMutex(&mutex);
closeCondition(&start_cond);
return NULL;
}
// Create a libdw session with DWARF information for all loaded modules
LibdwSession *libdwInit() {
LibdwSession *session = stgCallocBytes(1, sizeof(LibdwSession),
"libdwInit");
// Initialize ELF library
if (elf_version(EV_CURRENT) == EV_NONE) {
sysErrorBelch("libelf version too old!");
return NULL;
}
// Initialize a libdwfl session
static char *debuginfo_path;
static const Dwfl_Callbacks proc_callbacks =
{
.find_debuginfo = dwfl_standard_find_debuginfo,
.debuginfo_path = &debuginfo_path,
.find_elf = dwfl_linux_proc_find_elf,
};
session->dwfl = dwfl_begin (&proc_callbacks);
if (session->dwfl == NULL) {
sysErrorBelch("dwfl_begin failed: %s", dwfl_errmsg(dwfl_errno()));
free(session);
return NULL;
}
// Report the loaded modules
int ret = dwfl_linux_proc_report(session->dwfl, getpid());
if (ret < 0) {
sysErrorBelch("dwfl_linux_proc_report failed: %s",
dwfl_errmsg(dwfl_errno()));
goto fail;
}
if (dwfl_report_end (session->dwfl, NULL, NULL) != 0) {
sysErrorBelch("dwfl_report_end failed: %s", dwfl_errmsg(dwfl_errno()));
goto fail;
}
pid_t pid = getpid();
if (! dwfl_attach_state(session->dwfl, NULL, pid, &thread_cbs, NULL)) {
sysErrorBelch("dwfl_attach_state failed: %s",
dwfl_errmsg(dwfl_errno()));
goto fail;
}
return session;
fail:
dwfl_end(session->dwfl);
free(session);
return NULL;
}
HANDLE
getIOManagerEvent (void)
{
// This function has to exist even in the non-THREADED_RTS,
// because code in GHC.Conc refers to it. It won't ever be called
// unless we're in the threaded RTS, however.
#ifdef THREADED_RTS
HANDLE hRes;
ACQUIRE_LOCK(&event_buf_mutex);
if (io_manager_event == INVALID_HANDLE_VALUE) {
hRes = CreateEvent ( NULL, // no security attrs
true, // manual reset
false, // initial state,
NULL ); // event name: NULL for private events
if (hRes == NULL) {
sysErrorBelch("getIOManagerEvent");
stg_exit(EXIT_FAILURE);
}
io_manager_event = hRes;
} else {
hRes = io_manager_event;
}
RELEASE_LOCK(&event_buf_mutex);
return hRes;
#else
return NULL;
#endif
}
static
alloc_rec*
allocNew(uint32_t n) {
alloc_rec* rec;
rec = (alloc_rec*)stgMallocBytes(sizeof(alloc_rec),"getMBlocks: allocNew");
rec->size = ((W_)n+1)*MBLOCK_SIZE;
rec->base =
VirtualAlloc(NULL, rec->size, MEM_RESERVE, PAGE_READWRITE);
if(rec->base==0) {
stgFree((void*)rec);
rec=0;
if (GetLastError() == ERROR_NOT_ENOUGH_MEMORY) {
errorBelch("Out of memory\n");
stg_exit(EXIT_HEAPOVERFLOW);
} else {
sysErrorBelch(
"getMBlocks: VirtualAlloc MEM_RESERVE %d blocks failed", n);
}
} else {
alloc_rec temp;
temp.base=0; temp.size=0; temp.next=allocs;
alloc_rec* it;
it=&temp;
for(; it->next!=0 && it->next->base<rec->base; it=it->next) ;
rec->next=it->next;
it->next=rec;
allocs=temp.next;
}
return rec;
}
void osDecommitMemory (void *at, W_ size)
{
if (!VirtualFree(at, size, MEM_DECOMMIT)) {
sysErrorBelch("osDecommitMemory: VirtualFree MEM_DECOMMIT failed");
stg_exit(EXIT_FAILURE);
}
}
void *osReserveHeapMemory (void *startAddress, W_ *len)
{
void *start;
heap_base = VirtualAlloc(startAddress, *len + MBLOCK_SIZE,
MEM_RESERVE, PAGE_READWRITE);
if (heap_base == NULL) {
if (GetLastError() == ERROR_NOT_ENOUGH_MEMORY) {
errorBelch("out of memory");
} else {
sysErrorBelch(
"osReserveHeapMemory: VirtualAlloc MEM_RESERVE %llu bytes \
at address %p bytes failed",
len + MBLOCK_SIZE, startAddress);
}
stg_exit(EXIT_FAILURE);
}
// VirtualFree MEM_RELEASE must always match a
// previous MEM_RESERVE call, in address and size
// so we necessarily leak some address space here,
// before and after the aligned area
// It is not a huge problem because we never commit
// that memory
start = MBLOCK_ROUND_UP(heap_base);
return start;
}
void
initTicker (Time interval, TickProc handle_tick)
{
itimer_interval = interval;
#if defined(USE_PTHREAD_FOR_ITIMER)
pthread_t tid;
pthread_create(&tid, NULL, itimer_thread_func, (void*)handle_tick);
#elif defined(USE_TIMER_CREATE)
{
struct sigevent ev;
// Keep programs like valgrind happy
memset(&ev, 0, sizeof(ev));
ev.sigev_notify = SIGEV_SIGNAL;
ev.sigev_signo = ITIMER_SIGNAL;
if (timer_create(CLOCK_ID, &ev, &timer) != 0) {
sysErrorBelch("timer_create");
stg_exit(EXIT_FAILURE);
}
}
install_vtalrm_handler(handle_tick);
#else
install_vtalrm_handler(handle_tick);
#endif
}
static enum FdState fdPollWriteState (int fd)
{
int r;
fd_set wfd;
struct timeval now;
FD_ZERO(&wfd);
FD_SET(fd, &wfd);
/* only poll */
now.tv_sec = 0;
now.tv_usec = 0;
for (;;)
{
r = select(fd+1, NULL, &wfd, NULL, &now);
/* the descriptor is sane */
if (r != -1)
break;
switch (errno)
{
case EBADF: return RTS_FD_IS_INVALID;
case EINTR: continue;
default:
sysErrorBelch("select");
stg_exit(EXIT_FAILURE);
}
}
if (r == 0)
return RTS_FD_IS_BLOCKING;
else
return RTS_FD_IS_READY;
}
void
initTicker (nat ms, TickProc handle_tick)
{
install_vtalrm_handler(handle_tick);
#if !defined(THREADED_RTS)
timestamp = getourtimeofday();
#endif
itimer_interval = ms;
#if defined(USE_TIMER_CREATE)
{
struct sigevent ev;
// Keep programs like valgrind happy
memset(&ev, 0, sizeof(ev));
ev.sigev_notify = SIGEV_SIGNAL;
ev.sigev_signo = ITIMER_SIGNAL;
if (timer_create(TIMER_FLAVOUR, &ev, &timer) != 0) {
sysErrorBelch("timer_create");
stg_exit(EXIT_FAILURE);
}
}
#endif
}
HsWord32
readIOManagerEvent (void)
{
// This function must exist even in non-THREADED_RTS,
// see getIOManagerEvent() above.
#if defined(THREADED_RTS)
HsWord32 res;
ACQUIRE_LOCK(&event_buf_mutex);
if (io_manager_event != INVALID_HANDLE_VALUE) {
if (next_event == 0) {
res = 0; // no event to return
} else {
res = (HsWord32)(event_buf[--next_event]);
if (next_event == 0) {
if (!ResetEvent(io_manager_event)) {
sysErrorBelch("readIOManagerEvent");
stg_exit(EXIT_FAILURE);
}
}
}
} else {
res = 0;
}
RELEASE_LOCK(&event_buf_mutex);
// debugBelch("readIOManagerEvent: %d\n", res);
return res;
#else
return 0;
#endif
}
Time getProcessCPUTime(void)
{
#if !defined(BE_CONSERVATIVE) && defined(HAVE_CLOCK_GETTIME) && defined (_SC_CPUTIME) && defined(CLOCK_PROCESS_CPUTIME_ID) && defined(HAVE_SYSCONF)
static int checked_sysconf = 0;
static int sysconf_result = 0;
if (!checked_sysconf) {
sysconf_result = sysconf(_SC_CPUTIME);
checked_sysconf = 1;
}
if (sysconf_result != -1) {
struct timespec ts;
int res;
res = clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &ts);
if (res == 0) {
return SecondsToTime(ts.tv_sec) + NSToTime(ts.tv_nsec);
} else {
sysErrorBelch("clock_gettime");
stg_exit(EXIT_FAILURE);
}
}
#endif
// fallback to getrusage
{
struct rusage t;
getrusage(RUSAGE_SELF, &t);
return SecondsToTime(t.ru_utime.tv_sec) + USToTime(t.ru_utime.tv_usec);
}
}
void
osFreeAllMBlocks(void)
{
{
block_rec* next;
block_rec* it;
next=0;
it = free_blocks;
for(; it!=0; ) {
next = it->next;
stgFree(it);
it=next;
}
}
{
alloc_rec* next;
alloc_rec* it;
next=0;
it=allocs;
for(; it!=0; ) {
if(!VirtualFree((void*)it->base, 0, MEM_RELEASE)) {
sysErrorBelch("freeAllMBlocks: VirtualFree MEM_RELEASE failed");
stg_exit(EXIT_FAILURE);
}
next = it->next;
stgFree(it);
it=next;
}
}
}
void
initTicker (Time interval, TickProc handle_tick)
{
itimer_interval = interval;
#if defined(USE_TIMER_CREATE)
{
struct sigevent ev;
clockid_t clock;
// Keep programs like valgrind happy
memset(&ev, 0, sizeof(ev));
ev.sigev_notify = SIGEV_SIGNAL;
ev.sigev_signo = ITIMER_SIGNAL;
#if defined(CLOCK_MONOTONIC)
clock = CLOCK_MONOTONIC;
#else
clock = CLOCK_REALTIME;
#endif
if (timer_create(clock, &ev, &timer) != 0) {
sysErrorBelch("timer_create");
stg_exit(EXIT_FAILURE);
}
}
#endif
install_vtalrm_handler(handle_tick);
}
/* -----------------------------------------------------------------------------
* Wake up at least one IO or timer manager HS thread.
* -------------------------------------------------------------------------- */
void
ioManagerWakeup (void)
{
int r;
// Wake up the IO Manager thread by sending a byte down its pipe
if (io_manager_wakeup_fd >= 0) {
#if defined(HAVE_EVENTFD)
StgWord64 n = (StgWord64)IO_MANAGER_WAKEUP;
r = write(io_manager_wakeup_fd, (char *) &n, 8);
#else
StgWord8 byte = (StgWord8)IO_MANAGER_WAKEUP;
r = write(io_manager_wakeup_fd, &byte, 1);
#endif
/* N.B. If the TimerManager is shutting down as we run this
* then there is a possiblity that our first read of
* io_manager_wakeup_fd is non-negative, but before we get to the
* write the file is closed. If this occurs, io_manager_wakeup_fd
* will be written into with -1 (GHC.Event.Control does this prior
* to closing), so checking this allows us to distinguish this case.
* To ensure we observe the correct ordering, we declare the
* io_manager_wakeup_fd as volatile.
* Since this is not an error condition, we do not print the error
* message in this case.
*/
if (r == -1 && io_manager_wakeup_fd >= 0) {
sysErrorBelch("ioManagerWakeup: write");
}
}
}
StgWord64 getMonotonicNSec(void)
{
#if defined(HAVE_CLOCK_GETTIME)
struct timespec ts;
int res;
res = clock_gettime(CLOCK_ID, &ts);
if (res != 0) {
sysErrorBelch("clock_gettime");
stg_exit(EXIT_FAILURE);
}
return (StgWord64)ts.tv_sec * 1000000000 +
(StgWord64)ts.tv_nsec;
#elif defined(darwin_HOST_OS)
uint64_t time = mach_absolute_time();
return (time * timer_scaling_factor_numer) / timer_scaling_factor_denom;
#else // use gettimeofday()
struct timeval tv;
gettimeofday(&tv, (struct timezone *) NULL);
return (StgWord64)tv.tv_sec * 1000000000 +
(StgWord64)tv.tv_usec * 1000;
#endif
}
void getProcessTimes(Time *user, Time *elapsed)
{
static nat ClockFreq = 0;
if (ClockFreq == 0) {
#if defined(HAVE_SYSCONF)
long ticks;
ticks = sysconf(_SC_CLK_TCK);
if ( ticks == -1 ) {
sysErrorBelch("sysconf");
stg_exit(EXIT_FAILURE);
}
ClockFreq = ticks;
#elif defined(CLK_TCK) /* defined by POSIX */
ClockFreq = CLK_TCK;
#elif defined(HZ)
ClockFreq = HZ;
#elif defined(CLOCKS_PER_SEC)
ClockFreq = CLOCKS_PER_SEC;
#else
errorBelch("can't get clock resolution");
stg_exit(EXIT_FAILURE);
#endif
}
struct tms t;
clock_t r = times(&t);
*user = SecondsToTime(t.tms_utime) / ClockFreq;
*elapsed = SecondsToTime(r) / ClockFreq;
}
static void install_vtalrm_handler(TickProc handle_tick)
{
struct sigaction action;
action.sa_handler = handle_tick;
sigemptyset(&action.sa_mask);
#ifdef SA_RESTART
// specify SA_RESTART. One consequence if we don't do this is
// that readline gets confused by the -threaded RTS. It seems
// that if a SIGALRM handler is installed without SA_RESTART,
// readline installs its own SIGALRM signal handler (see
// readline's signals.c), and this somehow causes readline to go
// wrong when the input exceeds a single line (try it).
action.sa_flags = SA_RESTART;
#else
action.sa_flags = 0;
#endif
if (sigaction(ITIMER_SIGNAL, &action, NULL) == -1) {
sysErrorBelch("sigaction");
stg_exit(EXIT_FAILURE);
}
}
void
closeCondition( Condition* pCond )
{
if ( CloseHandle(*pCond) == 0 ) {
sysErrorBelch("closeCondition: failed to close");
}
return;
}
bool
signalCondition ( Condition* pCond )
{
if (SetEvent(*pCond) == 0) {
sysErrorBelch("SetEvent");
stg_exit(EXIT_FAILURE);
}
return true;
}
void osReleaseHeapMemory(void)
{
int r;
r = munmap((void*)mblock_address_space.begin,
mblock_address_space.end - mblock_address_space.begin);
if(r < 0)
sysErrorBelch("unable to release address space");
}
void osCommitMemory (void *at, W_ size)
{
void *temp;
temp = VirtualAlloc(at, size, MEM_COMMIT, PAGE_READWRITE);
if (temp == NULL) {
sysErrorBelch("osCommitMemory: VirtualAlloc MEM_COMMIT failed");
stg_exit(EXIT_FAILURE);
}
}
Backtrace *libdwGetBacktrace(LibdwSession *session) {
if (session->cur_bt != NULL) {
sysErrorBelch("Already collecting backtrace. Uh oh.");
return NULL;
}
Backtrace *bt = backtraceAlloc();
session->cur_bt = bt;
int pid = getpid();
int ret = dwfl_getthread_frames(session->dwfl, pid,
getBacktraceFrameCb, session);
if (ret == -1)
sysErrorBelch("Failed to get stack frames of current process: %s",
dwfl_errmsg(dwfl_errno()));
session->cur_bt = NULL;
return bt;
}
void setExecutable (void *p, W_ len, bool exec)
{
DWORD dwOldProtect = 0;
if (VirtualProtect (p, len,
exec ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE,
&dwOldProtect) == 0)
{
sysErrorBelch("setExecutable: failed to protect 0x%p; old protection: "
"%lu\n", p, (unsigned long)dwOldProtect);
stg_exit(EXIT_FAILURE);
}
}
