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

255
C/absmi.c
View File

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

8
C/adtdefs.c
View File

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

24
C/agc.c
View File

@ -143,30 +143,6 @@ recompute_mask(DBRef dbr)
return; 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 static void
rehash(CELL *oldcode, int NOfE, int KindOfEntries) 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_xreg2, (void));
STATIC_PROTO(wamreg emit_x, (CELL)); STATIC_PROTO(wamreg emit_x, (CELL));
STATIC_PROTO(yslot emit_y, (Ventry *)); 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(CELL *emit_bmlabel, (CELL));
STATIC_PROTO(CODEADDR emit_ilabel, (CELL)); STATIC_PROTO(yamop *emit_ilabel, (CELL));
STATIC_PROTO(Functor emit_f, (CELL)); STATIC_PROTO(Functor emit_f, (CELL));
STATIC_PROTO(CELL emit_c, (CELL)); STATIC_PROTO(CELL emit_c, (CELL));
STATIC_PROTO(COUNT emit_count, (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))) #define GONEXT(TYPE) code_p = ((yamop *)(&(code_p->u.TYPE.next)))
static CODEADDR code_addr; static yamop *code_addr;
static int pass_no; static int pass_no;
static OPREG var_offset; static OPREG var_offset;
static int is_y_var; static int is_y_var;
@ -244,10 +244,10 @@ emit_x(CELL xarg)
#endif /* PRECOMPUTE_REGADDRESS */ #endif /* PRECOMPUTE_REGADDRESS */
} }
inline static CODEADDR inline static yamop *
emit_a(CELL a) emit_a(CELL a)
{ {
return ((CODEADDR) (a)); return ((yamop *) (a));
} }
inline static struct pred_entry * inline static struct pred_entry *
@ -256,7 +256,7 @@ emit_pe(struct pred_entry *a)
return (a); return (a);
} }
inline static CODEADDR inline static yamop *
emit_ilabel(register CELL addr) emit_ilabel(register CELL addr)
{ {
if (addr & 1) if (addr & 1)
@ -756,8 +756,6 @@ a_p(op_numbers opcode)
code_p->opc = emit_op(_call_c_wfail); code_p->opc = emit_op(_call_c_wfail);
code_p->u.sdl.s = code_p->u.sdl.s =
emit_count(-Signed(RealEnvSize) - CELLSIZE * cpc->rnd2); emit_count(-Signed(RealEnvSize) - CELLSIZE * cpc->rnd2);
code_p->u.sdl.d =
emit_a((CELL) RepPredProp(fe)->TrueCodeOfPred);
code_p->u.sdl.l = code_p->u.sdl.l =
emit_a(Unsigned(code_addr) + label_offset[comit_lab]); emit_a(Unsigned(code_addr) + label_offset[comit_lab]);
code_p->u.sdl.p = code_p->u.sdl.p =
@ -783,15 +781,13 @@ a_p(op_numbers opcode)
} }
code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE
* (cpc->rnd2)); * (cpc->rnd2));
code_p->u.sla.l = emit_a((CELL) code_p->u.sla.sla_u.p = RepPredProp(fe);
RepPredProp(fe)->TrueCodeOfPred);
code_p->u.sla.p = RepPredProp(fe);
code_p->u.sla.p0 = CurrentPred; code_p->u.sla.p0 = CurrentPred;
if (cpc->rnd2) if (cpc->rnd2)
code_p->u.sla.l2 = emit_bmlabel(cpc->arnds[1]); code_p->u.sla.bmap = emit_bmlabel(cpc->arnds[1]);
else else
/* there is no bitmap as there are no variables in the environment */ /* 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); GONEXT(sla);
} }
@ -820,22 +816,20 @@ a_p(op_numbers opcode)
if (pass_no) { if (pass_no) {
code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE * code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE *
cpc->rnd2); cpc->rnd2);
code_p->u.sla.l = emit_a((CELL) & code_p->u.sla.sla_u.p = RepPredProp(fe);
RepPredProp(fe)->StateOfPred);
code_p->u.sla.p = RepPredProp(fe);
code_p->u.sla.p0 = CurrentPred; code_p->u.sla.p0 = CurrentPred;
if (cpc->rnd2) if (cpc->rnd2)
code_p->u.sla.l2 = emit_bmlabel(cpc->arnds[1]); code_p->u.sla.bmap = emit_bmlabel(cpc->arnds[1]);
else else
/* there is no bitmap as there are no variables in the environment */ /* 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); GONEXT(sla);
} }
else { else {
if (pass_no) if (pass_no)
code_p->u.l.l = emit_a((CELL) &RepPredProp(fe)->StateOfPred); code_p->u.p.p = RepPredProp(fe);
GONEXT(l); GONEXT(p);
} }
if (!comit_ok) { if (!comit_ok) {
Yap_Error(SYSTEM_ERROR, TermNil, "internal assembler error for commit"); 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)); PredEntry *pe = RepPredProp(Yap_GetPredPropByAtom(AtomTrue,0));
code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE * code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE *
cpc->rnd2); cpc->rnd2);
code_p->u.sla.l = emit_a((CELL)&(pe->StateOfPred)); code_p->u.sla.sla_u.p = pe;
code_p->u.sla.p = pe;
code_p->u.sla.p0 = CurrentPred; code_p->u.sla.p0 = CurrentPred;
if (cpc->rnd2) if (cpc->rnd2)
code_p->u.sla.l2 = emit_bmlabel(cpc->rnd1); code_p->u.sla.bmap = emit_bmlabel(cpc->rnd1);
else else
/* there is no bitmap as there are no variables in the environment */ /* 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); GONEXT(sla);
} }
@ -926,7 +919,6 @@ a_bfunc(CELL pred)
if (pass_no) { if (pass_no) {
code_p->opc = emit_op(_call_bfunc_yy); code_p->opc = emit_op(_call_bfunc_yy);
code_p->u.lxy.p = RepPredProp(((Prop)pred)); 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.y1 = v1;
code_p->u.lyy.y2 = emit_yreg(var_offset); code_p->u.lyy.y2 = emit_yreg(var_offset);
code_p->u.lyy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE); code_p->u.lyy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
@ -935,7 +927,6 @@ a_bfunc(CELL pred)
} else { } else {
if (pass_no) { if (pass_no) {
code_p->opc = emit_op(_call_bfunc_yx); 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.p = RepPredProp(((Prop)pred));
code_p->u.lxy.x = emit_xreg(var_offset); code_p->u.lxy.x = emit_xreg(var_offset);
code_p->u.lxy.y = v1; code_p->u.lxy.y = v1;
@ -951,7 +942,6 @@ a_bfunc(CELL pred)
if (ve->KindOfVE == PermVar) { if (ve->KindOfVE == PermVar) {
if (pass_no) { if (pass_no) {
code_p->opc = emit_op(_call_bfunc_xy); 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.p = RepPredProp(((Prop)pred));
code_p->u.lxy.x = x1; code_p->u.lxy.x = x1;
code_p->u.lxy.y = emit_yreg(var_offset); code_p->u.lxy.y = emit_yreg(var_offset);
@ -962,7 +952,6 @@ a_bfunc(CELL pred)
if (pass_no) { if (pass_no) {
code_p->opc = emit_op(_call_bfunc_xx); code_p->opc = emit_op(_call_bfunc_xx);
code_p->u.lxy.p = RepPredProp(((Prop)pred)); 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.x1 = x1;
code_p->u.lxx.x2 = emit_xreg(var_offset); code_p->u.lxx.x2 = emit_xreg(var_offset);
code_p->u.lxx.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE); 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 */ #endif /* YAPOR */
{ {
if (pass_no) { if (pass_no) {
Prop fe = Yap_GetPredPropByAtom(AtomTrue,0);
code_p->opc = emit_op(opcode); code_p->opc = emit_op(opcode);
code_p->u.sla.s = emit_count(opr); code_p->u.sla.s = emit_count(opr);
code_p->u.sla.l = emit_a(lab); code_p->u.sla.sla_u.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.p0 = CurrentPred; code_p->u.sla.p0 = CurrentPred;
#ifdef YAPOR #ifdef YAPOR
/* code_p->u.sla.p = (CODEADDR)CurrentPred; */
INIT_YAMOP_LTT(code_p, nofalts); INIT_YAMOP_LTT(code_p, nofalts);
if (hascut) if (hascut)
PUT_YAMOP_CUT(code_p); PUT_YAMOP_CUT(code_p);
if (CurrentPred->PredFlags & SequentialPredFlag) if (CurrentPred->PredFlags & SequentialPredFlag)
PUT_YAMOP_SEQ(code_p); PUT_YAMOP_SEQ(code_p);
if(opcode != _or_last) { 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 #else
code_p->u.sla.l2 = emit_bmlabel(cpc->arnds[1]); code_p->u.sla.bmap = emit_bmlabel(cpc->arnds[1]);
#endif /* YAPOR */ #endif /* YAPOR */
} }
GONEXT(sla); GONEXT(sla);
@ -1966,7 +1951,7 @@ do_pass(void)
int ystop_found = FALSE; int ystop_found = FALSE;
alloc_found = dealloc_found = FALSE; alloc_found = dealloc_found = FALSE;
code_p = (yamop *) code_addr; code_p = code_addr;
cpc = CodeStart; cpc = CodeStart;
comit_lab = 0L; comit_lab = 0L;
/* Space while for the clause flags */ /* Space while for the clause flags */
@ -2576,7 +2561,7 @@ do_pass(void)
a_e(_Ystop); a_e(_Ystop);
} }
CODEADDR yamop *
Yap_assemble(int mode) Yap_assemble(int mode)
{ {
/* /*
@ -2586,7 +2571,7 @@ Yap_assemble(int mode)
*/ */
CELL size; CELL size;
code_addr = NIL; code_addr = NULL;
assembling = mode; assembling = mode;
clause_has_blobs = FALSE; clause_has_blobs = FALSE;
label_offset = (int *)freep; label_offset = (int *)freep;
@ -2596,7 +2581,7 @@ Yap_assemble(int mode)
if (asm_error) { if (asm_error) {
Yap_Error_TYPE = SYSTEM_ERROR; Yap_Error_TYPE = SYSTEM_ERROR;
Yap_ErrorMessage = "internal assembler error"; Yap_ErrorMessage = "internal assembler error";
return (NIL); return NULL;
} }
pass_no = 1; pass_no = 1;
YAPEnterCriticalSection(); YAPEnterCriticalSection();
@ -2610,17 +2595,17 @@ Yap_assemble(int mode)
#else #else
size = (CELL)code_p; size = (CELL)code_p;
#endif #endif
while ((code_addr = (CODEADDR) Yap_AllocCodeSpace(size)) == NULL) { while ((code_addr = (yamop *) Yap_AllocCodeSpace(size)) == NULL) {
if (!Yap_growheap(TRUE)) { if (!Yap_growheap(TRUE)) {
Yap_Error_TYPE = SYSTEM_ERROR; Yap_Error_TYPE = SYSTEM_ERROR;
return (NIL); return NULL;
} }
} }
do_pass(); do_pass();
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
{ {
Clause *cl = (Clause *)code_addr; /* lcc, why? */ 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 #define C_INTERFACE
#include "Yap.h" #include "Yap.h"
#include "Yatom.h" #include "clause.h"
#include "Heap.h"
#include "yapio.h" #include "yapio.h"
#define HAS_YAP_H 1 #define HAS_YAP_H 1
#include "yap_structs.h" #include "yap_structs.h"
@ -823,7 +822,7 @@ X_API char *
YAP_CompileClause(Term t) YAP_CompileClause(Term t)
{ {
char *Yap_ErrorMessage; char *Yap_ErrorMessage;
CODEADDR codeaddr; yamop *codeaddr;
int mod = CurrentModule; int mod = CurrentModule;
BACKUP_MACHINE_REGS(); 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 retract_all, (PredEntry *, int));
STATIC_PROTO(void add_first_static, (PredEntry *, CODEADDR, int)); STATIC_PROTO(void add_first_static, (PredEntry *, yamop *, int));
STATIC_PROTO(void add_first_dynamic, (PredEntry *, CODEADDR, int)); STATIC_PROTO(void add_first_dynamic, (PredEntry *, yamop *, int));
STATIC_PROTO(void asserta_stat_clause, (PredEntry *, CODEADDR, int)); STATIC_PROTO(void asserta_stat_clause, (PredEntry *, yamop *, int));
STATIC_PROTO(void asserta_dynam_clause, (PredEntry *, CODEADDR)); STATIC_PROTO(void asserta_dynam_clause, (PredEntry *, yamop *));
STATIC_PROTO(void assertz_stat_clause, (PredEntry *, CODEADDR, int)); STATIC_PROTO(void assertz_stat_clause, (PredEntry *, yamop *, int));
STATIC_PROTO(void assertz_dynam_clause, (PredEntry *, CODEADDR)); STATIC_PROTO(void assertz_dynam_clause, (PredEntry *, yamop *));
STATIC_PROTO(void expand_consult, (void)); STATIC_PROTO(void expand_consult, (void));
STATIC_PROTO(int not_was_reconsulted, (PredEntry *, Term, int)); STATIC_PROTO(int not_was_reconsulted, (PredEntry *, Term, int));
#if EMACS #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_call_count_reset, (void));
STATIC_PROTO(Int p_toggle_static_predicates_in_use, (void)); STATIC_PROTO(Int p_toggle_static_predicates_in_use, (void));
STATIC_PROTO(Atom YapConsultingFile, (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 PredArity(p) (p->ArityOfPE)
#define TRYCODE(G,F,N) ( (N)<5 ? (op_numbers)((int)F+(N)*3) : G) #define TRYCODE(G,F,N) ( (N)<5 ? (op_numbers)((int)F+(N)*3) : G)
#define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next))) #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 EXECUTING PROLOG CLAUSES
@ -145,18 +148,16 @@ static_in_use(PredEntry *p, int check_everything)
/* Index a prolog pred, given its predicate entry */ /* Index a prolog pred, given its predicate entry */
/* ap is already locked, but IPred is the one who gets rid of the lock. */ /* ap is already locked, but IPred is the one who gets rid of the lock. */
static void static void
IPred(CODEADDR sp) IPred(PredEntry *ap)
{ {
PredEntry *ap; yamop *BaseAddr;
CODEADDR BaseAddr;
int Arity; int Arity;
Functor f; Functor f;
ap = (PredEntry *) sp;
#ifdef TABLING #ifdef TABLING
if (is_tabled(ap)) { if (is_tabled(ap)) {
ap->CodeOfPred = ap->TrueCodeOfPred; ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
ap->OpcodeOfPred = ((yamop *)(ap->CodeOfPred))->opc; ap->OpcodeOfPred = ap->CodeOfPred->opc;
return; return;
} }
#endif /* TABLING */ #endif /* TABLING */
@ -184,17 +185,17 @@ IPred(CODEADDR sp)
"trying to index a predicate with 0 arguments"); "trying to index a predicate with 0 arguments");
return; return;
} }
if ((BaseAddr = Yap_PredIsIndexable(ap)) != NIL) { if ((BaseAddr = Yap_PredIsIndexable(ap)) != NULL) {
ap->TrueCodeOfPred = BaseAddr; ap->cs.p_code.TrueCodeOfPred = BaseAddr;
ap->PredFlags |= IndexedPredFlag; ap->PredFlags |= IndexedPredFlag;
} }
if (ap->PredFlags & SpiedPredFlag) { if (ap->PredFlags & SpiedPredFlag) {
ap->StateOfPred = StaticMask | SpiedMask; ap->StateOfPred = StaticMask | SpiedMask;
ap->OpcodeOfPred = Yap_opcode(_spy_pred); ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (CODEADDR)(&(ap->OpcodeOfPred)); ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else { } else {
ap->StateOfPred = 0; ap->StateOfPred = 0;
ap->CodeOfPred = ap->TrueCodeOfPred; ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
ap->OpcodeOfPred = ((yamop *)(ap->CodeOfPred))->opc; ap->OpcodeOfPred = ((yamop *)(ap->CodeOfPred))->opc;
} }
WRITE_UNLOCK(ap->PRWLock); WRITE_UNLOCK(ap->PRWLock);
@ -205,9 +206,9 @@ IPred(CODEADDR sp)
} }
void void
Yap_IPred(CODEADDR sp) Yap_IPred(PredEntry *p)
{ {
IPred(sp); IPred(p);
} }
#define GONEXT(TYPE) code_p = ((yamop *)(&(code_p->u.TYPE.next))) #define GONEXT(TYPE) code_p = ((yamop *)(&(code_p->u.TYPE.next)))
@ -241,9 +242,9 @@ recover_log_upd_clause(Clause *cl)
} }
static Clause * 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)); return(ClauseCodeToClause(addr));
} }
@ -288,18 +289,18 @@ Yap_RemoveLogUpdIndex(Clause *cl)
static int static int
RemoveIndexation(PredEntry *ap) RemoveIndexation(PredEntry *ap)
{ {
register CODEADDR First; register yamop *First;
int spied; int spied;
First = ap->FirstClause; First = ap->cs.p_code.FirstClause;
if (ap->OpcodeOfPred == INDEX_OPCODE) { if (ap->OpcodeOfPred == INDEX_OPCODE) {
return (TRUE); return (TRUE);
} }
spied = ap->PredFlags & SpiedPredFlag; spied = ap->PredFlags & SpiedPredFlag;
if (ap->PredFlags & LogUpdatePredFlag) if (ap->PredFlags & LogUpdatePredFlag)
RemoveLogUpdIndex(ClauseCodeToClause(ap->TrueCodeOfPred)); RemoveLogUpdIndex(ClauseCodeToClause(ap->cs.p_code.TrueCodeOfPred));
else { else {
Clause *cl = ClauseCodeToClause(ap->TrueCodeOfPred); Clause *cl = ClauseCodeToClause(ap->cs.p_code.TrueCodeOfPred);
if (static_in_use(ap, FALSE)) { if (static_in_use(ap, FALSE)) {
/* This should never happen */ /* This should never happen */
cl->u.NextCl = DeadClauses; cl->u.NextCl = DeadClauses;
@ -308,17 +309,17 @@ RemoveIndexation(PredEntry *ap)
Yap_FreeCodeSpace((char *)cl); Yap_FreeCodeSpace((char *)cl);
} }
} }
if (First != ap->LastClause) if (First != ap->cs.p_code.LastClause)
ap->TrueCodeOfPred = First; ap->cs.p_code.TrueCodeOfPred = First;
ap->PredFlags ^= IndexedPredFlag; ap->PredFlags ^= IndexedPredFlag;
if (First != NIL && spied) { if (First != NIL && spied) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred); ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (CODEADDR)(&(ap->OpcodeOfPred)); ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
ap->StateOfPred = StaticMask | SpiedMask; ap->StateOfPred = StaticMask | SpiedMask;
} else { } else {
ap->StateOfPred = StaticMask; ap->StateOfPred = StaticMask;
ap->OpcodeOfPred = ((yamop *)(ap->TrueCodeOfPred))->opc; ap->OpcodeOfPred = ap->cs.p_code.TrueCodeOfPred->opc;
ap->CodeOfPred = ap->TrueCodeOfPred; ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
} }
return (TRUE); return (TRUE);
} }
@ -343,11 +344,11 @@ Yap_RemoveIndexation(PredEntry *ap)
static void static void
retract_all(PredEntry *p, int in_use) retract_all(PredEntry *p, int in_use)
{ {
CODEADDR q, q1; yamop *q, *q1;
int multifile_pred = p->PredFlags & MultiFileFlag; 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) { if (q != NIL) {
do { do {
Clause *cl; 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->cs.p_code.FirstClause = fclause;
p->LastClause = lclause; p->cs.p_code.LastClause = lclause;
if (fclause == NIL) { if (fclause == NIL) {
if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) { if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) {
p->OpcodeOfPred = FAIL_OPCODE; p->OpcodeOfPred = FAIL_OPCODE;
} else { } else {
p->OpcodeOfPred = UNDEF_OPCODE; 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.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0; p->StatisticsForPred.NOfHeadSuccesses = 0;
p->StatisticsForPred.NOfRetries = 0; p->StatisticsForPred.NOfRetries = 0;
@ -392,10 +393,10 @@ retract_all(PredEntry *p, int in_use)
yamop *cpt = (yamop *)fclause; yamop *cpt = (yamop *)fclause;
cpt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p))); cpt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p)));
if (fclause == lclause) { 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; p->OpcodeOfPred = NEXTOP(cpt,ld)->opc;
} else { } else {
p->TrueCodeOfPred = p->CodeOfPred = fclause; p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = fclause;
p->OpcodeOfPred = cpt->opc; p->OpcodeOfPred = cpt->opc;
if (p->PredFlags & ProfiledPredFlag) { if (p->PredFlags & ProfiledPredFlag) {
((yamop *)lclause)->opc = Yap_opcode(_profiled_trust_me); ((yamop *)lclause)->opc = Yap_opcode(_profiled_trust_me);
@ -408,10 +409,10 @@ retract_all(PredEntry *p, int in_use)
if (p->PredFlags & SpiedPredFlag) { if (p->PredFlags & SpiedPredFlag) {
p->StateOfPred |= StaticMask | SpiedMask; p->StateOfPred |= StaticMask | SpiedMask;
p->OpcodeOfPred = Yap_opcode(_spy_pred); p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} else if (p->PredFlags & IndexedPredFlag) { } else if (p->PredFlags & IndexedPredFlag) {
p->OpcodeOfPred = INDEX_OPCODE; p->OpcodeOfPred = INDEX_OPCODE;
p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} }
} }
if (PROFILING) { if (PROFILING) {
@ -428,7 +429,7 @@ retract_all(PredEntry *p, int in_use)
/* p is already locked */ /* p is already locked */
static void 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; 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->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p)));
pt = NEXTOP(pt, ld); pt = NEXTOP(pt, ld);
} }
p->TrueCodeOfPred = (CODEADDR)pt; p->cs.p_code.TrueCodeOfPred = pt;
p->FirstClause = p->LastClause = cp; p->cs.p_code.FirstClause = p->cs.p_code.LastClause = cp;
p->StatisticsForPred.NOfEntries = 0; p->StatisticsForPred.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0; p->StatisticsForPred.NOfHeadSuccesses = 0;
p->StatisticsForPred.NOfRetries = 0; p->StatisticsForPred.NOfRetries = 0;
@ -469,7 +470,7 @@ add_first_static(PredEntry *p, CODEADDR cp, int spy_flag)
if (spy_flag) { if (spy_flag) {
p->StateOfPred |= StaticMask | SpiedMask; p->StateOfPred |= StaticMask | SpiedMask;
p->OpcodeOfPred = Yap_opcode(_spy_pred); p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} else if (is_fast(p)) { } else if (is_fast(p)) {
p->StateOfPred |= StaticMask; p->StateOfPred |= StaticMask;
} else { } else {
@ -484,7 +485,7 @@ add_first_static(PredEntry *p, CODEADDR cp, int spy_flag)
/* p is already locked */ /* p is already locked */
static void 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; yamop *ncp = ((Clause *)NIL)->ClCode;
Clause *cl; Clause *cl;
@ -536,25 +537,25 @@ add_first_dynamic(PredEntry *p, CODEADDR cp, int spy_flag)
PUT_YAMOP_SEQ(ncp); PUT_YAMOP_SEQ(ncp);
#endif /* YAPOR */ #endif /* YAPOR */
/* This is the point we enter the code */ /* 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 /* set the first clause to have a retry and mark which will
* backtrack to the previous block */ * backtrack to the previous block */
if (p->PredFlags & ProfiledPredFlag) 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) else if (p->PredFlags & CountPredFlag)
((yamop *)cp)->opc = Yap_opcode(_count_retry_and_mark); cp->opc = Yap_opcode(_count_retry_and_mark);
else else
((yamop *)cp)->opc = Yap_opcode(_retry_and_mark); cp->opc = Yap_opcode(_retry_and_mark);
((yamop *)cp)->u.ld.s = p->ArityOfPE; cp->u.ld.s = p->ArityOfPE;
((yamop *)cp)->u.ld.p = p; cp->u.ld.p = p;
((yamop *)cp)->u.ld.d = (CODEADDR)ncp; cp->u.ld.d = ncp;
#ifdef KEEP_ENTRY_AGE #ifdef KEEP_ENTRY_AGE
/* also, keep a backpointer for the days you delete the clause */ /* also, keep a backpointer for the days you delete the clause */
ClauseCodeToClause(cp)->u.ClPrevious = ncp; ClauseCodeToClause(cp)->u.ClPrevious = ncp;
#endif #endif
/* Don't forget to say who is the only clause for the predicate so /* Don't forget to say who is the only clause for the predicate so
far */ 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 /* we're only missing what to do when we actually exit the procedure
*/ */
ncp = NEXTOP(ncp,ld); ncp = NEXTOP(ncp,ld);
@ -570,13 +571,13 @@ add_first_dynamic(PredEntry *p, CODEADDR cp, int spy_flag)
/* p is already locked */ /* p is already locked */
static void 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; yamop *q = (yamop *)cp;
q->u.ld.d = p->FirstClause; q->u.ld.d = p->cs.p_code.FirstClause;
q->u.ld.p = p; q->u.ld.p = p;
#ifdef YAPOR #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 */ #endif /* YAPOR */
#ifdef TABLING #ifdef TABLING
if (is_tabled(p)) if (is_tabled(p))
@ -584,19 +585,19 @@ asserta_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
else else
#endif /* TABLING */ #endif /* TABLING */
q->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p))); 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->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); q->opc = Yap_opcode(_profiled_trust_me);
else else
q->opc = Yap_opcode(_profiled_retry_me); q->opc = Yap_opcode(_profiled_retry_me);
} else if (p->PredFlags & CountPredFlag) { } 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); q->opc = Yap_opcode(_count_trust_me);
else else
q->opc = Yap_opcode(_count_retry_me); q->opc = Yap_opcode(_count_retry_me);
} else { } else {
if (p->FirstClause == p->LastClause) { if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) {
#ifdef TABLING #ifdef TABLING
if (is_tabled(p)) if (is_tabled(p))
q->opc = Yap_opcode(_table_trust_me); 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))); q->opc = Yap_opcode(TRYCODE(_retry_me, _retry_me0, PredArity(p)));
} }
} }
p->TrueCodeOfPred = p->FirstClause = cp; p->cs.p_code.TrueCodeOfPred = p->cs.p_code.FirstClause = cp;
q = ((yamop *)p->LastClause); p->cs.p_code.LastClause->u.ld.d = cp;
q->u.ld.d = cp;
} }
/* p is already locked */ /* p is already locked */
static void static void
asserta_dynam_clause(PredEntry *p, CODEADDR cp) asserta_dynam_clause(PredEntry *p, yamop *cp)
{ {
yamop *q; yamop *q;
q = (yamop *)cp; q = cp;
LOCK(ClauseCodeToClause(p->FirstClause)->ClLock); LOCK(ClauseCodeToClause(p->cs.p_code.FirstClause)->ClLock);
#ifdef KEEP_ENTRY_AGE #ifdef KEEP_ENTRY_AGE
/* also, keep backpointers for the days we'll delete all the clause */ /* 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); ClauseCodeToClause(cp)->u.ClPrevious = (yamop *)(p->CodeOfPred);
#endif #endif
UNLOCK(ClauseCodeToClause(p->FirstClause)->ClLock); UNLOCK(ClauseCodeToClause(p->cs.p_code.FirstClause)->ClLock);
q->u.ld.d = p->FirstClause; q->u.ld.d = p->cs.p_code.FirstClause;
q->u.ld.s = p->ArityOfPE; q->u.ld.s = p->ArityOfPE;
q->u.ld.p = p; q->u.ld.p = p;
if (p->PredFlags & ProfiledPredFlag) 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) else if (p->PredFlags & CountPredFlag)
((yamop *)cp)->opc = Yap_opcode(_count_retry_and_mark); cp->opc = Yap_opcode(_count_retry_and_mark);
else else
((yamop *)cp)->opc = Yap_opcode(_retry_and_mark); cp->opc = Yap_opcode(_retry_and_mark);
((yamop *)cp)->u.ld.s = p->ArityOfPE; cp->u.ld.s = p->ArityOfPE;
((yamop *)cp)->u.ld.p = p; cp->u.ld.p = p;
p->FirstClause = cp; p->cs.p_code.FirstClause = cp;
q = (yamop *)p->CodeOfPred; q = p->CodeOfPred;
q->u.ld.d = cp; q->u.ld.d = cp;
q->u.ld.s = p->ArityOfPE; q->u.ld.s = p->ArityOfPE;
q->u.ld.p = p; q->u.ld.p = p;
@ -650,31 +650,31 @@ asserta_dynam_clause(PredEntry *p, CODEADDR cp)
/* p is already locked */ /* p is already locked */
static void static void
assertz_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag) assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag)
{ {
yamop *pt; yamop *pt;
pt = (yamop *)(p->LastClause); pt = (yamop *)(p->cs.p_code.LastClause);
if (p->PredFlags & ProfiledPredFlag) { 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))); 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 } else
pt->opc = Yap_opcode(_profiled_retry_me); pt->opc = Yap_opcode(_profiled_retry_me);
} else if (p->PredFlags & CountPredFlag) { } 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))); 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 } else
pt->opc = Yap_opcode(_count_retry_me); pt->opc = Yap_opcode(_count_retry_me);
} else { } else {
if (p->FirstClause == p->LastClause) { if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) {
#ifdef TABLING #ifdef TABLING
if (is_tabled(p)) if (is_tabled(p))
pt->opc = Yap_opcode(_table_try_me); pt->opc = Yap_opcode(_table_try_me);
else else
#endif /* TABLING */ #endif /* TABLING */
pt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p))); 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 { } else {
#ifdef TABLING #ifdef TABLING
if (is_tabled(p)) if (is_tabled(p))
@ -685,7 +685,7 @@ assertz_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
} }
} }
pt->u.ld.d = cp; pt->u.ld.d = cp;
p->LastClause = cp; p->cs.p_code.LastClause = cp;
pt = (yamop *)cp; pt = (yamop *)cp;
if (p->PredFlags & ProfiledPredFlag) { if (p->PredFlags & ProfiledPredFlag) {
pt->opc = Yap_opcode(_profiled_trust_me); pt->opc = Yap_opcode(_profiled_trust_me);
@ -699,13 +699,13 @@ assertz_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
#endif /* TABLING */ #endif /* TABLING */
pt->opc = Yap_opcode(TRYCODE(_trust_me, _trust_me0, PredArity(p))); 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 #ifdef YAPOR
{ {
CODEADDR code; yamop *code;
code = p->FirstClause; code = p->cs.p_code.FirstClause;
while (code != p->LastClause){ while (code != p->cs.p_code.LastClause){
PUT_YAMOP_LTT((yamop *)code, YAMOP_LTT((yamop *)code) + 1); PUT_YAMOP_LTT((yamop *)code, YAMOP_LTT((yamop *)code) + 1);
code = NextClause(code); code = NextClause(code);
} }
@ -715,14 +715,14 @@ assertz_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
/* p is already locked */ /* p is already locked */
static void static void
assertz_dynam_clause(PredEntry *p, CODEADDR cp) assertz_dynam_clause(PredEntry *p, yamop *cp)
{ {
yamop *q; yamop *q;
q = (yamop *)(p->LastClause); q = p->cs.p_code.LastClause;
LOCK(ClauseCodeToClause(q)->ClLock); LOCK(ClauseCodeToClause(q)->ClLock);
q->u.ld.d = cp; q->u.ld.d = cp;
p->LastClause = cp; p->cs.p_code.LastClause = cp;
#ifdef KEEP_ENTRY_AGE #ifdef KEEP_ENTRY_AGE
/* also, keep backpointers for the days we'll delete all the clause */ /* also, keep backpointers for the days we'll delete all the clause */
ClauseCodeToClause(cp)->u.ClPrevious = q; ClauseCodeToClause(cp)->u.ClPrevious = q;
@ -831,7 +831,7 @@ addcl_permission_error(AtomEntry *ap, Int Arity, int in_use)
static void 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 * mode 0 assertz 1 consult 2 asserta
*/ */
@ -888,19 +888,19 @@ addclause(Term t, CODEADDR cp, int mode, int mod)
else else
p->PredFlags |= CompiledPredFlag; p->PredFlags |= CompiledPredFlag;
if ((Yap_GetValue(AtomIndex) != TermNil) && if ((Yap_GetValue(AtomIndex) != TermNil) &&
(p->FirstClause != NIL) && (p->cs.p_code.FirstClause != NIL) &&
(Arity != 0)) { (Arity != 0)) {
p->OpcodeOfPred = INDEX_OPCODE; 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)) { if (!(p->PredFlags & DynamicPredFlag)) {
add_first_static(p, cp, spy_flag); add_first_static(p, cp, spy_flag);
/* make sure we have a place to jump to */ /* make sure we have a place to jump to */
if (p->OpcodeOfPred == UNDEF_OPCODE || if (p->OpcodeOfPred == UNDEF_OPCODE ||
p->OpcodeOfPred == FAIL_OPCODE) { /* log updates */ p->OpcodeOfPred == FAIL_OPCODE) { /* log updates */
p->CodeOfPred = p->TrueCodeOfPred; p->CodeOfPred = p->cs.p_code.TrueCodeOfPred;
p->OpcodeOfPred = ((yamop *)(p->CodeOfPred))->opc; p->OpcodeOfPred = ((yamop *)(p->CodeOfPred))->opc;
} }
} else { } else {
@ -917,7 +917,7 @@ addclause(Term t, CODEADDR cp, int mode, int mod)
assertz_stat_clause(p, cp, spy_flag); assertz_stat_clause(p, cp, spy_flag);
if (p->OpcodeOfPred != INDEX_OPCODE && if (p->OpcodeOfPred != INDEX_OPCODE &&
p->OpcodeOfPred != Yap_opcode(_spy_pred)) { p->OpcodeOfPred != Yap_opcode(_spy_pred)) {
p->CodeOfPred = p->TrueCodeOfPred; p->CodeOfPred = p->cs.p_code.TrueCodeOfPred;
p->OpcodeOfPred = ((yamop *)(p->CodeOfPred))->opc; p->OpcodeOfPred = ((yamop *)(p->CodeOfPred))->opc;
} }
} }
@ -925,7 +925,7 @@ addclause(Term t, CODEADDR cp, int mode, int mod)
} }
void 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); addclause(t, cp, mode, mod);
} }
@ -1034,11 +1034,11 @@ last_clause_number(p)
PredEntry *p; PredEntry *p;
{ {
int i = 1; int i = 1;
CODEADDR q = p->FirstClause; yamop *q = p->cs.p_code.FirstClause;
if (q == NIL) if (q == NIL)
return (0); return (0);
while (q != p->LastClause) { while (q != p->cs.p_code.LastClause) {
q = NextClause(q); q = NextClause(q);
i++; i++;
} }
@ -1069,7 +1069,7 @@ p_compile(void)
Term t = Deref(ARG1); Term t = Deref(ARG1);
Term t1 = Deref(ARG2); Term t1 = Deref(ARG2);
Term t3 = Deref(ARG3); Term t3 = Deref(ARG3);
CODEADDR codeadr; yamop *codeadr;
Int mod; Int mod;
if (IsVarTerm(t1) || !IsIntTerm(t1)) if (IsVarTerm(t1) || !IsIntTerm(t1))
@ -1100,7 +1100,7 @@ p_compile_dynamic(void)
Term t1 = Deref(ARG2); Term t1 = Deref(ARG2);
Term t3 = Deref(ARG3); Term t3 = Deref(ARG3);
Clause *cl; Clause *cl;
CODEADDR code_adr; yamop *code_adr;
int old_optimize; int old_optimize;
Int mod; Int mod;
@ -1212,7 +1212,7 @@ end_consult(void)
PredEntry *pred = RepPredProp(fp->p); PredEntry *pred = RepPredProp(fp->p);
WRITE_LOCK(pred->PRWLock); WRITE_LOCK(pred->PRWLock);
if (pred->OpcodeOfPred == INDEX_OPCODE) { if (pred->OpcodeOfPred == INDEX_OPCODE) {
IPred((CODEADDR)pred); IPred(pred);
/* IPred does the unlocking */ /* IPred does the unlocking */
} else { } else {
WRITE_UNLOCK(pred->PRWLock); WRITE_UNLOCK(pred->PRWLock);
@ -1248,7 +1248,7 @@ p_purge_clauses(void)
PredEntry *pred; PredEntry *pred;
Term t = Deref(ARG1); Term t = Deref(ARG1);
Term t2 = Deref(ARG2); Term t2 = Deref(ARG2);
CODEADDR q, q1; yamop *q, *q1;
SMALLUNSGN mod; SMALLUNSGN mod;
int in_use; int in_use;
@ -1276,7 +1276,7 @@ p_purge_clauses(void)
if (pred->PredFlags & IndexedPredFlag) if (pred->PredFlags & IndexedPredFlag)
RemoveIndexation(pred); RemoveIndexation(pred);
Yap_PutValue(AtomAbol, MkAtomTerm(AtomTrue)); Yap_PutValue(AtomAbol, MkAtomTerm(AtomTrue));
q = pred->FirstClause; q = pred->cs.p_code.FirstClause;
in_use = static_in_use(pred,FALSE); in_use = static_in_use(pred,FALSE);
if (q != NIL) if (q != NIL)
do { do {
@ -1293,16 +1293,16 @@ p_purge_clauses(void)
Yap_FreeCodeSpace((char *)cl); Yap_FreeCodeSpace((char *)cl);
} }
} }
} while (q1 != pred->LastClause); } while (q1 != pred->cs.p_code.LastClause);
pred->FirstClause = pred->LastClause = NIL; pred->cs.p_code.FirstClause = pred->cs.p_code.LastClause = NIL;
if (pred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) { if (pred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) {
pred->OpcodeOfPred = FAIL_OPCODE; pred->OpcodeOfPred = FAIL_OPCODE;
} else { } else {
pred->OpcodeOfPred = UNDEF_OPCODE; pred->OpcodeOfPred = UNDEF_OPCODE;
} }
pred->TrueCodeOfPred = pred->cs.p_code.TrueCodeOfPred =
pred->CodeOfPred = pred->CodeOfPred =
(CODEADDR)(&(pred->OpcodeOfPred)); (yamop *)(&(pred->OpcodeOfPred));
pred->OwnerFile = AtomNil; pred->OwnerFile = AtomNil;
if (pred->PredFlags & MultiFileFlag) if (pred->PredFlags & MultiFileFlag)
pred->PredFlags ^= MultiFileFlag; pred->PredFlags ^= MultiFileFlag;
@ -1357,7 +1357,7 @@ p_setspy(void)
return (FALSE); return (FALSE);
} }
if (pred->OpcodeOfPred == INDEX_OPCODE) { if (pred->OpcodeOfPred == INDEX_OPCODE) {
IPred((CODEADDR)pred); IPred(pred);
goto restart_spy; goto restart_spy;
} }
fg = pred->PredFlags; fg = pred->PredFlags;
@ -1367,7 +1367,7 @@ p_setspy(void)
Yap_opcode(_spy_or_trymark); Yap_opcode(_spy_or_trymark);
} else { } else {
pred->OpcodeOfPred = Yap_opcode(_spy_pred); pred->OpcodeOfPred = Yap_opcode(_spy_pred);
pred->CodeOfPred = (CODEADDR)(&(pred->OpcodeOfPred)); pred->CodeOfPred = (yamop *)(&(pred->OpcodeOfPred));
} }
pred->StateOfPred |= SpiedMask; pred->StateOfPred |= SpiedMask;
pred->PredFlags |= SpiedPredFlag; pred->PredFlags |= SpiedPredFlag;
@ -1406,9 +1406,9 @@ p_rmspy(void)
} }
if (!(pred->PredFlags & DynamicPredFlag)) { if (!(pred->PredFlags & DynamicPredFlag)) {
if ((pred->StateOfPred ^= SpiedMask) & InUseMask) if ((pred->StateOfPred ^= SpiedMask) & InUseMask)
pred->CodeOfPred = pred->TrueCodeOfPred; pred->CodeOfPred = pred->cs.p_code.TrueCodeOfPred;
else else
pred->CodeOfPred = pred->TrueCodeOfPred; pred->CodeOfPred = pred->cs.p_code.TrueCodeOfPred;
pred->OpcodeOfPred = ((yamop *)(pred->CodeOfPred))->opc; pred->OpcodeOfPred = ((yamop *)(pred->CodeOfPred))->opc;
} else if (pred->OpcodeOfPred == Yap_opcode(_spy_or_trymark)) { } else if (pred->OpcodeOfPred == Yap_opcode(_spy_or_trymark)) {
pred->OpcodeOfPred = Yap_opcode(_try_and_mark); pred->OpcodeOfPred = Yap_opcode(_try_and_mark);
@ -1433,7 +1433,7 @@ p_number_of_clauses(void)
Term t2 = Deref(ARG2); Term t2 = Deref(ARG2);
int ncl = 0; int ncl = 0;
Prop pe; Prop pe;
CODEADDR q; yamop *q;
int testing; int testing;
int mod; int mod;
@ -1449,14 +1449,14 @@ p_number_of_clauses(void)
pe = PredPropByFunc(f, mod); pe = PredPropByFunc(f, mod);
} else } else
return (FALSE); return (FALSE);
q = RepPredProp(pe)->FirstClause; q = RepPredProp(pe)->cs.p_code.FirstClause;
READ_LOCK(RepPredProp(pe)->PRWLock); READ_LOCK(RepPredProp(pe)->PRWLock);
if (q != NIL) { if (q != NIL) {
if (RepPredProp(pe)->PredFlags & DynamicPredFlag) if (RepPredProp(pe)->PredFlags & DynamicPredFlag)
testing = TRUE; testing = TRUE;
else else
testing = FALSE; testing = FALSE;
while (q != RepPredProp(pe)->LastClause) { while (q != RepPredProp(pe)->cs.p_code.LastClause) {
if (!testing || if (!testing ||
!(ClauseCodeToClause(q)->ClFlags & ErasedMask)) !(ClauseCodeToClause(q)->ClFlags & ErasedMask))
ncl++; ncl++;
@ -1761,13 +1761,13 @@ p_kill_dynamic(void)
WRITE_UNLOCK(pe->PRWLock); WRITE_UNLOCK(pe->PRWLock);
return (FALSE); return (FALSE);
} }
if (pe->LastClause != pe->FirstClause) { if (pe->cs.p_code.LastClause != pe->cs.p_code.FirstClause) {
WRITE_UNLOCK(pe->PRWLock); WRITE_UNLOCK(pe->PRWLock);
return (FALSE); return (FALSE);
} }
pe->LastClause = pe->FirstClause = NIL; pe->cs.p_code.LastClause = pe->cs.p_code.FirstClause = NIL;
pe->OpcodeOfPred = UNDEF_OPCODE; pe->OpcodeOfPred = UNDEF_OPCODE;
pe->TrueCodeOfPred = pe->CodeOfPred = (CODEADDR)(&(pe->OpcodeOfPred)); pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
pe->PredFlags = 0L; pe->PredFlags = 0L;
WRITE_UNLOCK(pe->PRWLock); WRITE_UNLOCK(pe->PRWLock);
return (TRUE); return (TRUE);
@ -1801,35 +1801,37 @@ p_compile_mode(void)
} }
#if !defined(YAPOR) #if !defined(YAPOR)
static yamop *next_clause(PredEntry *pe, CODEADDR codeptr) static yamop *next_clause(PredEntry *pe, yamop *codeptr)
{ {
CODEADDR clcode, cl; yamop *clcode;
clcode = pe->FirstClause; Clause *cl;
cl = (CODEADDR)ClauseCodeToClause(clcode); clcode = pe->cs.p_code.FirstClause;
cl = ClauseCodeToClause(clcode);
do { do {
if (clcode == pe->LastClause) if (clcode == pe->cs.p_code.LastClause)
break; break;
if (codeptr > cl && codeptr <= cl + Yap_SizeOfBlock(cl)) { if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) {
return((yamop *)NextClause(clcode)); return(NextClause(clcode));
} }
cl = (CODEADDR)ClauseCodeToClause(clcode = NextClause(clcode)); cl = ClauseCodeToClause(clcode = NextClause(clcode));
} while (TRUE); } while (TRUE);
Yap_Error(SYSTEM_ERROR,TermNil,"could not find clause for indexing code"); Yap_Error(SYSTEM_ERROR,TermNil,"could not find clause for indexing code");
return(NULL); return(NULL);
} }
static yamop *cur_clause(PredEntry *pe, CODEADDR codeptr) static yamop *cur_clause(PredEntry *pe, yamop *codeptr)
{ {
CODEADDR clcode, cl; yamop *clcode;
clcode = pe->FirstClause; Clause *cl;
cl = (CODEADDR)ClauseCodeToClause(clcode); clcode = pe->cs.p_code.FirstClause;
cl = ClauseCodeToClause(clcode);
do { do {
if (codeptr > cl && codeptr <= cl + Yap_SizeOfBlock(cl)) { if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) {
return((yamop *)clcode); return((yamop *)clcode);
} }
if (clcode == pe->LastClause) if (clcode == pe->cs.p_code.LastClause)
break; break;
cl = (CODEADDR)ClauseCodeToClause(clcode = NextClause(clcode)); cl = ClauseCodeToClause(clcode = NextClause(clcode));
} while (TRUE); } while (TRUE);
Yap_Error(SYSTEM_ERROR,TermNil,"could not find clause for indexing code"); Yap_Error(SYSTEM_ERROR,TermNil,"could not find clause for indexing code");
return(NULL); return(NULL);
@ -1888,9 +1890,9 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything)
return(TRUE); return(TRUE);
READ_LOCK(pe->PRWLock); READ_LOCK(pe->PRWLock);
if (p->PredFlags & IndexedPredFlag) { if (p->PredFlags & IndexedPredFlag) {
CODEADDR code_p = (CODEADDR)(b_ptr->cp_ap); yamop *code_p = b_ptr->cp_ap;
if (code_p >= p->TrueCodeOfPred && if (code_p >= p->cs.p_code.TrueCodeOfPred &&
code_p <= p->TrueCodeOfPred + Yap_SizeOfBlock((CODEADDR)ClauseCodeToClause(p->TrueCodeOfPred))) { code_p <= p->cs.p_code.TrueCodeOfPred + Yap_SizeOfBlock((CODEADDR)ClauseCodeToClause(p->cs.p_code.TrueCodeOfPred))) {
yamop *prev; yamop *prev;
/* fix the choicepoint */ /* fix the choicepoint */
switch(opnum) { switch(opnum) {
@ -2104,17 +2106,17 @@ p_toggle_static_predicates_in_use(void)
static Int static Int
code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, CODEADDR codeptr) { code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
CODEADDR clcode, cl; yamop *clcode;
Clause *cl;
int i = 1; int i = 1;
READ_LOCK(pp->PRWLock); READ_LOCK(pp->PRWLock);
clcode = pp->FirstClause; clcode = pp->cs.p_code.FirstClause;
if (clcode != NIL) { if (clcode != NIL) {
/* check if the codeptr comes from the indexing code */ /* check if the codeptr comes from the indexing code */
if ((pp->PredFlags & IndexedPredFlag) && if ((pp->PredFlags & IndexedPredFlag) &&
codeptr > pp->TrueCodeOfPred && IN_BLOCK(codeptr,pp->cs.p_code.TrueCodeOfPred,Yap_SizeOfBlock((CODEADDR)(pp->cs.p_code.TrueCodeOfPred)))) {
codeptr <= pp->TrueCodeOfPred + Yap_SizeOfBlock(pp->TrueCodeOfPred)) {
*parity = pp->ArityOfPE; *parity = pp->ArityOfPE;
if (pp->ArityOfPE) { if (pp->ArityOfPE) {
*pat = NameOfFunctor(pp->FunctorOfPred); *pat = NameOfFunctor(pp->FunctorOfPred);
@ -2124,9 +2126,9 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, CODEADDR codeptr) {
READ_UNLOCK(pp->PRWLock); READ_UNLOCK(pp->PRWLock);
return(-1); return(-1);
} }
cl = (CODEADDR)ClauseCodeToClause(clcode); cl = ClauseCodeToClause(clcode);
do { do {
if (codeptr > cl && codeptr <= cl + Yap_SizeOfBlock(cl)) { if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) {
/* we found it */ /* we found it */
*parity = pp->ArityOfPE; *parity = pp->ArityOfPE;
if (pp->ArityOfPE) { if (pp->ArityOfPE) {
@ -2137,9 +2139,9 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, CODEADDR codeptr) {
READ_UNLOCK(pp->PRWLock); READ_UNLOCK(pp->PRWLock);
return(i); return(i);
} }
if (clcode == pp->LastClause) if (clcode == pp->cs.p_code.LastClause)
break; break;
cl = (CODEADDR)ClauseCodeToClause(clcode = NextClause(clcode)); cl = ClauseCodeToClause(clcode = NextClause(clcode));
i++; i++;
} while (TRUE); } while (TRUE);
} }
@ -2148,7 +2150,7 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, CODEADDR codeptr) {
} }
static Int static Int
PredForCode(CODEADDR codeptr, Atom *pat, UInt *parity, SMALLUNSGN *pmodule) { PredForCode(yamop *codeptr, Atom *pat, UInt *parity, SMALLUNSGN *pmodule) {
Int found = 0; Int found = 0;
Int i_table; Int i_table;
@ -2167,14 +2169,14 @@ PredForCode(CODEADDR codeptr, Atom *pat, UInt *parity, SMALLUNSGN *pmodule) {
} }
Int 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); return PredForCode(codeptr, pat, parity, pmodule);
} }
static Int static Int
p_pred_for_code(void) { p_pred_for_code(void) {
CODEADDR codeptr = (CODEADDR)IntegerOfTerm(Deref(ARG1)); yamop *codeptr = (yamop *)IntegerOfTerm(Deref(ARG1));
Atom at; Atom at;
UInt arity; UInt arity;
SMALLUNSGN module; SMALLUNSGN module;
@ -2381,7 +2383,7 @@ p_parent_pred(void)
Atom at; Atom at;
UInt arity; UInt arity;
SMALLUNSGN module; 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)) && return(Yap_unify(ARG1, MkIntTerm(0)) &&
Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) && Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) &&
Yap_unify(ARG3, MkIntTerm(0))); Yap_unify(ARG3, MkIntTerm(0)));

8
C/compiler.c
View File

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

4
C/errors.c
View File

@ -143,7 +143,7 @@ DumpActiveGoals (void)
restart_cp: restart_cp:
switch(opnum) { switch(opnum) {
case _or_else: 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); 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; SMALLUNSGN pred_module;
Int cl; 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) { == 0) {
/* system predicate */ /* system predicate */
#if HAVE_SNPRINTF #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_execute0, (void));
STATIC_PROTO(Int p_at_execute, (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 static Term
current_cp_as_integer(void) current_cp_as_integer(void)
{ {
@ -109,7 +105,7 @@ CallClause(PredEntry *pen, Int position)
flags = pen->PredFlags; flags = pen->PredFlags;
if ((flags & (CompiledPredFlag | DynamicPredFlag)) || if ((flags & (CompiledPredFlag | DynamicPredFlag)) ||
pen->OpcodeOfPred == UNDEF_OPCODE) { pen->OpcodeOfPred == UNDEF_OPCODE) {
CODEADDR q; yamop *q;
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */ if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
if (pen->ModuleOfPred) { if (pen->ModuleOfPred) {
@ -128,7 +124,7 @@ CallClause(PredEntry *pen, Int position)
YENV = ASP; YENV = ASP;
YENV[E_CB] = (CELL)(B->cp_b); YENV[E_CB] = (CELL)(B->cp_b);
CP = P; CP = P;
q = pen->FirstClause; q = pen->cs.p_code.FirstClause;
if (pen->PredFlags & ProfiledPredFlag) { if (pen->PredFlags & ProfiledPredFlag) {
LOCK(pen->StatisticsForPred.lock); LOCK(pen->StatisticsForPred.lock);
if (position == 1) if (position == 1)
@ -164,8 +160,8 @@ CallClause(PredEntry *pen, Int position)
*opp |= InUseMask; *opp |= InUseMask;
} }
#endif #endif
CLAUSECODE->clause = (CODEADDR)NEXTOP((yamop *)(q),ld); CLAUSECODE->clause = NEXTOP((yamop *)(q),ld);
P = (yamop *)CLAUSECODE->clause; P = CLAUSECODE->clause;
WRITE_UNLOCK(pen->PRWLock); WRITE_UNLOCK(pen->PRWLock);
return((CELL)(&(CLAUSECODE->clause))); return((CELL)(&(CLAUSECODE->clause)));
} else { } else {
@ -1349,7 +1345,7 @@ exec_absmi(int top)
} }
static int 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; choiceptr saved_b = B;
@ -1412,7 +1408,7 @@ Int
Yap_execute_goal(Term t, int nargs, SMALLUNSGN mod) Yap_execute_goal(Term t, int nargs, SMALLUNSGN mod)
{ {
Int out; Int out;
CODEADDR CodeAdr; yamop *CodeAdr;
yamop *saved_p, *saved_cp; yamop *saved_p, *saved_cp;
Prop pe; Prop pe;
PredEntry *ppe; PredEntry *ppe;
@ -1535,7 +1531,7 @@ Yap_trust_last(void)
int int
Yap_RunTopGoal(Term t) Yap_RunTopGoal(Term t)
{ {
CODEADDR CodeAdr; yamop *CodeAdr;
Prop pe; Prop pe;
PredEntry *ppe; PredEntry *ppe;
CELL *pt; CELL *pt;
@ -1687,7 +1683,7 @@ p_clean_ifcp(void) {
static Int static Int
JumpToEnv(Term t) { JumpToEnv(Term t) {
yamop *pos = (yamop *)(PredDollarCatch->LastClause); yamop *pos = PredDollarCatch->cs.p_code.LastClause;
CELL *env; CELL *env;
choiceptr first_func = NULL, B0 = B; choiceptr first_func = NULL, B0 = B;
@ -1695,7 +1691,7 @@ JumpToEnv(Term t) {
/* find the first choicepoint that may be a catch */ /* find the first choicepoint that may be a catch */
while (B != NULL && B->cp_ap != pos) { while (B != NULL && B->cp_ap != pos) {
/* we are already doing a catch */ /* 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; P = (yamop *)FAILCODE;
if (first_func != NULL) { if (first_func != NULL) {
B = first_func; B = first_func;
@ -1729,7 +1725,7 @@ JumpToEnv(Term t) {
} while (TRUE); } while (TRUE);
/* step one environment above */ /* step one environment above */
B->cp_cp = (yamop *)env[E_CP]; 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]; B->cp_env = (CELL *)env[E_E];
/* cannot recover Heap because of copy term :-( */ /* cannot recover Heap because of copy term :-( */
B->cp_h = H; 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; Atom at;
UInt arity; UInt arity;
SMALLUNSGN mod; 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) if (arity)
fprintf(Yap_stderr,"[GC] %s/%d marked %d (%s)\n", RepAtom(at)->StrOfAE, arity, total_marked, op_names[opnum]); fprintf(Yap_stderr,"[GC] %s/%d marked %d (%s)\n", RepAtom(at)->StrOfAE, arity, total_marked, op_names[opnum]);
else 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) (CELL *)(gc_B->cp_cp->u.ldl.bl)
#else #else
-gc_B->cp_cp->u.sla.s / ((OPREG)sizeof(CELL)), -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 #endif
); );
} else { } else {
@ -2207,7 +2207,7 @@ sweep_choicepoints(choiceptr gc_B)
(CELL *)(gc_B->cp_cp->u.ldl.bl) (CELL *)(gc_B->cp_cp->u.ldl.bl)
#else #else
-gc_B->cp_cp->u.sla.s / ((OPREG)sizeof(CELL)), -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 #endif
); );
break; break;

18
C/index.c
View File

@ -417,7 +417,7 @@ NGroupsIn(PredEntry *ap)
int x, y, PresentGroup; int x, y, PresentGroup;
ClauseDef *ActualCl = ArOfCl, *LastClauses[MaxOptions]; ClauseDef *ActualCl = ArOfCl, *LastClauses[MaxOptions];
GroupDef *Group = Groups; 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; NGroups = 1;
LastClauses[VarCl] = NIL; LastClauses[VarCl] = NIL;
@ -1316,11 +1316,11 @@ SpecialCases(void)
return (FALSE); return (FALSE);
} }
CODEADDR yamop *
Yap_PredIsIndexable(PredEntry *ap) Yap_PredIsIndexable(PredEntry *ap)
{ {
int NGr, Indexable = 0; int NGr, Indexable = 0;
CODEADDR indx_out = NIL; yamop *indx_out = NULL;
log_update = 0; log_update = 0;
if (setjmp(Yap_CompilerBotch) == 3) { if (setjmp(Yap_CompilerBotch) == 3) {
@ -1332,7 +1332,7 @@ Yap_PredIsIndexable(PredEntry *ap)
Yap_ErrorMessage = NULL; Yap_ErrorMessage = NULL;
labelno = 1; labelno = 1;
RemovedCl = FALSE; RemovedCl = FALSE;
FirstCl = (yamop *)(ap->FirstClause); FirstCl = ap->cs.p_code.FirstClause;
CurrentPred = ap; CurrentPred = ap;
if (CurrentPred->PredFlags & ProfiledPredFlag) if (CurrentPred->PredFlags & ProfiledPredFlag)
profiling = TRUE; profiling = TRUE;
@ -1352,7 +1352,7 @@ Yap_PredIsIndexable(PredEntry *ap)
CodeStart = cpc = NIL; CodeStart = cpc = NIL;
freep = (char *) (ArOfCl + NClauses); freep = (char *) (ArOfCl + NClauses);
if (Yap_ErrorMessage != NULL) { if (Yap_ErrorMessage != NULL) {
return (NIL); return NULL;
} }
if (CurrentPred->PredFlags & LogUpdatePredFlag) { if (CurrentPred->PredFlags & LogUpdatePredFlag) {
log_update = labelno; log_update = labelno;
@ -1360,7 +1360,7 @@ Yap_PredIsIndexable(PredEntry *ap)
} }
if (NClauses == 0) { if (NClauses == 0) {
Indexable = FALSE; Indexable = FALSE;
return(NIL); return NULL;
} else { } else {
if (NGr == 1) if (NGr == 1)
Indexable = SimpleCase(); Indexable = SimpleCase();
@ -1371,7 +1371,7 @@ Yap_PredIsIndexable(PredEntry *ap)
} }
if (CellPtr(freep) >= ASP) { if (CellPtr(freep) >= ASP) {
Yap_Error(SYSTEM_ERROR, TermNil, "out of stack space while indexing"); Yap_Error(SYSTEM_ERROR, TermNil, "out of stack space while indexing");
return(NIL); return NULL;
} }
if (log_update && NClauses > 1) { if (log_update && NClauses > 1) {
int i; int i;
@ -1404,7 +1404,7 @@ Yap_PredIsIndexable(PredEntry *ap)
} }
} }
if (!Indexable) { if (!Indexable) {
return (NIL); return NULL;
} else { } else {
#ifdef DEBUG #ifdef DEBUG
if (Yap_Option['i' - 'a' + 1]) { if (Yap_Option['i' - 'a' + 1]) {
@ -1414,7 +1414,7 @@ Yap_PredIsIndexable(PredEntry *ap)
if ((indx_out = Yap_assemble(ASSEMBLING_INDEX)) == NIL) { if ((indx_out = Yap_assemble(ASSEMBLING_INDEX)) == NIL) {
if (!Yap_growheap(FALSE)) { if (!Yap_growheap(FALSE)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return NULL;
} }
goto restart_index; 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)); pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(atom, Arity),CurrentModule));
else else
pe = RepPredProp(PredPropByAtom(atom,CurrentModule)); pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
pe->CodeOfPred = p_code;
pe->PredFlags = flags | StandardPredFlag | CPredFlag; pe->PredFlags = flags | StandardPredFlag | CPredFlag;
p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) code; pe->cs.f_code = code;
pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code;
if (flags & UserCPredFlag) if (flags & UserCPredFlag)
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_usercpred); p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_usercpred);
else else
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred); 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.s = -Signed(RealEnvSize);
p_code->u.sla.p = pe; p_code->u.sla.sla_u.p = pe;
p_code->u.sla.p0 = pe;
p_code = NEXTOP(p_code,sla); p_code = NEXTOP(p_code,sla);
p_code->opc = Yap_opcode(_procceed); p_code->opc = Yap_opcode(_procceed);
{ {
Term mod = CurrentModule; Term mod = CurrentModule;
pe->ModuleOfPred = mod; 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 void
@ -502,28 +493,15 @@ Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, CPre
else else
pe = RepPredProp(PredPropByAtom(atom,CurrentModule)); pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
pe->PredFlags = flags | StandardPredFlag | CPredFlag; pe->PredFlags = flags | StandardPredFlag | CPredFlag;
p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) code; pe->CodeOfPred = p_code;
pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code; pe->cs.d_code = cmp_code;
pe->ModuleOfPred = CurrentModule; pe->ModuleOfPred = CurrentModule;
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred); 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.s = -Signed(RealEnvSize);
p_code->u.sla.p = p_code->u.sla.p0 = pe;
p_code = NEXTOP(p_code,sla); p_code = NEXTOP(p_code,sla);
p_code->opc = Yap_opcode(_procceed); 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 void
@ -537,6 +515,8 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
else else
pe = RepPredProp(PredPropByAtom(atom,CurrentModule)); pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
pe->PredFlags = flags | AsmPredFlag | StandardPredFlag | (code); pe->PredFlags = flags | AsmPredFlag | StandardPredFlag | (code);
pe->cs.f_code = def;
pe->ModuleOfPred = CurrentModule;
if (def != NULL) { if (def != NULL) {
yamop *p_code = ((Clause *)NULL)->ClCode; yamop *p_code = ((Clause *)NULL)->ClCode;
Clause *cl = (Clause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e)); 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->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user"); cl->Owner = Yap_LookupAtom("user");
p_code = cl->ClCode; p_code = cl->ClCode;
p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) def; pe->CodeOfPred = p_code;
pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code;
pe->ModuleOfPred = CurrentModule;
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred); 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.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 = NEXTOP(p_code,sla);
p_code->opc = Yap_opcode(_procceed); p_code->opc = Yap_opcode(_procceed);
Yap_c_predicates[NumberOfCPreds] = def;
pe->StateOfPred = NumberOfCPreds;
NumberOfCPreds++;
} else { } else {
pe->FirstClause = pe->LastClause = NULL;
pe->OpcodeOfPred = Yap_opcode(_undef_p); pe->OpcodeOfPred = Yap_opcode(_undef_p);
pe->TrueCodeOfPred = pe->CodeOfPred = pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
(CODEADDR)(&(pe->OpcodeOfPred));
} }
} }
@ -570,13 +543,14 @@ static void
CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont) CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
{ {
yamop *code; yamop *code;
if (pe->FirstClause != pe->LastClause || pe->TrueCodeOfPred != if (pe->cs.p_code.FirstClause != pe->cs.p_code.LastClause ||
pe->FirstClause || pe->CodeOfPred != pe->FirstClause) { pe->cs.p_code.TrueCodeOfPred != pe->cs.p_code.FirstClause ||
pe->CodeOfPred != pe->cs.p_code.FirstClause) {
Yap_Error(SYSTEM_ERROR,TermNil, Yap_Error(SYSTEM_ERROR,TermNil,
"initiating a C Pred with backtracking"); "initiating a C Pred with backtracking");
return; return;
} }
code = (yamop *)(pe->FirstClause); code = (yamop *)(pe->cs.p_code.FirstClause);
if (pe->PredFlags & UserCPredFlag) if (pe->PredFlags & UserCPredFlag)
code->opc = Yap_opcode(_try_userc); code->opc = Yap_opcode(_try_userc);
else else
@ -585,8 +559,7 @@ CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
INIT_YAMOP_LTT(code, 2); INIT_YAMOP_LTT(code, 2);
PUT_YAMOP_SEQ(code); PUT_YAMOP_SEQ(code);
#endif /* YAPOR */ #endif /* YAPOR */
Yap_c_predicates[pe->StateOfPred] = Start; code->u.lds.f = Start;
code->u.lds.d = (CODEADDR) Start;
code = NEXTOP(code,lds); code = NEXTOP(code,lds);
if (pe->PredFlags & UserCPredFlag) if (pe->PredFlags & UserCPredFlag)
code->opc = Yap_opcode(_retry_userc); code->opc = Yap_opcode(_retry_userc);
@ -596,8 +569,7 @@ CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
INIT_YAMOP_LTT(code, 1); INIT_YAMOP_LTT(code, 1);
PUT_YAMOP_SEQ(code); PUT_YAMOP_SEQ(code);
#endif /* YAPOR */ #endif /* YAPOR */
Yap_c_predicates[pe->StateOfPred+1] = Cont; code->u.lds.f = Cont;
code->u.lds.d = (CODEADDR) 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)); pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(atom, Arity),CurrentModule));
else else
pe = RepPredProp(PredPropByAtom(atom,CurrentModule)); pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
if (pe->FirstClause != NIL) if (pe->cs.p_code.FirstClause != NIL)
CleanBack(pe, Start, Cont); CleanBack(pe, Start, Cont);
else { else {
Clause *cl; Clause *cl;
yamop *code = ((Clause *)NIL)->ClCode; yamop *code = ((Clause *)NULL)->ClCode;
pe->PredFlags = CompiledPredFlag | StandardPredFlag; pe->PredFlags = CompiledPredFlag | StandardPredFlag;
#ifdef YAPOR #ifdef YAPOR
pe->PredFlags |= SequentialPredFlag; pe->PredFlags |= SequentialPredFlag;
#endif /* YAPOR */ #endif /* YAPOR */
cl = (Clause cl = (Clause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(code,lds),lds),e));
*)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(code,lds),lds),e));
if (cl == NIL) { if (cl == NIL) {
Yap_Error(SYSTEM_ERROR,TermNil,"No Heap Space in InitCPredBack"); Yap_Error(SYSTEM_ERROR,TermNil,"No Heap Space in InitCPredBack");
return; return;
@ -630,16 +601,13 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity, unsigned int Extra, CPred
cl->ClFlags = 0; cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user"); cl->Owner = Yap_LookupAtom("user");
code = cl->ClCode; code = cl->ClCode;
pe->TrueCodeOfPred = pe->CodeOfPred = pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred =
pe->FirstClause = pe->LastClause = (CODEADDR)code; pe->cs.p_code.FirstClause = pe->cs.p_code.LastClause = code;
if (flags & UserCPredFlag) if (flags & UserCPredFlag)
pe->OpcodeOfPred = code->opc = Yap_opcode(_try_userc); pe->OpcodeOfPred = code->opc = Yap_opcode(_try_userc);
else else
pe->OpcodeOfPred = code->opc = Yap_opcode(_try_c); pe->OpcodeOfPred = code->opc = Yap_opcode(_try_c);
code->u.lds.d = (CODEADDR) Start; code->u.lds.f = Start;
pe->StateOfPred = NumberOfCPreds;
Yap_c_predicates[NumberOfCPreds] = Start;
NumberOfCPreds++;
code->u.lds.p = pe; code->u.lds.p = pe;
code->u.lds.s = Arity; code->u.lds.s = Arity;
code->u.lds.extra = Extra; 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); code->opc = Yap_opcode(_retry_userc);
else else
code->opc = Yap_opcode(_retry_c); code->opc = Yap_opcode(_retry_c);
code->u.lds.d = (CODEADDR) Cont; code->u.lds.f = Cont;
Yap_c_predicates[NumberOfCPreds] = Cont;
NumberOfCPreds++;
code->u.lds.p = pe; code->u.lds.p = pe;
code->u.lds.s = Arity; code->u.lds.s = Arity;
code->u.lds.extra = Extra; 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.op = Yap_opcode(_call);
heap_regs->env_for_trustfail_code.s = -Signed(RealEnvSize); 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->env_for_trustfail_code.l2 = NULL;
heap_regs->trustfailcode = Yap_opcode(_trust_fail); heap_regs->trustfailcode = Yap_opcode(_trust_fail);
heap_regs->env_for_yes_code.op = Yap_opcode(_call); 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.s = -Signed(RealEnvSize);
heap_regs->env_for_yes_code.l = NULL;
heap_regs->env_for_yes_code.l2 = NULL; heap_regs->env_for_yes_code.l2 = NULL;
heap_regs->yescode.opc = Yap_opcode(_Ystop); heap_regs->yescode.opc = Yap_opcode(_Ystop);
heap_regs->undef_op = Yap_opcode(_undef_p); heap_regs->undef_op = Yap_opcode(_undef_p);
@ -784,7 +748,7 @@ InitCodes(void)
heap_regs->heap_top_owner = -1; heap_regs->heap_top_owner = -1;
#endif /* YAPOR */ #endif /* YAPOR */
heap_regs->clausecode.arity = 0; heap_regs->clausecode.arity = 0;
heap_regs->clausecode.clause = NIL; heap_regs->clausecode.clause = NULL;
heap_regs->clausecode.func = NIL; heap_regs->clausecode.func = NIL;
heap_regs->invisiblechain.Entry = NIL; heap_regs->invisiblechain.Entry = NIL;
@ -822,8 +786,6 @@ InitCodes(void)
heap_regs->IntBBKeys = NULL; heap_regs->IntBBKeys = NULL;
heap_regs->char_conversion_table = NULL; heap_regs->char_conversion_table = NULL;
heap_regs->char_conversion_table2 = 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!!!! don't initialise this here, this is initialised by Yap_InitModules!!!!
heap_regs->no_of_modules = 1; heap_regs->no_of_modules = 1;

37
C/inlines.c
View File

@ -85,10 +85,24 @@ p_integer(void)
d0 = ARG1; d0 = ARG1;
deref_head(d0, integer_unk); deref_head(d0, integer_unk);
integer_nvar: integer_nvar:
if (IsIntegerTerm(d0)) { if (IsIntTerm(d0)) {
return(TRUE); 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); return(FALSE);
} }
@ -106,10 +120,25 @@ p_number(void)
d0 = ARG1; d0 = ARG1;
deref_head(d0, number_unk); deref_head(d0, number_unk);
number_nvar: number_nvar:
if (IsNumTerm(d0)) { if (IsIntTerm(d0)) {
return(TRUE); 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); 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(Term AdjustDBTerm, (Term));
STATIC_PROTO(void RestoreDB, (DBEntry *)); STATIC_PROTO(void RestoreDB, (DBEntry *));
STATIC_PROTO(void RestoreClause, (Clause *,int)); 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 rehash, (CELL *, int, int));
STATIC_PROTO(void CleanCode, (PredEntry *)); STATIC_PROTO(void CleanCode, (PredEntry *));
STATIC_PROTO(void RestoreEntries, (PropEntry *)); STATIC_PROTO(void RestoreEntries, (PropEntry *));
@ -343,10 +343,6 @@ put_info(int info, int mode)
putout(Unsigned(info)); putout(Unsigned(info));
/* say whether we just saved the heap or everything */ /* say whether we just saved the heap or everything */
putout(mode); putout(mode);
/* c-predicates in system */
putout(NumberOfCPreds);
/* comparison predicates in system */
putout(NumberOfCmpFuncs);
/* current state of stacks, to be used by SavedInfo */ /* current state of stacks, to be used by SavedInfo */
#if defined(YAPOR) || defined(TABLING) #if defined(YAPOR) || defined(TABLING)
/* space available in heap area */ /* space available in heap area */
@ -442,22 +438,6 @@ save_code_info(void)
my_ops[i] = Yap_opcode(i); my_ops[i] = Yap_opcode(i);
mywrite(splfild, (char *)my_ops, sizeof(OPCODE)*(_std_top+1)); 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 */ /* and the current character codes */
mywrite(splfild, Yap_chtype, NUMBER_OF_CHARS); 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 pp[80];
char msg[256]; 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 */ /* make sure we always check if there are enough bytes */
/* skip the first line */ /* skip the first line */
@ -654,21 +634,6 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap)
mode = get_header_cell(); mode = get_header_cell();
if (Yap_ErrorMessage) if (Yap_ErrorMessage)
return(FAIL_RESTORE); 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) { if (mode != DO_EVERYTHING && mode != DO_ONLY_CODE) {
Yap_ErrorMessage = "corrupt saved state"; Yap_ErrorMessage = "corrupt saved state";
return(FAIL_RESTORE); return(FAIL_RESTORE);
@ -806,44 +771,6 @@ get_insts(OPCODE old_ops[])
myread(splfild, (char *)old_ops, sizeof(OPCODE)*(_std_top+1)); 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 */ /* Get the old atoms hash table */
static void static void
get_hash(void) get_hash(void)
@ -919,7 +846,6 @@ get_coded(int flag, OPCODE old_ops[])
get_regs(flag); get_regs(flag);
get_insts(old_ops); get_insts(old_ops);
funcs_moved = check_funcs();
get_hash(); get_hash();
CopyCode(); CopyCode();
switch (flag) { 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" #include "rheap.h"
/* restore the atom entries which are invisible for the user */ /* restore the atom entries which are invisible for the user */

10
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * 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 */ /* information that can be stored in Code Space */
@ -72,7 +72,6 @@ typedef struct various_codes {
COUNT seq; COUNT seq;
#endif /* YAPOR */ #endif /* YAPOR */
COUNT s; COUNT s;
CODEADDR l;
CELL *l2; CELL *l2;
struct pred_entry *p; struct pred_entry *p;
struct pred_entry *p0; struct pred_entry *p0;
@ -86,7 +85,6 @@ typedef struct various_codes {
COUNT seq; COUNT seq;
#endif /* YAPOR */ #endif /* YAPOR */
COUNT s; COUNT s;
CODEADDR l;
CELL *l2; CELL *l2;
struct pred_entry *p; struct pred_entry *p;
struct pred_entry *p0; struct pred_entry *p0;
@ -96,7 +94,7 @@ typedef struct various_codes {
yamop rtrycode; yamop rtrycode;
struct { struct {
OPREG arity; OPREG arity;
CODEADDR clause; struct yami *clause;
Functor func; Functor func;
} clausecode; } clausecode;
union CONSULT_OBJ *consultsp; union CONSULT_OBJ *consultsp;
@ -156,8 +154,6 @@ typedef struct various_codes {
unsigned int n_of_threads; /* number of threads and processes in system */ unsigned int n_of_threads; /* number of threads and processes in system */
#endif #endif
unsigned int size_of_overflow; unsigned int size_of_overflow;
UInt number_of_cpreds;
UInt number_of_cmpfuncs;
Term module_name[MaxModules]; Term module_name[MaxModules];
struct pred_entry *module_pred[MaxModules]; struct pred_entry *module_pred[MaxModules];
SMALLUNSGN no_of_modules; SMALLUNSGN no_of_modules;
@ -388,8 +384,6 @@ typedef struct various_codes {
#define INT_BB_KEYS heap_regs->IntBBKeys #define INT_BB_KEYS heap_regs->IntBBKeys
#define CharConversionTable heap_regs->char_conversion_table #define CharConversionTable heap_regs->char_conversion_table
#define CharConversionTable2 heap_regs->char_conversion_table2 #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 ModuleName heap_regs->module_name
#define ModulePred heap_regs->module_pred #define ModulePred heap_regs->module_pred
#define PrimitivesModule heap_regs->primitives_module #define PrimitivesModule heap_regs->primitives_module

12
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto * * File: Yap.proto *
* mods: * * mods: *
* comments: Function declarations for YAP * * 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 */ /* prototype file for Yap */
@ -19,11 +19,6 @@
#define STATIC_PROTO(F,A) static F A #define STATIC_PROTO(F,A) static F A
typedef Int (*CPredicate)(void);
typedef Int (*CmpPredicate)(Term, Term);
/* absmi.c */ /* absmi.c */
Int STD_PROTO(Yap_absmi,(int)); 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)); Int STD_PROTO(YAP_Execute,(struct pred_entry *, CPredicate));
/* cdmgr.c */ /* cdmgr.c */
void STD_PROTO(Yap_addclause,(Term,CODEADDR,int,int));
Term STD_PROTO(Yap_all_calls,(void)); Term STD_PROTO(Yap_all_calls,(void));
Atom STD_PROTO(Yap_ConsultingFile,(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)); void STD_PROTO(Yap_InitCdMgr,(void));
#if EMACS #if EMACS
int STD_PROTO(where_new_clause, (Prop, int)); 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)); void STD_PROTO(Yap_InitCmpPreds,(void));
/* compiler.c */ /* compiler.c */
CODEADDR STD_PROTO(Yap_cclause,(Term, int, int)); yamop *STD_PROTO(Yap_cclause,(Term, int, int));
/* computils.c */ /* computils.c */

2
H/absmi.h
View File

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

73
H/amidefs.h
View File

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

8
H/clause.h
View File

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

36
m4/Yatom.h.m4
View File

@ -207,12 +207,20 @@ typedef struct {
typedef struct pred_entry { typedef struct pred_entry {
Prop NextOfPE; /* used to chain properties */ Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */ PropFlags KindOfPE; /* kind of property */
unsigned int ArityOfPE; /* arity of property */ struct yami *CodeOfPred;
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
CELL PredFlags; CELL PredFlags;
CODEADDR CodeOfPred; /* code address */ unsigned int ArityOfPE; /* arity of property */
CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */ 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 */ Functor FunctorOfPred; /* functor for Predicate */
CODEADDR FirstClause, LastClause;
Atom OwnerFile; /* File where the predicate was defined */ Atom OwnerFile; /* File where the predicate was defined */
struct pred_entry *NextPredOfModule; /* next pred for same module */ struct pred_entry *NextPredOfModule; /* next pred for same module */
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
@ -222,7 +230,6 @@ typedef struct pred_entry {
tab_ent_ptr TableOfPred; tab_ent_ptr TableOfPred;
#endif /* TABLING */ #endif /* TABLING */
SMALLUNSGN ModuleOfPred; /* module for this definition */ SMALLUNSGN ModuleOfPred; /* module for this definition */
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
profile_data StatisticsForPred; /* enable profiling for predicate */ profile_data StatisticsForPred; /* enable profiling for predicate */
SMALLUNSGN StateOfPred; /* actual state of predicate */ SMALLUNSGN StateOfPred; /* actual state of predicate */
} PredEntry; } PredEntry;
@ -238,20 +245,6 @@ Constructor(Prop,AbsPred,PredEntry *,p,p)
Inline(IsPredProperty, PropFlags, int, flags, (flags == PEProp) ) 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 */ /* Flags for code or dbase entry */
/* There are several flags for code and data base entries */ /* There are several flags for code and data base entries */
typedef enum { typedef enum {
@ -280,7 +273,7 @@ typedef struct DB_STRUCT {
CELL Flags; /* Term Flags */ CELL Flags; /* Term Flags */
SMALLUNSGN NOfRefsTo; /* Number of references pointing here */ SMALLUNSGN NOfRefsTo; /* Number of references pointing here */
struct struct_dbentry *Parent; /* key of DBase reference */ 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 **DBRefs; /* pointer to other references */
struct DB_STRUCT *Prev; /* Previous element in chain */ struct DB_STRUCT *Prev; /* Previous element in chain */
struct DB_STRUCT *Next; /* Next 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)); Term STD_PROTO(Yap_FetchTermFromDB,(DBRef,int));
void STD_PROTO(Yap_ReleaseTermFromDB,(DBRef)); void STD_PROTO(Yap_ReleaseTermFromDB,(DBRef));
/* .c */
CODEADDR STD_PROTO(Yap_PredIsIndexable,(PredEntry *));
/* init.c */ /* init.c */
Atom STD_PROTO(Yap_GetOp,(OpEntry *,int *,int)); 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), !, '$some_recordedp'(M:P), !,
'$recordedp'(M:P,(P:-Q),R). '$recordedp'(M:P,(P:-Q),R).
'$clause'(P,M,Q,_) :- '$clause'(P,M,Q,_) :-
\+ '$undefined'(P,M),
( '$system_predicate'(P,M) -> true ; ( '$system_predicate'(P,M) -> true ;
'$number_of_clauses'(P,M,N), N > 0 ), '$number_of_clauses'(P,M,N), N > 0 ),
functor(P,Name,Arity), functor(P,Name,Arity),
@ -286,23 +287,6 @@ nth_clause(V,I,R) :-
'$do_error'(permission_error(access,private_procedure,Name/Arity), '$do_error'(permission_error(access,private_procedure,Name/Arity),
nth_clause(M:P,I,R)). 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(M:C) :- !,
'$retract'(C,M). '$retract'(C,M).
retract(C) :- retract(C) :-