diff --git a/C/amasm.c b/C/amasm.c index 6639bc32c..b27136b8b 100755 --- a/C/amasm.c +++ b/C/amasm.c @@ -1152,8 +1152,7 @@ a_ustring(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blo 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])); - + AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1])); } *clause_has_blobsp = TRUE; GONEXT(ou); diff --git a/C/atoms.c b/C/atoms.c index 8980b5e02..0f6a6c388 100644 --- a/C/atoms.c +++ b/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); diff --git a/C/compiler.c b/C/compiler.c index 17b9ca358..88dc9da36 100644 --- a/C/compiler.c +++ b/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 diff --git a/C/errors.c b/C/errors.c index 1cc0829a3..2627010b9 100644 --- a/C/errors.c +++ b/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; diff --git a/C/pl-yap.c b/C/pl-yap.c index ad6cc8bb1..dd7127bb2 100755 --- a/C/pl-yap.c +++ b/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 (YAP_IsWideAtom(ya)) { - pl_wchar_t *name = (pl_wchar_t *)YAP_WideAtomName(ya); + if (IsWideAtom(a)) { + pl_wchar_t *name = (pl_wchar_t *)a->WStrOfAE; 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); } diff --git a/C/strings.c b/C/strings.c index 1dd6c3a8a..620708246 100644 --- a/C/strings.c +++ b/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 ); diff --git a/H/YapMirror.h b/H/YapMirror.h index 9bb1756dc..9dd694ee2 100644 --- a/H/YapMirror.h +++ b/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) { diff --git a/H/pl-yap.h b/H/pl-yap.h index 95d70d6dd..6d3cfdeb1 100644 --- a/H/pl-yap.h +++ b/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; diff --git a/include/YapError.h b/include/YapError.h index b5b0ab70c..b19b89b8c 100644 --- a/include/YapError.h +++ b/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,