diff --git a/C/absmi.c b/C/absmi.c index 3ce1159e7..5dcb178b0 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -7530,10 +7530,7 @@ Yap_absmi(int inp) Yap_PrologMode = UserCCallMode; { PredEntry *p = PREG->u.Osbpp.p; -#ifdef LOW_LEVEL_TRACER - if (Yap_do_low_level_trace) - low_level_trace(enter_pred,p,XREGS+1); -#endif /* LOW_LEVEL_TRACE */ + PREG = NEXTOP(PREG, Osbpp); saveregs(); save_machine_regs(); @@ -7541,6 +7538,7 @@ Yap_absmi(int inp) SREG = (CELL *) YAP_Execute(p, p->cs.f_code); EX = 0L; } + Yap_CloseSlots(); restore_machine_regs(); setregs(); @@ -7714,6 +7712,7 @@ Yap_absmi(int inp) restore_machine_regs(); setregs(); Yap_PrologMode = UserMode; + Yap_CloseSlots(); if (!SREG) { FAIL(); } @@ -7756,6 +7755,7 @@ Yap_absmi(int inp) restore_machine_regs(); setregs(); Yap_PrologMode = UserMode; + Yap_CloseSlots(); if (!SREG) { #ifdef CUT_C /* Removes the cut functions from the stack diff --git a/C/adtdefs.c b/C/adtdefs.c index 66553230e..d27947c68 100755 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -1382,6 +1382,7 @@ Yap_NewSlots(int n) n--; } ASP[0] = MkIntTerm(old_slots+oldn); + CurSlot = LCL0-ASP; return((ASP+1)-LCL0); } @@ -1391,6 +1392,7 @@ Yap_InitSlot(Term t) Int old_slots = IntOfTerm(ASP[0]); *ASP = t; ASP--; + CurSlot ++; ASP[0] = MkIntTerm(old_slots+1); return((ASP+1)-LCL0); } @@ -1403,6 +1405,7 @@ Yap_RecoverSlots(int n) return FALSE; } ASP += n; + CurSlot -= n; ASP[0] = MkIntTerm(old_slots-n); return TRUE; } diff --git a/C/c_interface.c b/C/c_interface.c index e023bd9c1..985e3efb1 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -1955,6 +1955,7 @@ YAP_RestartGoal(void) Yap_PrologMode = UserCCallMode; if (out == FALSE) { /* cleanup */ + Yap_CloseSlots(); Yap_trust_last(); Yap_AllowRestart = FALSE; } @@ -2719,6 +2720,7 @@ YAP_Predicate(Atom a, UInt arity, Term m) } else { Functor f = Yap_MkFunctor(a, arity); return((void *)RepPredProp(PredPropByFunc(f,m))); + fprintf(stderr,"here\n"); } } diff --git a/C/cdmgr.c b/C/cdmgr.c index bb4bb7a52..c95cb3124 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -3299,7 +3299,10 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything) only for retracts */ while (env_ptr && b_ptr > (choiceptr)env_ptr) { - PredEntry *pe = EnvPreg((yamop *)env_ptr[E_CP]); + yamop *cp = (yamop *)env_ptr[E_CP]; + PredEntry *pe; + + pe = EnvPreg(cp); if (p == pe) return(TRUE); if (env_ptr != NULL) env_ptr = (CELL *)(env_ptr[E_E]); diff --git a/C/exec.c b/C/exec.c index 3a7dec27a..873e7b54d 100644 --- a/C/exec.c +++ b/C/exec.c @@ -994,6 +994,7 @@ exec_absmi(int top) } else { Yap_PrologMode = UserMode; } + Yap_CloseSlots(); out = Yap_absmi(0); Yap_StartSlots(); return out; @@ -1049,6 +1050,7 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b) #endif YENV[E_CB] = Unsigned (B); CP = YESCODE; + Yap_StartSlots(); } static Term @@ -1200,7 +1202,6 @@ void Yap_trust_last(void) { ASP = B->cp_env; - P = (yamop *)(B->cp_env[E_CP]); CP = B->cp_cp; H = B->cp_h; #ifdef DEPTH_LIMIT @@ -1209,6 +1210,7 @@ Yap_trust_last(void) YENV= ASP = B->cp_env; ENV = (CELL *)((B->cp_env)[E_E]); B = B->cp_b; + P = (yamop *)(ENV[E_CP]); if (B) { SET_BB(B); HB = PROTECT_FROZEN_H(B); @@ -1621,11 +1623,9 @@ Yap_InitYaamRegs(void) CreepFlag = CalculateStackGap(); UNLOCK(SignalLock); EX = 0L; - /* for slots to work */ - Yap_StartSlots(); init_stack(0, NULL, TRUE, NULL); /* the first real choice-point will also have AP=FAIL */ - Yap_StartSlots(); + CurSlot = 0; GlobalArena = TermNil; h0var = MkVarTerm(); #if COROUTINING diff --git a/C/heapgc.c b/C/heapgc.c index 74f4374e5..fd7f6fafe 100755 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -1837,14 +1837,22 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B static void -mark_slots(CELL *ptr) +mark_slots(void) { - Int ns = IntOfTerm(*ptr); - ptr++; - while (ns > 0) { - mark_external_reference(ptr); + Int curslot = CurSlot; + while (curslot) { + CELL *ptr = LCL0-curslot; + Int ns = IntegerOfTerm(*ptr); + ptr++; - ns--; + while (ns > 0) { + // Yap_DebugPlWrite(ptr); + //fprintf(stderr,"\n"); + mark_external_reference(ptr); + ptr++; + ns--; + } + curslot = IntegerOfTerm(*ptr); } } @@ -1978,7 +1986,6 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose) restart_cp: switch (opnum) { case _Nstop: - mark_slots(gc_B->cp_env); if (gc_B->cp_b != NULL) { nargs = 0; break; @@ -2777,20 +2784,25 @@ sweep_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap) } static void -sweep_slots(CELL *ptr) +sweep_slots(void) { - Int ns = IntOfTerm(*ptr); - ptr++; - while (ns > 0) { - CELL cp_cell = *ptr; - if (MARKED_PTR(ptr)) { - UNMARK(ptr); - if (HEAP_PTR(cp_cell)) { - into_relocation_chain(ptr, GET_NEXT(cp_cell)); - } - } + Int curslot = CurSlot; + while (curslot) { + CELL *ptr = LCL0-curslot; + Int ns = IntOfTerm(*ptr); ptr++; - ns--; + while (ns > 0) { + CELL cp_cell = *ptr; + if (MARKED_PTR(ptr)) { + UNMARK(ptr); + if (HEAP_PTR(cp_cell)) { + into_relocation_chain(ptr, GET_NEXT(cp_cell)); + } + } + ptr++; + ns--; + } + curslot = IntegerOfTerm(*ptr); } } @@ -2870,7 +2882,6 @@ sweep_choicepoints(choiceptr gc_B) sweep_environments(gc_B->cp_env, EnvSizeInCells, NULL); - sweep_slots(gc_B->cp_env); if (gc_B->cp_b != NULL) { break; } else @@ -3606,8 +3617,7 @@ marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp) cont_top = (cont *)db_vec; /* These two must be marked first so that our trail optimisation won't lose values */ - if (Yap_PrologMode & UserCCallMode) - mark_slots(ASP); + mark_slots(); mark_regs(old_TR); /* active registers & trail */ /* active environments */ mark_environments(current_env, EnvSize(curp), EnvBMap(curp)); @@ -3660,8 +3670,7 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp) sweep_oldgen(HGEN, CurrentH0); } } - if (Yap_PrologMode & UserCCallMode) - sweep_slots(ASP); + sweep_slots(); sweep_environments(current_env, EnvSize(curp), EnvBMap(curp)); sweep_choicepoints(B); sweep_trail(B, old_TR); diff --git a/C/iopreds.c b/C/iopreds.c index 659169bef..490f7e63a 100755 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -3660,6 +3660,7 @@ int beam_write (void) { Yap_StartSlots(); Yap_plwrite (ARG1, Stream[Yap_c_output_stream].stream_wputc, 0, 1200); + Yap_CloseSlots(); if (EX != 0L) { Term ball = EX; EX = 0L; @@ -3679,6 +3680,7 @@ p_write (void) we cannot make recursive Prolog calls */ Yap_StartSlots(); Yap_plwrite (ARG2, Stream[Yap_c_output_stream].stream_wputc, flags, 1200); + Yap_CloseSlots(); if (EX != 0L) { Term ball = EX; EX = 0L; @@ -3697,6 +3699,7 @@ p_write_prio (void) we cannot make recursive Prolog calls */ Yap_StartSlots(); Yap_plwrite (ARG3, Stream[Yap_c_output_stream].stream_wputc, flags, (int)IntOfTerm(Deref(ARG2))); + Yap_CloseSlots(); if (EX != 0L) { Term ball = EX; EX = 0L; @@ -3720,6 +3723,7 @@ p_write2_prio (void) we cannot make recursive Prolog calls */ Yap_StartSlots(); Yap_plwrite (ARG4, Stream[Yap_c_output_stream].stream_wputc, (int) IntOfTerm (Deref (ARG2)), (int) IntOfTerm (Deref (ARG3))); + Yap_CloseSlots(); Yap_c_output_stream = old_output_stream; if (EX != 0L) { Term ball = EX; @@ -3744,6 +3748,7 @@ p_write2 (void) we cannot make recursive Prolog calls */ Yap_StartSlots(); Yap_plwrite (ARG3, Stream[Yap_c_output_stream].stream_wputc, (int) IntOfTerm (Deref (ARG2)), 1200); + Yap_CloseSlots(); Yap_c_output_stream = old_output_stream; if (EX != 0L) { Term ball = EX; @@ -5089,6 +5094,7 @@ format(volatile Term otail, volatile Term oargs, int sno) goto do_type_atom_error; Yap_StartSlots(); Yap_plwrite (t, f_putc, Handle_vars_f|To_heap_f, 1200); + Yap_CloseSlots(); FormatInfo = &finfo; break; case 'c': @@ -5338,8 +5344,8 @@ format(volatile Term otail, volatile Term oargs, int sno) t = targs[targ++]; Yap_StartSlots(); Yap_plwrite (t, f_putc, Quote_illegal_f|Ignore_ops_f|To_heap_f , 1200); + Yap_CloseSlots(); FormatInfo = &finfo; - ASP++; break; case '@': t = targs[targ++]; @@ -5368,6 +5374,7 @@ format(volatile Term otail, volatile Term oargs, int sno) goto do_default_error; } } + Yap_CloseSlots(); break; case 'p': if (targ > tnum-1 || has_repeats) @@ -5381,6 +5388,7 @@ format(volatile Term otail, volatile Term oargs, int sno) args = Yap_GetFromSlot(sl); Yap_RecoverSlots(1); } + Yap_CloseSlots(); if (EX != 0L) { Term ball; @@ -5399,7 +5407,6 @@ format(volatile Term otail, volatile Term oargs, int sno) Yap_JumpToEnv(ball); return FALSE; } - ASP++; break; case 'q': if (targ > tnum-1 || has_repeats) @@ -5407,8 +5414,8 @@ format(volatile Term otail, volatile Term oargs, int sno) t = targs[targ++]; Yap_StartSlots(); Yap_plwrite (t, f_putc, Handle_vars_f|Quote_illegal_f|To_heap_f, 1200); + Yap_CloseSlots(); FormatInfo = &finfo; - ASP++; break; case 'w': if (targ > tnum-1 || has_repeats) @@ -5416,8 +5423,8 @@ format(volatile Term otail, volatile Term oargs, int sno) t = targs[targ++]; Yap_StartSlots(); Yap_plwrite (t, f_putc, Handle_vars_f|To_heap_f, 1200); + Yap_CloseSlots(); FormatInfo = &finfo; - ASP++; break; case '~': if (has_repeats) @@ -6262,10 +6269,10 @@ Yap_TermToString(Term t, char *s, unsigned int sz, int flags) if (sno < 0) return FALSE; - Yap_StartSlots(); Yap_c_output_stream = sno; Yap_StartSlots(); Yap_plwrite (t, Stream[sno].stream_wputc, flags, 1200); + Yap_CloseSlots(); s[Stream[sno].u.mem_string.pos] = '\0'; Stream[sno].status = Free_Stream_f; Yap_c_output_stream = old_output_stream; diff --git a/H/Regs.h b/H/Regs.h index adf6ff594..6b015d6af 100644 --- a/H/Regs.h +++ b/H/Regs.h @@ -80,6 +80,7 @@ EXTERN void save_B(void); typedef struct { + Int CurSlot_; CELL CreepFlag_; /* 13 */ CELL *HB_; /* 4 heap (global) stack top at latest c.p. */ #if defined(SBA) || defined(TABLING) @@ -609,11 +610,10 @@ EXTERN inline void restore_B(void) { #endif +#define CurSlot Yap_REGS.CurSlot_ #define AuxBase Yap_REGS.AuxBase_ #define AuxSp Yap_REGS.AuxSp_ #define AuxTop Yap_REGS.AuxTop_ -#define TopB Yap_REGS.TopB_ -#define DelayedB Yap_REGS.DelayedB_ #define EX Yap_REGS.EX_ #define DEPTH Yap_REGS.DEPTH_ #if defined(SBA) || defined(TABLING) diff --git a/H/Yap.h b/H/Yap.h index f1a76f831..11997c64b 100755 --- a/H/Yap.h +++ b/H/Yap.h @@ -1305,4 +1305,27 @@ typedef enum COMPILE_ALL /* compile all predicates */ } yap_exec_mode; +/********* slots ***********************/ + + +static inline void +Yap_StartSlots(void) { + *--ASP = MkIntegerTerm(CurSlot); + *--ASP = MkIntTerm(0); + CurSlot = LCL0-ASP; +} + +static inline void +Yap_CloseSlots(void) { + Int old_slots; + old_slots = IntOfTerm(ASP[0]); + ASP += (old_slots+1); + CurSlot = IntegerOfTerm(*ASP); + ASP++; +} + +static inline Int +Yap_CurrentSlot(void) { + return IntOfTerm(ASP[0]); +} diff --git a/H/Yapproto.h b/H/Yapproto.h index 576a17351..ed46bce5f 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -59,8 +59,6 @@ Term STD_PROTO(Yap_NWideStringToDiffListOfAtoms,(wchar_t *, Term, size_t)); int STD_PROTO(Yap_AtomIncreaseHold,(Atom)); int STD_PROTO(Yap_AtomDecreaseHold,(Atom)); -#define Yap_StartSlots() (*--ASP = MkIntTerm(0)) -#define Yap_CurrentSlot() IntOfTerm(ASP[0]) Int STD_PROTO(Yap_InitSlot,(Term)); Int STD_PROTO(Yap_NewSlots,(int)); Term STD_PROTO(Yap_GetFromSlot,(Int)); diff --git a/library/yap2swi/yap2swi.c b/library/yap2swi/yap2swi.c index ba5551498..c26a51cda 100755 --- a/library/yap2swi/yap2swi.c +++ b/library/yap2swi/yap2swi.c @@ -2207,28 +2207,6 @@ X_API int PL_action(int action,...) return 0; } -X_API fid_t -PL_open_foreign_frame(void) -{ - return (fid_t)ASP; -} - -X_API void -PL_close_foreign_frame(fid_t f) -{ -} - -X_API void -PL_rewind_foreign_frame(fid_t f) -{ -} - -X_API void -PL_discard_foreign_frame(fid_t f) -{ - /* Missing: undo Trail!! */ -} - X_API term_t PL_exception(qid_t q) { @@ -2371,9 +2349,52 @@ typedef struct open_query_struct { int open; int state; YAP_Term g; + yamop *p, *cp; + Int slots; + struct open_query_struct *old; } open_query; -open_query execution; +static open_query *execution = NULL; + +X_API fid_t +PL_open_foreign_frame(void) +{ + open_query *new = (open_query *)malloc(sizeof(open_query)); + if (!new) return 0; + new->old = execution; + new->g = TermNil; + new->open = FALSE; + new->cp = CP; + new->p = P; + new->slots = CurSlot; + Yap_StartSlots(); + execution = new; + return (fid_t)new; +} + +X_API void +PL_close_foreign_frame(fid_t f) +{ + CP = execution->cp; + P = execution->p; + CurSlot = execution->slots; + execution = execution->old; +} + +X_API void +PL_rewind_foreign_frame(fid_t f) +{ + CurSlot = execution->slots; +} + +X_API void +PL_discard_foreign_frame(fid_t f) +{ + CP = execution->cp; + P = execution->p; + CurSlot = execution->slots; + execution = execution->old; +} X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0) { @@ -2382,11 +2403,14 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0) Term t[2], m; /* ignore flags and module for now */ - if (execution.open != 0) { + if (execution == NULL) + PL_open_foreign_frame(); + if (execution->open != 0) { YAP_Error(0, 0L, "only one query at a time allowed\n"); + return FALSE; } - execution.open=1; - execution.state=0; + execution->open=1; + execution->state=0; PredicateInfo((PredEntry *)p, &yname, &arity, &m); t[0] = SWIModuleToModule(ctx); if (arity == 0) { @@ -2395,8 +2419,8 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0) Functor f = Yap_MkFunctor(yname, arity); t[1] = Yap_MkApplTerm(f,arity,Yap_AddressFromSlot(t0)); } - execution.g = Yap_MkApplTerm(FunctorModule,2,t); - return &execution; + execution->g = Yap_MkApplTerm(FunctorModule,2,t); + return execution; } X_API int PL_next_solution(qid_t qi) @@ -2405,7 +2429,6 @@ X_API int PL_next_solution(qid_t qi) if (qi->open != 1) return 0; if (qi->state == 0) { - result = YAP_RunGoal(qi->g); } else { result = YAP_RestartGoal(); diff --git a/packages/ProbLog/Makefile.in b/packages/ProbLog/Makefile.in index 220b44d02..282d762b4 100644 --- a/packages/ProbLog/Makefile.in +++ b/packages/ProbLog/Makefile.in @@ -9,7 +9,8 @@ BINDIR = $(ROOTDIR)/bin # # where YAP should look for binary libraries # -LIBDIR=@libdir@/Yap +LIBDIR=@libdir@ +YAPLIBDIR=@libdir@/Yap # # where YAP should look for architecture-independent Prolog libraries # diff --git a/packages/ProbLog/simplecudd/Makefile.in b/packages/ProbLog/simplecudd/Makefile.in index 17be51be2..546e70b48 100644 --- a/packages/ProbLog/simplecudd/Makefile.in +++ b/packages/ProbLog/simplecudd/Makefile.in @@ -14,7 +14,8 @@ BINDIR = $(EROOTDIR)/bin # # where YAP should look for libraries # -LIBDIR=@libdir@/Yap +LIBDIR=@libdir@ +YAPLIBDIR=@libdir@/Yap # # CC=@CC@ @@ -60,4 +61,4 @@ clean: rm -f *.o ProblogBDD Example install: default - $(INSTALL_PROGRAM) ProblogBDD $(DESTDIR)$(LIBDIR) + $(INSTALL_PROGRAM) ProblogBDD $(DESTDIR)$(YAPLIBDIR) diff --git a/packages/jpl b/packages/jpl index 9efaf4ce7..c6b86a4c7 160000 --- a/packages/jpl +++ b/packages/jpl @@ -1 +1 @@ -Subproject commit 9efaf4ce7063fbdae534b4555a80fa1373bb7e9a +Subproject commit c6b86a4c77da30c8e3a9eafcad76a54004a779de diff --git a/packages/plunit/Makefile.in b/packages/plunit/Makefile.in index 185362b15..a030e3b63 100644 --- a/packages/plunit/Makefile.in +++ b/packages/plunit/Makefile.in @@ -19,8 +19,8 @@ srcdir=@srcdir@ BINDIR = $(EROOTDIR)/bin LIBDIR=@libdir@ -SHAREDIR=$(EROOTDIR)/share/Yap YAPLIBDIR=@libdir@/Yap +SHAREDIR=$(EROOTDIR)/share/Yap PL=@EXTEND_DYNLOADER_PATH@ $(DESTDIR)$(BINDIR)/yap $(DESTDIR)$(YAPLIBDIR)/startup.yss LN_S=@LN_S@