From 14f93826660561370d333fa52e3e5b53f6d5707f Mon Sep 17 00:00:00 2001 From: vsc Date: Tue, 1 Mar 2005 22:25:09 +0000 Subject: [PATCH] fix pruning bug 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 --- C/absmi.c | 21 ++++++++++++--------- C/adtdefs.c | 10 ++++++---- C/arith0.c | 4 ++++ C/arith1.c | 10 +++++++++- C/c_interface.c | 33 ++++++++++++++++++++++----------- C/dlmalloc.c | 4 ++-- C/errors.c | 5 +++-- C/index.c | 9 ++++++--- C/scanner.c | 10 +++++++++- C/stdpreds.c | 29 +++++++++++++++++++---------- C/sysbits.c | 2 +- C/unify.c | 2 +- 12 files changed, 94 insertions(+), 45 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index ebf60b0de..3998ea0b7 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -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 */ diff --git a/C/adtdefs.c b/C/adtdefs.c index 3c88983d0..e018f4301 100644 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -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 diff --git a/C/arith0.c b/C/arith0.c index 53ae1196e..9c21cb19c 100644 --- a/C/arith0.c +++ b/C/arith0.c @@ -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); diff --git a/C/arith1.c b/C/arith1.c index 7a3fc0973..37b8a7d86 100644 --- a/C/arith1.c +++ b/C/arith1.c @@ -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; } diff --git a/C/c_interface.c b/C/c_interface.c index 9e8c47904..38debffbd 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: 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 diff --git a/C/dlmalloc.c b/C/dlmalloc.c index 8f24023bf..60204691c 100755 --- a/C/dlmalloc.c +++ b/C/dlmalloc.c @@ -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 diff --git a/C/errors.c b/C/errors.c index 77e46203e..914d628b2 100644 --- a/C/errors.c +++ b/C/errors.c @@ -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; diff --git a/C/index.c b/C/index.c index 3bc11c3b3..19e0ef22c 100644 --- a/C/index.c +++ b/C/index.c @@ -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) { diff --git a/C/scanner.c b/C/scanner.c index 722476071..d51bc520e 100644 --- a/C/scanner.c +++ b/C/scanner.c @@ -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; diff --git a/C/stdpreds.c b/C/stdpreds.c index 815f8bb0a..37d56242f 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -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; } } diff --git a/C/sysbits.c b/C/sysbits.c index 18f1792ca..5b5f80c90 100644 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -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"); } diff --git a/C/unify.c b/C/unify.c index c8a7b9534..11f394658 100644 --- a/C/unify.c +++ b/C/unify.c @@ -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;