debug fixes to new globals code

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1686 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2006-08-23 12:12:14 +00:00
parent d11fd73306
commit 182d4f4694
4 changed files with 67 additions and 46 deletions

View File

@ -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,6 +661,7 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap
error_handler:
H = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size);
if (old_delay_arena != MkIntTerm(0))
ResetDelayArena(old_delay_arena, att_arenap);
XREGS[arity+1] = t;
XREGS[arity+2] = arena;
@ -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] =

View File

@ -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;

View File

@ -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 <stdio.h>
#include <gmp.h>
#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));

View File

@ -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, _, _) :-
'$findall'(Template, Generator, SoFar, Answers) :-
nb_queue(Ref),
(
'$execute'(Generator),
nb_queue_enqueue(Ref, Template),
fail.
% now wraps it all
'$findall'(_, _, Ref, SoFar, Answers) :-
nb_queue_close(Ref, Answers, SoFar).
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, _) :-
'$findall_with_common_vars'(Template, Generator, Answers) :-
nb_queue(Ref),
(
'$execute'(Generator),
nb_queue_enqueue(Ref, Template),
fail.
% now wraps it all
'$findall_with_common_vars'(_, _, Ref, Answers) :-
fail
;
nb_queue_close(Ref, Answers, []),
'$collect_with_common_vars'(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
).