Commit 0aca2f00 authored by wolfgang's avatar wolfgang
Browse files

[project @ 2005-01-10 18:44:38 by wolfgang]

Handle foreign import wrapper properly for MacOS X, powerpc64-linux and AIX.
Only Mac OS X tested so far.
Pass information about argument types from DsForeign to createAdjustor encoded
as a string ('i' for integers, 'f' for floats, 'd' for doubles and 'l' for
long [64bit] integers).
parent 5908f01a
......@@ -23,11 +23,11 @@ import DataCon ( splitProductType_maybe )
import DataCon ( dataConSourceArity )
import Type ( isUnLiftedType )
#endif
import MachOp ( machRepByteWidth )
import MachOp ( machRepByteWidth, MachRep(..) )
import SMRep ( argMachRep, primRepToCgRep )
import CoreUtils ( exprType, mkInlineMe )
import Id ( Id, idType, idName, mkSysLocal, setInlinePragma )
import Literal ( Literal(..) )
import Literal ( Literal(..), mkStringLit )
import Module ( moduleString )
import Name ( getOccString, NamedThing(..) )
import OccName ( encodeFS )
......@@ -389,11 +389,20 @@ dsFExportDynamic id cconv
adj_args = [ mkIntLitInt (ccallConvToInt cconv)
, Var stbl_value
, mkLit (MachLabel fe_nm mb_sz_args)
, mkLit (mkStringLit arg_type_info)
]
-- name of external entry point providing these services.
-- (probably in the RTS.)
adjustor = FSLIT("createAdjustor")
arg_type_info = drop 2 $ map (repCharCode.argMachRep
.primRepToCgRep.typePrimRep)
stub_args
repCharCode F32 = 'f'
repCharCode F64 = 'd'
repCharCode I64 = 'l'
repCharCode _ = 'i'
-- Determine the number of bytes of arguments to the stub function,
-- so that we can attach the '@N' suffix to its label if it is a
-- stdcall on Windows.
......
/* -----------------------------------------------------------------------------
* $Id: RtsExternal.h,v 1.6 2004/10/15 07:48:29 simonmar Exp $
* $Id: RtsExternal.h,v 1.7 2005/01/10 18:44:40 wolfgang Exp $
*
* (c) The GHC Team, 1998-2004
*
......@@ -59,7 +59,8 @@ extern StgInt suspendThread ( StgRegTable * );
extern StgRegTable * resumeThread ( StgInt );
/* Creating and destroying an adjustor thunk */
extern void* createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr);
extern void* createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr,
char *typeString);
extern void freeHaskellFunctionPtr(void* ptr);
/* -----------------------------------------------------------------------------
......
......@@ -134,33 +134,52 @@ stgAllocStable(size_t size_in_bytes, StgStablePtr *stable)
}
#endif
#if defined(powerpc64_TARGET_ARCH)
// We don't need to generate dynamic code on powerpc64-[linux|AIX],
// but we do need a piece of (static) inline assembly code:
#if defined(powerpc_TARGET_ARCH) || defined(powerpc64_TARGET_ARCH)
#if !(defined(powerpc_TARGET_ARCH) && defined(linux_TARGET_OS))
/* !!! !!! WARNING: !!! !!!
* This structure is accessed from AdjustorAsm.s
* Any changes here have to be mirrored in the offsets there.
*/
typedef struct AdjustorStub {
#if defined(powerpc_TARGET_ARCH) && defined(darwin_TARGET_OS)
unsigned lis;
unsigned ori;
unsigned lwz;
unsigned mtctr;
unsigned bctr;
StgFunPtr code;
#elif defined(powerpc64_TARGET_ARCH) && defined(darwin_TARGET_OS)
/* powerpc64-darwin: just guessing that it won't use fundescs. */
unsigned lis;
unsigned ori;
unsigned rldimi;
unsigned oris;
unsigned ori2;
unsigned lwz;
unsigned mtctr;
unsigned bctr;
StgFunPtr code;
#else
/* fundesc-based ABIs */
#define FUNDESCS
StgFunPtr code;
struct AdjustorStub
*toc;
void *env;
#endif
StgStablePtr hptr;
StgFunPtr wptr;
StgInt negative_framesize;
StgInt extrawords_plus_one;
} AdjustorStub;
static void
adjustorCodeWrittenInAsm()
{
__asm__ volatile (
"adjustorCode:\n\t"
"mr 10,8\n\t"
"mr 9,7\n\t"
"mr 8,6\n\t"
"mr 7,5\n\t"
"mr 6,4\n\t"
"mr 5,3\n\t"
"mr 3,11\n\t"
"ld 0,0(2)\n\t"
"ld 11,16(2)\n\t"
"mtctr 0\n\t"
"ld 2,8(2)\n\t"
"bctr"
: : );
}
#endif
#endif
void*
createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr, char *typeString)
{
void *adjustor = NULL;
......@@ -364,9 +383,9 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for
/* Ensure that instruction cache is consistent with our new code */
__asm__ volatile("call_pal %0" : : "i" (PAL_imb));
}
#elif defined(powerpc_TARGET_ARCH)
#elif defined(powerpc_TARGET_ARCH) && defined(linux_TARGET_OS)
/*
For PowerPC, the following code is used:
For PowerPC Linux, the following code is used:
mr r10,r8
mr r9,r7
......@@ -429,27 +448,102 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for
__asm__ volatile ("sync\n\tisync");
}
}
#elif defined(powerpc64_TARGET_ARCH)
// This is for powerpc64 linux and powerpc64 AIX.
// It probably won't apply to powerpc64-darwin.
{
typedef struct {
StgFunPtr code;
void* toc;
void* env;
} FunDesc;
FunDesc *desc = malloc(sizeof(FunDesc));
extern void *adjustorCode;
desc->code = (void*) &adjustorCode;
desc->toc = (void*) wptr;
desc->env = (void*) hptr;
#elif defined(powerpc_TARGET_ARCH) || defined(powerpc64_TARGET_ARCH)
#define OP_LO(op,lo) ((((unsigned)(op)) << 16) | (((unsigned)(lo)) & 0xFFFF))
#define OP_HI(op,hi) ((((unsigned)(op)) << 16) | (((unsigned)(hi)) >> 16))
{
AdjustorStub *adjustorStub;
int sz = 0, extra_sz, total_sz;
// from AdjustorAsm.s
// not declared as a function so that AIX-style
// fundescs can never get in the way.
extern void *adjustorCode;
#ifdef FUNDESCS
adjustorStub = stgMallocBytes(sizeof(AdjustorStub), "createAdjustor");
#else
adjustorStub = mallocBytesRWX(sizeof(AdjustorStub));
#endif
adjustor = adjustorStub;
adjustor = (void*) desc;
}
break;
adjustorStub->code = (void*) &adjustorCode;
#ifdef FUNDESCS
// function descriptors are a cool idea.
// We don't need to generate any code at runtime.
adjustorStub->toc = adjustorStub;
#else
// no function descriptors :-(
// We need to do things "by hand".
#if defined(powerpc_TARGET_ARCH)
// lis r2, hi(adjustorStub)
adjustorStub->lis = OP_HI(0x3c40, adjustorStub);
// ori r2, r2, lo(adjustorStub)
adjustorStub->ori = OP_LO(0x6042, adjustorStub);
// lwz r0, code(r2)
adjustorStub->lwz = OP_LO(0x8002, (char*)(&adjustorStub->code)
- (char*)adjustorStub);
// mtctr r0
adjustorStub->mtctr = 0x7c0903a6;
// bctr
adjustorStub->bctr = 0x4e800420;
#else
barf("adjustor creation not supported on this platform");
#endif
// Flush the Instruction cache:
{
int n = sizeof(AdjustorStub)/sizeof(unsigned);
unsigned *p = (unsigned*)adjustor;
while(n--)
{
__asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
: : "r" (p));
p++;
}
__asm__ volatile ("sync\n\tisync");
}
#endif
printf("createAdjustor: %s\n", typeString);
while(*typeString)
{
char t = *typeString++;
switch(t)
{
#if defined(powerpc64_TARGET_ARCH)
case 'd': sz += 1; break;
case 'l': sz += 1; break;
#else
case 'd': sz += 2; break;
case 'l': sz += 2; break;
#endif
case 'f': sz += 1; break;
case 'i': sz += 1; break;
}
}
extra_sz = sz - 8;
if(extra_sz < 0)
extra_sz = 0;
total_sz = (6 /* linkage area */
+ 8 /* minimum parameter area */
+ 2 /* two extra arguments */
+ extra_sz)*sizeof(StgWord);
// align to 16 bytes.
// AIX only requires 8 bytes, but who cares?
total_sz = (total_sz+15) & ~0xF;
adjustorStub->hptr = hptr;
adjustorStub->wptr = wptr;
adjustorStub->negative_framesize = -total_sz;
adjustorStub->extrawords_plus_one = extra_sz + 1;
}
#elif defined(ia64_TARGET_ARCH)
/*
......@@ -577,12 +671,19 @@ freeHaskellFunctionPtr(void* ptr)
/* Free the stable pointer first..*/
freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
#elif defined(powerpc_TARGET_ARCH)
#elif defined(powerpc_TARGET_ARCH) && defined(linux_TARGET_OS)
if ( *(StgWord*)ptr != 0x7d0a4378 ) {
errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
return;
}
freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 4*12)));
#elif defined(powerpc_TARGET_ARCH) || defined(powerpc64_TARGET_ARCH)
extern void* adjustorCode;
if ( ((AdjustorStub*)ptr)->code != (StgFunPtr) &adjustorCode ) {
errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
return;
}
freeStablePtr(((AdjustorStub*)ptr)->hptr);
#elif defined(ia64_TARGET_ARCH)
IA64FunDesc *fdesc = (IA64FunDesc *)ptr;
StgWord64 *code = (StgWord64 *)(fdesc+1);
......
#include "../includes/ghcconfig.h"
#if defined(powerpc_TARGET_ARCH) || defined(powerpc64_TARGET_ARCH)
#if !(defined(powerpc_TARGET_ARCH) && defined(linux_TARGET_OS))
/* The following code applies, with some differences,
to all powerpc platforms except for powerpc32-linux,
whose calling convention is annoyingly complex.
*/
/* The code is "almost" the same for
32-bit and for 64-bit
*/
#if defined(powerpc64_TARGET_ARCH)
#define WS 8
#define LOAD ld
#define STORE std
#else
#define WS 4
#define LOAD lwz
#define STORE stw
#endif
/* Some info about stack frame layout */
#define LINK_SLOT (2*WS)
#define LINKAGE_AREA_SIZE (6*WS)
/* The following defines mirror struct AdjustorStub
from Adjustor.c. Make sure to keep these in sync.
*/
#if defined(powerpc_TARGET_ARCH) && defined(darwin_TARGET_OS)
#define HEADER_WORDS 6
#elif defined(powerpc64_TARGET_ARCH) && defined(darwin_TARGET_OS)
#else
#define HEADER_WORDS 3
#endif
#define HPTR_OFF ((HEADER_WORDS )*WS)
#define WPTR_OFF ((HEADER_WORDS + 1)*WS)
#define FRAMESIZE_OFF ((HEADER_WORDS + 2)*WS)
#define EXTRA_WORDS_OFF ((HEADER_WORDS + 3)*WS)
/* Darwin insists on register names, everyone else prefers
to use numbers. */
#if !defined(darwin_TARGET_OS)
#define r0 0
#define r1 1
#define r2 2
#define r3 3
#define r4 4
#define r5 5
#define r6 6
#define r7 7
#define r8 8
#define r9 9
#define r10 10
#define r11 11
#define r12 12
#define r30 30
#define r31 31
#endif
.text
#if LEADING_UNDERSCORE
.globl _adjustorCode
_adjustorCode:
#else
.globl adjustorCode
/* Note that we don't build a function descriptor
for AIX-derived ABIs here. This will happen at runtime
in createAdjustor().
*/
adjustorCode:
#endif
/* On entry, r2 will point to the AdjustorStub data structure. */
/* save the link */
mflr r0
STORE r0, LINK_SLOT(r1)
/* set up stack frame */
LOAD r12, FRAMESIZE_OFF(r2)
#ifdef powerpc64_TARGET_ARCH
stdux r1, r1, r12
#else
stwux r1, r1, r12
#endif
/* Save some regs so that we can use them.
Note that we use the "Red Zone" below the stack pointer.
*/
STORE r31, -WS(r1)
STORE r30, -2*WS(r1)
mr r31, r1
subf r30, r12, r31
LOAD r12, EXTRA_WORDS_OFF(r2)
mtctr r12
b 2f
1:
LOAD r0, LINKAGE_AREA_SIZE + 8*WS(r30)
STORE r0, LINKAGE_AREA_SIZE + 10*WS(r31)
addi r30, r30, WS
addi r31, r31, WS
2:
bdnz 1b
/* Restore r30 and r31 now.
*/
LOAD r31, -WS(r1)
LOAD r30, -2*WS(r1)
STORE r10, LINKAGE_AREA_SIZE + 9*WS(r1)
STORE r9, LINKAGE_AREA_SIZE + 8*WS(r1)
mr r10, r8
mr r9, r7
mr r8, r6
mr r7, r5
mr r6, r4
mr r5, r3
LOAD r3, HPTR_OFF(r2)
LOAD r0, WPTR_OFF(r2)
mtctr r0
bctrl
LOAD r1, 0(r1)
LOAD r0, LINK_SLOT(r1)
mtlr r0
blr
#endif
#endif
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment