1 /* -----------------------------------------------------------------------------
2 * Foreign export adjustor thunks
6 * ---------------------------------------------------------------------------*/
8 /* A little bit of background...
10 An adjustor thunk is a dynamically allocated code snippet that allows
11 Haskell closures to be viewed as C function pointers.
13 Stable pointers provide a way for the outside world to get access to,
14 and evaluate, Haskell heap objects, with the RTS providing a small
15 range of ops for doing so. So, assuming we've got a stable pointer in
16 our hand in C, we can jump into the Haskell world and evaluate a callback
17 procedure, say. This works OK in some cases where callbacks are used, but
18 does require the external code to know about stable pointers and how to deal
19 with them. We'd like to hide the Haskell-nature of a callback and have it
20 be invoked just like any other C function pointer.
22 Enter adjustor thunks. An adjustor thunk is a little piece of code
23 that's generated on-the-fly (one per Haskell closure being exported)
24 that, when entered using some 'universal' calling convention (e.g., the
25 C calling convention on platform X), pushes an implicit stable pointer
26 (to the Haskell callback) before calling another (static) C function stub
27 which takes care of entering the Haskell code via its stable pointer.
29 An adjustor thunk is allocated on the C heap, and is called from within
30 Haskell just before handing out the function pointer to the Haskell (IO)
31 action. User code should never have to invoke it explicitly.
33 An adjustor thunk differs from a C function pointer in one respect: when
34 the code is through with it, it has to be freed in order to release Haskell
35 and C resources. Failure to do so result in memory leaks on both the C and
39 #include "PosixSource.h"
41 #include "RtsExternal.h"
49 #if defined(openbsd_HOST_OS) || defined(linux_HOST_OS)
51 #include <sys/types.h>
54 /* no C99 header stdint.h on OpenBSD? */
55 #if defined(openbsd_HOST_OS)
56 typedef unsigned long my_uintptr_t;
59 typedef uintptr_t my_uintptr_t;
63 #if defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)
67 /* Heavily arch-specific, I'm afraid.. */
70 * Allocate len bytes which are readable, writable, and executable.
72 * ToDo: If this turns out to be a performance bottleneck, one could
73 * e.g. cache the last VirtualProtect/mprotect-ed region and do
74 * nothing in case of a cache hit.
77 mallocBytesRWX(int len)
79 void *addr = stgMallocBytes(len, "mallocBytesRWX");
80 #if defined(i386_HOST_ARCH) && defined(_WIN32)
81 /* This could be necessary for processors which distinguish between READ and
82 EXECUTE memory accesses, e.g. Itaniums. */
83 DWORD dwOldProtect = 0;
84 if (VirtualProtect (addr, len, PAGE_EXECUTE_READWRITE, &dwOldProtect) == 0) {
85 barf("mallocBytesRWX: failed to protect 0x%p; error=%lu; old protection: %lu\n",
86 addr, (unsigned long)GetLastError(), (unsigned long)dwOldProtect);
88 #elif defined(openbsd_HOST_OS) || defined(linux_HOST_OS)
89 /* malloced memory isn't executable by default on OpenBSD */
90 my_uintptr_t pageSize = sysconf(_SC_PAGESIZE);
91 my_uintptr_t mask = ~(pageSize - 1);
92 my_uintptr_t startOfFirstPage = ((my_uintptr_t)addr ) & mask;
93 my_uintptr_t startOfLastPage = ((my_uintptr_t)addr + len - 1) & mask;
94 my_uintptr_t size = startOfLastPage - startOfFirstPage + pageSize;
95 if (mprotect((void*)startOfFirstPage, (size_t)size, PROT_EXEC | PROT_READ | PROT_WRITE) != 0) {
96 barf("mallocBytesRWX: failed to protect 0x%p\n", addr);
102 #ifdef LEADING_UNDERSCORE
103 #define UNDERSCORE "_"
105 #define UNDERSCORE ""
107 #if defined(i386_HOST_ARCH)
109 Now here's something obscure for you:
111 When generating an adjustor thunk that uses the C calling
112 convention, we have to make sure that the thunk kicks off
113 the process of jumping into Haskell with a tail jump. Why?
114 Because as a result of jumping in into Haskell we may end
115 up freeing the very adjustor thunk we came from using
116 freeHaskellFunctionPtr(). Hence, we better not return to
117 the adjustor code on our way out, since it could by then
120 The fix is readily at hand, just include the opcodes
121 for the C stack fixup code that we need to perform when
122 returning in some static piece of memory and arrange
123 to return to it before tail jumping from the adjustor thunk.
126 ".globl " UNDERSCORE "obscure_ccall_ret_code\n"
127 UNDERSCORE "obscure_ccall_ret_code:\n\t"
128 "addl $0x4, %esp\n\t"
131 extern void obscure_ccall_ret_code(void);
134 #if defined(x86_64_HOST_ARCH)
136 ".globl " UNDERSCORE "obscure_ccall_ret_code\n"
137 UNDERSCORE "obscure_ccall_ret_code:\n\t"
138 "addq $0x8, %rsp\n\t"
141 extern void obscure_ccall_ret_code(void);
144 #if defined(alpha_HOST_ARCH)
145 /* To get the definition of PAL_imb: */
146 # if defined(linux_HOST_OS)
147 # include <asm/pal.h>
149 # include <machine/pal.h>
153 #if defined(ia64_HOST_ARCH)
156 /* Layout of a function descriptor */
157 typedef struct _IA64FunDesc {
163 stgAllocStable(size_t size_in_bytes, StgStablePtr *stable)
166 nat data_size_in_words, total_size_in_words;
168 /* round up to a whole number of words */
169 data_size_in_words = (size_in_bytes + sizeof(W_) + 1) / sizeof(W_);
170 total_size_in_words = sizeofW(StgArrWords) + data_size_in_words;
172 /* allocate and fill it in */
173 arr = (StgArrWords *)allocate(total_size_in_words);
174 SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words);
176 /* obtain a stable ptr */
177 *stable = getStablePtr((StgPtr)arr);
179 /* and return a ptr to the goods inside the array */
180 return(BYTE_ARR_CTS(arr));
184 #if defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)
185 __asm__("obscure_ccall_ret_code:\n\t"
190 extern void obscure_ccall_ret_code(void);
193 #if defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH)
194 #if !(defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS))
196 /* !!! !!! WARNING: !!! !!!
197 * This structure is accessed from AdjustorAsm.s
198 * Any changes here have to be mirrored in the offsets there.
201 typedef struct AdjustorStub {
202 #if defined(powerpc_HOST_ARCH) && defined(darwin_HOST_OS)
209 #elif defined(powerpc64_HOST_ARCH) && defined(darwin_HOST_OS)
210 /* powerpc64-darwin: just guessing that it won't use fundescs. */
221 /* fundesc-based ABIs */
230 StgInt negative_framesize;
231 StgInt extrawords_plus_one;
238 createAdjustor(int cconv, StgStablePtr hptr,
241 #if !defined(powerpc_HOST_ARCH) && !defined(powerpc64_HOST_ARCH) && !defined(x86_64_HOST_ARCH)
246 void *adjustor = NULL;
250 case 0: /* _stdcall */
251 #if defined(i386_HOST_ARCH)
252 /* Magic constant computed by inspecting the code length of
253 the following assembly language snippet
254 (offset and machine code prefixed):
256 <0>: 58 popl %eax # temp. remove ret addr..
257 <1>: 68 fd fc fe fa pushl 0xfafefcfd # constant is large enough to
258 # hold a StgStablePtr
259 <6>: 50 pushl %eax # put back ret. addr
260 <7>: b8 fa ef ff 00 movl $0x00ffeffa, %eax # load up wptr
261 <c>: ff e0 jmp %eax # and jump to it.
262 # the callee cleans up the stack
264 adjustor = mallocBytesRWX(14);
266 unsigned char *const adj_code = (unsigned char *)adjustor;
267 adj_code[0x00] = (unsigned char)0x58; /* popl %eax */
269 adj_code[0x01] = (unsigned char)0x68; /* pushl hptr (which is a dword immediate ) */
270 *((StgStablePtr*)(adj_code + 0x02)) = (StgStablePtr)hptr;
272 adj_code[0x06] = (unsigned char)0x50; /* pushl %eax */
274 adj_code[0x07] = (unsigned char)0xb8; /* movl $wptr, %eax */
275 *((StgFunPtr*)(adj_code + 0x08)) = (StgFunPtr)wptr;
277 adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
278 adj_code[0x0d] = (unsigned char)0xe0;
284 #if defined(i386_HOST_ARCH)
285 /* Magic constant computed by inspecting the code length of
286 the following assembly language snippet
287 (offset and machine code prefixed):
289 <00>: 68 ef be ad de pushl $0xdeadbeef # constant is large enough to
290 # hold a StgStablePtr
291 <05>: b8 fa ef ff 00 movl $0x00ffeffa, %eax # load up wptr
292 <0a>: 68 ef be ad de pushl $obscure_ccall_ret_code # push the return address
293 <0f>: ff e0 jmp *%eax # jump to wptr
295 The ccall'ing version is a tad different, passing in the return
296 address of the caller to the auto-generated C stub (which enters
297 via the stable pointer.) (The auto-generated C stub is in on this
298 game, don't worry :-)
300 See the comment next to obscure_ccall_ret_code why we need to
301 perform a tail jump instead of a call, followed by some C stack
304 Note: The adjustor makes the assumption that any return value
305 coming back from the C stub is not stored on the stack.
306 That's (thankfully) the case here with the restricted set of
307 return types that we support.
309 adjustor = mallocBytesRWX(17);
311 unsigned char *const adj_code = (unsigned char *)adjustor;
313 adj_code[0x00] = (unsigned char)0x68; /* pushl hptr (which is a dword immediate ) */
314 *((StgStablePtr*)(adj_code+0x01)) = (StgStablePtr)hptr;
316 adj_code[0x05] = (unsigned char)0xb8; /* movl $wptr, %eax */
317 *((StgFunPtr*)(adj_code + 0x06)) = (StgFunPtr)wptr;
319 adj_code[0x0a] = (unsigned char)0x68; /* pushl obscure_ccall_ret_code */
320 *((StgFunPtr*)(adj_code + 0x0b)) = (StgFunPtr)obscure_ccall_ret_code;
322 adj_code[0x0f] = (unsigned char)0xff; /* jmp *%eax */
323 adj_code[0x10] = (unsigned char)0xe0;
325 #elif defined(x86_64_HOST_ARCH)
332 %rdi,%rsi,%rdx,%rcx,%r8,%r9 = arg0..arg6
334 if there are <6 integer args, then we can just push the
335 StablePtr into %edi and shuffle the other args up.
337 If there are >=6 integer args, then we have to flush one arg
338 to the stack, and arrange to adjust the stack ptr on return.
339 The stack will be rearranged to this:
344 return address *** <-- dummy arg in stub fn.
346 obscure_ccall_ret_code
348 This unfortunately means that the type of the stub function
349 must have a dummy argument for the original return address
350 pointer inserted just after the 6th integer argument.
352 Code for the simple case:
354 0: 4d 89 c1 mov %r8,%r9
355 3: 49 89 c8 mov %rcx,%r8
356 6: 48 89 d1 mov %rdx,%rcx
357 9: 48 89 f2 mov %rsi,%rdx
358 c: 48 89 fe mov %rdi,%rsi
359 f: 48 8b 3d 0a 00 00 00 mov 10(%rip),%rdi
360 16: e9 00 00 00 00 jmpq stub_function
362 20: .quad 0 # aligned on 8-byte boundary
365 And the version for >=6 integer arguments:
368 2: 68 00 00 00 00 pushq $obscure_ccall_ret_code
369 7: 4d 89 c1 mov %r8,%r9
370 a: 49 89 c8 mov %rcx,%r8
371 d: 48 89 d1 mov %rdx,%rcx
372 10: 48 89 f2 mov %rsi,%rdx
373 13: 48 89 fe mov %rdi,%rsi
374 16: 48 8b 3d 0b 00 00 00 mov 11(%rip),%rdi
375 1d: e9 00 00 00 00 jmpq stub_function
377 28: .quad 0 # aligned on 8-byte boundary
380 /* we assume the small code model (gcc -mcmmodel=small) where
381 * all symbols are <2^32, so hence wptr should fit into 32 bits.
383 ASSERT(((long)wptr >> 32) == 0);
389 // determine whether we have 6 or more integer arguments,
390 // and therefore need to flush one to the stack.
391 for (c = typeString; *c != '\0'; c++) {
392 if (*c == 'i' || *c == 'l') i++;
397 adjustor = mallocBytesRWX(40);
399 *(StgInt32 *)adjustor = 0x49c1894d;
400 *(StgInt32 *)(adjustor+4) = 0x8948c889;
401 *(StgInt32 *)(adjustor+8) = 0xf28948d1;
402 *(StgInt32 *)(adjustor+12) = 0x48fe8948;
403 *(StgInt32 *)(adjustor+16) = 0x000a3d8b;
404 *(StgInt32 *)(adjustor+20) = 0x00e90000;
406 *(StgInt32 *)(adjustor+23) =
407 (StgInt32)((StgInt64)wptr - (StgInt64)adjustor - 27);
408 *(StgInt64 *)(adjustor+32) = (StgInt64)hptr;
412 adjustor = mallocBytesRWX(48);
414 *(StgInt32 *)adjustor = 0x00685141;
415 *(StgInt32 *)(adjustor+4) = 0x4d000000;
416 *(StgInt32 *)(adjustor+8) = 0x8949c189;
417 *(StgInt32 *)(adjustor+12) = 0xd18948c8;
418 *(StgInt32 *)(adjustor+16) = 0x48f28948;
419 *(StgInt32 *)(adjustor+20) = 0x8b48fe89;
420 *(StgInt32 *)(adjustor+24) = 0x00000b3d;
421 *(StgInt32 *)(adjustor+28) = 0x0000e900;
423 *(StgInt32 *)(adjustor+3) =
424 (StgInt32)(StgInt64)obscure_ccall_ret_code;
425 *(StgInt32 *)(adjustor+30) =
426 (StgInt32)((StgInt64)wptr - (StgInt64)adjustor - 34);
427 *(StgInt64 *)(adjustor+40) = (StgInt64)hptr;
430 #elif defined(sparc_HOST_ARCH)
431 /* Magic constant computed by inspecting the code length of the following
432 assembly language snippet (offset and machine code prefixed):
434 <00>: 9C23A008 sub %sp, 8, %sp ! make room for %o4/%o5 in caller's frame
435 <04>: DA23A060 st %o5, [%sp + 96] ! shift registers by 2 positions
436 <08>: D823A05C st %o4, [%sp + 92]
437 <0C>: 9A10000B mov %o3, %o5
438 <10>: 9810000A mov %o2, %o4
439 <14>: 96100009 mov %o1, %o3
440 <18>: 94100008 mov %o0, %o2
441 <1C>: 13000000 sethi %hi(wptr), %o1 ! load up wptr (1 of 2)
442 <20>: 11000000 sethi %hi(hptr), %o0 ! load up hptr (1 of 2)
443 <24>: 81C26000 jmp %o1 + %lo(wptr) ! jump to wptr (load 2 of 2)
444 <28>: 90122000 or %o0, %lo(hptr), %o0 ! load up hptr (2 of 2, delay slot)
445 <2C> 00000000 ! place for getting hptr back easily
447 ccall'ing on SPARC is easy, because we are quite lucky to push a
448 multiple of 8 bytes (1 word hptr + 1 word dummy arg) in front of the
449 existing arguments (note that %sp must stay double-word aligned at
450 all times, see ABI spec at http://www.sparc.org/standards/psABI3rd.pdf).
451 To do this, we extend the *caller's* stack frame by 2 words and shift
452 the output registers used for argument passing (%o0 - %o5, we are a *leaf*
453 procedure because of the tail-jump) by 2 positions. This makes room in
454 %o0 and %o1 for the additinal arguments, namely hptr and a dummy (used
455 for destination addr of jump on SPARC, return address on x86, ...). This
456 shouldn't cause any problems for a C-like caller: alloca is implemented
457 similarly, and local variables should be accessed via %fp, not %sp. In a
458 nutshell: This should work! (Famous last words! :-)
460 adjustor = mallocBytesRWX(4*(11+1));
462 unsigned long *const adj_code = (unsigned long *)adjustor;
464 adj_code[ 0] = 0x9C23A008UL; /* sub %sp, 8, %sp */
465 adj_code[ 1] = 0xDA23A060UL; /* st %o5, [%sp + 96] */
466 adj_code[ 2] = 0xD823A05CUL; /* st %o4, [%sp + 92] */
467 adj_code[ 3] = 0x9A10000BUL; /* mov %o3, %o5 */
468 adj_code[ 4] = 0x9810000AUL; /* mov %o2, %o4 */
469 adj_code[ 5] = 0x96100009UL; /* mov %o1, %o3 */
470 adj_code[ 6] = 0x94100008UL; /* mov %o0, %o2 */
471 adj_code[ 7] = 0x13000000UL; /* sethi %hi(wptr), %o1 */
472 adj_code[ 7] |= ((unsigned long)wptr) >> 10;
473 adj_code[ 8] = 0x11000000UL; /* sethi %hi(hptr), %o0 */
474 adj_code[ 8] |= ((unsigned long)hptr) >> 10;
475 adj_code[ 9] = 0x81C26000UL; /* jmp %o1 + %lo(wptr) */
476 adj_code[ 9] |= ((unsigned long)wptr) & 0x000003FFUL;
477 adj_code[10] = 0x90122000UL; /* or %o0, %lo(hptr), %o0 */
478 adj_code[10] |= ((unsigned long)hptr) & 0x000003FFUL;
480 adj_code[11] = (unsigned long)hptr;
483 asm("flush %0" : : "r" (adj_code ));
484 asm("flush %0" : : "r" (adj_code + 2));
485 asm("flush %0" : : "r" (adj_code + 4));
486 asm("flush %0" : : "r" (adj_code + 6));
487 asm("flush %0" : : "r" (adj_code + 10));
489 /* max. 5 instructions latency, and we need at >= 1 for returning */
495 #elif defined(alpha_HOST_ARCH)
496 /* Magic constant computed by inspecting the code length of
497 the following assembly language snippet
498 (offset and machine code prefixed; note that the machine code
499 shown is longwords stored in little-endian order):
501 <00>: 46520414 mov a2, a4
502 <04>: 46100412 mov a0, a2
503 <08>: a61b0020 ldq a0, 0x20(pv) # load up hptr
504 <0c>: 46730415 mov a3, a5
505 <10>: a77b0028 ldq pv, 0x28(pv) # load up wptr
506 <14>: 46310413 mov a1, a3
507 <18>: 6bfb---- jmp (pv), <hint> # jump to wptr (with hint)
508 <1c>: 00000000 # padding for alignment
509 <20>: [8 bytes for hptr quadword]
510 <28>: [8 bytes for wptr quadword]
512 The "computed" jump at <08> above is really a jump to a fixed
513 location. Accordingly, we place an always-correct hint in the
514 jump instruction, namely the address offset from <0c> to wptr,
515 divided by 4, taking the lowest 14 bits.
517 We only support passing 4 or fewer argument words, for the same
518 reason described under sparc_HOST_ARCH above by JRS, 21 Aug 01.
519 On the Alpha the first 6 integer arguments are in a0 through a5,
520 and the rest on the stack. Hence we want to shuffle the original
521 caller's arguments by two.
523 On the Alpha the calling convention is so complex and dependent
524 on the callee's signature -- for example, the stack pointer has
525 to be a multiple of 16 -- that it seems impossible to me [ccshan]
526 to handle the general case correctly without changing how the
527 adjustor is called from C. For now, our solution of shuffling
528 registers only and ignoring the stack only works if the original
529 caller passed 4 or fewer argument words.
531 TODO: Depending on how much allocation overhead stgMallocBytes uses for
532 header information (more precisely, if the overhead is no more than
533 4 bytes), we should move the first three instructions above down by
534 4 bytes (getting rid of the nop), hence saving memory. [ccshan]
536 ASSERT(((StgWord64)wptr & 3) == 0);
537 adjustor = mallocBytesRWX(48);
539 StgWord64 *const code = (StgWord64 *)adjustor;
541 code[0] = 0x4610041246520414L;
542 code[1] = 0x46730415a61b0020L;
543 code[2] = 0x46310413a77b0028L;
544 code[3] = 0x000000006bfb0000L
545 | (((StgWord32*)(wptr) - (StgWord32*)(code) - 3) & 0x3fff);
547 code[4] = (StgWord64)hptr;
548 code[5] = (StgWord64)wptr;
550 /* Ensure that instruction cache is consistent with our new code */
551 __asm__ volatile("call_pal %0" : : "i" (PAL_imb));
553 #elif defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)
555 #define OP_LO(op,lo) ((((unsigned)(op)) << 16) | (((unsigned)(lo)) & 0xFFFF))
556 #define OP_HI(op,hi) ((((unsigned)(op)) << 16) | (((unsigned)(hi)) >> 16))
558 /* The PowerPC Linux (32-bit) calling convention is annoyingly complex.
559 We need to calculate all the details of the stack frame layout,
560 taking into account the types of all the arguments, and then
561 generate code on the fly. */
563 int src_gpr = 3, dst_gpr = 5;
565 int src_offset = 0, dst_offset = 0;
566 int n = strlen(typeString),i;
567 int src_locs[n], dst_locs[n];
572 Calculate where the arguments should go.
573 src_locs[] will contain the locations of the arguments in the
574 original stack frame passed to the adjustor.
575 dst_locs[] will contain the locations of the arguments after the
576 adjustor runs, on entry to the wrapper proc pointed to by wptr.
578 This algorithm is based on the one described on page 3-19 of the
579 System V ABI PowerPC Processor Supplement.
581 for(i=0;typeString[i];i++)
583 char t = typeString[i];
584 if((t == 'f' || t == 'd') && fpr <= 8)
585 src_locs[i] = dst_locs[i] = -32-(fpr++);
588 if(t == 'l' && src_gpr <= 9)
590 if((src_gpr & 1) == 0)
592 src_locs[i] = -src_gpr;
595 else if(t == 'i' && src_gpr <= 10)
597 src_locs[i] = -(src_gpr++);
601 if(t == 'l' || t == 'd')
606 src_locs[i] = src_offset;
607 src_offset += (t == 'l' || t == 'd') ? 8 : 4;
610 if(t == 'l' && dst_gpr <= 9)
612 if((dst_gpr & 1) == 0)
614 dst_locs[i] = -dst_gpr;
617 else if(t == 'i' && dst_gpr <= 10)
619 dst_locs[i] = -(dst_gpr++);
623 if(t == 'l' || t == 'd')
628 dst_locs[i] = dst_offset;
629 dst_offset += (t == 'l' || t == 'd') ? 8 : 4;
634 frameSize = dst_offset + 8;
635 frameSize = (frameSize+15) & ~0xF;
640 // allocate space for at most 4 insns per parameter
641 // plus 14 more instructions.
642 adjustor = mallocBytesRWX(4 * (4*n + 14));
643 code = (unsigned*)adjustor;
645 *code++ = 0x48000008; // b *+8
646 // * Put the hptr in a place where freeHaskellFunctionPtr
648 *code++ = (unsigned) hptr;
650 // * save the link register
651 *code++ = 0x7c0802a6; // mflr r0;
652 *code++ = 0x90010004; // stw r0, 4(r1);
653 // * and build a new stack frame
654 *code++ = OP_LO(0x9421, -frameSize); // stwu r1, -frameSize(r1)
656 // * now generate instructions to copy arguments
657 // from the old stack frame into the new stack frame.
660 if(src_locs[i] < -32)
661 ASSERT(dst_locs[i] == src_locs[i]);
662 else if(src_locs[i] < 0)
665 ASSERT(typeString[i] != 'f' && typeString[i] != 'd');
668 ASSERT(dst_locs[i] > -32);
669 // dst is in GPR, too.
671 if(typeString[i] == 'l')
675 | ((-dst_locs[i]+1) << 16)
676 | ((-src_locs[i]+1) << 11)
677 | ((-src_locs[i]+1) << 21);
681 | ((-dst_locs[i]) << 16)
682 | ((-src_locs[i]) << 11)
683 | ((-src_locs[i]) << 21);
687 if(typeString[i] == 'l')
689 // stw src+1, dst_offset+4(r1)
691 | ((-src_locs[i]+1) << 21)
695 // stw src, dst_offset(r1)
697 | ((-src_locs[i]) << 21)
703 ASSERT(dst_locs[i] >= 0);
704 ASSERT(typeString[i] != 'f' && typeString[i] != 'd');
706 if(typeString[i] == 'l')
708 // lwz r0, src_offset(r1)
710 | (src_locs[i] + frameSize + 8 + 4);
711 // stw r0, dst_offset(r1)
713 | (dst_locs[i] + 8 + 4);
715 // lwz r0, src_offset(r1)
717 | (src_locs[i] + frameSize + 8);
718 // stw r0, dst_offset(r1)
724 // * hptr will be the new first argument.
726 *code++ = OP_HI(0x3c60, hptr);
727 // ori r3,r3,lo(hptr)
728 *code++ = OP_LO(0x6063, hptr);
730 // * we need to return to a piece of code
731 // which will tear down the stack frame.
732 // lis r11,hi(obscure_ccall_ret_code)
733 *code++ = OP_HI(0x3d60, obscure_ccall_ret_code);
734 // ori r11,r11,lo(obscure_ccall_ret_code)
735 *code++ = OP_LO(0x616b, obscure_ccall_ret_code);
737 *code++ = 0x7d6803a6;
741 *code++ = OP_HI(0x3d60, wptr);
742 // ori r11,r11,lo(wptr)
743 *code++ = OP_LO(0x616b, wptr);
745 *code++ = 0x7d6903a6;
747 *code++ = 0x4e800420;
749 // Flush the Instruction cache:
751 unsigned *p = adjustor;
754 __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
758 __asm__ volatile ("sync\n\tisync");
762 #elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH)
764 #define OP_LO(op,lo) ((((unsigned)(op)) << 16) | (((unsigned)(lo)) & 0xFFFF))
765 #define OP_HI(op,hi) ((((unsigned)(op)) << 16) | (((unsigned)(hi)) >> 16))
767 /* The following code applies to all PowerPC and PowerPC64 platforms
768 whose stack layout is based on the AIX ABI.
770 Besides (obviously) AIX, this includes
771 Mac OS 9 and BeOS/PPC (may they rest in peace),
772 which use the 32-bit AIX ABI
774 which uses the 64-bit AIX ABI
775 and Darwin (Mac OS X),
776 which uses the same stack layout as AIX,
777 but no function descriptors.
779 The actual stack-frame shuffling is implemented out-of-line
780 in the function adjustorCode, in AdjustorAsm.S.
781 Here, we set up an AdjustorStub structure, which
782 is a function descriptor (on platforms that have function
783 descriptors) or a short piece of stub code (on Darwin) to call
784 adjustorCode with a pointer to the AdjustorStub struct loaded
787 One nice thing about this is that there is _no_ code generated at
788 runtime on the platforms that have function descriptors.
790 AdjustorStub *adjustorStub;
791 int sz = 0, extra_sz, total_sz;
793 // from AdjustorAsm.s
794 // not declared as a function so that AIX-style
795 // fundescs can never get in the way.
796 extern void *adjustorCode;
799 adjustorStub = stgMallocBytes(sizeof(AdjustorStub), "createAdjustor");
801 adjustorStub = mallocBytesRWX(sizeof(AdjustorStub));
803 adjustor = adjustorStub;
805 adjustorStub->code = (void*) &adjustorCode;
808 // function descriptors are a cool idea.
809 // We don't need to generate any code at runtime.
810 adjustorStub->toc = adjustorStub;
813 // no function descriptors :-(
814 // We need to do things "by hand".
815 #if defined(powerpc_HOST_ARCH)
816 // lis r2, hi(adjustorStub)
817 adjustorStub->lis = OP_HI(0x3c40, adjustorStub);
818 // ori r2, r2, lo(adjustorStub)
819 adjustorStub->ori = OP_LO(0x6042, adjustorStub);
821 adjustorStub->lwz = OP_LO(0x8002, (char*)(&adjustorStub->code)
822 - (char*)adjustorStub);
824 adjustorStub->mtctr = 0x7c0903a6;
826 adjustorStub->bctr = 0x4e800420;
828 barf("adjustor creation not supported on this platform");
831 // Flush the Instruction cache:
833 int n = sizeof(AdjustorStub)/sizeof(unsigned);
834 unsigned *p = (unsigned*)adjustor;
837 __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
841 __asm__ volatile ("sync\n\tisync");
845 // Calculate the size of the stack frame, in words.
848 char t = *typeString++;
852 #if defined(powerpc_HOST_ARCH)
853 // on 32-bit platforms, Double and Int64 occupy two words.
859 // everything else is one word.
864 // The first eight words of the parameter area
865 // are just "backing store" for the parameters passed in
866 // the GPRs. extra_sz is the number of words beyond those first
872 // Calculate the total size of the stack frame.
873 total_sz = (6 /* linkage area */
874 + 8 /* minimum parameter area */
875 + 2 /* two extra arguments */
876 + extra_sz)*sizeof(StgWord);
878 // align to 16 bytes.
879 // AIX only requires 8 bytes, but who cares?
880 total_sz = (total_sz+15) & ~0xF;
882 // Fill in the information that adjustorCode in AdjustorAsm.S
883 // will use to create a new stack frame with the additional args.
884 adjustorStub->hptr = hptr;
885 adjustorStub->wptr = wptr;
886 adjustorStub->negative_framesize = -total_sz;
887 adjustorStub->extrawords_plus_one = extra_sz + 1;
890 #elif defined(ia64_HOST_ARCH)
892 Up to 8 inputs are passed in registers. We flush the last two inputs to
893 the stack, initially into the 16-byte scratch region left by the caller.
894 We then shuffle the others along by 4 (taking 2 registers for ourselves
895 to save return address and previous function state - we need to come back
896 here on the way out to restore the stack, so this is a real function
897 rather than just a trampoline).
899 The function descriptor we create contains the gp of the target function
900 so gp is already loaded correctly.
902 [MLX] alloc r16=ar.pfs,10,2,0
904 [MII] st8.spill [r12]=r38,8 // spill in6 (out4)
905 mov r41=r37 // out7 = in5 (out3)
906 mov r40=r36;; // out6 = in4 (out2)
907 [MII] st8.spill [r12]=r39 // spill in7 (out5)
909 mov r38=r34;; // out4 = in2 (out0)
910 [MII] mov r39=r35 // out5 = in3 (out1)
911 mov r37=r33 // out3 = in1 (loc1)
912 mov r36=r32 // out2 = in0 (loc0)
913 [MLX] adds r12=-24,r12 // update sp
914 movl r34=hptr;; // out0 = hptr
915 [MIB] mov r33=r16 // loc1 = ar.pfs
916 mov r32=b0 // loc0 = retaddr
917 br.call.sptk.many b0=b6;;
919 [MII] adds r12=-16,r12
924 br.ret.sptk.many b0;;
927 /* These macros distribute a long constant into the two words of an MLX bundle */
928 #define BITS(val,start,count) (((val) >> (start)) & ((1 << (count))-1))
929 #define MOVL_LOWORD(val) (BITS(val,22,18) << 46)
930 #define MOVL_HIWORD(val) (BITS(val,40,23) | (BITS(val,0,7) << 36) | (BITS(val,7,9) << 50) \
931 | (BITS(val,16,5) << 55) | (BITS(val,21,1) << 44) | BITS(val,63,1) << 59)
935 IA64FunDesc *wdesc = (IA64FunDesc *)wptr;
936 StgWord64 wcode = wdesc->ip;
940 /* we allocate on the Haskell heap since malloc'd memory isn't executable - argh */
941 adjustor = stgAllocStable(sizeof(IA64FunDesc)+18*8, &stable);
943 fdesc = (IA64FunDesc *)adjustor;
944 code = (StgWord64 *)(fdesc + 1);
945 fdesc->ip = (StgWord64)code;
946 fdesc->gp = wdesc->gp;
948 code[0] = 0x0000058004288004 | MOVL_LOWORD(wcode);
949 code[1] = 0x6000000220000000 | MOVL_HIWORD(wcode);
950 code[2] = 0x029015d818984001;
951 code[3] = 0x8401200500420094;
952 code[4] = 0x886011d8189c0001;
953 code[5] = 0x84011004c00380c0;
954 code[6] = 0x0250210046013800;
955 code[7] = 0x8401000480420084;
956 code[8] = 0x0000233f19a06005 | MOVL_LOWORD((StgWord64)hptr);
957 code[9] = 0x6000000440000000 | MOVL_HIWORD((StgWord64)hptr);
958 code[10] = 0x0200210020010811;
959 code[11] = 0x1080006800006200;
960 code[12] = 0x0000210018406000;
961 code[13] = 0x00aa021000038005;
962 code[14] = 0x000000010000001d;
963 code[15] = 0x0084000880000200;
965 /* save stable pointers in convenient form */
966 code[16] = (StgWord64)hptr;
967 code[17] = (StgWord64)stable;
970 barf("adjustor creation not supported on this platform");
985 freeHaskellFunctionPtr(void* ptr)
987 #if defined(i386_HOST_ARCH)
988 if ( *(unsigned char*)ptr != 0x68 &&
989 *(unsigned char*)ptr != 0x58 ) {
990 errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
994 /* Free the stable pointer first..*/
995 if (*(unsigned char*)ptr == 0x68) { /* Aha, a ccall adjustor! */
996 freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x01)));
998 freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02)));
1000 #elif defined(x86_64_HOST_ARCH)
1001 if ( *(StgWord16 *)ptr == 0x894d ) {
1002 freeStablePtr(*(StgStablePtr*)(ptr+32));
1003 } else if ( *(StgWord16 *)ptr == 0x5141 ) {
1004 freeStablePtr(*(StgStablePtr*)(ptr+40));
1006 errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
1009 #elif defined(sparc_HOST_ARCH)
1010 if ( *(unsigned long*)ptr != 0x9C23A008UL ) {
1011 errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
1015 /* Free the stable pointer first..*/
1016 freeStablePtr(*((StgStablePtr*)((unsigned long*)ptr + 11)));
1017 #elif defined(alpha_HOST_ARCH)
1018 if ( *(StgWord64*)ptr != 0xa77b0018a61b0010L ) {
1019 errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
1023 /* Free the stable pointer first..*/
1024 freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
1025 #elif defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)
1026 if ( *(StgWord*)ptr != 0x48000008 ) {
1027 errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
1030 freeStablePtr(((StgStablePtr*)ptr)[1]);
1031 #elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH)
1032 extern void* adjustorCode;
1033 if ( ((AdjustorStub*)ptr)->code != (StgFunPtr) &adjustorCode ) {
1034 errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
1037 freeStablePtr(((AdjustorStub*)ptr)->hptr);
1038 #elif defined(ia64_HOST_ARCH)
1039 IA64FunDesc *fdesc = (IA64FunDesc *)ptr;
1040 StgWord64 *code = (StgWord64 *)(fdesc+1);
1042 if (fdesc->ip != (StgWord64)code) {
1043 errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
1046 freeStablePtr((StgStablePtr)code[16]);
1047 freeStablePtr((StgStablePtr)code[17]);
1052 *((unsigned char*)ptr) = '\0';
1059 * Function: initAdjustor()
1061 * Perform initialisation of adjustor thunk layer (if needed.)