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

fix bugs in tabling 

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@116 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
uid49918 2001-07-04 16:48:54 +00:00
parent de8cbd046c
commit 1578e68ec3
12 changed files with 419 additions and 252 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
C/absmi.c
View File

@ -390,7 +390,7 @@ absmi(int inp)
* choicepoint for the current B */
restore_yaam_regs(PREG->u.ld.d);
restore_at_least_one_arg(PREG->u.ld.s);
#ifdef FROZEN_REGS
#if defined(SBA) && defined(FROZEN_REGS)
S_Y = (CELL *)PROTECT_FROZEN_B(B_Y);
set_cut(S_Y, B->cp_b);
#else
@ -1370,7 +1370,11 @@ absmi(int inp)
/* multi-assignment variable */
/* so the next cell is the old value */
pt0--;
#if FROZEN_STACKS
pt[0] = TrailVal(pt0);
#else
pt[0] = TrailTerm(pt0);
#endif
goto failloop;
}
#endif
@ -1404,7 +1408,7 @@ absmi(int inp)
#endif /* YAPOR */
SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(B);
trim_trail();
TR = trim_trail(B, TR, HBREG);
}
ENDD(d0);
GONext();
@ -1426,7 +1430,7 @@ absmi(int inp)
#endif /* YAPOR */
SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(B);
trim_trail();
TR = trim_trail(B, TR, HBREG);
}
ENDD(d0);
GONext();
@ -1447,7 +1451,7 @@ absmi(int inp)
#endif /* YAPOR */
SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(B);
trim_trail();
TR = trim_trail(B, TR, HBREG);
}
ENDD(d0);
GONext();
@ -1505,7 +1509,7 @@ absmi(int inp)
#endif /* YAPOR */
SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(pt0);
trim_trail();
TR = trim_trail(B, TR, HBREG);
}
}
ENDD(d0);
@ -1538,7 +1542,7 @@ absmi(int inp)
#endif /* YAPOR */
SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(pt0);
trim_trail();
TR = trim_trail(B, TR, HBREG);
}
}
ENDD(d0);
@ -2118,6 +2122,10 @@ absmi(int inp)
#ifdef COROUTINING
}
#endif
#ifdef LOW_LEVEL_TRACER
if (do_low_level_trace)
low_level_trace(enter_pred,pred_entry(SREG),XREGS+1);
#endif /* LOW_LEVEL_TRACE */
PREG = (yamop *) PredCode(SREG);
CACHE_A1();
JMPNext();
@ -6010,6 +6018,10 @@ absmi(int inp)
pt0 = (CELL *) (Unsigned(SpyCode) - sizeof(SMALLUNSGN));
PREG = (yamop *) PredCode(pt0);
CACHE_A1();
#ifdef LOW_LEVEL_TRACER
if (do_low_level_trace)
low_level_trace(enter_pred,(PredEntry *)(PREG->u.sla.p),XREGS+1);
#endif /* LOW_LEVEL_TRACE */
ENDP(pt0);
JMPNext();
@ -7717,7 +7729,7 @@ absmi(int inp)
B = pt0;
#endif /* YAPOR */
HBREG = PROTECT_FROZEN_H(B);
trim_trail();
TR = trim_trail(B, TR, HBREG);
}
ENDCHO(pt0);
PREG = NEXTOP(PREG, x);
@ -7766,7 +7778,7 @@ absmi(int inp)
B = pt1;
#endif /* YAPOR */
HBREG = PROTECT_FROZEN_H(B);
trim_trail();
TR = trim_trail(B, TR, HBREG);
}
PREG = NEXTOP(PREG, y);
GONext();

84
C/attvar.c
View File

@ -30,7 +30,7 @@ static char SccsId[]="%W% %G%";
#define NULL (void *)0
#endif
STATIC_PROTO(Int InitVarTime, (void));
STATIC_PROTO(Term InitVarTime, (void));
static CELL *
AddToQueue(attvar_record *attv)
@ -189,22 +189,37 @@ mark_attvar(CELL *orig)
#endif /* FIXED_STACKS */
static Int
#if FROZEN_STACKS
static Term
CurrentTime(void) {
return(MkIntegerTerm(TR-(tr_fr_ptr)TrailBase));
}
#endif
static Term
InitVarTime(void) {
#if FROZEN_STACKS
if (B->cp_tr == TR) {
/* we run the risk of not making non-determinate bindings before
the end of the night */
/* so we just init a TR cell that will not harm anyone */
Bind((CELL *)(TR+1),AbsAppl(H-1));
}
return(MkIntegerTerm(B->cp_tr-(tr_fr_ptr)TrailBase));
#else
Term t = (CELL)H;
*H++ = TermFoundVar;
return(t);
#endif
}
static Int
PutAtt(attvar_record *attv, Int i, Term tatt) {
Int pos = i*2;
CELL *timestmp = (CELL *)(attv->Atts[pos]);
if (B->cp_h <= timestmp
#if defined(SBA) || defined(TABLING)
&& timestmp <= H
#endif
) {
#if FROZEN_STACKS
tr_fr_ptr timestmp = (tr_fr_ptr)TrailBase+IntegerOfTerm(attv->Atts[pos]);
if (B->cp_tr <= timestmp
&& timestmp <= TR) {
#if defined(SBA)
if (Unsigned((Int)(attv)-(Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
@ -213,11 +228,20 @@ PutAtt(attvar_record *attv, Int i, Term tatt) {
} else
#endif
attv->Atts[pos+1] = tatt;
#if defined(SBA) || defined(TABLING)
if (Unsigned((Int)(attv)-(Int)(HBREG)) >
Unsigned(BBREG)-(Int)(HBREG))
TrailVal(timestmp-1) = tatt;
#endif
Unsigned(BBREG)-(Int)(HBREG))
TrailVal(timestmp-1) = tatt;
} else {
Term tnewt;
MaBind(attv->Atts+pos+1, tatt);
tnewt = CurrentTime();
MaBind(attv->Atts+pos, tnewt);
}
#else
CELL *timestmp = (CELL *)(attv->Atts[pos]);
if (B->cp_h <= timestmp)
{
attv->Atts[pos+1] = tatt;
} else {
Term tnewt;
MaBind(attv->Atts+pos+1, tatt);
@ -225,6 +249,7 @@ PutAtt(attvar_record *attv, Int i, Term tatt) {
*H++ = TermFoundVar;
MaBind(attv->Atts+pos, tnewt);
}
#endif
return(TRUE);
}
@ -232,18 +257,30 @@ static Int
RmAtt(attvar_record *attv, Int i) {
Int pos = i *2;
if (!IsVarTerm(attv->Atts[pos+1])) {
CELL *timestmp = (CELL *)(attv->Atts[pos]);
if (B->cp_h <= timestmp
#if defined(SBA) || defined(TABLING)
&& timestmp <= H
#endif
) {
#if FROZEN_STACKS
tr_fr_ptr timestmp = (tr_fr_ptr)TrailBase+IntegerOfTerm(attv->Atts[pos]);
if (B->cp_tr <= timestmp
&& timestmp <= TR) {
RESET_VARIABLE(attv->Atts+(pos+1));
if (Unsigned((Int)(attv)-(Int)(HBREG)) >
Unsigned(BBREG)-(Int)(HBREG))
TrailVal(timestmp-1) = attv->Atts[pos+1];
} else {
/* reset the variable */
Term tnewt;
#ifdef SBA
MaBind(attv->Atts+(pos+1), 0L);
#else
MaBind(attv->Atts+(pos+1), (CELL)(attv->Atts+(pos+1)));
#endif
tnewt = CurrentTime();
MaBind(attv->Atts+pos, tnewt);
}
}
#else
CELL *timestmp = (CELL *)(attv->Atts[pos]);
if (B->cp_h <= timestmp) {
RESET_VARIABLE(attv->Atts+(pos+1));
#if defined(SBA) || defined(TABLING)
if (Unsigned((Int)(attv)-(Int)(HBREG)) >
Unsigned(BBREG)-(Int)(HBREG))
TrailVal(timestmp-1) = attv->Atts[pos+1];
#endif
} else {
/* reset the variable */
Term tnewt;
@ -257,6 +294,7 @@ RmAtt(attvar_record *attv, Int i) {
MaBind(attv->Atts+pos, tnewt);
}
}
#endif
return(TRUE);
}

11
C/exec.c
View File

@ -426,7 +426,7 @@ p_execute_within(void)
if (a == AtomTrue || a == AtomOtherwise)
return(TRUE);
else if (a == AtomCut) {
#if defined(SBA) && defined(FROZEN_REGS)
#ifdef SBA
choiceptr pt0 = (choiceptr)IntegerOfTerm(Deref(ARG2));
#else
choiceptr pt0 = (choiceptr)(LCL0-IntegerOfTerm(Deref(ARG2)));
@ -479,9 +479,10 @@ p_execute0(void)
Prop pe;
Atom a;
if (IsAtomTerm(t))
arity = 0, a = AtomOfTerm(t);
else if (IsApplTerm(t)) {
if (IsAtomTerm(t)) {
arity = 0;
a = AtomOfTerm(t);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
register unsigned int i;
register CELL *pt;
@ -873,7 +874,7 @@ exec_absmi(int top)
}
/* make the abstract machine jump where we want them to jump to */
#if defined(SBA) && defined(FROZEN_REGS)
#ifdef SBA
B = (choiceptr)depth;
#else
B = (choiceptr)(LCL0-depth);

21
C/grow.c
View File

@ -275,6 +275,9 @@ AdjustTrail(int adjusting_heap)
/* moving the trail is simple */
while (ptt != (tr_fr_ptr)TrailBase) {
register CELL reg = TrailTerm(ptt-1);
#ifdef FROZEN_STACKS
register CELL reg2 = TrailVal(ptt-1);
#endif
ptt--;
if (IsVarTerm(reg)) {
@ -309,6 +312,24 @@ AdjustTrail(int adjusting_heap)
TrailTerm(ptt) = AdjustAppl(reg);
#endif
}
#ifdef FROZEN_STACKS
if (IsVarTerm(reg2)) {
if (IsOldLocal(reg2))
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 (IsOldCode(reg2))
TrailVal(ptt) = CodeAdjust(reg2);
} else if (IsApplTerm(reg2)) {
TrailVal(ptt) = AdjustAppl(reg2);
} else if (IsPairTerm(reg2)) {
TrailVal(ptt) = AdjustPair(reg2);
}
#endif
}
}

275
C/heapgc.c
View File

@ -28,107 +28,6 @@ static char SccsId[] = "%W% %G%";
#define HYBRID_SCHEME 1
#ifdef MULTI_ASSIGNMENT_VARIABLES
/*
Based in opt.mavar.h. This is a set of routines to find out if a
ma trail entry has appeared before in the same trail segment. All ma
entries for the same cell are then linked. At the end of mark_trail() only
one will remain.
*/
#define GC_MAVARS_HASH_SIZE 512
typedef struct gc_ma_h_entry {
CELL* addr;
tr_fr_ptr trptr;
struct gc_ma_h_entry* ma_list;
struct gc_ma_h_entry *next;
} gc_ma_h_inner_struct;
extern struct gc_ma_h_entry *live_list;
typedef struct {
UInt timestmp;
struct gc_ma_h_entry val;
} gc_ma_hash_entry;
static gc_ma_hash_entry gc_ma_hash_table[GC_MAVARS_HASH_SIZE];
static UInt timestamp; /* an unsigned int */
static inline unsigned int
GC_MAVAR_HASH(CELL *addr) {
#if SIZEOF_INT_P==8
return((((unsigned int)((CELL)(addr)))>>3)%GC_MAVARS_HASH_SIZE);
#else
return((((unsigned int)((CELL)(addr)))>>2)%GC_MAVARS_HASH_SIZE);
#endif
}
gc_ma_h_inner_struct *gc_ma_h_top;
static inline struct gc_ma_h_entry *
GC_ALLOC_NEW_MASPACE(void)
{
gc_ma_h_inner_struct *new = gc_ma_h_top;
if ((char *)gc_ma_h_top > TrailTop-1024)
growtrail(64 * 1024L);
gc_ma_h_top++;
return(new);
}
static inline tr_fr_ptr*
gc_lookup_ma_var(CELL *addr, tr_fr_ptr trp) {
unsigned int i = GC_MAVAR_HASH(addr);
struct gc_ma_h_entry *nptr, *optr;
if (gc_ma_hash_table[i].timestmp != timestamp) {
gc_ma_hash_table[i].timestmp = timestamp;
gc_ma_hash_table[i].val.addr = addr;
gc_ma_hash_table[i].val.next = NULL;
gc_ma_hash_table[i].val.trptr = trp;
gc_ma_hash_table[i].val.ma_list = live_list;
live_list = &(gc_ma_hash_table[i].val);
return(NULL);
}
if (gc_ma_hash_table[i].val.addr == addr) {
return(&(gc_ma_hash_table[i].val.trptr));
}
optr = &(gc_ma_hash_table[i].val);
nptr = gc_ma_hash_table[i].val.next;
while (nptr != NULL) {
if (nptr->addr == addr) {
return(&(nptr->trptr));
}
optr = nptr;
nptr = nptr->next;
}
nptr = GC_ALLOC_NEW_MASPACE();
optr->next = nptr;
nptr->addr = addr;
nptr->trptr = trp;
nptr->ma_list = live_list;
nptr->next = NULL;
live_list = nptr;
return(NULL);
}
static inline void
GC_NEW_MAHASH(gc_ma_h_inner_struct *top) {
UInt time = ++timestamp;
if (time == 0) {
unsigned int i;
/* damn, we overflowed */
for (i = 0; i < GC_MAVARS_HASH_SIZE; i++)
gc_ma_hash_table[i].timestmp = 0;
time = ++timestamp;
}
gc_ma_h_top = top;
live_list = NULL;
}
#endif
/* global variables for garbage collection */
#ifndef DEBUG
@ -340,6 +239,109 @@ quicksort(CELL *a[], UInt p, UInt r)
#endif /* HYBRID_SCHEME */
#ifdef MULTI_ASSIGNMENT_VARIABLES
/*
Based in opt.mavar.h. This is a set of routines to find out if a
ma trail entry has appeared before in the same trail segment. All ma
entries for the same cell are then linked. At the end of mark_trail() only
one will remain.
*/
#define GC_MAVARS_HASH_SIZE 512
typedef struct gc_ma_h_entry {
CELL* addr;
tr_fr_ptr trptr;
struct gc_ma_h_entry* ma_list;
struct gc_ma_h_entry *next;
} gc_ma_h_inner_struct;
extern struct gc_ma_h_entry *live_list;
typedef struct {
UInt timestmp;
struct gc_ma_h_entry val;
} gc_ma_hash_entry;
static gc_ma_hash_entry gc_ma_hash_table[GC_MAVARS_HASH_SIZE];
static UInt timestamp; /* an unsigned int */
static inline unsigned int
GC_MAVAR_HASH(CELL *addr) {
#if SIZEOF_INT_P==8
return((((unsigned int)((CELL)(addr)))>>3)%GC_MAVARS_HASH_SIZE);
#else
return((((unsigned int)((CELL)(addr)))>>2)%GC_MAVARS_HASH_SIZE);
#endif
}
gc_ma_h_inner_struct *gc_ma_h_top;
static inline struct gc_ma_h_entry *
GC_ALLOC_NEW_MASPACE(void)
{
gc_ma_h_inner_struct *new = gc_ma_h_top;
if ((char *)gc_ma_h_top > TrailTop-1024)
growtrail(64 * 1024L);
gc_ma_h_top++;
cont_top0 = cont_top = (cont *)gc_ma_h_top;
return(new);
}
static inline tr_fr_ptr*
gc_lookup_ma_var(CELL *addr, tr_fr_ptr trp) {
unsigned int i = GC_MAVAR_HASH(addr);
struct gc_ma_h_entry *nptr, *optr;
if (gc_ma_hash_table[i].timestmp != timestamp) {
gc_ma_hash_table[i].timestmp = timestamp;
gc_ma_hash_table[i].val.addr = addr;
gc_ma_hash_table[i].val.next = NULL;
gc_ma_hash_table[i].val.trptr = trp;
gc_ma_hash_table[i].val.ma_list = live_list;
live_list = &(gc_ma_hash_table[i].val);
return(NULL);
}
if (gc_ma_hash_table[i].val.addr == addr) {
return(&(gc_ma_hash_table[i].val.trptr));
}
optr = &(gc_ma_hash_table[i].val);
nptr = gc_ma_hash_table[i].val.next;
while (nptr != NULL) {
if (nptr->addr == addr) {
return(&(nptr->trptr));
}
optr = nptr;
nptr = nptr->next;
}
nptr = GC_ALLOC_NEW_MASPACE();
optr->next = nptr;
nptr->addr = addr;
nptr->trptr = trp;
nptr->ma_list = live_list;
nptr->next = NULL;
live_list = nptr;
return(NULL);
}
static inline void
GC_NEW_MAHASH(gc_ma_h_inner_struct *top) {
UInt time = ++timestamp;
if (time == 0) {
unsigned int i;
/* damn, we overflowed */
for (i = 0; i < GC_MAVARS_HASH_SIZE; i++)
gc_ma_hash_table[i].timestmp = 0;
time = ++timestamp;
}
gc_ma_h_top = top;
cont_top0 = cont_top = (cont *)gc_ma_h_top;
live_list = NULL;
}
#endif
/* find all accessible objects on the heap and squeeze out all the rest */
@ -534,7 +536,7 @@ init_dbtable(tr_fr_ptr trail_ptr) {
/* DB pointer */
CELL flags;
#ifdef FROZEN_REGS /* TRAIL */
#ifdef FROZEN_STACKS /* TRAIL */
/* avoid frozen segments */
if (
#ifdef SBA
@ -545,7 +547,7 @@ init_dbtable(tr_fr_ptr trail_ptr) {
) {
continue;
}
#endif /* FROZEN_REGS */
#endif /* FROZEN_STACKS */
flags = Flags((CELL)pt0);
/* for the moment, if all references to the term in the stacks
@ -1094,6 +1096,7 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
static void
mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B)
{
cont *old_cont_top0 = cont_top0;
GC_NEW_MAHASH((gc_ma_h_inner_struct *)db_vec);
while (trail_ptr > trail_base) {
register CELL trail_cell;
@ -1114,7 +1117,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
RESET_VARIABLE(hp);
discard_trail_entries++;
RESET_VARIABLE(&TrailTerm(trail_ptr));
#ifdef FROZEN_REGS
#ifdef FROZEN_STACKS
RESET_VARIABLE(&TrailVal(trail_ptr));
#endif
#else
@ -1129,7 +1132,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
} else if ((hp < (CELL *)gc_B && hp >= gc_H) || hp > (CELL *)TrailBase) {
/* clean the trail, avoid dangling pointers! */
RESET_VARIABLE(&TrailTerm(trail_ptr));
#ifdef FROZEN_REGS
#ifdef FROZEN_STACKS
RESET_VARIABLE(&TrailVal(trail_ptr));
#endif
discard_trail_entries++;
@ -1147,7 +1150,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
MARK(cptr);
}
#endif
#ifdef FROZEN_REGS
#ifdef FROZEN_STACKS
mark_external_reference(&TrailVal(trail_ptr));
#endif
}
@ -1174,9 +1177,6 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
mark_external_reference(&(TrailTerm(trail_ptr)));
/* reset the gc to believe the original tag */
TrailTerm(trail_ptr) = AbsAppl((CELL *)TrailTerm(trail_ptr));
#ifdef FROZEN_REGS
mark_external_reference(&TrailVal(trail_ptr));
#endif
}
trail_ptr --;
} else {
@ -1185,12 +1185,12 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
/* we can safely ignore this little monster */
discard_trail_entries += 2;
RESET_VARIABLE(&TrailTerm(trail_ptr));
#ifdef FROZEN_REGS
#ifdef FROZEN_STACKS
RESET_VARIABLE(&TrailVal(trail_ptr));
#endif
trail_ptr--;
RESET_VARIABLE(&TrailTerm(trail_ptr));
#ifdef FROZEN_REGS
#ifdef FROZEN_STACKS
RESET_VARIABLE(&TrailVal(trail_ptr));
#endif
}
@ -1204,15 +1204,26 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
if (HEAP_PTR(trail_cell)) {
mark_external_reference(&TrailTerm(live_list->trptr-1));
}
#ifdef FROZEN_STACKS
if (HEAP_PTR(TrailVal(trail_ptr))) {
mark_external_reference(&TrailVal(trail_ptr));
}
#endif
/*
swap the two so that the sweep_trail() knows we have
a multi-assignment binding
*/
TrailTerm(live_list->trptr) = TrailTerm(live_list->trptr-1);
TrailTerm(live_list->trptr-1) = trail_cell2;
#ifdef FROZEN_STACKS
if (HEAP_PTR(TrailVal(trail_ptr-1))) {
mark_external_reference(&TrailVal(trail_ptr-1));
}
#endif
live_list = live_list->ma_list;
}
#endif
cont_top0 = cont_top = old_cont_top0;
}
/*
@ -1326,12 +1337,16 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)
#endif /* CHECK_CHOICEPOINTS */
{
/* find out how many cells are still alive in the trail */
#ifndef FROZEN_STACKS
UInt d0 = discard_trail_entries, diff, orig;
orig = saved_TR-gc_B->cp_tr;
#endif
mark_trail(saved_TR, gc_B->cp_tr, gc_B->cp_h, gc_B);
saved_TR = gc_B->cp_tr;
#ifndef FROZEN_STACKS
diff = discard_trail_entries-d0;
gc_B->cp_tr = (tr_fr_ptr)(orig-diff);
#endif /* FROZEN_STACKS */
}
restart_cp:
if (opnum == _or_else || opnum == _or_last) {
@ -1569,7 +1584,11 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
hp_in_use_erased = 0, code_entries = 0;
#endif
/* adjust cp_tr pointers */
#ifndef FROZEN_STACKS
/*
adjust cp_tr pointers,
we don't compress TR if we have freeze.
*/
{
Int size = old_TR-(tr_fr_ptr)TrailBase;
size -= discard_trail_entries;
@ -1579,6 +1598,8 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
gc_B = gc_B->cp_b;
}
}
#endif /* FROZEN_STACKS */
/* first, whatever we dumped on the trail. Easier just to do
the registers separately? */
for (trail_ptr = old_TR; trail_ptr < TR; trail_ptr++) {
@ -1598,14 +1619,19 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
trail_cell = TrailTerm(trail_ptr);
#ifdef FROZEN_STACKS
/* it is complex to recover cells with frozen segments */
TrailVal(dest) = TrailVal(trail_ptr);
#else
/* recover a trail cell */
if (trail_cell == (CELL)trail_ptr) {
TrailTerm(dest) = trail_cell;
trail_ptr++;
/* just skip cell */
} else {
TrailTerm(dest) = trail_cell;
#ifdef FROZEN_REGS
TrailVal(dest) = TrailVal(trail_ptr);
} else
#endif
{
TrailTerm(dest) = trail_cell;
if (IsVarTerm(trail_cell)) {
/* we need to check whether this is a honest to god trail entry */
if ((CELL *)trail_cell < H && MARKED(*(CELL *)trail_cell) && (CELL *)trail_cell >= H0) {
@ -1619,7 +1645,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
into_relocation_chain(CellPtr(trail_cell), GET_NEXT(*(CELL *)trail_cell));
}
}
#ifdef FROZEN_REGS
#ifdef FROZEN_STACKS
if (MARKED(TrailVal(dest))) {
UNMARK(&TrailVal(dest));
if (HEAP_PTR(TrailVal(dest))) {
@ -1632,7 +1658,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
CELL flags;
#ifdef FROZEN_REGS /* TRAIL */
#ifdef FROZEN_STACKS /* TRAIL */
/* process all segments */
if (
#ifdef SBA
@ -1645,7 +1671,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
dest++;
continue;
}
#endif /* FROZEN_REGS */
#endif /* FROZEN_STACKS */
flags = Flags((CELL)pt0);
#ifdef DEBUG
if (FlagOn(DBClMask, flags) && !FlagOn(LogUpdMask, flags)) {
@ -1696,6 +1722,15 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
into_relocation_chain(&TrailTerm(dest), GET_NEXT(old));
}
}
#ifdef FROZEN_STACKS
TrailVal(dest) = TrailVal(trail_ptr);
if (MARKED(TrailVal(dest))) {
UNMARK(&TrailVal(dest));
if (HEAP_PTR(TrailVal(dest))) {
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailTerm(dest)));
}
}
#endif
dest++;
if (MARKED(trail_cell)) {
UNMARK(&TrailTerm(dest));
@ -1704,7 +1739,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
}
}
trail_ptr++;
#ifdef FROZEN_REGS
#ifdef FROZEN_STACKS
TrailVal(dest) = TrailVal(trail_ptr);
if (MARKED(TrailVal(dest))) {
UNMARK(&TrailVal(dest));

18
C/init.c
View File

@ -47,20 +47,6 @@ static char SccsId[] = "%W% %G%";
#include <string.h>
#endif
#ifdef SBA
#ifdef YAPOR
#ifndef FROZEN_REGS
#define FROZEN_REGS 1
#endif
#endif
#endif
#ifdef TABLING
#ifndef FROZEN_REGS
#define FROZEN_REGS 1
#endif
#endif
#ifdef DEBUG
#ifdef MACC
STATIC_PROTO(void InTTYLine, (char *));
@ -1017,14 +1003,14 @@ InitYaamRegs(void)
}
}
STATIC_PREDICATES_MARKED = FALSE;
#ifdef FROZEN_REGS
#ifdef FROZEN_STACKS
H = HB = H0 = H_FZ = H_BASE;
#ifdef SBA
BSEG =
#endif /* SBA */
BBREG = B_FZ = B_BASE;
TR = TR_FZ = TR_BASE;
#endif /* FROZEN_REGS */
#endif /* FROZEN_STACKS */
CreepFlag = CalculateStackGap();
}

82
C/mavar.c
View File

@ -107,29 +107,69 @@ p_setarg(void)
== B->TR) we will add a little something ;-).
*/
#if FROZEN_STACKS
static void
CreateTimedVar(Term val)
{
timed_var *tv = (timed_var *)H;
tv->clock = MkIntegerTerm(B->cp_tr-(tr_fr_ptr)TrailBase);
if (B->cp_tr == TR) {
/* we run the risk of not making non-determinate bindings before
the end of the night */
/* so we just init a TR cell that will not harm anyone */
Bind((CELL *)(TR+1),AbsAppl(H-1));
}
tv->value = val;
H += sizeof(timed_var)/sizeof(CELL);
}
static void
CreateEmptyTimedVar(void)
{
timed_var *tv = (timed_var *)H;
tv->clock = MkIntegerTerm(B->cp_tr-(tr_fr_ptr)TrailBase);
if (B->cp_tr == TR) {
/* we run the risk of not making non-determinate bindings before
the end of the night */
/* so we just init a TR cell that will not harm anyone */
Bind((CELL *)(TR+1),AbsAppl(H-1));
}
RESET_VARIABLE(&(tv->value));
H += sizeof(timed_var)/sizeof(CELL);
}
#endif
Term NewTimedVar(CELL val)
{
Term out = AbsAppl(H);
#if FROZEN_STACKS
*H++ = (CELL)FunctorMutable;
CreateTimedVar(val);
#else
timed_var *tv;
Term out;
out = AbsAppl(H);
*H++ = (CELL)FunctorMutable;
tv = (timed_var *)H;
RESET_VARIABLE(&(tv->clock));
tv->value = val;
H += sizeof(timed_var)/sizeof(CELL);
#endif
return(out);
}
Term NewEmptyTimedVar(void)
{
Term out = AbsAppl(H);
#if FROZEN_STACKS
*H++ = (CELL)FunctorMutable;
CreateEmptyTimedVar();
#else
timed_var *tv;
Term out;
out = AbsAppl(H);
*H++ = (CELL)FunctorMutable;
tv = (timed_var *)H;
RESET_VARIABLE(&(tv->clock));
RESET_VARIABLE(&(tv->value));
H += sizeof(timed_var)/sizeof(CELL);
#endif
return(out);
}
@ -145,13 +185,10 @@ Term UpdateTimedVar(Term inv, Term new)
{
timed_var *tv = (timed_var *)(RepAppl(inv)+1);
CELL t = tv->value;
CELL* timestmp = (CELL *)(tv->clock);
#if FROZEN_STACKS
tr_fr_ptr timestmp = (tr_fr_ptr)TrailBase + IntegerOfTerm(tv->clock);
if (B->cp_h <= timestmp
#if defined(SBA) || defined(TABLING)
&& timestmp <= H
#endif
) {
if (B->cp_tr <= timestmp && timestmp <= TR) {
/* last assignment more recent than last B */
#if SBA
if (Unsigned((Int)(tv)-(Int)(H_FZ)) >
@ -160,17 +197,34 @@ Term UpdateTimedVar(Term inv, Term new)
else
#endif
tv->value = new;
#if defined(SBA) || defined(TABLING)
if (Unsigned((Int)(tv)-(Int)(HBREG)) >
Unsigned(BBREG)-(Int)(HBREG))
TrailVal(timestmp-1) = new;
#endif
Unsigned(BBREG)-(Int)(HBREG))
TrailVal(timestmp-1) = new;
} else {
Term nclock;
MaBind(&(tv->value), new);
nclock = MkIntegerTerm(TR-(tr_fr_ptr)TrailBase);
MaBind(&(tv->clock), nclock);
}
#else
CELL* timestmp = (CELL *)(tv->clock);
if (B->cp_h <= timestmp) {
/* last assignment more recent than last B */
#if SBA
if (Unsigned((Int)(tv)-(Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ)))
*STACK_TO_SBA(&(tv->value)) = new;
else
#endif
tv->value = new;
} else {
Term nclock = (Term)H;
MaBind(&(tv->value), new);
*H++ = TermFoundVar;
MaBind(&(tv->clock), nclock);
}
#endif
return(t);
}

2
C/tracer.c
View File

@ -129,7 +129,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
extern int gc_calls;
vsc_count++;
/* if (vsc_count < 4382) return;*/
if (vsc_count < 2518) return;
/* if (vsc_count > 500000) exit(0); */
/* if (gc_calls < 1) return;*/
YP_fprintf(YP_stderr,"%lu (%p)", vsc_count, H);

104
H/absmi.h
View File

@ -801,28 +801,14 @@ Macros to check the limits of stacks
#define YAPOR_update_alternative(CUR_ALT, NEW_ALT)
#endif /* YAPOR */
#ifdef SBA
#ifdef YAPOR
#ifndef FROZEN_REGS
#define FROZEN_REGS 1
#endif
#endif
#endif
#ifdef TABLING
#ifndef FROZEN_REGS
#define FROZEN_REGS 1
#endif
#endif
#if defined(FROZEN_REGS) && !defined(BFZ_TRAIL_SCHEME)
#if defined(FROZEN_STACKS) && !defined(BFZ_TRAIL_SCHEME)
#define SET_BB(V) BBREG = (V)
#else
#define SET_BB(V)
#endif
#ifdef FROZEN_REGS
#ifdef FROZEN_STACKS
#ifdef SBA
#define PROTECT_FROZEN_H(CPTR) \
((Unsigned((Int)((CPTR)->cp_h)-(Int)(H_FZ)) < \
@ -1110,40 +1096,58 @@ inline EXTERN int STD_PROTO(unify_extension,(Functor, CELL, CELL *, CELL));
#endif
#if defined(SBA) || defined(MULTI_ASSIGNMENT_VARIABLES)
#define trim_trail()
#elif FROZEN_REGS
{ tr_fr_ptr pt1, pt0; \
pt1 = TR; \
pt0 = TR = B->cp_tr; \
BEGD(d0); \
d0 = Unsigned(HBREG); \
while (pt0 < pt1) \
BEGD(d1); \
if (IsVarTerm(d1 = TrailTerm(pt0))) { \
if (d1 < d0 || d1 > Unsigned(B)) { \
DO_TRAIL(d1, TrailVal(pt0)); \
} \
pt0++; \
ENDD(d1); \
ENDD(d0); \
}
#if FROZEN_STACKS
static inline tr_fr_ptr
trim_trail(choiceptr b, tr_fr_ptr tr, CELL *hbreg)
{
tr_fr_ptr pt1, pt0;
pt1 = tr;
pt0 = TR = B->cp_tr;
BEGD(d0);
d0 = Unsigned(hbreg);
while (pt0 < pt1) {
BEGD(d1);
if (IsVarTerm(d1 = TrailTerm(pt0))) {
if (d1 < d0 || d1 > Unsigned(B)) {
DO_TRAIL(d1, TrailVal(pt0));
}
pt0++;
} else {
DO_TRAIL(d1, TrailVal(pt0));
pt0++;
}
ENDD(d1);
}
ENDD(d0);
return(TR);
}
#elif defined(SBA) || defined(MULTI_ASSIGNMENT_VARIABLES)
#define trim_trail(B, TR, HBREG) (TR)
#else
#define trim_trail() \
{ tr_fr_ptr pt1, pt0; \
pt1 = TR; \
pt0 = TR = B->cp_tr; \
BEGD(d0); \
d0 = Unsigned(HBREG); \
while (pt0 < pt1) \
BEGD(d1); \
if (IsVarTerm(d1 = *pt0++)) { \
if (d1 < d0 || d1 > Unsigned(B)) \
*TR++ = d1; \
} \
ENDD(d1); \
ENDD(d0); \
}
#endif /* FROZEN_REGS */
static inline tr_fr_ptr
trim_trail(choiceptr b, tr_fr_ptr tr, CELL *hbreg)
{
tr_fr_ptr pt1, pt0;
pt1 = TR;
pt0 = TR = B->cp_tr;
BEGD(d0);
d0 = Unsigned(HBREG);
while (pt0 < pt1) {
BEGD(d1);
if (IsVarTerm(d1 = TrailTerm(pt0))) {
if (d1 < d0 || d1 > Unsigned(B)) {
DO_TRAIL(d1, TrailVal(pt0));
}
pt0++;
ENDD(d1);
ENDD(d0);
}
}
return(TR);
}
#endif /* FROZEN_STACKS */

17
H/amiops.h
View File

@ -149,6 +149,7 @@ AlignGlobalForDouble(void)
DO_TRAIL(TERM, VAL)
#ifdef TERM_EXTENSIONS
#define Trail(TERM, VAL, LAB) \
if (IN_BETWEEN(HBREG,TERM,B) && \
((TERM) < (CELL *)B_FZ)) \
@ -186,19 +187,19 @@ AlignGlobalForDouble(void)
#ifdef TERM_EXTENSIONS
#define Trail_Global(TERM, VAL, LAB) \
if ((TERM) < HBREG) goto LAB
if ((TERM) >= HBREG) goto LAB
#else
#define Trail_Global(TERM, VAL, LAB) \
TRAIL_GLOBAL(TERM, VAL)
#endif
#define DO_MATRAIL(TERM, OLDVAL, NEWVAL) \
{ \
register tr_fr_ptr r = TR; \
TR = r + 2; \
TrailTerm(r) = (OLDVAL); \
TrailTerm(r+1) = AbsAppl((CELL *)(TERM)); \
TrailVal(r+1) = (NEWVAL); \
#define DO_MATRAIL(TERM, OLDVAL, NEWVAL) \
{ \
register tr_fr_ptr r = TR; \
TR = r + 2; \
TrailVal(r) = (OLDVAL); \
TrailTerm(r) = TrailTerm(r+1) = AbsAppl((CELL *)(TERM)); \
TrailVal(r+1) = (NEWVAL); \
}
#define MATRAIL(TERM, OVAL, VAL) \

13
TO_DO
View File

@ -2,15 +2,11 @@ BEFORE 4.4:
- mixed attributes and delays.
- write infinite terms
- constraints in DB.
- fix SBA plus co-routining
- non-void temporaries going to global
- timestamps on files.
- warnings in documentation file.
- system library
- fix restore when code is moved around.
- library(system) for WIN32
- document new interface functions.
- ^C can break code.
- add more precision when outputting floats.
- make statistics/0 better looking.
- mask when installing.
@ -21,8 +17,6 @@ TO CHECK:
TABLING
- pass all tabling tests from Kostis and Bart paper
- handle floats, long ints and friends in tables.
- make gc work after mutable var changes.
- knap-sack
PARALLELISM
- copying: Fix stack copying after new stack.
@ -85,3 +79,10 @@ DONE:
- check library(random)
- document system(library)
- interrupt handling in WIN32
- ^C can break code.
- system library
- library(system) for WIN32
TO DO (tabling)
- make gc work after mutable var changes.
- knap-sack

16
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.7 2001-06-27 15:00:10 vsc Exp $ *
* version: $Id: Yap.h.m4,v 1.8 2001-07-04 16:48:54 uid49918 Exp $ *
*************************************************************************/
#include "config.h"
@ -79,6 +79,20 @@
#endif
#endif
#ifdef SBA
#ifdef YAPOR
#ifndef FROZEN_STACKS
#define FROZEN_STACKS 1
#endif
#endif
#endif
#ifdef TABLING
#ifndef FROZEN_STACKS
#define FROZEN_STACKS 1
#endif
#endif
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
/* adjust a config.h from mingw32 to work with vc++ */
#ifdef HAVE_GCC