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
Show Stats 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 */

10
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.35 2002-11-20 15:04:35 vsc Exp $ *
* version: $Id: Heap.h,v 1.36 2002-12-27 16:53:08 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -72,7 +72,6 @@ typedef struct various_codes {
COUNT seq;
#endif /* YAPOR */
COUNT s;
CODEADDR l;
CELL *l2;
struct pred_entry *p;
struct pred_entry *p0;
@ -86,7 +85,6 @@ typedef struct various_codes {
COUNT seq;
#endif /* YAPOR */
COUNT s;
CODEADDR l;
CELL *l2;
struct pred_entry *p;
struct pred_entry *p0;
@ -96,7 +94,7 @@ typedef struct various_codes {
yamop rtrycode;
struct {
OPREG arity;
CODEADDR clause;
struct yami *clause;
Functor func;
} clausecode;
union CONSULT_OBJ *consultsp;
@ -156,8 +154,6 @@ typedef struct various_codes {
unsigned int n_of_threads; /* number of threads and processes in system */
#endif
unsigned int size_of_overflow;
UInt number_of_cpreds;
UInt number_of_cmpfuncs;
Term module_name[MaxModules];
struct pred_entry *module_pred[MaxModules];
SMALLUNSGN no_of_modules;
@ -388,8 +384,6 @@ typedef struct various_codes {
#define INT_BB_KEYS heap_regs->IntBBKeys
#define CharConversionTable heap_regs->char_conversion_table
#define CharConversionTable2 heap_regs->char_conversion_table2
#define NumberOfCPreds heap_regs->number_of_cpreds
#define NumberOfCmpFuncs heap_regs->number_of_cmpfuncs
#define ModuleName heap_regs->module_name
#define ModulePred heap_regs->module_pred
#define PrimitivesModule heap_regs->primitives_module

12
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.30 2002-12-06 20:03:25 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.31 2002-12-27 16:53:08 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -19,11 +19,6 @@
#define STATIC_PROTO(F,A) static F A
typedef Int (*CPredicate)(void);
typedef Int (*CmpPredicate)(Term, Term);
/* absmi.c */
Int STD_PROTO(Yap_absmi,(int));
@ -104,10 +99,9 @@ void STD_PROTO(Yap_InitBigNums,(void));
Int STD_PROTO(YAP_Execute,(struct pred_entry *, CPredicate));
/* cdmgr.c */
void STD_PROTO(Yap_addclause,(Term,CODEADDR,int,int));
Term STD_PROTO(Yap_all_calls,(void));
Atom STD_PROTO(Yap_ConsultingFile,(void));
Int STD_PROTO(Yap_PredForCode,(CODEADDR, Atom *, UInt *, SMALLUNSGN *));
Int STD_PROTO(Yap_PredForCode,(yamop *, Atom *, UInt *, SMALLUNSGN *));
void STD_PROTO(Yap_InitCdMgr,(void));
#if EMACS
int STD_PROTO(where_new_clause, (Prop, int));
@ -121,7 +115,7 @@ int STD_PROTO(Yap_compare_terms,(Term,Term));
void STD_PROTO(Yap_InitCmpPreds,(void));
/* compiler.c */
CODEADDR STD_PROTO(Yap_cclause,(Term, int, int));
yamop *STD_PROTO(Yap_cclause,(Term, int, int));
/* computils.c */

2
H/absmi.h
View File

@ -770,7 +770,7 @@ Macros to check the limits of stacks
pt1->cp_b = B; \
store_yaam_reg_cpdepth(pt1); \
pt1->cp_cp = d0; \
pt1->cp_ap = (yamop *)AP; \
pt1->cp_ap = AP; \
pt1->cp_env = ENV;
/***************************************************************

81
H/amidefs.h
View File

@ -29,6 +29,12 @@
#endif
typedef Int (*CPredicate)(void);
typedef Int (*CmpPredicate)(Term, Term);
#define OpRegSize sizeof(OPREG)
/*
@ -128,8 +134,8 @@ typedef struct yami {
} c;
struct {
CELL c;
CODEADDR l1;
CODEADDR l2;
struct yami *l1;
struct yami *l2;
CELL next;
} cll;
struct {
@ -140,7 +146,7 @@ typedef struct yami {
Int ClTrail;
Int ClENV;
Int ClRefs;
CODEADDR ClBase;
struct yami *ClBase;
CELL next;
} EC;
struct {
@ -155,7 +161,7 @@ typedef struct yami {
CELL next;
} fll;
struct {
CODEADDR l;
struct yami *l;
CELL next;
} l;
struct {
@ -167,7 +173,7 @@ typedef struct yami {
#endif /* TABLING */
COUNT s;
struct pred_entry *p;
CODEADDR d;
struct yami *d;
CELL next;
} ld;
struct {
@ -179,8 +185,8 @@ typedef struct yami {
#endif /* TABLING */
COUNT s;
struct pred_entry *p;
CODEADDR d;
CODEADDR bl;
struct yami *d;
struct yami *bl;
CELL next;
} ldl;
struct {
@ -197,14 +203,14 @@ typedef struct yami {
#endif /* TABLING */
COUNT s;
struct pred_entry *p;
CODEADDR d;
CPredicate f;
COUNT extra;
CELL next;
} lds;
struct {
CODEADDR l1;
CODEADDR l2;
CODEADDR l3;
struct yami *l1;
struct yami *l2;
struct yami *l3;
CELL next;
} lll;
struct {
@ -216,21 +222,20 @@ typedef struct yami {
#endif /* TABLING */
COUNT s;
struct pred_entry *p;
CODEADDR l1;
CODEADDR l2;
CODEADDR l3;
struct yami *l1;
struct yami *l2;
struct yami *l3;
CELL next;
} slll;
struct {
CODEADDR l1;
CODEADDR l2;
CODEADDR l3;
CODEADDR l4;
struct yami *l1;
struct yami *l2;
struct yami *l3;
struct yami *l4;
CELL next;
} llll;
struct {
struct pred_entry *p;
CODEADDR l;
struct pred_entry *p;
wamreg x1;
wamreg x2;
wamreg flags;
@ -238,26 +243,24 @@ typedef struct yami {
} lxx;
struct {
struct pred_entry *p;
CODEADDR l;
wamreg x;
yslot y;
yslot y;
wamreg flags;
CELL next;
} lxy;
struct {
struct pred_entry *p;
CODEADDR l;
wamreg y1;
yslot y2;
yslot y2;
wamreg flags;
CELL next;
} lyy;
struct {
OPCODE pop;
CODEADDR l1;
CODEADDR l2;
CODEADDR l3;
CODEADDR l4;
struct yami *l1;
struct yami *l2;
struct yami *l3;
struct yami *l4;
CELL next;
} ollll;
struct {
@ -302,6 +305,10 @@ typedef struct yami {
yslot y;
CELL next;
} oy;
struct {
struct pred_entry *p;
CELL next;
} p;
struct {
COUNT s;
CELL next;
@ -313,14 +320,14 @@ typedef struct yami {
} sc;
struct {
COUNT s;
CODEADDR d;
CODEADDR l;
CPredicate d;
struct yami *l;
struct pred_entry *p;
CELL next;
} sdl;
struct {
COUNT s;
CODEADDR l;
struct yami *l;
CELL next;
} sl;
struct {
@ -328,9 +335,11 @@ typedef struct yami {
unsigned int or_arg;
#endif /* YAPOR */
COUNT s;
CODEADDR l;
CELL *l2;
struct pred_entry *p;
CELL *bmap;
union {
struct yami *l;
struct pred_entry *p;
} sla_u;
struct pred_entry *p0;
CELL next;
} sla; /* also check env for yes and trustfail code before making any changes */
@ -545,10 +554,10 @@ typedef struct choicept {
#define RealEnvSize (EnvSizeInCells*sizeof(CELL))
#define ENV_Size(cp) (((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NIL,sla)))->u.sla.s)
#define ENV_ToP(cp) ((PredEntry *)(((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NIL,sla)))->u.sla.p))
#define ENV_ToP(cp) ((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NIL,sla)))->u.sla.p)
#define ENV_ToOp(cp) (((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NIL,sla)))->opc)
#define EnvSize(cp) ((-ENV_Size(cp))/(OPREG)sizeof(CELL))
#define EnvBMap(p) (((yamop *)((CODEADDR)(p) - (CELL)NEXTOP((yamop *)NIL,sla)))->u.sla.l2)
#define EnvBMap(p) (((yamop *)((CODEADDR)(p) - (CELL)NEXTOP((yamop *)NIL,sla)))->u.sla.bmap)
#define EnvPreg(p) (((yamop *)((CODEADDR)(p) - (CELL)NEXTOP((yamop *)NIL,sla)))->u.sla.p0)
/* access to instructions */

8
H/clause.h
View File

@ -118,7 +118,13 @@ typedef struct clause_struct {
/* cdmgr.c */
void STD_PROTO(Yap_RemoveLogUpdIndex,(Clause *));
void STD_PROTO(Yap_IPred,(CODEADDR sp));
void STD_PROTO(Yap_IPred,(PredEntry *));
void STD_PROTO(Yap_addclause,(Term,yamop *,int,int));
/* dbase.c */
void STD_PROTO(Yap_ErCl,(Clause *));
/* index.c */
yamop *STD_PROTO(Yap_PredIsIndexable,(PredEntry *));

3
H/compile.h
View File

@ -250,7 +250,7 @@ typedef struct CEXPENTRY {
#define Two 2
CODEADDR STD_PROTO(Yap_assemble,(int));
yamop *STD_PROTO(Yap_assemble,(int));
void STD_PROTO(Yap_emit,(compiler_vm_op,Int,CELL));
void STD_PROTO(Yap_emit_3ops,(compiler_vm_op,CELL,CELL,CELL));
CELL *STD_PROTO(Yap_emit_extra_size,(compiler_vm_op,CELL,int));
@ -261,6 +261,5 @@ void STD_PROTO(Yap_bip_name,(Int, char *));
void STD_PROTO(Yap_ShowCode,(void));
#endif /* DEBUG */
extern jmp_buf Yap_CompilerBotch;

138
H/rheap.h
View File

@ -80,13 +80,13 @@ restore_codes(void)
((yamop *)(&heap_regs->rtrycode))->opc = Yap_opcode(_retry_and_mark);
if (((yamop *)(&heap_regs->rtrycode))->u.ld.d != NIL)
((yamop *)(&heap_regs->rtrycode))->u.ld.d =
CodeAddrAdjust(((yamop *)(&heap_regs->rtrycode))->u.ld.d);
PtoOpAdjust(((yamop *)(&heap_regs->rtrycode))->u.ld.d);
{
int arity;
arity = heap_regs->clausecode.arity;
if (heap_regs->clausecode.clause != NIL)
heap_regs->clausecode.clause =
CodeAddrAdjust(heap_regs->clausecode.clause);
PtoOpAdjust(heap_regs->clausecode.clause);
if (arity) {
heap_regs->clausecode.func =
FuncAdjust(heap_regs->clausecode.func);
@ -471,7 +471,7 @@ RestoreDBEntry(DBRef dbr)
#endif
dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent));
if (dbr->Code != NIL)
dbr->Code = CodeAddrAdjust(dbr->Code);
dbr->Code = PtoOpAdjust(dbr->Code);
if (dbr->Flags & DBAtomic) {
if (IsAtomTerm(dbr->Entry))
dbr->Entry = AtomTermAdjust(dbr->Entry);
@ -651,7 +651,7 @@ RestoreClause(Clause *Cl, int mode)
case _table_completion:
#endif
pc->u.ld.p = PtoPredAdjust(pc->u.ld.p);
pc->u.ld.d = CodeAddrAdjust(pc->u.ld.d);
pc->u.ld.d = PtoOpAdjust(pc->u.ld.d);
pc = NEXTOP(pc,ld);
break;
/* instructions type l */
@ -668,12 +668,12 @@ RestoreClause(Clause *Cl, int mode)
case _skip:
case _try_in:
case _jump_if_var:
pc->u.l.l = CodeAddrAdjust(pc->u.l.l);
pc->u.l.l = PtoOpAdjust(pc->u.l.l);
pc = NEXTOP(pc,l);
break;
/* instructions type EC */
case _alloc_for_logical_pred:
pc->u.EC.ClBase = CodeAddrAdjust(pc->u.EC.ClBase);
pc->u.EC.ClBase = PtoOpAdjust(pc->u.EC.ClBase);
pc = NEXTOP(pc,EC);
break;
/* instructions type e */
@ -771,30 +771,36 @@ RestoreClause(Clause *Cl, int mode)
/* instructions type sla */
case _fcall:
case _call:
case _either:
case _or_else:
case _p_execute:
case _p_execute_within:
case _p_last_execute_within:
#ifdef YAPOR
case _or_last:
#endif
pc->u.sla.l = CodeAddrAdjust(pc->u.sla.l);
if (pc->u.sla.l2 != NULL) {
pc->u.sla.l2 = CellPtoHeapAdjust(pc->u.sla.l2);
if (pc->u.sla.bmap != NULL) {
pc->u.sla.bmap = CellPtoHeapAdjust(pc->u.sla.bmap);
}
pc->u.sla.p = PtoPredAdjust(pc->u.sla.p);
pc->u.sla.sla_u.p = PtoPredAdjust(pc->u.sla.sla_u.p);
pc->u.sla.p0 = PtoPredAdjust(pc->u.sla.p0);
pc = NEXTOP(pc,sla);
break;
/* instructions type sla, but for disjunctions */
case _either:
case _or_else:
if (pc->u.sla.bmap != NULL) {
pc->u.sla.bmap = CellPtoHeapAdjust(pc->u.sla.bmap);
}
pc->u.sla.sla_u.l = PtoOpAdjust(pc->u.sla.sla_u.l);
pc->u.sla.p0 = PtoPredAdjust(pc->u.sla.p0);
pc = NEXTOP(pc,sla);
break;
/* instructions type sla, but for functions */
case _call_cpred:
case _call_usercpred:
pc->u.sla.p = PtoPredAdjust(pc->u.sla.p);
pc->u.sla.sla_u.p = PtoPredAdjust(pc->u.sla.sla_u.p);
pc->u.sla.p0 = PtoPredAdjust(pc->u.sla.p0);
pc->u.sla.l = CCodeAdjust(pc->u.sla.p,pc->u.sla.l);
if (pc->u.sla.l2 != NULL) {
pc->u.sla.l2 = CellPtoHeapAdjust(pc->u.sla.l2);
if (pc->u.sla.bmap != NULL) {
pc->u.sla.bmap = CellPtoHeapAdjust(pc->u.sla.bmap);
}
pc = NEXTOP(pc,sla);
break;
@ -1001,8 +1007,7 @@ RestoreClause(Clause *Cl, int mode)
/* instructions type sdl */
case _call_c_wfail:
pc->u.sdl.p = PtoPredAdjust(pc->u.sdl.p);
pc->u.sdl.l = CodeAddrAdjust(pc->u.sdl.l);
pc->u.sdl.d = CCodeAdjust(pc->u.sdl.p,pc->u.sdl.d);
pc->u.sdl.l = PtoOpAdjust(pc->u.sdl.l);
pc = NEXTOP(pc,sdl);
break;
/* instructions type lds */
@ -1011,7 +1016,6 @@ RestoreClause(Clause *Cl, int mode)
/* don't need to do no nothing here, initstaff will do it for us
*/
pc->u.lds.p = PtoPredAdjust(pc->u.lds.p);
pc->u.lds.d = CCodeAdjust(pc->u.lds.p,pc->u.lds.d);
pc = NEXTOP(pc,lds);
break;
case _retry_c:
@ -1019,7 +1023,6 @@ RestoreClause(Clause *Cl, int mode)
/* don't need to do no nothing here, initstaff will do it for us
pc->u.lds.d = CCodeAdjust(pc->u.lds.d); */
pc->u.lds.p = PtoPredAdjust(pc->u.lds.p);
pc->u.lds.d = NextCCodeAdjust(pc->u.lds.p,pc->u.lds.d);
pc = NEXTOP(pc,lds);
break;
/* instructions type ldl */
@ -1028,26 +1031,26 @@ RestoreClause(Clause *Cl, int mode)
case _trust_tail_in:
case _trust_head_in:
pc->u.ldl.p = PtoPredAdjust(pc->u.ldl.p);
pc->u.ldl.d = CodeAddrAdjust(pc->u.ldl.d);
pc->u.ldl.bl = CodeAddrAdjust(pc->u.ldl.bl);
pc->u.ldl.d = PtoOpAdjust(pc->u.ldl.d);
pc->u.ldl.bl = PtoOpAdjust(pc->u.ldl.bl);
pc = NEXTOP(pc,ldl);
break;
/* instructions type llll */
case _switch_on_type:
case _switch_list_nl:
case _switch_on_head:
pc->u.llll.l1 = CodeAddrAdjust(pc->u.llll.l1);
pc->u.llll.l2 = CodeAddrAdjust(pc->u.llll.l2);
pc->u.llll.l3 = CodeAddrAdjust(pc->u.llll.l3);
pc->u.llll.l4 = CodeAddrAdjust(pc->u.llll.l4);
pc->u.llll.l1 = PtoOpAdjust(pc->u.llll.l1);
pc->u.llll.l2 = PtoOpAdjust(pc->u.llll.l2);
pc->u.llll.l3 = PtoOpAdjust(pc->u.llll.l3);
pc->u.llll.l4 = PtoOpAdjust(pc->u.llll.l4);
pc = NEXTOP(pc,llll);
break;
/* instructions type lll */
case _switch_on_nonv:
case _switch_nv_list:
pc->u.lll.l1 = CodeAddrAdjust(pc->u.lll.l1);
pc->u.lll.l2 = CodeAddrAdjust(pc->u.lll.l2);
pc->u.lll.l3 = CodeAddrAdjust(pc->u.lll.l3);
pc->u.lll.l1 = PtoOpAdjust(pc->u.lll.l1);
pc->u.lll.l2 = PtoOpAdjust(pc->u.lll.l2);
pc->u.lll.l3 = PtoOpAdjust(pc->u.lll.l3);
pc = NEXTOP(pc,lll);
break;
/* instructions type cll */
@ -1057,17 +1060,17 @@ RestoreClause(Clause *Cl, int mode)
if (IsAtomTerm(t))
pc->u.cll.c = AtomTermAdjust(t);
}
pc->u.cll.l1 = CodeAddrAdjust(pc->u.cll.l1);
pc->u.cll.l2 = CodeAddrAdjust(pc->u.cll.l2);
pc->u.cll.l1 = PtoOpAdjust(pc->u.cll.l1);
pc->u.cll.l2 = PtoOpAdjust(pc->u.cll.l2);
pc = NEXTOP(pc,cll);
break;
/* instructions type ollll */
case _switch_list_nl_prefetch:
pc->u.ollll.pop = Yap_opcode(Yap_op_from_opcode(pc->u.ollll.pop));
pc->u.ollll.l1 = CodeAddrAdjust(pc->u.ollll.l1);
pc->u.ollll.l2 = CodeAddrAdjust(pc->u.ollll.l2);
pc->u.ollll.l3 = CodeAddrAdjust(pc->u.ollll.l3);
pc->u.ollll.l4 = CodeAddrAdjust(pc->u.ollll.l4);
pc->u.ollll.l1 = PtoOpAdjust(pc->u.ollll.l1);
pc->u.ollll.l2 = PtoOpAdjust(pc->u.ollll.l2);
pc->u.ollll.l3 = PtoOpAdjust(pc->u.ollll.l3);
pc->u.ollll.l4 = PtoOpAdjust(pc->u.ollll.l4);
pc = NEXTOP(pc,ollll);
break;
/* switch_on_func */
@ -1135,8 +1138,8 @@ RestoreClause(Clause *Cl, int mode)
case _go_on_cons:
if (IsAtomTerm(pc->u.cll.c))
pc->u.cll.c = AtomTermAdjust(pc->u.cll.c);
pc->u.cll.l1 = CodeAddrAdjust(pc->u.cll.l1);
pc->u.cll.l2 = CodeAddrAdjust(pc->u.cll.l2);
pc->u.cll.l1 = PtoOpAdjust(pc->u.cll.l1);
pc->u.cll.l2 = PtoOpAdjust(pc->u.cll.l2);
pc = NEXTOP(pc,cll);
break;
/* instructions type sl */
@ -1146,7 +1149,7 @@ RestoreClause(Clause *Cl, int mode)
CELL *oldcode;
i = pc->u.s.s;
pc->u.sl.l = CodeAddrAdjust(pc->u.sl.l);
pc->u.sl.l = PtoOpAdjust(pc->u.sl.l);
oldcode = (CELL *)NEXTOP(pc,sl);
for (j = 0; j < i; ++j) {
Functor oldfunc = (Functor)(oldcode[0]);
@ -1166,7 +1169,7 @@ RestoreClause(Clause *Cl, int mode)
CELL *oldcode;
i = pc->u.sl.s;
pc->u.sl.l = CodeAddrAdjust(pc->u.sl.l);
pc->u.sl.l = PtoOpAdjust(pc->u.sl.l);
oldcode = (CELL *)NEXTOP(pc,sl);
for (j = 0; j < i; ++j) {
#if !USE_OFFSETS
@ -1188,9 +1191,9 @@ RestoreClause(Clause *Cl, int mode)
case _switch_last:
case _switch_l_list:
pc->u.slll.p = PtoPredAdjust(pc->u.slll.p);
pc->u.slll.l1 = CodeAddrAdjust(pc->u.slll.l1);
pc->u.slll.l2 = CodeAddrAdjust(pc->u.slll.l2);
pc->u.slll.l3 = CodeAddrAdjust(pc->u.slll.l3);
pc->u.slll.l1 = PtoOpAdjust(pc->u.slll.l1);
pc->u.slll.l2 = PtoOpAdjust(pc->u.slll.l2);
pc->u.slll.l3 = PtoOpAdjust(pc->u.slll.l3);
pc = NEXTOP(pc,slll);
break;
/* instructions type xxx */
@ -1304,7 +1307,6 @@ RestoreClause(Clause *Cl, int mode)
/* instructions type lxx */
case _call_bfunc_xx:
pc->u.lxx.p = PtoPredAdjust(pc->u.lxx.p);
pc->u.lxx.l = DirectCCodeAdjust(pc->u.lxx.p,pc->u.lxx.l);
pc->u.lxx.x1 = XAdjust(pc->u.lxx.x1);
pc->u.lxx.x2 = XAdjust(pc->u.lxx.x2);
pc = NEXTOP(pc,lxx);
@ -1313,14 +1315,12 @@ RestoreClause(Clause *Cl, int mode)
case _call_bfunc_yx:
case _call_bfunc_xy:
pc->u.lxy.p = PtoPredAdjust(pc->u.lxy.p);
pc->u.lxy.l = DirectCCodeAdjust(pc->u.lxy.p,pc->u.lxy.l);
pc->u.lxy.x = XAdjust(pc->u.lxy.x);
pc->u.lxy.y = YAdjust(pc->u.lxy.y);
pc = NEXTOP(pc,lxy);
break;
case _call_bfunc_yy:
pc->u.lyy.p = PtoPredAdjust(pc->u.lyy.p);
pc->u.lyy.l = DirectCCodeAdjust(pc->u.lyy.p,pc->u.lyy.l);
pc->u.lyy.y1 = YAdjust(pc->u.lyy.y1);
pc->u.lyy.y2 = YAdjust(pc->u.lyy.y2);
pc = NEXTOP(pc,lyy);
@ -1334,9 +1334,9 @@ RestoreClause(Clause *Cl, int mode)
* and ending with Last, First may be equal to Last
*/
static void
CleanClauses(CODEADDR First, CODEADDR Last)
CleanClauses(yamop *First, yamop *Last)
{
CODEADDR cl = First;
yamop *cl = First;
do {
RestoreClause(ClauseCodeToClause(cl), ASSEMBLING_CLAUSE);
if (cl == Last) return;
@ -1448,7 +1448,6 @@ static void
CleanCode(PredEntry *pp)
{
CELL flag;
CODEADDR FirstC, LastC;
/* Init takes care of the first 2 cases */
@ -1459,39 +1458,26 @@ CleanCode(PredEntry *pp)
if (pp->OwnerFile)
pp->OwnerFile = AtomAdjust(pp->OwnerFile);
pp->OpcodeOfPred = Yap_opcode(Yap_op_from_opcode(pp->OpcodeOfPred));
if (pp->PredFlags & CPredFlag) {
if (pp->PredFlags & BinaryTestPredFlag) {
pp->TrueCodeOfPred = DirectCCodeAdjust(pp,pp->TrueCodeOfPred);
} else {
/* C, assembly + C */
pp->CodeOfPred = pp->TrueCodeOfPred = CCodeAdjust(pp,pp->TrueCodeOfPred);
}
pp->CodeOfPred = pp->FirstClause = pp->LastClause =
(CODEADDR)AddrAdjust((ADDR)(pp->LastClause));
CleanClauses(pp->FirstClause, pp->FirstClause);
} else if (pp->PredFlags & AsmPredFlag) {
if (pp->PredFlags & (AsmPredFlag|CPredFlag)) {
/* assembly */
if (pp->FirstClause) {
pp->CodeOfPred = (CODEADDR)AddrAdjust((ADDR)(pp->CodeOfPred));
pp->FirstClause = (CODEADDR)AddrAdjust((ADDR)(pp->FirstClause));
pp->LastClause = (CODEADDR)AddrAdjust((ADDR)(pp->LastClause));
CleanClauses(pp->FirstClause, pp->FirstClause);
} else {
pp->TrueCodeOfPred = pp->CodeOfPred =
(CODEADDR)(&(pp->OpcodeOfPred));
if (pp->CodeOfPred) {
pp->CodeOfPred = PtoOpAdjust(pp->CodeOfPred);
CleanClauses(pp->CodeOfPred, pp->CodeOfPred);
}
} else {
if (pp->FirstClause)
pp->FirstClause = CodeAddrAdjust(pp->FirstClause);
if (pp->LastClause)
pp->LastClause = CodeAddrAdjust(pp->LastClause);
pp->CodeOfPred = CodeAddrAdjust(pp->CodeOfPred);
pp->TrueCodeOfPred = CodeAddrAdjust(pp->TrueCodeOfPred);
yamop *FirstC, *LastC;
/* Prolog code */
if (pp->cs.p_code.FirstClause)
pp->cs.p_code.FirstClause = PtoOpAdjust(pp->cs.p_code.FirstClause);
if (pp->cs.p_code.LastClause)
pp->cs.p_code.LastClause = PtoOpAdjust(pp->cs.p_code.LastClause);
pp->CodeOfPred =PtoOpAdjust(pp->CodeOfPred);
pp->cs.p_code.TrueCodeOfPred = PtoOpAdjust(pp->cs.p_code.TrueCodeOfPred);
if (pp->NextPredOfModule)
pp->NextPredOfModule = PtoPredAdjust(pp->NextPredOfModule);
flag = pp->PredFlags;
FirstC = pp->FirstClause;
LastC = pp->LastClause;
FirstC = pp->cs.p_code.FirstClause;
LastC = pp->cs.p_code.LastClause;
/* We just have a fail here */
if (FirstC == NIL && LastC == NIL) {
return;
@ -1504,7 +1490,7 @@ CleanCode(PredEntry *pp)
#ifdef DEBUG_RESTORE2
YP_fprintf(errout, "Correcting dynamic/indexed code\n");
#endif
RestoreClause(ClauseCodeToClause(pp->TrueCodeOfPred), ASSEMBLING_INDEX);
RestoreClause(ClauseCodeToClause(pp->cs.p_code.TrueCodeOfPred), ASSEMBLING_INDEX);
}
}
/* we are pointing at ourselves */

36
m4/Yatom.h.m4
View File

@ -207,12 +207,20 @@ typedef struct {
typedef struct pred_entry {
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
unsigned int ArityOfPE; /* arity of property */
struct yami *CodeOfPred;
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
CELL PredFlags;
CODEADDR CodeOfPred; /* code address */
CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */
unsigned int ArityOfPE; /* arity of property */
union {
struct {
struct yami *TrueCodeOfPred; /* code address */
struct yami *FirstClause;
struct yami *LastClause;
} p_code;
CPredicate f_code;
CmpPredicate d_code;
} cs; /* if needing to spy or to lock */
Functor FunctorOfPred; /* functor for Predicate */
CODEADDR FirstClause, LastClause;
Atom OwnerFile; /* File where the predicate was defined */
struct pred_entry *NextPredOfModule; /* next pred for same module */
#if defined(YAPOR) || defined(THREADS)
@ -222,7 +230,6 @@ typedef struct pred_entry {
tab_ent_ptr TableOfPred;
#endif /* TABLING */
SMALLUNSGN ModuleOfPred; /* module for this definition */
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
profile_data StatisticsForPred; /* enable profiling for predicate */
SMALLUNSGN StateOfPred; /* actual state of predicate */
} PredEntry;
@ -238,20 +245,6 @@ Constructor(Prop,AbsPred,PredEntry *,p,p)
Inline(IsPredProperty, PropFlags, int, flags, (flags == PEProp) )
/********* maximum number of C-written predicates and cmp funcs ******************/
#define MAX_C_PREDS 400
#define MAX_CMP_FUNCS 20
typedef struct {
PredEntry *p;
CmpPredicate f;
} cmp_entry;
extern CPredicate Yap_c_predicates[MAX_C_PREDS];
extern cmp_entry Yap_cmp_funcs[MAX_CMP_FUNCS];
/* Flags for code or dbase entry */
/* There are several flags for code and data base entries */
typedef enum {
@ -280,7 +273,7 @@ typedef struct DB_STRUCT {
CELL Flags; /* Term Flags */
SMALLUNSGN NOfRefsTo; /* Number of references pointing here */
struct struct_dbentry *Parent; /* key of DBase reference */
CODEADDR Code; /* pointer to code if this is a clause */
struct yami *Code; /* pointer to code if this is a clause */
struct DB_STRUCT **DBRefs; /* pointer to other references */
struct DB_STRUCT *Prev; /* Previous element in chain */
struct DB_STRUCT *Next; /* Next element in chain */
@ -495,9 +488,6 @@ DBRef STD_PROTO(Yap_StoreTermInDB,(int,int));
Term STD_PROTO(Yap_FetchTermFromDB,(DBRef,int));
void STD_PROTO(Yap_ReleaseTermFromDB,(DBRef));
/* .c */
CODEADDR STD_PROTO(Yap_PredIsIndexable,(PredEntry *));
/* init.c */
Atom STD_PROTO(Yap_GetOp,(OpEntry *,int *,int));

18
pl/preds.yap
View File

@ -253,6 +253,7 @@ clause(V,Q,R) :-
'$some_recordedp'(M:P), !,
'$recordedp'(M:P,(P:-Q),R).
'$clause'(P,M,Q,_) :-
\+ '$undefined'(P,M),
( '$system_predicate'(P,M) -> true ;
'$number_of_clauses'(P,M,N), N > 0 ),
functor(P,Name,Arity),
@ -286,23 +287,6 @@ nth_clause(V,I,R) :-
'$do_error'(permission_error(access,private_procedure,Name/Arity),
nth_clause(M:P,I,R)).
'$clause'(V,M,Q,R) :- var(V), !,
'$do_error'(instantiation_error,M:clause(V,Q,R)).
'$clause'(C,M,Q,R) :- number(C), !,
'$do_error'(type_error(callable,C),clause(C,M:Q,R)).
'$clause'(R,M,Q,R1) :- db_reference(R), !,
'$do_error'(type_error(callable,R),clause(R,M:Q,R1)).
'$clause'(M:P,_,Q,R) :- !,
'$clause'(P,M,Q,R).
'$clause'(P,Mod,Q,R) :-
( '$is_dynamic'(P, Mod) ->
'$recordedp'(Mod:P,(P:-Q),R)
;
functor(P,N,A),
'$do_error'(permission_error(access,private_procedure,N/A),
clause(Mod:P,Q,R))
).
retract(M:C) :- !,
'$retract'(C,M).
retract(C) :-