From a997f5647c89ef666c7dc1969e7dec3e07d1847f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 12 Jun 2012 14:50:36 +0100 Subject: [PATCH] fix save & restore in 6.3. --- C/agc.c | 2 +- C/qlyr.c | 13 +++++++------ C/qlyw.c | 3 +-- H/rheap.h | 45 ++++++++++++++++++++++++++------------------- H/sshift.h | 2 +- pl/boot.yap | 17 +++++++++-------- pl/hacks.yap | 5 +++-- pl/init.yap | 2 +- pl/qly.yap | 1 - 9 files changed, 49 insertions(+), 41 deletions(-) diff --git a/C/agc.c b/C/agc.c index 990be69db..ecf7f5108 100644 --- a/C/agc.c +++ b/C/agc.c @@ -148,7 +148,7 @@ AtomAdjust(Atom a) #define DelayAddrAdjust(P) (P) #define DelayAdjust(P) (P) #define GlobalAdjust(P) (P) -#define DBRefAdjust(P) (P) +#define DBRefAdjust(P,REF) (P) #define DBRefPAdjust(P) (P) #define DBTermAdjust(P) (P) #define LUIndexAdjust(P) (P) diff --git a/C/qlyr.c b/C/qlyr.c index ef07ea5f1..2f9412460 100644 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -253,7 +253,7 @@ InsertOPCODE(OPCODE op0, int i, OPCODE op) } static DBRef -LookupDBRef(DBRef dbr) +LookupDBRef(DBRef dbr, int inc_ref) { CACHE_REGS CELL hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize; @@ -262,7 +262,9 @@ LookupDBRef(DBRef dbr) p = LOCAL_ImportDBRefHashChain[hash]; while (p) { if (p->oval == dbr) { - p->count++; + if (inc_ref) { + p->count++; + } return p->val; } p = p->next; @@ -528,11 +530,11 @@ CellPtoHeapAdjust__ (CELL * dbtp USES_REGS) #define DelayAdjust(P) (P) #define GlobalAdjust(P) (P) -#define DBRefAdjust(P) DBRefAdjust__(P PASS_REGS) +#define DBRefAdjust(P, Ref) DBRefAdjust__(P, Ref PASS_REGS) static inline DBRef -DBRefAdjust__ (DBRef dbtp USES_REGS) +DBRefAdjust__ (DBRef dbtp, int do_reference USES_REGS) { - return LookupDBRef(dbtp); + return LookupDBRef(dbtp, do_reference); } #define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS) @@ -793,7 +795,6 @@ ReadHash(IOSTREAM *stream) } RCHECK(read_tag(stream) == QLY_START_DBREFS); LOCAL_ImportDBRefHashTableNum = read_uint(stream); - fprintf(stderr,"reading %ld\n",LOCAL_ImportDBRefHashTableNum); for (i = 0; i < LOCAL_ImportDBRefHashTableNum; i++) { LogUpdClause *ocl = (LogUpdClause *)read_uint(stream); UInt sz = read_uint(stream); diff --git a/C/qlyw.c b/C/qlyw.c index 186f8624c..15d5a65e3 100644 --- a/C/qlyw.c +++ b/C/qlyw.c @@ -300,7 +300,7 @@ PtoPredAdjust(PredEntry *pe) #define DelayAdjust(P) (P) #define GlobalAdjust(P) (P) -#define DBRefAdjust(P) DBRefAdjust__(P PASS_REGS) +#define DBRefAdjust(P,DoRef) DBRefAdjust__(P PASS_REGS) static inline DBRef DBRefAdjust__ (DBRef dbt USES_REGS) { @@ -457,7 +457,6 @@ SaveHash(IOSTREAM *stream) } save_tag(stream, QLY_START_DBREFS); save_uint(stream, LOCAL_ExportDBRefHashTableNum); - fprintf(stderr,"exporting %ld\n",LOCAL_ImportDBRefHashTableNum); for (i = 0; i < LOCAL_ExportDBRefHashTableSize; i++) { export_dbref_hash_entry_t *p = LOCAL_ExportDBRefHashChain[i]; while (p) { diff --git a/H/rheap.h b/H/rheap.h index 64851cf87..290210a52 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -241,7 +241,7 @@ static char SccsId[] = "@(#)rheap.c 1.3 3/15/90"; #define ConstantTermAdjust(P) ConstantTermAdjust__(P PASS_REGS) #define DBGroundTermAdjust(P) DBGroundTermAdjust__(P PASS_REGS) -#define AdjustDBTerm(P,A,B) AdjustDBTerm__(P,A,B PASS_REGS) +#define AdjustDBTerm(P,A,B,C) AdjustDBTerm__(P,A,B,C PASS_REGS) #define AdjustSwitchTable(op, table, i) AdjustSwitchTable__(op, table, i PASS_REGS) #define RestoreOtaplInst(start, opc, pe) RestoreOtaplInst__(start, opc, pe PASS_REGS) #define RestoreDBErasedMarker() RestoreDBErasedMarker__( PASS_REGS1 ) @@ -460,7 +460,7 @@ RestoreInvisibleAtoms__( USES_REGS1 ) /* adjusts terms stored in the data base, when they have no variables */ static Term -AdjustDBTerm__(Term trm, Term *p_base, Term *p_lim USES_REGS) +AdjustDBTerm__(Term trm, Term *p_base, Term *p_lim, Term *p_max USES_REGS) { if (IsVarTerm(trm)) return CodeVarAdjust(trm); @@ -474,7 +474,7 @@ AdjustDBTerm__(Term trm, Term *p_base, Term *p_lim USES_REGS) out = AbsPair(p); loop: if (p >= p_base || p < p_lim) { - p[0] = AdjustDBTerm(p[0], p, p_lim); + p[0] = AdjustDBTerm(p[0], p, p_lim, p_max); if (IsPairTerm(p[1])) { /* avoid term recursion with very deep lists */ Term *newp = PtoHeapCellAdjust(RepPair(p[1])); @@ -483,7 +483,7 @@ AdjustDBTerm__(Term trm, Term *p_base, Term *p_lim USES_REGS) p = newp; goto loop; } else { - p[1] = AdjustDBTerm(p[1], p, p_lim); + p[1] = AdjustDBTerm(p[1], p, p_lim, p_max); } } return out; @@ -495,6 +495,11 @@ AdjustDBTerm__(Term trm, Term *p_base, Term *p_lim USES_REGS) /* if it is before the current position, then we are looking at old code */ if (p >= p_base || p < p_lim) { + if (p >= p_max || p < p_lim) { + if (DBRefOfTerm(trm)!=DBRefAdjust(DBRefOfTerm(trm),FALSE)) + /* external term pointer, has to be a DBRef */ + return MkDBRefTerm(DBRefAdjust(DBRefOfTerm(trm),FALSE)); + } f = (Functor)p[0]; if (!IsExtensionFunctor(f)) { UInt Arity, i; @@ -503,9 +508,10 @@ AdjustDBTerm__(Term trm, Term *p_base, Term *p_lim USES_REGS) *p++ = (Term)f; Arity = ArityOfFunctor(f); for (i = 0; i < Arity; ++i) { - *p = AdjustDBTerm(*p, p0, p_lim); + *p = AdjustDBTerm(*p, p0, p_lim, p_max); p++; } + } else if (f == FunctorDBRef) { } } return AbsAppl(p0); @@ -519,22 +525,23 @@ RestoreDBTerm(DBTerm *dbr, int attachments USES_REGS) if (attachments) { #ifdef COROUTINING if (dbr->ag.attachments) - dbr->ag.attachments = AdjustDBTerm(dbr->ag.attachments, dbr->Contents, dbr->Contents); + dbr->ag.attachments = AdjustDBTerm(dbr->ag.attachments, dbr->Contents, dbr->Contents, dbr->Contents+dbr->NOfCells); #endif } else { if (dbr->ag.NextDBT) dbr->ag.NextDBT = DBTermAdjust(dbr->ag.NextDBT); } - if (dbr->DBRefs != NULL) { + if (dbr->DBRefs) { DBRef *cp; DBRef tm; dbr->DBRefs = DBRefPAdjust(dbr->DBRefs); cp = dbr->DBRefs; - while ((tm = *--cp) != 0) - *cp = DBRefAdjust(tm); + while ((tm = *--cp) != 0) { + *cp = DBRefAdjust(tm,TRUE); + } } - dbr->Entry = AdjustDBTerm(dbr->Entry, dbr->Contents, dbr->Contents); + dbr->Entry = AdjustDBTerm(dbr->Entry, dbr->Contents, dbr->Contents, dbr->Contents+dbr->NOfCells); } /* Restoring the heap */ @@ -863,7 +870,7 @@ static void RestoreDBErasedMarker__( USES_REGS1 ) { Yap_heap_regs->db_erased_marker = - DBRefAdjust(Yap_heap_regs->db_erased_marker); + DBRefAdjust(Yap_heap_regs->db_erased_marker,TRUE); Yap_heap_regs->db_erased_marker->id = FunctorDBRef; Yap_heap_regs->db_erased_marker->Flags = ErasedMask; Yap_heap_regs->db_erased_marker->Code = NULL; @@ -1069,9 +1076,9 @@ RestoreDBEntry(DBRef dbr USES_REGS) if (dbr->Code != NULL) dbr->Code = PtoOpAdjust(dbr->Code); if (dbr->Prev != NULL) - dbr->Prev = DBRefAdjust(dbr->Prev); + dbr->Prev = DBRefAdjust(dbr->Prev,TRUE); if (dbr->Next != NULL) - dbr->Next = DBRefAdjust(dbr->Next); + dbr->Next = DBRefAdjust(dbr->Next,TRUE); #ifdef DEBUG_RESTORE2 fprintf(stderr, "Recomputing masks\n"); #endif @@ -1085,26 +1092,26 @@ RestoreDB(DBEntry *pp USES_REGS) register DBRef dbr; if (pp->First != NULL) - pp->First = DBRefAdjust(pp->First); + pp->First = DBRefAdjust(pp->First,TRUE); if (pp->Last != NULL) - pp->Last = DBRefAdjust(pp->Last); + pp->Last = DBRefAdjust(pp->Last, TRUE); if (pp->ArityOfDB) pp->FunctorOfDB = FuncAdjust(pp->FunctorOfDB); else pp->FunctorOfDB = (Functor) AtomAdjust((Atom)(pp->FunctorOfDB)); if (pp->F0 != NULL) - pp->F0 = DBRefAdjust(pp->F0); + pp->F0 = DBRefAdjust(pp->F0, TRUE); if (pp->L0 != NULL) - pp->L0 = DBRefAdjust(pp->L0); + pp->L0 = DBRefAdjust(pp->L0, TRUE); /* immediate update semantics */ dbr = pp->F0; /* While we have something in the data base, even if erased, restore it */ while (dbr) { RestoreDBEntry(dbr PASS_REGS); if (dbr->n != NULL) - dbr->n = DBRefAdjust(dbr->n); + dbr->n = DBRefAdjust(dbr->n, TRUE); if (dbr->p != NULL) - dbr->p = DBRefAdjust(dbr->p); + dbr->p = DBRefAdjust(dbr->p, TRUE); dbr = dbr->n; } } diff --git a/H/sshift.h b/H/sshift.h index d7759df5b..8cc18eccc 100644 --- a/H/sshift.h +++ b/H/sshift.h @@ -72,7 +72,7 @@ #define DelayAddrAdjust(P) DelayAddrAdjust__(P PASS_REGS) #define DelayAdjust(P) DelayAdjust__(P PASS_REGS) #define GlobalAdjust(P) GlobalAdjust__(P PASS_REGS) -#define DBRefAdjust(P) DBRefAdjust__(P PASS_REGS) +#define DBRefAdjust(P,C) DBRefAdjust__(P PASS_REGS) #define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS) #define DBTermAdjust(P) DBTermAdjust__(P PASS_REGS) #define LUIndexAdjust(P) LUIndexAdjust__(P PASS_REGS) diff --git a/pl/boot.yap b/pl/boot.yap index e7a120c34..73c47d069 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -52,14 +52,15 @@ true :- true. ; set_value('$verbose',off) ), - ( - retractall(user:library_directory(_)), - '$system_library_directories'(D), - assertz(user:library_directory(D)), - fail - ; - true - ), +% '$init_preds', % needs to be done before library_directory +% ( +% retractall(user:library_directory(_)), +% '$system_library_directories'(D), +% assertz(user:library_directory(D)), +% fail +% ; +% true +% ), '$enter_system_mode', '$init_globals', '$swi_set_prolog_flag'(fileerrors, true), diff --git a/pl/hacks.yap b/pl/hacks.yap index 07ede36f9..c185ce79c 100644 --- a/pl/hacks.yap +++ b/pl/hacks.yap @@ -223,8 +223,9 @@ beautify_hidden_goal('$call'(G,CP,G0,M),prolog) --> [call(M:G0)]. beautify_hidden_goal('$current_predicate'(M,Na,Ar),prolog) --> [current_predicate(M,Na/Ar)]. -beautify_hidden_goal('$current_predicate_for_atom'(M,Na,Ar),prolog) --> - [current_predicate(M,Na/Ar)]. +beautify_hidden_goal('$current_predicate_for_atom'(Name,M,Ar),prolog) --> + { functor(P, Name, Ar) }, + [current_predicate(Name,M:P)]. beautify_hidden_goal('$list_clauses'(Stream,M,Pred),prolog) --> [listing(M:Pred)]. diff --git a/pl/init.yap b/pl/init.yap index ddb177a27..b3f2b8c05 100755 --- a/pl/init.yap +++ b/pl/init.yap @@ -121,7 +121,7 @@ otherwise. :- ['protect.yap']. -version(yap,[6,0]). +version(yap,[6,3]). system_mode(verbose,on) :- set_value('$verbose',on). system_mode(verbose,off) :- set_value('$verbose',off). diff --git a/pl/qly.yap b/pl/qly.yap index c450a7876..cb3b4cf9e 100755 --- a/pl/qly.yap +++ b/pl/qly.yap @@ -29,7 +29,6 @@ save_program(File, Goal) :- recorda('$restore_goal', Goal ,_R), fail. save_program(File, _Goal) :- -writeln(here), qsave_program(File). '$save_program_status' :-