diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

try to fix weird calling conventions of SWI.

Browse Source
This commit is contained in:
Vitor Santos Costa 2009-06-01 21:49:24 -05:00
parent 217afd3a72
commit 256d322f43
1 changed files with 17 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
library/yap2swi/yap2swi.c
View File

@ -88,7 +88,7 @@ PredicateInfo(void *p, Atom* a, unsigned long int* arity, Term* m)
} }
static void static void
UserCPredicateWithArgs(char *a, CPredicate def, unsigned long int arity, Term mod, int flags) UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int flags)
{ {
PredEntry *pe; PredEntry *pe;
Term cm = CurrentModule; Term cm = CurrentModule;
@ -104,23 +104,6 @@ UserCPredicateWithArgs(char *a, CPredicate def, unsigned long int arity, Term mo
CurrentModule = cm; CurrentModule = cm;
} }
static void
UserCPredicateVarargs(char *a, CPredicate def, unsigned long int arity, Term mod)
{
PredEntry *pe;
Term cm = CurrentModule;
CurrentModule = mod;
Yap_InitCPred(a, arity, def, UserCPredFlag|SWIEnvPredFlag);
if (arity == 0) {
pe = RepPredProp(PredPropByAtom(Yap_LookupAtom(a),mod));
} else {
Functor f = Yap_MkFunctor(Yap_LookupAtom(a), arity);
pe = RepPredProp(PredPropByFunc(f,mod));
}
pe->PredFlags |= SWIEnvPredFlag;
CurrentModule = cm;
}
char buffers[TMP_BUF_SIZE+BUF_SIZE*BUF_RINGS]; char buffers[TMP_BUF_SIZE+BUF_SIZE*BUF_RINGS];
static int buf_index = 0; static int buf_index = 0;
@ -2005,6 +1988,7 @@ X_API int PL_call(term_t tp, module_t m)
X_API void PL_register_foreign_in_module(const char *module, const char *name, int arity, foreign_t (*function)(void), int flags) X_API void PL_register_foreign_in_module(const char *module, const char *name, int arity, foreign_t (*function)(void), int flags)
{ {
Term tmod; Term tmod;
Int nflags = 0;
if (flags & (PL_FA_NOTRACE|PL_FA_CREF)) { if (flags & (PL_FA_NOTRACE|PL_FA_CREF)) {
fprintf(stderr,"PL_register_foreign_in_module called with non-implemented flag %x when creating predicate %s:%s/%d\n", flags, module, name, arity); fprintf(stderr,"PL_register_foreign_in_module called with non-implemented flag %x when creating predicate %s:%s/%d\n", flags, module, name, arity);
@ -2015,28 +1999,30 @@ X_API void PL_register_foreign_in_module(const char *module, const char *name, i
tmod = MkAtomTerm(Yap_LookupAtom((char *)module)); tmod = MkAtomTerm(Yap_LookupAtom((char *)module));
} }
if (flags & PL_FA_VARARGS) { if (flags & PL_FA_VARARGS) {
UserCPredicateVarargs((char *)name,(CPredicate)function,arity,tmod); nflags = SWIEnvPredFlag;
} else if (flags & PL_FA_NONDETERMINISTIC) { }
Yap_InitCPredBack((char *)name, arity, sizeof(struct foreign_context)/sizeof(CELL), (CPredicate)function, (CPredicate)function, UserCPredFlag|SWIEnvPredFlag); if (flags & PL_FA_TRANSPARENT) {
} else if (flags & PL_FA_TRANSPARENT) nflags |= ModuleTransparentPredFlag;
UserCPredicateWithArgs((char *)name,(CPredicate)function,arity,tmod,ModuleTransparentPredFlag); } else {
else nflags |= CArgsPredFlag;
UserCPredicateWithArgs((char *)name,(CPredicate)function,arity,tmod,0); }
if (flags & PL_FA_NONDETERMINISTIC) {
Yap_InitCPredBack((char *)name, arity, sizeof(struct foreign_context)/sizeof(CELL), (CPredicate)function, (CPredicate)function, UserCPredFlag|nflags);
} else {
UserCPredicate((char *)name,(CPredicate)function,arity,tmod,nflags);
}
} }
X_API void PL_register_extensions(PL_extension *ptr) X_API void PL_register_extensions(PL_extension *ptr)
{ {
while (ptr->predicate_name) { PL_load_extensions(ptr);
PL_register_foreign_in_module(NULL, ptr->predicate_name, ptr->arity, ptr->function, ptr->flags);
ptr++;
}
} }
X_API void PL_load_extensions(PL_extension *ptr) X_API void PL_load_extensions(PL_extension *ptr)
{ {
/* ignore flags for now */ /* ignore flags for now */
while(ptr->predicate_name != NULL) { while(ptr->predicate_name != NULL) {
UserCPredicateWithArgs(ptr->predicate_name,(CPredicate)ptr->function,ptr->arity,YAP_CurrentModule(),0); PL_register_foreign_in_module(NULL, ptr->predicate_name, ptr->arity, ptr->function, ptr->flags);
ptr++; ptr++;
} }
} }