fixes for abolish.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@525 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-06-11 05:30:47 +00:00
parent a254dad245
commit 7176752a68
11 changed files with 66 additions and 25 deletions

View File

@ -140,6 +140,8 @@ static Int c_arg;
#define TYPE_XC 2
static int c_type;
static int clause_has_blobs;
inline static YREG
emit_y(Ventry *ve)
{
@ -614,6 +616,7 @@ a_blob(op_numbers opcode)
code_p->u.c.c =
AbsAppl((CELL *)(Unsigned(code_addr) + label_offset[cpc->rnd1]));
}
clause_has_blobs = TRUE;
GONEXT(c);
}
@ -627,6 +630,7 @@ a_ublob(op_numbers opcode, op_numbers opcode_w)
AbsAppl((CELL *)(Unsigned(code_addr) + label_offset[cpc->rnd1]));
}
clause_has_blobs = TRUE;
GONEXT(oc);
}
@ -1985,6 +1989,9 @@ do_pass(void)
cl_p->ClFlags = c_mask;
if (log_update)
cl_p->ClFlags |= LogUpdMask;
if (clause_has_blobs) {
cl_p->ClFlags |= HasBlobsMask;
}
cl_p->u2.ClExt = NULL;
cl_p->Owner = YapConsultingFile();
}
@ -2583,6 +2590,7 @@ assemble(int mode)
code_addr = NIL;
assembling = mode;
clause_has_blobs = FALSE;
label_offset = (int *)freep;
pass_no = 0;
asm_error = FALSE;

View File

@ -363,8 +363,14 @@ retract_all(PredEntry *p)
} else {
if (p->PredFlags & LogUpdatePredFlag)
ErCl(cl);
else
FreeCodeSpace((char *)cl);
else {
if (cl->ClFlags & HasBlobsMask) {
cl->u.NextCl = DeadClauses;
DeadClauses = cl;
} else {
FreeCodeSpace((char *)cl);
}
}
}
} while (q1 != p->LastClause);
}
@ -1247,8 +1253,15 @@ p_purge_clauses(void)
q = NextClause(q);
if (pred->PredFlags & LogUpdatePredFlag)
ErCl(ClauseCodeToClause(q1));
else
FreeCodeSpace((char *)ClauseCodeToClause(q1));
else {
Clause *cl = ClauseCodeToClause(q1);
if (cl->ClFlags & HasBlobsMask) {
cl->u.NextCl = DeadClauses;
DeadClauses = cl;
} else {
FreeCodeSpace((char *)cl);
}
}
} while (q1 != pred->LastClause);
pred->FirstClause = pred->LastClause = NIL;
pred->OpcodeOfPred = UNDEF_OPCODE;
@ -2299,6 +2312,7 @@ p_cut_transparent(void)
return(TRUE);
}
void
InitCdMgr(void)
{

View File

@ -879,13 +879,15 @@ mark_variable(CELL_PTR current)
if ((Functor)cnext == FunctorDBRef) {
DBRef tref = DBRefOfTerm(ccur);
/* make sure the reference is marked as in use */
if ((tref->Flags & ErasedMask) &&
tref->Parent != NULL &&
tref->Parent->KindOfPE & LogUpdDBBit) {
*current = MkDBRefTerm(DBErasedMarker);
MARK(current);
} else {
tref->Flags |= GcFoundMask;
if (tref->Flags & InUseMask) {
if ((tref->Flags & ErasedMask) &&
tref->Parent != NULL &&
tref->Parent->KindOfPE & LogUpdDBBit) {
*current = MkDBRefTerm(DBErasedMarker);
MARK(current);
} else {
tref->Flags |= GcFoundMask;
}
}
} else {
mark_db_fixed(next);
@ -1850,7 +1852,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
#endif /* FROZEN_STACKS */
flags = Flags((CELL)pt0);
#ifdef DEBUG
if (FlagOn(DBClMask, flags) && !FlagOn(LogUpdMask, flags)) {
if (FlagOn(DBClMask, flags)) {
hp_entrs++;
if (!FlagOn(GcFoundMask, flags)) {
hp_not_in_use++;
@ -1867,7 +1869,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
}
#endif
if (!FlagOn(GcFoundMask, flags) && !FlagOn(LogUpdMask, flags)) {
if (!FlagOn(GcFoundMask, flags)) {
if (FlagOn(DBClMask, flags)) {
Flags((CELL)pt0) = ResetFlag(InUseMask, flags);
if (FlagOn(ErasedMask, flags)) {

View File

@ -1077,6 +1077,7 @@ InitCodes(void)
heap_regs->db_erased_marker->id = FunctorDBRef;
heap_regs->db_erased_marker->Flags = ErasedMask;
heap_regs->db_erased_marker->Code = NULL;
heap_regs->db_erased_marker->Parent = NULL;
INIT_LOCK(heap_regs->db_erased_marker->lock);
INIT_DBREF_COUNT(heap_regs->db_erased_marker);
}

View File

@ -112,8 +112,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* extern int gc_calls; */
vsc_count++;
/* if (vsc_count < 618000) return; */
if (vsc_count == 64) {
if (vsc_count == 32) {
printf("Here I go\n");
}
/* if (vsc_count > 500000) exit(0); */

View File

@ -81,7 +81,7 @@ typedef struct clause_struct {
/* the actual owner of the clause */
Atom Owner;
/* A set of flags describing info on the clause */
OPREG ClFlags;
CELL ClFlags;
#if defined(YAPOR) || defined(THREADS)
/* A lock for manipulating the clause */
lockvar ClLock;

View File

@ -16,6 +16,7 @@
<h2>Yap-4.3.23:</h2>
<ul>
<li>FIXED: new options for file_property (Nicos).</li>
<li>FIXED: check unification result in file_property (Nicos).</li>
<li>FIXED: yap_flag(fileerrors) (Nicos).</li>
<li>FIXED: clauses with blobs cannot be simply abolished.</li>

View File

@ -184,6 +184,7 @@
#undef HAVE_PUTENV
#undef HAVE_RAND
#undef HAVE_RANDOM
#undef HAVE_READLINK
#undef HAVE_REGEXEC
#undef HAVE_RENAME
#undef HAVE_RINT

View File

@ -7721,7 +7721,9 @@ file, a directory, a fifo file, or of unknown type;
@code{size(@var{Size})}, with gives the size for a file, and
@code{mod_time(@var{Time})}, which gives the last time a file was
modified according to some Operating System dependent
timestamp. Properties can be obtained through backtracking:
timestamp; @code{mode(@var{mode})}, gives the permission flags for the
file, and @code{linkto(@var{FileName})}, gives the file pointed to by a
symbolic link. Properties can be obtained through backtracking:
@example
?- file_property('Makefile',P).

View File

@ -252,6 +252,7 @@ extern cmp_entry cmp_funcs[MAX_CMP_FUNCS];
/* Flags for code or dbase entry */
/* There are several flags for code and data base entries */
typedef enum {
HasBlobsMask = 0x20000, /* informs this has blobs whihc may be in use */
GcFoundMask = 0x10000, /* informs this is a dynamic predicate */
DynamicMask = 0x8000, /* informs this is a dynamic predicate */
InUseMask = 0x4000, /* informs this block is being used */
@ -273,7 +274,7 @@ typedef struct DB_STRUCT {
Functor id; /* allow pointers to this struct to id */
/* as dbref */
Term EntryTerm; /* cell bound to itself */
SMALLUNSGN Flags; /* Term Flags */
CELL Flags; /* Term Flags */
SMALLUNSGN NOfRefsTo; /* Number of references pointing here */
struct struct_dbentry *Parent; /* key of DBase reference */
CODEADDR Code; /* pointer to code if this is a clause */

View File

@ -141,9 +141,9 @@ assertz_static(C) :-
'$compile_dynamic'((Head:-Body), 2, Mod, CR),
( '$get_value'('$abol',true)
->
'$flags'(H,Mod,Fl,Fl),
( Fl /\ 16'400000 =\= 0 -> '$erase_source'(H,Mod) ; true ),
( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Mod,Fl) ; true )
'$flags'(Head,Mod,Fl,Fl),
( Fl /\ 16'400000 =\= 0 -> '$erase_source'(Head,Mod) ; true ),
( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true )
;
true
),
@ -160,9 +160,9 @@ assertz_static(C) :-
'$compile_dynamic'((Head:-Body), 0, Mod, CR),
( '$get_value'('$abol',true)
->
'$flags'(H,Mod,Fl,Fl),
( Fl /\ 16'400000 =\= 0 -> '$erase_source'(H,Mod) ; true ),
( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Mod,Fl) ; true )
'$flags'(Head,Mod,Fl,Fl),
( Fl /\ 16'400000 =\= 0 -> '$erase_source'(Head,Mod) ; true ),
( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true )
;
true
),
@ -284,9 +284,15 @@ retract(C) :-
'$retract'(M:C,_) :- !,
'$retract'(C,M).
'$retract'(C,M) :-
'$check_head_and_body'(C,H,B,retract(C)),
'$check_head_and_body'(C,H,B,retract(M:C)),
'$is_dynamic'(H, M), !,
'$recordedp'(M:H,(H:-B),R), erase(R).
'$retract'(C,M) :-
'$check_head_and_body'(C,H,B,retract(M:C)),
'$undefined'(H,M), !,
functor(H,Na,Ar),
'$dynamic'(Na/Ar,M),
fail.
'$retract'(C,M) :-
'$fetch_predicate_indicator_from_clause'(C, PI),
throw(error(permission_error(modify,static_procedure,PI),retract(M:C))).
@ -310,6 +316,12 @@ retract(C,R) :- !,
var(R),
'$recordedp'(M:H,(H:-B),R),
erase(R).
'$retract'(C,M,_) :-
'$check_head_and_body'(C,H,B,retract(M:C,R)),
'$undefined'(H,M), !,
functor(H,Na,Ar),
'$dynamic'(Na/Ar,M),
fail.
'$retract'(C,M,_) :-
'$fetch_predicate_indicator_from_clause'(C, PI),
throw(error(permission_error(modify,static_procedure,PI),retract(M:C))).