more tabling fixes

use malloc when AllocCodeSpace fails
use snprintf when available.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1458 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-11-16 01:55:03 +00:00
parent e021bef90d
commit 4c0865ca37
9 changed files with 158 additions and 13 deletions

View File

@ -12,7 +12,7 @@
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: allocating space * * comments: allocating space *
* version:$Id: alloc.c,v 1.74 2005-11-08 13:57:41 vsc Exp $ * * version:$Id: alloc.c,v 1.75 2005-11-16 01:55:03 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
@ -78,6 +78,8 @@ minfo(char mtype)
} }
#endif #endif
static int vsc_allocs;
char * char *
Yap_AllocCodeSpace(unsigned int size) Yap_AllocCodeSpace(unsigned int size)
{ {
@ -87,6 +89,7 @@ Yap_AllocCodeSpace(unsigned int size)
mallocs++; mallocs++;
tmalloc += size; tmalloc += size;
#endif #endif
vsc_allocs++;
return malloc(size); return malloc(size);
} }

View File

@ -749,7 +749,7 @@ p_create_array(void)
while (!EndOfPAEntr(pp) && while (!EndOfPAEntr(pp) &&
pp->KindOfPE != ArrayProperty pp->KindOfPE != ArrayProperty
#if THREADS #if THREADS
&& pp->owner_id != worker_id && ((ArrayEntry *)pp)->owner_id != worker_id
#endif #endif
) )
pp = RepProp(pp->NextOfPE); pp = RepProp(pp->NextOfPE);

View File

@ -227,7 +227,7 @@ Yap_MkULLIntTerm(YAP_ULONG_LONG n)
char tmp[256]; char tmp[256];
#if HAVE_SNPRINTF #if HAVE_SNPRINTF
sprintf(tmp,256,"%llu",n); snprintf(tmp,256,"%llu",n);
#else #else
sprintf(tmp,"%llu",n); sprintf(tmp,"%llu",n);
#endif #endif

View File

@ -2904,8 +2904,8 @@ update_B_H( choiceptr gc_B, CELL *current, CELL *dest, CELL *odest
#ifdef TABLING #ifdef TABLING
/* make sure we include consumers */ /* make sure we include consumers */
if (depfr && gc_B >= DepFr_cons_cp(depfr)) { if (depfr && gc_B >= DepFr_cons_cp(depfr)) {
*depfrp = depfr = DepFr_next(depfr);
gc_B = DepFr_cons_cp(depfr); gc_B = DepFr_cons_cp(depfr);
*depfrp = depfr = DepFr_next(depfr);
} }
#endif /* TABLING */ #endif /* TABLING */
} }
@ -3765,9 +3765,10 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
if (gc_margin < gc_lim) if (gc_margin < gc_lim)
gc_margin = gc_lim; gc_margin = gc_lim;
GcCalls++; GcCalls++;
if (gc_on && !(Yap_PrologMode & InErrorMode) && if (gc_on && !(Yap_PrologMode & InErrorMode) //&&
/* make sure there is a point in collecting th eheap */ /* make sure there is a point in collecting th eheap */
H-H0 > (LCL0-ASP)/2) { //H-H0 > (LCL0-ASP)/2) {
) {
effectiveness = do_gc(predarity, current_env, nextop); effectiveness = do_gc(predarity, current_env, nextop);
if (effectiveness > 90) { if (effectiveness > 90) {
while (gc_margin < H-H0) while (gc_margin < H-H0)

View File

@ -434,7 +434,7 @@ InitDebug(void)
fprintf(stderr,"Set Trace Options:\n"); fprintf(stderr,"Set Trace Options:\n");
fprintf(stderr,"a getch\t\tb token\t\tc Lookup\td LookupVar\ti Index\n"); fprintf(stderr,"a getch\t\tb token\t\tc Lookup\td LookupVar\ti Index\n");
fprintf(stderr,"e SetOp\t\tf compile\tg icode\t\th boot\t\tl log\n"); fprintf(stderr,"e SetOp\t\tf compile\tg icode\t\th boot\t\tl log\n");
fprintf(stderr,"m Machine\n"); fprintf(stderr,"m Machine\t p parser\n");
while ((ch = YP_putchar(YP_getchar())) != '\n') while ((ch = YP_putchar(YP_getchar())) != '\n')
if (ch >= 'a' && ch <= 'z') if (ch >= 'a' && ch <= 'z')
Yap_Option[ch - 'a' + 1] = 1; Yap_Option[ch - 'a' + 1] = 1;

View File

@ -111,6 +111,7 @@ STATIC_PROTO(Term ParseTerm, (int, JMPBUFF *));
F } \ F } \
} }
#define FAIL longjmp(FailBuff->JmpBuff,1) #define FAIL longjmp(FailBuff->JmpBuff,1)
VarEntry * VarEntry *
@ -415,6 +416,14 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
switch (Yap_tokptr->Tok) { switch (Yap_tokptr->Tok) {
case Name_tok: case Name_tok:
t = Yap_tokptr->TokInfo; t = Yap_tokptr->TokInfo;
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
NextToken; NextToken;
if ((Yap_tokptr->Tok != Ord(Ponctuation_tok) if ((Yap_tokptr->Tok != Ord(Ponctuation_tok)
|| Unsigned(Yap_tokptr->TokInfo) != 'l') || Unsigned(Yap_tokptr->TokInfo) != 'l')
@ -425,6 +434,14 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
if (Yap_tokptr->Tok == Number_tok) { if (Yap_tokptr->Tok == Number_tok) {
if ((Atom)t == AtomMinus) { if ((Atom)t == AtomMinus) {
t = Yap_tokptr->TokInfo; t = Yap_tokptr->TokInfo;
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
if (IsIntTerm(t)) if (IsIntTerm(t))
t = MkIntTerm(-IntOfTerm(t)); t = MkIntTerm(-IntOfTerm(t));
else if (IsFloatTerm(t)) else if (IsFloatTerm(t))
@ -440,9 +457,25 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
else else
t = MkLongIntTerm(-LongIntOfTerm(t)); t = MkLongIntTerm(-LongIntOfTerm(t));
NextToken; NextToken;
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
break; break;
} else if ((Atom)t == AtomPlus) { } else if ((Atom)t == AtomPlus) {
t = Yap_tokptr->TokInfo; t = Yap_tokptr->TokInfo;
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
NextToken; NextToken;
break; break;
} }
@ -479,6 +512,14 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
func = Yap_MkFunctor((Atom) t, 1); func = Yap_MkFunctor((Atom) t, 1);
t = ParseTerm(oprprio, FailBuff); t = ParseTerm(oprprio, FailBuff);
t = Yap_MkApplTerm(func, 1, &t); t = Yap_MkApplTerm(func, 1, &t);
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (H > ASP-4096) {
Yap_ErrorMessage = "Stack Overflow"; Yap_ErrorMessage = "Stack Overflow";
@ -499,6 +540,14 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
case Number_tok: case Number_tok:
t = Yap_tokptr->TokInfo; t = Yap_tokptr->TokInfo;
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
NextToken; NextToken;
break; break;
@ -513,6 +562,14 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
t = MkAtomTerm(Yap_LookupAtom(p)); t = MkAtomTerm(Yap_LookupAtom(p));
else else
t = Yap_StringToList(p); t = Yap_StringToList(p);
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
NextToken; NextToken;
} }
break; break;
@ -522,6 +579,14 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
if ((t = varinfo->VarAdr) == TermNil) { if ((t = varinfo->VarAdr) == TermNil) {
t = varinfo->VarAdr = MkVarTerm(); t = varinfo->VarAdr = MkVarTerm();
} }
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
NextToken; NextToken;
break; break;
@ -534,11 +599,27 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
case 'l': /* non solo ( */ case 'l': /* non solo ( */
NextToken; NextToken;
t = ParseTerm(1200, FailBuff); t = ParseTerm(1200, FailBuff);
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
checkfor((Term) ')', FailBuff); checkfor((Term) ')', FailBuff);
break; break;
case '[': case '[':
NextToken; NextToken;
t = ParseList(FailBuff); t = ParseList(FailBuff);
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
checkfor((Term) ']', FailBuff); checkfor((Term) ']', FailBuff);
break; break;
case '{': case '{':
@ -603,6 +684,14 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
&& opprio <= prio && oplprio >= curprio) { && opprio <= prio && oplprio >= curprio) {
/* parse as posfix operator */ /* parse as posfix operator */
t = Yap_MkApplTerm(Yap_MkFunctor((Atom) Yap_tokptr->TokInfo, 1), 1, &t); t = Yap_MkApplTerm(Yap_MkFunctor((Atom) Yap_tokptr->TokInfo, 1), 1, &t);
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (H > ASP-4096) {
Yap_ErrorMessage = "Stack Overflow"; Yap_ErrorMessage = "Stack Overflow";
@ -622,6 +711,14 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
args[0] = t; args[0] = t;
args[1] = ParseTerm(1000, FailBuff); args[1] = ParseTerm(1000, FailBuff);
t = Yap_MkApplTerm(Yap_MkFunctor(AtomComma, 2), 2, args); t = Yap_MkApplTerm(Yap_MkFunctor(AtomComma, 2), 2, args);
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (H > ASP-4096) {
Yap_ErrorMessage = "Stack Overflow"; Yap_ErrorMessage = "Stack Overflow";
@ -636,6 +733,14 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
args[0] = t; args[0] = t;
args[1] = ParseTerm(1100, FailBuff); args[1] = ParseTerm(1100, FailBuff);
t = Yap_MkApplTerm(FunctorVBar, 2, args); t = Yap_MkApplTerm(FunctorVBar, 2, args);
#ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_DebugPutc(Yap_c_error_stream,']');
Yap_plwrite (t, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
#endif
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (H > ASP-4096) {
Yap_ErrorMessage = "Stack Overflow"; Yap_ErrorMessage = "Stack Overflow";
@ -649,7 +754,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
FAIL; FAIL;
break; break;
} }
return (t); return t;
} }

View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.init.c File: opt.init.c
version: $Id: opt.init.c,v 1.13 2005-11-04 01:17:17 vsc Exp $ version: $Id: opt.init.c,v 1.14 2005-11-16 01:55:03 vsc Exp $
**********************************************************************/ **********************************************************************/
@ -57,6 +57,36 @@ ma_h_inner_struct *Yap_ma_h_top;
#if YAP_MEMORY_ALLOC_SCHEME
char *
Yap_get_yap_space(int sz)
{
char *ptr = Yap_AllocCodeSpace(sz+sizeof(CELL));
if (ptr) {
*ptr = 'y';
return ptr+sizeof(CELL);
}
ptr = (char *)malloc(sz+sizeof(CELL));
if (ptr) {
*ptr = 'm';
return ptr+sizeof(CELL);
}
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "Yap_AllocCodeSpace error (ALLOC_STRUCT), when allocating %d B", sz);
return NULL;
}
void
Yap_free_yap_space(char *ptr)
{
ptr -= sizeof(CELL);
if (ptr[0] == 'y') {
Yap_FreeCodeSpace(ptr);
} else {
free((void *)ptr);
}
}
#endif
/* -------------------------- ** /* -------------------------- **
** Global functions ** ** Global functions **
** -------------------------- */ ** -------------------------- */
@ -265,3 +295,4 @@ void init_workers(void) {
} }
#endif /* YAPOR */ #endif /* YAPOR */
#endif /* YAPOR || TABLING */ #endif /* YAPOR || TABLING */

View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.macros.h File: opt.macros.h
version: $Id: opt.macros.h,v 1.10 2005-08-10 21:36:34 ricroc Exp $ version: $Id: opt.macros.h,v 1.11 2005-11-16 01:55:03 vsc Exp $
**********************************************************************/ **********************************************************************/
@ -61,15 +61,19 @@ extern int Yap_page_size;
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \ UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \
free(STR) free(STR)
#elif YAP_MEMORY_ALLOC_SCHEME /* ---------------------------------------------------- */ #elif YAP_MEMORY_ALLOC_SCHEME /* ---------------------------------------------------- */
char *STD_PROTO(Yap_get_yap_space, (int));
void STD_PROTO(Yap_free_yap_space, (char *));
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \ #define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), 1); \ UPDATE_STATS(Pg_str_in_use(STR_PAGES), 1); \
if ((STR = (STR_TYPE *) Yap_AllocCodeSpace(sizeof(STR_TYPE))) == NULL) \ STR = (STR_TYPE *)Yap_get_yap_space(sizeof(STR_TYPE))
Yap_Error(FATAL_ERROR, TermNil, "Yap_AllocCodeSpace error (ALLOC_STRUCT)")
#define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \ #define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE)
#define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \ #define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \ UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \
Yap_FreeCodeSpace((char *) (STR)) Yap_free_yap_space((char *)(STR))
#elif SHM_MEMORY_ALLOC_SCHEME /* ---------------------------------------------------- */ #elif SHM_MEMORY_ALLOC_SCHEME /* ---------------------------------------------------- */
#ifdef LIMIT_TABLING #ifdef LIMIT_TABLING
#define INIT_PAGE(PG_HD, STR_PAGES, STR_TYPE) \ #define INIT_PAGE(PG_HD, STR_PAGES, STR_TYPE) \

View File

@ -16,6 +16,7 @@
<h2>Yap-5.1.0:</h2> <h2>Yap-5.1.0:</h2>
<ul> <ul>
<li> FIXED: in tabling, use malloc when AllocCodeSpace fails. </li>
<li> FIXED: in tabling don't look inside cp_ap == NULL and fix recent <li> FIXED: in tabling don't look inside cp_ap == NULL and fix recent
bug in walking dependency frames. </li> bug in walking dependency frames. </li>
<li> FIXED: with tabling ASP sometimes was miscalculated, causing <li> FIXED: with tabling ASP sometimes was miscalculated, causing