X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FAdjustor.c;h=0f09743a02ee9040a54e8705daca47a17a0abbb4;hp=841f75c5d02e24522745e3ce2d57271ab46f84bb;hb=a2a67cd520b9841114d69a87a423dabcb3b4368e;hpb=b321da7d6a94582b5d59399a639af1b36e2e7a3b diff --git a/rts/Adjustor.c b/rts/Adjustor.c index 841f75c..0f09743 100644 --- a/rts/Adjustor.c +++ b/rts/Adjustor.c @@ -6,7 +6,7 @@ * ---------------------------------------------------------------------------*/ /* A little bit of background... - + An adjustor thunk is a dynamically allocated code snippet that allows Haskell closures to be viewed as C function pointers. @@ -32,15 +32,102 @@ action. User code should never have to invoke it explicitly. An adjustor thunk differs from a C function pointer in one respect: when the code is through with it, it has to be freed in order to release Haskell -and C resources. Failure to do so result in memory leaks on both the C and +and C resources. Failure to do so will result in memory leaks on both the C and Haskell side. */ #include "PosixSource.h" #include "Rts.h" -#include "RtsExternal.h" + #include "RtsUtils.h" -#include +#include "Stable.h" + +#if defined(USE_LIBFFI_FOR_ADJUSTORS) + +#include "ffi.h" +#include + +void +freeHaskellFunctionPtr(void* ptr) +{ + ffi_closure *cl; + + cl = (ffi_closure*)ptr; + freeStablePtr(cl->user_data); + stgFree(cl->cif->arg_types); + stgFree(cl->cif); + freeExec(cl); +} + +static ffi_type * char_to_ffi_type(char c) +{ + switch (c) { + case 'v': return &ffi_type_void; + case 'f': return &ffi_type_float; + case 'd': return &ffi_type_double; + case 'L': return &ffi_type_sint64; + case 'l': return &ffi_type_uint64; + case 'W': return &ffi_type_sint32; + case 'w': return &ffi_type_uint32; + case 'S': return &ffi_type_sint16; + case 's': return &ffi_type_uint16; + case 'B': return &ffi_type_sint8; + case 'b': return &ffi_type_uint8; + case 'p': return &ffi_type_pointer; + default: barf("char_to_ffi_type: unknown type '%c'", c); + } +} + +void* +createAdjustor (int cconv, + StgStablePtr hptr, + StgFunPtr wptr, + char *typeString) +{ + ffi_cif *cif; + ffi_type **arg_types; + nat n_args, i; + ffi_type *result_type; + ffi_closure *cl; + int r, abi; + void *code; + + n_args = strlen(typeString) - 1; + cif = stgMallocBytes(sizeof(ffi_cif), "createAdjustor"); + arg_types = stgMallocBytes(n_args * sizeof(ffi_type*), "createAdjustor"); + + result_type = char_to_ffi_type(typeString[0]); + for (i=0; i < n_args; i++) { + arg_types[i] = char_to_ffi_type(typeString[i+1]); + } + switch (cconv) { +#ifdef mingw32_TARGET_OS + case 0: /* stdcall */ + abi = FFI_STDCALL; + break; +#endif + case 1: /* ccall */ + abi = FFI_DEFAULT_ABI; + break; + default: + barf("createAdjustor: convention %d not supported on this platform", cconv); + } + + r = ffi_prep_cif(cif, abi, n_args, result_type, arg_types); + if (r != FFI_OK) barf("ffi_prep_cif failed: %d", r); + + cl = allocateExec(sizeof(ffi_closure), &code); + if (cl == NULL) { + barf("createAdjustor: failed to allocate memory"); + } + + r = ffi_prep_closure(cl, cif, (void*)wptr, hptr/*userdata*/); + if (r != FFI_OK) barf("ffi_prep_closure failed: %d", r); + + return (void*)code; +} + +#else // To end of file... #if defined(_WIN32) #include @@ -84,10 +171,6 @@ static void GNUC3_ATTRIBUTE(used) obscure_ccall_wrapper(void) } extern void obscure_ccall_ret_code(void); -#if defined(openbsd_HOST_OS) -static unsigned char *obscure_ccall_ret_code_dyn; -#endif - #endif #if defined(x86_64_HOST_ARCH) @@ -211,7 +294,7 @@ typedef struct AdjustorStub { } AdjustorStub; #endif -#if defined(darwin_HOST_OS) || defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) +#if (defined(i386_HOST_ARCH) && defined(darwin_HOST_OS)) || defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) static int totalArgumentSize(char *typeString) { int sz = 0; @@ -224,6 +307,7 @@ static int totalArgumentSize(char *typeString) // on 32-bit platforms, Double and Int64 occupy two words. case 'd': case 'l': + case 'L': if(sizeof(void*) == 4) { sz += 2; @@ -248,6 +332,7 @@ createAdjustor(int cconv, StgStablePtr hptr, ) { void *adjustor = NULL; + void *code; switch (cconv) { @@ -265,7 +350,7 @@ createAdjustor(int cconv, StgStablePtr hptr, : ff e0 jmp %eax # and jump to it. # the callee cleans up the stack */ - adjustor = allocateExec(14); + adjustor = allocateExec(14,&code); { unsigned char *const adj_code = (unsigned char *)adjustor; adj_code[0x00] = (unsigned char)0x58; /* popl %eax */ @@ -310,7 +395,7 @@ createAdjustor(int cconv, StgStablePtr hptr, That's (thankfully) the case here with the restricted set of return types that we support. */ - adjustor = allocateExec(17); + adjustor = allocateExec(17,&code); { unsigned char *const adj_code = (unsigned char *)adjustor; @@ -322,11 +407,7 @@ createAdjustor(int cconv, StgStablePtr hptr, adj_code[0x0a] = (unsigned char)0x68; /* pushl 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; @@ -339,7 +420,7 @@ createAdjustor(int cconv, StgStablePtr hptr, We offload most of the work to AdjustorAsm.S. */ - AdjustorStub *adjustorStub = allocateExec(sizeof(AdjustorStub)); + AdjustorStub *adjustorStub = allocateExec(sizeof(AdjustorStub),&code); adjustor = adjustorStub; extern void adjustorCode(void); @@ -425,11 +506,6 @@ createAdjustor(int cconv, StgStablePtr hptr, 38: .quad 0 # aligned on 8-byte boundary */ - /* we assume the small code model (gcc -mcmmodel=small) where - * all symbols are <2^32, so hence wptr should fit into 32 bits. - */ - ASSERT(((long)wptr >> 32) == 0); - { int i = 0; char *c; @@ -437,12 +513,12 @@ createAdjustor(int cconv, StgStablePtr hptr, // determine whether we have 6 or more integer arguments, // and therefore need to flush one to the stack. for (c = typeString; *c != '\0'; c++) { - if (*c == 'i' || *c == 'l') i++; + if (*c != 'f' && *c != 'd') i++; if (i == 6) break; } if (i < 6) { - adjustor = allocateExec(0x30); + adjustor = allocateExec(0x30,&code); *(StgInt32 *)adjustor = 0x49c1894d; *(StgInt32 *)(adjustor+0x4) = 0x8948c889; @@ -456,7 +532,7 @@ createAdjustor(int cconv, StgStablePtr hptr, } else { - adjustor = allocateExec(0x40); + adjustor = allocateExec(0x40,&code); *(StgInt32 *)adjustor = 0x35ff5141; *(StgInt32 *)(adjustor+0x4) = 0x00000020; @@ -503,7 +579,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 = allocateExec(4*(11+1)); + adjustor = allocateExec(4*(11+1),&code); { unsigned long *const adj_code = (unsigned long *)adjustor; @@ -580,7 +656,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 = allocateExec(48); + adjustor = allocateExec(48,&code); { StgWord64 *const code = (StgWord64 *)adjustor; @@ -631,48 +707,48 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for src_locs[i] = dst_locs[i] = -32-(fpr++); else { - if(t == 'l' && src_gpr <= 9) + if((t == 'l' || t == 'L') && src_gpr <= 9) { if((src_gpr & 1) == 0) src_gpr++; src_locs[i] = -src_gpr; src_gpr += 2; } - else if(t == 'i' && src_gpr <= 10) + else if((t == 'w' || t == 'W') && src_gpr <= 10) { src_locs[i] = -(src_gpr++); } else { - if(t == 'l' || t == 'd') + if(t == 'l' || t == 'L' || t == 'd') { if(src_offset % 8) src_offset += 4; } src_locs[i] = src_offset; - src_offset += (t == 'l' || t == 'd') ? 8 : 4; + src_offset += (t == 'l' || t == 'L' || t == 'd') ? 8 : 4; } - if(t == 'l' && dst_gpr <= 9) + if((t == 'l' || t == 'L') && dst_gpr <= 9) { if((dst_gpr & 1) == 0) dst_gpr++; dst_locs[i] = -dst_gpr; dst_gpr += 2; } - else if(t == 'i' && dst_gpr <= 10) + else if((t == 'w' || t == 'W') && dst_gpr <= 10) { dst_locs[i] = -(dst_gpr++); } else { - if(t == 'l' || t == 'd') + if(t == 'l' || t == 'L' || t == 'd') { if(dst_offset % 8) dst_offset += 4; } dst_locs[i] = dst_offset; - dst_offset += (t == 'l' || t == 'd') ? 8 : 4; + dst_offset += (t == 'l' || t == 'L' || t == 'd') ? 8 : 4; } } } @@ -685,7 +761,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 = allocateExec(4 * (4*n + 14)); + adjustor = allocateExec(4 * (4*n + 14),&code); code = (unsigned*)adjustor; *code++ = 0x48000008; // b *+8 @@ -714,7 +790,7 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for ASSERT(dst_locs[i] > -32); // dst is in GPR, too. - if(typeString[i] == 'l') + if(typeString[i] == 'l' || typeString[i] == 'L') { // mr dst+1, src+1 *code++ = 0x7c000378 @@ -730,7 +806,7 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for } else { - if(typeString[i] == 'l') + if(typeString[i] == 'l' || typeString[i] == 'L') { // stw src+1, dst_offset+4(r1) *code++ = 0x90010000 @@ -749,7 +825,7 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for ASSERT(dst_locs[i] >= 0); ASSERT(typeString[i] != 'f' && typeString[i] != 'd'); - if(typeString[i] == 'l') + if(typeString[i] == 'l' || typeString[i] == 'L') { // lwz r0, src_offset(r1) *code++ = 0x80010000 @@ -844,7 +920,7 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for #ifdef FUNDESCS adjustorStub = stgMallocBytes(sizeof(AdjustorStub), "createAdjustor"); #else - adjustorStub = allocateExec(sizeof(AdjustorStub)); + adjustorStub = allocateExec(sizeof(AdjustorStub),&code); #endif adjustor = adjustorStub; @@ -1017,7 +1093,7 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for } /* Have fun! */ - return adjustor; + return code; } @@ -1037,7 +1113,7 @@ freeHaskellFunctionPtr(void* ptr) } else { freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02))); } -#elif defined(x86_HOST_ARCH) && defined(darwin_HOST_OS) +#elif defined(i386_HOST_ARCH) && defined(darwin_HOST_OS) if ( *(unsigned char*)ptr != 0xe8 ) { errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); return; @@ -1095,25 +1171,10 @@ if ( *(unsigned char*)ptr != 0xe8 ) { #else ASSERT(0); #endif - *((unsigned char*)ptr) = '\0'; + // Can't write to this memory, it is only executable: + // *((unsigned char*)ptr) = '\0'; freeExec(ptr); } - -/* - * Function: initAdjustor() - * - * Perform initialisation of adjustor thunk layer (if needed.) - */ -void -initAdjustor(void) -{ -#if defined(i386_HOST_ARCH) && defined(openbsd_HOST_OS) - obscure_ccall_ret_code_dyn = allocateExec(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 -} +#endif // !USE_LIBFFI_FOR_ADJUSTORS