From 11a971e9f5ea85766322e332db62387e8f7815fd Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Wed, 12 Nov 2003 17:18:05 +0000
Subject: [PATCH] [project @ 2003-11-12 17:18:05 by sof] win32: Support for
 explicitly setting the execute bit on pages containing code
 that we generate. Not yet enabled.

Starting with SP2, Windows XP will honour newer x86 CPUs
that lets you distinguish between readable and
readable-executable pages.
---
 ghc/rts/Adjustor.c |   67 +++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 66 insertions(+), 1 deletion(-)

diff --git a/ghc/rts/Adjustor.c b/ghc/rts/Adjustor.c
index e9fc769..9187d2b 100644
--- a/ghc/rts/Adjustor.c
+++ b/ghc/rts/Adjustor.c
@@ -40,9 +40,16 @@ Haskell side.
 #include "Rts.h"
 #include "RtsUtils.h"
 #include "RtsFlags.h"
-
 #include <stdlib.h>
 
+#if defined(_WIN32)
+#include <windows.h>
+#endif
+
+#if defined(i386_TARGET_ARCH)
+static rtsBool execPage (void* addr, int writable);
+#endif
+
 /* Heavily arch-specific, I'm afraid.. */
 
 #if defined(i386_TARGET_ARCH)
@@ -146,6 +153,11 @@ createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
 
 	adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
 	adj_code[0x0d] = (unsigned char)0xe0;
+	
+#if 0
+	/* not yet */
+	execPage(adjustor,rtsTrue);
+#endif
     }
 #endif
     break;
@@ -190,6 +202,11 @@ createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
 
 	adj_code[0x0f] = (unsigned char)0xff; /* jmp *%eax */
 	adj_code[0x10] = (unsigned char)0xe0; 
+
+#if 0
+	/* not yet */
+	execPage(adjustor,rtsTrue);
+#endif
     }
 #elif defined(sparc_TARGET_ARCH)
   /* Magic constant computed by inspecting the code length of the following
@@ -527,3 +544,51 @@ freeHaskellFunctionPtr(void* ptr)
  stgFree(ptr);
 }
 
+#if defined(i386_TARGET_ARCH)
+/*
+ * Function: execPage()
+ *
+ * Set the executable bit on page containin
+ */
+static
+rtsBool
+execPage (void* addr, int writable)
+{
+#if defined(_WIN32)
+    SYSTEM_INFO sInfo;
+    DWORD dwOldProtect = 0;
+
+    /* doesn't return a result, so presumably it can't fail... */
+    GetSystemInfo(&sInfo);
+    
+    if ( VirtualProtect ( (void*)((unsigned long)addr & (sInfo.dwPageSize - 1)),
+			  sInfo.dwPageSize,
+			  ( writable ? PAGE_EXECUTE_READWRITE : PAGE_EXECUTE_READ),
+			  &dwOldProtect) == 0 ) {
+# if 1
+	DWORD rc = GetLastError();
+	fprintf(stderr, "execPage: failed to protect 0x%p; error=%lu; old protection: %lu\n", addr, rc, dwOldProtect);
+# endif
+	return rtsFalse;
+    }
+    return rtsTrue;
+#else
+    return rtsTrue;
+#endif
+}
+#endif
+
+/*
+ * Function: initAdjustor()
+ *
+ * Perform initialisation of adjustor thunk layer (if needed.)
+ */
+rtsBool
+initAdjustor(void)
+{
+#if defined(i386_TARGET_ARCH) && defined(_WIN32)
+    return execPage(__obscure_ccall_ret_code, rtsFalse);
+#else
+    return rtsTrue;
+#endif
+}
-- 
1.7.10.4