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
parent
d11fd73306
commit
182d4f4694
44
C/globals.c
44
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,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] =
|
||||
|
||||
6
C/grow.c
6
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;
|
||||
|
||||
14
H/TermExt.h
14
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 <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));
|
||||
|
||||
37
pl/setof.yap
37
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, _, _) :-
|
||||
'$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
|
||||
).
|
||||
|
||||
Reference in New Issue
Block a user