[project @ 2005-08-02 14:58:40 by simonmar]
[ghc-hetmet.git] / ghc / rts / Adjustor.c
index 13c66ca..ea4923a 100644 (file)
@@ -46,59 +46,15 @@ Haskell side.
 #include <windows.h>
 #endif
 
-#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS)
-#include <unistd.h>
-#include <sys/types.h>
-#include <sys/mman.h>
-
-/* no C99 header stdint.h on OpenBSD? */
-#if defined(openbsd_HOST_OS)
-typedef unsigned long my_uintptr_t;
-#else
-#include <stdint.h>
-typedef uintptr_t my_uintptr_t;
-#endif
-#endif
-
 #if defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)
 #include <string.h>
 #endif
 
-/* Heavily arch-specific, I'm afraid.. */
-
-/*
- * Allocate len bytes which are readable, writable, and executable.
- *
- * ToDo: If this turns out to be a performance bottleneck, one could
- * e.g. cache the last VirtualProtect/mprotect-ed region and do
- * nothing in case of a cache hit.
- */
-static void*
-mallocBytesRWX(int len)
-{
-  void *addr = stgMallocBytes(len, "mallocBytesRWX");
-#if defined(i386_HOST_ARCH) && defined(_WIN32)
-  /* This could be necessary for processors which distinguish between READ and
-     EXECUTE memory accesses, e.g. Itaniums. */
-  DWORD dwOldProtect = 0;
-  if (VirtualProtect (addr, len, PAGE_EXECUTE_READWRITE, &dwOldProtect) == 0) {
-    barf("mallocBytesRWX: failed to protect 0x%p; error=%lu; old protection: %lu\n",
-         addr, (unsigned long)GetLastError(), (unsigned long)dwOldProtect);
-  }
-#elif defined(openbsd_HOST_OS) || defined(linux_HOST_OS)
-  /* malloced memory isn't executable by default on OpenBSD */
-  my_uintptr_t pageSize         = sysconf(_SC_PAGESIZE);
-  my_uintptr_t mask             = ~(pageSize - 1);
-  my_uintptr_t startOfFirstPage = ((my_uintptr_t)addr          ) & mask;
-  my_uintptr_t startOfLastPage  = ((my_uintptr_t)addr + len - 1) & mask;
-  my_uintptr_t size             = startOfLastPage - startOfFirstPage + pageSize;
-  if (mprotect((void*)startOfFirstPage, (size_t)size, PROT_EXEC | PROT_READ | PROT_WRITE) != 0) {
-    barf("mallocBytesRWX: failed to protect 0x%p\n", addr);
-  }
+#ifdef LEADING_UNDERSCORE
+#define UNDERSCORE "_"
+#else 
+#define UNDERSCORE ""
 #endif
-  return addr;
-}
-
 #if defined(i386_HOST_ARCH)
 /* 
   Now here's something obscure for you:
@@ -117,22 +73,33 @@ mallocBytesRWX(int len)
   returning in some static piece of memory and arrange
   to return to it before tail jumping from the adjustor thunk.
 */
-__asm__ (
-   ".globl obscure_ccall_ret_code\n"
-   "obscure_ccall_ret_code:\n\t"
-   "addl $0x4, %esp\n\t"
-   "ret"
-  );
+static void  GNUC3_ATTRIBUTE(used) obscure_ccall_wrapper(void)
+{
+  __asm__ (
+     ".globl " UNDERSCORE "obscure_ccall_ret_code\n"
+     UNDERSCORE "obscure_ccall_ret_code:\n\t"
+     "addl $0x4, %esp\n\t"
+     "ret"
+   );
+}
 extern void obscure_ccall_ret_code(void);
+
+#if defined(openbsd_HOST_OS)
+static unsigned char *obscure_ccall_ret_code_dyn;
 #endif
 
-#if defined(x86_64_TARGET_ARCH)
-__asm__ (
-   ".globl obscure_ccall_ret_code\n"
-   "obscure_ccall_ret_code:\n\t"
+#endif
+
+#if defined(x86_64_HOST_ARCH)
+static void GNUC3_ATTRIBUTE(used) obscure_ccall_wrapper(void)
+{
+  __asm__ (
+   ".globl " UNDERSCORE "obscure_ccall_ret_code\n"
+   UNDERSCORE "obscure_ccall_ret_code:\n\t"
    "addq $0x8, %rsp\n\t"
    "ret"
   );
+}
 extern void obscure_ccall_ret_code(void);
 #endif
 
@@ -172,7 +139,7 @@ stgAllocStable(size_t size_in_bytes, StgStablePtr *stable)
   *stable = getStablePtr((StgPtr)arr);
 
   /* and return a ptr to the goods inside the array */
-  return(BYTE_ARR_CTS(arr));
+  return(&(arr->payload));
 }
 #endif
 
@@ -233,7 +200,7 @@ void*
 createAdjustor(int cconv, StgStablePtr hptr,
               StgFunPtr wptr,
               char *typeString
-#if !defined(powerpc_HOST_ARCH) && !defined(powerpc64_HOST_ARCH) && !defined(x86_64_TARGET_ARCH)
+#if !defined(powerpc_HOST_ARCH) && !defined(powerpc64_HOST_ARCH) && !defined(x86_64_HOST_ARCH)
                  STG_UNUSED
 #endif
               )
@@ -256,7 +223,7 @@ createAdjustor(int cconv, StgStablePtr hptr,
      <c>:      ff e0             jmp    %eax              # and jump to it.
                # the callee cleans up the stack
     */
-    adjustor = mallocBytesRWX(14);
+    adjustor = stgMallocBytesRWX(14);
     {
        unsigned char *const adj_code = (unsigned char *)adjustor;
        adj_code[0x00] = (unsigned char)0x58;  /* popl %eax  */
@@ -301,7 +268,7 @@ createAdjustor(int cconv, StgStablePtr hptr,
     That's (thankfully) the case here with the restricted set of 
     return types that we support.
   */
-    adjustor = mallocBytesRWX(17);
+    adjustor = stgMallocBytesRWX(17);
     {
        unsigned char *const adj_code = (unsigned char *)adjustor;
 
@@ -312,7 +279,12 @@ createAdjustor(int cconv, StgStablePtr hptr,
        *((StgFunPtr*)(adj_code + 0x06)) = (StgFunPtr)wptr;
 
        adj_code[0x0a] = (unsigned char)0x68;  /* pushl obscure_ccall_ret_code */
-       *((StgFunPtr*)(adj_code + 0x0b)) = (StgFunPtr)obscure_ccall_ret_code;
+       *((StgFunPtr*)(adj_code + 0x0b)) = 
+#if !defined(openbsd_HOST_OS)
+                       (StgFunPtr)obscure_ccall_ret_code;
+#else
+                       (StgFunPtr)obscure_ccall_ret_code_dyn;
+#endif
 
        adj_code[0x0f] = (unsigned char)0xff; /* jmp *%eax */
        adj_code[0x10] = (unsigned char)0xe0; 
@@ -389,7 +361,7 @@ createAdjustor(int cconv, StgStablePtr hptr,
        }
 
        if (i < 6) {
-           adjustor = mallocBytesRWX(40);
+           adjustor = stgMallocBytesRWX(40);
 
            *(StgInt32 *)adjustor      = 0x49c1894d;
            *(StgInt32 *)(adjustor+4)  = 0x8948c889;
@@ -404,7 +376,7 @@ createAdjustor(int cconv, StgStablePtr hptr,
        }
        else
        {
-           adjustor = mallocBytesRWX(48);
+           adjustor = stgMallocBytesRWX(48);
 
            *(StgInt32 *)adjustor      = 0x00685141;
            *(StgInt32 *)(adjustor+4)  = 0x4d000000;
@@ -452,7 +424,7 @@ createAdjustor(int cconv, StgStablePtr hptr,
      similarly, and local variables should be accessed via %fp, not %sp. In a
      nutshell: This should work! (Famous last words! :-)
   */
-    adjustor = mallocBytesRWX(4*(11+1));
+    adjustor = stgMallocBytesRWX(4*(11+1));
     {
         unsigned long *const adj_code = (unsigned long *)adjustor;
 
@@ -529,7 +501,7 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for
       4 bytes (getting rid of the nop), hence saving memory. [ccshan]
   */
     ASSERT(((StgWord64)wptr & 3) == 0);
-    adjustor = mallocBytesRWX(48);
+    adjustor = stgMallocBytesRWX(48);
     {
        StgWord64 *const code = (StgWord64 *)adjustor;
 
@@ -634,7 +606,7 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for
             */
                     // allocate space for at most 4 insns per parameter
                     // plus 14 more instructions.
-        adjustor = mallocBytesRWX(4 * (4*n + 14));
+        adjustor = stgMallocBytesRWX(4 * (4*n + 14));
         code = (unsigned*)adjustor;
         
         *code++ = 0x48000008; // b *+8
@@ -793,7 +765,7 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for
 #ifdef FUNDESCS
         adjustorStub = stgMallocBytes(sizeof(AdjustorStub), "createAdjustor");
 #else
-        adjustorStub = mallocBytesRWX(sizeof(AdjustorStub));
+        adjustorStub = stgMallocBytesRWX(sizeof(AdjustorStub));
 #endif
         adjustor = adjustorStub;
             
@@ -1058,4 +1030,11 @@ freeHaskellFunctionPtr(void* ptr)
 void
 initAdjustor(void)
 {
+#if defined(i386_HOST_ARCH) && defined(openbsd_HOST_OS)
+    obscure_ccall_ret_code_dyn = stgMallocBytesRWX(4);
+    obscure_ccall_ret_code_dyn[0] = ((unsigned char *)obscure_ccall_ret_code)[0];
+    obscure_ccall_ret_code_dyn[1] = ((unsigned char *)obscure_ccall_ret_code)[1];
+    obscure_ccall_ret_code_dyn[2] = ((unsigned char *)obscure_ccall_ret_code)[2];
+    obscure_ccall_ret_code_dyn[3] = ((unsigned char *)obscure_ccall_ret_code)[3];
+#endif
 }