imore SWI compat, including string fixes

C/bignum.c

@@ -242,6 +242,86 @@ p_rational(void)
 #endif
 }
 
+Term
+Yap_MkBlobStringTerm(const char *s, size_t len)
+{
+  CELL *ret = H;
+  size_t sz;
+  MP_INT *dst = (MP_INT *)(H+2);
+  blob_string_t *sp;
+  size_t siz;
+
+  sz = strlen(s);
+  if (len > 0 && sz > len) sz = len;
+  if (len/sizeof(CELL) > (ASP-ret)-1024) {
+    return TermNil;
+  }
+  H[0] = (CELL)FunctorBigInt;
+  H[1] = BLOB_STRING;
+
+  siz = (sizeof(size_t)+len+sizeof(CELL))/sizeof(CELL);
+  dst->_mp_size = siz;
+  dst->_mp_alloc = 0L;
+  sp = (blob_string_t *)(dst+1);
+  sp->len = sz;
+  strncpy((char *)(sp+1), s, sz);
+  H += siz;
+  H[0] = EndSpecials;
+  H++;
+  return AbsAppl(ret);
+}
+
+Term
+Yap_MkBlobWideStringTerm(const wchar_t *s, size_t len)
+{
+  CELL *ret = H;
+  size_t sz;
+  MP_INT *dst = (MP_INT *)(H+2);
+  blob_string_t *sp;
+  size_t siz;
+
+  sz = wcslen(s);
+  if (len > 0 && sz > len) sz = len;
+  if (len/sizeof(CELL) > (ASP-ret)-1024) {
+    return TermNil;
+  }
+  H[0] = (CELL)FunctorBigInt;
+  H[1] = BLOB_WIDE_STRING;
+
+  siz = (sizeof(size_t)+(len+2)*sizeof(wchar_t))/sizeof(CELL);
+  dst->_mp_size = siz;
+  dst->_mp_alloc = 0L;
+  sp = (blob_string_t *)(dst+1);
+  sp->len = sz;
+  wcsncpy((wchar_t *)(sp+1), s, sz);
+  H += siz;
+  H[0] = EndSpecials;
+  H++;
+  return AbsAppl(ret);
+}
+
+char *
+Yap_BlobStringOfTerm(Term t)
+{
+  blob_string_t *new = (blob_string_t *)(RepAppl(t)+2+sizeof(MP_INT)/sizeof(CELL));
+  return (char *)(new+1);
+}
+
+wchar_t *
+Yap_BlobWideStringOfTerm(Term t)
+{
+  blob_string_t *new = (blob_string_t *)(RepAppl(t)+2+sizeof(MP_INT)/sizeof(CELL));
+  return (wchar_t *)(new+1);
+}
+
+char *
+Yap_BlobStringOfTermAndLength(Term t, size_t *sp)
+{
+  blob_string_t *new = (blob_string_t *)(RepAppl(t)+2+sizeof(MP_INT)/sizeof(CELL));
+  *sp = new->len;
+  return (char *)(new+1);
+}
+
 void
 Yap_InitBigNums(void)
 {

H/TermExt.h

@@ -75,7 +75,8 @@ typedef enum
     ARRAY_INT =    0x21,
     ARRAY_FLOAT =  0x22,
     CLAUSE_LIST =  0x40,
-    STRING =  0x80, /* unsupported, reserved */
+    BLOB_STRING =  0x80, /* SWI style strings */
+    BLOB_WIDE_STRING =  0x81, /* SWI style strings */
     EXTERNAL_BLOB =  0x100 /* for SWI emulation */
   } 
 big_blob_type;
@@ -385,6 +386,34 @@ IsLargeIntTerm (Term t)
 
 #endif
 
+typedef struct string_struct {
+  size_t len;
+}  blob_string_t;
+
+Term STD_PROTO (Yap_MkBlobStringTerm, (const char *, size_t len));
+Term STD_PROTO (Yap_MkBlobWideStringTerm, (const wchar_t *, size_t len));
+char *STD_PROTO (Yap_BlobStringOfTerm, (Term));
+wchar_t *STD_PROTO (Yap_BlobWideStringOfTerm, (Term));
+char *STD_PROTO (Yap_BlobStringOfTermAndLength, (Term, size_t *));
+
+inline EXTERN int IsBlobStringTerm (Term);
+
+inline EXTERN int
+IsBlobStringTerm (Term t)
+{
+  return (int) (IsApplTerm (t) &&
+		FunctorOfTerm (t) == FunctorBigInt &&
+		(RepAppl(t)[1] & BLOB_STRING) == BLOB_STRING);
+}
+
+inline EXTERN int
+IsWideBlobString (Term t)
+{
+  return (int) (IsApplTerm (t) &&
+		FunctorOfTerm (t) == FunctorBigInt &&
+		RepAppl(t)[1] == BLOB_WIDE_STRING);
+}
+
 /* extern Functor FunctorLongInt; */
 
 inline EXTERN int IsLargeNumTerm (Term);

include/SWI-Prolog.h

@@ -380,7 +380,6 @@ extern X_API int PL_get_name_arity(term_t, atom_t *, int *);
 extern X_API int PL_get_nil(term_t);
 extern X_API int PL_get_pointer(term_t, void **);
 extern X_API int PL_get_intptr(term_t, intptr_t *);
-extern X_API int PL_get_string(term_t, char **, int *);
 extern X_API int PL_get_tail(term_t, term_t);
 /* end PL_get_* functions  =============================*/
 /* begin PL_new_* functions =============================*/
@@ -409,6 +408,7 @@ extern X_API int PL_put_list_chars(term_t, const char *);
 extern X_API void PL_put_nil(term_t);
 extern X_API int PL_put_pointer(term_t, void *);
 extern X_API int PL_put_string_chars(term_t, const char *);
+extern X_API int PL_put_string_nchars(term_t, size_t, const char *);
 extern X_API int PL_put_term(term_t, term_t);
 extern X_API int PL_put_variable(term_t);
 extern X_API  int PL_compare(term_t, term_t);

library/yap2swi/yap2swi.c

@@ -417,22 +417,22 @@ X_API int PL_get_atom_chars(term_t ts, char **a)  /* SAM check type */
     BUF_MALLOC Data is copied to a new buffer returned by malloc(3)
 */
 
-static int CvtToStringTerm(YAP_Term t, char *buf, char *buf_max)
+static int CvtToStringTerm(Term t, char *buf, char *buf_max)
 {
-  while (YAP_IsPairTerm(t)) {
+  while (IsPairTerm(t)) {
-    YAP_Term hd = YAP_HeadOfTerm(t);
+    YAP_Term hd = HeadOfTerm(t);
     long int  i;
-    if (!YAP_IsIntTerm(hd))
+    if (!IsVarTerm(hd) || !IsIntTerm(hd))
       return 0;
-    i = YAP_IntOfTerm(hd);
+    i = IntOfTerm(hd);
     if (i <= 0 || i >= 255)
       return 0;
-    if (!YAP_IsIntTerm(hd))
+    if (!IsIntTerm(hd))
       return 0;
     *buf++ = i;
     if (buf == buf_max)
       return 0;
-    t = YAP_TailOfTerm(t);
+    t = TailOfTerm(t);
   }
   if (t != TermNil)
     return 0;
@@ -534,7 +534,10 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
     if (!(flags & (CVT_FLOAT|CVT_ATOMIC|CVT_NUMBER|CVT_ALL)))
       return 0;
     snprintf(tmp,BUF_SIZE,"%f",YAP_FloatOfTerm(t));
-  } else if (flags & (CVT_LIST|CVT_LIST)) {
+  } else if (flags & (CVT_STRING)) {
+    char *s = Yap_BlobStringOfTerm(t);
+    strncat(tmp, s, BUF_SIZE-1);
+  } else if (flags & CVT_LIST) {
     if (CvtToStringTerm(t,tmp,tmp+BUF_SIZE) == 0)
       return 0;
   } else {
@@ -669,6 +672,17 @@ X_API int PL_get_head(term_t ts, term_t h)
   return 1;
 }
 
+X_API int PL_get_string_chars(term_t t, char **s, size_t *len)
+{
+  Term tt = Yap_GetFromSlot(t);
+  if (!IsBlobStringTerm(tt)) {
+    return 0;
+  }
+  *s = Yap_BlobStringOfTermAndLength(tt, len);
+  return TRUE;
+}
+
+
 /* SWI: int PL_get_integer(term_t t, int *i)
    YAP: long int  YAP_IntOfTerm(Term) */
 X_API int PL_get_integer(term_t ts, int *i)
@@ -875,24 +889,6 @@ X_API int PL_get_pointer(term_t ts, void **i)
   return 1;
 }
 
-/* SWI: int PL_get_atom_chars(term_t t, char **s)
-   YAP: char* AtomName(Atom) */
-X_API int PL_get_string(term_t ts, char **sp, int *lenp)  /* SAM check type */
-{
-  YAP_Term t = Yap_GetFromSlot(ts);
-  char *to;
-  int len;
-  if (!YAP_IsPairTerm(t))
-    return 0;
-  if (!YAP_StringToBuffer(t, buffers, TMP_BUF_SIZE))
-      return(FALSE);
-  len = strlen(buffers);
-  to = (char *)Yap_NewSlots((len/sizeof(YAP_Term))+1);
-  strncpy(to, buffers, TMP_BUF_SIZE);
-  *sp = to;
-  return 1;
-}
-
 X_API int PL_get_tail(term_t ts, term_t tl)
 {
   YAP_Term t = Yap_GetFromSlot(ts);
@@ -1244,9 +1240,13 @@ X_API int PL_put_pointer(term_t t, void *ptr)
   return TRUE;
 }
 
-X_API int PL_put_string_chars(term_t t, const char *s)
+X_API int PL_put_string_nchars(term_t t, size_t len, const char *chars)
 {
-  Yap_PutInSlot(t,YAP_BufferToString((char *)s));
+  Term tt;
+
+  if ((tt = Yap_MkBlobStringTerm(chars, len)) == TermNil)
+    return FALSE;
+  Yap_PutInSlot(t,tt);
   return TRUE;
 }
 
@@ -1796,6 +1796,8 @@ X_API int PL_unify_wchars(term_t t, int type, size_t len, const pl_wchar_t *char
     }
     break;
   case PL_STRING:
+    chterm = Yap_MkBlobWideStringTerm(chars, len);
+    break;
   case PL_CODE_LIST:
     chterm = YAP_NWideBufferToString(chars, len);
     break;
@@ -1824,7 +1826,6 @@ X_API int PL_unify_wchars_diff(term_t t, term_t tail, int type, size_t len, cons
     len = wcslen(chars);
 
   switch (type) {
-  case PL_STRING:
   case PL_CODE_LIST:
     chterm = YAP_NWideBufferToDiffList(chars, Yap_GetFromSlot(tail), len);
     break;
@@ -1963,7 +1964,7 @@ X_API int PL_unify_term(term_t l,...)
 	*pt++ = MkFloatTerm(va_arg(ap, double));
 	break;
       case PL_STRING:
-	*pt++ = YAP_BufferToString(va_arg(ap, char *));
+	*pt++ = Yap_MkBlobStringTerm(va_arg(ap, char *), -1);
 	break;
       case PL_CHARS:
 	{
@@ -2149,12 +2150,6 @@ X_API void PL_unregister_atom(atom_t atom)
   Yap_AtomDecreaseHold(SWIAtomToAtom(atom));
 }
 
-X_API int PL_get_string_chars(term_t t, char **s, size_t *len)
-{
-  /* there are no such objects in Prolog */
-  return FALSE;
-}
-
 X_API int PL_term_type(term_t t)
 {
   /* YAP_ does not support strings as different objects */