From 0cef3c538949a055ca56756097937167a120d462 Mon Sep 17 00:00:00 2001 From: vsc Date: Mon, 8 Jan 2007 08:27:19 +0000 Subject: [PATCH] fix restore (Trevor) make indexing a bit faster on IDB git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1771 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/agc.c | 1 + C/c_interface.c | 7 +++-- C/index.c | 64 ++++++++++++++++++++++++++++++++--------- C/tracer.c | 1 + H/rheap.h | 40 ++++++++++++++++++++++++-- H/sshift.h | 9 +++++- library/matrix/matrix.c | 9 ++++-- 7 files changed, 109 insertions(+), 22 deletions(-) diff --git a/C/agc.c b/C/agc.c index b5c204d11..6165741e1 100644 --- a/C/agc.c +++ b/C/agc.c @@ -116,6 +116,7 @@ AtomAdjust(Atom a) #define AddrAdjust(P) (P) #define AtomEntryAdjust(P) (P) +#define GlobalEntryAdjust(P) (P) #define BlobTermAdjust(P) (P) #define CellPtoHeapAdjust(P) (P) #define CellPtoHeapCellAdjust(P) (P) diff --git a/C/c_interface.c b/C/c_interface.c index 3528bf03d..eaaa3d379 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -10,8 +10,11 @@ * File: c_interface.c * * comments: c_interface primitives definition * * * -* Last rev: $Date: 2006-12-13 16:10:14 $,$Author: vsc $ * +* Last rev: $Date: 2007-01-08 08:27:19 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.87 2006/12/13 16:10:14 vsc +* several debugger and CLP(BN) improvements. +* * Revision 1.86 2006/11/27 17:42:02 vsc * support for UNICODE, and other bug fixes. * @@ -757,7 +760,7 @@ YAP_Unify(Term t1, Term t2) out = Yap_unify(t1, t2); RECOVER_MACHINE_REGS(); - return(out); + return out; } X_API long diff --git a/C/index.c b/C/index.c index 9cbbacb4e..3319d5554 100644 --- a/C/index.c +++ b/C/index.c @@ -11,8 +11,11 @@ * File: index.c * * comments: Indexing a Prolog predicate * * * -* Last rev: $Date: 2006-12-27 01:32:37 $,$Author: vsc $ * +* Last rev: $Date: 2007-01-08 08:27:19 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.180 2006/12/27 01:32:37 vsc +* diverse fixes +* * Revision 1.179 2006/11/27 17:42:02 vsc * support for UNICODE, and other bug fixes. * @@ -2804,15 +2807,17 @@ add_head_info(ClauseDef *clause, UInt regno) break; case _unify_idb_term: case _copy_idb_term: - if (regno == 2) { + if (regno != 2) { + clause->Tag = (CELL)NULL; + } else { LogUpdClause *lcl = ClauseCodeToLogUpdClause(cl); Term t = lcl->ClSource->Entry; - + if (IsVarTerm(t)) { clause->Tag = (CELL)NULL; } else if (IsApplTerm(t)) { CELL *pt = RepAppl(t); - + clause->Tag = AbsAppl((CELL *)pt[0]); if (IsExtensionFunctor(FunctorOfTerm(t))) { clause->u.t_ptr = t; @@ -2827,8 +2832,6 @@ add_head_info(ClauseDef *clause, UInt regno) } else { clause->Tag = t; } - } else { - clause->Tag = (CELL)NULL; } return; default: @@ -4271,14 +4274,49 @@ cls_info(ClauseDef *min, ClauseDef *max, UInt argno) } static int -cls_head_info(ClauseDef *min, ClauseDef *max, UInt argno) +cls_head_info(ClauseDef *min, ClauseDef *max, UInt argno, int in_idb) { ClauseDef *cl=min; - while (cl <= max) { - add_head_info(cl, argno); - /* if (IsVarTerm(cl->Tag)) cl->Tag = (CELL)NULL; */ - cl++; + if (in_idb) { + if (argno != 2) { + while (cl <= max) { + cl->Tag = (CELL)NULL; + cl++; + } + } else { + while (cl <= max) { + LogUpdClause *lcl = ClauseCodeToLogUpdClause(cl->CurrentCode); + Term t = lcl->ClSource->Entry; + + if (IsVarTerm(t)) { + cl->Tag = (CELL)NULL; + } else if (IsApplTerm(t)) { + CELL *pt = RepAppl(t); + + cl->Tag = AbsAppl((CELL *)pt[0]); + if (IsExtensionFunctor(FunctorOfTerm(t))) { + cl->u.t_ptr = t; + } else { + cl->u.c_sreg = pt; + } + } else if (IsPairTerm(t)) { + CELL *pt = RepPair(t); + + cl->Tag = AbsPair(NULL); + cl->u.c_sreg = pt-1; + } else { + cl->Tag = t; + } + cl++; + } + } + } else { + while (cl <= max) { + add_head_info(cl, argno); + /* if (IsVarTerm(cl->Tag)) cl->Tag = (CELL)NULL; */ + cl++; + } } return FALSE; } @@ -4307,7 +4345,7 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno, } t = Deref(XREGS[argno]); if (ap->PredFlags & LogUpdatePredFlag) { - found_pvar = cls_head_info(min, max, argno); + found_pvar = cls_head_info(min, max, argno, (ap->ModuleOfPred == IDB_MODULE)); } else { found_pvar = cls_info(min, max, argno); } @@ -4332,7 +4370,7 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno, argno++; t = Deref(XREGS[argno]); if (ap->PredFlags & LogUpdatePredFlag) { - found_pvar = cls_head_info(min, max, argno); + found_pvar = cls_head_info(min, max, argno, (ap->ModuleOfPred == IDB_MODULE) ); } else { found_pvar = cls_info(min, max, argno); } diff --git a/C/tracer.c b/C/tracer.c index afd264619..e077ccbc3 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -160,6 +160,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) LOCK(Yap_heap_regs->low_level_trace_lock); sc = Yap_heap_regs; + vsc_count++; #ifdef COMMENTED if (vsc_count > 1388060LL && vsc_count < 1388070LL) { if (vsc_count==1388061LL) diff --git a/H/rheap.h b/H/rheap.h index 9d0fce169..245cf0759 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -11,8 +11,11 @@ * File: rheap.h * * comments: walk through heap code * * * -* Last rev: $Date: 2006-11-27 17:42:03 $,$Author: vsc $ * +* Last rev: $Date: 2007-01-08 08:27:19 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.71 2006/11/27 17:42:03 vsc +* support for UNICODE, and other bug fixes. +* * Revision 1.70 2006/08/25 19:50:35 vsc * global data structures * @@ -1206,8 +1209,7 @@ RestoreEntries(PropEntry *pp) { DBEntry *de = (DBEntry *) pp; de->NextOfPE = - PropAdjust(de->NextOfPE); - if (HDiff) + PropAdjust(de->NextOfPE); if (HDiff) RestoreDB(de); } break; @@ -1220,6 +1222,38 @@ RestoreEntries(PropEntry *pp) RestoreBB(bb); } break; + case GlobalProperty: + { + GlobalEntry *gb = (GlobalEntry *) pp; + Term gbt = gb->global; + + gb->NextOfPE = + PropAdjust(gb->NextOfPE); + gb->AtomOfGE = + AtomEntryAdjust(gb->AtomOfGE); + gb->NextGE = + GlobalEntryAdjust(gb->NextGE); + if (IsVarTerm(gbt)) { + CELL *gbp = VarOfTerm(gbt); + if (IsOldGlobalPtr(gbp)) + gbp = PtoGloAdjust(gbp); + else + gbp = CellPtoHeapAdjust(gbp); + gb->global = (CELL)gbp; + } else if (IsPairTerm(gbt)) { + gb->global = AbsPair(PtoGloAdjust(RepPair(gbt))); + } else if (IsApplTerm(gbt)) { + CELL *gbp = RepAppl(gbt); + if (IsOldGlobalPtr(gbp)) + gbp = PtoGloAdjust(gbp); + else + gbp = CellPtoHeapAdjust(gbp); + gb->global = AbsAppl(gbp); + } else if (IsAtomTerm(gbt)) { + gb->global = AtomTermAdjust(gbt); + } /* numbers need no adjusting */ + } + break; case OpProperty: { OpEntry *opp = (OpEntry *)pp; diff --git a/H/sshift.h b/H/sshift.h index d0b9bd27f..ca58ccec7 100644 --- a/H/sshift.h +++ b/H/sshift.h @@ -340,6 +340,14 @@ AtomEntryAdjust (AtomEntry * at) return (AtomEntry *) ((AtomEntry *) (CharP (at) + HDiff)); } +inline EXTERN GlobalEntry *GlobalEntryAdjust (GlobalEntry *); + +inline EXTERN GlobalEntry * +GlobalEntryAdjust (GlobalEntry * at) +{ + return (GlobalEntry *) ((GlobalEntry *) (CharP (at) + HDiff)); +} + inline EXTERN union CONSULT_OBJ *ConsultObjAdjust (union CONSULT_OBJ *); @@ -730,6 +738,5 @@ IsGlobal (CELL reg) } - void STD_PROTO (Yap_AdjustStacksAndTrail, (void)); void STD_PROTO (Yap_AdjustRegs, (int)); diff --git a/library/matrix/matrix.c b/library/matrix/matrix.c index 629ced75a..fe71699a1 100644 --- a/library/matrix/matrix.c +++ b/library/matrix/matrix.c @@ -535,7 +535,8 @@ matrix_dec2(int *mat, int *indx) static int matrix_set(void) { - int dims[MAX_DIMS], *mat, tf; + int dims[MAX_DIMS], *mat; + YAP_Term tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { @@ -606,7 +607,8 @@ matrix_set_all(void) static int matrix_add(void) { - int dims[MAX_DIMS], *mat, tf; + int dims[MAX_DIMS], *mat; + YAP_Term tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { @@ -643,7 +645,8 @@ matrix_add(void) static int do_matrix_access(void) { - int dims[MAX_DIMS], *mat, tf; + int dims[MAX_DIMS], *mat; + YAP_Term tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) {