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

This commit is contained in:
Vitor Santos Costa 2011-01-06 11:21:55 -06:00
commit 51334c66af
17 changed files with 185 additions and 29 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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) :-
(

View File

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