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:
parent
a254dad245
commit
7176752a68
@ -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;
|
||||
|
22
C/cdmgr.c
22
C/cdmgr.c
@ -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)
|
||||
{
|
||||
|
20
C/heapgc.c
20
C/heapgc.c
@ -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)) {
|
||||
|
1
C/init.c
1
C/init.c
@ -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);
|
||||
}
|
||||
|
@ -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); */
|
||||
|
@ -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;
|
||||
|
@ -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>
|
||||
|
@ -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
|
||||
|
@ -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).
|
||||
|
@ -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 */
|
||||
|
26
pl/preds.yap
26
pl/preds.yap
@ -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))).
|
||||
|
Reference in New Issue
Block a user