$OpenBSD: patch-ghc_rts_Adjustor_c,v 1.5 2004/04/26 23:48:50 dons Exp $
Ok. This is the magical "adjustor thunk". The entry point into
Haskell land from C land. Problem is that it (1) uses dynamically
generated code stored on the heap, as well as (2) a nasty little hack
that invovles exec'ing some code in .data. 

Solved (1) by using a StablePtr, avoiding malloc memory
altogether for the adjustor thunk itself.

Solved (2) by writing the assembly to do the code they
were too lazy to put into asm in the first place.

--- ghc/rts/Adjustor.c.orig	Sat Oct 18 12:04:10 2003
+++ ghc/rts/Adjustor.c	Sat Oct 18 12:04:08 2003
@@ -65,10 +65,11 @@
    For this to work we make the assumption that bytes in .data
    are considered executable.
 */
-static unsigned char __obscure_ccall_ret_code [] = 
-  { 0x83, 0xc4, 0x04 /* addl $0x4, %esp */
-  , 0xc3             /* ret */
-  };
+static void __obscure_ccall_ret_code(void) 
+{ 
+	asm("addl $0x4, %esp");
+	asm("ret");
+}
 #endif
 
 #if defined(alpha_TARGET_ARCH)
@@ -77,7 +78,6 @@
 #endif
 
 #if defined(ia64_TARGET_ARCH)
-#include "Storage.h"
 
 /* Layout of a function descriptor */
 typedef struct _IA64FunDesc {
@@ -85,6 +85,10 @@
     StgWord64 gp;
 } IA64FunDesc;
 
+#endif
+
+#include "Storage.h"
+
 static void *
 stgAllocStable(size_t size_in_bytes, StgStablePtr *stable)
 {
@@ -105,7 +109,6 @@
   /* and return a ptr to the goods inside the array */
   return(BYTE_ARR_CTS(arr));
 }
-#endif
 
 void*
 createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
@@ -128,8 +131,13 @@
      <c>: 	ff e0             jmp    %eax        	   # and jump to it.
 		# the callee cleans up the stack
     */
-    if ((adjustor = stgMallocBytes(14, "createAdjustor")) != NULL) {
-	unsigned char *const adj_code = (unsigned char *)adjustor;
+    {
+	StgStablePtr stable;
+	unsigned char *adj_code;
+
+	adjustor = stgAllocStable(18, &stable);
+	adj_code = (unsigned char *)adjustor;
+
 	adj_code[0x00] = (unsigned char)0x58;  /* popl %eax  */
 
 	adj_code[0x01] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
@@ -142,6 +150,8 @@
 
 	adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
 	adj_code[0x0d] = (unsigned char)0xe0;
+
+	*((StgStablePtr*)(adj_code + 0x0e)) = (StgStablePtr)stable;
     }
 #endif
     break;
@@ -172,9 +182,13 @@
     That's (thankfully) the case here with the restricted set of 
     return types that we support.
   */
-    if ((adjustor = stgMallocBytes(17, "createAdjustor")) != NULL) {
-	unsigned char *const adj_code = (unsigned char *)adjustor;
+    {
+	StgStablePtr stable;
+	unsigned char *adj_code;
 
+	adjustor = stgAllocStable(21, &stable);
+	adj_code = (unsigned char *)adjustor;
+
 	adj_code[0x00] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
 	*((StgStablePtr*)(adj_code+0x01)) = (StgStablePtr)hptr;
 
@@ -186,6 +200,8 @@
 
 	adj_code[0x0f] = (unsigned char)0xff; /* jmp *%eax */
 	adj_code[0x10] = (unsigned char)0xe0; 
+
+	*((StgStablePtr*)(adj_code+0x11)) = (StgStablePtr)stable;
     }
 #elif defined(sparc_TARGET_ARCH)
   /* Magic constant computed by inspecting the code length of the following
@@ -217,9 +233,13 @@
      similarly, and local variables should be accessed via %fp, not %sp. In a
      nutshell: This should work! (Famous last words! :-)
   */
-    if ((adjustor = stgMallocBytes(4*(11+1), "createAdjustor")) != NULL) {
-        unsigned long *const adj_code = (unsigned long *)adjustor;
+    {
+	StgStablePtr stable;
+	unsigned long *adj_code;
 
+	adjustor = stgAllocStable(4*(11+2), &stable);
+	adj_code = (unsigned long *)adjustor;
+
         adj_code[ 0]  = 0x9C23A008UL;   /* sub   %sp, 8, %sp         */
         adj_code[ 1]  = 0xDA23A060UL;   /* st    %o5, [%sp + 96]     */
         adj_code[ 2]  = 0xD823A05CUL;   /* st    %o4, [%sp + 92]     */
@@ -237,6 +257,7 @@
         adj_code[10] |= ((unsigned long)hptr) & 0x000003FFUL;
 
         adj_code[11]  = (unsigned long)hptr;
+	adj_code[12]  = (unsigned long)stable;
 
         /* flush cache */
         asm("flush %0" : : "r" (adj_code     ));
@@ -476,12 +497,15 @@
    return;
  }
 
- /* Free the stable pointer first..*/
+ /* Free the internal stable pointer first..*/
  if (*(unsigned char*)ptr == 0x68) { /* Aha, a ccall adjustor! */
     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x01)));
+    freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x11)));
  } else {
     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02)));
+    freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x0e)));
  }    
+ return;
 #elif defined(sparc_TARGET_ARCH)
  if ( *(unsigned long*)ptr != 0x9C23A008UL ) {
    fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
@@ -490,6 +514,8 @@
 
  /* Free the stable pointer first..*/
  freeStablePtr(*((StgStablePtr*)((unsigned long*)ptr + 11)));
+ freeStablePtr(*((StgStablePtr*)((unsigned long*)ptr + 12)));
+ return;
 #elif defined(alpha_TARGET_ARCH)
  if ( *(StgWord64*)ptr != 0xa77b0018a61b0010L ) {
    fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
