diff --git a/C/absmi.c b/C/absmi.c index 64d3ff892..dff8cb0e5 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -2215,9 +2215,11 @@ Yap_absmi(int inp) /* cut */ Op(cut, e); #ifdef COROUTINING - CACHE_Y_AS_ENV(YREG); - check_stack(NoStackCut, H); - ENDCACHE_Y_AS_ENV(); + 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 - CACHE_Y_AS_ENV(YREG); - check_stack(NoStackCutT, H); - ENDCACHE_Y_AS_ENV(); + 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 - CACHE_Y_AS_ENV(YREG); - check_stack(NoStackCutE, H); - ENDCACHE_Y_AS_ENV(); + 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; } diff --git a/C/agc.c b/C/agc.c index d81b692ac..7f37a92db 100755 --- a/C/agc.c +++ b/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) { diff --git a/C/c_interface.c b/C/c_interface.c index 8c5bdd1c7..90946129c 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -3152,20 +3152,80 @@ YAP_FileDescriptorFromStream(Term t) X_API void * YAP_Record(Term t) { - - return (void *)Yap_StoreTermInDB(Deref(t), 0); + DBTerm *dbterm; + DBRecordList *dbt; + + 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; } diff --git a/C/save.c b/C/save.c index dcb3b7600..f09151dc9 100755 --- a/C/save.c +++ b/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)); diff --git a/H/YapHeap.h b/H/YapHeap.h index ead1a77b8..f18faf678 100755 --- a/H/YapHeap.h +++ b/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; diff --git a/H/dhstruct.h b/H/dhstruct.h index 50ab83967..4e8f34a96 100644 --- a/H/dhstruct.h +++ b/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 diff --git a/H/hstruct.h b/H/hstruct.h index d73f8fc17..21e8c2765 100644 --- a/H/hstruct.h +++ b/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]; diff --git a/H/ihstruct.h b/H/ihstruct.h index 43806c2e3..3589fa71e 100644 --- a/H/ihstruct.h +++ b/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(); diff --git a/H/rheap.h b/H/rheap.h index 4011ae629..e69a712c0 100755 --- a/H/rheap.h +++ b/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) { diff --git a/H/rhstruct.h b/H/rhstruct.h index 975b12127..383728d95 100644 --- a/H/rhstruct.h +++ b/H/rhstruct.h @@ -298,6 +298,8 @@ + RestoreYapRecords(); + RestoreSWIAtoms(); diff --git a/H/sshift.h b/H/sshift.h index 96d6fdf07..6ac683f0a 100755 --- a/H/sshift.h +++ b/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 diff --git a/docs/yap.tex b/docs/yap.tex index 7de3b0c48..a7dffd36e 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -1,4 +1,4 @@ -�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 diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 0a0d7f262..3f2064986 100755 --- a/library/dialect/swi/fli/swi.c +++ b/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); - if (t == 0L) + Term t = YAP_Recorded((void *)db); + 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) diff --git a/library/lists.yap b/library/lists.yap index fa84c4e53..c907b9144 100644 --- a/library/lists.yap +++ b/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, - list_concat/2, - flatten/2, - max_list/2, - min_list/2, - numlist/3, - intersection/3 + sumlist/2 ]). :- 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). diff --git a/misc/HEAPFIELDS b/misc/HEAPFIELDS index 621460228..a5ddebc25 100644 --- a/misc/HEAPFIELDS +++ b/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 diff --git a/pl/boot.yap b/pl/boot.yap index 01da760c4..11080bdc7 100755 --- a/pl/boot.yap +++ b/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) :- ( diff --git a/pl/checker.yap b/pl/checker.yap index 6e52d9a53..87d8995a8 100644 --- a/pl/checker.yap +++ b/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