try to decrease HeapTop if recovering space on top of Heap;

change overflow code to be less relying on non-decreasing Heap.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@405 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-03-08 06:33:16 +00:00
parent 7460eccabd
commit 5503ea22f3
5 changed files with 49 additions and 49 deletions

View File

@ -1634,12 +1634,7 @@ absmi(int inp)
NoStackExecute: NoStackExecute:
SREG = (CELL *) pred_entry(PREG->u.l.l); SREG = (CELL *) pred_entry(PREG->u.l.l);
#ifdef YAPOR if (CFREG == (CELL)(LCL0+1))
/* abort_optyap("NoStackExecute in function absmi"); */
if (HeapTop > GlobalBase - MinHeapGap)
#else /* YAPOR */
if (HeapTop > Addr(AuxSp) - MinHeapGap)
#endif
{ {
ASP = Y+E_CB; ASP = Y+E_CB;
if (ASP > (CELL *)B) if (ASP > (CELL *)B)
@ -1777,18 +1772,12 @@ absmi(int inp)
NoStackCall: NoStackCall:
/* on X86 machines S will not actually be holding the pointer to pred */ /* on X86 machines S will not actually be holding the pointer to pred */
SREG = (CELL *) PREG->u.sla.p; SREG = (CELL *) PREG->u.sla.p;
#ifdef YAPOR if (CFREG == (CELL)(LCL0+1)) {
/* abort_optyap("NoStackCall in function absmi"); */ ASP = (CELL *) (((char *) Y) + PREG->u.sla.s);
if (HeapTop > GlobalBase - MinHeapGap) if (ASP > (CELL *)B)
#else ASP = (CELL *)B;
if (HeapTop > Addr(AuxSp) - MinHeapGap) goto noheapleft;
#endif /* YAPOR */ }
{
ASP = (CELL *) (((char *) Y) + PREG->u.sla.s);
if (ASP > (CELL *)B)
ASP = (CELL *)B;
goto noheapleft;
}
#ifdef COROUTINING #ifdef COROUTINING
if (CFREG == Unsigned(LCL0)) { if (CFREG == Unsigned(LCL0)) {
if (ReadTimedVar(WokenGoals) != TermNil) if (ReadTimedVar(WokenGoals) != TermNil)
@ -1856,18 +1845,12 @@ absmi(int inp)
NoStackEither: NoStackEither:
/* find something to fool S */ /* find something to fool S */
SREG = (CELL *)RepPredProp(GetPredPropByFunc(MkFunctor(AtomRestoreRegs,1),0)); SREG = (CELL *)RepPredProp(GetPredPropByFunc(MkFunctor(AtomRestoreRegs,1),0));
#ifdef YAPOR if (CFREG == (CELL)(LCL0+1)) {
/* abort_optyap("NoStackCall in function absmi"); */ ASP = (CELL *) (((char *) Y) + PREG->u.sla.s);
if (HeapTop > GlobalBase - MinHeapGap) if (ASP > (CELL *)B)
#else ASP = (CELL *)B;
if (HeapTop > Addr(AuxSp) - MinHeapGap) goto noheapleft;
#endif /* YAPOR */ }
{
ASP = (CELL *) (((char *) Y) + PREG->u.sla.s);
if (ASP > (CELL *)B)
ASP = (CELL *)B;
goto noheapleft;
}
if (CFREG == Unsigned(LCL0)) { if (CFREG == Unsigned(LCL0)) {
if (ReadTimedVar(WokenGoals) != TermNil) if (ReadTimedVar(WokenGoals) != TermNil)
goto creep_either; goto creep_either;
@ -1941,18 +1924,12 @@ absmi(int inp)
NoStackDExecute: NoStackDExecute:
/* set SREG for next instructions */ /* set SREG for next instructions */
SREG = (CELL *) pred_entry(PREG->u.l.l); SREG = (CELL *) pred_entry(PREG->u.l.l);
#ifdef YAPOR if (CFREG == (CELL)(LCL0+1)) {
/* abort_optyap("noStackDExecute in function absmi"); */ ASP = Y+E_CB;
if (HeapTop > GlobalBase - MinHeapGap) if (ASP > (CELL *)B)
#else ASP = (CELL *)B;
if (HeapTop > Addr(AuxSp) - MinHeapGap) goto noheapleft;
#endif /* YAPOR */ }
{
ASP = Y+E_CB;
if (ASP > (CELL *)B)
ASP = (CELL *)B;
goto noheapleft;
}
#ifdef COROUTINING #ifdef COROUTINING
if (CFREG == Unsigned(LCL0)) { if (CFREG == Unsigned(LCL0)) {
if (ReadTimedVar(WokenGoals) != TermNil) if (ReadTimedVar(WokenGoals) != TermNil)
@ -2125,6 +2102,7 @@ absmi(int inp)
JMPNext(); JMPNext();
} }
#endif #endif
creep_on = FALSE;
#if SHADOW_S #if SHADOW_S
S = SREG; S = SREG;
#endif #endif

View File

@ -12,7 +12,7 @@
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: allocating space * * comments: allocating space *
* version:$Id: alloc.c,v 1.16 2002-02-26 17:41:53 vsc Exp $ * * version:$Id: alloc.c,v 1.17 2002-03-08 06:33:16 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
@ -169,8 +169,23 @@ FreeBlock(BlockHeader *b)
RemoveFromFreeList(p); RemoveFromFreeList(p);
b->b_size += p->b_size + 1; b->b_size += p->b_size + 1;
} }
/* check if we are the HeapTop */
if (!HEAPTOP_OWNER(worker_id)) {
LOCK(HeapTopLock);
}
if (sp == (YAP_SEG_SIZE *)HeapTop) {
LOCK(HeapUsedLock);
HeapUsed -= (b->b_size + 1) * sizeof(YAP_SEG_SIZE);
UNLOCK(HeapUsedLock);
HeapTop = (ADDR)b;
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
} else {
/* insert on list of free blocks */ /* insert on list of free blocks */
AddToFreeList(b); AddToFreeList(b);
}
if (!HEAPTOP_OWNER(worker_id)) {
UNLOCK(HeapTopLock);
}
UNLOCK(GLOBAL_LOCKS_alloc_block); UNLOCK(GLOBAL_LOCKS_alloc_block);
UNLOCK(FreeBlocksLock); UNLOCK(FreeBlocksLock);
} }
@ -265,7 +280,7 @@ AllocHeap(unsigned int size)
if (!HEAPTOP_OWNER(worker_id)) { if (!HEAPTOP_OWNER(worker_id)) {
UNLOCK(HeapTopLock); UNLOCK(HeapTopLock);
} }
CreepFlag = Unsigned(LCL0) - Unsigned(H0); CreepFlag = Unsigned(LCL0+1);
} else { } else {
if (size > SizeOfOverflow) if (size > SizeOfOverflow)
SizeOfOverflow = size*sizeof(CELL) + sizeof(YAP_SEG_SIZE); SizeOfOverflow = size*sizeof(CELL) + sizeof(YAP_SEG_SIZE);

View File

@ -10,7 +10,7 @@
* File: Regs.h * * File: Regs.h *
* mods: * * mods: *
* comments: YAP abstract machine registers * * comments: YAP abstract machine registers *
* version: $Id: Regs.h,v 1.13 2002-02-06 17:35:25 vsc Exp $ * * version: $Id: Regs.h,v 1.14 2002-03-08 06:33:16 vsc Exp $ *
*************************************************************************/ *************************************************************************/
@ -698,6 +698,9 @@ EXTERN inline void restore_B(void) {
REGSTORE standard_regs; REGSTORE standard_regs;
#endif /* PUSH_REGS */ #endif /* PUSH_REGS */
/******************* controlling debugging ****************************/
extern int creep_on;
static inline UInt static inline UInt
CalculateStackGap(void) CalculateStackGap(void)
{ {

View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 * * File: Yap.h.m4 *
* mods: * * mods: *
* comments: main header file for YAP * * comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.22 2002-02-22 06:10:16 vsc Exp $ * * version: $Id: Yap.h.m4,v 1.23 2002-03-08 06:33:16 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#include "config.h" #include "config.h"
@ -773,6 +773,9 @@ extern int CritLocks;
extern char **yap_args; extern char **yap_args;
extern int yap_argc; extern int yap_argc;
/******************* controlling debugging ****************************/
extern int creep_on;
#ifdef YAPOR #ifdef YAPOR
#define YAPEnterCriticalSection() \ #define YAPEnterCriticalSection() \
{ \ { \

View File

@ -18,7 +18,8 @@
% This one should come first so that disjunctions and long distance % This one should come first so that disjunctions and long distance
% cuts are compiled right with co-routining. % cuts are compiled right with co-routining.
% %
true :- true. % otherwise, $$compile will ignore this clause.
true :- true.
'$live' :- '$live' :-
'$init_system', '$init_system',
@ -679,7 +680,7 @@ incore(G) :- '$execute'(G).
'$last_execute_within'(B). '$last_execute_within'(B).
% Be careful with -> cutting through % Be careful with -> cutting through
';'(A,B) :- (A = ( T->G) -> (A;B) :- (A = ( T->G) ->
( '$execute_within'(T) -> '$execute_within'(G) ; '$execute_within'(A) ; '$execute_within'(B) ) ( '$execute_within'(T) -> '$execute_within'(G) ; '$execute_within'(A) ; '$execute_within'(B) )
; ;
( '$execute_within'(A) ; '$execute_within'(B) ) ). ( '$execute_within'(A) ; '$execute_within'(B) ) ).