fix count flag for indices
fix memory expansion with holes. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@911 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
4d3a8b6a53
commit
4f97e338ab
|
@ -461,8 +461,6 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, SMALLUNSGN cur_mod)
|
||||||
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
|
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
|
||||||
|
|
||||||
extern long long int vsc_count;
|
extern long long int vsc_count;
|
||||||
if (p == 0x9183b68) printf("%lld entering %s:%s/%d\n", vsc_count,
|
|
||||||
RepAtom(AtomOfTerm(ModuleName[cur_mod]))->StrOfAE, RepAtom(fe->NameOfFE)->StrOfAE, fe->ArityOfFE);
|
|
||||||
|
|
||||||
INIT_RWLOCK(p->PRWLock);
|
INIT_RWLOCK(p->PRWLock);
|
||||||
p->KindOfPE = PEProp;
|
p->KindOfPE = PEProp;
|
||||||
|
|
14
C/alloc.c
14
C/alloc.c
|
@ -12,7 +12,7 @@
|
||||||
* Last rev: *
|
* Last rev: *
|
||||||
* mods: *
|
* mods: *
|
||||||
* comments: allocating space *
|
* comments: allocating space *
|
||||||
* version:$Id: alloc.c,v 1.37 2003-10-28 01:16:02 vsc Exp $ *
|
* version:$Id: alloc.c,v 1.38 2003-10-30 11:31:05 vsc Exp $ *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
#ifdef SCCS
|
#ifdef SCCS
|
||||||
static char SccsId[] = "%W% %G%";
|
static char SccsId[] = "%W% %G%";
|
||||||
|
@ -342,9 +342,6 @@ Yap_ReleasePreAllocCodeSpace(ADDR ptr)
|
||||||
static void
|
static void
|
||||||
FreeCodeSpace(char *p)
|
FreeCodeSpace(char *p)
|
||||||
{
|
{
|
||||||
if (p == 0x2adc37e4) {
|
|
||||||
printf("Erasing my block\n");
|
|
||||||
}
|
|
||||||
FreeBlock(((BlockHeader *) (p - sizeof(YAP_SEG_SIZE))));
|
FreeBlock(((BlockHeader *) (p - sizeof(YAP_SEG_SIZE))));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -714,6 +711,7 @@ ExtendWorkSpace(Int s, int fixed_allocation)
|
||||||
}
|
}
|
||||||
if (fixed_allocation) {
|
if (fixed_allocation) {
|
||||||
if (a != WorkSpaceTop) {
|
if (a != WorkSpaceTop) {
|
||||||
|
munmap((void *)a, (size_t)s);
|
||||||
Yap_ErrorMessage = Yap_ErrorSay;
|
Yap_ErrorMessage = Yap_ErrorSay;
|
||||||
snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
|
snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
|
||||||
"mmap could not grow memory at %p, got %p", WorkSpaceTop, a );
|
"mmap could not grow memory at %p, got %p", WorkSpaceTop, a );
|
||||||
|
@ -1139,10 +1137,12 @@ Yap_AllocHole(UInt actual_request, UInt total_size)
|
||||||
YAP_SEG_SIZE bsiz = (WorkSpaceTop0-HeapTop)/sizeof(CELL)-2*sizeof(YAP_SEG_SIZE)/sizeof(CELL);
|
YAP_SEG_SIZE bsiz = (WorkSpaceTop0-HeapTop)/sizeof(CELL)-2*sizeof(YAP_SEG_SIZE)/sizeof(CELL);
|
||||||
|
|
||||||
/* push HeapTop to after hole */
|
/* push HeapTop to after hole */
|
||||||
HeapTop = WorkSpaceTop-actual_request;
|
HeapTop = WorkSpaceTop-(actual_request-sizeof(YAP_SEG_SIZE));
|
||||||
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
|
((YAP_SEG_SIZE *) HeapTop)[0] = InUseFlag;
|
||||||
/* now simulate a block */
|
/* now simulate a block */
|
||||||
endb->b_size = (HeapTop-WorkSpaceTop0)/sizeof(CELL) | InUseFlag;
|
((YAP_SEG_SIZE *) HeapTop)[-1] =
|
||||||
|
endb->b_size =
|
||||||
|
(HeapTop-WorkSpaceTop0)/sizeof(YAP_SEG_SIZE) | InUseFlag;
|
||||||
newb->b_size = bsiz;
|
newb->b_size = bsiz;
|
||||||
AddToFreeList(newb);
|
AddToFreeList(newb);
|
||||||
}
|
}
|
||||||
|
|
14
C/cdmgr.c
14
C/cdmgr.c
|
@ -394,7 +394,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
|
||||||
tcl->SiblingIndex = c->SiblingIndex;
|
tcl->SiblingIndex = c->SiblingIndex;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
/* make sure that a child cannot remove ourselves */
|
/* make sure that a child cannot remove us */
|
||||||
c->ClRefCount++;
|
c->ClRefCount++;
|
||||||
while (ncl != NULL) {
|
while (ncl != NULL) {
|
||||||
LogUpdIndex *next = ncl->SiblingIndex;
|
LogUpdIndex *next = ncl->SiblingIndex;
|
||||||
|
@ -422,8 +422,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
|
||||||
decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
|
decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
|
||||||
Yap_FreeCodeSpace((CODEADDR)c);
|
Yap_FreeCodeSpace((CODEADDR)c);
|
||||||
} else {
|
} else {
|
||||||
c->ClFlags |= (ErasedMask|SwitchRootMask);
|
c->ClFlags |= ErasedMask;
|
||||||
c->u.pred = ap;
|
|
||||||
c->ChildIndex = NULL;
|
c->ChildIndex = NULL;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -470,7 +469,14 @@ Yap_kill_iblock(ClauseUnion *blk, ClauseUnion *parent_blk, PredEntry *ap)
|
||||||
void
|
void
|
||||||
Yap_ErLogUpdIndex(LogUpdIndex *clau)
|
Yap_ErLogUpdIndex(LogUpdIndex *clau)
|
||||||
{
|
{
|
||||||
kill_first_log_iblock(clau, NULL, clau->u.pred);
|
LogUpdIndex *c = clau;
|
||||||
|
if (c->ClFlags & SwitchRootMask) {
|
||||||
|
kill_first_log_iblock(clau, NULL, c->u.pred);
|
||||||
|
} else {
|
||||||
|
while (!(c->ClFlags & SwitchRootMask))
|
||||||
|
c = c->u.ParentIndex;
|
||||||
|
kill_first_log_iblock(clau, clau->u.ParentIndex, c->u.pred);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
|
|
|
@ -1476,7 +1476,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (tofref != TmpRefBase) {
|
if (tofref != TmpRefBase) {
|
||||||
CodeAbs += TmpRefBase - tofref + 1;
|
CodeAbs += (TmpRefBase - tofref) + 1;
|
||||||
if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) {
|
if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) {
|
||||||
Yap_Error_Size = (UInt)DBLength(CodeAbs);
|
Yap_Error_Size = (UInt)DBLength(CodeAbs);
|
||||||
DBErrorFlag = OVF_ERROR_IN_DB;
|
DBErrorFlag = OVF_ERROR_IN_DB;
|
||||||
|
@ -1494,7 +1494,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat)
|
||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
if (p == NULL) {
|
if (p == NULL) {
|
||||||
ppt = (DBTerm *)AllocDBSpace(sizeof(DBTerm)+(UInt)CodeAbs);
|
ppt = (DBTerm *)AllocDBSpace(DBLength(CodeAbs));
|
||||||
if (ppt == NULL) {
|
if (ppt == NULL) {
|
||||||
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
|
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
|
||||||
return generate_dberror_msg(OVF_ERROR_IN_DB, (UInt)DBLength(CodeAbs), "heap crashed against stacks");
|
return generate_dberror_msg(OVF_ERROR_IN_DB, (UInt)DBLength(CodeAbs), "heap crashed against stacks");
|
||||||
|
@ -4106,9 +4106,9 @@ p_instance_module(void)
|
||||||
if (IsIntegerTerm(t1))
|
if (IsIntegerTerm(t1))
|
||||||
dbr = (DBRef)IntegerOfTerm(t1);
|
dbr = (DBRef)IntegerOfTerm(t1);
|
||||||
else
|
else
|
||||||
return (FALSE);
|
return FALSE;
|
||||||
/* limited sanity checking */
|
/* limited sanity checking */
|
||||||
if (dbr->id != FunctorDBRef) {
|
if (dbr > (DBRef)Yap_HeapBase && dbr < (DBRef)HeapTop && dbr->id != FunctorDBRef) {
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
|
|
|
@ -4737,6 +4737,8 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
|
||||||
pcl = blk->u.ParentIndex;
|
pcl = blk->u.ParentIndex;
|
||||||
ncl->SiblingIndex = pcl->ChildIndex;
|
ncl->SiblingIndex = pcl->ChildIndex;
|
||||||
pcl->ChildIndex = ncl;
|
pcl->ChildIndex = ncl;
|
||||||
|
/* we have a new pointer to our clause */
|
||||||
|
pcl->ClRefCount++;
|
||||||
if (!(blk->ClFlags & ErasedMask)) {
|
if (!(blk->ClFlags & ErasedMask)) {
|
||||||
Yap_kill_iblock((ClauseUnion *)blk, (ClauseUnion *)pcl, ap);
|
Yap_kill_iblock((ClauseUnion *)blk, (ClauseUnion *)pcl, ap);
|
||||||
}
|
}
|
||||||
|
|
|
@ -52,10 +52,10 @@
|
||||||
typedef CELL YAP_SEG_SIZE;
|
typedef CELL YAP_SEG_SIZE;
|
||||||
|
|
||||||
typedef struct FREEB {
|
typedef struct FREEB {
|
||||||
YAP_SEG_SIZE b_size;
|
YAP_SEG_SIZE b_size;
|
||||||
struct FREEB *b_next;
|
struct FREEB *b_next;
|
||||||
struct FREEB *b_next_size;
|
struct FREEB *b_next_size;
|
||||||
} BlockHeader;
|
} BlockHeader;
|
||||||
|
|
||||||
#define MinBlockSize (sizeof(BlockHeader)+sizeof(YAP_SEG_SIZE))
|
#define MinBlockSize (sizeof(BlockHeader)+sizeof(YAP_SEG_SIZE))
|
||||||
#define MaxBlockSize 0xffffff
|
#define MaxBlockSize 0xffffff
|
||||||
|
|
11
pl/preds.yap
11
pl/preds.yap
|
@ -292,15 +292,20 @@ clause(V,Q) :-
|
||||||
'$clause'(P,M,Q) :-
|
'$clause'(P,M,Q) :-
|
||||||
'$clause'(P,M,Q,_).
|
'$clause'(P,M,Q,_).
|
||||||
|
|
||||||
clause(P,Q,R) :- db_reference(R), !,
|
clause(P,Q,R) :- var(P), !,
|
||||||
instance(R,T),
|
'$current_module'(M),
|
||||||
( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
|
'$clause'(P,M,Q,R).
|
||||||
clause(M:P,Q,R) :- !,
|
clause(M:P,Q,R) :- !,
|
||||||
'$clause'(P,M,Q,R).
|
'$clause'(P,M,Q,R).
|
||||||
clause(V,Q,R) :-
|
clause(V,Q,R) :-
|
||||||
'$current_module'(M),
|
'$current_module'(M),
|
||||||
'$clause'(V,M,Q,R).
|
'$clause'(V,M,Q,R).
|
||||||
|
|
||||||
|
'$clause'(P,M,Q,R) :-
|
||||||
|
'$instance_module'(R,M0), !,
|
||||||
|
M0 = M,
|
||||||
|
instance(R,T),
|
||||||
|
( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
|
||||||
'$clause'(V,M,Q,_) :- var(V), !,
|
'$clause'(V,M,Q,_) :- var(V), !,
|
||||||
'$do_error'(instantiation_error,M:clause(V,Q)).
|
'$do_error'(instantiation_error,M:clause(V,Q)).
|
||||||
'$clause'(C,M,Q,_) :- number(C), !,
|
'$clause'(C,M,Q,_) :- number(C), !,
|
||||||
|
|
Reference in New Issue