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

cleanup: typecast to yamop * instead of CODEADDR wherever possible.

Browse Source 
Fix integer(233333833838383) fails bug (Roberto Bagnara).


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@733 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
2002-12-27 16:53:09 +00:00
parent 6d0e6345be
commit e2edae71c7
24 changed files with 688 additions and 827 deletions
Download Patch File Download Diff File Expand all files Collapse all files

389
C/absmi.c
View File

@@ -1176,18 +1176,17 @@ Yap_absmi(int inp)
CUT_wait_leftmost();
#endif /* YAPOR */
READ_LOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
if (((PredEntry *)(PREG->u.ld.p))->CodeOfPred !=
(CODEADDR)PREG) {
if (PREG->u.ld.p->CodeOfPred != PREG) {
/* oops, someone changed the procedure under our feet,
fortunately this is no big deal because we haven't done
anything yet */
READ_UNLOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
PREG = (yamop *)(((PredEntry *)(PREG->u.ld.p))->CodeOfPred);
PREG = PREG->u.ld.p->CodeOfPred;
JMPNext();
}
#endif
CACHE_Y(YREG);
PREG = (yamop *) (PREG->u.ld.d);
PREG = PREG->u.ld.d;
/*
I've got a read lock on the DB, so I don't need to care...
niaaahh.... niahhhh...
@@ -1256,7 +1255,7 @@ Yap_absmi(int inp)
/* need to make the DB stable until I get the new clause */
READ_LOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
CACHE_Y(B);
PREG = (yamop *) (PREG->u.ld.d);
PREG = PREG->u.ld.d;
LOCK(DynamicLock(PREG));
READ_UNLOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
restore_yaam_regs(PREG);
@@ -1736,44 +1735,45 @@ Yap_absmi(int inp)
/* Macros for stack trimming */
/* execute Label */
BOp(execute, l);
BEGP(pt0);
CACHE_Y_AS_ENV(YREG);
pt0 = (CELL *) (PREG->u.l.l);
CACHE_A1();
ALWAYS_LOOKAHEAD(PredOpCode(pt0));
BEGD(d0);
d0 = (CELL)B;
BOp(execute, p);
{
PredEntry *pt0;
CACHE_Y_AS_ENV(YREG);
pt0 = PREG->u.p.p;
CACHE_A1();
ALWAYS_LOOKAHEAD(pt0->OpcodeOfPred);
BEGD(d0);
d0 = (CELL)B;
#ifndef NO_CHECKING
check_stack(NoStackExecute, H);
check_stack(NoStackExecute, H);
#endif
PREG = (yamop *) PredCode(pt0);
E_YREG[E_CB] = d0;
ENDD(d0);
PREG = pt0->CodeOfPred;
E_YREG[E_CB] = d0;
ENDD(d0);
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
if (Module(pt0)) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (Module(pt0))
DEPTH -= MkIntConstant(2);
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
if (pt0->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (pt0->ModuleOfPred)
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,pred_entry(pt0),XREGS+1);
}
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 */
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
ENDCACHE_Y_AS_ENV();
ENDP(pt0);
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
ENDCACHE_Y_AS_ENV();
}
ENDBOp();
NoStackExecute:
SREG = (CELL *) pred_entry(PREG->u.l.l);
SREG = (CELL *) PREG->u.p.p;
if (CFREG == (CELL)(LCL0+1))
{
ASP = YREG+E_CB;
@@ -1788,59 +1788,61 @@ Yap_absmi(int inp)
/* dexecute Label */
/* joint deallocate and execute */
BOp(dexecute, l);
BOp(dexecute, p);
CACHE_Y_AS_ENV(YREG);
BEGP(pt0);
CACHE_A1();
pt0 = (CELL *) (PREG->u.l.l);
{
PredEntry *pt0;
CACHE_A1();
pt0 = PREG->u.p.p;
#ifndef NO_CHECKING
/* check stacks */
check_stack(NoStackDExecute, H);
/* check stacks */
check_stack(NoStackDExecute, H);
#endif
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (Module(pt0)) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (Module(pt0))
DEPTH -= MkIntConstant(2);
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pt0->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (pt0->ModuleOfPred)
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pred_entry(pt0),XREGS+1);
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pt0,XREGS+1);
#endif /* LOW_LEVEL_TRACER */
PREG = (yamop *) PredCode(pt0);
ALWAYS_LOOKAHEAD(PredOpCode(pt0));
/* do deallocate */
CPREG = (yamop *) E_YREG[E_CP];
E_YREG = ENV = (CELL *) E_YREG[E_E];
PREG = pt0->CodeOfPred;
ALWAYS_LOOKAHEAD(pt0->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);
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef SBA
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
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;
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
#endif
else E_YREG = (CELL *)((CELL)E_YREG + ENV_Size(CPREG));
}
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));
}
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();
ENDP(pt0);
WRITEBACK_Y_AS_ENV();
/* setup GB */
E_YREG[E_CB] = (CELL) B;
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
}
ENDCACHE_Y_AS_ENV();
ENDBOp();
@@ -1856,32 +1858,32 @@ Yap_absmi(int inp)
BOp(call, sla);
CACHE_Y_AS_ENV(YREG);
BEGP(pt0);
pt0 = (CELL *) (PREG->u.sla.l);
CACHE_A1();
{
PredEntry *pt;
pt = PREG->u.sla.sla_u.p;
CACHE_A1();
#ifndef NO_CHECKING
check_stack(NoStackCall, H);
check_stack(NoStackCall, H);
#endif
ENV = E_YREG;
/* Try to preserve the environment */
E_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s);
CPREG =
(yamop *) NEXTOP(PREG, sla);
ALWAYS_LOOKAHEAD(PredOpCode(pt0));
PREG = (yamop *) PredCode(pt0);
ENV = E_YREG;
/* Try to preserve the environment */
E_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s);
CPREG = NEXTOP(PREG, sla);
ALWAYS_LOOKAHEAD(pt->OpcodeOfPred);
PREG = pt->CodeOfPred;
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (Module(pt0)) {
if (pt->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (Module(pt0))
} else if (pt->ModuleOfPred)
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pred_entry(pt0),XREGS+1);
low_level_trace(enter_pred,pt,XREGS+1);
#endif /* LOW_LEVEL_TRACER */
#ifdef FROZEN_STACKS
{
@@ -1905,13 +1907,13 @@ Yap_absmi(int inp)
#endif /* YAPOR */
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
ENDP(pt0);
}
ENDCACHE_Y_AS_ENV();
ENDBOp();
NoStackCall:
/* on X86 machines S will not actually be holding the pointer to pred */
SREG = (CELL *) PREG->u.sla.p;
SREG = (CELL *) PREG->u.sla.sla_u.p;
if (CFREG == (CELL)(LCL0+1)) {
ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s);
if (ASP > (CELL *)B)
@@ -2067,7 +2069,7 @@ Yap_absmi(int inp)
NoStackDExecute:
/* set SREG for next instructions */
SREG = (CELL *) pred_entry(PREG->u.l.l);
SREG = (CELL *) PREG->u.p.p;
if (CFREG == (CELL)(LCL0+1)) {
ASP = YREG+E_CB;
if (ASP > (CELL *)B)
@@ -2308,7 +2310,7 @@ Yap_absmi(int inp)
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,(PredEntry *)(SREG),XREGS+1);
#endif /* LOW_LEVEL_TRACE */
PREG = (yamop *) ((PredEntry *)(SREG))->CodeOfPred;
PREG = ((PredEntry *)(SREG))->CodeOfPred;
CACHE_A1();
JMPNext();
@@ -5629,7 +5631,7 @@ Yap_absmi(int inp)
\************************************************************************/
BOp(jump, l);
PREG = (yamop *) (PREG->u.l.l);
PREG = PREG->u.l.l;
JMPNext();
ENDBOp();
@@ -5682,7 +5684,7 @@ Yap_absmi(int inp)
#endif /* FROZEN_STACKS */
pt1 = (choiceptr)(((CELL *) pt1)-1);
*(CELL **) pt1 = YREG;
store_yaam_regs_for_either(PREG->u.sla.l, PREG);
store_yaam_regs_for_either(PREG->u.sla.sla_u.l, PREG);
SREG = (CELL *) (B = pt1);
#ifdef YAPOR
SCH_set_load(pt1);
@@ -5705,10 +5707,10 @@ Yap_absmi(int inp)
SET_BB(PROTECT_FROZEN_B(B));
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
SCH_new_alternative(PREG, (yamop *) (PREG->u.sla.l));
SCH_new_alternative(PREG, PREG->u.sla.sla_u.l);
} else
#endif /* YAPOR */
B->cp_ap = (yamop *) PREG->u.sla.l;
B->cp_ap = PREG->u.sla.sla_u.l;
PREG = NEXTOP(PREG, sla);
YREG = (CELL *) B->cp_a1;
GONext();
@@ -5829,13 +5831,13 @@ Yap_absmi(int inp)
#endif /* FROZEN_STACKS */
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,PREG->u.sla.p,XREGS+1);
low_level_trace(enter_pred,PREG->u.sla.sla_u.p,XREGS+1);
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
d0 = (CELL) (PREG->u.sla.l);
CPredicate f = PREG->u.sla.sla_u.p->cs.f_code;
PREG = NEXTOP(PREG, sla);
saveregs();
d0 = (*((Int (*)(void)) d0)) ();
d0 = (f)();
setregs();
if (!d0) {
FAIL();
@@ -5869,17 +5871,17 @@ Yap_absmi(int inp)
/* for slots to work */
*--ASP = MkIntTerm(0);
#endif /* FROZEN_STACKS */
{
PredEntry *p = PREG->u.sla.sla_u.p;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,PREG->u.sla.p,XREGS+1);
low_level_trace(enter_pred,p,XREGS+1);
#endif /* LOW_LEVEL_TRACE */
{
PredEntry *p = PREG->u.sla.p;
PREG = NEXTOP(PREG, sla);
saveregs();
save_machine_regs();
SREG = (CELL *) YAP_Execute(p, (CPredicate)(p->TrueCodeOfPred));
SREG = (CELL *) YAP_Execute(p, p->cs.f_code);
EX = 0L;
}
@@ -5917,14 +5919,14 @@ Yap_absmi(int inp)
ENDD(d0);
}
#endif /* FROZEN_STACKS */
BEGD(d0);
d0 = (CELL) (PREG->u.sdl.d);
saveregs();
SREG = (CELL *) (*((Int (*)(void)) d0)) ();
ENDD(d0);
{
CPredicate f = PREG->u.sdl.p->cs.f_code;
saveregs();
SREG = (CELL *)((f)());
}
setregs();
if (!SREG)
PREG = (yamop *) (PREG->u.sdl.l);
PREG = PREG->u.sdl.l;
else
PREG = NEXTOP(PREG, sdl);
CACHE_A1();
@@ -5948,13 +5950,11 @@ Yap_absmi(int inp)
TRYCC:
ASP = (CELL *)B;
saveregs();
BEGD(d0);
d0 = (CELL)PREG->u.lds.d;
SREG = (CELL *) (*((Int (*)(void)) (d0))) ();
ENDD(d0);
{
CPredicate f = (CPredicate)(PREG->u.lds.f);
saveregs();
SREG = (CELL *) ((f) ());
}
setregs();
if (!SREG) {
FAIL();
@@ -5967,7 +5967,7 @@ Yap_absmi(int inp)
HBREG = PROTECT_FROZEN_H(B);
SET_BB(B);
}
PREG = (yamop *) CPREG;
PREG = CPREG;
YREG = ENV;
JMPNext();
ENDBOp();
@@ -6008,7 +6008,7 @@ Yap_absmi(int inp)
ASP = YENV;
saveregs();
save_machine_regs();
SREG = (CELL *) YAP_Execute(PREG->u.lds.p, (CPredicate)(PREG->u.lds.d));
SREG = (CELL *) YAP_Execute(PREG->u.lds.p, (CPredicate)(PREG->u.lds.f));
EX = 0L;
restore_machine_regs();
setregs();
@@ -6022,7 +6022,7 @@ Yap_absmi(int inp)
YREG = ASP;
HBREG = PROTECT_FROZEN_H(B);
}
PREG = (yamop *) CPREG;
PREG = CPREG;
YREG = ENV;
CACHE_A1();
JMPNext();
@@ -6065,7 +6065,7 @@ Yap_absmi(int inp)
*/
if (PredFromDefCode(PREG)->OpcodeOfPred != INDEX_OPCODE) {
/* someone was here before we were */
PREG = (yamop *) PredFromDefCode(PREG)->CodeOfPred;
PREG = PredFromDefCode(PREG)->CodeOfPred;
WRITE_UNLOCK(PredFromDefCode(PREG)->PRWLock);
JMPNext();
}
@@ -6075,11 +6075,11 @@ Yap_absmi(int inp)
if (ASP > (CELL *) B) {
ASP = (CELL *) B;
}
Yap_IPred((CODEADDR)PredFromDefCode(PREG));
Yap_IPred(PredFromDefCode(PREG));
/* IPred can generate errors, it thus must get rid of the lock itself */
setregs();
CACHED_A1() = ARG1;
PREG = (yamop *) PredFromDefCode(PREG)->CodeOfPred;
PREG = PredFromDefCode(PREG)->CodeOfPred;
JMPNext();
ENDBOp();
@@ -6156,7 +6156,7 @@ Yap_absmi(int inp)
}
}
}
PREG = (yamop *)(UndefCode->CodeOfPred);
PREG = UndefCode->CodeOfPred;
CFREG = CalculateStackGap();
CACHE_A1();
JMPNext();
@@ -6167,7 +6167,7 @@ Yap_absmi(int inp)
PredEntry *pe = PredFromDefCode(PREG);
if (!(FlipFlop ^= 1)) {
READ_LOCK(pe->PRWLock);
PREG = (yamop *) pe->TrueCodeOfPred;
PREG = pe->cs.p_code.TrueCodeOfPred;
READ_UNLOCK(pe->PRWLock);
JMPNext();
}
@@ -6224,7 +6224,7 @@ Yap_absmi(int inp)
PredEntry *pt0;
pt0 = SpyCode;
P_before_spy = PREG;
PREG = (yamop *) (pt0->CodeOfPred);
PREG = pt0->CodeOfPred;
CACHE_A1();
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
@@ -6401,7 +6401,7 @@ Yap_absmi(int inp)
BEGD(d0);
d0 = ARG1;
/* deref it first */
PREG = (yamop *) (PREG->u.lds.d);
PREG = (yamop *) (PREG->u.lds.f);
deref_head(d0,trust_first_in_unk);
trust_first_in_nvar:
if (IsPairTerm(d0)) {
@@ -6579,7 +6579,7 @@ Yap_absmi(int inp)
BEGD(d0);
d0 = ARG1;
/* deref it first */
PREG = (yamop *) (PREG->u.lds.d);
PREG = (yamop *) (PREG->u.lds.f);
deref_head(d0,trust_tail_in_unk);
trust_tail_in_nvar:
if (IsPairTerm(d0)) {
@@ -7380,7 +7380,7 @@ Yap_absmi(int inp)
else
pt0 += 2;
}
PREG = (yamop *) (PREG->u.sl.l);
PREG = PREG->u.sl.l;
JMPNext();
ENDP(pt0);
ENDD(d0);
@@ -7635,13 +7635,26 @@ Yap_absmi(int inp)
deref_head(d0, integer_x_unk);
integer_x_nvar:
/* non variable */
if (IsIntTerm(d0) || IsLargeIntTerm(d0)) {
if (IsIntTerm(d0)) {
PREG = NEXTOP(PREG, x);
GONext();
}
else {
FAIL();
if (IsApplTerm(d0)) {
Functor f0 = FunctorOfTerm(d0);
if (IsExtensionFunctor(f0)) {
switch ((CELL)f0) {
case (CELL)FunctorLongInt:
#ifdef USE_GMP
case (CELL)FunctorBigInt:
#endif
PREG = NEXTOP(PREG, x);
GONext();
default:
FAIL();
}
}
}
FAIL();
BEGP(pt0);
deref_body(d0, pt0, integer_x_unk, integer_x_nvar);
@@ -7658,13 +7671,26 @@ Yap_absmi(int inp)
deref_head(d0, integer_y_unk);
integer_y_nvar:
/* non variable */
if (IsIntTerm(d0) || IsLargeIntTerm(d0)) {
PREG = NEXTOP(PREG, y);
if (IsIntTerm(d0)) {
PREG = NEXTOP(PREG, x);
GONext();
}
else {
FAIL();
if (IsApplTerm(d0)) {
Functor f0 = FunctorOfTerm(d0);
if (IsExtensionFunctor(f0)) {
switch ((CELL)f0) {
case (CELL)FunctorLongInt:
#ifdef USE_GMP
case (CELL)FunctorBigInt:
#endif
PREG = NEXTOP(PREG, y);
GONext();
default:
FAIL();
}
}
}
FAIL();
derefa_body(d0, pt0, integer_y_unk, integer_y_nvar);
FAIL();
@@ -7709,13 +7735,27 @@ Yap_absmi(int inp)
deref_head(d0, number_x_unk);
number_x_nvar:
/* non variable */
if (IsNumTerm(d0)) {
if (IsIntTerm(d0)) {
PREG = NEXTOP(PREG, x);
GONext();
}
else {
FAIL();
if (IsApplTerm(d0)) {
Functor f0 = FunctorOfTerm(d0);
if (IsExtensionFunctor(f0)) {
switch ((CELL)f0) {
case (CELL)FunctorLongInt:
case (CELL)FunctorDouble:
#ifdef USE_GMP
case (CELL)FunctorBigInt:
#endif
PREG = NEXTOP(PREG, x);
GONext();
default:
FAIL();
}
}
}
FAIL();
BEGP(pt0);
deref_body(d0, pt0, number_x_unk, number_x_nvar);
@@ -7732,13 +7772,28 @@ Yap_absmi(int inp)
deref_head(d0, number_y_unk);
number_y_nvar:
/* non variable */
if (IsNumTerm(d0)) {
PREG = NEXTOP(PREG, y);
/* non variable */
if (IsIntTerm(d0)) {
PREG = NEXTOP(PREG, x);
GONext();
}
else {
FAIL();
if (IsApplTerm(d0)) {
Functor f0 = FunctorOfTerm(d0);
if (IsExtensionFunctor(f0)) {
switch ((CELL)f0) {
case (CELL)FunctorLongInt:
case (CELL)FunctorDouble:
#ifdef USE_GMP
case (CELL)FunctorBigInt:
#endif
PREG = NEXTOP(PREG, y);
GONext();
default:
FAIL();
}
}
}
FAIL();
derefa_body(d0, pt0, number_y_unk, number_y_nvar);
FAIL();
@@ -9696,13 +9751,13 @@ Yap_absmi(int inp)
}
}
exec_bin_cmp_xx:
BEGD(d2);
d2 = (CELL)(PREG->u.lxx.l);
PREG = NEXTOP(PREG, lxx);
saveregs();
d0 = (CELL) (*((Int (*)(CELL, CELL)) d2)) (d0,d1);
{
CmpPredicate f = PREG->u.lxx.p->cs.d_code;
PREG = NEXTOP(PREG, lxx);
saveregs();
d0 = (CELL) (f) (d0,d1);
ENDD(d2);
}
setregs();
if (!d0) {
FAIL();
@@ -9759,12 +9814,12 @@ Yap_absmi(int inp)
}
}
exec_bin_cmp_yx:
BEGD(d2);
d2 = (CELL)(PREG->u.lxy.l);
PREG = NEXTOP(PREG, lxy);
saveregs();
d0 = (CELL) (*((Int (*)(CELL, CELL)) d2)) (d0,d1);
ENDD(d2);
{
CmpPredicate f = PREG->u.lxy.p->cs.d_code;
PREG = NEXTOP(PREG, lxy);
saveregs();
d0 = (CELL) (f) (d0,d1);
}
setregs();
if (!d0) {
FAIL();
@@ -9821,12 +9876,12 @@ Yap_absmi(int inp)
}
}
exec_bin_cmp_xy:
BEGD(d2);
d2 = (CELL)(PREG->u.lxy.l);
PREG = NEXTOP(PREG, lxy);
saveregs();
d0 = (CELL) (*((Int (*)(CELL, CELL)) d2)) (d0,d1);
ENDD(d2);
{
CmpPredicate f = PREG->u.lxy.p->cs.d_code;
PREG = NEXTOP(PREG, lxy);
saveregs();
d0 = (CELL) (f) (d0,d1);
}
setregs();
if (!d0) {
FAIL();
@@ -9886,12 +9941,12 @@ Yap_absmi(int inp)
}
}
exec_bin_cmp_yy:
BEGD(d2);
d2 = (CELL)(PREG->u.lyy.l);
PREG = NEXTOP(PREG, lyy);
saveregs();
d0 = (CELL) (*((Int (*)(CELL, CELL)) d2)) (d0,d1);
ENDD(d2);
{
CmpPredicate f = PREG->u.lyy.p->cs.d_code;
PREG = NEXTOP(PREG, lyy);
saveregs();
d0 = (CELL) (f) (d0,d1);
}
setregs();
if (!d0) {
FAIL();
@@ -11719,7 +11774,7 @@ Yap_absmi(int inp)
CPREG =
(yamop *) NEXTOP(PREG, sla);
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
PREG = (yamop *) pen->CodeOfPred;
PREG = pen->CodeOfPred;
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pen->ModuleOfPred) {
@@ -11860,7 +11915,7 @@ Yap_absmi(int inp)
CPREG =
(yamop *) NEXTOP(PREG, sla);
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
PREG = (yamop *) pen->CodeOfPred;
PREG = pen->CodeOfPred;
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pen->ModuleOfPred) {
@@ -11999,7 +12054,7 @@ Yap_absmi(int inp)
d0 = ENV[E_CB];
else
d0 = (CELL)B;
PREG = (yamop *) pen->CodeOfPred;
PREG = pen->CodeOfPred;
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pen->ModuleOfPred) {

8
C/adtdefs.c
View File

@@ -401,12 +401,12 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, SMALLUNSGN cur_mod)
INIT_RWLOCK(p->PRWLock);
p->KindOfPE = PEProp;
p->ArityOfPE = fe->ArityOfFE;
p->FirstClause = p->LastClause = NIL;
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
p->PredFlags = 0L;
p->StateOfPred = 0;
p->OwnerFile = AtomNil;
p->OpcodeOfPred = UNDEF_OPCODE;
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
p->ModuleOfPred = cur_mod;
p->NextPredOfModule = ModulePred[cur_mod];
ModulePred[cur_mod] = p;
@@ -436,12 +436,12 @@ Yap_NewPredPropByAtom(AtomEntry *ae, SMALLUNSGN cur_mod)
INIT_RWLOCK(p->PRWLock);
p->KindOfPE = PEProp;
p->ArityOfPE = 0;
p->FirstClause = p->LastClause = NIL;
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
p->PredFlags = 0L;
p->StateOfPred = 0;
p->OwnerFile = AtomNil;
p->OpcodeOfPred = UNDEF_OPCODE;
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
p->ModuleOfPred = cur_mod;
p->NextPredOfModule = ModulePred[cur_mod];
ModulePred[cur_mod] = p;

24
C/agc.c
View File

@@ -143,30 +143,6 @@ recompute_mask(DBRef dbr)
return;
}
static CODEADDR
CCodeAdjust(PredEntry *pe, CODEADDR c)
{
/* add this code to a list of ccalls that must be adjusted */
return c;
}
static CODEADDR
NextCCodeAdjust(PredEntry *pe, CODEADDR c)
{
/* add this code to a list of ccalls that must be adjusted */
return c;
}
static CODEADDR
DirectCCodeAdjust(PredEntry *pe, CODEADDR c)
{
/* add this code to a list of ccalls that must be adjusted */
return (c);
}
static void
rehash(CELL *oldcode, int NOfE, int KindOfEntries)
{

69
C/amasm.c
View File

@@ -36,9 +36,9 @@ STATIC_PROTO(yslot emit_yreg, (CELL));
STATIC_PROTO(wamreg emit_xreg2, (void));
STATIC_PROTO(wamreg emit_x, (CELL));
STATIC_PROTO(yslot emit_y, (Ventry *));
STATIC_PROTO(CODEADDR emit_a, (CELL));
STATIC_PROTO(yamop *emit_a, (CELL));
STATIC_PROTO(CELL *emit_bmlabel, (CELL));
STATIC_PROTO(CODEADDR emit_ilabel, (CELL));
STATIC_PROTO(yamop *emit_ilabel, (CELL));
STATIC_PROTO(Functor emit_f, (CELL));
STATIC_PROTO(CELL emit_c, (CELL));
STATIC_PROTO(COUNT emit_count, (CELL));
@@ -114,7 +114,7 @@ static yamop *code_p;
#define GONEXT(TYPE) code_p = ((yamop *)(&(code_p->u.TYPE.next)))
static CODEADDR code_addr;
static yamop *code_addr;
static int pass_no;
static OPREG var_offset;
static int is_y_var;
@@ -244,10 +244,10 @@ emit_x(CELL xarg)
#endif /* PRECOMPUTE_REGADDRESS */
}
inline static CODEADDR
inline static yamop *
emit_a(CELL a)
{
return ((CODEADDR) (a));
return ((yamop *) (a));
}
inline static struct pred_entry *
@@ -256,7 +256,7 @@ emit_pe(struct pred_entry *a)
return (a);
}
inline static CODEADDR
inline static yamop *
emit_ilabel(register CELL addr)
{
if (addr & 1)
@@ -756,8 +756,6 @@ a_p(op_numbers opcode)
code_p->opc = emit_op(_call_c_wfail);
code_p->u.sdl.s =
emit_count(-Signed(RealEnvSize) - CELLSIZE * cpc->rnd2);
code_p->u.sdl.d =
emit_a((CELL) RepPredProp(fe)->TrueCodeOfPred);
code_p->u.sdl.l =
emit_a(Unsigned(code_addr) + label_offset[comit_lab]);
code_p->u.sdl.p =
@@ -783,15 +781,13 @@ a_p(op_numbers opcode)
}
code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE
* (cpc->rnd2));
code_p->u.sla.l = emit_a((CELL)
RepPredProp(fe)->TrueCodeOfPred);
code_p->u.sla.p = RepPredProp(fe);
code_p->u.sla.sla_u.p = RepPredProp(fe);
code_p->u.sla.p0 = CurrentPred;
if (cpc->rnd2)
code_p->u.sla.l2 = emit_bmlabel(cpc->arnds[1]);
code_p->u.sla.bmap = emit_bmlabel(cpc->arnds[1]);
else
/* there is no bitmap as there are no variables in the environment */
code_p->u.sla.l2 = NULL;
code_p->u.sla.bmap = NULL;
}
GONEXT(sla);
}
@@ -820,22 +816,20 @@ a_p(op_numbers opcode)
if (pass_no) {
code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE *
cpc->rnd2);
code_p->u.sla.l = emit_a((CELL) &
RepPredProp(fe)->StateOfPred);
code_p->u.sla.p = RepPredProp(fe);
code_p->u.sla.sla_u.p = RepPredProp(fe);
code_p->u.sla.p0 = CurrentPred;
if (cpc->rnd2)
code_p->u.sla.l2 = emit_bmlabel(cpc->arnds[1]);
code_p->u.sla.bmap = emit_bmlabel(cpc->arnds[1]);
else
/* there is no bitmap as there are no variables in the environment */
code_p->u.sla.l2 = NULL;
code_p->u.sla.bmap = NULL;
}
GONEXT(sla);
}
else {
if (pass_no)
code_p->u.l.l = emit_a((CELL) &RepPredProp(fe)->StateOfPred);
GONEXT(l);
code_p->u.p.p = RepPredProp(fe);
GONEXT(p);
}
if (!comit_ok) {
Yap_Error(SYSTEM_ERROR, TermNil, "internal assembler error for commit");
@@ -865,14 +859,13 @@ a_empty_call(void)
PredEntry *pe = RepPredProp(Yap_GetPredPropByAtom(AtomTrue,0));
code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE *
cpc->rnd2);
code_p->u.sla.l = emit_a((CELL)&(pe->StateOfPred));
code_p->u.sla.p = pe;
code_p->u.sla.sla_u.p = pe;
code_p->u.sla.p0 = CurrentPred;
if (cpc->rnd2)
code_p->u.sla.l2 = emit_bmlabel(cpc->rnd1);
code_p->u.sla.bmap = emit_bmlabel(cpc->rnd1);
else
/* there is no bitmap as there are no variables in the environment */
code_p->u.sla.l2 = NULL;
code_p->u.sla.bmap = NULL;
}
GONEXT(sla);
}
@@ -926,7 +919,6 @@ a_bfunc(CELL pred)
if (pass_no) {
code_p->opc = emit_op(_call_bfunc_yy);
code_p->u.lxy.p = RepPredProp(((Prop)pred));
code_p->u.lyy.l = RepPredProp(((Prop)pred))->TrueCodeOfPred;
code_p->u.lyy.y1 = v1;
code_p->u.lyy.y2 = emit_yreg(var_offset);
code_p->u.lyy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
@@ -935,7 +927,6 @@ a_bfunc(CELL pred)
} else {
if (pass_no) {
code_p->opc = emit_op(_call_bfunc_yx);
code_p->u.lxy.l = RepPredProp(((Prop)pred))->TrueCodeOfPred;
code_p->u.lxy.p = RepPredProp(((Prop)pred));
code_p->u.lxy.x = emit_xreg(var_offset);
code_p->u.lxy.y = v1;
@@ -951,7 +942,6 @@ a_bfunc(CELL pred)
if (ve->KindOfVE == PermVar) {
if (pass_no) {
code_p->opc = emit_op(_call_bfunc_xy);
code_p->u.lxy.l = RepPredProp(((Prop)pred))->TrueCodeOfPred;
code_p->u.lxy.p = RepPredProp(((Prop)pred));
code_p->u.lxy.x = x1;
code_p->u.lxy.y = emit_yreg(var_offset);
@@ -962,7 +952,6 @@ a_bfunc(CELL pred)
if (pass_no) {
code_p->opc = emit_op(_call_bfunc_xx);
code_p->u.lxy.p = RepPredProp(((Prop)pred));
code_p->u.lxx.l = RepPredProp(((Prop)pred))->TrueCodeOfPred;
code_p->u.lxx.x1 = x1;
code_p->u.lxx.x2 = emit_xreg(var_offset);
code_p->u.lxx.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
@@ -1189,25 +1178,21 @@ a_either(op_numbers opcode, CELL opr, CELL lab)
#endif /* YAPOR */
{
if (pass_no) {
Prop fe = Yap_GetPredPropByAtom(AtomTrue,0);
code_p->opc = emit_op(opcode);
code_p->u.sla.s = emit_count(opr);
code_p->u.sla.l = emit_a(lab);
/* use code for atom true so that we won't try to do anything smart */
code_p->u.sla.p = RepPredProp(fe);
code_p->u.sla.sla_u.l = emit_a(lab);
code_p->u.sla.p0 = CurrentPred;
#ifdef YAPOR
/* code_p->u.sla.p = (CODEADDR)CurrentPred; */
INIT_YAMOP_LTT(code_p, nofalts);
if (hascut)
PUT_YAMOP_CUT(code_p);
if (CurrentPred->PredFlags & SequentialPredFlag)
PUT_YAMOP_SEQ(code_p);
if(opcode != _or_last) {
code_p->u.sla.l2 = emit_bmlabel(cpc->arnds[1]);
code_p->u.sla.bmap = emit_bmlabel(cpc->arnds[1]);
}
#else
code_p->u.sla.l2 = emit_bmlabel(cpc->arnds[1]);
code_p->u.sla.bmap = emit_bmlabel(cpc->arnds[1]);
#endif /* YAPOR */
}
GONEXT(sla);
@@ -1966,7 +1951,7 @@ do_pass(void)
int ystop_found = FALSE;
alloc_found = dealloc_found = FALSE;
code_p = (yamop *) code_addr;
code_p = code_addr;
cpc = CodeStart;
comit_lab = 0L;
/* Space while for the clause flags */
@@ -2576,7 +2561,7 @@ do_pass(void)
a_e(_Ystop);
}
CODEADDR
yamop *
Yap_assemble(int mode)
{
/*
@@ -2586,7 +2571,7 @@ Yap_assemble(int mode)
*/
CELL size;
code_addr = NIL;
code_addr = NULL;
assembling = mode;
clause_has_blobs = FALSE;
label_offset = (int *)freep;
@@ -2596,7 +2581,7 @@ Yap_assemble(int mode)
if (asm_error) {
Yap_Error_TYPE = SYSTEM_ERROR;
Yap_ErrorMessage = "internal assembler error";
return (NIL);
return NULL;
}
pass_no = 1;
YAPEnterCriticalSection();
@@ -2610,17 +2595,17 @@ Yap_assemble(int mode)
#else
size = (CELL)code_p;
#endif
while ((code_addr = (CODEADDR) Yap_AllocCodeSpace(size)) == NULL) {
while ((code_addr = (yamop *) Yap_AllocCodeSpace(size)) == NULL) {
if (!Yap_growheap(TRUE)) {
Yap_Error_TYPE = SYSTEM_ERROR;
return (NIL);
return NULL;
}
}
do_pass();
YAPLeaveCriticalSection();
{
Clause *cl = (Clause *)code_addr; /* lcc, why? */
return((CODEADDR)(cl->ClCode));
return(cl->ClCode);
}
}

5
C/c_interface.c
View File

@@ -19,8 +19,7 @@
#define C_INTERFACE
#include "Yap.h"
#include "Yatom.h"
#include "Heap.h"
#include "clause.h"
#include "yapio.h"
#define HAS_YAP_H 1
#include "yap_structs.h"
@@ -823,7 +822,7 @@ X_API char *
YAP_CompileClause(Term t)
{
char *Yap_ErrorMessage;
CODEADDR codeaddr;
yamop *codeaddr;
int mod = CurrentModule;
BACKUP_MACHINE_REGS();

306
C/cdmgr.c
View File

@@ -32,12 +32,12 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
STATIC_PROTO(void retract_all, (PredEntry *, int));
STATIC_PROTO(void add_first_static, (PredEntry *, CODEADDR, int));
STATIC_PROTO(void add_first_dynamic, (PredEntry *, CODEADDR, int));
STATIC_PROTO(void asserta_stat_clause, (PredEntry *, CODEADDR, int));
STATIC_PROTO(void asserta_dynam_clause, (PredEntry *, CODEADDR));
STATIC_PROTO(void assertz_stat_clause, (PredEntry *, CODEADDR, int));
STATIC_PROTO(void assertz_dynam_clause, (PredEntry *, CODEADDR));
STATIC_PROTO(void add_first_static, (PredEntry *, yamop *, int));
STATIC_PROTO(void add_first_dynamic, (PredEntry *, yamop *, int));
STATIC_PROTO(void asserta_stat_clause, (PredEntry *, yamop *, int));
STATIC_PROTO(void asserta_dynam_clause, (PredEntry *, yamop *));
STATIC_PROTO(void assertz_stat_clause, (PredEntry *, yamop *, int));
STATIC_PROTO(void assertz_dynam_clause, (PredEntry *, yamop *));
STATIC_PROTO(void expand_consult, (void));
STATIC_PROTO(int not_was_reconsulted, (PredEntry *, Term, int));
#if EMACS
@@ -80,12 +80,15 @@ STATIC_PROTO(Int p_call_count_set, (void));
STATIC_PROTO(Int p_call_count_reset, (void));
STATIC_PROTO(Int p_toggle_static_predicates_in_use, (void));
STATIC_PROTO(Atom YapConsultingFile, (void));
STATIC_PROTO(Int PredForCode,(CODEADDR, Atom *, UInt *, SMALLUNSGN *));
STATIC_PROTO(Int PredForCode,(yamop *, Atom *, UInt *, SMALLUNSGN *));
#define PredArity(p) (p->ArityOfPE)
#define TRYCODE(G,F,N) ( (N)<5 ? (op_numbers)((int)F+(N)*3) : G)
#define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next)))
#define IN_BLOCK(P,B,SZ) ((CODEADDR)(P) > (CODEADDR)(B) && \
(CODEADDR)(P) <= (CODEADDR)(B)+(SZ))
/******************************************************************
EXECUTING PROLOG CLAUSES
@@ -145,18 +148,16 @@ static_in_use(PredEntry *p, int check_everything)
/* Index a prolog pred, given its predicate entry */
/* ap is already locked, but IPred is the one who gets rid of the lock. */
static void
IPred(CODEADDR sp)
IPred(PredEntry *ap)
{
PredEntry *ap;
CODEADDR BaseAddr;
yamop *BaseAddr;
int Arity;
Functor f;
ap = (PredEntry *) sp;
#ifdef TABLING
if (is_tabled(ap)) {
ap->CodeOfPred = ap->TrueCodeOfPred;
ap->OpcodeOfPred = ((yamop *)(ap->CodeOfPred))->opc;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
ap->OpcodeOfPred = ap->CodeOfPred->opc;
return;
}
#endif /* TABLING */
@@ -184,17 +185,17 @@ IPred(CODEADDR sp)
"trying to index a predicate with 0 arguments");
return;
}
if ((BaseAddr = Yap_PredIsIndexable(ap)) != NIL) {
ap->TrueCodeOfPred = BaseAddr;
if ((BaseAddr = Yap_PredIsIndexable(ap)) != NULL) {
ap->cs.p_code.TrueCodeOfPred = BaseAddr;
ap->PredFlags |= IndexedPredFlag;
}
if (ap->PredFlags & SpiedPredFlag) {
ap->StateOfPred = StaticMask | SpiedMask;
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (CODEADDR)(&(ap->OpcodeOfPred));
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else {
ap->StateOfPred = 0;
ap->CodeOfPred = ap->TrueCodeOfPred;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
ap->OpcodeOfPred = ((yamop *)(ap->CodeOfPred))->opc;
}
WRITE_UNLOCK(ap->PRWLock);
@@ -205,9 +206,9 @@ IPred(CODEADDR sp)
}
void
Yap_IPred(CODEADDR sp)
Yap_IPred(PredEntry *p)
{
IPred(sp);
IPred(p);
}
#define GONEXT(TYPE) code_p = ((yamop *)(&(code_p->u.TYPE.next)))
@@ -241,9 +242,9 @@ recover_log_upd_clause(Clause *cl)
}
static Clause *
ClauseBodyToClause(CODEADDR addr)
ClauseBodyToClause(yamop *addr)
{
addr = addr - (Int)NEXTOP((yamop *)NULL,ld);
addr = (yamop *)((CODEADDR)addr - (Int)NEXTOP((yamop *)NULL,ld));
return(ClauseCodeToClause(addr));
}
@@ -288,18 +289,18 @@ Yap_RemoveLogUpdIndex(Clause *cl)
static int
RemoveIndexation(PredEntry *ap)
{
register CODEADDR First;
register yamop *First;
int spied;
First = ap->FirstClause;
First = ap->cs.p_code.FirstClause;
if (ap->OpcodeOfPred == INDEX_OPCODE) {
return (TRUE);
}
spied = ap->PredFlags & SpiedPredFlag;
if (ap->PredFlags & LogUpdatePredFlag)
RemoveLogUpdIndex(ClauseCodeToClause(ap->TrueCodeOfPred));
RemoveLogUpdIndex(ClauseCodeToClause(ap->cs.p_code.TrueCodeOfPred));
else {
Clause *cl = ClauseCodeToClause(ap->TrueCodeOfPred);
Clause *cl = ClauseCodeToClause(ap->cs.p_code.TrueCodeOfPred);
if (static_in_use(ap, FALSE)) {
/* This should never happen */
cl->u.NextCl = DeadClauses;
@@ -308,17 +309,17 @@ RemoveIndexation(PredEntry *ap)
Yap_FreeCodeSpace((char *)cl);
}
}
if (First != ap->LastClause)
ap->TrueCodeOfPred = First;
if (First != ap->cs.p_code.LastClause)
ap->cs.p_code.TrueCodeOfPred = First;
ap->PredFlags ^= IndexedPredFlag;
if (First != NIL && spied) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (CODEADDR)(&(ap->OpcodeOfPred));
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
ap->StateOfPred = StaticMask | SpiedMask;
} else {
ap->StateOfPred = StaticMask;
ap->OpcodeOfPred = ((yamop *)(ap->TrueCodeOfPred))->opc;
ap->CodeOfPred = ap->TrueCodeOfPred;
ap->OpcodeOfPred = ap->cs.p_code.TrueCodeOfPred->opc;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
}
return (TRUE);
}
@@ -343,11 +344,11 @@ Yap_RemoveIndexation(PredEntry *ap)
static void
retract_all(PredEntry *p, int in_use)
{
CODEADDR q, q1;
yamop *q, *q1;
int multifile_pred = p->PredFlags & MultiFileFlag;
CODEADDR fclause = NIL, lclause = NIL;
yamop *fclause = NIL, *lclause = NIL;
q = p->FirstClause;
q = p->cs.p_code.FirstClause;
if (q != NIL) {
do {
Clause *cl;
@@ -374,17 +375,17 @@ retract_all(PredEntry *p, int in_use)
}
}
}
} while (q1 != p->LastClause);
} while (q1 != p->cs.p_code.LastClause);
}
p->FirstClause = fclause;
p->LastClause = lclause;
p->cs.p_code.FirstClause = fclause;
p->cs.p_code.LastClause = lclause;
if (fclause == NIL) {
if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) {
p->OpcodeOfPred = FAIL_OPCODE;
} else {
p->OpcodeOfPred = UNDEF_OPCODE;
}
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
p->StatisticsForPred.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0;
p->StatisticsForPred.NOfRetries = 0;
@@ -392,10 +393,10 @@ retract_all(PredEntry *p, int in_use)
yamop *cpt = (yamop *)fclause;
cpt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p)));
if (fclause == lclause) {
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)NEXTOP(cpt,ld);
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = NEXTOP(cpt,ld);
p->OpcodeOfPred = NEXTOP(cpt,ld)->opc;
} else {
p->TrueCodeOfPred = p->CodeOfPred = fclause;
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = fclause;
p->OpcodeOfPred = cpt->opc;
if (p->PredFlags & ProfiledPredFlag) {
((yamop *)lclause)->opc = Yap_opcode(_profiled_trust_me);
@@ -408,10 +409,10 @@ retract_all(PredEntry *p, int in_use)
if (p->PredFlags & SpiedPredFlag) {
p->StateOfPred |= StaticMask | SpiedMask;
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} else if (p->PredFlags & IndexedPredFlag) {
p->OpcodeOfPred = INDEX_OPCODE;
p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
}
}
if (PROFILING) {
@@ -428,7 +429,7 @@ retract_all(PredEntry *p, int in_use)
/* p is already locked */
static void
add_first_static(PredEntry *p, CODEADDR cp, int spy_flag)
add_first_static(PredEntry *p, yamop *cp, int spy_flag)
{
yamop *pt = (yamop *)cp;
@@ -453,8 +454,8 @@ add_first_static(PredEntry *p, CODEADDR cp, int spy_flag)
pt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p)));
pt = NEXTOP(pt, ld);
}
p->TrueCodeOfPred = (CODEADDR)pt;
p->FirstClause = p->LastClause = cp;
p->cs.p_code.TrueCodeOfPred = pt;
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = cp;
p->StatisticsForPred.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0;
p->StatisticsForPred.NOfRetries = 0;
@@ -469,7 +470,7 @@ add_first_static(PredEntry *p, CODEADDR cp, int spy_flag)
if (spy_flag) {
p->StateOfPred |= StaticMask | SpiedMask;
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} else if (is_fast(p)) {
p->StateOfPred |= StaticMask;
} else {
@@ -484,7 +485,7 @@ add_first_static(PredEntry *p, CODEADDR cp, int spy_flag)
/* p is already locked */
static void
add_first_dynamic(PredEntry *p, CODEADDR cp, int spy_flag)
add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
{
yamop *ncp = ((Clause *)NIL)->ClCode;
Clause *cl;
@@ -536,25 +537,25 @@ add_first_dynamic(PredEntry *p, CODEADDR cp, int spy_flag)
PUT_YAMOP_SEQ(ncp);
#endif /* YAPOR */
/* This is the point we enter the code */
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)ncp;
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = ncp;
/* set the first clause to have a retry and mark which will
* backtrack to the previous block */
if (p->PredFlags & ProfiledPredFlag)
((yamop *)cp)->opc = Yap_opcode(_profiled_retry_and_mark);
cp->opc = Yap_opcode(_profiled_retry_and_mark);
else if (p->PredFlags & CountPredFlag)
((yamop *)cp)->opc = Yap_opcode(_count_retry_and_mark);
cp->opc = Yap_opcode(_count_retry_and_mark);
else
((yamop *)cp)->opc = Yap_opcode(_retry_and_mark);
((yamop *)cp)->u.ld.s = p->ArityOfPE;
((yamop *)cp)->u.ld.p = p;
((yamop *)cp)->u.ld.d = (CODEADDR)ncp;
cp->opc = Yap_opcode(_retry_and_mark);
cp->u.ld.s = p->ArityOfPE;
cp->u.ld.p = p;
cp->u.ld.d = ncp;
#ifdef KEEP_ENTRY_AGE
/* also, keep a backpointer for the days you delete the clause */
ClauseCodeToClause(cp)->u.ClPrevious = ncp;
#endif
/* Don't forget to say who is the only clause for the predicate so
far */
p->LastClause = p->FirstClause = cp;
p->cs.p_code.LastClause = p->cs.p_code.FirstClause = cp;
/* we're only missing what to do when we actually exit the procedure
*/
ncp = NEXTOP(ncp,ld);
@@ -570,13 +571,13 @@ add_first_dynamic(PredEntry *p, CODEADDR cp, int spy_flag)
/* p is already locked */
static void
asserta_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
asserta_stat_clause(PredEntry *p, yamop *cp, int spy_flag)
{
yamop *q = (yamop *)cp;
q->u.ld.d = p->FirstClause;
q->u.ld.d = p->cs.p_code.FirstClause;
q->u.ld.p = p;
#ifdef YAPOR
PUT_YAMOP_LTT(q, YAMOP_LTT((yamop *)(p->FirstClause)) + 1);
PUT_YAMOP_LTT(q, YAMOP_LTT((yamop *)(p->cs.p_code.FirstClause)) + 1);
#endif /* YAPOR */
#ifdef TABLING
if (is_tabled(p))
@@ -584,19 +585,19 @@ asserta_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
else
#endif /* TABLING */
q->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p)));
q = (yamop *)(p->FirstClause);
q = (yamop *)(p->cs.p_code.FirstClause);
if (p->PredFlags & ProfiledPredFlag) {
if (p->FirstClause == p->LastClause)
if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause)
q->opc = Yap_opcode(_profiled_trust_me);
else
q->opc = Yap_opcode(_profiled_retry_me);
} else if (p->PredFlags & CountPredFlag) {
if (p->FirstClause == p->LastClause)
if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause)
q->opc = Yap_opcode(_count_trust_me);
else
q->opc = Yap_opcode(_count_retry_me);
} else {
if (p->FirstClause == p->LastClause) {
if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) {
#ifdef TABLING
if (is_tabled(p))
q->opc = Yap_opcode(_table_trust_me);
@@ -612,37 +613,36 @@ asserta_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
q->opc = Yap_opcode(TRYCODE(_retry_me, _retry_me0, PredArity(p)));
}
}
p->TrueCodeOfPred = p->FirstClause = cp;
q = ((yamop *)p->LastClause);
q->u.ld.d = cp;
p->cs.p_code.TrueCodeOfPred = p->cs.p_code.FirstClause = cp;
p->cs.p_code.LastClause->u.ld.d = cp;
}
/* p is already locked */
static void
asserta_dynam_clause(PredEntry *p, CODEADDR cp)
asserta_dynam_clause(PredEntry *p, yamop *cp)
{
yamop *q;
q = (yamop *)cp;
LOCK(ClauseCodeToClause(p->FirstClause)->ClLock);
q = cp;
LOCK(ClauseCodeToClause(p->cs.p_code.FirstClause)->ClLock);
#ifdef KEEP_ENTRY_AGE
/* also, keep backpointers for the days we'll delete all the clause */
ClauseCodeToClause(p->FirstClause)->u.ClPrevious = q;
ClauseCodeToClause(p->cs.p_code.FirstClause)->u.ClPrevious = q;
ClauseCodeToClause(cp)->u.ClPrevious = (yamop *)(p->CodeOfPred);
#endif
UNLOCK(ClauseCodeToClause(p->FirstClause)->ClLock);
q->u.ld.d = p->FirstClause;
UNLOCK(ClauseCodeToClause(p->cs.p_code.FirstClause)->ClLock);
q->u.ld.d = p->cs.p_code.FirstClause;
q->u.ld.s = p->ArityOfPE;
q->u.ld.p = p;
if (p->PredFlags & ProfiledPredFlag)
((yamop *)cp)->opc = Yap_opcode(_profiled_retry_and_mark);
cp->opc = Yap_opcode(_profiled_retry_and_mark);
else if (p->PredFlags & CountPredFlag)
((yamop *)cp)->opc = Yap_opcode(_count_retry_and_mark);
cp->opc = Yap_opcode(_count_retry_and_mark);
else
((yamop *)cp)->opc = Yap_opcode(_retry_and_mark);
((yamop *)cp)->u.ld.s = p->ArityOfPE;
((yamop *)cp)->u.ld.p = p;
p->FirstClause = cp;
q = (yamop *)p->CodeOfPred;
cp->opc = Yap_opcode(_retry_and_mark);
cp->u.ld.s = p->ArityOfPE;
cp->u.ld.p = p;
p->cs.p_code.FirstClause = cp;
q = p->CodeOfPred;
q->u.ld.d = cp;
q->u.ld.s = p->ArityOfPE;
q->u.ld.p = p;
@@ -650,31 +650,31 @@ asserta_dynam_clause(PredEntry *p, CODEADDR cp)
/* p is already locked */
static void
assertz_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag)
{
yamop *pt;
pt = (yamop *)(p->LastClause);
pt = (yamop *)(p->cs.p_code.LastClause);
if (p->PredFlags & ProfiledPredFlag) {
if (p->FirstClause == p->LastClause) {
if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) {
pt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p)));
p->TrueCodeOfPred = p->FirstClause;
p->cs.p_code.TrueCodeOfPred = p->cs.p_code.FirstClause;
} else
pt->opc = Yap_opcode(_profiled_retry_me);
} else if (p->PredFlags & CountPredFlag) {
if (p->FirstClause == p->LastClause) {
if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) {
pt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p)));
p->TrueCodeOfPred = p->FirstClause;
p->cs.p_code.TrueCodeOfPred = p->cs.p_code.FirstClause;
} else
pt->opc = Yap_opcode(_count_retry_me);
} else {
if (p->FirstClause == p->LastClause) {
if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) {
#ifdef TABLING
if (is_tabled(p))
pt->opc = Yap_opcode(_table_try_me);
else
#endif /* TABLING */
pt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p)));
p->TrueCodeOfPred = p->FirstClause;
p->cs.p_code.TrueCodeOfPred = p->cs.p_code.FirstClause;
} else {
#ifdef TABLING
if (is_tabled(p))
@@ -685,7 +685,7 @@ assertz_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
}
}
pt->u.ld.d = cp;
p->LastClause = cp;
p->cs.p_code.LastClause = cp;
pt = (yamop *)cp;
if (p->PredFlags & ProfiledPredFlag) {
pt->opc = Yap_opcode(_profiled_trust_me);
@@ -699,13 +699,13 @@ assertz_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
#endif /* TABLING */
pt->opc = Yap_opcode(TRYCODE(_trust_me, _trust_me0, PredArity(p)));
}
pt->u.ld.d = p->FirstClause;
pt->u.ld.d = p->cs.p_code.FirstClause;
#ifdef YAPOR
{
CODEADDR code;
yamop *code;
code = p->FirstClause;
while (code != p->LastClause){
code = p->cs.p_code.FirstClause;
while (code != p->cs.p_code.LastClause){
PUT_YAMOP_LTT((yamop *)code, YAMOP_LTT((yamop *)code) + 1);
code = NextClause(code);
}
@@ -715,14 +715,14 @@ assertz_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
/* p is already locked */
static void
assertz_dynam_clause(PredEntry *p, CODEADDR cp)
assertz_dynam_clause(PredEntry *p, yamop *cp)
{
yamop *q;
q = (yamop *)(p->LastClause);
q = p->cs.p_code.LastClause;
LOCK(ClauseCodeToClause(q)->ClLock);
q->u.ld.d = cp;
p->LastClause = cp;
p->cs.p_code.LastClause = cp;
#ifdef KEEP_ENTRY_AGE
/* also, keep backpointers for the days we'll delete all the clause */
ClauseCodeToClause(cp)->u.ClPrevious = q;
@@ -831,7 +831,7 @@ addcl_permission_error(AtomEntry *ap, Int Arity, int in_use)
static void
addclause(Term t, CODEADDR cp, int mode, int mod)
addclause(Term t, yamop *cp, int mode, int mod)
/*
* mode 0 assertz 1 consult 2 asserta
*/
@@ -888,19 +888,19 @@ addclause(Term t, CODEADDR cp, int mode, int mod)
else
p->PredFlags |= CompiledPredFlag;
if ((Yap_GetValue(AtomIndex) != TermNil) &&
(p->FirstClause != NIL) &&
(p->cs.p_code.FirstClause != NIL) &&
(Arity != 0)) {
p->OpcodeOfPred = INDEX_OPCODE;
p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
}
}
if (p->FirstClause == NIL) {
if (p->cs.p_code.FirstClause == NIL) {
if (!(p->PredFlags & DynamicPredFlag)) {
add_first_static(p, cp, spy_flag);
/* make sure we have a place to jump to */
if (p->OpcodeOfPred == UNDEF_OPCODE ||
p->OpcodeOfPred == FAIL_OPCODE) { /* log updates */
p->CodeOfPred = p->TrueCodeOfPred;
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred;
p->OpcodeOfPred = ((yamop *)(p->CodeOfPred))->opc;
}
} else {
@@ -917,7 +917,7 @@ addclause(Term t, CODEADDR cp, int mode, int mod)
assertz_stat_clause(p, cp, spy_flag);
if (p->OpcodeOfPred != INDEX_OPCODE &&
p->OpcodeOfPred != Yap_opcode(_spy_pred)) {
p->CodeOfPred = p->TrueCodeOfPred;
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred;
p->OpcodeOfPred = ((yamop *)(p->CodeOfPred))->opc;
}
}
@@ -925,7 +925,7 @@ addclause(Term t, CODEADDR cp, int mode, int mod)
}
void
Yap_addclause(Term t, CODEADDR cp, int mode, int mod) {
Yap_addclause(Term t, yamop *cp, int mode, int mod) {
addclause(t, cp, mode, mod);
}
@@ -1034,11 +1034,11 @@ last_clause_number(p)
PredEntry *p;
{
int i = 1;
CODEADDR q = p->FirstClause;
yamop *q = p->cs.p_code.FirstClause;
if (q == NIL)
return (0);
while (q != p->LastClause) {
while (q != p->cs.p_code.LastClause) {
q = NextClause(q);
i++;
}
@@ -1069,7 +1069,7 @@ p_compile(void)
Term t = Deref(ARG1);
Term t1 = Deref(ARG2);
Term t3 = Deref(ARG3);
CODEADDR codeadr;
yamop *codeadr;
Int mod;
if (IsVarTerm(t1) || !IsIntTerm(t1))
@@ -1100,7 +1100,7 @@ p_compile_dynamic(void)
Term t1 = Deref(ARG2);
Term t3 = Deref(ARG3);
Clause *cl;
CODEADDR code_adr;
yamop *code_adr;
int old_optimize;
Int mod;
@@ -1212,7 +1212,7 @@ end_consult(void)
PredEntry *pred = RepPredProp(fp->p);
WRITE_LOCK(pred->PRWLock);
if (pred->OpcodeOfPred == INDEX_OPCODE) {
IPred((CODEADDR)pred);
IPred(pred);
/* IPred does the unlocking */
} else {
WRITE_UNLOCK(pred->PRWLock);
@@ -1248,7 +1248,7 @@ p_purge_clauses(void)
PredEntry *pred;
Term t = Deref(ARG1);
Term t2 = Deref(ARG2);
CODEADDR q, q1;
yamop *q, *q1;
SMALLUNSGN mod;
int in_use;
@@ -1276,7 +1276,7 @@ p_purge_clauses(void)
if (pred->PredFlags & IndexedPredFlag)
RemoveIndexation(pred);
Yap_PutValue(AtomAbol, MkAtomTerm(AtomTrue));
q = pred->FirstClause;
q = pred->cs.p_code.FirstClause;
in_use = static_in_use(pred,FALSE);
if (q != NIL)
do {
@@ -1293,16 +1293,16 @@ p_purge_clauses(void)
Yap_FreeCodeSpace((char *)cl);
}
}
} while (q1 != pred->LastClause);
pred->FirstClause = pred->LastClause = NIL;
} while (q1 != pred->cs.p_code.LastClause);
pred->cs.p_code.FirstClause = pred->cs.p_code.LastClause = NIL;
if (pred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) {
pred->OpcodeOfPred = FAIL_OPCODE;
} else {
pred->OpcodeOfPred = UNDEF_OPCODE;
}
pred->TrueCodeOfPred =
pred->cs.p_code.TrueCodeOfPred =
pred->CodeOfPred =
(CODEADDR)(&(pred->OpcodeOfPred));
(yamop *)(&(pred->OpcodeOfPred));
pred->OwnerFile = AtomNil;
if (pred->PredFlags & MultiFileFlag)
pred->PredFlags ^= MultiFileFlag;
@@ -1357,7 +1357,7 @@ p_setspy(void)
return (FALSE);
}
if (pred->OpcodeOfPred == INDEX_OPCODE) {
IPred((CODEADDR)pred);
IPred(pred);
goto restart_spy;
}
fg = pred->PredFlags;
@@ -1367,7 +1367,7 @@ p_setspy(void)
Yap_opcode(_spy_or_trymark);
} else {
pred->OpcodeOfPred = Yap_opcode(_spy_pred);
pred->CodeOfPred = (CODEADDR)(&(pred->OpcodeOfPred));
pred->CodeOfPred = (yamop *)(&(pred->OpcodeOfPred));
}
pred->StateOfPred |= SpiedMask;
pred->PredFlags |= SpiedPredFlag;
@@ -1406,9 +1406,9 @@ p_rmspy(void)
}
if (!(pred->PredFlags & DynamicPredFlag)) {
if ((pred->StateOfPred ^= SpiedMask) & InUseMask)
pred->CodeOfPred = pred->TrueCodeOfPred;
pred->CodeOfPred = pred->cs.p_code.TrueCodeOfPred;
else
pred->CodeOfPred = pred->TrueCodeOfPred;
pred->CodeOfPred = pred->cs.p_code.TrueCodeOfPred;
pred->OpcodeOfPred = ((yamop *)(pred->CodeOfPred))->opc;
} else if (pred->OpcodeOfPred == Yap_opcode(_spy_or_trymark)) {
pred->OpcodeOfPred = Yap_opcode(_try_and_mark);
@@ -1433,7 +1433,7 @@ p_number_of_clauses(void)
Term t2 = Deref(ARG2);
int ncl = 0;
Prop pe;
CODEADDR q;
yamop *q;
int testing;
int mod;
@@ -1449,14 +1449,14 @@ p_number_of_clauses(void)
pe = PredPropByFunc(f, mod);
} else
return (FALSE);
q = RepPredProp(pe)->FirstClause;
q = RepPredProp(pe)->cs.p_code.FirstClause;
READ_LOCK(RepPredProp(pe)->PRWLock);
if (q != NIL) {
if (RepPredProp(pe)->PredFlags & DynamicPredFlag)
testing = TRUE;
else
testing = FALSE;
while (q != RepPredProp(pe)->LastClause) {
while (q != RepPredProp(pe)->cs.p_code.LastClause) {
if (!testing ||
!(ClauseCodeToClause(q)->ClFlags & ErasedMask))
ncl++;
@@ -1761,13 +1761,13 @@ p_kill_dynamic(void)
WRITE_UNLOCK(pe->PRWLock);
return (FALSE);
}
if (pe->LastClause != pe->FirstClause) {
if (pe->cs.p_code.LastClause != pe->cs.p_code.FirstClause) {
WRITE_UNLOCK(pe->PRWLock);
return (FALSE);
}
pe->LastClause = pe->FirstClause = NIL;
pe->cs.p_code.LastClause = pe->cs.p_code.FirstClause = NIL;
pe->OpcodeOfPred = UNDEF_OPCODE;
pe->TrueCodeOfPred = pe->CodeOfPred = (CODEADDR)(&(pe->OpcodeOfPred));
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
pe->PredFlags = 0L;
WRITE_UNLOCK(pe->PRWLock);
return (TRUE);
@@ -1801,35 +1801,37 @@ p_compile_mode(void)
}
#if !defined(YAPOR)
static yamop *next_clause(PredEntry *pe, CODEADDR codeptr)
static yamop *next_clause(PredEntry *pe, yamop *codeptr)
{
CODEADDR clcode, cl;
clcode = pe->FirstClause;
cl = (CODEADDR)ClauseCodeToClause(clcode);
yamop *clcode;
Clause *cl;
clcode = pe->cs.p_code.FirstClause;
cl = ClauseCodeToClause(clcode);
do {
if (clcode == pe->LastClause)
if (clcode == pe->cs.p_code.LastClause)
break;
if (codeptr > cl && codeptr <= cl + Yap_SizeOfBlock(cl)) {
return((yamop *)NextClause(clcode));
if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) {
return(NextClause(clcode));
}
cl = (CODEADDR)ClauseCodeToClause(clcode = NextClause(clcode));
cl = ClauseCodeToClause(clcode = NextClause(clcode));
} while (TRUE);
Yap_Error(SYSTEM_ERROR,TermNil,"could not find clause for indexing code");
return(NULL);
}
static yamop *cur_clause(PredEntry *pe, CODEADDR codeptr)
static yamop *cur_clause(PredEntry *pe, yamop *codeptr)
{
CODEADDR clcode, cl;
clcode = pe->FirstClause;
cl = (CODEADDR)ClauseCodeToClause(clcode);
yamop *clcode;
Clause *cl;
clcode = pe->cs.p_code.FirstClause;
cl = ClauseCodeToClause(clcode);
do {
if (codeptr > cl && codeptr <= cl + Yap_SizeOfBlock(cl)) {
if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) {
return((yamop *)clcode);
}
if (clcode == pe->LastClause)
if (clcode == pe->cs.p_code.LastClause)
break;
cl = (CODEADDR)ClauseCodeToClause(clcode = NextClause(clcode));
cl = ClauseCodeToClause(clcode = NextClause(clcode));
} while (TRUE);
Yap_Error(SYSTEM_ERROR,TermNil,"could not find clause for indexing code");
return(NULL);
@@ -1888,9 +1890,9 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything)
return(TRUE);
READ_LOCK(pe->PRWLock);
if (p->PredFlags & IndexedPredFlag) {
CODEADDR code_p = (CODEADDR)(b_ptr->cp_ap);
if (code_p >= p->TrueCodeOfPred &&
code_p <= p->TrueCodeOfPred + Yap_SizeOfBlock((CODEADDR)ClauseCodeToClause(p->TrueCodeOfPred))) {
yamop *code_p = b_ptr->cp_ap;
if (code_p >= p->cs.p_code.TrueCodeOfPred &&
code_p <= p->cs.p_code.TrueCodeOfPred + Yap_SizeOfBlock((CODEADDR)ClauseCodeToClause(p->cs.p_code.TrueCodeOfPred))) {
yamop *prev;
/* fix the choicepoint */
switch(opnum) {
@@ -2104,17 +2106,17 @@ p_toggle_static_predicates_in_use(void)
static Int
code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, CODEADDR codeptr) {
CODEADDR clcode, cl;
code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
yamop *clcode;
Clause *cl;
int i = 1;
READ_LOCK(pp->PRWLock);
clcode = pp->FirstClause;
clcode = pp->cs.p_code.FirstClause;
if (clcode != NIL) {
/* check if the codeptr comes from the indexing code */
if ((pp->PredFlags & IndexedPredFlag) &&
codeptr > pp->TrueCodeOfPred &&
codeptr <= pp->TrueCodeOfPred + Yap_SizeOfBlock(pp->TrueCodeOfPred)) {
IN_BLOCK(codeptr,pp->cs.p_code.TrueCodeOfPred,Yap_SizeOfBlock((CODEADDR)(pp->cs.p_code.TrueCodeOfPred)))) {
*parity = pp->ArityOfPE;
if (pp->ArityOfPE) {
*pat = NameOfFunctor(pp->FunctorOfPred);
@@ -2124,9 +2126,9 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, CODEADDR codeptr) {
READ_UNLOCK(pp->PRWLock);
return(-1);
}
cl = (CODEADDR)ClauseCodeToClause(clcode);
cl = ClauseCodeToClause(clcode);
do {
if (codeptr > cl && codeptr <= cl + Yap_SizeOfBlock(cl)) {
if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) {
/* we found it */
*parity = pp->ArityOfPE;
if (pp->ArityOfPE) {
@@ -2137,9 +2139,9 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, CODEADDR codeptr) {
READ_UNLOCK(pp->PRWLock);
return(i);
}
if (clcode == pp->LastClause)
if (clcode == pp->cs.p_code.LastClause)
break;
cl = (CODEADDR)ClauseCodeToClause(clcode = NextClause(clcode));
cl = ClauseCodeToClause(clcode = NextClause(clcode));
i++;
} while (TRUE);
}
@@ -2148,7 +2150,7 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, CODEADDR codeptr) {
}
static Int
PredForCode(CODEADDR codeptr, Atom *pat, UInt *parity, SMALLUNSGN *pmodule) {
PredForCode(yamop *codeptr, Atom *pat, UInt *parity, SMALLUNSGN *pmodule) {
Int found = 0;
Int i_table;
@@ -2167,14 +2169,14 @@ PredForCode(CODEADDR codeptr, Atom *pat, UInt *parity, SMALLUNSGN *pmodule) {
}
Int
Yap_PredForCode(CODEADDR codeptr, Atom *pat, UInt *parity, SMALLUNSGN *pmodule) {
Yap_PredForCode(yamop *codeptr, Atom *pat, UInt *parity, SMALLUNSGN *pmodule) {
return PredForCode(codeptr, pat, parity, pmodule);
}
static Int
p_pred_for_code(void) {
CODEADDR codeptr = (CODEADDR)IntegerOfTerm(Deref(ARG1));
yamop *codeptr = (yamop *)IntegerOfTerm(Deref(ARG1));
Atom at;
UInt arity;
SMALLUNSGN module;
@@ -2381,7 +2383,7 @@ p_parent_pred(void)
Atom at;
UInt arity;
SMALLUNSGN module;
if (!PredForCode((CODEADDR)P_before_spy, &at, &arity, &module)) {
if (!PredForCode(P_before_spy, &at, &arity, &module)) {
return(Yap_unify(ARG1, MkIntTerm(0)) &&
Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) &&
Yap_unify(ARG3, MkIntTerm(0)));

8
C/compiler.c
View File

@@ -2728,13 +2728,13 @@ c_optimize(PInstr *pc)
} while (pc != NULL);
}
CODEADDR
yamop *
Yap_cclause(Term inp_clause, int NOfArgs, int mod)
{ /* compile a prolog clause, copy of clause myst be in ARG1 */
/* returns address of code for clause */
Term head, body;
CELL *SaveH;
CODEADDR acode;
yamop *acode;
volatile int maxvnum = 512;
int botch_why;
@@ -2841,11 +2841,11 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod)
/* insert extra instructions to count calls */
READ_LOCK(CurrentPred->PRWLock);
if ((CurrentPred->PredFlags & ProfiledPredFlag) ||
(PROFILING && (CurrentPred->FirstClause == NIL))) {
(PROFILING && (CurrentPred->cs.p_code.FirstClause == NIL))) {
profiling = TRUE;
call_counting = FALSE;
} else if ((CurrentPred->PredFlags & CountPredFlag) ||
(CALL_COUNTING && (CurrentPred->FirstClause == NIL))) {
(CALL_COUNTING && (CurrentPred->cs.p_code.FirstClause == NIL))) {
call_counting = TRUE;
profiling = FALSE;
} else {

105
C/dbase.c
View File

@@ -253,11 +253,11 @@ STATIC_PROTO(Int cont_current_key_integer, (void));
STATIC_PROTO(Int p_rcdstatp, (void));
STATIC_PROTO(Int p_somercdedp, (void));
#ifdef KEEP_OLD_ENTRIES_HANGING_ABOUT
STATIC_PROTO(int StillInChain, (CODEADDR, PredEntry *));
STATIC_PROTO(int StillInChain, (yamop *, PredEntry *));
#endif /* KEEP_OLD_ENTRIES_HANGING_ABOUT */
#ifdef DISCONNECT_OLD_ENTRIES
STATIC_PROTO(yamop * find_next_clause, (DBRef));
STATIC_PROTO(Int jump_to_next_dynamic_clause, (void));
STATIC_PROTO(Int p_jump_to_next_dynamic_clause, (void));
#endif /* DISCONNECT_OLD_ENTRIES */
#ifdef SFUNC
STATIC_PROTO(void SFVarIn, (Term));
@@ -1655,7 +1655,7 @@ record(int Flag, Term key, Term t_data, Term t_code)
#endif
}
if (Flag & WithRef) {
x->Code = (CODEADDR) IntegerOfTerm(t_code);
x->Code = (yamop *) IntegerOfTerm(t_code);
} else {
x->Code = NULL;
}
@@ -3457,7 +3457,7 @@ StillInChain(CODEADDR cl, PredEntry *pred)
if (!(pred->PredFlags & DynamicPredFlag))
return (FALSE);
base = pred->FirstClause;
end = pred->LastClause;
end = pred->cs.p_code.LastClause;
while (cl != base) {
if (base == end)
return (FALSE);
@@ -3497,7 +3497,7 @@ find_next_clause(DBRef ref0)
/* OK, we found a clause we can jump to, do a bit of hanky pancking with
the choice-point, so that it believes we are actually working from that
clause */
newp = (yamop *)(ref->Code);
newp = ref->Code;
/* and next let's tell the world this clause is being used, just
like if we were executing a standard retry_and_mark */
#if defined(YAPOR) || defined(THREADS)
@@ -3522,12 +3522,12 @@ find_next_clause(DBRef ref0)
/* This procedure is called when a clause is officialy deleted. Its job
is to find out where the code can go next, if it can go anywhere */
static Int
jump_to_next_dynamic_clause(void)
p_jump_to_next_dynamic_clause(void)
{
DBRef ref = (DBRef)(((yamop *)((CODEADDR)P-(CELL)NEXTOP((yamop *)NIL,sla)))->u.sla.l2);
DBRef ref = (DBRef)(((yamop *)((CODEADDR)P-(CELL)NEXTOP((yamop *)NULL,sla)))->u.sla.bmap);
yamop *newp = find_next_clause(ref);
if (newp == (yamop *)NULL) {
if (newp == NULL) {
cut_fail();
}
/* the next alternative to try must be obtained from this clause */
@@ -3607,13 +3607,13 @@ MyEraseClause(Clause *clau)
last->u.ld.d = second;
} else if (previous != NIL) {
yamop *previousoflast = (yamop *)(previous->Code);
pred->LastClause = (CODEADDR)previousoflast;
pred->cs.p_code.LastClause = (CODEADDR)previousoflast;
previousoflast->u.ld.d = pred->CodeOfPred;
} else {
Yap_FreeCodeSpace(((char *) ClauseCodeToClause(pred->CodeOfPred)));
pred->LastClause = pred->FirstClause = NIL;
pred->cs.p_code.LastClause = pred->FirstClause = NIL;
p->OpcodeOfPred = FAIL_OPCODE;
p->TrueCodeOfPred = p->CodeOfPred =
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred =
(CODEADDR)(&(p->OpcodeOfPred));
}
}
@@ -3633,14 +3633,14 @@ MyEraseClause(Clause *clau)
I don't need to lock the clause at this point because
I am the last one using it anyway.
*/
ref = (DBRef) NEXTOP(clau->ClCode,ld)->u.sla.l2;
ref = (DBRef) NEXTOP(clau->ClCode,ld)->u.sla.bmap;
/* don't do nothing if the reference is still in use */
if (DBREF_IN_USE(ref))
return;
if ( P == clau->ClCode ) {
yamop *np = RTRYCODE;
/* make it the next alternative */
np->u.ld.d = (CODEADDR)find_next_clause((DBRef)(NEXTOP(P,ld)->u.sla.l2));
np->u.ld.d = find_next_clause((DBRef)(NEXTOP(P,ld)->u.sla.bmap));
if (np->u.ld.d == NULL)
P = (yamop *)FAILCODE;
else {
@@ -3680,23 +3680,23 @@ PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr)
{
yamop *code_p = clau->ClCode;
PredEntry *p = (PredEntry *)(code_p->u.ld.p);
CODEADDR cl = (CODEADDR)(code_p);
yamop *cl = code_p;
WRITE_LOCK(p->PRWLock);
if (p->FirstClause != cl) {
if (p->cs.p_code.FirstClause != cl) {
/* we are not the first clause... */
yamop *prev_code_p = (yamop *)(dbr->Prev->Code);
prev_code_p->u.ld.d = code_p->u.ld.d;
/* are we the last? */
if (p->LastClause == cl)
p->LastClause = (CODEADDR)prev_code_p;
if (p->cs.p_code.LastClause == cl)
p->cs.p_code.LastClause = prev_code_p;
} else {
/* we are the first clause, what about the last ? */
if (p->LastClause == p->FirstClause) {
p->LastClause = p->FirstClause = NIL;
if (p->cs.p_code.LastClause == p->cs.p_code.FirstClause) {
p->cs.p_code.LastClause = p->cs.p_code.FirstClause = NULL;
} else {
p->FirstClause = code_p->u.ld.d;
((yamop *)(p->FirstClause))->opc =
p->cs.p_code.FirstClause = code_p->u.ld.d;
p->cs.p_code.FirstClause->opc =
Yap_opcode(TRYCODE(_try_me, _try_me0, p->ArityOfPE));
}
}
@@ -3707,31 +3707,31 @@ PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr)
if (!(clau->ClFlags & InUseMask))
EraseLogUpdCl(clau);
}
if (p->FirstClause == p->LastClause) {
if (p->FirstClause != NIL) {
code_p = (yamop *)(p->FirstClause);
code_p->u.ld.d = p->FirstClause;
p->TrueCodeOfPred = (CODEADDR)NEXTOP(code_p, ld);
if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) {
if (p->cs.p_code.FirstClause != NULL) {
code_p = p->cs.p_code.FirstClause;
code_p->u.ld.d = p->cs.p_code.FirstClause;
p->cs.p_code.TrueCodeOfPred = NEXTOP(code_p, ld);
if (p->PredFlags & SpiedPredFlag) {
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
p->StateOfPred = StaticMask | SpiedMask;
} else {
p->CodeOfPred = p->TrueCodeOfPred;
p->OpcodeOfPred = ((yamop *)(p->TrueCodeOfPred))->opc;
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred;
p->OpcodeOfPred = p->cs.p_code.TrueCodeOfPred->opc;
p->StateOfPred = StaticMask;
}
} else {
p->OpcodeOfPred = FAIL_OPCODE;
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
}
} else {
if (p->PredFlags & SpiedPredFlag) {
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} else {
p->OpcodeOfPred = INDEX_OPCODE;
p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
}
}
WRITE_UNLOCK(p->PRWLock);
@@ -3765,10 +3765,10 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
DBProp father;
PredEntry *pred;
/* first we get the next clause */
CODEADDR next = code_p->u.ld.d;
yamop *next = code_p->u.ld.d;
/* then we get the previous clause */
CODEADDR previous = (CODEADDR)(clau->u.ClPrevious);
CODEADDR clau_code;
yamop *previous = clau->u.ClPrevious;
yamop *clau_code;
/* next we check if we still have clauses left in the chain */
if (previous != next) {
@@ -3791,10 +3791,10 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
}
WRITE_LOCK(pred->PRWLock);
/* got my pred entry, let's have some fun! */
clau_code = (CODEADDR)(clau->ClCode);
if (pred->FirstClause == pred->LastClause) {
clau_code = clau->ClCode;
if (pred->cs.p_code.FirstClause == pred->cs.p_code.LastClause) {
#ifdef DEBUG
if (pred->FirstClause != clau_code) {
if (pred->cs.p_code.FirstClause != clau_code) {
/* sanity check */
if (father->ArityOfDB == 0) {
Yap_Error(SYSTEM_ERROR, TermNil, "Prepare to erase clause for %s/%d",RepAtom((Atom)father->FunctorOfDB)->StrOfAE,0);
@@ -3807,26 +3807,26 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
#endif
/* nothing left here, let's clean the shop */
Yap_FreeCodeSpace(((char *) ClauseCodeToClause(pred->CodeOfPred)));
pred->LastClause = pred->FirstClause = NIL;
pred->cs.p_code.LastClause = pred->cs.p_code.FirstClause = NIL;
pred->OpcodeOfPred = FAIL_OPCODE;
pred->TrueCodeOfPred = pred->CodeOfPred =
(CODEADDR)(&(pred->OpcodeOfPred));
} else if (clau_code == pred->FirstClause) {
pred->FirstClause = next;
} else if (clau_code == pred->LastClause) {
pred->LastClause = previous;
pred->cs.p_code.TrueCodeOfPred = pred->CodeOfPred =
(yamop *)(&(pred->OpcodeOfPred));
} else if (clau_code == pred->cs.p_code.FirstClause) {
pred->cs.p_code.FirstClause = next;
} else if (clau_code == pred->cs.p_code.LastClause) {
pred->cs.p_code.LastClause = previous;
}
WRITE_UNLOCK(pred->PRWLock);
}
/* make sure we don't directly point to anyone else */
code_p->u.ld.d = (CODEADDR)code_p;
code_p->u.ld.d = code_p;
/* now, put some code so that backtracks to here will survive */
code_p = NEXTOP(code_p, ld);
/* in this case, a failed clause should go to the data base and find
out what is the next clause, if there is one */
code_p->opc = Yap_opcode(_call_cpred);
code_p->u.sla.l = (CODEADDR)(&jump_to_next_dynamic_clause);
code_p->u.sla.l2 = (CELL *)(dbr);
code_p->u.sla.sla_u.p = RepPredProp(Yap_GetPredPropByAtom(Yap_FullLookupAtom("$jump_to_next_dynamic_clause"),0));
code_p->u.sla.bmap = (CELL *)(dbr);
#endif /* DISCONNECT_OLD_ENTRIES */
}
@@ -4677,6 +4677,7 @@ Yap_InitDBPreds(void)
Yap_InitCPred("key_statistics", 3, p_key_statistics, SyncPredFlag);
Yap_InitCPred("nth_instance", 3, p_nth_instance, SyncPredFlag);
Yap_InitCPred("$nth_instancep", 3, p_nth_instancep, SyncPredFlag);
Yap_InitCPred("$jump_to_next_dynamic_clause", 0, p_jump_to_next_dynamic_clause, SyncPredFlag);
}
void
@@ -4685,16 +4686,16 @@ Yap_InitBackDB(void)
Yap_InitCPredBack("recorded", 3, 3, in_rded, co_rded, SyncPredFlag);
/* internal version, just to prevent the debugger from nosying around */
RETRY_C_RECORDED_CODE = NEXTOP((yamop *)
(RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("recorded"), 3),0))->FirstClause),lds);
(RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("recorded"), 3),0))->cs.p_code.FirstClause),lds);
Yap_InitCPredBack("$recorded_with_key", 3, 3, in_rded_with_key, co_rded, SyncPredFlag);
RETRY_C_RECORDED_K_CODE = NEXTOP((yamop *)
(RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$recorded_with_key"), 3),0))->FirstClause),lds);
(RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$recorded_with_key"), 3),0))->cs.p_code.FirstClause),lds);
Yap_InitCPredBack("$recorded", 3, 3, in_rded, co_rded, SyncPredFlag);
RETRY_C_DRECORDED_CODE = NEXTOP((yamop *)
(RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$recorded"), 3),0))->FirstClause),lds);
(RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$recorded"), 3),0))->cs.p_code.FirstClause),lds);
Yap_InitCPredBack("$recordedp", 3, 3, in_rdedp, co_rdedp, SyncPredFlag);
RETRY_C_RECORDEDP_CODE = NEXTOP((yamop *)
(RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$recordedp"), 3),0))->FirstClause),lds);
(RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$recordedp"), 3),0))->cs.p_code.FirstClause),lds);
Yap_InitCPredBack("current_key", 2, 4, init_current_key, cont_current_key,
SyncPredFlag);
}

4
C/errors.c
View File

@@ -143,7 +143,7 @@ DumpActiveGoals (void)
restart_cp:
switch(opnum) {
case _or_else:
if (b_ptr->cp_ap == (yamop *)(b_ptr->cp_ap->u.sla.l))
if (b_ptr->cp_ap == (yamop *)(b_ptr->cp_ap->u.sla.sla_u.l))
{
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("repeat ")), Yap_DebugPutc, 0);
}
@@ -197,7 +197,7 @@ detect_bug_location(yamop *yap_pc, char *tp, int psize)
SMALLUNSGN pred_module;
Int cl;
if ((cl = Yap_PredForCode((CODEADDR)yap_pc, &pred_name, &pred_arity, &pred_module))
if ((cl = Yap_PredForCode(yap_pc, &pred_name, &pred_arity, &pred_module))
== 0) {
/* system predicate */
#if HAVE_SNPRINTF

24
C/exec.c
View File

@@ -28,10 +28,6 @@ STATIC_PROTO(Int p_execute, (void));
STATIC_PROTO(Int p_execute0, (void));
STATIC_PROTO(Int p_at_execute, (void));
/************ table of C-Predicates *************/
CPredicate Yap_c_predicates[MAX_C_PREDS];
cmp_entry Yap_cmp_funcs[MAX_CMP_FUNCS];
static Term
current_cp_as_integer(void)
{
@@ -109,7 +105,7 @@ CallClause(PredEntry *pen, Int position)
flags = pen->PredFlags;
if ((flags & (CompiledPredFlag | DynamicPredFlag)) ||
pen->OpcodeOfPred == UNDEF_OPCODE) {
CODEADDR q;
yamop *q;
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
if (pen->ModuleOfPred) {
@@ -128,7 +124,7 @@ CallClause(PredEntry *pen, Int position)
YENV = ASP;
YENV[E_CB] = (CELL)(B->cp_b);
CP = P;
q = pen->FirstClause;
q = pen->cs.p_code.FirstClause;
if (pen->PredFlags & ProfiledPredFlag) {
LOCK(pen->StatisticsForPred.lock);
if (position == 1)
@@ -164,8 +160,8 @@ CallClause(PredEntry *pen, Int position)
*opp |= InUseMask;
}
#endif
CLAUSECODE->clause = (CODEADDR)NEXTOP((yamop *)(q),ld);
P = (yamop *)CLAUSECODE->clause;
CLAUSECODE->clause = NEXTOP((yamop *)(q),ld);
P = CLAUSECODE->clause;
WRITE_UNLOCK(pen->PRWLock);
return((CELL)(&(CLAUSECODE->clause)));
} else {
@@ -1349,7 +1345,7 @@ exec_absmi(int top)
}
static int
do_goal(CODEADDR CodeAdr, int arity, CELL *pt, int top)
do_goal(yamop *CodeAdr, int arity, CELL *pt, int top)
{
choiceptr saved_b = B;
@@ -1412,7 +1408,7 @@ Int
Yap_execute_goal(Term t, int nargs, SMALLUNSGN mod)
{
Int out;
CODEADDR CodeAdr;
yamop *CodeAdr;
yamop *saved_p, *saved_cp;
Prop pe;
PredEntry *ppe;
@@ -1535,7 +1531,7 @@ Yap_trust_last(void)
int
Yap_RunTopGoal(Term t)
{
CODEADDR CodeAdr;
yamop *CodeAdr;
Prop pe;
PredEntry *ppe;
CELL *pt;
@@ -1687,7 +1683,7 @@ p_clean_ifcp(void) {
static Int
JumpToEnv(Term t) {
yamop *pos = (yamop *)(PredDollarCatch->LastClause);
yamop *pos = PredDollarCatch->cs.p_code.LastClause;
CELL *env;
choiceptr first_func = NULL, B0 = B;
@@ -1695,7 +1691,7 @@ JumpToEnv(Term t) {
/* find the first choicepoint that may be a catch */
while (B != NULL && B->cp_ap != pos) {
/* we are already doing a catch */
if (B->cp_ap == (yamop *)(PredHandleThrow->LastClause)) {
if (B->cp_ap == PredHandleThrow->cs.p_code.LastClause) {
P = (yamop *)FAILCODE;
if (first_func != NULL) {
B = first_func;
@@ -1729,7 +1725,7 @@ JumpToEnv(Term t) {
} while (TRUE);
/* step one environment above */
B->cp_cp = (yamop *)env[E_CP];
B->cp_ap = (yamop *)(PredHandleThrow->LastClause);
B->cp_ap = PredHandleThrow->cs.p_code.LastClause;
B->cp_env = (CELL *)env[E_E];
/* cannot recover Heap because of copy term :-( */
B->cp_h = H;

6
C/heapgc.c
View File

@@ -1474,7 +1474,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
Atom at;
UInt arity;
SMALLUNSGN mod;
if (Yap_PredForCode((CODEADDR)gc_B->cp_ap, &at, &arity, &mod)) {
if (Yap_PredForCode(gc_B->cp_ap, &at, &arity, &mod)) {
if (arity)
fprintf(Yap_stderr,"[GC] %s/%d marked %d (%s)\n", RepAtom(at)->StrOfAE, arity, total_marked, op_names[opnum]);
else
@@ -1544,7 +1544,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
(CELL *)(gc_B->cp_cp->u.ldl.bl)
#else
-gc_B->cp_cp->u.sla.s / ((OPREG)sizeof(CELL)),
gc_B->cp_cp->u.sla.l2
gc_B->cp_cp->u.sla.bmap
#endif
);
} else {
@@ -2207,7 +2207,7 @@ sweep_choicepoints(choiceptr gc_B)
(CELL *)(gc_B->cp_cp->u.ldl.bl)
#else
-gc_B->cp_cp->u.sla.s / ((OPREG)sizeof(CELL)),
gc_B->cp_cp->u.sla.l2
gc_B->cp_cp->u.sla.bmap
#endif
);
break;

18
C/index.c
View File

@@ -417,7 +417,7 @@ NGroupsIn(PredEntry *ap)
int x, y, PresentGroup;
ClauseDef *ActualCl = ArOfCl, *LastClauses[MaxOptions];
GroupDef *Group = Groups;
yamop *q = (yamop *)(ap->FirstClause), *LastOne = (yamop *)(ap->LastClause);
yamop *q = ap->cs.p_code.FirstClause, *LastOne = ap->cs.p_code.LastClause;
NGroups = 1;
LastClauses[VarCl] = NIL;
@@ -1316,11 +1316,11 @@ SpecialCases(void)
return (FALSE);
}
CODEADDR
yamop *
Yap_PredIsIndexable(PredEntry *ap)
{
int NGr, Indexable = 0;
CODEADDR indx_out = NIL;
yamop *indx_out = NULL;
log_update = 0;
if (setjmp(Yap_CompilerBotch) == 3) {
@@ -1332,7 +1332,7 @@ Yap_PredIsIndexable(PredEntry *ap)
Yap_ErrorMessage = NULL;
labelno = 1;
RemovedCl = FALSE;
FirstCl = (yamop *)(ap->FirstClause);
FirstCl = ap->cs.p_code.FirstClause;
CurrentPred = ap;
if (CurrentPred->PredFlags & ProfiledPredFlag)
profiling = TRUE;
@@ -1352,7 +1352,7 @@ Yap_PredIsIndexable(PredEntry *ap)
CodeStart = cpc = NIL;
freep = (char *) (ArOfCl + NClauses);
if (Yap_ErrorMessage != NULL) {
return (NIL);
return NULL;
}
if (CurrentPred->PredFlags & LogUpdatePredFlag) {
log_update = labelno;
@@ -1360,7 +1360,7 @@ Yap_PredIsIndexable(PredEntry *ap)
}
if (NClauses == 0) {
Indexable = FALSE;
return(NIL);
return NULL;
} else {
if (NGr == 1)
Indexable = SimpleCase();
@@ -1371,7 +1371,7 @@ Yap_PredIsIndexable(PredEntry *ap)
}
if (CellPtr(freep) >= ASP) {
Yap_Error(SYSTEM_ERROR, TermNil, "out of stack space while indexing");
return(NIL);
return NULL;
}
if (log_update && NClauses > 1) {
int i;
@@ -1404,7 +1404,7 @@ Yap_PredIsIndexable(PredEntry *ap)
}
}
if (!Indexable) {
return (NIL);
return NULL;
} else {
#ifdef DEBUG
if (Yap_Option['i' - 'a' + 1]) {
@@ -1414,7 +1414,7 @@ Yap_PredIsIndexable(PredEntry *ap)
if ((indx_out = Yap_assemble(ASSEMBLING_INDEX)) == NIL) {
if (!Yap_growheap(FALSE)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
return NULL;
}
goto restart_index;
}

94
C/init.c
View File

@@ -458,31 +458,22 @@ Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, int flags)
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(atom, Arity),CurrentModule));
else
pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
pe->CodeOfPred = p_code;
pe->PredFlags = flags | StandardPredFlag | CPredFlag;
p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) code;
pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code;
pe->cs.f_code = code;
if (flags & UserCPredFlag)
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_usercpred);
else
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred);
p_code->u.sla.l2 = NULL;
p_code->u.sla.bmap = NULL;
p_code->u.sla.s = -Signed(RealEnvSize);
p_code->u.sla.p = pe;
p_code->u.sla.p0 = pe;
p_code->u.sla.sla_u.p = pe;
p_code = NEXTOP(p_code,sla);
p_code->opc = Yap_opcode(_procceed);
{
Term mod = CurrentModule;
pe->ModuleOfPred = mod;
}
if (!(flags & UserCPredFlag)) {
Yap_c_predicates[NumberOfCPreds] = code;
pe->StateOfPred = NumberOfCPreds;
NumberOfCPreds++;
if (NumberOfCPreds >= MAX_C_PREDS) {
Yap_Error(SYSTEM_ERROR, TermNil, "Too Many C-Predicates");
}
}
}
void
@@ -502,28 +493,15 @@ Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, CPre
else
pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
pe->PredFlags = flags | StandardPredFlag | CPredFlag;
p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) code;
pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code;
pe->CodeOfPred = p_code;
pe->cs.d_code = cmp_code;
pe->ModuleOfPred = CurrentModule;
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred);
p_code->u.sla.l2 = NULL;
p_code->u.sla.sla_u.p = pe;
p_code->u.sla.bmap = NULL;
p_code->u.sla.s = -Signed(RealEnvSize);
p_code->u.sla.p = p_code->u.sla.p0 = pe;
p_code = NEXTOP(p_code,sla);
p_code->opc = Yap_opcode(_procceed);
Yap_c_predicates[NumberOfCPreds] = code;
pe->StateOfPred = NumberOfCPreds;
NumberOfCPreds++;
if (NumberOfCPreds == MAX_C_PREDS) {
Yap_Error(SYSTEM_ERROR, TermNil, "not enough table for c-predicates");
}
pe->TrueCodeOfPred = (CODEADDR) cmp_code;
Yap_cmp_funcs[NumberOfCmpFuncs].p = pe;
Yap_cmp_funcs[NumberOfCmpFuncs].f = cmp_code;
NumberOfCmpFuncs++;
if (NumberOfCmpFuncs == MAX_CMP_FUNCS) {
Yap_Error(SYSTEM_ERROR, TermNil, "not enough table for comparison predicates");
}
}
void
@@ -537,6 +515,8 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
else
pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
pe->PredFlags = flags | AsmPredFlag | StandardPredFlag | (code);
pe->cs.f_code = def;
pe->ModuleOfPred = CurrentModule;
if (def != NULL) {
yamop *p_code = ((Clause *)NULL)->ClCode;
Clause *cl = (Clause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e));
@@ -545,23 +525,16 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user");
p_code = cl->ClCode;
p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) def;
pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code;
pe->ModuleOfPred = CurrentModule;
pe->CodeOfPred = p_code;
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred);
p_code->u.sla.l2 = NULL;
p_code->u.sla.bmap = NULL;
p_code->u.sla.s = -Signed(RealEnvSize);
p_code->u.sla.p = p_code->u.sla.p0 = pe;
p_code->u.sla.sla_u.p = pe;
p_code = NEXTOP(p_code,sla);
p_code->opc = Yap_opcode(_procceed);
Yap_c_predicates[NumberOfCPreds] = def;
pe->StateOfPred = NumberOfCPreds;
NumberOfCPreds++;
} else {
pe->FirstClause = pe->LastClause = NULL;
pe->OpcodeOfPred = Yap_opcode(_undef_p);
pe->TrueCodeOfPred = pe->CodeOfPred =
(CODEADDR)(&(pe->OpcodeOfPred));
pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
}
}
@@ -570,13 +543,14 @@ static void
CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
{
yamop *code;
if (pe->FirstClause != pe->LastClause || pe->TrueCodeOfPred !=
pe->FirstClause || pe->CodeOfPred != pe->FirstClause) {
if (pe->cs.p_code.FirstClause != pe->cs.p_code.LastClause ||
pe->cs.p_code.TrueCodeOfPred != pe->cs.p_code.FirstClause ||
pe->CodeOfPred != pe->cs.p_code.FirstClause) {
Yap_Error(SYSTEM_ERROR,TermNil,
"initiating a C Pred with backtracking");
return;
}
code = (yamop *)(pe->FirstClause);
code = (yamop *)(pe->cs.p_code.FirstClause);
if (pe->PredFlags & UserCPredFlag)
code->opc = Yap_opcode(_try_userc);
else
@@ -585,8 +559,7 @@ CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
INIT_YAMOP_LTT(code, 2);
PUT_YAMOP_SEQ(code);
#endif /* YAPOR */
Yap_c_predicates[pe->StateOfPred] = Start;
code->u.lds.d = (CODEADDR) Start;
code->u.lds.f = Start;
code = NEXTOP(code,lds);
if (pe->PredFlags & UserCPredFlag)
code->opc = Yap_opcode(_retry_userc);
@@ -596,8 +569,7 @@ CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
INIT_YAMOP_LTT(code, 1);
PUT_YAMOP_SEQ(code);
#endif /* YAPOR */
Yap_c_predicates[pe->StateOfPred+1] = Cont;
code->u.lds.d = (CODEADDR) Cont;
code->u.lds.f = Cont;
}
@@ -611,17 +583,16 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity, unsigned int Extra, CPred
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(atom, Arity),CurrentModule));
else
pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
if (pe->FirstClause != NIL)
if (pe->cs.p_code.FirstClause != NIL)
CleanBack(pe, Start, Cont);
else {
Clause *cl;
yamop *code = ((Clause *)NIL)->ClCode;
yamop *code = ((Clause *)NULL)->ClCode;
pe->PredFlags = CompiledPredFlag | StandardPredFlag;
#ifdef YAPOR
pe->PredFlags |= SequentialPredFlag;
#endif /* YAPOR */
cl = (Clause
*)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(code,lds),lds),e));
cl = (Clause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(code,lds),lds),e));
if (cl == NIL) {
Yap_Error(SYSTEM_ERROR,TermNil,"No Heap Space in InitCPredBack");
return;
@@ -630,16 +601,13 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity, unsigned int Extra, CPred
cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user");
code = cl->ClCode;
pe->TrueCodeOfPred = pe->CodeOfPred =
pe->FirstClause = pe->LastClause = (CODEADDR)code;
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred =
pe->cs.p_code.FirstClause = pe->cs.p_code.LastClause = code;
if (flags & UserCPredFlag)
pe->OpcodeOfPred = code->opc = Yap_opcode(_try_userc);
else
pe->OpcodeOfPred = code->opc = Yap_opcode(_try_c);
code->u.lds.d = (CODEADDR) Start;
pe->StateOfPred = NumberOfCPreds;
Yap_c_predicates[NumberOfCPreds] = Start;
NumberOfCPreds++;
code->u.lds.f = Start;
code->u.lds.p = pe;
code->u.lds.s = Arity;
code->u.lds.extra = Extra;
@@ -652,9 +620,7 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity, unsigned int Extra, CPred
code->opc = Yap_opcode(_retry_userc);
else
code->opc = Yap_opcode(_retry_c);
code->u.lds.d = (CODEADDR) Cont;
Yap_c_predicates[NumberOfCPreds] = Cont;
NumberOfCPreds++;
code->u.lds.f = Cont;
code->u.lds.p = pe;
code->u.lds.s = Arity;
code->u.lds.extra = Extra;
@@ -753,13 +719,11 @@ InitCodes(void)
heap_regs->env_for_trustfail_code.op = Yap_opcode(_call);
heap_regs->env_for_trustfail_code.s = -Signed(RealEnvSize);
heap_regs->env_for_trustfail_code.l = NULL;
heap_regs->env_for_trustfail_code.l2 = NULL;
heap_regs->trustfailcode = Yap_opcode(_trust_fail);
heap_regs->env_for_yes_code.op = Yap_opcode(_call);
heap_regs->env_for_yes_code.s = -Signed(RealEnvSize);
heap_regs->env_for_yes_code.l = NULL;
heap_regs->env_for_yes_code.l2 = NULL;
heap_regs->yescode.opc = Yap_opcode(_Ystop);
heap_regs->undef_op = Yap_opcode(_undef_p);
@@ -784,7 +748,7 @@ InitCodes(void)
heap_regs->heap_top_owner = -1;
#endif /* YAPOR */
heap_regs->clausecode.arity = 0;
heap_regs->clausecode.clause = NIL;
heap_regs->clausecode.clause = NULL;
heap_regs->clausecode.func = NIL;
heap_regs->invisiblechain.Entry = NIL;
@@ -822,8 +786,6 @@ InitCodes(void)
heap_regs->IntBBKeys = NULL;
heap_regs->char_conversion_table = NULL;
heap_regs->char_conversion_table2 = NULL;
heap_regs->number_of_cpreds = 0;
heap_regs->number_of_cmpfuncs = 0;
/*
don't initialise this here, this is initialised by Yap_InitModules!!!!
heap_regs->no_of_modules = 1;

37
C/inlines.c
View File

@@ -85,10 +85,24 @@ p_integer(void)
d0 = ARG1;
deref_head(d0, integer_unk);
integer_nvar:
if (IsIntegerTerm(d0)) {
if (IsIntTerm(d0)) {
return(TRUE);
}
else {
if (IsApplTerm(d0)) {
Functor f0 = FunctorOfTerm(d0);
if (IsExtensionFunctor(f0)) {
switch ((CELL)f0) {
case (CELL)FunctorLongInt:
#ifdef USE_GMP
case (CELL)FunctorBigInt:
#endif
return(TRUE);
default:
return(FALSE);
}
}
return(FALSE);
} else {
return(FALSE);
}
@@ -106,10 +120,25 @@ p_number(void)
d0 = ARG1;
deref_head(d0, number_unk);
number_nvar:
if (IsNumTerm(d0)) {
if (IsIntTerm(d0)) {
return(TRUE);
}
else {
if (IsApplTerm(d0)) {
Functor f0 = FunctorOfTerm(d0);
if (IsExtensionFunctor(f0)) {
switch ((CELL)f0) {
case (CELL)FunctorLongInt:
case (CELL)FunctorDouble:
#ifdef USE_GMP
case (CELL)FunctorBigInt:
#endif
return(TRUE);
default:
return(FALSE);
}
}
return(FALSE);
} else {
return(FALSE);
}

110
C/save.c
View File

@@ -108,7 +108,7 @@ STATIC_PROTO(void ConvDBList, (Term, char *,CELL));
STATIC_PROTO(Term AdjustDBTerm, (Term));
STATIC_PROTO(void RestoreDB, (DBEntry *));
STATIC_PROTO(void RestoreClause, (Clause *,int));
STATIC_PROTO(void CleanClauses, (CODEADDR, CODEADDR));
STATIC_PROTO(void CleanClauses, (yamop *, yamop *));
STATIC_PROTO(void rehash, (CELL *, int, int));
STATIC_PROTO(void CleanCode, (PredEntry *));
STATIC_PROTO(void RestoreEntries, (PropEntry *));
@@ -343,10 +343,6 @@ put_info(int info, int mode)
putout(Unsigned(info));
/* say whether we just saved the heap or everything */
putout(mode);
/* c-predicates in system */
putout(NumberOfCPreds);
/* comparison predicates in system */
putout(NumberOfCmpFuncs);
/* current state of stacks, to be used by SavedInfo */
#if defined(YAPOR) || defined(TABLING)
/* space available in heap area */
@@ -442,22 +438,6 @@ save_code_info(void)
my_ops[i] = Yap_opcode(i);
mywrite(splfild, (char *)my_ops, sizeof(OPCODE)*(_std_top+1));
}
/* Then the c-functions */
putout(NumberOfCPreds);
{
UInt i;
for (i = 0; i < NumberOfCPreds; ++i)
putcellptr(CellPtr(Yap_c_predicates[i]));
}
/* Then the cmp-functions */
putout(NumberOfCmpFuncs);
{
UInt i;
for (i = 0; i < NumberOfCmpFuncs; ++i) {
putcellptr(CellPtr(Yap_cmp_funcs[i].p));
putcellptr(CellPtr(Yap_cmp_funcs[i].f));
}
}
/* and the current character codes */
mywrite(splfild, Yap_chtype, NUMBER_OF_CHARS);
}
@@ -615,7 +595,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap)
{
char pp[80];
char msg[256];
CELL hp_size, gb_size, lc_size, tr_size, mode, c_preds, cmp_funcs;
CELL hp_size, gb_size, lc_size, tr_size, mode;
/* make sure we always check if there are enough bytes */
/* skip the first line */
@@ -654,21 +634,6 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap)
mode = get_header_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
/* check the number of c-predicates */
c_preds = get_header_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
if (Yap_HeapBase != NULL && c_preds != NumberOfCPreds) {
Yap_ErrorMessage = "saved state with different number of built-ins";
return(FAIL_RESTORE);
}
cmp_funcs = get_header_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
if (Yap_HeapBase != NULL && cmp_funcs != NumberOfCmpFuncs) {
Yap_ErrorMessage = "saved state with different built-ins";
return(FAIL_RESTORE);
}
if (mode != DO_EVERYTHING && mode != DO_ONLY_CODE) {
Yap_ErrorMessage = "corrupt saved state";
return(FAIL_RESTORE);
@@ -806,44 +771,6 @@ get_insts(OPCODE old_ops[])
myread(splfild, (char *)old_ops, sizeof(OPCODE)*(_std_top+1));
}
/* check if the old functions are the same as the new ones, or if they
have moved around. Note that we don't need these functions afterwards */
static int
check_funcs(void)
{
UInt old_NumberOfCPreds, old_NumberOfCmpFuncs;
int out = FALSE;
if ((old_NumberOfCPreds = get_cell()) != NumberOfCPreds) {
Yap_Error(SYSTEM_ERROR,TermNil,"bad saved state, different number of functions (%d vs %d), system corrupted, old_NumberOfCPreds, NumberOfCPreds");
}
{
unsigned int i;
for (i = 0; i < old_NumberOfCPreds; ++i) {
CELL *old_pred = get_cellptr();
out = (out || old_pred != CellPtr(Yap_c_predicates[i]));
}
}
if ((old_NumberOfCmpFuncs = get_cell()) != NumberOfCmpFuncs) {
Yap_Error(SYSTEM_ERROR,TermNil,"bad saved state, different number of comparison functions (%d vs %d), system corrupted", old_NumberOfCmpFuncs, NumberOfCmpFuncs);
}
{
unsigned int i;
for (i = 0; i < old_NumberOfCmpFuncs; ++i) {
CELL *old_p = get_cellptr();
CELL *old_f = get_cellptr();
/* if (AddrAdjust((ADDR)old_p) != cmp_funcs[i].p) {
Yap_Error(SYSTEM_ERROR,TermNil,"bad saved state, comparison function is in wrong place (%p vs %p), system corrupted", AddrAdjust((ADDR)old_p), cmp_funcs[i].p);
} */
Yap_cmp_funcs[i].p = (PredEntry *)AddrAdjust((ADDR)old_p);
out = (out ||
old_f != CellPtr(Yap_cmp_funcs[i].f));
}
}
return(out);
}
/* Get the old atoms hash table */
static void
get_hash(void)
@@ -919,7 +846,6 @@ get_coded(int flag, OPCODE old_ops[])
get_regs(flag);
get_insts(old_ops);
funcs_moved = check_funcs();
get_hash();
CopyCode();
switch (flag) {
@@ -1104,38 +1030,6 @@ rehash(CELL *oldcode, int NOfE, int KindOfEntries)
}
}
static CODEADDR
CCodeAdjust(PredEntry *pe, CODEADDR c)
{
/* add this code to a list of ccalls that must be adjusted */
return ((CODEADDR)(Yap_c_predicates[pe->StateOfPred]));
}
static CODEADDR
NextCCodeAdjust(PredEntry *pe, CODEADDR c)
{
/* add this code to a list of ccalls that must be adjusted */
return ((CODEADDR)(Yap_c_predicates[pe->StateOfPred+1]));
}
static CODEADDR
DirectCCodeAdjust(PredEntry *pe, CODEADDR c)
{
/* add this code to a list of ccalls that must be adjusted */
unsigned int i;
for (i = 0; i < NumberOfCmpFuncs; i++) {
if (Yap_cmp_funcs[i].p == pe) {
return((CODEADDR)(Yap_cmp_funcs[i].f));
}
}
Yap_Error(FATAL_ERROR,TermNil,"bad saved state, ccalls corrupted");
return(NULL);
}
#include "rheap.h"
/* restore the atom entries which are invisible for the user */