From 1c3c0c630116ca1503b32f77e24f6301953f4b6b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 22 Oct 2014 16:22:38 +0100 Subject: [PATCH 1/7] fix sub_atom, by Paulo Moura. --- C/atomic.c | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/C/atomic.c b/C/atomic.c index 32c766fdc..61b2f9002 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -1831,6 +1831,10 @@ init_sub_atomic( int sub_atom USES_REGS ) return FALSE; } else { min = IntegerOfTerm(tbef); + if ((Int)min < 0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tbef, "sub_string/5"); + return FALSE; + }; mask |= SUB_ATOM_HAS_MIN; bnds++; } @@ -1841,6 +1845,10 @@ init_sub_atomic( int sub_atom USES_REGS ) return FALSE; } else { len = IntegerOfTerm(tsize); + if ((Int)len < 0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tsize, "sub_string/5"); + return FALSE; + }; mask |= SUB_ATOM_HAS_SIZE; bnds++; } @@ -1851,6 +1859,10 @@ init_sub_atomic( int sub_atom USES_REGS ) return FALSE; } else { after = IntegerOfTerm(tafter); + if ((Int)after < 0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tafter, "sub_string/5"); + return FALSE; + }; mask |= SUB_ATOM_HAS_AFTER; bnds++; } From 93270c125acb3244f2a3993bb6e7c231acc8a760 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 22 Oct 2014 16:50:12 +0100 Subject: [PATCH 2/7] fix several ISO compat bugs (Paulo Moura). --- C/arith2.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/C/arith2.c b/C/arith2.c index e314b84e4..4a2775a3e 100644 --- a/C/arith2.c +++ b/C/arith2.c @@ -253,7 +253,7 @@ p_div2(Term t1, Term t2 USES_REGS) { /* two bignums */ return Yap_gmp_div2_big_big(t1, t2); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2"); default: RERROR(); } @@ -282,7 +282,7 @@ p_rem(Term t1, Term t2 USES_REGS) { RINT(i1%i2); } case (CELL)double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rem/2"); case (CELL)big_int_e: #ifdef USE_GMP return Yap_gmp_rem_int_big(IntegerOfTerm(t1), t2); @@ -292,7 +292,7 @@ p_rem(Term t1, Term t2 USES_REGS) { } break; case (CELL)double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "mod/2"); + return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "rem/2"); case (CELL)big_int_e: #ifdef USE_GMP switch (ETypeOfTerm(t2)) { @@ -304,7 +304,7 @@ p_rem(Term t1, Term t2 USES_REGS) { /* two bignums */ return Yap_gmp_rem_big_big(t1, t2); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rem/2"); default: RERROR(); } @@ -350,7 +350,7 @@ p_rdiv(Term t1, Term t2 USES_REGS) { case (CELL)big_int_e: return Yap_gmq_rdiv_big_big(t1, t2); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rdiv/2"); default: RERROR(); } From 92ffbe5a2e4ed2b3978d689b8ca5ef1486e84554 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 22 Oct 2014 17:17:34 +0100 Subject: [PATCH 3/7] fix atomic_conct, Paulo Moura --- C/atomic.c | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/C/atomic.c b/C/atomic.c index 61b2f9002..7d365f75c 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -638,10 +638,13 @@ init_atom_concat3( USES_REGS1 ) } else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) { at = Yap_SubtractTailAtom( Deref(ARG3), t2 PASS_REGS ); ot = ARG1; - } else { + } else if (Yap_IsGroundTerm(t3)) { EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_AtomToLength(t3 PASS_REGS)); return cont_atom_concat3( PASS_REGS1 ); + } else { + LOCAL_Error_TYPE = INSTANTIATION_ERROR; + LOCAL_Error_Term = t1; } if (at) { if (Yap_unify(ot, MkAtomTerm(at))) cut_succeed(); @@ -732,10 +735,13 @@ init_atomic_concat3( USES_REGS1 ) } else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) { at = Yap_SubtractTailAtom( t3, CastToAtom(t2) PASS_REGS ); ot = ARG1; + } else if (Yap_IsGroundTerm(t3)) { + EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); + EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_AtomicToLength(t3 PASS_REGS)); + return cont_atomic_concat3( PASS_REGS1 ); } else { - EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); - EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_AtomicToLength(t3 PASS_REGS)); - return cont_atomic_concat3( PASS_REGS1 ); + LOCAL_Error_TYPE = INSTANTIATION_ERROR; + LOCAL_Error_Term = t1; } if (at) { if (Yap_unify(ot, CastToNumeric(at))) cut_succeed(); From 0367f528402ec926783bca0272e6acf8d1329250 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 22 Oct 2014 17:22:37 +0100 Subject: [PATCH 4/7] string_concat --- C/atomic.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/C/atomic.c b/C/atomic.c index 7d365f75c..e631d5405 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -810,10 +810,13 @@ init_string_concat3( USES_REGS1 ) } else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) { tf = Yap_SubtractTailString( t3, t2 PASS_REGS ); ot = ARG1; + } else if (Yap_IsGroundTerm(t3)) { + EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); + EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_StringToLength(t3 PASS_REGS)); + return cont_string_concat3( PASS_REGS1 ); } else { - EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); - EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_StringToLength(t3 PASS_REGS)); - return cont_string_concat3( PASS_REGS1 ); + LOCAL_Error_TYPE = INSTANTIATION_ERROR; + LOCAL_Error_Term = t1; } if (tf) { if (Yap_unify(ot, tf)) { cut_succeed(); } From 171dca1c8c1b11ac5ca614300813c08a7c48a723 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 22 Oct 2014 17:54:50 +0100 Subject: [PATCH 5/7] Paulo Moura: fix atom_length/2 e atomic_length/2. --- C/atomic.c | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/C/atomic.c b/C/atomic.c index e631d5405..ba4268ef8 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -1225,23 +1225,29 @@ p_atomics_to_string3( USES_REGS1 ) static Int p_atom_length( USES_REGS1 ) { - Term t1; + Term t1 = Deref(ARG1);; Term t2 = Deref(ARG2); ssize_t len; + if (!Yap_IsGroundTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR, t1, "atom_length/2"); + return(FALSE); + } else if (!IsAtomTerm(t1)) { + Yap_Error(TYPE_ERROR_ATOM, t1, "atom_length/2"); + return(FALSE); + } + if (Yap_IsGroundTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2"); return(FALSE); - } - if (FALSE && (len = IntegerOfTerm(t2)) < 0) { + } else if ((len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2"); return(FALSE); } } restart_aux: - t1 = Deref(ARG1); len = Yap_AtomicToLength(t1 PASS_REGS); if (len != (size_t)-1) return Yap_unify( ARG2, MkIntegerTerm(len) ); @@ -1255,23 +1261,30 @@ restart_aux: static Int p_atomic_length( USES_REGS1 ) { - Term t1; + Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); ssize_t len; + if (!Yap_IsGroundTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR, t1, "atomic_length/2"); + return(FALSE); + } else if (!IsAtomicTerm(t1)) { + Yap_Error(TYPE_ERROR_ATOM, t1, "atomic_length/2"); + return(FALSE); + } + if (Yap_IsGroundTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "atomic_length/2"); return(FALSE); } - if (FALSE && (len = IntegerOfTerm(t2)) < 0) { + if ((len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atomic_length/2"); return(FALSE); } } restart_aux: - t1 = Deref(ARG1); len = Yap_AtomicToLength(t1 PASS_REGS); if (len != (size_t)-1) return Yap_unify( ARG2, MkIntegerTerm(len) ); From 6c021e7899077f12b2dba4415cb5f3f0bf583d63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 22 Oct 2014 20:26:19 +0100 Subject: [PATCH 6/7] fix typos in gmp support routines, by Paulo Moura. --- C/gmp_support.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/C/gmp_support.c b/C/gmp_support.c index bb28cd350..8ef03a115 100644 --- a/C/gmp_support.c +++ b/C/gmp_support.c @@ -778,7 +778,7 @@ Yap_gmp_rem_big_int(Term t, Int i2) { CELL *pt = RepAppl(t); if (pt[1] != BIG_INT) { - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2"); + return Yap_ArithError(TYPE_ERROR_INTEGER, t, "rem/2"); } else { MP_INT *b = Yap_BigIntOfTerm(t); MP_INT new; @@ -795,7 +795,7 @@ Yap_gmp_rem_int_big(Int i1, Term t) CACHE_REGS CELL *pt = RepAppl(t); if (pt[1] != BIG_INT) { - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2"); + return Yap_ArithError(TYPE_ERROR_INTEGER, t, "rem/2"); } else { /* integer is much smaller */ return MkIntegerTerm(i1); @@ -829,7 +829,7 @@ Yap_gmp_gcd_int_big(Int i, Term t) CACHE_REGS CELL *pt = RepAppl(t); if (pt[1] != BIG_INT) { - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2"); + return Yap_ArithError(TYPE_ERROR_INTEGER, t, "gcd/2"); } else { /* integer is much smaller */ if (i > 0) { From 749ba13d3dd5cba8b95be9d7c8b9c1b8055e3283 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 23 Oct 2014 00:35:14 +0100 Subject: [PATCH 7/7] fix retractall with numbers, Paulo Moura --- pl/preds.yap | 3 +++ 1 file changed, 3 insertions(+) diff --git a/pl/preds.yap b/pl/preds.yap index 58036a241..3c3c8cb2c 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -675,6 +675,9 @@ retractall(V) :- ; '$retractall_lu'(T,M) ) + ; + \+ callable(T) -> + '$do_error'(type_error(callable,T),retractall(T)) ; '$undefined'(T,M) -> functor(T,Na,Ar),