projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2000-06-20 15:18:40 by simonmar]
[ghc-hetmet.git]
/
ghc
/
rts
/
ForeignCall.c
diff --git
a/ghc/rts/ForeignCall.c
b/ghc/rts/ForeignCall.c
index
17eb97a
..
a6a4646
100644
(file)
--- a/
ghc/rts/ForeignCall.c
+++ b/
ghc/rts/ForeignCall.c
@@
-1,6
+1,6
@@
/* -----------------------------------------------------------------------------
/* -----------------------------------------------------------------------------
- * $Id: ForeignCall.c,v 1.11 1999/11/08 15:30:37 sewardj Exp $
+ * $Id: ForeignCall.c,v 1.17 2000/05/26 10:14:34 sewardj Exp $
*
* (c) The GHC Team 1994-1999.
*
*
* (c) The GHC Team 1994-1999.
*
@@
-178,7
+178,7
@@
static void universal_call_c_generic
unsigned int *p = (unsigned int*) args;
#define ARG(n) (p[n*2])
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) \
(!strncmp(str,argstr,n_args + 1)))
#define CALL(retType,callTypes,callVals) \
@@
-205,7
+205,8
@@
static void universal_call_c_generic
printf("%c",(char)argstr[i]);
}
printf("' [%d arg(s)]\n",n_args);
printf("%c",(char)argstr[i]);
}
printf("' [%d arg(s)]\n",n_args);
- assert(0);
+ barf("aborting");
+ ASSERT(0);
}
#undef CALL
#undef CMP
}
#undef CALL
#undef CMP
@@
-248,7
+249,7
@@
int ccall ( CFunDescriptor* d,
return 1; /* unlikely, but ... */
p = (unsigned int*) &arg_vec[1];
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:
switch (d->arg_tys[i]) {
case INT_REP:
@@
-385,8
+386,8
@@
int ccall ( CFunDescriptor* d,
/* Make it possible for the evaluator to get hold of bytecode
for a given function by name. Useful but a hack. Sigh.
*/
/* 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.
/* ----------------------------------------------------------------*
* The implementation for x86_ccall and x86_stdcall.
@@
-465,11
+466,15
@@
unpackArgsAndCallHaskell_x86_nocallconv_wrk ( StgStablePtr stableptr,
argp++;
}
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");
if (sstat != Success)
barf ("unpackArgsAndCallHaskell_x86_nocallconv: eval failed");
@@
-519,10
+524,10
@@
unpackArgsAndCallHaskell_x86_nocallconv_INTISH (
StgStablePtr stableptr, char* tydesc, char* args
)
{
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
/* 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
@@
-682,7
+687,7
@@
StgAddr createAdjThunk ( StgStablePtr stableptr,
createAdjThunk_x86 ( stableptr, typestr, callconv );
#else
0;
createAdjThunk_x86 ( stableptr, typestr, callconv );
#else
0;
- #warn foreign export not implemented on this architecture
+#warning foreign export not implemented on this architecture
#endif
}
#endif
}