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

1197
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->ArityOfPE = fe->ArityOfFE;
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
p->cs.p_code.NOfClauses = 0;
p->PredFlags = 0L;
p->StateOfPred = 0;
p->OwnerFile = AtomNil;
p->OpcodeOfPred = UNDEF_OPCODE;
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->ArityOfPE = 0;
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
p->cs.p_code.NOfClauses = 0;
p->PredFlags = 0L;
p->StateOfPred = 0;
p->OwnerFile = AtomNil;
p->OpcodeOfPred = UNDEF_OPCODE;
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));

487
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_pl, (op_numbers,PredEntry *));
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_if, (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_either, (op_numbers, CELL, CELL));
#endif /* YAPOR */
STATIC_PROTO(void a_gl_in, (op_numbers));
STATIC_PROTO(void a_gl, (op_numbers));
STATIC_PROTO(void a_bfunc, (CELL));
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_uvar, (void));
STATIC_PROTO(void a_wvar, (void));
STATIC_PROTO(void do_pass, (void));
STATIC_PROTO(yamop *do_pass, (void));
#ifdef DEBUG_OPCODES
STATIC_PROTO(void DumpOpCodes, (void));
#endif
@ -144,6 +137,20 @@ static int c_type;
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
emit_y(Ventry *ve)
{
@ -336,7 +343,7 @@ static void
a_cl(op_numbers opcode)
{
if (pass_no) {
Clause *cl = (Clause *)code_addr;
LogUpdClause *cl = (LogUpdClause *)code_addr;
code_p->opc = emit_op(opcode);
code_p->u.l.l = code_addr;
cl->u.ClVarChain = (yamop *)(Unsigned(code_addr) + label_offset[1]);
@ -348,7 +355,7 @@ static void
a_cle(op_numbers opcode)
{
if (pass_no) {
Clause *cl = (Clause *)code_addr;
LogUpdClause *cl = (LogUpdClause *)code_addr;
code_p->opc = emit_op(opcode);
code_p->u.EC.ClTrail = 0;
@ -705,6 +712,17 @@ a_r(op_numbers opcode)
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
check_alloc(void)
{
@ -892,6 +910,16 @@ a_l(op_numbers opcode)
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
a_pl(op_numbers opcode, PredEntry *pred)
{
@ -988,96 +1016,86 @@ a_igl(op_numbers opcode)
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
a_4sw(op_numbers opcode)
{
CELL *seq_ptr;
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);
}
#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 (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) {
code_p->opc = emit_op(_switch_list_nl);
seq_ptr = cpc->arnds;
code_p->u.ollll.pop = ((yamop *)(seq_ptr[0]))->opc;
code_p->u.ollll.l1 = emit_ilabel(seq_ptr[0]);
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.l4 = emit_ilabel(seq_ptr[3]);
}
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);
} 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.l1 = emit_ilabel(seq_ptr[0]);
code_p->u.ollll.l2 = emit_ilabel(seq_ptr[1]);
code_p->u.ollll.l3 = emit_ilabel(seq_ptr[2]);
code_p->u.ollll.l4 = emit_ilabel(seq_ptr[3]);
}
GONEXT(ollll);
}
}
#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
a_hx(op_numbers opcode)
@ -1121,9 +1139,21 @@ a_go(op_numbers opcode)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.cll.c = emit_count(cpc->arnds[0]);
code_p->u.cll.l1 = emit_ilabel(cpc->arnds[1]);
code_p->u.cll.l2 = emit_ilabel(cpc->arnds[2]);
code_p->u.cll.c = emit_count(cpc->arnds[1]); /* tag */
code_p->u.cll.l1 = emit_ilabel(cpc->arnds[2]); /* success point */
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);
}
@ -1163,30 +1193,6 @@ a_try(op_numbers opcode, CELL lab, CELL opr)
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
#ifdef YAPOR
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);
#endif /* YAPOR */
static void
static yamop *
do_pass(void)
{
yamop *entry_code;
#ifdef YAPOR
#define EITHER_INST 50
yamop *entry_code;
yamop *either_inst[EITHER_INST];
int either_cont = 0;
#endif /* YAPOR */
int log_update;
#if defined(YAPOR) || defined(THREADS)
int dynamic;
#endif
int ystop_found = FALSE;
union clause_obj *cl_u;
alloc_found = dealloc_found = FALSE;
code_p = code_addr;
cl_u = (union clause_obj *)code_p;
cpc = CodeStart;
comit_lab = 0L;
/* Space while for the clause flags */
log_update = CurrentPred->PredFlags & LogUpdatePredFlag;
#if defined(YAPOR) || defined(THREADS)
dynamic = CurrentPred->PredFlags & DynamicPredFlag;
#endif
if (assembling != ASSEMBLING_INDEX) {
Clause *cl_p = (Clause *)code_p;
if (pass_no) {
cl_p->u.ClValue = clause_store;
cl_p->ClFlags = clause_mask;
if (log_update)
cl_p->ClFlags |= LogUpdMask;
if (clause_has_blobs) {
cl_p->ClFlags |= HasBlobsMask;
}
cl_p->u2.ClExt = NULL;
cl_p->Owner = Yap_ConsultingFile();
}
code_p = (yamop *)(cl_p->ClCode);
IPredArity = cpc->rnd2; /* number of args */
if (log_update) {
if (pass_no) {
cl_u->luc.ClFlags = LogUpdMask;
cl_u->luc.Owner = Yap_ConsultingFile();
if (clause_has_blobs) {
cl_u->luc.ClFlags |= HasBlobsMask;
}
cl_u->luc.u2.ClExt = NULL;
#if defined(YAPOR) || defined(THREADS)
if ((dynamic||log_update) && pass_no) {
INIT_LOCK(cl_p->ClLock);
INIT_CLREF_COUNT(cl_p);
}
INIT_LOCK(cl_u.luc->ClLock);
INIT_CLREF_COUNT(cl_u.luc);
#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;
#ifdef YAPOR
a_try(TRYOP(_try_me, _try_me0), 0, IPredArity, 1, 0);
#else
a_try(TRYOP(_try_me, _try_me0), 0, IPredArity);
#endif /* YAPOR */
} else {
Clause *cl_p = (Clause *)code_p;
if (pass_no) {
cl_p->u.ClValue = TermNil;
if (log_update) {
cl_p->u2.ClUse = 0;
cl_p->ClFlags = LogUpdatePredFlag|IndexedPredFlag|IndexMask;
} else {
cl_p->u2.ClExt = NULL;
cl_p->ClFlags = clause_mask|IndexMask;
if (log_update) {
if (pass_no) {
cl_u->luc.ClFlags = LogUpdatePredFlag|IndexedPredFlag|IndexMask;
cl_u->luc.u2.ClUse = 0;
}
cl_p->Owner = CurrentPred->OwnerFile;
code_p = cl_u->luc.ClCode;
} else {
if (pass_no) {
cl_u->sc.ClFlags = IndexMask;
}
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;
#endif
}
while (cpc) {
@ -2282,92 +2295,19 @@ do_pass(void)
a_cl(_trust_logical_pred);
a_gl(_trust);
break;
case tryin_op:
a_igl(_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);
case try_in_op:
a_il(_try_in);
break;
case jump_op:
a_l(_jump);
/* don't assemble jumps to next instruction */
if (cpc->nextInst == NULL ||
cpc->nextInst->op != label_op ||
cpc->rnd1 != cpc->nextInst->rnd1) {
a_l(_jump);
}
break;
case jumpi_op:
a_il(_jump);
break;
case restore_tmps_op:
a_l(_move_back);
@ -2460,34 +2400,18 @@ do_pass(void)
#endif /* YAPOR */
dealloc_found = FALSE;
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:
a_igl(_jump_if_var);
break;
case switch_t_op:
case switch_on_type_op:
a_4sw(_switch_on_type);
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:
a_hx(_switch_on_cons);
break;
@ -2495,19 +2419,21 @@ do_pass(void)
a_hx(_switch_on_func);
break;
case if_c_op:
a_if(_if_cons);
if (cpc->rnd1 == 1) {
a_go(_go_on_cons);
} else {
a_if(_if_cons);
}
break;
case if_f_op:
a_if(_if_func);
break;
case go_c_op:
a_go(_go_on_cons);
break;
case go_f_op:
a_go(_go_on_func);
if (cpc->rnd1 == 1) {
a_go(_go_on_func);
} else {
a_if(_if_func);
}
break;
case if_not_op:
a_go(_if_not_then);
a_ifnot(_if_not_then);
break;
case mark_initialised_pvars_op:
a_bmap();
@ -2576,6 +2502,7 @@ do_pass(void)
}
if (!ystop_found)
a_e(_Ystop);
return entry_code;
}
yamop *
@ -2587,6 +2514,7 @@ Yap_assemble(int mode)
* produces the final version of the code
*/
CELL size;
yamop *entry_code;
code_addr = NULL;
assembling = mode;
@ -2594,7 +2522,7 @@ Yap_assemble(int mode)
label_offset = (int *)freep;
pass_no = 0;
asm_error = FALSE;
do_pass();
entry_code = do_pass();
if (asm_error) {
Yap_Error_TYPE = SYSTEM_ERROR;
Yap_ErrorMessage = "internal assembler error";
@ -2604,7 +2532,7 @@ Yap_assemble(int mode)
YAPEnterCriticalSection();
{
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)
size = (CELL)code_p;
}
@ -2614,17 +2542,12 @@ Yap_assemble(int mode)
return NULL;
}
}
do_pass();
entry_code = do_pass();
YAPLeaveCriticalSection();
{
Clause *cl = (Clause *)code_addr; /* lcc, why? */
#ifdef LOW_PROF
PROFSIZE=code_p;
PROFSIZE=code_p;
#endif
return(cl->ClCode);
}
return entry_code;
}
void

3
C/arith2.c
View File

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

306
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 do_toggle_static_predicates_in_use, (int));
#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_compile, (void));
STATIC_PROTO(Int p_compile_dynamic, (void));
@ -107,7 +107,7 @@ static_in_use(PredEntry *p, int check_everything)
return (FALSE);
}
if (STATIC_PREDICATES_MARKED) {
return (p->StateOfPred & InUseMask);
return (p->PredFlags & InUsePredFlag);
} else {
/* This code does not work for YAPOR or THREADS!!!!!!!! */
return(search_for_static_predicate_in_use(p, check_everything));
@ -190,11 +190,9 @@ IPred(PredEntry *ap)
ap->PredFlags |= IndexedPredFlag;
}
if (ap->PredFlags & SpiedPredFlag) {
ap->StateOfPred = StaticMask | SpiedMask;
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else {
ap->StateOfPred = 0;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
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)))
static void
recover_log_upd_clause(Clause *cl)
recover_log_upd_clause(LogUpdClause *cl)
{
LOCK(cl->ClLock);
if (cl->ClFlags & LogUpdRuleMask) {
@ -226,7 +224,7 @@ recover_log_upd_clause(Clause *cl)
!(cl->ClFlags & InUseMask)
#endif
)
Yap_ErCl(cl);
Yap_ErLogUpdCl(cl);
} else {
if (--(cl->u2.ClUse) == 0 &&
(cl->ClFlags & ErasedMask) &&
@ -236,21 +234,21 @@ recover_log_upd_clause(Clause *cl)
!(cl->ClFlags & InUseMask)
#endif
)
Yap_ErCl(cl);
Yap_ErLogUpdCl(cl);
}
UNLOCK(cl->ClLock);
}
static Clause *
ClauseBodyToClause(yamop *addr)
static LogUpdClause *
ClauseBodyToLogUpdClause(yamop *addr)
{
addr = (yamop *)((CODEADDR)addr - (Int)NEXTOP((yamop *)NULL,ld));
return(ClauseCodeToClause(addr));
return(ClauseCodeToLogUpdClause(addr));
}
/* we already have a lock on the predicate */
static void
RemoveLogUpdIndex(Clause *cl)
RemoveLogUpdIndex(LogUpdClause *cl)
{
yamop *code_p;
OPCODE last = Yap_opcode(_trust_logical_pred);
@ -266,20 +264,21 @@ RemoveLogUpdIndex(Clause *cl)
code_p = cl->u.ClVarChain;
/* skip try_log_update */
GONEXT(l);
recover_log_upd_clause(ClauseBodyToClause(code_p->u.ld.d));
recover_log_upd_clause(ClauseBodyToLogUpdClause(code_p->u.ld.d));
GONEXT(ld);
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);
}
/* skip trust_log_update */
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);
}
void
Yap_RemoveLogUpdIndex(Clause *cl)
Yap_RemoveLogUpdIndex(LogUpdClause *cl)
{
RemoveLogUpdIndex(cl);
}
@ -298,12 +297,15 @@ RemoveIndexation(PredEntry *ap)
}
spied = ap->PredFlags & SpiedPredFlag;
if (ap->PredFlags & LogUpdatePredFlag)
RemoveLogUpdIndex(ClauseCodeToClause(ap->cs.p_code.TrueCodeOfPred));
RemoveLogUpdIndex(ClauseCodeToLogUpdClause(ap->cs.p_code.TrueCodeOfPred));
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)) {
/* This should never happen */
cl->u.NextCl = DeadClauses;
cl->ClFlags = 0;
cl->NextCl = DeadClauses;
DeadClauses = cl;
} else {
Yap_FreeCodeSpace((char *)cl);
@ -312,12 +314,10 @@ RemoveIndexation(PredEntry *ap)
if (First != ap->cs.p_code.LastClause)
ap->cs.p_code.TrueCodeOfPred = First;
ap->PredFlags ^= IndexedPredFlag;
if (First != NIL && spied) {
if (First != NULL && spied) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
ap->StateOfPred = StaticMask | SpiedMask;
} else {
ap->StateOfPred = StaticMask;
ap->OpcodeOfPred = ap->cs.p_code.TrueCodeOfPred->opc;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
}
@ -346,36 +346,55 @@ retract_all(PredEntry *p, int in_use)
{
yamop *q, *q1;
int multifile_pred = p->PredFlags & MultiFileFlag;
yamop *fclause = NIL, *lclause = NIL;
yamop *fclause = NULL, *lclause = NULL;
q = p->cs.p_code.FirstClause;
if (q != NIL) {
do {
Clause *cl;
q1 = q;
q = NextClause(q);
cl = ClauseCodeToClause(q1);
if (multifile_pred && cl->Owner != YapConsultingFile()) {
if (fclause == NIL) {
fclause = q1;
if (p->PredFlags & LogUpdatePredFlag) {
do {
LogUpdClause *cl;
q1 = q;
q = NextClause(q);
cl = ClauseCodeToLogUpdClause(q1);
if (multifile_pred && cl->Owner != YapConsultingFile()) {
if (fclause == NULL) {
fclause = q1;
} else {
yamop *clp = (yamop *)lclause;
clp->u.ld.d = q1;
}
lclause = q1;
} else {
yamop *clp = (yamop *)lclause;
clp->u.ld.d = q1;
Yap_ErLogUpdCl(cl);
}
lclause = q1;
} else {
if (p->PredFlags & LogUpdatePredFlag)
Yap_ErCl(cl);
else {
} 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;
} else {
yamop *clp = (yamop *)lclause;
clp->u.ld.d = q1;
}
lclause = q1;
} else {
if (cl->ClFlags & HasBlobsMask) {
cl->u.NextCl = DeadClauses;
DeadClauses = cl;
DeadClause *dcl = (DeadClause *)cl;
dcl->NextCl = DeadClauses;
dcl->ClFlags = 0;
DeadClauses = dcl;
} else {
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.LastClause = lclause;
@ -407,7 +426,6 @@ retract_all(PredEntry *p, int in_use)
}
}
if (p->PredFlags & SpiedPredFlag) {
p->StateOfPred |= StaticMask | SpiedMask;
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} 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.FirstClause = p->cs.p_code.LastClause = cp;
p->cs.p_code.NOfClauses = 1;
p->StatisticsForPred.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0;
p->StatisticsForPred.NOfRetries = 0;
@ -472,13 +491,8 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
PUT_YAMOP_SEQ((yamop *)cp);
#endif /* YAPOR */
if (spy_flag) {
p->StateOfPred |= StaticMask | SpiedMask;
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} else if (is_fast(p)) {
p->StateOfPred |= StaticMask;
} else {
p->StateOfPred |= StaticMask;
}
if (yap_flags[SOURCE_MODE_FLAG]) {
p->PredFlags |= SourcePredFlag;
@ -491,8 +505,8 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
static void
add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
{
yamop *ncp = ((Clause *)NIL)->ClCode;
Clause *cl;
yamop *ncp = ((DynamicClause *)NULL)->ClCode;
DynamicClause *cl;
if (p == PredGoalExpansion) {
PRED_GOAL_EXPANSION_ON = TRUE;
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,
* that is a try_mark to start the code and a fail to finish things up */
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) {
Yap_Error(SYSTEM_ERROR,TermNil,"Heap crashed against Stacks");
return;
}
cl->Owner = p->OwnerFile;
/* skip the first entry, this contains the back link and will always be
empty for this entry */
ncp = (yamop *)(((CELL *)ncp)+1);
/* next we have the flags. For this block mainly say whether we are
* being spied */
if (spy_flag) {
cl->ClFlags = DynamicMask | SpiedMask;
ncp = cl->ClCode;
}
else {
cl->ClFlags = DynamicMask;
ncp = cl->ClCode;
}
cl->ClFlags = DynamicMask;
ncp = cl->ClCode;
INIT_LOCK(cl->ClLock);
INIT_CLREF_COUNT(cl);
/* 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 */
/* This is the point we enter the code */
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
* backtrack to the previous block */
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.d = ncp;
/* 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
far */
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.LastClause->u.ld.d = cp;
p->cs.p_code.NOfClauses++;
}
/* p is already locked */
@ -629,11 +638,11 @@ asserta_dynam_clause(PredEntry *p, yamop *cp)
{
yamop *q;
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 */
ClauseCodeToClause(p->cs.p_code.FirstClause)->u.ClPrevious = q;
ClauseCodeToClause(cp)->u.ClPrevious = (yamop *)(p->CodeOfPred);
UNLOCK(ClauseCodeToClause(p->cs.p_code.FirstClause)->ClLock);
ClauseCodeToDynamicClause(p->cs.p_code.FirstClause)->ClPrevious = q;
ClauseCodeToDynamicClause(cp)->ClPrevious = (yamop *)(p->CodeOfPred);
UNLOCK(ClauseCodeToDynamicClause(p->cs.p_code.FirstClause)->ClLock);
q->u.ld.d = p->cs.p_code.FirstClause;
q->u.ld.s = p->ArityOfPE;
q->u.ld.p = p;
@ -650,6 +659,7 @@ asserta_dynam_clause(PredEntry *p, yamop *cp)
q->u.ld.d = cp;
q->u.ld.s = p->ArityOfPE;
q->u.ld.p = p;
p->cs.p_code.NOfClauses++;
}
/* p is already locked */
@ -715,6 +725,7 @@ assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag)
}
}
#endif /* YAPOR */
p->cs.p_code.NOfClauses++;
}
/* p is already locked */
@ -724,12 +735,12 @@ assertz_dynam_clause(PredEntry *p, yamop *cp)
yamop *q;
q = p->cs.p_code.LastClause;
LOCK(ClauseCodeToClause(q)->ClLock);
LOCK(ClauseCodeToDynamicClause(q)->ClLock);
q->u.ld.d = cp;
p->cs.p_code.LastClause = cp;
/* also, keep backpointers for the days we'll delete all the clause */
ClauseCodeToClause(cp)->u.ClPrevious = q;
UNLOCK(ClauseCodeToClause(q)->ClLock);
ClauseCodeToDynamicClause(cp)->ClPrevious = q;
UNLOCK(ClauseCodeToDynamicClause(q)->ClLock);
q = (yamop *)cp;
if (p->PredFlags & ProfiledPredFlag)
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.s = p->ArityOfPE;
q->u.ld.p = p;
p->cs.p_code.NOfClauses++;
}
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)
return;
if (!is_dynamic(p)) {
Clause *clp = ClauseCodeToClause(cp);
clp->ClFlags |= StaticMask;
if (p->PredFlags & LogUpdatePredFlag) {
LogUpdClause *clp = ClauseCodeToLogUpdClause(cp);
clp->ClFlags |= StaticMask;
} else {
StaticClause *clp = ClauseCodeToStaticClause(cp);
clp->ClFlags |= StaticMask;
}
if (compile_mode)
p->PredFlags |= CompiledPredFlag | FastPredFlag;
else
@ -1101,7 +1118,7 @@ p_compile_dynamic(void)
Term t = Deref(ARG1);
Term t1 = Deref(ARG2);
Term t3 = Deref(ARG3);
Clause *cl;
DynamicClause *cl;
yamop *code_adr;
int old_optimize;
Int mod;
@ -1119,25 +1136,20 @@ p_compile_dynamic(void)
if (!Yap_ErrorMessage) {
optimizer_on = old_optimize;
cl = ClauseCodeToClause(code_adr);
cl = ClauseCodeToDynamicClause(code_adr);
addclause(t, code_adr, (int) (IntOfTerm(t1) & 3), mod);
}
if (Yap_ErrorMessage) {
} else {
if (IntOfTerm(t1) & 4) {
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, "line %d, %s", Yap_FirstLineInParse(), Yap_ErrorMessage);
} else
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return (FALSE);
}
cl = ClauseCodeToClause(code_adr);
if (!(cl->ClFlags & LogUpdMask))
cl->ClFlags = DynamicMask;
cl->ClFlags = DynamicMask;
t = MkIntegerTerm((Int)code_adr);
return(Yap_unify(ARG4, t));
}
static int consult_level = 0;
static Atom
@ -1285,18 +1297,20 @@ p_purge_clauses(void)
q1 = q;
q = NextClause(q);
if (pred->PredFlags & LogUpdatePredFlag)
Yap_ErCl(ClauseCodeToClause(q1));
Yap_ErLogUpdCl(ClauseCodeToLogUpdClause(q1));
else {
Clause *cl = ClauseCodeToClause(q1);
StaticClause *cl = ClauseCodeToStaticClause(q1);
if (cl->ClFlags & HasBlobsMask || in_use) {
cl->u.NextCl = DeadClauses;
DeadClauses = cl;
DeadClause *dcl = (DeadClause *)cl;
dcl->NextCl = DeadClauses;
dcl->ClFlags = 0;
DeadClauses = dcl;
} else {
Yap_FreeCodeSpace((char *)cl);
}
}
} 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)) {
pred->OpcodeOfPred = FAIL_OPCODE;
} else {
@ -1371,7 +1385,6 @@ p_setspy(void)
pred->OpcodeOfPred = Yap_opcode(_spy_pred);
pred->CodeOfPred = (yamop *)(&(pred->OpcodeOfPred));
}
pred->StateOfPred |= SpiedMask;
pred->PredFlags |= SpiedPredFlag;
WRITE_UNLOCK(pred->PRWLock);
return (TRUE);
@ -1407,10 +1420,7 @@ p_rmspy(void)
return (FALSE);
}
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;
} else if (pred->OpcodeOfPred == Yap_opcode(_spy_or_trymark)) {
pred->OpcodeOfPred = Yap_opcode(_try_and_mark);
@ -1436,7 +1446,6 @@ p_number_of_clauses(void)
int ncl = 0;
Prop pe;
yamop *q;
int testing;
int mod;
if (IsVarTerm(t2) || !IsAtomTerm(t2)) {
@ -1454,19 +1463,10 @@ p_number_of_clauses(void)
q = RepPredProp(pe)->cs.p_code.FirstClause;
READ_LOCK(RepPredProp(pe)->PRWLock);
if (q != NIL) {
if (RepPredProp(pe)->PredFlags & DynamicPredFlag)
testing = TRUE;
else
testing = FALSE;
while (q != RepPredProp(pe)->cs.p_code.LastClause) {
if (!testing ||
!(ClauseCodeToClause(q)->ClFlags & ErasedMask))
ncl++;
ncl++;
q = NextClause(q);
}
if (!testing ||
!(ClauseCodeToClause(q)->ClFlags & ErasedMask))
ncl++;
}
READ_UNLOCK(RepPredProp(pe)->PRWLock);
t = MkIntegerTerm(ncl);
@ -1803,37 +1803,37 @@ p_compile_mode(void)
}
#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)
{
yamop *clcode;
Clause *cl;
StaticClause *cl;
clcode = pe->cs.p_code.FirstClause;
cl = ClauseCodeToClause(clcode);
cl = ClauseCodeToStaticClause(clcode);
do {
if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) {
return((yamop *)clcode);
}
if (clcode == pe->cs.p_code.LastClause)
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);
Yap_Error(SYSTEM_ERROR,TermNil,"could not find clause for indexing code");
return(NULL);
@ -1899,24 +1899,25 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything)
READ_LOCK(pe->PRWLock);
if (p->PredFlags & IndexedPredFlag) {
yamop *code_p = b_ptr->cp_ap;
if (code_p >= p->cs.p_code.TrueCodeOfPred &&
code_p <= p->cs.p_code.TrueCodeOfPred + Yap_SizeOfBlock((CODEADDR)ClauseCodeToClause(p->cs.p_code.TrueCodeOfPred))) {
yamop *prev;
/* fix the choicepoint */
switch(opnum) {
case _switch_last:
case _switch_l_list:
{
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;
default:
b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->u.ld.d);
}
READ_UNLOCK(pe->PRWLock);
char *code_end;
if (p->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = ClauseCodeToLogUpdClause(p->cs.p_code.TrueCodeOfPred);
code_end = (char *)cl + Yap_SizeOfBlock((CODEADDR)cl);
} else {
StaticClause *cl = ClauseCodeToStaticClause(p->cs.p_code.TrueCodeOfPred);
code_end = (char *)cl + Yap_SizeOfBlock((CODEADDR)cl);
}
if (code_p >= p->cs.p_code.TrueCodeOfPred &&
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);
}
}
READ_UNLOCK(pe->PRWLock);
} else {
READ_UNLOCK(pe->PRWLock);
}
@ -1935,9 +1936,9 @@ mark_pred(int mark, PredEntry *pe)
if (pe->ModuleOfPred) {
WRITE_LOCK(pe->PRWLock);
if (mark) {
pe->StateOfPred |= InUseMask;
pe->PredFlags |= InUsePredFlag;
} else {
pe->StateOfPred &= ~InUseMask;
pe->PredFlags &= ~InUsePredFlag;
}
WRITE_UNLOCK(pe->PRWLock);
}
@ -2116,12 +2117,21 @@ p_toggle_static_predicates_in_use(void)
static Int
code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
yamop *clcode;
Clause *cl;
int i = 1;
READ_LOCK(pp->PRWLock);
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 */
if ((pp->PredFlags & IndexedPredFlag) &&
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);
return(-1);
}
cl = ClauseCodeToClause(clcode);
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))) {
/* we found it */
*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)
break;
cl = ClauseCodeToClause(clcode = NextClause(clcode));
i++;
clcode = NextClause(clcode);
} while (TRUE);
}
READ_UNLOCK(pp->PRWLock);
@ -2381,7 +2399,7 @@ p_clean_up_dead_clauses(void)
{
while (DeadClauses != NULL) {
char *pt = (char *)DeadClauses;
DeadClauses = DeadClauses->u.NextCl;
DeadClauses = DeadClauses->NextCl;
Yap_FreeCodeSpace(pt);
}
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_bifun, (Int, Term, Term, 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 get_cl_info, (Term));
STATIC_PROTO(void c_head, (Term));
STATIC_PROTO(int usesvar, (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
c_body(Term Body, int mod)
{
onhead = FALSE;
BodyStart = cpc;
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)
&& FunctorOfTerm(Body) == FunctorComma) {
Term t2 = ArgOfTerm(2, Body);
@ -1731,42 +1699,6 @@ c_body(Term Body, int 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
c_head(Term t)
{
@ -1784,7 +1716,6 @@ c_head(Term t)
f = FunctorOfTerm(t);
Yap_emit(name_op, (CELL) NameOfFunctor(f), ArityOfFunctor(f));
c_args(t, 0);
get_cl_info(ArgOfTerm(1, t));
}
/* number of permanent variables in the clause */
@ -2793,7 +2724,6 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod)
return (0);
}
SaveH = H;
clause_mask = 0;
or_found = 0;
Yap_ErrorMessage = NULL;
/* initialize variables for code generation */

191
C/computils.c
View File

@ -267,8 +267,50 @@ Yap_bip_name(Int op, char *s) {
#ifdef DEBUG
static void
ShowOp (f)
char *f;
write_address(CELL address)
{
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;
while ((ch = *f++) != 0)
@ -291,7 +333,7 @@ ShowOp (f)
}
break;
case 'l':
Yap_plwrite (MkIntTerm (arg), Yap_DebugPutc, 0);
write_address (arg);
break;
case 'B':
{
@ -367,19 +409,7 @@ ShowOp (f)
}
break;
case 'f':
if (IsExtensionFunctor((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);
}
write_functor((Functor)arg);
break;
case 'r':
Yap_DebugPutc (Yap_c_error_stream,'A');
@ -388,27 +418,14 @@ ShowOp (f)
case 'h':
{
CELL my_arg = *cptr++;
if (my_arg & 1)
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);
write_address(my_arg);
}
break;
case 'g':
if (arg & 1)
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);
write_address(arg);
break;
case 'i':
Yap_plwrite (MkIntTerm (arg), Yap_DebugPutc, 0);
write_address (arg);
break;
case 'j':
{
@ -441,59 +458,40 @@ ShowOp (f)
case 'c':
{
int i;
for (i = 0; i < arg; ++i)
{
CELL my_arg;
if (*cptr)
{
Yap_plwrite ((Term) * cptr++, Yap_DebugPutc, 0);
}
else
{
Yap_plwrite (MkIntTerm (0), Yap_DebugPutc, 0);
cptr++;
}
Yap_DebugPutc (Yap_c_error_stream,'\t');
my_arg = *cptr++;
if (my_arg & 1)
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);
Yap_DebugPutc (Yap_c_error_stream,'\n');
for (i = 0; i < arg; ++i) {
CELL my_arg;
Yap_DebugPutc(Yap_c_error_stream,'\t');
if (*cptr) {
Yap_plwrite ((Term) * cptr++, Yap_DebugPutc, 0);
} else {
Yap_plwrite (MkIntTerm (0), Yap_DebugPutc, 0);
cptr++;
}
Yap_DebugPutc (Yap_c_error_stream,'\t');
my_arg = *cptr++;
write_address (my_arg);
if (i+1 < arg)
Yap_DebugPutc (Yap_c_error_stream,'\n');
}
}
break;
case 'e':
{
int i;
for (i = 0; i < arg; ++i)
{
CELL my_arg;
if (*cptr)
{
Yap_plwrite (MkAtomTerm (NameOfFunctor ((Functor) * cptr)), Yap_DebugPutc, 0);
Yap_DebugPutc (Yap_c_error_stream,'/');
Yap_plwrite (MkIntTerm (ArityOfFunctor ((Functor) * cptr++)), Yap_DebugPutc, 0);
}
else
{
Yap_plwrite (MkIntTerm (0), Yap_DebugPutc, 0);
cptr++;
}
Yap_DebugPutc (Yap_c_error_stream,'\t');
my_arg = *cptr++;
if (my_arg & 1)
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);
Yap_DebugPutc (Yap_c_error_stream,'\n');
for (i = 0; i < arg; ++i) {
CELL my_arg = cptr[0], lbl = cptr[1];
Yap_DebugPutc(Yap_c_error_stream,'\t');
if (my_arg) {
write_functor((Functor)my_arg);
} else {
Yap_plwrite(MkIntTerm (0), Yap_DebugPutc, 0);
}
Yap_DebugPutc(Yap_c_error_stream,'\t');
write_address(lbl);
cptr += 2;
if (i+1 < arg)
Yap_DebugPutc(Yap_c_error_stream,'\n');
}
}
break;
default:
@ -554,6 +552,7 @@ static char *opformat[] =
"deallocate",
"try_me_else\t\t%l\t%x",
"jump\t\t%l",
"jump\t\t%l",
"procceed",
"call\t\t%p,%d,%z",
"execute\t\t%p",
@ -576,42 +575,14 @@ static char *opformat[] =
"retry\t\t%g\t%x",
"trust\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",
"cache_arg\t%r",
"cache_sub_arg\t%d",
"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",
"if_a_constant\t%i\t%h\n%c",
"go_if_ equals_constant\t%o\t%h\t%h",
"if_constant\t%i\t%h\n%c",
"switch_on_functor\t%i\n%e",
"if_a_functor\t%i\t%h\n%e",
"go_if_equals_functor\t%j\t%h\t%h",
"if_functor\t%i\t%h\n%e",
"if_not_then\t%i\t%h\t%h\t%h",
"save_pair\t%v",
"save_appl\t%v",

97
C/dbase.c
View File

@ -226,9 +226,9 @@ STATIC_PROTO(Int co_rdedp, (void));
STATIC_PROTO(Int p_first_instance, (void));
STATIC_PROTO(void ErasePendingRefs, (DBRef));
STATIC_PROTO(void RemoveDBEntry, (DBRef));
STATIC_PROTO(void EraseLogUpdCl, (Clause *));
STATIC_PROTO(void MyEraseClause, (Clause *));
STATIC_PROTO(void PrepareToEraseClause, (Clause *, DBRef));
STATIC_PROTO(void EraseLogUpdCl, (LogUpdClause *));
STATIC_PROTO(void MyEraseClause, (DynamicClause *));
STATIC_PROTO(void PrepareToEraseClause, (DynamicClause *, DBRef));
STATIC_PROTO(void EraseEntry, (DBRef));
STATIC_PROTO(Int p_erase, (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 */
#if defined(YAPOR) || defined(THREADS)
{
Clause *cl = ClauseCodeToClause(newp);
DynamicClause *cl = ClauseCodeToDynamicClause(newp);
LOCK(cl->ClLock);
TRAIL_CLREF(cl);
@ -3594,7 +3594,7 @@ find_next_clause(DBRef ref0)
#else
if (!DynamicFlags(newp) & InUseMask) {
DynamicFlags(newp) |= InUseMask;
TRAIL_CLREF(ClauseCodeToClause(newp));
TRAIL_CLREF(ClauseCodeToDynamicClause(newp));
}
#endif
return(newp);
@ -3621,8 +3621,10 @@ p_jump_to_next_dynamic_clause(void)
}
static void
EraseLogUpdCl(Clause *clau)
EraseLogUpdCl(LogUpdClause *clau)
{
if (CL_IN_USE(clau))
return;
if (clau->ClFlags & IndexMask) {
Yap_RemoveLogUpdIndex(clau);
} else {
@ -3636,7 +3638,7 @@ EraseLogUpdCl(Clause *clau)
}
static void
MyEraseClause(Clause *clau)
MyEraseClause(DynamicClause *clau)
{
DBRef ref;
SMALLUNSGN clmask;
@ -3644,10 +3646,6 @@ MyEraseClause(Clause *clau)
if (CL_IN_USE(clau))
return;
clmask = clau->ClFlags;
if (clmask & LogUpdMask) {
EraseLogUpdCl(clau);
return;
}
/*
I don't need to lock the clause at this point because
I am the last one using it anyway.
@ -3684,7 +3682,17 @@ MyEraseClause(Clause *clau)
lock on the current predicate
*/
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);
}
@ -3692,12 +3700,15 @@ Yap_ErCl(Clause *clau)
#define TRYCODE(G,F,N) ( (N)<5 ? (op_numbers)((int)(F)+(N)*3) : G)
static void
PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr)
PrepareToEraseLogUpdClause(LogUpdClause *clau, DBRef dbr)
{
yamop *code_p = clau->ClCode;
PredEntry *p = (PredEntry *)(code_p->u.ld.p);
yamop *cl = code_p;
if (clau->ClFlags & ErasedMask)
return;
clau->ClFlags |= ErasedMask;
WRITE_LOCK(p->PRWLock);
if (p->cs.p_code.FirstClause != cl) {
/* we are not the first clause... */
@ -3720,8 +3731,7 @@ PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr)
if (p->PredFlags & IndexedPredFlag) {
Yap_RemoveIndexation(p);
} 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 != NULL) {
@ -3731,11 +3741,9 @@ PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr)
if (p->PredFlags & SpiedPredFlag) {
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
p->StateOfPred = StaticMask | SpiedMask;
} else {
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred;
p->OpcodeOfPred = p->cs.p_code.TrueCodeOfPred->opc;
p->StateOfPred = StaticMask;
}
} else {
p->OpcodeOfPred = FAIL_OPCODE;
@ -3750,11 +3758,12 @@ PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr)
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
}
}
p->cs.p_code.NOfClauses--;
WRITE_UNLOCK(p->PRWLock);
}
static void
PrepareToEraseClause(Clause *clau, DBRef dbr)
PrepareToEraseClause(DynamicClause *clau, DBRef dbr)
{
yamop *code_p;
@ -3762,10 +3771,6 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
if (clau->ClFlags & ErasedMask)
return;
clau->ClFlags |= ErasedMask;
if (clau->ClFlags & LogUpdMask) {
PrepareToEraseLogUpdClause(clau, dbr);
return;
}
/* skip mask */
code_p = clau->ClCode;
/* skip retry instruction */
@ -3777,17 +3782,17 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
/* first we get the next clause */
yamop *next = code_p->u.ld.d;
/* then we get the previous clause */
yamop *previous = clau->u.ClPrevious;
yamop *previous = clau->ClPrevious;
yamop *clau_code;
/* next we check if we still have clauses left in the chain */
if (previous != next) {
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 */
previous_code->u.ld.d = next;
/* 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
predicate entry that a clause left. */
@ -3817,7 +3822,7 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
}
#endif
/* 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->OpcodeOfPred = FAIL_OPCODE;
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) {
pred->cs.p_code.LastClause = previous;
}
pred->cs.p_code.NOfClauses--;
WRITE_UNLOCK(pred->PRWLock);
}
/* make sure we don't directly point to anyone else */
@ -3845,17 +3851,32 @@ ErDBE(DBRef entryref)
{
if ((entryref->Flags & DBCode) && entryref->Code) {
Clause *clau = ClauseCodeToClause(entryref->Code);
LOCK(clau->ClLock);
if (CL_IN_USE(clau) || entryref->NOfRefsTo != 0) {
PrepareToEraseClause(clau, entryref);
UNLOCK(clau->ClLock);
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 {
if (!(clau->ClFlags & ErasedMask))
DynamicClause *clau = ClauseCodeToDynamicClause(entryref->Code);
LOCK(clau->ClLock);
if (CL_IN_USE(clau) || entryref->NOfRefsTo != 0) {
PrepareToEraseClause(clau, entryref);
UNLOCK(clau->ClLock);
/* the clause must have left the chain */
MyEraseClause(clau);
UNLOCK(clau->ClLock);
} else {
if (!(clau->ClFlags & ErasedMask))
PrepareToEraseClause(clau, entryref);
UNLOCK(clau->ClLock);
/* the clause must have left the chain */
MyEraseClause(clau);
}
}
} else if (!(DBREF_IN_USE(entryref))) {
if (entryref->NOfRefsTo == 0)
@ -3908,7 +3929,11 @@ EraseEntry(DBRef entryref)
if (!DBREF_IN_USE(entryref)) {
ErDBE(entryref);
} 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->func = pen->FunctorOfPred;
while (position > 1) {
while (ClauseCodeToClause(q)->ClFlags & ErasedMask)
while (ClauseCodeToDynamicClause(q)->ClFlags & ErasedMask)
q = NextClause(q);
position--;
q = NextClause(q);
}
while (ClauseCodeToClause(q)->ClFlags & ErasedMask)
while (ClauseCodeToDynamicClause(q)->ClFlags & ErasedMask)
q = NextClause(q);
#if defined(YAPOR) || defined(THREADS)
{
Clause *cl = ClauseCodeToClause(q);
DynamicClause *cl = ClauseCodeToDynamicClause(q);
LOCK(cl->ClLock);
TRAIL_CLREF(cl);
@ -160,9 +160,9 @@ CallClause(PredEntry *pen, Int position)
UNLOCK(cl->ClLock);
}
#else
if (!(ClauseCodeToClause(q)->ClFlags & InUseMask)) {
CELL *opp = &(ClauseCodeToClause(q)->ClFlags);
TRAIL_CLREF(ClauseCodeToClause(q));
if (!(ClauseCodeToDynamicClause(q)->ClFlags & InUseMask)) {
CELL *opp = &(ClauseCodeToDynamicClause(q)->ClFlags);
TRAIL_CLREF(ClauseCodeToDynamicClause(q));
*opp |= InUseMask;
}
#endif

217
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 compaction_phase, (tr_fr_ptr, CELL *, yamop *, CELL *));
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 mark_db_fixed, (CELL *));
STATIC_PROTO(void mark_regs, (tr_fr_ptr));
@ -479,19 +477,27 @@ count_cells_marked(void)
/* straightforward binary tree scheme that, given a key, finds a
matching dbref */
typedef enum {
db_entry,
cl_entry,
lcl_entry,
dcl_entry
} db_entry_type;
typedef struct db_entry {
DBRef val;
CODEADDR val;
db_entry_type db_type;
struct db_entry *left;
CELL *lim;
CODEADDR lim;
struct db_entry *right;
} *dbentry;
static dbentry db_vec, db_vec0;
static dbentry db_vec, db_vec0;
/* init the table */
static void
store_ref_in_dbtable(DBRef entry)
store_in_dbtable(CODEADDR entry, db_entry_type db_type)
{
dbentry parent = db_vec0;
dbentry new = db_vec;
@ -499,7 +505,8 @@ store_ref_in_dbtable(DBRef entry)
if ((ADDR)new > Yap_TrailTop-1024)
Yap_growtrail(64 * 1024L);
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;
if (db_vec == db_vec0) {
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 */
static DBRef
find_ref_in_dbtable(DBRef entry)
static dbentry
find_ref_in_dbtable(CODEADDR entry)
{
dbentry current = db_vec0;
while (current != NULL) {
if (current->val < entry && current->lim > (CELL *)entry) {
return(current->val);
if (current->val < entry && current->lim > entry) {
return(current);
}
if (entry < current->val)
current = current->right;
@ -581,16 +552,30 @@ find_ref_in_dbtable(DBRef entry)
static void
mark_db_fixed(CELL *ptr) {
DBRef el;
dbentry el;
el = find_ref_in_dbtable((DBRef)ptr);
if (el != NULL)
el->Flags |= GcFoundMask;
el = find_ref_in_dbtable((CODEADDR)ptr);
if (el != NULL) {
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
init_dbtable(tr_fr_ptr trail_ptr) {
Clause *cl = DeadClauses;
DeadClause *cl = DeadClauses;
db_vec0 = db_vec = (dbentry)TR;
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)) {
CELL *pt0 = RepPair(trail_cell);
/* DB pointer */
CODEADDR entry;
CELL flags;
#ifdef FROZEN_STACKS /* TRAIL */
@ -619,20 +603,21 @@ init_dbtable(tr_fr_ptr trail_ptr) {
}
#endif /* FROZEN_STACKS */
flags = Flags((CELL)pt0);
flags = *pt0;
/* for the moment, if all references to the term in the stacks
are only pointers, reset the flag */
entry = ((CODEADDR)pt0 - (CELL) &(((DBRef) NIL)->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 {
store_cl_in_dbtable((Clause *)entry);
store_in_dbtable((CODEADDR)ClauseFlagsToDynamicClause(pt0), cl_entry);
}
}
}
while (cl != NULL) {
store_cl_in_dbtable(cl);
cl = cl->u.NextCl;
store_in_dbtable((CODEADDR)cl, dcl_entry);
cl = cl->NextCl;
}
if (db_vec == db_vec0) {
/* 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 */
Int bmap = 0;
int currv = 0;
Clause *cl;
#ifdef DEBUG
if (size < 0 || size > 512)
fprintf(Yap_stderr,"Oops, env size for %p is %ld\n", gc_ENV, (unsigned long int)size);
#endif
if ((cl = (Clause *)find_ref_in_dbtable((DBRef)gc_ENV[E_CP])) != NULL) {
cl->ClFlags |= GcFoundMask;
}
mark_db_fixed((CELL *)gc_ENV[E_CP]);
/* for each saved variable */
if (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;
register OPCODE op;
yamop *rtp = gc_B->cp_ap;
Clause *cl;
if ((cl = (Clause *)find_ref_in_dbtable((DBRef)rtp)) != NULL) {
cl->ClFlags |= GcFoundMask;
}
if ((cl = (Clause *)find_ref_in_dbtable((DBRef)(gc_B->cp_b))) != NULL) {
cl->ClFlags |= GcFoundMask;
}
mark_db_fixed((CELL *)rtp);
mark_db_fixed((CELL *)(gc_B->cp_ap));
mark_db_fixed((CELL *)(gc_B->cp_cp));
#ifdef EASY_SHUNTING
current_B = gc_B;
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_last:
case _Nstop:
case _switch_last:
case _switch_l_list:
case _retry_userc:
case _trust_logical_pred:
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 ;-) */
return;
}
case _switch_last:
case _switch_l_list:
nargs = rtp->u.slll.s;
break;
case _retry_c:
case _retry_userc:
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 _count_retry_and_mark:
case _retry_and_mark:
ClauseCodeToClause(gc_B->cp_ap)->ClFlags |= GcFoundMask;
ClauseCodeToDynamicClause(gc_B->cp_ap)->ClFlags |= GcFoundMask;
#ifdef DEBUG
case _retry_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 _trust_me4:
case _retry:
case _trust_in:
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;
break;
case _jump:
rtp = rtp->u.l.l;
op = rtp->opc;
opnum = Yap_op_from_opcode(op);
goto restart_cp;
default:
fprintf(Yap_stderr, "OOps in GC: Unexpected opcode: %d\n", opnum);
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,
hp_in_use_erased = 0, code_entries = 0;
#endif
Clause **cptr, *cl;
#ifndef FROZEN_STACKS
/*
@ -1932,7 +1898,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
continue;
}
#endif /* FROZEN_STACKS */
flags = Flags((CELL)pt0);
flags = *pt0;
#ifdef DEBUG
hp_entrs++;
if (!FlagOn(GcFoundMask, flags)) {
@ -1958,25 +1924,42 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
Yap_ErDBE(dbr);
}
} else {
Clause *cl = ClauseFlagsToClause((CELL)pt0);
int erase;
DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & ErasedMask)
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)
&& (cl->ref_count == 0)
#endif
;
if (erase) {
/* at this point,
no one is accessing the clause */
Yap_ErCl(cl);
if (erase) {
/* at this point,
no one is accessing the clause */
Yap_ErLogUpdCl(cl);
}
} else {
DynamicClause *cl = ClauseFlagsToDynamicClause(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_ErCl(cl);
}
}
}
RESET_VARIABLE(&TrailTerm(dest));
discard_trail_entries++;
} else {
Flags((CELL)pt0) = ResetFlag(GcFoundMask, flags);
*pt0 = ResetFlag(GcFoundMask, flags);
}
#if MULTI_ASSIGNMENT_VARIABLES
} 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);
}
cptr = &(DeadClauses);
cl = DeadClauses;
while (cl != NULL) {
if (!(cl->ClFlags & GcFoundMask)) {
char *ocl = (char *)cl;
cl = cl->u.NextCl;
*cptr = cl;
Yap_FreeCodeSpace(ocl);
} else {
cl->ClFlags &= ~GcFoundMask;
cptr = &(cl->u.NextCl);
cl = cl->u.NextCl;
{
DeadClause **cptr;
DeadClause *cl;
cptr = &(DeadClauses);
cl = DeadClauses;
while (cl != NULL) {
if (!(cl->ClFlags & GcFoundMask)) {
char *ocl = (char *)cl;
cl = cl->NextCl;
*cptr = cl;
Yap_FreeCodeSpace(ocl);
} else {
cl->ClFlags &= ~GcFoundMask;
cptr = &(cl->NextCl);
cl = cl->NextCl;
}
}
}
}
@ -2235,6 +2223,11 @@ sweep_choicepoints(choiceptr gc_B)
op = rtp->opc;
opnum = Yap_op_from_opcode(op);
goto restart_cp;
case _jump:
rtp = rtp->u.l.l;
op = rtp->opc;
opnum = Yap_op_from_opcode(op);
goto restart_cp;
#ifdef TABLING
case _table_answer_resolution:
{

3764
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);
PredEntry *pe;
yamop *p_code = ((Clause *)NULL)->ClCode;
Clause *cl = (Clause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e));
yamop *p_code = ((StaticClause *)NULL)->ClCode;
StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e));
cl->u.ClValue = 0;
cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user");
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);
PredEntry *pe;
yamop *p_code = ((Clause *)NULL)->ClCode;
Clause *cl = (Clause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),lxx),e));
yamop *p_code = ((StaticClause *)NULL)->ClCode;
StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),lxx),e));
cl->u.ClValue = 0;
cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user");
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->ModuleOfPred = CurrentModule;
if (def != NULL) {
yamop *p_code = ((Clause *)NULL)->ClCode;
Clause *cl = (Clause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e));
yamop *p_code = ((StaticClause *)NULL)->ClCode;
StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e));
cl->u.ClValue = 0;
cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user");
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)
CleanBack(pe, Start, Cont);
else {
Clause *cl;
yamop *code = ((Clause *)NULL)->ClCode;
StaticClause *cl;
yamop *code = ((StaticClause *)NULL)->ClCode;
pe->PredFlags = CompiledPredFlag | StandardPredFlag;
#ifdef YAPOR
pe->PredFlags |= SequentialPredFlag;
#endif /* YAPOR */
cl = (Clause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(code,lds),lds),e));
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(code,lds),lds),e));
if (cl == NIL) {
Yap_Error(SYSTEM_ERROR,TermNil,"No Heap Space in InitCPredBack");
return;
}
cl->u.ClValue = 0;
cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user");
code = cl->ClCode;
@ -710,7 +706,7 @@ InitCodes(void)
INIT_YAMOP_LTT(&(heap_regs->tableanswerresolutioncode), 0);
#endif /* YAPOR */
#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_2 = 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.s = -Signed(RealEnvSize);
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.s = -Signed(RealEnvSize);
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->index_op = Yap_opcode(_index_pred);
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))->u.ld.s = 0;
@ -748,9 +744,9 @@ InitCodes(void)
heap_regs->n_of_threads = 1;
heap_regs->heap_top_owner = -1;
#endif /* YAPOR */
heap_regs->clausecode.arity = 0;
heap_regs->clausecode.clause = NULL;
heap_regs->clausecode.func = NIL;
heap_regs->clausecode->arity = 0;
heap_regs->clausecode->clause = NULL;
heap_regs->clausecode->func = NIL;
heap_regs->invisiblechain.Entry = NIL;
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(Term AdjustDBTerm, (Term));
STATIC_PROTO(void RestoreDB, (DBEntry *));
STATIC_PROTO(void RestoreClause, (Clause *,int));
STATIC_PROTO(void CleanClauses, (yamop *, yamop *));
STATIC_PROTO(void RestoreClause, (yamop *, PredEntry *, int));
STATIC_PROTO(void CleanClauses, (yamop *, yamop *,PredEntry *));
STATIC_PROTO(void rehash, (CELL *, int, int));
STATIC_PROTO(void CleanCode, (PredEntry *));
STATIC_PROTO(void RestoreEntries, (PropEntry *));
@ -1379,17 +1379,21 @@ UnmarkTrEntries(void)
if (IsVarTerm(entry)) {
RESET_VARIABLE((CELL *)entry);
} else if (IsPairTerm(entry)) {
CODEADDR ent = CodeAddrAdjust((CODEADDR)RepPair(entry));
CELL *ent = CellPtoHeapAdjust(RepPair(entry));
register CELL flags;
flags = Flags(ent);
flags = *ent;
ResetFlag(InUseMask, flags);
Flags(ent) = flags;
*ent = flags;
if (FlagOn(ErasedMask, flags)) {
if (FlagOn(DBClMask, flags)) {
Yap_ErDBE((DBRef) (ent - (CELL) &(((DBRef) NIL)->Flags)));
Yap_ErDBE(DBStructFlagsToDBStruct(ent));
} 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; */
vsc_count++;
/* return;*/
#ifdef COMMENTED
if (vsc_count < 124840LL) return;
return;
if (vsc_count == 124881LL) {
printf("Here I go\n");
}

37
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* 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 */
@ -58,7 +58,7 @@ typedef struct various_codes {
yamop tableanswerresolutioncode;
#endif /* TABLING */
yamop comma_code[5];
OPCODE failcode;
yamop failcode[1];
OPCODE failcode_1;
OPCODE failcode_2;
OPCODE failcode_3;
@ -77,7 +77,7 @@ typedef struct various_codes {
struct pred_entry *p;
struct pred_entry *p0;
} env_for_trustfail_code; /* sla */
OPCODE trustfailcode;
yamop trustfailcode[1];
struct {
OPCODE op;
#ifdef YAPOR
@ -90,14 +90,14 @@ typedef struct various_codes {
struct pred_entry *p;
struct pred_entry *p0;
} env_for_yes_code; /* sla */
yamop yescode;
yamop nocode;
yamop rtrycode;
yamop yescode[1];
yamop nocode[1];
yamop rtrycode[1];
struct {
OPREG arity;
struct yami *clause;
Functor func;
} clausecode;
} clausecode[1];
union CONSULT_OBJ *consultsp;
union CONSULT_OBJ *consultbase;
union CONSULT_OBJ *consultlow;
@ -127,7 +127,7 @@ typedef struct various_codes {
int compiler_compile_mode;
struct pred_entry *compiler_current_pred;
AtomHashEntry invisiblechain;
OPCODE dummycode;
OPCODE dummycode[1];
UInt maxdepth, maxlist;
int update_mode;
Atom atprompt;
@ -159,7 +159,7 @@ typedef struct various_codes {
Term module_name[MaxModules];
struct pred_entry *module_pred[MaxModules];
SMALLUNSGN no_of_modules;
struct clause_struct *dead_clauses;
struct dead_clause *dead_clauses;
int primitives_module;
int user_module;
Atom
@ -314,8 +314,6 @@ typedef struct various_codes {
struct PSEUDO *compiler_CodeStart;
struct PSEUDO *compiler_icpc;
struct PSEUDO *compiler_BlobsStart;
int compiler_clause_mask;
CELL compiler_clause_store;
int *compiler_label_offset;
UInt i_pred_arity;
int compiler_profiling;
@ -350,14 +348,13 @@ typedef struct various_codes {
#define ANSWER_RESOLUTION ((yamop *)&(heap_regs->tableanswerresolutioncode ))
#endif /* TABLING */
#define COMMA_CODE heap_regs->comma_code
#define FAILCODE ((CODEADDR)&(heap_regs->failcode ))
#define FAILCODE ((CODEADDR)&(heap_regs->failcode ))
#define TRUSTFAILCODE ((CODEADDR)&(heap_regs->trustfailcode ))
#define YESCODE (&(heap_regs->yescode ))
#define NOCODE (&(heap_regs->nocode ))
#define RTRYCODE (&(heap_regs->rtrycode ))
#define DUMMYCODE (&(heap_regs->dummycode ))
#define CLAUSECODE (&(heap_regs->clausecode ))
#define FAILCODE heap_regs->failcode
#define TRUSTFAILCODE heap_regs->trustfailcode
#define YESCODE heap_regs->yescode
#define NOCODE heap_regs->nocode
#define RTRYCODE heap_regs->rtrycode
#define DUMMYCODE heap_regs->dummycode
#define CLAUSECODE heap_regs->clausecode
#define INVISIBLECHAIN heap_regs->invisiblechain
#define max_depth heap_regs->maxdepth
#define max_list heap_regs->maxlist
@ -535,8 +532,6 @@ typedef struct various_codes {
#define CodeStart heap_regs->compiler_CodeStart
#define icpc heap_regs->compiler_icpc
#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 IPredArity heap_regs->i_pred_arity
#define profiling heap_regs->compiler_profiling

24
H/YapOpcodes.h
View File

@ -140,29 +140,15 @@
OPCODE(cut_t ,e),
OPCODE(cut_e ,e),
OPCODE(try_clause ,ld),
OPCODE(try_in ,l),
OPCODE(retry ,ld),
OPCODE(trust_in ,ldl),
OPCODE(trust ,ld),
OPCODE(retry_first ,ld),
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(try_in ,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_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(if_cons ,sl),
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_from_code(X) ((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->CodeOfPred))))
#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 PredOpCode(X) pred_entry(X)->OpcodeOfPred
#define TruePredCode(X) pred_entry(X)->TrueCodeOfPred

38
H/amidefs.h
View File

@ -142,6 +142,11 @@ typedef struct yami {
CODEADDR d;
CELL next;
} d;
struct {
CODEADDR d;
struct pred_entry *p;
CELL next;
} dp;
struct {
Int ClTrail;
Int ClENV;
@ -234,6 +239,22 @@ typedef struct yami {
struct yami *l4;
CELL next;
} 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 pred_entry *p;
wamreg x1;
@ -313,6 +334,11 @@ typedef struct yami {
COUNT s;
CELL next;
} s;
struct {
COUNT s;
struct pred_entry *p;
CELL next;
} sp;
struct {
COUNT s;
CELL c;
@ -431,6 +457,8 @@ typedef yamop yamopp;
#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)
typedef struct trail_frame {
Term term;
@ -554,12 +582,12 @@ typedef struct choicept {
#endif
#define RealEnvSize (EnvSizeInCells*sizeof(CELL))
#define ENV_Size(cp) (((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NIL,sla)))->u.sla.s)
#define ENV_ToP(cp) (((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NIL,sla)))->u.sla.sla_u.p)
#define ENV_ToOp(cp) (((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NIL,sla)))->opc)
#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 *)NULL,sla)))->u.sla.sla_u.p)
#define ENV_ToOp(cp) (((yamop *)((CODEADDR)(cp) - (CELL)NEXTOP((yamop *)NULL,sla)))->opc)
#define EnvSize(cp) ((-ENV_Size(cp))/(OPREG)sizeof(CELL))
#define EnvBMap(p) (((yamop *)((CODEADDR)(p) - (CELL)NEXTOP((yamop *)NIL,sla)))->u.sla.bmap)
#define EnvPreg(p) (((yamop *)((CODEADDR)(p) - (CELL)NEXTOP((yamop *)NIL,sla)))->u.sla.p0)
#define EnvBMap(p) (((yamop *)((CODEADDR)(p) - (CELL)NEXTOP((yamop *)NULL,sla)))->u.sla.bmap)
#define EnvPreg(p) (((yamop *)((CODEADDR)(p) - (CELL)NEXTOP((yamop *)NULL,sla)))->u.sla.p0)
/* access to instructions */

107
H/clause.h
View File

@ -32,54 +32,13 @@ typedef union CONSULT_OBJ {
#define ASSEMBLING_CLAUSE 0
#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 PredFirstClause 0
#define PredMiddleClause 1
#define PredLastClause 2
typedef struct clause_struct {
/* 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;
typedef struct logic_upd_clause {
/* A set of flags describing info on the clause */
CELL ClFlags;
#if defined(YAPOR) || defined(THREADS)
@ -87,6 +46,10 @@ typedef struct clause_struct {
lockvar ClLock;
UInt ref_count;
#endif
union {
yamop *ClVarChain; /* indexing code for log. sem. */
} u;
/* extra clause information for logical update indices and facts */
union {
/* extra clause information for logical update semantics, rules with envs */
yamop *ClExt;
@ -95,14 +58,58 @@ typedef struct clause_struct {
} u2;
/* The instructions, at least one of the form sl */
yamop ClCode[MIN_ARRAY];
} Clause;
Atom Owner;
} LogUpdClause;
#define ClauseCodeToClause(p) ((Clause *)((CODEADDR)(p)-(CELL)(((Clause *)NULL)->ClCode)))
#define ClauseFlagsToClause(p) ((Clause *)((CODEADDR)(p)-(CELL)(&(((Clause *)NULL)->ClFlags))))
typedef struct dynamic_clause {
/* 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)
#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_compile_cmp_flags,(PredEntry *));
void STD_PROTO(Yap_InitComma,(void));
wamreg STD_PROTO(Yap_regnotoreg,(UInt));
/* cdmgr.c */
void STD_PROTO(Yap_RemoveLogUpdIndex,(Clause *));
void STD_PROTO(Yap_RemoveLogUpdIndex,(LogUpdClause *));
void STD_PROTO(Yap_IPred,(PredEntry *));
void STD_PROTO(Yap_addclause,(Term,yamop *,int,int));
/* dbase.c */
void STD_PROTO(Yap_ErCl,(Clause *));
void STD_PROTO(Yap_ErCl,(DynamicClause *));
void STD_PROTO(Yap_ErLogUpdCl,(LogUpdClause *));
/* exec.c */
Term STD_PROTO(Yap_cp_as_integer,(choiceptr));

37
H/compile.h
View File

@ -65,6 +65,7 @@ typedef enum compiler_op {
deallocate_op,
tryme_op,
jump_op,
jumpi_op,
procceed_op,
call_op,
execute_op,
@ -86,43 +87,15 @@ typedef enum compiler_op {
try_op,
retry_op,
trust_op,
tryin_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,
try_in_op,
jump_v_op,
switch_t_op,
switch_nv_op,
switch_l_op,
switch_h_op,
switch_lnl_op,
switch_nvl_op,
switch_ll_op,
cache_arg_op,
cache_sub_arg_op,
switch_on_type_op,
switch_c_op,
if_c_op,
go_c_op,
switch_f_op,
if_f_op,
go_f_op,
if_not_op,
save_pair_op,
save_appl_op,

90
H/index.h
View File

@ -15,68 +15,70 @@
* *
*************************************************************************/
/* Minimum number of clauses needed to build an hash table */
#define MinHashEntries 4
/* allowed types for clauses */
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 */
#define NonVarCl(X) ((X) != VarCl)
#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 */
#define MaxOptions 4
/* 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,
used to build the indexing code */
/* Used to store all important information about a clause */
typedef struct StructClauseDef {
int Kind; /* type of first argument */
Term Name; /* if nonvar or nonlist, first argument */
yamop *Code; /* start of code for clause */
struct StructClauseDef *Next; /* next clause in chain */
} ClauseDef;
Term Tag; /* if nonvar or nonlist, first argument */
yamop *Code; /* start of code for clause */
yamop *CurrentCode; /* start of code for clause */
yamop *WorkPC; /* start of code for clause */
} ClauseDef;
/* Relevant information for groups */
typedef struct {
int Type[MaxOptions]; /* quantity of elements of each kind */
int NCl; /* total amount of clauses */
int SInfo; /* special info about group */
int NofClausesAfter; /* number of clauses after the group */
ClauseDef *Start; /* first clause of group */
yamop *First,*Last; /* first and last code of clauses in group */
} GroupDef;
/* SInfo may be one of: */
#define OnlyNils 0x1
#define UsesBips 0x2
ClauseDef *FirstClause;
ClauseDef *LastClause;
UInt VarClauses;
UInt AtomClauses;
UInt PairClauses;
UInt StructClauses;
UInt TestClauses;
} GroupDef;
/* Different elements of the same kind in a group */
typedef struct {
Term Class; /* description of element */
CELL Code; /* code that deals with it */
ClauseDef *First, *Last; /* first and last clause with that term */
} EntryDef;
#define IsVarClause(X) ( ClauseCodeToClause(X)->ClFlags & FIsVar )
/* switch_on_cons */
typedef struct {
Term Tag;
UInt Label;
} AtomSwiEntry;
#define TermOfCl(X) ( ClauseCodeToClause(X)->u.ClValue )
#define HeadOfList(X) ( ClauseCodeToClause(X)->u.ClValue )
/* switch_on_func */
typedef struct {
Functor Tag;
UInt Label;
} FuncSwiEntry;
#define FinalGr(I) ((I) == NGroups - 1 && (I) != 0)
/*
* Number of clauses before you disable extended single optimisation.
*/
#define CLAUSES_FOR_EXTENDED_SINGLE 16
/* switch_on_type */
typedef struct {
UInt PairEntry;
UInt ConstEntry;
UInt FuncEntry;
UInt VarEntry;
} TypeSwitch;
#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);
#endif /* YAPOR */
#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_2 = 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->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->yescode.opc = Yap_opcode(_Ystop);
heap_regs->yescode->opc = Yap_opcode(_Ystop);
heap_regs->undef_op = Yap_opcode(_undef_p);
heap_regs->index_op = Yap_opcode(_index_pred);
heap_regs->fail_op = Yap_opcode(_op_fail);
heap_regs->nocode.opc = Yap_opcode(_Nstop);
heap_regs->nocode->opc = Yap_opcode(_Nstop);
#ifdef YAPOR
INIT_YAMOP_LTT(&(heap_regs->nocode), 1);
#endif /* YAPOR */
#ifdef YAPOR
INIT_YAMOP_LTT(&(heap_regs->rtrycode), 1);
#endif /* YAPOR */
((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);
{
int arity;
arity = heap_regs->clausecode.arity;
if (heap_regs->clausecode.clause != NIL)
heap_regs->clausecode.clause =
PtoOpAdjust(heap_regs->clausecode.clause);
arity = heap_regs->clausecode->arity;
if (heap_regs->clausecode->clause != NIL)
heap_regs->clausecode->clause =
PtoOpAdjust(heap_regs->clausecode->clause);
if (arity) {
heap_regs->clausecode.func =
FuncAdjust(heap_regs->clausecode.func);
heap_regs->clausecode->func =
FuncAdjust(heap_regs->clausecode->func);
} else {
/* an atom */
heap_regs->clausecode.func =
(Functor)AtomAdjust((Atom)(heap_regs->clausecode.func));
heap_regs->clausecode->func =
(Functor)AtomAdjust((Atom)(heap_regs->clausecode->func));
}
}
/* restore consult stack. It consists of heap pointers, so it
@ -131,7 +128,7 @@ restore_codes(void)
AddrAdjust((ADDR)heap_regs->char_conversion_table2);
}
if (heap_regs->dead_clauses != NULL) {
heap_regs->dead_clauses = (Clause *)
heap_regs->dead_clauses = (DeadClause *)
AddrAdjust((ADDR)(heap_regs->dead_clauses));
}
heap_regs->retry_recorded_code =
@ -562,38 +559,32 @@ RestoreBB(BlackBoardEntry *pp)
/* Restores a prolog clause, in its compiled form */
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
* clause for this predicate or not
*/
{
yamop *pc;
OPREG cl_type = FirstArgOfClType(Cl->ClFlags);
if (mode == ASSEMBLING_CLAUSE) {
if (cl_type == ApplCl ||
(cl_type == ListCl && HeadOfClType(cl_type) == ApplCl)) {
#ifdef DEBUG_RESTORE2
YP_fprintf(errout, "at %p, appl: %lx -> %lx", Cl, Cl->u.ClValue,
(CELL)FuncAdjust((Functor)(Cl->u.ClValue)));
#endif
Cl->u.ClValue = (CELL)FuncAdjust((Functor)(Cl->u.ClValue));
} else if ((cl_type == AtCl ||
(cl_type == ListCl && HeadOfClType(cl_type) == AtCl)) &&
IsAtomTerm(Cl->u.ClValue)) {
#ifdef DEBUG_RESTORE2
if (IsAtomTerm(Cl->u.ClValue))
YP_fprintf(errout, "at %p, atom: %lx -> %lx", Cl, Cl->u.ClValue,
AtomTermAdjust(Cl->u.ClValue));
#endif
Cl->u.ClValue = AtomTermAdjust(Cl->u.ClValue);
if (pp->PredFlags & DynamicPredFlag) {
DynamicClause *cl = ClauseCodeToDynamicClause(pc);
if (cl->ClPrevious != NULL) {
cl->ClPrevious = PtoOpAdjust(cl->ClPrevious);
}
cl->Owner = AtomAdjust(cl->Owner);
} else if (pp->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = ClauseCodeToLogUpdClause(pc);
if (cl->ClFlags & LogUpdRuleMask) {
cl->u2.ClExt = PtoOpAdjust(cl->u2.ClExt);
}
cl->Owner = AtomAdjust(cl->Owner);
} else {
StaticClause *cl = ClauseCodeToStaticClause(pc);
cl->Owner = AtomAdjust(cl->Owner);
}
}
/* TO DO: log update semantics */
/* Get the stored operator */
pc = Cl->ClCode;
do {
op_numbers op = Yap_op_from_opcode(pc->opc);
pc->opc = Yap_opcode(op);
@ -638,12 +629,6 @@ RestoreClause(Clause *Cl, int mode)
case _try_clause:
case _retry:
case _trust:
case _retry_first:
case _trust_first:
case _retry_tail:
case _trust_tail:
case _retry_head:
case _trust_head:
#ifdef YAPOR
case _getwork:
case _getwork_seq:
@ -673,8 +658,8 @@ RestoreClause(Clause *Cl, int mode)
case _jump:
case _move_back:
case _skip:
case _try_in:
case _jump_if_var:
case _try_in:
pc->u.l.l = PtoOpAdjust(pc->u.l.l);
pc = NEXTOP(pc,l);
break;
@ -1035,35 +1020,41 @@ RestoreClause(Clause *Cl, int mode)
pc->u.lds.p = PtoPredAdjust(pc->u.lds.p);
pc = NEXTOP(pc,lds);
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 */
case _switch_on_type:
case _switch_list_nl:
case _switch_on_head:
pc->u.llll.l1 = PtoOpAdjust(pc->u.llll.l1);
pc->u.llll.l2 = PtoOpAdjust(pc->u.llll.l2);
pc->u.llll.l3 = PtoOpAdjust(pc->u.llll.l3);
pc->u.llll.l4 = PtoOpAdjust(pc->u.llll.l4);
pc = NEXTOP(pc,llll);
break;
/* instructions type lll */
case _switch_on_nonv:
case _switch_nv_list:
pc->u.lll.l1 = PtoOpAdjust(pc->u.lll.l1);
pc->u.lll.l2 = PtoOpAdjust(pc->u.lll.l2);
pc->u.lll.l3 = PtoOpAdjust(pc->u.lll.l3);
pc = NEXTOP(pc,lll);
/* instructions type xllll */
case _switch_list_nl:
pc->u.ollll.pop = Yap_opcode(Yap_op_from_opcode(pc->u.ollll.pop));
pc->u.ollll.l1 = PtoOpAdjust(pc->u.llll.l1);
pc->u.ollll.l2 = PtoOpAdjust(pc->u.llll.l2);
pc->u.ollll.l3 = PtoOpAdjust(pc->u.llll.l3);
pc->u.ollll.l4 = PtoOpAdjust(pc->u.llll.l4);
pc = NEXTOP(pc,ollll);
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:
{
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 = NEXTOP(pc,cll);
break;
/* instructions type ollll */
case _switch_list_nl_prefetch:
pc->u.ollll.pop = Yap_opcode(Yap_op_from_opcode(pc->u.ollll.pop));
pc->u.ollll.l1 = 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 */
case _switch_on_func:
{
@ -1197,15 +1179,6 @@ RestoreClause(Clause *Cl, int mode)
pc = (yamop *)oldcode;
}
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 */
case _p_plus_vv:
case _p_minus_vv:
@ -1344,11 +1317,11 @@ RestoreClause(Clause *Cl, int mode)
* and ending with Last, First may be equal to Last
*/
static void
CleanClauses(yamop *First, yamop *Last)
CleanClauses(yamop *First, yamop *Last, PredEntry *pp)
{
yamop *cl = First;
do {
RestoreClause(ClauseCodeToClause(cl), ASSEMBLING_CLAUSE);
RestoreClause(cl, pp, ASSEMBLING_CLAUSE);
if (cl == Last) return;
cl = NextClause(cl);
} while (TRUE);
@ -1472,7 +1445,7 @@ CleanCode(PredEntry *pp)
/* assembly */
if (pp->CodeOfPred) {
pp->CodeOfPred = PtoOpAdjust(pp->CodeOfPred);
CleanClauses(pp->CodeOfPred, pp->CodeOfPred);
CleanClauses(pp->CodeOfPred, pp->CodeOfPred, pp);
}
} else {
yamop *FirstC, *LastC;
@ -1495,12 +1468,12 @@ CleanCode(PredEntry *pp)
#ifdef DEBUG_RESTORE2
YP_fprintf(errout, "at %lx Correcting clauses from %lx to %lx\n", *(OPCODE *) FirstC, FirstC, LastC);
#endif
CleanClauses(FirstC, LastC);
CleanClauses(FirstC, LastC, pp);
if (flag & (DynamicPredFlag|IndexedPredFlag)) {
#ifdef DEBUG_RESTORE2
YP_fprintf(errout, "Correcting dynamic/indexed code\n");
#endif
RestoreClause(ClauseCodeToClause(pp->cs.p_code.TrueCodeOfPred), ASSEMBLING_INDEX);
RestoreClause(pp->cs.p_code.TrueCodeOfPred,pp, ASSEMBLING_INDEX);
}
}
/* we are pointing at ourselves */

14
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.
*/
typedef enum {
InUsePredFlag = 0x4000000L, /* count calls to pred */
CountPredFlag = 0x2000000L, /* count calls to pred */
HiddenPredFlag = 0x1000000L, /* invisible predicate */
CArgsPredFlag = 0x800000L, /* SWI-like C-interface pred. */
@ -211,9 +212,10 @@ typedef struct pred_entry {
unsigned int ArityOfPE; /* arity of property */
union {
struct {
struct yami *TrueCodeOfPred; /* code address */
struct yami *FirstClause;
struct yami *LastClause;
struct yami *TrueCodeOfPred; /* code address */
struct yami *FirstClause;
struct yami *LastClause;
UInt NOfClauses;
} p_code;
CPredicate f_code;
CmpPredicate d_code;
@ -229,7 +231,6 @@ typedef struct pred_entry {
#endif /* TABLING */
SMALLUNSGN ModuleOfPred; /* module for this definition */
profile_data StatisticsForPred; /* enable profiling for predicate */
SMALLUNSGN StateOfPred; /* actual state of predicate */
} PredEntry;
#define PEProp ((PropFlags)(0x0000))
@ -255,8 +256,7 @@ typedef enum {
DBClMask = 0x0800, /* informs this is a data base structure */
LogUpdRuleMask= 0x0400, /* informs the code is for a log upd rule with env */
LogUpdMask = 0x0200, /* informs this is a logic update index. */
StaticMask = 0x0100, /* dealing with static predicates */
SpiedMask = 0x0080 /* this predicate is being spied */
StaticMask = 0x0100 /* dealing with static predicates */
/* other flags belong to DB */
} dbentry_flags;
@ -289,7 +289,7 @@ typedef struct DB_STRUCT {
Term Contents[MIN_ARRAY]; /* stored term */
} 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)
#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'(min,17).
'$binary_op_as_integer'(max,18).
'$binary_op_as_integer'(atan2,19).
%'$binary_op_as_integer'(gcdmult,28).
/* Arithmetics */

4
pl/boot.yap
View File

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