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

new indexing algorithm

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@822 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-04-30 17:46:05 +00:00
parent dc57d5a0aa
commit d290885f8f
25 changed files with 3592 additions and 3319 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1173
C/absmi.c
View File

File diff suppressed because it is too large Load Diff

4
C/adtdefs.c
View File

@ -400,8 +400,8 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, SMALLUNSGN cur_mod)
p->KindOfPE = PEProp; p->KindOfPE = PEProp;
p->ArityOfPE = fe->ArityOfFE; p->ArityOfPE = fe->ArityOfFE;
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
p->cs.p_code.NOfClauses = 0;
p->PredFlags = 0L; p->PredFlags = 0L;
p->StateOfPred = 0;
p->OwnerFile = AtomNil; p->OwnerFile = AtomNil;
p->OpcodeOfPred = UNDEF_OPCODE; p->OpcodeOfPred = UNDEF_OPCODE;
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
@ -435,8 +435,8 @@ Yap_NewPredPropByAtom(AtomEntry *ae, SMALLUNSGN cur_mod)
p->KindOfPE = PEProp; p->KindOfPE = PEProp;
p->ArityOfPE = 0; p->ArityOfPE = 0;
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
p->cs.p_code.NOfClauses = 0;
p->PredFlags = 0L; p->PredFlags = 0L;
p->StateOfPred = 0;
p->OwnerFile = AtomNil; p->OwnerFile = AtomNil;
p->OpcodeOfPred = UNDEF_OPCODE; p->OpcodeOfPred = UNDEF_OPCODE;
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));

469
C/amasm.c
View File

@ -65,12 +65,6 @@ STATIC_PROTO(void a_r, (op_numbers));
STATIC_PROTO(void a_p, (op_numbers)); STATIC_PROTO(void a_p, (op_numbers));
STATIC_PROTO(void a_pl, (op_numbers,PredEntry *)); STATIC_PROTO(void a_pl, (op_numbers,PredEntry *));
STATIC_PROTO(void a_l, (op_numbers)); STATIC_PROTO(void a_l, (op_numbers));
STATIC_PROTO(void a_3sw, (op_numbers));
STATIC_PROTO(void a_3sws, (op_numbers));
STATIC_PROTO(void a_4sw, (op_numbers));
#if USE_THREADED_CODE
STATIC_PROTO(void a_4_lsw, (op_numbers));
#endif
STATIC_PROTO(void a_hx, (op_numbers)); STATIC_PROTO(void a_hx, (op_numbers));
STATIC_PROTO(void a_if, (op_numbers)); STATIC_PROTO(void a_if, (op_numbers));
STATIC_PROTO(void a_go, (op_numbers)); STATIC_PROTO(void a_go, (op_numbers));
@ -82,7 +76,6 @@ STATIC_PROTO(void a_either, (op_numbers, CELL, CELL, int, int));
STATIC_PROTO(void a_try, (op_numbers, CELL, CELL)); STATIC_PROTO(void a_try, (op_numbers, CELL, CELL));
STATIC_PROTO(void a_either, (op_numbers, CELL, CELL)); STATIC_PROTO(void a_either, (op_numbers, CELL, CELL));
#endif /* YAPOR */ #endif /* YAPOR */
STATIC_PROTO(void a_gl_in, (op_numbers));
STATIC_PROTO(void a_gl, (op_numbers)); STATIC_PROTO(void a_gl, (op_numbers));
STATIC_PROTO(void a_bfunc, (CELL)); STATIC_PROTO(void a_bfunc, (CELL));
STATIC_PROTO(wamreg compile_cmp_flags, (char *)); STATIC_PROTO(wamreg compile_cmp_flags, (char *));
@ -90,7 +83,7 @@ STATIC_PROTO(void a_igl, (op_numbers));
STATIC_PROTO(void a_ucons, (compiler_vm_op)); STATIC_PROTO(void a_ucons, (compiler_vm_op));
STATIC_PROTO(void a_uvar, (void)); STATIC_PROTO(void a_uvar, (void));
STATIC_PROTO(void a_wvar, (void)); STATIC_PROTO(void a_wvar, (void));
STATIC_PROTO(void do_pass, (void)); STATIC_PROTO(yamop *do_pass, (void));
#ifdef DEBUG_OPCODES #ifdef DEBUG_OPCODES
STATIC_PROTO(void DumpOpCodes, (void)); STATIC_PROTO(void DumpOpCodes, (void));
#endif #endif
@ -144,6 +137,20 @@ static int c_type;
static int clause_has_blobs; static int clause_has_blobs;
wamreg
Yap_regnotoreg(UInt regnbr)
{
#if PRECOMPUTE_REGADDRESS
return (wamreg)(XREGS + regnbr);
#else
#if MSHIFTOFFS
return regnbr;
#else
return CELLSIZE*regnbr;
#endif
#endif /* ALIGN_LONGS */
}
inline static yslot inline static yslot
emit_y(Ventry *ve) emit_y(Ventry *ve)
{ {
@ -336,7 +343,7 @@ static void
a_cl(op_numbers opcode) a_cl(op_numbers opcode)
{ {
if (pass_no) { if (pass_no) {
Clause *cl = (Clause *)code_addr; LogUpdClause *cl = (LogUpdClause *)code_addr;
code_p->opc = emit_op(opcode); code_p->opc = emit_op(opcode);
code_p->u.l.l = code_addr; code_p->u.l.l = code_addr;
cl->u.ClVarChain = (yamop *)(Unsigned(code_addr) + label_offset[1]); cl->u.ClVarChain = (yamop *)(Unsigned(code_addr) + label_offset[1]);
@ -348,7 +355,7 @@ static void
a_cle(op_numbers opcode) a_cle(op_numbers opcode)
{ {
if (pass_no) { if (pass_no) {
Clause *cl = (Clause *)code_addr; LogUpdClause *cl = (LogUpdClause *)code_addr;
code_p->opc = emit_op(opcode); code_p->opc = emit_op(opcode);
code_p->u.EC.ClTrail = 0; code_p->u.EC.ClTrail = 0;
@ -705,6 +712,17 @@ a_r(op_numbers opcode)
GONEXT(x); GONEXT(x);
} }
inline static void
a_sp(op_numbers opcode, COUNT sv)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.sp.s = sv-1;
code_p->u.sp.p = CurrentPred;
}
GONEXT(dp);
}
static void static void
check_alloc(void) check_alloc(void)
{ {
@ -892,6 +910,16 @@ a_l(op_numbers opcode)
GONEXT(l); GONEXT(l);
} }
static void
a_il(op_numbers opcode)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.l.l = emit_ilabel(cpc->rnd1);
}
GONEXT(l);
}
static void static void
a_pl(op_numbers opcode, PredEntry *pred) a_pl(op_numbers opcode, PredEntry *pred)
{ {
@ -988,96 +1016,86 @@ a_igl(op_numbers opcode)
GONEXT(l); GONEXT(l);
} }
static void
a_3sw(op_numbers opcode)
{
CELL *seq_ptr;
if (pass_no) {
code_p->opc = emit_op(opcode);
seq_ptr = cpc->arnds;
code_p->u.lll.l1 = emit_ilabel(seq_ptr[0]);
code_p->u.lll.l2 = emit_ilabel(seq_ptr[1]);
code_p->u.lll.l3 = emit_ilabel(seq_ptr[2]);
}
GONEXT(lll);
}
static void
a_3sws(op_numbers opcode)
{
CELL *seq_ptr;
if (pass_no) {
code_p->opc = emit_op(opcode);
seq_ptr = cpc->arnds;
code_p->u.slll.s = IPredArity;
code_p->u.slll.p = CurrentPred;
#ifdef YAPOR
INIT_YAMOP_LTT(code_p, cpc->rnd1 >> 1);
if (cpc->rnd1 & 1)
PUT_YAMOP_CUT(code_p);
if (CurrentPred->PredFlags & SequentialPredFlag)
PUT_YAMOP_SEQ(code_p);
#endif /* YAPOR */
code_p->u.slll.l1 = emit_ilabel(seq_ptr[0]);
code_p->u.slll.l2 = emit_ilabel(seq_ptr[1]);
code_p->u.slll.l3 = emit_ilabel(seq_ptr[2]);
}
GONEXT(slll);
}
static void static void
a_4sw(op_numbers opcode) a_4sw(op_numbers opcode)
{ {
CELL *seq_ptr; CELL *seq_ptr;
if (opcode == _switch_on_type &&
cpc->nextInst != NULL &&
cpc->nextInst->op == label_op &&
cpc->arnds[1] == cpc->nextInst->rnd1 &&
!(cpc->arnds[0] & 1) &&
cpc->nextInst->nextInst != NULL &&
cpc->nextInst->nextInst->op == if_c_op &&
cpc->nextInst->nextInst->rnd1 == 1 &&
cpc->nextInst->nextInst->arnds[1] == TermNil &&
cpc->nextInst->nextInst->arnds[0] == cpc->arnds[2]) {
if (pass_no) { if (pass_no) {
code_p->opc = emit_op(opcode); code_p->opc = emit_op(_switch_list_nl);
seq_ptr = cpc->arnds; seq_ptr = cpc->arnds;
code_p->u.llll.l1 = emit_ilabel(seq_ptr[0]);
code_p->u.llll.l2 = emit_ilabel(seq_ptr[1]);
code_p->u.llll.l3 = emit_ilabel(seq_ptr[2]);
code_p->u.llll.l4 = emit_ilabel(seq_ptr[3]);
}
GONEXT(llll);
}
#if USE_THREADED_CODE
/* specialised code for fast switch_on_list, taking advantage of the
fact that in this case we are sure it is a list */
static void
a_4_lsw(op_numbers opcode)
{
CELL *seq_ptr;
seq_ptr = cpc->arnds;
if (opcode == _switch_list_nl && (seq_ptr[0] & 1)) {
/* local address, don't do anything because we
don't know what is supposed to be there */
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.llll.l1 = emit_ilabel(seq_ptr[0]);
code_p->u.llll.l2 = emit_ilabel(seq_ptr[1]);
code_p->u.llll.l3 = emit_ilabel(seq_ptr[2]);
code_p->u.llll.l4 = emit_ilabel(seq_ptr[3]);
}
GONEXT(llll);
} else {
/* optimise direct jumps to list like code, by prefetching the
first address for lists */
if (pass_no) {
code_p->opc = emit_op(_switch_list_nl_prefetch);
code_p->u.ollll.pop = ((yamop *)(seq_ptr[0]))->opc; code_p->u.ollll.pop = ((yamop *)(seq_ptr[0]))->opc;
code_p->u.ollll.l1 = emit_ilabel(seq_ptr[0]); code_p->u.ollll.l1 = emit_ilabel(seq_ptr[0]);
code_p->u.ollll.l2 = emit_ilabel(seq_ptr[1]); code_p->u.ollll.l2 = emit_ilabel(cpc->nextInst->nextInst->arnds[2]);
code_p->u.ollll.l3 = emit_ilabel(seq_ptr[2]); code_p->u.ollll.l3 = emit_ilabel(seq_ptr[2]);
code_p->u.ollll.l4 = emit_ilabel(seq_ptr[3]); code_p->u.ollll.l4 = emit_ilabel(seq_ptr[3]);
} }
GONEXT(ollll); GONEXT(ollll);
cpc = cpc->nextInst->nextInst;
} else {
if (pass_no) {
code_p->opc = emit_op(opcode);
seq_ptr = cpc->arnds;
code_p->u.llll.l1 = emit_ilabel(seq_ptr[0]);
code_p->u.llll.l2 = emit_ilabel(seq_ptr[1]);
code_p->u.llll.l3 = emit_ilabel(seq_ptr[2]);
code_p->u.llll.l4 = emit_ilabel(seq_ptr[3]);
}
GONEXT(llll);
} }
} }
#endif
static void
a_4sw_x(op_numbers opcode)
{
CELL *seq_ptr;
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.xllll.x = emit_xreg2();
cpc = cpc->nextInst;
seq_ptr = cpc->arnds;
code_p->u.xllll.l1 = emit_ilabel(seq_ptr[0]);
code_p->u.xllll.l2 = emit_ilabel(seq_ptr[1]);
code_p->u.xllll.l3 = emit_ilabel(seq_ptr[2]);
code_p->u.xllll.l4 = emit_ilabel(seq_ptr[3]);
} else {
/* skip one */
cpc = cpc->nextInst;
}
GONEXT(xllll);
}
static void
a_4sw_s(op_numbers opcode)
{
CELL *seq_ptr;
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.sllll.s = cpc->rnd2;
cpc = cpc->nextInst;
seq_ptr = cpc->arnds;
code_p->u.sllll.l1 = emit_ilabel(seq_ptr[0]);
code_p->u.sllll.l2 = emit_ilabel(seq_ptr[1]);
code_p->u.sllll.l3 = emit_ilabel(seq_ptr[2]);
code_p->u.sllll.l4 = emit_ilabel(seq_ptr[3]);
} else {
/* skip one */
cpc = cpc->nextInst;
}
GONEXT(sllll);
}
static void static void
a_hx(op_numbers opcode) a_hx(op_numbers opcode)
@ -1121,9 +1139,21 @@ a_go(op_numbers opcode)
{ {
if (pass_no) { if (pass_no) {
code_p->opc = emit_op(opcode); code_p->opc = emit_op(opcode);
code_p->u.cll.c = emit_count(cpc->arnds[0]); code_p->u.cll.c = emit_count(cpc->arnds[1]); /* tag */
code_p->u.cll.l1 = emit_ilabel(cpc->arnds[1]); code_p->u.cll.l1 = emit_ilabel(cpc->arnds[2]); /* success point */
code_p->u.cll.l2 = emit_ilabel(cpc->arnds[2]); code_p->u.cll.l2 = emit_ilabel(cpc->arnds[0]); /* fail point */
}
GONEXT(cll);
}
static void
a_ifnot(op_numbers opcode)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.cll.c = cpc->arnds[0]; /* tag */
code_p->u.cll.l1 = emit_ilabel(cpc->arnds[1]); /* success point */
code_p->u.cll.l2 = emit_ilabel(cpc->arnds[2]); /* fail point */
} }
GONEXT(cll); GONEXT(cll);
} }
@ -1163,30 +1193,6 @@ a_try(op_numbers opcode, CELL lab, CELL opr)
GONEXT(ld); GONEXT(ld);
} }
static void
a_gl_in(op_numbers opcode)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.ldl.d = emit_a(cpc->rnd1);
code_p->u.ldl.s = emit_count(IPredArity);
code_p->u.ldl.p = CurrentPred;
#ifdef YAPOR
INIT_YAMOP_LTT(code_p, cpc->rnd2 >> 1);
if (cpc->rnd2 & 1)
PUT_YAMOP_CUT(code_p);
if (CurrentPred->PredFlags & SequentialPredFlag)
PUT_YAMOP_SEQ(code_p);
#endif /* YAPOR */
/* next op is a jump, with the jump giving the address to fail to
after this alternative */
cpc = cpc->nextInst;
code_p->u.ldl.bl = emit_ilabel(cpc->rnd1);
} else
cpc = cpc->nextInst;
GONEXT(ldl);
}
static void static void
#ifdef YAPOR #ifdef YAPOR
a_either(op_numbers opcode, CELL opr, CELL lab, int nofalts, int hascut) a_either(op_numbers opcode, CELL opr, CELL lab, int nofalts, int hascut)
@ -1952,80 +1958,87 @@ a_f2(int var)
#define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(code_addr) + label_offset[cpc->rnd1], IPredArity); #define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(code_addr) + label_offset[cpc->rnd1], IPredArity);
#endif /* YAPOR */ #endif /* YAPOR */
static void static yamop *
do_pass(void) do_pass(void)
{ {
yamop *entry_code;
#ifdef YAPOR #ifdef YAPOR
#define EITHER_INST 50 #define EITHER_INST 50
yamop *entry_code;
yamop *either_inst[EITHER_INST]; yamop *either_inst[EITHER_INST];
int either_cont = 0; int either_cont = 0;
#endif /* YAPOR */ #endif /* YAPOR */
int log_update; int log_update;
#if defined(YAPOR) || defined(THREADS)
int dynamic; int dynamic;
#endif
int ystop_found = FALSE; int ystop_found = FALSE;
union clause_obj *cl_u;
alloc_found = dealloc_found = FALSE; alloc_found = dealloc_found = FALSE;
code_p = code_addr; code_p = code_addr;
cl_u = (union clause_obj *)code_p;
cpc = CodeStart; cpc = CodeStart;
comit_lab = 0L; comit_lab = 0L;
/* Space while for the clause flags */ /* Space while for the clause flags */
log_update = CurrentPred->PredFlags & LogUpdatePredFlag; log_update = CurrentPred->PredFlags & LogUpdatePredFlag;
#if defined(YAPOR) || defined(THREADS)
dynamic = CurrentPred->PredFlags & DynamicPredFlag; dynamic = CurrentPred->PredFlags & DynamicPredFlag;
#endif
if (assembling != ASSEMBLING_INDEX) { if (assembling != ASSEMBLING_INDEX) {
Clause *cl_p = (Clause *)code_p; if (log_update) {
if (pass_no) { if (pass_no) {
cl_p->u.ClValue = clause_store; cl_u->luc.ClFlags = LogUpdMask;
cl_p->ClFlags = clause_mask; cl_u->luc.Owner = Yap_ConsultingFile();
if (log_update)
cl_p->ClFlags |= LogUpdMask;
if (clause_has_blobs) { if (clause_has_blobs) {
cl_p->ClFlags |= HasBlobsMask; cl_u->luc.ClFlags |= HasBlobsMask;
} }
cl_p->u2.ClExt = NULL; cl_u->luc.u2.ClExt = NULL;
cl_p->Owner = Yap_ConsultingFile();
}
code_p = (yamop *)(cl_p->ClCode);
IPredArity = cpc->rnd2; /* number of args */
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if ((dynamic||log_update) && pass_no) { INIT_LOCK(cl_u.luc->ClLock);
INIT_LOCK(cl_p->ClLock); INIT_CLREF_COUNT(cl_u.luc);
INIT_CLREF_COUNT(cl_p);
}
#endif #endif
#ifdef YAPOR }
code_p = cl_u->luc.ClCode;
} else if (dynamic) {
if (pass_no) {
cl_u->ic.Owner = Yap_ConsultingFile();
if (clause_has_blobs) {
cl_u->ic.ClFlags |= HasBlobsMask;
}
#if defined(YAPOR) || defined(THREADS)
INIT_LOCK(cl_u.ic->ClLock);
INIT_CLREF_COUNT(cl_u.ic);
#endif
}
code_p = cl_u->ic.ClCode;
} else {
/* static clause */
if (pass_no) {
cl_u->sc.ClFlags = 0;
cl_u->sc.Owner = Yap_ConsultingFile();
if (clause_has_blobs) {
cl_u->sc.ClFlags |= HasBlobsMask;
}
}
code_p = cl_u->sc.ClCode;
}
IPredArity = cpc->rnd2; /* number of args */
entry_code = code_p; entry_code = code_p;
#ifdef YAPOR
a_try(TRYOP(_try_me, _try_me0), 0, IPredArity, 1, 0); a_try(TRYOP(_try_me, _try_me0), 0, IPredArity, 1, 0);
#else #else
a_try(TRYOP(_try_me, _try_me0), 0, IPredArity); a_try(TRYOP(_try_me, _try_me0), 0, IPredArity);
#endif /* YAPOR */ #endif /* YAPOR */
} else { } else {
Clause *cl_p = (Clause *)code_p;
if (pass_no) {
cl_p->u.ClValue = TermNil;
if (log_update) { if (log_update) {
cl_p->u2.ClUse = 0; if (pass_no) {
cl_p->ClFlags = LogUpdatePredFlag|IndexedPredFlag|IndexMask; cl_u->luc.ClFlags = LogUpdatePredFlag|IndexedPredFlag|IndexMask;
cl_u->luc.u2.ClUse = 0;
}
code_p = cl_u->luc.ClCode;
} else { } else {
cl_p->u2.ClExt = NULL; if (pass_no) {
cl_p->ClFlags = clause_mask|IndexMask; cl_u->sc.ClFlags = IndexMask;
} }
cl_p->Owner = CurrentPred->OwnerFile; code_p = cl_u->sc.ClCode;
} }
code_p = (yamop *)(cl_p->ClCode);
#if defined(YAPOR) || defined(THREADS)
if ((dynamic||log_update) && pass_no) {
INIT_LOCK(cl_p->ClLock);
INIT_CLREF_COUNT(cl_p);
}
#endif
#ifdef YAPOR
entry_code = code_p; entry_code = code_p;
#endif
} }
while (cpc) { while (cpc) {
@ -2282,92 +2295,19 @@ do_pass(void)
a_cl(_trust_logical_pred); a_cl(_trust_logical_pred);
a_gl(_trust); a_gl(_trust);
break; break;
case tryin_op: case try_in_op:
a_igl(_try_in); a_il(_try_in);
break;
case retryin_op:
a_gl(_retry);
break;
case trustin_op:
a_gl_in(_trust_in);
break;
case tryf_op:
if (log_update)
a_cl(_try_logical_pred);
a_gl(_try_clause);
break;
case retryf_op:
a_gl(_retry_first);
break;
case trustf_op:
if (log_update)
a_cl(_trust_logical_pred);
a_gl(_trust_first);
break;
case tryfin_op:
a_igl(_try_in);
break;
case retryfin_op:
a_gl(_retry_first);
break;
case trustfin_op:
a_gl_in(_trust_first_in);
break;
case tryt_op:
if (log_update)
a_cl(_try_logical_pred);
a_gl(_try_clause);
break;
case retryt_op:
a_gl(_retry_tail);
break;
case trustt_op:
if (log_update)
a_cl(_trust_logical_pred);
a_gl(_trust_tail);
break;
case trytin_op:
a_igl(_try_in);
break;
case retrytin_op:
a_gl(_retry_tail);
break;
case trusttin_op:
a_gl_in(_trust_tail_in);
break;
case tryh_op:
if (log_update)
a_cl(_try_logical_pred);
a_gl(_try_clause);
break;
case retryh_op:
a_gl(_retry_head);
break;
case trusth_op:
if (log_update)
a_cl(_trust_logical_pred);
a_gl(_trust_head);
break;
case tryhin_op:
a_igl(_try_in);
break;
case retryhin_op:
a_gl(_retry_head);
break;
case trusthin_op:
a_gl_in(_trust_head_in);
break;
case trylf_op:
/* now that we don't need to save the arguments this is just a
simple retry */
a_gl(_retry);
break;
/* ibd */
case trylh_op:
a_gl(_retry);
break; break;
case jump_op: case jump_op:
/* don't assemble jumps to next instruction */
if (cpc->nextInst == NULL ||
cpc->nextInst->op != label_op ||
cpc->rnd1 != cpc->nextInst->rnd1) {
a_l(_jump); a_l(_jump);
}
break;
case jumpi_op:
a_il(_jump);
break; break;
case restore_tmps_op: case restore_tmps_op:
a_l(_move_back); a_l(_move_back);
@ -2460,34 +2400,18 @@ do_pass(void)
#endif /* YAPOR */ #endif /* YAPOR */
dealloc_found = FALSE; dealloc_found = FALSE;
break; break;
case cache_arg_op:
a_4sw_x(_switch_on_arg_type);
break;
case cache_sub_arg_op:
a_4sw_s(_switch_on_sub_arg_type);
break;
case jump_v_op: case jump_v_op:
a_igl(_jump_if_var); a_igl(_jump_if_var);
break; break;
case switch_t_op: case switch_on_type_op:
a_4sw(_switch_on_type); a_4sw(_switch_on_type);
break; break;
case switch_nv_op:
a_3sw(_switch_on_nonv);
break;
case switch_l_op:
a_3sws(_switch_last);
break;
case switch_h_op:
a_4sw(_switch_on_head);
break;
case switch_lnl_op:
#if USE_THREADED_CODE
a_4_lsw(_switch_list_nl);
#else
a_4sw(_switch_list_nl);
#endif
break;
case switch_nvl_op:
a_3sw(_switch_nv_list);
break;
case switch_ll_op:
a_3sws(_switch_l_list);
break;
case switch_c_op: case switch_c_op:
a_hx(_switch_on_cons); a_hx(_switch_on_cons);
break; break;
@ -2495,19 +2419,21 @@ do_pass(void)
a_hx(_switch_on_func); a_hx(_switch_on_func);
break; break;
case if_c_op: case if_c_op:
if (cpc->rnd1 == 1) {
a_go(_go_on_cons);
} else {
a_if(_if_cons); a_if(_if_cons);
}
break; break;
case if_f_op: case if_f_op:
a_if(_if_func); if (cpc->rnd1 == 1) {
break;
case go_c_op:
a_go(_go_on_cons);
break;
case go_f_op:
a_go(_go_on_func); a_go(_go_on_func);
} else {
a_if(_if_func);
}
break; break;
case if_not_op: case if_not_op:
a_go(_if_not_then); a_ifnot(_if_not_then);
break; break;
case mark_initialised_pvars_op: case mark_initialised_pvars_op:
a_bmap(); a_bmap();
@ -2576,6 +2502,7 @@ do_pass(void)
} }
if (!ystop_found) if (!ystop_found)
a_e(_Ystop); a_e(_Ystop);
return entry_code;
} }
yamop * yamop *
@ -2587,6 +2514,7 @@ Yap_assemble(int mode)
* produces the final version of the code * produces the final version of the code
*/ */
CELL size; CELL size;
yamop *entry_code;
code_addr = NULL; code_addr = NULL;
assembling = mode; assembling = mode;
@ -2594,7 +2522,7 @@ Yap_assemble(int mode)
label_offset = (int *)freep; label_offset = (int *)freep;
pass_no = 0; pass_no = 0;
asm_error = FALSE; asm_error = FALSE;
do_pass(); entry_code = do_pass();
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";
@ -2604,7 +2532,7 @@ Yap_assemble(int mode)
YAPEnterCriticalSection(); YAPEnterCriticalSection();
{ {
size = size =
(CELL)NEXTOP(NEXTOP(NEXTOP((yamop *)(((Clause *)NULL)->ClCode),ld),sla),e); (CELL)NEXTOP(NEXTOP(NEXTOP((yamop *)(((DynamicClause *)NULL)->ClCode),ld),sla),e);
if ((CELL)code_p > size) if ((CELL)code_p > size)
size = (CELL)code_p; size = (CELL)code_p;
} }
@ -2614,17 +2542,12 @@ Yap_assemble(int mode)
return NULL; return NULL;
} }
} }
do_pass(); entry_code = do_pass();
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
{
Clause *cl = (Clause *)code_addr; /* lcc, why? */
#ifdef LOW_PROF #ifdef LOW_PROF
PROFSIZE=code_p; PROFSIZE=code_p;
#endif #endif
return entry_code;
return(cl->ClCode);
}
} }
void void

3
C/arith2.c
View File

@ -1669,8 +1669,7 @@ static InitBinEntry InitBinTab[] = {
{"exp", p_power}, {"exp", p_power},
{"gcd", p_gcd}, {"gcd", p_gcd},
{"min", p_min}, {"min", p_min},
{"max", p_max}, {"max", p_max}
{"atan2", p_atan2}
}; };
static Int static Int

268
C/cdmgr.c
View File

@ -49,7 +49,7 @@ STATIC_PROTO(Int search_for_static_predicate_in_use, (PredEntry *, int));
STATIC_PROTO(void mark_pred, (int, PredEntry *)); STATIC_PROTO(void mark_pred, (int, PredEntry *));
STATIC_PROTO(void do_toggle_static_predicates_in_use, (int)); STATIC_PROTO(void do_toggle_static_predicates_in_use, (int));
#endif #endif
STATIC_PROTO(void recover_log_upd_clause, (Clause *)); STATIC_PROTO(void recover_log_upd_clause, (LogUpdClause *));
STATIC_PROTO(Int p_number_of_clauses, (void)); STATIC_PROTO(Int p_number_of_clauses, (void));
STATIC_PROTO(Int p_compile, (void)); STATIC_PROTO(Int p_compile, (void));
STATIC_PROTO(Int p_compile_dynamic, (void)); STATIC_PROTO(Int p_compile_dynamic, (void));
@ -107,7 +107,7 @@ static_in_use(PredEntry *p, int check_everything)
return (FALSE); return (FALSE);
} }
if (STATIC_PREDICATES_MARKED) { if (STATIC_PREDICATES_MARKED) {
return (p->StateOfPred & InUseMask); return (p->PredFlags & InUsePredFlag);
} else { } else {
/* This code does not work for YAPOR or THREADS!!!!!!!! */ /* This code does not work for YAPOR or THREADS!!!!!!!! */
return(search_for_static_predicate_in_use(p, check_everything)); return(search_for_static_predicate_in_use(p, check_everything));
@ -190,11 +190,9 @@ IPred(PredEntry *ap)
ap->PredFlags |= IndexedPredFlag; ap->PredFlags |= IndexedPredFlag;
} }
if (ap->PredFlags & SpiedPredFlag) { if (ap->PredFlags & SpiedPredFlag) {
ap->StateOfPred = StaticMask | SpiedMask;
ap->OpcodeOfPred = Yap_opcode(_spy_pred); ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else { } else {
ap->StateOfPred = 0;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred; ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
ap->OpcodeOfPred = ((yamop *)(ap->CodeOfPred))->opc; ap->OpcodeOfPred = ((yamop *)(ap->CodeOfPred))->opc;
} }
@ -214,7 +212,7 @@ Yap_IPred(PredEntry *p)
#define GONEXT(TYPE) code_p = ((yamop *)(&(code_p->u.TYPE.next))) #define GONEXT(TYPE) code_p = ((yamop *)(&(code_p->u.TYPE.next)))
static void static void
recover_log_upd_clause(Clause *cl) recover_log_upd_clause(LogUpdClause *cl)
{ {
LOCK(cl->ClLock); LOCK(cl->ClLock);
if (cl->ClFlags & LogUpdRuleMask) { if (cl->ClFlags & LogUpdRuleMask) {
@ -226,7 +224,7 @@ recover_log_upd_clause(Clause *cl)
!(cl->ClFlags & InUseMask) !(cl->ClFlags & InUseMask)
#endif #endif
) )
Yap_ErCl(cl); Yap_ErLogUpdCl(cl);
} else { } else {
if (--(cl->u2.ClUse) == 0 && if (--(cl->u2.ClUse) == 0 &&
(cl->ClFlags & ErasedMask) && (cl->ClFlags & ErasedMask) &&
@ -236,21 +234,21 @@ recover_log_upd_clause(Clause *cl)
!(cl->ClFlags & InUseMask) !(cl->ClFlags & InUseMask)
#endif #endif
) )
Yap_ErCl(cl); Yap_ErLogUpdCl(cl);
} }
UNLOCK(cl->ClLock); UNLOCK(cl->ClLock);
} }
static Clause * static LogUpdClause *
ClauseBodyToClause(yamop *addr) ClauseBodyToLogUpdClause(yamop *addr)
{ {
addr = (yamop *)((CODEADDR)addr - (Int)NEXTOP((yamop *)NULL,ld)); addr = (yamop *)((CODEADDR)addr - (Int)NEXTOP((yamop *)NULL,ld));
return(ClauseCodeToClause(addr)); return(ClauseCodeToLogUpdClause(addr));
} }
/* we already have a lock on the predicate */ /* we already have a lock on the predicate */
static void static void
RemoveLogUpdIndex(Clause *cl) RemoveLogUpdIndex(LogUpdClause *cl)
{ {
yamop *code_p; yamop *code_p;
OPCODE last = Yap_opcode(_trust_logical_pred); OPCODE last = Yap_opcode(_trust_logical_pred);
@ -266,20 +264,21 @@ RemoveLogUpdIndex(Clause *cl)
code_p = cl->u.ClVarChain; code_p = cl->u.ClVarChain;
/* skip try_log_update */ /* skip try_log_update */
GONEXT(l); GONEXT(l);
recover_log_upd_clause(ClauseBodyToClause(code_p->u.ld.d)); recover_log_upd_clause(ClauseBodyToLogUpdClause(code_p->u.ld.d));
GONEXT(ld); GONEXT(ld);
while(code_p->opc != last) { while(code_p->opc != last) {
recover_log_upd_clause(ClauseBodyToClause(code_p->u.ld.d)); recover_log_upd_clause(ClauseBodyToLogUpdClause(code_p->u.ld.d));
GONEXT(ld); GONEXT(ld);
} }
/* skip trust_log_update */ /* skip trust_log_update */
GONEXT(l); GONEXT(l);
recover_log_upd_clause(ClauseBodyToClause(code_p->u.ld.d)); recover_log_upd_clause(ClauseBodyToLogUpdClause(code_p->u.ld.d));
/* don't need to worry about MultiFiles */
Yap_FreeCodeSpace((char *) cl); Yap_FreeCodeSpace((char *) cl);
} }
void void
Yap_RemoveLogUpdIndex(Clause *cl) Yap_RemoveLogUpdIndex(LogUpdClause *cl)
{ {
RemoveLogUpdIndex(cl); RemoveLogUpdIndex(cl);
} }
@ -298,12 +297,15 @@ RemoveIndexation(PredEntry *ap)
} }
spied = ap->PredFlags & SpiedPredFlag; spied = ap->PredFlags & SpiedPredFlag;
if (ap->PredFlags & LogUpdatePredFlag) if (ap->PredFlags & LogUpdatePredFlag)
RemoveLogUpdIndex(ClauseCodeToClause(ap->cs.p_code.TrueCodeOfPred)); RemoveLogUpdIndex(ClauseCodeToLogUpdClause(ap->cs.p_code.TrueCodeOfPred));
else { else {
Clause *cl = ClauseCodeToClause(ap->cs.p_code.TrueCodeOfPred); DeadClause *cl;
cl = (DeadClause *)ClauseCodeToStaticClause(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->ClFlags = 0;
cl->NextCl = DeadClauses;
DeadClauses = cl; DeadClauses = cl;
} else { } else {
Yap_FreeCodeSpace((char *)cl); Yap_FreeCodeSpace((char *)cl);
@ -312,12 +314,10 @@ RemoveIndexation(PredEntry *ap)
if (First != ap->cs.p_code.LastClause) if (First != ap->cs.p_code.LastClause)
ap->cs.p_code.TrueCodeOfPred = First; ap->cs.p_code.TrueCodeOfPred = First;
ap->PredFlags ^= IndexedPredFlag; ap->PredFlags ^= IndexedPredFlag;
if (First != NIL && spied) { if (First != NULL && spied) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred); ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
ap->StateOfPred = StaticMask | SpiedMask;
} else { } else {
ap->StateOfPred = StaticMask;
ap->OpcodeOfPred = ap->cs.p_code.TrueCodeOfPred->opc; ap->OpcodeOfPred = ap->cs.p_code.TrueCodeOfPred->opc;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred; ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
} }
@ -346,17 +346,36 @@ retract_all(PredEntry *p, int in_use)
{ {
yamop *q, *q1; yamop *q, *q1;
int multifile_pred = p->PredFlags & MultiFileFlag; int multifile_pred = p->PredFlags & MultiFileFlag;
yamop *fclause = NIL, *lclause = NIL; yamop *fclause = NULL, *lclause = NULL;
q = p->cs.p_code.FirstClause; q = p->cs.p_code.FirstClause;
if (q != NIL) { if (q != NIL) {
if (p->PredFlags & LogUpdatePredFlag) {
do { do {
Clause *cl; LogUpdClause *cl;
q1 = q; q1 = q;
q = NextClause(q); q = NextClause(q);
cl = ClauseCodeToClause(q1); cl = ClauseCodeToLogUpdClause(q1);
if (multifile_pred && cl->Owner != YapConsultingFile()) { if (multifile_pred && cl->Owner != YapConsultingFile()) {
if (fclause == NIL) { if (fclause == NULL) {
fclause = q1;
} else {
yamop *clp = (yamop *)lclause;
clp->u.ld.d = q1;
}
lclause = q1;
} else {
Yap_ErLogUpdCl(cl);
}
} while (q1 != p->cs.p_code.LastClause);
} else {
do {
StaticClause *cl;
q1 = q;
q = NextClause(q);
cl = ClauseCodeToStaticClause(q1);
if (multifile_pred && cl->Owner != YapConsultingFile()) {
if (fclause == NULL) {
fclause = q1; fclause = q1;
} else { } else {
yamop *clp = (yamop *)lclause; yamop *clp = (yamop *)lclause;
@ -364,19 +383,19 @@ retract_all(PredEntry *p, int in_use)
} }
lclause = q1; lclause = q1;
} else { } else {
if (p->PredFlags & LogUpdatePredFlag)
Yap_ErCl(cl);
else {
if (cl->ClFlags & HasBlobsMask) { if (cl->ClFlags & HasBlobsMask) {
cl->u.NextCl = DeadClauses; DeadClause *dcl = (DeadClause *)cl;
DeadClauses = cl; dcl->NextCl = DeadClauses;
dcl->ClFlags = 0;
DeadClauses = dcl;
} else { } else {
Yap_FreeCodeSpace((char *)cl); Yap_FreeCodeSpace((char *)cl);
} }
} p->cs.p_code.NOfClauses--;
} }
} while (q1 != p->cs.p_code.LastClause); } while (q1 != p->cs.p_code.LastClause);
} }
}
p->cs.p_code.FirstClause = fclause; p->cs.p_code.FirstClause = fclause;
p->cs.p_code.LastClause = lclause; p->cs.p_code.LastClause = lclause;
if (fclause == NIL) { if (fclause == NIL) {
@ -407,7 +426,6 @@ retract_all(PredEntry *p, int in_use)
} }
} }
if (p->PredFlags & SpiedPredFlag) { if (p->PredFlags & SpiedPredFlag) {
p->StateOfPred |= StaticMask | SpiedMask;
p->OpcodeOfPred = Yap_opcode(_spy_pred); p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} else if (p->PredFlags & IndexedPredFlag) { } else if (p->PredFlags & IndexedPredFlag) {
@ -460,6 +478,7 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
} }
p->cs.p_code.TrueCodeOfPred = pt; p->cs.p_code.TrueCodeOfPred = pt;
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = cp; p->cs.p_code.FirstClause = p->cs.p_code.LastClause = cp;
p->cs.p_code.NOfClauses = 1;
p->StatisticsForPred.NOfEntries = 0; p->StatisticsForPred.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0; p->StatisticsForPred.NOfHeadSuccesses = 0;
p->StatisticsForPred.NOfRetries = 0; p->StatisticsForPred.NOfRetries = 0;
@ -472,13 +491,8 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
PUT_YAMOP_SEQ((yamop *)cp); PUT_YAMOP_SEQ((yamop *)cp);
#endif /* YAPOR */ #endif /* YAPOR */
if (spy_flag) { if (spy_flag) {
p->StateOfPred |= StaticMask | SpiedMask;
p->OpcodeOfPred = Yap_opcode(_spy_pred); p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} else if (is_fast(p)) {
p->StateOfPred |= StaticMask;
} else {
p->StateOfPred |= StaticMask;
} }
if (yap_flags[SOURCE_MODE_FLAG]) { if (yap_flags[SOURCE_MODE_FLAG]) {
p->PredFlags |= SourcePredFlag; p->PredFlags |= SourcePredFlag;
@ -491,8 +505,8 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
static void static void
add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag) add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
{ {
yamop *ncp = ((Clause *)NIL)->ClCode; yamop *ncp = ((DynamicClause *)NULL)->ClCode;
Clause *cl; DynamicClause *cl;
if (p == PredGoalExpansion) { if (p == PredGoalExpansion) {
PRED_GOAL_EXPANSION_ON = TRUE; PRED_GOAL_EXPANSION_ON = TRUE;
Yap_InitComma(); Yap_InitComma();
@ -510,25 +524,18 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
/* allocate starter block, containing info needed to start execution, /* allocate starter block, containing info needed to start execution,
* that is a try_mark to start the code and a fail to finish things up */ * that is a try_mark to start the code and a fail to finish things up */
cl = cl =
(Clause *) Yap_AllocCodeSpace((Int)NEXTOP(NEXTOP(NEXTOP(ncp,ld),e),e)); (DynamicClause *) Yap_AllocCodeSpace((Int)NEXTOP(NEXTOP(NEXTOP(ncp,ld),e),e));
if (cl == NIL) { if (cl == NIL) {
Yap_Error(SYSTEM_ERROR,TermNil,"Heap crashed against Stacks"); Yap_Error(SYSTEM_ERROR,TermNil,"Heap crashed against Stacks");
return; return;
} }
cl->Owner = p->OwnerFile;
/* skip the first entry, this contains the back link and will always be /* skip the first entry, this contains the back link and will always be
empty for this entry */ empty for this entry */
ncp = (yamop *)(((CELL *)ncp)+1); ncp = (yamop *)(((CELL *)ncp)+1);
/* next we have the flags. For this block mainly say whether we are /* next we have the flags. For this block mainly say whether we are
* being spied */ * being spied */
if (spy_flag) {
cl->ClFlags = DynamicMask | SpiedMask;
ncp = cl->ClCode;
}
else {
cl->ClFlags = DynamicMask; cl->ClFlags = DynamicMask;
ncp = cl->ClCode; ncp = cl->ClCode;
}
INIT_LOCK(cl->ClLock); INIT_LOCK(cl->ClLock);
INIT_CLREF_COUNT(cl); INIT_CLREF_COUNT(cl);
/* next, set the first instruction to execute in the dyamic /* next, set the first instruction to execute in the dyamic
@ -546,6 +553,7 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
#endif /* YAPOR */ #endif /* YAPOR */
/* This is the point we enter the code */ /* This is the point we enter the code */
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = ncp; p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = ncp;
p->cs.p_code.NOfClauses = 1;
/* 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)
@ -558,7 +566,7 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
cp->u.ld.p = p; cp->u.ld.p = p;
cp->u.ld.d = ncp; cp->u.ld.d = ncp;
/* 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; ClauseCodeToDynamicClause(cp)->ClPrevious = ncp;
/* 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->cs.p_code.LastClause = p->cs.p_code.FirstClause = cp; p->cs.p_code.LastClause = p->cs.p_code.FirstClause = cp;
@ -621,6 +629,7 @@ asserta_stat_clause(PredEntry *p, yamop *cp, int spy_flag)
} }
p->cs.p_code.TrueCodeOfPred = p->cs.p_code.FirstClause = cp; p->cs.p_code.TrueCodeOfPred = p->cs.p_code.FirstClause = cp;
p->cs.p_code.LastClause->u.ld.d = cp; p->cs.p_code.LastClause->u.ld.d = cp;
p->cs.p_code.NOfClauses++;
} }
/* p is already locked */ /* p is already locked */
@ -629,11 +638,11 @@ asserta_dynam_clause(PredEntry *p, yamop *cp)
{ {
yamop *q; yamop *q;
q = cp; q = cp;
LOCK(ClauseCodeToClause(p->cs.p_code.FirstClause)->ClLock); LOCK(ClauseCodeToDynamicClause(p->cs.p_code.FirstClause)->ClLock);
/* 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->cs.p_code.FirstClause)->u.ClPrevious = q; ClauseCodeToDynamicClause(p->cs.p_code.FirstClause)->ClPrevious = q;
ClauseCodeToClause(cp)->u.ClPrevious = (yamop *)(p->CodeOfPred); ClauseCodeToDynamicClause(cp)->ClPrevious = (yamop *)(p->CodeOfPred);
UNLOCK(ClauseCodeToClause(p->cs.p_code.FirstClause)->ClLock); UNLOCK(ClauseCodeToDynamicClause(p->cs.p_code.FirstClause)->ClLock);
q->u.ld.d = p->cs.p_code.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;
@ -650,6 +659,7 @@ asserta_dynam_clause(PredEntry *p, yamop *cp)
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;
p->cs.p_code.NOfClauses++;
} }
/* p is already locked */ /* p is already locked */
@ -715,6 +725,7 @@ assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag)
} }
} }
#endif /* YAPOR */ #endif /* YAPOR */
p->cs.p_code.NOfClauses++;
} }
/* p is already locked */ /* p is already locked */
@ -724,12 +735,12 @@ assertz_dynam_clause(PredEntry *p, yamop *cp)
yamop *q; yamop *q;
q = p->cs.p_code.LastClause; q = p->cs.p_code.LastClause;
LOCK(ClauseCodeToClause(q)->ClLock); LOCK(ClauseCodeToDynamicClause(q)->ClLock);
q->u.ld.d = cp; q->u.ld.d = cp;
p->cs.p_code.LastClause = cp; p->cs.p_code.LastClause = cp;
/* 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; ClauseCodeToDynamicClause(cp)->ClPrevious = q;
UNLOCK(ClauseCodeToClause(q)->ClLock); UNLOCK(ClauseCodeToDynamicClause(q)->ClLock);
q = (yamop *)cp; q = (yamop *)cp;
if (p->PredFlags & ProfiledPredFlag) if (p->PredFlags & ProfiledPredFlag)
q->opc = Yap_opcode(_profiled_retry_and_mark); q->opc = Yap_opcode(_profiled_retry_and_mark);
@ -740,6 +751,7 @@ assertz_dynam_clause(PredEntry *p, yamop *cp)
q->u.ld.d = p->CodeOfPred; q->u.ld.d = p->CodeOfPred;
q->u.ld.s = p->ArityOfPE; q->u.ld.s = p->ArityOfPE;
q->u.ld.p = p; q->u.ld.p = p;
p->cs.p_code.NOfClauses++;
} }
static void expand_consult(void) static void expand_consult(void)
@ -883,8 +895,13 @@ addclause(Term t, yamop *cp, int mode, int mod)
if (Yap_ErrorMessage && Yap_Error_TYPE == PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE) if (Yap_ErrorMessage && Yap_Error_TYPE == PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE)
return; return;
if (!is_dynamic(p)) { if (!is_dynamic(p)) {
Clause *clp = ClauseCodeToClause(cp); if (p->PredFlags & LogUpdatePredFlag) {
LogUpdClause *clp = ClauseCodeToLogUpdClause(cp);
clp->ClFlags |= StaticMask; clp->ClFlags |= StaticMask;
} else {
StaticClause *clp = ClauseCodeToStaticClause(cp);
clp->ClFlags |= StaticMask;
}
if (compile_mode) if (compile_mode)
p->PredFlags |= CompiledPredFlag | FastPredFlag; p->PredFlags |= CompiledPredFlag | FastPredFlag;
else else
@ -1101,7 +1118,7 @@ p_compile_dynamic(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);
Clause *cl; DynamicClause *cl;
yamop *code_adr; yamop *code_adr;
int old_optimize; int old_optimize;
Int mod; Int mod;
@ -1119,25 +1136,20 @@ p_compile_dynamic(void)
if (!Yap_ErrorMessage) { if (!Yap_ErrorMessage) {
optimizer_on = old_optimize; optimizer_on = old_optimize;
cl = ClauseCodeToClause(code_adr); cl = ClauseCodeToDynamicClause(code_adr);
addclause(t, code_adr, (int) (IntOfTerm(t1) & 3), mod); addclause(t, code_adr, (int) (IntOfTerm(t1) & 3), mod);
} } else {
if (Yap_ErrorMessage) {
if (IntOfTerm(t1) & 4) { if (IntOfTerm(t1) & 4) {
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, "line %d, %s", Yap_FirstLineInParse(), Yap_ErrorMessage); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, "line %d, %s", Yap_FirstLineInParse(), Yap_ErrorMessage);
} else } else
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return (FALSE); return (FALSE);
} }
cl = ClauseCodeToClause(code_adr);
if (!(cl->ClFlags & LogUpdMask))
cl->ClFlags = DynamicMask; cl->ClFlags = DynamicMask;
t = MkIntegerTerm((Int)code_adr); t = MkIntegerTerm((Int)code_adr);
return(Yap_unify(ARG4, t)); return(Yap_unify(ARG4, t));
} }
static int consult_level = 0; static int consult_level = 0;
static Atom static Atom
@ -1285,18 +1297,20 @@ p_purge_clauses(void)
q1 = q; q1 = q;
q = NextClause(q); q = NextClause(q);
if (pred->PredFlags & LogUpdatePredFlag) if (pred->PredFlags & LogUpdatePredFlag)
Yap_ErCl(ClauseCodeToClause(q1)); Yap_ErLogUpdCl(ClauseCodeToLogUpdClause(q1));
else { else {
Clause *cl = ClauseCodeToClause(q1); StaticClause *cl = ClauseCodeToStaticClause(q1);
if (cl->ClFlags & HasBlobsMask || in_use) { if (cl->ClFlags & HasBlobsMask || in_use) {
cl->u.NextCl = DeadClauses; DeadClause *dcl = (DeadClause *)cl;
DeadClauses = cl; dcl->NextCl = DeadClauses;
dcl->ClFlags = 0;
DeadClauses = dcl;
} else { } else {
Yap_FreeCodeSpace((char *)cl); Yap_FreeCodeSpace((char *)cl);
} }
} }
} while (q1 != pred->cs.p_code.LastClause); } while (q1 != pred->cs.p_code.LastClause);
pred->cs.p_code.FirstClause = pred->cs.p_code.LastClause = NIL; pred->cs.p_code.FirstClause = pred->cs.p_code.LastClause = NULL;
if (pred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) { if (pred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) {
pred->OpcodeOfPred = FAIL_OPCODE; pred->OpcodeOfPred = FAIL_OPCODE;
} else { } else {
@ -1371,7 +1385,6 @@ p_setspy(void)
pred->OpcodeOfPred = Yap_opcode(_spy_pred); pred->OpcodeOfPred = Yap_opcode(_spy_pred);
pred->CodeOfPred = (yamop *)(&(pred->OpcodeOfPred)); pred->CodeOfPred = (yamop *)(&(pred->OpcodeOfPred));
} }
pred->StateOfPred |= SpiedMask;
pred->PredFlags |= SpiedPredFlag; pred->PredFlags |= SpiedPredFlag;
WRITE_UNLOCK(pred->PRWLock); WRITE_UNLOCK(pred->PRWLock);
return (TRUE); return (TRUE);
@ -1407,9 +1420,6 @@ p_rmspy(void)
return (FALSE); return (FALSE);
} }
if (!(pred->PredFlags & DynamicPredFlag)) { if (!(pred->PredFlags & DynamicPredFlag)) {
if ((pred->StateOfPred ^= SpiedMask) & InUseMask)
pred->CodeOfPred = pred->cs.p_code.TrueCodeOfPred;
else
pred->CodeOfPred = pred->cs.p_code.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)) {
@ -1436,7 +1446,6 @@ p_number_of_clauses(void)
int ncl = 0; int ncl = 0;
Prop pe; Prop pe;
yamop *q; yamop *q;
int testing;
int mod; int mod;
if (IsVarTerm(t2) || !IsAtomTerm(t2)) { if (IsVarTerm(t2) || !IsAtomTerm(t2)) {
@ -1454,19 +1463,10 @@ p_number_of_clauses(void)
q = RepPredProp(pe)->cs.p_code.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)
testing = TRUE;
else
testing = FALSE;
while (q != RepPredProp(pe)->cs.p_code.LastClause) { while (q != RepPredProp(pe)->cs.p_code.LastClause) {
if (!testing ||
!(ClauseCodeToClause(q)->ClFlags & ErasedMask))
ncl++; ncl++;
q = NextClause(q); q = NextClause(q);
} }
if (!testing ||
!(ClauseCodeToClause(q)->ClFlags & ErasedMask))
ncl++;
} }
READ_UNLOCK(RepPredProp(pe)->PRWLock); READ_UNLOCK(RepPredProp(pe)->PRWLock);
t = MkIntegerTerm(ncl); t = MkIntegerTerm(ncl);
@ -1803,37 +1803,37 @@ p_compile_mode(void)
} }
#if !defined(YAPOR) #if !defined(YAPOR)
static yamop *next_clause(PredEntry *pe, yamop *codeptr)
{
yamop *clcode;
Clause *cl;
clcode = pe->cs.p_code.FirstClause;
cl = ClauseCodeToClause(clcode);
do {
if (clcode == pe->cs.p_code.LastClause)
break;
if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) {
return(NextClause(clcode));
}
cl = ClauseCodeToClause(clcode = NextClause(clcode));
} while (TRUE);
Yap_Error(SYSTEM_ERROR,TermNil,"could not find clause for indexing code");
return(NULL);
}
static yamop *cur_clause(PredEntry *pe, yamop *codeptr) static yamop *cur_clause(PredEntry *pe, yamop *codeptr)
{ {
yamop *clcode; yamop *clcode;
Clause *cl; StaticClause *cl;
clcode = pe->cs.p_code.FirstClause; clcode = pe->cs.p_code.FirstClause;
cl = ClauseCodeToClause(clcode); cl = ClauseCodeToStaticClause(clcode);
do { do {
if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) { if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) {
return((yamop *)clcode); return((yamop *)clcode);
} }
if (clcode == pe->cs.p_code.LastClause) if (clcode == pe->cs.p_code.LastClause)
break; break;
cl = ClauseCodeToClause(clcode = NextClause(clcode)); cl = ClauseCodeToStaticClause(clcode = NextClause(clcode));
} while (TRUE);
Yap_Error(SYSTEM_ERROR,TermNil,"could not find clause for indexing code");
return(NULL);
}
static yamop *cur_log_upd_clause(PredEntry *pe, yamop *codeptr)
{
yamop *clcode;
LogUpdClause *cl;
clcode = pe->cs.p_code.FirstClause;
cl = ClauseCodeToLogUpdClause(clcode);
do {
if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) {
return((yamop *)clcode);
}
if (clcode == pe->cs.p_code.LastClause)
break;
cl = ClauseCodeToLogUpdClause(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);
@ -1899,24 +1899,25 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything)
READ_LOCK(pe->PRWLock); READ_LOCK(pe->PRWLock);
if (p->PredFlags & IndexedPredFlag) { if (p->PredFlags & IndexedPredFlag) {
yamop *code_p = b_ptr->cp_ap; yamop *code_p = b_ptr->cp_ap;
if (code_p >= p->cs.p_code.TrueCodeOfPred && char *code_end;
code_p <= p->cs.p_code.TrueCodeOfPred + Yap_SizeOfBlock((CODEADDR)ClauseCodeToClause(p->cs.p_code.TrueCodeOfPred))) {
yamop *prev; if (p->PredFlags & LogUpdatePredFlag) {
/* fix the choicepoint */ LogUpdClause *cl = ClauseCodeToLogUpdClause(p->cs.p_code.TrueCodeOfPred);
switch(opnum) { code_end = (char *)cl + Yap_SizeOfBlock((CODEADDR)cl);
case _switch_last: } else {
case _switch_l_list: StaticClause *cl = ClauseCodeToStaticClause(p->cs.p_code.TrueCodeOfPred);
{ code_end = (char *)cl + Yap_SizeOfBlock((CODEADDR)cl);
prev = (yamop *)((CODEADDR)(code_p)-(CELL)NEXTOP((yamop *)NIL,ld));
/* previous clause must be a try or a retry */
b_ptr->cp_ap = next_clause(pe, prev->u.ld.d);
} }
break; if (code_p >= p->cs.p_code.TrueCodeOfPred &&
default: code_p <= (yamop *)code_end) {
/* fix the choicepoint */
if (p->PredFlags & LogUpdatePredFlag) {
b_ptr->cp_ap = cur_log_upd_clause(pe, b_ptr->cp_ap->u.ld.d);
} else {
b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->u.ld.d); b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->u.ld.d);
} }
READ_UNLOCK(pe->PRWLock);
} }
READ_UNLOCK(pe->PRWLock);
} else { } else {
READ_UNLOCK(pe->PRWLock); READ_UNLOCK(pe->PRWLock);
} }
@ -1935,9 +1936,9 @@ mark_pred(int mark, PredEntry *pe)
if (pe->ModuleOfPred) { if (pe->ModuleOfPred) {
WRITE_LOCK(pe->PRWLock); WRITE_LOCK(pe->PRWLock);
if (mark) { if (mark) {
pe->StateOfPred |= InUseMask; pe->PredFlags |= InUsePredFlag;
} else { } else {
pe->StateOfPred &= ~InUseMask; pe->PredFlags &= ~InUsePredFlag;
} }
WRITE_UNLOCK(pe->PRWLock); WRITE_UNLOCK(pe->PRWLock);
} }
@ -2116,12 +2117,21 @@ p_toggle_static_predicates_in_use(void)
static Int static Int
code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) { code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
yamop *clcode; yamop *clcode;
Clause *cl;
int i = 1; int i = 1;
READ_LOCK(pp->PRWLock); READ_LOCK(pp->PRWLock);
clcode = pp->cs.p_code.FirstClause; clcode = pp->cs.p_code.FirstClause;
if (clcode != NIL) { if (clcode != NULL) {
char *code_end;
if (pp->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = ClauseCodeToLogUpdClause(pp->cs.p_code.TrueCodeOfPred);
code_end = (char *)cl + Yap_SizeOfBlock((CODEADDR)cl);
} else if (!(pp->PredFlags & DynamicPredFlag)) {
code_end = NULL;
} else {
StaticClause *cl = ClauseCodeToStaticClause(pp->cs.p_code.TrueCodeOfPred);
code_end = (char *)cl + Yap_SizeOfBlock((CODEADDR)cl);
}
/* 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) &&
IN_BLOCK(codeptr,pp->cs.p_code.TrueCodeOfPred,Yap_SizeOfBlock((CODEADDR)(pp->cs.p_code.TrueCodeOfPred)))) { IN_BLOCK(codeptr,pp->cs.p_code.TrueCodeOfPred,Yap_SizeOfBlock((CODEADDR)(pp->cs.p_code.TrueCodeOfPred)))) {
@ -2134,8 +2144,16 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
READ_UNLOCK(pp->PRWLock); READ_UNLOCK(pp->PRWLock);
return(-1); return(-1);
} }
cl = ClauseCodeToClause(clcode);
do { do {
CODEADDR cl;
if (pp->PredFlags & LogUpdatePredFlag) {
cl = (CODEADDR)ClauseCodeToLogUpdClause(clcode);
} else if (!(pp->PredFlags & DynamicPredFlag)) {
cl = (CODEADDR)ClauseCodeToDynamicClause(clcode);
} else {
cl = (CODEADDR)ClauseCodeToStaticClause(clcode);
}
if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) { if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) {
/* we found it */ /* we found it */
*parity = pp->ArityOfPE; *parity = pp->ArityOfPE;
@ -2149,8 +2167,8 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
} }
if (clcode == pp->cs.p_code.LastClause) if (clcode == pp->cs.p_code.LastClause)
break; break;
cl = ClauseCodeToClause(clcode = NextClause(clcode));
i++; i++;
clcode = NextClause(clcode);
} while (TRUE); } while (TRUE);
} }
READ_UNLOCK(pp->PRWLock); READ_UNLOCK(pp->PRWLock);
@ -2381,7 +2399,7 @@ p_clean_up_dead_clauses(void)
{ {
while (DeadClauses != NULL) { while (DeadClauses != NULL) {
char *pt = (char *)DeadClauses; char *pt = (char *)DeadClauses;
DeadClauses = DeadClauses->u.NextCl; DeadClauses = DeadClauses->NextCl;
Yap_FreeCodeSpace(pt); Yap_FreeCodeSpace(pt);
} }
return(TRUE); return(TRUE);

70
C/compiler.c
View File

@ -36,9 +36,7 @@ STATIC_PROTO(void c_eq, (Term, Term));
STATIC_PROTO(void c_test, (Int, Term)); STATIC_PROTO(void c_test, (Int, Term));
STATIC_PROTO(void c_bifun, (Int, Term, Term, Term, int)); STATIC_PROTO(void c_bifun, (Int, Term, Term, Term, int));
STATIC_PROTO(void c_goal, (Term, int)); STATIC_PROTO(void c_goal, (Term, int));
STATIC_PROTO(void get_type_info, (Term));
STATIC_PROTO(void c_body, (Term, int)); STATIC_PROTO(void c_body, (Term, int));
STATIC_PROTO(void get_cl_info, (Term));
STATIC_PROTO(void c_head, (Term)); STATIC_PROTO(void c_head, (Term));
STATIC_PROTO(int usesvar, (int)); STATIC_PROTO(int usesvar, (int));
STATIC_PROTO(CELL *init_bvarray, (int)); STATIC_PROTO(CELL *init_bvarray, (int));
@ -1678,42 +1676,12 @@ c_goal(Term Goal, int mod)
} }
} }
static void
get_type_info(Term Goal)
{
if (IsNonVarTerm(Goal) && IsApplTerm(Goal)) {
if (clause_mask == VarCl &&
ArgOfTerm(1, Goal) == (Term) clause_store) {
if (FunctorOfTerm(Goal) == FunctorGVar)
clause_mask |= FIsVar;
else if (FunctorOfTerm(Goal) == FunctorGAtom)
clause_mask |= AtCl | FIsAtom;
else if (FunctorOfTerm(Goal) == FunctorGInteger)
clause_mask |= AtCl | FIsNum;
/*
* vsc: with the new scheme floats are structs, so
* the simple index switch cannot differentiate them
* from structs:
* else if (FunctorOfTerm(Goal) == FunctorGAtomic ||
* FunctorOfTerm(Goal) == FunctorGPrimitive)
* clause_mask |= AtCl|FIsNum;
*/
}
}
}
static void static void
c_body(Term Body, int mod) c_body(Term Body, int mod)
{ {
onhead = FALSE; onhead = FALSE;
BodyStart = cpc; BodyStart = cpc;
goalno = 1; goalno = 1;
if (IsNonVarTerm(Body) && IsApplTerm(Body)) {
if (FunctorOfTerm(Body) == FunctorComma)
get_type_info(ArgOfTerm(1, Body));
else
get_type_info(Body);
}
while (IsNonVarTerm(Body) && IsApplTerm(Body) while (IsNonVarTerm(Body) && IsApplTerm(Body)
&& FunctorOfTerm(Body) == FunctorComma) { && FunctorOfTerm(Body) == FunctorComma) {
Term t2 = ArgOfTerm(2, Body); Term t2 = ArgOfTerm(2, Body);
@ -1731,42 +1699,6 @@ c_body(Term Body, int mod)
c_goal(Body, mod); c_goal(Body, mod);
} }
static void
get_cl_info(register Term t)
{
if (IsVarTerm(t)) {
clause_mask = VarCl;
clause_store = (CELL) t;
}
else if (IsPairTerm(t)) {
clause_mask = ListCl;
t = HeadOfTerm(t);
if (IsVarTerm(t))
clause_mask |= FHeadVar;
else if (IsPairTerm(t))
clause_mask |= FHeadList;
else if (IsApplTerm(t)) {
clause_store = (CELL) FunctorOfTerm(t);
clause_mask |= FHeadAppl;
}
else {
clause_store = (CELL) t;
clause_mask |= FHeadCons;
}
}
else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (!IsExtensionFunctor(fun)) {
clause_mask = (CELL)ApplCl;
clause_store = (CELL)fun;
}
}
else {
clause_store = (CELL) t;
clause_mask = AtCl;
}
}
static void static void
c_head(Term t) c_head(Term t)
{ {
@ -1784,7 +1716,6 @@ c_head(Term t)
f = FunctorOfTerm(t); f = FunctorOfTerm(t);
Yap_emit(name_op, (CELL) NameOfFunctor(f), ArityOfFunctor(f)); Yap_emit(name_op, (CELL) NameOfFunctor(f), ArityOfFunctor(f));
c_args(t, 0); c_args(t, 0);
get_cl_info(ArgOfTerm(1, t));
} }
/* number of permanent variables in the clause */ /* number of permanent variables in the clause */
@ -2793,7 +2724,6 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod)
return (0); return (0);
} }
SaveH = H; SaveH = H;
clause_mask = 0;
or_found = 0; or_found = 0;
Yap_ErrorMessage = NULL; Yap_ErrorMessage = NULL;
/* initialize variables for code generation */ /* initialize variables for code generation */

167
C/computils.c
View File

@ -267,8 +267,50 @@ Yap_bip_name(Int op, char *s) {
#ifdef DEBUG #ifdef DEBUG
static void static void
ShowOp (f) write_address(CELL address)
char *f; {
if (address < (CELL)AtomBase) {
Yap_DebugPutc(Yap_c_error_stream,'L');
Yap_plwrite (MkIntTerm (address), Yap_DebugPutc, 0);
} else if (address == (CELL) FAILCODE) {
Yap_plwrite (MkAtomTerm (AtomFail), Yap_DebugPutc, 0);
} else {
char buf[32], *p = buf;
#if HAVE_SNPRINTF
snprintf(buf,32,"%x",address);
#else
snprintf(buf,"%x",address);
#endif
p[31] = '\0'; /* so that I don't have to worry */
Yap_DebugPutc(Yap_c_error_stream,'0');
Yap_DebugPutc(Yap_c_error_stream,'x');
while (*p != '\0') {
Yap_DebugPutc(Yap_c_error_stream,*p++);
}
}
}
static void
write_functor(Functor f)
{
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) {
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("DBRef")), Yap_DebugPutc, 0);
} else if (f == FunctorLongInt) {
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("LongInt")), Yap_DebugPutc, 0);
} else if (f == FunctorDouble) {
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("Double")), Yap_DebugPutc, 0);
}
} else {
Yap_plwrite(MkAtomTerm(NameOfFunctor (f)), Yap_DebugPutc, 0);
Yap_DebugPutc (Yap_c_error_stream,'/');
Yap_plwrite(MkIntTerm(ArityOfFunctor (f)), Yap_DebugPutc, 0);
}
}
static void
ShowOp (char *f)
{ {
char ch; char ch;
while ((ch = *f++) != 0) while ((ch = *f++) != 0)
@ -291,7 +333,7 @@ ShowOp (f)
} }
break; break;
case 'l': case 'l':
Yap_plwrite (MkIntTerm (arg), Yap_DebugPutc, 0); write_address (arg);
break; break;
case 'B': case 'B':
{ {
@ -367,19 +409,7 @@ ShowOp (f)
} }
break; break;
case 'f': case 'f':
if (IsExtensionFunctor((Functor)arg)) { write_functor((Functor)arg);
if ((Functor)arg == FunctorDBRef) {
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("DBRef")), Yap_DebugPutc, 0);
} else if ((Functor)arg == FunctorLongInt) {
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("LongInt")), Yap_DebugPutc, 0);
} else if ((Functor)arg == FunctorDouble) {
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("Double")), Yap_DebugPutc, 0);
}
} else {
Yap_plwrite(MkAtomTerm(NameOfFunctor ((Functor) arg)), Yap_DebugPutc, 0);
Yap_DebugPutc (Yap_c_error_stream,'/');
Yap_plwrite(MkIntTerm(ArityOfFunctor ((Functor) arg)), Yap_DebugPutc, 0);
}
break; break;
case 'r': case 'r':
Yap_DebugPutc (Yap_c_error_stream,'A'); Yap_DebugPutc (Yap_c_error_stream,'A');
@ -388,27 +418,14 @@ ShowOp (f)
case 'h': case 'h':
{ {
CELL my_arg = *cptr++; CELL my_arg = *cptr++;
if (my_arg & 1) write_address(my_arg);
Yap_plwrite (MkIntTerm (my_arg),
Yap_DebugPutc, 0);
else if (my_arg == (CELL) FAILCODE)
Yap_plwrite (MkAtomTerm (AtomFail), Yap_DebugPutc, 0);
else
Yap_plwrite (MkIntegerTerm ((Int) my_arg),
Yap_DebugPutc, 0);
} }
break; break;
case 'g': case 'g':
if (arg & 1) write_address(arg);
Yap_plwrite (MkIntTerm (arg),
Yap_DebugPutc, 0);
else if (arg == (CELL) FAILCODE)
Yap_plwrite (MkAtomTerm (AtomFail), Yap_DebugPutc, 0);
else
Yap_plwrite (MkIntegerTerm ((Int) arg), Yap_DebugPutc, 0);
break; break;
case 'i': case 'i':
Yap_plwrite (MkIntTerm (arg), Yap_DebugPutc, 0); write_address (arg);
break; break;
case 'j': case 'j':
{ {
@ -441,27 +458,19 @@ ShowOp (f)
case 'c': case 'c':
{ {
int i; int i;
for (i = 0; i < arg; ++i) for (i = 0; i < arg; ++i) {
{
CELL my_arg; CELL my_arg;
if (*cptr) Yap_DebugPutc(Yap_c_error_stream,'\t');
{ if (*cptr) {
Yap_plwrite ((Term) * cptr++, Yap_DebugPutc, 0); Yap_plwrite ((Term) * cptr++, Yap_DebugPutc, 0);
} } else {
else
{
Yap_plwrite (MkIntTerm (0), Yap_DebugPutc, 0); Yap_plwrite (MkIntTerm (0), Yap_DebugPutc, 0);
cptr++; cptr++;
} }
Yap_DebugPutc (Yap_c_error_stream,'\t'); Yap_DebugPutc (Yap_c_error_stream,'\t');
my_arg = *cptr++; my_arg = *cptr++;
if (my_arg & 1) write_address (my_arg);
Yap_plwrite (MkIntTerm (my_arg), if (i+1 < arg)
Yap_DebugPutc, 0);
else if (my_arg == (CELL) FAILCODE)
Yap_plwrite (MkAtomTerm (AtomFail), Yap_DebugPutc, 0);
else
Yap_plwrite (MkIntegerTerm ((Int) my_arg), Yap_DebugPutc, 0);
Yap_DebugPutc (Yap_c_error_stream,'\n'); Yap_DebugPutc (Yap_c_error_stream,'\n');
} }
} }
@ -469,29 +478,18 @@ ShowOp (f)
case 'e': case 'e':
{ {
int i; int i;
for (i = 0; i < arg; ++i) for (i = 0; i < arg; ++i) {
{ CELL my_arg = cptr[0], lbl = cptr[1];
CELL my_arg; Yap_DebugPutc(Yap_c_error_stream,'\t');
if (*cptr) if (my_arg) {
{ write_functor((Functor)my_arg);
Yap_plwrite (MkAtomTerm (NameOfFunctor ((Functor) * cptr)), Yap_DebugPutc, 0); } else {
Yap_DebugPutc (Yap_c_error_stream,'/');
Yap_plwrite (MkIntTerm (ArityOfFunctor ((Functor) * cptr++)), Yap_DebugPutc, 0);
}
else
{
Yap_plwrite(MkIntTerm (0), Yap_DebugPutc, 0); Yap_plwrite(MkIntTerm (0), Yap_DebugPutc, 0);
cptr++;
} }
Yap_DebugPutc(Yap_c_error_stream,'\t'); Yap_DebugPutc(Yap_c_error_stream,'\t');
my_arg = *cptr++; write_address(lbl);
if (my_arg & 1) cptr += 2;
Yap_plwrite (MkIntTerm (my_arg), if (i+1 < arg)
Yap_DebugPutc, 0);
else if (my_arg == (CELL) FAILCODE)
Yap_plwrite (MkAtomTerm (AtomFail), Yap_DebugPutc, 0);
else
Yap_plwrite (MkIntegerTerm ((Int) my_arg), Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,'\n'); Yap_DebugPutc(Yap_c_error_stream,'\n');
} }
} }
@ -554,6 +552,7 @@ static char *opformat[] =
"deallocate", "deallocate",
"try_me_else\t\t%l\t%x", "try_me_else\t\t%l\t%x",
"jump\t\t%l", "jump\t\t%l",
"jump\t\t%l",
"procceed", "procceed",
"call\t\t%p,%d,%z", "call\t\t%p,%d,%z",
"execute\t\t%p", "execute\t\t%p",
@ -576,42 +575,14 @@ static char *opformat[] =
"retry\t\t%g\t%x", "retry\t\t%g\t%x",
"trust\t\t%g\t%x", "trust\t\t%g\t%x",
"try_in\t\t%g\t%x", "try_in\t\t%g\t%x",
"retry_in\t\t%g\t%x",
"trust_in\t\t%g\t%x",
"try_first\t\t%g\t%x",
"retry_first\t\t%g\t%x",
"trust_first\t\t%g\t%x",
"try_first in\t\t%g\t%x",
"retry_first in\t\t%g\t%x",
"trust_first in\t\t%g\t%x",
"try_tail\t\t%g\t%x",
"retry_tail\t\t%g\t%x",
"trust_tail\t\t%g\t%x",
"try_tail_in\t\t%g\t%x",
"retry_tail_in\t\t%g\t%x",
"trust_tail_in\t\t%g\t%x",
"try_head\t\t%g\t%x",
"retry_head\t\t%g\t%x",
"trust_head\t\t%g\t%x",
"try_head_in\t\t%g\t%x",
"retry_head_in\t\t%g\t%x",
"trust_head_in\t\t%g\t%x",
"try_last_first\t\t%g\t%x",
"try_last_head\t\t%g\t%x",
"jump_if_var\t\t%g", "jump_if_var\t\t%g",
"cache_arg\t%r",
"cache_sub_arg\t%d",
"switch_on_type\t%h\t%h\t%h\t%h", "switch_on_type\t%h\t%h\t%h\t%h",
"switch_on_type_if_nonvar\t%h\t%h\t%h",
"switch_on_type_of_last\t%h\t%h\t%h",
"switch_on_type_of_head\t%h\t%h\t%h\t%h",
"switch_on_list_or_nil\t%h\t%h\t%h\t%h",
"switch_if_list_or_nil\t%h\t%h\t%h",
"switch_on_last_list_or_nil\t%h\t%h\t%h",
"switch_on_constant\t%i\n%c", "switch_on_constant\t%i\n%c",
"if_a_constant\t%i\t%h\n%c", "if_constant\t%i\t%h\n%c",
"go_if_ equals_constant\t%o\t%h\t%h",
"switch_on_functor\t%i\n%e", "switch_on_functor\t%i\n%e",
"if_a_functor\t%i\t%h\n%e", "if_functor\t%i\t%h\n%e",
"go_if_equals_functor\t%j\t%h\t%h",
"if_not_then\t%i\t%h\t%h\t%h", "if_not_then\t%i\t%h\t%h\t%h",
"save_pair\t%v", "save_pair\t%v",
"save_appl\t%v", "save_appl\t%v",

79
C/dbase.c
View File

@ -226,9 +226,9 @@ STATIC_PROTO(Int co_rdedp, (void));
STATIC_PROTO(Int p_first_instance, (void)); STATIC_PROTO(Int p_first_instance, (void));
STATIC_PROTO(void ErasePendingRefs, (DBRef)); STATIC_PROTO(void ErasePendingRefs, (DBRef));
STATIC_PROTO(void RemoveDBEntry, (DBRef)); STATIC_PROTO(void RemoveDBEntry, (DBRef));
STATIC_PROTO(void EraseLogUpdCl, (Clause *)); STATIC_PROTO(void EraseLogUpdCl, (LogUpdClause *));
STATIC_PROTO(void MyEraseClause, (Clause *)); STATIC_PROTO(void MyEraseClause, (DynamicClause *));
STATIC_PROTO(void PrepareToEraseClause, (Clause *, DBRef)); STATIC_PROTO(void PrepareToEraseClause, (DynamicClause *, DBRef));
STATIC_PROTO(void EraseEntry, (DBRef)); STATIC_PROTO(void EraseEntry, (DBRef));
STATIC_PROTO(Int p_erase, (void)); STATIC_PROTO(Int p_erase, (void));
STATIC_PROTO(Int p_eraseall, (void)); STATIC_PROTO(Int p_eraseall, (void));
@ -3584,7 +3584,7 @@ find_next_clause(DBRef ref0)
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)
{ {
Clause *cl = ClauseCodeToClause(newp); DynamicClause *cl = ClauseCodeToDynamicClause(newp);
LOCK(cl->ClLock); LOCK(cl->ClLock);
TRAIL_CLREF(cl); TRAIL_CLREF(cl);
@ -3594,7 +3594,7 @@ find_next_clause(DBRef ref0)
#else #else
if (!DynamicFlags(newp) & InUseMask) { if (!DynamicFlags(newp) & InUseMask) {
DynamicFlags(newp) |= InUseMask; DynamicFlags(newp) |= InUseMask;
TRAIL_CLREF(ClauseCodeToClause(newp)); TRAIL_CLREF(ClauseCodeToDynamicClause(newp));
} }
#endif #endif
return(newp); return(newp);
@ -3621,8 +3621,10 @@ p_jump_to_next_dynamic_clause(void)
} }
static void static void
EraseLogUpdCl(Clause *clau) EraseLogUpdCl(LogUpdClause *clau)
{ {
if (CL_IN_USE(clau))
return;
if (clau->ClFlags & IndexMask) { if (clau->ClFlags & IndexMask) {
Yap_RemoveLogUpdIndex(clau); Yap_RemoveLogUpdIndex(clau);
} else { } else {
@ -3636,7 +3638,7 @@ EraseLogUpdCl(Clause *clau)
} }
static void static void
MyEraseClause(Clause *clau) MyEraseClause(DynamicClause *clau)
{ {
DBRef ref; DBRef ref;
SMALLUNSGN clmask; SMALLUNSGN clmask;
@ -3644,10 +3646,6 @@ MyEraseClause(Clause *clau)
if (CL_IN_USE(clau)) if (CL_IN_USE(clau))
return; return;
clmask = clau->ClFlags; clmask = clau->ClFlags;
if (clmask & LogUpdMask) {
EraseLogUpdCl(clau);
return;
}
/* /*
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.
@ -3684,7 +3682,17 @@ MyEraseClause(Clause *clau)
lock on the current predicate lock on the current predicate
*/ */
void void
Yap_ErCl(Clause *clau) Yap_ErLogUpdCl(LogUpdClause *clau)
{
EraseLogUpdCl(clau);
}
/*
This predicate is supposed to be called with a
lock on the current predicate
*/
void
Yap_ErCl(DynamicClause *clau)
{ {
MyEraseClause(clau); MyEraseClause(clau);
} }
@ -3692,12 +3700,15 @@ Yap_ErCl(Clause *clau)
#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)
static void static void
PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr) PrepareToEraseLogUpdClause(LogUpdClause *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);
yamop *cl = code_p; yamop *cl = code_p;
if (clau->ClFlags & ErasedMask)
return;
clau->ClFlags |= ErasedMask;
WRITE_LOCK(p->PRWLock); WRITE_LOCK(p->PRWLock);
if (p->cs.p_code.FirstClause != cl) { if (p->cs.p_code.FirstClause != cl) {
/* we are not the first clause... */ /* we are not the first clause... */
@ -3720,7 +3731,6 @@ PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr)
if (p->PredFlags & IndexedPredFlag) { if (p->PredFlags & IndexedPredFlag) {
Yap_RemoveIndexation(p); Yap_RemoveIndexation(p);
} else { } else {
if (!(clau->ClFlags & InUseMask))
EraseLogUpdCl(clau); EraseLogUpdCl(clau);
} }
if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) { if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) {
@ -3731,11 +3741,9 @@ PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr)
if (p->PredFlags & SpiedPredFlag) { if (p->PredFlags & SpiedPredFlag) {
p->OpcodeOfPred = Yap_opcode(_spy_pred); p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
p->StateOfPred = StaticMask | SpiedMask;
} else { } else {
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred; p->CodeOfPred = p->cs.p_code.TrueCodeOfPred;
p->OpcodeOfPred = p->cs.p_code.TrueCodeOfPred->opc; p->OpcodeOfPred = p->cs.p_code.TrueCodeOfPred->opc;
p->StateOfPred = StaticMask;
} }
} else { } else {
p->OpcodeOfPred = FAIL_OPCODE; p->OpcodeOfPred = FAIL_OPCODE;
@ -3750,11 +3758,12 @@ PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr)
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} }
} }
p->cs.p_code.NOfClauses--;
WRITE_UNLOCK(p->PRWLock); WRITE_UNLOCK(p->PRWLock);
} }
static void static void
PrepareToEraseClause(Clause *clau, DBRef dbr) PrepareToEraseClause(DynamicClause *clau, DBRef dbr)
{ {
yamop *code_p; yamop *code_p;
@ -3762,10 +3771,6 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
if (clau->ClFlags & ErasedMask) if (clau->ClFlags & ErasedMask)
return; return;
clau->ClFlags |= ErasedMask; clau->ClFlags |= ErasedMask;
if (clau->ClFlags & LogUpdMask) {
PrepareToEraseLogUpdClause(clau, dbr);
return;
}
/* skip mask */ /* skip mask */
code_p = clau->ClCode; code_p = clau->ClCode;
/* skip retry instruction */ /* skip retry instruction */
@ -3777,17 +3782,17 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
/* first we get the next clause */ /* first we get the next clause */
yamop *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 */
yamop *previous = clau->u.ClPrevious; yamop *previous = clau->ClPrevious;
yamop *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) {
yamop *previous_code = (yamop *)previous; yamop *previous_code = (yamop *)previous;
Clause *next_cl = ClauseCodeToClause(next); DynamicClause *next_cl = ClauseCodeToDynamicClause(next);
/* we do, let's say the previous now backtracks to the next */ /* we do, let's say the previous now backtracks to the next */
previous_code->u.ld.d = next; previous_code->u.ld.d = next;
/* and tell next who it is the previous element */ /* and tell next who it is the previous element */
next_cl->u.ClPrevious = previous_code; next_cl->ClPrevious = previous_code;
} }
/* that's it about setting up the code, now let's tell the /* that's it about setting up the code, now let's tell the
predicate entry that a clause left. */ predicate entry that a clause left. */
@ -3817,7 +3822,7 @@ 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 *) ClauseCodeToDynamicClause(pred->CodeOfPred)));
pred->cs.p_code.LastClause = pred->cs.p_code.FirstClause = NULL; pred->cs.p_code.LastClause = pred->cs.p_code.FirstClause = NULL;
pred->OpcodeOfPred = FAIL_OPCODE; pred->OpcodeOfPred = FAIL_OPCODE;
pred->cs.p_code.TrueCodeOfPred = pred->CodeOfPred = pred->cs.p_code.TrueCodeOfPred = pred->CodeOfPred =
@ -3827,6 +3832,7 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
} else if (clau_code == pred->cs.p_code.LastClause) { } else if (clau_code == pred->cs.p_code.LastClause) {
pred->cs.p_code.LastClause = previous; pred->cs.p_code.LastClause = previous;
} }
pred->cs.p_code.NOfClauses--;
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 */
@ -3845,7 +3851,21 @@ ErDBE(DBRef entryref)
{ {
if ((entryref->Flags & DBCode) && entryref->Code) { if ((entryref->Flags & DBCode) && entryref->Code) {
Clause *clau = ClauseCodeToClause(entryref->Code); if (entryref->Flags & LogUpdMask) {
LogUpdClause *clau = ClauseCodeToLogUpdClause(entryref->Code);
LOCK(clau->ClLock);
if (CL_IN_USE(clau) || entryref->NOfRefsTo != 0) {
PrepareToEraseLogUpdClause(clau, entryref);
UNLOCK(clau->ClLock);
} else {
if (!(clau->ClFlags & ErasedMask))
PrepareToEraseLogUpdClause(clau, entryref);
UNLOCK(clau->ClLock);
/* the clause must have left the chain */
EraseLogUpdCl(clau);
}
} else {
DynamicClause *clau = ClauseCodeToDynamicClause(entryref->Code);
LOCK(clau->ClLock); LOCK(clau->ClLock);
if (CL_IN_USE(clau) || entryref->NOfRefsTo != 0) { if (CL_IN_USE(clau) || entryref->NOfRefsTo != 0) {
PrepareToEraseClause(clau, entryref); PrepareToEraseClause(clau, entryref);
@ -3857,6 +3877,7 @@ ErDBE(DBRef entryref)
/* the clause must have left the chain */ /* the clause must have left the chain */
MyEraseClause(clau); MyEraseClause(clau);
} }
}
} else if (!(DBREF_IN_USE(entryref))) { } else if (!(DBREF_IN_USE(entryref))) {
if (entryref->NOfRefsTo == 0) if (entryref->NOfRefsTo == 0)
RemoveDBEntry(entryref); RemoveDBEntry(entryref);
@ -3908,7 +3929,11 @@ EraseEntry(DBRef entryref)
if (!DBREF_IN_USE(entryref)) { if (!DBREF_IN_USE(entryref)) {
ErDBE(entryref); ErDBE(entryref);
} else if ((entryref->Flags & DBCode) && entryref->Code) { } else if ((entryref->Flags & DBCode) && entryref->Code) {
PrepareToEraseClause(ClauseCodeToClause(entryref->Code), entryref); if (p->KindOfPE & LogUpdDBBit) {
PrepareToEraseLogUpdClause(ClauseCodeToLogUpdClause(entryref->Code), entryref);
} else {
PrepareToEraseClause(ClauseCodeToDynamicClause(entryref->Code), entryref);
}
} }
} }

12
C/exec.c
View File

@ -143,16 +143,16 @@ CallClause(PredEntry *pen, Int position)
CLAUSECODE->arity = pen->ArityOfPE; CLAUSECODE->arity = pen->ArityOfPE;
CLAUSECODE->func = pen->FunctorOfPred; CLAUSECODE->func = pen->FunctorOfPred;
while (position > 1) { while (position > 1) {
while (ClauseCodeToClause(q)->ClFlags & ErasedMask) while (ClauseCodeToDynamicClause(q)->ClFlags & ErasedMask)
q = NextClause(q); q = NextClause(q);
position--; position--;
q = NextClause(q); q = NextClause(q);
} }
while (ClauseCodeToClause(q)->ClFlags & ErasedMask) while (ClauseCodeToDynamicClause(q)->ClFlags & ErasedMask)
q = NextClause(q); q = NextClause(q);
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
{ {
Clause *cl = ClauseCodeToClause(q); DynamicClause *cl = ClauseCodeToDynamicClause(q);
LOCK(cl->ClLock); LOCK(cl->ClLock);
TRAIL_CLREF(cl); TRAIL_CLREF(cl);
@ -160,9 +160,9 @@ CallClause(PredEntry *pen, Int position)
UNLOCK(cl->ClLock); UNLOCK(cl->ClLock);
} }
#else #else
if (!(ClauseCodeToClause(q)->ClFlags & InUseMask)) { if (!(ClauseCodeToDynamicClause(q)->ClFlags & InUseMask)) {
CELL *opp = &(ClauseCodeToClause(q)->ClFlags); CELL *opp = &(ClauseCodeToDynamicClause(q)->ClFlags);
TRAIL_CLREF(ClauseCodeToClause(q)); TRAIL_CLREF(ClauseCodeToDynamicClause(q));
*opp |= InUseMask; *opp |= InUseMask;
} }
#endif #endif

179
C/heapgc.c
View File

@ -62,8 +62,6 @@ STATIC_PROTO(void push_registers, (Int, yamop *));
STATIC_PROTO(void marking_phase, (tr_fr_ptr, CELL *, yamop *, CELL *)); STATIC_PROTO(void marking_phase, (tr_fr_ptr, CELL *, yamop *, CELL *));
STATIC_PROTO(void compaction_phase, (tr_fr_ptr, CELL *, yamop *, CELL *)); STATIC_PROTO(void compaction_phase, (tr_fr_ptr, CELL *, yamop *, CELL *));
STATIC_PROTO(void pop_registers, (Int, yamop *)); STATIC_PROTO(void pop_registers, (Int, yamop *));
STATIC_PROTO(void store_ref_in_dbtable, (DBRef));
STATIC_PROTO(DBRef find_ref_in_dbtable, (DBRef));
STATIC_PROTO(void init_dbtable, (tr_fr_ptr)); STATIC_PROTO(void init_dbtable, (tr_fr_ptr));
STATIC_PROTO(void mark_db_fixed, (CELL *)); STATIC_PROTO(void mark_db_fixed, (CELL *));
STATIC_PROTO(void mark_regs, (tr_fr_ptr)); STATIC_PROTO(void mark_regs, (tr_fr_ptr));
@ -479,10 +477,18 @@ count_cells_marked(void)
/* straightforward binary tree scheme that, given a key, finds a /* straightforward binary tree scheme that, given a key, finds a
matching dbref */ matching dbref */
typedef enum {
db_entry,
cl_entry,
lcl_entry,
dcl_entry
} db_entry_type;
typedef struct db_entry { typedef struct db_entry {
DBRef val; CODEADDR val;
db_entry_type db_type;
struct db_entry *left; struct db_entry *left;
CELL *lim; CODEADDR lim;
struct db_entry *right; struct db_entry *right;
} *dbentry; } *dbentry;
@ -491,7 +497,7 @@ static dbentry db_vec, db_vec0;
/* init the table */ /* init the table */
static void static void
store_ref_in_dbtable(DBRef entry) store_in_dbtable(CODEADDR entry, db_entry_type db_type)
{ {
dbentry parent = db_vec0; dbentry parent = db_vec0;
dbentry new = db_vec; dbentry new = db_vec;
@ -499,7 +505,8 @@ store_ref_in_dbtable(DBRef entry)
if ((ADDR)new > Yap_TrailTop-1024) if ((ADDR)new > Yap_TrailTop-1024)
Yap_growtrail(64 * 1024L); Yap_growtrail(64 * 1024L);
new->val = entry; new->val = entry;
new->lim = (CELL *)((CODEADDR)entry+Yap_SizeOfBlock((CODEADDR)entry)); new->db_type = db_type;
new->lim = entry+Yap_SizeOfBlock((CODEADDR)entry);
new->left = new->right = NULL; new->left = new->right = NULL;
if (db_vec == db_vec0) { if (db_vec == db_vec0) {
db_vec++; db_vec++;
@ -525,51 +532,15 @@ store_ref_in_dbtable(DBRef entry)
} }
} }
/* init the table */
static void
store_cl_in_dbtable(Clause *cl)
{
dbentry parent = db_vec0;
dbentry new = db_vec;
if ((ADDR)new > Yap_TrailTop-1024)
Yap_growtrail(64 * 1024L);
new->val = (DBRef)cl;
new->lim = (CELL *)((CODEADDR)cl + Yap_SizeOfBlock((CODEADDR)cl));
new->left = new->right = NULL;
if (db_vec == db_vec0) {
db_vec++;
return;
}
db_vec++;
parent = db_vec0;
beg:
if ((DBRef)cl < parent->val) {
if (parent->right == NULL) {
parent->right = new;
} else {
parent = parent->right;
goto beg;
}
} else {
if (parent->left == NULL) {
parent->left = new;
} else {
parent = parent->left;
goto beg;
}
}
}
/* find an element in the dbentries table */ /* find an element in the dbentries table */
static DBRef static dbentry
find_ref_in_dbtable(DBRef entry) find_ref_in_dbtable(CODEADDR entry)
{ {
dbentry current = db_vec0; dbentry current = db_vec0;
while (current != NULL) { while (current != NULL) {
if (current->val < entry && current->lim > (CELL *)entry) { if (current->val < entry && current->lim > entry) {
return(current->val); return(current);
} }
if (entry < current->val) if (entry < current->val)
current = current->right; current = current->right;
@ -581,16 +552,30 @@ find_ref_in_dbtable(DBRef entry)
static void static void
mark_db_fixed(CELL *ptr) { mark_db_fixed(CELL *ptr) {
DBRef el; dbentry el;
el = find_ref_in_dbtable((DBRef)ptr); el = find_ref_in_dbtable((CODEADDR)ptr);
if (el != NULL) if (el != NULL) {
el->Flags |= GcFoundMask; switch (el->db_type) {
case db_entry:
((DBRef)(el->val))->Flags |= GcFoundMask;
break;
case cl_entry:
((DynamicClause *)(el->val))->ClFlags |= GcFoundMask;
break;
case lcl_entry:
((LogUpdClause *)(el->val))->ClFlags |= GcFoundMask;
break;
case dcl_entry:
((DeadClause *)(el->val))->ClFlags |= GcFoundMask;
break;
}
}
} }
static void static void
init_dbtable(tr_fr_ptr trail_ptr) { init_dbtable(tr_fr_ptr trail_ptr) {
Clause *cl = DeadClauses; DeadClause *cl = DeadClauses;
db_vec0 = db_vec = (dbentry)TR; db_vec0 = db_vec = (dbentry)TR;
while (trail_ptr > (tr_fr_ptr)Yap_TrailBase) { while (trail_ptr > (tr_fr_ptr)Yap_TrailBase) {
@ -603,7 +588,6 @@ init_dbtable(tr_fr_ptr trail_ptr) {
if (!IsVarTerm(trail_cell) && IsPairTerm(trail_cell)) { if (!IsVarTerm(trail_cell) && IsPairTerm(trail_cell)) {
CELL *pt0 = RepPair(trail_cell); CELL *pt0 = RepPair(trail_cell);
/* DB pointer */ /* DB pointer */
CODEADDR entry;
CELL flags; CELL flags;
#ifdef FROZEN_STACKS /* TRAIL */ #ifdef FROZEN_STACKS /* TRAIL */
@ -619,20 +603,21 @@ init_dbtable(tr_fr_ptr trail_ptr) {
} }
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
flags = Flags((CELL)pt0); flags = *pt0;
/* for the moment, if all references to the term in the stacks /* for the moment, if all references to the term in the stacks
are only pointers, reset the flag */ are only pointers, reset the flag */
entry = ((CODEADDR)pt0 - (CELL) &(((DBRef) NIL)->Flags));
if (FlagOn(DBClMask, flags)) { if (FlagOn(DBClMask, flags)) {
store_ref_in_dbtable((DBRef)entry); store_in_dbtable((CODEADDR)DBStructFlagsToDBStruct(pt0), db_entry);
} else if (flags & LogUpdMask) {
store_in_dbtable((CODEADDR)ClauseFlagsToLogUpdClause(pt0), lcl_entry);
} else { } else {
store_cl_in_dbtable((Clause *)entry); store_in_dbtable((CODEADDR)ClauseFlagsToDynamicClause(pt0), cl_entry);
} }
} }
} }
while (cl != NULL) { while (cl != NULL) {
store_cl_in_dbtable(cl); store_in_dbtable((CODEADDR)cl, dcl_entry);
cl = cl->u.NextCl; cl = cl->NextCl;
} }
if (db_vec == db_vec0) { if (db_vec == db_vec0) {
/* could not find any entries: probably using LOG UPD semantics */ /* could not find any entries: probably using LOG UPD semantics */
@ -1121,15 +1106,12 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
while (gc_ENV != NULL) { /* no more environments */ while (gc_ENV != NULL) { /* no more environments */
Int bmap = 0; Int bmap = 0;
int currv = 0; int currv = 0;
Clause *cl;
#ifdef DEBUG #ifdef DEBUG
if (size < 0 || size > 512) if (size < 0 || size > 512)
fprintf(Yap_stderr,"Oops, env size for %p is %ld\n", gc_ENV, (unsigned long int)size); fprintf(Yap_stderr,"Oops, env size for %p is %ld\n", gc_ENV, (unsigned long int)size);
#endif #endif
if ((cl = (Clause *)find_ref_in_dbtable((DBRef)gc_ENV[E_CP])) != NULL) { mark_db_fixed((CELL *)gc_ENV[E_CP]);
cl->ClFlags |= GcFoundMask;
}
/* for each saved variable */ /* for each saved variable */
if (size > EnvSizeInCells) { if (size > EnvSizeInCells) {
int tsize = size - EnvSizeInCells; int tsize = size - EnvSizeInCells;
@ -1435,14 +1417,10 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
op_numbers opnum; op_numbers opnum;
register OPCODE op; register OPCODE op;
yamop *rtp = gc_B->cp_ap; yamop *rtp = gc_B->cp_ap;
Clause *cl;
if ((cl = (Clause *)find_ref_in_dbtable((DBRef)rtp)) != NULL) { mark_db_fixed((CELL *)rtp);
cl->ClFlags |= GcFoundMask; mark_db_fixed((CELL *)(gc_B->cp_ap));
} mark_db_fixed((CELL *)(gc_B->cp_cp));
if ((cl = (Clause *)find_ref_in_dbtable((DBRef)(gc_B->cp_b))) != NULL) {
cl->ClFlags |= GcFoundMask;
}
#ifdef EASY_SHUNTING #ifdef EASY_SHUNTING
current_B = gc_B; current_B = gc_B;
prev_HB = HB; prev_HB = HB;
@ -1472,8 +1450,6 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _or_else: case _or_else:
case _or_last: case _or_last:
case _Nstop: case _Nstop:
case _switch_last:
case _switch_l_list:
case _retry_userc: case _retry_userc:
case _trust_logical_pred: case _trust_logical_pred:
case _retry_profiled: case _retry_profiled:
@ -1582,10 +1558,6 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
/* this is the last choice point, the work is done ;-) */ /* this is the last choice point, the work is done ;-) */
return; return;
} }
case _switch_last:
case _switch_l_list:
nargs = rtp->u.slll.s;
break;
case _retry_c: case _retry_c:
case _retry_userc: case _retry_userc:
if (gc_B->cp_ap == RETRY_C_RECORDED_CODE if (gc_B->cp_ap == RETRY_C_RECORDED_CODE
@ -1721,7 +1693,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _profiled_retry_and_mark: case _profiled_retry_and_mark:
case _count_retry_and_mark: case _count_retry_and_mark:
case _retry_and_mark: case _retry_and_mark:
ClauseCodeToClause(gc_B->cp_ap)->ClFlags |= GcFoundMask; ClauseCodeToDynamicClause(gc_B->cp_ap)->ClFlags |= GcFoundMask;
#ifdef DEBUG #ifdef DEBUG
case _retry_me: case _retry_me:
case _trust_me: case _trust_me:
@ -1740,19 +1712,14 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _retry_me4: case _retry_me4:
case _trust_me4: case _trust_me4:
case _retry: case _retry:
case _trust_in:
case _trust: case _trust:
case _retry_first:
case _trust_first_in:
case _trust_first:
case _retry_tail:
case _trust_tail_in:
case _trust_tail:
case _retry_head:
case _trust_head_in:
case _trust_head:
nargs = rtp->u.ld.s; nargs = rtp->u.ld.s;
break; break;
case _jump:
rtp = rtp->u.l.l;
op = rtp->opc;
opnum = Yap_op_from_opcode(op);
goto restart_cp;
default: default:
fprintf(Yap_stderr, "OOps in GC: Unexpected opcode: %d\n", opnum); fprintf(Yap_stderr, "OOps in GC: Unexpected opcode: %d\n", opnum);
nargs = 0; nargs = 0;
@ -1832,7 +1799,6 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
Int hp_entrs = 0, hp_erased = 0, hp_not_in_use = 0, Int hp_entrs = 0, hp_erased = 0, hp_not_in_use = 0,
hp_in_use_erased = 0, code_entries = 0; hp_in_use_erased = 0, code_entries = 0;
#endif #endif
Clause **cptr, *cl;
#ifndef FROZEN_STACKS #ifndef FROZEN_STACKS
/* /*
@ -1932,7 +1898,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
continue; continue;
} }
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
flags = Flags((CELL)pt0); flags = *pt0;
#ifdef DEBUG #ifdef DEBUG
hp_entrs++; hp_entrs++;
if (!FlagOn(GcFoundMask, flags)) { if (!FlagOn(GcFoundMask, flags)) {
@ -1958,7 +1924,23 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
Yap_ErDBE(dbr); Yap_ErDBE(dbr);
} }
} else { } else {
Clause *cl = ClauseFlagsToClause((CELL)pt0); if (flags & LogUpdMask) {
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt0);
int erase;
DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & ErasedMask)
#if defined(YAPOR) || defined(THREADS)
&& (cl->ref_count == 0)
#endif
;
if (erase) {
/* at this point,
no one is accessing the clause */
Yap_ErLogUpdCl(cl);
}
} else {
DynamicClause *cl = ClauseFlagsToDynamicClause(pt0);
int erase; int erase;
DEC_CLREF_COUNT(cl); DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask; cl->ClFlags &= ~InUseMask;
@ -1973,10 +1955,11 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
Yap_ErCl(cl); Yap_ErCl(cl);
} }
} }
}
RESET_VARIABLE(&TrailTerm(dest)); RESET_VARIABLE(&TrailTerm(dest));
discard_trail_entries++; discard_trail_entries++;
} else { } else {
Flags((CELL)pt0) = ResetFlag(GcFoundMask, flags); *pt0 = ResetFlag(GcFoundMask, flags);
} }
#if MULTI_ASSIGNMENT_VARIABLES #if MULTI_ASSIGNMENT_VARIABLES
} else { } else {
@ -2057,18 +2040,23 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
(unsigned long int)((OldHeapUsed-HeapUsed)/(OldHeapUsed/100)), (unsigned long int)((OldHeapUsed-HeapUsed)/(OldHeapUsed/100)),
(unsigned long int)OldHeapUsed); (unsigned long int)OldHeapUsed);
} }
{
DeadClause **cptr;
DeadClause *cl;
cptr = &(DeadClauses); cptr = &(DeadClauses);
cl = DeadClauses; cl = DeadClauses;
while (cl != NULL) { while (cl != NULL) {
if (!(cl->ClFlags & GcFoundMask)) { if (!(cl->ClFlags & GcFoundMask)) {
char *ocl = (char *)cl; char *ocl = (char *)cl;
cl = cl->u.NextCl; cl = cl->NextCl;
*cptr = cl; *cptr = cl;
Yap_FreeCodeSpace(ocl); Yap_FreeCodeSpace(ocl);
} else { } else {
cl->ClFlags &= ~GcFoundMask; cl->ClFlags &= ~GcFoundMask;
cptr = &(cl->u.NextCl); cptr = &(cl->NextCl);
cl = cl->u.NextCl; cl = cl->NextCl;
}
} }
} }
} }
@ -2235,6 +2223,11 @@ sweep_choicepoints(choiceptr gc_B)
op = rtp->opc; op = rtp->opc;
opnum = Yap_op_from_opcode(op); opnum = Yap_op_from_opcode(op);
goto restart_cp; goto restart_cp;
case _jump:
rtp = rtp->u.l.l;
op = rtp->opc;
opnum = Yap_op_from_opcode(op);
goto restart_cp;
#ifdef TABLING #ifdef TABLING
case _table_answer_resolution: case _table_answer_resolution:
{ {

3854
C/index.c
View File

File diff suppressed because it is too large Load Diff

36
C/init.c
View File

@ -446,10 +446,9 @@ Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, int flags)
{ {
Atom atom = Yap_LookupAtom(Name); Atom atom = Yap_LookupAtom(Name);
PredEntry *pe; PredEntry *pe;
yamop *p_code = ((Clause *)NULL)->ClCode; yamop *p_code = ((StaticClause *)NULL)->ClCode;
Clause *cl = (Clause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e)); StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e));
cl->u.ClValue = 0;
cl->ClFlags = 0; cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user"); cl->Owner = Yap_LookupAtom("user");
p_code = cl->ClCode; p_code = cl->ClCode;
@ -481,10 +480,9 @@ Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, int
{ {
Atom atom = Yap_LookupAtom(Name); Atom atom = Yap_LookupAtom(Name);
PredEntry *pe; PredEntry *pe;
yamop *p_code = ((Clause *)NULL)->ClCode; yamop *p_code = ((StaticClause *)NULL)->ClCode;
Clause *cl = (Clause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),lxx),e)); StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),lxx),e));
cl->u.ClValue = 0;
cl->ClFlags = 0; cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user"); cl->Owner = Yap_LookupAtom("user");
p_code = cl->ClCode; p_code = cl->ClCode;
@ -519,10 +517,9 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
pe->cs.f_code = def; pe->cs.f_code = def;
pe->ModuleOfPred = CurrentModule; pe->ModuleOfPred = CurrentModule;
if (def != NULL) { if (def != NULL) {
yamop *p_code = ((Clause *)NULL)->ClCode; yamop *p_code = ((StaticClause *)NULL)->ClCode;
Clause *cl = (Clause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e)); StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e));
cl->u.ClValue = 0;
cl->ClFlags = 0; cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user"); cl->Owner = Yap_LookupAtom("user");
p_code = cl->ClCode; p_code = cl->ClCode;
@ -587,18 +584,17 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity, unsigned int Extra, CPred
if (pe->cs.p_code.FirstClause != NIL) if (pe->cs.p_code.FirstClause != NIL)
CleanBack(pe, Start, Cont); CleanBack(pe, Start, Cont);
else { else {
Clause *cl; StaticClause *cl;
yamop *code = ((Clause *)NULL)->ClCode; yamop *code = ((StaticClause *)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 *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(code,lds),lds),e)); cl = (StaticClause *)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;
} }
cl->u.ClValue = 0;
cl->ClFlags = 0; cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user"); cl->Owner = Yap_LookupAtom("user");
code = cl->ClCode; code = cl->ClCode;
@ -710,7 +706,7 @@ InitCodes(void)
INIT_YAMOP_LTT(&(heap_regs->tableanswerresolutioncode), 0); INIT_YAMOP_LTT(&(heap_regs->tableanswerresolutioncode), 0);
#endif /* YAPOR */ #endif /* YAPOR */
#endif /* TABLING */ #endif /* TABLING */
heap_regs->failcode = Yap_opcode(_op_fail); heap_regs->failcode->opc = Yap_opcode(_op_fail);
heap_regs->failcode_1 = Yap_opcode(_op_fail); heap_regs->failcode_1 = Yap_opcode(_op_fail);
heap_regs->failcode_2 = Yap_opcode(_op_fail); heap_regs->failcode_2 = Yap_opcode(_op_fail);
heap_regs->failcode_3 = Yap_opcode(_op_fail); heap_regs->failcode_3 = Yap_opcode(_op_fail);
@ -721,17 +717,17 @@ 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.l2 = NULL; heap_regs->env_for_trustfail_code.l2 = NULL;
heap_regs->trustfailcode = Yap_opcode(_trust_fail); heap_regs->trustfailcode->opc = 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.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);
heap_regs->index_op = Yap_opcode(_index_pred); heap_regs->index_op = Yap_opcode(_index_pred);
heap_regs->fail_op = Yap_opcode(_op_fail); heap_regs->fail_op = Yap_opcode(_op_fail);
heap_regs->nocode.opc = Yap_opcode(_Nstop); heap_regs->nocode->opc = Yap_opcode(_Nstop);
((yamop *)(&heap_regs->rtrycode))->opc = Yap_opcode(_retry_and_mark); ((yamop *)(&heap_regs->rtrycode))->opc = Yap_opcode(_retry_and_mark);
((yamop *)(&heap_regs->rtrycode))->u.ld.s = 0; ((yamop *)(&heap_regs->rtrycode))->u.ld.s = 0;
@ -748,9 +744,9 @@ InitCodes(void)
heap_regs->n_of_threads = 1; heap_regs->n_of_threads = 1;
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 = NULL; 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;
INIT_RWLOCK(heap_regs->invisiblechain.AERWLock); INIT_RWLOCK(heap_regs->invisiblechain.AERWLock);

18
C/save.c
View File

@ -107,8 +107,8 @@ STATIC_PROTO(void restore_codes, (void));
STATIC_PROTO(void ConvDBList, (Term, char *,CELL)); 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, (yamop *, PredEntry *, int));
STATIC_PROTO(void CleanClauses, (yamop *, yamop *)); STATIC_PROTO(void CleanClauses, (yamop *, yamop *,PredEntry *));
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 *));
@ -1379,17 +1379,21 @@ UnmarkTrEntries(void)
if (IsVarTerm(entry)) { if (IsVarTerm(entry)) {
RESET_VARIABLE((CELL *)entry); RESET_VARIABLE((CELL *)entry);
} else if (IsPairTerm(entry)) { } else if (IsPairTerm(entry)) {
CODEADDR ent = CodeAddrAdjust((CODEADDR)RepPair(entry)); CELL *ent = CellPtoHeapAdjust(RepPair(entry));
register CELL flags; register CELL flags;
flags = Flags(ent); flags = *ent;
ResetFlag(InUseMask, flags); ResetFlag(InUseMask, flags);
Flags(ent) = flags; *ent = flags;
if (FlagOn(ErasedMask, flags)) { if (FlagOn(ErasedMask, flags)) {
if (FlagOn(DBClMask, flags)) { if (FlagOn(DBClMask, flags)) {
Yap_ErDBE((DBRef) (ent - (CELL) &(((DBRef) NIL)->Flags))); Yap_ErDBE(DBStructFlagsToDBStruct(ent));
} else { } else {
Yap_ErCl(ClauseFlagsToClause(ent)); if (flags & LogUpdMask) {
Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(ent));
} else {
Yap_ErCl(ClauseFlagsToDynamicClause(ent));
}
} }
} }
} }

3
C/tracer.c
View File

@ -111,9 +111,8 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* extern int gc_calls; */ /* extern int gc_calls; */
vsc_count++; vsc_count++;
/* return;*/
#ifdef COMMENTED #ifdef COMMENTED
if (vsc_count < 124840LL) return; return;
if (vsc_count == 124881LL) { if (vsc_count == 124881LL) {
printf("Here I go\n"); printf("Here I go\n");
} }

37
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.39 2003-03-20 15:10:16 vsc Exp $ * * version: $Id: Heap.h,v 1.40 2003-04-30 17:45:53 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* information that can be stored in Code Space */ /* information that can be stored in Code Space */
@ -58,7 +58,7 @@ typedef struct various_codes {
yamop tableanswerresolutioncode; yamop tableanswerresolutioncode;
#endif /* TABLING */ #endif /* TABLING */
yamop comma_code[5]; yamop comma_code[5];
OPCODE failcode; yamop failcode[1];
OPCODE failcode_1; OPCODE failcode_1;
OPCODE failcode_2; OPCODE failcode_2;
OPCODE failcode_3; OPCODE failcode_3;
@ -77,7 +77,7 @@ typedef struct various_codes {
struct pred_entry *p; struct pred_entry *p;
struct pred_entry *p0; struct pred_entry *p0;
} env_for_trustfail_code; /* sla */ } env_for_trustfail_code; /* sla */
OPCODE trustfailcode; yamop trustfailcode[1];
struct { struct {
OPCODE op; OPCODE op;
#ifdef YAPOR #ifdef YAPOR
@ -90,14 +90,14 @@ typedef struct various_codes {
struct pred_entry *p; struct pred_entry *p;
struct pred_entry *p0; struct pred_entry *p0;
} env_for_yes_code; /* sla */ } env_for_yes_code; /* sla */
yamop yescode; yamop yescode[1];
yamop nocode; yamop nocode[1];
yamop rtrycode; yamop rtrycode[1];
struct { struct {
OPREG arity; OPREG arity;
struct yami *clause; struct yami *clause;
Functor func; Functor func;
} clausecode; } clausecode[1];
union CONSULT_OBJ *consultsp; union CONSULT_OBJ *consultsp;
union CONSULT_OBJ *consultbase; union CONSULT_OBJ *consultbase;
union CONSULT_OBJ *consultlow; union CONSULT_OBJ *consultlow;
@ -127,7 +127,7 @@ typedef struct various_codes {
int compiler_compile_mode; int compiler_compile_mode;
struct pred_entry *compiler_current_pred; struct pred_entry *compiler_current_pred;
AtomHashEntry invisiblechain; AtomHashEntry invisiblechain;
OPCODE dummycode; OPCODE dummycode[1];
UInt maxdepth, maxlist; UInt maxdepth, maxlist;
int update_mode; int update_mode;
Atom atprompt; Atom atprompt;
@ -159,7 +159,7 @@ typedef struct various_codes {
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;
struct clause_struct *dead_clauses; struct dead_clause *dead_clauses;
int primitives_module; int primitives_module;
int user_module; int user_module;
Atom Atom
@ -314,8 +314,6 @@ typedef struct various_codes {
struct PSEUDO *compiler_CodeStart; struct PSEUDO *compiler_CodeStart;
struct PSEUDO *compiler_icpc; struct PSEUDO *compiler_icpc;
struct PSEUDO *compiler_BlobsStart; struct PSEUDO *compiler_BlobsStart;
int compiler_clause_mask;
CELL compiler_clause_store;
int *compiler_label_offset; int *compiler_label_offset;
UInt i_pred_arity; UInt i_pred_arity;
int compiler_profiling; int compiler_profiling;
@ -350,14 +348,13 @@ typedef struct various_codes {
#define ANSWER_RESOLUTION ((yamop *)&(heap_regs->tableanswerresolutioncode )) #define ANSWER_RESOLUTION ((yamop *)&(heap_regs->tableanswerresolutioncode ))
#endif /* TABLING */ #endif /* TABLING */
#define COMMA_CODE heap_regs->comma_code #define COMMA_CODE heap_regs->comma_code
#define FAILCODE ((CODEADDR)&(heap_regs->failcode )) #define FAILCODE heap_regs->failcode
#define FAILCODE ((CODEADDR)&(heap_regs->failcode )) #define TRUSTFAILCODE heap_regs->trustfailcode
#define TRUSTFAILCODE ((CODEADDR)&(heap_regs->trustfailcode )) #define YESCODE heap_regs->yescode
#define YESCODE (&(heap_regs->yescode )) #define NOCODE heap_regs->nocode
#define NOCODE (&(heap_regs->nocode )) #define RTRYCODE heap_regs->rtrycode
#define RTRYCODE (&(heap_regs->rtrycode )) #define DUMMYCODE heap_regs->dummycode
#define DUMMYCODE (&(heap_regs->dummycode )) #define CLAUSECODE heap_regs->clausecode
#define CLAUSECODE (&(heap_regs->clausecode ))
#define INVISIBLECHAIN heap_regs->invisiblechain #define INVISIBLECHAIN heap_regs->invisiblechain
#define max_depth heap_regs->maxdepth #define max_depth heap_regs->maxdepth
#define max_list heap_regs->maxlist #define max_list heap_regs->maxlist
@ -535,8 +532,6 @@ typedef struct various_codes {
#define CodeStart heap_regs->compiler_CodeStart #define CodeStart heap_regs->compiler_CodeStart
#define icpc heap_regs->compiler_icpc #define icpc heap_regs->compiler_icpc
#define BlobsStart heap_regs->compiler_BlobsStart #define BlobsStart heap_regs->compiler_BlobsStart
#define clause_mask heap_regs->compiler_clause_mask
#define clause_store heap_regs->compiler_clause_store
#define label_offset heap_regs->compiler_label_offset #define label_offset heap_regs->compiler_label_offset
#define IPredArity heap_regs->i_pred_arity #define IPredArity heap_regs->i_pred_arity
#define profiling heap_regs->compiler_profiling #define profiling heap_regs->compiler_profiling

24
H/YapOpcodes.h
View File

@ -140,29 +140,15 @@
OPCODE(cut_t ,e), OPCODE(cut_t ,e),
OPCODE(cut_e ,e), OPCODE(cut_e ,e),
OPCODE(try_clause ,ld), OPCODE(try_clause ,ld),
OPCODE(try_in ,l),
OPCODE(retry ,ld), OPCODE(retry ,ld),
OPCODE(trust_in ,ldl),
OPCODE(trust ,ld), OPCODE(trust ,ld),
OPCODE(retry_first ,ld), OPCODE(try_in ,l),
OPCODE(trust_first_in ,ldl),
OPCODE(trust_first ,ld),
OPCODE(retry_tail ,ld),
OPCODE(trust_tail_in ,ldl),
OPCODE(trust_tail ,ld),
OPCODE(retry_head ,ld),
OPCODE(trust_head_in ,ldl),
OPCODE(trust_head ,ld),
OPCODE(jump_if_var ,l), OPCODE(jump_if_var ,l),
OPCODE(switch_on_type ,llll),
OPCODE(switch_on_nonv ,lll),
OPCODE(switch_last ,slll),
OPCODE(switch_on_head ,llll),
OPCODE(switch_list_nl ,llll),
OPCODE(switch_list_nl_prefetch ,llll),
OPCODE(switch_nv_list ,lll),
OPCODE(switch_l_list ,slll),
OPCODE(switch_on_cons ,c), OPCODE(switch_on_cons ,c),
OPCODE(switch_on_type ,llll),
OPCODE(switch_list_nl ,ollll),
OPCODE(switch_on_arg_type ,xllll),
OPCODE(switch_on_sub_arg_type ,sllll),
OPCODE(go_on_cons ,cll), OPCODE(go_on_cons ,cll),
OPCODE(if_cons ,sl), OPCODE(if_cons ,sl),
OPCODE(switch_on_func ,s), OPCODE(switch_on_func ,s),

1
H/absmi.h
View File

@ -533,7 +533,6 @@ typedef CELL label;
#define pred_entry(X) ((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->StateOfPred)))) #define pred_entry(X) ((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->StateOfPred))))
#define pred_entry_from_code(X) ((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->CodeOfPred)))) #define pred_entry_from_code(X) ((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->CodeOfPred))))
#define PredFromDefCode(X) ((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->OpcodeOfPred)))) #define PredFromDefCode(X) ((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->OpcodeOfPred))))
#define Flags(X) pred_entry(X)->StateOfPred
#define PredCode(X) pred_entry(X)->CodeOfPred #define PredCode(X) pred_entry(X)->CodeOfPred
#define PredOpCode(X) pred_entry(X)->OpcodeOfPred #define PredOpCode(X) pred_entry(X)->OpcodeOfPred
#define TruePredCode(X) pred_entry(X)->TrueCodeOfPred #define TruePredCode(X) pred_entry(X)->TrueCodeOfPred

38
H/amidefs.h
View File

@ -142,6 +142,11 @@ typedef struct yami {
CODEADDR d; CODEADDR d;
CELL next; CELL next;
} d; } d;
struct {
CODEADDR d;
struct pred_entry *p;
CELL next;
} dp;
struct { struct {
Int ClTrail; Int ClTrail;
Int ClENV; Int ClENV;
@ -234,6 +239,22 @@ typedef struct yami {
struct yami *l4; struct yami *l4;
CELL next; CELL next;
} llll; } llll;
struct {
wamreg x;
struct yami *l1;
struct yami *l2;
struct yami *l3;
struct yami *l4;
CELL next;
} xllll;
struct {
COUNT s;
struct yami *l1;
struct yami *l2;
struct yami *l3;
struct yami *l4;
CELL next;
} sllll;
struct { struct {
struct pred_entry *p; struct pred_entry *p;
wamreg x1; wamreg x1;
@ -313,6 +334,11 @@ typedef struct yami {
COUNT s; COUNT s;
CELL next; CELL next;
} s; } s;
struct {
COUNT s;
struct pred_entry *p;
CELL next;
} sp;
struct { struct {
COUNT s; COUNT s;
CELL c; CELL c;
@ -431,6 +457,8 @@ typedef yamop yamopp;
#define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next))) #define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next)))
#define PREVOP(V,TYPE) ((yamop *)((CODEADDR)(V)-(CELL)NEXTOP((yamop *)NULL,TYPE)))
#if defined(TABLING) || defined(SBA) #if defined(TABLING) || defined(SBA)
typedef struct trail_frame { typedef struct trail_frame {
Term term; Term term;
@ -554,12 +582,12 @@ typedef struct choicept {
#endif #endif
#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 *)NULL,sla)))->u.sla.s)
#define ENV_ToP(cp) (((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NIL,sla)))->u.sla.sla_u.p) #define ENV_ToP(cp) (((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NULL,sla)))->u.sla.sla_u.p)
#define ENV_ToOp(cp) (((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NIL,sla)))->opc) #define ENV_ToOp(cp) (((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NULL,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.bmap) #define EnvBMap(p) (((yamop *)((CODEADDR)(p) - (CELL)NEXTOP((yamop *)NULL,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 *)NULL,sla)))->u.sla.p0)
/* access to instructions */ /* access to instructions */

107
H/clause.h
View File

@ -32,54 +32,13 @@ typedef union CONSULT_OBJ {
#define ASSEMBLING_CLAUSE 0 #define ASSEMBLING_CLAUSE 0
#define ASSEMBLING_INDEX 1 #define ASSEMBLING_INDEX 1
/* This information is put at the start of every clause */
#define VarCl 0x0000 /* The clause's first argument is a var */
#define ListCl 0x0001 /* The clause's first argument is a list */
#define ApplCl 0x0002 /* The clause's first argument is an Appl */
#define AtCl 0x0003 /* The clause's first argument is a const */
/* If the firs argument is a list, then we care about what
we have in its head */
#define FHeadVar 0x0000 /* The head of the first argument is a var */
#define FHeadList 0x0004 /* The head of the first argument is a list */
#define FHeadAppl 0x0008 /* The head of the first argument ia an Appl */
#define FHeadCons 0x000c /* The head of the first argument is a cons */
/* If the first argument is a variable, then it may be tipified later */
#define FIsVar 0x0010 /* ... :- var(X)... */
#define FIsAtom 0x0020 /* ... :- atom(X) .... */
#define FIsNum 0x0040 /* ... :- integer(X) ...
... :- number(X) ... */
#define FIsPrimi 0x0080 /* ... :- atomic(X) ...
... :- primitive(X) ... */
#define FirstArgOfClType(X) ((X) & 0x03 )
#define HeadOfClType(X) ( ((X) >> 2) & 0x03 )
#define KindOfArg(X) FirstArgOfClType(ClauseCodeToClause(X)->ClFlags)
#define KindOfListArg(X) HeadOfClType(ClauseCodeToClause(X)->ClFlags)
#define KindOfBipArg(X) ClauseCodeToClause(X)->ClFlags
#define NextClause(X) (((yamop *)X)->u.ld.d) #define NextClause(X) (((yamop *)X)->u.ld.d)
#define PredFirstClause 0 #define PredFirstClause 0
#define PredMiddleClause 1 #define PredMiddleClause 1
#define PredLastClause 2 #define PredLastClause 2
typedef struct clause_struct { typedef struct logic_upd_clause {
/* This info is used by the indexing algorithm and by the dynamic clauses.
It is either the value of the first arg for static clauses or a pointer
to the previous clause */
union {
CELL ClValue; /* indexable clause */
yamop *ClPrevious; /* immediate update clause */
CODEADDR ClInfo; /* indexing code for log. sem. */
yamop *ClVarChain; /* log. sem. indexing code */
struct clause_struct *NextCl; /* dead clause */
} u;
/* the actual owner of the clause */
Atom Owner;
/* A set of flags describing info on the clause */ /* A set of flags describing info on the clause */
CELL ClFlags; CELL ClFlags;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
@ -87,6 +46,10 @@ typedef struct clause_struct {
lockvar ClLock; lockvar ClLock;
UInt ref_count; UInt ref_count;
#endif #endif
union {
yamop *ClVarChain; /* indexing code for log. sem. */
} u;
/* extra clause information for logical update indices and facts */
union { union {
/* extra clause information for logical update semantics, rules with envs */ /* extra clause information for logical update semantics, rules with envs */
yamop *ClExt; yamop *ClExt;
@ -95,14 +58,58 @@ typedef struct clause_struct {
} u2; } u2;
/* The instructions, at least one of the form sl */ /* The instructions, at least one of the form sl */
yamop ClCode[MIN_ARRAY]; yamop ClCode[MIN_ARRAY];
} Clause; Atom Owner;
} LogUpdClause;
#define ClauseCodeToClause(p) ((Clause *)((CODEADDR)(p)-(CELL)(((Clause *)NULL)->ClCode))) typedef struct dynamic_clause {
#define ClauseFlagsToClause(p) ((Clause *)((CODEADDR)(p)-(CELL)(&(((Clause *)NULL)->ClFlags)))) /* A set of flags describing info on the clause */
CELL ClFlags;
#if defined(YAPOR) || defined(THREADS)
/* A lock for manipulating the clause */
lockvar ClLock;
UInt ref_count;
#endif
Atom Owner;
yamop *ClPrevious; /* immediate update clause */
/* The instructions, at least one of the form sl */
yamop ClCode[MIN_ARRAY];
} DynamicClause;
#define DynamicFlags(X) (ClauseCodeToClause(X)->ClFlags) typedef struct static_clause {
/* A set of flags describing info on the clause */
CELL ClFlags;
Atom Owner;
/* The instructions, at least one of the form sl */
yamop ClCode[MIN_ARRAY];
} StaticClause;
#define DynamicLock(X) (ClauseCodeToClause(X)->ClLock) typedef struct dead_clause {
CELL ClFlags;
struct dead_clause *NextCl; /* dead clause */
#if defined(YAPOR) || defined(THREADS)
/* A lock for manipulating the clause */
lockvar ClLock;
UInt ref_count;
#endif
} DeadClause;
typedef union clause_obj {
struct logic_upd_clause luc;
struct dynamic_clause ic;
struct static_clause sc;
} ClauseUnion;
#define ClauseCodeToDynamicClause(p) ((DynamicClause *)((CODEADDR)(p)-(CELL)(((DynamicClause *)NULL)->ClCode)))
#define ClauseCodeToStaticClause(p) ((StaticClause *)((CODEADDR)(p)-(CELL)(((StaticClause *)NULL)->ClCode)))
#define ClauseCodeToLogUpdClause(p) ((LogUpdClause *)((CODEADDR)(p)-(CELL)(((LogUpdClause *)NULL)->ClCode)))
#define ClauseFlagsToDynamicClause(p) ((DynamicClause *)(p))
#define ClauseFlagsToLogUpdClause(p) ((LogUpdClause *)(p))
#define ClauseFlagsToStaticClause(p) ((StaticClause *)(p))
#define DynamicFlags(X) (ClauseCodeToDynamicClause(X)->ClFlags)
#define DynamicLock(X) (ClauseCodeToDynamicClause(X)->ClLock)
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
#define INIT_CLREF_COUNT(X) (X)->ref_count = 0 #define INIT_CLREF_COUNT(X) (X)->ref_count = 0
@ -120,14 +127,16 @@ typedef struct clause_struct {
wamreg STD_PROTO(Yap_emit_x,(CELL)); wamreg STD_PROTO(Yap_emit_x,(CELL));
wamreg STD_PROTO(Yap_compile_cmp_flags,(PredEntry *)); wamreg STD_PROTO(Yap_compile_cmp_flags,(PredEntry *));
void STD_PROTO(Yap_InitComma,(void)); void STD_PROTO(Yap_InitComma,(void));
wamreg STD_PROTO(Yap_regnotoreg,(UInt));
/* cdmgr.c */ /* cdmgr.c */
void STD_PROTO(Yap_RemoveLogUpdIndex,(Clause *)); void STD_PROTO(Yap_RemoveLogUpdIndex,(LogUpdClause *));
void STD_PROTO(Yap_IPred,(PredEntry *)); void STD_PROTO(Yap_IPred,(PredEntry *));
void STD_PROTO(Yap_addclause,(Term,yamop *,int,int)); void STD_PROTO(Yap_addclause,(Term,yamop *,int,int));
/* dbase.c */ /* dbase.c */
void STD_PROTO(Yap_ErCl,(Clause *)); void STD_PROTO(Yap_ErCl,(DynamicClause *));
void STD_PROTO(Yap_ErLogUpdCl,(LogUpdClause *));
/* exec.c */ /* exec.c */
Term STD_PROTO(Yap_cp_as_integer,(choiceptr)); Term STD_PROTO(Yap_cp_as_integer,(choiceptr));

37
H/compile.h
View File

@ -65,6 +65,7 @@ typedef enum compiler_op {
deallocate_op, deallocate_op,
tryme_op, tryme_op,
jump_op, jump_op,
jumpi_op,
procceed_op, procceed_op,
call_op, call_op,
execute_op, execute_op,
@ -86,43 +87,15 @@ typedef enum compiler_op {
try_op, try_op,
retry_op, retry_op,
trust_op, trust_op,
tryin_op, try_in_op,
retryin_op,
trustin_op,
tryf_op,
retryf_op,
trustf_op,
tryfin_op,
retryfin_op,
trustfin_op,
tryt_op,
retryt_op,
trustt_op,
trytin_op,
retrytin_op,
trusttin_op,
tryh_op,
retryh_op,
trusth_op,
tryhin_op,
retryhin_op,
trusthin_op,
trylf_op,
trylh_op,
jump_v_op, jump_v_op,
switch_t_op, cache_arg_op,
switch_nv_op, cache_sub_arg_op,
switch_l_op, switch_on_type_op,
switch_h_op,
switch_lnl_op,
switch_nvl_op,
switch_ll_op,
switch_c_op, switch_c_op,
if_c_op, if_c_op,
go_c_op,
switch_f_op, switch_f_op,
if_f_op, if_f_op,
go_f_op,
if_not_op, if_not_op,
save_pair_op, save_pair_op,
save_appl_op, save_appl_op,

82
H/index.h
View File

@ -15,68 +15,70 @@
* * * *
*************************************************************************/ *************************************************************************/
/* Minimum number of clauses needed to build an hash table */ /* allowed types for clauses */
#define MinHashEntries 4 typedef enum clause_type_enum {
pair_clause = 0x01,
struct_clause = 0x02,
atom_clause = 0x04,
int_clause = 0x08,
flt_clause = 0x10,
lgint_clause = 0x20,
dbref_clause = 0x40
} clause_type;
/* Four types of Clauses */ /* Four types of Clauses */
#define NonVarCl(X) ((X) != VarCl) #define MaxOptions 4
#define MaxOptions (AtCl+1)
/* Some Flags */
#define LoneGroup 0x01 /* just a group */
#define FirstIndex 0x02 /* we are working over first arg */
#define HeadIndex 0x04 /* we are working over the head */
#define LastFoundList 0x08 /* informs first arg is a list */
#define LastGroup 0x10 /* this is the last group */
#define IsAtom 0x20 /* the last value is an atom */
#define IsStruct 0x40 /* the last value is a compound term */
/* Minimum number of clauses needed to build an hash table */
/* must be a power of two */
#define MIN_HASH_ENTRIES 4
#define HASH_SHIFT 6
/* Intermediate Data structures, /* Intermediate Data structures,
used to build the indexing code */ used to build the indexing code */
/* Used to store all important information about a clause */ /* Used to store all important information about a clause */
typedef struct StructClauseDef { typedef struct StructClauseDef {
int Kind; /* type of first argument */ Term Tag; /* if nonvar or nonlist, first argument */
Term Name; /* if nonvar or nonlist, first argument */
yamop *Code; /* start of code for clause */ yamop *Code; /* start of code for clause */
struct StructClauseDef *Next; /* next clause in chain */ yamop *CurrentCode; /* start of code for clause */
yamop *WorkPC; /* start of code for clause */
} ClauseDef; } ClauseDef;
/* Relevant information for groups */ /* Relevant information for groups */
typedef struct { typedef struct {
int Type[MaxOptions]; /* quantity of elements of each kind */ ClauseDef *FirstClause;
int NCl; /* total amount of clauses */ ClauseDef *LastClause;
int SInfo; /* special info about group */ UInt VarClauses;
int NofClausesAfter; /* number of clauses after the group */ UInt AtomClauses;
ClauseDef *Start; /* first clause of group */ UInt PairClauses;
yamop *First,*Last; /* first and last code of clauses in group */ UInt StructClauses;
UInt TestClauses;
} GroupDef; } GroupDef;
/* SInfo may be one of: */
#define OnlyNils 0x1
#define UsesBips 0x2
/* Different elements of the same kind in a group */ /* switch_on_cons */
typedef struct { typedef struct {
Term Class; /* description of element */ Term Tag;
CELL Code; /* code that deals with it */ UInt Label;
ClauseDef *First, *Last; /* first and last clause with that term */ } AtomSwiEntry;
} EntryDef;
#define IsVarClause(X) ( ClauseCodeToClause(X)->ClFlags & FIsVar ) /* switch_on_func */
typedef struct {
Functor Tag;
UInt Label;
} FuncSwiEntry;
#define TermOfCl(X) ( ClauseCodeToClause(X)->u.ClValue ) /* switch_on_type */
#define HeadOfList(X) ( ClauseCodeToClause(X)->u.ClValue ) typedef struct {
UInt PairEntry;
#define FinalGr(I) ((I) == NGroups - 1 && (I) != 0) UInt ConstEntry;
UInt FuncEntry;
/* UInt VarEntry;
* Number of clauses before you disable extended single optimisation. } TypeSwitch;
*/
#define CLAUSES_FOR_EXTENDED_SINGLE 16
#define MAX_REG_COPIES 32

153
H/rheap.h
View File

@ -53,7 +53,7 @@ restore_codes(void)
INIT_YAMOP_LTT(&(heap_regs->tableanswerresolutioncode), 0); INIT_YAMOP_LTT(&(heap_regs->tableanswerresolutioncode), 0);
#endif /* YAPOR */ #endif /* YAPOR */
#endif /* TABLING */ #endif /* TABLING */
heap_regs->failcode = Yap_opcode(_op_fail); heap_regs->failcode->opc = Yap_opcode(_op_fail);
heap_regs->failcode_1 = Yap_opcode(_op_fail); heap_regs->failcode_1 = Yap_opcode(_op_fail);
heap_regs->failcode_2 = Yap_opcode(_op_fail); heap_regs->failcode_2 = Yap_opcode(_op_fail);
heap_regs->failcode_3 = Yap_opcode(_op_fail); heap_regs->failcode_3 = Yap_opcode(_op_fail);
@ -62,19 +62,16 @@ restore_codes(void)
heap_regs->failcode_6 = Yap_opcode(_op_fail); heap_regs->failcode_6 = Yap_opcode(_op_fail);
heap_regs->env_for_trustfail_code.op = Yap_opcode(_call); heap_regs->env_for_trustfail_code.op = Yap_opcode(_call);
heap_regs->trustfailcode = Yap_opcode(_trust_fail); heap_regs->trustfailcode->opc = 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->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);
heap_regs->index_op = Yap_opcode(_index_pred); heap_regs->index_op = Yap_opcode(_index_pred);
heap_regs->fail_op = Yap_opcode(_op_fail); heap_regs->fail_op = Yap_opcode(_op_fail);
heap_regs->nocode.opc = Yap_opcode(_Nstop); heap_regs->nocode->opc = Yap_opcode(_Nstop);
#ifdef YAPOR #ifdef YAPOR
INIT_YAMOP_LTT(&(heap_regs->nocode), 1); INIT_YAMOP_LTT(&(heap_regs->nocode), 1);
#endif /* YAPOR */
#ifdef YAPOR
INIT_YAMOP_LTT(&(heap_regs->rtrycode), 1); INIT_YAMOP_LTT(&(heap_regs->rtrycode), 1);
#endif /* YAPOR */ #endif /* YAPOR */
((yamop *)(&heap_regs->rtrycode))->opc = Yap_opcode(_retry_and_mark); ((yamop *)(&heap_regs->rtrycode))->opc = Yap_opcode(_retry_and_mark);
@ -83,17 +80,17 @@ restore_codes(void)
PtoOpAdjust(((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 =
PtoOpAdjust(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);
} else { } else {
/* an atom */ /* an atom */
heap_regs->clausecode.func = heap_regs->clausecode->func =
(Functor)AtomAdjust((Atom)(heap_regs->clausecode.func)); (Functor)AtomAdjust((Atom)(heap_regs->clausecode->func));
} }
} }
/* restore consult stack. It consists of heap pointers, so it /* restore consult stack. It consists of heap pointers, so it
@ -131,7 +128,7 @@ restore_codes(void)
AddrAdjust((ADDR)heap_regs->char_conversion_table2); AddrAdjust((ADDR)heap_regs->char_conversion_table2);
} }
if (heap_regs->dead_clauses != NULL) { if (heap_regs->dead_clauses != NULL) {
heap_regs->dead_clauses = (Clause *) heap_regs->dead_clauses = (DeadClause *)
AddrAdjust((ADDR)(heap_regs->dead_clauses)); AddrAdjust((ADDR)(heap_regs->dead_clauses));
} }
heap_regs->retry_recorded_code = heap_regs->retry_recorded_code =
@ -562,38 +559,32 @@ RestoreBB(BlackBoardEntry *pp)
/* Restores a prolog clause, in its compiled form */ /* Restores a prolog clause, in its compiled form */
static void static void
RestoreClause(Clause *Cl, int mode) RestoreClause(yamop *pc, PredEntry *pp, int mode)
/* /*
* Cl points to the start of the code, IsolFlag tells if we have a single * Cl points to the start of the code, IsolFlag tells if we have a single
* clause for this predicate or not * clause for this predicate or not
*/ */
{ {
yamop *pc;
OPREG cl_type = FirstArgOfClType(Cl->ClFlags);
if (mode == ASSEMBLING_CLAUSE) { if (mode == ASSEMBLING_CLAUSE) {
if (cl_type == ApplCl || if (pp->PredFlags & DynamicPredFlag) {
(cl_type == ListCl && HeadOfClType(cl_type) == ApplCl)) { DynamicClause *cl = ClauseCodeToDynamicClause(pc);
#ifdef DEBUG_RESTORE2 if (cl->ClPrevious != NULL) {
YP_fprintf(errout, "at %p, appl: %lx -> %lx", Cl, Cl->u.ClValue, cl->ClPrevious = PtoOpAdjust(cl->ClPrevious);
(CELL)FuncAdjust((Functor)(Cl->u.ClValue))); }
#endif cl->Owner = AtomAdjust(cl->Owner);
Cl->u.ClValue = (CELL)FuncAdjust((Functor)(Cl->u.ClValue)); } else if (pp->PredFlags & LogUpdatePredFlag) {
} else if ((cl_type == AtCl || LogUpdClause *cl = ClauseCodeToLogUpdClause(pc);
(cl_type == ListCl && HeadOfClType(cl_type) == AtCl)) &&
IsAtomTerm(Cl->u.ClValue)) { if (cl->ClFlags & LogUpdRuleMask) {
#ifdef DEBUG_RESTORE2 cl->u2.ClExt = PtoOpAdjust(cl->u2.ClExt);
if (IsAtomTerm(Cl->u.ClValue)) }
YP_fprintf(errout, "at %p, atom: %lx -> %lx", Cl, Cl->u.ClValue, cl->Owner = AtomAdjust(cl->Owner);
AtomTermAdjust(Cl->u.ClValue)); } else {
#endif StaticClause *cl = ClauseCodeToStaticClause(pc);
Cl->u.ClValue = AtomTermAdjust(Cl->u.ClValue);
cl->Owner = AtomAdjust(cl->Owner);
} }
} }
/* TO DO: log update semantics */
/* Get the stored operator */
pc = Cl->ClCode;
do { do {
op_numbers op = Yap_op_from_opcode(pc->opc); op_numbers op = Yap_op_from_opcode(pc->opc);
pc->opc = Yap_opcode(op); pc->opc = Yap_opcode(op);
@ -638,12 +629,6 @@ RestoreClause(Clause *Cl, int mode)
case _try_clause: case _try_clause:
case _retry: case _retry:
case _trust: case _trust:
case _retry_first:
case _trust_first:
case _retry_tail:
case _trust_tail:
case _retry_head:
case _trust_head:
#ifdef YAPOR #ifdef YAPOR
case _getwork: case _getwork:
case _getwork_seq: case _getwork_seq:
@ -673,8 +658,8 @@ RestoreClause(Clause *Cl, int mode)
case _jump: case _jump:
case _move_back: case _move_back:
case _skip: case _skip:
case _try_in:
case _jump_if_var: case _jump_if_var:
case _try_in:
pc->u.l.l = PtoOpAdjust(pc->u.l.l); pc->u.l.l = PtoOpAdjust(pc->u.l.l);
pc = NEXTOP(pc,l); pc = NEXTOP(pc,l);
break; break;
@ -1035,35 +1020,41 @@ RestoreClause(Clause *Cl, int mode)
pc->u.lds.p = PtoPredAdjust(pc->u.lds.p); pc->u.lds.p = PtoPredAdjust(pc->u.lds.p);
pc = NEXTOP(pc,lds); pc = NEXTOP(pc,lds);
break; break;
/* instructions type ldl */
case _trust_in:
case _trust_first_in:
case _trust_tail_in:
case _trust_head_in:
pc->u.ldl.p = PtoPredAdjust(pc->u.ldl.p);
pc->u.ldl.d = PtoOpAdjust(pc->u.ldl.d);
pc->u.ldl.bl = PtoOpAdjust(pc->u.ldl.bl);
pc = NEXTOP(pc,ldl);
break;
/* instructions type llll */ /* instructions type llll */
case _switch_on_type: case _switch_on_type:
case _switch_list_nl:
case _switch_on_head:
pc->u.llll.l1 = PtoOpAdjust(pc->u.llll.l1); pc->u.llll.l1 = PtoOpAdjust(pc->u.llll.l1);
pc->u.llll.l2 = PtoOpAdjust(pc->u.llll.l2); pc->u.llll.l2 = PtoOpAdjust(pc->u.llll.l2);
pc->u.llll.l3 = PtoOpAdjust(pc->u.llll.l3); pc->u.llll.l3 = PtoOpAdjust(pc->u.llll.l3);
pc->u.llll.l4 = PtoOpAdjust(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 xllll */
case _switch_on_nonv: case _switch_list_nl:
case _switch_nv_list: pc->u.ollll.pop = Yap_opcode(Yap_op_from_opcode(pc->u.ollll.pop));
pc->u.lll.l1 = PtoOpAdjust(pc->u.lll.l1); pc->u.ollll.l1 = PtoOpAdjust(pc->u.llll.l1);
pc->u.lll.l2 = PtoOpAdjust(pc->u.lll.l2); pc->u.ollll.l2 = PtoOpAdjust(pc->u.llll.l2);
pc->u.lll.l3 = PtoOpAdjust(pc->u.lll.l3); pc->u.ollll.l3 = PtoOpAdjust(pc->u.llll.l3);
pc = NEXTOP(pc,lll); pc->u.ollll.l4 = PtoOpAdjust(pc->u.llll.l4);
pc = NEXTOP(pc,ollll);
break; break;
/* instructions type cll */ /* instructions type xllll */
case _switch_on_arg_type:
pc->u.xllll.x = XAdjust(pc->u.xllll.x);
pc->u.xllll.l1 = PtoOpAdjust(pc->u.xllll.l1);
pc->u.xllll.l2 = PtoOpAdjust(pc->u.xllll.l2);
pc->u.xllll.l3 = PtoOpAdjust(pc->u.xllll.l3);
pc->u.xllll.l4 = PtoOpAdjust(pc->u.xllll.l4);
pc = NEXTOP(pc,xllll);
break;
/* instructions type sllll */
case _switch_on_sub_arg_type:
pc->u.sllll.l1 = PtoOpAdjust(pc->u.sllll.l1);
pc->u.sllll.l2 = PtoOpAdjust(pc->u.sllll.l2);
pc->u.sllll.l3 = PtoOpAdjust(pc->u.sllll.l3);
pc->u.sllll.l4 = PtoOpAdjust(pc->u.sllll.l4);
pc = NEXTOP(pc,sllll);
break;
/* instructions type lll */
case _if_not_then: case _if_not_then:
{ {
Term t = pc->u.cll.c; Term t = pc->u.cll.c;
@ -1074,15 +1065,6 @@ RestoreClause(Clause *Cl, int mode)
pc->u.cll.l2 = PtoOpAdjust(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 */
case _switch_list_nl_prefetch:
pc->u.ollll.pop = Yap_opcode(Yap_op_from_opcode(pc->u.ollll.pop));
pc->u.ollll.l1 = PtoOpAdjust(pc->u.ollll.l1);
pc->u.ollll.l2 = PtoOpAdjust(pc->u.ollll.l2);
pc->u.ollll.l3 = PtoOpAdjust(pc->u.ollll.l3);
pc->u.ollll.l4 = PtoOpAdjust(pc->u.ollll.l4);
pc = NEXTOP(pc,ollll);
break;
/* switch_on_func */ /* switch_on_func */
case _switch_on_func: case _switch_on_func:
{ {
@ -1197,15 +1179,6 @@ RestoreClause(Clause *Cl, int mode)
pc = (yamop *)oldcode; pc = (yamop *)oldcode;
} }
break; break;
/* instructions type slll */
case _switch_last:
case _switch_l_list:
pc->u.slll.p = PtoPredAdjust(pc->u.slll.p);
pc->u.slll.l1 = PtoOpAdjust(pc->u.slll.l1);
pc->u.slll.l2 = PtoOpAdjust(pc->u.slll.l2);
pc->u.slll.l3 = PtoOpAdjust(pc->u.slll.l3);
pc = NEXTOP(pc,slll);
break;
/* instructions type xxx */ /* instructions type xxx */
case _p_plus_vv: case _p_plus_vv:
case _p_minus_vv: case _p_minus_vv:
@ -1344,11 +1317,11 @@ 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(yamop *First, yamop *Last) CleanClauses(yamop *First, yamop *Last, PredEntry *pp)
{ {
yamop *cl = First; yamop *cl = First;
do { do {
RestoreClause(ClauseCodeToClause(cl), ASSEMBLING_CLAUSE); RestoreClause(cl, pp, ASSEMBLING_CLAUSE);
if (cl == Last) return; if (cl == Last) return;
cl = NextClause(cl); cl = NextClause(cl);
} while (TRUE); } while (TRUE);
@ -1472,7 +1445,7 @@ CleanCode(PredEntry *pp)
/* assembly */ /* assembly */
if (pp->CodeOfPred) { if (pp->CodeOfPred) {
pp->CodeOfPred = PtoOpAdjust(pp->CodeOfPred); pp->CodeOfPred = PtoOpAdjust(pp->CodeOfPred);
CleanClauses(pp->CodeOfPred, pp->CodeOfPred); CleanClauses(pp->CodeOfPred, pp->CodeOfPred, pp);
} }
} else { } else {
yamop *FirstC, *LastC; yamop *FirstC, *LastC;
@ -1495,12 +1468,12 @@ CleanCode(PredEntry *pp)
#ifdef DEBUG_RESTORE2 #ifdef DEBUG_RESTORE2
YP_fprintf(errout, "at %lx Correcting clauses from %lx to %lx\n", *(OPCODE *) FirstC, FirstC, LastC); YP_fprintf(errout, "at %lx Correcting clauses from %lx to %lx\n", *(OPCODE *) FirstC, FirstC, LastC);
#endif #endif
CleanClauses(FirstC, LastC); CleanClauses(FirstC, LastC, pp);
if (flag & (DynamicPredFlag|IndexedPredFlag)) { if (flag & (DynamicPredFlag|IndexedPredFlag)) {
#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->cs.p_code.TrueCodeOfPred), ASSEMBLING_INDEX); RestoreClause(pp->cs.p_code.TrueCodeOfPred,pp, ASSEMBLING_INDEX);
} }
} }
/* we are pointing at ourselves */ /* we are pointing at ourselves */

8
m4/Yatom.h.m4
View File

@ -162,6 +162,7 @@ Inline(IsValProperty, PropFlags, int, flags, (flags == ValProperty) )
CodeOfPred holds the address of the correspondent C-function. CodeOfPred holds the address of the correspondent C-function.
*/ */
typedef enum { typedef enum {
InUsePredFlag = 0x4000000L, /* count calls to pred */
CountPredFlag = 0x2000000L, /* count calls to pred */ CountPredFlag = 0x2000000L, /* count calls to pred */
HiddenPredFlag = 0x1000000L, /* invisible predicate */ HiddenPredFlag = 0x1000000L, /* invisible predicate */
CArgsPredFlag = 0x800000L, /* SWI-like C-interface pred. */ CArgsPredFlag = 0x800000L, /* SWI-like C-interface pred. */
@ -214,6 +215,7 @@ typedef struct pred_entry {
struct yami *TrueCodeOfPred; /* code address */ struct yami *TrueCodeOfPred; /* code address */
struct yami *FirstClause; struct yami *FirstClause;
struct yami *LastClause; struct yami *LastClause;
UInt NOfClauses;
} p_code; } p_code;
CPredicate f_code; CPredicate f_code;
CmpPredicate d_code; CmpPredicate d_code;
@ -229,7 +231,6 @@ typedef struct pred_entry {
#endif /* TABLING */ #endif /* TABLING */
SMALLUNSGN ModuleOfPred; /* module for this definition */ SMALLUNSGN ModuleOfPred; /* module for this definition */
profile_data StatisticsForPred; /* enable profiling for predicate */ profile_data StatisticsForPred; /* enable profiling for predicate */
SMALLUNSGN StateOfPred; /* actual state of predicate */
} PredEntry; } PredEntry;
#define PEProp ((PropFlags)(0x0000)) #define PEProp ((PropFlags)(0x0000))
@ -255,8 +256,7 @@ typedef enum {
DBClMask = 0x0800, /* informs this is a data base structure */ DBClMask = 0x0800, /* informs this is a data base structure */
LogUpdRuleMask= 0x0400, /* informs the code is for a log upd rule with env */ LogUpdRuleMask= 0x0400, /* informs the code is for a log upd rule with env */
LogUpdMask = 0x0200, /* informs this is a logic update index. */ LogUpdMask = 0x0200, /* informs this is a logic update index. */
StaticMask = 0x0100, /* dealing with static predicates */ StaticMask = 0x0100 /* dealing with static predicates */
SpiedMask = 0x0080 /* this predicate is being spied */
/* other flags belong to DB */ /* other flags belong to DB */
} dbentry_flags; } dbentry_flags;
@ -289,7 +289,7 @@ typedef struct DB_STRUCT {
Term Contents[MIN_ARRAY]; /* stored term */ Term Contents[MIN_ARRAY]; /* stored term */
} DBStruct; } DBStruct;
#define DBStructFlagsToDBStruct(X) ((DBRef)((X) - (CELL) &(((DBRef) NIL)->Flags))) #define DBStructFlagsToDBStruct(X) ((DBRef)((char *)(X) - (CELL) &(((DBRef) NIL)->Flags)))
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
#define INIT_DBREF_COUNT(X) (X)->ref_count = 0 #define INIT_DBREF_COUNT(X) (X)->ref_count = 0

1
pl/arith.yap
View File

@ -352,7 +352,6 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
'$binary_op_as_integer'(gcd,16). '$binary_op_as_integer'(gcd,16).
'$binary_op_as_integer'(min,17). '$binary_op_as_integer'(min,17).
'$binary_op_as_integer'(max,18). '$binary_op_as_integer'(max,18).
'$binary_op_as_integer'(atan2,19).
%'$binary_op_as_integer'(gcdmult,28). %'$binary_op_as_integer'(gcdmult,28).
/* Arithmetics */ /* Arithmetics */

4
pl/boot.yap
View File

@ -265,11 +265,11 @@ repeat :- '$repeat'.
'$execute_command'(C,_,top) :- var(C), !, '$execute_command'(C,_,top) :- var(C), !,
'$do_error'(instantiation_error,meta_call(C)). '$do_error'(instantiation_error,meta_call(C)).
'$execute_command'(end_of_file,_,_).
'$execute_command'(C,_,top) :- number(C), !, '$execute_command'(C,_,top) :- number(C), !,
'$do_error'(type_error(callable,C),meta_call(C)). '$do_error'(type_error(callable,C),meta_call(C)).
'$execute_command'(R,_,top) :- db_reference(R), !, '$execute_command'(R,_,top) :- db_reference(R), !,
'$do_error'(type_error(callable,R),meta_call(R)). '$do_error'(type_error(callable,R),meta_call(R)).
'$execute_command'(end_of_file,_,_) :- !.
'$execute_command'((:-G),_,Option) :- !, '$execute_command'((:-G),_,Option) :- !,
'$current_module'(M), '$current_module'(M),
'$process_directive'(G, Option, M), '$process_directive'(G, Option, M),
@ -880,7 +880,7 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
'$csult'(V, _) :- var(V), !, '$csult'(V, _) :- var(V), !,
'$do_error'(instantiation_error,consult(V)). '$do_error'(instantiation_error,consult(V)).
'$csult'([], _) :- !. '$csult'([], _).
'$csult'([-F|L], M) :- !, '$reconsult'(M:F), '$csult'(L, M). '$csult'([-F|L], M) :- !, '$reconsult'(M:F), '$csult'(L, M).
'$csult'([F|L], M) :- '$consult'(M:F), '$csult'(L, M). '$csult'([F|L], M) :- '$consult'(M:F), '$csult'(L, M).