allow coroutining plus tabling, this means fixing some trouble with the
gc and a bug in global variable handling. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1745 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
d79dd807e6
commit
c79a7a5bdb
@ -10,8 +10,11 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2006-12-27 01:32:37 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2006-12-29 01:57:50 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.215 2006/12/27 01:32:37 vsc
|
||||
* diverse fixes
|
||||
*
|
||||
* Revision 1.214 2006/11/28 00:46:28 vsc
|
||||
* fix bug in threaded implementation
|
||||
*
|
||||
@ -507,7 +510,6 @@ char *Yap_op_names[_std_top + 1] =
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
Int
|
||||
Yap_absmi(int inp)
|
||||
{
|
||||
@ -2086,6 +2088,7 @@ Yap_absmi(int inp)
|
||||
#ifdef FROZEN_STACKS
|
||||
{
|
||||
tr_fr_ptr pt0, pt1, pbase;
|
||||
|
||||
pbase = B->cp_tr;
|
||||
pt0 = pt1 = TR - 1;
|
||||
while (pt1 >= pbase) {
|
||||
|
||||
@ -148,7 +148,7 @@ NewDelayArena(UInt size)
|
||||
UInt howmuch;
|
||||
|
||||
while ((ADDR)min < Yap_GlobalBase+1024) {
|
||||
if ((howmuch = Yap_InsertInGlobal((CELL *)max, size*sizeof(attvar_record))==0)) {
|
||||
if ((howmuch = Yap_InsertInGlobal((CELL *)max, size*sizeof(attvar_record)))==0) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms");
|
||||
return TermNil;
|
||||
}
|
||||
|
||||
44
C/heapgc.c
44
C/heapgc.c
@ -126,7 +126,7 @@ static cont *cont_top;
|
||||
|
||||
static gc_ma_hash_entry gc_ma_hash_table[GC_MAVARS_HASH_SIZE];
|
||||
|
||||
static gc_ma_hash_entry *gc_ma_h_top;
|
||||
static gc_ma_hash_entry *gc_ma_h_top, *gc_ma_h_list;
|
||||
|
||||
static UInt gc_timestamp; /* an unsigned int */
|
||||
|
||||
@ -337,6 +337,11 @@ gc_lookup_ma_var(CELL *addr, tr_fr_ptr trp) {
|
||||
if (gc_ma_hash_table[i].timestmp != gc_timestamp) {
|
||||
gc_ma_hash_table[i].timestmp = gc_timestamp;
|
||||
gc_ma_hash_table[i].addr = addr;
|
||||
#if TABLING
|
||||
gc_ma_hash_table[i].loc = trp;
|
||||
gc_ma_hash_table[i].more = gc_ma_h_list;
|
||||
gc_ma_h_list = gc_ma_hash_table+i;
|
||||
#endif
|
||||
gc_ma_hash_table[i].next = NULL;
|
||||
return NULL;
|
||||
}
|
||||
@ -344,6 +349,13 @@ gc_lookup_ma_var(CELL *addr, tr_fr_ptr trp) {
|
||||
while (nptr) {
|
||||
optr = nptr;
|
||||
if (nptr->addr == addr) {
|
||||
#if TABLING
|
||||
/*
|
||||
we're moving from oldest to more recent, so only a new entry
|
||||
has the correct new value
|
||||
*/
|
||||
TrailVal(nptr->loc+1) = TrailVal(trp+1);
|
||||
#endif
|
||||
return nptr;
|
||||
}
|
||||
nptr = nptr->next;
|
||||
@ -351,13 +363,20 @@ gc_lookup_ma_var(CELL *addr, tr_fr_ptr trp) {
|
||||
nptr = GC_ALLOC_NEW_MASPACE();
|
||||
optr->next = nptr;
|
||||
nptr->addr = addr;
|
||||
#if TABLING
|
||||
nptr->loc = trp;
|
||||
#endif
|
||||
nptr->next = NULL;
|
||||
nptr->more = gc_ma_h_list;
|
||||
gc_ma_h_list = nptr;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static inline void
|
||||
GC_NEW_MAHASH(gc_ma_hash_entry *top) {
|
||||
UInt time = ++gc_timestamp;
|
||||
|
||||
gc_ma_h_list = NULL;
|
||||
if (time == 0) {
|
||||
unsigned int i;
|
||||
|
||||
@ -1651,11 +1670,10 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
mark_external_reference(&(TrailTerm(trail_base)));
|
||||
/* reset the gc to believe the original tag */
|
||||
TrailTerm(trail_base) = AbsAppl((CELL *)TrailTerm(trail_base));
|
||||
}
|
||||
#ifdef TABLING
|
||||
mark_external_reference(&(TrailVal(trail_base)));
|
||||
#endif
|
||||
}
|
||||
#ifndef TABLING
|
||||
#else
|
||||
trail_base++;
|
||||
mark_external_reference(&(TrailTerm(trail_base)));
|
||||
#endif
|
||||
@ -1666,9 +1684,6 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
mark_external_reference(&(TrailTerm(trail_base)));
|
||||
/* reset the gc to believe the original tag */
|
||||
TrailTerm(trail_base) = AbsAppl((CELL *)TrailTerm(trail_base));
|
||||
#ifdef TABLING
|
||||
mark_external_reference(&(TrailVal(trail_base)));
|
||||
#endif
|
||||
}
|
||||
} else {
|
||||
remove_trash_entry:
|
||||
@ -1695,6 +1710,19 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
#endif
|
||||
trail_base++;
|
||||
}
|
||||
#if TABLING
|
||||
/*
|
||||
Ugly, but needed: we're not really sure about what were the new
|
||||
values until the very end
|
||||
*/
|
||||
{
|
||||
gc_ma_hash_entry *gl = gc_ma_h_list;
|
||||
while (gl) {
|
||||
mark_external_reference(&(TrailVal(gl->loc+1)));
|
||||
gl = gl->more;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
#ifdef EASY_SHUNTING
|
||||
sTR = (tr_fr_ptr)old_cont_top0;
|
||||
while (begsTR != NULL) {
|
||||
@ -2373,6 +2401,8 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
||||
Int marked_val_ptr = MARKED_PTR(&TrailVal(trail_ptr+1));
|
||||
|
||||
TrailTerm(dest+1) = TrailTerm(dest) = trail_cell;
|
||||
TrailVal(dest) = old;
|
||||
TrailVal(dest+1) = old1;
|
||||
if (marked_ptr) {
|
||||
UNMARK(&TrailTerm(dest));
|
||||
UNMARK(&TrailTerm(dest+1));
|
||||
|
||||
@ -160,7 +160,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
||||
|
||||
LOCK(Yap_heap_regs->low_level_trace_lock);
|
||||
sc = Yap_heap_regs;
|
||||
vsc_count++;
|
||||
#ifdef COMMENTED
|
||||
if (vsc_count > 1388060LL && vsc_count < 1388070LL) {
|
||||
if (vsc_count==1388061LL)
|
||||
|
||||
8
H/Heap.h
8
H/Heap.h
@ -10,7 +10,7 @@
|
||||
* File: Heap.h *
|
||||
* mods: *
|
||||
* comments: Heap Init Structure *
|
||||
* version: $Id: Heap.h,v 1.111 2006-12-27 01:32:37 vsc Exp $ *
|
||||
* version: $Id: Heap.h,v 1.112 2006-12-29 01:57:50 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* information that can be stored in Code Space */
|
||||
@ -46,6 +46,10 @@ typedef struct memory_hole {
|
||||
|
||||
typedef struct gc_ma_hash_entry_struct {
|
||||
UInt timestmp;
|
||||
#if TABLING
|
||||
tr_fr_ptr loc;
|
||||
struct gc_ma_hash_entry_struct *more;
|
||||
#endif
|
||||
CELL* addr;
|
||||
struct gc_ma_hash_entry_struct *next;
|
||||
} gc_ma_hash_entry;
|
||||
@ -153,6 +157,7 @@ typedef struct worker_local_struct {
|
||||
int disc_trail_entries;
|
||||
gc_ma_hash_entry Gc_ma_hash_table[GC_MAVARS_HASH_SIZE];
|
||||
gc_ma_hash_entry *Gc_ma_h_top;
|
||||
gc_ma_hash_entry *Gc_ma_h_list;
|
||||
UInt Gc_timestamp; /* an unsigned int */
|
||||
ADDR DB_vec, DB_vec0;
|
||||
struct RB_red_blk_node *DB_root, *DB_nil;
|
||||
@ -847,6 +852,7 @@ struct various_codes *Yap_heap_regs;
|
||||
#endif /* GC_NO_TAGS */
|
||||
#define gc_ma_hash_table Yap_heap_regs->wl[worker_id].Gc_ma_hash_table
|
||||
#define gc_ma_h_top Yap_heap_regs->wl[worker_id].Gc_ma_h_top
|
||||
#define gc_ma_h_list Yap_heap_regs->wl[worker_id].Gc_ma_h_list
|
||||
#define gc_timestamp Yap_heap_regs->wl[worker_id].Gc_timestamp
|
||||
#define cont_top0 Yap_heap_regs->wl[worker_id].conttop0
|
||||
#define db_vec Yap_heap_regs->wl[worker_id].DB_vec
|
||||
|
||||
@ -16,6 +16,8 @@
|
||||
|
||||
<h2>Yap-5.1.2:</h2>
|
||||
<ul>
|
||||
<li> FIXED: garbage collector would not understand bindings to mavars in
|
||||
tabling version.</li>
|
||||
<li> FIXED: cut might not prune correctly around meta-call (obs by
|
||||
Trevor Walker).</li>
|
||||
<li> NEW: keep history around (use nb and friends).</li>
|
||||
|
||||
13
configure
vendored
13
configure
vendored
@ -848,9 +848,9 @@ Optional Features:
|
||||
--enable-cut-c support for executing c code when a cut occurs
|
||||
--enable-tabling support tabling
|
||||
--enable-or-parallelism support or-parallelism as: env-copy,sba,a-cow
|
||||
--enable-depth-limit support depth-bound computation
|
||||
--enable-rational-trees support infinite rational trees
|
||||
--enable-coroutining support co-routining, attributed variables and constraints
|
||||
--enable-depth-limit support depth-bound computation
|
||||
--enable-wam-profile support low level profiling of abstract machine
|
||||
--enable-low-level-tracer support support for procedure-call tracing
|
||||
--enable-threads support system threads
|
||||
@ -2283,16 +2283,6 @@ if test "${enable_or_parallelism+set}" = set; then
|
||||
else
|
||||
orparallelism=no
|
||||
fi;
|
||||
if test "$tabling" = yes -o "$orparallelism" = yes -o "$threads" = yes
|
||||
then
|
||||
# Check whether --enable-depth-limit or --disable-depth-limit was given.
|
||||
if test "${enable_depth_limit+set}" = set; then
|
||||
enableval="$enable_depth_limit"
|
||||
depthlimit="$enableval"
|
||||
else
|
||||
depthlimit=no
|
||||
fi;
|
||||
else
|
||||
# Check whether --enable-rational-trees or --disable-rational-trees was given.
|
||||
if test "${enable_rational_trees+set}" = set; then
|
||||
enableval="$enable_rational_trees"
|
||||
@ -2314,7 +2304,6 @@ if test "${enable_depth_limit+set}" = set; then
|
||||
else
|
||||
depthlimit=yes
|
||||
fi;
|
||||
fi
|
||||
# Check whether --enable-wam-profile or --disable-wam-profile was given.
|
||||
if test "${enable_wam_profile+set}" = set; then
|
||||
enableval="$enable_wam_profile"
|
||||
|
||||
@ -24,12 +24,6 @@ AC_ARG_ENABLE(tabling,
|
||||
AC_ARG_ENABLE(or-parallelism,
|
||||
[ --enable-or-parallelism support or-parallelism as: env-copy,sba,a-cow ],
|
||||
orparallelism="$enableval", orparallelism=no)
|
||||
if test "$tabling" = yes -o "$orparallelism" = yes -o "$threads" = yes
|
||||
then
|
||||
AC_ARG_ENABLE(depth-limit,
|
||||
[ --enable-depth-limit support depth-bound computation ],
|
||||
depthlimit="$enableval", depthlimit=no)
|
||||
else
|
||||
AC_ARG_ENABLE(rational-trees,
|
||||
[ --enable-rational-trees support infinite rational trees ],
|
||||
rationaltrees="$enableval" , rationaltrees=yes)
|
||||
@ -39,7 +33,6 @@ AC_ARG_ENABLE(coroutining,
|
||||
AC_ARG_ENABLE(depth-limit,
|
||||
[ --enable-depth-limit support depth-bound computation ],
|
||||
depthlimit="$enableval", depthlimit=yes)
|
||||
fi
|
||||
AC_ARG_ENABLE(wam-profile,
|
||||
[ --enable-wam-profile support low level profiling of abstract machine ],
|
||||
wamprofile="$enableval", wamprofile=no)
|
||||
|
||||
25
pl/utils.yap
25
pl/utils.yap
@ -166,6 +166,29 @@ call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- atom(A), !,
|
||||
call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :-
|
||||
'$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)).
|
||||
|
||||
/*
|
||||
|
||||
call_cleanup(Goal, Catcher, Cleanup) :-
|
||||
catch('$call_cleanup'(Goal,Catcher,Cleanup),
|
||||
Exception,
|
||||
'$cleanup_exception'(Exception,Catcher,Cleanup)).
|
||||
|
||||
'$cleanup_exception'(Exception, exception(Exception), Cleanup) :-
|
||||
call(cleanup).
|
||||
|
||||
'$call_cleanup'(Goal,Catcher,Cleanup) :-
|
||||
yap_hacks:current_choice_point(CP0),
|
||||
call(Goal),
|
||||
yap_hacks:current_choice_point(CPF),
|
||||
( CP0 =:= CPF ->
|
||||
Catcher = exit,
|
||||
call(Cleanup)
|
||||
;
|
||||
true
|
||||
).
|
||||
'$call_cleanup'(Goal,fail,Cleanup) :-
|
||||
call(Cleanup).
|
||||
*/
|
||||
|
||||
op(P,T,V) :- var(P), !,
|
||||
'$do_error'(instantiation_error,op(P,T,V)).
|
||||
@ -465,7 +488,7 @@ unknown(V0,V) :-
|
||||
|
||||
% Only efective if yap compiled with -DDEBUG
|
||||
% this predicate shows the code produced by the compiler
|
||||
'$show_code' :- '$debug'(0'f).
|
||||
'$show_code' :- '$debug'(0'f). %' just make emacs happy
|
||||
|
||||
grow_heap(X) :- '$grow_heap'(X).
|
||||
grow_stack(X) :- '$grow_stack'(X).
|
||||
|
||||
Reference in New Issue
Block a user