From 056ccbc81932040e257584c8a46e169ac5b15072 Mon Sep 17 00:00:00 2001 From: vsc Date: Sun, 10 Apr 2005 04:01:15 +0000 Subject: [PATCH] bug fixes, I hope! git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1270 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/absmi.c | 22 +++++++----- C/amasm.c | 16 +++++---- C/arrays.c | 30 ++++++++++++++++ C/c_interface.c | 11 ++++-- C/cdmgr.c | 15 +++++--- C/compiler.c | 30 ++++++---------- C/dbase.c | 85 +++++++++++++++++++++++++++++++++++++++++++--- C/exec.c | 2 +- C/index.c | 79 +++++++++++++++++++++++------------------- H/YapOpcodes.h | 7 ++-- H/amidefs.h | 10 ++++-- H/clause.h | 2 +- H/rclause.h | 14 +++++--- LGPL/JPL/src/jpl.c | 36 ++++++++++++++++++-- configure | 6 ++-- configure.in | 10 +++--- console/yap.c | 2 +- distribute | 2 +- docs/yap.tex | 7 ++++ library/swi.yap | 8 ++--- 20 files changed, 286 insertions(+), 108 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 98331c0a4..85afa4385 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -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(); diff --git a/C/amasm.c b/C/amasm.c index 803950cd2..eeeebc16b 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -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 */ diff --git a/C/arrays.c b/C/arrays.c index 36cc0ef27..5d9c07e2f 100644 --- a/C/arrays.c +++ b/C/arrays.c @@ -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); } diff --git a/C/c_interface.c b/C/c_interface.c index 046be1094..942d17f76 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -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); diff --git a/C/cdmgr.c b/C/cdmgr.c index 1f3c54649..82f854a02 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -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 */ diff --git a/C/compiler.c b/C/compiler.c index 139b95181..2e2780779 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -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 */ diff --git a/C/dbase.c b/C/dbase.c index d591db9dc..07a9e1576 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -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); diff --git a/C/exec.c b/C/exec.c index 818ef81b7..0b9e7a387 100644 --- a/C/exec.c +++ b/C/exec.c @@ -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); diff --git a/C/index.c b/C/index.c index a5845c8e0..65e3412e3 100644 --- a/C/index.c +++ b/C/index.c @@ -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; diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index d411710d9..a4cff76ec 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -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), diff --git a/H/amidefs.h b/H/amidefs.h index de9aeefa1..1f3180b3f 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -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; diff --git a/H/clause.h b/H/clause.h index 468880884..3dd2d5460 100644 --- a/H/clause.h +++ b/H/clause.h @@ -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; diff --git a/H/rclause.h b/H/rclause.h index 863f23cbe..544753824 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -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: diff --git a/LGPL/JPL/src/jpl.c b/LGPL/JPL/src/jpl.c index 864bd2732..4f9955e08 100644 --- a/LGPL/JPL/src/jpl.c +++ b/LGPL/JPL/src/jpl.c @@ -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 } diff --git a/configure b/configure index 2536e5e96..b2264062f 100755 --- a/configure +++ b/configure @@ -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 diff --git a/configure.in b/configure.in index 6507012f2..25bb3068a 100644 --- a/configure.in +++ b/configure.in @@ -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]) diff --git a/console/yap.c b/console/yap.c index 6b26f7cdd..9fa103440 100644 --- a/console/yap.c +++ b/console/yap.c @@ -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; diff --git a/distribute b/distribute index e7de3f92a..09109c7ae 100755 --- a/distribute +++ b/distribute @@ -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 diff --git a/docs/yap.tex b/docs/yap.tex index 4ef1c315d..49489c92e 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -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 diff --git a/library/swi.yap b/library/swi.yap index 51a7c8ddd..2184df3a8 100644 --- a/library/swi.yap +++ b/library/swi.yap @@ -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,