From b37ee94fe9ff72128a55ce6860d027b852c9289c Mon Sep 17 00:00:00 2001 From: vsc Date: Wed, 12 Feb 2003 13:20:52 +0000 Subject: [PATCH] you may have code and dbrefs at the same time. try to expand trail in single sweep git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@769 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/dbase.c | 40 ++++++++++++++++++++-------------------- C/heapgc.c | 32 ++++++++++++++++++++++++-------- C/init.c | 3 ++- C/sysbits.c | 6 +++++- H/rheap.h | 21 +++++++++------------ m4/Yatom.h.m4 | 6 ++---- pl/directives.yap | 3 ++- pl/init.yap | 12 ++++++------ 8 files changed, 70 insertions(+), 53 deletions(-) diff --git a/C/dbase.c b/C/dbase.c index 72b94abbc..34921f301 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -1062,11 +1062,11 @@ sf_include(sfp) inline static DBRef check_if_cons(DBRef p, Term to_compare) { - while (p != NIL + while (p != NIL && (p->Flags & (DBCode | ErasedMask | DBVar | DBNoVars | DBComplex) || p->Entry != Unsigned(to_compare))) - p = NextDBRef(p); - return (p); + p = NextDBRef(p); + return (p); } /* @@ -1218,7 +1218,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag) pp->id = FunctorDBRef; pp->Flags = DBVar; pp->Entry = (CELL) Tm; - pp->u.Code = NULL; + pp->Code = NULL; pp->NOfCells = 1; INIT_LOCK(pp->lock); INIT_DBREF_COUNT(pp); @@ -1243,7 +1243,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag) pp->id = FunctorDBRef; pp->Flags = flag; pp->Entry = (CELL) Tm; - pp->u.Code = NULL; + pp->Code = NULL; pp->NOfCells = 1; INIT_LOCK(pp->lock); INIT_DBREF_COUNT(pp); @@ -1328,7 +1328,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag) dbr->NOfRefsTo++; pp->Contents[0] = (CELL)NIL; pp->Contents[1] = (CELL)dbr; - pp->u.DBRefs = (DBRef *)(pp->Contents+2); + pp->DBRefs = (DBRef *)(pp->Contents+2); INIT_LOCK(pp->lock); INIT_DBREF_COUNT(pp); Yap_ReleasePreAllocCodeSpace((ADDR)pp0); @@ -1512,9 +1512,9 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag) *rfnar++ = NULL; while (ptr != tofref) *rfnar++ = *--ptr; - pp->u.DBRefs = rfnar; + pp->DBRefs = rfnar; } else { - pp->u.DBRefs = NULL; + pp->DBRefs = NULL; } Yap_ReleasePreAllocCodeSpace((ADDR)pp0); return (pp); @@ -1528,7 +1528,7 @@ new_lu_index(LogUpdDBProp AtProp) { DBRef ref = AtProp->First; DBRef *te; - if (index == NIL) { + if (index == NULL) { DBErrorFlag = OTHER_ERROR_IN_DB; DBErrorNumber = SYSTEM_ERROR; DBErrorTerm = TermNil; @@ -1632,7 +1632,7 @@ record(int Flag, Term key, Term t_data, Term t_code) p->Last = x; } if (Flag & WithRef) { - x->u.Code = (yamop *) IntegerOfTerm(t_code); + x->Code = (yamop *) IntegerOfTerm(t_code); } WRITE_UNLOCK(p->DBRWLock); return (x); @@ -1721,7 +1721,7 @@ record_at(int Flag, DBRef r0, Term t_data, Term t_code) r0->Next = x; } if (Flag & WithRef) { - x->u.Code = (yamop *) IntegerOfTerm(t_code); + x->Code = (yamop *) IntegerOfTerm(t_code); } WRITE_UNLOCK(p->DBRWLock); return (x); @@ -3472,7 +3472,7 @@ ErasePendingRefs(DBRef entryref) if (!(entryref->Flags & DBWithRefs)) return; - cp = CellPtr(entryref->u.DBRefs); + cp = CellPtr(entryref->DBRefs); while ((ref = (DBRef)(*--cp)) != NULL) { if ((ref->Flags & DBClMask) && (--(ref->NOfRefsTo) == 0) && (ref->Flags & ErasedMask)) @@ -3581,7 +3581,7 @@ find_next_clause(DBRef ref0) /* OK, we found a clause we can jump to, do a bit of hanky pancking with the choice-point, so that it believes we are actually working from that clause */ - newp = ref->u.Code; + newp = ref->Code; /* and next let's tell the world this clause is being used, just like if we were executing a standard retry_and_mark */ #if defined(YAPOR) || defined(THREADS) @@ -3703,7 +3703,7 @@ PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr) WRITE_LOCK(p->PRWLock); if (p->cs.p_code.FirstClause != cl) { /* we are not the first clause... */ - yamop *prev_code_p = (yamop *)(dbr->Prev->u.Code); + yamop *prev_code_p = (yamop *)(dbr->Prev->Code); prev_code_p->u.ld.d = code_p->u.ld.d; /* are we the last? */ if (p->cs.p_code.LastClause == cl) @@ -3718,7 +3718,7 @@ PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr) Yap_opcode(TRYCODE(_try_me, _try_me0, p->ArityOfPE)); } } - dbr->u.Code = NULL; /* unlink the two now */ + dbr->Code = NULL; /* unlink the two now */ if (p->PredFlags & IndexedPredFlag) { Yap_RemoveIndexation(p); } else { @@ -3845,8 +3845,8 @@ static void ErDBE(DBRef entryref) { - if ((entryref->Flags & DBCode) && entryref->u.Code) { - Clause *clau = ClauseCodeToClause(entryref->u.Code); + if ((entryref->Flags & DBCode) && entryref->Code) { + Clause *clau = ClauseCodeToClause(entryref->Code); LOCK(clau->ClLock); if (CL_IN_USE(clau) || entryref->NOfRefsTo != 0) { PrepareToEraseClause(clau, entryref); @@ -3908,8 +3908,8 @@ EraseEntry(DBRef entryref) entryref->Next = NIL; if (!DBREF_IN_USE(entryref)) { ErDBE(entryref); - } else if ((entryref->Flags & DBCode) && entryref->u.Code) { - PrepareToEraseClause(ClauseCodeToClause(entryref->u.Code), entryref); + } else if ((entryref->Flags & DBCode) && entryref->Code) { + PrepareToEraseClause(ClauseCodeToClause(entryref->Code), entryref); } } @@ -4357,7 +4357,7 @@ keepdbrefs(DBRef entryref) if (!(entryref->Flags & DBWithRefs)) return; - cp = entryref->u.DBRefs; + cp = entryref->DBRefs; while ((ref = *--cp) != NIL) { LOCK(ref->lock); if(!(ref->Flags & InUseMask)) { diff --git a/C/heapgc.c b/C/heapgc.c index 59a02c67e..574b631ab 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -1135,15 +1135,23 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap) int tsize = size - EnvSizeInCells; currv = sizeof(CELL)*8-tsize%(sizeof(CELL)*8); - pvbmap += tsize/(sizeof(CELL)*8); - bmap = *pvbmap; + if (pvbmap != NULL) { + pvbmap += tsize/(sizeof(CELL)*8); + bmap = *pvbmap; + } else { + bmap = -1L; + } bmap = (Int)(((CELL)bmap) << currv); } for (saved_var = gc_ENV - size; saved_var < gc_ENV - EnvSizeInCells; saved_var++) { if (currv == sizeof(CELL)*8) { - pvbmap--; - bmap = *pvbmap; + if (pvbmap) { + pvbmap--; + bmap = *pvbmap; + } else { + bmap = -1L; + } currv = 0; } /* we may have already been here */ @@ -2087,15 +2095,23 @@ sweep_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap) currv = sizeof(CELL)*8-tsize%(sizeof(CELL)*8); - pvbmap += tsize/(sizeof(CELL)*8); - bmap = *pvbmap; + if (pvbmap != NULL) { + pvbmap += tsize/(sizeof(CELL)*8); + bmap = *pvbmap; + } else { + bmap = -1L; + } bmap = (Int)(((CELL)bmap) << currv); } for (saved_var = gc_ENV - size; saved_var < gc_ENV - EnvSizeInCells; saved_var++) { if (currv == sizeof(CELL)*8) { - pvbmap--; - bmap = *pvbmap; + if (pvbmap != NULL) { + pvbmap--; + bmap = *pvbmap; + } else { + bmap = -1L; + } currv = 0; } if (bmap < 0) { diff --git a/C/init.c b/C/init.c index dac312819..d09f770fa 100644 --- a/C/init.c +++ b/C/init.c @@ -984,7 +984,8 @@ InitCodes(void) (DBRef)Yap_AllocCodeSpace(sizeof(DBStruct)); heap_regs->db_erased_marker->id = FunctorDBRef; heap_regs->db_erased_marker->Flags = ErasedMask; - heap_regs->db_erased_marker->u.Code = NULL; + heap_regs->db_erased_marker->Code = NULL; + heap_regs->db_erased_marker->DBRefs = NULL; heap_regs->db_erased_marker->Parent = NULL; INIT_LOCK(heap_regs->db_erased_marker->lock); INIT_DBREF_COUNT(heap_regs->db_erased_marker); diff --git a/C/sysbits.c b/C/sysbits.c index 5ad5b8f54..de7f733ae 100644 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -1017,7 +1017,11 @@ SearchForTrailFault(void) #if OS_HANDLES_TR_OVERFLOW if ((TR > (tr_fr_ptr)Yap_TrailTop-1024 && TR < (tr_fr_ptr)Yap_TrailTop+(64*1024))|| Yap_DBTrailOverflow()) { - if (!Yap_growtrail(64 * 1024L)) { + long trsize = 64*2014L; + while (trsize < ((CELL)TR-(CELL)Yap_TrailTop)) { + trsize += 64*2014L; + } + if (!Yap_growtrail(trsize)) { Yap_Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve %ld bytes in growtrail", 64*1024L); } /* just in case, make sure the OS keeps the signal handler. */ diff --git a/H/rheap.h b/H/rheap.h index 1fb0f165f..7178f475a 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -470,19 +470,16 @@ RestoreDBEntry(DBRef dbr) YP_fprintf(errout, " a var\n"); #endif dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent)); - if (dbr->Flags & DBCode) { - if (dbr->u.Code != NULL) - dbr->u.Code = PtoOpAdjust(dbr->u.Code); - } else { - if (dbr->Flags & DBWithRefs) { - DBRef *cp; - DBRef tm; + if (dbr->Code != NULL) + dbr->Code = PtoOpAdjust(dbr->Code); + if (dbr->Flags & DBWithRefs) { + DBRef *cp; + DBRef tm; - dbr->u.DBRefs = DBRefPAdjust(dbr->u.DBRefs); - cp = dbr->u.DBRefs; - while ((tm = *--cp) != 0) - *cp = DBRefAdjust(tm); - } + dbr->DBRefs = DBRefPAdjust(dbr->DBRefs); + cp = dbr->DBRefs; + while ((tm = *--cp) != 0) + *cp = DBRefAdjust(tm); } if (dbr->Flags & DBAtomic) { if (IsAtomTerm(dbr->Entry)) diff --git a/m4/Yatom.h.m4 b/m4/Yatom.h.m4 index 8b391b573..04875be8d 100644 --- a/m4/Yatom.h.m4 +++ b/m4/Yatom.h.m4 @@ -268,10 +268,8 @@ typedef struct DB_STRUCT { CELL Flags; /* Term Flags */ CELL NOfRefsTo; /* Number of references pointing here */ struct struct_dbentry *Parent; /* key of DBase reference */ - union { - struct yami *Code; /* pointer to code if this is a clause */ - struct DB_STRUCT **DBRefs; /* pointer to other references */ - } u; + struct yami *Code; /* pointer to code if this is a clause */ + struct DB_STRUCT **DBRefs; /* pointer to other references */ struct DB_STRUCT *Prev; /* Previous element in chain */ struct DB_STRUCT *Next; /* Next element in chain */ #if defined(YAPOR) || defined(THREADS) diff --git a/pl/directives.yap b/pl/directives.yap index 865dfaea1..bff97796c 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -131,6 +131,7 @@ yap_flag(gc,V) :- ( '$get_value'('$gc',[]) -> V = off ; V = on). yap_flag(gc,on) :- !, '$set_value'('$gc',true). yap_flag(gc,off) :- !, '$set_value'('$gc',[]). + yap_flag(gc_margin,N) :- var(N) -> '$get_value'('$gc_margin',N) @@ -616,7 +617,7 @@ yap_flag(host_type,X) :- '$transl_to_character_escape_modes'(0,off) :- !. '$transl_to_character_escape_modes'(0,cprolog). -'$transl_to_character_escape_modes'(1,on) :- !. +'$transl_to_character_escape_modes'(2,on) :- !. '$transl_to_character_escape_modes'(1,iso). '$transl_to_character_escape_modes'(2,sicstus). diff --git a/pl/init.yap b/pl/init.yap index 37df55db8..d85548adc 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -27,12 +27,12 @@ false :- fail. (:- G) :- '$execute'(G), !. '$$!'(CP) :- '$cut_by'(CP). [] :- true. -','(A,B) :- '$meta_call'((A,B),prolog). -';'(A,B) :- '$meta_call'((A;B),prolog). -'|'(A,B) :- '$meta_call'((A;B),prolog). -'->'(A,B) :- '$meta_call'((A->B),prolog). -\+(G) :- '$meta_call'(\+(G),prolog). -not(G) :- '$meta_call'(not(G),prolog). +','(A,B) :- '$current_module'(Module), '$meta_call'((A,B),Module). +';'(A,B) :- '$current_module'(Module), '$meta_call'((A;B),Module). +'|'(A,B) :- '$current_module'(Module), '$meta_call'((A;B),Module). +'->'(A,B) :- '$current_module'(Module), '$meta_call'((A->B),Module). +\+(G) :- '$current_module'(Module), '$meta_call'(\+(G),Module). +not(G) :- '$current_module'(Module), '$meta_call'(not(G),Module). :- '$set_value'('$doindex',true).