diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

replace cut_c by trail entries

Browse Source
This commit is contained in:
Vitor Santos Costa 2017-07-30 21:53:07 +01:00
parent 3d191957db
commit dac6dc7c22
35 changed files with 4509 additions and 4587 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
C/agc.c
View File

@ -340,8 +340,8 @@ mark_global_cell(CELL *pt)
Int sz = 3 + Int sz = 3 +
(sizeof(MP_INT)+ (sizeof(MP_INT)+
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL); (((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
Opaque_CallOnGCMark f; YAP_Opaque_CallOnGCMark f;
Opaque_CallOnGCRelocate f2; YAP_Opaque_CallOnGCRelocate f2;
Term t = AbsAppl(pt); Term t = AbsAppl(pt);
if ( (f = Yap_blob_gc_mark_handler(t)) ) { if ( (f = Yap_blob_gc_mark_handler(t)) ) {

291
C/bignum.c
View File

@ -1,19 +1,19 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* * * *
************************************************************************** **************************************************************************
* * * *
* File: arith1.c * * File: arith1.c *
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: bignum support through gmp * * comments: bignum support through gmp *
* * * *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #endif
@ -33,12 +33,10 @@ static char SccsId[] = "%W% %G%";
#include "YapEval.h" #include "YapEval.h"
#include "alloc.h" #include "alloc.h"
Term Term Yap_MkBigIntTerm(MP_INT *big) {
Yap_MkBigIntTerm(MP_INT *big)
{
CACHE_REGS CACHE_REGS
Int nlimbs; Int nlimbs;
MP_INT *dst = (MP_INT *)(HR+2); MP_INT *dst = (MP_INT *)(HR + 2);
CELL *ret = HR; CELL *ret = HR;
Int bytes; Int bytes;
@ -50,38 +48,33 @@ Yap_MkBigIntTerm(MP_INT *big)
// nlimbs = ALIGN_YAPTYPE(bytes,CELL)/CellSize; // nlimbs = ALIGN_YAPTYPE(bytes,CELL)/CellSize;
// this works, but it shouldn't need to do this... // this works, but it shouldn't need to do this...
nlimbs = big->_mp_alloc; nlimbs = big->_mp_alloc;
bytes = nlimbs*sizeof(CELL); bytes = nlimbs * sizeof(CELL);
if (nlimbs > (ASP-ret)-1024) { if (nlimbs > (ASP - ret) - 1024) {
return TermNil; return TermNil;
} }
HR[0] = (CELL)FunctorBigInt; HR[0] = (CELL)FunctorBigInt;
HR[1] = BIG_INT; HR[1] = BIG_INT;
dst->_mp_size = big->_mp_size; dst->_mp_size = big->_mp_size;
dst->_mp_alloc = nlimbs*(CellSize/sizeof(mp_limb_t)); dst->_mp_alloc = nlimbs * (CellSize / sizeof(mp_limb_t));
memmove((void *)(dst+1), (const void *)(big->_mp_d), bytes); memmove((void *)(dst + 1), (const void *)(big->_mp_d), bytes);
HR = (CELL *)(dst+1)+nlimbs; HR = (CELL *)(dst + 1) + nlimbs;
HR[0] = EndSpecials; HR[0] = EndSpecials;
HR++; HR++;
return AbsAppl(ret); return AbsAppl(ret);
} }
MP_INT *Yap_BigIntOfTerm(Term t) {
MP_INT *new = (MP_INT *)(RepAppl(t) + 2);
MP_INT * new->_mp_d = (mp_limb_t *)(new + 1);
Yap_BigIntOfTerm(Term t) return (new);
{
MP_INT *new = (MP_INT *)(RepAppl(t)+2);
new->_mp_d = (mp_limb_t *)(new+1);
return(new);
} }
Term Term Yap_MkBigRatTerm(MP_RAT *big) {
Yap_MkBigRatTerm(MP_RAT *big)
{
CACHE_REGS CACHE_REGS
Int nlimbs; Int nlimbs;
MP_INT *dst = (MP_INT *)(HR+2); MP_INT *dst = (MP_INT *)(HR + 2);
MP_INT *num = mpq_numref(big); MP_INT *num = mpq_numref(big);
MP_INT *den = mpq_denref(big); MP_INT *den = mpq_denref(big);
MP_RAT *rat; MP_RAT *rat;
@ -89,84 +82,76 @@ Yap_MkBigRatTerm(MP_RAT *big)
if (mpz_cmp_si(den, 1) == 0) if (mpz_cmp_si(den, 1) == 0)
return Yap_MkBigIntTerm(num); return Yap_MkBigIntTerm(num);
if ((num->_mp_alloc+den->_mp_alloc)*(sizeof(mp_limb_t)/CellSize) > (ASP-ret)-1024) { if ((num->_mp_alloc + den->_mp_alloc) * (sizeof(mp_limb_t) / CellSize) >
(ASP - ret) - 1024) {
return TermNil; return TermNil;
} }
HR[0] = (CELL)FunctorBigInt; HR[0] = (CELL)FunctorBigInt;
HR[1] = BIG_RATIONAL; HR[1] = BIG_RATIONAL;
dst->_mp_size = 0; dst->_mp_size = 0;
rat = (MP_RAT *)(dst+1); rat = (MP_RAT *)(dst + 1);
rat->_mp_num._mp_size = num->_mp_size; rat->_mp_num._mp_size = num->_mp_size;
rat->_mp_num._mp_alloc = num->_mp_alloc; rat->_mp_num._mp_alloc = num->_mp_alloc;
nlimbs = (num->_mp_alloc)*(sizeof(mp_limb_t)/CellSize); nlimbs = (num->_mp_alloc) * (sizeof(mp_limb_t) / CellSize);
memmove((void *)(rat+1), (const void *)(num->_mp_d), nlimbs*CellSize); memmove((void *)(rat + 1), (const void *)(num->_mp_d), nlimbs * CellSize);
rat->_mp_den._mp_size = den->_mp_size; rat->_mp_den._mp_size = den->_mp_size;
rat->_mp_den._mp_alloc = den->_mp_alloc; rat->_mp_den._mp_alloc = den->_mp_alloc;
HR = (CELL *)(rat+1)+nlimbs; HR = (CELL *)(rat + 1) + nlimbs;
nlimbs = (den->_mp_alloc)*(sizeof(mp_limb_t)/CellSize); nlimbs = (den->_mp_alloc) * (sizeof(mp_limb_t) / CellSize);
memmove((void *)(HR), (const void *)(den->_mp_d), nlimbs*CellSize); memmove((void *)(HR), (const void *)(den->_mp_d), nlimbs * CellSize);
HR += nlimbs; HR += nlimbs;
dst->_mp_alloc = (HR-(CELL *)(dst+1)); dst->_mp_alloc = (HR - (CELL *)(dst + 1));
HR[0] = EndSpecials; HR[0] = EndSpecials;
HR++; HR++;
return AbsAppl(ret); return AbsAppl(ret);
} }
MP_RAT * MP_RAT *Yap_BigRatOfTerm(Term t) {
Yap_BigRatOfTerm(Term t) MP_RAT *new = (MP_RAT *)(RepAppl(t) + 2 + sizeof(MP_INT) / sizeof(CELL));
{
MP_RAT *new = (MP_RAT *)(RepAppl(t)+2+sizeof(MP_INT)/sizeof(CELL));
mp_limb_t *nt; mp_limb_t *nt;
nt = new->_mp_num._mp_d = (mp_limb_t *)(new+1); nt = new->_mp_num._mp_d = (mp_limb_t *)(new + 1);
nt += new->_mp_num._mp_alloc; nt += new->_mp_num._mp_alloc;
new->_mp_den._mp_d = nt; new->_mp_den._mp_d = nt;
return new; return new;
} }
Term Term Yap_RatTermToApplTerm(Term t) {
Yap_RatTermToApplTerm(Term t)
{
Term ts[2]; Term ts[2];
MP_RAT *rat = Yap_BigRatOfTerm(t); MP_RAT *rat = Yap_BigRatOfTerm(t);
ts[0] = Yap_MkBigIntTerm(mpq_numref(rat)); ts[0] = Yap_MkBigIntTerm(mpq_numref(rat));
ts[1] = Yap_MkBigIntTerm(mpq_denref(rat)); ts[1] = Yap_MkBigIntTerm(mpq_denref(rat));
return Yap_MkApplTerm(FunctorRDiv,2,ts); return Yap_MkApplTerm(FunctorRDiv, 2, ts);
} }
#endif #endif
Term Term Yap_AllocExternalDataInStack(CELL tag, size_t bytes, CELL **pt) {
Yap_AllocExternalDataInStack(CELL tag, size_t bytes)
{
CACHE_REGS CACHE_REGS
Int nlimbs; Int nlimbs;
MP_INT *dst = (MP_INT *)(HR+2); MP_INT *dst = (MP_INT *)(HR + 2);
CELL *ret = HR; CELL *ret = HR;
nlimbs = ALIGN_BY_TYPE(bytes,CELL)/CellSize; nlimbs = ALIGN_BY_TYPE(bytes, CELL) / CellSize;
if (nlimbs > (ASP-ret)-1024) { if (nlimbs > (ASP - ret) - 1024) {
return TermNil; return TermNil;
} }
HR[0] = (CELL)FunctorBigInt; HR[0] = (CELL)FunctorBigInt;
HR[1] = tag; HR[1] = tag;
dst->_mp_size = 0; dst->_mp_size = 0;
dst->_mp_alloc = nlimbs; dst->_mp_alloc = nlimbs;
HR = (CELL *)(dst+1)+nlimbs; HR = (CELL *)(dst + 1) + nlimbs;
HR[0] = EndSpecials; HR[0] = EndSpecials;
HR++; HR++;
if (tag != EXTERNAL_BLOB) { *pt = (CELL *)(dst + 1);
TrailTerm(TR) = AbsPair(ret);
TR++;
}
return AbsAppl(ret); return AbsAppl(ret);
} }
int Yap_CleanOpaqueVariable(CELL *pt) int Yap_CleanOpaqueVariable(CELL d) {
{
CELL blob_info, blob_tag; CELL blob_info, blob_tag;
MP_INT *blobp; MP_INT *blobp;
CELL *pt = RepAppl(HeadOfTerm(d));
#ifdef DEBUG #ifdef DEBUG
/* sanity checking */ /* sanity checking */
if (pt[0] != (CELL)FunctorBigInt) { if (pt[0] != (CELL)FunctorBigInt) {
@ -175,23 +160,20 @@ int Yap_CleanOpaqueVariable(CELL *pt)
} }
#endif #endif
blob_tag = pt[1]; blob_tag = pt[1];
if (blob_tag < USER_BLOB_START || if (blob_tag < USER_BLOB_START || blob_tag >= USER_BLOB_END) {
blob_tag >= USER_BLOB_END) { Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt),
Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt), "clean opaque: bad blob with tag " UInt_FORMAT ,blob_tag); "clean opaque: bad blob with tag " UInt_FORMAT, blob_tag);
return FALSE; return FALSE;
} }
blob_info = blob_tag - USER_BLOB_START; blob_info = blob_tag - USER_BLOB_START;
if (!GLOBAL_OpaqueHandlers) if (!GLOBAL_OpaqueHandlers)
return FALSE; return FALSE;
blobp = (MP_INT *)(pt+2);
if (!GLOBAL_OpaqueHandlers[blob_info].fail_handler) if (!GLOBAL_OpaqueHandlers[blob_info].fail_handler)
return TRUE; return true;
return (GLOBAL_OpaqueHandlers[blob_info].fail_handler)((void *)(blobp+1)); return (GLOBAL_OpaqueHandlers[blob_info].fail_handler)(d);
} }
Opaque_CallOnWrite YAP_Opaque_CallOnWrite Yap_blob_write_handler(Term t) {
Yap_blob_write_handler(Term t)
{
CELL blob_info, blob_tag; CELL blob_info, blob_tag;
CELL *pt = RepAppl(t); CELL *pt = RepAppl(t);
@ -203,9 +185,9 @@ Yap_blob_write_handler(Term t)
} }
#endif #endif
blob_tag = pt[1]; blob_tag = pt[1];
if (blob_tag < USER_BLOB_START || if (blob_tag < USER_BLOB_START || blob_tag >= USER_BLOB_END) {
blob_tag >= USER_BLOB_END) { Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt),
Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt), "clean opaque: bad blob with tag " UInt_FORMAT ,blob_tag); "clean opaque: bad blob with tag " UInt_FORMAT, blob_tag);
return FALSE; return FALSE;
} }
blob_info = blob_tag - USER_BLOB_START; blob_info = blob_tag - USER_BLOB_START;
@ -215,9 +197,7 @@ Yap_blob_write_handler(Term t)
return GLOBAL_OpaqueHandlers[blob_info].write_handler; return GLOBAL_OpaqueHandlers[blob_info].write_handler;
} }
Opaque_CallOnGCMark YAP_Opaque_CallOnGCMark Yap_blob_gc_mark_handler(Term t) {
Yap_blob_gc_mark_handler(Term t)
{
CELL blob_info, blob_tag; CELL blob_info, blob_tag;
CELL *pt = RepAppl(t); CELL *pt = RepAppl(t);
@ -229,19 +209,16 @@ Yap_blob_gc_mark_handler(Term t)
} }
#endif #endif
blob_tag = pt[1]; blob_tag = pt[1];
if (blob_tag < USER_BLOB_START || if (blob_tag < USER_BLOB_START || blob_tag >= USER_BLOB_END) {
blob_tag >= USER_BLOB_END) {
return NULL; return NULL;
} }
blob_info = blob_tag - USER_BLOB_START; blob_info = blob_tag - USER_BLOB_START;
if (!GLOBAL_OpaqueHandlers) if (!GLOBAL_OpaqueHandlers)
return NULL; return NULL;
return GLOBAL_OpaqueHandlers[blob_info].gc_mark_handler; return GLOBAL_OpaqueHandlers[blob_info].mark_handler;
} }
Opaque_CallOnGCRelocate YAP_Opaque_CallOnGCRelocate Yap_blob_gc_relocate_handler(Term t) {
Yap_blob_gc_relocate_handler(Term t)
{
CELL blob_info, blob_tag; CELL blob_info, blob_tag;
CELL *pt = RepAppl(t); CELL *pt = RepAppl(t);
@ -253,19 +230,18 @@ Yap_blob_gc_relocate_handler(Term t)
} }
#endif #endif
blob_tag = pt[1]; blob_tag = pt[1];
if (blob_tag < USER_BLOB_START || if (blob_tag < USER_BLOB_START || blob_tag >= USER_BLOB_END) {
blob_tag >= USER_BLOB_END) { Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt),
Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt), "clean opaque: bad blob with tag " UInt_FORMAT ,blob_tag); "clean opaque: bad blob with tag " UInt_FORMAT, blob_tag);
return FALSE; return FALSE;
} }
blob_info = blob_tag - USER_BLOB_START; blob_info = blob_tag - USER_BLOB_START;
if (!GLOBAL_OpaqueHandlers) if (!GLOBAL_OpaqueHandlers)
return NULL; return NULL;
return GLOBAL_OpaqueHandlers[blob_info].gc_relocate_handler; return GLOBAL_OpaqueHandlers[blob_info].relocate_handler;
} }
extern Int Yap_blob_tag(Term t) extern Int Yap_blob_tag(Term t) {
{
CELL *pt = RepAppl(t); CELL *pt = RepAppl(t);
#ifdef DEBUG #ifdef DEBUG
@ -278,9 +254,7 @@ extern Int Yap_blob_tag(Term t)
return pt[1]; return pt[1];
} }
void * void *Yap_blob_info(Term t) {
Yap_blob_info(Term t)
{
MP_INT *blobp; MP_INT *blobp;
CELL *pt = RepAppl(t); CELL *pt = RepAppl(t);
@ -293,27 +267,25 @@ Yap_blob_info(Term t)
#endif #endif
if (!GLOBAL_OpaqueHandlers) if (!GLOBAL_OpaqueHandlers)
return FALSE; return FALSE;
blobp = (MP_INT *)(pt+2); blobp = (MP_INT *)(pt + 2);
return (void *)(blobp+1); return (void *)(blobp + 1);
} }
Term Term Yap_MkULLIntTerm(YAP_ULONG_LONG n) {
Yap_MkULLIntTerm(YAP_ULONG_LONG n)
{
#if __GNUC__ && USE_GMP #if __GNUC__ && USE_GMP
mpz_t new; mpz_t new;
char tmp[256]; char tmp[256];
Term t; Term t;
#ifdef _WIN32 #ifdef _WIN32
snprintf(tmp,256,"%I64u",n); snprintf(tmp, 256, "%I64u", n);
#elif HAVE_SNPRINTF #elif HAVE_SNPRINTF
snprintf(tmp,256,"%llu",n); snprintf(tmp, 256, "%llu", n);
#else #else
sprintf(tmp,"%llu",n); sprintf(tmp, "%llu", n);
#endif #endif
/* try to scan it as a bignum */ /* try to scan it as a bignum */
mpz_init_set_str (new, tmp, 10); mpz_init_set_str(new, tmp, 10);
if (mpz_fits_slong_p(new)) { if (mpz_fits_slong_p(new)) {
CACHE_REGS CACHE_REGS
return MkIntegerTerm(mpz_get_si(new)); return MkIntegerTerm(mpz_get_si(new));
@ -327,54 +299,51 @@ Yap_MkULLIntTerm(YAP_ULONG_LONG n)
#endif #endif
} }
CELL * CELL *Yap_HeapStoreOpaqueTerm(Term t) {
Yap_HeapStoreOpaqueTerm(Term t)
{
CELL *ptr = RepAppl(t); CELL *ptr = RepAppl(t);
size_t sz; size_t sz;
void *new; void *new;
if (ptr[0] == (CELL)FunctorBigInt) { if (ptr[0] == (CELL)FunctorBigInt) {
sz = sizeof(MP_INT)+2*CellSize+ sz = sizeof(MP_INT) + 2 * CellSize +
((MP_INT *)(ptr+2))->_mp_alloc*sizeof(mp_limb_t); ((MP_INT *)(ptr + 2))->_mp_alloc * sizeof(mp_limb_t);
} else { /* string */ } else { /* string */
sz = sizeof(CELL)*(2+ptr[1]); sz = sizeof(CELL) * (2 + ptr[1]);
} }
new = Yap_AllocCodeSpace(sz); new = Yap_AllocCodeSpace(sz);
if (!new) { if (!new) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "subgoal_search_loop: no space for %s", StringOfTerm(t) ); Yap_Error(RESOURCE_ERROR_HEAP, TermNil,
"subgoal_search_loop: no space for %s", StringOfTerm(t));
} else { } else {
if (ptr[0] == (CELL)FunctorBigInt) { if (ptr[0] == (CELL)FunctorBigInt) {
MP_INT *new = (MP_INT *)(RepAppl(t)+2); MP_INT *new = (MP_INT *)(RepAppl(t) + 2);
new->_mp_d = (mp_limb_t *)(new+1); new->_mp_d = (mp_limb_t *)(new + 1);
} }
memmove(new, ptr, sz); memmove(new, ptr, sz);
} }
return new; return new;
} }
size_t Yap_OpaqueTermToString(Term t, char *str, size_t max) {
size_t
Yap_OpaqueTermToString(Term t, char *str, size_t max)
{
size_t str_index = 0; size_t str_index = 0;
CELL * li = RepAppl(t); CELL *li = RepAppl(t);
unsigned char *ptr = (unsigned char *)StringOfTerm(AbsAppl(li)); unsigned char *ptr = (unsigned char *)StringOfTerm(AbsAppl(li));
if (li[0] == (CELL)FunctorString) { if (li[0] == (CELL)FunctorString) {
str_index += sprintf(& str[str_index], "\""); str_index += sprintf(&str[str_index], "\"");
do { do {
utf8proc_int32_t chr; utf8proc_int32_t chr;
ptr += get_utf8(ptr, -1, &chr); ptr += get_utf8(ptr, -1, &chr);
if (chr == '\0') break; if (chr == '\0')
str_index += sprintf(str+str_index, "%C", chr); break;
str_index += sprintf(str + str_index, "%C", chr);
} while (TRUE); } while (TRUE);
str_index += sprintf(str+str_index, "\""); str_index += sprintf(str + str_index, "\"");
} else { } else {
CELL big_tag = li[1]; CELL big_tag = li[1];
if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) { if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) {
str_index += sprintf(& str[str_index], "{...}"); str_index += sprintf(&str[str_index], "{...}");
#ifdef USE_GMP #ifdef USE_GMP
} else if (big_tag == BIG_INT) { } else if (big_tag == BIG_INT) {
MP_INT *big = Yap_BigIntOfTerm(AbsAppl(li)); MP_INT *big = Yap_BigIntOfTerm(AbsAppl(li));
@ -398,52 +367,35 @@ Yap_OpaqueTermToString(Term t, char *str, size_t max)
return; return;
} }
} */ } */
str_index += sprintf(& str[str_index], "0"); str_index += sprintf(&str[str_index], "0");
} }
return str_index; return str_index;
} }
static Int static Int p_is_bignum(USES_REGS1) {
p_is_bignum( USES_REGS1 )
{
#ifdef USE_GMP #ifdef USE_GMP
Term t = Deref(ARG1); Term t = Deref(ARG1);
return( return (IsNonVarTerm(t) && IsApplTerm(t) &&
IsNonVarTerm(t) && FunctorOfTerm(t) == FunctorBigInt && RepAppl(t)[1] == BIG_INT);
IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorBigInt &&
RepAppl(t)[1] == BIG_INT
);
#else #else
return FALSE; return FALSE;
#endif #endif
} }
static Int static Int p_is_string(USES_REGS1) {
p_is_string( USES_REGS1 )
{
Term t = Deref(ARG1); Term t = Deref(ARG1);
return( return (IsNonVarTerm(t) && IsApplTerm(t) &&
IsNonVarTerm(t) && FunctorOfTerm(t) == FunctorString);
IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorString
);
} }
static Int static Int p_nb_set_bit(USES_REGS1) {
p_nb_set_bit( USES_REGS1 )
{
#ifdef USE_GMP #ifdef USE_GMP
Term t = Deref(ARG1); Term t = Deref(ARG1);
Term ti = Deref(ARG2); Term ti = Deref(ARG2);
Int i; Int i;
if (!( if (!(IsNonVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorBigInt &&
IsNonVarTerm(t) && RepAppl(t)[1] == BIG_INT))
IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorBigInt &&
RepAppl(t)[1] == BIG_INT
))
return FALSE; return FALSE;
if (!IsIntegerTerm(ti)) { if (!IsIntegerTerm(ti)) {
return FALSE; return FALSE;
@ -462,9 +414,7 @@ p_nb_set_bit( USES_REGS1 )
#endif #endif
} }
static Int static Int p_has_bignums(USES_REGS1) {
p_has_bignums( USES_REGS1 )
{
#ifdef USE_GMP #ifdef USE_GMP
return TRUE; return TRUE;
#else #else
@ -472,9 +422,7 @@ p_has_bignums( USES_REGS1 )
#endif #endif
} }
static Int static Int p_is_opaque(USES_REGS1) {
p_is_opaque( USES_REGS1 )
{
Term t = Deref(ARG1); Term t = Deref(ARG1);
if (IsVarTerm(t)) if (IsVarTerm(t))
return FALSE; return FALSE;
@ -485,14 +433,12 @@ p_is_opaque( USES_REGS1 )
if (f != FunctorBigInt) if (f != FunctorBigInt)
return FALSE; return FALSE;
pt = RepAppl(t); pt = RepAppl(t);
return ( pt[1] != BIG_RATIONAL || pt[1] != BIG_INT ); return (pt[1] != BIG_RATIONAL || pt[1] != BIG_INT);
} }
return FALSE; return FALSE;
} }
static Int static Int p_is_rational(USES_REGS1) {
p_is_rational( USES_REGS1 )
{
Term t = Deref(ARG1); Term t = Deref(ARG1);
if (IsVarTerm(t)) if (IsVarTerm(t))
return FALSE; return FALSE;
@ -507,14 +453,12 @@ p_is_rational( USES_REGS1 )
if (f != FunctorBigInt) if (f != FunctorBigInt)
return FALSE; return FALSE;
pt = RepAppl(t); pt = RepAppl(t);
return ( pt[1] == BIG_RATIONAL || pt[1] == BIG_INT ); return (pt[1] == BIG_RATIONAL || pt[1] == BIG_INT);
} }
return FALSE; return FALSE;
} }
static Int static Int p_rational(USES_REGS1) {
p_rational( USES_REGS1 )
{
#ifdef USE_GMP #ifdef USE_GMP
Term t = Deref(ARG1); Term t = Deref(ARG1);
Functor f; Functor f;
@ -535,36 +479,31 @@ p_rational( USES_REGS1 )
rat = Yap_BigRatOfTerm(t); rat = Yap_BigRatOfTerm(t);
while ((t1 = Yap_MkBigIntTerm(mpq_numref(rat))) == TermNil || while ((t1 = Yap_MkBigIntTerm(mpq_numref(rat))) == TermNil ||
(t2 = Yap_MkBigIntTerm(mpq_denref(rat))) == TermNil) { (t2 = Yap_MkBigIntTerm(mpq_denref(rat))) == TermNil) {
UInt size = UInt size = (mpq_numref(rat)->_mp_alloc) * (sizeof(mp_limb_t) / CellSize) +
(mpq_numref(rat)->_mp_alloc)*(sizeof(mp_limb_t)/CellSize) + (mpq_denref(rat)->_mp_alloc) * (sizeof(mp_limb_t) / CellSize);
(mpq_denref(rat)->_mp_alloc)*(sizeof(mp_limb_t)/CellSize);
if (!Yap_gcl(size, 3, ENV, P)) { if (!Yap_gcl(size, 3, ENV, P)) {
Yap_Error(RESOURCE_ERROR_STACK, t, LOCAL_ErrorMessage); Yap_Error(RESOURCE_ERROR_STACK, t, LOCAL_ErrorMessage);
return FALSE; return FALSE;
} }
} }
return return Yap_unify(ARG2, t1) && Yap_unify(ARG3, t2);
Yap_unify(ARG2, t1) &&
Yap_unify(ARG3, t2);
#else #else
return FALSE; return FALSE;
#endif #endif
} }
void void Yap_InitBigNums(void) {
Yap_InitBigNums(void)
{
Yap_InitCPred("$has_bignums", 0, p_has_bignums, SafePredFlag); Yap_InitCPred("$has_bignums", 0, p_has_bignums, SafePredFlag);
Yap_InitCPred("$bignum", 1, p_is_bignum, SafePredFlag); Yap_InitCPred("$bignum", 1, p_is_bignum, SafePredFlag);
Yap_InitCPred("rational", 3, p_rational, 0); Yap_InitCPred("rational", 3, p_rational, 0);
Yap_InitCPred("rational", 1, p_is_rational, SafePredFlag); Yap_InitCPred("rational", 1, p_is_rational, SafePredFlag);
/** @pred rational( _T_) /** @pred rational( _T_)
Checks whether `T` is a rational number. Checks whether `T` is a rational number.
*/ */
Yap_InitCPred("string", 1, p_is_string, SafePredFlag); Yap_InitCPred("string", 1, p_is_string, SafePredFlag);
Yap_InitCPred("opaque", 1, p_is_opaque, SafePredFlag); Yap_InitCPred("opaque", 1, p_is_opaque, SafePredFlag);
Yap_InitCPred("nb_set_bit", 2, p_nb_set_bit, SafePredFlag); Yap_InitCPred("nb_set_bit", 2, p_nb_set_bit, SafePredFlag);

25
C/c_interface.c
View File

@ -1865,7 +1865,8 @@ X_API Int YAP_RunGoal(Term t) {
} }
X_API Term YAP_AllocExternalDataInStack(size_t bytes) { X_API Term YAP_AllocExternalDataInStack(size_t bytes) {
Term t = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes); CELL *pt;
Term t = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes, &pt);
if (t == TermNil) if (t == TermNil)
return 0L; return 0L;
return t; return t;
@ -1883,7 +1884,7 @@ X_API YAP_opaque_tag_t YAP_NewOpaqueType(struct YAP_opaque_handler_struct *f) {
int i; int i;
if (!GLOBAL_OpaqueHandlers) { if (!GLOBAL_OpaqueHandlers) {
GLOBAL_OpaqueHandlers = GLOBAL_OpaqueHandlers =
malloc(sizeof(opaque_handler_t) * (USER_BLOB_END - USER_BLOB_START)); malloc(sizeof(YAP_opaque_handler_t) * (USER_BLOB_END - USER_BLOB_START));
if (!GLOBAL_OpaqueHandlers) { if (!GLOBAL_OpaqueHandlers) {
/* no room */ /* no room */
return -1; return -1;
@ -1893,14 +1894,28 @@ X_API YAP_opaque_tag_t YAP_NewOpaqueType(struct YAP_opaque_handler_struct *f) {
return -1; return -1;
} }
i = GLOBAL_OpaqueHandlersCount++; i = GLOBAL_OpaqueHandlersCount++;
memcpy(GLOBAL_OpaqueHandlers + i, f, sizeof(opaque_handler_t)); memcpy(GLOBAL_OpaqueHandlers + i, f, sizeof(YAP_opaque_handler_t));
return i + USER_BLOB_START; return i + USER_BLOB_START;
} }
X_API Term YAP_NewOpaqueObject(YAP_opaque_tag_t tag, size_t bytes) { X_API Term YAP_NewOpaqueObject(YAP_opaque_tag_t blob_tag, size_t bytes) {
Term t = Yap_AllocExternalDataInStack((CELL) tag, bytes); CELL *pt;
Term t = Yap_AllocExternalDataInStack((CELL) blob_tag, bytes, &pt);
if (t == TermNil) if (t == TermNil)
return 0L; return 0L;
blob_tag = pt[1];
if (blob_tag < USER_BLOB_START ||
blob_tag >= USER_BLOB_END) {
Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt), "clean opaque: bad blob with tag " UInt_FORMAT ,blob_tag);
return FALSE;
}
YAP_opaque_tag_t blob_info = blob_tag - USER_BLOB_START;
if (GLOBAL_OpaqueHandlers[blob_info].cut_handler ||
GLOBAL_OpaqueHandlers[blob_info].fail_handler ) {
*HR++ = t;
*HR++ = TermNil;
TrailTerm(TR) = AbsPair(HR-2);
}
return t; return t;
} }

492
C/exec.c
View File

@ -22,7 +22,6 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#include "attvar.h" #include "attvar.h"
#include "cut_c.h" #include "cut_c.h"
#include "yapio.h" #include "yapio.h"
#include "yapio.h"
static bool CallPredicate(PredEntry *, choiceptr, yamop *CACHE_TYPE); static bool CallPredicate(PredEntry *, choiceptr, yamop *CACHE_TYPE);
// must hold thread worker comm lock at call. // must hold thread worker comm lock at call.
@ -215,7 +214,7 @@ static Int save_env_b(USES_REGS1) {
static PredEntry *new_pred(Term t, Term tmod, char *pname) { static PredEntry *new_pred(Term t, Term tmod, char *pname) {
Term t0 = t; Term t0 = t;
restart: restart:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname); Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL; return NULL;
@ -315,7 +314,7 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
/* I cannot use the standard macro here because /* I cannot use the standard macro here because
otherwise I would dereference the argument and otherwise I would dereference the argument and
might skip a svar */ might skip a svar */
if (pen->PredFlags & (MetaPredFlag|UndefPredFlag)) { if (pen->PredFlags & (MetaPredFlag | UndefPredFlag)) {
return CallMetaCall(t, mod PASS_REGS); return CallMetaCall(t, mod PASS_REGS);
} }
pt = RepAppl(t) + 1; pt = RepAppl(t) + 1;
@ -393,7 +392,7 @@ inline static bool do_execute_n(Term t, Term mod, unsigned int n USES_REGS) {
int j = -n; int j = -n;
Term t0 = t; Term t0 = t;
restart_exec: restart_exec:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS); return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS);
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
@ -441,7 +440,7 @@ inline static bool do_execute_n(Term t, Term mod, unsigned int n USES_REGS) {
pen = RepPredProp(PredPropByFunc(f, mod)); pen = RepPredProp(PredPropByFunc(f, mod));
/* You thought we would be over by now */ /* You thought we would be over by now */
/* but no meta calls require special preprocessing */ /* but no meta calls require special preprocessing */
if (pen->PredFlags & (MetaPredFlag|UndefPredFlag)) { if (pen->PredFlags & (MetaPredFlag | UndefPredFlag)) {
Term t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS); Term t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS);
return (CallMetaCall(t, mod PASS_REGS)); return (CallMetaCall(t, mod PASS_REGS));
} }
@ -650,7 +649,7 @@ static Int execute_clause(USES_REGS1) { /* '$execute_clause'(Goal) */
yamop *code; yamop *code;
Term clt = Deref(ARG3); Term clt = Deref(ARG3);
restart_exec: restart_exec:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1"); Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
return FALSE; return FALSE;
@ -712,26 +711,6 @@ static Int execute_in_mod(USES_REGS1) { /* '$execute'(Goal) */
return do_execute(Deref(ARG1), Deref(ARG2) PASS_REGS); return do_execute(Deref(ARG1), Deref(ARG2) PASS_REGS);
} }
typedef enum {
CALLED_FROM_CALL = 0x1,
CALLED_FROM_ANSWER = 0x2,
CALLED_FROM_EXIT = 0x4,
CALLED_FROM_RETRY = 0x8,
CALLED_FROM_FAIL = 0x18,
CALLED_FROM_CUT = 0x20,
CALLED_FROM_EXCEPTION = 0x40,
CALLED_FROM_THROW = 0x80
} execution_port;
INLINE_ONLY inline bool called_from_forward(execution_port port) {
return port & (CALLED_FROM_EXIT | CALLED_FROM_CALL | CALLED_FROM_ANSWER |
CALLED_FROM_CUT | CALLED_FROM_THROW);
}
INLINE_ONLY inline bool called_from_backward(execution_port port) {
return port & (CALLED_FROM_RETRY | CALLED_FROM_FAIL | CALLED_FROM_EXCEPTION);
}
/** /**
* remove choice points created since a call to top-goal. * remove choice points created since a call to top-goal.
* *
@ -762,6 +741,7 @@ static void prune_inner_computation(choiceptr parent) {
CP = oCP; CP = oCP;
ENV = LCL0 - oENV; ENV = LCL0 - oENV;
} }
/** /**
* restore abstract machine state * restore abstract machine state
* after completing a computation. * after completing a computation.
@ -789,160 +769,95 @@ static void complete_inner_computation(choiceptr old_B) {
ENV = myB->cp_env; ENV = myB->cp_env;
} }
static inline Term *GetTermAddress(CELL a) { static Int Yap_ignore(Term t USES_REGS) {
Term *b = NULL; yamop *oP = P, *oCP = CP;
restart: Int oENV = LCL0 - ENV;
if (!IsVarTerm(a)) { Int oYENV = LCL0 - YENV;
return (b); Int oB = LCL0 - (CELL *)B;
} else if (a == (CELL)b) { bool rc = Yap_RunTopGoal(t, false);
return (b);
} else {
b = (CELL *)a;
a = *b;
goto restart;
}
}
/** if (Yap_RaiseException()) {
* call a cleanup routine taking care with the status variable. P = oP;
*/ CP = oCP;
static bool call_cleanup(Term t3, Term t4, Term cleanup, ENV = LCL0 - oENV;
choiceptr B0 USES_REGS) { YENV = LCL0 - oYENV;
CELL *pt = GetTermAddress(t3); B = (choiceptr)(LCL0-oB);
DBTerm *ball = Yap_RefToException();
if (pt == NULL)
return false;
*pt = cleanup;
bool out = Yap_RunTopGoal(t4, true);
if (out) {
prune_inner_computation(B0);
} else {
complete_inner_computation(B0);
}
pt = GetTermAddress(t3);
if (ball)
Yap_CopyException(ball);
if (pt == NULL) {
return false; return false;
} }
RESET_VARIABLE(pt);
if (!rc) {
complete_inner_computation((choiceptr)(LCL0 - oB));
// We'll pass it through
} else {
prune_inner_computation((choiceptr)(LCL0 - oB));
}
P = oP;
CP = oCP;
ENV = LCL0 - oENV;
YENV = LCL0 - oYENV;
B = (choiceptr)(LCL0 - oB);
return true; return true;
} }
/** extern void *Yap_blob_info(Term t);
* What to do when we exit a protected call
* @method exit_set_call
* @param exec_result result of call (0 or 1)
* @param b0 original choicepointer (pointed to by root)
* @param t3 state
* @param b0 user goal to call on port.
*
* @param USES_REGS [description]
* @return [description]
*/
static bool exit_set_call(execution_port exec_result, choiceptr B0, yamop *oCP,
Term t3, Term t4 USES_REGS) {
Term rc;
switch (exec_result) {
// we failed
// Exception: we'll pass it through
case CALLED_FROM_EXCEPTION:
// internal exception
{
Term ball = Yap_PeekException();
Term signal = Yap_MkApplTerm(FunctorException, 1, &ball);
rc = signal;
B = B0;
}
break;
case CALLED_FROM_THROW:
// internal exception
{
Term ball = Yap_PeekException();
Term signal = Yap_MkApplTerm(FunctorException, 1, &ball);
rc = signal;
B = B0;
}
break;
case CALLED_FROM_RETRY:
// external exception
rc = TermRetry;
// internal failure
return true;
break;
case CALLED_FROM_FAIL:
B = B0;
rc = TermFail;
break;
case CALLED_FROM_EXIT:
// deterministic exit
rc = TermExit;
if (B->cp_b == B0) {
CP = B->cp_cp;
ENV = B->cp_env;
ASP = (CELL *)B;
B = B0;
}
break;
case CALLED_FROM_CUT:
if (B->cp_b == B0) {
CP = B->cp_cp;
ENV = B->cp_env;
ASP = (CELL *)B;
B = B0;
}
rc = TermCut;
break;
case CALLED_FROM_CALL:
// cut exit
rc = TermCall;
break;
case CALLED_FROM_ANSWER:
// cut exit
rc = TermAnswer;
// non deterministic
choiceptr saved_b = B;
CELL *pt = ASP;
CUT_C_PUSH(
NEXTOP(NEXTOP(PredProtectStack->cs.p_code.FirstClause, OtapFs), OtapFs),
pt); // this is where things get complicated, we need to
// protect the stack and be able to backtrack
pt -= 4;
pt[3] = t4;
pt[2] = t3;
pt[1] = MkAddressTerm(oCP);
pt[0] = MkIntegerTerm(LCL0 - (CELL *)B0);
B = (choiceptr)pt;
B--;
B->cp_h = HR;
B->cp_tr = TR;
B->cp_cp = oCP;
B->cp_ap = NEXTOP(PredProtectStack->cs.p_code.FirstClause, OtapFs);
B->cp_env = ENV;
B->cp_b = saved_b;
#ifdef DEPTH_LIMIT
B->cp_depth = saved_b->cp_depth;
#endif /* DEPTH_LIMIT */
YENV = ASP = (CELL *)B;
YENV[E_CB] = (CELL)B;
HB = HR;
return true;
}
call_cleanup(t3, t4, rc, B PASS_REGS);
static bool set_watch(Int Bv, Term task) {
CELL *pt;
Term t = Yap_AllocExternalDataInStack((CELL)setup_call_catcher_cleanup_tag,
sizeof(Int), &pt);
if (t == TermNil)
return false;
*pt = Bv;
*HR++ = t;
*HR++ = task;
TrailTerm(TR) = AbsPair(HR - 2);
TR++;
return true; return true;
} }
static Int protect_stack_from_cut(USES_REGS1) { static bool watch_cut(Term ext USES_REGS) {
// called after backtracking.. // called after backtracking..
/* reinitialize the engine */ //
/* the first real choice-point will also have AP=FAIL */ Term task = TailOfTerm(ext);
/* always have an empty slots for people to use */ Term box = ArgOfTerm(1, task);
YENV = ASP = (CELL *)B; Term port = ArgOfTerm(2, task);
call_cleanup(B->cp_a3, B->cp_a4, (P == FAILCODE ? TermException : TermCut), Term cleanup = ArgOfTerm(3, task);
B PASS_REGS); Term cleaned = ArgOfTerm(6, task);
bool first = Deref(ArgOfTerm(5, task)) == MkIntTerm(0);
bool done = first && !IsVarTerm(Deref(ArgOfTerm(4, task)));
bool previous = !IsVarTerm(Deref(ArgOfTerm(6, task)));
if (done || previous)
return true;
while (B->cp_ap->opc == FAIL_OPCODE)
B = B->cp_b;
if (Yap_HasException()) {
Term e = Yap_GetException();
Term t;
if (first) {
t = Yap_MkApplTerm(FunctorException, 1, &e);
} else {
t = Yap_MkApplTerm(FunctorExternalException, 1, &e);
}
if (!Yap_unify(port, t))
return false;
} else {
if (!Yap_unify(port, TermCut))
return false;
}
if (IsVarTerm(cleaned) && box != TermTrue)
{
*VarOfTerm(cleaned) = Deref(port);
}
else
{
return true;
}
Yap_ignore(cleanup);
if (Yap_RaiseException())
return false;
return true; return true;
} }
@ -953,57 +868,68 @@ static Int protect_stack_from_cut(USES_REGS1) {
* @method protect_stack_from_restore * @method protect_stack_from_restore
* @param USES_REGS1 [env for threaded execution] * @param USES_REGS1 [env for threaded execution]
* @return c * @return c
[next answer] */
*/ static bool watch_retry(Term d0 USES_REGS) {
static Int protect_stack_from_retry(USES_REGS1) {
// called after backtracking.. // called after backtracking..
// //
yamop *oP = P; CELL d = ((CELL *)Yap_blob_info(HeadOfTerm(d0)))[0];
Int oENV = LCL0 - ENV;
yamop *oCP = (yamop *)AddressOfTerm(B->cp_a2);
Term t3 = B->cp_a3;
Term t4 = B->cp_a4;
Int b0 = IntegerOfTerm(ARG1);
choiceptr B0 = (choiceptr)(LCL0 - b0);
cut_c_pop(); choiceptr B0 = (choiceptr)(LCL0 - d);
Term task = TailOfTerm(d0);
Term box = ArgOfTerm(1, task);
Term cleanup = ArgOfTerm(3, task);
Term port = ArgOfTerm(2, task);
Term cleaned = ArgOfTerm(6, task);
bool first = Deref(ArgOfTerm(5, task)) == MkIntTerm(0);
bool done = first && !IsVarTerm(Deref(ArgOfTerm(4, task)));
bool previous = !IsVarTerm(Deref(ArgOfTerm(6, task)));
bool ex = false;
// call_cleanup(t3, t4, TermRetry, B0 USES_REGS); if (done || previous)
// binding to t3 should be undone return true;
// by next backtrack.
/* first, destroy the current choice-point, while (B->cp_ap->opc == FAIL_OPCODE)
*/
B = B->cp_b; B = B->cp_b;
// B should lead to CP with _ystop,,
P = FAILCODE;
bool res = Yap_exec_absmi(false, CurrentModule);
/* reinitialize the engine */
/* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */
// ensure that we have slots where we need the
execution_port p;
if (res) {
if (Yap_HasException()) {
p = CALLED_FROM_THROW;
} else if (B->cp_b >= B0) {
p = CALLED_FROM_EXIT;
} else
p = CALLED_FROM_ANSWER;
} else {
if (Yap_HasException()) if (Yap_HasException())
p = CALLED_FROM_EXCEPTION; {
Term e = Yap_GetException();
Term t;
ex = true;
if (first)
{
t = Yap_MkApplTerm(FunctorException, 1, &e);
}
else else
p = CALLED_FROM_FAIL; {
t = Yap_MkApplTerm(FunctorExternalException, 1, &e);
} }
Int rc = exit_set_call(p, B0, oCP, t3, t4 PASS_REGS); if (!Yap_unify(port, t))
if (rc) {
CP = oCP;
P = oP;
ENV = LCL0 - oENV;
}
if (Yap_RaiseException())
return false; return false;
return res; }
else if(B < B0)
{
if (box != TermTrue) {
return true;
}
if (!Yap_unify(port, TermRetry)) {
return false;
}
} else if (first) {
if (!Yap_unify(port, TermFail))
return false;
} else {
return true;
}
if (IsVarTerm(cleaned) && box != TermTrue) {
*VarOfTerm(cleaned) = Deref(port);
} else {
return true;
}
Yap_ignore(cleanup);
if (!ex && Yap_RaiseException())
return false;
return true;
} }
/** /**
@ -1014,24 +940,14 @@ static Int protect_stack_from_retry(USES_REGS1) {
* @param USES_REGS1 [env for threaded execution] * @param USES_REGS1 [env for threaded execution]
* @return [always succeed] * @return [always succeed]
*/ */
static Int protect_stack(USES_REGS1) {
// just create the choice-point;
return true;
}
static Int setup_call_catcher_cleanup(USES_REGS1) { static Int setup_call_catcher_cleanup(USES_REGS1) {
Term Setup = Deref(ARG1); Term Setup = Deref(ARG1);
Int oENV = LCL0 - ENV;
choiceptr B0 = B; choiceptr B0 = B;
Term t3, t4; yamop *oP = P, *oCP = CP;
yhandle_t hl = Yap_StartSlots(); Int oENV = LCL0 - ENV;
yhandle_t h2 = Yap_InitHandle(ARG2); Int oYENV = LCL0 - YENV;
yhandle_t h3 = Yap_InitHandle(t3 = Deref(ARG3));
yhandle_t h4 = Yap_InitHandle(ARG4);
yamop *oCP = CP, *oP = P;
bool rc; bool rc;
execution_port port;
Yap_DisableInterrupts(worker_id); Yap_DisableInterrupts(worker_id);
rc = Yap_RunTopGoal(Setup, false); rc = Yap_RunTopGoal(Setup, false);
@ -1048,46 +964,62 @@ static Int setup_call_catcher_cleanup(USES_REGS1) {
} else { } else {
prune_inner_computation(B0); prune_inner_computation(B0);
} }
// at this point starts actual goal execution....
rc = Yap_RunTopGoal(Yap_GetFromSlot(h2), false);
complete_inner_computation(B);
t4 = Yap_GetFromSlot(h4);
t3 = Yap_GetFromSlot(h3);
// make sure that t3 point to our nice cell.
Yap_CloseSlots(hl);
if (rc) {
// ignore empty choice
while (B->cp_ap->opc == FAIL_OPCODE)
B = B->cp_b;
if (Yap_HasException()) {
port = CALLED_FROM_THROW;
} else if (B->cp_b < B0) {
port = CALLED_FROM_ANSWER;
} else {
port = CALLED_FROM_EXIT;
}
} else {
if (Yap_HasException())
port = CALLED_FROM_EXCEPTION;
else
port = CALLED_FROM_FAIL;
}
// store the correct CP, ENV can be recovered from last env.
bool e = exit_set_call(port, B0, oCP, t3, t4 PASS_REGS);
// ensure we have same P
// also, we cannot trust recovered ENV and CP
if (e) {
P = oP; P = oP;
CP = oCP; CP = oCP;
ENV = LCL0 - oENV; ENV = LCL0 - oENV;
} YENV = LCL0 - oYENV;
if (Yap_RaiseException()) {
return false;
}
return rc; return rc;
} }
static Int tag_cleanup(USES_REGS1)
{
Int iB = LCL0 - (CELL *)B;
set_watch(iB, Deref(ARG2));
return Yap_unify(ARG1, MkIntegerTerm(iB));
}
static Int cleanup_on_exit(USES_REGS1)
{
choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(Deref(ARG1)));
Term task = Deref(ARG2);
Term box = ArgOfTerm(1, task);
Term cleanup = ArgOfTerm(3, task);
Term catcher = ArgOfTerm(2, task);
Term tag = ArgOfTerm(4, task);
Term cleaned = ArgOfTerm(6, task);
while (B->cp_ap->opc == FAIL_OPCODE)
B = B->cp_b;
if (B < B0)
{
// non-deterministic
set_watch(LCL0 - (CELL *)B, task);
if (box == TermTrue)
{
if (!Yap_unify(catcher, TermAnswer))
return false;
B->cp_tr++;
Yap_ignore(cleanup);
B->cp_tr--;
}
return true;
}
if (!Yap_unify(catcher, TermExit))
return false;
if (IsVarTerm(tag))
*VarOfTerm(tag) = TermTrue;
if (IsVarTerm(cleaned) && box != TermTrue)
{
*VarOfTerm(cleaned) = TermExit;
}
else
{
return true;
}
Yap_ignore(cleanup);
return true;
}
static bool complete_ge(bool out, Term omod, yhandle_t sl, bool creeping) { static bool complete_ge(bool out, Term omod, yhandle_t sl, bool creeping) {
CACHE_REGS CACHE_REGS
if (creeping) { if (creeping) {
@ -1201,7 +1133,7 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
return EnterCreepMode(t, mod PASS_REGS); return EnterCreepMode(t, mod PASS_REGS);
} }
t = Yap_YapStripModule(t, &mod); t = Yap_YapStripModule(t, &mod);
restart_exec: restart_exec:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1"); Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
return false; return false;
@ -1477,7 +1409,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
case 5: case 5:
// going up, unless there is no up to go to. or someone // going up, unless there is no up to go to. or someone
// but we should inform the caller on what happened. // but we should inform the caller on what happened.
if (B && B->cp_b && B->cp_b <= (choiceptr)(LCL0-LOCAL_CBorder)) { if (B && B->cp_b && B->cp_b <= (choiceptr)(LCL0 - LOCAL_CBorder)) {
break; break;
} }
LOCAL_RestartEnv = sighold; LOCAL_RestartEnv = sighold;
@ -1599,7 +1531,7 @@ void Yap_fail_all(choiceptr bb USES_REGS) {
DEPTH = B->cp_depth; DEPTH = B->cp_depth;
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
YENV = ENV = B->cp_env; YENV = ENV = B->cp_env;
/* recover local stack */ /* recover local stack */
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
DEPTH = ENV[E_DEPTH]; DEPTH = ENV[E_DEPTH];
#endif #endif
@ -1812,7 +1744,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
HR[1] = MkAtomTerm(Yap_LookupAtom("top")); HR[1] = MkAtomTerm(Yap_LookupAtom("top"));
arity = 2; arity = 2;
HR += 2; HR += 2;
} else if (ppe->PredFlags & (MetaPredFlag|UndefPredFlag)) { } else if (ppe->PredFlags & (MetaPredFlag | UndefPredFlag)) {
// we're in a meta-call, rake care about modules // we're in a meta-call, rake care about modules
// //
Term ts[2]; Term ts[2];
@ -2038,11 +1970,8 @@ static Int JumpToEnv() {
/* find the first choicepoint that may be a catch */ /* find the first choicepoint that may be a catch */
// DBTerm *dbt = Yap_RefToException(); // DBTerm *dbt = Yap_RefToException();
while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch) { while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch) {
//printf("--handler=%p, max=%p\n", handler, LCL0-LOCAL_CBorder); // printf("--handler=%p, max=%p\n", handler, LCL0-LOCAL_CBorder);
while (POP_CHOICE_POINT(handler)) { if (handler == (choiceptr)(LCL0 - LOCAL_CBorder)) {
POP_FAIL_EXECUTE(handler);
}
if (handler == (choiceptr)(LCL0-LOCAL_CBorder)) {
break; break;
} }
/* we are already doing a catch */ /* we are already doing a catch */
@ -2058,6 +1987,7 @@ static Int JumpToEnv() {
} }
POP_FAIL(handler); POP_FAIL(handler);
B = handler; B = handler;
// Yap_CopyException(ref); // Yap_CopyException(ref);
if (Yap_PredForChoicePt(B, NULL) == PredDollarCatch) { if (Yap_PredForChoicePt(B, NULL) == PredDollarCatch) {
/* can recover Heap thanks to copy term :-( */ /* can recover Heap thanks to copy term :-( */
@ -2077,10 +2007,9 @@ static Int JumpToEnv() {
} else if (IsVarTerm(t)) { } else if (IsVarTerm(t)) {
t = Yap_MkApplTerm(FunctorGVar, 1, &t); t = Yap_MkApplTerm(FunctorGVar, 1, &t);
} }
B->cp_h = HR;
HB = HR;
Yap_unify(t, B->cp_a2); Yap_unify(t, B->cp_a2);
B->cp_tr = TR; B->cp_h = HR;
TR--;
} }
P = FAILCODE; P = FAILCODE;
return true; return true;
@ -2138,9 +2067,9 @@ static Int generate_pred_info(USES_REGS1) {
void Yap_InitYaamRegs(int myworker_id) { void Yap_InitYaamRegs(int myworker_id) {
Term h0var; Term h0var;
// getchar(); // getchar();
#if PUSH_REGS #if PUSH_REGS
/* Guarantee that after a longjmp we go back to the original abstract /* Guarantee that after a longjmp we go back to the original abstract
machine registers */ machine registers */
#ifdef THREADS #ifdef THREADS
if (myworker_id) { if (myworker_id) {
@ -2148,7 +2077,7 @@ void Yap_InitYaamRegs(int myworker_id) {
pthread_setspecific(Yap_yaamregs_key, (const void *)rs); pthread_setspecific(Yap_yaamregs_key, (const void *)rs);
REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs; REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs;
} }
/* may be run by worker_id on behalf on myworker_id */ /* may be run by worker_id on behalf on myworker_id */
#else #else
Yap_regp = &Yap_standard_regs; Yap_regp = &Yap_standard_regs;
#endif #endif
@ -2186,8 +2115,8 @@ void Yap_InitYaamRegs(int myworker_id) {
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
/* the first real choice-point will also have AP=FAIL */ /* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */ /* always have an empty slots for people to use */
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
LOCAL = REMOTE(myworker_id); LOCAL = REMOTE(myworker_id);
worker_id = myworker_id; worker_id = myworker_id;
@ -2296,6 +2225,12 @@ int Yap_dogc(int extra_args, Term *tp USES_REGS) {
void Yap_InitExecFs(void) { void Yap_InitExecFs(void) {
CACHE_REGS CACHE_REGS
YAP_opaque_handler_t catcher_ops;
memset(&catcher_ops, 0, sizeof(catcher_ops));
catcher_ops.cut_handler = watch_cut;
catcher_ops.fail_handler = watch_retry;
setup_call_catcher_cleanup_tag = YAP_NewOpaqueType(&catcher_ops);
Term cm = CurrentModule; Term cm = CurrentModule;
Yap_InitComma(); Yap_InitComma();
Yap_InitCPred("$execute", 1, execute, 0); Yap_InitCPred("$execute", 1, execute, 0);
@ -2350,7 +2285,8 @@ void Yap_InitExecFs(void) {
Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0); Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0);
Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0); Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0);
Yap_InitCPred("$get_exception", 1, get_exception, 0); Yap_InitCPred("$get_exception", 1, get_exception, 0);
Yap_InitCPred("setup_call_catcher_cleanup", 4, setup_call_catcher_cleanup, 0); Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup,
Yap_InitCPredBackCut("$protect_stack", 4, 0, protect_stack, 0);
protect_stack_from_retry, protect_stack_from_cut, 0); Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, 0);
Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0);
} }

184
C/fail_absmi_insts.h
View File

@ -4,8 +4,6 @@
#ifdef INDENT_CODE #ifdef INDENT_CODE
{ {
{
{
#endif /* INDENT_CODE */ #endif /* INDENT_CODE */
/* trust_fail */ /* trust_fail */
@ -30,7 +28,7 @@
ENDBOp(); ENDBOp();
#ifdef YAPOR #ifdef YAPOR
shared_fail: shared_fail:
B = Get_LOCAL_top_cp(); B = Get_LOCAL_top_cp();
SET_BB(PROTECT_FROZEN_B(B)); SET_BB(PROTECT_FROZEN_B(B));
goto fail; goto fail;
@ -39,7 +37,8 @@
/* fail */ /* fail */
PBOp(op_fail, e); PBOp(op_fail, e);
if (PP) { if (PP)
{
UNLOCK(PP->PELock); UNLOCK(PP->PELock);
PP = NULL; PP = NULL;
} }
@ -49,11 +48,12 @@
ENDCACHE_Y_AS_ENV(); ENDCACHE_Y_AS_ENV();
#endif #endif
fail: fail:
{ {
register tr_fr_ptr pt0 = TR; register tr_fr_ptr pt0 = TR;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (PP) { if (PP)
{
UNLOCK(PP->PELock); UNLOCK(PP->PELock);
PP = NULL; PP = NULL;
} }
@ -62,19 +62,23 @@
save_pc(); save_pc();
CACHE_TR(B->cp_tr); CACHE_TR(B->cp_tr);
PREFETCH_OP(PREG); PREFETCH_OP(PREG);
failloop: failloop:
if (pt0 == S_TR) { if (pt0 == S_TR)
{
SP = SP0; SP = SP0;
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) { if (Yap_do_low_level_trace)
{
int go_on = true; int go_on = true;
yamop *ipc = PREG; yamop *ipc = PREG;
while (go_on) { while (go_on)
{
op_numbers opnum = Yap_op_from_opcode(ipc->opc); op_numbers opnum = Yap_op_from_opcode(ipc->opc);
go_on = false; go_on = false;
switch (opnum) { switch (opnum)
{
#ifdef TABLING #ifdef TABLING
case _table_load_answer: case _table_load_answer:
low_level_trace(retry_table_loader, LOAD_CP(B)->cp_pred_entry, NULL); low_level_trace(retry_table_loader, LOAD_CP(B)->cp_pred_entry, NULL);
@ -138,7 +142,7 @@
case _retry2: case _retry2:
case _retry3: case _retry3:
case _retry4: case _retry4:
ipc = NEXTOP(ipc,l); ipc = NEXTOP(ipc, l);
go_on = true; go_on = true;
break; break;
case _jump: case _jump:
@ -151,7 +155,7 @@
break; break;
case _retry_profiled: case _retry_profiled:
case _count_retry: case _count_retry:
ipc = NEXTOP(ipc,p); ipc = NEXTOP(ipc, p);
go_on = true; go_on = true;
break; break;
case _retry_me: case _retry_me:
@ -187,35 +191,39 @@
#endif /* LOW_LEVEL_TRACER */ #endif /* LOW_LEVEL_TRACER */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
if (pt0 < TR_FZ || pt0 > (ADDR)CurrentTrailTop+MinTrailGap) if (pt0 < TR_FZ || pt0 > (ADDR)CurrentTrailTop + MinTrailGap)
#else #else
if (pt0 < TR_FZ) if (pt0 < TR_FZ)
#endif /* YAPOR_SBA */ #endif /* YAPOR_SBA */
{ {
TR = TR_FZ; TR = TR_FZ;
TRAIL_LINK(pt0); TRAIL_LINK(pt0);
} else }
else
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
RESTORE_TR(); RESTORE_TR();
GONext(); GONext();
} }
BEGD(d1); BEGD(d1);
d1 = TrailTerm(pt0-1); d1 = TrailTerm(pt0 - 1);
pt0--; pt0--;
if (IsVarTerm(d1)) { if (IsVarTerm(d1))
{
#if defined(YAPOR_SBA) && defined(YAPOR) #if defined(YAPOR_SBA) && defined(YAPOR)
/* clean up the trail when we backtrack */ /* clean up the trail when we backtrack */
if (Unsigned((Int)(d1)-(Int)(H_FZ)) > if (Unsigned((Int)(d1) - (Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) { Unsigned((Int)(B_FZ) - (Int)(H_FZ)))
{
RESET_VARIABLE(STACK_TO_SBA(d1)); RESET_VARIABLE(STACK_TO_SBA(d1));
} else }
else
#endif #endif
/* normal variable */ /* normal variable */
RESET_VARIABLE(d1); RESET_VARIABLE(d1);
goto failloop; goto failloop;
} }
/* pointer to code space */ /* pointer to code space */
/* or updatable variable */ /* or updatable variable */
#if defined(TERM_EXTENSIONS) || defined(FROZEN_STACKS) || defined(MULTI_ASSIGNMENT_VARIABLES) #if defined(TERM_EXTENSIONS) || defined(FROZEN_STACKS) || defined(MULTI_ASSIGNMENT_VARIABLES)
if (IsPairTerm(d1)) if (IsPairTerm(d1))
#endif /* TERM_EXTENSIONS || FROZEN_STACKS || MULTI_ASSIGNMENT_VARIABLES */ #endif /* TERM_EXTENSIONS || FROZEN_STACKS || MULTI_ASSIGNMENT_VARIABLES */
@ -223,8 +231,9 @@
register CELL flags; register CELL flags;
CELL *pt1 = RepPair(d1); CELL *pt1 = RepPair(d1);
#ifdef LIMIT_TABLING #ifdef LIMIT_TABLING
if ((ADDR) pt1 == LOCAL_TrailBase) { if ((ADDR)pt1 == LOCAL_TrailBase)
sg_fr_ptr sg_fr = (sg_fr_ptr) TrailVal(pt0); {
sg_fr_ptr sg_fr = (sg_fr_ptr)TrailVal(pt0);
TrailTerm(pt0) = AbsPair((CELL *)(pt0 - 1)); TrailTerm(pt0) = AbsPair((CELL *)(pt0 - 1));
SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */ SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */
insert_into_global_sg_fr_list(sg_fr); insert_into_global_sg_fr_list(sg_fr);
@ -235,23 +244,29 @@
/* avoid frozen segments */ /* avoid frozen segments */
if ( if (
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
(ADDR) pt1 >= HeapTop (ADDR)pt1 >= HeapTop
#else #else
IN_BETWEEN(LOCAL_TrailBase, pt1, (ADDR)CurrentTrailTop+MinTrailGap) IN_BETWEEN(LOCAL_TrailBase, pt1, (ADDR)CurrentTrailTop + MinTrailGap)
#endif /* YAPOR_SBA */ #endif /* YAPOR_SBA */
) )
{ {
pt0 = (tr_fr_ptr) pt1; pt0 = (tr_fr_ptr)pt1;
goto failloop; goto failloop;
} else }
else
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
if (IN_BETWEEN(H0,pt1,HR)) { if (IN_BETWEEN(H0, pt1, HR))
if (IsAttVar(pt1)) { {
goto failloop; if (IsAttVar(pt1))
} else if (*pt1 == (CELL)FunctorBigInt) { {
Yap_CleanOpaqueVariable(pt1);
goto failloop; goto failloop;
} }
else
{
TR = pt0;
Yap_CleanOpaqueVariable(d1);
goto fail;
}
} }
#ifdef FROZEN_STACKS /* TRAIL */ #ifdef FROZEN_STACKS /* TRAIL */
/* don't reset frozen variables */ /* don't reset frozen variables */
@ -260,7 +275,8 @@
#endif #endif
flags = *pt1; flags = *pt1;
#if MULTIPLE_STACKS #if MULTIPLE_STACKS
if (FlagOn(DBClMask, flags)) { if (FlagOn(DBClMask, flags))
{
DBRef dbr = DBStructFlagsToDBStruct(pt1); DBRef dbr = DBStructFlagsToDBStruct(pt1);
int erase; int erase;
@ -268,31 +284,39 @@
DEC_DBREF_COUNT(dbr); DEC_DBREF_COUNT(dbr);
erase = (dbr->Flags & ErasedMask) && (dbr->ref_count == 0); erase = (dbr->Flags & ErasedMask) && (dbr->ref_count == 0);
UNLOCK(dbr->lock); UNLOCK(dbr->lock);
if (erase) { if (erase)
{
saveregs(); saveregs();
Yap_ErDBE(dbr); Yap_ErDBE(dbr);
setregs(); setregs();
} }
} else { }
if (flags & LogUpdMask) { else
if (flags & IndexMask) { {
if (flags & LogUpdMask)
{
if (flags & IndexMask)
{
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt1); LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt1);
int erase; int erase;
#if PARALLEL_YAP #if PARALLEL_YAP
PredEntry *ap = cl->ClPred; PredEntry *ap = cl->ClPred;
#endif #endif
PELOCK(8,ap); PELOCK(8, ap);
DEC_CLREF_COUNT(cl); DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount); erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
if (erase) { if (erase)
{
saveregs(); saveregs();
/* at this point, /* at this point,
we are the only ones accessing the clause, we are the only ones accessing the clause,
hence we don't need to have a lock it */ hence we don't need to have a lock it */
Yap_ErLogUpdIndex(cl); Yap_ErLogUpdIndex(cl);
setregs(); setregs();
} else if (cl->ClFlags & DirtyMask) { }
else if (cl->ClFlags & DirtyMask)
{
saveregs(); saveregs();
/* at this point, /* at this point,
we are the only ones accessing the clause, we are the only ones accessing the clause,
@ -301,19 +325,23 @@
setregs(); setregs();
} }
UNLOCK(ap->PELock); UNLOCK(ap->PELock);
} else { }
else
{
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1); LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
int erase; int erase;
#if PARALLEL_YAP #if PARALLEL_YAP
PredEntry *ap = cl->ClPred; PredEntry *ap = cl->ClPred;
#endif #endif
/* BB support */ /* BB support */
if (ap) { if (ap)
{
PELOCK(9,ap); PELOCK(9, ap);
DEC_CLREF_COUNT(cl); DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount); erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
if (erase) { if (erase)
{
saveregs(); saveregs();
/* at this point, /* at this point,
we are the only ones accessing the clause, we are the only ones accessing the clause,
@ -324,7 +352,9 @@
UNLOCK(ap->PELock); UNLOCK(ap->PELock);
} }
} }
} else { }
else
{
DynamicClause *cl = ClauseFlagsToDynamicClause(pt1); DynamicClause *cl = ClauseFlagsToDynamicClause(pt1);
int erase; int erase;
@ -332,7 +362,8 @@
DEC_CLREF_COUNT(cl); DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount); erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
UNLOCK(cl->ClLock); UNLOCK(cl->ClLock);
if (erase) { if (erase)
{
saveregs(); saveregs();
/* at this point, /* at this point,
we are the only ones accessing the clause, we are the only ones accessing the clause,
@ -345,24 +376,37 @@
#else #else
ResetFlag(InUseMask, flags); ResetFlag(InUseMask, flags);
*pt1 = flags; *pt1 = flags;
if (FlagOn((ErasedMask|DirtyMask), flags)) { if (FlagOn((ErasedMask | DirtyMask), flags))
if (FlagOn(DBClMask, flags)) { {
if (FlagOn(DBClMask, flags))
{
saveregs(); saveregs();
Yap_ErDBE(DBStructFlagsToDBStruct(pt1)); Yap_ErDBE(DBStructFlagsToDBStruct(pt1));
setregs(); setregs();
} else { }
else
{
saveregs(); saveregs();
if (flags & LogUpdMask) { if (flags & LogUpdMask)
if (flags & IndexMask) { {
if (FlagOn(ErasedMask, flags)) { if (flags & IndexMask)
{
if (FlagOn(ErasedMask, flags))
{
Yap_ErLogUpdIndex(ClauseFlagsToLogUpdIndex(pt1)); Yap_ErLogUpdIndex(ClauseFlagsToLogUpdIndex(pt1));
} else { }
else
{
Yap_CleanUpIndex(ClauseFlagsToLogUpdIndex(pt1)); Yap_CleanUpIndex(ClauseFlagsToLogUpdIndex(pt1));
} }
} else { }
else
{
Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(pt1)); Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(pt1));
} }
} else { }
else
{
Yap_ErCl(ClauseFlagsToDynamicClause(pt1)); Yap_ErCl(ClauseFlagsToDynamicClause(pt1));
} }
setregs(); setregs();
@ -372,16 +416,17 @@
goto failloop; goto failloop;
} }
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
else /* if (IsApplTerm(d1)) */ { else /* if (IsApplTerm(d1)) */
{
CELL *pt = RepAppl(d1); CELL *pt = RepAppl(d1);
/* AbsAppl means */ /* AbsAppl means */
/* multi-assignment variable */ /* multi-assignment variable */
/* so the next cell is the old value */ /* so the next cell is the old value */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
--pt0; --pt0;
pt[0] = TrailVal(pt0); pt[0] = TrailVal(pt0);
#else #else
pt[0] = TrailTerm(pt0-1); pt[0] = TrailTerm(pt0 - 1);
pt0 -= 2; pt0 -= 2;
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
goto failloop; goto failloop;
@ -389,26 +434,27 @@
#endif #endif
ENDD(d1); ENDD(d1);
ENDCACHE_TR(); ENDCACHE_TR();
} }
#ifdef COROUTINING #ifdef COROUTINING
NoStackFail: NoStackFail:
BEGD(d0); BEGD(d0);
#ifdef SHADOW_S #ifdef SHADOW_S
Yap_REGS.S_ = SREG; Yap_REGS.S_ = SREG;
#endif #endif
saveregs(); saveregs();
d0 = interrupt_fail( PASS_REGS1 ); d0 = interrupt_fail(PASS_REGS1);
setregs(); setregs();
#ifdef SHADOW_S #ifdef SHADOW_S
SREG = Yap_REGS.S_; SREG = Yap_REGS.S_;
#endif #endif
if (!d0) FAIL(); if (!d0)
FAIL();
JMPNext(); JMPNext();
ENDD(d0); ENDD(d0);
#endif /* COROUTINING */ #endif /* COROUTINING */
ENDPBOp(); ENDPBOp();
#ifdef INDENT_CODE
}
#endif /* INDENT_CODE */

4
C/grow.c
View File

@ -586,8 +586,8 @@ AdjustGlobal(Int sz, bool thread_copying USES_REGS)
(sizeof(MP_INT)+ (sizeof(MP_INT)+
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/CellSize; (((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/CellSize;
//printf("sz *%ld* at @%ld@\n", sz, pt-H0); //printf("sz *%ld* at @%ld@\n", sz, pt-H0);
Opaque_CallOnGCMark f; YAP_Opaque_CallOnGCMark f;
Opaque_CallOnGCRelocate f2; YAP_Opaque_CallOnGCRelocate f2;
Term t = AbsAppl(pt); Term t = AbsAppl(pt);
if ( (f = Yap_blob_gc_mark_handler(t)) ) { if ( (f = Yap_blob_gc_mark_handler(t)) ) {

41
C/heapgc.c
View File

@ -514,7 +514,7 @@ pop_registers(Int num_regs, yamop *nextop USES_REGS)
/* pop info on opaque variables */ /* pop info on opaque variables */
while (LOCAL_extra_gc_cells > LOCAL_extra_gc_cells_base) { while (LOCAL_extra_gc_cells > LOCAL_extra_gc_cells_base) {
Opaque_CallOnGCRelocate f; YAP_Opaque_CallOnGCRelocate f;
CELL *ptr = LOCAL_extra_gc_cells-1; CELL *ptr = LOCAL_extra_gc_cells-1;
size_t n = ptr[0], t = ptr[-1]; size_t n = ptr[0], t = ptr[-1];
@ -1436,16 +1436,17 @@ mark_variable(CELL_PTR current USES_REGS)
MARK(next+sz); MARK(next+sz);
} }
POP_CONTINUATION(); POP_CONTINUATION();
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt: {
{ YAP_Opaque_CallOnGCMark f;
Opaque_CallOnGCMark f;
Term t = AbsAppl(next); Term t = AbsAppl(next);
UInt sz = (sizeof(MP_INT)+CellSize+ UInt sz = (sizeof(MP_INT) + CellSize +
((MP_INT *)(next+2))->_mp_alloc*sizeof(mp_limb_t))/CellSize; ((MP_INT *)(next + 2))->_mp_alloc * sizeof(mp_limb_t)) /
CellSize;
MARK(next); MARK(next);
if ( (f = Yap_blob_gc_mark_handler(t)) ) { if ((f = Yap_blob_gc_mark_handler(t))) {
Int n = (f)(Yap_BlobTag(t), Yap_BlobInfo(t), LOCAL_extra_gc_cells, LOCAL_extra_gc_cells_top - (LOCAL_extra_gc_cells+2)); Int n = (f)(Yap_BlobTag(t), Yap_BlobInfo(t), LOCAL_extra_gc_cells,
LOCAL_extra_gc_cells_top - (LOCAL_extra_gc_cells + 2));
if (n < 0) { if (n < 0) {
/* error: we don't have enough room */ /* error: we don't have enough room */
/* could not find more trail */ /* could not find more trail */
@ -1454,23 +1455,23 @@ mark_variable(CELL_PTR current USES_REGS)
} else if (n > 0) { } else if (n > 0) {
CELL *ptr = LOCAL_extra_gc_cells; CELL *ptr = LOCAL_extra_gc_cells;
LOCAL_extra_gc_cells += n+2; LOCAL_extra_gc_cells += n + 2;
PUSH_CONTINUATION(ptr, n+1 PASS_REGS); PUSH_CONTINUATION(ptr, n + 1 PASS_REGS);
ptr += n; ptr += n;
ptr[0] = t; ptr[0] = t;
ptr[1] = n+1; ptr[1] = n + 1;
} }
} }
/* size is given by functor + friends */ /* size is given by functor + friends */
if (next < LOCAL_HGEN) { if (next < LOCAL_HGEN) {
LOCAL_total_oldies += 2+sz; LOCAL_total_oldies += 2 + sz;
} else { } else {
DEBUG_printf0("%p 1\n", next); DEBUG_printf0("%p 1\n", next);
DEBUG_printf1("%p %ld\n", next, (long int)(sz+2)); DEBUG_printf1("%p %ld\n", next, (long int)(sz + 2));
} }
//fprintf(stderr,"%p M %d\n", next,2+sz); // fprintf(stderr,"%p M %d\n", next,2+sz);
LOCAL_total_marked += 2+sz; LOCAL_total_marked += 2 + sz;
PUSH_POINTER(next PASS_REGS); PUSH_POINTER(next PASS_REGS);
sz++; sz++;
#if DEBUG #if DEBUG
@ -1811,15 +1812,9 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
TrailTerm(trail_base) = (CELL)cptr; TrailTerm(trail_base) = (CELL)cptr;
mark_external_reference(&TrailTerm(trail_base) PASS_REGS); mark_external_reference(&TrailTerm(trail_base) PASS_REGS);
TrailTerm(trail_base) = trail_cell; TrailTerm(trail_base) = trail_cell;
} else if (*cptr == (CELL)FunctorBigInt) { } else {
TrailTerm(trail_base) = AbsAppl(cptr);
mark_external_reference(&TrailTerm(trail_base) PASS_REGS); mark_external_reference(&TrailTerm(trail_base) PASS_REGS);
TrailTerm(trail_base) = trail_cell;
} }
#ifdef DEBUG
else
fprintf(stderr,"OOPS in GC: weird trail entry at %p:" UInt_FORMAT "\n", &TrailTerm(trail_base), (CELL)cptr);
#endif
} }
} }
#if MULTI_ASSIGNMENT_VARIABLES #if MULTI_ASSIGNMENT_VARIABLES
@ -2655,7 +2650,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS)
if (HEAP_PTR(TrailTerm(dest))) { if (HEAP_PTR(TrailTerm(dest))) {
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell) PASS_REGS); into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell) PASS_REGS);
} }
} else if (*pt0 == (CELL)FunctorBigInt) { } else {
TrailTerm(dest) = trail_cell; TrailTerm(dest) = trail_cell;
/* be careful with partial gc */ /* be careful with partial gc */
if (HEAP_PTR(TrailTerm(dest))) { if (HEAP_PTR(TrailTerm(dest))) {

3
C/stack.c
View File

@ -1155,8 +1155,9 @@ bool Yap_find_prolog_culprit(USES_REGS1) {
while (curCP != YESCODE) { while (curCP != YESCODE) {
curENV = (CELL *)(curENV[E_E]); curENV = (CELL *)(curENV[E_E]);
if (curENV < ASP || curENV >= LCL0) if (curENV < ASP || curENV >= LCL0) {
break; break;
}
pe = EnvPreg(curCP); pe = EnvPreg(curCP);
if (pe==NULL) { if (pe==NULL) {
pe = PredMetaCall; pe = PredMetaCall;

2
C/write.c
View File

@ -271,7 +271,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg,
return; return;
#endif #endif
} else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) { } else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
Opaque_CallOnWrite f; YAP_Opaque_CallOnWrite f;
CELL blob_info; CELL blob_info;
blob_info = big_tag - USER_BLOB_START; blob_info = big_tag - USER_BLOB_START;

2
H/ATOMS
View File

@ -134,6 +134,7 @@ A Eq N "="
A Error N "error" A Error N "error"
A Exception N "exception" A Exception N "exception"
A Extensions N "extensions" A Extensions N "extensions"
A ExternalException N "external_exception"
A Evaluable N "evaluable" A Evaluable N "evaluable"
A EvaluationError N "evaluation_error" A EvaluationError N "evaluation_error"
A Executable N "executable" A Executable N "executable"
@ -510,6 +511,7 @@ F ExecuteInMod ExecuteInMod 2
F ExecuteWithin ExecuteWithin 1 F ExecuteWithin ExecuteWithin 1
F ExistenceError ExistenceError 2 F ExistenceError ExistenceError 2
F ExoClause ExoClause 2 F ExoClause ExoClause 2
F ExternalException ExternalException 1
F Functor Functor 3 F Functor Functor 3
F GAtom Atom 1 F GAtom Atom 1
F GAtomic Atomic 1 F GAtomic Atomic 1

2
H/GLOBALS
View File

@ -116,7 +116,7 @@ char Executable[YAP_FILENAME_MAX] void
#endif #endif
int OpaqueHandlersCount =0 int OpaqueHandlersCount =0
struct opaque_handler_struct* OpaqueHandlers =NULL struct YAP_opaque_handler_struct* OpaqueHandlers =NULL
#if __simplescalar__ #if __simplescalar__
char pwd[YAP_FILENAME_MAX] void char pwd[YAP_FILENAME_MAX] void

3
H/HEAPFIELDS
View File

@ -307,6 +307,9 @@ int NUM_OF_ATTS =1 void
UInt Yap_AttsSize void void UInt Yap_AttsSize void void
#endif #endif
/** opaque terms used to wake up on cut of call catcher meta-goal */
UInt setup_call_catcher_cleanup_tag void void
/* Operators */ /* Operators */
struct operator_entry *OpList =NULL OpListAdjust struct operator_entry *OpList =NULL OpListAdjust

1
H/TermExt.h
View File

@ -96,6 +96,7 @@ typedef enum {
ARRAY_FLOAT = 0x22, ARRAY_FLOAT = 0x22,
CLAUSE_LIST = 0x40, CLAUSE_LIST = 0x40,
EXTERNAL_BLOB = 0x100, /* generic data */ EXTERNAL_BLOB = 0x100, /* generic data */
GOAL_CUT_POINT = 0x200,
USER_BLOB_START = 0x1000, /* user defined blob */ USER_BLOB_START = 0x1000, /* user defined blob */
USER_BLOB_END = 0x1100 /* end of user defined blob */ USER_BLOB_END = 0x1100 /* end of user defined blob */
} big_blob_type; } big_blob_type;

18
H/YapHeap.h
View File

@ -31,24 +31,6 @@ typedef int (*SWI_FlushFunction)(void *);
typedef int (*SWI_PLGetStreamFunction)(void *); typedef int (*SWI_PLGetStreamFunction)(void *);
typedef int (*SWI_PLGetStreamPositionFunction)(void *); typedef int (*SWI_PLGetStreamPositionFunction)(void *);
typedef int (*Opaque_CallOnFail)(void *);
typedef int (*Opaque_CallOnWrite)(FILE *, int, void *, int);
typedef Int (*Opaque_CallOnGCMark)(int, void *, Term *, Int);
typedef int (*Opaque_CallOnGCRelocate)(int, void *, Term *, Int);
typedef struct opaque_handler_struct {
Opaque_CallOnFail fail_handler;
Opaque_CallOnWrite write_handler;
Opaque_CallOnGCMark gc_mark_handler;
Opaque_CallOnGCRelocate gc_relocate_handler;
} opaque_handler_t;
extern Opaque_CallOnWrite Yap_blob_write_handler_from_slot(Int slot);
extern Opaque_CallOnGCMark Yap_blob_gc_mark_handler(Term t);
extern Opaque_CallOnGCRelocate Yap_blob_gc_relocate_handler(Term t);
extern Int Yap_blob_tag_from_slot(Int slot);
extern void *Yap_blob_info_from_slot(Int slot);
#ifndef INT_KEYS_DEFAULT_SIZE #ifndef INT_KEYS_DEFAULT_SIZE
#define INT_KEYS_DEFAULT_SIZE 256 #define INT_KEYS_DEFAULT_SIZE 256
#endif #endif

8
H/Yapproto.h
View File

@ -107,10 +107,11 @@ extern int Yap_IsStringTerm(Term);
extern int Yap_IsWideStringTerm(Term); extern int Yap_IsWideStringTerm(Term);
extern Term Yap_RatTermToApplTerm(Term); extern Term Yap_RatTermToApplTerm(Term);
extern void Yap_InitBigNums(void); extern void Yap_InitBigNums(void);
extern Term Yap_AllocExternalDataInStack(CELL, size_t); extern Term Yap_AllocExternalDataInStack(CELL, size_t, CELL **);
extern int Yap_CleanOpaqueVariable(CELL *); extern int Yap_CleanOpaqueVariable(Term t);
extern CELL *Yap_HeapStoreOpaqueTerm(Term t); extern CELL *Yap_HeapStoreOpaqueTerm(Term t);
extern size_t Yap_OpaqueTermToString(Term t, char *str, size_t max); extern size_t Yap_OpaqueTermToString(Term t, char *str, size_t max);
extern Int Yap_blob_tag(Term t);
/* c_interface.c */ /* c_interface.c */
#ifndef YAP_CPP_INTERFACE #ifndef YAP_CPP_INTERFACE
@ -500,6 +501,9 @@ extern void Yap_init_optyap_preds(void);
// struct PL_local_data *Yap_InitThreadIO(int wid); // struct PL_local_data *Yap_InitThreadIO(int wid);
extern void Yap_flush(void); extern void Yap_flush(void);
extern X_API YAP_opaque_tag_t
YAP_NewOpaqueType(struct YAP_opaque_handler_struct *f);
/* pl-yap.c */ /* pl-yap.c */
extern Int Yap_source_line_no(void); extern Int Yap_source_line_no(void);
extern Atom Yap_source_file_name(void); extern Atom Yap_source_file_name(void);

45
H/cut_c.h
View File

@ -21,48 +21,13 @@ struct cut_c_str {
#define CBACK_CUT_ARG(Offset) B->cp_args[(Offset)-1] #define CBACK_CUT_ARG(Offset) B->cp_args[(Offset)-1]
#define CUT_C_PUSH(YAMOP, S_YREG) \ #define CUT_C_PUSH(YAMOP, S_YREG)
{ \
if ((YAMOP)->y_u.OtapFs.f) { \
S_YREG = S_YREG - CUT_C_STR_SIZE; \
cut_c_str_ptr new_top = (cut_c_str_ptr)S_YREG; \
new_top->try_userc_cut_yamop = YAMOP; \
cut_c_push(new_top); \
} \
}
#define POP_CHOICE_POINT(cp) \ #define POP_CHOICE_POINT(cp) false
(((CELL *)Yap_REGS.CUT_C_TOP != (CELL *)LOCAL_LocalBase) && \ #define POP_EXECUTE()
((CELL *)(cp) > (CELL *)Yap_REGS.CUT_C_TOP))
#define POP_EXECUTE() \ #define POP_FAIL(handler)
cut_c_str_ptr TOP = Yap_REGS.CUT_C_TOP; \ #define POP_FAIL_EXECUTE(handler)
CPredicate func = \
(CPredicate)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.f; \
PredEntry *pred = \
(PredEntry *)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.p; \
YAP_ExecuteOnCut(pred, func, TOP); \
cut_c_pop();
#define POP_FAIL(handler) \
if (handler) { yamop *oap = handler->cp_ap; \
handler->cp_ap = NOCODE; \
P = (yamop *)FAILCODE; \
choiceptr olB = B; B = handler; \
HR = handler->cp_h; \
/* DBTerm *ref = Yap_RefToException(); */ \
Yap_exec_absmi(true, false); \
B = olB; handler->cp_ap = oap; }
#define POP_FAIL_EXECUTE(handler) \
POP_FAIL(handler); \
cut_c_str_ptr TOP = Yap_REGS.CUT_C_TOP; \
CPredicate func = \
(CPredicate)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.f; \
PredEntry *pred = \
(PredEntry *)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.p; \
YAP_ExecuteOnCut(pred, func, TOP); \
cut_c_pop();
/*Initializes CUT_C_TOP*/ /*Initializes CUT_C_TOP*/
void cut_c_initialize(int wid); void cut_c_initialize(int wid);

2
H/generated/dhstruct.h
View File

@ -270,6 +270,8 @@
#define Yap_AttsSize Yap_heap_regs->Yap_AttsSize_ #define Yap_AttsSize Yap_heap_regs->Yap_AttsSize_
#endif #endif
#define setup_call_catcher_cleanup_tag Yap_heap_regs->setup_call_catcher_cleanup_tag_
#define OpList Yap_heap_regs->OpList_ #define OpList Yap_heap_regs->OpList_
#define ForeignCodeLoaded Yap_heap_regs->ForeignCodeLoaded_ #define ForeignCodeLoaded Yap_heap_regs->ForeignCodeLoaded_

2
H/generated/h0globals.h
View File

@ -100,7 +100,7 @@ EXTERNAL YP_FILE* GLOBAL_logfile;
EXTERNAL char GLOBAL_Executable[YAP_FILENAME_MAX]; EXTERNAL char GLOBAL_Executable[YAP_FILENAME_MAX];
#endif #endif
EXTERNAL int GLOBAL_OpaqueHandlersCount; EXTERNAL int GLOBAL_OpaqueHandlersCount;
EXTERNAL struct opaque_handler_struct* GLOBAL_OpaqueHandlers; EXTERNAL struct YAP_opaque_handler_struct* GLOBAL_OpaqueHandlers;
#if __simplescalar__ #if __simplescalar__
EXTERNAL char GLOBAL_pwd[YAP_FILENAME_MAX]; EXTERNAL char GLOBAL_pwd[YAP_FILENAME_MAX];
#endif #endif

2
H/generated/h0struct.h
View File

@ -273,6 +273,8 @@ EXTERNAL int NUM_OF_ATTS;
/* initialised by memory allocator */ /* initialised by memory allocator */
EXTERNAL UInt Yap_AttsSize; EXTERNAL UInt Yap_AttsSize;
#endif #endif
/** opaque terms used to wake up on cut of call catcher meta-goal */
EXTERNAL UInt setup_call_catcher_cleanup_tag;
/* Operators */ /* Operators */
EXTERNAL struct operator_entry *OpList; EXTERNAL struct operator_entry *OpList;
/* foreign code loaded */ /* foreign code loaded */

2
H/generated/hglobals.h
View File

@ -100,7 +100,7 @@ typedef struct global_data {
char Executable_[YAP_FILENAME_MAX]; char Executable_[YAP_FILENAME_MAX];
#endif #endif
int OpaqueHandlersCount_; int OpaqueHandlersCount_;
struct opaque_handler_struct* OpaqueHandlers_; struct YAP_opaque_handler_struct* OpaqueHandlers_;
#if __simplescalar__ #if __simplescalar__
char pwd_[YAP_FILENAME_MAX]; char pwd_[YAP_FILENAME_MAX];
#endif #endif

2
H/generated/hstruct.h
View File

@ -273,6 +273,8 @@
/* initialised by memory allocator */ /* initialised by memory allocator */
UInt Yap_AttsSize_; UInt Yap_AttsSize_;
#endif #endif
/** opaque terms used to wake up on cut of call catcher meta-goal */
UInt setup_call_catcher_cleanup_tag_;
/* Operators */ /* Operators */
struct operator_entry *OpList_; struct operator_entry *OpList_;
/* foreign code loaded */ /* foreign code loaded */

2
H/generated/iatoms.h
View File

@ -129,6 +129,7 @@
AtomError = Yap_LookupAtom("error"); TermError = MkAtomTerm(AtomError); AtomError = Yap_LookupAtom("error"); TermError = MkAtomTerm(AtomError);
AtomException = Yap_LookupAtom("exception"); TermException = MkAtomTerm(AtomException); AtomException = Yap_LookupAtom("exception"); TermException = MkAtomTerm(AtomException);
AtomExtensions = Yap_LookupAtom("extensions"); TermExtensions = MkAtomTerm(AtomExtensions); AtomExtensions = Yap_LookupAtom("extensions"); TermExtensions = MkAtomTerm(AtomExtensions);
AtomExternalException = Yap_LookupAtom("external_exception"); TermExternalException = MkAtomTerm(AtomExternalException);
AtomEvaluable = Yap_LookupAtom("evaluable"); TermEvaluable = MkAtomTerm(AtomEvaluable); AtomEvaluable = Yap_LookupAtom("evaluable"); TermEvaluable = MkAtomTerm(AtomEvaluable);
AtomEvaluationError = Yap_LookupAtom("evaluation_error"); TermEvaluationError = MkAtomTerm(AtomEvaluationError); AtomEvaluationError = Yap_LookupAtom("evaluation_error"); TermEvaluationError = MkAtomTerm(AtomEvaluationError);
AtomExecutable = Yap_LookupAtom("executable"); TermExecutable = MkAtomTerm(AtomExecutable); AtomExecutable = Yap_LookupAtom("executable"); TermExecutable = MkAtomTerm(AtomExecutable);
@ -505,6 +506,7 @@
FunctorExecuteWithin = Yap_MkFunctor(AtomExecuteWithin,1); FunctorExecuteWithin = Yap_MkFunctor(AtomExecuteWithin,1);
FunctorExistenceError = Yap_MkFunctor(AtomExistenceError,2); FunctorExistenceError = Yap_MkFunctor(AtomExistenceError,2);
FunctorExoClause = Yap_MkFunctor(AtomExoClause,2); FunctorExoClause = Yap_MkFunctor(AtomExoClause,2);
FunctorExternalException = Yap_MkFunctor(AtomExternalException,1);
FunctorFunctor = Yap_MkFunctor(AtomFunctor,3); FunctorFunctor = Yap_MkFunctor(AtomFunctor,3);
FunctorGAtom = Yap_MkFunctor(AtomAtom,1); FunctorGAtom = Yap_MkFunctor(AtomAtom,1);
FunctorGAtomic = Yap_MkFunctor(AtomAtomic,1); FunctorGAtomic = Yap_MkFunctor(AtomAtomic,1);

2
H/generated/ihstruct.h
View File

@ -270,6 +270,8 @@
#endif #endif
OpList = NULL; OpList = NULL;
ForeignCodeLoaded = NULL; ForeignCodeLoaded = NULL;

2
H/generated/ratoms.h
View File

@ -129,6 +129,7 @@
AtomError = AtomAdjust(AtomError); TermError = MkAtomTerm(AtomError); AtomError = AtomAdjust(AtomError); TermError = MkAtomTerm(AtomError);
AtomException = AtomAdjust(AtomException); TermException = MkAtomTerm(AtomException); AtomException = AtomAdjust(AtomException); TermException = MkAtomTerm(AtomException);
AtomExtensions = AtomAdjust(AtomExtensions); TermExtensions = MkAtomTerm(AtomExtensions); AtomExtensions = AtomAdjust(AtomExtensions); TermExtensions = MkAtomTerm(AtomExtensions);
AtomExternalException = AtomAdjust(AtomExternalException); TermExternalException = MkAtomTerm(AtomExternalException);
AtomEvaluable = AtomAdjust(AtomEvaluable); TermEvaluable = MkAtomTerm(AtomEvaluable); AtomEvaluable = AtomAdjust(AtomEvaluable); TermEvaluable = MkAtomTerm(AtomEvaluable);
AtomEvaluationError = AtomAdjust(AtomEvaluationError); TermEvaluationError = MkAtomTerm(AtomEvaluationError); AtomEvaluationError = AtomAdjust(AtomEvaluationError); TermEvaluationError = MkAtomTerm(AtomEvaluationError);
AtomExecutable = AtomAdjust(AtomExecutable); TermExecutable = MkAtomTerm(AtomExecutable); AtomExecutable = AtomAdjust(AtomExecutable); TermExecutable = MkAtomTerm(AtomExecutable);
@ -505,6 +506,7 @@
FunctorExecuteWithin = FuncAdjust(FunctorExecuteWithin); FunctorExecuteWithin = FuncAdjust(FunctorExecuteWithin);
FunctorExistenceError = FuncAdjust(FunctorExistenceError); FunctorExistenceError = FuncAdjust(FunctorExistenceError);
FunctorExoClause = FuncAdjust(FunctorExoClause); FunctorExoClause = FuncAdjust(FunctorExoClause);
FunctorExternalException = FuncAdjust(FunctorExternalException);
FunctorFunctor = FuncAdjust(FunctorFunctor); FunctorFunctor = FuncAdjust(FunctorFunctor);
FunctorGAtom = FuncAdjust(FunctorGAtom); FunctorGAtom = FuncAdjust(FunctorGAtom);
FunctorGAtomic = FuncAdjust(FunctorGAtomic); FunctorGAtomic = FuncAdjust(FunctorGAtomic);

2
H/generated/rhstruct.h
View File

@ -270,6 +270,8 @@
#endif #endif
OpList = OpListAdjust(OpList); OpList = OpListAdjust(OpList);
RestoreForeignCode(); RestoreForeignCode();

3
H/generated/tatoms.h
View File

@ -129,6 +129,7 @@ X_API EXTERNAL Atom AtomEq; X_API EXTERNAL Term TermEq;
X_API EXTERNAL Atom AtomError; X_API EXTERNAL Term TermError; X_API EXTERNAL Atom AtomError; X_API EXTERNAL Term TermError;
X_API EXTERNAL Atom AtomException; X_API EXTERNAL Term TermException; X_API EXTERNAL Atom AtomException; X_API EXTERNAL Term TermException;
X_API EXTERNAL Atom AtomExtensions; X_API EXTERNAL Term TermExtensions; X_API EXTERNAL Atom AtomExtensions; X_API EXTERNAL Term TermExtensions;
X_API EXTERNAL Atom AtomExternalException; X_API EXTERNAL Term TermExternalException;
X_API EXTERNAL Atom AtomEvaluable; X_API EXTERNAL Term TermEvaluable; X_API EXTERNAL Atom AtomEvaluable; X_API EXTERNAL Term TermEvaluable;
X_API EXTERNAL Atom AtomEvaluationError; X_API EXTERNAL Term TermEvaluationError; X_API EXTERNAL Atom AtomEvaluationError; X_API EXTERNAL Term TermEvaluationError;
X_API EXTERNAL Atom AtomExecutable; X_API EXTERNAL Term TermExecutable; X_API EXTERNAL Atom AtomExecutable; X_API EXTERNAL Term TermExecutable;
@ -571,6 +572,8 @@ X_API EXTERNAL Functor FunctorExistenceError;
X_API EXTERNAL Functor FunctorExoClause; X_API EXTERNAL Functor FunctorExoClause;
X_API EXTERNAL Functor FunctorExternalException;
X_API EXTERNAL Functor FunctorFunctor; X_API EXTERNAL Functor FunctorFunctor;
X_API EXTERNAL Functor FunctorGAtom; X_API EXTERNAL Functor FunctorGAtom;

70
H/trim_trail.h
View File

@ -1,5 +1,5 @@
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
{ {
tr_fr_ptr pt0, pt1, pbase; tr_fr_ptr pt0, pt1, pbase;
pbase = B->cp_tr; pbase = B->cp_tr;
@ -17,9 +17,10 @@
} else if (IsPairTerm(d1)) { } else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1); CELL *pt = RepPair(d1);
#ifdef LIMIT_TABLING #ifdef LIMIT_TABLING
if ((ADDR) pt == LOCAL_TrailBase) { if ((ADDR)pt == LOCAL_TrailBase) {
sg_fr_ptr sg_fr = (sg_fr_ptr) TrailVal(pt1); sg_fr_ptr sg_fr = (sg_fr_ptr)TrailVal(pt1);
SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */ SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use
--> compiled */
insert_into_global_sg_fr_list(sg_fr); insert_into_global_sg_fr_list(sg_fr);
} else } else
#endif /* LIMIT_TABLING */ #endif /* LIMIT_TABLING */
@ -27,13 +28,19 @@
/* skip, this is a problem because we lose information, /* skip, this is a problem because we lose information,
namely active references */ namely active references */
pt1 = (tr_fr_ptr)pt; pt1 = (tr_fr_ptr)pt;
} else if (IN_BETWEEN(H0,pt,HR) && IsAttVar(pt)) { } else if (IN_BETWEEN(H0, pt, HR) && IsApplTerm(HeadOfTerm(d1))) {
CELL val = Deref(*pt); Term t = HeadOfTerm(d1);
if (IsVarTerm(val)) { Functor f = FunctorOfTerm(t);
YapBind(pt, MkAtomTerm(AtomCut)); if (f == FunctorBigInt) {
Yap_WakeUp(pt); Int tag = Yap_blob_tag(t) - USER_BLOB_START;
RESET_VARIABLE(&TrailTerm(pt1));
GLOBAL_OpaqueHandlers[tag].cut_handler(d1);
} else {
pt0--;
} }
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) { pt1--;
continue;
} else if ((*pt & (LogUpdMask | IndexMask)) == (LogUpdMask | IndexMask)) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt); LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
int erase; int erase;
#if defined(THREADS) || defined(YAPOR) #if defined(THREADS) || defined(YAPOR)
@ -43,7 +50,7 @@
LOCK(ap->PELock); LOCK(ap->PELock);
DEC_CLREF_COUNT(cl); DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask; cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & (ErasedMask|DirtyMask)) && !(cl->ClRefCount); erase = (cl->ClFlags & (ErasedMask | DirtyMask)) && !(cl->ClRefCount);
if (erase) { if (erase) {
/* at this point, we are the only ones accessing the clause, /* at this point, we are the only ones accessing the clause,
hence we don't need to have a lock it */ hence we don't need to have a lock it */
@ -60,14 +67,14 @@
} }
pt1--; pt1--;
} else if (IsApplTerm(d1)) { } else if (IsApplTerm(d1)) {
if (IN_BETWEEN(HBREG,RepAppl(d1),B->cp_b)) { if (IN_BETWEEN(HBREG, RepAppl(d1), B->cp_b)) {
/* deterministic binding to multi-assignment variable */ /* deterministic binding to multi-assignment variable */
pt1 -= 2; pt1 -= 2;
} else { } else {
TrailVal(pt0) = TrailVal(pt1); TrailVal(pt0) = TrailVal(pt1);
TrailTerm(pt0) = d1; TrailTerm(pt0) = d1;
TrailVal(pt0-1) = TrailVal(pt1-1); TrailVal(pt0 - 1) = TrailVal(pt1 - 1);
TrailTerm(pt0-1) = TrailTerm(pt1-1); TrailTerm(pt0 - 1) = TrailTerm(pt1 - 1);
pt0 -= 2; pt0 -= 2;
pt1 -= 2; pt1 -= 2;
} }
@ -86,9 +93,9 @@
memmove(pbase, pt0, size * sizeof(struct trail_frame)); memmove(pbase, pt0, size * sizeof(struct trail_frame));
TR = pbase + size; TR = pbase + size;
} }
} }
#else #else
{ {
tr_fr_ptr pt1, pt0; tr_fr_ptr pt1, pt0;
pt1 = pt0 = B->cp_tr; pt1 = pt0 = B->cp_tr;
while (pt1 != TR) { while (pt1 != TR) {
@ -104,7 +111,7 @@
} }
pt1++; pt1++;
} else if (IsApplTerm(d1)) { } else if (IsApplTerm(d1)) {
if (IN_BETWEEN(HBREG,RepAppl(d1),B->cp_b)) { if (IN_BETWEEN(HBREG, RepAppl(d1), B->cp_b)) {
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
pt1 += 2; pt1 += 2;
#else #else
@ -114,13 +121,13 @@
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
TrailVal(pt0) = TrailVal(pt1); TrailVal(pt0) = TrailVal(pt1);
TrailTerm(pt0) = d1; TrailTerm(pt0) = d1;
TrailVal(pt0+1) = TrailVal(pt1+1); TrailVal(pt0 + 1) = TrailVal(pt1 + 1);
TrailTerm(pt0+1) = TrailTerm(pt1+1); TrailTerm(pt0 + 1) = TrailTerm(pt1 + 1);
pt0 += 2; pt0 += 2;
pt1 += 2; pt1 += 2;
#else #else
TrailTerm(pt0+1) = TrailTerm(pt1+1); TrailTerm(pt0 + 1) = TrailTerm(pt1 + 1);
TrailTerm(pt0) = TrailTerm(pt0+2) = d1; TrailTerm(pt0) = TrailTerm(pt0 + 2) = d1;
pt0 += 3; pt0 += 3;
pt1 += 3; pt1 += 3;
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
@ -128,13 +135,15 @@
} else if (IsPairTerm(d1)) { } else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1); CELL *pt = RepPair(d1);
if (IN_BETWEEN(H0,pt,HR) && IsAttVar(pt)) { else if (IN_BETWEEN(H0, pt, HR) && IsApplTerm(HeadOfTerm(d1))) {
CELL val = Deref(*pt); Term t = HeadOfTerm(d1);
if (IsVarTerm(val)) { Functor f = FunctorOfTerm(t);
YapBind(VarOfTerm(val), MkAtomTerm(AtomCut)); if (f == FunctorBigInt) {
Yap_WakeUp(pt); RESET_VARIABLE(&TrailTerm(pt1));
} Int tag = Yap_blob_tag(t);
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) { GLOBAL_OpaqueHandlers[tag].cut_handler(d1);
} else if ((*pt & (LogUpdMask | IndexMask)) ==
(LogUpdMask | IndexMask)) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt); LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
PredEntry *ap = cl->ClPred; PredEntry *ap = cl->ClPred;
@ -144,7 +153,7 @@
LOCK(ap->PELock); LOCK(ap->PELock);
DEC_CLREF_COUNT(cl); DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask; cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & (DirtyMask|ErasedMask)) && !(cl->ClRefCount); erase = (cl->ClFlags & (DirtyMask | ErasedMask)) && !(cl->ClRefCount);
if (erase) { if (erase) {
/* at this point, we are the only ones accessing the clause, /* at this point, we are the only ones accessing the clause,
hence we don't need to have a lock it */ hence we don't need to have a lock it */
@ -159,7 +168,8 @@
pt0++; pt0++;
} }
pt1++; pt1++;
} else { }
else {
TrailTerm(pt0) = d1; TrailTerm(pt0) = d1;
pt0++; pt0++;
pt1++; pt1++;

3
pl/boot.yap
View File

@ -854,8 +854,8 @@ number of steps.
format(user_error,'.~n', []). format(user_error,'.~n', []).
'$another' :- '$another' :-
'$clear_input'(user_input),
format(user_error,' ? ',[]), format(user_error,' ? ',[]),
'$clear_input'(user_input),
get_code(user_input,C), get_code(user_input,C),
'$do_another'(C). '$do_another'(C).
@ -1399,7 +1399,6 @@ Command = (H --> B) ->
'$enter_command'(Stream, Mod, Status) :- '$enter_command'(Stream, Mod, Status) :-
'$clear_input'(Stream),
prompt1(': '), prompt(_,' '), prompt1(': '), prompt(_,' '),
Options = [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)], Options = [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)],
( (

11
pl/control.yap
View File

@ -262,10 +262,12 @@ This is similar to call_cleanup/1 but with an additional
*/ */
call_cleanup(Goal, Cleanup) :- call_cleanup(Goal, Cleanup) :-
setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup). call_cleanup(Goal, _Catcher, Cleanup).
call_cleanup(Goal, Catcher, Cleanup) :- call_cleanup(Goal, Catcher, Cleanup) :-
setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup). '$tag_cleanup'(CP0, cleanup( false, Catcher, Cleanup, Tag, 0, Done)),
call( Goal ),
'$cleanup_on_exit'(CP0, cleanup( false, Catcher, Cleanup, Tag, 1, Done )).
/** @pred setup_call_cleanup(: _Setup_,: _Goal_, : _CleanUpGoal_) /** @pred setup_call_cleanup(: _Setup_,: _Goal_, : _CleanUpGoal_)
@ -285,6 +287,11 @@ finally undone by _Cleanup_.
setup_call_cleanup(Setup,Goal, Cleanup) :- setup_call_cleanup(Setup,Goal, Cleanup) :-
setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup). setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
'$setup_call_catcher_cleanup'(Setup),
call_cleanup(Goal, Catcher, Cleanup).
/** @pred call_with_args(+ _Name_,...,? _Ai_,...) /** @pred call_with_args(+ _Name_,...,? _Ai_,...)