Improve SWI interface emulation.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1920 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
b715dc4a60
commit
4c08960096
@ -10,8 +10,12 @@
|
||||
* File: c_interface.c *
|
||||
* comments: c_interface primitives definition *
|
||||
* *
|
||||
* Last rev: $Date: 2007-06-04 12:28:01 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2007-09-04 10:34:54 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.95 2007/06/04 12:28:01 vsc
|
||||
* interface speedups
|
||||
* bad error message in X is foo>>2.
|
||||
*
|
||||
* Revision 1.94 2007/05/15 11:33:51 vsc
|
||||
* fix min list
|
||||
*
|
||||
@ -241,6 +245,9 @@
|
||||
#if HAVE_STDARG_H
|
||||
#include <stdarg.h>
|
||||
#endif
|
||||
#if HAVE_STRING_H
|
||||
#include <string.h>
|
||||
#endif
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
#include <windows.h>
|
||||
#endif
|
||||
@ -291,8 +298,12 @@ X_API flt STD_PROTO(YAP_FloatOfTerm,(Term));
|
||||
X_API Term STD_PROTO(YAP_MkAtomTerm,(Atom));
|
||||
X_API Atom STD_PROTO(YAP_AtomOfTerm,(Term));
|
||||
X_API Atom STD_PROTO(YAP_LookupAtom,(char *));
|
||||
X_API Atom STD_PROTO(YAP_LookupWideAtom,(wchar_t *));
|
||||
X_API int STD_PROTO(YAP_AtomNameLength,(Atom));
|
||||
X_API Atom STD_PROTO(YAP_FullLookupAtom,(char *));
|
||||
X_API int STD_PROTO(YAP_IsWideAtom,(Atom));
|
||||
X_API char *STD_PROTO(YAP_AtomName,(Atom));
|
||||
X_API wchar_t *STD_PROTO(YAP_WideAtomName,(Atom));
|
||||
X_API Term STD_PROTO(YAP_MkPairTerm,(Term,Term));
|
||||
X_API Term STD_PROTO(YAP_MkNewPairTerm,(void));
|
||||
X_API Term STD_PROTO(YAP_HeadOfTerm,(Term));
|
||||
@ -580,6 +591,12 @@ YAP_AtomOfTerm(Term t)
|
||||
}
|
||||
|
||||
|
||||
X_API int
|
||||
YAP_IsWideAtom(Atom a)
|
||||
{
|
||||
return IsWideAtom(a);
|
||||
}
|
||||
|
||||
X_API char *
|
||||
YAP_AtomName(Atom a)
|
||||
{
|
||||
@ -589,6 +606,12 @@ YAP_AtomName(Atom a)
|
||||
return(o);
|
||||
}
|
||||
|
||||
X_API wchar_t *
|
||||
YAP_WideAtomName(Atom a)
|
||||
{
|
||||
return RepAtom(a)->WStrOfAE;
|
||||
}
|
||||
|
||||
X_API Atom
|
||||
YAP_LookupAtom(char *c)
|
||||
{
|
||||
@ -606,6 +629,23 @@ YAP_LookupAtom(char *c)
|
||||
}
|
||||
}
|
||||
|
||||
X_API Atom
|
||||
YAP_LookupWideAtom(wchar_t *c)
|
||||
{
|
||||
Atom a;
|
||||
|
||||
while (TRUE) {
|
||||
a = Yap_LookupWideAtom(c);
|
||||
if (a == NIL || (ActiveSignals & YAP_CDOVF_SIGNAL)) {
|
||||
if (!Yap_growheap(FALSE, 0, NULL)) {
|
||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
|
||||
}
|
||||
} else {
|
||||
return a;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
X_API Atom
|
||||
YAP_FullLookupAtom(char *c)
|
||||
{
|
||||
@ -623,6 +663,20 @@ YAP_FullLookupAtom(char *c)
|
||||
}
|
||||
}
|
||||
|
||||
X_API int
|
||||
YAP_AtomNameLength(Atom at)
|
||||
{
|
||||
if (IsWideAtom(at)) {
|
||||
wchar_t *c = RepAtom(at)->WStrOfAE;
|
||||
|
||||
return wcslen(c);
|
||||
} else {
|
||||
char *c = RepAtom(at)->StrOfAE;
|
||||
|
||||
return strlen(c);
|
||||
}
|
||||
}
|
||||
|
||||
X_API Term
|
||||
YAP_MkVarTerm(void)
|
||||
{
|
||||
|
||||
@ -16,6 +16,8 @@
|
||||
|
||||
<h2>Yap-5.1.3:</h2>
|
||||
<ul>
|
||||
<li> FIXED: updates to SWI C-interface and corresponding extensions to
|
||||
C-interface .</li>
|
||||
<li> FIXED: be careful to give delayarena exactly what it needs to expand.</li>
|
||||
<li> FIXED: improve BNT support with CLP(BN).</li>
|
||||
<li> FIXED: support checking for big_nums and readline. (obs from
|
||||
|
||||
27
docs/yap.tex
27
docs/yap.tex
@ -12609,6 +12609,33 @@ atom had been "hidden": this is useful for system maintenance from C
|
||||
code. The functor @code{YAP_AtomName} returns a pointer to the string
|
||||
for the atom.
|
||||
|
||||
@noindent
|
||||
@findex YAP_IsWideAtom (C-Interface function)
|
||||
@findex YAP_LookupWideAtom (C-Interface function)
|
||||
@findex YAP_WideAtomName (C-Interface function)
|
||||
The following primitives handle constructing atoms from strings with
|
||||
wide characters, and vice-versa:
|
||||
@example
|
||||
YAP_Atom YAP_LookupWideAtom(wchar_t * @var{s})
|
||||
wchar_t *YAP_WideAtomName(YAP_Atom @var{t})
|
||||
@end example
|
||||
|
||||
@noindent
|
||||
@findex YAP_IsIsWideAtom (C-Interface function)
|
||||
The following primitive tells whether an atom needs wide atoms in its
|
||||
representation:
|
||||
@example
|
||||
int YAP_IsWideAtom(YAP_Atom @var{t})
|
||||
@end example
|
||||
|
||||
@noindent
|
||||
@findex YAP_AtomNameLength (C-Interface function)
|
||||
The following primitive can be used to obtain the size of an atom in a
|
||||
representation-independent way:
|
||||
@example
|
||||
int YAP_AtomNameLength(YAP_Atom @var{t})
|
||||
@end example
|
||||
|
||||
@findex YAP_MkPairTerm (C-Interface function)
|
||||
@findex YAP_MkNewPairTerm (C-Interface function)
|
||||
@findex YAP_HeadOfTerm (C-Interface function)
|
||||
|
||||
@ -32,6 +32,8 @@
|
||||
#include <stdarg.h>
|
||||
#endif
|
||||
|
||||
#include <wchar.h>
|
||||
|
||||
/*
|
||||
__BEGIN_DECLS should be used at the beginning of the C declarations,
|
||||
so that C++ compilers don't mangle their names. __END_DECLS is used
|
||||
@ -133,12 +135,24 @@ extern X_API YAP_Atom PROTO(YAP_AtomOfTerm,(YAP_Term));
|
||||
/* YAP_Atom LookupAtom(const char *) */
|
||||
extern X_API YAP_Atom PROTO(YAP_LookupAtom,(CONST char *));
|
||||
|
||||
/* YAP_Atom LookupWideAtom(const wchar_t *) */
|
||||
extern X_API YAP_Atom PROTO(YAP_LookupWideAtom,(CONST wchar_t *));
|
||||
|
||||
/* YAP_Atom FullLookupAtom(const char *) */
|
||||
extern X_API YAP_Atom PROTO(YAP_FullLookupAtom,(CONST char *));
|
||||
|
||||
/* int AtomNameLength(Atom) */
|
||||
extern X_API int PROTO(YAP_AtomNameLength,(YAP_Atom));
|
||||
|
||||
/* const char* IsWideAtom(YAP_Atom) */
|
||||
extern X_API int *PROTO(YAP_IsWideAtom,(YAP_Atom));
|
||||
|
||||
/* const char* AtomName(YAP_Atom) */
|
||||
extern X_API CONST char *PROTO(YAP_AtomName,(YAP_Atom));
|
||||
|
||||
/* const wchar_t* AtomWideName(YAP_Atom) */
|
||||
extern X_API CONST wchar_t *PROTO(YAP_WideAtomName,(YAP_Atom));
|
||||
|
||||
/* YAP_Term MkPairTerm(YAP_Term Head, YAP_Term Tail) */
|
||||
extern X_API YAP_Term PROTO(YAP_MkPairTerm,(YAP_Term,YAP_Term));
|
||||
|
||||
|
||||
@ -18,8 +18,9 @@
|
||||
|
||||
#define BUF_SIZE 256
|
||||
#define TMP_BUF_SIZE 2*BUF_SIZE
|
||||
#define BUF_RINGS 16
|
||||
|
||||
char buffers[TMP_BUF_SIZE+BUF_SIZE*4];
|
||||
char buffers[TMP_BUF_SIZE+BUF_SIZE*BUF_RINGS];
|
||||
static int buf_index = 0;
|
||||
|
||||
static char *
|
||||
@ -27,7 +28,7 @@ alloc_ring_buf(void)
|
||||
{
|
||||
int ret = buf_index;
|
||||
buf_index++;
|
||||
if (buf_index == 4)
|
||||
if (buf_index == BUF_RINGS)
|
||||
buf_index = 0;
|
||||
return buffers+(TMP_BUF_SIZE+ret*BUF_SIZE);
|
||||
}
|
||||
@ -130,7 +131,7 @@ X_API int PL_get_atom_chars(term_t ts, char **a) /* SAM check type */
|
||||
term-types should converted and the second how the argument is
|
||||
stored. Below is a specification of these constants. BUF_RING
|
||||
implies, if the data is not static (as from an atom), the data is
|
||||
copied to the next buffer from a ring of four (4) buffers. This is a
|
||||
copied to the next buffer from a ring of sixteen (16) buffers. This is a
|
||||
convenient way of converting multiple arguments passed to a foreign
|
||||
predicate to C-strings. If BUF_MALLOC is used, the data must be
|
||||
freed using free() when not needed any longer.
|
||||
@ -204,9 +205,14 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
|
||||
}
|
||||
*sp = tmp;
|
||||
if (YAP_IsAtomTerm(t)) {
|
||||
YAP_Atom at = YAP_AtomOfTerm(t);
|
||||
if (!(flags & (CVT_ATOM|CVT_ATOMIC|CVT_ALL)))
|
||||
return 0;
|
||||
*sp = (char *)YAP_AtomName(YAP_AtomOfTerm(t));
|
||||
if (YAP_IsWideAtom(at))
|
||||
/* will this always work? */
|
||||
snprintf(*sp,BUF_SIZE,"%ls",YAP_WideAtomName(at));
|
||||
else
|
||||
*sp = (char *)YAP_AtomName(YAP_AtomOfTerm(t));
|
||||
return 1;
|
||||
} else if (YAP_IsIntTerm(t)) {
|
||||
if (!(flags & (CVT_INTEGER|CVT_NUMBER|CVT_ATOMIC|CVT_ALL)))
|
||||
@ -228,7 +234,7 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
|
||||
*bf = '\0';
|
||||
}
|
||||
if (flags & BUF_MALLOC) {
|
||||
char *nbf = malloc(strlen(tmp));
|
||||
char *nbf = YAP_AllocSpaceFromYap(strlen(tmp)+1);
|
||||
if (nbf == NULL)
|
||||
return 0;
|
||||
strncpy(nbf,tmp,BUF_SIZE);
|
||||
@ -237,6 +243,57 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
|
||||
return 1;
|
||||
}
|
||||
|
||||
X_API int PL_get_nchars(term_t l, size_t *len, char **sp, unsigned flags)
|
||||
{
|
||||
int out = PL_get_chars(l, sp, flags);
|
||||
if (!out) return out;
|
||||
*len = strlen(*sp);
|
||||
return out;
|
||||
}
|
||||
|
||||
|
||||
/* same as get_chars, but works on buffers of wide chars */
|
||||
X_API int PL_get_wchars(term_t l, size_t *len, wchar_t **wsp, unsigned flags)
|
||||
{
|
||||
if (YAP_IsAtomTerm(l)) {
|
||||
YAP_Atom at = YAP_AtomOfTerm(l);
|
||||
|
||||
if (!(flags & (CVT_ATOM|CVT_ATOMIC|CVT_ALL)))
|
||||
return 0;
|
||||
if (YAP_IsWideAtom(at))
|
||||
/* will this always work? */
|
||||
*wsp = (wchar_t *)YAP_WideAtomName(at);
|
||||
} else {
|
||||
char *sp;
|
||||
int res = PL_get_chars(l, &sp, ((flags & ~(BUF_MALLOC|BUF_DISCARDABLE))|BUF_RING));
|
||||
size_t sz;
|
||||
|
||||
if (!res)
|
||||
return FALSE;
|
||||
sz = wcstombs(sp,NULL,BUF_SIZE);
|
||||
if (flags & BUF_MALLOC) {
|
||||
wchar_t *nbf = (wchar_t *)YAP_AllocSpaceFromYap(sz+1);
|
||||
if (nbf == NULL)
|
||||
return 0;
|
||||
*wsp = nbf;
|
||||
} else if (flags & BUF_DISCARDABLE) {
|
||||
wchar_t *buf = (wchar_t *)buffers;
|
||||
|
||||
if (wcstombs(sp,buf,BUF_SIZE) == -1)
|
||||
return 0;
|
||||
*wsp = buf;
|
||||
} else {
|
||||
wchar_t *tmp = (wchar_t *)alloc_ring_buf();
|
||||
if (wcstombs(sp, tmp, BUF_SIZE) == -1)
|
||||
return 0;
|
||||
*wsp = tmp;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
/* SWI: int PL_get_functor(term_t t, functor_t *f)
|
||||
YAP: YAP_Functor YAP_FunctorOfTerm(Term) */
|
||||
X_API int PL_get_functor(term_t ts, functor_t *f)
|
||||
@ -299,6 +356,35 @@ X_API int PL_get_long(term_t ts, long *i)
|
||||
return 1;
|
||||
}
|
||||
|
||||
X_API int PL_get_int64(term_t ts, int64_t *i)
|
||||
{
|
||||
YAP_Term t = YAP_GetFromSlot(ts);
|
||||
if (!YAP_IsIntTerm(t) ) {
|
||||
if (YAP_IsFloatTerm(t)) {
|
||||
double dbl = YAP_FloatOfTerm(t);
|
||||
if (dbl - (int64_t)dbl == 0.0) {
|
||||
*i = (int64_t)dbl;
|
||||
return 1;
|
||||
}
|
||||
#if USE_GMP
|
||||
} else if (YAP_IsBigIntTerm(t)) {
|
||||
MP_INT *g;
|
||||
char s[64];
|
||||
YAP_BigNumOfTerm(t, (void *)g);
|
||||
if (mpz_sizeinbase(g,2) > 64) {
|
||||
return 0;
|
||||
}
|
||||
mpz_get_str (s, 10, g);
|
||||
sscanf(s, "%lld", (long long int *)i);
|
||||
return 1;
|
||||
#endif
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
*i = YAP_IntOfTerm(t);
|
||||
return 1;
|
||||
}
|
||||
|
||||
X_API int PL_get_list(term_t ts, term_t h, term_t tl)
|
||||
{
|
||||
YAP_Term t = YAP_GetFromSlot(ts);
|
||||
@ -419,6 +505,25 @@ X_API atom_t PL_new_atom(const char *c)
|
||||
return (atom_t)YAP_LookupAtom((char *)c);
|
||||
}
|
||||
|
||||
X_API atom_t PL_new_atom_wchars(int len, const wchar_t *c)
|
||||
{
|
||||
return (atom_t)YAP_LookupWideAtom((wchar_t *)c);
|
||||
}
|
||||
|
||||
X_API char *PL_atom_nchars(atom_t name, size_t *sp)
|
||||
{
|
||||
*sp = YAP_AtomNameLength((YAP_Atom)name);
|
||||
return (char *)YAP_AtomName((YAP_Atom)name);
|
||||
}
|
||||
|
||||
X_API wchar_t *PL_atom_wchars(atom_t name, size_t *sp)
|
||||
{
|
||||
if (!YAP_IsWideAtom((YAP_Atom)name))
|
||||
return NULL;
|
||||
*sp = YAP_AtomNameLength((YAP_Atom)name);
|
||||
return (wchar_t *)YAP_WideAtomName((YAP_Atom)name);
|
||||
}
|
||||
|
||||
X_API functor_t PL_new_functor(atom_t name, int arity)
|
||||
{
|
||||
functor_t f;
|
||||
@ -532,6 +637,18 @@ X_API void PL_put_integer(term_t t, long n)
|
||||
YAP_PutInSlot(t,YAP_MkIntTerm(n));
|
||||
}
|
||||
|
||||
X_API void PL_put_int64(term_t t, int64_t n)
|
||||
{
|
||||
#if HAVE_GMP
|
||||
char s[64];
|
||||
MP_INT *rop;
|
||||
|
||||
sprintf(s, "%lld", (long long int)n);
|
||||
mpz_init_set_str (rop, s, 10);
|
||||
YAP_PutInSlot(t,YAP_MkBigIntTerm((void *)rop));
|
||||
#endif
|
||||
}
|
||||
|
||||
X_API void PL_put_list(term_t t)
|
||||
{
|
||||
YAP_PutInSlot(t,YAP_MkNewPairTerm());
|
||||
@ -623,6 +740,24 @@ X_API int PL_unify_integer(term_t t, long n)
|
||||
return YAP_Unify(YAP_GetFromSlot(t),iterm);
|
||||
}
|
||||
|
||||
/* SWI: int PL_unify_integer(term_t ?t, long n)
|
||||
YAP long int unify(YAP_Term* a, Term* b) */
|
||||
X_API int PL_unify_int64(term_t t, int64_t n)
|
||||
{
|
||||
#if HAVE_GMP
|
||||
YAP_Term iterm;
|
||||
char s[64];
|
||||
MP_INT *rop;
|
||||
|
||||
sprintf(s, "%lld", (long long int)n);
|
||||
mpz_init_set_str (rop, s, 10);
|
||||
iterm = YAP_MkBigIntTerm((void *)rop);
|
||||
return YAP_Unify(YAP_GetFromSlot(t),iterm);
|
||||
#else
|
||||
return FALSE;
|
||||
#endif
|
||||
}
|
||||
|
||||
/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
|
||||
YAP long int unify(YAP_Term* a, Term* b) */
|
||||
X_API int PL_unify_list(term_t t, term_t h, term_t tail)
|
||||
@ -1055,6 +1190,13 @@ PL_is_initialised(int *argc, char ***argv)
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
X_API atom_t PL_module_name(module_t m)
|
||||
{
|
||||
YAP_Atom at = YAP_AtomOfTerm((YAP_Term)m);
|
||||
YAP_CreateModule(at);
|
||||
return (atom_t)at;
|
||||
}
|
||||
|
||||
X_API predicate_t PL_pred(functor_t f, module_t m)
|
||||
{
|
||||
if (YAP_IsAtomTerm(f)) {
|
||||
|
||||
@ -34,6 +34,12 @@ typedef struct open_query_struct *qid_t;
|
||||
typedef long functor_t;
|
||||
typedef int (*PL_agc_hook_t)(atom_t);
|
||||
typedef unsigned long foreign_t; /* return type of foreign functions */
|
||||
#ifdef WIN32
|
||||
typedef __int64 int64_t;
|
||||
typedef unsigned __int64 uint64_t;
|
||||
#else
|
||||
#include <inttypes.h> /* more portable than stdint.h */
|
||||
#endif
|
||||
|
||||
typedef void *function_t;
|
||||
|
||||
@ -126,7 +132,8 @@ typedef void *PL_engine_t;
|
||||
typedef void install_t;
|
||||
|
||||
extern X_API PL_agc_hook_t PL_agc_hook(PL_agc_hook_t);
|
||||
extern X_API char* PL_atom_chars(atom_t);
|
||||
extern X_API void PL_free(void *);
|
||||
extern X_API char* PL_atom_chars(atom_t);
|
||||
extern X_API term_t PL_copy_term_ref(term_t);
|
||||
extern X_API term_t PL_new_term_ref(void);
|
||||
extern X_API term_t PL_new_term_refs(int);
|
||||
@ -136,14 +143,18 @@ extern X_API int PL_get_arg(int, term_t, term_t);
|
||||
extern X_API int PL_get_atom(term_t, atom_t *);
|
||||
extern X_API int PL_get_atom_chars(term_t, char **);
|
||||
extern X_API int PL_get_chars(term_t, char **, unsigned);
|
||||
extern X_API int PL_get_nchars(term_t, size_t *, char **, unsigned);
|
||||
extern X_API int PL_get_wchars(term_t, size_t *, wchar_t **, unsigned);
|
||||
extern X_API int PL_get_functor(term_t, functor_t *);
|
||||
extern X_API int PL_get_float(term_t, double *);
|
||||
extern X_API int PL_get_head(term_t, term_t);
|
||||
extern X_API int PL_get_int64(term_t, int64_t *);
|
||||
extern X_API int PL_get_integer(term_t, int *);
|
||||
extern X_API int PL_get_list(term_t, term_t, term_t);
|
||||
extern X_API int PL_get_long(term_t, long *);
|
||||
extern X_API int PL_get_list_chars(term_t, char **, unsigned);
|
||||
extern X_API int PL_get_module(term_t, module_t *);
|
||||
extern X_API atom_t PL_module_name(module_t);
|
||||
extern X_API module_t PL_new_module(atom_t);
|
||||
extern X_API int PL_get_name_arity(term_t, atom_t *, int *);
|
||||
extern X_API int PL_get_nil(term_t);
|
||||
@ -153,6 +164,9 @@ extern X_API int PL_get_tail(term_t, term_t);
|
||||
/* end PL_get_* functions =============================*/
|
||||
/* begin PL_new_* functions =============================*/
|
||||
extern X_API atom_t PL_new_atom(const char *);
|
||||
extern X_API atom_t PL_new_atom_wchars(int, const wchar_t *);
|
||||
extern X_API char *PL_atom_nchars(atom_t, size_t *);
|
||||
extern X_API wchar_t *PL_atom_wchars(atom_t, size_t *);
|
||||
extern X_API functor_t PL_new_functor(atom_t, int);
|
||||
extern X_API atom_t PL_functor_name(functor_t);
|
||||
extern X_API int PL_functor_arity(functor_t);
|
||||
@ -165,6 +179,7 @@ extern X_API void PL_put_atom(term_t, atom_t);
|
||||
extern X_API void PL_put_atom_chars(term_t, const char *);
|
||||
extern X_API void PL_put_float(term_t, double);
|
||||
extern X_API void PL_put_functor(term_t, functor_t t);
|
||||
extern X_API void PL_put_int64(term_t, int64_t);
|
||||
extern X_API void PL_put_integer(term_t, long);
|
||||
extern X_API void PL_put_list(term_t);
|
||||
extern X_API void PL_put_list_chars(term_t, const char *);
|
||||
@ -180,6 +195,7 @@ extern X_API int PL_unify(term_t, term_t);
|
||||
extern X_API int PL_unify_atom(term_t, atom_t);
|
||||
extern X_API int PL_unify_atom_chars(term_t, const char *);
|
||||
extern X_API int PL_unify_float(term_t, double);
|
||||
extern X_API int PL_unify_int64(term_t, int64_t);
|
||||
extern X_API int PL_unify_integer(term_t, long);
|
||||
extern X_API int PL_unify_list(term_t, term_t, term_t);
|
||||
extern X_API int PL_unify_list_chars(term_t, const char *);
|
||||
|
||||
Reference in New Issue
Block a user