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

stabilisation patches for Yap-4.5.2

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@922 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-11-12 12:33:31 +00:00
parent ab1a1a0219
commit 1ada44ab8e
21 changed files with 663 additions and 299 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
C/absmi.c
View File

@ -1170,7 +1170,7 @@ Yap_absmi(int inp)
#else
{
LogUpdClause *cl = (LogUpdClause *)PREG->u.EC.ClBase;
if (!(cl->ClFlags |= InUseMask)) {
if (!(cl->ClFlags & InUseMask)) {
/* Clause *cl = (Clause *)PREG->u.EC.ClBase;
PREG->u.EC.ClTrail = TR-(tr_fr_ptr)Yap_TrailBase;
@ -1215,7 +1215,7 @@ Yap_absmi(int inp)
TRAIL_CLREF(cl);
UNLOCK(cl->ClLock);
#else
if (!(cl->ClFlags |= InUseMask)) {
if (!(cl->ClFlags & InUseMask)) {
/* Clause *cl = (Clause *)PREG->u.EC.ClBase;
PREG->u.EC.ClTrail = TR-(tr_fr_ptr)Yap_TrailBase;
@ -1260,7 +1260,7 @@ Yap_absmi(int inp)
TRAIL_CLREF(cl);
UNLOCK(cl->ClLock);
#else
if (!(cl->ClFlags |= InUseMask)) {
if (!(cl->ClFlags & InUseMask)) {
/* Clause *cl = (Clause *)PREG->u.EC.ClBase;
PREG->u.EC.ClTrail = TR-(tr_fr_ptr)Yap_TrailBase;
@ -1449,7 +1449,6 @@ Yap_absmi(int inp)
register tr_fr_ptr pt0 = TR;
PREG = B->cp_ap;
CACHE_TR(B->cp_tr);
RESTORE_TR();
PREFETCH_OP(PREG);
failloop:
if (pt0 == S_TR) {
@ -1566,6 +1565,7 @@ Yap_absmi(int inp)
}
}
#endif /* LOW_LEVEL_TRACER */
RESTORE_TR();
GONext();
}
BEGD(d1);

2
C/adtdefs.c
View File

@ -460,8 +460,6 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, SMALLUNSGN cur_mod)
Prop p0;
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
extern long long int vsc_count;
INIT_RWLOCK(p->PRWLock);
p->KindOfPE = PEProp;
p->ArityOfPE = fe->ArityOfFE;

66
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.40 2003-11-07 16:31:08 ricroc Exp $ *
* version:$Id: alloc.c,v 1.41 2003-11-12 12:33:30 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -149,6 +149,14 @@ FreeBlock(BlockHeader *b)
BlockHeader *p;
YAP_SEG_SIZE *sp;
/* {
static long long int vsc_free_ops;
vsc_free_ops++;
BlockHeader *q = FreeBlocks;
while (q) q = q->b_next_size;
}*/
/* sanity check */
sp = &(b->b_size) + (b->b_size & ~InUseFlag);
if (*sp != b->b_size) {
@ -231,6 +239,13 @@ AllocHeap(unsigned int size)
BlockHeader *b, *n;
YAP_SEG_SIZE *sp;
/* {
static long long int vsc_alloc_ops;
vsc_alloc_ops++;
BlockHeader *q = FreeBlocks;
while (q) q = q->b_next_size;
}*/
size += 2*sizeof(YAP_SEG_SIZE);
#if SIZEOF_INT_P==4
size = (((size + 7) & 0xfffffff8L) >> 2); /* size in dwords + 2 */
@ -595,10 +610,12 @@ ExtendWorkSpace(Int s, int fixed_allocation)
abort_optyap("function ExtendWorkSpace called");
return(FALSE);
#else
MALLOC_T a;
prolog_exec_mode OldPrologMode = Yap_PrologMode;
MALLOC_T base = WorkSpaceTop;
#if !defined(_AIX) || !defined(__hpux) || !defined(__APPLE__)
int fd;
#endif
if (fixed_allocation == MAP_FIXED)
base = WorkSpaceTop;
@ -615,32 +632,31 @@ ExtendWorkSpace(Int s, int fixed_allocation)
a = mmap(base, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANON | fixed_allocation, -1, 0);
#else
int fd;
Yap_PrologMode = ExtendStackMode;
fd = open("/dev/zero", O_RDWR);
if (fd < 0) {
Yap_PrologMode = ExtendStackMode;
fd = open("/dev/zero", O_RDWR);
if (fd < 0) {
#if HAVE_MKSTEMP
char file[256];
strncpy(file,"/tmp/YAP.TMPXXXXXX",256);
if (mkstemp(file) == -1) {
Yap_ErrorMessage = Yap_ErrorSay;
char file[256];
strncpy(file,"/tmp/YAP.TMPXXXXXX",256);
if (mkstemp(file) == -1) {
Yap_ErrorMessage = Yap_ErrorSay;
#if HAVE_STRERROR
snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mkstemp could not create temporary file %s (%s)",
file, strerror(errno));
snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mkstemp could not create temporary file %s (%s)",
file, strerror(errno));
#else
snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mkstemp could not create temporary file %s", file);
snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mkstemp could not create temporary file %s", file);
#endif /* HAVE_STRERROR */
Yap_PrologMode = OldPrologMode;
return FALSE;
}
Yap_PrologMode = OldPrologMode;
return FALSE;
}
#else
#if HAVE_TMPNAM
char *file = tmpnam(NULL);
char *file = tmpnam(NULL);
#else
char file[YAP_FILENAME_MAX];
strcpy(file,"/tmp/mapfile");
char file[YAP_FILENAME_MAX];
strcpy(file,"/tmp/mapfile");
itos(getpid(), &file[12]);
#endif /* HAVE_TMPNAM */
#endif /* HAVE_MKSTEMP */
@ -773,7 +789,7 @@ InitWorkSpace(Int s)
}
static int
ExtendWorkSpace(Int s, int fixed_allocation)
ExtendWorkSpace(Int s)
{
MALLOC_T ptr;
int shm_id;
@ -849,7 +865,7 @@ InitWorkSpace(Int s)
}
static int
ExtendWorkSpace(Int s, fixed_allocation)
ExtendWorkSpace(Int s)
{
MALLOC_T ptr = (MALLOC_T)sbrk(s);
prolog_exec_mode OldPrologMode = Yap_PrologMode;
@ -979,7 +995,7 @@ InitWorkSpace(Int s)
}
static int
ExtendWorkSpace(Int s, int fixed_allocation)
ExtendWorkSpace(Int s)
{
MALLOC_T ptr;
prolog_exec_mode OldPrologMode = Yap_PrologMode;
@ -1133,6 +1149,7 @@ Yap_ExtendWorkSpaceThroughHole(UInt s)
void
Yap_AllocHole(UInt actual_request, UInt total_size)
{
#if USE_MMAP
/* where we were when the hole was created,
also where is the hole store */
ADDR WorkSpaceTop0 = WorkSpaceTop-total_size;
@ -1149,4 +1166,5 @@ Yap_AllocHole(UInt actual_request, UInt total_size)
(HeapTop-WorkSpaceTop0)/sizeof(YAP_SEG_SIZE) | InUseFlag;
newb->b_size = bsiz;
AddToFreeList(newb);
#endif
}

138
C/cdmgr.c
View File

@ -256,28 +256,19 @@ decrease_ref_counter(yamop *ptr, yamop *b, yamop *e, yamop *sc)
LogUpdClause *cl = ClauseCodeToLogUpdClause(ptr);
LOCK(cl->ClLock);
cl->ClRefCount--;
if (cl->ClFlags & ErasedMask &&
!(cl->ClRefCount) &&
!(cl->ClFlags & InUseMask)) {
/* last ref to the clause */
Yap_ErLogUpdCl(cl);
}
UNLOCK(cl->ClLock);
}
}
static void
decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code)
{
/* decrease all reference counters */
yamop *beg = c->ClCode, *end, *ipc;
op_numbers op;
if (c->ClFlags & SwitchTableMask) {
return;
}
op = Yap_op_from_opcode(beg->opc);
if ((op == _enter_lu_pred ||
op == _stale_lu_index) &&
beg->u.Ill.l1 != beg->u.Ill.l2) {
end = beg->u.Ill.l2;
} else {
end = (yamop *)((CODEADDR)c+Yap_SizeOfBlock((CODEADDR)c));
}
ipc = beg;
while (ipc < end) {
op_numbers op = Yap_op_from_opcode(ipc->opc);
/* printf("op: %d %p->%p\n", op, ipc, end); */
@ -365,6 +356,33 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
}
}
void
Yap_cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *sc)
{
cleanup_dangling_indices(ipc, beg, end, sc);
}
static void
decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
{
/* decrease all reference counters */
yamop *beg = c->ClCode, *end, *ipc;
op_numbers op;
if (c->ClFlags & SwitchTableMask) {
return;
}
op = Yap_op_from_opcode(beg->opc);
if ((op == _enter_lu_pred ||
op == _stale_lu_index) &&
beg->u.Ill.l1 != beg->u.Ill.l2) {
end = beg->u.Ill.l2;
} else {
end = (yamop *)((CODEADDR)c+Yap_SizeOfBlock((CODEADDR)c));
}
ipc = beg;
cleanup_dangling_indices(ipc, beg, end, suspend_code);
}
static void
kill_static_child_indxs(StaticIndex *indx)
{
@ -420,8 +438,24 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
}
}
decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
#ifdef DEBUG
{
LogUpdIndex *cl = DBErasedIList, *c0 = NULL;
while (cl != NULL) {
if (c == cl) {
if (c0) c0->SiblingIndex = c->SiblingIndex;
else DBErasedIList = c->SiblingIndex;
}
cl = cl->SiblingIndex;
}
}
#endif
Yap_FreeCodeSpace((CODEADDR)c);
} else {
#ifdef DEBUG
c->SiblingIndex = DBErasedIList;
DBErasedIList = c;
#endif
c->ClFlags |= ErasedMask;
/* try to move up, so that we don't hold an index */
if (cl != NULL &&
@ -1871,10 +1905,10 @@ p_is_dynamic(void)
return (FALSE);
} else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
pe = RepPredProp(PredPropByAtom(at, mod));
pe = RepPredProp(Yap_GetPredPropByAtom(at, mod));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
pe = RepPredProp(PredPropByFunc(fun, mod));
pe = RepPredProp(Yap_GetPredPropByFunc(fun, mod));
} else
return (FALSE);
if (pe == NIL)
@ -2397,7 +2431,7 @@ all_calls(void)
ts[0] = MkIntegerTerm((Int)P);
if (yap_flags[STACK_DUMP_ON_ERROR_FLAG]) {
ts[1] = all_envs(ENV);
ts[1] = all_cps(B);
ts[2] = all_cps(B);
} else {
ts[1] = ts[2] = TermNil;
}
@ -3196,6 +3230,71 @@ Yap_dump_code_area_for_profiler(void) {
#endif /* LOW_PROF */
static UInt
index_ssz(StaticIndex *x)
{
UInt sz = Yap_SizeOfBlock((CODEADDR)x);
x = x->ChildIndex;
while (x != NULL) {
sz += index_ssz(x);
x = x->SiblingIndex;
}
return sz;
}
static Int
static_statistics(PredEntry *pe)
{
UInt sz = 0, cls = 0, isz = 0;
StaticClause *cl;
yamop *ipc = pe->cs.p_code.FirstClause;
if (ipc != NULL) {
do {
cl = ClauseCodeToStaticClause(ipc);
cls++;
sz += Yap_SizeOfBlock((CODEADDR)cl);
if (ipc == pe->cs.p_code.LastClause)
break;
ipc = NextClause(ipc);
} while (TRUE);
}
if (pe->cs.p_code.NOfClauses > 1 &&
pe->cs.p_code.TrueCodeOfPred != pe->cs.p_code.FirstClause) {
isz = index_ssz(ClauseCodeToStaticIndex(pe->cs.p_code.TrueCodeOfPred));
}
return Yap_unify(ARG3, MkIntegerTerm(cls)) &&
Yap_unify(ARG4, MkIntegerTerm(sz)) &&
Yap_unify(ARG5, MkIntegerTerm(isz));
}
static Int
p_static_pred_statistics(void)
{
Term t = Deref(ARG1);
Term tmod = Deref(ARG2);
SMALLUNSGN mod = Yap_LookupModule(tmod);
PredEntry *pe;
if (IsVarTerm(t)) {
return (FALSE);
} else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
pe = RepPredProp(Yap_GetPredPropByAtom(at, mod));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
pe = RepPredProp(Yap_GetPredPropByFunc(fun, mod));
} else
return (FALSE);
if (pe == NIL)
return (FALSE);
if (pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|UserCPredFlag|AsmPredFlag|CPredFlag|BinaryTestPredFlag)) {
/* should use '$recordedp' in this case */
return FALSE;
}
return static_statistics(pe);
}
void
Yap_InitCdMgr(void)
@ -3247,5 +3346,6 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$continue_log_update_clause", 4, p_continue_log_update_clause0, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$log_update_retract", 3, p_log_update_retract, SyncPredFlag);
Yap_InitCPred("$continue_log_update_retract", 4, p_continue_log_update_retract, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag);
}

409
C/dbase.c
View File

@ -25,6 +25,10 @@ static char SccsId[] = "%W% %G%";
#if HAVE_STRING_H
#include <string.h>
#endif
#if HAVE_STRING_H
#include <string.h>
#endif
#include <stdlib.h>
/* There are two options to implement traditional immediate update semantics.
@ -199,7 +203,7 @@ STATIC_PROTO(CELL *MkDBTerm, (CELL *, CELL *, CELL *, CELL *, CELL *, CELL *,in
#else
STATIC_PROTO(CELL *MkDBTerm, (CELL *, CELL *, CELL *, CELL *, CELL *, int *));
#endif
STATIC_PROTO(DBRef CreateDBStruct, (Term, DBProp, int, int *));
STATIC_PROTO(DBRef CreateDBStruct, (Term, DBProp, int, int *, UInt));
STATIC_PROTO(DBRef record, (int, Term, Term, Term));
STATIC_PROTO(DBRef check_if_cons, (DBRef, Term));
STATIC_PROTO(DBRef check_if_var, (DBRef));
@ -214,8 +218,6 @@ STATIC_PROTO(Int p_rcdz, (void));
STATIC_PROTO(Int p_rcdzp, (void));
STATIC_PROTO(Int p_drcdap, (void));
STATIC_PROTO(Int p_drcdzp, (void));
STATIC_PROTO(Int p_rcdaifnot, (void));
STATIC_PROTO(Int p_rcdzifnot, (void));
STATIC_PROTO(Term GetDBTerm, (DBTerm *));
STATIC_PROTO(DBProp FetchDBPropFromKey, (Term, int, int, char *));
STATIC_PROTO(Int i_recorded, (DBProp,Term));
@ -1138,6 +1140,7 @@ check_if_wvars(DBRef p, unsigned int NOfCells, CELL *BTptr)
}
#ifdef IDB_LINK_TABLE
static int
scheckcells(int NOfCells, register CELL *m1, register CELL *m2, link_entry *lp, register CELL bp)
{
@ -1248,23 +1251,43 @@ CreateDBWithDBRef(Term Tm, DBProp p)
}
static DBTerm *
CreateDBTermForVarOrAtom(Term Tm) {
DBTerm *ppt = (DBTerm *)AllocDBSpace(sizeof(DBTerm));
CreateDBTermForAtom(Term Tm, UInt extra_size) {
DBTerm *ppt;
ADDR ptr;
if (ppt == NULL) {
ptr = (ADDR)AllocDBSpace(extra_size+sizeof(DBTerm));
if (ptr == NULL) {
return (DBTerm *)generate_dberror_msg(OTHER_ERROR_IN_DB, 0, "could not allocate space");
}
ppt = (DBTerm *)(ptr+extra_size);
ppt->NOfCells = 0;
ppt->DBRefs = NULL;
#ifdef COROUTINING
ppt->attachments = 0;
#endif
ppt->DBRefs = NULL;
if (IsVarTerm(Tm)) {
ppt->Entry = 0L;
} else {
ppt->Entry = Tm;
ppt->Entry = Tm;
return ppt;
}
static DBTerm *
CreateDBTermForVar(UInt extra_size)
{
DBTerm *ppt;
ADDR ptr;
ptr = (ADDR)AllocDBSpace(extra_size+sizeof(DBTerm));
if (ptr == NULL) {
return (DBTerm *)generate_dberror_msg(OTHER_ERROR_IN_DB, 0, "could not allocate space");
}
ppt = (DBTerm *)(ptr+extra_size);
ppt->NOfCells = 0;
ppt->DBRefs = NULL;
#ifdef COROUTINING
ppt->attachments = 0;
#endif
ppt->DBRefs = NULL;
ppt->Entry = (CELL)(&(ppt->Entry));
return ppt;
}
@ -1285,7 +1308,7 @@ CreateDBRefForAtom(Term Tm, DBProp p, int InFlag) {
INIT_DBREF_COUNT(pp);
pp->Flags = flag;
pp->Code = NULL;
pp->DBT.Entry = (CELL) Tm;
pp->DBT.Entry = Tm;
pp->DBT.DBRefs = NULL;
pp->DBT.NOfCells = 0;
#ifdef COROUTINING
@ -1319,7 +1342,7 @@ CreateDBRefForVar(Term Tm, DBProp p, int InFlag) {
}
static DBRef
CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat)
CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
{
Register Term tt, *nar = NIL;
SMALLUNSGN flag;
@ -1333,19 +1356,35 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat)
DBErrorFlag = NO_ERROR_IN_DB;
if (p == NULL && ( IsVarTerm(Tm) || IsAtomOrIntTerm(Tm))) {
return (DBRef)CreateDBTermForVarOrAtom(Tm);
}
if (IsVarTerm(Tm)
if (p == NULL) {
if (IsVarTerm(Tm)) {
#ifdef COROUTINING
if (!SafeIsAttachedTerm(Tm)) {
#endif
DBRef out = (DBRef)CreateDBTermForVar(extra_size);
*pstat = TRUE;
return out;
#ifdef COROUTINING
}
#endif
} else if (IsAtomOrIntTerm(Tm)) {
DBRef out = (DBRef)CreateDBTermForAtom(Tm, extra_size);
*pstat = FALSE;
return out;
}
} else {
if (IsVarTerm(Tm)
#ifdef COROUTINING
&& !SafeIsAttachedTerm(Tm)
#endif
) {
*pstat = TRUE;
return CreateDBRefForVar(Tm, p, InFlag);
} else if (IsAtomOrIntTerm(Tm)) {
return CreateDBRefForAtom(Tm, p, InFlag);
} else {
*pstat = TRUE;
return CreateDBRefForVar(Tm, p, InFlag);
} else if (IsAtomOrIntTerm(Tm)) {
return CreateDBRefForAtom(Tm, p, InFlag);
}
}
{
DBTerm *ppt, *ppt0;
DBRef pp, pp0;
Term *ntp0, *ntp;
@ -1358,7 +1397,8 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat)
/* compound term */
if (p == NULL) {
ppt0 = (DBTerm *)Yap_PreAllocCodeSpace();
ADDR ptr = Yap_PreAllocCodeSpace();
ppt0 = (DBTerm *)(ptr+extra_size);
pp0 = (DBRef)ppt0;
} else {
pp0 = (DBRef)Yap_PreAllocCodeSpace();
@ -1497,7 +1537,8 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat)
#endif
#endif
if (p == NULL) {
ppt = (DBTerm *)AllocDBSpace(DBLength(CodeAbs));
ADDR ptr = Yap_AllocCodeSpace((CELL)CodeAbs+extra_size+sizeof(DBTerm));
ppt = (DBTerm *)(ptr+extra_size);
if (ppt == NULL) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return generate_dberror_msg(OVF_ERROR_IN_DB, (UInt)DBLength(CodeAbs), "heap crashed against stacks");
@ -1609,7 +1650,7 @@ record(int Flag, Term key, Term t_data, Term t_code)
if (EndOfPAEntr(p = FetchDBPropFromKey(twork, Flag & MkCode, TRUE, "record/3"))) {
return(NULL);
}
if ((x = CreateDBStruct(t_data, p, Flag, &needs_vars)) == NULL) {
if ((x = CreateDBStruct(t_data, p, Flag, &needs_vars, 0)) == NULL) {
return (NULL);
}
if ((Flag & MkIfNot) && found_one)
@ -1682,7 +1723,7 @@ record_at(int Flag, DBRef r0, Term t_data, Term t_code)
FathersPlace = NIL;
#endif
p = r0->Parent;
if ((x = CreateDBStruct(t_data, p, Flag, &needs_vars)) == NULL) {
if ((x = CreateDBStruct(t_data, p, Flag, &needs_vars, 0)) == NULL) {
return (NULL);
}
TRAIL_REF(x);
@ -1757,13 +1798,11 @@ record_lu(PredEntry *pe, Term t, int position)
LogUpdClause *cl;
int needs_vars = FALSE;
if ((x = (DBTerm *)CreateDBStruct(t, NULL, 0, &needs_vars)) == NULL) {
ipc = NEXTOP(((LogUpdClause *)NULL)->ClCode,e);
if ((x = (DBTerm *)CreateDBStruct(t, NULL, 0, &needs_vars, (UInt)ipc)) == NULL) {
return NULL; /* crash */
}
/* we've got the term */
ipc = NEXTOP(((LogUpdClause *)NULL)->ClCode,e);
if ((cl = (LogUpdClause *)Yap_AllocCodeSpace((UInt)ipc)) == NULL)
return NULL;
cl = (LogUpdClause *)((ADDR)x-(UInt)ipc);
ipc = cl->ClCode;
cl->Id = FunctorDBRef;
cl->ClFlags = LogUpdMask;
@ -1802,7 +1841,7 @@ p_rcda(void)
if (pe) {
LogUpdClause *cl = record_lu(pe, t2, MkFirst);
if (cl != NULL) {
TRAIL_REF((DBRef)cl);
TRAIL_CLREF(cl);
cl->ClFlags |= InUseMask;
TRef = MkDBRefTerm((DBRef)cl);
} else {
@ -1945,7 +1984,7 @@ p_rcdz(void)
if (pe) {
LogUpdClause *cl = record_lu(pe, t2, MkLast);
if (cl != NULL) {
TRAIL_REF((DBRef)cl);
TRAIL_CLREF(cl);
cl->ClFlags |= InUseMask;
TRef = MkDBRefTerm((DBRef)cl);
} else {
@ -2208,91 +2247,70 @@ p_drcdzp(void)
goto restart_record;
}
/* '$recordaifnot'(+Functor,+Term,-Ref) */
static Int
p_rcdaifnot(void)
static Int
p_still_variant(void)
{
Term TRef;
DBRef db_ref;
restart_record:
Yap_Error_Size = 0;
if (!IsVarTerm(Deref(ARG3)))
return (FALSE);
found_one = NIL;
db_ref = record(MkFirst | MkIfNot, Deref(ARG1), Deref(ARG2), Unsigned(0));
if (db_ref == NULL)
return(FALSE);
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
TRef = MkDBRefTerm(db_ref);
return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
CELL *old_h = B->cp_h;
tr_fr_ptr old_tr = B->cp_tr;
Term t1 = Deref(ARG1), t2 = Deref(ARG2);
DBTerm *dbt;
DBRef dbr;
if (IsVarTerm(t1) || !IsDBRefTerm(t1)) {
if (IsIntegerTerm(t1))
dbr = (DBRef)IntegerOfTerm(t1);
else
return (FALSE);
/* limited sanity checking */
if (dbr->id != FunctorDBRef) {
return FALSE;
}
goto recover_record;
case TOVF_ERROR_IN_DB:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OVF_ERROR_IN_DB:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg);
return(FALSE);
} else {
dbr = DBRefOfTerm(t1);
}
recover_record:
DBErrorFlag = NO_ERROR_IN_DB;
goto restart_record;
/* ok, we assume there was a choicepoint before we copied the term */
if (dbr->Flags & LogUpdMask) {
LogUpdClause *cl = (LogUpdClause *)dbr;
if (old_tr != TR-2)
return FALSE;
if (Yap_op_from_opcode(cl->ClCode->opc) == _unify_idb_term) {
return TRUE;
} else {
dbt = cl->ClSource;
}
} else {
if (old_tr != TR-2)
return FALSE;
if (dbr->Flags & (DBNoVars|DBAtomic))
return TRUE;
if (dbr->Flags & DBVar)
return IsVarTerm(t2);
dbt = &(dbr->DBT);
}
#ifdef IDB_LINK_TABLE
{
link_entry *lp = (link_entry *)(dbt->Contents+dbt->NOfCells);
link_entry link;
while ((link = *lp++)) {
Term t2 = Deref(old_h[link-1]);
if (IsUnboundVar((CELL)(dbt->Contents+(link-1)))) {
if (IsVarTerm(t2)) {
Yap_unify(t2,MkAtomTerm(AtomFoundVar));
} else {
return FALSE;
}
}
}
}
#else /* IDB_LINK_TABLE */
not IMPLEMENTED;
#endif
return TRUE;
}
/* '$recordzifnot'(+Functor,+Term,-Ref) */
static Int
p_rcdzifnot(void)
{
Term TRef;
DBRef db_ref;
restart_record:
Yap_Error_Size = 0;
if (!IsVarTerm(Deref(ARG3)))
return (FALSE);
found_one = NIL;
db_ref = record(MkLast | MkIfNot, Deref(ARG1), Deref(ARG2), Unsigned(0));
if (db_ref == NULL)
return(FALSE);
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
TRef = MkDBRefTerm(db_ref);
return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
goto recover_record;
case TOVF_ERROR_IN_DB:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OVF_ERROR_IN_DB:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg);
return(FALSE);
}
recover_record:
DBErrorFlag = NO_ERROR_IN_DB;
goto restart_record;
}
#ifdef COROUTINING
static void
@ -3235,15 +3253,15 @@ lu_recorded(PredEntry *pe) {
} else {
CP = P;
P = pe->CodeOfPred;
if (pe->PredFlags & ProfiledPredFlag) {
LOCK(pe->StatisticsForPred.lock);
pe->StatisticsForPred.NOfEntries++;
UNLOCK(pe->StatisticsForPred.lock);
}
ENV = YENV;
YENV = ASP;
YENV[E_CB] = (CELL) B;
}
if (pe->PredFlags & ProfiledPredFlag) {
LOCK(pe->StatisticsForPred.lock);
pe->StatisticsForPred.NOfEntries++;
UNLOCK(pe->StatisticsForPred.lock);
}
return TRUE;
}
@ -3468,8 +3486,10 @@ lu_statistics(PredEntry *pe)
while (x != NULL) {
cls++;
sz += Yap_SizeOfBlock((CODEADDR)x);
if (x->ClSource != NULL)
sz += Yap_SizeOfBlock((CODEADDR)x->ClSource);
if (pe->ModuleOfPred != 2 &&
x->ClSource != NULL) {
sz += Yap_SizeOfBlock((CODEADDR)(x->ClSource));
}
x = x->ClNext;
}
}
@ -3506,6 +3526,10 @@ p_key_statistics(void)
while (x != NULL) {
cls++;
sz += Yap_SizeOfBlock((CODEADDR)x);
if (x->Code) {
DynamicClause *cl = ClauseCodeToDynamicClause(x->Code);
sz += Yap_SizeOfBlock((CODEADDR)cl);
}
x = NextDBRef(x);
}
return
@ -3514,6 +3538,81 @@ p_key_statistics(void)
Yap_unify(ARG4,MkIntTerm(0));
}
#ifdef DEBUG
static Int
p_total_erased(void)
{
UInt sz = 0, cls = 0;
UInt isz = 0, icls = 0;
LogUpdClause *cl = DBErasedList;
LogUpdIndex *icl = DBErasedIList;
/* only for log upds */
while (cl) {
cls++;
sz += Yap_SizeOfBlock((CODEADDR)cl);
cl = cl->ClNext;
}
while (icl) {
icls++;
isz += Yap_SizeOfBlock((CODEADDR)icl);
icl = icl->SiblingIndex;
}
return
Yap_unify(ARG1,MkIntegerTerm(cls)) &&
Yap_unify(ARG2,MkIntegerTerm(sz)) &&
Yap_unify(ARG3,MkIntegerTerm(icls)) &&
Yap_unify(ARG4,MkIntegerTerm(isz));
}
static Int
p_key_erased_statistics(void)
{
UInt sz = 0, cls = 0;
UInt isz = 0, icls = 0;
Term twork = Deref(ARG1);
PredEntry *pe;
LogUpdClause *cl = DBErasedList;
LogUpdIndex *icl = DBErasedIList;
/* only for log upds */
if ((pe = find_lu_entry(twork)) == NULL)
return FALSE;
while (cl) {
if (cl->ClPred == pe) {
cls++;
sz += Yap_SizeOfBlock((CODEADDR)cl);
}
cl = cl->ClNext;
}
while (icl) {
LogUpdIndex *c = icl;
while (!c->ClFlags & SwitchRootMask)
c = c->u.ParentIndex;
if (pe == c->u.pred) {
icls++;
isz += Yap_SizeOfBlock((CODEADDR)icl);
}
icl = icl->SiblingIndex;
}
return
Yap_unify(ARG2,MkIntegerTerm(cls)) &&
Yap_unify(ARG3,MkIntegerTerm(sz)) &&
Yap_unify(ARG4,MkIntegerTerm(icls)) &&
Yap_unify(ARG5,MkIntegerTerm(isz));
}
static Int
p_heap_space_info(void)
{
return
Yap_unify(ARG1,MkIntegerTerm(HeapUsed)) &&
Yap_unify(ARG2,MkIntegerTerm(HeapMax-HeapUsed));
}
#endif
/*
* This is called when we are erasing a data base clause, because we may have
@ -3671,13 +3770,54 @@ p_jump_to_next_dynamic_clause(void)
static void
complete_lu_erase(LogUpdClause *clau)
{
if (CL_IN_USE(clau))
DBRef *cp = clau->ClSource->DBRefs;
if (CL_IN_USE(clau)) {
return;
}
if (clau->ClFlags & LogUpdRuleMask &&
clau->ClExt->u.EC.ClRefs > 0) {
return;
}
ReleaseTermFromDB(clau->ClSource);
if (clau->ClPred->ModuleOfPred != 2)
ReleaseTermFromDB(clau->ClSource);
#ifdef DEBUG
if (clau->ClNext)
clau->ClNext->ClPrev = clau->ClPrev;
if (clau->ClPrev) {
clau->ClPrev->ClNext = clau->ClNext;
} else {
DBErasedList = clau->ClNext;
}
#endif
if (cp != NULL) {
DBRef ref;
while ((ref = *--cp) != NIL) {
if (ref->Flags & LogUpdMask) {
LogUpdClause *cl = (LogUpdClause *)ref;
LOCK(cl->ClLock);
cl->ClRefCount--;
if (cl->ClFlags & ErasedMask &&
!(cl->ClFlags & InUseMask) &&
!(cl->ClRefCount)) {
UNLOCK(cl->ClLock);
EraseLogUpdCl(cl);
} else {
UNLOCK(cl->ClLock);
}
} else {
LOCK(ref->lock);
ref->NOfRefsTo--;
if (ref->Flags & ErasedMask &&
!(ref->Flags & InUseMask) &&
ref->NOfRefsTo) {
UNLOCK(ref->lock);
ErDBE(ref);
} else {
UNLOCK(ref->lock);
}
}
}
}
Yap_FreeCodeSpace((char *)clau);
}
@ -3686,6 +3826,7 @@ EraseLogUpdCl(LogUpdClause *clau)
{
/* no need to erase what has been erased */
if (!(clau->ClFlags & ErasedMask)) {
/* get ourselves out of the list */
if (clau->ClNext != NULL) {
clau->ClNext->ClPrev = clau->ClPrev;
@ -3709,6 +3850,19 @@ EraseLogUpdCl(LogUpdClause *clau)
}
clau->ClFlags |= ErasedMask;
clau->ClPred->cs.p_code.NOfClauses--;
#ifdef DEBUG
{
LogUpdClause *er_head = DBErasedList;
if (er_head == NULL) {
clau->ClPrev = clau->ClNext = NULL;
} else {
clau->ClNext = er_head;
er_head->ClPrev = clau;
clau->ClPrev = NULL;
}
DBErasedList = clau;
}
#endif
Yap_RemoveClauseFromIndex(clau->ClPred, clau->ClCode);
}
complete_lu_erase(clau);
@ -3980,6 +4134,7 @@ p_eraseall(void)
Yap_ErLogUpdCl(cl);
cl = ncl;
} while (cl != NULL);
return TRUE;
}
if (EndOfPAEntr(p = FetchDBPropFromKey(twork, 0, FALSE, "eraseall/3"))) {
return(TRUE);
@ -4319,7 +4474,7 @@ StoreTermInDB(Term t, int nargs)
Yap_Error_Size = 0;
while ((x = (DBTerm *)CreateDBStruct(t, (DBProp)NULL,
InQueue, &needs_vars)) == NULL) {
InQueue, &needs_vars, 0)) == NULL) {
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
#ifdef DEBUG
@ -4589,14 +4744,15 @@ Yap_InitDBPreds(void)
Yap_InitCPred("recorded", 3, p_recorded, SyncPredFlag);
Yap_InitCPred("recorda", 3, p_rcda, SyncPredFlag);
Yap_InitCPred("recordz", 3, p_rcdz, SyncPredFlag);
Yap_InitCPred("$still_variant", 2, p_still_variant, SyncPredFlag);
Yap_InitCPred("recorda_at", 3, p_rcda_at, SyncPredFlag);
Yap_InitCPred("recordz_at", 3, p_rcdz_at, SyncPredFlag);
Yap_InitCPred("$recordap", 3, p_rcdap, SyncPredFlag);
Yap_InitCPred("$recordzp", 3, p_rcdzp, SyncPredFlag);
Yap_InitCPred("$recordap", 4, p_drcdap, SyncPredFlag);
Yap_InitCPred("$recordzp", 4, p_drcdzp, SyncPredFlag);
Yap_InitCPred("$recordaifnot", 3, p_rcdaifnot, SyncPredFlag);
Yap_InitCPred("$recordzifnot", 3, p_rcdzifnot, SyncPredFlag);
// Yap_InitCPred("$recordaifnot", 3, p_rcdaifnot, SyncPredFlag);
// Yap_InitCPred("$recordzifnot", 3, p_rcdzifnot, SyncPredFlag);
Yap_InitCPred("erase", 1, p_erase, SafePredFlag|SyncPredFlag);
Yap_InitCPred("erased", 1, p_erased, TestPredFlag | SafePredFlag|SyncPredFlag);
Yap_InitCPred("instance", 2, p_instance, SyncPredFlag);
@ -4616,6 +4772,11 @@ Yap_InitDBPreds(void)
Yap_InitCPred("$fetch_reference_from_index", 3, p_fetch_reference_from_index, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$resize_int_keys", 1, p_resize_int_keys, SafePredFlag|SyncPredFlag);
Yap_InitCPred("key_statistics", 4, p_key_statistics, SyncPredFlag);
#ifdef DEBUG
Yap_InitCPred("total_erased", 4, p_total_erased, SyncPredFlag);
Yap_InitCPred("key_erased_statistics", 5, p_key_erased_statistics, SyncPredFlag);
Yap_InitCPred("heap_space_info", 2, p_heap_space_info, SyncPredFlag);
#endif
Yap_InitCPred("nth_instance", 3, p_nth_instance, SyncPredFlag);
Yap_InitCPred("$nth_instancep", 3, p_nth_instancep, SyncPredFlag);
Yap_InitCPred("$jump_to_next_dynamic_clause", 0, p_jump_to_next_dynamic_clause, SyncPredFlag);

31
C/grow.c
View File

@ -925,10 +925,7 @@ Yap_growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
return(TRUE);
}
/* Used by do_goal() when we're short of stack space */
int
Yap_growtrail(long size)
static int do_growtrail(long size)
{
Int start_growth_time = Yap_cputime(), growth_time;
int gc_verbose = Yap_is_gc_verbose();
@ -949,7 +946,7 @@ Yap_growtrail(long size)
Yap_ErrorMessage = NULL;
if (!Yap_ExtendWorkSpace(size)) {
strncat(Yap_ErrorMessage,": trail stack overflowed", MAX_ERROR_MSG_SIZE);
return(FALSE);
return FALSE;
}
YAPEnterCriticalSection();
Yap_TrailTop += size;
@ -960,7 +957,29 @@ Yap_growtrail(long size)
fprintf(Yap_stderr, "[TO] took %g sec\n", (double)growth_time/1000);
fprintf(Yap_stderr, "[TO] Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000);
}
return(TRUE);
return TRUE;
}
/* Used by do_goal() when we're short of stack space */
int
Yap_growtrail(long size)
{
return do_growtrail(size);
}
CELL **
Yap_shift_visit(CELL **to_visit)
{
CELL **old_top = (CELL **)Yap_TrailTop;
if (do_growtrail(64 * 1024L)) {
CELL **dest = (CELL **)((char *)to_visit+64 * 1024L);
cpcellsd((CELL *)dest, (CELL *)to_visit, (CELL)((CELL *)old_top-(CELL *)to_visit));
return dest;
} else {
Yap_Error(SYSTEM_ERROR,TermNil,"cannot grow temporary stack for unification (%p)", Yap_TrailTop);
return to_visit;
}
}
void

4
C/heapgc.c
View File

@ -481,8 +481,6 @@ count_cells_marked(void)
/* straightforward binary tree scheme that, given a key, finds a
matching dbref */
#define XOR_BIT 32
typedef enum {
db_entry,
cl_entry,
@ -549,7 +547,7 @@ find_ref_in_dbtable(CODEADDR entry)
if (current->val < entry && current->lim > entry) {
return(current);
}
if (((CELL)entry ^ (CELL)(current->val)) & XOR_BIT)
if (entry < current->val)
current = current->right;
else
current = current->left;

199
C/index.c
View File

@ -3003,7 +3003,7 @@ do_index(ClauseDef *min, ClauseDef* max, PredEntry *ap, UInt argno, UInt fail_l,
UInt ngroups, found_pvar = FALSE;
UInt i = 0;
GroupDef *group = (GroupDef *)top;
UInt labl, labl0;
UInt labl, labl0, lablx;
Term t;
/* remember how we entered here */
UInt argno0 = argno;
@ -3023,23 +3023,29 @@ do_index(ClauseDef *min, ClauseDef* max, PredEntry *ap, UInt argno, UInt fail_l,
found_pvar = cls_info(min, max, argno);
}
ngroups = groups_in(min, max, group);
labl0 = labl = new_label();
while (IsVarTerm(t)) {
if (max - min > 2 &&
ap->ModuleOfPred != 2) {
if (IsVarTerm(t) &&
max - min > 2 &&
ap->ModuleOfPred != 2) {
lablx = new_label();
Yap_emit(label_op, lablx, Zero);
while (IsVarTerm(t)) {
Yap_emit(jump_nv_op, (CELL)(&(ap->cs.p_code.ExpandCode)), argno);
}
if (argno == ap->ArityOfPE) {
return do_var_clauses(min, max, FALSE, ap, first, clleft, fail_l, argno0);
}
argno++;
t = Deref(XREGS[argno]);
if (ap->PredFlags & LogUpdatePredFlag) {
found_pvar = cls_head_info(min, max, argno);
} else {
found_pvar = cls_info(min, max, argno);
}
ngroups = groups_in(min, max, group);
if (argno == ap->ArityOfPE) {
do_var_clauses(min, max, FALSE, ap, first, clleft, fail_l, argno0);
return lablx;
}
argno++;
t = Deref(XREGS[argno]);
if (ap->PredFlags & LogUpdatePredFlag) {
found_pvar = cls_head_info(min, max, argno);
} else {
found_pvar = cls_info(min, max, argno);
}
ngroups = groups_in(min, max, group);
}
labl0 = labl = new_label();
} else {
lablx = labl0 = labl = new_label();
}
top = (CELL *)(group+ngroups);
if (argno > 1) {
@ -3114,7 +3120,7 @@ do_index(ClauseDef *min, ClauseDef* max, PredEntry *ap, UInt argno, UInt fail_l,
group++;
labl = nextlbl;
}
return labl0;
return lablx;
}
static ClauseDef *
@ -3381,10 +3387,11 @@ reset_stack(istack_entry *sp0)
}
static istack_entry *
push_stack(istack_entry *sp, Int arg, Term Tag)
push_stack(istack_entry *sp, Int arg, Term Tag, Term extra)
{
sp->pos = arg;
sp->val = Tag;
sp->extra = extra;
sp++;
sp->pos = 0;
return sp;
@ -3404,17 +3411,6 @@ install_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
UInt argno = -sp->pos;
add_arg_info(cls, ap, argno);
}
/* go straight to the meat for dbrefs and friends */
if (IsApplTerm(cls->Tag)) {
Functor f = (Functor)RepAppl(cls->Tag);
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) {
cls->Tag = cls->u.t_ptr;
} else {
cls->Tag = MkIntTerm(RepAppl(cls->u.t_ptr)[1]);
}
}
}
/* if we are not talking about a variable */
if (cls->Tag != sp->val) {
if (sp->val == 0L) {
@ -3422,6 +3418,18 @@ install_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
}
break;
} else {
if (IsApplTerm(cls->Tag)) {
Functor f = (Functor)RepAppl(cls->Tag);
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) {
if (cls->u.t_ptr == sp->extra) break;
} else {
Term t = MkIntTerm(RepAppl(sp->extra)[1]),
t1 = MkIntTerm(RepAppl(cls->u.t_ptr)[1]);
if (t == t1) break;
}
}
}
if ((Int)(sp->pos) > 0) {
move_next(cls, sp->pos);
} else if (sp->pos) {
@ -3491,17 +3499,6 @@ install_log_upd_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
UInt argno = -sp->pos;
add_arg_info(cls, ap, argno);
}
/* go straught to the meat for dbrefs and friends */
if (IsApplTerm(cls->Tag)) {
Functor f = (Functor)RepAppl(cls->Tag);
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) {
cls->Tag = cls->u.t_ptr;
} else {
cls->Tag = MkIntTerm(RepAppl(cls->u.t_ptr)[1]);
}
}
}
/* if we are not talking about a variable */
if (cls->Tag != sp->val) {
if (sp->val == 0L) {
@ -3509,6 +3506,18 @@ install_log_upd_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
}
break;
} else {
if (IsApplTerm(cls->Tag)) {
Functor f = (Functor)RepAppl(cls->Tag);
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) {
if (cls->u.t_ptr != sp->extra) break;
} else {
Term t = MkIntTerm(RepAppl(sp->extra)[1]),
t1 = MkIntTerm(RepAppl(cls->u.t_ptr)[1]);
if (t != t1) break;
}
}
}
if ((Int)(sp->pos) > 0) {
move_next(cls, sp->pos);
} else if (sp->pos) {
@ -3744,11 +3753,11 @@ expand_index(PredEntry *ap) {
break;
case _jump_if_nonvar:
argno = arg_from_x(ipc->u.xl.x);
t = Deref(Yap_XREGS[argno]);
t = Deref(XREGS[argno]);
i = 0;
/* expand_index expects to find the new argument */
argno--;
if (!IsVarTerm(t)) {
argno--;
labp = &(ipc->u.xl.l);
ipc = ipc->u.xl.l;
} else {
@ -3759,13 +3768,13 @@ expand_index(PredEntry *ap) {
/* instructions type e */
case _index_dbref:
t = AbsAppl(s_reg-1);
sp[-1].val = t;
sp[-1].extra = t;
s_reg = NULL;
ipc = NEXTOP(ipc,e);
break;
case _index_blob:
t = MkIntTerm(s_reg[0]);
sp[-1].val = t;
sp[-1].extra = AbsAppl(s_reg-1);
s_reg = NULL;
ipc = NEXTOP(ipc,e);
break;
@ -3778,15 +3787,15 @@ expand_index(PredEntry *ap) {
labp = &(ipc->u.llll.l4);
ipc = ipc->u.llll.l4;
} else if (IsPairTerm(t)) {
sp = push_stack(sp, 1, AbsPair(NULL));
sp = push_stack(sp, 1, AbsPair(NULL), TermNil);
s_reg = RepPair(t);
labp = &(ipc->u.llll.l1);
ipc = ipc->u.llll.l1;
} else if (IsApplTerm(t)) {
sp = push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)));
sp = push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil);
ipc = ipc->u.llll.l3;
} else {
sp = push_stack(sp, argno, t);
sp = push_stack(sp, argno, t, TermNil);
ipc = ipc->u.llll.l2;
}
break;
@ -3800,33 +3809,33 @@ expand_index(PredEntry *ap) {
} else if (IsPairTerm(t)) {
s_reg = RepPair(t);
labp = &(ipc->u.ollll.l1);
sp = push_stack(sp, 1, AbsPair(NULL));
sp = push_stack(sp, 1, AbsPair(NULL), TermNil);
ipc = ipc->u.ollll.l1;
} else if (IsApplTerm(t)) {
sp = push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)));
sp = push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil);
ipc = ipc->u.ollll.l3;
} else {
sp = push_stack(sp, argno, t);
sp = push_stack(sp, argno, t, TermNil);
ipc = ipc->u.ollll.l2;
}
break;
case _switch_on_arg_type:
argno = arg_from_x(ipc->u.xllll.x);
i = 0;
t = Deref(Yap_XREGS[argno]);
t = Deref(XREGS[argno]);
if (IsVarTerm(t)) {
labp = &(ipc->u.xllll.l4);
ipc = ipc->u.xllll.l4;
} else if (IsPairTerm(t)) {
s_reg = RepPair(t);
sp = push_stack(sp, argno, AbsPair(NULL));
sp = push_stack(sp, argno, AbsPair(NULL), TermNil);
labp = &(ipc->u.xllll.l1);
ipc = ipc->u.xllll.l1;
} else if (IsApplTerm(t)) {
sp = push_stack(sp, argno, AbsAppl((CELL *)FunctorOfTerm(t)));
sp = push_stack(sp, argno, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil);
ipc = ipc->u.xllll.l3;
} else {
sp = push_stack(sp, argno, t);
sp = push_stack(sp, argno, t, TermNil);
ipc = ipc->u.xllll.l2;
}
break;
@ -3841,19 +3850,19 @@ expand_index(PredEntry *ap) {
i++;
} else if (IsPairTerm(t)) {
s_reg = RepPair(t);
sp = push_stack(sp, -i-1, AbsPair(NULL));
sp = push_stack(sp, -i-1, AbsPair(NULL), TermNil);
labp = &(ipc->u.sllll.l1);
ipc = ipc->u.sllll.l1;
i = 0;
} else if (IsApplTerm(t)) {
sp = push_stack(sp, -i-1, AbsAppl((CELL *)FunctorOfTerm(t)));
sp = push_stack(sp, -i-1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil);
ipc = ipc->u.sllll.l3;
i = 0;
} else {
/* We don't push stack here, instead we go over to next argument
sp = push_stack(sp, -i-1, t);
*/
sp = push_stack(sp, -i-1, t);
sp = push_stack(sp, -i-1, t, TermNil);
ipc = ipc->u.sllll.l2;
i++;
}
@ -4017,13 +4026,10 @@ expand_index(PredEntry *ap) {
} else if (IsPairTerm(sp[-1].val) && sp > stack) {
lab = do_compound_index(cls, max, s_reg, ap, i, 2, argno, fail_l, isfirstcl, is_last_arg, clleft, top);
} else {
/* we are continuing within a compound term */
Functor f = (Functor)RepAppl(sp[-1].val);
/* we are continuing within a compound term */
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef)
lab = do_dbref_index(cls, max, t, ap, argno, fail_l, isfirstcl, clleft, top);
else
lab = do_blob_index(cls, max, t, ap, argno, fail_l, isfirstcl, clleft, top);
lab = do_index(cls, max, ap, argno+1, fail_l, isfirstcl, clleft, top);
} else {
lab = do_compound_index(cls, max, s_reg, ap, i, ArityOfFunctor(f), argno, fail_l, isfirstcl, is_last_arg, clleft, top);
}
@ -4626,16 +4632,22 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
if (i == 0) {
if (op != _try_clause) {
LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
if (compact_mode)
if (compact_mode) {
tgl->ClRefCount--;
if (tgl->ClFlags & ErasedMask &&
!(tgl->ClRefCount) &&
!(tgl->ClFlags & InUseMask)) {
/* last ref to the clause */
Yap_ErLogUpdCl(tgl);
}
}
}
codep->opc = Yap_opcode(_try_clause);
codep = copy_ld(codep, ocodep, ap, ocodep->u.ld.d, FALSE);
} else if (i == ncls-1) {
goto do_trust;
} else {
if (op == _try_clause) {
LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
tgl->ClRefCount++;
} else if (!compact_mode) {
if (op == _try_clause || !compact_mode) {
LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
tgl->ClRefCount++;
}
@ -4646,10 +4658,13 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
break;
case _trust:
if (i < ncls-1) goto do_retry;
do_trust:
if (!compact_mode) {
LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
tgl->ClRefCount++;
}
} else {
Yap_cleanup_dangling_indices(NEXTOP(ocodep,ld),ostart->u.Ill.l1,ostart->u.Ill.l2,(yamop *)&(ap->cs.p_code.ExpandCode));
}
codep = gen_lui_trust(codep, ocodep, profiled, count_reds, ap, ocodep->u.ld.d, TRUE, nblk);
ocodep = NULL;
break;
@ -4659,6 +4674,12 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
tgl->ClRefCount--;
if (tgl->ClFlags & ErasedMask &&
!(tgl->ClRefCount) &&
!(tgl->ClFlags & InUseMask)) {
/* last ref to the clause */
Yap_ErLogUpdCl(tgl);
}
}
ocodep = NEXTOP(ocodep, ld);
break;
@ -6041,8 +6062,11 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr
choiceptr b0 = NULL;
yamop **jlbl = NULL;
for (i = 1; i <= ap->ArityOfPE; i++) {
Yap_XREGS[i] = tar[i];
if (ap->ModuleOfPred != 2) {
/* makes no sense for IDB, as ArityOfPE means nothing */
for (i = 1; i <= ap->ArityOfPE; i++) {
XREGS[i] = tar[i];
}
}
/* try to refine the interval using the indexing code */
while (ipc != NULL) {
@ -6178,7 +6202,7 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr
break;
case _jump_if_nonvar:
{
Term t = Deref(Yap_XREGS[arg_from_x(ipc->u.xllll.x)]);
Term t = Deref(XREGS[arg_from_x(ipc->u.xllll.x)]);
if (!IsVarTerm(t)) {
jlbl = &(ipc->u.xl.l);
ipc = ipc->u.xl.l;
@ -6223,7 +6247,7 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr
}
break;
case _switch_on_arg_type:
t = Deref(Yap_XREGS[arg_from_x(ipc->u.xllll.x)]);
t = Deref(XREGS[arg_from_x(ipc->u.xllll.x)]);
if (IsVarTerm(t)) {
jlbl = &(ipc->u.xllll.l4);
ipc = ipc->u.xllll.l4;
@ -6413,7 +6437,7 @@ find_caller(PredEntry *ap, yamop *code) {
}
break;
case _jump_if_nonvar:
if (!IsVarTerm(Yap_XREGS[arg_from_x(ipc->u.xllll.x)])) {
if (!IsVarTerm(XREGS[arg_from_x(ipc->u.xllll.x)])) {
ipc = ipc->u.xl.l;
} else {
ipc = NEXTOP(ipc,xl);
@ -6442,16 +6466,16 @@ find_caller(PredEntry *ap, yamop *code) {
if (ipc->u.llll.l4 == code) return &(ipc->u.llll.l4);
ipc = ipc->u.llll.l4;
} else if (IsPairTerm(t)) {
sp = push_stack(sp, 1, AbsPair(NULL));
sp = push_stack(sp, 1, AbsPair(NULL), TermNil);
s_reg = RepPair(t);
labp = &(ipc->u.llll.l1);
if (ipc->u.llll.l1 == code) return &(ipc->u.llll.l1);
ipc = ipc->u.llll.l1;
} else if (IsApplTerm(t)) {
sp = push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)));
sp = push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil);
ipc = ipc->u.llll.l3;
} else {
sp = push_stack(sp, 1, t);
sp = push_stack(sp, 1, t, TermNil);
ipc = ipc->u.llll.l2;
}
break;
@ -6464,14 +6488,15 @@ find_caller(PredEntry *ap, yamop *code) {
ipc = ipc->u.ollll.l4;
} else if (IsPairTerm(t)) {
s_reg = RepPair(t);
sp = push_stack(sp, 1, AbsPair(NULL));
if (ipc->u.ollll.l1 == code) return &(ipc->u.ollll.l1);
sp = push_stack(sp, 1, AbsPair(NULL), TermNil);
if (ipc->u.ollll.l1 == code)
return &(ipc->u.ollll.l1);
ipc = ipc->u.ollll.l1;
} else if (IsApplTerm(t)) {
sp = push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)));
sp = push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil);
ipc = ipc->u.ollll.l3;
} else {
sp = push_stack(sp, 1, t);
sp = push_stack(sp, 1, t, TermNil);
ipc = ipc->u.ollll.l2;
}
break;
@ -6483,14 +6508,14 @@ find_caller(PredEntry *ap, yamop *code) {
ipc = ipc->u.xllll.l4;
} else if (IsPairTerm(t)) {
s_reg = RepPair(t);
sp = push_stack(sp, argno, AbsPair(NULL));
sp = push_stack(sp, argno, AbsPair(NULL), TermNil);
if (ipc->u.xllll.l1 == code) return &(ipc->u.xllll.l1);
ipc = ipc->u.xllll.l1;
} else if (IsApplTerm(t)) {
sp = push_stack(sp, argno, AbsAppl((CELL *)FunctorOfTerm(t)));
sp = push_stack(sp, argno, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil);
ipc = ipc->u.xllll.l3;
} else {
sp = push_stack(sp, argno, t);
sp = push_stack(sp, argno, t, TermNil);
ipc = ipc->u.xllll.l2;
}
break;
@ -6506,14 +6531,14 @@ find_caller(PredEntry *ap, yamop *code) {
ipc = ipc->u.sllll.l4;
} else if (IsPairTerm(t)) {
s_reg = RepPair(t);
sp = push_stack(sp, -argno-1, AbsPair(NULL));
sp = push_stack(sp, -argno-1, AbsPair(NULL), TermNil);
if (ipc->u.sllll.l1 == code) return &(ipc->u.sllll.l1);
ipc = ipc->u.sllll.l1;
} else if (IsApplTerm(t)) {
sp = push_stack(sp, -argno-1, AbsAppl((CELL *)FunctorOfTerm(t)));
sp = push_stack(sp, -argno-1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil);
ipc = ipc->u.sllll.l3;
} else {
sp = push_stack(sp, -argno-1, t);
sp = push_stack(sp, -argno-1, t, TermNil);
ipc = ipc->u.sllll.l2;
}
}

13
C/tracer.c
View File

@ -104,6 +104,8 @@ check_trail_consistency(void) {
static int vsc_xstop = FALSE;
CELL old_value = 0L, old_value2 = 0L;
void
low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
{
@ -114,6 +116,15 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
vsc_count++;
#ifdef COMMENTED
if (port != enter_pred ||
!pred ||
pred->ArityOfPE != 4 ||
strcmp(RepAtom(NameOfFunctor(pred->FunctorOfPred))->StrOfAE,"in_between_target_phrases"))
return;
if (vsc_count < 1246949400LL)
return;
if (vsc_count == 1246949493LL)
vsc_xstop = TRUE;
if (vsc_count < 5646100000LL)
return;
if (vsc_count == 5646100441LL)
@ -125,7 +136,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
if (vsc_count < 5530257LL) {
return;
}
if (vsc_count == 41597LL) {
if (vsc_count == ) {
vsc_xstop = TRUE;
}
if (vsc_count < 3399741LL) {

10
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.46 2003-11-05 18:55:03 ricroc Exp $ *
* version: $Id: Heap.h,v 1.47 2003-11-12 12:33:31 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -298,6 +298,10 @@ typedef struct various_codes {
struct pred_entry *pred_handle_throw;
struct array_entry *dyn_array_list;
struct DB_STRUCT *db_erased_marker;
#ifdef DEBUG
struct logic_upd_clause *db_erased_list;
struct logic_upd_index *db_erased_ilist;
#endif /* DEBUG */
struct stream_desc *yap_streams;
#ifdef DEBUG
int debugger_output_msg;
@ -534,6 +538,10 @@ typedef struct various_codes {
#define PredHandleThrow heap_regs->pred_handle_throw
#define DynArrayList heap_regs->dyn_array_list
#define DBErasedMarker heap_regs->db_erased_marker
#ifdef DEBUG
#define DBErasedList heap_regs->db_erased_list
#define DBErasedIList heap_regs->db_erased_ilist
#endif /* DEBUG */
#define Stream heap_regs->yap_streams
#define output_msg heap_regs->debugger_output_msg
#define NOfFileAliases heap_regs->n_of_file_aliases

3
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.39 2003-10-28 01:16:02 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.40 2003-11-12 12:33:31 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -161,6 +161,7 @@ int STD_PROTO(Yap_growstack, (long));
int STD_PROTO(Yap_growtrail, (long));
int STD_PROTO(Yap_growglobal, (CELL **));
void STD_PROTO(Yap_growatomtable, (void));
CELL **STD_PROTO(Yap_shift_visit, (CELL **));
/* heapgc.c */
Int STD_PROTO(Yap_total_gc_time,(void));

27
H/absmi.h
View File

@ -283,26 +283,12 @@ restore_absmi_regs(REGSTORE * old_regs)
* backtracking *
***************************************************************/
#if TR_IN_MEM
#define CACHE_TR(A) { register tr_fr_ptr S_TR = (A)
#define RESTORE_TR() TR = S_TR
#define ENDCACHE_TR() }
#else
#define S_TR TR
#define CACHE_TR(A) { TR = (A)
#define RESTORE_TR()
#define ENDCACHE_TR() }
#endif
/***************************************************************
* S is usually, but not always, a register (X86 machines). *
* This affects unification instructions *
@ -1155,6 +1141,7 @@ trim_trail(choiceptr b, tr_fr_ptr tr, CELL *hbreg)
#if IN_ABSMI_C || IN_UNIFY_C
static int
IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
{
#if SHADOW_REGS
@ -1169,7 +1156,7 @@ IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
register CELL *HBREG = HB;
#endif /* SHADOW_HB */
CELL **to_visit = (CELL **)AuxSp;
CELL **to_visit = (CELL **)Yap_TrailTop;
loop:
while (pt0 < pt0_end) {
@ -1193,6 +1180,9 @@ loop:
if (!IsPairTerm(d1)) {
goto cufail;
}
if ((CELL *)to_visit-(CELL *)TR < 1024) {
to_visit = Yap_shift_visit(to_visit);
}
#ifdef RATIONAL_TREES
/* now link the two structures so that no one else will */
/* come here */
@ -1235,6 +1225,9 @@ loop:
continue;
goto cufail;
}
if ((CELL *)to_visit-(CELL *)TR < 1024) {
to_visit = Yap_shift_visit(to_visit);
}
#ifdef RATIONAL_TREES
/* now link the two structures so that no one else will */
/* come here */
@ -1286,7 +1279,7 @@ loop:
}
}
/* Do we still have compound terms to visit */
if (to_visit < (CELL **) AuxSp) {
if (to_visit < (CELL **) Yap_TrailTop) {
#ifdef RATIONAL_TREES
pt0 = to_visit[0];
pt0_end = to_visit[1];
@ -1306,7 +1299,7 @@ loop:
cufail:
#ifdef RATIONAL_TREES
/* failure */
while (to_visit < (CELL **) AuxSp) {
while (to_visit < (CELL **) Yap_TrailTop) {
CELL *pt0;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[3];

1
H/clause.h
View File

@ -168,6 +168,7 @@ void STD_PROTO(Yap_IPred,(PredEntry *));
void STD_PROTO(Yap_addclause,(Term,yamop *,int,int));
void STD_PROTO(Yap_add_logupd_clause,(PredEntry *,LogUpdClause *,int));
void STD_PROTO(Yap_kill_iblock,(ClauseUnion *,ClauseUnion *,PredEntry *));
void STD_PROTO(Yap_cleanup_dangling_indices,(yamop *,yamop *,yamop *,yamop *));
ClauseUnion *STD_PROTO(Yap_find_owner_index,(yamop *, PredEntry *));
/* dbase.c */

1
H/index.h
View File

@ -89,6 +89,7 @@ typedef struct {
typedef struct {
Int pos;
Term val;
Term extra;
} istack_entry;
typedef enum {

2
Makefile.in
View File

@ -90,7 +90,7 @@ TEXI2PDF=texi2pdf
#4.1VPATH=@srcdir@:@srcdir@/OPTYap
CWD=$(PWD)
#
VERSION=Yap-4.5.1
VERSION=Yap-4.5.2
#
TAG_HEADERS= Tags_32bits.h Tags_32Ops.h Tags_32LowTag.h\

2
docs/yap.tex
View File

@ -8,7 +8,7 @@
@c @setchapternewpage odd
@c %**end of header
@set VERSION: 4.5.1
@set VERSION: 4.5.2
@set EDITION 4.2.3
@set UPDATED January 2002

4
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.48 2003-11-05 18:31:49 ricroc Exp $ *
* version: $Id: Yap.h.m4,v 1.49 2003-11-12 12:33:31 vsc Exp $ *
*************************************************************************/
#include "config.h"
@ -90,7 +90,7 @@
#undef USE_THREADED_CODE
#endif
#define inline __inline
#define YAP_VERSION "Yap-4.5.1"
#define YAP_VERSION "Yap-4.5.2"
#define BIN_DIR "c:\\Program Files\\Yap\\bin"
#define LIB_DIR "c:\\Program Files\\Yap\\lib\\Yap"
#define SHARE_DIR "c:\\Program Files\\Yap\\share\\Yap"

2
misc/Yap.spec
View File

@ -3,7 +3,7 @@
Name: Yap
Summary: Prolog Compiler
Version: 4.5.1
Version: 4.5.2
Packager: Vitor Santos Costa <vitor@cos.ufrj.br>
Release: 1
Source: http://www.ncc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz

1
pl/modules.yap
View File

@ -594,6 +594,7 @@ source_module(Mod) :-
phrase(:,?),
phrase(:,?,+),
predicate_property(:,?),
predicate_statistics(:,-,-,-),
on_exception(+,:,:),
reconsult(:),
retract(:),

18
pl/preds.yap
View File

@ -798,6 +798,24 @@ predicate_property(Pred,Prop) :-
'$number_of_clauses'(P,Mod,NCl).
predicate_statistics(V,NCls,Sz,ISz) :- var(V), !,
'$do_error'(instantiation_error,predicate_statistics(V,NCls,Sz,ISz)).
predicate_statistics(M:P,NCls,Sz,ISz) :-
'$predicate_statistics'(P,M,NCls,Sz,ISz).
predicate_statistics(P,NCls,Sz,ISz) :-
'$current_module'(M),
'$predicate_statistics'(P,M,NCls,Sz,ISz).
'$predicate_statistics'(P,M,NCls,Sz,ISz) :-
'$is_dynamic'(H, M), !,
'$key_statistics'(M:H,NCls,Sz,ISz).
'$predicate_statistics'(P,M,NCls,Sz,ISz) :-
'$system_predicate'(P,M), !, fail.
'$predicate_statistics'(P,M,NCls,Sz,ISz) :-
'$undefined'(P,M), !, fail.
'$predicate_statistics'(P,M,NCls,Sz,ISz) :-
'$static_pred_statistics'(P,M,NCls,Sz,ISz).
:- '$make_pred_push_mod'((_,_)).
:- '$make_pred_push_mod'((_;_)).
:- '$make_pred_push_mod'((_|_)).

21
pl/utils.yap
View File

@ -303,13 +303,24 @@ restore(A) :- var(A), !,
restore(A) :- atom(A), !, name(A,S), '$restore'(S).
restore(S) :- '$restore'(S).
recordaifnot(K,T,R) :-
( recorded(K,T,R) -> fail ; recorda(K,T,R)).
recordzifnot(K,T,R) :-
( recorded(K,T,R) -> fail ; recordz(K,T,R)).
%%% current ....
recordaifnot(K,T,R) :-
recorded(K,T,R), % force non-det binding to R.
'$still_variant'(R,T),
!,
fail.
recordaifnot(K,T,R) :-
recorda(K,T,R).
recordzifnot(K,T,R) :-
recorded(K,T,R),
'$still_variant'(R,T),
!,
fail.
recordzifnot(K,T,R) :-
recordz(K,T,R).
current_atom(A) :- % check
atom(A), !.
current_atom(A) :- % generate