diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix pruning bug

Browse Source 
make DL_MALLOC less enthusiastic about walking through buckets.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1253 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-03-01 22:25:09 +00:00
parent fce2c52d17
commit 14f9382666
12 changed files with 94 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
C/absmi.c
View File

@ -10,8 +10,11 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2005-02-08 18:04:17 $,$Author: vsc $ *
* Last rev: $Date: 2005-03-01 22:25:07 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.157 2005/02/08 18:04:17 vsc
* library_directory may not be deterministic (usually it isn't).
*
* Revision 1.156 2005/01/13 05:47:25 vsc
* lgamma broke arithmetic optimisation
* integer_y has type y
@ -2003,7 +2006,7 @@ Yap_absmi(int inp)
#ifdef YAPOR
CUT_prune_to((choiceptr) d0);
#else
while (B->cp_b != (choiceptr)d0) {
while (B->cp_b < (choiceptr)d0) {
B = B->cp_b;
}
trim_trail:
@ -2083,7 +2086,7 @@ Yap_absmi(int inp)
#ifdef YAPOR
CUT_prune_to((choiceptr) d0);
#else
while (B->cp_b != (choiceptr)d0) {
while (B->cp_b < (choiceptr)d0) {
B = B->cp_b;
}
#endif /* YAPOR */
@ -2124,7 +2127,7 @@ Yap_absmi(int inp)
#ifdef YAPOR
CUT_prune_to((choiceptr) d0);
#else
while (B->cp_b != (choiceptr)d0) {
while (B->cp_b < (choiceptr)d0) {
B = B->cp_b;
}
#endif /* YAPOR */
@ -2182,7 +2185,7 @@ Yap_absmi(int inp)
#ifdef YAPOR
CUT_prune_to(pt0);
#else
while (B->cp_b != pt0) {
while (B->cp_b < pt0) {
B = B->cp_b;
}
#endif /* YAPOR */
@ -2215,7 +2218,7 @@ Yap_absmi(int inp)
#ifdef YAPOR
CUT_prune_to(pt0);
#else
while (B->cp_b != pt0) {
while (B->cp_b < pt0) {
B = B->cp_b;
}
#endif /* YAPOR */
@ -8479,7 +8482,7 @@ Yap_absmi(int inp)
float_y_nvar:
/* non variable */
if (IsFloatTerm(d0)) {
PREG = NEXTOP(PREG, xF);
PREG = NEXTOP(PREG, yF);
GONext();
}
PREG = PREG->u.yF.F;
@ -8517,7 +8520,7 @@ Yap_absmi(int inp)
#ifdef YAPOR
CUT_prune_to(pt0);
#else
while (B->cp_b != pt0) {
while (B->cp_b < pt0) {
B = B->cp_b;
}
#endif /* YAPOR */
@ -8562,7 +8565,7 @@ Yap_absmi(int inp)
#ifdef YAPOR
CUT_prune_to(pt1);
#else
while (B->cp_b != pt1) {
while (B->cp_b < pt1) {
B = B->cp_b;
}
#endif /* YAPOR */

10
C/adtdefs.c
View File

@ -176,6 +176,8 @@ LookupAtom(char *atom)
NOfAtoms++;
/* add new atom to start of chain */
ae = (AtomEntry *) Yap_AllocAtomSpace((sizeof *ae) + strlen(atom) + 1);
if (ae == NULL)
return NIL;
na = AbsAtom(ae);
ae->PropsOfAE = NIL;
if (ae->StrOfAE != atom)
@ -193,7 +195,7 @@ LookupAtom(char *atom)
Atom
Yap_LookupAtom(char *atom)
{ /* lookup atom in atom table */
return(LookupAtom(atom));
return LookupAtom(atom);
}
Atom
@ -222,7 +224,7 @@ Yap_LookupAtomWithAddress(char *atom, AtomEntry *ae)
a = HashChain[hash].Entry;
/* search atom in chain */
if (SearchAtom(p, a) != NIL) {
Yap_Error(FATAL_ERROR,TermNil,"repeated initialisation for atom %s", ae);
Yap_Error(INTERNAL_ERROR,TermNil,"repeated initialisation for atom %s", ae);
WRITE_UNLOCK(HashChain[hash].AERWLock);
return;
}
@ -842,7 +844,7 @@ Yap_GetName(char *s, UInt max, Term t)
register Int i;
if (IsVarTerm(t) || !IsPairTerm(t))
return (FALSE);
return FALSE;
while (IsPairTerm(t)) {
Head = HeadOfTerm(t);
if (!IsNumTerm(Head))
@ -857,7 +859,7 @@ Yap_GetName(char *s, UInt max, Term t)
}
}
*s = '\0';
return (TRUE);
return TRUE;
}
#ifdef SFUNC

4
C/arith0.c
View File

@ -211,6 +211,10 @@ Yap_InitConstExps(void)
for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) {
AtomEntry *ae = RepAtom(Yap_LookupAtom(InitConstTab[i].OpName));
if (ae == NULL) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"at InitConstExps");
return;
}
WRITE_LOCK(ae->ARWLock);
if (Yap_GetExpPropHavingLock(ae, 0)) {
WRITE_UNLOCK(ae->ARWLock);

10
C/arith1.c
View File

@ -2072,6 +2072,10 @@ Yap_InitUnaryExps(void)
for (i = 0; i < sizeof(InitUnTab)/sizeof(InitUnEntry); ++i) {
AtomEntry *ae = RepAtom(Yap_LookupAtom(InitUnTab[i].OpName));
if (ae == NULL) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"at InitUnaryExps");
return;
}
WRITE_LOCK(ae->ARWLock);
if (Yap_GetExpPropHavingLock(ae, 1)) {
WRITE_UNLOCK(ae->ARWLock);
@ -2099,6 +2103,10 @@ Yap_ReInitUnaryExps(void)
for (i = 0; i < sizeof(InitUnTab)/sizeof(InitUnEntry); ++i) {
AtomEntry *ae = RepAtom(Yap_FullLookupAtom(InitUnTab[i].OpName));
if (ae == NULL) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"at ReInitUnaryExps");
return FALSE;
}
WRITE_LOCK(ae->ARWLock);
if ((p = Yap_GetExpPropHavingLock(ae, 1)) == NULL) {
WRITE_UNLOCK(ae->ARWLock);
@ -2107,6 +2115,6 @@ Yap_ReInitUnaryExps(void)
RepExpProp(p)->FOfEE.unary = InitUnTab[i].f;
WRITE_UNLOCK(ae->ARWLock);
}
return(TRUE);
return TRUE;
}

33
C/c_interface.c
View File

@ -10,8 +10,11 @@
* File: c_interface.c *
* comments: c_interface primitives definition *
* *
* Last rev: $Date: 2005-02-08 18:04:47 $,$Author: vsc $ *
* Last rev: $Date: 2005-03-01 22:25:08 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.60 2005/02/08 18:04:47 vsc
* library_directory may not be deterministic (usually it isn't).
*
* Revision 1.59 2004/12/08 00:56:35 vsc
* missing ;
*
@ -388,13 +391,18 @@ YAP_AtomName(Atom a)
X_API Atom
YAP_LookupAtom(char *c)
{
Atom a = Yap_LookupAtom(c);
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
Atom a;
while (TRUE) {
a = Yap_LookupAtom(c);
if (a == NIL || (ActiveSignals & YAP_CDOVF_SIGNAL)) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
}
} else {
return a;
}
}
return a;
}
X_API Atom
@ -402,13 +410,16 @@ YAP_FullLookupAtom(char *c)
{
Atom at;
at = Yap_FullLookupAtom(c);
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
while (TRUE) {
at = Yap_FullLookupAtom(c);
if (at == NIL || (ActiveSignals & YAP_CDOVF_SIGNAL)) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
}
} else {
return at;
}
}
return(at);
}
X_API Term

4
C/dlmalloc.c
View File

@ -264,8 +264,8 @@ static int largebin_index(unsigned int sz) {
-1 - no bins sorted (not recommended!)
*/
#define FIRST_SORTED_BIN_SIZE MIN_LARGE_SIZE
/* #define FIRST_SORTED_BIN_SIZE 65536 */
/*#define FIRST_SORTED_BIN_SIZE MIN_LARGE_SIZE */
#define FIRST_SORTED_BIN_SIZE 2056
/*
Unsorted chunks

5
C/errors.c
View File

@ -372,7 +372,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
int psize = YAP_BUF_SIZE;
#if DEBUG
fprintf(stderr,"***** Processing Error %d (%x,%x) ***\n", type, ActiveSignals,Yap_PrologMode);
/* fprintf(stderr,"***** Processing Error %d (%x,%x) %s***\n", type, ActiveSignals,Yap_PrologMode,format);*/
#endif
if (type == INTERRUPT_ERROR) {
fprintf(stderr,"%% YAP exiting: cannot handle signal %d\n",
@ -399,6 +399,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
}
/* must do this here */
if (type == FATAL_ERROR
|| type == INTERNAL_ERROR
#if USE_SYSTEM_MALLOC
|| !Yap_heap_regs
#else
@ -425,7 +426,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
error_exit_yap (1);
}
if (P == (yamop *)(FAILCODE))
return(P);
return P;
/* PURE_ABORT may not have set where correctly, BootMode may not have the data terms ready */
if (type == PURE_ABORT || Yap_PrologMode & BootMode) {
where = TermNil;

9
C/index.c
View File

@ -11,8 +11,11 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2005-02-25 00:09:06 $,$Author: vsc $ *
* Last rev: $Date: 2005-03-01 22:25:08 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.117 2005/02/25 00:09:06 vsc
* fix fix, otherwise I'd remove two choice-points :-(.
*
* Revision 1.116 2005/02/24 21:46:39 vsc
* Improve error handling routine, trying to make it more robust.
* Improve hole handling in stack expansion
@ -5560,7 +5563,7 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp0, PredEntry *
codep = NEXTOP(codep, p);
break;
default:
Yap_Error(FATAL_ERROR, TermNil, "Invalid Opcode %d", op);
Yap_Error(INTERNAL_ERROR, TermNil, "Invalid Opcode %d", op);
return sp;
}
}
@ -5777,7 +5780,7 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
ocodep = NEXTOP(ocodep, p);
break;
default:
Yap_Error(FATAL_ERROR, TermNil, "Invalid Opcode");
Yap_Error(INTERNAL_ERROR, TermNil, "Invalid Opcode");
}
}
if (flag == RECORDZ) {

10
C/scanner.c
View File

@ -745,7 +745,15 @@ Yap_tokenizer(int inp_stream)
*charp++ = '\0';
if (!isvar) {
/* don't do this in iso */
t->TokInfo = Unsigned(Yap_LookupAtom(TokImage));
Atom ae = Yap_LookupAtom(TokImage);
if (ae == NIL) {
Yap_ErrorMessage = "Code Space Overflow";
if (p)
p->TokInfo = eot_tok;
/* serious error now */
return l;
}
t->TokInfo = Unsigned(ae);
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
if (ch == '(')
solo_flag = FALSE;

29
C/stdpreds.c
View File

@ -11,8 +11,12 @@
* File: stdpreds.c *
* comments: General-purpose C implemented system predicates *
* *
* Last rev: $Date: 2005-02-21 16:50:04 $,$Author: vsc $ *
* Last rev: $Date: 2005-03-01 22:25:09 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.82 2005/02/21 16:50:04 vsc
* amd64 fixes
* library fixes
*
* Revision 1.81 2005/02/08 04:05:35 vsc
* fix mess with add clause
* improves on sigsegv handling
@ -1005,17 +1009,20 @@ p_name(void)
NewT = Yap_StringToList(String);
if (!IsVarTerm(t) && !IsPairTerm(t) && t != TermNil) {
Yap_Error(TYPE_ERROR_LIST,ARG2,"name/2");
return(FALSE);
return FALSE;
}
return (Yap_unify(NewT, ARG2));
return Yap_unify(NewT, ARG2);
} else {
Yap_Error(TYPE_ERROR_ATOMIC,AtomNameT,"name/2");
return(FALSE);
}
}
s = String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE;
if (s == NULL) {
return FALSE;
}
if (!IsVarTerm(t) && t == MkAtomTerm(AtomNil)) {
return (Yap_unify_constant(ARG1, MkAtomTerm(Yap_LookupAtom(""))));
return Yap_unify_constant(ARG1, MkAtomTerm(Yap_LookupAtom("")));
}
while (!IsVarTerm(t) && IsPairTerm(t)) {
Term Head;
@ -1023,23 +1030,25 @@ p_name(void)
Head = HeadOfTerm(t);
if (IsVarTerm(Head)) {
Yap_Error(INSTANTIATION_ERROR,Head,"name/2");
return(FALSE);
return FALSE;
}
if (!IsIntTerm(Head)) {
Yap_Error(TYPE_ERROR_INTEGER,Head,"name/2");
return(FALSE);
return FALSE;
}
i = IntOfTerm(Head);
if (i < 0 || i > 255) {
if (i<0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,Head,"name/2");
return(FALSE);
return FALSE;
}
if (s+1 == (char *)AuxSp) {
if (s+1 >= (char *)AuxSp-1024) {
char *nString;
*H++ = t;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0, NULL))->StrOfAE;
if (!nString)
return FALSE;
t = *--H;
s = nString+(s-String);
String = nString;
@ -1056,10 +1065,10 @@ p_name(void)
if ((NewT = get_num(String)) == TermNil) {
NewT = MkAtomTerm(Yap_LookupAtom(String));
}
return (Yap_unify_constant(ARG1, NewT));
return Yap_unify_constant(ARG1, NewT);
} else {
Yap_Error(TYPE_ERROR_LIST,t,"name/2");
return(FALSE);
return FALSE;
}
}

2
C/sysbits.c
View File

@ -1170,7 +1170,7 @@ SearchForTrailFault(void)
/* my_signal_info(SIGSEGV, HandleSIGSEGV); */
} else
#endif /* OS_HANDLES_TR_OVERFLOW */
Yap_Error(FATAL_ERROR, TermNil,
Yap_Error(INTERNAL_ERROR, TermNil,
"likely bug in YAP, segmentation violation");
}

2
C/unify.c
View File

@ -586,7 +586,7 @@ InitReverseLookupOpcode(void)
if (OP_RTABLE == NULL)
OP_RTABLE = (opentry *)Yap_AllocCodeSpace(OP_HASH_SIZE*sizeof(struct opcode_tab_entry));
if (OP_RTABLE == NULL) {
Yap_Error(FATAL_ERROR, TermNil,
Yap_Error(INTERNAL_ERROR, TermNil,
"Couldn't obtain space for the reverse translation opcode table");
}
opeptr = OP_RTABLE;