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

support expand group of clauses

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1031 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-03-31 01:03:10 +00:00
parent 545b12a808
commit c853e894c0
8 changed files with 192 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
C/absmi.c
View File

@ -10,8 +10,14 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
* Last rev: $Date: 2004-03-31 01:03:09 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.126 2004/03/19 11:35:42 vsc
* trim_trail for default machine
* be more aggressive about try-retry-trust chains.
* - handle cases where block starts with a wait
* - don't use _killed instructions, just let the thing rot by itself.
*
* Revision 1.125 2004/03/10 14:59:54 vsc
* optimise -> for type tests
*
@ -6458,6 +6464,48 @@ Yap_absmi(int inp)
}
ENDBOp();
BOp(expand_clauses, sp);
{
PredEntry *pe = PREG->u.sp.p;
yamop *pt0;
/* update ASP before calling IPred */
ASP = YREG+E_CB;
if (ASP > (CELL *) B) {
ASP = (CELL *) B;
}
#if defined(YAPOR) || defined(THREADS)
if (PP == NULL) {
READ_LOCK(pe->PRWLock);
PP = pe;
}
LOCK(pe->PELock);
if (*PREG_ADDR != PREG) {
PREG = *PREG_ADDR;
if (pe->PredFlags & (ThreadLocalPredFlag|LogUpdatePredFlag)) {
READ_UNLOCK(pe->PRWLock);
PP = NULL;
}
UNLOCK(pe->PELock);
JMPNext();
}
#endif
saveregs();
pt0 = Yap_ExpandIndex(pe);
/* restart index */
setregs();
UNLOCK(pe->PELock);
PREG = pt0;
#if defined(YAPOR) || defined(THREADS)
if (pe->PredFlags & (ThreadLocalPredFlag|LogUpdatePredFlag)) {
READ_UNLOCK(pe->PRWLock);
PP = NULL;
}
#endif
JMPNext();
}
ENDBOp();
BOp(undef_p, e);
/* save S for module name */
{
@ -6923,7 +6971,7 @@ Yap_absmi(int inp)
#define HASH_SHIFT 6
BOp(switch_on_func, ssl);
BOp(switch_on_func, sssl);
BEGD(d1);
d1 = *SREG++;
/* we use a very simple hash function to find elements in a
@ -6931,10 +6979,10 @@ Yap_absmi(int inp)
{
register CELL
/* first, calculate the mask */
Mask = (PREG->u.sl.s - 1) << 1, /* next, calculate the hash function */
Mask = (PREG->u.sssl.s - 1) << 1, /* next, calculate the hash function */
hash = d1 >> (HASH_SHIFT - 1) & Mask;
PREG = (yamop *)(PREG->u.sl.l);
PREG = (yamop *)(PREG->u.sssl.l);
/* PREG now points at the beginning of the hash table */
BEGP(pt0);
/* pt0 will always point at the item */
@ -6977,10 +7025,10 @@ Yap_absmi(int inp)
{
register CELL
/* first, calculate the mask */
Mask = (PREG->u.sl.s - 1) << 1, /* next, calculate the hash function */
Mask = (PREG->u.sssl.s - 1) << 1, /* next, calculate the hash function */
hash = d1 >> (HASH_SHIFT - 1) & Mask;
PREG = (yamop *)(PREG->u.sl.l);
PREG = (yamop *)(PREG->u.sssl.l);
/* PREG now points at the beginning of the hash table */
BEGP(pt0);
/* pt0 will always point at the item */
@ -7015,10 +7063,10 @@ Yap_absmi(int inp)
ENDD(d1);
ENDBOp();
BOp(go_on_func, sl);
BOp(go_on_func, sssl);
BEGD(d0);
{
CELL *pt = (CELL *)(PREG->u.sl.l);
CELL *pt = (CELL *)(PREG->u.sssl.l);
d0 = *SREG++;
if (d0 == pt[0]) {
@ -7034,10 +7082,10 @@ Yap_absmi(int inp)
ENDD(d0);
ENDBOp();
BOp(go_on_cons, sl);
BOp(go_on_cons, sssl);
BEGD(d0);
{
CELL *pt = (CELL *)(PREG->u.sl.l);
CELL *pt = (CELL *)(PREG->u.sssl.l);
d0 = I_R;
if (d0 == pt[0]) {
@ -7053,10 +7101,10 @@ Yap_absmi(int inp)
ENDD(d0);
ENDBOp();
BOp(if_func, sl);
BOp(if_func, sssl);
BEGD(d1);
BEGP(pt0);
pt0 = (CELL *) PREG->u.sl.l;
pt0 = (CELL *) PREG->u.sssl.l;
d1 = *SREG++;
while (pt0[0] != d1 && pt0[0] != (CELL)NULL ) {
pt0 += 2;
@ -7068,10 +7116,10 @@ Yap_absmi(int inp)
ENDD(d1);
ENDBOp();
BOp(if_cons, sl);
BOp(if_cons, sssl);
BEGD(d1);
BEGP(pt0);
pt0 = (CELL *) PREG->u.sl.l;
pt0 = (CELL *) PREG->u.sssl.l;
d1 = I_R;
while (pt0[0] != d1 && pt0[0] != 0L ) {
pt0 += 2;

39
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c *
* comments: abstract machine assembler *
* *
* Last rev: $Date: 2004-03-10 14:59:55 $ *
* $Log: not supported by cvs2svn $ *
* Last rev: $Date: 2004-03-31 01:03:09 $ *
* $Log: not supported by cvs2svn $
* Revision 1.58 2004/03/10 14:59:55 vsc
* optimise -> for type tests
* *
* *
*************************************************************************/
#ifdef SCCS
@ -734,18 +737,6 @@ a_r(CELL arnd2, op_numbers opcode, yamop *code_p, int pass_no)
return code_p;
}
inline static yamop *
a_sp(op_numbers opcode, COUNT sv, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.sp.s = sv-1;
code_p->u.sp.p = cip->CurrentPred;
}
GONEXT(dp);
return code_p;
}
static yamop *
check_alloc(clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip)
{
@ -1191,25 +1182,32 @@ a_hx(op_numbers opcode, union clause_obj *cl_u, int log_update, yamop *code_p, i
{
register CELL i, imax;
register CELL *seq_ptr = (CELL *)cip->cpc->rnd2;
int j = 0;
imax = cip->cpc->rnd1;
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.sl.s = emit_c(imax);
code_p->u.sl.l = emit_a(cip->cpc->rnd2);
code_p->u.sssl.s = emit_c(imax);
code_p->u.sssl.l = emit_a(cip->cpc->rnd2);
if (log_update) {
init_log_upd_table(ClauseCodeToLogUpdIndex(cip->cpc->rnd2), cl_u);
} else {
init_static_table(ClauseCodeToStaticIndex(cip->cpc->rnd2), cl_u);
}
}
GONEXT(sl);
if (pass_no) {
for (i = 0; i < imax; i++) {
yamop *ipc = (yamop *)seq_ptr[1];
a_pair(seq_ptr, pass_no, cip);
if (ipc != FAILCODE) {
j++;
}
seq_ptr += 2;
}
code_p->u.sssl.e = j;
code_p->u.sssl.w = 0;
}
GONEXT(sssl);
return code_p;
}
@ -1222,15 +1220,16 @@ a_if(op_numbers opcode, union clause_obj *cl_u, int log_update, yamop *code_p, i
imax = cip->cpc->rnd1;
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.sl.s = emit_count(imax);
code_p->u.sl.l = emit_a(cip->cpc->rnd2);
code_p->u.sssl.s = code_p->u.sssl.e = emit_count(imax);
code_p->u.sssl.w = 0;
code_p->u.sssl.l = emit_a(cip->cpc->rnd2);
if (log_update) {
init_log_upd_table(ClauseCodeToLogUpdIndex(cip->cpc->rnd2), cl_u);
} else {
init_static_table(ClauseCodeToStaticIndex(cip->cpc->rnd2), cl_u);
}
}
GONEXT(sl);
GONEXT(sssl);
if (pass_no) {
CELL lab, lab0;
for (i = 0; i < imax; i++) {

51
C/cdmgr.c
View File

@ -11,8 +11,14 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
* Last rev: $Date: 2004-03-31 01:03:09 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.115 2004/03/19 11:35:42 vsc
* trim_trail for default machine
* be more aggressive about try-retry-trust chains.
* - handle cases where block starts with a wait
* - don't use _killed instructions, just let the thing rot by itself.
*
* *
*************************************************************************/
#ifdef SCCS
@ -353,7 +359,7 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
case _switch_on_cons:
case _if_cons:
case _go_on_cons:
ipc = NEXTOP(ipc,sl);
ipc = NEXTOP(ipc,sssl);
break;
default:
Yap_Error(SYSTEM_ERROR,TermNil,"Bug in Indexing Code: opcode %d", op);
@ -377,6 +383,18 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
yamop *beg = c->ClCode, *end, *ipc;
op_numbers op;
if (c->ClFlags & SwitchTableMask) {
CELL *end = (CELL *)((char *)c+c->ClSize);
CELL *beg = (CELL *)(c->ClCode);
OPCODE ecs = Yap_opcode(_expand_clauses);
while (beg < end) {
yamop *cop;
cop = (yamop *)beg[1];
beg += 2;
if (cop->opc == ecs) {
Yap_FreeCodeSpace((char *)cop);
}
}
return;
}
op = Yap_op_from_opcode(beg->opc);
@ -403,9 +421,12 @@ kill_static_child_indxs(StaticIndex *indx)
Yap_FreeCodeSpace((CODEADDR)indx);
}
int kills;
static void
kill_off_lu_block(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
{
kills++;
if (parent != NULL) {
/* sat bye bye */
/* decrease refs */
@ -3114,8 +3135,15 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
{
LogUpdClause *cl;
Term rtn;
Term Terms[3];
cl = Yap_FollowIndexingCode(pe, i_code, th, tb, tr, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr);
Terms[0] = th;
Terms[1] = tb;
Terms[2] = tr;
cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr);
th = Terms[0];
tb = Terms[1];
tr = Terms[2];
if (cl == NULL) {
return FALSE;
}
@ -3223,8 +3251,14 @@ static Int
fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time)
{
LogUpdClause *cl;
Term Terms[3];
cl = Yap_FollowIndexingCode(pe, i_code, th, tb, TermNil, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr);
Terms[0] = th;
Terms[1] = tb;
Terms[2] = TermNil;
cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr);
th = Terms[0];
tb = Terms[1];
#if defined(YAPOR) || defined(THREADS)
if (PP == pe) {
READ_UNLOCK(pe->PRWLock);
@ -3314,8 +3348,15 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
{
StaticClause *cl;
Term rtn;
Term Terms[3];
cl = (StaticClause *)Yap_FollowIndexingCode(pe, i_code, th, tb, tr, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr);
Terms[0] = th;
Terms[1] = tb;
Terms[2] = tr;
cl = (StaticClause *)Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr);
th = Terms[0];
tb = Terms[1];
tr = Terms[2];
if (cl == NULL)
return FALSE;
rtn = MkDBRefTerm((DBRef)cl);

4
C/tracer.c
View File

@ -127,10 +127,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
}
#endif
vsc_count++;
if (vsc_count < 5319900)
return;
if (vsc_count == 5319949)
vsc_xstop = 1;
#ifdef COMMENTED
// if (vsc_count == 218280)
// vsc_xstop = 1;

21
H/YapOpcodes.h
View File

@ -11,8 +11,14 @@
* File: YapOpcodes.h *
* comments: Central Table with all YAP opcodes *
* *
* Last rev: $Date: 2004-03-19 11:35:42 $ *
* Last rev: $Date: 2004-03-31 01:03:10 $ *
* $Log: not supported by cvs2svn $
* Revision 1.22 2004/03/19 11:35:42 vsc
* trim_trail for default machine
* be more aggressive about try-retry-trust chains.
* - handle cases where block starts with a wait
* - don't use _killed instructions, just let the thing rot by itself.
*
* Revision 1.21 2004/03/10 14:59:55 vsc
* optimise -> for type tests
* *
@ -155,22 +161,23 @@
OPCODE(try_in ,l),
OPCODE(jump_if_var ,l),
OPCODE(jump_if_nonvar ,xl),
OPCODE(switch_on_cons ,ssl),
OPCODE(switch_on_cons ,sssl),
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 ,sl),
OPCODE(if_cons ,sl),
OPCODE(switch_on_func ,sl),
OPCODE(go_on_func ,sl),
OPCODE(if_func ,sl),
OPCODE(go_on_cons ,sssl),
OPCODE(if_cons ,sssl),
OPCODE(switch_on_func ,sssl),
OPCODE(go_on_func ,sssl),
OPCODE(if_func ,sssl),
OPCODE(if_not_then ,cll),
OPCODE(index_dbref ,e),
OPCODE(index_blob ,e),
OPCODE(trust_fail ,e),
OPCODE(index_pred ,e),
OPCODE(expand_index ,e),
OPCODE(expand_clauses ,sp),
OPCODE(save_b_x ,x),
OPCODE(save_b_y ,y),
OPCODE(commit_b_x ,x),

22
H/amidefs.h
View File

@ -11,8 +11,11 @@
* File: amidefs.h *
* comments: Abstract machine peculiarities *
* *
* Last rev: $Date: 2004-03-10 14:59:55 $ *
* $Log: not supported by cvs2svn $ *
* Last rev: $Date: 2004-03-31 01:03:10 $ *
* $Log: not supported by cvs2svn $
* Revision 1.22 2004/03/10 14:59:55 vsc
* optimise -> for type tests
* *
* *
*************************************************************************/
@ -357,7 +360,8 @@ typedef struct yami {
CELL next;
} s;
struct {
COUNT s;
COUNT s1;
COUNT s2;
struct pred_entry *p;
CELL next;
} sp;
@ -374,11 +378,6 @@ typedef struct yami {
CELL next;
} sdl;
struct {
COUNT s;
struct yami *l;
CELL next;
} sl;
struct {
#ifdef YAPOR
unsigned int or_arg;
#endif /* YAPOR */
@ -392,6 +391,13 @@ typedef struct yami {
struct pred_entry *p0;
CELL next;
} sla; /* also check env for yes and trustfail code before making any changes */
struct {
COUNT s; /* size of table */
COUNT e; /* live entries */
COUNT w; /* pending suspended blocks */
struct yami *l;
CELL next;
} sssl;
struct {
wamreg x;
CELL next;

2
H/clause.h
View File

@ -196,7 +196,7 @@ yamop *STD_PROTO(Yap_CleanUpIndex,(struct logic_upd_index *));
void STD_PROTO(Yap_AddClauseToIndex,(PredEntry *,yamop *,int));
void STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *));
LogUpdClause *STD_PROTO(Yap_NthClause,(PredEntry *,Int));
LogUpdClause *STD_PROTO(Yap_FollowIndexingCode,(PredEntry *,yamop *,Term,Term,Term, yamop *,yamop *));
LogUpdClause *STD_PROTO(Yap_FollowIndexingCode,(PredEntry *,yamop *, Term *, yamop *,yamop *));
#if USE_THREADED_CODE

54
H/rheap.h
View File

@ -11,8 +11,14 @@
* File: rheap.h *
* comments: walk through heap code *
* *
* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* Last rev: $Date: 2004-03-31 01:03:10 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.39 2004/03/19 11:35:42 vsc
* trim_trail for default machine
* be more aggressive about try-retry-trust chains.
* - handle cases where block starts with a wait
* - don't use _killed instructions, just let the thing rot by itself.
* *
* *
*************************************************************************/
#ifdef SCCS
@ -713,6 +719,18 @@ restore_opcodes(yamop *pc)
pc->u.xF.F = PtoOpAdjust(pc->u.xF.F);
pc = NEXTOP(pc,xF);
break;
case _expand_clauses:
pc->u.sp.p = PtoPredAdjust(pc->u.sp.p);
{
COUNT i;
yamop **st = (yamop **)NEXTOP(pc,sp);
for (i = 0; i < pc->u.sp.s1; i++, st++) {
if (*st) {
*st = PtoOpAdjust(*st);
}
}
}
/* instructions type y */
case _save_b_y:
case _commit_b_y:
@ -1051,8 +1069,8 @@ restore_opcodes(yamop *pc)
int i, j;
CELL *oldcode, *startcode;
i = pc->u.sl.s;
startcode = oldcode = (CELL *)(pc->u.sl.l = PtoOpAdjust(pc->u.sl.l));
i = pc->u.sssl.s;
startcode = oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l));
for (j = 0; j < i; j++) {
Functor oldfunc = (Functor)(oldcode[0]);
CODEADDR oldjmp = (CODEADDR)(oldcode[1]);
@ -1063,7 +1081,7 @@ restore_opcodes(yamop *pc)
oldcode += 2;
}
rehash(startcode, i, Funcs);
pc = NEXTOP(pc,sl);
pc = NEXTOP(pc,sssl);
}
break;
/* switch_on_cons */
@ -1075,11 +1093,11 @@ restore_opcodes(yamop *pc)
CELL *startcode;
#endif
i = pc->u.sl.s;
i = pc->u.sssl.s;
#if !USE_OFFSETS
startcode =
#endif
oldcode = (CELL *)(pc->u.sl.l = PtoOpAdjust(pc->u.sl.l));
oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l));
for (j = 0; j < i; j++) {
Term oldcons = oldcode[0];
CODEADDR oldjmp = (CODEADDR)(oldcode[1]);
@ -1092,23 +1110,23 @@ restore_opcodes(yamop *pc)
#if !USE_OFFSETS
rehash(startcode, i, Atomics);
#endif
pc = NEXTOP(pc,sl);
pc = NEXTOP(pc,sssl);
}
break;
case _go_on_func:
{
CELL *oldcode = (CELL *)(pc->u.sl.l = PtoOpAdjust(pc->u.sl.l));
CELL *oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l));
Functor oldfunc = (Functor)(oldcode[0]);
oldcode[0] = (CELL)FuncAdjust(oldfunc);
oldcode[1] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[1]);
oldcode[3] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[3]);
}
pc = NEXTOP(pc,sl);
pc = NEXTOP(pc,sssl);
break;
case _go_on_cons:
{
CELL *oldcode = (CELL *)(pc->u.sl.l = PtoOpAdjust(pc->u.sl.l));
CELL *oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l));
Term oldcons = oldcode[0];
if (IsAtomTerm(oldcons)) {
@ -1117,14 +1135,14 @@ restore_opcodes(yamop *pc)
oldcode[1] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[1]);
oldcode[3] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[3]);
}
pc = NEXTOP(pc,sl);
pc = NEXTOP(pc,sssl);
break;
case _if_func:
{
CELL *oldcode = (CELL *)(pc->u.sl.l = PtoOpAdjust(pc->u.sl.l));
CELL *oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l));
Int j;
for (j = 0; j < pc->u.sl.s; j++) {
for (j = 0; j < pc->u.sssl.s; j++) {
Functor oldfunc = (Functor)(oldcode[0]);
CODEADDR oldjmp = (CODEADDR)(oldcode[1]);
oldcode[0] = (CELL)FuncAdjust(oldfunc);
@ -1134,14 +1152,14 @@ restore_opcodes(yamop *pc)
/* adjust fail code */
oldcode[1] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[1]);
}
pc = NEXTOP(pc,sl);
pc = NEXTOP(pc,sssl);
break;
case _if_cons:
{
CELL *oldcode = (CELL *)(pc->u.sl.l = PtoOpAdjust(pc->u.sl.l));
CELL *oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l));
Int j;
for (j = 0; j < pc->u.sl.s; j++) {
for (j = 0; j < pc->u.sssl.s; j++) {
Term oldcons = oldcode[0];
CODEADDR oldjmp = (CODEADDR)(oldcode[1]);
if (IsAtomTerm(oldcons)) {
@ -1153,7 +1171,7 @@ restore_opcodes(yamop *pc)
/* adjust fail code */
oldcode[1] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[1]);
}
pc = NEXTOP(pc,sl);
pc = NEXTOP(pc,sssl);
break;
/* instructions type xxx */
case _p_plus_vv: