diff --git a/C/absmi.c b/C/absmi.c index 3d155242a..4703e2d10 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -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 -#include -#include - -#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); diff --git a/C/adtdefs.c b/C/adtdefs.c index 1ac15bd89..8495cc65b 100644 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -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; } diff --git a/C/alloc.c b/C/alloc.c index e94a2d5e1..164965d3f 100644 --- a/C/alloc.c +++ b/C/alloc.c @@ -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; diff --git a/C/amasm.c b/C/amasm.c index 66d0c9457..ae0ca6bec 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -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); diff --git a/C/cdmgr.c b/C/cdmgr.c index db5af59f2..728ecee74 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -11,8 +11,11 @@ * File: cdmgr.c * * comments: Code manager * * * -* Last rev: $Date: 2005-11-23 03:01:33 $,$Author: vsc $ * +* Last rev: $Date: 2005-12-17 03:25:39 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.172 2005/11/23 03:01:33 vsc +* fix several bugs in save/restore.b +* * Revision 1.171 2005/10/29 01:28:37 vsc * make undefined more ISO compatible. * @@ -515,9 +518,9 @@ Yap_BuildMegaClause(PredEntry *ap) if (has_blobs) { sz -= sizeof(StaticClause); } else { - sz -= (UInt)NEXTOP((yamop *)NULL,e) + sizeof(StaticClause); + sz -= (UInt)NEXTOP((yamop *)NULL,p) + sizeof(StaticClause); } - required = sz*ap->cs.p_code.NOfClauses+sizeof(MegaClause)+(UInt)NEXTOP((yamop *)NULL,e); + required = sz*ap->cs.p_code.NOfClauses+sizeof(MegaClause)+(UInt)NEXTOP((yamop *)NULL,l); while (!(mcl = (MegaClause *)Yap_AllocCodeSpace(required))) { if (!Yap_growheap(FALSE, sizeof(consult_obj)*ConsultCapacity, NULL)) { /* just fail, the system will keep on going */ @@ -544,6 +547,7 @@ Yap_BuildMegaClause(PredEntry *ap) cl = cl->ClNext; } ptr->opc = Yap_opcode(_Ystop); + ptr->u.l.l = mcl->ClCode; cl = ClauseCodeToStaticClause(ap->cs.p_code.FirstClause); /* recover the space spent on the original clauses */ @@ -551,6 +555,8 @@ Yap_BuildMegaClause(PredEntry *ap) StaticClause *ncl; ncl = cl->ClNext; + if (cl->ClFlags & ProfFoundMask) + Yap_InformOfRemoval((CODEADDR)cl); Yap_FreeCodeSpace((ADDR)cl); if (cl->ClCode == ap->cs.p_code.LastClause) break; @@ -582,6 +588,8 @@ split_megaclause(PredEntry *ap) while (start) { StaticClause *cl = start; start = cl->ClNext; + if (cl->ClFlags & ProfFoundMask) + Yap_InformOfRemoval((CODEADDR)cl); Yap_FreeCodeSpace((char *)cl); start = NULL; } @@ -936,6 +944,8 @@ kill_static_child_indxs(StaticIndex *indx) kill_static_child_indxs(cl); cl = next; } + if (indx->ClFlags & ProfFoundMask) + Yap_InformOfRemoval((CODEADDR)indx); Yap_FreeCodeSpace((char *)indx); } @@ -957,14 +967,13 @@ kill_off_lu_block(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap) kill_off_lu_block(parent, NULL, ap); } else { UNLOCK(parent->ClLock); - kill_off_lu_block(parent, parent->u.ParentIndex, ap); + kill_off_lu_block(parent, parent->ParentIndex, ap); } } else { UNLOCK(parent->ClLock); } } UNLOCK(c->ClLock); -#ifdef DEBUG { LogUpdIndex *parent = DBErasedIList, *c0 = NULL; while (parent != NULL) { @@ -977,7 +986,8 @@ kill_off_lu_block(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap) parent = parent->SiblingIndex; } } -#endif + if (c->ClFlags & ProfFoundMask) + Yap_InformOfRemoval((CODEADDR)c); Yap_FreeCodeSpace((char *)c); } @@ -1035,18 +1045,16 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap) parent->ClFlags & SwitchTableMask) { LOCK(parent->ClLock); - c->u.ParentIndex = parent->u.ParentIndex; + c->ParentIndex = parent->ParentIndex; LOCK(parent->u.ParentIndex->ClLock); - parent->u.ParentIndex->ClRefCount++; + parent->ParentIndex->ClRefCount++; UNLOCK(parent->u.ParentIndex->ClLock); parent->ClRefCount--; UNLOCK(parent->ClLock); } - c->ChildIndex = NULL; -#ifdef DEBUG + c->ChildIndex = (LogUpdIndex *)ap; c->SiblingIndex = DBErasedIList; DBErasedIList = c; -#endif UNLOCK(c->ClLock); } @@ -1133,33 +1141,29 @@ Yap_ErLogUpdIndex(LogUpdIndex *clau, yamop *ipc) if (clau->ClFlags & ErasedMask) { if (!c->ClRefCount) { if (c->ClFlags & SwitchRootMask) { - kill_off_lu_block(clau, NULL, c->u.pred); + kill_off_lu_block(clau, NULL, c->ClPred); } else { - while (!(c->ClFlags & SwitchRootMask)) - c = c->u.ParentIndex; - kill_off_lu_block(clau, clau->u.ParentIndex, c->u.pred); + kill_off_lu_block(clau, clau->ParentIndex, clau->ClPred); } } /* otherwise, nothing I can do, I have been erased already */ return codep; } if (c->ClFlags & SwitchRootMask) { - kill_first_log_iblock(clau, NULL, c->u.pred); + kill_first_log_iblock(clau, NULL, c->ClPred); } else { - while (!(c->ClFlags & SwitchRootMask)) - c = c->u.ParentIndex; #if defined(THREADS) || defined(YAPOR) LOCK(clau->u.ParentIndex->ClLock); /* protect against attempts at erasing */ clau->ClRefCount++; UNLOCK(clau->u.ParentIndex->ClLock); #endif - kill_first_log_iblock(clau, clau->u.ParentIndex, c->u.pred); + kill_first_log_iblock(clau, clau->ParentIndex, clau->ClPred); #if defined(THREADS) || defined(YAPOR) - LOCK(clau->u.ParentIndex->ClLock); + LOCK(clau->ParentIndex->ClLock); /* protect against attempts at erasing */ clau->ClRefCount--; - UNLOCK(clau->u.ParentIndex->ClLock); + UNLOCK(clau->ParentIndex->ClLock); #endif } return codep; @@ -1229,6 +1233,8 @@ retract_all(PredEntry *p, int in_use) dcl->ClSize = sz; DeadClauses = dcl; } else { + if (cl->ClFlags & ProfFoundMask) + Yap_InformOfRemoval((CODEADDR)cl); Yap_FreeCodeSpace((char *)cl); } p->cs.p_code.NOfClauses = 0; @@ -1244,6 +1250,8 @@ retract_all(PredEntry *p, int in_use) dcl->ClSize = sz; DeadClauses = dcl; } else { + if (cl->ClFlags & ProfFoundMask) + Yap_InformOfRemoval((CODEADDR)cl); Yap_FreeCodeSpace((char *)cl); } p->cs.p_code.NOfClauses--; @@ -1362,7 +1370,7 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag) /* allocate starter block, containing info needed to start execution, * that is a try_mark to start the code and a fail to finish things up */ cl = - (DynamicClause *) Yap_AllocCodeSpace((Int)NEXTOP(NEXTOP(NEXTOP(ncp,ld),e),e)); + (DynamicClause *) Yap_AllocCodeSpace((Int)NEXTOP(NEXTOP(NEXTOP(ncp,ld),e),l)); if (cl == NIL) { Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"Heap crashed against Stacks"); return; @@ -1419,6 +1427,7 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag) /* and close the code */ ncp = NEXTOP(ncp,e); ncp->opc = Yap_opcode(_Ystop); + ncp->u.l.l = cl->ClCode; } /* p is already locked */ @@ -1964,6 +1973,8 @@ Yap_EraseStaticClause(StaticClause *cl, Term mod) { dcl->ClSize = sz; DeadClauses = dcl; } else { + if (cl->ClFlags & ProfFoundMask) + Yap_InformOfRemoval((CODEADDR)cl); Yap_FreeCodeSpace((char *)cl); } if (ap->cs.p_code.NOfClauses == 0) { @@ -3294,14 +3305,16 @@ code_in_pred_info(PredEntry *pp, Atom *pat, UInt *parity) { } static int -code_in_pred_lu_index(LogUpdIndex *icl, yamop *codeptr) { +code_in_pred_lu_index(LogUpdIndex *icl, yamop *codeptr, CODEADDR *startp, CODEADDR *endp) { LogUpdIndex *cicl; if (IN_BLOCK(codeptr,icl,icl->ClSize)) { + if (startp) *startp = (CODEADDR)icl; + if (endp) *endp = (CODEADDR)icl+icl->ClSize; return TRUE; } cicl = icl->ChildIndex; while (cicl != NULL) { - if (code_in_pred_lu_index(cicl, codeptr)) + if (code_in_pred_lu_index(cicl, codeptr, startp, endp)) return TRUE; cicl = cicl->SiblingIndex; } @@ -3309,14 +3322,16 @@ code_in_pred_lu_index(LogUpdIndex *icl, yamop *codeptr) { } static int -code_in_pred_s_index(StaticIndex *icl, yamop *codeptr) { +code_in_pred_s_index(StaticIndex *icl, yamop *codeptr, CODEADDR *startp, CODEADDR *endp) { StaticIndex *cicl; if (IN_BLOCK(codeptr,icl,icl->ClSize)) { + if (startp) *startp = (CODEADDR)icl; + if (endp) *endp = (CODEADDR)icl+icl->ClSize; return TRUE; } cicl = icl->ChildIndex; while (cicl != NULL) { - if (code_in_pred_s_index(cicl, codeptr)) + if (code_in_pred_s_index(cicl, codeptr, startp, endp)) return TRUE; cicl = cicl->SiblingIndex; } @@ -3324,7 +3339,7 @@ code_in_pred_s_index(StaticIndex *icl, yamop *codeptr) { } static Int -find_code_in_clause(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) { +find_code_in_clause(PredEntry *pp, yamop *codeptr, CODEADDR *startp, CODEADDR *endp) { Int i = 1; yamop *clcode; @@ -3334,7 +3349,10 @@ find_code_in_clause(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) { LogUpdClause *cl = ClauseCodeToLogUpdClause(clcode); do { if (IN_BLOCK(codeptr,(CODEADDR)cl,cl->ClSize)) { - clause_was_found(pp, pat, parity); + if (startp) + *startp = (CODEADDR)cl; + if (endp) + *endp = (CODEADDR)cl+cl->ClSize; return i; } i++; @@ -3346,7 +3364,10 @@ find_code_in_clause(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) { cl = ClauseCodeToDynamicClause(clcode); if (IN_BLOCK(codeptr,cl,cl->ClSize)) { - clause_was_found(pp, pat, parity); + if (startp) + *startp = (CODEADDR)cl; + if (endp) + *endp = (CODEADDR)cl+cl->ClSize; return i; } if (clcode == pp->cs.p_code.LastClause) @@ -3359,7 +3380,10 @@ find_code_in_clause(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) { cl = ClauseCodeToMegaClause(clcode); if (IN_BLOCK(codeptr,cl,cl->ClSize)) { - clause_was_found(pp, pat, parity); + if (startp) + *startp = (CODEADDR)cl; + if (endp) + *endp = (CODEADDR)cl+cl->ClSize; return 1+((char *)codeptr-(char *)cl->ClCode)/cl->ClItemSize; } } else { @@ -3368,7 +3392,10 @@ find_code_in_clause(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) { cl = ClauseCodeToStaticClause(clcode); do { if (IN_BLOCK(codeptr,cl,cl->ClSize)) { - clause_was_found(pp, pat, parity); + if (startp) + *startp = (CODEADDR)cl; + if (endp) + *endp = (CODEADDR)cl+cl->ClSize; return i; } if (cl->ClCode == pp->cs.p_code.LastClause) @@ -3381,6 +3408,44 @@ find_code_in_clause(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) { return(0); } +static int +cl_code_in_pred(PredEntry *pp, yamop *codeptr, CODEADDR *startp, CODEADDR *endp) { + Int out; + + READ_LOCK(pp->PRWLock); + /* check if the codeptr comes from the indexing code */ + if (pp->PredFlags & IndexedPredFlag) { + if (pp->PredFlags & LogUpdatePredFlag) { + if (code_in_pred_lu_index(ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, startp, endp)) { + READ_UNLOCK(pp->PRWLock); + return TRUE; + } + } else { + if (code_in_pred_s_index(ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, startp, endp)) { + READ_UNLOCK(pp->PRWLock); + return TRUE; + } + } + } + if (pp->PredFlags & (CPredFlag|AsmPredFlag|UserCPredFlag)) { + StaticClause *cl = ClauseCodeToStaticClause(pp->CodeOfPred); + if (IN_BLOCK(codeptr,(CODEADDR)cl,cl->ClSize)) { + if (startp) + *startp = (CODEADDR)cl; + if (endp) + *endp = (CODEADDR)cl+cl->ClSize; + return TRUE; + } else { + return FALSE; + } + } else { + out = find_code_in_clause(pp, codeptr, startp, endp); + } + READ_UNLOCK(pp->PRWLock); + if (out) return TRUE; + return FALSE; +} + static Int code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) { Int out; @@ -3389,20 +3454,22 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) { /* check if the codeptr comes from the indexing code */ if (pp->PredFlags & IndexedPredFlag) { if (pp->PredFlags & LogUpdatePredFlag) { - if (code_in_pred_lu_index(ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr)) { + if (code_in_pred_lu_index(ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, NULL, NULL)) { code_in_pred_info(pp, pat, parity); READ_UNLOCK(pp->PRWLock); return -1; } } else { - if (code_in_pred_s_index(ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr)) { + if (code_in_pred_s_index(ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, NULL, NULL)) { code_in_pred_info(pp, pat, parity); READ_UNLOCK(pp->PRWLock); return -1; } } } - out = find_code_in_clause(pp, pat, parity, codeptr); + if ((out = find_code_in_clause(pp, codeptr, NULL, NULL))) { + clause_was_found(pp, pat, parity); + } READ_UNLOCK(pp->PRWLock); return out; } @@ -3440,11 +3507,14 @@ Yap_PredForCode(yamop *codeptr, find_pred_type where_from, Atom *pat, UInt *pari } else if (where_from == FIND_PRED_FROM_ENV) { p = EnvPreg(codeptr); if (p) { + Int out; if (p->ModuleOfPred == PROLOG_MODULE) *pmodule = ModuleName[0]; else *pmodule = p->ModuleOfPred; - return find_code_in_clause(p, pat, parity, codeptr); + out = find_code_in_clause(p, codeptr, NULL, NULL); + clause_was_found(p, pat, parity); + return out; } } else { return PredForCode(codeptr, pat, parity, pmodule); @@ -3460,6 +3530,700 @@ Yap_PredForCode(yamop *codeptr, find_pred_type where_from, Atom *pat, UInt *pari return -1; } +static PredEntry * +ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) { + yamop *pc; + PredEntry *pp = NULL; + int clause_code = FALSE; + + if (codeptr >= COMMA_CODE && + codeptr < FAILCODE) { + pp = RepPredProp(Yap_GetPredPropByFunc(FunctorComma,CurrentModule)); + *startp = (CODEADDR)COMMA_CODE; + *endp = (CODEADDR)(FAILCODE-1); + return pp; + } + pc = codeptr; + while (TRUE) { + op_numbers op; + + op = Yap_op_from_opcode(pc->opc); + /* C-code, maybe indexing */ + switch (op) { + case _Nstop: + return NULL; + case _Ystop: + if (!pp) { + /* must be an index */ + PredEntry **pep = (PredEntry **)pc->u.l.l; + pp = pep[-1]; + } + if (pp->PredFlags & LogUpdatePredFlag) { + if (clause_code) { + LogUpdClause *cl = ClauseCodeToLogUpdClause(pc->u.l.l); + *startp = (CODEADDR)cl; + *endp = (CODEADDR)cl+cl->ClSize; + } else { + LogUpdIndex *cl = ClauseCodeToLogUpdIndex(pc->u.l.l); + *startp = (CODEADDR)cl; + *endp = (CODEADDR)cl+cl->ClSize; + } + } else if (pp->PredFlags & DynamicPredFlag) { + DynamicClause *cl = ClauseCodeToDynamicClause(pc->u.l.l); + *startp = (CODEADDR)cl; + *endp = (CODEADDR)cl+cl->ClSize; + } else { + if (clause_code) { + StaticClause *cl = ClauseCodeToStaticClause(pc->u.l.l); + *startp = (CODEADDR)cl; + *endp = (CODEADDR)cl+cl->ClSize; + } else { + StaticIndex *cl = ClauseCodeToStaticIndex(pc->u.l.l); + *startp = (CODEADDR)cl; + *endp = (CODEADDR)cl+cl->ClSize; + } + } + return pp; + /* instructions type ld */ + case _try_me: + case _retry_me: + case _trust_me: + case _profiled_retry_me: + case _profiled_trust_me: + case _count_retry_me: + case _count_trust_me: + case _spy_or_trymark: + case _try_and_mark: + case _profiled_retry_and_mark: + case _count_retry_and_mark: + case _retry_and_mark: + case _try_clause: + case _retry: + case _trust: +#ifdef YAPOR + case _getwork: + case _getwork_seq: + case _sync: +#endif +#ifdef TABLING + case _table_load_answer: + case _table_try_answer: + case _table_try_single: + case _table_try_me: + case _table_retry_me: + case _table_trust_me: + case _table_try: + case _table_retry: + case _table_trust: + case _table_answer_resolution: + case _table_completion: +#endif /* TABLING */ + pp = pc->u.ld.p; + pc = NEXTOP(pc,ld); + break; + case _enter_lu_pred: + case _stale_lu_index: + { + LogUpdIndex *icl = ClauseCodeToLogUpdIndex(pc); + *startp = (CODEADDR)icl; + *endp = (CODEADDR)icl+icl->ClSize; + return icl->ClPred; + } + break; + /* instructions type p */ + case _count_call: + case _count_retry: + case _enter_profiling: + case _retry_profiled: + pc = NEXTOP(pc,p); + break; +#if !defined(YAPOR) + case _or_last: +#endif + case _procceed: + case _lock_lu: + pp = pc->u.p.p; + if (pp->PredFlags & MegaClausePredFlag) { + MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause); + *startp = (CODEADDR)mcl; + *endp = (CODEADDR)mcl+mcl->ClSize; + return pp; + } + clause_code = TRUE; + pc = NEXTOP(pc,p); + break; + case _execute: + case _dexecute: + clause_code = TRUE; + pp = pc->u.pp.p0; + pc = NEXTOP(pc,pp); + break; + case _trust_logical_pred: + case _jump: + case _move_back: + case _skip: + case _jump_if_var: + case _try_in: + case _try_clause2: + case _try_clause3: + case _try_clause4: + case _retry2: + case _retry3: + case _retry4: + case _p_eq: + case _p_dif: + pc = NEXTOP(pc,l); + break; + /* instructions type EC */ + case _jump_if_nonvar: + pc = NEXTOP(pc,xll); + break; + /* instructions type EC */ + case _alloc_for_logical_pred: + { + LogUpdClause *cl = pc->u.EC.ClBase; + + *startp = (CODEADDR)cl; + *endp = (CODEADDR)NEXTOP((yamop *)cl,e); + return cl->ClPred; + } + /* instructions type e */ + case _unify_idb_term: + case _copy_idb_term: + { + LogUpdClause *cl = (LogUpdClause *)((CELL)pc - (CELL)(((LogUpdClause *)NULL)->ClCode)); + *startp = (CODEADDR)cl; + *endp = (CODEADDR)NEXTOP((yamop *)cl,e); + return cl->ClPred; + } + case _cut: + case _cut_t: + case _cut_e: + case _allocate: + case _deallocate: + case _write_void: + case _write_list: + case _write_l_list: + case _pop: +#if THREADS + case _thread_local: +#endif + case _p_equal: + case _p_functor: + case _enter_a_profiling: + case _count_a_call: + case _index_dbref: + case _index_blob: + case _unlock_lu: +#ifdef YAPOR + case _getwork_first_time: +#endif +#ifdef TABLING + case _trie_do_null: + case _trie_trust_null: + case _trie_try_null: + case _trie_retry_null: + case _trie_do_var: + case _trie_trust_var: + case _trie_try_var: + case _trie_retry_var: + case _trie_do_val: + case _trie_trust_val: + case _trie_try_val: + case _trie_retry_val: + case _trie_do_atom: + case _trie_trust_atom: + case _trie_try_atom: + case _trie_retry_atom: + case _trie_do_list: + case _trie_trust_list: + case _trie_try_list: + case _trie_retry_list: + case _trie_do_struct: + case _trie_trust_struct: + case _trie_try_struct: + case _trie_retry_struct: + case _trie_do_extension: + case _trie_trust_extension: + case _trie_try_extension: + case _trie_retry_extension: + case _trie_do_float: + case _trie_trust_float: + case _trie_try_float: + case _trie_retry_float: + case _trie_do_long: + case _trie_trust_long: + case _trie_try_long: + case _trie_retry_long: +#endif /* TABLING */ +#ifdef TABLING_INNER_CUTS + case _clause_with_cut: +#endif /* TABLING_INNER_CUTS */ + pc = NEXTOP(pc,e); + break; + /* instructions type x */ + case _save_b_x: + case _commit_b_x: + case _get_list: + case _put_list: + case _write_x_var: + case _write_x_val: + case _write_x_loc: + pc = NEXTOP(pc,x); + break; + /* instructions type xF */ + case _p_atom_x: + case _p_atomic_x: + case _p_integer_x: + case _p_nonvar_x: + case _p_number_x: + case _p_var_x: + case _p_db_ref_x: + case _p_primitive_x: + case _p_compound_x: + case _p_float_x: + case _p_cut_by_x: + pc = NEXTOP(pc,xF); + break; + /* instructions type y */ + case _save_b_y: + case _commit_b_y: + case _write_y_var: + case _write_y_val: + case _write_y_loc: + pc = NEXTOP(pc,y); + break; + /* instructions type yF */ + case _p_atom_y: + case _p_atomic_y: + case _p_integer_y: + case _p_nonvar_y: + case _p_number_y: + case _p_var_y: + case _p_db_ref_y: + case _p_primitive_y: + case _p_compound_y: + case _p_float_y: + case _p_cut_by_y: + pc = NEXTOP(pc,yF); + break; + /* instructions type sla */ + case _p_execute_tail: + case _p_execute: + clause_code = TRUE; + pp = RepPredProp(Yap_GetPredPropByFunc(FunctorCall, CurrentModule)); + *startp = (CODEADDR)&(pp->CodeOfPred); + *endp = (CODEADDR)&(pp->CodeOfPred); + return pp; + case _fcall: + case _call: +#ifdef YAPOR + case _or_last: +#endif + clause_code = TRUE; + pp = pc->u.sla.sla_u.p; + pc = NEXTOP(pc,sla); + break; + /* instructions type sla, but for disjunctions */ + case _either: + case _or_else: + case _call_cpred: + case _call_usercpred: + clause_code = TRUE; + pp = pc->u.sla.p0; + pc = NEXTOP(pc,sla); + break; + /* instructions type xx */ + case _get_x_var: + case _get_x_val: + case _glist_valx: + case _gl_void_varx: + case _gl_void_valx: + case _put_x_var: + case _put_x_val: + pc = NEXTOP(pc,xx); + break; + case _put_xx_val: + pc = NEXTOP(pc,xxxx); + break; + /* instructions type yx */ + case _get_y_var: + case _get_y_val: + case _put_y_var: + case _put_y_val: + case _put_unsafe: + pc = NEXTOP(pc,yx); + break; + /* instructions type xc */ + case _get_atom: + case _put_atom: + case _get_float: + case _get_longint: + case _get_bigint: + pc = NEXTOP(pc,xc); + break; + /* instructions type cc */ + case _get_2atoms: + pc = NEXTOP(pc,cc); + break; + /* instructions type ccc */ + case _get_3atoms: + pc = NEXTOP(pc,ccc); + break; + /* instructions type cccc */ + case _get_4atoms: + pc = NEXTOP(pc,cccc); + break; + /* instructions type ccccc */ + case _get_5atoms: + pc = NEXTOP(pc,ccccc); + break; + /* instructions type cccccc */ + case _get_6atoms: + pc = NEXTOP(pc,cccccc); + break; + /* instructions type xf */ + case _get_struct: + case _put_struct: + pc = NEXTOP(pc,xf); + break; + /* instructions type xy */ + case _glist_valy: + case _gl_void_vary: + case _gl_void_valy: + pc = NEXTOP(pc,xy); + break; + /* instructions type ox */ + case _unify_x_var: + case _unify_x_var_write: + case _unify_l_x_var: + case _unify_l_x_var_write: + case _unify_x_val_write: + case _unify_x_val: + case _unify_l_x_val_write: + case _unify_l_x_val: + case _unify_x_loc_write: + case _unify_x_loc: + case _unify_l_x_loc_write: + case _unify_l_x_loc: + case _save_pair_x_write: + case _save_pair_x: + case _save_appl_x_write: + case _save_appl_x: + pc = NEXTOP(pc,ox); + break; + /* instructions type oxx */ + case _unify_x_var2: + case _unify_x_var2_write: + case _unify_l_x_var2: + case _unify_l_x_var2_write: + pc = NEXTOP(pc,oxx); + break; + /* instructions type oy */ + case _unify_y_var: + case _unify_y_var_write: + case _unify_l_y_var: + case _unify_l_y_var_write: + case _unify_y_val_write: + case _unify_y_val: + case _unify_l_y_val_write: + case _unify_l_y_val: + case _unify_y_loc_write: + case _unify_y_loc: + case _unify_l_y_loc_write: + case _unify_l_y_loc: + case _save_pair_y_write: + case _save_pair_y: + case _save_appl_y_write: + case _save_appl_y: + pc = NEXTOP(pc,oy); + break; + /* instructions type o */ + case _unify_void_write: + case _unify_void: + case _unify_l_void_write: + case _unify_l_void: + case _unify_list_write: + case _unify_list: + case _unify_l_list_write: + case _unify_l_list: + pc = NEXTOP(pc,o); + break; + /* instructions type os */ + case _unify_n_voids_write: + case _unify_n_voids: + case _unify_l_n_voids_write: + case _unify_l_n_voids: + pc = NEXTOP(pc,os); + break; + /* instructions type oc */ + case _unify_atom_write: + case _unify_atom: + case _unify_l_atom_write: + case _unify_l_atom: + case _unify_float: + case _unify_l_float: + case _unify_longint: + case _unify_l_longint: + case _unify_bigint: + case _unify_l_bigint: + pc = NEXTOP(pc,oc); + break; + /* instructions type osc */ + case _unify_n_atoms_write: + case _unify_n_atoms: + pc = NEXTOP(pc,osc); + break; + /* instructions type of */ + case _unify_struct_write: + case _unify_struct: + case _unify_l_struc_write: + case _unify_l_struc: + pc = NEXTOP(pc,of); + break; + /* instructions type s */ + case _write_n_voids: + case _pop_n: +#ifdef BEAM + case _run_eam: +#endif +#ifdef TABLING + case _table_new_answer: +#endif /* TABLING */ + pc = NEXTOP(pc,s); + break; + /* instructions type c */ + case _write_atom: + pc = NEXTOP(pc,c); + break; + /* instructions type sc */ + case _write_n_atoms: + pc = NEXTOP(pc,sc); + break; + /* instructions type f */ + case _write_struct: + case _write_l_struc: + pc = NEXTOP(pc,f); + break; + /* instructions type sdl */ + case _call_c_wfail: + clause_code = TRUE; + pp = pc->u.sdl.p; + pc = NEXTOP(pc,sdl); + break; + /* instructions type lds */ + case _try_c: + case _try_userc: + case _retry_c: + case _retry_userc: + clause_code = TRUE; + pp = pc->u.lds.p; + pc = NEXTOP(pc,lds); + break; +#ifdef CUT_C + case _cut_c: + case _cut_userc: + /* don't need to do nothing here, because this two instructions + are "phantom" instructions. (see: cut_c implementation paper + on PADL 2006) */ + break; +#endif + /* instructions type llll */ + case _switch_on_type: + pc = NEXTOP(pc,llll); + break; + /* instructions type ollll */ + case _switch_list_nl: + pc = NEXTOP(pc,ollll); + break; + /* instructions type xllll */ + case _switch_on_arg_type: + pc = NEXTOP(pc,xllll); + break; + /* instructions type sllll */ + case _switch_on_sub_arg_type: + pc = NEXTOP(pc,sllll); + break; + /* instructions type clll */ + case _if_not_then: + pc = NEXTOP(pc,clll); + break; + /* switch_on_func */ + case _switch_on_func: + case _switch_on_cons: + case _go_on_func: + case _go_on_cons: + case _if_func: + case _if_cons: + pc = NEXTOP(pc,sssl); + break; + /* instructions type xxx */ + case _p_plus_vv: + case _p_minus_vv: + case _p_times_vv: + case _p_div_vv: + case _p_and_vv: + case _p_or_vv: + case _p_sll_vv: + case _p_slr_vv: + case _p_arg_vv: + case _p_func2s_vv: + case _p_func2f_xx: + clause_code = TRUE; + pc = NEXTOP(pc,xxx); + break; + /* instructions type xxc */ + case _p_plus_vc: + case _p_minus_cv: + case _p_times_vc: + case _p_div_cv: + case _p_and_vc: + case _p_or_vc: + case _p_sll_vc: + case _p_slr_vc: + case _p_func2s_vc: + clause_code = TRUE; + pc = NEXTOP(pc,xxc); + break; + case _p_div_vc: + case _p_sll_cv: + case _p_slr_cv: + case _p_arg_cv: + clause_code = TRUE; + pc = NEXTOP(pc,xcx); + break; + case _p_func2s_cv: + clause_code = TRUE; + pc = NEXTOP(pc,xcx); + break; + /* instructions type xyx */ + case _p_func2f_xy: + clause_code = TRUE; + pc = NEXTOP(pc,xyx); + break; + /* instructions type yxx */ + case _p_plus_y_vv: + case _p_minus_y_vv: + case _p_times_y_vv: + case _p_div_y_vv: + case _p_and_y_vv: + case _p_or_y_vv: + case _p_sll_y_vv: + case _p_slr_y_vv: + case _p_arg_y_vv: + case _p_func2s_y_vv: + case _p_func2f_yx: + clause_code = TRUE; + pc = NEXTOP(pc,yxx); + break; + /* instructions type yyx */ + case _p_func2f_yy: + clause_code = TRUE; + pc = NEXTOP(pc,yyx); + break; + /* instructions type yxc */ + case _p_plus_y_vc: + case _p_minus_y_cv: + case _p_times_y_vc: + case _p_div_y_vc: + case _p_div_y_cv: + case _p_and_y_vc: + case _p_or_y_vc: + case _p_sll_y_vc: + case _p_slr_y_vc: + case _p_func2s_y_vc: + clause_code = TRUE; + pc = NEXTOP(pc,yxc); + break; + /* instructions type ycx */ + case _p_sll_y_cv: + case _p_slr_y_cv: + case _p_arg_y_cv: + clause_code = TRUE; + pc = NEXTOP(pc,ycx); + break; + /* instructions type ycx */ + case _p_func2s_y_cv: + clause_code = TRUE; + pc = NEXTOP(pc,ycx); + break; + /* instructions type llxx */ + case _call_bfunc_xx: + clause_code = TRUE; + pc = NEXTOP(pc,llxx); + break; + /* instructions type llxy */ + case _call_bfunc_yx: + case _call_bfunc_xy: + clause_code = TRUE; + pc = NEXTOP(pc,llxy); + break; + case _call_bfunc_yy: + clause_code = TRUE; + pc = NEXTOP(pc,llyy); + break; + case _expand_index: + pp = ((PredEntry *)(Unsigned(pc)-(CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode)))); + if (pc == codeptr) { + *startp = (CODEADDR)&(pp->cs.p_code.ExpandCode); + *endp = (CODEADDR)&(pp->cs.p_code.ExpandCode); + } + return pp; + case _undef_p: + case _spy_pred: + case _index_pred: + pp = ((PredEntry *)(Unsigned(pc)-(CELL)(&(((PredEntry *)NULL)->OpcodeOfPred)))); + *startp = (CODEADDR)&(pp->CodeOfPred); + *endp = (CODEADDR)&(pp->CodeOfPred); + return pp; + case _expand_clauses: + /* expansion points may not be found when following the indices tree */ + pp = codeptr->u.sp.p; + if (pc == codeptr) { + *startp = (CODEADDR)codeptr; + *endp = (CODEADDR)NEXTOP(codeptr,sp); + } + return pp; + case _op_fail: + if (codeptr == FAILCODE) { + pp = RepPredProp(Yap_GetPredPropByAtom(AtomFail,CurrentModule)); + *startp = *endp = (CODEADDR)FAILCODE; + return pp; + } + pc = NEXTOP(pc,e); + break; + case _trust_fail: + if (codeptr == TRUSTFAILCODE) { + pp = RepPredProp(Yap_GetPredPropByAtom(AtomFail,CurrentModule)); + *startp = *endp = (CODEADDR)TRUSTFAILCODE; + return pp; + } + pc = NEXTOP(pc,e); + break; + } + } + return NULL; +} + +PredEntry * +Yap_PredEntryForCode(yamop *codeptr, find_pred_type where_from, CODEADDR *startp, CODEADDR *endp) { + + if (where_from == FIND_PRED_FROM_CP) { + PredEntry *pp = PredForChoicePt(codeptr); + if (cl_code_in_pred(pp, codeptr, startp, endp)) { + return pp; + } + } else if (where_from == FIND_PRED_FROM_ENV) { + PredEntry *pp = EnvPreg(codeptr); + if (cl_code_in_pred(pp, codeptr, startp, endp)) { + return pp; + } + } else { + return ClauseInfoForCode(codeptr, startp, endp); + } + return NULL; +} + static Int p_pred_for_code(void) { @@ -3673,6 +4437,8 @@ p_clean_up_dead_clauses(void) while (DeadClauses != NULL) { char *pt = (char *)DeadClauses; DeadClauses = DeadClauses->NextCl; + if (((DeadClause *)pt)->ClFlags & ProfFoundMask) + Yap_InformOfRemoval((CODEADDR)pt); Yap_FreeCodeSpace(pt); } return(TRUE); @@ -4299,7 +5065,7 @@ p_continue_static_clause(void) return fetch_next_static_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE); } -#ifdef LOW_PROF +#if LOW_PROF static void add_code_in_pred(PredEntry *pp) { @@ -4307,7 +5073,9 @@ add_code_in_pred(PredEntry *pp) { READ_LOCK(pp->PRWLock); /* check if the codeptr comes from the indexing code */ - + + /* highly likely this is used for indexing */ + Yap_inform_profiler_of_clause((yamop *)&(pp->OpcodeOfPred), (yamop *)(&(pp->OpcodeOfPred)+1), pp, 1); if (pp->PredFlags & (CPredFlag|AsmPredFlag)) { char *code_end; StaticClause *cl; @@ -4319,6 +5087,7 @@ add_code_in_pred(PredEntry *pp) { READ_UNLOCK(pp->PRWLock); return; } + Yap_inform_profiler_of_clause((yamop *)&(pp->cs.p_code.ExpandCode), (yamop *)(&(pp->cs.p_code.ExpandCode)+1), pp, 1); clcode = pp->cs.p_code.TrueCodeOfPred; if (pp->PredFlags & IndexedPredFlag) { char *code_end; @@ -4345,10 +5114,10 @@ add_code_in_pred(PredEntry *pp) { } else if (pp->PredFlags & DynamicPredFlag) { do { DynamicClause *cl; - char *code_end; + CODEADDR code_end; cl = ClauseCodeToDynamicClause(clcode); - code_end = (char *)cl + cl->ClSize; + code_end = (CODEADDR)cl + cl->ClSize; Yap_inform_profiler_of_clause(clcode, (yamop *)code_end, pp,0); if (clcode == pp->cs.p_code.LastClause) break; @@ -4466,7 +5235,6 @@ p_static_pred_statistics(void) return static_statistics(pe); } -#if DEBUG static Int p_predicate_erased_statistics(void) { @@ -4498,13 +5266,9 @@ p_predicate_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; } @@ -4514,7 +5278,6 @@ p_predicate_erased_statistics(void) Yap_unify(ARG4,MkIntegerTerm(icls)) && Yap_unify(ARG5,MkIntegerTerm(isz)); } -#endif /* DEBUG */ static int p_program_continuation(void) diff --git a/C/compiler.c b/C/compiler.c index 42aecc0fa..b160648e2 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -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); } } diff --git a/C/dbase.c b/C/dbase.c index b2381447b..bdb3c05cf 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -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) diff --git a/C/heapgc.c b/C/heapgc.c index 1a39144cd..17772c65d 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -3509,7 +3509,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop) while (H0 - max < 1024+(2*NUM_OF_ATTS)) { if (!Yap_growglobal(¤t_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 diff --git a/C/index.c b/C/index.c index 113bf1cd4..6005920c3 100644 --- a/C/index.c +++ b/C/index.c @@ -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) diff --git a/C/init.c b/C/init.c index 2796bfc3d..a823c6a67 100644 --- a/C/init.c +++ b/C/init.c @@ -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; } } diff --git a/C/iopreds.c b/C/iopreds.c index 040813cc6..aa90ffacc 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -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) { diff --git a/C/scanner.c b/C/scanner.c index 6c590d122..398161e78 100644 --- a/C/scanner.c +++ b/C/scanner.c @@ -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; } diff --git a/C/stdpreds.c b/C/stdpreds.c index 892e962ce..99432aae3 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -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 #endif -#ifdef LOW_PROF -#include -#include -#include -#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(t2pp==t->pp) { - calls+=t2->pcs; - t2++; - } - while(tpca=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 (tpp == 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(t2pp==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 */ diff --git a/C/tracer.c b/C/tracer.c index b56a16dbb..55b664cea 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -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; diff --git a/CLPBN/clpbn.yap b/CLPBN/clpbn.yap index b7bff7b91..68d309df3 100644 --- a/CLPBN/clpbn.yap +++ b/CLPBN/clpbn.yap @@ -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). diff --git a/CLPBN/clpbn/topsort.yap b/CLPBN/clpbn/topsort.yap index b2bdd40ba..2cd589072 100644 --- a/CLPBN/clpbn/topsort.yap +++ b/CLPBN/clpbn/topsort.yap @@ -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), diff --git a/H/Heap.h b/H/Heap.h index f907642fc..aa60545b3 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -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 diff --git a/H/Yap.h b/H/Yap.h index fdeff3df3..8845685df 100644 --- a/H/Yap.h +++ b/H/Yap.h @@ -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; diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index 439f6bbe9..ca1cc01e5 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -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 */ diff --git a/H/Yapproto.h b/H/Yapproto.h index 45d0bfc77..dbddc9c6a 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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 */ diff --git a/H/Yatom.h b/H/Yatom.h index ac10099d8..b89038cca 100644 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -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 */ diff --git a/H/absmi.h b/H/absmi.h index a179f2b55..a0a8833dc 100644 --- a/H/absmi.h +++ b/H/absmi.h @@ -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 diff --git a/H/amidefs.h b/H/amidefs.h index 907e5a4cc..9f3a4fc90 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -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; diff --git a/H/clause.h b/H/clause.h index 724c15820..6dd662375 100644 --- a/H/clause.h +++ b/H/clause.h @@ -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 diff --git a/H/iopreds.h b/H/iopreds.h index 7d240eb6d..d4f85a090 100644 --- a/H/iopreds.h +++ b/H/iopreds.h @@ -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 { diff --git a/H/rclause.h b/H/rclause.h index 062669891..049a48a49 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -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: diff --git a/H/rheap.h b/H/rheap.h index edda62780..11361340c 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -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); diff --git a/Makefile.in b/Makefile.in index a4f22b050..113c58119 100644 --- a/Makefile.in +++ b/Makefile.in @@ -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 $@ diff --git a/changes-5.1.html b/changes-5.1.html index 179181dac..74ab07e31 100644 --- a/changes-5.1.html +++ b/changes-5.1.html @@ -16,6 +16,16 @@

Yap-5.1.0:

    +
  • NEW: tabling does not conflit with depth limit (Trevor Walker).
    • +
  • NEW: make scanner restartable on seekable files (Nuno Fonseca).
    • +
  • NEW: improve error discovery within scanner (Jude Shavlik).
    • +
  • NEW: change event profiler to do profiling online and +off-line.
    • +
  • NEW: routine to find clause/pred
    • +
  • NEW: always end clauses with Ystop START, so that we can refer +back to the clause's beginning.
    • +
  • NEW: always have a pointer to Pred in clauses, so that we can +find current predicate.
  • NEW: heapgc should now be concurrent when using threads.
  • FIXED: heapgc wo tags can handle trail overflows right.
  • NEW: heapgc wo tags does not write on the collected areas during marking.
    • diff --git a/config.h.in b/config.h.in index 6f6712fc4..f4a3d3ff5 100644 --- a/config.h.in +++ b/config.h.in @@ -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 diff --git a/configure.in b/configure.in index 73951941c..39de74033 100644 --- a/configure.in +++ b/configure.in @@ -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) diff --git a/pl/profile.yap b/pl/profile.yap index 01d09908c..60ab10208 100644 --- a/pl/profile.yap +++ b/pl/profile.yap @@ -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. +