Improve SWI interface emulation.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1920 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/c_interface.c

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

changes-5.1.html

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

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)

include/YapInterface.h

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

library/yap2swi/yap2swi.c

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

library/yap2swi/yap2swi.h

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