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

fix \= on mavars. 

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@858 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-08-23 19:26:08 +00:00
parent a154a3f6e8
commit 3831eeb927
1 changed files with 387 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

503
C/absmi.c
View File

@ -291,7 +291,6 @@ Yap_absmi(int inp)
restore_absmi_regs(old_regs); restore_absmi_regs(old_regs);
#endif #endif
if (!Yap_growheap(FALSE, 0)) { if (!Yap_growheap(FALSE, 0)) {
saveregs();
Yap_Error(SYSTEM_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage); Yap_Error(SYSTEM_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
setregs(); setregs();
FAIL(); FAIL();
@ -370,7 +369,7 @@ Yap_absmi(int inp)
/* try_me Label,NArgs */ /* try_me Label,NArgs */
Op(try_me, ld); Op(try_me, ld);
/* check if enough space between trail and codespace */ /* check if enough space between trail and codespace */
check_trail(); check_trail(TR);
/* I use YREG =to go through the choicepoint. Usually YREG =is in a /* I use YREG =to go through the choicepoint. Usually YREG =is in a
* register, but sometimes (X86) not. In this case, have a * register, but sometimes (X86) not. In this case, have a
* new register to point at YREG =*/ * new register to point at YREG =*/
@ -696,7 +695,7 @@ Yap_absmi(int inp)
*****************************************************************/ *****************************************************************/
/* try_me0 Label,NArgs */ /* try_me0 Label,NArgs */
Op(try_me0, ld); Op(try_me0, ld);
check_trail(); check_trail(TR);
CACHE_Y(YREG); CACHE_Y(YREG);
store_yaam_regs(PREG->u.ld.d, 0); store_yaam_regs(PREG->u.ld.d, 0);
set_cut(S_YREG, B); set_cut(S_YREG, B);
@ -755,7 +754,7 @@ Yap_absmi(int inp)
/* try_me1 Label,NArgs */ /* try_me1 Label,NArgs */
Op(try_me1, ld); Op(try_me1, ld);
check_trail(); check_trail(TR);
CACHE_Y(YREG); CACHE_Y(YREG);
{ {
register CELL x1 = CACHED_A1(); register CELL x1 = CACHED_A1();
@ -822,7 +821,7 @@ Yap_absmi(int inp)
/* try_me2 Label,NArgs */ /* try_me2 Label,NArgs */
Op(try_me2, ld); Op(try_me2, ld);
check_trail(); check_trail(TR);
CACHE_Y(YREG); CACHE_Y(YREG);
#ifdef HAVE_FEW_REGS #ifdef HAVE_FEW_REGS
store_yaam_regs(PREG->u.ld.d, 2); store_yaam_regs(PREG->u.ld.d, 2);
@ -900,7 +899,7 @@ Yap_absmi(int inp)
/* try_me3 Label,NArgs */ /* try_me3 Label,NArgs */
Op(try_me3, ld); Op(try_me3, ld);
check_trail(); check_trail(TR);
CACHE_Y(YREG); CACHE_Y(YREG);
#ifdef HAVE_FEW_REGS #ifdef HAVE_FEW_REGS
store_yaam_regs(PREG->u.ld.d, 3); store_yaam_regs(PREG->u.ld.d, 3);
@ -984,7 +983,7 @@ Yap_absmi(int inp)
/* try_me4 Label,NArgs */ /* try_me4 Label,NArgs */
Op(try_me4, ld); Op(try_me4, ld);
check_trail(); check_trail(TR);
CACHE_Y(YREG); CACHE_Y(YREG);
store_yaam_regs(PREG->u.ld.d, 4); store_yaam_regs(PREG->u.ld.d, 4);
#ifdef HAVE_FEW_REGS #ifdef HAVE_FEW_REGS
@ -1079,7 +1078,7 @@ Yap_absmi(int inp)
BOp(try_logical_pred, l); BOp(try_logical_pred, l);
/* mark the indexing code */ /* mark the indexing code */
{ {
LogUpdClause *cl = (LogUpdClause *)PREG->u.l.l; LogUpdIndex *cl = (LogUpdIndex *)PREG->u.l.l;
PREG = NEXTOP(PREG, l); PREG = NEXTOP(PREG, l);
LOCK(cl->ClLock); LOCK(cl->ClLock);
/* indicate the indexing code is being used */ /* indicate the indexing code is being used */
@ -1091,7 +1090,7 @@ Yap_absmi(int inp)
if (!(cl->ClFlags & InUseMask)) { if (!(cl->ClFlags & InUseMask)) {
cl->ClFlags |= InUseMask; cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl); TRAIL_CLREF(cl);
cl->u2.ClUse = TR-(tr_fr_ptr)(Yap_TrailBase); cl->ClUse = TR-(tr_fr_ptr)(Yap_TrailBase);
} }
#endif #endif
UNLOCK(cl->ClLock); UNLOCK(cl->ClLock);
@ -1104,7 +1103,7 @@ Yap_absmi(int inp)
/* unmark the indexing code */ /* unmark the indexing code */
/* mark the indexing code */ /* mark the indexing code */
{ {
LogUpdClause *cl = (LogUpdClause *)PREG->u.l.l; LogUpdIndex *cl = (LogUpdIndex *)PREG->u.l.l;
PREG = NEXTOP(PREG, l); PREG = NEXTOP(PREG, l);
/* check if we are the ones using this code */ /* check if we are the ones using this code */
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
@ -1118,19 +1117,19 @@ Yap_absmi(int inp)
/* I am the last one using this clause, hence I don't need a lock /* I am the last one using this clause, hence I don't need a lock
to dispose of it to dispose of it
*/ */
Yap_ErLogUpdCl(cl); Yap_RemoveLogUpdIndex(cl);
} else { } else {
UNLOCK(cl->ClLock); UNLOCK(cl->ClLock);
} }
#else #else
if (cl->u2.ClUse == TR-(tr_fr_ptr)(Yap_TrailBase)) { if (cl->ClUse == TR-(tr_fr_ptr)(Yap_TrailBase)) {
cl->u2.ClUse = 0; cl->ClUse = 0;
cl->ClFlags &= ~InUseMask; cl->ClFlags &= ~InUseMask;
/* clear the entry from the trail */ /* clear the entry from the trail */
TR = --(B->cp_tr); TR = --(B->cp_tr);
/* next, recover space for the indexing code if it was erased */ /* next, recover space for the indexing code if it was erased */
if (cl->ClFlags & ErasedMask) { if (cl->ClFlags & ErasedMask) {
Yap_ErLogUpdCl(cl); Yap_RemoveLogUpdIndex(cl);
} }
} }
#endif #endif
@ -1169,6 +1168,91 @@ Yap_absmi(int inp)
GONext(); GONext();
ENDBOp(); ENDBOp();
/* copy database term */
BOp(copy_idb_term, e);
{
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
Term t;
t = Yap_FetchTermFromDB(cl->ClSource, 3);
if (!Yap_IUnify(ARG2, t)) {
FAIL();
}
if (!Yap_IUnify(ARG3, MkDBRefTerm((DBRef)cl))) {
FAIL();
}
#if defined(YAPOR) || defined(THREADS)
LOCK(cl->ClLock);
/* always add an extra reference */
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
UNLOCK(cl->ClLock);
#else
if (!(cl->ClFlags |= InUseMask)) {
/* Clause *cl = (Clause *)PREG->u.EC.ClBase;
PREG->u.EC.ClTrail = TR-(tr_fr_ptr)Yap_TrailBase;
PREG->u.EC.ClENV = LCL0-YENV;*/
cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl);
}
#endif
}
PREG = CPREG;
YREG = ENV;
#ifdef DEPTH_LIMIT
DEPTH = YREG[E_DEPTH];
#endif
GONext();
ENDBOp();
/* unify with database term */
BOp(unify_idb_term, e);
{
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
if (!Yap_IUnify(ARG2, cl->ClSource->Entry)) {
FAIL();
}
if (!Yap_IUnify(ARG3, MkDBRefTerm((DBRef)cl))) {
FAIL();
}
/* say that an environment is using this clause */
/* we have our own copy for the clause */
#if defined(YAPOR) || defined(THREADS)
LOCK(cl->ClLock);
/* always add an extra reference */
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
UNLOCK(cl->ClLock);
#else
if (!(cl->ClFlags |= InUseMask)) {
/* Clause *cl = (Clause *)PREG->u.EC.ClBase;
PREG->u.EC.ClTrail = TR-(tr_fr_ptr)Yap_TrailBase;
PREG->u.EC.ClENV = LCL0-YENV;*/
cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl);
}
#endif
}
PREG = CPREG;
YREG = ENV;
#ifdef DEPTH_LIMIT
DEPTH = YREG[E_DEPTH];
#endif
GONext();
ENDBOp();
/***************************************************************** /*****************************************************************
* try and retry of dynamic predicates * * try and retry of dynamic predicates *
*****************************************************************/ *****************************************************************/
@ -1185,7 +1269,7 @@ Yap_absmi(int inp)
/* try_and_mark Label,NArgs */ /* try_and_mark Label,NArgs */
BOp(try_and_mark, ld); BOp(try_and_mark, ld);
check_trail(); check_trail(TR);
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
#ifdef YAPOR #ifdef YAPOR
/* The flags I check here should never change during execution */ /* The flags I check here should never change during execution */
@ -1461,25 +1545,25 @@ Yap_absmi(int inp)
#endif #endif
{ {
register CELL flags; register CELL flags;
CELL *pt0 = RepPair(d1); CELL *pt1 = RepPair(d1);
#ifdef FROZEN_STACKS /* TRAIL */ #ifdef FROZEN_STACKS /* TRAIL */
/* avoid frozen segments */ /* avoid frozen segments */
#ifdef SBA #ifdef SBA
if ((ADDR) pt0 >= HeapTop) if ((ADDR) pt1 >= HeapTop)
#else #else
if ((ADDR) pt0 >= Yap_TrailBase) if ((ADDR) pt1 >= Yap_TrailBase)
#endif #endif
{ {
pt0 = (tr_fr_ptr) pt0; pt1 = (tr_fr_ptr) pt1;
goto failloop; goto failloop;
} }
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
flags = *pt0; flags = *pt1;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (!FlagOn(DBClMask, flags)) { if (!FlagOn(DBClMask, flags)) {
if (flags & LogUpdMask) { if (flags & LogUpdMask) {
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt0); LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
int erase; int erase;
LOCK(cl->ClLock); LOCK(cl->ClLock);
DEC_CLREF_COUNT(cl); DEC_CLREF_COUNT(cl);
@ -1493,7 +1577,7 @@ Yap_absmi(int inp)
Yap_ErLogUpdCl(cl); Yap_ErLogUpdCl(cl);
setregs(); setregs();
} else { } else {
DynamicClause *cl = ClauseFlagsToDynamicClause(pt0); DynamicClause *cl = ClauseFlagsToDynamicClause(pt1);
int erase; int erase;
LOCK(cl->ClLock); LOCK(cl->ClLock);
DEC_CLREF_COUNT(cl); DEC_CLREF_COUNT(cl);
@ -1509,7 +1593,7 @@ Yap_absmi(int inp)
} }
} }
} else { } else {
DBRef dbr = DBStructFlagsToDBStruct(pt0); DBRef dbr = DBStructFlagsToDBStruct(pt1);
int erase; int erase;
LOCK(dbr->lock); LOCK(dbr->lock);
@ -1524,18 +1608,18 @@ Yap_absmi(int inp)
} }
#else #else
ResetFlag(InUseMask, flags); ResetFlag(InUseMask, flags);
*pt0 = flags; *pt1 = flags;
if (FlagOn(ErasedMask, flags)) { if (FlagOn(ErasedMask, flags)) {
if (FlagOn(DBClMask, flags)) { if (FlagOn(DBClMask, flags)) {
saveregs(); saveregs();
Yap_ErDBE(DBStructFlagsToDBStruct(pt0)); Yap_ErDBE(DBStructFlagsToDBStruct(pt1));
setregs(); setregs();
} else { } else {
saveregs(); saveregs();
if (flags & LogUpdMask) { if (flags & LogUpdMask) {
Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(pt0)); Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(pt1));
} else { } else {
Yap_ErCl(ClauseFlagsToDynamicClause(pt0)); Yap_ErCl(ClauseFlagsToDynamicClause(pt1));
} }
setregs(); setregs();
} }
@ -1756,6 +1840,11 @@ Yap_absmi(int inp)
PredEntry *pt0; PredEntry *pt0;
CACHE_Y_AS_ENV(YREG); CACHE_Y_AS_ENV(YREG);
pt0 = PREG->u.p.p; pt0 = PREG->u.p.p;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,pt0,XREGS+1);
}
#endif /* LOW_LEVEL_TRACE */
CACHE_A1(); CACHE_A1();
ALWAYS_LOOKAHEAD(pt0->OpcodeOfPred); ALWAYS_LOOKAHEAD(pt0->OpcodeOfPred);
BEGD(d0); BEGD(d0);
@ -1776,11 +1865,6 @@ Yap_absmi(int inp)
} else if (pt0->ModuleOfPred) } else if (pt0->ModuleOfPred)
DEPTH -= MkIntConstant(2); DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,pt0,XREGS+1);
}
#endif /* LOW_LEVEL_TRACE */
/* this is the equivalent to setting up the stack */ /* this is the equivalent to setting up the stack */
ALWAYS_GONext(); ALWAYS_GONext();
ALWAYS_END_PREFETCH(); ALWAYS_END_PREFETCH();
@ -1789,14 +1873,31 @@ Yap_absmi(int inp)
ENDBOp(); ENDBOp();
NoStackExecute: NoStackExecute:
SREG = (CELL *) PREG->u.p.p; if (CFREG == (CELL)(LCL0+2)) {
if (CFREG == (CELL)(LCL0+1)) PredEntry *ap = PREG->u.p.p;
{ if (ap->PredFlags & HiddenPredFlag) {
ASP = YREG+E_CB; /* we have to execute the instruction without performing the test */
if (ASP > (CELL *)B) CACHE_Y_AS_ENV(YREG);
ASP = (CELL *)B; CACHE_A1();
goto noheapleft; ALWAYS_LOOKAHEAD(ap->OpcodeOfPred);
PREG = ap->CodeOfPred;
E_YREG[E_CB] = (CELL)B;
check_depth(DEPTH, ap);
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
ENDCACHE_Y_AS_ENV();
} else {
SREG = (CELL *) ap;
goto creep;
} }
}
SREG = (CELL *) PREG->u.p.p;
if (CFREG == (CELL)(LCL0+1)) {
ASP = YREG+E_CB;
if (ASP > (CELL *)B)
ASP = (CELL *)B;
goto noheapleft;
}
if (CFREG != CalculateStackGap()) if (CFREG != CalculateStackGap())
goto creep; goto creep;
else else
@ -1805,7 +1906,11 @@ Yap_absmi(int inp)
/* dexecute Label */ /* dexecute Label */
/* joint deallocate and execute */ /* joint deallocate and execute */
BOp(dexecute, p); BOp(dexecute, p);
CACHE_Y_AS_ENV(YREG); #ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,PREG->u.p.p,XREGS+1);
#endif /* LOW_LEVEL_TRACER */
CACHE_Y_AS_ENV(YREG);
{ {
PredEntry *pt0; PredEntry *pt0;
@ -1825,10 +1930,6 @@ Yap_absmi(int inp)
} else if (pt0->ModuleOfPred) } else if (pt0->ModuleOfPred)
DEPTH -= MkIntConstant(2); DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pt0,XREGS+1);
#endif /* LOW_LEVEL_TRACER */
PREG = pt0->CodeOfPred; PREG = pt0->CodeOfPred;
ALWAYS_LOOKAHEAD(pt0->OpcodeOfPred); ALWAYS_LOOKAHEAD(pt0->OpcodeOfPred);
/* do deallocate */ /* do deallocate */
@ -1873,6 +1974,10 @@ Yap_absmi(int inp)
ENDBOp(); ENDBOp();
BOp(call, sla); BOp(call, sla);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,PREG->u.sla.sla_u.p,XREGS+1);
#endif /* LOW_LEVEL_TRACER */
CACHE_Y_AS_ENV(YREG); CACHE_Y_AS_ENV(YREG);
{ {
PredEntry *pt; PredEntry *pt;
@ -1897,10 +2002,6 @@ Yap_absmi(int inp)
} else if (pt->ModuleOfPred) } else if (pt->ModuleOfPred)
DEPTH -= MkIntConstant(2); DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pt,XREGS+1);
#endif /* LOW_LEVEL_TRACER */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
{ {
choiceptr top_b = PROTECT_FROZEN_B(B); choiceptr top_b = PROTECT_FROZEN_B(B);
@ -1929,6 +2030,46 @@ Yap_absmi(int inp)
NoStackCall: NoStackCall:
/* on X86 machines S will not actually be holding the pointer to pred */ /* on X86 machines S will not actually be holding the pointer to pred */
if (CFREG == (CELL)(LCL0+2)) {
PredEntry *ap = PREG->u.sla.sla_u.p;
if (ap->PredFlags & HiddenPredFlag) {
CACHE_Y_AS_ENV(YREG);
CACHE_A1();
ENV = E_YREG;
/* Try to preserve the environment */
E_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s);
CPREG = NEXTOP(PREG, sla);
ALWAYS_LOOKAHEAD(ap->OpcodeOfPred);
PREG = ap->CodeOfPred;
check_depth(DEPTH, ap);
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef SBA
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
#else
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
#endif
}
#else
if (E_YREG > (CELL *) B) {
E_YREG = (CELL *) B;
}
#endif /* FROZEN_STACKS */
WRITEBACK_Y_AS_ENV();
/* setup GB */
E_YREG[E_CB] = (CELL) B;
#ifdef YAPOR
SCH_check_requests();
#endif /* YAPOR */
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
ENDCACHE_Y_AS_ENV();
} else {
SREG = (CELL *) ap;
goto creepc;
}
}
SREG = (CELL *) PREG->u.sla.sla_u.p; SREG = (CELL *) PREG->u.sla.sla_u.p;
if (CFREG == (CELL)(LCL0+1)) { if (CFREG == (CELL)(LCL0+1)) {
ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s); ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s);
@ -1946,8 +2087,6 @@ Yap_absmi(int inp)
} }
} }
#endif #endif
if (CFREG != CalculateStackGap())
goto creepc;
ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s); ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s);
if (ASP > (CELL *)B) if (ASP > (CELL *)B)
ASP = (CELL *)B; ASP = (CELL *)B;
@ -2084,6 +2223,47 @@ Yap_absmi(int inp)
goto creep; goto creep;
NoStackDExecute: NoStackDExecute:
if (CFREG == (CELL)(LCL0+2)) {
PredEntry *ap = PREG->u.p.p;
if (ap->PredFlags & HiddenPredFlag) {
CACHE_Y_AS_ENV(YREG);
CACHE_A1();
check_depth(DEPTH, ap);
PREG = ap->CodeOfPred;
ALWAYS_LOOKAHEAD(ap->OpcodeOfPred);
/* do deallocate */
CPREG = (yamop *) E_YREG[E_CP];
E_YREG = ENV = (CELL *) E_YREG[E_E];
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef SBA
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
#else
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
#endif
else E_YREG = (CELL *)((CELL)E_YREG + ENV_Size(CPREG));
}
#else
if (E_YREG > (CELL *)B) {
E_YREG = (CELL *)B;
} else {
E_YREG = (CELL *) ((CELL) E_YREG + ENV_Size(CPREG));
}
#endif /* FROZEN_STACKS */
WRITEBACK_Y_AS_ENV();
/* setup GB */
E_YREG[E_CB] = (CELL) B;
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
ENDCACHE_Y_AS_ENV();
} else {
SREG = (CELL *) ap;
goto creepde;
}
}
/* set SREG for next instructions */ /* set SREG for next instructions */
SREG = (CELL *) PREG->u.p.p; SREG = (CELL *) PREG->u.p.p;
if (CFREG == (CELL)(LCL0+1)) { if (CFREG == (CELL)(LCL0+1)) {
@ -2322,7 +2502,7 @@ Yap_absmi(int inp)
#ifdef COROUTINING #ifdef COROUTINING
} }
#endif #endif
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEvel_TRACER
if (Yap_do_low_level_trace) if (Yap_do_low_level_trace)
low_level_trace(enter_pred,(PredEntry *)(SREG),XREGS+1); low_level_trace(enter_pred,(PredEntry *)(SREG),XREGS+1);
#endif /* LOW_LEVEL_TRACE */ #endif /* LOW_LEVEL_TRACE */
@ -6097,6 +6277,42 @@ Yap_absmi(int inp)
JMPNext(); JMPNext();
ENDBOp(); ENDBOp();
BOp(expand_index, e);
saveregs();
{
PredEntry *pe = PredFromExpandCode(PREG);
/* update ASP before calling IPred */
ASP = YREG+E_CB;
if (ASP > (CELL *) B) {
ASP = (CELL *) B;
}
Yap_ExpandIndex(pe);
/* restart index */
setregs();
CACHED_A1() = ARG1;
PREG = pe->CodeOfPred;
JMPNext();
}
ENDBOp();
BOp(check_var_for_index, xxp);
{
CELL *pt0 = XREGS+PREG->u.xxp.x;
do {
if (!IsVarTerm(*pt0)) {
saveregs();
Yap_RemoveIndexation(PREG->u.xxp.p);
setregs();
PREG = PREG->u.xxp.p->CodeOfPred;
JMPNext();
}
pt0++;
} while (pt0 <= XREGS+PREG->u.xxp.x1);
}
PREG = NEXTOP(PREG,xxp);
JMPNext();
ENDBOp();
BOp(undef_p, e); BOp(undef_p, e);
/* save S for module name */ /* save S for module name */
{ {
@ -6179,7 +6395,7 @@ Yap_absmi(int inp)
BOp(spy_pred, e); BOp(spy_pred, e);
{ {
PredEntry *pe = PredFromDefCode(PREG); PredEntry *pe = PredFromDefCode(PREG);
if (!(FlipFlop ^= 1)) { if (FlipFlop == 0) {
READ_LOCK(pe->PRWLock); READ_LOCK(pe->PRWLock);
PREG = pe->cs.p_code.TrueCodeOfPred; PREG = pe->cs.p_code.TrueCodeOfPred;
READ_UNLOCK(pe->PRWLock); READ_UNLOCK(pe->PRWLock);
@ -6252,7 +6468,7 @@ Yap_absmi(int inp)
\************************************************************************/ \************************************************************************/
BOp(try_clause, ld); BOp(try_clause, ld);
check_trail(); check_trail(TR);
CACHE_Y(YREG); CACHE_Y(YREG);
/* Point AP to the code that follows this instruction */ /* Point AP to the code that follows this instruction */
store_at_least_one_arg(PREG->u.ld.s); store_at_least_one_arg(PREG->u.ld.s);
@ -6538,7 +6754,7 @@ Yap_absmi(int inp)
#define HASH_SHIFT 6 #define HASH_SHIFT 6
BOp(switch_on_func, s); BOp(switch_on_func, sl);
BEGD(d1); BEGD(d1);
d1 = *SREG++; d1 = *SREG++;
/* we use a very simple hash function to find elements in a /* we use a very simple hash function to find elements in a
@ -6546,10 +6762,10 @@ Yap_absmi(int inp)
{ {
register CELL register CELL
/* first, calculate the mask */ /* first, calculate the mask */
Mask = (PREG->u.s.s - 1) << 1, /* next, calculate the hash function */ Mask = (PREG->u.sl.s - 1) << 1, /* next, calculate the hash function */
hash = d1 >> (HASH_SHIFT - 1) & Mask; hash = d1 >> (HASH_SHIFT - 1) & Mask;
PREG = NEXTOP(PREG, s); PREG = (yamop *)(PREG->u.sl.l);
/* PREG now points at the beginning of the hash table */ /* PREG now points at the beginning of the hash table */
BEGP(pt0); BEGP(pt0);
/* pt0 will always point at the item */ /* pt0 will always point at the item */
@ -6582,7 +6798,7 @@ Yap_absmi(int inp)
ENDD(d1); ENDD(d1);
ENDBOp(); ENDBOp();
BOp(switch_on_cons, s); BOp(switch_on_cons, sl);
BEGD(d1); BEGD(d1);
d1 = I_R; d1 = I_R;
/* we use a very simple hash function to find elements in a /* we use a very simple hash function to find elements in a
@ -6590,10 +6806,10 @@ Yap_absmi(int inp)
{ {
register CELL register CELL
/* first, calculate the mask */ /* first, calculate the mask */
Mask = (PREG->u.s.s - 1) << 1, /* next, calculate the hash function */ Mask = (PREG->u.sl.s - 1) << 1, /* next, calculate the hash function */
hash = d1 >> (HASH_SHIFT - 1) & Mask; hash = d1 >> (HASH_SHIFT - 1) & Mask;
PREG = NEXTOP(PREG, s); PREG = (yamop *)(PREG->u.sl.l);
/* PREG now points at the beginning of the hash table */ /* PREG now points at the beginning of the hash table */
BEGP(pt0); BEGP(pt0);
/* pt0 will always point at the item */ /* pt0 will always point at the item */
@ -6626,77 +6842,81 @@ Yap_absmi(int inp)
ENDD(d1); ENDD(d1);
ENDBOp(); ENDBOp();
BOp(go_on_func, fll); BOp(go_on_func, sl);
BEGD(d0); BEGD(d0);
d0 = *SREG++; {
if (d0 == (CELL) (PREG->u.fll.f)) { CELL *pt = (CELL *)(PREG->u.sl.l);
PREG = (yamop *) (PREG->u.fll.l1);
JMPNext(); d0 = *SREG++;
} if (d0 == pt[0]) {
else { PREG = (yamop *) pt[1];
PREG = (yamop *) (PREG->u.fll.l2); JMPNext();
JMPNext(); } else {
PREG = (yamop *) pt[3];
JMPNext();
}
} }
ENDD(d0); ENDD(d0);
ENDBOp(); ENDBOp();
BOp(go_on_cons, cll); BOp(go_on_cons, sl);
BEGD(d0); BEGD(d0);
d0 = I_R; {
if (d0 == PREG->u.cll.c) { CELL *pt = (CELL *)(PREG->u.sl.l);
PREG = (yamop *) (PREG->u.cll.l1);
JMPNext(); d0 = I_R;
} if (d0 == pt[0]) {
else { PREG = (yamop *) pt[1];
PREG = (yamop *) (PREG->u.cll.l2); JMPNext();
JMPNext(); } else {
PREG = (yamop *) pt[3];
JMPNext();
}
} }
ENDD(d0); ENDD(d0);
ENDBOp(); ENDBOp();
BOp(if_func, sl); BOp(if_func, sl);
BEGD(d1); BEGD(d1);
d1 = *SREG++;
BEGD(d0);
BEGP(pt0); BEGP(pt0);
d0 = PREG->u.sl.s; pt0 = (CELL *) PREG->u.sl.l;
pt0 = (CELL *) NEXTOP(PREG, sl); d1 = *SREG++;
while (d0-- > 0) { while (pt0[0] != d1 && pt0[0] != (CELL)NULL ) {
if (pt0[0] == d1) { pt0 += 2;
PREG = (yamop *) (pt0[1]);
JMPNext();
}
else
pt0 += 2;
} }
PREG = PREG->u.sl.l; PREG = (yamop *) (pt0[1]);
JMPNext(); JMPNext();
ENDP(pt0); ENDP(pt0);
ENDD(d0);
ENDD(d1); ENDD(d1);
ENDBOp(); ENDBOp();
BOp(if_cons, sl); BOp(if_cons, sl);
BEGD(d1); BEGD(d1);
d1 = I_R;
BEGD(d0);
BEGP(pt0); BEGP(pt0);
d0 = PREG->u.sl.s; pt0 = (CELL *) PREG->u.sl.l;
pt0 = (CELL *) NEXTOP(PREG, sl); d1 = I_R;
while (d0-- > 0) { while (pt0[0] != d1 && pt0[0] != 0L ) {
if (pt0[0] == d1) { pt0 += 2;
PREG = (yamop *) (pt0[1]);
JMPNext();
}
else
pt0 += 2;
} }
PREG = PREG->u.sl.l; PREG = (yamop *) (pt0[1]);
JMPNext(); JMPNext();
ENDP(pt0); ENDP(pt0);
ENDD(d0);
ENDD(d1); ENDD(d1);
ENDBOp(); ENDBOp();
Op(index_dbref, e);
PREG = NEXTOP(PREG, e);
I_R = AbsAppl(SREG-1);
GONext();
ENDOp();
Op(index_blob, e);
PREG = NEXTOP(PREG, e);
I_R = MkIntTerm(SREG[0]);
GONext();
ENDOp();
/************************************************************************\ /************************************************************************\
* Basic Primitive Predicates * * Basic Primitive Predicates *
@ -9193,15 +9413,29 @@ Yap_absmi(int inp)
while (TR != pt0) { while (TR != pt0) {
BEGD(d1); BEGD(d1);
d1 = TrailTerm(--TR); d1 = TrailTerm(--TR);
if (IsVarTerm(d1)) {
#if defined(SBA) && defined(YAPOR) #if defined(SBA) && defined(YAPOR)
/* clean up the trail when we backtrack */ /* clean up the trail when we backtrack */
if (Unsigned((Int)(d1)-(Int)(H_FZ)) > if (Unsigned((Int)(d1)-(Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) { Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
RESET_VARIABLE(STACK_TO_SBA(d1)); RESET_VARIABLE(STACK_TO_SBA(d1));
} else } else
#endif #endif
/* normal variable */ /* normal variable */
RESET_VARIABLE(d1); RESET_VARIABLE(d1);
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else /* if (IsApplTerm(d1)) */ {
CELL *pt = RepAppl(d1);
/* AbsAppl means */
/* multi-assignment variable */
/* so the next cell is the old value */
#if FROZEN_STACKS
pt[0] = TrailVal(--TR);
#else
pt[0] = TrailTerm(--TR);
#endif
#endif
}
ENDD(d1); ENDD(d1);
} }
HBREG = B->cp_h; HBREG = B->cp_h;
@ -10983,8 +11217,7 @@ Yap_absmi(int inp)
#ifndef NO_CHECKING #ifndef NO_CHECKING
check_stack(NoStackPExecute, H); check_stack(NoStackPExecute, H);
#endif #endif
CPREG = CPREG = NEXTOP(PREG, sla);
(yamop *) NEXTOP(PREG, sla);
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred); ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
PREG = pen->CodeOfPred; PREG = pen->CodeOfPred;
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
@ -11030,7 +11263,7 @@ Yap_absmi(int inp)
#ifdef COROUTINING #ifdef COROUTINING
if (CFREG == Unsigned(LCL0)) { if (CFREG == Unsigned(LCL0)) {
if (Yap_ReadTimedVar(WokenGoals) != TermNil) if (Yap_ReadTimedVar(WokenGoals) != TermNil)
goto creep; goto creep_pe;
else { else {
CFREG = CalculateStackGap(); CFREG = CalculateStackGap();
goto execute_end; goto execute_end;
@ -11038,7 +11271,7 @@ Yap_absmi(int inp)
} }
#endif #endif
if (CFREG != CalculateStackGap()) if (CFREG != CalculateStackGap())
goto creep; goto creep_pe;
saveregs(); saveregs();
if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, sla))) { if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, sla))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
@ -11049,6 +11282,10 @@ Yap_absmi(int inp)
} }
ENDBOp(); ENDBOp();
creep_pe: /* do creep in call */
CPREG = NEXTOP(PREG, sla);
goto creep;
BOp(p_execute_tail, e); BOp(p_execute_tail, e);
{ {
PredEntry *pen; PredEntry *pen;
@ -11264,18 +11501,52 @@ Yap_absmi(int inp)
WRITEBACK_Y_AS_ENV(); WRITEBACK_Y_AS_ENV();
SREG = (CELL *) pen; SREG = (CELL *) pen;
ASP = E_YREG; ASP = E_YREG;
if (CFREG == (CELL)(LCL0+1)) {
CFREG = CalculateStackGap();
saveregs();
if (!Yap_growheap(FALSE, 0)) {
Yap_Error(SYSTEM_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
setregs();
FAIL();
}
setregs();
goto execute_after_comma;
}
#ifdef COROUTINING #ifdef COROUTINING
if (CFREG == Unsigned(LCL0)) { if (CFREG == Unsigned(LCL0)) {
if (Yap_ReadTimedVar(WokenGoals) != TermNil) if (Yap_ReadTimedVar(WokenGoals) != TermNil)
goto creep; goto execute_after_comma;
else { else {
CFREG = CalculateStackGap(); CFREG = CalculateStackGap();
goto execute_after_comma; goto execute_after_comma;
} }
} }
#endif #endif
/* debugger */
if (CFREG == (CELL)(LCL0+2)) {
if (pen->PredFlags & HiddenPredFlag) {
PREG = pen->CodeOfPred;
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
E_YREG[E_CB] = (CELL)B;
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pen->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (pen->ModuleOfPred) {
DEPTH -= MkIntConstant(2);
}
#endif /* DEPTH_LIMIT */
/* do deallocate */
WRITEBACK_Y_AS_ENV();
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
} else goto creep;
}
if (CFREG != CalculateStackGap()) if (CFREG != CalculateStackGap())
goto creep; goto execute_after_comma;
ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s); ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s);
if (ASP > (CELL *)B) if (ASP > (CELL *)B)
ASP = (CELL *)B; ASP = (CELL *)B;