improve string support

fix non-thread compilation.

C/bignum.c

@@ -245,6 +245,36 @@ p_rational( USES_REGS1 )
 #endif
 }
 
+int
+Yap_IsStringTerm(Term t)
+{
+  CELL fl;
+  if (IsVarTerm(t))
+    return FALSE;
+  if (!IsApplTerm(t))
+    return FALSE;
+  if (FunctorOfTerm(t) != FunctorBigInt)
+    return FALSE;
+
+  fl = RepAppl(t)[1];
+  return fl == BLOB_STRING || fl == BLOB_WIDE_STRING;
+}
+
+int
+Yap_IsWideStringTerm(Term t)
+{
+  CELL fl;
+  if (IsVarTerm(t))
+    return FALSE;
+  if (!IsApplTerm(t))
+    return FALSE;
+  if (FunctorOfTerm(t) != FunctorBigInt)
+    return FALSE;
+
+  fl = RepAppl(t)[1];
+  return fl == BLOB_WIDE_STRING;
+}
+
 Term
 Yap_MkBlobStringTerm(const char *s, size_t len)
 {
@@ -267,8 +297,10 @@ Yap_MkBlobStringTerm(const char *s, size_t len)
   dst->_mp_size = siz;
   dst->_mp_alloc = 0L;
   sp = (blob_string_t *)(dst+1);
+  H = (CELL *)sp;
   sp->len = sz;
-  strncpy((char *)(sp+1), s, sz);
+  strncpy((char *)(sp+1), s, sz+1);
+  fprintf(stderr,"%s\n", (char *)(sp+1));
   H += siz;
   H[0] = EndSpecials;
   H++;
@@ -297,6 +329,7 @@ Yap_MkBlobWideStringTerm(const wchar_t *s, size_t len)
   dst->_mp_size = siz;
   dst->_mp_alloc = 0L;
   sp = (blob_string_t *)(dst+1);
+  H = (CELL *)sp;
   sp->len = sz;
   wcsncpy((wchar_t *)(sp+1), s, sz);
   H += siz;

C/c_interface.c

@@ -3498,14 +3498,14 @@ X_API int
 YAP_Erase(void *handle)
 {
   DBRecordList *dbr = (DBRecordList *)handle;
-  Yap_ReleaseTermFromDB(dbr->dbrecord);
   if (dbr->next_rec) 
     dbr->next_rec->prev_rec = dbr->prev_rec;
   if (dbr->prev_rec) 
-    dbr->next_rec->prev_rec = dbr->next_rec;
+    dbr->prev_rec->next_rec = dbr->next_rec;
   else if (Yap_Records == dbr) {
     Yap_Records = dbr->next_rec;
   }
+  Yap_ReleaseTermFromDB(dbr->dbrecord);
   Yap_FreeCodeSpace(handle);
   return 1;
 }

C/init.c

@@ -1257,16 +1257,20 @@ InitCodes(void)
 {
   CACHE_REGS
   int wid;
-  for (wid = 1; wid < MAX_INITS; wid++) {
 #if THREADS
+  for (wid = 1; wid < MAX_INITS; wid++) {
     Yap_WLocal[wid] = NULL;
   }
 #endif
 #include "ihstruct.h"
+#if THREADS
   Yap_InitThread(0);
+#endif
   InitGlobal();
   InitWorker(0);
+#if THREADS
   InitFirstWorkerThreadHandle();
+#endif
   /* make sure no one else can use these two atoms */
   CurrentModule = 0;
   Yap_ReleaseAtom(AtomOfTerm(TermReFoundVar));

C/stdpreds.c

@@ -1652,15 +1652,22 @@ p_atom_codes( USES_REGS1 )
     Term            NewT;
     Atom at;
 
-    if (!IsAtomTerm(t1)) {
+    if (Yap_IsStringTerm(t1)) {
+      if (Yap_IsWideStringTerm(t1)) {
+	NewT = Yap_WideStringToList(Yap_BlobWideStringOfTerm(t1));
+      } else {
+	NewT = Yap_StringToList(Yap_BlobStringOfTerm(t1));
+      }
+    } else if (!IsAtomTerm(t1)) {
       Yap_Error(TYPE_ERROR_ATOM, t1, "atom_codes/2");
       return(FALSE);
-    }
-    at = AtomOfTerm(t1);
-    if (IsWideAtom(at)) {
-      NewT = Yap_WideStringToList((wchar_t *)RepAtom(at)->StrOfAE);
     } else {
-      NewT = Yap_StringToList(RepAtom(at)->StrOfAE);
+      at = AtomOfTerm(t1);
+      if (IsWideAtom(at)) {
+	NewT = Yap_WideStringToList((wchar_t *)RepAtom(at)->StrOfAE);
+      } else {
+	NewT = Yap_StringToList(RepAtom(at)->StrOfAE);
+      }
     }
     return (Yap_unify(NewT, ARG2));
   } else {

H/Yapproto.h

@@ -116,6 +116,8 @@ void   STD_PROTO(Yap_InitBBPreds,(void));
 
 /* bignum.c */
 Term   STD_PROTO(Yap_MkULLIntTerm, (YAP_ULONG_LONG));
+int    STD_PROTO(Yap_IsStringTerm, (Term));
+int    STD_PROTO(Yap_IsWideStringTerm, (Term));
 Term   STD_PROTO(Yap_RatTermToApplTerm, (Term));
 void   STD_PROTO(Yap_InitBigNums, (void));
 

include/SWI-Prolog.h

@@ -142,6 +142,8 @@ typedef wchar_t pl_wchar_t;             /* wide character support */
 typedef uintptr_t	PL_fid_t;	/* opaque foreign context handle */
 #endif
 
+#define O_STRING 1
+
 typedef void *pl_function_t;
 
 #define fid_t PL_fid_t			/* avoid AIX name-clash */

library/dialect/swi/fli/swi.c

@@ -1792,22 +1792,8 @@ X_API int PL_is_number(term_t ts)
 X_API int PL_is_string(term_t ts)
 {
   CACHE_REGS
-  YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
+  Term t = Yap_GetFromSlot(ts PASS_REGS);
-  while (YAP_IsPairTerm(t)) {
+  return Yap_IsStringTerm(t);
-    YAP_Term hd = YAP_HeadOfTerm(t);
-    long int  i;
-    if (!YAP_IsIntTerm(hd))
-      return 0;
-    i = YAP_IntOfTerm(hd);
-    if (i <= 0 || i >= 255)
-      return 0;
-    if (!YAP_IsIntTerm(hd))
-      return 0;
-    t = YAP_TailOfTerm(t);
-  }
-  if (t != TermNil)
-    return 0;
-  return FALSE;
 }
 
 X_API int PL_is_variable(term_t ts)

packages/PLStream/pl-file.c

@@ -4672,6 +4672,7 @@ EndPredDefs
 
 #if __YAP_PROLOG__
 
+static int
 pl_get_time(term_t t)
 { return PL_unify_float(t, WallTime());
 }
@@ -4728,10 +4729,12 @@ struct PL_local_data *Yap_InitThreadIO(int wid)
     Yap_Error(OUT_OF_HEAP_ERROR, 0L, "Creating thread %d\n", wid);
     return p;
   }
+#if THREADS
   if (wid) {
     /* copy from other worker */
     memcpy(p, Yap_WLocal[worker_id]->Yap_ld_, sizeof(struct PL_local_data));
   }
+#endif
   return p;
 }
 

packages/PLStream/pl-incl.h

@@ -597,9 +597,11 @@ extern void PL_cleanup_fork(void);
 extern int PL_rethrow(void);
 extern void PL_get_number(term_t l, number *n);
 extern int PL_unify_atomic(term_t t, PL_atomic_t a);
+extern int _PL_unify_atomic(term_t t, PL_atomic_t a);
+extern int _PL_unify_string(term_t t, word w);
 
 #define _PL_get_arg(X,Y,Z) PL_get_arg(X,Y,Z)
-#define _PL_unify_atomic PL_unify_atomic
+
 extern IOSTREAM **			/* provide access to Suser_input, */
   _PL_streams(void);			/* Suser_output and Suser_error */
 

packages/PLStream/pl-text.c

@@ -353,7 +353,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
     { word w = textToString(text);
 
       if ( w )
-	return _PL_unify_atomic(term, w);
+	return _PL_unify_string(term, w);
       else
 	return FALSE;
     }

packages/PLStream/pl-yap.c

@@ -77,15 +77,13 @@ codeToAtom(int chrcode)
 word
 globalString(size_t size, char *s)
 {
-  // return YAP_MkBlobStringTerm(s, size);
+  return Yap_MkBlobStringTerm(s, size);
-  return 0L;
 }
 
 word
 globalWString(size_t size, wchar_t *s)
 {
-  // return YAP_MkBlobWideStringTerm(size, s);
+  return Yap_MkBlobWideStringTerm(s, size);
-  return 0L;
 }
 
 int
@@ -282,6 +280,13 @@ _PL_unify_atomic(term_t t, PL_atomic_t a)
   return PL_unify_atom(t, a);
 }
 
+int
+_PL_unify_string(term_t t, word w)
+{
+  GET_LD
+  return Yap_unify(Yap_GetFromSlot(t PASS_REGS), w);
+}
+
 word lookupAtom(const char *s, size_t len)
 {
   /* dirty trick to ensure s is null terminated */
@@ -377,7 +382,21 @@ get_atom_text(atom_t atom, PL_chars_t *text)
 
 int
 get_string_text(word w, PL_chars_t *text ARG_LD)
-{ fail;
+{
+  CELL fl = RepAppl(w)[1];
+  if (fl == BLOB_STRING) {
+    fprintf(stderr,"%s\n", Yap_BlobStringOfTerm(w));
+    text->text.t = Yap_BlobStringOfTerm(w);
+    text->encoding = ENC_ISO_LATIN_1;
+    text->length = strlen(text->text.t);
+  } else {
+    text->text.w = Yap_BlobWideStringOfTerm(w);
+    text->encoding = ENC_WCHAR;
+    text->length = wcslen(text->text.w);
+  }
+  text->storage = PL_CHARS_STACK;
+  text->canonical = TRUE;
+  return TRUE;
 }
 
 void
@@ -1067,18 +1086,6 @@ recursiveMutexInit(recursiveMutex *m)
 
 }
 
-word
-pl_sleep(term_t time)
-{ double t;
-
-  if ( PL_get_float_ex(time, &t) )
-    return Pause(t);
-
-  fail;
-}
-
-
-
 counting_mutex _PL_mutexes[] =
 { COUNT_MUTEX_INITIALIZER("L_MISC"),
   COUNT_MUTEX_INITIALIZER("L_ALLOC"),

packages/PLStream/pl-yap.h

@@ -115,7 +115,7 @@ void PL_license(const char *license, const char *module);
 
 #define stringAtom(w)	YAP_AtomName((YAP_Atom)(w))
 #define isInteger(A) (YAP_IsIntTerm((A)) || YAP_IsBigNumTerm((A)))
-#define isString(A) FALSE
+#define isString(A) Yap_IsStringTerm(A)
 #define isAtom(A) YAP_IsAtomTerm((A))
 #define isList(A) YAP_IsPairTerm((A))
 #define isNil(A) ((A) == YAP_TermNil())