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

bug fixes, I hope! 

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1270 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-04-10 04:01:15 +00:00
parent 9d7954f092
commit 056ccbc819
20 changed files with 286 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
C/absmi.c
View File

@ -10,8 +10,14 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2005-04-07 17:48:53 $,$Author: ricroc $ *
* Last rev: $Date: 2005-04-10 04:01:07 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.162 2005/04/07 17:48:53 ricroc
* Adding tabling support for mixed strategy evaluation (batched and local scheduling)
* UPDATE: compilation flags -DTABLING_BATCHED_SCHEDULING and -DTABLING_LOCAL_SCHEDULING removed. To support tabling use -DTABLING in the Makefile or --enable-tabling in configure.
* NEW: yap_flag(tabling_mode,MODE) changes the tabling execution mode of all tabled predicates to MODE (batched, local or default).
* NEW: tabling_mode(PRED,MODE) changes the default tabling execution mode of predicate PRED to MODE (batched or local).
*
* Revision 1.161 2005/03/13 06:26:09 vsc
* fix excessive pruning in meta-calls
* fix Term->int breakage in compiler
@ -7828,20 +7834,20 @@ Yap_absmi(int inp)
ENDD(d0);
ENDBOp();
BOp(jump_if_nonvar, xl);
BOp(jump_if_nonvar, xll);
BEGD(d0);
d0 = XREG(PREG->u.xl.x);
d0 = XREG(PREG->u.xll.x);
deref_head(d0, jump2_if_unk);
/* non var */
jump2_if_nonvar:
copy_jmp_address(PREG->u.xl.l);
PREG = PREG->u.xl.l;
copy_jmp_address(PREG->u.xll.l1);
PREG = PREG->u.xll.l1;
JMPNext();
BEGP(pt0);
deref_body(d0, pt0, jump2_if_unk, jump2_if_nonvar);
/* variable */
PREG = NEXTOP(PREG, xl);
PREG = NEXTOP(PREG, xll);
ENDP(pt0);
JMPNext();
ENDD(d0);
@ -11396,8 +11402,8 @@ Yap_absmi(int inp)
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xcx),sla),l);
GONext();
} else if (d1 == 0) {
XREG(PREG->u.xxx.x) = d0;
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxx),sla),l);
XREG(PREG->u.xcx.x) = d0;
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xcx),sla),l);
GONext();
} else {
saveregs();

16
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c *
* comments: abstract machine assembler *
* *
* Last rev: $Date: 2005-03-04 20:30:10 $ *
* Last rev: $Date: 2005-04-10 04:01:09 $ *
* $Log: not supported by cvs2svn $
* Revision 1.72 2005/03/04 20:30:10 ricroc
* bug fixes for YapTab support
*
* Revision 1.71 2005/01/28 23:14:34 vsc
* move to Yap-4.5.7
* Fix clause size
@ -1197,10 +1200,11 @@ a_xigl(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.xl.x = emit_x(cpc->rnd2);
code_p->u.xl.l = emit_a(cpc->rnd1);
code_p->u.xll.x = emit_x(cpc->rnd2);
code_p->u.xll.l1 = emit_a(cpc->rnd1);
code_p->u.xll.l2 = NEXTOP(code_p,xll);
}
GONEXT(xl);
GONEXT(xll);
return code_p;
}
@ -1793,7 +1797,7 @@ a_fetch_vc(cmp_op_info *cmp_info, int pass_no, struct intermediates *cip)
Ventry *ve;
cmp_info->c_type = TYPE_XC;
cmp_info->c_arg = (Int)(cip->cpc->rnd1);
cmp_info->c_arg = cip->cpc->rnd1;
ve = (Ventry *) p->rnd1;
if (ve->KindOfVE == PermVar) {
/* don't get rid of get_val_op */
@ -1820,7 +1824,7 @@ a_fetch_cv(cmp_op_info *cmp_info, int pass_no, struct intermediates *cip)
Ventry *ve;
cmp_info->c_type = TYPE_CX;
cmp_info->c_arg = (Int)(cip->cpc->rnd1);
cmp_info->c_arg = cip->cpc->rnd1;
ve = (Ventry *) p->rnd1;
if (ve->KindOfVE == PermVar) {
/* don't get rid of get_val_op */

30
C/arrays.c
View File

@ -2011,6 +2011,35 @@ p_static_array_to_term(void)
return(FALSE);
}
static Int
p_static_array_location(void)
{
Term t = Deref(ARG1);
Int *ptr;
if (IsVarTerm(t)) {
return FALSE;
} else if (IsAtomTerm(t)) {
/* Create a named array */
AtomEntry *ae = RepAtom(AtomOfTerm(t));
StaticArrayEntry *pp;
READ_LOCK(ae->ARWLock);
pp = RepStaticArrayProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
pp = RepStaticArrayProp(pp->NextOfPE);
if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
READ_UNLOCK(ae->ARWLock);
return FALSE;
} else {
ptr = pp->ValueOfVE.ints;
READ_UNLOCK(ae->ARWLock);
}
return Yap_unify(ARG2,MkIntegerTerm((Int)ptr));
}
return FALSE;
}
void
Yap_InitArrayPreds(void)
{
@ -2029,5 +2058,6 @@ Yap_InitArrayPreds(void)
Yap_InitCPred("$array_refs_compiled", 0, p_array_refs_compiled, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$static_array_properties", 3, p_static_array_properties, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("static_array_to_term", 2, p_static_array_to_term, 0L);
Yap_InitCPred("static_array_location", 2, p_static_array_location, 0L);
}

11
C/c_interface.c
View File

@ -10,8 +10,12 @@
* File: c_interface.c *
* comments: c_interface primitives definition *
* *
* Last rev: $Date: 2005-03-15 18:29:23 $,$Author: vsc $ *
* Last rev: $Date: 2005-04-10 04:01:10 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.65 2005/03/15 18:29:23 vsc
* fix GPL
* fix idb: stuff in coroutines.
*
* Revision 1.64 2005/03/13 06:26:10 vsc
* fix excessive pruning in meta-calls
* fix Term->int breakage in compiler
@ -1009,8 +1013,9 @@ YAP_Read(int (*mygetc)(void))
Stream[sno].status = Free_Stream_f;
if (Yap_ErrorMessage)
{
save_machine_regs();
return(0);
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
RECOVER_MACHINE_REGS();
return 0;
}
t = Yap_Parse();
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);

15
C/cdmgr.c
View File

@ -11,8 +11,11 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2005-03-04 20:30:11 $,$Author: ricroc $ *
* Last rev: $Date: 2005-04-10 04:01:10 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.154 2005/03/04 20:30:11 ricroc
* bug fixes for YapTab support
*
* Revision 1.153 2005/02/25 03:39:44 vsc
* fix fixes to undefp
* fix bug where clause mistook cp for ap
@ -752,8 +755,8 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
break;
/* instructions type xl */
case _jump_if_nonvar:
release_wcls(ipc->u.xl.l, ecs);
ipc = NEXTOP(ipc,xl);
release_wcls(ipc->u.xll.l1, ecs);
ipc = NEXTOP(ipc,xll);
break;
/* instructions type e */
case _switch_on_type:
@ -2300,6 +2303,10 @@ p_setspy(void)
return (FALSE);
}
if (pred->OpcodeOfPred == INDEX_OPCODE) {
int i = 0;
for (i = 0; i < pred->ArityOfPE; i++) {
XREGS[i+1] = MkVarTerm();
}
IPred(pred, 0);
goto restart_spy;
}
@ -4415,7 +4422,7 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$start_consult", 3, p_startconsult, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$show_consult_level", 1, p_showconslultlev, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$end_consult", 0, p_endconsult, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$set_spy", 2, p_setspy, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$set_spy", 2, p_setspy, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$rm_spy", 2, p_rmspy, SafePredFlag|SyncPredFlag|HiddenPredFlag);
/* gc() may happen during compilation, hence these predicates are
now unsafe */

30
C/compiler.c
View File

@ -11,8 +11,13 @@
* File: compiler.c *
* comments: Clause compiler *
* *
* Last rev: $Date: 2005-03-13 06:26:10 $,$Author: vsc $ *
* Last rev: $Date: 2005-04-10 04:01:10 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.64 2005/03/13 06:26:10 vsc
* fix excessive pruning in meta-calls
* fix Term->int breakage in compiler
* improve JPL (at least it does something now for amd64).
*
* Revision 1.63 2005/03/04 20:30:11 ricroc
* bug fixes for YapTab support
*
@ -813,19 +818,11 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, compiler_struct *cglobs)
c_var(t1, v1, 0, 0, cglobs);
c_var(tn, v2, 0, 0, cglobs);
/* it has to be either an integer or a floating point */
} else if (IsIntTerm(t2)) {
} else if (IsIntegerTerm(t2)) {
/* first temp */
Int v1 = --cglobs->tmpreg;
Yap_emit(fetch_args_vc_op, (CELL)IntOfTerm(t2), Zero, &cglobs->cint);
/* these should be the arguments */
c_var(t1, v1, 0, 0, cglobs);
/* now we know where the arguments are */
} else if (IsLongIntTerm(t2)) {
/* first temp */
Int v1 = --cglobs->tmpreg;
Yap_emit(fetch_args_vc_op, (CELL)LongIntOfTerm(t2), Zero, &cglobs->cint);
Yap_emit(fetch_args_vc_op, IntegerOfTerm(t2), Zero, &cglobs->cint);
/* these should be the arguments */
c_var(t1, v1, 0, 0, cglobs);
/* now we know where the arguments are */
@ -1058,17 +1055,10 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, compiler_struct *cglobs)
/* now we know where the arguments are */
}
}
} else if (IsIntTerm(t1)) {
} else if (IsIntegerTerm(t1)) {
/* first temp */
Int v1 = --cglobs->tmpreg;
Yap_emit(fetch_args_cv_op, (CELL)IntOfTerm(t1), Zero, &cglobs->cint);
/* these should be the arguments */
c_var(t2, v1, 0, 0, cglobs);
/* now we know where the arguments are */
} else if (IsLongIntTerm(t1)) {
/* first temp */
Int v1 = --cglobs->tmpreg;
Yap_emit(fetch_args_cv_op, (CELL)LongIntOfTerm(t1), Zero, &cglobs->cint);
Yap_emit(fetch_args_cv_op, IntegerOfTerm(t1), Zero, &cglobs->cint);
/* these should be the arguments */
c_var(t2, v1, 0, 0, cglobs);
/* now we know where the arguments are */

85
C/dbase.c
View File

@ -1864,11 +1864,11 @@ record_at(int Flag, DBRef r0, Term t_data, Term t_code)
static LogUpdClause *
record_lu(PredEntry *pe, Term t, int position)
new_lu_db_entry(Term t, PredEntry *pe)
{
yamop *ipc;
DBTerm *x;
LogUpdClause *cl;
yamop *ipc;
int needs_vars = FALSE;
struct db_globs dbg;
@ -1895,6 +1895,19 @@ record_lu(PredEntry *pe, Term t, int position)
ipc->opc = Yap_opcode(_copy_idb_term);
else
ipc->opc = Yap_opcode(_unify_idb_term);
return cl;
}
static LogUpdClause *
record_lu(PredEntry *pe, Term t, int position)
{
LogUpdClause *cl;
if ((cl = new_lu_db_entry(t, pe)) == NULL) {
return NULL;
}
WRITE_LOCK(pe->PRWLock);
#if defined(YAPOR) || defined(THREADS)
WPP = pe;
@ -1907,6 +1920,48 @@ record_lu(PredEntry *pe, Term t, int position)
return cl;
}
static LogUpdClause *
record_lu_at(int position, LogUpdClause *ocl, Term t)
{
LogUpdClause *cl;
PredEntry *pe;
LOCK(ocl->ClLock);
pe = ocl->ClPred;
if ((cl = new_lu_db_entry(t,pe)) == NULL) {
return NULL;
}
WRITE_LOCK(pe->PRWLock);
Yap_RemoveIndexation(pe);
if (position == MkFirst) {
/* add before current clause */
cl->ClNext = ocl;
if (ocl->ClCode == pe->cs.p_code.FirstClause) {
cl->ClPrev = NULL;
pe->cs.p_code.FirstClause = cl->ClCode;
} else {
cl->ClPrev = ocl->ClPrev;
ocl->ClPrev->ClNext = cl;
}
ocl->ClPrev = cl;
} else {
/* add after current clause */
cl->ClPrev = ocl;
if (ocl->ClCode == pe->cs.p_code.LastClause) {
cl->ClNext = NULL;
pe->cs.p_code.LastClause = cl->ClCode;
} else {
cl->ClNext = ocl->ClNext;
ocl->ClNext->ClPrev = cl;
}
ocl->ClNext = cl;
}
pe->cs.p_code.NOfClauses++;
WRITE_UNLOCK(pe->PRWLock);
UNLOCK(ocl->ClLock);
return cl;
}
/* recorda(+Functor,+Term,-Ref) */
static Int
@ -1973,12 +2028,13 @@ p_rcdap(void)
return Yap_unify(ARG3, TRef);
}
/* recorda_at(+Functor,+Term,-Ref) */
/* recorda_at(+DBRef,+Term,-Ref) */
static Int
p_rcda_at(void)
{
/* Idiotic xlc's cpp does not work with ARG1 within MkDBRefTerm */
Term TRef, t1 = Deref(ARG1), t2 = Deref(ARG2);
DBRef dbr;
if (!IsVarTerm(Deref(ARG3)))
return (FALSE);
@ -1992,7 +2048,16 @@ p_rcda_at(void)
}
Yap_Error_Size = 0;
restart_record:
TRef = MkDBRefTerm(record_at(MkFirst, DBRefOfTerm(t1), t2, Unsigned(0)));
dbr = DBRefOfTerm(t1);
if (dbr->Flags & ErasedMask) {
/* doesn't make sense */
return FALSE;
}
if (dbr->Flags & LogUpdMask) {
TRef = MkDBRefTerm((DBRef)record_lu_at(MkFirst, (LogUpdClause *)dbr, t2));
} else {
TRef = MkDBRefTerm(record_at(MkFirst, DBRefOfTerm(t1), t2, Unsigned(0)));
}
if (Yap_Error_TYPE != YAP_NO_ERROR) {
if (recover_from_record_error(3)) {
t1 = Deref(ARG1);
@ -2100,6 +2165,7 @@ p_rcdz_at(void)
{
/* Idiotic xlc's cpp does not work with ARG1 within MkDBRefTerm */
Term TRef, t1 = Deref(ARG1), t2 = Deref(ARG2);
DBRef dbr;
if (!IsVarTerm(Deref(ARG3)))
return (FALSE);
@ -2113,7 +2179,16 @@ p_rcdz_at(void)
}
Yap_Error_Size = 0;
restart_record:
TRef = MkDBRefTerm(record_at(MkLast, DBRefOfTerm(t1), t2, Unsigned(0)));
dbr = DBRefOfTerm(t1);
if (dbr->Flags & ErasedMask) {
/* doesn't make sense */
return FALSE;
}
if (dbr->Flags & LogUpdMask) {
TRef = MkDBRefTerm((DBRef)record_lu_at(MkLast, (LogUpdClause *)dbr, t2));
} else {
TRef = MkDBRefTerm(record_at(MkLast, dbr, t2, Unsigned(0)));
}
if (Yap_Error_TYPE != YAP_NO_ERROR) {
if (recover_from_record_error(3)) {
t1 = Deref(ARG1);

2
C/exec.c
View File

@ -1296,7 +1296,7 @@ Yap_RunTopGoal(Term t)
if (Yap_TrailTop - HeapTop < 2048) {
Yap_PrologMode = BootMode;
Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,
"unable to boot because of too little heap space");
"unable to boot because of too little Trail space");
}
#endif
goal_out = do_goal(t, CodeAdr, arity, pt, TRUE);

79
C/index.c
View File

@ -11,8 +11,14 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2005-04-07 17:48:54 $,$Author: ricroc $ *
* Last rev: $Date: 2005-04-10 04:01:12 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.121 2005/04/07 17:48:54 ricroc
* Adding tabling support for mixed strategy evaluation (batched and local scheduling)
* UPDATE: compilation flags -DTABLING_BATCHED_SCHEDULING and -DTABLING_LOCAL_SCHEDULING removed. To support tabling use -DTABLING in the Makefile or --enable-tabling in configure.
* NEW: yap_flag(tabling_mode,MODE) changes the tabling execution mode of all tabled predicates to MODE (batched, local or default).
* NEW: tabling_mode(PRED,MODE) changes the default tabling execution mode of predicate PRED to MODE (batched or local).
*
* Revision 1.120 2005/03/15 18:29:23 vsc
* fix GPL
* fix idb: stuff in coroutines.
@ -526,8 +532,7 @@ sort_group(GroupDef *grp, CELL *top, struct intermediates *cint)
longjmp(cint->CompilerBotch,4);
#else
if (!Yap_growtrail(2*max*CellSize, TRUE)) {
Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld in growtrail",
2*max*CellSize);
longjmp(cint->CompilerBotch,4);
return;
}
#endif
@ -689,7 +694,7 @@ has_cut(yamop *pc)
pc = NEXTOP(pc,l);
break;
case _jump_if_nonvar:
pc = NEXTOP(pc,xl);
pc = NEXTOP(pc,xll);
break;
/* instructions type EC */
case _alloc_for_logical_pred:
@ -4655,17 +4660,17 @@ expand_index(struct intermediates *cint) {
}
break;
case _jump_if_nonvar:
argno = arg_from_x(ipc->u.xl.x);
argno = arg_from_x(ipc->u.xll.x);
t = Deref(XREGS[argno]);
i = 0;
/* expand_index expects to find the new argument */
if (!IsVarTerm(t)) {
argno--;
olabp = NULL;
labp = &(ipc->u.xl.l);
ipc = ipc->u.xl.l;
labp = &(ipc->u.xll.l1);
ipc = ipc->u.xll.l1;
} else {
ipc = NEXTOP(ipc,xl);
ipc = NEXTOP(ipc,xll);
}
break;
/* instructions type EC */
@ -4911,7 +4916,8 @@ expand_index(struct intermediates *cint) {
if (Yap_op_from_opcode((*labp)->opc) == _expand_clauses) {
/* ok, we know how many clauses */
yamop *ipc = *labp;
COUNT nclauses = ipc->u.sp.s2;
/* check all slots, not just the ones with values */
COUNT nclauses = ipc->u.sp.s1;
yamop **clp = (yamop **)NEXTOP(ipc,sp);
eblk = cint->expand_block = ipc;
@ -5516,7 +5522,7 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp0, PredEntry *
start = blk->ClCode;
op0 = Yap_op_from_opcode(start->opc);
while (op0 == _jump_if_nonvar) {
start = NEXTOP(start, xl);
start = NEXTOP(start, xll);
op0 = Yap_op_from_opcode(start->opc);
}
if ((op0 != _enter_lu_pred && op0 != _stale_lu_index)
@ -5828,7 +5834,7 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
while (op == _jump_if_nonvar) {
jnvs++;
begin = NEXTOP(begin, xl);
begin = NEXTOP(begin, xll);
op = Yap_op_from_opcode(begin->opc);
}
/* add half the current space plus 1, and also the extra clause */
@ -5844,13 +5850,13 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
sz = sizeof(LogUpdIndex)+
(xcls-1)*((UInt)NEXTOP((yamop *)NULL,l))+
((UInt)NEXTOP((yamop *)NULL,ld))+
jnvs*((UInt)NEXTOP((yamop *)NULL,xl))+
jnvs*((UInt)NEXTOP((yamop *)NULL,xll))+
(UInt)NEXTOP((yamop *)NULL,Ill)+
(UInt)NEXTOP((yamop *)NULL,p);
} else {
sz = sizeof(LogUpdIndex)+
xcls*((UInt)NEXTOP((yamop *)NULL,ld))+
jnvs*((UInt)NEXTOP((yamop *)NULL,xl))+
jnvs*((UInt)NEXTOP((yamop *)NULL,xll))+
(UInt)NEXTOP((yamop *)NULL,Ill)+
(UInt)NEXTOP((yamop *)NULL,p);
}
@ -5891,16 +5897,17 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
begin = blk->ClCode;
while (jnvs--) {
nbegin->opc = begin->opc;
nbegin->u.xl.x = begin->u.xl.x;
nbegin->u.xl.l = begin->u.xl.l;
if (nbegin->u.xl.l->opc == Yap_opcode(_expand_clauses)) {
nbegin->u.xll.x = begin->u.xll.x;
nbegin->u.xll.l1 = begin->u.xll.l1;
nbegin->u.xll.l2 = NEXTOP(nbegin,xll);
if (nbegin->u.xll.l1->opc == Yap_opcode(_expand_clauses)) {
if (!(blk->ClFlags & ErasedMask)) {
/* we haven't done erase yet */
nbegin->u.xl.l->u.sp.s3++;
nbegin->u.xll.l1->u.sp.s3++;
}
}
begin = NEXTOP(begin, xl);
nbegin = NEXTOP(nbegin, xl);
begin = NEXTOP(begin, xll);
nbegin = NEXTOP(nbegin, xll);
}
codep = start = nbegin;
/* ok, we've allocated and set up things, now let's finish */
@ -5991,7 +5998,7 @@ clean_up_index(LogUpdIndex *blk, yamop **jlbl, PredEntry *ap)
UInt ncls;
while (op == _jump_if_nonvar) {
codep = NEXTOP(codep, xl);
codep = NEXTOP(codep, xll);
op = Yap_op_from_opcode(codep->opc);
}
ncls = codep->u.Ill.s;
@ -6011,7 +6018,7 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
/* make sure this is something I can work with */
while (op == _jump_if_nonvar) {
begin = NEXTOP(begin, xl);
begin = NEXTOP(begin, xll);
op = Yap_op_from_opcode(begin->opc);
}
if (op != _enter_lu_pred && op != _stale_lu_index) {
@ -6115,7 +6122,7 @@ inserta_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
/* make sure this is something I can work with */
while (op == _jump_if_nonvar) {
begin = NEXTOP(begin, xl);
begin = NEXTOP(begin, xll);
op = Yap_op_from_opcode(begin->opc);
}
if (op != _enter_lu_pred && op != _stale_lu_index) {
@ -6524,8 +6531,9 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
ipc = NEXTOP(ipc,l);
break;
case _jump_if_nonvar:
sp = push_path(sp, &(ipc->u.xl.l), cls, cint);
ipc = NEXTOP(ipc,xl);
sp = push_path(sp, &(ipc->u.xll.l2), cls, cint);
sp = cross_block(sp, &ipc->u.xll.l1, ap);
ipc = ipc->u.xll.l1;
break;
/* instructions type EC */
case _try_in:
@ -7090,8 +7098,9 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
ipc = NEXTOP(ipc,l);
break;
case _jump_if_nonvar:
sp = push_path(sp, &(ipc->u.xl.l), cls, cint);
ipc = NEXTOP(ipc,xl);
sp = push_path(sp, &(ipc->u.xll.l2), cls, cint);
sp = cross_block(sp, &ipc->u.xll.l1, ap);
ipc = ipc->u.xll.l1;
break;
/* instructions type e */
case _switch_on_type:
@ -7769,12 +7778,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
break;
case _jump_if_nonvar:
{
Term t = Deref(XREGS[arg_from_x(ipc->u.xl.x)]);
Term t = Deref(XREGS[arg_from_x(ipc->u.xll.x)]);
if (!IsVarTerm(t)) {
jlbl = &(ipc->u.xl.l);
ipc = ipc->u.xl.l;
jlbl = &(ipc->u.xll.l1);
ipc = ipc->u.xll.l1;
} else {
ipc = NEXTOP(ipc,xl);
ipc = NEXTOP(ipc,xll);
}
}
break;
@ -8161,7 +8170,7 @@ Yap_NthClause(PredEntry *ap, Int ncls)
ipc = ipc->u.l.l;
break;
case _jump_if_nonvar:
ipc = NEXTOP(ipc,xl);
ipc = NEXTOP(ipc,xll);
break;
/* instructions type e */
case _switch_on_type:
@ -8269,10 +8278,10 @@ find_caller(PredEntry *ap, yamop *code, struct intermediates *cint) {
}
break;
case _jump_if_nonvar:
if (!IsVarTerm(XREGS[arg_from_x(ipc->u.xllll.x)])) {
ipc = ipc->u.xl.l;
if (!IsVarTerm(XREGS[arg_from_x(ipc->u.xll.x)])) {
ipc = ipc->u.xll.l1;
} else {
ipc = NEXTOP(ipc,xl);
ipc = NEXTOP(ipc,xll);
}
break;
/* instructions type EC */
@ -8507,7 +8516,7 @@ Yap_CleanUpIndex(LogUpdIndex *blk)
op_numbers op = Yap_op_from_opcode(start->opc);
while (op == _jump_if_nonvar) {
start = NEXTOP(start, xl);
start = NEXTOP(start, xll);
op = Yap_op_from_opcode(start->opc);
}
codep = start->u.Ill.l1;

7
H/YapOpcodes.h
View File

@ -11,8 +11,11 @@
* File: YapOpcodes.h *
* comments: Central Table with all YAP opcodes *
* *
* Last rev: $Date: 2004-10-26 20:16:04 $ *
* Last rev: $Date: 2005-04-10 04:01:13 $ *
* $Log: not supported by cvs2svn $
* Revision 1.25 2004/10/26 20:16:04 vsc
* More bug fixes for overflow handling
*
* Revision 1.24 2004/09/27 20:45:04 vsc
* Mega clauses
* Fixes to sizeof(expand_clauses) which was being overestimated
@ -183,7 +186,7 @@
OPCODE(trust ,ld),
OPCODE(try_in ,l),
OPCODE(jump_if_var ,l),
OPCODE(jump_if_nonvar ,xl),
OPCODE(jump_if_nonvar ,xll),
OPCODE(switch_on_cons ,sssl),
OPCODE(switch_on_type ,llll),
OPCODE(switch_list_nl ,ollll),

10
H/amidefs.h
View File

@ -11,8 +11,11 @@
* File: amidefs.h *
* comments: Abstract machine peculiarities *
* *
* Last rev: $Date: 2004-09-30 21:37:41 $ *
* Last rev: $Date: 2005-04-10 04:01:13 $ *
* $Log: not supported by cvs2svn $
* Revision 1.26 2004/09/30 21:37:41 vsc
* fixes for thread support
*
* Revision 1.25 2004/09/27 20:45:04 vsc
* Mega clauses
* Fixes to sizeof(expand_clauses) which was being overestimated
@ -476,9 +479,10 @@ typedef struct yami {
} xF;
struct {
wamreg x;
struct yami *l;
struct yami *l1;
struct yami *l2;
CELL next;
} xl;
} xll;
struct {
wamreg xl;
wamreg xr;

2
H/clause.h
View File

@ -256,7 +256,7 @@ same_lu_block(yamop **paddr, yamop *p)
OPCODE jmp_op = Yap_opcode(_jump_if_nonvar);
while (np->opc == jmp_op) {
np = NEXTOP(np, xl);
np = NEXTOP(np, xll);
if (np == p) return TRUE;
}
return FALSE;

14
H/rclause.h
View File

@ -12,8 +12,13 @@
* File: rclause.h *
* comments: walk through a clause *
* *
* Last rev: $Date: 2005-01-04 02:50:21 $,$Author: vsc $ *
* Last rev: $Date: 2005-04-10 04:01:13 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.1 2005/01/04 02:50:21 vsc
* - allow MegaClauses with blobs
* - change Diffs to be thread specific
* - include Christian's updates
*
* Revision 1.47 2004/12/02 06:06:47 vsc
* fix threads so that they at least start
* allow error handling to work with threads
@ -166,9 +171,10 @@ restore_opcodes(yamop *pc)
break;
/* instructions type EC */
case _jump_if_nonvar:
pc->u.xl.l = PtoOpAdjust(pc->u.xl.l);
pc->u.xl.x = XAdjust(pc->u.xl.x);
pc = NEXTOP(pc,xl);
pc->u.xll.l1 = PtoOpAdjust(pc->u.xll.l1);
pc->u.xll.l2 = PtoOpAdjust(pc->u.xll.l2);
pc->u.xll.x = XAdjust(pc->u.xll.x);
pc = NEXTOP(pc,xll);
break;
/* instructions type EC */
case _alloc_for_logical_pred:

36
LGPL/JPL/src/jpl.c
View File

@ -1,4 +1,4 @@
/* $Id: jpl.c,v 1.3 2005-03-15 18:29:24 vsc Exp $
/* $Id: jpl.c,v 1.4 2005-04-10 04:01:13 vsc Exp $
Part of JPL -- SWI-Prolog/Java interface
@ -1740,8 +1740,8 @@ jni_fetch_buffer_value_plc(
&& PL_unify_float(tv1,((jfloat*)bp)[i]);
case JNI_XPUT_DOUBLE:
return PL_unify_integer(tv2,((int*)&((jdouble*)bp)[i])[1])
&& PL_unify_integer(tv1,((int*)&((jdouble*)bp)[i])[0]);
return PL_unify_integer(tv2,0)
&& YAP_Unify(YAP_GetFromSlot(tv1),YAP_MkFloatTerm(((jdouble*)bp)[i]));
default:
return FALSE;
}
@ -2170,6 +2170,35 @@ jni_void_2_plc(
}
/*
%T jni_SetByteArrayElement(+term, +term, +term)
*/
static foreign_t
jni_SetByteArrayElement(
term_t ta1, // +Arg1
term_t ta2, // +Arg2
term_t ta3 // +Arg3
)
{
jboolean r; // Prolog exit/fail outcome
jbyteArray p1;
jint i2;
jbyte i3;
if ( !jni_ensure_jvm() )
{
return FALSE;
}
r =
JNI_term_to_byte_jarray(env,ta1,&p1)
&& JNI_term_to_jint(ta2,&i2)
&& JNI_term_to_jbyte(ta3,&i3)
&& ( (*env)->SetByteArrayRegion(env,p1,i2,1,&i3) , TRUE );
return jni_check_exception() && r;
}
/*
%T jni_void( +integer, +term, +term, +term)
*/
@ -3865,6 +3894,7 @@ PL_extension predspecs[] =
{ "jni_func", 4, jni_func_2_plc, 0 },
{ "jni_func", 5, jni_func_3_plc, 0 },
{ "jni_func", 6, jni_func_4_plc, 0 },
{ "jni_SetByteArrayElement", 3, jni_SetByteArrayElement, 0 },
{ "jpl_c_lib_version", 1, jpl_c_lib_version_1_plc, 0 },
{ "jpl_c_lib_version", 4, jpl_c_lib_version_4_plc, 0 },
{ NULL, 0, NULL, 0 }

6
configure vendored
View File

@ -2263,7 +2263,7 @@ if test "${enable_dynamic_loading+set}" = set; then
else
dynamic_loading=no
fi;
# Check whether --enable-use_malloc or --disable-use_malloc was given.
# Check whether --enable-use-malloc or --disable-use-malloc was given.
if test "${enable_use_malloc+set}" = set; then
enableval="$enable_use_malloc"
use_malloc="$enableval"
@ -2318,13 +2318,13 @@ if test "${with_jpl+set}" = set; then
if test "$withval" = yes; then
yap_cv_jpl="$JAVA_HOME"
dynamic_loading=yes
threads=yes
maxmemory=yes
elif test "$withval" = no; then
yap_cv_jpl=no
else
yap_cv_jpl=$with_jpl
dynamic_loading=yes
threads=yes
maxmemory=yes
fi
else
yap_cv_jpl=no

10
configure.in
View File

@ -1,4 +1,4 @@
dnl
Mdnl
dnl Process this file with autoconf to produce a configure script.
dnl
@ -57,7 +57,7 @@ AC_ARG_ENABLE(cygwin,
AC_ARG_ENABLE(dynamic_loading,
[ --enable-dynamic-loading compile Yap as a DLL ],
dynamic_loading="$enableval", dynamic_loading=no)
AC_ARG_ENABLE(use_malloc,
AC_ARG_ENABLE(use-malloc,
[ --enable-use-malloc use malloc to allocate memory ],
use_malloc="$enableval", use_malloc=no)
AC_ARG_ENABLE(condor,
@ -90,13 +90,15 @@ AC_ARG_WITH(jpl,
if test "$withval" = yes; then
yap_cv_jpl="$JAVA_HOME"
dynamic_loading=yes
threads=yes
maxmemory=yes
dnl threads=yes
elif test "$withval" = no; then
yap_cv_jpl=no
else
yap_cv_jpl=$with_jpl
dynamic_loading=yes
threads=yes
maxmemory=yes
dnl threads=yes
fi,
[yap_cv_jpl=no])

2
console/yap.c
View File

@ -250,7 +250,7 @@ static int
parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
{
char *p;
#if SUPPORT_CONDOR||SUPPORT_THREADS
#if USE_SYSTEM_MALLOC
int BootMode = YAP_FULL_BOOT_FROM_PROLOG;
#else
int BootMode = YAP_BOOT_FROM_SAVED_CODE;

2
distribute
View File

@ -83,7 +83,7 @@ cd examples
splat
cd ../../../..
if test "$1" = "--small"; then
tar cvzf "$version"-small.tar.gz --exclude=CVS --exclude=CHR/chr/examples --exclude=CLPQR/clpqr/examples "$version"/{Artistic,INSTALL,README*,changes*,config*,install-sh,Makefile.in,.depend.in,distribute,C,H,VC,console,docs,include,library,m4,misc,pl,LGPL/README,LGPL/pillow/[C-Z]*,LGPL/pillow/*.pl,LGPL/pillow/doc/*info*,LGPL/JPL/jpl.yap,LGPL/JPL/Makefile.in,LGPL/JPL/java,LGPL/JPL/src,build-distr,OPTYap,CLPQR,CHR,CLPBN}
tar cvzf "$version"-small.tar.gz --exclude=CVS "$version"/{Artistic,INSTALL,README*,changes*,config*,install-sh,Makefile.in,.depend.in,distribute,C,H,VC,console,docs,include,library,m4,misc,pl,LGPL/README,LGPL/pillow/[C-Z]*,LGPL/pillow/*.pl,LGPL/pillow/doc/*info*,LGPL/JPL/jpl.yap,LGPL/JPL/jpl_paths.yap.in,LGPL/JPL/Makefile.in,LGPL/JPL/java,LGPL/JPL/src,build-distr,OPTYap,CLPQR,CHR,CLPBN} # --exclude=CLPQR/clpqr/examples --exclude=CHR/chr/examples
else
tar cvzf "$version".tar.gz --exclude=CVS "$version"/{Artistic,INSTALL,README*,changes*,config*,install-sh,Makefile.in,.depend.in,distribute,C,H,VC,console,docs,include,library,m4,misc,pl,LGPL/README,LGPL/pillow/[C-Z]*,LGPL/pillow/*.pl,LGPL/pillow/doc/*info*,LGPL/JPL/jpl.yap,LGPL/JPL/Makefile.in,LGPL/JPL/java,LGPL/JPL/src,build-distr,build-distr,OPTYap,CLPQR,CHR,CLPBN,Logtalk}
fi

7
docs/yap.tex
View File

@ -5959,6 +5959,13 @@ must be an atom (named array). The @var{Size} must evaluate to an
integer. The @var{Type} must be bound to one of types mentioned
previously.
@item static_array_location(+@var{Name}, -@var{Ptr})
@findex static_array_location/4
@snindex static_array_location/4
@cnindex static_array_location/4
Give the location for a static array with name
@var{Name}.
@item static_array_properties(?@var{Name}, ?@var{Size}, ?@var{Type})
@findex static_array_properties/3
@snindex static_array_properties/3

8
library/swi.yap
View File

@ -52,11 +52,11 @@ do_volatile(_,_).
:- use_module(library(lists)).
absolute_file_name(jar(File), Opts, Path) :- !,
absolute_file_name(jar(File), _Opts, Path) :- !,
absolute_file_name(library(File), Path).
absolute_file_name(library(File), Opts, Path) :- !,
absolute_file_name(library(File), _Opts, Path) :- !,
absolute_file_name(library(File), Path).
absolute_file_name(File, Opts, Path) :-
absolute_file_name(File, _Opts, Path) :-
absolute_file_name(File, Path).
@ -94,7 +94,7 @@ do_forall(X,Y) :-
do_forall(_,_).
do_for_forall(Y) :- call(Y), !, fail.
do_for_forall(Y) :- throw(fail_forall).
do_for_forall(_) :- throw(fail_forall).
between(I,_,I).
between(I0,I,J) :- I0 < I,