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

fix multithreaded version

Browse Source 
include new version of Ricardo's profiler
new predicat atomic_concat
allow multithreaded-debugging
small fixes


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1085 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-06-29 19:04:46 +00:00
parent a7f550d667
commit f6503f0100
17 changed files with 455 additions and 215 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
C/absmi.c
View File

@ -10,8 +10,15 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2004-06-23 17:24:19 $,$Author: vsc $ *
* Last rev: $Date: 2004-06-29 19:04:40 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.137 2004/06/23 17:24:19 vsc
* New comment-based message style
* Fix thread support (at least don't deadlock with oneself)
* small fixes for coroutining predicates
* force Yap to recover space in arrays of dbrefs
* use private predicates in debugger.
*
* Revision 1.136 2004/06/17 22:07:22 vsc
* bad bug in indexing code.
*
@ -94,25 +101,6 @@ AritFunctorOfTerm(Term t) {
#include "arith2.h"
#ifdef THREADS
static int
same_lu_block(yamop **paddr, yamop *p)
{
yamop *np = *paddr;
if (np != p) {
OPCODE jmp_op = Yap_opcode(_jump_if_nonvar);
while (np->opc == jmp_op) {
np = NEXTOP(np, xl);
if (np == p) return TRUE;
}
return FALSE;
} else {
return TRUE;
}
}
#endif
#ifdef COROUTINING
/*
Imagine we are interrupting the execution, say, because we have a spy
@ -179,19 +167,36 @@ push_live_regs(yamop *pco)
#endif
#if LOW_PROF
#include <signal.h>
#include <ucontext.h>
#include <stdio.h>
void prof_alrm(int signo)
#define TestMode (GCMode | GrowHeapMode | GrowStackMode | ErrorHandlingMode | InErrorMode | AbortMode)
int Yap_absmiEND(void);
void prof_alrm(int signo, siginfo_t *si, ucontext_t *sc);
void prof_alrm(int signo, siginfo_t *si, ucontext_t *sc)
{
#ifdef i386
fprintf(FProf,"%p\n", PREG);
#else
/* vsc: not really supported for shadow regs */
fprintf(FProf,"%p\n", P);
#endif
void * oldpc=(void *) sc->uc_mcontext.gregs[14]; /* 14= REG_EIP */
if (Yap_PrologMode & TestMode) {
fprintf(FProf,"%p %p\n", (void *) (Yap_PrologMode & TestMode), P);
return;
}
// printf("[%p,%p] -> %p\n", Yap_ABSMI_OPCODES[_try_me], Yap_ABSMI_OPCODES[_p_execute_tail], oldpc);
// if (oldpc<(void *) &Yap_absmi || oldpc> (void *) Yap_ABSMI_OPCODES[_p_execute_tail]) {
if (oldpc<(void *) &Yap_absmi || oldpc> (void *) &Yap_absmiEND) {
fprintf(FProf,"%p %p\n", (void *) oldpc, P);
return;
}
fprintf(FProf,"0 %p\n", PREG);
return;
}
#endif
Int
Yap_absmi(int inp)
{
@ -1189,13 +1194,16 @@ Yap_absmi(int inp)
BOp(stale_lu_index, Ill);
{
yamop *ipc;
#if defined(YAPOR) || defined(THREADS)
PredEntry *pe = PREG->u.Ill.l1->u.ld.p;
#endif
/* update ASP before calling IPred */
ASP = YREG+E_CB;
if (ASP > (CELL *) B) {
ASP = (CELL *) B;
}
saveregs();
#if defined(YAPOR) || defined(THREADS)
LOCK(pe->PELock);
if (PP) {
@ -1209,7 +1217,6 @@ Yap_absmi(int inp)
JMPNext();
}
#endif
saveregs();
ipc = Yap_CleanUpIndex(PREG->u.Ill.I);
setregs();
/* restart index */
@ -11939,4 +11946,8 @@ Yap_absmi(int inp)
}
/* dummy function that is needed for profiler */
int Yap_absmiEND()
{
return 1;
}

6
C/arrays.c
View File

@ -1562,11 +1562,15 @@ p_assign_static(void)
if (ptr->Flags & LogUpdMask) {
LogUpdClause *lup = (LogUpdClause *)ptr;
LOCK(lup->ClLock);
lup->ClRefCount--;
if (lup->ClRefCount == 0 &&
(lup->ClFlags & ErasedMask) &&
!(lup->ClFlags & InUseMask)) {
UNLOCK(lup->ClLock);
Yap_ErLogUpdCl(lup);
} else {
UNLOCK(lup->ClLock);
}
} else {
ptr->NOfRefsTo--;
@ -1580,7 +1584,9 @@ p_assign_static(void)
if (p->Flags & LogUpdMask) {
LogUpdClause *lup = (LogUpdClause *)p;
LOCK(lup->ClLock);
lup->ClRefCount++;
UNLOCK(lup->ClLock);
} else {
p->NOfRefsTo++;
}

7
C/c_interface.c
View File

@ -10,8 +10,11 @@
* File: c_interface.c *
* comments: c_interface primitives definition *
* *
* Last rev: $Date: 2004-06-09 03:32:02 $,$Author: vsc $ *
* Last rev: $Date: 2004-06-29 19:04:41 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.49 2004/06/09 03:32:02 vsc
* fix bugs
*
* Revision 1.48 2004/06/05 03:36:59 vsc
* coroutining is now a part of attvars.
* some more fixes.
@ -923,11 +926,13 @@ YAP_CompileClause(Term t)
Yap_ErrorMessage = NULL;
ARG1 = t;
YAPEnterCriticalSection();
codeaddr = Yap_cclause (t,0, mod, t);
if (codeaddr != NULL) {
t = Deref(ARG1); /* just in case there was an heap overflow */
Yap_addclause (t, codeaddr, TRUE, mod);
}
YAPLeaveCriticalSection();
RECOVER_MACHINE_REGS();
return(Yap_ErrorMessage);

14
C/cdmgr.c
View File

@ -11,8 +11,12 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2004-06-05 03:36:59 $,$Author: vsc $ *
* Last rev: $Date: 2004-06-29 19:04:41 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.124 2004/06/05 03:36:59 vsc
* coroutining is now a part of attvars.
* some more fixes.
*
* Revision 1.123 2004/05/17 21:42:09 vsc
* misc fixes
*
@ -3299,6 +3303,10 @@ p_continue_log_update_clause(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
#if defined(YAPOR) || defined(THREADS)
READ_LOCK(pe->PRWLock);
PP = pe;
#endif
return fetch_next_lu_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE);
}
@ -3395,6 +3403,10 @@ p_continue_log_update_clause0(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
#if defined(YAPOR) || defined(THREADS)
READ_LOCK(pe->PRWLock);
PP = pe;
#endif
return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
}

8
C/compiler.c
View File

@ -11,8 +11,11 @@
* File: compiler.c *
* comments: Clause compiler *
* *
* Last rev: $Date: 2004-04-22 20:07:04 $,$Author: vsc $ *
* Last rev: $Date: 2004-06-29 19:04:41 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.50 2004/04/22 20:07:04 vsc
* more fixes for USE_SYSTEM_MEMORY
*
* Revision 1.49 2004/03/10 16:27:39 vsc
* skip compilation steps for ground facts.
*
@ -2748,6 +2751,8 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod, Term src)
Int osize = 2*sizeof(CELL)*(ASP-H);
ARG1 = my_clause;
*H++ = src;
YAPLeaveCriticalSection();
if (!Yap_gcl(Yap_Error_Size, 2, ENV, P)) {
Yap_Error_TYPE = OUT_OF_STACK_ERROR;
Yap_Error_Term = my_clause;
@ -2758,6 +2763,7 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod, Term src)
Yap_Error_Term = my_clause;
}
}
YAPEnterCriticalSection();
src = *--H;
my_clause = ARG1;
}

95
C/dbase.c
View File

@ -1933,8 +1933,11 @@ p_rcdap(void)
}
goto recover_record;
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
}
goto recover_record;
case OUT_OF_HEAP_ERROR:
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
@ -1981,8 +1984,11 @@ p_rcda_at(void)
}
goto recover_record;
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
}
goto recover_record;
case OUT_OF_HEAP_ERROR:
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
@ -2037,8 +2043,11 @@ p_rcdz(void)
}
goto recover_record;
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
}
goto recover_record;
case OUT_OF_HEAP_ERROR:
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
@ -2076,8 +2085,11 @@ p_rcdzp(void)
}
goto recover_record;
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
}
goto recover_record;
case OUT_OF_HEAP_ERROR:
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
@ -2124,8 +2136,11 @@ p_rcdz_at(void)
}
goto recover_record;
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recordz_at/3");
return(FALSE);
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
}
goto recover_record;
case OUT_OF_HEAP_ERROR:
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
@ -2171,8 +2186,11 @@ 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;
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
}
goto recover_record;
case OUT_OF_HEAP_ERROR:
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
@ -2213,8 +2231,11 @@ p_drcdap(void)
}
goto recover_record;
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
}
goto recover_record;
case OUT_OF_HEAP_ERROR:
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
@ -2256,8 +2277,11 @@ p_drcdzp(void)
}
goto recover_record;
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
}
goto recover_record;
case OUT_OF_HEAP_ERROR:
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
@ -3895,23 +3919,22 @@ static void
EraseLogUpdCl(LogUpdClause *clau)
{
PredEntry *ap;
#if defined(YAPOR) || defined(THREADS)
int i_locked = FALSE;
#endif
ap = clau->ClPred;
#if defined(YAPOR) || defined(THREADS)
if (WPP != ap) {
WRITE_LOCK(ap->PRWLock);
if (WPP == NULL) {
i_locked = TRUE;
WPP = ap;
}
}
#endif
LOCK(clau->ClLock);
/* no need to erase what has been erased */
if (!(clau->ClFlags & ErasedMask)) {
#if defined(YAPOR) || defined(THREADS)
int i_locked = FALSE;
if (WPP != ap) {
WRITE_LOCK(ap->PRWLock);
if (WPP == NULL) {
i_locked = TRUE;
WPP = ap;
}
}
#endif
/* get ourselves out of the list */
if (clau->ClNext != NULL) {
LOCK(clau->ClNext->ClLock);
@ -3962,15 +3985,15 @@ EraseLogUpdCl(LogUpdClause *clau)
/* release the extra reference */
LOCK(clau->ClLock);
clau->ClRefCount--;
}
UNLOCK(clau->ClLock);
complete_lu_erase(clau);
#if defined(YAPOR) || defined(THREADS)
if (WPP != ap || i_locked) {
if (i_locked) WPP= NULL;
WRITE_UNLOCK(ap->PRWLock);
}
#endif
}
UNLOCK(clau->ClLock);
complete_lu_erase(clau);
}
static void
@ -4700,8 +4723,14 @@ StoreTermInDB(Term t, int nargs)
break;
}
case OUT_OF_TRAIL_ERROR:
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
XREGS[nargs+1] = t;
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
} else {
t = Deref(XREGS[nargs+1]);
break;
}
case OUT_OF_HEAP_ERROR:
XREGS[nargs+1] = t;
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {

24
C/grow.c
View File

@ -540,9 +540,9 @@ static_growheap(long size, int fix_code, struct intermediates *cip)
UNLOCK(SignalLock);
}
ASP -= 256;
YAPEnterCriticalSection();
TrDiff = LDiff = GDiff = DelayDiff = size;
XDiff = HDiff = 0;
YAPEnterCriticalSection();
SetHeapRegs();
MoveLocalAndTrail();
if (fix_code) {
@ -590,9 +590,9 @@ static_growglobal(long size, CELL **ptr)
fprintf(Yap_stderr, "[DO] growing the stacks %ld bytes\n", size);
}
ASP -= 256;
YAPEnterCriticalSection();
TrDiff = LDiff = GDiff = size;
XDiff = HDiff = DelayDiff = 0;
YAPEnterCriticalSection();
SetHeapRegs();
MoveLocalAndTrail();
MoveGlobalOnly();
@ -733,7 +733,12 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip)
int
Yap_growheap(int fix_code, UInt in_size, void *cip)
{
return do_growheap(fix_code, in_size, (struct intermediates *)cip);
int res;
Yap_PrologMode |= GrowHeapMode;
res=do_growheap(fix_code, in_size, (struct intermediates *)cip);
Yap_PrologMode &= ~GrowHeapMode;
return res;
}
int
@ -765,6 +770,7 @@ execute_growstack(long size, int from_trail)
strncat(Yap_ErrorMessage,": local crashed against global", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
YAPEnterCriticalSection();
XDiff = HDiff = 0;
GDiff = DelayDiff = Yap_GlobalBase-MyGlobalBase;
#if USE_SYSTEM_MALLOC
@ -780,7 +786,6 @@ execute_growstack(long size, int from_trail)
Yap_GlobalBase = (char *)MyGlobalBase;
}
ASP -= 256;
YAPEnterCriticalSection();
if (GDiff) {
SetHeapRegs();
} else {
@ -841,7 +846,12 @@ growstack(long size)
int
Yap_growstack(long size)
{
return growstack(size);
int res;
Yap_PrologMode |= GrowStackMode;
res=growstack(size);
Yap_PrologMode &= ~GrowStackMode;
return res;
}
static void
@ -943,10 +953,10 @@ Yap_growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
(unsigned long int)(TR-(tr_fr_ptr)Yap_TrailBase),Yap_TrailBase,TR);
fprintf(Yap_stderr, "%% growing the stacks %ld bytes\n", size);
}
TrDiff = LDiff = size;
XDiff = HDiff = GDiff = DelayDiff = 0;
ASP -= 256;
YAPEnterCriticalSection();
TrDiff = LDiff = size;
XDiff = HDiff = GDiff = DelayDiff = 0;
SetStackRegs();
MoveLocalAndTrail();
AdjustScannerStacks(tksp, vep);

8
C/heapgc.c
View File

@ -3172,7 +3172,7 @@ p_inform_gc(void)
static int
call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
{
UInt gc_margin = 128;
UInt gc_margin = MinStackGap;
Term Tgc_margin;
Int effectiveness = 0;
int gc_on = FALSE;
@ -3225,7 +3225,11 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
int
Yap_gc(Int predarity, CELL *current_env, yamop *nextop)
{
return call_gc(4096, predarity, current_env, nextop);
int res;
Yap_PrologMode |= GCMode;
res=call_gc(4096, predarity, current_env, nextop);
Yap_PrologMode &= ~GCMode;
return res;
}
int

49
C/index.c
View File

@ -11,8 +11,11 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2004-06-17 22:07:23 $,$Author: vsc $ *
* Last rev: $Date: 2004-06-29 19:04:42 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.91 2004/06/17 22:07:23 vsc
* bad bug in indexing code.
*
* Revision 1.90 2004/04/29 03:44:04 vsc
* fix bad suspended clause counter
*
@ -5240,15 +5243,20 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
{
LogUpdIndex *idx = ncl->ChildIndex = blk->ChildIndex;
while (idx) {
LogUpdIndex *nidx;
LOCK(idx->ClLock);
blk->ClRefCount--;
ncl->ClRefCount++;
idx = idx->SiblingIndex;
idx->u.ParentIndex = ncl;
nidx = idx->SiblingIndex;
UNLOCK(idx->ClLock);
idx = nidx;
}
}
blk->ChildIndex = NULL;
ncl->ClSize = sz;
INIT_LOCK(ncl->ClLock);
INIT_CLREF_COUNT(ncl);
nbegin = ncl->ClCode;
begin = blk->ClCode;
while (jnvs--) {
@ -5311,7 +5319,13 @@ clean_up_index(LogUpdIndex *blk, yamop **jlbl, PredEntry *ap)
{
yamop *codep = blk->ClCode;
if (blk->ClFlags & InUseMask) {
if (
#if defined(THREADS) || defined(YAPOR)
blk->ClRefCount
#else
blk->ClFlags & InUseMask
#endif
) {
yamop *new;
if ((new = replace_lu_block(blk, REFRESH, ap, NULL, FALSE)) == NULL) {
@ -5377,7 +5391,13 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
LogUpdClause *tgl = ClauseCodeToLogUpdClause(code);
if (begin->opc != Yap_opcode(_stale_lu_index)) {
if (blk->ClFlags & InUseMask) {
if (
#if defined(THREADS) || defined(YAPOR)
blk->ClRefCount
#else
blk->ClFlags & InUseMask
#endif
) {
begin->opc = Yap_opcode(_stale_lu_index);
} else {
/* we need to rebuild the code */
@ -6935,7 +6955,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
case _stale_lu_index:
#if defined(YAPOR) || defined(THREADS)
LOCK(ap->PELock);
if (*jlbl != ipc) {
if (!same_lu_block(jlbl, ipc)) {
ipc = *jlbl;
UNLOCK(ap->PELock);
break;
@ -7000,7 +7020,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
break;
case _jump_if_nonvar:
{
Term t = Deref(XREGS[arg_from_x(ipc->u.xllll.x)]);
Term t = Deref(XREGS[arg_from_x(ipc->u.xl.x)]);
if (!IsVarTerm(t)) {
jlbl = &(ipc->u.xl.l);
ipc = ipc->u.xl.l;
@ -7144,7 +7164,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
H += 3;
#if defined(YAPOR) || defined(THREADS)
LOCK(ap->PELock);
if (*jlbl != ipc) {
if (!same_lu_block(jlbl, ipc)) {
ipc = *jlbl;
UNLOCK(ap->PELock);
break;
@ -7315,7 +7335,7 @@ Yap_NthClause(PredEntry *ap, Int ncls)
case _stale_lu_index:
#if defined(YAPOR) || defined(THREADS)
LOCK(ap->PELock);
if (*jlbl != ipc) {
if (!same_lu_block(jlbl, ipc)) {
ipc = *jlbl;
UNLOCK(ap->PELock);
break;
@ -7636,6 +7656,9 @@ find_caller(PredEntry *ap, yamop *code) {
alt = NULL;
}
break;
case _lock_lu:
ipc = NEXTOP(ipc,p);
break;
case _stale_lu_index:
/* found myself */
return NULL;
@ -7663,7 +7686,13 @@ Yap_CleanUpIndex(LogUpdIndex *blk)
tblk = tblk->u.ParentIndex;
ap = tblk->u.pred;
if (blk->ClFlags & InUseMask) {
if (
#if defined(THREADS) || defined(YAPOR)
blk->ClRefCount
#else
blk->ClFlags & InUseMask
#endif
) {
/* I have to kill this block */
yamop **caller, *new;
caller = find_caller(ap, blk->ClCode);

314
C/stdpreds.c
View File

@ -11,8 +11,11 @@
* File: stdpreds.c *
* comments: General-purpose C implemented system predicates *
* *
* Last rev: $Date: 2004-06-16 14:12:53 $,$Author: vsc $ *
* Last rev: $Date: 2004-06-29 19:04:42 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.69 2004/06/16 14:12:53 vsc
* miscellaneous fixes
*
* Revision 1.68 2004/05/14 17:11:30 vsc
* support BigNums in interface
*
@ -111,6 +114,7 @@ STD_PROTO(static Int p_walltime, (void));
STD_PROTO(static Int p_access_yap_flags, (void));
STD_PROTO(static Int p_set_yap_flags, (void));
#ifdef LOW_PROF
#define TIMER_DEFAULT 100
@ -139,82 +143,12 @@ static Int order=0;
}
}
#if defined(__linux__)
static void
prof_alrm_OLD(int signo)
{
// printf("%p %p\n", Yap_regp->P_,P);
fprintf(FProf,"%p\n", Yap_regp->P_);
return;
}
extern void prof_alrm(int signo);
static Int start_profilers(int msec)
{
struct itimerval t;
if (ProfilerOn==msec) return(TRUE);
if (ProfilerOn) {
setitimer(ITIMER_PROF,NULL,NULL);
fclose(FPreds);
fclose(FProf);
ProfilerOn = 0;
return TRUE;
}
if (signal(SIGPROF,prof_alrm) == SIG_ERR) {
return FALSE;
}
FPreds=fopen("PROFPREDS","w+");
if (FPreds == NULL) return FALSE;
FProf=fopen("PROFILING","w+");
if (FProf==NULL) { fclose(FPreds); return FALSE; }
Yap_dump_code_area_for_profiler();
t.it_interval.tv_sec=0;
t.it_interval.tv_usec=msec;
t.it_value.tv_sec=0;
t.it_value.tv_usec=msec;
setitimer(ITIMER_PROF,&t,NULL);
ProfilerOn = msec;
return(TRUE);
}
#endif /* Linux */
static Int useprof(void) {
#if defined(__linux__)
Term p;
p=Deref(ARG1);
return(start_profilers(IntOfTerm(p)));
#else
return(FALSE);
#endif
}
static Int useprof0(void) {
#if defined(__linux__)
return(start_profilers(TIMER_DEFAULT));
#else
return(FALSE);
#endif
}
#if defined(__linux__)
typedef struct clause_entry {
yamop *beg, *end;
PredEntry *pp;
UInt pcs; /* counter with total for each clause */
UInt pca; /* counter with total for each predicate (repeats for each clause)*/
Int ts; /* start end timestamp towards retracts, eventually */
Int tf;
UInt pca; /* counter with total for each predicate (repeated for each clause)*/
Int ts; /* start end timestamp towards retracts, eventually */
} clauseentry;
static int
@ -267,18 +201,29 @@ search_pc_pred(yamop *pc_ptr,clauseentry *beg, clauseentry *end) {
}
}
extern void Yap_InitAbsmi(void);
extern int rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit0);
#ifndef ANALYST
static char *op_names[_std_top + 1] =
{
#define OPCODE(OP,TYPE) #OP
#include "YapOpcodes.h"
#undef OPCODE
};
#else
extern char *op_names[];
#endif
static Int profend(void);
static int
showprofres(UInt type) {
clauseentry *pr=(clauseentry *) TR, *t, *t2;
UInt count=0, ProfCalls=0;
yamop *pc_ptr;
clauseentry *pr, *t, *t2;
UInt count=0, ProfCalls=0, InGrowHeap=0, InGrowStack=0, InGC=0, InError=0, InUnify=0, InCCall=0;
yamop *pc_ptr,*y; void *oldpc;
if (ProfilerOn) {
setitimer(ITIMER_PROF,NULL,NULL);
fclose(FPreds);
fclose(FProf);
ProfilerOn = 0;
}
profend(); /* Make sure profiler has ended */
/* First part: Read information about predicates and store it on yap trail */
@ -286,6 +231,7 @@ showprofres(UInt type) {
if (FPreds == NULL) return FALSE;
ProfPreds=0;
pr=(clauseentry *) TR;
while (fscanf(FPreds,"+%p %p %p %d",&(pr->beg),&(pr->end),&(pr->pp),&(pr->ts)) > 0){
int c;
pr->pcs = 0L;
@ -311,20 +257,46 @@ showprofres(UInt type) {
t2=NULL;
ProfCalls=0;
while(fscanf(FProf,"%p\n",&pc_ptr) >0){
while(fscanf(FProf,"%p %p\n",&oldpc, &pc_ptr) >0){
if (type<10) ProfCalls++;
if (oldpc!=0 && type<=2) {
if ((unsigned long)oldpc< 70000) {
if ((unsigned long) oldpc & GrowHeapMode) { InGrowHeap++; continue; }
if ((unsigned long)oldpc & GrowStackMode) { InGrowStack++; continue; }
if ((unsigned long)oldpc & GCMode) { InGC++; continue; }
if ((unsigned long)oldpc & (ErrorHandlingMode | InErrorMode)) { InError++; continue; }
}
if (oldpc>(void *) rational_tree_loop && oldpc<(void *) Yap_InitAbsmi) { InUnify++; continue; }
y=(yamop *) ((long) pc_ptr-20);
if ((void *) y->opc==Yap_ABSMI_OPCODES[_call_cpred] || (void *) y->opc==Yap_ABSMI_OPCODES[_call_usercpred]) {
InCCall++; /* I Was in a C Call */
pc_ptr=y;
/*
printf("Aqui está um call_cpred(%p) \n",y->u.sla.sla_u.p->cs.f_code);
for(i=0;i<_std_top && pc_ptr->opc!=Yap_ABSMI_OPCODES[i];i++);
printf("Outro syscall diferente %s\n", op_names[i]);
*/
continue;
}
/* I should never get here, but since I'm, it is certanly Unknown Code, so
continue running to try to count it as Prolog Code */
}
t=search_pc_pred(pc_ptr,(clauseentry *)TR,pr);
if (t!=NULL) { /* pc was found */
if (type<10) t->pcs++;
else {
if (t->pp==(PredEntry *)type) {
ProfCalls++;
if (t2!=NULL) t2->pcs++;
}
}
t2=t;
}
if (type<10) t->pcs++;
else {
if (t->pp==(PredEntry *)type) {
ProfCalls++;
if (t2!=NULL) t2->pcs++;
}
}
t2=t;
}
}
fclose(FProf);
if (ProfCalls==0) return(FALSE);
@ -346,7 +318,9 @@ showprofres(UInt type) {
}
/* counting done: now it is time to present the results */
fflush(stdout);
/*
if (type>10) {
PredEntry *myp = (PredEntry *)type;
if (myp->FunctorOfPred->KindOfPE==47872) {
@ -357,8 +331,9 @@ showprofres(UInt type) {
}
type=1;
}
*/
if (type==0) { /* Results by predicate */
if (type==0 || type==1 || type==3) { /* Results by predicate */
t = (clauseentry *)TR;
while (t < pr) {
UInt calls=t->pca;
@ -374,10 +349,6 @@ showprofres(UInt type) {
}
while (t<pr && t->pp == myp) t++;
}
count=ProfCalls-count;
if (count>0) printf("Unknown:Unknown -> %u (%3.1f%c)\n",count,(float) count*100/ProfCalls,'%');
printf("Total of Calls=%u \n",ProfCalls);
} else { /* Results by clauses */
t = (clauseentry *)TR;
while (t < pr) {
@ -403,35 +374,109 @@ showprofres(UInt type) {
}
t++;
}
count=ProfCalls-count;
if (count>0) printf("Unknown:Unknown -> %u (%3.1f%c)\n",count,(float) count*100/ProfCalls,'%');
printf("Total of Calls=%u \n",ProfCalls);
}
}
count=ProfCalls-(count+InGrowHeap+InGrowStack+InGC+InError+InUnify+InCCall); // Falta +InCCall
if (InGrowHeap>0) printf("%p sys: GrowHeap -> %u (%3.1f%c)\n",(void *) GrowHeapMode,InGrowHeap,(float) InGrowHeap*100/ProfCalls,'%');
if (InGrowStack>0) printf("%p sys: GrowStack -> %u (%3.1f%c)\n",(void *) GrowStackMode,InGrowStack,(float) InGrowStack*100/ProfCalls,'%');
if (InGC>0) printf("%p sys: GC -> %u (%3.1f%c)\n",(void *) GCMode,InGC,(float) InGC*100/ProfCalls,'%');
if (InError>0) printf("%p sys: ErrorHandling -> %u (%3.1f%c)\n",(void *) ErrorHandlingMode,InError,(float) InError*100/ProfCalls,'%');
if (InUnify>0) printf("%p sys: Unify -> %u (%3.1f%c)\n",(void *) UnifyMode,InUnify,(float) InUnify*100/ProfCalls,'%');
if (InCCall>0) printf("%p sys: C Code -> %u (%3.1f%c)\n",(void *) CCallMode,InCCall,(float) InCCall*100/ProfCalls,'%');
if (count>0) printf("Unknown:Unknown -> %u (%3.1f%c)\n",count,(float) count*100/ProfCalls,'%');
printf("Total of Calls=%u \n",ProfCalls);
return TRUE;
}
#endif /*Linux */
static Int profinit(void)
{
if (ProfilerOn!=0) return (FALSE);
FPreds=fopen("PROFPREDS","w+");
if (FPreds == NULL) return FALSE;
FProf=fopen("PROFILING","w+");
if (FProf==NULL) { fclose(FPreds); return FALSE; }
Yap_dump_code_area_for_profiler();
ProfilerOn = -1; /* Inited but not yet started */
return(TRUE);
}
extern void prof_alrm(int signo, siginfo_t *si, void *sc);
static Int start_profilers(int msec)
{
struct itimerval t;
struct sigaction sa;
if (ProfilerOn!=-1) return (FALSE); /* have to go through profinit */
sa.sa_sigaction=prof_alrm;
sigemptyset(&sa.sa_mask);
sa.sa_flags=SA_SIGINFO;
if (sigaction(SIGPROF,&sa,NULL)== -1) return FALSE;
// if (signal(SIGPROF,prof_alrm) == SIG_ERR) return FALSE;
t.it_interval.tv_sec=0;
t.it_interval.tv_usec=msec;
t.it_value.tv_sec=0;
t.it_value.tv_usec=msec;
setitimer(ITIMER_PROF,&t,NULL);
ProfilerOn = msec;
return(TRUE);
}
static Int profon(void) {
Term p;
p=Deref(ARG1);
return(start_profilers(IntOfTerm(p)));
}
static Int profon0(void) {
return(start_profilers(TIMER_DEFAULT));
}
static Int profoff(void) {
if (ProfilerOn>0) {
setitimer(ITIMER_PROF,NULL,NULL);
ProfilerOn = -1;
return TRUE;
}
return FALSE;
}
static Int profalt(void) {
if (ProfilerOn==0) return(FALSE);
if (ProfilerOn==-1) return profon();
return profoff();
}
static Int profend(void)
{
if (ProfilerOn==0) return(FALSE);
profoff(); /* Make sure profiler is off */
fclose(FPreds);
fclose(FProf);
ProfilerOn=0;
return (TRUE);
}
static Int profres(void) {
#if defined(__linux__)
Term p;
p=Deref(ARG1);
if (IsLongIntTerm(p)) return(showprofres(LongIntOfTerm(p)));
else return(showprofres(IntOfTerm(p)));
#else
return(FALSE);
#endif
}
static Int profres0(void) {
#if defined(__linux__)
return(showprofres(0));
#else
return(FALSE);
#endif
}
#endif /* LOW_PROF */
@ -1097,7 +1142,7 @@ p_atomic_concat(void)
}
if (!IsAtomicTerm(thead)) {
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
Yap_Error(TYPE_ERROR_ATOM, ARG1, "atom_concat/2");
Yap_Error(TYPE_ERROR_ATOMIC, ARG1, "atom_concat/2");
return(FALSE);
}
if (IsAtomTerm(thead)) {
@ -1110,12 +1155,41 @@ p_atomic_concat(void)
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
} else if (IsIntegerTerm(thead)) {
goto restart;
}
memcpy((void *)cptr, (void *)atom_str, sz);
cptr += sz;
} else if (IsIntegerTerm(thead)) {
#if HAVE_SNPRINTF
snprintf(cptr, (top-cptr)-1024,"%ld", (long int)IntegerOfTerm(thead));
#else
sprintf(cptr,"%ld", IntegerOfTerm(thead));
#endif
while (*cptr && cptr < top-1024) cptr++;
} else if (IsFloatTerm(thead)) {
#if HAVE_SNPRINTF
snprintf(cptr,(top-cptr)-1024,"%g", FloatOfTerm(thead));
#else
sprintf(cptr,"%g", FloatOfTerm(thead));
#endif
while (*cptr && cptr < top-1024) cptr++;
#if USE_GMP
} else if (IsBigIntTerm(thead)) {
MP_INT *n = Yap_BigIntOfTerm(thead);
int sz;
if ((sz = mpz_sizeinbase (n, 10)) > (top-cptr)-1024) {
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
if (!Yap_growheap(FALSE, sz+1024, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
goto restart;
}
goto restart;
mpz_get_str(cptr, 10, n);
while (*cptr) cptr++;
#endif
}
memcpy((void *)cptr, (void *)atom_str, sz);
cptr += sz;
t1 = TailOfTerm(t1);
if (IsVarTerm(t1)) {
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
@ -2785,8 +2859,12 @@ Yap_InitCPreds(void)
Yap_InitCPred("$hidden", 1, p_hidden, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$has_yap_or", 0, p_has_yap_or, SafePredFlag|SyncPredFlag);
#ifdef LOW_PROF
Yap_InitCPred("useprof", 1, useprof, SafePredFlag);
Yap_InitCPred("useprof", 0, useprof0, SafePredFlag);
Yap_InitCPred("profinit",0, profinit, SafePredFlag);
Yap_InitCPred("profend" ,0, profend, SafePredFlag);
Yap_InitCPred("profon" , 0, profon0, SafePredFlag);
Yap_InitCPred("profon" , 1, profon, SafePredFlag);
Yap_InitCPred("profoff", 0, profoff, SafePredFlag);
Yap_InitCPred("profalt", 0, profalt, SafePredFlag);
Yap_InitCPred("profres", 1, profres, SafePredFlag);
Yap_InitCPred("profres", 0, profres0, SafePredFlag);
#endif

2
C/unify.c
View File

@ -26,7 +26,7 @@ STATIC_PROTO(int rtable_hash_op, (OPCODE));
STATIC_PROTO(void InitReverseLookupOpcode, (void));
#endif
static int
int
rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit0)
{
CELL **to_visit = to_visit0;

19
H/clause.h
View File

@ -231,3 +231,22 @@ Yap_op_from_opcode(OPCODE opc)
}
#endif /* USE_THREADED_CODE */
#if defined(YAPOR) || defined(THREADS)
static int
same_lu_block(yamop **paddr, yamop *p)
{
yamop *np = *paddr;
if (np != p) {
OPCODE jmp_op = Yap_opcode(_jump_if_nonvar);
while (np->opc == jmp_op) {
np = NEXTOP(np, xl);
if (np == p) return TRUE;
}
return FALSE;
} else {
return TRUE;
}
}
#endif

11
docs/yap.tex
View File

@ -2688,12 +2688,21 @@ codes for the characters of the external representation of @var{A}.
@item atom_concat(+@var{As},?@var{A})
@findex atom_concat/2
@snindex atom_concat/2
@syindex atom_concat/2
@cnindex atom_concat/2
The predicate holds when the first argument is a list of atoms, and the
second unifies with the atom obtained by concatenating all the atoms in
the first list.
@item atomic_concat(+@var{As},?@var{A})
@findex atomic_concat/2
@snindex atomic_concat/2
@cnindex atomic_concat/2
The predicate holds when the first argument is a list of atoms, and
the second unifies with the atom obtained by concatenating all the
atomic terms in the first list. The first argument thus may contain
atoms or numbers.
@item atom_concat(+@var{A1},+@var{A2},?@var{A})
@findex atom_concat/3
@syindex atom_concat/3

10
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.57 2004-04-22 20:07:07 vsc Exp $ *
* version: $Id: Yap.h.m4,v 1.58 2004-06-29 19:04:45 vsc Exp $ *
*************************************************************************/
#include "config.h"
@ -893,7 +893,13 @@ typedef enum {
InterruptMode = 16, /* under an interrupt */
InErrorMode = 32, /* under an interrupt */
ConsoleGetcMode = 64, /* blocked reading from console */
ExtendStackMode = 128 /* trying to extend stack */
ExtendStackMode = 128, /* trying to extend stack */
GrowHeapMode = 256, /* extending Heap */
GrowStackMode = 512, /* extending Stack */
GCMode = 1024, /* doing Garbage Collecting */
ErrorHandlingMode = 2048, /* doing error handling */
CCallMode = 4096, /* In c Call */
UnifyMode = 8192 /* In Unify Code */
} prolog_exec_mode;
extern prolog_exec_mode Yap_PrologMode;

16
pl/checker.yap
View File

@ -11,8 +11,14 @@
* File: checker.yap *
* comments: style checker for Prolog *
* *
* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* Last rev: $Date: 2004-06-29 19:04:46 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.13 2004/03/19 11:35:42 vsc
* trim_trail for default machine
* be more aggressive about try-retry-trust chains.
* - handle cases where block starts with a wait
* - don't use _killed instructions, just let the thing rot by itself.
* *
* *
*************************************************************************/
@ -28,10 +34,16 @@ style_check(all) :- '$syntax_check_mode'(_,on),
'$syntax_check_multiple'(_,on).
style_check(single_var) :- '$syntax_check_mode'(_,on),
'$syntax_check_single_var'(_,on).
style_check(-single_var) :-
no_style_check(single_var).
style_check(discontiguous) :- '$syntax_check_mode'(_,on),
'$syntax_check_discontiguous'(_,on).
style_check(-discontiguous) :-
no_style_check(discontiguous).
style_check(multiple) :- '$syntax_check_mode'(_,on),
'$syntax_check_multiple'(_,on).
style_check(-multiple) :-
no_style_check(multiple).
style_check([]).
style_check([H|T]) :- style_check(H), style_check(T).

4
pl/debug.yap
View File

@ -379,7 +379,7 @@ debugging :-
'$continue_avoid_goal'(_, G, Module, _) :-
recorded('$spy_stop', on, _), !,
\+ '$pred_being_spied'(G, Module).
% fpr skip keep on going until we get back.
% for skip keep on going until we get back.
'$continue_avoid_goal'(GoalNumber, _, _, Value) :-
number(Value),
Value < GoalNumber.
@ -509,7 +509,7 @@ debugging :-
'$action'(0'n,_,_,_,_) :- !, % n nodebug
'$skipeol'(0'n),
'$set_yap_flags'(10,0),
( recorded('$spy_stop',_,R), erase(R), fail ; true).
( recorded('$spy_stop',_,R), erase(R), fail ; true),
nodebug.
'$action'(0'k,_,CallNumber,_,_) :- !, % k quasi leap
'$skipeol'(0'k),

14
pl/threads.yap
View File

@ -25,7 +25,8 @@
'$init_thread0' :-
no_threads, !.
'$init_thread0' :-
'$create_mq'(0).
'$create_mq'(0),
'$add_thread_aliases'([main], 0).
'$top_thread_goal'(G, Detached) :-
@ -281,7 +282,7 @@ message_queue_create(Cond) :-
recorda('$queue',q(Cond,Mutex,Cond,CName), _).
message_queue_create(Name) :-
atom(Name),
recorded('$thread_alias',[Name|_],_), !,
recorded('$thread_alias',[_,Name],_), !,
'$do_error'(permission_error(create,queue,Name),message_queue_create(Name)).
message_queue_create(Name) :-
atom(Name), !,
@ -323,9 +324,9 @@ message_queue_destroy(Name) :-
erase(R),
fail.
'$clean_mqueue'(_).
thread_send_message(Queue, Term) :-
recorded('$thread_alias',[Queue|Id],_), !,
recorded('$thread_alias',[Id|Queue],_), !,
thread_send_message(Id, Term).
thread_send_message(Queue, Term) :-
recorded('$queue',q(Queue,Mutex,Cond,Key),_),
@ -338,6 +339,9 @@ thread_get_message(Term) :-
'$thread_self'(Id),
thread_get_message(Id, Term).
thread_get_message(Queue, Term) :-
recorded('$thread_alias',[Id|Queue],_), !,
thread_get_message(Id, Term).
thread_get_message(Queue, Term) :-
recorded('$queue',q(Queue,Mutex,Cond,Key),_),
mutex_lock(Mutex),
@ -396,7 +400,7 @@ thread_signal(Thread, Goal) :-
var(Thread), !,
'$do_error'(instantiation_error,thread_signal(Thread, Goal)).
thread_signal(Thread, Goal) :-
recorded('$thread_alias',[Thread|Id],_),
recorded('$thread_alias',[Id|Thread],_),
'$thread_signal'(Id, Goal).
thread_signal(Thread, Goal) :-
integer(Thread), !,