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

global variables

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1685 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2006-08-22 16:12:46 +00:00
parent 0f714371e5
commit d11fd73306
31 changed files with 1712 additions and 640 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
C/agc.c
View File

@ -123,6 +123,8 @@ AtomAdjust(Atom a)
#define CodeAddrAdjust(P) (P) #define CodeAddrAdjust(P) (P)
#define ConsultObjAdjust(P) (P) #define ConsultObjAdjust(P) (P)
#define DelayAddrAdjust(P) (P) #define DelayAddrAdjust(P) (P)
#define DelayAdjust(P) (P)
#define GlobalAdjust(P) (P)
#define DBRefAdjust(P) (P) #define DBRefAdjust(P) (P)
#define DBRefPAdjust(P) (P) #define DBRefPAdjust(P) (P)
#define DBTermAdjust(P) (P) #define DBTermAdjust(P) (P)
@ -134,6 +136,7 @@ AtomAdjust(Atom a)
#define PtoStCAdjust(P) (P) #define PtoStCAdjust(P) (P)
#define PtoArrayEAdjust(P) (P) #define PtoArrayEAdjust(P) (P)
#define PtoArraySAdjust(P) (P) #define PtoArraySAdjust(P) (P)
#define PtoGlobalEAdjust(P) (P)
#define PtoDelayAdjust(P) (P) #define PtoDelayAdjust(P) (P)
#define PtoGloAdjust(P) (P) #define PtoGloAdjust(P) (P)
#define PtoLocAdjust(P) (P) #define PtoLocAdjust(P) (P)
@ -282,16 +285,13 @@ mark_global(void)
* the code * the code
*/ */
#if COROUTINING #if COROUTINING
CELL *ptf = (CELL *)DelayTop(); pt = (CELL *)DelayTop();
#else
pt = (CELL *)Yap_GlobalBase;
while (pt < ptf) {
pt = mark_global_cell(pt);
}
#endif
pt = H0; pt = H0;
#endif
while (pt < H) { while (pt < H) {
pt = mark_global_cell(pt); pt = mark_global_cell(pt);
pt++;
} }
} }

24
C/attvar.c
View File

@ -77,8 +77,9 @@ CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
/* add a new attributed variable */ /* add a new attributed variable */
newv = DelayTop(); newv = DelayTop();
if (H0 - (CELL *)newv < 1024) if ((ADDR)newv - Yap_GlobalBase < 1024*sizeof(CELL))
return FALSE; return FALSE;
newv--;
RESET_VARIABLE(&(newv->Value)); RESET_VARIABLE(&(newv->Value));
RESET_VARIABLE(&(newv->Done)); RESET_VARIABLE(&(newv->Done));
vt = &(attv->Atts); vt = &(attv->Atts);
@ -94,7 +95,7 @@ CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
to_visit[3] = (CELL *)vt[-1]; to_visit[3] = (CELL *)vt[-1];
*to_visit_ptr = to_visit+4; *to_visit_ptr = to_visit+4;
*res = (CELL)&(newv->Done); *res = (CELL)&(newv->Done);
SetDelayTop(newv+1); SetDelayTop(newv);
return TRUE; return TRUE;
} }
@ -110,13 +111,13 @@ static attvar_record *
BuildNewAttVar(void) BuildNewAttVar(void)
{ {
attvar_record *attv = DelayTop(); attvar_record *attv = DelayTop();
if (H0 - (CELL *)(attv+1) < 1024) { if ((ADDR)attv - Yap_GlobalBase < 1024*sizeof(CELL))
return NULL; return FALSE;
} attv--;
RESET_VARIABLE(&(attv->Done)); RESET_VARIABLE(&(attv->Done));
RESET_VARIABLE(&(attv->Value)); RESET_VARIABLE(&(attv->Value));
RESET_VARIABLE(&(attv->Atts)); RESET_VARIABLE(&(attv->Atts));
SetDelayTop(attv+1); SetDelayTop(attv);
return attv; return attv;
} }
@ -415,18 +416,16 @@ AllAttVars(attvar_record *attv) {
CELL *h0 = H; CELL *h0 = H;
attvar_record *max = DelayTop(); attvar_record *max = DelayTop();
while (attv != max) { while (--attv >= max) {
if (ASP - H < 1024) { if (ASP - H < 1024) {
H = h0; H = h0;
Yap_Error_Size = (ASP-H)*sizeof(CELL); Yap_Error_Size = (ASP-H)*sizeof(CELL);
return 0L; return 0L;
} }
if (IsVarTerm(attv->Done) && IsUnboundVar(&attv->Done)) { if (IsVarTerm(attv->Done) && IsUnboundVar(&attv->Done)) {
if (IsIntegerTerm(attv->Atts)) { if (IsVarTerm(attv->Atts) && VarOfTerm(attv->Atts) < (CELL *)attv) {
/* skip call residue(s) */ /* skip call residue(s) */
UInt n = IntegerOfTerm(attv->Atts)-1; attv = (attvar_record *)(attv->Atts);
attv += n;
} else { } else {
if (H != h0) { if (H != h0) {
H[-1] = AbsPair(H); H[-1] = AbsPair(H);
@ -435,7 +434,6 @@ AllAttVars(attvar_record *attv) {
H += 2; H += 2;
} }
} }
attv++;
} }
if (H != h0) { if (H != h0) {
H[-1] = TermNil; H[-1] = TermNil;
@ -882,7 +880,7 @@ p_all_attvars(void)
Term out; Term out;
attvar_record *base; attvar_record *base;
base = (attvar_record *)Yap_GlobalBase+IntegerOfTerm(Yap_ReadTimedVar(AttsMutableList)); base = (attvar_record *)Yap_ReadTimedVar(AttsMutableList);
if (!(out = AllAttVars(base))) { if (!(out = AllAttVars(base))) {
if (!Yap_gcl(Yap_Error_Size, 1, ENV, P)) { if (!Yap_gcl(Yap_Error_Size, 1, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);

10
C/bignum.c
View File

@ -51,15 +51,7 @@ Yap_MkBigIntTerm(MP_INT *big)
dst->_mp_alloc = big->_mp_alloc; dst->_mp_alloc = big->_mp_alloc;
memmove((void *)(dst+1), (const void *)(big->_mp_d), nlimbs*CellSize); memmove((void *)(dst+1), (const void *)(big->_mp_d), nlimbs*CellSize);
H = (CELL *)(dst+1)+nlimbs; H = (CELL *)(dst+1)+nlimbs;
if ((char *)H-(char *)ret > MAX_SPECIALS_TAG-EndSpecials) { H[0] = EndSpecials;
/* too large */
return TermNil;
}
#if GC_NO_TAGS
H[0] = (H-ret)*sizeof(CELL)+EndSpecials;
#else
H[0] = ((H-ret)*sizeof(CELL)+EndSpecials)|MBIT;
#endif
H++; H++;
return AbsAppl(ret); return AbsAppl(ret);
} }

22
C/corout.c
View File

@ -49,31 +49,25 @@ p_set_svar_list(void)
Term newl = Deref(ARG1); Term newl = Deref(ARG1);
attvar_record *max = DelayTop(); attvar_record *max = DelayTop();
if (IsVarTerm(newl)) { if (IsVarTerm(newl) && VarOfTerm(newl) > H0) {
/* set to current top */ /* set to current top */
UInt diff; max--;
Term tdiff;
RESET_VARIABLE(&max->Done); RESET_VARIABLE(&max->Done);
RESET_VARIABLE(&max->Value); RESET_VARIABLE(&max->Value);
max->Atts = MkIntTerm(1); RESET_VARIABLE(&(max->Atts));
max++;
SetDelayTop(max); SetDelayTop(max);
diff = max-(attvar_record *)Yap_GlobalBase;
tdiff = MkIntegerTerm(diff);
Yap_UpdateTimedVar(AttsMutableList,tdiff); Yap_UpdateTimedVar(AttsMutableList,(CELL)max);
return Yap_unify(ARG1,tdiff); return Yap_unify(ARG1,(CELL)max);
} else { } else {
UInt old = IntegerOfTerm(Yap_UpdateTimedVar(AttsMutableList,newl)); attvar_record *aold = (attvar_record *)Yap_UpdateTimedVar(AttsMutableList,newl);
attvar_record *aold = (attvar_record *)Yap_GlobalBase + (old-1);
if (max > aold+1) { if (max < aold) {
/* we are moving forward */ /* we are moving forward */
/* these items are protected by call-residue, should not /* these items are protected by call-residue, should not
be visible to AllAtts be visible to AllAtts
*/ */
MaBind(&(aold->Atts),MkIntegerTerm(max-aold)); MaBind(&(aold->Atts),(CELL)max);
} }
} }
#endif #endif

24
C/dbase.c
View File

@ -630,11 +630,7 @@ copy_long_int(CELL *st, CELL *pt)
/* first thing, store a link to the list before we move on */ /* first thing, store a link to the list before we move on */
st[0] = (CELL)FunctorLongInt; st[0] = (CELL)FunctorLongInt;
st[1] = pt[1]; st[1] = pt[1];
#if GC_NO_TAGS st[2] = EndSpecials;
st[2] = 2*sizeof(CELL)+EndSpecials;
#else
st[2] = ((2*sizeof(CELL)+EndSpecials)|MBIT);
#endif
/* now reserve space */ /* now reserve space */
return st+3; return st+3;
} }
@ -647,17 +643,9 @@ copy_double(CELL *st, CELL *pt)
st[1] = pt[1]; st[1] = pt[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
st[2] = pt[2]; st[2] = pt[2];
#if GC_NO_TAGS st[3] = EndSpecials;
st[3] = 3*sizeof(CELL)+EndSpecials;
#else #else
st[3] = ((3*sizeof(CELL)+EndSpecials)|MBIT); st[2] = EndSpecials;
#endif /* GC_NO_TAGS */
#else
#if GC_NO_TAGS
st[2] = 2*sizeof(CELL)+EndSpecials;
#else
st[2] = ((2*sizeof(CELL)+EndSpecials)|MBIT);
#endif /* GC_NO_TAGS */
#endif #endif
/* now reserve space */ /* now reserve space */
return st+(2+SIZEOF_DOUBLE/SIZEOF_LONG_INT); return st+(2+SIZEOF_DOUBLE/SIZEOF_LONG_INT);
@ -677,11 +665,7 @@ copy_big_int(CELL *st, CELL *pt)
memcpy((void *)(st+1), (void *)(pt+1), sz); memcpy((void *)(st+1), (void *)(pt+1), sz);
st = st+1+sz/CellSize; st = st+1+sz/CellSize;
/* then the tail for gc */ /* then the tail for gc */
#if GC_NO_TAGS st[0] = EndSpecials;
st[0] = sz+CellSize+EndSpecials;
#else
st[0] = (sz+CellSize+EndSpecials)|MBIT;
#endif
return st+1; return st+1;
} }
#endif /* BIG_INT */ #endif /* BIG_INT */

7
C/exec.c
View File

@ -1779,6 +1779,7 @@ p_generate_pred_info(void) {
void void
Yap_InitYaamRegs(void) Yap_InitYaamRegs(void)
{ {
Term h0var;
#if PUSH_REGS #if PUSH_REGS
/* Guarantee that after a longjmp we go back to the original abstract /* Guarantee that after a longjmp we go back to the original abstract
@ -1824,10 +1825,10 @@ Yap_InitYaamRegs(void)
/* for slots to work */ /* for slots to work */
Yap_StartSlots(); Yap_StartSlots();
#if COROUTINING #if COROUTINING
RESET_VARIABLE((CELL *)Yap_GlobalBase); h0var = MkVarTerm();
DelayedVars = Yap_NewTimedVar(MkIntTerm(0)); DelayedVars = Yap_NewTimedVar(h0var);
WokenGoals = Yap_NewTimedVar(TermNil); WokenGoals = Yap_NewTimedVar(TermNil);
AttsMutableList = Yap_NewTimedVar(MkIntTerm(0)); AttsMutableList = Yap_NewTimedVar(h0var);
#endif #endif
GcGeneration = Yap_NewTimedVar(MkIntTerm(0)); GcGeneration = Yap_NewTimedVar(MkIntTerm(0));
GcCurrentPhase = 0L; GcCurrentPhase = 0L;

1162
C/globals.c Normal file
View File

File diff suppressed because it is too large Load Diff

10
C/gprof.c
View File

@ -11,8 +11,12 @@
* File: gprof.c * * File: gprof.c *
* comments: Interrupt Driven Profiler * * comments: Interrupt Driven Profiler *
* * * *
* Last rev: $Date: 2006-08-07 18:51:44 $,$Author: vsc $ * * Last rev: $Date: 2006-08-22 16:12:45 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.6 2006/08/07 18:51:44 vsc
* fix garbage collector not to try to garbage collect when we ask for large
* chunks of stack in a single go.
*
* Revision 1.5 2006/04/27 20:58:59 rslopes * Revision 1.5 2006/04/27 20:58:59 rslopes
* fix do profiler offline. * fix do profiler offline.
* *
@ -843,7 +847,7 @@ showprofres(UInt type) {
if (calls && myp->FunctorOfPred->KindOfPE==47872) { if (calls && myp->FunctorOfPred->KindOfPE==47872) {
count+=calls; count+=calls;
printf("%p",myp); printf("%p",myp);
if (myp->ModuleOfPred!=NULL) printf(" %s",RepAtom(AtomOfTerm(myp->ModuleOfPred))->StrOfAE); if (myp->ModuleOfPred) printf(" %s",RepAtom(AtomOfTerm(myp->ModuleOfPred))->StrOfAE);
printf(":%s",RepAtom(NameOfFunctor(myp->FunctorOfPred))->StrOfAE); printf(":%s",RepAtom(NameOfFunctor(myp->FunctorOfPred))->StrOfAE);
if (myp->ArityOfPE) printf("/%d",myp->ArityOfPE); if (myp->ArityOfPE) printf("/%d",myp->ArityOfPE);
printf(" -> %lu (%3.1f%c)\n",(unsigned long int)calls,(float) calls*100/ProfCalls,'%'); printf(" -> %lu (%3.1f%c)\n",(unsigned long int)calls,(float) calls*100/ProfCalls,'%');
@ -868,7 +872,7 @@ showprofres(UInt type) {
} }
count+=calls; count+=calls;
// printf("%p %p",t->pp, t->beg); // printf("%p %p",t->pp, t->beg);
if (t->pp->ModuleOfPred!=NULL) printf(" %s",RepAtom(AtomOfTerm(t->pp->ModuleOfPred))->StrOfAE); if (t->pp->ModuleOfPred) printf(" %s",RepAtom(AtomOfTerm(t->pp->ModuleOfPred))->StrOfAE);
printf(":%s",RepAtom(NameOfFunctor(t->pp->FunctorOfPred))->StrOfAE); printf(":%s",RepAtom(NameOfFunctor(t->pp->FunctorOfPred))->StrOfAE);
if (t->pp->ArityOfPE) printf("/%d",t->pp->ArityOfPE); if (t->pp->ArityOfPE) printf("/%d",t->pp->ArityOfPE);
printf(" -> %lu (%3.1f%c)\n",(unsigned long int)calls,(float) calls*100/ProfCalls,'%'); printf(" -> %lu (%3.1f%c)\n",(unsigned long int)calls,(float) calls*100/ProfCalls,'%');

238
C/grow.c
View File

@ -35,7 +35,7 @@
#endif #endif
#if !COROUTINING #if !COROUTINING
#define DelayTop() Yap_GlobalBase #define DelayTop() H0
#endif #endif
static int heap_overflows = 0; static int heap_overflows = 0;
@ -66,7 +66,6 @@ STATIC_PROTO(int growstack, (long));
STATIC_PROTO(void MoveGlobal, (void)); STATIC_PROTO(void MoveGlobal, (void));
STATIC_PROTO(void MoveLocalAndTrail, (void)); STATIC_PROTO(void MoveLocalAndTrail, (void));
STATIC_PROTO(void SetHeapRegs, (void)); STATIC_PROTO(void SetHeapRegs, (void));
STATIC_PROTO(void SetStackRegs, (void));
STATIC_PROTO(void AdjustTrail, (int)); STATIC_PROTO(void AdjustTrail, (int));
STATIC_PROTO(void AdjustLocal, (void)); STATIC_PROTO(void AdjustLocal, (void));
STATIC_PROTO(void AdjustGlobal, (void)); STATIC_PROTO(void AdjustGlobal, (void));
@ -86,7 +85,7 @@ cpcellsd(register CELL *Dest, register CELL *Org, CELL NOf)
#else #else
register Int n_of = NOf; register Int n_of = NOf;
for (; n_of >= 0; n_of--) for (; n_of >= 0; n_of--)
*--Dest = *--Org; *Dest++ = *Org++;
#endif #endif
} }
@ -156,60 +155,10 @@ SetHeapRegs(void)
S = PtoGloAdjust(S); S = PtoGloAdjust(S);
else if (IsOldLocalPtr(S)) else if (IsOldLocalPtr(S))
S = PtoLocAdjust(S); S = PtoLocAdjust(S);
#ifdef COROUTINING if (GlobalArena)
if (DelayedVars) GlobalArena = AbsAppl(PtoGloAdjust(RepAppl(GlobalArena)));
DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars))); if (GlobalDelayArena)
if (AttsMutableList) GlobalDelayArena = GlobalAdjust(GlobalDelayArena);
AttsMutableList = AbsAppl(PtoGloAdjust(RepAppl(AttsMutableList)));
if (WokenGoals)
WokenGoals = AbsAppl(PtoGloAdjust(RepAppl(WokenGoals)));
#endif
GcGeneration = AbsAppl(PtoGloAdjust(RepAppl(GcGeneration)));
GcPhase = AbsAppl(PtoGloAdjust(RepAppl(GcPhase)));
}
static void
SetStackRegs(void)
{
/* The old local stack pointers */
OldLCL0 = LCL0;
OldASP = ASP;
OldH = H;
OldH0 = H0;
OldGlobalBase = (CELL *)Yap_GlobalBase;
OldTrailTop = Yap_TrailTop;
OldTrailBase = Yap_TrailBase;
OldTR = TR;
OldHeapBase = Yap_HeapBase;
OldHeapTop = HeapTop;
/* The local and aux stack addresses */
Yap_TrailBase = TrailAddrAdjust(Yap_TrailBase);
Yap_TrailTop = TrailAddrAdjust(Yap_TrailTop);
Yap_LocalBase = LocalAddrAdjust(Yap_LocalBase);
TR = PtoTRAdjust(TR);
/* The registers pointing to the local stack */
if (ENV)
ENV = PtoLocAdjust(ENV);
if (ASP)
ASP = PtoLocAdjust(ASP);
if (LCL0)
LCL0 = PtoLocAdjust(LCL0);
if (B)
B = ChoicePtrAdjust(B);
#ifdef CUT_C
if (Yap_REGS.CUT_C_TOP)
Yap_REGS.CUT_C_TOP = (cut_c_str_ptr)ChoicePtrAdjust((choiceptr)Yap_REGS.CUT_C_TOP);
#endif
#ifdef TABLING
if (B_FZ)
B_FZ = ChoicePtrAdjust(B_FZ);
if (BB)
BB = ChoicePtrAdjust(BB);
if (TR_FZ)
TR_FZ = PtoTRAdjust(TR_FZ);
#endif /* TABLING */
if (YENV)
YENV = PtoLocAdjust(YENV);
#ifdef COROUTINING #ifdef COROUTINING
if (DelayedVars) if (DelayedVars)
DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars))); DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars)));
@ -227,17 +176,9 @@ MoveLocalAndTrail(void)
{ {
/* cpcellsd(To,From,NOfCells) - copy the cells downwards */ /* cpcellsd(To,From,NOfCells) - copy the cells downwards */
#if USE_SYSTEM_MALLOC #if USE_SYSTEM_MALLOC
#if HAVE_MEMMOVE
cpcellsd(ASP, (CELL *)((char *)OldASP+DelayDiff), (CELL *)OldTR - OldASP); cpcellsd(ASP, (CELL *)((char *)OldASP+DelayDiff), (CELL *)OldTR - OldASP);
#else #else
cpcellsd((CELL *)TR, (CELL *)((char *)OldTR+Delaydiff), (CELL *)OldTR - OldASP);
#endif
#else
#if HAVE_MEMMOVE
cpcellsd(ASP, OldASP, (CELL *)OldTR - OldASP); cpcellsd(ASP, OldASP, (CELL *)OldTR - OldASP);
#else
cpcellsd((CELL *)TR, (CELL *)OldTR, (CELL *)OldTR - OldASP);
#endif
#endif #endif
} }
@ -248,44 +189,40 @@ MoveGlobal(void)
* cpcellsd(To,From,NOfCells) - copy the cells downwards - in * cpcellsd(To,From,NOfCells) - copy the cells downwards - in
* absmi.asm * absmi.asm
*/ */
#if HAVE_MEMMOVE
cpcellsd((CELL *)Yap_GlobalBase, (CELL *)OldGlobalBase, OldH - (CELL *)OldGlobalBase); cpcellsd((CELL *)Yap_GlobalBase, (CELL *)OldGlobalBase, OldH - (CELL *)OldGlobalBase);
#else
cpcellsd(H, OldH, OldH - (CELL *)OldGlobalBase);
#endif
} }
static void static void
MoveGlobalOnly(void) MoveExpandedGlobal(void)
{
/*
* cpcellsd(To,From,NOfCells) - copy the cells downwards - in
* absmi.asm
*/
cpcellsd((CELL *)(Yap_GlobalBase+GDiff), (CELL *)OldGlobalBase, OldH - (CELL *)OldGlobalBase);
}
static void
MoveGlobalWithHole(void)
{
/*
* cpcellsd(To,From,NOfCells) - copy the cells downwards - in
* absmi.asm
*/
cpcellsd((CELL *)((char *)OldGlobalBase+GDiff0), (CELL *)OldGlobalBase, OldH - (CELL *)OldGlobalBase);
}
static void
MoveHalfGlobal(CELL *OldPt)
{ {
/* /*
* cpcellsd(To,From,NOfCells) - copy the cells downwards - in * cpcellsd(To,From,NOfCells) - copy the cells downwards - in
* absmi.asm * absmi.asm
*/ */
#if USE_SYSTEM_MALLOC UInt diff = OldH-OldPt;
#if HAVE_MEMMOVE CELL *NewPt = (CELL *)((char*)OldPt+GDiff);
cpcellsd(H0, (CELL *)((char *)OldH0+DelayDiff), OldH - OldH0); CELL *IntPt = (CELL *)((char*)OldPt+GDiff0);
#else cpcellsd(NewPt, IntPt, diff);
cpcellsd(H, (CELL *)((char *)OldH+DelayDiff), OldH - OldH0);
#endif
#else
#if HAVE_MEMMOVE
cpcellsd(H0, OldH0, OldH - OldH0);
#else
cpcellsd(H, OldH, OldH - OldH0);
#endif
#endif
}
static void
MoveDelays(void)
{
UInt sz = (ADDR)OldH0-(ADDR)OldGlobalBase;
#if HAVE_MEMMOVE
cpcellsd((CELL *)Yap_GlobalBase, OldGlobalBase, sz);
#else
cpcellsd(H0, OldH0, sz);
#endif
} }
static inline CELL static inline CELL
@ -295,8 +232,6 @@ AdjustAppl(register CELL t0)
if (IsOldGlobalPtr(t)) if (IsOldGlobalPtr(t))
return (AbsAppl(PtoGloAdjust(t))); return (AbsAppl(PtoGloAdjust(t)));
else if (IsOldDelayPtr(t))
return (AbsAppl(PtoDelayAdjust(t)));
else if (IsOldTrailPtr(t)) else if (IsOldTrailPtr(t))
return (AbsAppl(CellPtoTRAdjust(t))); return (AbsAppl(CellPtoTRAdjust(t)));
else if (IsHeapP(t)) else if (IsHeapP(t))
@ -317,8 +252,6 @@ AdjustPair(register CELL t0)
if (IsOldGlobalPtr(t)) if (IsOldGlobalPtr(t))
return (AbsPair(PtoGloAdjust(t))); return (AbsPair(PtoGloAdjust(t)));
if (IsOldDelayPtr(t))
return (AbsPair(PtoDelayAdjust(t)));
if (IsOldTrailPtr(t)) if (IsOldTrailPtr(t))
return (AbsPair(CellPtoTRAdjust(t))); return (AbsPair(CellPtoTRAdjust(t)));
else if (IsHeapP(t)) else if (IsHeapP(t))
@ -348,8 +281,6 @@ AdjustTrail(int adjusting_heap)
TrailTerm(ptt) = LocalAdjust(reg); TrailTerm(ptt) = LocalAdjust(reg);
else if (IsOldGlobal(reg)) else if (IsOldGlobal(reg))
TrailTerm(ptt) = GlobalAdjust(reg); TrailTerm(ptt) = GlobalAdjust(reg);
else if (IsOldDelay(reg))
TrailTerm(ptt) = DelayAdjust(reg);
else if (IsOldTrail(reg)) else if (IsOldTrail(reg))
TrailTerm(ptt) = TrailAdjust(reg); TrailTerm(ptt) = TrailAdjust(reg);
} else if (IsPairTerm(reg)) { } else if (IsPairTerm(reg)) {
@ -367,8 +298,6 @@ AdjustTrail(int adjusting_heap)
TrailVal(ptt) = LocalAdjust(reg2); TrailVal(ptt) = LocalAdjust(reg2);
else if (IsOldGlobal(reg2)) else if (IsOldGlobal(reg2))
TrailVal(ptt) = GlobalAdjust(reg2); TrailVal(ptt) = GlobalAdjust(reg2);
else if (IsOldDelay(reg2))
TrailVal(ptt) = DelayAdjust(reg2);
else if (IsOldTrail(reg2)) else if (IsOldTrail(reg2))
TrailVal(ptt) = TrailAdjust(reg2); TrailVal(ptt) = TrailAdjust(reg2);
} else if (IsApplTerm(reg2)) { } else if (IsApplTerm(reg2)) {
@ -395,8 +324,6 @@ AdjustLocal(void)
*pt = LocalAdjust(reg); *pt = LocalAdjust(reg);
else if (IsOldGlobal(reg)) else if (IsOldGlobal(reg))
*pt = GlobalAdjust(reg); *pt = GlobalAdjust(reg);
else if (IsOldDelay(reg))
*pt = DelayAdjust(reg);
else if (IsOldTrail(reg)) else if (IsOldTrail(reg))
*pt = TrailAdjust(reg); *pt = TrailAdjust(reg);
else if (IsOldCode(reg)) else if (IsOldCode(reg))
@ -416,8 +343,6 @@ AdjustGlobTerm(Term reg)
if (IsVarTerm(reg)) { if (IsVarTerm(reg)) {
if (IsOldGlobal(reg)) if (IsOldGlobal(reg))
return GlobalAdjust(reg); return GlobalAdjust(reg);
else if (IsOldDelay(reg))
return DelayAdjust(reg);
else if (IsOldLocal(reg)) else if (IsOldLocal(reg))
return LocalAdjust(reg); return LocalAdjust(reg);
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
@ -437,11 +362,19 @@ AdjustGlobal(void)
CELL *pt; CELL *pt;
ArrayEntry *al = DynamicArrays; ArrayEntry *al = DynamicArrays;
StaticArrayEntry *sal = StaticArrays; StaticArrayEntry *sal = StaticArrays;
GlobalEntry *gl = GlobalVariables;
while (al) { while (al) {
al->ValueOfVE = AdjustGlobTerm(al->ValueOfVE); al->ValueOfVE = AdjustGlobTerm(al->ValueOfVE);
al = al->NextAE; al = al->NextAE;
} }
while (gl) {
if (IsVarTerm(gl->global) ||
!IsAtomOrIntTerm(gl->global)) {
gl->global = AdjustGlobTerm(gl->global);
}
gl = gl->NextGE;
}
while (sal) { while (sal) {
if (sal->ArrayType == array_of_nb_terms) { if (sal->ArrayType == array_of_nb_terms) {
UInt arity = -sal->ArrayEArity, i; UInt arity = -sal->ArrayEArity, i;
@ -465,11 +398,9 @@ AdjustGlobal(void)
register CELL reg; register CELL reg;
reg = *pt; reg = *pt;
if (IsVarTerm(reg)) { if (IsVarTerm(reg)) {
if (IsOldGlobal(reg)) if (IsOldGlobal(reg))
*pt = GlobalAdjust(reg); *pt = GlobalAdjust(reg);
else if (IsOldDelay(reg))
*pt = DelayAdjust(reg);
else if (IsOldLocal(reg)) else if (IsOldLocal(reg))
*pt = LocalAdjust(reg); *pt = LocalAdjust(reg);
else if (IsOldCode(reg)) { else if (IsOldCode(reg)) {
@ -559,8 +490,6 @@ AdjustRegs(int n)
reg = LocalAdjust(reg); reg = LocalAdjust(reg);
else if (IsOldGlobal(reg)) else if (IsOldGlobal(reg))
reg = GlobalAdjust(reg); reg = GlobalAdjust(reg);
else if (IsOldDelay(reg))
reg = DelayAdjust(reg);
else if (IsOldTrail(reg)) else if (IsOldTrail(reg))
reg = TrailAdjust(reg); reg = TrailAdjust(reg);
else if (IsOldCode(reg)) else if (IsOldCode(reg))
@ -618,7 +547,8 @@ static_growheap(long size, int fix_code, struct intermediates *cip)
ASP -= 256; ASP -= 256;
YAPEnterCriticalSection(); YAPEnterCriticalSection();
TrDiff = LDiff = GDiff = DelayDiff = size; TrDiff = LDiff = GDiff = DelayDiff = size;
XDiff = HDiff = 0; XDiff = HDiff = GDiff0 = 0;
GSplit = NULL;
SetHeapRegs(); SetHeapRegs();
MoveLocalAndTrail(); MoveLocalAndTrail();
if (fix_code) { if (fix_code) {
@ -644,21 +574,31 @@ static_growheap(long size, int fix_code, struct intermediates *cip)
return(TRUE); return(TRUE);
} }
/* Used by do_goal() when we're short of heap space */ /* Used when we're short of heap, usually because of an overflow in
the attributed stack, but also because we allocated a zone */
static int static int
static_growglobal(long size, CELL **ptr) static_growglobal(long size, CELL **ptr, CELL *hsplit)
{ {
UInt start_growth_time, growth_time; UInt start_growth_time, growth_time;
int gc_verbose; int gc_verbose;
char *omax = (ADDR)DelayTop(); char *omax = (ADDR)DelayTop();
ADDR old_GlobalBase = Yap_GlobalBase; ADDR old_GlobalBase = Yap_GlobalBase;
UInt minimal_request = 0L; UInt minimal_request = 0L;
long size0; long size0, sz = size;
char vb_msg1, *vb_msg2;
if (hsplit) {
/* just a little bit of sanity checking */
if (hsplit < (CELL*)omax ||
hsplit > H)
return FALSE;
else if (hsplit == (CELL *)omax)
hsplit = NULL;
}
/* adjust to a multiple of 256) */ /* adjust to a multiple of 256) */
Yap_PrologMode |= GrowStackMode; Yap_PrologMode |= GrowStackMode;
if (size < (omax-Yap_GlobalBase)/8) if (size < ((char *)H0-omax)/8)
size = (omax-Yap_GlobalBase)/8; size = ((char *)H0-omax)/8;
size0 = size = AdjustPageSize(size); size0 = size = AdjustPageSize(size);
Yap_ErrorMessage = NULL; Yap_ErrorMessage = NULL;
if (!Yap_ExtendWorkSpace(size)) { if (!Yap_ExtendWorkSpace(size)) {
@ -676,8 +616,20 @@ static_growglobal(long size, CELL **ptr)
gc_verbose = Yap_is_gc_verbose(); gc_verbose = Yap_is_gc_verbose();
delay_overflows++; delay_overflows++;
if (gc_verbose) { if (gc_verbose) {
fprintf(Yap_stderr, "%% DO Delay overflow %d\n", delay_overflows); if (hsplit) {
fprintf(Yap_stderr, "%% DO growing the stacks %ld bytes\n", size); if (hsplit > H0) {
vb_msg1 = 'H';
vb_msg2 = "Global Variable Space";
} else {
vb_msg1 = 'D';
vb_msg2 = "Global Variable Delay Space";
}
} else {
vb_msg1 = 'D';
vb_msg2 = "Delay";
}
fprintf(Yap_stderr, "%% %cO %s overflow %d\n", vb_msg1, vb_msg2, delay_overflows); \
fprintf(Yap_stderr, "%% %cO growing the stacks %ld bytes\n", vb_msg1, size);
} }
ASP -= 256; ASP -= 256;
YAPEnterCriticalSection(); YAPEnterCriticalSection();
@ -695,18 +647,30 @@ static_growglobal(long size, CELL **ptr)
DelayDiff = 0; DelayDiff = 0;
} }
#endif #endif
if (hsplit) {
GDiff0 = GDiff-sz;
GSplit = hsplit;
} else {
GDiff0 = DelayDiff;
GSplit = NULL;
}
XDiff = HDiff = 0; XDiff = HDiff = 0;
Yap_GlobalBase = old_GlobalBase; Yap_GlobalBase = old_GlobalBase;
SetHeapRegs(); SetHeapRegs();
MoveLocalAndTrail(); MoveLocalAndTrail();
MoveGlobalOnly(); if (hsplit) {
if (minimal_request) { MoveGlobalWithHole();
MoveDelays(); } else {
MoveExpandedGlobal();
} }
AdjustStacksAndTrail(); AdjustStacksAndTrail();
AdjustRegs(MaxTemps); AdjustRegs(MaxTemps);
if (ptr) if (ptr) {
*ptr = PtoLocAdjust(*ptr); *ptr = PtoLocAdjust(*ptr);
}
if (hsplit) {
MoveHalfGlobal(hsplit);
}
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
ASP += 256; ASP += 256;
if (minimal_request) { if (minimal_request) {
@ -715,14 +679,13 @@ static_growglobal(long size, CELL **ptr)
growth_time = Yap_cputime()-start_growth_time; growth_time = Yap_cputime()-start_growth_time;
total_delay_overflow_time += growth_time; total_delay_overflow_time += growth_time;
if (gc_verbose) { if (gc_verbose) {
fprintf(Yap_stderr, "%% DO took %g sec\n", (double)growth_time/1000); fprintf(Yap_stderr, "%% %cO took %g sec\n", vb_msg1, (double)growth_time/1000);
fprintf(Yap_stderr, "%% DO Total of %g sec expanding stacks \n", (double)total_delay_overflow_time/1000); fprintf(Yap_stderr, "%% %cO Total of %g sec expanding stacks \n", vb_msg1, (double)total_delay_overflow_time/1000);
} }
Yap_PrologMode &= ~GrowStackMode; Yap_PrologMode &= ~GrowStackMode;
return(TRUE); return(TRUE);
} }
static void static void
fix_compiler_instructions(PInstr *pcpc) fix_compiler_instructions(PInstr *pcpc)
{ {
@ -1072,7 +1035,7 @@ Yap_growglobal(CELL **ptr)
return(FALSE); return(FALSE);
} }
#endif #endif
if (!static_growglobal(sz, ptr)) if (!static_growglobal(sz, ptr, NULL))
return(FALSE); return(FALSE);
#ifdef TABLING #ifdef TABLING
fix_tabling_info(); fix_tabling_info();
@ -1081,6 +1044,18 @@ Yap_growglobal(CELL **ptr)
} }
int
Yap_InsertInGlobal(CELL *where, UInt howmuch)
{
if (!static_growglobal(howmuch, NULL, where))
return FALSE;
#ifdef TABLING
fix_tabling_info();
#endif /* TABLING */
return TRUE;
}
int int
Yap_growstack(long size) Yap_growstack(long size)
{ {
@ -1202,6 +1177,7 @@ execute_growstack(long size0, int from_trail, int in_parser, tr_fr_ptr *old_trp,
} }
} }
XDiff = HDiff = 0; XDiff = HDiff = 0;
GDiff0=0;
#if USE_SYSTEM_MALLOC #if USE_SYSTEM_MALLOC
if (from_trail) { if (from_trail) {
TrDiff = LDiff = GDiff; TrDiff = LDiff = GDiff;
@ -1216,11 +1192,7 @@ execute_growstack(long size0, int from_trail, int in_parser, tr_fr_ptr *old_trp,
} }
#endif #endif
ASP -= 256; ASP -= 256;
if (GDiff) { SetHeapRegs();
SetHeapRegs();
} else {
SetStackRegs();
}
if (from_trail) { if (from_trail) {
Yap_TrailTop += size0; Yap_TrailTop += size0;
} }
@ -1382,7 +1354,7 @@ static int do_growtrail(long size, int contiguous_only, int in_parser, tr_fr_ptr
} else { } else {
YAPEnterCriticalSection(); YAPEnterCriticalSection();
if (in_parser) { if (in_parser) {
TrDiff = LDiff = GDiff = DelayDiff = XDiff = HDiff = 0; TrDiff = LDiff = GDiff = DelayDiff = XDiff = HDiff = GDiff0 = 0;
AdjustScannerStacks(tksp, vep); AdjustScannerStacks(tksp, vep);
} }
Yap_TrailTop += size; Yap_TrailTop += size;

402
C/heapgc.c
View File

@ -99,12 +99,6 @@ typedef struct RB_red_blk_node {
/* in a single gc */ /* in a single gc */
static unsigned long int total_marked, total_oldies; /* number of heap objects marked */ static unsigned long int total_marked, total_oldies; /* number of heap objects marked */
#if DEBUG
#ifdef COROUTINING
static unsigned long int total_smarked;
#endif
#endif
#ifdef EASY_SHUNTING #ifdef EASY_SHUNTING
static choiceptr current_B; static choiceptr current_B;
@ -399,10 +393,17 @@ push_registers(Int num_regs, yamop *nextop)
/* push array entries first */ /* push array entries first */
ArrayEntry *al = DynamicArrays; ArrayEntry *al = DynamicArrays;
GlobalEntry *gl = GlobalVariables;
TrailTerm(TR++) = GlobalArena;
TrailTerm(TR++) = GlobalDelayArena;
while (al) { while (al) {
TrailTerm(TR++) = al->ValueOfVE; TrailTerm(TR++) = al->ValueOfVE;
al = al->NextAE; al = al->NextAE;
} }
while (gl) {
TrailTerm(TR++) = gl->global;
gl = gl->NextGE;
}
while (sal) { while (sal) {
if (sal->ArrayType == array_of_nb_terms) { if (sal->ArrayType == array_of_nb_terms) {
UInt arity = -sal->ArrayEArity, i; UInt arity = -sal->ArrayEArity, i;
@ -463,10 +464,18 @@ pop_registers(Int num_regs, yamop *nextop)
/* pop array entries first */ /* pop array entries first */
ArrayEntry *al = DynamicArrays; ArrayEntry *al = DynamicArrays;
GlobalEntry *gl = GlobalVariables;
GlobalArena = TrailTerm(ptr++);
GlobalDelayArena = TrailTerm(ptr++);
while (al) { while (al) {
al->ValueOfVE = TrailTerm(ptr++); al->ValueOfVE = TrailTerm(ptr++);
al = al->NextAE; al = al->NextAE;
} }
while (gl) {
gl->global = TrailTerm(ptr++);
gl = gl->NextGE;
}
sal = StaticArrays; sal = StaticArrays;
while (sal) { while (sal) {
if (sal->ArrayType == array_of_nb_terms) { if (sal->ArrayType == array_of_nb_terms) {
@ -1034,20 +1043,17 @@ check_global(void) {
if (MARKED_PTR(current)) { if (MARKED_PTR(current)) {
CELL ccell = UNMARK_CELL(ccurr); CELL ccell = UNMARK_CELL(ccurr);
if ( if (ccell == EndSpecials) {
ccell < MAX_SPECIALS_TAG && /* two first pages */
ccell > EndSpecials && IsVarTerm(ccell)) {
/* oops, we found a blob */ /* oops, we found a blob */
int nofcells = (UNMARK_CELL(*current)-EndSpecials) / sizeof(CELL); CELL *ptr = current-1;
CELL *ptr = current - nofcells ; UInt nofcells;
while (!MARKED_PTR(ptr)) ptr--;
nofcells = current-ptr;
current = ptr; current = ptr;
ccurr = *current; ccurr = *current;
/* process the functor next */ /* process the functor next */
} }
if (MARKED_PTR(current)) {
printf("Oops, found marked cell at %p\n", current);
break;
}
} }
#if INSTRUMENT_GC #if INSTRUMENT_GC
if (IsVarTerm(ccurr)) { if (IsVarTerm(ccurr)) {
@ -1279,51 +1285,35 @@ mark_variable(CELL_PTR current)
} }
total_marked += 3; total_marked += 3;
PUSH_POINTER(next); PUSH_POINTER(next);
PUSH_POINTER(next+1);
PUSH_POINTER(next+2); PUSH_POINTER(next+2);
POP_CONTINUATION(); POP_CONTINUATION();
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
MARK(next); MARK(next);
if (next < HGEN) {
total_oldies+=2+SIZEOF_DOUBLE/SIZEOF_LONG_INT;
}
total_marked += 2+SIZEOF_DOUBLE/SIZEOF_LONG_INT;
PUSH_POINTER(next); PUSH_POINTER(next);
PUSH_POINTER(next+1); {
PUSH_POINTER(next+2); UInt sz = 1+SIZEOF_DOUBLE/SIZEOF_LONG_INT;
#if SIZEOF_DOUBLE==2*SIZEOF_LONG_INT if (next < HGEN) {
PUSH_POINTER(next+3); total_oldies+= 1+sz;
#if GC_NO_TAGS }
MARK(next+3); total_marked += 1+sz;
#endif PUSH_POINTER(next+sz);
#elif GC_NO_TAGS MARK(next+sz);
MARK(next+2); }
#endif
POP_CONTINUATION(); POP_CONTINUATION();
#ifdef USE_GMP #ifdef USE_GMP
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
MARK(next);
/* size is given by functor + friends */
if (next < HGEN) {
total_oldies+=2+
(sizeof(MP_INT)+
(((MP_INT *)(next+1))->_mp_alloc*sizeof(mp_limb_t)))/CellSize;
}
total_marked += 2+
(sizeof(MP_INT)+
(((MP_INT *)(next+1))->_mp_alloc*sizeof(mp_limb_t)))/CellSize;
{ {
int i; UInt sz = (sizeof(MP_INT)+
(((MP_INT *)(next+1))->_mp_alloc*sizeof(mp_limb_t)))/CellSize;
MARK(next);
/* size is given by functor + friends */
if (next < HGEN)
total_oldies += 2+sz;
total_marked += 2+sz;
PUSH_POINTER(next); PUSH_POINTER(next);
for (i = 1; i <= (sizeof(MP_INT)+ sz++;
(((MP_INT *)(next+1))->_mp_alloc*sizeof(mp_limb_t)))/CellSize; MARK(next+sz);
i++) { PUSH_POINTER(next+sz);
PUSH_POINTER(next+i);
}
#if GC_NO_TAGS
MARK(next+i);
#endif
PUSH_POINTER(next+i);
} }
POP_CONTINUATION(); POP_CONTINUATION();
#endif #endif
@ -1430,9 +1420,8 @@ mark_regs(tr_fr_ptr old_TR)
static void static void
mark_delays(CELL *max) mark_delays(CELL *max)
{ {
CELL *ptr = (CELL *)Yap_GlobalBase; for (; max < H0; max++) {
for (; ptr < max; ptr++) { mark_external_reference2(max);
mark_external_reference2(ptr);
} }
} }
#endif #endif
@ -3035,68 +3024,43 @@ compact_heap(void)
for (current = H - 1; current >= start_from; current--) { for (current = H - 1; current >= start_from; current--) {
if (MARKED_PTR(current)) { if (MARKED_PTR(current)) {
CELL ccell = UNMARK_CELL(*current); CELL ccell = UNMARK_CELL(*current);
if (
IN_BETWEEN(EndSpecials, ccell, MAX_SPECIALS_TAG) /* two first pages */
&& IsVarTerm(ccell)
) {
/* oops, we found a blob */
int nofcells = (UNMARK_CELL(*current)-EndSpecials) / sizeof(CELL);
CELL *ptr;
if (!nofcells) {
/* Arrays */
nofcells = current[-1];
}
ptr = current - nofcells;
if (MARKED_PTR(ptr)) {
#ifdef DEBUG
found_marked+=nofcells;
#endif /* DEBUG */
if (current <= next_hb) {
gc_B = update_B_H(gc_B, current, dest, dest+1
#ifdef TABLING
, &depfr
#endif
);
next_hb = set_next_hb(gc_B);
}
/* this one's being used */
/* first swap the tag so that it will be seen by the next step */
{
CELL tmp = current[0];
current[0] = ptr[1];
#if GC_NO_TAGS
MARK(ptr+1);
#endif
ptr[1] = tmp;
}
if (in_garbage > 0) {
current[1] = in_garbage;
in_garbage = 0;
}
dest -= nofcells;
current = ptr;
/* process the functor next */
} else {
/* skip the term */
in_garbage += nofcells+1;
current = ptr;
continue;
}
} else {
if (current <= next_hb) {
gc_B = update_B_H(gc_B, current, dest, dest+1
#ifdef TABLING
, &depfr
#endif
);
next_hb = set_next_hb(gc_B);
}
}
if (in_garbage > 0) { if (in_garbage > 0) {
current[1] = in_garbage; current[1] = in_garbage;
in_garbage = 0; in_garbage = 0;
} }
if (current <= next_hb) {
gc_B = update_B_H(gc_B, current, dest, dest+1
#ifdef TABLING
, &depfr
#endif
);
next_hb = set_next_hb(gc_B);
}
if (ccell == EndSpecials) {
/* oops, we found a blob */
CELL *ptr = current-1;
UInt nofcells;
while (!MARKED_PTR(ptr)) ptr--;
nofcells = current-ptr;
ptr++;
#if GC_NO_TAGS
MARK(ptr);
#else
XXX BROKEN CODE
#endif
found_marked+=nofcells;
/* first swap the tag so that it will be seen by the next step */
current[0] = ptr[0];
ptr[0] = EndSpecials;
dest -= nofcells;
current = ptr;
continue;
/* process the functor on a separate cycle */
}
#ifdef DEBUG #ifdef DEBUG
found_marked++; found_marked++;
#endif /* DEBUG */ #endif /* DEBUG */
@ -3125,6 +3089,11 @@ compact_heap(void)
start_from[0] = in_garbage; start_from[0] = in_garbage;
#ifdef DEBUG #ifdef DEBUG
if (dest != start_from-1)
fprintf(Yap_stderr,"%% Bad Dest (%d): %p should be %p\n",
GcCalls,
dest,
start_from);
if (total_marked != found_marked) if (total_marked != found_marked)
fprintf(Yap_stderr,"%% Upward (%d): %ld total against %ld found\n", fprintf(Yap_stderr,"%% Upward (%d): %ld total against %ld found\n",
GcCalls, GcCalls,
@ -3145,22 +3114,19 @@ compact_heap(void)
CELL ccur = *current; CELL ccur = *current;
if (MARKED_PTR(current)) { if (MARKED_PTR(current)) {
CELL uccur = UNMARK_CELL(ccur); CELL uccur = UNMARK_CELL(ccur);
if ( if (uccur == EndSpecials) {
uccur < MAX_SPECIALS_TAG && /* two first pages */ CELL *old_dest = dest;
uccur > EndSpecials && IsVarTerm(uccur)) {
/* oops, we found a blob */
int nofcells = (uccur-EndSpecials) / sizeof(CELL) , i;
CELL *current0=current-1;
//FIX THIS dest++;
*dest++ = current[nofcells-1]; current++;
current ++; while (!MARKED_PTR(current)) {
for (i = 0; i < nofcells-2; i++) {
*dest++ = *current++; *dest++ = *current++;
} }
*dest++ = ccur; *old_dest = *current;
*dest++ = EndSpecials;
#ifdef DEBUG #ifdef DEBUG
found_marked += nofcells; found_marked += (dest-old_dest);
#endif #endif
continue; continue;
} }
@ -3207,69 +3173,6 @@ compact_heap(void)
} }
#ifdef HYBRID_SCHEME #ifdef HYBRID_SCHEME
static void
adjust_cp_hbs(void)
{
#ifdef TABLING
dep_fr_ptr depfr = LOCAL_top_dep_fr;
#endif /* TABLING */
choiceptr gc_B = B;
CELL_PTR *top = iptop-1, *base = (CELL_PTR *)H;
#ifdef TABLING
if (depfr != NULL && gc_B >= DepFr_cons_cp(depfr)) {
gc_B = DepFr_cons_cp(depfr);
depfr = DepFr_next(depfr);
}
#endif
while (gc_B != NULL) {
CELL *gc_H = gc_B->cp_h;
CELL_PTR *nbase = base;
#ifdef TABLING
if (depfr && gc_B >= DepFr_cons_cp(depfr)) {
gc_B = DepFr_cons_cp(depfr);
depfr = DepFr_next(depfr);
continue;
}
#endif /* TABLING */
if (top[0] <= gc_H) {
if (top[0] == gc_H) {
gc_B->cp_h = H0+(top-base);
} else {
gc_B->cp_h = H0+((top+1)-base);
}
} else while (TRUE) {
CELL_PTR *nxt = nbase+(top-nbase)/2;
if (nxt[0] > gc_H) {
if (nbase == top) {
if (nbase == base) {
gc_B->cp_h = H0;
break;
} else {
Yap_Error(SYSTEM_ERROR,TermNil,"Bug in Garbage collector");
return;
}
}
top = nxt;
} else if (nxt[0] < gc_H && nxt[1] < gc_H) {
nbase = nxt+1;
} else if (nxt[0] == gc_H) {
gc_B->cp_h = H0+(nxt-base);
top = nxt;
break;
} else {
gc_B->cp_h = H0+((nxt-base)+1);
top = nxt+1;
break;
}
}
gc_B = gc_B->cp_b;
}
}
/* /*
* move marked objects on the heap upwards over unmarked objects, and reset * move marked objects on the heap upwards over unmarked objects, and reset
* all pointers to point to new locations * all pointers to point to new locations
@ -3278,9 +3181,15 @@ static void
icompact_heap(void) icompact_heap(void)
{ {
CELL_PTR *iptr, *ibase = (CELL_PTR *)H; CELL_PTR *iptr, *ibase = (CELL_PTR *)H;
CELL_PTR dest;
CELL *next_hb;
#ifdef DEBUG #ifdef DEBUG
Int found_marked = 0; Int found_marked = 0;
#endif /* DEBUG */ #endif /* DEBUG */
#ifdef TABLING
dep_fr_ptr depfr = LOCAL_top_dep_fr;
#endif /* TABLING */
choiceptr gc_B = B;
/* /*
* upward phase - scan heap from high to low, setting marked upward * upward phase - scan heap from high to low, setting marked upward
@ -3288,39 +3197,51 @@ icompact_heap(void)
* objects pointed to * objects pointed to
*/ */
#ifdef TABLING
if (depfr != NULL && gc_B >= DepFr_cons_cp(depfr)) {
gc_B = DepFr_cons_cp(depfr);
depfr = DepFr_next(depfr);
}
#endif
next_hb = set_next_hb(gc_B);
dest = (CELL_PTR) H0 + total_marked - 1;
for (iptr = iptop - 1; iptr >= ibase; iptr--) { for (iptr = iptop - 1; iptr >= ibase; iptr--) {
CELL ccell; CELL ccell;
CELL_PTR current; CELL_PTR current;
current = *iptr; current = *iptr;
ccell = UNMARK_CELL(*current); ccell = UNMARK_CELL(*current);
if (ccell < MAX_SPECIALS_TAG && /* two first pages */ if (current <= next_hb) {
ccell > EndSpecials && IsVarTerm(ccell) gc_B = update_B_H(gc_B, current, dest, dest+1
) { #ifdef TABLING
/* oops, we found a blob */ , &depfr
int nofcells = (UNMARK_CELL(*current)-EndSpecials) / sizeof(CELL);
CELL *ptr = current - nofcells ;
iptr -= nofcells;
#ifdef DEBUG
found_marked+=nofcells;
#endif /* DEBUG */
/* this one's being used */
/* first swap the tag so that it will be seen by the next step */
{
CELL tmp = current[0];
current[0] = ptr[1];
#if GC_NO_TAGS
MARK(ptr+1);
#endif #endif
ptr[1] = tmp; );
} next_hb = set_next_hb(gc_B);
current = ptr; }
if (ccell == EndSpecials) {
/* oops, we found a blob */
CELL_PTR ptr;
UInt nofcells;
/* use the first cell after the functor for all our dirty tricks */
ptr = iptr[-1]+1;
nofcells = current-ptr;
#ifdef DEBUG
found_marked+=(nofcells+1);
#endif /* DEBUG */
dest -= nofcells+1;
/* this one's being used */
/* make the second step see the EndSpecial tag */
current[0] = ptr[0];
ptr[0] = EndSpecials;
iptr[0] = ptr;
continue;
} }
#ifdef DEBUG #ifdef DEBUG
found_marked++; found_marked++;
#endif /* DEBUG */ #endif /* DEBUG */
update_relocation_chain(current, H0+(iptr-ibase)); update_relocation_chain(current, dest);
if (HEAP_PTR(*current)) { if (HEAP_PTR(*current)) {
CELL_PTR next; CELL_PTR next;
next = GET_NEXT(*current); next = GET_NEXT(*current);
@ -3330,15 +3251,22 @@ icompact_heap(void)
else if (current == next) { /* cell pointing to else if (current == next) { /* cell pointing to
* itself */ * itself */
#if GC_NO_TAGS #if GC_NO_TAGS
*current = (CELL) (H0+(iptr-ibase)); /* no tag */ UNRMARK(current);
*current = (CELL) dest; /* no tag */
#else #else
*current = (*current & MBIT) | (CELL) (H0+(iptr-ibase)); /* no tag */ *current = (*current & MBIT) | (CELL) dest; /* no tag */
#endif #endif
} }
} }
dest--;
} }
#ifdef DEBUG #ifdef DEBUG
if (dest != H0-1)
fprintf(Yap_stderr,"%% Bad Dest (%d): %p should be %p\n",
GcCalls,
dest,
H0-1);
if (total_marked != found_marked) if (total_marked != found_marked)
fprintf(Yap_stderr,"%% Upward (%d): %ld total against %ld found\n", fprintf(Yap_stderr,"%% Upward (%d): %ld total against %ld found\n",
GcCalls, GcCalls,
@ -3354,25 +3282,27 @@ icompact_heap(void)
* locations * locations
*/ */
dest = H0;
for (iptr = ibase; iptr < iptop; iptr++) { for (iptr = ibase; iptr < iptop; iptr++) {
CELL_PTR next; CELL_PTR next;
CELL *current = *iptr; CELL *current = *iptr;
CELL ccur = *current; CELL ccur = *current;
CELL_PTR dest = H0+(iptr-ibase);
CELL uccur = UNMARK_CELL(ccur); CELL uccur = UNMARK_CELL(ccur);
if (uccur < MAX_SPECIALS_TAG && uccur > EndSpecials && IsVarTerm(uccur)) {
/* oops, we found a blob */
int nofcells = (uccur-EndSpecials) / sizeof(CELL) , i;
*dest++ = current[nofcells-1]; if (uccur == EndSpecials) {
current ++; CELL *old_dest = dest;
for (i = 0; i < nofcells-2; i++) {
/* leave a hole */
dest++;
current++;
while (!MARKED_PTR(current)) {
*dest++ = *current++; *dest++ = *current++;
} }
*dest = ccur; /* fill in hole */
iptr += nofcells-1; *old_dest = *current;
*dest++ = EndSpecials;
#ifdef DEBUG #ifdef DEBUG
found_marked += nofcells; found_marked += dest-old_dest;
#endif #endif
continue; continue;
} }
@ -3388,12 +3318,18 @@ icompact_heap(void)
*dest = ccur; *dest = ccur;
into_relocation_chain(dest, next); into_relocation_chain(dest, next);
UNMARK(dest); UNMARK(dest);
dest++;
} else { } else {
/* just move current cell */ /* just move current cell */
*dest = ccur = UNMARK_CELL(ccur); *dest++ = ccur = UNMARK_CELL(ccur);
} }
} }
#ifdef DEBUG #ifdef DEBUG
if (H0+total_marked != dest)
fprintf(Yap_stderr,"%% Downward (%d): %p total against %p found\n",
GcCalls,
H0+total_marked,
dest);
if (total_marked != found_marked) if (total_marked != found_marked)
fprintf(Yap_stderr,"%% Downward (%d): %ld total against %ld found\n", fprintf(Yap_stderr,"%% Downward (%d): %ld total against %ld found\n",
GcCalls, GcCalls,
@ -3401,7 +3337,7 @@ icompact_heap(void)
(unsigned long int)found_marked); (unsigned long int)found_marked);
#endif #endif
H = H0+(iptop-ibase); /* reset H */ H = dest; /* reset H */
HB = B->cp_h; HB = B->cp_h;
#ifdef TABLING #ifdef TABLING
if (B_FZ == (choiceptr)LCL0) if (B_FZ == (choiceptr)LCL0)
@ -3482,17 +3418,16 @@ sweep_oldgen(CELL *max, CELL *base)
#ifdef COROUTINING #ifdef COROUTINING
static void static void
sweep_delays(CELL *max) sweep_delays(CELL *max, CELL *myH0)
{ {
CELL *ptr = (CELL *)Yap_GlobalBase; while (max < myH0) {
while (ptr < max) { if (MARKED_PTR(max)) {
if (MARKED_PTR(ptr)) { UNMARK(max);
UNMARK(ptr); if (HEAP_PTR(*max)) {
if (HEAP_PTR(*ptr)) { into_relocation_chain(max, GET_NEXT(*max));
into_relocation_chain(ptr, GET_NEXT(*ptr));
} }
} }
ptr++; max++;
} }
} }
#endif #endif
@ -3506,7 +3441,7 @@ sweep_delays(CELL *max)
static void static void
compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max) compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
{ {
CELL *CurrentH0 = NULL; CELL *CurrentH0 = NULL, *myH0 = H0;
int icompact = (iptop < (CELL_PTR *)ASP && 10*total_marked < H-H0); int icompact = (iptop < (CELL_PTR *)ASP && 10*total_marked < H-H0);
@ -3524,7 +3459,7 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
} }
} }
#ifdef COROUTINING #ifdef COROUTINING
sweep_delays(max); sweep_delays(max, myH0);
#endif #endif
sweep_environments(current_env, EnvSize(curp), EnvBMap((CELL *)curp)); sweep_environments(current_env, EnvSize(curp), EnvBMap((CELL *)curp));
sweep_choicepoints(B); sweep_choicepoints(B);
@ -3532,12 +3467,14 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
#ifdef HYBRID_SCHEME #ifdef HYBRID_SCHEME
if (icompact) { if (icompact) {
#ifdef DEBUG #ifdef DEBUG
/*
if (total_marked if (total_marked
#ifdef COROUTINING #ifdef COROUTINING
-total_smarked -total_smarked
#endif #endif
!= iptop-(CELL_PTR *)H && iptop < (CELL_PTR *)ASP -1024) != iptop-(CELL_PTR *)H && iptop < (CELL_PTR *)ASP -1024)
fprintf(Yap_stderr,"%% Oops on iptop-H (%ld) vs %ld\n", (unsigned long int)(iptop-(CELL_PTR *)H), total_marked); fprintf(Yap_stderr,"%% Oops on iptop-H (%ld) vs %ld\n", (unsigned long int)(iptop-(CELL_PTR *)H), total_marked);
*/
#endif #endif
#if DEBUGX #if DEBUGX
int effectiveness = (((H-H0)-total_marked)*100)/(H-H0); int effectiveness = (((H-H0)-total_marked)*100)/(H-H0);
@ -3550,7 +3487,6 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
CurrentH0 = NULL; CurrentH0 = NULL;
} }
quicksort((CELL_PTR *)H, 0, (iptop-(CELL_PTR *)H)-1); quicksort((CELL_PTR *)H, 0, (iptop-(CELL_PTR *)H)-1);
adjust_cp_hbs();
icompact_heap(); icompact_heap();
} else } else
#endif /* HYBRID_SCHEME */ #endif /* HYBRID_SCHEME */
@ -3589,7 +3525,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
gc_trace = FALSE; gc_trace = FALSE;
#if COROUTINING #if COROUTINING
max = (CELL *)DelayTop(); max = (CELL *)DelayTop();
while (H0 - max < 1024+(2*NUM_OF_ATTS)) { while (max - (CELL*)Yap_GlobalBase < 1024+(2*NUM_OF_ATTS)) {
if (!Yap_growglobal(&current_env)) { if (!Yap_growglobal(&current_env)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return -1; return -1;

7
C/init.c
View File

@ -971,6 +971,9 @@ InitCodes(void)
Yap_heap_regs->wl[i].scratchpad.msz = SCRATCH_START_SIZE; Yap_heap_regs->wl[i].scratchpad.msz = SCRATCH_START_SIZE;
Yap_heap_regs->wl[i].dynamic_arrays = NULL; Yap_heap_regs->wl[i].dynamic_arrays = NULL;
Yap_heap_regs->wl[i].static_arrays = NULL; Yap_heap_regs->wl[i].static_arrays = NULL;
Yap_heap_regs->wl[i].global_variables = NULL;
Yap_heap_regs->wl[i].global_arena = 0L;
Yap_heap_regs->wl[i].global_delay_arena = 0L;
Yap_heap_regs->wl[i].consultlow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj)*InitialConsultCapacity); Yap_heap_regs->wl[i].consultlow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj)*InitialConsultCapacity);
if (Yap_heap_regs->wl[i].consultlow == NULL) { if (Yap_heap_regs->wl[i].consultlow == NULL) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCodes"); Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCodes");
@ -984,6 +987,9 @@ InitCodes(void)
#else #else
Yap_heap_regs->wl.dynamic_arrays = NULL; Yap_heap_regs->wl.dynamic_arrays = NULL;
Yap_heap_regs->wl.static_arrays = NULL; Yap_heap_regs->wl.static_arrays = NULL;
Yap_heap_regs->wl.global_variables = NULL;
Yap_heap_regs->wl.global_arena = 0L;
Yap_heap_regs->wl.global_delay_arena = 0L;
Yap_heap_regs->wl.consultlow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj)*InitialConsultCapacity); Yap_heap_regs->wl.consultlow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj)*InitialConsultCapacity);
if (Yap_heap_regs->wl.consultlow == NULL) { if (Yap_heap_regs->wl.consultlow == NULL) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCodes"); Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCodes");
@ -1171,6 +1177,7 @@ InitCodes(void)
Yap_heap_regs->functor_mutable = Yap_MkFunctor(Yap_FullLookupAtom("$mutable_variable"), Yap_heap_regs->functor_mutable = Yap_MkFunctor(Yap_FullLookupAtom("$mutable_variable"),
sizeof(timed_var)/sizeof(CELL)); sizeof(timed_var)/sizeof(CELL));
#endif #endif
Yap_heap_regs->functor_nb_queue = Yap_MkFunctor(Yap_LookupAtom("queue"), 5);
Yap_heap_regs->functor_not = Yap_MkFunctor(AtomNot, 1); Yap_heap_regs->functor_not = Yap_MkFunctor(AtomNot, 1);
Yap_heap_regs->functor_or = Yap_MkFunctor(AtomSemic, 2); Yap_heap_regs->functor_or = Yap_MkFunctor(AtomSemic, 2);
Yap_heap_regs->functor_portray = Yap_MkFunctor(AtomPortray, 1); Yap_heap_regs->functor_portray = Yap_MkFunctor(AtomPortray, 1);

1
C/save.c
View File

@ -881,6 +881,7 @@ get_regs(int flag)
OldH = H; OldH = H;
OldTR = TR; OldTR = TR;
GDiff = Unsigned(NewGlobalBase) - Unsigned(Yap_GlobalBase); GDiff = Unsigned(NewGlobalBase) - Unsigned(Yap_GlobalBase);
GDiff0 = 0;
LDiff = Unsigned(NewLCL0) - Unsigned(LCL0); LDiff = Unsigned(NewLCL0) - Unsigned(LCL0);
TrDiff = LDiff; TrDiff = LDiff;
Yap_GlobalBase = (ADDR)NewGlobalBase; Yap_GlobalBase = (ADDR)NewGlobalBase;

27
C/stdpreds.c
View File

@ -11,8 +11,12 @@
* File: stdpreds.c * * File: stdpreds.c *
* comments: General-purpose C implemented system predicates * * comments: General-purpose C implemented system predicates *
* * * *
* Last rev: $Date: 2006-08-07 18:51:44 $,$Author: vsc $ * * Last rev: $Date: 2006-08-22 16:12:46 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.106 2006/08/07 18:51:44 vsc
* fix garbage collector not to try to garbage collect when we ask for large
* chunks of stack in a single go.
*
* Revision 1.105 2006/06/05 19:36:00 vsc * Revision 1.105 2006/06/05 19:36:00 vsc
* hacks * hacks
* *
@ -3000,21 +3004,22 @@ Yap_InitCPreds(void)
Yap_InitCPred("dump_active_goals", 0, p_dump_active_goals, SafePredFlag|SyncPredFlag); Yap_InitCPred("dump_active_goals", 0, p_dump_active_goals, SafePredFlag|SyncPredFlag);
#endif #endif
Yap_InitUnify(); Yap_InitArrayPreds();
Yap_InitInlines();
Yap_InitCdMgr();
Yap_InitExecFs();
Yap_InitIOPreds();
Yap_InitCmpPreds();
Yap_InitDBPreds();
Yap_InitBBPreds(); Yap_InitBBPreds();
Yap_InitBigNums(); Yap_InitBigNums();
Yap_InitSysPreds(); Yap_InitCdMgr();
Yap_InitSavePreds(); Yap_InitCmpPreds();
Yap_InitCoroutPreds(); Yap_InitCoroutPreds();
Yap_InitArrayPreds(); Yap_InitDBPreds();
Yap_InitExecFs();
Yap_InitGlobals();
Yap_InitInlines();
Yap_InitIOPreds();
Yap_InitLoadForeign(); Yap_InitLoadForeign();
Yap_InitModulesC(); Yap_InitModulesC();
Yap_InitSavePreds();
Yap_InitSysPreds();
Yap_InitUnify();
#if defined CUT_C && defined MYDDAS_MYSQL #if defined CUT_C && defined MYDDAS_MYSQL
Yap_InitMYDDAS_MySQLPreds(); Yap_InitMYDDAS_MySQLPreds();
#endif #endif

2
C/tracer.c
View File

@ -359,7 +359,7 @@ volatile int vsc_wait;
static Int p_vsc_wait(void) static Int p_vsc_wait(void)
{ {
fprintf(stderr,"attach %d\n",getpid()); fprintf(stderr,"attach %d\n",(int)getpid());
while (!vsc_wait); while (!vsc_wait);
vsc_wait=1; vsc_wait=1;
return(TRUE); return(TRUE);

2
C/utilpreds.c
View File

@ -209,7 +209,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
if (dvars == NULL) { if (dvars == NULL) {
dvars = (CELL *)DelayTop(); dvars = (CELL *)DelayTop();
} }
if (ptd0 >= dvars) { if (ptd0 < dvars) {
*ptf++ = (CELL) ptd0; *ptf++ = (CELL) ptd0;
} else { } else {
tr_fr_ptr CurTR; tr_fr_ptr CurTR;

2
C/write.c
View File

@ -342,7 +342,7 @@ write_var(CELL *t, struct write_globs *wglb)
#endif #endif
#endif #endif
wrputc('D', wglb->writech); wrputc('D', wglb->writech);
wrputn(((Int) (t- CellPtr(Yap_GlobalBase))),wglb->writech); wrputn((Int) ((attvar_record *)H0-(attvar_record *)t),wglb->writech);
} else { } else {
wrputn(((Int) (t- H0)),wglb->writech); wrputn(((Int) (t- H0)),wglb->writech);
} }

14
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.102 2006-08-02 18:18:30 vsc Exp $ * * version: $Id: Heap.h,v 1.103 2006-08-22 16:12:46 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* information that can be stored in Code Space */ /* information that can be stored in Code Space */
@ -74,12 +74,14 @@ typedef struct scratch_block_struct {
typedef struct restore_info { typedef struct restore_info {
Int cl_diff, Int cl_diff,
g_diff, g_diff,
g_diff0,
h_diff, h_diff,
l_diff, l_diff,
tr_diff, tr_diff,
x_diff, x_diff,
delay_diff; delay_diff;
CELL *old_ASP, *old_LCL0; CELL *old_ASP, *old_LCL0;
CELL *g_split;
tr_fr_ptr old_TR; tr_fr_ptr old_TR;
CELL *old_GlobalBase, *old_H, *old_H0; CELL *old_GlobalBase, *old_H, *old_H0;
ADDR old_TrailBase, old_TrailTop; ADDR old_TrailBase, old_TrailTop;
@ -160,6 +162,9 @@ typedef struct worker_local_struct {
jmp_buf gc_restore; /* where to jump if garbage collection crashes */ jmp_buf gc_restore; /* where to jump if garbage collection crashes */
struct array_entry *dynamic_arrays; struct array_entry *dynamic_arrays;
struct static_array_entry *static_arrays; struct static_array_entry *static_arrays;
struct global_entry *global_variables;
Term global_arena;
Term global_delay_arena;
yamop trust_lu_code[3]; yamop trust_lu_code[3];
} worker_local; } worker_local;
@ -450,6 +455,7 @@ typedef struct various_codes {
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
functor_mutable, functor_mutable,
#endif #endif
functor_nb_queue,
functor_not, functor_not,
functor_or, functor_or,
functor_portray, functor_portray,
@ -733,6 +739,7 @@ struct various_codes *Yap_heap_regs;
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
#define FunctorMutable Yap_heap_regs->functor_mutable #define FunctorMutable Yap_heap_regs->functor_mutable
#endif #endif
#define FunctorNBQueue Yap_heap_regs->functor_nb_queue
#define FunctorNot Yap_heap_regs->functor_not #define FunctorNot Yap_heap_regs->functor_not
#define FunctorOr Yap_heap_regs->functor_or #define FunctorOr Yap_heap_regs->functor_or
#define FunctorPortray Yap_heap_regs->functor_portray #define FunctorPortray Yap_heap_regs->functor_portray
@ -842,6 +849,8 @@ struct various_codes *Yap_heap_regs;
#define OldHeapTop RINFO.old_HeapTop #define OldHeapTop RINFO.old_HeapTop
#define ClDiff RINFO.cl_diff #define ClDiff RINFO.cl_diff
#define GDiff RINFO.g_diff #define GDiff RINFO.g_diff
#define GDiff0 RINFO.g_diff0
#define GSplit RINFO.g_split
#define HDiff RINFO.h_diff #define HDiff RINFO.h_diff
#define LDiff RINFO.l_diff #define LDiff RINFO.l_diff
#define TrDiff RINFO.tr_diff #define TrDiff RINFO.tr_diff
@ -880,6 +889,9 @@ struct various_codes *Yap_heap_regs;
#define TrustLUCode Yap_heap_regs->WL.trust_lu_code #define TrustLUCode Yap_heap_regs->WL.trust_lu_code
#define DynamicArrays Yap_heap_regs->WL.dynamic_arrays #define DynamicArrays Yap_heap_regs->WL.dynamic_arrays
#define StaticArrays Yap_heap_regs->WL.static_arrays #define StaticArrays Yap_heap_regs->WL.static_arrays
#define GlobalVariables Yap_heap_regs->WL.global_variables
#define GlobalArena Yap_heap_regs->WL.global_arena
#define GlobalDelayArena Yap_heap_regs->WL.global_delay_arena
#define profiling Yap_heap_regs->compiler_profiling #define profiling Yap_heap_regs->compiler_profiling
#define call_counting Yap_heap_regs->compiler_call_counting #define call_counting Yap_heap_regs->compiler_call_counting
#define compile_arrays Yap_heap_regs->compiler_compile_arrays #define compile_arrays Yap_heap_regs->compiler_compile_arrays

72
H/TermExt.h
View File

@ -10,7 +10,7 @@
* File: TermExt.h * * File: TermExt.h *
* mods: * * mods: *
* comments: Extensions to standard terms for YAP * * comments: Extensions to standard terms for YAP *
* version: $Id: TermExt.h,v 1.9 2006-05-19 14:31:32 vsc Exp $ * * version: $Id: TermExt.h,v 1.10 2006-08-22 16:12:46 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#ifdef USE_SYSTEM_MALLOC #ifdef USE_SYSTEM_MALLOC
@ -43,35 +43,18 @@
typedef enum typedef enum
{ {
#if defined(IN_SECOND_QUADRANT) && !GC_NO_TAGS
db_ref_e = sizeof (Functor *) | RBIT,
long_int_e = 2 * sizeof (Functor *) | RBIT,
#ifdef USE_GMP
big_int_e = 3 * sizeof (Functor *) | RBIT,
double_e = 4 * sizeof (Functor *) | RBIT
#else
double_e = 3 * sizeof (Functor *) | RBIT
#endif
#else
db_ref_e = sizeof (Functor *), db_ref_e = sizeof (Functor *),
long_int_e = 2 * sizeof (Functor *), long_int_e = 2 * sizeof (Functor *),
#ifdef USE_GMP
big_int_e = 3 * sizeof (Functor *), big_int_e = 3 * sizeof (Functor *),
double_e = 4 * sizeof (Functor *) double_e = 4 * sizeof (Functor *)
#else
double_e = 3 * sizeof (Functor *)
#endif
#endif
} }
blob_type; blob_type;
#define FunctorDBRef ((Functor)(db_ref_e)) #define FunctorDBRef ((Functor)(db_ref_e))
#define FunctorLongInt ((Functor)(long_int_e)) #define FunctorLongInt ((Functor)(long_int_e))
#ifdef USE_GMP
#define FunctorBigInt ((Functor)(big_int_e)) #define FunctorBigInt ((Functor)(big_int_e))
#endif
#define FunctorDouble ((Functor)(double_e)) #define FunctorDouble ((Functor)(double_e))
#define EndSpecials (double_e) #define EndSpecials (double_e+sizeof(Functor *))
inline EXTERN blob_type BlobOfFunctor (Functor f); inline EXTERN blob_type BlobOfFunctor (Functor f);
@ -141,14 +124,7 @@ typedef struct special_functors_struct
special_functors; special_functors;
#endif #endif
#if USE_SYSTEM_MALLOC
#define MAX_SPECIALS_TAG (4*4096)
#else
#define MAX_SPECIALS_TAG ((CELL)AtomBase)
#endif
#if SIZEOF_DOUBLE == SIZEOF_LONG_INT #if SIZEOF_DOUBLE == SIZEOF_LONG_INT
#if GC_NO_TAGS
inline EXTERN Term MkFloatTerm (Float); inline EXTERN Term MkFloatTerm (Float);
@ -156,27 +132,11 @@ inline EXTERN Term
MkFloatTerm (Float dbl) MkFloatTerm (Float dbl)
{ {
return (Term) ((H[0] = (CELL) FunctorDouble, *(Float *) (H + 1) = return (Term) ((H[0] = (CELL) FunctorDouble, *(Float *) (H + 1) =
dbl, H[2] = (2 * sizeof (CELL) + EndSpecials), H += dbl, H[2] = EndSpecials, H +=
3, AbsAppl (H - 3))); 3, AbsAppl (H - 3)));
} }
#else
inline EXTERN Term MkFloatTerm (Float);
inline EXTERN Term
MkFloatTerm (Float dbl)
{
return (Term) ((H[0] = (CELL) FunctorDouble, *(Float *) (H + 1) =
dbl, H[2] = ((2 * sizeof (CELL) + EndSpecials) | MBIT), H +=
3, AbsAppl (H - 3)));
}
#endif
inline EXTERN Float FloatOfTerm (Term t); inline EXTERN Float FloatOfTerm (Term t);
inline EXTERN Float inline EXTERN Float
@ -223,8 +183,6 @@ CpFloatUnaligned (CELL * ptr)
#endif #endif
#if GC_NO_TAGS
inline EXTERN Term MkFloatTerm (Float); inline EXTERN Term MkFloatTerm (Float);
inline EXTERN Term inline EXTERN Term
@ -232,27 +190,11 @@ MkFloatTerm (Float dbl)
{ {
return (Term) ((AlignGlobalForDouble (), H[0] = return (Term) ((AlignGlobalForDouble (), H[0] =
(CELL) FunctorDouble, *(Float *) (H + 1) = dbl, H[3] = (CELL) FunctorDouble, *(Float *) (H + 1) = dbl, H[3] =
(3 * sizeof (CELL) + EndSpecials), H += EndSpecials, H +=
4, AbsAppl (H - 4))); 4, AbsAppl (H - 4)));
} }
#else
inline EXTERN Term MkFloatTerm (Float);
inline EXTERN Term
MkFloatTerm (Float dbl)
{
return (Term) ((AlignGlobalForDouble (), H[0] =
(CELL) FunctorDouble, *(Float *) (H + 1) = dbl, H[3] =
((3 * sizeof (CELL) + EndSpecials) | MBIT), H +=
4, AbsAppl (H - 4)));
}
#endif
inline EXTERN Float FloatOfTerm (Term t); inline EXTERN Float FloatOfTerm (Term t);
@ -292,11 +234,7 @@ MkLongIntTerm (Int i)
{ {
H[0] = (CELL) FunctorLongInt; H[0] = (CELL) FunctorLongInt;
H[1] = (CELL) (i); H[1] = (CELL) (i);
#if GC_NO_TAGS H[2] = EndSpecials;
H[2] = 2 * sizeof (CELL) + EndSpecials;
#else
H[2] = ((2 * sizeof (CELL) + EndSpecials) | MBIT);
#endif
H += 3; H += 3;
return AbsAppl(H - 3); return AbsAppl(H - 3);
} }

7
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto * * File: Yap.proto *
* mods: * * mods: *
* comments: Function declarations for YAP * * comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.75 2006-08-02 18:18:30 vsc Exp $ * * version: $Id: Yapproto.h,v 1.76 2006-08-22 16:12:46 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* prototype file for Yap */ /* prototype file for Yap */
@ -165,9 +165,14 @@ void STD_PROTO(Yap_inform_profiler_of_clause,(struct yami *,struct yami *,struct
#define Yap_inform_profiler_of_clause(A,B,C,D) #define Yap_inform_profiler_of_clause(A,B,C,D)
#endif #endif
/* globals.c */
Term STD_PROTO(Yap_NewArena,(UInt,CELL *));
void STD_PROTO(Yap_InitGlobals,(void));
/* grow.c */ /* grow.c */
Int STD_PROTO(Yap_total_stack_shift_time,(void)); Int STD_PROTO(Yap_total_stack_shift_time,(void));
void STD_PROTO(Yap_InitGrowPreds, (void)); void STD_PROTO(Yap_InitGrowPreds, (void));
int STD_PROTO(Yap_InsertInGlobal, (CELL *, UInt));
int STD_PROTO(Yap_growheap, (int, UInt, void *)); int STD_PROTO(Yap_growheap, (int, UInt, void *));
int STD_PROTO(Yap_growstack, (long)); int STD_PROTO(Yap_growstack, (long));
int STD_PROTO(Yap_growtrail, (long, int)); int STD_PROTO(Yap_growtrail, (long, int));

72
H/Yatom.h
View File

@ -192,9 +192,81 @@ IsFunctorProperty (int flags)
ff fa module property ff fa module property
ff fb blackboard property ff fb blackboard property
ff fc value property ff fc value property
ff fd global property
ff ff op property ff ff op property
*/ */
/* Global Variable property */
typedef struct global_entry
{
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
#if defined(YAPOR) || defined(THREADS)
rwlock_t GRWLock; /* a simple lock to protect this entry */
#if THREADS
unsigned int owner_id; /* owner thread */
#endif
#endif
struct AtomEntryStruct *AtomOfGE; /* parent atom for deletion */
struct global_entry *NextGE; /* linked list of global entries */
Term global; /* index in module table */
} GlobalEntry;
#if USE_OFFSETS_IN_PROPS
inline EXTERN GlobalEntry *RepGlobalProp (Prop p);
inline EXTERN GlobalEntry *
RepGlobalProp (Prop p)
{
return (GlobalEntry *) (AtomBase + Unsigned (p));
}
inline EXTERN Prop AbsGlobalProp (GlobalEntry * p);
inline EXTERN Prop
AbsGlobalProp (GlobalEntry * p)
{
return (Prop) (Addr (p) - AtomBase);
}
#else
inline EXTERN GlobalEntry *RepGlobalProp (Prop p);
inline EXTERN GlobalEntry *
RepGlobalProp (Prop p)
{
return (GlobalEntry *) (p);
}
inline EXTERN Prop AbsGlobalProp (GlobalEntry * p);
inline EXTERN Prop
AbsGlobalProp (GlobalEntry * p)
{
return (Prop) (p);
}
#endif
#define GlobalProperty ((PropFlags)0xfffd)
inline EXTERN PropFlags IsGlobalProperty (int);
inline EXTERN PropFlags
IsGlobalProperty (int flags)
{
return (PropFlags) ((flags == GlobalProperty));
}
/* Module property */ /* Module property */
typedef struct typedef struct
{ {

1
H/amiops.h
View File

@ -314,6 +314,7 @@ Binding Macros for Multiple Assignment Variables.
#define Bind(A,D) TRAIL(A,D); *(A) = (D) #define Bind(A,D) TRAIL(A,D); *(A) = (D)
#define Bind_Global(A,D) TRAIL_GLOBAL(A,D); *(A) = (D) #define Bind_Global(A,D) TRAIL_GLOBAL(A,D); *(A) = (D)
#define Bind_and_Trail(A,D) DO_TRAIL(A,D); *(A) = (D)
#define BIND(A,D,L) *(A) = (D); Trail(A,D,L) #define BIND(A,D,L) *(A) = (D); Trail(A,D,L)
#define BIND_GLOBAL(A,D,L) *(A) = (D); Trail_Global(A,D,L) #define BIND_GLOBAL(A,D,L) *(A) = (D); Trail_Global(A,D,L)

4
H/attvar.h
View File

@ -54,12 +54,12 @@ typedef struct attvar_struct {
static inline attvar_record * static inline attvar_record *
DelayTop(void) { DelayTop(void) {
return (attvar_record *)((attvar_record *)Yap_GlobalBase+IntegerOfTerm(Yap_ReadTimedVar(DelayedVars))); return (attvar_record *)Yap_ReadTimedVar(DelayedVars);
} }
static inline void static inline void
SetDelayTop(attvar_record *new_top) { SetDelayTop(attvar_record *new_top) {
Yap_UpdateTimedVar(DelayedVars, MkIntegerTerm((CELL)(new_top-(attvar_record *)Yap_GlobalBase))); Yap_UpdateTimedVar(DelayedVars, (CELL)new_top);
} }
#endif #endif

27
H/rheap.h
View File

@ -11,8 +11,11 @@
* File: rheap.h * * File: rheap.h *
* comments: walk through heap code * * comments: walk through heap code *
* * * *
* Last rev: $Date: 2006-08-02 18:18:30 $,$Author: vsc $ * * Last rev: $Date: 2006-08-22 16:12:46 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.68 2006/08/02 18:18:30 vsc
* preliminary support for readutil library (SWI compatible).
*
* Revision 1.67 2006/05/17 18:38:11 vsc * Revision 1.67 2006/05/17 18:38:11 vsc
* make system library use true file name * make system library use true file name
* *
@ -643,6 +646,7 @@ restore_codes(void)
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
Yap_heap_regs->functor_mutable = FuncAdjust(Yap_heap_regs->functor_mutable); Yap_heap_regs->functor_mutable = FuncAdjust(Yap_heap_regs->functor_mutable);
#endif #endif
Yap_heap_regs->functor_nb_queue = FuncAdjust(Yap_heap_regs->functor_nb_queue);
Yap_heap_regs->functor_not = FuncAdjust(Yap_heap_regs->functor_not); Yap_heap_regs->functor_not = FuncAdjust(Yap_heap_regs->functor_not);
Yap_heap_regs->functor_or = FuncAdjust(Yap_heap_regs->functor_or); Yap_heap_regs->functor_or = FuncAdjust(Yap_heap_regs->functor_or);
Yap_heap_regs->functor_portray = FuncAdjust(Yap_heap_regs->functor_portray); Yap_heap_regs->functor_portray = FuncAdjust(Yap_heap_regs->functor_portray);
@ -738,6 +742,23 @@ restore_codes(void)
Yap_heap_regs->wl.static_arrays = Yap_heap_regs->wl.static_arrays =
PtoArraySAdjust(Yap_heap_regs->wl.static_arrays); PtoArraySAdjust(Yap_heap_regs->wl.static_arrays);
} }
if (Yap_heap_regs->wl.global_variables) {
Yap_heap_regs->wl.global_variables =
PtoGlobalEAdjust(Yap_heap_regs->wl.global_variables);
}
if (Yap_heap_regs->wl.global_arena) {
if (IsAtomTerm(Yap_heap_regs->wl.global_arena)) {
Yap_heap_regs->wl.global_arena =
AtomTermAdjust(Yap_heap_regs->wl.global_arena);
} else {
Yap_heap_regs->wl.global_arena =
AbsAppl(PtoGloAdjust(RepAppl(Yap_heap_regs->wl.global_arena)));
}
}
if (Yap_heap_regs->wl.global_delay_arena) {
Yap_heap_regs->wl.global_delay_arena =
GlobalAdjust(Yap_heap_regs->wl.global_delay_arena);
}
#endif #endif
#endif #endif
if (Yap_heap_regs->last_wtime != NULL) if (Yap_heap_regs->last_wtime != NULL)
@ -896,8 +917,6 @@ restore_static_array(StaticArrayEntry *ae)
*base++ = (AtomEntry *)LocalAddrAdjust((ADDR)reg); *base++ = (AtomEntry *)LocalAddrAdjust((ADDR)reg);
} else if (IsOldGlobal((CELL)reg)) { } else if (IsOldGlobal((CELL)reg)) {
*base++ = (AtomEntry *)GlobalAddrAdjust((ADDR)reg); *base++ = (AtomEntry *)GlobalAddrAdjust((ADDR)reg);
} else if (IsOldDelay((CELL)reg)) {
*base++ = (AtomEntry *)DelayAddrAdjust((ADDR)reg);
} else if (IsOldTrail((CELL)reg)) { } else if (IsOldTrail((CELL)reg)) {
*base++ = (AtomEntry *)TrailAddrAdjust((ADDR)reg); *base++ = (AtomEntry *)TrailAddrAdjust((ADDR)reg);
} else { } else {
@ -1155,8 +1174,6 @@ RestoreEntries(PropEntry *pp)
ae->ValueOfVE = AbsAppl(PtoHeapCellAdjust(ptr)); ae->ValueOfVE = AbsAppl(PtoHeapCellAdjust(ptr));
} else if (IsOldLocalInTRPtr(ptr)) { } else if (IsOldLocalInTRPtr(ptr)) {
ae->ValueOfVE = AbsAppl(PtoLocAdjust(ptr)); ae->ValueOfVE = AbsAppl(PtoLocAdjust(ptr));
} else if (IsOldDelayPtr(ptr)) {
ae->ValueOfVE = AbsAppl(PtoDelayAdjust(ptr));
} else if (IsOldTrailPtr(ptr)) { } else if (IsOldTrailPtr(ptr)) {
ae->ValueOfVE = AbsAppl(CellPtoTRAdjust(ptr)); ae->ValueOfVE = AbsAppl(CellPtoTRAdjust(ptr));
} }

51
H/sshift.h
View File

@ -43,7 +43,11 @@ inline EXTERN CELL *PtoGloAdjust (CELL *);
inline EXTERN CELL * inline EXTERN CELL *
PtoGloAdjust (CELL * ptr) PtoGloAdjust (CELL * ptr)
{ {
return (CELL *) (((CELL *) (CharP (ptr) + GDiff))); if (ptr < GSplit) {
return (CELL *) (((CELL *) (CharP (ptr) + GDiff0)));
} else {
return (CELL *) (((CELL *) (CharP (ptr) + GDiff)));
}
} }
@ -126,7 +130,11 @@ inline EXTERN CELL GlobalAdjust (CELL);
inline EXTERN CELL inline EXTERN CELL
GlobalAdjust (CELL val) GlobalAdjust (CELL val)
{ {
return (CELL) ((val + GDiff)); if ((CELL *)val < GSplit) {
return (CELL) ((val + GDiff0));
} else {
return (CELL) ((val + GDiff));
}
} }
@ -146,7 +154,11 @@ inline EXTERN ADDR GlobalAddrAdjust (ADDR);
inline EXTERN ADDR inline EXTERN ADDR
GlobalAddrAdjust (ADDR ptr) GlobalAddrAdjust (ADDR ptr)
{ {
return (ADDR) ((ptr + GDiff)); if ((CELL *)ptr < GSplit) {
return (ADDR) ((ptr + GDiff0));
} else {
return (ADDR) ((ptr + GDiff));
}
} }
@ -481,6 +493,15 @@ PtoArrayEAdjust (ArrayEntry * ptr)
} }
inline EXTERN GlobalEntry *PtoGlobalEAdjust (GlobalEntry *);
inline EXTERN GlobalEntry *
PtoGlobalEAdjust (GlobalEntry * ptr)
{
return (GlobalEntry *) (((GlobalEntry *) (CharP (ptr) + HDiff)));
}
inline EXTERN StaticArrayEntry *PtoArraySAdjust (StaticArrayEntry *); inline EXTERN StaticArrayEntry *PtoArraySAdjust (StaticArrayEntry *);
inline EXTERN StaticArrayEntry * inline EXTERN StaticArrayEntry *
@ -608,7 +629,7 @@ inline EXTERN int IsOldGlobal (CELL);
inline EXTERN int inline EXTERN int
IsOldGlobal (CELL reg) IsOldGlobal (CELL reg)
{ {
return (int) (IN_BETWEEN (OldH0, reg, OldH)); return (int) (IN_BETWEEN (OldGlobalBase, reg, OldH));
} }
@ -618,27 +639,7 @@ inline EXTERN int IsOldGlobalPtr (CELL *);
inline EXTERN int inline EXTERN int
IsOldGlobalPtr (CELL * ptr) IsOldGlobalPtr (CELL * ptr)
{ {
return (int) (IN_BETWEEN (OldH0, ptr, OldH)); return (int) (IN_BETWEEN (OldGlobalBase, ptr, OldH));
}
inline EXTERN int IsOldDelay (CELL);
inline EXTERN int
IsOldDelay (CELL reg)
{
return (int) (IN_BETWEEN (OldGlobalBase, reg, OldH0));
}
inline EXTERN int IsOldDelayPtr (CELL *);
inline EXTERN int
IsOldDelayPtr (CELL * ptr)
{
return (int) (IN_BETWEEN (OldGlobalBase, ptr, OldH0));
} }

11
Makefile.in
View File

@ -142,7 +142,7 @@ C_SOURCES= \
$(srcdir)/C/corout.c $(srcdir)/C/dbase.c $(srcdir)/C/dlmalloc.c \ $(srcdir)/C/corout.c $(srcdir)/C/dbase.c $(srcdir)/C/dlmalloc.c \
$(srcdir)/C/errors.c \ $(srcdir)/C/errors.c \
$(srcdir)/C/eval.c $(srcdir)/C/exec.c \ $(srcdir)/C/eval.c $(srcdir)/C/exec.c \
$(srcdir)/C/gprof.c $(srcdir)/C/grow.c \ $(srcdir)/C/globals.c $(srcdir)/C/gprof.c $(srcdir)/C/grow.c \
$(srcdir)/C/heapgc.c $(srcdir)/C/index.c \ $(srcdir)/C/heapgc.c $(srcdir)/C/index.c \
$(srcdir)/C/init.c $(srcdir)/C/inlines.c \ $(srcdir)/C/init.c $(srcdir)/C/inlines.c \
$(srcdir)/C/iopreds.c $(srcdir)/C/depth_bound.c \ $(srcdir)/C/iopreds.c $(srcdir)/C/depth_bound.c \
@ -210,7 +210,7 @@ ENGINE_OBJECTS = \
bignum.o bb.o \ bignum.o bb.o \
cdmgr.o cmppreds.o compiler.o computils.o \ cdmgr.o cmppreds.o compiler.o computils.o \
corout.o cut_c.o dbase.o dlmalloc.o errors.o eval.o \ corout.o cut_c.o dbase.o dlmalloc.o errors.o eval.o \
exec.o gprof.o grow.o \ exec.o globals.o gprof.o grow.o \
heapgc.o index.o init.o inlines.o \ heapgc.o index.o init.o inlines.o \
iopreds.o depth_bound.o mavar.o \ iopreds.o depth_bound.o mavar.o \
myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_initialization.o \ myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_initialization.o \
@ -322,12 +322,15 @@ eval.o: $(srcdir)/C/eval.c
exec.o: $(srcdir)/C/exec.c exec.o: $(srcdir)/C/exec.c
$(CC) -c $(CFLAGS) $(srcdir)/C/exec.c -o $@ $(CC) -c $(CFLAGS) $(srcdir)/C/exec.c -o $@
grow.o: $(srcdir)/C/grow.c globals.o: $(srcdir)/C/globals.c
$(CC) -c $(CFLAGS) $(srcdir)/C/grow.c -o $@ $(CC) -c $(CFLAGS) $(srcdir)/C/globals.c -o $@
gprof.o: $(srcdir)/C/gprof.c gprof.o: $(srcdir)/C/gprof.c
$(CC) -c $(CFLAGS) $(srcdir)/C/gprof.c -o $@ $(CC) -c $(CFLAGS) $(srcdir)/C/gprof.c -o $@
grow.o: $(srcdir)/C/grow.c
$(CC) -c $(CFLAGS) $(srcdir)/C/grow.c -o $@
heapgc.o: $(srcdir)/C/heapgc.c heapgc.o: $(srcdir)/C/heapgc.c
$(CC) -c $(CFLAGS) $(srcdir)/C/heapgc.c -o $@ $(CC) -c $(CFLAGS) $(srcdir)/C/heapgc.c -o $@

2
changes-5.1.html
View File

@ -16,6 +16,8 @@
<h2>Yap-5.1.2:</h2> <h2>Yap-5.1.2:</h2>
<ul> <ul>
<li> NEW: global variables a la hProlog, includes major changes in
stack shifter, garbage collector, and setof.</li>
<li> FIXED: do not call garbage collector if the space we need is more <li> FIXED: do not call garbage collector if the space we need is more
than what is available (obs from Nicos Angelopoulos).</li> than what is available (obs from Nicos Angelopoulos).</li>
<li> FIXED: recordaifnot(a,_,_) was broken (obs from Jesse Davis).</li> <li> FIXED: recordaifnot(a,_,_) was broken (obs from Jesse Davis).</li>

1
configure.in
View File

@ -718,6 +718,7 @@ dnl Linux has both elf and a.out, in this case we found elf
LIBS="$LIBS -ldl" LIBS="$LIBS -ldl"
fi fi
fi fi
LIBS="$LIBS -framework JavaVM"
SHLIB_CFLAGS="-fno-common" SHLIB_CFLAGS="-fno-common"
SHLIB_SUFFIX=".dylib" SHLIB_SUFFIX=".dylib"
DO_SECOND_LD="" DO_SECOND_LD=""

68
library/dbqueues.yap
View File

@ -1,48 +1,52 @@
% A library to implement queues of DB Terms % A library to implement queues of NB Terms
:- module(dbqueue, [ :- module(nbqueue, [
db_enqueue/2, nb_enqueue/2,
db_dequeue/2, nb_dequeue/2,
db_clean_queue/1 nb_clean_queue/1
nb_size/2
]). ]).
:- unhide('$init_db_queue'). :- unhide('$init_nb_queue').
:- unhide('$db_enqueue'). :- unhide('$nb_enqueue').
:- unhide('$db_dequeue'). :- unhide('$nb_dequeue').
db_enqueue(Name,El) :- var(Name), nb_enqueue(Name,El) :- var(Name),
throw(error(instantiation_error(Name),db_enqueue(Name,El))). throw(error(instantiation_error(Name),nb_enqueue(Name,El))).
db_enqueue(Name,El) :- \+ atom(Name), !, nb_enqueue(Name,El) :- \+ atom(Name), !,
throw(error(type_error_atom(Name),db_enqueue(Name,El))). throw(error(type_error_atom(Name),nb_enqueue(Name,El))).
db_enqueue(Name,El) :- nb_enqueue(Name,El) :-
recorded('$db_queue',[Name|Ref],_), !, recorded('$nb_queue',[Name|Ref],_), !,
prolog:'$db_enqueue'(Ref, El). prolog:'$nb_enqueue'(Ref, El).
db_enqueue(Name,El) :- nb_enqueue(Name,El) :-
prolog:'$init_db_queue'(Ref), prolog:'$init_nb_queue'(Ref),
recorda('$db_queue',[Name|Ref],_), recorda('$nb_queue',[Name|Ref],_),
prolog:'$db_enqueue'(Ref,El). prolog:'$nb_enqueue'(Ref,El).
db_dequeue(Name,El) :- var(Name), nb_dequeue(Name,El) :- var(Name),
throw(error(instantiation_error(Name),db_dequeue(Name,El))). throw(error(instantiation_error(Name),nb_dequeue(Name,El))).
db_dequeue(Name,El) :- \+ atom(Name), !, nb_dequeue(Name,El) :- \+ atom(Name), !,
throw(error(type_error_atom(Name),db_dequeue(Name,El))). throw(error(type_error_atom(Name),nb_dequeue(Name,El))).
db_dequeue(Name,El) :- nb_dequeue(Name,El) :-
recorded('$db_queue',[Name|Ref],R), recorded('$nb_queue',[Name|Ref],R),
( prolog:'$db_dequeue'(Ref, El) -> ( prolog:'$nb_dequeue'(Ref, El) ->
true true
; ;
erase(R), erase(R),
fail fail
). ).
db_clean_queue(Name) :- nb_clean_queue(Name) :-
recorded('$db_queue',[Name|Ref],R), !, recorded('$nb_queue',[Name|Ref],R), !,
erase(R), erase(R),
db_dequeue_all(Ref). nb_dequeue_all(Ref).
db_clean_queue(_). nb_clean_queue(_).
db_dequeue_all(Ref) :- nb_dequeue_all(Ref) :-
( prolog:'$db_dequeue'(Ref, _) -> db_dequeue_all(Ref) ; true ). ( prolog:'$nb_dequeue'(Ref, _) -> nb_dequeue_all(Ref) ; true ).
nb_dequeue_size(Ref, Size) :-
prolog:'$nb_size'(Ref, Size).

17
library/swi.yap
View File

@ -116,23 +116,6 @@ prolog:between(I0,I,J) :- I0 < I,
I1 is I0+1, I1 is I0+1,
prolog:between(I1,I,J). prolog:between(I1,I,J).
prolog:b_getval(GlobalVariable,Value) :-
array_element(GlobalVariable,0,Value).
prolog:b_setval(GlobalVariable,Value) :-
array(GlobalVariable,1),
dynamic_update_array(GlobalVariable,0,Value).
prolog:nb_getval(GlobalVariable,Value) :-
array_element(GlobalVariable,0,Value).
prolog:nb_setval(GlobalVariable,Value) :-
static_array(GlobalVariable,1,nb_term),
update_array(GlobalVariable,0,Value).
prolog:nb_delete(GlobalVariable) :-
close_static_array(GlobalVariable).
prolog:nb_current(GlobalVariable,Val) :- prolog:nb_current(GlobalVariable,Val) :-
static_array_properties(GlobalVariable,1,nb_term), static_array_properties(GlobalVariable,1,nb_term),
array_element(GlobalVariable,0,Val). array_element(GlobalVariable,0,Val).

1
pl/boot.yap
View File

@ -46,6 +46,7 @@ true :- true.
true true
), ),
'$set_yap_flags'(10,0), '$set_yap_flags'(10,0),
'$allocate_default_arena'(1024, 64),
set_value(fileerrors,1), set_value(fileerrors,1),
set_value('$gc',on), set_value('$gc',on),
set_value('$lf_verbose',informational), set_value('$lf_verbose',informational),

48
pl/setof.yap
View File

@ -33,66 +33,42 @@ _^Goal :-
findall(Template, Generator, Answers) :- findall(Template, Generator, Answers) :-
'$check_list_for_bags'(Answers, findall(Template, Generator, Answers)), '$check_list_for_bags'(Answers, findall(Template, Generator, Answers)),
'$init_db_queue'(Ref), nb_queue(Ref),
'$findall'(Template, Generator, Ref, [], Answers). '$findall'(Template, Generator, Ref, [], Answers).
% If some answers have already been found % If some answers have already been found
findall(Template, Generator, Answers, SoFar) :- findall(Template, Generator, Answers, SoFar) :-
'$init_db_queue'(Ref), nb_queue(Ref),
'$findall'(Template, Generator, Ref, SoFar, Answers). '$findall'(Template, Generator, Ref, SoFar, Answers).
% starts by calling the generator, % starts by calling the generator,
% and recording the answers % and recording the answers
'$findall'(Template, Generator, Ref, _, _) :- '$findall'(Template, Generator, Ref, _, _) :-
'$catch'(Error,'$clean_findall'(Ref,Error),_),
'$execute'(Generator), '$execute'(Generator),
'$db_enqueue'(Ref, Template), nb_queue_enqueue(Ref, Template),
fail. fail.
% now wraps it all % now wraps it all
'$findall'(_, _, Ref, SoFar, Answers) :- '$findall'(_, _, Ref, SoFar, Answers) :-
'$catch'(Error,'$clean_findall'(Ref,Error),_), nb_queue_close(Ref, Answers, SoFar).
'$collect_for_findall'(Ref, SoFar, Answers), !.
% error handling: be careful to recover all the space we used up
% in implementing findall.
%
'$clean_findall'(Ref,Ball) :-
'$db_dequeue'(Ref,_), !,
'$clean_findall'(Ref,Ball).
'$clean_findall'(_,Ball) :-
% get this off the unwound computation.
copy_term(Ball,NewBall),
% get current jump point
'$jump_env_and_store_ball'(NewBall).
% by getting all answers
'$collect_for_findall'(Ref, SoFar, Out) :-
'$db_dequeue'(Ref, Term), !,
Out = [Term|Answers],
'$collect_for_findall'(Ref, SoFar, Answers).
'$collect_for_findall'(_, SoFar, SoFar).
% findall_with_key is very similar to findall, but uses the SICStus % findall_with_key is very similar to findall, but uses the SICStus
% algorithm to guarantee that variables will have the same names. % algorithm to guarantee that variables will have the same names.
% %
'$findall_with_common_vars'(Template, Generator, Ref, _) :- '$findall_with_common_vars'(Template, Generator, Ref, _) :-
'$execute'(Generator), '$execute'(Generator),
'$db_enqueue'(Ref, Template), nb_queue_enqueue(Ref, Template),
fail. fail.
% now wraps it all % now wraps it all
'$findall_with_common_vars'(_, _, Ref, Answers) :- '$findall_with_common_vars'(_, _, Ref, Answers) :-
'$collect_with_common_vars'(Ref, _, [], Answers). nb_queue_close(Ref, Answers, []),
'$collect_with_common_vars'(Answers, _).
% by getting all answers '$collect_with_common_vars'([], _).
'$collect_with_common_vars'(Ref, VarList, SoFar, Solution) :- '$collect_with_common_vars'([Key-_|Answers], VarList) :-
'$db_dequeue'(Ref, BDEntry), !,
BDEntry = Key-_,
Solution = [BDEntry|Answers],
'$variables_in_term'(Key, _, VarList), '$variables_in_term'(Key, _, VarList),
'$collect_with_common_vars'(Ref, VarList, SoFar, Answers). '$collect_with_common_vars'(Answers, VarList).
'$collect_with_common_vars'(_, _, Solution, Solution).
% This is the setof predicate % This is the setof predicate
@ -117,12 +93,12 @@ bagof(Template, Generator, Bag) :-
( FreeVars \== [] -> ( FreeVars \== [] ->
'$variables_in_term'(FreeVars, [], LFreeVars), '$variables_in_term'(FreeVars, [], LFreeVars),
Key =.. ['$'|LFreeVars], Key =.. ['$'|LFreeVars],
'$init_db_queue'(Ref), nb_queue(Ref),
'$findall_with_common_vars'(Key-Template, StrippedGenerator, Ref, Bags0), '$findall_with_common_vars'(Key-Template, StrippedGenerator, Ref, Bags0),
'$keysort'(Bags0, Bags), '$keysort'(Bags0, Bags),
'$pick'(Bags, Key, Bag) '$pick'(Bags, Key, Bag)
; ;
'$init_db_queue'(Ref), nb_queue(Ref),
'$findall'(Template, StrippedGenerator, Ref, [], Bag0), '$findall'(Template, StrippedGenerator, Ref, [], Bag0),
Bag0 \== [], Bag0 \== [],
Bag = Bag0 Bag = Bag0