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 2007-09-04 10:34:55 +00:00
parent b715dc4a60
commit 4c08960096
6 changed files with 262 additions and 7 deletions

View File

@ -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)
{

View File

@ -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

View File

@ -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)

View File

@ -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));

View File

@ -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)) {

View File

@ -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 *);