Merge branch 'master' of ../yap-6.2
This commit is contained in:
commit
51334c66af
26
C/absmi.c
26
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;
|
||||
}
|
||||
|
3
C/agc.c
3
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)
|
||||
{
|
||||
|
@ -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;
|
||||
}
|
||||
|
||||
|
15
C/save.c
15
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));
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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];
|
||||
|
@ -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();
|
||||
|
||||
|
||||
|
15
H/rheap.h
15
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)
|
||||
{
|
||||
|
@ -298,6 +298,8 @@
|
||||
|
||||
|
||||
|
||||
RestoreYapRecords();
|
||||
|
||||
RestoreSWIAtoms();
|
||||
|
||||
|
||||
|
10
H/sshift.h
10
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
|
||||
|
||||
|
14
docs/yap.tex
14
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
|
||||
|
@ -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)
|
||||
|
@ -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).
|
||||
|
@ -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
|
||||
|
@ -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) :-
|
||||
(
|
||||
|
@ -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
|
||||
|
Reference in New Issue
Block a user