158 lines
5.0 KiB
Plaintext
158 lines
5.0 KiB
Plaintext
$OpenBSD: patch-ghc_rts_Adjustor_c,v 1.4 2004/01/08 20:33:23 avsm 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);
|