diff --git a/C/c_interface.c b/C/c_interface.c index 2745257f8..2821b5500 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -1162,6 +1162,8 @@ typedef Int (*CPredicate5)(Int,Int,Int,Int,Int); typedef Int (*CPredicate6)(Int,Int,Int,Int,Int,Int); typedef Int (*CPredicate7)(Int,Int,Int,Int,Int,Int,Int); typedef Int (*CPredicate8)(Int,Int,Int,Int,Int,Int,Int,Int); +typedef Int (*CPredicate9)(Int,Int,Int,Int,Int,Int,Int,Int,Int); +typedef Int (*CPredicate10)(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int); typedef Int (*CPredicateV)(Int,Int,struct foreign_context *); static Int @@ -1241,6 +1243,33 @@ execute_cargs(PredEntry *pe, CPredicate exec_code) Yap_InitSlot(Deref(ARG7)), Yap_InitSlot(Deref(ARG8)))); } + case 9: + { + CPredicate9 code9 = (CPredicate9)exec_code; + return ((code9)(Yap_InitSlot(Deref(ARG1)), + Yap_InitSlot(Deref(ARG2)), + Yap_InitSlot(Deref(ARG3)), + Yap_InitSlot(Deref(ARG4)), + Yap_InitSlot(Deref(ARG5)), + Yap_InitSlot(Deref(ARG6)), + Yap_InitSlot(Deref(ARG7)), + Yap_InitSlot(Deref(ARG8)), + Yap_InitSlot(Deref(ARG9)))); + } + case 10: + { + CPredicate10 code10 = (CPredicate10)exec_code; + return ((code10)(Yap_InitSlot(Deref(ARG1)), + Yap_InitSlot(Deref(ARG2)), + Yap_InitSlot(Deref(ARG3)), + Yap_InitSlot(Deref(ARG4)), + Yap_InitSlot(Deref(ARG5)), + Yap_InitSlot(Deref(ARG6)), + Yap_InitSlot(Deref(ARG7)), + Yap_InitSlot(Deref(ARG8)), + Yap_InitSlot(Deref(ARG9)), + Yap_InitSlot(Deref(ARG10)))); + } default: return(FALSE); } @@ -1255,6 +1284,8 @@ typedef Int (*CBPredicate5)(Int,Int,Int,Int,Int,struct foreign_context *); typedef Int (*CBPredicate6)(Int,Int,Int,Int,Int,Int,struct foreign_context *); typedef Int (*CBPredicate7)(Int,Int,Int,Int,Int,Int,Int,struct foreign_context *); typedef Int (*CBPredicate8)(Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *); +typedef Int (*CBPredicate9)(Int,Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *); +typedef Int (*CBPredicate10)(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *); static Int execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context *ctx) @@ -1340,6 +1371,35 @@ execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context * Yap_InitSlot(Deref(ARG8)), ctx)); } + case 9: + { + CBPredicate9 code9 = (CBPredicate9)exec_code; + return ((code9)(Yap_InitSlot(Deref(ARG1)), + Yap_InitSlot(Deref(ARG2)), + Yap_InitSlot(Deref(ARG3)), + Yap_InitSlot(Deref(ARG4)), + Yap_InitSlot(Deref(ARG5)), + Yap_InitSlot(Deref(ARG6)), + Yap_InitSlot(Deref(ARG7)), + Yap_InitSlot(Deref(ARG8)), + Yap_InitSlot(Deref(ARG9)), + ctx)); + } + case 10: + { + CBPredicate10 code10 = (CBPredicate10)exec_code; + return ((code10)(Yap_InitSlot(Deref(ARG1)), + Yap_InitSlot(Deref(ARG2)), + Yap_InitSlot(Deref(ARG3)), + Yap_InitSlot(Deref(ARG4)), + Yap_InitSlot(Deref(ARG5)), + Yap_InitSlot(Deref(ARG6)), + Yap_InitSlot(Deref(ARG7)), + Yap_InitSlot(Deref(ARG8)), + Yap_InitSlot(Deref(ARG9)), + Yap_InitSlot(Deref(ARG10)), + ctx)); + } default: return(FALSE); } @@ -1375,7 +1435,7 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) Int val; CPredicateV codev = (CPredicateV)exec_code; struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1)); - + ctx->control = FRG_FIRST_CALL; ctx->engine = NULL; //(PL_local_data *)Yap_regp; ctx->context = NULL; diff --git a/library/yap2swi/blobs.c b/library/yap2swi/blobs.c new file mode 100644 index 000000000..efc080245 --- /dev/null +++ b/library/yap2swi/blobs.c @@ -0,0 +1,119 @@ +/************************************************************************* +* * +* YAP Prolog * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright V.Santos Costa and Universidade do Porto 1985-- * +* * +************************************************************************** +* * +* File: blobs.c * +* comments: support blobs in YAP definition * +* * +* Last rev: $Date: $,$Author: vsc $ * +* * +* * +*************************************************************************/ + +#include +#include + +#include + +#include + +#include "swi.h" + + +PL_EXPORT(int) +PL_is_blob(term_t t, PL_blob_t **type) +{ + Term yt = Yap_GetFromSlot(t); + Atom a; + BlobPropEntry *b; + + if (IsVarTerm(yt)) + return FALSE; + if (!IsAtomTerm(yt)) + return FALSE; + a = AtomOfTerm(yt); + if (!IsBlob(a)) + return FALSE; + b = RepBlobProp(a->PropsOfAE); + *type = b->blob_t; + return TRUE; +} + +PL_EXPORT(int) +PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type) +{ + fprintf(stderr,"PL_unify_blob not implemented yet\n"); + return FALSE; +} + +PL_EXPORT(int) +PL_put_blob(term_t t, void *blob, size_t len, PL_blob_t *type) +{ + fprintf(stderr,"PL_put_blob not implemented yet\n"); + return FALSE; +} + +PL_EXPORT(int) +PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type) +{ + fprintf(stderr,"PL_get_blob not implemented yet\n"); + return FALSE; +} + +PL_EXPORT(void*) +PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type) +{ + Atom x = SWIAtomToAtom(a); + + if (!IsBlob(x)) { + if (IsWideAtom(x)) { + if ( len ) + *len = wcslen(x->WStrOfAE); + if ( type ) + *type = SWI_Blobs; + return x->WStrOfAE; + } + if ( len ) + *len = strlen(x->StrOfAE); + if ( type ) + *type = SWI_Blobs; + return x->StrOfAE; + } + if ( len ) + *len = x->rep.blob.length; + if ( type ) + *type = RepBlobProp(x->PropsOfAE)->blob_t; + + return x->rep.blob.data; +} + +PL_EXPORT(void) +PL_register_blob_type(PL_blob_t *type) +{ + fprintf(stderr,"PL_register_blob_type not implemented yet\n"); +} + +PL_EXPORT(PL_blob_t*) +PL_find_blob_type(const char* name) +{ + fprintf(stderr,"PL_find_blob_type not implemented yet\n"); + return NULL; +} + +PL_EXPORT(int) +PL_unregister_blob_type(PL_blob_t *type) +{ + fprintf(stderr,"PL_unregister_blob_type not implemented yet\n"); + return FALSE; +} + +void +Yap_install_blobs(void) +{ + +} diff --git a/library/yap2swi/swi.h b/library/yap2swi/swi.h new file mode 100644 index 000000000..3032aece8 --- /dev/null +++ b/library/yap2swi/swi.h @@ -0,0 +1,126 @@ +void Yap_swi_install(void); +void Yap_install_blobs(void); + +/* Required by PL_error */ +#define ERR_NO_ERROR 0 +#define ERR_INSTANTIATION 1 /* void */ +#define ERR_TYPE 2 /* atom_t expected, term_t value */ +#define ERR_DOMAIN 3 /* atom_t domain, term_t value */ +#define ERR_REPRESENTATION 4 /* atom_t what */ +#define ERR_MODIFY_STATIC_PROC 5 /* predicate_t proc */ +#define ERR_EVALUATION 6 /* atom_t what */ +#define ERR_AR_TYPE 7 /* atom_t expected, Number value */ +#define ERR_NOT_EVALUABLE 8 /* functor_t func */ +#define ERR_DIV_BY_ZERO 9 /* void */ +#define ERR_FAILED 10 /* predicate_t proc */ +#define ERR_FILE_OPERATION 11 /* atom_t action, atom_t type, term_t */ +#define ERR_PERMISSION 12 /* atom_t type, atom_t op, term_t obj*/ +#define ERR_NOT_IMPLEMENTED 13 /* const char *what */ +#define ERR_EXISTENCE 14 /* atom_t type, term_t obj */ +#define ERR_STREAM_OP 15 /* atom_t action, term_t obj */ +#define ERR_RESOURCE 16 /* atom_t resource */ +#define ERR_NOMEM 17 /* void */ +#define ERR_SYSCALL 18 /* void */ +#define ERR_SHELL_FAILED 19 /* term_t command */ +#define ERR_SHELL_SIGNALLED 20 /* term_t command, int signal */ +#define ERR_AR_UNDEF 21 /* void */ +#define ERR_AR_OVERFLOW 22 /* void */ +#define ERR_AR_UNDERFLOW 23 /* void */ +#define ERR_UNDEFINED_PROC 24 /* Definition def */ +#define ERR_SIGNALLED 25 /* int sig, char *name */ +#define ERR_CLOSED_STREAM 26 /* IOSTREAM * */ +#define ERR_BUSY 27 /* mutexes */ +#define ERR_PERMISSION_PROC 28 /* op, type, Definition */ +#define ERR_DDE_OP 29 /* op, error */ +#define ERR_SYNTAX 30 /* what */ +#define ERR_SHARED_OBJECT_OP 31 /* op, error */ +#define ERR_TIMEOUT 32 /* op, object */ +#define ERR_NOT_IMPLEMENTED_PROC 33 /* name, arity */ +#define ERR_FORMAT 34 /* message */ +#define ERR_FORMAT_ARG 35 /* seq, term */ +#define ERR_OCCURS_CHECK 36 /* Word, Word */ +#define ERR_CHARS_TYPE 37 /* char *, term */ +#define ERR_MUST_BE_VAR 38 /* int argn, term_t term */ + +typedef struct open_query_struct { + int open; + int state; + YAP_Term g; + yamop *p, *cp; + Int slots; + jmp_buf env; + struct open_query_struct *old; +} open_query; + +#define addr_hash(V) (((CELL) (V)) >> 4 & (N_SWI_HASH-1)) + +static inline void +add_to_hash(Int i, ADDR key) +{ + UInt h = addr_hash(key); + while (SWI_ReverseHash[h].key) { + h = (h+1)%N_SWI_HASH; + } + SWI_ReverseHash[h].key = key; + SWI_ReverseHash[h].pos = i; +} + +static atom_t +in_hash(ADDR key) +{ + UInt h = addr_hash(key); + while (SWI_ReverseHash[h].key) { + if (SWI_ReverseHash[h].key == key) + return SWI_ReverseHash[h].pos; + h = (h+1)%N_SWI_HASH; + } + return 0; +} + + +static inline atom_t +AtomToSWIAtom(Atom at) +{ + atom_t ats; + if ((ats = in_hash((ADDR)at))) + return ats; + return (atom_t)at; +} + +static inline Atom +SWIAtomToAtom(atom_t at) +{ + if ((CELL)at & 1) + return SWI_Atoms[at>>1]; + return (Atom)at; +} + +static inline Term +SWIModuleToModule(module_t m) +{ + if (m) + return (CELL)m; + if (CurrentModule) + return CurrentModule; + return USER_MODULE; +} + +static inline functor_t +FunctorToSWIFunctor(Functor at) +{ + atom_t ats; + if ((ats = in_hash((ADDR)at))) + return (functor_t)ats; + return (functor_t)at; +} + +static inline Functor +SWIFunctorToFunctor(functor_t at) +{ + if (IsAtomTerm(at)) + return (Functor)at; + if ((CELL)(at) & 2) + return SWI_Functors[((CELL)at)/4]; + return (Functor)at; +} +