Esempio n. 1
1
/* Returns NULL on failure; errno set */
static void *
my_mmap (void *addr, W_ size, int operation)
{
    void *ret;

#if darwin_HOST_OS
    // Without MAP_FIXED, Apple's mmap ignores addr.
    // With MAP_FIXED, it overwrites already mapped regions, whic
    // mmap(0, ... MAP_FIXED ...) is worst of all: It unmaps the program text
    // and replaces it with zeroes, causing instant death.
    // This behaviour seems to be conformant with IEEE Std 1003.1-2001.
    // Let's just use the underlying Mach Microkernel calls directly,
    // they're much nicer.

    kern_return_t err = 0;
    ret = addr;

    if(operation & MEM_RESERVE)
    {
        if(addr)    // try to allocate at address
            err = vm_allocate(mach_task_self(),(vm_address_t*) &ret,
                              size, false);
        if(!addr || err)    // try to allocate anywhere
            err = vm_allocate(mach_task_self(),(vm_address_t*) &ret,
                              size, true);
    }

    if(err) {
        // don't know what the error codes mean exactly, assume it's
        // not our problem though.
        errorBelch("memory allocation failed (requested %" FMT_Word " bytes)",
                   size);
        stg_exit(EXIT_FAILURE);
    }

    if(operation & MEM_COMMIT) {
        vm_protect(mach_task_self(), (vm_address_t)ret, size, false,
                   VM_PROT_READ|VM_PROT_WRITE);
    }

#else

    int prot, flags;
    if (operation & MEM_COMMIT)
        prot = PROT_READ | PROT_WRITE;
    else
        prot = PROT_NONE;
    if (operation == MEM_RESERVE)
# if defined(MAP_NORESERVE)
        flags = MAP_NORESERVE;
# else
#  ifdef USE_LARGE_ADDRESS_SPACE
#   error USE_LARGE_ADDRESS_SPACE needs MAP_NORESERVE
#  endif
        errorBelch("my_mmap(,,MEM_RESERVE) not supported on this platform");
# endif
    else if (operation == MEM_COMMIT)
Esempio n. 2
0
void
OutOfHeapHook (W_ request_size, W_ heap_size) /* both sizes in bytes */
{
  /*    fprintf(stderr, "Heap exhausted;\nwhile trying to allocate %lu bytes in a %lu-byte heap;\nuse `+RTS -H<size>' to increase the total heap size.\n", */

  (void)request_size;   /* keep gcc -Wall happy */
  if (heap_size > 0) {
      errorBelch("Heap exhausted;\nCurrent maximum heap size is %" FMT_Word " bytes (%" FMT_Word " MB);\nuse `+RTS -M<size>' to increase it.",
          heap_size, heap_size / (1024*1024));
  } else {
      errorBelch("out of memory");
  }
}
Esempio n. 3
0
File: RtsMain.c Progetto: raeez/ghc
/* Hack: we assume that we're building a batch-mode system unless
 * INTERPRETER is set
 */
#ifndef INTERPRETER /* Hack */
static void real_main(void)
{
    int exit_status;
    SchedulerStatus status;
    /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */

    startupHaskell(progargc,progargv,NULL);

    /* kick off the computation by creating the main thread with a pointer
       to mainIO_closure representing the computation of the overall program;
       then enter the scheduler with this thread and off we go;

       the same for GranSim (we have only one instance of this code)

       in a parallel setup, where we have many instances of this code
       running on different PEs, we should do this only for the main PE
       (IAmMainThread is set in startupHaskell)
    */

    /* ToDo: want to start with a larger stack size */
    {
        Capability *cap = rts_lock();
        cap = rts_evalLazyIO(cap,progmain_closure, NULL);
        status = rts_getSchedStatus(cap);
        taskTimeStamp(myTask());
        rts_unlock(cap);
    }

    /* check the status of the entire Haskell computation */
    switch (status) {
    case Killed:
        errorBelch("main thread exited (uncaught exception)");
        exit_status = EXIT_KILLED;
        break;
    case Interrupted:
        errorBelch("interrupted");
        exit_status = EXIT_INTERRUPTED;
        break;
    case HeapExhausted:
        exit_status = EXIT_HEAPOVERFLOW;
        break;
    case Success:
        exit_status = EXIT_SUCCESS;
        break;
    default:
        barf("main thread completed with invalid status");
    }
    shutdownHaskellAndExit(exit_status);
}
Esempio n. 4
0
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;
}
Esempio n. 5
0
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;
}
Esempio n. 6
0
File: Select.c Progetto: Chobbes/ghc
fdOutOfRange (int fd)
{
    errorBelch("file descriptor %d out of range for select (0--%d).\n"
               "Recompile with -threaded to work around this.",
               fd, (int)FD_SETSIZE);
    stg_exit(EXIT_FAILURE);
}
Esempio n. 7
0
File: OSMem.c Progetto: mboes/ghc
void *
osGetMBlocks(nat n)
{
  caddr_t ret;
  W_ size = MBLOCK_SIZE * (W_)n;

  if (next_request == 0) {
      // use gen_map_mblocks the first time.
      ret = gen_map_mblocks(size);
  } else {
      ret = my_mmap(next_request, size, MEM_RESERVE_AND_COMMIT);

      if (((W_)ret & MBLOCK_MASK) != 0) {
          // misaligned block!
#if 0 // defined(DEBUG)
          errorBelch("warning: getMBlock: misaligned block %p returned "
                     "when allocating %d megablock(s) at %p",
                     ret, n, next_request);
#endif

          // unmap this block...
          if (munmap(ret, size) == -1) {
              barf("getMBlock: munmap failed");
          }
          // and do it the hard way
          ret = gen_map_mblocks(size);
      }
  }
  // Next time, we'll try to allocate right after the block we just got.
  // ToDo: check that we haven't already grabbed the memory at next_request
  next_request = ret + size;

  return ret;
}
Esempio n. 8
0
File: OSMem.c Progetto: mboes/ghc
/* Returns 0 if physical memory size cannot be identified */
StgWord64 getPhysicalMemorySize (void)
{
    static StgWord64 physMemSize = 0;
    if (!physMemSize) {
#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
        /* So, darwin doesn't support _SC_PHYS_PAGES, but it does
           support getting the raw memory size in bytes through
           sysctlbyname(hw.memsize); */
        size_t len = sizeof(physMemSize);
        int ret = -1;

        /* Note hw.memsize is in bytes, so no need to multiply by page size. */
        ret = sysctlbyname("hw.memsize", &physMemSize, &len, NULL, 0);
        if (ret == -1) {
            physMemSize = 0;
            return 0;
        }
#else
        /* We'll politely assume we have a system supporting _SC_PHYS_PAGES
         * otherwise.  */
        W_ pageSize = getPageSize();
        long ret = sysconf(_SC_PHYS_PAGES);
        if (ret == -1) {
#if defined(DEBUG)
            errorBelch("warning: getPhysicalMemorySize: cannot get "
                       "physical memory size");
#endif
            return 0;
        }
        physMemSize = ret * pageSize;
#endif /* darwin_HOST_OS */
    }
    return physMemSize;
}
Esempio n. 9
0
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;
}
Esempio n. 10
0
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;
        }
    }
}
Esempio n. 11
0
/*
 * Function: rts_InstallConsoleEvent()
 *
 * Install/remove a console event handler.
 */
int
rts_InstallConsoleEvent(int action, StgStablePtr *handler)
{
    StgInt previous_hdlr = console_handler;

    switch (action) {
    case STG_SIG_IGN:
        console_handler = STG_SIG_IGN;
        if ( !SetConsoleCtrlHandler(NULL, true) ) {
            errorBelch("warning: unable to ignore console events");
        }
        break;
    case STG_SIG_DFL:
        console_handler = STG_SIG_IGN;
        if ( !SetConsoleCtrlHandler(NULL, false) ) {
            errorBelch("warning: unable to restore default console event "
                       "handling");
        }
        break;
    case STG_SIG_HAN:
#ifdef THREADED_RTS
        // handler is stored in an MVar in the threaded RTS
        console_handler = STG_SIG_HAN;
#else
        console_handler = (StgInt)*handler;
#endif
        if (previous_hdlr < 0 || previous_hdlr == STG_SIG_HAN) {
          /* Only install generic_handler() once */
          if ( !SetConsoleCtrlHandler(generic_handler, true) ) {
            errorBelch("warning: unable to install console event handler");
          }
        }
        break;
    }

    if (previous_hdlr == STG_SIG_DFL ||
        previous_hdlr == STG_SIG_IGN ||
        previous_hdlr == STG_SIG_HAN) {
        return previous_hdlr;
    } else {
        if (handler != NULL) {
            *handler = (StgStablePtr)previous_hdlr;
        }
        return STG_SIG_HAN;
    }
}
Esempio n. 12
0
// Used for detecting a non-empty FPU stack on x86 (see #4914)
void checkFPUStack(void)
{
#ifdef x86_HOST_ARCH
    static unsigned char buf[108];
    asm("FSAVE %0":"=m" (buf));

    if(buf[8]!=255 || buf[9]!=255) {
        errorBelch("NONEMPTY FPU Stack, TAG = %x %x\n",buf[8],buf[9]);
        abort();
    }
#endif
}
Esempio n. 13
0
void __unregister_hs_exception_handler( void )
{
    if (__hs_handle != NULL)
    {
        // Should the return value be checked? we're terminating anyway. 
        RemoveVectoredExceptionHandler(__hs_handle);
        __hs_handle = NULL;
    }
    else
    {
        errorBelch("__unregister_hs_exception_handler() called without having called __register_hs_exception_handler() first.");
    }
}
Esempio n. 14
0
void __register_hs_exception_handler( void )
{
    // Allow the VEH handler to be registered only once.
    if (NULL == __hs_handle)
    {
        __hs_handle = AddVectoredExceptionHandler(CALL_FIRST, __hs_exception_handler);
        // should the handler not be registered this will return a null.
        assert(__hs_handle);
    }
    else
    {
        errorBelch("There is no need to call __register_hs_exception_handler() twice, VEH handlers are global per process.");
    }
}
Esempio n. 15
0
void freeMyTask (void)
{
    Task *task;

    task = myTask();

    if (task == NULL) return;

    if (!task->stopped) {
        errorBelch(
            "freeMyTask() called, but the Task is not stopped; ignoring");
        return;
    }

    if (task->worker) {
        errorBelch("freeMyTask() called on a worker; ignoring");
        return;
    }

    ACQUIRE_LOCK(&all_tasks_mutex);

    if (task->all_prev) {
        task->all_prev->all_next = task->all_next;
    } else {
        all_tasks = task->all_next;
    }
    if (task->all_next) {
        task->all_next->all_prev = task->all_prev;
    }

    taskCount--;

    RELEASE_LOCK(&all_tasks_mutex);

    freeTask(task);
    setMyTask(NULL);
}
Esempio n. 16
0
/* Returns 0 if physical memory size cannot be identified */
StgWord64 getPhysicalMemorySize (void)
{
    static StgWord64 physMemSize = 0;
    if (!physMemSize) {
        MEMORYSTATUSEX status;
        status.dwLength = sizeof(status);
        if (!GlobalMemoryStatusEx(&status)) {
#if defined(DEBUG)
            errorBelch("warning: getPhysicalMemorySize: cannot get physical memory size");
#endif
            return 0;
        }
        physMemSize = status.ullTotalPhys;
    }
    return physMemSize;
}
Esempio n. 17
0
/* ---------------------------------------------------------------------------
 * Function:  initCapabilities()
 *
 * Purpose:   set up the Capability handling. For the THREADED_RTS build,
 *            we keep a table of them, the size of which is
 *            controlled by the user via the RTS flag -N.
 *
 * ------------------------------------------------------------------------- */
void
initCapabilities( void )
{
#if defined(THREADED_RTS)
    nat i;

#ifndef REG_Base
    // We can't support multiple CPUs if BaseReg is not a register
    if (RtsFlags.ParFlags.nNodes > 1) {
	errorBelch("warning: multiple CPUs not supported in this build, reverting to 1");
	RtsFlags.ParFlags.nNodes = 1;
    }
#endif

    n_capabilities = RtsFlags.ParFlags.nNodes;

    if (n_capabilities == 1) {
	capabilities = &MainCapability;
	// THREADED_RTS must work on builds that don't have a mutable
	// BaseReg (eg. unregisterised), so in this case
	// capabilities[0] must coincide with &MainCapability.
    } else {
	capabilities = stgMallocBytes(n_capabilities * sizeof(Capability),
				      "initCapabilities");
    }

    for (i = 0; i < n_capabilities; i++) {
	initCapability(&capabilities[i], i);
    }

    debugTrace(DEBUG_sched, "allocated %d capabilities", n_capabilities);

#else /* !THREADED_RTS */

    n_capabilities = 1;
    capabilities = &MainCapability;
    initCapability(&MainCapability, 0);

#endif

    // There are no free capabilities to begin with.  We will start
    // a worker Task to each Capability, which will quickly put the
    // Capability on the free list when it finds nothing to do.
    last_free_capability = &capabilities[0];
}
Esempio n. 18
0
File: Task.c Progetto: Eufavn/ghc
Task *
newBoundTask (void)
{
    Task *task;

    if (!tasksInitialized) {
        errorBelch("newBoundTask: RTS is not initialised; call hs_init() first");
        stg_exit(EXIT_FAILURE);
    }

    task = allocTask();

    task->stopped = rtsFalse;

    newInCall(task);

    debugTrace(DEBUG_sched, "new task (taskCount: %d)", taskCount);
    return task;
}
Esempio n. 19
0
void osBindMBlocksToNode(
    void *addr,
    StgWord size,
    uint32_t node)
{
    if (osNumaAvailable())
    {
        void* temp;
        if (RtsFlags.GcFlags.numa) {
            /* Note [base memory]
               I would like to use addr here to specify the base
               memory of allocation. The problem is that the address
               we are requesting is too high. I can't figure out if it's
               because of my NUMA-emulation or a bug in the code.

               On windows also -xb is broken, it does nothing so that can't
               be used to tweak it (see #12577). So for now, just let the OS decide.
            */
            temp = VirtualAllocExNuma(
                          GetCurrentProcess(),
                          NULL, // addr? See base memory
                          size,
                          MEM_RESERVE | MEM_COMMIT,
                          PAGE_READWRITE,
                          node
                        );

            if (!temp) {
                if (GetLastError() == ERROR_NOT_ENOUGH_MEMORY) {
                    errorBelch("out of memory");
                }
                else {
                    sysErrorBelch(
                        "osBindMBlocksToNode: VirtualAllocExNuma MEM_RESERVE %" FMT_Word " bytes "
                        "at address %p bytes failed",
                                        size, addr);
                }
                stg_exit(EXIT_FAILURE);
            }
        }
    }
}
Esempio n. 20
0
void
sendIOManagerEvent (HsWord32 event)
{
#if defined(THREADED_RTS)
    ACQUIRE_LOCK(&event_buf_mutex);

    // debugBelch("sendIOManagerEvent: %d\n", event);
    if (io_manager_event != INVALID_HANDLE_VALUE) {
        if (next_event == EVENT_BUFSIZ) {
            errorBelch("event buffer overflowed; event dropped");
        } else {
            if (!SetEvent(io_manager_event)) {
                sysErrorBelch("sendIOManagerEvent");
                stg_exit(EXIT_FAILURE);
            }
            event_buf[next_event++] = (StgWord32)event;
        }
    }

    RELEASE_LOCK(&event_buf_mutex);
#endif
}
Esempio n. 21
0
/* ---------------------------------------------------------------------------
 * Function:  initCapabilities()
 *
 * Purpose:   set up the Capability handling. For the THREADED_RTS build,
 *            we keep a table of them, the size of which is
 *            controlled by the user via the RTS flag -N.
 *
 * ------------------------------------------------------------------------- */
void
initCapabilities( void )
{
    /* Declare a couple capability sets representing the process and
       clock domain. Each capability will get added to these capsets. */
    traceCapsetCreate(CAPSET_OSPROCESS_DEFAULT, CapsetTypeOsProcess);
    traceCapsetCreate(CAPSET_CLOCKDOMAIN_DEFAULT, CapsetTypeClockdomain);

#if defined(THREADED_RTS)

#ifndef REG_Base
    // We can't support multiple CPUs if BaseReg is not a register
    if (RtsFlags.ParFlags.nNodes > 1) {
	errorBelch("warning: multiple CPUs not supported in this build, reverting to 1");
	RtsFlags.ParFlags.nNodes = 1;
    }
#endif

    n_capabilities = 0;
    moreCapabilities(0, RtsFlags.ParFlags.nNodes);
    n_capabilities = RtsFlags.ParFlags.nNodes;

#else /* !THREADED_RTS */

    n_capabilities = 1;
    capabilities = stgMallocBytes(sizeof(Capability*), "initCapabilities");
    capabilities[0] = &MainCapability;
    initCapability(&MainCapability, 0);

#endif

    enabled_capabilities = n_capabilities;

    // There are no free capabilities to begin with.  We will start
    // a worker Task to each Capability, which will quickly put the
    // Capability on the free list when it finds nothing to do.
    last_free_capability = capabilities[0];
}
Esempio n. 22
0
/* ---------------------------------------------------------------------------
 * Function:  initCapabilities()
 *
 * Purpose:   set up the Capability handling. For the THREADED_RTS build,
 *            we keep a table of them, the size of which is
 *            controlled by the user via the RTS flag -N.
 *
 * ------------------------------------------------------------------------- */
void initCapabilities (void)
{
    uint32_t i;

    /* Declare a couple capability sets representing the process and
       clock domain. Each capability will get added to these capsets. */
    traceCapsetCreate(CAPSET_OSPROCESS_DEFAULT, CapsetTypeOsProcess);
    traceCapsetCreate(CAPSET_CLOCKDOMAIN_DEFAULT, CapsetTypeClockdomain);

    // Initialise NUMA
    if (!RtsFlags.GcFlags.numa) {
        n_numa_nodes = 1;
        for (i = 0; i < MAX_NUMA_NODES; i++) {
            numa_map[i] = 0;
        }
    } else {
        uint32_t nNodes = osNumaNodes();
        if (nNodes > MAX_NUMA_NODES) {
            barf("Too many NUMA nodes (max %d)", MAX_NUMA_NODES);
        }
        StgWord mask = RtsFlags.GcFlags.numaMask & osNumaMask();
        uint32_t logical = 0, physical = 0;
        for (; physical < MAX_NUMA_NODES; physical++) {
            if (mask & 1) {
                numa_map[logical++] = physical;
            }
            mask = mask >> 1;
        }
        n_numa_nodes = logical;
        if (logical == 0) {
            barf("%s: available NUMA node set is empty");
        }
    }

#if defined(THREADED_RTS)

#ifndef REG_Base
    // We can't support multiple CPUs if BaseReg is not a register
    if (RtsFlags.ParFlags.nCapabilities > 1) {
        errorBelch("warning: multiple CPUs not supported in this build, reverting to 1");
        RtsFlags.ParFlags.nCapabilities = 1;
    }
#endif

    n_capabilities = 0;
    moreCapabilities(0, RtsFlags.ParFlags.nCapabilities);
    n_capabilities = RtsFlags.ParFlags.nCapabilities;

#else /* !THREADED_RTS */

    n_capabilities = 1;
    capabilities = stgMallocBytes(sizeof(Capability*), "initCapabilities");
    capabilities[0] = &MainCapability;

    initCapability(&MainCapability, 0);

#endif

    enabled_capabilities = n_capabilities;

    // There are no free capabilities to begin with.  We will start
    // a worker Task to each Capability, which will quickly put the
    // Capability on the free list when it finds nothing to do.
    for (i = 0; i < n_numa_nodes; i++) {
        last_free_capability[i] = capabilities[0];
    }
}
Esempio n. 23
0
void
initStorage (void)
{
  nat g;

  if (generations != NULL) {
      // multi-init protection
      return;
  }

  initMBlocks();

  /* Sanity check to make sure the LOOKS_LIKE_ macros appear to be
   * doing something reasonable.
   */
  /* We use the NOT_NULL variant or gcc warns that the test is always true */
  ASSERT(LOOKS_LIKE_INFO_PTR_NOT_NULL((StgWord)&stg_BLOCKING_QUEUE_CLEAN_info));
  ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure));
  ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure));
  
  if (RtsFlags.GcFlags.maxHeapSize != 0 &&
      RtsFlags.GcFlags.heapSizeSuggestion > 
      RtsFlags.GcFlags.maxHeapSize) {
      RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
  }

  if (RtsFlags.GcFlags.maxHeapSize != 0 &&
      RtsFlags.GcFlags.minAllocAreaSize > 
      RtsFlags.GcFlags.maxHeapSize) {
      errorBelch("maximum heap size (-M) is smaller than minimum alloc area size (-A)");
      RtsFlags.GcFlags.minAllocAreaSize = RtsFlags.GcFlags.maxHeapSize;
  }

  initBlockAllocator();
  
#if defined(THREADED_RTS)
  initMutex(&sm_mutex);
#endif

  ACQUIRE_SM_LOCK;

  /* allocate generation info array */
  generations = (generation *)stgMallocBytes(RtsFlags.GcFlags.generations 
                                             * sizeof(struct generation_),
                                             "initStorage: gens");

  /* Initialise all generations */
  for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
      initGeneration(&generations[g], g);
  }

  /* A couple of convenience pointers */
  g0 = &generations[0];
  oldest_gen = &generations[RtsFlags.GcFlags.generations-1];

  /* Set up the destination pointers in each younger gen. step */
  for (g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
      generations[g].to = &generations[g+1];
  }
  oldest_gen->to = oldest_gen;
  
  /* The oldest generation has one step. */
  if (RtsFlags.GcFlags.compact || RtsFlags.GcFlags.sweep) {
      if (RtsFlags.GcFlags.generations == 1) {
          errorBelch("WARNING: compact/sweep is incompatible with -G1; disabled");
      } else {
          oldest_gen->mark = 1;
          if (RtsFlags.GcFlags.compact)
              oldest_gen->compact = 1;
      }
  }

  generations[0].max_blocks = 0;

  dyn_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
  debug_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
  revertible_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
   
  /* initialise the allocate() interface */
  large_alloc_lim = RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W;

  exec_block = NULL;

#ifdef THREADED_RTS
  initSpinLock(&gc_alloc_block_sync);
#ifdef PROF_SPIN
  whitehole_spin = 0;
#endif
#endif

  N = 0;

  next_nursery = 0;
  storageAddCapabilities(0, n_capabilities);

  IF_DEBUG(gc, statDescribeGens());

  RELEASE_SM_LOCK;

  traceEventHeapInfo(CAPSET_HEAP_DEFAULT,
                     RtsFlags.GcFlags.generations,
                     RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE_W * sizeof(W_),
                     RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W * sizeof(W_),
                     MBLOCK_SIZE_W * sizeof(W_),
                     BLOCK_SIZE_W  * sizeof(W_));
}
Esempio n. 24
0
void
setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[])
{
    rtsBool error = rtsFalse;
    I_ mode;
    I_ arg, total_arg;

    setProgName (argv);
    total_arg = *argc;
    arg = 1;

    *argc = 1;
    *rts_argc = 0;

    // process arguments from the ghc_rts_opts global variable first.
    // (arguments from the GHCRTS environment variable and the command
    // line override these).
    {
	if (ghc_rts_opts != NULL) {
	    splitRtsFlags(ghc_rts_opts, rts_argc, rts_argv);
	}
    }

    // process arguments from the GHCRTS environment variable next
    // (arguments from the command line override these).
    {
	char *ghc_rts = getenv("GHCRTS");

	if (ghc_rts != NULL) {
            if (rtsOptsEnabled != rtsOptsNone) {
                splitRtsFlags(ghc_rts, rts_argc, rts_argv);
            }
            else {
                errorBelch("Warning: Ignoring GHCRTS variable as RTS options are disabled.\n         Link with -rtsopts to enable them.");
                // We don't actually exit, just warn
            }
	}
    }

    // Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts
    //   argv[0] must be PGM argument -- leave in argv

    for (mode = PGM; arg < total_arg; arg++) {
	// The '--RTS' argument disables all future +RTS ... -RTS processing.
	if (strequal("--RTS", argv[arg])) {
	    arg++;
	    break;
	}
	// The '--' argument is passed through to the program, but
	// disables all further +RTS ... -RTS processing.
	else if (strequal("--", argv[arg])) {
	    break;
	}
	else if (strequal("+RTS", argv[arg])) {
            if (rtsOptsEnabled != rtsOptsNone) {
                mode = RTS;
            }
            else {
                errorBelch("RTS options are disabled. Link with -rtsopts to enable them.");
                stg_exit(EXIT_FAILURE);
            }
	}
	else if (strequal("-RTS", argv[arg])) {
	    mode = PGM;
	}
	else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) {
            rts_argv[(*rts_argc)++] = argv[arg];
        }
        else if (mode == PGM) {
	    argv[(*argc)++] = argv[arg];
	}
	else {
	  barf("too many RTS arguments (max %d)", MAX_RTS_ARGS-1);
	}
    }
    // process remaining program arguments
    for (; arg < total_arg; arg++) {
	argv[(*argc)++] = argv[arg];
    }
    argv[*argc] = (char *) 0;
    rts_argv[*rts_argc] = (char *) 0;

    // Process RTS (rts_argv) part: mainly to determine statsfile
    for (arg = 0; arg < *rts_argc; arg++) {
	if (rts_argv[arg][0] != '-') {
	    fflush(stdout);
	    errorBelch("unexpected RTS argument: %s", rts_argv[arg]);
	    error = rtsTrue;

        } else {

            switch(rts_argv[arg][1]) {
            case '-':
                if (strequal("info", &rts_argv[arg][2])) {
                    printRtsInfo();
                    stg_exit(0);
                }
                break;
            default:
                break;
            }

            if (rtsOptsEnabled != rtsOptsAll)
            {
                errorBelch("Most RTS options are disabled. Link with -rtsopts to enable them.");
                stg_exit(EXIT_FAILURE);
            }

            switch(rts_argv[arg][1]) {

	      /* process: general args, then PROFILING-only ones, then
		 CONCURRENT-only, TICKY-only (same order as defined in
		 RtsFlags.lh); within those groups, mostly in
		 case-insensitive alphabetical order.  Final group is
		 x*, which allows for more options.
	      */

#ifdef TICKY_TICKY
# define TICKY_BUILD_ONLY(x) x
#else
# define TICKY_BUILD_ONLY(x) \
errorBelch("the flag %s requires the program to be built with -ticky", rts_argv[arg]); \
error = rtsTrue;
#endif

#ifdef PROFILING
# define PROFILING_BUILD_ONLY(x)   x
#else
# define PROFILING_BUILD_ONLY(x) \
errorBelch("the flag %s requires the program to be built with -prof", rts_argv[arg]); \
error = rtsTrue;
#endif

#ifdef TRACING
# define TRACING_BUILD_ONLY(x)   x
#else
# define TRACING_BUILD_ONLY(x) \
errorBelch("the flag %s requires the program to be built with -eventlog or -debug", rts_argv[arg]); \
error = rtsTrue;
#endif

#ifdef THREADED_RTS
# define THREADED_BUILD_ONLY(x)      x
#else
# define THREADED_BUILD_ONLY(x) \
errorBelch("the flag %s requires the program to be built with -threaded", rts_argv[arg]); \
error = rtsTrue;
#endif

#ifdef DEBUG
# define DEBUG_BUILD_ONLY(x) x
#else
# define DEBUG_BUILD_ONLY(x) \
errorBelch("the flag %s requires the program to be built with -debug", rts_argv[arg]); \
error = rtsTrue;
#endif

	      /* =========== GENERAL ========================== */
	      case '?':
		error = rtsTrue;
		break;

              /* This isn't going to allow us to keep related options
                 together as we add more --* flags. We really need a
                 proper options parser. */
	      case '-':
                  if (strequal("install-signal-handlers=yes",
                               &rts_argv[arg][2])) {
                      RtsFlags.MiscFlags.install_signal_handlers = rtsTrue;
                  }
                  else if (strequal("install-signal-handlers=no",
                               &rts_argv[arg][2])) {
                      RtsFlags.MiscFlags.install_signal_handlers = rtsFalse;
                  }
                  else if (strequal("machine-readable",
                               &rts_argv[arg][2])) {
                      RtsFlags.MiscFlags.machineReadable = rtsTrue;
                  }
                  else if (strequal("info",
                               &rts_argv[arg][2])) {
                      printRtsInfo();
                      stg_exit(0);
                  }
                  else {
		      errorBelch("unknown RTS option: %s",rts_argv[arg]);
		      error = rtsTrue;
                  }
		  break;
	      case 'A':
                  RtsFlags.GcFlags.minAllocAreaSize
                      = decodeSize(rts_argv[arg], 2, BLOCK_SIZE, HS_INT_MAX)
                           / BLOCK_SIZE;
                  break;

#ifdef USE_PAPI
	      case 'a':
		switch(rts_argv[arg][2]) {
		case '1':
		  RtsFlags.PapiFlags.eventType = PAPI_FLAG_CACHE_L1;
		  break;
		case '2':
		  RtsFlags.PapiFlags.eventType = PAPI_FLAG_CACHE_L2;
		  break;
		case 'b':
		  RtsFlags.PapiFlags.eventType = PAPI_FLAG_BRANCH;
		  break;
		case 's':
		  RtsFlags.PapiFlags.eventType = PAPI_FLAG_STALLS;
		  break;
		case 'e':
		  RtsFlags.PapiFlags.eventType = PAPI_FLAG_CB_EVENTS;
		  break;
                case '+':
                case '#':
                  if (RtsFlags.PapiFlags.numUserEvents >= MAX_PAPI_USER_EVENTS) {
                      errorBelch("maximum number of PAPI events reached");
                      stg_exit(EXIT_FAILURE);
                  }
                  nat eventNum  = RtsFlags.PapiFlags.numUserEvents++;
                  char kind     = rts_argv[arg][2];
                  nat eventKind = kind == '+' ? PAPI_PRESET_EVENT_KIND : PAPI_NATIVE_EVENT_KIND;

                  RtsFlags.PapiFlags.userEvents[eventNum] = rts_argv[arg] + 3;
                  RtsFlags.PapiFlags.eventType = PAPI_USER_EVENTS;
                  RtsFlags.PapiFlags.userEventsKind[eventNum] = eventKind;
                  break;
		default:
		  bad_option( rts_argv[arg] );
		}
		break;
#endif

	      case 'B':
		RtsFlags.GcFlags.ringBell = rtsTrue;
		break;

	      case 'c':
		  if (rts_argv[arg][2] != '\0') {
		      RtsFlags.GcFlags.compactThreshold =
			  atof(rts_argv[arg]+2);
		  } else {
		      RtsFlags.GcFlags.compact = rtsTrue;
		  }
		  break;

              case 'w':
		RtsFlags.GcFlags.sweep = rtsTrue;
		break;

	      case 'F':
	        RtsFlags.GcFlags.oldGenFactor = atof(rts_argv[arg]+2);
	      
		if (RtsFlags.GcFlags.oldGenFactor < 0)
		  bad_option( rts_argv[arg] );
		break;
	      
	      case 'D':
              DEBUG_BUILD_ONLY(
	      { 
		  char *c;

		  for (c  = rts_argv[arg] + 2; *c != '\0'; c++) {
		      switch (*c) {
		      case 's':
			  RtsFlags.DebugFlags.scheduler = rtsTrue;
			  break;
		      case 'i':
			  RtsFlags.DebugFlags.interpreter = rtsTrue;
			  break;
		      case 'w':
			  RtsFlags.DebugFlags.weak = rtsTrue;
			  break;
		      case 'G':
			  RtsFlags.DebugFlags.gccafs = rtsTrue;
			  break;
		      case 'g':
			  RtsFlags.DebugFlags.gc = rtsTrue;
			  break;
		      case 'b':
			  RtsFlags.DebugFlags.block_alloc = rtsTrue;
			  break;
		      case 'S':
			  RtsFlags.DebugFlags.sanity = rtsTrue;
			  break;
		      case 't':
			  RtsFlags.DebugFlags.stable = rtsTrue;
			  break;
		      case 'p':
			  RtsFlags.DebugFlags.prof = rtsTrue;
			  break;
		      case 'l':
			  RtsFlags.DebugFlags.linker = rtsTrue;
			  break;
		      case 'a':
			  RtsFlags.DebugFlags.apply = rtsTrue;
			  break;
		      case 'm':
			  RtsFlags.DebugFlags.stm = rtsTrue;
			  break;
		      case 'z':
			  RtsFlags.DebugFlags.squeeze = rtsTrue;
			  break;
		      case 'c':
			  RtsFlags.DebugFlags.hpc = rtsTrue;
			  break;
		      case 'r':
			  RtsFlags.DebugFlags.sparks = rtsTrue;
			  break;
		      default:
			  bad_option( rts_argv[arg] );
		      }
		  }
                  // -Dx also turns on -v.  Use -l to direct trace
                  // events to the .eventlog file instead.
                  RtsFlags.TraceFlags.tracing = TRACE_STDERR;
	      })
              break;

	      case 'K':
                  RtsFlags.GcFlags.maxStkSize =
                      decodeSize(rts_argv[arg], 2, sizeof(W_), HS_WORD_MAX) / sizeof(W_);
                  break;

	      case 'k':
		switch(rts_argv[arg][2]) {
                case 'c':
                  RtsFlags.GcFlags.stkChunkSize =
                      decodeSize(rts_argv[arg], 3, sizeof(W_), HS_WORD_MAX) / sizeof(W_);
                  break;
                case 'b':
                  RtsFlags.GcFlags.stkChunkBufferSize =
                      decodeSize(rts_argv[arg], 3, sizeof(W_), HS_WORD_MAX) / sizeof(W_);
                  break;
                case 'i':
                  RtsFlags.GcFlags.initialStkSize =
                      decodeSize(rts_argv[arg], 3, sizeof(W_), HS_WORD_MAX) / sizeof(W_);
                  break;
                default:
                  RtsFlags.GcFlags.initialStkSize =
                      decodeSize(rts_argv[arg], 2, sizeof(W_), HS_WORD_MAX) / sizeof(W_);
                  break;
                }
                break;

              case 'M':
                  RtsFlags.GcFlags.maxHeapSize =
                      decodeSize(rts_argv[arg], 2, BLOCK_SIZE, HS_WORD_MAX) / BLOCK_SIZE;
                  /* user give size in *bytes* but "maxHeapSize" is in *blocks* */
                  break;

	      case 'm':
                  RtsFlags.GcFlags.pcFreeHeap = atof(rts_argv[arg]+2);

                  if (RtsFlags.GcFlags.pcFreeHeap < 0 ||
                      RtsFlags.GcFlags.pcFreeHeap > 100)
                      bad_option( rts_argv[arg] );
                  break;

	      case 'G':
                  RtsFlags.GcFlags.generations =
                      decodeSize(rts_argv[arg], 2, 1, HS_INT_MAX);
                  break;

	      case 'H':
                  if (rts_argv[arg][2] == '\0') {
                      RtsFlags.GcFlags.heapSizeSuggestionAuto = rtsTrue;
                  } else {
                      RtsFlags.GcFlags.heapSizeSuggestion =
                          (nat)(decodeSize(rts_argv[arg], 2, BLOCK_SIZE, HS_WORD_MAX) / BLOCK_SIZE);
                  }
                  break;

#ifdef RTS_GTK_FRONTPANEL
	      case 'f':
		  RtsFlags.GcFlags.frontpanel = rtsTrue;
		  break;
#endif

    	      case 'I':	/* idle GC delay */
		if (rts_argv[arg][2] == '\0') {
		  /* use default */
		} else {
		    I_ cst; /* tmp */

		    /* Convert to millisecs */
		    cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
		    RtsFlags.GcFlags.idleGCDelayTime = cst;
		}
		break;

	      case 'S':
		  RtsFlags.GcFlags.giveStats = VERBOSE_GC_STATS;
		  goto stats;

	      case 's':
		  RtsFlags.GcFlags.giveStats = SUMMARY_GC_STATS;
		  goto stats;

	      case 't':
		  RtsFlags.GcFlags.giveStats = ONELINE_GC_STATS;
		  goto stats;

	    stats:
		{ 
		    int r;
		    r = open_stats_file(arg, *argc, argv,
					*rts_argc, rts_argv, NULL,
					&RtsFlags.GcFlags.statsFile);
		    if (r == -1) { error = rtsTrue; }
		}
                break;

	      case 'Z':
		RtsFlags.GcFlags.squeezeUpdFrames = rtsFalse;
		break;

	      /* =========== PROFILING ========================== */

	      case 'P': /* detailed cost centre profiling (time/alloc) */
	      case 'p': /* cost centre profiling (time/alloc) */
		PROFILING_BUILD_ONLY(
		switch (rts_argv[arg][2]) {
		  case 'x':
		    RtsFlags.CcFlags.doCostCentres = COST_CENTRES_XML;
		    break;
		  case 'a':
		    RtsFlags.CcFlags.doCostCentres = COST_CENTRES_ALL;
		    break;
		  default:
		      if (rts_argv[arg][1] == 'P') {
			  RtsFlags.CcFlags.doCostCentres =
			      COST_CENTRES_VERBOSE;
		      } else {
			  RtsFlags.CcFlags.doCostCentres =
			      COST_CENTRES_SUMMARY;
		      }
		      break;
		}
		) break;

	      case 'R':
		  PROFILING_BUILD_ONLY(
		      RtsFlags.ProfFlags.maxRetainerSetSize = atof(rts_argv[arg]+2);
  	          ) break;
	      case 'L':
		  PROFILING_BUILD_ONLY(
		      RtsFlags.ProfFlags.ccsLength = atof(rts_argv[arg]+2);
                      if(RtsFlags.ProfFlags.ccsLength <= 0) {
			bad_option(rts_argv[arg]);
                      }
		  ) break;
Esempio n. 25
0
File: Storage.c Progetto: Sciumo/ghc
void
initStorage( void )
{
    nat g, n;

  if (generations != NULL) {
      // multi-init protection
      return;
  }

  initMBlocks();

  /* Sanity check to make sure the LOOKS_LIKE_ macros appear to be
   * doing something reasonable.
   */
  /* We use the NOT_NULL variant or gcc warns that the test is always true */
  ASSERT(LOOKS_LIKE_INFO_PTR_NOT_NULL((StgWord)&stg_BLOCKING_QUEUE_CLEAN_info));
  ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure));
  ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure));
  
  if (RtsFlags.GcFlags.maxHeapSize != 0 &&
      RtsFlags.GcFlags.heapSizeSuggestion > 
      RtsFlags.GcFlags.maxHeapSize) {
    RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
  }

  if (RtsFlags.GcFlags.maxHeapSize != 0 &&
      RtsFlags.GcFlags.minAllocAreaSize > 
      RtsFlags.GcFlags.maxHeapSize) {
      errorBelch("maximum heap size (-M) is smaller than minimum alloc area size (-A)");
      RtsFlags.GcFlags.minAllocAreaSize = RtsFlags.GcFlags.maxHeapSize;
  }

  initBlockAllocator();
  
#if defined(THREADED_RTS)
  initMutex(&sm_mutex);
#endif

  ACQUIRE_SM_LOCK;

  /* allocate generation info array */
  generations = (generation *)stgMallocBytes(RtsFlags.GcFlags.generations 
					     * sizeof(struct generation_),
					     "initStorage: gens");

  /* Initialise all generations */
  for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
      initGeneration(&generations[g], g);
  }

  /* A couple of convenience pointers */
  g0 = &generations[0];
  oldest_gen = &generations[RtsFlags.GcFlags.generations-1];

  nurseries = stgMallocBytes(n_capabilities * sizeof(struct nursery_),
                             "initStorage: nurseries");
  
  /* Set up the destination pointers in each younger gen. step */
  for (g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
      generations[g].to = &generations[g+1];
  }
  oldest_gen->to = oldest_gen;
  
  /* The oldest generation has one step. */
  if (RtsFlags.GcFlags.compact || RtsFlags.GcFlags.sweep) {
      if (RtsFlags.GcFlags.generations == 1) {
	  errorBelch("WARNING: compact/sweep is incompatible with -G1; disabled");
      } else {
	  oldest_gen->mark = 1;
          if (RtsFlags.GcFlags.compact)
              oldest_gen->compact = 1;
      }
  }

  generations[0].max_blocks = 0;

  /* The allocation area.  Policy: keep the allocation area
   * small to begin with, even if we have a large suggested heap
   * size.  Reason: we're going to do a major collection first, and we
   * don't want it to be a big one.  This vague idea is borne out by 
   * rigorous experimental evidence.
   */
  allocNurseries();

  weak_ptr_list = NULL;
  caf_list = END_OF_STATIC_LIST;
  revertible_caf_list = END_OF_STATIC_LIST;
   
  /* initialise the allocate() interface */
  large_alloc_lim = RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W;

  exec_block = NULL;

#ifdef THREADED_RTS
  initSpinLock(&gc_alloc_block_sync);
  whitehole_spin = 0;
#endif

  N = 0;

  // allocate a block for each mut list
  for (n = 0; n < n_capabilities; n++) {
      for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
          capabilities[n].mut_lists[g] = allocBlock();
      }
  }

  initGcThreads();

  IF_DEBUG(gc, statDescribeGens());

  RELEASE_SM_LOCK;
}
Esempio n. 26
0
File: OSMem.c Progetto: mboes/ghc
static void *
my_mmap (void *addr, W_ size, int operation)
{
    void *ret;

#if darwin_HOST_OS
    // Without MAP_FIXED, Apple's mmap ignores addr.
    // With MAP_FIXED, it overwrites already mapped regions, whic
    // mmap(0, ... MAP_FIXED ...) is worst of all: It unmaps the program text
    // and replaces it with zeroes, causing instant death.
    // This behaviour seems to be conformant with IEEE Std 1003.1-2001.
    // Let's just use the underlying Mach Microkernel calls directly,
    // they're much nicer.

    kern_return_t err = 0;
    ret = addr;

    if(operation & MEM_RESERVE)
    {
        if(addr)    // try to allocate at address
            err = vm_allocate(mach_task_self(),(vm_address_t*) &ret,
                              size, FALSE);
        if(!addr || err)    // try to allocate anywhere
            err = vm_allocate(mach_task_self(),(vm_address_t*) &ret,
                              size, TRUE);
    }

    if(err) {
        // don't know what the error codes mean exactly, assume it's
        // not our problem though.
        errorBelch("memory allocation failed (requested %" FMT_Word " bytes)",
                   size);
        stg_exit(EXIT_FAILURE);
    }

    if(operation & MEM_COMMIT) {
        vm_protect(mach_task_self(), (vm_address_t)ret, size, FALSE,
                   VM_PROT_READ|VM_PROT_WRITE);
    }

#else

    int prot, flags;
    if (operation & MEM_COMMIT)
        prot = PROT_READ | PROT_WRITE;
    else
        prot = PROT_NONE;
    if (operation == MEM_RESERVE)
        flags = MAP_NORESERVE;
    else if (operation == MEM_COMMIT)
        flags = MAP_FIXED;
    else
        flags = 0;

#if defined(irix_HOST_OS)
    {
        if (operation & MEM_RESERVE)
        {
            int fd = open("/dev/zero",O_RDONLY);
            ret = mmap(addr, size, prot, flags | MAP_PRIVATE, fd, 0);
            close(fd);
        }
        else
        {
            ret = mmap(addr, size, prot, flags | MAP_PRIVATE, -1, 0);
        }
    }
#elif hpux_HOST_OS
    ret = mmap(addr, size, prot, flags | MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
#elif linux_HOST_OS
    ret = mmap(addr, size, prot, flags | MAP_ANON | MAP_PRIVATE, -1, 0);
    if (ret == (void *)-1 && errno == EPERM) {
        // Linux may return EPERM if it tried to give us
        // a chunk of address space below mmap_min_addr,
        // See Trac #7500.
        if (addr != 0 && (operation & MEM_RESERVE)) {
            // Try again with no hint address.
            // It's not clear that this can ever actually help,
            // but since our alternative is to abort, we may as well try.
            ret = mmap(0, size, prot, flags | MAP_ANON | MAP_PRIVATE, -1, 0);
        }
        if (ret == (void *)-1 && errno == EPERM) {
            // Linux is not willing to give us any mapping,
            // so treat this as an out-of-memory condition
            // (really out of virtual address space).
            errno = ENOMEM;
        }
    }
#else
    ret = mmap(addr, size, prot, flags | MAP_ANON | MAP_PRIVATE, -1, 0);
#endif
#endif

    if (ret == (void *)-1) {
        if (errno == ENOMEM ||
            (errno == EINVAL && sizeof(void*)==4 && size >= 0xc0000000)) {
            // If we request more than 3Gig, then we get EINVAL
            // instead of ENOMEM (at least on Linux).
            errorBelch("out of memory (requested %" FMT_Word " bytes)", size);
            stg_exit(EXIT_FAILURE);
        } else {
            barf("getMBlock: mmap: %s", strerror(errno));
        }
    }

    return ret;
}
Esempio n. 27
0
/*
 * Function: initDefaultHandlers()
 *
 * Install any default signal/console handlers. Currently we install a
 * Ctrl+C handler that shuts down the RTS in an orderly manner.
 */
void initDefaultHandlers(void)
{
    if ( !SetConsoleCtrlHandler(shutdown_handler, true) ) {
        errorBelch("warning: failed to install default console handler");
    }
}
Esempio n. 28
0
int main (int argc, char *argv[])
{
    testfun *f;
    int i, r;

    RtsConfig conf = defaultRtsConfig;
    conf.rts_opts_enabled = RtsOptsAll;
    hs_init_ghc(&argc, &argv, conf);

    initLinker_(0);

    loadPackages();

    for (i=0; i < ITERATIONS; i++) {
        r = loadObj(OBJPATH);
        if (!r) {
            errorBelch("loadObj(%s) failed", OBJPATH);
            exit(1);
        }
        r = resolveObjs();
        if (!r) {
            errorBelch("resolveObjs failed");
            exit(1);
        }
#if LEADING_UNDERSCORE
        f = lookupSymbol("_f");
#else
        f = lookupSymbol("f");
#endif
        if (!f) {
            errorBelch("lookupSymbol failed");
            exit(1);
        }
        r = f(3);
        if (r != 4) {
            errorBelch("call failed; %d", r);
            exit(1);
        }
        unloadObj(OBJPATH);
        performMajorGC();
        printf("%d ", i);
        fflush(stdout);
    }

    for (i=0; i < ITERATIONS; i++) {
        r = loadObj(OBJPATH);
        if (!r) {
            errorBelch("loadObj(%s) failed", OBJPATH);
            exit(1);
        }
        r = resolveObjs();
        if (!r) {
            errorBelch("resolveObjs failed");
            exit(1);
        }
#if LEADING_UNDERSCORE
        f = lookupSymbol("_f");
#else
        f = lookupSymbol("f");
#endif
        if (!f) {
            errorBelch("lookupSymbol failed");
            exit(1);
        }
        r = f(3);
        if (r != 4) {
            errorBelch("call failed; %d", r);
            exit(1);
        }
        // check that we can purge first, then unload
        purgeObj(OBJPATH);
        performMajorGC();
        unloadObj(OBJPATH);
        performMajorGC();
        printf("%d ", i);
        fflush(stdout);
    }

    hs_exit();
    exit(0);
}
Esempio n. 29
0
void resetDefaultHandlers(void)
{
    if ( !SetConsoleCtrlHandler(shutdown_handler, false) ) {
        errorBelch("warning: failed to uninstall default console handler");
    }
}