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

diverse fixes

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1738 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2006-12-27 01:32:38 +00:00
parent 72064a8c74
commit 78b52b925c
21 changed files with 175 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
C/absmi.c
View File

@ -10,8 +10,11 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2006-11-28 00:46:28 $,$Author: vsc $ *
* Last rev: $Date: 2006-12-27 01:32:37 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.214 2006/11/28 00:46:28 vsc
* fix bug in threaded implementation
*
* Revision 1.213 2006/11/27 17:42:02 vsc
* support for UNICODE, and other bug fixes.
*
@ -13253,7 +13256,7 @@ Yap_absmi(int inp)
/* create an to execute the call */
deref_head(d1, execute_comma_comma_unk);
execute_comma_comma_nvar:
ENV_YREG[E_CB] = (CELL)pt0[E_CB];
ENV_YREG[E_CB] = pt0[E_CB];
if (IsAtomTerm(d1)) {
ENV_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),mod));
} else if (IsApplTerm(d1)) {
@ -13431,7 +13434,7 @@ Yap_absmi(int inp)
/* for profiler */
save_pc();
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
ENV_YREG[E_CB] = (CELL)B;
ENV_YREG[E_CB] = pt0[E_CB];
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pen,XREGS+1);

7
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c *
* comments: abstract machine assembler *
* *
* Last rev: $Date: 2006-12-13 16:10:14 $ *
* Last rev: $Date: 2006-12-27 01:32:37 $ *
* $Log: not supported by cvs2svn $
* Revision 1.93 2006/12/13 16:10:14 vsc
* several debugger and CLP(BN) improvements.
*
* Revision 1.92 2006/11/15 00:13:36 vsc
* fixes for indexing code.
*
@ -440,6 +443,7 @@ a_lucl(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip,
code_p->opc = emit_op(opcode);
code_p->u.Ill.I = (LogUpdIndex *)cip->code_addr;
cip->current_try_lab = &code_p->u.Ill.l1;
cip->current_trust_lab = &code_p->u.Ill.l2;
code_p->u.Ill.s = cip->cpc->rnd3;
#if defined(YAPOR) || defined(THREADS)
code_p->u.Ill.p = cip->CurrentPred;
@ -1744,6 +1748,7 @@ a_try(op_numbers opcode, CELL lab, CELL opr, int nofalts, int hascut, yamop *cod
else
newcp->opc = emit_op(_trust_logical);
newcp->u.lld.t.block = (LogUpdIndex *)(cip->code_addr);
*cip->current_trust_lab = newcp;
}
newcp->u.lld.d = ClauseCodeToLogUpdClause(emit_a(lab));
cip->current_try_lab = &(newcp->u.lld.n);

7
C/cdmgr.c
View File

@ -11,8 +11,11 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2006-12-13 16:10:14 $,$Author: vsc $ *
* Last rev: $Date: 2006-12-27 01:32:37 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.201 2006/12/13 16:10:14 vsc
* several debugger and CLP(BN) improvements.
*
* Revision 1.200 2006/11/27 17:42:02 vsc
* support for UNICODE, and other bug fixes.
*
@ -646,7 +649,7 @@ Yap_BuildMegaClause(PredEntry *ap)
nof_megaclauses++;
#endif
while (!(mcl = (MegaClause *)Yap_AllocCodeSpace(required))) {
if (!Yap_growheap(FALSE, sizeof(consult_obj)*ConsultCapacity, NULL)) {
if (!Yap_growheap(FALSE, required, NULL)) {
/* just fail, the system will keep on going */
return;
}

28
C/exec.c
View File

@ -137,6 +137,25 @@ p_save_cp(void)
return(TRUE);
}
static Int
p_save_env_b(void)
{
Term t = Deref(ARG1);
Term td;
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
if (!IsVarTerm(t)) return(FALSE);
td = cp_as_integer((choiceptr)YENV[E_CB]);
BIND((CELL *)t,td,bind_save_cp);
#ifdef COROUTINING
DO_TRAIL(CellPtr(t), td);
if (CellPtr(t) < H0) Yap_WakeUp((CELL *)t);
bind_save_cp:
#endif
return(TRUE);
}
inline static Int
do_execute(Term t, Term mod)
{
@ -600,7 +619,8 @@ p_execute_nonstop(void)
/* call may not define new system predicates!! */
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred);
} else if (RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) {
} else if ((RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) &&
RepPredProp(pe)->OpcodeOfPred != Yap_opcode(_call_bfunc_xx)) {
return RepPredProp(pe)->cs.f_code();
} else {
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred);
@ -1854,6 +1874,7 @@ p_uncaught_throw(void)
void
Yap_InitExecFs(void)
{
Term cm = CurrentModule;
Yap_InitComma();
Yap_InitCPred("$execute", 1, p_execute, HiddenPredFlag);
Yap_InitCPred("$execute", 2, p_execute2, HiddenPredFlag);
@ -1877,7 +1898,10 @@ Yap_InitExecFs(void)
Yap_InitCPred("$execute0", 2, p_execute0, HiddenPredFlag);
Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop, HiddenPredFlag);
Yap_InitCPred("$execute_clause", 4, p_execute_clause, HiddenPredFlag);
Yap_InitCPred("$save_current_choice_point", 1, p_save_cp, HiddenPredFlag);
CurrentModule = HACKS_MODULE;
Yap_InitCPred("current_choice_point", 1, p_save_cp, HiddenPredFlag);
Yap_InitCPred("env_choice_point", 1, p_save_env_b, HiddenPredFlag);
CurrentModule = cm;
Yap_InitCPred("$pred_goal_expansion_on", 0, p_pred_goal_expansion_on, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$restore_regs", 1, p_restore_regs, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$restore_regs", 2, p_restore_regs2, SafePredFlag|HiddenPredFlag);

62
C/globals.c
View File

@ -269,10 +269,10 @@ static int
GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity)
{
if (size == 0) {
if (old_size < 64*1024) {
if (old_size < 1024*1024) {
size = old_size;
} else {
size = 64*1024;
size = 1024*1024;
}
}
if (size < 4096) {
@ -299,7 +299,6 @@ GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity)
} else {
XREGS[arity+1] = arena;
if ((size=Yap_InsertInGlobal(pt, size*sizeof(CELL)))==0) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
size = size/sizeof(CELL);
@ -573,12 +572,16 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
to_visit = bp[0];
HB = HLow;
ptf++;
if ((ADDR)TR > Yap_TrailTop-128)
goto trail_overflow;
Bind_and_Trail(ptd0, ptf[-1]);
}
} else {
#endif
/* first time we met this term */
RESET_VARIABLE(ptf);
if ((ADDR)TR > Yap_TrailTop-128)
goto trail_overflow;
Bind_and_Trail(ptd0, (CELL)ptf);
ptf++;
#ifdef COROUTINING
@ -644,6 +647,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
reset_trail(TR0);
return -2;
#if COROUTINING
delay_overflow:
/* oops, we're in trouble */
@ -661,13 +665,30 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
}
#endif
reset_trail(TR0);
return -2;
return -3;
#endif
trail_overflow:
/* oops, we're in trouble */
H = HLow;
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
ptf = to_visit[2];
*pt0 = (CELL)to_visit[3];
}
#endif
reset_trail(TR0);
return -4;
}
static Term
CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap)
CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap, Int min_grow)
{
UInt old_size = ArenaSz(arena);
CELL *oldH = H;
@ -782,6 +803,10 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap
}
} else {
H += 1+ArityOfFunctor(f);
if (H > ASP-128) {
res = -1;
goto error_handler;
}
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0, att_arenap)) < 0) {
goto error_handler;
}
@ -808,13 +833,13 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap
switch (res) {
case -1:
/* handle arena overflow */
if (!GrowArena(arena, old_top, old_size, 0L, arity+4)) {
if (!GrowArena(arena, old_top, old_size, min_grow, arity+4)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return 0L;
}
break;
#if COROUTINING
case -2:
case -3:
/* handle delay arena overflow */
old_size = DelayArenaSz(*att_arenap);
if (!GrowDelayArena(att_arenap, old_size, 0L, arity+4)) {
@ -823,6 +848,13 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap
}
break;
#endif
case -4:
/* handle trail overflow */
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L, FALSE)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, Yap_ErrorMessage);
return 0L;
}
break;
default: /* temporary space overflow */
if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
@ -919,7 +951,7 @@ p_nb_setval(void)
return (FALSE);
}
ge = GetGlobalEntry(AtomOfTerm(t));
to = CopyTermToArena(ARG2, GlobalArena, 2, &GlobalArena, &GlobalDelayArena);
to = CopyTermToArena(ARG2, GlobalArena, 2, &GlobalArena, &GlobalDelayArena, 0);
if (to == 0L)
return FALSE;
WRITE_LOCK(ge->GRWLock);
@ -1181,7 +1213,7 @@ p_nb_queue_enqueue(void)
arena = GetQueueArena(qd,"enqueue");
if (arena == 0L)
return FALSE;
to = CopyTermToArena(ARG2, arena, 2, qd+QUEUE_ARENA, qd+QUEUE_DELAY_ARENA);
to = CopyTermToArena(ARG2, arena, 2, qd+QUEUE_ARENA, qd+QUEUE_DELAY_ARENA,ArenaPt(arena)-RepPair(qd[QUEUE_HEAD]));
if (to == 0L)
return FALSE;
qd = GetQueue(ARG1,"enqueue");
@ -1193,8 +1225,7 @@ p_nb_queue_enqueue(void)
old_sz = ArenaSz(arena);
qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
while (old_sz < 128) {
UInt gsiz = qsize*2;
UInt gsiz = H-RepPair(qd[QUEUE_HEAD]);
H = oldH;
HB = oldHB;
if (gsiz > 1024*1024) {
@ -1203,6 +1234,7 @@ p_nb_queue_enqueue(void)
gsiz = 1024;
}
ARG3 = to;
fprintf(stderr,"growing %d cells\n",gsiz);
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) {
Yap_Error(OUT_OF_STACK_ERROR, arena, Yap_ErrorMessage);
return 0L;
@ -1511,9 +1543,9 @@ p_nb_heap_add_to_heap(void)
arena = qd[HEAP_ARENA];
if (arena == 0L)
return FALSE;
key = CopyTermToArena(ARG2, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA);
key = CopyTermToArena(ARG2, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA, 0);
arena = qd[HEAP_ARENA];
to = CopyTermToArena(ARG3, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA);
to = CopyTermToArena(ARG3, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA, 0);
if (key == 0 || to == 0L)
return FALSE;
qd = GetHeap(ARG1,"add_to_heap");
@ -1912,9 +1944,9 @@ p_nb_beam_add_to_beam(void)
arena = qd[HEAP_ARENA];
if (arena == 0L)
return FALSE;
key = CopyTermToArena(ARG2, qd[HEAP_ARENA], 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA);
key = CopyTermToArena(ARG2, qd[HEAP_ARENA], 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA, 0);
arena = qd[HEAP_ARENA];
to = CopyTermToArena(ARG3, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA);
to = CopyTermToArena(ARG3, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA, 0);
if (key == 0 || to == 0L)
return FALSE;
qd = GetHeap(ARG1,"add_to_beam");

5
C/grow.c
View File

@ -662,7 +662,8 @@ static_growglobal(long size, CELL **ptr, CELL *hsplit)
#else
if (!do_grow) {
TrDiff = DelayDiff = LDiff = 0;
GDiff = size;
/* don't grow more than what we asked for */
GDiff = size-(size0-sz);
} else if (minimal_request) {
DelayDiff = size-size0;
TrDiff = LDiff = GDiff = size;
@ -672,7 +673,7 @@ static_growglobal(long size, CELL **ptr, CELL *hsplit)
}
#endif
if (hsplit) {
GDiff0 = GDiff-sz;
GDiff0 = GDiff-size0;
GSplit = hsplit;
} else {
GDiff0 = DelayDiff;

62
C/index.c
View File

@ -11,8 +11,11 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2006-11-27 17:42:02 $,$Author: vsc $ *
* Last rev: $Date: 2006-12-27 01:32:37 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.179 2006/11/27 17:42:02 vsc
* support for UNICODE, and other bug fixes.
*
* Revision 1.178 2006/11/21 16:21:31 vsc
* fix I/O mess
* fix spy/reconsult mess
@ -6218,8 +6221,11 @@ find_last_clause(yamop *start)
}
static void
remove_clause_from_index(yamop **prevp, yamop *curp, LogUpdClause *cl)
remove_clause_from_index(yamop *header, LogUpdClause *cl)
{
yamop **prevp = &(header->u.Ill.l1);
yamop *curp = header->u.Ill.l1;
if (curp->u.lld.d == cl) {
yamop *newp = curp->u.lld.n;
newp->opc = curp->opc;
@ -6232,6 +6238,8 @@ remove_clause_from_index(yamop **prevp, yamop *curp, LogUpdClause *cl)
curp = curp->u.lld.n;
}
/* in case we were the last */
if (curp == header->u.Ill.l2)
header->u.Ill.l2 = ocurp;
if (ocurp != ocurp0)
ocurp->opc = curp->opc;
ocurp->u.lld.n = curp->u.lld.n;
@ -6247,12 +6255,13 @@ remove_clause_from_index(yamop **prevp, yamop *curp, LogUpdClause *cl)
}
static void
remove_dirty_clauses_from_index(yamop **prevp, yamop *curp)
remove_dirty_clauses_from_index(yamop *header)
{
LogUpdClause *cl;
OPCODE startopc = curp->opc;
yamop *previouscurp;
OPCODE endop = Yap_opcode(_trust_logical);
yamop **prevp= &(header->u.Ill.l1), *curp = header->u.Ill.l1;
OPCODE startopc = curp->opc;
PredEntry *ap = curp->u.lld.d->ClPred;
if (ap->PredFlags & CountPredFlag)
@ -6289,6 +6298,7 @@ remove_dirty_clauses_from_index(yamop **prevp, yamop *curp)
previouscurp->opc = endop;
previouscurp->u.lld.t.block = curp->u.lld.t.block;
previouscurp->u.lld.n = NULL;
header->u.Ill.l2 = previouscurp;
Yap_LUIndexSpace_CP -= (UInt)NEXTOP((yamop*)NULL,lld);
Yap_FreeCodeSpace((ADDR)curp);
return;
@ -6357,8 +6367,7 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp0, PredEntry *
!(blk->ClFlags & InUseMask)
#endif
) {
remove_clause_from_index(&start->u.Ill.l1,
start->u.Ill.l1,
remove_clause_from_index(start,
ClauseCodeToLogUpdClause(bg));
} else {
blk->ClFlags |= DirtyMask;
@ -6675,34 +6684,13 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
switch(op) {
case _try_logical:
if (first) {
/* ERROR */
} else {
/* just go to next instruction */
ipc = ipc->u.lld.n;
}
break;
case _retry_logical:
case _count_retry_logical:
case _profiled_retry_logical:
ipc = ipc->u.lld.n;
break;
case _trust_logical:
case _count_trust_logical:
case _profiled_trust_logical:
if (first) {
/* ERROR */
} else {
if (ap->PredFlags & CountPredFlag)
ipc->opc = Yap_opcode(_count_trust_logical);
else if (ap->PredFlags & ProfiledPredFlag)
ipc->opc = Yap_opcode(_profiled_trust_logical);
else
ipc->opc = Yap_opcode(_retry_logical);
ipc->u.lld.n = add_trust(icl, cls, cint);
ipc->u.lld.t.s = ap->ArityOfPE;
}
ipc = pop_path(&sp, cls, ap);
/* ERROR */
break;
case _enter_lu_pred:
ipc->u.Ill.s++;
@ -6715,11 +6703,23 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
else
ipc->u.Ill.l1->opc = Yap_opcode(_retry_logical);
ipc->u.Ill.l1 = add_try(ap, cls, ipc->u.Ill.l1, cint);
ipc = pop_path(&sp, cls, ap);
} else {
/* just go to next instruction */
ipc = ipc->u.Ill.l1;
yamop *end = add_trust(icl, cls, cint),
*old = ipc->u.Ill.l2;
/* we used to have two clauses */
if (ap->PredFlags & CountPredFlag)
old->opc = Yap_opcode(_count_retry_logical);
else if (ap->PredFlags & ProfiledPredFlag)
old->opc = Yap_opcode(_profiled_retry_logical);
else
old->opc = Yap_opcode(_retry_logical);
old->u.lld.n = end;
old->u.lld.t.s = ap->ArityOfPE;
ipc->u.Ill.l2 = end;
}
ipc = pop_path(&sp, cls, ap);
break;
case _try_clause:
/* I cannot expand a predicate that starts on a variable,
@ -8480,6 +8480,6 @@ Yap_CleanUpIndex(LogUpdIndex *blk)
op = Yap_op_from_opcode(start->opc);
}
codep = start->u.Ill.l1;
remove_dirty_clauses_from_index(&start->u.Ill.l1, start->u.Ill.l1);
remove_dirty_clauses_from_index(start);
}

1
C/init.c
View File

@ -882,6 +882,7 @@ InitCodes(void)
Yap_heap_regs->terms_module = MkAtomTerm(Yap_LookupAtom("terms"));
Yap_heap_regs->system_module = MkAtomTerm(Yap_LookupAtom("system"));
Yap_heap_regs->readutil_module = MkAtomTerm(Yap_LookupAtom("readutil"));
Yap_heap_regs->hacks_module = MkAtomTerm(Yap_LookupAtom("yap_hacks"));
Yap_heap_regs->globals_module = MkAtomTerm(Yap_LookupAtom("nb"));
Yap_InitModules();
#ifdef BEAM

1
C/inlines.c
View File

@ -825,7 +825,6 @@ void
Yap_InitInlines(void)
{
Yap_InitAsmPred("$$cut_by", 1, _cut_by, p_cut_by, SafePredFlag);
Yap_InitAsmPred("atom", 1, _atom, p_atom, SafePredFlag);
Yap_InitAsmPred("atomic", 1, _atomic, p_atomic, SafePredFlag);
Yap_InitAsmPred("integer", 1, _integer, p_integer, SafePredFlag);

4
C/modules.c
View File

@ -184,7 +184,9 @@ Yap_InitModules(void)
ModuleName[7] =
READUTIL_MODULE;
ModuleName[8] =
HACKS_MODULE;
ModuleName[9] =
GLOBALS_MODULE;
NoOfModules = 9;
NoOfModules = 10;
CurrentModule = PROLOG_MODULE;
}

11
C/tracer.c
View File

@ -162,6 +162,17 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
sc = Yap_heap_regs;
vsc_count++;
#ifdef COMMENTED
if (vsc_count > 1388060LL && vsc_count < 1388070LL) {
if (vsc_count==1388061LL)
jmp_deb(1);
if (vsc_count % 1LL == 0) {
UInt sz = Yap_regp->H0_[17];
UInt end = sizeof(MP_INT)/sizeof(CELL)+sz+1;
fprintf(stderr,"VAL %lld %d %x/%x\n",vsc_count,sz,H0[16],H0[16+end]);
}
} else
return;
Yap_DebugPlWrite(Yap_XREGS[2]);
if (worker_id != 04 || worker_id != 03) return;
// if (vsc_count == 218280)
// vsc_xstop = 1;

10
C/utilpreds.c
View File

@ -380,7 +380,15 @@ CopyTerm(Term inp, UInt arity) {
tf = AbsAppl(H);
H[0] = (CELL)f;
H += 1+ArityOfFunctor(f);
{
if (H > ASP-128) {
H -= 1+ArityOfFunctor(f);
if (!Yap_gcl((ASP-H)*sizeof(CELL),arity+1, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
t = Deref(XREGS[arity+1]);
goto restart_appl;
} else {
int res;
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0)) < 0) {

4
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.110 2006-11-28 13:46:41 vsc Exp $ *
* version: $Id: Heap.h,v 1.111 2006-12-27 01:32:37 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -486,6 +486,7 @@ typedef struct various_codes {
terms_module,
system_module,
readutil_module,
hacks_module,
globals_module;
void *last_wtime;
struct pred_entry *pred_goal_expansion;
@ -783,6 +784,7 @@ struct various_codes *Yap_heap_regs;
#define TERMS_MODULE Yap_heap_regs->terms_module
#define SYSTEM_MODULE Yap_heap_regs->system_module
#define READUTIL_MODULE Yap_heap_regs->readutil_module
#define HACKS_MODULE Yap_heap_regs->hacks_module
#define GLOBALS_MODULE Yap_heap_regs->globals_module
#define PredGoalExpansion Yap_heap_regs->pred_goal_expansion
#define PredMetaCall Yap_heap_regs->pred_meta_call

2
H/compile.h
View File

@ -248,7 +248,7 @@ typedef struct intermediates {
yamop *expand_block;
UInt i_labelno;
/* for expanding code */
yamop **current_try_lab;
yamop **current_try_lab, **current_trust_lab;
yamop *try_instructions;
union {
struct static_index *si;

2
changes-5.1.html
View File

@ -16,6 +16,8 @@
<h2>Yap-5.1.2:</h2>
<ul>
<li> FIXED: cut might not prune correctly around meta-call (obs by
Trevor Walker).</li>
<li> NEW: keep history around (use nb and friends).</li>
<li> NEW: fix determinsitic debugging.</li>
<li> NEW: make debugger compatible with threads (use nb and friends).</li>

2
library/Makefile.in
View File

@ -33,6 +33,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
$(srcdir)/dbqueues.yap \
$(srcdir)/dgraphs.yap \
$(srcdir)/gensym.yap \
$(srcdir)/hacks.yap \
$(srcdir)/heaps.yap \
$(srcdir)/listing.yap \
$(srcdir)/lists.yap \
@ -55,6 +56,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
$(srcdir)/trees.yap \
$(srcdir)/ugraphs.yap \
$(srcdir)/undgraphs.yap \
$(srcdir)/varnumbers.yap \
$(srcdir)/wdgraphs.yap \
$(srcdir)/wundgraphs.yap \
$(srcdir)/lam_mpi.yap \

4
pl/arith.yap
View File

@ -61,7 +61,7 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
;
OUT = ('$set_depth_limit_for_next_call'(D),NG)
).
'$do_c_built_in'(once(G), M, ('$save_current_choice_point'(CP),NG,'$$cut_by'(CP))) :- !,
'$do_c_built_in'(once(G), M, (yap_hacks:current_choice_point(CP),NG,'$$cut_by'(CP))) :- !,
'$do_c_built_in'(G,M,NG).
'$do_c_built_in'('C'(A,B.C), _, (A=[B|C])) :- !.
'$do_c_built_in'(X is Y, _, P) :-
@ -114,7 +114,7 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
'$composed_built_in'(V) :- var(V), !,
fail.
'$composed_built_in'(('$save_current_choice_point'(_),NG,'$$cut_by'(_))) :- !,
'$composed_built_in'((yap_hacks:current_choice_point(_),NG,'$$cut_by'(_))) :- !,
'$composed_built_in'(NG).
'$composed_built_in'((_,_)).
'$composed_built_in'((_;_)).

14
pl/boot.yap
View File

@ -79,7 +79,7 @@ true :- true.
% encapsulate $cut_by because of co-routining.
%
'$cut_by'(X) :- '$$cut_by'(X).
'$$cut_by'(X) :- '$cut_by'(X).
% Start file for yap
@ -651,25 +651,25 @@ incore(G) :- '$execute'(G).
% standard meta-call, called if $execute could not do everything.
%
'$meta_call'(G, M) :-
'$save_current_choice_point'(CP),
yap_hacks:current_choice_point(CP),
'$call'(G, CP, G, M).
','(X,Y) :-
'$save_current_choice_point'(CP),
yap_hacks:env_choice_point(CP),
'$current_module'(M),
'$call'(X,CP,(X,Y),M),
'$call'(Y,CP,(X,Y),M).
';'(X,Y) :-
'$save_current_choice_point'(CP),
yap_hacks:env_choice_point(CP),
'$current_module'(M),
( '$call'(X,CP,(X;Y),M) ; '$call'(Y,CP,(X;Y),M) ).
'|'(X,Y) :-
'$save_current_choice_point'(CP),
yap_hacks:env_choice_point(CP),
'$current_module'(M),
( '$call'(X,CP,(X|Y),M) ; '$call'(Y,CP,(X|Y),M) ).
'->'(X,Y) :-
'$save_current_choice_point'(CP),
yap_hacks:env_choice_point(CP),
'$current_module'(M),
( '$call'(X,CP,(X->Y),M) -> '$call'(Y,CP,(X->Y),M) ).
\+(G) :- \+ '$execute'(G).
@ -681,7 +681,7 @@ not(G) :- \+ '$execute'(G).
%
'$meta_call'(G,_ISO,M) :-
'$iso_check_goal'(G,G),
'$save_current_choice_point'(CP),
yap_hacks:current_choice_point(CP),
'$call'(G, CP, G, M).
'$meta_call'(G, CP, G0, M) :-

8
pl/debug.yap
View File

@ -278,8 +278,8 @@ debugging :-
% last argument to do_spy says that we are at the end of a context. It
% is required to know whether we are controlled by the debugger.
'$do_spy'(!, _, CP, _) :- !, '$cut_by'(CP).
'$do_spy'('$cut_by'(M), _, _, _) :- !, '$cut_by'(M).
'$do_spy'(!, _, CP, _) :- !, '$$cut_by'(CP).
'$do_spy'('$cut_by'(M), _, _, _) :- !, '$$cut_by'(M).
'$do_spy'(true, _, _, _) :- !.
%'$do_spy'(fail, _, _, _) :- !, fail.
'$do_spy'(M:G, _, CP, InControl) :- !,
@ -326,7 +326,7 @@ debugging :-
% we are skipping, so we can just call the goal,
% while leaving the minimal structure in place.
'$loop_spy'(GoalNumber, G, Module, InControl) :-
'$save_current_choice_point'(CP),
yap_hacks:current_choice_point(CP),
'$system_catch'('$loop_spy2'(GoalNumber, G, Module, InControl, CP),
Module, Event,
'$loop_spy_event'(Event, GoalNumber, G, Module, InControl)).
@ -390,7 +390,7 @@ debugging :-
(
Det == true
->
'$cut_by'(CP)
'$$cut_by'(CP)
;
true
),

2
pl/directives.yap
View File

@ -681,8 +681,8 @@ yap_flag(float_format,X) :-
V = profiling ;
V = redefine_warnings ;
V = single_var_warnings ;
V = strict_iso ;
V = stack_dump_on_error ;
V = strict_iso ;
V = syntax_errors ;
V = system_options ;
V = to_chars_mode ;

6
pl/init.yap
View File

@ -42,6 +42,8 @@ otherwise.
:- bootstrap('errors.yap').
:- bootstrap('consult.yap').
:- [ 'utils.yap',
'arith.yap',
'directives.yap'].
@ -75,7 +77,7 @@ otherwise.
:- ['protect.yap'].
version(yap,[4,1]).
version(yap,[5,1]).
system_mode(verbose,on) :- set_value('$verbose',on).
system_mode(verbose,off) :- set_value('$verbose',off).
@ -87,6 +89,8 @@ system_mode(verbose,off) :- set_value('$verbose',off).
:- ['corout.yap',
'arrays.yap'].
yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- '$change_type_of_char'(36,7). % Make $ a symbol character
:- default_sequential(off).