1 /* -*- mode: hugs-c; -*- */
2 /* -----------------------------------------------------------------------------
3 * $Id: ForeignCall.c,v 1.3 1999/02/05 16:02:40 simonm Exp $
5 * (c) The GHC Team 1994-1999.
7 * Foreign Function calls
9 * ---------------------------------------------------------------------------*/
15 #include "Assembler.h" /* for CFun stuff */
16 #include "Evaluator.h"
17 #include "ForeignCall.h"
19 /* the assymetry here seem to come from the caller-allocates
20 * calling convention. But does the caller really allocate
24 void hcall( HFunDescriptor* d, StablePtr fun, void* as, void* rs)
27 /* out of date - ADR */
28 marshall(d->arg_tys,as);
30 unmarshall(d->result_tys,rs);
36 /* By experiment on an x86 box, we found that gcc's
37 * __builtin_apply(fun,as,size) expects *as to look like this:
38 * as[0] = &first arg = &as[1]
43 * on an x86, it returns a pointer to a struct containing an
44 * int/int64/ptr in its first 4-8 bytes and a float/double in the next
48 * as[0] = &first arg = &as[2]
49 * as[1] = where structures should be returned
54 * This is something of a hack - but seems to be more portable than
55 * hacking it up in assembly language which is how I did it before - ADR
57 void ccall( CFunDescriptor* d, void (*fun)(void) )
60 char* tys = d->arg_tys;
61 /* ToDo: the use of ARG_SIZE is based on the assumption that Hugs
62 * obeys the same alignment restrictions as C.
63 * But this is almost certainly wrong!
64 * We could use gcc's __va_rounded_size macro (see varargs.h) to do a
68 void *as=alloca(4 + d->arg_size);
69 StgWord* args = (StgWord*) as;
70 *(void**)(args++) = 4 + (char*)as; /* incoming args ptr */
72 args += unmarshall(*tys,args);
74 rs = __builtin_apply(fun,as,(char*)args-(char*)as-4);
75 #elif sparc_TARGET_ARCH
76 void *as=alloca(8 + d->arg_size);
77 StgWord* args = (StgWord*) as;
79 *(void**)(args++) = (char*)as; /* incoming args ptr */
80 *(void**)(args++) = 0; /* structure value address - I think this is the address of a block of memory where structures are returned - in which case we should initialise with rs or something like that*/
82 args += unmarshall(*tys,args);
84 argcount = ((void*)args - as);
85 ASSERT(8 + d->arg_size == argcount);
91 rs = __builtin_apply(fun,as,argcount);
93 #error Cant do ccall for this architecture
96 /* ToDo: can't handle multiple return values at the moment
97 * - it's hard enough to get single return values working
99 if (*(d->result_tys)) {
100 char ty = *(d->result_tys);
101 ASSERT(d->result_tys[1] == '\0');
105 /* ToDo: is this right? */
106 marshall(ty,(char*)rs+8);
115 CFunDescriptor* mkDescriptor( char* as, char* rs )
117 /* ToDo: don't use malloc */
118 CFunDescriptor *d = malloc(sizeof(CFunDescriptor));
121 d->arg_size = argSize(as);
123 d->result_size = argSize(rs);
127 #endif /* INTERPRETER */