fixes for abolish.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@525 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/amasm.c

@@ -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;

C/cdmgr.c

@@ -363,8 +363,14 @@ retract_all(PredEntry *p)
       } else {
 	if (p->PredFlags & LogUpdatePredFlag)
 	  ErCl(cl);
-	else
+	else {
-	  FreeCodeSpace((char *)cl);
+	  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
+      else {
-	FreeCodeSpace((char *)ClauseCodeToClause(q1));
+	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)
 {

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) &&
+	if (tref->Flags & InUseMask) {
-	    tref->Parent != NULL &&
+	  if ((tref->Flags & ErasedMask) &&
-	    tref->Parent->KindOfPE & LogUpdDBBit) {
+	      tref->Parent != NULL &&
-	  *current = MkDBRefTerm(DBErasedMarker);
+	      tref->Parent->KindOfPE & LogUpdDBBit) {
-	  MARK(current);
+	    *current = MkDBRefTerm(DBErasedMarker);
-	} else {
+	    MARK(current);
-	  tref->Flags |= GcFoundMask;
+	  } 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)) {

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);
 }

C/tracer.c

@@ -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 == 32) {
-  if (vsc_count == 64) {
     printf("Here I go\n");
   }
   /* if (vsc_count > 500000) exit(0); */

H/clause.h

@@ -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;

changes4.3.html

@@ -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>

config.h.in

@@ -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

docs/yap.tex

@@ -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).

m4/Yatom.h.m4

@@ -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 	*/

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),
+            '$flags'(Head,Mod,Fl,Fl),
-	    ( Fl /\ 16'400000 =\= 0 -> '$erase_source'(H,Mod) ; true ),
+	    ( Fl /\ 16'400000 =\= 0 -> '$erase_source'(Head,Mod) ; true ),
-	    ( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Mod,Fl) ; 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),
+            '$flags'(Head,Mod,Fl,Fl),
-            ( Fl /\ 16'400000 =\= 0 -> '$erase_source'(H,Mod) ; true ),
+            ( Fl /\ 16'400000 =\= 0 -> '$erase_source'(Head,Mod) ; true ),
-	    ( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Mod,Fl) ; 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))).