diff --git a/C/amasm.c b/C/amasm.c index 366a05972..19764850b 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -2079,6 +2079,7 @@ do_pass(void) } else { /* static clause */ if (pass_no) { + cl_u->sc.Id = FunctorDBRef; cl_u->sc.ClFlags = 0; cl_u->sc.Owner = Yap_ConsultingFile(); if (clause_has_blobs) { @@ -2441,7 +2442,7 @@ do_pass(void) longjmp(Yap_CompilerBotch, 3); } - if ( (char *)(label_offset+cpc->rnd1) > freep) + if ( (char *)(label_offset+cpc->rnd1) >= freep) freep = (char *)(label_offset+(cpc->rnd1+1)); label_offset[cpc->rnd1] = (CELL) code_p; } @@ -2650,15 +2651,44 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact) !is_fact) { DBTerm *x; LogUpdClause *cl; + CELL *h0 = H; + + H = (CELL *)freep; while ((x = Yap_StoreTermInDBPlusExtraSpace(t, size)) == NULL) { + H = h0; if (!Yap_growheap(TRUE, size)) { Yap_Error_TYPE = SYSTEM_ERROR; return NULL; } + h0 = H; + H = (CELL *)freep; } + H = h0; cl = (LogUpdClause *)((CODEADDR)x-(UInt)size); cl->ClSource = x; code_addr = (yamop *)cl; + } else if (mode == ASSEMBLING_CLAUSE && + (ap->PredFlags & SourcePredFlag || + (!ap->cs.p_code.NOfClauses && yap_flags[SOURCE_MODE_FLAG])) && + !is_fact) { + DBTerm *x; + StaticClause *cl; + CELL *h0 = H; + + H = (CELL *)freep; + while ((x = Yap_StoreTermInDBPlusExtraSpace(t, size)) == NULL) { + H = h0; + if (!Yap_growheap(TRUE, size)) { + Yap_Error_TYPE = SYSTEM_ERROR; + return NULL; + } + h0 = H; + H = (CELL *)freep; + } + H = h0; + cl = (StaticClause *)((CODEADDR)x-(UInt)size); + cl->ClSource = x; + code_addr = (yamop *)cl; } else { while ((code_addr = (yamop *) Yap_AllocCodeSpace(size)) == NULL) { if (!Yap_growheap(TRUE, size)) { @@ -2667,7 +2697,6 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact) } } } - // fprintf(stderr,"vsc: asking for %p\n",code_addr); entry_code = do_pass(); YAPLeaveCriticalSection(); #ifdef LOW_PROF diff --git a/C/c_interface.c b/C/c_interface.c index b6d094ec4..d25a0b45a 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -843,7 +843,7 @@ YAP_CompileClause(Term t) Yap_ErrorMessage = NULL; ARG1 = t; - codeaddr = Yap_cclause (t,0, mod); + codeaddr = Yap_cclause (t,0, mod, t); if (codeaddr != NULL) { t = Deref(ARG1); /* just in case there was an heap overflow */ Yap_addclause (t, codeaddr, TRUE, mod); diff --git a/C/cdmgr.c b/C/cdmgr.c index 6b3a23e26..7c55c6b22 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1133,7 +1133,7 @@ addcl_permission_error(AtomEntry *ap, Int Arity, int in_use) static Term -addclause(Term t, yamop *cp, int mode, int mod, Term src) +addclause(Term t, yamop *cp, int mode, int mod) /* * mode @@ -1201,8 +1201,10 @@ addclause(Term t, yamop *cp, int mode, int mod, Term src) StaticClause *clp = ClauseCodeToStaticClause(cp); clp->ClFlags |= StaticMask; if (IsAtomTerm(t) || - FunctorOfTerm(t) != FunctorAssert) + FunctorOfTerm(t) != FunctorAssert) { clp->ClFlags |= FactMask; + clp->ClSource = NULL; + } } if (compile_mode) p->PredFlags = pflags | CompiledPredFlag | FastPredFlag; @@ -1246,7 +1248,7 @@ addclause(Term t, yamop *cp, int mode, int mod, Term src) void Yap_addclause(Term t, yamop *cp, int mode, int mod) { - addclause(t, cp, mode, mod, t); + addclause(t, cp, mode, mod); } void @@ -1408,11 +1410,11 @@ p_compile(void) if (IsVarTerm(t3) || !IsAtomTerm(t3)) return (FALSE); mod = Yap_LookupModule(t3); - codeadr = Yap_cclause(t, 2, mod); /* vsc: give the number of arguments + codeadr = Yap_cclause(t, 2, mod, Deref(ARG3)); /* vsc: give the number of arguments to cclause in case there is overflow */ t = Deref(ARG1); /* just in case there was an heap overflow */ if (!Yap_ErrorMessage) - addclause(t, codeadr, (int) (IntOfTerm(t1) & 3), mod, Deref(ARG3)); + addclause(t, codeadr, (int) (IntOfTerm(t1) & 3), mod); if (Yap_ErrorMessage) { if (IntOfTerm(t1) & 4) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, @@ -1441,13 +1443,13 @@ p_compile_dynamic(void) old_optimize = optimizer_on; optimizer_on = FALSE; mod = Yap_LookupModule(t3); - code_adr = Yap_cclause(t, 3, mod); /* vsc: give the number of arguments to + code_adr = Yap_cclause(t, 3, mod, Deref(ARG3)); /* vsc: give the number of arguments to cclause() in case there is a overflow */ t = Deref(ARG1); /* just in case there was an heap overflow */ if (!Yap_ErrorMessage) { optimizer_on = old_optimize; - t = addclause(t, code_adr, (int) (IntOfTerm(t1) & 3), mod, Deref(ARG3)); + t = addclause(t, code_adr, (int) (IntOfTerm(t1) & 3), mod); } else { if (IntOfTerm(t1) & 4) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, "line %d, %s", Yap_FirstLineInParse(), Yap_ErrorMessage); @@ -1902,6 +1904,33 @@ p_is_log_updatable(void) return(out); } +static Int +p_is_source(void) +{ /* '$is_dynamic'(+P) */ + PredEntry *pe; + Term t = Deref(ARG1); + Term t2 = Deref(ARG2); + Int out; + SMALLUNSGN mod = Yap_LookupModule(t2); + + if (IsVarTerm(t)) { + return (FALSE); + } else if (IsAtomTerm(t)) { + Atom at = AtomOfTerm(t); + pe = RepPredProp(PredPropByAtom(at, mod)); + } else if (IsApplTerm(t)) { + Functor fun = FunctorOfTerm(t); + pe = RepPredProp(PredPropByFunc(fun, mod)); + } else + return (FALSE); + if (pe == NIL) + return (FALSE); + READ_LOCK(pe->PRWLock); + out = (pe->PredFlags & SourcePredFlag); + READ_UNLOCK(pe->PRWLock); + return(out); +} + static Int p_is_dynamic(void) { /* '$is_dynamic'(+P) */ @@ -2980,7 +3009,7 @@ get_pred(Term t1, Term tmod, char *command) static Int fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time) { - LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, tr, NextClause(PredLogUpdClause->cs.p_code.FirstClause), cp_ptr); + LogUpdClause *cl = Yap_follow_indexing_code(pe, i_code, th, tb, tr, NextClause(PredLogUpdClause->cs.p_code.FirstClause), cp_ptr); Term rtn; if (cl == NULL) @@ -2998,24 +3027,26 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya } #endif if (cl->ClFlags & FactMask) { - Functor f = FunctorOfTerm(th); - UInt arity = ArityOfFunctor(f), i; - CELL *pt = RepAppl(th)+1; - if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) || !Yap_unify(tr, rtn)) return FALSE; - for (i=0; iArityOfPE) { + Functor f = FunctorOfTerm(th); + UInt arity = ArityOfFunctor(f), i; + CELL *pt = RepAppl(th)+1; + + for (i=0; iClCode; } - /* don't need no ENV */ - if (first_time) { - CP = P; - ENV = YENV; - YENV = ASP; - YENV[E_CB] = (CELL) B; - } - P = cl->ClCode; return TRUE; } else { Term t; @@ -3048,6 +3079,9 @@ p_log_update_clause(void) pe = get_pred(t1, Deref(ARG2), "clause/3"); if (pe == NULL || EndOfPAEntr(pe)) return FALSE; + if(pe->OpcodeOfPred == INDEX_OPCODE) { + IPred(pe); + } return fetch_next_lu_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE); } @@ -3063,28 +3097,30 @@ p_continue_log_update_clause(void) static Int fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time) { - LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, TermNil, NextClause(PredLogUpdClause0->cs.p_code.FirstClause), cp_ptr); + LogUpdClause *cl = Yap_follow_indexing_code(pe, i_code, th, tb, TermNil, NextClause(PredLogUpdClause0->cs.p_code.FirstClause), cp_ptr); if (cl == NULL) return FALSE; if (cl->ClFlags & FactMask) { - Functor f = FunctorOfTerm(th); - UInt arity = ArityOfFunctor(f), i; - CELL *pt = RepAppl(th)+1; - if (!Yap_unify(tb, MkAtomTerm(AtomTrue))) return FALSE; - for (i=0; iArityOfPE) { + Functor f = FunctorOfTerm(th); + UInt arity = ArityOfFunctor(f), i; + CELL *pt = RepAppl(th)+1; + + for (i=0; iClCode; } - /* don't need no ENV */ - if (first_time) { - CP = P; - ENV = YENV; - YENV = ASP; - YENV[E_CB] = (CELL) B; - } - P = cl->ClCode; return TRUE; } else { Term t; @@ -3116,6 +3152,9 @@ p_log_update_clause0(void) pe = get_pred(t1, Deref(ARG2), "clause/3"); if (pe == NULL || EndOfPAEntr(pe)) return FALSE; + if(pe->OpcodeOfPred == INDEX_OPCODE) { + IPred(pe); + } return fetch_next_lu_clause0(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE); } @@ -3128,6 +3167,84 @@ p_continue_log_update_clause0(void) return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE); } +static Int +fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time) +{ + StaticClause *cl = (StaticClause *)Yap_follow_indexing_code(pe, i_code, th, tb, tr, NextClause(PredStaticClause->cs.p_code.FirstClause), cp_ptr); + Term rtn; + + if (cl == NULL) + return FALSE; + rtn = MkDBRefTerm((DBRef)cl); + if (cl->ClFlags & FactMask) { + if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) || + !Yap_unify(tr, rtn)) + return FALSE; + + if (pe->ArityOfPE) { + Functor f = FunctorOfTerm(th); + UInt arity = ArityOfFunctor(f), i; + CELL *pt = RepAppl(th)+1; + + for (i=0; iClCode,ld); + } + return TRUE; + } else { + Term t; + + while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) { + if (first_time) { + if (!Yap_gc(4, YENV, P)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + return FALSE; + } + } else { + if (!Yap_gc(5, ENV, CP)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + return FALSE; + } + } + } + return(Yap_unify(th, ArgOfTerm(1,t)) && + Yap_unify(tb, ArgOfTerm(2,t)) && + Yap_unify(tr, rtn)); + } +} + +static Int /* $hidden_predicate(P) */ +p_static_clause(void) +{ + PredEntry *pe; + Term t1 = Deref(ARG1); + + pe = get_pred(t1, Deref(ARG2), "clause/3"); + if (pe == NULL || EndOfPAEntr(pe)) + return FALSE; + if(pe->OpcodeOfPred == INDEX_OPCODE) { + IPred(pe); + } + return fetch_next_static_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE); +} + +static Int /* $hidden_predicate(P) */ +p_continue_static_clause(void) +{ + PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1)); + yamop *ipc = (yamop *)IntegerOfTerm(ARG2); + + return fetch_next_static_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE); +} + #ifdef LOW_PROF static void @@ -3302,6 +3419,7 @@ Yap_InitCdMgr(void) Yap_InitCPred("$in_use", 2, p_in_use, TestPredFlag | SafePredFlag|SyncPredFlag); Yap_InitCPred("$is_dynamic", 2, p_is_dynamic, TestPredFlag | SafePredFlag); Yap_InitCPred("$is_log_updatable", 2, p_is_log_updatable, TestPredFlag | SafePredFlag); + Yap_InitCPred("$is_source", 2, p_is_source, TestPredFlag | SafePredFlag); Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag); Yap_InitCPred("$number_of_clauses", 3, p_number_of_clauses, SafePredFlag|SyncPredFlag); Yap_InitCPred("$undefined", 2, p_undefined, SafePredFlag|TestPredFlag); @@ -3333,7 +3451,8 @@ Yap_InitCdMgr(void) Yap_InitCPred("$continue_log_update_clause", 5, p_continue_log_update_clause, SafePredFlag|SyncPredFlag); Yap_InitCPred("$log_update_clause", 3, p_log_update_clause0, SyncPredFlag); Yap_InitCPred("$continue_log_update_clause", 4, p_continue_log_update_clause0, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$continue_log_update_clause", 4, p_continue_log_update_clause0, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$static_clause", 4, p_static_clause, SyncPredFlag); + Yap_InitCPred("$continue_static_clause", 5, p_continue_static_clause, SafePredFlag|SyncPredFlag); Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag); } diff --git a/C/compiler.c b/C/compiler.c index dae9fe051..5811e41c1 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -2703,7 +2703,7 @@ c_optimize(PInstr *pc) } yamop * -Yap_cclause(Term inp_clause, int NOfArgs, int mod) +Yap_cclause(Term inp_clause, int NOfArgs, int mod, Term src) { /* compile a prolog clause, copy of clause myst be in ARG1 */ /* returns address of code for clause */ Term head, body; @@ -2868,7 +2868,7 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod) Yap_ShowCode(); #endif /* phase 3: assemble code */ - acode = Yap_assemble(ASSEMBLING_CLAUSE, inp_clause, CurrentPred, body == MkAtomTerm(AtomTrue)); + acode = Yap_assemble(ASSEMBLING_CLAUSE, src, CurrentPred, body == MkAtomTerm(AtomTrue)); /* check first if there was space for us */ diff --git a/C/index.c b/C/index.c index baac300d8..26e89a362 100644 --- a/C/index.c +++ b/C/index.c @@ -6010,6 +6010,21 @@ lu_clause(yamop *ipc) return c; } +static LogUpdClause * +static_clause(yamop *ipc) +{ + StaticClause *c; + CELL *p = (CELL *)ipc; + + if (ipc == FAILCODE) + return NULL; + while ((c = ClauseCodeToStaticClause(p))->Id != FunctorDBRef || + (c->ClFlags & (LogUpdMask|IndexMask|DynamicMask|SwitchTableMask|SwitchRootMask))) { + p--; + } + return (LogUpdClause *)c; +} + static void store_clause_choice_point(Term t1, Term tb, Term tr, yamop *ipc, PredEntry *pe, yamop *ap_pc, yamop *cp_pc) { @@ -6052,7 +6067,7 @@ update_clause_choice_point(yamop *ipc, yamop *ap_pc) } LogUpdClause * -Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yamop *ap_pc, yamop *cp_pc) +Yap_follow_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yamop *ap_pc, yamop *cp_pc) { CELL *tar = RepAppl(t1); UInt i; @@ -6061,6 +6076,7 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr yamop *start_pc = ipc; choiceptr b0 = NULL; yamop **jlbl = NULL; + int lu_pred = ap->PredFlags & LogUpdatePredFlag; if (ap->ModuleOfPred != 2) { /* makes no sense for IDB, as ArityOfPE means nothing */ @@ -6068,7 +6084,7 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr XREGS[i] = tar[i]; } } - /* try to refine the interval using the indexing code */ + /* try to refine the interval using the indexing code */ while (ipc != NULL) { op_numbers op = Yap_op_from_opcode(ipc->opc); @@ -6082,7 +6098,10 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr store_clause_choice_point(t1, tb, tr, NEXTOP(ipc,ld), ap, ap_pc, cp_pc); else update_clause_choice_point(NEXTOP(ipc,ld), ap_pc); - return lu_clause(ipc->u.ld.d); + if (lu_pred) + return lu_clause(ipc->u.ld.d); + else + return static_clause(ipc->u.ld.d); case _try_me: case _try_me1: case _try_me2: @@ -6099,7 +6118,10 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr case _retry_profiled: case _count_retry: update_clause_choice_point(NEXTOP(ipc,ld),ap_pc); - return lu_clause(ipc->u.ld.d); + if (lu_pred) + return lu_clause(ipc->u.ld.d); + else + return static_clause(ipc->u.ld.d); case _retry_me: case _retry_me1: case _retry_me2: @@ -6119,7 +6141,10 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr abolish_incomplete_subgoals(B); #endif /* TABLING */ b0 = B; - return lu_clause(ipc->u.ld.d); + if (lu_pred) + return lu_clause(ipc->u.ld.d); + else + return static_clause(ipc->u.ld.d); case _profiled_trust_me: case _trust_me: case _count_trust_me: @@ -6363,7 +6388,10 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr #endif /* TABLING */ /* I did a trust */ } - return lu_clause(ipc); + if (lu_pred) + return lu_clause(ipc); + else + return static_clause(ipc); } } if (b0) { diff --git a/C/init.c b/C/init.c index bd44e8710..114e33242 100644 --- a/C/init.c +++ b/C/init.c @@ -979,7 +979,7 @@ InitCodes(void) heap_regs->pred_recorded_with_key = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$recorded_with_key"),3),0)); heap_regs->pred_log_upd_clause = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_log_upd_clause"),5),0)); heap_regs->pred_log_upd_clause0 = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_log_upd_clause"),4),0)); - heap_regs->pred_log_upd_retract = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_log_upd_retract"),4),0)); + heap_regs->pred_static_clause = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_static_clause"),5),0)); heap_regs->pred_throw = RepPredProp(PredPropByFunc(FunctorThrow,0)); heap_regs->pred_handle_throw = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$handle_throw"),3),0)); heap_regs->pred_goal_expansion = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("goal_expansion"),3),1)); diff --git a/C/tracer.c b/C/tracer.c index 4d18a711c..70dd3917b 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -115,6 +115,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) /* extern int gc_calls; */ vsc_count++; + if (vsc_count == 121085) + vsc_xstop = 1; + if (vsc_count < 121000LL) + return; #ifdef COMMENTED if (port != enter_pred || !pred || diff --git a/H/Heap.h b/H/Heap.h index 178f07eed..393d8bdb3 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.47 2003-11-12 12:33:31 vsc Exp $ * +* version: $Id: Heap.h,v 1.48 2003-11-21 16:56:20 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -293,7 +293,7 @@ typedef struct various_codes { struct pred_entry *pred_recorded_with_key; struct pred_entry *pred_log_upd_clause; struct pred_entry *pred_log_upd_clause0; - struct pred_entry *pred_log_upd_retract; + struct pred_entry *pred_static_clause; struct pred_entry *pred_throw; struct pred_entry *pred_handle_throw; struct array_entry *dyn_array_list; @@ -533,7 +533,7 @@ typedef struct various_codes { #define PredRecordedWithKey heap_regs->pred_recorded_with_key #define PredLogUpdClause heap_regs->pred_log_upd_clause #define PredLogUpdClause0 heap_regs->pred_log_upd_clause0 -#define PredLogUpdRetract heap_regs->pred_log_upd_retract +#define PredStaticClause heap_regs->pred_static_clause #define PredThrow heap_regs->pred_throw #define PredHandleThrow heap_regs->pred_handle_throw #define DynArrayList heap_regs->dyn_array_list diff --git a/H/Yapproto.h b/H/Yapproto.h index 533664e08..c9c85c193 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -10,7 +10,7 @@ * File: Yap.proto * * mods: * * comments: Function declarations for YAP * -* version: $Id: Yapproto.h,v 1.40 2003-11-12 12:33:31 vsc Exp $ * +* version: $Id: Yapproto.h,v 1.41 2003-11-21 16:56:20 vsc Exp $ * *************************************************************************/ /* prototype file for Yap */ @@ -118,7 +118,7 @@ int STD_PROTO(Yap_compare_terms,(Term,Term)); void STD_PROTO(Yap_InitCmpPreds,(void)); /* compiler.c */ -yamop *STD_PROTO(Yap_cclause,(Term, int, int)); +yamop *STD_PROTO(Yap_cclause,(Term, int, int, Term)); /* computils.c */ diff --git a/H/clause.h b/H/clause.h index ef16db6da..e3bf8a04d 100644 --- a/H/clause.h +++ b/H/clause.h @@ -106,7 +106,9 @@ typedef struct static_index { typedef struct static_clause { /* A set of flags describing info on the clause */ + Functor Id; CELL ClFlags; + DBTerm *ClSource; Atom Owner; /* The instructions, at least one of the form sl */ yamop ClCode[MIN_ARRAY]; @@ -185,7 +187,7 @@ yamop *STD_PROTO(Yap_ExpandIndex,(PredEntry *)); 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_follow_lu_indexing_code,(PredEntry *,yamop *,Term,Term,Term, yamop *,yamop *)); +LogUpdClause *STD_PROTO(Yap_follow_indexing_code,(PredEntry *,yamop *,Term,Term,Term, yamop *,yamop *)); #if LOW_PROF /* profiling */ diff --git a/H/rheap.h b/H/rheap.h index d6c7c6a5b..a6e3e9eeb 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -309,6 +309,10 @@ restore_codes(void) (PredEntry *)AddrAdjust((ADDR)heap_regs->pred_recorded_with_key); heap_regs->pred_log_upd_clause = (PredEntry *)AddrAdjust((ADDR)heap_regs->pred_log_upd_clause); + heap_regs->pred_log_upd_clause0 = + (PredEntry *)AddrAdjust((ADDR)heap_regs->pred_log_upd_clause0); + heap_regs->pred_static_clause = + (PredEntry *)AddrAdjust((ADDR)heap_regs->pred_static_clause); heap_regs->pred_throw = (PredEntry *)AddrAdjust((ADDR)heap_regs->pred_throw); heap_regs->pred_handle_throw = diff --git a/pl/boot.yap b/pl/boot.yap index cf423211e..d0fc0dae9 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -380,13 +380,6 @@ repeat :- '$repeat'. ( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Mod,Fl) ; true ) ; true - ), - ( Fl /\ 16'400000 =:= 0 -> % is this procedure in source mode? - % no, just ignore - true - ; - % and store our clause - '$store_stat_clause'(G0, H, L, Mod) ). '$store_stat_clause'(G0, H, L, M) :- @@ -404,7 +397,6 @@ repeat :- '$repeat'. '$is_multifile'(G, M), !, functor(G, Na, Ar), '$erase_mf_source'(Na, Ar, M). -'$erase_source'(G, M) :- '$recordedp'(M:G,_,R), erase(R), fail. '$erase_source'(_, _). '$erase_mf_source'(Na, Ar, M) :- diff --git a/pl/debug.yap b/pl/debug.yap index c756bd4e1..1a1054388 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -393,16 +393,11 @@ debugging :- '$execute0'(G, M). '$spycall'(G,M) :- '$flags'(G,M,F,F), - F /\ 16'2008 =\= 0, !, % dynamic procedure, or logical semantics + F /\ 16'402008 =\= 0, !, % dynamic procedure, logical semantics, or source % use the interpreter '$clause'(G, M, Cl), CP is '$last_choice_pt', '$do_spy'(Cl, M, CP). -'$spycall'(G,M) :- - '$some_recordedp'(M:G), !, - '$clause'(G, M, Cl), - CP is '$last_choice_pt', - '$do_spy'(Cl, M, CP). '$spycall'(G,M) :- '$continue_debugging', '$execute0'(G, M). diff --git a/pl/errors.yap b/pl/errors.yap index 95d7de6af..bd52803ff 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -177,8 +177,6 @@ print_message(Level, Mss) :- '$preprocess_stack'(Gs, I, NGs). '$beautify_hidden_goal'('$ensure_loaded',_,prolog,ClNo,Gs,I,NGs) :- !, '$preprocess_stack'(Gs, I, NGs). -'$beautify_hidden_goal'('$recordedp',_,prolog,ClNo,Gs,I,NGs) :- !, - '$preprocess_stack'(Gs, I, NGs). '$beautify_hidden_goal'('$continue_with_command',_,prolog,ClNo,Gs,I,NGs) :- !, '$preprocess_stack'(Gs, I, NGs). '$beautify_hidden_goal'('$spycall_stdpred',_,prolog,ClNo,Gs,I,NGs) :- !, diff --git a/pl/listing.yap b/pl/listing.yap index 61f3ed9f7..d377e1690 100644 --- a/pl/listing.yap +++ b/pl/listing.yap @@ -55,16 +55,8 @@ listing(V) :- '$funcspec'(Name,_,_) :- '$do_error'(domain_error(predicate_spec,Name),listing(Name)). -'$list_clauses'(Stream, Mod, Pred) :- - '$is_log_updatable'(Pred, Mod), !, - '$log_update_clause'(Pred,Mod,Body), - '$portray_clause'(Stream,(Pred:-Body)), - fail. '$list_clauses'(Stream, M, Pred) :- - ( '$recordedp'(M:Pred,_,_) -> nl(Stream) ), - fail. -'$list_clauses'(Stream, M, Pred) :- - '$recordedp'(M:Pred,(Pred:-Body),_), + '$clause'(Pred, M, Body), '$portray_clause'(Stream,(Pred:-Body)), fail. diff --git a/pl/preds.yap b/pl/preds.yap index 0501918de..5f857543a 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -314,6 +314,9 @@ clause(V,Q,R) :- '$do_error'(type_error(callable,R),M:clause(R,Q)). '$clause'(M:P,_,Q,R) :- !, '$clause'(P,M,Q,R). +'$clause'(P,M,Q,R) :- + '$is_source'(P, M), !, + '$static_clause'(P,M,Q,R). '$clause'(P,M,Q,R) :- '$is_log_updatable'(P, M), !, '$log_update_clause'(P,M,Q,R). @@ -339,10 +342,10 @@ clause(V,Q,R) :- '$continue_log_update_clause'(A,B,C,D). '$do_log_upd_clause'(A,B,C,D). -'$do_log_upd_retract'(_,_,_,_). -'$do_log_upd_retract'(A,B,C,D) :- - '$continue_log_update_retract'(A,B,C,D). -'$do_log_upd_retract'(A,B,C,D). +'$do_static_clause'(_,_,_,_,_). +'$do_static_clause'(A,B,C,D,E) :- + '$continue_static_clause'(A,B,C,D,E). +'$do_static_clause'(A,B,C,D,E). nth_clause(P,I,R) :- nonvar(R), !, '$nth_instancep'(P,I,R). @@ -625,8 +628,7 @@ abolish(X) :- functor(G,A,N), '$do_error'(permission_error(modify,static_procedure,A/N),abolish(Module:G)). '$abolishs'(G, M) :- - '$purge_clauses'(G, M), - '$recordedp'(M:G,_,R), erase(R), fail. + '$purge_clauses'(G, M), fail. '$abolishs'(_, _). % @@ -776,7 +778,8 @@ predicate_property(Pred,Prop) :- '$predicate_property'(P,M,_,built_in) :- '$system_predicate'(P,M), !. '$predicate_property'(P,M,_,source) :- - ( '$recordedp'(M:P,_,_) -> true ; false). + '$flags'(G,M,F,F), + ( F /\ 16'400000 =\= 0 -> true ; false). '$predicate_property'(P,M,_,dynamic) :- '$is_dynamic'(P,M). '$predicate_property'(P,M,_,static) :-