From 182d4f46949d6a588d8f036f6a7ead92fee30844 Mon Sep 17 00:00:00 2001 From: vsc Date: Wed, 23 Aug 2006 12:12:14 +0000 Subject: [PATCH] debug fixes to new globals code git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1686 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/globals.c | 46 +++++++++++++++++++++++++++------------------- C/grow.c | 6 +++--- H/TermExt.h | 14 +++++++++++++- pl/setof.yap | 47 ++++++++++++++++++++++++----------------------- 4 files changed, 67 insertions(+), 46 deletions(-) diff --git a/C/globals.c b/C/globals.c index 7520670af..eb252bf27 100644 --- a/C/globals.c +++ b/C/globals.c @@ -127,7 +127,6 @@ CreateDelayArena(attvar_record *max, attvar_record *min) RESET_VARIABLE(&ptr->Atts); } RESET_VARIABLE(&(ptr->Value)); - SetDelayTop(min); return (CELL)max; } @@ -135,6 +134,8 @@ static Term NewDelayArena(UInt size) { attvar_record *max = DelayTop(), *min = max-size; + Term out; + while ((ADDR)min < Yap_GlobalBase+1024) { if (!Yap_InsertInGlobal((CELL *)max, size*sizeof(attvar_record))) { Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms"); @@ -142,7 +143,9 @@ NewDelayArena(UInt size) } max = DelayTop(), min = max-size; } - return CreateDelayArena(max, min); + out = CreateDelayArena(max, min); + SetDelayTop(min); + return out; } static Term @@ -160,14 +163,14 @@ GrowDelayArena(Term *arenap, UInt old_size, UInt size, UInt arity) size = 64; } XREGS[arity+1] = (CELL)arenap; - if (!Yap_InsertInGlobal((CELL *)arena, size*sizeof(attvar_record))) { + if (!Yap_InsertInGlobal((CELL *)arena, (size-old_size)*sizeof(attvar_record))) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return TermNil; } arenap = (CELL *)XREGS[arity+1]; arena = *arenap; - CreateDelayArena(DelayArenaPt(arena)+size, DelayArenaPt(arena)-size); - return (CELL)(ArenaPt(arena)+size); + CreateDelayArena(DelayArenaPt(arena), DelayArenaPt(arena)-size); + return arena; } static Term @@ -236,7 +239,7 @@ p_allocate_default_arena(void) return FALSE; } GlobalArena = NewArena(IntegerOfTerm(t), 2, NULL); - GlobalDelayArena = NewDelayArena(IntegerOfTerm(t2)); + GlobalDelayArena = NewDelayArena(2); return TRUE; } @@ -658,7 +661,8 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap error_handler: H = HB; CloseArena(oldH, oldHB, oldASP, newarena, old_size); - ResetDelayArena(old_delay_arena, att_arenap); + if (old_delay_arena != MkIntTerm(0)) + ResetDelayArena(old_delay_arena, att_arenap); XREGS[arity+1] = t; XREGS[arity+2] = arena; XREGS[arity+3] = (CELL)newarena; @@ -678,7 +682,8 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap break; case -2: /* handle delay arena overflow */ - if (!GrowDelayArena(att_arenap, 0L, 0L, arity+4)) { + old_size = DelayArenaSz(*att_arenap); + if (!GrowDelayArena(att_arenap, old_size, 0L, arity+4)) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return 0L; } @@ -888,6 +893,7 @@ p_nb_queue(void) { Term queue_arena, delay_queue_arena, queue, ar[5], *nar; Term t = Deref(ARG1); + UInt arena_sz = (H-H0)/16; if (!IsVarTerm(t)) { if (!IsApplTerm(t)) { @@ -904,13 +910,20 @@ p_nb_queue(void) queue = Yap_MkApplTerm(FunctorNBQueue,5,ar); if (!Yap_unify(queue,ARG1)) return FALSE; - queue_arena = NewArena(1024,1,NULL); + if (arena_sz < 1024) + arena_sz = 1024; + queue_arena = NewArena(arena_sz,1,NULL); if (queue_arena == 0L) { return FALSE; } nar = RepAppl(Deref(ARG1))+1; nar[QUEUE_ARENA] = queue_arena; - delay_queue_arena = NewDelayArena(64); + arena_sz = ((attvar_record *)H0- DelayTop())/16; + if (arena_sz <2) + arena_sz = 2; + if (arena_sz > 256) + arena_sz = 256; + delay_queue_arena = NewDelayArena(arena_sz); if (delay_queue_arena == 0L) { return FALSE; } @@ -993,6 +1006,10 @@ p_nb_queue_close(void) return Yap_unify(ARG3, ARG2); } + if (qp[QUEUE_ARENA] != MkIntTerm(0)) + RecoverArena(qp[QUEUE_ARENA]); + if (qp[QUEUE_DELAY_ARENA] != MkIntTerm(0)) + RecoverDelayArena(qp[QUEUE_DELAY_ARENA]); if (qp[QUEUE_SIZE] == MkIntTerm(0)) { return Yap_unify(ARG3, ARG2); @@ -1000,15 +1017,6 @@ p_nb_queue_close(void) out = Yap_unify(ARG3, qp[QUEUE_TAIL]) && Yap_unify(ARG2, qp[QUEUE_HEAD]); - /* - arena = GetQueueArena(qp, "delete_queue"); - if ((CELL *)ArenaLimit == H && - H != B->cp_h) { - H = RepAppl(arena); - } - */ - RecoverArena(qp[QUEUE_ARENA]); - RecoverDelayArena(qp[QUEUE_DELAY_ARENA]); qp[QUEUE_TAIL] = qp[QUEUE_HEAD] = qp[QUEUE_ARENA] = diff --git a/C/grow.c b/C/grow.c index 1023a055a..cff8f4452 100644 --- a/C/grow.c +++ b/C/grow.c @@ -395,7 +395,7 @@ AdjustGlobal(void) */ pt = CellPtr(Yap_GlobalBase); while (pt < H) { - register CELL reg; + CELL reg; reg = *pt; if (IsVarTerm(reg)) { @@ -585,7 +585,7 @@ static_growglobal(long size, CELL **ptr, CELL *hsplit) ADDR old_GlobalBase = Yap_GlobalBase; UInt minimal_request = 0L; long size0, sz = size; - char vb_msg1, *vb_msg2; + char vb_msg1 = '\0', *vb_msg2; if (hsplit) { /* just a little bit of sanity checking */ @@ -628,7 +628,7 @@ static_growglobal(long size, CELL **ptr, CELL *hsplit) vb_msg1 = 'D'; vb_msg2 = "Delay"; } - fprintf(Yap_stderr, "%% %cO %s overflow %d\n", vb_msg1, vb_msg2, delay_overflows); \ + fprintf(Yap_stderr, "%% %cO %s overflow %d\n", vb_msg1, vb_msg2, delay_overflows); fprintf(Yap_stderr, "%% %cO growing the stacks %ld bytes\n", vb_msg1, size); } ASP -= 256; diff --git a/H/TermExt.h b/H/TermExt.h index dd26ad651..f6484dcf4 100644 --- a/H/TermExt.h +++ b/H/TermExt.h @@ -10,7 +10,7 @@ * File: TermExt.h * * mods: * * comments: Extensions to standard terms for YAP * -* version: $Id: TermExt.h,v 1.10 2006-08-22 16:12:46 vsc Exp $ * +* version: $Id: TermExt.h,v 1.11 2006-08-23 12:12:14 vsc Exp $ * *************************************************************************/ #ifdef USE_SYSTEM_MALLOC @@ -260,9 +260,21 @@ IsLongIntTerm (Term t) #ifdef USE_GMP + #include + #include +#else + +typedef struct { + UInt _size, _mp_alloc; + void *_mp_d; +} MP_INT; + +#endif + +#ifdef USE_GMP Term STD_PROTO (Yap_MkBigIntTerm, (MP_INT *)); MP_INT *STD_PROTO (Yap_BigIntOfTerm, (Term)); diff --git a/pl/setof.yap b/pl/setof.yap index 074c8d553..cf1d6fd7a 100644 --- a/pl/setof.yap +++ b/pl/setof.yap @@ -33,37 +33,40 @@ _^Goal :- findall(Template, Generator, Answers) :- '$check_list_for_bags'(Answers, findall(Template, Generator, Answers)), - nb_queue(Ref), - '$findall'(Template, Generator, Ref, [], Answers). + '$findall'(Template, Generator, [], Answers). % If some answers have already been found findall(Template, Generator, Answers, SoFar) :- - nb_queue(Ref), - '$findall'(Template, Generator, Ref, SoFar, Answers). + '$findall'(Template, Generator, SoFar, Answers). % starts by calling the generator, % and recording the answers -'$findall'(Template, Generator, Ref, _, _) :- - '$execute'(Generator), - nb_queue_enqueue(Ref, Template), - fail. -% now wraps it all -'$findall'(_, _, Ref, SoFar, Answers) :- - nb_queue_close(Ref, Answers, SoFar). +'$findall'(Template, Generator, SoFar, Answers) :- + nb_queue(Ref), + ( + '$execute'(Generator), + nb_queue_enqueue(Ref, Template), + fail + ; + nb_queue_close(Ref, Answers, SoFar) + ). + % findall_with_key is very similar to findall, but uses the SICStus % algorithm to guarantee that variables will have the same names. % -'$findall_with_common_vars'(Template, Generator, Ref, _) :- - '$execute'(Generator), - nb_queue_enqueue(Ref, Template), - fail. -% now wraps it all -'$findall_with_common_vars'(_, _, Ref, Answers) :- - nb_queue_close(Ref, Answers, []), - '$collect_with_common_vars'(Answers, _). +'$findall_with_common_vars'(Template, Generator, Answers) :- + nb_queue(Ref), + ( + '$execute'(Generator), + nb_queue_enqueue(Ref, Template), + fail + ; + nb_queue_close(Ref, Answers, []), + '$collect_with_common_vars'(Answers, _) + ). '$collect_with_common_vars'([], _). '$collect_with_common_vars'([Key-_|Answers], VarList) :- @@ -93,13 +96,11 @@ bagof(Template, Generator, Bag) :- ( FreeVars \== [] -> '$variables_in_term'(FreeVars, [], LFreeVars), Key =.. ['$'|LFreeVars], - nb_queue(Ref), - '$findall_with_common_vars'(Key-Template, StrippedGenerator, Ref, Bags0), + '$findall_with_common_vars'(Key-Template, StrippedGenerator, Bags0), '$keysort'(Bags0, Bags), '$pick'(Bags, Key, Bag) ; - nb_queue(Ref), - '$findall'(Template, StrippedGenerator, Ref, [], Bag0), + '$findall'(Template, StrippedGenerator, [], Bag0), Bag0 \== [], Bag = Bag0 ).