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

threads, clean signals, and much more...

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@957 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-01-23 02:23:51 +00:00
parent 437a6a19ab
commit ba9876268f
54 changed files with 17285 additions and 6361 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

407
C/absmi.c
View File

@ -211,7 +211,11 @@ Yap_absmi(int inp)
init_absmi_regs(&absmi_regs);
/* the registers are all set up, let's swap */
#ifdef THREADS
pthread_setspecific(yaamregs_key, (const void *)&absmi_regs);
#else
Yap_regp = &absmi_regs;
#endif
#undef Yap_REGS
#define Yap_REGS absmi_regs
@ -285,16 +289,18 @@ Yap_absmi(int inp)
#endif /* USE_THREADED_CODE */
noheapleft:
CFREG = CalculateStackGap();
saveregs();
if (NOfAtoms > 2*AtomHashTableSize) {
Yap_growatomtable();
} else if (!Yap_growheap(FALSE, 0)) {
} else if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
setregs();
FAIL();
}
setregs();
ActiveSignals &= ~YAP_CDOVF_SIGNAL;
if (!ActiveSignals)
CFREG = CalculateStackGap();
goto reset_absmi;
#if !OS_HANDLES_TR_OVERFLOW
@ -1437,17 +1443,6 @@ Yap_absmi(int inp)
/* fail */
PBOp(op_fail, e);
#ifndef NO_CHECKING
/* the fail builtin may end a loop of C builtins,
and some of these built-ins may grow the heap. */
#ifdef YAPOR
if (HeapTop > Yap_GlobalBase - MinHeapGap)
goto noheapleft_in_fail;
#else
if (HeapTop > Addr(AuxSp) - MinHeapGap)
goto noheapleft_in_fail;
#endif /* YAPOR */
#endif
fail:
{
@ -1723,10 +1718,6 @@ Yap_absmi(int inp)
}
ENDPBOp();
noheapleft_in_fail:
ASP = (CELL *)B;
goto noheapleft;
/************************************************************************\
@ -1949,32 +1940,14 @@ Yap_absmi(int inp)
ENDBOp();
NoStackExecute:
if (CFREG == (CELL)(LCL0+2)) {
PredEntry *ap = PREG->u.p.p;
if (ap->PredFlags & HiddenPredFlag) {
/* we have to execute the instruction without performing the test */
CACHE_Y_AS_ENV(YREG);
CACHE_A1();
ALWAYS_LOOKAHEAD(ap->OpcodeOfPred);
PREG = ap->CodeOfPred;
E_YREG[E_CB] = (CELL)B;
check_depth(DEPTH, ap);
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
ENDCACHE_Y_AS_ENV();
} else {
SREG = (CELL *) ap;
goto creep;
}
}
SREG = (CELL *) PREG->u.p.p;
if (CFREG == (CELL)(LCL0+1)) {
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ASP = YREG+E_CB;
if (ASP > (CELL *)B)
ASP = (CELL *)B;
goto noheapleft;
}
if (CFREG != CalculateStackGap())
if (ActiveSignals)
goto creep;
else
goto NoStackExec;
@ -2105,7 +2078,7 @@ Yap_absmi(int inp)
NoStackCall:
/* on X86 machines S will not actually be holding the pointer to pred */
if (CFREG == (CELL)(LCL0+2)) {
if (ActiveSignals == YAP_CREEP_SIGNAL) {
PredEntry *ap = PREG->u.sla.sla_u.p;
if (ap->PredFlags & HiddenPredFlag) {
CACHE_Y_AS_ENV(YREG);
@ -2146,22 +2119,15 @@ Yap_absmi(int inp)
}
}
SREG = (CELL *) PREG->u.sla.sla_u.p;
if (CFREG == (CELL)(LCL0+1)) {
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s);
if (ASP > (CELL *)B)
ASP = (CELL *)B;
goto noheapleft;
}
#ifdef COROUTINING
if (CFREG == Unsigned(LCL0)) {
if (Yap_ReadTimedVar(WokenGoals) != TermNil)
goto creepc;
else {
CFREG = CalculateStackGap();
JMPNext();
}
if (ActiveSignals) {
goto creepc;
}
#endif
ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s);
if (ASP > (CELL *)B)
ASP = (CELL *)B;
@ -2179,7 +2145,7 @@ Yap_absmi(int inp)
so I don't need to redo it.
*/
NoStackDeallocate:
if (CFREG == (CELL)(LCL0+2)) {
if (ActiveSignals == YAP_CREEP_SIGNAL) {
GONext();
}
ASP = YREG;
@ -2187,29 +2153,21 @@ Yap_absmi(int inp)
if (SREG <= ASP) {
ASP = SREG-EnvSizeInCells;
}
if (CFREG == (CELL)(LCL0+1)) {
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
goto noheapleft;
}
#ifdef COROUTINING
if (CFREG == Unsigned(LCL0)) {
if (Yap_ReadTimedVar(WokenGoals) != TermNil) {
if (Yap_op_from_opcode(PREG->opc) == _cut_e) {
/* followed by a cut */
ARG1 = MkIntegerTerm(LCL0-(CELL *)SREG[E_CB]);
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorCutBy,1));
} else {
SREG = (CELL *)RepPredProp(Yap_GetPredPropByAtom(AtomTrue,0));
}
goto creep;
if (ActiveSignals) {
if (Yap_op_from_opcode(PREG->opc) == _cut_e) {
/* followed by a cut */
ARG1 = MkIntegerTerm(LCL0-(CELL *)SREG[E_CB]);
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorCutBy,1));
} else {
CFREG = CalculateStackGap();
JMPNext();
SREG = (CELL *)RepPredProp(Yap_GetPredPropByAtom(AtomTrue,0));
}
goto creep;
}
#endif
if (CFREG != CalculateStackGap()) {
GONext();
}
saveregs();
if (!Yap_gc(0, ENV, CPREG)) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
@ -2222,7 +2180,7 @@ Yap_absmi(int inp)
/* This is easier: I know there is an environment so I cannot do allocate */
NoStackCommitY:
/* find something to fool S */
if (CFREG == Unsigned(LCL0) && Yap_ReadTimedVar(WokenGoals) != TermNil) {
if (ActiveSignals != YAP_CREEP_SIGNAL) {
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(AtomRestoreRegs,2),0));
XREGS[0] = YREG[PREG->u.y.y];
PREG = NEXTOP(PREG,y);
@ -2234,7 +2192,7 @@ Yap_absmi(int inp)
/* Problem: have I got an environment or not? */
NoStackCommitX:
/* find something to fool S */
if (CFREG == Unsigned(LCL0) && Yap_ReadTimedVar(WokenGoals) != TermNil) {
if (ActiveSignals != YAP_CREEP_SIGNAL) {
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(AtomRestoreRegs,2),0));
#if USE_THREADED_CODE
if (PREG->opc == (OPCODE)OpAddress[_fcall])
@ -2260,24 +2218,19 @@ Yap_absmi(int inp)
/* don't forget I cannot creep at ; */
NoStackEither:
if (ActiveSignals == YAP_CREEP_SIGNAL) {
goto either_notest;
}
/* find something to fool S */
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(AtomRestoreRegs,1),0));
if (CFREG == (CELL)(LCL0+1)) {
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s);
if (ASP > (CELL *)B)
ASP = (CELL *)B;
goto noheapleft;
}
if (CFREG == Unsigned(LCL0)) {
if (Yap_ReadTimedVar(WokenGoals) != TermNil)
goto creep_either;
else {
CFREG = CalculateStackGap();
JMPNext();
}
}
if (CFREG != CalculateStackGap()) {
goto either_notest;
if (ActiveSignals) {
goto creep_either;
}
ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s);
if (ASP > (CELL *)B)
@ -2341,7 +2294,7 @@ Yap_absmi(int inp)
goto creep;
NoStackDExecute:
if (CFREG == (CELL)(LCL0+2)) {
if (ActiveSignals == YAP_CREEP_SIGNAL) {
PredEntry *ap = PREG->u.p.p;
if (ap->PredFlags & HiddenPredFlag) {
@ -2384,23 +2337,13 @@ Yap_absmi(int inp)
}
/* set SREG for next instructions */
SREG = (CELL *) PREG->u.p.p;
if (CFREG == (CELL)(LCL0+1)) {
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ASP = YREG+E_CB;
if (ASP > (CELL *)B)
ASP = (CELL *)B;
goto noheapleft;
}
#ifdef COROUTINING
if (CFREG == Unsigned(LCL0)) {
if (Yap_ReadTimedVar(WokenGoals) != TermNil)
goto creepde;
else {
CFREG = CalculateStackGap();
JMPNext();
}
}
#endif
if (CFREG != CalculateStackGap())
if (ActiveSignals)
goto creepde;
/* try performing garbage collection */
@ -2463,168 +2406,90 @@ Yap_absmi(int inp)
/* and now CREEP */
creep:
#ifdef COROUTINING
/* If I was not in creep mode, I have to unfold all woken
* goals first.
* Notice there might be a problem with
* backtracking. I do not trail operations on WokenGoals,
* hence Woken Goals is not restored on backtracking. This
* is not a problem if suspended goals are quickly pushed onto
* the stack for execution. In other words, WakeUpCode
* *cannot* fail before having woken up all suspended goals.
*/
/* make sure we are here because of an awoken goal */
if (CFREG == Unsigned(LCL0) && !(Yap_PrologMode & (InterruptMode|AbortMode))) {
Term WGs;
Term my_goal;
WGs = Yap_ReadTimedVar(WokenGoals);
my_goal = AbsAppl(H);
if (WGs != TermNil) {
#if SHADOW_S
/* save S for ModuleName() */
S = SREG;
#endif
BEGD(d0);
d0 = ((PredEntry *)(SREG))->ArityOfPE;
if (d0 == 0) {
my_goal = MkAtomTerm((Atom)((PredEntry *)(SREG))->FunctorOfPred);
}
else {
my_goal = AbsAppl(H);
*H = (CELL) ((PredEntry *)(SREG))->FunctorOfPred;
H++;
BEGP(pt1);
pt1 = XREGS + 1;
for (; d0 > 0; --d0) {
BEGD(d1);
BEGP(pt0);
pt0 = pt1;
d1 = *pt0;
deref_head(d1, wake_up_unk);
wake_up_nonvar:
pt1++;
/* just copy it to the heap */
*H++ = d1;
continue;
derefa_body(d1, pt0, wake_up_unk, wake_up_nonvar);
/* bind it, in case it is a local variable */
if (pt0 <= H) {
/* variable is safe */
*H++ = (CELL)pt0;
pt1++;
} else {
d1 = Unsigned(H);
RESET_VARIABLE(H);
pt1++;
H += 1;
Bind_Local(pt0, d1);
}
/* notice I am incrementing H */
ENDP(pt0);
ENDD(d1);
}
ENDP(pt1);
}
ENDD(d0);
H[0] = Yap_Module_Name((CODEADDR)SREG);
H[1] = my_goal;
ARG1 = AbsPair(H);
H += 2;
ARG2 = Yap_ListOfWokenGoals();
SREG = (CELL *) (WakeUpCode);
/* no more goals to wake up */
Yap_UpdateTimedVar(WokenGoals, TermNil);
CFREG = CalculateStackGap();
}
else {
CFREG = CalculateStackGap();
/* We haven't changed P yet so this means redo the
* same instruction */
JMPNext();
}
}
else {
#endif
#if _MSC_VER || defined(__MINGW32__)
/* I need this for Windows and other systems where SIGINT
is not proceesed by same thread as absmi */
if (Yap_PrologMode & (AbortMode|InterruptMode)) {
CFREG = CalculateStackGap();
/* same instruction */
if (Yap_PrologMode & InterruptMode) {
Yap_PrologMode &= ~InterruptMode;
ASP = YREG+E_CB;
if (ASP > (CELL *)B)
ASP = (CELL *)B;
saveregs();
Yap_ProcessSIGINT();
setregs();
}
JMPNext();
}
#endif
#if SHADOW_S
S = SREG;
#endif
BEGD(d0);
d0 = ((PredEntry *)(SREG))->ArityOfPE;
if (d0 == 0) {
H[1] = MkAtomTerm((Atom) ((PredEntry *)(SREG))->FunctorOfPred);
}
else {
H[d0 + 2] = AbsAppl(H);
*H = (CELL) ((PredEntry *)(SREG))->FunctorOfPred;
H++;
BEGP(pt1);
pt1 = XREGS + 1;
for (; d0 > 0; --d0) {
BEGD(d1);
BEGP(pt0);
pt0 = pt1;
d1 = *pt0;
deref_head(d1, creep_unk);
creep_nonvar:
/* just copy it to the heap */
pt1++;
*H++ = d1;
continue;
derefa_body(d1, pt0, creep_unk, creep_nonvar);
if (pt0 <= H) {
/* variable is safe */
*H++ = (CELL)pt0;
pt1++;
} else {
/* bind it, in case it is a local variable */
d1 = Unsigned(H);
RESET_VARIABLE(H);
pt1++;
H += 1;
Bind_Local(pt0, d1);
}
ENDP(pt0);
ENDD(d1);
}
ENDP(pt1);
}
ENDD(d0);
H[0] = Yap_Module_Name(((CODEADDR)(SREG)));
ARG1 = (Term) AbsPair(H);
H += 2;
if (Yap_PrologMode & (AbortMode|InterruptMode)) {
CFREG = CalculateStackGap();
SREG = (CELL *) CreepCode;
#ifdef COROUTINING
/* same instruction */
if (Yap_PrologMode & InterruptMode) {
Yap_PrologMode &= ~InterruptMode;
ASP = YREG+E_CB;
if (ASP > (CELL *)B)
ASP = (CELL *)B;
saveregs();
Yap_ProcessSIGINT();
setregs();
}
JMPNext();
}
#endif
#if SHADOW_S
S = SREG;
#endif
BEGD(d0);
d0 = ((PredEntry *)(SREG))->ArityOfPE;
if (d0 == 0) {
H[1] = MkAtomTerm((Atom) ((PredEntry *)(SREG))->FunctorOfPred);
}
else {
H[d0 + 2] = AbsAppl(H);
*H = (CELL) ((PredEntry *)(SREG))->FunctorOfPred;
H++;
BEGP(pt1);
pt1 = XREGS + 1;
for (; d0 > 0; --d0) {
BEGD(d1);
BEGP(pt0);
pt0 = pt1;
d1 = *pt0;
deref_head(d1, creep_unk);
creep_nonvar:
/* just copy it to the heap */
pt1++;
*H++ = d1;
continue;
derefa_body(d1, pt0, creep_unk, creep_nonvar);
if (pt0 <= H) {
/* variable is safe */
*H++ = (CELL)pt0;
pt1++;
} else {
/* bind it, in case it is a local variable */
d1 = Unsigned(H);
RESET_VARIABLE(H);
pt1++;
H += 1;
Bind_Local(pt0, d1);
}
ENDP(pt0);
ENDD(d1);
}
ENDP(pt1);
}
ENDD(d0);
H[0] = Yap_Module_Name(((CODEADDR)(SREG)));
ARG1 = (Term) AbsPair(H);
H += 2;
CFREG = CalculateStackGap();
#ifdef COROUTINING
if (ActiveSignals & YAP_WAKEUP_SIGNAL) {
ARG2 = Yap_ListOfWokenGoals();
SREG = (CELL *) (WakeUpCode);
/* no more goals to wake up */
Yap_UpdateTimedVar(WokenGoals, TermNil);
ActiveSignals &= ~YAP_WAKEUP_SIGNAL;
} else
#endif
SREG = (CELL *) CreepCode;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,(PredEntry *)(SREG),XREGS+1);
#endif /* LOW_LEVEL_TRACE */
PREG = ((PredEntry *)(SREG))->CodeOfPred;
CFREG = CalculateStackGap();
CACHE_A1();
JMPNext();
@ -5983,8 +5848,8 @@ Yap_absmi(int inp)
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackEither, H);
ENDCACHE_Y_AS_ENV();
either_notest:
#endif
either_notest:
BEGD(d0);
/* Try to preserve the environment */
d0 = PREG->u.sla.s;
@ -11471,17 +11336,7 @@ Yap_absmi(int inp)
/* setup GB */
WRITEBACK_Y_AS_ENV();
YREG[E_CB] = (CELL) B;
#ifdef COROUTINING
if (CFREG == Unsigned(LCL0)) {
if (Yap_ReadTimedVar(WokenGoals) != TermNil)
goto creep_pe;
else {
CFREG = CalculateStackGap();
goto execute_end;
}
}
#endif
if (CFREG != CalculateStackGap())
if (ActiveSignals)
goto creep_pe;
saveregs_and_ycache();
if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, sla))) {
@ -11712,52 +11567,20 @@ Yap_absmi(int inp)
WRITEBACK_Y_AS_ENV();
SREG = (CELL *) pen;
ASP = E_YREG;
if (CFREG == (CELL)(LCL0+1)) {
CFREG = CalculateStackGap();
ActiveSignals &= ~YAP_CDOVF_SIGNAL;
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
saveregs_and_ycache();
if (!Yap_growheap(FALSE, 0)) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
setregs_and_ycache();
FAIL();
}
setregs_and_ycache();
goto execute_after_comma;
CFREG = CalculateStackGap();
}
#ifdef COROUTINING
if (CFREG == Unsigned(LCL0)) {
if (Yap_ReadTimedVar(WokenGoals) != TermNil)
goto execute_after_comma;
else {
CFREG = CalculateStackGap();
goto execute_after_comma;
}
if (ActiveSignals) {
goto creep;
}
#endif
/* debugger */
if (CFREG == (CELL)(LCL0+2)) {
if (pen->PredFlags & HiddenPredFlag) {
PREG = pen->CodeOfPred;
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
E_YREG[E_CB] = (CELL)B;
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pen->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (pen->ModuleOfPred) {
DEPTH -= MkIntConstant(2);
}
#endif /* DEPTH_LIMIT */
/* do deallocate */
WRITEBACK_Y_AS_ENV();
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
} else goto creep;
}
if (CFREG != CalculateStackGap())
goto execute_after_comma;
ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s);
if (ASP > (CELL *)B)
ASP = (CELL *)B;

3
C/adtdefs.c
View File

@ -26,6 +26,7 @@ static char SccsId[] = "%W% %G%";
#endif
#include "Yap.h"
ADDR STD_PROTO(Yap_PreAllocCodeSpace, (void));
Prop STD_PROTO(PredPropByFunc,(Functor, SMALLUNSGN));
Prop STD_PROTO(PredPropByAtom,(Atom, SMALLUNSGN));
#include "Yatom.h"
@ -184,7 +185,7 @@ LookupAtom(char *atom)
INIT_RWLOCK(ae->ARWLock);
WRITE_UNLOCK(HashChain[hash].AERWLock);
if (NOfAtoms > 2*AtomHashTableSize) {
CreepFlag = Unsigned(LCL0+1);
Yap_signal(YAP_CDOVF_SIGNAL);
}
return na;
}

287
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.42 2003-11-28 01:26:53 vsc Exp $ *
* version:$Id: alloc.c,v 1.43 2004-01-23 02:20:59 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -48,6 +48,186 @@ static char SccsId[] = "%W% %G%";
#endif
#endif
#define K ((Int) 1024)
/************************************************************************/
/* Yap workspace management */
#if THREADS
#define USE_SYSTEM_MALLOC 1
#endif
#if USE_SYSTEM_MALLOC
int
Yap_SizeOfBlock(CODEADDR p)
{
return ((UInt *)p)[-1];
}
char *
Yap_AllocCodeSpace(unsigned int size)
{
char *ptr = malloc(size+sizeof(UInt));
UInt *pi = (UInt *)ptr;
pi[0] = size;
return (char *)(pi+1);
}
void
Yap_FreeCodeSpace(char *p)
{
free (p-sizeof(UInt));
}
char *
Yap_AllocAtomSpace(unsigned int size)
{
char *ptr = malloc(size+sizeof(UInt));
UInt *pi = (UInt *)ptr;
pi[0] = size;
return (char *)(pi+1);
}
void
Yap_FreeAtomSpace(char *p)
{
free (p-sizeof(UInt));
}
/* If you need to dinamically allocate space from the heap, this is
* the macro you should use */
ADDR
Yap_PreAllocCodeSpace(void)
{
char *ptr;
UInt sz = ScratchPad.msz;
if (ScratchPad.ptr == NULL) {
while (!(ptr = malloc(sz)))
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(NULL);
}
ScratchPad.ptr = ptr;
} else {
ptr = ScratchPad.ptr;
}
AuxSp = (CELL *)(AuxTop = (ADDR)(ptr+ScratchPad.sz));
return ptr;
}
ADDR
Yap_ExpandPreAllocCodeSpace(void)
{
char *ptr;
UInt sz = ScratchPad.msz;
ScratchPad.msz =
ScratchPad.sz =
sz = sz + SCRATCH_INC_SIZE;
if (!(ptr = malloc(sz)))
return NULL;
ScratchPad.ptr = ptr;
AuxSp = (CELL *)(AuxTop = ptr+sz);
return ptr;
}
/* Grabbing the HeapTop is an excellent idea for a sequential system,
but does work as well in parallel systems. Anyway, this will do for now */
void
Yap_ReleasePreAllocCodeSpace(ADDR ptr)
{
}
struct various_codes *heap_regs;
static void
InitHeap(void)
{
heap_regs = (struct various_codes *)malloc(sizeof(struct various_codes));
}
void
Yap_InitHeap(void *heap_addr)
{
InitHeap();
}
static void
InitExStacks(int Trail, int Stack)
{
UInt pm, sa, ta;
/* sanity checking for data areas */
if (Trail < MinTrailSpace)
Trail = MinTrailSpace;
if (Stack < MinStackSpace)
Stack = MinStackSpace;
pm = (Trail + Stack)*K; /* memory to be
* requested */
sa = Stack*K; /* stack area size */
Yap_GlobalBase = malloc(pm);
Yap_TrailTop = Yap_GlobalBase + pm;
Yap_LocalBase = Yap_GlobalBase + sa;
Yap_TrailBase = Yap_LocalBase + sizeof(CELL);
AuxSp = NULL;
#ifdef DEBUG
if (Yap_output_msg) {
fprintf(stderr, "HeapBase = %p GlobalBase = %p\n LocalBase = %p TrailTop = %p\n",
Yap_HeapBase, Yap_GlobalBase, Yap_LocalBase, Yap_TrailTop);
ta = Trail*K; /* trail area size */
fprintf(stderr, "Heap+Aux: %ld\tLocal+Global: %uld\tTrail: %uld\n",
(long int)(pm - sa - ta), (unsigned long int)sa, (unsigned long int)ta);
}
#endif /* DEBUG */
}
void
Yap_InitExStacks(int Trail, int Stack)
{
InitExStacks(Trail, Stack);
}
void
Yap_KillStacks(void)
{
if (Yap_GlobalBase) {
free(Yap_GlobalBase);
Yap_GlobalBase = NULL;
}
}
void
Yap_InitMemory(int Trail, int Heap, int Stack)
{
InitHeap();
InitExStacks(Trail, Stack);
}
int
Yap_ExtendWorkSpace(Int s)
{
return -1;
}
UInt
Yap_ExtendWorkSpaceThroughHole(UInt s)
{
return -1;
}
void
Yap_AllocHole(UInt actual_request, UInt total_size)
{
}
#else
#if HAVE_SNPRINTF
#define snprintf3(A,B,C) snprintf(A,B,C)
#define snprintf4(A,B,C,D) snprintf(A,B,C,D)
@ -68,13 +248,8 @@ STATIC_PROTO(void AddToFreeList, (BlockHeader *));
#include <stdlib.h>
#endif
#define K ((Int) 1024)
#define MinHGap 256*K
/************************************************************************/
/* Yap workspace management */
int
Yap_SizeOfBlock(CODEADDR p)
{
@ -187,10 +362,7 @@ FreeBlock(BlockHeader *b)
RemoveFromFreeList(p);
b->b_size += p->b_size + 1;
}
/* check if we are the HeapTop */
if (!HEAPTOP_OWNER(worker_id)) {
LOCK(HeapTopLock);
}
LOCK(HeapTopLock);
if (sp == (YAP_SEG_SIZE *)HeapTop) {
LOCK(HeapUsedLock);
HeapUsed -= (b->b_size + 1) * sizeof(YAP_SEG_SIZE);
@ -201,9 +373,7 @@ FreeBlock(BlockHeader *b)
/* insert on list of free blocks */
AddToFreeList(b);
}
if (!HEAPTOP_OWNER(worker_id)) {
UNLOCK(HeapTopLock);
}
UNLOCK(HeapTopLock);
UNLOCK(FreeBlocksLock);
}
@ -277,10 +447,8 @@ AllocHeap(unsigned int size)
UNLOCK(FreeBlocksLock);
return (Addr(b) + sizeof(YAP_SEG_SIZE));
}
LOCK(HeapTopLock);
UNLOCK(FreeBlocksLock);
if (!HEAPTOP_OWNER(worker_id)) {
LOCK(HeapTopLock);
}
b = (BlockHeader *) HeapTop;
HeapTop += size * sizeof(CELL) + sizeof(YAP_SEG_SIZE);
LOCK(HeapUsedLock);
@ -291,35 +459,29 @@ AllocHeap(unsigned int size)
abort_optyap("No heap left in function AllocHeap");
}
#else
if (HeapTop > Addr(AuxSp) - MinHeapGap) {
if (HeapTop > HeapLim - MinHeapGap) {
HeapTop -= size * sizeof(CELL) + sizeof(YAP_SEG_SIZE);
HeapUsed -= size * sizeof(CELL) + sizeof(YAP_SEG_SIZE);
if (HeapTop > Addr(AuxSp)) {
if (HeapTop > HeapLim) {
UNLOCK(HeapUsedLock);
if (!HEAPTOP_OWNER(worker_id)) {
UNLOCK(HeapTopLock);
}
UNLOCK(HeapTopLock);
/* we destroyed the stack */
Yap_Error(SYSTEM_ERROR, TermNil, "Stack Crashed against Heap...");
return(NULL);
} else {
if (HeapTop + size * sizeof(CELL) + sizeof(YAP_SEG_SIZE) < Addr(AuxSp)) {
if (HeapTop + size * sizeof(CELL) + sizeof(YAP_SEG_SIZE) < HeapLim) {
/* small allocations, we can wait */
HeapTop += size * sizeof(CELL) + sizeof(YAP_SEG_SIZE);
HeapUsed += size * sizeof(CELL) + sizeof(YAP_SEG_SIZE);
UNLOCK(HeapUsedLock);
if (!HEAPTOP_OWNER(worker_id)) {
UNLOCK(HeapTopLock);
}
CreepFlag = Unsigned(LCL0+1);
UNLOCK(HeapTopLock);
Yap_signal(YAP_CDOVF_SIGNAL);
} else {
if (size > SizeOfOverflow)
SizeOfOverflow = size*sizeof(CELL) + sizeof(YAP_SEG_SIZE);
/* big allocations, the caller must handle the problem */
UNLOCK(HeapUsedLock);
if (!HEAPTOP_OWNER(worker_id)) {
UNLOCK(HeapTopLock);
}
UNLOCK(HeapTopLock);
return(NULL);
}
}
@ -328,38 +490,14 @@ AllocHeap(unsigned int size)
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
if (HeapUsed > HeapMax)
HeapMax = HeapUsed;
HeapPlus = HeapTop + MinHGap / CellSize;
UNLOCK(HeapUsedLock);
b->b_size = size | InUseFlag;
sp = &(b->b_size) + size;
*sp = b->b_size;
if (!HEAPTOP_OWNER(worker_id)) {
UNLOCK(HeapTopLock);
}
UNLOCK(HeapTopLock);
return (Addr(b) + sizeof(YAP_SEG_SIZE));
}
/* If you need to dinamically allocate space from the heap, this is
* the macro you should use */
ADDR
Yap_PreAllocCodeSpace(void)
{
LOCK(HeapTopLock);
HEAPTOP_OWN(worker_id);
return (Addr(HeapTop) + sizeof(YAP_SEG_SIZE));
}
#if defined(YAPOR) || defined(THREADS)
/* Grabbing the HeapTop is an excellent idea for a sequential system,
but does work as well in parallel systems. Anyway, this will do for now */
void
Yap_ReleasePreAllocCodeSpace(ADDR ptr)
{
HEAPTOP_DISOWN(worker_id);
UNLOCK(HeapTopLock);
}
#endif
/* If you need to dinamically allocate space from the heap, this is
* the macro you should use */
static void
@ -402,6 +540,7 @@ Yap_AllocCodeSpace(unsigned int size)
return AllocCodeSpace(size);
}
/************************************************************************/
/* Workspace allocation */
/* */
@ -1053,6 +1192,10 @@ InitHeap(void *heap_addr)
/* reserve space for specially allocated functors and atoms so that
their values can be known statically */
HeapTop = Yap_HeapBase + AdjustSize(sizeof(all_heap_codes));
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
/* guarantee blocks always start at even addresses */
HeapTop += sizeof(YAP_SEG_SIZE);
#endif
HeapMax = HeapUsed = HeapTop-Yap_HeapBase;
@ -1061,9 +1204,7 @@ InitHeap(void *heap_addr)
HeapTop = HeapTop + sizeof(YAP_SEG_SIZE);
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
HeapPlus = HeapTop + MinHGap / CellSize;
FreeBlocks = NIL;
HEAPTOP_DISOWN(worker_id);
#if defined(YAPOR) || defined(TABLING)
#ifdef USE_HEAP
@ -1089,7 +1230,27 @@ Yap_InitMemory(int Trail, int Heap, int Stack)
{
Int pm, sa, ta;
#if defined(YAPOR) || defined(TABLING)
{
#ifdef USE_HEAP
int OKHeap = MinHeapSpace+(sizeof(struct global_data) + aux_number_workers*sizeof(struct local_data))/1024;
#else
int OKHeap = MinHeapSpace+(sizeof(struct global_data) + aux_number_workers*sizeof(struct local_data)+OPT_CHUNK_SIZE)/1024;
#endif
if (Heap < OKHeap)
Heap = OKHeap;
}
#else
if (Heap < MinHeapSpace)
Heap = MinHeapSpace;
#endif /* YAPOR || TABLING */
/* sanity checking for data areas */
if (Trail < MinTrailSpace)
Trail = MinTrailSpace;
Trail = AdjustPageSize(Trail * K);
if (Stack < MinStackSpace)
Stack = MinStackSpace;
Stack = AdjustPageSize(Stack * K);
Heap = AdjustPageSize(Heap * K);
@ -1105,9 +1266,10 @@ Yap_InitMemory(int Trail, int Heap, int Stack)
Yap_TrailBase = Yap_LocalBase + sizeof(CELL);
Yap_GlobalBase = Yap_LocalBase - sa;
AuxTop = Yap_GlobalBase - CellSize; /* avoid confusions while
HeapLim = Yap_GlobalBase; /* avoid confusions while
* * restoring */
AuxSp = (CELL *) AuxTop;
AuxTop = (ADDR)(AuxSp = (CELL *)Yap_GlobalBase);
#ifdef DEBUG
#if SIZEOF_INT_P!=SIZEOF_INT
@ -1133,6 +1295,11 @@ Yap_InitMemory(int Trail, int Heap, int Stack)
}
void
Yap_InitExStacks(int Trail, int Stack)
{
}
int
Yap_ExtendWorkSpace(Int s)
{
@ -1177,3 +1344,7 @@ Yap_AllocHole(UInt actual_request, UInt total_size)
AddToFreeList(newb);
#endif
}
#endif /* USE_SYSTEM_MALLOC */

1742
C/amasm.c
View File

File diff suppressed because it is too large Load Diff

6
C/arrays.c
View File

@ -446,7 +446,7 @@ AllocateStaticArraySpace(StaticArrayEntry *p, static_array_types atype, Int arra
}
while ((p->ValueOfVE.floats = (Float *) Yap_AllocAtomSpace(asize) ) == NULL) {
YAPLeaveCriticalSection();
if (!Yap_growheap(FALSE, asize)) {
if (!Yap_growheap(FALSE, asize, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return;
}
@ -460,7 +460,7 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star
{
if (EndOfPAEntr(p)) {
while ((p = (StaticArrayEntry *) Yap_AllocAtomSpace(sizeof(*p))) == NULL) {
if (!Yap_growheap(FALSE, sizeof(*p))) {
if (!Yap_growheap(FALSE, sizeof(*p), NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return NULL;
}
@ -1169,7 +1169,7 @@ p_create_mmapped_array(void)
#endif
}
/* This routine verifies whether a complex has variables. */
/* This routine removes array references from complex terms? */
static void
replace_array_references_complex(register CELL *pt0,
register CELL *pt0_end,

6
C/attvar.c
View File

@ -54,8 +54,7 @@ AddToQueue(attvar_record *attv)
if ((Term)WGs == TermNil) {
Yap_UpdateTimedVar(WokenGoals, (CELL)new);
/* from now on, we have to start waking up goals */
if (CreepFlag != Unsigned(LCL0) - Unsigned(H0))
CreepFlag = Unsigned(LCL0);
Yap_signal(YAP_WAKEUP_SIGNAL);
} else {
/* add to the end of the current list of suspended goals */
CELL *where_to = (CELL *)Deref((CELL)WGs);
@ -81,8 +80,7 @@ AddFailToQueue(void)
if ((Term)WGs == TermNil) {
Yap_UpdateTimedVar(WokenGoals, (CELL)new);
/* from now on, we have to start waking up goals */
if (CreepFlag != Unsigned(LCL0) - Unsigned(H0))
CreepFlag = Unsigned(LCL0);
Yap_signal(YAP_WAKEUP_SIGNAL);
} else {
/* add to the end of the current list of suspended goals */
CELL *where_to = (CELL *)Deref((CELL)WGs);

7
C/c_interface.c
View File

@ -591,7 +591,7 @@ YAP_AllocSpaceFromYap(unsigned int size)
BACKUP_MACHINE_REGS();
if ((ptr = Yap_AllocCodeSpace(size)) == NULL) {
if (!Yap_growheap(FALSE, size)) {
if (!Yap_growheap(FALSE, size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(NULL);
}
@ -835,7 +835,6 @@ YAP_Write(Term t, void (*myputc)(int), int flags)
X_API char *
YAP_CompileClause(Term t)
{
char *Yap_ErrorMessage;
yamop *codeaddr;
int mod = CurrentModule;
@ -890,11 +889,12 @@ YAP_Init(YAP_init_args *yap_init)
Heap = yap_init->HeapSize;
}
Yap_InitStacks (Heap, Stack, Trail,
Yap_InitWorkspace(Heap, Stack, Trail,
yap_init->NumberWorkers,
yap_init->SchedulerLoop,
yap_init->DelayedReleaseLoad
);
Yap_InitExStacks (Stack, Trail);
Yap_InitYaamRegs();
#if HAVE_MPI
@ -975,6 +975,7 @@ YAP_FastInit(char saved_state[])
init_args.TrailSize = 0;
init_args.YapLibDir = NULL;
init_args.YapPrologBootFile = NULL;
init_args.YapPrologInitFile = NULL;
init_args.YapPrologRCFile = NULL;
init_args.HaltAfterConsult = FALSE;
init_args.FastBoot = FALSE;

2
C/cdmgr.c
View File

@ -928,7 +928,7 @@ static void expand_consult(void)
ConsultCapacity += InitialConsultCapacity;
/* I assume it always works ;-) */
while ((new_cl = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj)*ConsultCapacity)) == NULL) {
if (!Yap_growheap(FALSE, sizeof(consult_obj)*ConsultCapacity)) {
if (!Yap_growheap(FALSE, sizeof(consult_obj)*ConsultCapacity, NULL)) {
Yap_Error(SYSTEM_ERROR,TermNil,Yap_ErrorMessage);
return;
}

1684
C/compiler.c
View File

File diff suppressed because it is too large Load Diff

100
C/computils.c
View File

@ -33,7 +33,7 @@ static char SccsId[] = "%W% %G%";
#endif
#ifdef DEBUG
STATIC_PROTO (void ShowOp, (char *));
STATIC_PROTO (void ShowOp, (char *, struct PSEUDO *));
#endif /* DEBUG */
/*
@ -42,11 +42,6 @@ STATIC_PROTO (void ShowOp, (char *));
*/
#ifdef DEBUG
static Int arg, rn;
static compiler_vm_op ic;
static CELL *cptr;
char Yap_Option[20];
@ -54,28 +49,28 @@ YP_FILE *Yap_logfile;
#endif
static char *
AllocCMem (int size)
AllocCMem (int size, struct intermediates *cip)
{
char *p;
p = freep;
p = cip->freep;
#if SIZEOF_INT_P==8
size = (size + 7) & 0xfffffffffffffff8L;
#else
size = (size + 3) & 0xfffffffcL;
#endif
freep += size;
if (ASP <= CellPtr (freep) + 256) {
Yap_Error_Size = 256+((char *)freep - (char *)H);
cip->freep += size;
if (ASP <= CellPtr (cip->freep) + 256) {
Yap_Error_Size = 256+((char *)cip->freep - (char *)H);
save_machine_regs();
longjmp(Yap_CompilerBotch,3);
longjmp(cip->CompilerBotch,3);
}
return (p);
}
char *
Yap_AllocCMem (int size)
Yap_AllocCMem (int size, struct intermediates *cip)
{
return(AllocCMem(size));
return(AllocCMem(size, cip));
}
int
@ -101,75 +96,75 @@ Yap_is_a_test_pred (Term arg, SMALLUNSGN mod)
}
void
Yap_emit (compiler_vm_op o, Int r1, CELL r2)
Yap_emit (compiler_vm_op o, Int r1, CELL r2, struct intermediates *cip)
{
PInstr *p;
p = (PInstr *) AllocCMem (sizeof (*p));
p = (PInstr *) AllocCMem (sizeof (*p), cip);
p->op = o;
p->rnd1 = r1;
p->rnd2 = r2;
p->nextInst = NULL;
if (cpc == NIL) {
cpc = CodeStart = p;
if (cip->cpc == NIL) {
cip->cpc = cip->CodeStart = p;
} else {
cpc->nextInst = p;
cpc = p;
cip->cpc->nextInst = p;
cip->cpc = p;
}
}
void
Yap_emit_3ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3)
Yap_emit_3ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3, struct intermediates *cip)
{
PInstr *p;
p = (PInstr *) AllocCMem (sizeof (*p)+sizeof(CELL));
p = (PInstr *) AllocCMem (sizeof (*p)+sizeof(CELL), cip);
p->op = o;
p->rnd1 = r1;
p->rnd2 = r2;
p->rnd3 = r3;
p->nextInst = NIL;
if (cpc == NIL)
cpc = CodeStart = p;
if (cip->cpc == NIL)
cip->cpc = cip->CodeStart = p;
else
{
cpc->nextInst = p;
cpc = p;
cip->cpc->nextInst = p;
cip->cpc = p;
}
}
void
Yap_emit_4ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3, CELL r4)
Yap_emit_4ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3, CELL r4, struct intermediates *cip)
{
PInstr *p;
p = (PInstr *) AllocCMem (sizeof (*p)+2*sizeof(CELL));
p = (PInstr *) AllocCMem (sizeof (*p)+2*sizeof(CELL), cip);
p->op = o;
p->rnd1 = r1;
p->rnd2 = r2;
p->rnd3 = r3;
p->rnd4 = r4;
p->nextInst = NIL;
if (cpc == NIL)
cpc = CodeStart = p;
if (cip->cpc == NIL)
cip->cpc = cip->CodeStart = p;
else
{
cpc->nextInst = p;
cpc = p;
cip->cpc->nextInst = p;
cip->cpc = p;
}
}
CELL *
Yap_emit_extra_size (compiler_vm_op o, CELL r1, int size)
Yap_emit_extra_size (compiler_vm_op o, CELL r1, int size, struct intermediates *cip)
{
PInstr *p;
p = (PInstr *) AllocCMem (sizeof (*p) + size - CellSize);
p = (PInstr *) AllocCMem (sizeof (*p) + size - CellSize, cip);
p->op = o;
p->rnd1 = r1;
p->nextInst = NIL;
if (cpc == NIL)
cpc = CodeStart = p;
if (cip->cpc == NIL)
cip->cpc = cip->CodeStart = p;
else
{
cpc->nextInst = p;
cpc = p;
cip->cpc->nextInst = p;
cip->cpc = p;
}
return (p->arnds);
}
@ -307,9 +302,13 @@ write_functor(Functor f)
}
static void
ShowOp (char *f)
ShowOp (char *f, struct PSEUDO *cpc)
{
char ch;
Int arg = cpc->rnd1;
Int rn = cpc->rnd2;
CELL *cptr = cpc->arnds;
while ((ch = *f++) != 0)
{
if (ch == '%')
@ -654,24 +653,21 @@ static char *opformat[] =
void
Yap_ShowCode ()
Yap_ShowCode (struct intermediates *cint)
{
CELL *OldH = H;
struct PSEUDO *cpc;
cpc = CodeStart;
cpc = cint->CodeStart;
/* MkIntTerm and friends may build terms in the global stack */
H = (CELL *)freep;
while (cpc)
{
ic = cpc->op;
arg = cpc->rnd1;
rn = cpc->rnd2;
cptr = cpc->arnds;
if (ic != nop_op) {
ShowOp (opformat[ic]);
}
cpc = cpc->nextInst;
H = (CELL *)cint->freep;
while (cpc) {
compiler_vm_op ic = cpc->op;
if (ic != nop_op) {
ShowOp (opformat[ic], cpc);
}
cpc = cpc->nextInst;
}
Yap_DebugPutc (Yap_c_error_stream,'\n');
H = OldH;
}

4
C/corout.c
View File

@ -220,9 +220,7 @@ static void ReleaseGoals(sus_record *from)
CELL *where_to = (CELL *)Deref((CELL)WGs);
Bind_Global(where_to, (CELL)from);
}
/* from now on, we have to start waking up goals */
if (CreepFlag != Unsigned(LCL0) - Unsigned(H0))
CreepFlag = Unsigned(LCL0);
Yap_signal(YAP_WAKEUP_SIGNAL);
}
static void

169
C/dbase.c
View File

@ -631,6 +631,11 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
int *vars_foundp)
{
#if THREADS
#undef Yap_REGS
register REGSTORE *regp = Yap_regp;
#define Yap_REGS (*regp)
#endif
register visitel *visited = (visitel *)AuxSp;
/* store this in H */
register CELL **to_visit = (CELL **)H;
@ -1022,6 +1027,10 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
#endif
return(NULL);
#endif
#if THREADS
#undef Yap_REGS
#define Yap_REGS (*Yap_regp)
#endif /* THREADS */
}
@ -1871,11 +1880,16 @@ p_rcda(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
@ -1911,12 +1925,16 @@ p_rcdap(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
} else {
goto recover_record;
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return FALSE;
@ -1961,11 +1979,16 @@ p_rcda_at(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
@ -2011,18 +2034,23 @@ p_rcdz(void)
case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
return FALSE;
}
goto recover_record;
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
@ -2058,11 +2086,16 @@ p_rcdzp(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
@ -2107,11 +2140,16 @@ p_rcdz_at(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recordz_at/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
@ -2145,7 +2183,7 @@ p_rcdstatp(void)
switch(Yap_Error_TYPE) {
case YAP_NO_ERROR:
return (Yap_unify(ARG4,TRef));
case OUT_OF_HEAP_ERROR:
case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
@ -2153,13 +2191,18 @@ p_rcdstatp(void)
goto recover_record;
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in record_stat_source/3");
return(FALSE);
case OUT_OF_STACK_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
return FALSE;
case OUT_OF_HEAP_ERROR:
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
@ -2198,11 +2241,16 @@ p_drcdap(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
@ -2242,11 +2290,16 @@ p_drcdzp(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
@ -4621,13 +4674,17 @@ StoreTermInDB(Term t, int nargs)
return(FALSE);
case OUT_OF_HEAP_ERROR:
XREGS[nargs+1] = t;
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else {
t = Deref(XREGS[nargs+1]);
break;
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
#ifndef THREADS
break;
#endif
}
t = Deref(XREGS[nargs+1]);
break;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
@ -4657,7 +4714,7 @@ p_init_queue(void)
Term t;
while ((dbq = (db_queue *)AllocDBSpace(sizeof(db_queue))) == NULL) {
if (!Yap_growheap(FALSE, sizeof(db_queue))) {
if (!Yap_growheap(FALSE, sizeof(db_queue), NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}

16
C/exec.c
View File

@ -223,7 +223,7 @@ EnterCreepMode(SMALLUNSGN mod) {
inline static Int
do_execute(Term t, SMALLUNSGN mod)
{
if (CreepFlag == (CELL)(LCL0+2)) {
if (ActiveSignals) {
return(EnterCreepMode(mod));
} else if (PRED_GOAL_EXPANSION_ON) {
return(CallMetaCall(mod));
@ -1362,12 +1362,12 @@ Yap_RunTopGoal(Term t)
READ_LOCK(ppe->PRWLock);
}
if (pe == NIL) {
if (pe != NIL) {
READ_UNLOCK(ppe->PRWLock);
}
/* we must always start the emulator with Prolog code */
return(FALSE);
}
if (pe != NIL) {
READ_UNLOCK(ppe->PRWLock);
}
CodeAdr = ppe->CodeOfPred;
if (Yap_TrailTop - HeapTop < 2048) {
Yap_PrologMode = BootMode;
@ -1555,13 +1555,19 @@ p_generate_pred_info(void) {
void
Yap_InitYaamRegs(void)
{
#if PUSH_REGS
/* Guarantee that after a longjmp we go back to the original abstract
machine registers */
#ifdef THREADS
int myworker_id = worker_id;
pthread_setspecific(yaamregs_key, (const void *)ThreadHandle[myworker_id].default_yaam_regs);
worker_id = myworker_id;
#else
Yap_regp = &Yap_standard_regs;
#endif
#endif /* PUSH_REGS */
Yap_PutValue (AtomBreak, MkIntTerm (0));
AuxSp = (CELL *)AuxTop;
TR = (tr_fr_ptr)Yap_TrailBase;
#ifdef COROUTINING
H = H0 = ((CELL *) Yap_GlobalBase)+ 2048;

39
C/grow.c
View File

@ -63,7 +63,7 @@ STATIC_PROTO(void AdjustTrail, (int));
STATIC_PROTO(void AdjustLocal, (void));
STATIC_PROTO(void AdjustGlobal, (void));
STATIC_PROTO(void AdjustGrowStack, (void));
STATIC_PROTO(int static_growheap, (long,int));
STATIC_PROTO(int static_growheap, (long,int,struct intermediates *));
STATIC_PROTO(void cpcellsd, (CELL *, CELL *, CELL));
STATIC_PROTO(CELL AdjustAppl, (CELL));
STATIC_PROTO(CELL AdjustPair, (CELL));
@ -121,7 +121,8 @@ SetHeapRegs(void)
Yap_GlobalBase = DelayAddrAdjust(Yap_GlobalBase);
Yap_LocalBase = LocalAddrAdjust(Yap_LocalBase);
AuxSp = PtoDelayAdjust(AuxSp);
AuxTop = DelayAddrAdjust(AuxTop);
AuxTop = (ADDR)PtoDelayAdjust((CELL *)AuxTop);
HeapLim = DelayAddrAdjust(HeapLim);
/* The registers pointing to one of the stacks */
ENV = PtoLocAdjust(ENV);
ASP = PtoLocAdjust(ASP);
@ -142,8 +143,6 @@ SetHeapRegs(void)
S = PtoGloAdjust(S);
else if (IsOldLocalPtr(S))
S = PtoLocAdjust(S);
if (MyTR)
MyTR = PtoTRAdjust(MyTR);
#ifdef COROUTINING
DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars)));
MutableList = AbsAppl(PtoGloAdjust(RepAppl(MutableList)));
@ -182,8 +181,6 @@ SetStackRegs(void)
TR_FZ = PtoTRAdjust(TR_FZ);
#endif /* TABLING */
YENV = PtoLocAdjust(YENV);
if (MyTR)
MyTR = PtoTRAdjust(MyTR);
}
static void
@ -493,7 +490,7 @@ Yap_AdjustRegs(int n)
/* Used by do_goal() when we're short of heap space */
static int
static_growheap(long size, int fix_code)
static_growheap(long size, int fix_code, struct intermediates *cip)
{
Int start_growth_time, growth_time;
int gc_verbose;
@ -521,7 +518,7 @@ static_growheap(long size, int fix_code)
fprintf(Yap_stderr, "[HO] growing the heap %ld bytes\n", size);
}
/* CreepFlag is set to force heap expansion */
if (CreepFlag == Unsigned(LCL0+1)) {
if (ActiveSignals == YAP_CDOVF_SIGNAL) {
CreepFlag = CalculateStackGap();
}
ASP -= 256;
@ -532,7 +529,7 @@ static_growheap(long size, int fix_code)
MoveLocalAndTrail();
if (fix_code) {
CELL *SaveOldH = OldH;
OldH = (CELL *)freep;
OldH = (CELL *)cip->freep;
MoveGlobal();
OldH = SaveOldH;
} else {
@ -663,7 +660,7 @@ fix_tabling_info(void)
#endif /* TABLING */
static int
do_growheap(int fix_code, UInt in_size)
do_growheap(int fix_code, UInt in_size, struct intermediates *cip)
{
unsigned long size = sizeof(CELL) * 16 * 1024L;
int shift_factor = (heap_overflows > 8 ? 8 : heap_overflows);
@ -680,7 +677,7 @@ do_growheap(int fix_code, UInt in_size)
#endif
if (SizeOfOverflow > sz)
sz = AdjustPageSize(SizeOfOverflow);
while(sz >= sizeof(CELL) * 16 * 1024L && !static_growheap(sz, fix_code)) {
while(sz >= sizeof(CELL) * 16 * 1024L && !static_growheap(sz, fix_code, cip)) {
size = size/2;
sz = size << shift_factor;
if (sz < in_size) {
@ -689,18 +686,18 @@ do_growheap(int fix_code, UInt in_size)
}
/* we must fix an instruction chain */
if (fix_code) {
PInstr *pcpc = CodeStart;
PInstr *pcpc = cip->CodeStart;
if (pcpc != NULL) {
CodeStart = pcpc = (PInstr *)GlobalAddrAdjust((ADDR)pcpc);
cip->CodeStart = pcpc = (PInstr *)GlobalAddrAdjust((ADDR)pcpc);
}
fix_compiler_instructions(pcpc);
pcpc = BlobsStart;
pcpc = cip->BlobsStart;
if (pcpc != NULL) {
BlobsStart = pcpc = (PInstr *)GlobalAddrAdjust((ADDR)pcpc);
cip->BlobsStart = pcpc = (PInstr *)GlobalAddrAdjust((ADDR)pcpc);
}
fix_compiler_instructions(pcpc);
freep = (char *)GlobalAddrAdjust((ADDR)freep);
label_offset = (int *)GlobalAddrAdjust((ADDR)label_offset);
cip->freep = (char *)GlobalAddrAdjust((ADDR)cip->freep);
cip->label_offset = (int *)GlobalAddrAdjust((ADDR)cip->label_offset);
}
#ifdef TABLING
fix_tabling_info();
@ -713,9 +710,9 @@ do_growheap(int fix_code, UInt in_size)
}
int
Yap_growheap(int fix_code, UInt in_size)
Yap_growheap(int fix_code, UInt in_size, void *cip)
{
return do_growheap(fix_code, in_size);
return do_growheap(fix_code, in_size, (struct intermediates *)cip);
}
int
@ -992,7 +989,7 @@ Yap_growatomtable(void)
while ((ntb = (AtomHashEntry *)Yap_AllocCodeSpace(nsize*sizeof(AtomHashEntry))) == NULL) {
/* leave for next time */
if (!do_growheap(FALSE, nsize*sizeof(AtomHashEntry)))
if (!do_growheap(FALSE, nsize*sizeof(AtomHashEntry), NULL))
return;
}
atom_table_overflows++;
@ -1063,7 +1060,7 @@ p_growheap(void)
if (diff < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t1, "grow_heap/1");
}
return(static_growheap(diff, FALSE));
return(static_growheap(diff, FALSE, NULL));
}
static Int

2
C/heapgc.c
View File

@ -3090,7 +3090,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
}
if (HeapTop >= Yap_GlobalBase - MinHeapGap) {
*--ASP = (CELL)current_env;
if (!Yap_growheap(FALSE, MinHeapGap)) {
if (!Yap_growheap(FALSE, MinHeapGap, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}

442
C/index.c
View File

File diff suppressed because it is too large Load Diff

124
C/init.c
View File

@ -25,6 +25,7 @@ static char SccsId[] = "%W% %G%";
#include "Yap.h"
#include "yapio.h"
#include "alloc.h"
#include "clause.h"
#include "Foreign.h"
#ifdef LOW_LEVEL_TRACER
@ -72,13 +73,19 @@ STD_PROTO(void exit, (int));
/************** YAP PROLOG GLOBAL VARIABLES *************************/
/************* variables related to memory allocation ***************/
ADDR Yap_HeapBase,
Yap_LocalBase,
Yap_GlobalBase,
Yap_TrailBase,
Yap_TrailTop;
/* Functor FunctorDouble, FunctorLongInt, FunctorDBRef; */
ADDR Yap_HeapBase;
#ifdef THREADS
struct thread_globs Yap_thread_gl[MAX_WORKERS];
#else
ADDR Yap_HeapBase,
Yap_LocalBase,
Yap_GlobalBase,
Yap_TrailBase,
Yap_TrailTop;
/************ variables concerned with Error Handling *************/
char *Yap_ErrorMessage; /* used to pass error messages */
@ -86,6 +93,33 @@ Term Yap_Error_Term; /* used to pass error terms */
yap_error_number Yap_Error_TYPE; /* used to pass the error */
UInt Yap_Error_Size; /* used to pass a size associated with an error */
/******************* storing error messages ****************************/
char Yap_ErrorSay[MAX_ERROR_MSG_SIZE];
/* if we botched in a LongIO operation */
jmp_buf Yap_IOBotch;
/* if we botched in the compiler */
jmp_buf Yap_CompilerBotch;
/************ variables concerned with Error Handling *************/
sigjmp_buf Yap_RestartEnv; /* used to restart after an abort execution */
/********* IO support *****/
/********* parsing ********************************************/
TokEntry *Yap_tokptr, *Yap_toktide;
VarEntry *Yap_VarTable, *Yap_AnonVarTable;
int Yap_eot_before_eof = FALSE;
/******************* intermediate buffers **********************/
char Yap_FileNameBuf[YAP_FILENAME_MAX],
Yap_FileNameBuf2[YAP_FILENAME_MAX];
#endif /* THREADS */
/********* readline support *****/
#if HAVE_LIBREADLINE
@ -107,14 +141,6 @@ char emacs_tmp[256], emacs_tmp2[256];
#endif
/******************* storing error messages ****************************/
char Yap_ErrorSay[MAX_ERROR_MSG_SIZE];
/******************* intermediate buffers **********************/
char Yap_FileNameBuf[YAP_FILENAME_MAX],
Yap_FileNameBuf2[YAP_FILENAME_MAX];
/********* Prolog State ********************************************/
prolog_exec_mode Yap_PrologMode = BootMode;
@ -129,11 +155,6 @@ YP_FILE *Yap_stdin;
YP_FILE *Yap_stdout;
YP_FILE *Yap_stderr;
/********* parsing ********************************************/
TokEntry *Yap_tokptr, *Yap_toktide;
VarEntry *Yap_VarTable, *Yap_AnonVarTable;
int Yap_eot_before_eof = FALSE;
/************** Access to yap initial arguments ***************************/
@ -147,19 +168,10 @@ int Yap_argc;
ext_op attas[attvars_ext+1];
#endif
/************ variables concerned with Error Handling *************/
sigjmp_buf Yap_RestartEnv; /* used to restart after an abort execution */
/************** declarations local to init.c ************************/
static char *optypes[] =
{"", "xfx", "xfy", "yfx", "xf", "yf", "fx", "fy"};
/* if we botched in a LongIO operation */
jmp_buf Yap_IOBotch;
/* if we botched in the compiler */
jmp_buf Yap_CompilerBotch;
/* OS page size for memory allocation */
int Yap_page_size;
@ -751,6 +763,20 @@ InitCodes(void)
INIT_YAMOP_LTT(&(heap_regs->rtrycode), 1);
#endif /* YAPOR */
#ifdef THREADS
INIT_LOCK(heap_regs->thread_handles_lock);
{
int i;
for (i=0; i < MAX_WORKERS; i++) {
heap_regs->thread_handle[i].in_use = FALSE;
}
}
heap_regs->thread_handle[0].id = 0;
heap_regs->thread_handle[0].in_use = TRUE;
heap_regs->thread_handle[0].default_yaam_regs =
&Yap_standard_regs;
heap_regs->thread_handle[0].handle = pthread_self();
#endif
#if defined(YAPOR) || defined(THREADS)
INIT_RWLOCK(heap_regs->bgl);
INIT_LOCK(heap_regs->free_blocks_lock);
@ -759,6 +785,14 @@ InitCodes(void)
INIT_LOCK(heap_regs->dead_clauses_lock);
heap_regs->n_of_threads = 1;
heap_regs->heap_top_owner = -1;
{
int i;
for (i=0; i < MAX_WORKERS; i++) {
heap_regs->wl[i].scratchpad.ptr = NULL;
heap_regs->wl[i].scratchpad.sz = SCRATCH_START_SIZE;
heap_regs->wl[i].scratchpad.msz = SCRATCH_START_SIZE;
}
}
#endif /* YAPOR */
heap_regs->clausecode->arity = 0;
heap_regs->clausecode->clause = NULL;
@ -929,6 +963,7 @@ InitCodes(void)
heap_regs->functor_stream = Yap_MkFunctor (AtomStream, 1);
heap_regs->functor_stream_pos = Yap_MkFunctor (AtomStreamPos, 3);
heap_regs->functor_stream_eOS = Yap_MkFunctor (Yap_LookupAtom("end_of_stream"), 1);
heap_regs->functor_thread_run = Yap_MkFunctor (Yap_LookupAtom("$top_thread_goal"), 1);
heap_regs->functor_change_module = Yap_MkFunctor (Yap_LookupAtom("$change_module"), 1);
heap_regs->functor_current_module = Yap_MkFunctor (Yap_LookupAtom("$current_module"), 1);
FunctorThrow = Yap_MkFunctor( Yap_LookupAtom("throw"), 1);
@ -1087,7 +1122,7 @@ InitYapOr(int Heap,
void
Yap_InitStacks(int Heap,
Yap_InitWorkspace(int Heap,
int Stack,
int Trail,
int aux_number_workers,
@ -1100,10 +1135,15 @@ Yap_InitStacks(int Heap,
/* initialise system stuff */
#if PUSH_REGS
/* In this case we need to initialise the abstract registers */
#ifdef THREADS
pthread_key_create(&yaamregs_key, NULL);
pthread_setspecific(yaamregs_key, (const void *)&Yap_standard_regs);
#else
/* In this case we need to initialise the abstract registers */
Yap_regp = &Yap_standard_regs;
/* the emulator will eventually copy them to its own local
register array, but for now they exist */
#endif
#endif /* PUSH_REGS */
#ifdef THREADS
@ -1113,26 +1153,6 @@ Yap_InitStacks(int Heap,
/* also init memory page size, required by later functions */
Yap_InitSysbits ();
/* sanity checking for data areas */
if (Trail < MinTrailSpace)
Trail = MinTrailSpace;
if (Stack < MinStackSpace)
Stack = MinStackSpace;
#if defined(YAPOR) || defined(TABLING)
{
#ifdef USE_HEAP
int OKHeap = MinHeapSpace+(sizeof(struct global_data) + aux_number_workers*sizeof(struct local_data))/1024;
#else
int OKHeap = MinHeapSpace+(sizeof(struct global_data) + aux_number_workers*sizeof(struct local_data)+OPT_CHUNK_SIZE)/1024;
#endif
if (Heap < OKHeap)
Heap = OKHeap;
}
#else
if (Heap < MinHeapSpace)
Heap = MinHeapSpace;
#endif /* YAPOR || TABLING */
#if defined(YAPOR) || defined(TABLING)
InitYapOr(Heap,
Stack,
@ -1170,6 +1190,10 @@ Yap_InitStacks(int Heap,
Yap_InitSysPath();
InitFlags();
InitStdPreds();
/* make sure tmp area is available */
{
Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace());
}
}
void

14
C/iopreds.c
View File

@ -168,14 +168,6 @@ STATIC_PROTO (Int p_type_of_char, (void));
STATIC_PROTO (Int GetArgSizeFromChar, (Term *));
STATIC_PROTO (void CloseStream, (int));
#if EMACS
static int first_char;
#endif
static int StartLine;
static int
yap_fflush(int sno)
{
@ -2015,7 +2007,7 @@ p_open_mem_read_stream (void) /* $open_mem_read_stream(+List,-Stream) */
}
}
while ((nbuf = (char *)Yap_AllocAtomSpace((sl+1)*sizeof(char))) == NULL) {
if (!Yap_growheap(FALSE, (sl+1)*sizeof(char))) {
if (!Yap_growheap(FALSE, (sl+1)*sizeof(char), NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -2069,7 +2061,7 @@ p_open_mem_write_stream (void) /* $open_mem_write_stream(-Stream) */
extern int Yap_page_size;
while ((nbuf = (char *)Yap_AllocAtomSpace(Yap_page_size*sizeof(char))) == NULL) {
if (!Yap_growheap(FALSE, Yap_page_size*sizeof(char))) {
if (!Yap_growheap(FALSE, Yap_page_size*sizeof(char), NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -4812,7 +4804,7 @@ p_char_conversion(void)
return(TRUE);
CharConversionTable2 = Yap_AllocCodeSpace(NUMBER_OF_CHARS*sizeof(char));
while (CharConversionTable2 == NULL) {
if (!Yap_growheap(FALSE, NUMBER_OF_CHARS*sizeof(char))) {
if (!Yap_growheap(FALSE, NUMBER_OF_CHARS*sizeof(char), NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}

11
C/other.c
View File

@ -28,10 +28,19 @@ REGSTORE Yap_standard_regs;
#if PUSH_REGS
REGSTORE *Yap_regp;
#ifdef THREADS
/* PushRegs always on */
pthread_key_t yaamregs_key;
#else
REGSTORE *Yap_regp;
#endif
#else /* !PUSH_REGS */
REGSTORE Yap_REGS;
#endif

124
C/parser.c
View File

@ -61,53 +61,57 @@ static char SccsId[] = "%W% %G%";
#endif
STATIC_PROTO(void GNextToken, (void));
STATIC_PROTO(void checkfor, (Term));
STATIC_PROTO(Term ParseArgs, (Atom));
STATIC_PROTO(Term ParseList, (void));
STATIC_PROTO(Term ParseTerm, (int));
/* weak backtraking mechanism based on long_jump */
typedef struct {
typedef struct jmp_buff_struct {
jmp_buf JmpBuff;
} JMPBUFF;
static JMPBUFF FailBuff;
STATIC_PROTO(void GNextToken, (void));
STATIC_PROTO(void checkfor, (Term, JMPBUFF *));
STATIC_PROTO(Term ParseArgs, (Atom, JMPBUFF *));
STATIC_PROTO(Term ParseList, (JMPBUFF *));
STATIC_PROTO(Term ParseTerm, (int, JMPBUFF *));
#define TRY(S,P) \
{ Volatile JMPBUFF saveenv;\
Volatile TokEntry *saveT=Yap_tokptr; \
Volatile CELL *saveH=H;\
Volatile int savecurprio=curprio;\
saveenv=FailBuff;\
if(!setjmp(FailBuff.JmpBuff)) {\
S;\
FailBuff=saveenv;\
P;\
}\
else { FailBuff=saveenv; \
H=saveH; \
curprio = savecurprio; \
Yap_tokptr=saveT; \
}\
}\
#define TRY(S,P) \
{ Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT=Yap_tokptr; \
Volatile CELL *saveH=H; \
Volatile int savecurprio=curprio; \
saveenv=FailBuff; \
if(!setjmp(newenv.JmpBuff)) { \
FailBuff = &newenv; \
S; \
FailBuff=saveenv; \
P; \
} \
else { FailBuff=saveenv; \
H=saveH; \
curprio = savecurprio; \
Yap_tokptr=saveT; \
} \
}
#define TRY3(S,P,F) \
{ Volatile JMPBUFF saveenv;\
Volatile TokEntry *saveT=Yap_tokptr; Volatile CELL *saveH=H;\
saveenv=FailBuff;\
if(!setjmp(FailBuff.JmpBuff)) {\
S;\
FailBuff=saveenv;\
P;\
}\
else { FailBuff=saveenv; H=saveH; Yap_tokptr=saveT; F }\
}\
#define TRY3(S,P,F) \
{ Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT=Yap_tokptr; \
Volatile CELL *saveH=H; \
saveenv=FailBuff; \
if(!setjmp(newenv.JmpBuff)) { \
FailBuff = &newenv; \
S; \
FailBuff=saveenv; \
P; \
} \
else { \
FailBuff=saveenv; \
H=saveH; \
Yap_tokptr=saveT; \
F } \
}
#define FAIL longjmp(FailBuff.JmpBuff,1)
#define FAIL longjmp(FailBuff->JmpBuff,1)
VarEntry *
Yap_LookupVar(char *var) /* lookup variable in variables table */
@ -281,7 +285,7 @@ GNextToken(void)
}
inline static void
checkfor(Term c)
checkfor(Term c, JMPBUFF *FailBuff)
{
if (Yap_tokptr->Tok != Ord(Ponctuation_tok)
|| Yap_tokptr->TokInfo != c)
@ -290,7 +294,7 @@ checkfor(Term c)
}
static Term
ParseArgs(Atom a)
ParseArgs(Atom a, JMPBUFF *FailBuff)
{
int nargs = 0;
Term *p, t;
@ -302,7 +306,7 @@ ParseArgs(Atom a)
p = (Term *) ParserAuxSp;
while (1) {
Term *tp = (Term *)ParserAuxSp;
*tp++ = Unsigned(ParseTerm(999));
*tp++ = Unsigned(ParseTerm(999, FailBuff));
ParserAuxSp = (tr_fr_ptr)tp;
++nargs;
if (Yap_tokptr->Tok != Ord(Ponctuation_tok))
@ -329,13 +333,13 @@ ParseArgs(Atom a)
t = Yap_MkApplTerm(Yap_MkFunctor(a, nargs), nargs, p);
#endif
/* check for possible overflow against local stack */
checkfor((Term) ')');
checkfor((Term) ')', FailBuff);
return (t);
}
static Term
ParseList(void)
ParseList(JMPBUFF *FailBuff)
{
Term o;
CELL *to_store;
@ -343,14 +347,14 @@ ParseList(void)
loop:
to_store = H;
H+=2;
to_store[0] = ParseTerm(999);
to_store[0] = ParseTerm(999, FailBuff);
if (Yap_tokptr->Tok == Ord(Ponctuation_tok)) {
if (((int) Yap_tokptr->TokInfo) == ',') {
NextToken;
if (Yap_tokptr->Tok == Ord(Name_tok)
&& strcmp(RepAtom((Atom)(Yap_tokptr->TokInfo))->StrOfAE, "..") == 0) {
NextToken;
to_store[1] = ParseTerm(999);
to_store[1] = ParseTerm(999, FailBuff);
} else {
/* check for possible overflow against local stack */
if (H > ASP-4096) {
@ -364,7 +368,7 @@ ParseList(void)
}
} else if (((int) Yap_tokptr->TokInfo) == '|') {
NextToken;
to_store[1] = ParseTerm(999);
to_store[1] = ParseTerm(999, FailBuff);
} else {
to_store[1] = MkAtomTerm(AtomNil);
}
@ -382,7 +386,7 @@ ParseList(void)
#endif
static Term
ParseTerm(int prio)
ParseTerm(int prio, JMPBUFF *FailBuff)
{
/* parse term with priority prio */
Volatile Prop opinfo;
@ -456,7 +460,7 @@ ParseTerm(int prio)
TRY(
/* build appl on the heap */
func = Yap_MkFunctor((Atom) t, 1);
t = ParseTerm(oprprio);
t = ParseTerm(oprprio, FailBuff);
t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */
if (H > ASP-4096) {
@ -471,7 +475,7 @@ ParseTerm(int prio)
}
if (Yap_tokptr->Tok == Ord(Ponctuation_tok)
&& Unsigned(Yap_tokptr->TokInfo) == 'l')
t = ParseArgs((Atom) t);
t = ParseArgs((Atom) t, FailBuff);
else
t = MkAtomTerm((Atom)t);
break;
@ -512,13 +516,13 @@ ParseTerm(int prio)
case '(':
case 'l': /* non solo ( */
NextToken;
t = ParseTerm(1200);
checkfor((Term) ')');
t = ParseTerm(1200, FailBuff);
checkfor((Term) ')', FailBuff);
break;
case '[':
NextToken;
t = ParseList();
checkfor((Term) ']');
t = ParseList(FailBuff);
checkfor((Term) ']', FailBuff);
break;
case '{':
NextToken;
@ -527,14 +531,14 @@ ParseTerm(int prio)
t = MkAtomTerm(NameOfFunctor(FunctorBraces));
NextToken;
} else {
t = ParseTerm(1200);
t = ParseTerm(1200, FailBuff);
t = Yap_MkApplTerm(FunctorBraces, 1, &t);
/* check for possible overflow against local stack */
if (H > ASP-4096) {
Yap_ErrorMessage = "Stack Overflow";
FAIL;
}
checkfor((Term) '}');
checkfor((Term) '}', FailBuff);
}
break;
default:
@ -562,7 +566,7 @@ ParseTerm(int prio)
{
Term args[2];
args[0] = t;
args[1] = ParseTerm(oprprio);
args[1] = ParseTerm(oprprio, FailBuff);
t = Yap_MkApplTerm(func, 2, args);
/* check for possible overflow against local stack */
if (H > ASP-4096) {
@ -599,7 +603,7 @@ ParseTerm(int prio)
Volatile Term args[2];
NextToken;
args[0] = t;
args[1] = ParseTerm(1000);
args[1] = ParseTerm(1000, FailBuff);
t = Yap_MkApplTerm(Yap_MkFunctor(AtomComma, 2), 2, args);
/* check for possible overflow against local stack */
if (H > ASP-4096) {
@ -613,7 +617,7 @@ ParseTerm(int prio)
Volatile Term args[2];
NextToken;
args[0] = t;
args[1] = ParseTerm(1100);
args[1] = ParseTerm(1100, FailBuff);
t = Yap_MkApplTerm(FunctorVBar, 2, args);
/* check for possible overflow against local stack */
if (H > ASP-4096) {
@ -636,8 +640,10 @@ Term
Yap_Parse(void)
{
Volatile Term t;
JMPBUFF FailBuff;
if (!setjmp(FailBuff.JmpBuff)) {
t = ParseTerm(1200);
t = ParseTerm(1200, &FailBuff);
if (Yap_tokptr->Tok != Ord(eot_tok))
return (0L);
return (t);

13
C/save.c
View File

@ -379,7 +379,6 @@ save_regs(int mode)
putcellptr(YENV);
putcellptr(S);
putcellptr((CELL *)P);
putcellptr((CELL *)MyTR);
putout(CreepFlag);
putout(FlipFlop);
putout(EX);
@ -388,7 +387,6 @@ save_regs(int mode)
#endif
}
putout(CurrentModule);
putcellptr((CELL *)HeapPlus);
if (mode == DO_EVERYTHING) {
#ifdef COROUTINING
putout(WokenGoals);
@ -642,8 +640,9 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap)
hp_size = get_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
while (Yap_HeapBase != NULL && hp_size > Unsigned(AuxTop) - Unsigned(Yap_HeapBase)) {
if(!Yap_growheap(FALSE, hp_size)) {
while (Yap_HeapBase != NULL &&
hp_size > Unsigned(HeapLim) - Unsigned(Yap_HeapBase)) {
if(!Yap_growheap(FALSE, hp_size, NULL)) {
return(FAIL_RESTORE);
}
}
@ -714,7 +713,6 @@ get_regs(int flag)
YENV = get_cellptr();
S = get_cellptr();
P = (yamop *)get_cellptr();
MyTR = (tr_fr_ptr)get_cellptr();
CreepFlag = get_cell();
FlipFlop = get_cell();
#ifdef COROUTINING
@ -722,7 +720,6 @@ get_regs(int flag)
#endif
}
CurrentModule = get_cell();
HeapPlus = (ADDR)get_cellptr();
if (flag == DO_EVERYTHING) {
#ifdef COROUTINING
WokenGoals = get_cell();
@ -860,7 +857,6 @@ get_coded(int flag, OPCODE old_ops[])
static void
restore_heap_regs(void)
{
HeapPlus = AddrAdjust(HeapPlus);
HeapTop = AddrAdjust(HeapTop);
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
HeapMax = HeapUsed = OldHeapUsed;
@ -883,9 +879,6 @@ restore_regs(int flag)
HB = PtoLocAdjust(HB);
YENV = PtoLocAdjust(YENV);
S = PtoGloAdjust(S);
HeapPlus = AddrAdjust(HeapPlus);
if (MyTR)
MyTR = PtoTRAdjust(MyTR);
#ifdef COROUTINING
DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars)));
#ifdef MULTI_ASSIGNMENT_VARIABLES

32
C/stdpreds.c
View File

@ -120,7 +120,7 @@ Yap_inform_profiler_of_clause(yamop *code_start, yamop *code_end, PredEntry *pe)
*/
ProfPreds++;
if (FPreds != NULL) {
fprintf(FPreds,"+%p %p %p %ld\n",code_start,code_end, pe, ProfCalls);
fprintf(FPreds,"+%p %p %p %uld\n",code_start,code_end, pe, ProfCalls);
}
}
@ -261,7 +261,7 @@ showprofres(int tipo) {
(void)fseek(FPreds, 0L, SEEK_SET);
while (i) {
if (fscanf(FPreds,"+%p %p %p %ld\n",&(pr->beg),&(pr->end),&(pr->pp),&(pr->ts)) == 0){
if (fscanf(FPreds,"+%p %p %p %uld\n",&(pr->beg),&(pr->end),&(pr->pp),&(pr->ts)) == 0){
/* error */
return FALSE;
}
@ -301,13 +301,13 @@ showprofres(int tipo) {
}
if (calls) {
if (myp->ArityOfPE) {
printf("%s:%s/%d -> %ld\n",
printf("%s:%s/%d -> %uld\n",
RepAtom(AtomOfTerm(ModuleName[myp->ModuleOfPred]))->StrOfAE,
RepAtom(NameOfFunctor(myp->FunctorOfPred))->StrOfAE,
myp->ArityOfPE,
calls);
} else {
printf("%s:%s -> %ld\n",
printf("%s:%s -> %uld\n",
RepAtom(AtomOfTerm(ModuleName[myp->ModuleOfPred]))->StrOfAE,
RepAtom((Atom)(myp->FunctorOfPred))->StrOfAE,
calls);
@ -405,17 +405,26 @@ p_setflop(void)
return (FALSE);
}
inline static void
do_signal(yap_signals sig)
{
LOCK(SignalLock);
CreepFlag = Unsigned(LCL0);
ActiveSignals |= sig;
UNLOCK(SignalLock);
}
static Int
p_creep(void)
{
Atom at;
PredEntry *pred;
yap_flags[SPY_CREEP_FLAG] = TRUE;
at = Yap_FullLookupAtom("$creep");
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred;
CreepFlag = Unsigned(LCL0+2);
yap_flags[SPY_CREEP_FLAG] = TRUE;
do_signal(YAP_CREEP_SIGNAL);
FlipFlop = 0;
return TRUE;
}
@ -427,10 +436,10 @@ p_stop_creep(void)
return TRUE;
}
Int
Yap_creep(void)
void
Yap_signal(yap_signals sig)
{
return p_creep();
do_signal(sig);
}
#ifdef undefined
@ -924,7 +933,7 @@ p_atom_concat(void)
sz = strlen(atom_str);
if (cptr+sz >= top-1024) {
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
if (!Yap_growheap(FALSE, sz+1024)) {
if (!Yap_growheap(FALSE, sz+1024, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -2647,6 +2656,9 @@ Yap_InitCPreds(void)
#if defined(YAPOR) || defined(TABLING)
Yap_init_optyap_preds();
#endif /* YAPOR || TABLING */
#ifdef THREADS
Yap_InitThreadPreds();
#endif /* ANALYST */
{
void (*(*(p))) (void) = E_Modules;
while (*p)

110
C/sysbits.c
View File

@ -1130,7 +1130,7 @@ InteractSIGINT(int ch) {
Yap_PutValue (Yap_LookupAtom ("spy_sl"), MkIntTerm (0));
Yap_PutValue (Yap_FullLookupAtom ("$trace"), MkIntTerm (1));
yap_flags[SPY_CREEP_FLAG] = 1;
Yap_creep ();
Yap_signal (YAP_CREEP_SIGNAL);
return(1);
#ifdef LOW_LEVEL_TRACER
case 'T':
@ -1229,7 +1229,7 @@ HandleALRM(int s)
{
my_signal (SIGALRM, HandleALRM);
/* force the system to creep */
Yap_creep ();
Yap_signal (YAP_ALARM_SIGNAL);
/* now, say what is going on */
Yap_PutValue(AtomAlarm, MkAtomTerm(AtomTrue));
}
@ -1266,35 +1266,19 @@ ReceiveSignal (int s)
#if defined(SIGUSR1)
case SIGUSR1:
/* force the system to creep */
Yap_creep ();
/* add to the set of signals pending */
{
Term t;
t = Yap_GetValue(AtomSigPending);
t = MkPairTerm(MkAtomTerm(Yap_LookupAtom("sig_usr1")), t);
Yap_PutValue(AtomSigPending, t);
}
Yap_signal (YAP_USR1_SIGNAL);
break;
#endif /* defined(SIGUSR1) */
#if defined(SIGUSR2)
case SIGUSR2:
/* force the system to creep */
Yap_creep ();
/* add to the set of signals pending */
{
Term t;
t = Yap_GetValue(AtomSigPending);
t = MkPairTerm(MkAtomTerm(Yap_LookupAtom("sig_usr2")), t);
Yap_PutValue(AtomSigPending, t);
}
Yap_signal (YAP_USR2_SIGNAL);
break;
#endif /* defined(SIGUSR2) */
#if defined(SIGHUP)
case SIGHUP:
/* force the system to creep */
Yap_creep ();
/* raise the '$sig_pending' flag */
Yap_PutValue(AtomSigPending, MkAtomTerm(Yap_LookupAtom("sig_hup")));
Yap_signal (YAP_HUP_SIGNAL);
break;
#endif /* defined(SIGHUP) */
default:
@ -1310,7 +1294,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
switch(dwCtrlType) {
case CTRL_C_EVENT:
case CTRL_BREAK_EVENT:
Yap_creep();
Yap_signal(YAP_ALARM_SIGNAL);
Yap_PrologMode |= InterruptMode;
return(TRUE);
default:
@ -1948,7 +1932,7 @@ DoTimerThread(LPVOID targ)
}
if (WaitForSingleObject(htimer, INFINITE) != WAIT_OBJECT_0)
fprintf(stderr,"WaitForSingleObject failed (%ld)\n", GetLastError());
Yap_creep ();
Yap_signal (YAP_ALARM_SIGNAL);
/* now, say what is going on */
Yap_PutValue(AtomAlarm, MkAtomTerm(AtomTrue));
ExitThread(1);
@ -2119,6 +2103,84 @@ Yap_ReInitWallTime (void)
InitLastWtime();
}
static Int
p_first_signal(void)
{
LOCK(SignalLock);
/* always do wakeups first, because you don't want to keep the
non-backtrackable variable bad */
if (ActiveSignals & YAP_WAKEUP_SIGNAL) {
ActiveSignals &= ~YAP_WAKEUP_SIGNAL;
UNLOCK(SignalLock);
return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_wake_up")));
}
if (ActiveSignals & YAP_ITI_SIGNAL) {
ActiveSignals &= ~YAP_ITI_SIGNAL;
UNLOCK(SignalLock);
return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_iti")));
}
if (ActiveSignals & YAP_INT_SIGNAL) {
ActiveSignals &= ~YAP_INT_SIGNAL;
UNLOCK(SignalLock);
return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_int")));
}
if (ActiveSignals & YAP_USR2_SIGNAL) {
ActiveSignals &= ~YAP_USR2_SIGNAL;
UNLOCK(SignalLock);
return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_usr2")));
}
if (ActiveSignals & YAP_USR1_SIGNAL) {
ActiveSignals &= ~YAP_USR1_SIGNAL;
UNLOCK(SignalLock);
return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_usr1")));
}
if (ActiveSignals & YAP_HUP_SIGNAL) {
ActiveSignals &= ~YAP_HUP_SIGNAL;
UNLOCK(SignalLock);
return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_hup")));
}
if (ActiveSignals & YAP_ALARM_SIGNAL) {
ActiveSignals &= ~YAP_ALARM_SIGNAL;
UNLOCK(SignalLock);
return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_alarm")));
}
if (ActiveSignals & YAP_CREEP_SIGNAL) {
ActiveSignals &= ~YAP_CREEP_SIGNAL;
UNLOCK(SignalLock);
return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_creep")));
}
UNLOCK(SignalLock);
return FALSE;
}
static Int
p_continue_signals(void)
{
/* hack to force the signal anew */
if (ActiveSignals & YAP_ITI_SIGNAL) {
Yap_signal(YAP_ITI_SIGNAL);
}
if (ActiveSignals & YAP_INT_SIGNAL) {
Yap_signal(YAP_INT_SIGNAL);
}
if (ActiveSignals & YAP_USR2_SIGNAL) {
Yap_signal(YAP_USR2_SIGNAL);
}
if (ActiveSignals & YAP_USR1_SIGNAL) {
Yap_signal(YAP_USR1_SIGNAL);
}
if (ActiveSignals & YAP_HUP_SIGNAL) {
Yap_signal(YAP_HUP_SIGNAL);
}
if (ActiveSignals & YAP_ALARM_SIGNAL) {
Yap_signal(YAP_ALARM_SIGNAL);
}
if (ActiveSignals & YAP_CREEP_SIGNAL) {
Yap_signal(YAP_CREEP_SIGNAL);
}
return TRUE;
}
void
Yap_InitSysPreds(void)
{
@ -2138,6 +2200,8 @@ Yap_InitSysPreds(void)
Yap_InitCPred ("$file_age", 2, p_file_age, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$set_fpu_exceptions", 0, p_set_fpu_exceptions, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$first_signal", 1, p_first_signal, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag);
}

361
C/threads.c Normal file
View File

@ -0,0 +1,361 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: stdpreds.c *
* Last rev: *
* mods: *
* comments: threads *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
#if THREADS
/*
* This file includes the definition of threads in Yap. Threads
* are supposed to be compatible with the SWI-Prolog thread package.
*
*/
#include "Yap.h"
#include "Yatom.h"
#include "Heap.h"
#include "eval.h"
#include "yapio.h"
#include <stdio.h>
#if HAVE_STRING_H
#include <string.h>
#endif
static int
allocate_new_tid(void)
{
int new_worker_id = 0;
LOCK(ThreadHandlesLock);
while(new_worker_id < MAX_WORKERS &&
ThreadHandle[new_worker_id].in_use == TRUE)
new_worker_id++;
ThreadHandle[new_worker_id].in_use = TRUE;
UNLOCK(ThreadHandlesLock);
if (new_worker_id == MAX_WORKERS)
return -1;
return new_worker_id;
}
static void
store_specs(int new_worker_id, UInt ssize, UInt tsize, Term tgoal)
{
ThreadHandle[new_worker_id].ssize = ssize;
ThreadHandle[new_worker_id].tsize = tsize;
ThreadHandle[new_worker_id].tgoal =
Yap_StoreTermInDB(tgoal,4);
}
static void
thread_die(void)
{
Yap_KillStacks();
LOCK(ThreadHandlesLock);
ThreadHandle[worker_id].in_use = FALSE;
free((void *)ThreadHandle[worker_id].default_yaam_regs);
UNLOCK(ThreadHandlesLock);
}
static void *
thread_run(void *widp)
{
Term tgoal;
Term tgs[1];
int out;
REGSTORE *standard_regs = (REGSTORE *)malloc(sizeof(REGSTORE));
int myworker_id = *((int *)widp);
/* create the YAAM descriptor */
ThreadHandle[myworker_id].default_yaam_regs = standard_regs;
pthread_setspecific(yaamregs_key, (void *)standard_regs);
worker_id = myworker_id;
Yap_InitExStacks(ThreadHandle[myworker_id].ssize, ThreadHandle[myworker_id].tsize);
Yap_InitYaamRegs();
{
ADDR ptr = Yap_PreAllocCodeSpace();
Yap_ReleasePreAllocCodeSpace(ptr);
}
tgs[0] = Yap_FetchTermFromDB(ThreadHandle[worker_id].tgoal);
tgoal = Yap_MkApplTerm(FunctorThreadRun, 1, tgs);
out = Yap_RunTopGoal(tgoal);
thread_die();
return NULL;
}
static Int
p_create_thread(void)
{
UInt ssize = IntegerOfTerm(Deref(ARG2));
UInt tsize = IntegerOfTerm(Deref(ARG3));
/* UInt systemsize = IntegerOfTerm(Deref(ARG4)); */
Term tgoal = Deref(ARG1);
int new_worker_id = allocate_new_tid();
if (new_worker_id == -1) {
/* YAP ERROR */
return FALSE;
}
ThreadHandle[new_worker_id].id = new_worker_id;
store_specs(new_worker_id, ssize, tsize, tgoal);
if ((ThreadHandle[new_worker_id].ret = pthread_create(&(ThreadHandle[new_worker_id].handle), NULL, thread_run, (void *)(&(ThreadHandle[new_worker_id].id)))) == 0)
return Yap_unify(MkIntegerTerm(new_worker_id), ARG5);
thread_die();
/* YAP ERROR */
return FALSE;
}
static Int
p_thread_self(void)
{
return Yap_unify(MkIntegerTerm(worker_id), ARG1);
}
static Int
p_thread_join(void)
{
pthread_t th = ThreadHandle[IntegerOfTerm(Deref(ARG1))].handle;
void *retval;
if (pthread_join(th, &retval) < 0) {
/* ERROR */
return FALSE;
}
return TRUE;
}
static Int
p_thread_detach(void)
{
pthread_t th = ThreadHandle[IntegerOfTerm(Deref(ARG1))].handle;
if (pthread_detach(th) < 0) {
/* ERROR */
return FALSE;
}
return TRUE;
}
static Int
p_thread_exit(void)
{
pthread_exit(NULL);
return TRUE;
}
static Int
p_thread_die(void)
{
thread_die();
return TRUE;
}
static Int
p_thread_set_concurrency(void)
{
Term tnew = Deref(ARG2);
int newc, cur;
if (IsVarTerm(tnew)) {
newc = 0;
} else if (IsIntegerTerm(tnew)) {
newc = IntegerOfTerm(tnew);
} else {
Yap_Error(TYPE_ERROR_INTEGER,tnew,"thread_set_concurrency/2");
return(FALSE);
}
cur = MkIntegerTerm(pthread_getconcurrency());
if (pthread_setconcurrency(newc) != 0) {
return FALSE;
}
return Yap_unify(ARG1, MkIntegerTerm(cur));
}
static Int
p_valid_thread(void)
{
Int i = IntegerOfTerm(Deref(ARG1));
return ThreadHandle[i].in_use;
}
/* Mutex Support */
typedef struct swi_mutex {
UInt owners;
Int tid_own;
pthread_mutex_t m;
} SWIMutex;
static Int
p_new_mutex(void)
{
SWIMutex* mutp;
pthread_mutexattr_t mat;
mutp = (SWIMutex *)Yap_AllocCodeSpace(sizeof(SWIMutex));
if (mutp == NULL) {
return FALSE;
}
pthread_mutexattr_init(&mat);
#ifdef HAVE_PTHREAD_MUTEXATTR_SETKIND_NP
pthread_mutexattr_setkind_np(&mat, PTHREAD_MUTEX_RECURSIVE_NP);
#else
#ifdef HAVE_PTHREAD_MUTEXATTR_SETTYPE
pthread_mutexattr_settype(&mat, PTHREAD_MUTEX_RECURSIVE);
#endif
#endif
pthread_mutex_init(&mutp->m, &mat);
mutp->owners = 0;
mutp->tid_own = 0;
return Yap_unify(ARG1, MkIntegerTerm((Int)mutp));
}
static Int
p_destroy_mutex(void)
{
SWIMutex *mut = (SWIMutex*)Deref(ARG1);
if (pthread_mutex_destroy(&mut->m) < 0)
return FALSE;
Yap_FreeCodeSpace((void *)mut);
return TRUE;
}
static Int
p_lock_mutex(void)
{
SWIMutex *mut = (SWIMutex*)Deref(ARG1);
if (pthread_mutex_lock(&mut->m) < 0)
return FALSE;
mut->owners++;
mut->tid_own = worker_id;
return TRUE;
}
static Int
p_trylock_mutex(void)
{
SWIMutex *mut = (SWIMutex*)Deref(ARG1);
if (pthread_mutex_trylock(&mut->m) == EBUSY)
return FALSE;
mut->owners++;
mut->tid_own = worker_id;
return TRUE;
}
static Int
p_unlock_mutex(void)
{
SWIMutex *mut = (SWIMutex*)Deref(ARG1);
if (pthread_mutex_unlock(&mut->m) < 0)
return FALSE;
mut->owners--;
return TRUE;
}
static Int
p_info_mutex(void)
{
SWIMutex *mut = (SWIMutex*)Deref(ARG1);
return Yap_unify(ARG2, MkIntegerTerm(mut->owners)) &&
Yap_unify(ARG2, MkIntegerTerm(mut->tid_own));
return TRUE;
}
static Int
p_cond_create(void)
{
pthread_cond_t* condp;
condp = (SWIMutex *)Yap_AllocCodeSpace(sizeof(pthread_cond_t));
if (condp == NULL) {
return FALSE;
}
pthread_cond_init(condp, NULL);
return Yap_unify(ARG1, MkIntegerTerm((Int)condp));
}
static Int
p_cond_destroy(void)
{
pthread_cond_t *condp = (pthread_cond_t *)Deref(ARG1);
if (pthread_cond_destroy(condp) < 0)
return FALSE;
Yap_FreeCodeSpace((void *)condp);
return TRUE;
}
static Int
p_cond_signal(void)
{
pthread_cond_t *condp = (pthread_cond_t *)Deref(ARG1);
if (pthread_cond_signal(condp) < 0)
return FALSE;
return TRUE;
}
static Int
p_cond_broadcast(void)
{
pthread_cond_t *condp = (pthread_cond_t *)Deref(ARG1);
if (pthread_cond_broadcast(condp) < 0)
return FALSE;
return TRUE;
}
static Int
p_cond_wait(void)
{
pthread_cond_t *condp = (pthread_cond_t *)Deref(ARG1);
SWIMutex *mut = (SWIMutex*)Deref(ARG2);
if (pthread_cond_wait(condp, &mut->m) < 0)
return FALSE;
return TRUE;
}
void Yap_InitThreadPreds(void)
{
Yap_InitCPred("$create_thread", 5, p_create_thread, 0);
Yap_InitCPred("$thread_self", 1, p_thread_self, SafePredFlag);
Yap_InitCPred("$thread_join", 1, p_thread_join, 0);
Yap_InitCPred("$detach_thread", 1, p_thread_detach, 0);
Yap_InitCPred("$thread_exit", 0, p_thread_exit, 0);
Yap_InitCPred("$thread_die", 0, p_thread_die, 0);
Yap_InitCPred("thread_set_concurrency", 2, p_thread_set_concurrency, 0);
Yap_InitCPred("$valid_thread", 1, p_valid_thread, 0);
Yap_InitCPred("$new_mutex", 1, p_new_mutex, SafePredFlag);
Yap_InitCPred("$destroy_mutex", 1, p_destroy_mutex, SafePredFlag);
Yap_InitCPred("$lock_mutex", 1, p_lock_mutex, SafePredFlag);
Yap_InitCPred("$trylock_mutex", 1, p_trylock_mutex, SafePredFlag);
Yap_InitCPred("$unlock_mutex", 1, p_unlock_mutex, SafePredFlag);
Yap_InitCPred("$info_mutex", 2, p_info_mutex, SafePredFlag);
Yap_InitCPred("$cond_create", 1, p_cond_create, SafePredFlag);
Yap_InitCPred("$cond_destroy", 1, p_cond_destroy, SafePredFlag);
Yap_InitCPred("$cond_signal", 1, p_cond_signal, SafePredFlag);
Yap_InitCPred("$cond_broadcast", 1, p_cond_broadcast, SafePredFlag);
Yap_InitCPred("$cond_wait", 2, p_cond_wait, SafePredFlag);
}
#endif /* THREADS */

3
C/tracer.c
View File

@ -153,6 +153,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
}
if (gc_calls < 1) return;
#endif
#if defined(THREADS) || defined(YAPOR)
fprintf(Yap_stderr,"(%d)", worker_id);
#endif
#if defined(__GNUC__)
fprintf(Yap_stderr,"%llu ", vsc_count);
#endif

11
C/unify.c
View File

@ -436,7 +436,11 @@ p_acyclic(void)
int
Yap_IUnify(register CELL d0, register CELL d1)
{
#if SHADOW_REGS
#if THREADS
#undef Yap_REGS
register REGSTORE *regp = Yap_regp;
#define Yap_REGS (*regp)
#elif SHADOW_REGS
#if defined(B) || defined(TR)
register REGSTORE *regp = &Yap_REGS;
@ -546,7 +550,10 @@ unify_var_nvar_trail:
}
return (TRUE);
#endif
#if SHADOW_REGS
#if THREADS
#undef Yap_REGS
#define Yap_REGS (*Yap_regp)
#elif SHADOW_REGS
#if defined(B) || defined(TR)
#undef Yap_REGS
#endif /* defined(B) || defined(TR) */

51
C/utilpreds.c
View File

@ -58,7 +58,7 @@ static int
copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *HLow)
{
CELL **to_visit = (CELL **)(HeapTop + sizeof(CELL));
CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
tr_fr_ptr TR0 = TR;
CELL *HB0 = HB;
#ifdef COROUTINING
@ -66,6 +66,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
#endif
HB = HLow;
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
register CELL d0;
@ -234,7 +235,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
}
}
/* Do we still have compound terms to visit */
if (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
if (to_visit > to_visit0) {
#ifdef RATIONAL_TREES
to_visit -= 4;
pt0 = to_visit[0];
@ -262,7 +263,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
while (to_visit > to_visit0) {
to_visit -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
@ -280,7 +281,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
while (to_visit > to_visit0) {
to_visit -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
@ -316,7 +317,7 @@ CopyTerm(Term inp) {
t = Deref(ARG1);
goto restart_attached;
} else { /* handle overflow */
if (!Yap_growheap(FALSE, 0)) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -352,7 +353,7 @@ CopyTerm(Term inp) {
t = Deref(ARG1);
goto restart_list;
} else { /* handle overflow */
if (!Yap_growheap(FALSE, 0)) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -387,7 +388,7 @@ CopyTerm(Term inp) {
t = Deref(ARG1);
goto restart_appl;
} else { /* handle overflow */
if (!Yap_growheap(FALSE, 0)) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -414,11 +415,12 @@ p_copy_term(void) /* copy term t to a new instance */
static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *HLow)
{
CELL **to_visit = (CELL **)(HeapTop + sizeof(CELL));
CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
tr_fr_ptr TR0 = TR;
CELL *HB0 = HB;
HB = HLow;
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
register CELL d0;
@ -538,7 +540,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
}
}
/* Do we still have compound terms to visit */
if (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
if (to_visit > to_visit0) {
#ifdef RATIONAL_TREES
to_visit -= 4;
pt0 = to_visit[0];
@ -567,7 +569,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
while (to_visit > to_visit0) {
to_visit -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
@ -585,7 +587,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
while (to_visit > to_visit0) {
to_visit -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
@ -625,7 +627,7 @@ CopyTermNoDelays(Term inp) {
t = Deref(ARG1);
goto restart_list;
} else { /* handle overflow */
if (!Yap_growheap(FALSE, 0)) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -657,7 +659,7 @@ CopyTermNoDelays(Term inp) {
t = Deref(ARG1);
goto restart_appl;
} else { /* handle overflow */
if (!Yap_growheap(FALSE, 0)) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -679,11 +681,12 @@ p_copy_term_no_delays(void) /* copy term t to a new instance */
static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end)
{
register CELL **to_visit = (CELL **)(HeapTop + sizeof(CELL));
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
register tr_fr_ptr TR0 = TR;
CELL *InitialH = H;
CELL output = AbsPair(H);
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
register CELL d0;
@ -753,7 +756,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end)
TrailTerm(TR++) = (CELL)ptd0;
}
/* Do we still have compound terms to visit */
if (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
if (to_visit > to_visit0) {
#ifdef RATIONAL_TREES
to_visit -= 3;
pt0 = to_visit[0];
@ -768,6 +771,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end)
}
clean_tr(TR0);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
if (H != InitialH) {
/* close the list */
Term t2 = Deref(ARG2);
@ -814,11 +818,12 @@ p_variables_in_term(void) /* variables in term t */
static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end)
{
register CELL **to_visit = (CELL **)(HeapTop + sizeof(CELL));
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
register tr_fr_ptr TR0 = TR;
CELL *InitialH = H;
CELL output = AbsPair(H);
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
register CELL d0;
@ -893,7 +898,7 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
TrailTerm(TR++) = (CELL)ptd0;
}
/* Do we still have compound terms to visit */
if (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
if (to_visit > to_visit0) {
#ifdef RATIONAL_TREES
to_visit -= 3;
pt0 = to_visit[0];
@ -940,8 +945,9 @@ p_non_singletons_in_term(void) /* non_singletons in term t */
static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end)
{
register CELL **to_visit = (CELL **)(HeapTop + sizeof(CELL));
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
register CELL d0;
@ -1003,7 +1009,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end)
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
#ifdef RATIONAL_TREES
while (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
pt0_end = to_visit[1];
@ -1013,7 +1019,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end)
return(FALSE);
}
/* Do we still have compound terms to visit */
if (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
if (to_visit > to_visit0) {
#ifdef RATIONAL_TREES
to_visit -= 3;
pt0 = to_visit[0];
@ -1057,9 +1063,10 @@ static Int var_in_complex_term(register CELL *pt0,
Term v)
{
register CELL **to_visit = (CELL **)(HeapTop + sizeof(CELL));
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
register tr_fr_ptr TR0 = TR;
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
register CELL d0;
@ -1130,7 +1137,7 @@ static Int var_in_complex_term(register CELL *pt0,
TrailTerm(TR++) = (CELL)ptd0;
}
/* Do we still have compound terms to visit */
if (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
if (to_visit > to_visit0) {
#ifdef RATIONAL_TREES
to_visit -= 3;
pt0 = to_visit[0];

127
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.49 2003-12-01 17:27:41 vsc Exp $ *
* version: $Id: Heap.h,v 1.50 2004-01-23 02:22:06 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -36,6 +36,40 @@ typedef struct reduction_counters {
int retries_on;
} red_counters;
typedef struct scratch_block_struct {
char *ptr;
UInt sz, msz;
} scratch_block;
typedef struct worker_local_struct {
#ifdef THREADS
lockvar signal_lock; /* protect signal handlers from IPIs */
#endif
UInt active_signals;
UInt i_pred_arity;
yamop *prof_end;
Int start_line;
scratch_block scratchpad;
#ifdef MULTI_ASSIGNMENT_VARIABLES
Term woken_goals;
Term mutable_list;
Term atts_mutable_list;
#endif
} worker_local;
#ifdef THREADS
typedef struct thandle {
int in_use;
UInt ssize;
UInt tsize;
struct DB_TERM *tgoal;
int id;
int ret;
REGSTORE *default_yaam_regs;
pthread_t handle;
} yap_thandle;
#endif
typedef int (*Agc_hook)(Atom);
typedef struct various_codes {
@ -43,10 +77,14 @@ typedef struct various_codes {
Int heap_used;
Int heap_max;
ADDR heap_top;
ADDR heap_lim;
struct FREEB *free_blocks;
#if defined(YAPOR) || defined(THREADS)
rwlock_t bgl; /* protect long critical regions */
lockvar free_blocks_lock; /* protect the list of free blocks */
worker_local wl[MAX_WORKERS];
#else
worker_local wl;
#endif
#ifdef YAPOR
int seq_def;
@ -112,11 +150,6 @@ typedef struct various_codes {
#endif
#ifdef COROUTINING
int num_of_atts; /* max. number of attributes we have for a variable */
#ifdef MULTI_ASSIGNMENT_VARIABLES
Term woken_goals;
Term mutable_list;
Term atts_mutable_list;
#endif
struct pred_entry *wake_up_code;
#endif
struct pred_entry *creep_code;
@ -127,7 +160,6 @@ typedef struct various_codes {
int system_pred_goal_expansion_on;
int compiler_optimizer_on;
int compiler_compile_mode;
struct pred_entry *compiler_current_pred;
AtomHashEntry invisiblechain;
OPCODE dummycode[1];
UInt maxdepth, maxlist;
@ -275,6 +307,7 @@ typedef struct various_codes {
functor_stream,
functor_stream_pos,
functor_stream_eOS,
functor_thread_run,
functor_change_module,
functor_current_module,
functor_u_minus,
@ -325,14 +358,6 @@ typedef struct various_codes {
ADDR foreign_code_top;
ADDR foreign_code_max;
int parser_error_style;
char *compiler_freep;
char *compiler_freep0;
struct PSEUDO *compiler_cpc;
struct PSEUDO *compiler_CodeStart;
struct PSEUDO *compiler_icpc;
struct PSEUDO *compiler_BlobsStart;
int *compiler_label_offset;
UInt i_pred_arity;
int compiler_profiling;
int compiler_call_counting;
/********* whether we should try to compile array references ******************/
@ -346,16 +371,25 @@ typedef struct various_codes {
struct global_data global;
struct local_data remote[MAX_WORKERS];
#endif /* YAPOR || TABLING */
#ifdef THREADS
lockvar thread_handles_lock; /* protect ThreadManipulation */
struct thandle thread_handle[MAX_WORKERS];
#endif
UInt n_of_atoms;
UInt atom_hash_table_size;
AtomHashEntry *hash_chain;
} all_heap_codes;
#ifdef THREADS
struct various_codes *heap_regs;
#else
#define heap_regs ((all_heap_codes *)HEAP_INIT_BASE)
#endif
#define HeapUsed heap_regs->heap_used
#define HeapMax heap_regs->heap_max
#define HeapTop heap_regs->heap_top
#define HeapTop heap_regs->heap_top
#define HeapLim heap_regs->heap_lim
#ifdef YAPOR
#define SEQUENTIAL_IS_DEFAULT heap_regs->seq_def
#define GETWORK (&(heap_regs->getworkcode ))
@ -395,6 +429,10 @@ typedef struct various_codes {
#define UNDEF_OPCODE heap_regs->undef_op
#define INDEX_OPCODE heap_regs->index_op
#define FAIL_OPCODE heap_regs->fail_op
#ifdef THREADS
#define ThreadHandlesLock heap_regs->thread_handles_lock
#define ThreadHandle heap_regs->thread_handle
#endif
#define NOfAtoms heap_regs->n_of_atoms
#define AtomHashTableSize heap_regs->atom_hash_table_size
#define HashChain heap_regs->hash_chain
@ -518,6 +556,7 @@ typedef struct various_codes {
#define FunctorStream heap_regs->functor_stream
#define FunctorStreamPos heap_regs->functor_stream_pos
#define FunctorStreamEOS heap_regs->functor_stream_eOS
#define FunctorThreadRun heap_regs->functor_thread_run
#define FunctorChangeModule heap_regs->functor_change_module
#define FunctorCurrentModule heap_regs->functor_current_module
#define FunctorModSwitch heap_regs->functor_mod_switch
@ -565,21 +604,39 @@ typedef struct various_codes {
#define Yap_LibDir heap_regs->yap_lib_dir
#define AGCHook heap_regs->agc_hook
#define ParserErrorStyle heap_regs->parser_error_style
#define freep heap_regs->compiler_freep
#define freep0 heap_regs->compiler_freep0
#define cpc heap_regs->compiler_cpc
#define CodeStart heap_regs->compiler_CodeStart
#define icpc heap_regs->compiler_icpc
#define BlobsStart heap_regs->compiler_BlobsStart
#define label_offset heap_regs->compiler_label_offset
#define IPredArity heap_regs->i_pred_arity
#ifdef COROUTINING
#define WakeUpCode heap_regs->wake_up_code
#endif
#if defined(YAPOR) || defined(THREADS)
#define SignalLock heap_regs->wl[worker_id].signal_lock
#define ActiveSignals heap_regs->wl[worker_id].active_signals
#define IPredArity heap_regs->wl[worker_id].i_pred_arity
#define ProfEnd heap_regs->wl[worker_id].prof_end
#define StartLine heap_regs->wl[worker_id].start_line
#define ScratchPad heap_regs->wl[worker_id].scratchpad
#ifdef COROUTINING
#define WokenGoals heap_regs->wl[worker_id].woken_goals
#define MutableList heap_regs->wl[worker_id].mutable_list
#define AttsMutableList heap_regs->wl[worker_id].atts_mutable_list
#endif
#else
#define ActiveSignals heap_regs->wl.active_signals
#define IPredArity heap_regs->wl.i_pred_arity
#define ProfEnd heap_regs->wl.prof_end
#define StartLine heap_regs->wl.start_line
#define ScratchPad heap_regs->wl.scratchpad
#ifdef COROUTINING
#define WokenGoals heap_regs->wl.woken_goals
#define MutableList heap_regs->wl.mutable_list
#define AttsMutableList heap_regs->wl.atts_mutable_list
#endif
#endif
#define profiling heap_regs->compiler_profiling
#define call_counting heap_regs->compiler_call_counting
#define compile_arrays heap_regs->compiler_compile_arrays
#define optimizer_on heap_regs->compiler_optimizer_on
#define compile_mode heap_regs->compiler_compile_mode
#define P_before_spy heap_regs->debugger_p_before_spy
#define CurrentPred heap_regs->compiler_current_pred
#define ForeignCodeBase heap_regs->foreign_code_base;
#define ForeignCodeTop heap_regs->foreign_code_top;
#define ForeignCodeMax heap_regs->foreign_code_max;
@ -590,12 +647,6 @@ typedef struct various_codes {
#define LastWtimePtr heap_regs->last_wtime
#define BGL heap_regs->bgl
#define FreeBlocks heap_regs->free_blocks
#ifdef COROUTINING
#define WakeUpCode heap_regs->wake_up_code
#define WokenGoals heap_regs->woken_goals
#define MutableList heap_regs->mutable_list
#define AttsMutableList heap_regs->atts_mutable_list
#endif
#if defined(YAPOR) || defined(THREADS)
#define FreeBlocksLock heap_regs->free_blocks_lock
#define HeapTopLock heap_regs->heap_top_lock
@ -638,3 +689,17 @@ typedef struct various_codes {
#endif
#if defined(YAPOR) || defined(THREADS)
ADDR STD_PROTO(Yap_PreAllocCodeSpace, (void));
ADDR STD_PROTO(Yap_ExpandPreAllocCodeSpace, (void));
void STD_PROTO(Yap_ReleasePreAllocCodeSpace, (ADDR));
#else
EXTERN inline ADDR
Yap_PreAllocCodeSpace(void)
{
return Addr(HeapTop) + sizeof(CELL);
}
#define Yap_ExpandPreAllocCodeSpace() NULL
#define Yap_ReleasePreAllocCodeSpace(x)
#endif

54
H/Regs.h
View File

@ -10,7 +10,7 @@
* File: Regs.h *
* mods: *
* comments: YAP abstract machine registers *
* version: $Id: Regs.h,v 1.21 2003-11-05 18:55:03 ricroc Exp $ *
* version: $Id: Regs.h,v 1.22 2004-01-23 02:22:20 vsc Exp $ *
*************************************************************************/
@ -20,10 +20,8 @@
#ifdef i386
#define PUSH_REGS 1
#ifdef THREADS
#undef PUSH_X
#endif
#endif
#if defined(sparc) || defined(__sparc)
#undef PUSH_REGS
@ -50,6 +48,16 @@
#undef PUSH_X
#endif
/* force a cache of WAM regs for multi-threaded architectures! */
#ifdef THREADS
#ifndef PUSH_REGS
#define PUSH_REGS 1
#endif
#ifndef PUSH_X
#define PUSH_X 1
#endif
#endif
EXTERN void restore_machine_regs(void);
EXTERN void save_machine_regs(void);
EXTERN void restore_H(void);
@ -80,8 +88,6 @@ typedef struct
CELL *LCL0_; /* 3 local stack base */
CELL *AuxSp_; /* 9 Auxiliary stack pointer */
ADDR AuxTop_; /* 10 Auxiliary stack top */
ADDR HeapPlus_; /* 11 To avoid collisions with HeapTop */
tr_fr_ptr MyTR_; /* 12 */
/* visualc*/
CELL FlipFlop_; /* 18 */
CELL EX_; /* 18 */
@ -123,19 +129,19 @@ typedef struct
#if PUSH_X
Term XTERMS[MaxTemps]; /* 29 */
#define XREGS REGS.XTERMS
#endif
}
REGSTORE;
extern REGSTORE *Yap_regp;
#if !PUSH_X
#if PUSH_X
/* keep X as a global variable */
#define XREGS (Yap_regp->XTERMS)
#else
/* keep X as a global variable */
Term Yap_XREGS[MaxTemps]; /* 29 */
@ -143,9 +149,17 @@ Term Yap_XREGS[MaxTemps]; /* 29 */
#endif
#ifdef THREADS
extern pthread_key_t yaamregs_key;
#define Yap_regp ((REGSTORE *)pthread_getspecific(yaamregs_key))
#endif
#define Yap_REGS (*Yap_regp)
#else /* PUSH_REGS */
#else /* !PUSH_REGS */
Term X[MaxTemps]; /* 29 */
@ -629,15 +643,13 @@ EXTERN inline void restore_B(void) {
#endif
#define AuxSp Yap_REGS.AuxSp_
#define AuxTop Yap_REGS.AuxTop_
#define HeapPlus Yap_REGS.HeapPlus_ /*To avoid any chock with HeapTop */
#define MyTR Yap_REGS.MyTR_
#define TopB Yap_REGS.TopB_
#define DelayedB Yap_REGS.DelayedB_
#define FlipFlop Yap_REGS.FlipFlop_
#define EX Yap_REGS.EX_
#define DEPTH Yap_REGS.DEPTH_
#define AuxSp Yap_REGS.AuxSp_
#define AuxTop Yap_REGS.AuxTop_
#define TopB Yap_REGS.TopB_
#define DelayedB Yap_REGS.DelayedB_
#define FlipFlop Yap_REGS.FlipFlop_
#define EX Yap_REGS.EX_
#define DEPTH Yap_REGS.DEPTH_
#if defined(SBA) || defined(TABLING)
#define H_FZ Yap_REGS.H_FZ_
#define B_FZ Yap_REGS.B_FZ_

15
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.41 2003-11-21 16:56:20 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.42 2004-01-23 02:22:23 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -75,6 +75,7 @@ int STD_PROTO(Yap_ExtendWorkSpace,(Int));
void STD_PROTO(Yap_FreeAtomSpace,(char *));
int STD_PROTO(Yap_FreeWorkSpace, (void));
void STD_PROTO(Yap_InitMemory,(int,int,int));
void STD_PROTO(Yap_InitExStacks,(int,int));
/* amasm.c */
OPCODE STD_PROTO(Yap_opcode,(op_numbers));
@ -156,7 +157,7 @@ void STD_PROTO(Yap_trust_last,(void));
/* grow.c */
Int STD_PROTO(Yap_total_stack_shift_time,(void));
void STD_PROTO(Yap_InitGrowPreds, (void));
int STD_PROTO(Yap_growheap, (int, UInt));
int STD_PROTO(Yap_growheap, (int, UInt, void *));
int STD_PROTO(Yap_growstack, (long));
int STD_PROTO(Yap_growtrail, (long));
int STD_PROTO(Yap_growglobal, (CELL **));
@ -178,11 +179,12 @@ void STD_PROTO(Yap_DebugEndline,(void));
int STD_PROTO(Yap_DebugGetc,(void));
#endif
int STD_PROTO(Yap_IsOpType,(char *));
void STD_PROTO(Yap_InitStacks,(int,int,int,int,int,int));
void STD_PROTO(Yap_InitCPred,(char *, unsigned long int, CPredicate, int));
void STD_PROTO(Yap_InitAsmPred,(char *, unsigned long int, int, CPredicate, int));
void STD_PROTO(Yap_InitCmpPred,(char *, unsigned long int, CmpPredicate, int));
void STD_PROTO(Yap_InitCPredBack,(char *, unsigned long int, unsigned int, CPredicate,CPredicate,int));
void STD_PROTO(Yap_InitWorkspace,(int,int,int,int,int,int));
void STD_PROTO(Yap_KillStacks,(void));
void STD_PROTO(Yap_InitYaamRegs,(void));
void STD_PROTO(Yap_ReInitWallTime, (void));
int STD_PROTO(Yap_OpDec,(int,char *,Atom));
@ -250,7 +252,7 @@ void STD_PROTO(Yap_InitSortPreds,(void));
void STD_PROTO(Yap_InitBackCPreds,(void));
void STD_PROTO(Yap_InitCPreds,(void));
void STD_PROTO(Yap_show_statistics,(void));
Int STD_PROTO(Yap_creep,(void));
void STD_PROTO(Yap_signal,(yap_signals));
/* sysbits.c */
void STD_PROTO(Yap_set_fpu_exceptions,(int));
@ -270,6 +272,11 @@ int STD_PROTO(Yap_TrueFileName, (char *, char *, int));
int STD_PROTO(Yap_ProcessSIGINT,(void));
double STD_PROTO(Yap_random, (void));
/* threads.c */
#ifdef THREADS
void STD_PROTO(Yap_InitThreadPreds,(void));
#endif /* ANALYST */
/* tracer.c */
#ifdef LOW_LEVEL_TRACER
void STD_PROTO(Yap_InitLowLevelTrace,(void));

6
H/absmi.h
View File

@ -175,7 +175,11 @@ inline EXTERN void
restore_absmi_regs(REGSTORE * old_regs)
{
memcpy(old_regs, Yap_regp, sizeof(REGSTORE));
#ifdef THREADS
pthread_setspecific(yaamregs_key, (void *)old_regs);
#else
Yap_regp = old_regs;
#endif
}
#endif /* PUSH_REGS */
@ -554,7 +558,7 @@ typedef CELL label;
#define XREG(I) XREGS[I]
#endif /* ALIGN_LONGS */
#endif /* PRECOMPUTE_REGADDRESS */
/* The Unification Stack is the Auxiliary stack */

16
H/alloc.h
View File

@ -25,9 +25,7 @@
HeapTop \
| Free Space
AuxSp \
| Auxiliary stack
AuxTop /
HeapMax /
GlobalBase-1/
@ -123,12 +121,6 @@ MALLOC_T calloc(size_t,size_t);
#endif
#if defined(YAPOR) || defined(THREADS)
#define HEAPTOP_OWNER(worker_id) ((worker_id) == HeapTopOwner)
#define HEAPTOP_OWN(worker_id) (HeapTopOwner = (worker_id))
#define HEAPTOP_DISOWN(worker_id) (HeapTopOwner = -1)
#else
#define HEAPTOP_OWNER(worker_id) (FALSE)
#define HEAPTOP_OWN(worker_id)
#define HEAPTOP_DISOWN(worker_id)
#endif
#define SCRATCH_START_SIZE (64*1024L)
#define SCRATCH_INC_SIZE (64*1024L)

5
H/clause.h
View File

@ -191,11 +191,6 @@ void STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *));
LogUpdClause *STD_PROTO(Yap_NthClause,(PredEntry *,Int));
LogUpdClause *STD_PROTO(Yap_FollowIndexingCode,(PredEntry *,yamop *,Term,Term,Term, yamop *,yamop *));
#if LOW_PROF
/* profiling */
yamop *Yap_prof_end;
#endif /* LOW_PROF */
#if USE_THREADED_CODE
#define OP_HASH_SIZE 2048

31
H/compile.h
View File

@ -203,6 +203,22 @@ typedef struct CEXPENTRY {
struct CEXPENTRY *RightCE, *LeftCE;
} CExpEntry;
typedef struct intermediates {
char *freep;
char *freep0;
struct PSEUDO *cpc;
struct PSEUDO *CodeStart;
struct PSEUDO *icpc;
struct PSEUDO *BlobsStart;
int *label_offset;
Int *uses;
Term *contents;
struct pred_entry *CurrentPred;
jmp_buf CompilerBotch;
yamop *code_addr;
} CIntermediates;
#define SafeVar 0x01
#define PermFlag 0x02
#define GlobalVal 0x04
@ -234,17 +250,16 @@ typedef struct CEXPENTRY {
#define Two 2
yamop *STD_PROTO(Yap_assemble,(int,Term,struct pred_entry *,int));
void STD_PROTO(Yap_emit,(compiler_vm_op,Int,CELL));
void STD_PROTO(Yap_emit_3ops,(compiler_vm_op,CELL,CELL,CELL));
void STD_PROTO(Yap_emit_4ops,(compiler_vm_op,CELL,CELL,CELL,CELL));
CELL *STD_PROTO(Yap_emit_extra_size,(compiler_vm_op,CELL,int));
char *STD_PROTO(Yap_AllocCMem,(int));
yamop *STD_PROTO(Yap_assemble,(int,Term,struct pred_entry *,int, struct intermediates *));
void STD_PROTO(Yap_emit,(compiler_vm_op,Int,CELL, struct intermediates *));
void STD_PROTO(Yap_emit_3ops,(compiler_vm_op,CELL,CELL,CELL, struct intermediates *));
void STD_PROTO(Yap_emit_4ops,(compiler_vm_op,CELL,CELL,CELL,CELL, struct intermediates *));
CELL *STD_PROTO(Yap_emit_extra_size,(compiler_vm_op,CELL,int, struct intermediates *));
char *STD_PROTO(Yap_AllocCMem,(int, struct intermediates *));
int STD_PROTO(Yap_is_a_test_pred,(Term, SMALLUNSGN));
void STD_PROTO(Yap_bip_name,(Int, char *));
#ifdef DEBUG
void STD_PROTO(Yap_ShowCode,(void));
void STD_PROTO(Yap_ShowCode,(struct intermediates *));
#endif /* DEBUG */
extern jmp_buf Yap_CompilerBotch;

10
H/rheap.h
View File

@ -328,10 +328,12 @@ restore_codes(void)
#ifdef COROUTINING
if (heap_regs->wake_up_code != NULL)
heap_regs->wake_up_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->wake_up_code));
heap_regs->mutable_list =
AbsAppl(PtoGloAdjust(RepAppl(heap_regs->mutable_list)));
heap_regs->atts_mutable_list =
AbsAppl(PtoGloAdjust(RepAppl(heap_regs->atts_mutable_list)));
#if !defined(THREADS)
heap_regs->wl.mutable_list =
AbsAppl(PtoGloAdjust(RepAppl(heap_regs->wl.mutable_list)));
heap_regs->wl.atts_mutable_list =
AbsAppl(PtoGloAdjust(RepAppl(heap_regs->wl.atts_mutable_list)));
#endif
#endif
if (heap_regs->last_wtime != NULL)
heap_regs->last_wtime = (void *)PtoHeapCellAdjust((CELL *)(heap_regs->last_wtime));

32
H/yapio.h
View File

@ -162,14 +162,6 @@ extern YP_FILE yp_iob[YP_MAX_FILES];
#endif /* YAP_STDIO */
#if defined(FILENAME_MAX) && !defined(__hpux)
#define YAP_FILENAME_MAX FILENAME_MAX
#else
#define YAP_FILENAME_MAX 1024 /* This is ok for Linux, should be ok for everyone */
#endif
extern char Yap_FileNameBuf[YAP_FILENAME_MAX], Yap_FileNameBuf2[YAP_FILENAME_MAX];
typedef YP_FILE *YP_File;
enum TokenKinds {
@ -254,11 +246,6 @@ typedef struct AliasDescS {
#define NUMBER_OF_CHARS 256
extern char *Yap_chtype;
/*************** variables concerned with parsing *********************/
extern TokEntry *Yap_tokptr, *Yap_toktide;
extern VarEntry *Yap_VarTable, *Yap_AnonVarTable;
extern int Yap_eot_before_eof;
/* parser stack, used to be AuxSp, now is ASP */
#define ParserAuxSp (TR)
@ -349,8 +336,27 @@ HashFunction(char *CHP)
#define CONTINUE_ON_PARSER_ERROR 2
#define EXCEPTION_ON_PARSER_ERROR 3
#ifdef THREADS
#define Yap_IOBotch Yap_thread_gl[worker_id].io_botch
#define Yap_tokptr Yap_thread_gl[worker_id].tokptr
#define Yap_toktide Yap_thread_gl[worker_id].toktide
#define Yap_VarTable Yap_thread_gl[worker_id].var_table
#define Yap_AnonVarTable Yap_thread_gl[worker_id].anon_var_table
#define Yap_eot_before_eof Yap_thread_gl[worker_id].eot_before_eof
#define Yap_FileNameBuf Yap_thread_gl[worker_id].file_name_buf
#define Yap_FileNameBuf2 Yap_thread_gl[worker_id].file_name_buf2
#else
extern jmp_buf Yap_IOBotch;
/*************** variables concerned with parsing *********************/
extern TokEntry *Yap_tokptr, *Yap_toktide;
extern VarEntry *Yap_VarTable, *Yap_AnonVarTable;
extern int Yap_eot_before_eof;
extern char Yap_FileNameBuf[YAP_FILENAME_MAX], Yap_FileNameBuf2[YAP_FILENAME_MAX];
#endif
#ifdef DEBUG
extern YP_FILE *Yap_logfile;
#endif

5
OPTYap/opt.memory.c
View File

@ -182,8 +182,7 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
Yap_TrailTop = Yap_TrailBase + TrailAuxArea / 2;
AuxTop = Yap_TrailBase + TrailAuxArea - CellSize;
AuxSp = (CELL *) AuxTop;
HeapMax = Yap_TrailBase + TrailAuxArea - CellSize;
Yap_InitHeap(mmap_addr);
BaseWorkArea = mmap_addr;
@ -254,8 +253,6 @@ void remap_memory(void) {
Yap_TrailBase += worker_id * WorkerArea;
Yap_LocalBase += worker_id * WorkerArea;
Yap_TrailTop += worker_id * WorkerArea;
AuxTop += worker_id * WorkerArea;
AuxSp = (CELL *) AuxTop;
#endif /* SBA */
#ifdef ENV_COPY
void *remap_addr;

5
OPTYap/opt.structs.h
View File

@ -4,11 +4,6 @@
typedef double realtime;
typedef unsigned long bitmap;
#ifdef YAPOR
#define MAX_WORKERS (sizeof(bitmap) * 8)
#else
#define MAX_WORKERS 1
#endif /* YAPOR */

6
config.h.in
View File

@ -41,6 +41,9 @@
/* Host Name ? */
#undef HOST_ALIAS
#undef SUPPORT_CONDOR
#undef SUPPORT_THREADS
#undef HAVE_SYS_WAIT_H
#undef NO_UNION_WAIT
@ -63,6 +66,7 @@
#undef HAVE_MEMORY_H
#undef HAVE_NETDB_H
#undef HAVE_NETINET_IN_H
#undef HAVE_PTHREAD_H
#undef HAVE_READLINE_READLINE_H
#undef HAVE_REGEX_H
#undef HAVE_SIGINFO_H
@ -171,6 +175,8 @@
#undef HAVE_NSLINKMODULE
#undef HAVE_OPENDIR
#undef HAVE_POPEN
#undef HAVE_PTHREAD_MUTEXATTR_SETKIND_NP
#undef HAVE_PTHREAD_MUTEXATTR_SETTYPE
#undef HAVE_PUTENV
#undef HAVE_RAND
#undef HAVE_RANDOM

16823
configure vendored
View File

File diff suppressed because it is too large Load Diff

9
configure.in
View File

@ -177,6 +177,7 @@ then
CC="condor_compile $CC"
dnl no readline with condor.
yap_cv_readline="no"
AC_DEFINE(SUPPORT_CONDOR, 1)
fi
dnl Compilation Flags
@ -332,6 +333,14 @@ then
AC_CHECK_LIB(gmp,main)
fi
if test "$threads" = yes
then
AC_DEFINE(SUPPORT_THREADS, 1)
AC_CHECK_LIB(pthread,pthread_create)
AC_CHECK_HEADERS(pthread.h)
AC_CHECK_FUNCS(pthread_mutexattr_setkind_np pthread_mutexattr_settype)
fi
MPI_OBJS=
if test "$yap_cv_mpi" != "no"
then

60
console/yap.c
View File

@ -90,6 +90,7 @@ static int output_msg;
#endif
static char BootFile[] = "boot.yap";
static char InitFile[] = "init.yap";
#ifdef lint
/* VARARGS1 */
@ -249,9 +250,13 @@ static int
parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
{
char *p;
#if defined(SUPPORT_THREADS) || defined(SUPPORT_CONDOR)
int BootMode = YAP_FULL_BOOT_FROM_PROLOG;
#else
int BootMode = YAP_BOOT_FROM_SAVED_CODE;
#endif
int *ssize;
while (--argc > 0)
{
p = *++argv;
@ -418,6 +423,8 @@ parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
return(BootMode);
}
static char boot_file[256];
static int
init_standard_system(int argc, char *argv[], YAP_init_args *iap)
{
@ -429,6 +436,7 @@ init_standard_system(int argc, char *argv[], YAP_init_args *iap)
iap->TrailSize = 0;
iap->YapLibDir = NULL;
iap->YapPrologBootFile = NULL;
iap->YapPrologInitFile = NULL;
iap->YapPrologRCFile = NULL;
iap->HaltAfterConsult = FALSE;
iap->FastBoot = FALSE;
@ -440,8 +448,23 @@ init_standard_system(int argc, char *argv[], YAP_init_args *iap)
BootMode = parse_yap_arguments(argc,argv,iap);
if (BootMode == YAP_FULL_BOOT_FROM_PROLOG) {
#if HAVE_STRNCAT
strncpy(boot_file, PL_SRC_DIR, 256);
#else
strcpy(boot_file, PL_SRC_DIR);
#endif
#if HAVE_STRNCAT
strncat(boot_file, BootFile, 256);
#else
strcat(boot_file, BootFile);
#endif
iap->YapPrologBootFile = boot_file;
}
/* init memory */
if (BootMode == YAP_BOOT_FROM_PROLOG) {
if (BootMode == YAP_BOOT_FROM_PROLOG ||
BootMode == YAP_FULL_BOOT_FROM_PROLOG) {
YAP_Init(iap);
} else {
BootMode = YAP_Init(iap);
@ -461,14 +484,45 @@ exec_top_level(int BootMode, YAP_init_args *iap)
/* continue executing from the frozen stacks */
YAP_ContinueGoal();
}
else if (BootMode == YAP_BOOT_FROM_PROLOG)
else if (BootMode == YAP_BOOT_FROM_PROLOG ||
BootMode == YAP_FULL_BOOT_FROM_PROLOG)
{
YAP_Atom livegoal;
/* read the bootfile */
do_bootfile (iap->YapPrologBootFile ? iap->YapPrologBootFile : BootFile);
livegoal = YAP_FullLookupAtom("$live");
/* initialise the top-level */
if (BootMode == YAP_FULL_BOOT_FROM_PROLOG) {
char init_file[256];
YAP_Atom atfile;
YAP_Functor fgoal;
YAP_Term goal, as[1];
#if HAVE_STRNCAT
strncpy(init_file, PL_SRC_DIR, 256);
#else
strcpy(init_file, PL_SRC_DIR);
#endif
#if HAVE_STRNCAT
strncat(init_file, InitFile, 256);
#else
strcat(init_file, InitFile);
#endif
/* consult init file */
atfile = YAP_LookupAtom(init_file);
as[0] = YAP_MkAtomTerm(atfile);
fgoal = YAP_MkFunctor(YAP_FullLookupAtom("$consult"), 1);
goal = YAP_MkApplTerm(fgoal, 1, as);
/* launch consult */
YAP_RunGoal(goal);
/* set default module to user */
as[0] = YAP_MkAtomTerm(YAP_LookupAtom("user"));
fgoal = YAP_MkFunctor(YAP_FullLookupAtom("module"), 1);
goal = YAP_MkApplTerm(fgoal, 1, as);
YAP_RunGoal(goal);
}
YAP_PutValue(livegoal, YAP_MkAtomTerm (YAP_FullLookupAtom("$true")));
}
/* the top-level is now ready */

3
include/yap_structs.h
View File

@ -50,6 +50,7 @@ typedef struct AtomEntry *YAP_Atom;
#define YAP_BOOT_FROM_PROLOG 0
#define YAP_BOOT_FROM_SAVED_CODE 1
#define YAP_BOOT_FROM_SAVED_STACKS 2
#define YAP_FULL_BOOT_FROM_PROLOG 4
#define YAP_BOOT_FROM_SAVED_ERROR -1
#define YAP_WRITE_QUOTED 0
@ -72,6 +73,8 @@ typedef struct {
char *YapLibDir;
/* if NON-NULL, name for a Prolog file to use when booting */
char *YapPrologBootFile;
/* if NON-NULL, name for a Prolog file to use when initialising */
char *YapPrologInitFile;
/* if NON-NULL, name for a Prolog file to consult before entering top-level */
char *YapPrologRCFile;
/* if previous NON-NULL and TRUE, halt after consulting that file */

10
m4/TermExt.h.m4
View File

@ -10,9 +10,15 @@
* File: TermExt.h *
* mods: *
* comments: Extensions to standard terms for YAP *
* version: $Id: TermExt.h.m4,v 1.11 2003-12-27 00:38:53 vsc Exp $ *
* version: $Id: TermExt.h.m4,v 1.12 2004-01-23 02:23:12 vsc Exp $ *
*************************************************************************/
#ifdef THREADS
#define SF_STORE (&(heap_regs->funcs))
#else
#define SF_STORE ((special_functors *)HEAP_INIT_BASE)
#endif
#if USE_OFFSETS
#define AtomFoundVar ((Atom)(&(((special_functors *)(NULL))->AtFoundVar)))
#define AtomNil ((Atom)(&(((special_functors *)(NULL))->AtNil)))
@ -61,8 +67,6 @@ typedef enum {
Destructor(Functor, BlobOf, blob_type, f, (CELL)f)
#define SF_STORE ((special_functors *)HEAP_INIT_BASE)
#ifdef COROUTINING
typedef struct {

119
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.49 2003-11-12 12:33:31 vsc Exp $ *
* version: $Id: Yap.h.m4,v 1.50 2004-01-23 02:23:15 vsc Exp $ *
*************************************************************************/
#include "config.h"
@ -142,6 +142,16 @@
** and integer types Short and UShort with half the size of a ptr
*/
#ifdef THREADS
#include <pthread.h>
#endif
#if defined(YAPOR) || defined(THREADS)
#define MAX_WORKERS (sizeof(unsigned long) * 8)
#else
#define MAX_WORKERS 1
#endif /* YAPOR */
#if SIZEOF_INT_P==4
#if SIZEOF_INT==4
@ -251,6 +261,10 @@ extern char Yap_Option[20];
#endif
#endif /* !IN_SECOND_QUADRANT */
#ifdef THREADS
#define HEAP_INIT_BASE 0L
#define AtomBase NULL
#else
#if defined(MMAP_ADDR) && (USE_MMAP || USE_SHMAT || _WIN32) && !__simplescalar__
#define HEAP_INIT_BASE (MMAP_ADDR)
#define AtomBase ((char *)MMAP_ADDR)
@ -258,6 +272,7 @@ extern char Yap_Option[20];
#define HEAP_INIT_BASE ((CELL)Yap_HeapBase)
#define AtomBase (Yap_HeapBase)
#endif
#endif
@ -380,8 +395,6 @@ typedef volatile int lockvar;
#define siglongjmp(Env, Arg) longjmp(Env, Arg)
#endif
extern sigjmp_buf Yap_RestartEnv; /* used to restart after an abort */
/* Support for arrays */
#include "arrays.h"
@ -474,11 +487,6 @@ typedef enum {
UNKNOWN_ERROR
} yap_error_number;
extern char *Yap_ErrorMessage; /* used to pass error messages */
extern Term Yap_Error_Term; /* used to pass error terms */
extern yap_error_number Yap_Error_TYPE; /* used to pass the error */
extern UInt Yap_Error_Size; /* used to pass the error */
typedef enum {
YAP_INT_BOUNDED_FLAG = 0,
MAX_ARITY_FLAG = 1,
@ -519,6 +527,20 @@ typedef enum {
INDEX_MODE_MAX = 4
} index_mode_options;
typedef enum {
YAP_CREEP_SIGNAL = 0x1, /* received a creep */
YAP_WAKEUP_SIGNAL = 0x2, /* goals to wake up */
YAP_ALARM_SIGNAL = 0x4, /* received an alarm */
YAP_HUP_SIGNAL = 0x8, /* received SIGHUP */
YAP_USR1_SIGNAL = 0x10, /* received SIGUSR1 */
YAP_USR2_SIGNAL = 0x20, /* received SIGUSR2 */
YAP_INT_SIGNAL = 0x40, /* received SIGINT (unused for now) */
YAP_ITI_SIGNAL = 0x80, /* received inter thread signal */
YAP_TROVF_SIGNAL = 0x100, /* received trail overflow */
YAP_CDOVF_SIGNAL = 0x200, /* received code overflow */
YAP_STOVF_SIGNAL = 0x400 /* received stack overflow */
} yap_signals;
#define NUMBER_OF_YAP_FLAGS INDEXING_MODE_FLAG+1
/************************ prototypes **********************************/
@ -642,11 +664,73 @@ and RefOfTerm(t) : Term -> DBRef = ...
/************* variables related to memory allocation *******************/
/* must be before TermExt.h */
extern ADDR Yap_HeapBase,
Yap_LocalBase,
Yap_GlobalBase,
Yap_TrailBase,
Yap_TrailTop;
extern ADDR Yap_HeapBase;
#define MAX_ERROR_MSG_SIZE 256
/* This is ok for Linux, should be ok for everyone */
#define YAP_FILENAME_MAX 1024
#ifdef THREADS
typedef struct thread_globs {
ADDR local_base;
ADDR global_base;
ADDR trail_base;
ADDR trail_top;
char *error_message;
Term error_term;
Term error_type;
UInt error_size;
char error_say[MAX_ERROR_MSG_SIZE];
jmp_buf io_botch;
sigjmp_buf restart_env;
struct TOKEN *tokptr;
struct TOKEN *toktide;
struct VARSTRUCT *var_table;
struct VARSTRUCT *anon_var_table;
int eot_before_eof;
char file_name_buf[YAP_FILENAME_MAX];
char file_name_buf2[YAP_FILENAME_MAX];
} tglobs;
extern struct thread_globs Yap_thread_gl[MAX_WORKERS];
#define Yap_LocalBase Yap_thread_gl[worker_id].local_base
#define Yap_GlobalBase Yap_thread_gl[worker_id].global_base
#define Yap_TrailBase Yap_thread_gl[worker_id].trail_base
#define Yap_TrailTop Yap_thread_gl[worker_id].trail_top
#define Yap_ErrorMessage Yap_thread_gl[worker_id].error_message
#define Yap_Error_Term Yap_thread_gl[worker_id].error_term
#define Yap_Error_TYPE Yap_thread_gl[worker_id].error_type
#define Yap_Error_Size Yap_thread_gl[worker_id].error_size
#define Yap_ErrorSay Yap_thread_gl[worker_id].error_say
#define Yap_RestartEnv Yap_thread_gl[worker_id].restart_env
#else
extern ADDR Yap_HeapBase,
Yap_LocalBase,
Yap_GlobalBase,
Yap_TrailBase,
Yap_TrailTop;
extern sigjmp_buf Yap_RestartEnv; /* used to restart after an abort */
extern char *Yap_ErrorMessage; /* used to pass error messages */
extern Term Yap_Error_Term; /* used to pass error terms */
extern yap_error_number Yap_Error_TYPE; /* used to pass the error */
extern UInt Yap_Error_Size; /* used to pass the error */
/******************* storing error messages ****************************/
extern char Yap_ErrorSay[MAX_ERROR_MSG_SIZE];
#endif
#ifdef DEBUG
/************** Debugging Support ***************************/
extern int Yap_output_msg;
#endif
/* applies to unbound variables */
@ -775,10 +859,6 @@ typedef struct opcode_tab_entry {
#endif
/******************* storing error messages ****************************/
#define MAX_ERROR_MSG_SIZE 256
extern char Yap_ErrorSay[MAX_ERROR_MSG_SIZE];
/********* Prolog may be in several modes *******************************/
typedef enum {
@ -800,11 +880,6 @@ extern int Yap_CritLocks;
extern char **Yap_argv;
extern int Yap_argc;
#ifdef DEBUG
/************** Debugging Support ***************************/
extern int Yap_output_msg;
#endif
/******************* number of modules ****************************/
#define MaxModules 256

7
m4/Yatom.h.m4
View File

@ -543,13 +543,6 @@ PredPropByAtom(Atom at, SMALLUNSGN cur_mod)
return(Yap_NewPredPropByAtom(ae,cur_mod));
}
ADDR STD_PROTO(Yap_PreAllocCodeSpace, (void));
#if defined(YAPOR) || defined(THREADS)
void STD_PROTO(Yap_ReleasePreAllocCodeSpace, (ADDR));
#else
#define Yap_ReleasePreAllocCodeSpace(x)
#endif
typedef enum {
PROLOG_MODULE = 0,
USER_MODULE = 1,

21
pl/boot.yap
View File

@ -53,27 +53,6 @@ read_sig.
;
true
),
% If this is not here, the following get written twice in the idb. Why?
eraseall('$sig_handler'),
% The default interrupt handlers are kept, so that it's
% possible to revert to them with on_signal(S,_,default)
recordz('$sig_handler',default(sig_hup,
(( exists('~/.yaprc') -> [-'~/.yaprc'] ; true ),
( exists('~/.prologrc') -> [-'~/.prologrc'] ; true ),
( exists('~/prolog.ini') -> [-'~/prolog.ini'] ; true ))), _),
recordz('$sig_handler',default(sig_usr1,
(nl,writeq('[ Received user signal 1 ]'),nl,halt)), _),
recordz('$sig_handler',default(sig_usr2,
(nl,writeq('[ Received user signal 2 ]'),nl,halt)), _),
% The current interrupt handlers are also set the default values
recordz('$sig_handler',action(sig_hup,
(( exists('~/.yaprc') -> [-'~/.yaprc'] ; true ),
( exists('~/.prologrc') -> [-'~/.prologrc'] ; true ),
( exists('~/prolog.ini') -> [-'~/prolog.ini'] ; true ))), _),
recordz('$sig_handler',action(sig_usr1,
(nl,writeq('[ Received user signal 1 ]'),nl,halt)), _),
recordz('$sig_handler',action(sig_usr2,
(nl,writeq('[ Received user signal 2 ]'),nl,halt)), _),
'$set_yap_flags'(10,0),
set_value('$gc',on),
set_value('$verbose',on),

11
pl/debug.yap
View File

@ -244,23 +244,12 @@ debugging :-
% when 1 spying is enabled *(the same as spy stop).
'$creep'([Mod|G]) :-
'$stop_debugging',
CP is '$last_choice_pt',
'$do_spy'(G, Mod, CP, no).
%'$spy'(G) :- write(user_error,'$spy'(G)), nl, fail.
%
% handle suspended goals
% take care with hidden goals.
%
% $spy may be called from user code, so be careful.
'$spy'(G) :-
'$stop_debugging',
% we can start working now.
'$awoken_goals'(LG), !,
'$creep',
'$wake_up_goal'(G, LG).
'$spy'([Mod|G]) :-
CP is '$last_choice_pt',
'$do_spy'(G, Mod, CP, no).

17
pl/errors.yap
View File

@ -8,7 +8,7 @@
* *
**************************************************************************
* *
* File: boot.yap *
* File: errors.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: error messages for YAP *
@ -396,6 +396,12 @@ print_message(Level, Mss) :-
'$output_error_message'(existence_error(array,F), W) :-
'$format'(user_error,"[ EXISTENCE ERROR- ~w could not open array ~w ]~n",
[W,F]).
'$output_error_message'(existence_error(mutex,F), W) :-
'$format'(user_error,"[ EXISTENCE ERROR- ~w could not open mutex ~w ]~n",
[W,F]).
'$output_error_message'(existence_error(queue,F), W) :-
'$format'(user_error,"[ EXISTENCE ERROR- ~w could not open message queue ~w ]~n",
[W,F]).
'$output_error_message'(existence_error(procedure,P), _) :-
'$format'(user_error,"[ EXISTENCE ERROR- procedure ~w undefined ]~n",
[P]).
@ -447,6 +453,12 @@ print_message(Level, Mss) :-
'$output_error_message'(permission_error(create,array,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot create array ~w ]~n",
[Where,P]).
'$output_error_message'(permission_error(create,mutex,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot create mutex ~a ]~n",
[Where,P]).
'$output_error_message'(permission_error(create,queue,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot create queue ~a ]~n",
[Where,P]).
'$output_error_message'(permission_error(create,operator,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot create operator ~w ]~n",
[Where,P]).
@ -495,6 +507,9 @@ print_message(Level, Mss) :-
'$output_error_message'(permission_error(resize,array,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot resize array ~w ]~n",
[Where,P]).
'$output_error_message'(permission_error(unlock,mutex,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot unlock mutex ~w ]~n",
[Where,P]).
'$output_error_message'(representation_error(character), Where) :-
'$format'(user_error,"[ REPRESENTATION ERROR- ~w: expected character ]~n",
[Where]).

4
pl/grammar.yap
View File

@ -120,3 +120,7 @@ phrase(Phrase, S0, S) :-
'$t_body'(Phrase, _, last, S0, S, Goal), !,
'$execute'(Goal).
'$append'([], L, L) .
'$append'([H|T], L, [H|R]) :-
'$append'(T, L, R).

2
pl/init.yap
View File

@ -59,6 +59,7 @@ not(G) :- '$current_module'(Module), '$meta_call'(not(G),Module).
% modules must be after preds, otherwise we will have trouble
% with meta-predicate expansion being invoked
'modules.yap',
'signals.yap',
'profile.yap',
'callcount.yap',
'load_foreign.yap',
@ -67,6 +68,7 @@ not(G) :- '$current_module'(Module), '$meta_call'(not(G),Module).
'setof.yap',
'strict_iso.yap',
'tabling.yap',
'threads.yap',
'yapor.yap'].
:- ['protect.yap'].

112
pl/signals.yap Normal file
View File

@ -0,0 +1,112 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: signals.pl *
* Last rev: *
* mods: *
* comments: signal handling in YAP *
* *
*************************************************************************/
:- meta_predicate on_signal(+,?,:), alarm(+,:,-).
'$creep'(G) :-
% get the first signal from the mask
'$first_signal'(Sig), !,
% process it
'$do_signal'(Sig, G).
'$creep'([M|G]) :-
% noise, just go on with our life.
'$execute'(M:G).
'$do_signal'(sig_wake_up, G) :-
'$awoken_goals'(LG),
% if more signals alive, set creep flag
'$continue_signals',
'$wake_up_goal'(G, LG).
'$do_signal'(sig_creep, G) :-
'$start_creep'(G).
% Unix signals
'$do_signal'(sig_alarm, G) :-
'$signal_handler'(sig_alarm, G).
'$do_signal'(sig_hup, G) :-
'$signal_handler'(sig_hup, G).
'$do_signal'(sig_usr1, G) :-
'$signal_handler'(sig_usr1, G).
'$do_signal'(sig_usr2, G) :-
'$signal_handler'(sig_usr2, G).
'$signal_handler'(Sig, [M|G]) :-
'$signal_do'(Sig, Goal),
% if more signals alive, set creep flag
'$continue_signals',
'$current_module'(M0),
'$execute0'((Goal,M:G),M0).
% notice that the last signal to be processed must always be creep
'$start_creep'([_|'$cut_by'(CP)]) :- !,
'$cut_by'(CP),
'$creep'.
'$start_creep'([_|true]) :- !,
'$creep'.
'$start_creep'([Mod|G]) :-
'$hidden_predicate'(G,Mod), !,
'$creep',
'$execute0'(G,Mod).
'$start_creep'([Mod|G]) :-
'$stop_debugging',
CP is '$last_choice_pt',
'$do_spy'(G, Mod, CP, no).
'$signal_do'(Sig, Goal) :-
recorded('$signal_handler', action(Sig,Goal), _), !.
'$signal_do'(Sig, Goal) :-
'$signal_def'(Sig, Goal).
% reconsult init files.
'$signal_def'(sig_hup, (( exists('~/.yaprc') -> [-'~/.yaprc'] ; true ),
( exists('~/.prologrc') -> [-'~/.prologrc'] ; true ),
( exists('~/prolog.ini') -> [-'~/prolog.ini'] ; true ))).
% die on signal default.
'$signal_def'(sig_usr1, (print_message(error, 'Received user signal 1'),halt)).
'$signal_def'(sig_usr2, (print_message(error, 'Received user signal 2'),halt)).
% ignore sig_alarm by default
'$signal_def'(sig_alarm, true).
on_signal(Signal,OldAction,default) :-
'$reset_signal'(Signal, OldAction).
on_signal(Signal,OldAction,Action) :-
var(Action),
'$check_signal'(OldAction),
Action = OldAction.
on_signal(Signal,OldAction,Action) :-
'$reset_signal'(Signal, OldAction),
'$current_module'(M),
recordz('$sig_handler', action(Signal,M:Action), _).
'$reset_signal'(Signal, OldAction) :-
recorded('$sig_handler', action(Signal,OldAction), Ref), !,
erase(Ref).
'$reset_signal'(_, default).
'$check_signal'(Signal, OldAction) :-
recorded('$sig_handler', action(Signal,OldAction), _), !.
'$reset_signal'(_, default).
alarm(Interval, Goal, Left) :-
on_signal(sig_alarm, _, Goal),
'$alarm'(Interval, Left).
raise_exception(Ball) :- throw(Ball).
on_exception(Pat, G, H) :- catch(G, Pat, H).

340
pl/threads.yap Normal file
View File

@ -0,0 +1,340 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: threads.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: support threads *
* *
*************************************************************************/
:- meta_predicate thread_create(:,-,+), thread_at_exit(:).
'$top_thread_goal'(G) :-
'$current_module'(Module),
'$system_catch'((G,'$close_thread'),Module,Exception,'$thread_exception'(Exception)).
'$top_thread_goal'(_) :-
'$thread_self'(Id0),
recorda('$thread_exit_status', [Id0|false], _),
'$run_at_thread_exit'(Id0).
'$close_thread' :-
'$thread_self'(Id0),
recorda('$thread_exit_status', [Id0|true], _),
'$run_at_thread_exit'(Id0).
'$thread_exception'(Exception) :-
'$thread_self'(Id0),
recorda('$thread_exit_status', [Id0|exception(Exception)], _),
'$run_at_thread_exit'(Id0).
thread_create(Goal, Id, Options) :-
G0 = thread_create(Goal, Id, Options),
'$check_callable'(Goal,G0),
'$thread_options'(Options, Aliases, Stack, Trail, System, Detached, G0),
'$create_thread'(Goal, Stack, Trail, System, Id),
'$clean_db_on_id'(Id),
(Detached == true -> '$detach_thread'(Id) ; true),
'$create_mq'(Id),
'$add_thread_aliases'(Aliases, Id).
'$clean_db_on_id'(Id) :-
recorda('$thread_exit_status', [Id|_], R),
erase(R),
fail.
'$clean_db_on_id'(Id) :-
recorded('$thread_alias',[Id|_],R),
erase(R),
fail.
'$clean_db_on_id'(Id) :-
recorded('$thread_exit_hook',[Id|_],R),
erase(R),
fail.
'$clean_db_on_id'(_).
'$thread_options'(V, _, _, _, _, _, G) :- var(V), !,
'$do_error'(instantiation_error,G).
'$thread_options'([], [], Stack, Trail, System, _, _) :-
'$thread_ground_stacks'(Stack),
'$thread_ground_stacks'(Trail),
'$thread_ground_stacks'(System).
'$thread_options'([Opt|OPts], Aliases, Stack, Trail, System, Detached, G0) :-
'$thread_option'(OPt, Aliases, Stack, Trail, System, Detached, G0, Aliases0),
'$thread_options'(Opts, Aliases0, Stack, Trail, System, Detached, G0).
'$thread_option'(stacks(Stack), Aliases, Stack, _, _, _, G0, Aliases) :- !,
( \+ integer(Stack) -> '$do_error'(type_error(integer,Stack),G0) ; true ).
'$thread_option'(trail(Trail), Aliases, _, Trail, _, _, G0, Aliases) :- !,
( \+ integer(Trail) -> '$do_error'(type_error(integer,Trail),G0) ; true ).
'$thread_option'(system(Trail), Aliases, _, _, System, _, G0, Aliases) :- !,
( \+ integer(System) -> '$do_error'(type_error(integer,System),G0) ; true ).
'$thread_option'(alias(Alias), [Alias|Aliases], _, _, _, _, G0, Aliases) :- !,
( \+ atom(Alias) -> '$do_error'(type_error(atom,Alias),G0) ; true ).
'$thread_option'(detached(B), Aliases, _, _, _, B, G0, Aliases) :- !,
( B \== true, B \== false -> '$do_error'(domain_error(flag_value,B+[true,false]),G0) ; true ).
'$thread_option'(Option, Aliases, _, _, _, _, G0, Aliases) :-
'$do_error'(domain_error(thread_option,Option+[stacks(_),trail(_),system(_),alias(_),detached(_)]),G0).
'$thread_ground_stacks'(0) :- !.
'$thread_ground_stacks'(_).
'$add_thread_aliases'([Alias|Aliases], Id) :-
recorda('$thread_alias',[Id0|Alias],_),
'$add_thread_aliases'(Aliases, Id).
'$add_thread_aliases'([], _).
thread_self(Id) :-
'$thread_self'(Id0),
'$check_thread_alias'(Id0,Id).
'$check_thread_alias'(Id0,Id) :-
recorded('$thread_alias',[Id0|Id],_), !.
'$check_thread_alias'(Id,Id).
/* Exit status may be true, false, exception(Term), exited(Term) */
thread_join(Id, Status) :-
'$check_thread_alias'(Id0,Id),
'$thread_join'(Id0),
'$erase_thread_aliases'(Id0),
recorded('$thread_exit_status',[Id0|Status],R),
erase(R).
'$erase_thread_aliases'(Id0) :-
recorded('$thread_alias',[Id0|_],R),
erase(R),
fail.
'$erase_thread_aliases'(_).
thread_detach(Id) :-
'$check_thread_alias'(Id0,Id),
'$detach_thread'(Id0).
thread_exit(Term) :-
'$thread_self'(Id0),
'$run_at_thread_exit'(Id0),
recorda('$thread_exit_status', [Id0|Term], _),
'$thread_exit'.
'$run_at_thread_exit'(Id0) :-
findall(Hook, (recorded('$thread_exit_hook',[Id0|Hook],R), erase(R)), Hooks),
'$run_thread_hooks'(Hooks),
message_queue_destroy(Id0).
'$run_thread_hooks'([]).
'$run_thread_hooks'([Hook|Hooks]) :-
'$thread_top_goal'(Hook),
'$run_thread_hooks'(Hooks).
thread_at_exit(Goal) :-
'$check_callable'(Goal,thread_at_exit(Goal)),
'$thread_self'(Id0),
recordz('$thread_exit_hook',[Id0|Goal],_).
current_thread(Tid, Status) :-
var(Tid), !,
'$cur_threads'(0, Tid, Status).
current_thread(Tid, Status) :-
'$check_thread_alias'(Id0,Tid), !,
'$valid_thread'(Id0),
'$thr_status'(Id0, Status).
current_thread(Tid, Status) :- integer(Tid), !,
'$valid_thread'(Tid),
'$thr_status'(Tid, Status).
current_thread(Tid, Status) :-
'$do_error'(type_error(integer,Tid),current_thread(Tid, Status)).
'$cur_threads'(Tid, Tid, Status) :-
'$valid_thread'(Tid),
'$thr_status'(Tid, Status).
'$cur_threads'(Tid, TidF, Status) :-
'$valid_thread'(Tid),
Tid1 is Tid+1,
'$cur_threads'(Tid1, TidF, Status).
'$thr_status'(Tid, Status) :-
recorded('$thread_exit_status', [Tid|Status], _), !.
'$thr_status'(Tid, running).
mutex_create(V) :-
var(V), !,
'$new_mutex'(Id),
recorda('$mutex'(Id,Id),_).
mutex_create(A) :-
atom(A),
recorded('$mutex',[A|_],_), !,
'$do_error'(permission_error(create,mutex,A),mutex_create(A)).
mutex_create(A) :-
atom(A), !,
'$new_mutex'(Id),
recorda('$mutex'(A,Id),_).
mutex_create(V) :-
'$do_error'(type_error(atom,V),mutex_create(V)).
mutex_destroy(V) :-
var(V), !,
'$do_error'(instantiation_error,mutex_destroy(A)).
mutex_destroy(A) :-
recorded('$mutex',[A|Id],R),
'$kill_mutex'(Id),
erase(R).
mutex_destroy(A) :-
atom(A), !,
'$do_error'(existence_error(mutex,A),mutex_destroy(A)).
mutex_destroy(V) :-
'$do_error'(type_error(atom,V),mutex_destroy(V)).
mutex_lock(V) :-
var(V), !,
'$do_error'(instantiation_error,mutex_lock(A)).
mutex_lock(A) :-
recorded('$mutex',[A|Id],_),
'$lock_mutex'(Id).
mutex_lock(A) :-
atom(A), !,
mutex_create(A),
mutex_lock(A).
mutex_lock(V) :-
'$do_error'(type_error(atom,V),mutex_lock(V)).
mutex_trylock(V) :-
var(V), !,
'$do_error'(instantiation_error,mutex_trylock(A)).
mutex_trylock(A) :-
recorded('$mutex',[A|Id],_),
'$trylock_mutex'(Id).
mutex_trylock(A) :-
atom(A), !,
mutex_create(A),
mutex_trylock(A).
mutex_trylock(V) :-
'$do_error'(type_error(atom,V),mutex_trylock(V)).
mutex_unlock(V) :-
var(V), !,
'$do_error'(instantiation_error,mutex_unlock(A)).
mutex_unlock(A) :-
recorded('$mutex',[A|Id],_),
( '$unlock_mutex'(Id) ->
true
;
'$do_error'(permission_error(unlock,mutex,A),mutex_unlock(A))
).
mutex_unlock(A) :-
atom(A), !,
'$do_error'(existence_error(mutex,A),mutex_unlock(A)).
mutex_unlock(V) :-
'$do_error'(type_error(atom,V),mutex_unlock(V)).
mutex_unlock_all :-
'$thread_self'(T),
recorded('$mutex',[_|Id],_),
'$mutex_info'(Id, NRefs, T),
NRefs > 0,
'$mutex_unlock_all'(Id),
fail.
mutex_unlock_all.
'$mutex_unlock_all'(Id) :-
'$mutex_info'(Id, NRefs, _),
NRefs > 0,
'$unlock_mutex'(Id),
'$mutex_unlock_all'(Id).
current_mutex(M, T, NRefs) :-
recorded('$mutex',[M|Id],_),
'$mutex_info'(Id, NRefs, T).
message_queue_create(Cond) :-
var(Cond), !,
mutex_create(Mutex),
'$cond_create'(Cond),
recorda('$queue',q(Cond,Mutex,Cond), _).
message_queue_create(Name) :-
atom(Name), !,
recorded('$thread_alias',[Name|_],_),
'$do_error'(permission_error(create,queue,Name),thread_queue_create(Name)).
message_queue_create(Name) :-
atom(Name), !,
'$create_mq'(Name).
message_queue_create(Name) :-
'$do_error'(type_error(atom,Name),thread_queue_create(Name)).
'$create_mq'(Name) :-
mutex_create(Mutex),
'$cond_create'(Cond),
recorda('$queue',q(Name,Mutex,Cond),_).
message_queue_destroy(Name) :-
var(Name), !,
'$do_error'(instantiation_error,thread_queue_destroy(Name)).
message_queue_destroy(Queue) :-
recorded('$queue',q(Queue,Mutex,Cond),R), !,
erase(R),
mutex_destroy(Mutex),
'$cond_destroy'(Cond),
'$clean_mqueue'(Queue).
message_queue_destroy(Queue) :-
atom(Queue), !,
'$do_error'(existence_error(queue,Queue),thread_queue_destroy(Name)).
message_queue_destroy(Name) :-
'$do_error'(type_error(atom,Name),thread_queue_destroy(Name)).
'$clean_mqueue'(Q) :-
recorded('$msg_queue',q(Queue,_),R),
erase(R),
fail.
'$clean_mqueue'(_).
thread_send_message(Queue, Term) :-
recorded('$thread_alias',[Queue|Id],_),
thread_send_message(Id, Term).
thread_send_message(Queue, Term) :-
recorded('$queue',q(Queue,Mutex,Cond),_),
mutex_lock(Mutex),
recordz('$msg_queue',q(Queue,Term),_),
'$cond_broadcast'(Cond),
mutex_unlock(Mutex).
thread_get_message(Term) :-
'$thread_self'(Id),
thread_get_message(Id, Term).
thread_get_message(Queue, Term) :-
recorded('$queue',q(Queue,Mutex,Cond),_),
mutex_lock(Mutex),
'$thread_get_message_loop'(Queue, Term, Mutex, Cond).
'$thread_get_message_loop'(Queue, Term, Mutex, Cond) :-
recorded('$msg_queue',q(Queue,Term),R), !,
mutex_unlock(Mutex),
erase(R).
'$thread_get_message_loop'(Queue, Term, Mutex, Cond) :-
'$cond_wait'(Cond, Mutex),
'$thread_get_message_loop'(Queue, Term, Mutex, Cond).
thread_peek_message(Term) :-
'$thread_self'(Id),
thread_peek_message(Id, Term).
thread_peek_message(Queue, Term) :-
recorded('$queue',q(Queue,Mutex,Cond),_),
mutex_lock(Mutex),
'$thread_peek_message2'(Queue, Term, Mutex).
'$thread_get_message_loop'(Queue, Term, Mutex) :-
recorded('$msg_queue',q(Queue,Term),_), !,
mutex_unlock(Mutex).
'$thread_get_message_loop'(Queue, Term, Mutex) :-
mutex_unlock(Mutex),
fail.

26
pl/utils.yap
View File

@ -250,23 +250,6 @@ putenv(Na,Val) :-
getenv(Na,Val) :-
'$getenv'(Na,Val).
alarm(_, _, _) :-
recorded('$alarm_handler',_, Ref), erase(Ref), fail.
alarm(Interval, Goal, Left) :-
'$current_module'(M),
recordz('$alarm_handler',M:Goal,_),
'$alarm'(Interval, Left).
on_signal(Signal,OldAction,default) :-
recorded('$sig_handler', default(Signal,Action), _Ref),
on_signal(Signal,OldAction,Action).
on_signal(Signal,OldAction,Action) :-
recorded('$sig_handler', action(Signal,OldAction), Ref),
erase(Ref),
'$current_module'(M),
recordz('$sig_handler', action(Signal,M:Action), _).
%%% Saving and restoring a computation
save(A) :- var(A), !,
@ -820,12 +803,3 @@ user_defined_directive(Dir,Action) :-
recorda('$toplevel_hooks',H,_),
fail.
'$set_toplevel_hook'(_).
raise_exception(Ball) :- throw(Ball).
on_exception(Pat, G, H) :- catch(G, Pat, H).
'$append'([], L, L) .
'$append'([H|T], L, [H|R]) :-
'$append'(T, L, R).