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
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 ConsultObjAdjust(P) (P)
#define DelayAddrAdjust(P) (P)
#define DelayAdjust(P) (P)
#define GlobalAdjust(P) (P)
#define DBRefAdjust(P) (P)
#define DBRefPAdjust(P) (P)
#define DBTermAdjust(P) (P)
@@ -134,6 +136,7 @@ AtomAdjust(Atom a)
#define PtoStCAdjust(P) (P)
#define PtoArrayEAdjust(P) (P)
#define PtoArraySAdjust(P) (P)
#define PtoGlobalEAdjust(P) (P)
#define PtoDelayAdjust(P) (P)
#define PtoGloAdjust(P) (P)
#define PtoLocAdjust(P) (P)
@@ -282,16 +285,13 @@ mark_global(void)
* the code
*/
#if COROUTINING
CELL *ptf = (CELL *)DelayTop();
pt = (CELL *)Yap_GlobalBase;
while (pt < ptf) {
pt = mark_global_cell(pt);
}
#endif
pt = (CELL *)DelayTop();
#else
pt = H0;
#endif
while (pt < H) {
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 */
newv = DelayTop();
if (H0 - (CELL *)newv < 1024)
if ((ADDR)newv - Yap_GlobalBase < 1024*sizeof(CELL))
return FALSE;
newv--;
RESET_VARIABLE(&(newv->Value));
RESET_VARIABLE(&(newv->Done));
vt = &(attv->Atts);
@@ -94,7 +95,7 @@ CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
to_visit[3] = (CELL *)vt[-1];
*to_visit_ptr = to_visit+4;
*res = (CELL)&(newv->Done);
SetDelayTop(newv+1);
SetDelayTop(newv);
return TRUE;
}
@@ -110,13 +111,13 @@ static attvar_record *
BuildNewAttVar(void)
{
attvar_record *attv = DelayTop();
if (H0 - (CELL *)(attv+1) < 1024) {
return NULL;
}
if ((ADDR)attv - Yap_GlobalBase < 1024*sizeof(CELL))
return FALSE;
attv--;
RESET_VARIABLE(&(attv->Done));
RESET_VARIABLE(&(attv->Value));
RESET_VARIABLE(&(attv->Atts));
SetDelayTop(attv+1);
SetDelayTop(attv);
return attv;
}
@@ -415,18 +416,16 @@ AllAttVars(attvar_record *attv) {
CELL *h0 = H;
attvar_record *max = DelayTop();
while (attv != max) {
while (--attv >= max) {
if (ASP - H < 1024) {
H = h0;
Yap_Error_Size = (ASP-H)*sizeof(CELL);
return 0L;
}
if (IsVarTerm(attv->Done) && IsUnboundVar(&attv->Done)) {
if (IsIntegerTerm(attv->Atts)) {
if (IsVarTerm(attv->Atts) && VarOfTerm(attv->Atts) < (CELL *)attv) {
/* skip call residue(s) */
UInt n = IntegerOfTerm(attv->Atts)-1;
attv += n;
attv = (attvar_record *)(attv->Atts);
} else {
if (H != h0) {
H[-1] = AbsPair(H);
@@ -435,7 +434,6 @@ AllAttVars(attvar_record *attv) {
H += 2;
}
}
attv++;
}
if (H != h0) {
H[-1] = TermNil;
@@ -882,7 +880,7 @@ p_all_attvars(void)
Term out;
attvar_record *base;
base = (attvar_record *)Yap_GlobalBase+IntegerOfTerm(Yap_ReadTimedVar(AttsMutableList));
base = (attvar_record *)Yap_ReadTimedVar(AttsMutableList);
if (!(out = AllAttVars(base))) {
if (!Yap_gcl(Yap_Error_Size, 1, ENV, P)) {
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;
memmove((void *)(dst+1), (const void *)(big->_mp_d), nlimbs*CellSize);
H = (CELL *)(dst+1)+nlimbs;
if ((char *)H-(char *)ret > MAX_SPECIALS_TAG-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[0] = EndSpecials;
H++;
return AbsAppl(ret);
}

22
C/corout.c
View File

@@ -49,31 +49,25 @@ p_set_svar_list(void)
Term newl = Deref(ARG1);
attvar_record *max = DelayTop();
if (IsVarTerm(newl)) {
if (IsVarTerm(newl) && VarOfTerm(newl) > H0) {
/* set to current top */
UInt diff;
Term tdiff;
max--;
RESET_VARIABLE(&max->Done);
RESET_VARIABLE(&max->Value);
max->Atts = MkIntTerm(1);
max++;
RESET_VARIABLE(&(max->Atts));
SetDelayTop(max);
diff = max-(attvar_record *)Yap_GlobalBase;
tdiff = MkIntegerTerm(diff);
Yap_UpdateTimedVar(AttsMutableList,tdiff);
return Yap_unify(ARG1,tdiff);
Yap_UpdateTimedVar(AttsMutableList,(CELL)max);
return Yap_unify(ARG1,(CELL)max);
} else {
UInt old = IntegerOfTerm(Yap_UpdateTimedVar(AttsMutableList,newl));
attvar_record *aold = (attvar_record *)Yap_GlobalBase + (old-1);
attvar_record *aold = (attvar_record *)Yap_UpdateTimedVar(AttsMutableList,newl);
if (max > aold+1) {
if (max < aold) {
/* we are moving forward */
/* these items are protected by call-residue, should not
be visible to AllAtts
*/
MaBind(&(aold->Atts),MkIntegerTerm(max-aold));
MaBind(&(aold->Atts),(CELL)max);
}
}
#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 */
st[0] = (CELL)FunctorLongInt;
st[1] = pt[1];
#if GC_NO_TAGS
st[2] = 2*sizeof(CELL)+EndSpecials;
#else
st[2] = ((2*sizeof(CELL)+EndSpecials)|MBIT);
#endif
st[2] = EndSpecials;
/* now reserve space */
return st+3;
}
@@ -647,17 +643,9 @@ copy_double(CELL *st, CELL *pt)
st[1] = pt[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
st[2] = pt[2];
#if GC_NO_TAGS
st[3] = 3*sizeof(CELL)+EndSpecials;
st[3] = EndSpecials;
#else
st[3] = ((3*sizeof(CELL)+EndSpecials)|MBIT);
#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 */
st[2] = EndSpecials;
#endif
/* now reserve space */
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);
st = st+1+sz/CellSize;
/* then the tail for gc */
#if GC_NO_TAGS
st[0] = sz+CellSize+EndSpecials;
#else
st[0] = (sz+CellSize+EndSpecials)|MBIT;
#endif
st[0] = EndSpecials;
return st+1;
}
#endif /* BIG_INT */

7
C/exec.c
View File

@@ -1779,6 +1779,7 @@ p_generate_pred_info(void) {
void
Yap_InitYaamRegs(void)
{
Term h0var;
#if PUSH_REGS
/* Guarantee that after a longjmp we go back to the original abstract
@@ -1824,10 +1825,10 @@ Yap_InitYaamRegs(void)
/* for slots to work */
Yap_StartSlots();
#if COROUTINING
RESET_VARIABLE((CELL *)Yap_GlobalBase);
DelayedVars = Yap_NewTimedVar(MkIntTerm(0));
h0var = MkVarTerm();
DelayedVars = Yap_NewTimedVar(h0var);
WokenGoals = Yap_NewTimedVar(TermNil);
AttsMutableList = Yap_NewTimedVar(MkIntTerm(0));
AttsMutableList = Yap_NewTimedVar(h0var);
#endif
GcGeneration = Yap_NewTimedVar(MkIntTerm(0));
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 *
* 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 $
* 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
* fix do profiler offline.
*
@@ -843,7 +847,7 @@ showprofres(UInt type) {
if (calls && myp->FunctorOfPred->KindOfPE==47872) {
count+=calls;
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);
if (myp->ArityOfPE) printf("/%d",myp->ArityOfPE);
printf(" -> %lu (%3.1f%c)\n",(unsigned long int)calls,(float) calls*100/ProfCalls,'%');
@@ -868,7 +872,7 @@ showprofres(UInt type) {
}
count+=calls;
// 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);
if (t->pp->ArityOfPE) printf("/%d",t->pp->ArityOfPE);
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
#if !COROUTINING
#define DelayTop() Yap_GlobalBase
#define DelayTop() H0
#endif
static int heap_overflows = 0;
@@ -66,7 +66,6 @@ STATIC_PROTO(int growstack, (long));
STATIC_PROTO(void MoveGlobal, (void));
STATIC_PROTO(void MoveLocalAndTrail, (void));
STATIC_PROTO(void SetHeapRegs, (void));
STATIC_PROTO(void SetStackRegs, (void));
STATIC_PROTO(void AdjustTrail, (int));
STATIC_PROTO(void AdjustLocal, (void));
STATIC_PROTO(void AdjustGlobal, (void));
@@ -86,7 +85,7 @@ cpcellsd(register CELL *Dest, register CELL *Org, CELL NOf)
#else
register Int n_of = NOf;
for (; n_of >= 0; n_of--)
*--Dest = *--Org;
*Dest++ = *Org++;
#endif
}
@@ -156,60 +155,10 @@ SetHeapRegs(void)
S = PtoGloAdjust(S);
else if (IsOldLocalPtr(S))
S = PtoLocAdjust(S);
#ifdef COROUTINING
if (DelayedVars)
DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars)));
if (AttsMutableList)
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);
if (GlobalArena)
GlobalArena = AbsAppl(PtoGloAdjust(RepAppl(GlobalArena)));
if (GlobalDelayArena)
GlobalDelayArena = GlobalAdjust(GlobalDelayArena);
#ifdef COROUTINING
if (DelayedVars)
DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars)));
@@ -227,17 +176,9 @@ MoveLocalAndTrail(void)
{
/* cpcellsd(To,From,NOfCells) - copy the cells downwards */
#if USE_SYSTEM_MALLOC
#if HAVE_MEMMOVE
cpcellsd(ASP, (CELL *)((char *)OldASP+DelayDiff), (CELL *)OldTR - OldASP);
#else
cpcellsd((CELL *)TR, (CELL *)((char *)OldTR+Delaydiff), (CELL *)OldTR - OldASP);
#endif
#else
#if HAVE_MEMMOVE
cpcellsd(ASP, OldASP, (CELL *)OldTR - OldASP);
#else
cpcellsd((CELL *)TR, (CELL *)OldTR, (CELL *)OldTR - OldASP);
#endif
#endif
}
@@ -248,44 +189,40 @@ MoveGlobal(void)
* cpcellsd(To,From,NOfCells) - copy the cells downwards - in
* absmi.asm
*/
#if HAVE_MEMMOVE
cpcellsd((CELL *)Yap_GlobalBase, (CELL *)OldGlobalBase, OldH - (CELL *)OldGlobalBase);
#else
cpcellsd(H, OldH, OldH - (CELL *)OldGlobalBase);
#endif
}
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
* absmi.asm
*/
#if USE_SYSTEM_MALLOC
#if HAVE_MEMMOVE
cpcellsd(H0, (CELL *)((char *)OldH0+DelayDiff), OldH - OldH0);
#else
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
UInt diff = OldH-OldPt;
CELL *NewPt = (CELL *)((char*)OldPt+GDiff);
CELL *IntPt = (CELL *)((char*)OldPt+GDiff0);
cpcellsd(NewPt, IntPt, diff);
}
static inline CELL
@@ -295,8 +232,6 @@ AdjustAppl(register CELL t0)
if (IsOldGlobalPtr(t))
return (AbsAppl(PtoGloAdjust(t)));
else if (IsOldDelayPtr(t))
return (AbsAppl(PtoDelayAdjust(t)));
else if (IsOldTrailPtr(t))
return (AbsAppl(CellPtoTRAdjust(t)));
else if (IsHeapP(t))
@@ -317,8 +252,6 @@ AdjustPair(register CELL t0)
if (IsOldGlobalPtr(t))
return (AbsPair(PtoGloAdjust(t)));
if (IsOldDelayPtr(t))
return (AbsPair(PtoDelayAdjust(t)));
if (IsOldTrailPtr(t))
return (AbsPair(CellPtoTRAdjust(t)));
else if (IsHeapP(t))
@@ -348,8 +281,6 @@ AdjustTrail(int adjusting_heap)
TrailTerm(ptt) = LocalAdjust(reg);
else if (IsOldGlobal(reg))
TrailTerm(ptt) = GlobalAdjust(reg);
else if (IsOldDelay(reg))
TrailTerm(ptt) = DelayAdjust(reg);
else if (IsOldTrail(reg))
TrailTerm(ptt) = TrailAdjust(reg);
} else if (IsPairTerm(reg)) {
@@ -367,8 +298,6 @@ AdjustTrail(int adjusting_heap)
TrailVal(ptt) = LocalAdjust(reg2);
else if (IsOldGlobal(reg2))
TrailVal(ptt) = GlobalAdjust(reg2);
else if (IsOldDelay(reg2))
TrailVal(ptt) = DelayAdjust(reg2);
else if (IsOldTrail(reg2))
TrailVal(ptt) = TrailAdjust(reg2);
} else if (IsApplTerm(reg2)) {
@@ -395,8 +324,6 @@ AdjustLocal(void)
*pt = LocalAdjust(reg);
else if (IsOldGlobal(reg))
*pt = GlobalAdjust(reg);
else if (IsOldDelay(reg))
*pt = DelayAdjust(reg);
else if (IsOldTrail(reg))
*pt = TrailAdjust(reg);
else if (IsOldCode(reg))
@@ -416,8 +343,6 @@ AdjustGlobTerm(Term reg)
if (IsVarTerm(reg)) {
if (IsOldGlobal(reg))
return GlobalAdjust(reg);
else if (IsOldDelay(reg))
return DelayAdjust(reg);
else if (IsOldLocal(reg))
return LocalAdjust(reg);
#ifdef MULTI_ASSIGNMENT_VARIABLES
@@ -437,11 +362,19 @@ AdjustGlobal(void)
CELL *pt;
ArrayEntry *al = DynamicArrays;
StaticArrayEntry *sal = StaticArrays;
GlobalEntry *gl = GlobalVariables;
while (al) {
al->ValueOfVE = AdjustGlobTerm(al->ValueOfVE);
al = al->NextAE;
}
while (gl) {
if (IsVarTerm(gl->global) ||
!IsAtomOrIntTerm(gl->global)) {
gl->global = AdjustGlobTerm(gl->global);
}
gl = gl->NextGE;
}
while (sal) {
if (sal->ArrayType == array_of_nb_terms) {
UInt arity = -sal->ArrayEArity, i;
@@ -465,11 +398,9 @@ AdjustGlobal(void)
register CELL reg;
reg = *pt;
if (IsVarTerm(reg)) {
if (IsVarTerm(reg)) {
if (IsOldGlobal(reg))
*pt = GlobalAdjust(reg);
else if (IsOldDelay(reg))
*pt = DelayAdjust(reg);
else if (IsOldLocal(reg))
*pt = LocalAdjust(reg);
else if (IsOldCode(reg)) {
@@ -559,8 +490,6 @@ AdjustRegs(int n)
reg = LocalAdjust(reg);
else if (IsOldGlobal(reg))
reg = GlobalAdjust(reg);
else if (IsOldDelay(reg))
reg = DelayAdjust(reg);
else if (IsOldTrail(reg))
reg = TrailAdjust(reg);
else if (IsOldCode(reg))
@@ -618,7 +547,8 @@ static_growheap(long size, int fix_code, struct intermediates *cip)
ASP -= 256;
YAPEnterCriticalSection();
TrDiff = LDiff = GDiff = DelayDiff = size;
XDiff = HDiff = 0;
XDiff = HDiff = GDiff0 = 0;
GSplit = NULL;
SetHeapRegs();
MoveLocalAndTrail();
if (fix_code) {
@@ -644,21 +574,31 @@ static_growheap(long size, int fix_code, struct intermediates *cip)
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_growglobal(long size, CELL **ptr)
static_growglobal(long size, CELL **ptr, CELL *hsplit)
{
UInt start_growth_time, growth_time;
int gc_verbose;
char *omax = (ADDR)DelayTop();
ADDR old_GlobalBase = Yap_GlobalBase;
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) */
Yap_PrologMode |= GrowStackMode;
if (size < (omax-Yap_GlobalBase)/8)
size = (omax-Yap_GlobalBase)/8;
if (size < ((char *)H0-omax)/8)
size = ((char *)H0-omax)/8;
size0 = size = AdjustPageSize(size);
Yap_ErrorMessage = NULL;
if (!Yap_ExtendWorkSpace(size)) {
@@ -676,8 +616,20 @@ static_growglobal(long size, CELL **ptr)
gc_verbose = Yap_is_gc_verbose();
delay_overflows++;
if (gc_verbose) {
fprintf(Yap_stderr, "%% DO Delay overflow %d\n", delay_overflows);
fprintf(Yap_stderr, "%% DO growing the stacks %ld bytes\n", size);
if (hsplit) {
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;
YAPEnterCriticalSection();
@@ -695,18 +647,30 @@ static_growglobal(long size, CELL **ptr)
DelayDiff = 0;
}
#endif
if (hsplit) {
GDiff0 = GDiff-sz;
GSplit = hsplit;
} else {
GDiff0 = DelayDiff;
GSplit = NULL;
}
XDiff = HDiff = 0;
Yap_GlobalBase = old_GlobalBase;
SetHeapRegs();
MoveLocalAndTrail();
MoveGlobalOnly();
if (minimal_request) {
MoveDelays();
if (hsplit) {
MoveGlobalWithHole();
} else {
MoveExpandedGlobal();
}
AdjustStacksAndTrail();
AdjustRegs(MaxTemps);
if (ptr)
if (ptr) {
*ptr = PtoLocAdjust(*ptr);
}
if (hsplit) {
MoveHalfGlobal(hsplit);
}
YAPLeaveCriticalSection();
ASP += 256;
if (minimal_request) {
@@ -715,14 +679,13 @@ static_growglobal(long size, CELL **ptr)
growth_time = Yap_cputime()-start_growth_time;
total_delay_overflow_time += growth_time;
if (gc_verbose) {
fprintf(Yap_stderr, "%% DO took %g sec\n", (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 took %g sec\n", vb_msg1, (double)growth_time/1000);
fprintf(Yap_stderr, "%% %cO Total of %g sec expanding stacks \n", vb_msg1, (double)total_delay_overflow_time/1000);
}
Yap_PrologMode &= ~GrowStackMode;
return(TRUE);
}
static void
fix_compiler_instructions(PInstr *pcpc)
{
@@ -1072,7 +1035,7 @@ Yap_growglobal(CELL **ptr)
return(FALSE);
}
#endif
if (!static_growglobal(sz, ptr))
if (!static_growglobal(sz, ptr, NULL))
return(FALSE);
#ifdef TABLING
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
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;
GDiff0=0;
#if USE_SYSTEM_MALLOC
if (from_trail) {
TrDiff = LDiff = GDiff;
@@ -1216,11 +1192,7 @@ execute_growstack(long size0, int from_trail, int in_parser, tr_fr_ptr *old_trp,
}
#endif
ASP -= 256;
if (GDiff) {
SetHeapRegs();
} else {
SetStackRegs();
}
SetHeapRegs();
if (from_trail) {
Yap_TrailTop += size0;
}
@@ -1382,7 +1354,7 @@ static int do_growtrail(long size, int contiguous_only, int in_parser, tr_fr_ptr
} else {
YAPEnterCriticalSection();
if (in_parser) {
TrDiff = LDiff = GDiff = DelayDiff = XDiff = HDiff = 0;
TrDiff = LDiff = GDiff = DelayDiff = XDiff = HDiff = GDiff0 = 0;
AdjustScannerStacks(tksp, vep);
}
Yap_TrailTop += size;

402
C/heapgc.c
View File

@@ -99,12 +99,6 @@ typedef struct RB_red_blk_node {
/* in a single gc */
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
static choiceptr current_B;
@@ -399,10 +393,17 @@ push_registers(Int num_regs, yamop *nextop)
/* push array entries first */
ArrayEntry *al = DynamicArrays;
GlobalEntry *gl = GlobalVariables;
TrailTerm(TR++) = GlobalArena;
TrailTerm(TR++) = GlobalDelayArena;
while (al) {
TrailTerm(TR++) = al->ValueOfVE;
al = al->NextAE;
}
while (gl) {
TrailTerm(TR++) = gl->global;
gl = gl->NextGE;
}
while (sal) {
if (sal->ArrayType == array_of_nb_terms) {
UInt arity = -sal->ArrayEArity, i;
@@ -463,10 +464,18 @@ pop_registers(Int num_regs, yamop *nextop)
/* pop array entries first */
ArrayEntry *al = DynamicArrays;
GlobalEntry *gl = GlobalVariables;
GlobalArena = TrailTerm(ptr++);
GlobalDelayArena = TrailTerm(ptr++);
while (al) {
al->ValueOfVE = TrailTerm(ptr++);
al = al->NextAE;
}
while (gl) {
gl->global = TrailTerm(ptr++);
gl = gl->NextGE;
}
sal = StaticArrays;
while (sal) {
if (sal->ArrayType == array_of_nb_terms) {
@@ -1034,20 +1043,17 @@ check_global(void) {
if (MARKED_PTR(current)) {
CELL ccell = UNMARK_CELL(ccurr);
if (
ccell < MAX_SPECIALS_TAG && /* two first pages */
ccell > EndSpecials && IsVarTerm(ccell)) {
if (ccell == EndSpecials) {
/* oops, we found a blob */
int nofcells = (UNMARK_CELL(*current)-EndSpecials) / sizeof(CELL);
CELL *ptr = current - nofcells ;
CELL *ptr = current-1;
UInt nofcells;
while (!MARKED_PTR(ptr)) ptr--;
nofcells = current-ptr;
current = ptr;
ccurr = *current;
/* process the functor next */
}
if (MARKED_PTR(current)) {
printf("Oops, found marked cell at %p\n", current);
break;
}
}
#if INSTRUMENT_GC
if (IsVarTerm(ccurr)) {
@@ -1279,51 +1285,35 @@ mark_variable(CELL_PTR current)
}
total_marked += 3;
PUSH_POINTER(next);
PUSH_POINTER(next+1);
PUSH_POINTER(next+2);
POP_CONTINUATION();
case (CELL)FunctorDouble:
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+1);
PUSH_POINTER(next+2);
#if SIZEOF_DOUBLE==2*SIZEOF_LONG_INT
PUSH_POINTER(next+3);
#if GC_NO_TAGS
MARK(next+3);
#endif
#elif GC_NO_TAGS
MARK(next+2);
#endif
{
UInt sz = 1+SIZEOF_DOUBLE/SIZEOF_LONG_INT;
if (next < HGEN) {
total_oldies+= 1+sz;
}
total_marked += 1+sz;
PUSH_POINTER(next+sz);
MARK(next+sz);
}
POP_CONTINUATION();
#ifdef USE_GMP
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);
for (i = 1; i <= (sizeof(MP_INT)+
(((MP_INT *)(next+1))->_mp_alloc*sizeof(mp_limb_t)))/CellSize;
i++) {
PUSH_POINTER(next+i);
}
#if GC_NO_TAGS
MARK(next+i);
#endif
PUSH_POINTER(next+i);
sz++;
MARK(next+sz);
PUSH_POINTER(next+sz);
}
POP_CONTINUATION();
#endif
@@ -1430,9 +1420,8 @@ mark_regs(tr_fr_ptr old_TR)
static void
mark_delays(CELL *max)
{
CELL *ptr = (CELL *)Yap_GlobalBase;
for (; ptr < max; ptr++) {
mark_external_reference2(ptr);
for (; max < H0; max++) {
mark_external_reference2(max);
}
}
#endif
@@ -3035,68 +3024,43 @@ compact_heap(void)
for (current = H - 1; current >= start_from; current--) {
if (MARKED_PTR(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) {
current[1] = in_garbage;
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
found_marked++;
#endif /* DEBUG */
@@ -3125,6 +3089,11 @@ compact_heap(void)
start_from[0] = in_garbage;
#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)
fprintf(Yap_stderr,"%% Upward (%d): %ld total against %ld found\n",
GcCalls,
@@ -3145,22 +3114,19 @@ compact_heap(void)
CELL ccur = *current;
if (MARKED_PTR(current)) {
CELL uccur = UNMARK_CELL(ccur);
if (
uccur < MAX_SPECIALS_TAG && /* two first pages */
uccur > EndSpecials && IsVarTerm(uccur)) {
/* oops, we found a blob */
int nofcells = (uccur-EndSpecials) / sizeof(CELL) , i;
if (uccur == EndSpecials) {
CELL *old_dest = dest;
//FIX THIS
*dest++ = current[nofcells-1];
current ++;
for (i = 0; i < nofcells-2; i++) {
CELL *current0=current-1;
dest++;
current++;
while (!MARKED_PTR(current)) {
*dest++ = *current++;
}
*dest++ = ccur;
*old_dest = *current;
*dest++ = EndSpecials;
#ifdef DEBUG
found_marked += nofcells;
found_marked += (dest-old_dest);
#endif
continue;
}
@@ -3207,69 +3173,6 @@ compact_heap(void)
}
#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
* all pointers to point to new locations
@@ -3278,9 +3181,15 @@ static void
icompact_heap(void)
{
CELL_PTR *iptr, *ibase = (CELL_PTR *)H;
CELL_PTR dest;
CELL *next_hb;
#ifdef DEBUG
Int found_marked = 0;
#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
@@ -3288,39 +3197,51 @@ icompact_heap(void)
* 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--) {
CELL ccell;
CELL_PTR current;
current = *iptr;
ccell = UNMARK_CELL(*current);
if (ccell < MAX_SPECIALS_TAG && /* two first pages */
ccell > EndSpecials && IsVarTerm(ccell)
) {
/* oops, we found a blob */
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);
if (current <= next_hb) {
gc_B = update_B_H(gc_B, current, dest, dest+1
#ifdef TABLING
, &depfr
#endif
ptr[1] = tmp;
}
current = ptr;
);
next_hb = set_next_hb(gc_B);
}
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
found_marked++;
#endif /* DEBUG */
update_relocation_chain(current, H0+(iptr-ibase));
update_relocation_chain(current, dest);
if (HEAP_PTR(*current)) {
CELL_PTR next;
next = GET_NEXT(*current);
@@ -3330,15 +3251,22 @@ icompact_heap(void)
else if (current == next) { /* cell pointing to
* itself */
#if GC_NO_TAGS
*current = (CELL) (H0+(iptr-ibase)); /* no tag */
UNRMARK(current);
*current = (CELL) dest; /* no tag */
#else
*current = (*current & MBIT) | (CELL) (H0+(iptr-ibase)); /* no tag */
*current = (*current & MBIT) | (CELL) dest; /* no tag */
#endif
}
}
dest--;
}
#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)
fprintf(Yap_stderr,"%% Upward (%d): %ld total against %ld found\n",
GcCalls,
@@ -3354,25 +3282,27 @@ icompact_heap(void)
* locations
*/
dest = H0;
for (iptr = ibase; iptr < iptop; iptr++) {
CELL_PTR next;
CELL *current = *iptr;
CELL ccur = *current;
CELL_PTR dest = H0+(iptr-ibase);
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];
current ++;
for (i = 0; i < nofcells-2; i++) {
if (uccur == EndSpecials) {
CELL *old_dest = dest;
/* leave a hole */
dest++;
current++;
while (!MARKED_PTR(current)) {
*dest++ = *current++;
}
*dest = ccur;
iptr += nofcells-1;
/* fill in hole */
*old_dest = *current;
*dest++ = EndSpecials;
#ifdef DEBUG
found_marked += nofcells;
found_marked += dest-old_dest;
#endif
continue;
}
@@ -3388,12 +3318,18 @@ icompact_heap(void)
*dest = ccur;
into_relocation_chain(dest, next);
UNMARK(dest);
dest++;
} else {
/* just move current cell */
*dest = ccur = UNMARK_CELL(ccur);
*dest++ = ccur = UNMARK_CELL(ccur);
}
}
#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)
fprintf(Yap_stderr,"%% Downward (%d): %ld total against %ld found\n",
GcCalls,
@@ -3401,7 +3337,7 @@ icompact_heap(void)
(unsigned long int)found_marked);
#endif
H = H0+(iptop-ibase); /* reset H */
H = dest; /* reset H */
HB = B->cp_h;
#ifdef TABLING
if (B_FZ == (choiceptr)LCL0)
@@ -3482,17 +3418,16 @@ sweep_oldgen(CELL *max, CELL *base)
#ifdef COROUTINING
static void
sweep_delays(CELL *max)
sweep_delays(CELL *max, CELL *myH0)
{
CELL *ptr = (CELL *)Yap_GlobalBase;
while (ptr < max) {
if (MARKED_PTR(ptr)) {
UNMARK(ptr);
if (HEAP_PTR(*ptr)) {
into_relocation_chain(ptr, GET_NEXT(*ptr));
while (max < myH0) {
if (MARKED_PTR(max)) {
UNMARK(max);
if (HEAP_PTR(*max)) {
into_relocation_chain(max, GET_NEXT(*max));
}
}
ptr++;
max++;
}
}
#endif
@@ -3506,7 +3441,7 @@ sweep_delays(CELL *max)
static void
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);
@@ -3524,7 +3459,7 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
}
}
#ifdef COROUTINING
sweep_delays(max);
sweep_delays(max, myH0);
#endif
sweep_environments(current_env, EnvSize(curp), EnvBMap((CELL *)curp));
sweep_choicepoints(B);
@@ -3532,12 +3467,14 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
#ifdef HYBRID_SCHEME
if (icompact) {
#ifdef DEBUG
/*
if (total_marked
#ifdef COROUTINING
-total_smarked
#endif
!= 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);
*/
#endif
#if DEBUGX
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;
}
quicksort((CELL_PTR *)H, 0, (iptop-(CELL_PTR *)H)-1);
adjust_cp_hbs();
icompact_heap();
} else
#endif /* HYBRID_SCHEME */
@@ -3589,7 +3525,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
gc_trace = FALSE;
#if COROUTINING
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)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
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].dynamic_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);
if (Yap_heap_regs->wl[i].consultlow == NULL) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCodes");
@@ -984,6 +987,9 @@ InitCodes(void)
#else
Yap_heap_regs->wl.dynamic_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);
if (Yap_heap_regs->wl.consultlow == NULL) {
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"),
sizeof(timed_var)/sizeof(CELL));
#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_or = Yap_MkFunctor(AtomSemic, 2);
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;
OldTR = TR;
GDiff = Unsigned(NewGlobalBase) - Unsigned(Yap_GlobalBase);
GDiff0 = 0;
LDiff = Unsigned(NewLCL0) - Unsigned(LCL0);
TrDiff = LDiff;
Yap_GlobalBase = (ADDR)NewGlobalBase;

27
C/stdpreds.c
View File

@@ -11,8 +11,12 @@
* File: stdpreds.c *
* 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 $
* 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
* hacks
*
@@ -3000,21 +3004,22 @@ Yap_InitCPreds(void)
Yap_InitCPred("dump_active_goals", 0, p_dump_active_goals, SafePredFlag|SyncPredFlag);
#endif
Yap_InitUnify();
Yap_InitInlines();
Yap_InitCdMgr();
Yap_InitExecFs();
Yap_InitIOPreds();
Yap_InitCmpPreds();
Yap_InitDBPreds();
Yap_InitArrayPreds();
Yap_InitBBPreds();
Yap_InitBigNums();
Yap_InitSysPreds();
Yap_InitSavePreds();
Yap_InitCdMgr();
Yap_InitCmpPreds();
Yap_InitCoroutPreds();
Yap_InitArrayPreds();
Yap_InitDBPreds();
Yap_InitExecFs();
Yap_InitGlobals();
Yap_InitInlines();
Yap_InitIOPreds();
Yap_InitLoadForeign();
Yap_InitModulesC();
Yap_InitSavePreds();
Yap_InitSysPreds();
Yap_InitUnify();
#if defined CUT_C && defined MYDDAS_MYSQL
Yap_InitMYDDAS_MySQLPreds();
#endif

2
C/tracer.c
View File

@@ -359,7 +359,7 @@ volatile int vsc_wait;
static Int p_vsc_wait(void)
{
fprintf(stderr,"attach %d\n",getpid());
fprintf(stderr,"attach %d\n",(int)getpid());
while (!vsc_wait);
vsc_wait=1;
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) {
dvars = (CELL *)DelayTop();
}
if (ptd0 >= dvars) {
if (ptd0 < dvars) {
*ptf++ = (CELL) ptd0;
} else {
tr_fr_ptr CurTR;

2
C/write.c
View File

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