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

major changes to support online event-based profiling

Browse Source 
improve error discovery and restart on scanner.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1477 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-12-17 03:25:39 +00:00
parent fb399932e4
commit 60d79804fe
32 changed files with 1339 additions and 707 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
C/absmi.c
View File

@ -10,8 +10,14 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2005-12-05 17:16:10 $,$Author: vsc $ *
* Last rev: $Date: 2005-12-17 03:25:38 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.188 2005/12/05 17:16:10 vsc
* write_depth/3
* overflow handlings and garbage collection
* Several ipdates to CLPBN
* dif/2 could be broken in the presence of attributed variables.
*
* Revision 1.187 2005/11/26 02:57:25 vsc
* improvements to debugger
* overflow fixes
@ -384,41 +390,6 @@ push_live_regs(yamop *pco)
}
#endif
#if LOW_PROF
#include <signal.h>
#include <ucontext.h>
#include <stdio.h>
#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)
{
#if __linux__ && (defined(i386) || defined(__amd64__))
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);
#endif
return;
}
#endif
#if defined(ANALYST) || defined(DEBUG)
char *Yap_op_names[_std_top + 1] =
@ -639,7 +610,7 @@ Yap_absmi(int inp)
#endif /* OS_HANDLES_TR_OVERFLOW */
BOp(Ystop, e);
BOp(Ystop, l);
if (YREG > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
}
@ -1171,7 +1142,7 @@ Yap_absmi(int inp)
/* we have our own copy for the clause */
#if defined(YAPOR) || defined(THREADS)
{
LogUpdClause *cl = (LogUpdClause *)PREG->u.EC.ClBase;
LogUpdClause *cl = PREG->u.EC.ClBase;
LOCK(cl->ClLock);
/* always add an extra reference */
@ -2160,11 +2131,11 @@ Yap_absmi(int inp)
/* Macros for stack trimming */
/* execute Label */
BOp(execute, p);
BOp(execute, pp);
{
PredEntry *pt0;
CACHE_Y_AS_ENV(YREG);
pt0 = PREG->u.p.p;
pt0 = PREG->u.pp.p;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,pt0,XREGS+1);
@ -2198,7 +2169,7 @@ Yap_absmi(int inp)
ENDBOp();
NoStackExecute:
SREG = (CELL *) PREG->u.p.p;
SREG = (CELL *) PREG->u.pp.p;
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ASP = YREG+E_CB;
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
@ -2212,17 +2183,17 @@ Yap_absmi(int inp)
/* dexecute Label */
/* joint deallocate and execute */
BOp(dexecute, p);
BOp(dexecute, pp);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,PREG->u.p.p,XREGS+1);
low_level_trace(enter_pred,PREG->u.pp.p,XREGS+1);
#endif /* LOW_LEVEL_TRACER */
CACHE_Y_AS_ENV(YREG);
{
PredEntry *pt0;
CACHE_A1();
pt0 = PREG->u.p.p;
pt0 = PREG->u.pp.p;
#ifndef NO_CHECKING
/* check stacks */
check_stack(NoStackDExecute, H);
@ -2760,7 +2731,7 @@ Yap_absmi(int inp)
CACHE_A1();
JMPNext();
BOp(procceed, e);
BOp(procceed, p);
CACHE_Y_AS_ENV(YREG);
PREG = CPREG;
ENV_YREG = ENV;
@ -7178,6 +7149,10 @@ Yap_absmi(int inp)
}
#endif
saveregs();
{
static yamop *opppp;
opppp= PREG;
}
pt0 = Yap_ExpandIndex(pe, 0);
/* restart index */
setregs();
@ -7815,16 +7790,17 @@ Yap_absmi(int inp)
/* we use a very simple hash function to find elements in a
* switch table */
{
register CELL
CELL
/* first, calculate the mask */
Mask = (PREG->u.sssl.s - 1) << 1, /* next, calculate the hash function */
hash = d1 >> (HASH_SHIFT - 1) & Mask;
CELL *base;
PREG = (yamop *)(PREG->u.sssl.l);
base = (CELL *)PREG->u.sssl.l;
/* PREG now points at the beginning of the hash table */
BEGP(pt0);
/* pt0 will always point at the item */
pt0 = (CELL *) (PREG) + hash;
pt0 = base + hash;
BEGD(d0);
d0 = pt0[0];
/* a match happens either if we found the value, or if we
@ -7840,7 +7816,7 @@ Yap_absmi(int inp)
while (1) {
hash = (hash + d) & Mask;
pt0 = (CELL *) (PREG) + hash;
pt0 = base + hash;
d0 = pt0[0];
if (d0 == d1 || d0 == 0) {
copy_jmp_addressa(pt0+1);
@ -7861,16 +7837,17 @@ Yap_absmi(int inp)
/* we use a very simple hash function to find elements in a
* switch table */
{
register CELL
CELL
/* first, calculate the mask */
Mask = (PREG->u.sssl.s - 1) << 1, /* next, calculate the hash function */
hash = d1 >> (HASH_SHIFT - 1) & Mask;
CELL *base;
PREG = (yamop *)(PREG->u.sssl.l);
base = (CELL *)PREG->u.sssl.l;
/* PREG now points at the beginning of the hash table */
BEGP(pt0);
/* pt0 will always point at the item */
pt0 = (CELL *) (PREG) + hash;
pt0 = base + hash;
BEGD(d0);
d0 = pt0[0];
/* a match happens either if we found the value, or if we
@ -7886,7 +7863,7 @@ Yap_absmi(int inp)
while (1) {
hash = (hash + d) & Mask;
pt0 = (CELL *) (PREG) + hash;
pt0 = base + hash;
d0 = pt0[0];
if (d0 == d1 || d0 == 0) {
copy_jmp_addressa(pt0+1);

27
C/adtdefs.c
View File

@ -564,6 +564,15 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
fe->PropsOfFE = p0 = AbsPredProp(p);
p->FunctorOfPred = (Functor)fe;
WRITE_UNLOCK(fe->FRWLock);
#ifdef LOW_PROF
if (ProfilerOn &&
Yap_OffLineProfiler) {
Yap_inform_profiler_of_clause((yamop *)&(p->OpcodeOfPred), (yamop *)(&(p->OpcodeOfPred)+1), p, 1);
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
Yap_inform_profiler_of_clause((yamop *)&(p->cs.p_code.ExpandCode), (yamop *)(&(p->cs.p_code.ExpandCode)+1), p, 1);
}
}
#endif /* LOW_PROF */
return p0;
}
@ -600,6 +609,15 @@ Yap_NewThreadPred(PredEntry *ap)
p->NextOfPE = AbsPredProp(ThreadHandle[worker_id].local_preds);
ThreadHandle[worker_id].local_preds = p;
p->FunctorOfPred = ap->FunctorOfPred;
#ifdef LOW_PROF
if (ProfilerOn &&
Yap_OffLineProfiler) {
Yap_inform_profiler_of_clause((yamop *)&(p->OpcodeOfPred), (yamop *)(&(p->OpcodeOfPred)+1), p, 1);
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
Yap_inform_profiler_of_clause((yamop *)&(p->cs.p_code.ExpandCode), (yamop *)(&(p->cs.p_code.ExpandCode)+1), p, 1);
}
}
#endif /* LOW_PROF */
return AbsPredProp(p);
}
#endif
@ -658,6 +676,15 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
ae->PropsOfAE = p0 = AbsPredProp(p);
p->FunctorOfPred = (Functor)AbsAtom(ae);
WRITE_UNLOCK(ae->ARWLock);
#ifdef LOW_PROF
if (ProfilerOn &&
Yap_OffLineProfiler) {
Yap_inform_profiler_of_clause((yamop *)&(p->OpcodeOfPred), (yamop *)(&(p->OpcodeOfPred)+1), p, 1);
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
Yap_inform_profiler_of_clause((yamop *)&(p->cs.p_code.ExpandCode), (yamop *)(&(p->cs.p_code.ExpandCode)+1), p, 1);
}
}
#endif /* LOW_PROF */
return p0;
}

25
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.78 2005-12-07 17:53:29 vsc Exp $ *
* version:$Id: alloc.c,v 1.79 2005-12-17 03:25:39 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -81,30 +81,36 @@ minfo(char mtype)
static inline char *
call_malloc(unsigned int size)
{
char *out;
#if INSTRUMENT_MALLOC
if (mallocs % 1024*4 == 0)
minfo('A');
mallocs++;
tmalloc += size;
#endif
return (char *) malloc(size);
Yap_PrologMode |= MallocMode;
out = (char *) malloc(size);
Yap_PrologMode &= ~MallocMode;
return out;
}
char *
Yap_AllocCodeSpace(unsigned int size)
{
return call_malloc(size);
return call_malloc(size);
}
void
Yap_FreeCodeSpace(char *p)
{
Yap_PrologMode |= MallocMode;
#if INSTRUMENT_MALLOC
if (frees % 1024*4 == 0)
minfo('F');
frees++;
#endif
free (p);
Yap_PrologMode &= ~MallocMode;
}
char *
@ -116,12 +122,14 @@ Yap_AllocAtomSpace(unsigned int size)
void
Yap_FreeAtomSpace(char *p)
{
Yap_PrologMode |= MallocMode;
#if INSTRUMENT_MALLOC
if (frees % 1024*4 == 0)
minfo('F');
frees++;
#endif
free (p);
Yap_PrologMode &= ~MallocMode;
}
/* If you need to dinamically allocate space from the heap, this is
@ -132,11 +140,16 @@ Yap_InitPreAllocCodeSpace(void)
char *ptr;
UInt sz = ScratchPad.msz;
if (ScratchPad.ptr == NULL) {
while (!(ptr = malloc(sz)))
Yap_PrologMode |= MallocMode;
while (!(ptr = malloc(sz))) {
Yap_PrologMode &= ~MallocMode;
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return(NULL);
}
Yap_PrologMode |= MallocMode;
}
Yap_PrologMode &= ~MallocMode;
ScratchPad.ptr = ptr;
} else {
ptr = ScratchPad.ptr;
@ -161,7 +174,9 @@ Yap_ExpandPreAllocCodeSpace(UInt sz0, void *cip)
minfo('R');
reallocs++;
#endif
Yap_PrologMode |= MallocMode;
while (!(ptr = realloc(ScratchPad.ptr, sz))) {
Yap_PrologMode &= ~MallocMode;
#if USE_DL_MALLOC
if (!Yap_growheap((cip!=NULL), sz, cip)) {
return NULL;
@ -169,7 +184,9 @@ Yap_ExpandPreAllocCodeSpace(UInt sz0, void *cip)
#else
return NULL;
#endif
Yap_PrologMode |= MallocMode;
}
Yap_PrologMode &= ~MallocMode;
ScratchPad.ptr = ptr;
AuxSp = (CELL *)(AuxTop = ptr+sz);
return ptr;

47
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c *
* comments: abstract machine assembler *
* *
* Last rev: $Date: 2005-09-08 22:06:44 $ *
* Last rev: $Date: 2005-12-17 03:25:39 $ *
* $Log: not supported by cvs2svn $
* Revision 1.84 2005/09/08 22:06:44 rslopes
* BEAM for YAP update...
*
* Revision 1.83 2005/08/02 03:09:49 vsc
* fix debugger to do well nonsource predicates.
*
@ -435,7 +438,7 @@ a_cle(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
code_p->u.EC.ClTrail = 0;
code_p->u.EC.ClENV = 0;
code_p->u.EC.ClRefs = 0;
code_p->u.EC.ClBase = cip->code_addr;
code_p->u.EC.ClBase = cl;
cl->ClExt = code_p;
cl->ClFlags |= LogUpdRuleMask;
}
@ -1087,6 +1090,14 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
}
GONEXT(sla);
}
else if (opcode == _execute ||
opcode == _dexecute) {
if (pass_no) {
code_p->u.pp.p = RepPredProp(fe);
code_p->u.pp.p0 = clinfo->CurrentPred;
}
GONEXT(pp);
}
else {
if (pass_no)
code_p->u.p.p = RepPredProp(fe);
@ -1430,7 +1441,7 @@ init_log_upd_table(LogUpdIndex *ic, union clause_obj *cl_u)
ic->PrevSiblingIndex = NULL;
ic->ChildIndex = NULL;
ic->ClRefCount = 0;
ic->u.ParentIndex = (LogUpdIndex *)cl_u;
ic->ParentIndex = (LogUpdIndex *)cl_u;
INIT_LOCK(ic->ClLock);
cl_u->lui.ChildIndex = ic;
cl_u->lui.ClRefCount++;
@ -2500,7 +2511,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
cl_u->lui.ChildIndex = NULL;
cl_u->lui.SiblingIndex = NULL;
cl_u->lui.PrevSiblingIndex = NULL;
cl_u->lui.u.pred = cip->CurrentPred;
cl_u->lui.ClPred = cip->CurrentPred;
cl_u->lui.ParentIndex = NULL;
cl_u->lui.ClSize = size;
cl_u->lui.ClRefCount = 0;
INIT_LOCK(cl_u->lui.ClLock);
@ -2526,6 +2538,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
cl_u->si.ClFlags = IndexMask;
cl_u->si.ChildIndex = NULL;
cl_u->si.SiblingIndex = NULL;
cl_u->si.ClPred = cip->CurrentPred;
}
code_p = cl_u->si.ClCode;
*entry_codep = code_p;
@ -2750,6 +2763,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
break;
case fail_op:
code_p = a_e(_op_fail, code_p, pass_no);
code_p = a_pl(_procceed, cip->CurrentPred, code_p, pass_no);
break;
case cut_op:
code_p = a_cut(&clinfo, code_p, pass_no, cip);
@ -2770,7 +2784,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
!(cip->CurrentPred->PredFlags & ThreadLocalPredFlag))
code_p = a_e(_unlock_lu, code_p, pass_no);
#endif
code_p = a_e(_procceed, code_p, pass_no);
code_p = a_pl(_procceed, cip->CurrentPred, code_p, pass_no);
#ifdef YAPOR
if (pass_no)
PUT_YAMOP_CUT(*entry_codep);
@ -2876,7 +2890,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
!(cip->CurrentPred->PredFlags & ThreadLocalPredFlag))
code_p = a_e(_unlock_lu, code_p, pass_no);
#endif
code_p = a_e(_procceed, code_p, pass_no);
code_p = a_pl(_procceed, cip->CurrentPred, code_p, pass_no);
break;
case call_op:
code_p = a_p(_call, &clinfo, code_p, pass_no, cip);
@ -2898,7 +2912,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
(cip->cpc->nextInst->op == mark_initialised_pvars_op ||
cip->cpc->nextInst->op == blob_op)) {
ystop_found = TRUE;
code_p = a_e(_Ystop, code_p, pass_no);
code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
}
if (!pass_no) {
if (CellPtr(cip->label_offset+cip->cpc->rnd1) > ASP-256) {
@ -3011,9 +3025,17 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = a_e(_index_blob, code_p, pass_no);
break;
case mark_initialised_pvars_op:
if (!ystop_found) {
code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
ystop_found = TRUE;
}
code_p = a_bmap(code_p, pass_no, cip->cpc);
break;
case mark_live_regs_op:
if (!ystop_found) {
code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
ystop_found = TRUE;
}
code_p = a_bregs(code_p, pass_no, cip->cpc);
break;
case commit_opt_op:
@ -3095,7 +3117,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
cip->cpc = cip->cpc->nextInst;
}
if (!ystop_found)
code_p = a_e(_Ystop, code_p, pass_no);
code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
return code_p;
}
@ -3218,6 +3240,12 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
}
code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, cip, size);
ProfEnd=code_p;
#ifdef LOW_PROF
if (ProfilerOn &&
Yap_OffLineProfiler) {
Yap_inform_profiler_of_clause(entry_code, ProfEnd, ap, mode == ASSEMBLING_INDEX);
}
#endif /* LOW_PROF */
return entry_code;
}
@ -3247,7 +3275,8 @@ Yap_InitComma(void)
code_p->opc = emit_op(_deallocate);
GONEXT(e);
code_p->opc = emit_op(_procceed);
GONEXT(e);
code_p->u.p.p = PredMetaCall;
GONEXT(p);
} else {
if (PROFILING) {
code_p->opc = opcode(_enter_a_profiling);

857
C/cdmgr.c
View File

File diff suppressed because it is too large Load Diff

9
C/compiler.c
View File

@ -11,8 +11,11 @@
* File: compiler.c *
* comments: Clause compiler *
* *
* Last rev: $Date: 2005-09-08 22:06:44 $,$Author: rslopes $ *
* Last rev: $Date: 2005-12-17 03:25:39 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.69 2005/09/08 22:06:44 rslopes
* BEAM for YAP update...
*
* Revision 1.68 2005/07/06 15:10:03 vsc
* improvements to compiler: merged instructions and fixes for ->
*
@ -3189,11 +3192,11 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
return NULL;
} else {
#ifdef LOW_PROF
if (ProfilerOn) {
if (ProfilerOn &&
Yap_OffLineProfiler) {
Yap_inform_profiler_of_clause(acode, ProfEnd, cglobs.cint.CurrentPred,0);
}
#endif /* LOW_PROF */
return(acode);
}
}

18
C/dbase.c
View File

@ -1941,6 +1941,12 @@ record_lu(PredEntry *pe, Term t, int position)
#if defined(YAPOR) || defined(THREADS)
WPP = pe;
#endif
#ifdef LOW_PROF
if (ProfilerOn &&
Yap_OffLineProfiler) {
Yap_inform_profiler_of_clause(cl->ClCode, (yamop *)(cl+cl->ClSize), pe, 0);
}
#endif /* LOW_PROF */
Yap_add_logupd_clause(pe, cl, (position == MkFirst ? 2 : 0));
#if defined(YAPOR) || defined(THREADS)
WPP = NULL;
@ -3828,13 +3834,9 @@ p_key_erased_statistics(void)
cl = cl->ClNext;
}
while (icl) {
LogUpdIndex *c = icl;
while (!c->ClFlags & SwitchRootMask)
c = c->u.ParentIndex;
if (pe == c->u.pred) {
if (pe == icl->ClPred) {
icls++;
isz += c->ClSize;
isz += icl->ClSize;
}
icl = icl->SiblingIndex;
}
@ -4065,6 +4067,8 @@ complete_lu_erase(LogUpdClause *clau)
}
}
}
if (clau->ClFlags & ProfFoundMask)
Yap_InformOfRemoval((CODEADDR)clau);
Yap_FreeCodeSpace((char *)clau);
}
@ -4184,6 +4188,8 @@ MyEraseClause(DynamicClause *clau)
P = np;
}
} else {
if (clmask & ProfFoundMask)
Yap_InformOfRemoval((CODEADDR)clau);
Yap_FreeCodeSpace((char *)clau);
#ifdef DEBUG
if (ref->NOfRefsTo)

11
C/heapgc.c
View File

@ -3509,7 +3509,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
while (H0 - max < 1024+(2*NUM_OF_ATTS)) {
if (!Yap_growglobal(&current_env)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return 0;
return -1;
}
max = (CELL *)DelayTop();
}
@ -3549,7 +3549,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
fprintf(Yap_stderr, "%% TrailTop at %p clashes with gc bits: %lx\n", Yap_TrailTop, (unsigned long int)(MBIT|RBIT));
fprintf(Yap_stderr, "%% garbage collection disallowed\n");
}
return(0);
return -1;
}
#endif
if (gc_trace) {
@ -3569,7 +3569,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
*--ASP = (CELL)current_env;
if (!Yap_growheap(FALSE, MinHeapGap, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
return -1;
}
current_env = (CELL *)*ASP;
ASP++;
@ -3594,7 +3594,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
*--ASP = (CELL)current_env;
Yap_bp = (char *)Yap_ExpandPreAllocCodeSpace(alloc_sz, NULL);
if (!Yap_bp)
return 0;
return -1;
current_env = (CELL *)*ASP;
ASP++;
#if COROUTINING
@ -3809,6 +3809,7 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
/* expand the stack if effectiveness is less than 20 % */
if (ASP - H < gc_margin/sizeof(CELL) ||
effectiveness < 20) {
Yap_PrologMode &= ~GCMode;
return Yap_growstack(gc_margin);
}
/*
@ -3838,7 +3839,7 @@ Yap_gcl(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
static Int
p_gc(void)
{
return do_gc(0, ENV, P);
return do_gc(0, ENV, P) >= 0;
}
void

124
C/index.c
View File

@ -11,8 +11,11 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2005-11-24 15:33:52 $,$Author: tiagosoares $ *
* Last rev: $Date: 2005-12-17 03:25:39 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.148 2005/11/24 15:33:52 tiagosoares
* removed some compilation warnings related to the cut-c code
*
* Revision 1.147 2005/11/18 18:48:52 tiagosoares
* support for executing c code when a cut occurs
*
@ -749,14 +752,16 @@ has_cut(yamop *pc)
case _stale_lu_index:
pc = pc->u.Ill.l1;
break;
case _execute:
case _dexecute:
pc = NEXTOP(pc,pp);
break;
/* instructions type l */
case _enter_profiling:
case _count_call:
case _retry_profiled:
case _count_retry:
case _trust_logical_pred:
case _execute:
case _dexecute:
case _jump:
case _move_back:
case _skip:
@ -782,7 +787,6 @@ has_cut(yamop *pc)
/* instructions type e */
case _trust_fail:
case _op_fail:
case _procceed:
case _allocate:
case _deallocate:
case _write_void:
@ -3228,7 +3232,14 @@ emit_switch_space(UInt n, UInt item_size, struct intermediates *cint)
}
cl->ClFlags = SwitchTableMask|LogUpdMask;
cl->ClSize = sz;
cl->ClPred = cint->CurrentPred;
/* insert into code chain */
#ifdef LOW_PROF
if (ProfilerOn &&
Yap_OffLineProfiler) {
Yap_inform_profiler_of_clause(cl->ClCode, (yamop*)((CODEADDR)cl+sz), ap, 1);
}
#endif /* LOW_PROF */
return cl->ClCode;
} else {
UInt sz = sizeof(StaticIndex)+n*item_size;
@ -3239,6 +3250,13 @@ emit_switch_space(UInt n, UInt item_size, struct intermediates *cint)
}
cl->ClFlags = SwitchTableMask;
cl->ClSize = sz;
cl->ClPred = cint->CurrentPred;
#ifdef LOW_PROF
if (ProfilerOn &&
Yap_OffLineProfiler) {
Yap_inform_profiler_of_clause(cl->ClCode, (yamop*)((CODEADDR)cl+sz), ap, 1);
}
#endif /* LOW_PROF */
return cl->ClCode;
/* insert into code chain */
}
@ -3563,6 +3581,12 @@ suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap, struct intermedi
if ((ncode = (yamop *)Yap_AllocCodeSpace(sz)) == NULL) {
longjmp(cint->CompilerBotch, 2);
}
#ifdef LOW_PROF
if (ProfilerOn &&
Yap_OffLineProfiler) {
Yap_inform_profiler_of_clause(ncode, NEXTOP(ncode,sp), ap, 1);
}
#endif /* LOW_PROF */
/* create an expand_block */
ncode->opc = Yap_opcode(_expand_clauses);
ncode->u.sp.p = ap;
@ -3611,8 +3635,10 @@ recover_ecls_block(yamop *ipc)
}
UNLOCK(ExpandClausesListLock);
#if DEBUG
Yap_expand_clauses_sz -= (UInt)(NEXTOP((yamop *)NULL,sp))+ipc->u.sp.s1*sizeof(yamop *);
Yap_expand_clauses_sz -= (UInt)(NEXTOP((yamop *)NULL,sp))+ipc->u.sp.s1*sizeof(yamop *);
#endif
/* no dangling pointers for gprof */
Yap_InformOfRemoval((CODEADDR)ipc);
Yap_FreeCodeSpace((char *)ipc);
}
}
@ -4381,11 +4407,6 @@ Yap_PredIsIndexable(PredEntry *ap, UInt NSlots)
} else {
return NULL;
}
#ifdef LOW_PROF
if (ProfilerOn) {
Yap_inform_profiler_of_clause(indx_out, ProfEnd, ap,1);
}
#endif /* LOW_PROF */
if (ap->PredFlags & LogUpdatePredFlag) {
LogUpdIndex *cl = ClauseCodeToLogUpdIndex(indx_out);
cl->ClFlags |= SwitchRootMask;
@ -4892,6 +4913,7 @@ expand_index(struct intermediates *cint) {
ipc = ipc->u.l.l;
break;
case _lock_lu:
case _procceed:
ipc = NEXTOP(ipc,p);
break;
case _unlock_lu:
@ -5273,9 +5295,6 @@ expand_index(struct intermediates *cint) {
lab = do_index(cls, max, cint, argno+1, fail_l, isfirstcl, clleft, top);
}
}
if (eblk) {
recover_ecls_block(eblk);
}
if (labp && !(lab & 1))
*labp = (yamop *)lab; /* in case we have a single clause */
return labp;
@ -5284,7 +5303,7 @@ expand_index(struct intermediates *cint) {
static yamop *
ExpandIndex(PredEntry *ap, int ExtraArgs) {
yamop *indx_out;
yamop *indx_out, *expand_clauses;
yamop **labp;
int cb;
struct intermediates cint;
@ -5332,6 +5351,11 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) {
cint.CurrentPred = ap;
Yap_ErrorMessage = NULL;
Yap_Error_Size = 0;
if (P->opc == Yap_opcode(_expand_clauses)) {
expand_clauses = P;
} else {
expand_clauses = NULL;
}
#ifdef DEBUG
if (Yap_Option['i' - 'a' + 1]) {
Term tmod = ap->ModuleOfPred;
@ -5393,11 +5417,6 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) {
/* single case */
return *labp;
}
#ifdef LOW_PROF
if (ProfilerOn) {
Yap_inform_profiler_of_clause(indx_out, ProfEnd, ap,1);
}
#endif /* LOW_PROF */
if (indx_out == NULL) {
return FAILCODE;
}
@ -5414,7 +5433,7 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) {
if (ic->ChildIndex) {
ic->ChildIndex->PrevSiblingIndex = nic;
}
nic->u.ParentIndex = ic;
nic->ParentIndex = ic;
nic->ClFlags &= ~SwitchRootMask;
ic->ChildIndex = nic;
ic->ClRefCount++;
@ -5428,6 +5447,10 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) {
nic->SiblingIndex = ic->ChildIndex;
ic->ChildIndex = nic;
}
if (expand_clauses) {
P = indx_out;
recover_ecls_block(expand_clauses);
}
return indx_out;
}
@ -5588,7 +5611,8 @@ replace_index_block(ClauseUnion *parent_block, yamop *cod, yamop *ncod, PredEntr
ncl->PrevSiblingIndex = cl->PrevSiblingIndex;
ncl->ClRefCount = cl->ClRefCount;
ncl->ChildIndex = cl->ChildIndex;
ncl->u.ParentIndex = cl->u.ParentIndex;
ncl->ParentIndex = cl->ParentIndex;
ncl->ClPred = cl->ClPred;
INIT_LOCK(ncl->ClLock);
if (c == cl) {
parent_block->lui.ChildIndex = ncl;
@ -5600,7 +5624,7 @@ replace_index_block(ClauseUnion *parent_block, yamop *cod, yamop *ncod, PredEntr
}
c = cl->ChildIndex;
while (c != NULL) {
c->u.ParentIndex = ncl;
c->ParentIndex = ncl;
c = c->SiblingIndex;
}
Yap_FreeCodeSpace((char *)cl);
@ -5610,6 +5634,7 @@ replace_index_block(ClauseUnion *parent_block, yamop *cod, yamop *ncod, PredEntr
*ncl = ClauseCodeToStaticIndex(ncod),
*c = parent_block->si.ChildIndex;
ncl->SiblingIndex = cl->SiblingIndex;
ncl->ClPred = cl->ClPred;
if (c == cl) {
parent_block->si.ChildIndex = ncl;
} else {
@ -6073,6 +6098,9 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
if (flag == RECORDZ) {
codep = gen_lui_trust(codep, ocodep, profiled, count_reds, ap, code, has_cut, nblk);
}
codep->opc = Yap_opcode(_Ystop);
/* this must be updated if we are copying to different place */
codep->u.l.l = ostart;
return codep;
}
@ -6109,13 +6137,15 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
((UInt)NEXTOP((yamop *)NULL,ld))+
jnvs*((UInt)NEXTOP((yamop *)NULL,xll))+
(UInt)NEXTOP((yamop *)NULL,Ill)+
(UInt)NEXTOP((yamop *)NULL,p);
(UInt)NEXTOP((yamop *)NULL,p)+
(UInt)NEXTOP((yamop *)NULL,l);
} else {
sz = sizeof(LogUpdIndex)+
xcls*((UInt)NEXTOP((yamop *)NULL,ld))+
jnvs*((UInt)NEXTOP((yamop *)NULL,xll))+
(UInt)NEXTOP((yamop *)NULL,Ill)+
(UInt)NEXTOP((yamop *)NULL,p);
(UInt)NEXTOP((yamop *)NULL,p)+
(UInt)NEXTOP((yamop *)NULL,l);
}
if (count_reds) sz += xcls*((UInt)NEXTOP((yamop *)NULL,p));
if (profiled) sz += xcls*((UInt)NEXTOP((yamop *)NULL,p));
@ -6125,23 +6155,29 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
Yap_ErrorMessage = "while at indexing code";
return NULL;
}
#ifdef LOW_PROF
if (ProfilerOn &&
Yap_OffLineProfiler) {
Yap_inform_profiler_of_clause(ncl->ClCode, (yamop *)(ncl+sz), ap, 1);
}
#endif /* LOW_PROF */
ncl->ClFlags = LogUpdMask|IndexedPredFlag|IndexMask;
if (blk->ClFlags & SwitchRootMask) {
ncl->ClFlags |= SwitchRootMask;
ncl->u.pred = blk->u.pred;
} else {
ncl->u.ParentIndex = blk->u.ParentIndex;
}
ncl->ClPred = blk->ClPred;
ncl->ParentIndex = blk->ParentIndex;
ncl->ClRefCount = 0;
{
LogUpdIndex *idx = ncl->ChildIndex = blk->ChildIndex;
while (idx) {
LogUpdIndex *nidx;
LOCK(idx->ClLock);
blk->ClRefCount--;
ncl->ClRefCount++;
idx->u.ParentIndex = ncl;
idx->ParentIndex = ncl;
nidx = idx->SiblingIndex;
UNLOCK(idx->ClLock);
idx = nidx;
@ -6212,12 +6248,16 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
codep = cp_lu_trychain(codep, ocodep, begin, flag, ap, code, has_cut, ncl, ncls, i);
/* the copying has been done */
start->u.Ill.l2 = codep;
/* make sure we have access to the clause */
codep->u.l.l = start;
/* insert ourselves into chain */
if (blk->ClFlags & SwitchRootMask) {
Yap_kill_iblock((ClauseUnion *)blk, NULL, ap);
} else {
pcl = blk->u.ParentIndex;
pcl = blk->ParentIndex;
ncl->SiblingIndex = pcl->ChildIndex;
ncl->ClPred = pcl->ClPred;
ncl->ParentIndex = pcl;
ncl->PrevSiblingIndex = NULL;
if (pcl->ChildIndex) {
pcl->ChildIndex->PrevSiblingIndex = ncl;
@ -6290,16 +6330,12 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
otherwise I just don't understand what is going on */
if ((op != _enter_lu_pred && op != _stale_lu_index) ||
! is_trust(PREVOP(begin->u.xll.l2,ld)->opc)) {
if (blk->ClFlags & SwitchRootMask) {
Yap_kill_iblock((ClauseUnion *)blk, NULL, ap);
} else {
Yap_kill_iblock((ClauseUnion *)blk, (ClauseUnion *)blk->u.ParentIndex, ap);
}
Yap_kill_iblock((ClauseUnion *)blk, (ClauseUnion *)blk->ParentIndex, ap);
return (yamop *)&(ap->cs.p_code.ExpandCode);
}
/* ok, we are in a sequence of try-retry-trust instructions, or something
similar */
bsize = blk->ClSize;
bsize = blk->ClSize -(CELL)NEXTOP((yamop*)NULL,l);
end = (yamop *)((CODEADDR)blk+bsize);
where = last = begin->u.Ill.l2;
next = NEXTOP(where, ld);
@ -6373,7 +6409,10 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
#ifdef TABLING
where->u.ld.te = last->u.ld.te;
#endif /* TABLING */
begin->u.Ill.l2 = NEXTOP(where,ld);
where = NEXTOP(where,ld);
begin->u.Ill.l2 = where;
where->opc = Yap_opcode(_Ystop);
where->u.l.l = begin;
begin->u.Ill.s++;
tgl->ClRefCount++;
return blk->ClCode;
@ -6396,11 +6435,7 @@ inserta_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
}
if ((op != _enter_lu_pred && op != _stale_lu_index) ||
! is_trust(PREVOP(begin->u.xll.l2,ld)->opc)) {
if (blk->ClFlags & SwitchRootMask) {
Yap_kill_iblock((ClauseUnion *)blk, NULL, ap);
} else {
Yap_kill_iblock((ClauseUnion *)blk, (ClauseUnion *)blk->u.ParentIndex, ap);
}
Yap_kill_iblock((ClauseUnion *)blk, (ClauseUnion *)blk->ParentIndex, ap);
return (yamop *)&(ap->cs.p_code.ExpandCode);
}
/* ok, we are in a sequence of try-retry-trust instructions, or something
@ -8694,13 +8729,10 @@ yamop *
Yap_CleanUpIndex(LogUpdIndex *blk)
{
PredEntry *ap;
LogUpdIndex *pblk = blk, *tblk;
LogUpdIndex *pblk = blk;
/* first, go up until findin'your pred */
tblk = pblk;
while (!(tblk->ClFlags & SwitchRootMask))
tblk = tblk->u.ParentIndex;
ap = tblk->u.pred;
ap = pblk->ClPred;
if (
#if defined(THREADS) || defined(YAPOR)

36
C/init.c
View File

@ -489,9 +489,9 @@ Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, int flags)
UInt sz;
if (flags & SafePredFlag) {
sz = (CELL)NEXTOP(NEXTOP(NEXTOP(p_code,sla),e),e);
sz = (CELL)NEXTOP(NEXTOP(NEXTOP(p_code,sla),p),l);
} else {
sz = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(p_code,e),sla),e),e),e);
sz = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(p_code,e),sla),e),p),l);
}
cl = (StaticClause *)Yap_AllocCodeSpace(sz);
if (!cl) {
@ -527,8 +527,10 @@ Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, int flags)
p_code = NEXTOP(p_code,e);
}
p_code->opc = Yap_opcode(_procceed);
p_code = NEXTOP(p_code,e);
p_code->u.p.p = pe;
p_code = NEXTOP(p_code,p);
p_code->opc = Yap_opcode(_Ystop);
p_code->u.l.l = cl->ClCode;
pe->OpcodeOfPred = pe->CodeOfPred->opc;
pe->ModuleOfPred = CurrentModule;
}
@ -551,7 +553,7 @@ Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, int
/* already exists */
} else {
while (!cl) {
UInt sz = sizeof(StaticClause)+(CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)NULL),llxx),e),e);
UInt sz = sizeof(StaticClause)+(CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)NULL),llxx),p),l);
cl = (StaticClause *)Yap_AllocCodeSpace(sz);
if (!cl) {
if (!Yap_growheap(FALSE, sz, NULL)) {
@ -579,8 +581,10 @@ Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, int
p_code->u.llxx.flags = Yap_compile_cmp_flags(pe);
p_code = NEXTOP(p_code,llxx);
p_code->opc = Yap_opcode(_procceed);
p_code = NEXTOP(p_code,e);
p_code->u.p.p = pe;
p_code = NEXTOP(p_code,p);
p_code->opc = Yap_opcode(_Ystop);
p_code->u.l.l = cl->ClCode;
}
void
@ -598,13 +602,15 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
pe->ModuleOfPred = CurrentModule;
if (def != NULL) {
yamop *p_code = ((StaticClause *)NULL)->ClCode;
StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),sla),e),e));
StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),sla),p),l));
if (!cl) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitAsmPred");
return;
}
cl->ClFlags = 0;
cl->ClSize = (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),sla),e),e);
cl->usc.ClPred = pe;
p_code = cl->ClCode;
pe->CodeOfPred = p_code;
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred);
@ -613,8 +619,10 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
p_code->u.sla.sla_u.p = pe;
p_code = NEXTOP(p_code,sla);
p_code->opc = Yap_opcode(_procceed);
p_code = NEXTOP(p_code,e);
p_code->u.p.p = pe;
p_code = NEXTOP(p_code,p);
p_code->opc = Yap_opcode(_Ystop);
p_code->u.l.l = cl->ClCode;
} else {
pe->OpcodeOfPred = Yap_opcode(_undef_p);
pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
@ -727,9 +735,9 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
#endif /* YAPOR */
#ifdef CUT_C
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,lds),lds),lds),e));
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,lds),lds),lds),l));
#else
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(code,lds),lds),e));
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(code,lds),lds),l));
#endif
if (cl == NULL) {
@ -737,6 +745,15 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
return;
}
cl->ClFlags = 0L;
#ifdef CUT_C
cl->ClSize =
(CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,lds),lds),lds),e);
#else
cl->ClSize =
(CELL)NEXTOP(NEXTOP(NEXTOP(code,lds),lds),e);
#endif
cl->usc.ClPred = pe;
code = cl->ClCode;
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred =
pe->cs.p_code.FirstClause = pe->cs.p_code.LastClause = code;
@ -778,6 +795,7 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
code = NEXTOP(code,lds);
#endif /* CUT_C */
code->opc = Yap_opcode(_Ystop);
code->u.l.l = cl->ClCode;
}
}

73
C/iopreds.c
View File

@ -2886,6 +2886,7 @@ syntax_error (TokEntry * tokptr)
}
break;
case Error_tok:
case eot_tok:
break;
case Ponctuation_tok:
{
@ -3004,7 +3005,7 @@ p_get_read_error_handler(void)
Err: ARG6
*/
static Int
do_read(int inp_stream)
do_read(int inp_stream, int nargs)
{
Term t, v;
TokEntry *tokstart;
@ -3025,10 +3026,63 @@ do_read(int inp_stream)
}
while (TRUE) {
CELL *old_H;
UInt cpos = 0;
int seekable = Stream[inp_stream].status & Seekable_Stream_f;
#if HAVE_FGETPOS
fpos_t rpos;
#endif
/* two cases where we can seek: memory and console */
if (seekable) {
if (Stream[inp_stream].status & InMemory_Stream_f) {
cpos = Stream[inp_stream].u.mem_string.pos;
} else {
#if HAVE_FGETPOS
fgetpos(Stream[inp_stream].u.file.file, &rpos);
#else
cpos = ftell(Stream[inp_stream].u.file.file);
#endif
}
}
/* Scans the term using stack space */
Yap_eot_before_eof = FALSE;
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(inp_stream);
while (TRUE) {
old_H = H;
Yap_eot_before_eof = FALSE;
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(inp_stream);
if (Yap_Error_TYPE && seekable) {
H = old_H;
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
if (Stream[inp_stream].status & InMemory_Stream_f) {
Stream[inp_stream].u.mem_string.pos = cpos;
} else {
#if HAVE_FGETPOS
fsetpos(Stream[inp_stream].u.file.file, &rpos);
#else
fseek(Stream[inp_stream].u.file.file, cpos, 0L);
#endif
}
if (Yap_Error_TYPE == OUT_OF_TRAIL_ERROR) {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growtrail (sizeof(CELL) * 16 * 1024L, FALSE)) {
return FALSE;
}
} else if (Yap_Error_TYPE == OUT_OF_AUXSPACE_ERROR) {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_ExpandPreAllocCodeSpace(0, NULL)) {
return FALSE;
}
} else if (Yap_Error_TYPE == OUT_OF_STACK_ERROR) {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gc(nargs, ENV, CP)) {
return FALSE;
}
}
} else {
/* done with this */
break;
}
}
Yap_Error_TYPE = YAP_NO_ERROR;
/* preserve value of H after scanning: otherwise we may lose strings
and floats */
old_H = H;
@ -3049,8 +3103,8 @@ do_read(int inp_stream)
} else {
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return (Yap_unify(MkIntegerTerm(StartLine = Stream[inp_stream].linecount),ARG5) &&
Yap_unify_constant (ARG2, MkAtomTerm (AtomEof)));
return Yap_unify(MkIntegerTerm(StartLine = Stream[inp_stream].linecount),ARG5) &&
Yap_unify_constant(ARG2, MkAtomTerm (AtomEof));
}
}
}
@ -3153,7 +3207,7 @@ do_read(int inp_stream)
static Int
p_read (void)
{ /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
return(do_read(Yap_c_input_stream));
return(do_read(Yap_c_input_stream, 6));
}
static Int
@ -3166,7 +3220,7 @@ p_read2 (void)
if (inp_stream == -1) {
return(FALSE);
}
return(do_read(inp_stream));
return(do_read(inp_stream, 7));
}
static Int
@ -4317,7 +4371,10 @@ format(volatile Term otail, volatile Term oargs, int sno)
fill_pads(repeats-(finfo.format_ptr-finfo.format_base));
}
finfo.pad_max = finfo.pad_entries;
column_boundary = repeats;
if (repeats)
column_boundary = repeats;
else
column_boundary = finfo.format_ptr-finfo.format_base;
break;
case '+':
if (has_repeats) {

53
C/scanner.c
View File

@ -644,6 +644,7 @@ Yap_scan_num(int (*Nxtch) (int))
ScannerExtraBlocks = NULL;
if (!(ptr = AllocScannerMemory(4096))) {
Yap_ErrorMessage = "Trail Overflow";
Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
return TermNil;
}
ch = Nxtch(-1);
@ -658,6 +659,8 @@ Yap_scan_num(int (*Nxtch) (int))
return TermNil;
}
cherr = 0;
if (ASP-H < 1024)
return TermNil;
out = get_num(&ch, &cherr, -1, Nxtch, Nxtch, ptr, 4096);
PopScannerMemory(ptr, 4096);
if (sign == -1) {
@ -702,12 +705,13 @@ Yap_tokenizer(int inp_stream)
t->TokNext = NULL;
if (t == NULL) {
Yap_ErrorMessage = "Trail Overflow";
Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
if (p)
p->TokInfo = eot_tok;
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
if (l == NIL)
if (!l)
l = t;
else
p->TokNext = t;
@ -740,8 +744,18 @@ Yap_tokenizer(int inp_stream)
charp = TokImage;
isvar = (chtype[och] != LC);
*charp++ = och;
for (; chtype[ch] <= NU; ch = Nxtch(inp_stream))
for (; chtype[ch] <= NU; ch = Nxtch(inp_stream)) {
if (charp == (char *)AuxSp-1024) {
/* huge atom or variable, we are in trouble */
Yap_ErrorMessage = "Code Space Overflow due to huge atom";
Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
if (p)
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
*charp++ = ch;
}
*charp++ = '\0';
if (!isvar) {
/* don't do this in iso */
@ -749,7 +763,7 @@ Yap_tokenizer(int inp_stream)
if (ae == NIL) {
Yap_ErrorMessage = "Code Space Overflow";
if (p)
p->TokInfo = eot_tok;
t->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
@ -773,12 +787,21 @@ Yap_tokenizer(int inp_stream)
cherr = 0;
if (!(ptr = AllocScannerMemory(4096))) {
Yap_ErrorMessage = "Trail Overflow";
Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
if (p)
t->TokInfo = eot_tok;
t->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
if (ASP-H < 1024 ||
((t->TokInfo = get_num(&cha,&cherr,inp_stream,Nxtch,QuotedNxtch,ptr,4096)) == 0L)) {
Yap_ErrorMessage = "Stack Overflow";
Yap_Error_TYPE = OUT_OF_STACK_ERROR;
if (p)
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
t->TokInfo = get_num(&cha,&cherr,inp_stream,Nxtch,QuotedNxtch,ptr,4096);
PopScannerMemory(ptr, 4096);
ch = cha;
if (cherr) {
@ -788,8 +811,9 @@ Yap_tokenizer(int inp_stream)
e = (TokEntry *) AllocScannerMemory(sizeof(TokEntry));
if (e == NULL) {
Yap_ErrorMessage = "Trail Overflow";
Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
if (p)
p->TokInfo = eot_tok;
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
} else {
@ -816,8 +840,9 @@ Yap_tokenizer(int inp_stream)
e2 = (TokEntry *) AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) {
Yap_ErrorMessage = "Trail Overflow";
Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
if (p)
p->TokInfo = eot_tok;
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
} else {
@ -846,7 +871,8 @@ Yap_tokenizer(int inp_stream)
e2 = (TokEntry *) AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) {
Yap_ErrorMessage = "Trail Overflow";
p->TokInfo = eot_tok;
Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
t->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
} else {
@ -875,6 +901,7 @@ Yap_tokenizer(int inp_stream)
ch = QuotedNxtch(inp_stream);
while (1) {
if (charp + 1024 > (char *)AuxSp) {
Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
Yap_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)";
break;
}
@ -906,7 +933,8 @@ Yap_tokenizer(int inp_stream)
++len;
if (charp > (char *)AuxSp - 1024) {
/* Not enough space to read in the string. */
Yap_ErrorMessage = "not enough heap space to read in string or quoted atom";
Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
Yap_ErrorMessage = "not enough space to read in string or quoted atom";
/* serious error now */
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
@ -917,7 +945,7 @@ Yap_tokenizer(int inp_stream)
if (quote == '"') {
mp = AllocScannerMemory(len + 1);
if (mp == NULL) {
Yap_ErrorMessage = "not enough stack space to read in string or quoted atom";
Yap_ErrorMessage = "not enough heap space to read in string or quoted atom";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
return l;
@ -1024,7 +1052,8 @@ Yap_tokenizer(int inp_stream)
TokEntry *e = (TokEntry *) AllocScannerMemory(sizeof(TokEntry));
if (e == NULL) {
Yap_ErrorMessage = "Trail Overflow";
p->TokInfo = eot_tok;
Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}

436
C/stdpreds.c
View File

@ -11,8 +11,11 @@
* File: stdpreds.c *
* comments: General-purpose C implemented system predicates *
* *
* Last rev: $Date: 2005-11-22 11:25:59 $,$Author: tiagosoares $ *
* Last rev: $Date: 2005-12-17 03:25:39 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.97 2005/11/22 11:25:59 tiagosoares
* support for the MyDDAS interface library
*
* Revision 1.96 2005/10/28 17:38:49 vsc
* sveral updates
*
@ -162,12 +165,6 @@ static char SccsId[] = "%W% %G%";
#include <string.h>
#endif
#ifdef LOW_PROF
#include <signal.h>
#include <unistd.h>
#include <sys/time.h>
#endif
STD_PROTO(static Int p_setval, (void));
STD_PROTO(static Int p_value, (void));
STD_PROTO(static Int p_values, (void));
@ -302,420 +299,6 @@ Int show_time(void) /* MORE PRECISION */
#endif /* BEAM */
#ifdef LOW_PROF
#define TIMER_DEFAULT 100
#define MORE_INFO_FILE 1
#define PROFILING_FILE 1
#define PROFPREDS_FILE 2
static char *DIRNAME=NULL;
char *set_profile_dir(char *);
char *set_profile_dir(char *name){
int size=0;
if (name!=NULL) {
size=strlen(name)+1;
if (DIRNAME!=NULL) free(DIRNAME);
DIRNAME=malloc(size);
if (DIRNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); }
strcpy(DIRNAME,name);
}
if (DIRNAME==NULL) {
do {
if (DIRNAME!=NULL) free(DIRNAME);
size+=20;
DIRNAME=malloc(size);
if (DIRNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); }
} while (getcwd(DIRNAME, size-15)==NULL);
}
return DIRNAME;
}
char *profile_names(int);
char *profile_names(int k) {
static char *FNAME=NULL;
int size=200;
if (DIRNAME==NULL) set_profile_dir(NULL);
size=strlen(DIRNAME)+40;
if (FNAME!=NULL) free(FNAME);
FNAME=malloc(size);
if (FNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); }
strcpy(FNAME,DIRNAME);
if (k==PROFILING_FILE) {
sprintf(FNAME,"%s/PROFILING_%d",FNAME,getpid());
} else {
sprintf(FNAME,"%s/PROFPREDS_%d",FNAME,getpid());
}
// printf("%s\n",FNAME);
return FNAME;
}
void del_profile_files(void);
void del_profile_files() {
if (DIRNAME!=NULL) {
remove(profile_names(PROFPREDS_FILE));
remove(profile_names(PROFILING_FILE));
}
}
void
Yap_inform_profiler_of_clause(yamop *code_start, yamop *code_end, PredEntry *pe,int index_code) {
static Int order=0;
ProfPreds++;
if (FPreds != NULL) {
Int temp;
order++;
if (index_code) temp=-order; else temp=order;
fprintf(FPreds,"+%p %p %p %ld",code_start,code_end, pe, (long int)temp);
#if MORE_INFO_FILE
if (pe->FunctorOfPred->KindOfPE==47872) {
if (pe->ArityOfPE) {
fprintf(FPreds," %s/%d", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE);
} else {
fprintf(FPreds," %s",RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE);
}
}
#endif
fprintf(FPreds,"\n");
}
}
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 (repeated for each clause)*/
int ts; /* start end timestamp towards retracts, eventually */
} clauseentry;
static int
cl_cmp(const void *c1, const void *c2)
{
const clauseentry *cl1 = (const clauseentry *)c1;
const clauseentry *cl2 = (const clauseentry *)c2;
if (cl1->beg > cl2->beg) return 1;
if (cl1->beg < cl2->beg) return -1;
return 0;
}
static int
p_cmp(const void *c1, const void *c2)
{
const clauseentry *cl1 = (const clauseentry *)c1;
const clauseentry *cl2 = (const clauseentry *)c2;
if (cl1->pp > cl2->pp) return 1;
if (cl1->pp < cl2->pp) return -1;
/* else same pp, but they are always different on the ts */
if (cl1->ts > cl2->ts) return 1;
else return -1;
}
static clauseentry *
search_pc_pred(yamop *pc_ptr,clauseentry *beg, clauseentry *end) {
Int i, j, f, l;
f = 0; l = (end-beg);
i = l/2;
while (TRUE) {
if (beg[i].beg > pc_ptr) {
l = i-1;
if (l < f) {
return NULL;
}
j = i;
i = (f+l)/2;
} else if (beg[i].end < pc_ptr) {
f = i+1;
if (f > l) {
return NULL;
}
i = (f+l)/2;
} else if (beg[i].beg <= pc_ptr && beg[i].end >= pc_ptr) {
return (&beg[i]);
} else {
return NULL;
}
}
}
extern void Yap_InitAbsmi(void);
extern int rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit0);
static Int profend(void);
static int
showprofres(UInt type) {
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;
profend(); /* Make sure profiler has ended */
/* First part: Read information about predicates and store it on yap trail */
FPreds=fopen(profile_names(PROFPREDS_FILE),"r");
if (FPreds == NULL) { printf("Sorry, profiler couldn't find PROFPREDS file. \n"); 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;
pr++;
if (pr > (clauseentry *)Yap_TrailTop - 1024) {
Yap_growtrail(64 * 1024L, FALSE);
}
ProfPreds++;
do {
c=fgetc(FPreds);
} while(c!=EOF && c!='\n');
}
fclose(FPreds);
if (ProfPreds==0) return(TRUE);
qsort((void *)TR, ProfPreds, sizeof(clauseentry), cl_cmp);
/* Second part: Read Profiling to know how many times each predicate has been profiled */
FProf=fopen(profile_names(PROFILING_FILE),"r");
if (FProf==NULL) { printf("Sorry, profiler couldn't find PROFILING file. \n"); return FALSE; }
t2=NULL;
ProfCalls=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 (y->opc==Yap_opcode(_call_cpred) || y->opc==Yap_opcode(_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", Yap_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;
}
}
fclose(FProf);
if (ProfCalls==0) return(TRUE);
/*I have the counting by clauses, but we also need them by predicate */
qsort((void *)TR, ProfPreds, sizeof(clauseentry), p_cmp);
t = (clauseentry *)TR;
while (t < pr) {
UInt calls=t->pcs;
t2=t+1;
while(t2<pr && t2->pp==t->pp) {
calls+=t2->pcs;
t2++;
}
while(t<t2) {
t->pca=calls;
t++;
}
}
/* counting done: now it is time to present the results */
fflush(stdout);
/*
if (type>10) {
PredEntry *myp = (PredEntry *)type;
if (myp->FunctorOfPred->KindOfPE==47872) {
printf("Details on predicate:");
printf(" %s",RepAtom(AtomOfTerm(myp->ModuleOfPred))->StrOfAE);
printf(":%s",RepAtom(NameOfFunctor(myp->FunctorOfPred))->StrOfAE);
if (myp->ArityOfPE) printf("/%d\n",myp->ArityOfPE);
}
type=1;
}
*/
if (type==0 || type==1 || type==3) { /* Results by predicate */
t = (clauseentry *)TR;
while (t < pr) {
UInt calls=t->pca;
PredEntry *myp = t->pp;
if (calls && myp->FunctorOfPred->KindOfPE==47872) {
count+=calls;
printf("%p",myp);
printf(" %s",RepAtom(AtomOfTerm(myp->ModuleOfPred))->StrOfAE);
printf(":%s",RepAtom(NameOfFunctor(myp->FunctorOfPred))->StrOfAE);
if (myp->ArityOfPE) printf("/%d",myp->ArityOfPE);
printf(" -> %lu (%3.1f%c)\n",(unsigned long int)calls,(float) calls*100/ProfCalls,'%');
}
while (t<pr && t->pp == myp) t++;
}
} else { /* Results by clauses */
t = (clauseentry *)TR;
while (t < pr) {
if (t->pca!=0 && (t->ts>=0 || t->pcs!=0) && t->pp->FunctorOfPred->KindOfPE==47872) {
UInt calls=t->pcs;
if (t->ts<0) { /* join all index entries */
t2=t+1;
while(t2<pr && t2->pp==t->pp && t2->ts<0) {
t++;
calls+=t->pcs;
t2++;
}
printf("IDX");
} else {
printf(" ");
}
count+=calls;
// printf("%p %p",t->pp, t->beg);
printf(" %s",RepAtom(AtomOfTerm(t->pp->ModuleOfPred))->StrOfAE);
printf(":%s",RepAtom(NameOfFunctor(t->pp->FunctorOfPred))->StrOfAE);
if (t->pp->ArityOfPE) printf("/%d",t->pp->ArityOfPE);
printf(" -> %lu (%3.1f%c)\n",(unsigned long int)calls,(float) calls*100/ProfCalls,'%');
}
t++;
}
}
count=ProfCalls-(count+InGrowHeap+InGrowStack+InGC+InError+InUnify+InCCall); // Falta +InCCall
if (InGrowHeap>0) printf("%p sys: GrowHeap -> %lu (%3.1f%c)\n",(void *) GrowHeapMode,(unsigned long int)InGrowHeap,(float) InGrowHeap*100/ProfCalls,'%');
if (InGrowStack>0) printf("%p sys: GrowStack -> %lu (%3.1f%c)\n",(void *) GrowStackMode,(unsigned long int)InGrowStack,(float) InGrowStack*100/ProfCalls,'%');
if (InGC>0) printf("%p sys: GC -> %lu (%3.1f%c)\n",(void *) GCMode,(unsigned long int)InGC,(float) InGC*100/ProfCalls,'%');
if (InError>0) printf("%p sys: ErrorHandling -> %lu (%3.1f%c)\n",(void *) ErrorHandlingMode,(unsigned long int)InError,(float) InError*100/ProfCalls,'%');
if (InUnify>0) printf("%p sys: Unify -> %lu (%3.1f%c)\n",(void *) UnifyMode,(unsigned long int)InUnify,(float) InUnify*100/ProfCalls,'%');
if (InCCall>0) printf("%p sys: C Code -> %lu (%3.1f%c)\n",(void *) CCallMode,(unsigned long int)InCCall,(float) InCCall*100/ProfCalls,'%');
if (count>0) printf("Unknown:Unknown -> %lu (%3.1f%c)\n",(unsigned long int)count,(float) count*100/ProfCalls,'%');
printf("Total of Calls=%lu \n",(unsigned long int)ProfCalls);
return TRUE;
}
static Int profinit(void)
{
if (ProfilerOn!=0) return (FALSE);
FPreds=fopen(profile_names(PROFPREDS_FILE),"w+");
if (FPreds == NULL) return FALSE;
FProf=fopen(profile_names(PROFILING_FILE),"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) {
Term p;
p=Deref(ARG1);
if (IsLongIntTerm(p)) return(showprofres(LongIntOfTerm(p)));
else return(showprofres(IntOfTerm(p)));
}
static Int profres0(void) {
return(showprofres(0));
}
#endif /* LOW_PROF */
static Int
p_setval(void)
{ /* '$set_value'(+Atom,+Atomic) */
@ -3346,16 +2929,6 @@ Yap_InitCPreds(void)
Yap_InitCPred("$hidden", 1, p_hidden, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$has_yap_or", 0, p_has_yap_or, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$has_eam", 0, p_has_eam, SafePredFlag|SyncPredFlag|HiddenPredFlag);
#ifdef LOW_PROF
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
#ifndef YAPOR
Yap_InitCPred("$default_sequential", 1, p_default_sequential, SafePredFlag|SyncPredFlag|HiddenPredFlag);
#endif
@ -3409,6 +2982,7 @@ Yap_InitCPreds(void)
#endif
Yap_InitEval();
Yap_InitGrowPreds();
Yap_InitLowProf();
#if defined(YAPOR) || defined(TABLING)
Yap_init_optyap_preds();
#endif /* YAPOR || TABLING */

9
C/tracer.c
View File

@ -125,15 +125,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
sc = Yap_heap_regs;
vsc_count++;
{
Term WGs = Yap_ReadTimedVar(WokenGoals);
fprintf(stderr,"%d %p %lld: ",port, H, vsc_count);
Yap_DebugPlWrite(WGs);
Yap_DebugErrorPutc ('\n');
}
if (vsc_count < 100) {
return;
}
#ifdef COMMENTED
// if (vsc_count == 218280)
// vsc_xstop = 1;

2
CLPBN/clpbn.yap
View File

@ -74,7 +74,7 @@ clpbn_flag(solver,Before,After) :-
extract_dist(Dist, Table, Parents, Domain),
add_evidence(Var,El).
extract_dist(V, Tab.Inps, Domain) :- var(V), !,
extract_dist(V, Tab, Inps, Domain) :- var(V), !,
V = p(Domain, Tab, Inps).
extract_dist(p(Domain, trans(L), Parents), Tab, Inps, Domain) :- !,
compress_hmm_table(L, Parents, Tab, Inps).

10
CLPBN/clpbn/topsort.yap
View File

@ -1,7 +1,7 @@
:- module(topsort, [topsort/2,
topsort/3,
reversed_topsort/3]).
reversed_topsort/2]).
:- use_module(library(rbtrees),
[new/1,
@ -22,6 +22,14 @@ topsort(Graph0, Sorted0, Sorted) :-
new(RB),
topsort(Graph0, Sorted0, RB, Sorted).
%
% Have children first in the list
%
reversed_topsort(Graph0, RSorted) :-
new(RB),
topsort(Graph0, [], RB, Sorted),
reverse(Sorted, RSorted).
topsort([], Sort, _, Sort) :- !.
topsort(Graph0, Sort0, Found0, Sort) :-
add_nodes(Graph0, Found0, SortI, NewGraph, Found, Sort),

8
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.88 2005-12-07 17:53:30 vsc Exp $ *
* version: $Id: Heap.h,v 1.89 2005-12-17 03:25:39 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -448,11 +448,9 @@ typedef struct various_codes {
struct pred_entry *pred_throw;
struct pred_entry *pred_handle_throw;
struct DB_STRUCT *db_erased_marker;
#ifdef DEBUG
struct logic_upd_clause *db_erased_list;
struct logic_upd_index *db_erased_ilist;
UInt expand_clauses_sz;
#endif /* DEBUG */
struct stream_desc *yap_streams;
#ifdef DEBUG
int debugger_output_msg;
@ -462,6 +460,7 @@ typedef struct various_codes {
struct AliasDescS * file_aliases;
#if LOW_PROF
int profiler_on;
int offline_profiler;
FILE *f_prof, *f_preds;
UInt prof_preds;
#endif /* LOW_PROF */
@ -715,11 +714,9 @@ struct various_codes *Yap_heap_regs;
#define PredThrow Yap_heap_regs->pred_throw
#define PredHandleThrow Yap_heap_regs->pred_handle_throw
#define DBErasedMarker Yap_heap_regs->db_erased_marker
#ifdef DEBUG
#define DBErasedList Yap_heap_regs->db_erased_list
#define DBErasedIList Yap_heap_regs->db_erased_ilist
#define Yap_expand_clauses_sz Yap_heap_regs->expand_clauses_sz
#endif /* DEBUG */
#define Stream Yap_heap_regs->yap_streams
#define output_msg Yap_heap_regs->debugger_output_msg
#define NOfFileAliases Yap_heap_regs->n_of_file_aliases
@ -727,6 +724,7 @@ struct various_codes *Yap_heap_regs;
#define FileAliases Yap_heap_regs->file_aliases
#if LOW_PROF
#define ProfilerOn Yap_heap_regs->profiler_on
#define Yap_OffLineProfiler Yap_heap_regs->offline_profiler
#define FProf Yap_heap_regs->f_prof
#define FPreds Yap_heap_regs->f_preds
#define ProfPreds Yap_heap_regs->prof_preds

9
H/Yap.h
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h,v 1.9 2005-11-23 13:24:00 vsc Exp $ *
* version: $Id: Yap.h,v 1.10 2005-12-17 03:25:39 vsc Exp $ *
*************************************************************************/
#include "config.h"
@ -221,7 +221,7 @@ typedef long int YAP_LONG_LONG;
typedef unsigned long int YAP_ULONG_LONG;
#endif
#if HAVE_SIGPROF && __linux__
#if HAVE_SIGPROF && (defined(__linux__) || defined(__POWERPC__))
#define LOW_PROF 1
#endif
@ -642,7 +642,7 @@ typedef enum
if you place things in the lower addresses (power to the libc people).
*/
#if (defined(_AIX) || defined(_WIN32) || defined(__APPLE__) || defined(sparc) || defined(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(__linux__) || defined(IN_SECOND_QUADRANT) || defined(__CYGWIN__))
#if (defined(_AIX) || defined(_WIN32) || defined(__APPLE__) || defined(sparc) || defined(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(__POWERPC__) || defined(__linux__) || defined(IN_SECOND_QUADRANT) || defined(__CYGWIN__))
#define USE_LOW32_TAGS 1
#endif
@ -1154,7 +1154,8 @@ typedef enum
ErrorHandlingMode = 0x800, /* doing error handling */
CCallMode = 0x1000, /* In c Call */
UnifyMode = 0x2000, /* In Unify Code */
UserCCallMode = 0x4000 /* In User C-call Code */
UserCCallMode = 0x4000, /* In User C-call Code */
MallocMode = 0x8000 /* Doing malloc, realloc, free */
} prolog_exec_mode;
extern prolog_exec_mode Yap_PrologMode;

13
H/YapOpcodes.h
View File

@ -11,8 +11,11 @@
* File: YapOpcodes.h *
* comments: Central Table with all YAP opcodes *
* *
* Last rev: $Date: 2005-11-18 18:50:34 $ *
* Last rev: $Date: 2005-12-17 03:25:39 $ *
* $Log: not supported by cvs2svn $
* Revision 1.35 2005/11/18 18:50:34 tiagosoares
* support for executing c code when a cut occurs
*
* Revision 1.34 2005/09/08 21:55:48 rslopes
* BEAM for YAP update...
*
@ -67,11 +70,11 @@
* *
* *
*************************************************************************/
OPCODE(Ystop ,e),
OPCODE(Ystop ,l),
OPCODE(Nstop ,e),
OPCODE(execute ,l),
OPCODE(execute ,pp),
OPCODE(call ,sla),
OPCODE(procceed ,e),
OPCODE(procceed ,p),
OPCODE(allocate ,e),
OPCODE(deallocate ,e),
OPCODE(op_fail ,e),
@ -265,7 +268,7 @@
OPCODE(glist_valx ,ss), /* peephole */
OPCODE(glist_valy ,xy), /* peephole */
OPCODE(fcall ,sla),
OPCODE(dexecute ,l),
OPCODE(dexecute ,pp),
OPCODE(gl_void_varx ,xx), /* peephole */
OPCODE(gl_void_vary ,xy), /* peephole */
OPCODE(gl_void_valx ,xx), /* peephole */

13
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.65 2005-12-05 17:16:11 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.66 2005-12-17 03:25:39 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -156,6 +156,13 @@ Int STD_PROTO(Yap_execute_goal,(Term, int, Term));
int STD_PROTO(Yap_exec_absmi,(int));
void STD_PROTO(Yap_trust_last,(void));
/* gprof.c */
void STD_PROTO(Yap_InitLowProf,(void));
#if LOW_PROF
void STD_PROTO(Yap_inform_profiler_of_clause,(struct yami *,struct yami *,struct pred_entry *,int));
#else
#define Yap_inform_profiler_of_clause(A,B,C,D)
#endif
/* grow.c */
Int STD_PROTO(Yap_total_stack_shift_time,(void));
@ -340,7 +347,3 @@ void STD_PROTO(Yap_init_socks,(char *, long));
void STD_PROTO(Yap_init_optyap_preds,(void));
#if LOW_PROF
void STD_PROTO(Yap_dump_code_area_for_profiler,(void));
void STD_PROTO(Yap_inform_profiler_of_clause,(yamop *,yamop *, struct pred_entry *,int index_code));
#endif /* LOW_PROF */

2
H/Yatom.h
View File

@ -638,7 +638,7 @@ typedef enum
SwitchRootMask = 0x80000, /* informs this is the root for the index tree */
SwitchTableMask = 0x40000, /* informs this is a switch table */
HasBlobsMask = 0x20000, /* informs this has blobs which may be in use */
GcFoundMask = 0x10000, /* informs this is a dynamic predicate */
ProfFoundMask = 0x10000, /* informs this clause is being counted by profiler */
DynamicMask = 0x8000, /* informs this is a dynamic predicate */
InUseMask = 0x4000, /* informs this block is being used */
ErasedMask = 0x2000, /* informs this block has been erased */

2
H/absmi.h
View File

@ -60,7 +60,7 @@ static char SccsId[] = "%W% %G%";
#define USE_PREFETCH 1
#endif
#ifdef _POWER
#if defined(_POWER)
#define SHADOW_P 1
#define SHADOW_REGS 1
#define USE_PREFETCH 1

12
H/amidefs.h
View File

@ -11,8 +11,11 @@
* File: amidefs.h *
* comments: Abstract machine peculiarities *
* *
* Last rev: $Date: 2005-07-06 15:10:15 $ *
* Last rev: $Date: 2005-12-17 03:25:39 $ *
* $Log: not supported by cvs2svn $
* Revision 1.29 2005/07/06 15:10:15 vsc
* improvements to compiler: merged instructions and fixes for ->
*
* Revision 1.28 2005/05/30 06:07:35 vsc
* changes to support more tagging schemes from tabulation.
*
@ -220,7 +223,7 @@ typedef struct yami {
Int ClTrail;
Int ClENV;
Int ClRefs;
struct yami *ClBase;
struct logic_upd_clause *ClBase;
CELL next;
} EC;
struct {
@ -422,6 +425,11 @@ typedef struct yami {
struct pred_entry *p;
CELL next;
} p;
struct {
struct pred_entry *p;
struct pred_entry *p0;
CELL next;
} pp;
struct {
COUNT s;
CELL next;

16
H/clause.h
View File

@ -47,14 +47,12 @@ typedef struct logic_upd_index {
lockvar ClLock;
#endif
UInt ClSize;
union {
PredEntry *pred;
struct logic_upd_index *ParentIndex;
} u;
struct logic_upd_index *ParentIndex;
struct logic_upd_index *SiblingIndex;
struct logic_upd_index *PrevSiblingIndex;
struct logic_upd_index *ChildIndex;
/* The instructions, at least one of the form sl */
PredEntry *ClPred;
yamop ClCode[MIN_ARRAY];
} LogUpdIndex;
@ -105,6 +103,7 @@ typedef struct static_index {
struct static_index *SiblingIndex;
struct static_index *ChildIndex;
/* The instructions, at least one of the form sl */
PredEntry *ClPred;
yamop ClCode[MIN_ARRAY];
} StaticIndex;
@ -309,6 +308,7 @@ typedef enum {
} find_pred_type;
Int STD_PROTO(Yap_PredForCode,(yamop *, find_pred_type, Atom *, UInt *, Term *));
PredEntry *STD_PROTO(Yap_PredEntryForCode,(yamop *, find_pred_type, CODEADDR *, CODEADDR *));
LogUpdClause *STD_PROTO(Yap_new_ludbe,(Term, PredEntry *, UInt));
Term STD_PROTO(Yap_LUInstance,(LogUpdClause *, UInt));
@ -316,5 +316,9 @@ Term STD_PROTO(Yap_LUInstance,(LogUpdClause *, UInt));
void STD_PROTO(Yap_bug_location,(yamop *));
#endif
#if LOW_PROF
void STD_PROTO(Yap_InformOfRemoval,(CODEADDR));
void STD_PROTO(Yap_dump_code_area_for_profiler,(void));
#else
#define Yap_InformOfRemoval(X)
#endif

2
H/iopreds.h
View File

@ -47,7 +47,7 @@ typedef struct stream_desc
struct {
char *buf; /* where the file is being read from/written to */
Int max_size; /* maximum buffer size (may be changed dynamically) */
Int pos;
UInt pos;
volatile void *error_handler;
} mem_string;
struct {

18
H/rclause.h
View File

@ -12,8 +12,11 @@
* File: rclause.h *
* comments: walk through a clause *
* *
* Last rev: $Date: 2005-11-24 15:35:29 $,$Author: tiagosoares $ *
* Last rev: $Date: 2005-12-17 03:25:39 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.13 2005/11/24 15:35:29 tiagosoares
* removed some compilation warnings related to the cut-c code
*
* Revision 1.12 2005/09/19 19:14:50 vsc
* fix two instructions that were being read badly: op_fail and
* switch_list_nl.
@ -114,6 +117,7 @@ restore_opcodes(yamop *pc)
#ifdef DEBUG_RESTORE2
fprintf(stderr, "OK\n");
#endif
pc->u.l.l = PtoOpAdjust(pc->u.l.l);
return;
/* instructions type ld */
case _try_me:
@ -169,12 +173,17 @@ restore_opcodes(yamop *pc)
case _lock_lu:
case _count_call:
case _count_retry:
case _execute:
case _procceed:
pc->u.p.p = PtoPredAdjust(pc->u.p.p);
pc = NEXTOP(pc,p);
break;
case _trust_logical_pred:
case _execute:
case _dexecute:
pc->u.pp.p = PtoPredAdjust(pc->u.pp.p);
pc->u.pp.p0 = PtoPredAdjust(pc->u.pp.p0);
pc = NEXTOP(pc,pp);
break;
case _trust_logical_pred:
case _jump:
case _move_back:
case _skip:
@ -200,7 +209,7 @@ restore_opcodes(yamop *pc)
break;
/* instructions type EC */
case _alloc_for_logical_pred:
pc->u.EC.ClBase = PtoOpAdjust(pc->u.EC.ClBase);
pc->u.EC.ClBase = (struct logic_upd_clause *)PtoOpAdjust((yamop *)pc->u.EC.ClBase);
pc = NEXTOP(pc,EC);
break;
/* instructions type e */
@ -213,7 +222,6 @@ restore_opcodes(yamop *pc)
case _cut:
case _cut_t:
case _cut_e:
case _procceed:
case _allocate:
case _deallocate:
case _write_void:

17
H/rheap.h
View File

@ -11,8 +11,14 @@
* File: rheap.h *
* comments: walk through heap code *
* *
* Last rev: $Date: 2005-12-05 17:16:11 $,$Author: vsc $ *
* Last rev: $Date: 2005-12-17 03:25:39 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.59 2005/12/05 17:16:11 vsc
* write_depth/3
* overflow handlings and garbage collection
* Several ipdates to CLPBN
* dif/2 could be broken in the presence of attributed variables.
*
* Revision 1.58 2005/11/23 03:01:33 vsc
* fix several bugs in save/restore.b
*
@ -754,11 +760,9 @@ CleanLUIndex(LogUpdIndex *idx)
{
idx->ClRefCount = 0;
INIT_LOCK(idx->ClLock);
if (idx->ClFlags & SwitchRootMask) {
idx->u.pred = PtoPredAdjust(idx->u.pred);
} else {
idx->u.ParentIndex = LUIndexAdjust(idx->u.ParentIndex);
}
idx->ClPred = PtoPredAdjust(idx->ClPred);
if (idx->ParentIndex)
idx->ParentIndex = LUIndexAdjust(idx->ParentIndex);
if (idx->SiblingIndex) {
idx->SiblingIndex = LUIndexAdjust(idx->SiblingIndex);
CleanLUIndex(idx->SiblingIndex);
@ -775,6 +779,7 @@ CleanLUIndex(LogUpdIndex *idx)
static void
CleanSIndex(StaticIndex *idx)
{
idx->ClPred = PtoPredAdjust(idx->ClPred);
if (idx->SiblingIndex) {
idx->SiblingIndex = SIndexAdjust(idx->SiblingIndex);
CleanSIndex(idx->SiblingIndex);

14
Makefile.in
View File

@ -138,7 +138,8 @@ C_SOURCES= \
$(srcdir)/C/compiler.c $(srcdir)/C/computils.c \
$(srcdir)/C/corout.c $(srcdir)/C/dbase.c $(srcdir)/C/dlmalloc.c \
$(srcdir)/C/errors.c \
$(srcdir)/C/eval.c $(srcdir)/C/exec.c $(srcdir)/C/grow.c \
$(srcdir)/C/eval.c $(srcdir)/C/exec.c \
$(srcdir)/C/gprof.c $(srcdir)/C/grow.c \
$(srcdir)/C/heapgc.c $(srcdir)/C/index.c \
$(srcdir)/C/init.c $(srcdir)/C/inlines.c \
$(srcdir)/C/iopreds.c $(srcdir)/C/depth_bound.c \
@ -197,10 +198,12 @@ YAPDOCS=$(srcdir)/docs/yap.tex $(srcdir)/docs/chr.tex \
ENGINE_OBJECTS = \
agc.o absmi.o adtdefs.o alloc.o amasm.o analyst.o arrays.o \
arith0.o arith1.o arith2.o attvar.o bb.o \
arith0.o arith1.o arith2.o attvar.o \
bignum.o bb.o \
cdmgr.o cmppreds.o compiler.o computils.o \
corout.o cut_c.o dbase.o dlmalloc.o errors.o eval.o bignum.o \
exec.o grow.o heapgc.o index.o init.o inlines.o \
corout.o cut_c.o dbase.o dlmalloc.o errors.o eval.o \
exec.o gprof.o grow.o \
heapgc.o index.o init.o inlines.o \
iopreds.o depth_bound.o mavar.o \
myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_test_predicates.o \
myddas_util.o modules.o other.o \
@ -313,6 +316,9 @@ exec.o: $(srcdir)/C/exec.c
grow.o: $(srcdir)/C/grow.c
$(CC) -c $(CFLAGS) $(srcdir)/C/grow.c -o $@
gprof.o: $(srcdir)/C/gprof.c
$(CC) -c $(CFLAGS) $(srcdir)/C/gprof.c -o $@
heapgc.o: $(srcdir)/C/heapgc.c
$(CC) -c $(CFLAGS) $(srcdir)/C/heapgc.c -o $@

10
changes-5.1.html
View File

@ -16,6 +16,16 @@
<h2>Yap-5.1.0:</h2>
<ul>
<li> NEW: tabling does not conflit with depth limit (Trevor Walker). </li>
<li> NEW: make scanner restartable on seekable files (Nuno Fonseca). </li>
<li> NEW: improve error discovery within scanner (Jude Shavlik). </li>
<li> NEW: change event profiler to do profiling online and
off-line. </li>
<li> NEW: routine to find clause/pred </li>
<li> NEW: always end clauses with Ystop START, so that we can refer
back to the clause's beginning. </li>
<li> NEW: always have a pointer to Pred in clauses, so that we can
find current predicate. </li>
<li> NEW: heapgc should now be concurrent when using threads. </li>
<li> FIXED: heapgc wo tags can handle trail overflows right. </li>
<li> NEW: heapgc wo tags does not write on the collected areas during marking. </li>

1
config.h.in
View File

@ -151,6 +151,7 @@
#undef HAVE_DUP2
#undef HAVE_FESETTRAPENABLE
#undef HAVE_FETESTEXCEPT
#undef HAVE_FGETPOS
#undef HAVE_FINITE
#undef HAVE_GETCWD
#undef HAVE_GETENV

20
configure.in
View File

@ -1,4 +1,4 @@
Mdnl
vMdnl
dnl Process this file with autoconf to produce a configure script.
dnl
@ -189,22 +189,6 @@ then
AC_DEFINE(MinHeapSpace, (400*SIZEOF_INT_P))
AC_DEFINE(MinStackSpace,(300*SIZEOF_INT_P))
AC_DEFINE(MinTrailSpace,( 48*SIZEOF_INT_P))
if test "$depthlimit" = yes -a "$tabling" = yes
then
echo
echo
echo "********************************************************"
echo
echo
echo "!!!!!! WARNING !!!!!!"
echo "Depth Limit makes no sense with Tabling"
echo "Please contact ricroc@ncc.up.pt for help"
echo
echo
echo "********************************************************"
echo
echo
fi
else
AC_DEFINE(MinHeapSpace, (200*SIZEOF_INT_P))
AC_DEFINE(MinStackSpace,(200*SIZEOF_INT_P))
@ -1001,7 +985,7 @@ fi
dnl Checks for library functions.
AC_TYPE_SIGNAL
AC_CHECK_FUNCS(acosh asinh atanh chdir ctime dlopen dup2)
AC_CHECK_FUNCS(fesettrapenable finite getcwd getenv)
AC_CHECK_FUNCS(fesettrapenable fgetpos finite getcwd getenv)
AC_CHECK_FUNCS(gethostbyname gethostid gethostname)
AC_CHECK_FUNCS(gethrtime getpwnam getrusage gettimeofday getwd)
AC_CHECK_FUNCS(isatty isnan kill labs link lgamma)

69
pl/profile.yap
View File

@ -58,3 +58,72 @@ profile_reset :-
fail.
profile_reset.
showprofres(A) :-
'$proftype'(offline),
'$offline_showprofres'(A).
showprofres(_) :- fail.
showprofres :-
'$proftype'(offline),
'$offline_showprofres'.
showprofres :-
'$profglobs'(Tot,GCs,HGrows,SGrows,Mallocs),
% root node has no useful info.
'$get_all_profinfo'(0,[],ProfInfo0),
sort(ProfInfo0,ProfInfo),
'$get_ppreds'(ProfInfo,Preds0),
'$add_extras_prof'(GCs, HGrows, SGrows, Mallocs, Preds0, PredsI),
keysort(PredsI,Preds),
'$sum_alls'(Preds,0,Tot0),
Accounted is -Tot0,
format(user_error,'~d ticks, ~d accounted for~n',[Tot,Accounted]),
'$display_preds'(Preds, Tot, 0, 1).
'$get_all_profinfo'([],L,L) :- !.
'$get_all_profinfo'(Node,L0,Lf) :-
'$profnode'(Node,Clause,PredId,Count,Left,Right),
'$get_all_profinfo'(Left,L0,Li),
'$get_all_profinfo'(Right,[gprof(PredId,Clause,Count)|Li],Lf).
'$get_ppreds'([],[]).
'$get_ppreds'([gprof(0,_,0)|Cls],Ps) :- !,
'$get_ppreds'(Cls,Ps).
'$get_ppreds'([gprof(0,_,Count)|Cls],Ps) :- !,
'$do_error'(system_error,showprofres(gprof(0,_,Count))).
'$get_ppreds'([gprof(PProfInfo,_,Count0)|Cls],[Sum-(Mod:Name/Arity)|Ps]) :-
'$get_more_ppreds'(Cls,PProfInfo,Count0,NCls,Sum),
'$get_pred_pinfo'(PProfInfo,Mod,Name,Arity),
'$get_ppreds'(NCls,Ps).
'$get_more_ppreds'([gprof(PProfInfo,_,Count)|Cls],PProfInfo,Count0,NCls,Sum)
:- !,
Count1 is Count+Count0,
'$get_more_ppreds'(Cls,PProfInfo,Count1,NCls,Sum).
'$get_more_ppreds'(Cls, _, Sum, Cls, NSum) :- NSum is -Sum.
'$display_preds'([], _, _, _).
'$display_preds'([NSum-P|Ps], Tot, SoFar, I) :-
Sum is -NSum,
Perc is (100*Sum)/Tot,
Next is SoFar+Sum,
NextP is (100*Next)/Tot,
format(user_error,'~|~t~d.~7+ ~|~w:~t~d~50+ (~|~t~2f~6+%) |~|~t~2f~6+%|~n',[I,P,Sum,Perc,NextP]),
I1 is I+1,
'$display_preds'(Ps,Tot,Next,I1).
'$sum_alls'([],Tot,Tot).
'$sum_alls'([C-_|Preds],Tot0,Tot) :-
TotI is C+Tot0,
'$sum_alls'(Preds,TotI,Tot).
'$add_extras_prof'(GCs, HGrows, SGrows, Mallocs, Preds0, PredsI) :-
'$add_extra_prof'(GCs, 'Garbage Collections',Preds0,Preds1),
'$add_extra_prof'(HGrows, 'Code Expansion',Preds1,Preds2),
'$add_extra_prof'(SGrows, 'Stack Expansion',Preds2,Preds3),
'$add_extra_prof'(Mallocs, 'Heap Allocation',Preds3,PredsI).
'$add_extra_prof'(0, _,Preds, Preds) :- !.
'$add_extra_prof'(Ticks, Name, Preds, [NTicks-Name|Preds]) :-
NTicks is -Ticks.