new text conversion and string code (big changes, take care please)

C/absmi.c

@@ -4409,6 +4409,52 @@ Yap_absmi(int inp)
       ENDD(d0);
       ENDOp();
 
+      Op(get_string, xu);
+      BEGD(d0);
+      d0 = XREG(PREG->u.xu.x);
+      deref_head(d0, gstring_unk);
+
+    gstring_nonvar:
+      if (!IsApplTerm(d0))
+	FAIL();
+      /* we have met a preexisting string */
+      START_PREFETCH(xu);
+      BEGP(pt0);
+      pt0 = RepAppl(d0);
+      /* check functor */
+      if (*pt0 != (CELL)FunctorString) {
+	FAIL();
+      }
+      BEGP(pt1);
+      pt1 = RepAppl(PREG->u.xu.u);
+      PREG = NEXTOP(PREG, xu);
+      if (
+	  pt1[1] != pt0[1] ||
+	  strcmp((const char *)(pt1+2), (const char *)(pt0+2))
+	  ) FAIL();
+      ENDP(pt1);
+      ENDP(pt0);
+      /* enter read mode */
+      GONext();
+      END_PREFETCH();
+
+      BEGP(pt0);
+      deref_body(d0, pt0, gstring_unk, gstring_nonvar);
+      /* Enter Write mode */
+      /* set d1 to be the new structure we are going to create */
+      START_PREFETCH(xc);
+      BEGD(d1);
+      d1 = PREG->u.xu.u;
+      PREG = NEXTOP(PREG, xu);
+      Bind(pt0, d1);
+      GONext();
+      ENDD(d1);
+      END_PREFETCH();
+      ENDP(pt0);
+
+      ENDD(d0);
+      ENDOp();
+
       Op(get_longint, xi);
       BEGD(d0);
       d0 = XREG(PREG->u.xi.x);
@@ -6072,6 +6118,87 @@ Yap_absmi(int inp)
       GONext();
       ENDOp();
 
+      Op(unify_string, ou);
+      BEGD(d0);
+      BEGP(pt0);
+      pt0 = SREG++;
+      d0 = *pt0;
+      deref_head(d0, ustring_unk);
+    ustring_nonvar:
+      if (!IsApplTerm(d0)) {
+	FAIL();	
+      }
+      /* look inside term */
+      BEGP(pt0);
+      pt0 = RepAppl(d0);
+      BEGD(d0);
+      d0 = *pt0;
+      if (d0 != (CELL)FunctorString) {
+	FAIL();
+      }
+      ENDD(d0);
+      BEGP(pt1);
+      pt1 = RepAppl(PREG->u.ou.u);
+      PREG = NEXTOP(PREG, ou);
+      if (
+	  pt1[1] != pt0[1]
+	  || strcmp( (const char *)(pt1 + 2), (const char *)(pt0+2) )
+	  ) FAIL();
+      ENDP(pt1);
+      ENDP(pt0);
+      GONext();
+
+      derefa_body(d0, pt0, ustring_unk, ustring_nonvar);
+      BEGD(d1);
+      d1 = PREG->u.ou.u;
+      PREG = NEXTOP(PREG, ou);
+      Bind_Global(pt0, d1);
+      GONext();
+      ENDD(d1);
+      ENDP(pt0);
+      ENDD(d0);
+      ENDOp();
+
+      Op(unify_l_string, ou);
+      BEGD(d0);
+      CACHE_S();
+      READ_IN_S();
+      d0 = *S_SREG;
+      deref_head(d0, ulstring_unk);
+    ulstring_nonvar:
+      if (!IsApplTerm(d0)) {
+	FAIL();	
+      }
+      BEGP(pt0);
+      pt0 = RepAppl(d0);
+      BEGD(d0);
+      d0 = *pt0;
+      if (d0 != (CELL)FunctorString) {
+	FAIL();
+      }
+      ENDD(d0);
+      BEGP(pt1);
+      pt1 = RepAppl(PREG->u.ou.u);
+      PREG = NEXTOP(PREG, ou);
+      if (
+	  pt1[1] != pt0[1]
+	  || strcmp( (const char *)(pt1 + 2), (const char *)(pt0+2) )
+	  ) FAIL();
+      ENDP(pt1);
+      ENDP(pt0);
+      GONext();
+
+      derefa_body(d0, S_SREG, ulstring_unk, ulstring_nonvar);
+      BEGD(d1);
+      d1 = PREG->u.ou.u;
+      PREG = NEXTOP(PREG, ou);
+      Bind_Global(S_SREG, d1);
+      GONext();
+      ENDD(d1);
+      ENDCACHE_S();
+      ENDD(d0);
+      ENDOp();
+
       Op(unify_longint, oi);
       BEGD(d0);
       BEGP(pt0);
@@ -11694,6 +11821,17 @@ Yap_absmi(int inp)
 	    }
 	    PREG = PREG->u.l.l;
 	    GONext();
+	  case (CELL)FunctorString:
+	    if (f1 != FunctorString) {
+	      PREG = PREG->u.l.l;
+	      GONext();
+	    }
+	    if (strcmp((char *)(RepAppl(d0)+2),(char *)(RepAppl(d1)+2)) == 0) {
+	      PREG = NEXTOP(PREG, l);
+	      GONext();
+	    }
+	    PREG = PREG->u.l.l;
+	    GONext();
 #ifdef USE_GMP
 	  case (CELL)FunctorBigInt:
 	    if (f1 != FunctorBigInt) {

C/adtdefs.c

@@ -30,6 +30,7 @@ static Prop	PredPropByFunc(Functor, Term);
 static Prop	PredPropByAtom(Atom, Term);
 #include "Yatom.h"
 #include "yapio.h"
+#include "pl-utf8.h"
 #include <stdio.h>
 #include <wchar.h>
 #if HAVE_STRING_H
@@ -340,6 +341,25 @@ Yap_LookupMaybeWideAtomWithLength(wchar_t *atom, size_t len)
   }
 }
 
+Atom
+Yap_LookupAtomWithLength(char *atom, size_t len)
+{				/* lookup atom in atom table            */
+  char *p = atom;
+  Atom at;
+
+  char *ptr, *ptr0;
+  /* not really a wide atom */
+  p = atom;
+  ptr0 = ptr = Yap_AllocCodeSpace(len+1);
+  if (!ptr)
+    return NIL;
+  while (len--) {*ptr++ = *p++;}
+  ptr[0] = '\0';
+  at = LookupAtom(ptr0);
+  Yap_FreeCodeSpace(ptr0);
+  return at;
+}
+
 Atom
 Yap_LookupAtom(char *atom)
 {				/* lookup atom in atom table            */
@@ -1060,6 +1080,9 @@ Yap_GetValue(Atom a)
     } else if (f == FunctorLongInt) {
       CACHE_REGS
       out = MkLongIntTerm(LongIntOfTerm(out));
+    } else if (f == FunctorString) {
+      CACHE_REGS
+      out = MkStringTerm(StringOfTerm(out));
     }
 #ifdef USE_GMP
     else {
@@ -1167,6 +1190,21 @@ Yap_PutValue(Atom a, Term v)
     memcpy((void *)pt, (void *)ap, sz);
     p->ValueOfVE = AbsAppl(pt);
 #endif
+  } else if (IsStringTerm(v)) {
+    CELL *ap = RepAppl(v);
+    Int sz = 
+      sizeof(CELL)*(3+ap[1]);
+    CELL *pt = (CELL *) Yap_AllocAtomSpace(sz);
+
+    if (pt == NULL) {
+      WRITE_UNLOCK(ae->ARWLock);
+      return;
+    }
+    if (IsApplTerm(t0)) {
+      Yap_FreeCodeSpace((char *) RepAppl(t0));
+    }
+    memcpy((void *)pt, (void *)ap, sz);
+    p->ValueOfVE = AbsAppl(pt);
   } else {
     if (IsApplTerm(t0)) {
       /* recover space */
@@ -1201,209 +1239,6 @@ Yap_PutAtomTranslation(Atom a, Int i)
   WRITE_UNLOCK(ae->ARWLock);
 }
 
-Term
-Yap_StringToList(char *s)
-{
-  CACHE_REGS
-  register Term t;
-  register unsigned char *cp = (unsigned char *)s + strlen(s);
-
-  t = MkAtomTerm(AtomNil);
-  while (cp > (unsigned char *)s) {
-    t = MkPairTerm(MkIntTerm(*--cp), t);
-  }
-  return (t);
-}
-
-Term
-Yap_NStringToList(char *s, size_t len)
-{
-  CACHE_REGS
-  Term t;
-  unsigned char *cp = (unsigned char *)s + len;
-
-  t = MkAtomTerm(AtomNil);
-  while (cp > (unsigned char *)s) {
-    t = MkPairTerm(MkIntegerTerm(*--cp), t);
-  }
-  return t;
-}
-
-
-Term
-Yap_WideStringToList(wchar_t *s)
-{
-  CACHE_REGS
-  Term t;
-  wchar_t *cp = s + wcslen(s);
-
-  t = MkAtomTerm(AtomNil);
-  while (cp > s) {
-    if (ASP < H+1024)
-      return (CELL)0;    
-    t = MkPairTerm(MkIntegerTerm(*--cp), t);
-  }
-  return t;
-}
-
-Term
-Yap_NWideStringToList(wchar_t *s, size_t len)
-{
-  CACHE_REGS
-  Term t;
-  wchar_t *cp = s + len;
-
-  t = MkAtomTerm(AtomNil);
-  while (cp > s) {
-    if (ASP < H+1024)
-      return (CELL)0;    
-    t = MkPairTerm(MkIntegerTerm(*--cp), t);
-  }
-  return t;
-}
-
-Term
-Yap_StringToDiffList(char *s, Term t USES_REGS)
-{
-  register unsigned char *cp = (unsigned char *)s + strlen(s);
-
- t = Yap_Globalise(t);
-  while (cp > (unsigned char *)s) {
-    if (ASP < H+1024)
-      return (CELL)0;
-    t = MkPairTerm(MkIntTerm(*--cp), t);
-  }
-  return t;
-}
-
-Term
-Yap_NStringToDiffList(char *s, Term t, size_t len)
-{
-  CACHE_REGS
-  register unsigned char *cp = (unsigned char *)s + len;
-
-  t = Yap_Globalise(t);
-  while (cp > (unsigned char *)s) {
-    t = MkPairTerm(MkIntTerm(*--cp), t);
-  }
-  return t;
-}
-
-Term
-Yap_WideStringToDiffList(wchar_t *s, Term t)
-{
-  CACHE_REGS
- wchar_t *cp = s + wcslen(s);
-
-  t = Yap_Globalise(t);
-  while (cp > s) {
-    t = MkPairTerm(MkIntegerTerm(*--cp), t);
-  }
-  return t;
-}
-
-Term
-Yap_NWideStringToDiffList(wchar_t *s, Term t, size_t len)
-{
-  CACHE_REGS
- wchar_t *cp = s + len;
-
- t = Yap_Globalise(t);
-  while (cp > s) {
-    t = MkPairTerm(MkIntegerTerm(*--cp), t);
-  }
-  return t;
-}
-
-Term
-Yap_StringToListOfAtoms(char *s)
-{
-  CACHE_REGS
-  register Term t;
-  char so[2];
-  register unsigned char *cp = (unsigned char *)s + strlen(s);
-
-  so[1] = '\0';
-  t = MkAtomTerm(AtomNil);
-  while (cp > (unsigned char *)s) {
-    so[0] = *--cp;
-    t = MkPairTerm(MkAtomTerm(LookupAtom(so)), t);
-  }
-  return t;
-}
-
-Term
-Yap_NStringToListOfAtoms(char *s, size_t len)
-{
-  CACHE_REGS
-  register Term t;
-  char so[2];
-  register unsigned char *cp = (unsigned char *)s + len;
-
-  so[1] = '\0';
-  t = MkAtomTerm(AtomNil);
-  while (cp > (unsigned char *)s) {
-    so[0] = *--cp;
-    t = MkPairTerm(MkAtomTerm(LookupAtom(so)), t);
-  }
-  return t;
-}
-
-Term
-Yap_WideStringToListOfAtoms(wchar_t *s)
-{
-  CACHE_REGS
-  register Term t;
-  wchar_t so[2];
-  wchar_t *cp = s + wcslen(s);
-
-  so[1] = '\0';
-  t = MkAtomTerm(AtomNil);
-  while (cp > s) {
-    so[0] = *--cp;
-    if (ASP < H+1024)
-      return (CELL)0;    
-    t = MkPairTerm(MkAtomTerm(LookupWideAtom(so)), t);
-  }
-  return t;
-}
-
-Term
-Yap_NWideStringToListOfAtoms(wchar_t *s, size_t len)
-{
-  CACHE_REGS
-  register Term t;
-  wchar_t so[2];
-  wchar_t *cp = s + len;
-
-  so[1] = '\0';
-  t = MkAtomTerm(AtomNil);
-  while (cp > s) {
-    if (ASP < H+1024)
-      return (CELL)0;    
-    so[0] = *--cp;
-    t = MkPairTerm(MkAtomTerm(LookupWideAtom(so)), t);
-  }
-  return t;
-}
-
-Term
-Yap_NWideStringToDiffListOfAtoms(wchar_t *s, Term t0, size_t len)
-{
-  CACHE_REGS
-  register Term t;
-  wchar_t so[2];
-  wchar_t *cp = s + len;
-
-  so[1] = '\0';
-  t = Yap_Globalise(t0);
-  while (cp > s) {
-    so[0] = *--cp;
-    t = MkPairTerm(MkAtomTerm(LookupWideAtom(so)), t);
-  }
-  return t;
-}
-
 Term
 Yap_ArrayToList(register Term *tp, int nof)
 {

C/agc.c

@@ -324,6 +324,8 @@ mark_global_cell(CELL *pt)
 #else
       return pt + 3;
 #endif
+    case (CELL)FunctorString:
+      return pt + 3 + pt[1];
     case (CELL)FunctorBigInt:
       {
 	Int sz = 3 +

C/amasm.c

@@ -1144,6 +1144,22 @@ a_ublob(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobs
   return code_p;
 }
 
+// strings are blobs
+inline static yamop *
+a_ustring(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
+{
+  if (pass_no) {
+    code_p->opc = emit_op(opcode);
+    code_p->u.ou.opcw = emit_op(opcode_w);
+    code_p->u.ou.u = 
+      AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1]));
+      
+  }
+  *clause_has_blobsp = TRUE;
+  GONEXT(ou);
+  return code_p;
+}
+
 inline static yamop *
 a_udbt(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip)
 {
@@ -1384,6 +1400,19 @@ a_rb(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, stru
   return code_p;
 }
 
+inline static yamop *
+a_rstring(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
+{
+  if (pass_no) {
+    code_p->opc = emit_op(opcode);
+    code_p->u.xu.x = emit_x(cip->cpc->rnd2);
+    code_p->u.xu.u = AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1]));
+  }
+  *clause_has_blobsp = TRUE;
+  GONEXT(xu);
+  return code_p;
+}
+
 inline static yamop *
 a_dbt(op_numbers opcode, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip)
 {
@@ -2421,6 +2450,16 @@ copy_blob(yamop *code_p, int pass_no, struct PSEUDO *cpc)
   return code_p;
 }
 
+static yamop *
+copy_string(yamop *code_p, int pass_no, struct PSEUDO *cpc)
+{
+  /* copy the blob to code space, making no effort to align if a double */
+  int max = cpc->rnd1, i;
+  for (i = 0; i < max; i++)
+    code_p = fill_a(cpc->arnds[i], code_p, pass_no);
+  return code_p;
+}
+
 
 static void
 a_fetch_vv(cmp_op_info *cmp_info, int pass_no, struct intermediates *cip)
@@ -3240,6 +3279,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case get_bigint_op:
       code_p = a_rb(_get_bigint, clause_has_blobsp, code_p, pass_no, cip);
       break;
+    case get_string_op:
+      code_p = a_rb(_get_string, clause_has_blobsp, code_p, pass_no, cip);
+      break;
     case get_dbterm_op:
       code_p = a_dbt(_get_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
       break;
@@ -3258,6 +3300,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case put_bigint_op:
       code_p = a_rb(_put_bigint, clause_has_blobsp, code_p, pass_no, cip);
       break;
+    case put_string_op:
+      code_p = a_rstring(_put_bigint, clause_has_blobsp, code_p, pass_no, cip);
+      break;
     case put_dbterm_op:
       code_p = a_dbt(_put_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
       break;
@@ -3318,6 +3363,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case unify_bigint_op:
       code_p = a_ublob(cip->cpc->rnd1, _unify_bigint, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip);
       break;
+    case unify_string_op:
+      code_p = a_ublob(cip->cpc->rnd1, _unify_string, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip);
+      break;
     case unify_dbterm_op:
       code_p = a_udbt(cip->cpc->rnd1, _unify_dbterm, _unify_atom_write, clause_has_dbtermp, code_p, pass_no, cip);
       break;
@@ -3336,6 +3384,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case unify_last_bigint_op:
       code_p = a_ublob(cip->cpc->rnd1, _unify_l_bigint, _unify_l_atom_write, clause_has_blobsp, code_p, pass_no, cip);
       break;
+    case unify_last_string_op:
+      code_p = a_ublob(cip->cpc->rnd1, _unify_l_bigint, _unify_l_atom_write, clause_has_blobsp, code_p, pass_no, cip);
+      break;
     case unify_last_dbterm_op:
       code_p = a_udbt(cip->cpc->rnd1, _unify_l_dbterm, _unify_l_atom_write, clause_has_dbtermp, code_p, pass_no, cip);
       break;
@@ -3354,6 +3405,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case write_bigint_op:
       code_p = a_wblob(cip->cpc->rnd1, _write_bigint, clause_has_blobsp, code_p, pass_no, cip);
       break;
+    case write_string_op:
+      code_p = a_wblob(cip->cpc->rnd1, _write_bigint, clause_has_blobsp, code_p, pass_no, cip);
+      break;
     case write_dbterm_op:
       code_p = a_wdbt(cip->cpc->rnd1, _write_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
       break;
@@ -3540,7 +3594,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
 	  cip->cpc->nextInst != NULL &&
 	  (cip->cpc->nextInst->op == mark_initialised_pvars_op ||
 	   cip->cpc->nextInst->op == mark_live_regs_op ||
-	   cip->cpc->nextInst->op == blob_op)) {
+	   cip->cpc->nextInst->op == blob_op ||
+	   cip->cpc->nextInst->op == string_op)) {
 	ystop_found = TRUE;
 	code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
       }
@@ -3746,6 +3801,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
       /* install a blob */
       code_p = copy_blob(code_p, pass_no, cip->cpc);
       break;
+    case string_op:
+      /* install a blob */
+      code_p = copy_string(code_p, pass_no, cip->cpc);
+      break;
     case empty_call_op:
       /* create an empty call */
       code_p = a_empty_call(&clinfo, code_p, pass_no, cip);

C/attvar.c

@@ -950,6 +950,9 @@ AllAttVars( USES_REGS1 ) {
       pt += 3;
 #endif
       break;
+    case (CELL)FunctorString:
+      pt += 3+pt[1];
+      break;
     case (CELL)FunctorBigInt:
       {
 	Int sz = 3 +

C/bignum.c

@@ -469,142 +469,6 @@ 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)
-{
-  CACHE_REGS
-  CELL *ret = H;
-  size_t sz;
-  MP_INT *dst = (MP_INT *)(H+2);
-  blob_string_t *sp;
-  size_t siz;
-  char *dest;
-
-  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 = ALIGN_YAPTYPE((len+1+sizeof(blob_string_t)),CELL);
-  dst->_mp_size = 0L;
-  dst->_mp_alloc = siz/sizeof(mp_limb_t);
-  sp = (blob_string_t *)(dst+1);
-  sp->len = sz;
-  dest = (char *)(sp+1);
-  strncpy(dest, s, sz);
-  dest[sz] = '\0';
-  H += (siz + 2*sizeof(CELL)+sizeof(MP_INT)+sizeof(Functor))/sizeof(CELL);
-  H[-1] = EndSpecials;
-  return AbsAppl(ret);
-}
-
-Term
-Yap_MkBlobWideStringTerm(const wchar_t *s, size_t len)
-{
-  CACHE_REGS
-  CELL *ret = H;
-  size_t sz;
-  MP_INT *dst = (MP_INT *)(H+2);
-  blob_string_t *sp = (blob_string_t *)(dst+1);
-  size_t siz, i = 0;
-
-  H[0] = (CELL)FunctorBigInt;
-  dst->_mp_size = 0L;
-  sz = wcslen(s);
-  if (len > 0 && sz > len) {
-    sz = len;
-  }
-  if ((len/sizeof(CELL)) > (ASP-ret)-1024) {
-    return TermNil;
-  }
-  while (i < sz) {
-    if (s[i++] >= 255) break;
-  }
-  if (i == sz) {
-    /* we have a standard ascii string */
-    char *target;
-    size_t i = 0;
-
-    H[1] = BLOB_STRING;
-    siz = ALIGN_YAPTYPE((sz+1+sizeof(blob_string_t)),CELL);
-    dst->_mp_alloc = siz/sizeof(mp_limb_t);
-    sp->len = sz;
-    target = (char *)(sp+1);
-    for (i = 0 ; i < sz; i++) {
-      target[i] = s[i];
-    }
-    target[sz] = '\0';
-    H += (siz+2*sizeof(CELL)+sizeof(MP_INT)+sizeof(Functor))/sizeof(CELL);
-  } else {
-    wchar_t * target;
-
-    H[1] = BLOB_WIDE_STRING;
-    siz = ALIGN_YAPTYPE((sz+1)*sizeof(wchar_t)+sizeof(blob_string_t),CELL);
-    dst->_mp_alloc = siz/sizeof(mp_limb_t);
-    sp->len = sz;
-    target = (wchar_t *)(sp+1); 
-    wcsncpy(target, s, sz);
-    target[sz] = '\0';
-    H += (siz + 2*sizeof(CELL)+sizeof(MP_INT)+sizeof(Functor))/sizeof(CELL);
-  }
-  H[-1] = EndSpecials;
-  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)
 {

C/c_interface.c

@@ -354,6 +354,7 @@
 #include "yap_structs.h"
 #define _yap_c_interface_h 1
 #include "pl-shared.h"
+#include "YapMirror.h"
 #include "pl-read.h"
 #ifdef TABLING
 #include "tab.macros.h"
@@ -1984,42 +1985,16 @@ YAP_FreeSpaceFromYap(void *ptr)
 X_API int
 YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
 {
-  unsigned int j = 0;
+  CACHE_REGS
-
+  seq_tv_t inp, out;
-  while (t != TermNil) {
+  inp.val.t = t;
-    register Term   Head;
+  inp.type = YAP_STRING_CODES|YAP_STRING_TRUNC;
-    register Int    i;
+  inp.max = bufsize;
-
+  out.type = YAP_STRING_CHARS;
-    Head = HeadOfTerm(t);
+  out.val.c = buf;
-    if (IsVarTerm(Head)) {
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
-      Yap_Error(INSTANTIATION_ERROR,Head,"user defined procedure");
+    return FALSE;
-      return(FALSE);
+  return TRUE;
-    } else if (!IsIntTerm(Head)) {
-      Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure");
-      return FALSE;		
-    }
-    i = IntOfTerm(Head);
-    if (i < 0 || i > 255) {
-      Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure");
-      return FALSE;		
-    }
-    if (j == bufsize) {
-      buf[bufsize-1] = '\0';
-      return FALSE;
-    } else {
-      buf[j++] = i;
-    }
-    t = TailOfTerm(t);
-    if (IsVarTerm(t)) {
-      Yap_Error(INSTANTIATION_ERROR,t,"user defined procedure");
-      return FALSE;
-    } else if (!IsPairTerm(t) && t != TermNil) {
-      Yap_Error(TYPE_ERROR_LIST, t, "user defined procedure");
-      return FALSE;
-    }
-  }
-  buf[j] = '\0';
-  return(TRUE);
 }
 
 
@@ -2030,7 +2005,14 @@ YAP_BufferToString(char *s)
   Term t; 
   BACKUP_H();
 
-  t = Yap_StringToList(s);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.c = s;
+  inp.type = YAP_STRING_CHARS;
+  out.type = YAP_STRING_CODES;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;
@@ -2043,7 +2025,16 @@ YAP_NBufferToString(char *s, size_t len)
   Term t; 
   BACKUP_H();
 
-  t = Yap_NStringToList(s, len);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.c = s;
+  inp.type = YAP_STRING_CHARS;
+  out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
+  out.sz = len;
+  out.max = len;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;
@@ -2056,7 +2047,14 @@ YAP_WideBufferToString(wchar_t *s)
   Term t; 
   BACKUP_H();
 
-  t = Yap_WideStringToList(s);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.w = s;
+  inp.type = YAP_STRING_WCHARS;
+  out.type = YAP_STRING_CODES;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;
@@ -2069,7 +2067,16 @@ YAP_NWideBufferToString(wchar_t *s, size_t len)
   Term t; 
   BACKUP_H();
 
-  t = Yap_NWideStringToList(s, len);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.w = s;
+  inp.type = YAP_STRING_WCHARS;
+  out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
+  out.sz = len;
+  out.max = len;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;
@@ -2131,7 +2138,14 @@ YAP_BufferToAtomList(char *s)
   Term t; 
   BACKUP_H();
 
-  t = Yap_StringToListOfAtoms(s);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.c = s;
+  inp.type = YAP_STRING_CHARS;
+  out.type = YAP_STRING_ATOMS;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;
@@ -2144,7 +2158,16 @@ YAP_NBufferToAtomList(char *s, size_t len)
   Term t; 
   BACKUP_H();
 
-  t = Yap_NStringToListOfAtoms(s, len);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.c = s;
+  inp.type = YAP_STRING_CHARS;
+  out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
+  out.sz = len;
+  out.max = len;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;
@@ -2157,7 +2180,14 @@ YAP_WideBufferToAtomList(wchar_t *s)
   Term t; 
   BACKUP_H();
 
-  t = Yap_WideStringToListOfAtoms(s);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.w = s;
+  inp.type = YAP_STRING_WCHARS;
+  out.type = YAP_STRING_ATOMS;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;
@@ -2170,7 +2200,16 @@ YAP_NWideBufferToAtomList(wchar_t *s, size_t len)
   Term t; 
   BACKUP_H();
 
-  t = Yap_NWideStringToListOfAtoms(s, len);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.w = s;
+  inp.type = YAP_STRING_WCHARS;
+  out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
+  out.sz = len;
+  out.max = len;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;
@@ -2183,7 +2222,17 @@ YAP_NWideBufferToAtomDiffList(wchar_t *s, Term t0, size_t len)
   Term t; 
   BACKUP_H();
 
-  t = Yap_NWideStringToDiffListOfAtoms(s, t0, len);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.w = s;
+  inp.type = YAP_STRING_WCHARS;
+  out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
+  out.sz = len;
+  out.max = len;
+  out.dif = t0;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;
@@ -2193,11 +2242,18 @@ YAP_NWideBufferToAtomDiffList(wchar_t *s, Term t0, size_t len)
 X_API Term
 YAP_BufferToDiffList(char *s, Term t0)
 {
-  CACHE_REGS
   Term t; 
   BACKUP_H();
 
-  t = Yap_StringToDiffList(s, t0 PASS_REGS);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.c = s;
+  inp.type = YAP_STRING_CHARS;
+  out.type = YAP_STRING_CODES|YAP_STRING_DIFF;
+  out.dif = t0;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;
@@ -2210,7 +2266,17 @@ YAP_NBufferToDiffList(char *s, Term t0, size_t len)
   Term t; 
   BACKUP_H();
 
-  t = Yap_NStringToDiffList(s, t0, len);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.c = s;
+  inp.type = YAP_STRING_CHARS;
+  out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
+  out.sz = len;
+  out.max = len;
+  out.dif = t0;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;
@@ -2223,7 +2289,15 @@ YAP_WideBufferToDiffList(wchar_t *s, Term t0)
   Term t; 
   BACKUP_H();
 
-  t = Yap_WideStringToDiffList(s, t0);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.w = s;
+  inp.type = YAP_STRING_WCHARS;
+  out.type = YAP_STRING_CODES|YAP_STRING_DIFF;
+  out.dif = t0;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;
@@ -2236,7 +2310,17 @@ YAP_NWideBufferToDiffList(wchar_t *s, Term t0, size_t len)
   Term t; 
   BACKUP_H();
 
-  t = Yap_NWideStringToDiffList(s, t0, len);
+  CACHE_REGS
+  seq_tv_t inp, out;
+  inp.val.w = s;
+  inp.type = YAP_STRING_WCHARS;
+  out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
+  out.sz = len;
+  out.max = len;
+  out.dif = t0;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  t = out.val.t;
 
   RECOVER_H();
   return t;

C/cmppreds.c

@@ -141,6 +141,26 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
 	}
 	if (out != 0)
 	  goto done;
+      } else if (IsStringTerm(d0)) {
+	if (IsStringTerm(d1)){
+	  out = strcmp(StringOfTerm(d0) , StringOfTerm(d1));
+	} else if (IsIntTerm(d1))
+	  out = 1;
+	else if (IsFloatTerm(d1)) {
+	  out = 1;
+	} else if (IsLongIntTerm(d1)) {
+	  out = 1;
+#ifdef USE_GMP
+	} else if (IsBigIntTerm(d1)) {
+	  out = 1;
+#endif
+	} else if (IsRefTerm(d1)) {
+	  out = 1 ;
+	} else {
+	  out = -1;
+	}
+	if (out != 0)
+	  goto done;
       } else if (IsLongIntTerm(d0)) {
 	if (IsIntTerm(d1))
 	  out = LongIntOfTerm(d0) - IntOfTerm(d1);
@@ -319,24 +339,30 @@ compare(Term t1, Term t2) /* compare terms t1 and t2	 */
 	return cmp_atoms(AtomOfTerm(t1),AtomOfTerm(t2));
       if (IsPrimitiveTerm(t2))
 	return 1;
+      if (IsStringTerm(t2))
+	return 1;
       return -1;
     } else {
       if (IsIntTerm(t2)) {
 	return IntOfTerm(t1) - IntOfTerm(t2);
       }
-      if (IsFloatTerm(t2)) {
+      if (IsApplTerm(t2)) {
-	return 1;
+	Functor fun2 = FunctorOfTerm(t2);
-      }
+	switch ((CELL)fun2) {
-      if (IsLongIntTerm(t2)) {
+	case double_e:
-	return IntOfTerm(t1) - LongIntOfTerm(t2);
+	  return 1;
-      }
+	case long_int_e:
+	  return IntOfTerm(t1) - LongIntOfTerm(t2);
 #ifdef USE_GMP
-      if (IsBigIntTerm(t2)) {
+	case big_int_e:
-	return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
+	  return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
-      }
 #endif
-      if (IsRefTerm(t2))
+	case db_ref_e:
-	return 1;
+	  return 1;
+	case string_e:
+	  return 1;
+	}
+      }
       return -1;
     }
   } else if (IsPairTerm(t1)) {
@@ -408,6 +434,16 @@ compare(Term t1, Term t2) /* compare terms t1 and t2	 */
 	  return -1;
 	}
 #endif
+      case string_e:
+	{
+	  if (IsApplTerm(t2)) {
+	    Functor f2 = FunctorOfTerm(t2);
+	    if (f2 == FunctorString)
+	      return strcmp(StringOfTerm(t1), StringOfTerm(t2));
+	    return 1;
+	  }
+	  return -1;
+	}
       case db_ref_e:
 	if (IsRefTerm(t2))
 	  return Unsigned(RefOfTerm(t2)) -

C/compiler.c

@@ -668,7 +668,7 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
       Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_atom_op
 		      : unify_atom_op) :
 	    write_atom_op), (CELL) t, Zero, &cglobs->cint);
-  } else  if (IsIntegerTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t)) {
+  } else  if (IsIntegerTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t) || IsStringTerm(t)) {
     if (!IsIntTerm(t)) {
       if (IsFloatTerm(t)) {
 	if (level == 0)
@@ -684,6 +684,41 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
 	  Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_longint_op
 			  : unify_longint_op) :
 		write_longint_op), t, Zero, &cglobs->cint);
+      } else if (IsStringTerm(t)) {
+	/* we are taking a string, that is supposed to be
+	 guarded in the clause itself. . */
+	CELL l1 = ++cglobs->labelno;
+	CELL *src = RepAppl(t);
+	PInstr *ocpc = cglobs->cint.cpc, *OCodeStart = cglobs->cint.CodeStart;
+	Int sz = (3+src[1])*sizeof(CELL);
+	CELL *dest;
+
+	/* use a special list to store the blobs */
+	cglobs->cint.cpc = cglobs->cint.icpc;
+	/*      if (IsFloatTerm(t)) {
+		Yap_emit(align_float_op, Zero, Zero, &cglobs->cint);
+		}*/
+	Yap_emit(label_op, l1, Zero, &cglobs->cint);
+	dest = 
+	  Yap_emit_extra_size(blob_op, sz/CellSize, sz, &cglobs->cint);
+
+	/* copy the bignum */
+	memcpy(dest, src, sz);
+	/* note that we don't need to copy size info, unless we wanted
+	 to garbage collect clauses ;-) */
+	cglobs->cint.icpc = cglobs->cint.cpc;
+	if (cglobs->cint.BlobsStart == NULL)
+	  cglobs->cint.BlobsStart = cglobs->cint.CodeStart;
+	cglobs->cint.cpc = ocpc;
+	cglobs->cint.CodeStart = OCodeStart;
+	/* The argument to pass to the structure is now the label for
+	   where we are storing the blob */
+	if (level == 0)
+	  Yap_emit((cglobs->onhead ? get_string_op : put_string_op), t, argno, &cglobs->cint);
+	else
+	  Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_string_op
+			  : unify_string_op) :
+		write_string_op), t, Zero, &cglobs->cint);
       } else {
 	/* we are taking a blob, that is a binary that is supposed to be
 	 guarded in the clause itself. Possible examples include
@@ -2585,6 +2620,7 @@ CheckVoids(compiler_struct *cglobs)
     case get_float_op:
     case get_dbterm_op:
     case get_longint_op:
+    case get_string_op:
     case get_bigint_op:
     case get_list_op:
     case get_struct_op:
@@ -2935,6 +2971,7 @@ c_layout(compiler_struct *cglobs)
     case get_num_op:
     case get_float_op:
     case get_longint_op:
+    case get_string_op:
     case get_dbterm_op:
     case get_bigint_op:
       --cglobs->Uses[rn];
@@ -3013,6 +3050,7 @@ c_layout(compiler_struct *cglobs)
     case put_num_op:
     case put_float_op:
     case put_longint_op:
+    case put_string_op:
     case put_dbterm_op:
     case put_bigint_op:
       rn = checkreg(arg, rn, ic, FALSE, cglobs);
@@ -3311,10 +3349,13 @@ c_optimize(PInstr *pc)
     case unify_last_float_op:
     case write_float_op:
     case unify_longint_op:
+    case unify_string_op:
     case unify_bigint_op:
     case unify_last_longint_op:
+    case unify_last_string_op:
     case unify_last_bigint_op:
     case write_longint_op:
+    case write_string_op:
     case write_bigint_op:
     case unify_list_op:
     case write_list_op:

C/computils.c

@@ -435,6 +435,8 @@ write_functor(Functor f)
       Yap_DebugPlWrite(MkAtomTerm(AtomLONGINT));
     } else if (f == FunctorDouble) {
       Yap_DebugPlWrite(MkAtomTerm(AtomDOUBLE));
+    } else if (f == FunctorString) {
+      Yap_DebugPlWrite(MkAtomTerm(AtomSTRING));
     }
   } else {
     Yap_DebugPlWrite(MkAtomTerm(NameOfFunctor (f)));

C/corout.c

@@ -152,6 +152,9 @@ static int can_unify_complex(register CELL *pt0,
 	    case (CELL)FunctorDouble:
 	      if (FloatOfTerm(d0) == FloatOfTerm(d1)) continue;
 	      goto comparison_failed;
+	    case (CELL)FunctorString:
+	      if (strcmp(StringOfTerm(d0), StringOfTerm(d1)) == 0) continue;
+	      goto comparison_failed;
 #ifdef USE_GMP
 	    case (CELL)FunctorBigInt:
 	      if (Yap_gmp_tcmp_big_big(d0,d1) == 0) continue;
@@ -288,6 +291,9 @@ can_unify(Term t1, Term t2, Term *Vars USES_REGS)
       case (CELL)FunctorLongInt:
 	if (RepAppl(t1)[1] == RepAppl(t2)[1]) return(TRUE);
 	return FALSE;
+      case (CELL)FunctorString:
+	if (strcmp(StringOfTerm(t1), StringOfTerm(t2)) == 0) return(TRUE);
+	return FALSE;
       case (CELL)FunctorDouble:
 	if (FloatOfTerm(t1) == FloatOfTerm(t2)) return(TRUE);
 	return FALSE;

C/dbase.c

@@ -596,6 +596,16 @@ copy_double(CELL *st, CELL *pt)
   return st+(2+SIZEOF_DOUBLE/SIZEOF_LONG_INT);
 }
 
+static CELL *
+copy_string(CELL *st, CELL *pt)
+{
+  UInt sz = pt[1]+3;
+  /* first thing, store a link to the list before we move on */
+  memcpy(st,pt,sizeof(CELL)*sz);
+  /* now reserve space */
+  return st+sz;
+}
+
 #ifdef USE_GMP
 static CELL *
 copy_big_int(CELL *st, CELL *pt)
@@ -711,6 +721,17 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
 	  ++pt0;
 	  continue;
 #endif
+	case (CELL)FunctorString:
+	  {
+	    CELL *st = CodeMax;
+
+	    CheckDBOverflow(3+ap2[1]);
+	    /* first thing, store a link to the list before we move on */
+	    *StoPoint++ = AbsAppl(st);
+	    CodeMax = copy_string(CodeMax, ap2);
+	    ++pt0;
+	    continue;
+	  }
 	case (CELL)FunctorDouble:
 	  {
 	    CELL *st = CodeMax;
@@ -1478,6 +1499,9 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
 	case (CELL)FunctorDouble:
 	  ntp = copy_double(ntp0, RepAppl(Tm));
 	  break;
+	case (CELL)FunctorString:
+	  ntp = copy_string(ntp0, RepAppl(Tm));
+	  break;
 	case (CELL)FunctorDBRef:
 	  Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
 	  return CreateDBWithDBRef(Tm, p, dbg);

C/errors.c

@@ -29,6 +29,100 @@
 #endif
 #include "Foreign.h"
 
+static Term
+gen_syntax_error(Atom InpAtom, char *s)
+{
+  CACHE_REGS
+  Term ts[7], ti[2];
+  ti[0] = ARG1;
+  ti[1] = ARG2;
+  ts[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom(s),2),2,ti);
+  ts[1] = ts[4] = ts[5] = MkIntTerm(0);
+  ts[2] = MkAtomTerm(AtomExpectedNumber);
+  ts[3] = TermNil;
+  ts[6] = MkAtomTerm(InpAtom);
+  return(Yap_MkApplTerm(FunctorSyntaxError,7,ts));
+}
+
+
+int Yap_HandleError( const char *s, ... ) {
+  CACHE_REGS
+    yap_error_number err = LOCAL_Error_TYPE;
+  char *serr;
+
+  LOCAL_Error_TYPE = YAP_NO_ERROR;
+  if (LOCAL_ErrorMessage) {
+    serr = LOCAL_ErrorMessage;
+  } else {
+    serr = (char *)s;
+  }
+  switch (err) {
+  case OUT_OF_STACK_ERROR:
+    if (!Yap_gc(2, ENV, gc_P(P,CP))) {
+      Yap_Error(OUT_OF_STACK_ERROR, TermNil, serr);
+      return(FALSE);
+    }
+    return TRUE;
+  case OUT_OF_AUXSPACE_ERROR:
+    if (LOCAL_MAX_SIZE < (char *)AuxSp-AuxBase) {
+      LOCAL_MAX_SIZE += 1024;
+    }
+    if (!Yap_ExpandPreAllocCodeSpace(0,NULL, TRUE)) {
+      /* crash in flames */
+      Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, serr);
+      return FALSE;
+    }
+    return TRUE;
+  case OUT_OF_HEAP_ERROR:
+    if (!Yap_growheap(FALSE, 0, NULL)) {
+      Yap_Error(OUT_OF_HEAP_ERROR, ARG2, serr);
+      return FALSE;
+    }
+  default:
+    Yap_Error(err, LOCAL_Error_Term, serr);
+    return(FALSE);
+  }
+}
+  
+int Yap_SWIHandleError( const char *s, ... )
+{
+  CACHE_REGS
+    yap_error_number err = LOCAL_Error_TYPE;
+  char *serr;
+
+  LOCAL_Error_TYPE = YAP_NO_ERROR;
+  if (LOCAL_ErrorMessage) {
+    serr = LOCAL_ErrorMessage;
+  } else {
+    serr = (char *)s;
+  }
+  switch (err) {
+  case OUT_OF_STACK_ERROR:
+    if (!Yap_gc(2, ENV, gc_P(P,CP))) {
+      Yap_Error(OUT_OF_STACK_ERROR, TermNil, serr);
+      return(FALSE);
+    }
+    return TRUE;
+  case OUT_OF_AUXSPACE_ERROR:
+    if (LOCAL_MAX_SIZE < (char *)AuxSp-AuxBase) {
+      LOCAL_MAX_SIZE += 1024;
+    }
+    if (!Yap_ExpandPreAllocCodeSpace(0,NULL, TRUE)) {
+      /* crash in flames */
+      Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, serr);
+      return FALSE;
+    }
+    return TRUE;
+  case OUT_OF_HEAP_ERROR:
+    if (!Yap_growheap(FALSE, 0, NULL)) {
+      Yap_Error(OUT_OF_HEAP_ERROR, ARG2, serr);
+      return FALSE;
+    }
+  default:
+    Yap_Error(err, LOCAL_Error_Term, serr);
+    return(FALSE);
+  }
+}
 
 void
 Yap_RestartYap ( int flag )
@@ -1454,7 +1548,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
 
       i = strlen(tmpbuf);
       ti[0] = MkAtomTerm(AtomSyntaxError);
-      nt[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, ti);
+      nt[0] = gen_syntax_error(AtomNil, tmpbuf);
       psize -= i;
       fun = FunctorError;
       serious = TRUE;
@@ -1535,6 +1629,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
       serious = TRUE;
     }
     break;
+  case TYPE_ERROR_BIGNUM:
+    {
+      int i;
+      Term ti[2];
+
+      i = strlen(tmpbuf);
+      ti[0] = MkAtomTerm(AtomBigNum);
+      ti[1] = where;
+      nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
+      psize -= i;
+      fun = FunctorError;
+      serious = TRUE;
+    }
+    break;
   case TYPE_ERROR_BYTE:
     {
       int i;

C/globals.c

@@ -395,6 +395,14 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
 	    H += 3;
 #endif
 	    break;
+	  case (CELL)FunctorString:
+	    if (ASP - H > MIN_ARENA_SIZE+3+ap2[1]) {
+	      goto overflow;
+	    }
+	    *ptf++ = AbsAppl(H);
+	    memcpy(H, ap2, sizeof(CELL)*(3+ap2[1]));
+	    H+=ap2[1]+3;
+	    break;
 	  default:
 	    {
 	      /* big int */
@@ -680,6 +688,14 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
 	H += 3;
 #endif
 	break;
+      case (CELL)FunctorString:
+	if (H > ASP - MIN_ARENA_SIZE+3+ap[1]) {
+	  res = -1;
+	  goto error_handler;
+	}
+	memcpy(H, ap, sizeof(CELL)*(3+ap[1]));
+	H += ap[1]+3;
+	break;
       default:
 	{
 	  UInt sz = ArenaSz(t), i;

C/gmp_support.c

@@ -1327,51 +1327,6 @@ Yap_gmp_tcmp_big_big(Term t1, Term t2)
       return 1;
     } else if (pt1[1] == BIG_RATIONAL) {
       b1 = Yap_BigRatOfTerm(t1);
-    } else if (pt1[1] == BLOB_STRING) {
-      char *s1 = Yap_BlobStringOfTerm(t1);
-      if (pt2[1] == BLOB_STRING) {
-	char *s2 = Yap_BlobStringOfTerm(t2);
-	return strcmp(s1,s2);
-      } else if (pt2[1] == BLOB_WIDE_STRING) {
-	wchar_t *wcs2 = Yap_BlobWideStringOfTerm(t2), *wcs1, *tmp1;
-	int out;
-	size_t n = strlen(s1);
-	if (!(wcs1 = (wchar_t *)malloc((n+1)*sizeof(wchar_t)))) {
-	  Yap_Error(OUT_OF_HEAP_ERROR, t1, "compare/3");	  
-	  return 0;
-	}
-	tmp1 = wcs1;
-	while (*s1) {
-	  *tmp1++ = *s1++;
-	}
-	out = wcscmp(wcs1, wcs2);
-	free(wcs1);
-	return out;
-      }
-      b1 = Yap_BigRatOfTerm(t1);
-    } else if (pt1[1] == BLOB_WIDE_STRING) {
-      wchar_t *wcs1 = Yap_BlobWideStringOfTerm(t1);
-      if (pt2[1] == BLOB_STRING) {
-	char *s2 = Yap_BlobStringOfTerm(t2);
-	wchar_t *wcs2, *tmp2;
-	int out;
-	size_t n = strlen(s2);
-	if (!(wcs2 = (wchar_t *)malloc((n+1)*sizeof(wchar_t)))) {
-	  Yap_Error(OUT_OF_HEAP_ERROR, t2, "compare/3");	  
-	  return 0;
-	}
-	tmp2 = wcs2;
-	while (*s2) {
-	  *tmp2++ = *s2++;
-	}
-	out = wcscmp(wcs1, wcs2);
-	free(wcs2);
-	return out;
-      } else if (pt2[1] == BLOB_WIDE_STRING) {
-	wchar_t *wcs2 = Yap_BlobWideStringOfTerm(t2);
-	return wcscmp(wcs1,wcs2);
-      }
-      b1 = Yap_BigRatOfTerm(t1);
     } else {
       return pt1-pt2;
     }
@@ -1686,6 +1641,19 @@ Yap_gmp_popcount(Term t)
   }
 }
 
+char * 
+Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base)
+{
+  if (s) {
+    size_t size = mpz_sizeinbase(b, base);
+    if (size+2 > sz) {
+      return NULL;
+    }
+    return mpz_get_str (s, base, b);
+  }
+  return NULL;
+}
+
 char * 
 Yap_gmp_to_string(Term t, char *s, size_t sz, int base)
 {

C/grow.c

@@ -559,6 +559,9 @@ AdjustGlobal(long sz, int thread_copying USES_REGS)
 	  pt += 2;
 #endif
 	  break;
+	case (CELL)FunctorString:
+	  pt += 3+pt[1];
+	  break;
 	case (CELL)FunctorBigInt:
 	  {
 	    Int sz = 2+
@@ -1082,7 +1085,9 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
     case get_float_op:
     case put_float_op:
     case get_longint_op:
+    case get_string_op:
     case put_longint_op:
+    case put_string_op:
     case unify_float_op:
     case unify_last_float_op:
     case write_float_op:
@@ -1112,8 +1117,11 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
     case unify_last_num_op:
     case write_num_op:
     case unify_longint_op:
+    case unify_string_op:
     case unify_last_longint_op:
+    case unify_last_string_op:
     case write_longint_op:
+    case write_string_op:
     case unify_bigint_op:
     case unify_last_bigint_op:
     case unify_dbterm_op:
@@ -1416,6 +1424,18 @@ Yap_growheap(int fix_code, size_t in_size, void *cip)
   int res;
   int blob_overflow = (NOfBlobs > NOfBlobsMax);
 
+#if (THREADS) || YAPOR
+  res = FALSE;
+  if (NOfAtoms > 2*AtomHashTableSize || blob_overflow) {
+      LOCK(LOCAL_SignalLock);
+      if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) {
+	CreepFlag = CalculateStackGap();
+      }
+      LOCAL_ActiveSignals &= ~YAP_CDOVF_SIGNAL;
+      UNLOCK(LOCAL_SignalLock);
+      return TRUE;
+    }
+#else
   if (NOfAtoms > 2*AtomHashTableSize || blob_overflow) {
     UInt n = NOfAtoms;
     if (GLOBAL_AGcThreshold)
@@ -1446,6 +1466,7 @@ Yap_growheap(int fix_code, size_t in_size, void *cip)
   res=do_growheap(fix_code, in_size, (struct intermediates *)cip, NULL, NULL, NULL PASS_REGS);
 #endif
   LeaveGrowMode(GrowHeapMode);
+#endif
   return res;
 }
 

C/heapgc.c

@@ -1378,6 +1378,23 @@ mark_variable(CELL_PTR current USES_REGS)
 	  MARK(next+sz);
 	}
 	POP_CONTINUATION();
+      case (CELL)FunctorString:
+	MARK(next);
+	PUSH_POINTER(next PASS_REGS);
+	{
+	  UInt sz = 2+next[1];
+	  if (next < LOCAL_HGEN) {
+	    LOCAL_total_oldies+= 1+sz;
+	  } else {
+	    DEBUG_printf0("%p 1\n", next);
+	    DEBUG_printf1("%p %ld\n", next, (long int)(sz+1));
+	  }
+	  //fprintf(stderr,"%p M %d\n", next,1+sz);
+	  LOCAL_total_marked += 1+sz;
+	  PUSH_POINTER(next+sz PASS_REGS);
+	  MARK(next+sz);
+	}
+	POP_CONTINUATION();
       case (CELL)FunctorBigInt:
 	{
 	  Opaque_CallOnGCMark f;

C/index.c

@@ -1203,6 +1203,16 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
       cl = NEXTOP(cl,oc);
       argno--;
       break;
+    case _unify_string:
+    case _unify_l_string:
+      if (argno == 1) {
+	clause->Tag = AbsAppl((CELL *)FunctorString);
+	clause->u.t_ptr = cl->u.ou.u;
+	return;
+      }
+      cl = NEXTOP(cl,ou);
+      argno--;
+      break;
     case _unify_n_atoms:
       if (argno <= cl->u.osc.s) {
 	clause->Tag = cl->u.osc.c;
@@ -2920,6 +2930,10 @@ install_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
 	    if (cls->u.t_ptr &&
 		Yap_Double_key(sp->extra) != Yap_Double_key(cls->u.t_ptr))
 		break;
+	  } else if (f == FunctorString) {
+	    if (cls->u.t_ptr &&
+		Yap_String_key(sp->extra) != Yap_String_key(cls->u.t_ptr))
+		break;
 	  } else {
 	    if (cls->u.t_ptr && 
 		Yap_Int_key(sp->extra) != Yap_Int_key(cls->u.t_ptr))

C/inlines.c

@@ -325,6 +325,8 @@ eq(Term t1, Term t2 USES_REGS)
 	    return (d0 == d1);
 	  case (CELL)FunctorLongInt:
 	    return(LongIntOfTerm(d0) == LongIntOfTerm(d1));
+	  case (CELL)FunctorString:
+	    return(strcmp(StringOfTerm(d0), StringOfTerm(d1)) == 0);
 #ifdef USE_GMP
 	  case (CELL)FunctorBigInt:
 	    return (Yap_gmp_tcmp_big_big(d0, d1) == 0);
@@ -611,6 +613,8 @@ p_functor( USES_REGS1 )			/* functor(?,?,?) */
 	d1 = MkIntTerm(0);
       } else if (d1 == (CELL)FunctorLongInt) {
 	d1 = MkIntTerm(0);
+      } else if (d1 == (CELL)FunctorString) {
+	d1 = MkIntTerm(0);
       } else
 	  return(FALSE);
     } else {

C/iopreds.c

@@ -31,6 +31,7 @@ static char SccsId[] = "%W% %G%";
 #include "eval.h"
 /* stuff we want to use in standard YAP code */
 #include "pl-shared.h"
+#include "YapMirror.h"
 #include <stdlib.h>
 #if HAVE_STDARG_H
 #include <stdarg.h>
@@ -324,7 +325,7 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
 	VarEntry *varinfo = (VarEntry *)info;
 
 	t[0] = MkIntTerm(0);
-	t[1] = Yap_StringToList(varinfo->VarRep);
+	t[1] = Yap_CharsToListOfCodes((const char *)varinfo->VarRep PASS_REGS);
 	if (varinfo->VarAdr == TermNil) {
 	  t[2] = varinfo->VarAdr = MkVarTerm();
 	} else {
@@ -335,13 +336,13 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
       break;
     case String_tok:
       {
-	Term t0 = Yap_StringToList((char *)info);
+	Term t0 = Yap_CharsToListOfCodes((const char *)info PASS_REGS);
 	ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
       }
       break;
     case WString_tok:
       {
-	Term t0 = Yap_WideStringToList((wchar_t *)info);
+	Term t0 = Yap_WCharsToListOfCodes((const wchar_t *)info PASS_REGS);
 	ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
       }
       break;

C/load_foreign.c

@@ -21,6 +21,8 @@ static char     SccsId[] = "%W% %G%.2";
 #include "Yatom.h"
 #include "YapHeap.h"
 #include "yapio.h"
+#include "pl-shared.h"
+#include "YapMirror.h"
 #include <stdlib.h>
 #if HAVE_STRING_H
 #include <string.h>
@@ -211,7 +213,7 @@ p_call_shared_object_function( USES_REGS1 ) {
 
 static Int
 p_obj_suffix( USES_REGS1 ) {
-  return Yap_unify(Yap_StringToList(SO_EXT),ARG1);
+  return Yap_unify(Yap_CharsToListOfCodes(SO_EXT PASS_REGS),ARG1);
 }
 
 static Int

C/parser.c

@@ -53,6 +53,7 @@ static char SccsId[] = "%W% %G%";
 #include "eval.h"
 /* stuff we want to use in standard YAP code */
 #include "pl-shared.h"
+#include "YapMirror.h"
 #include "pl-read.h"
 #include "pl-text.h"
 #if HAVE_STRING_H
@@ -392,7 +393,7 @@ checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS)
 
 static int
 is_quasi_quotation_syntax(Term goal, ReadData _PL_rd, Atom *pat)
-{ GET_LD
+{ CACHE_REGS
   Term m = CurrentModule, t;
   Atom at;
   UInt arity;
@@ -688,23 +689,9 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
   case String_tok:	/* build list on the heap */
     {
       Volatile char *p = (char *) LOCAL_tokptr->TokInfo;
-      if (*p == 0)
+      t = Yap_CharsToTDQ(p, CurrentModule PASS_REGS);
-	t = MkAtomTerm(AtomNil);
+      if (!t) {
-      else {
+	FAIL;
-	unsigned int flags = Yap_GetModuleEntry(CurrentModule)->flags;
-	if (flags &  DBLQ_CHARS)
-	  t = Yap_StringToListOfAtoms(p);
-	else if (flags & DBLQ_ATOM) {
-	  Atom at = Yap_LookupAtom(p);
-	  if (at == NIL) {
-	    LOCAL_ErrorMessage = "Heap Overflow";
-	    FAIL;	  
-	  }
-	  t = MkAtomTerm(at);
-	} else if (flags & DBLQ_STRING) {
-	  t = Yap_MkBlobStringTerm(p, strlen(p));
-	} else
-	  t = Yap_StringToList(p);
       }
       NextToken;
     }
@@ -713,26 +700,8 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
   case WString_tok:	/* build list on the heap */
     {
       Volatile wchar_t *p = (wchar_t *) LOCAL_tokptr->TokInfo;
-      if (*p == 0)
+      t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS);
-	t = MkAtomTerm(AtomNil);
+      if (!t) {
-      else {
-	unsigned int flags = Yap_GetModuleEntry(CurrentModule)->flags;
-	if (flags &  DBLQ_CHARS)
-	  t = Yap_WideStringToListOfAtoms(p);
-	else if (flags & DBLQ_ATOM) {
-	  Atom at = Yap_LookupWideAtom(p);
-	  if (at == NIL) {
-	    LOCAL_ErrorMessage = "Heap Overflow";
-	    FAIL;	  
-	  }
-	  t = MkAtomTerm(at);
-	} else if (flags & DBLQ_STRING) {
-	  t = Yap_MkBlobWideStringTerm(p, wcslen(p));
-	} else
-	  t = Yap_WideStringToList(p);
-      }
-      if (t == 0L) {
-	LOCAL_ErrorMessage = "Stack Overflow";
 	FAIL;
       }
       NextToken;

C/pl-yap.c

@@ -7,6 +7,7 @@
 #include "Yap.h"
 #include "Yatom.h"
 #include "pl-incl.h"
+#include "YapMirror.h"
 #if HAVE_MATH_H
 #include <math.h>
 #endif
@@ -84,13 +85,17 @@ codeToAtom(int chrcode)
 word
 globalString(size_t size, char *s)
 {
-  return Yap_MkBlobStringTerm(s, size);
+  CACHE_REGS
+
+  return Yap_CharsToString(s PASS_REGS);
 }
 
 word
 globalWString(size_t size, wchar_t *s)
 {
-  return Yap_MkBlobWideStringTerm(s, size);
+  CACHE_REGS
+
+  return Yap_WCharsToString(s PASS_REGS);
 }
 
 int
@@ -414,16 +419,9 @@ get_atom_text(atom_t atom, PL_chars_t *text)
 int
 get_string_text(word w, PL_chars_t *text ARG_LD)
 {
-  CELL fl = RepAppl(w)[1];
+  text->text.t = (char *)StringOfTerm(w);
-  if (fl == BLOB_STRING) {
+  text->encoding = ENC_ISO_LATIN_1;
-    text->text.t = Yap_BlobStringOfTerm(w);
+  text->length = strlen(text->text.t);
-    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;

C/scanner.c

@@ -42,7 +42,7 @@
 /* stuff we want to use in standard YAP code */
 #include "pl-shared.h"
 #include "pl-read.h"
-#include "pl-utf8.h"
+#include "YapMirror.h"
 #if _MSC_VER || defined(__MINGW32__) 
 #if HAVE_FINITE==1
 #undef HAVE_FINITE
@@ -780,7 +780,7 @@ extend_comment(int ch USES_REGS) {
 static void
 close_comment( USES_REGS1 ) {
   LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = '\0';
-  *LOCAL_CommentsNextChar = Yap_MkBlobWideStringTerm(LOCAL_CommentsBuff, LOCAL_CommentsBuffPos);
+  *LOCAL_CommentsNextChar = Yap_WCharsToString(LOCAL_CommentsBuff PASS_REGS);
   free(LOCAL_CommentsBuff);
   LOCAL_CommentsBuff = NULL;
   LOCAL_CommentsBuffLim = 0;

C/sysbits.c

@@ -186,12 +186,14 @@ Yap_InitSysPath(void) {
   int commons_done = FALSE;
   {
     char *dir;
-    if ((dir = Yap_RegistryGetString("library"))) {
+    if ((dir = Yap_RegistryGetString("library")) &&
+	is_directory(dir)) {
       Yap_PutValue(AtomSystemLibraryDir,
 		   MkAtomTerm(Yap_LookupAtom(dir)));
       dir_done = TRUE;
     }
-    if ((dir = Yap_RegistryGetString("prolog_commons"))) {
+    if ((dir = Yap_RegistryGetString("prolog_commons")) &&
+	is_directory(dir)) {
       Yap_PutValue(AtomPrologCommonsDir,
 		   MkAtomTerm(Yap_LookupAtom(dir)));
       commons_done = TRUE;
@@ -207,8 +209,7 @@ Yap_InitSysPath(void) {
     int buflen;
     char *pt;
 
-    if ((fatts = GetFileAttributes(LOCAL_FileNameBuf)) == 0xFFFFFFFFL ||
+    if (!is_directory(LOCAL_FileNameBuf)) {
-	!(fatts & FILE_ATTRIBUTE_DIRECTORY)) {
       /* couldn't find it where it was supposed to be,
 	 let's try using the executable */
       if (!GetModuleFileNameEx( GetCurrentProcess(), NULL, LOCAL_FileNameBuf, YAP_FILENAME_MAX)) {

C/unify.c

@@ -376,6 +376,8 @@ oc_unify_nvar_nvar:
 	  return(pt0[1] == pt1[1]);
 	case (CELL)FunctorDouble:
 	  return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
+	case (CELL)FunctorString:
+	  return(strcmp( (const char *)(pt0+2),  (const char )(pt1+2)) == 0);
 #ifdef USE_GMP
 	case (CELL)FunctorBigInt:
 	  return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0);
@@ -505,6 +507,8 @@ unify_nvar_nvar:
 	  return(pt0 == pt1);
 	case (CELL)FunctorLongInt:
 	  return(pt0[1] == pt1[1]);
+	case (CELL)FunctorString:
+	  return(strcmp( (const char *)(pt0+2),  (const char )(pt1+2)) == 0);
 	case (CELL)FunctorDouble:
 	  return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
 #ifdef USE_GMP
@@ -870,6 +874,8 @@ unifiable_nvar_nvar:
 	  return(pt0 == pt1);
 	case (CELL)FunctorLongInt:
 	  return(pt0[1] == pt1[1]);
+	case (CELL)FunctorString:
+	  return(strcmp( (const char *)(pt0+2),  (const char )(pt1+2)) == 0);
 	case (CELL)FunctorDouble:
 	  return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
 #ifdef USE_GMP

C/utilpreds.c

@@ -169,6 +169,8 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
 	      sz = sizeof(Float)/sizeof(CELL)+2;
 	    } else if (f== FunctorLongInt) {
 	      sz = 3;
+	    } else if (f== FunctorString) {
+	      sz = 3+ap2[1];
 	    } else {
 	      CELL *pt = ap2+1;
 	      sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
@@ -1333,6 +1335,8 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0,
 	    sz = sizeof(Float)/sizeof(CELL)+2;
 	  } else if (f== FunctorLongInt) {
 	    sz = 3;
+	  } else if (f== FunctorString) {
+	    sz = 3+ap2[1];
 	  } else {
 	    CELL *pt = ap2+1;
 	    sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
@@ -3331,6 +3335,9 @@ SizeOfExtension(Term t)
   if (f== FunctorDouble) {
     return 2 + sizeof(Float)/sizeof(CELL);
   }
+  if (f== FunctorString) {
+    return 3 + RepAppl(t)[1];
+  }
   if (f== FunctorLongInt) {
     return 2 + sizeof(Float)/sizeof(CELL);
   }
@@ -3819,6 +3826,10 @@ hash_complex_term(register CELL *pt0,
 	  case (CELL)FunctorLongInt:
 	    *st++ = LongIntOfTerm(d0);
 	    break;
+	  case (CELL)FunctorString:
+	    memcpy(st, RepAppl(d0), (3+RepAppl(d0)[1])*sizeof(CELL));
+	    st += 3+RepAppl(d0)[1];
+	    break;
 #ifdef USE_GMP
 	  case (CELL)FunctorBigInt:
 	    {
@@ -5498,6 +5509,7 @@ Yap_SkipList(Term *l, Term **tailp)
   return length;
 }
 
+
 static Int 
 p_skip_list( USES_REGS1 ) {
   Term *tail;

C/write.c

@@ -29,6 +29,7 @@ static char     SccsId[] = "%W% %G%";
 #include "attvar.h"
 #endif
 #include "pl-shared.h"
+#include "pl-utf8.h"
 
 #if HAVE_STRING_H
 #include <string.h>
@@ -69,7 +70,7 @@ typedef  struct  rewind_term {
 } rwts;
 
 typedef struct write_globs {
-  void     *stream;
+  IOSTREAM*stream;
   int      Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
   int      Keep_terms;
   int      Write_Loops;
@@ -166,6 +167,35 @@ wrputn(Int n, struct write_globs *wglb)	/* writes an integer	 */
 
 #define wrputs(s, stream) Sfputs(s, stream)
 
+static void 
+wrpututf8(const char *s, struct write_globs *wglb)	/* writes an integer	 */
+                
+{
+  IOSTREAM *stream = wglb->stream;
+
+
+  if (wglb->Write_strings)
+    wrputc('`', stream);
+  else
+    wrputc('"', stream);
+  if (stream->encoding == ENC_UTF8) {
+    wrputs( s, stream);
+  } else {
+    int chr;
+    char *ptr = (char *)s;
+    do {
+      ptr = utf8_get_char(ptr, &chr);
+      if (chr == '\0') break;
+      wrputc(chr, stream);
+    } while (TRUE);
+  }
+  if (wglb->Write_strings)
+    wrputc('`', stream);
+  else
+    wrputc('"', stream);
+}
+
+
 static void 
 wrputws(wchar_t *s, wrf stream)		/* writes a string	 */
 {
@@ -242,8 +272,14 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
   CELL *pt = RepAppl(t)+1;
   CELL big_tag = pt[0];
 
+  if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) {
+    wrputc('{', wglb->stream);
+    wrputs("...", wglb->stream);
+    wrputc('}', wglb->stream);
+    lastw = separator;
+    return;
 #ifdef USE_GMP
-  if (big_tag == BIG_INT) 
+  } else if (big_tag == BIG_INT) 
   {
     MP_INT *big = Yap_BigIntOfTerm(t);
     write_mpint(big, wglb);
@@ -252,39 +288,7 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
     Term trat = Yap_RatTermToApplTerm(t);
     writeTerm(trat, p, depth, rinfixarg, wglb, rwt);
     return;
-  }
 #endif
-  if (big_tag == BLOB_STRING) {
-    if (wglb->Write_strings)
-      wrputc('`',wglb->stream);
-    else
-      wrputc('"',wglb->stream);
-    wrputs(Yap_BlobStringOfTerm(t),wglb->stream);
-    if (wglb->Write_strings)
-      wrputc('`',wglb->stream);
-    else
-      wrputc('"',wglb->stream);
-    return;
-  } else if (big_tag == BLOB_WIDE_STRING) {
-    wchar_t *s = Yap_BlobWideStringOfTerm(t);
-    if (wglb->Write_strings)
-      wrputc('`',wglb->stream);
-    else
-      wrputc('"', wglb->stream);
-    while (*s) {
-      wrputc(*s++, wglb->stream);
-    }
-    if (wglb->Write_strings)
-      wrputc('`',wglb->stream);
-    else
-      wrputc('"',wglb->stream);
-    return;
-  } else if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) {
-    wrputc('{', wglb->stream);
-    wrputs("...", wglb->stream);
-    wrputc('}', wglb->stream);
-    lastw = separator;
-    return;
   } else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
     Opaque_CallOnWrite f;
     CELL blob_info;
@@ -391,6 +395,21 @@ wrputf(Float f, struct write_globs *wglb)	/* writes a float	 */
   protect_close_number(wglb, ob);
 }
 
+int
+Yap_FormatFloat( Float f, const char *s, size_t sz )
+{
+  struct write_globs wglb;
+  char *ws = (char *)s;
+  IOSTREAM *smem = Sopenmem(&ws, &sz, "w");
+  wglb.stream = smem;
+  wglb.lw = separator;
+  wglb.last_atom_minus = FALSE;
+  wrputf(f, &wglb);
+  Sclose(smem); 
+  return TRUE;
+}
+
+
 /* writes a data base reference */
 static void 
 wrputref(CODEADDR ref, int Quote_illegal, struct write_globs *wglb)
@@ -429,6 +448,7 @@ wrputblob(AtomEntry * ref, int Quote_illegal, struct write_globs *wglb)
     wrputs(s, stream);
   }
   lastw = alphanum;
+  return 1;
 }
 
 static int 
@@ -599,7 +619,7 @@ putAtom(Atom atom, int Quote_illegal,  struct write_globs *wglb)
 }
 
 static int 
-IsStringTerm(Term string)	/* checks whether this is a string */
+IsCodesTerm(Term string)	/* checks whether this is a string */
 {
   if (IsVarTerm(string))
     return FALSE;
@@ -888,7 +908,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
       if (Yap_GetValue(AtomPortray) == MkAtomTerm(AtomTrue))
 	return;
     }
-    if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsStringTerm(t)) {
+    if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsCodesTerm(t)) {
       putString(t, wglb);
     } else {
       wrputc('[', wglb->stream);
@@ -909,6 +929,9 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
       case (CELL)FunctorDouble:
 	wrputf(FloatOfTerm(t),wglb);
 	return;
+      case (CELL)FunctorString:
+	wrpututf8(StringOfTerm(t),wglb);
+	return;
       case (CELL)FunctorAttVar:	
 	write_var(RepAppl(t)+1, wglb, &nrwt);
 	return;
@@ -1099,7 +1122,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
       if (lastw == alphanum) {
 	wrputc(' ', wglb->stream);
       }
-      if (!IsVarTerm(ti) && (IsIntTerm(ti) || IsStringTerm(ti) || IsAtomTerm(ti))) {
+      if (!IsVarTerm(ti) && (IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti))) {
 	if (IsIntTerm(ti)) {
 	  Int k = IntOfTerm(ti);
 	  if (k == -1)  {

H/TermExt.h

@@ -45,18 +45,20 @@ typedef enum
 {
   db_ref_e = sizeof (Functor *),
   attvar_e = 2*sizeof (Functor *),
-  long_int_e = 3 * sizeof (Functor *),
+  double_e = 3 * sizeof (Functor *),
-  big_int_e = 4 * sizeof (Functor *),
+  long_int_e = 4 * sizeof (Functor *),
-  double_e = 5 * sizeof (Functor *)
+  big_int_e = 5 * sizeof (Functor *),
+  string_e = 6 * sizeof (Functor *)
 }
 blob_type;
 
 #define   FunctorDBRef    ((Functor)(db_ref_e))
 #define   FunctorAttVar   ((Functor)(attvar_e))
+#define   FunctorDouble   ((Functor)(double_e))
 #define   FunctorLongInt  ((Functor)(long_int_e))
 #define   FunctorBigInt   ((Functor)(big_int_e))
-#define   FunctorDouble   ((Functor)(double_e))
+#define   FunctorString   ((Functor)(string_e))
-#define   EndSpecials     (double_e+sizeof(Functor *))
+#define   EndSpecials     (string_e+sizeof(Functor *))
 
 #include "inline-only.h"
 
@@ -92,8 +94,6 @@ typedef enum
     ARRAY_INT =    0x21,
     ARRAY_FLOAT =  0x22,
     CLAUSE_LIST =  0x40,
-    BLOB_STRING =  0x80, /* SWI style strings */
-    BLOB_WIDE_STRING =  0x81, /* SWI style strings */
     EXTERNAL_BLOB =  0x100, /* generic data */
     USER_BLOB_START =  0x1000, /* user defined blob */
     USER_BLOB_END =  0x1100 /* end of user defined blob */
@@ -295,13 +295,6 @@ OOPS
 #include <stddef.h>
 #endif
 
-Term Yap_MkBlobStringTerm(const char *, size_t len);
-Term Yap_MkBlobWideStringTerm(const wchar_t *, size_t len);
-char *Yap_BlobStringOfTerm(Term);
-wchar_t *Yap_BlobWideStringOfTerm(Term);
-char *Yap_BlobStringOfTermAndLength(Term, size_t *);
-
-
 
 INLINE_ONLY inline EXTERN int IsFloatTerm (Term);
 
@@ -312,8 +305,6 @@ IsFloatTerm (Term t)
 }
 
 
-
-
 /* extern Functor FunctorLongInt; */
 
 #define MkLongIntTerm(i) __MkLongIntTerm((i) PASS_REGS)
@@ -350,6 +341,53 @@ IsLongIntTerm (Term t)
 }
 
 
+/****************************************************/
+
+/*********** strings, coded as UTF-8 ****************/
+
+#include <string.h>
+
+/* extern Functor FunctorString; */
+
+#define MkStringTerm(i) __MkStringTerm((i) PASS_REGS)
+
+INLINE_ONLY inline EXTERN Term __MkStringTerm (const char *s USES_REGS);
+
+INLINE_ONLY inline EXTERN Term
+__MkStringTerm (const char *s USES_REGS)
+{
+  Term t = AbsAppl(H);
+  size_t sz = ALIGN_YAPTYPE(strlen(s)+1,CELL);
+  H[0] = (CELL) FunctorString;
+  H[1] = (CELL) sz;
+  strcpy((char *)(H+2), s);
+  H[2+sz] =  EndSpecials;
+  H += 3+sz;
+  return t;
+}
+
+
+INLINE_ONLY inline EXTERN const char *StringOfTerm (Term t);
+
+INLINE_ONLY inline EXTERN const char *
+StringOfTerm (Term t)
+{
+  return (const char *) (RepAppl (t)+2);
+}
+
+
+
+INLINE_ONLY inline EXTERN int IsStringTerm (Term);
+
+INLINE_ONLY inline EXTERN int
+IsStringTerm (Term t)
+{
+  return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorString);
+}
+
+
+
+/****************************************************/
 
 #ifdef USE_GMP
 
@@ -438,30 +476,6 @@ IsLargeIntTerm (Term t)
 
 #endif
 
-typedef struct string_struct {
-  UInt len;
-}  blob_string_t;
-
-INLINE_ONLY inline EXTERN int IsBlobStringTerm (Term);
-
-INLINE_ONLY inline EXTERN int
-IsBlobStringTerm (Term t)
-{
-  return (int) (IsApplTerm (t) &&
-		FunctorOfTerm (t) == FunctorBigInt &&
-		(RepAppl(t)[1] & BLOB_STRING) == BLOB_STRING);
-}
-
-INLINE_ONLY inline EXTERN int IsWideBlobStringTerm (Term);
-
-INLINE_ONLY inline EXTERN int
-IsWideBlobStringTerm (Term t)
-{
-  return (int) (IsApplTerm (t) &&
-		FunctorOfTerm (t) == FunctorBigInt &&
-		RepAppl(t)[1] == BLOB_WIDE_STRING);
-}
-
 /* extern Functor FunctorLongInt; */
 
 INLINE_ONLY inline EXTERN int IsLargeNumTerm (Term);
@@ -470,8 +484,8 @@ INLINE_ONLY inline EXTERN int
 IsLargeNumTerm (Term t)
 {
   return (int) (IsApplTerm (t)
-		&& ((FunctorOfTerm (t) <= FunctorDouble)
+		&& ((FunctorOfTerm (t) <= FunctorBigInt)
-		    && (FunctorOfTerm (t) >= FunctorLongInt)));
+		    && (FunctorOfTerm (t) >= FunctorDouble)));
 }
 
 INLINE_ONLY inline EXTERN int IsExternalBlobTerm (Term, CELL);
@@ -523,7 +537,7 @@ INLINE_ONLY inline EXTERN Int IsExtensionFunctor (Functor);
 INLINE_ONLY inline EXTERN Int
 IsExtensionFunctor (Functor f)
 {
-  return (Int) (f <= FunctorDouble);
+  return (Int) (f <= FunctorString);
 }
 
 
@@ -533,7 +547,7 @@ INLINE_ONLY inline EXTERN Int IsBlobFunctor (Functor);
 INLINE_ONLY inline EXTERN Int
 IsBlobFunctor (Functor f)
 {
-  return (Int) ((f <= FunctorDouble && f >= FunctorDBRef));
+  return (Int) ((f <= FunctorString && f >= FunctorDBRef));
 }
 
 
@@ -665,6 +679,8 @@ unify_extension (Functor f, CELL d0, CELL * pt0, CELL d1)
       return (d0 == d1);
     case long_int_e:
       return (pt0[1] == RepAppl (d1)[1]);
+    case string_e:
+      return strcmp( (char *)pt0[2], (char *)RepAppl (d1)[2] ) == 0;
     case big_int_e:
 #ifdef USE_GMP
       return (Yap_gmp_tcmp_big_big(d0,d1) == 0);
@@ -721,4 +737,21 @@ CELL Yap_Double_key(Term t)
   return Yap_DoubleP_key(RepAppl(t)+1);
 }
 
+static inline
+CELL Yap_StringP_key(CELL *pt)
+{
+  UInt n = pt[1], i;
+  CELL val = pt[2];
+  for (i=1; i<n; i++) {
+    val ^= pt[i+1];
+  }
+  return MkIntTerm(val & (MAX_ABS_INT-1));  
+}
+
+static inline
+CELL Yap_String_key(Term t)
+{
+  return Yap_StringP_key(RepAppl(t)+1);
+}
+
 #endif

H/Yap.h

@@ -230,7 +230,6 @@ typedef char *ADDR;
 typedef CELL OFFSET;
 typedef unsigned char *CODEADDR;
 
-#define ALIGN_YAPTYPE(X,TYPE) (((CELL)(X)+(sizeof(TYPE)-1)) & ~(sizeof(TYPE)-1))
 
 #define TermPtr(V)	((Term *) (V))
 #define	Addr(V)		((ADDR) (V))

H/YapOpcodes.h

@@ -76,6 +76,7 @@
   OPCODE(get_list                   ,x),
   OPCODE(get_struct                 ,xfa),
   OPCODE(get_float                  ,xd),
+  OPCODE(get_string                 ,xu),
   OPCODE(get_longint                ,xi),
   OPCODE(get_bigint                 ,xN),
   OPCODE(get_dbterm                 ,xD),
@@ -131,6 +132,8 @@
   OPCODE(unify_float_write          ,od),
   OPCODE(unify_l_float              ,od),
   OPCODE(unify_l_float_write        ,od),
+  OPCODE(unify_string               ,ou),
+  OPCODE(unify_l_string             ,ou),
   OPCODE(unify_longint              ,oi),
   OPCODE(unify_longint_write        ,oi),
   OPCODE(unify_l_longint            ,oi),

H/YapTerm.h

@@ -21,6 +21,9 @@ typedef void *Atom;
 
 #endif
 
+#define ALIGN_YAPTYPE(X,TYPE) (((CELL)(X)+(sizeof(TYPE)-1)) & ~(sizeof(TYPE)-1))
+
+
 #ifndef EXTERN
 #define EXTERN extern
 #endif

H/Yapproto.h

@@ -26,6 +26,8 @@ Term	Yap_GetValue(Atom);
 int     Yap_HasOp(Atom);
 struct operator_entry *Yap_GetOpPropForAModuleHavingALock(AtomEntry *, Term);
 Atom	Yap_LookupAtom(char *);
+Atom	Yap_LookupAtomWithLength(char *, size_t);
+Atom	Yap_LookupUTF8Atom(char *);
 Atom	Yap_LookupMaybeWideAtom(wchar_t *);
 Atom	Yap_LookupMaybeWideAtomWithLength(wchar_t *, size_t);
 Atom	Yap_FullLookupAtom(char *);
@@ -39,19 +41,6 @@ Functor	Yap_MkFunctor(Atom,unsigned int);
 void	Yap_MkFunctorWithAddress(Atom,unsigned int,FunctorEntry *);
 void	Yap_PutValue(Atom,Term);
 void	Yap_ReleaseAtom(Atom);
-Term	Yap_StringToList(char *);
-Term	Yap_NStringToList(char *, size_t);
-Term	Yap_WideStringToList(wchar_t *);
-Term	Yap_NWideStringToList(wchar_t *, size_t);
-Term	Yap_StringToDiffList(char *,Term CACHE_TYPE);
-Term	Yap_NStringToDiffList(char *,Term, size_t);
-Term	Yap_WideStringToDiffList(wchar_t *,Term);
-Term	Yap_NWideStringToDiffList(wchar_t *,Term, size_t);
-Term	Yap_StringToListOfAtoms(char *);
-Term	Yap_NStringToListOfAtoms(char *, size_t);
-Term	Yap_WideStringToListOfAtoms(wchar_t *);
-Term	Yap_NWideStringToListOfAtoms(wchar_t *, size_t);
-Term	Yap_NWideStringToDiffListOfAtoms(wchar_t *, Term, size_t);
 int     Yap_AtomIncreaseHold(Atom);
 int     Yap_AtomDecreaseHold(Atom);
 struct operator_entry *Yap_OpPropForModule(Atom, Term);
@@ -169,6 +158,8 @@ void	Yap_RestartYap(int);
 void	Yap_exit(int);
 yamop  *Yap_Error(yap_error_number,Term,char *msg, ...);
 yamop  *Yap_NilError(yap_error_number,char *msg, ...);
+int     Yap_HandleError( const char *msg, ... );
+int     Yap_SWIHandleError( const char *, ... );
 
 /* eval.c */
 void	Yap_InitEval(void);
@@ -348,6 +339,7 @@ void	Yap_InitSignalCPreds(void);
 /* sort.c */
 void    Yap_InitSortPreds(void);
 
+
 /* stdpreds.c */
 void	Yap_InitBackCPreds(void);
 void	Yap_InitCPreds(void);
@@ -430,7 +422,7 @@ Int     Yap_SkipList(Term *, Term **);
 
 /* write.c */
 void	Yap_plwrite(Term, void *, int, int, int);
-
+int     Yap_FormatFloat( Float f, const char *s, size_t sz );
 
 /* MYDDAS */
 

H/amidefs.h

@@ -273,6 +273,7 @@ typedef enum {
   p: predicate, struct pred_entry *
   s: small integer, COUNT
   t: pointer to table entry, used by yaptab, struct table_entry *
+  u: utf-8 string
   x: wam register, wamreg
   y: environment slot
 
@@ -558,6 +559,11 @@ typedef struct yami {
       COUNT               s;
       CELL next;
     } os;
+    struct {
+      OPCODE              opcw;
+      Term    u;
+      CELL next;
+    } ou;
     struct {
       OPCODE              opcw;
       wamreg                x;
@@ -783,6 +789,11 @@ typedef struct yami {
       wamreg                xr;
       CELL next;
     } xx;
+    struct {
+      wamreg                x;
+      Term                  u;
+      CELL next;
+    } xu;
     struct {
       wamreg                x;
       wamreg                xi;

H/compile.h

@@ -34,6 +34,8 @@ typedef enum compiler_op {
   put_dbterm_op,
   get_longint_op,
   put_longint_op,
+  get_string_op,
+  put_string_op,
   get_bigint_op,
   put_bigint_op,
   get_list_op,
@@ -55,6 +57,8 @@ typedef enum compiler_op {
   write_dbterm_op,
   unify_longint_op,
   write_longint_op,
+  unify_string_op,
+  write_string_op,
   unify_bigint_op,
   write_bigint_op,
   unify_list_op,
@@ -76,6 +80,7 @@ typedef enum compiler_op {
   unify_last_float_op,
   unify_last_dbterm_op,
   unify_last_longint_op,
+  unify_last_string_op,
   unify_last_bigint_op,
   ensure_space_op,
   native_op,
@@ -126,6 +131,7 @@ typedef enum compiler_op {
   if_not_op,
   index_dbref_op,
   index_blob_op,
+  index_string_op,
   index_long_op,
   if_nonvar_op,
   save_pair_op,
@@ -182,6 +188,7 @@ typedef enum compiler_op {
   fetch_args_for_bccall,
   bccall_op,
   blob_op,
+  string_op,
   label_ctl_op
 #ifdef SFUNC
   ,

H/dlocals.h

@@ -417,4 +417,6 @@
 #define REMOTE_CurSlot(wid) REMOTE(wid)->CurSlot_
 #define LOCAL_SourceModule LOCAL->SourceModule_
 #define REMOTE_SourceModule(wid) REMOTE(wid)->SourceModule_
+#define LOCAL_MAX_SIZE LOCAL->MAX_SIZE_
+#define REMOTE_MAX_SIZE(wid) REMOTE(wid)->MAX_SIZE_
 

H/eval.h

@@ -233,6 +233,8 @@ ETypeOfTerm(Term t)
 }
 
 #if USE_GMP
+char *Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base);
+
 Term  Yap_gmq_rdiv_int_int(Int, Int);
 Term  Yap_gmq_rdiv_int_big(Int, Term);
 Term  Yap_gmq_rdiv_big_int(Term, Int);

H/findclause.h

@@ -409,6 +409,12 @@
     case _unify_n_atoms_write:
       cl = NEXTOP(cl,osc);
       break;
+    case _unify_l_string:
+      cl = NEXTOP(cl,ou);
+      break;
+    case _unify_string:
+      cl = NEXTOP(cl,ou);
+      break;
     case _save_appl_x:
       if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.ox.x))) {
 	clause->Tag = (CELL)NULL;
@@ -873,6 +879,14 @@
       }
       cl = NEXTOP(cl,xl);
       break;
+    case _get_string:
+      if (is_regcopy(myregs, nofregs, cl->u.xu.x)) {
+	clause->Tag = AbsAppl((CELL *)FunctorString);
+	clause->u.t_ptr = (CELL)NULL;
+	return;
+      }
+      cl = NEXTOP(cl,xu);
+      break;
     case _get_x_val:
       if (!(nofregs = link_regcopies(myregs, nofregs, cl->u.xx.xl, cl->u.xx.xr))) {
 	clause->Tag = (CELL)NULL;

H/headclause.h

@@ -376,6 +376,12 @@
     case _unify_n_atoms_write:
       cl = NEXTOP(cl,osc);
       break;
+    case _unify_l_string:
+      cl = NEXTOP(cl,ou);
+      break;
+    case _unify_string:
+      cl = NEXTOP(cl,ou);
+      break;
     case _save_appl_x:
       if (iarg == cl->u.ox.x) {
 	clause->Tag = (CELL)NULL;
@@ -652,6 +658,14 @@
       }
       cl = NEXTOP(cl,xi);
       break;
+    case _get_string:
+      if (iarg == cl->u.xu.x) {
+	clause->Tag = AbsAppl((CELL *)FunctorString);
+	clause->u.t_ptr = (CELL)NULL;
+	return;
+      }
+      cl = NEXTOP(cl,xu);
+      break;
     case _get_x_val:
       if (cl->u.xx.xl == iarg ||
         cl->u.xx.xr == iarg) {

H/hlocals.h

@@ -235,4 +235,5 @@ typedef struct worker_local {
 
   Int  CurSlot_;
   Term  SourceModule_;
+  size_t  MAX_SIZE_;
 } w_local;

H/iatoms.h

@@ -34,6 +34,7 @@
   AtomBatched = Yap_LookupAtom("batched");
   AtomBetween = Yap_LookupAtom("between");
   AtomHugeInt = Yap_LookupAtom("huge_int");
+  AtomBigNum = Yap_LookupAtom("big_num");
   AtomBinaryStream = Yap_LookupAtom("binary_stream");
   AtomBraces = Yap_LookupAtom("{}");
   AtomBreak = Yap_FullLookupAtom("$break");
@@ -296,6 +297,7 @@
   AtomStreamPos = Yap_FullLookupAtom("$stream_position");
   AtomStreamPosition = Yap_LookupAtom("stream_position");
   AtomString = Yap_LookupAtom("string");
+  AtomSTRING = Yap_FullLookupAtom("String");
   AtomSwi = Yap_LookupAtom("swi");
   AtomSyntaxError = Yap_LookupAtom("syntax_error");
   AtomSyntaxErrorHandler = Yap_LookupAtom("syntax_error_handler");

H/ilocals.h

@@ -235,4 +235,5 @@ static void InitWorker(int wid) {
 
   REMOTE_CurSlot(wid) = 0;
   REMOTE_SourceModule(wid) = 0;
+  REMOTE_MAX_SIZE(wid) = 1024L;
 }

H/iopreds.h

@@ -54,3 +54,4 @@ typedef int (*GetsFunc)(int, UInt, char *);
 void Yap_InitStdStreams(void);
 Term Yap_StreamPosition(struct io_stream *);
 void Yap_InitPlIO(void);
+

H/pl-incl.h

@@ -511,7 +511,6 @@ typedef struct wakeup_state
 Defining built-in predicates using the new interface 
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-#define EOS '\0'
 #define ESC			((char) 27)
 #define streq(s, q)		((strcmp((s), (q)) == 0))
 
@@ -726,7 +725,6 @@ extern atom_t	lookupUCSAtom(const pl_wchar_t *s, size_t len);
 extern int toIntegerNumber(Number n, int flags);
 extern int get_atom_ptr_text(Atom a, PL_chars_t *text);
 extern int warning(const char *fm, ...);
-extern int raiseSignal(PL_local_data_t *ld, int sig);
 
 /**** stuff from pl-files.c ****/
 void initFiles(void);

H/pl-shared.h

@@ -141,6 +141,8 @@ typedef struct redir_context
 
 #include "pl-file.h"
 
+#define EOS '\0'
+
 		/********************************
 		*       HASH TABLES             *
 		*********************************/
@@ -264,7 +266,30 @@ COMMON(int)		debugmode(debug_type new, debug_type *old);
 COMMON(int)		tracemode(debug_type new, debug_type *old);
 COMMON(void)		Yap_setCurrentSourceLocation(IOSTREAM **s);
 
-#define SWIAtomToAtom(X) SWI_Atoms[(X)>>1]
+extern int raiseSignal(PL_local_data_t *ld, int sig);
+
+#ifdef YATOM_H
+
+static inline atom_t
+AtomToSWIAtom(Atom at)
+{
+  TranslationEntry *p;
+
+  if ((p = Yap_GetTranslationProp(at)) != NULL)
+    return (atom_t)(p->Translation*2+1);
+  return (atom_t)at;
+}
+
+#endif
+
+static inline Atom
+SWIAtomToAtom(atom_t at)
+{
+  if ((CELL)at & 1)
+    return SWI_Atoms[at/2];
+  return (Atom)at;
+}
+
 Atom                  YAP_AtomFromSWIAtom(atom_t at);
 atom_t                YAP_SWIAtomFromAtom(Atom at);
 

H/pl-yap.h

@@ -124,7 +124,7 @@ void PL_license(const char *license, const char *module);
 
 #define stringAtom(w)	(YAP_AtomFromSWIAtom(w)->StrOfAE)
 #define isInteger(A) (!IsVarTerm(A) && ( IsIntegerTerm((A)) || YAP_IsBigNumTerm((A)) ))
-#define isString(A) (!IsVarTerm(A) && Yap_IsStringTerm(A) )
+#define isString(A) (!IsVarTerm(A) && IsStringTerm(A) )
 #define isAtom(A) (!IsVarTerm(A) && IsAtomTerm((A)) )
 #define isList(A) (!IsVarTerm(A) && IsPairTerm((A)) )
 #define isNil(A) ((A) == TermNil)

H/ratoms.h

@@ -34,6 +34,7 @@
   AtomBatched = AtomAdjust(AtomBatched);
   AtomBetween = AtomAdjust(AtomBetween);
   AtomHugeInt = AtomAdjust(AtomHugeInt);
+  AtomBigNum = AtomAdjust(AtomBigNum);
   AtomBinaryStream = AtomAdjust(AtomBinaryStream);
   AtomBraces = AtomAdjust(AtomBraces);
   AtomBreak = AtomAdjust(AtomBreak);
@@ -296,6 +297,7 @@
   AtomStreamPos = AtomAdjust(AtomStreamPos);
   AtomStreamPosition = AtomAdjust(AtomStreamPosition);
   AtomString = AtomAdjust(AtomString);
+  AtomSTRING = AtomAdjust(AtomSTRING);
   AtomSwi = AtomAdjust(AtomSwi);
   AtomSyntaxError = AtomAdjust(AtomSyntaxError);
   AtomSyntaxErrorHandler = AtomAdjust(AtomSyntaxErrorHandler);

H/rclause.h

@@ -389,6 +389,13 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
       pc->u.osc.c = ConstantTermAdjust(pc->u.osc.c);
       pc = NEXTOP(pc,osc);
       break;
+      /* instructions type ou */
+    case _unify_l_string:
+    case _unify_string:
+      pc->u.ou.opcw = OpcodeAdjust(pc->u.ou.opcw);
+      pc->u.ou.u = BlobTermInCodeAdjust(pc->u.ou.u);
+      pc = NEXTOP(pc,ou);
+      break;
       /* instructions type ox */
     case _save_appl_x:
     case _save_appl_x_write:
@@ -637,6 +644,12 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
       pc->u.xps.s = ConstantAdjust(pc->u.xps.s);
       pc = NEXTOP(pc,xps);
       break;
+      /* instructions type xu */
+    case _get_string:
+      pc->u.xu.x = XAdjust(pc->u.xu.x);
+      pc->u.xu.u = BlobTermInCodeAdjust(pc->u.xu.u);
+      pc = NEXTOP(pc,xu);
+      break;
       /* instructions type xx */
     case _get_x_val:
     case _get_x_var:

H/rlocals.h

@@ -233,6 +233,7 @@ static void RestoreWorker(int wid USES_REGS) {
 
 
 
+
 
 
 }

H/saveclause.h

@@ -406,6 +406,13 @@
       CHECK(save_ConstantTerm(stream, pc->u.osc.c));
       pc = NEXTOP(pc,osc);
       break;
+      /* instructions type ou */
+    case _unify_l_string:
+    case _unify_string:
+      CHECK(save_Opcode(stream, pc->u.ou.opcw));
+      CHECK(save_BlobTermInCode(stream, pc->u.ou.u));
+      pc = NEXTOP(pc,ou);
+      break;
       /* instructions type ox */
     case _save_appl_x:
     case _save_appl_x_write:
@@ -653,6 +660,12 @@
       CHECK(save_Constant(stream, pc->u.xps.s));
       pc = NEXTOP(pc,xps);
       break;
+      /* instructions type xu */
+    case _get_string:
+      CHECK(save_X(stream, pc->u.xu.x));
+      CHECK(save_BlobTermInCode(stream, pc->u.xu.u));
+      pc = NEXTOP(pc,xu);
+      break;
       /* instructions type xx */
     case _get_x_val:
     case _get_x_var:

H/tatoms.h

@@ -66,6 +66,8 @@
 #define AtomBetween Yap_heap_regs->AtomBetween_
   Atom AtomHugeInt_;
 #define AtomHugeInt Yap_heap_regs->AtomHugeInt_
+  Atom AtomBigNum_;
+#define AtomBigNum Yap_heap_regs->AtomBigNum_
   Atom AtomBinaryStream_;
 #define AtomBinaryStream Yap_heap_regs->AtomBinaryStream_
   Atom AtomBraces_;
@@ -590,6 +592,8 @@
 #define AtomStreamPosition Yap_heap_regs->AtomStreamPosition_
   Atom AtomString_;
 #define AtomString Yap_heap_regs->AtomString_
+  Atom AtomSTRING_;
+#define AtomSTRING Yap_heap_regs->AtomSTRING_
   Atom AtomSwi_;
 #define AtomSwi Yap_heap_regs->AtomSwi_
   Atom AtomSyntaxError_;

H/walkclause.h

@@ -293,6 +293,11 @@
     case _unify_n_atoms_write:
       pc = NEXTOP(pc,osc);
       break;
+      /* instructions type ou */
+    case _unify_l_string:
+    case _unify_string:
+      pc = NEXTOP(pc,ou);
+      break;
       /* instructions type ox */
     case _save_appl_x:
     case _save_appl_x_write:
@@ -478,6 +483,10 @@
     case _commit_b_x:
       pc = NEXTOP(pc,xps);
       break;
+      /* instructions type xu */
+    case _get_string:
+      pc = NEXTOP(pc,xu);
+      break;
       /* instructions type xx */
     case _get_x_val:
     case _get_x_var:

Makefile.in

@@ -189,6 +189,7 @@ HEADERS = \
 	$(srcdir)/H/tracer.h \
 	$(srcdir)/H/trim_trail.h \
 	$(srcdir)/H/yapio.h \
+	$(srcdir)/H/YapMirrorn.h \
 	$(srcdir)/BEAM/eam.h $(srcdir)/BEAM/eamamasm.h \
 	$(srcdir)/OPTYap/opt.config.h \
 	$(srcdir)/OPTYap/opt.proto.h $(srcdir)/OPTYap/opt.structs.h \
@@ -227,7 +228,7 @@ IOLIB_SOURCES=$(srcdir)/os/pl-buffer.c $(srcdir)/os/pl-ctype.c \
 	$(srcdir)/os/pl-tai.c  \
 	$(srcdir)/os/pl-text.c \
 	$(srcdir)/os/pl-version.c \
-	$(srcdir)/os/pl-write.c \
+		$(srcdir)/os/pl-write.c \
 	$(srcdir)/C/pl-yap.c @ENABLE_WINCONSOLE@$(srcdir)/os/windows/uxnt.c
 
 C_SOURCES= \
@@ -262,6 +263,7 @@ C_SOURCES= \
 	$(srcdir)/C/qlyw.c \
 	$(srcdir)/C/range.c \
 	$(srcdir)/C/save.c $(srcdir)/C/scanner.c $(srcdir)/C/signals.c \
+	$(srcdir)/C/strings.c \
 	$(srcdir)/C/sort.c $(srcdir)/C/stdpreds.c $(srcdir)/C/sysbits.c \
 	$(srcdir)/C/threads.c \
 	$(srcdir)/C/tracer.c $(srcdir)/C/unify.c $(srcdir)/C/userpreds.c  \
@@ -370,7 +372,7 @@ ENGINE_OBJECTS = \
 	myddas_util.o myddas_statistics.o myddas_top_level.o \
 	myddas_wkb2prolog.o modules.o other.o   \
 	parser.o qlyr.o qlyw.o range.o \
-	save.o scanner.o signals.o sort.o stdpreds.o \
+	save.o scanner.o signals.o strings.o sort.o stdpreds.o \
 	sysbits.o threads.o tracer.o \
 	udi.o\
 	unify.o userpreds.o utilpreds.o \

include/YapError.h

@@ -98,6 +98,7 @@ typedef enum
   TYPE_ERROR_ARRAY,
   TYPE_ERROR_ATOM,
   TYPE_ERROR_ATOMIC,
+  TYPE_ERROR_BIGNUM,
   TYPE_ERROR_BYTE,
   TYPE_ERROR_CALLABLE,
   TYPE_ERROR_CHAR,
@@ -120,5 +121,67 @@ typedef enum
   UNKNOWN_ERROR
 } yap_error_number;
 
+#define LOCAL_ERROR(v) \
+  if (H + 2*(v) > ASP-1024) { \
+    LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\
+    LOCAL_Error_Term = t;\
+    LOCAL_Error_Size = 2*(v)*sizeof(CELL);\
+    return 0L;				  \
+  }
+
+#define JMP_LOCAL_ERROR(v, LAB)   \
+  if (H + 2*(v) > ASP-1024) { \
+    LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\
+    LOCAL_Error_Term = t;\
+    LOCAL_Error_Size = 2*(v)*sizeof(CELL);\
+    goto LAB;				  \
+  }
+
+#define AUX_ERROR(t, n, s, TYPE)      \
+    if (s + (n+1) > (TYPE *)AuxSp) {  \
+    LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;\
+    LOCAL_Error_Term = t;\
+    LOCAL_Error_Size = n*sizeof(TYPE);\
+    return NULL; \
+    }
+
+#define AUX_TERM_ERROR(t, n, s, TYPE)      \
+    if (s + (n+1) > (TYPE *)AuxSp) {  \
+    LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;\
+    LOCAL_Error_Term = t;\
+    LOCAL_Error_Size = n*sizeof(TYPE);\
+    return 0L; \
+    }
+
+#define JMP_AUX_ERROR(n, s, t, TYPE, LAB)	\
+    if (s + (n+1) > (TYPE *)AuxSp) {  \
+    LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;\
+    LOCAL_Error_Term = t;\
+    LOCAL_Error_Size = n*sizeof(TYPE);\
+    goto LAB; \
+    }
+
+#define HEAP_ERROR(a,TYPE) if( a == NIL) {	\
+    LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR;\
+    LOCAL_Error_Term = t;\
+    LOCAL_Error_Size = n*sizeof(TYPE);\
+    return NULL;\
+    }
+
+#define HEAP_TERM_ERROR(a,TYPE) if( a == NIL) {	\
+    LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR;\
+    LOCAL_Error_Term = t;\
+    LOCAL_Error_Size = n*sizeof(TYPE);\
+    return 0L;\
+    }
+
+#define JMP_HEAP_ERROR(a,n,t,TYPE, LAB) if( a == NIL) {	\
+    LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR;\
+    LOCAL_Error_Term = t;\
+    LOCAL_Error_Size = n*sizeof(TYPE);\
+    goto LAB;\
+    }
+
+
 
 #endif

library/dialect/swi/fli/blobs.c

@@ -24,7 +24,7 @@
 #define _WITH_DPRINTF
 #include <stdio.h>
 
-#include	<SWI-Prolog.h>
+#include	<pl-shared.h>
 
 #include "swi.h"
 
@@ -113,10 +113,10 @@ lookupBlob(void *blob, size_t len, PL_blob_t *type, int *new)
   ae->rep.blob->length = len;
   memcpy(ae->rep.blob->data, blob, len);
   SWI_Blobs = ae;
-  UNLOCK(SWI_Blobs_Lock);
   if (NOfBlobs > NOfBlobsMax) {
     Yap_signal(YAP_CDOVF_SIGNAL);
   }
+  UNLOCK(SWI_Blobs_Lock);
   return ae;
 }
 

library/dialect/swi/fli/swi.c

@@ -36,10 +36,10 @@
 
 #define PL_KERNEL 1
 
-#include	<SWI-Stream.h>
+#include	<pl-shared.h>
-#include	<SWI-Prolog.h>
 
 #include	<yapio.h>
+#include	<YapMirror.h>
 
 #ifdef USE_GMP
 #include <gmp.h>
@@ -352,6 +352,19 @@ X_API int PL_get_float(term_t ts, double *f) /* SAM type check*/
   return 1;
 }
 
+X_API int PL_get_string_chars(term_t t, char **s, size_t *len)
+{
+  CACHE_REGS
+  Term tt = Yap_GetFromSlot(t PASS_REGS);
+  if (!IsStringTerm(tt)) {
+    return 0;
+  }
+  *s = (char *)StringOfTerm(tt);
+  *len = utf8_strlen(*s, strlen(*s));
+  return TRUE;
+}
+
+
 X_API int PL_get_head(term_t ts, term_t h)
 {
   CACHE_REGS
@@ -368,18 +381,6 @@ X_API int PL_get_string(term_t t, char **s, size_t *len)
   return PL_get_string_chars(t, s, len);
 }
 
-X_API int PL_get_string_chars(term_t t, char **s, size_t *len)
-{
-  CACHE_REGS
-  Term tt = Yap_GetFromSlot(t PASS_REGS);
-  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)
@@ -624,103 +625,47 @@ X_API int PL_get_tail(term_t ts, term_t tl)
       */
 X_API atom_t PL_new_atom(const char *c)
 {
+  CACHE_REGS
   Atom at;
-  while ((at = Yap_LookupAtom((char *)c)) == NULL) {
+  atom_t sat;
-    if (!Yap_growheap(FALSE, 0L, NULL)) {
+
-      CACHE_REGS
+  while((at = Yap_CharsToAtom(c PASS_REGS)) == 0L) {
-      Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_new_atom" ))
-      return 0L;
+      return FALSE;
-    }
   }
   Yap_AtomIncreaseHold(at);
-  return AtomToSWIAtom(at);
+  sat = AtomToSWIAtom(at);
+  return sat;
 }
 
 X_API atom_t PL_new_atom_nchars(size_t len, const char *c)
 {
+  CACHE_REGS
   Atom at;
-  char *pt;
+  atom_t sat;
-  if (strlen(c) > len) {
+
-    while ((pt = (char *)Yap_AllocCodeSpace(len+1)) == NULL) {
+  while((at = Yap_NCharsToAtom(c, len PASS_REGS)) == 0L) {
-      if (!Yap_growheap(FALSE, 0L, NULL)) {
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_new_atom_nchars" ))
-	CACHE_REGS
+      return FALSE;
-	Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
-	return 0L;
-      }
-    }
-    memcpy(pt, c, len);
-    pt[len] = '\0';
-  } else {
-    pt = (char *)c;
-  }
-  while ((at = Yap_LookupAtom(pt)) == NULL) {
-    if (!Yap_growheap(FALSE, 0L, NULL)) {
-      CACHE_REGS
-      Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
-      return 0L;
-    }
   }
   Yap_AtomIncreaseHold(at);
-  return AtomToSWIAtom(at);
+  sat = AtomToSWIAtom(at);
+  return sat;
 }
 
 X_API atom_t PL_new_atom_wchars(size_t len, const wchar_t *c)
 {
-  atom_t at;
+  CACHE_REGS
-  int i;
+  Atom at;
+  atom_t sat;
 
-  for (i=0;i<len;i++) {
+  while((at = Yap_NWCharsToAtom(c, len PASS_REGS)) == 0L) {
-    if (c[i] > 255) break;
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_new_atom_wchars" ))
+      return FALSE;
   }
-  if (i!=len) {
+  Yap_AtomIncreaseHold(at);
-    Atom at0;
+  sat = AtomToSWIAtom(at);
-    wchar_t *nbf;
+  return sat;
-    while (!(nbf = (wchar_t *)YAP_AllocSpaceFromYap((len+1)*sizeof(wchar_t)))) {
-      if (!Yap_growheap(FALSE, 0L, NULL)) {
-	CACHE_REGS
-	Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
-	return 0;
-      }
-    }
-    for (i=0;i<len;i++)
-      nbf[i] = c[i];
-    nbf[len]='\0';
-    while ((at0 = Yap_LookupWideAtom(nbf)) == NULL) {
-      if (!Yap_growheap(FALSE, 0L, NULL)) {
-	CACHE_REGS
-	Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
-	return 0L;
-      }
-    }
-    at = AtomToSWIAtom(at0);
-    Yap_AtomIncreaseHold(at0);
-    YAP_FreeSpaceFromYap(nbf);
-  } else {
-    char *nbf;
-    Atom at0;
-
-    while (!(nbf = (char *)YAP_AllocSpaceFromYap((len+1)*sizeof(char)))) {
-      if (!Yap_growheap(FALSE, 0L, NULL)) {
-	CACHE_REGS
-	Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
-	return 0;
-      }
-    }
-    for (i=0;i<len;i++)
-      nbf[i] = c[i];
-    nbf[len]='\0';
-    while (!(at0 = Yap_LookupAtom(nbf))) {
-      if (!Yap_growheap(FALSE, 0L, NULL)) {
-	CACHE_REGS
-	Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
-	return 0;
-      }
-    }
-    at = AtomToSWIAtom(at0);
-    Yap_AtomIncreaseHold(at0);
-    YAP_FreeSpaceFromYap(nbf);
-  }
-  return at;
 }
 
 X_API wchar_t *PL_atom_wchars(atom_t name, size_t *sp)
@@ -855,12 +800,9 @@ X_API int PL_put_atom_chars(term_t t, const char *s)
 {
   CACHE_REGS
   Atom at;
-  if (!(at = Yap_LookupAtom((char *)s))) {
+  while((at = Yap_CharsToAtom(s PASS_REGS)) == 0L) {
-    if (!Yap_growheap(FALSE, 0L, NULL)) {
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_atom_nchars" ))
-      CACHE_REGS
-      Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
       return FALSE;
-    }
   }
   Yap_AtomIncreaseHold(at);
   Yap_PutInSlot(t,MkAtomTerm(at) PASS_REGS);
@@ -871,25 +813,9 @@ X_API int PL_put_atom_nchars(term_t t, size_t len, const char *s)
 {
   CACHE_REGS
   Atom at;
-  char *buf;
+  while((at = Yap_NCharsToAtom(s, len PASS_REGS)) == 0L) {
-
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_atom_nchars" ))
-  if (strlen(s) > len) {
-    while (!(buf = (char *)Yap_AllocCodeSpace(len+1))) {
-      if (!Yap_growheap(FALSE, 0L, NULL)) {
-	Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
-	return FALSE;
-      }
-    }
-    memcpy(buf, s, len);
-    buf[len] = 0;
-  } else {
-    buf = (char *)s;
-  }
-  while (!(at = Yap_LookupAtom(buf))) {
-    if (!Yap_growheap(FALSE, 0L, NULL)) {
-      Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
       return FALSE;
-    }
   }
   Yap_AtomIncreaseHold(at);
   Yap_PutInSlot(t,MkAtomTerm(at) PASS_REGS);
@@ -973,12 +899,12 @@ X_API int PL_put_list(term_t t)
 X_API int PL_put_list_chars(term_t t, const char *s)
 {
   CACHE_REGS
-  Yap_PutInSlot(t,YAP_BufferToString((char *)s) PASS_REGS);
+  Term nt;
-  if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
+  while((nt = Yap_CharsToListOfAtoms(s PASS_REGS)) == 0L) {
-    if (!do_gc(0)) {
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_put_string_nchars" ))
       return FALSE;
-    }
   }
+  Yap_PutInSlot(t, nt PASS_REGS);
   return TRUE;
 }
 
@@ -1002,11 +928,12 @@ X_API int PL_put_pointer(term_t t, void *ptr)
 X_API int PL_put_string_nchars(term_t t, size_t len, const char *chars)
 {
   CACHE_REGS
-  Term tt;
+  Term nt;
-
+  while((nt = Yap_NCharsToString(chars, len PASS_REGS)) == 0L) {
-  if ((tt = Yap_MkBlobStringTerm(chars, len)) == TermNil)
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_put_string_nchars" ))
-    return FALSE;
+      return FALSE;
-  Yap_PutInSlot(t,tt PASS_REGS);
+  }
+  Yap_PutInSlot(t, nt PASS_REGS);
   return TRUE;
 }
 
@@ -1084,17 +1011,13 @@ X_API int PL_unify_atom(term_t t, atom_t at)
 X_API int PL_unify_atom_chars(term_t t, const char *s)
 {
   CACHE_REGS
-  Atom catom;
+  Atom at;
-  Term cterm;
+  while((at = Yap_CharsToAtom(s PASS_REGS)) == 0L) {
-  while (!(catom = Yap_LookupAtom((char *)s))) {
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_atom_nchars" ))
-    if (!Yap_growheap(FALSE, 0L, NULL)) {
-      Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
       return FALSE;
-    }
   }
-  Yap_AtomIncreaseHold(catom);
+  Yap_AtomIncreaseHold(at);
-  cterm = MkAtomTerm(catom);
+  return Yap_unify(Yap_GetFromSlot(t PASS_REGS), MkAtomTerm(at));
-  return Yap_unify(Yap_GetFromSlot(t PASS_REGS),cterm);
 }
 
 /* SWI: int PL_unify_atom_chars(term_t ?t, const char *chars)
@@ -1102,24 +1025,13 @@ X_API int PL_unify_atom_chars(term_t t, const char *s)
 X_API int PL_unify_atom_nchars(term_t t, size_t len, const char *s)
 {
   CACHE_REGS
-  Atom catom;
+  Atom at;
-  YAP_Term cterm;
+  while((at = Yap_NCharsToAtom(s, len PASS_REGS)) == 0L) {
-  char *buf = (char *)malloc(len+1);
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_atom_nchars" ))
-
-  if (!buf)
-    return FALSE;
-  memcpy(buf, s, len);
-  buf[len] = '\0';
-  while (!(catom = Yap_LookupAtom(buf))) {
-    if (!Yap_growheap(FALSE, 0L, NULL)) {
-      Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
       return FALSE;
-    }
   }
-  free(buf);
+  Yap_AtomIncreaseHold(at);
-  Yap_AtomIncreaseHold(catom);
+  return Yap_unify(Yap_GetFromSlot(t PASS_REGS), MkAtomTerm(at));
-  cterm = MkAtomTerm(catom);
-  return YAP_Unify(Yap_GetFromSlot(t PASS_REGS),cterm);
 }
 
 /* SWI: int PL_unify_float(term_t ?t, double f)
@@ -1252,14 +1164,12 @@ X_API int PL_unify_arg(int index, term_t tt, term_t arg)
 X_API int PL_unify_list_chars(term_t t, const char *chars)
 {
   CACHE_REGS
-  YAP_Term chterm;
+  Term chterm;
-  if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
+  while((chterm = Yap_CharsToListOfAtoms(chars PASS_REGS)) == 0L) {
-    if (!do_gc(0)) {
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_list_chars" ))
       return FALSE;
-    }
   }
-  chterm = YAP_BufferToString((char *)chars);
+  return Yap_unify(Yap_GetFromSlot(t PASS_REGS), chterm);
-  return YAP_Unify(Yap_GetFromSlot(t PASS_REGS), chterm);
 }
 
 /* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
@@ -1268,27 +1178,31 @@ X_API int PL_unify_list_ncodes(term_t t, size_t len, const char *chars)
 {
   CACHE_REGS
   Term chterm;
-  if (Unsigned(H) > Unsigned(ASP+len*2)-CreepFlag) {
+  while((chterm = Yap_NCharsToListOfCodes(chars, len PASS_REGS)) == 0L) {
-    if (!do_gc(0)) {
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_list_ncodes" ))
       return FALSE;
-    }
   }
-  chterm = Yap_NStringToList((char *)chars, len);
   return Yap_unify(Yap_GetFromSlot(t PASS_REGS), chterm);
 }
 
 X_API int
-PL_unify_list_codes(term_t l, const char *chars)
+PL_unify_list_codes(term_t t, const char *chars)
-{ return PL_unify_list_ncodes(l, strlen(chars), chars);
+{ 
+  CACHE_REGS
+  Term chterm;
+  while((chterm = Yap_CharsToListOfCodes(chars PASS_REGS)) == 0L) {
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_list_codes" ))
+      return FALSE;
+  }
+  return Yap_unify(Yap_GetFromSlot(t PASS_REGS), chterm);
 }
 
 /* SWI: int PL_unify_nil(term_t ?l)
    YAP long int  unify(YAP_Term* a, Term* b) */
-X_API int PL_unify_nil(term_t l)
+X_API int PL_unify_nil(term_t t)
 {
   CACHE_REGS
-  YAP_Term nilterm = TermNil;
+  return Yap_unify(Yap_GetFromSlot(t PASS_REGS), TermNil);
-  return YAP_Unify(Yap_GetFromSlot(l PASS_REGS), nilterm);
 }
 
 /* SWI: int PL_unify_pointer(term_t ?t, void *ptr)
@@ -1306,28 +1220,23 @@ X_API int PL_unify_pointer(term_t t, void *ptr)
 X_API int PL_unify_string_chars(term_t t, const char *chars)
 {
   CACHE_REGS
-  YAP_Term chterm;
+  Term chterm;
-  if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
+  while((chterm = Yap_CharsToString(chars PASS_REGS)) == 0L) {
-    if (!do_gc(0)) {
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_list_ncodes" ))
       return FALSE;
-    }
   }
-  chterm = YAP_BufferToString((char *)chars);
+  return Yap_unify(Yap_GetFromSlot(t PASS_REGS), chterm);
-  return YAP_Unify(Yap_GetFromSlot(t PASS_REGS), chterm);
 }
 
 X_API int PL_unify_string_nchars(term_t t, size_t len, const char *chars)
 {
   CACHE_REGS
-  YAP_Term chterm;
+  Term chterm;
-
+  while((chterm = Yap_NCharsToString(chars, len PASS_REGS)) == 0L) {
-  if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_list_ncodes" ))
-    if (!do_gc(0)) {
       return FALSE;
-    }
   }
-  chterm = YAP_NBufferToString((char *)chars, len);
+  return Yap_unify(Yap_GetFromSlot(t PASS_REGS), chterm);
-  return YAP_Unify(Yap_GetFromSlot(t PASS_REGS), chterm);
 }
 
 /* SWI: int PL_unify_wchars(term_t ?t, int type, size_t len,, const pl_wchar_t *s)
@@ -1337,43 +1246,42 @@ X_API int PL_unify_wchars(term_t t, int type, size_t len, const pl_wchar_t *char
   CACHE_REGS
   YAP_Term chterm;
 
-  if (len == (size_t)-1)
+  while (TRUE) {
-    len = wcslen(chars);
+    switch (type) {
-
+    case PL_ATOM:
-  if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
-    if (!do_gc(0)) return FALSE;
-  }
-  switch (type) {
-  case PL_ATOM:
     {
       Atom at;
-      while ((at = Yap_LookupMaybeWideAtomWithLength((wchar_t *)chars, len)) == NULL) {
+      at = Yap_NWCharsToAtom(chars, len PASS_REGS);
-	if (!Yap_growheap(FALSE, 0L, NULL)) {
+      if (at) {
-	  Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
+	Yap_AtomIncreaseHold(at);
-	  return FALSE;
+	chterm = MkAtomTerm(at);
-	}
+	return Yap_unify(Yap_GetFromSlot(t PASS_REGS), chterm);
       }
-      Yap_AtomIncreaseHold(at);
-      chterm = MkAtomTerm(at);
     }
     break;
-  case PL_STRING:
+    case PL_UTF8_STRING:
-    chterm = Yap_MkBlobWideStringTerm(chars, len);
+    case PL_STRING:
-    break;
+      if ((chterm = Yap_NWCharsToString(chars, len PASS_REGS)) != 0) {
-  case PL_UTF8_STRING:
+	return YAP_Unify(Yap_GetFromSlot(t PASS_REGS), chterm);
-    chterm = Yap_MkBlobWideStringTerm(chars, len);
+      }
-    break;
+      break;
-  case PL_CODE_LIST:
+    case PL_CODE_LIST:
-    chterm = YAP_NWideBufferToString(chars, len);
+      if ((chterm = Yap_NWCharsToListOfCodes(chars, len PASS_REGS)) != 0) {
-    break;
+	return YAP_Unify(Yap_GetFromSlot(t PASS_REGS), chterm);
-  case PL_CHAR_LIST:
+      }
-    chterm = YAP_NWideBufferToAtomList(chars, len);
+      break;
-    break;
+    case PL_CHAR_LIST:
-  default:
+      if ((chterm = Yap_NWCharsToListOfAtoms(chars, len PASS_REGS)) != 0) {
-    /* should give error?? */
+	return YAP_Unify(Yap_GetFromSlot(t PASS_REGS), chterm);
-    return FALSE;
+      }
+      break;
+    default:
+      /* should give error?? */
+      return FALSE;
+    }
+    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_wchars" ))
+      return FALSE;
   }
-  return YAP_Unify(Yap_GetFromSlot(t PASS_REGS), chterm);
 }
 
 typedef struct {
@@ -1399,52 +1307,6 @@ typedef struct {
   } arg;
 } arg_types;
 
-static Atom
-LookupMaxAtom(size_t n, char *s)
-{
-  CACHE_REGS
-  Atom catom;
-  char *buf = (char *)Yap_AllocCodeSpace(n+1);
-  
-  if (!buf)
-    return FALSE;
-  memcpy(buf, s, n);
-  buf[n] = '\0';
-  while (!(catom = Yap_LookupAtom(buf))) {
-    if (!Yap_growheap(FALSE, 0L, NULL)) {
-      Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
-      return NULL;
-    }
-  }
-  Yap_AtomIncreaseHold(catom);
-  Yap_FreeCodeSpace(buf);
-  return catom;
-}
-
-static Atom
-LookupMaxWideAtom(size_t n, wchar_t *s)
-{
-  Atom catom;
-  size_t sz = wcslen(s);
-  wchar_t *buf;
-
-  if (sz+1 < n) n = sz+1;
-  buf = (wchar_t *)Yap_AllocCodeSpace((n+1)*sizeof(wchar_t));
-  if (!buf)
-    return FALSE;
-  wcsncpy(buf, s, n);
-  buf[n] = '\0';
-  while (!(catom = Yap_LookupMaybeWideAtom(buf))) {
-    if (!Yap_growheap(FALSE, 0L, NULL)) {
-      CACHE_REGS
-      Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
-      return NULL;
-    }
-  }
-  Yap_AtomIncreaseHold(catom);
-  Yap_FreeAtomSpace((ADDR)buf);
-  return catom;
-}
 
 static YAP_Term
 MkBoolTerm(int b)
@@ -1511,33 +1373,52 @@ int PL_unify_termv(term_t l, va_list ap)
 	*pt++ = MkFloatTerm(va_arg(ap, double));
 	break;
       case PL_STRING:
-	*pt++ = Yap_MkBlobStringTerm(va_arg(ap, char *), -1);
+	{
+	  Term chterm;
+	  const char *chars = va_arg(ap, char *);
+	  while((chterm = Yap_CharsToString(chars PASS_REGS)) == 0L) {
+	    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_term" ))
+	      return FALSE;
+	  }
+	  *pt++ = chterm;
+	}
 	break;
       case PL_CHARS:
 	{
 	  Atom at;
-	  char *s = va_arg(ap, char *);
+	  const char *chars = va_arg(ap, char *);
-	  while (!(at = Yap_LookupAtom(s))) {
+	  while((at = Yap_CharsToAtom(chars PASS_REGS)) == 0L) {
-	    if (!Yap_growheap(FALSE, 0L, NULL)) {
+	    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_term" ))
-	      Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
 	      return FALSE;
-	    }
 	  }
-	  Yap_AtomIncreaseHold(at);
 	  *pt++ = MkAtomTerm(at);
+	  Yap_AtomIncreaseHold(at);
 	}
 	break;
       case PL_NCHARS:
 	{
+	  Atom at;
 	  size_t sz = va_arg(ap, size_t);
-	  *pt++ = MkAtomTerm(LookupMaxAtom(sz,va_arg(ap, char *)));
+	  const char *chars = va_arg(ap, char *);
+	  while((at = Yap_NCharsToAtom(chars, sz PASS_REGS)) == 0L) {
+	    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_term" ))
+	      return FALSE;
+	  }
+	  *pt++ = MkAtomTerm(at);
+	  Yap_AtomIncreaseHold(at);
 	}
 	break;
       case PL_NWCHARS:
 	{
+	  Atom at;
 	  size_t sz = va_arg(ap, size_t);
-	  wchar_t * arg = va_arg(ap, wchar_t *);
+	  const wchar_t *chars = va_arg(ap, wchar_t *);
-	  *pt++ = MkAtomTerm(LookupMaxWideAtom(sz,arg));
+	  while((at = Yap_NWCharsToAtom(chars, sz PASS_REGS)) == 0L) {
+	    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_term" ))
+	      return FALSE;
+	  }
+	  *pt++ = MkAtomTerm(at);
+	  Yap_AtomIncreaseHold(at);
 	}
 	break;
       case PL_TERM:
@@ -1612,29 +1493,19 @@ int PL_unify_termv(term_t l, va_list ap)
 	{
 	  char *fname = va_arg(ap, char *);
 	  size_t arity = va_arg(ap, size_t);
+	  Atom at;
 
+	  while((at = Yap_CharsToAtom(fname PASS_REGS)) == 0L) {
+	    if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_unify_term" ))
+	      return FALSE;
+	  }
+	  Yap_AtomIncreaseHold(at);
 	  if (!arity) {
-	    Atom at;
-
-	    while (!(at = Yap_LookupAtom(fname))) {
-	      if (!Yap_growheap(FALSE, 0L, NULL)) {
-		Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
-		return FALSE;
-	      }
-	    }
-	    Yap_AtomIncreaseHold(at);
 	    *pt++ = MkAtomTerm(at);
 	  } else {
-	    Atom at;
 	    Functor ff;
 	    Term t;
 
-	    while (!(at = Yap_LookupAtom(fname))) {
-	      if (!Yap_growheap(FALSE, 0L, NULL)) {
-		Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
-		return FALSE;
-	      }
-	    }
 	    ff = Yap_MkFunctor(at,arity);
 	    t = Yap_MkNewApplTerm(ff, arity);
 	    if (nels) {
@@ -1864,7 +1735,7 @@ X_API int PL_is_string(term_t ts)
 {
   CACHE_REGS
   Term t = Yap_GetFromSlot(ts PASS_REGS);
-  return Yap_IsStringTerm(t);
+  return IsStringTerm(t);
 }
 
 X_API int PL_is_variable(term_t ts)
@@ -2354,7 +2225,7 @@ X_API void PL_cut_query(qid_t qi)
   if (qi->open != 1 || qi->state == 0) return;
   YAP_LeaveGoal(FALSE, &qi->h);
   qi->open = 0;
-  Yap_FreeCodeSpace( qi );
+  Yap_FreeCodeSpace( (char *)qi );
 }
 
 X_API void PL_close_query(qid_t qi)
@@ -2370,7 +2241,7 @@ X_API void PL_close_query(qid_t qi)
   }
   YAP_LeaveGoal(FALSE, &qi->h);
   qi->open = 0;
-  Yap_FreeCodeSpace( qi );
+  Yap_FreeCodeSpace( (char *)qi );
 }
 
 X_API int PL_call_predicate(module_t ctx, int flags, predicate_t p, term_t t0)
@@ -2906,7 +2777,6 @@ str_prefix(const char *p0, char *s)
 static int
 atom_generator(const char *prefix, char **hit, int state)
 {
-  CACHE_REGS
   struct scan_atoms *index;
   Atom            catom;
   Int            i;

library/dialect/swi/fli/swi.h

@@ -39,24 +39,6 @@ in_hash(ADDR key)
 }
 
 
-static inline atom_t
-AtomToSWIAtom(Atom at)
-{
-  TranslationEntry *p;
-
-  if ((p = Yap_GetTranslationProp(at)) != NULL)
-    return (atom_t)(p->Translation*2+1);
-  return (atom_t)at;
-}
-
-static inline Atom
-SWIAtomToAtom(atom_t at)
-{
-  if ((CELL)at & 1)
-    return SWI_Atoms[at/2];
-  return (Atom)at;
-}
-
 static inline Term
 SWIModuleToModule(module_t m)
 {
@@ -77,13 +59,4 @@ FunctorToSWIFunctor(Functor at)
   return (functor_t)at;
 }
 
-/* This is silly, but let's keep it like that for now */
-static inline Functor
-SWIFunctorToFunctor(functor_t f)
-{
-  if ((CELL)(f) & 2 && ((CELL)f) < N_SWI_FUNCTORS*4+2)
-    return SWI_Functors[((CELL)f)/4];
-  return (Functor)f;
-}
-
 #define isDefinedProcedure(pred) TRUE // TBD

misc/ATOMS

@@ -39,6 +39,7 @@ A	B			F	"$last_choice_pt"
 A	Batched			N	"batched"
 A	Between			N	"between"
 A	HugeInt			N	"huge_int"
+A	BigNum			N	"big_num"
 A	BinaryStream		N	"binary_stream"
 A	Braces			N	"{}"
 A	Break			F	"$break"
@@ -301,6 +302,7 @@ A	StreamOrAlias		N	"stream_or_alias"
 A	StreamPos		F	"$stream_position"
 A	StreamPosition		N	"stream_position"
 A	String			N	"string"
+A	STRING			F	"String"
 A	Swi			N	"swi"
 A	SyntaxError		N	"syntax_error"
 A	SyntaxErrorHandler	N	"syntax_error_handler"

misc/LOCALS

@@ -271,4 +271,6 @@ Int				CurSlot					=0
 
 Term				SourceModule				=0
 
+size_t				MAX_SIZE				=1024L
+
 END_WORKER_LOCAL

misc/buildops

@@ -261,6 +261,7 @@ get_op(0'O,"OrArg").
 get_op(0'p,"PtoPred").
 get_op(0's,"Constant").
 get_op(0't,"TabEntry").
+get_op(0'u,"BlobTermInCode").
 get_op(0'x,"X").
 get_op(0'y,"Y").
 % '
@@ -884,6 +885,7 @@ opinfo("gl_void_vary",[bind("y","AbsPair(NULL)",workpc=currentop),new("y")]).
 opinfo("get_struct",[bind("x","AbsAppl((CELL *)cl->u.xfa.f)",workpc=nextop)]).
 opinfo("get_float",[bind("x","AbsAppl((CELL *)FunctorDouble)",t_ptr="d")]).
 opinfo("get_longint",[bind("x","AbsAppl((CELL *)FunctorLongInt)",t_ptr="i")]).
+opinfo("get_string",[bind("x","AbsAppl((CELL *)FunctorString)",t_ptr=[])]).
 opinfo("get_bigint",[bind("x","AbsAppl((CELL *)FunctorBigInt)",t_ptr=[])]).
 opinfo("copy_idb_term",[logical]).
 opinfo("unify_idb_term",[logical]).
@@ -892,6 +894,7 @@ opinfo("put_dbterm",[new("x")]).
 opinfo("put_bigint",[new("x")]).
 opinfo("put_float",[new("x")]).
 opinfo("put_longint",[new("x")]).
+opinfo("put_string",[new("x")]).
 opinfo("put_list",[new("x")]).
 opinfo("put_struct",[new("x")]).
 opinfo("get_2atoms",[bind(1,"c1",[]),
@@ -1059,6 +1062,11 @@ opinfo("unify_bigint_write",[]).
 opinfo("unify_l_bigint",[]).
 opinfo("unify_l_bigint_write",[]).
 opinfo("write_bigint",[body]).
+opinfo("unify_string",[]).
+opinfo("unify_string_write",[]).
+opinfo("unify_l_string",[]).
+opinfo("unify_l_string_write",[]).
+opinfo("write_string",[body]).
 opinfo("unify_dbterm",[]).
 opinfo("unify_dbterm_write",[]).
 opinfo("unify_l_dbterm",[]).

os/pl-utf8.c

@@ -65,6 +65,54 @@ _PL__utf8_get_char(const char *in, int *chr)
   return (char *)in+1;
 }
 
+unicode_type_t
+_PL__utf8_type(const char *in0, size_t len)
+{ 					/* 2-byte, 0x80-0x7ff */
+  int chr;
+  char *in = (char *) in0;
+  int type = S_ASCII;
+
+  while (in[0] != '\0' && in-in0 < len) {
+    if ( (in[0]&0xe0) == 0xc0 && CONT(1) )
+      { chr = ((in[0]&0x1f) << 6)|VAL(1,0);
+	if (chr > 255) return S_WIDE;
+	if (chr > 127) type = S_LATIN;
+	in += 2;
+	break;
+      }
+    /* 3-byte, 0x800-0xffff */
+    if ( (in[0]&0xf0) == 0xe0 && CONT(1) && CONT(2) )
+      { chr = ((in[0]&0xf) << 12)|VAL(1,6)|VAL(2,0);
+	if (chr > 255) return S_WIDE;
+	if (chr > 127) type = S_LATIN;
+	in += 3;
+      }
+    /* 4-byte, 0x10000-0x1FFFFF */
+    if ( (in[0]&0xf8) == 0xf0 && CONT(1) && CONT(2) && CONT(3) )
+      { chr = ((in[0]&0x7) << 18)|VAL(1,12)|VAL(2,6)|VAL(3,0);
+	if (chr > 255) return S_WIDE;
+	if (chr > 127) type = S_LATIN;
+	in += 4;
+      }
+    /* 5-byte, 0x200000-0x3FFFFFF */
+    if ( (in[0]&0xfc) == 0xf8 && CONT(1) && CONT(2) && CONT(3) && CONT(4) )
+      { chr = ((in[0]&0x3) << 24)|VAL(1,18)|VAL(2,12)|VAL(3,6)|VAL(4,0);
+	if (chr > 255) return S_WIDE;
+	if (chr > 127) type = S_LATIN;
+	in += 5;
+      }
+    /* 6-byte, 0x400000-0x7FFFFFF */
+    if ( (in[0]&0xfe) == 0xfc && CONT(1) && CONT(2) && CONT(3) && CONT(4) && CONT(5) )
+      { chr = ((in[0]&0x1) << 30)|VAL(1,24)|VAL(2,18)|VAL(3,12)|VAL(4,6)|VAL(5,0);
+	if (chr > 255) return S_WIDE;
+	if (chr > 127) type = S_LATIN;
+	in += 6;
+      }
+    in ++;
+  }
+  return type;
+}
+
 
 char *
 _PL__utf8_put_char(char *out, int chr)

os/pl-utf8.h

@@ -59,4 +59,12 @@ extern char *_PL__utf8_put_char(char *out, int chr);
 
 extern size_t utf8_strlen(const char *s, size_t len);
 
+typedef enum {
+  S_ASCII,
+  S_LATIN,
+  S_WIDE
+} unicode_type_t;
+
+extern unicode_type_t _PL__utf8_type(const char *in0, size_t len);
+
 #endif /*UTF8_H_INCLUDED*/

pl/boot.yap

@@ -1023,7 +1023,7 @@ bootstrap(F) :-
 	close(Stream).
 
 '$read_vars'(Stream, T, Mod, Pos, V, _Prompt, false) :- !,
-       read_term(Stream, T, [ /* module(Mod), */ variable_names(V), term_position(Pos), syntax_errors(dec10)  ]).
+       read_term(Stream, T, [  module(Mod), variable_names(V), term_position(Pos), syntax_errors(dec10)  ]).
 '$read_vars'(Stream, T, Mod, Pos, V, _Prompt, ReadComments) :-
        read_term(Stream, T, [module(Mod), variable_names(V), term_position(Pos), syntax_errors(dec10),  comments( ReadComments ) ]).
 

pl/preds.yap

@@ -983,9 +983,9 @@ current_predicate(F0) :-
 
 '$$current_predicate'(F, M) :-
         ( var(M) ->			% only for the predicate
-	'$current_module'(M),
+	'$current_module'(M)
-	M \= prolog
 	; true),
+	M \= prolog,
 	'$current_predicate3'(F,M).
 
 '$current_predicate3'(A/Arity,M) :-