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 +
(sizeof(MP_INT)+
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
Opaque_CallOnGCMark f;
Opaque_CallOnGCRelocate f2;
YAP_Opaque_CallOnGCMark f;
YAP_Opaque_CallOnGCRelocate f2;
Term t = AbsAppl(pt);
if ( (f = Yap_blob_gc_mark_handler(t)) ) {

167
C/bignum.c
View File

@ -33,9 +33,7 @@ static char SccsId[] = "%W% %G%";
#include "YapEval.h"
#include "alloc.h"
Term
Yap_MkBigIntTerm(MP_INT *big)
{
Term Yap_MkBigIntTerm(MP_INT *big) {
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(HR + 2);
@ -66,19 +64,14 @@ Yap_MkBigIntTerm(MP_INT *big)
return AbsAppl(ret);
}
MP_INT *
Yap_BigIntOfTerm(Term t)
{
MP_INT *Yap_BigIntOfTerm(Term t) {
MP_INT *new = (MP_INT *)(RepAppl(t) + 2);
new->_mp_d = (mp_limb_t *)(new + 1);
return (new);
}
Term
Yap_MkBigRatTerm(MP_RAT *big)
{
Term Yap_MkBigRatTerm(MP_RAT *big) {
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(HR + 2);
@ -89,7 +82,8 @@ Yap_MkBigRatTerm(MP_RAT *big)
if (mpz_cmp_si(den, 1) == 0)
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;
}
HR[0] = (CELL)FunctorBigInt;
@ -112,9 +106,7 @@ Yap_MkBigRatTerm(MP_RAT *big)
return AbsAppl(ret);
}
MP_RAT *
Yap_BigRatOfTerm(Term t)
{
MP_RAT *Yap_BigRatOfTerm(Term t) {
MP_RAT *new = (MP_RAT *)(RepAppl(t) + 2 + sizeof(MP_INT) / sizeof(CELL));
mp_limb_t *nt;
@ -124,9 +116,7 @@ Yap_BigRatOfTerm(Term t)
return new;
}
Term
Yap_RatTermToApplTerm(Term t)
{
Term Yap_RatTermToApplTerm(Term t) {
Term ts[2];
MP_RAT *rat = Yap_BigRatOfTerm(t);
@ -137,9 +127,7 @@ Yap_RatTermToApplTerm(Term t)
#endif
Term
Yap_AllocExternalDataInStack(CELL tag, size_t bytes)
{
Term Yap_AllocExternalDataInStack(CELL tag, size_t bytes, CELL **pt) {
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(HR + 2);
@ -156,17 +144,14 @@ Yap_AllocExternalDataInStack(CELL tag, size_t bytes)
HR = (CELL *)(dst + 1) + nlimbs;
HR[0] = EndSpecials;
HR++;
if (tag != EXTERNAL_BLOB) {
TrailTerm(TR) = AbsPair(ret);
TR++;
}
*pt = (CELL *)(dst + 1);
return AbsAppl(ret);
}
int Yap_CleanOpaqueVariable(CELL *pt)
{
int Yap_CleanOpaqueVariable(CELL d) {
CELL blob_info, blob_tag;
MP_INT *blobp;
CELL *pt = RepAppl(HeadOfTerm(d));
#ifdef DEBUG
/* sanity checking */
if (pt[0] != (CELL)FunctorBigInt) {
@ -175,23 +160,20 @@ int Yap_CleanOpaqueVariable(CELL *pt)
}
#endif
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);
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;
}
blob_info = blob_tag - USER_BLOB_START;
if (!GLOBAL_OpaqueHandlers)
return FALSE;
blobp = (MP_INT *)(pt+2);
if (!GLOBAL_OpaqueHandlers[blob_info].fail_handler)
return TRUE;
return (GLOBAL_OpaqueHandlers[blob_info].fail_handler)((void *)(blobp+1));
return true;
return (GLOBAL_OpaqueHandlers[blob_info].fail_handler)(d);
}
Opaque_CallOnWrite
Yap_blob_write_handler(Term t)
{
YAP_Opaque_CallOnWrite Yap_blob_write_handler(Term t) {
CELL blob_info, blob_tag;
CELL *pt = RepAppl(t);
@ -203,9 +185,9 @@ Yap_blob_write_handler(Term t)
}
#endif
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);
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;
}
blob_info = blob_tag - USER_BLOB_START;
@ -215,9 +197,7 @@ Yap_blob_write_handler(Term t)
return GLOBAL_OpaqueHandlers[blob_info].write_handler;
}
Opaque_CallOnGCMark
Yap_blob_gc_mark_handler(Term t)
{
YAP_Opaque_CallOnGCMark Yap_blob_gc_mark_handler(Term t) {
CELL blob_info, blob_tag;
CELL *pt = RepAppl(t);
@ -229,19 +209,16 @@ Yap_blob_gc_mark_handler(Term t)
}
#endif
blob_tag = pt[1];
if (blob_tag < USER_BLOB_START ||
blob_tag >= USER_BLOB_END) {
if (blob_tag < USER_BLOB_START || blob_tag >= USER_BLOB_END) {
return NULL;
}
blob_info = blob_tag - USER_BLOB_START;
if (!GLOBAL_OpaqueHandlers)
return NULL;
return GLOBAL_OpaqueHandlers[blob_info].gc_mark_handler;
return GLOBAL_OpaqueHandlers[blob_info].mark_handler;
}
Opaque_CallOnGCRelocate
Yap_blob_gc_relocate_handler(Term t)
{
YAP_Opaque_CallOnGCRelocate Yap_blob_gc_relocate_handler(Term t) {
CELL blob_info, blob_tag;
CELL *pt = RepAppl(t);
@ -253,19 +230,18 @@ Yap_blob_gc_relocate_handler(Term t)
}
#endif
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);
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;
}
blob_info = blob_tag - USER_BLOB_START;
if (!GLOBAL_OpaqueHandlers)
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);
#ifdef DEBUG
@ -278,9 +254,7 @@ extern Int Yap_blob_tag(Term t)
return pt[1];
}
void *
Yap_blob_info(Term t)
{
void *Yap_blob_info(Term t) {
MP_INT *blobp;
CELL *pt = RepAppl(t);
@ -297,9 +271,7 @@ Yap_blob_info(Term t)
return (void *)(blobp + 1);
}
Term
Yap_MkULLIntTerm(YAP_ULONG_LONG n)
{
Term Yap_MkULLIntTerm(YAP_ULONG_LONG n) {
#if __GNUC__ && USE_GMP
mpz_t new;
char tmp[256];
@ -327,9 +299,7 @@ Yap_MkULLIntTerm(YAP_ULONG_LONG n)
#endif
}
CELL *
Yap_HeapStoreOpaqueTerm(Term t)
{
CELL *Yap_HeapStoreOpaqueTerm(Term t) {
CELL *ptr = RepAppl(t);
size_t sz;
void *new;
@ -342,7 +312,8 @@ Yap_HeapStoreOpaqueTerm(Term t)
}
new = Yap_AllocCodeSpace(sz);
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 {
if (ptr[0] == (CELL)FunctorBigInt) {
MP_INT *new = (MP_INT *)(RepAppl(t) + 2);
@ -354,10 +325,7 @@ Yap_HeapStoreOpaqueTerm(Term t)
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;
CELL *li = RepAppl(t);
unsigned char *ptr = (unsigned char *)StringOfTerm(AbsAppl(li));
@ -366,7 +334,8 @@ Yap_OpaqueTermToString(Term t, char *str, size_t max)
do {
utf8proc_int32_t chr;
ptr += get_utf8(ptr, -1, &chr);
if (chr == '\0') break;
if (chr == '\0')
break;
str_index += sprintf(str + str_index, "%C", chr);
} while (TRUE);
str_index += sprintf(str + str_index, "\"");
@ -403,47 +372,30 @@ Yap_OpaqueTermToString(Term t, char *str, size_t max)
return str_index;
}
static Int
p_is_bignum( USES_REGS1 )
{
static Int p_is_bignum(USES_REGS1) {
#ifdef USE_GMP
Term t = Deref(ARG1);
return(
IsNonVarTerm(t) &&
IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorBigInt &&
RepAppl(t)[1] == BIG_INT
);
return (IsNonVarTerm(t) && IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorBigInt && RepAppl(t)[1] == BIG_INT);
#else
return FALSE;
#endif
}
static Int
p_is_string( USES_REGS1 )
{
static Int p_is_string(USES_REGS1) {
Term t = Deref(ARG1);
return(
IsNonVarTerm(t) &&
IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorString
);
return (IsNonVarTerm(t) && IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorString);
}
static Int
p_nb_set_bit( USES_REGS1 )
{
static Int p_nb_set_bit(USES_REGS1) {
#ifdef USE_GMP
Term t = Deref(ARG1);
Term ti = Deref(ARG2);
Int i;
if (!(
IsNonVarTerm(t) &&
IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorBigInt &&
RepAppl(t)[1] == BIG_INT
))
if (!(IsNonVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorBigInt &&
RepAppl(t)[1] == BIG_INT))
return FALSE;
if (!IsIntegerTerm(ti)) {
return FALSE;
@ -462,9 +414,7 @@ p_nb_set_bit( USES_REGS1 )
#endif
}
static Int
p_has_bignums( USES_REGS1 )
{
static Int p_has_bignums(USES_REGS1) {
#ifdef USE_GMP
return TRUE;
#else
@ -472,9 +422,7 @@ p_has_bignums( USES_REGS1 )
#endif
}
static Int
p_is_opaque( USES_REGS1 )
{
static Int p_is_opaque(USES_REGS1) {
Term t = Deref(ARG1);
if (IsVarTerm(t))
return FALSE;
@ -490,9 +438,7 @@ p_is_opaque( USES_REGS1 )
return FALSE;
}
static Int
p_is_rational( USES_REGS1 )
{
static Int p_is_rational(USES_REGS1) {
Term t = Deref(ARG1);
if (IsVarTerm(t))
return FALSE;
@ -512,9 +458,7 @@ p_is_rational( USES_REGS1 )
return FALSE;
}
static Int
p_rational( USES_REGS1 )
{
static Int p_rational(USES_REGS1) {
#ifdef USE_GMP
Term t = Deref(ARG1);
Functor f;
@ -535,25 +479,20 @@ p_rational( USES_REGS1 )
rat = Yap_BigRatOfTerm(t);
while ((t1 = Yap_MkBigIntTerm(mpq_numref(rat))) == TermNil ||
(t2 = Yap_MkBigIntTerm(mpq_denref(rat))) == TermNil) {
UInt size =
(mpq_numref(rat)->_mp_alloc)*(sizeof(mp_limb_t)/CellSize) +
UInt size = (mpq_numref(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)) {
Yap_Error(RESOURCE_ERROR_STACK, t, LOCAL_ErrorMessage);
return FALSE;
}
}
return
Yap_unify(ARG2, t1) &&
Yap_unify(ARG3, t2);
return Yap_unify(ARG2, t1) && Yap_unify(ARG3, t2);
#else
return FALSE;
#endif
}
void
Yap_InitBigNums(void)
{
void Yap_InitBigNums(void) {
Yap_InitCPred("$has_bignums", 0, p_has_bignums, SafePredFlag);
Yap_InitCPred("$bignum", 1, p_is_bignum, SafePredFlag);
Yap_InitCPred("rational", 3, p_rational, 0);

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) {
Term t = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes);
CELL *pt;
Term t = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes, &pt);
if (t == TermNil)
return 0L;
return t;
@ -1883,7 +1884,7 @@ X_API YAP_opaque_tag_t YAP_NewOpaqueType(struct YAP_opaque_handler_struct *f) {
int i;
if (!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) {
/* no room */
return -1;
@ -1893,14 +1894,28 @@ X_API YAP_opaque_tag_t YAP_NewOpaqueType(struct YAP_opaque_handler_struct *f) {
return -1;
}
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;
}
X_API Term YAP_NewOpaqueObject(YAP_opaque_tag_t tag, size_t bytes) {
Term t = Yap_AllocExternalDataInStack((CELL) tag, bytes);
X_API Term YAP_NewOpaqueObject(YAP_opaque_tag_t blob_tag, size_t bytes) {
CELL *pt;
Term t = Yap_AllocExternalDataInStack((CELL) blob_tag, bytes, &pt);
if (t == TermNil)
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;
}

458
C/exec.c
View File

@ -22,7 +22,6 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#include "attvar.h"
#include "cut_c.h"
#include "yapio.h"
#include "yapio.h"
static bool CallPredicate(PredEntry *, choiceptr, yamop *CACHE_TYPE);
// must hold thread worker comm lock at call.
@ -712,26 +711,6 @@ static Int execute_in_mod(USES_REGS1) { /* '$execute'(Goal) */
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.
*
@ -762,6 +741,7 @@ static void prune_inner_computation(choiceptr parent) {
CP = oCP;
ENV = LCL0 - oENV;
}
/**
* restore abstract machine state
* after completing a computation.
@ -789,160 +769,95 @@ static void complete_inner_computation(choiceptr old_B) {
ENV = myB->cp_env;
}
static inline Term *GetTermAddress(CELL a) {
Term *b = NULL;
restart:
if (!IsVarTerm(a)) {
return (b);
} else if (a == (CELL)b) {
return (b);
} else {
b = (CELL *)a;
a = *b;
goto restart;
}
}
static Int Yap_ignore(Term t USES_REGS) {
yamop *oP = P, *oCP = CP;
Int oENV = LCL0 - ENV;
Int oYENV = LCL0 - YENV;
Int oB = LCL0 - (CELL *)B;
bool rc = Yap_RunTopGoal(t, false);
/**
* call a cleanup routine taking care with the status variable.
*/
static bool call_cleanup(Term t3, Term t4, Term cleanup,
choiceptr B0 USES_REGS) {
CELL *pt = GetTermAddress(t3);
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) {
if (Yap_RaiseException()) {
P = oP;
CP = oCP;
ENV = LCL0 - oENV;
YENV = LCL0 - oYENV;
B = (choiceptr)(LCL0-oB);
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;
}
/**
* 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);
extern void *Yap_blob_info(Term t);
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;
}
static Int protect_stack_from_cut(USES_REGS1) {
static bool watch_cut(Term ext USES_REGS) {
// called after backtracking..
/* reinitialize the engine */
/* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */
YENV = ASP = (CELL *)B;
call_cleanup(B->cp_a3, B->cp_a4, (P == FAILCODE ? TermException : TermCut),
B PASS_REGS);
//
Term task = TailOfTerm(ext);
Term box = ArgOfTerm(1, task);
Term port = ArgOfTerm(2, task);
Term cleanup = ArgOfTerm(3, 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)));
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;
}
@ -953,57 +868,68 @@ static Int protect_stack_from_cut(USES_REGS1) {
* @method protect_stack_from_restore
* @param USES_REGS1 [env for threaded execution]
* @return c
[next answer]
*/
static Int protect_stack_from_retry(USES_REGS1) {
static bool watch_retry(Term d0 USES_REGS) {
// called after backtracking..
//
yamop *oP = P;
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);
CELL d = ((CELL *)Yap_blob_info(HeadOfTerm(d0)))[0];
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);
// binding to t3 should be undone
// by next backtrack.
/* first, destroy the current choice-point,
*/
if (done || previous)
return true;
while (B->cp_ap->opc == FAIL_OPCODE)
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())
p = CALLED_FROM_EXCEPTION;
{
Term e = Yap_GetException();
Term t;
ex = true;
if (first)
{
t = Yap_MkApplTerm(FunctorException, 1, &e);
}
else
p = CALLED_FROM_FAIL;
{
t = Yap_MkApplTerm(FunctorExternalException, 1, &e);
}
Int rc = exit_set_call(p, B0, oCP, t3, t4 PASS_REGS);
if (rc) {
CP = oCP;
P = oP;
ENV = LCL0 - oENV;
}
if (Yap_RaiseException())
if (!Yap_unify(port, t))
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]
* @return [always succeed]
*/
static Int protect_stack(USES_REGS1) {
// just create the choice-point;
return true;
}
static Int setup_call_catcher_cleanup(USES_REGS1) {
Term Setup = Deref(ARG1);
Int oENV = LCL0 - ENV;
choiceptr B0 = B;
Term t3, t4;
yhandle_t hl = Yap_StartSlots();
yhandle_t h2 = Yap_InitHandle(ARG2);
yhandle_t h3 = Yap_InitHandle(t3 = Deref(ARG3));
yhandle_t h4 = Yap_InitHandle(ARG4);
yamop *oCP = CP, *oP = P;
yamop *oP = P, *oCP = CP;
Int oENV = LCL0 - ENV;
Int oYENV = LCL0 - YENV;
bool rc;
execution_port port;
Yap_DisableInterrupts(worker_id);
rc = Yap_RunTopGoal(Setup, false);
@ -1048,46 +964,62 @@ static Int setup_call_catcher_cleanup(USES_REGS1) {
} else {
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;
CP = oCP;
ENV = LCL0 - oENV;
}
if (Yap_RaiseException()) {
return false;
}
YENV = LCL0 - oYENV;
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) {
CACHE_REGS
if (creeping) {
@ -2039,9 +1971,6 @@ static Int JumpToEnv() {
// DBTerm *dbt = Yap_RefToException();
while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch) {
// printf("--handler=%p, max=%p\n", handler, LCL0-LOCAL_CBorder);
while (POP_CHOICE_POINT(handler)) {
POP_FAIL_EXECUTE(handler);
}
if (handler == (choiceptr)(LCL0 - LOCAL_CBorder)) {
break;
}
@ -2058,6 +1987,7 @@ static Int JumpToEnv() {
}
POP_FAIL(handler);
B = handler;
// Yap_CopyException(ref);
if (Yap_PredForChoicePt(B, NULL) == PredDollarCatch) {
/* can recover Heap thanks to copy term :-( */
@ -2077,10 +2007,9 @@ static Int JumpToEnv() {
} else if (IsVarTerm(t)) {
t = Yap_MkApplTerm(FunctorGVar, 1, &t);
}
B->cp_h = HR;
HB = HR;
Yap_unify(t, B->cp_a2);
B->cp_tr = TR;
B->cp_h = HR;
TR--;
}
P = FAILCODE;
return true;
@ -2296,6 +2225,12 @@ int Yap_dogc(int extra_args, Term *tp USES_REGS) {
void Yap_InitExecFs(void) {
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;
Yap_InitComma();
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("$do_term_expansion", 2, do_term_expansion, 0);
Yap_InitCPred("$get_exception", 1, get_exception, 0);
Yap_InitCPred("setup_call_catcher_cleanup", 4, setup_call_catcher_cleanup, 0);
Yap_InitCPredBackCut("$protect_stack", 4, 0, protect_stack,
protect_stack_from_retry, protect_stack_from_cut, 0);
Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup,
0);
Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, 0);
Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0);
}

136
C/fail_absmi_insts.h
View File

@ -4,8 +4,6 @@
#ifdef INDENT_CODE
{
{
{
#endif /* INDENT_CODE */
/* trust_fail */
@ -39,7 +37,8 @@
/* fail */
PBOp(op_fail, e);
if (PP) {
if (PP)
{
UNLOCK(PP->PELock);
PP = NULL;
}
@ -53,7 +52,8 @@
{
register tr_fr_ptr pt0 = TR;
#if defined(YAPOR) || defined(THREADS)
if (PP) {
if (PP)
{
UNLOCK(PP->PELock);
PP = NULL;
}
@ -63,18 +63,22 @@
CACHE_TR(B->cp_tr);
PREFETCH_OP(PREG);
failloop:
if (pt0 == S_TR) {
if (pt0 == S_TR)
{
SP = SP0;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
if (Yap_do_low_level_trace)
{
int go_on = true;
yamop *ipc = PREG;
while (go_on) {
while (go_on)
{
op_numbers opnum = Yap_op_from_opcode(ipc->opc);
go_on = false;
switch (opnum) {
switch (opnum)
{
#ifdef TABLING
case _table_load_answer:
low_level_trace(retry_table_loader, LOAD_CP(B)->cp_pred_entry, NULL);
@ -194,7 +198,8 @@
{
TR = TR_FZ;
TRAIL_LINK(pt0);
} else
}
else
#endif /* FROZEN_STACKS */
RESTORE_TR();
GONext();
@ -202,13 +207,16 @@
BEGD(d1);
d1 = TrailTerm(pt0 - 1);
pt0--;
if (IsVarTerm(d1)) {
if (IsVarTerm(d1))
{
#if defined(YAPOR_SBA) && defined(YAPOR)
/* clean up the trail when we backtrack */
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));
} else
}
else
#endif
/* normal variable */
RESET_VARIABLE(d1);
@ -223,7 +231,8 @@
register CELL flags;
CELL *pt1 = RepPair(d1);
#ifdef LIMIT_TABLING
if ((ADDR) pt1 == LOCAL_TrailBase) {
if ((ADDR)pt1 == LOCAL_TrailBase)
{
sg_fr_ptr sg_fr = (sg_fr_ptr)TrailVal(pt0);
TrailTerm(pt0) = AbsPair((CELL *)(pt0 - 1));
SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */
@ -243,15 +252,21 @@
{
pt0 = (tr_fr_ptr)pt1;
goto failloop;
} else
}
else
#endif /* FROZEN_STACKS */
if (IN_BETWEEN(H0,pt1,HR)) {
if (IsAttVar(pt1)) {
goto failloop;
} else if (*pt1 == (CELL)FunctorBigInt) {
Yap_CleanOpaqueVariable(pt1);
if (IN_BETWEEN(H0, pt1, HR))
{
if (IsAttVar(pt1))
{
goto failloop;
}
else
{
TR = pt0;
Yap_CleanOpaqueVariable(d1);
goto fail;
}
}
#ifdef FROZEN_STACKS /* TRAIL */
/* don't reset frozen variables */
@ -260,7 +275,8 @@
#endif
flags = *pt1;
#if MULTIPLE_STACKS
if (FlagOn(DBClMask, flags)) {
if (FlagOn(DBClMask, flags))
{
DBRef dbr = DBStructFlagsToDBStruct(pt1);
int erase;
@ -268,14 +284,19 @@
DEC_DBREF_COUNT(dbr);
erase = (dbr->Flags & ErasedMask) && (dbr->ref_count == 0);
UNLOCK(dbr->lock);
if (erase) {
if (erase)
{
saveregs();
Yap_ErDBE(dbr);
setregs();
}
} else {
if (flags & LogUpdMask) {
if (flags & IndexMask) {
}
else
{
if (flags & LogUpdMask)
{
if (flags & IndexMask)
{
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt1);
int erase;
#if PARALLEL_YAP
@ -285,14 +306,17 @@
PELOCK(8, ap);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
if (erase) {
if (erase)
{
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_ErLogUpdIndex(cl);
setregs();
} else if (cl->ClFlags & DirtyMask) {
}
else if (cl->ClFlags & DirtyMask)
{
saveregs();
/* at this point,
we are the only ones accessing the clause,
@ -301,19 +325,23 @@
setregs();
}
UNLOCK(ap->PELock);
} else {
}
else
{
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
int erase;
#if PARALLEL_YAP
PredEntry *ap = cl->ClPred;
#endif
/* BB support */
if (ap) {
if (ap)
{
PELOCK(9, ap);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
if (erase) {
if (erase)
{
saveregs();
/* at this point,
we are the only ones accessing the clause,
@ -324,7 +352,9 @@
UNLOCK(ap->PELock);
}
}
} else {
}
else
{
DynamicClause *cl = ClauseFlagsToDynamicClause(pt1);
int erase;
@ -332,7 +362,8 @@
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
UNLOCK(cl->ClLock);
if (erase) {
if (erase)
{
saveregs();
/* at this point,
we are the only ones accessing the clause,
@ -345,24 +376,37 @@
#else
ResetFlag(InUseMask, flags);
*pt1 = flags;
if (FlagOn((ErasedMask|DirtyMask), flags)) {
if (FlagOn(DBClMask, flags)) {
if (FlagOn((ErasedMask | DirtyMask), flags))
{
if (FlagOn(DBClMask, flags))
{
saveregs();
Yap_ErDBE(DBStructFlagsToDBStruct(pt1));
setregs();
} else {
}
else
{
saveregs();
if (flags & LogUpdMask) {
if (flags & IndexMask) {
if (FlagOn(ErasedMask, flags)) {
if (flags & LogUpdMask)
{
if (flags & IndexMask)
{
if (FlagOn(ErasedMask, flags))
{
Yap_ErLogUpdIndex(ClauseFlagsToLogUpdIndex(pt1));
} else {
}
else
{
Yap_CleanUpIndex(ClauseFlagsToLogUpdIndex(pt1));
}
} else {
}
else
{
Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(pt1));
}
} else {
}
else
{
Yap_ErCl(ClauseFlagsToDynamicClause(pt1));
}
setregs();
@ -372,7 +416,8 @@
goto failloop;
}
#ifdef MULTI_ASSIGNMENT_VARIABLES
else /* if (IsApplTerm(d1)) */ {
else /* if (IsApplTerm(d1)) */
{
CELL *pt = RepAppl(d1);
/* AbsAppl means */
/* multi-assignment variable */
@ -403,12 +448,13 @@
#ifdef SHADOW_S
SREG = Yap_REGS.S_;
#endif
if (!d0) FAIL();
if (!d0)
FAIL();
JMPNext();
ENDD(d0);
#endif /* COROUTINING */
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)+
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/CellSize;
//printf("sz *%ld* at @%ld@\n", sz, pt-H0);
Opaque_CallOnGCMark f;
Opaque_CallOnGCRelocate f2;
YAP_Opaque_CallOnGCMark f;
YAP_Opaque_CallOnGCRelocate f2;
Term t = AbsAppl(pt);
if ( (f = Yap_blob_gc_mark_handler(t)) ) {

23
C/heapgc.c
View File

@ -514,7 +514,7 @@ pop_registers(Int num_regs, yamop *nextop USES_REGS)
/* pop info on opaque variables */
while (LOCAL_extra_gc_cells > LOCAL_extra_gc_cells_base) {
Opaque_CallOnGCRelocate f;
YAP_Opaque_CallOnGCRelocate f;
CELL *ptr = LOCAL_extra_gc_cells-1;
size_t n = ptr[0], t = ptr[-1];
@ -1436,16 +1436,17 @@ mark_variable(CELL_PTR current USES_REGS)
MARK(next+sz);
}
POP_CONTINUATION();
case (CELL)FunctorBigInt:
{
Opaque_CallOnGCMark f;
case (CELL)FunctorBigInt: {
YAP_Opaque_CallOnGCMark f;
Term t = AbsAppl(next);
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);
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) {
/* error: we don't have enough room */
/* could not find more trail */
@ -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;
mark_external_reference(&TrailTerm(trail_base) PASS_REGS);
TrailTerm(trail_base) = trail_cell;
} else if (*cptr == (CELL)FunctorBigInt) {
TrailTerm(trail_base) = AbsAppl(cptr);
} else {
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
@ -2655,7 +2650,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS)
if (HEAP_PTR(TrailTerm(dest))) {
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell) PASS_REGS);
}
} else if (*pt0 == (CELL)FunctorBigInt) {
} else {
TrailTerm(dest) = trail_cell;
/* be careful with partial gc */
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) {
curENV = (CELL *)(curENV[E_E]);
if (curENV < ASP || curENV >= LCL0)
if (curENV < ASP || curENV >= LCL0) {
break;
}
pe = EnvPreg(curCP);
if (pe==NULL) {
pe = PredMetaCall;

2
C/write.c
View File

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

2
H/ATOMS
View File

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

2
H/GLOBALS
View File

@ -116,7 +116,7 @@ char Executable[YAP_FILENAME_MAX] void
#endif
int OpaqueHandlersCount =0
struct opaque_handler_struct* OpaqueHandlers =NULL
struct YAP_opaque_handler_struct* OpaqueHandlers =NULL
#if __simplescalar__
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
#endif
/** opaque terms used to wake up on cut of call catcher meta-goal */
UInt setup_call_catcher_cleanup_tag void void
/* Operators */
struct operator_entry *OpList =NULL OpListAdjust

1
H/TermExt.h
View File

@ -96,6 +96,7 @@ typedef enum {
ARRAY_FLOAT = 0x22,
CLAUSE_LIST = 0x40,
EXTERNAL_BLOB = 0x100, /* generic data */
GOAL_CUT_POINT = 0x200,
USER_BLOB_START = 0x1000, /* user defined blob */
USER_BLOB_END = 0x1100 /* end of user defined blob */
} 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_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
#define INT_KEYS_DEFAULT_SIZE 256
#endif

8
H/Yapproto.h
View File

@ -107,10 +107,11 @@ extern int Yap_IsStringTerm(Term);
extern int Yap_IsWideStringTerm(Term);
extern Term Yap_RatTermToApplTerm(Term);
extern void Yap_InitBigNums(void);
extern Term Yap_AllocExternalDataInStack(CELL, size_t);
extern int Yap_CleanOpaqueVariable(CELL *);
extern Term Yap_AllocExternalDataInStack(CELL, size_t, CELL **);
extern int Yap_CleanOpaqueVariable(Term t);
extern CELL *Yap_HeapStoreOpaqueTerm(Term t);
extern size_t Yap_OpaqueTermToString(Term t, char *str, size_t max);
extern Int Yap_blob_tag(Term t);
/* c_interface.c */
#ifndef YAP_CPP_INTERFACE
@ -500,6 +501,9 @@ extern void Yap_init_optyap_preds(void);
// struct PL_local_data *Yap_InitThreadIO(int wid);
extern void Yap_flush(void);
extern X_API YAP_opaque_tag_t
YAP_NewOpaqueType(struct YAP_opaque_handler_struct *f);
/* pl-yap.c */
extern Int Yap_source_line_no(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 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 CUT_C_PUSH(YAMOP, S_YREG)
#define POP_CHOICE_POINT(cp) \
(((CELL *)Yap_REGS.CUT_C_TOP != (CELL *)LOCAL_LocalBase) && \
((CELL *)(cp) > (CELL *)Yap_REGS.CUT_C_TOP))
#define POP_CHOICE_POINT(cp) false
#define POP_EXECUTE()
#define POP_EXECUTE() \
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();
#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();
#define POP_FAIL(handler)
#define POP_FAIL_EXECUTE(handler)
/*Initializes CUT_C_TOP*/
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_
#endif
#define setup_call_catcher_cleanup_tag Yap_heap_regs->setup_call_catcher_cleanup_tag_
#define OpList Yap_heap_regs->OpList_
#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];
#endif
EXTERNAL int GLOBAL_OpaqueHandlersCount;
EXTERNAL struct opaque_handler_struct* GLOBAL_OpaqueHandlers;
EXTERNAL struct YAP_opaque_handler_struct* GLOBAL_OpaqueHandlers;
#if __simplescalar__
EXTERNAL char GLOBAL_pwd[YAP_FILENAME_MAX];
#endif

2
H/generated/h0struct.h
View File

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

2
H/generated/hglobals.h
View File

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

2
H/generated/hstruct.h
View File

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

2
H/generated/iatoms.h
View File

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

2
H/generated/ihstruct.h
View File

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

2
H/generated/ratoms.h
View File

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

2
H/generated/rhstruct.h
View File

@ -270,6 +270,8 @@
#endif
OpList = OpListAdjust(OpList);
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 AtomException; X_API EXTERNAL Term TermException;
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 AtomEvaluationError; X_API EXTERNAL Term TermEvaluationError;
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 FunctorExternalException;
X_API EXTERNAL Functor FunctorFunctor;
X_API EXTERNAL Functor FunctorGAtom;

38
H/trim_trail.h
View File

@ -19,7 +19,8 @@
#ifdef LIMIT_TABLING
if ((ADDR)pt == LOCAL_TrailBase) {
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);
} else
#endif /* LIMIT_TABLING */
@ -27,12 +28,18 @@
/* skip, this is a problem because we lose information,
namely active references */
pt1 = (tr_fr_ptr)pt;
} else if (IN_BETWEEN(H0,pt,HR) && IsAttVar(pt)) {
CELL val = Deref(*pt);
if (IsVarTerm(val)) {
YapBind(pt, MkAtomTerm(AtomCut));
Yap_WakeUp(pt);
} else if (IN_BETWEEN(H0, pt, HR) && IsApplTerm(HeadOfTerm(d1))) {
Term t = HeadOfTerm(d1);
Functor f = FunctorOfTerm(t);
if (f == FunctorBigInt) {
Int tag = Yap_blob_tag(t) - USER_BLOB_START;
RESET_VARIABLE(&TrailTerm(pt1));
GLOBAL_OpaqueHandlers[tag].cut_handler(d1);
} else {
pt0--;
}
pt1--;
continue;
} else if ((*pt & (LogUpdMask | IndexMask)) == (LogUpdMask | IndexMask)) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
int erase;
@ -128,13 +135,15 @@
} else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1);
if (IN_BETWEEN(H0,pt,HR) && IsAttVar(pt)) {
CELL val = Deref(*pt);
if (IsVarTerm(val)) {
YapBind(VarOfTerm(val), MkAtomTerm(AtomCut));
Yap_WakeUp(pt);
}
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
else if (IN_BETWEEN(H0, pt, HR) && IsApplTerm(HeadOfTerm(d1))) {
Term t = HeadOfTerm(d1);
Functor f = FunctorOfTerm(t);
if (f == FunctorBigInt) {
RESET_VARIABLE(&TrailTerm(pt1));
Int tag = Yap_blob_tag(t);
GLOBAL_OpaqueHandlers[tag].cut_handler(d1);
} else if ((*pt & (LogUpdMask | IndexMask)) ==
(LogUpdMask | IndexMask)) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
#if defined(YAPOR) || defined(THREADS)
PredEntry *ap = cl->ClPred;
@ -159,7 +168,8 @@
pt0++;
}
pt1++;
} else {
}
else {
TrailTerm(pt0) = d1;
pt0++;
pt1++;

3
pl/boot.yap
View File

@ -854,8 +854,8 @@ number of steps.
format(user_error,'.~n', []).
'$another' :-
'$clear_input'(user_input),
format(user_error,' ? ',[]),
'$clear_input'(user_input),
get_code(user_input,C),
'$do_another'(C).
@ -1399,7 +1399,6 @@ Command = (H --> B) ->
'$enter_command'(Stream, Mod, Status) :-
'$clear_input'(Stream),
prompt1(': '), prompt(_,' '),
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) :-
setup_call_catcher_cleanup(true, 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_)
@ -285,6 +287,11 @@ finally undone by _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),
call_cleanup(Goal, Catcher, Cleanup).
/** @pred call_with_args(+ _Name_,...,? _Ai_,...)