more atom/string manipulation fixes and SWI compatibility

C/amasm.c

@@ -1153,7 +1153,6 @@ a_ustring(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blo
     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);

C/atoms.c

@@ -65,6 +65,10 @@ p_char_code( USES_REGS1 )
       Yap_Error(INSTANTIATION_ERROR,t0,"char_code/2");
       return(FALSE);
     } else if (!IsIntegerTerm(t1)) {
+      if (!IsBigIntTerm(t1)) {
+	Yap_Error(REPRESENTATION_ERROR_INT,t1,"char_code/2");
+	return(FALSE);
+      }
       Yap_Error(TYPE_ERROR_INTEGER,t1,"char_code/2");
       return(FALSE);
     } else {
@@ -78,6 +82,10 @@ p_char_code( USES_REGS1 )
       if (code > MAX_ISO_LATIN1) {
 	wchar_t wcodes[2];
 
+	if (code > CHARCODE_MAX) {
+	  Yap_Error(REPRESENTATION_ERROR_INT,t1,"char_code/2");
+	  return(FALSE);
+	}
 	wcodes[0] = code;
 	wcodes[1] = '\0';
 	tout = MkAtomTerm(Yap_LookupWideAtom(wcodes));
@@ -184,12 +192,12 @@ p_string_to_atom( USES_REGS1 )
   if (!IsVarTerm(t1)) {
     Atom at;
     // verify if an atom, int, float or bignnum
-    at = Yap_StringToAtom( t1 PASS_REGS );
+    at = Yap_StringSWIToAtom( t1 PASS_REGS );
     if (at)
       return Yap_unify(MkAtomTerm(at), t2);
     // else
   } else {
-    Term t0 = Yap_AtomToString( t2 PASS_REGS );
+    Term t0 = Yap_AtomSWIToString( t2 PASS_REGS );
     if (t0) return Yap_unify(t0, t1);
   }
   if (LOCAL_Error_TYPE && Yap_HandleError( "string_to_atom/2" )) {
@@ -284,6 +292,30 @@ p_atom_codes( USES_REGS1 )
   return FALSE;
 }
 
+static Int 
+p_string_codes( USES_REGS1 )
+{
+  Term t1;
+ restart_aux:
+  t1  = Deref(ARG1);
+  if (!IsVarTerm(t1)) {
+    Term tf = Yap_StringSWIToListOfCodes(t1 PASS_REGS);
+    if (tf)
+      return Yap_unify( ARG2, tf );
+  } else {
+    /* ARG1 unbound */
+    Term   t = Deref(ARG2);
+    Term tf = Yap_ListSWIToString(t PASS_REGS);
+    if (tf)
+      return Yap_unify( ARG1, tf );
+  }
+  /* error handling */
+  if (LOCAL_Error_TYPE && Yap_HandleError( "atom_codes/2" )) {
+    t1 = Deref(ARG1);
+    goto restart_aux;
+  }
+  return FALSE;
+}
 
 static Int 
 p_number_chars( USES_REGS1 )
@@ -335,6 +367,31 @@ p_number_atom( USES_REGS1 )
   return FALSE;
 }
 
+static Int 
+p_number_string( USES_REGS1 )
+{
+  Term t1;
+ restart_aux:
+  t1  = Deref(ARG1);
+  if (!IsVarTerm(t1)) {
+    Term tf;
+    tf = Yap_NumberToString(t1 PASS_REGS);
+    if (tf)
+      return Yap_unify( ARG2, tf );
+  } else {
+    /* ARG1 unbound */
+    Term   t = Deref(ARG2);
+    Term tf = Yap_StringToNumber(t PASS_REGS);
+    if (tf)
+      return Yap_unify( ARG1, tf );
+  }
+  /* error handling */
+  if (LOCAL_Error_TYPE && Yap_HandleError( "number_string/2")) {
+    goto restart_aux;
+  }
+  return FALSE;
+}
+
 static Int 
 p_number_codes( USES_REGS1 )
 {
@@ -559,7 +616,7 @@ p_atom_length( USES_REGS1 )
       Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2");
       return(FALSE);
     }
-    if ((len = IntegerOfTerm(t2)) < 0) {
+    if (FALSE && (len = IntegerOfTerm(t2)) < 0) {
       Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2");
       return(FALSE);
     }
@@ -589,7 +646,7 @@ p_atomic_length( USES_REGS1 )
       Yap_Error(TYPE_ERROR_INTEGER, t2, "atomic_length/2");
       return(FALSE);
     }
-    if ((len = IntegerOfTerm(t2)) < 0) {
+    if (FALSE && (len = IntegerOfTerm(t2)) < 0) {
       Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atomic_length/2");
       return(FALSE);
     }
@@ -619,7 +676,7 @@ p_string_length( USES_REGS1 )
       Yap_Error(TYPE_ERROR_INTEGER, t2, "string_length/2");
       return(FALSE);
     }
-    if ((len = IntegerOfTerm(t2)) < 0) {
+    if (FALSE && (len = IntegerOfTerm(t2)) < 0) {
       Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "string_length/2");
       return(FALSE);
     }
@@ -1514,12 +1571,14 @@ Yap_InitAtomPreds(void)
   Yap_InitCPred("char_code", 2, p_char_code, SafePredFlag);
   Yap_InitCPred("atom_chars", 2, p_atom_chars, 0);
   Yap_InitCPred("atom_codes", 2, p_atom_codes, 0);
+  Yap_InitCPred("string_codes", 2, p_string_codes, 0);
   Yap_InitCPred("atom_length", 2, p_atom_length, SafePredFlag);
   Yap_InitCPred("atomic_length", 2, p_atomic_length, SafePredFlag);
   Yap_InitCPred("string_length", 2, p_string_length, SafePredFlag);
   Yap_InitCPred("$atom_split", 4, p_atom_split, SafePredFlag);
   Yap_InitCPred("number_chars", 2, p_number_chars, 0);
   Yap_InitCPred("number_atom", 2, p_number_atom, 0);
+  Yap_InitCPred("number_string", 2, p_number_string, 0);
   Yap_InitCPred("number_codes", 2, p_number_codes, 0);
   Yap_InitCPred("atom_number", 2, p_atom_number, 0);
   Yap_InitCPred("string_number", 2, p_string_number, 0);

C/compiler.c

@@ -693,7 +693,6 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
 	Int sz = (3+src[1])*sizeof(CELL);
 	CELL *dest;
 
-	char *ptr = src+2; int chr;
 	/* use a special list to store the blobs */
 	cglobs->cint.cpc = cglobs->cint.icpc;
 	/*      if (IsFloatTerm(t)) {
@@ -719,7 +718,7 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
 	else
 	  Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_string_op
 			  : unify_string_op) :
-		write_string_op), t, Zero, &cglobs->cint);
+		write_string_op), l1, 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

C/errors.c

@@ -1476,6 +1476,19 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
       serious = TRUE;
     }
     break;
+  case REPRESENTATION_ERROR_INT:
+    {
+      int i;
+      Term ti[1];
+
+      i = strlen(tmpbuf);
+      ti[0] = MkAtomTerm(AtomInt);
+      nt[0] = Yap_MkApplTerm(FunctorRepresentationError, 1, ti);
+      psize -= i;
+      fun = FunctorError;
+      serious = TRUE;
+    }
+    break;
   case REPRESENTATION_ERROR_MAX_ARITY:
     {
       int i;

C/pl-yap.c

@@ -390,14 +390,13 @@ typedef union
 int
 get_atom_ptr_text(Atom a, PL_chars_t *text)
 { 
-  YAP_Atom ya = (YAP_Atom)a;
+  if (IsWideAtom(a)) {
-  if (YAP_IsWideAtom(ya)) {
+    pl_wchar_t *name = (pl_wchar_t *)a->WStrOfAE;
-    pl_wchar_t *name = (pl_wchar_t *)YAP_WideAtomName(ya);
     text->text.w   = name;
     text->length   = wcslen(name);
     text->encoding = ENC_WCHAR;
   } else
-    { char *name = (char *)YAP_AtomName(ya);
+    { char *name = a->StrOfAE;
     text->text.t   = name;
     text->length   = strlen(name);
     text->encoding = ENC_ISO_LATIN_1;
@@ -411,7 +410,7 @@ get_atom_ptr_text(Atom a, PL_chars_t *text)
 
 int
 get_atom_text(atom_t atom, PL_chars_t *text)
-{ Atom a = (Atom)atomValue(atom);
+{ Atom a = YAP_AtomFromSWIAtom(atom);
 
   return get_atom_ptr_text(a, text);
 }

C/strings.c

@@ -60,7 +60,7 @@ get_string_from_list( Term t, seq_tv_t *inp, char *s, int atoms USES_REGS)
       Atom at;
       if (IsWideAtom(at = AtomOfTerm(HeadOfTerm(t)))) {
 	int i = RepAtom(at)->WStrOfAE[0];
-	if (i <= 0 || i > 255) {
+	if (i <= 0) {
 	  LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE;
 	  return NULL;		
 	}
@@ -116,7 +116,12 @@ get_wide_from_list( Term t, seq_tv_t *inp, wchar_t *s, int atoms USES_REGS)
     }
   } else {
     while (t != TermNil) {
-      *s++ = IntOfTerm(HeadOfTerm(t));
+      int code;
+      *s++ = code = IntOfTerm(HeadOfTerm(t));
+      if (code <= 0) {
+	LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE;
+	return NULL;		
+      }
       if (--max == 0) {
 	*s++ = 0;
 	return s0;
@@ -456,7 +461,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal USES_REGS)
       } else if (IsAtomTerm(t)) {
 	if (inp->type & (YAP_STRING_ATOM)) {
 	  inp->type &= (YAP_STRING_ATOM);
-	  inp->val.a = AtomOfTerm(t);
+	  inp->val.t = t;
 	  return read_Text( buf, inp, enc, minimal PASS_REGS);
 	} else {
 	  LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
@@ -511,7 +516,7 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal USES_REGS)
 
       LOCAL_TERM_ERROR( 2*(lim-s) );
       buf = buf_from_tstring(H);
-      while (cp < lim) {
+      while (*cp && cp < lim) {
 	int chr;
 	cp = utf8_get_char(cp, &chr);
 	buf = utf8_put_char(buf, chr);
@@ -629,7 +634,7 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal USES_REGS)
       w[1] = '\0';
 
       LOCAL_TERM_ERROR( 2*(lim-s) );
-      while (cp < lim) {
+      while (*cp && cp < lim) {
 	int chr;
 	cp = get_wchar(cp, &chr);
 	w[0] = chr;
@@ -673,7 +678,7 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal USES_REGS)
     { char *s = s0, *lim = s + strnlen(s, max);
       char *cp = s;
       LOCAL_TERM_ERROR( 2*(lim-s) );
-      while (cp < lim) {
+      while (*cp && cp < lim) {
 	int chr;
 	cp = utf8_get_char(cp, &chr);
 	H[0] = MkIntTerm(chr);
@@ -750,11 +755,12 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal USES_REGS)
       wchar_t *buf = malloc(sizeof(wchar_t)*((lim+1)-s)), *ptr = buf;
       Atom at;
 
-      while (s < lim) {
+      while (*s && s < lim) {
 	int chr;
 	s = utf8_get_char(s, &chr);
 	*ptr++ = chr;
       }
+      *ptr++ = '\0';
       if (min > max) max = min;
       at = Yap_LookupMaybeWideAtomWithLength( buf, max );
       free( buf );

H/YapMirror.h

@@ -18,6 +18,12 @@
 static char SccsId[] = "%W% %G%";
 #endif
 
+#if SIZEOF_WCHAR_T == 2
+#define CHARCODE_MAX 0xffff
+#else
+#define CHARCODE_MAX 0x10ffff
+#endif
+
 /*
  * This file defines main data-structure for text conversion and
  * mirroring
@@ -223,6 +229,20 @@ Yap_AtomToString(Term t0 USES_REGS)
   return out.val.t;
 }
 
+static inline Term
+Yap_AtomSWIToString(Term t0 USES_REGS)
+{
+  seq_tv_t inp, out;
+
+  inp.val.t = t0;
+  inp.type = YAP_STRING_ATOM|YAP_STRING_STRING|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_ATOMS_CODES|YAP_STRING_TERM;
+  out.type = YAP_STRING_STRING;
+  
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  return out.val.t;
+}
+
 static inline Term
 Yap_AtomicToString(Term t0 USES_REGS)
 {
@@ -383,6 +403,21 @@ Yap_ListToString(Term t0 USES_REGS)
 }
 
 
+static inline Term
+Yap_ListSWIToString(Term t0 USES_REGS)
+{
+  seq_tv_t inp, out;
+
+  inp.val.t = t0;
+  inp.type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM;
+  out.type = YAP_STRING_STRING;
+  
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  return out.val.t;
+}
+
+
 static inline Term
 YapListToTDQ(Term t0, Term mod USES_REGS)
 {
@@ -584,6 +619,18 @@ Yap_StringToAtom(Term t0 USES_REGS)
   return out.val.a;
 }
 
+static inline Atom
+Yap_StringSWIToAtom(Term t0 USES_REGS)
+{
+  seq_tv_t inp, out;
+  inp.val.t = t0;
+  inp.type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_ATOMS_CODES|YAP_STRING_TERM;
+  out.type = YAP_STRING_ATOM;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  return out.val.a;
+}
+
 static inline size_t
 Yap_StringToAtomic(Term t0 USES_REGS)
 {
@@ -632,6 +679,18 @@ Yap_StringToListOfCodes(Term t0 USES_REGS)
   return out.val.t;
 }
 
+static inline size_t
+Yap_StringSWIToListOfCodes(Term t0 USES_REGS)
+{
+  seq_tv_t inp, out;
+  inp.val.t = t0;
+  inp.type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_ATOMS_CODES|YAP_STRING_TERM;
+  out.type = YAP_STRING_CODES;
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+    return 0L;
+  return out.val.t;
+}
+
 static inline Term
 Yap_StringToNumber(Term t0 USES_REGS)
 {

H/pl-yap.h

@@ -133,7 +133,7 @@ void PL_license(const char *license, const char *module);
 #define isVar(A) IsVarTerm((A))
 #define valReal(w) FloatOfTerm((w))
 #define valFloat(w) FloatOfTerm((w))
-#define atomValue(atom) YAP_AtomFromSWIAtom(atom)
+#define atomValue(atom) AtomOfTerm(atom)
 #define atomFromTerm(term) YAP_SWIAtomFromAtom(AtomOfTerm(term))
 
 inline static char *
@@ -184,7 +184,7 @@ charCode(Term w)
 	return -1;
       }
       if (strlen(a->StrOfAE) == 1)
-	return a->StrOfAE[0];
+	return ((unsigned char *)(a->StrOfAE))[0];
       return -1;
     }
   return -1;

include/YapError.h

@@ -84,6 +84,7 @@ typedef enum
   PRED_ENTRY_COUNTER_UNDERFLOW,
   REPRESENTATION_ERROR_CHARACTER,
   REPRESENTATION_ERROR_CHARACTER_CODE,
+  REPRESENTATION_ERROR_INT,
   REPRESENTATION_ERROR_MAX_ARITY,
   REPRESENTATION_ERROR_VARIABLE,
   RESOURCE_ERROR_HUGE_INT,