Merge branch 'master' of ../yap-6.2

C/absmi.c

@@ -2215,9 +2215,11 @@ Yap_absmi(int inp)
       /* cut                              */
       Op(cut, e);
 #ifdef COROUTINING
+      if (FALSE) {
 	CACHE_Y_AS_ENV(YREG);
 	check_stack(NoStackCut, H);
 	ENDCACHE_Y_AS_ENV();
+      }
     do_cut:
 #endif
       PREG = NEXTOP(NEXTOP(NEXTOP(PREG, e),Osbpp),l);
@@ -2261,9 +2263,11 @@ Yap_absmi(int inp)
       /* cut_t does the same as cut */
       Op(cut_t, e);
 #ifdef COROUTINING
+      if (FALSE) {
 	CACHE_Y_AS_ENV(YREG);
 	check_stack(NoStackCutT, H);
 	ENDCACHE_Y_AS_ENV();
+      }
     do_cut_t:
 #endif
       PREG = NEXTOP(NEXTOP(NEXTOP(PREG, e),Osbpp),l);
@@ -2322,9 +2326,11 @@ Yap_absmi(int inp)
       /* cut_e                            */
       Op(cut_e, e);
 #ifdef COROUTINING
+      if (FALSE) {
 	CACHE_Y_AS_ENV(YREG);
 	check_stack(NoStackCutE, H);
 	ENDCACHE_Y_AS_ENV();
+      }
     do_cut_e:
 #endif
       PREG = NEXTOP(NEXTOP(NEXTOP(PREG, e),Osbpp),l);
@@ -2794,7 +2800,7 @@ Yap_absmi(int inp)
       }
       if (!(ActiveSignals & YAP_CREEP_SIGNAL)) {
 	SREG = (CELL *)PredRestoreRegs;
-	XREGS[0] = MkIntegerTerm(LCL0-(CELL *)YREG[E_CB]);
+	XREGS[0] = MkIntegerTerm(LCL0-(CELL *)SREG[E_CB]);
 	PREG = NEXTOP(PREG,e);
 	goto creep_either;
       }

C/agc.c

@@ -143,6 +143,7 @@ static Term AdjustDBTerm(Term, Term *);
 #define OpcodeAdjust(P) (P)
 #define ModuleAdjust(P) (P)
 #define ExternalFunctionAdjust(P) (P)
+#define DBRecordAdjust(P) (P)
 #define PredEntryAdjust(P) (P)
 #define ModEntryPtrAdjust(P) (P)
 #define AtomEntryAdjust(P) (P)
@@ -200,6 +201,8 @@ static Term AdjustDBTerm(Term, Term *);
 
 #include "rheap.h"
 
+
+
 static void
 RestoreHashPreds(void)
 {

C/c_interface.c

@@ -3152,20 +3152,80 @@ YAP_FileDescriptorFromStream(Term t)
 X_API void *
 YAP_Record(Term t)
 {
+  DBTerm *dbterm;
+  DBRecordList *dbt;
 
-  return (void *)Yap_StoreTermInDB(Deref(t), 0);
+  dbterm = Yap_StoreTermInDB(Deref(t), 0);
+  if (dbterm == NULL)
+    return NULL;
+  dbt = (struct record_list *)Yap_AllocCodeSpace(sizeof(struct record_list));
+  while (dbt == NULL) {
+    if (!Yap_growheap(FALSE, sizeof(struct record_list), NULL)) {
+      /* be a good neighbor */
+      Yap_FreeCodeSpace((void *)dbterm);
+      Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "using YAP_Record");
+      return NULL;
+    }
+  }
+  if (Yap_Records) {
+    Yap_Records->prev_rec = dbt;
+  }
+  dbt->next_rec = Yap_Records;
+  dbt->prev_rec = NULL;
+  dbt->dbrecord = dbterm;
+  Yap_Records = dbt;
+  fprintf(stderr,"adding %p\n", dbt);
+  return dbt;
 }
 
 X_API Term
 YAP_Recorded(void *handle)
 {
-  return Yap_FetchTermFromDB((DBTerm *)handle);
+  Term t;
+  fprintf(stderr,"reading %p\n", handle);
+  DBTerm *dbterm = ((DBRecordList *)handle)->dbrecord;
+
+  BACKUP_MACHINE_REGS();
+  do {
+    Yap_Error_TYPE = YAP_NO_ERROR;
+    t = Yap_FetchTermFromDB(dbterm);
+    if (Yap_Error_TYPE == YAP_NO_ERROR) {
+      RECOVER_MACHINE_REGS();
+      return t;
+    } else if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
+      Yap_Error_TYPE = YAP_NO_ERROR;
+      if (!Yap_growglobal(NULL)) {
+	Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
+	RECOVER_MACHINE_REGS();
+	return FALSE;
+      }
+    } else {
+      Yap_Error_TYPE = YAP_NO_ERROR;
+      if (!Yap_growstack(dbterm->NOfCells*CellSize)) {
+	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+	RECOVER_MACHINE_REGS();
+	return FALSE;
+      }
+    }
+  } while (t == (CELL)0);
+  RECOVER_MACHINE_REGS();
+  return t;
 }
 
 X_API int
 YAP_Erase(void *handle)
 {
-  Yap_ReleaseTermFromDB((DBTerm *)handle);
+  fprintf(stderr,"erasing %p\n", handle);
+  DBRecordList *dbr = (DBRecordList *)handle;
+  Yap_ReleaseTermFromDB(dbr->dbrecord);
+  if (dbr->next_rec) 
+    dbr->next_rec->prev_rec = dbr->prev_rec;
+  if (dbr->prev_rec) 
+    dbr->next_rec->prev_rec = dbr->next_rec;
+  else if (Yap_Records == dbr) {
+    Yap_Records = dbr->next_rec;
+  }
+  Yap_FreeCodeSpace(handle);
   return 1;
 }
 

C/save.c

@@ -1691,6 +1691,20 @@ UnmarkTrEntries(void)
 
 int in_limbo = FALSE;
 
+/* cleanup any records we had in the saved state. They are now inaccessible */
+static void
+FreeRecords(void) {
+  struct record_list *ptr;
+
+  ptr = Yap_Records;
+  Yap_Records = NULL;
+  while (ptr) {
+    struct record_list *optr = ptr;
+    Yap_ReleaseTermFromDB(ptr->dbrecord);
+    ptr = ptr->next_rec;
+    Yap_FreeCodeSpace((void *)optr);
+  }
+}
 
 /*
  * This function is called when wanting only to restore the heap and
@@ -1748,6 +1762,7 @@ Restore(char *s, char *lib_dir)
     Yap_InitPreAllocCodeSpace();
   }
 #endif
+  FreeRecords();
   CloseRestore();
   if (which_save == 2) {
     Yap_unify(ARG2, MkIntTerm(0));

H/YapHeap.h

@@ -95,6 +95,12 @@ typedef struct scratch_block_struct {
   UInt sz, msz;
 } scratch_block;
 
+typedef struct record_list {
+  /* a list of dbterms associated with a clause */
+  struct DB_TERM *dbrecord;
+  struct record_list *next_rec, *prev_rec;
+} DBRecordList;
+
 typedef struct restore_info {
   Int base_diff;
   Int cl_diff;

H/dhstruct.h

@@ -298,6 +298,8 @@
 #define ForeignCodeTop Yap_heap_regs->foreign_code_top
 #define ForeignCodeMax Yap_heap_regs->foreign_code_max
 
+#define Yap_Records Yap_heap_regs->yap_records
+
 #define SWI_Atoms Yap_heap_regs->swi_atoms
 #define SWI_Functors Yap_heap_regs->swi_functors
 #define SWI_ReverseHash Yap_heap_regs->swi_reverse_hash

H/hstruct.h

@@ -298,6 +298,8 @@
   ADDR  foreign_code_top;
   ADDR  foreign_code_max;
 
+  struct record_list  *yap_records;
+
   Atom  swi_atoms[N_SWI_ATOMS];
   Functor  swi_functors[N_SWI_FUNCTORS];
   struct swi_reverse_hash  swi_reverse_hash[N_SWI_HASH];

H/ihstruct.h

@@ -298,6 +298,8 @@
   Yap_heap_regs->foreign_code_top = NULL;
   Yap_heap_regs->foreign_code_max = NULL;
 
+  Yap_heap_regs->yap_records = NULL;
+
   InitSWIAtoms();
 
 

H/rheap.h

@@ -983,6 +983,21 @@ RestoreForeignCode(void)
   }
 }
 
+static void
+RestoreYapRecords(void)
+{
+  struct record_list *ptr;
+
+  Yap_Records = DBRecordAdjust(Yap_Records);
+  ptr = Yap_Records;
+  while (ptr) {
+    ptr->next_rec = DBRecordAdjust(ptr->next_rec);
+    ptr->prev_rec = DBRecordAdjust(ptr->prev_rec);
+    ptr->dbrecord = DBTermAdjust(ptr->dbrecord);
+    RestoreDBTerm(ptr->dbrecord, FALSE);
+  }
+}
+
 static void
 RestoreBallTerm(int wid)
 {

H/rhstruct.h

@@ -298,6 +298,8 @@
 
 
 
+  RestoreYapRecords();
+
   RestoreSWIAtoms();
 
 

H/sshift.h

@@ -309,6 +309,16 @@ HoldEntryAdjust (HoldEntry * ptr)
   return (HoldEntry *) (((HoldEntry *) (CharP (ptr) + HDiff)));
 }
 
+inline EXTERN struct record_list *DBRecordAdjust (struct record_list *);
+
+inline EXTERN struct record_list *
+DBRecordAdjust (struct record_list * ptr)
+{
+  if (!ptr)
+    return ptr;
+  return (struct record_list *) (CharP (ptr) + HDiff);
+}
+
 
 #if	USE_OFFSETS
 

docs/yap.tex

@@ -1,4 +1,4 @@
-<EFBFBD>a\input texinfo @c -*- mode: texinfo; coding: latin-1; -*-
+\input texinfo @c -*- mode: texinfo; coding: latin-1; -*-
 
 @c %**start of header
 @setfilename yap.info
@@ -9267,6 +9267,18 @@ Succeeds if @var{Set3} unifies with the intersection of @var{Set1} and
 need not be ordered.
 @end table
 
+@item subtract(+@var{Set}, +@var{Delete}, ?@var{Result})
+@findex subtract/3
+@syindex subtract/3
+@cnindex subtract/3
+Delete all elements from @var{Set} that   occur  in @var{Delete} (a set)
+and unify the  result  with  @var{Result}.   Deletion  is  based  on
+unification using @code{memberchk/2}. The complexity is
+@code{|Delete|*|Set|}.
+
+See @code{ord_subtract/3}.
+@end table
+
 @node LineUtilities, MapList, Lists, Library
 @section Line Manipulation Utilities
 @cindex Line Utilities Library

library/dialect/swi/fli/swi.c

@@ -2326,23 +2326,25 @@ X_API record_t
 PL_record(term_t ts)
 {
   Term t = Yap_GetFromSlot(ts);
-  return (record_t)Yap_StoreTermInDB(t, 0);
+  return (record_t)YAP_Record(t);
 }
 
 X_API int
 PL_recorded(record_t db, term_t ts)
 {
-  Term t = Yap_FetchTermFromDB((DBTerm *)db);
+  Term t = YAP_Recorded((void *)db);
-  if (t == 0L)
+  fprintf(stderr,"PL_recorded %ld\n", t);
+  if (t == ((CELL)0))
     return FALSE;
   Yap_PutInSlot(ts,t);
+  fprintf(stderr,"PL_recorded\n");
   return TRUE;
 }
 
 X_API void
 PL_erase(record_t db)
 {
-  Yap_ReleaseTermFromDB((DBTerm *)db);
+  YAP_Erase((void *)db);
 }
 
 X_API void PL_halt(int e)

library/lists.yap

@@ -8,9 +8,14 @@
 	   append/3,
 	   append/2,
 	   delete/3,
+	   intersection/3,
+	   flatten/2,
 	   last/2,
+	   list_concat/2,
+	   max_list/2,	 
 	   member/2,
 	   memberchk/2,
+	   min_list/2,
 	   nextto/3,
 	   nth/3,
 	   nth/4,
@@ -18,6 +23,7 @@
 	   nth0/4,
 	   nth1/3,
 	   nth1/4,
+	   numlist/3,
 	   permutation/2,
 	   prefix/2,
 	   remove_duplicates/2,
@@ -27,16 +33,11 @@
 	   selectchk/3,
 	   sublist/2,
 	   substitute/4,
+	   subtract/3,
+	   suffix/2,
 	   sum_list/2,
 	   sum_list/3,
-	   suffix/2,
+	   sumlist/2
-	   sumlist/2,
-	   list_concat/2,
-	   flatten/2,
-	   max_list/2,	 
-	   min_list/2,
-	   numlist/3,
-	   intersection/3
 	  ]).
 
 :- use_module(library(error),
@@ -400,3 +401,17 @@ intersection([X|T], L, Intersect) :-
 intersection([_|T], L, R) :-
 	intersection(T, L, R).
 
+%%	subtract(+Set, +Delete, -Result) is det.
+%
+%	Delete all elements from `Set' that   occur  in `Delete' (a set)
+%	and unify the  result  with  `Result'.   Deletion  is  based  on
+%	unification using memberchk/2. The complexity is |Delete|*|Set|.
+%
+%	@see ord_subtract/3.
+
+subtract([], _, []) :- !.
+subtract([E|T], D, R) :-
+	memberchk(E, D), !,
+	subtract(T, D, R).
+subtract([H|T], D, [H|R]) :-
+	subtract(T, D, R).

misc/HEAPFIELDS

@@ -339,6 +339,9 @@ ADDR		foreign_code_base	ForeignCodeBase		=NULL void
 ADDR		foreign_code_top	ForeignCodeTop		=NULL void
 ADDR		foreign_code_max	ForeignCodeMax		=NULL void
 
+/* recorded terms */
+struct record_list *yap_records		Yap_Records		=NULL		RestoreYapRecords()
+
 /* SWI atoms and functors */
 Atom		swi_atoms[N_SWI_ATOMS]	SWI_Atoms		InitSWIAtoms() RestoreSWIAtoms()
 Functor		swi_functors[N_SWI_FUNCTORS] SWI_Functors	void void

pl/boot.yap

@@ -536,7 +536,8 @@ true :- true.
  % end of YAPOR
 
 '$query'(G,[]) :-
-	 '$prompt_alternatives_on'(groundness), !,
+	 '$prompt_alternatives_on'(OPT),
+	 ( OPT = groundness ; OPT = determinism), !,
 	 '$yes_no'(G,(?-)).
 '$query'(G,V) :-
 	 (

pl/checker.yap

@@ -149,7 +149,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
 	;
 	    get_value('$syntaxcheckmultiple',on)
 	)),
-	recorded('$reconsulting',File,_),
+	nb_getval('$consulting_file',File),
 	'$xtract_head'(T,M,NM,_,F,A),
 	\+ (
 	    % allow duplicates if we are not the last predicate to have