diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

debug fixes to new globals code

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
C/globals.c
View File

@ -127,7 +127,6 @@ CreateDelayArena(attvar_record *max, attvar_record *min)
RESET_VARIABLE(&ptr->Atts); RESET_VARIABLE(&ptr->Atts);
} }
RESET_VARIABLE(&(ptr->Value)); RESET_VARIABLE(&(ptr->Value));
SetDelayTop(min);
return (CELL)max; return (CELL)max;
} }
@ -135,6 +134,8 @@ static Term
NewDelayArena(UInt size) NewDelayArena(UInt size)
{ {
attvar_record *max = DelayTop(), *min = max-size; attvar_record *max = DelayTop(), *min = max-size;
Term out;
while ((ADDR)min < Yap_GlobalBase+1024) { while ((ADDR)min < Yap_GlobalBase+1024) {
if (!Yap_InsertInGlobal((CELL *)max, size*sizeof(attvar_record))) { if (!Yap_InsertInGlobal((CELL *)max, size*sizeof(attvar_record))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms"); 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; max = DelayTop(), min = max-size;
} }
return CreateDelayArena(max, min); out = CreateDelayArena(max, min);
SetDelayTop(min);
return out;
} }
static Term static Term
@ -160,14 +163,14 @@ GrowDelayArena(Term *arenap, UInt old_size, UInt size, UInt arity)
size = 64; size = 64;
} }
XREGS[arity+1] = (CELL)arenap; 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); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return TermNil; return TermNil;
} }
arenap = (CELL *)XREGS[arity+1]; arenap = (CELL *)XREGS[arity+1];
arena = *arenap; arena = *arenap;
CreateDelayArena(DelayArenaPt(arena)+size, DelayArenaPt(arena)-size); CreateDelayArena(DelayArenaPt(arena), DelayArenaPt(arena)-size);
return (CELL)(ArenaPt(arena)+size); return arena;
} }
static Term static Term
@ -236,7 +239,7 @@ p_allocate_default_arena(void)
return FALSE; return FALSE;
} }
GlobalArena = NewArena(IntegerOfTerm(t), 2, NULL); GlobalArena = NewArena(IntegerOfTerm(t), 2, NULL);
GlobalDelayArena = NewDelayArena(IntegerOfTerm(t2)); GlobalDelayArena = NewDelayArena(2);
return TRUE; return TRUE;
} }
@ -658,6 +661,7 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap
error_handler: error_handler:
H = HB; H = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size); CloseArena(oldH, oldHB, oldASP, newarena, old_size);
if (old_delay_arena != MkIntTerm(0))
ResetDelayArena(old_delay_arena, att_arenap); ResetDelayArena(old_delay_arena, att_arenap);
XREGS[arity+1] = t; XREGS[arity+1] = t;
XREGS[arity+2] = arena; XREGS[arity+2] = arena;
@ -678,7 +682,8 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap
break; break;
case -2: case -2:
/* handle delay arena overflow */ /* 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); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return 0L; return 0L;
} }
@ -888,6 +893,7 @@ p_nb_queue(void)
{ {
Term queue_arena, delay_queue_arena, queue, ar[5], *nar; Term queue_arena, delay_queue_arena, queue, ar[5], *nar;
Term t = Deref(ARG1); Term t = Deref(ARG1);
UInt arena_sz = (H-H0)/16;
if (!IsVarTerm(t)) { if (!IsVarTerm(t)) {
if (!IsApplTerm(t)) { if (!IsApplTerm(t)) {
@ -904,13 +910,20 @@ p_nb_queue(void)
queue = Yap_MkApplTerm(FunctorNBQueue,5,ar); queue = Yap_MkApplTerm(FunctorNBQueue,5,ar);
if (!Yap_unify(queue,ARG1)) if (!Yap_unify(queue,ARG1))
return FALSE; 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) { if (queue_arena == 0L) {
return FALSE; return FALSE;
} }
nar = RepAppl(Deref(ARG1))+1; nar = RepAppl(Deref(ARG1))+1;
nar[QUEUE_ARENA] = queue_arena; 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) { if (delay_queue_arena == 0L) {
return FALSE; return FALSE;
} }
@ -993,6 +1006,10 @@ p_nb_queue_close(void)
return return
Yap_unify(ARG3, ARG2); 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)) { if (qp[QUEUE_SIZE] == MkIntTerm(0)) {
return return
Yap_unify(ARG3, ARG2); Yap_unify(ARG3, ARG2);
@ -1000,15 +1017,6 @@ p_nb_queue_close(void)
out = out =
Yap_unify(ARG3, qp[QUEUE_TAIL]) && Yap_unify(ARG3, qp[QUEUE_TAIL]) &&
Yap_unify(ARG2, qp[QUEUE_HEAD]); 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_TAIL] =
qp[QUEUE_HEAD] = qp[QUEUE_HEAD] =
qp[QUEUE_ARENA] = qp[QUEUE_ARENA] =

6
C/grow.c
View File

@ -395,7 +395,7 @@ AdjustGlobal(void)
*/ */
pt = CellPtr(Yap_GlobalBase); pt = CellPtr(Yap_GlobalBase);
while (pt < H) { while (pt < H) {
register CELL reg; CELL reg;
reg = *pt; reg = *pt;
if (IsVarTerm(reg)) { if (IsVarTerm(reg)) {
@ -585,7 +585,7 @@ static_growglobal(long size, CELL **ptr, CELL *hsplit)
ADDR old_GlobalBase = Yap_GlobalBase; ADDR old_GlobalBase = Yap_GlobalBase;
UInt minimal_request = 0L; UInt minimal_request = 0L;
long size0, sz = size; long size0, sz = size;
char vb_msg1, *vb_msg2; char vb_msg1 = '\0', *vb_msg2;
if (hsplit) { if (hsplit) {
/* just a little bit of sanity checking */ /* just a little bit of sanity checking */
@ -628,7 +628,7 @@ static_growglobal(long size, CELL **ptr, CELL *hsplit)
vb_msg1 = 'D'; vb_msg1 = 'D';
vb_msg2 = "Delay"; 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); fprintf(Yap_stderr, "%% %cO growing the stacks %ld bytes\n", vb_msg1, size);
} }
ASP -= 256; ASP -= 256;

14
H/TermExt.h
View File

@ -10,7 +10,7 @@
* File: TermExt.h * * File: TermExt.h *
* mods: * * mods: *
* comments: Extensions to standard terms for YAP * * 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 #ifdef USE_SYSTEM_MALLOC
@ -260,9 +260,21 @@ IsLongIntTerm (Term t)
#ifdef USE_GMP #ifdef USE_GMP
#include <stdio.h> #include <stdio.h>
#include <gmp.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 *)); Term STD_PROTO (Yap_MkBigIntTerm, (MP_INT *));
MP_INT *STD_PROTO (Yap_BigIntOfTerm, (Term)); MP_INT *STD_PROTO (Yap_BigIntOfTerm, (Term));

37
pl/setof.yap
View File

@ -33,37 +33,40 @@ _^Goal :-
findall(Template, Generator, Answers) :- findall(Template, Generator, Answers) :-
'$check_list_for_bags'(Answers, findall(Template, Generator, Answers)), '$check_list_for_bags'(Answers, findall(Template, Generator, Answers)),
nb_queue(Ref), '$findall'(Template, Generator, [], Answers).
'$findall'(Template, Generator, Ref, [], Answers).
% If some answers have already been found % If some answers have already been found
findall(Template, Generator, Answers, SoFar) :- findall(Template, Generator, Answers, SoFar) :-
nb_queue(Ref), '$findall'(Template, Generator, SoFar, Answers).
'$findall'(Template, Generator, Ref, SoFar, Answers).
% starts by calling the generator, % starts by calling the generator,
% and recording the answers % and recording the answers
'$findall'(Template, Generator, Ref, _, _) :- '$findall'(Template, Generator, SoFar, Answers) :-
nb_queue(Ref),
(
'$execute'(Generator), '$execute'(Generator),
nb_queue_enqueue(Ref, Template), nb_queue_enqueue(Ref, Template),
fail. fail
% now wraps it all ;
'$findall'(_, _, Ref, SoFar, Answers) :- nb_queue_close(Ref, Answers, SoFar)
nb_queue_close(Ref, Answers, SoFar). ).
% findall_with_key is very similar to findall, but uses the SICStus % findall_with_key is very similar to findall, but uses the SICStus
% algorithm to guarantee that variables will have the same names. % 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), '$execute'(Generator),
nb_queue_enqueue(Ref, Template), nb_queue_enqueue(Ref, Template),
fail. fail
% now wraps it all ;
'$findall_with_common_vars'(_, _, Ref, Answers) :-
nb_queue_close(Ref, Answers, []), nb_queue_close(Ref, Answers, []),
'$collect_with_common_vars'(Answers, _). '$collect_with_common_vars'(Answers, _)
).
'$collect_with_common_vars'([], _). '$collect_with_common_vars'([], _).
'$collect_with_common_vars'([Key-_|Answers], VarList) :- '$collect_with_common_vars'([Key-_|Answers], VarList) :-
@ -93,13 +96,11 @@ bagof(Template, Generator, Bag) :-
( FreeVars \== [] -> ( FreeVars \== [] ->
'$variables_in_term'(FreeVars, [], LFreeVars), '$variables_in_term'(FreeVars, [], LFreeVars),
Key =.. ['$'|LFreeVars], Key =.. ['$'|LFreeVars],
nb_queue(Ref), '$findall_with_common_vars'(Key-Template, StrippedGenerator, Bags0),
'$findall_with_common_vars'(Key-Template, StrippedGenerator, Ref, Bags0),
'$keysort'(Bags0, Bags), '$keysort'(Bags0, Bags),
'$pick'(Bags, Key, Bag) '$pick'(Bags, Key, Bag)
; ;
nb_queue(Ref), '$findall'(Template, StrippedGenerator, [], Bag0),
'$findall'(Template, StrippedGenerator, Ref, [], Bag0),
Bag0 \== [], Bag0 \== [],
Bag = Bag0 Bag = Bag0
). ).