/* -----------------------------------------------------------------------------
- * $Id: ForeignCall.c,v 1.10 1999/10/26 17:27:30 sewardj Exp $
+ * $Id: ForeignCall.c,v 1.16 2000/05/12 11:59:39 sewardj Exp $
*
* (c) The GHC Team 1994-1999.
*
#include "RtsUtils.h" /* barf :-) */
#include "Assembler.h" /* for CFun stuff */
+#include "Schedule.h"
#include "Evaluator.h"
#include "ForeignCall.h"
unsigned int *p = (unsigned int*) args;
#define ARG(n) (p[n*2])
-#define CMP(str) ((n_args + 1 == strlen(str)) && \
+#define CMP(str) ((n_args + 1 == (int)strlen(str)) && \
(!strncmp(str,argstr,n_args + 1)))
#define CALL(retType,callTypes,callVals) \
int ccall ( CFunDescriptor* d,
void (*fun)(void),
StgBCO** bco,
- char cc
+ char cc,
+ Capability* cap
)
{
double arg_vec [31];
unsigned int* p;
int i;
unsigned long ul;
+ unsigned int token;
if (sizeof(int) != 4 || sizeof(double) != 8 || sizeof(float) != 4
|| (sizeof(void*) != 4 && sizeof(void*) != 8)
return 1; /* unlikely, but ... */
p = (unsigned int*) &arg_vec[1];
- for (i = 0; i < d->num_args; i++) {
+ for (i = 0; i < (int)(d->num_args); i++) {
switch (d->arg_tys[i]) {
case INT_REP:
}
PushPtr((StgPtr)(*bco));
- SaveThreadState();
+ cap->rCurrentTSO->sp = MainRegTable.rSp;
+ cap->rCurrentTSO->su = MainRegTable.rSu;
+ cap->rCurrentTSO->splim = MainRegTable.rSpLim;
+ token = suspendThread(cap);
#if i386_TARGET_ARCH
if (cc == 'c')
universal_call_c_generic (
d->num_args, (void*)arg_vec, argd_vec, fun );
#endif
- LoadThreadState();
+
+ cap = resumeThread(token);
+ MainRegTable.rSp = cap->rCurrentTSO->sp;
+ MainRegTable.rSu = cap->rCurrentTSO->su;
+ MainRegTable.rSpLim = cap->rCurrentTSO->splim;
*bco=(StgBCO*)PopPtr();
/* INT, WORD, ADDR, STABLE don't need to do a word-size check
/* Make it possible for the evaluator to get hold of bytecode
for a given function by name. Useful but a hack. Sigh.
*/
-extern void* getHugs_AsmObject_for ( char* s );
-
+extern void* /* StgClosure* */ getHugs_BCO_cptr_for ( char* s );
+extern int /*Bool*/ combined;
/* ----------------------------------------------------------------*
* The implementation for x86_ccall and x86_stdcall.
argp++;
}
- node = rts_apply (
- asmClosureOfObject(getHugs_AsmObject_for("primRunST")),
- node );
+ if (combined) {
+ sstat = rts_evalIO ( node, &nodeOut );
+ } else {
+ node = rts_apply (
+ getHugs_BCO_cptr_for("runST"),
+ node );
+ sstat = rts_eval ( node, &nodeOut );
+ }
- sstat = rts_eval ( node, &nodeOut );
if (sstat != Success)
barf ("unpackArgsAndCallHaskell_x86_nocallconv: eval failed");
StgStablePtr stableptr, char* tydesc, char* args
)
{
- HaskellObj nodeOut
- = unpackArgsAndCallHaskell_x86_nocallconv_wrk (
- stableptr, tydesc, args
- );
+ HaskellObj nodeOut;
+ nodeOut = unpackArgsAndCallHaskell_x86_nocallconv_wrk (
+ stableptr, tydesc, args
+ );
/* A complete hack. We know that all these returns will be
put into %eax (and %edx, if it is a 64-bit return), and
the adjustor thunk will then itself return to the original
createAdjThunk_x86 ( stableptr, typestr, callconv );
#else
0;
- #warn foreign export not implemented on this architecture
+#warning foreign export not implemented on this architecture
#endif
}